mod_land_vars.f90

Go to the documentation of this file.

!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
module mod_land_vars
  !-----------------------------------------------------------------------------
  !
  !++ 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_vars_setup
  public :: land_vars_restart_read
  public :: land_vars_restart_write
  public :: land_vars_history
  public :: land_vars_total
  public :: land_vars_external_in

  public :: land_vars_restart_create
  public :: land_vars_restart_open
  public :: land_vars_restart_def_var
  public :: land_vars_restart_enddef
  public :: land_vars_restart_close

  public :: convert_ws2vwc

  !-----------------------------------------------------------------------------
  !
  !++ Public parameters & variables
  !
  logical,               public :: land_restart_output                = .false.         

  character(len=H_LONG),  public :: land_restart_in_basename           = ''
  logical,                public :: land_restart_in_postfix_timelabel  = .false.         
  character(len=H_LONG),  public :: land_restart_out_basename          = ''
  logical,                public :: land_restart_out_postfix_timelabel = .true.          
  character(len=H_MID),   public :: land_restart_out_title             = 'LAND restart'
  character(len=H_SHORT), public :: land_restart_out_dtype             = 'DEFAULT'

  ! prognostic variables
  real(RP), public, allocatable :: land_temp      (:,:,:)
  real(RP), public, allocatable :: land_water     (:,:,:)
  real(RP), public, allocatable :: land_sfc_temp  (:,:)
  real(RP), public, allocatable :: land_sfc_albedo(:,:,:)

  ! tendency variables
  real(RP), public, allocatable :: land_temp_t      (:,:,:)
  real(RP), public, allocatable :: land_water_t     (:,:,:)
  real(RP), public, allocatable :: land_sfc_temp_t  (:,:)
  real(RP), public, allocatable :: land_sfc_albedo_t(:,:,:)

  ! surface variables for restart
  real(RP), public, allocatable :: land_sflx_mw  (:,:)
  real(RP), public, allocatable :: land_sflx_mu  (:,:)
  real(RP), public, allocatable :: land_sflx_mv  (:,:)
  real(RP), public, allocatable :: land_sflx_sh  (:,:)
  real(RP), public, allocatable :: land_sflx_lh  (:,:)
  real(RP), public, allocatable :: land_sflx_gh  (:,:)
  real(RP), public, allocatable :: land_sflx_evap(:,:)

  ! diagnostic variables
  real(RP), public, allocatable :: land_u10(:,:)
  real(RP), public, allocatable :: land_v10(:,:)
  real(RP), public, allocatable :: land_t2 (:,:)
  real(RP), public, allocatable :: land_q2 (:,:)

  ! recieved atmospheric variables
  real(RP), public, allocatable :: atmos_temp     (:,:)
  real(RP), public, allocatable :: atmos_pres     (:,:)
  real(RP), public, allocatable :: atmos_w        (:,:)
  real(RP), public, allocatable :: atmos_u        (:,:)
  real(RP), public, allocatable :: atmos_v        (:,:)
  real(RP), public, allocatable :: atmos_dens     (:,:)
  real(RP), public, allocatable :: atmos_qv       (:,:)
  real(RP), public, allocatable :: atmos_pbl      (:,:)
  real(RP), public, allocatable :: atmos_sfc_pres (:,:)
  real(RP), public, allocatable :: atmos_sflx_lw  (:,:)
  real(RP), public, allocatable :: atmos_sflx_sw  (:,:)
  real(RP), public, allocatable :: atmos_cossza   (:,:)
  real(RP), public, allocatable :: atmos_sflx_prec(:,:)

  real(RP), public, allocatable :: land_property  (:,:,:)

  character(len=H_LONG), public :: land_property_in_filename  = ''

  integer,  public, parameter   :: land_property_nmax = 8
  integer,  public, parameter   :: i_waterlimit       = 1 ! maximum  soil moisture           [m3/m3]
  integer,  public, parameter   :: i_watercritical    = 2 ! critical soil moisture           [m3/m3]
  integer,  public, parameter   :: i_thermalcond      = 3 ! thermal conductivity for soil    [W/K/m]
  integer,  public, parameter   :: i_heatcapacity     = 4 ! heat capacity for soil           [J/K/m3]
  integer,  public, parameter   :: i_waterdiff        = 5 ! moisture diffusivity in the soil [m2/s]
  integer,  public, parameter   :: i_z0m              = 6 ! roughness length for momemtum    [m]
  integer,  public, parameter   :: i_z0h              = 7 ! roughness length for heat        [m]
  integer,  public, parameter   :: i_z0e              = 8 ! roughness length for vapor       [m]

  !-----------------------------------------------------------------------------
  !
  !++ Private procedure
  !
  private :: land_param_read

  !-----------------------------------------------------------------------------
  !
  !++ Private parameters & variables
  !
  logical,                private :: land_vars_checkrange      = .false.

  integer,                private, parameter :: vmax        = 13
  integer,                private, parameter :: i_temp      =  1
  integer,                private, parameter :: i_water     =  2
  integer,                private, parameter :: i_waterds   =  3
  integer,                private, parameter :: i_sfc_temp  =  4
  integer,                private, parameter :: i_alb_lw    =  5
  integer,                private, parameter :: i_alb_sw    =  6
  integer,                private, parameter :: i_sflx_mw   =  7
  integer,                private, parameter :: i_sflx_mu   =  8
  integer,                private, parameter :: i_sflx_mv   =  9
  integer,                private, parameter :: i_sflx_sh   = 10
  integer,                private, parameter :: i_sflx_lh   = 11
  integer,                private, parameter :: i_sflx_gh   = 12
  integer,                private, parameter :: i_sflx_evap = 13

  character(len=H_SHORT), private            :: var_name(vmax)
  character(len=H_MID),   private            :: var_desc(vmax)
  character(len=H_SHORT), private            :: var_unit(vmax)
  integer,                private            :: var_id(vmax)
  integer,                private            :: restart_fid = -1  ! file ID

  data var_name / 'LAND_TEMP',      &
                  'LAND_WATER',     &
                  'LAND_DSAT',      &
                  'LAND_SFC_TEMP',  &
                  'LAND_ALB_LW',    &
                  'LAND_ALB_SW',    &
                  'LAND_SFLX_MW',   &
                  'LAND_SFLX_MU',   &
                  'LAND_SFLX_MV',   &
                  'LAND_SFLX_SH',   &
                  'LAND_SFLX_LH',   &
                  'LAND_SFLX_GH',   &
                  'LAND_SFLX_evap'  /
  data var_desc / 'temperature at each soil layer',  &
                  'moisture at each soil layer',     &
                  'degree of saturation at each soil layer', &
                  'land surface skin temperature',   &
                  'land surface albedo (longwave)',  &
                  'land surface albedo (shortwave)', &
                  'land surface w-momentum flux',    &
                  'land surface u-momentum flux',    &
                  'land surface v-momentum flux',    &
                  'land surface sensible heat flux', &
                  'land surface latent heat flux',   &
                  'land surface ground heat flux',   &
                  'land surface water vapor flux'    /
  data var_unit / 'K',       &
                  'm3/m3',   &
                  '1',       &
                  'K',       &
                  '1',       &
                  '1',       &
                  'kg/m2/s', &
                  'kg/m2/s', &
                  'kg/m2/s', &
                  'J/m2/s',  &
                  'J/m2/s',  &
                  'J/m2/s',  &
                  'kg/m2/s'  /

  real(RP), private, allocatable :: land_property_table(:,:)

  integer,  private              :: land_qa_comm
  real(RP), private, allocatable :: work_comm(:,:,:) ! for communication

  logical,  private              :: land_restart_in_check_coordinates = .true.

  !-----------------------------------------------------------------------------
contains
  !-----------------------------------------------------------------------------
  subroutine land_vars_setup
    use scale_process, only: &
       prc_mpistop
    use scale_const, only: &
       undef => const_undef
    use scale_comm, only: &
       comm_vars8, &
       comm_wait
    use scale_landuse, only: &
       landuse_index_pft, &
       landuse_pft_nmax
    implicit none

    namelist / param_land_vars /  &
       land_restart_in_basename,           &
       land_restart_in_postfix_timelabel,  &
       land_restart_in_check_coordinates,  &
       land_restart_output,                &
       land_restart_out_basename,          &
       land_restart_out_postfix_timelabel, &
       land_restart_out_title,             &
       land_restart_out_dtype,             &
       land_vars_checkrange

    integer :: ierr
    integer :: i, j, iv, p
    !---------------------------------------------------------------------------

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

    allocate( land_temp(lkmax,ia,ja) )
    allocate( land_water(lkmax,ia,ja) )
    allocate( land_sfc_temp(ia,ja)       )
    allocate( land_sfc_albedo(ia,ja,2)     )
    land_temp(:,:,:) = undef
    land_water(:,:,:) = undef
    land_sfc_temp(:,:)   = undef
    land_sfc_albedo(:,:,:) = undef

    allocate( land_temp_t(lkmax,ia,ja) )
    allocate( land_water_t(lkmax,ia,ja) )
    allocate( land_sfc_temp_t(ia,ja)       )
    allocate( land_sfc_albedo_t(ia,ja,2)     )
    land_temp_t(:,:,:) = undef
    land_water_t(:,:,:) = undef
    land_sfc_temp_t(:,:)   = undef
    land_sfc_albedo_t(:,:,:) = undef

    allocate( land_sflx_mw(ia,ja) )
    allocate( land_sflx_mu(ia,ja) )
    allocate( land_sflx_mv(ia,ja) )
    allocate( land_sflx_sh(ia,ja) )
    allocate( land_sflx_lh(ia,ja) )
    allocate( land_sflx_gh(ia,ja) )
    allocate( land_sflx_evap(ia,ja) )
    land_sflx_mw(:,:) = undef
    land_sflx_mu(:,:) = undef
    land_sflx_mv(:,:) = undef
    land_sflx_sh(:,:) = undef
    land_sflx_lh(:,:) = undef
    land_sflx_gh(:,:) = undef
    land_sflx_evap(:,:) = undef

    allocate( land_u10(ia,ja) )
    allocate( land_v10(ia,ja) )
    allocate( land_t2(ia,ja) )
    allocate( land_q2(ia,ja) )
    land_u10(:,:) = undef
    land_v10(:,:) = undef
    land_t2(:,:) = undef
    land_q2(:,:) = undef

    allocate( atmos_temp(ia,ja) )
    allocate( atmos_pres(ia,ja) )
    allocate( atmos_w(ia,ja) )
    allocate( atmos_u(ia,ja) )
    allocate( atmos_v(ia,ja) )
    allocate( atmos_dens(ia,ja) )
    allocate( atmos_qv(ia,ja) )
    allocate( atmos_pbl(ia,ja) )
    allocate( atmos_sfc_pres(ia,ja) )
    allocate( atmos_sflx_lw(ia,ja) )
    allocate( atmos_sflx_sw(ia,ja) )
    allocate( atmos_cossza(ia,ja) )
    allocate( atmos_sflx_prec(ia,ja) )
    atmos_temp(:,:) = undef
    atmos_pres(:,:) = undef
    atmos_w(:,:) = undef
    atmos_u(:,:) = undef
    atmos_v(:,:) = undef
    atmos_dens(:,:) = undef
    atmos_qv(:,:) = undef
    atmos_pbl(:,:) = undef
    atmos_sfc_pres(:,:) = undef
    atmos_sflx_lw(:,:) = undef
    atmos_sflx_sw(:,:) = undef
    atmos_cossza(:,:) = undef
    atmos_sflx_prec(:,:) = undef

    land_qa_comm = lkmax &
                 + lkmax &
                 + 1     &
                 + 2

    allocate( work_comm(ia,ja,land_qa_comm) )

    !--- read namelist
    rewind(io_fid_conf)
    read(io_fid_conf,nml=param_land_vars,iostat=ierr)
    if( ierr < 0 ) then !--- missing
       if( io_l ) write(io_fid_log,*) '*** Not found namelist. Default used.'
    elseif( ierr > 0 ) then !--- fatal error
       write(*,*) 'xxx Not appropriate names in namelist PARAM_LAND_VARS. Check!'
       call prc_mpistop
    endif
    if( io_nml ) write(io_fid_nml,nml=param_land_vars)

    if( io_l ) write(io_fid_log,*)
    if( io_l ) write(io_fid_log,*) '*** List of prognostic variables (LAND) ***'
    if( io_l ) write(io_fid_log,'(1x,A,A24,A,A48,A,A12,A)') &
               '***       |', 'VARNAME                 ','|', &
               'DESCRIPTION                                     ', '[', 'UNIT        ', ']'
    do iv = 1, vmax
       if( io_l ) write(io_fid_log,'(1x,A,I3,A,A24,A,A48,A,A12,A)') &
                  '*** NO.',iv,'|',var_name(iv),'|',var_desc(iv),'[',var_unit(iv),']'
    enddo

    if( io_l ) write(io_fid_log,*)
    if ( land_restart_in_basename /= '' ) then
       if( io_l ) write(io_fid_log,*) '*** Restart input?  : YES, file = ', trim(land_restart_in_basename)
       if( io_l ) write(io_fid_log,*) '*** Add timelabel?  : ', land_restart_in_postfix_timelabel
    else
       if( io_l ) write(io_fid_log,*) '*** Restart input?  : NO'
    endif
    if (       land_restart_output             &
         .AND. land_restart_out_basename /= '' ) then
       if( io_l ) write(io_fid_log,*) '*** Restart output? : YES, file = ', trim(land_restart_out_basename)
       if( io_l ) write(io_fid_log,*) '*** Add timelabel?  : ', land_restart_out_postfix_timelabel
    else
       if( io_l ) write(io_fid_log,*) '*** Restart output? : NO'
       land_restart_output = .false.
    endif

    ! Read land property table
    allocate( land_property_table(landuse_pft_nmax,land_property_nmax) )
    land_property_table(:,:) = undef

    call land_param_read

    ! Apply land property to 2D map
    allocate( land_property(ia,ja,land_property_nmax) )

    ! tentative, mosaic is off
    do p = 1, land_property_nmax
    do j = js, je
    do i = is, ie
       land_property(i,j,p) = land_property_table( landuse_index_pft(i,j,1), p )
    enddo
    enddo
    enddo

    do p = 1, land_property_nmax
       call comm_vars8( land_property(:,:,p), p )
    enddo
    do p = 1, land_property_nmax
       call comm_wait ( land_property(:,:,p), p )
    enddo

    return
  end subroutine land_vars_setup

  !-----------------------------------------------------------------------------
  subroutine land_vars_restart_open
    use scale_time, only: &
       time_gettimelabel
    use scale_fileio, only: &
       fileio_open, &
       fileio_check_coordinates
    use mod_land_admin, only: &
       land_sw
    implicit none

    character(len=19)     :: timelabel
    character(len=H_LONG) :: basename
    !---------------------------------------------------------------------------

    if( io_l ) write(io_fid_log,*)
    if( io_l ) write(io_fid_log,*) '*** Open restart file (LAND) ***'

    if ( land_sw .and. land_restart_in_basename /= '' ) then

       if ( land_restart_in_postfix_timelabel ) then
          call time_gettimelabel( timelabel )
          basename = trim(land_restart_in_basename)//'_'//trim(timelabel)
       else
          basename = trim(land_restart_in_basename)
       endif

       if( io_l ) write(io_fid_log,*) '*** basename: ', trim(basename)

       call fileio_open( restart_fid, & ! [OUT]
                         basename     ) ! [IN]

       if ( land_restart_in_check_coordinates ) then
          call fileio_check_coordinates( restart_fid, land=.true. )
       end if

    else
       if( io_l ) write(io_fid_log,*) '*** restart file for land is not specified.'
    endif

    return
  end subroutine land_vars_restart_open

  !-----------------------------------------------------------------------------
  subroutine land_vars_restart_read
    use scale_fileio, only: &
       fileio_read, &
       fileio_flush
    implicit none
    !---------------------------------------------------------------------------

    if ( restart_fid /= -1 ) then
       if( io_l ) write(io_fid_log,*)
       if( io_l ) write(io_fid_log,*) '*** Read from restart file (LAND) ***'

       call fileio_read( land_temp(:,:,:),                                 & ! [OUT]
                         restart_fid, var_name(i_temp),      'Land', step=1 ) ! [IN]
       call fileio_read( land_water(:,:,:),                                 & ! [OUT]
                         restart_fid, var_name(i_water),     'Land', step=1 ) ! [IN]
       call fileio_read( land_sfc_temp(:,:),                                & ! [OUT]
                         restart_fid, var_name(i_sfc_temp),  'XY',   step=1 ) ! [IN]
       call fileio_read( land_sfc_albedo(:,:,i_lw),                         & ! [OUT]
                         restart_fid, var_name(i_alb_lw),    'XY',   step=1 ) ! [IN]
       call fileio_read( land_sfc_albedo(:,:,i_sw),                         & ! [OUT]
                         restart_fid, var_name(i_alb_sw),    'XY',   step=1 ) ! [IN]
       call fileio_read( land_sflx_mw(:,:),                                 & ! [OUT]
                         restart_fid, var_name(i_sflx_mw),   'XY',   step=1 ) ! [IN]
       call fileio_read( land_sflx_mu(:,:),                                 & ! [OUT]
                         restart_fid, var_name(i_sflx_mu),   'XY',   step=1 ) ! [IN]
       call fileio_read( land_sflx_mv(:,:),                                 & ! [OUT]
                         restart_fid, var_name(i_sflx_mv),   'XY',   step=1 ) ! [IN]
       call fileio_read( land_sflx_sh(:,:),                                 & ! [OUT]
                         restart_fid, var_name(i_sflx_sh),   'XY',   step=1 ) ! [IN]
       call fileio_read( land_sflx_lh(:,:),                                 & ! [OUT]
                         restart_fid, var_name(i_sflx_lh),   'XY',   step=1 ) ! [IN]
       call fileio_read( land_sflx_gh(:,:),                                 & ! [OUT]
                         restart_fid, var_name(i_sflx_gh),   'XY',   step=1 ) ! [IN]
       call fileio_read( land_sflx_evap(:,:),                               & ! [OUT]
                         restart_fid, var_name(i_sflx_evap), 'XY',   step=1 ) ! [IN]

       if( io_aggregate ) call fileio_flush( restart_fid ) ! commit all pending read requests

       call land_vars_total
    else
       if( io_l ) write(io_fid_log,*) '*** invalid restart file ID for land.'
    endif

    return
  end subroutine land_vars_restart_read

  !-----------------------------------------------------------------------------
  subroutine land_vars_history
    use scale_history, only: &
       hist_in
    implicit none

    real(RP) :: land_waterds(lkmax,ia,ja)
    integer :: k, i, j
    !---------------------------------------------------------------------------

    if ( land_vars_checkrange ) then
       call valcheck( land_temp(:,is:ie,js:je),    0.0_rp, 1000.0_rp, var_name(i_temp),       &
                     __file__, __line__ )
       call valcheck( land_water(:,is:ie,js:je),    0.0_rp, 1000.0_rp, var_name(i_water),      &
                     __file__, __line__ )
       call valcheck( land_sfc_temp(is:ie,js:je),      0.0_rp, 1000.0_rp, var_name(i_sfc_temp),   &
                     __file__, __line__ )
       call valcheck( land_sfc_albedo(is:ie,js:je,i_lw), 0.0_rp,    2.0_rp, var_name(i_alb_lw),     &
                     __file__, __line__ )
       call valcheck( land_sfc_albedo(is:ie,js:je,i_sw), 0.0_rp,    2.0_rp, var_name(i_alb_sw),     &
                     __file__, __line__ )
    endif

    call hist_in( land_temp(:,:,:), var_name(i_temp),  var_desc(i_temp),  var_unit(i_temp),  zdim='land' )
    call hist_in( land_water(:,:,:), var_name(i_water), var_desc(i_water), var_unit(i_water), zdim='land' )
    do j = js, je
    do i = is, ie
    do k = 1, lkmax
       land_waterds(k,i,j) = land_water(k,i,j) / land_property(i,j,i_waterlimit)
    end do
    end do
    end do
    call hist_in( land_waterds(:,:,:), var_name(i_waterds), var_desc(i_waterds), var_unit(i_waterds), zdim='land', nohalo=.true. )


    call hist_in( land_sfc_temp(:,:),      var_name(i_sfc_temp),   var_desc(i_sfc_temp),   var_unit(i_sfc_temp) )
    call hist_in( land_sfc_albedo(:,:,i_lw), var_name(i_alb_lw),     var_desc(i_alb_lw),     var_unit(i_alb_lw)   )
    call hist_in( land_sfc_albedo(:,:,i_sw), var_name(i_alb_sw),     var_desc(i_alb_sw),     var_unit(i_alb_sw)   )

    call hist_in( land_sflx_mw(:,:), var_name(i_sflx_mw),   var_desc(i_sflx_mw),   var_unit(i_sflx_mw)   )
    call hist_in( land_sflx_mu(:,:), var_name(i_sflx_mu),   var_desc(i_sflx_mu),   var_unit(i_sflx_mu)   )
    call hist_in( land_sflx_mv(:,:), var_name(i_sflx_mv),   var_desc(i_sflx_mv),   var_unit(i_sflx_mv)   )
    call hist_in( land_sflx_sh(:,:), var_name(i_sflx_sh),   var_desc(i_sflx_sh),   var_unit(i_sflx_sh)   )
    call hist_in( land_sflx_lh(:,:), var_name(i_sflx_lh),   var_desc(i_sflx_lh),   var_unit(i_sflx_lh)   )
    call hist_in( land_sflx_gh(:,:), var_name(i_sflx_gh),   var_desc(i_sflx_gh),   var_unit(i_sflx_gh)   )
    call hist_in( land_sflx_evap(:,:), var_name(i_sflx_evap), var_desc(i_sflx_evap), var_unit(i_sflx_evap) )

    return
  end subroutine land_vars_history

  !-----------------------------------------------------------------------------
  subroutine land_vars_total
    use scale_rm_statistics, only: &
       statistics_checktotal, &
       stat_total
    implicit none

    real(RP) :: total

    character(len=2) :: sk
    integer          :: k
    !---------------------------------------------------------------------------

    if ( statistics_checktotal ) then

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

          call stat_total( total, land_temp(k,:,:), trim(var_name(i_temp) )//sk )
          call stat_total( total, land_water(k,:,:), trim(var_name(i_water))//sk )
       enddo

       call stat_total( total, land_sfc_temp(:,:),      var_name(i_sfc_temp) )
       call stat_total( total, land_sfc_albedo(:,:,i_lw), var_name(i_alb_lw)   )
       call stat_total( total, land_sfc_albedo(:,:,i_sw), var_name(i_alb_sw)   )

    endif

    return
  end subroutine land_vars_total

  !-----------------------------------------------------------------------------
  subroutine land_vars_external_in( &
      LAND_TEMP_in,      &
      LAND_WATER_in,     &
      LAND_SFC_TEMP_in,  &
      LAND_SFC_albedo_in )
    implicit none

    real(RP), intent(in) :: land_temp_in (:,:,:)
    real(RP), intent(in) :: land_water_in(:,:,:)
    real(RP), intent(in) :: land_sfc_temp_in  (ia,ja)
    real(RP), intent(in) :: land_sfc_albedo_in(ia,ja,2)
    !---------------------------------------------------------------------------

    if( io_l ) write(io_fid_log,*)
    if( io_l ) write(io_fid_log,*) '*** External Input (land) ***'

    land_temp(:,:,:) = land_temp_in(:,:,:)
    land_water(:,:,:) = land_water_in(:,:,:)
    land_sfc_temp(:,:)   = land_sfc_temp_in(:,:)
    land_sfc_albedo(:,:,:) = land_sfc_albedo_in(:,:,:)

    land_sflx_mw(:,:) = 0.0_rp
    land_sflx_mu(:,:) = 0.0_rp
    land_sflx_mv(:,:) = 0.0_rp
    land_sflx_sh(:,:) = 0.0_rp
    land_sflx_lh(:,:) = 0.0_rp
    land_sflx_gh(:,:) = 0.0_rp
    land_sflx_evap(:,:) = 0.0_rp

    call land_vars_total

    return
  end subroutine land_vars_external_in

  !-----------------------------------------------------------------------------
  subroutine land_param_read
    use scale_process, only: &
       prc_mpistop
    use scale_landuse, only: &
       landuse_pft_nmax
    implicit none

    integer              :: index
    character(len=H_MID) :: description
    real(RP)             :: strgmax
    real(RP)             :: strgcrt
    real(RP)             :: tcs
    real(RP)             :: hcs
    real(RP)             :: dfw
    real(RP)             :: z0m
    real(RP)             :: z0h
    real(RP)             :: z0e

    namelist / param_land_property /  &
       land_property_in_filename

    namelist / param_land_data / &
       index,       &
       description, &
       strgmax,     &
       strgcrt,     &
       tcs,         &
       hcs,         &
       dfw,         &
       z0m,         &
       z0h,         &
       z0e

    integer :: n
    integer :: ierr

    integer :: io_fid_land_property
    !---------------------------------------------------------------------------

    !--- read namelist
    rewind(io_fid_conf)
    read(io_fid_conf,nml=param_land_property,iostat=ierr)
    if( ierr < 0 ) then !--- missing
       if( io_l ) write(io_fid_log,*) '*** Not found namelist. Default used.'
    elseif( ierr > 0 ) then !--- fatal error
       write(*,*) 'xxx Not appropriate names in namelist PARAM_LAND_PROPERTY. Check!'
       call prc_mpistop
    endif
    if( io_nml ) write(io_fid_nml,nml=param_land_property)

    if( land_property_in_filename /= '' ) then
      !--- Open land parameter file
      io_fid_land_property = io_get_available_fid()
      open( io_fid_land_property,                     &
            file   = trim(land_property_in_filename), &
            form   = 'formatted',                     &
            status = 'old',                           &
            iostat = ierr                             )

      if ( ierr /= 0 ) then
         write(*,*) 'xxx [LAND_param_read] Failed to open land parameter file! :', &
                    trim(land_property_in_filename)
         call prc_mpistop
      else
        if( io_l ) write(io_fid_log,*)
        if( io_l ) write(io_fid_log,*) '*** Properties for each plant functional type (PFT)'
        if( io_l ) write(io_fid_log,'(12(1x,A))') '***          ', &
                                                  '                     description', &
                                                  'Max Stg.', &
                                                  'CRT Stg.', &
                                                  'T condu.', &
                                                  'H capac.', &
                                                  'DFC Wat.', &
                                                  '   Z0(m)', &
                                                  '   Z0(h)', &
                                                  '   Z0(e)'

        !--- read namelist
        rewind(io_fid_land_property)

        do n = 1, landuse_pft_nmax
           ! undefined roughness length
           z0h = -1.0_rp
           z0e = -1.0_rp

           read(io_fid_land_property,nml=param_land_data,iostat=ierr)
           if ( ierr < 0 ) then !--- no more data
              exit
           elseif( ierr > 0 ) then !--- fatal error
              write(*,*) 'xxx Not appropriate names in namelist PARAM_LAND_DATA. Check!'
              call prc_mpistop
           endif

           if( z0h < 0.0_rp ) then
             z0h = z0m / 7.4_rp ! defined by Garratt and Francey (1978)
           endif
           if( z0e < 0.0_rp ) then
             z0e = z0m / 7.4_rp ! defined by Garratt and Francey (1978)
           endif

           land_property_table(index,i_waterlimit   ) = strgmax
           land_property_table(index,i_watercritical) = strgcrt
           land_property_table(index,i_thermalcond  ) = tcs
           land_property_table(index,i_heatcapacity ) = hcs
           land_property_table(index,i_waterdiff    ) = dfw
           land_property_table(index,i_z0m          ) = z0m
           land_property_table(index,i_z0h          ) = z0h
           land_property_table(index,i_z0e          ) = z0e

           if( io_l ) write(io_fid_log,'(1x,A10,I3.3,1x,A32,3(1x,F8.2),(1x,ES8.1),4(1x,F8.2))') &
                                         '*** IDX = ', index, &
                                         trim(description), &
                                         strgmax, &
                                         strgcrt, &
                                         tcs,     &
                                         hcs,     &
                                         dfw,     &
                                         z0m,     &
                                         z0h,     &
                                         z0e
        enddo

      end if

      close( io_fid_land_property )

    endif

    return
  end subroutine land_param_read

  !-----------------------------------------------------------------------------
  function convert_ws2vwc( WS, critical ) result( VWC )
    implicit none

    real(RP), intent(in) :: ws(ia,ja) ! water saturation [fraction]
    logical,  intent(in) :: critical  ! is I_WaterCritical used?

    real(RP) :: vwc(ia,ja) ! volumetric water content [m3/m3]

    ! work
    integer :: i, j, num
    !---------------------------------------------------------------------------

    if( critical ) then
      num = i_watercritical
    else
      num = i_waterlimit
    end if

    do j = js, je
    do i = is, ie
      vwc(i,j) = max( min( ws(i,j)*land_property(i,j,num), land_property(i,j,num) ), 0.0_rp )
    end do
    end do

    return
  end function convert_ws2vwc

  !-----------------------------------------------------------------------------
  subroutine land_vars_restart_create
    use scale_time, only: &
       time_gettimelabel
    use scale_fileio, only: &
       fileio_create
    use mod_land_admin, only: &
       land_sw
    implicit none

    character(len=19)     :: timelabel
    character(len=H_LONG) :: basename
    !---------------------------------------------------------------------------

    if ( land_sw .and. land_restart_out_basename /= '' ) then

       if( io_l ) write(io_fid_log,*)
       if( io_l ) write(io_fid_log,*) '*** Create restart file (LAND) ***'

       if ( land_restart_out_postfix_timelabel ) then
          call time_gettimelabel( timelabel )
          basename = trim(land_restart_out_basename)//'_'//trim(timelabel)
       else
          basename = trim(land_restart_out_basename)
       endif

       if( io_l ) write(io_fid_log,*) '*** basename: ', trim(basename)

       call fileio_create( restart_fid,                                             & ! [OUT]
                           basename, land_restart_out_title, land_restart_out_dtype ) ! [IN]

    endif

    return
  end subroutine land_vars_restart_create

  !-----------------------------------------------------------------------------
  subroutine land_vars_restart_enddef
    use scale_fileio, only: &
       fileio_enddef
    implicit none

    if ( restart_fid /= -1 ) then
       call fileio_enddef( restart_fid ) ! [IN]
    endif

    return
  end subroutine land_vars_restart_enddef

  !-----------------------------------------------------------------------------
  subroutine land_vars_restart_close
    use scale_fileio, only: &
       fileio_close
    implicit none
    !---------------------------------------------------------------------------

    if ( restart_fid /= -1 ) then
       if( io_l ) write(io_fid_log,*)
       if( io_l ) write(io_fid_log,*) '*** Close restart file (LAND) ***'

       call fileio_close( restart_fid ) ! [IN]

       restart_fid = -1
    endif

    return
  end subroutine land_vars_restart_close

  !-----------------------------------------------------------------------------
  subroutine land_vars_restart_def_var
    use scale_fileio, only: &
       fileio_def_var
    implicit none
    !---------------------------------------------------------------------------

    if ( restart_fid /= -1 ) then

       call fileio_def_var( restart_fid, var_id(i_temp),      var_name(i_temp),      var_desc(i_temp),      &
                            var_unit(i_temp),      'Land', land_restart_out_dtype)
       call fileio_def_var( restart_fid, var_id(i_water),     var_name(i_water),     var_desc(i_water),     &
                            var_unit(i_water),     'Land', land_restart_out_dtype)
       call fileio_def_var( restart_fid, var_id(i_sfc_temp),  var_name(i_sfc_temp),  var_desc(i_sfc_temp),  &
                            var_unit(i_sfc_temp),  'XY',   land_restart_out_dtype)
       call fileio_def_var( restart_fid, var_id(i_alb_lw),    var_name(i_alb_lw),    var_desc(i_alb_lw),    &
                            var_unit(i_alb_lw),    'XY',   land_restart_out_dtype)
       call fileio_def_var( restart_fid, var_id(i_alb_sw),    var_name(i_alb_sw),    var_desc(i_alb_sw),    &
                            var_unit(i_alb_sw),    'XY',   land_restart_out_dtype)
       call fileio_def_var( restart_fid, var_id(i_sflx_mw),   var_name(i_sflx_mw),   var_desc(i_sflx_mw),   &
                            var_unit(i_sflx_mw),   'XY',   land_restart_out_dtype)
       call fileio_def_var( restart_fid, var_id(i_sflx_mu),   var_name(i_sflx_mu),   var_desc(i_sflx_mu),   &
                            var_unit(i_sflx_mu),   'XY',   land_restart_out_dtype)
       call fileio_def_var( restart_fid, var_id(i_sflx_mv),   var_name(i_sflx_mv),   var_desc(i_sflx_mv),   &
                            var_unit(i_sflx_mv),   'XY',   land_restart_out_dtype)
       call fileio_def_var( restart_fid, var_id(i_sflx_sh),   var_name(i_sflx_sh),   var_desc(i_sflx_sh),   &
                            var_unit(i_sflx_sh),   'XY',   land_restart_out_dtype)
       call fileio_def_var( restart_fid, var_id(i_sflx_lh),   var_name(i_sflx_lh),   var_desc(i_sflx_lh),   &
                            var_unit(i_sflx_lh),   'XY',   land_restart_out_dtype)
       call fileio_def_var( restart_fid, var_id(i_sflx_gh),   var_name(i_sflx_gh),   var_desc(i_sflx_gh),   &
                            var_unit(i_sflx_gh),   'XY',   land_restart_out_dtype)
       call fileio_def_var( restart_fid, var_id(i_sflx_evap), var_name(i_sflx_evap), var_desc(i_sflx_evap), &
                            var_unit(i_sflx_evap), 'XY',   land_restart_out_dtype)

    endif

    return
  end subroutine land_vars_restart_def_var

  !-----------------------------------------------------------------------------
  subroutine land_vars_restart_write
    use scale_fileio, only: &
       fileio_write_var
    implicit none
    !---------------------------------------------------------------------------

    if ( restart_fid /= -1 ) then

       call land_vars_total

       call fileio_write_var( restart_fid, var_id(i_temp),      land_temp(:,:,:),          & ! [IN]
                              var_name(i_temp),      'Land', nohalo=.true.                 ) ! [IN]
       call fileio_write_var( restart_fid, var_id(i_water),     land_water(:,:,:),         & ! [IN]
                              var_name(i_water),     'Land', nohalo=.true.                 ) ! [IN]
       call fileio_write_var( restart_fid, var_id(i_sfc_temp),  land_sfc_temp(:,:),        & ! [IN]
                              var_name(i_sfc_temp),  'XY',   nohalo=.true.                 ) ! [IN]
       call fileio_write_var( restart_fid, var_id(i_alb_lw),    land_sfc_albedo(:,:,i_lw), & ! [IN]
                              var_name(i_alb_lw),    'XY',   nohalo=.true.                 ) ! [IN]
       call fileio_write_var( restart_fid, var_id(i_alb_sw),    land_sfc_albedo(:,:,i_sw), & ! [IN]
                              var_name(i_alb_sw),    'XY',   nohalo=.true.                 ) ! [IN]
       call fileio_write_var( restart_fid, var_id(i_sflx_mw),   land_sflx_mw(:,:),         & ! [IN]
                              var_name(i_sflx_mw),   'XY',   nohalo=.true.                 ) ! [IN]
       call fileio_write_var( restart_fid, var_id(i_sflx_mu),   land_sflx_mu(:,:),         & ! [IN]
                              var_name(i_sflx_mu),   'XY',   nohalo=.true.                 ) ! [IN]
       call fileio_write_var( restart_fid, var_id(i_sflx_mv),   land_sflx_mv(:,:),         & ! [IN]
                              var_name(i_sflx_mv),   'XY',   nohalo=.true.                 ) ! [IN]
       call fileio_write_var( restart_fid, var_id(i_sflx_sh),   land_sflx_sh(:,:),         & ! [IN]
                              var_name(i_sflx_sh),   'XY',   nohalo=.true.                 ) ! [IN]
       call fileio_write_var( restart_fid, var_id(i_sflx_lh),   land_sflx_lh(:,:),         & ! [IN]
                              var_name(i_sflx_lh),   'XY',   nohalo=.true.                 ) ! [IN]
       call fileio_write_var( restart_fid, var_id(i_sflx_gh),   land_sflx_gh(:,:),         & ! [IN]
                              var_name(i_sflx_gh),   'XY',   nohalo=.true.                 ) ! [IN]
       call fileio_write_var( restart_fid, var_id(i_sflx_evap), land_sflx_evap(:,:),       & ! [IN]
                              var_name(i_sflx_evap), 'XY',   nohalo=.true.                 ) ! [IN]

    endif

    return
  end subroutine land_vars_restart_write

end module mod_land_vars