mod_urban_driver.f90

Go to the documentation of this file.

!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
module mod_urban_driver
  !-----------------------------------------------------------------------------
  !
  !++ used modules
  !
  use scale_precision
  use scale_stdio
  use scale_prof
  use scale_debug
  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_driver_setup
  public :: urban_driver_resume
  public :: urban_driver
  public :: urban_surface_get
  public :: urban_surface_set

  !-----------------------------------------------------------------------------
  !
  !++ Public parameters & variables
  !
  !-----------------------------------------------------------------------------
  !
  !++ Private procedure
  !
  !-----------------------------------------------------------------------------
  !
  !++ Private parameters & variables
  !
  !-----------------------------------------------------------------------------
contains
  !-----------------------------------------------------------------------------
  subroutine urban_driver_setup
    use mod_urban_phy_driver, only: &
       urban_phy_driver_setup
    implicit none
    !---------------------------------------------------------------------------

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

    call urban_phy_driver_setup

    return
  end subroutine urban_driver_setup

  !-----------------------------------------------------------------------------
  subroutine urban_driver_resume
    use mod_urban_phy_driver, only: &
       urban_phy_driver_resume
    use mod_urban_vars, only: &
       urban_vars_history
    use mod_urban_admin, only: &
       urban_sw
    implicit none
    !---------------------------------------------------------------------------

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

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

    call urban_phy_driver_resume

    !########## Set Surface Boundary to coupler ##########
    call urban_surface_set( countup=.true. )

    !########## History & Monitor ##########
    if ( urban_sw ) then
       call prof_rapstart('URB_History', 1)
       call urban_vars_history
       call prof_rapend  ('URB_History', 1)
    endif

    return
  end subroutine urban_driver_resume

  !-----------------------------------------------------------------------------
  subroutine urban_driver
    use scale_time, only: &
       dt => time_dtsec_urban
    use mod_urban_admin, only: &
       urban_sw
    use mod_urban_vars, only: &
       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_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_vars_total,  &
       urban_vars_history
    use mod_urban_phy_driver, only: &
       urban_phy_driver
    implicit none

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

    !########## Get Surface Boundary from coupler ##########
    call prof_rapstart('URB_SfcExch', 2)
    call urban_surface_get
    call prof_rapend  ('URB_SfcExch', 2)

    !########## Physics ##########
    if ( urban_sw ) then
       call prof_rapstart('URB_Physics', 1)
       call urban_phy_driver( update_flag = .true. )
       call prof_rapend  ('URB_Physics', 1)
    endif

    !########## Update ##########
    do j = js, je
    do i = is, ie
    do k = uks, uke
       urban_trl(k,i,j) = urban_trl(k,i,j) + urban_trl_t(k,i,j) * dt
       urban_tbl(k,i,j) = urban_tbl(k,i,j) + urban_tbl_t(k,i,j) * dt
       urban_tgl(k,i,j) = urban_tgl(k,i,j) + urban_tgl_t(k,i,j) * dt
    end do
    end do
    end do
    do j = js, je
    do i = is, ie
       urban_tr(i,j) = urban_tr(i,j) + urban_tr_t(i,j) * dt
       urban_tb(i,j) = urban_tb(i,j) + urban_tb_t(i,j) * dt
       urban_tg(i,j) = urban_tg(i,j) + urban_tg_t(i,j) * dt
       urban_tc(i,j) = urban_tc(i,j) + urban_tc_t(i,j) * dt
       urban_qc(i,j) = urban_qc(i,j) + urban_qc_t(i,j) * dt
       urban_uc(i,j) = urban_uc(i,j) + urban_uc_t(i,j) * dt

       urban_rainr(i,j) = urban_rainr(i,j) + urban_rainr_t(i,j) * dt
       urban_rainb(i,j) = urban_rainb(i,j) + urban_rainb_t(i,j) * dt
       urban_raing(i,j) = urban_raing(i,j) + urban_raing_t(i,j) * dt
       urban_roff(i,j) = urban_roff(i,j) + urban_roff_t(i,j) * dt
    end do
    end do

    call urban_vars_total

    !########## Set Surface Boundary to coupler ##########
    call prof_rapstart('URB_SfcExch', 2)
    call urban_surface_set( countup=.true. )
    call prof_rapend  ('URB_SfcExch', 2)

    !########## reset tendencies ##########
!OCL XFILL
    do j = js, je
    do i = is, ie
    do k = uks, uke
       urban_trl_t(k,i,j) = 0.0_rp
       urban_tbl_t(k,i,j) = 0.0_rp
       urban_tgl_t(k,i,j) = 0.0_rp
    end do
    end do
    end do

!OCL XFILL
    do j = js, je
    do i = is, ie
       urban_tr_t(i,j) = 0.0_rp
       urban_tb_t(i,j) = 0.0_rp
       urban_tg_t(i,j) = 0.0_rp
       urban_tc_t(i,j) = 0.0_rp
       urban_qc_t(i,j) = 0.0_rp
       urban_uc_t(i,j) = 0.0_rp

       urban_rainr_t(i,j) = 0.0_rp
       urban_rainb_t(i,j) = 0.0_rp
       urban_raing_t(i,j) = 0.0_rp
       urban_roff_t(i,j) = 0.0_rp
    enddo
    enddo

    !########## History & Monitor ##########
    call prof_rapstart('URB_History', 1)
    call urban_vars_history
    call prof_rapend  ('URB_History', 1)

    return
  end subroutine urban_driver

  !-----------------------------------------------------------------------------
  subroutine urban_surface_get
    use mod_urban_admin, only: &
       urban_sw
    use mod_urban_vars, only: &
       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_cossza,   &
       atmos_sflx_prec
    use mod_cpl_vars, only: &
       cpl_getatm_urb
    implicit none

    real(RP) :: atmos_sflx_rad_dn(ia,ja,2,2)
    real(RP) :: atmos_sflx_rain  (ia,ja)
    real(RP) :: atmos_sflx_snow  (ia,ja)

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

    if ( urban_sw ) then
       call cpl_getatm_urb( atmos_temp(:,:),     & ! [OUT]
                            atmos_pres(:,:),     & ! [OUT]
                            atmos_w(:,:),     & ! [OUT]
                            atmos_u(:,:),     & ! [OUT]
                            atmos_v(:,:),     & ! [OUT]
                            atmos_dens(:,:),     & ! [OUT]
                            atmos_qv(:,:),     & ! [OUT]
                            atmos_pbl(:,:),     & ! [OUT]
                            atmos_sfc_pres(:,:),     & ! [OUT]
                            atmos_sflx_rad_dn(:,:,:,:), & ! [OUT]
                            atmos_cossza(:,:),     & ! [OUT]
                            atmos_sflx_rain(:,:),     & ! [OUT]
                            atmos_sflx_snow(:,:)      ) ! [OUT]
    endif

!OCL XFILL
    do j = js, je
    do i = is, ie
       atmos_sflx_sw(i,j,1) = atmos_sflx_rad_dn(i,j,i_sw,1) ! direct
       atmos_sflx_lw(i,j,1) = atmos_sflx_rad_dn(i,j,i_lw,1) ! direct
       atmos_sflx_sw(i,j,2) = atmos_sflx_rad_dn(i,j,i_sw,2) ! diffuse
       atmos_sflx_lw(i,j,2) = atmos_sflx_rad_dn(i,j,i_lw,2) ! diffuse

       atmos_sflx_prec(i,j)   = atmos_sflx_rain(i,j) + atmos_sflx_snow(i,j) ! liquid+ice
    enddo
    enddo

    return
  end subroutine urban_surface_get

  !-----------------------------------------------------------------------------
  subroutine urban_surface_set( countup )
    use mod_urban_admin, only: &
       urban_sw
    use mod_urban_vars, only: &
       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
    use mod_cpl_vars, only: &
       cpl_puturb
    implicit none

    ! arguments
    logical, intent(in) :: countup
    !---------------------------------------------------------------------------

    if ( urban_sw ) then
       call cpl_puturb( urban_sfc_temp(:,:),   & ! [IN]
                        urban_sfc_albedo(:,:,:), & ! [IN]
                        urban_z0m(:,:),   & ! [IN]
                        urban_z0h(:,:),   & ! [IN]
                        urban_z0e(:,:),   & ! [IN]
                        urban_sflx_mw(:,:),   & ! [IN]
                        urban_sflx_mu(:,:),   & ! [IN]
                        urban_sflx_mv(:,:),   & ! [IN]
                        urban_sflx_sh(:,:),   & ! [IN]
                        urban_sflx_lh(:,:),   & ! [IN]
                        urban_sflx_gh(:,:),   & ! [IN]
                        urban_sflx_evap(:,:),   & ! [IN]
                        urban_u10(:,:),   & ! [IN]
                        urban_v10(:,:),   & ! [IN]
                        urban_t2(:,:),   & ! [IN]
                        urban_q2(:,:),   & ! [IN]
                        countup                  ) ! [IN]
    endif

    return
  end subroutine urban_surface_set

end module mod_urban_driver