ParaMonte Fortran 2.0.0
Parallel Monte Carlo and Machine Learning Library
See the latest version documentation.
test_pm_matrixInv.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
19
20module test_pm_matrixInv
21
22 use pm_matrixTrans ! LCOV_EXCL_LINE
23 use pm_err, only: err_type
24 use pm_test, only: test_type, LK
25 use pm_kind, only: LK
26
27 implicit none
28
29 private
30 public :: setTest
31 type(test_type) :: test
32
33!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
34
35 interface
36 module function test_placeHolder() result(assertion); logical(LK) :: assertion; end function
37 end interface
38
39!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
40
41contains
42
43!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
44
45 subroutine setTest()
46
47 implicit none
48
49 test = test_type(MODULE_NAME)
50
51 call test%run(test_genInvMat_1, SK_"test_genInvMat_1")
52 call test%run(test_getInvChoLow_1, SK_"test_getInvChoLow_1")
53 call test%run(test_getMatInvLow_1, SK_"test_getMatInvLow_1")
54 call test%run(test_getMatInvDet_1, SK_"test_getMatInvDet_1")
55 !call test%run(test_getMatInvChoUpp_1, SK_"test_getMatInvChoUpp_1")
56
57 call test%run(test_getInvPosDefMat_1, SK_"test_getInvPosDefMat_1")
58 call test%run(test_getInvPosDefMat_2, SK_"test_getInvPosDefMat_2")
59
60 call test%run(test_getMatInvFromChoLow_1, SK_"test_getMatInvFromChoLow_1")
61 call test%run(test_getInvLowFromChoLow_1, SK_"test_getInvLowFromChoLow_1")
62
63 call test%run(test_getInvPosDefMatSqrtDet_1, SK_"test_getInvPosDefMatSqrtDet_1")
64 call test%run(test_getInvPosDefMatSqrtDet_2, SK_"test_getInvPosDefMatSqrtDet_2")
65 call test%run(test_getInvPosDefMatSqrtDet_3, SK_"test_getInvPosDefMatSqrtDet_3")
66
67 call test%summarize()
68
69 end subroutine setTest
70
71!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
72
73 function test_getInvPosDefMatSqrtDet_1() result(assertion)
74
75 use pm_kind, only: IK, RK
76 implicit none
77
78 logical(LK) :: assertion
79 integer(IK) , parameter :: nd = 3_IK
80 real(RK) , parameter :: tolerance = 1.e-12_RK
81 real(RK) , parameter :: PosDefMat(nd,nd) = reshape( [ 1._RK, 0._RK, 1._RK &
82 , 0._RK, 2._RK, 0._RK &
83 , 1._RK, 0._RK, 3._RK ], shape = shape(PosDefMat) )
84 real(RK) , parameter :: MatInvMat_ref(nd,nd) = reshape( [ 1.500000000000000_RK, 0.000000000000000_RK, -0.50000000000000_RK &
85 , 0.000000000000000_RK, 0.500000000000000_RK, 0.000000000000000_RK &
86 , -0.50000000000000_RK, 0.000000000000000_RK, 0.500000000000000_RK ] &
87 , shape = shape(MatInvMat_ref) )
88 real(RK) , parameter :: ChoDia_ref(nd) = [ 1.000000000000000_RK, 1.414213562373095_RK, 1.414213562373095_RK ]
89 real(RK) , parameter :: sqrtDetInvPosDefMat_ref = 0.5_RK
90 real(RK) :: MatInvMat(nd,nd), sqrtDetInvPosDefMat
91 real(RK), allocatable :: MatInvMat_diff(:,:), sqrtDetInvPosDefMat_diff
92
93 MatInvMat = PosDefMat
94
95 call setInvPosDefMatSqrtDet(nd = nd, MatInvMat = MatInvMat, sqrtDetInvPosDefMat = sqrtDetInvPosDefMat)
96
97 ! Gfortran 7.1 fails to automatically reallocate this array. This is not implemented in Gfortran 7.0.0
98 if (allocated(MatInvMat_diff)) deallocate(MatInvMat_diff); allocate(MatInvMat_diff, mold = MatInvMat)
99
100 MatInvMat_diff = abs(MatInvMat - MatInvMat_ref)
101 sqrtDetInvPosDefMat_diff = abs(sqrtDetInvPosDefMat - sqrtDetInvPosDefMat_ref)
102
103 assertion = all(MatInvMat_diff < tolerance) .and. sqrtDetInvPosDefMat_diff < tolerance
104
105 if (test%traceable .and. .not. assertion) then
106 ! LCOV_EXCL_START
107 write(test%disp%unit,"(*(g0,:,', '))")
108 write(test%disp%unit,"(*(g0,:,', '))") "MatInvMat_ref = ", MatInvMat_ref
109 write(test%disp%unit,"(*(g0,:,', '))") "MatInvMat = ", MatInvMat
110 write(test%disp%unit,"(*(g0,:,', '))") "MatInvMat_diff = ", MatInvMat_diff
111 write(test%disp%unit,"(*(g0,:,', '))")
112 write(test%disp%unit,"(*(g0,:,', '))") "sqrtDetInvPosDefMat_ref = ", sqrtDetInvPosDefMat_ref
113 write(test%disp%unit,"(*(g0,:,', '))") "sqrtDetInvPosDefMat_diff = ", sqrtDetInvPosDefMat
114 write(test%disp%unit,"(*(g0,:,', '))") "sqrtDetInvPosDefMat = ", sqrtDetInvPosDefMat_diff
115 write(test%disp%unit,"(*(g0,:,', '))")
116 end if
117 ! LCOV_EXCL_STOP
118
119 end function test_getInvPosDefMatSqrtDet_1
120
121!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
122
125 function test_getInvPosDefMatSqrtDet_2() result(assertion)
126 use pm_kind, only: IK, RK
127 implicit none
128 logical(LK) :: assertion
129 integer(IK) , parameter :: nd = 3_IK
130 real(RK) , parameter :: PosDefMat(nd,nd) = reshape( [ 1._RK, 0._RK, -1._RK &
131 , 0._RK, 2._RK, -0._RK &
132 , 1._RK, 0._RK, -3._RK ], shape = shape(PosDefMat) )
133 real(RK) :: MatInvMat(nd,nd), sqrtDetInvPosDefMat
134
135 MatInvMat = PosDefMat
136
137 call setInvPosDefMatSqrtDet(nd = nd, MatInvMat = MatInvMat, sqrtDetInvPosDefMat = sqrtDetInvPosDefMat)
138
139 assertion = sqrtDetInvPosDefMat < 0._RK
140
141 if (test%traceable .and. .not. assertion) then
142 ! LCOV_EXCL_START
143 write(test%disp%unit,"(*(g0,:,', '))")
144 write(test%disp%unit,"(*(g0,:,', '))") "MatInvMat = ", MatInvMat
145 write(test%disp%unit,"(*(g0,:,', '))") "sqrtDetInvPosDefMat = ", sqrtDetInvPosDefMat
146 write(test%disp%unit,"(*(g0,:,', '))")
147 ! LCOV_EXCL_STOP
148 end if
149
150 end function test_getInvPosDefMatSqrtDet_2
151
152!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
153
156 function test_getInvPosDefMatSqrtDet_3() result(assertion)
157 use pm_kind, only: IK, RK
158 implicit none
159 logical(LK) :: assertion
160 integer(IK) , parameter :: nd = 1_IK
161 real(RK) , parameter :: tolerance = 1.e-12_RK
162 real(RK) , parameter :: MatInvMat_ref(nd,nd) = reshape( [ 0.5_RK ], shape = shape(MatInvMat_ref) )
163 real(RK) , parameter :: PosDefMat(nd,nd) = reshape( [ 2._RK ], shape = shape(PosDefMat) )
164 real(RK) , parameter :: sqrtDetInvPosDefMat_ref = 0.5_RK
165 real(RK) :: MatInvMat(nd,nd), sqrtDetInvPosDefMat
166 real(RK), allocatable :: MatInvMat_diff(:,:), sqrtDetInvPosDefMat_diff
167
168 MatInvMat = PosDefMat
169
170 call setInvPosDefMatSqrtDet(nd = nd, MatInvMat = MatInvMat, sqrtDetInvPosDefMat = sqrtDetInvPosDefMat)
171 if (allocated(MatInvMat_diff)) deallocate(MatInvMat_diff); allocate(MatInvMat_diff, mold = MatInvMat)
172
173 MatInvMat_diff = abs(MatInvMat - MatInvMat_ref)
174 sqrtDetInvPosDefMat_diff = abs(sqrtDetInvPosDefMat - sqrtDetInvPosDefMat_ref)
175
176 assertion = all(MatInvMat_diff < tolerance) .and. sqrtDetInvPosDefMat_diff < tolerance
177
178 if (test%traceable .and. .not. assertion) then
179 ! LCOV_EXCL_START
180 write(test%disp%unit,"(*(g0,:,', '))")
181 write(test%disp%unit,"(*(g0,:,', '))") "MatInvMat_ref = ", MatInvMat_ref
182 write(test%disp%unit,"(*(g0,:,', '))") "MatInvMat = ", MatInvMat
183 write(test%disp%unit,"(*(g0,:,', '))") "MatInvMat_diff = ", MatInvMat_diff
184 write(test%disp%unit,"(*(g0,:,', '))")
185 write(test%disp%unit,"(*(g0,:,', '))") "sqrtDetInvPosDefMat_ref = ", sqrtDetInvPosDefMat_ref
186 write(test%disp%unit,"(*(g0,:,', '))") "sqrtDetInvPosDefMat_diff = ", sqrtDetInvPosDefMat
187 write(test%disp%unit,"(*(g0,:,', '))") "sqrtDetInvPosDefMat = ", sqrtDetInvPosDefMat_diff
188 write(test%disp%unit,"(*(g0,:,', '))")
189 end if
190 ! LCOV_EXCL_STOP
191
192
193 end function test_getInvPosDefMatSqrtDet_3
194
195!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
196
197 function test_getMatInvFromChoLow_1() result(assertion)
198
199 use pm_kind, only: IK, RK
200 implicit none
201
202 logical(LK) :: assertion
203 integer(IK) , parameter :: nd = 3_IK
204 real(RK) , parameter :: tolerance = 1.e-12_RK
205 real(RK) , parameter :: choLow(nd,nd) = reshape( [ 1.000000000000000_RK, 0.000000000000000_RK, 1.000000000000000_RK &
206 , 0.000000000000000_RK, 2.000000000000000_RK, 0.000000000000000_RK &
207 , 1.000000000000000_RK, 0.000000000000000_RK, 3.000000000000000_RK ] &
208 , shape = shape(choLow) )
209 real(RK) , parameter :: choDia(nd) = [ 1.000000000000000_RK, 1.414213562373095_RK, 1.414213562373095_RK ]
210 real(RK) , parameter :: ChoDia_ref(nd) = [ 1.000000000000000_RK, 1.414213562373095_RK, 1.414213562373095_RK ]
211 real(RK) , parameter :: InvMatFromChoLow_ref(nd,nd) = reshape( [ 1.500000000000000_RK, 0.000000000000000_RK, -0.50000000000000_RK &
212 , 0.000000000000000_RK, 0.500000000000000_RK, 0.000000000000000_RK &
213 , -0.50000000000000_RK, 0.000000000000000_RK, 0.500000000000000_RK ] &
214 , shape = shape(InvMatFromChoLow_ref) )
215 real(RK) , parameter :: sqrtDetInvPosDefMat_ref = 0.5_RK
216 real(RK) :: InvMatFromChoLow(nd,nd)
217 real(RK), allocatable :: InvMatFromChoLow_diff(:,:)
218
219 InvMatFromChoLow = getMatInvFromChoLow(nd = nd, choLow = choLow, choDia = choDia)
220
221 ! Gfortran 7.1 fails to automatically reallocate this array. This is not implemented in Gfortran 7.0.0
222 if (allocated(InvMatFromChoLow_diff)) deallocate(InvMatFromChoLow_diff); allocate(InvMatFromChoLow_diff, mold = InvMatFromChoLow)
223
224 InvMatFromChoLow_diff = abs(InvMatFromChoLow - InvMatFromChoLow_ref)
225
226 assertion = all(InvMatFromChoLow_diff < tolerance)
227
228 if (test%traceable .and. .not. assertion) then
229 ! LCOV_EXCL_START
230 write(test%disp%unit,"(*(g0,:,', '))")
231 write(test%disp%unit,"(*(g0,:,', '))") "InvMatFromChoLow_ref = ", InvMatFromChoLow_ref
232 write(test%disp%unit,"(*(g0,:,', '))") "InvMatFromChoLow = ", InvMatFromChoLow
233 write(test%disp%unit,"(*(g0,:,', '))") "InvMatFromChoLow_diff = ", InvMatFromChoLow_diff
234 write(test%disp%unit,"(*(g0,:,', '))")
235 end if
236 ! LCOV_EXCL_STOP
237
238 end function test_getMatInvFromChoLow_1
239
240!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
241
242 function test_getInvLowFromChoLow_1() result(assertion)
243
244 use pm_matrixSymCopy, only: setMatSymFromMatLow
245 use pm_kind, only: IK, RK
246 implicit none
247
248 logical(LK) :: assertion
249 integer(IK) , parameter :: nd = 3_IK
250 real(RK) , parameter :: tolerance = 1.e-12_RK
251 real(RK) , parameter :: choLow(nd,nd) = reshape( [ 1.000000000000000_RK, 0.000000000000000_RK, 1.000000000000000_RK &
252 , 0.000000000000000_RK, 2.000000000000000_RK, 0.000000000000000_RK &
253 , 1.000000000000000_RK, 0.000000000000000_RK, 3.000000000000000_RK ] &
254 , shape = shape(choLow) )
255 real(RK) , parameter :: choDia(nd) = [ 1.000000000000000_RK, 1.414213562373095_RK, 1.414213562373095_RK ]
256 real(RK) , parameter :: ChoDia_ref(nd) = [ 1.000000000000000_RK, 1.414213562373095_RK, 1.414213562373095_RK ]
257 real(RK) , parameter :: InvMatFromChoLow_ref(nd,nd) = reshape( [ 1.500000000000000_RK, 0.000000000000000_RK, -0.50000000000000_RK &
258 , 0.000000000000000_RK, 0.500000000000000_RK, 0.000000000000000_RK &
259 , -0.50000000000000_RK, 0.000000000000000_RK, 0.500000000000000_RK ] &
260 , shape = shape(InvMatFromChoLow_ref) )
261 real(RK) , parameter :: sqrtDetInvPosDefMat_ref = 0.5_RK
262 real(RK) :: InvMatFromChoLow(nd,nd)
263 real(RK), allocatable :: InvMatFromChoLow_diff(:,:)
264
265 InvMatFromChoLow = getInvLowFromChoLow(nd = nd, choLow = choLow, choDia = choDia)
266 call setMatSymFromMatLow(InvMatFromChoLow)
267
268 allocate(InvMatFromChoLow_diff, mold = InvMatFromChoLow)
269
270 InvMatFromChoLow_diff = abs(InvMatFromChoLow - InvMatFromChoLow_ref)
271
272 assertion = all(InvMatFromChoLow_diff < tolerance)
273
274 if (test%traceable .and. .not. assertion) then
275 ! LCOV_EXCL_START
276 write(test%disp%unit,"(*(g0,:,', '))")
277 write(test%disp%unit,"(*(g0,:,', '))") "InvMatFromChoLow_ref = ", InvMatFromChoLow_ref
278 write(test%disp%unit,"(*(g0,:,', '))") "InvMatFromChoLow = ", InvMatFromChoLow
279 write(test%disp%unit,"(*(g0,:,', '))") "InvMatFromChoLow_diff = ", InvMatFromChoLow_diff
280 write(test%disp%unit,"(*(g0,:,', '))")
281 ! LCOV_EXCL_STOP
282 end if
283
284 ! Gfortran 7.1 fails to automatically reallocate this array. This is not implemented in Gfortran 7.0.0
285 deallocate(InvMatFromChoLow_diff)
286
287 end function test_getInvLowFromChoLow_1
288
289!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
290
291 function test_getInvPosDefMat_1() result(assertion)
292
293 use pm_kind, only: IK, RK
294 implicit none
295
296 logical(LK) :: assertion
297 integer(IK) , parameter :: nd = 3_IK
298 real(RK) , parameter :: tolerance = 1.e-12_RK
299 real(RK) , parameter :: PosDefMat(nd,nd) = reshape( [ 1._RK, 0._RK, 1._RK &
300 , 0._RK, 2._RK, 0._RK &
301 , 1._RK, 0._RK, 3._RK ], shape = shape(PosDefMat) )
302 real(RK) , parameter :: MatInvMat_ref(nd,nd) = reshape( [ 1.500000000000000_RK, 0.000000000000000_RK, -0.50000000000000_RK &
303 , 0.000000000000000_RK, 0.500000000000000_RK, 0.000000000000000_RK &
304 , -0.50000000000000_RK, 0.000000000000000_RK, 0.500000000000000_RK ] &
305 , shape = shape(MatInvMat_ref) )
306 real(RK) :: MatInvMat(nd,nd)
307 real(RK), allocatable :: MatInvMat_diff(:,:)
308
309 MatInvMat = getInvPosDefMat(nd = nd, PosDefMat = PosDefMat)
310
311 ! Gfortran 7.1 fails to automatically reallocate this array. This is not implemented in Gfortran 7.0.0
312 if (allocated(MatInvMat_diff)) deallocate(MatInvMat_diff); allocate(MatInvMat_diff, mold = MatInvMat)
313 MatInvMat_diff = abs(MatInvMat - MatInvMat_ref)
314
315 assertion = all(MatInvMat_diff < tolerance)
316
317 if (test%traceable .and. .not. assertion) then
318 ! LCOV_EXCL_START
319 write(test%disp%unit,"(*(g0,:,', '))")
320 write(test%disp%unit,"(*(g0,:,', '))") "MatInvMat_ref = ", MatInvMat_ref
321 write(test%disp%unit,"(*(g0,:,', '))") "MatInvMat = ", MatInvMat
322 write(test%disp%unit,"(*(g0,:,', '))") "MatInvMat_diff = ", MatInvMat_diff
323 write(test%disp%unit,"(*(g0,:,', '))")
324 ! LCOV_EXCL_STOP
325 end if
326
327 end function test_getInvPosDefMat_1
328
329!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
330
333 function test_getInvPosDefMat_2() result(assertion)
334
335 use pm_kind, only: IK, RK
336 implicit none
337
338 logical(LK) :: assertion
339 integer(IK) , parameter :: nd = 3_IK
340 real(RK) , parameter :: PosDefMat(nd,nd) = reshape( [ 1._RK, 0._RK, -1._RK &
341 , 0._RK, 2._RK, -0._RK &
342 , 1._RK, 0._RK, -3._RK ], shape = shape(PosDefMat) )
343 real(RK) :: MatInvMat(nd,nd)
344
345 MatInvMat = getInvPosDefMat(nd = nd, PosDefMat = PosDefMat)
346
347 assertion = MatInvMat(1,1) < 0._RK
348
349 if (test%traceable .and. .not. assertion) then
350 ! LCOV_EXCL_START
351 write(test%disp%unit,"(*(g0,:,', '))")
352 write(test%disp%unit,"(*(g0,:,', '))") "MatInvMat = ", MatInvMat
353 write(test%disp%unit,"(*(g0,:,', '))")
354 end if
355 ! LCOV_EXCL_STOP
356
357 end function test_getInvPosDefMat_2
358
359!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
360
361 function test_getMatInvDet_1() result(assertion)
362
363 use pm_kind, only: IK, RK
364 implicit none
365
366 logical(LK) :: assertion
367 integer(IK) , parameter :: nd = 3_IK
368 real(RK) , parameter :: tolerance = 1.e-12_RK
369 real(RK) , parameter :: PosDefMat(nd,nd) = reshape( [ 1._RK, 0._RK, 1._RK &
370 , 0._RK, 2._RK, 0._RK &
371 , 1._RK, 0._RK, 3._RK ], shape = shape(PosDefMat) )
372 real(RK) , parameter :: MatInvMat_ref(nd,nd) = reshape( [ 1.500000000000000_RK, 0.000000000000000_RK, -0.50000000000000_RK &
373 , 0.000000000000000_RK, 0.500000000000000_RK, 0.000000000000000_RK &
374 , -0.50000000000000_RK, 0.000000000000000_RK, 0.500000000000000_RK ] &
375 , shape = shape(MatInvMat_ref) )
376 real(RK) , parameter :: MatrixLUP_ref(nd,nd) = reshape( [ 1.000000000000000_RK, 0.000000000000000_RK, 1.000000000000000_RK &
377 , 0.000000000000000_RK, 2.000000000000000_RK, 0.000000000000000_RK &
378 , 1.000000000000000_RK, 0.000000000000000_RK, 2.000000000000000_RK ] &
379 , shape = shape(MatInvMat_ref) )
380 real(RK) , parameter :: detInvMat_ref = 0.25_RK
381 real(RK) :: MatInvMat(nd,nd), detInvMat, detInvMat_diff
382 real(RK), allocatable :: MatrixLUP(:,:), MatInvMat_diff(:,:), MatrixLUP_diff(:,:)
383
384 MatrixLUP = PosDefMat
385
386 call getMatInvDet(nd = nd, MatrixLUP = MatrixLUP, InverseMatrix = MatInvMat, detInvMat = detInvMat, failed = assertion)
387 assertion = .not. assertion
388 call test%assert(assertion)
389
390 ! Gfortran 7.1 fails to automatically reallocate this array. This is not implemented in Gfortran 7.0.0
391 if (allocated(MatrixLUP_diff)) deallocate(MatrixLUP_diff); allocate(MatrixLUP_diff, mold = MatrixLUP)
392 MatrixLUP_diff = abs(MatrixLUP - MatrixLUP_ref)
393
394 ! Gfortran 7.1 fails to automatically reallocate this array. This is not implemented in Gfortran 7.0.0
395 if (allocated(MatInvMat_diff)) deallocate(MatInvMat_diff); allocate(MatInvMat_diff, mold = MatInvMat)
396 MatInvMat_diff = abs(MatInvMat - MatInvMat_ref)
397
398 detInvMat_diff = abs(detInvMat - detInvMat_ref)
399
400 assertion = all(MatInvMat_diff < tolerance) .and. detInvMat_diff < tolerance
401
402 if (test%traceable .and. .not. assertion) then
403 ! LCOV_EXCL_START
404 write(test%disp%unit,"(*(g0,:,', '))")
405 write(test%disp%unit,"(*(g0,:,', '))") "MatrixLUP_ref = ", MatrixLUP_ref
406 write(test%disp%unit,"(*(g0,:,', '))") "MatrixLUP = ", MatrixLUP
407 write(test%disp%unit,"(*(g0,:,', '))") "MatrixLUP_diff = ", MatrixLUP_diff
408 write(test%disp%unit,"(*(g0,:,', '))")
409 write(test%disp%unit,"(*(g0,:,', '))") "MatInvMat_ref = ", MatInvMat_ref
410 write(test%disp%unit,"(*(g0,:,', '))") "MatInvMat = ", MatInvMat
411 write(test%disp%unit,"(*(g0,:,', '))") "MatInvMat_diff = ", MatInvMat_diff
412 write(test%disp%unit,"(*(g0,:,', '))")
413 write(test%disp%unit,"(*(g0,:,', '))") "detInvMat_ref = ", detInvMat_ref
414 write(test%disp%unit,"(*(g0,:,', '))") "detInvMat = ", detInvMat
415 write(test%disp%unit,"(*(g0,:,', '))") "detInvMat_diff = ", detInvMat_diff
416 write(test%disp%unit,"(*(g0,:,', '))")
417 end if
418 ! LCOV_EXCL_STOP
419
420 end function test_getMatInvDet_1
421
422!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
423
424 function test_genInvMat_1() result(assertion)
425
426 use pm_kind, only: IK, RK
427 implicit none
428
429 logical(LK) :: assertion
430 integer(IK) , parameter :: nd = 3_IK
431 real(RK) , parameter :: tolerance = 1.e-12_RK
432 real(RK) , parameter :: PosDefMat(nd,nd) = reshape( [ 1._RK, 0._RK, 1._RK &
433 , 0._RK, 2._RK, 0._RK &
434 , 1._RK, 0._RK, 3._RK ], shape = shape(PosDefMat) )
435 real(RK) , parameter :: InverseMatrix_ref(nd,nd) = reshape( [ 1.500000000000000_RK, 0.000000000000000_RK, -0.50000000000000_RK &
436 , 0.000000000000000_RK, 0.500000000000000_RK, 0.000000000000000_RK &
437 , -0.50000000000000_RK, 0.000000000000000_RK, 0.500000000000000_RK ] &
438 , shape = shape(InverseMatrix_ref) )
439 real(RK) :: InverseMatrix(nd,nd)
440 real(RK), allocatable :: InverseMatrix_diff(:,:)
441
442 InverseMatrix = getMatInv(nd = nd, Matrix = PosDefMat)
443
444 ! Gfortran 7.1 fails to automatically reallocate this array. This is not implemented in Gfortran 7.0.0
445 if (allocated(InverseMatrix_diff)) deallocate(InverseMatrix_diff); allocate(InverseMatrix_diff, mold = InverseMatrix)
446
447 InverseMatrix_diff = abs(InverseMatrix - InverseMatrix_ref)
448
449 assertion = all(InverseMatrix_diff < tolerance)
450
451 if (test%traceable .and. .not. assertion) then
452 ! LCOV_EXCL_START
453 write(test%disp%unit,"(*(g0,:,', '))")
454 write(test%disp%unit,"(*(g0,:,', '))") "InverseMatrix_ref = ", InverseMatrix_ref
455 write(test%disp%unit,"(*(g0,:,', '))") "InverseMatrix = ", InverseMatrix
456 write(test%disp%unit,"(*(g0,:,', '))") "InverseMatrix_diff = ", InverseMatrix_diff
457 write(test%disp%unit,"(*(g0,:,', '))")
458 end if
459 ! LCOV_EXCL_STOP
460
461 end function test_genInvMat_1
462
463!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
464
465 function test_getMatInvLow_1() result(assertion)
466
467 use pm_kind, only: IK, RK
468 implicit none
469
470 logical(LK) :: assertion
471 integer(IK) :: i,j
472 integer(IK) , parameter :: nd = 3_IK
473 real(RK) , parameter :: tolerance = 1.e-12_RK
474 real(RK) , parameter :: PosDefMat(nd,nd) = reshape( [ 1.00_RK, +0.25_RK, +1.0_RK &
475 , 0.25_RK, +2.00_RK, -0.5_RK &
476 , 1.00_RK, -0.50_RK, +3.0_RK ], shape = shape(PosDefMat) )
477 ! This is the Cholesky lower of the `PosDefMat`.
478 real(RK) , parameter :: MatLow(nd,nd) = transpose(reshape( [ 1.00_RK, 0._RK, 0._RK &
479 , 0.25_RK, +1.391941090707505_RK, 0._RK &
480 , 1.00_RK, -0.538815906080325_RK, 1.307546335452338_RK ], shape = shape(MatLow)))
481 real(RK) , parameter :: InvMatLow_ref(nd,nd) = transpose(reshape([ +1.000000000000000_RK, 0._RK, 0._RK &
482 , -0.179605302026775_RK, 0.718421208107100_RK, 0._RK &
483 , -0.838803309535462_RK, 0.296048226894869_RK, 0.764791252811745_RK ], shape = shape(InvMatLow_ref)))
484 real(RK) :: InvMatLow(nd,nd)
485 real(RK), allocatable :: InvMatLow_diff(:)
486
487 InvMatLow = getLogPDF(nd, MatLow)
488
489 InvMatLow_diff = abs([((InvMatLow(i,j) - InvMatLow_ref(i,j), i = j, nd), j = 1, nd)])
490 assertion = all(InvMatLow_diff < tolerance)
491
492 if (test%traceable .and. .not. assertion) then
493 ! LCOV_EXCL_START
494 write(test%disp%unit,"(*(g0,:,', '))")
495 write(test%disp%unit,"(*(g0,:,', '))") "InvMatLow_ref = ", InvMatLow_ref
496 write(test%disp%unit,"(*(g0,:,', '))") "InvMatLow = ", InvMatLow
497 write(test%disp%unit,"(*(g0,:,', '))") "InvMatLow_diff = ", InvMatLow_diff
498 write(test%disp%unit,"(*(g0,:,', '))")
499 ! LCOV_EXCL_STOP
500 end if
501
502 ! Gfortran 7.1 fails to automatically reallocate this array. This is not implemented in Gfortran 7.0.0
503 deallocate(InvMatLow_diff)
504
505 end function test_getMatInvLow_1
506
507!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
508
509 function test_getInvChoLow_1() result(assertion)
510
511 use pm_kind, only: IK, RK
512 implicit none
513
514 logical(LK) :: assertion
515 integer(IK) :: i,j
516 integer(IK) , parameter :: nd = 3_IK
517 real(RK) , parameter :: tolerance = 1.e-12_RK
518 real(RK) , parameter :: PosDefMat(nd,nd) = reshape( [ 1.00_RK, +0.25_RK, +1.0_RK &
519 , 0.25_RK, +2.00_RK, -0.5_RK &
520 , 1.00_RK, -0.50_RK, +3.0_RK ], shape = shape(PosDefMat) )
521 ! This is the Cholesky lower of the `PosDefMat`.
522 real(RK) , parameter :: MatLow(nd,nd) = transpose(reshape( [ 0.00_RK, 0._RK, 0._RK &
523 , 0.25_RK, 0._RK, 0._RK &
524 , 1.00_RK, -0.538815906080325_RK, 0._RK ], shape = shape(MatLow)))
525 real(RK) , parameter :: DiagMat(nd) = [1.00_RK, 1.391941090707505_RK, 1.307546335452338_RK]
526 real(RK) , parameter :: InvMatLow_ref(nd,nd) = transpose(reshape([ +1.000000000000000_RK, 0._RK, 0._RK &
527 , -0.179605302026775_RK, 0.718421208107100_RK, 0._RK &
528 , -0.838803309535462_RK, 0.296048226894869_RK, 0.764791252811745_RK ], shape = shape(InvMatLow_ref)))
529 real(RK) :: InvMatLow(nd,nd)
530 real(RK), allocatable :: InvMatLow_diff(:)
531
532 InvMatLow = getLogPDF(nd, MatLow, DiagMat)
533
534 InvMatLow_diff = abs([((InvMatLow(i,j) - InvMatLow_ref(i,j), i = j, nd), j = 1, nd)])
535 assertion = all(InvMatLow_diff < tolerance)
536
537 if (test%traceable .and. .not. assertion) then
538 ! LCOV_EXCL_START
539 write(test%disp%unit,"(*(g0,:,', '))")
540 write(test%disp%unit,"(*(g0,:,', '))") "InvMatLow_ref = ", InvMatLow_ref
541 write(test%disp%unit,"(*(g0,:,', '))") "InvMatLow = ", InvMatLow
542 write(test%disp%unit,"(*(g0,:,', '))") "InvMatLow_diff = ", InvMatLow_diff
543 write(test%disp%unit,"(*(g0,:,', '))")
544 ! LCOV_EXCL_STOP
545 end if
546
547 ! Gfortran 7.1 fails to automatically reallocate this array. This is not implemented in Gfortran 7.0.0
548 deallocate(InvMatLow_diff)
549
550 end function test_getInvChoLow_1
551
552!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
553
554! function test_getMatInvChoUpp_1() result(assertion)
555!
556! use pm_kind, only: IK, RK
557! implicit none
558!
559! logical(LK) :: assertion
560! integer(IK) , parameter :: nd = 3_IK
561! real(RK) , parameter :: tolerance = 1.e-12_RK
562! real(RK) , parameter :: PosDefMat(nd,nd) = reshape( [ +2.0_RK, 0.5_RK, -0.3_RK &
563! , +0.5_RK, 1.0_RK, +0.1_RK &
564! , -0.3_RK, 0.1_RK, +5.0_RK &
565! ] , shape = shape(PosDefMat) )
566! real(RK) , parameter :: InvMatChoUpp_ref(nd,nd) = transpose( reshape([ +0.579558652729384_RK, -0.385983440243132_RK, +0.053396918610710_RK &
567! , -0.293844367015099_RK, +1.150987224157956_RK, -0.020020030050088_RK &
568! , +0.040650406504065_RK, -0.040650406504065_RK, +0.203252032520325_RK &
569! ], shape = shape(InvMatChoUpp_ref) ))
570! real(RK) , parameter :: InvMatChoDia_ref(nd) = [ 0.761287496764123_RK, 1.001001502504383_RK, 0.447213595499958_RK]
571! real(RK) :: InvMatChoUpp(nd,nd)
572! real(RK) :: InvMatChoDia(nd)
573! real(RK), allocatable :: InvMatChoDia_diff(:)
574! real(RK), allocatable :: InvMatChoUpp_diff(:,:)
575! real(RK) :: choLow(nd,nd)
576! real(RK) :: choDia(nd)
577!
578! choLow = PosDefMat
579! call setChoLow(choLow, choDia, nd)
580! call getMatInvChoUpp(nd,choLow,choDia,InvMatChoUpp,InvMatChoDia)
581!
582! InvMatChoUpp_diff = abs(InvMatChoUpp - InvMatChoUpp_ref)
583! assertion = all(InvMatChoUpp_diff < tolerance)
584! call test%assert(assertion)
585!
586! InvMatChoDia_diff = abs(InvMatChoDia - InvMatChoDia_ref)
587! assertion = assertion .and. all(InvMatChoDia_diff < tolerance)
588! call test%assert(assertion)
589!
590! if (test%traceable .and. .not. assertion) then
591! ! LCOV_EXCL_START
592! write(test%disp%unit,"(*(g0,:,', '))")
593! write(test%disp%unit,"(*(g0,:,', '))") "InvMatChoUpp_ref = ", InvMatChoUpp_ref
594! write(test%disp%unit,"(*(g0,:,', '))") "InvMatChoUpp = ", InvMatChoUpp
595! write(test%disp%unit,"(*(g0,:,', '))") "InvMatChoUpp_diff = ", InvMatChoUpp_diff
596! write(test%disp%unit,"(*(g0,:,', '))") "InvMatChoDia_ref = ", InvMatChoDia_ref
597! write(test%disp%unit,"(*(g0,:,', '))") "InvMatChoDia = ", InvMatChoDia
598! write(test%disp%unit,"(*(g0,:,', '))") "InvMatChoDia_diff = ", InvMatChoDia_diff
599! write(test%disp%unit,"(*(g0,:,', '))")
600! ! LCOV_EXCL_STOP
601! end if
602!
603! ! Gfortran 7.1 fails to automatically reallocate this array. This is not implemented in Gfortran 7.0.0
604! deallocate(InvMatChoUpp_diff)
605!
606! end function test_getMatInvChoUpp_1
607
608!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
609
610end module test_pm_matrixInv ! LCOV_EXCL_LINE
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::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::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_matrixTrans
This module contains abstract and concrete derived types and procedures related to various common mat...
Definition: pm_matrixTrans.F90:104
pm_test
This module contains a simple unit-testing framework for the Fortran libraries, including the ParaMon...
Definition: pm_test.F90:42
test_pm_matrixInv
This module contains tests of the module pm_matrixInv.
Definition: test_pm_matrixInv.F90:20
test_pm_matrixInv::test_getInvChoLow_1
logical(LK) function test_getInvChoLow_1()
Definition: test_pm_matrixInv.F90:510
test_pm_matrixInv::test_getMatInvLow_1
logical(LK) function test_getMatInvLow_1()
Definition: test_pm_matrixInv.F90:466
test_pm_matrixInv::test_getInvPosDefMat_1
logical(LK) function test_getInvPosDefMat_1()
Definition: test_pm_matrixInv.F90:292
test_pm_matrixInv::test_genInvMat_1
logical(LK) function test_genInvMat_1()
Definition: test_pm_matrixInv.F90:425
test_pm_matrixInv::test_getInvPosDefMatSqrtDet_3
logical(LK) function test_getInvPosDefMatSqrtDet_3()
Test with an 1-dimensional input matrix.
Definition: test_pm_matrixInv.F90:157
test_pm_matrixInv::test
type(test_type) test
Definition: test_pm_matrixInv.F90:31
test_pm_matrixInv::test_getMatInvFromChoLow_1
logical(LK) function test_getMatInvFromChoLow_1()
Definition: test_pm_matrixInv.F90:198
test_pm_matrixInv::test_getInvPosDefMatSqrtDet_1
logical(LK) function test_getInvPosDefMatSqrtDet_1()
Definition: test_pm_matrixInv.F90:74
test_pm_matrixInv::setTest
subroutine setTest()
Definition: test_pm_matrixInv.F90:46
test_pm_matrixInv::test_getInvPosDefMat_2
logical(LK) function test_getInvPosDefMat_2()
The first element of MatInvMat must be set to a negative value, if the input matrix is non-positive-d...
Definition: test_pm_matrixInv.F90:334
test_pm_matrixInv::test_getInvPosDefMatSqrtDet_2
logical(LK) function test_getInvPosDefMatSqrtDet_2()
The output sqrtDetInvPosDefMat must be set to a negative value, if the input matrix is non-positive-d...
Definition: test_pm_matrixInv.F90:126
test_pm_matrixInv::test_getMatInvDet_1
logical(LK) function test_getMatInvDet_1()
Definition: test_pm_matrixInv.F90:362
test_pm_matrixInv::test_getInvLowFromChoLow_1
logical(LK) function test_getInvLowFromChoLow_1()
Definition: test_pm_matrixInv.F90:243
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