mod_atmos_phy_mp_driver.f90

Go to the documentation of this file.

!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
#include "inc_openmp.h"
module mod_atmos_phy_mp_driver
  !-----------------------------------------------------------------------------
  !
  !++ used modules
  !
  use scale_precision
  use scale_stdio
  use scale_prof
  use scale_grid_index
  use scale_tracer
  !-----------------------------------------------------------------------------
  implicit none
  private
  !-----------------------------------------------------------------------------
  !
  !++ Public procedure
  !
  public :: atmos_phy_mp_driver_config
  public :: atmos_phy_mp_driver_setup
  public :: atmos_phy_mp_driver_resume
  public :: atmos_phy_mp_driver

  !-----------------------------------------------------------------------------
  !
  !++ Public parameters & variables
  !
  !-----------------------------------------------------------------------------
  !
  !++ Private procedure
  !
  !-----------------------------------------------------------------------------
  !
  !++ Private parameters & variables
  !
  !-----------------------------------------------------------------------------
contains
  !-----------------------------------------------------------------------------
  subroutine atmos_phy_mp_driver_config
    use scale_atmos_phy_mp, only: &
       atmos_phy_mp_config
    use mod_atmos_admin, only: &
       atmos_phy_mp_type, &
       atmos_sw_phy_mp
    implicit none
    !---------------------------------------------------------------------------

    if( io_l ) write(io_fid_log,*)
    if( io_l ) write(io_fid_log,*) '++++++ Module[CONFIG] / Categ[ATMOS PHY_MP] / Origin[SCALE-RM]'

    if ( atmos_sw_phy_mp ) then
       call atmos_phy_mp_config( atmos_phy_mp_type )
    end if

    return
  end subroutine atmos_phy_mp_driver_config

  !-----------------------------------------------------------------------------
  subroutine atmos_phy_mp_driver_setup
    use scale_atmos_phy_mp, only: &
       atmos_phy_mp_setup
    use mod_atmos_admin, only: &
       atmos_phy_mp_type, &
       atmos_sw_phy_mp
    use mod_atmos_phy_mp_vars, only: &
       sflx_rain => atmos_phy_mp_sflx_rain, &
       sflx_snow => atmos_phy_mp_sflx_snow
    implicit none
    !---------------------------------------------------------------------------

    if( io_l ) write(io_fid_log,*)
    if( io_l ) write(io_fid_log,*) '++++++ Module[DRIVER] / Categ[ATMOS PHY_MP] / Origin[SCALE-RM]'

    if ( atmos_sw_phy_mp ) then

       ! setup library component
       call atmos_phy_mp_setup

    else

       if( io_l ) write(io_fid_log,*) '*** this component is never called.'
       if( io_l ) write(io_fid_log,*) '*** SFLX_rain and SFLX_snow is set to zero.'
       sflx_rain(:,:) = 0.0_rp
       sflx_snow(:,:) = 0.0_rp

    endif

    return
  end subroutine atmos_phy_mp_driver_setup

  !-----------------------------------------------------------------------------
  subroutine atmos_phy_mp_driver_resume
    use mod_atmos_admin, only: &
       atmos_sw_phy_mp
    implicit none

    if ( atmos_sw_phy_mp ) then

       ! run once (only for the diagnostic value)
       call prof_rapstart('ATM_Microphysics', 1)
       call atmos_phy_mp_driver( update_flag = .true. )
       call prof_rapend  ('ATM_Microphysics', 1)

    end if

    return
  end subroutine atmos_phy_mp_driver_resume

  !-----------------------------------------------------------------------------
  subroutine atmos_phy_mp_driver( update_flag )
    use scale_time, only: &
       dt_mp => time_dtsec_atmos_phy_mp
    use scale_rm_statistics, only: &
       statistics_checktotal, &
       stat_total
    use scale_history, only: &
       hist_in
    use scale_atmos_hydrometeor, only: &
       n_hyd, &
       i_hc,  &
       i_hr,  &
       i_hi,  &
       i_hs,  &
       i_hg,  &
       i_hh
    use scale_atmos_phy_mp, only: &
       atmos_phy_mp,                 &
       atmos_phy_mp_effectiveradius, &
       qs_mp,                        &
       qe_mp
    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, &
       temp
    use mod_atmos_phy_mp_vars, only: &
       dens_t_mp => atmos_phy_mp_dens_t,    &
       momz_t_mp => atmos_phy_mp_momz_t,    &
       momx_t_mp => atmos_phy_mp_momx_t,    &
       momy_t_mp => atmos_phy_mp_momy_t,    &
       rhot_t_mp => atmos_phy_mp_rhot_t,    &
       rhoq_t_mp => atmos_phy_mp_rhoq_t,    &
       evaporate => atmos_phy_mp_evaporate, &
       sflx_rain => atmos_phy_mp_sflx_rain, &
       sflx_snow => atmos_phy_mp_sflx_snow
    use mod_atmos_phy_ae_vars, only: &
       ccn_t => atmos_phy_ae_ccn_t
    implicit none

    logical, intent(in) :: update_flag

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

    real(RP) :: re    (ka,ia,ja,n_hyd) ! effective radius
    real(RP) :: precip(ia,ja)
    real(RP) :: total ! dummy

    integer :: k, i, j, iq
    !---------------------------------------------------------------------------

    if ( update_flag ) then

!OCL XFILL
       !$omp parallel do default(none) &
       !$omp shared(JA,IA,KA,DENS0,MOMZ0,MOMX0,MOMY0,RHOT0,DENS,MOMZ,MOMX,MOMY,RHOT) &
       !$omp private(i,j,k) OMP_SCHEDULE_ collapse(2)
       do j  = 1, ja
       do i  = 1, ia
       do k  = 1, ka
          dens0(k,i,j) = dens(k,i,j) ! save
          momz0(k,i,j) = momz(k,i,j) ! save
          momx0(k,i,j) = momx(k,i,j) ! save
          momy0(k,i,j) = momy(k,i,j) ! save
          rhot0(k,i,j) = rhot(k,i,j) ! save
       enddo
       enddo
       enddo

!OCL XFILL
       do iq = 1, qa
       do j  = 1, ja
       do i  = 1, ia
       do k  = 1, ka
          qtrc0(k,i,j,iq) = qtrc(k,i,j,iq) ! save
       enddo
       enddo
       enddo
       enddo

       ccn(:,:,:) = ccn_t(:,:,:) * dt_mp

       call atmos_phy_mp( dens0(:,:,:),   & ! [INOUT]
                          momz0(:,:,:),   & ! [INOUT]
                          momx0(:,:,:),   & ! [INOUT]
                          momy0(:,:,:),   & ! [INOUT]
                          rhot0(:,:,:),   & ! [INOUT]
                          qtrc0(:,:,:,:), & ! [INOUT]
                          ccn(:,:,:),   & ! [IN]
                          evaporate(:,:,:),   & ! [OUT]
                          sflx_rain(:,:),     & ! [OUT]
                          sflx_snow(:,:)      ) ! [OUT]

!OCL XFILL
       !$omp parallel do default(none) private(i,j,k) OMP_SCHEDULE_ collapse(2) &
       !$omp shared(JS,JE,IS,IE,KS,KE,DENS_t_MP,DENS0,DENS,MOMZ_t_MP,MOMZ0,MOMZ,MOMX_t_MP,MOMX0) &
       !$omp shared(MOMX,MOMY_t_MP,MOMY0,MOMY,RHOT_t_MP,RHOT0,RHOT,dt_MP)
       do j  = js, je
       do i  = is, ie
       do k  = ks, ke
          dens_t_mp(k,i,j) = ( dens0(k,i,j) - dens(k,i,j) ) / dt_mp
          momz_t_mp(k,i,j) = ( momz0(k,i,j) - momz(k,i,j) ) / dt_mp
          momx_t_mp(k,i,j) = ( momx0(k,i,j) - momx(k,i,j) ) / dt_mp
          momy_t_mp(k,i,j) = ( momy0(k,i,j) - momy(k,i,j) ) / dt_mp
          rhot_t_mp(k,i,j) = ( rhot0(k,i,j) - rhot(k,i,j) ) / dt_mp
       enddo
       enddo
       enddo

!OCL XFILL
       do iq = qs_mp, qe_mp
       !$omp parallel do default(none) &
       !$omp shared(JS,JE,IS,IE,KS,KE,RHOQ_t_MP,iq,QTRC0,QTRC,DENS0,DENS,dt_MP) &
       !$omp private(i,j,k) OMP_SCHEDULE_ collapse(2)
       do j  = js, je
       do i  = is, ie
       do k  = ks, ke
          rhoq_t_mp(k,i,j,iq) = ( qtrc0(k,i,j,iq) * dens0(k,i,j) &
                                - qtrc(k,i,j,iq) * dens(k,i,j) ) / dt_mp
       enddo
       enddo
       enddo
       enddo

!OCL XFILL
       do j  = js, je
       do i  = is, ie
          precip(i,j) = sflx_rain(i,j) + sflx_snow(i,j)
       end do
       end do

       call hist_in( sflx_rain(:,:),   'RAIN_MP',   'surface rain rate by MP',          'kg/m2/s',  nohalo=.true. )
       call hist_in( sflx_snow(:,:),   'SNOW_MP',   'surface snow rate by MP',          'kg/m2/s',  nohalo=.true. )
       call hist_in( precip(:,:),   'PREC_MP',   'surface precipitation rate by MP', 'kg/m2/s',  nohalo=.true. )
       call hist_in( evaporate(:,:,:), 'EVAPORATE', 'evaporated cloud number',          'num/m3/s', nohalo=.true. )

       call hist_in( dens_t_mp(:,:,:), 'DENS_t_MP', 'tendency DENS in MP', 'kg/m3/s'  , nohalo=.true. )
       call hist_in( momz_t_mp(:,:,:), 'MOMZ_t_MP', 'tendency MOMZ in MP', 'kg/m2/s2' , nohalo=.true. )
       call hist_in( momx_t_mp(:,:,:), 'MOMX_t_MP', 'tendency MOMX in MP', 'kg/m2/s2' , nohalo=.true. )
       call hist_in( momy_t_mp(:,:,:), 'MOMY_t_MP', 'tendency MOMY in MP', 'kg/m2/s2' , nohalo=.true. )
       call hist_in( rhot_t_mp(:,:,:), 'RHOT_t_MP', 'tendency RHOT in MP', 'K*kg/m3/s', nohalo=.true. )

       do iq = qs_mp, qe_mp
          call hist_in( rhoq_t_mp(:,:,:,iq), trim(tracer_name(iq))//'_t_MP', &
                        'tendency rho*'//trim(tracer_name(iq))//'in MP', 'kg/m3/s', nohalo=.true. )
       enddo

       call atmos_phy_mp_effectiveradius( re(:,:,:,:), & ! [OUT]
                                          qtrc(:,:,:,:), & ! [IN]
                                          dens(:,:,:),   & ! [IN]
                                          temp(:,:,:)    ) ! [IN]

       call hist_in( re(:,:,:,i_hc), 'Re_QC', 'effective radius cloud water', 'cm', nohalo=.true. )
       call hist_in( re(:,:,:,i_hr), 'Re_QR', 'effective radius rain',        'cm', nohalo=.true. )
       call hist_in( re(:,:,:,i_hi), 'Re_QI', 'effective radius ice water',   'cm', nohalo=.true. )
       call hist_in( re(:,:,:,i_hs), 'Re_QS', 'effective radius snow',        'cm', nohalo=.true. )
       call hist_in( re(:,:,:,i_hg), 'Re_QG', 'effective radius graupel',     'cm', nohalo=.true. )
       call hist_in( re(:,:,:,i_hh), 'Re_QH', 'effective radius hail',        'cm', nohalo=.true. )
    endif

    !$omp parallel do default(none) private(i,j,k) OMP_SCHEDULE_ collapse(2) &
    !$omp shared(JS,JE,IS,IE,KS,KE,DENS_t,DENS_t_MP,MOMZ_t,MOMZ_t_MP,MOMX_t,MOMX_t_MP,MOMY_t) &
    !$omp shared(MOMY_t_MP,RHOT_t,RHOT_t_MP)
    do j = js, je
    do i = is, ie
    do k = ks, ke
       dens_t(k,i,j) = dens_t(k,i,j) + dens_t_mp(k,i,j)
       momz_t(k,i,j) = momz_t(k,i,j) + momz_t_mp(k,i,j)
       momx_t(k,i,j) = momx_t(k,i,j) + momx_t_mp(k,i,j)
       momy_t(k,i,j) = momy_t(k,i,j) + momy_t_mp(k,i,j)
       rhot_t(k,i,j) = rhot_t(k,i,j) + rhot_t_mp(k,i,j)
    enddo
    enddo
    enddo

    do iq = qs_mp, qe_mp
    !$omp parallel do default(none) private(i,j,k) OMP_SCHEDULE_ &
    !$omp shared(JS,JE,IS,IE,KS,KE,RHOQ_t,iq,RHOQ_t_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_mp(k,i,j,iq)
    enddo
    enddo
    enddo
    enddo

    if ( statistics_checktotal ) then
       call stat_total( total, dens_t_mp(:,:,:), 'DENS_t_MP' )
       call stat_total( total, momz_t_mp(:,:,:), 'MOMZ_t_MP' )
       call stat_total( total, momx_t_mp(:,:,:), 'MOMX_t_MP' )
       call stat_total( total, momy_t_mp(:,:,:), 'MOMY_t_MP' )
       call stat_total( total, rhot_t_mp(:,:,:), 'RHOT_t_MP' )

       do iq = qs_mp, qe_mp
          call stat_total( total, rhoq_t_mp(:,:,:,iq), trim(tracer_name(iq))//'_t_MP' )
       enddo
    endif

    return
  end subroutine atmos_phy_mp_driver

end module mod_atmos_phy_mp_driver