The ParaMonte Documentation Website
Current view: top level - kernel - ParaMonteChainFileContents_mod.f90 (source / functions) Hit Total Coverage
Test: ParaMonte 1.5.1 :: MPI Parallel Kernel - Code Coverage Report Lines: 293 319 91.8 %
Date: 2021-01-08 13:07:16 Functions: 6 6 100.0 %
Legend: Lines: hit not hit

          Line data    Source code
       1             : !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
       2             : !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
       3             : !!!!
       4             : !!!!   MIT License
       5             : !!!!
       6             : !!!!   ParaMonte: plain powerful parallel Monte Carlo library.
       7             : !!!!
       8             : !!!!   Copyright (C) 2012-present, The Computational Data Science Lab
       9             : !!!!
      10             : !!!!   This file is part of the ParaMonte library.
      11             : !!!!
      12             : !!!!   Permission is hereby granted, free of charge, to any person obtaining a
      13             : !!!!   copy of this software and associated documentation files (the "Software"),
      14             : !!!!   to deal in the Software without restriction, including without limitation
      15             : !!!!   the rights to use, copy, modify, merge, publish, distribute, sublicense,
      16             : !!!!   and/or sell copies of the Software, and to permit persons to whom the
      17             : !!!!   Software is furnished to do so, subject to the following conditions:
      18             : !!!!
      19             : !!!!   The above copyright notice and this permission notice shall be
      20             : !!!!   included in all copies or substantial portions of the Software.
      21             : !!!!
      22             : !!!!   THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
      23             : !!!!   EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
      24             : !!!!   MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
      25             : !!!!   IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM,
      26             : !!!!   DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR
      27             : !!!!   OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE
      28             : !!!!   OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
      29             : !!!!
      30             : !!!!   ACKNOWLEDGMENT
      31             : !!!!
      32             : !!!!   ParaMonte is an honor-ware and its currency is acknowledgment and citations.
      33             : !!!!   As per the ParaMonte library license agreement terms, if you use any parts of
      34             : !!!!   this library for any purposes, kindly acknowledge the use of ParaMonte in your
      35             : !!!!   work (education/research/industry/development/...) by citing the ParaMonte
      36             : !!!!   library as described on this page:
      37             : !!!!
      38             : !!!!       https://github.com/cdslaborg/paramonte/blob/main/ACKNOWLEDGMENT.md
      39             : !!!!
      40             : !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
      41             : !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
      42             : 
      43             : !>  \brief This module contains the classs and procedures for chain IO and manipulation.
      44             : !>  \author Amir Shahmoradi
      45             : 
      46             : module ParaMonteChainFileContents_mod
      47             : 
      48             :     use, intrinsic :: iso_fortran_env, only: output_unit
      49             :     use Decoration_mod, only: INDENT
      50             :     use Constants_mod, only: IK, RK
      51             :     use Err_mod, only: Err_type, warn
      52             :     use JaggedArray_mod, only: CharVec_type
      53             :     implicit none
      54             : 
      55             :     character(*), parameter :: MODULE_NAME = "@ParaMonteChainFileContents_mod"
      56             : 
      57             :     integer(IK) , parameter :: NUM_DEF_COL = 7_IK   ! number of columns in the chain file other than the State columns
      58             : 
      59             :     character(*), parameter :: COL_HEADER_DEFAULT(NUM_DEF_COL) =    [ "ProcessID            " &
      60             :                                                                     , "DelayedRejectionStage" &
      61             :                                                                     , "MeanAcceptanceRate   " &
      62             :                                                                     , "AdaptationMeasure    " &
      63             :                                                                     , "BurninLocation       " &
      64             :                                                                     , "SampleWeight         " &
      65             :                                                                     , "SampleLogFunc        " &
      66             :                                                                     ]
      67             : 
      68             :     type :: Count_type
      69             :         integer(IK) :: compact = 0_IK   ! number of unique (weighted) points in the chain
      70             :         integer(IK) :: verbose = 0_IK   ! number of points (weight=1) in the MCMC chain
      71             :         integer(IK) :: target = 0_IK    ! size of the allocations for the Chain components
      72             :     end type Count_type
      73             : 
      74             :     type                                    :: ChainFileContents_type
      75             :         integer(IK)                         :: ndim = 0_IK
      76             :         integer(IK)                         :: lenHeader = 0_IK
      77             :         integer(IK)                         :: numDefCol = NUM_DEF_COL
      78             :         type(Count_type)                    :: Count
      79             :         integer(IK)         , allocatable   :: ProcessID(:)     !< The vector of the ID of the images whose function calls haven been accepted.
      80             :         integer(IK)         , allocatable   :: DelRejStage(:)   !< The delayed rejection stages at which the proposed states were accepted.
      81             :         real(RK)            , allocatable   :: Adaptation(:)    !< The vector of the adaptation measures at the MCMC accepted states.
      82             :         real(RK)            , allocatable   :: MeanAccRate(:)   !< The vector of the average acceptance rates at the given point in the chain.
      83             :         integer(IK)         , allocatable   :: BurninLoc(:)     !< The burnin locations at the given locations in the chains.
      84             :         integer(IK)         , allocatable   :: Weight(:)        !< The vector of the weights of the MCMC accepted states.
      85             :         real(RK)            , allocatable   :: LogFunc(:)       !< The vector of LogFunc values corresponding to the MCMC states.
      86             :         real(RK)            , allocatable   :: State(:,:)       !< The (nd,chainSize) MCMC chain of accepted proposed states.
      87             :         type(CharVec_type)  , allocatable   :: ColHeader(:)     !< The column headers of the chain file.
      88             :         character(:)        , allocatable   :: delimiter        !< The delimiter used to separate objects in the chain file.
      89             :         type(Err_type)                      :: Err
      90             :     contains
      91             :         procedure, pass :: nullify => nullifyChainFileContents
      92             :         procedure, pass :: get => getChainFileContents
      93             :         procedure, pass :: writeChainFile
      94             :         procedure, pass :: getLenHeader
      95             :         procedure, pass :: writeHeader
      96             :     end type ChainFileContents_type
      97             : 
      98             :     interface ChainFileContents_type
      99             :         module procedure :: constructChainFileContents
     100             :     end interface ChainFileContents_type
     101             : 
     102             : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
     103             : 
     104             : contains
     105             : 
     106             : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
     107             : 
     108             :     !> \brief
     109             :     !> This is the constructor of the class [ChainFileContents_type](@ref chainfilecontents_type).\n
     110             :     !> Return an object of class [ChainFileContents_type](@ref chainfilecontents_type) given the input specifications.
     111             :     !>
     112             :     !> @param[in]   ndim                : The number of dimensions of the domain of the objective function.
     113             :     !> @param[in]   variableNameList    : The list of variable names corresponding to each axis of the domain of the objective function (**optional**).
     114             :     !> @param[in]   chainFilePath       : The list of variable names corresponding to each axis of the domain of the objective function (**optional**).
     115             :     !> @param[in]   chainSize           : The size of the chain in the chain file specified by the input `chainFilePath` (**optional**).
     116             :     !> @param[in]   chainFileForm       : The file format of the chain file (`"binary"` vs. `"compact"` vs. `"verbose"`) (**optional**).
     117             :     !> @param[in]   lenHeader           : The full length of the first line in the input file (the header line) (**optional**).
     118             :     !> @param[in]   delimiter           : The delimiter symbol used in the chain file (**optional**).
     119             :     !> @param[in]   targetChainSize     : The final target size of the chain (in case the chain file is an interrupted simulation) (**optional**).
     120             :     !>
     121             :     !> \return
     122             :     !> `CFC` : An object of class [ChainFileContents_type](@ref chainfilecontents_type) containing the chain.
     123             :     !>
     124             :     !> \warning
     125             :     !> If `chainFilePath` is given, then the rest of the optional arguments *must be also given*.
     126         813 :     function constructChainFileContents(ndim,variableNameList,chainFilePath,chainSize,chainFileForm,lenHeader,delimiter,targetChainSize) result(CFC)
     127             : #if INTEL_COMPILER_ENABLED && defined DLL_ENABLED && (OS_IS_WINDOWS || defined OS_IS_DARWIN)
     128             :         !DEC$ ATTRIBUTES DLLEXPORT :: constructChainFileContents
     129             : #endif
     130             :         implicit none
     131             :         integer(IK) , intent(in)            :: ndim
     132             :         character(*), intent(in), optional  :: chainFileForm
     133             :         character(*), intent(in), optional  :: variableNameList(ndim)
     134             :         character(*), intent(in), optional  :: chainFilePath
     135             :         character(*), intent(in), optional  :: delimiter
     136             :         integer(IK) , intent(in), optional  :: lenHeader, chainSize, targetChainSize
     137             :         type(ChainFileContents_type)        :: CFC
     138         693 :         type(Err_type)                      :: Err
     139             :         integer(IK)                         :: icol
     140         693 :         Err%occurred = .false.
     141             : 
     142         693 :         CFC%ndim = ndim
     143             : 
     144             :         ! set up the chain file column header
     145             : 
     146        6618 :         allocate(CFC%ColHeader(ndim+NUM_DEF_COL))
     147        5544 :         do icol = 1, NUM_DEF_COL
     148        5544 :             CFC%ColHeader(icol)%record = trim(adjustl(COL_HEADER_DEFAULT(icol)))
     149             :         end do
     150         693 :         if (present(variableNameList)) then
     151         348 :             do icol = NUM_DEF_COL + 1, NUM_DEF_COL + ndim
     152         348 :                 CFC%ColHeader(icol)%record = trim(adjustl(variableNameList(icol-NUM_DEF_COL)))
     153             :             end do
     154             :         end if
     155             : 
     156             :         ! set up other variables if given
     157             : 
     158         693 :         if (present(lenHeader)) CFC%lenHeader = lenHeader
     159         693 :         if (present(delimiter)) CFC%delimiter = delimiter
     160         693 :         if (present(targetChainSize)) CFC%Count%target = targetChainSize
     161             : 
     162             :         ! read the chain file if the path is given
     163             : 
     164         693 :         if (present(chainFilePath) .and. present(chainFileForm)) call CFC%get(chainFilePath,chainFileForm,Err,chainSize,lenHeader,ndim,delimiter,targetChainSize)
     165         693 :         if (Err%occurred) then
     166             :         ! LCOV_EXCL_START
     167             :             CFC%Err%occurred = .true.
     168             :             CFC%Err%msg = Err%msg
     169             :             return
     170             :         end if
     171             :         ! LCOV_EXCL_STOP
     172             : 
     173         693 :     end function constructChainFileContents
     174             : 
     175             : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
     176             : 
     177             :     !> \brief
     178             :     !> This is a method of the class [ChainFileContents_type](@ref chainfilecontents_type).\n
     179             :     !> Return the contents of a ParaMonte simulation output chain file, always in `compact` format, regardless of the
     180             :     !> value of `chainFileFormat` and store it in the object of class [ChainFileContents_type](@ref chainfilecontents_type).
     181             :     !>
     182             :     !> @param[inout]    CFC             : The object of class [ChainFileContents_type](@ref chainfilecontents_type).
     183             :     !> @param[in]       chainFilePath   : The list of variable names corresponding to each axis of the domain of the objective function.
     184             :     !> @param[in]       chainFileForm   : The file format of the chain file (`"binary"` vs. `"compact"` vs. `"verbose"`).
     185             :     !> @param[out]      Err             : An object of class [Err_type](@ref err_mod::err_type) containing information about whether an error has occurred.
     186             :     !> @param[in]       chainSize       : The size of the chain in the chain file specified by the input `chainFilePath` (**optional**).
     187             :     !> @param[in]       lenHeader       : The full length of the first line in the input file (the header line) (**optional**).
     188             :     !> @param[in]       ndim            : The number of dimensions of the domain of the objective function (**optional**).
     189             :     !> @param[in]       delimiter       : The delimiter symbol used in the chain file (**optional**).
     190             :     !> @param[in]       targetChainSize : The final target size of the chain (in case the chain file is an interrupted simulation) (**optional**).
     191             :     !>
     192             :     !> \warning
     193             :     !> `targetChainSize` must be `>= chainSize`, if provided. It is used for the allocation of the chain components.
     194             :     !> 
     195             :     !> \warning
     196             :     !> `chainSize` must be `<= targetChainSize`. The first `chainSize` elements of the `CFC` components will contain
     197             :     !> the chain information read from the chain file. The chain component elements beyond `chainSize` will be set to zero.
     198         123 :     subroutine getChainFileContents(CFC,chainFilePath,chainFileForm,Err,chainSize,lenHeader,ndim,delimiter,targetChainSize)
     199             : #if INTEL_COMPILER_ENABLED && defined DLL_ENABLED && (OS_IS_WINDOWS || defined OS_IS_DARWIN)
     200             :         !DEC$ ATTRIBUTES DLLEXPORT :: getChainFileContents
     201             : #endif
     202         693 :         use FileContents_mod, only: getNumRecordInFile
     203             :         use Constants_mod, only: IK, RK, NLC, NEGINF_IK, NEGINF_RK
     204             :         use String_mod, only: String_type, getLowerCase, num2str
     205             : 
     206             :         implicit none
     207             : 
     208             :         character(*), parameter                         :: PROCEDURE_NAME = MODULE_NAME // "@getChainFileContents()"
     209             : 
     210             :         class(ChainFileContents_type), intent(inout)    :: CFC
     211             :         character(*)    , intent(in)                    :: chainFilePath
     212             :         character(*)    , intent(in)                    :: chainFileForm
     213             :         type(Err_type)  , intent(out)                   :: Err
     214             :         character(*)    , intent(in), optional          :: delimiter
     215             :         integer(IK)     , intent(in), optional          :: chainSize, lenHeader, ndim, targetChainSize
     216          63 :         character(:)    , allocatable                   :: chainFilePathTrimmed, thisForm
     217          63 :         type(String_type)                               :: Record
     218             :         integer(IK)                                     :: chainFileUnit, i, iState, delimiterLen, chainSizeDefault
     219             :         integer(IK)                                     :: irowLastUniqueSample
     220             :         integer(IK)                                     :: numColTot
     221             :         logical                                         :: fileExists, fileIsOpen, delimHasBegun, delimHasEnded, isBinary, isCompact, isVerbose
     222             : 
     223          63 :         Err%occurred = .false.
     224          63 :         chainFilePathTrimmed = trim(adjustl(chainFilePath))
     225          63 :         inquire(file=chainFilePathTrimmed,exist=fileExists,opened=fileIsOpen,number=chainFileUnit)
     226             : 
     227         636 :         blockFileExistence: if (fileExists) then
     228             : 
     229             :             ! set up chain file format
     230             : 
     231          63 :             isBinary = .false.
     232          63 :             isCompact = .false.
     233          63 :             isVerbose = .false.
     234         126 :             if (getLowerCase(chainFileForm)=="binary") then
     235          12 :                 isBinary = .true.
     236         102 :             elseif (getLowerCase(chainFileForm)=="compact") then
     237          39 :                 isCompact = .true.
     238          24 :             elseif (getLowerCase(chainFileForm)=="verbose") then
     239          12 :                 isVerbose = .false.
     240             :             else
     241             :                 ! LCOV_EXCL_START
     242             :                 Err%occurred = .true.
     243             :                 Err%msg = PROCEDURE_NAME//": Unrecognized chain file form: "//chainFileForm
     244             :                 return
     245             :                 ! LCOV_EXCL_STOP
     246             :             end if
     247             : 
     248          63 :             if (isBinary) then
     249          12 :                 thisForm = "unformatted"
     250          12 :                 if (.not. present(ndim) .or. .not. present(lenHeader) .or. .not. present(delimiter)) then
     251             :                     ! LCOV_EXCL_START
     252             :                     Err%occurred = .true.
     253             :                     Err%msg = PROCEDURE_NAME//": If the chain file is in binary form, chainSize, lenHeader, delimiter, and ndim must be provided by the user."
     254             :                     return
     255             :                     ! LCOV_EXCL_STOP
     256             :                 end if
     257             :             else
     258          51 :                 thisForm = "formatted"
     259             :             end if
     260             : 
     261          63 :             if (fileIsOpen) then
     262          32 :                 if (chainFileUnit==-1) then
     263             :                     ! LCOV_EXCL_START
     264             :                     Err%occurred = .true.
     265             :                     Err%msg = PROCEDURE_NAME//": The file located at: "//chainFilePathTrimmed//NLC//"is open, but no unit is connected to the file."//NLC
     266             :                     return
     267             :                     ! LCOV_EXCL_STOP
     268             :                 else
     269          32 :                     close(chainFileUnit)
     270             :                 end if
     271             :             end if
     272             : 
     273             :             ! get the number of records in file, minus header line
     274             : 
     275          63 :             if (present(chainSize)) then
     276           3 :                 chainSizeDefault = chainSize
     277             :             else ! here chainSizeDefault is indeed max(chainSize) depending on the file format: verbose or compact
     278          60 :                 if (isBinary) then
     279             :                     open( newunit = chainFileUnit &
     280             :                         , file = chainFilePathTrimmed &
     281             :                         , status = "old" &
     282             :                         , form = thisForm &
     283             :                         , iostat = Err%stat &
     284             : #if defined INTEL_COMPILER_ENABLED && defined OS_IS_WINDOWS
     285             :                         , SHARED &
     286             : #endif
     287          12 :                         )
     288          12 :                     if (Err%stat/=0) then
     289             :                         ! LCOV_EXCL_START
     290             :                         Err%occurred = .true.
     291             :                         Err%msg = PROCEDURE_NAME//": Unable to open the file located at: "//chainFilePathTrimmed//NLC
     292             :                         return
     293             :                         ! LCOV_EXCL_STOP
     294             :                     end if
     295          12 :                     if (allocated(Record%value)) deallocate(Record%value)
     296          12 :                     allocate( character(lenHeader) :: Record%value )
     297          12 :                     read(chainFileUnit) Record%value
     298             :                     block
     299             :                         integer(IK)             :: processID ! LCOV_EXCL_LINE
     300             :                         integer(IK)             :: delRejStage ! LCOV_EXCL_LINE
     301             :                         real(RK)                :: meanAccRate ! LCOV_EXCL_LINE
     302             :                         real(RK)                :: adaptation ! LCOV_EXCL_LINE
     303             :                         integer(IK)             :: burninLoc ! LCOV_EXCL_LINE
     304             :                         integer(IK)             :: weight ! LCOV_EXCL_LINE
     305             :                         real(RK)                :: logFunc ! LCOV_EXCL_LINE
     306             :                         real(RK), allocatable   :: State(:) ! LCOV_EXCL_LINE
     307          12 :                         if (allocated(State)) deallocate(State); allocate(State(ndim))
     308          12 :                         chainSizeDefault = 0_IK
     309        7200 :                         loopFindChainSizeDefault: do
     310        7212 :                             read(chainFileUnit,iostat=Err%stat) processID, delRejStage, meanAccRate, adaptation, burninLoc, weight, logFunc, State
     311        7212 :                             if (Err%stat==0_IK) then
     312        7200 :                                 chainSizeDefault = chainSizeDefault + 1_IK
     313          12 :                             elseif (is_iostat_end(Err%stat)) then
     314          12 :                                 exit loopFindChainSizeDefault
     315             :                             ! LCOV_EXCL_START
     316             :                             elseif (is_iostat_eor(Err%stat)) then
     317             :                                 Err%occurred = .true.
     318             :                                 Err%msg = PROCEDURE_NAME//": Incomplete record detected while reading the input binary chain file at: "//chainFilePathTrimmed//NLC
     319             :                                 return
     320             :                             else
     321             :                                 Err%occurred = .true.
     322             :                                 Err%msg = PROCEDURE_NAME//": IO error occurred while reading the input binary chain file at: "//chainFilePathTrimmed//NLC
     323             :                                 return
     324             :                             ! LCOV_EXCL_STOP
     325             :                             end if
     326             :                         end do loopFindChainSizeDefault
     327             :                     end block
     328          12 :                     close(chainFileUnit)
     329             :                 else ! is not binary
     330          48 :                     call getNumRecordInFile(chainFilePathTrimmed,chainSizeDefault,Err,exclude="")
     331          48 :                     if (Err%occurred) then
     332             :                     ! LCOV_EXCL_START
     333             :                         Err%msg = PROCEDURE_NAME//Err%msg
     334             :                         return
     335             :                     end if
     336             :                     ! LCOV_EXCL_STOP
     337          48 :                     chainSizeDefault = chainSizeDefault - 1_IK ! subtract header
     338             :                 end if
     339             :             end if
     340             : 
     341             :             ! set the number of elements in the Chain components
     342             : 
     343          63 :             if (present(targetChainSize)) then ! in restart mode, this must always be the case
     344          63 :                 CFC%Count%target = targetChainSize
     345             :             else
     346           0 :                 CFC%Count%target = chainSizeDefault
     347             :             end if
     348             :             !if (CFC%Count%target<chainSizeDefault) then
     349             :             !    Err%occurred = .true.
     350             :             !    Err%msg =   PROCEDURE_NAME//": Internal error occurred. The input targetChainSize cannot be smaller than the input chainSize:" // NLC // &
     351             :             !                "    targetChainSize = " // num2str(CFC%Count%target) // NLC // &
     352             :             !                "          chainSize = " // num2str(chainSizeDefault) // NLC // &
     353             :             !                "It appears that the user has manipulated the output chain file."
     354             :             !    return
     355             :             !end if
     356             : 
     357             :             ! allocate Chain components
     358             : 
     359          63 :             if (allocated(CFC%ProcessID))     deallocate(CFC%ProcessID)
     360          63 :             if (allocated(CFC%DelRejStage))   deallocate(CFC%DelRejStage)
     361          63 :             if (allocated(CFC%MeanAccRate))   deallocate(CFC%MeanAccRate)
     362          63 :             if (allocated(CFC%Adaptation))    deallocate(CFC%Adaptation)
     363          63 :             if (allocated(CFC%BurninLoc))     deallocate(CFC%BurninLoc)
     364          63 :             if (allocated(CFC%Weight))        deallocate(CFC%Weight)
     365          63 :             if (allocated(CFC%LogFunc))       deallocate(CFC%LogFunc)
     366          63 :             if (allocated(CFC%State))         deallocate(CFC%State)
     367       34259 :             allocate(CFC%ProcessID  (CFC%Count%target)); CFC%ProcessID   = NEGINF_IK
     368       34259 :             allocate(CFC%DelRejStage(CFC%Count%target)); CFC%DelRejStage = NEGINF_IK
     369       34259 :             allocate(CFC%MeanAccRate(CFC%Count%target)); CFC%MeanAccRate = NEGINF_RK
     370       34259 :             allocate(CFC%Adaptation (CFC%Count%target)); CFC%Adaptation  = NEGINF_RK ! this initialization is critical and relied upon later below
     371       34259 :             allocate(CFC%BurninLoc  (CFC%Count%target)); CFC%BurninLoc   = NEGINF_IK
     372       34259 :             allocate(CFC%Weight     (CFC%Count%target)); CFC%Weight      = NEGINF_IK
     373       34259 :             allocate(CFC%LogFunc    (CFC%Count%target)); CFC%LogFunc     = NEGINF_RK
     374             : 
     375             :             ! find the delimiter
     376             : 
     377          63 :             blockFindDelim: if (present(delimiter)) then
     378             : 
     379          60 :                 CFC%delimiter = delimiter
     380             : 
     381             :             else blockFindDelim
     382             : 
     383           3 :                 if (allocated(CFC%delimiter)) deallocate(CFC%delimiter)
     384           3 :                 allocate( character(1023) :: CFC%delimiter )
     385           3 :                 if (allocated(Record%value)) deallocate(Record%value)
     386           3 :                 allocate( character(99999) :: Record%value )
     387             : 
     388             :                 open( newunit = chainFileUnit &
     389             :                     , file = chainFilePathTrimmed &
     390             :                     , status = "old" &
     391             :                     , form = thisForm &
     392             :                     , iostat = Err%stat &
     393             : #if defined INTEL_COMPILER_ENABLED && defined OS_IS_WINDOWS
     394             :                     , SHARED &
     395             : #endif
     396           3 :                     )
     397           3 :                 if (Err%stat/=0) then
     398             :                 ! LCOV_EXCL_START
     399             :                     Err%occurred = .true.
     400             :                     Err%msg = PROCEDURE_NAME//": Unable to open the file located at: "//chainFilePathTrimmed//"."//NLC
     401             :                     return
     402             :                 end if
     403             :                 ! LCOV_EXCL_STOP
     404             : 
     405           3 :                 read(chainFileUnit,*)   ! skip the header
     406           3 :                 read(chainFileUnit,"(A)") Record%value  ! read the first numeric row in string format
     407           3 :                 close(chainFileUnit)
     408             : 
     409           3 :                 Record%value = trim(adjustl(Record%value))
     410           3 :                 delimHasEnded = .false.
     411           3 :                 delimHasBegun = .false.
     412           3 :                 delimiterLen = 0
     413          21 :                 loopSearchDelimiter: do i = 1, len(Record%value)-1
     414          21 :                     if ( Record%isDigit(Record%value(i:i)) ) then
     415           6 :                         if (delimHasBegun) delimHasEnded = .true.
     416          15 :                     elseif (Record%value(i:i)=="." .or. Record%value(i:i)=="+" .or. Record%value(i:i)=="-") then
     417           0 :                         if (delimHasBegun) then
     418           0 :                             delimHasEnded = .true.
     419             :                         else
     420             :                             ! LCOV_EXCL_START
     421             :                             Err%occurred = .true.
     422             :                             Err%msg = PROCEDURE_NAME//": The file located at: " // chainFilePathTrimmed //NLC//&
     423             :                             "has unrecognizable format. Found "//Record%value(i:i)//" in the first column, while expecting positive integer."//NLC
     424             :                             return
     425             :                             ! LCOV_EXCL_STOP
     426             :                         end if
     427             :                     else
     428          15 :                         if (i==1) then  ! here it is assumed that the first column in chain file always contains integers
     429             :                             ! LCOV_EXCL_START
     430             :                             Err%occurred = .true.
     431             :                             Err%msg = PROCEDURE_NAME//": The file located at: "//chainFilePathTrimmed//NLC//"has unrecognizable format."//NLC
     432             :                             return
     433             :                             ! LCOV_EXCL_STOP
     434             :                         else
     435          15 :                             delimHasBegun = .true.
     436          15 :                             delimiterLen = delimiterLen + 1
     437          15 :                             CFC%delimiter(delimiterLen:delimiterLen) = Record%value(i:i)
     438             :                         end if
     439             :                     end if
     440          21 :                     if (delimHasEnded) exit loopSearchDelimiter
     441             :                 end do loopSearchDelimiter
     442             : 
     443           3 :                 if (.not.(delimHasBegun.and.delimHasEnded)) then
     444             :                     ! LCOV_EXCL_START
     445             :                     Err%occurred = .true.
     446             :                     Err%msg = PROCEDURE_NAME//": The file located at: "//chainFilePathTrimmed//NLC//"has unrecognizable format. Could not identify the column delimiter."//NLC
     447             :                     return
     448             :                     ! LCOV_EXCL_STOP
     449             :                 else
     450           3 :                     CFC%delimiter = trim(adjustl(CFC%delimiter(1:delimiterLen)))
     451           3 :                     delimiterLen = len(CFC%delimiter)
     452           3 :                     if (delimiterLen==0) then
     453           0 :                         CFC%delimiter = " "
     454           0 :                         delimiterLen = 1
     455             :                     end if
     456             :                 end if
     457             : 
     458             :             end if blockFindDelim
     459             : 
     460             :             ! find the number of dimensions of the state (the number of function variables)
     461             : 
     462          63 :             if (present(ndim)) then
     463          63 :                 CFC%ndim = ndim
     464             :             else
     465           0 :                 Record%Parts = Record%split(Record%value,CFC%delimiter,Record%nPart)
     466           0 :                 CFC%numDefCol = 0_IK
     467           0 :                 loopFindNumDefCol: do i = 1, Record%nPart
     468           0 :                     if ( index(string=Record%Parts(i)%record,substring="LogFunc") > 0 ) then
     469           0 :                         CFC%numDefCol = i
     470           0 :                         exit loopFindNumDefCol
     471             :                     end if
     472             :                 end do loopFindNumDefCol
     473           0 :                 if (CFC%numDefCol/=NUM_DEF_COL .or. CFC%numDefCol==0_IK) then
     474             :                     ! LCOV_EXCL_START
     475             :                     Err%occurred = .true.
     476             :                     Err%msg = PROCEDURE_NAME//": Internal error occurred. CFC%numDefCol/=NUM_DEF_COL: " // num2str(CFC%numDefCol) // num2str(NUM_DEF_COL)
     477             :                     return
     478             :                     ! LCOV_EXCL_STOP
     479             :                 end if
     480           0 :                 CFC%ndim = Record%nPart - NUM_DEF_COL
     481             :             end if
     482             : 
     483             :             ! reopen the file to read the contents
     484             : 
     485             :             open( newunit = chainFileUnit &
     486             :                 , file = chainFilePathTrimmed &
     487             :                 , status = "old" &
     488             :                 , form = thisForm &
     489             :                 , iostat = Err%stat &
     490             : #if defined INTEL_COMPILER_ENABLED && defined OS_IS_WINDOWS
     491             :                 , SHARED &
     492             : #endif
     493          63 :                 )
     494          63 :             if (Err%stat/=0) then
     495             :                 ! LCOV_EXCL_START
     496             :                 Err%occurred = .true.
     497             :                 Err%msg = PROCEDURE_NAME//": Unable to open the file located at: "//chainFilePathTrimmed //"."//NLC
     498             :                 return
     499             :                 ! LCOV_EXCL_STOP
     500             :             end if
     501             : 
     502             :             ! first read the column headers
     503             : 
     504          63 :             if (allocated(Record%value)) deallocate(Record%value) ! set up the record string that keeps the contents of each line
     505          63 :             if (isBinary) then
     506          12 :                 allocate( character(lenHeader) :: Record%value )
     507          12 :                 read(chainFileUnit) Record%value
     508             :             else
     509          51 :                 allocate( character(99999) :: Record%value ) ! such huge allocation is rather redundant and is good for a ~4000 dimensional objective function.
     510          51 :                 read(chainFileUnit, "(A)" ) Record%value
     511             :             end if
     512         693 :             CFC%ColHeader = Record%split(trim(adjustl(Record%value)), CFC%delimiter, Record%npart)
     513         630 :             do i = 1, Record%npart ! xxx is this trimming necessary?
     514         630 :                 CFC%ColHeader(i)%record = trim(adjustl(CFC%ColHeader(i)%record))
     515             :             end do
     516             : 
     517             :             ! read the chain
     518             : 
     519          63 :             if (.not. isBinary) then
     520          51 :                 numColTot = CFC%numDefCol + CFC%ndim
     521             :             end if
     522             : 
     523          63 :             allocate(CFC%State(CFC%ndim,CFC%Count%target))
     524          63 :             CFC%Count%verbose = 0_IK
     525             : 
     526          63 :             if (isBinary) then
     527             : 
     528        7212 :                 loopReadBinary: do iState = 1, chainSizeDefault
     529        7200 :                     read(chainFileUnit, iostat=Err%stat ) CFC%ProcessID                (iState)    &
     530        7200 :                                                         , CFC%DelRejStage              (iState)    &
     531        7200 :                                                         , CFC%MeanAccRate              (iState)    &
     532        7200 :                                                         , CFC%Adaptation               (iState)    &
     533        7200 :                                                         , CFC%BurninLoc                (iState)    &
     534        7200 :                                                         , CFC%Weight                   (iState)    &
     535        7200 :                                                         , CFC%LogFunc                  (iState)    &
     536       14400 :                                                         , CFC%State         (1:CFC%ndim,iState)
     537        7200 :                     if (is_iostat_eor(Err%stat) .or. is_iostat_end(Err%stat)) then
     538             :                     ! LCOV_EXCL_START
     539             :                         call warnUserAboutCorruptChainFile(iState)
     540             :                         exit loopReadBinary
     541             :                     end if
     542             :                     ! LCOV_EXCL_STOP
     543        7212 :                     CFC%Count%verbose = CFC%Count%verbose + CFC%Weight(iState)
     544             :                 end do loopReadBinary
     545             : 
     546          51 :             elseif (isCompact) then
     547             : 
     548       18937 :                 loopReadCompact: do iState = 1, chainSizeDefault
     549       18898 :                     read(chainFileUnit, "(A)" ) Record%value
     550      208229 :                     Record%Parts = Record%split(trim(adjustl(Record%value)),CFC%delimiter,Record%nPart)
     551       18937 :                     if (Record%nPart<numColTot) then
     552             :                         ! LCOV_EXCL_START
     553             :                         call warnUserAboutCorruptChainFile(iState)
     554             :                         exit loopReadCompact
     555             :                         ! LCOV_EXCL_STOP
     556             :                     else
     557       18898 :                         read(Record%Parts(1)%record,*) CFC%ProcessID    (iState)
     558       18898 :                         read(Record%Parts(2)%record,*) CFC%DelRejStage  (iState)
     559       18898 :                         read(Record%Parts(3)%record,*) CFC%MeanAccRate  (iState)
     560       18898 :                         read(Record%Parts(4)%record,*) CFC%Adaptation   (iState)
     561       18898 :                         read(Record%Parts(5)%record,*) CFC%BurninLoc    (iState)
     562       18898 :                         read(Record%Parts(6)%record,*) CFC%Weight       (iState)
     563       18898 :                         read(Record%Parts(7)%record,*) CFC%LogFunc      (iState)
     564       56694 :                         do i = 1, CFC%ndim
     565       56694 :                             read(Record%Parts(CFC%numDefCol+i)%record,*) CFC%State  (i,iState)
     566             :                         end do
     567       18898 :                         CFC%Count%verbose = CFC%Count%verbose + CFC%Weight(iState)
     568             :                     end if
     569             :                 end do loopReadCompact
     570             : 
     571             :             else ! is verbose form
     572             : 
     573          12 :                 blockChainSizeDefault: if (chainSizeDefault>0_IK) then
     574             : 
     575          12 :                     CFC%Count%compact = 1_IK
     576             :                     blockReadVerbose: block
     577             : 
     578             :                         logical                 :: newUniqueSampleDetected
     579             :                         integer(IK)             :: processID
     580             :                         integer(IK)             :: delRejStage
     581          12 :                         real(RK)                :: meanAccRate
     582          12 :                         real(RK)                :: adaptation
     583             :                         integer(IK)             :: burninLoc
     584             :                         integer(IK)             :: weight
     585          12 :                         real(RK)                :: logFunc
     586             :                         real(RK), allocatable   :: State(:)
     587          12 :                         if (allocated(State)) deallocate(State); allocate(State(ndim))
     588             : 
     589          12 :                         irowLastUniqueSample = 0_IK
     590             : 
     591             :                         ! read the first sample
     592             : 
     593          12 :                         read(chainFileUnit, "(A)" ) Record%value
     594         240 :                         Record%Parts = Record%split(trim(adjustl(Record%value)),CFC%delimiter,Record%nPart)
     595          12 :                         if (Record%nPart<numColTot) then
     596             :                             ! LCOV_EXCL_START
     597             :                             call warnUserAboutCorruptChainFile(iState)
     598             :                             !exit blockChainSizeDefault
     599             :                             ! intel 2018 to 2019.05 yields internal compiler error with the above exit. Intel 19.1 and gnu 9.1 are fine.
     600             :                             ! The following is a workaround for now.
     601             :                             exit blockReadVerbose
     602             :                             ! LCOV_EXCL_STOP
     603             :                         else
     604          12 :                             read(Record%Parts(1)%record,*) CFC%ProcessID(CFC%Count%compact)
     605          12 :                             read(Record%Parts(2)%record,*) CFC%DelRejStage(CFC%Count%compact)
     606          12 :                             read(Record%Parts(3)%record,*) CFC%MeanAccRate(CFC%Count%compact)
     607          12 :                             read(Record%Parts(4)%record,*) CFC%Adaptation(CFC%Count%compact)
     608          12 :                             read(Record%Parts(5)%record,*) CFC%BurninLoc(CFC%Count%compact)
     609          12 :                             read(Record%Parts(6)%record,*) CFC%Weight(CFC%Count%compact)
     610          12 :                             read(Record%Parts(7)%record,*) CFC%LogFunc(CFC%Count%compact)
     611          36 :                             do i = 1, CFC%ndim
     612          36 :                                 read(Record%Parts(CFC%numDefCol+i)%record,*) CFC%State(i,CFC%Count%compact)
     613             :                             end do
     614             :                         end if
     615             : 
     616             :                         ! read the rest of samples beyond the first, if any exist
     617             : 
     618          12 :                         newUniqueSampleDetected = .false.
     619       23622 :                         loopOverChainfFileContents: do iState = 2, chainSizeDefault
     620             : 
     621       23610 :                             read(chainFileUnit, "(A)" ) Record%value
     622      259710 :                             Record%Parts = Record%split(trim(adjustl(Record%value)), CFC%delimiter, Record%nPart)
     623       23622 :                             if (Record%nPart<numColTot) then
     624             :                                 ! LCOV_EXCL_START
     625             :                                 call warnUserAboutCorruptChainFile(iState)
     626             :                                 exit loopOverChainfFileContents
     627             :                                 ! LCOV_EXCL_STOP
     628             :                             else
     629       23610 :                                 read(Record%Parts(1)%record,*) ProcessID
     630       23610 :                                 read(Record%Parts(2)%record,*) DelRejStage
     631       23610 :                                 read(Record%Parts(3)%record,*) MeanAccRate
     632       23610 :                                 read(Record%Parts(4)%record,*) Adaptation
     633       23610 :                                 read(Record%Parts(5)%record,*) BurninLoc
     634       23610 :                                 read(Record%Parts(6)%record,*) Weight
     635       23610 :                                 read(Record%Parts(7)%record,*) LogFunc
     636       70830 :                                 do i = 1, CFC%ndim
     637       70830 :                                     read(Record%Parts(CFC%numDefCol+i)%record,*) State(i)
     638             :                                 end do
     639             : 
     640             :                                 ! increment CFC%Count%compact if new sample detected
     641             : 
     642       47220 :                                 newUniqueSampleDetected =    LogFunc        /= CFC%LogFunc    (CFC%Count%compact) &
     643             :                                                        !.or. MeanAccRate    /= CFC%MeanAccRate(CFC%Count%compact) &
     644             :                                                        !.or. Adaptation     /= CFC%Adaptation (CFC%Count%compact) &
     645             :                                                        !.or. BurninLoc      /= CFC%BurninLoc  (CFC%Count%compact) &
     646             :                                                        !.or. Weight         /= CFC%Weight     (CFC%Count%compact) &
     647             :                                                        !.or. DelRejStage    /= CFC%DelRejStage(CFC%Count%compact) &
     648             :                                                        !.or. ProcessID      /= CFC%ProcessID  (CFC%Count%compact) &
     649       70830 :                                                         .or. any(CFC%State(1:CFC%ndim,CFC%Count%compact) /= CFC%State(1:CFC%ndim,CFC%Count%compact))
     650       23610 :                                 if (newUniqueSampleDetected) then
     651        7188 :                                     irowLastUniqueSample = irowLastUniqueSample + CFC%Weight(CFC%Count%compact)
     652             :                                     ! increment the compact sample
     653        7188 :                                     CFC%Count%compact = CFC%Count%compact + 1_IK
     654        7188 :                                     if (CFC%Count%target<CFC%Count%compact) then
     655           0 :                                         Err%occurred = .true.
     656             :                                         Err%msg =   PROCEDURE_NAME//": Fatal error occurred. CFC%Count%target<CFC%Count%compact: "// &
     657             :                                                     num2str(CFC%Count%target) // " /= " // num2str(CFC%Count%compact) // &
     658           0 :                                                     "The contents of the input chain file is longer than the user-requested allocation size."
     659           0 :                                         return
     660             :                                     end if
     661             :                                 else
     662       16422 :                                     weight = CFC%Weight(CFC%Count%compact) + 1_IK
     663             :                                 end if
     664             : 
     665             :                                 ! write the latest sample
     666             : 
     667       23610 :                                 CFC%LogFunc         (CFC%Count%compact) = LogFunc
     668       23610 :                                 CFC%MeanAccRate     (CFC%Count%compact) = MeanAccRate
     669       23610 :                                 CFC%Adaptation      (CFC%Count%compact) = max(CFC%Adaptation(CFC%Count%compact),Adaptation)
     670       23610 :                                 CFC%BurninLoc       (CFC%Count%compact) = BurninLoc
     671       23610 :                                 CFC%Weight          (CFC%Count%compact) = Weight
     672       23610 :                                 CFC%DelRejStage     (CFC%Count%compact) = DelRejStage
     673       23610 :                                 CFC%ProcessID       (CFC%Count%compact) = ProcessID
     674       70830 :                                 CFC%State(1:CFC%ndim,CFC%Count%compact) = State(1:CFC%ndim)
     675             : 
     676             :                             end if
     677             : 
     678             :                         end do loopOverChainfFileContents
     679             : 
     680             :                     end block blockReadVerbose
     681             : 
     682             :                 else blockChainSizeDefault
     683             : 
     684           0 :                     CFC%Count%compact = 0_IK
     685           0 :                     CFC%Count%verbose = 0_IK
     686             : 
     687             :                 end if blockChainSizeDefault
     688             : 
     689             :             end if
     690             : 
     691          63 :             if (isBinary .or. isCompact) then
     692          51 :                 CFC%Count%compact = chainSizeDefault
     693             :             else
     694          12 :                 CFC%Count%verbose = chainSizeDefault
     695        7212 :                 if (CFC%Count%verbose/=sum(CFC%Weight(1:CFC%Count%compact))) then
     696             :                     ! LCOV_EXCL_START
     697             :                     Err%occurred = .true.
     698             :                     Err%msg =   PROCEDURE_NAME//": Internal error occurred. CountVerbose/=sum(Weight): "// &
     699             :                                 num2str(CFC%Count%verbose)//" /= "//num2str(sum(CFC%Weight(1:CFC%Count%compact)))// &
     700             :                                 ", CFC%Count%compact = "//num2str(CFC%Count%compact)
     701             :                     return
     702             :                     ! LCOV_EXCL_STOP
     703          12 :                 elseif (.not. present(targetChainSize)) then
     704           0 :                     CFC%ProcessID     = CFC%ProcessID   (1:CFC%Count%compact)
     705           0 :                     CFC%DelRejStage   = CFC%DelRejStage (1:CFC%Count%compact)
     706           0 :                     CFC%MeanAccRate   = CFC%MeanAccRate (1:CFC%Count%compact)
     707           0 :                     CFC%Adaptation    = CFC%Adaptation  (1:CFC%Count%compact)
     708           0 :                     CFC%BurninLoc     = CFC%BurninLoc   (1:CFC%Count%compact)
     709           0 :                     CFC%Weight        = CFC%Weight      (1:CFC%Count%compact)
     710           0 :                     CFC%LogFunc       = CFC%LogFunc     (1:CFC%Count%compact)
     711           0 :                     CFC%State         = CFC%State       (1:CFC%ndim,1:CFC%Count%compact)
     712             :                 end if
     713             :             end if
     714             : 
     715          63 :             close(chainFileUnit)
     716             : 
     717             :             ! set the rest of elements to null values
     718             : 
     719          63 :             if (CFC%Count%target>chainSizeDefault) call CFC%nullify(startIndex=CFC%Count%compact+1_IK, endIndex=CFC%Count%target)
     720             : 
     721             :         else blockFileExistence
     722             : 
     723             :             ! LCOV_EXCL_START
     724             :             Err%occurred = .true.
     725             :             Err%msg = PROCEDURE_NAME//": The chain file does not exist in the given file path: "//chainFilePathTrimmed
     726             :             return
     727             :             ! LCOV_EXCL_STOP
     728             : 
     729             :         end if blockFileExistence
     730             : 
     731             :     contains
     732             : 
     733             :         ! LCOV_EXCL_START
     734             :         subroutine warnUserAboutCorruptChainFile(lineNumber)
     735             :             implicit none
     736             :             integer(IK) :: lineNumber
     737             :             if (isVerbose) then
     738             :                 chainSizeDefault = irowLastUniqueSample
     739             :                 CFC%Count%compact = CFC%Count%compact - 1
     740             :             else
     741             :                 chainSizeDefault = chainSizeDefault - 1
     742             :             end if
     743             :             call warn   ( prefix = INDENT//"ParaMonte" &
     744             :                         , marginTop = 0_IK &
     745             :                         , marginBot = 2_IK &
     746             :                         , outputUnit = output_unit &
     747             :                         , msg = "An end-of-file or end-of-record condition occurred while parsing the contents of the chain file at line = "//num2str(lineNumber)//" with iostat = "//num2str(Err%stat)// &
     748             :                                 ". Assuming the previous line as the last line of the chain file..." &
     749             :                         )
     750             :         ! LCOV_EXCL_STOP
     751          63 :         end subroutine warnUserAboutCorruptChainFile
     752             : 
     753             :     end subroutine getChainFileContents
     754             : 
     755             : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
     756             : 
     757             :     !> \brief
     758             :     !> This is a method of the class [ChainFileContents_type](@ref chainfilecontents_type).\n
     759             :     !> Reset the components of the chain object to an unlikely value for the purpose of error catching and debugging.
     760             :     !> Store the modified components as part of the input object of class [ChainFileContents_type](@ref chainfilecontents_type).
     761             :     !>
     762             :     !> @param[inout]    CFC             : The number of dimensions of the domain of the objective function.
     763             :     !> @param[in]       startIndex      : The beginning index beyond which the component values will be reset.
     764             :     !> @param[in]       endIndex        : The ending index below which the component values will be reset.
     765           3 :     subroutine nullifyChainFileContents(CFC,startIndex,endIndex)
     766             : #if INTEL_COMPILER_ENABLED && defined DLL_ENABLED && (OS_IS_WINDOWS || defined OS_IS_DARWIN)
     767             :         !DEC$ ATTRIBUTES DLLEXPORT :: nullifyChainFileContents
     768             : #endif
     769             :         implicit none
     770             :         class(ChainFileContents_type), intent(inout)    :: CFC
     771             :         integer(IK), intent(in)                         :: startIndex, endIndex
     772         901 :         CFC%ProcessID   (startIndex:endIndex) = -huge(0_IK)
     773         901 :         CFC%DelRejStage (startIndex:endIndex) = -huge(0_IK)
     774         901 :         CFC%MeanAccRate (startIndex:endIndex) = -huge(0._RK)
     775         901 :         CFC%Adaptation  (startIndex:endIndex) = -huge(0._RK)
     776         901 :         CFC%BurninLoc   (startIndex:endIndex) = -huge(0_IK)
     777         901 :         CFC%Weight      (startIndex:endIndex) = 0_IK
     778         901 :         CFC%LogFunc     (startIndex:endIndex) = -huge(0._RK)
     779        2697 :         CFC%State       (1:CFC%ndim,startIndex:endIndex) = -huge(0._RK)
     780           3 :     end subroutine nullifyChainFileContents
     781             : 
     782             : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
     783             : 
     784             :     !> \brief
     785             :     !> This is a method of the class [ChainFileContents_type](@ref chainfilecontents_type).\n
     786             :     !> Return the length of the header of the chain file.
     787             :     !>
     788             :     !> @param[inout]    CFC             :   The object of class [ChainFileContents_type](@ref chainfilecontents_type).
     789             :     !> @param[in]       ndim            :   The number of dimensions of the domain of the objective function.
     790             :     !> @param[in]       isBinary        :   The logical flag indicating whether the file is in `binary` format.
     791             :     !> @param[in]       chainFileFormat :   The Fortran IO formatting string to be used to read the contents of the chain file (**optional**).
     792             :     !>                                      This argument is only required with a non-binary chain file, i.e., when `isBinary = .false.`.
     793          60 :     subroutine getLenHeader(CFC,ndim,isBinary,chainFileFormat)
     794             : #if INTEL_COMPILER_ENABLED && defined DLL_ENABLED && (OS_IS_WINDOWS || defined OS_IS_DARWIN)
     795             :         !DEC$ ATTRIBUTES DLLEXPORT :: getLenHeader
     796             : #endif
     797             :         use Constants_mod, only: IK ! LCOV_EXCL_LINE
     798             :         use Err_mod, only: abort
     799             :         implicit none
     800             :         class(ChainFileContents_type), intent(inout)    :: CFC
     801             :         integer(IK) , intent(in)                        :: ndim
     802             :         logical     , intent(in)                        :: isBinary
     803             :         character(*), intent(in), optional              :: chainFileFormat
     804             :         character(*), parameter                         :: PROCEDURE_NAME = MODULE_NAME//"@getLenHeader()"
     805          60 :         character(:), allocatable                       :: record
     806             :         integer(IK)                                     :: i
     807          60 :         CFC%Err%occurred = .false.
     808          60 :         allocate( character(99999) :: record )
     809          60 :         if (isBinary) then
     810         120 :             write( record , "(*(g0,:,','))" ) (CFC%ColHeader(i)%record, i=1,CFC%numDefCol+ndim)
     811             :         else
     812          48 :             if ( present(chainFileFormat) ) then
     813         480 :                 write(record,chainFileFormat) (CFC%ColHeader(i)%record, i=1,CFC%numDefCol+ndim)
     814             :             else
     815             :                 ! LCOV_EXCL_START
     816             :                 CFC%Err%occurred = .true.
     817             :                 CFC%Err%msg = PROCEDURE_NAME//"Internal error occurred. For formatted chain files, chainFileFormat must be given."
     818             :                 call abort(CFC%Err)
     819             :                 error stop
     820             :                 return
     821             :                 ! LCOV_EXCL_STOP
     822             :             end if
     823             :         end if
     824          60 :         CFC%lenHeader = len_trim(adjustl(record))
     825          60 :         deallocate(record)
     826          60 :     end subroutine getLenHeader
     827             : 
     828             : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
     829             : 
     830             :     !> \brief
     831             :     !> This is a method of the class [ChainFileContents_type](@ref chainfilecontents_type).\n
     832             :     !> Write the requested header to the chain file.
     833             :     !>
     834             :     !> @param[inout]    CFC             :   The object of class [ChainFileContents_type](@ref chainfilecontents_type).
     835             :     !> @param[in]       ndim            :   The number of dimensions of the domain of the objective function.
     836             :     !> @param[in]       chainFileUnit   :   The unit ID of the chain file to which the header should be written.
     837             :     !> @param[in]       isBinary        :   The logical flag indicating whether the file is in `binary` format.
     838             :     !> @param[in]       chainFileFormat :   The Fortran IO formatting string to be used to read the contents of the chain file (**optional**).
     839             :     !>                                      This argument is only required with a non-binary chain file, i.e., when `isBinary = .false.`.
     840         269 :     subroutine writeHeader(CFC,ndim,chainFileUnit,isBinary,chainFileFormat)
     841             : #if INTEL_COMPILER_ENABLED && defined DLL_ENABLED && (OS_IS_WINDOWS || defined OS_IS_DARWIN)
     842             :         !DEC$ ATTRIBUTES DLLEXPORT :: writeHeader
     843             : #endif
     844          60 :         use Constants_mod, only: IK
     845             :         use Err_mod, only: abort
     846             :         implicit none
     847             :         class(ChainFileContents_type), intent(inout)    :: CFC
     848             :         integer(IK) , intent(in)                        :: ndim, chainFileUnit
     849             :         logical     , intent(in)                        :: isBinary
     850             :         character(*), intent(in), optional              :: chainFileFormat
     851             :         character(*), parameter                         :: PROCEDURE_NAME = MODULE_NAME//"@writeHeader()"
     852         269 :         character(:), allocatable                       :: record
     853             :         integer(IK)                                     :: i
     854         269 :         CFC%Err%occurred = .false.
     855         269 :         if (isBinary) then
     856          20 :             allocate( character(99999) :: record )
     857         198 :             write( record , "(*(g0,:,','))" ) (CFC%ColHeader(i)%record, i=1,CFC%numDefCol+ndim)
     858          20 :             write(chainFileUnit) trim(adjustl(record))
     859          20 :             deallocate(record)
     860             :         else
     861         249 :             if ( present(chainFileFormat) ) then
     862        2380 :                 write(chainFileUnit,chainFileFormat) (CFC%ColHeader(i)%record, i=1,CFC%numDefCol+ndim)
     863             :             else
     864             :                 ! LCOV_EXCL_START
     865             :                 CFC%Err%occurred = .true.
     866             :                 CFC%Err%msg = PROCEDURE_NAME//"Internal error occurred. For formatted chain files, chainFileFormat must be given."
     867             :                 call abort(CFC%Err)
     868             :                 error stop
     869             :                 return
     870             :                 ! LCOV_EXCL_STOP
     871             :             end if
     872             :         end if
     873         269 :     end subroutine writeHeader
     874             : 
     875             : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
     876             : 
     877             :     !> \brief
     878             :     !> This is a method of the class [ChainFileContents_type](@ref chainfilecontents_type).\n
     879             :     !> Write the chain properties to the chain file.
     880             :     !>
     881             :     !> @param[inout]    CFC                     :   The object of class [ChainFileContents_type](@ref chainfilecontents_type).
     882             :     !> @param[in]       ndim                    :   The number of dimensions of the domain of the objective function.
     883             :     !> @param[in]       compactStartIndex       :   The beginning index of the compact chain beyond which the elements of the chain will be written to the output file.
     884             :     !> @param[in]       compactEndIndex         :   The ending index of the compact chain below which the elements of the chain will be written to the output file.
     885             :     !> @param[in]       chainFileUnit           :   The unit ID of the chain file to which the header should be written.
     886             :     !> @param[in]       chainFileForm           :   The file format of the chain file (`"binary"` vs. `"compact"` vs. `"verbose"`).
     887             :     !> @param[in]       chainFileFormat         :   The Fortran IO formatting string to be used to read the contents of the chain file (**optional**).
     888             :     !>                                              This argument is only required with a non-binary chain file, i.e., when `isBinary = .false.`.
     889             :     !> @param[in]       adaptiveUpdatePeriod    :   The adaptive update period (**optional**). It must be provided if `chainFileForm = "verbose"`.
     890          32 :     subroutine writeChainFile(CFC,ndim,compactStartIndex,compactEndIndex,chainFileUnit,chainFileForm,chainFileFormat,adaptiveUpdatePeriod)
     891             : #if INTEL_COMPILER_ENABLED && defined DLL_ENABLED && (OS_IS_WINDOWS || defined OS_IS_DARWIN)
     892             :         !DEC$ ATTRIBUTES DLLEXPORT :: writeChainFile
     893             : #endif
     894         269 :         use Constants_mod, only: IK, RK
     895             :         use Err_mod, only: abort
     896             :         implicit none
     897             :         class(ChainFileContents_type), intent(inout)    :: CFC
     898             :         integer(IK) , intent(in)                        :: ndim, compactStartIndex, compactEndIndex, chainFileUnit
     899             :         character(*), intent(in)                        :: chainFileForm
     900             :         character(*), intent(in), optional              :: chainFileFormat
     901             :         integer(IK) , intent(in), optional              :: adaptiveUpdatePeriod
     902             :         character(*), parameter                         :: PROCEDURE_NAME = MODULE_NAME//"@writeChainFile()"
     903             :         logical                                         :: isBinary, isCompact, isVerbose
     904          32 :         real(RK)                                        :: adaptation
     905             :         integer(IK)                                     :: i,j, counter
     906             : 
     907          32 :         CFC%Err%occurred = .false.
     908             : 
     909          32 :         isBinary = .false.
     910          32 :         isCompact = .false.
     911          32 :         isVerbose = .false.
     912          32 :         if (chainFileForm=="binary") then
     913           8 :             isBinary = .true.
     914          24 :         elseif (chainFileForm=="compact") then
     915          16 :             isCompact = .true.
     916           8 :         elseif (chainFileForm=="verbose") then
     917           8 :             isVerbose = .true.
     918             :         else
     919             :             ! LCOV_EXCL_START
     920             :             CFC%Err%occurred = .true.
     921             :             CFC%Err%msg = PROCEDURE_NAME//"Internal error occurred. Unknown chain file format: "//chainFileForm
     922             :             ! LCOV_EXCL_STOP
     923             :         end if
     924             : 
     925          32 :         if ( .not. isBinary .and. .not. present(chainFileFormat) ) then
     926             :                 ! LCOV_EXCL_START
     927             :                 CFC%Err%occurred = .true.
     928             :                 CFC%Err%msg = PROCEDURE_NAME//"Internal error occurred. For formatted chain files, chainFileFormat must be given."
     929             :                 ! LCOV_EXCL_STOP
     930             :         end if
     931             : 
     932          32 :         if ( isVerbose .and. .not. present(adaptiveUpdatePeriod) ) then
     933             :                 ! LCOV_EXCL_START
     934             :                 CFC%Err%occurred = .true.
     935             :                 CFC%Err%msg = PROCEDURE_NAME//"Internal error occurred. For verbose chain files, adaptiveUpdatePeriod must be given."
     936             :                 ! LCOV_EXCL_STOP
     937             :         end if
     938             : 
     939          32 :         if (CFC%Err%occurred) then
     940             :             ! LCOV_EXCL_START
     941             :             call abort(CFC%Err)
     942             :             return
     943             :             ! LCOV_EXCL_STOP
     944             :         end if
     945             : 
     946          32 :         call CFC%writeHeader(ndim,chainFileUnit,isBinary,chainFileFormat)
     947             : 
     948          32 :         if (compactStartIndex<=compactEndIndex) then
     949          32 :             if (isCompact) then
     950        7984 :                 do i = compactStartIndex, compactEndIndex
     951        7968 :                     write(chainFileUnit,chainFileFormat     ) CFC%ProcessID(i)      &
     952        7968 :                                                             , CFC%DelRejStage(i)    &
     953        7968 :                                                             , CFC%MeanAccRate(i)    &
     954        7968 :                                                             , CFC%Adaptation(i)     &
     955        7968 :                                                             , CFC%BurninLoc(i)      &
     956        7968 :                                                             , CFC%Weight(i)         &
     957        7968 :                                                             , CFC%LogFunc(i)        &
     958       15952 :                                                             , CFC%State(1:ndim,i)
     959             :                 end do
     960          16 :             elseif (isBinary) then
     961        5192 :                 do i = compactStartIndex, compactEndIndex
     962        5184 :                     write(chainFileUnit                     ) CFC%ProcessID(i)      &
     963        5184 :                                                             , CFC%DelRejStage(i)    &
     964        5184 :                                                             , CFC%MeanAccRate(i)    &
     965        5184 :                                                             , CFC%Adaptation(i)     &
     966        5184 :                                                             , CFC%BurninLoc(i)      &
     967        5184 :                                                             , CFC%Weight(i)         &
     968        5184 :                                                             , CFC%LogFunc(i)        &
     969       10376 :                                                             , CFC%State(1:ndim,i)
     970             :                 end do
     971           8 :             elseif (isVerbose) then
     972           8 :                 counter = compactStartIndex
     973        5192 :                 do i = compactStartIndex, compactEndIndex
     974       25871 :                     do j = 1, CFC%Weight(i)
     975       20679 :                         if (mod(counter,adaptiveUpdatePeriod)==0_IK) then
     976       19418 :                             adaptation = CFC%Adaptation(i)
     977             :                         else
     978        1261 :                             adaptation = 0._RK
     979             :                         end if
     980       20679 :                         write(chainFileUnit,chainFileFormat ) CFC%ProcessID(i)      &
     981       20679 :                                                             , CFC%DelRejStage(i)    &
     982       20679 :                                                             , CFC%MeanAccRate(i)    &
     983             :                                                             , adaptation            &
     984       20679 :                                                             , CFC%BurninLoc(i)      &
     985       20679 :                                                             , 1_IK                  &
     986       20679 :                                                             , CFC%LogFunc(i)        &
     987       41358 :                                                             , CFC%State(1:ndim,i)
     988       25863 :                         counter = counter + 1
     989             :                     end do
     990             :                 end do
     991             :             end if
     992             :         end if
     993          32 :         flush(chainFileUnit)
     994          32 :     end subroutine writeChainFile
     995             : 
     996             : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
     997             : 
     998             : end module ParaMonteChainFileContents_mod ! LCOV_EXCL_LINE

ParaMonte: Plain Powerful Parallel Monte Carlo Library 
The Computational Data Science Lab
© Copyright 2012 - 2021