mod_atmos_driver.F90

Go to the documentation of this file.

!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
#include "scalelib.h"
module mod_atmos_driver
  !-----------------------------------------------------------------------------
  !
  !++ used modules
  !
  use scale_precision
  use scale_io
  use scale_prof
  use scale_atmos_grid_cartesc_index
  !-----------------------------------------------------------------------------
  implicit none
  private
  !-----------------------------------------------------------------------------
  !
  !++ Public procedure
  !
  public :: atmos_driver_tracer_setup
  public :: atmos_driver_setup
  public :: atmos_driver_calc_tendency
  public :: atmos_driver_calc_tendency_from_sflux
  public :: atmos_driver_update
  public :: atmos_driver_finalize
  public :: atmos_surface_get
  public :: atmos_surface_set

  !-----------------------------------------------------------------------------
  !
  !++ Public parameters & variables
  !
  !-----------------------------------------------------------------------------
  !
  !++ Private procedure
  !
  !-----------------------------------------------------------------------------
  !
  !++ Private parameters & variables
  !
  !-----------------------------------------------------------------------------
contains
  !-----------------------------------------------------------------------------
  subroutine atmos_driver_tracer_setup
    use mod_atmos_phy_mp_driver, only: &
       atmos_phy_mp_driver_tracer_setup
    use mod_atmos_phy_ae_driver, only: &
       atmos_phy_ae_driver_tracer_setup
    use mod_atmos_phy_ch_driver, only: &
       atmos_phy_ch_driver_tracer_setup
    use mod_atmos_phy_tb_driver, only: &
       atmos_phy_tb_driver_tracer_setup
    use mod_atmos_phy_bl_driver, only: &
       atmos_phy_bl_driver_tracer_setup
    implicit none
    !---------------------------------------------------------------------------

    log_newline
    log_info("ATMOS_driver_tracer_setup",*) 'Setup'

    call atmos_phy_mp_driver_tracer_setup
    call atmos_phy_ch_driver_tracer_setup
    call atmos_phy_ae_driver_tracer_setup
    call atmos_phy_tb_driver_tracer_setup
    call atmos_phy_bl_driver_tracer_setup

    return
  end subroutine atmos_driver_tracer_setup

  !-----------------------------------------------------------------------------
  subroutine atmos_driver_setup
    use scale_time, only: &
       time_nowdate
    use scale_atmos_solarins, only: &
       atmos_solarins_setup
    use scale_atmos_refstate, only: &
       atmos_refstate_setup
    use mod_atmos_bnd_driver, only: &
       atmos_boundary_driver_setup
    use mod_atmos_dyn_driver, only: &
       atmos_dyn_driver_setup
    use mod_atmos_phy_mp_driver, only: &
       atmos_phy_mp_driver_setup
    use mod_atmos_phy_mp_vars, only: &
       qa_mp, &
       qs_mp, &
       qe_mp
    use mod_atmos_phy_ch_driver, only: &
       atmos_phy_ch_driver_setup
    use mod_atmos_phy_ae_driver, only: &
       atmos_phy_ae_driver_setup
    use mod_atmos_phy_rd_driver, only: &
       atmos_phy_rd_driver_setup
    use mod_atmos_phy_sf_driver, only: &
       atmos_phy_sf_driver_setup
    use mod_atmos_phy_tb_driver, only: &
       atmos_phy_tb_driver_setup
    use mod_atmos_phy_bl_driver, only: &
       atmos_phy_bl_driver_setup
    use mod_atmos_phy_cp_driver, only: &
       atmos_phy_cp_driver_setup
    use scale_atmos_grid_cartesc, only: &
       cz => atmos_grid_cartesc_cz, &
       fz => atmos_grid_cartesc_fz
    use scale_atmos_grid_cartesc_real, only: &
       base_lon => atmos_grid_cartesc_real_basepoint_lon, &
       base_lat => atmos_grid_cartesc_real_basepoint_lat, &
       real_cz  => atmos_grid_cartesc_real_cz, &
       real_fz  => atmos_grid_cartesc_real_fz, &
       real_phi => atmos_grid_cartesc_real_phi
    implicit none
    !---------------------------------------------------------------------------

    log_newline
    log_info("ATMOS_driver_setup",*) 'Setup'

    log_newline
    log_info("ATMOS_driver_setup",*) 'Setup each atmospheric components ...'

    !--- setup solar insolation
    call atmos_solarins_setup( base_lon, base_lat, time_nowdate(1) )

    call prof_rapstart('ATM_Refstate', 2)
    call atmos_refstate_setup( ka, ks, ke, ia, isb, ieb, ja, jsb, jeb, &
                               cz(:), fz(:), real_cz(:,:,:), real_fz(:,:,:), real_phi(:,:,:) )

    call prof_rapend  ('ATM_Refstate', 2)

    call prof_rapstart('ATM_Boundary', 2)
    call atmos_boundary_driver_setup
    call prof_rapend  ('ATM_Boundary', 2)

    ! setup each components
    call atmos_dyn_driver_setup
    call atmos_phy_mp_driver_setup
    call atmos_phy_ae_driver_setup
    call atmos_phy_ch_driver_setup
    call atmos_phy_rd_driver_setup
    call atmos_phy_sf_driver_setup
    call atmos_phy_tb_driver_setup
    call atmos_phy_bl_driver_setup
    call atmos_phy_cp_driver_setup

    log_newline
    log_info("ATMOS_driver_setup",*) 'Finish setup of each atmospheric components.'

    return
  end subroutine atmos_driver_setup

  !-----------------------------------------------------------------------------
  subroutine atmos_driver_calc_tendency( force )
    use mod_atmos_vars, only: &
       dens_tp, &
       momz_tp, &
       rhou_tp, &
       rhov_tp, &
       rhot_tp, &
       rhoh_p,  &
       rhoq_tp, &
       momx_tp, &
       momy_tp
    use mod_atmos_phy_mp_driver, only: &
       atmos_phy_mp_driver_calc_tendency
    use mod_atmos_phy_ch_driver, only: &
       atmos_phy_ch_driver_calc_tendency
    use mod_atmos_phy_ae_driver, only: &
       atmos_phy_ae_driver_calc_tendency
    use mod_atmos_phy_rd_driver, only: &
       atmos_phy_rd_driver_calc_tendency
    use mod_atmos_phy_sf_driver, only: &
       atmos_phy_sf_driver_calc_tendency
    use mod_atmos_phy_tb_driver, only: &
       atmos_phy_tb_driver_calc_tendency
    use mod_atmos_phy_cp_driver, only: &
       atmos_phy_cp_driver_calc_tendency
    use mod_atmos_phy_bl_driver, only: &
       atmos_phy_bl_driver_calc_tendency
    use mod_admin_time, only: &
       do_phy_mp => time_doatmos_phy_mp, &
       do_phy_ae => time_doatmos_phy_ae, &
       do_phy_ch => time_doatmos_phy_ch, &
       do_phy_rd => time_doatmos_phy_rd, &
       do_phy_sf => time_doatmos_phy_sf, &
       do_phy_tb => time_doatmos_phy_tb, &
       do_phy_bl => time_doatmos_phy_bl, &
       do_phy_cp => time_doatmos_phy_cp
    use mod_atmos_admin, only: &
       atmos_sw_phy_mp, &
       atmos_sw_phy_ae, &
       atmos_sw_phy_ch, &
       atmos_sw_phy_rd, &
       atmos_sw_phy_sf, &
       atmos_sw_phy_tb, &
       atmos_sw_phy_bl, &
       atmos_sw_phy_cp
    use mod_cpl_admin, only: &
       cpl_sw
    implicit none
    logical, intent(in) :: force
    !---------------------------------------------------------------------------

    !########## Get Surface Boundary from coupler ##########
    call atmos_surface_get

    !########## calculate tendency ##########
    ! reset tendencies
!OCL XFILL
    dens_tp(:,:,:)   = 0.0_rp
!OCL XFILL
    momz_tp(:,:,:)   = 0.0_rp
!OCL XFILL
    rhou_tp(:,:,:)   = 0.0_rp
!OCL XFILL
    rhov_tp(:,:,:)   = 0.0_rp
!OCL XFILL
    rhot_tp(:,:,:)   = 0.0_rp
!OCL XFILL
    rhoh_p(:,:,:)   = 0.0_rp
!OCL XFILL
    rhoq_tp(:,:,:,:) = 0.0_rp
!OCL XFILL
    momx_tp(:,:,:)   = 0.0_rp
!OCL XFILL
    momy_tp(:,:,:)   = 0.0_rp

    ! Microphysics
    if ( atmos_sw_phy_mp ) then
       call prof_rapstart('ATM_Microphysics', 1)
       call atmos_phy_mp_driver_calc_tendency( update_flag = do_phy_mp .or. force )
       call prof_rapend  ('ATM_Microphysics', 1)
    endif
    ! Aerosol
    if ( atmos_sw_phy_ae ) then
       call prof_rapstart('ATM_Aerosol', 1)
       call atmos_phy_ae_driver_calc_tendency( update_flag = do_phy_ae .or. force )
       call prof_rapend  ('ATM_Aerosol', 1)
    endif
    ! Chemistry
    if ( atmos_sw_phy_ch ) then
       call prof_rapstart('ATM_Chemistry', 1)
       call atmos_phy_ch_driver_calc_tendency( update_flag = do_phy_ch .or. force )
       call prof_rapend  ('ATM_Chemistry', 1)
    endif
    ! Radiation
    if ( atmos_sw_phy_rd ) then
       call prof_rapstart('ATM_Radiation', 1)
       call atmos_phy_rd_driver_calc_tendency( update_flag = do_phy_rd .or. force )
       call prof_rapend  ('ATM_Radiation', 1)
    endif
    ! Turbulence
    if ( atmos_sw_phy_tb ) then
       call prof_rapstart('ATM_Turbulence', 1)
       call atmos_phy_tb_driver_calc_tendency( update_flag = do_phy_tb .or. force )
       call prof_rapend  ('ATM_Turbulence', 1)
    endif
    ! Cumulus
    if ( atmos_sw_phy_cp ) then
       call prof_rapstart('ATM_Cumulus', 1)
       call atmos_phy_cp_driver_calc_tendency( update_flag = do_phy_cp .or. force )
       call prof_rapend  ('ATM_Cumulus', 1)
    endif
    if ( .not. cpl_sw ) then
       ! Surface Flux
       if ( atmos_sw_phy_sf ) then
          call prof_rapstart('ATM_SurfaceFlux', 1)
          call atmos_phy_sf_driver_calc_tendency( update_flag = do_phy_sf .or. force )
          call prof_rapend  ('ATM_SurfaceFlux', 1)
       endif
       ! Planetary Boundary layer
       if ( atmos_sw_phy_bl ) then
          call prof_rapstart('ATM_PBL', 1)
          call atmos_phy_bl_driver_calc_tendency( update_flag = do_phy_bl .or. force )
          call prof_rapend  ('ATM_PBL', 1)
       endif
    end if

    !########## Set Surface Boundary Condition ##########
    call atmos_surface_set( countup = .true. )

    return
  end subroutine atmos_driver_calc_tendency

  !-----------------------------------------------------------------------------
  subroutine atmos_driver_calc_tendency_from_sflux( force )
    use mod_atmos_phy_sf_driver, only: &
       atmos_phy_sf_driver_calc_tendency
    use mod_atmos_phy_bl_driver, only: &
       atmos_phy_bl_driver_calc_tendency
    use mod_cpl_admin, only: &
       cpl_sw
    use mod_atmos_admin, only: &
       atmos_sw_phy_sf, &
       atmos_sw_phy_bl
    use mod_admin_time, only: &
       do_phy_sf => time_doatmos_phy_sf, &
       do_phy_bl => time_doatmos_phy_bl
    implicit none
    logical, intent(in) :: force
    !---------------------------------------------------------------------------

    if ( cpl_sw ) then

       !########## Get Surface Boundary Condition ##########
       call atmos_surface_get

       ! Surface Flux
       if ( atmos_sw_phy_sf ) then
          call prof_rapstart('ATM_SurfaceFlux', 1)
          call atmos_phy_sf_driver_calc_tendency( update_flag = do_phy_sf .or. force )
          call prof_rapend  ('ATM_SurfaceFlux', 1)
       endif

       ! Planetary Boundary layer
       if ( atmos_sw_phy_bl ) then
          call prof_rapstart('ATM_PBL', 1)
          call atmos_phy_bl_driver_calc_tendency( update_flag = do_phy_bl .or. force )
          call prof_rapend  ('ATM_PBL', 1)
       endif

    end if

    return
  end subroutine atmos_driver_calc_tendency_from_sflux

  !-----------------------------------------------------------------------------
  subroutine atmos_driver_update
    use mod_atmos_admin, only: &
       atmos_sw_dyn,    &
       atmos_sw_phy_mp, &
       atmos_sw_phy_ae
    use mod_admin_time, only: &
       do_dyn    => time_doatmos_dyn,    &
       do_phy_mp => time_doatmos_phy_mp, &
       do_phy_ae => time_doatmos_phy_ae
    use scale_atmos_refstate, only: &
       atmos_refstate_update_flag, &
       atmos_refstate_update
    use mod_atmos_vars, only: &
       atmos_vars_history,         &
       atmos_vars_calc_diagnostics,&
       atmos_vars_history_setpres, &
       atmos_vars_monitor,         &
       dens,                       &
       temp,                       &
       pres,                       &
       pott,                       &
       qv
    use mod_atmos_bnd_driver, only: &
       atmos_boundary_driver_update, &
       atmos_boundary_update_flag
    use mod_atmos_dyn_driver, only: &
       atmos_dyn_driver
    use mod_atmos_phy_mp_driver, only: &
       atmos_phy_mp_driver_adjustment
    use mod_atmos_phy_ae_driver, only: &
       atmos_phy_ae_driver_adjustment
    use scale_atmos_grid_cartesc, only: &
       cz   => atmos_grid_cartesc_cz,  &
       fz   => atmos_grid_cartesc_fz,  &
       fdz  => atmos_grid_cartesc_fdz, &
       rcdz => atmos_grid_cartesc_rcdz
    use scale_atmos_grid_cartesc_real, only: &
       real_cz  => atmos_grid_cartesc_real_cz, &
       real_fz  => atmos_grid_cartesc_real_fz, &
       real_phi => atmos_grid_cartesc_real_phi, &
       area     => atmos_grid_cartesc_real_area
    use scale_time, only: &
       time_nowdaysec
    implicit none
    !---------------------------------------------------------------------------

    !########## Dynamics ##########
    if ( atmos_sw_dyn ) then
       call prof_rapstart('ATM_Dynamics', 1)
       call atmos_dyn_driver( do_dyn )
       call prof_rapend  ('ATM_Dynamics', 1)
    endif

    !########## Lateral/Top Boundary Condition ###########
    if ( atmos_boundary_update_flag ) then
       call prof_rapstart('ATM_Boundary', 2)
       call atmos_boundary_driver_update
       call prof_rapend  ('ATM_Boundary', 2)
    endif

    !########## Calculate diagnostic variables ##########
    call atmos_vars_calc_diagnostics


    !########## Adjustment ##########
    ! Microphysics
    if ( atmos_sw_phy_mp .and. do_phy_mp ) then
       call prof_rapstart('ATM_Microphysics', 1)
       call atmos_phy_mp_driver_adjustment
       call prof_rapend  ('ATM_Microphysics', 1)
       call atmos_vars_calc_diagnostics
    endif
    ! Aerosol
    if ( atmos_sw_phy_ae .and. do_phy_ae ) then
       call prof_rapstart('ATM_Aerosol', 1)
       call atmos_phy_ae_driver_adjustment
       call prof_rapend  ('ATM_Aerosol', 1)
       call atmos_vars_calc_diagnostics
    endif


    !########## Reference State ###########
    if ( atmos_refstate_update_flag ) then
       call prof_rapstart('ATM_Refstate', 2)
       call atmos_refstate_update( ka, ks, ke, ia, isb, ieb, ja, jsb, jeb, &
                                   dens(:,:,:), pott(:,:,:), temp(:,:,:), pres(:,:,:), qv(:,:,:), & ! [IN]
                                   cz(:), fz(:), fdz(:), rcdz(:),                                 & ! [IN]
                                   real_cz(:,:,:), real_fz(:,:,:), real_phi(:,:,:), area(:,:),    & ! [IN]
                                   time_nowdaysec                                                 ) ! [IN]
       call prof_rapend  ('ATM_Refstate', 2)
    endif


    !########## Set hydrostatic pressure coordinate ##########
    call atmos_vars_history_setpres


    !########## History & Monitor ##########
    call atmos_vars_history
    call atmos_vars_monitor

    return
  end subroutine atmos_driver_update

  !-----------------------------------------------------------------------------
  subroutine atmos_driver_finalize
    use mod_atmos_bnd_driver, only: &
       atmos_boundary_update_flag, &
       atmos_boundary_driver_finalize
    use scale_comm_cartesc_nest, only: &
       nest_comm_disconnect => comm_cartesc_nest_disconnect
    implicit none
    !---------------------------------------------------------------------------

    !########## Lateral/Top Boundary Condition ###########
    if ( atmos_boundary_update_flag ) then
       ! If this run is parent of online nesting, boundary data must be sent
       call atmos_boundary_driver_finalize

       ! Finialize Inter-Communicators
       call nest_comm_disconnect
    endif

    return
  end subroutine atmos_driver_finalize

  !-----------------------------------------------------------------------------
  subroutine atmos_surface_get
    use mod_atmos_phy_sf_vars, only: &
       sfc_temp   => atmos_phy_sf_sfc_temp,   &
       sfc_albedo => atmos_phy_sf_sfc_albedo, &
       sfc_z0m    => atmos_phy_sf_sfc_z0m,    &
       sfc_z0h    => atmos_phy_sf_sfc_z0h,    &
       sfc_z0e    => atmos_phy_sf_sfc_z0e,    &
       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_lh    => atmos_phy_sf_sflx_lh,    &
       sflx_gh    => atmos_phy_sf_sflx_gh,    &
       sflx_qtrc  => atmos_phy_sf_sflx_qtrc,  &
       u10        => atmos_phy_sf_u10,        &
       v10        => atmos_phy_sf_v10,        &
       t2         => atmos_phy_sf_t2,         &
       q2         => atmos_phy_sf_q2
    use mod_cpl_admin, only: &
       cpl_sw
    use mod_cpl_vars, only: &
       cpl_getsfc_atm
    implicit none
    !---------------------------------------------------------------------------

    call prof_rapstart('ATM_SfcExch', 2)

    if ( cpl_sw ) then
       call cpl_getsfc_atm( sfc_temp(:,:),     & ! [OUT]
                            sfc_albedo(:,:,:,:), & ! [OUT]
                            sfc_z0m(:,:),     & ! [OUT]
                            sfc_z0h(:,:),     & ! [OUT]
                            sfc_z0e(:,:),     & ! [OUT]
                            sflx_mw(:,:),     & ! [OUT]
                            sflx_mu(:,:),     & ! [OUT]
                            sflx_mv(:,:),     & ! [OUT]
                            sflx_sh(:,:),     & ! [OUT]
                            sflx_lh(:,:),     & ! [OUT]
                            sflx_gh(:,:),     & ! [OUT]
                            sflx_qtrc(:,:,:),   & ! [OUT]
                            u10(:,:),     & ! [OUT]
                            v10(:,:),     & ! [OUT]
                            t2(:,:),     & ! [OUT]
                            q2(:,:)      ) ! [OUT]
    endif

    call prof_rapend  ('ATM_SfcExch', 2)

    return
  end subroutine atmos_surface_get

  !-----------------------------------------------------------------------------
  subroutine atmos_surface_set( countup )
    use scale_atmos_grid_cartesc_real, only: &
       real_cz => atmos_grid_cartesc_real_cz, &
       real_z1 => atmos_grid_cartesc_real_z1
    use scale_topography, only: &
       topo_zsfc
    use scale_atmos_bottom, only: &
       bottom_estimate => atmos_bottom_estimate
    use mod_atmos_vars, only: &
       dens, &
       qtrc, &
       temp, &
       pres, &
       w,    &
       u,    &
       v
    use mod_atmos_phy_mp_vars, only: &
       sflx_rain_mp => atmos_phy_mp_sflx_rain, &
       sflx_snow_mp => atmos_phy_mp_sflx_snow
    use mod_atmos_phy_cp_vars, only: &
       sflx_rain_cp => atmos_phy_cp_sflx_rain
    use mod_atmos_phy_rd_vars, only: &
       sflx_rad_dn => atmos_phy_rd_sflx_down, &
       cossza      => atmos_phy_rd_cossza
    use mod_atmos_phy_bl_vars, only: &
       atm_pbl => atmos_phy_bl_zi
    use mod_cpl_admin, only: &
       cpl_sw
    use mod_cpl_vars, only: &
       cpl_putatm
    implicit none

    ! arguments
    logical, intent(in) :: countup

    ! works
    real(RP) :: SFC_DENS(ia,ja)
    real(RP) :: SFC_PRES(ia,ja)

    real(RP) :: SFLX_rain(ia,ja)
    real(RP) :: SFLX_snow(ia,ja)

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

    call prof_rapstart('ATM_SfcExch', 2)

    if ( cpl_sw ) then
       ! sum of rainfall from mp and cp
       !$omp parallel do private(i,j) OMP_SCHEDULE_
       do j = 1, ja
       do i = 1, ia
          sflx_rain(i,j) = sflx_rain_mp(i,j) + sflx_rain_cp(i,j)
          sflx_snow(i,j) = sflx_snow_mp(i,j)
       enddo
       enddo

       ! planetary boundary layer
       call bottom_estimate( ka, ks, ke, ia, isb, ieb, ja, jsb, jeb, &
                             dens(:,:,:), pres(:,:,:),                     & ! [IN]
                             real_cz(:,:,:), topo_zsfc(:,:), real_z1(:,:), & ! [IN]
                             sfc_dens(:,:), sfc_pres(:,:)                  ) ! [OUT]

       call cpl_putatm( temp(ks,:,:),   & ! [IN]
                        pres(ks,:,:),   & ! [IN]
                        w(ks,:,:),   & ! [IN]
                        u(ks,:,:),   & ! [IN]
                        v(ks,:,:),   & ! [IN]
                        dens(ks,:,:),   & ! [IN]
                        qtrc(ks,:,:,:), & ! [IN]
                        atm_pbl(:,:),      & ! [IN]
                        sfc_dens(:,:),      & ! [IN]
                        sfc_pres(:,:),      & ! [IN]
                        sflx_rad_dn(:,:,:,:),  & ! [IN]
                        cossza(:,:),      & ! [IN]
                        sflx_rain(:,:),      & ! [IN]
                        sflx_snow(:,:),      & ! [IN]
                        countup                ) ! [IN]
    endif

    call prof_rapend  ('ATM_SfcExch', 2)

    return
  end subroutine atmos_surface_set

  subroutine atmos_driver_boundary_update

  end subroutine atmos_driver_boundary_update
end module mod_atmos_driver