mod_land_driver.f90

Go to the documentation of this file.

!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
module mod_land_driver
  !-----------------------------------------------------------------------------
  !
  !++ used modules
  !
  use scale_precision
  use scale_stdio
  use scale_prof
  use scale_debug
  use scale_grid_index
  use scale_land_grid_index

  use scale_const, only: &
     i_sw  => const_i_sw, &
     i_lw  => const_i_lw
  !-----------------------------------------------------------------------------
  implicit none
  private
  !-----------------------------------------------------------------------------
  !
  !++ Public procedure
  !
  public :: land_driver_setup
  public :: land_driver_resume
  public :: land_driver
  public :: land_surface_get
  public :: land_surface_set

  !-----------------------------------------------------------------------------
  !
  !++ Public parameters & variables
  !
  !-----------------------------------------------------------------------------
  !
  !++ Private procedure
  !
  !-----------------------------------------------------------------------------
  !
  !++ Private parameters & variables
  !
  !-----------------------------------------------------------------------------
contains
  !-----------------------------------------------------------------------------
  subroutine land_driver_setup
    use mod_land_phy_driver, only: &
       land_phy_driver_setup
    implicit none
    !---------------------------------------------------------------------------

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

    call land_phy_driver_setup

    return
  end subroutine land_driver_setup

  !-----------------------------------------------------------------------------
  subroutine land_driver_resume
    use mod_land_phy_driver, only: &
       land_phy_driver_resume
    use mod_land_vars, only: &
       land_vars_history
    use mod_land_admin, only: &
       land_sw
    implicit none
    !---------------------------------------------------------------------------

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

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

    call land_phy_driver_resume

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

    !########## History & Monitor ##########
    if ( land_sw ) then
       call prof_rapstart('LND_History', 1)
       call land_vars_history
       call prof_rapend  ('LND_History', 1)
    endif

    return
  end subroutine land_driver_resume

  !-----------------------------------------------------------------------------
  subroutine land_driver
    use scale_time, only: &
       dt => time_dtsec_land
    use mod_land_admin, only: &
       land_sw
    use mod_land_vars, only: &
       land_temp,         &
       land_water,        &
       land_sfc_temp,     &
       land_sfc_albedo,   &
       land_temp_t,       &
       land_water_t,      &
       land_sfc_temp_t,   &
       land_sfc_albedo_t, &
       land_vars_total,   &
       land_vars_history
    use mod_land_phy_driver, only: &
       land_phy_driver
    implicit none

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

    !########## Get Surface Boundary from coupler ##########
    call prof_rapstart('LND_SfcExch', 2)
    call land_surface_get
    call prof_rapend  ('LND_SfcExch', 2)

    !########## Physics ##########
    if ( land_sw ) then
       call prof_rapstart('LND_Physics', 1)
       call land_phy_driver( update_flag = .true. )
       call prof_rapend  ('LND_Physics', 1)
    endif

    !########## Update ##########
    do j = js, je
    do i = is, ie
    do k = lks, lke
       land_temp(k,i,j) = land_temp(k,i,j) + land_temp_t(k,i,j) * dt
       land_water(k,i,j) = land_water(k,i,j) + land_water_t(k,i,j) * dt
    enddo
    enddo
    enddo
    do j = js, je
    do i = is, ie
       land_sfc_temp(i,j)      = land_sfc_temp(i,j)      + land_sfc_temp_t(i,j)      * dt
       land_sfc_albedo(i,j,i_lw) = land_sfc_albedo(i,j,i_lw) + land_sfc_albedo_t(i,j,i_lw) * dt
       land_sfc_albedo(i,j,i_sw) = land_sfc_albedo(i,j,i_sw) + land_sfc_albedo_t(i,j,i_sw) * dt
    enddo
    enddo

    !########## Negative Fixer ##########
    do j = js, je
    do i = is, ie
    do k = lks, lke
       land_water(k,i,j) = max( land_water(k,i,j), 0.0_rp )
    enddo
    enddo
    enddo

    call land_vars_total

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

    !########## reset tendencies ##########
!OCL XFILL
    do j = js, je
    do i = is, ie
    do k = lks, lke
       land_temp_t(k,i,j) = 0.0_rp
       land_water_t(k,i,j) = 0.0_rp
    enddo
    enddo
    enddo

!OCL XFILL
    do j = js, je
    do i = is, ie
       land_sfc_temp_t(i,j)      = 0.0_rp
       land_sfc_albedo_t(i,j,i_lw) = 0.0_rp
       land_sfc_albedo_t(i,j,i_sw) = 0.0_rp
    enddo
    enddo

    !########## History & Monitor ##########
    call prof_rapstart('LND_History', 1)
    call land_vars_history
    call prof_rapend  ('LND_History', 1)

    return
  end subroutine land_driver

  !-----------------------------------------------------------------------------
  subroutine land_surface_get
    use mod_land_admin, only: &
       land_sw
    use mod_land_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_lnd
    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 ( land_sw ) then
       call cpl_getatm_lnd( 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) = atmos_sflx_rad_dn(i,j,i_sw,1) + atmos_sflx_rad_dn(i,j,i_sw,2) ! direct+diffuse
       atmos_sflx_lw(i,j) = atmos_sflx_rad_dn(i,j,i_lw,1) + atmos_sflx_rad_dn(i,j,i_lw,2) ! direct+diffuse

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

    return
  end subroutine land_surface_get

  !-----------------------------------------------------------------------------
  subroutine land_surface_set( countup )
    use mod_land_admin, only: &
       land_sw
    use mod_land_vars, only: &
       land_property,   &
       i_z0m,           &
       i_z0h,           &
       i_z0e,           &
       land_sfc_temp,   &
       land_sfc_albedo, &
       land_sflx_mw,    &
       land_sflx_mu,    &
       land_sflx_mv,    &
       land_sflx_sh,    &
       land_sflx_lh,    &
       land_sflx_gh,    &
       land_sflx_evap,  &
       land_u10,        &
       land_v10,        &
       land_t2,         &
       land_q2
    use mod_cpl_vars, only: &
       cpl_putlnd
    implicit none

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

    if ( land_sw ) then
       call cpl_putlnd( land_sfc_temp(:,:),       & ! [IN]
                        land_sfc_albedo(:,:,:),     & ! [IN]
                        land_property(:,:,i_z0m), & ! [IN]
                        land_property(:,:,i_z0h), & ! [IN]
                        land_property(:,:,i_z0e), & ! [IN]
                        land_sflx_mw(:,:),       & ! [IN]
                        land_sflx_mu(:,:),       & ! [IN]
                        land_sflx_mv(:,:),       & ! [IN]
                        land_sflx_sh(:,:),       & ! [IN]
                        land_sflx_lh(:,:),       & ! [IN]
                        land_sflx_gh(:,:),       & ! [IN]
                        land_sflx_evap(:,:),       & ! [IN]
                        land_u10(:,:),       & ! [IN]
                        land_v10(:,:),       & ! [IN]
                        land_t2(:,:),       & ! [IN]
                        land_q2(:,:),       & ! [IN]
                        countup                     ) ! [IN]
    endif

    return
  end subroutine land_surface_set

end module mod_land_driver