BaseExchange.f90

Go to the documentation of this file.

module baseexchangemodule
 
  use kindmodule, only: dp, i4b, lgp
  use constantsmodule, only: lenexchangename, lenmempath
  use listmodule, only: listtype
  use basemodelmodule, only: basemodeltype
 
  implicit none
 
  private
  public :: baseexchangetype, addbaseexchangetolist, getbaseexchangefromlist
  private :: castasbaseexchangeclass
 
  type, abstract :: baseexchangetype
    character(len=LENEXCHANGENAME) :: name !< the name of this exchange
    character(len=LENMEMPATH) :: memorypath !< the location in the memory manager where the variables are stored
    character(len=LENMEMPATH) :: input_mempath
    integer(I4B) :: id
 
  contains
 
    procedure(exg_df), deferred :: exg_df
    procedure(exg_ar), deferred :: exg_ar
    procedure :: exg_rp
    procedure :: exg_calculate_delt
    procedure :: exg_ot
    procedure :: exg_fp
    procedure :: exg_da
    procedure :: connects_model
  end type baseexchangetype
 
  abstract interface
 
    subroutine exg_df(this)
      import baseexchangetype
      class(baseexchangetype) :: this
    end subroutine
 
    subroutine exg_ar(this)
      import baseexchangetype
      class(baseexchangetype) :: this
    end subroutine
 
  end interface
 
contains
 
  !> @brief Read and prepare
  !<
  subroutine exg_rp(this)
    ! -- modules
    use tdismodule, only: readnewdata
    ! -- dummy
    class(baseexchangetype) :: this
    !
    ! -- Check with TDIS on whether or not it is time to RP
    if (.not. readnewdata) return
    !
    ! -- Nothing to do for RP
    !
    ! -- Return
    return
  end subroutine exg_rp
 
  !> @brief Calculate time step length
  !<
  subroutine exg_calculate_delt(this)
    ! -- dummy
    class(baseexchangetype) :: this
    !
    ! -- Nothing to do for TU
    !
    ! -- Return
    return
  end subroutine exg_calculate_delt
 
  !> @brief Run output routines
  !<
  subroutine exg_ot(this)
    ! -- dummy
    class(baseexchangetype) :: this
    !
    ! -- Return
    return
  end subroutine exg_ot
 
  !> @brief Final processing
  !<
  subroutine exg_fp(this)
    ! -- dummy
    class(baseexchangetype) :: this
    !
    ! -- Return
    return
  end subroutine exg_fp
 
  !> @brief Deallocate memory
  !<
  subroutine exg_da(this)
    ! -- dummy
    class(baseexchangetype) :: this
    !
    ! -- Return
    return
  end subroutine exg_da
 
  !> @brief Should return true when the exchange should be added to the
  !! solution where the model resides
  !<
  function connects_model(this, model) result(is_connected)
    ! -- dummy
    class(baseexchangetype) :: this !< the instance of the exchange
    class(basemodeltype), pointer, intent(in) :: model !< the model to which the exchange might hold a connection
    ! -- return
    logical(LGP) :: is_connected !< true, when connected
    !
    is_connected = .false.
    !
    ! -- Return
    return
  end function
 
  !> @brief Cast the object passed in as BaseExchangeType and return it
  !<
  function castasbaseexchangeclass(obj) result(res)
    ! -- dummy
    class(*), pointer, intent(inout) :: obj
    ! -- return
    class(baseexchangetype), pointer :: res
    !
    res => null()
    if (.not. associated(obj)) return
    !
    select type (obj)
    class is (baseexchangetype)
      res => obj
    end select
    !
    ! -- Return
    return
  end function castasbaseexchangeclass
 
  !> @brief Add the exchange object (BaseExchangeType) to a list
  !<
  subroutine addbaseexchangetolist(list, exchange)
    ! -- dummy
    type(listtype), intent(inout) :: list
    class(baseexchangetype), pointer, intent(inout) :: exchange
    ! -- local
    class(*), pointer :: obj
    !
    obj => exchange
    call list%Add(obj)
    !
    ! -- Return
    return
  end subroutine addbaseexchangetolist
 
  !> @brief Retrieve a specific BaseExchangeType object from a list
  !<
  function getbaseexchangefromlist(list, idx) result(res)
    ! -- dummy
    type(listtype), intent(inout) :: list
    integer(I4B), intent(in) :: idx
    class(baseexchangetype), pointer :: res
    ! -- local
    class(*), pointer :: obj
    !
    obj => list%GetItem(idx)
    res => castasbaseexchangeclass(obj)
    !
    ! -- Return
    return
  end function getbaseexchangefromlist
 
end module baseexchangemodule