mod_urban_phy_driver.f90

Go to the documentation of this file.

!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
module mod_urban_phy_driver
  !-----------------------------------------------------------------------------
  !
  !++ used modules
  !
  use scale_precision
  use scale_stdio
  use scale_prof
  use scale_grid_index
  use scale_urban_grid_index

  use scale_const, only: &
     i_sw  => const_i_sw, &
     i_lw  => const_i_lw
  !-----------------------------------------------------------------------------
  implicit none
  private
  !-----------------------------------------------------------------------------
  !
  !++ Public procedure
  !
  public :: urban_phy_driver_setup
  public :: urban_phy_driver_resume
  public :: urban_phy_driver

  !-----------------------------------------------------------------------------
  !
  !++ Public parameters & variables
  !
  !-----------------------------------------------------------------------------
  !
  !++ Private procedure
  !
  !-----------------------------------------------------------------------------
  !
  !++ Private parameters & variables
  !
  !-----------------------------------------------------------------------------
contains
  !-----------------------------------------------------------------------------
  subroutine urban_phy_driver_setup
    use scale_urban_phy, only: &
       urban_phy_setup
    use mod_urban_admin, only: &
       urban_type, &
       urban_sw
    use mod_urban_vars, only: &
       urban_z0m, &
       urban_z0h, &
       urban_z0e
    implicit none
    !---------------------------------------------------------------------------

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

    if ( urban_sw ) then

       ! setup library component
       call urban_phy_setup( urban_type,     & ! [IN]
                             urban_z0m(:,:), & ! [OUT]
                             urban_z0h(:,:), & ! [OUT]
                             urban_z0e(:,:)  ) ! [OUT]

    else
       if( io_l ) write(io_fid_log,*) '*** this component is never called.'
    endif

    return
  end subroutine urban_phy_driver_setup

  !-----------------------------------------------------------------------------
  subroutine urban_phy_driver_resume
    use mod_admin_restart, only: &
       restart_run
    use mod_urban_admin, only: &
       urban_sw
    implicit none

    if ( urban_sw ) then

       if ( .NOT. restart_run ) then ! tentative
          ! run once (only for the diagnostic value)
          call prof_rapstart('URB_Physics', 1)
          call urban_phy_driver( update_flag = .true. )
          call prof_rapend  ('URB_Physics', 1)
       end if

    end if

    return
  end subroutine urban_phy_driver_resume
  !-----------------------------------------------------------------------------
  subroutine urban_phy_driver( update_flag )
    use scale_atmos_hydrometeor, only: &
       hydrometeor_lhv => atmos_hydrometeor_lhv
    use scale_time, only: &
       nowdate => time_nowdate,     &
       dt      => time_dtsec_urban
    use scale_rm_statistics, only: &
       statistics_checktotal, &
       stat_total
    use scale_history, only: &
       hist_in
    use scale_mapproj, only: &
       base_lon => mprj_basepoint_lon, &
       base_lat => mprj_basepoint_lat
    use scale_grid_real, only: &
       real_z1
    use scale_urban_phy, only: &
       urban_phy
    use mod_urban_vars, only: &
       urban_tr,         &
       urban_tb,         &
       urban_tg,         &
       urban_tc,         &
       urban_qc,         &
       urban_uc,         &
       urban_trl,        &
       urban_tbl,        &
       urban_tgl,        &
       urban_rainr,      &
       urban_rainb,      &
       urban_raing,      &
       urban_roff,       &
       urban_tr_t,       &
       urban_tb_t,       &
       urban_tg_t,       &
       urban_tc_t,       &
       urban_qc_t,       &
       urban_uc_t,       &
       urban_trl_t,      &
       urban_tbl_t,      &
       urban_tgl_t,      &
       urban_rainr_t,    &
       urban_rainb_t,    &
       urban_raing_t,    &
       urban_roff_t,     &
       urban_sfc_temp,   &
       urban_sfc_albedo, &
       urban_sflx_mw,    &
       urban_sflx_mu,    &
       urban_sflx_mv,    &
       urban_sflx_sh,    &
       urban_sflx_lh,    &
       urban_sflx_gh,    &
       urban_sflx_evap,  &
       urban_z0m,        &
       urban_z0h,        &
       urban_z0e,        &
       urban_u10,        &
       urban_v10,        &
       urban_t2,         &
       urban_q2,         &
       atmos_temp,       &
       atmos_pres,       &
       atmos_w,          &
       atmos_u,          &
       atmos_v,          &
       atmos_dens,       &
       atmos_qv,         &
       atmos_pbl,        &
       atmos_sfc_pres,   &
       atmos_sflx_lw,    &
       atmos_sflx_sw,    &
       atmos_sflx_prec
    implicit none

    ! arguments
    logical, intent(in) :: update_flag

    ! works
    real(RP) :: lhv(ia,ja) ! latent heat of vaporization [J/kg]
    real(RP) :: total      ! dummy

    character(len=2) :: sk

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

    if ( update_flag ) then

       call urban_phy( urban_tr_t(:,:),      & ! [OUT]
                       urban_tb_t(:,:),      & ! [OUT]
                       urban_tg_t(:,:),      & ! [OUT]
                       urban_tc_t(:,:),      & ! [OUT]
                       urban_qc_t(:,:),      & ! [OUT]
                       urban_uc_t(:,:),      & ! [OUT]
                       urban_trl_t(:,:,:),    & ! [OUT]
                       urban_tbl_t(:,:,:),    & ! [OUT]
                       urban_tgl_t(:,:,:),    & ! [OUT]
                       urban_rainr_t(:,:),      & ! [OUT]
                       urban_rainb_t(:,:),      & ! [OUT]
                       urban_raing_t(:,:),      & ! [OUT]
                       urban_roff_t(:,:),      & ! [OUT]
                       urban_sfc_temp(:,:),      & ! [OUT]
                       urban_sfc_albedo(:,:,i_lw), & ! [OUT]
                       urban_sfc_albedo(:,:,i_sw), & ! [OUT]
                       urban_sflx_mw(:,:),      & ! [OUT]
                       urban_sflx_mu(:,:),      & ! [OUT]
                       urban_sflx_mv(:,:),      & ! [OUT]
                       urban_sflx_sh(:,:),      & ! [OUT]
                       urban_sflx_lh(:,:),      & ! [OUT]
                       urban_sflx_gh(:,:),      & ! [OUT]
                       urban_z0m(:,:),      & ! [OUT]
                       urban_z0h(:,:),      & ! [OUT]
                       urban_z0e(:,:),      & ! [OUT]
                       urban_u10(:,:),      & ! [OUT]
                       urban_v10(:,:),      & ! [OUT]
                       urban_t2(:,:),      & ! [OUT]
                       urban_q2(:,:),      & ! [OUT]
                       atmos_temp(:,:),      & ! [IN]
                       atmos_pres(:,:),      & ! [IN]
                       atmos_w(:,:),      & ! [IN]
                       atmos_u(:,:),      & ! [IN]
                       atmos_v(:,:),      & ! [IN]
                       atmos_dens(:,:),      & ! [IN]
                       atmos_qv(:,:),      & ! [IN]
                       real_z1(:,:),      & ! [IN]
                       atmos_pbl(:,:),      & ! [IN]
                       atmos_sfc_pres(:,:),      & ! [IN]
                       atmos_sflx_lw(:,:,:),    & ! [IN]
                       atmos_sflx_sw(:,:,:),    & ! [IN]
                       atmos_sflx_prec(:,:),      & ! [IN]
                       urban_tr(:,:),      & ! [IN]
                       urban_tb(:,:),      & ! [IN]
                       urban_tg(:,:),      & ! [IN]
                       urban_tc(:,:),      & ! [IN]
                       urban_qc(:,:),      & ! [IN]
                       urban_uc(:,:),      & ! [IN]
                       urban_trl(:,:,:),    & ! [IN]
                       urban_tbl(:,:,:),    & ! [IN]
                       urban_tgl(:,:,:),    & ! [IN]
                       urban_rainr(:,:),      & ! [IN]
                       urban_rainb(:,:),      & ! [IN]
                       urban_raing(:,:),      & ! [IN]
                       urban_roff(:,:),      & ! [IN]
                       base_lon,                   & ! [IN]
                       base_lat,                   & ! [IN]
                       nowdate(:),        & ! [IN]
                       dt                          ) ! [IN]

       call hydrometeor_lhv( lhv(:,:), atmos_temp(:,:) )

!OCL XFILL
       do j = js, je
       do i = is, ie
          urban_sflx_evap(i,j) = urban_sflx_lh(i,j) / lhv(i,j)
       end do
       end do

       call hist_in( urban_tr_t(:,:), 'URBAN_TR_t', 'tendency of URBAN_TR', 'K'     )
       call hist_in( urban_tb_t(:,:), 'URBAN_TB_t', 'tendency of URBAN_TB', 'K'     )
       call hist_in( urban_tg_t(:,:), 'URBAN_TG_t', 'tendency of URBAN_TG', 'K'     )
       call hist_in( urban_tc_t(:,:), 'URBAN_TC_t', 'tendency of URBAN_TC', 'K'     )
       call hist_in( urban_qc_t(:,:), 'URBAN_QC_t', 'tendency of URBAN_QC', 'kg/kg' )
       call hist_in( urban_uc_t(:,:), 'URBAN_UC_t', 'tendency of URBAN_UC', 'm/s'   )

       call hist_in( urban_trl_t(:,:,:), 'URBAN_TRL_t', 'tendency of URBAN_TRL', 'K', zdim='urban' )
       call hist_in( urban_tbl_t(:,:,:), 'URBAN_TBL_t', 'tendency of URBAN_TBL', 'K', zdim='urban' )
       call hist_in( urban_tgl_t(:,:,:), 'URBAN_TGL_t', 'tendency of URBAN_TGL', 'K', zdim='urban' )

       call hist_in( urban_rainr_t(:,:), 'URBAN_RAINR_t', 'tendency of URBAN_RAINR', 'K' )
       call hist_in( urban_rainb_t(:,:), 'URBAN_RAINB_t', 'tendency of URBAN_RAINB', 'K' )
       call hist_in( urban_raing_t(:,:), 'URBAN_RAING_t', 'tendency of URBAN_RAING', 'K' )
       call hist_in( urban_roff_t(:,:), 'URBAN_ROFF_t',  'tendency of URBAN_ROFF',  'K' )

    endif

    if ( statistics_checktotal ) then
       call stat_total( total, urban_tr_t(:,:), 'URBAN_TR_t' )
       call stat_total( total, urban_tb_t(:,:), 'URBAN_TB_t' )
       call stat_total( total, urban_tg_t(:,:), 'URBAN_TG_t' )
       call stat_total( total, urban_tc_t(:,:), 'URBAN_TC_t' )
       call stat_total( total, urban_qc_t(:,:), 'URBAN_QC_t' )
       call stat_total( total, urban_uc_t(:,:), 'URBAN_UC_t' )

       do k = uks, uke
          write(sk,'(I2.2)') k

          call stat_total( total, urban_trl_t(k,:,:), 'URBAN_TRL_t'//sk  )
          call stat_total( total, urban_tbl_t(k,:,:), 'URBAN_TBL_t'//sk  )
          call stat_total( total, urban_tgl_t(k,:,:), 'URBAN_TGL_t'//sk  )
       enddo

       call stat_total( total, urban_rainr_t(:,:), 'URBAN_RAINR_t' )
       call stat_total( total, urban_rainb_t(:,:), 'URBAN_RAINB_t' )
       call stat_total( total, urban_raing_t(:,:), 'URBAN_RAING_t' )
       call stat_total( total, urban_roff_t(:,:), 'URBAN_ROFF_t'  )
    endif

    return
  end subroutine urban_phy_driver

end module mod_urban_phy_driver