tools_repro.F90

Go to the documentation of this file.

# 1 "/Users/miesch/JEDI/code/working_copy/internal/mpas-bundle/saber/src/saber/util/tools_repro.fypp"
# 1 "/Users/miesch/JEDI/code/working_copy/internal/mpas-bundle/saber/src/saber/util/../generics.fypp" 1
!----------------------------------------------------------------------
! Header: generics
!> Generic ranks, dimensions and types
! Author: Benjamin Menetrier
! Licensing: this code is distributed under the CeCILL-C license
! Copyright 2015-... UCAR, CERFACS, METEO-FRANCE and IRIT
!----------------------------------------------------------------------
 
# 57 "/Users/miesch/JEDI/code/working_copy/internal/mpas-bundle/saber/src/saber/util/../generics.fypp"
# 2 "/Users/miesch/JEDI/code/working_copy/internal/mpas-bundle/saber/src/saber/util/tools_repro.fypp" 2
# 1 "/Users/miesch/JEDI/code/working_copy/internal/mpas-bundle/saber/src/saber/util/../instrumentation.fypp" 1
# 1 "/Users/miesch/JEDI/code/working_copy/internal/mpas-bundle/saber/src/saber/util/../subr_list.fypp" 1
!----------------------------------------------------------------------
! Header: subr_list
!> Subroutines/functions list
! Author: Benjamin Menetrier
! Licensing: this code is distributed under the CeCILL-C license
! Copyright 2015-... UCAR, CERFACS, METEO-FRANCE and IRIT
!----------------------------------------------------------------------
 
# 926 "/Users/miesch/JEDI/code/working_copy/internal/mpas-bundle/saber/src/saber/util/../subr_list.fypp"
# 2 "/Users/miesch/JEDI/code/working_copy/internal/mpas-bundle/saber/src/saber/util/../instrumentation.fypp" 2
!----------------------------------------------------------------------
! Header: instrumentation
!> Instrumentation functions
! Author: Benjamin Menetrier
! Licensing: this code is distributed under the CeCILL-C license
! Copyright 2015-... UCAR, CERFACS, METEO-FRANCE and IRIT
!----------------------------------------------------------------------
 
# 112 "/Users/miesch/JEDI/code/working_copy/internal/mpas-bundle/saber/src/saber/util/../instrumentation.fypp"
# 3 "/Users/miesch/JEDI/code/working_copy/internal/mpas-bundle/saber/src/saber/util/tools_repro.fypp" 2
!----------------------------------------------------------------------
! Module: tools_repro
!> Reproducibility functions
! Author: Benjamin Menetrier
! Licensing: this code is distributed under the CeCILL-C license
! Copyright 2015-... UCAR, CERFACS, METEO-FRANCE and IRIT
!----------------------------------------------------------------------
module tools_repro
 
use tools_const, only: zero,one,pi
use tools_kinds, only: kind_int,kind_real
 
 
implicit none
 
logical :: repro = .true.        !< Reproducibility flag
real(kind_real) :: rth = 1.0e-12 !< Reproducibility threshold
 
interface eq
# 23 "/Users/miesch/JEDI/code/working_copy/internal/mpas-bundle/saber/src/saber/util/tools_repro.fypp"
     module procedure repro_eq_int
# 23 "/Users/miesch/JEDI/code/working_copy/internal/mpas-bundle/saber/src/saber/util/tools_repro.fypp"
     module procedure repro_eq_real
# 23 "/Users/miesch/JEDI/code/working_copy/internal/mpas-bundle/saber/src/saber/util/tools_repro.fypp"
     module procedure repro_eq_logical
# 25 "/Users/miesch/JEDI/code/working_copy/internal/mpas-bundle/saber/src/saber/util/tools_repro.fypp"
end interface
interface inf
# 28 "/Users/miesch/JEDI/code/working_copy/internal/mpas-bundle/saber/src/saber/util/tools_repro.fypp"
     module procedure repro_inf_int
# 28 "/Users/miesch/JEDI/code/working_copy/internal/mpas-bundle/saber/src/saber/util/tools_repro.fypp"
     module procedure repro_inf_real
# 30 "/Users/miesch/JEDI/code/working_copy/internal/mpas-bundle/saber/src/saber/util/tools_repro.fypp"
end interface
interface infeq
# 33 "/Users/miesch/JEDI/code/working_copy/internal/mpas-bundle/saber/src/saber/util/tools_repro.fypp"
     module procedure repro_infeq_int
# 33 "/Users/miesch/JEDI/code/working_copy/internal/mpas-bundle/saber/src/saber/util/tools_repro.fypp"
     module procedure repro_infeq_real
# 35 "/Users/miesch/JEDI/code/working_copy/internal/mpas-bundle/saber/src/saber/util/tools_repro.fypp"
end interface
interface sup
# 38 "/Users/miesch/JEDI/code/working_copy/internal/mpas-bundle/saber/src/saber/util/tools_repro.fypp"
     module procedure repro_sup_int
# 38 "/Users/miesch/JEDI/code/working_copy/internal/mpas-bundle/saber/src/saber/util/tools_repro.fypp"
     module procedure repro_sup_real
# 40 "/Users/miesch/JEDI/code/working_copy/internal/mpas-bundle/saber/src/saber/util/tools_repro.fypp"
end interface
interface supeq
# 43 "/Users/miesch/JEDI/code/working_copy/internal/mpas-bundle/saber/src/saber/util/tools_repro.fypp"
     module procedure repro_supeq_int
# 43 "/Users/miesch/JEDI/code/working_copy/internal/mpas-bundle/saber/src/saber/util/tools_repro.fypp"
     module procedure repro_supeq_real
# 45 "/Users/miesch/JEDI/code/working_copy/internal/mpas-bundle/saber/src/saber/util/tools_repro.fypp"
end interface
interface indist
   module procedure repro_indist
end interface
interface small
   module procedure repro_small
end interface
 
private
public :: repro,rth
public :: eq,inf,infeq,sup,supeq,indist,small
 
contains
 
# 60 "/Users/miesch/JEDI/code/working_copy/internal/mpas-bundle/saber/src/saber/util/tools_repro.fypp"
!----------------------------------------------------------------------
! Function: repro_eq_int
!> Equal test for int
!----------------------------------------------------------------------
function repro_eq_int(x,y) result(test)
 
implicit none
 
! Passed variables
integer(kind_int),intent(in) :: x !< First real
integer(kind_int),intent(in) :: y !< Second real
 
! Returned variable
logical :: test
 
! Set name
 
 
! Probe in
 
 
 test = (x==y) 
# 89 "/Users/miesch/JEDI/code/working_copy/internal/mpas-bundle/saber/src/saber/util/tools_repro.fypp"
 
 
! Probe out
 
 
end function repro_eq_int
# 60 "/Users/miesch/JEDI/code/working_copy/internal/mpas-bundle/saber/src/saber/util/tools_repro.fypp"
!----------------------------------------------------------------------
! Function: repro_eq_real
!> Equal test for real
!----------------------------------------------------------------------
function repro_eq_real(x,y) result(test)
 
implicit none
 
! Passed variables
real(kind_real),intent(in) :: x !< First real
real(kind_real),intent(in) :: y !< Second real
 
! Returned variable
logical :: test
 
! Set name
 
 
! Probe in
 
 
 
# 83 "/Users/miesch/JEDI/code/working_copy/internal/mpas-bundle/saber/src/saber/util/tools_repro.fypp"
   if (repro) then
      test = indist(x,y)
   else
      test = .not.(abs(x-y)>zero)
   end if
# 89 "/Users/miesch/JEDI/code/working_copy/internal/mpas-bundle/saber/src/saber/util/tools_repro.fypp"
 
 
! Probe out
 
 
end function repro_eq_real
# 60 "/Users/miesch/JEDI/code/working_copy/internal/mpas-bundle/saber/src/saber/util/tools_repro.fypp"
!----------------------------------------------------------------------
! Function: repro_eq_logical
!> Equal test for logical
!----------------------------------------------------------------------
function repro_eq_logical(x,y) result(test)
 
implicit none
 
! Passed variables
logical,intent(in) :: x !< First real
logical,intent(in) :: y !< Second real
 
! Returned variable
logical :: test
 
! Set name
 
 
! Probe in
 
 
 
# 89 "/Users/miesch/JEDI/code/working_copy/internal/mpas-bundle/saber/src/saber/util/tools_repro.fypp"
 test = (x.eqv.y) 
 
! Probe out
 
 
end function repro_eq_logical
# 96 "/Users/miesch/JEDI/code/working_copy/internal/mpas-bundle/saber/src/saber/util/tools_repro.fypp"
 
# 98 "/Users/miesch/JEDI/code/working_copy/internal/mpas-bundle/saber/src/saber/util/tools_repro.fypp"
!----------------------------------------------------------------------
! Function: repro_inf_int
!> Inferior test for int
!----------------------------------------------------------------------
function repro_inf_int(x,y) result(test)
 
implicit none
 
! Passed variables
integer(kind_int),intent(in) :: x !< First real
integer(kind_int),intent(in) :: y !< Second real
 
! Returned variable
logical :: test
 
! Set name
 
 
! Probe in
 
 
test = (x<y)
 
 
! Probe out
 
 
end function repro_inf_int
# 98 "/Users/miesch/JEDI/code/working_copy/internal/mpas-bundle/saber/src/saber/util/tools_repro.fypp"
!----------------------------------------------------------------------
! Function: repro_inf_real
!> Inferior test for real
!----------------------------------------------------------------------
function repro_inf_real(x,y) result(test)
 
implicit none
 
! Passed variables
real(kind_real),intent(in) :: x !< First real
real(kind_real),intent(in) :: y !< Second real
 
! Returned variable
logical :: test
 
! Set name
 
 
! Probe in
 
 
test = (x<y)
 if (repro) test = test.and.(.not.indist(x,y)) 
 
! Probe out
 
 
end function repro_inf_real
# 127 "/Users/miesch/JEDI/code/working_copy/internal/mpas-bundle/saber/src/saber/util/tools_repro.fypp"
 
# 129 "/Users/miesch/JEDI/code/working_copy/internal/mpas-bundle/saber/src/saber/util/tools_repro.fypp"
!----------------------------------------------------------------------
! Function: repro_infeq_int
!> Inferior or equal test for int
!----------------------------------------------------------------------
function repro_infeq_int(x,y) result(test)
 
implicit none
 
! Passed variables
integer(kind_int),intent(in) :: x !< First real
integer(kind_int),intent(in) :: y !< Second real
 
! Returned variable
logical :: test
 
! Set name
 
 
! Probe in
 
 
test = inf(x,y).or.eq(x,y)
 
! Probe out
 
 
end function repro_infeq_int
# 129 "/Users/miesch/JEDI/code/working_copy/internal/mpas-bundle/saber/src/saber/util/tools_repro.fypp"
!----------------------------------------------------------------------
! Function: repro_infeq_real
!> Inferior or equal test for real
!----------------------------------------------------------------------
function repro_infeq_real(x,y) result(test)
 
implicit none
 
! Passed variables
real(kind_real),intent(in) :: x !< First real
real(kind_real),intent(in) :: y !< Second real
 
! Returned variable
logical :: test
 
! Set name
 
 
! Probe in
 
 
test = inf(x,y).or.eq(x,y)
 
! Probe out
 
 
end function repro_infeq_real
# 157 "/Users/miesch/JEDI/code/working_copy/internal/mpas-bundle/saber/src/saber/util/tools_repro.fypp"
 
# 159 "/Users/miesch/JEDI/code/working_copy/internal/mpas-bundle/saber/src/saber/util/tools_repro.fypp"
!----------------------------------------------------------------------
! Function: repro_sup_int
!> Superior test for int
!----------------------------------------------------------------------
function repro_sup_int(x,y) result(test)
 
implicit none
 
! Passed variables
integer(kind_int),intent(in) :: x !< First real
integer(kind_int),intent(in) :: y !< Second real
 
! Returned variable
logical :: test
 
! Set name
 
 
! Probe in
 
 
test = (x>y)
 
 
! Probe out
 
 
end function repro_sup_int
# 159 "/Users/miesch/JEDI/code/working_copy/internal/mpas-bundle/saber/src/saber/util/tools_repro.fypp"
!----------------------------------------------------------------------
! Function: repro_sup_real
!> Superior test for real
!----------------------------------------------------------------------
function repro_sup_real(x,y) result(test)
 
implicit none
 
! Passed variables
real(kind_real),intent(in) :: x !< First real
real(kind_real),intent(in) :: y !< Second real
 
! Returned variable
logical :: test
 
! Set name
 
 
! Probe in
 
 
test = (x>y)
 if (repro) test = test.and.(.not.indist(x,y)) 
 
! Probe out
 
 
end function repro_sup_real
# 188 "/Users/miesch/JEDI/code/working_copy/internal/mpas-bundle/saber/src/saber/util/tools_repro.fypp"
 
# 190 "/Users/miesch/JEDI/code/working_copy/internal/mpas-bundle/saber/src/saber/util/tools_repro.fypp"
!----------------------------------------------------------------------
! Function: repro_supeq_int
!> Superior or equal test for int
!----------------------------------------------------------------------
function repro_supeq_int(x,y) result(test)
 
implicit none
 
! Passed variables
integer(kind_int),intent(in) :: x !< First real
integer(kind_int),intent(in) :: y !< Second real
 
! Returned variable
logical :: test
 
! Set name
 
 
! Probe in
 
 
test = sup(x,y).or.eq(x,y)
 
! Probe out
 
 
end function repro_supeq_int
# 190 "/Users/miesch/JEDI/code/working_copy/internal/mpas-bundle/saber/src/saber/util/tools_repro.fypp"
!----------------------------------------------------------------------
! Function: repro_supeq_real
!> Superior or equal test for real
!----------------------------------------------------------------------
function repro_supeq_real(x,y) result(test)
 
implicit none
 
! Passed variables
real(kind_real),intent(in) :: x !< First real
real(kind_real),intent(in) :: y !< Second real
 
! Returned variable
logical :: test
 
! Set name
 
 
! Probe in
 
 
test = sup(x,y).or.eq(x,y)
 
! Probe out
 
 
end function repro_supeq_real
# 218 "/Users/miesch/JEDI/code/working_copy/internal/mpas-bundle/saber/src/saber/util/tools_repro.fypp"
 
!----------------------------------------------------------------------
! Function: repro_indist
!> Indistiguishability test
!----------------------------------------------------------------------
function repro_indist(x,y) result(test)
 
implicit none
 
! Passed variables
real(kind_real),intent(in) :: x !< First real
real(kind_real),intent(in) :: y !< Second real
 
! Returned variable
logical :: test
 
! Set name
 
 
! Probe in
 
 
test = .false.
if (repro) then
      if ((abs(x)>zero).or.(abs(y)>zero)) then
      test = abs(x-y)<rth*(abs(x+y))
   else
      test = .true.
   end if
end if
 
! Probe out
 
 
end function repro_indist
 
!----------------------------------------------------------------------
! Function: repro_small
!> Small value test
!----------------------------------------------------------------------
function repro_small(x,y) result(test)
 
implicit none
 
! Passed variables
real(kind_real),intent(in) :: x !< First real
real(kind_real),intent(in) :: y !< Second real
 
! Returned variable
logical :: test
 
! Set name
 
 
! Probe in
 
 
test = .false.
if (repro) test = abs(x)<rth*abs(y)
 
! Probe out
 
 
end function repro_small
 
end module tools_repro