Line data Source code
1 : !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
2 : !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
3 : !!!!
4 : !!!! MIT License
5 : !!!!
6 : !!!! ParaMonte: plain powerful parallel Monte Carlo library.
7 : !!!!
8 : !!!! Copyright (C) 2012-present, The Computational Data Science Lab
9 : !!!!
10 : !!!! This file is part of the ParaMonte library.
11 : !!!!
12 : !!!! Permission is hereby granted, free of charge, to any person obtaining a
13 : !!!! copy of this software and associated documentation files (the "Software"),
14 : !!!! to deal in the Software without restriction, including without limitation
15 : !!!! the rights to use, copy, modify, merge, publish, distribute, sublicense,
16 : !!!! and/or sell copies of the Software, and to permit persons to whom the
17 : !!!! Software is furnished to do so, subject to the following conditions:
18 : !!!!
19 : !!!! The above copyright notice and this permission notice shall be
20 : !!!! included in all copies or substantial portions of the Software.
21 : !!!!
22 : !!!! THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
23 : !!!! EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
24 : !!!! MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
25 : !!!! IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM,
26 : !!!! DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR
27 : !!!! OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE
28 : !!!! OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
29 : !!!!
30 : !!!! ACKNOWLEDGMENT
31 : !!!!
32 : !!!! ParaMonte is an honor-ware and its currency is acknowledgment and citations.
33 : !!!! As per the ParaMonte library license agreement terms, if you use any parts of
34 : !!!! this library for any purposes, kindly acknowledge the use of ParaMonte in your
35 : !!!! work (education/research/industry/development/...) by citing the ParaMonte
36 : !!!! library as described on this page:
37 : !!!!
38 : !!!! https://github.com/cdslaborg/paramonte/blob/main/ACKNOWLEDGMENT.md
39 : !!!!
40 : !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
41 : !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
42 :
43 : !> \brief This module contains tests of the module [Misc_mod](@ref misc_mod).
44 : !> \author Amir Shahmoradi
45 :
46 : module Test_Misc_mod
47 :
48 : use Misc_mod
49 : use Err_mod, only: Err_type
50 : use Test_mod, only: Test_type
51 : implicit none
52 :
53 : private
54 : public :: test_Misc
55 :
56 : type(Test_type) :: Test
57 :
58 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
59 :
60 : contains
61 :
62 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
63 :
64 1 : subroutine test_Misc()
65 : implicit none
66 1 : Test = Test_type(moduleName=MODULE_NAME)
67 1 : call Test%run(test_arth_IK_1, "test_arth_IK_1")
68 1 : call Test%run(test_arth_RK_1, "test_arth_RK_1")
69 1 : call Test%run(test_arth_RK_2, "test_arth_RK_2")
70 1 : call Test%run(test_swap_IK_1, "test_swap_IK_1")
71 1 : call Test%run(test_swap_RK_1, "test_swap_RK_1")
72 1 : call Test%run(test_swap_CK_1, "test_swap_RK_1")
73 1 : call Test%run(test_swap_SPI_1, "test_swap_SPI_1")
74 1 : call Test%run(test_swap_DPI_1, "test_swap_DPI_1")
75 1 : call Test%run(test_swap_SPR_1, "test_swap_SPR_1")
76 1 : call Test%run(test_swap_DPR_1, "test_swap_DPR_1")
77 1 : call Test%run(test_swap_SPC_1, "test_swap_SPC_1")
78 1 : call Test%run(test_swap_DPC_1, "test_swap_DPC_1")
79 1 : call Test%run(test_zroots_unity_1, "test_zroots_unity_1")
80 1 : call Test%run(test_copyArray_IK_1, "test_copyArray_IK_1")
81 1 : call Test%run(test_copyArray_IK_2, "test_copyArray_IK_2")
82 1 : call Test%run(test_copyArray_RK_1, "test_copyArray_RK_1")
83 1 : call Test%run(test_copyArray_RK_2, "test_copyArray_RK_2")
84 1 : call Test%run(test_resizeVector_RK_1, "test_resizeVector_RK_1")
85 1 : call Test%run(test_masked_swap_SPR_1, "test_masked_swap_SPR_1")
86 1 : call Test%run(test_masked_swap_SPR_2, "test_masked_swap_SPR_2")
87 1 : call Test%run(test_masked_swap_SPRV_1, "test_masked_swap_SPRV_1")
88 1 : call Test%run(test_masked_swap_SPRM_1, "test_masked_swap_SPRM_1")
89 1 : call Test%run(test_findUnique_1, "test_findUnique_1")
90 1 : call Test%finalize()
91 1 : end subroutine test_Misc
92 :
93 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
94 :
95 1 : function test_swap_IK_1() result(assertion)
96 1 : use Constants_mod, only: IK
97 : implicit none
98 : logical :: assertion
99 : integer(IK) :: i
100 : integer(IK) , parameter :: vecLen = 3_IK
101 : integer(IK) , parameter :: Vector1_ref(vecLen) = [(+i,i=1,vecLen)]
102 : integer(IK) , parameter :: Vector2_ref(vecLen) = [(-i,i=1,vecLen)]
103 : integer(IK) :: Vector1(vecLen)
104 : integer(IK) :: Vector2(vecLen)
105 1 : Vector1 = Vector1_ref
106 1 : Vector2 = Vector2_ref
107 4 : call swap_IK(Vector1,Vector2)
108 7 : assertion = all(Vector1==Vector2_ref) .and. all(Vector2==Vector1_ref)
109 1 : if (Test%isDebugMode .and. .not. assertion) then
110 : ! LCOV_EXCL_START
111 : write(Test%outputUnit,"(*(g0,:,' '))")
112 : write(Test%outputUnit,"(*(g0,:,' '))") "Vector1_ref =", Vector1_ref
113 : write(Test%outputUnit,"(*(g0,:,' '))") "Vector2 =", Vector2
114 : write(Test%outputUnit,"(*(g0,:,' '))") "Vector2_ref =", Vector2_ref
115 : write(Test%outputUnit,"(*(g0,:,' '))") "Vector1 =", Vector1
116 : write(Test%outputUnit,"(*(g0,:,' '))")
117 : end if
118 : ! LCOV_EXCL_STOP
119 1 : end function test_swap_IK_1
120 :
121 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
122 :
123 1 : function test_swap_SPI_1() result(assertion)
124 1 : use Constants_mod, only: SPI
125 : implicit none
126 : logical :: assertion
127 : integer(SPI) :: i
128 : integer(SPI) , parameter :: vecLen = 3_SPI
129 : integer(SPI) , parameter :: Vector1_ref(vecLen) = [(+i,i=1,vecLen)]
130 : integer(SPI) , parameter :: Vector2_ref(vecLen) = [(-i,i=1,vecLen)]
131 : integer(SPI) :: Vector1(vecLen)
132 : integer(SPI) :: Vector2(vecLen)
133 1 : Vector1 = Vector1_ref
134 1 : Vector2 = Vector2_ref
135 4 : call swap_SPI(Vector1,Vector2)
136 7 : assertion = all(Vector1==Vector2_ref) .and. all(Vector2==Vector1_ref)
137 1 : if (Test%isDebugMode .and. .not. assertion) then
138 : ! LCOV_EXCL_START
139 : write(Test%outputUnit,"(*(g0,:,' '))")
140 : write(Test%outputUnit,"(*(g0,:,' '))") "Vector1_ref =", Vector1_ref
141 : write(Test%outputUnit,"(*(g0,:,' '))") "Vector2 =", Vector2
142 : write(Test%outputUnit,"(*(g0,:,' '))") "Vector2_ref =", Vector2_ref
143 : write(Test%outputUnit,"(*(g0,:,' '))") "Vector1 =", Vector1
144 : write(Test%outputUnit,"(*(g0,:,' '))")
145 : end if
146 : ! LCOV_EXCL_STOP
147 1 : end function test_swap_SPI_1
148 :
149 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
150 :
151 1 : function test_swap_DPI_1() result(assertion)
152 1 : use Constants_mod, only: DPI
153 : implicit none
154 : logical :: assertion
155 : integer(DPI) :: i
156 : integer(DPI) , parameter :: vecLen = 3
157 : integer(DPI) , parameter :: Vector1_ref(vecLen) = [(+i,i=1,vecLen)]
158 : integer(DPI) , parameter :: Vector2_ref(vecLen) = [(-i,i=1,vecLen)]
159 : integer(DPI) :: Vector1(vecLen)
160 : integer(DPI) :: Vector2(vecLen)
161 1 : Vector1 = Vector1_ref
162 1 : Vector2 = Vector2_ref
163 4 : call swap_DPI(Vector1,Vector2)
164 7 : assertion = all(Vector1==Vector2_ref) .and. all(Vector2==Vector1_ref)
165 1 : if (Test%isDebugMode .and. .not. assertion) then
166 : ! LCOV_EXCL_START
167 : write(Test%outputUnit,"(*(g0,:,' '))")
168 : write(Test%outputUnit,"(*(g0,:,' '))") "Vector1_ref =", Vector1_ref
169 : write(Test%outputUnit,"(*(g0,:,' '))") "Vector2 =", Vector2
170 : write(Test%outputUnit,"(*(g0,:,' '))") "Vector2_ref =", Vector2_ref
171 : write(Test%outputUnit,"(*(g0,:,' '))") "Vector1 =", Vector1
172 : write(Test%outputUnit,"(*(g0,:,' '))")
173 : end if
174 : ! LCOV_EXCL_STOP
175 1 : end function test_swap_DPI_1
176 :
177 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
178 :
179 1 : function test_swap_RK_1() result(assertion)
180 1 : use Constants_mod, only: IK, RK
181 : implicit none
182 : logical :: assertion
183 : integer(IK) :: i
184 : integer(IK) , parameter :: vecLen = 3_IK
185 : real(RK) , parameter :: Vector1_ref(vecLen) = [(real(+i,RK),i=1,vecLen)]
186 : real(RK) , parameter :: Vector2_ref(vecLen) = [(real(-i,RK),i=1,vecLen)]
187 : real(RK) :: Vector1(vecLen)
188 : real(RK) :: Vector2(vecLen)
189 1 : Vector1 = Vector1_ref
190 1 : Vector2 = Vector2_ref
191 4 : call swap_RK(Vector1,Vector2)
192 7 : assertion = all(Vector1==Vector2_ref) .and. all(Vector2==Vector1_ref)
193 1 : if (Test%isDebugMode .and. .not. assertion) then
194 : ! LCOV_EXCL_START
195 : write(Test%outputUnit,"(*(g0,:,' '))")
196 : write(Test%outputUnit,"(*(g0,:,' '))") "Vector1_ref =", Vector1_ref
197 : write(Test%outputUnit,"(*(g0,:,' '))") "Vector2 =", Vector2
198 : write(Test%outputUnit,"(*(g0,:,' '))") "Vector2_ref =", Vector2_ref
199 : write(Test%outputUnit,"(*(g0,:,' '))") "Vector1 =", Vector1
200 : write(Test%outputUnit,"(*(g0,:,' '))")
201 : end if
202 : ! LCOV_EXCL_STOP
203 1 : end function test_swap_RK_1
204 :
205 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
206 :
207 1 : function test_swap_SPR_1() result(assertion)
208 1 : use Constants_mod, only: IK, SPR
209 : implicit none
210 : logical :: assertion
211 : integer(IK) :: i
212 : integer(IK) , parameter :: vecLen = 3_IK
213 : real(SPR) , parameter :: Vector1_ref(vecLen) = [(real(+i,SPR),i=1,vecLen)]
214 : real(SPR) , parameter :: Vector2_ref(vecLen) = [(real(-i,SPR),i=1,vecLen)]
215 : real(SPR) :: Vector1(vecLen)
216 : real(SPR) :: Vector2(vecLen)
217 1 : Vector1 = Vector1_ref
218 1 : Vector2 = Vector2_ref
219 4 : call swap_SPR(Vector1,Vector2)
220 7 : assertion = all(Vector1==Vector2_ref) .and. all(Vector2==Vector1_ref)
221 1 : if (Test%isDebugMode .and. .not. assertion) then
222 : ! LCOV_EXCL_START
223 : write(Test%outputUnit,"(*(g0,:,' '))")
224 : write(Test%outputUnit,"(*(g0,:,' '))") "Vector1_ref =", Vector1_ref
225 : write(Test%outputUnit,"(*(g0,:,' '))") "Vector2 =", Vector2
226 : write(Test%outputUnit,"(*(g0,:,' '))") "Vector2_ref =", Vector2_ref
227 : write(Test%outputUnit,"(*(g0,:,' '))") "Vector1 =", Vector1
228 : write(Test%outputUnit,"(*(g0,:,' '))")
229 : end if
230 : ! LCOV_EXCL_STOP
231 1 : end function test_swap_SPR_1
232 :
233 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
234 :
235 1 : function test_swap_DPR_1() result(assertion)
236 1 : use Constants_mod, only: IK, DPR
237 : implicit none
238 : logical :: assertion
239 : integer(IK) :: i
240 : integer(IK) , parameter :: vecLen = 3_IK
241 : real(DPR) , parameter :: Vector1_ref(vecLen) = [(real(+i,DPR),i=1,vecLen)]
242 : real(DPR) , parameter :: Vector2_ref(vecLen) = [(real(-i,DPR),i=1,vecLen)]
243 : real(DPR) :: Vector1(vecLen)
244 : real(DPR) :: Vector2(vecLen)
245 1 : Vector1 = Vector1_ref
246 1 : Vector2 = Vector2_ref
247 4 : call swap_DPR(Vector1,Vector2)
248 7 : assertion = all(Vector1==Vector2_ref) .and. all(Vector2==Vector1_ref)
249 1 : if (Test%isDebugMode .and. .not. assertion) then
250 : ! LCOV_EXCL_START
251 : write(Test%outputUnit,"(*(g0,:,' '))")
252 : write(Test%outputUnit,"(*(g0,:,' '))") "Vector1_ref =", Vector1_ref
253 : write(Test%outputUnit,"(*(g0,:,' '))") "Vector2 =", Vector2
254 : write(Test%outputUnit,"(*(g0,:,' '))") "Vector2_ref =", Vector2_ref
255 : write(Test%outputUnit,"(*(g0,:,' '))") "Vector1 =", Vector1
256 : write(Test%outputUnit,"(*(g0,:,' '))")
257 : end if
258 : ! LCOV_EXCL_STOP
259 1 : end function test_swap_DPR_1
260 :
261 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
262 :
263 1 : function test_swap_CK_1() result(assertion)
264 1 : use Constants_mod, only: IK, RK, CK
265 : implicit none
266 : logical :: assertion
267 : integer(IK) :: i
268 : integer(IK) , parameter :: vecLen = 3_IK
269 : complex(CK) , parameter :: Vector1_ref(vecLen) = [(cmplx(+i,0.,RK),i=1,vecLen)]
270 : complex(CK) , parameter :: Vector2_ref(vecLen) = [(cmplx(-i,0.,RK),i=1,vecLen)]
271 : complex(CK) :: Vector1(vecLen)
272 : complex(CK) :: Vector2(vecLen)
273 1 : Vector1 = Vector1_ref
274 1 : Vector2 = Vector2_ref
275 4 : call swap_CK(Vector1,Vector2)
276 7 : assertion = all(Vector1==Vector2_ref) .and. all(Vector2==Vector1_ref)
277 1 : if (Test%isDebugMode .and. .not. assertion) then
278 : ! LCOV_EXCL_START
279 : write(Test%outputUnit,"(*(g0,:,' '))")
280 : write(Test%outputUnit,"(*(g0,:,' '))") "Vector1_ref =", Vector1_ref
281 : write(Test%outputUnit,"(*(g0,:,' '))") "Vector2 =", Vector2
282 : write(Test%outputUnit,"(*(g0,:,' '))") "Vector2_ref =", Vector2_ref
283 : write(Test%outputUnit,"(*(g0,:,' '))") "Vector1 =", Vector1
284 : write(Test%outputUnit,"(*(g0,:,' '))")
285 : end if
286 : ! LCOV_EXCL_STOP
287 1 : end function test_swap_CK_1
288 :
289 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
290 :
291 1 : function test_swap_SPC_1() result(assertion)
292 1 : use Constants_mod, only: IK, SPR, SPC
293 : implicit none
294 : logical :: assertion
295 : integer(IK) :: i
296 : integer(IK) , parameter :: vecLen = 3_IK
297 : complex(SPC), parameter :: Vector1_ref(vecLen) = [(cmplx(+i,0.,SPR),i=1,vecLen)]
298 : complex(SPC), parameter :: Vector2_ref(vecLen) = [(cmplx(-i,0.,SPR),i=1,vecLen)]
299 : complex(SPC) :: Vector1(vecLen)
300 : complex(SPC) :: Vector2(vecLen)
301 1 : Vector1 = Vector1_ref
302 1 : Vector2 = Vector2_ref
303 4 : call swap_SPC(Vector1,Vector2)
304 7 : assertion = all(Vector1==Vector2_ref) .and. all(Vector2==Vector1_ref)
305 1 : if (Test%isDebugMode .and. .not. assertion) then
306 : ! LCOV_EXCL_START
307 : write(Test%outputUnit,"(*(g0,:,' '))")
308 : write(Test%outputUnit,"(*(g0,:,' '))") "Vector1_ref =", Vector1_ref
309 : write(Test%outputUnit,"(*(g0,:,' '))") "Vector2 =", Vector2
310 : write(Test%outputUnit,"(*(g0,:,' '))") "Vector2_ref =", Vector2_ref
311 : write(Test%outputUnit,"(*(g0,:,' '))") "Vector1 =", Vector1
312 : write(Test%outputUnit,"(*(g0,:,' '))")
313 : end if
314 : ! LCOV_EXCL_STOP
315 1 : end function test_swap_SPC_1
316 :
317 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
318 :
319 1 : function test_swap_DPC_1() result(assertion)
320 1 : use Constants_mod, only: IK, DPR, DPC
321 : implicit none
322 : logical :: assertion
323 : integer(IK) :: i
324 : integer(IK) , parameter :: vecLen = 3_IK
325 : complex(DPC), parameter :: Vector1_ref(vecLen) = [(cmplx(+i,0.,DPR),i=1,vecLen)]
326 : complex(DPC), parameter :: Vector2_ref(vecLen) = [(cmplx(-i,0.,DPR),i=1,vecLen)]
327 : complex(DPC) :: Vector1(vecLen)
328 : complex(DPC) :: Vector2(vecLen)
329 1 : Vector1 = Vector1_ref
330 1 : Vector2 = Vector2_ref
331 4 : call swap_DPC(Vector1,Vector2)
332 7 : assertion = all(Vector1==Vector2_ref) .and. all(Vector2==Vector1_ref)
333 1 : if (Test%isDebugMode .and. .not. assertion) then
334 : ! LCOV_EXCL_START
335 : write(Test%outputUnit,"(*(g0,:,' '))")
336 : write(Test%outputUnit,"(*(g0,:,' '))") "Vector1_ref =", Vector1_ref
337 : write(Test%outputUnit,"(*(g0,:,' '))") "Vector2 =", Vector2
338 : write(Test%outputUnit,"(*(g0,:,' '))") "Vector2_ref =", Vector2_ref
339 : write(Test%outputUnit,"(*(g0,:,' '))") "Vector1 =", Vector1
340 : write(Test%outputUnit,"(*(g0,:,' '))")
341 : end if
342 : ! LCOV_EXCL_STOP
343 1 : end function test_swap_DPC_1
344 :
345 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
346 :
347 1 : function test_masked_swap_SPR_1() result(assertion)
348 1 : use Constants_mod, only: IK, SPR
349 : implicit none
350 : logical :: assertion
351 : logical , parameter :: mask = .true.
352 : real(SPR) , parameter :: scalar1_ref = 1._SPR
353 : real(SPR) , parameter :: scalar2_ref = 2._SPR
354 1 : real(SPR) :: scalar1
355 1 : real(SPR) :: scalar2
356 1 : scalar1 = scalar1_ref
357 1 : scalar2 = scalar2_ref
358 1 : call masked_swap_SPR(scalar1,scalar2,mask)
359 1 : assertion = scalar1==scalar2_ref .and. scalar2==scalar1_ref
360 1 : if (Test%isDebugMode .and. .not. assertion) then
361 : ! LCOV_EXCL_START
362 : write(Test%outputUnit,"(*(g0,:,' '))")
363 : write(Test%outputUnit,"(*(g0,:,' '))") "scalar1_ref =", scalar1_ref
364 : write(Test%outputUnit,"(*(g0,:,' '))") "scalar2 =", scalar2
365 : write(Test%outputUnit,"(*(g0,:,' '))") "scalar2_ref =", scalar2_ref
366 : write(Test%outputUnit,"(*(g0,:,' '))") "scalar1 =", scalar1
367 : write(Test%outputUnit,"(*(g0,:,' '))")
368 : end if
369 : ! LCOV_EXCL_STOP
370 1 : end function test_masked_swap_SPR_1
371 :
372 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
373 :
374 1 : function test_masked_swap_SPR_2() result(assertion)
375 1 : use Constants_mod, only: IK, SPR
376 : implicit none
377 : logical :: assertion
378 : logical , parameter :: mask = .false.
379 : real(SPR) , parameter :: scalar1_ref = 1._SPR
380 : real(SPR) , parameter :: scalar2_ref = 2._SPR
381 1 : real(SPR) :: scalar1
382 1 : real(SPR) :: scalar2
383 1 : scalar1 = scalar1_ref
384 1 : scalar2 = scalar2_ref
385 1 : call masked_swap_SPR(scalar1,scalar2,mask)
386 1 : assertion = scalar1==scalar1_ref .and. scalar2==scalar2_ref
387 1 : if (Test%isDebugMode .and. .not. assertion) then
388 : ! LCOV_EXCL_START
389 : write(Test%outputUnit,"(*(g0,:,' '))")
390 : write(Test%outputUnit,"(*(g0,:,' '))") "scalar1_ref =", scalar1_ref
391 : write(Test%outputUnit,"(*(g0,:,' '))") "scalar1 =", scalar1
392 : write(Test%outputUnit,"(*(g0,:,' '))") "scalar2_ref =", scalar2_ref
393 : write(Test%outputUnit,"(*(g0,:,' '))") "scalar2 =", scalar2
394 : write(Test%outputUnit,"(*(g0,:,' '))")
395 : end if
396 : ! LCOV_EXCL_STOP
397 1 : end function test_masked_swap_SPR_2
398 :
399 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
400 :
401 1 : function test_masked_swap_SPRV_1() result(assertion)
402 1 : use Constants_mod, only: IK, SPR
403 : implicit none
404 : logical :: assertion
405 : integer(IK) :: i
406 : integer(IK) , parameter :: vecLen = 3_IK
407 : logical , parameter :: Mask(vecLen) = [ .false., .true., .false. ]
408 : real(SPR) , parameter :: Vector2_ref(vecLen) = [(real(-i,SPR),i=1,vecLen)]
409 : real(SPR) , parameter :: Vector1_ref(vecLen) = [(real(+i,SPR),i=1,vecLen)]
410 : real(SPR) :: Vector1(vecLen)
411 : real(SPR) :: Vector2(vecLen)
412 1 : Vector1 = Vector1_ref
413 1 : Vector2 = Vector2_ref
414 1 : call masked_swap_SPRV(Vector1,Vector2,Mask)
415 7 : assertion = all((Vector1==Vector2_ref) .eqv. Mask) .and. all( (Vector2==Vector1_ref) .eqv. Mask)
416 1 : if (Test%isDebugMode .and. .not. assertion) then
417 : ! LCOV_EXCL_START
418 : write(Test%outputUnit,"(*(g0,:,' '))")
419 : write(Test%outputUnit,"(*(g0,:,' '))") "Mask =", Mask
420 : write(Test%outputUnit,"(*(g0,:,' '))") "Vector1_ref =", Vector1_ref
421 : write(Test%outputUnit,"(*(g0,:,' '))") "Vector2 =", Vector2
422 : write(Test%outputUnit,"(*(g0,:,' '))") "Vector2_ref =", Vector2_ref
423 : write(Test%outputUnit,"(*(g0,:,' '))") "Vector1 =", Vector1
424 : write(Test%outputUnit,"(*(g0,:,' '))")
425 : end if
426 : ! LCOV_EXCL_STOP
427 1 : end function test_masked_swap_SPRV_1
428 :
429 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
430 :
431 1 : function test_masked_swap_SPRM_1() result(assertion)
432 1 : use Constants_mod, only: IK, SPR
433 : implicit none
434 : logical :: assertion
435 : integer(IK) :: i
436 : integer(IK) , parameter :: nrow = 3_IK
437 : integer(IK) , parameter :: ncol = 2_IK
438 : logical , parameter :: Mask(nrow,ncol) = reshape([ .false., .true., .false., .false., .true., .false. ], shape = shape(Mask))
439 : real(SPR) , parameter :: Matrix2_ref(nrow,ncol) = reshape([(real(-i,SPR),i=1,nrow*ncol)], shape = shape(Mask))
440 : real(SPR) , parameter :: Matrix1_ref(nrow,ncol) = reshape([(real(+i,SPR),i=1,nrow*ncol)], shape = shape(Mask))
441 : real(SPR) :: Matrix1(nrow,ncol)
442 : real(SPR) :: Matrix2(nrow,ncol)
443 1 : Matrix1 = Matrix1_ref
444 1 : Matrix2 = Matrix2_ref
445 1 : call masked_swap_SPRM(Matrix1,Matrix2,mask)
446 17 : assertion = all((Matrix1==Matrix2_ref) .eqv. mask) .and. all( (Matrix2==Matrix1_ref) .eqv. mask)
447 1 : if (Test%isDebugMode .and. .not. assertion) then
448 : ! LCOV_EXCL_START
449 : write(Test%outputUnit,"(*(g0,:,' '))")
450 : write(Test%outputUnit,"(*(g0,:,' '))") "Mask =", Mask
451 : write(Test%outputUnit,"(*(g0,:,' '))") "Matrix1_ref =", Matrix1_ref
452 : write(Test%outputUnit,"(*(g0,:,' '))") "Matrix2 =", Matrix2
453 : write(Test%outputUnit,"(*(g0,:,' '))") "Matrix2_ref =", Matrix2_ref
454 : write(Test%outputUnit,"(*(g0,:,' '))") "Matrix1 =", Matrix1
455 : write(Test%outputUnit,"(*(g0,:,' '))")
456 : end if
457 : ! LCOV_EXCL_STOP
458 1 : end function test_masked_swap_SPRM_1
459 :
460 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
461 :
462 1 : function test_arth_IK_1() result(assertion)
463 1 : use Constants_mod, only: IK
464 : implicit none
465 : logical :: assertion
466 : integer(IK) :: i
467 : integer(IK) , parameter :: first = 13, increment = 5, n = 10
468 : integer(IK) , parameter :: ArithmeticProgression_ref(n) = [(i*increment+first,i=0,n-1)]
469 : integer(IK), allocatable :: ArithmeticProgression(:)
470 1 : ArithmeticProgression = arth_IK(first = first,increment = increment, n = n)
471 11 : assertion = all(ArithmeticProgression == ArithmeticProgression_ref)
472 1 : if (Test%isDebugMode .and. .not. assertion) then
473 : ! LCOV_EXCL_START
474 : write(Test%outputUnit,"(*(g0,:,' '))")
475 : write(Test%outputUnit,"(*(g0,:,' '))") "ArithmeticProgression_ref =", ArithmeticProgression_ref
476 : write(Test%outputUnit,"(*(g0,:,' '))") "ArithmeticProgression =", ArithmeticProgression
477 : write(Test%outputUnit,"(*(g0,:,' '))")
478 : end if
479 : ! LCOV_EXCL_STOP
480 1 : end function test_arth_IK_1
481 :
482 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
483 :
484 1 : function test_arth_RK_1() result(assertion)
485 1 : use Constants_mod, only: IK, RK
486 : implicit none
487 : logical :: assertion
488 : integer(IK) :: i
489 : real(RK) , parameter :: first = 13._RK, increment = 5._RK
490 : integer(IK) , parameter :: n = 10_IK
491 : real(RK) , parameter :: ArithmeticProgression_ref(n) = [(real(i*increment+first,RK),i=0,n-1)]
492 : real(RK) , allocatable :: ArithmeticProgression(:)
493 1 : ArithmeticProgression = arth_RK(first = first, increment = increment, n = n)
494 11 : assertion = all(ArithmeticProgression == ArithmeticProgression_ref)
495 1 : if (Test%isDebugMode .and. .not. assertion) then
496 : ! LCOV_EXCL_START
497 : write(Test%outputUnit,"(*(g0,:,' '))")
498 : write(Test%outputUnit,"(*(g0,:,' '))") "ArithmeticProgression_ref =", ArithmeticProgression_ref
499 : write(Test%outputUnit,"(*(g0,:,' '))") "ArithmeticProgression =", ArithmeticProgression
500 : write(Test%outputUnit,"(*(g0,:,' '))")
501 : end if
502 : ! LCOV_EXCL_STOP
503 1 : end function test_arth_RK_1
504 :
505 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
506 :
507 1 : function test_arth_RK_2() result(assertion)
508 1 : use Constants_mod, only: IK, RK
509 : implicit none
510 : logical :: assertion
511 : integer(IK) :: i
512 : real(RK) , parameter :: first = 13._RK, increment = 5._RK
513 : integer(IK) , parameter :: n = 20_IK
514 : real(RK) , parameter :: ArithmeticProgression_ref(n) = [(real(i*increment+first,RK),i=0,n-1)]
515 : real(RK) , allocatable :: ArithmeticProgression(:)
516 1 : ArithmeticProgression = arth_RK(first = first, increment = increment, n = n)
517 21 : assertion = all(ArithmeticProgression == ArithmeticProgression_ref)
518 1 : if (Test%isDebugMode .and. .not. assertion) then
519 : ! LCOV_EXCL_START
520 : write(Test%outputUnit,"(*(g0,:,' '))")
521 : write(Test%outputUnit,"(*(g0,:,' '))") "ArithmeticProgression_ref =", ArithmeticProgression_ref
522 : write(Test%outputUnit,"(*(g0,:,' '))") "ArithmeticProgression =", ArithmeticProgression
523 : write(Test%outputUnit,"(*(g0,:,' '))")
524 : end if
525 : ! LCOV_EXCL_STOP
526 1 : end function test_arth_RK_2
527 :
528 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
529 :
530 1 : function test_zroots_unity_1() result(assertion)
531 1 : use Constants_mod, only: IK, RK, CK
532 : implicit none
533 : logical :: assertion
534 : complex(CK) , allocatable :: Zroots(:)
535 : integer(IK) , parameter :: n = 5, nn = 10
536 : real(RK) , parameter :: tolerance = 1.e-10_RK
537 : complex(CK) , parameter :: Zroots_ref(nn) = [ (1.000000000000000_RK, 0.000000000000000_RK) &
538 : , (0.3090169943749475_RK, 0.9510565162951535_RK) &
539 : , (-0.8090169943749473_RK, 0.5877852522924732_RK) &
540 : , (-0.8090169943749476_RK, -0.5877852522924730_RK) &
541 : , (0.3090169943749472_RK, -0.9510565162951536_RK) &
542 : , (1.000000000000000_RK, -0.2775557561562891E-15_RK) &
543 : , (0.3090169943749478_RK, 0.9510565162951534_RK) &
544 : , (-0.8090169943749472_RK, 0.5877852522924734_RK) &
545 : , (-0.8090169943749477_RK, -0.5877852522924728_RK) &
546 : , (0.3090169943749470_RK, -0.9510565162951536_RK) ]
547 1 : Zroots = zroots_unity(n,nn)
548 21 : assertion = all(abs(real(Zroots) - real(Zroots_ref)) < tolerance) .and. all(abs(aimag(Zroots) - aimag(Zroots_ref)) < tolerance)
549 1 : if (Test%isDebugMode .and. .not. assertion) then
550 : ! LCOV_EXCL_START
551 : write(Test%outputUnit,"(*(g0.16,' '))")
552 : write(Test%outputUnit,"(*(g0.16,' '))") "Zroots_ref =", Zroots_ref
553 : write(Test%outputUnit,"(*(g0.16,' '))") "Zroots =", Zroots
554 : write(Test%outputUnit,"(*(g0.16,' '))")
555 : end if
556 : ! LCOV_EXCL_STOP
557 1 : end function test_zroots_unity_1
558 :
559 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
560 :
561 1 : function test_copyArray_IK_1() result(assertion)
562 1 : use Constants_mod, only: IK
563 : implicit none
564 : logical :: assertion
565 : integer(IK) :: i
566 : integer(IK) , parameter :: numCopied_ref = 5, numNotCopied_ref = 0
567 : integer(IK) , parameter :: lenSource = 5, lenDestin = 10
568 : integer(IK) , parameter :: Source(lenSource) = [(int(i,IK),i=1,lenSource)]
569 : integer(IK) , parameter :: Destin_ref(lenDestin) = [1_IK, 2_IK, 3_IK, 4_IK, 5_IK, 0_IK, 0_IK, 0_IK, 0_IK, 0_IK]
570 : integer(IK) :: Destin(lenDestin)
571 : integer(IK) :: numCopied, numNotCopied
572 1 : Destin = 0_IK
573 1 : call copyArray_IK(Source = Source, Destination = Destin, numCopied = numCopied, numNotCopied = numNotCopied)
574 11 : assertion = all(Destin == Destin_ref) .and. (numCopied == numCopied_ref) .and. (numNotCopied == numNotCopied_ref)
575 1 : if (Test%isDebugMode .and. .not. assertion) then
576 : ! LCOV_EXCL_START
577 : write(Test%outputUnit,"(*(g0,:,' '))")
578 : write(Test%outputUnit,"(*(g0,:,' '))") "numNotCopied_ref =", numNotCopied_ref
579 : write(Test%outputUnit,"(*(g0,:,' '))") "numNotCopied =", numNotCopied
580 : write(Test%outputUnit,"(*(g0,:,' '))") "numCopied_ref =", numCopied_ref
581 : write(Test%outputUnit,"(*(g0,:,' '))") "numCopied =", numCopied
582 : write(Test%outputUnit,"(*(g0,:,' '))") "Destin_ref =", Destin_ref
583 : write(Test%outputUnit,"(*(g0,:,' '))") "Source =", Source
584 : write(Test%outputUnit,"(*(g0,:,' '))") "Destin =", Destin
585 : write(Test%outputUnit,"(*(g0,:,' '))")
586 : end if
587 : ! LCOV_EXCL_STOP
588 1 : end function test_copyArray_IK_1
589 :
590 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
591 :
592 1 : function test_copyArray_IK_2() result(assertion)
593 1 : use Constants_mod, only: IK
594 : implicit none
595 : logical :: assertion
596 : integer(IK) :: i
597 : integer(IK) , parameter :: numCopied_ref = 5, numNotCopied_ref = 5
598 : integer(IK) , parameter :: lenSource = 10, lenDestin = 5
599 : integer(IK) , parameter :: Source(lenSource) = [(int(i,IK),i=1,lenSource)]
600 : integer(IK) , parameter :: Destin_ref(lenDestin) = [1_IK, 2_IK, 3_IK, 4_IK, 5_IK]
601 : integer(IK) :: Destin(lenDestin)
602 : integer(IK) :: numCopied, numNotCopied
603 1 : Destin = 0_IK
604 1 : call copyArray_IK(Source = Source, Destination = Destin, numCopied = numCopied, numNotCopied = numNotCopied)
605 6 : assertion = all(Destin == Destin_ref) .and. (numCopied == numCopied_ref) .and. (numNotCopied == numNotCopied_ref)
606 1 : if (Test%isDebugMode .and. .not. assertion) then
607 : ! LCOV_EXCL_START
608 : write(Test%outputUnit,"(*(g0,:,' '))")
609 : write(Test%outputUnit,"(*(g0,:,' '))") "numNotCopied_ref =", numNotCopied_ref
610 : write(Test%outputUnit,"(*(g0,:,' '))") "numNotCopied =", numNotCopied
611 : write(Test%outputUnit,"(*(g0,:,' '))") "numCopied_ref =", numCopied_ref
612 : write(Test%outputUnit,"(*(g0,:,' '))") "numCopied =", numCopied
613 : write(Test%outputUnit,"(*(g0,:,' '))") "Destin_ref =", Destin_ref
614 : write(Test%outputUnit,"(*(g0,:,' '))") "Source =", Source
615 : write(Test%outputUnit,"(*(g0,:,' '))") "Destin =", Destin
616 : write(Test%outputUnit,"(*(g0,:,' '))")
617 : end if
618 : ! LCOV_EXCL_STOP
619 1 : end function test_copyArray_IK_2
620 :
621 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
622 :
623 1 : function test_copyArray_RK_1() result(assertion)
624 1 : use Constants_mod, only: IK, RK
625 : implicit none
626 : logical :: assertion
627 : integer(IK) :: i
628 : integer(IK) , parameter :: numCopied_ref = 5, numNotCopied_ref = 0
629 : integer(IK) , parameter :: lenSource = 5, lenDestin = 10
630 : real(RK) , parameter :: Source(lenSource) = [(real(i,RK),i=1,lenSource)]
631 : real(RK) , parameter :: Destin_ref(lenDestin) = [1._RK, 2._RK, 3._RK, 4._RK, 5._RK, 0._RK, 0._RK, 0._RK, 0._RK, 0._RK]
632 : real(RK) :: Destin(lenDestin)
633 : integer(IK) :: numCopied, numNotCopied
634 1 : Destin = 0._RK
635 1 : call copyArray_RK(Source = Source, Destination = Destin, numCopied = numCopied, numNotCopied = numNotCopied)
636 11 : assertion = all(Destin == Destin_ref) .and. (numCopied == numCopied_ref) .and. (numNotCopied == numNotCopied_ref)
637 1 : if (Test%isDebugMode .and. .not. assertion) then
638 : ! LCOV_EXCL_START
639 : write(Test%outputUnit,"(*(g0,:,' '))")
640 : write(Test%outputUnit,"(*(g0,:,' '))") "numNotCopied_ref =", numNotCopied_ref
641 : write(Test%outputUnit,"(*(g0,:,' '))") "numNotCopied =", numNotCopied
642 : write(Test%outputUnit,"(*(g0,:,' '))") "numCopied_ref =", numCopied_ref
643 : write(Test%outputUnit,"(*(g0,:,' '))") "numCopied =", numCopied
644 : write(Test%outputUnit,"(*(g0,:,' '))") "Destin_ref =", Destin_ref
645 : write(Test%outputUnit,"(*(g0,:,' '))") "Source =", Source
646 : write(Test%outputUnit,"(*(g0,:,' '))") "Destin =", Destin
647 : write(Test%outputUnit,"(*(g0,:,' '))")
648 : end if
649 : ! LCOV_EXCL_STOP
650 1 : end function test_copyArray_RK_1
651 :
652 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
653 :
654 1 : function test_copyArray_RK_2() result(assertion)
655 1 : use Constants_mod, only: IK, RK
656 : implicit none
657 : logical :: assertion
658 : integer(IK) :: i
659 : integer(IK) , parameter :: numCopied_ref = 5, numNotCopied_ref = 5
660 : integer(IK) , parameter :: lenSource = 10, lenDestin = 5
661 : real(RK) , parameter :: Source(lenSource) = [(real(i,RK),i=1,lenSource)]
662 : real(RK) , parameter :: Destin_ref(lenDestin) = [1._RK, 2._RK, 3._RK, 4._RK, 5._RK]
663 : real(RK) :: Destin(lenDestin)
664 : integer(IK) :: numCopied, numNotCopied
665 1 : Destin = 0._RK
666 1 : call copyArray_RK(Source = Source, Destination = Destin, numCopied = numCopied, numNotCopied = numNotCopied)
667 6 : assertion = all(Destin == Destin_ref) .and. (numCopied == numCopied_ref) .and. (numNotCopied == numNotCopied_ref)
668 1 : if (Test%isDebugMode .and. .not. assertion) then
669 : ! LCOV_EXCL_START
670 : write(Test%outputUnit,"(*(g0,:,' '))")
671 : write(Test%outputUnit,"(*(g0,:,' '))") "numNotCopied_ref =", numNotCopied_ref
672 : write(Test%outputUnit,"(*(g0,:,' '))") "numNotCopied =", numNotCopied
673 : write(Test%outputUnit,"(*(g0,:,' '))") "numCopied_ref =", numCopied_ref
674 : write(Test%outputUnit,"(*(g0,:,' '))") "numCopied =", numCopied
675 : write(Test%outputUnit,"(*(g0,:,' '))") "Destin_ref =", Destin_ref
676 : write(Test%outputUnit,"(*(g0,:,' '))") "Source =", Source
677 : write(Test%outputUnit,"(*(g0,:,' '))") "Destin =", Destin
678 : write(Test%outputUnit,"(*(g0,:,' '))")
679 : end if
680 : ! LCOV_EXCL_STOP
681 1 : end function test_copyArray_RK_2
682 :
683 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
684 :
685 1 : function test_resizeVector_RK_1() result(assertion)
686 1 : use Constants_mod, only: IK, RK
687 : implicit none
688 : logical :: assertion
689 : integer(IK) :: i
690 : integer(IK) , parameter :: lenVector = 5, lenVectorNew = 10
691 : real(RK) , parameter :: Vector_ref(lenVector) = [(real(i,RK),i=1,lenVector)]
692 : real(RK) , allocatable :: Vector(:)
693 6 : Vector = Vector_ref
694 1 : call resizeVector_RK(Vector = Vector, from = lenVector, to = lenVectorNew)
695 6 : assertion = size(Vector) == lenVectorNew .and. all(Vector(1:lenVector) == Vector_ref(1:lenVector))
696 1 : if (Test%isDebugMode .and. .not. assertion) then
697 : ! LCOV_EXCL_START
698 : write(Test%outputUnit,"(*(g0,:,' '))")
699 : write(Test%outputUnit,"(*(g0,:,' '))") "Vector_ref =", Vector_ref
700 : write(Test%outputUnit,"(*(g0,:,' '))") "lenVectorNew =", lenVectorNew
701 : write(Test%outputUnit,"(*(g0,:,' '))") "size(Vector) =", size(Vector)
702 : write(Test%outputUnit,"(*(g0,:,' '))")
703 : end if
704 : ! LCOV_EXCL_STOP
705 1 : end function test_resizeVector_RK_1
706 :
707 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
708 :
709 1 : function test_findUnique_1() result(assertion)
710 :
711 1 : use Constants_mod, only: RK, IK
712 :
713 : implicit none
714 : logical :: assertion
715 : integer(IK), parameter :: VECTOR(*) = [1,2,1,3,5,5,2]
716 : integer(IK), parameter :: LEN_VECTOR = size(VECTOR)
717 : integer(IK), parameter :: UNIQUE_VALUE(*) = [1,2,3,5]
718 : integer(IK), parameter :: UNIQUE_COUNT(*) = [2,2,1,2]
719 : integer(IK), allocatable :: UniqueValue(:), UniqueCount(:), ZeroLenVector(:)
720 : integer(IK) :: lenUnique
721 :
722 : call findUnique ( lenVector = LEN_VECTOR &
723 : , Vector = VECTOR &
724 : , UniqueValue = UniqueValue &
725 : , UniqueCount = UniqueCount &
726 : , lenUnique = lenUnique &
727 1 : )
728 :
729 9 : assertion = all(UniqueValue==UNIQUE_VALUE) .and. all(UniqueCount==UNIQUE_COUNT)
730 :
731 : ! test with empty input vector
732 :
733 1 : allocate(ZeroLenVector(0))
734 : call findUnique ( lenVector = 0_IK & ! LCOV_EXCL_LINE
735 : , Vector = ZeroLenVector & ! LCOV_EXCL_LINE
736 : , UniqueValue = UniqueValue & ! LCOV_EXCL_LINE
737 : , UniqueCount = UniqueCount & ! LCOV_EXCL_LINE
738 : , lenUnique = lenUnique & ! LCOV_EXCL_LINE
739 1 : )
740 :
741 1 : if (Test%isDebugMode .and. .not. assertion) then
742 : ! LCOV_EXCL_START
743 : write(Test%outputUnit,"(*(g0,:,', '))")
744 : write(Test%outputUnit,"(*(g0,:,', '))") "VECTOR", VECTOR
745 : write(Test%outputUnit,"(*(g0,:,', '))")
746 : write(Test%outputUnit,"(*(g0,:,', '))") "UNIQUE_VALUE", UNIQUE_VALUE
747 : write(Test%outputUnit,"(*(g0,:,', '))") "UniqueValue ", UniqueValue
748 : write(Test%outputUnit,"(*(g0,:,', '))")
749 : write(Test%outputUnit,"(*(g0,:,', '))") "UNIQUE_COUNT", UNIQUE_COUNT
750 : write(Test%outputUnit,"(*(g0,:,', '))") "UniqueCount ", UniqueCount
751 : write(Test%outputUnit,"(*(g0,:,', '))")
752 : write(Test%outputUnit,"(*(g0,:,', '))") "lenUnique", lenUnique
753 : write(Test%outputUnit,"(*(g0,:,', '))")
754 : write(Test%outputUnit,"(*(g0,:,', '))")
755 : write(Test%outputUnit,"(*(g0,:,', '))")
756 : write(Test%outputUnit,"(*(g0,:,', '))") "VECTOR", ZeroLenVector
757 : write(Test%outputUnit,"(*(g0,:,', '))")
758 : write(Test%outputUnit,"(*(g0,:,', '))") "UniqueValue ", UniqueValue
759 : write(Test%outputUnit,"(*(g0,:,', '))")
760 : write(Test%outputUnit,"(*(g0,:,', '))") "UniqueCount ", UniqueCount
761 : write(Test%outputUnit,"(*(g0,:,', '))")
762 : write(Test%outputUnit,"(*(g0,:,', '))") "lenUnique", lenUnique
763 : write(Test%outputUnit,"(*(g0,:,', '))")
764 : end if
765 : ! LCOV_EXCL_STOP
766 :
767 1 : end function test_findUnique_1
768 :
769 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
770 :
771 : end module Test_Misc_mod ! LCOV_EXCL_LINE
|
