mod_atmos_phy_tb_driver.f90

Go to the documentation of this file.

!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
#include "inc_openmp.h"
module mod_atmos_phy_tb_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_tb_driver_config
  public :: atmos_phy_tb_driver_setup
  public :: atmos_phy_tb_driver_resume
  public :: atmos_phy_tb_driver

  !-----------------------------------------------------------------------------
  !
  !++ Public parameters & variables
  !
  !-----------------------------------------------------------------------------
  !
  !++ Private procedure
  !
  !-----------------------------------------------------------------------------
  !
  !++ Private parameters & variables
  !
  !-----------------------------------------------------------------------------
contains
  !-----------------------------------------------------------------------------
  subroutine atmos_phy_tb_driver_config
    use scale_atmos_phy_tb, only: &
       atmos_phy_tb_config
    use mod_atmos_admin, only: &
       atmos_phy_tb_type, &
       atmos_sw_phy_tb
    implicit none
    !---------------------------------------------------------------------------

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

    if ( atmos_sw_phy_tb ) then
       call atmos_phy_tb_config( atmos_phy_tb_type )
    end if

    return
  end subroutine atmos_phy_tb_driver_config

  !-----------------------------------------------------------------------------
  subroutine atmos_phy_tb_driver_setup
    use scale_grid, only: &
       cdz => grid_cdz, &
       cdx => grid_cdx, &
       cdy => grid_cdy
    use scale_grid_real, only: &
       cz  => real_cz
    use scale_atmos_phy_tb, only: &
       atmos_phy_tb_setup
    use mod_atmos_admin, only: &
       atmos_sw_phy_tb
    use mod_atmos_phy_tb_vars, only: &
       momz_t_tb => atmos_phy_tb_momz_t
    implicit none

    integer :: i, j
    !---------------------------------------------------------------------------

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

    ! initialize
    do j = js, je
    do i = is, ie
       momz_t_tb(ks-1,i,j) = 0.0_rp
       momz_t_tb(ke  ,i,j) = 0.0_rp
    enddo
    enddo

    if ( atmos_sw_phy_tb ) then
       ! setup library component
       call atmos_phy_tb_setup( cdz, cdx, cdy, cz ) ! [IN]
    else
       if( io_l ) write(io_fid_log,*) '*** this component is never called.'
    endif

    return
  end subroutine atmos_phy_tb_driver_setup

  !-----------------------------------------------------------------------------
  subroutine atmos_phy_tb_driver_resume
    use mod_atmos_admin, only: &
       atmos_sw_phy_tb
    implicit none

    if ( atmos_sw_phy_tb ) then

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

    end if

    return
  end subroutine atmos_phy_tb_driver_resume

  !-----------------------------------------------------------------------------
  subroutine atmos_phy_tb_driver( update_flag )
    use scale_gridtrans, only: &
       gsqrt => gtrans_gsqrt, &
       j13g  => gtrans_j13g,  &
       j23g  => gtrans_j23g,  &
       j33g  => gtrans_j33g,  &
       mapf  => gtrans_mapf
    use scale_rm_statistics, only: &
       statistics_checktotal, &
       stat_total
    use scale_comm, only: &
       comm_vars8, &
       comm_wait
    use scale_history, only: &
       hist_in
    use scale_time, only: &
       dt_tb => time_dtsec_atmos_phy_tb
    use scale_atmos_phy_tb, only: &
       atmos_phy_tb, &
       i_tke
    use scale_atmos_phy_tb_common, only: &
       calc_tend_momz => atmos_phy_tb_calc_tend_momz, &
       calc_tend_momx => atmos_phy_tb_calc_tend_momx, &
       calc_tend_momy => atmos_phy_tb_calc_tend_momy, &
       calc_tend_phi  => atmos_phy_tb_calc_tend_phi
    use mod_atmos_vars, only: &
       dens => dens_av,   &
       momz => momz_av,   &
       momx => momx_av,   &
       momy => momy_av,   &
       rhot => rhot_av,   &
       qtrc => qtrc_av,   &
       n2   => n2,        &
       momz_t => momz_tp, &
       momx_t => momx_tp, &
       momy_t => momy_tp, &
       rhot_t => rhot_tp, &
       rhoq_t => rhoq_tp
    use mod_atmos_phy_tb_vars, only: &
       momz_t_tb => atmos_phy_tb_momz_t, &
       momx_t_tb => atmos_phy_tb_momx_t, &
       momy_t_tb => atmos_phy_tb_momy_t, &
       rhot_t_tb => atmos_phy_tb_rhot_t, &
       rhoq_t_tb => atmos_phy_tb_rhoq_t
    use mod_atmos_phy_sf_vars, only: &
       sflx_mw => atmos_phy_sf_sflx_mw, &
       sflx_mu => atmos_phy_sf_sflx_mu, &
       sflx_mv => atmos_phy_sf_sflx_mv, &
       sflx_sh => atmos_phy_sf_sflx_sh, &
       sflx_q  => atmos_phy_sf_sflx_qtrc
    implicit none

    logical, intent(in) :: update_flag

    ! eddy viscosity/diffusion flux
    real(RP) :: qflx_momz(ka,ia,ja,3)
    real(RP) :: qflx_momx(ka,ia,ja,3)
    real(RP) :: qflx_momy(ka,ia,ja,3)
    real(RP) :: qflx_rhot(ka,ia,ja,3)
    real(RP) :: qflx_rhoq(ka,ia,ja,3,qa)

    real(RP) :: nu(ka,ia,ja) ! eddy viscosity
    real(RP) :: ri(ka,ia,ja) ! Richardson number
    real(RP) :: pr(ka,ia,ja) ! Prandtl number

    real(RP) :: tend(ka,ia,ja)
    real(RP) :: total ! dummy

    integer  :: jjs, jje
    integer  :: iis, iie

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

    if ( update_flag ) then

       rhoq_t_tb = 0.0_rp

       call atmos_phy_tb( qflx_momz, qflx_momx, qflx_momy,        & ! [OUT]
                          qflx_rhot, qflx_rhoq,                   & ! [OUT]
                          rhoq_t_tb,                              & ! [INOUT]
                          nu, ri, pr,                             & ! [OUT]
                          momz, momx, momy, rhot, dens, qtrc, n2, & ! [IN]
                          sflx_mw, sflx_mu, sflx_mv,              & ! [IN]
                          sflx_sh, sflx_q,                        & ! [IN]
                          gsqrt, j13g, j23g, j33g, mapf,          & ! [IN]
                          dt_tb                                   ) ! [IN]

       do jjs = js, je, jblock
       jje = jjs+jblock-1
       do iis = is, ie, iblock
       iie = iis+iblock-1
          call calc_tend_momz( momz_t_tb,   & ! (out)
                               qflx_momz,   & ! (in)
                               gsqrt, j13g, j23g, j33g, mapf, & ! (in)
                               iis, iie, jjs, jje ) ! (in)
       end do
       end do

       do jjs = js, je, jblock
       jje = jjs+jblock-1
       do iis = is, ie, iblock
       iie = iis+iblock-1
          call calc_tend_momx( momx_t_tb,   & ! (out)
                               qflx_momx,   & ! (in)
                               gsqrt, j13g, j23g, j33g, mapf, & ! (in)
                               iis, iie, jjs, jje ) ! (in)
       end do
       end do

       do jjs = js, je, jblock
       jje = jjs+jblock-1
       do iis = is, ie, iblock
       iie = iis+iblock-1
          call calc_tend_momy( momy_t_tb,   & ! (out)
                               qflx_momy,   & ! (in)
                               gsqrt, j13g, j23g, j33g, mapf, & ! (in)
                               iis, iie, jjs, jje ) ! (in)
       end do
       end do

       do jjs = js, je, jblock
       jje = jjs+jblock-1
       do iis = is, ie, iblock
       iie = iis+iblock-1
          call calc_tend_phi ( rhot_t_tb,  & ! (out)
                               qflx_rhot,  & ! (in)
                               gsqrt, j13g, j23g, j33g, mapf, & ! (in)
                               iis, iie, jjs, jje ) ! (in)
       end do
       end do

       do iq = 1, qa
          if ( iq == i_tke .or. .not. tracer_advc(iq) ) cycle

          do jjs = js, je, jblock
          jje = jjs+jblock-1
          do iis = is, ie, iblock
          iie = iis+iblock-1
             call calc_tend_phi( tend(:,:,:), & ! (out)
                                 qflx_rhoq(:,:,:,:,iq),  & ! (in)
                                 gsqrt, j13g, j23g, j33g, mapf, & ! (in)
                                 iis, iie, jjs, jje ) ! (in)

             do j = jjs, jje
             do i = iis, iie
             do k = ks, ke
                rhoq_t_tb(k,i,j,iq) = rhoq_t_tb(k,i,j,iq) + tend(k,i,j)
             end do
             end do
             end do

          end do
          end do
       end do

       call hist_in( nu(:,:,:), 'NU',  'eddy viscosity',           'm2/s' , nohalo=.true. )
       call hist_in( ri(:,:,:), 'Ri',  'Richardson number',        'NIL'  , nohalo=.true. )
       call hist_in( pr(:,:,:), 'Pr',  'Prantle number',           'NIL'  , nohalo=.true. )

       call hist_in( momz_t_tb(:,:,:), 'MOMZ_t_TB', 'MOMZ tendency (TB)', 'kg/m2/s2',  nohalo=.true. )
       call hist_in( momx_t_tb(:,:,:), 'MOMX_t_TB', 'MOMX tendency (TB)', 'kg/m2/s2',  nohalo=.true. )
       call hist_in( momy_t_tb(:,:,:), 'MOMY_t_TB', 'MOMY tendency (TB)', 'kg/m2/s2',  nohalo=.true. )
       call hist_in( rhot_t_tb(:,:,:), 'RHOT_t_TB', 'RHOT tendency (TB)', 'K.kg/m3/s', nohalo=.true. )

       do iq = 1, qa
          call hist_in( rhoq_t_tb(:,:,:,iq), trim(tracer_name(iq))//'_t_TB',                      &
                        'RHO*'//trim(tracer_name(iq))//' tendency (TB)', 'kg/m3/s', nohalo=.true. )
       enddo

       call hist_in( qflx_momz(:,:,:,zdir), 'SGS_ZFLX_MOMZ', 'SGS Z FLUX of MOMZ', 'kg/m/s2', &
                     nohalo=.true.)
       call hist_in( qflx_momz(:,:,:,xdir), 'SGS_XFLX_MOMZ', 'SGS X FLUX of MOMZ', 'kg/m/s2', &
                     xdim='half', zdim='half', nohalo=.true.)
       call hist_in( qflx_momz(:,:,:,ydir), 'SGS_YFLX_MOMZ', 'SGS Y FLUX of MOMZ', 'kg/m/s2', &
                     ydim='half', zdim='half', nohalo=.true.)

       call hist_in( qflx_momx(:,:,:,zdir), 'SGS_ZFLX_MOMX', 'SGS Z FLUX of MOMX', 'kg/m/s2', &
                     xdim='half', zdim='half', nohalo=.true.)
       call hist_in( qflx_momx(:,:,:,xdir), 'SGS_XFLX_MOMX', 'SGS X FLUX of MOMX', 'kg/m/s2', &
                     nohalo=.true.)
       call hist_in( qflx_momx(:,:,:,ydir), 'SGS_YFLX_MOMX', 'SGS Y FLUX of MOMX', 'kg/m/s2', &
                     xdim='half', ydim='half', nohalo=.true.)

       call hist_in( qflx_momy(:,:,:,zdir), 'SGS_ZFLX_MOMY', 'SGS Z FLUX of MOMY', 'kg/m/s2', &
                     ydim='half', zdim='half', nohalo=.true.)
       call hist_in( qflx_momy(:,:,:,xdir), 'SGS_XFLX_MOMY', 'SGS X FLUX of MOMY', 'kg/m/s2', &
                     xdim='half', ydim='half', nohalo=.true.)
       call hist_in( qflx_momy(:,:,:,ydir), 'SGS_YFLX_MOMY', 'SGS Y FLUX of MOMY', 'kg/m/s2', &
                     nohalo=.true.)

       call hist_in( qflx_rhot(:,:,:,zdir), 'SGS_ZFLX_RHOT', 'SGS Z FLUX of RHOT', 'K*kg/m2/s', &
                     zdim='half', nohalo=.true.)
       call hist_in( qflx_rhot(:,:,:,xdir), 'SGS_XFLX_RHOT', 'SGS X FLUX of RHOT', 'K*kg/m2/s', &
                     xdim='half', nohalo=.true.)
       call hist_in( qflx_rhot(:,:,:,ydir), 'SGS_YFLX_RHOT', 'SGS Y FLUX of RHOT', 'K*kg/m2/s', &
                     ydim='half', nohalo=.true.)


       do iq = 1, qa
          if ( iq == i_tke .or. .not. tracer_advc(iq) ) cycle

          call hist_in( qflx_rhoq(:,:,:,zdir,iq), &
               'SGS_ZFLX_'//trim(tracer_name(iq)), 'SGS Z FLUX of '//trim(tracer_name(iq)), 'kg/m2/s', &
               zdim='half', nohalo=.true.)
          call hist_in( qflx_rhoq(:,:,:,xdir,iq), &
               'SGS_XFLX_'//trim(tracer_name(iq)), 'SGS X FLUX of '//trim(tracer_name(iq)), 'kg/m2/s', &
               xdim='half', nohalo=.true.)
          call hist_in( qflx_rhoq(:,:,:,ydir,iq), &
               'SGS_YFLX_'//trim(tracer_name(iq)), 'SGS Y FLUX of '//trim(tracer_name(ia)), 'kg/m2/s', &
               ydim='half', nohalo=.true.)
       end do

       if ( statistics_checktotal ) then
          call stat_total( total, momz_t_tb(:,:,:), 'MOMZ_t_TB' )
          call stat_total( total, momx_t_tb(:,:,:), 'MOMX_t_TB' )
          call stat_total( total, momy_t_tb(:,:,:), 'MOMY_t_TB' )
          call stat_total( total, rhot_t_tb(:,:,:), 'RHOT_t_TB' )
          call stat_total( total, nu(:,:,:), 'Nu' )
          call stat_total( total, ri(:,:,:), 'Ri' )
          call stat_total( total, pr(:,:,:), 'Pr' )

          do iq = 1, qa
             call stat_total( total, rhoq_t_tb(:,:,:,iq), trim(tracer_name(iq))//'_t_TB' )
          enddo
       endif

    endif

    !$omp parallel do default(none) private(i,j,k) OMP_SCHEDULE_ collapse(2) &
    !$omp shared(JS,JE,IS,IE,KS,KE,MOMZ_t,MOMZ_t_TB,MOMX_t,MOMX_t_TB,MOMY_t,MOMY_t_TB,RHOT_t,RHOT_t_TB)
    do j = js, je
    do i = is, ie
    do k = ks, ke
       momz_t(k,i,j) = momz_t(k,i,j) + momz_t_tb(k,i,j)
       momx_t(k,i,j) = momx_t(k,i,j) + momx_t_tb(k,i,j)
       momy_t(k,i,j) = momy_t(k,i,j) + momy_t_tb(k,i,j)
       rhot_t(k,i,j) = rhot_t(k,i,j) + rhot_t_tb(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_tb(k,i,j,iq)
    enddo
    enddo
    enddo
    enddo

    return
  end subroutine atmos_phy_tb_driver

end module mod_atmos_phy_tb_driver