SICOPOLIS V5-dev  Revision 1105
compare_float_m.F90
Go to the documentation of this file.
1 !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
2 !
3 ! Module : c o m p a r e _ f l o a t _ m
4 !
5 !> @file
6 !!
7 !! Comparison of single- or double-precision floating-point numbers.
8 !!
9 !! @section Copyright
10 !!
11 !! Copyright 2009-2017 Ralf Greve
12 !!
13 !! @section License
14 !!
15 !! This file is part of SICOPOLIS.
16 !!
17 !! SICOPOLIS is free software: you can redistribute it and/or modify
18 !! it under the terms of the GNU General Public License as published by
19 !! the Free Software Foundation, either version 3 of the License, or
20 !! (at your option) any later version.
21 !!
22 !! SICOPOLIS is distributed in the hope that it will be useful,
23 !! but WITHOUT ANY WARRANTY; without even the implied warranty of
24 !! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
25 !! GNU General Public License for more details.
26 !!
27 !! You should have received a copy of the GNU General Public License
28 !! along with SICOPOLIS. If not, see <http://www.gnu.org/licenses/>.
29 !<
30 !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
31 
32 !-------------------------------------------------------------------------------
33 !> Comparison of single- or double-precision floating-point numbers.
34 !<------------------------------------------------------------------------------
36 
37 #if (defined(MODEL_SICOPOLIS))
38  use sico_types_m, only: sp, dp
39 #endif
40 
41  implicit none
42 
43  private
44  public :: approx_equal, approx_equal_integer, approx_integer_multiple
45 
46 #if (!defined(MODEL_SICOPOLIS))
47  integer, parameter :: sp = kind(1.0) ! single precision
48  integer, parameter :: dp = kind(1.0d0) ! double precision
49 #endif
50 
51  interface approx_equal
52  procedure :: approx_equal_sp, approx_equal_dp
53  end interface
54 
55  interface approx_equal_integer
56  procedure :: approx_equal_integer_sp, approx_equal_integer_dp
57  end interface
58 
59  interface approx_integer_multiple
60  procedure :: approx_integer_multiple_sp, approx_integer_multiple_dp
61  end interface
62 
63 contains
64 
65 !-------------------------------------------------------------------------------
66 !> Check whether single-precision x and y are approximately equal
67 !! (within a given eps limit).
68 !<------------------------------------------------------------------------------
69  function approx_equal_sp(x, y, eps)
70 
71  implicit none
72 
73  real(sp), intent(in) :: x, y
74  real(sp), intent(in) :: eps
75 
76  logical :: approx_equal_sp
77 
78  if ( abs(x-y) <= abs(x+y)*eps ) then
79  approx_equal_sp = .true.
80  else
81  approx_equal_sp = .false.
82  end if
83 
84  end function approx_equal_sp
85 
86 !-------------------------------------------------------------------------------
87 !> Check whether double-precision x and y are approximately equal
88 !! (within a given eps limit).
89 !<------------------------------------------------------------------------------
90  function approx_equal_dp(x, y, eps)
91 
92  implicit none
93 
94  real(dp), intent(in) :: x, y
95  real(dp), intent(in) :: eps
96 
97  logical :: approx_equal_dp
98 
99  if ( abs(x-y) <= abs(x+y)*eps ) then
100  approx_equal_dp = .true.
101  else
102  approx_equal_dp = .false.
103  end if
104 
105  end function approx_equal_dp
106 
107 !-------------------------------------------------------------------------------
108 !> Check whether single-precision x is approximately equal to an integer
109 !! (within a given eps limit).
110 !<------------------------------------------------------------------------------
111  function approx_equal_integer_sp(x, eps)
112 
113  implicit none
114 
115  real(sp), intent(in) :: x
116  real(sp), intent(in) :: eps
117 
118  logical :: approx_equal_integer_sp
119 
120  if (x == 0.0_sp) then
121  approx_equal_integer_sp = .true.
122  else if (approx_equal_sp(x, real(nint(x),sp), eps)) then
123  approx_equal_integer_sp = .true.
124  else
125  approx_equal_integer_sp = .false.
126  end if
127 
128  end function approx_equal_integer_sp
129 
130 !-------------------------------------------------------------------------------
131 !> Check whether double-precision x is approximately equal to an integer
132 !! (within a given eps limit).
133 !<------------------------------------------------------------------------------
134  function approx_equal_integer_dp(x, eps)
135 
136  implicit none
137 
138  real(dp), intent(in) :: x
139  real(dp), intent(in) :: eps
140 
141  logical :: approx_equal_integer_dp
142 
143  if (x == 0.0_dp) then
144  approx_equal_integer_dp = .true.
145  else if (approx_equal_dp(x, real(nint(x),dp), eps)) then
146  approx_equal_integer_dp = .true.
147  else
148  approx_equal_integer_dp = .false.
149  end if
150 
151  end function approx_equal_integer_dp
152 
153 !-------------------------------------------------------------------------------
154 !> Check whether single-precision x is approximately an integer multiple of
155 !! single-precision y (within a given eps limit).
156 !<------------------------------------------------------------------------------
157  function approx_integer_multiple_sp(x, y, eps)
158 
159  implicit none
160 
161  real(sp), intent(in) :: x, y
162  real(sp), intent(in) :: eps
163 
164  logical :: approx_integer_multiple_sp
165 
166  if (y == 0.0_sp) then
167  approx_integer_multiple_sp = .false.
168  else if (nint(x/y) == 0) then
169  approx_integer_multiple_sp = .false.
170  else if (approx_equal_integer_sp(x/y, eps)) then
171  approx_integer_multiple_sp = .true.
172  else
173  approx_integer_multiple_sp = .false.
174  end if
175 
176  end function approx_integer_multiple_sp
177 
178 !-------------------------------------------------------------------------------
179 !> Check whether double-precision x is approximately an integer multiple of
180 !! double-precision y (within a given eps limit).
181 !<------------------------------------------------------------------------------
182  function approx_integer_multiple_dp(x, y, eps)
183 
184  implicit none
185 
186  real(dp), intent(in) :: x, y
187  real(dp), intent(in) :: eps
188 
189  logical :: approx_integer_multiple_dp
190 
191  if (y == 0.0_dp) then
192  approx_integer_multiple_dp = .false.
193  else if (nint(x/y) == 0) then
194  approx_integer_multiple_dp = .false.
195  else if (approx_equal_integer_dp(x/y, eps)) then
196  approx_integer_multiple_dp = .true.
197  else
198  approx_integer_multiple_dp = .false.
199  end if
200 
201  end function approx_integer_multiple_dp
202 
203 !-------------------------------------------------------------------------------
204 
205 end module compare_float_m
206 !
Declarations of kind types for SICOPOLIS.
Comparison of single- or double-precision floating-point numbers.