mod_atmos_phy_cp_driver.F90

Go to the documentation of this file.

!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
#include "scalelib.h"
module mod_atmos_phy_cp_driver
  !-----------------------------------------------------------------------------
  !
  !++ used modules
  !
  use scale_precision
  use scale_io
  use scale_prof
  use scale_atmos_grid_cartesc_index
  use scale_tracer
  !-----------------------------------------------------------------------------
  implicit none
  private
  !-----------------------------------------------------------------------------
  !
  !++ Public procedure
  !
  public :: atmos_phy_cp_driver_setup
  public :: atmos_phy_cp_driver_finalize
  public :: atmos_phy_cp_driver_calc_tendency
 
  !-----------------------------------------------------------------------------
  !
  !++ Public parameters & variables
  !
  !-----------------------------------------------------------------------------
  !
  !++ Private procedure
  !
  !-----------------------------------------------------------------------------
  !
  !++ Private parameters & variables
  !
  !-----------------------------------------------------------------------------
contains
  !-----------------------------------------------------------------------------
  subroutine atmos_phy_cp_driver_setup
    use scale_prc, only: &
       prc_abort
    use scale_atmos_phy_cp_common, only: &
       atmos_phy_cp_common_setup
    use scale_atmos_phy_cp_kf, only: &
       atmos_phy_cp_kf_setup
    use scale_atmos_phy_cp_kf_jmapplib, only: &
       atmos_phy_cp_kf_jmapplib_setup
    use mod_atmos_admin, only: &
       atmos_phy_cp_type, &
       atmos_sw_phy_cp
    use scale_time , only :&
       dt => time_dtsec_atmos_phy_cp
    use scale_atmos_grid_cartesc, only: &
       dx
    use scale_atmos_grid_cartesc_real, only: &
       cz   => atmos_grid_cartesc_real_cz, &
       area => atmos_grid_cartesc_real_area
    use scale_atmos_hydrometeor, only: &
       atmos_hydrometeor_ice_phase
    implicit none
 
    logical :: warmrain
    !---------------------------------------------------------------------------
 
    log_newline
    log_info("ATMOS_PHY_CP_driver_setup",*) 'Setup'
 
    if ( atmos_sw_phy_cp ) then
 
       ! setup library component
       call atmos_phy_cp_common_setup
       select case ( atmos_phy_cp_type )
       case ( 'KF' )
          warmrain = ( .not. atmos_hydrometeor_ice_phase )
          call atmos_phy_cp_kf_setup( ka, ks, ke, ia, is, ie, ja, js, je, &
                                      cz, area, &
                                      warmrain  )
       case ( 'KF-JMAPPLIB' )
          call atmos_phy_cp_kf_jmapplib_setup( ka, ks, ke, ia, ja, &
                                               dx, dt )
       case default
          log_error("ATMOS_PHY_CP_driver_setup",*) 'ATMOS_PHY_CP_TYPE (', trim(atmos_phy_cp_type), ') is invalid. Check!'
          call prc_abort
       end select
 
    else
       log_info("ATMOS_PHY_CP_driver_setup",*) 'this component is never called.'
    endif
 
    return
  end subroutine atmos_phy_cp_driver_setup
 
  !-----------------------------------------------------------------------------
  subroutine atmos_phy_cp_driver_finalize
    use scale_atmos_phy_cp_kf, only: &
       atmos_phy_cp_kf_finalize
    use mod_atmos_admin, only: &
       atmos_phy_cp_type, &
       atmos_sw_phy_cp
    implicit none
    !---------------------------------------------------------------------------
 
    log_newline
    log_info("ATMOS_PHY_CP_driver_finalize",*) 'Finalize'
 
    if ( atmos_sw_phy_cp ) then
 
       select case ( atmos_phy_cp_type )
       case ( 'KF' )
          call atmos_phy_cp_kf_finalize
       end select
 
    endif
 
    return
  end subroutine atmos_phy_cp_driver_finalize
 
  !-----------------------------------------------------------------------------
  subroutine atmos_phy_cp_driver_calc_tendency( update_flag )
    use scale_statistics, only: &
       statistics_checktotal, &
       statistics_total
    use scale_atmos_grid_cartesc_real, only: &
       atmos_grid_cartesc_real_vol,       &
       atmos_grid_cartesc_real_totvol,    &
       atmos_grid_cartesc_real_volwxy,    &
       atmos_grid_cartesc_real_totvolwxy, &
       atmos_grid_cartesc_real_volzuy,    &
       atmos_grid_cartesc_real_totvolzuy, &
       atmos_grid_cartesc_real_volzxv,    &
       atmos_grid_cartesc_real_totvolzxv
    use scale_file_history, only: &
       file_history_in
    use scale_time , only :&
       time_dtsec, &
       time_dtsec_atmos_phy_cp
    use scale_atmos_grid_cartesc_real, only: &
       cz => atmos_grid_cartesc_real_cz, &
       fz => atmos_grid_cartesc_real_fz
    use scale_atmos_hydrometeor, only: &
       hyd_name, &
       cv_water, &
       cv_ice,   &
       lhf
    use scale_atmos_phy_cp_kf, only: &
       atmos_phy_cp_kf_tendency
    use scale_atmos_phy_cp_kf_jmapplib, only: &
       atmos_phy_cp_kf_jmapplib_tendency
    use scale_atmos_phy_cp_common, only: &
       atmos_phy_cp_common_wmean
    use mod_atmos_phy_mp_vars, only: &
       qs_mp, &
       qe_mp
    use mod_atmos_phy_mp_driver, only: &
       atmos_phy_mp_driver_qhyd2qtrc
    use mod_atmos_admin, only: &
       atmos_phy_cp_type
    use mod_atmos_vars, only: &
       dens   => dens_av, &
       momz   => momz_av, &
       momx   => momx_av, &
       momy   => momy_av, &
       rhot   => rhot_av, &
       qtrc   => qtrc_av, &
       dens_t => dens_tp, &
       momz_t => momz_tp, &
       momx_t => momx_tp, &
       momy_t => momy_tp, &
       rhot_t => rhot_tp, &
       rhoq_t => rhoq_tp, &
       u,                 &
       v,                 &
       w,                 &
       temp,              &
       pott,              &
       pres,              &
       exner,             &
       qdry,              &
       qv,                &
       qc,                &
       qi
    use scale_atmos_hydrometeor, only: &
       n_hyd
    use mod_atmos_phy_cp_vars, only: &
       dens_t_cp      => atmos_phy_cp_dens_t,         &
       rhot_t_cp      => atmos_phy_cp_rhot_t,         &
       rhoqv_t_cp     => atmos_phy_cp_rhoqv_t,        &
       rhohyd_t_cp    => atmos_phy_cp_rhohyd_t,       &
       mflx_cloudbase => atmos_phy_cp_mflx_cloudbase, &
       sflx_rain      => atmos_phy_cp_sflx_rain,      &  ! convective rain [kg/m2/s]
       sflx_snow      => atmos_phy_cp_sflx_snow,      &  ! convective snow [kg/m2/s]
       sflx_engi      => atmos_phy_cp_sflx_engi,      &  ! internal energy flux [J/m2/s]
       cloudtop       => atmos_phy_cp_cloudtop,       &  ! cloud top height [m]
       cloudbase      => atmos_phy_cp_cloudbase,      &  ! cloud base height [m]
       cldfrac_dp     => atmos_phy_cp_cldfrac_dp,     &  ! cloud fraction (deep convection) (0-1)
       cldfrac_sh     => atmos_phy_cp_cldfrac_sh,     &  ! cloud fraction (shallow convection) (0-1)
       w0mean         => atmos_phy_cp_w0mean,         &  ! running mean vertical wind velocity [m/s]
       kf_nca         => atmos_phy_cp_kf_nca             ! advection/cumulus convection timescale/dt for KF [step]
    use mod_atmos_phy_bl_vars, only: &
       pblh      => atmos_phy_bl_zi, &
       sflx_buoy => atmos_phy_bl_sflx_buoy
    use mod_atmos_phy_sf_vars, only: &
       us => atmos_phy_sf_ustar
    implicit none
 
    logical, intent(in) :: update_flag
 
    real(rp) :: rhoq_t_cp(ka,ia,ja,qs_mp:qe_mp)
 
    real(rp) :: sflx_prec(ia,ja)
 
    integer  :: k, i, j, iq
    !---------------------------------------------------------------------------
 
    if ( atmos_phy_cp_type /= "KF-JMAPPLIB" ) then
 
       ! temporal running mean of vertical velocity
!       !$acc update host(W,w0mean)
       call atmos_phy_cp_common_wmean( ka, ks, ke, ia, is, ie, ja, js, je, &
                                       w(:,:,:),                            & ! [IN]
                                       time_dtsec, time_dtsec_atmos_phy_cp, & ! [IN]
                                       w0mean(:,:,:)                        ) ! [INOUT]
!       !$acc update device(w0mean)
    end if
 
 
    if ( update_flag ) then ! update
 
       !$acc data create(SFLX_prec)
 
       select case ( atmos_phy_cp_type )
       case ( 'KF' )
!          !$acc update host(DENS,U,V,RHOT,TEMP,PRES,QDRY,QV,DENS_t_CP,RHOT_t_CP,RHOQV_t_CP,RHOHYD_t_CP,kf_nca,SFLX_rain,SFLX_snow,SFLX_ENGI,cloudtop,cloudbase,cldfrac_dp,cldfrac_sh)
          call atmos_phy_cp_kf_tendency( ka, ks, ke, ia, is, ie, ja, js, je, &
                                         dens(:,:,:),                              & ! [IN]
                                         u(:,:,:), v(:,:,:),                       & ! [IN]
                                         rhot(:,:,:), temp(:,:,:), pres(:,:,:),    & ! [IN]
                                         qdry(:,:,:), qv(:,:,:),                   & ! [IN]
                                         w0mean(:,:,:),                            & ! [IN]
                                         fz(:,:,:),                                & ! [IN]
                                         time_dtsec_atmos_phy_cp,                  & ! [IN]
                                         dens_t_cp(:,:,:),                         & ! [INOUT]
                                         rhot_t_cp(:,:,:),                         & ! [INOUT]
                                         rhoqv_t_cp(:,:,:), rhohyd_t_cp(:,:,:,:),  & ! [INOUT]
                                         kf_nca(:,:),                              & ! [INOUT]
                                         sflx_rain(:,:), sflx_snow(:,:),           & ! [INOUT]
                                         sflx_engi(:,:),                           & ! [INOUT]
                                         cloudtop(:,:), cloudbase(:,:),            & ! [INOUT]
                                         cldfrac_dp(:,:,:), cldfrac_sh(:,:,:)      ) ! [INOUT]
!          !$acc update device(DENS_t_CP,RHOT_t_CP,RHOQV_t_CP,RHOHYD_t_CP,kf_nca,SFLX_rain,SFLX_snow,SFLX_ENGI,cloudtop,cloudbase,cldfrac_dp,cldfrac_sh)
 
          !$omp parallel do
          !$acc kernels
          do j = js, je
          do i = is, ie
             sflx_prec(i,j) = sflx_rain(i,j) + sflx_snow(i,j)
          end do
          end do
          !$acc end kernels
 
       case ( 'KF-JMAPPLIB' )
 
          !$omp parallel do
          !$acc kernels
          do j = js, je
          do i = is, ie
             sflx_prec(i,j) = sflx_rain(i,j) + sflx_snow(i,j)
          end do
          end do
          !$acc end kernels
 
          !$acc update host(DENS,U,V,W,TEMP,POTT,PRES,EXNER,QDRY,QV,QC,QI,us,PBLH,SFLX_BUOY,RHOT_t_CP,RHOQV_t_CP,RHOHYD_t_CP,w0mean,kf_nca,SFLX_rain,SFLX_snow,SFLX_prec,cloudtop,cloudbase)
          call atmos_phy_cp_kf_jmapplib_tendency( ka, ks, ke, ia, is, ie, ja, js, je, &
                                                  dens(:,:,:),                             & ! [IN]
                                                  u(:,:,:), v(:,:,:), w(:,:,:),            & ! [IN]
                                                  temp(:,:,:), pott(:,:,:),                & ! [IN]
                                                  pres(:,:,:), exner(:,:,:),               & ! [IN]
                                                  qdry(:,:,:), qv(:,:,:),                  & ! [IN]
                                                  qc(:,:,:), qi(:,:,:),                    & ! [IN]
                                                  us(:,:), pblh(:,:), sflx_buoy(:,:),      & ! [IN]
                                                  cz(:,:,:), fz(:,:,:),                    & ! [IN]
                                                  dens_t_cp(:,:,:),                        & ! [OUT]
                                                  rhot_t_cp(:,:,:),                        & ! [INOUT]
                                                  rhoqv_t_cp(:,:,:), rhohyd_t_cp(:,:,:,:), & ! [INOUT]
                                                  w0mean(:,:,:), kf_nca(:,:),              & ! [INOUT]
                                                  sflx_rain(:,:), sflx_snow(:,:),          & ! [INOUT]
                                                  sflx_prec(:,:),                          & ! [INOUT]
                                                  cloudtop(:,:), cloudbase(:,:)            ) ! [INOUT]
          !$acc update device(DENS_t_CP,RHOT_t_CP,RHOQV_t_CP,RHOHYD_t_CP,w0mean,kf_nca,SFLX_rain,SFLX_snow,SFLX_prec,cloudtop,cloudbase)
          !$omp parallel do
          !$acc kernels
          do j = js, je
          do i = is, ie
             ! assume that temperature of precipitation is the same as that at the lowest layer
             sflx_engi(i,j) = sflx_rain(i,j) * cv_water * temp(ks,i,j) &
                            + sflx_snow(i,j) * ( cv_ice * temp(ks,i,j) - lhf )
          end do
          end do
          !$acc end kernels
 
       end select
 
!OCL XFILL
       !$omp parallel do
       !$acc kernels
       do j  = js, je
       do i  = is, ie
          mflx_cloudbase(i,j) = 0.0_rp
       enddo
       enddo
       !$acc end kernels
 
       ! diagnose tendency of number concentration
 
       call file_history_in( w0mean(:,:,:),         'w0mean', 'running mean vertical wind velocity', 'kg/m2/s', fill_halo=.true. )
       call file_history_in( mflx_cloudbase(:,:),   'CBMFX',     'cloud base mass flux',             'kg/m2/s', fill_halo=.true. )
       call file_history_in( sflx_rain(:,:),   'RAIN_CP',   'surface rain rate by CP',          'kg/m2/s', fill_halo=.true. )
       call file_history_in( sflx_snow(:,:),   'SNOW_CP',   'surface snow rate by CP',          'kg/m2/s', fill_halo=.true. )
       call file_history_in( sflx_prec(:,:),   'PREC_CP',   'surface precipitation rate by CP', 'kg/m2/s', fill_halo=.true. )
       call file_history_in( cloudtop(:,:),   'CUMHGT',    'CP cloud top height',              'm',       fill_halo=.true. )
       call file_history_in( cloudbase(:,:),   'CUBASE',    'CP cloud base height',             'm',       fill_halo=.true. )
       call file_history_in( cldfrac_dp(:,:,:), 'CUMFRC_DP', 'CP cloud fraction (deep)',         '1',       fill_halo=.true. )
       call file_history_in( cldfrac_sh(:,:,:), 'CUMFRC_SH', 'CP cloud fraction (shallow)',      '1',       fill_halo=.true. )
       call file_history_in( kf_nca(:,:),   'kf_nca',    'advection or cumulus convection timescale for KF', 's', fill_halo=.true. )
 
       call file_history_in( dens_t_cp(:,:,:), 'DENS_t_CP', 'tendency DENS in CP', 'kg/m3/s'  , fill_halo=.true. )
       call file_history_in( rhot_t_cp(:,:,:), 'RHOT_t_CP', 'tendency RHOT in CP', 'K*kg/m3/s', fill_halo=.true. )
 
       call file_history_in( rhoqv_t_cp(:,:,:), 'QV_t_CP',  'tendency rho*QV in CP', 'kg/m3/s', fill_halo=.true. )
       do iq = 1, n_hyd
          call file_history_in( rhohyd_t_cp(:,:,:,iq), trim(hyd_name(iq))//'_t_CP', &
                                'tendency rho*'//trim(hyd_name(iq))//' in CP', 'kg/m3/s', fill_halo=.true. )
       enddo
 
       !$acc end data
 
    endif ! update
 
    !$omp parallel do private(i,j,k) OMP_SCHEDULE_ collapse(2)
    !$acc kernels
    do j = js, je
    do i = is, ie
    do k = ks, ke
       dens_t(k,i,j) = dens_t(k,i,j) + dens_t_cp(k,i,j)
       rhot_t(k,i,j) = rhot_t(k,i,j) + rhot_t_cp(k,i,j)
    enddo
    enddo
    enddo
    !$acc end kernels
 
    !$acc data create(RHOQ_t_CP)
 
    call atmos_phy_mp_driver_qhyd2qtrc( ka, ks, ke, ia, is, ie, ja, js, je, &
                                        rhoqv_t_cp(:,:,:), rhohyd_t_cp(:,:,:,:), & ! [IN]
                                        rhoq_t_cp(:,:,:,qs_mp:qe_mp)             ) ! [OUT]
 
    !$omp parallel do private(iq,i,j,k) OMP_SCHEDULE_ collapse(3)
    !$acc kernels
    do iq = qs_mp, qe_mp
    do j  = js, je
    do i  = is, ie
    do k  = ks, ke
       rhoq_t(k,i,j,iq) = rhoq_t(k,i,j,iq) + rhoq_t_cp(k,i,j,iq)
    enddo
    enddo
    enddo
    enddo
    !$acc end kernels
 
    if ( statistics_checktotal ) then
       call statistics_total( ka, ks, ke, ia, is, ie, ja, js, je, &
                              dens_t_cp(:,:,:), 'DENS_t_CP',       &
                              atmos_grid_cartesc_real_vol(:,:,:),  &
                              atmos_grid_cartesc_real_totvol       )
       call statistics_total( ka, ks, ke, ia, is, ie, ja, js, je, &
                              rhot_t_cp(:,:,:), 'RHOT_t_CP',       &
                              atmos_grid_cartesc_real_vol(:,:,:),  &
                              atmos_grid_cartesc_real_totvol       )
 
       do iq = qs_mp, qe_mp
          call statistics_total( ka, ks, ke, ia, is, ie, ja, js, je, &
                                 rhoq_t_cp(:,:,:,iq), trim(tracer_name(iq))//'_t_CP', &
                                 atmos_grid_cartesc_real_vol(:,:,:),                  &
                                 atmos_grid_cartesc_real_totvol                       )
       enddo
    endif
 
    !$acc end data
 
    return
  end subroutine atmos_phy_cp_driver_calc_tendency
 
end module mod_atmos_phy_cp_driver