ParaMonte Fortran 2.0.0
Parallel Monte Carlo and Machine Learning Library
See the latest version documentation.
test_pm_statistics.F90
Go to the documentation of this file.
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
24
25!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
26
27module test_pm_statistics
28
29 use pm_statistics
30 use pm_err, only: err_type
31 use pm_test, only: test_type, LK
32 implicit none
33
34 private
35 public :: setTest
36 type(test_type) :: test
37
38 !integer(IK) , parameter :: lenRnd = 50_IK
39 !real(RK) :: UnifRnd(lenRnd) = [ 0.0759666916908419_RK &
40 ! , 0.2399161535536580_RK &
41 ! , 0.1233189348351660_RK &
42 ! , 0.1839077882824170_RK &
43 ! , 0.2399525256649030_RK &
44 ! , 0.4172670690843700_RK &
45 ! , 0.0496544303257421_RK &
46 ! , 0.9027161099152810_RK &
47 ! , 0.9447871897216460_RK &
48 ! , 0.4908640924680800_RK &
49 ! , 0.4892526384000190_RK &
50 ! , 0.3377194098213770_RK &
51 ! , 0.9000538464176620_RK &
52 ! , 0.3692467811202150_RK &
53 ! , 0.1112027552937870_RK &
54 ! , 0.7802520683211380_RK &
55 ! , 0.3897388369612530_RK &
56 ! , 0.2416912859138330_RK &
57 ! , 0.4039121455881150_RK &
58 ! , 0.0964545251683886_RK &
59 ! , 0.1319732926063350_RK &
60 ! , 0.9420505907754850_RK &
61 ! , 0.9561345402298020_RK &
62 ! , 0.5752085950784660_RK &
63 ! , 0.0597795429471558_RK &
64 ! , 0.2347799133724060_RK &
65 ! , 0.3531585712220710_RK &
66 ! , 0.8211940401979590_RK &
67 ! , 0.0154034376515551_RK &
68 ! , 0.0430238016578078_RK &
69 ! , 0.1689900294627040_RK &
70 ! , 0.6491154749564520_RK &
71 ! , 0.7317223856586700_RK &
72 ! , 0.6477459631363070_RK &
73 ! , 0.4509237064309450_RK &
74 ! , 0.5470088922863450_RK &
75 ! , 0.2963208056077730_RK &
76 ! , 0.7446928070741560_RK &
77 ! , 0.1889550150325450_RK &
78 ! , 0.6867754333653150_RK &
79 ! , 0.1835111557372700_RK &
80 ! , 0.3684845964903370_RK &
81 ! , 0.6256185607296900_RK &
82 ! , 0.7802274351513770_RK &
83 ! , 0.0811257688657853_RK &
84 ! , 0.9293859709687300_RK &
85 ! , 0.7757126786084020_RK &
86 ! , 0.4867916324031720_RK &
87 ! , 0.4358585885809190_RK &
88 ! , 0.4467837494298060_RK ]
89
90 !real(RK) :: StdNormRnd1(lenRnd) = [ 0.537667139546100_RK &
91 ! , 1.83388501459509_RK &
92 ! , -2.25884686100365_RK &
93 ! , 0.862173320368121_RK &
94 ! , 0.318765239858981_RK &
95 ! , -1.30768829630527_RK &
96 ! , -0.433592022305684_RK &
97 ! , 0.342624466538650_RK &
98 ! , 3.57839693972576_RK &
99 ! , 2.76943702988488_RK &
100 ! , -1.34988694015652_RK &
101 ! , 3.03492346633185_RK &
102 ! , 0.725404224946106_RK &
103 ! , -0.0630548731896562_RK &
104 ! , 0.714742903826096_RK &
105 ! , -0.204966058299775_RK &
106 ! , -0.124144348216312_RK &
107 ! , 1.48969760778547_RK &
108 ! , 1.40903448980048_RK &
109 ! , 1.41719241342961_RK &
110 ! , 0.671497133608081_RK &
111 ! , -1.20748692268504_RK &
112 ! , 0.717238651328839_RK &
113 ! , 1.63023528916473_RK &
114 ! , 0.488893770311789_RK &
115 ! , 1.03469300991786_RK &
116 ! , 0.726885133383238_RK &
117 ! , -0.303440924786016_RK &
118 ! , 0.293871467096658_RK &
119 ! , -0.787282803758638_RK &
120 ! , 0.888395631757642_RK &
121 ! , -1.14707010696915_RK &
122 ! , -1.06887045816803_RK &
123 ! , -0.809498694424876_RK &
124 ! , -2.94428416199490_RK &
125 ! , 1.43838029281510_RK &
126 ! , 0.325190539456198_RK &
127 ! , -0.754928319169703_RK &
128 ! , 1.37029854009523_RK &
129 ! , -1.71151641885370_RK &
130 ! , -0.102242446085491_RK &
131 ! , -0.241447041607358_RK &
132 ! , 0.319206739165502_RK &
133 ! , 0.312858596637428_RK &
134 ! , -0.864879917324457_RK &
135 ! , -0.0300512961962686_RK &
136 ! , -0.164879019209038_RK &
137 ! , 0.627707287528727_RK &
138 ! , 1.09326566903948_RK &
139 ! , 1.10927329761440_RK ]
140 !
141 !real(RK) :: StdNormRnd2(lenRnd) = [ -0.863652821988714_RK &
142 ! , 0.0773590911304249_RK &
143 ! , -1.21411704361541_RK &
144 ! , -1.11350074148676_RK &
145 ! , -0.00684932810334806_RK &
146 ! , 1.53263030828475_RK &
147 ! , -0.769665913753682_RK &
148 ! , 0.371378812760058_RK &
149 ! , -0.225584402271252_RK &
150 ! , 1.11735613881447_RK &
151 ! , -1.08906429505224_RK &
152 ! , 0.0325574641649735_RK &
153 ! , 0.552527021112224_RK &
154 ! , 1.10061021788087_RK &
155 ! , 1.54421189550395_RK &
156 ! , 0.0859311331754255_RK &
157 ! , -1.49159031063761_RK &
158 ! , -0.742301837259857_RK &
159 ! , -1.06158173331999_RK &
160 ! , 2.35045722400204_RK &
161 ! , -0.615601881466894_RK &
162 ! , 0.748076783703985_RK &
163 ! , -0.192418510588264_RK &
164 ! , 0.888610425420721_RK &
165 ! , -0.764849236567874_RK &
166 ! , -1.40226896933876_RK &
167 ! , -1.42237592509150_RK &
168 ! , 0.488193909859941_RK &
169 ! , -0.177375156618825_RK &
170 ! , -0.196053487807333_RK &
171 ! , 1.41931015064255_RK &
172 ! , 0.291584373984183_RK &
173 ! , 0.197811053464361_RK &
174 ! , 1.58769908997406_RK &
175 ! , -0.804465956349547_RK &
176 ! , 0.696624415849607_RK &
177 ! , 0.835088165072682_RK &
178 ! , -0.243715140377952_RK &
179 ! , 0.215670086403744_RK &
180 ! , -1.16584393148205_RK &
181 ! , -1.14795277889859_RK &
182 ! , 0.104874716016494_RK &
183 ! , 0.722254032225002_RK &
184 ! , 2.58549125261624_RK &
185 ! , -0.666890670701386_RK &
186 ! , 0.187331024578940_RK &
187 ! , -0.0824944253709554_RK &
188 ! , -1.93302291785099_RK &
189 ! , -0.438966153934773_RK &
190 ! , -1.79467884145512_RK ]
191
192!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
193
194contains
195
196!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
197
198 subroutine setTest()
199
200 test = test_type(MODULE_NAME)
201 call test%run(test_getRandLogn_1, SK_"test_getRandLogn_1")
202 call test%run(test_getRandBeta_1, SK_"test_getRandBeta_1")
203 call test%run(test_getRandGamma_1, SK_"test_getRandGamma_1")
204 call test%run(test_getLogProbMVU_1, SK_"test_getLogProbMVU_1")
205 call test%run(test_getRandCorMat_1, SK_"test_getRandCorMat_1")
206 call test%run(test_getLogProbGeo_1, SK_"test_getLogProbGeo_1")
207 call test%run(test_getUniformCDF_1, SK_"test_getUniformCDF_1")
208 call test%run(test_getUnifRandorm_1, SK_"test_getUnifRandorm_1")
209 call test%run(test_getBetaCDF_RK1_1, SK_"test_getBetaCDF_RK1_1")
210 call test%run(test_getBetaCDF_RK2_1, SK_"test_getBetaCDF_RK2_1")
211 call test%run(test_getLogProbLognSP_1, SK_"test_getLogProbLognSP_1")
212 call test%run(test_getLogProbLognMP_1, SK_"test_getLogProbLognMP_1")
213 call test%run(test_getRandIntLecuyer_1, SK_"test_getRandIntLecuyer_1")
214 call test%run(test_getRandRealLecuyer_1, SK_"test_getRandRealLecuyer_1")
215 call test%run(test_getLogProbNormSP_RK_1, SK_"test_getLogProbNormSP_RK_1")
216 call test%run(test_getLogProbNormMP_RK_1, SK_"test_getLogProbNormMP_RK_1")
217 !call test%run(test_getLogProbNormSP_CK_1, SK_"test_getLogProbNormSP_CK_1")
218 !call test%run(test_getLogProbNormMP_CK_1, SK_"test_getLogProbNormMP_CK_1")
219 call test%run(test_getLogProbGeoCyclic_1, SK_"test_getLogProbGeoCyclic_1")
220 call test%run(test_getRandGammaIntShape_1, SK_"test_getRandGammaIntShape_1")
221 call test%run(test_getLogProbMixMVNSP_RK_1, SK_"test_getLogProbMixMVNSP_RK_1")
222 call test%run(test_getLogProbMixMVNMP_RK_1, SK_"test_getLogProbMixMVNMP_RK_1")
223 !call test%run(test_getLogProbMixMVNSP_CK_1, SK_"test_getLogProbMixMVNSP_CK_1")
224 !call test%run(test_getLogProbMixMVNMP_CK_1, SK_"test_getLogProbMixMVNMP_CK_1")
225 call test%run(test_getRandCorMatRejection_1, SK_"test_getRandCorMatRejection_1")
226 call test%run(test_getLogProbMixNormSP_RK_1, SK_"test_getLogProbMixNormSP_RK_1")
227 call test%run(test_getLogProbMixNormMP_RK_1, SK_"test_getLogProbMixNormMP_RK_1")
228 !call test%run(test_getLogProbMixNormSP_CK_1, SK_"test_getLogProbMixNormSP_CK_1")
229 !call test%run(test_getLogProbMixNormMP_CK_1, SK_"test_getLogProbMixNormMP_CK_1")
230 call test%summarize()
231
232 end subroutine setTest
233
234!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
235
236 function test_getLogProbNormSP_RK_1() result(assertion)
237
238 use pm_kind, only: IK, RK
239 implicit none
240
241 logical(LK) :: assertion
242 real(RK) , parameter :: mean = 3._RK
243 real(RK) , parameter :: point = 2._RK
244 real(RK) , parameter :: inverseVariance = 1._RK / 16._RK
245 real(RK) , parameter :: logProbNorm_ref = -2.336482894324563_RK
246 real(RK) , parameter :: logSqrtInverseVariance = log(sqrt(inverseVariance))
247 real(RK) , parameter :: tolerance = 1.e-12_RK
248 real(RK) :: logProbNorm
249 real(RK) :: difference
250
251 logProbNorm = getLogProbNormSP_RK( mean = mean &
252 , inverseVariance = inverseVariance &
253 , logSqrtInverseVariance = logSqrtInverseVariance &
254 , point = point &
255 )
256
257 difference = abs( (logProbNorm - logProbNorm_ref) / logProbNorm_ref )
258 assertion = difference <= tolerance
259
260 ! LCOV_EXCL_START
261 if (test%traceable .and. .not. assertion) then
262 write(test%disp%unit,"(*(g0,:,', '))")
263 write(test%disp%unit,"(*(g0,:,', '))") "LogProbNorm_ref ", logProbNorm_ref
264 write(test%disp%unit,"(*(g0,:,', '))") "LogProbNorm ", logProbNorm
265 write(test%disp%unit,"(*(g0,:,', '))") "Difference ", difference
266 write(test%disp%unit,"(*(g0,:,', '))")
267 end if
268 ! LCOV_EXCL_STOP
269
270 end function test_getLogProbNormSP_RK_1
271
272!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
273
274 function test_getLogProbNormMP_RK_1() result(assertion)
275
276 use pm_kind, only: IK, RK
277 implicit none
278
279 logical(LK) :: assertion
280 integer(IK) , parameter :: np = 2_IK
281 real(RK) , parameter :: mean = 3._RK
282 real(RK) , parameter :: point(np) = [2._RK, 3._RK]
283 real(RK) , parameter :: inverseVariance = 1._RK / 16._RK
284 real(RK) , parameter :: logProbNorm_ref(np) = [ -2.336482894324563_RK, -2.305232894324563_RK ]
285 real(RK) , parameter :: logSqrtInverseVariance = log(sqrt(inverseVariance))
286 real(RK) , parameter :: tolerance = 1.e-12_RK
287 real(RK) :: logProbNorm(np)
288 real(RK) :: difference(np)
289
290 logProbNorm = getLogProbNormMP_RK( np = np &
291 , mean = mean &
292 , inverseVariance = inverseVariance &
293 , logSqrtInverseVariance = logSqrtInverseVariance &
294 , point = point &
295 )
296
297 difference = abs( (logProbNorm - logProbNorm_ref) / logProbNorm_ref )
298 assertion = all(difference <= tolerance)
299
300 ! LCOV_EXCL_START
301 if (test%traceable .and. .not. assertion) then
302 write(test%disp%unit,"(*(g0,:,', '))")
303 write(test%disp%unit,"(*(g0,:,', '))") "LogProbNorm_ref ", logProbNorm_ref
304 write(test%disp%unit,"(*(g0,:,', '))") "LogProbNorm ", logProbNorm
305 write(test%disp%unit,"(*(g0,:,', '))") "Difference ", difference
306 write(test%disp%unit,"(*(g0,:,', '))")
307 end if
308 ! LCOV_EXCL_STOP
309
310 end function test_getLogProbNormMP_RK_1
311
312!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
313!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
314!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
315
316 function test_getLogProbNormSP_CK_1() result(assertion)
317
318 use pm_kind, only: IK, RK, CK
319 implicit none
320
321 logical(LK) :: assertion
322 real(RK) , parameter :: tolerance = 1.e-12_RK
323 complex(CK) , parameter :: mean = 3._RK
324 complex(CK) , parameter :: point = cmplx(2._RK,kind=RK)
325 complex(CK) , parameter :: inverseVariance = cmplx(1._RK / 16._RK,kind=RK)
326 complex(CK) , parameter :: logProbNorm_ref = cmplx(-2.336482894324563_RK,kind=RK)
327 complex(CK) , parameter :: logSqrtInverseVariance = cmplx(log(sqrt(inverseVariance)),kind=RK)
328 complex(CK) :: logProbNorm
329 real(RK) :: difference
330
331 logProbNorm = getLogProbNormSP_CK( mean = mean &
332 , inverseVariance = inverseVariance &
333 , logSqrtInverseVariance = logSqrtInverseVariance &
334 , point = point &
335 )
336
337 difference = abs( real(logProbNorm - logProbNorm_ref,kind=RK) / real(logProbNorm_ref,kind=RK) )
338 assertion = difference <= tolerance
339
340 ! LCOV_EXCL_START
341 if (test%traceable .and. .not. assertion) then
342 write(test%disp%unit,"(*(g0,:,', '))")
343 write(test%disp%unit,"(*(g0,:,', '))") "LogProbNorm_ref ", real(logProbNorm_ref, kind = RK)
344 write(test%disp%unit,"(*(g0,:,', '))") "LogProbNorm ", real(logProbNorm, kind = RK)
345 write(test%disp%unit,"(*(g0,:,', '))") "Difference ", real(difference, kind = RK)
346 write(test%disp%unit,"(*(g0,:,', '))")
347 end if
348 ! LCOV_EXCL_STOP
349
350 end function test_getLogProbNormSP_CK_1
351
352!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
353
354 function test_getLogProbNormMP_CK_1() result(assertion)
355
356 use pm_kind, only: IK, RK, CK
357 implicit none
358
359 logical(LK) :: assertion
360 real(RK) , parameter :: tolerance = 1.e-12_RK
361 integer(IK) , parameter :: np = 2_IK
362 complex(CK) , parameter :: mean = 3._RK
363 complex(CK) , parameter :: point(np) = cmplx([2._RK, 3._RK], kind=RK)
364 complex(CK) , parameter :: inverseVariance = cmplx(1._RK / 16._RK, kind=RK)
365 complex(CK) , parameter :: logProbNorm_ref(np) = cmplx([ -2.336482894324563_RK, -2.305232894324563_RK ], kind=RK)
366 complex(CK) , parameter :: logSqrtInverseVariance = cmplx(log(sqrt(inverseVariance)), kind=RK)
367 complex(CK) :: logProbNorm(np)
368 real(RK) :: difference(np)
369
370 logProbNorm = getLogProbNormMP_CK( np = np &
371 , mean = mean &
372 , inverseVariance = inverseVariance &
373 , logSqrtInverseVariance = logSqrtInverseVariance &
374 , point = point &
375 )
376
377 difference = abs( (real(logProbNorm, kind=RK) - real(logProbNorm_ref, kind=RK)) / real(logProbNorm_ref, kind=RK) )
378 assertion = all(difference <= tolerance)
379
380 ! LCOV_EXCL_START
381 if (test%traceable .and. .not. assertion) then
382 write(test%disp%unit,"(*(g0,:,', '))")
383 write(test%disp%unit,"(*(g0,:,', '))") "LogProbNorm_ref ", real(logProbNorm_ref, kind = RK)
384 write(test%disp%unit,"(*(g0,:,', '))") "LogProbNorm ", real(logProbNorm, kind = RK)
385 write(test%disp%unit,"(*(g0,:,', '))") "Difference ", real(difference, kind = RK)
386 write(test%disp%unit,"(*(g0,:,', '))")
387 end if
388 ! LCOV_EXCL_STOP
389
390 end function test_getLogProbNormMP_CK_1
391
392!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
393!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
394!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
395
396 function test_getLogProbMixNormSP_RK_1() result(assertion)
397
398 use pm_kind, only: IK, RK
399 implicit none
400
401 logical(LK) :: assertion
402 integer(IK) , parameter :: nmode = 2_IK
403 real(RK) , parameter :: point = 2._RK
404 real(RK) , parameter :: tolerance = 1.e-12_RK
405 real(RK) , parameter :: mean(nmode) = [ 0.25_RK, 0.75_RK ]
406 real(RK) , parameter :: invCov(nmode) = [ 1._RK / 16._RK, 1._RK / 32._RK ]
407 real(RK) , parameter :: LogAmplitude(nmode) = [ 3._RK, 4._RK ]
408 real(RK) , parameter :: logSqrtDetInvCovMat(nmode) = log(sqrt(invCov))
409 real(RK) , parameter :: logProbMixNorm_ref = 1.718832134253714_RK
410 real(RK) :: logProbMixNorm
411 real(RK) :: difference
412
413 logProbMixNorm = getLogProbMixNorm( nmode = nmode &
414 , LogAmplitude = LogAmplitude &
415 , mean = mean &
416 , invCov = invCov &
417 , logSqrtDetInvCovMat = logSqrtDetInvCovMat &
418 , point = point &
419 )
420
421 difference = abs( (logProbMixNorm - logProbMixNorm_ref) / logProbMixNorm_ref )
422 assertion = difference <= tolerance
423
424 ! LCOV_EXCL_START
425 if (test%traceable .and. .not. assertion) then
426 write(test%disp%unit,"(*(g0,:,', '))")
427 write(test%disp%unit,"(*(g0,:,', '))") "logProbMixNorm_ref ", logProbMixNorm_ref
428 write(test%disp%unit,"(*(g0,:,', '))") "logProbMixNorm ", logProbMixNorm
429 write(test%disp%unit,"(*(g0,:,', '))") "Difference ", difference
430 write(test%disp%unit,"(*(g0,:,', '))")
431 end if
432 ! LCOV_EXCL_STOP
433
434 end function test_getLogProbMixNormSP_RK_1
435
436!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
437
438 function test_getLogProbMixNormMP_RK_1() result(assertion)
439
440 use pm_kind, only: IK, RK
441 implicit none
442
443 logical(LK) :: assertion
444 integer(IK) , parameter :: np = 2_IK
445 integer(IK) , parameter :: nmode = 2_IK
446 real(RK) , parameter :: point(np) = [ 2._RK, 3._RK ]
447 real(RK) , parameter :: tolerance = 1.e-12_RK
448 real(RK) , parameter :: mean(nmode) = [ 0.25_RK, 0.75_RK ]
449 real(RK) , parameter :: invCov(nmode) = [ 1._RK / 16._RK, 1._RK / 32._RK ]
450 real(RK) , parameter :: LogAmplitude(nmode) = [ 3._RK, 4._RK ]
451 real(RK) , parameter :: logSqrtDetInvCovMat(nmode) = log(sqrt(invCov))
452 real(RK) , parameter :: logProbMixNorm_ref(np) = [ 1.718832134253714_RK, 1.636902047052812_RK ]
453 real(RK) :: logProbMixNorm(np)
454 real(RK) :: difference(np)
455
456 logProbMixNorm = getLogProbMixNorm( nmode = nmode &
457 , np = np &
458 , LogAmplitude = LogAmplitude &
459 , mean = mean &
460 , invCov = invCov &
461 , logSqrtDetInvCovMat = logSqrtDetInvCovMat &
462 , point = point &
463 )
464
465 difference = abs( (logProbMixNorm - logProbMixNorm_ref) / logProbMixNorm_ref )
466 assertion = all(difference <= tolerance)
467
468 ! LCOV_EXCL_START
469 if (test%traceable .and. .not. assertion) then
470 write(test%disp%unit,"(*(g0,:,', '))")
471 write(test%disp%unit,"(*(g0,:,', '))") "logProbMixNorm_ref ", logProbMixNorm_ref
472 write(test%disp%unit,"(*(g0,:,', '))") "logProbMixNorm ", logProbMixNorm
473 write(test%disp%unit,"(*(g0,:,', '))") "Difference ", difference
474 write(test%disp%unit,"(*(g0,:,', '))")
475 end if
476 ! LCOV_EXCL_STOP
477
478 end function test_getLogProbMixNormMP_RK_1
479
480!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
481
482 function test_getLogProbMixMVNSP_RK_1() result(assertion)
483
484 use pm_kind, only: IK, RK
485 implicit none
486
487 logical(LK) :: assertion
488 integer(IK) :: i
489 integer(IK) , parameter :: nd = 3_IK
490 integer(IK) , parameter :: nmode = 2_IK
491 real(RK) , parameter :: tolerance = 1.e-12_RK
492 real(RK) , parameter :: Point(nd) = [(real(i,RK),i=1,nd)]
493 real(RK) , parameter :: mean(nd,nmode) = reshape([(real(i**2+1._RK,RK),i=1,nd*nmode)], shape = shape(mean))
494 real(RK) , parameter :: invCov(nd,nd,nmode) = reshape([ 1._RK, 0._RK, 1._RK &
495 , 0._RK, 2._RK, 0._RK &
496 , 1._RK, 0._RK, 3._RK &
497 , 2._RK, 0._RK, 0._RK &
498 , 0._RK, 2._RK, 0._RK &
499 , 0._RK, 0._RK, 2._RK &
500 ], shape = shape(invCov) )
501 real(RK) , parameter :: LogAmplitude(nmode) = [ 3._RK, 4._RK ]
502 real(RK) , parameter :: logSqrtDetInvCovMat(nmode) = [-0.693147180559945_RK, -1.039720770839918_RK]
503 real(RK) , parameter :: logProbMixMVN_ref = -90.44996278017396_RK
504 real(RK) :: logProbMixMVN
505 real(RK) :: difference
506
507 logProbMixMVN = getlogProbMixMVN( nmode = nmode &
508 , nd = nd &
509 , LogAmplitude = LogAmplitude &
510 , mean = mean &
511 , invCov = invCov &
512 , logSqrtDetInvCovMat = logSqrtDetInvCovMat &
513 , point = point &
514 )
515
516 difference = abs( (logProbMixMVN - logProbMixMVN_ref) / logProbMixMVN_ref )
517 assertion = difference <= tolerance
518
519 ! LCOV_EXCL_START
520 if (test%traceable .and. .not. assertion) then
521 write(test%disp%unit,"(*(g0,:,', '))")
522 write(test%disp%unit,"(*(g0,:,', '))") "logProbMixMVN_ref ", logProbMixMVN_ref
523 write(test%disp%unit,"(*(g0,:,', '))") "logProbMixMVN ", logProbMixMVN
524 write(test%disp%unit,"(*(g0,:,', '))") "Difference ", difference
525 write(test%disp%unit,"(*(g0,:,', '))")
526 end if
527 ! LCOV_EXCL_STOP
528
529 end function test_getLogProbMixMVNSP_RK_1
530
531!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
532
533 function test_getLogProbMixMVNMP_RK_1() result(assertion)
534
535 use pm_kind, only: IK, RK
536 implicit none
537
538 logical(LK) :: assertion
539 integer(IK) :: i
540 integer(IK) , parameter :: nd = 3_IK
541 integer(IK) , parameter :: np = 2_IK
542 integer(IK) , parameter :: nmode = 2_IK
543 real(RK) , parameter :: tolerance = 1.e-12_RK
544 real(RK) , parameter :: Point(nd,np) = reshape([(real(i,RK),i=1,nd*np)], shape = shape(Point))
545 real(RK) , parameter :: mean(nd,nmode) = reshape([(real(i**2+1._RK,RK),i=1,nd*nmode)], shape = shape(mean))
546 real(RK) , parameter :: invCov(nd,nd,nmode) = reshape([ 1._RK, 0._RK, 1._RK &
547 , 0._RK, 2._RK, 0._RK &
548 , 1._RK, 0._RK, 3._RK &
549 , 2._RK, 0._RK, 0._RK &
550 , 0._RK, 2._RK, 0._RK &
551 , 0._RK, 0._RK, 2._RK &
552 ], shape = shape(invCov) )
553 real(RK) , parameter :: LogAmplitude(nmode) = [ 3._RK, 4._RK ]
554 real(RK) , parameter :: logSqrtDetInvCovMat(nmode) = [-0.693147180559945_RK, -1.039720770839918_RK]
555 real(RK) , parameter :: logProbMixMVN_ref(np) = [ -90.44996278017396_RK, -18.44996278017396_RK ]
556 real(RK) :: logProbMixMVN(np)
557 real(RK) :: difference(np)
558
559 logProbMixMVN = getlogProbMixMVN( nmode = nmode &
560 , nd = nd &
561 , np = np &
562 , LogAmplitude = LogAmplitude &
563 , mean = mean &
564 , invCov = invCov &
565 , logSqrtDetInvCovMat = logSqrtDetInvCovMat &
566 , point = point &
567 )
568
569 difference = abs( (logProbMixMVN - logProbMixMVN_ref) / logProbMixMVN_ref )
570 assertion = all(difference <= tolerance)
571
572 ! LCOV_EXCL_START
573 if (test%traceable .and. .not. assertion) then
574 write(test%disp%unit,"(*(g0,:,', '))")
575 write(test%disp%unit,"(*(g0,:,', '))") "logProbMixMVN_ref ", logProbMixMVN_ref
576 write(test%disp%unit,"(*(g0,:,', '))") "logProbMixMVN ", logProbMixMVN
577 write(test%disp%unit,"(*(g0,:,', '))") "Difference ", difference
578 write(test%disp%unit,"(*(g0,:,', '))")
579 end if
580 ! LCOV_EXCL_STOP
581
582 end function test_getLogProbMixMVNMP_RK_1
583
584!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
585!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
586!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
587!
588! function test_getLogProbMixNormSP_CK_1() result(assertion)
589!
590! use pm_kind, only: IK, RK, CK
591! implicit none
592!
593! logical(LK) :: assertion
594! real(RK) , parameter :: tolerance = 1.e-12_RK
595! integer(IK) , parameter :: nmode = 2_IK
596! complex(CK) , parameter :: point = 2._RK
597! complex(CK) , parameter :: mean(nmode) = cmplx([ 0.25_RK, 0.75_RK ], kind = RK)
598! complex(CK) , parameter :: invCov(nmode) = cmplx([ 1._RK / 16._RK, 1._RK / 32._RK ], kind = RK)
599! complex(CK) , parameter :: LogAmplitude(nmode) = cmplx([ 3._RK, 4._RK ], kind = RK)
600! complex(CK) , parameter :: logSqrtDetInvCovMat(nmode) = cmplx(log(sqrt(invCov)), kind = RK)
601! complex(CK) , parameter :: logProbMixNorm_ref = cmplx(1.718832134253714_RK, kind = RK)
602! complex(CK) :: logProbMixNorm
603! real(RK) :: difference
604!
605! logProbMixNorm = getLogProbMixNorm ( nmode = nmode &
606! , LogAmplitude = LogAmplitude &
607! , mean = mean &
608! , invCov = invCov &
609! , logSqrtDetInvCovMat = logSqrtDetInvCovMat &
610! , point = point &
611! )
612!
613! difference = abs( (real(logProbMixNorm, kind = RK) - real(logProbMixNorm_ref, kind = RK)) / real(logProbMixNorm_ref, kind = RK) )
614! assertion = difference <= tolerance
615!
616! ! LCOV_EXCL_START
617! if (test%traceable .and. .not. assertion) then
618! write(test%disp%unit,"(*(g0,:,', '))")
619! write(test%disp%unit,"(*(g0,:,', '))") "logProbMixNorm_ref ", real(logProbMixNorm_ref, kind = RK)
620! write(test%disp%unit,"(*(g0,:,', '))") "logProbMixNorm ", real(logProbMixNorm, kind = RK)
621! write(test%disp%unit,"(*(g0,:,', '))") "Difference ", real(difference, kind = RK)
622! write(test%disp%unit,"(*(g0,:,', '))")
623! end if
624! ! LCOV_EXCL_STOP
625!
626! end function test_getLogProbMixNormSP_CK_1
627!
628!!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
629!
630! function test_getLogProbMixNormMP_CK_1() result(assertion)
631!
632! use pm_kind, only: IK, RK, CK
633! implicit none
634!
635! logical(LK) :: assertion
636! real(RK) , parameter :: tolerance = 1.e-12_RK
637! integer(IK) , parameter :: np = 2_IK
638! integer(IK) , parameter :: nmode = 2_IK
639! complex(CK) , parameter :: point(np) = cmplx([ 2._RK, 3._RK ], kind = RK)
640! complex(CK) , parameter :: mean(nmode) = cmplx([ 0.25_RK, 0.75_RK ], kind = RK)
641! complex(CK) , parameter :: invCov(nmode) = cmplx([ 1._RK / 16._RK, 1._RK / 32._RK ], kind = RK)
642! complex(CK) , parameter :: LogAmplitude(nmode) = cmplx([ 3._RK, 4._RK ], kind = RK)
643! complex(CK) , parameter :: logSqrtDetInvCovMat(nmode) = cmplx(log(sqrt(invCov)), kind = RK)
644! complex(CK) , parameter :: logProbMixNorm_ref(np) = cmplx([ 1.718832134253714_RK, 1.636902047052812_RK ], kind = RK)
645! complex(CK) :: logProbMixNorm(np)
646! real(RK) :: difference(np)
647!
648! logProbMixNorm = getLogProbMixNorm ( nmode = nmode &
649! , np = np &
650! , LogAmplitude = LogAmplitude &
651! , mean = mean &
652! , invCov = invCov &
653! , logSqrtDetInvCovMat = logSqrtDetInvCovMat &
654! , point = point &
655! )
656!
657! difference = abs( (real(logProbMixNorm, kind = RK) - real(logProbMixNorm_ref, kind = RK)) / real(logProbMixNorm_ref, kind = RK) )
658! assertion = all(difference <= tolerance)
659!
660! ! LCOV_EXCL_START
661! if (test%traceable .and. .not. assertion) then
662! write(test%disp%unit,"(*(g0,:,', '))")
663! write(test%disp%unit,"(*(g0,:,', '))") "logProbMixNorm_ref ", real(logProbMixNorm_ref, kind = RK)
664! write(test%disp%unit,"(*(g0,:,', '))") "logProbMixNorm ", real(logProbMixNorm, kind = RK)
665! write(test%disp%unit,"(*(g0,:,', '))") "Difference ", real(difference, kind = RK)
666! write(test%disp%unit,"(*(g0,:,', '))")
667! end if
668! ! LCOV_EXCL_STOP
669!
670! end function test_getLogProbMixNormMP_CK_1
671!
672!!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
673!
674! function test_getLogProbMixMVNSP_CK_1() result(assertion)
675!
676! use pm_kind, only: IK, RK, CK
677! implicit none
678!
679! logical(LK) :: assertion
680! real(RK) , parameter :: tolerance = 1.e-12_RK
681! integer(IK) :: i
682! integer(IK) , parameter :: nd = 3_IK
683! integer(IK) , parameter :: nmode = 2_IK
684! complex(CK) , parameter :: Point(nd) = cmplx([(real(i,RK),i=1,nd)], kind = RK)
685! complex(CK) , parameter :: mean(nd,nmode) = cmplx(reshape([(real(i**2+1._RK,RK),i=1,nd*nmode)], shape = shape(mean)), kind = RK)
686! complex(CK) , parameter :: invCov(nd,nd,nmode) = cmplx( reshape( [ 1._RK, 0._RK, 1._RK &
687! , 0._RK, 2._RK, 0._RK &
688! , 1._RK, 0._RK, 3._RK &
689! , 2._RK, 0._RK, 0._RK &
690! , 0._RK, 2._RK, 0._RK &
691! , 0._RK, 0._RK, 2._RK &
692! ], shape = shape(invCov) ), kind = RK)
693! complex(CK) , parameter :: LogAmplitude(nmode) = cmplx([ 3._RK, 4._RK ], kind = RK)
694! complex(CK) , parameter :: logSqrtDetInvCovMat(nmode) = cmplx([-0.693147180559945_RK, -1.039720770839918_RK], kind = RK)
695! complex(CK) , parameter :: logProbMixMVN_ref = cmplx(-90.44996278017396_RK, kind = RK)
696! complex(CK) :: logProbMixMVN
697! real(RK) :: difference
698!
699! logProbMixMVN = getlogProbMixMVN( nmode = nmode &
700! , nd = nd &
701! , LogAmplitude = LogAmplitude &
702! , mean = mean &
703! , invCov = invCov &
704! , logSqrtDetInvCovMat = logSqrtDetInvCovMat &
705! , point = point &
706! )
707!
708! difference = abs( (real(logProbMixMVN, kind = RK) - real(logProbMixMVN_ref, kind = RK)) / real(logProbMixMVN_ref, kind = RK) )
709! assertion = difference <= tolerance
710!
711! ! LCOV_EXCL_START
712! if (test%traceable .and. .not. assertion) then
713! write(test%disp%unit,"(*(g0,:,', '))")
714! write(test%disp%unit,"(*(g0,:,', '))") "logProbMixMVN_ref ", real(logProbMixMVN_ref, kind = RK)
715! write(test%disp%unit,"(*(g0,:,', '))") "logProbMixMVN ", real(logProbMixMVN, kind = RK)
716! write(test%disp%unit,"(*(g0,:,', '))") "Difference ", real(difference, kind = RK)
717! write(test%disp%unit,"(*(g0,:,', '))")
718! end if
719! ! LCOV_EXCL_STOP
720!
721! end function test_getLogProbMixMVNSP_CK_1
722!
723!!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
724!
725! function test_getLogProbMixMVNMP_CK_1() result(assertion)
726!
727! use pm_kind, only: IK, RK, CK
728! implicit none
729!
730! logical(LK) :: assertion
731! integer(IK) :: i
732! real(RK) , parameter :: tolerance = 1.e-12_RK
733! integer(IK) , parameter :: nd = 3_IK
734! integer(IK) , parameter :: np = 2_IK
735! integer(IK) , parameter :: nmode = 2_IK
736! complex(CK) , parameter :: Point(nd,np) = cmplx(reshape([(real(i,RK),i=1,nd*np)], shape = shape(Point)), kind = RK)
737! complex(CK) , parameter :: mean(nd,nmode) = cmplx(reshape([(real(i**2+1._RK,RK),i=1,nd*nmode)], shape = shape(mean)), kind = RK)
738! complex(CK) , parameter :: invCov(nd,nd,nmode) = cmplx(reshape( [ 1._RK, 0._RK, 1._RK &
739! , 0._RK, 2._RK, 0._RK &
740! , 1._RK, 0._RK, 3._RK &
741! , 2._RK, 0._RK, 0._RK &
742! , 0._RK, 2._RK, 0._RK &
743! , 0._RK, 0._RK, 2._RK &
744! ], shape = shape(invCov) ), kind = RK)
745! complex(CK) , parameter :: LogAmplitude(nmode) = cmplx([ 3._RK, 4._RK ], kind = RK)
746! complex(CK) , parameter :: logSqrtDetInvCovMat(nmode) = cmplx([-0.693147180559945_RK, -1.039720770839918_RK], kind = RK)
747! complex(CK) , parameter :: logProbMixMVN_ref(np) = cmplx([ -90.44996278017396_RK, -18.44996278017396_RK ], kind = RK)
748! complex(CK) :: logProbMixMVN(np)
749! real(RK) :: difference(np)
750!
751! logProbMixMVN = getlogProbMixMVN( nmode = nmode &
752! , nd = nd &
753! , np = np &
754! , LogAmplitude = LogAmplitude &
755! , mean = mean &
756! , invCov = invCov &
757! , logSqrtDetInvCovMat = logSqrtDetInvCovMat &
758! , point = point &
759! )
760!
761! difference = abs( (real(logProbMixMVN, kind = RK) - real(logProbMixMVN_ref, kind = RK)) / real(logProbMixMVN_ref, kind = RK) )
762! assertion = all(difference <= tolerance)
763!
764! ! LCOV_EXCL_START
765! if (test%traceable .and. .not. assertion) then
766! write(test%disp%unit,"(*(g0,:,', '))")
767! write(test%disp%unit,"(*(g0,:,', '))") "logProbMixMVN_ref ", real(logProbMixMVN_ref, kind = RK)
768! write(test%disp%unit,"(*(g0,:,', '))") "logProbMixMVN ", real(logProbMixMVN, kind = RK)
769! write(test%disp%unit,"(*(g0,:,', '))") "Difference ", real(difference, kind = RK)
770! write(test%disp%unit,"(*(g0,:,', '))")
771! end if
772! ! LCOV_EXCL_STOP
773!
774! end function test_getLogProbMixMVNMP_CK_1
775!
776!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
777!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
778!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
779
780 ! \todo
781 ! What is the best method of testing for randomness?
782 function test_getRandLogn_1() result(assertion)
783 use pm_kind, only: IK, RK
784 implicit none
785 logical(LK) :: assertion
786 real(RK) :: lognRnd
787 lognRnd = getRandLogn(0._RK, 1._RK)
788 assertion = .true._LK
789 end function test_getRandLogn_1
790
791!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
792
793 function test_getLogProbMVU_1() result(assertion)
794 use pm_kind, only: IK, RK
795 implicit none
796 logical(LK) :: assertion
797 integer(IK) , parameter :: nd = 2_IK
798 real(RK) , parameter :: tolerance = 1.e-12_RK
799 real(RK) , parameter :: logSqrtDetCovMat = log(1._RK)
800 real(RK) , parameter :: logProbMVU_ref = -1.144729885849400_RK
801 real(RK) :: difference
802 real(RK) :: logProbMVU
803 logProbMVU = getLogProbMVU(nd, logSqrtDetCovMat)
804 difference = abs( (logProbMVU - logProbMVU_ref) / logProbMVU_ref)
805 assertion = difference < tolerance
806 ! LCOV_EXCL_START
807 if (test%traceable .and. .not. assertion) then
808 write(test%disp%unit,"(*(g0,:,', '))")
809 write(test%disp%unit,"(*(g0,:,', '))") "logProbMVU_ref ", logProbMVU_ref
810 write(test%disp%unit,"(*(g0,:,', '))") "logProbMVU ", logProbMVU
811 write(test%disp%unit,"(*(g0,:,', '))") "difference ", difference
812 write(test%disp%unit,"(*(g0,:,', '))")
813 end if
814 ! LCOV_EXCL_STOP
815 end function test_getLogProbMVU_1
816
817!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
818
819 function test_getLogProbLognSP_1() result(assertion)
820
821 use pm_kind, only: IK, RK
822 implicit none
823 logical(LK) :: assertion
824 integer(IK) , parameter :: nd = 2_IK
825 real(RK) , parameter :: tolerance = 1.e-12_RK
826 real(RK) , parameter :: logMean = 2._RK
827 real(RK) , parameter :: logPoint = log(5._RK)
828 real(RK) , parameter :: inverseVariance = 1.e-2_RK
829 real(RK) , parameter :: logSqrtInverseVariance = log(sqrt(inverseVariance))
830 real(RK) , parameter :: logProbLogn_ref = -4.831724232354038_RK
831 real(RK) :: difference
832 real(RK) :: logProbLogn
833
834 logProbLogn = getLogProbLogn(logMean = logMean, inverseVariance = inverseVariance, logSqrtInverseVariance = logSqrtInverseVariance, logPoint = logPoint)
835 difference = abs( (logProbLogn - logProbLogn_ref) / logProbLogn_ref )
836 assertion = difference < tolerance
837
838 logProbLogn = getLogProbLognorm(logMean = logMean, inverseVariance = inverseVariance, logSqrtInverseVariance = logSqrtInverseVariance, logPoint = logPoint)
839 difference = abs( (logProbLogn - logProbLogn_ref) / logProbLogn_ref )
840 assertion = assertion .and. difference < tolerance
841
842 ! LCOV_EXCL_START
843 if (test%traceable .and. .not. assertion) then
844 write(test%disp%unit,"(*(g0,:,', '))")
845 write(test%disp%unit,"(*(g0,:,', '))") "logProbLogn_ref ", logProbLogn_ref
846 write(test%disp%unit,"(*(g0,:,', '))") "logProbLogn ", logProbLogn
847 write(test%disp%unit,"(*(g0,:,', '))") "difference ", difference
848 write(test%disp%unit,"(*(g0,:,', '))")
849 end if
850 ! LCOV_EXCL_STOP
851
852 end function test_getLogProbLognSP_1
853
854!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
855
856 function test_getLogProbLognMP_1() result(assertion)
857
858 use pm_kind, only: IK, RK
859 implicit none
860 logical(LK) :: assertion
861 integer(IK) , parameter :: nd = 2_IK, np = 3_IK
862 real(RK) , parameter :: tolerance = 1.e-12_RK
863 real(RK) , parameter :: logMean = 2._RK
864 real(RK) , parameter :: LogPoint(np) = log([5._RK, 6._RK, 7._RK])
865 real(RK) , parameter :: inverseVariance = 1.e-2_RK
866 real(RK) , parameter :: logSqrtInverseVariance = log(sqrt(inverseVariance))
867 real(RK) , parameter :: LogProbLogn_ref(np) = [ -4.831724232354038_RK, -5.013499916020054_RK, -5.167448403813908_RK ]
868 real(RK) :: LogProbLogn(np)
869 real(RK) :: difference(np)
870
871 LogProbLogn = getLogProbLogn(np = np, logMean = logMean, inverseVariance = inverseVariance, logSqrtInverseVariance = logSqrtInverseVariance, logPoint = LogPoint)
872 difference = abs( (LogProbLogn - LogProbLogn_ref) / LogProbLogn_ref )
873 assertion = all(difference < tolerance)
874
875 LogProbLogn = getLogProbLognorm(np = np, logMean = logMean, inverseVariance = inverseVariance, logSqrtInverseVariance = logSqrtInverseVariance, logPoint = LogPoint)
876 difference = abs( (LogProbLogn - LogProbLogn_ref) / LogProbLogn_ref )
877 assertion = assertion .and. all(difference < tolerance)
878
879 ! LCOV_EXCL_START
880 if (test%traceable .and. .not. assertion) then
881 write(test%disp%unit,"(*(g0,:,', '))")
882 write(test%disp%unit,"(*(g0,:,', '))") "LogProbLogn_ref ", LogProbLogn_ref
883 write(test%disp%unit,"(*(g0,:,', '))") "LogProbLogn ", LogProbLogn
884 write(test%disp%unit,"(*(g0,:,', '))") "difference ", difference
885 write(test%disp%unit,"(*(g0,:,', '))")
886 end if
887 ! LCOV_EXCL_STOP
888
889 end function test_getLogProbLognMP_1
890
891!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
892
893 function test_getRandRealLecuyer_1() result(assertion)
894 use pm_kind, only: IK, RK
895 implicit none
896 logical(LK) :: assertion
897 integer(IK) , parameter :: np = 100
898 integer(IK) :: idum = 3333, i
899 real(RK) :: RandRealLecuyer(np)
900 assertion = .true._LK
901 do i = 1, np
902 RandRealLecuyer(i) = getRandRealLecuyer(idum)
903 assertion = assertion .and. RandRealLecuyer(i) <= 1._RK .and. RandRealLecuyer(i) >= 0._RK
904 ! LCOV_EXCL_START
905 if (test%traceable .and. .not. assertion) then
906 write(test%disp%unit,"(*(g0,:,' '))")
907 write(test%disp%unit,"(*(g0,:,' '))") "RandRealLecuyer(",i,") =", RandRealLecuyer(i)
908 write(test%disp%unit,"(*(g0,:,' '))")
909 end if
910 ! LCOV_EXCL_STOP
911 end do
912 end function test_getRandRealLecuyer_1
913
914!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
915
916 function test_getRandIntLecuyer_1() result(assertion)
917 use pm_kind, only: IK, RK
918 implicit none
919 logical(LK) :: assertion
920 integer(IK) , parameter :: lowerBound = -2, upperBound = 9
921 integer(IK) , parameter :: np = 100
922 integer(IK) :: idum = 3333, i
923 integer(IK) :: RandIntLecuyer(np)
924 assertion = .true._LK
925 do i = 1, np
926 RandIntLecuyer(i) = getRandIntLecuyer(lowerBound,upperBound,idum)
927 assertion = assertion .and. RandIntLecuyer(i) <= upperBound .and. RandIntLecuyer(i) >= lowerBound
928 ! LCOV_EXCL_START
929 if (test%traceable .and. .not. assertion) then
930 write(test%disp%unit,"(*(g0,:,' '))")
931 write(test%disp%unit,"(*(g0,:,' '))") "RandIntLecuyer(",i,") =", RandIntLecuyer(i)
932 write(test%disp%unit,"(*(g0,:,' '))")
933 end if
934 ! LCOV_EXCL_STOP
935 end do
936 end function test_getRandIntLecuyer_1
937
938!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
939
940 function test_getUnifRandorm_1() result(assertion)
941 use pm_kind, only: IK, RK
942 implicit none
943 logical(LK) :: assertion
944 integer(IK) , parameter :: np = 100
945 real(RK) , parameter :: lowerBound = -2._RK, upperBound = 9._RK
946 integer(IK) :: i
947 real(RK) :: RandUniform(np)
948 assertion = .true._LK
949 do i = 1, np
950 RandUniform(i) = getUnifRandorm(lowerBound,upperBound)
951 assertion = assertion .and. RandUniform(i) <= upperBound .and. RandUniform(i) >= lowerBound
952 ! LCOV_EXCL_START
953 if (test%traceable .and. .not. assertion) then
954 write(test%disp%unit,"(*(g0,:,' '))")
955 write(test%disp%unit,"(*(g0,:,' '))") "RandUniform(",i,") =", RandUniform(i)
956 write(test%disp%unit,"(*(g0,:,' '))")
957 end if
958 ! LCOV_EXCL_STOP
959 end do
960 end function test_getUnifRandorm_1
961
962!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
963
964 function test_getRandGamma_1() result(assertion)
965 logical(LK) :: assertion
966 integer(IK) , parameter :: np = 100
967 real(RK) , parameter :: alpha = 2._RK
968 real(RK) , parameter :: lowerBound = 0._RK, upperBound = huge(0._RK)
969 integer(IK) :: i
970 real(RK) :: RandGamma(np)
971 assertion = .true._LK
972 do i = 1, np
973 RandGamma(i) = getRandGamma(alpha)
974 assertion = assertion .and. RandGamma(i) <= upperBound .and. RandGamma(i) >= lowerBound
975 ! LCOV_EXCL_START
976 if (test%traceable .and. .not. assertion) then
977 write(test%disp%unit,"(*(g0,:,' '))")
978 write(test%disp%unit,"(*(g0,:,' '))") "RandGamma(",i,") =", RandGamma(i)
979 write(test%disp%unit,"(*(g0,:,' '))")
980 end if
981 ! LCOV_EXCL_STOP
982 end do
983 assertion = assertion .and. getRandGamma(alpha=-1._RK) < 0._RK
984 end function test_getRandGamma_1
985
986!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
987
988 function test_getRandGammaIntShape_1() result(assertion)
989 use pm_kind, only: IK, RK
990 implicit none
991 logical(LK) :: assertion
992 integer(IK) , parameter :: np = 100
993 integer(IK) , parameter :: alpha = 2_IK
994 real(RK) , parameter :: lowerBound = 0._RK, upperBound = huge(0._RK)
995 integer(IK) :: i
996 real(RK) :: RandGamma(np)
997 assertion = .true._LK
998 do i = 1, np
999 RandGamma(i) = getRandGammaIntShape(alpha)
1000 assertion = assertion .and. RandGamma(i) <= upperBound .and. RandGamma(i) >= lowerBound
1001 ! LCOV_EXCL_START
1002 if (test%traceable .and. .not. assertion) then
1003 write(test%disp%unit,"(*(g0,:,' '))")
1004 write(test%disp%unit,"(*(g0,:,' '))") "RandGamma(",i,") =", RandGamma(i)
1005 write(test%disp%unit,"(*(g0,:,' '))")
1006 end if
1007 ! LCOV_EXCL_STOP
1008 end do
1009 assertion = assertion .and. getRandGammaIntShape(alpha=-1_IK) < 0._RK
1010 end function test_getRandGammaIntShape_1
1011
1012!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1013
1014 function test_getRandBeta_1() result(assertion)
1015 use pm_kind, only: IK, RK
1016 implicit none
1017 logical(LK) :: assertion
1018 integer(IK) , parameter :: np = 100
1019 real(RK) , parameter :: alpha = 2._RK, beta = 3._RK
1020 real(RK) , parameter :: lowerBound = 0._RK, upperBound = 1._RK
1021 integer(IK) :: i
1022 real(RK) :: RandBeta(np)
1023 assertion = .true._LK
1024 do i = 1, np
1025 RandBeta(i) = getRandBeta(alpha, beta)
1026 assertion = assertion .and. RandBeta(i) <= upperBound .and. RandBeta(i) >= lowerBound
1027 ! LCOV_EXCL_START
1028 if (test%traceable .and. .not. assertion) then
1029 write(test%disp%unit,"(*(g0,:,' '))")
1030 write(test%disp%unit,"(*(g0,:,' '))") "RandBeta(",i,") =", RandBeta(i)
1031 write(test%disp%unit,"(*(g0,:,' '))")
1032 end if
1033 ! LCOV_EXCL_STOP
1034 end do
1035 assertion = assertion .and. getRandBeta(alpha=-1._RK, beta=+2._RK) < 0._RK
1036 assertion = assertion .and. getRandBeta(alpha=+1._RK, beta=-2._RK) < 0._RK
1037 assertion = assertion .and. getRandBeta(alpha=-1._RK, beta=-2._RK) < 0._RK
1038 end function test_getRandBeta_1
1039
1040!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1041
1042 function test_getRandCorMat_1() result(assertion)
1043 use pm_kind, only: IK, RK
1044 use pm_matrixDet, only: isPosDef
1045 implicit none
1046 logical(LK) :: assertion
1047 integer(IK) , parameter :: nd = 2_IK
1048 integer(IK) , parameter :: np = 100_IK
1049 real(RK) , parameter :: eta = 5._RK
1050 real(RK) , parameter :: lowerBound = -1._RK, upperBound = 1._RK
1051 integer(IK) :: i
1052 real(RK) :: RandCorMat(nd,nd)
1053 assertion = .true._LK
1054 do i = 1, np
1055 RandCorMat = getRandCorMat(nd,eta)
1056 assertion = assertion .and. all(RandCorMat <= upperBound) .and. all(RandCorMat >= lowerBound)
1057 assertion = assertion .and. isPosDef(nd,RandCorMat)
1058 ! LCOV_EXCL_START
1059 if (test%traceable .and. .not. assertion) then
1060 write(test%disp%unit,"(*(g0,:,' '))")
1061 write(test%disp%unit,"(*(g0,:,' '))") "RandCorMat(:,:,) =", RandCorMat
1062 write(test%disp%unit,"(*(g0,:,' '))")
1063 end if
1064 ! LCOV_EXCL_STOP
1065 end do
1066 ! do not uncomment this as GNU Fortran 9.1 crashes on this in debug mode with error message:
1067 ! Fortran runtime error: Dimension 1 of array 'randcormat' has extent 0 instead of 2...
1068 !RandCorMat = getRandCorMat(nd = 0_IK, eta = 1._RK); assertion = assertion .and. RandCorMat(1,1) < 0._RK
1069 !RandCorMat = getRandCorMat(nd = -1_IK, eta = +2._RK); assertion = assertion .and. RandCorMat(1,1) < 0._RK
1070 !RandCorMat = getRandCorMat(nd = +1_IK, eta = +0._RK); assertion = assertion .and. RandCorMat(1,1) < 0._RK
1071 RandCorMat = getRandCorMat(nd = +2_IK, eta = +0._RK); assertion = assertion .and. RandCorMat(1,1) < 0._RK
1072 RandCorMat = getRandCorMat(nd = +2_IK, eta = -1._RK); assertion = assertion .and. RandCorMat(1,1) < 0._RK
1073 RandCorMat = getRandCorMat(nd = +2_IK, eta = -2._RK); assertion = assertion .and. RandCorMat(1,1) < 0._RK
1074 end function test_getRandCorMat_1
1075
1076!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1077
1078 function test_getRandCorMatRejection_1() result(assertion)
1079 use pm_kind, only: IK, RK
1080 use pm_matrixDet, only: isPosDef
1081 implicit none
1082 logical(LK) :: assertion, assertionCurrent
1083 integer(IK) , parameter :: nd = 2_IK
1084 integer(IK) , parameter :: np = 100_IK
1085 real(RK) , parameter :: minRho = -.3_RK, maxRho = .6_RK
1086 real(RK) , parameter :: lowerBound = -1._RK, upperBound = 1._RK
1087 integer(IK) :: i, j, k
1088 real(RK) :: RandCorMat(nd,nd)
1089 assertion = .true._LK
1090 do i = 1, np
1091 RandCorMat = getRandCorMatRejection(nd,minRho,maxRho)
1092 assertion = assertion .and. all(RandCorMat <= upperBound) .and. all(RandCorMat >= lowerBound)
1093 do j = 1, nd
1094 do k = 1, nd
1095 if (j==k) then
1096 assertionCurrent = RandCorMat(j,k) == upperBound
1097 else
1098 assertionCurrent = RandCorMat(j,k) <= maxRho .and. RandCorMat(j,k) >= minRho
1099 end if
1100 assertion = assertion .and. assertionCurrent
1101 end do
1102 end do
1103 assertionCurrent = isPosDef(nd,RandCorMat)
1104 ! LCOV_EXCL_START
1105 if (test%traceable .and. .not. assertion) then
1106 write(test%disp%unit,"(*(g0,:,' '))")
1107 write(test%disp%unit,"(*(g0,:,' '))") "RandCorMat(:,:,) =", RandCorMat
1108 write(test%disp%unit,"(*(g0,:,' '))")
1109 end if
1110 ! LCOV_EXCL_STOP
1111 assertion = assertion .and. assertionCurrent
1112 end do
1113 ! do not uncomment this as GNU Fortran 9.1 crashes on this in debug mode with error message:
1114 ! Fortran runtime error: Dimension 1 of array 'randcormat' has extent 1 instead of 2...
1115 !RandCorMat = getRandCorMatRejection(nd = +1_IK, minRho = +.2_RK, maxRho = -.5_RK); assertion = assertion .and. RandCorMat(1,1) < 0._RK
1116 RandCorMat = getRandCorMatRejection(nd = +2_IK, minRho = -.2_RK, maxRho = -.5_RK); assertion = assertion .and. RandCorMat(1,1) < 0._RK
1117 RandCorMat = getRandCorMatRejection(nd = +2_IK, minRho = +.2_RK, maxRho = -.5_RK); assertion = assertion .and. RandCorMat(1,1) < 0._RK
1118 !RandCorMat = getRandCorMatRejection(nd = +0_IK, minRho = +.2_RK, maxRho = +.5_RK); assertion = assertion .and. RandCorMat(1,1) < 0._RK
1119 !RandCorMat = getRandCorMatRejection(nd = -3_IK, minRho = +.2_RK, maxRho = +.5_RK); assertion = assertion .and. RandCorMat(1,1) < 0._RK
1120 end function test_getRandCorMatRejection_1
1121
1122!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1123
1124 function test_getLogProbGeo_1() result(assertion)
1125 use pm_kind, only: IK, RK
1126 implicit none
1127 logical(LK) :: assertion
1128 integer(IK) :: i
1129 integer(IK) , parameter :: numTrial = 10_IK
1130 integer(IK) , parameter :: SuccessStep(numTrial) = [ (i, i = 1, numTrial) ]
1131 real(RK) , parameter :: successProb = 0.7_RK
1132 real(RK) , parameter :: tolerance = 1.e-12_RK
1133 real(RK) , parameter :: LogProbGeo_ref(numTrial) = [ -.3566749439387324_RK &
1134 , -1.560647748264668_RK &
1135 , -2.764620552590604_RK &
1136 , -3.968593356916540_RK &
1137 , -5.172566161242476_RK &
1138 , -6.376538965568412_RK &
1139 , -7.580511769894348_RK &
1140 , -8.784484574220283_RK &
1141 , -9.988457378546219_RK &
1142 , -11.19243018287215_RK ]
1143 real(RK) :: LogProbGeo(numTrial)
1144 real(RK) :: Difference(numTrial)
1145
1146 LogProbGeo = getLogProbGeo(numTrial, SuccessStep, successProb)
1147 Difference = abs(LogProbGeo - LogProbGeo_ref) / abs(LogProbGeo_ref)
1148 assertion = all( Difference < tolerance )
1149
1150 if (test%traceable .and. .not. assertion) then
1151 ! LCOV_EXCL_START
1152 write(test%disp%unit,"(*(g0,:,' '))")
1153 write(test%disp%unit,"(*(g0,:,' '))") "LogProbGeo_ref =", LogProbGeo_ref
1154 write(test%disp%unit,"(*(g0,:,' '))") "LogProbGeo =", LogProbGeo
1155 write(test%disp%unit,"(*(g0,:,' '))") "Difference =", Difference
1156 write(test%disp%unit,"(*(g0,:,' '))")
1157 end if
1158 ! LCOV_EXCL_STOP
1159
1160 end function test_getLogProbGeo_1
1161
1162!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1163
1164 function test_getLogProbGeoCyclic_1() result(assertion)
1165 use pm_kind, only: IK, RK
1166 implicit none
1167 logical(LK) :: assertion
1168 integer(IK) :: i
1169 integer(IK) , parameter :: numTrial = 10_IK
1170 integer(IK) , parameter :: maxNumTrial = 3_IK
1171 integer(IK) , parameter :: SuccessStep(numTrial) = [ (i, i = 1, numTrial) ]
1172 real(RK) , parameter :: successProb = 0.7_RK
1173 real(RK) , parameter :: tolerance = 1.e-12_RK
1174 real(RK) , parameter :: LogProbGeoCyclic_ref(numTrial) = [ -0.32930374714260041_RK &
1175 , -1.53327655146853630_RK &
1176 , -2.73724935579447240_RK &
1177 , -3.94122216012040830_RK &
1178 , -5.14519496444634420_RK &
1179 , -6.34916776877228010_RK &
1180 , -7.55314057309821600_RK &
1181 , -8.75711337742415100_RK &
1182 , -9.96108618175008690_RK &
1183 , -11.1650589860760230_RK ]
1184 real(RK) :: LogProbGeoCyclic(numTrial)
1185 real(RK) :: Difference(numTrial)
1186
1187 LogProbGeoCyclic = getLogProbGeoCyclic(successProb, maxNumTrial, numTrial, SuccessStep)
1188 Difference = abs(LogProbGeoCyclic - LogProbGeoCyclic_ref) / abs(LogProbGeoCyclic_ref)
1189 assertion = all( Difference < tolerance )
1190
1191 if (test%traceable .and. .not. assertion) then
1192 ! LCOV_EXCL_START
1193 write(test%disp%unit,"(*(g0,:,' '))")
1194 write(test%disp%unit,"(*(g0,:,' '))") "LogProbGeoCyclic_ref =", LogProbGeoCyclic_ref
1195 write(test%disp%unit,"(*(g0,:,' '))") "LogProbGeoCyclic =", LogProbGeoCyclic
1196 write(test%disp%unit,"(*(g0,:,' '))") "Difference =", Difference
1197 write(test%disp%unit,"(*(g0,:,' '))")
1198 end if
1199 ! LCOV_EXCL_STOP
1200
1201 end function test_getLogProbGeoCyclic_1
1202
1203!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1204
1205 function test_getBetaCDF_RK1_1() result(assertion)
1206 use pm_kind, only: RK => RK1
1207 use pm_kind, only: IK
1208 implicit none
1209 logical(LK) :: assertion
1210 integer(IK) , parameter :: nd = 2_IK
1211 real(RK) , parameter :: tolerance = 1.e-12_RK
1212 real(RK) , parameter :: alpha = 2._RK
1213 real(RK) , parameter :: beta = 5._RK
1214 real(RK) , parameter :: val = 0.5_RK
1215 real(RK) , parameter :: betaCDF_ref = 0.890625000000000_RK
1216 real(RK) :: difference
1217 real(RK) :: betaCDF
1218 betaCDF = getBetaCDF(alpha,beta,val)
1219 difference = abs( (betaCDF - betaCDF_ref) / betaCDF_ref )
1220 assertion = difference < tolerance
1221 if (test%traceable .and. .not. assertion) then
1222 ! LCOV_EXCL_START
1223 write(test%disp%unit,"(*(g0,:,', '))")
1224 write(test%disp%unit,"(*(g0,:,', '))") "betaCDF_ref ", betaCDF_ref
1225 write(test%disp%unit,"(*(g0,:,', '))") "betaCDF ", betaCDF
1226 write(test%disp%unit,"(*(g0,:,', '))") "difference ", difference
1227 write(test%disp%unit,"(*(g0,:,', '))")
1228 end if
1229 ! LCOV_EXCL_STOP
1230 assertion = assertion .and. getBetaCDF(alpha,beta,-.01_RK) < 0._RK .and. getBetaCDF(alpha,beta,+1.01_RK) < 0._RK
1231 end function test_getBetaCDF_RK1_1
1232
1233!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1234
1235 function test_getBetaCDF_RK2_1() result(assertion)
1236 use pm_kind, only: RK => RK2
1237 use pm_kind, only: IK
1238 implicit none
1239 logical(LK) :: assertion
1240 integer(IK) , parameter :: nd = 2_IK
1241 real(RK) , parameter :: tolerance = 1.e-12_RK
1242 real(RK) , parameter :: alpha = 2._RK
1243 real(RK) , parameter :: beta = 5._RK
1244 real(RK) , parameter :: val = 0.5_RK
1245 real(RK) , parameter :: betaCDF_ref = 0.890625000000000_RK
1246 real(RK) :: difference
1247 real(RK) :: betaCDF
1248 betaCDF = getBetaCDF(alpha,beta,val)
1249 difference = abs( (betaCDF - betaCDF_ref) / betaCDF_ref )
1250 assertion = difference < tolerance
1251 if (test%traceable .and. .not. assertion) then
1252 ! LCOV_EXCL_START
1253 write(test%disp%unit,"(*(g0,:,', '))")
1254 write(test%disp%unit,"(*(g0,:,', '))") "betaCDF_ref ", betaCDF_ref
1255 write(test%disp%unit,"(*(g0,:,', '))") "betaCDF ", betaCDF
1256 write(test%disp%unit,"(*(g0,:,', '))") "difference ", difference
1257 write(test%disp%unit,"(*(g0,:,', '))")
1258 ! LCOV_EXCL_STOP
1259 end if
1260 assertion = assertion .and. getBetaCDF(alpha,beta,-.01_RK) < 0._RK .and. getBetaCDF(alpha,beta,+1.01_RK) < 0._RK
1261 end function test_getBetaCDF_RK2_1
1262
1263!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1264
1265 function test_getUniformCDF_1() result(assertion)
1266 use pm_kind, only: IK, RK
1267 implicit none
1268 logical(LK) :: assertion
1269 integer(IK) , parameter :: nd = 2_IK
1270 real(RK) , parameter :: tolerance = 1.e-12_RK
1271 real(RK) , parameter :: avg = 2._RK
1272 real(RK) , parameter :: std = 5._RK
1273 real(RK) , parameter :: val = 10._RK
1274 real(RK) , parameter :: uniformCDF_ref = val
1275 real(RK) :: difference
1276 real(RK) :: uniformCDF
1277 uniformCDF = getUniformCDF(val)
1278 difference = abs( (uniformCDF - uniformCDF_ref) / uniformCDF_ref )
1279 assertion = difference < tolerance
1280 if (test%traceable .and. .not. assertion) then
1281 ! LCOV_EXCL_START
1282 write(test%disp%unit,"(*(g0,:,', '))")
1283 write(test%disp%unit,"(*(g0,:,', '))") "uniformCDF_ref ", uniformCDF_ref
1284 write(test%disp%unit,"(*(g0,:,', '))") "uniformCDF ", uniformCDF
1285 write(test%disp%unit,"(*(g0,:,', '))") "difference ", difference
1286 write(test%disp%unit,"(*(g0,:,', '))")
1287 end if
1288 ! LCOV_EXCL_STOP
1289 end function test_getUniformCDF_1
1290
1291!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1292
1293end module test_pm_statistics
pm_err
This module contains classes and procedures for reporting and handling errors.
Definition: pm_err.F90:52
pm_err::MODULE_NAME
character(*, SK), parameter MODULE_NAME
Definition: pm_err.F90:58
pm_kind
This module defines the relevant Fortran kind type-parameters frequently used in the ParaMonte librar...
Definition: pm_kind.F90:268
pm_kind::RK2
integer, parameter RK2
Definition: pm_kind.F90:511
pm_kind::RK
integer, parameter RK
The default real kind in the ParaMonte library: real64 in Fortran, c_double in C-Fortran Interoperati...
Definition: pm_kind.F90:543
pm_kind::LK
integer, parameter LK
The default logical kind in the ParaMonte library: kind(.true.) in Fortran, kind(....
Definition: pm_kind.F90:541
pm_kind::CK
integer, parameter CK
The default complex kind in the ParaMonte library: real64 in Fortran, c_double_complex in C-Fortran I...
Definition: pm_kind.F90:542
pm_kind::IK
integer, parameter IK
The default integer kind in the ParaMonte library: int32 in Fortran, c_int32_t in C-Fortran Interoper...
Definition: pm_kind.F90:540
pm_kind::RK1
integer, parameter RK1
Definition: pm_kind.F90:522
pm_matrixDet
This module contains procedures and generic interfaces relevant to the computation of the determinant...
Definition: pm_matrixDet.F90:95
pm_test
This module contains a simple unit-testing framework for the Fortran libraries, including the ParaMon...
Definition: pm_test.F90:42
test_pm_statistics
This module contains tests of the statistics modules.
Definition: test_pm_statistics.F90:27
test_pm_statistics::test_getLogProbMVU_1
logical(LK) function test_getLogProbMVU_1()
Definition: test_pm_statistics.F90:794
test_pm_statistics::test_getLogProbGeo_1
logical(LK) function test_getLogProbGeo_1()
Definition: test_pm_statistics.F90:1125
test_pm_statistics::test_getLogProbNormMP_RK_1
logical(LK) function test_getLogProbNormMP_RK_1()
Definition: test_pm_statistics.F90:275
test_pm_statistics::test_getRandCorMatRejection_1
logical(LK) function test_getRandCorMatRejection_1()
Definition: test_pm_statistics.F90:1079
test_pm_statistics::test_getLogProbGeoCyclic_1
logical(LK) function test_getLogProbGeoCyclic_1()
Definition: test_pm_statistics.F90:1165
test_pm_statistics::test_getRandGamma_1
logical(LK) function test_getRandGamma_1()
Definition: test_pm_statistics.F90:965
test_pm_statistics::test_getLogProbMixNormSP_RK_1
logical(LK) function test_getLogProbMixNormSP_RK_1()
Definition: test_pm_statistics.F90:397
test_pm_statistics::setTest
subroutine setTest()
Definition: test_pm_statistics.F90:199
test_pm_statistics::test_getBetaCDF_RK2_1
logical(LK) function test_getBetaCDF_RK2_1()
Definition: test_pm_statistics.F90:1236
test_pm_statistics::test_getLogProbLognSP_1
logical(LK) function test_getLogProbLognSP_1()
Definition: test_pm_statistics.F90:820
test_pm_statistics::test_getLogProbNormSP_RK_1
logical(LK) function test_getLogProbNormSP_RK_1()
Definition: test_pm_statistics.F90:237
test_pm_statistics::test_getBetaCDF_RK1_1
logical(LK) function test_getBetaCDF_RK1_1()
Definition: test_pm_statistics.F90:1206
test_pm_statistics::test
type(test_type) test
Definition: test_pm_statistics.F90:36
test_pm_statistics::test_getRandIntLecuyer_1
logical(LK) function test_getRandIntLecuyer_1()
Definition: test_pm_statistics.F90:917
test_pm_statistics::test_getRandRealLecuyer_1
logical(LK) function test_getRandRealLecuyer_1()
Definition: test_pm_statistics.F90:894
test_pm_statistics::test_getRandCorMat_1
logical(LK) function test_getRandCorMat_1()
Definition: test_pm_statistics.F90:1043
test_pm_statistics::test_getLogProbLognMP_1
logical(LK) function test_getLogProbLognMP_1()
Definition: test_pm_statistics.F90:857
test_pm_statistics::test_getUnifRandorm_1
logical(LK) function test_getUnifRandorm_1()
Definition: test_pm_statistics.F90:941
test_pm_statistics::test_getRandBeta_1
logical(LK) function test_getRandBeta_1()
Definition: test_pm_statistics.F90:1015
test_pm_statistics::test_getRandLogn_1
logical(LK) function test_getRandLogn_1()
Definition: test_pm_statistics.F90:783
test_pm_statistics::test_getUniformCDF_1
logical(LK) function test_getUniformCDF_1()
Definition: test_pm_statistics.F90:1266
test_pm_statistics::test_getLogProbNormMP_CK_1
logical(LK) function test_getLogProbNormMP_CK_1()
Definition: test_pm_statistics.F90:355
test_pm_statistics::test_getLogProbMixMVNMP_RK_1
logical(LK) function test_getLogProbMixMVNMP_RK_1()
Definition: test_pm_statistics.F90:534
test_pm_statistics::test_getRandGammaIntShape_1
logical(LK) function test_getRandGammaIntShape_1()
Definition: test_pm_statistics.F90:989
test_pm_statistics::test_getLogProbMixNormMP_RK_1
logical(LK) function test_getLogProbMixNormMP_RK_1()
Definition: test_pm_statistics.F90:439
test_pm_statistics::test_getLogProbMixMVNSP_RK_1
logical(LK) function test_getLogProbMixMVNSP_RK_1()
Definition: test_pm_statistics.F90:483
test_pm_statistics::test_getLogProbNormSP_CK_1
logical(LK) function test_getLogProbNormSP_CK_1()
Definition: test_pm_statistics.F90:317
pm_err::err_type
This is the derived type for generating objects to gracefully and verbosely handle runtime unexpected...
Definition: pm_err.F90:157
pm_test::test_type
This is the derived type test_type for generating objects that facilitate testing of a series of proc...
Definition: pm_test.F90:209