SICOPOLIS V5-dev  Revision 1368
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-2018 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  module procedure approx_equal_sp
53  module procedure approx_equal_dp
54  end interface
55 
56  interface approx_equal_integer
57  module procedure approx_equal_integer_sp
58  module procedure approx_equal_integer_dp
59  end interface
60 
61  interface approx_integer_multiple
62  module procedure approx_integer_multiple_sp
63  module procedure approx_integer_multiple_dp
64  end interface
65 
66 contains
67 
68 !-------------------------------------------------------------------------------
69 !> Check whether single-precision x and y are approximately equal
70 !! (within a given eps limit).
71 !<------------------------------------------------------------------------------
72  function approx_equal_sp(x, y, eps)
73 
74  implicit none
75 
76  real(sp), intent(in) :: x, y
77  real(sp), intent(in) :: eps
78 
79  logical :: approx_equal_sp
80 
81  if ( abs(x-y) <= abs(x+y)*eps ) then
82  approx_equal_sp = .true.
83  else
84  approx_equal_sp = .false.
85  end if
86 
87  end function approx_equal_sp
88 
89 !-------------------------------------------------------------------------------
90 !> Check whether double-precision x and y are approximately equal
91 !! (within a given eps limit).
92 !<------------------------------------------------------------------------------
93  function approx_equal_dp(x, y, eps)
94 
95  implicit none
96 
97  real(dp), intent(in) :: x, y
98  real(dp), intent(in) :: eps
99 
100  logical :: approx_equal_dp
101 
102  if ( abs(x-y) <= abs(x+y)*eps ) then
103  approx_equal_dp = .true.
104  else
105  approx_equal_dp = .false.
106  end if
107 
108  end function approx_equal_dp
109 
110 !-------------------------------------------------------------------------------
111 !> Check whether single-precision x is approximately equal to an integer
112 !! (within a given eps limit).
113 !<------------------------------------------------------------------------------
114  function approx_equal_integer_sp(x, eps)
115 
116  implicit none
117 
118  real(sp), intent(in) :: x
119  real(sp), intent(in) :: eps
120 
121  logical :: approx_equal_integer_sp
122 
123  if (x == 0.0_sp) then
124  approx_equal_integer_sp = .true.
125  else if (approx_equal_sp(x, real(nint(x),sp), eps)) then
126  approx_equal_integer_sp = .true.
127  else
128  approx_equal_integer_sp = .false.
129  end if
130 
131  end function approx_equal_integer_sp
132 
133 !-------------------------------------------------------------------------------
134 !> Check whether double-precision x is approximately equal to an integer
135 !! (within a given eps limit).
136 !<------------------------------------------------------------------------------
137  function approx_equal_integer_dp(x, eps)
138 
139  implicit none
140 
141  real(dp), intent(in) :: x
142  real(dp), intent(in) :: eps
143 
144  logical :: approx_equal_integer_dp
145 
146  if (x == 0.0_dp) then
147  approx_equal_integer_dp = .true.
148  else if (approx_equal_dp(x, real(nint(x),dp), eps)) then
149  approx_equal_integer_dp = .true.
150  else
151  approx_equal_integer_dp = .false.
152  end if
153 
154  end function approx_equal_integer_dp
155 
156 !-------------------------------------------------------------------------------
157 !> Check whether single-precision x is approximately an integer multiple of
158 !! single-precision y (within a given eps limit).
159 !<------------------------------------------------------------------------------
160  function approx_integer_multiple_sp(x, y, eps)
161 
162  implicit none
163 
164  real(sp), intent(in) :: x, y
165  real(sp), intent(in) :: eps
166 
167  logical :: approx_integer_multiple_sp
168 
169  if (y == 0.0_sp) then
170  approx_integer_multiple_sp = .false.
171  else if (nint(x/y) == 0) then
172  approx_integer_multiple_sp = .false.
173  else if (approx_equal_integer_sp(x/y, eps)) then
174  approx_integer_multiple_sp = .true.
175  else
176  approx_integer_multiple_sp = .false.
177  end if
178 
179  end function approx_integer_multiple_sp
180 
181 !-------------------------------------------------------------------------------
182 !> Check whether double-precision x is approximately an integer multiple of
183 !! double-precision y (within a given eps limit).
184 !<------------------------------------------------------------------------------
185  function approx_integer_multiple_dp(x, y, eps)
186 
187  implicit none
188 
189  real(dp), intent(in) :: x, y
190  real(dp), intent(in) :: eps
191 
192  logical :: approx_integer_multiple_dp
193 
194  if (y == 0.0_dp) then
195  approx_integer_multiple_dp = .false.
196  else if (nint(x/y) == 0) then
197  approx_integer_multiple_dp = .false.
198  else if (approx_equal_integer_dp(x/y, eps)) then
199  approx_integer_multiple_dp = .true.
200  else
201  approx_integer_multiple_dp = .false.
202  end if
203 
204  end function approx_integer_multiple_dp
205 
206 !-------------------------------------------------------------------------------
207 
208 end module compare_float_m
209 !
Declarations of kind types for SICOPOLIS.
Comparison of single- or double-precision floating-point numbers.