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_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_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( atmos_phy_mp_type )

    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_phy_mp, only: &
       atmos_phy_mp
    use mod_atmos_vars, only: &
       dens,              &
       momz,              &
       momx,              &
       momy,              &
       rhot,              &
       qtrc,              &
       dens_t => dens_tp, &
       momz_t => momz_tp, &
       momx_t => momx_tp, &
       momy_t => momy_tp, &
       rhot_t => rhot_tp, &
       rhoq_t => rhoq_tp
    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) :: precip(ia,ja)
    real(RP) :: total ! dummy

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

    if ( update_flag ) then

!OCL XFILL
       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
       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 = 1, qa
       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',      'surface rain rate by MP',          'kg/m2/s',  nohalo=.true. )
       call hist_in( sflx_snow(:,:),   'SNOW',      '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 = 1, qa
          call hist_in( rhoq_t_mp(:,:,:,iq), trim(aq_name(iq))//'_t_MP', &
                        'tendency rho*'//trim(aq_name(iq))//'in MP', 'kg/m3/s', nohalo=.true. )
       enddo

    endif

    !$omp parallel do private(i,j,k) OMP_SCHEDULE_ collapse(2)
    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

    !$omp parallel do private(i,j,k) OMP_SCHEDULE_ collapse(3)
    do iq = 1,  qa
    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 = 1, qa
          call stat_total( total, rhoq_t_mp(:,:,:,iq), trim(aq_name(iq))//'_t_MP' )
       enddo
    endif

    return
  end subroutine atmos_phy_mp_driver

end module mod_atmos_phy_mp_driver