source: palm/trunk/UTIL/inifor/tests/util.f90 @ 3461

Last change on this file since 3461 was 3183, checked in by suehring, 6 years ago

last commit documented

  • Property svn:keywords set to Id
File size: 4.2 KB
Line 
1!> @file tests/util.f90
2!------------------------------------------------------------------------------!
3! This file is part of the PALM model system.
4!
5! PALM is free software: you can redistribute it and/or modify it under the
6! terms of the GNU General Public License as published by the Free Software
7! Foundation, either version 3 of the License, or (at your option) any later
8! version.
9!
10! PALM is distributed in the hope that it will be useful, but WITHOUT ANY
11! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
12! A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
13!
14! You should have received a copy of the GNU General Public License along with
15! PALM. If not, see <http://www.gnu.org/licenses/>.
16!
17! Copyright 2017-2018 Leibniz Universitaet Hannover
18! Copyright 2017-2018 Deutscher Wetterdienst Offenbach
19!------------------------------------------------------------------------------!
20!
21! Current revisions:
22! -----------------
23!
24!
25! Former revisions:
26! -----------------
27! $Id: util.f90 3183 2018-07-27 14:25:55Z knoop $
28! Expose error measure as parameter in assert_equal()
29!
30!
31! 3182 2018-07-27 13:36:03Z suehring
32! Initial revision
33!
34!
35!
36! Authors:
37! --------
38! @author Eckhard Kadasch
39!
40! Description:
41! ------------
42!> This module provides utiliy functions used in all test programs.
43!------------------------------------------------------------------------------!
44 MODULE test_utils
45 
46    IMPLICIT NONE
47
48 CONTAINS
49
50    SUBROUTINE begin_test(title, res)
51       CHARACTER(LEN=*), INTENT(IN) ::  title
52       LOGICAL, INTENT(OUT)         ::  res
53
54       res = .TRUE.
55
56       PRINT '(/A)',       "******************************************************"
57       PRINT '(A, A, A)',  " [  ]  Test '", TRIM(title), "' started."
58       PRINT '(A/)',       "******************************************************"
59    END SUBROUTINE begin_test
60
61    SUBROUTINE end_test(title, res)
62       CHARACTER(LEN=*), INTENT(IN) ::  title
63       CHARACTER(LEN=30)            ::  msg, label
64       LOGICAL, INTENT(IN)          ::  res
65
66
67       IF (res .EQV. .TRUE.)  THEN
68          msg = 'completed successfully.'
69          label = ' [OK]'
70       ELSE
71          msg = 'failed.'
72          label = ' [XX]'
73       END IF
74
75       PRINT '(/A, A, A, A)', TRIM(label) // "  Test '", TRIM(title), "' ", TRIM(msg)
76       PRINT '(A/)',       "******************************************************"
77
78    END SUBROUTINE end_test
79
80    LOGICAL FUNCTION assert_equal(a, b, msg, ratio)
81       REAL, OPTIONAL, INTENT(IN)     ::  ratio
82       REAL, DIMENSION(:), INTENT(IN) ::  a, b
83       CHARACTER(LEN=*), INTENT(IN)   ::  msg
84
85       IF ( PRESENT(ratio) )  THEN
86           assert_equal = assert(a, b, 'eq', ratio)
87       ELSE
88           assert_equal = assert(a, b, 'eq')
89       END IF
90
91       IF (assert_equal .eqv. .TRUE.)  THEN
92           PRINT *, "Equality assertion for ", msg, " was successful."
93       ELSE
94           PRINT *, "Equality assertion for ", msg, " failed. Maximum error is ",               &
95              MAXVAL( ABS( a - b))
96       END IF
97
98    END FUNCTION assert_equal
99
100    LOGICAL FUNCTION assert(a, b, mode, ratio)
101
102       REAL, DIMENSION(:), INTENT(IN) ::  a, b
103       REAL, OPTIONAL, INTENT(IN)     ::  ratio
104       CHARACTER(LEN=*), INTENT(IN)   ::  mode
105
106       REAL    ::  diff, mag, max_rel_diff
107       INTEGER ::  i
108
109       max_rel_diff = 10 * EPSILON(1.0)
110       IF (PRESENT(ratio)) max_rel_diff = ratio
111
112       SELECT CASE( TRIM(mode) )
113
114       ! This case is inspired by
115       ! https://randomascii.wordpress.com/2012/02/25/comparing-floating-point-numbers-2012-edition/
116       CASE('eq')
117          IF ( ALL(a(:) == b(:)) )  THEN
118             PRINT *, "Checking for exact equality"
119             assert = .TRUE.
120          ELSE
121             assert = .TRUE.
122             PRINT *, "Checking for near equality"
123             DO i = 1, SIZE(a)
124                diff   = ABS(a(i) - b(i)) 
125                mag    = MAX( ABS(a(i)), ABS(b(i)) )
126                assert = assert .AND. (diff < mag * max_rel_diff )
127             END DO
128          END IF
129
130       CASE DEFAULT
131          PRINT *, " Error: Assert mode ", mode, " not implemented. Stopping."
132          STOP
133
134       END SELECT
135   
136    END FUNCTION assert
137
138 END MODULE test_utils
139
Note: See TracBrowser for help on using the repository browser.