scale_atmos_phy_sf.F90

Go to the documentation of this file.

!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
#include "inc_openmp.h"
module scale_atmos_phy_sf
  !-----------------------------------------------------------------------------
  !
  !++ used modules
  !
  use scale_precision
  use scale_stdio
  use scale_prof
  use scale_grid_index
  use scale_tracer
  !-----------------------------------------------------------------------------
  implicit none
  private
  !-----------------------------------------------------------------------------
  !
  !++ Public procedure
  !
  public :: atmos_phy_sf_setup

  !-----------------------------------------------------------------------------
  !
  !++ Public parameters & variables
  !
  !-----------------------------------------------------------------------------
  !
  !++ Private procedure
  !
  !-----------------------------------------------------------------------------
  !
  !++ Private parameters & variables
  !
  !-----------------------------------------------------------------------------
  abstract interface
     subroutine sf( &
          ATM_TEMP, ATM_PRES, ATM_W, ATM_U, ATM_V,     &
          ATM_DENS,                                    &
          ATM_QTRC,                                    &
          ATM_Z1, dt,                                  &
          SFC_DENS, SFC_PRES,                          &
          SFLX_LW_dn, SFLX_SW_dn,                      &
          SFC_TEMP, SFC_albedo,                        &
          SFC_Z0M, SFC_Z0H, SFC_Z0E,                   &
          SFLX_MW, SFLX_MU, SFLX_MV, SFLX_SH, SFLX_LH, &
          SFLX_QTRC,                                   &
          U10, V10, T2, Q2                             )
       use scale_precision
       use scale_grid_index
       use scale_tracer
       implicit none

       real(RP), intent(in)    :: atm_temp  (ia,ja)    ! temperature at the lowermost layer (cell center) [K]
       real(RP), intent(in)    :: atm_pres  (ia,ja)    ! pressure    at the lowermost layer (cell center) [Pa]
       real(RP), intent(in)    :: atm_w     (ia,ja)    ! velocity w  at the lowermost layer (cell center) [m/s]
       real(RP), intent(in)    :: atm_u     (ia,ja)    ! velocity u  at the lowermost layer (cell center) [m/s]
       real(RP), intent(in)    :: atm_v     (ia,ja)    ! velocity v  at the lowermost layer (cell center) [m/s]
       real(RP), intent(in)    :: atm_dens  (ia,ja)    ! density     at the lowermost layer (cell center) [kg/m3]
       real(RP), intent(in)    :: atm_qtrc  (ia,ja,qa) ! tracer      at the lowermost layer (cell center) [kg/kg]
       real(RP), intent(in)    :: atm_z1    (ia,ja)    ! height of the lowermost grid from surface (cell center) [m]
       real(DP), intent(in)    :: dt                   ! delta time
       real(RP), intent(in)    :: sfc_dens  (ia,ja)    ! density     at the surface atmosphere [kg/m3]
       real(RP), intent(in)    :: sfc_pres  (ia,ja)    ! pressure    at the surface atmosphere [Pa]
       real(RP), intent(in)    :: sflx_lw_dn(ia,ja)    ! downward longwave  radiation flux at the surface [J/m2/s]
       real(RP), intent(in)    :: sflx_sw_dn(ia,ja)    ! downward shortwave radiation flux at the surface [J/m2/s]
       real(RP), intent(in)    :: sfc_temp  (ia,ja)    ! temperature at the surface skin [K]
       real(RP), intent(in)    :: sfc_albedo(ia,ja,2)  ! surface albedo (LW/SW) [0-1]
       real(RP), intent(inout) :: sfc_z0m   (ia,ja)    ! surface roughness length (momentum) [m]
       real(RP), intent(inout) :: sfc_z0h   (ia,ja)    ! surface roughness length (heat) [m]
       real(RP), intent(inout) :: sfc_z0e   (ia,ja)    ! surface roughness length (vapor) [m]
       real(RP), intent(out)   :: sflx_mw   (ia,ja)    ! surface flux for z-momentum    (area center)   [m/s*kg/m2/s]
       real(RP), intent(out)   :: sflx_mu   (ia,ja)    ! surface flux for x-momentum    (area center)   [m/s*kg/m2/s]
       real(RP), intent(out)   :: sflx_mv   (ia,ja)    ! surface flux for y-momentum    (area center)   [m/s*kg/m2/s]
       real(RP), intent(out)   :: sflx_sh   (ia,ja)    ! surface flux for sensible heat (area center)   [J/m2/s]
       real(RP), intent(out)   :: sflx_lh   (ia,ja)    ! surface flux for latent   heat (area center)   [J/m2/s]
       real(RP), intent(out)   :: sflx_qtrc (ia,ja,qa) ! surface flux for tracer mass   (area center)   [kg/m2/s]
       real(RP), intent(out)   :: u10       (ia,ja)    ! velocity u        at 10m height
       real(RP), intent(out)   :: v10       (ia,ja)    ! velocity v        at 10m height
       real(RP), intent(out)   :: t2        (ia,ja)    ! temperature t     at  2m height
       real(RP), intent(out)   :: q2        (ia,ja)    ! water vapor q     at  2m height
     end subroutine sf
  end interface
  procedure(sf), pointer :: atmos_phy_sf => null()
  public :: atmos_phy_sf

contains

  !-----------------------------------------------------------------------------
  !
  !-----------------------------------------------------------------------------
  subroutine atmos_phy_sf_setup( SF_TYPE )
    use scale_process, only: &
       prc_mpistop
#define EXTM(pre, name, post) pre ## name ## post
#define NAME(pre, name, post) EXTM(pre, name, post)
#ifdef SF
    use name(scale_atmos_phy_, sf,), only: &
       name(atmos_phy_, sf, _setup), &
       name(atmos_phy_, sf,)
#else
    use scale_atmos_phy_sf_const, only: &
       atmos_phy_sf_const_setup, &
       atmos_phy_sf_const
    use scale_atmos_phy_sf_bulk, only: &
       atmos_phy_sf_bulk_setup, &
       atmos_phy_sf_bulk
#endif
    implicit none

    character(len=*), intent(in) :: SF_TYPE
    !---------------------------------------------------------------------------

    select case( sf_type )
    case('CONST')
       call atmos_phy_sf_const_setup( sf_type )
       atmos_phy_sf => atmos_phy_sf_const
    case('BULK')
       call atmos_phy_sf_bulk_setup( sf_type )
       atmos_phy_sf => atmos_phy_sf_bulk
    case('OFF', 'COUPLE')
       ! do nothing
    case default
       write(*,*) 'xxx ATMPS_PHY_SF_TYPE is invalid'
       call prc_mpistop
    end select

    return
  end subroutine atmos_phy_sf_setup

end module scale_atmos_phy_sf