scale_atmos_dyn_tinteg_large_rk3.F90

Go to the documentation of this file.

!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
#include "inc_openmp.h"
module scale_atmos_dyn_tinteg_large_rk3
  !-----------------------------------------------------------------------------
  !
  !++ used modules
  !
  use scale_precision
  use scale_stdio
  use scale_prof
  use scale_grid_index
  use scale_index
  use scale_tracer

#ifdef DEBUG
  use scale_debug, only: &
     check
  use scale_const, only: &
     undef  => const_undef, &
     iundef => const_undef2
#endif
  !-----------------------------------------------------------------------------
  implicit none
  private
  !-----------------------------------------------------------------------------
  !
  !++ Public procedure
  !
  public :: atmos_dyn_tinteg_large_rk3_setup
  public :: atmos_dyn_tinteg_large_rk3

  !-----------------------------------------------------------------------------
  !
  !++ Public parameters & variables
  !
  !-----------------------------------------------------------------------------
  !
  !++ Private procedure
  !
  !-----------------------------------------------------------------------------
  !
  !++ Private parameters & variables
  !
  !-----------------------------------------------------------------------------
contains

  !-----------------------------------------------------------------------------
  subroutine atmos_dyn_tinteg_large_rk3_setup( &
       tinteg_type )
    use scale_process, only: &
       prc_mpistop
    use scale_const, only: &
       undef => const_undef
    use scale_comm, only: &
       comm_vars8_init
    implicit none

    character(len=*) :: tinteg_type

    integer :: iv
    !---------------------------------------------------------------------------

    if ( tinteg_type /= 'RK3' ) then
       write(*,*) 'xxx TINTEG_LARGE_TYPE is not RK3. Check!'
       call prc_mpistop
    end if

    return
  end subroutine atmos_dyn_tinteg_large_rk3_setup

  !-----------------------------------------------------------------------------
  subroutine atmos_dyn_tinteg_large_rk3( &
       DENS,    MOMZ,    MOMX,    MOMY,    RHOT,    QTRC,    &
       PROG,                                                 &
       DENS_av, MOMZ_av, MOMX_av, MOMY_av, RHOT_av, QTRC_av, &
       mflx_hi, tflx_hi,                                     &
       num_diff, num_diff_q,                                 &
       DENS_tp, MOMZ_tp, MOMX_tp, MOMY_tp, RHOT_tp, RHOQ_tp, &
       CORIOLI,                                              &
       CDZ, CDX, CDY, FDZ, FDX, FDY,                         &
       RCDZ, RCDX, RCDY, RFDZ, RFDX, RFDY,                   &
       PHI, GSQRT,                                           &
       J13G, J23G, J33G, MAPF,                               &
       AQ_CV,                                                &
       REF_dens, REF_pott, REF_qv, REF_pres,                 &
       BND_W, BND_E, BND_S, BND_N,                           &
       ND_COEF, ND_COEF_Q, ND_ORDER, ND_SFC_FACT, ND_USE_RS, &
       DAMP_DENS,       DAMP_VELZ,       DAMP_VELX,          &
       DAMP_VELY,       DAMP_POTT,       DAMP_QTRC,          &
       DAMP_alpha_DENS, DAMP_alpha_VELZ, DAMP_alpha_VELX,    &
       DAMP_alpha_VELY, DAMP_alpha_POTT, DAMP_alpha_QTRC,    &
       divdmp_coef,                                          &
       FLAG_FCT_MOMENTUM, FLAG_FCT_T, FLAG_FCT_TRACER,       &
       FLAG_FCT_ALONG_STREAM,                                &
       USE_AVERAGE,                                          &
       DTL, DTS                                              )
    use scale_const, only: &
       rdry   => const_rdry, &
       rvap   => const_rvap, &
       cvdry  => const_cvdry
    use scale_comm, only: &
       comm_vars8, &
       comm_wait
    use scale_gridtrans, only: &
       i_xyz, &
       i_xyw, &
       i_uyz, &
       i_xvz, &
       i_xy,  &
       i_uy,  &
       i_xv
    use scale_atmos_dyn_common, only: &
       atmos_dyn_numfilter_coef,   &
       atmos_dyn_numfilter_coef_q, &
       atmos_dyn_fct
    use scale_atmos_dyn_fvm_flux_ud1, only: &
       atmos_dyn_fvm_fluxz_xyz_ud1, &
       atmos_dyn_fvm_fluxx_xyz_ud1, &
       atmos_dyn_fvm_fluxy_xyz_ud1
    use scale_atmos_dyn_fvm_flux, only: &
       atmos_dyn_fvm_fluxz_xyz, &
       atmos_dyn_fvm_fluxx_xyz, &
       atmos_dyn_fvm_fluxy_xyz
    use scale_atmos_dyn_tstep_large, only: &
       atmos_dyn_tstep_large
    use scale_atmos_boundary, only: &
       bnd_qa, &
       bnd_smoother_fact => atmos_boundary_smoother_fact
    use scale_history, only: &
#ifdef hist_tend
       hist_in, &
#endif
       hist_switch
    implicit none

    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) :: QTRC(ka,ia,ja,qa)

    real(RP), intent(inout) :: PROG(ka,ia,ja,va)

    real(RP), intent(inout) :: DENS_av(ka,ia,ja)
    real(RP), intent(inout) :: MOMZ_av(ka,ia,ja)
    real(RP), intent(inout) :: MOMX_av(ka,ia,ja)
    real(RP), intent(inout) :: MOMY_av(ka,ia,ja)
    real(RP), intent(inout) :: RHOT_av(ka,ia,ja)
    real(RP), intent(inout) :: QTRC_av(ka,ia,ja,qa)

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

    real(RP), intent(out)   :: num_diff(ka,ia,ja,5,3)
    real(RP), intent(out)   :: num_diff_q(ka,ia,ja,3)

    real(RP), intent(in)    :: DENS_tp(ka,ia,ja)
    real(RP), intent(in)    :: MOMZ_tp(ka,ia,ja)
    real(RP), intent(in)    :: MOMX_tp(ka,ia,ja)
    real(RP), intent(in)    :: MOMY_tp(ka,ia,ja)
    real(RP), intent(in)    :: RHOT_tp(ka,ia,ja)
    real(RP), intent(in)    :: RHOQ_tp(ka,ia,ja,qa)

    real(RP), intent(in)    :: CORIOLI(ia,ja)

    real(RP), intent(in)    :: CDZ (ka)
    real(RP), intent(in)    :: CDX (ia)
    real(RP), intent(in)    :: CDY (ja)
    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)    :: AQ_CV(qqa)

    real(RP), intent(in)    :: REF_dens(ka,ia,ja)
    real(RP), intent(in)    :: REF_pott(ka,ia,ja)
    real(RP), intent(in)    :: REF_qv  (ka,ia,ja)
    real(RP), intent(in)    :: REF_pres(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)    :: ND_COEF
    real(RP), intent(in)    :: ND_COEF_Q
    integer,  intent(in)    :: ND_ORDER
    real(RP), intent(in)    :: ND_SFC_FACT
    logical,  intent(in)    :: ND_USE_RS

    real(RP), intent(in)    :: DAMP_DENS(ka,ia,ja)
    real(RP), intent(in)    :: DAMP_VELZ(ka,ia,ja)
    real(RP), intent(in)    :: DAMP_VELX(ka,ia,ja)
    real(RP), intent(in)    :: DAMP_VELY(ka,ia,ja)
    real(RP), intent(in)    :: DAMP_POTT(ka,ia,ja)
    real(RP), intent(in)    :: DAMP_QTRC(ka,ia,ja,bnd_qa)

    real(RP), intent(in)    :: DAMP_alpha_DENS(ka,ia,ja)
    real(RP), intent(in)    :: DAMP_alpha_VELZ(ka,ia,ja)
    real(RP), intent(in)    :: DAMP_alpha_VELX(ka,ia,ja)
    real(RP), intent(in)    :: DAMP_alpha_VELY(ka,ia,ja)
    real(RP), intent(in)    :: DAMP_alpha_POTT(ka,ia,ja)
    real(RP), intent(in)    :: DAMP_alpha_QTRC(ka,ia,ja,bnd_qa)

    real(RP), intent(in)    :: divdmp_coef

    logical,  intent(in)    :: FLAG_FCT_MOMENTUM
    logical,  intent(in)    :: FLAG_FCT_T
    logical,  intent(in)    :: FLAG_FCT_TRACER
    logical,  intent(in)    :: FLAG_FCT_ALONG_STREAM

    logical,  intent(in)    :: USE_AVERAGE

    real(DP), intent(in)    :: DTL
    real(DP), intent(in)    :: DTS

    ! for time integartion
    real(RP) :: DENS0   (ka,ia,ja)
    real(RP) :: MOMZ0   (ka,ia,ja)
    real(RP) :: MOMX0   (ka,ia,ja)
    real(RP) :: MOMY0   (ka,ia,ja)
    real(RP) :: RHOT0   (ka,ia,ja)
    real(RP) :: QTRC0   (ka,ia,ja,qa)
    real(RP) :: PROG0   (ka,ia,ja,va)

    real(DP) :: dtrk

    logical :: last

    integer :: n, iq

    !---------------------------------------------------------------------------

    call prof_rapstart("DYN_Large_RK3_Prep", 3)

    !##### SAVE #####
!OCL XFILL
       dens0(:,:,:) = dens(:,:,:)
!OCL XFILL
       momz0(:,:,:) = momz(:,:,:)
!OCL XFILL
       momx0(:,:,:) = momx(:,:,:)
!OCL XFILL
       momy0(:,:,:) = momy(:,:,:)
!OCL XFILL
       rhot0(:,:,:) = rhot(:,:,:)
!OCL XFILL
       qtrc0(:,:,:,:) = qtrc(:,:,:,:)

       if ( va > 0 ) then
!OCL XFILL
          prog0(:,:,:,:) = prog(:,:,:,:)
       end if

       call prof_rapend  ("DYN_Large_RK3_Prep", 3)

       !------------------------------------------------------------------------
       ! Start RK
       !------------------------------------------------------------------------

       call prof_rapstart("DYN_Large_RK3", 3)

       do n = 1, 3

          dtrk = dtl / real( 4-n, kind=dp )
          last = n == 3

          if ( n > 1 ) then
             dens = dens0
             momz = momz0
             momx = momx0
             momy = momy0
             rhot = rhot0
             if ( va > 0 ) prog = prog0
          end if

          call atmos_dyn_tstep_large( &
               dens,    momz,    momx,    momy,    rhot,    qtrc,    prog,  & ! (inout)
               dens_av, momz_av, momx_av, momy_av, rhot_av, qtrc_av,        & ! (inout)
               mflx_hi, tflx_hi,                                            & ! (out)
               num_diff, num_diff_q,                                        & ! (out)
               qtrc0,                                                       & ! (in)
               dens_tp, momz_tp, momx_tp, momy_tp, rhot_tp, rhoq_tp,        & ! (in)
               corioli,                                                     & ! (in)
               cdz, cdx, cdy, fdz, fdx, fdy,                                & ! (in)
               rcdz, rcdx, rcdy, rfdz, rfdx, rfdy,                          & ! (in)
               phi, gsqrt,                                                  & ! (in)
               j13g, j23g, j33g, mapf,                                      & ! (in)
               aq_cv,                                                       & ! (in)
               ref_dens, ref_pott, ref_qv, ref_pres,                        & ! (in)
               bnd_w, bnd_e, bnd_s, bnd_n,                                  & ! (in)
               nd_coef, nd_coef_q, nd_order, nd_sfc_fact, nd_use_rs,        & ! (in)
               damp_dens,       damp_velz,       damp_velx,                 & ! (in)
               damp_vely,       damp_pott,       damp_qtrc,                 & ! (in)
               damp_alpha_dens, damp_alpha_velz, damp_alpha_velx,           & ! (in)
               damp_alpha_vely, damp_alpha_pott, damp_alpha_qtrc,           & ! (in)
               divdmp_coef,                                                 & ! (in)
               flag_fct_momentum, flag_fct_t, flag_fct_tracer,              & ! (in)
               flag_fct_along_stream,                                       & ! (in)
               use_average .AND. last,                                      & ! (in)
               dtrk, dts, last                                              ) ! (in)

       end do

       call prof_rapend  ("DYN_Large_RK3", 3)

    return
  end subroutine atmos_dyn_tinteg_large_rk3

end module scale_atmos_dyn_tinteg_large_rk3