SABER
tools_repro.F90
Go to the documentation of this file.
1
!----------------------------------------------------------------------
2
! Module: tools_repro
3
!> Reproducibility functions
4
! Author: Benjamin Menetrier
5
! Licensing: this code is distributed under the CeCILL-C license
6
! Copyright © 2015-... UCAR, CERFACS, METEO-FRANCE and IRIT
7
!----------------------------------------------------------------------
8
module
tools_repro
9
10
use
tools_const
,
only
:
pi
11
use
tools_kinds
,
only
:
kind_real
12
use
type_mpl
,
only
:
mpl_type
13
14
implicit none
15
16
logical
::
repro
= .true.
! Reproducibility flag
17
real
(
kind_real
),
parameter
::
rth
= 1.0e-12
! Reproducibility threshold
18
19
private
20
public
::
repro
,
rth
21
public
::
eq
,
inf
,
infeq
,
sup
,
supeq
,
indist
,
small
22
23
contains
24
25
!----------------------------------------------------------------------
26
! Function: eq
27
!> Equal test for reals
28
!----------------------------------------------------------------------
29
function
eq
(x,y)
30
31
implicit none
32
33
! Passed variables
34
real
(
kind_real
),
intent(in)
:: x
!< First real
35
real
(
kind_real
),
intent(in)
:: y
!< Second real
36
37
! Returned variable
38
logical
::
eq
39
40
if
(
repro
)
then
41
eq
=
indist
(x,y)
42
else
43
eq
= .not.(abs(x-y)>0.0)
44
end if
45
46
end function
eq
47
48
!----------------------------------------------------------------------
49
! Function: inf
50
!> Inferior test for reals
51
!----------------------------------------------------------------------
52
function
inf
(x,y)
53
54
implicit none
55
56
! Passed variables
57
real
(
kind_real
),
intent(in)
:: x
!< First real
58
real
(
kind_real
),
intent(in)
:: y
!< Second real
59
60
! Returned variable
61
logical
::
inf
62
63
inf
= (x<y)
64
if
(
repro
)
inf
=
inf
.and.(.not.
indist
(x,y))
65
66
end function
inf
67
68
!----------------------------------------------------------------------
69
! Function: infeq
70
!> Inferior or equal test for reals
71
!----------------------------------------------------------------------
72
function
infeq
(x,y)
73
74
implicit none
75
76
! Passed variables
77
real
(
kind_real
),
intent(in)
:: x
!< First real
78
real
(
kind_real
),
intent(in)
:: y
!< Second real
79
80
! Returned variable
81
logical
::
infeq
82
83
infeq
=
inf
(x,y).or.
eq
(x,y)
84
85
end function
infeq
86
87
!----------------------------------------------------------------------
88
! Function: sup
89
!> Superior test for reals
90
!----------------------------------------------------------------------
91
function
sup
(x,y)
92
93
implicit none
94
95
! Passed variables
96
real
(
kind_real
),
intent(in)
:: x
!< First real
97
real
(
kind_real
),
intent(in)
:: y
!< Second real
98
99
! Returned variable
100
logical
::
sup
101
102
sup
= (x>y)
103
if
(
repro
)
sup
=
sup
.and.(.not.
indist
(x,y))
104
105
end function
sup
106
107
!----------------------------------------------------------------------
108
! Function: supeq
109
!> Superior or equal test for reals
110
!----------------------------------------------------------------------
111
function
supeq
(x,y)
112
113
implicit none
114
115
! Passed variables
116
real
(
kind_real
),
intent(in)
:: x
!< First real
117
real
(
kind_real
),
intent(in)
:: y
!< Second real
118
119
! Returned variable
120
logical
::
supeq
121
122
supeq
=
sup
(x,y).or.
eq
(x,y)
123
124
end function
supeq
125
126
!----------------------------------------------------------------------
127
! Function: indist
128
!> Indistiguishability test
129
!----------------------------------------------------------------------
130
function
indist
(x,y)
131
132
implicit none
133
134
! Passed variables
135
real
(
kind_real
),
intent(in)
:: x
!< First real
136
real
(
kind_real
),
intent(in)
:: y
!< Second real
137
138
! Returned variable
139
logical
::
indist
140
141
indist
= .false.
142
if
(
repro
)
then
143
if
((abs(x)>0.0).or.(abs(y)>0.0))
then
144
indist
= abs(x-y)<
rth
*(abs(x+y))
145
else
146
indist
= .true.
147
end if
148
end if
149
150
end function
indist
151
152
!----------------------------------------------------------------------
153
! Function: small
154
!> Small value test
155
!----------------------------------------------------------------------
156
function
small
(x,y)
157
158
implicit none
159
160
! Passed variables
161
real
(
kind_real
),
intent(in)
:: x
!< First real
162
real
(
kind_real
),
intent(in)
:: y
!< Second real
163
164
! Returned variable
165
logical
::
small
166
167
small
= .false.
168
if
(
repro
)
small
= abs(x)<
rth
*abs(y)
169
170
end function
small
171
172
end module
tools_repro
tools_repro::sup
logical function, public sup(x, y)
Superior test for reals.
Definition:
tools_repro.F90:92
tools_repro::inf
logical function, public inf(x, y)
Inferior test for reals.
Definition:
tools_repro.F90:53
tools_repro::supeq
logical function, public supeq(x, y)
Superior or equal test for reals.
Definition:
tools_repro.F90:112
tools_repro::repro
logical, public repro
Definition:
tools_repro.F90:16
tools_const
Define usual constants and missing values.
Definition:
tools_const.F90:8
tools_repro::small
logical function, public small(x, y)
Small value test.
Definition:
tools_repro.F90:157
tools_repro::indist
logical function, public indist(x, y)
Indistiguishability test.
Definition:
tools_repro.F90:131
tools_repro
Reproducibility functions.
Definition:
tools_repro.F90:8
tools_repro::eq
logical function, public eq(x, y)
Equal test for reals.
Definition:
tools_repro.F90:30
tools_repro::infeq
logical function, public infeq(x, y)
Inferior or equal test for reals.
Definition:
tools_repro.F90:73
tools_repro::rth
real(kind_real), parameter, public rth
Definition:
tools_repro.F90:17
tools_kinds
Kinds definition.
Definition:
tools_kinds.F90:8
type_mpl
MPI parameters derived type.
Definition:
type_mpl.F90:8
tools_const::pi
real(kind_real), parameter, public pi
Definition:
tools_const.F90:14
type_mpl::mpl_type
Definition:
type_mpl.F90:24
tools_kinds::kind_real
integer, parameter, public kind_real
Definition:
tools_kinds.F90:18
fv3-bundle
saber
src
saber
util
tools_repro.F90
Generated on Sun Oct 25 2020 09:22:31 for SABER by
1.8.18