! PsychroLib version 2.0.0 (https://github.com/psychrometrics/psychrolib)
! Copyright (c) 2018 D. Thevenard and D. Meyer for the current library implementation
! Copyright (c) 2017 ASHRAE Handbook — Fundamentals for ASHRAE equations and coefficients
! Licensed under the MIT License.

module psychrolib
  !+ Module overview
  !+  Contains functions for calculating thermodynamic properties of gas-vapor mixtures
  !+  and standard atmosphere suitable for most engineering, physical, and meteorological
  !+  applications.
  !+
  !+  Most of the functions are an implementation of the formulae found in the
  !+  2017 ASHRAE Handbook - Fundamentals, in both International System (SI),
  !+  and Imperial (IP) units. Please refer to the information included in
  !+  each function for their respective reference.
  !+
  !+ Example
  !+  use psychrolib, only: GetTDewPointFromRelHum, SI
  !+  ! Set the unit system, for example to SI (can be either 'SI' or 'IP')
  !+  SetUnitSystem(SI)
  !+  ! Calculate the dew point temperature for a dry bulb temperature of 25 C and a relative humidity of 80%
  !+  print *, GetTDewPointFromRelHum(25.0, 0.80)
  !+ 21.3094
  !+
  !+ Copyright
  !+  - For the current library implementation
  !+     Copyright (c) 2018 D. Thevenard and D. Meyer.
  !+  - For equations and coefficients published ASHRAE Handbook — Fundamentals, Chapter 1
  !+     Copyright (c) 2017 ASHRAE Handbook — Fundamentals (https://www.ashrae.org)
  !+
  !+ License
  !+  MIT (https://github.com/psychrometrics/psychrolib/LICENSE.txt)
  !+
  !+ Note from the Authors
  !+  We have made every effort to ensure that the code is adequate, however, we make no
  !+  representation with respect to its accuracy. Use at your own risk. Should you notice
  !+  an error, or if you have a suggestion, please notify us through GitHub at
  !+  https://github.com/psychrometrics/psychrolib/issues.

  implicit none

  private
  public :: IP
  public :: SI
  public :: SetUnitSystem
  public :: GetUnitSystem
  public :: isIP
  public :: GetTRankineFromTFahrenheit
  public :: GetTKelvinFromTCelsius
  public :: GetTWetBulbFromTDewPoint
  public :: GetTWetBulbFromRelHum
  public :: GetRelHumFromTDewPoint
  public :: GetRelHumFromTWetBulb
  public :: GetTDewPointFromRelHum
  public :: GetTDewPointFromTWetBulb
  public :: GetVapPresFromRelHum
  public :: GetRelHumFromVapPres
  public :: GetTDewPointFromVapPres
  public :: GetVapPresFromTDewPoint
  public :: GetTWetBulbFromHumRatio
  public :: GetHumRatioFromTWetBulb
  public :: GetHumRatioFromRelHum
  public :: GetRelHumFromHumRatio
  public :: GetHumRatioFromTDewPoint
  public :: GetTDewPointFromHumRatio
  public :: GetHumRatioFromVapPres
  public :: GetVapPresFromHumRatio
  public :: GetDryAirEnthalpy
  public :: GetDryAirDensity
  public :: GetDryAirVolume
  public :: GetSatVapPres
  public :: GetSatHumRatio
  public :: GetSatAirEnthalpy
  public :: GetVaporPressureDeficit
  public :: GetDegreeOfSaturation
  public :: GetMoistAirEnthalpy
  public :: GetMoistAirVolume
  public :: GetMoistAirDensity
  public :: GetStandardAtmPressure
  public :: GetStandardAtmTemperature
  public :: GetSeaLevelPressure
  public :: GetStationPressure
  public :: CalcPsychrometricsFromTWetBulb
  public :: CalcPsychrometricsFromTDewPoint
  public :: CalcPsychrometricsFromRelHum

  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  ! Global constants
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

  real, parameter ::  R_DA_IP = 53.350
    !+ Universal gas constant for dry air (IP version) in ft lb_Force lb_DryAir⁻¹ R⁻¹
    !+ Reference:
    !+ ASHRAE Handbook - Fundamentals (2017) ch. 1

  real, parameter ::  R_DA_SI = 287.042
    !+ Universal gas constant for dry air (SI version) in J kg_DryAir⁻¹ K⁻¹
    !+ Reference:
    !+ ASHRAE Handbook - Fundamentals (2017) ch. 1

  integer, parameter :: IP = 1
  integer, parameter :: SI = 2

  integer  :: PSYCHROLIB_UNITS = 0 ! 0 = undefined
    !+ Unit system to use.

  real ::  PSYCHROLIB_TOLERANCE = 1.0
    !+ Tolerance of temperature calculations

  contains

  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  ! Helper functions
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

  subroutine SetUnitSystem(UnitSystem)
  !+ Set the system of units to use (SI or IP).
  !+ Notes: this function *HAS TO BE CALLED* before the library can be used

    integer, intent(in)    :: UnitSystem
    !+ Units: string indicating the system of units chosen (SI or IP)

    if (.not. (UnitSystem == SI .or. UnitSystem == IP)) then
      error stop "The system of units has to be either SI or IP."
    end if

    PSYCHROLIB_UNITS = UnitSystem

    ! Define tolerance on temperature calculations
    ! The tolerance is the same in IP and SI
    if (UnitSystem == IP) then
      PSYCHROLIB_TOLERANCE = 0.001 * 9.0 / 5.0
    else
      PSYCHROLIB_TOLERANCE = 0.001
    end if
  end subroutine SetUnitSystem

  function GetUnitSystem() result(UnitSystem)
    !+ Return the system of units in use.
    integer :: UnitSystem
    UnitSystem = PSYCHROLIB_UNITS
  end function GetUnitSystem

  function isIP()
    !+ Check whether the system in use is IP or SI
    logical :: isIP
    if (PSYCHROLIB_UNITS == IP) then
      isIP = .true.
    else if (PSYCHROLIB_UNITS == SI) then
      isIP = .false.
    else
      error stop "The system of units has not been defined."
    end if
  end function isIP

  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  ! Conversion between temperature units
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

  function GetTRankineFromTFahrenheit(TFahrenheit) result(TRankine)
    real, intent(in)  :: TFahrenheit
      !+ Temperature in degree Fahrenheit
    real              :: TRankine
      !+ Temperature in degree Rankine
    real              :: ZERO_FAHRENHEIT_AS_RANKINE
      !+ Zero degree Fahrenheit (°F) expressed as degree Rankine (°R)

    ZERO_FAHRENHEIT_AS_RANKINE = 459.67

    TRankine = TFahrenheit + ZERO_FAHRENHEIT_AS_RANKINE
  end function GetTRankineFromTFahrenheit

  function GetTKelvinFromTCelsius(TCelsius) result(TKelvin)
    real, intent(in)  :: TCelsius
      !+ Temperature in degree Celsius
    real              :: TKelvin
      !+ Tempearatyre in Kelvin
    real              :: ZERO_CELSIUS_AS_KELVIN
      ! Zero degree Fahrenheit (°F) expressed as Kelvin (K)

    ZERO_CELSIUS_AS_KELVIN = 273.15

    TKelvin = TCelsius + ZERO_CELSIUS_AS_KELVIN
  end function GetTKelvinFromTCelsius

  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  ! Conversions between dew point, wet bulb, and relative humidity
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

  function GetTWetBulbFromTDewPoint(TDryBulb, TDewPoint, Pressure) result(TWetBulb)
    !+ Return wet-bulb temperature given dry-bulb temperature, dew-point temperature, and pressure.
    !+ References:
    !+ ASHRAE Handbook - Fundamentals (2017) ch. 1

    real, intent(in)  :: TDryBulb
      !+ Dry-bulb temperature in °F [IP] or °C [SI]
    real, intent(in)  :: TDewPoint
      !+ Dew-point temperature in °F [IP] or °C [SI]
    real, intent(in)  :: Pressure
      !+ Atmospheric pressure in Psi [IP] or Pa [SI]
    real              :: TWetBulb
      !+ Wet-bulb temperature in °F [IP] or °C [SI]
    real              :: HumRatio
      !+ Humidity ratio in lb_H₂O lb_Air⁻¹ [IP] or kg_H₂O kg_Air⁻¹ [SI]

    if (TDewPoint > TDryBulb) then
      error stop "Error: dew point temperature is above dry bulb temperature"
    end if

    HumRatio = GetHumRatioFromTDewPoint(TDewPoint, Pressure)
    TWetBulb = GetTWetBulbFromHumRatio(TDryBulb, HumRatio, Pressure)
  end function GetTWetBulbFromTDewPoint

  function GetTWetBulbFromRelHum(TDryBulb, RelHum, Pressure) result(TWetBulb)
    !+ Return wet-bulb temperature given dry-bulb temperature, relative humidity, and pressure.
    !+ References:
    !+ ASHRAE Handbook - Fundamentals (2017) ch. 1

    real, intent(in)  ::  TDryBulb
      !+ Dry-bulb temperature in °F [IP] or °C [SI]
    real, intent(in)  ::  RelHum
      !+ Relative humidity in range [0, 1]
    real, intent(in)  ::  Pressure
      !+ Atmospheric pressure in Psi [IP] or Pa [SI]
    real              ::  TWetBulb
      !+ Wet-bulb temperature in °F [IP] or °C [SI]
    real              ::  HumRatio
      !+ Humidity ratio in lb_H₂O lb_Air⁻¹ [IP] or kg_H₂O kg_Air⁻¹ [SI]

    if (RelHum < 0.0 .or. RelHum > 1.0) then
      error stop "Error: relative humidity is outside range [0,1]"
    end if

    HumRatio = GetHumRatioFromRelHum(TDryBulb, RelHum, Pressure)
    TWetBulb = GetTWetBulbFromHumRatio(TDryBulb, HumRatio, Pressure)
  end function GetTWetBulbFromRelHum

  function GetRelHumFromTDewPoint(TDryBulb, TDewPoint) result(RelHum)
    !+ Return relative humidity given dry-bulb temperature and dew-point temperature.
    !+ References:
    !+ ASHRAE Handbook - Fundamentals (2017) ch. 1 eqn 22

    real, intent(in)  ::  TDryBulb
      !+ Dry-bulb temperature in °F [IP] or °C [SI]
    real, intent(in)  ::  TDewPoint
      !+ Dew-point temperature in °F [IP] or °C [SI]
    real              ::  RelHum
      !+ Relative humidity in range [0, 1]
    real              ::  VapPres
      !+ Partial pressure of water vapor in moist air in Psi [IP] or Pa [SI]
    real              ::  SatVapPres
      !+ Vapor pressure of saturated air in Psi [IP] or Pa [SI]

    if (TDewPoint > TDryBulb) then
      error stop "Error: dew point temperature is above dry bulb temperature"
    end if

    VapPres     = GetSatVapPres(TDewPoint)
    SatVapPres  = GetSatVapPres(TDryBulb)
    RelHum      = VapPres / SatVapPres
  end function GetRelHumFromTDewPoint

  function GetRelHumFromTWetBulb(TDryBulb, TWetBulb, Pressure) result(RelHum)
    !+ Return relative humidity given dry-bulb temperature, wet bulb temperature and pressure.
    !+ References:
    !+ ASHRAE Handbook - Fundamentals (2017) ch. 1

    real, intent(in)  ::  TDryBulb
      !+ Dry-bulb temperature in °F [IP] or °C [SI]
    real, intent(in)  ::  TWetBulb
      !+ Wet-bulb temperature in °F [IP] or °C [SI]
    real, intent(in)  ::  Pressure
      !+ Atmospheric pressure in Psi [IP] or Pa [SI]
    real              ::  RelHum
      !+ Relative humidity in range [0, 1]
    real              ::  HumRatio
      !+ Humidity ratio in lb_H₂O lb_Air⁻¹ [IP] or kg_H₂O kg_Air⁻¹ [SI]

    if (TWetBulb > TDryBulb) then
      error stop "Error: wet bulb temperature is above dry bulb temperature"
    end if

    HumRatio = GetHumRatioFromTWetBulb(TDryBulb, TWetBulb, Pressure)
    RelHum   = GetRelHumFromHumRatio(TDryBulb, HumRatio, Pressure)
  end function GetRelHumFromTWetBulb

  function GetTDewPointFromRelHum(TDryBulb, RelHum) result(TDewPoint)
    !+ Return dew-point temperature given dry-bulb temperature and relative humidity.
    !+ References:
    !+ ASHRAE Handbook - Fundamentals (2017) ch. 1

    real, intent(in)  ::  TDryBulb
      !+ Dry-bulb temperature in °F [IP] or °C [SI]
    real, intent(in)  ::  RelHum
      !+ Relative humidity in range [0, 1]
    real              ::  TDewPoint
      !+ Dew-point temperature in °F [IP] or °C [SI]
    real              ::  VapPres
      !+ Partial pressure of water vapor in moist air in Psi [IP] or Pa [SI]

    if (RelHum < 0.0 .or. RelHum > 1.0) then
      error stop "Error: relative humidity is outside range [0,1]"
    end if

    VapPres   = GetVapPresFromRelHum(TDryBulb, RelHum)
    TDewPoint = GetTDewPointFromVapPres(TDryBulb, VapPres)
  end function GetTDewPointFromRelHum

  function GetTDewPointFromTWetBulb(TDryBulb, TWetBulb, Pressure) result(TDewPoint)
    !+ Return dew-point temperature given dry-bulb temperature, wet-bulb temperature, and pressure.
    !+ References:
    !+ ASHRAE Handbook - Fundamentals (2017) ch. 1

    real, intent(in)  ::  TDryBulb
      !+ Dry-bulb temperature in °F [IP] or °C [SI]
    real, intent(in)  ::  TWetBulb
      !+ Wet-bulb temperature in °F [IP] or °C [SI]
    real, intent(in)  ::  Pressure
      !+ Atmospheric pressure in Psi [IP] or Pa [SI]
    real              ::  TDewPoint
      !+ Dew-point temperature in °F [IP] or °C [SI]
    real              ::  HumRatio
      !+ Humidity ratio in lb_H₂O lb_Air⁻¹ [IP] or kg_H₂O kg_Air⁻¹ [SI]

    if (TWetBulb > TDryBulb) then
      error stop "Error: wet bulb temperature is above dry bulb temperature"
    end if

    HumRatio  = GetHumRatioFromTWetBulb(TDryBulb, TWetBulb, Pressure)
    TDewPoint = GetTDewPointFromHumRatio(TDryBulb, HumRatio, Pressure)
  end function GetTDewPointFromTWetBulb

  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  ! Conversions between dew point, or relative humidity and vapor pressure
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

  function GetVapPresFromRelHum(TDryBulb, RelHum) result(VapPres)
    !+ Return partial pressure of water vapor as a function of relative humidity and temperature.
    !+ References:
    !+ ASHRAE Handbook - Fundamentals (2017) ch. 1 eqn 12, 22

    real, intent(in)  ::  TDryBulb
      !+ Dry-bulb temperature in °F [IP] or °C [SI]
    real, intent(in)  ::  RelHum
      !+ Relative humidity in range [0, 1]
    real              ::  VapPres
      !+ Partial pressure of water vapor in moist air in Psi [IP] or Pa [SI]

    if (RelHum < 0.0 .or. RelHum > 1.0) then
      error stop "Error: relative humidity is outside range [0,1]"
    end if

    VapPres = RelHum * GetSatVapPres(TDryBulb)
  end function GetVapPresFromRelHum

  function GetRelHumFromVapPres(TDryBulb, VapPres) result(RelHum)
    !+ Return relative humidity given dry-bulb temperature and vapor pressure.
    !+ References:
    !+ ASHRAE Handbook - Fundamentals (2017) ch. 1 eqn 12, 22

    real, intent(in)  ::  TDryBulb
      !+ Dry-bulb temperature in °F [IP] or °C [SI]
    real, intent(in)  ::  VapPres
      !+ Partial pressure of water vapor in moist air in Psi [IP] or Pa [SI]
    real              ::  RelHum
      !+ Relative humidity in range [0, 1]

    if (VapPres < 0.0) then
      error stop "Error: partial pressure of water vapor in moist air cannot be negative"
    end if

    RelHum = VapPres / GetSatVapPres(TDryBulb)
  end function GetRelHumFromVapPres

  function GetTDewPointFromVapPres(TDryBulb, VapPres) result(TDewPoint)
    !+ Return dew-point temperature given dry-bulb temperature and vapor pressure.
    !+ References:
    !+ ASHRAE Handbook - Fundamentals (2017) ch. 1 eqn. 5 and 6
    !+ Notes:
    !+ The dew point temperature is solved by inverting the equation giving water vapor pressure
    !+ at saturation from temperature rather than using the regressions provided
    !+ by ASHRAE (eqn. 37 and 38) which are much less accurate and have a
    !+ narrower range of validity.
    !+ The Newton-Raphson (NR) method is used on the logarithm of water vapour
    !+ pressure as a function of temperature, which is a very smooth function
    !+ Convergence is usually achieved in 3 to 5 iterations.
    !+ TDryBulb is not really needed here, just used for convenience.

    real, intent(in)    ::  TDryBulb
      !+ Dry-bulb temperature in °F [IP] or °C [SI]
    real, intent(in)    ::  VapPres
      !+ Partial pressure of water vapor in moist air in Psi [IP] or Pa [SI]
    real                ::  TDewPoint
      !+ Dew-point temperature in °F [IP] or °C [SI]
    real                ::  Tdp
      !+ Calculated value of dew point temperatures, solved for iteratively in °F [IP] or °C [SI]
    real                ::  lnVP
      !+ Natural logarithm of partial pressure of water vapor pressure in moist air
    real                ::  d_lnVP
      !+ Derivative of function, calculated numerically
    real                ::  lnVP_c
      !+ Value of log of vapor water pressure used in NR calculation
    real                ::  Tdp_c
      !+ Value of Tdp used in NR calculation
    real                ::  d_Tdp
      !+ Value of temperature step used in NR calculation
    real                ::  STEPSIZE
      !+ Size of timestep (dimensionless)
    real                :: TMidPoint
      !+ Midpoint of domain of validity
    real, dimension(2)  ::  BOUNDS
      !+ Valid temperature range in °F [IP] or °C [SI]
    integer             :: index
      !+ Index used in the calculation

    ! Bounds and step size as a function of the system of units
    if (isIP()) then
        BOUNDS(1) = -148.0
        BOUNDS(2) =  392.0
        STEPSIZE  =  0.01 * 9.0 / 5.0
    else
        BOUNDS(1) = -100.0
        BOUNDS(2) =  200.0
        STEPSIZE  =  0.01
    end if

    TMidPoint = (BOUNDS(2) + BOUNDS(2)) / 2.0

    ! Bounds outside which a solution cannot be found
    if (VapPres <= GetSatVapPres(BOUNDS(1)) .or. VapPres >= GetSatVapPres(BOUNDS(2))) then
      error stop "Error: partial pressure of water vapor is outside range of validity of equations"
    end if

    ! First guess
    Tdp = TDryBulb
    lnVP = log(VapPres)
    Tdp_c = Tdp
    index = 1

    do while ((abs(Tdp - Tdp_c) > PSYCHROLIB_TOLERANCE) .or. (index < 2))
      ! Current point
      Tdp_c = Tdp
      lnVP_c = log(GetSatVapPres(Tdp_c))
      ! Step - negative in the right part of the curve, positive in the left part
      ! to avoid going past the domain of validity of eqn. 5 and 6
      ! when Tdp_c is close to its bounds
      if (Tdp_c > TMidPoint) then
        d_Tdp = -STEPSIZE
      else
        d_Tdp = STEPSIZE
      end if
      ! Derivative of function, calculated numerically
      d_lnVP = (log(GetSatVapPres(Tdp_c + d_Tdp)) - lnVP_c) / d_Tdp
      ! New estimate, bounded by domain of validity of eqn. 5 and 6
      Tdp = Tdp_c - (lnVP_c - lnVP) / d_lnVP
      Tdp = max(Tdp, BOUNDS(1))
      Tdp = min(Tdp, BOUNDS(2))
      index = index + 1
    end do

  TDewPoint = min(Tdp, TDryBulb)
  end function GetTDewPointFromVapPres

  function GetVapPresFromTDewPoint(TDewPoint) result(VapPres)
    !+ Return vapor pressure given dew point temperature.
    !+ References:
    !+ ASHRAE Handbook - Fundamentals (2017) ch. 1 eqn 36

    real, intent(in)  ::  TDewPoint
      !+ Dew-point temperature in °F [IP] or °C [SI]
    real              ::  VapPres
      !+ Partial pressure of water vapor in moist air in Psi [IP] or Pa [SI]

    VapPres = GetSatVapPres(TDewPoint)
  end function GetVapPresFromTDewPoint

  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  ! Conversions from wet-bulb temperature, dew-point temperature, or relative humidity to humidity ratio
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

  function GetTWetBulbFromHumRatio(TDryBulb, HumRatio, Pressure) result(TWetBulb)
    !+ Return wet-bulb temperature given dry-bulb temperature, humidity ratio, and pressure.
    !+ References:
    !+ ASHRAE Handbook - Fundamentals (2017) ch. 1 eqn 33 and 35 solved for Tstar

    real, intent(in)  ::  TDryBulb
      !+ Dry-bulb temperature in °F [IP] or °C [SI]
    real, intent(in)  ::  HumRatio
      !+ Humidity ratio in lb_H₂O lb_Air⁻¹ [IP] or kg_H₂O kg_Air⁻¹ [SI]
    real, intent(in)  ::  Pressure
      !+ Atmospheric pressure in Psi [IP] or Pa [SI]
    real              ::  TWetBulb
      !+ Wet-bulb temperature in °F [IP] or °C [SI]
    real              ::  TDewPoint
      !+ TDewPoint : Dew-point temperature in °F [IP] or °C [SI]
    real              ::  TWetBulbSup
      !+ Upper value of wet bulb temperature in bissection method (initial guess is from dry bulb temperature) in °F [IP] or °C [SI]
    real              ::  TWetBulbInf
      !+ Lower value of wet bulb temperature in bissection method (initial guess is from dew point temperature) in °F [IP] or °C [SI]
    real              ::  Wstar
      !+ Humidity ratio at temperature Tstar in lb_H₂O lb_Air⁻¹ [IP] or kg_H₂O kg_Air⁻¹ [SI]

    if (HumRatio < 0.0) then
      error stop "Error: humidity ratio cannot be negative"
    end if

    TDewPoint = GetTDewPointFromHumRatio(TDryBulb, HumRatio, Pressure)

    ! Initial guesses
    TWetBulbSup = TDryBulb
    TWetBulbInf = TDewPoint
    TWetBulb = (TWetBulbInf + TWetBulbSup) / 2.0

    ! Bisection loop
    do while(TWetBulbSup - TWetBulbInf > PSYCHROLIB_TOLERANCE)

    ! Compute humidity ratio at temperature Tstar
    Wstar = GetHumRatioFromTWetBulb(TDryBulb, TWetBulb, Pressure)

    ! Get new bounds
    if (Wstar > HumRatio) then
      TWetBulbSup = TWetBulb
    else
      TWetBulbInf = TWetBulb
    end if

    ! New guess of wet bulb temperature
    TWetBulb = (TWetBulbSup + TWetBulbInf) / 2.0
    end do
  end function GetTWetBulbFromHumRatio

  function GetHumRatioFromTWetBulb(TDryBulb, TWetBulb, Pressure) result(HumRatio)
    !+ Return humidity ratio given dry-bulb temperature, wet-bulb temperature, and pressure.
    !+ References:
    !+ ASHRAE Handbook - Fundamentals (2017) ch. 1 eqn 33 and 35

    real, intent(in)  ::  TDryBulb
      !+ Dry-bulb temperature in °F [IP] or °C [SI]
    real, intent(in)  ::  TWetBulb
      !+ Wet-bulb temperature in °F [IP] or °C [SI]
    real, intent(in)  ::  Pressure
      !+ Atmospheric pressure in Psi [IP] or Pa [SI]
    real              ::  HumRatio
      !+ Humidity ratio in lb_H₂O lb_Air⁻¹ [IP] or kg_H₂O kg_Air⁻¹ [SI]
    real              ::  Wsstar
      !+ Humidity ratio at temperature Tstar in lb_H₂O lb_Air⁻¹ [IP] or kg_H₂O kg_Air⁻¹ [SI]

    if (TWetBulb > TDryBulb) then
      error stop "Error: wet bulb temperature is above dry bulb temperature"
    end if

    Wsstar = GetSatHumRatio(TWetBulb, Pressure)

    if (isIP()) then
      if (TWetBulb >= 32.0) then
        HumRatio = ((1093.0 - 0.556 * TWetBulb) * Wsstar - 0.240 * (TDryBulb - TWetBulb))   &
                   / (1093.0 + 0.444 * TDryBulb - TWetBulb)
      else
        HumRatio = ((1220.0 - 0.04 * TWetBulb) * Wsstar - 0.240 * (TDryBulb - TWetBulb))    &
                   / (1220.0 + 0.444 * TDryBulb - 0.48 * TWetBulb)
      end if
    else
      if (TWetBulb >= 0.0) then
        HumRatio = ((2501.0 - 2.326 * TWetBulb) * Wsstar - 1.006 * (TDryBulb - TWetBulb))   &
                   / (2501.0 + 1.86 * TDryBulb - 4.186 * TWetBulb)
      else
           HumRatio = ((2830.0 - 0.24 * TWetBulb) * Wsstar - 1.006 * (TDryBulb - TWetBulb)) &
                      / (2830.0 + 1.86 * TDryBulb - 2.1 * TWetBulb)
      end if
    end if
  end function GetHumRatioFromTWetBulb

  function GetHumRatioFromRelHum(TDryBulb, RelHum, Pressure) result(HumRatio)
    !+ Return humidity ratio given dry-bulb temperature, relative humidity, and pressure.
    !+ Reference:
    !+ ASHRAE Handbook - Fundamentals (2017) ch. 1

    real, intent(in)  ::  TDryBulb
      !+ Dry-bulb temperature in °F [IP] or °C [SI]
    real, intent(in)  ::  RelHum
      !+ Relative humidity in range [0, 1]
    real, intent(in)  ::  Pressure
      !+ Atmospheric pressure in Psi [IP] or Pa [SI]
    real              ::  HumRatio
      !+ Humidity ratio in lb_H₂O lb_Air⁻¹ [IP] or kg_H₂O kg_Air⁻¹ [SI]
    real              ::  VapPres
      !+ Partial pressure of water vapor in moist air in Psi [IP] or Pa [SI]

    if (RelHum < 0.0 .or. RelHum > 1.0) then
      error stop "Error: relative humidity is outside range [0,1]"
    end if

    VapPres   = GetVapPresFromRelHum(TDryBulb, RelHum)
    HumRatio  = GetHumRatioFromVapPres(VapPres, Pressure)
  end function GetHumRatioFromRelHum

  function GetRelHumFromHumRatio(TDryBulb, HumRatio, Pressure) result(RelHum)
  !+ Return relative humidity given dry-bulb temperature, humidity ratio, and pressure.
  !+ Reference:
  !+ ASHRAE Handbook - Fundamentals (2017) ch. 1

    real, intent(in)  ::  TDryBulb
      !+ Dry-bulb temperature in °F [IP] or °C [SI]
    real, intent(in)  ::  HumRatio
      !+ Humidity ratio in lb_H₂O lb_Air⁻¹ [IP] or kg_H₂O kg_Air⁻¹ [SI]
    real, intent(in)  ::  Pressure
      !+ Atmospheric pressure in Psi [IP] or Pa [SI]
    real              ::  RelHum
      !+ Relative humidity in range [0, 1]
    real              ::  VapPres
      !+ Partial pressure of water vapor in moist air in Psi [IP] or Pa [SI]

    if (HumRatio < 0.0) then
      error stop "Error: humidity ratio cannot be negative"
    end if

    VapPres = GetVapPresFromHumRatio(HumRatio, Pressure)
    RelHum  = GetRelHumFromVapPres(TDryBulb, VapPres)
  end function GetRelHumFromHumRatio

  function GetHumRatioFromTDewPoint(TDewPoint, Pressure) result(HumRatio)
    !+ Return humidity ratio given dew-point temperature and pressure.
    !+ Reference:
    !+ ASHRAE Handbook - Fundamentals (2017) ch. 1

    real, intent(in)  ::  TDewPoint
      !+ Dew-point temperature in °F [IP] or °C [SI]
    real, intent(in)  ::  Pressure
      !+ Atmospheric pressure in Psi [IP] or Pa [SI]
    real              ::  HumRatio
      !+ Humidity ratio in lb_H₂O lb_Air⁻¹ [IP] or kg_H₂O kg_Air⁻¹ [SI]
    real              ::  VapPres
      !+ Partial pressure of water vapor in moist air in Psi [IP] or Pa [SI]

    VapPres   = GetSatVapPres(TDewPoint)
    HumRatio  = GetHumRatioFromVapPres(VapPres, Pressure)
  end function GetHumRatioFromTDewPoint

  function GetTDewPointFromHumRatio(TDryBulb, HumRatio, Pressure) result(TDewPoint)
    !+ Return dew-point temperature given dry-bulb temperature, humidity ratio, and pressure.
    !+ Reference:
    !+ ASHRAE Handbook - Fundamentals (2017) ch. 1

    real, intent(in)  ::  TDryBulb
      !+ Dry-bulb temperature in °F [IP] or °C [SI]
    real, intent(in)  ::  HumRatio
      !+ Humidity ratio in lb_H₂O lb_Air⁻¹ [IP] or kg_H₂O kg_Air⁻¹ [SI]
    real, intent(in)  ::  Pressure
      !+ Atmospheric pressure in Psi [IP] or Pa [SI]
    real              ::  TDewPoint
      !+ Dew-point temperature in °F [IP] or °C [SI]
    real              ::  VapPres
      !+ Partial pressure of water vapor in moist air in Psi [IP] or Pa [SI]

    if (HumRatio < 0.0) then
      error stop "Error: humidity ratio cannot be negative"
    end if

    VapPres   = GetVapPresFromHumRatio(HumRatio, Pressure)
    TDewPoint = GetTDewPointFromVapPres(TDryBulb, VapPres)
  end function GetTDewPointFromHumRatio

  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  ! Conversions between humidity ratio and vapor pressure
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

  function GetHumRatioFromVapPres(VapPres, Pressure) result(HumRatio)
    !+ Return humidity ratio given water vapor pressure and atmospheric pressure.
    !+ Reference:
    !+ ASHRAE Fundamentals (2005) ch. 6 eqn. 22;
    !+ ASHRAE Fundamentals (2009) ch. 1 eqn. 22.

    real, intent(in)  ::  VapPres
      !+ Partial pressure of water vapor in moist air in Psi [IP] or Pa [SI]
    real, intent(in)  ::  Pressure
      !+ Atmospheric pressure in Psi [IP] or Pa [SI]
    real              ::  HumRatio
      !+ Humidity ratio in lb_H₂O lb_Air⁻¹ [IP] or kg_H₂O kg_Air⁻¹ [SI]

    if (VapPres < 0.0) then
      error stop "Error: partial pressure of water vapor in moist air cannot be negative"
    end if

    HumRatio = 0.621945 * VapPres / (Pressure-VapPres)
  end function GetHumRatioFromVapPres

  function GetVapPresFromHumRatio(HumRatio, Pressure) result(VapPres)
    !+ Return vapor pressure given humidity ratio and pressure.
    !+ Reference:
    !+ ASHRAE Handbook - Fundamentals (2017) ch. 1 eqn 20 solved for pw

    real, intent(in)  ::  HumRatio
      !+ Humidity ratio in lb_H₂O lb_Air⁻¹ [IP] or kg_H₂O kg_Air⁻¹ [SI]
    real, intent(in)  ::  Pressure
      !+ Atmospheric pressure in Psi [IP] or Pa [SI]
    real              ::  VapPres
      !+ Partial pressure of water vapor in moist air in Psi [IP] or Pa [SI]

    if (HumRatio < 0.0) then
      error stop "Error: humidity ratio is negative"
    end if

    VapPres = Pressure * HumRatio / (0.621945 + HumRatio)
  end function GetVapPresFromHumRatio

  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  ! Dry Air Calculations
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

  function GetDryAirEnthalpy(TDryBulb) result(DryAirEnthalpy)
    !+ Return dry-air enthalpy given dry-bulb temperature.
    !+ Reference:
    !+ ASHRAE Handbook - Fundamentals (2017) ch. 1 eqn 28

    real, intent(in)  ::  TDryBulb
      !+ Dry-bulb temperature in °F [IP] or °C [SI]
    real              ::  DryAirEnthalpy
      !+ Dry air enthalpy in Btu lb⁻¹ [IP] or J kg⁻¹ [SI]

    if (isIP()) then
      DryAirEnthalpy = 0.240 * TDryBulb
    else
      DryAirEnthalpy = 1006 * TDryBulb
    end if
  end function GetDryAirEnthalpy

  function GetDryAirDensity(TDryBulb, Pressure) result(DryAirDensity)
    !+ Return dry-air density given dry-bulb temperature and pressure.
    !+ Reference:
    !+ ASHRAE Handbook - Fundamentals (2017) ch. 1
    !+ Notes:
    !+ Eqn 14 for the perfect gas relationship for dry air.
    !+ Eqn 1 for the universal gas constant.
    !+ The factor 144 in IP is for the conversion of Psi = lb in⁻² to lb ft⁻².

    real, intent(in)  ::  TDryBulb
      !+ Dry-bulb temperature in °F [IP] or °C [SI]
    real, intent(in)  ::  Pressure
      !+ Atmospheric pressure in Psi [IP] or Pa [SI]
    real              ::  DryAirDensity
      !+ Dry air density in lb ft⁻³ [IP] or kg m⁻³ [SI]

    if (isIP()) then
      DryAirDensity = (144 * Pressure) / R_DA_IP / GetTRankineFromTFahrenheit(TDryBulb)
    else
      DryAirDensity = Pressure / R_DA_SI / GetTKelvinFromTCelsius(TDryBulb)
    end if
  end function GetDryAirDensity

  function GetDryAirVolume(TDryBulb, Pressure) result(DryAirVolume)
    !+ Return dry-air volume given dry-bulb temperature and pressure.
    !+ Reference:
    !+ ASHRAE Handbook - Fundamentals (2017) ch. 1
    !+ Notes:
    !+ Eqn 14 for the perfect gas relationship for dry air.
    !+ Eqn 1 for the universal gas constant.
    !+ The factor 144 in IP is for the conversion of Psi = lb in⁻² to lb ft⁻².

    real, intent(in)  ::  TDryBulb
      !+ Dry-bulb temperature in °F [IP] or °C [SI]
    real, intent(in)  ::  Pressure
      !+ Atmospheric pressure in Psi [IP] or Pa [SI]
    real              ::  DryAirVolume
      !+ Dry air volume in ft³ lb⁻¹ [IP] or in m³ kg⁻¹ [SI]

    if (isIP()) then
      DryAirVolume = GetTRankineFromTFahrenheit(TDryBulb) * R_DA_IP / (144 * Pressure)
    else
      DryAirVolume = GetTKelvinFromTCelsius(TDryBulb) * R_DA_SI / Pressure
    end if
  end function GetDryAirVolume

  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  ! Saturated Air Calculations
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

  function GetSatVapPres(TDryBulb) result(SatVapPres)
    !+ Return saturation vapor pressure given dry-bulb temperature.
    !+ Reference:
    !+ ASHRAE Handbook - Fundamentals (2017) ch. 1  eqn 5

    real, intent(in)  ::  TDryBulb
      !+ Dry-bulb temperature in °F [IP] or °C [SI]
    real              ::  SatVapPres
      !+ Vapor pressure of saturated air in Psi [IP] or Pa [SI]
    real              ::  LnPws
      !+ Log of Vapor Pressure of saturated air (dimensionless)
    real              ::  T
      !+ Dry bulb temperature in R [IP] or K [SI]

    if (isIP()) then
      if (TDryBulb < -148.0 .or. TDryBulb > 392.0) then
        error stop "Error: dry bulb temperature must be in range [-148, 392]°F"
      end if

      T = GetTRankineFromTFahrenheit(TDryBulb)

      if (TDryBulb <= 32.) then
        LnPws = (-1.0214165E+04 / T - 4.8932428 - 5.3765794E-03 * T + 1.9202377E-07 * T**2    &
                + 3.5575832E-10 * T**3 - 9.0344688E-14 * T**4 + 4.1635019 * log(T))
      else
        LnPws = -1.0440397E+04 / T - 1.1294650E+01 - 2.7022355E-02* T + 1.2890360E-05 * T**2  &
                - 2.4780681E-09 * T**3 + 6.5459673 * log(T)
      end if

      else
        if (TDryBulb < -100.0 .or. TDryBulb > 200.0) then
          error stop "Error: dry bulb temperature must be in range [-100, 200]°C"
        end if

        T = GetTKelvinFromTCelsius(TDryBulb)

        if (TDryBulb <= 0) then
          LnPws = -5.6745359E+03 / T + 6.3925247 - 9.677843E-03 * T + 6.2215701E-07 * T**2    &
                  + 2.0747825E-09 * T**3 - 9.484024E-13 * T**4 + 4.1635019 * log(T)
        else
          LnPws = -5.8002206E+03 / T + 1.3914993 - 4.8640239E-02 * T + 4.1764768E-05 * T**2   &
                  - 1.4452093E-08 * T**3 + 6.5459673 * log(T)
        end if
      end if

    SatVapPres = exp(LnPws)
  end function GetSatVapPres

  function GetSatHumRatio(TDryBulb, Pressure) result(SatHumRatio)
    !+ Return humidity ratio of saturated air given dry-bulb temperature and pressure.
    !+ Reference:
    !+ ASHRAE Handbook - Fundamentals (2017) ch. 1 eqn 36, solved for W

    real, intent(in)  ::  TDryBulb
      !+ Dry-bulb temperature in °F [IP] or °C [SI]
    real, intent(in)  ::  Pressure
      !+ Atmospheric pressure in Psi [IP] or Pa [SI]
    real              ::  SatHumRatio
      !+ Humidity ratio of saturated air in lb_H₂O lb_Air⁻¹ [IP] or kg_H₂O kg_Air⁻¹ [SI]
    real              ::  SatVaporPres
      !+ Vapor pressure of saturated air in in lb_H₂O lb_Air⁻¹ [IP] or kg_H₂O kg_Air⁻¹ [SI]

    SatVaporPres  = GetSatVapPres(TDryBulb)
    SatHumRatio   = 0.621945 * SatVaporPres / (Pressure-SatVaporPres)
  end function GetSatHumRatio

  function GetSatAirEnthalpy(TDryBulb, Pressure) result(SatAirEnthalpy)
    !+ Return saturated air enthalpy given dry-bulb temperature and pressure.
    !+ Reference:
    !+ ASHRAE Handbook - Fundamentals (2017) ch. 1

    real, intent(in)  ::  TDryBulb
      !+ Dry-bulb temperature in °F [IP] or °C [SI]
    real, intent(in)  ::  Pressure
      !+ Atmospheric pressure in Psi [IP] or Pa [SI]
    real              ::  SatAirEnthalpy
      !+ Saturated air enthalpy in Btu lb⁻¹ [IP] or J kg⁻¹ [SI]

    SatAirEnthalpy = GetMoistAirEnthalpy(TDryBulb, GetSatHumRatio(TDryBulb, Pressure))
  end function GetSatAirEnthalpy

  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  ! Moist Air Calculations
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

  function GetVaporPressureDeficit(TDryBulb, HumRatio, Pressure) result(VaporPressureDeficit)
    !+ Return Vapor pressure deficit given dry-bulb temperature, humidity ratio, and pressure.
    !+ Reference:
    !+ Oke (1987) eqn 2.13a

    real, intent(in)  ::  TDryBulb
      !+ Dry-bulb temperature in °F [IP] or °C [SI]
    real, intent(in)  ::  HumRatio
      !+ Humidity ratio in lb_H₂O lb_Air⁻¹ [IP] or kg_H₂O kg_Air⁻¹ [SI]
    real, intent(in)  ::  Pressure
      !+ Atmospheric pressure in Psi [IP] or Pa [SI]
    real              ::  VaporPressureDeficit
      !+ Vapor pressure deficit in Psi [IP] or Pa [SI]
    real              ::  RelHum
      !+ Relative humidity in range [0, 1]

    if (HumRatio < 0.0) then
      error stop "Error: humidity ratio is negative"
    end if

    RelHum = GetRelHumFromHumRatio(TDryBulb, HumRatio, Pressure)
    VaporPressureDeficit = GetSatVapPres(TDryBulb) * (1.0 - RelHum)
  end function GetVaporPressureDeficit

  function GetDegreeOfSaturation(TDryBulb, HumRatio, Pressure) result(DegreeOfSaturation)
    !+ Return the degree of saturation (i.e humidity ratio of the air / humidity ratio of the air at saturation
    !+ at the same temperature and pressure) given dry-bulb temperature, humidity ratio, and atmospheric pressure.
    !+ Reference:
    !+ ASHRAE Handbook - Fundamentals (2009) ch. 1 eqn 12
    !+ Notes:
    !+ This definition is absent from the 2017 Handbook. Using 2009 version instead.

    real, intent(in)  ::  TDryBulb
      !+ Dry-bulb temperature in °F [IP] or °C [SI]
    real, intent(in)  ::  HumRatio
      !+ Humidity ratio in lb_H₂O lb_Air⁻¹ [IP] or kg_H₂O kg_Air⁻¹ [SI]
    real, intent(in)  ::  Pressure
      !+ Atmospheric pressure in Psi [IP] or Pa [SI]
    real              ::  DegreeOfSaturation
      !+ Degree of saturation in arbitrary unit

    if (HumRatio < 0.0) then
      error stop "Error: humidity ratio is negative"
    end if

    DegreeOfSaturation = HumRatio/GetSatHumRatio(TDryBulb, Pressure)
  end function GetDegreeOfSaturation

  function GetMoistAirEnthalpy(TDryBulb, HumRatio) result(MoistAirEnthalpy)
    !+ Return moist air enthalpy given dry-bulb temperature and humidity ratio.
    !+ Reference:
    !+ ASHRAE Handbook - Fundamentals (2017) ch. 1 eqn 30

    real, intent(in)  ::  TDryBulb
      !+ Dry-bulb temperature in °F [IP] or °C [SI]
    real, intent(in)  ::  HumRatio
      !+ Humidity ratio in lb_H₂O lb_Air⁻¹ [IP] or kg_H₂O kg_Air⁻¹ [SI]
    real              ::  MoistAirEnthalpy
      !+ Moist air enthalpy in Btu lb⁻¹ [IP] or J kg⁻¹

    if (HumRatio < 0.0) then
      error stop "Error: humidity ratio is negative"
    end if

    if (isIP()) then
        MoistAirEnthalpy = 0.240 * TDryBulb + HumRatio * (1061.0 + 0.444 * TDryBulb)
    else
        MoistAirEnthalpy = (1.006 * TDryBulb + HumRatio * (2501.0 + 1.86 * TDryBulb)) * 1000.0
    end if
  end function GetMoistAirEnthalpy

  function GetMoistAirVolume(TDryBulb, HumRatio, Pressure) result(MoistAirVolume)
    !+ Return moist air specific volume given dry-bulb temperature, humidity ratio, and pressure.
    !+ Reference:
    !+ ASHRAE Handbook - Fundamentals (2017) ch. 1 eqn 26
    !+ Notes:
    !+ In IP units, R_DA_IP / 144 equals 0.370486 which is the coefficient appearing in eqn 26
    !+ The factor 144 is for the conversion of Psi = lb in⁻² to lb ft⁻².

    real, intent(in)  ::  TDryBulb
      !+ Dry-bulb temperature in °F [IP] or °C [SI]
    real, intent(in)  ::  HumRatio
      !+ Humidity ratio in lb_H₂O lb_Air⁻¹ [IP] or kg_H₂O kg_Air⁻¹ [SI]
    real, intent(in)  ::  Pressure
      !+ Atmospheric pressure in Psi [IP] or Pa [SI]
    real              ::  MoistAirVolume
      !+ Specific volume of moist air in ft³ lb⁻¹ of dry air [IP] or in m³ kg⁻¹ of dry air [SI]

    if (HumRatio < 0.0) then
      error stop "Error: humidity ratio is negative"
    end if

    if (isIP()) then
        MoistAirVolume = R_DA_IP * GetTRankineFromTFahrenheit(TDryBulb) * (1.0 + 1.607858 * HumRatio) / (144.0 * Pressure)
    else
        MoistAirVolume = R_DA_SI * GetTKelvinFromTCelsius(TDryBulb) * (1.0 + 1.607858 * HumRatio) / Pressure
    end if
  end function GetMoistAirVolume

  function GetMoistAirDensity(TDryBulb, HumRatio, Pressure) result(MoistAirDensity)
    !+ Return moist air density given humidity ratio, dry bulb temperature, and pressure.
    !+ Reference:
    !+ ASHRAE Handbook - Fundamentals (2017) ch. 1 eqn 11

    real, intent(in)  ::  TDryBulb
      !+ Dry-bulb temperature in °F [IP] or °C [SI]
    real, intent(in)  ::  HumRatio
      !+ Humidity ratio in lb_H₂O lb_Air⁻¹ [IP] or kg_H₂O kg_Air⁻¹ [SI]
    real, intent(in)  ::  Pressure
      !+ Atmospheric pressure in Psi [IP] or Pa [SI]
    real              ::  MoistAirDensity
      !+ Moist air density in lb ft⁻³ [IP] or kg m⁻³ [SI]

    if (HumRatio < 0.0) then
      error stop "Error: humidity ratio is negative"
    end if

    MoistAirDensity = (1.0 + HumRatio) / GetMoistAirVolume(TDryBulb, HumRatio, Pressure)
  end function GetMoistAirDensity

  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  ! Standard atmosphere
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

  function GetStandardAtmPressure(Altitude) result(StandardAtmPressure)
    !+ Return standard atmosphere barometric pressure, given the elevation (altitude).
    !+ Reference:
    !+ ASHRAE Handbook - Fundamentals (2017) ch. 1 eqn 3

    real, intent(in)  ::  Altitude
      !+ Altitude in ft [IP] or m [SI]
    real              ::  StandardAtmPressure
      !+ Standard atmosphere barometric pressure in Psi [IP] or Pa [SI]

    if (isIP()) then
        StandardAtmPressure = 14.696 * (1.0 - 6.8754e-06 * Altitude)**5.2559
    else
        StandardAtmPressure = 101325 * (1 - 2.25577e-05 * Altitude)**5.2559
    end if
  end function GetStandardAtmPressure

  function GetStandardAtmTemperature(Altitude) result(StandardAtmTemperature)
    !+ Return standard atmosphere temperature, given the elevation (altitude).
    !+ Reference:
    !+ ASHRAE Handbook - Fundamentals (2017) ch. 1 eqn 4

    real, intent(in)  ::  Altitude
      !+ Altitude in ft [IP] or m [SI]
    real              ::  StandardAtmTemperature
      !+ Standard atmosphere dry-bulb temperature in °F [IP] or °C [SI]

    if (isIP()) then
        StandardAtmTemperature = 59.0 - 0.00356620 * Altitude
    else
        StandardAtmTemperature = 15.0 - 0.0065 * Altitude
    end if
  end function GetStandardAtmTemperature

  function GetSeaLevelPressure(StnPressure, Altitude, TDryBulb) result(SeaLevelPressure)
    !+ Return sea level pressure given dry-bulb temperature, altitude above sea level and pressure.
    !+ Reference:
    !+ Hess SL, Introduction to theoretical meteorology, Holt Rinehart and Winston, NY 1959,
    !+ ch. 6.5; Stull RB, Meteorology for scientists and engineers, 2nd edition,
    !+ Brooks/Cole 2000, ch. 1.
    !+ Notes:
    !+ The standard procedure for the US is to use for TDryBulb the average
    !+ of the current station temperature and the station temperature from 12 hours ago.

    real, intent(in)  ::  StnPressure
      !+ Observed station pressure in Psi [IP] or Pa [SI]
    real, intent(in)  ::  Altitude
      !+ Altitude in ft [IP] or m [SI]
    real, intent(in)  ::  TDryBulb
      !+ Dry-bulb temperature in °F [IP] or °C [SI]
    real              ::  SeaLevelPressure
      !+ Sea level barometric pressure in Psi [IP] or Pa [SI]
    real              ::  TColumn
      !+ Average temperature in column of air in R [IP] or K [SI]
    real              ::  H
      !+ scale height (dimensionless)

    if (isIP()) then
      ! Calculate average temperature in column of air, assuming a lapse rate
      ! of 3.6 °F/1000ft
      TColumn = TDryBulb + 0.0036 * Altitude / 2.0

      ! Determine the scale height
      H = 53.351 * GetTRankineFromTFahrenheit(TColumn)
    else
      ! Calculate average temperature in column of air, assuming a lapse rate
      ! of 6.5 °C/km
      TColumn = TDryBulb + 0.0065 * Altitude / 2.0

      ! Determine the scale height
      H = 287.055 * GetTKelvinFromTCelsius(TColumn) / 9.807
    end if

    ! Calculate the sea level pressure
    SeaLevelPressure = StnPressure * exp(Altitude / H)
  end function GetSeaLevelPressure

  function GetStationPressure(SeaLevelPressure, Altitude, TDryBulb) result(StationPressure)
    !+ Return station pressure from sea level pressure.
    !+ Reference:
    !+ See 'GetSeaLevelPressure'
    !+ Notes:
    !+ This function is just the inverse of 'GetSeaLevelPressure'.

    real, intent(in)  ::  SeaLevelPressure
      !+ Sea level barometric pressure in Psi [IP] or Pa [SI]
    real, intent(in)  ::  Altitude
      !+ Altitude in ft [IP] or m [SI]
    real, intent(in)  ::  TDryBulb
      !+ Dry-bulb temperature in °F [IP] or °C [SI]
    real              ::  StationPressure
      !+ Station pressure in Psi [IP] or Pa [SI]

    StationPressure = SeaLevelPressure / GetSeaLevelPressure(1.0, Altitude, TDryBulb)
  end function GetStationPressure

  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  ! Functions to set all psychrometric values
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

  subroutine CalcPsychrometricsFromTWetBulb(TDryBulb,           &
                                            TWetBulb,           &
                                            Pressure,           &
                                            HumRatio,           &
                                            TDewPoint,          &
                                            RelHum,             &
                                            VapPres,            &
                                            MoistAirEnthalpy,   &
                                            MoistAirVolume,     &
                                            DegreeOfSaturation)

    !+ Utility function to calculate humidity ratio, dew-point temperature, relative humidity,
    !+ vapour pressure, moist air enthalpy, moist air volume, and degree of saturation of air given
    !+ dry-bulb temperature, wet-bulb temperature, and pressure.

    real, intent(in)    ::  TDryBulb
      !+ Dry-bulb temperature in °F [IP] or °C [SI]
    real, intent(in)    ::  TWetBulb
      !+ Wet-bulb temperature in °F [IP] or °C [SI]
    real, intent(in)    ::  Pressure
      !+ Atmospheric pressure in Psi [IP] or Pa [SI]
    real, intent(out)   ::  HumRatio
      !+ Humidity ratio in lb_H₂O lb_Air⁻¹ [IP] or kg_H₂O kg_Air⁻¹ [SI]
    real, intent(out)   ::  TDewPoint
      !+ Dew-point temperature in °F [IP] or °C [SI]
    real, intent(out)   ::  RelHum
      !+ Relative humidity in range [0, 1]
    real, intent(out)   ::  VapPres
      !+ Partial pressure of water vapor in moist air in Psi [IP] or Pa [SI]
    real, intent(out)   ::  MoistAirEnthalpy
      !+ Moist air enthalpy in Btu lb⁻¹ [IP] or J kg⁻¹ [SI]
    real, intent(out)   ::  MoistAirVolume
      !+ Specific volume of moist air in ft³ lb⁻¹ [IP] or in m³ kg⁻¹ [SI]
    real, intent(out)   ::  DegreeOfSaturation
      !+ Degree of saturation [unitless]

    HumRatio            = GetHumRatioFromTWetBulb(TDryBulb, TWetBulb, Pressure)
    TDewPoint           = GetTDewPointFromHumRatio(TDryBulb, HumRatio, Pressure)
    RelHum              = GetRelHumFromHumRatio(TDryBulb, HumRatio, Pressure)
    VapPres             = GetVapPresFromHumRatio(HumRatio, Pressure)
    MoistAirEnthalpy    = GetMoistAirEnthalpy(TDryBulb, HumRatio)
    MoistAirVolume      = GetMoistAirVolume(TDryBulb, HumRatio, Pressure)
    DegreeOfSaturation  = GetDegreeOfSaturation(TDryBulb, HumRatio, Pressure)
  end subroutine CalcPsychrometricsFromTWetBulb

  subroutine CalcPsychrometricsFromTDewPoint(TDryBulb,           &
                                             TDewPoint,          &
                                             Pressure,           &
                                             HumRatio,           &
                                             TWetBulb,           &
                                             RelHum,             &
                                             VapPres,            &
                                             MoistAirEnthalpy,   &
                                             MoistAirVolume,     &
                                             DegreeOfSaturation)

    !+ Utility function to calculate humidity ratio, wet-bulb temperature, relative humidity,
    !+ vapour pressure, moist air enthalpy, moist air volume, and degree of saturation of air given
    !+ dry-bulb temperature, dew-point temperature, and pressure.

    real, intent(in)    ::  TDryBulb
      !+ Dry-bulb temperature in °F [IP] or °C [SI]
    real, intent(in)    ::  TDewPoint
      !+ Dew-point temperature in °F [IP] or °C [SI]
    real, intent(in)    ::  Pressure
      !+ Atmospheric pressure in Psi [IP] or Pa [SI]
    real, intent(out)   ::  HumRatio
      !+ Humidity ratio in lb_H₂O lb_Air⁻¹ [IP] or kg_H₂O kg_Air⁻¹ [SI]
    real, intent(out)   ::  TWetBulb
      !+ Wet-bulb temperature in °F [IP] or °C [SI]
    real, intent(out)   ::  RelHum
      !+ Relative humidity in range [0, 1]
    real, intent(out)   ::  VapPres
      !+ Partial pressure of water vapor in moist air in Psi [IP] or Pa [SI]
    real, intent(out)   ::  MoistAirEnthalpy
      !+ Moist air enthalpy in Btu lb⁻¹ [IP] or J kg⁻¹ [SI]
    real, intent(out)   ::  MoistAirVolume
      !+ Specific volume of moist air in ft³ lb⁻¹ [IP] or in m³ kg⁻¹ [SI]
    real, intent(out)   ::  DegreeOfSaturation
      !+ Degree of saturation [unitless]

    HumRatio            = GetHumRatioFromTDewPoint(TDewPoint, Pressure)
    TWetBulb            = GetTWetBulbFromHumRatio(TDryBulb, HumRatio, Pressure)
    RelHum              = GetRelHumFromHumRatio(TDryBulb, HumRatio, Pressure)
    VapPres             = GetVapPresFromHumRatio(HumRatio, Pressure)
    MoistAirEnthalpy    = GetMoistAirEnthalpy(TDryBulb, HumRatio)
    MoistAirVolume      = GetMoistAirVolume(TDryBulb, HumRatio, Pressure)
    DegreeOfSaturation  = GetDegreeOfSaturation(TDryBulb, HumRatio, Pressure)
  end subroutine CalcPsychrometricsFromTDewPoint

  subroutine CalcPsychrometricsFromRelHum(TDryBulb,           &
                                          RelHum,             &
                                          Pressure,           &
                                          HumRatio,           &
                                          TWetBulb,           &
                                          TDewPoint,          &
                                          VapPres,            &
                                          MoistAirEnthalpy,   &
                                          MoistAirVolume,     &
                                          DegreeOfSaturation)

    !+ Utility function to calculate humidity ratio, wet-bulb temperature, dew-point temperature,
    !+ vapour pressure, moist air enthalpy, moist air volume, and degree of saturation of air given
    !+ dry-bulb temperature, relative humidity and pressure.

    real, intent(in)    ::  TDryBulb
      !+ Dry-bulb temperature in °F [IP] or °C [SI]
    real, intent(in)    ::  RelHum
      !+ Relative humidity in range [0, 1]
    real, intent(in)    ::  Pressure
      !+ Atmospheric pressure in Psi [IP] or Pa [SI]
    real, intent(out)   ::  HumRatio
      !+ Humidity ratio in lb_H₂O lb_Air⁻¹ [IP] or kg_H₂O kg_Air⁻¹ [SI]
    real, intent(out)   ::  TWetBulb
      !+ Wet-bulb temperature in °F [IP] or °C [SI]
    real, intent(out)   ::  TDewPoint
      !+ Dew-point temperature in °F [IP] or °C [SI]
    real, intent(out)   ::  VapPres
      !+ Partial pressure of water vapor in moist air in Psi [IP] or Pa [SI]
    real, intent(out)   ::  MoistAirEnthalpy
      !+ Moist air enthalpy in Btu lb⁻¹ [IP] or J kg⁻¹ [SI]
    real, intent(out)   ::  MoistAirVolume
      !+ Specific volume of moist air in ft³ lb⁻¹ [IP] or in m³ kg⁻¹ [SI]
    real, intent(out)   ::  DegreeOfSaturation
      !+ Degree of saturation [unitless]

    HumRatio            = GetHumRatioFromRelHum(TDryBulb, RelHum, Pressure)
    TWetBulb            = GetTWetBulbFromHumRatio(TDryBulb, HumRatio, Pressure)
    TDewPoint           = GetTDewPointFromHumRatio(TDryBulb, HumRatio, Pressure)
    VapPres             = GetVapPresFromHumRatio(HumRatio, Pressure)
    MoistAirEnthalpy    = GetMoistAirEnthalpy(TDryBulb, HumRatio)
    MoistAirVolume      = GetMoistAirVolume(TDryBulb, HumRatio, Pressure)
    DegreeOfSaturation  = GetDegreeOfSaturation(TDryBulb, HumRatio, Pressure)
  end subroutine CalcPsychrometricsFromRelHum

end module psychrolib


!==============================================================================!
  subroutine Surf_Mod_Calculate_Element_Normals(surf, phi)
!------------------------------------------------------------------------------!
!   Calculates element normals                                                 !
!------------------------------------------------------------------------------!
  implicit none
!---------------------------------[Arguments]----------------------------------!
  type(Surf_Type), target :: surf
  type(Var_Type),  target :: phi
!-----------------------------------[Locals]-----------------------------------!
  type(Vert_Type), pointer :: vert(:)
  type(Elem_Type), pointer :: elem(:)
  integer,         pointer :: nv, ne
  integer                  :: c, e, j
  real                     :: surf_v(3)
  real                     :: a(3), b(3), tri_v(3), tri_v_m
!==============================================================================!

  ! Take aliases
  nv   => surf % n_verts
  ne   => surf % n_elems
  vert => surf % vert
  elem => surf % elem

  !---------------------------------!
  !   Browse through all elements   !   (in the future, only for this_proc)
  !---------------------------------!
  do e = 1, ne

    a(1) = vert(elem(e) % j) % x_n - vert(elem(e) % i) % x_n
    a(2) = vert(elem(e) % j) % y_n - vert(elem(e) % i) % y_n
    a(3) = vert(elem(e) % j) % z_n - vert(elem(e) % i) % z_n

    b(1) = vert(elem(e) % k) % x_n - vert(elem(e) % i) % x_n
    b(2) = vert(elem(e) % k) % y_n - vert(elem(e) % i) % y_n
    b(3) = vert(elem(e) % k) % z_n - vert(elem(e) % i) % z_n

    tri_v = Math_Mod_Cross_Product(a, b)

    ! Magnitude of the cross produc
    tri_v_m = sqrt(tri_v(1)**2 + tri_v(2)**2 + tri_v(3)**2)

    elem(e) % nx = tri_v(1) / tri_v_m
    elem(e) % ny = tri_v(2) / tri_v_m
    elem(e) % nz = tri_v(3) / tri_v_m

    do j = 1, 3

      ! Take the closest cell
      if(j .eq. 1) c = vert(elem(e) % i) % cell
      if(j .eq. 2) c = vert(elem(e) % j) % cell
      if(j .eq. 3) c = vert(elem(e) % k) % cell

      ! Surface vector
      surf_v(1) = phi % x(c)
      surf_v(2) = phi % y(c)
      surf_v(3) = phi % z(c)

      if(dot_product(surf_v, tri_v) < 0.0) then
        print *, '# Error, element ', e, 'is not properly oriented!'
        stop
      end if
    end do   ! for i, j, k

  end do

  end subroutine


!! # check to see if value exceeds threshold

logical function difference_exceeds_th(blockno,&
                                     qval,qmin,qmax,quad, &
                                     dx,dy,xc,yc,threshhold)
    implicit none

    double precision :: qval,qmin,qmax,threshhold
    double precision :: quad(-1:1,-1:1)
    double precision :: dx,dy, xc, yc
    integer :: blockno

    double precision :: dqx, dqy, dq
    logical :: refine

    refine = .false.

    dqx = abs(quad(1,0) - quad(-1,0))
    dqy = abs(quad(0,1) - quad(0,-1))
    dq  = max(dqx, dqy)

    if (dq .gt. threshhold) then
        refine = .true.
    endif

    difference_exceeds_th = refine

end function difference_exceeds_th

double precision function gradient_dot(u,v)
    implicit none

    double precision :: u(3), v(3)

    gradient_dot = u(1)*v(1) + u(2)*v(2) + u(3)*v(3)

end function gradient_dot


program test
  implicit none
  integer,parameter :: seed = 86456
  real, dimension(1:5) :: a
  integer :: i
  print *, '---------------------test mod(a, b)--------------'
  print *, 'mod(12., 3.)',mod(12., 3.)
  print *, 'How computer calculate mod(12. ,mod(12., 7.))?', mod(12.,mod(12., 7.))
  print *, 'int(12.,7.)',int(12./7.)
  print *, '----------------------test rand()-----------------'

  call srand(seed)
  print *, rand(), rand(), rand(), rand()
  print *, rand(seed), rand(), rand(), rand()
  open(9,file = 'RandomNumber.dat', status='unknown')
  do i = 1, 10000
     write (9,*)i, rand()
  end do
  close(9)

  print *, '-----------------test random_number()-------------'
  call random_number(a)
  print *, a

end program test


!
! Copyright (c) 2000-2008, Roland Schmehl. All rights reserved.
!
! This software is distributable under the BSD license. See the terms of the
! BSD license in the documentation provided with this software.
!
MODULE FortranParser
  !------- -------- --------- --------- --------- --------- --------- --------- -------
  ! Fortran 2008 function parser
  !------- -------- --------- --------- --------- --------- --------- --------- -------
  !
  ! This is an OOP Fortran 2008 version of the original fparser by Roland Schmehl. This simple class
  ! wrapping of the original fparser has been developed by Jacopo Chevallard, and it is available on
  ! the GitHub repository https://github.com/jacopo-chevallard/FortranParser.
  !
  ! For comments and bug reports, please open an issue on
  ! https://github.com/jacopo-chevallard/FortranParser/issues
  !
  ! This function parser module is intended for applications where a set of mathematical
  ! fortran-style expressions is specified at runtime and is then evaluated for a large
  ! number of variable values. This is done by compiling the set of function strings
  ! into byte code, which is interpreted efficiently for the various variable values.
  !
  ! The source code of the original fparser is available from http://fparser.sourceforge.net
  !
  ! Please send comments, corrections or questions realtive to the original fparser to its author:
  ! Roland Schmehl <roland.schmehl@alumni.uni-karlsruhe.de>
  !
  !------- -------- --------- --------- --------- --------- --------- --------- -------
  ! The function parser concept is based on a C++ class library written by  Juha
  ! Nieminen <warp@iki.fi> available from http://warp.povusers.org/FunctionParser/
  !------- -------- --------- --------- --------- --------- --------- --------- -------
  USE FortranParser_parameters, ONLY: rn,is               ! Import KIND parameters

  IMPLICIT NONE

  PUBLIC                     :: EquationParser

  !------- -------- --------- --------- --------- --------- --------- --------- -------
  PRIVATE

  INTEGER(is),                              PARAMETER :: cImmed   = 1,          &
                                                         cNeg     = 2,          &
                                                         cAdd     = 3,          &
                                                         cSub     = 4,          &
                                                         cMul     = 5,          &
                                                         cDiv     = 6,          &
                                                         cPow     = 7,          &
                                                         cAbs     = 8,          &
                                                         cExp     = 9,          &
                                                         cLog10   = 10,         &
                                                         cLog     = 11,         &
                                                         cSqrt    = 12,         &
                                                         cSinh    = 13,         &
                                                         cCosh    = 14,         &
                                                         cTanh    = 15,         &
                                                         cSin     = 16,         &
                                                         cCos     = 17,         &
                                                         cTan     = 18,         &
                                                         cAsin    = 19,         &
                                                         cAcos    = 20,         &
                                                         cAtan    = 21,         &
                                                         VarBegin = 22

  CHARACTER (LEN=1), DIMENSION(cAdd:cPow),  PARAMETER :: Ops      = (/ '+',     &
                                                                       '-',     &
                                                                       '*',     &
                                                                       '/',     &
                                                                       '^' /)

  CHARACTER (LEN=5), DIMENSION(cAbs:cAtan), PARAMETER :: Funcs    = (/ 'abs  ', &
                                                                       'exp  ', &
                                                                       'log10', &
                                                                       'log  ', &
                                                                       'sqrt ', &
                                                                       'sinh ', &
                                                                       'cosh ', &
                                                                       'tanh ', &
                                                                       'sin  ', &
                                                                       'cos  ', &
                                                                       'tan  ', &
                                                                       'asin ', &
                                                                       'acos ', &
                                                                       'atan ' /)

  INTEGER, parameter  :: MAX_FUN_LENGTH = 1024

  TYPE EquationParser

    INTEGER(is), POINTER :: ByteCode(:) => null()
    INTEGER              :: ByteCodeSize = 0
    REAL(rn),    POINTER :: Immed(:) => null()
    INTEGER              :: ImmedSize = 0
    REAL(rn),    POINTER :: Stack(:) => null()
    INTEGER              :: StackSize = 0
    INTEGER              :: StackPtr = 0
    INTEGER              :: Error = 0

    character(len=MAX_FUN_LENGTH) :: funcString = ''
    character(len=MAX_FUN_LENGTH) :: funcStringOrig = ''
    character(len=MAX_FUN_LENGTH), allocatable :: variableNames(:)
    contains

      private

      procedure, public :: evaluate
      procedure:: parse
      procedure :: Compile
      procedure :: AddCompiledByte
      procedure :: CompileSubstr
      procedure :: MathItemIndex
      procedure :: CheckSyntax

      final :: finalize

  END TYPE EquationParser

  ! Class constructor
  interface EquationParser
    procedure constructor
  end interface EquationParser

CONTAINS

!*****************************************************************************************
  type (EquationParser) function constructor(FuncStr, Var)

    CHARACTER (LEN=*),               INTENT(in) :: FuncStr   ! Function string
    CHARACTER (LEN=*), DIMENSION(:), INTENT(in) :: Var       ! Array with variable names

    constructor%ByteCode => null()
    constructor%Immed => null()
    constructor%Stack => null()

    constructor%ByteCodeSize = 0
    constructor%ImmedSize = 0
    constructor%StackSize = 0
    constructor%StackPtr = 0

    constructor%funcString = FuncStr
    constructor%funcStringOrig = FuncStr

    allocate(constructor%variableNames(size(Var)))

    constructor%variableNames(:) = Var(:)

    call constructor%parse()

  end function constructor

!*****************************************************************************************
  subroutine finalize(this)

    type(EquationParser) :: this

    if (associated(this%ByteCode))  nullify(this%ByteCode)
    if (associated(this%Immed))     nullify(this%Immed)
    if (associated(this%Stack))     nullify(this%Stack)

  end subroutine finalize

!*****************************************************************************************
  SUBROUTINE parse(this)
    ! Parse ith function string FuncStr and compile it into bytecode
    class(EquationParser) :: this

    CALL Replace('**','^ ', this%funcString)                            ! Exponent into 1-Char. format

    CALL RemoveSpaces(this%funcString)                                 ! Condense function string

    CALL this%CheckSyntax()

    CALL this%Compile()                                ! Compile into bytecode

  END SUBROUTINE parse

!*****************************************************************************************
  FUNCTION evaluate(this, Val, Error) RESULT (res)
    ! Evaluate bytecode of ith function for the values passed in array Val(:)
    class(EquationParser) :: this
    REAL(rn), DIMENSION(:), INTENT(in) :: Val                ! Variable values
    INTEGER, optional,      intent(out):: Error              ! Error code
    REAL(rn)                           :: res                ! Result
    INTEGER                            :: IP,              & ! Instruction pointer
                                          DP,              & ! Data pointer
                                          SP                 ! Stack pointer
    REAL(rn),                PARAMETER :: zero = 0._rn
    integer       :: EvalErrType

    IF (present(Error)) Error = 0

    IF (this%Error /= 0) then
      WRITE(*,*)'*** Error: Syntax or compilation error'
      IF (present(Error)) Error = this%Error
      return
    ENDIF

    DP = 1
    SP = 0
    EvalErrType=0

    DO IP=1,this%ByteCodeSize

       SELECT CASE (this%ByteCode(IP))

       CASE (cImmed); SP=SP+1; this%Stack(SP)=this%Immed(DP); DP=DP+1

       CASE   (cNeg); this%Stack(SP)=-this%Stack(SP)

       CASE   (cAdd); this%Stack(SP-1)=this%Stack(SP-1)+this%Stack(SP); SP=SP-1

       CASE   (cSub); this%Stack(SP-1)=this%Stack(SP-1)-this%Stack(SP); SP=SP-1

       CASE   (cMul); this%Stack(SP-1)=this%Stack(SP-1)*this%Stack(SP); SP=SP-1

       CASE   (cDiv)

         IF (this%Stack(SP)==0._rn) THEN
           EvalErrType=1
           res=zero
           exit
         ENDIF
         this%Stack(SP-1)=this%Stack(SP-1)/this%Stack(SP); SP=SP-1

       CASE   (cPow); this%Stack(SP-1)=this%Stack(SP-1)**this%Stack(SP); SP=SP-1

       CASE   (cAbs); this%Stack(SP)=ABS(this%Stack(SP))

       CASE   (cExp); this%Stack(SP)=EXP(this%Stack(SP))

       CASE (cLog10)

         IF (this%Stack(SP)<=0._rn) THEN
           EvalErrType=3
           res=zero
           exit
         ENDIF
         this%Stack(SP)=LOG10(this%Stack(SP))

       CASE   (cLog)

         IF (this%Stack(SP)<=0._rn) THEN
           EvalErrType=3
           res=zero
           exit
         ENDIF
         this%Stack(SP)=LOG(this%Stack(SP))

       CASE  (cSqrt)

         IF (this%Stack(SP)<0._rn) THEN
           EvalErrType=3
           res=zero
           exit
         ENDIF
         this%Stack(SP)=SQRT(this%Stack(SP))

       CASE  (cSinh); this%Stack(SP)=SINH(this%Stack(SP))

       CASE  (cCosh); this%Stack(SP)=COSH(this%Stack(SP))

       CASE  (cTanh); this%Stack(SP)=TANH(this%Stack(SP))

       CASE   (cSin); this%Stack(SP)=SIN(this%Stack(SP))

       CASE   (cCos); this%Stack(SP)=COS(this%Stack(SP))

       CASE   (cTan); this%Stack(SP)=TAN(this%Stack(SP))

       CASE  (cAsin)

         IF ((this%Stack(SP)<-1._rn) .OR. (this%Stack(SP)>1._rn)) THEN
           EvalErrType=4
           res=zero
           exit
         ENDIF
         this%Stack(SP)=ASIN(this%Stack(SP))

       CASE  (cAcos);
         IF ((this%Stack(SP)<-1._rn).OR.(this%Stack(SP)>1._rn)) THEN
           EvalErrType=4
           res=zero
           exit
         ENDIF
         this%Stack(SP)=ACOS(this%Stack(SP))

       CASE  (cAtan); this%Stack(SP)=ATAN(this%Stack(SP))

       CASE  DEFAULT; SP=SP+1; this%Stack(SP)=Val(this%ByteCode(IP)-VarBegin+1)

       END SELECT

    END DO

    IF (EvalErrType > 0) then
      IF (present(Error)) Error = EvalErrType
      WRITE(*,*)'*** Error: ',EvalErrMsg(EvalErrType)
    else
      res = this%Stack(1)
    endif

  END FUNCTION evaluate

!*****************************************************************************************
  SUBROUTINE CheckSyntax(this)
    ! Check syntax of function string,  returns 0 if syntax is ok
    class(EquationParser) :: this
    INTEGER(is)                                 :: n
    CHARACTER (LEN=1)                           :: c
    REAL(rn)                                    :: r
    LOGICAL                                     :: err
    INTEGER                                     :: ParCnt, & ! Parenthesis counter
                                                   j,ib,in,lFunc

    IF (this%Error /= 0) return
    j = 1
    ParCnt = 0
    lFunc = LEN_TRIM(this%funcString)
    step: DO
       IF (j > lFunc) THEN; CALL ParseErrMsg (j, this%funcStringOrig, this%Error); return; ENDIF
       c = this%funcString(j:j)
       !-- -------- --------- --------- --------- --------- --------- --------- -------
       ! Check for valid operand (must appear)
       !-- -------- --------- --------- --------- --------- --------- --------- -------
       IF (c == '-' .OR. c == '+') THEN                      ! Check for leading - or +
          j = j+1
          IF (j > lFunc) THEN; CALL ParseErrMsg (j, this%funcStringOrig, this%Error, 'Missing operand'); return; ENDIF
          c = this%funcString(j:j)
          IF (ANY(c == Ops)) THEN; CALL ParseErrMsg (j, this%funcStringOrig, this%Error, 'Multiple operators'); return; ENDIF
       END IF
       n = MathFunctionIndex (this%funcString(j:))
       IF (n > 0) THEN                                       ! Check for math function
          j = j+LEN_TRIM(Funcs(n))
          IF (j > lFunc) THEN; CALL ParseErrMsg (j, this%funcStringOrig, this%Error, 'Missing function argument'); return; ENDIF
          c = this%funcString(j:j)
          IF (c /= '(') THEN; CALL ParseErrMsg (j, this%funcStringOrig, this%Error, 'Missing opening parenthesis'); return; ENDIF
       END IF
       IF (c == '(') THEN                                    ! Check for opening parenthesis
          ParCnt = ParCnt+1
          j = j+1
          CYCLE step
       END IF
       IF (SCAN(c,'0123456789.') > 0) THEN                   ! Check for number
          r = RealNum (this%funcString(j:),ib,in,err)
          IF (err) THEN; CALL ParseErrMsg (j, this%funcStringOrig, this%Error, 'Invalid number format:  '//this%funcString(j+ib-1:j+in-2)); return; ENDIF
          j = j+in-1
          IF (j > lFunc) EXIT
          c = this%funcString(j:j)
       ELSE                                                  ! Check for variable
          n = VariableIndex (this%funcString(j:),this%variableNames,ib,in)
          IF (n == 0) THEN; CALL ParseErrMsg (j, this%funcStringOrig, this%Error, 'Invalid element: '//this%funcString(j+ib-1:j+in-2)); return; ENDIF
          j = j+in-1
          IF (j > lFunc) EXIT
          c = this%funcString(j:j)
       END IF
       DO WHILE (c == ')')                                   ! Check for closing parenthesis
          ParCnt = ParCnt-1
          IF (ParCnt < 0) THEN; CALL ParseErrMsg (j, this%funcStringOrig, this%Error, 'Mismatched parenthesis'); return; ENDIF
          IF (this%funcString(j-1:j-1) == '(') THEN; CALL ParseErrMsg (j-1, this%funcStringOrig, this%Error, 'Empty parentheses'); return; ENDIF
          j = j+1
          IF (j > lFunc) EXIT
          c = this%funcString(j:j)
       END DO
       !-- -------- --------- --------- --------- --------- --------- --------- -------
       ! Now, we have a legal operand: A legal operator or end of string must follow
       !-- -------- --------- --------- --------- --------- --------- --------- -------
       IF (j > lFunc) EXIT
       IF (ANY(c == Ops)) THEN                               ! Check for multiple operators
          IF (j+1 > lFunc) THEN; CALL ParseErrMsg (j, this%funcStringOrig, this%Error); return; ENDIF
          IF (ANY(this%funcString(j+1:j+1) == Ops)) THEN; CALL ParseErrMsg (j+1, this%funcStringOrig, this%Error, 'Multiple operators'); return; ENDIF
       ELSE                                                  ! Check for next operand
          CALL ParseErrMsg (j, this%funcStringOrig, this%Error, 'Missing operator'); return
       END IF
       !-- -------- --------- --------- --------- --------- --------- --------- -------
       ! Now, we have an operand and an operator: the next loop will check for another
       ! operand (must appear)
       !-- -------- --------- --------- --------- --------- --------- --------- -------
       j = j+1
    END DO step
    IF (ParCnt > 0) CALL ParseErrMsg (j, this%funcStringOrig, this%Error, 'Missing )')
  END SUBROUTINE CheckSyntax

!*****************************************************************************************
  FUNCTION EvalErrMsg(EvalErrType) RESULT (msg)
    ! Return error message
    integer, intent(in) :: EvalErrType
    CHARACTER (LEN=*), DIMENSION(4), PARAMETER :: m = (/ 'Division by zero                ', &
                                                         'Argument of SQRT negative       ', &
                                                         'Argument of LOG negative        ', &
                                                         'Argument of ASIN or ACOS illegal' /)
    CHARACTER (LEN=LEN(m))                     :: msg
    !----- -------- --------- --------- --------- --------- --------- --------- -------
    IF (EvalErrType < 1 .OR. EvalErrType > SIZE(m)) THEN
       msg = ''
    ELSE
       msg = m(EvalErrType)
    ENDIF

  END FUNCTION EvalErrMsg

!*****************************************************************************************
  SUBROUTINE ParseErrMsg (j, FuncStr, Error, Msg)
    ! Print error message and terminate program
    INTEGER,                     INTENT(in) :: j
    CHARACTER (LEN=*),           INTENT(in) :: FuncStr       ! Original function string
    INTEGER,                     INTENT(out):: Error
    CHARACTER (LEN=*), OPTIONAL, INTENT(in) :: Msg

    Error = -1
    IF (PRESENT(Msg)) THEN
       WRITE(*,*) '*** Error in syntax of function string: '//Msg
    ELSE
       WRITE(*,*) '*** Error in syntax of function string:'
    ENDIF

    WRITE(*,*)
    WRITE(*,'(A)') ' '//FuncStr

    WRITE(*,'(A)') '?'
  END SUBROUTINE ParseErrMsg

!*****************************************************************************************
  FUNCTION OperatorIndex (c) RESULT (n)
    ! Return operator index
    CHARACTER (LEN=1), INTENT(in) :: c
    INTEGER(is)                   :: n,j

    n = 0

    DO j=cAdd,cPow
       IF (c == Ops(j)) THEN
          n = j
          EXIT
       END IF
    END DO

  END FUNCTION OperatorIndex

!*****************************************************************************************
  FUNCTION MathFunctionIndex (str) RESULT (n)
    ! Return index of math function beginnig at 1st position of string str
    CHARACTER (LEN=*), INTENT(in) :: str

    INTEGER(is)                   :: n,j
    INTEGER                       :: k
    CHARACTER (LEN=LEN(Funcs))    :: fun

    n = 0

    DO j=cAbs,cAtan                                          ! Check all math functions
       k = MIN(LEN_TRIM(Funcs(j)), LEN(str))
       CALL LowCase (str(1:k), fun)
       IF (fun == Funcs(j)) THEN                             ! Compare lower case letters
          n = j                                              ! Found a matching function
          EXIT
       END IF
    END DO

  END FUNCTION MathFunctionIndex

!*****************************************************************************************
  FUNCTION VariableIndex (str, Var, ibegin, inext) RESULT (n)
    !----- -------- --------- --------- --------- --------- --------- --------- -------
    ! Return index of variable at begin of string str (returns 0 if no variable found)
    !----- -------- --------- --------- --------- --------- --------- --------- -------
    IMPLICIT NONE
    CHARACTER (LEN=*),               INTENT(in) :: str       ! String
    CHARACTER (LEN=*), DIMENSION(:), INTENT(in) :: Var       ! Array with variable names
    INTEGER(is)                                 :: n         ! Index of variable
    INTEGER, OPTIONAL,              INTENT(out) :: ibegin, & ! Start position of variable name
                                                   inext     ! Position of character after name
    INTEGER                                     :: j,ib,in,lstr
    !----- -------- --------- --------- --------- --------- --------- --------- -------
    n = 0
    lstr = LEN_TRIM(str)
    IF (lstr > 0) THEN
       DO ib=1,lstr                                          ! Search for first character in str
          IF (str(ib:ib) /= ' ') EXIT                        ! When lstr>0 at least 1 char in str
       END DO
       DO in=ib,lstr                                         ! Search for name terminators
          IF (SCAN(str(in:in),'+-*/^) ') > 0) EXIT
       END DO
       DO j=1,SIZE(Var)
          IF (str(ib:in-1) == Var(j)) THEN
             n = j                                           ! Variable name found
             EXIT
          END IF
       END DO
    END IF
    IF (PRESENT(ibegin)) ibegin = ib
    IF (PRESENT(inext))  inext  = in
  END FUNCTION VariableIndex

!*****************************************************************************************
  SUBROUTINE RemoveSpaces (str)
    ! Remove Spaces from string, remember positions of characters in old string
    CHARACTER (LEN=*), INTENT(inout) :: str

    INTEGER                          :: k,lstr

    lstr = LEN_TRIM(str)

    k = 1

    DO WHILE (str(k:lstr) /= ' ')
       IF (str(k:k) == ' ') THEN
          str(k:lstr)  = str(k+1:lstr)//' '                  ! Move 1 character to left
          k = k-1
       END IF
       k = k+1
    END DO

  END SUBROUTINE RemoveSpaces

!*****************************************************************************************
  SUBROUTINE Replace (ca,cb,str)
    ! Replace ALL appearances of character set ca in string str by character set cb
    CHARACTER (LEN=*),       INTENT(in) :: ca
    CHARACTER (LEN=LEN(ca)), INTENT(in) :: cb                ! LEN(ca) must be LEN(cb)
    CHARACTER (LEN=*),    INTENT(inout) :: str

    INTEGER                             :: j,lca

    lca = LEN(ca)

    DO j=1,LEN_TRIM(str)-lca+1
       IF (str(j:j+lca-1) == ca) str(j:j+lca-1) = cb
    END DO

  END SUBROUTINE Replace

!*****************************************************************************************
  SUBROUTINE Compile(this)
    ! Compile i-th function string F into bytecode
    class(EquationParser) :: this
    INTEGER                                     :: istat

    IF (this%Error /= 0) return

    IF (ASSOCIATED(this%ByteCode)) DEALLOCATE ( this%ByteCode, &
                                                   this%Immed,    &
                                                   this%Stack     )
    this%ByteCodeSize = 0
    this%ImmedSize    = 0
    this%StackSize    = 0
    this%StackPtr     = 0

    CALL this%CompileSubstr(1,LEN_TRIM(this%funcString))               ! Compile string to determine size

    ALLOCATE ( this%ByteCode(this%ByteCodeSize), &
               this%Immed(this%ImmedSize),       &
               this%Stack(this%StackSize),       &
               STAT = istat                            )
    IF (istat /= 0) THEN
       WRITE(*,*) '*** Parser error: Memmory allocation for byte code failed'
       this%Error = -1
    ELSE
       this%ByteCodeSize = 0
       this%ImmedSize    = 0
       this%StackSize    = 0
       this%StackPtr     = 0
       CALL this%CompileSubstr(1,LEN_TRIM(this%funcString))            ! Compile string into bytecode
    END IF

  END SUBROUTINE Compile

!*****************************************************************************************
  SUBROUTINE AddCompiledByte(this, b)
    ! Add compiled byte to bytecode
    class(EquationParser) :: this
    INTEGER(is), INTENT(in) :: b                             ! Value of byte to be added

    this%ByteCodeSize = this%ByteCodeSize + 1

    IF (ASSOCIATED(this%ByteCode)) then
      this%ByteCode(this%ByteCodeSize) = b
    endif

  END SUBROUTINE AddCompiledByte

!*****************************************************************************************
  FUNCTION MathItemIndex(this, b, e) RESULT (n)
    ! Return math item index, if item is real number, enter it into Comp-structure
    class(EquationParser) :: this

    INTEGER,           INTENT(in) :: b,e                     ! First and last pos. of substring
    INTEGER(is)                                 :: n         ! Byte value of math item

    n = 0

    IF (SCAN(this%funcString(b:b),'0123456789.') > 0) THEN                 ! Check for begin of a number
       this%ImmedSize = this%ImmedSize + 1
       IF (ASSOCIATED(this%Immed)) this%Immed(this%ImmedSize) = RealNum(this%funcString(b:e))
       n = cImmed
    ELSE                                                     ! Check for a variable
       n = VariableIndex(this%funcString(b:e), this%variableNames)
       IF (n > 0) n = VarBegin+n-1
    END IF

  END FUNCTION MathItemIndex

!*****************************************************************************************
  FUNCTION CompletelyEnclosed (F, b, e) RESULT (res)
    ! Check if function substring F(b:e) is completely enclosed by a pair of parenthesis
    CHARACTER (LEN=*), INTENT(in) :: F                       ! Function substring
    INTEGER,           INTENT(in) :: b,e                     ! First and last pos. of substring

    LOGICAL                       :: res
    INTEGER                       :: j,k

    res=.false.

    IF (F(b:b) == '(' .AND. F(e:e) == ')') THEN
       k = 0
       DO j=b+1,e-1
          IF     (F(j:j) == '(') THEN
             k = k+1
          ELSEIF (F(j:j) == ')') THEN
             k = k-1
          END IF
          IF (k < 0) EXIT
       END DO
       IF (k == 0) res=.true.                                ! All opened parenthesis closed
    END IF

  END FUNCTION CompletelyEnclosed

!*****************************************************************************************
  RECURSIVE SUBROUTINE CompileSubstr(this, b, e)
    ! Compile i-th function string funcString into bytecode
    class(EquationParser) :: this
    INTEGER,                         INTENT(in) :: b,e       ! Begin and end position substring

    INTEGER(is)                                 :: n
    INTEGER                                     :: b2,j,k,io
    CHARACTER (LEN=*),                PARAMETER :: calpha = 'abcdefghijklmnopqrstuvwxyz'// &
                                                            'ABCDEFGHIJKLMNOPQRSTUVWXYZ'
    ! Check for special cases of substring

    IF     (this%funcString(b:b) == '+') THEN                              ! Case 1: funcString(b:e) = '+...'
!      WRITE(*,*)'1. funcString(b:e) = "+..."'
       CALL this%CompileSubstr(b+1, e)
       RETURN
    ELSEIF (CompletelyEnclosed (this%funcString, b, e)) THEN               ! Case 2: funcString(b:e) = '(...)'
!      WRITE(*,*)'2. funcString(b:e) = "(...)"'
       CALL this%CompileSubstr(b+1, e-1)
       RETURN
    ELSEIF (SCAN(this%funcString(b:b), calpha) > 0) THEN
       n = MathFunctionIndex(this%funcString(b:e))
       IF (n > 0) THEN
          b2 = b+INDEX(this%funcString(b:e),'(')-1
          IF (CompletelyEnclosed(this%funcString, b2, e)) THEN             ! Case 3: funcString(b:e) = 'fcn(...)'
!            WRITE(*,*)'3. funcString(b:e) = "fcn(...)"'
             CALL this%CompileSubstr(b2+1, e-1)
             CALL this%AddCompiledByte(n)
             RETURN
          END IF
       END IF

    ELSEIF (this%funcString(b:b) == '-') THEN
       IF (CompletelyEnclosed(this%funcString, b+1, e)) THEN              ! Case 4: this%funcString(b:e) = '-(...)'
!         WRITE(*,*)'4. this%funcString(b:e) = "-(...)"'
          CALL this%CompileSubstr(b+2, e-1)
          CALL this%AddCompiledByte(cNeg)
          RETURN
       ELSEIF (SCAN(this%funcString(b+1:b+1),calpha) > 0) THEN
          n = MathFunctionIndex(this%funcString(b+1:e))
          IF (n > 0) THEN
             b2 = b+INDEX(this%funcString(b+1:e),'(')
             IF (CompletelyEnclosed(this%funcString, b2, e)) THEN          ! Case 5: this%funcString(b:e) = '-fcn(...)'
!               WRITE(*,*)'5. this%funcString(b:e) = "-fcn(...)"'
                CALL this%CompileSubstr(b2+1, e-1);
                CALL this%AddCompiledByte(n)
                CALL this%AddCompiledByte(cNeg)
                RETURN
             END IF
          END IF
       ENDIF
    END IF

    ! Check for operator in substring: check only base level (k=0), exclude expr. in ()

    DO io=cAdd,cPow                                          ! Increasing priority +-*/^
       k = 0
       DO j=e,b,-1
          IF     (this%funcString(j:j) == ')') THEN
             k = k+1
          ELSEIF (this%funcString(j:j) == '(') THEN
             k = k-1
          END IF
          IF (k == 0 .AND. this%funcString(j:j) == Ops(io) .AND. IsBinaryOp (j, this%funcString)) THEN
             IF (ANY(this%funcString(j:j) == Ops(cMul:cPow)) .AND. this%funcString(b:b) == '-') THEN ! Case 6: this%funcString(b:e) = '-...Op...' with Op > -
!               WRITE(*,*)'6. this%funcString(b:e) = "-...Op..." with Op > -'
                CALL this%CompileSubstr(b+1, e)
                CALL this%AddCompiledByte(cNeg)
                RETURN
             ELSE                                                        ! Case 7: this%funcString(b:e) = '...BinOp...'
!               WRITE(*,*)'7. Binary operator',this%funcString(j:j)
                CALL this%CompileSubstr(b, j-1)
                CALL this%CompileSubstr(j+1, e)
                CALL this%AddCompiledByte(OperatorIndex(Ops(io)))
                this%StackPtr = this%StackPtr - 1
                RETURN
             END IF
          END IF
       END DO
    END DO

    ! Check for remaining items, i.e. variables or explicit numbers

    b2 = b

    IF (this%funcString(b:b) == '-') b2 = b2+1

    n = this%MathItemIndex(b2, e)

!   WRITE(*,*)'8. AddCompiledByte ',n
    CALL this%AddCompiledByte(n)

    this%StackPtr = this%StackPtr + 1
    IF (this%StackPtr > this%StackSize) this%StackSize = this%StackSize + 1

    IF (b2 > b) CALL this%AddCompiledByte(cNeg)

  END SUBROUTINE CompileSubstr

!*****************************************************************************************
  FUNCTION IsBinaryOp (j, F) RESULT (res)
    ! Check if operator F(j:j) in string F is binary operator
    ! Special cases already covered elsewhere:              (that is corrected in v1.1)
    ! - operator character F(j:j) is first character of string (j=1)
    INTEGER,           INTENT(in) :: j                       ! Position of Operator
    CHARACTER (LEN=*), INTENT(in) :: F                       ! String

    LOGICAL                       :: res                     ! Result
    INTEGER                       :: k
    LOGICAL                       :: Dflag,Pflag

    res=.true.

    IF (F(j:j) == '+' .OR. F(j:j) == '-') THEN               ! Plus or minus sign:
       IF (j == 1) THEN                                      ! - leading unary operator ?
          res = .false.
       ELSEIF (SCAN(F(j-1:j-1),'+-*/^(') > 0) THEN           ! - other unary operator ?
          res = .false.
       ELSEIF (SCAN(F(j+1:j+1),'0123456789') > 0 .AND. &     ! - in exponent of real number ?
               SCAN(F(j-1:j-1),'eEdD')       > 0) THEN
          Dflag=.false.; Pflag=.false.
          k = j-1
          DO WHILE (k > 1)                                   !   step to the left in mantissa
             k = k-1
             IF     (SCAN(F(k:k),'0123456789') > 0) THEN
                Dflag=.true.
             ELSEIF (F(k:k) == '.') THEN
                IF (Pflag) THEN
                   EXIT                                      !   * EXIT: 2nd appearance of '.'
                ELSE
                   Pflag=.true.                              !   * mark 1st appearance of '.'
                ENDIF
             ELSE
                EXIT                                         !   * all other characters
             END IF
          END DO
          IF (Dflag .AND. (k == 1 .OR. SCAN(F(k:k),'+-*/^(') > 0)) res = .false.
       END IF
    END IF
  END FUNCTION IsBinaryOp

!*****************************************************************************************
  FUNCTION RealNum(str, ibegin, inext, error) RESULT (res)
    ! Get real number from string - Format: [blanks][+|-][nnn][.nnn][e|E|d|D[+|-]nnn]
    CHARACTER (LEN=*),  INTENT(in) :: str                    ! String
    REAL(rn)                       :: res                    ! Real number
    INTEGER, OPTIONAL, INTENT(out) :: ibegin,              & ! Start position of real number
                                      inext                  ! 1st character after real number
    LOGICAL, OPTIONAL, INTENT(out) :: error                  ! Error flag

    INTEGER                        :: ib,in,istat
    LOGICAL                        :: Bflag,               & ! .T. at begin of number in str
                                      InMan,               & ! .T. in mantissa of number
                                      Pflag,               & ! .T. after 1st '.' encountered
                                      Eflag,               & ! .T. at exponent identifier 'eEdD'
                                      InExp,               & ! .T. in exponent of number
                                      DInMan,              & ! .T. if at least 1 digit in mant.
                                      DInExp,              & ! .T. if at least 1 digit in exp.
                                      err                    ! Local error flag
    !----- -------- --------- --------- --------- --------- --------- --------- -------
    Bflag=.true.; InMan=.false.; Pflag=.false.; Eflag=.false.; InExp=.false.
    DInMan=.false.; DInExp=.false.
    ib   = 1
    in   = 1
    DO WHILE (in <= LEN_TRIM(str))
       SELECT CASE (str(in:in))
       CASE (' ')                                            ! Only leading blanks permitted
          ib = ib+1
          IF (InMan .OR. Eflag .OR. InExp) EXIT
       CASE ('+','-')                                        ! Permitted only
          IF     (Bflag) THEN
             InMan=.true.; Bflag=.false.                     ! - at beginning of mantissa
          ELSEIF (Eflag) THEN
             InExp=.true.; Eflag=.false.                     ! - at beginning of exponent
          ELSE
             EXIT                                            ! - otherwise STOP
          ENDIF
       CASE ('0':'9')                                        ! Mark
          IF     (Bflag) THEN
             InMan=.true.; Bflag=.false.                     ! - beginning of mantissa
          ELSEIF (Eflag) THEN
             InExp=.true.; Eflag=.false.                     ! - beginning of exponent
          ENDIF
          IF (InMan) DInMan=.true.                           ! Mantissa contains digit
          IF (InExp) DInExp=.true.                           ! Exponent contains digit
       CASE ('.')
          IF     (Bflag) THEN
             Pflag=.true.                                    ! - mark 1st appearance of '.'
             InMan=.true.; Bflag=.false.                     !   mark beginning of mantissa
          ELSEIF (InMan .AND..NOT.Pflag) THEN
             Pflag=.true.                                    ! - mark 1st appearance of '.'
          ELSE
             EXIT                                            ! - otherwise STOP
          END IF
       CASE ('e','E','d','D')                                ! Permitted only
          IF (InMan) THEN
             Eflag=.true.; InMan=.false.                     ! - following mantissa
          ELSE
             EXIT                                            ! - otherwise STOP
          ENDIF
       CASE DEFAULT
          EXIT                                               ! STOP at all other characters
       END SELECT
       in = in+1
    END DO
    err = (ib > in-1) .OR. (.NOT.DInMan) .OR. ((Eflag.OR.InExp).AND..NOT.DInExp)
    IF (err) THEN
       res = 0.0_rn
    ELSE
       READ(str(ib:in-1),*,IOSTAT=istat) res
       err = istat /= 0
    END IF
    IF (PRESENT(ibegin)) ibegin = ib
    IF (PRESENT(inext))  inext  = in
    IF (PRESENT(error))  error  = err
  END FUNCTION RealNum

!*****************************************************************************************
  SUBROUTINE LowCase (str1, str2)
    ! Transform upper case letters in str1 into lower case letters, result is str2
    IMPLICIT NONE
    CHARACTER (LEN=*),  INTENT(in) :: str1
    CHARACTER (LEN=*), INTENT(out) :: str2
    INTEGER                        :: j,k
    CHARACTER (LEN=*),   PARAMETER :: lc = 'abcdefghijklmnopqrstuvwxyz'
    CHARACTER (LEN=*),   PARAMETER :: uc = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'

    str2 = str1

    DO j=1,LEN_TRIM(str1)
       k = INDEX(uc,str1(j:j))
       IF (k > 0) str2(j:j) = lc(k:k)
    END DO

  END SUBROUTINE LowCase

  END MODULE FortranParser


      subroutine xyz_ijk(ig,nx,ny,nz,x,y,z,i,j,k)
c s kelkar March 24, 06
c given the local coordinates of a point x,y,z, with respect to
c a node# ig in coarse grid, find the indices i,j,k that specify
c the subgrid cell that the point falls in.
c 1<=i<=nx, 1<=j<=ny, 1<=k<=nz
c********************************************************************
c INPUT VARIABLES
c     ig : node # of the node in the coarse grid
c     x,y,z: coordinates of the  point in local system wrt ig
c     nx,ny,nz : # of divisions along the x,y,z,axis for the subgrid
c
c OUTOUT VARIABLES
c     i,j,k : indices representating the location of the subcell
c             indices go along the x,y,z, axis respectively
c INTERNAL VARIABLES
c********************************************************************

      use comunits

      implicit none

      integer ig,i,j,k,nx,ny,nz

      real*8 x,y,z

      if(nx*ny*nz.gt.0) then
         i = int(x*nx)+1
         j = int(y*ny)+1
         k = int(z*nz)+1
c the next correction is for a popint sitting on a + face.
c for example, suppose point is on a +x face, ie x=1. then
c we get i=(1*nx)+1=nx+1 > nx : this is bad as it puts the
c point in the next cell, so force i<= nx etc.
         if(i.gt.nx) i=nx
         if(j.gt.ny) j=ny
         if(k.gt.nz) k=nz
      else
         write(error_unit_number,*)' some of nx,ny,nz = 0 for ig=',ig
         write(error_unit_number,*)' subroutine xyz_ijk. STOP'
         stop
      endif

      return

      end

c........................................................................


    MODULE random_exponential_mod
! .. Implicit None Statement ..
      IMPLICIT NONE
! ..
    CONTAINS

!*********************************************************************

      FUNCTION random_exponential(av)
! .. Use Statements ..
        USE random_standard_exponential_mod
! ..
! .. Implicit None Statement ..
        IMPLICIT NONE
! ..
! .. Function Return Value ..
        REAL :: random_exponential
! ..
! .. Scalar Arguments ..
        REAL, INTENT (IN) :: av
! ..
! .. Executable Statements ..

!**********************************************************************
!     REAL FUNCTION GENEXP( AV )
!                    GENerate EXPonential random deviate
!                              Function
!     Generates a single random deviate from an exponential
!     distribution with mean AV.
!                              Arguments
!     AV --> The mean of the exponential distribution from which
!            a random deviate is to be generated.
!                              REAL AV
!     JJV                      (AV >= 0)
!     GENEXP <-- The random deviate.
!                              REAL GENEXP
!                              Method
!     Renames SEXPO from TOMS as slightly modified by BWB to use RANF
!     instead of SUNIF.
!     For details see:
!               Ahrens, J.H. and Dieter, U.
!               Computer Methods for Sampling From the
!               Exponential and Normal Distributions.
!               Comm. ACM, 15,10 (Oct. 1972), 873 - 882.
!**********************************************************************
!     JJV added check to ensure AV >= 0.0
        IF (av<0.0) THEN
          WRITE (*,*) 'AV < 0.0 in GENEXP - ABORT'
          WRITE (*,*) 'Value of AV: ', av
          STOP 'AV < 0.0 in GENEXP - ABORT'
        END IF

        random_exponential = random_standard_exponential()*av
        RETURN

      END FUNCTION random_exponential

!*********************************************************************

    END MODULE random_exponential_mod


!---------------------------------------------------------------------
!
!  Example of compilation errors
!
!---------------------------------------------------------------------

PROGRAM typeMismatchError
    IMPLICIT NONE
    REAL(8) :: rectagleArea
    INTEGER :: side_a_length
    INTEGER :: side_b_length
    REAL :: myArea

    side_a_length = 2
    side_b_length = 4
    myArea = rectagleArea( side_a_length , side_b_length)
    PRINT *, myArea

END PROGRAM

REAL(8) FUNCTION rectagleArea( side_a_length , side_b_length )
    IMPLICIT NONE
    REAL(8), INTENT(IN) :: side_a_length
    REAL(8), INTENT(IN) :: side_b_length

    rectagleArea=side_a_length*side_b_length

END FUNCTION


module kind_parameters
  use iso_fortran_env, only : real64
  !! select and expose kind parameters
  implicit none

  private
  public :: rkind

  integer, parameter :: precision=15, range=307
  integer, parameter :: rkind = selected_real_kind(precision, range)

  ! Alterntives:
  !
  ! real(real64) x     ! only specifies bit-representation, not numerical precision
  ! double precision y ! leaves wiggle room
  ! real(8)            ! behavior not defined by standard
end module


program tester

    use forlab_math, only: all_close
    use stdlib_error, only: check
    implicit none

    call test_math_all_close_real
    call test_math_all_close_complex
    print *, "All tests in `test_math_all_close` passed."

contains

    subroutine test_math_all_close_real

        real :: x(4, 4), random(4, 4)

        call random_number(random)
        x = 1.0

        call check(all_close(x+1.0e-11*random, x), msg="REAL: all_close(x+1.0e-11*random, x) failed.")
        call check(all_close(x+1.0e-5 *random, x), msg="REAL: all_close(x+1.0e-5 *random, x) failed.", warn=.true.)

    end subroutine test_math_all_close_real

    subroutine test_math_all_close_complex

        real    :: random(4, 4)
        complex :: x(4, 4)

        call random_number(random)
        x = 1.0

        call check(all_close(x+1.0e-11*random, x), msg="CMPLX: all_close(x+1.0e-11*random, x)")
        call check(all_close(x+1.0e-5 *random, x), msg="CMPLX: all_close(x+1.0e-5 *random, x) failed.", warn=.true.)

    end subroutine test_math_all_close_complex

end program tester