mod_land_driver.F90

Go to the documentation of this file.

!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
#include "scalelib.h"
module mod_land_driver
  !-----------------------------------------------------------------------------
  !
  !++ used modules
  !
  use scale_precision
  use scale_io
  use scale_prof
  use scale_land_grid_cartesc_index
  use scale_tracer
  use scale_cpl_sfc_index

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

  !-----------------------------------------------------------------------------
  !
  !++ Public parameters & variables
  !
  !-----------------------------------------------------------------------------
  !
  !++ Private procedure
  !
  !-----------------------------------------------------------------------------
  !
  !++ Private parameters & variables
  !
  logical, private :: snow_flag
  !-----------------------------------------------------------------------------
contains
  !-----------------------------------------------------------------------------
  subroutine land_driver_setup
    use scale_prc, only: &
       prc_abort
    use mod_land_admin, only: &
       land_do, &
       land_dyn_type, &
       land_sfc_type, &
       snow_type
    use scale_land_dyn_bucket, only: &
       land_dyn_bucket_setup
    use scale_land_phy_snow_ky90, only: &
       land_phy_snow_ky90_setup
    use scale_cpl_phy_sfc_skin, only: &
       cpl_phy_sfc_skin_setup
    use scale_cpl_phy_sfc_fixed_temp, only: &
       cpl_phy_sfc_fixed_temp_setup
    implicit none
    !---------------------------------------------------------------------------

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

    snow_flag = .false.

    if ( land_do ) then

       select case ( land_dyn_type )
       case ( 'BUCKET' )
          call land_dyn_bucket_setup
       case ( 'INIT' )
          ! do nothing
       case default
          log_error("LAND_driver_setup",*) 'LAND_DYN_TYPE is invalid: ', trim(land_dyn_type)
          call prc_abort
       end select

       select case ( land_sfc_type )
       case ( 'SKIN' )
          call cpl_phy_sfc_skin_setup
       case ( 'FIXED-TEMP' )
          call cpl_phy_sfc_fixed_temp_setup
       case default
          log_error("LAND_driver_setup",*) 'LAND_SFC_TYPE is invalid: ', trim(land_sfc_type)
          call prc_abort
       end select

       select case ( snow_type )
       case ( 'NONE', 'OFF' )
       case ( 'KY90' )
          log_info("LAND_driver_setup",*) 'SNOW model is enabled'
          log_info("LAND_driver_setup",*) 'SNOW model is on experimental stage.'
          log_info("LAND_driver_setup",*) 'Use this with your own risk.'
          call land_phy_snow_ky90_setup
          snow_flag = .true.
       case default
          log_error("LAND_driver_setup",*) 'SNOW_TYPE is invalid: ', trim(snow_type)
          call prc_abort
       end select

    end if

    return
  end subroutine land_driver_setup

  !-----------------------------------------------------------------------------
  subroutine land_driver_calc_tendency( force )
    use scale_time, only: &
       dt => time_dtsec_land
    use scale_file_history, only: &
       file_history_in
    use scale_atmos_grid_cartesc_real, only: &
       real_z1 => atmos_grid_cartesc_real_z1
    use scale_atmos_hydrometeor, only: &
       hydrometeor_lhv => atmos_hydrometeor_lhv, &
       atmos_hydrometeor_dry,                    &
       i_qv
    use scale_land_grid_cartesc, only: &
       lcz => land_grid_cartesc_cz
    use scale_land_phy_snow_ky90, only: &
       land_phy_snow_ky90
    use scale_land_phy_snow_diagnos, only: &
       land_phy_snow_diags
    use scale_cpl_phy_sfc_skin, only: &
       cpl_phy_sfc_skin
    use scale_cpl_phy_sfc_fixed_temp, only: &
       cpl_phy_sfc_fixed_temp
    use mod_atmos_admin, only: &
       atmos_sw_phy_ch
    use mod_atmos_phy_ch_driver, only: &
       atmos_phy_ch_driver_land_flux
    use mod_land_admin, only: &
       land_sfc_type, &
       snow_type
    use mod_land_vars, only: &
       i_waterlimit,      &
       i_watercritical,   &
       i_stomataresist,   &
       i_thermalcond,     &
       i_heatcapacity,    &
       i_waterdiff,       &
       i_alblw,          &
       i_albsw,          &
       i_z0m,             &
       i_z0h,             &
       i_z0e,             &
       land_property,     &
       land_temp,         &
       land_water,        &
       land_sfc_temp,     &
       land_sfc_albedo,   &
       land_temp_t,       &
       land_water_t,      &
       land_sflx_mw,      &
       land_sflx_mu,      &
       land_sflx_mv,      &
       land_sflx_sh,      &
       land_sflx_lh,      &
       land_sflx_gh,      &
       land_sflx_qtrc,    &
       land_sflx_water,   &
       land_sflx_ice,     &
       land_u10,          &
       land_v10,          &
       land_t2,           &
       land_q2,           &
       snow_sfc_temp,     &
       snow_swe,          &
       snow_depth,        &
       snow_dzero,        &
       snow_nosnowsec,    &
       atmos_temp,        &
       atmos_pres,        &
       atmos_w,           &
       atmos_u,           &
       atmos_v,           &
       atmos_dens,        &
       atmos_qv,          &
       atmos_pbl,         &
       atmos_sfc_dens,    &
       atmos_sfc_pres,    &
       atmos_sflx_rad_dn, &
       atmos_sflx_rain,   &
       atmos_sflx_snow
    use scale_landuse, only: &
       landuse_fact_land, &
       landuse_exists_land
    implicit none

    logical, intent(in) :: force

    ! parameters
    real(RP), parameter :: BETA_MAX = 1.0_rp

    ! works
    real(RP) :: SNOW_QVEF (lia,lja)
    real(RP) :: LAND_QVEF (lia,lja)
    real(RP) :: LAND_TC_dZ(lia,lja)
    real(RP) :: SFLX_QV   (lia,lja)
    real(RP) :: SFLX_GH   (lia,lja)
    real(RP) :: LHV       (lia,lja) ! latent heat of vaporization [J/kg]

    ! for snow
    real(RP) :: SNOW_albedo         (lia,lja,2)
    real(RP) :: SNOW_ATMOS_SFLX_SH  (lia,lja)
    real(RP) :: SNOW_ATMOS_SFLX_LH  (lia,lja)
    real(RP) :: SNOW_ATMOS_SFLX_GH  (lia,lja)
    !real(RP) :: SNOW_ATMOS_SFLX_evap(LIA,LJA)
    real(RP) :: SNOW_LAND_SFLX_GH   (lia,lja)
    real(RP) :: SNOW_LAND_SFLX_water(lia,lja)
    real(RP) :: SNOW_LAND_SFLX_ice  (lia,lja)
    real(RP) :: SNOW_frac           (lia,lja)

    real(RP) :: SNOW_ATMOS_SFLX_MW  (lia,lja)
    real(RP) :: SNOW_ATMOS_SFLX_MU  (lia,lja)
    real(RP) :: SNOW_ATMOS_SFLX_MV  (lia,lja)
    real(RP) :: SNOW_U10            (lia,lja)
    real(RP) :: SNOW_V10            (lia,lja)
    real(RP) :: SNOW_T2             (lia,lja)
    real(RP) :: SNOW_Q2             (lia,lja)

    ! monitor
    !real(RP) :: MONIT_WCONT0        (LIA,LJA)
    !real(RP) :: MONIT_WCONT1        (LIA,LJA)
    !real(RP) :: MONIT_ENG0          (LIA,LJA)
    !real(RP) :: MONIT_ENG1          (LIA,LJA)
    !
    !real(RP) :: MONIT_SNOW_heat     (LIA,LJA)
    !real(RP) :: MONIT_SNOW_water    (LIA,LJA)
    !real(RP) :: MONIT_LAND_heat     (LIA,LJA)
    !real(RP) :: MONIT_LAND_water    (LIA,LJA)

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

    call prof_rapstart('LND_CalcTend', 1)

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

    !########## reset tendencies ##########
!OCL XFILL
    !$omp parallel do
    do j = ljs, lje
    do i = lis, lie
    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 iq = 1, qa
    !$omp parallel do
    do j  = ljs, lje
    do i  = lis, lie
       land_sflx_qtrc(i,j,iq) = 0.0_rp
    enddo
    enddo
    enddo

    call hydrometeor_lhv( lia, lis, lie, lja, ljs, lje, &
                          atmos_temp(:,:), lhv(:,:) )

    if ( snow_flag ) then
       !------------------------------------------------------------------------

!OCL XFILL
       !$omp parallel do
       do j = ljs, lje
       do i = lis, lie
          ! This is for debug---adachi start
          !if(( int(SNOW_frac(i,j)) == 1 ).and.( abs(SNOW_SFC_TEMP(i,j)-LAND_SFC_TEMP(i,j))/=0 ))then
          !   LOG_ERROR("LAND_driver_calc_tendency",*) "Error please check SNOW_SFC_TEMP routine"
          !   call PRC_abort
          !endif
          ! This is for debug---adachi end
          snow_sfc_temp(i,j) = land_sfc_temp(i,j)
       end do
       end do

       select case ( snow_type )
       case ( 'KY90' )
          ! accumulation and melt of snow if there is snow

          !MONIT_WCONT0 = 0.0_RP
          !call monitor_snow_water(  SNOW_Depth          (:,:),   & ! [IN]
          !                          SNOW_Dzero          (:,:),   & ! [IN]
          !                          MONIT_WCONT0        (:,:)    ) ! [OUT]

          call land_phy_snow_ky90( lia, lis, lie, lja, ljs, lje, &
                                   atmos_sflx_rain(:,:), atmos_sflx_snow(:,:),       & ! [IN]
                                   atmos_pres(:,:), atmos_temp(:,:), atmos_qv(:,:),  & ! [IN]
                                   atmos_w(:,:), atmos_u(:,:), atmos_v(:,:),         & ! [IN]
                                   atmos_sfc_dens(:,:),                              & ! [IN]
                                   atmos_sflx_rad_dn(:,:,:,:),                       & ! [IN]
                                   landuse_fact_land(:,:), dt,                       & ! [IN]
                                   snow_sfc_temp(:,:), snow_swe(:,:),                & ! [INOUT]
                                   snow_depth(:,:), snow_dzero(:,:),                 & ! [INOUT]
                                   snow_nosnowsec(:,:),                              & ! [INOUT]
                                   snow_albedo(:,:,:),                               & ! [OUT]
                                   snow_atmos_sflx_sh(:,:), snow_atmos_sflx_lh(:,:), & ! [OUT]
                                   snow_atmos_sflx_gh(:,:), snow_land_sflx_gh(:,:),  & ! [OUT]
                                   snow_land_sflx_water(:,:),                        & ! [OUT]
                                   snow_frac(:,:)                         ) ! [OUT]

!OCL XFILL
          !$omp parallel do
          do j = ljs, lje
          do i = lis, lie
             snow_land_sflx_ice(i,j) = 0.0_rp
          enddo
          enddo
       end select

!OCL XFILL
       !!$omp parallel do
       !do j = LJS, LJE
       !do i = LIS, LIE
       !   SNOW_ATMOS_SFLX_evap (i,j) = - SNOW_ATMOS_SFLX_LH(i,j) / LHV(i,j)
       !end do
       !end do
       !call monitor_snow_water(  SNOW_Depth          (:,:),   & ! [IN]
       !                          SNOW_Dzero          (:,:),   & ! [IN]
       !                          MONIT_WCONT1        (:,:)    ) ! [OUT]

       !call monitor_land_regidual( ATMOS_SFLX_rain     (:,:),   & ! [IN] ! downward at surface
       !                            ATMOS_SFLX_snow     (:,:),   & ! [IN] ! downward at surface
       !                            SNOW_ATMOS_SFLX_evap(:,:),   & ! [IN] ! upward   at surface
       !                            SNOW_LAND_SFLX_water(:,:),   & ! [IN] ! downward at bottom
       !                            SNOW_LAND_SFLX_ice  (:,:),   & ! [IN] ! downward at bottom
       !                            MONIT_WCONT0        (:,:),   & ! [IN]
       !                            MONIT_WCONT1        (:,:),   & ! [IN]
       !                            MONIT_SNOW_water    (:,:)    ) ! [OUT]

!OCL XFILL
       !$omp parallel do
       do j = ljs, lje
       do i = lis, lie
          snow_qvef(i,j) = 1.0_rp ! tentative
       end do
       end do

       ! momentum fluxes and diagnostic variables above snowpack
       call land_phy_snow_diags( lia, lis, lie, lja, ljs, lje, &
                                 snow_frac(:,:),                                                & ! [IN]
                                 atmos_temp(:,:), atmos_pres(:,:),                              & ! [IN]
                                 atmos_w(:,:), atmos_u(:,:), atmos_v(:,:),                      & ! [IN]
                                 atmos_dens(:,:), atmos_qv(:,:),                                & ! [IN]
                                 real_z1(:,:), atmos_pbl(:,:),                                  & ! [IN]
                                 atmos_sfc_dens(:,:), atmos_sfc_pres(:,:), snow_sfc_temp(:,:), & ! [IN]
                                 snow_qvef(:,:),                                                & ! [IN]
                                 land_property(:,:,i_z0m),                                      & ! [IN]
                                 land_property(:,:,i_z0h),                                      & ! [IN]
                                 land_property(:,:,i_z0e),                                      & ! [IN]
                                 snow_atmos_sflx_mw(:,:),                                       & ! [OUT]
                                 snow_atmos_sflx_mu(:,:),                                       & ! [OUT]
                                 snow_atmos_sflx_mv(:,:),                                       & ! [OUT]
                                 snow_u10(:,:), snow_v10(:,:),                                  & ! [OUT]
                                 snow_t2(:,:), snow_q2(:,:)                                     ) ! [OUT]

       call file_history_in( snow_albedo(:,:,i_sw), 'SNOW_ALB_SW',          'Snow surface albedo (short wave)',         '1',      dim_type='XY' )
       call file_history_in( snow_albedo(:,:,i_lw), 'SNOW_ALB_LW',          'Snow surface albedo (long wave)',          '1',      dim_type='XY' )
       call file_history_in( snow_atmos_sflx_sh(:,:),      'SNOW_ATMOS_SFLX_SH',   'Snow surface sensible heat flux',          'J/m2/s', dim_type='XY' )
       call file_history_in( snow_atmos_sflx_lh(:,:),      'SNOW_ATMOS_SFLX_LH',   'Snow surface latent heat flux',            'J/m2/s', dim_type='XY' )
       call file_history_in( snow_atmos_sflx_gh(:,:),      'SNOW_ATMOS_SFLX_GH',   'Snowpack received heat flux',              'J/m2/s', dim_type='XY' )
       call file_history_in( snow_land_sflx_gh(:,:),      'SNOW_LAND_SFLX_GH',    'land surface ground heat flux under snow', 'J/m2/s', dim_type='XY' )
       call file_history_in( snow_land_sflx_water(:,:),      'SNOW_LAND_SFLX_water', 'land surface liquid water flux under snow', 'kg/m2/s',dim_type='XY' )
       call file_history_in( snow_land_sflx_water(:,:),      'SNOW_LAND_SFLX_ice',   'land surface ice water flux under snow',    'kg/m2/s',dim_type='XY' )
       call file_history_in( snow_frac(:,:),      'SNOW_frac',            'Snow fraction on land subgrid',            '1',      dim_type='XY' )
       call file_history_in( snow_atmos_sflx_mw(:,:),      'SNOW_ATMOS_SFLX_MW',   'Snow surface w-momentum flux',             'J/m2/s', dim_type='XY' )
       call file_history_in( snow_atmos_sflx_mu(:,:),      'SNOW_ATMOS_SFLX_MU',   'Snow surface u-momentum flux',             'J/m2/s', dim_type='XY' )
       call file_history_in( snow_atmos_sflx_mv(:,:),      'SNOW_ATMOS_SFLX_MV',   'Snow surface v-momentum flux',             'J/m2/s', dim_type='XY' )
       call file_history_in( snow_u10(:,:),      'SNOW_U10',             'Wind velocity u at 10 m on snow surface',  'm/s',    dim_type='XY' )
       call file_history_in( snow_v10(:,:),      'SNOW_V10',             'Wind velocity v at 10 m on snow surface',  'm/s',    dim_type='XY' )
       call file_history_in( snow_t2(:,:),      'SNOW_T2',              'Air temperature at 2m on snow surface',    'K',      dim_type='XY' )
       call file_history_in( snow_q2(:,:),      'SNOW_Q2',              'Specific humidity at 2m on snow surface',  'kg/kg',  dim_type='XY' )
    endif


!OCL XFILL
    !$omp parallel do
    do j = ljs, lje
    do i = lis, lie
       land_qvef(i,j) = min( land_water(lks,i,j) / land_property(i,j,i_watercritical), beta_max )

       ! eq.(12) in Merlin et al.(2011) but simplified P=0.5 used
       !sw = 0.5_RP + sign(0.5_RP,LAND_WATER(LKS,i,j)-LAND_PROPERTY(i,j,I_WaterCritical)) ! if W > Wc, sw = 1
       !LAND_QVEF(i,j) = (        sw ) * 1.0_RP &
       !               + ( 1.0_RP-sw ) * sqrt( 0.5_RP - 0.5_RP * cos( PI * LAND_WATER(LKS,i,j) / LAND_PROPERTY(i,j,I_WaterCritical) ) )

       land_tc_dz(i,j) = land_property(i,j,i_thermalcond) / lcz(lks)
    end do
    end do


    !------------------------------------------------------------------------


    select case ( land_sfc_type )
    case ( 'SKIN' )
!OCL XFILL
       !$omp parallel do
       do j = ljs, lje
       do i = lis, lie
          land_sfc_albedo(i,j,i_r_direct ,i_r_ir ) = land_property(i,j,i_alblw)
          land_sfc_albedo(i,j,i_r_diffuse,i_r_ir ) = land_property(i,j,i_alblw)
          land_sfc_albedo(i,j,i_r_direct ,i_r_nir) = land_property(i,j,i_albsw)
          land_sfc_albedo(i,j,i_r_diffuse,i_r_nir) = land_property(i,j,i_albsw)
          land_sfc_albedo(i,j,i_r_direct ,i_r_vis) = land_property(i,j,i_albsw)
          land_sfc_albedo(i,j,i_r_diffuse,i_r_vis) = land_property(i,j,i_albsw)
       end do
       end do

       call cpl_phy_sfc_skin( lia, lis, lie, lja, ljs, lje, &
                              atmos_temp(:,:), atmos_pres(:,:),                        & ! [IN]
                              atmos_w(:,:), atmos_u(:,:), atmos_v(:,:),                & ! [IN]
                              atmos_dens(:,:), atmos_qv(:,:), lhv(:,:),                & ! [IN]
                              real_z1(:,:), atmos_pbl(:,:),                            & ! [IN]
                              atmos_sfc_dens(:,:), atmos_sfc_pres(:,:),                & ! [IN]
                              atmos_sflx_rad_dn(:,:,:,:),                              & ! [IN]
                              land_temp(lks,:,:), land_qvef(:,:),                      & ! [IN]
                              land_sfc_albedo(:,:,:,:),                                & ! [IN]
                              land_property(:,:,i_stomataresist),                      & ! [IN]
                              land_tc_dz(:,:),                                         & ! [IN]
                              land_property(:,:,i_z0m),                                & ! [IN]
                              land_property(:,:,i_z0h),                                & ! [IN]
                              land_property(:,:,i_z0e),                                & ! [IN]
                              landuse_exists_land(:,:), dt,                            & ! [IN]
                              'LAND',                                                  & ! [IN]
                              land_sfc_temp(:,:),                                      & ! [INOUT]
                              land_sflx_mw(:,:), land_sflx_mu(:,:), land_sflx_mv(:,:), & ! [OUT]
                              land_sflx_sh(:,:), sflx_qv(:,:), sflx_gh(:,:),           & ! [OUT]
                              land_u10(:,:), land_v10(:,:), land_t2(:,:), land_q2(:,:) ) ! [OUT]

    case ( 'FIXED-TEMP' )
!OCL XFILL
       !$omp parallel do
       do j = ljs, lje
       do i = lis, lie
          land_sfc_temp(i,j) = land_temp(lks,i,j)
       end do
       end do
!OCL XFILL
       !$omp parallel do
       do j = ljs, lje
       do i = lis, lie
          land_sfc_albedo(i,j,i_r_direct ,i_r_ir ) = land_property(i,j,i_alblw)
          land_sfc_albedo(i,j,i_r_diffuse,i_r_ir ) = land_property(i,j,i_alblw)
          land_sfc_albedo(i,j,i_r_direct ,i_r_nir) = land_property(i,j,i_albsw)
          land_sfc_albedo(i,j,i_r_diffuse,i_r_nir) = land_property(i,j,i_albsw)
          land_sfc_albedo(i,j,i_r_direct ,i_r_vis) = land_property(i,j,i_albsw)
          land_sfc_albedo(i,j,i_r_diffuse,i_r_vis) = land_property(i,j,i_albsw)
       end do
       end do

       call cpl_phy_sfc_fixed_temp( lia, lis, lie, lja, ljs, lje, &
                                    atmos_temp(:,:), atmos_pres(:,:),                        & ! [IN]
                                    atmos_w(:,:), atmos_u(:,:), atmos_v(:,:),                & ! [IN]
                                    atmos_dens(:,:), atmos_qv(:,:), lhv(:,:),                & ! [IN]
                                    real_z1(:,:), atmos_pbl(:,:),                            & ! [IN]
                                    atmos_sfc_dens(:,:), atmos_sfc_pres(:,:),                & ! [IN]
                                    atmos_sflx_rad_dn(:,:,:,:),                              & ! [IN]
                                    land_sfc_temp(:,:), land_qvef(:,:),                      & ! [IN]
                                    land_sfc_albedo(:,:,:,:),                                & ! [IN]
                                    land_property(:,:,i_stomataresist),                      & ! [IN]
                                    land_property(:,:,i_z0m),                                & ! [IN]
                                    land_property(:,:,i_z0h),                                & ! [IN]
                                    land_property(:,:,i_z0e),                                & ! [IN]
                                    landuse_exists_land(:,:), dt,                            & ! [IN]
                                    land_sflx_mw(:,:), land_sflx_mu(:,:), land_sflx_mv(:,:), & ! [OUT]
                                    land_sflx_sh(:,:), sflx_qv(:,:), sflx_gh(:,:),           & ! [OUT]
                                    land_u10(:,:), land_v10(:,:),                            & ! [OUT]
                                    land_t2(:,:), land_q2(:,:)                               ) ! [OUT]

    end select

    ! LAND_SFLX_* are positive for downward
!OCL XFILL
    !$omp parallel do
    do j = ljs, lje
    do i = lis, lie
       land_sflx_gh(i,j) = - sflx_gh(i,j) ! inverse sign ( positive for upward to downward )
       land_sflx_water(i,j) = atmos_sflx_rain(i,j) - sflx_qv(i,j)
       land_sflx_ice(i,j) = atmos_sflx_snow(i,j)
    end do
    end do

    if ( .NOT. atmos_hydrometeor_dry ) then
       !$omp parallel do
       do j = ljs, lje
       do i = lis, lie
          land_sflx_lh(i,j) = sflx_qv(i,j) * lhv(i,j) ! always LHV
       enddo
       enddo
    else
       !$omp parallel do
       do j = ljs, lje
       do i = lis, lie
          land_sflx_lh(i,j) = 0.0_rp
       enddo
       enddo
    endif

    if ( snow_flag ) then

       ! marge land surface and snow surface !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!OCL XFILL
       !$omp parallel do
       do j = ljs, lje
       do i = lis, lie
          land_sfc_temp(i,j) = (        snow_frac(i,j) ) * snow_sfc_temp(i,j) &
                             + ( 1.0_rp-snow_frac(i,j) ) * land_sfc_temp(i,j)

          do idir = i_r_direct, i_r_diffuse
             land_sfc_albedo(i,j,idir,i_r_ir ) = (        snow_frac(i,j) ) * snow_albedo(i,j,i_lw)         &
                                               + ( 1.0_rp-snow_frac(i,j) ) * land_sfc_albedo(i,j,idir,i_r_ir)
             land_sfc_albedo(i,j,idir,i_r_nir) = (        snow_frac(i,j) ) * snow_albedo(i,j,i_sw)         &
                                               + ( 1.0_rp-snow_frac(i,j) ) * land_sfc_albedo(i,j,idir,i_r_nir)
             land_sfc_albedo(i,j,idir,i_r_vis) = (        snow_frac(i,j) ) * snow_albedo(i,j,i_sw)         &
                                               + ( 1.0_rp-snow_frac(i,j) ) * land_sfc_albedo(i,j,idir,i_r_vis)
          enddo

          ! flux to the soil
          land_sflx_gh(i,j) = (        snow_frac(i,j) ) * snow_land_sflx_gh(i,j) &
                               + ( 1.0_rp-snow_frac(i,j) ) *      land_sflx_gh(i,j)
          land_sflx_water(i,j) = (        snow_frac(i,j) ) * snow_land_sflx_water(i,j) &
                               + ( 1.0_rp-snow_frac(i,j) ) *      land_sflx_water(i,j)
          land_sflx_ice(i,j) = (        snow_frac(i,j) ) * snow_land_sflx_ice(i,j) &
                               + ( 1.0_rp-snow_frac(i,j) ) *      land_sflx_ice(i,j)
          ! flux to the atmosphere
          land_sflx_sh(i,j) = (        snow_frac(i,j) ) * snow_atmos_sflx_sh(i,j) &
                               + ( 1.0_rp-snow_frac(i,j) ) *       land_sflx_sh(i,j)
          land_sflx_lh(i,j) = (        snow_frac(i,j) ) * snow_atmos_sflx_lh(i,j) &
                               + ( 1.0_rp-snow_frac(i,j) ) *       land_sflx_lh(i,j)

          ! diagnostics
          land_u10(i,j) = (        snow_frac(i,j) ) *      snow_u10(i,j) &
                               + ( 1.0_rp-snow_frac(i,j) ) *      land_u10(i,j)
          land_v10(i,j) = (        snow_frac(i,j) ) *      snow_v10(i,j) &
                               + ( 1.0_rp-snow_frac(i,j) ) *      land_v10(i,j)
          land_t2(i,j) = (        snow_frac(i,j) ) *      snow_t2(i,j) &
                               + ( 1.0_rp-snow_frac(i,j) ) *      land_t2(i,j)
          land_q2(i,j) = (        snow_frac(i,j) ) *      snow_q2(i,j) &
                               + ( 1.0_rp-snow_frac(i,j) ) *      land_q2(i,j)
       enddo
       enddo

    end if

    if ( .NOT. atmos_hydrometeor_dry ) then
       !$omp parallel do
       do j = ljs, lje
       do i = lis, lie
          land_sflx_qtrc(i,j,i_qv) = land_sflx_lh(i,j) / lhv(i,j)
       enddo
       enddo
    endif

    ! Surface flux for chemical tracers
    if ( atmos_sw_phy_ch ) then
       call atmos_phy_ch_driver_land_flux( land_sflx_qtrc(:,:,:) ) ! [INOUT]
    endif

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

    call prof_rapend  ('LND_CalcTend', 1)

    return
  end subroutine land_driver_calc_tendency

  !-----------------------------------------------------------------------------
  subroutine land_driver_update
    use scale_time, only: &
       dt => time_dtsec_land
    use mod_land_vars, only: &
       land_property,     &
       i_waterlimit,      &
       i_thermalcond,     &
       i_heatcapacity,    &
       i_waterdiff,       &
       land_temp,         &
       land_water,        &
       land_sflx_gh,      &
       land_sflx_water,   &
       land_sflx_ice,     &
       land_sfc_temp,     &
       land_temp_t,       &
       land_water_t,      &
       land_vars_total,   &
       land_vars_history
    use scale_land_grid_cartesc, only: &
       lcdz => land_grid_cartesc_cdz
    use scale_land_dyn_bucket, only: &
       land_dyn_bucket
    use scale_landuse, only: &
       landuse_fact_land
    use scale_time, only: &
       nowdaysec => time_nowdaysec
    use scale_file_history, only: &
       file_history_in
    use mod_land_admin, only: &
       land_dyn_type
    implicit none

    real(RP) :: RUNOFF(lia,lja)

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

    call prof_rapstart('LND_Update', 2)

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

    !########## Dynamics / Update variables ##########
    select case ( land_dyn_type )
    case ( 'BUCKET' )
       call land_dyn_bucket( lkmax, lks, lke, lia, lis, lie, lja, ljs, lje, &
                             land_temp_t(:,:,:), land_water_t(:,:,:),   & ! [IN]
                             land_property(:,:,i_waterlimit),           & ! [IN]
                             land_property(:,:,i_thermalcond),          & ! [IN]
                             land_property(:,:,i_heatcapacity),         & ! [IN]
                             land_property(:,:,i_waterdiff),            & ! [IN]
                             land_sflx_gh(:,:),                         & ! [IN]
                             land_sflx_water(:,:), land_sflx_ice(:,:),  & ! [IN]
                             landuse_fact_land(:,:), lcdz(:),           & ! [IN]
                             dt, nowdaysec,                             & ! [IN]
                             land_temp(:,:,:), land_water(:,:,:),       & ! [INOUT]
                             runoff(:,:)                                ) ! [OUT]
       call file_history_in( runoff(:,:), 'RUNOFF', 'runoff water', 'kg', dim_type='XY' )
    case ( 'INIT' )
       ! Never update LAND_TEMP and LAND_WATER from initial condition
    end select

    !########## Negative Fixer ##########
    !$omp parallel do
    do j = ljs, lje
    do i = lis, lie
    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

    !########## History & Monitor ##########
    call land_vars_history


    call prof_rapend  ('LND_Update', 1)

    return
  end subroutine land_driver_update

  !-----------------------------------------------------------------------------
  subroutine land_surface_get
    use mod_land_admin, only: &
       land_do
    use mod_land_vars, only: &
       atmos_temp,        &
       atmos_pres,        &
       atmos_w,           &
       atmos_u,           &
       atmos_v,           &
       atmos_dens,        &
       atmos_qv,          &
       atmos_pbl,         &
       atmos_sfc_dens,    &
       atmos_sfc_pres,    &
       atmos_sflx_rad_dn, &
       atmos_cossza,      &
       atmos_sflx_rain,   &
       atmos_sflx_snow
    use mod_cpl_vars, only: &
       cpl_getatm_lnd
    implicit none
    !---------------------------------------------------------------------------

    call prof_rapstart('LND_SfcExch', 2)

    if ( land_do ) 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_dens(:,:),     & ! [OUT]
                            atmos_sfc_pres(:,:),     & ! [OUT]
                            atmos_sflx_rad_dn(:,:,:,:), & ! [OUT]
                            atmos_cossza(:,:),     & ! [OUT]
                            atmos_sflx_rain(:,:),     & ! [OUT]
                            atmos_sflx_snow(:,:)      ) ! [OUT]
    endif

    call prof_rapend  ('LND_SfcExch', 2)

    return
  end subroutine land_surface_get

  !-----------------------------------------------------------------------------
  subroutine land_surface_set( countup )
    use mod_land_admin, only: &
       land_do
    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_qtrc,  &
       land_u10,        &
       land_v10,        &
       land_t2,         &
       land_q2
    use mod_cpl_vars, only: &
       cpl_putlnd
    implicit none

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

    call prof_rapstart('LND_SfcExch', 2)

    if ( land_do ) 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_qtrc(:,:,:),     & ! [IN]
                        land_u10(:,:),       & ! [IN]
                        land_v10(:,:),       & ! [IN]
                        land_t2(:,:),       & ! [IN]
                        land_q2(:,:),       & ! [IN]
                        countup                     ) ! [IN]
    endif

    call prof_rapend  ('LND_SfcExch', 2)

    return
  end subroutine land_surface_set

end module mod_land_driver