scale_atmos_phy_tb.F90

Go to the documentation of this file.

!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
module scale_atmos_phy_tb
  !-----------------------------------------------------------------------------
  !
  !++ 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_tb_setup

  !-----------------------------------------------------------------------------
  !
  !++ Public parameters & variables
  !
  !-----------------------------------------------------------------------------
  !
  !++ Private procedure
  !
  !-----------------------------------------------------------------------------
  !
  !++ Private parameters & variables
  !
  abstract interface
     subroutine tb( &
       qflx_sgs_momz, qflx_sgs_momx, qflx_sgs_momy, & ! (out)
       qflx_sgs_rhot, qflx_sgs_rhoq,                & ! (out)
       tke,                                         & ! (inout)
       tke_t, nu_c, ri, pr, n2,                     & ! (out) diagnostic variables
       momz, momx, momy, rhot, dens, qtrc,          & ! (in)
       sflx_mw, sflx_mu, sflx_mv, sflx_sh, sflx_qv, & ! (in)
       gsqrt, j13g, j23g, j33g, mapf, dt            ) ! (in)
       use scale_precision
       use scale_grid_index
       use scale_tracer
       implicit none
       real(RP), intent(out) :: qflx_sgs_momz(ka,ia,ja,3)
       real(RP), intent(out) :: qflx_sgs_momx(ka,ia,ja,3)
       real(RP), intent(out) :: qflx_sgs_momy(ka,ia,ja,3)
       real(RP), intent(out) :: qflx_sgs_rhot(ka,ia,ja,3)
       real(RP), intent(out) :: qflx_sgs_rhoq(ka,ia,ja,3,qa)

       real(RP), intent(inout) :: tke(ka,ia,ja)
       real(RP), intent(out)   :: tke_t(ka,ia,ja) ! tendency TKE
       real(RP), intent(out)   :: nu_c(ka,ia,ja) ! eddy viscosity (center)
       real(RP), intent(out)   :: ri  (ka,ia,ja) ! Richardson number
       real(RP), intent(out)   :: pr  (ka,ia,ja) ! Prantle number
       real(RP), intent(out)   :: n2  (ka,ia,ja) ! squared Brunt-Vaisala frequency

       real(RP), intent(in)  :: momz(ka,ia,ja)
       real(RP), intent(in)  :: momx(ka,ia,ja)
       real(RP), intent(in)  :: momy(ka,ia,ja)
       real(RP), intent(in)  :: rhot(ka,ia,ja)
       real(RP), intent(in)  :: dens(ka,ia,ja)
       real(RP), intent(in)  :: qtrc(ka,ia,ja,qa)

       real(RP), intent(in)  :: sflx_mw(ia,ja)
       real(RP), intent(in)  :: sflx_mu(ia,ja)
       real(RP), intent(in)  :: sflx_mv(ia,ja)
       real(RP), intent(in)  :: sflx_sh(ia,ja)
       real(RP), intent(in)  :: sflx_qv(ia,ja)

       real(RP), intent(in)  :: gsqrt   (ka,ia,ja,7)
       real(RP), intent(in)  :: j13g    (ka,ia,ja,7)
       real(RP), intent(in)  :: j23g    (ka,ia,ja,7)
       real(RP), intent(in)  :: j33g
       real(RP), intent(in)  :: mapf    (ia,ja,2,4)
       real(DP), intent(in)  :: dt
     end subroutine tb
  end interface
  procedure(tb), pointer :: atmos_phy_tb => null()
  public :: atmos_phy_tb

  !-----------------------------------------------------------------------------
contains

  subroutine atmos_phy_tb_setup( &
       TB_TYPE,       &
       CDZ, CDX, CDY, &
       CZ             )
    use scale_process, only: &
       prc_mpistop
#define EXTM(pre, name, post) pre ## name ## post
#define NAME(pre, name, post) EXTM(pre, name, post)
#ifdef TB
    use name(scale_atmos_phy_tb_, tb,), only: &
       name(atmos_phy_tb_, tb, _setup), &
       name(atmos_phy_tb_, tb,)
#else
    use scale_atmos_phy_tb_smg, only: &
       atmos_phy_tb_smg_setup, &
       atmos_phy_tb_smg
    use scale_atmos_phy_tb_d1980, only: &
       atmos_phy_tb_d1980_setup, &
       atmos_phy_tb_d1980
    use scale_atmos_phy_tb_dns, only: &
       atmos_phy_tb_dns_setup, &
       atmos_phy_tb_dns
    use scale_atmos_phy_tb_mynn, only: &
       atmos_phy_tb_mynn_setup, &
       atmos_phy_tb_mynn
    use scale_atmos_phy_tb_hybrid, only: &
       atmos_phy_tb_hybrid_setup, &
       atmos_phy_tb_hybrid
    use scale_atmos_phy_tb_dummy, only: &
       atmos_phy_tb_dummy_setup, &
       atmos_phy_tb_dummy
#endif
    implicit none

    character(len=*), intent(in) :: TB_TYPE

    real(RP), intent(in) :: CDZ(ka)
    real(RP), intent(in) :: CDX(ia)
    real(RP), intent(in) :: CDY(ja)
    real(RP), intent(in) :: CZ (ka,ia,ja)
    !---------------------------------------------------------------------------

#ifdef TB
    call name(atmos_phy_tb_, tb, _setup)( &
              tb_type,       &
              cdz, cdx, cdy, &
              cz             )
    atmos_phy_tb                 => name(atmos_phy_tb_, tb, )
#else
    select case( tb_type )
    case ( 'SMAGORINSKY' )
       call atmos_phy_tb_smg_setup( &
            tb_type,       &
            cdz, cdx, cdy, &
            cz             )
       atmos_phy_tb => atmos_phy_tb_smg

    case ( 'D1980' )
       call atmos_phy_tb_d1980_setup( &
            tb_type,       &
            cdz, cdx, cdy, &
            cz             )
       atmos_phy_tb => atmos_phy_tb_d1980

    case ( 'DNS' )
       call atmos_phy_tb_dns_setup( &
            tb_type,       &
            cdz, cdx, cdy, &
            cz             )
       atmos_phy_tb => atmos_phy_tb_dns

    case ( 'MYNN' )
       call atmos_phy_tb_mynn_setup( &
            tb_type,       &
            cdz, cdx, cdy, &
            cz             )
       atmos_phy_tb => atmos_phy_tb_mynn

    case ('HYBRID')
       call atmos_phy_tb_hybrid_setup( &
            tb_type,       &
            cdz, cdx, cdy, &
            cz             )
       atmos_phy_tb => atmos_phy_tb_hybrid

    case ('OFF')

       ! do nothing

    case default

       write(*,*) 'xxx ATMOS_PHY_TB_TYPE is invalid'
       call prc_mpistop

    end select
#endif

    return
  end subroutine atmos_phy_tb_setup

end module scale_atmos_phy_tb