IsothermFactory.f90

Go to the documentation of this file.

module isothermfactorymodule
 
  use kindmodule, only: i4b, dp
  use simmodule, only: store_error
 
  use isothermenummodule
  use isotherminterfacemodule, only: isothermtype
  use linearisothermsmodule, only: linearisothermtype
  use freundlichisothermmodule, only: freundlichisothermtype
  use langmuirisothermmodule, only: langmuirisothermtype
 
  implicit none
  private
  public :: create_isotherm
 
contains
 
  !> @brief Create an isotherm object based on type and parameters.
  !>
  !> Returns a pointer to a concrete `IsothermType` (or `null()` if sorption
  !> is off). Uses `isotherm_type` to select Linear, Freundlich, or Langmuir,
  !> passing `distcoef` and `sp2` as required by the chosen model.
  !<
  function create_isotherm(isotherm_type, distcoef, sp2) result(isotherm)
    ! -- result
    class(isothermtype), pointer :: isotherm !< allocated concrete isotherm or null()
    ! -- dummy
    integer(I4B), intent(in) :: isotherm_type !< enumerator from `IsothermEnumModule`
    real(dp), dimension(:), pointer, contiguous :: distcoef !< primary coefficient (Kd, Kf, or Kl)
    real(dp), dimension(:), pointer, contiguous :: sp2 !< secondary parameter (a for Freundlich, Sbar for Langmuir)
 
    select case (isotherm_type)
    case (sorption_off)
      nullify (isotherm)
    case (sorption_linear)
      allocate (isotherm, source=linearisothermtype(distcoef))
    case (sorption_freund)
      allocate (isotherm, source=freundlichisothermtype(distcoef, sp2))
    case (sorption_lang)
      allocate (isotherm, source=langmuirisothermtype(distcoef, sp2))
    case default
      call store_error('Sorption type not implemented.')
    end select
 
  end function create_isotherm
end module isothermfactorymodule