Skip to content

Commit

Permalink
f_is_default for all comparisons
Browse files Browse the repository at this point in the history
  • Loading branch information
@ChrisZYJ
ChrisZYJ committed Jun 28, 2024
1 parent c9d0732 commit f30a70c
Show file tree
Hide file tree
Showing 23 changed files with 219 additions and 168 deletions.
2 changes: 2 additions & 0 deletions src/common/m_checker_common.fpp
View file
Original file line number Diff line number Diff line change
Expand Up @@ -10,6 +10,8 @@ module m_checker_common

use m_mpi_proxy !< Message passing interface (MPI) module proxy

use m_helper_basic !< Functions to compare floating point numbers

use m_helper

implicit none
Expand Down
57 changes: 1 addition & 56 deletions src/common/m_helper.fpp
View file
Original file line number Diff line number Diff line change
Expand Up @@ -36,10 +36,7 @@ module m_helper
f_create_bbox, &
s_print_2D_array, &
f_xor, &
f_logical_to_int, &
f_approx_equal, &
f_is_default, &
f_all_default
f_logical_to_int

contains

Expand Down Expand Up @@ -535,56 +532,4 @@ contains
end if
end function f_logical_to_int

!> This procedure checks if two floating point numbers of kind(0d0) are within tolerance.
!! @param a First number.
!! @param b Second number.
!! @param tol_input Relative error (default = 1d-6).
!! @return Result of the comparison.
logical function f_approx_equal(a, b, tol_input) result(res)
! Reference: https://floating-point-gui.de/errors/comparison/

real(kind(0d0)), intent(in) :: a, b
real(kind(0d0)), optional, intent(in) :: tol_input
real(kind(0d0)) :: tol

if (present(tol_input)) then
if (tol_input <= 0d0) then
call s_mpi_abort('tol_input must be positive. Exiting ...')
end if
tol = tol_input
else
tol = 1d-6
end if

if (a == b) then
res = .true.
else if (a == 0d0 .or. b == 0d0 .or. (abs(a) + abs(b) < tiny(a))) then
res = (abs(a - b) < (tol*tiny(a)))
else
res = (abs(a - b)/min(abs(a) + abs(b), huge(a)) < tol)
end if
end function f_approx_equal

!> Checks if a real(kind(0d0)) variable is of default value.
!! @param var Variable to check.
logical function f_is_default(var) result(res)
real(kind(0d0)), intent(in) :: var

res = f_approx_equal(var, dflt_real)
end function f_is_default

!> Checks if ALL elements of a real(kind(0d0)) array are of default value.
!! @param var_array Array to check.
logical function f_all_default(var_array) result(res)
real(kind(0d0)), intent(in) :: var_array(:)
logical :: res_array(size(var_array))
integer :: i

do i = 1, size(var_array)
res_array(i) = f_is_default(var_array(i))
end do

res = all(res_array)
end function f_all_default

end module m_helper
74 changes: 74 additions & 0 deletions src/common/m_helper_basic.f90
View file
Original file line number Diff line number Diff line change
@@ -0,0 +1,74 @@
!>
!! @file m_helper_basic.f90
!! @brief Contains module m_helper_basic

module m_helper_basic

! Dependencies =============================================================

use m_derived_types !< Definitions of the derived types
! ==========================================================================

implicit none

private;
public :: f_approx_equal, &
f_is_default, &
f_all_default

contains

!> This procedure checks if two floating point numbers of kind(0d0) are within tolerance.
!! @param a First number.
!! @param b Second number.
!! @param tol_input Relative error (default = 1d-6).
!! @return Result of the comparison.
logical function f_approx_equal(a, b, tol_input) result(res)
! Reference: https://floating-point-gui.de/errors/comparison/

real(kind(0d0)), intent(in) :: a, b
real(kind(0d0)), optional, intent(in) :: tol_input
real(kind(0d0)) :: tol

if (present(tol_input)) then
if (tol_input <= 0d0) then
call exit(1)
! Not using s_mpi_abort to prevent circular dependency
end if
tol = tol_input
else
tol = 1d-6
end if

if (a == b) then
res = .true.
else if (a == 0d0 .or. b == 0d0 .or. (abs(a) + abs(b) < tiny(a))) then
res = (abs(a - b) < (tol*tiny(a)))
else
res = (abs(a - b)/min(abs(a) + abs(b), huge(a)) < tol)
end if
end function f_approx_equal

!> Checks if a real(kind(0d0)) variable is of default value.
!! @param var Variable to check.
logical function f_is_default(var) result(res)
real(kind(0d0)), intent(in) :: var

res = f_approx_equal(var, dflt_real)
end function f_is_default

!> Checks if ALL elements of a real(kind(0d0)) array are of default value.
!! @param var_array Array to check.
logical function f_all_default(var_array) result(res)
real(kind(0d0)), intent(in) :: var_array(:)
logical :: res_array(size(var_array))
integer :: i

do i = 1, size(var_array)
res_array(i) = f_is_default(var_array(i))
end do

res = all(res_array)
end function f_all_default

end module m_helper_basic
6 changes: 4 additions & 2 deletions src/common/m_variables_conversion.fpp
View file
Original file line number Diff line number Diff line change
Expand Up @@ -19,6 +19,8 @@ module m_variables_conversion

use m_mpi_proxy !< Message passing interface (MPI) module proxy

use m_helper_basic !< Functions to compare floating point numbers

use m_helper
! ==========================================================================

Expand Down Expand Up @@ -1005,7 +1007,7 @@ contains
qK_prim_vf(i)%sf(j, k, l) = qK_cons_vf(i)%sf(j, k, l)
end do

if (sigma /= dflt_real) then
if (.not. f_is_default(sigma)) then
qK_prim_vf(c_idx)%sf(j, k, l) = qK_cons_vf(c_idx)%sf(j, k, l)
end if

Expand Down Expand Up @@ -1159,7 +1161,7 @@ contains
end do
end if

if (sigma /= dflt_real) then
if (.not. f_is_default(sigma)) then
q_cons_vf(c_idx)%sf(j, k, l) = q_prim_vf(c_idx)%sf(j, k, l)
end if

Expand Down
2 changes: 2 additions & 0 deletions src/post_process/m_checker.f90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -9,6 +9,8 @@ module m_checker

use m_mpi_proxy !< Message passing interface (MPI) module proxy

use m_helper_basic !< Functions to compare floating point numbers

use m_helper

implicit none
Expand Down
6 changes: 4 additions & 2 deletions src/post_process/m_global_parameters.fpp
View file
Original file line number Diff line number Diff line change
Expand Up @@ -13,6 +13,8 @@ module m_global_parameters
#endif

use m_derived_types !< Definitions of the derived types

use m_helper_basic !< Functions to compare floating point numbers
! ==========================================================================

implicit none
Expand Down Expand Up @@ -489,7 +491,7 @@ contains
sys_size = stress_idx%end
end if

if (sigma /= dflt_real) then
if (.not. f_is_default(sigma)) then
c_idx = sys_size + 1
sys_size = c_idx
end if
Expand All @@ -515,7 +517,7 @@ contains
sys_size = internalEnergies_idx%end
alf_idx = 1 ! dummy, cannot actually have a void fraction

if (sigma /= dflt_real) then
if (.not. f_is_default(sigma)) then
c_idx = sys_size + 1
sys_size = c_idx
end if
Expand Down
9 changes: 6 additions & 3 deletions src/pre_process/m_assign_variables.f90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -9,6 +9,9 @@ module m_assign_variables
use m_global_parameters ! Global parameters for the code

use m_variables_conversion ! Subroutines to change the state variables from

use m_helper_basic !< Functions to compare floating point numbers

! one form to another
! ==========================================================================

Expand Down Expand Up @@ -577,17 +580,17 @@ subroutine s_assign_patch_species_primitive_variables(patch_id, j, k, l, &

if (bubbles .and. (.not. polytropic) .and. (.not. qbmm)) then
do i = 1, nb
if (q_prim_vf(bub_idx%ps(i))%sf(j, k, l) == dflt_real) then
if (f_is_default(q_prim_vf(bub_idx%ps(i))%sf(j, k, l))) then
q_prim_vf(bub_idx%ps(i))%sf(j, k, l) = pb0(i)
! print *, 'setting to pb0'
end if
if (q_prim_vf(bub_idx%ms(i))%sf(j, k, l) == dflt_real) then
if (f_is_default(q_prim_vf(bub_idx%ms(i))%sf(j, k, l))) then
q_prim_vf(bub_idx%ms(i))%sf(j, k, l) = mass_v0(i)
end if
end do
end if

if (sigma /= dflt_real) then
if (.not. f_is_default(sigma)) then
q_prim_vf(c_idx)%sf(j, k, l) = eta*patch_icpp(patch_id)%cf_val + &
(1d0 - eta)*patch_icpp(smooth_patch_id)%cf_val
end if
Expand Down
58 changes: 30 additions & 28 deletions src/pre_process/m_check_ib_patches.fpp
View file
Original file line number Diff line number Diff line change
Expand Up @@ -18,6 +18,8 @@ module m_check_ib_patches

use m_compile_specific

use m_helper_basic !< Functions to compare floating point numbers

use m_helper
! ==========================================================================

Expand Down Expand Up @@ -82,9 +84,9 @@ contains
! Constraints on the geometric parameters of the circle patch
if (n == 0 .or. p > 0 .or. patch_ib(patch_id)%radius <= 0d0 &
.or. &
patch_ib(patch_id)%x_centroid == dflt_real &
f_is_default(patch_ib(patch_id)%x_centroid) &
.or. &
patch_ib(patch_id)%y_centroid == dflt_real) then
f_is_default(patch_ib(patch_id)%y_centroid)) then

call s_mpi_abort('Inconsistency(ies) detected in '// &
'geometric parameters of circle '// &
Expand All @@ -107,8 +109,8 @@ contains
! Constraints on the geometric parameters of the airfoil patch
if (n == 0 .or. p > 0 .or. patch_ib(patch_id)%c <= 0d0 &
.or. patch_ib(patch_id)%p <= 0d0 .or. patch_ib(patch_id)%t <= 0d0 &
.or. patch_ib(patch_id)%m <= 0d0 .or. patch_ib(patch_id)%x_centroid == dflt_real &
.or. patch_ib(patch_id)%y_centroid == dflt_real) then
.or. patch_ib(patch_id)%m <= 0d0 .or. f_is_default(patch_ib(patch_id)%x_centroid) &
.or. f_is_default(patch_ib(patch_id)%y_centroid)) then

call s_mpi_abort('Inconsistency(ies) detected in '// &
'geometric parameters of airfoil '// &
Expand All @@ -131,9 +133,9 @@ contains
! Constraints on the geometric parameters of the 3d airfoil patch
if (n == 0 .or. p == 0 .or. patch_ib(patch_id)%c <= 0d0 &
.or. patch_ib(patch_id)%p <= 0d0 .or. patch_ib(patch_id)%t <= 0d0 &
.or. patch_ib(patch_id)%m <= 0d0 .or. patch_ib(patch_id)%x_centroid == dflt_real &
.or. patch_ib(patch_id)%y_centroid == dflt_real .or. patch_ib(patch_id)%z_centroid == dflt_real &
.or. patch_ib(patch_id)%length_z == dflt_real) then
.or. patch_ib(patch_id)%m <= 0d0 .or. f_is_default(patch_ib(patch_id)%x_centroid) &
.or. f_is_default(patch_ib(patch_id)%y_centroid) .or. f_is_default(patch_ib(patch_id)%z_centroid) &
.or. f_is_default(patch_ib(patch_id)%length_z)) then

call s_mpi_abort('Inconsistency(ies) detected in '// &
'geometric parameters of airfoil '// &
Expand All @@ -156,9 +158,9 @@ contains
! Constraints on the geometric parameters of the rectangle patch
if (n == 0 .or. p > 0 &
.or. &
patch_ib(patch_id)%x_centroid == dflt_real &
f_is_default(patch_ib(patch_id)%x_centroid) &
.or. &
patch_ib(patch_id)%y_centroid == dflt_real &
f_is_default(patch_ib(patch_id)%y_centroid) &
.or. &
patch_ib(patch_id)%length_x <= 0d0 &
.or. &
Expand All @@ -185,11 +187,11 @@ contains
! Constraints on the geometric parameters of the sphere patch
if (n == 0 .or. p == 0 &
.or. &
patch_ib(patch_id)%x_centroid == dflt_real &
f_is_default(patch_ib(patch_id)%x_centroid) &
.or. &
patch_ib(patch_id)%y_centroid == dflt_real &
f_is_default(patch_ib(patch_id)%y_centroid) &
.or. &
patch_ib(patch_id)%z_centroid == dflt_real &
f_is_default(patch_ib(patch_id)%z_centroid) &
.or. &
patch_ib(patch_id)%radius <= 0d0) then

Expand All @@ -214,27 +216,27 @@ contains
! Constraints on the geometric parameters of the cylinder patch
if (p == 0 &
.or. &
patch_ib(patch_id)%x_centroid == dflt_real &
f_is_default(patch_ib(patch_id)%x_centroid) &
.or. &
patch_ib(patch_id)%y_centroid == dflt_real &
f_is_default(patch_ib(patch_id)%y_centroid) &
.or. &
patch_ib(patch_id)%z_centroid == dflt_real &
f_is_default(patch_ib(patch_id)%z_centroid) &
.or. &
(patch_ib(patch_id)%length_x <= 0d0 .and. &
patch_ib(patch_id)%length_y <= 0d0 .and. &
patch_ib(patch_id)%length_z <= 0d0) &
.or. &
(patch_ib(patch_id)%length_x > 0d0 .and. &
(patch_ib(patch_id)%length_y /= dflt_real .or. &
patch_ib(patch_id)%length_z /= dflt_real)) &
((.not. f_is_default(patch_ib(patch_id)%length_y)) .or. &
(.not. f_is_default(patch_ib(patch_id)%length_z)))) &
.or. &
(patch_ib(patch_id)%length_y > 0d0 .and. &
(patch_ib(patch_id)%length_x /= dflt_real .or. &
patch_ib(patch_id)%length_z /= dflt_real)) &
((.not. f_is_default(patch_ib(patch_id)%length_x)) .or. &
(.not. f_is_default(patch_ib(patch_id)%length_z)))) &
.or. &
(patch_ib(patch_id)%length_z > 0d0 .and. &
(patch_ib(patch_id)%length_x /= dflt_real .or. &
patch_ib(patch_id)%length_y /= dflt_real)) &
((.not. f_is_default(patch_ib(patch_id)%length_x)) .or. &
(.not. f_is_default(patch_ib(patch_id)%length_y)))) &
.or. &
patch_ib(patch_id)%radius <= 0d0) then

Expand All @@ -256,19 +258,19 @@ contains
call s_int_to_str(patch_id, iStr)

! Constraints on the geometric parameters of the inactive patch
if (patch_ib(patch_id)%x_centroid /= dflt_real &
if ((.not. f_is_default(patch_ib(patch_id)%x_centroid)) &
.or. &
patch_ib(patch_id)%y_centroid /= dflt_real &
(.not. f_is_default(patch_ib(patch_id)%y_centroid)) &
.or. &
patch_ib(patch_id)%z_centroid /= dflt_real &
(.not. f_is_default(patch_ib(patch_id)%z_centroid)) &
.or. &
patch_ib(patch_id)%length_x /= dflt_real &
(.not. f_is_default(patch_ib(patch_id)%length_x)) &
.or. &
patch_ib(patch_id)%length_y /= dflt_real &
(.not. f_is_default(patch_ib(patch_id)%length_y)) &
.or. &
patch_ib(patch_id)%length_z /= dflt_real &
(.not. f_is_default(patch_ib(patch_id)%length_z)) &
.or. &
patch_ib(patch_id)%radius /= dflt_real) then
(.not. f_is_default(patch_ib(patch_id)%radius))) then

call s_mpi_abort('Inconsistency(ies) detected in '// &
'geometric parameters of inactive '// &
Expand Down
2 changes: 2 additions & 0 deletions src/pre_process/m_check_patches.fpp
View file
Original file line number Diff line number Diff line change
Expand Up @@ -18,6 +18,8 @@ module m_check_patches

use m_compile_specific

use m_helper_basic !< Functions to compare floating point numbers

use m_helper
! ==========================================================================

Expand Down
Loading

0 comments on commit f30a70c

Please sign in to comment.