mod_land_phy_driver.f90

Go to the documentation of this file.

!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
module mod_land_phy_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_phy_driver_setup
  public :: land_phy_driver_resume
  public :: land_phy_driver

  !-----------------------------------------------------------------------------
  !
  !++ Public parameters & variables
  !
  !-----------------------------------------------------------------------------
  !
  !++ Private procedure
  !
  !-----------------------------------------------------------------------------
  !
  !++ Private parameters & variables
  !
  !-----------------------------------------------------------------------------
contains
  !-----------------------------------------------------------------------------
  subroutine land_phy_driver_setup
    use scale_land_phy, only: &
       land_phy_setup
    use scale_land_sfc, only: &
       land_sfc_setup
    use mod_land_admin, only: &
       land_type, &
       land_sw
    implicit none
    !---------------------------------------------------------------------------

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

    if ( land_sw ) then

       ! setup library component
       call land_phy_setup( land_type )
       call land_sfc_setup( land_type )

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

    return
  end subroutine land_phy_driver_setup

  !-----------------------------------------------------------------------------
  subroutine land_phy_driver_resume
    use mod_admin_restart, only: &
       restart_run
    use mod_land_admin, only: &
       land_sw
    implicit none

    if ( land_sw ) then

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

    return
  end subroutine land_phy_driver_resume
  !-----------------------------------------------------------------------------
  subroutine land_phy_driver( update_flag )
    use scale_atmos_thermodyn, only: &
       atmos_thermodyn_templhv
    use scale_time, only: &
       dt => time_dtsec_land
    use scale_rm_statistics, only: &
       statistics_checktotal, &
       stat_total
    use scale_history, only: &
       hist_in
    use scale_grid_real, only: &
       real_z1
    use scale_land_grid, only: &
       grid_lcdz
    use scale_land_phy, only: &
       land_phy
    use scale_land_sfc, only: &
       land_sfc
    use mod_land_vars, only: &
       land_property,     &
       i_waterlimit,      &
       i_watercritical,   &
       i_thermalcond,     &
       i_heatcapacity,    &
       i_waterdiff,       &
       i_z0m,             &
       i_z0h,             &
       i_z0e,             &
       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_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,           &
       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

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

    ! arguments
    logical, intent(in) :: update_flag

    ! works
    real(RP) :: LAND_QVEF(ia,ja)
    real(RP) :: LAND_DZ1 (ia,ja)

    real(RP) :: total ! dummy
    real(RP) :: lhv(ia,ja)

    character(len=2) :: sk

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

    if ( update_flag ) then

!OCL XFILL
       do j = js, je
       do i = is, ie
          land_qvef(i,j) = min( land_water(lks,i,j) / land_property(i,j,i_watercritical), beta_max )
          land_dz1(i,j) = grid_lcdz(lks)
       end do
       end do

       call land_sfc( land_sfc_temp_t(:,:),               & ! [OUT]
                      land_sflx_mw(:,:),               & ! [OUT]
                      land_sflx_mu(:,:),               & ! [OUT]
                      land_sflx_mv(:,:),               & ! [OUT]
                      land_sflx_sh(:,:),               & ! [OUT]
                      land_sflx_lh(:,:),               & ! [OUT]
                      land_sflx_gh(:,:),               & ! [OUT]
                      land_u10(:,:),               & ! [OUT]
                      land_v10(:,:),               & ! [OUT]
                      land_t2(:,:),               & ! [OUT]
                      land_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]
                      land_temp(lks,:,:),           & ! [IN]
                      land_sfc_temp(:,:),               & ! [IN]
                      land_qvef(:,:),               & ! [IN]
                      land_sfc_albedo(:,:,i_lw),          & ! [IN]
                      land_sfc_albedo(:,:,i_sw),          & ! [IN]
                      land_dz1(:,:),               & ! [IN]
                      land_property(:,:,i_thermalcond), & ! [IN]
                      land_property(:,:,i_z0m),         & ! [IN]
                      land_property(:,:,i_z0h),         & ! [IN]
                      land_property(:,:,i_z0e),         & ! [IN]
                      dt                                  ) ! [IN]

       call atmos_thermodyn_templhv( lhv, atmos_temp )

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

       call land_phy( land_temp_t(:,:,:),              & ! [OUT]
                      land_water_t(:,:,:),              & ! [OUT]
                      land_temp(:,:,:),              & ! [IN]
                      land_water(:,:,:),              & ! [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]
                      atmos_sflx_prec(:,:),                & ! [IN]
                      land_sflx_evap(:,:),                & ! [IN]
                      grid_lcdz(:),                  & ! [IN]
                      dt                                   ) ! [IN]

       ! no albedo update (tentative)
!OCL XFILL
       land_sfc_albedo_t(:,:,:) = 0.0_rp

       call hist_in( land_temp_t(:,:,:), 'LAND_TEMP_t',  'tendency of LAND_TEMP',  'K',     zdim='land' )
       call hist_in( land_water_t(:,:,:), 'LAND_WATER_t', 'tendency of LAND_WATER', 'm3/m3', zdim='land' )

       call hist_in( land_sfc_temp_t(:,:),      'LAND_SFC_TEMP_t', 'tendency of LAND_SFC_TEMP', 'K'   )
       call hist_in( land_sfc_albedo_t(:,:,i_lw), 'LAND_ALB_LW_t',   'tendency of LAND_ALB_LW',   '0-1' )
       call hist_in( land_sfc_albedo_t(:,:,i_sw), 'LAND_ALB_SW_t',   'tendency of LAND_ALB_SW',   '0-1' )

       call hist_in( land_property(:,:,i_waterlimit),    'LP_WaterLimit',    'LAND PROPERTY, WaterLimit',    'm3/m3'  )
       call hist_in( land_property(:,:,i_watercritical), 'LP_WaterCritical', 'LAND PROPERTY, WaterCritical', 'm3/m3'  )
       call hist_in( land_property(:,:,i_thermalcond),   'LP_ThermalCond',   'LAND PROPERTY, ThermalCond',   'W/K/m'  )
       call hist_in( land_property(:,:,i_heatcapacity),  'LP_HeatCapacity',  'LAND PROPERTY, HeatCapacity',  'J/K/m3' )
       call hist_in( land_property(:,:,i_waterdiff),     'LP_WaterDiff',     'LAND PROPERTY, WaterDiff',     'm2/s'   )
       call hist_in( land_property(:,:,i_z0m),           'LP_Z0M',           'LAND PROPERTY, Z0M',           'm'      )
       call hist_in( land_property(:,:,i_z0h),           'LP_Z0H',           'LAND PROPERTY, Z0H',           'm'      )
       call hist_in( land_property(:,:,i_z0e),           'LP_Z0E',           'LAND PROPERTY, Z0E',           'm'      )

    endif

    if ( statistics_checktotal ) then
       do k = lks, lke
          write(sk,'(I2.2)') k

          call stat_total( total, land_temp_t(k,:,:), 'LAND_TEMP_t'//sk  )
          call stat_total( total, land_water_t(k,:,:), 'LAND_WATER_t'//sk )
       enddo

       call stat_total( total, land_sfc_temp_t(:,:),      'LAND_SFC_TEMP_t'  )
       call stat_total( total, land_sfc_albedo_t(:,:,i_lw), 'LAND_ALB_LW_t'    )
       call stat_total( total, land_sfc_albedo_t(:,:,i_sw), 'LAND_ALB_SW_t'    )
    endif

    return
  end subroutine land_phy_driver

end module mod_land_phy_driver