scale_atmos_dyn_tinteg_short.F90

Go to the documentation of this file.

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

  abstract interface
     subroutine short( &
          DENS, MOMZ, MOMX, MOMY, RHOT, PROG,       & ! (inout)
          mflx_hi, tflx_hi,                         & ! (inout)
          dens_t, momz_t, momx_t, momy_t, rhot_t,   & ! (in)
          rtot, cvtot, corioli,                     & ! (in)
          num_diff, divdmp_coef, ddiv,              & ! (in)
          flag_fct_momentum, flag_fct_t,            & ! (in)
          flag_fct_along_stream,                    & ! (in)
          cdz, fdz, fdx, fdy,                       & ! (in)
          rcdz, rcdx, rcdy, rfdz, rfdx, rfdy,       & ! (in)
          phi, gsqrt, j13g, j23g, j33g, mapf,       & ! (in)
          ref_pres, ref_dens,                       & ! (in)
          bnd_w, bnd_e, bnd_s, bnd_n,               & ! (in)
          dt                                        ) ! (in)
       use scale_precision
       use scale_grid_index
       use scale_index
       real(RP), intent(inout) :: dens(ka,ia,ja)
       real(RP), intent(inout) :: momz(ka,ia,ja)
       real(RP), intent(inout) :: momx(ka,ia,ja)
       real(RP), intent(inout) :: momy(ka,ia,ja)
       real(RP), intent(inout) :: rhot(ka,ia,ja)
       real(RP), intent(inout) :: prog(ka,ia,ja,va)

       real(RP), intent(inout) :: mflx_hi(ka,ia,ja,3)
       real(RP), intent(inout) :: tflx_hi(ka,ia,ja,3)

       real(RP), intent(in)    :: dens_t(ka,ia,ja)
       real(RP), intent(in)    :: momz_t(ka,ia,ja)
       real(RP), intent(in)    :: momx_t(ka,ia,ja)
       real(RP), intent(in)    :: momy_t(ka,ia,ja)
       real(RP), intent(in)    :: rhot_t(ka,ia,ja)

       real(RP), intent(in)    :: rtot(ka,ia,ja)
       real(RP), intent(in)    :: cvtot(ka,ia,ja)
       real(RP), intent(in)    :: corioli(ia,ja)

       real(RP), intent(in)    :: num_diff(ka,ia,ja,5,3)
       real(RP), intent(in)    :: divdmp_coef
       real(RP), intent(in)    :: ddiv(ka,ia,ja)

       logical,  intent(in)    :: flag_fct_momentum
       logical,  intent(in)    :: flag_fct_t
       logical,  intent(in)    :: flag_fct_along_stream

       real(RP), intent(in)    :: cdz (ka)
       real(RP), intent(in)    :: fdz (ka-1)
       real(RP), intent(in)    :: fdx (ia-1)
       real(RP), intent(in)    :: fdy (ja-1)
       real(RP), intent(in)    :: rcdz(ka)
       real(RP), intent(in)    :: rcdx(ia)
       real(RP), intent(in)    :: rcdy(ja)
       real(RP), intent(in)    :: rfdz(ka-1)
       real(RP), intent(in)    :: rfdx(ia-1)
       real(RP), intent(in)    :: rfdy(ja-1)

       real(RP), intent(in)    :: phi  (ka,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(RP), intent(in)    :: ref_pres(ka,ia,ja)
       real(RP), intent(in)    :: ref_dens(ka,ia,ja)

       logical,  intent(in)    :: bnd_w
       logical,  intent(in)    :: bnd_e
       logical,  intent(in)    :: bnd_s
       logical,  intent(in)    :: bnd_n

       real(RP), intent(in)    :: dt
     end subroutine short
  end interface
  procedure(short), pointer :: atmos_dyn_tinteg_short => null()
  public :: atmos_dyn_tinteg_short

  !-----------------------------------------------------------------------------
  !
  !++ Public parameters & variables
  !
  !-----------------------------------------------------------------------------
  !
  !++ Private procedure
  !
  !-----------------------------------------------------------------------------
  !
  !++ Private parameters & variables
  !
  !-----------------------------------------------------------------------------
contains
  !-----------------------------------------------------------------------------
  subroutine atmos_dyn_tinteg_short_setup( &
       ATMOS_DYN_Tinteg_short_TYPE )

    use scale_precision
    use scale_grid_index
    use scale_index
    use scale_process, only: &
       prc_mpistop
#define EXTM(pre, name, post) pre ## name ## post
#define NAME(pre, name, post) EXTM(pre, name, post)
#ifdef TINTEG_SHORT
    use name(scale_atmos_dyn_tinteg_short_, tinteg_short,), only: &
       name(atmos_dyn_rk_tinteg_short_, tinteg_short, _setup), &
       name(atmos_dyn_rk_tinteg_short_, tinteg_short,)
#else
    use scale_atmos_dyn_tinteg_short_rk3, only: &
       atmos_dyn_tinteg_short_rk3_setup, &
       atmos_dyn_tinteg_short_rk3
    use scale_atmos_dyn_tinteg_short_rk4, only: &
       atmos_dyn_tinteg_short_rk4_setup, &
       atmos_dyn_tinteg_short_rk4
#endif
    implicit none
    character(len=*), intent(in)  :: ATMOS_DYN_Tinteg_short_TYPE
    !---------------------------------------------------------------------------

#ifdef TINTEG_SHORT
    name(atmos_dyn_tinteg_short_, tinteg_short, _setup)( &
            atmos_dyn_tinteg_short_type )
    atmos_dyn_tinteg_short => name(atmos_dyn_tingeg_short_, tinteg_short,)
#else
    select case ( atmos_dyn_tinteg_short_type )
    case ( 'RK3', 'RK3WS2002' )
       call atmos_dyn_tinteg_short_rk3_setup( &
            atmos_dyn_tinteg_short_type )
       atmos_dyn_tinteg_short => atmos_dyn_tinteg_short_rk3
    case ( 'RK4' )
       call atmos_dyn_tinteg_short_rk4_setup( &
            atmos_dyn_tinteg_short_type )
       atmos_dyn_tinteg_short => atmos_dyn_tinteg_short_rk4
    case ( 'OFF', 'NONE' )
       ! do nothing
    case default
       write(*,*) 'xxx ATMOS_DYN_TINTEG_SHORT_TYPE is invalid: ', atmos_dyn_tinteg_short_type
       call prc_mpistop
    end select
#endif

    return
  end subroutine atmos_dyn_tinteg_short_setup

end module scale_atmos_dyn_tinteg_short