mod_atmos_phy_ch_driver.F90

Go to the documentation of this file.

!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
#include "scalelib.h"
module mod_atmos_phy_ch_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_ch_driver_tracer_setup
  public :: atmos_phy_ch_driver_setup
  public :: atmos_phy_ch_driver_finalize
  public :: atmos_phy_ch_driver_calc_tendency
  public :: atmos_phy_ch_driver_ocean_flux
  public :: atmos_phy_ch_driver_land_flux
  public :: atmos_phy_ch_driver_urban_flux
 
  !-----------------------------------------------------------------------------
  !
  !++ Public parameters & variables
  !
  !-----------------------------------------------------------------------------
  !
  !++ Private procedure
  !
  !-----------------------------------------------------------------------------
  !
  !++ Private parameters & variables
  !
  !-----------------------------------------------------------------------------
contains
  !-----------------------------------------------------------------------------
  subroutine atmos_phy_ch_driver_tracer_setup
    use mod_atmos_admin, only: &
       atmos_phy_ch_type, &
       atmos_sw_phy_ch
    use scale_tracer, only: &
       tracer_regist
    use scale_atmos_phy_ch_rn222, only: &
       atmos_phy_ch_rn222_ntracers, &
       atmos_phy_ch_rn222_name, &
       atmos_phy_ch_rn222_desc, &
       atmos_phy_ch_rn222_unit
    use mod_atmos_phy_ch_vars, only: &
       qa_ch, &
       qs_ch, &
       qe_ch
    use scale_prc, only: &
       prc_abort
    implicit none
    !---------------------------------------------------------------------------
 
    log_newline
    log_info("ATMOS_PHY_CH_driver_tracer_setup",*) 'Setup'
 
    if ( atmos_sw_phy_ch ) then
 
       select case ( atmos_phy_ch_type )
       case ( 'OFF', 'NONE' )
          log_info("ATMOS_PHY_CH_driver_tracer_setup",*) 'this component is never called.'
       case ( 'RN222' )
 
          call tracer_regist( qs_ch,                        & ! [OUT]
                              atmos_phy_ch_rn222_ntracers,  & ! [IN]
                              atmos_phy_ch_rn222_name(:),   & ! [IN]
                              atmos_phy_ch_rn222_desc(:),   & ! [IN]
                              atmos_phy_ch_rn222_unit(:)    ) ! [IN]
          qa_ch = atmos_phy_ch_rn222_ntracers
 
       case default
          log_error("ATMOS_PHY_CH_driver_tracer_setup",*) 'invalid chemistry type(', atmos_phy_ch_type, '). CHECK!'
          call prc_abort
       end select
 
       qe_ch = qs_ch + qa_ch - 1
 
    else
       qa_ch = 0
       qs_ch = -1
       qe_ch = -2
    endif
 
    return
  end subroutine atmos_phy_ch_driver_tracer_setup
 
  !-----------------------------------------------------------------------------
  subroutine atmos_phy_ch_driver_setup
    use scale_atmos_grid_cartesc_real, only: &
       real_lon => atmos_grid_cartesc_real_lon, &
       real_lat => atmos_grid_cartesc_real_lat
    use scale_atmos_phy_ch_rn222, only: &
       atmos_phy_ch_rn222_setup
    use scale_atmos_sfc_ch_rn222, only: &
       atmos_sfc_ch_rn222_setup
    use mod_atmos_admin, only: &
       atmos_phy_ch_type, &
       atmos_sw_phy_ch
    implicit none
    !---------------------------------------------------------------------------
 
    log_newline
    log_info("ATMOS_PHY_CH_driver_setup",*) 'Setup'
 
    if ( atmos_sw_phy_ch ) then
 
       select case ( atmos_phy_ch_type )
       case ( 'RN222' )
          call atmos_phy_ch_rn222_setup
          call atmos_sfc_ch_rn222_setup( ia, ja,            & ! [IN]
                                         real_lon, real_lat ) ! [IN]
       end select
 
    else
       log_info("ATMOS_PHY_CH_driver_setup",*) 'this component is never called.'
    endif
 
    return
  end subroutine atmos_phy_ch_driver_setup
 
  !-----------------------------------------------------------------------------
  subroutine atmos_phy_ch_driver_finalize
    use scale_atmos_sfc_ch_rn222, only: &
       atmos_sfc_ch_rn222_finalize
    use mod_atmos_admin, only: &
       atmos_phy_ch_type, &
       atmos_sw_phy_ch
    implicit none
    !---------------------------------------------------------------------------
 
    log_newline
    log_info("ATMOS_PHY_CH_driver_finalize",*) 'Finalize'
 
    if ( atmos_sw_phy_ch ) then
 
       select case ( atmos_phy_ch_type )
       case ( 'RN222' )
          call atmos_sfc_ch_rn222_finalize
       end select
 
    end if
 
    return
  end subroutine atmos_phy_ch_driver_finalize
 
  !-----------------------------------------------------------------------------
  subroutine atmos_phy_ch_driver_calc_tendency( update_flag )
    use scale_tracer, only: &
       tracer_name
    use scale_time, only: &
       dt_ch => time_dtsec_atmos_phy_ch
    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
    use scale_file_history, only: &
       file_history_in
    use mod_atmos_vars, only: &
       dens   => dens_av, &
       qtrc   => qtrc_av, &
       rhoq_t => rhoq_tp
    use mod_atmos_phy_sf_vars, only: &
       sflx_qtrc => atmos_phy_sf_sflx_qtrc
    use mod_atmos_phy_ch_vars, only: &
       rhoq_t_ch => atmos_phy_ch_rhoq_t, &
       qa_ch,        &
       qs_ch,        &
       qe_ch
!       O3        => ATMOS_PHY_CH_O3
    use mod_atmos_admin, only: &
       atmos_phy_ch_type
    use scale_atmos_phy_ch_rn222, only: &
       atmos_phy_ch_rn222_tendency
    implicit none
 
    logical, intent(in) :: update_flag
 
    integer  :: k, i, j, iq
    !---------------------------------------------------------------------------
 
    if ( update_flag ) then
 
!OCL XFILL
       !$acc kernels
       rhoq_t_ch(:,:,:,:) = 0.0_rp
       !$acc end kernels
 
       select case( atmos_phy_ch_type )
       case( 'RN222' )
          !$acc update host(DENS,QTRC(:,:,:,QS_CH:QE_CH),RHOQ_t_CH(:,:,:,QS_CH:QE_CH))
          call atmos_phy_ch_rn222_tendency( ka, ks, ke,                   & ! [IN]
                                            ia, is, ie,                   & ! [IN]
                                            ja, js, je,                   & ! [IN]
                                            qa_ch,                        & ! [IN]
                                            dens(:,:,:),             & ! [IN]
                                            qtrc(:,:,:,qs_ch:qe_ch), & ! [IN]
                                            rhoq_t_ch(:,:,:,qs_ch:qe_ch)  ) ! [INOUT]
          !$acc update device(RHOQ_t_CH(:,:,:,QS_CH:QE_CH))
       end select
 
       do iq = qs_ch, qe_ch
          call file_history_in( rhoq_t_ch(:,:,:,iq), trim(tracer_name(iq))//'_t_CH', &
                                'tendency rho*'//trim(tracer_name(iq))//' in CH',    &
                                'kg/m3/s', fill_halo=.true.                          )
       enddo
    endif
 
    !$omp parallel do private(i,j,k) collapse(3) OMP_SCHEDULE_
    !$acc kernels
    do iq = qs_ch, qe_ch
       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_ch(k,i,j,iq)
       enddo
       enddo
       enddo
    enddo
    !$acc end kernels
 
    if ( statistics_checktotal ) then
       do iq = qs_ch, qe_ch
          call statistics_total( ka, ks, ke, ia, is, ie, ja, js, je, &
                                 rhoq_t_ch(:,:,:,iq), trim(tracer_name(iq))//'_t_CH', &
                                 atmos_grid_cartesc_real_vol(:,:,:),                  &
                                 atmos_grid_cartesc_real_totvol                       )
       enddo
    endif
 
    return
  end subroutine atmos_phy_ch_driver_calc_tendency
 
  !-----------------------------------------------------------------------------
  subroutine atmos_phy_ch_driver_ocean_flux( &
       SFLX_QTRC )
    use scale_ocean_grid_cartesc_index
    use scale_atmos_sfc_ch_rn222, only: &
       atmos_sfc_ch_rn222_ocean_flux
    use mod_atmos_admin, only: &
       atmos_phy_ch_type
    use mod_atmos_phy_ch_vars, only: &
       qa_ch, &
       qs_ch, &
       qe_ch
    implicit none
 
    real(rp), intent(inout) :: sflx_qtrc(oia,oja,qa)
 
    !---------------------------------------------------------------------------
 
    select case( atmos_phy_ch_type )
    case( 'RN222' )
       !$acc update host(SFLX_QTRC(:,:,QS_CH:QE_CH))
       call atmos_sfc_ch_rn222_ocean_flux( oia, ois, oie,             & ! [IN]
                                           oja, ojs, oje,             & ! [IN]
                                           qa_ch,                     & ! [IN]
                                           sflx_qtrc(:,:,qs_ch:qe_ch) ) ! [INOUT]
       !$acc update device(SFLX_QTRC(:,:,QS_CH:QE_CH))
    end select
 
    return
  end subroutine atmos_phy_ch_driver_ocean_flux
 
  !-----------------------------------------------------------------------------
  subroutine atmos_phy_ch_driver_land_flux( &
       SFLX_QTRC   )
    use scale_land_grid_cartesc_index
    use scale_time, only: &
       time_nowdate
    use scale_atmos_sfc_ch_rn222, only: &
       atmos_sfc_ch_rn222_land_flux
    use mod_atmos_admin, only: &
       atmos_phy_ch_type
    use mod_atmos_phy_ch_vars, only: &
       qa_ch, &
       qs_ch, &
       qe_ch
    implicit none
 
    real(rp), intent(inout) :: sflx_qtrc(lia,lja,qa)
 
    !---------------------------------------------------------------------------
 
    select case( atmos_phy_ch_type )
    case( 'RN222' )
       !$acc update host(SFLX_QTRC(:,:,QS_CH:QE_CH))
       call atmos_sfc_ch_rn222_land_flux( lia, lis, lie,             & ! [IN]
                                          lja, ljs, lje,             & ! [IN]
                                          qa_ch,                     & ! [IN]
                                          time_nowdate(:),           & ! [IN]
                                          sflx_qtrc(:,:,qs_ch:qe_ch) ) ! [INOUT]
       !$acc update device(SFLX_QTRC(:,:,QS_CH:QE_CH))
    end select
 
    return
  end subroutine atmos_phy_ch_driver_land_flux
 
  !-----------------------------------------------------------------------------
  subroutine atmos_phy_ch_driver_urban_flux( &
       SFLX_QTRC )
    use scale_urban_grid_cartesc_index
    use scale_time, only: &
       time_nowdate
    use scale_atmos_sfc_ch_rn222, only: &
       atmos_sfc_ch_rn222_land_flux
    use mod_atmos_admin, only: &
       atmos_phy_ch_type
    use mod_atmos_phy_ch_vars, only: &
       qa_ch, &
       qs_ch, &
       qe_ch
    implicit none
 
    real(rp), intent(inout) :: sflx_qtrc(uia,uja,qa)
 
    !---------------------------------------------------------------------------
 
    select case( atmos_phy_ch_type )
    case( 'RN222' )
       !$acc update host(SFLX_QTRC(:,:,QS_CH:QE_CH))
       call atmos_sfc_ch_rn222_land_flux( uia, uis, uie,             & ! [IN]
                                          uja, ujs, uje,             & ! [IN]
                                          qa_ch,                     & ! [IN]
                                          time_nowdate(:),           & ! [IN]
                                          sflx_qtrc(:,:,qs_ch:qe_ch) ) ! [INOUT]
       !$acc update device(SFLX_QTRC(:,:,QS_CH:QE_CH))
    end select
 
    return
  end subroutine atmos_phy_ch_driver_urban_flux
 
end module mod_atmos_phy_ch_driver