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

Last change on this file was 4843, checked in by raasch, 13 months ago

local namelist parameter added to switch off the module although the respective module namelist appears in the namelist file, further copyright updates

  • 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-2021 Leibniz Universitaet Hannover
18! Copyright 2017-2021 Deutscher Wetterdienst Offenbach
19!------------------------------------------------------------------------------!
20!
21! Current revisions:
22! -----------------
23!
24!
25! Former revisions:
26! -----------------
27! $Id: util.f90 4843 2021-01-15 15:22:11Z banzhafs $
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       ENDIF
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       ENDIF
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       ENDIF
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             ENDDO
128          ENDIF
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.