Line data Source code
1 : !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
2 : !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
3 : !!!! !!!!
4 : !!!! ParaMonte: Parallel Monte Carlo and Machine Learning Library. !!!!
5 : !!!! !!!!
6 : !!!! Copyright (C) 2012-present, The Computational Data Science Lab !!!!
7 : !!!! !!!!
8 : !!!! This file is part of the ParaMonte library. !!!!
9 : !!!! !!!!
10 : !!!! LICENSE !!!!
11 : !!!! !!!!
12 : !!!! https://github.com/cdslaborg/paramonte/blob/main/LICENSE.md !!!!
13 : !!!! !!!!
14 : !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
15 : !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
16 :
17 : !> \brief
18 : !> This file contains the implementations of the tests of module [pm_mathlinSpace](@ref pm_mathlinSpace).
19 : !>
20 : !> \fintest
21 : !>
22 : !> \author
23 : !> \AmirShahmoradi, Sunday 4:33 PM, September 19, 2021, Dallas, TX
24 :
25 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
26 :
27 : #if CK_ENABLED
28 : #define TYPE_KIND complex(TKC)
29 : #elif RK_ENABLED
30 : #define TYPE_KIND real(TKC)
31 : #else
32 : #error "Unrecognized interface."
33 : #endif
34 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
35 : #if getLinSpace_ENABLED || setLinSpace_ENABLED
36 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
37 :
38 : TYPE_KIND :: x1, x2
39 : real(TKC), parameter :: TOL = epsilon(0._TKC) * 10
40 : TYPE_KIND, allocatable :: linSpace(:)
41 : TYPE_KIND, allocatable :: linSpace_ref(:)
42 : real(TKC), allocatable :: diff(:)
43 : integer(IK) :: sign
44 :
45 16 : assertion = .true._LK
46 :
47 16 : sign = 1_IK
48 16 : call testWith()
49 :
50 16 : sign = -1_IK
51 16 : call testWith()
52 :
53 : contains
54 :
55 32 : subroutine testWith()
56 :
57 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
58 :
59 32 : call reset()
60 : #if CK_ENABLED
61 16 : x1 = (0._TKC, 10._TKC)
62 16 : x2 = (10._TKC, 0._TKC)
63 : #elif RK_ENABLED
64 16 : x1 = 0._TKC
65 16 : x2 = 10._TKC
66 : #endif
67 32 : allocate(linSpace_ref(0))
68 :
69 32 : call report()
70 32 : call test%assert(assertion, SK_"getLinSpace() must return an empty `linSpace` when size of `linSpace` is zero.")
71 :
72 32 : call report(fopen = .false._LK)
73 32 : call test%assert(assertion, SK_"getLinSpace() must return an empty `linSpace` when size of `linSpace` is zero with `fopen = .false.`.")
74 :
75 32 : call report(lopen = .false._LK)
76 32 : call test%assert(assertion, SK_"getLinSpace() must return an empty `linSpace` when size of `linSpace` is zero with `lopen = .false.`.")
77 :
78 32 : call report(fopen = .false._LK, lopen = .false._LK)
79 32 : call test%assert(assertion, SK_"getLinSpace() must return an empty `linSpace` when size of `linSpace` is zero with `fopen = .false._LK, lopen = .false.`.")
80 :
81 32 : call report(fopen = .false._LK, lopen = .true._LK)
82 32 : call test%assert(assertion, SK_"getLinSpace() must return an empty `linSpace` when size of `linSpace` is zero with `fopen = .false._LK, lopen = .true.`.")
83 :
84 32 : call report(fopen = .true._LK, lopen = .false._LK)
85 32 : call test%assert(assertion, SK_"getLinSpace() must return an empty `linSpace` when size of `linSpace` is zero with `fopen = .true._LK, lopen = .false.`.")
86 :
87 32 : call report(fopen = .true._LK, lopen = .true._LK)
88 32 : call test%assert(assertion, SK_"getLinSpace() must return an empty `linSpace` when size of `linSpace` is zero with `fopen = .true._LK, lopen = .true.`.")
89 :
90 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
91 :
92 32 : call reset()
93 : #if CK_ENABLED
94 16 : x1 = (0._TKC, 10._TKC)
95 16 : x2 = (10._TKC, 0._TKC)
96 80 : linSpace_ref = [(0._TKC, 10._TKC), (5._TKC, 5._TKC), (10._TKC, 0._TKC)]
97 : #elif RK_ENABLED
98 16 : x1 = 0._TKC
99 16 : x2 = 10._TKC
100 80 : linSpace_ref = [0._TKC, 5._TKC, 10._TKC]
101 : #endif
102 32 : call report()
103 96 : call test%assert(assertion, SK_"getLinSpace() must return an increasing `linSpace` when x1, x2 = "//getStr([x1, x2]*sign))
104 :
105 32 : call report(fopen = .false._LK)
106 96 : call test%assert(assertion, SK_"getLinSpace() must return an increasing `linSpace` with `fopen = .false.` when x1, x2 = "//getStr([x1, x2]*sign))
107 :
108 32 : call report(lopen = .false._LK)
109 96 : call test%assert(assertion, SK_"getLinSpace() must return an increasing `linSpace` with `lopen = .false.` when x1, x2 = "//getStr([x1, x2]*sign))
110 :
111 32 : call report(fopen = .false._LK, lopen = .false._LK)
112 96 : call test%assert(assertion, SK_"getLinSpace() must return an increasing `linSpace` with `fopen = .false._LK, lopen = .false.` when x1, x2 = "//getStr([x1, x2]*sign))
113 :
114 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
115 :
116 32 : call reset()
117 : #if CK_ENABLED
118 16 : x1 = (0._TKC, 10._TKC)
119 16 : x2 = (10._TKC, 0._TKC)
120 : !linSpace_ref = [(2.5_TKC, 10_TKC), (5._TKC, 7.5_TKC), (7.5_TKC, 5._TKC), (10._TKC, 2.5_TKC)]
121 96 : linSpace_ref = [(2.5_TKC, 7.5_TKC), (5._TKC, 5._TKC), (7.5_TKC, 2.5_TKC), (10._TKC, 0._TKC)]
122 : #elif RK_ENABLED
123 16 : x1 = 0._TKC
124 16 : x2 = 10._TKC
125 96 : linSpace_ref = [2.5_TKC, 5._TKC, 7.5_TKC, 10._TKC]
126 : #endif
127 32 : call report(fopen = .true._LK)
128 96 : call test%assert(assertion, SK_"getLinSpace() must return an increasing `linSpace` with `fopen = .true.` when x1, x2 = "//getStr([x1, x2]*sign))
129 :
130 32 : call report(fopen = .true._LK, lopen = .false._LK)
131 96 : call test%assert(assertion, SK_"getLinSpace() must return an increasing `linSpace` with `fopen = .true._LK, lopen = .false.` when x1, x2 = "//getStr([x1, x2]*sign))
132 :
133 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
134 :
135 32 : call reset()
136 : #if CK_ENABLED
137 16 : x1 = (0._TKC, 10._TKC)
138 16 : x2 = (10._TKC, 0._TKC)
139 96 : linSpace_ref = [(0._TKC, 10._TKC), (2.5_TKC, 7.5_TKC), (5._TKC, 5._TKC), (7.5_TKC, 2.5_TKC)]
140 : #elif RK_ENABLED
141 16 : x1 = 0._TKC
142 16 : x2 = 10._TKC
143 96 : linSpace_ref = [0._TKC, 2.5_TKC, 5._TKC, 7.5_TKC]
144 : #endif
145 :
146 32 : call report(lopen = .true._LK)
147 96 : call test%assert(assertion, SK_"getLinSpace() must return an increasing `linSpace` with `lopen = .true.` when x1, x2 = "//getStr([x1, x2]*sign))
148 :
149 32 : call report(fopen = .false._LK, lopen = .true._LK)
150 96 : call test%assert(assertion, SK_"getLinSpace() must return an increasing `linSpace` with `fopen = .false._LK, lopen = .true.` when x1, x2 = "//getStr([x1, x2]*sign))
151 :
152 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
153 :
154 32 : call reset()
155 : #if CK_ENABLED
156 16 : x1 = (0._TKC, 10._TKC)
157 16 : x2 = (10._TKC, 0._TKC)
158 96 : linSpace_ref = [(1.25_TKC, 8.75_TKC), (3.75_TKC, 6.25_TKC), (6.25_TKC, 3.75_TKC), (8.75_TKC, 1.25_TKC)]
159 : #elif RK_ENABLED
160 16 : x1 = 0._TKC
161 16 : x2 = 10._TKC
162 96 : linSpace_ref = [1.25_TKC, 3.75_TKC, 6.25_TKC, 8.75_TKC]
163 : #endif
164 32 : call report(fopen = .true._LK, lopen = .true._LK)
165 96 : call test%assert(assertion, SK_"getLinSpace() must return an increasing `linSpace` with `fopen = .true._LK, lopen = .true.` when x1, x2 = "//getStr([x1, x2]*sign))
166 :
167 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
168 :
169 32 : call reset()
170 : #if CK_ENABLED
171 16 : x1 = (-10._TKC, +10._TKC)
172 16 : x2 = (+10._TKC, -10._TKC)
173 96 : linSpace_ref = [(-7.5_TKC, 7.5_TKC), (-2.5_TKC, 2.5_TKC), (2.5_TKC, -2.5_TKC), (7.5_TKC, -7.5_TKC)]
174 : #elif RK_ENABLED
175 16 : x1 = -10._TKC
176 16 : x2 = +10._TKC
177 96 : linSpace_ref = [-7.5_TKC, -2.5_TKC, 2.5_TKC, 7.5_TKC]
178 : #endif
179 32 : call report(fopen = .true._LK, lopen = .true._LK)
180 96 : call test%assert(assertion, SK_"getLinSpace() must return an increasing `linSpace` with `fopen = .true._LK, lopen = .true.` when x1, x2 = "//getStr([x1, x2]*sign))
181 :
182 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
183 :
184 32 : call reset()
185 : #if CK_ENABLED
186 16 : x1 = (-7.5_TKC, +7.5_TKC)
187 16 : x2 = (+7.5_TKC, -7.5_TKC)
188 96 : linSpace_ref = [(-7.5_TKC, 7.5_TKC), (-2.5_TKC, 2.5_TKC), (2.5_TKC, -2.5_TKC), (7.5_TKC, -7.5_TKC)]
189 : #elif RK_ENABLED
190 16 : x1 = -7.5_TKC
191 16 : x2 = +7.5_TKC
192 96 : linSpace_ref = [-7.5_TKC, -2.5_TKC, 2.5_TKC, 7.5_TKC]
193 : #endif
194 32 : call report()
195 96 : call test%assert(assertion, SK_"getLinSpace() must return an increasing `linSpace` when x1, x2 = "//getStr([x1, x2]*sign))
196 :
197 32 : call report(fopen = .false._LK)
198 96 : call test%assert(assertion, SK_"getLinSpace() must return an increasing `linSpace` with `fopen = .false.` when x1, x2 = "//getStr([x1, x2]*sign))
199 :
200 32 : call report(lopen = .false._LK)
201 96 : call test%assert(assertion, SK_"getLinSpace() must return an increasing `linSpace` with `lopen = .false.` when x1, x2 = "//getStr([x1, x2]*sign))
202 :
203 32 : call report(fopen = .false._LK, lopen = .false._LK)
204 96 : call test%assert(assertion, SK_"getLinSpace() must return an increasing `linSpace` with `fopen = .false._LK, lopen = .false.` when x1, x2 = "//getStr([x1, x2]*sign))
205 :
206 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
207 :
208 32 : call reset()
209 : #if CK_ENABLED
210 16 : x1 = (-7.5_TKC, +7.5_TKC)
211 16 : x2 = (+12.5_TKC, -12.5_TKC)
212 96 : linSpace_ref = [(-7.5_TKC, 7.5_TKC), (-2.5_TKC, 2.5_TKC), (2.5_TKC, -2.5_TKC), (7.5_TKC, -7.5_TKC)]
213 : #elif RK_ENABLED
214 16 : x1 = -7.5_TKC
215 16 : x2 = +12.5_TKC
216 96 : linSpace_ref = [-7.5_TKC, -2.5_TKC, 2.5_TKC, 7.5_TKC]
217 : #endif
218 32 : call report(fopen = .false._LK, lopen = .true._LK)
219 96 : call test%assert(assertion, SK_"getLinSpace() must return an increasing `linSpace` with `fopen = .false._LK, lopen = .true.` when x1, x2 = "//getStr([x1, x2]*sign))
220 :
221 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
222 :
223 32 : call reset()
224 : #if CK_ENABLED
225 16 : x1 = (-12.5_TKC, +12.5_TKC)
226 16 : x2 = (+7.5_TKC, -7.5_TKC)
227 96 : linSpace_ref = [(-7.5_TKC, 7.5_TKC), (-2.5_TKC, 2.5_TKC), (2.5_TKC, -2.5_TKC), (7.5_TKC, -7.5_TKC)]
228 : #elif RK_ENABLED
229 16 : x1 = -12.5_TKC
230 16 : x2 = +7.5_TKC
231 96 : linSpace_ref = [-7.5_TKC, -2.5_TKC, 2.5_TKC, 7.5_TKC]
232 : #endif
233 32 : call report(fopen = .true._LK, lopen = .false._LK)
234 96 : call test%assert(assertion, SK_"getLinSpace() must return an increasing `linSpace` with `fopen = .true._LK, lopen = .false.` when x1, x2 = "//getStr([x1, x2]*sign))
235 :
236 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
237 :
238 32 : call reset()
239 : #if CK_ENABLED
240 16 : x1 = (-12.5_TKC, +12.5_TKC)
241 16 : x2 = (+7.5_TKC, -7.5_TKC)
242 48 : linSpace_ref = [x1]
243 : #elif RK_ENABLED
244 16 : x1 = -12.5_TKC
245 16 : x2 = +7.5_TKC
246 48 : linSpace_ref = [x1]
247 : #endif
248 32 : call report(fopen = .false._LK, lopen = .false._LK)
249 96 : call test%assert(assertion, SK_"getLinSpace() must return a `linSpace = x1` when `size(linSpace)==1` when x1, x2 = "//getStr([x1, x2]*sign))
250 :
251 32 : call report()
252 96 : call test%assert(assertion, SK_"getLinSpace() must return a `linSpace = x1` when `size(linSpace)==1` with `fopen = .false._LK, lopen = .false.` when x1, x2 = "//getStr([x1, x2]*sign))
253 :
254 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
255 :
256 32 : call reset()
257 : #if CK_ENABLED
258 16 : x1 = (-10._TKC, +10._TKC)
259 16 : x2 = (+10._TKC, -10._TKC)
260 96 : linSpace_ref = [(-7.5_TKC, 7.5_TKC), (-2.5_TKC, 2.5_TKC), (2.5_TKC, -2.5_TKC), (7.5_TKC, -7.5_TKC)]
261 : #elif RK_ENABLED
262 16 : x1 = -10._TKC
263 16 : x2 = +10._TKC
264 96 : linSpace_ref = [-7.5_TKC, -2.5_TKC, 2.5_TKC, 7.5_TKC]
265 : #endif
266 32 : call report(fopen = .true._LK, lopen = .true._LK)
267 96 : call test%assert(assertion, SK_"getLinSpace() must return an increasing `linSpace` with `fopen = .true._LK, lopen = .true.` when x1, x2 = "//getStr([x1, x2]*sign))
268 :
269 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
270 :
271 32 : end subroutine
272 :
273 352 : subroutine reset()
274 352 : if (allocated(linSpace)) deallocate(linSpace)
275 352 : if (allocated(linSpace_ref)) deallocate(linSpace_ref)
276 352 : end subroutine
277 :
278 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
279 :
280 832 : subroutine report(fopen, lopen)
281 : logical(LK), intent(in), optional :: fopen, lopen
282 : #if getLinSpace_ENABLED
283 : integer(IK) :: count
284 416 : count = size(linSpace_ref, kind = IK)
285 1888 : linSpace = getLinSpace(x1 * sign, x2 * sign, count, fopen = fopen, lopen = lopen)
286 : #elif setLinSpace_ENABLED
287 416 : if (allocated(linSpace)) deallocate(linSpace)
288 832 : allocate(linSpace, mold = linSpace_ref)
289 416 : call setLinSpace(linSpace, x1 * sign, x2 * sign, fopen = fopen, lopen = lopen)
290 : #else
291 : #error "Unrecognized interface."
292 : #endif
293 3776 : diff = abs(linSpace - linSpace_ref * sign)
294 2944 : assertion = assertion .and. all(diff < tol)
295 832 : if (test%traceable .and. .not. assertion) then
296 : ! LCOV_EXCL_START
297 : call test%disp%skip()
298 : call test%disp%show("x1")
299 : call test%disp%show( x1 )
300 : call test%disp%show("x2")
301 : call test%disp%show( x2 )
302 : call test%disp%show("linSpace_ref")
303 : call test%disp%show( linSpace_ref )
304 : call test%disp%show("linSpace")
305 : call test%disp%show( linSpace )
306 : call test%disp%show("diff")
307 : call test%disp%show( diff )
308 : call test%disp%show("TOL")
309 : call test%disp%show( TOL )
310 : call test%disp%show("sign")
311 : call test%disp%show( sign )
312 : if (present(fopen)) then
313 : call test%disp%show("fopen")
314 : call test%disp%show( fopen )
315 : end if
316 : if (present(lopen)) then
317 : call test%disp%show("lopen")
318 : call test%disp%show( lopen )
319 : end if
320 : call test%disp%skip()
321 : ! LCOV_EXCL_STOP
322 : end if
323 832 : end subroutine
324 :
325 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
326 : #elif getLogSpace_ENABLED || setLogSpace_ENABLED
327 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
328 :
329 : TYPE_KIND :: logx1, logx2
330 : real(TKC), parameter :: TOL = epsilon(0._TKC) * 10 ! ipo requires the given eps precision.
331 : TYPE_KIND, allocatable :: logSpace(:)
332 : TYPE_KIND, allocatable :: linSpace_ref(:), logSpace_ref(:)
333 : TYPE_KIND, allocatable :: diff(:)
334 : integer(IK) :: sign
335 :
336 16 : assertion = .true._LK
337 :
338 16 : sign = 1_IK
339 16 : call testWith()
340 :
341 16 : sign = -1_IK
342 16 : call testWith()
343 :
344 16 : sign = 1_IK
345 16 : call testWith(base = 2._TKC)
346 16 : sign = -1_IK
347 16 : call testWith(base = 2._TKC)
348 :
349 : contains
350 :
351 64 : subroutine testWith(base)
352 :
353 : real(TKC), intent(in), optional :: base
354 :
355 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
356 :
357 64 : call reset()
358 :
359 : #if CK_ENABLED
360 32 : logx1 = (0._TKC, 10._TKC)
361 32 : logx2 = (10._TKC, 0._TKC)
362 : #elif RK_ENABLED
363 32 : logx1 = 0._TKC
364 32 : logx2 = 10._TKC
365 : #endif
366 64 : allocate(linSpace_ref(0))
367 :
368 64 : call report(base)
369 64 : call test%assert(assertion, SK_"getLogSpace() must return an empty `logSpace` when size of `logSpace` is zero.")
370 :
371 64 : call report(base, fopen = .false._LK)
372 64 : call test%assert(assertion, SK_"getLogSpace() must return an empty `logSpace` when size of `logSpace` is zero with `fopen = .false.`.")
373 :
374 64 : call report(base, lopen = .false._LK)
375 64 : call test%assert(assertion, SK_"getLogSpace() must return an empty `logSpace` when size of `logSpace` is zero with `lopen = .false.`.")
376 :
377 64 : call report(base, fopen = .false._LK, lopen = .false._LK)
378 64 : call test%assert(assertion, SK_"getLogSpace() must return an empty `logSpace` when size of `logSpace` is zero with `fopen = .false._LK, lopen = .false.`.")
379 :
380 64 : call report(base, fopen = .false._LK, lopen = .true._LK)
381 64 : call test%assert(assertion, SK_"getLogSpace() must return an empty `logSpace` when size of `logSpace` is zero with `fopen = .false._LK, lopen = .true.`.")
382 :
383 64 : call report(base, fopen = .true._LK, lopen = .false._LK)
384 64 : call test%assert(assertion, SK_"getLogSpace() must return an empty `logSpace` when size of `logSpace` is zero with `fopen = .true._LK, lopen = .false.`.")
385 :
386 64 : call report(base, fopen = .true._LK, lopen = .true._LK)
387 64 : call test%assert(assertion, SK_"getLogSpace() must return an empty `logSpace` when size of `logSpace` is zero with `fopen = .true._LK, lopen = .true.`.")
388 :
389 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
390 :
391 64 : call reset()
392 :
393 : #if CK_ENABLED
394 32 : logx1 = (0._TKC, 10._TKC)
395 32 : logx2 = (10._TKC, 0._TKC)
396 160 : linSpace_ref = [(0._TKC, 10._TKC), (5._TKC, 5._TKC), (10._TKC, 0._TKC)]
397 : #elif RK_ENABLED
398 32 : logx1 = 0._TKC
399 32 : logx2 = 10._TKC
400 160 : linSpace_ref = [0._TKC, 5._TKC, 10._TKC]
401 : #endif
402 :
403 64 : call report(base)
404 192 : call test%assert(assertion, SK_"getLogSpace() must return an increasing `logSpace` when logx1, logx2 = "//getStr([logx1, logx2]*sign))
405 :
406 64 : call report(base, fopen = .false._LK)
407 192 : call test%assert(assertion, SK_"getLogSpace() must return an increasing `logSpace` with `fopen = .false.` when logx1, logx2 = "//getStr([logx1, logx2]*sign))
408 :
409 64 : call report(base, lopen = .false._LK)
410 192 : call test%assert(assertion, SK_"getLogSpace() must return an increasing `logSpace` with `lopen = .false.` when logx1, logx2 = "//getStr([logx1, logx2]*sign))
411 :
412 64 : call report(base, fopen = .false._LK, lopen = .false._LK)
413 192 : call test%assert(assertion, SK_"getLogSpace() must return an increasing `logSpace` with `fopen = .false._LK, lopen = .false.` when logx1, logx2 = "//getStr([logx1, logx2]*sign))
414 :
415 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
416 :
417 64 : call reset()
418 :
419 : #if CK_ENABLED
420 32 : logx1 = (0._TKC, 10._TKC)
421 32 : logx2 = (10._TKC, 0._TKC)
422 : !linSpace_ref = [(2.5_TKC, 10_TKC), (5._TKC, 7.5_TKC), (7.5_TKC, 5._TKC), (10._TKC, 2.5_TKC)]
423 192 : linSpace_ref = [(2.5_TKC, 7.5_TKC), (5._TKC, 5._TKC), (7.5_TKC, 2.5_TKC), (10._TKC, 0._TKC)]
424 : #elif RK_ENABLED
425 32 : logx1 = 0._TKC
426 32 : logx2 = 10._TKC
427 192 : linSpace_ref = [2.5_TKC, 5._TKC, 7.5_TKC, 10._TKC]
428 : #endif
429 :
430 64 : call report(base, fopen = .true._LK)
431 192 : call test%assert(assertion, SK_"getLogSpace() must return an increasing `logSpace` with `fopen = .true.` when logx1, logx2 = "//getStr([logx1, logx2]*sign))
432 :
433 64 : call report(base, fopen = .true._LK, lopen = .false._LK)
434 192 : call test%assert(assertion, SK_"getLogSpace() must return an increasing `logSpace` with `fopen = .true._LK, lopen = .false.` when logx1, logx2 = "//getStr([logx1, logx2]*sign))
435 :
436 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
437 :
438 64 : call reset()
439 :
440 : #if CK_ENABLED
441 32 : logx1 = (0._TKC, 10._TKC)
442 32 : logx2 = (10._TKC, 0._TKC)
443 192 : linSpace_ref = [(0._TKC, 10._TKC), (2.5_TKC, 7.5_TKC), (5._TKC, 5._TKC), (7.5_TKC, 2.5_TKC)]
444 : #elif RK_ENABLED
445 32 : logx1 = 0._TKC
446 32 : logx2 = 10._TKC
447 192 : linSpace_ref = [0._TKC, 2.5_TKC, 5._TKC, 7.5_TKC]
448 : #endif
449 :
450 64 : call report(base, lopen = .true._LK)
451 192 : call test%assert(assertion, SK_"getLogSpace() must return an increasing `logSpace` with `lopen = .true.` when logx1, logx2 = "//getStr([logx1, logx2]*sign))
452 :
453 64 : call report(base, fopen = .false._LK, lopen = .true._LK)
454 192 : call test%assert(assertion, SK_"getLogSpace() must return an increasing `logSpace` with `fopen = .false._LK, lopen = .true.` when logx1, logx2 = "//getStr([logx1, logx2]*sign))
455 :
456 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
457 :
458 64 : call reset()
459 :
460 : #if CK_ENABLED
461 32 : logx1 = (0._TKC, 10._TKC)
462 32 : logx2 = (10._TKC, 0._TKC)
463 192 : linSpace_ref = [(1.25_TKC, 8.75_TKC), (3.75_TKC, 6.25_TKC), (6.25_TKC, 3.75_TKC), (8.75_TKC, 1.25_TKC)]
464 : #elif RK_ENABLED
465 32 : logx1 = 0._TKC
466 32 : logx2 = 10._TKC
467 192 : linSpace_ref = [1.25_TKC, 3.75_TKC, 6.25_TKC, 8.75_TKC]
468 : #endif
469 :
470 64 : call report(base, fopen = .true._LK, lopen = .true._LK)
471 192 : call test%assert(assertion, SK_"getLogSpace() must return an increasing `logSpace` with `fopen = .true._LK, lopen = .true.` when logx1, logx2 = "//getStr([logx1, logx2]*sign))
472 :
473 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
474 :
475 64 : call reset()
476 :
477 : #if CK_ENABLED
478 32 : logx1 = (-10._TKC, +10._TKC)
479 32 : logx2 = (+10._TKC, -10._TKC)
480 192 : linSpace_ref = [(-7.5_TKC, 7.5_TKC), (-2.5_TKC, 2.5_TKC), (2.5_TKC, -2.5_TKC), (7.5_TKC, -7.5_TKC)]
481 : #elif RK_ENABLED
482 32 : logx1 = -10._TKC
483 32 : logx2 = +10._TKC
484 192 : linSpace_ref = [-7.5_TKC, -2.5_TKC, 2.5_TKC, 7.5_TKC]
485 : #endif
486 :
487 64 : call report(base, fopen = .true._LK, lopen = .true._LK)
488 192 : call test%assert(assertion, SK_"getLogSpace() must return an increasing `logSpace` with `fopen = .true._LK, lopen = .true.` when logx1, logx2 = "//getStr([logx1, logx2]*sign))
489 :
490 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
491 :
492 64 : call reset()
493 :
494 : #if CK_ENABLED
495 32 : logx1 = (-7.5_TKC, +7.5_TKC)
496 32 : logx2 = (+7.5_TKC, -7.5_TKC)
497 192 : linSpace_ref = [(-7.5_TKC, 7.5_TKC), (-2.5_TKC, 2.5_TKC), (2.5_TKC, -2.5_TKC), (7.5_TKC, -7.5_TKC)]
498 : #elif RK_ENABLED
499 32 : logx1 = -7.5_TKC
500 32 : logx2 = +7.5_TKC
501 192 : linSpace_ref = [-7.5_TKC, -2.5_TKC, 2.5_TKC, 7.5_TKC]
502 : #endif
503 :
504 64 : call report(base)
505 192 : call test%assert(assertion, SK_"getLogSpace() must return an increasing `logSpace` when logx1, logx2 = "//getStr([logx1, logx2]*sign))
506 :
507 64 : call report(base, fopen = .false._LK)
508 192 : call test%assert(assertion, SK_"getLogSpace() must return an increasing `logSpace` with `fopen = .false.` when logx1, logx2 = "//getStr([logx1, logx2]*sign))
509 :
510 64 : call report(base, lopen = .false._LK)
511 192 : call test%assert(assertion, SK_"getLogSpace() must return an increasing `logSpace` with `lopen = .false.` when logx1, logx2 = "//getStr([logx1, logx2]*sign))
512 :
513 64 : call report(base, fopen = .false._LK, lopen = .false._LK)
514 192 : call test%assert(assertion, SK_"getLogSpace() must return an increasing `logSpace` with `fopen = .false._LK, lopen = .false.` when logx1, logx2 = "//getStr([logx1, logx2]*sign))
515 :
516 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
517 :
518 64 : call reset()
519 :
520 : #if CK_ENABLED
521 32 : logx1 = (-7.5_TKC, +7.5_TKC)
522 32 : logx2 = (+12.5_TKC, -12.5_TKC)
523 192 : linSpace_ref = [(-7.5_TKC, 7.5_TKC), (-2.5_TKC, 2.5_TKC), (2.5_TKC, -2.5_TKC), (7.5_TKC, -7.5_TKC)]
524 : #elif RK_ENABLED
525 32 : logx1 = -7.5_TKC
526 32 : logx2 = +12.5_TKC
527 192 : linSpace_ref = [-7.5_TKC, -2.5_TKC, 2.5_TKC, 7.5_TKC]
528 : #endif
529 :
530 64 : call report(base, fopen = .false._LK, lopen = .true._LK)
531 192 : call test%assert(assertion, SK_"getLogSpace() must return an increasing `logSpace` with `fopen = .false._LK, lopen = .true.` when logx1, logx2 = "//getStr([logx1, logx2]*sign))
532 :
533 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
534 :
535 64 : call reset()
536 :
537 : #if CK_ENABLED
538 32 : logx1 = (-12.5_TKC, +12.5_TKC)
539 32 : logx2 = (+7.5_TKC, -7.5_TKC)
540 192 : linSpace_ref = [(-7.5_TKC, 7.5_TKC), (-2.5_TKC, 2.5_TKC), (2.5_TKC, -2.5_TKC), (7.5_TKC, -7.5_TKC)]
541 : #elif RK_ENABLED
542 32 : logx1 = -12.5_TKC
543 32 : logx2 = +7.5_TKC
544 192 : linSpace_ref = [-7.5_TKC, -2.5_TKC, 2.5_TKC, 7.5_TKC]
545 : #endif
546 :
547 64 : call report(base, fopen = .true._LK, lopen = .false._LK)
548 192 : call test%assert(assertion, SK_"getLogSpace() must return an increasing `logSpace` with `fopen = .true._LK, lopen = .false.` when logx1, logx2 = "//getStr([logx1, logx2]*sign))
549 :
550 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
551 :
552 64 : call reset()
553 :
554 : #if CK_ENABLED
555 32 : logx1 = (-12.5_TKC, +12.5_TKC)
556 32 : logx2 = (+7.5_TKC, -7.5_TKC)
557 96 : linSpace_ref = [logx1]
558 : #elif RK_ENABLED
559 32 : logx1 = -12.5_TKC
560 32 : logx2 = +7.5_TKC
561 96 : linSpace_ref = [logx1]
562 : #endif
563 :
564 64 : call report(base, fopen = .false._LK, lopen = .false._LK)
565 192 : call test%assert(assertion, SK_"getLogSpace() must return a `logSpace = logx1` when `size(logSpace)==1` when logx1, logx2 = "//getStr([logx1, logx2]*sign))
566 :
567 64 : call report(base)
568 192 : call test%assert(assertion, SK_"getLogSpace() must return a `logSpace = logx1` when `size(logSpace)==1` with `fopen = .false._LK, lopen = .false.` when logx1, logx2 = "//getStr([logx1, logx2]*sign))
569 :
570 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
571 :
572 64 : call reset()
573 :
574 : #if CK_ENABLED
575 32 : logx1 = (-10._TKC, +10._TKC)
576 32 : logx2 = (+10._TKC, -10._TKC)
577 192 : linSpace_ref = [(-7.5_TKC, 7.5_TKC), (-2.5_TKC, 2.5_TKC), (2.5_TKC, -2.5_TKC), (7.5_TKC, -7.5_TKC)]
578 : #elif RK_ENABLED
579 32 : logx1 = -10._TKC
580 32 : logx2 = +10._TKC
581 192 : linSpace_ref = [-7.5_TKC, -2.5_TKC, 2.5_TKC, 7.5_TKC]
582 : #endif
583 :
584 64 : call report(base, fopen = .true._LK, lopen = .true._LK)
585 192 : call test%assert(assertion, SK_"getLogSpace() must return an increasing `logSpace` with `fopen = .true._LK, lopen = .true.` when logx1, logx2 = "//getStr([logx1, logx2]*sign))
586 :
587 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
588 :
589 64 : end subroutine
590 :
591 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
592 :
593 704 : subroutine reset()
594 704 : if (allocated(logSpace)) deallocate(logSpace)
595 704 : if (allocated(linSpace_ref)) deallocate(linSpace_ref)
596 704 : end subroutine
597 :
598 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
599 :
600 1664 : subroutine report(base, fopen, lopen)
601 : logical(LK), intent(in), optional :: fopen, lopen
602 : real(TKC), intent(in), optional :: base
603 : #if getLogSpace_ENABLED
604 : integer(IK) :: count
605 832 : count = size(linSpace_ref, kind = IK)
606 3776 : logSpace = getLogSpace(logx1 * sign, logx2 * sign, count, fopen = fopen, lopen = lopen, base = base)
607 : #elif setLogSpace_ENABLED
608 832 : if (allocated(logSpace)) deallocate(logSpace)
609 1664 : allocate(logSpace, mold = linSpace_ref)
610 832 : call setLogSpace(logSpace, logx1 * sign, logx2 * sign, fopen = fopen, lopen = lopen, base = base)
611 : #else
612 : #error "Unrecognized interface."
613 : #endif
614 1664 : if (present(base)) then
615 3776 : logSpace_ref = base**(linSpace_ref * sign)
616 : else
617 3776 : logSpace_ref = exp(linSpace_ref * sign)
618 : end if
619 1664 : if (allocated(diff)) deallocate(diff)
620 3328 : allocate(diff, mold = logSpace_ref)
621 : #if CK_ENABLED
622 2944 : where (logSpace_ref%re > 0._TKC)
623 : diff%re = abs(logSpace%re - logSpace_ref%re) / logSpace_ref%re
624 : elsewhere
625 : diff%re = abs(logSpace%re - logSpace_ref%re)
626 : end where
627 2944 : where (logSpace_ref%im > 0._TKC)
628 : diff%im = abs(logSpace%im - logSpace_ref%im) / logSpace_ref%im
629 : elsewhere
630 : diff%im = abs(logSpace%im - logSpace_ref%im)
631 : end where
632 2944 : assertion = assertion .and. all(diff%re < TOL)
633 2944 : assertion = assertion .and. all(diff%im < TOL)
634 : #elif RK_ENABLED
635 2944 : where (logSpace_ref > 0._TKC)
636 : diff = abs(logSpace - logSpace_ref) / logSpace_ref
637 : elsewhere
638 : diff = abs(logSpace - logSpace_ref)
639 : end where
640 2944 : assertion = assertion .and. all(diff < TOL)
641 : #endif
642 1664 : if (test%traceable .and. .not. assertion) then
643 : ! LCOV_EXCL_START
644 : call test%disp%skip()
645 : call test%disp%show("logx1")
646 : call test%disp%show( logx1 )
647 : call test%disp%show("logx2")
648 : call test%disp%show( logx2 )
649 : call test%disp%show("linSpace_ref")
650 : call test%disp%show( linSpace_ref )
651 : call test%disp%show("logSpace_ref")
652 : call test%disp%show( logSpace_ref )
653 : call test%disp%show("logSpace")
654 : call test%disp%show( logSpace )
655 : call test%disp%show("diff")
656 : call test%disp%show( diff )
657 : call test%disp%show("TOL")
658 : call test%disp%show( TOL )
659 : call test%disp%show("sign")
660 : call test%disp%show( sign )
661 : if (present(base)) then
662 : call test%disp%show("base")
663 : call test%disp%show( base )
664 : end if
665 : if (present(fopen)) then
666 : call test%disp%show("fopen")
667 : call test%disp%show( fopen )
668 : end if
669 : if (present(lopen)) then
670 : call test%disp%show("lopen")
671 : call test%disp%show( lopen )
672 : end if
673 : call test%disp%skip()
674 : ! LCOV_EXCL_STOP
675 : end if
676 1664 : end subroutine
677 :
678 : #else
679 : !%%%%%%%%%%%%%%%%%%%%%%%%
680 : #error "Unrecognized interface."
681 : !%%%%%%%%%%%%%%%%%%%%%%%%
682 : #endif
683 : #undef TYPE_KIND
|
