constants_and_conversions.F90

Go to the documentation of this file.

!> @file
!! Contains a single module, @ref constants_and_conversions, which contains useful
!! physical constants and basic conversion utilities
 
!> This module contains physical constants and convenience functions aimed at
!! performing unit conversions. The functions included in this module perform
!! conversions between various temperature and distance units.
module constants_and_conversions
 
  use iso_c_binding, only : c_short, c_int, c_long, c_float, c_double, c_bool, &
                            c_long_long
  implicit none
 
  !
  integer (c_int), parameter :: datatype_int     = 0
  integer (c_int), parameter :: datatype_float   = 1
  integer (c_int), parameter :: datatype_real    = 1
  integer (c_int), parameter :: datatype_double  = 2
  integer (c_int), parameter :: datatype_short   = 3
  integer (c_int), parameter :: datatype_na      = -9999
 
  ! [ common mathematical constants ]
  public :: pi, twopi, halfpi
  real (c_double), parameter    :: pi = 4.0_c_double*atan(1.0_c_double)
  real (c_double), parameter    :: twopi = pi * 2.0_c_double
  real (c_double), parameter    :: halfpi = pi / 2.0_c_double
 
  ! [ trig conversion factors ]
  public :: degrees_to_radians, radians_to_degrees
  real (c_double), parameter    :: degrees_to_radians = twopi / 360.0_c_double
  real (c_double), parameter    :: radians_to_degrees = 360.0_c_double / twopi
 
  ! [ common 'magic' numbers and logicals ]
  public :: true, false
  public :: rbigval, ibigval, dbigval, itinyval, rtinyval, dtinyval
  public :: rfreezing, dfreezing, near_zero
  public :: rzero
  logical (c_bool), parameter   :: true = .true._c_bool
  logical (c_bool), parameter   :: false = .false._c_bool
 
  real (c_float), parameter     :: near_zero = epsilon(1.0_c_float)
  real (c_float), parameter     :: rbigval = huge(0.0_c_float)
  real (c_double), parameter    :: dbigval = huge(0.0_c_double)
  integer(c_int), parameter     :: ibigval = huge(0_c_int)
  real (c_float), parameter     :: rtinyval = -(huge(0.0_c_float) - 1.0)
  real (c_double), parameter    :: dtinyval = -(huge(0.0_c_double) - 1.0)
  real (c_float), parameter     :: ftinyval = -(huge(0.0_c_float) - 1.0)
  integer(c_int), parameter     :: itinyval = -(huge(0_c_int) - 1)
  real (c_float), parameter     :: rfreezing = 32.0_c_float
  real (c_float), parameter     :: ffreezing = 32.0_c_float
  real (c_double), parameter    :: dfreezing = 32.0_c_double
  integer (c_int), parameter    :: izero = 0_c_int
  real (c_float), parameter     :: fzero = 0.0_c_float
  real (c_float), parameter     :: rzero = 0.0_c_float
  real (c_double), parameter    :: dzero = 0.0_c_double
 
    ! [ evil global variables ]
  character (len=1)            :: os_native_path_delimiter
  integer (c_int)              :: random_start = 0
 
  ! [ select conversion factors ]
  real (c_double), parameter, public :: c_per_f    = 5.0_c_double / 9.0_c_double
  real (c_double), parameter, public :: f_per_c    = 9.0_c_double / 5.0_c_double
  real (c_double), parameter, public :: m_per_foot = 0.3048_c_double
  real (c_double), parameter, public :: mm_per_in  = 25.4_c_double
  real (c_double), parameter, public :: freezing_point_of_water_kelvin = 273.15_c_double
  real (c_double), parameter, public :: freezing_point_of_water_fahrenheit = 32.0_c_double
 
  public :: output_prefix_name, output_directory_name, data_directory_name,     &
            lookup_table_directory_name
  character (len=:), allocatable    :: output_directory_name
  character (len=:), allocatable    :: output_prefix_name
  character (len=:), allocatable    :: data_directory_name
  character (len=:), allocatable    :: lookup_table_directory_name
 
  type bounds_t
    character (len=:), allocatable  :: sproj4_string
    integer (c_int)            :: inumcols
    integer (c_int)            :: inumrows
    real (c_double)            :: fx_ll, fy_ll
    real (c_double)            :: fx_ur, fy_ur
    real (c_double)            :: fgridcellsize
  end type bounds_t
 
  type (bounds_t), public :: bnds
 
  public :: operator(.approxequal.)
  interface operator(.approxequal.)
    module procedure approx_equal_float_float
    module procedure approx_equal_double_double
    module procedure approx_equal_float_double
  end interface operator(.approxequal.)
 
 
 
  !> establish generic interfaces to single and double precision functions
  public :: c_to_f
  interface c_to_f
    module procedure ctof_sgl_fn
    module procedure ctof_dbl_fn
  end interface c_to_f
 
  public f_to_c
  interface f_to_c
    module procedure ftoc_sgl_fn
    module procedure ftoc_dbl_fn
  end interface f_to_c
 
  public :: f_to_k
  interface f_to_k
    module procedure ftok_sgl_fn
    module procedure ftok_dbl_fn
  end interface f_to_k
 
  public :: c_to_k
  interface c_to_k
    module procedure ctok_sgl_fn
    module procedure ctok_dbl_fn
  end interface c_to_k
 
  public :: deg_to_rad
  interface deg_to_rad
    module procedure deg_to_rad_sgl_fn
    module procedure deg_to_rad_dbl_fn
  end interface deg_to_rad
 
  public :: rad_to_deg
  interface rad_to_deg
    module procedure rad_to_deg_sgl_fn
    module procedure rad_to_deg_dbl_fn
  end interface rad_to_deg
 
  public :: asfloat
  interface asfloat
    module procedure char2real
    module procedure short2real
    module procedure int2real
    module procedure dbl2real
    module procedure bool2real
  end interface asfloat
 
  public :: asdouble
  interface asdouble
    module procedure char2dbl
    module procedure short2dbl
    module procedure int2dbl
    module procedure real2dbl
    module procedure bool2dbl
  end interface asdouble
 
  public asint
  interface asint
    module procedure short2int
    module procedure char2int
    module procedure real2int
    module procedure dbl2int
    module procedure bool2int
  end interface asint
 
  public aslogical
  interface aslogical
    module procedure short2logical
    module procedure int2logical
    module procedure real2logical
    module procedure dbl2logical
    module procedure char2logical
  end interface aslogical
 
  public :: mm_to_in
  interface mm_to_in
    module procedure mm_to_inches_sgl_fn
    module procedure mm_to_inches_dbl_fn
  end interface mm_to_in
 
  public :: in_to_mm
  interface in_to_mm
    module procedure inches_to_mm_sgl_fn
    module procedure inches_to_mm_dbl_fn
  end interface in_to_mm
 
  public :: clip
  interface clip
    module procedure enforce_bounds_int_fn
    module procedure enforce_bounds_sgl_fn
    module procedure enforce_bounds_dbl_fn
  end interface clip
 
  public :: char_ptr_to_fortran_string
  public :: c_to_fortran_string
  public :: fortran_to_c_string
  public :: is_numeric
 
  real (c_float), parameter  :: tolerance_float = 1.0e-6_c_float
  real (c_double), parameter :: tolerance_double = 1.0e-9_c_double
 
contains
 
  function fix_pathname( input_pathname )    result( output_pathname )
 
    character (len=*), intent(in)            :: input_pathname
    character (len=len_trim(input_pathname)) :: output_pathname
 
    ! [ LOCALS ]
    integer (c_int) :: indx, jndx
 
    do indx=1,len_trim(input_pathname)
 
      jndx = min( indx+1, len_trim(input_pathname) )
      ! allow for escaping of spaces in pathnames
      if (     ( (input_pathname(indx:indx) == '/')                            &
                .or. (input_pathname(indx:indx) == '\') )                      &
          .and. (input_pathname(jndx:jndx) /= ' ' ) ) then
 
        output_pathname(indx:indx) = os_native_path_delimiter
 
      else
 
        output_pathname(indx:indx) = input_pathname(indx:indx)
 
      endif
 
    enddo
 
  end function fix_pathname
 
 
  elemental function approx_equal_float_float(fValue1, fValue2)  result(lBool)
 
    real (c_float), intent(in)    :: fvalue1
    real (c_float), intent(in)    :: fvalue2
    logical (c_bool)              :: lbool
 
    if ( abs( fvalue1 - fvalue2 ) < tolerance_float ) then
      lbool = true
    else
      lbool = false
    endif
 
  end function approx_equal_float_float
 
 
 
 
  elemental function approx_equal_float_double(fValue1, fValue2)  result(lBool)
 
    real (c_float), intent(in)    :: fvalue1
    real (c_double), intent(in)    :: fvalue2
    logical (c_bool)              :: lbool
 
    if ( abs( fvalue1 - real(fvalue2, c_float) ) < tolerance_float ) then
      lbool = true
    else
      lbool = false
    endif
 
  end function approx_equal_float_double
 
 
 
 
 
  elemental function approx_equal_double_double(fValue1, fValue2)  result(lBool)
 
    real (c_double), intent(in)    :: fvalue1
    real (c_double), intent(in)    :: fvalue2
    logical (c_bool)               :: lbool
 
    if ( abs( fvalue1 - fvalue2 ) < tolerance_double ) then
      lbool = true
    else
      lbool = false
    endif
 
  end function approx_equal_double_double
 
!--------------------------------------------------------------------------
 
  !> Determine if string contains numeric values.
  !! @param[in]  degrees     String value.
  !! @retval     is_numeric  True if any numeric values are present in the string.
 
  impure elemental function is_numeric( value )
 
    character (len=*), intent(in)    :: value
    logical (c_bool)            :: is_numeric
 
    ! [ LOCALS ]
    character (len=256) :: sbuf
 
    sbuf = keepnumeric( value )
 
    if ( len_trim( sbuf ) == 0 ) then
      is_numeric = false
    else
      is_numeric = true
    endif
 
  end function is_numeric
 
!--------------------------------------------------------------------------
 
  !> Convert degrees to radians.
  !! @param[in]  degrees   Angle in degrees.
  !! @retval     radians  Angle in radians.
 
  elemental function deg_to_rad_sgl_fn( degrees )    result( radians )
 
    real (c_float), intent(in)    :: degrees
    real (c_float)                :: radians
 
    radians = real(degrees * degrees_to_radians, c_float)
 
  end function deg_to_rad_sgl_fn
 
 
!--------------------------------------------------------------------------------------------------
 
  !> Convert degrees to radians.
  !! @param[in]  degrees   Angle in degrees.
  !! @retval     radians   Angle in radians.
 
  elemental function deg_to_rad_dbl_fn(degrees)    result(radians)
 
    real (c_double), intent(in)    :: degrees
    real (c_double)                :: radians
 
    radians = degrees * degrees_to_radians
 
  end function deg_to_rad_dbl_fn
 
 
!--------------------------------------------------------------------------------------------------
 
  !> Convert radians to degrees.
  !! @param[in]  radians   Angle in radians.
  !! @retval     degrees   Angle in degrees.
 
  elemental function rad_to_deg_sgl_fn(radians)    result(degrees)
 
    real (c_float), intent(in)    :: radians
    real (c_float)                :: degrees
 
    degrees = real(radians * radians_to_degrees, c_float)
 
  end function rad_to_deg_sgl_fn
 
!--------------------------------------------------------------------------------------------------
 
  !> Convert radians to degrees.
  !! @param[in]  radians   Angle in radians.
  !! @retval     degrees   Angle in degrees.
 
  elemental function rad_to_deg_dbl_fn(radians)    result(degrees)
 
    real (c_double), intent(in)    :: radians
    real (c_double)                :: degrees
 
    degrees = radians * radians_to_degrees
 
  end function rad_to_deg_dbl_fn
 
 
!--------------------------------------------------------------------------------------------------
 
  !> Convert degrees Fahrenheit to degrees Celsius.
  !! @param[in]  degrees_F   Temperature in degrees Fahrenheit.
  !! @retval     degrees_C   Temperature in degrees Celcius.
 
  elemental function ftoc_sgl_fn(degrees_F)   result(degrees_C)
 
    real (c_float),intent(in) :: degrees_f
    real (c_float) :: degrees_c
 
    degrees_c = real((degrees_f - rfreezing) * c_per_f, c_float)
 
  end function ftoc_sgl_fn
 
 
!--------------------------------------------------------------------------------------------------
 
  !> Convert degrees Fahrenheit to degrees Celsius.
  !! @param[in] degrees_F Temperature in degrees Fahrenheit.
  !! @retval degrees_C Temperature in degrees Celcius.
 
  elemental function ftoc_dbl_fn( degrees_F )   result( degrees_C )
 
    real (c_double),intent(in) :: degrees_f
    real (c_double) :: degrees_c
 
    degrees_c = ( degrees_f - dfreezing ) * c_per_f
 
  end function ftoc_dbl_fn
 
 
!--------------------------------------------------------------------------------------------------
 
  !> Convert degrees Celsius to degrees Fahrenheit.
  !! @param[in] degrees_C Temperature in degrees Celsius.
  !! @retval degrees_F Temperature in degrees Fahrenheit.
 
  elemental function ctof_sgl_fn( degrees_C )   result( degrees_F )
 
    real (c_float),intent(in) :: degrees_c
    real (c_float) :: degrees_f
 
    degrees_f = real(degrees_c * f_per_c + dfreezing, c_float)
 
  end function ctof_sgl_fn
 
 
!--------------------------------------------------------------------------------------------------
 
  !> Convert degrees Celsius to degrees Fahrenheit.
  !! @param[in] degrees_C Temperature in degrees Celsius.
  !! @retval degrees_F Temperature in degree
 
  elemental function ctof_dbl_fn( degrees_C )   result( degrees_F )
 
    real (c_double),intent(in) :: degrees_c
    real (c_double) :: degrees_f
 
    degrees_f = degrees_c * f_per_c + dfreezing
 
  end function ctof_dbl_fn
 
 
!--------------------------------------------------------------------------------------------------
 
  !> Convert degrees Fahrenheit to Kelvins.
  !! @param[in] degrees_F Temperature in degrees Fahrenheit.
  !! @retval degrees_K Temperature in Kelvins.
 
  elemental function ftok_sgl_fn( degrees_F )    result( degrees_K )
 
    real (c_float),intent(in) :: degrees_f
    real (c_float) :: degrees_k
 
    degrees_k = real((degrees_f - dfreezing) * c_per_f + 273.15_c_double, c_float)
 
  end function ftok_sgl_fn
 
 
!--------------------------------------------------------------------------------------------------
 
  !> Convert degrees Fahrenheit to Kelvins.
  !! @param[in] degrees_F Temperature in degrees Fahrenheit.
  !! @retval degrees_K Temperature in Kelvins.
 
  elemental function ftok_dbl_fn( degrees_F )    result( degrees_K )
 
    real (c_double),intent(in) :: degrees_f
    real (c_double) :: degrees_k
 
    degrees_k = (degrees_f - dfreezing) * c_per_f + 273.15_c_double
 
  end function ftok_dbl_fn
 
 
!--------------------------------------------------------------------------------------------------
 
  !> Convert degrees Celsius to Kelvins.
  !! @param[in] degrees_C Temperature in degrees Celcius.
  !! @retval degrees_K Temperature in Kelvins.
 
  elemental function ctok_sgl_fn( degrees_C )    result( degrees_K )
 
    real (c_float), intent(in) :: degrees_c
    real (c_float) :: degrees_k
 
    degrees_k = real(degrees_c + 273.15_c_double, c_float)
 
  end function ctok_sgl_fn
 
 
!--------------------------------------------------------------------------------------------------
 
  !> Convert degrees Fahrenheit to Kelvins.
  !! @param[in] degrees_C Temperature in degrees Celsius.
  !! @retval degrees_K Temperature in Kelvins.
 
  elemental function ctok_dbl_fn( degrees_C )    result( degrees_K )
 
    real (c_double), intent(in) :: degrees_c
    real (c_double) :: degrees_k
 
    degrees_k = degrees_c + 273.15_c_double
 
  end function ctok_dbl_fn
 
!--------------------------------------------------------------------------------------------------
 
  !>  Convert inches to mm.
  !! @param[in] inches Value in inches.
  !! @retval mm Value in millimeters.
 
  elemental function inches_to_mm_sgl_fn( inches )   result( mm )
 
    real (c_float),intent(in) :: inches
    real (c_float)            :: mm
 
    mm = real(inches * 25.4_c_double, c_float)
 
  end function inches_to_mm_sgl_fn
 
!--------------------------------------------------------------------------------------------------
 
  !>  Convert inches to mm.
  !! @param[in] inches Value in inches.
  !! @retval mm Value in millimeters.
 
  elemental function inches_to_mm_dbl_fn( inches )   result( mm )
 
    real (c_double),intent(in) :: inches
    real (c_double)            :: mm
 
    mm = inches * 25.4_c_double
 
  end function inches_to_mm_dbl_fn
 
!--------------------------------------------------------------------------------------------------
 
  !>  Convert millimeters to inches.
  !! @param[in] mm Value in millimeters.
  !! @retval inches Value in inches.
 
  elemental function mm_to_inches_sgl_fn(mm) result(inches)
 
    real (c_float),intent(in) :: mm
    real (c_float) :: inches
 
    inches = real(mm / 25.4_c_double, c_float)
 
  end function mm_to_inches_sgl_fn
 
!--------------------------------------------------------------------------------------------------
 
  !>  Convert millimeters to inches.
  !! @param[in] mm Value in millimeters.
  !! @retval inches Value in inches.
 
  elemental function mm_to_inches_dbl_fn( mm ) result( inches )
 
    real (c_double),intent(in) :: mm
    real (c_double) :: inches
 
    inches = mm / 25.4_c_double
 
  end function mm_to_inches_dbl_fn
 
!--------------------------------------------------------------------------------------------------
 
  !> Convert a short integer to a logical value
 
  elemental function short2logical(iShortVal)    result(lValue)
 
    integer (c_short), intent(in)    :: ishortval
    logical (c_bool)                 :: lvalue
 
    if ( ishortval == 0 ) then
      lvalue = false
    else
      lvalue = true
    endif
 
  end function short2logical
 
!--------------------------------------------------------------------------------------------------
 
  !> Convert an integer to a logical value
 
  elemental function int2logical(iValue)    result(lValue)
 
    integer (c_int), intent(in)      :: ivalue
    logical (c_bool)                 :: lvalue
 
    if ( ivalue == 0 ) then
      lvalue = false
    else
      lvalue = true
    endif
 
  end function int2logical
 
!--------------------------------------------------------------------------------------------------
 
  !> Convert a real to a logical value
 
  elemental function real2logical(rValue)    result(lValue)
 
    real (c_float), intent(in)      :: rvalue
    logical (c_bool)                :: lvalue
 
    ! [ LOCALS ]
    real (c_float), parameter :: fminresolution = 2.0 * spacing(1.0_c_float)
 
    if ( rvalue > -fminresolution .and. rvalue < fminresolution ) then
      lvalue = false
    else
      lvalue = true
    endif
 
  end function real2logical
 
!--------------------------------------------------------------------------------------------------
 
  !> Convert a double to a logical value
 
  elemental function dbl2logical(rValue)    result(lValue)
 
    real (c_double), intent(in)      :: rvalue
    logical (c_bool)                 :: lvalue
 
    ! [ LOCALS ]
    real (c_double), parameter :: dminresolution = 2.0 * spacing(1.0_c_float)
 
    if ( rvalue > -dminresolution .and. rvalue < dminresolution ) then
      lvalue = false
    else
      lvalue = true
    endif
 
  end function dbl2logical
 
!--------------------------------------------------------------------------------------------------
 
  !> Convert a character string to a logical value
 
  elemental function char2logical(sValue)    result(lValue)
 
    character (len=*), intent(in)      :: svalue
    logical (c_bool)              :: lvalue
 
    select case ( svalue )
 
      case ( "TRUE", "True", "true", "T", "YES", "Yes", "yes", "1" )
 
        lvalue = true
 
      case default
 
        lvalue = false
 
    end select
 
  end function char2logical
 
!--------------------------------------------------------------------------------------------------
 
  !> Convert a short integer to an integer
 
  elemental function short2int(iShortVal)    result(iValue)
 
    integer (c_short), intent(in)    :: ishortval
    integer (c_int)                  :: ivalue
 
    ivalue = int( ishortval, c_int )
 
  end function short2int
 
!--------------------------------------------------------------------------------------------------
 
  !> Convert a character value into a integer
 
  impure elemental function char2int(sValue)  result(iValue)
 
    character (len=*), intent(in) :: svalue
    integer (c_int) :: ivalue
 
    ! [ LOCALS ]
    integer (c_int) :: istat
    character (len=:), allocatable :: stempval
    real (c_float)  :: rvalue
 
    stempval = keepnumeric(svalue)
 
    ! if the cleaned up string appears to be a real value,
    ! attempt to read as real and convert to int
    if ( scan(stempval, ".") /= 0 ) then
 
      read(unit=stempval, fmt=*, iostat=istat) rvalue
 
      if (istat == 0)  ivalue = int(rvalue, c_int)
 
    else
 
      read(unit=stempval, fmt=*, iostat=istat) ivalue
 
    endif
 
    if (istat /= 0)  ivalue = itinyval
 
  end function char2int
 
!--------------------------------------------------------------------------------------------------
 
!> Convert a real value into a integer
 
elemental function real2int(rValue)  result(iValue)
 
  real (c_float), intent(in) :: rvalue
  integer (c_int) :: ivalue
 
  ivalue = int(rvalue, c_int)
 
end function real2int
 
!--------------------------------------------------------------------------------------------------
 
!> Convert a double-precision value to an integer
 
elemental function dbl2int(rValue)  result(iValue)
 
  real (c_double), intent(in) :: rvalue
  integer (c_int) :: ivalue
 
  ivalue = int(rvalue, c_int)
 
end function dbl2int
 
!--------------------------------------------------------------------------------------------------
 
!> Convert a boolean value into a int
elemental pure function bool2int(lValue)   result(iValue)
  logical (c_bool), intent(in) :: lvalue
  integer (c_int)              :: ivalue
 
  if (lvalue) then
    ivalue = 1_c_int
  else
    ivalue = 0_c_int
  end if
 
end function bool2int
 
!> Convert a character value into a real
 
elemental function char2real(sValue)  result(rValue)
 
  character (len=*), intent(in) :: svalue
  real (c_float) :: rvalue
 
  ! [ LOCALS ]
  integer (c_int) :: istat
 
  read(unit=svalue, fmt=*, iostat=istat) rvalue
 
  if (istat /= 0) rvalue = rtinyval
 
end function char2real
 
!--------------------------------------------------------------------------------------------------
 
!> Convert a short int value into a real
 
elemental function short2real(iValue)  result(rValue)
 
  integer (c_short), intent(in) :: ivalue
  real (c_float)                :: rvalue
 
  rvalue = real(ivalue, c_float)
 
end function short2real
 
!--------------------------------------------------------------------------------------------------
 
!> Convert an int value into a real
 
elemental function int2real(iValue)  result(rValue)
 
  integer (c_int), intent(in) :: ivalue
  real (c_float) :: rvalue
 
  rvalue = real(ivalue, c_float)
 
end function int2real
 
!--------------------------------------------------------------------------------------------------
 
!> Convert a dbl value into a real
 
elemental function dbl2real(dpValue)  result(rValue)
 
  real (c_double), intent(in) :: dpvalue
  real (c_float) :: rvalue
 
  rvalue = real(dpvalue, c_float)
 
end function dbl2real
 
!--------------------------------------------------------------------------------------------------
 
!> Convert a boolean value into a real
elemental pure function bool2real(lValue)   result(rValue)
  logical (c_bool), intent(in) :: lvalue
  real (c_float)               :: rvalue
 
  if (lvalue) then
    rvalue = 1.0_c_float
  else
    rvalue = 0.0_c_float
  end if
 
end function bool2real
 
!--------------------------------------------------------------------------------------------------
 
!> Convert a character value into a double
 
elemental function char2dbl(sValue)  result(dValue)
 
  character (len=*), intent(in)    :: svalue
  real (c_double) :: dvalue
 
  ! [ LOCALS ]
  integer (c_int) :: istat
 
  read(unit=svalue, fmt=*, iostat=istat) dvalue
 
  if (istat /= 0)  dvalue = dtinyval
 
end function char2dbl
 
!--------------------------------------------------------------------------------------------------
 
!> Convert a short int value into a double
 
elemental function short2dbl(iValue)  result(dValue)
 
  integer (c_short), intent(in) :: ivalue
  real (c_double)               :: dvalue
 
  dvalue = real(ivalue, c_double)
 
end function short2dbl
 
!--------------------------------------------------------------------------------------------------
 
!> Convert an int value into a double
 
elemental function int2dbl(iValue)  result(dValue)
 
  integer (c_int), intent(in) :: ivalue
  real (c_double) :: dvalue
 
  dvalue = real(ivalue, c_double)
 
end function int2dbl
 
!--------------------------------------------------------------------------------------------------
 
!> Convert a real value into a double
 
elemental function real2dbl(fValue)  result(dValue)
 
  real (c_float), intent(in) :: fvalue
  real (c_double) :: dvalue
 
  dvalue = real(fvalue, c_double)
 
end function real2dbl
 
!--------------------------------------------------------------------------------------------------
 
!> Convert a boolean value into a double
elemental pure function bool2dbl(lValue)   result(dValue)
  logical (c_bool), intent(in) :: lvalue
  real (c_double)              :: dvalue
 
  if (lvalue) then
    dvalue = 1.0_c_double
  else
    dvalue = 0.0_c_double
  end if
 
end function bool2dbl
 
!--------------------------------------------------------------------------------------------------
 
function char_ptr_to_fortran_string( cpCharacterPtr )  result(sText)
 
  use iso_c_binding
  implicit none
 
  type(c_ptr) :: cpcharacterptr
  character(len=256) :: stext
  character (c_char), pointer, dimension(:) :: fptr
  integer (c_int) :: icount
 
    stext = repeat(" ", 256)
 
    call c_f_pointer(cpcharacterptr, fptr, [256])
    icount = 0
    do
      icount = icount + 1
      if( index(string=fptr(icount), substring=c_null_char ) /= 0) exit
      stext(icount:icount) = fptr(icount)
 
    enddo
 
end function char_ptr_to_fortran_string
 
!--------------------------------------------------------------------------------------------------
 
elemental function c_to_fortran_string( cCharacterString )  result(sText)
 
  use iso_c_binding
  implicit none
 
  character (len=*), intent(in) :: ccharacterstring
  character(len=len(cCharacterString) - 1) :: stext
  integer (c_int) :: iindex
 
  stext = ""
 
  iindex = index( string=ccharacterstring, substring=c_null_char )
 
  if(iindex == 0) then
 
    stext = trim(adjustl(ccharacterstring))
 
  else
 
    stext = ccharacterstring(1:iindex-1)
 
  endif
 
end function c_to_fortran_string
 
!--------------------------------------------------------------------------------------------------
 
elemental function fortran_to_c_string( sText )  result(cCharacterString)
 
  use iso_c_binding
  implicit none
 
  character (len=*), intent(in) :: stext
  character(len=256) :: ccharacterstring
  integer (c_int) :: iindex
 
  iindex = index(string=stext, substring=c_null_char)
 
  if (iindex == 0) then
    ccharacterstring = trim(stext)//c_null_char
  else
    ccharacterstring  = stext(1:iindex)
  endif
 
end function fortran_to_c_string
 
  !> Strip everything except numeric characters from a text string.
  !!
  !! Keep only the numeric characters in a text string.
  !! @param[in] sTextIn
  impure elemental function keepnumeric(sText1)            result(sText)
 
    ! ARGUMENTS
    character (len=*), intent(in)           :: stext1
    character (len=len(sText1))             :: stext
 
    ! LOCALS
    character (len=512)            :: stemp
    character (len=512)            :: sbuf
    integer (c_int)           :: ir                 ! Index in sRecord
    integer (c_int)           :: iindex1, iindex2
    character (len=:), allocatable :: stargetcharacters_l
 
    ! TargetCharacter omits the period ("."): do not want a real value returned
    ! as a funky integer (e.g. string "3.141" returned as integer 3141 )
    stargetcharacters_l = "qwertyuiopasdfghjklzxcvbnmQWERTYUIOPASDFGHJKLZXCVBNM" &
      //"!@#$%^&*()_+-={}[]|\:;'<,>?/~`'"//'"'
 
    ! eliminate any leading spaces
    stemp = adjustl(stext1)
    sbuf = ""
    iindex2 = 0
 
    do iindex1 = 1,len_trim(stext1)
 
      ir = scan(stemp(iindex1:iindex1), stargetcharacters_l)
 
      if(ir==0) then
        iindex2 = iindex2 + 1
        sbuf(iindex2:iindex2) = stemp(iindex1:iindex1)
      end if
 
    enddo
 
    stext = trim(sbuf)
 
  end function keepnumeric
 
  elemental function enforce_bounds_int_fn(value, minval, maxval)  result(retval)
 
    integer (c_int), intent(in)   :: value
    integer (c_int), intent(in)   :: minval
    integer (c_int), intent(in)   :: maxval
    integer (c_int)               :: retval
 
    retval = min( max( value, minval ), maxval)
 
  end function enforce_bounds_int_fn 
 
  elemental function enforce_bounds_sgl_fn(value, minval, maxval)  result(retval)
 
    real (c_float), intent(in)   :: value
    real (c_float), intent(in)   :: minval
    real (c_float), intent(in)   :: maxval
    real (c_float)               :: retval
 
    retval = min( max( value, minval ), maxval)
 
  end function enforce_bounds_sgl_fn 
 
  elemental function enforce_bounds_dbl_fn(value, minval, maxval)  result(retval)
  
    real (c_double), intent(in)   :: value
    real (c_double), intent(in)   :: minval
    real (c_double), intent(in)   :: maxval
    real (c_double)               :: retval
  
    retval = min( max( value, minval ), maxval)
  
  end function enforce_bounds_dbl_fn 
 
end module constants_and_conversions