Line data Source code
1 : !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
2 : !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
3 : !!!! !!!!
4 : !!!! ParaMonte: Parallel Monte Carlo and Machine Learning Library. !!!!
5 : !!!! !!!!
6 : !!!! Copyright (C) 2012-present, The Computational Data Science Lab !!!!
7 : !!!! !!!!
8 : !!!! This file is part of the ParaMonte library. !!!!
9 : !!!! !!!!
10 : !!!! LICENSE !!!!
11 : !!!! !!!!
12 : !!!! https://github.com/cdslaborg/paramonte/blob/main/LICENSE.md !!!!
13 : !!!! !!!!
14 : !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
15 : !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
16 :
17 : !> \brief
18 : !> This module contains the **internal** classes and procedures for setting up the attributes of the ParaMonte library DRAM-MCMC samplers.<br>
19 : !>
20 : !> \details
21 : !> For more information, see the description of the attributes within the bodies of their constructors in this module.<br>
22 : !> Alternatively, a description of these simulation specifications is always printed out the in `_report.txt` files of each ParaMonte DRAM-MCMC simulation.
23 : !>
24 : !> \note
25 : !> The contents of this module are not meant to be used by the end users of the ParaMonte library.<br>
26 : !>
27 : !> \devnote
28 : !> The madness seen here with module-level generics is due to the lack of support for PDTs in \gfortran{13.1} and older versions.<br>
29 : !>
30 : !> \finmain
31 : !>
32 : !> \author
33 : !> \AmirShahmoradi, Monday 00:01 AM, January 1, 2018, Institute for Computational Engineering and Sciences, University of Texas Austin
34 :
35 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
36 :
37 : use pm_except, only: isNAN
38 : use pm_except, only: setNAN
39 : use pm_val2str, only: getStr
40 : use pm_arrayResize, only: setResized
41 : use pm_kind, only: SKC => SK, SK, IK, LK
42 : use pm_sampling_mcmc, only: specmcmc_type, astatmcmc_type, burninLoc_type, NL2, NL1
43 : use pm_sampling_scio, only: cfcdram_type
44 :
45 : implicit none
46 :
47 : character(*,SKC) , parameter :: MODULE_NAME = SK_"@pm_sampling_dram"
48 :
49 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
50 : ! simulation declarations.
51 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
52 :
53 : type, abstract, extends(astatmcmc_type) :: astatdram_type
54 : type(burninLoc_type) :: burninLocDRAM
55 : integer(IK) :: numFunCallAcceptedRejectedDelayed = 0_IK
56 : integer(IK) :: numFunCallAcceptedRejectedDelayedUnused = 0_IK
57 : end type
58 :
59 : type, extends(astatdram_type) :: statdram_type
60 : type(cfcdram_type) :: cfc
61 : end type
62 :
63 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
64 : ! specification declarations.
65 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
66 :
67 : !real(RKC) :: burninAdaptationMeasure ! namelist input
68 : type :: burninAdaptationMeasure_type
69 : real(RKC) :: val
70 : real(RKC) :: def
71 : character(:,SKC) , allocatable :: desc
72 : end type
73 :
74 : !integer(IK) :: proposalAdaptationCount ! namelist input
75 : type :: proposalAdaptationCount_type
76 : integer(IK) :: val
77 : integer(IK) :: def
78 : integer(IK) :: null
79 : character(:,SKC) , allocatable :: desc
80 : end type
81 :
82 : !integer(IK) :: proposalAdaptationCountGreedy ! namelist input
83 : type :: proposalAdaptationCountGreedy_type
84 : integer(IK) :: val
85 : integer(IK) :: def
86 : integer(IK) :: null
87 : character(:,SKC) , allocatable :: desc
88 : end type
89 :
90 : !integer(IK) :: proposalAdaptationPeriod ! namelist input
91 : type :: proposalAdaptationPeriod_type
92 : integer(IK) :: val
93 : integer(IK) :: def
94 : integer(IK) :: null
95 : character(:,SKC) , allocatable :: desc
96 : end type
97 :
98 : !integer(IK) :: proposalDelayedRejectionCount ! namelist input
99 : type :: proposalDelayedRejectionCount_type
100 : integer(IK) :: max = 1000_IK
101 : integer(IK) :: min = 0_IK
102 : integer(IK) :: val
103 : integer(IK) :: def
104 : integer(IK) :: null
105 : character(:,SKC) , allocatable :: desc
106 : end type
107 :
108 : !real(RKC) , allocatable :: proposalDelayedRejectionScaleFactor(:) ! namelist input
109 : type :: proposalDelayedRejectionScaleFactor_type
110 : real(RKC) :: def
111 : real(RKC) , allocatable :: val(:)
112 : !real(RKC) , allocatable :: log(:)
113 : character(:,SKC) , allocatable :: desc
114 : end type
115 :
116 : type, extends(specmcmc_type) :: specdram_type
117 : type(burninAdaptationMeasure_type) :: burninAdaptationMeasure
118 : type(proposalAdaptationCount_type) :: proposalAdaptationCount
119 : type(proposalAdaptationCountGreedy_type) :: proposalAdaptationCountGreedy
120 : type(proposalAdaptationPeriod_type) :: proposalAdaptationPeriod
121 : type(proposalDelayedRejectionCount_type) :: proposalDelayedRejectionCount
122 : type(proposalDelayedRejectionScaleFactor_type) :: proposalDelayedRejectionScaleFactor
123 : contains
124 : procedure, pass, private :: sanitize
125 : procedure, pass, private :: report
126 : procedure, pass, public :: set
127 : end type
128 :
129 : interface specdram_type
130 : module procedure :: construct
131 : end interface
132 :
133 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
134 :
135 : contains
136 :
137 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
138 :
139 0 : subroutine killMeAlreadyCMake1_RK5(); use pm_sampling_scio_RK5, only: RKC; end subroutine
140 0 : subroutine killMeAlreadyCMake1_RK4(); use pm_sampling_scio_RK4, only: RKC; end subroutine
141 0 : subroutine killMeAlreadyCMake1_RK3(); use pm_sampling_scio_RK3, only: RKC; end subroutine
142 0 : subroutine killMeAlreadyCMake1_RK2(); use pm_sampling_scio_RK2, only: RKC; end subroutine
143 0 : subroutine killMeAlreadyCMake1_RK1(); use pm_sampling_scio_RK1, only: RKC; end subroutine
144 :
145 0 : subroutine killMeAlreadyCMake2_RK5(); use pm_sampling_mcmc_RK5, only: RKC; end subroutine
146 0 : subroutine killMeAlreadyCMake2_RK4(); use pm_sampling_mcmc_RK4, only: RKC; end subroutine
147 0 : subroutine killMeAlreadyCMake2_RK3(); use pm_sampling_mcmc_RK3, only: RKC; end subroutine
148 0 : subroutine killMeAlreadyCMake2_RK2(); use pm_sampling_mcmc_RK2, only: RKC; end subroutine
149 0 : subroutine killMeAlreadyCMake2_RK1(); use pm_sampling_mcmc_RK1, only: RKC; end subroutine
150 :
151 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
152 :
153 14 : function construct(modelr, method, ndim) result(spec)
154 : #if __INTEL_COMPILER && DLL_ENABLED && (_WIN32 || _WIN64)
155 : !DEC$ ATTRIBUTES DLLEXPORT :: construct
156 : #endif
157 : use pm_kind, only: modelr_type
158 : type(modelr_type), intent(in) :: modelr
159 : character(*,SKC), intent(in) :: method
160 : integer(IK), intent(in) :: ndim
161 : type(specdram_type) :: spec
162 :
163 14 : spec%specmcmc_type = specmcmc_type(modelr, method, ndim)
164 :
165 : burninAdaptationMeasure_block: block
166 : use pm_sampling_scio, only: burninAdaptationMeasure
167 14 : spec%burninAdaptationMeasure%def = 1._RKC
168 : spec%burninAdaptationMeasure%desc = &
169 : SKC_"The simulation specification `burninAdaptationMeasure` is a scalar of type `real` of the highest precision available &
170 : &within the ParaMonte library whose value, between 0 and 1, represents the adaptation measure threshold below which &
171 : &the simulated Markov chain will be used to generate the output sample. In other words, any point in the output Markov &
172 : &chain that has been sampled during significant adaptation of the proposal distribution (set by `burninAdaptationMeasure`) &
173 : &will not be included in constructing the final MCMC output sample. &
174 : &This is to ensure that the generation of the output sample will be based only on the part of the simulated chain that &
175 : &is practically guaranteed to be Markovian and ergodic. If this variable is set to 0, then the output sample will be &
176 : &generated from the part of the chain where no proposal adaptation has occurred. This non-adaptive or minimally-adaptive &
177 : &part of the chain may not even exist if the total adaptation period of the simulation, set by `proposalAdaptationCount` &
178 : &and `proposalAdaptationPeriod` input variables, is longer than the total length of the output MCMC chain. &
179 : &In such cases, the resulting output sample may be zero size. In general, when good mixing occurs &
180 : &(e.g., when the input variable `outputChainSize` is reasonably large), then any specific &
181 : &value of `burninAdaptationMeasure` becomes practically irrelevant. &
182 : &The default value for `burninAdaptationMeasure` is `"//getStr(spec%burninAdaptationMeasure%def)//SKC_"`, implying that the &
183 14 : &entire chain (excluding of an initial automatically-determined burnin period) will be used to generate the final output sample."
184 : !$omp master
185 14 : call setNAN(burninAdaptationMeasure)
186 : !$omp end master
187 : end block burninAdaptationMeasure_block
188 :
189 : proposalAdaptationCount_block: block
190 : use pm_sampling_scio, only: proposalAdaptationCount
191 14 : spec%proposalAdaptationCount%null = -huge(0_IK)
192 14 : spec%proposalAdaptationCount%def = huge(0_IK)
193 : spec%proposalAdaptationCount%desc = &
194 : SKC_"The simulation specification `proposalAdaptationCount` is a scalar of type `integer` representing the total number of &
195 : &adaptive updates that will be made to the parameters of the proposal distribution to increase the efficiency of the sampler &
196 : &thus increasing the overall sampling efficiency of the simulation. Every `proposalAdaptationPeriod` number of calls to the &
197 : &objective function, the parameters of the proposal distribution will be updated until either the total number of adaptive &
198 : &updates reaches the value of `proposalAdaptationCount`. This variable must be a non-negative integer. As a rule of thumb, &
199 : &it may be appropriate to ensure the condition `outputChainSize >> proposalAdaptationPeriod * proposalAdaptationCount` &
200 : &holds to improve the ergodicity and stationarity of the MCMC sampler. If `proposalAdaptationCount` is zero, &
201 : &then the proposal distribution parameters will be fixed to the initial input values &
202 14 : &throughout the entire MCMC sampling. The default value is `"//getStr(spec%proposalAdaptationCount%def)//SKC_"`."
203 : !$omp master
204 14 : proposalAdaptationCount = spec%proposalAdaptationCount%null
205 : !$omp end master
206 : end block proposalAdaptationCount_block
207 :
208 : proposalAdaptationCountGreedy_block: block
209 : use pm_sampling_scio, only: proposalAdaptationCountGreedy
210 14 : spec%proposalAdaptationCountGreedy%null = -huge(0_IK)
211 14 : spec%proposalAdaptationCountGreedy%def = 0_IK
212 : spec%proposalAdaptationCountGreedy%desc = &
213 : SKC_"The simulation specification `proposalAdaptationCountGreedy` is a positive-valued scalar of type `integer` representing the &
214 : &count of initial ""greedy"" adaptive updates the sampler will apply to the proposal distribution before starting regular adaptation. &
215 : &Greedy adaptations are made using only the 'unique' accepted points in the MCMC chain. This is useful, for example, when the function &
216 : &to be sampled by the sampler is high dimensional, in which case, the adaptive updates to proposal distribution will less likely lead to &
217 : &numerical instabilities, such as a singular covariance matrix for the multivariate proposal sampler. &
218 : &The variable `proposalAdaptationCountGreedy` must be less than the specified value for `proposalAdaptationCount`. &
219 : &If larger, it will be automatically reset to `proposalAdaptationCount` for the simulation. &
220 14 : &The default value is `"//getStr(spec%proposalAdaptationCountGreedy%def)//SKC_"`."
221 : !$omp master
222 14 : proposalAdaptationCountGreedy = spec%proposalAdaptationCountGreedy%null
223 : !$omp end master
224 : end block proposalAdaptationCountGreedy_block
225 :
226 : proposalAdaptationPeriod_block: block
227 : use pm_sampling_scio, only: proposalAdaptationPeriod
228 14 : spec%proposalAdaptationPeriod%def = spec%ndim%val * 4_IK !+ 1_IK ! max(ndim+1_IK,100_IK)
229 14 : spec%proposalAdaptationPeriod%null = -huge(0_IK)
230 : spec%proposalAdaptationPeriod%desc = &
231 : SKC_"The simulation specification `proposalAdaptationPeriod` is a positive-valued scalar of type `integer`. &
232 : &Every `proposalAdaptationPeriod` calls to the objective function, the parameters of the proposal distribution will be updated. &
233 : &The smaller the value of `proposalAdaptationPeriod`, the easier it will be for the sampler kernel to adapt the proposal distribution &
234 : &to the covariance structure of the objective function. However, this will happen at the expense of slower simulation runtime as the &
235 : &adaptation process can become computationally expensive, particularly for very high dimensional objective functions (`ndim >> 1`). &
236 : &The larger the value of `proposalAdaptationPeriod`, the easier it will be for the sampler kernel to keep the sampling efficiency &
237 : &close to the requested target acceptance rate range (if specified via the input variable targetAcceptanceRate). However, too large &
238 : &values for `proposalAdaptationPeriod` will only delay the adaptation of the proposal distribution to the global structure of &
239 : &the objective function that is being sampled. If `outputChainSize <= proposalAdaptationPeriod` holds, then no adaptive &
240 : &updates to the proposal distribution will be made. The default value is `4 * ndim`, where `ndim` is the dimension &
241 14 : &of the domain of the objective function to be sampled."
242 : !$omp master
243 14 : proposalAdaptationPeriod = spec%proposalAdaptationPeriod%null
244 : !$omp end master
245 : end block proposalAdaptationPeriod_block
246 :
247 : proposalDelayedRejectionCount_block: block
248 : use pm_sampling_scio, only: proposalDelayedRejectionCount
249 14 : spec%proposalDelayedRejectionCount%null = -huge(0_IK)
250 14 : spec%proposalDelayedRejectionCount%def = 0_IK
251 : spec%proposalDelayedRejectionCount%desc = &
252 : SKC_"The simulation specification `proposalAdaptationPeriod` is a non-negative-valued scalar of type `integer` representing &
253 : &the total number of stages for which rejections of new proposals will be tolerated by MCMC sampler before going back &
254 : &to the previously accepted point (state). The condition `"//&
255 : getStr(spec%proposalDelayedRejectionCount%min)//" <= proposalDelayedRejectionCount <= "//getStr(spec%proposalDelayedRejectionCount%max)//&
256 : SKC_"` must hold. Possible values are:"//NL2//&
257 : SKC_"+ `proposalDelayedRejectionCount = 0`"//NL2//&
258 : SKC_" indicating no deployment of the delayed rejection algorithm."//NL2//&
259 : SKC_"+ `proposalDelayedRejectionCount > 0`"//NL2//&
260 : SKC_" which implies a maximum proposalDelayedRejectionCount number of rejections will be tolerated."//NL2//&
261 : SKC_"For example, setting `proposalDelayedRejectionCount` to `1` means that at any point during the sampling, if a proposal is rejected, &
262 : &the MCMC sampler will not go back to the last sampled state. Instead, it will continue to propose a new state from the last &
263 : &rejected proposal. If the new state is again rejected based on the rules of the MCMC sampler, then the algorithm will not &
264 : &tolerate further rejections, because the maximum number of rejections to be tolerated has been set by the user to be &
265 : &`proposalDelayedRejectionCount = 1`. The algorithm then goes back to the original last-accepted state and will begin &
266 14 : &proposing new states from that location. The default value is `"//getStr(spec%proposalDelayedRejectionCount%def)//SKC_"`."
267 : !$omp master
268 14 : proposalDelayedRejectionCount = spec%proposalDelayedRejectionCount%null
269 : !$omp end master
270 : end block proposalDelayedRejectionCount_block
271 :
272 : proposalDelayedRejectionScaleFactor_block: block
273 : use pm_sampling_scio, only: proposalDelayedRejectionScaleFactor
274 14 : spec%proposalDelayedRejectionScaleFactor%def = 0.5_RKC**(1._RKC / spec%ndim%val) ! This gives a half volume to the covariance.
275 : spec%proposalDelayedRejectionScaleFactor%desc = &
276 : "The simulation specification `proposalDelayedRejectionScaleFactor` is a positive-valued vector of type `real` of the &
277 : &highest precision available within the ParaMonte library, of length `(1 : proposalDelayedRejectionCount)`, by which &
278 : &the covariance matrix of the proposal distribution of the MCMC sampler is scaled when the Delayed Rejection (DR) scheme &
279 : &is activated (by setting `proposalDelayedRejectionCount` to a positive value). At each `i`th stage of the DR process, &
280 : &the proposal distribution from the last stage is scaled by the factor `proposalDelayedRejectionScaleFactor(i)`. &
281 : &Missing elements of the `proposalDelayedRejectionScaleFactor` in the input external file to the sampler will be set to &
282 : &the default value. The default value at all stages is `0.5**(1 / ndim)` where `ndim` is the number of dimensions of the &
283 : &domain of the objective function. This default value effectively reduces the volume of the covariance matrix &
284 14 : &of the proposal distribution by half compared to the last DR stage."
285 : !$omp master
286 14 : call setResized(proposalDelayedRejectionScaleFactor, spec%proposalDelayedRejectionCount%max)
287 14014 : call setNAN(proposalDelayedRejectionScaleFactor)
288 : !$omp end master
289 : end block proposalDelayedRejectionScaleFactor_block
290 :
291 : !$omp barrier
292 :
293 70 : end function construct
294 :
295 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
296 :
297 13 : function set(spec, sampler) result(err)
298 : #if __INTEL_COMPILER && DLL_ENABLED && (_WIN32 || _WIN64)
299 : !DEC$ ATTRIBUTES DLLEXPORT :: set
300 : #endif
301 : use pm_err, only: err_type
302 : use pm_sampling, only: paradram_type
303 : use pm_sampling, only: sampler_type
304 : class(specdram_type), intent(inout) :: spec
305 : class(sampler_type), intent(in), optional :: sampler
306 : type(err_type) :: err
307 :
308 : select type(sampler)
309 : type is (paradram_type)
310 :
311 13 : err = spec%specmcmc_type%set(sampler%paramcmc_type)
312 13 : if (err%occurred) return
313 :
314 : burninAdaptationMeasure_block: block
315 : use pm_sampling_scio, only: burninAdaptationMeasure
316 13 : if (spec%overridable .and. allocated(sampler%burninAdaptationMeasure)) then
317 0 : spec%burninAdaptationMeasure%val = real(sampler%burninAdaptationMeasure, RKC)
318 : else
319 13 : spec%burninAdaptationMeasure%val = burninAdaptationMeasure
320 : end if
321 13 : if (isNAN(spec%burninAdaptationMeasure%val)) spec%burninAdaptationMeasure%val = spec%burninAdaptationMeasure%def
322 : end block burninAdaptationMeasure_block
323 :
324 : proposalAdaptationCount_block: block
325 : use pm_sampling_scio, only: proposalAdaptationCount
326 13 : if (spec%overridable .and. allocated(sampler%proposalAdaptationCount)) then
327 0 : spec%proposalAdaptationCount%val = sampler%proposalAdaptationCount
328 : else
329 13 : spec%proposalAdaptationCount%val = proposalAdaptationCount
330 : end if
331 13 : if (spec%proposalAdaptationCount%val == spec%proposalAdaptationCount%null) spec%proposalAdaptationCount%val = spec%proposalAdaptationCount%def
332 : end block proposalAdaptationCount_block
333 :
334 : proposalAdaptationCountGreedy_block: block
335 : use pm_sampling_scio, only: proposalAdaptationCountGreedy
336 13 : if (spec%overridable .and. allocated(sampler%proposalAdaptationCountGreedy)) then
337 0 : spec%proposalAdaptationCountGreedy%val = sampler%proposalAdaptationCountGreedy
338 : else
339 13 : spec%proposalAdaptationCountGreedy%val = proposalAdaptationCountGreedy
340 : end if
341 13 : if (spec%proposalAdaptationCountGreedy%val == spec%proposalAdaptationCountGreedy%null) spec%proposalAdaptationCountGreedy%val = spec%proposalAdaptationCountGreedy%def
342 : end block proposalAdaptationCountGreedy_block
343 :
344 : proposalAdaptationPeriod_block: block
345 : use pm_sampling_scio, only: proposalAdaptationPeriod
346 13 : if (spec%overridable .and. allocated(sampler%proposalAdaptationPeriod)) then
347 0 : spec%proposalAdaptationPeriod%val = sampler%proposalAdaptationPeriod
348 : else
349 13 : spec%proposalAdaptationPeriod%val = proposalAdaptationPeriod
350 : end if
351 13 : if (spec%proposalAdaptationPeriod%val == spec%proposalAdaptationPeriod%null) spec%proposalAdaptationPeriod%val = spec%proposalAdaptationPeriod%def
352 : end block proposalAdaptationPeriod_block
353 :
354 : proposalDelayedRejectionCount_block: block
355 : use pm_sampling_scio, only: proposalDelayedRejectionCount
356 13 : if (spec%overridable .and. allocated(sampler%proposalDelayedRejectionCount)) then
357 0 : spec%proposalDelayedRejectionCount%val = sampler%proposalDelayedRejectionCount
358 : else
359 13 : spec%proposalDelayedRejectionCount%val = proposalDelayedRejectionCount
360 : end if
361 13 : if (spec%proposalDelayedRejectionCount%val == spec%proposalDelayedRejectionCount%null) spec%proposalDelayedRejectionCount%val = spec%proposalDelayedRejectionCount%def
362 : end block proposalDelayedRejectionCount_block
363 :
364 : proposalDelayedRejectionScaleFactor_block: block
365 : use pm_sampling_scio, only: proposalDelayedRejectionScaleFactor
366 : use pm_arrayFill, only: getFilled
367 : integer(IK) :: idel
368 13 : if (spec%overridable .and. allocated(sampler%proposalDelayedRejectionScaleFactor)) then
369 0 : spec%proposalDelayedRejectionScaleFactor%val = real(sampler%proposalDelayedRejectionScaleFactor, RKC)
370 : else
371 13003 : do idel = size(proposalDelayedRejectionScaleFactor, 1, IK), 1, -1
372 13003 : if (.not. isNAN(proposalDelayedRejectionScaleFactor(idel))) exit
373 : end do
374 36 : spec%proposalDelayedRejectionScaleFactor%val = proposalDelayedRejectionScaleFactor(1 : idel)
375 : end if
376 13 : if (0_IK < size(spec%proposalDelayedRejectionScaleFactor%val, 1, IK)) then
377 12 : where (isNAN(spec%proposalDelayedRejectionScaleFactor%val))
378 : spec%proposalDelayedRejectionScaleFactor%val = spec%proposalDelayedRejectionScaleFactor%def
379 : end where
380 11 : elseif (0_IK < spec%proposalDelayedRejectionCount%val) then
381 0 : spec%proposalDelayedRejectionScaleFactor%val = getFilled(spec%proposalDelayedRejectionScaleFactor%def, spec%proposalDelayedRejectionCount%val)
382 : else
383 11 : call setResized(spec%proposalDelayedRejectionScaleFactor%val, 0_IK)
384 : end if
385 : end block proposalDelayedRejectionScaleFactor_block
386 :
387 : ! Take care of exceptional cases.
388 :
389 : block
390 : integer(IK) :: idel, remaining
391 13 : remaining = spec%proposalDelayedRejectionCount%val - size(spec%proposalDelayedRejectionScaleFactor%val, 1, IK)
392 13 : if (0_IK < remaining) then
393 0 : spec%proposalDelayedRejectionScaleFactor%val = [spec%proposalDelayedRejectionScaleFactor%val, (spec%proposalDelayedRejectionScaleFactor%def, idel = 1, remaining)]
394 : end if
395 : end block
396 :
397 : ! open output files, report and sanitize.
398 :
399 13 : if (spec%image%is%leader) call spec%report() ! if (spec%run%is%new)
400 26 : call spec%sanitize(err)
401 :
402 : class default
403 : error stop "The input `sampler` must be of type `paradram_type`." ! LCOV_EXCL_LINE
404 : end select
405 :
406 26 : end function
407 :
408 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
409 :
410 13 : subroutine report(spec)
411 : #if __INTEL_COMPILER && DLL_ENABLED && (_WIN32 || _WIN64)
412 : !DEC$ ATTRIBUTES DLLEXPORT :: report
413 : #endif
414 : use pm_str, only: UNDEFINED
415 : class(specdram_type), intent(inout) :: spec
416 :
417 13 : call spec%disp%text%wrap(NL1//spec%method%val//SKC_".simulation.specifications.dram"//NL1)
418 :
419 : associate(ndim => spec%ndim%val, format => spec%reportFile%format%generic)
420 :
421 13 : call spec%disp%show("burninAdaptationMeasure")
422 13 : call spec%disp%show(spec%burninAdaptationMeasure%val, format = format)
423 13 : call spec%disp%note%show(spec%burninAdaptationMeasure%desc)
424 :
425 13 : call spec%disp%show("proposalAdaptationCount")
426 13 : call spec%disp%show(spec%proposalAdaptationCount%val, format = format)
427 13 : call spec%disp%note%show(spec%proposalAdaptationCount%desc)
428 :
429 13 : call spec%disp%show("proposalAdaptationCountGreedy")
430 13 : call spec%disp%show(spec%proposalAdaptationCountGreedy%val, format = format)
431 13 : call spec%disp%note%show(spec%proposalAdaptationCountGreedy%desc)
432 :
433 13 : call spec%disp%show("proposalAdaptationPeriod")
434 13 : call spec%disp%show(spec%proposalAdaptationPeriod%val, format = format)
435 13 : call spec%disp%note%show(spec%proposalAdaptationPeriod%desc)
436 :
437 13 : call spec%disp%show("proposalDelayedRejectionCount")
438 13 : call spec%disp%show(spec%proposalDelayedRejectionCount%val, format = format)
439 13 : call spec%disp%note%show(spec%proposalDelayedRejectionCount%desc)
440 :
441 13 : call spec%disp%show("proposalDelayedRejectionScaleFactor")
442 13 : if (size(spec%proposalDelayedRejectionScaleFactor%val) == 0) then
443 11 : call spec%disp%show(UNDEFINED, format = format)
444 : else
445 6 : call spec%disp%show(reshape(spec%proposalDelayedRejectionScaleFactor%val, [size(spec%proposalDelayedRejectionScaleFactor%val), 1]), format = format)
446 : end if
447 26 : call spec%disp%note%show(spec%proposalDelayedRejectionScaleFactor%desc)
448 :
449 : end associate
450 :
451 13 : end subroutine
452 :
453 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
454 :
455 13 : subroutine sanitize(spec, err)
456 : #if __INTEL_COMPILER && DLL_ENABLED && (_WIN32 || _WIN64)
457 : !DEC$ ATTRIBUTES DLLEXPORT :: sanitize
458 : #endif
459 : use pm_err, only: err_type, getFine
460 : type(err_type), intent(inout) :: err
461 : class(specdram_type), intent(inout) :: spec
462 : character(*,SKC), parameter :: PROCEDURE_NAME = MODULE_NAME//SKC_"@sanitizeSpecDRAM()"
463 :
464 : burninAdaptationMeasure_block: block
465 13 : if (spec%burninAdaptationMeasure%val < 0._RKC) then
466 0 : err%occurred = .true._LK
467 : err%msg = err%msg//NL2//PROCEDURE_NAME//getFine(__FILE__, __LINE__)//SKC_": Error occurred. &
468 : &The input specification `burninAdaptationMeasure` ("//getStr(spec%burninAdaptationMeasure%val)//SKC_") cannot be less than 0. &
469 : &If you are unsure of the appropriate value for burninAdaptationMeasure, drop it from the input list. &
470 0 : &The sampler will automatically assign an appropriate value to it."
471 : end if
472 13 : if (1._RKC < spec%burninAdaptationMeasure%val) then
473 0 : err%occurred = .true._LK
474 : err%msg = err%msg//NL2//PROCEDURE_NAME//getFine(__FILE__, __LINE__)//SKC_": Error occurred. &
475 : &The input specification `burninAdaptationMeasure` ("//getStr(spec%burninAdaptationMeasure%val)//SKC_") cannot be larger than 1. &
476 : &If you are unsure of the appropriate value for burninAdaptationMeasure, drop it from the input list. &
477 0 : &The sampler will automatically assign an appropriate value to it."
478 : end if
479 : end block burninAdaptationMeasure_block
480 :
481 : proposalAdaptationCount_block: block
482 13 : if (spec%proposalAdaptationCount%val < 0_IK) then
483 0 : err%occurred = .true._LK
484 : err%msg = err%msg//NL2//PROCEDURE_NAME//SKC_"@sanitize(): Error occurred. &
485 : &The input requested value for `proposalAdaptationCount` ("//getStr(spec%proposalAdaptationCount%val)//SKC_") &
486 : &cannot be negative. If you are unsure of the appropriate value for `proposalAdaptationCount`, drop it from &
487 0 : &the input list. The sampler will automatically assign an appropriate value to it."
488 : end if
489 : end block proposalAdaptationCount_block
490 :
491 : proposalAdaptationCountGreedy_block: block
492 13 : if (spec%proposalAdaptationCountGreedy%val < 0_IK) then
493 0 : err%occurred = .true._LK
494 : err%msg = err%msg//NL2//MODULE_NAME//SKC_"@sanitize(): Error occurred. &
495 : &The input requested value for `proposalAdaptationCountGreedy` ("//getStr(spec%proposalAdaptationCountGreedy%val)//SKC_") cannot be negative. &
496 : &If you are unsure of the appropriate value for `proposalAdaptationCountGreedy`, drop it from the input list. &
497 0 : &The sampler will automatically assign an appropriate value to it."
498 : end if
499 : end block proposalAdaptationCountGreedy_block
500 :
501 : proposalAdaptationPeriod_block: block
502 13 : if (spec%proposalAdaptationPeriod%val < 1_IK) then
503 0 : err%occurred = .true._LK
504 : err%msg = err%msg//NL2//MODULE_NAME//SKC_"@sanitize(): Error occurred. &
505 : &The input requested value for `proposalAdaptationPeriod` ("//getStr(spec%proposalAdaptationPeriod%val)//SKC_") cannot be less than 1. &
506 : &If you are unsure of the appropriate value for proposalAdaptationPeriod, drop it from the input list. &
507 0 : &The sampler will automatically assign an appropriate value to it."
508 : end if
509 : end block proposalAdaptationPeriod_block
510 :
511 : proposalDelayedRejectionCount_block: block
512 13 : if (spec%proposalDelayedRejectionCount%val < spec%proposalDelayedRejectionCount%min) then
513 0 : err%occurred = .true._LK
514 : err%msg = err%msg//NL2//PROCEDURE_NAME//getFine(__FILE__, __LINE__)//SKC_": Error occurred. &
515 : &The input requested value for `proposalDelayedRejectionCount` ("//getStr(spec%proposalDelayedRejectionCount%val)//"SKC_) cannot be negative. &
516 : &If you are unsure of the appropriate value for `proposalDelayedRejectionCount`, drop it from the input list. &
517 0 : &The MCMC sampler will automatically assign an appropriate value to it."
518 13 : elseif (spec%proposalDelayedRejectionCount%val > spec%proposalDelayedRejectionCount%max) then
519 : err%occurred = .true._LK ! LCOV_EXCL_LINE
520 : err%msg = err%msg//NL2//PROCEDURE_NAME//getFine(__FILE__, __LINE__)//SKC_": Error occurred. &
521 : &The input requested value for `proposalDelayedRejectionCount` ("//getStr(spec%proposalDelayedRejectionCount%val)//SKC_") can not be > "// &
522 : getStr(spec%proposalDelayedRejectionCount%max)//SKC_". If you are unsure of the appropriate value for &
523 : &`proposalDelayedRejectionCount`, drop it from the input list. The MCMC sampler will &
524 0 : &automatically assign an appropriate value to it."
525 : end if
526 : end block proposalDelayedRejectionCount_block
527 :
528 : proposalDelayedRejectionScaleFactor_block: block
529 : use pm_sampling_scio, only: proposalDelayedRejectionScaleFactor
530 : integer(IK) :: idel
531 13 : if (size(spec%proposalDelayedRejectionScaleFactor%val, 1, IK) /= spec%proposalDelayedRejectionCount%val) then
532 0 : err%occurred = .true._LK
533 : err%msg = err%msg//NL2//PROCEDURE_NAME//getFine(__FILE__, __LINE__)//SKC_": Error occurred. The length of the vector `proposalDelayedRejectionScaleFactor` ("//&
534 : getStr(size(spec%proposalDelayedRejectionScaleFactor%val))//SKC_") is not equal to proposalDelayedRejectionCount = "//&
535 : getStr(spec%proposalDelayedRejectionCount%val)//SKC_". If you are unsure how to set the values of `proposalDelayedRejectionScaleFactor`, &
536 0 : &drop it from the input. The sampler will automatically set the appropriate value for `proposalDelayedRejectionScaleFactor`."
537 : end if
538 23 : do idel = 1, size(spec%proposalDelayedRejectionScaleFactor%val, 1, IK)
539 23 : if (spec%proposalDelayedRejectionScaleFactor%val(idel) <= 0._RKC) then
540 : ! spec%proposalDelayedRejectionScaleFactor%log(idel) = log(spec%proposalDelayedRejectionScaleFactor%val(idel))
541 : !else
542 0 : err%occurred = .true._LK
543 : err%msg = err%msg//NL2//PROCEDURE_NAME//getFine(__FILE__, __LINE__)//SKC_": Error occurred. The input value for the element `"//getStr(idel)//&
544 0 : SKC_"` of the variable proposalDelayedRejectionScaleFactor cannot be smaller than or equal to 0."
545 : end if
546 : end do
547 : !$omp barrier
548 : !$omp master
549 13 : if (allocated(proposalDelayedRejectionScaleFactor)) deallocate(proposalDelayedRejectionScaleFactor)
550 : !$omp end master
551 : end block proposalDelayedRejectionScaleFactor_block
552 :
553 13 : end subroutine
554 :
555 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
|
