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