Line data Source code
1 : ! This file is part of fortran_tester
2 : ! Copyright 2015-2020 Pierre de Buyl and contributors
3 : ! License: BSD
4 :
5 : !> Routines to test Fortran programs
6 : !!
7 : !! fortran_tester is a pure-Fortran module. It provides a datatype to hold test results and
8 : !! routines to test for equality, closeness, and positivity of variables. The routines are
9 : !! overloaded and the resulting interface consists of a small number of names.
10 :
11 : module tester
12 : use, intrinsic :: iso_fortran_env, only : int8, int16, int32, int64, real32, real64
13 :
14 : implicit none
15 : private
16 : public :: tester_t
17 :
18 : !> The main **tester** class.
19 : type :: tester_t
20 : integer(int32) :: n_errors=0_int32 !< Number of errors.
21 : integer(int32) :: n_tests=0_int32 !< Number of tests.
22 : real(real32) :: tolerance32=2._real32*epsilon(1._real32) !< Real tolerance, 32 bits.
23 : real(real64) :: tolerance64=2._real64*epsilon(1._real64) !< Real tolerance, 64 bits.
24 : contains
25 : procedure :: init !< Initialize the tester.
26 : procedure :: print !< Print tests results.
27 : generic, public :: assert_equal => &
28 : assert_equal_i8, &
29 : assert_equal_i16, &
30 : assert_equal_i32, &
31 : assert_equal_i64, &
32 : assert_equal_r32, &
33 : assert_equal_r64, &
34 : assert_equal_c32, &
35 : assert_equal_c64, &
36 : assert_equal_l, &
37 : assert_equal_i8_1, &
38 : assert_equal_i16_1, &
39 : assert_equal_i32_1, &
40 : assert_equal_i64_1, &
41 : assert_equal_r32_1, &
42 : assert_equal_r64_1, &
43 : assert_equal_c32_1, &
44 : assert_equal_c64_1, &
45 : assert_equal_l_1 !< Check if two values (integer, real, complex or logical) are equal.
46 : procedure, private :: assert_equal_i8 !< Check if two integers (8 bits) are equal.
47 : procedure, private :: assert_equal_i16 !< Check if two integers (16 bits) are equal.
48 : procedure, private :: assert_equal_i32 !< Check if two integers (32 bits) are equal.
49 : procedure, private :: assert_equal_i64 !< Check if two integers (64 bits) are equal.
50 : procedure, private :: assert_equal_r32 !< Check if two reals (32 bits) are equal.
51 : procedure, private :: assert_equal_r64 !< Check if two reals (64 bits) are equal.
52 : procedure, private :: assert_equal_c32 !< Check if two complex numbers (32 bits) are equal.
53 : procedure, private :: assert_equal_c64 !< Check if two complex numbers (64 bits) are equal.
54 : procedure, private :: assert_equal_l !< Check if two logicals are equal.
55 : procedure, private :: assert_equal_i8_1 !< Check if two integer (8 bits) arrays (rank 1) are equal.
56 : procedure, private :: assert_equal_i16_1 !< Check if two integer (16 bits) arrays (rank 1) are equal.
57 : procedure, private :: assert_equal_i32_1 !< Check if two integer (32 bits) arrays (rank 1) are equal.
58 : procedure, private :: assert_equal_i64_1 !< Check if two integer (64 bits) arrays (rank 1) are equal.
59 : procedure, private :: assert_equal_r32_1 !< Check if two real (32 bits) arrays (rank 1) are equal.
60 : procedure, private :: assert_equal_r64_1 !< Check if two real (64 bits) arrays (rank 1) are equal.
61 : procedure, private :: assert_equal_c32_1 !< Check if two complex (32 bits) arrays (rank 1) are equal.
62 : procedure, private :: assert_equal_c64_1 !< Check if two complex (64 bits) arrays (rank 1) are equal.
63 : procedure, private :: assert_equal_l_1 !< Check if two logical arrays (rank 1) are equal.
64 : generic, public :: assert_positive => &
65 : assert_positive_i8, &
66 : assert_positive_i16, &
67 : assert_positive_i32, &
68 : assert_positive_i64, &
69 : assert_positive_r32, &
70 : assert_positive_r64, &
71 : assert_positive_i8_1, &
72 : assert_positive_i16_1, &
73 : assert_positive_i32_1, &
74 : assert_positive_i64_1, &
75 : assert_positive_r32_1, &
76 : assert_positive_r64_1 !< Check if a number (integer or real) is positive.
77 : procedure, private :: assert_positive_i8 !< Check if a integer (8 bits) is positive.
78 : procedure, private :: assert_positive_i16 !< Check if a integer (16 bits) is positive.
79 : procedure, private :: assert_positive_i32 !< Check if a integer (32 bits) is positive.
80 : procedure, private :: assert_positive_i64 !< Check if a integer (64 bits) is positive.
81 : procedure, private :: assert_positive_r32 !< Check if a real (32 bits) is positive.
82 : procedure, private :: assert_positive_r64 !< Check if a real (64 bits) is positive.
83 : procedure, private :: assert_positive_i8_1 !< Check if a integer (8 bits) array (rank 1) is positive.
84 : procedure, private :: assert_positive_i16_1 !< Check if a integer (16 bits) array (rank 1) is positive.
85 : procedure, private :: assert_positive_i32_1 !< Check if a integer (32 bits) array (rank 1) is positive.
86 : procedure, private :: assert_positive_i64_1 !< Check if a integer (64 bits) array (rank 1) is positive.
87 : procedure, private :: assert_positive_r32_1 !< Check if a real (32 bits) array (rank 1) is positive.
88 : procedure, private :: assert_positive_r64_1 !< Check if a real (64 bits) array (rank 1) is positive.
89 : generic, public :: assert_close => &
90 : assert_close_r32, &
91 : assert_close_r64, &
92 : assert_close_c32, &
93 : assert_close_c64, &
94 : assert_close_r32_1, &
95 : assert_close_r64_1, &
96 : assert_close_c32_1, &
97 : assert_close_c64_1 !< Check if two values (real or complex) are close with respect a tolerance.
98 : procedure, private :: assert_close_r32 !< Check if two reals (32 bits) are close with respect a tolerance.
99 : procedure, private :: assert_close_r64 !< Check if two reals (64 bits) are close with respect a tolerance.
100 : procedure, private :: assert_close_c32 !< Check if two complex numbers (32 bits) are close with respect a tolerance.
101 : procedure, private :: assert_close_c64 !< Check if two complex numbers (64 bits) are close with respect a tolerance.
102 : procedure, private :: assert_close_r32_1 !< Check if two real (32 bits) arrays (rank 1) are close with respect a tolerance.
103 : procedure, private :: assert_close_r64_1 !< Check if two real (64 bits) arrays (rank 1) are close with respect a tolerance.
104 : procedure, private :: assert_close_c32_1 !< Check if two complex (32 bits) arrays (rank 1) are close with respect a tolerance.
105 : procedure, private :: assert_close_c64_1 !< Check if two complex (64 bits) arrays (rank 1) are close with respect a tolerance.
106 : end type tester_t
107 :
108 : contains
109 :
110 : !> Initialize the tester.
111 9 : subroutine init(this, tolerance32, tolerance64)
112 0 : class(tester_t), intent(out) :: this !< The tester.
113 : real(real32), intent(in), optional :: tolerance32 !< Real tolerance, 32 bits.
114 : real(real64), intent(in), optional :: tolerance64 !< Real tolerance, 64 bits.
115 :
116 9 : this% n_errors = 0
117 9 : this% n_tests = 0
118 :
119 9 : if (present(tolerance64)) then
120 0 : this% tolerance64 = tolerance64
121 : else
122 9 : this% tolerance64 = 2._real64*epsilon(1._real64)
123 : end if
124 :
125 9 : if (present(tolerance32)) then
126 0 : this% tolerance32 = tolerance32
127 : else
128 9 : this% tolerance32 = 2._real32*epsilon(1._real32)
129 : end if
130 :
131 9 : end subroutine init
132 :
133 : !> Print tests results.
134 9 : subroutine print(this, errorstop)
135 : class(tester_t), intent(in) :: this !< The tester.
136 : logical, intent(in), optional :: errorstop !< Flag to activate error stop if one test fails.
137 :
138 : logical :: do_errorstop
139 9 : if (present(errorstop)) then
140 0 : do_errorstop = errorstop
141 : else
142 9 : do_errorstop = .true.
143 : end if
144 :
145 9 : write(*,*) 'fortran_tester:', this% n_errors, ' error(s) for', this% n_tests, 'test(s)'
146 :
147 9 : if (this% n_errors == 0) then
148 5 : write(*,*) 'fortran_tester: all tests succeeded'
149 : else
150 4 : write(*,*) 'fortran_tester: tests failed'
151 4 : if (do_errorstop) then
152 4 : stop 1
153 : end if
154 : end if
155 :
156 5 : end subroutine print
157 :
158 : !> Check if two integers (8 bits) are equal.
159 0 : subroutine assert_equal_i8(this, i1, i2)
160 : class(tester_t), intent(inout) :: this !< The tester.
161 : integer(int8), intent(in) :: i1 !< Value to compare.
162 : integer(int8), intent(in) :: i2 !< Value to compare.
163 :
164 0 : this% n_tests = this% n_tests + 1
165 0 : if (i1 .ne. i2) then
166 0 : this% n_errors = this% n_errors + 1
167 : end if
168 :
169 0 : end subroutine assert_equal_i8
170 :
171 : !> Check if two integers (16 bits) are equal.
172 1 : subroutine assert_equal_i16(this, i1, i2)
173 : class(tester_t), intent(inout) :: this !< The tester.
174 : integer(int16), intent(in) :: i1 !< Value to compare.
175 : integer(int16), intent(in) :: i2 !< Value to compare.
176 :
177 1 : this% n_tests = this% n_tests + 1
178 1 : if (i1 .ne. i2) then
179 0 : this% n_errors = this% n_errors + 1
180 : end if
181 :
182 1 : end subroutine assert_equal_i16
183 :
184 : !> Check if two integers (32 bits) are equal.
185 3 : subroutine assert_equal_i32(this, i1, i2)
186 : class(tester_t), intent(inout) :: this !< The tester.
187 : integer(int32), intent(in) :: i1 !< Value to compare.
188 : integer(int32), intent(in) :: i2 !< Value to compare.
189 :
190 3 : this% n_tests = this% n_tests + 1
191 3 : if (i1 .ne. i2) then
192 1 : this% n_errors = this% n_errors + 1
193 : end if
194 :
195 3 : end subroutine assert_equal_i32
196 :
197 : !> Check if two integers (64 bits) are equal.
198 1 : subroutine assert_equal_i64(this, i1, i2)
199 : class(tester_t), intent(inout) :: this !< The tester.
200 : integer(int64), intent(in) :: i1 !< Value to compare.
201 : integer(int64), intent(in) :: i2 !< Value to compare.
202 :
203 1 : this% n_tests = this% n_tests + 1
204 1 : if (i1 .ne. i2) then
205 0 : this% n_errors = this% n_errors + 1
206 : end if
207 :
208 1 : end subroutine assert_equal_i64
209 :
210 : !> Check if two reals (32 bits) are equal.
211 1 : subroutine assert_equal_r32(this, r1, r2)
212 : class(tester_t), intent(inout) :: this !< The tester.
213 : real(real32), intent(in) :: r1 !< Value to compare.
214 : real(real32), intent(in) :: r2 !< Value to compare.
215 :
216 1 : this% n_tests = this% n_tests + 1
217 1 : if (r1 .ne. r2) then
218 0 : this% n_errors = this% n_errors + 1
219 : end if
220 :
221 1 : end subroutine assert_equal_r32
222 :
223 : !> Check if two reals (64 bits) are equal.
224 1 : subroutine assert_equal_r64(this, r1, r2)
225 : class(tester_t), intent(inout) :: this !< The tester.
226 : real(real64), intent(in) :: r1 !< Value to compare.
227 : real(real64), intent(in) :: r2 !< Value to compare.
228 :
229 1 : this% n_tests = this% n_tests + 1
230 1 : if (r1 .ne. r2) then
231 0 : this% n_errors = this% n_errors + 1
232 : end if
233 :
234 1 : end subroutine assert_equal_r64
235 :
236 : !> Check if two complex numbers (32 bits) are equal.
237 1 : subroutine assert_equal_c32(this, c1, c2)
238 : class(tester_t), intent(inout) :: this !< The tester.
239 : complex(real32), intent(in) :: c1 !< Value to compare.
240 : complex(real32), intent(in) :: c2 !< Value to compare.
241 :
242 1 : this% n_tests = this% n_tests + 1
243 1 : if (c1 .ne. c2) then
244 0 : this% n_errors = this% n_errors + 1
245 : end if
246 :
247 1 : end subroutine assert_equal_c32
248 :
249 : !> Check if two complex numbers (64 bits) are equal.
250 1 : subroutine assert_equal_c64(this, c1, c2)
251 : class(tester_t), intent(inout) :: this !< The tester.
252 : complex(real64), intent(in) :: c1 !< Value to compare.
253 : complex(real64), intent(in) :: c2 !< Value to compare.
254 :
255 1 : this% n_tests = this% n_tests + 1
256 1 : if (c1 .ne. c2) then
257 0 : this% n_errors = this% n_errors + 1
258 : end if
259 :
260 1 : end subroutine assert_equal_c64
261 :
262 : !> Check if two logicals are equal.
263 2 : subroutine assert_equal_l(this, l1, l2)
264 : class(tester_t), intent(inout) :: this !< The tester.
265 : logical, intent(in) :: l1 !< Value to compare.
266 : logical, intent(in) :: l2 !< Value to compare.
267 :
268 2 : this% n_tests = this% n_tests + 1
269 2 : if (l1 .neqv. l2) then
270 1 : this% n_errors = this% n_errors + 1
271 : end if
272 :
273 2 : end subroutine assert_equal_l
274 :
275 : !> Check if two integer (8 bits) arrays (rank 1) are equal.
276 0 : subroutine assert_equal_i8_1(this, i1, i2)
277 : class(tester_t), intent(inout) :: this !< The tester.
278 : integer(int8), dimension(:), intent(in) :: i1 !< Value to compare.
279 : integer(int8), dimension(:), intent(in) :: i2 !< Value to compare.
280 :
281 0 : this% n_tests = this% n_tests + 1
282 :
283 0 : if ( size(i1) .ne. size(i2) ) then
284 0 : this% n_errors = this% n_errors + 1
285 : else
286 0 : if ( maxval(abs(i1-i2)) > 0 ) then
287 0 : this% n_errors = this% n_errors + 1
288 : end if
289 : end if
290 :
291 0 : end subroutine assert_equal_i8_1
292 :
293 : !> Check if two integer (16 bits) arrays (rank 1) are equal.
294 1 : subroutine assert_equal_i16_1(this, i1, i2)
295 : class(tester_t), intent(inout) :: this !< The tester.
296 : integer(int16), dimension(:), intent(in) :: i1 !< Value to compare.
297 : integer(int16), dimension(:), intent(in) :: i2 !< Value to compare.
298 :
299 1 : this% n_tests = this% n_tests + 1
300 :
301 1 : if ( size(i1) .ne. size(i2) ) then
302 0 : this% n_errors = this% n_errors + 1
303 : else
304 1 : if ( maxval(abs(i1-i2)) > 0 ) then
305 0 : this% n_errors = this% n_errors + 1
306 : end if
307 : end if
308 :
309 1 : end subroutine assert_equal_i16_1
310 :
311 : !> Check if two integer (32 bits) arrays (rank 1) are equal.
312 3 : subroutine assert_equal_i32_1(this, i1, i2)
313 : class(tester_t), intent(inout) :: this !< The tester.
314 : integer(int32), dimension(:), intent(in) :: i1 !< Value to compare.
315 : integer(int32), dimension(:), intent(in) :: i2 !< Value to compare.
316 :
317 3 : this% n_tests = this% n_tests + 1
318 :
319 3 : if ( size(i1) .ne. size(i2) ) then
320 0 : this% n_errors = this% n_errors + 1
321 : else
322 3 : if ( maxval(abs(i1-i2)) > 0 ) then
323 1 : this% n_errors = this% n_errors + 1
324 : end if
325 : end if
326 :
327 3 : end subroutine assert_equal_i32_1
328 :
329 : !> Check if two integer (64 bits) arrays (rank 1) are equal.
330 2 : subroutine assert_equal_i64_1(this, i1, i2)
331 : class(tester_t), intent(inout) :: this !< The tester.
332 : integer(int64), dimension(:), intent(in) :: i1 !< Value to compare.
333 : integer(int64), dimension(:), intent(in) :: i2 !< Value to compare.
334 :
335 2 : this% n_tests = this% n_tests + 1
336 :
337 2 : if ( size(i1) .ne. size(i2) ) then
338 0 : this% n_errors = this% n_errors + 1
339 : else
340 2 : if ( maxval(abs(i1-i2)) > 0 ) then
341 1 : this% n_errors = this% n_errors + 1
342 : end if
343 : end if
344 :
345 2 : end subroutine assert_equal_i64_1
346 :
347 : !> Check if two real (32 bits) arrays (rank 1) are equal.
348 1 : subroutine assert_equal_r32_1(this, r1, r2)
349 : class(tester_t), intent(inout) :: this !< The tester.
350 : real(real32), dimension(:), intent(in) :: r1 !< Value to compare.
351 : real(real32), dimension(:), intent(in) :: r2 !< Value to compare.
352 :
353 1 : this% n_tests = this% n_tests + 1
354 :
355 1 : if ( size(r1) .ne. size(r2) ) then
356 0 : this% n_errors = this% n_errors + 1
357 : else
358 1 : if ( maxval(abs(r1-r2)) > 0 ) then
359 0 : this% n_errors = this% n_errors + 1
360 : end if
361 : end if
362 :
363 1 : end subroutine assert_equal_r32_1
364 :
365 : !> Check if two real (64 bits) arrays (rank 1) are equal.
366 1 : subroutine assert_equal_r64_1(this, r1, r2)
367 : class(tester_t), intent(inout) :: this !< The tester.
368 : real(real64), dimension(:), intent(in) :: r1 !< Value to compare.
369 : real(real64), dimension(:), intent(in) :: r2 !< Value to compare.
370 :
371 1 : this% n_tests = this% n_tests + 1
372 :
373 1 : if ( size(r1) .ne. size(r2) ) then
374 0 : this% n_errors = this% n_errors + 1
375 : else
376 1 : if ( maxval(abs(r1-r2)) > 0 ) then
377 0 : this% n_errors = this% n_errors + 1
378 : end if
379 : end if
380 :
381 1 : end subroutine assert_equal_r64_1
382 :
383 : !> Check if two complex (32 bits) arrays (rank 1) are equal.
384 1 : subroutine assert_equal_c32_1(this, c1, c2)
385 : class(tester_t), intent(inout) :: this !< The tester.
386 : complex(real32), dimension(:), intent(in) :: c1 !< Value to compare.
387 : complex(real32), dimension(:), intent(in) :: c2 !< Value to compare.
388 :
389 1 : this% n_tests = this% n_tests + 1
390 :
391 1 : if ( size(c1) .ne. size(c2) ) then
392 0 : this% n_errors = this% n_errors + 1
393 : else
394 1 : if ( maxval(abs(c1-c2)) > 0 ) then
395 0 : this% n_errors = this% n_errors + 1
396 : end if
397 : end if
398 :
399 1 : end subroutine assert_equal_c32_1
400 :
401 : !> Check if two complex (64 bits) arrays (rank 1) are equal.
402 1 : subroutine assert_equal_c64_1(this, c1, c2)
403 : class(tester_t), intent(inout) :: this !< The tester.
404 : complex(real64), dimension(:), intent(in) :: c1 !< Value to compare.
405 : complex(real64), dimension(:), intent(in) :: c2 !< Value to compare.
406 :
407 1 : this% n_tests = this% n_tests + 1
408 :
409 1 : if ( size(c1) .ne. size(c2) ) then
410 0 : this% n_errors = this% n_errors + 1
411 : else
412 1 : if ( maxval(abs(c1-c2)) > 0 ) then
413 0 : this% n_errors = this% n_errors + 1
414 : end if
415 : end if
416 :
417 1 : end subroutine assert_equal_c64_1
418 :
419 : !> Check if two logical arrays (rank 1) are equal.
420 1 : subroutine assert_equal_l_1(this, l1, l2)
421 : class(tester_t), intent(inout) :: this !< The tester.
422 : logical, intent(in), dimension(:) :: l1 !< Value to compare.
423 : logical, intent(in), dimension(:) :: l2 !< Value to compare.
424 :
425 : integer :: k
426 :
427 1 : this% n_tests = this% n_tests + 1
428 :
429 1 : if ( size(l1) .ne. size(l2) ) then
430 0 : this% n_errors = this% n_errors + 1
431 : else
432 3 : do k = 1, size(l1)
433 2 : if (l1(k) .neqv. l2(k)) then
434 0 : this% n_errors = this% n_errors + 1
435 0 : exit
436 : end if
437 : end do
438 : end if
439 :
440 1 : end subroutine assert_equal_l_1
441 :
442 : !> Check if a integer (32 bits) is positive.
443 0 : subroutine assert_positive_i8(this, i)
444 : class(tester_t), intent(inout) :: this !< The tester.
445 : integer(int8), intent(in) :: i !< Value to check.
446 :
447 0 : this% n_tests = this% n_tests + 1
448 0 : if (i < 0) then
449 0 : this% n_errors = this% n_errors + 1
450 : end if
451 :
452 0 : end subroutine assert_positive_i8
453 :
454 : !> Check if a integer (16 bits) is positive.
455 1 : subroutine assert_positive_i16(this, i)
456 : class(tester_t), intent(inout) :: this !< The tester.
457 : integer(int16), intent(in) :: i !< Value to check.
458 :
459 1 : this% n_tests = this% n_tests + 1
460 1 : if (i < 0) then
461 0 : this% n_errors = this% n_errors + 1
462 : end if
463 :
464 1 : end subroutine assert_positive_i16
465 :
466 : !> Check if a integer (32 bits) is positive.
467 1 : subroutine assert_positive_i32(this, i)
468 : class(tester_t), intent(inout) :: this !< The tester.
469 : integer(int32), intent(in) :: i !< Value to check.
470 :
471 1 : this% n_tests = this% n_tests + 1
472 1 : if (i < 0) then
473 0 : this% n_errors = this% n_errors + 1
474 : end if
475 :
476 1 : end subroutine assert_positive_i32
477 :
478 : !> Check if a integer (32 bits) is positive.
479 1 : subroutine assert_positive_i64(this, i)
480 : class(tester_t), intent(inout) :: this !< The tester.
481 : integer(int64), intent(in) :: i !< Value to check.
482 :
483 1 : this% n_tests = this% n_tests + 1
484 1 : if (i < 0) then
485 0 : this% n_errors = this% n_errors + 1
486 : end if
487 :
488 1 : end subroutine assert_positive_i64
489 :
490 : !> Check if a real (32 bits) is positive.
491 2 : subroutine assert_positive_r32(this, r)
492 : class(tester_t), intent(inout) :: this !< The tester.
493 : real(real32), intent(in) :: r !< Value to check.
494 :
495 2 : this% n_tests = this% n_tests + 1
496 2 : if (r < 0) then
497 0 : this% n_errors = this% n_errors + 1
498 : end if
499 :
500 2 : end subroutine assert_positive_r32
501 :
502 : !> Check if a real (64 bits) is positive.
503 1 : subroutine assert_positive_r64(this, r)
504 : class(tester_t), intent(inout) :: this !< The tester.
505 : real(real64), intent(in) :: r !< Value to check.
506 :
507 1 : this% n_tests = this% n_tests + 1
508 1 : if (r < 0) then
509 0 : this% n_errors = this% n_errors + 1
510 : end if
511 :
512 1 : end subroutine assert_positive_r64
513 :
514 : !> Check if a integer (8 bits) array (rank 1) is positive.
515 0 : subroutine assert_positive_i8_1(this, i)
516 : class(tester_t), intent(inout) :: this !< The tester.
517 : integer(int8), dimension(:), intent(in) :: i !< Value to check.
518 :
519 0 : this% n_tests = this% n_tests + 1
520 :
521 0 : if ( minval(i) < 0 ) then
522 0 : this% n_errors = this% n_errors + 1
523 : end if
524 :
525 0 : end subroutine assert_positive_i8_1
526 :
527 : !> Check if a integer (16 bits) array (rank 1) is positive.
528 1 : subroutine assert_positive_i16_1(this, i)
529 : class(tester_t), intent(inout) :: this !< The tester.
530 : integer(int16), dimension(:), intent(in) :: i !< Value to check.
531 :
532 1 : this% n_tests = this% n_tests + 1
533 :
534 1 : if ( minval(i) < 0 ) then
535 0 : this% n_errors = this% n_errors + 1
536 : end if
537 :
538 1 : end subroutine assert_positive_i16_1
539 :
540 : !> Check if a integer (32 bits) array (rank 1) is positive.
541 1 : subroutine assert_positive_i32_1(this, i)
542 : class(tester_t), intent(inout) :: this !< The tester.
543 : integer(int32), dimension(:), intent(in) :: i !< Value to check.
544 :
545 1 : this% n_tests = this% n_tests + 1
546 :
547 1 : if ( minval(i) < 0 ) then
548 0 : this% n_errors = this% n_errors + 1
549 : end if
550 :
551 1 : end subroutine assert_positive_i32_1
552 :
553 : !> Check if a integer (64 bits) array (rank 1) is positive.
554 1 : subroutine assert_positive_i64_1(this, i)
555 : class(tester_t), intent(inout) :: this !< The tester.
556 : integer(int64), dimension(:), intent(in) :: i !< Value to check.
557 :
558 1 : this% n_tests = this% n_tests + 1
559 :
560 1 : if ( minval(i) < 0 ) then
561 0 : this% n_errors = this% n_errors + 1
562 : end if
563 :
564 1 : end subroutine assert_positive_i64_1
565 :
566 : !> Check if a real (32 bits) array (rank 1) is positive.
567 1 : subroutine assert_positive_r32_1(this, r)
568 : class(tester_t), intent(inout) :: this !< The tester.
569 : real(real32), dimension(:), intent(in) :: r !< Value to check.
570 :
571 1 : this% n_tests = this% n_tests + 1
572 :
573 1 : if ( minval(r) < 0 ) then
574 0 : this% n_errors = this% n_errors + 1
575 : end if
576 :
577 1 : end subroutine assert_positive_r32_1
578 :
579 : !> Check if a real (64 bits) array (rank 1) is positive.
580 1 : subroutine assert_positive_r64_1(this, r)
581 : class(tester_t), intent(inout) :: this !< The tester.
582 : real(real64), dimension(:), intent(in) :: r !< Value to check.
583 :
584 1 : this% n_tests = this% n_tests + 1
585 :
586 1 : if ( minval(r) < 0 ) then
587 0 : this% n_errors = this% n_errors + 1
588 : end if
589 :
590 1 : end subroutine assert_positive_r64_1
591 :
592 : !> Check if two reals (32 bits) are close with respect a tolerance.
593 2 : subroutine assert_close_r32(this, r1, r2)
594 : class(tester_t), intent(inout) :: this !< The tester.
595 : real(real32), intent(in) :: r1 !< Value to compare.
596 : real(real32), intent(in) :: r2 !< Value to compare.
597 :
598 2 : this% n_tests = this% n_tests + 1
599 :
600 2 : if ( abs(r1-r2) > this% tolerance32 ) then
601 0 : this% n_errors = this% n_errors + 1
602 : end if
603 :
604 2 : end subroutine assert_close_r32
605 :
606 : !> Check if two reals (64 bits) are close with respect a tolerance.
607 3 : subroutine assert_close_r64(this, r1, r2)
608 : class(tester_t), intent(inout) :: this !< The tester.
609 : real(real64), intent(in) :: r1 !< Value to compare.
610 : real(real64), intent(in) :: r2 !< Value to compare.
611 :
612 3 : this% n_tests = this% n_tests + 1
613 :
614 3 : if ( abs(r1-r2) > this% tolerance64 ) then
615 0 : this% n_errors = this% n_errors + 1
616 : end if
617 :
618 3 : end subroutine assert_close_r64
619 :
620 : !> Check if two real (32 bits) arrays (rank 1) are close with respect a tolerance.
621 1 : subroutine assert_close_r32_1(this, r1, r2)
622 : class(tester_t), intent(inout) :: this !< The tester.
623 : real(real32), intent(in), dimension(:) :: r1 !< Value to compare.
624 : real(real32), intent(in), dimension(:) :: r2 !< Value to compare.
625 :
626 1 : this% n_tests = this% n_tests + 1
627 :
628 1 : if ( size(r1) .ne. size(r2) ) then
629 0 : this% n_errors = this% n_errors + 1
630 : else
631 1 : if ( maxval(abs(r1-r2)) > this% tolerance32 ) then
632 0 : this% n_errors = this% n_errors + 1
633 : end if
634 : end if
635 :
636 1 : end subroutine assert_close_r32_1
637 :
638 : !> Check if two real (64 bits) arrays (rank 1) are close with respect a tolerance.
639 1 : subroutine assert_close_r64_1(this, r1, r2)
640 : class(tester_t), intent(inout) :: this !< The tester.
641 : real(real64), intent(in), dimension(:) :: r1 !< Value to compare.
642 : real(real64), intent(in), dimension(:) :: r2 !< Value to compare.
643 :
644 1 : this% n_tests = this% n_tests + 1
645 :
646 1 : if ( size(r1) .ne. size(r2) ) then
647 0 : this% n_errors = this% n_errors + 1
648 : else
649 1 : if ( maxval(abs(r1-r2)) > this% tolerance64 ) then
650 0 : this% n_errors = this% n_errors + 1
651 : end if
652 : end if
653 :
654 1 : end subroutine assert_close_r64_1
655 :
656 : !> Check if two complex numbers (32 bits) are close with respect a tolerance.
657 1 : subroutine assert_close_c32(this, c1, c2)
658 : class(tester_t), intent(inout) :: this !< The tester.
659 : complex(real32), intent(in) :: c1 !< Value to compare.
660 : complex(real32), intent(in) :: c2 !< Value to compare.
661 :
662 1 : this% n_tests = this% n_tests + 1
663 :
664 1 : if ( abs(c1-c2) > this% tolerance32 ) then
665 0 : this% n_errors = this% n_errors + 1
666 : end if
667 :
668 1 : end subroutine assert_close_c32
669 :
670 : !> Check if two complex numbers (64 bits) are close with respect a tolerance.
671 2 : subroutine assert_close_c64(this, r1, c2)
672 : class(tester_t), intent(inout) :: this !< The tester.
673 : complex(real64), intent(in) :: r1 !< Value to compare.
674 : complex(real64), intent(in) :: c2 !< Value to compare.
675 :
676 2 : this% n_tests = this% n_tests + 1
677 :
678 2 : if ( abs(r1-c2) > this% tolerance64 ) then
679 0 : this% n_errors = this% n_errors + 1
680 : end if
681 :
682 2 : end subroutine assert_close_c64
683 :
684 : !> Check if two complex (32 bits) arrays (rank 1) are close with respect a tolerance.
685 1 : subroutine assert_close_c32_1(this, c1, c2)
686 : class(tester_t), intent(inout) :: this !< The tester.
687 : complex(real32), intent(in), dimension(:) :: c1 !< Value to compare.
688 : complex(real32), intent(in), dimension(:) :: c2 !< Value to compare.
689 :
690 1 : this% n_tests = this% n_tests + 1
691 :
692 1 : if ( size(c1) .ne. size(c2) ) then
693 0 : this% n_errors = this% n_errors + 1
694 : else
695 1 : if ( maxval(abs(c1-c2)) > this% tolerance32 ) then
696 0 : this% n_errors = this% n_errors + 1
697 : end if
698 : end if
699 :
700 1 : end subroutine assert_close_c32_1
701 :
702 : !> Check if two real (64 bits) arrays (rank 1) are close with respect a tolerance.
703 2 : subroutine assert_close_c64_1(this, c1, c2)
704 : class(tester_t), intent(inout) :: this !< The tester.
705 : complex(real64), intent(in), dimension(:) :: c1 !< Value to compare.
706 : complex(real64), intent(in), dimension(:) :: c2 !< Value to compare.
707 :
708 2 : this% n_tests = this% n_tests + 1
709 :
710 2 : if ( size(c1) .ne. size(c2) ) then
711 0 : this% n_errors = this% n_errors + 1
712 : else
713 2 : if ( maxval(abs(c1-c2)) > this% tolerance64 ) then
714 0 : this% n_errors = this% n_errors + 1
715 : end if
716 : end if
717 :
718 2 : end subroutine assert_close_c64_1
719 :
720 : end module tester
|
