mod_atmos_dyn_driver.F90

Go to the documentation of this file.

!-------------------------------------------------------------------------------
#include "scalelib.h"
module mod_atmos_dyn_driver
  !-----------------------------------------------------------------------------
  !
  !++ used modules
  !
  use scale_precision
  use scale_io
  use scale_prof
  use scale_atmos_grid_cartesc_index
  use scale_index
  use scale_tracer
  !-----------------------------------------------------------------------------
  implicit none
  private
  !-----------------------------------------------------------------------------
  !
  !++ Public procedure
  !
  public :: atmos_dyn_driver_setup
  public :: atmos_dyn_driver_finalize
  public :: atmos_dyn_driver
 
  !-----------------------------------------------------------------------------
  !
  !++ Public parameters & variables
  !
  character(len=H_SHORT), public :: atmos_dyn_tstep_large_type     = 'FVM-HEVE'
  character(len=H_SHORT), public :: atmos_dyn_tstep_tracer_type    = 'FVM-HEVE'
 
  character(len=H_SHORT), public :: atmos_dyn_tinteg_large_type    = 'EULER'        ! Type of time integration
                                                                   ! 'RK3'
  character(len=H_SHORT), public :: atmos_dyn_tinteg_short_type    = 'RK4'
                                                                   ! 'RK3WS2002'
                                                                   ! 'RK3'
                                                                   ! 'RK7s6o' (only for FVM-HEVE)
  character(len=H_SHORT), public :: atmos_dyn_tinteg_tracer_type   = 'RK3WS2002'
                                                                   ! 'EULER'
 
  character(len=H_SHORT), public :: atmos_dyn_fvm_flux_type        = 'CD4'          ! Type of advective flux scheme (FVM)
  character(len=H_SHORT), public :: atmos_dyn_fvm_flux_tracer_type = 'UD3KOREN1993'
                                                                   ! 'CD2'
                                                                   ! 'UD3'
                                                                   ! 'CD4'
                                                                   ! 'UD5'
                                                                   ! 'CD6'
 
  !-----------------------------------------------------------------------------
  !
  !++ Private procedure
  !
  !-----------------------------------------------------------------------------
  !
  !++ Private parameters & variables
  !
  ! Numerical filter
  integer,  private :: atmos_dyn_numerical_diff_laplacian_num
  real(rp), private :: atmos_dyn_numerical_diff_coef          ! nondimensional numerical diffusion
  real(rp), private :: atmos_dyn_numerical_diff_coef_tracer   ! nondimensional numerical diffusion for tracer
  real(rp), private :: atmos_dyn_numerical_diff_sfc_fact
  logical , private :: atmos_dyn_numerical_diff_use_refstate
 
  real(rp), private :: atmos_dyn_wdamp_tau                    ! maximum tau for Rayleigh damping of w [s]
  real(rp), private :: atmos_dyn_wdamp_height                 ! height       to start apply Rayleigh damping [m]
  integer,  private :: atmos_dyn_wdamp_layer                  ! layer number to start apply Rayleigh damping [num]
 
  ! Divergence damping
  real(rp), private :: atmos_dyn_divdmp_coef                  ! Divergence dumping coef
 
  ! Flux-Corrected Transport limiter
  logical,  private :: atmos_dyn_flag_tracer_split_tend
  logical,  private :: atmos_dyn_flag_fct_momentum
  logical,  private :: atmos_dyn_flag_fct_t
  logical,  private :: atmos_dyn_flag_fct_tracer
  logical,  private :: atmos_dyn_flag_fct_along_stream
 
  !-----------------------------------------------------------------------------
contains
  !-----------------------------------------------------------------------------
  subroutine atmos_dyn_driver_setup
    use scale_prc, only: &
       prc_abort
    use scale_atmos_grid_cartesc, only: &
       domain_center_y => atmos_grid_cartesc_domain_center_y, &
       cy  => atmos_grid_cartesc_cy,  &
       fz  => atmos_grid_cartesc_fz,  &
       cdz => atmos_grid_cartesc_cdz, &
       cdx => atmos_grid_cartesc_cdx, &
       cdy => atmos_grid_cartesc_cdy, &
       fdz => atmos_grid_cartesc_fdz, &
       fdx => atmos_grid_cartesc_fdx, &
       fdy => atmos_grid_cartesc_fdy
    use scale_atmos_grid_cartesc_real, only: &
       real_lat => atmos_grid_cartesc_real_lat
    use scale_time, only: &
       time_dtsec_atmos_dyn
    use mod_atmos_admin, only: &
       atmos_sw_dyn,   &
       atmos_dyn_type
    use mod_atmos_vars, only: &
       dens, &
       momz, &
       momx, &
       momy, &
       rhot, &
       qtrc
    use mod_atmos_dyn_vars, only: &
       prog
    use scale_atmos_dyn, only: &
       atmos_dyn_setup
    implicit none
 
    namelist / param_atmos_dyn / &
       atmos_dyn_tinteg_short_type,            &
       atmos_dyn_tinteg_tracer_type,           &
       atmos_dyn_tinteg_large_type,            &
       atmos_dyn_fvm_flux_type,                &
       atmos_dyn_fvm_flux_tracer_type,         &
       atmos_dyn_numerical_diff_laplacian_num, &
       atmos_dyn_numerical_diff_coef,          &
       atmos_dyn_numerical_diff_coef_tracer,   &
       atmos_dyn_numerical_diff_sfc_fact,      &
       atmos_dyn_numerical_diff_use_refstate,  &
       atmos_dyn_wdamp_tau,                    &
       atmos_dyn_wdamp_height,                 &
       atmos_dyn_wdamp_layer,                  &
       atmos_dyn_divdmp_coef,                  &
       atmos_dyn_flag_tracer_split_tend,       &
       atmos_dyn_flag_fct_momentum,            &
       atmos_dyn_flag_fct_t,                   &
       atmos_dyn_flag_fct_tracer,              &
       atmos_dyn_flag_fct_along_stream
 
    real(rp) :: dt
    integer  :: ierr
    !---------------------------------------------------------------------------
 
    log_newline
    log_info("ATMOS_DYN_driver_setup",*) 'Setup'
 
    if ( atmos_sw_dyn ) then
 
       atmos_dyn_numerical_diff_laplacian_num = 2
       atmos_dyn_numerical_diff_coef          = 1.0e-4_rp
       atmos_dyn_numerical_diff_coef_tracer   = 0.0_rp
       atmos_dyn_numerical_diff_sfc_fact      = 1.0_rp
       atmos_dyn_numerical_diff_use_refstate  = .true.
 
       atmos_dyn_wdamp_tau    = -1.0_rp
       atmos_dyn_wdamp_height = -1.0_rp
       atmos_dyn_wdamp_layer  = -1
 
       atmos_dyn_divdmp_coef = 0.0_rp
 
       atmos_dyn_flag_tracer_split_tend = .false.
       atmos_dyn_flag_fct_momentum      = .false.
       atmos_dyn_flag_fct_t             = .false.
       atmos_dyn_flag_fct_tracer        = .false.
       atmos_dyn_flag_fct_along_stream  = .true.
 
       !--- read namelist
       rewind(io_fid_conf)
       read(io_fid_conf,nml=param_atmos_dyn,iostat=ierr)
       if( ierr < 0 ) then !--- missing
          log_info("ATMOS_DYN_driver_setup",*) 'Not found namelist. Default used.'
       elseif( ierr > 0 ) then !--- fatal error
          log_error("ATMOS_DYN_driver_setup",*) 'Not appropriate names in namelist PARAM_ATMOS_DYN. Check!'
          call prc_abort
       endif
       log_nml(param_atmos_dyn)
 
       dt = real(time_dtsec_atmos_dyn,kind=rp)
 
       if ( atmos_dyn_wdamp_layer > kmax ) then
          log_error("ATMOS_DYN_driver_setup",*) 'ATMOS_DYN_wdamp_layer should be less than total number of vertical layer(KA). Check!'
          call prc_abort
       elseif( atmos_dyn_wdamp_layer > 0 ) then
          atmos_dyn_wdamp_height = fz(atmos_dyn_wdamp_layer+ks-1)
       endif
 
       if ( atmos_dyn_wdamp_tau < 0.0_rp ) then
          atmos_dyn_wdamp_tau = dt * 10.0_rp
       elseif ( atmos_dyn_wdamp_tau < dt ) then
          log_error("ATMOS_DYN_driver_setup",*) 'ATMOS_DYN_wdamp_tau should be larger than TIME_DT_ATMOS_DYN. Check!'
          call prc_abort
       end if
 
       if ( atmos_sw_dyn ) then
          log_newline
          log_info("ATMOS_DYN_driver_setup",*) 'Scheme for Large time step  : ', trim(atmos_dyn_tinteg_large_type)
          log_info("ATMOS_DYN_driver_setup",*) 'Scheme for Short time step  : ', trim(atmos_dyn_tinteg_short_type)
          log_info("ATMOS_DYN_driver_setup",*) 'Scheme for Tracer advection : ', trim(atmos_dyn_tinteg_tracer_type)
       endif
 
       call atmos_dyn_setup( atmos_dyn_tinteg_short_type,        & ! [IN]
                             atmos_dyn_tinteg_tracer_type,       & ! [IN]
                             atmos_dyn_tinteg_large_type,        & ! [IN]
                             atmos_dyn_tstep_tracer_type,        & ! [IN]
                             atmos_dyn_tstep_large_type,         & ! [IN]
                             atmos_dyn_type,                     & ! [IN] Note that ATMOS_DYN_TYPE corresponds to ATMOS_DYN_TSTEP_SHORT_TYPE. 
                             atmos_dyn_fvm_flux_type,            & ! [IN]
                             atmos_dyn_fvm_flux_tracer_type,     & ! [IN]
                             dens, momz, momx, momy, rhot, qtrc, & ! [IN]
                             prog,                               & ! [IN]
                             cdz, cdx, cdy, fdz, fdx, fdy,       & ! [IN]
                             atmos_dyn_wdamp_tau,                & ! [IN]
                             atmos_dyn_wdamp_height,             & ! [IN]
                             fz,                                 & ! [IN]
                             none = atmos_dyn_type=='NONE'       ) ! [IN]
    endif
 
    return
  end subroutine atmos_dyn_driver_setup
 
  !-----------------------------------------------------------------------------
  subroutine atmos_dyn_driver_finalize
    use scale_atmos_dyn, only: &
       atmos_dyn_finalize
    use mod_atmos_admin, only: &
       atmos_sw_dyn
 
    if ( atmos_sw_dyn ) then
       call atmos_dyn_finalize
    end if
 
    return
  end subroutine atmos_dyn_driver_finalize
  !-----------------------------------------------------------------------------
  subroutine atmos_dyn_driver( do_flag )
    use scale_prc_cartesc, only: &
       prc_twod
    use scale_atmos_grid_cartesc, only: &
       cdz  => atmos_grid_cartesc_cdz,  &
       cdx  => atmos_grid_cartesc_cdx,  &
       cdy  => atmos_grid_cartesc_cdy,  &
       fdz  => atmos_grid_cartesc_fdz,  &
       fdx  => atmos_grid_cartesc_fdx,  &
       fdy  => atmos_grid_cartesc_fdy,  &
       rcdz => atmos_grid_cartesc_rcdz, &
       rcdx => atmos_grid_cartesc_rcdx, &
       rcdy => atmos_grid_cartesc_rcdy, &
       rfdz => atmos_grid_cartesc_rfdz, &
       rfdx => atmos_grid_cartesc_rfdx, &
       rfdy => atmos_grid_cartesc_rfdy
    use scale_atmos_grid_cartesc_real, only: &
       real_phi => atmos_grid_cartesc_real_phi
    use scale_atmos_grid_cartesc_metric, only: &
       gsqrt => atmos_grid_cartesc_metric_gsqrt, &
       j13g  => atmos_grid_cartesc_metric_j13g,  &
       j23g  => atmos_grid_cartesc_metric_j23g,  &
       j33g  => atmos_grid_cartesc_metric_j33g,  &
       mapf  => atmos_grid_cartesc_metric_mapf
    use scale_time, only: &
       time_dtsec,           &
       time_dtsec_atmos_dyn
    use mod_atmos_admin, only: &
       atmos_use_average
    use scale_atmos_hydrometeor, only: &
       i_qv
    use mod_atmos_vars, only: &
       atmos_vars_check,  &
       dens,    &
       momz,    &
       momx,    &
       momy,    &
       rhot,    &
       qtrc,    &
       dens_av, &
       momz_av, &
       momx_av, &
       momy_av, &
       rhot_av, &
       qtrc_av, &
       dens_tp, &
       rhou_tp, &
       rhov_tp, &
       rhot_tp, &
       rhoq_tp, &
       rhoh_p,  &
       momz_tp, &
       momx_tp, &
       momy_tp, &
       cptot,   &
       exner
    use mod_atmos_dyn_vars, only: &
       prog
    use scale_coriolis, only: &
       coriolis_f
    use scale_atmos_refstate, only: &
       atmos_refstate_dens, &
       atmos_refstate_pott, &
       atmos_refstate_qv,   &
       atmos_refstate_pres
    use mod_atmos_bnd_driver, only: &
       atmos_boundary_dens,       &
       atmos_boundary_velz,       &
       atmos_boundary_velx,       &
       atmos_boundary_vely,       &
       atmos_boundary_pott,       &
       atmos_boundary_qtrc,       &
       atmos_boundary_alpha_dens, &
       atmos_boundary_alpha_velz, &
       atmos_boundary_alpha_velx, &
       atmos_boundary_alpha_vely, &
       atmos_boundary_alpha_pott, &
       atmos_boundary_alpha_qtrc, &
       atmos_boundary_mflux_offset_x, &
       atmos_boundary_mflux_offset_y, &
       bnd_qa, &
       bnd_iq, &
       atmos_boundary_smoother_fact
    use scale_atmos_dyn, only: &
       atmos_dyn
    use scale_comm_cartesc, only: &
       comm_vars8, &
       comm_wait
    implicit none
 
    logical, intent(in) :: do_flag
 
    integer :: k, i, j, iq
    !---------------------------------------------------------------------------
 
#if defined DEBUG || defined QUICKDEBUG
    rhot_tp(   1:ks-1,:,:) = 0.0_rp
    rhot_tp(ke+1:ka,  :,:) = 0.0_rp
    momx_tp(   1:ks-1,:,:) = 0.0_rp
    momx_tp(ke+1:ka,  :,:) = 0.0_rp
    momy_tp(   1:ks-1,:,:) = 0.0_rp
    momy_tp(ke+1:ka,  :,:) = 0.0_rp
#endif
 
    if ( do_flag ) then
 
       !$acc data &
       !$acc copy(DENS,MOMZ,MOMX,MOMY,RHOT,QTRC) &
       !$acc copyin(DENS_tp,RHOU_tp,RHOV_tp,RHOT_tp,RHOQ_tp,RHOH_p,MOMZ_tp,MOMX_tp,MOMY_tp, &
       !$acc        coriolis_f, &
       !$acc        atmos_boundary_dens,atmos_boundary_velz,atmos_boundary_velx,atmos_boundary_vely,atmos_boundary_pott,atmos_boundary_qtrc, &
       !$acc        atmos_boundary_alpha_dens,atmos_boundary_alpha_velz,atmos_boundary_alpha_velx,atmos_boundary_alpha_vely,atmos_boundary_alpha_pott,atmos_boundary_alpha_qtrc, &
       !$acc        atmos_boundary_mflux_offset_x,atmos_boundary_mflux_offset_y)
 
 
       if ( .not. prc_twod ) &
       call comm_vars8( rhou_tp, 1 )
       call comm_vars8( rhov_tp, 2 )
       call comm_vars8( momz_tp, 3 )
       do iq = 1, qa
          call comm_vars8( rhoq_tp(:,:,:,iq), 4+iq)
       end do
 
       !$omp parallel do default(none) OMP_SCHEDULE_ collapse(2) &
       !$omp private(k,i,j) &
       !$omp shared (KA,KS,KE,IS,IE,JS,JE, &
       !$omp         RHOT_tp,RHOH_p,CPtot,EXNER)
       !$acc kernels
       do j = js, je
       do i = is, ie
       do k = ks, ke
          rhot_tp(k,i,j) = rhot_tp(k,i,j) &
                         + rhoh_p(k,i,j) / ( cptot(k,i,j) * exner(k,i,j) )
       end do
       end do
       end do
       !$acc end kernels
       call comm_vars8( rhot_tp, 4 )
 
       if ( prc_twod ) then
          !$omp parallel do default(none) OMP_SCHEDULE_ &
          !$omp private(k,j) &
          !$omp shared (KA,KS,KE,IS,JS,JE, &
          !$omp         MOMX_tp,RHOU_tp)
          !$acc kernels
          do j = js, je
          do k = ks, ke
             momx_tp(k,is,j) = momx_tp(k,is,j) + rhou_tp(k,is,j)
          end do
          end do
          !$acc end kernels
       else
          call comm_wait ( rhou_tp, 1 )
          !$omp parallel do default(none) OMP_SCHEDULE_ collapse(2) &
          !$omp private(k,i,j) &
          !$omp shared (KA,KS,KE,IS,IE,JS,JE, &
          !$omp         MOMX_tp,RHOU_tp)
          !$acc kernels
          do j = js, je
          do i = is, ie
          do k = ks, ke
             momx_tp(k,i,j) = momx_tp(k,i,j) &
                            + 0.5_rp * ( rhou_tp(k,i,j) + rhou_tp(k,i+1,j) )
          end do
          end do
          end do
          !$acc end kernels
          call comm_vars8( momx_tp, 1 )
       end if
 
       call comm_wait ( rhov_tp, 2 )
       !$omp parallel do default(none) OMP_SCHEDULE_ collapse(2) &
       !$omp private(k,i,j) &
       !$omp shared (KA,KS,KE,IS,IE,JS,JE, &
       !$omp         MOMY_tp,RHOV_tp)
       !$acc kernels
       do j = js, je
       do i = is, ie
       do k = ks, ke
          momy_tp(k,i,j) = momy_tp(k,i,j) &
                         + 0.5_rp * ( rhov_tp(k,i,j) + rhov_tp(k,i,j+1) )
       end do
       end do
       end do
       !$acc end kernels
       call comm_vars8( momy_tp, 2 )
 
       call comm_wait ( momz_tp, 3 )
       call comm_wait ( rhot_tp, 4, .false. )
       do iq = 1, qa
          call comm_wait ( rhoq_tp(:,:,:,iq), 4+iq, .false. )
       end do
       if ( .not. prc_twod ) &
       call comm_wait ( momx_tp, 1 )
       call comm_wait ( momy_tp, 2 )
 
 
       call atmos_dyn( dens, momz, momx, momy, rhot, qtrc,                   & ! [INOUT]
                       prog,                                                 & ! [IN]
                       dens_av, momz_av, momx_av, momy_av, rhot_av, qtrc_av, & ! [INOUT]
                       dens_tp, momz_tp, momx_tp, momy_tp, rhot_tp, rhoq_tp, & ! [IN]
                       coriolis_f,                                           & ! [IN]
                       cdz,  cdx,  cdy,  fdz,  fdx,  fdy,                    & ! [IN]
                       rcdz, rcdx, rcdy, rfdz, rfdx, rfdy,                   & ! [IN]
                       real_phi,                                             & ! [IN]
                       gsqrt, j13g, j23g, j33g, mapf,                        & ! [IN]
                       tracer_r, tracer_cv, tracer_cp, tracer_mass,          & ! [IN]
                       atmos_refstate_dens,                                  & ! [IN]
                       atmos_refstate_pott,                                  & ! [IN]
                       atmos_refstate_qv,                                    & ! [IN]
                       atmos_refstate_pres,                                  & ! [IN]
                       atmos_dyn_numerical_diff_coef,                        & ! [IN]
                       atmos_dyn_numerical_diff_coef_tracer,                 & ! [IN]
                       atmos_dyn_numerical_diff_laplacian_num,               & ! [IN]
                       atmos_dyn_numerical_diff_sfc_fact,                    & ! [IN]
                       atmos_dyn_numerical_diff_use_refstate,                & ! [IN]
                       bnd_qa, bnd_iq, atmos_boundary_smoother_fact,         & ! [IN]
                       atmos_boundary_dens,                                  & ! [IN]
                       atmos_boundary_velz,                                  & ! [IN]
                       atmos_boundary_velx,                                  & ! [IN]
                       atmos_boundary_vely,                                  & ! [IN]
                       atmos_boundary_pott,                                  & ! [IN]
                       atmos_boundary_qtrc,                                  & ! [IN]
                       atmos_boundary_alpha_dens,                            & ! [IN]
                       atmos_boundary_alpha_velz,                            & ! [IN]
                       atmos_boundary_alpha_velx,                            & ! [IN]
                       atmos_boundary_alpha_vely,                            & ! [IN]
                       atmos_boundary_alpha_pott,                            & ! [IN]
                       atmos_boundary_alpha_qtrc,                            & ! [IN]
                       atmos_boundary_mflux_offset_x,                        & ! [IN]
                       atmos_boundary_mflux_offset_y,                        & ! [IN]
                       atmos_dyn_divdmp_coef,                                & ! [IN]
                       atmos_dyn_flag_tracer_split_tend,                     & ! [IN]
                       atmos_dyn_flag_fct_momentum,                          & ! [IN]
                       atmos_dyn_flag_fct_t,                                 & ! [IN]
                       atmos_dyn_flag_fct_tracer,                            & ! [IN]
                       atmos_dyn_flag_fct_along_stream,                      & ! [IN]
                       atmos_use_average,                                    & ! [IN]
                       i_qv,                                                 & ! [IN]
                       time_dtsec,                                           & ! [IN]
                       time_dtsec_atmos_dyn                                  ) ! [IN]
 
       call atmos_vars_check
 
       !$acc end data
    endif
 
    return
  end subroutine atmos_dyn_driver
 
end module mod_atmos_dyn_driver