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
    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_R, AQ_CV, AQ_CP, AQ_MASS,                          &
       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,    &
       wdamp_coef,                                           &
       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
#ifdef HIST_TEND
    use scale_history, only: &
       hist_in
#endif
    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_r   (qa)
    real(RP), intent(in)    :: aq_cv  (qa)
    real(RP), intent(in)    :: aq_cp  (qa)
    real(RP), intent(in)    :: aq_mass(qa)

    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)    :: wdamp_coef(ka)
    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_r, aq_cv, aq_cp, aq_mass,                                 & ! (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)
               wdamp_coef,                                                  & ! (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