!-------------------------------------------------------------------------------
!> module COUPLER Variables
!!
!! @par Description
!!          Container for coupler variables
!!
!! @author Team SCALE
!! @li      2013-08-31 (T.Yamaura)  [new]
!!
!<
!-------------------------------------------------------------------------------
module mod_cpl_vars
  !-----------------------------------------------------------------------------
  !
  !++ used modules
  !
  use scale_precision
  use scale_stdio
  use scale_prof
  use scale_debug
  use scale_grid_index
  !-----------------------------------------------------------------------------
  implicit none
  private
  !-----------------------------------------------------------------------------
  !
  !++ Public procedure
  !
  public :: CPL_vars_setup
  public :: CPL_vars_fillhalo
  public :: CPL_vars_restart_read
  public :: CPL_vars_restart_write
  public :: CPL_vars_history
  public :: CPL_vars_total
  public :: CPL_vars_merge
  public :: CPL_putAtm
  public :: CPL_putLnd
  public :: CPL_putOcn
  public :: CPL_getCPL2Atm
  public :: CPL_getCPL2Lnd
  public :: CPL_getCPL2Ocn

  !-----------------------------------------------------------------------------
  !
  !++ Public parameters & variables
  !
  character(len=H_SHORT), public, save :: CPL_TYPE_AtmLnd = 'OFF'   !< atmos-land coupler type
  character(len=H_SHORT), public, save :: CPL_TYPE_AtmOcn = 'OFF'   !< atmos-ocean coupler type
  logical,                public, save :: CPL_LST_UPDATE  = .false. !< is Land Surface Temperature updated?
  logical,                public, save :: CPL_SST_UPDATE  = .false. !< is Sea Surface Temperature updated?
  logical,                public, save :: CPL_sw_AtmLnd             !< do atmos-land coupler calculation?
  logical,                public, save :: CPL_sw_AtmOcn             !< do atmos-ocean coupler calculation?
  logical,                public, save :: CPL_sw_restart            !< output coupler restart?

  real(RP), public, save, allocatable :: LST  (:,:)   ! Land Surface Temperature [K]
  real(RP), public, save, allocatable :: SST  (:,:)   ! Sea Surface Temperature [K]
  real(RP), public, save, allocatable :: ALBW (:,:,:) ! Sea Surface albedo [0-1]
  real(RP), public, save, allocatable :: ALBG (:,:,:) ! Land Surface albedo [0-1]
  real(RP), public, save, allocatable :: Z0W  (:,:)   ! Sea Surface roughness length [m]
  real(RP), public, save, allocatable :: SkinT(:,:)   ! Ground Skin Temperature [K]
  real(RP), public, save, allocatable :: SkinW(:,:)   ! Ground Skin Water       [kg/m2]
  real(RP), public, save, allocatable :: SnowQ(:,:)   ! Ground Snow amount      [kg/m2]
  real(RP), public, save, allocatable :: SnowT(:,:)   ! Ground Snow Temperature [K]

  real(RP), public, save, allocatable :: XMFLX (:,:) ! x-momentum flux [kg/m2/s]
  real(RP), public, save, allocatable :: YMFLX (:,:) ! y-momentum flux [kg/m2/s]
  real(RP), public, save, allocatable :: ZMFLX (:,:) ! z-momentum flux [kg/m2/s]
  real(RP), public, save, allocatable :: SWUFLX(:,:) ! upward short-wave radiation flux (upward positive) [W/m2]
  real(RP), public, save, allocatable :: LWUFLX(:,:) ! upward long-wave radiation flux (upward positive) [W/m2]
  real(RP), public, save, allocatable :: SHFLX (:,:) ! sensible heat flux (upward positive) [W/m2]
  real(RP), public, save, allocatable :: LHFLX (:,:) ! latent heat flux (upward positive) [W/m2]
  real(RP), public, save, allocatable :: QVFLX (:,:) ! moisture flux for atmosphere [kg/m2/s]

  real(RP), public, save, allocatable :: Lnd_GHFLX  (:,:) ! ground heat flux (upward positive) [W/m2]
  real(RP), public, save, allocatable :: Lnd_PRECFLX(:,:) ! precipitation flux [kg/m2/s]
  real(RP), public, save, allocatable :: Lnd_QVFLX  (:,:) ! moisture flux for land [kg/m2/s]

  real(RP), public, save, allocatable :: Ocn_WHFLX  (:,:) ! water heat flux (upward positive) [W/m2]
  real(RP), public, save, allocatable :: Ocn_PRECFLX(:,:) ! precipitation flux [kg/m2/s]
  real(RP), public, save, allocatable :: Ocn_QVFLX  (:,:) ! moisture flux for ocean [kg/m2/s]

  ! surface fluxes from atmosphere-land coupler
  real(RP), public, save, allocatable :: AtmLnd_XMFLX (:,:) ! x-momentum flux [kg/m2/s]
  real(RP), public, save, allocatable :: AtmLnd_YMFLX (:,:) ! y-momentum flux [kg/m2/s]
  real(RP), public, save, allocatable :: AtmLnd_ZMFLX (:,:) ! z-momentum flux [kg/m2/s]
  real(RP), public, save, allocatable :: AtmLnd_SWUFLX(:,:) ! upward short-wave radiation flux (upward positive) [W/m2]
  real(RP), public, save, allocatable :: AtmLnd_LWUFLX(:,:) ! upward long-wave radiation flux (upward positive) [W/m2]
  real(RP), public, save, allocatable :: AtmLnd_SHFLX (:,:) ! sensible heat flux (upward positive) [W/m2]
  real(RP), public, save, allocatable :: AtmLnd_LHFLX (:,:) ! latent heat flux (upward positive) [W/m2]
  real(RP), public, save, allocatable :: AtmLnd_QVFLX (:,:) ! moisture flux for atmosphere [kg/m2/s]

  ! surface fluxes from atmosphere-ocean coupler
  real(RP), public, save, allocatable :: AtmOcn_XMFLX (:,:) ! x-momentum flux [kg/m2/s]
  real(RP), public, save, allocatable :: AtmOcn_YMFLX (:,:) ! y-momentum flux [kg/m2/s]
  real(RP), public, save, allocatable :: AtmOcn_ZMFLX (:,:) ! z-momentum flux [kg/m2/s]
  real(RP), public, save, allocatable :: AtmOcn_SWUFLX(:,:) ! upward short-wave radiation flux (upward positive) [W/m2]
  real(RP), public, save, allocatable :: AtmOcn_LWUFLX(:,:) ! upward long-wave radiation flux (upward positive) [W/m2]
  real(RP), public, save, allocatable :: AtmOcn_SHFLX (:,:) ! sensible heat flux (upward positive) [W/m2]
  real(RP), public, save, allocatable :: AtmOcn_LHFLX (:,:) ! latent heat flux (upward positive) [W/m2]
  real(RP), public, save, allocatable :: AtmOcn_QVFLX (:,:) ! moisture flux for atmosphere [kg/m2/s]

  ! Atmospheric values
  real(RP), public, save, allocatable :: CPL_DENS(:,:) ! air density [kg/m3]
  real(RP), public, save, allocatable :: CPL_MOMX(:,:) ! momentum x [kg/m2/s]
  real(RP), public, save, allocatable :: CPL_MOMY(:,:) ! momentum y [kg/m2/s]
  real(RP), public, save, allocatable :: CPL_MOMZ(:,:) ! momentum z [kg/m2/s]
  real(RP), public, save, allocatable :: CPL_RHOS(:,:) ! air density at the surface [kg/m3]
  real(RP), public, save, allocatable :: CPL_PRES(:,:) ! pressure at the surface [Pa]
  real(RP), public, save, allocatable :: CPL_ATMP(:,:) ! air temperature at the surface [K]
  real(RP), public, save, allocatable :: CPL_QV  (:,:) ! ratio of mass of tracer to total mass [kg/kg]
  real(RP), public, save, allocatable :: CPL_PREC(:,:) ! surface precipitation rate [kg/m2/s]
  real(RP), public, save, allocatable :: CPL_SWD (:,:) ! downward short-wave radiation flux (upward positive) [W/m2]
  real(RP), public, save, allocatable :: CPL_LWD (:,:) ! downward long-wave radiation flux (upward positive) [W/m2]

  ! Land values
  real(RP), public, save, allocatable :: CPL_TG  (:,:) ! soil temperature [K]
  real(RP), public, save, allocatable :: CPL_QVEF(:,:) ! efficiency of evaporation [0-1]
  real(RP), public, save, allocatable :: CPL_TCS (:,:) ! thermal conductivity for soil [W/m/K]
  real(RP), public, save, allocatable :: CPL_DZG (:,:) ! soil depth [m]
  real(RP), public, save, allocatable :: CPL_Z0M (:,:) ! roughness length for momemtum [m]
  real(RP), public, save, allocatable :: CPL_Z0H (:,:) ! roughness length for heat [m]
  real(RP), public, save, allocatable :: CPL_Z0E (:,:) ! roughness length for vapor [m]

  ! Ocean values
  real(RP), public, save, allocatable :: CPL_TW  (:,:) ! water temperature [K]

  ! counter
  real(RP), public, save :: CNT_Atm_Lnd ! counter for atmos flux by land
  real(RP), public, save :: CNT_Atm_Ocn ! counter for atmos flux by ocean
  real(RP), public, save :: CNT_Lnd     ! counter for land flux
  real(RP), public, save :: CNT_Ocn     ! counter for ocean flux

  !-----------------------------------------------------------------------------
  !
  !++ Private procedure
  !
  !-----------------------------------------------------------------------------
  !
  !++ Private parameters & variables
  !
  logical,                private, save :: CPL_RESTART_OUTPUT       = .false.               !< output restart file?
  character(len=H_LONG) , private, save :: CPL_RESTART_IN_BASENAME  = ''                    !< basename of the input file
  character(len=H_LONG) , private, save :: CPL_RESTART_OUT_BASENAME = ''                    !< basename of the output file
  character(len=H_MID)  , private, save :: CPL_RESTART_OUT_TITLE    = 'SCALE-LES CPL VARS.' !< title    of the output file
  character(len=H_SHORT), private, save :: CPL_RESTART_OUT_DTYPE    = 'DEFAULT'             !< REAL4 or REAL8
  logical,                private, save :: CPL_VARS_CHECKRANGE      = .false.

  integer, private, parameter :: PV_NUM        = 25

  integer, private, parameter :: I_LST         = 1
  integer, private, parameter :: I_SST         = 2
  integer, private, parameter :: I_ALBW_SW     = 3
  integer, private, parameter :: I_ALBW_LW     = 4
  integer, private, parameter :: I_ALBG_SW     = 5
  integer, private, parameter :: I_ALBG_LW     = 6
  integer, private, parameter :: I_Z0W         = 7
  integer, private, parameter :: I_SkinT       = 8
  integer, private, parameter :: I_SkinW       = 9
  integer, private, parameter :: I_SnowQ       = 10
  integer, private, parameter :: I_SnowT       = 11
  integer, private, parameter :: I_XMFLX       = 12
  integer, private, parameter :: I_YMFLX       = 13
  integer, private, parameter :: I_ZMFLX       = 14
  integer, private, parameter :: I_SWUFLX      = 15
  integer, private, parameter :: I_LWUFLX      = 16
  integer, private, parameter :: I_SHFLX       = 17
  integer, private, parameter :: I_LHFLX       = 18
  integer, private, parameter :: I_QVFLX       = 19
  integer, private, parameter :: I_Lnd_GHFLX   = 20
  integer, private, parameter :: I_Lnd_PRECFLX = 21
  integer, private, parameter :: I_Lnd_QVFLX   = 22
  integer, private, parameter :: I_Ocn_WHFLX   = 23
  integer, private, parameter :: I_Ocn_PRECFLX = 24
  integer, private, parameter :: I_Ocn_QVFLX   = 25

  character(len=H_SHORT), private, save :: PV_NAME(PV_NUM) !< name  of the coupler variables
  character(len=H_MID),   private, save :: PV_DESC(PV_NUM) !< desc. of the coupler variables
  character(len=H_SHORT), private, save :: PV_UNIT(PV_NUM) !< unit  of the coupler variables

  data PV_NAME / 'LST',         &
                 'SST',         &
                 'ALBW_SW',     &
                 'ALBW_LW',     &
                 'ALBG_SW',     &
                 'ALBG_LW',     &
                 'Z0W',         &
                 'SkinT',       &
                 'SkinW',       &
                 'SnowQ',       &
                 'SnowT',       &
                 'XMFLX',       &
                 'YMFLX',       &
                 'ZMFLX',       &
                 'SWUFLX',      &
                 'LWUFLX',      &
                 'SHFLX',       &
                 'LHFLX',       &
                 'QVFLX',       &
                 'Lnd_GHFLX',   &
                 'Lnd_PRECFLX', &
                 'Lnd_QVFLX',   &
                 'Ocn_WHFLX',   &
                 'Ocn_PRECFLX', &
                 'Ocn_QVFLX'    /

  data PV_DESC / 'land surface temp.',               &
                 'sea surface temp.',                &
                 'sea surface albedo for SW',        &
                 'sea surface albedo for LW',        &
                 'land surface albedo for SW',       &
                 'land surface albedo for LW',       &
                 'sea surface roughness length',     &
                 'ground skin temp.',                &
                 'ground skin water',                &
                 'ground snow amount',               &
                 'ground snow temp.',                &
                 'x-momentum flux',                  &
                 'y-momentum flux',                  &
                 'z-momentum flux',                  &
                 'upward short-wave radiation flux', &
                 'upward long-wave radiation flux',  &
                 'sensible heat flux',               &
                 'latent heat flux',                 &
                 'moisture flux for atmosphere',     &
                 'ground heat flux',                 &
                 'precipitation flux for land',      &
                 'moisture flux for land',           &
                 'water heat flux',                  &
                 'precipitation flux for ocean',     &
                 'moisture flux for ocean'           /

  data PV_UNIT / 'K',       &
                 'K',       &
                 '0-1',     &
                 '0-1',     &
                 '0-1',     &
                 '0-1',     &
                 'm',       &
                 'K',       &
                 'kg/m2',   &
                 'kg/m2',   &
                 'K',       &
                 'kg/m2/s', &
                 'kg/m2/s', &
                 'kg/m2/s', &
                 'W/m2',    &
                 'W/m2',    &
                 'W/m2',    &
                 'W/m2',    &
                 'kg/m2/s', &
                 'W/m2',    &
                 'kg/m2/s', &
                 'kg/m2/s', &
                 'W/m2',    &
                 'kg/m2/s', &
                 'kg/m2/s'  /

  !-----------------------------------------------------------------------------
contains
  !-----------------------------------------------------------------------------
  !> Setup
  subroutine CPL_vars_setup
    use scale_process, only: &
       PRC_MPIstop
    use scale_const, only: &
       NRAD => CONST_NRAD
    implicit none

    NAMELIST / PARAM_CPL / &
       CPL_TYPE_AtmLnd, &
       CPL_TYPE_AtmOcn, &
       CPL_LST_UPDATE,  &
       CPL_SST_UPDATE

    NAMELIST / PARAM_CPL_VARS /  &
       CPL_RESTART_IN_BASENAME,  &
       CPL_RESTART_OUTPUT,       &
       CPL_RESTART_OUT_BASENAME, &
       CPL_RESTART_OUT_TITLE,    &
       CPL_RESTART_OUT_DTYPE,    &
       CPL_VARS_CHECKRANGE

    integer :: ip, ierr
    !---------------------------------------------------------------------------

    if( IO_L ) write(IO_FID_LOG,*)
    if( IO_L ) write(IO_FID_LOG,*) '+++ Module[CPL VARS]/Categ[CPL]'

    CNT_Atm_Lnd = 0.0_RP
    CNT_Atm_Ocn = 0.0_RP
    CNT_Lnd     = 0.0_RP
    CNT_Ocn     = 0.0_RP

    allocate( LST  (IA,JA)      )
    allocate( SST  (IA,JA)      )
    allocate( ALBW (IA,JA,NRAD) )
    allocate( ALBG (IA,JA,NRAD) )
    allocate( Z0W  (IA,JA)      )
    allocate( SkinT(IA,JA)      )
    allocate( SkinW(IA,JA)      )
    allocate( SnowQ(IA,JA)      )
    allocate( SnowT(IA,JA)      )

    allocate( XMFLX (IA,JA) )
    allocate( YMFLX (IA,JA) )
    allocate( ZMFLX (IA,JA) )
    allocate( SWUFLX(IA,JA) )
    allocate( LWUFLX(IA,JA) )
    allocate( SHFLX (IA,JA) )
    allocate( LHFLX (IA,JA) )
    allocate( QVFLX (IA,JA) )

    allocate( Lnd_GHFLX  (IA,JA) )
    allocate( Lnd_PRECFLX(IA,JA) )
    allocate( Lnd_QVFLX  (IA,JA) )

    allocate( Ocn_WHFLX  (IA,JA) )
    allocate( Ocn_PRECFLX(IA,JA) )
    allocate( Ocn_QVFLX  (IA,JA) )

    allocate( CPL_DENS(IA,JA) )
    allocate( CPL_MOMX(IA,JA) )
    allocate( CPL_MOMY(IA,JA) )
    allocate( CPL_MOMZ(IA,JA) )
    allocate( CPL_RHOS(IA,JA) )
    allocate( CPL_PRES(IA,JA) )
    allocate( CPL_ATMP(IA,JA) )
    allocate( CPL_QV  (IA,JA) )
    allocate( CPL_PREC(IA,JA) )
    allocate( CPL_SWD (IA,JA) )
    allocate( CPL_LWD (IA,JA) )

    allocate( CPL_TG  (IA,JA) )
    allocate( CPL_QVEF(IA,JA) )
    allocate( CPL_TCS (IA,JA) )
    allocate( CPL_DZG (IA,JA) )
    allocate( CPL_Z0M (IA,JA) )
    allocate( CPL_Z0H (IA,JA) )
    allocate( CPL_Z0E (IA,JA) )

    allocate( CPL_TW  (IA,JA) )

    allocate( AtmLnd_XMFLX      (IA,JA) )
    allocate( AtmLnd_YMFLX      (IA,JA) )
    allocate( AtmLnd_ZMFLX      (IA,JA) )
    allocate( AtmLnd_SWUFLX     (IA,JA) )
    allocate( AtmLnd_LWUFLX     (IA,JA) )
    allocate( AtmLnd_SHFLX      (IA,JA) )
    allocate( AtmLnd_LHFLX      (IA,JA) )
    allocate( AtmLnd_QVFLX      (IA,JA) )

    allocate( AtmOcn_XMFLX      (IA,JA) )
    allocate( AtmOcn_YMFLX      (IA,JA) )
    allocate( AtmOcn_ZMFLX      (IA,JA) )
    allocate( AtmOcn_SWUFLX     (IA,JA) )
    allocate( AtmOcn_LWUFLX     (IA,JA) )
    allocate( AtmOcn_SHFLX      (IA,JA) )
    allocate( AtmOcn_LHFLX      (IA,JA) )
    allocate( AtmOcn_QVFLX      (IA,JA) )

    !--- read namelist
    rewind(IO_FID_CONF)
    read(IO_FID_CONF,nml=PARAM_CPL,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_CPL. Check!'
       call PRC_MPIstop
    endif
    if( IO_L ) write(IO_FID_LOG,nml=PARAM_CPL)

    if( IO_L ) write(IO_FID_LOG,*) '*** [CPL] selected components'

    ! Atoms-Land Switch
    if ( CPL_TYPE_AtmLnd /= 'OFF' .AND. CPL_TYPE_AtmLnd /= 'NONE' ) then
       if( IO_L ) write(IO_FID_LOG,*) '*** Atmos-Land Coupler : ON'
       CPL_sw_AtmLnd = .true.
    else
       if( IO_L ) write(IO_FID_LOG,*) '*** Atmos-Land Coupler : OFF'
       CPL_sw_AtmLnd = .false.
    endif

    ! Atoms-Ocean Switch
    if ( CPL_TYPE_AtmOcn /= 'OFF' .AND. CPL_TYPE_AtmOcn /= 'NONE' ) then
       if( IO_L ) write(IO_FID_LOG,*) '*** Atmos-Ocean Coupler : ON'
       CPL_sw_AtmOcn = .true.
    else
       if( IO_L ) write(IO_FID_LOG,*) '*** Atmos-Ocean Coupler : OFF'
       CPL_sw_AtmOcn = .false.
    endif

    !--- read namelist
    rewind(IO_FID_CONF)
    read(IO_FID_CONF,nml=PARAM_CPL_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_CPL_VARS. Check!'
       call PRC_MPIstop
    endif
    if( IO_L ) write(IO_FID_LOG,nml=PARAM_CPL_VARS)

    if( IO_L ) write(IO_FID_LOG,*)
    if( IO_L ) write(IO_FID_LOG,*) '*** [CPL] prognostic variables'
    if( IO_L ) write(IO_FID_LOG,'(1x,A,A8,A,A32,3(A))') &
               '***       |',' VARNAME','|', 'DESCRIPTION                     ','[', 'UNIT            ',']'
    do ip = 1, PV_NUM
       if( IO_L ) write(IO_FID_LOG,'(1x,A,i3,A,A8,A,A32,3(A))') &
                  '*** NO.',ip,'|',trim(PV_NAME(ip)),'|', PV_DESC(ip),'[', PV_UNIT(ip),']'
    enddo

    ! restart switch
    if( IO_L ) write(IO_FID_LOG,*)
    if( IO_L ) write(IO_FID_LOG,*) 'Output...'
    if ( CPL_RESTART_OUTPUT ) then
       if( IO_L ) write(IO_FID_LOG,*) '  Coupler restart output : YES'
       CPL_sw_restart = .true.
    else
       if( IO_L ) write(IO_FID_LOG,*) '  Coupler restart output : NO'
       CPL_sw_restart = .false.
    endif
    if( IO_L ) write(IO_FID_LOG,*)

    return
  end subroutine CPL_vars_setup

  !-----------------------------------------------------------------------------
  !> fill HALO region of coupler variables
  subroutine CPL_vars_fillhalo
    use scale_comm, only: &
       COMM_vars8, &
       COMM_wait
    use scale_const, only: &
       I_SW => CONST_I_SW, &
       I_LW => CONST_I_LW
    implicit none
    !---------------------------------------------------------------------------

    ! fill IHALO & JHALO
    call COMM_vars8( LST  (:,:),      1  )
    call COMM_vars8( SST  (:,:),      2  )
    call COMM_vars8( ALBW (:,:,I_SW), 3  )
    call COMM_vars8( ALBW (:,:,I_LW), 4  )
    call COMM_vars8( ALBG (:,:,I_SW), 5  )
    call COMM_vars8( ALBG (:,:,I_LW), 6  )
    call COMM_vars8( Z0W  (:,:),      7  )
    call COMM_vars8( SkinT(:,:),      8  )
    call COMM_vars8( SkinW(:,:),      9  )
    call COMM_vars8( SnowQ(:,:),      10 )
    call COMM_vars8( SnowT(:,:),      11 )

    call COMM_wait ( LST  (:,:),      1  )
    call COMM_wait ( SST  (:,:),      2  )
    call COMM_wait ( ALBW (:,:,I_SW), 3  )
    call COMM_wait ( ALBW (:,:,I_LW), 4  )
    call COMM_wait ( ALBG (:,:,I_SW), 5  )
    call COMM_wait ( ALBG (:,:,I_LW), 6  )
    call COMM_wait ( Z0W  (:,:),      7  )
    call COMM_wait ( SkinT(:,:),      8  )
    call COMM_wait ( SkinW(:,:),      9  )
    call COMM_wait ( SnowQ(:,:),      10 )
    call COMM_wait ( SnowT(:,:),      11 )

    return
  end subroutine CPL_vars_fillhalo

  !-----------------------------------------------------------------------------
  !> Read coupler restart
  subroutine CPL_vars_restart_read
    use scale_fileio, only: &
       FILEIO_read
    use scale_const, only: &
       UNDEF => CONST_UNDEF, &
       I_SW  => CONST_I_SW,  &
       I_LW  => CONST_I_LW
    use scale_comm, only: &
       COMM_vars8, &
       COMM_wait
    implicit none
    !---------------------------------------------------------------------------

    if( IO_L ) write(IO_FID_LOG,*)
    if( IO_L ) write(IO_FID_LOG,*) '*** Input restart file (coupler) ***'

    call PROF_rapstart('FILE I NetCDF')

    if ( CPL_RESTART_IN_BASENAME /= '' ) then

       call FILEIO_read( LST(:,:),                                        & ![OUT]
                         CPL_RESTART_IN_BASENAME, 'LST',     'XY', step=1 ) ![IN]
       call FILEIO_read( SST(:,:),                                        & ![OUT]
                         CPL_RESTART_IN_BASENAME, 'SST',     'XY', step=1 ) ![IN]
       call FILEIO_read( ALBW(:,:,I_SW),                                  & ![OUT]
                         CPL_RESTART_IN_BASENAME, 'ALBW_SW', 'XY', step=1 ) ![IN]
       call FILEIO_read( ALBW(:,:,I_LW),                                  & ![OUT]
                         CPL_RESTART_IN_BASENAME, 'ALBW_LW', 'XY', step=1 ) ![IN]
       call FILEIO_read( ALBG(:,:,I_SW),                                  & ![OUT]
                         CPL_RESTART_IN_BASENAME, 'ALBG_SW', 'XY', step=1 ) ![IN]
       call FILEIO_read( ALBG(:,:,I_LW),                                  & ![OUT]
                         CPL_RESTART_IN_BASENAME, 'ALBG_LW', 'XY', step=1 ) ![IN]
       call FILEIO_read( Z0W(:,:),                                        & ![OUT]
                         CPL_RESTART_IN_BASENAME, 'Z0W',     'XY', step=1 ) ![IN]
       call FILEIO_read( SkinT(:,:),                                      & ![OUT]
                         CPL_RESTART_IN_BASENAME, 'SkinT',   'XY', step=1 ) ![IN]
       call FILEIO_read( SkinW(:,:),                                      & ![OUT]
                         CPL_RESTART_IN_BASENAME, 'SkinW',   'XY', step=1 ) ![IN]
       call FILEIO_read( SnowQ(:,:),                                      & ![OUT]
                         CPL_RESTART_IN_BASENAME, 'SnowQ',   'XY', step=1 ) ![IN]
       call FILEIO_read( SnowT(:,:),                                      & ![OUT]
                         CPL_RESTART_IN_BASENAME, 'SnowT',   'XY', step=1 ) ![IN]

       call CPL_vars_fillhalo

       call CPL_vars_total
    else
       if( IO_L ) write(IO_FID_LOG,*) '*** restart file for coupler is not specified.'

       LST  (:,:)   = UNDEF
       SST  (:,:)   = UNDEF
       ALBW (:,:,:) = UNDEF
       ALBG (:,:,:) = UNDEF
       Z0W  (:,:)   = UNDEF
       SkinT(:,:)   = UNDEF
       SkinW(:,:)   = UNDEF
       SnowQ(:,:)   = UNDEF
       SnowT(:,:)   = UNDEF
    endif

    call PROF_rapend  ('FILE I NetCDF')

    return
  end subroutine CPL_vars_restart_read

  !-----------------------------------------------------------------------------
  !> Write coupler restart
  subroutine CPL_vars_restart_write
    use scale_time, only: &
       NOWSEC => TIME_NOWDAYSEC
    use scale_fileio, only: &
       FILEIO_write
    use scale_const, only: &
       I_SW => CONST_I_SW, &
       I_LW => CONST_I_LW
    implicit none

    character(len=H_LONG) :: bname

    integer :: n
    !---------------------------------------------------------------------------

    call PROF_rapstart('FILE O NetCDF')

    if ( CPL_RESTART_OUT_BASENAME /= '' ) then

       if( IO_L ) write(IO_FID_LOG,*)
       if( IO_L ) write(IO_FID_LOG,*) '*** Output restart file (coupler) ***'

       bname = ''
       write(bname(1:15), '(F15.3)') NOWSEC
       do n = 1, 15
          if ( bname(n:n) == ' ' ) bname(n:n) = '0'
       enddo
       write(bname,'(A,A,A)') trim(CPL_RESTART_OUT_BASENAME), '_', trim(bname)

       call FILEIO_write( LST(:,:),        bname, CPL_RESTART_OUT_TITLE,               & ! [IN]
                          PV_NAME(I_LST),     PV_DESC(I_LST),     PV_UNIT(I_LST),      & ! [IN]
                          'XY', CPL_RESTART_OUT_DTYPE, append=.true.                   ) ! [IN]
       call FILEIO_write( SST(:,:),        bname, CPL_RESTART_OUT_TITLE,               & ! [IN]
                          PV_NAME(I_SST),     PV_DESC(I_SST),     PV_UNIT(I_SST),      & ! [IN]
                          'XY', CPL_RESTART_OUT_DTYPE, append=.true.                   ) ! [IN]
       call FILEIO_write( ALBW(:,:,I_SW),  bname, CPL_RESTART_OUT_TITLE,               & ! [IN]
                          PV_NAME(I_ALBW_SW), PV_DESC(I_ALBW_SW), PV_UNIT(I_ALBW_SW),  & ! [IN]
                          'XY', CPL_RESTART_OUT_DTYPE, append=.true.                   ) ! [IN]
       call FILEIO_write( ALBW(:,:,I_LW),  bname, CPL_RESTART_OUT_TITLE,               & ! [IN]
                          PV_NAME(I_ALBW_LW), PV_DESC(I_ALBW_LW), PV_UNIT(I_ALBW_LW),  & ! [IN]
                          'XY', CPL_RESTART_OUT_DTYPE, append=.true.                   ) ! [IN]
       call FILEIO_write( ALBG(:,:,I_SW),  bname, CPL_RESTART_OUT_TITLE,               & ! [IN]
                          PV_NAME(I_ALBG_SW), PV_DESC(I_ALBG_SW), PV_UNIT(I_ALBG_SW),  & ! [IN]
                          'XY', CPL_RESTART_OUT_DTYPE, append=.true.                   ) ! [IN]
       call FILEIO_write( ALBG(:,:,I_LW),  bname, CPL_RESTART_OUT_TITLE,               & ! [IN]
                          PV_NAME(I_ALBG_LW), PV_DESC(I_ALBG_LW), PV_UNIT(I_ALBG_LW),  & ! [IN]
                          'XY', CPL_RESTART_OUT_DTYPE, append=.true.                   ) ! [IN]
       call FILEIO_write( Z0W(:,:),        bname, CPL_RESTART_OUT_TITLE,               & ! [IN]
                          PV_NAME(I_Z0W),     PV_DESC(I_Z0W),     PV_UNIT(I_Z0W),      & ! [IN]
                          'XY', CPL_RESTART_OUT_DTYPE, append=.true.                   ) ! [IN]
       call FILEIO_write( SkinT(:,:),      bname, CPL_RESTART_OUT_TITLE,               & ! [IN]
                          PV_NAME(I_SkinT),   PV_DESC(I_SkinT),   PV_UNIT(I_SkinT),    & ! [IN]
                          'XY', CPL_RESTART_OUT_DTYPE, append=.true.                   ) ! [IN]
       call FILEIO_write( SkinW(:,:),      bname, CPL_RESTART_OUT_TITLE,               & ! [IN]
                          PV_NAME(I_SkinW),   PV_DESC(I_SkinW),   PV_UNIT(I_SkinW),    & ! [IN]
                          'XY', CPL_RESTART_OUT_DTYPE, append=.true.                   ) ! [IN]
       call FILEIO_write( SnowQ(:,:),      bname, CPL_RESTART_OUT_TITLE,               & ! [IN]
                          PV_NAME(I_SnowQ),   PV_DESC(I_SnowQ),   PV_UNIT(I_SnowQ),    & ! [IN]
                          'XY', CPL_RESTART_OUT_DTYPE, append=.true.                   ) ! [IN]
       call FILEIO_write( SnowT(:,:),      bname, CPL_RESTART_OUT_TITLE,               & ! [IN]
                          PV_NAME(I_SnowT),   PV_DESC(I_SnowT),   PV_UNIT(I_SnowT),    & ! [IN]
                          'XY', CPL_RESTART_OUT_DTYPE, append=.true.                   ) ! [IN]

    endif

    call PROF_rapend  ('FILE O NetCDF')

    call CPL_vars_total

    return
  end subroutine CPL_vars_restart_write

  !-----------------------------------------------------------------------------
  !> History output set for coupler variables
  subroutine CPL_vars_history
    use scale_time, only: &
       TIME_DTSEC_CPL
    use scale_history, only: &
       HIST_in
    use scale_const, only: &
       I_SW => CONST_I_SW, &
       I_LW => CONST_I_LW
    implicit none
    !---------------------------------------------------------------------------

    if ( CPL_VARS_CHECKRANGE ) then
       call VALCHECK( LST  (:,:),      0.0_RP, 1000.0_RP, PV_NAME(I_LST)    , __FILE__, __LINE__ )
       call VALCHECK( SST  (:,:),      0.0_RP, 1000.0_RP, PV_NAME(I_SST)    , __FILE__, __LINE__ )
       call VALCHECK( ALBW (:,:,I_SW), 0.0_RP,    2.0_RP, PV_NAME(I_ALBW_SW), __FILE__, __LINE__ )
       call VALCHECK( ALBW (:,:,I_LW), 0.0_RP,    2.0_RP, PV_NAME(I_ALBW_LW), __FILE__, __LINE__ )
       call VALCHECK( ALBG (:,:,I_SW), 0.0_RP,    2.0_RP, PV_NAME(I_ALBG_SW), __FILE__, __LINE__ )
       call VALCHECK( ALBG (:,:,I_LW), 0.0_RP,    2.0_RP, PV_NAME(I_ALBG_LW), __FILE__, __LINE__ )
       call VALCHECK( Z0W  (:,:),      0.0_RP, 1000.0_RP, PV_NAME(I_Z0W)    , __FILE__, __LINE__ )
       call VALCHECK( SkinT(:,:),      0.0_RP, 1000.0_RP, PV_NAME(I_SkinT)  , __FILE__, __LINE__ )
       call VALCHECK( SkinW(:,:),      0.0_RP, 1000.0_RP, PV_NAME(I_SkinW)  , __FILE__, __LINE__ )
       call VALCHECK( SnowQ(:,:),      0.0_RP, 1000.0_RP, PV_NAME(I_SnowQ)  , __FILE__, __LINE__ )
       call VALCHECK( SnowT(:,:),      0.0_RP, 1000.0_RP, PV_NAME(I_SnowT)  , __FILE__, __LINE__ )

       call VALCHECK( XMFLX (:,:), -1.0E4_RP, 1.0E4_RP, PV_NAME(I_XMFLX) , __FILE__, __LINE__ )
       call VALCHECK( YMFLX (:,:), -1.0E4_RP, 1.0E4_RP, PV_NAME(I_YMFLX) , __FILE__, __LINE__ )
       call VALCHECK( ZMFLX (:,:), -1.0E4_RP, 1.0E4_RP, PV_NAME(I_ZMFLX) , __FILE__, __LINE__ )
       call VALCHECK( SWUFLX(:,:), -1.0E4_RP, 1.0E4_RP, PV_NAME(I_SWUFLX), __FILE__, __LINE__ )
       call VALCHECK( LWUFLX(:,:), -1.0E4_RP, 1.0E4_RP, PV_NAME(I_LWUFLX), __FILE__, __LINE__ )
       call VALCHECK( SHFLX (:,:), -1.0E4_RP, 1.0E4_RP, PV_NAME(I_SHFLX) , __FILE__, __LINE__ )
       call VALCHECK( LHFLX (:,:), -1.0E4_RP, 1.0E4_RP, PV_NAME(I_LHFLX) , __FILE__, __LINE__ )
       call VALCHECK( QVFLX (:,:), -1.0E4_RP, 1.0E4_RP, PV_NAME(I_QVFLX) , __FILE__, __LINE__ )

       call VALCHECK( Lnd_GHFLX  (:,:), -1.0E4_RP, 1.0E4_RP, PV_NAME(I_Lnd_GHFLX)  , __FILE__, __LINE__ )
       call VALCHECK( Lnd_PRECFLX(:,:), -1.0E4_RP, 1.0E4_RP, PV_NAME(I_Lnd_PRECFLX), __FILE__, __LINE__ )
       call VALCHECK( Lnd_QVFLX  (:,:), -1.0E4_RP, 1.0E4_RP, PV_NAME(I_Lnd_QVFLX)  , __FILE__, __LINE__ )

       call VALCHECK( Ocn_WHFLX  (:,:), -1.0E4_RP, 1.0E4_RP, PV_NAME(I_Ocn_WHFLX)  , __FILE__, __LINE__ )
       call VALCHECK( Ocn_PRECFLX(:,:), -1.0E4_RP, 1.0E4_RP, PV_NAME(I_Ocn_PRECFLX), __FILE__, __LINE__ )
       call VALCHECK( Ocn_QVFLX  (:,:), -1.0E4_RP, 1.0E4_RP, PV_NAME(I_Ocn_QVFLX)  , __FILE__, __LINE__ )
    endif

    call HIST_in( LST  (:,:),      'LST',      PV_DESC(I_LST),      PV_UNIT(I_LST),      TIME_DTSEC_CPL )
    call HIST_in( SST  (:,:),      'SST',      PV_DESC(I_SST),      PV_UNIT(I_SST),      TIME_DTSEC_CPL )
    call HIST_in( ALBW (:,:,I_SW), 'ALBW_SW',  PV_DESC(I_ALBW_SW),  PV_UNIT(I_ALBW_SW),  TIME_DTSEC_CPL )
    call HIST_in( ALBW (:,:,I_LW), 'ALBW_LW',  PV_DESC(I_ALBW_LW),  PV_UNIT(I_ALBW_LW),  TIME_DTSEC_CPL )
    call HIST_in( ALBG (:,:,I_SW), 'ALBG_SW',  PV_DESC(I_ALBG_SW),  PV_UNIT(I_ALBG_SW),  TIME_DTSEC_CPL )
    call HIST_in( ALBG (:,:,I_LW), 'ALBG_LW',  PV_DESC(I_ALBG_LW),  PV_UNIT(I_ALBG_LW),  TIME_DTSEC_CPL )
    call HIST_in( Z0W  (:,:),      'Z0W',      PV_DESC(I_Z0W),      PV_UNIT(I_Z0W),      TIME_DTSEC_CPL )
    call HIST_in( SkinT(:,:),      'SkinT',    PV_DESC(I_SkinT),    PV_UNIT(I_SkinT),    TIME_DTSEC_CPL )
    call HIST_in( SkinW(:,:),      'SkinW',    PV_DESC(I_SkinW),    PV_UNIT(I_SkinW),    TIME_DTSEC_CPL )
    call HIST_in( SnowQ(:,:),      'SnowQ',    PV_DESC(I_SnowQ),    PV_UNIT(I_SnowQ),    TIME_DTSEC_CPL )
    call HIST_in( SnowT(:,:),      'SnowT',    PV_DESC(I_SnowT),    PV_UNIT(I_SnowT),    TIME_DTSEC_CPL )

    call HIST_in( XMFLX (:,:), 'XMFLX',  PV_DESC(I_XMFLX),  PV_UNIT(I_XMFLX),  TIME_DTSEC_CPL )
    call HIST_in( YMFLX (:,:), 'YMFLX',  PV_DESC(I_YMFLX),  PV_UNIT(I_YMFLX),  TIME_DTSEC_CPL )
    call HIST_in( ZMFLX (:,:), 'ZMFLX',  PV_DESC(I_ZMFLX),  PV_UNIT(I_ZMFLX),  TIME_DTSEC_CPL )
    call HIST_in( SWUFLX(:,:), 'SWUFLX', PV_DESC(I_SWUFLX), PV_UNIT(I_SWUFLX), TIME_DTSEC_CPL )
    call HIST_in( LWUFLX(:,:), 'LWUFLX', PV_DESC(I_LWUFLX), PV_UNIT(I_LWUFLX), TIME_DTSEC_CPL )
!    call HIST_in( SHFLX (:,:), 'SHFLX',  PV_DESC(I_SHFLX),  PV_UNIT(I_SHFLX),  TIME_DTSEC_CPL )
!    call HIST_in( LHFLX (:,:), 'LHFLX',  PV_DESC(I_LHFLX),  PV_UNIT(I_LHFLX),  TIME_DTSEC_CPL )
    call HIST_in( QVFLX (:,:), 'QVFLX',  PV_DESC(I_QVFLX),  PV_UNIT(I_QVFLX),  TIME_DTSEC_CPL )

    call HIST_in( Lnd_GHFLX  (:,:), 'Lnd_GHFLX',   PV_DESC(I_Lnd_GHFLX),   PV_UNIT(I_Lnd_GHFLX),   TIME_DTSEC_CPL )
    call HIST_in( Lnd_PRECFLX(:,:), 'Lnd_PRECFLX', PV_DESC(I_Lnd_PRECFLX), PV_UNIT(I_Lnd_PRECFLX), TIME_DTSEC_CPL )
    call HIST_in( Lnd_QVFLX  (:,:), 'Lnd_QVFLX',   PV_DESC(I_Lnd_QVFLX),   PV_UNIT(I_Lnd_QVFLX),   TIME_DTSEC_CPL )

    call HIST_in( Ocn_WHFLX  (:,:), 'Ocn_WHFLX',   PV_DESC(I_Ocn_WHFLX),   PV_UNIT(I_Ocn_WHFLX),   TIME_DTSEC_CPL )
    call HIST_in( Ocn_PRECFLX(:,:), 'Ocn_PRECFLX', PV_DESC(I_Ocn_PRECFLX), PV_UNIT(I_Ocn_PRECFLX), TIME_DTSEC_CPL )
    call HIST_in( Ocn_QVFLX  (:,:), 'Ocn_QVFLX',   PV_DESC(I_Ocn_QVFLX),   PV_UNIT(I_Ocn_QVFLX),   TIME_DTSEC_CPL )

    return
  end subroutine CPL_vars_history

  !-----------------------------------------------------------------------------
  !> Budget monitor for coupler
  subroutine CPL_vars_total
    use scale_stats, only: &
       STAT_checktotal, &
       STAT_total
    use scale_const, only: &
       I_SW => CONST_I_SW, &
       I_LW => CONST_I_LW
    implicit none

    real(RP) :: total
    !---------------------------------------------------------------------------

    if ( STAT_checktotal ) then

!       call STAT_total( total, LST(:,:),        PV_NAME(I_LST)     )
!       call STAT_total( total, SST(:,:),        PV_NAME(I_SST)     )
!       call STAT_total( total, ALBW(:,:,I_SW),  PV_NAME(I_ALBW_SW) )
!       call STAT_total( total, ALBW(:,:,I_LW),  PV_NAME(I_ALBW_LW) )
!       call STAT_total( total, ALBG(:,:,I_SW),  PV_NAME(I_ALBG_SW) )
!       call STAT_total( total, ALBG(:,:,I_LW),  PV_NAME(I_ALBG_LW) )
!       call STAT_total( total, Z0W(:,:),        PV_NAME(I_Z0W)     )
!       call STAT_total( total, SkinT(:,:),      PV_NAME(I_SkinT)   )
!       call STAT_total( total, SkinW(:,:),      PV_NAME(I_SkinW)   )
!       call STAT_total( total, SnowQ(:,:),      PV_NAME(I_SnowQ)   )
!       call STAT_total( total, SnowT(:,:),      PV_NAME(I_SnowT)   )

    endif

    return
  end subroutine CPL_vars_total

  subroutine CPL_vars_merge
    use scale_landuse, only: &
      frac_ocean => LANDUSE_frac_ocean
    implicit none
    !---------------------------------------------------------------------------

    ! tentative
    if( CPL_sw_AtmLnd ) then
      frac_ocean(:,:) = 0.0_RP
    end if

    ! input land
    SkinT (:,:) = LST          (:,:) * ( 1.0_RP - frac_ocean(:,:) )
    XMFLX (:,:) = AtmLnd_XMFLX (:,:) * ( 1.0_RP - frac_ocean(:,:) )
    YMFLX (:,:) = AtmLnd_YMFLX (:,:) * ( 1.0_RP - frac_ocean(:,:) )
    ZMFLX (:,:) = AtmLnd_ZMFLX (:,:) * ( 1.0_RP - frac_ocean(:,:) )
    SWUFLX(:,:) = AtmLnd_SWUFLX(:,:) * ( 1.0_RP - frac_ocean(:,:) )
    LWUFLX(:,:) = AtmLnd_LWUFLX(:,:) * ( 1.0_RP - frac_ocean(:,:) )
    SHFLX (:,:) = AtmLnd_SHFLX (:,:) * ( 1.0_RP - frac_ocean(:,:) )
    LHFLX (:,:) = AtmLnd_LHFLX (:,:) * ( 1.0_RP - frac_ocean(:,:) )
    QVFLX (:,:) = AtmLnd_QVFLX (:,:) * ( 1.0_RP - frac_ocean(:,:) )

    ! input ocean
    SkinT (:,:) = SkinT (:,:) + SST          (:,:) * frac_ocean(:,:)
    XMFLX (:,:) = XMFLX (:,:) + AtmOcn_XMFLX (:,:) * frac_ocean(:,:)
    YMFLX (:,:) = YMFLX (:,:) + AtmOcn_YMFLX (:,:) * frac_ocean(:,:)
    ZMFLX (:,:) = ZMFLX (:,:) + AtmOcn_ZMFLX (:,:) * frac_ocean(:,:)
    SWUFLX(:,:) = SWUFLX(:,:) + AtmOcn_SWUFLX(:,:) * frac_ocean(:,:)
    LWUFLX(:,:) = LWUFLX(:,:) + AtmOcn_LWUFLX(:,:) * frac_ocean(:,:)
    SHFLX (:,:) = SHFLX (:,:) + AtmOcn_SHFLX (:,:) * frac_ocean(:,:)
    LHFLX (:,:) = LHFLX (:,:) + AtmOcn_LHFLX (:,:) * frac_ocean(:,:)
    QVFLX (:,:) = QVFLX (:,:) + AtmOcn_QVFLX (:,:) * frac_ocean(:,:)

    return
  end subroutine CPL_vars_merge

  subroutine CPL_putAtm( &
      pDENS, pMOMX, pMOMY, pMOMZ, & ! (in)
      pRHOS, pPRES, pATMP, pQV,   & ! (in)
      pPREC, pSWD, pLWD           ) ! (in)
    implicit none

    real(RP), intent(in) :: pDENS(IA,JA)
    real(RP), intent(in) :: pMOMX(IA,JA)
    real(RP), intent(in) :: pMOMY(IA,JA)
    real(RP), intent(in) :: pMOMZ(IA,JA)
    real(RP), intent(in) :: pRHOS(IA,JA)
    real(RP), intent(in) :: pPRES(IA,JA)
    real(RP), intent(in) :: pATMP(IA,JA)
    real(RP), intent(in) :: pQV  (IA,JA)
    real(RP), intent(in) :: pPREC(IA,JA)
    real(RP), intent(in) :: pSWD (IA,JA)
    real(RP), intent(in) :: pLWD (IA,JA)
    !---------------------------------------------------------------------------

    CPL_DENS(:,:) = pDENS(:,:)
    CPL_MOMX(:,:) = pMOMX(:,:)
    CPL_MOMY(:,:) = pMOMY(:,:)
    CPL_MOMZ(:,:) = pMOMZ(:,:)
    CPL_RHOS(:,:) = pRHOS(:,:)
    CPL_PRES(:,:) = pPRES(:,:)
    CPL_ATMP(:,:) = pATMP(:,:)
    CPL_QV  (:,:) = pQV  (:,:)
    CPL_PREC(:,:) = pPREC(:,:)
    CPL_SWD (:,:) = pSWD (:,:)
    CPL_LWD (:,:) = pLWD (:,:)

    return
  end subroutine CPL_putAtm

  subroutine CPL_putLnd( &
      pTG, pQVEF,        & ! (in)
      pTCS, pDZG,        & ! (in)
      pZ0M, pZ0H, pZ0E   ) ! (in)
    implicit none

    real(RP), intent(in) :: pTG  (IA,JA)
    real(RP), intent(in) :: pQVEF(IA,JA)
    real(RP), intent(in) :: pTCS (IA,JA)
    real(RP), intent(in) :: pDZG (IA,JA)
    real(RP), intent(in) :: pZ0M (IA,JA)
    real(RP), intent(in) :: pZ0H (IA,JA)
    real(RP), intent(in) :: pZ0E (IA,JA)
    !---------------------------------------------------------------------------

    CPL_TG  (:,:) = pTG  (:,:)
    CPL_QVEF(:,:) = pQVEF(:,:)
    CPL_TCS (:,:) = pTCS (:,:)
    CPL_DZG (:,:) = pDZG (:,:)
    CPL_Z0M (:,:) = pZ0M (:,:)
    CPL_Z0H (:,:) = pZ0H (:,:)
    CPL_Z0E (:,:) = pZ0E (:,:)

    return
  end subroutine CPL_putLnd

  subroutine CPL_putOcn( &
      pTW ) ! (in)
    implicit none

    real(RP), intent(in) :: pTW  (IA,JA)
    !---------------------------------------------------------------------------

    CPL_TW  (:,:) = pTW  (:,:)

    return
  end subroutine CPL_putOcn

  subroutine CPL_getCPL2Atm( &
      pXMFLX, pYMFLX, pZMFLX, & ! (out)
      pSWUFLX, pLWUFLX,       & ! (out)
      pSHFLX, pLHFLX, pQVFLX  ) ! (out)
    implicit none

    real(RP), intent(out) :: pXMFLX (IA,JA)
    real(RP), intent(out) :: pYMFLX (IA,JA)
    real(RP), intent(out) :: pZMFLX (IA,JA)
    real(RP), intent(out) :: pSWUFLX(IA,JA)
    real(RP), intent(out) :: pLWUFLX(IA,JA)
    real(RP), intent(out) :: pSHFLX (IA,JA)
    real(RP), intent(out) :: pLHFLX (IA,JA)
    real(RP), intent(out) :: pQVFLX (IA,JA)
    !---------------------------------------------------------------------------

    pXMFLX (:,:) = XMFLX (:,:)
    pYMFLX (:,:) = YMFLX (:,:)
    pZMFLX (:,:) = ZMFLX (:,:)
    pSWUFLX(:,:) = SWUFLX(:,:)
    pLWUFLX(:,:) = LWUFLX(:,:)
    pSHFLX (:,:) = SHFLX (:,:)
    pLHFLX (:,:) = LHFLX (:,:)
    pQVFLX (:,:) = QVFLX (:,:)

    CNT_Atm_Lnd = 0.0_RP
    CNT_Atm_Ocn = 0.0_RP

    return
  end subroutine CPL_getCPL2Atm

  subroutine CPL_getCPL2Lnd( &
      pLnd_GHFLX, pLnd_PRECFLX, pLnd_QVFLX ) ! (out)
    implicit none

    real(RP), intent(out) :: pLnd_GHFLX  (IA,JA)
    real(RP), intent(out) :: pLnd_PRECFLX(IA,JA)
    real(RP), intent(out) :: pLnd_QVFLX  (IA,JA)

    pLnd_GHFLX  (:,:) = Lnd_GHFLX  (:,:)
    pLnd_PRECFLX(:,:) = Lnd_PRECFLX(:,:)
    pLnd_QVFLX  (:,:) = Lnd_QVFLX  (:,:)

    CNT_Lnd = 0.0_RP

    return
  end subroutine CPL_getCPL2Lnd

  subroutine CPL_getCPL2Ocn( &
      pOcn_WHFLX, pOcn_PRECFLX, pOcn_QVFLX ) ! (out)
    implicit none

    real(RP), intent(out) :: pOcn_WHFLX  (IA,JA)
    real(RP), intent(out) :: pOcn_PRECFLX(IA,JA)
    real(RP), intent(out) :: pOcn_QVFLX  (IA,JA)

    pOcn_WHFLX  (:,:) = Ocn_WHFLX  (:,:)
    pOcn_PRECFLX(:,:) = Ocn_PRECFLX(:,:)
    pOcn_QVFLX  (:,:) = Ocn_QVFLX  (:,:)

    CNT_Ocn = 0.0_RP

    return
  end subroutine CPL_getCPL2Ocn

end module mod_CPL_vars


!>  \file sfc_noahmp_drv.f
!!  This file contains the NoahMP land surface scheme driver.

!> This module contains the CCPP-compliant NoahMP land surface scheme driver.
      module noahmpdrv

      implicit none

      private

      public :: noahmpdrv_init, noahmpdrv_run, noahmpdrv_finalize

      contains

!! \section arg_table_noahmpdrv_init Argument Table
!! \htmlinclude noahmpdrv_init.html
!!
      subroutine noahmpdrv_init(me, isot, ivegsrc, nlunit, errmsg,      &
     &                          errflg)

        use set_soilveg_mod,  only: set_soilveg

        implicit none

        integer,              intent(in)  :: me, isot, ivegsrc, nlunit
        character(len=*),     intent(out) :: errmsg
        integer,              intent(out) :: errflg

        ! Initialize CCPP error handling variables
        errmsg = ''
        errflg = 0

        !--- initialize soil vegetation
        call set_soilveg(me, isot, ivegsrc, nlunit)

      end subroutine noahmpdrv_init

      subroutine noahmpdrv_finalize
      end subroutine noahmpdrv_finalize

!> \section arg_table_noahmpdrv_run Argument Table
!! \htmlinclude noahmpdrv_run.html
!!
!                                                                       !
!     lheatstrg- logical, flag for canopy heat storage             1    !
!                         parameterization                              !
!                                                                       !
!-----------------------------------
      subroutine noahmpdrv_run                                          &
!...................................
!  ---  inputs:
     &     ( im, km, itime, ps, u1, v1, t1, q1, soiltyp, vegtype,       &
     &       sigmaf, sfcemis, dlwflx, dswsfc, snet, delt, tg3, cm, ch,  &
     &       prsl1, prslki, zf, dry, wind, slopetyp,                    &
     &       shdmin, shdmax, snoalb, sfalb, flag_iter, flag_guess,      &
     &       lheatstrg,                                                 &
     &       idveg, iopt_crs, iopt_btr, iopt_run, iopt_sfc, iopt_frz,   &
     &       iopt_inf, iopt_rad, iopt_alb, iopt_snf, iopt_tbot,         &
     &       iopt_stc, xlatin, xcoszin, iyrlen, julian,                 &
     &       rainn_mp, rainc_mp, snow_mp, graupel_mp, ice_mp,           &
     &       con_hvap, con_cp, con_jcal, rhoh2o, con_eps, con_epsm1,    &
     &       con_fvirt, con_rd, con_hfus,                               &

!  ---  in/outs:
     &       weasd, snwdph, tskin, tprcp, srflag, smc, stc, slc,        &
     &       canopy, trans, tsurf, zorl,                                &

! --- Noah MP specific

     &       snowxy, tvxy, tgxy, canicexy, canliqxy, eahxy, tahxy, cmxy,&
     &       chxy, fwetxy, sneqvoxy, alboldxy, qsnowxy, wslakexy, zwtxy,&
     &       waxy, wtxy, tsnoxy, zsnsoxy, snicexy, snliqxy, lfmassxy,   &
     &       rtmassxy, stmassxy, woodxy, stblcpxy, fastcpxy, xlaixy,    &
     &       xsaixy, taussxy, smoiseq, smcwtdxy, deeprechxy, rechxy,    &

!  ---  outputs:
     &       sncovr1, qsurf, gflux, drain, evap, hflx, ep, runoff,      &
     &       cmm, chh, evbs, evcw, sbsno, snowc, stm, snohf,            &
     &       smcwlt2, smcref2, wet1, t2mmp, q2mp, errmsg, errflg)
!
!
      use machine ,   only : kind_phys
!     use date_def,   only : idate
      use funcphys,   only : fpvs

      use module_sf_noahmplsm
      use module_sf_noahmp_glacier
      use noahmp_tables, only : isice_table, co2_table, o2_table,       &
     &                       isurban_table,smcref_table,smcdry_table,   &
     &                       smcmax_table,co2_table,o2_table,           &
     &                       saim_table,laim_table

      implicit none

      real(kind=kind_phys), parameter :: a2      = 17.2693882
      real(kind=kind_phys), parameter :: a3      = 273.16
      real(kind=kind_phys), parameter :: a4      = 35.86
      real(kind=kind_phys), parameter :: a23m4   = a2*(a3-a4)

      real, parameter                 :: undefined       =  -1.e36

      real                            :: dz8w    =  undefined
      real                            :: dx      =  undefined
      real                            :: qc      =  undefined
      real                            :: foln    =  1.0   ! foliage
      integer                         :: nsoil   = 4   ! hardwired to Noah
      integer                         :: nsnow   = 3   ! max. snow layers
      integer                         :: ist     = 1   ! soil type, 1 soil; 2  lake;  14 is water
      integer                         :: isc     = 4   ! middle day soil color: soil 1-9 lightest

      real(kind=kind_phys), save  :: zsoil(4),sldpth(4)
      data zsoil / -0.1, -0.4, -1.0, -2.0 /
      data sldpth /0.1, 0.3, 0.6, 1.0 /
!     data dzs /0.1, 0.3, 0.6, 1.0 /

!
!  ---  input:
!

      integer, intent(in) :: im, km, itime

      integer, dimension(im), intent(in) :: soiltyp, vegtype, slopetyp

      real (kind=kind_phys), dimension(im), intent(in) :: ps, u1, v1,   &
     &       t1, q1, sigmaf, sfcemis, dlwflx, dswsfc, snet, tg3, cm,    &
     &       ch, prsl1, prslki, wind, shdmin, shdmax,                   &
     &       snoalb, sfalb, zf,                                         &
     &       rainn_mp,rainc_mp,snow_mp,graupel_mp,ice_mp

      logical, dimension(im), intent(in) :: dry

      real (kind=kind_phys),dimension(im),intent(in) :: xlatin,xcoszin

      integer,  intent(in) ::  idveg, iopt_crs,iopt_btr,iopt_run,       &
     &                         iopt_sfc,iopt_frz,iopt_inf,iopt_rad,     &
     &                         iopt_alb,iopt_snf,iopt_tbot,iopt_stc

      real (kind=kind_phys),  intent(in) :: julian
      integer,  intent(in)               :: iyrlen

      real (kind=kind_phys),  intent(in) :: delt
      logical, dimension(im), intent(in) :: flag_iter, flag_guess

      logical, intent(in) :: lheatstrg

      real (kind=kind_phys),  intent(in) :: con_hvap, con_cp, con_jcal, &
     &                      rhoh2o, con_eps, con_epsm1, con_fvirt,      &
     &                      con_rd, con_hfus

!  ---  in/out:
      real (kind=kind_phys), dimension(im), intent(inout) :: weasd,     &
     &       snwdph, tskin, tprcp, srflag, canopy, trans, tsurf, zorl

      real (kind=kind_phys), dimension(im,km), intent(inout) ::         &
     &       smc, stc, slc

      real (kind=kind_phys), dimension(im), intent(inout) :: snowxy,    &
     &                      tvxy,tgxy,canicexy,canliqxy,eahxy,tahxy,    &
     &                      cmxy,chxy,fwetxy,sneqvoxy,alboldxy,qsnowxy, &
     &                      wslakexy,zwtxy,waxy,wtxy,lfmassxy,rtmassxy, &
     &                      stmassxy,woodxy,stblcpxy,fastcpxy,xlaixy,   &
     &                      xsaixy,taussxy,smcwtdxy,deeprechxy,rechxy

      real (kind=kind_phys),dimension(im,-2:0),intent(inout) :: tsnoxy
      real (kind=kind_phys),dimension(im,-2:0),intent(inout) :: snicexy
      real (kind=kind_phys),dimension(im,-2:0),intent(inout) :: snliqxy
      real (kind=kind_phys),dimension(im,1:4), intent(inout) :: smoiseq
      real (kind=kind_phys),dimension(im,-2:4),intent(inout) :: zsnsoxy

      integer, dimension(im)                   :: jsnowxy
      real (kind=kind_phys),dimension(im)      :: snodep
      real (kind=kind_phys),dimension(im,-2:4) :: tsnsoxy

!  ---  output:

      real (kind=kind_phys), dimension(im), intent(out) :: sncovr1,     &
     &       qsurf, gflux, drain, evap, hflx, ep, runoff, cmm, chh,     &
     &    evbs, evcw, sbsno, snowc, stm, snohf, smcwlt2, smcref2, wet1
      real (kind=kind_phys), dimension(:), intent(out) :: t2mmp, q2mp

! error messages
      character(len=*), intent(out)    :: errmsg
      integer,          intent(out)    :: errflg

!  ---  locals:
      real (kind=kind_phys), dimension(im) :: rch, rho,                 &
     &       q0, qs1, theta1, tv1,  weasd_old, snwdph_old,              &
     &       tprcp_old, srflag_old, tskin_old, canopy_old

      real (kind=kind_phys), dimension(km) :: et,stsoil,smsoil, slsoil

      real (kind=kind_phys),dimension(im,km) :: smc_old,stc_old,slc_old

      real (kind=kind_phys), dimension(im) :: snow_old, tv_old,tg_old,  &
     &       canice_old,canliq_old,eah_old,tah_old,fwet_old,sneqvo_old, &
     &       albold_old,qsnow_old,wslake_old,zwt_old,wa_old,wt_old,     &
     &       lfmass_old,rtmass_old,stmass_old,wood_old,stblcp_old,      &
     &       fastcp_old,xlai_old,xsai_old,tauss_old,smcwtd_old,         &
     &       deeprech_old,rech_old

      real(kind=kind_phys),dimension(im,1:4)  :: smoiseq_old
      real(kind=kind_phys),dimension(im,-2:0) :: tsno_old
      real(kind=kind_phys),dimension(im,-2:0) :: snice_old
      real(kind=kind_phys),dimension(im,-2:0) :: snliq_old
      real(kind=kind_phys),dimension(im,-2:4) :: zsnso_old
      real(kind=kind_phys),dimension(im,-2:4) :: tsnso_old

      real (kind=kind_phys) :: alb, albedo, beta, chx, cmx, cmc,        &
     &       dew, drip, dqsdt2, ec, edir, ett, eta, esnow, etp,         &
     &       flx1, flx2, flx3, ffrozp, lwdn, pc, prcp, ptu, q2,         &
     &       q2sat, solnet, rc, rcs, rct, rcq, rcsoil, rsmin,           &
     &       runoff1, runoff2, runoff3, sfcspd, sfcprs, sfctmp,         &
     &       sfcems, sheat, shdfac, shdmin1d, shdmax1d, smcwlt,         &
     &       smcdry, smcref, smcmax, sneqv, snoalb1d, snowh,            &
     &       snomlt, sncovr, soilw, soilm, ssoil, tsea, th2,            &
     &       xlai, zlvl, swdn, tem, psfc,fdown,t2v,tbot

      real (kind=kind_phys) :: pconv,pnonc,pshcv,psnow,pgrpl,phail
      real (kind=kind_phys) :: lat,cosz,uu,vv,swe
      integer               :: isnowx

      real (kind=kind_phys) :: tvx,tgx,canicex,canliqx,eahx,            &
     &       tahx,fwetx,sneqvox,alboldx,qsnowx,wslakex,zwtx,            &
     &       wax,wtx,lfmassx, rtmassx,stmassx, woodx,stblcpx,           &
     &       fastcpx,xlaix,xsaix,taussx,smcwtdx,deeprechx,rechx,        &
     &       qsfc1d

      real (kind=kind_phys), dimension(-2:0) :: tsnox, snicex, snliqx
      real (kind=kind_phys), dimension(-2:0) :: ficeold
      real (kind=kind_phys), dimension( km ) :: smoiseqx
      real (kind=kind_phys), dimension(-2:4) :: zsnsox
      real (kind=kind_phys), dimension(-2:4) :: tsnsox

      real (kind=kind_phys) :: z0wrf,fsa,fsr,fira,fsh,fcev,fgev,        &
     &                         fctr,ecan,etran,trad,tgb,tgv,t2mv,       &
     &                         t2mb,q2v,q2b,runsrf,runsub,apar,         &
     &                         psn,sav,sag,fsno,nee,gpp,npp,fveg,       &
     &                         qsnbot,ponding,ponding1,ponding2,        &
     &                         rssun,rssha,bgap,wgap,chv,chb,emissi,    &
     &                         shg,shc,shb,evg,evb,ghv,ghb,irg,irc,     &
     &                         irb,tr,evc,chleaf,chuc,chv2,chb2,        &
     &                         fpice,pahv,pahg,pahb,pah,co2pp,o2pp,ch2b

      real (kind=kind_phys) :: cpfac

      integer :: i, k, ice, stype, vtype ,slope,nroot,couple
      logical :: flag(im)
      logical :: snowng,frzgra

      !  ---  local derived constants:

      real(kind=kind_phys) :: cpinv, hvapi, convrad, elocp

      type(noahmp_parameters) :: parameters

!
!===> ...  begin here
!
      cpinv   = 1.0/con_cp
      hvapi   = 1.0/con_hvap
      convrad = con_jcal*1.e4/60.0
      elocp   = con_hvap/con_cp

! Initialize CCPP error handling variables
      errmsg = ''
      errflg = 0

!  --- ...  set flag for land points

      do i = 1, im
        flag(i) = dry(i)
      enddo

!  --- ...  save land-related prognostic fields for guess run

      do i = 1, im
        if (flag(i) .and. flag_guess(i)) then
          weasd_old(i)  = weasd(i)
          snwdph_old(i) = snwdph(i)
          tskin_old(i)  = tskin(i)
          canopy_old(i) = canopy(i)
          tprcp_old(i)  = tprcp(i)
          srflag_old(i) = srflag(i)
!
!
          snow_old(i)   = snowxy(i)
          tv_old(i)     = tvxy(i)
          tg_old(i)     = tgxy(i)
          canice_old(i) = canicexy(i)
          canliq_old(i) = canliqxy(i)
          eah_old(i)    = eahxy(i)
          tah_old(i)    = tahxy(i)
          fwet_old(i)   = fwetxy(i)
          sneqvo_old(i) = sneqvoxy(i)
          albold_old(i) = alboldxy(i)
          qsnow_old(i)  = qsnowxy(i)
          wslake_old(i) = wslakexy(i)
          zwt_old(i)    = zwtxy(i)
          wa_old(i)     = waxy(i)
          wt_old(i)     = wtxy(i)
          lfmass_old(i) = lfmassxy(i)
          rtmass_old(i) = rtmassxy(i)
          stmass_old(i) = stmassxy(i)
          wood_old(i)   = woodxy(i)
          stblcp_old(i) = stblcpxy(i)
          fastcp_old(i) = fastcpxy(i)
          xlai_old(i)   = xlaixy(i)
          xsai_old(i)   = xsaixy(i)
          tauss_old(i)  = taussxy(i)
          smcwtd_old(i) = smcwtdxy(i)
          rech_old(i)   = rechxy(i)

          deeprech_old(i) = deeprechxy(i)
!
          do k = 1, km
           smc_old(i,k) = smc(i,k)
           stc_old(i,k) = stc(i,k)
           slc_old(i,k) = slc(i,k)
          enddo

!
          do k = 1, km
            smoiseq_old(i,k) = smoiseq(i,k)
          enddo

          do k = -2,0
           tsno_old(i,k)  = tsnoxy(i,k)
           snice_old(i,k) = snicexy(i,k)
           snliq_old(i,k) = snliqxy(i,k)
          enddo

          do k = -2,4
            zsnso_old (i,k) = zsnsoxy(i,k)
          enddo

        endif
      enddo

!
!   call to init MP options
!
!    &_________________________________________________________________ &

!  --- ...  initialization block

      do i = 1, im
        if (flag_iter(i) .and. flag(i)) then
          ep(i)     = 0.0
          evap (i)  = 0.0
          hflx (i)  = 0.0
          gflux(i)  = 0.0
          drain(i)  = 0.0
          canopy(i) = max(canopy(i), 0.0)

          evbs (i)  = 0.0
          evcw (i)  = 0.0
          trans(i)  = 0.0
          sbsno(i)  = 0.0
          snowc(i)  = 0.0
          snohf(i)  = 0.0
        endif
      enddo

!  --- ...  initialize variables

      do i = 1, im
        if (flag_iter(i) .and. flag(i)) then
          q0(i)   = max(q1(i), 1.e-8)   !* q1=specific humidity at level 1 (kg/kg)
          theta1(i) = t1(i) * prslki(i) !* adiabatic temp at level 1 (k)

          tv1(i) = t1(i) * (1.0 + con_fvirt*q0(i))
          rho(i) = prsl1(i) / (con_rd * tv1(i))
          qs1(i) = fpvs( t1(i) )        !* qs1=sat. humidity at level 1 (kg/kg)
          qs1(i) = con_eps*qs1(i) / (prsl1(i) + con_epsm1*qs1(i))
          qs1(i) = max(qs1(i), 1.e-8)
          q0 (i) = min(qs1(i), q0(i))

          if (vegtype(i) == isice_table ) then
              if (weasd(i) < 0.1) then
                 weasd(i)  = 0.1
               endif
          endif

         endif
        enddo

!  --- ...  noah: prepare variables to run noah lsm
!   1. configuration information (c):
!      ------------------------------
!    couple  - couple-uncouple flag (=1: coupled, =0: uncoupled)
!    ffrozp  - fraction for snow-rain (1.=snow, 0.=rain,  0-1 mixed))
!    ice     - sea-ice flag (=1: sea-ice, =0: land)
!    dt      - timestep (sec) (dt should not exceed 3600 secs) = delt
!    zlvl    - height (m) above ground of atmospheric forcing variables
!    nsoil   - number of soil layers (at least 2)
!    sldpth  - the thickness of each soil layer (m)

      do i = 1, im

        if (flag_iter(i) .and. flag(i)) then

          couple = 1

          ice    = 0
          nsoil  = km
          snowng = .false.
          frzgra = .false.

!         if     (srflag(i) == 1.0) then  ! snow phase
!           ffrozp = 1.0
!         elseif (srflag(i) == 0.0) then  ! rain phase
!           ffrozp = 0.0
!         endif
! use srflag directly to allow fractional rain/snow
          ffrozp = srflag(i)

          zlvl = zf(i)

!   2. forcing data (f):
!      -----------------
!    lwdn    - lw dw radiation flux (w/m2)
!    solnet  - net sw radiation flux (dn-up) (w/m2)
!    sfcprs  - pressure at height zlvl above ground (pascals)
!    prcp    - precip rate (kg m-2 s-1)
!    sfctmp  - air temperature (k) at height zlvl above ground
!    th2     - air potential temperature (k) at height zlvl above ground
!    q2      - mixing ratio at height zlvl above ground (kg kg-1)

          lat    = xlatin(i)                 ! in radian
          cosz   = xcoszin(i)

          lwdn   = dlwflx(i)         !..downward lw flux at sfc in w/m2
          swdn   = dswsfc(i)         !..downward sw flux at sfc in w/m2
          solnet = snet(i)           !..net sw rad flx (dn-up) at sfc in w/m2
          sfcems = sfcemis(i)

          sfctmp = t1(i)
          sfcprs = prsl1(i)
          psfc   = ps(i)
          prcp   = rhoh2o * tprcp(i) / delt

        if (prcp > 0.0) then
          if (ffrozp > 0.0) then                   ! rain/snow flag, one condition is enough?
            snowng = .true.
            qsnowxy(i) = ffrozp * prcp/10.0                 !still use rho water?
          else
            if (sfctmp <= 275.15) frzgra = .true.
          endif
        endif

          th2    = theta1(i)
          q2     = q0(i)

!   3. other forcing (input) data (i):
!      ------------------------------
!    sfcspd  - wind speed (m s-1) at height zlvl above ground
!    q2sat   - sat mixing ratio at height zlvl above ground (kg kg-1)
!    dqsdt2  - slope of sat specific humidity curve at t=sfctmp (kg kg-1 k-1)

          uu     = u1(i)
          vv     = v1(i)

          sfcspd = wind(i)
          q2sat =  qs1(i)
          dqsdt2 = q2sat * a23m4/(sfctmp-a4)**2

!   4. canopy/soil characteristics (s):
!      --------------------------------
!    vegtyp  - vegetation type (integer index)                       -> vtype
!    soiltyp - soil type (integer index)                             -> stype
!    slopetyp- class of sfc slope (integer index)                    -> slope
!    shdfac  - areal fractional coverage of green vegetation (0.0-1.0)
!    shdmin  - minimum areal fractional coverage of green vegetation -> shdmin1d
!    ptu     - photo thermal unit (plant phenology for annuals/crops)
!    alb     - backround snow-free surface albedo (fraction)
!    snoalb  - upper bound on maximum albedo over deep snow          -> snoalb1d
!    tbot    - bottom soil temperature (local yearly-mean sfc air temp)

          vtype = vegtype(i)
          stype = soiltyp(i)
          slope = slopetyp(i)
          shdfac= sigmaf(i)

          shdmin1d = shdmin(i)
          shdmax1d = shdmax(i)
          snoalb1d = snoalb(i)

          alb  = sfalb(i)

          tbot = tg3(i)
          ptu  = 0.0

          cmc = canopy(i)/1000.              ! convert from mm to m
          tsea = tsurf(i)                    ! clu_q2m_iter

          snowh = snwdph(i) * 0.001         ! convert from mm to m
          sneqv = weasd(i)  * 0.001         ! convert from mm to m

!   5. history (state) variables (h):
!      ------------------------------
!    cmc     - canopy moisture content (m)
!    t1      - ground/canopy/snowpack) effective skin temperature (k)   -> tsea
!    stc(nsoil) - soil temp (k)                                         -> stsoil
!    smc(nsoil) - total soil moisture content (volumetric fraction)     -> smsoil
!    sh2o(nsoil)- unfrozen soil moisture content (volumetric fraction)  -> slsoil
!    snowh   - actual snow depth (m)
!    sneqv   - liquid water-equivalent snow depth (m)
!    albedo  - surface albedo including snow effect (unitless fraction)
!    ch      - surface exchange coefficient for heat and moisture (m s-1) -> chx
!    cm      - surface exchange coefficient for momentum (m s-1)          -> cmx

          isnowx   = nint(snowxy(i))
          tvx      = tvxy(i)
          tgx      = tgxy(i)
          canliqx  = canliqxy(i)    !in mm
          canicex  = canicexy(i)

          eahxy(i) = (ps(i)*q2)/(0.622+q2) ! use q0 to reinit;
          eahx     = eahxy(i)
          tahx     = tahxy(i)

          co2pp    = co2_table * sfcprs
          o2pp     = o2_table  * sfcprs
          fwetx    = fwetxy(i)

          sneqvox  = sneqvoxy(i)
          alboldx  = alboldxy(i)

          qsnowx   = qsnowxy(i)
          wslakex  = wslakexy(i)

          zwtx     = zwtxy(i)
          wax      = waxy(i)
          wtx      = waxy(i)

          do k = -2,0
           tsnsoxy(i,k) = tsnoxy(i,k)
          enddo

          do k = 1,4
           tsnsoxy(i,k) = stc(i,k)
          enddo

         do k = -2,0
              snicex(k)  = snicexy(i,k)       ! in k/m3; mm
              snliqx(k)  = snliqxy(i,k)       ! in k/m3; mm
              tsnox (k)  = tsnoxy(i,k)

              ficeold(k) = 0.0                ! derived

              if (snicex(k) > 0.0 ) then
               ficeold(k) = snicex(k) /(snicex(k)+snliqx(k))

              endif
         enddo

          do k = -2, km
            zsnsox(k)  = zsnsoxy(i,k)
            tsnsox(k)  = tsnsoxy(i,k)
          enddo

          lfmassx  = lfmassxy(i)
          rtmassx  = rtmassxy(i)
          stmassx  = stmassxy(i)

          woodx    = woodxy(i)
          stblcpx  = stblcpxy(i)
          fastcpx  = fastcpxy(i)

          xsaix    = xsaixy(i)
          xlaix    = xlaixy(i)

          taussx   = taussxy(i)

          qsfc1d   = undefined              ! derive later, it is an in/out?
          swe      = weasd(i)

          do k = 1, km
            smoiseqx(k)  = smoiseq(i,k)
          enddo

          smcwtdx        = smcwtdxy(i)
          rechx          = rechxy(i)
          deeprechx      = deeprechxy(i)
!--
!   the optional details for precip
!--

!         pconv = 0.                      !     convective - may introduce later
!         pnonc = (1 - ffrozp) * prcp                    !     large scale total in mm/s;
!         pshcv = 0.
!         psnow = ffrozp * prcp /10.0     !      snow = qsnowx?
!         pgrpl = 0.
!         phail = 0.
          pnonc = rainn_mp(i)
          pconv = rainc_mp(i)
          pshcv = 0.
          psnow = snow_mp(i)
          pgrpl = graupel_mp(i)
          phail = ice_mp(i)
!
!-- old
!
          do k = 1, km
!           stsoil(k) = stc(i,k)
            smsoil(k) = smc(i,k)
            slsoil(k) = slc(i,k)
          enddo

          snowh = snwdph(i) * 0.001         ! convert from mm to m

          if (swe /= 0.0 .and. snowh == 0.0) then
            snowh = 10.0 * swe /1000.0
          endif

          chx    = chxy(i) ! maybe chxy
          cmx    = cmxy(i)

          chh(i) = ch(i)  * wind(i) * rho(i)
          cmm(i) = cm(i)  * wind(i)

       call transfer_mp_parameters(vtype,stype,slope,isc,parameters)

       call noahmp_options(idveg ,iopt_crs,iopt_btr,iopt_run,iopt_sfc,  &
     & iopt_frz,iopt_inf,iopt_rad,iopt_alb,iopt_snf,iopt_tbot,iopt_stc)

!
!  initialize heat capacity enhancement factor for heat storage parameterization
!
       cpfac = 1.0

        if ( vtype == isice_table )  then

          ice = -1
          tbot = min(tbot,263.15)

         call noahmp_options_glacier                                    &
     &   (idveg  ,iopt_crs  ,iopt_btr, iopt_run ,iopt_sfc ,iopt_frz,    &
     &   iopt_inf ,iopt_rad ,iopt_alb ,iopt_snf ,iopt_tbot, iopt_stc )

       call noahmp_glacier (                                            &
     &             i       ,1       ,cosz    ,nsnow   ,nsoil   ,delt  , & ! in : time/space/model-related
     &             sfctmp  ,sfcprs  ,uu      ,vv      ,q2      ,swdn  , & ! in : forcing
     &             prcp    ,lwdn    ,tbot    ,zlvl    ,ficeold ,zsoil , & ! in : forcing
     &             qsnowx  ,sneqvox ,alboldx ,cmx     ,chx     ,isnowx, & ! in/out :sneqvox + alboldx -LST
     &             swe  ,smsoil  ,zsnsox     ,snowh  ,snicex ,snliqx ,  & ! in/out : sneqvx + snowhx are avgd
     &             tgx     ,tsnsox  ,slsoil  ,taussx  ,qsfc1d         , & ! in/out :
     &             fsa     ,fsr     ,fira    ,fsh     ,fgev  ,ssoil   , & ! out :
     &             trad    ,edir    ,runsrf  ,runsub  ,sag   ,albedo  , & ! out : albedo is surface albedo
     &             qsnbot  ,ponding ,ponding1,ponding2,t2mb  ,q2b     , & ! out :
#ifdef CCPP
     &             emissi  ,fpice   ,ch2b    ,esnow, errmsg, errflg )
#else
     &             emissi  ,fpice   ,ch2b    ,esnow )
#endif

#ifdef CCPP
       if (errflg /= 0) return
#endif
!
! in/out and outs
!

         fsno    = 1.0

         tvx     = undefined
         canicex = undefined
         canliqx = undefined
         eahx    = undefined
         tahx    = undefined

         fwetx   = undefined
         wslakex = undefined
         zwtx    = undefined
         wax     = undefined
         wtx     = undefined

         lfmassx = undefined
         rtmassx = undefined
         stmassx = undefined
         woodx   = undefined
         stblcpx = undefined
         fastcpx = undefined
         xlaix   = undefined
         xsaix   = undefined

         smcwtdx = 0.0
         rechx   = 0.0
         deeprechx       = 0.0

         do k = 1,4
         smoiseqx(k)   = smsoil(k)
         enddo

        fctr    = undefined
        fcev    = undefined

        z0wrf  = 0.002

        eta    = fgev
        t2mmp(i) = t2mb
        q2mp(i) = q2b
!
! Non-glacial case
!
        else
                 ice = 0

!        write(*,*)'tsnsox(1)=',tsnsox,'tgx=',tgx
       call noahmp_sflx (parameters                                    ,&
     &        i       , 1       , lat     , iyrlen  , julian  , cosz   ,& ! in : time/space-related
     &        delt    , dx      , dz8w    , nsoil   , zsoil   , nsnow  ,& ! in : model configuration
     &        shdfac  , shdmax1d, vtype   , ice     , ist              ,& ! in : vegetation/soil
     &        smoiseqx                                                 ,& ! in
     &        sfctmp  , sfcprs  , psfc    , uu      , vv      , q2     ,& ! in : forcing
     &        qc      , swdn    , lwdn                                 ,& ! in : forcing
     &        pconv   , pnonc   , pshcv   , psnow   , pgrpl   , phail  ,& ! in : forcing
     &        tbot    , co2pp   , o2pp    , foln    , ficeold , zlvl   ,& ! in : forcing
     &        lheatstrg                                                ,& ! in : canopy heat storage
     &        alboldx , sneqvox                                        ,& ! in/out :
     &        tsnsox  , slsoil  , smsoil  , tahx    , eahx    , fwetx  ,& ! in/out :
     &        canliqx , canicex , tvx     , tgx     , qsfc1d  , qsnowx ,& ! in/out :
     &        isnowx  , zsnsox  , snowh   , swe     , snicex  , snliqx ,& ! in/out :
     &        zwtx    , wax     , wtx     , wslakex , lfmassx , rtmassx,& ! in/out :
     &        stmassx , woodx   , stblcpx , fastcpx , xlaix   ,xsaix   ,& ! in/out :
     &        cmx     , chx     , taussx                               ,& ! in/out :
     &        smcwtdx ,deeprechx, rechx   , cpfac                      ,& ! in/out :
     &        z0wrf                                                    ,& ! out
     &        fsa     , fsr     , fira    , fsh     , ssoil   , fcev   ,& ! out :
     &        fgev    , fctr    , ecan    , etran   , edir    , trad   ,& ! out :
     &        tgb     , tgv     , t2mv    , t2mb    , q2v     , q2b    ,& ! out :
     &        runsrf  , runsub  , apar    , psn     , sav     , sag    ,& ! out :
     &        fsno    , nee     , gpp     , npp     , fveg    , albedo ,& ! out :
     &        qsnbot  , ponding , ponding1, ponding2, rssun   , rssha  ,& ! out :
     &        bgap    , wgap    , chv     , chb     , emissi           ,& ! out :
     &        shg     , shc     , shb     , evg     , evb     , ghv    ,&! out :
     &        ghb     , irg     , irc     , irb     , tr      , evc    ,& ! out :
     &        chleaf  , chuc    , chv2    , chb2    , fpice   , pahv   ,& ! out
#ifdef CCPP
     &        pahg    , pahb    , pah     , esnow, errmsg, errflg   )
#else
     &        pahg    , pahb    , pah     , esnow   )
#endif

#ifdef CCPP
       if (errflg /= 0) return
#endif

       eta  = fcev + fgev + fctr     ! the flux w/m2

       t2mmp(i) = t2mv*fveg+t2mb*(1-fveg)
       q2mp(i) = q2v*fveg+q2b*(1-fveg)

      endif          ! glacial split ends

!
! mp in/out
!
             snowxy   (i)                = float(isnowx)
             tvxy     (i)                = tvx
             tgxy     (i)                = tgx
             canliqxy (i)                = canliqx
             canicexy (i)                = canicex
             eahxy    (i)                = eahx
             tahxy    (i)                = tahx

             cmxy     (i)                = cmx
             chxy     (i)                = chx

             fwetxy   (i)                = fwetx
             sneqvoxy (i)                = sneqvox
             alboldxy (i)                = alboldx
             qsnowxy  (i)                = qsnowx

             wslakexy (i)                = wslakex
             zwtxy    (i)                = zwtx
             waxy     (i)                = wax
             wtxy     (i)                = wtx

             do k = -2,0
             tsnoxy   (i,k) = tsnsox(k)
             snicexy  (i,k) = snicex (k)
             snliqxy  (i,k) = snliqx (k)
             enddo

             do k = -2,4
             zsnsoxy  (i,k) = zsnsox(k)
             enddo

             lfmassxy (i)                = lfmassx
             rtmassxy (i)                = rtmassx
             stmassxy (i)                = stmassx
             woodxy   (i)                = woodx
             stblcpxy (i)                = stblcpx
             fastcpxy (i)                = fastcpx

             xlaixy   (i)                = xlaix
             xsaixy   (i)                = xsaix

             taussxy  (i)                = taussx

             rechxy   (i)                = rechx
             deeprechxy(i)               = deeprechx
             smcwtdxy(i)                 = smcwtdx
             smoiseq(i,1:4)              = smoiseqx(1:4)

!
! generic in/outs
!
          do k = 1, km
            stc(i,k) = tsnsox(k)
            smc(i,k) = smsoil(k)
            slc(i,k) = slsoil(k)
          enddo

          canopy(i)  = canicex + canliqx
          weasd(i)   = swe
          snwdph(i)  = snowh * 1000.0

!         write(*,*) 'swe,snowh,can'
!         write (*,*) swe,snowh*1000.0,canopy(i)
!
          smcmax = smcmax_table(stype)
          smcref = smcref_table(stype)
          smcwlt = smcdry_table(stype)
!
! outs
!
          wet1(i)    = smsoil(1) / smcmax
          smcwlt2(i) = smcwlt
          smcref2(i) = smcref

          runoff(i)  = runsrf
          drain(i)   = runsub

          zorl(i)    = z0wrf * 100.0

          sncovr1(i) = fsno
          snowc  (i) = fsno

          sbsno(i)   = esnow
          gflux(i)   = -1.0*ssoil
          hflx(i)    = fsh
          evbs(i)    = fgev
          evcw(i)    = fcev
          trans(i)   = fctr
          evap(i)    = eta

!         write(*,*) 'vtype, stype are',vtype,stype
!         write(*,*) 'fsh,gflx,eta',fsh,ssoil,eta
!         write(*,*) 'esnow,runsrf,runsub',esnow,runsrf,runsub
!         write(*,*) 'evbs,evcw,trans',fgev,fcev,fctr
!         write(*,*) 'snowc',fsno

          tsurf(i)   = trad

          stm(i) = (0.1*smsoil(1)+0.3*smsoil(2)+0.6*smsoil(3)+           &
     &              1.0*smsoil(4))*1000.0  ! unit conversion from m to kg m-2
!
          snohf (i) = qsnbot * con_hfus  ! only part of it but is diagnostic
!         write(*,*) 'snohf',snohf(i)

          fdown     = fsa + lwdn
          t2v       = sfctmp * (1.0 + 0.61*q2)
!         ssoil     = -1.0 *ssoil

       call penman (sfctmp,sfcprs,chx,t2v,th2,prcp,fdown,ssoil,         &
     &   cpfac,q2,q2sat,etp,snowng,frzgra,ffrozp,dqsdt2,emissi,fsno)

          ep(i) = etp

        endif   ! end if_flag_iter_and_flag_block
      enddo   ! end do_i_loop

!   --- ...  compute qsurf (specific humidity at sfc)

      do i = 1, im
        if (flag_iter(i) .and. flag(i)) then
          rch(i)   = rho(i) * con_cp * ch(i) * wind(i)
          qsurf(i) = q1(i)  + evap(i) / (elocp * rch(i))
        endif
      enddo

      do i = 1, im
        if (flag_iter(i) .and. flag(i)) then
          tem     = 1.0 / rho(i)
          hflx(i) = hflx(i) * tem * cpinv
          evap(i) = evap(i) * tem * hvapi
        endif
      enddo

!  --- ...  restore land-related prognostic fields for guess run

      do i = 1, im
        if (flag(i)) then
          if (flag_guess(i)) then
            weasd(i)  = weasd_old(i)
            snwdph(i) = snwdph_old(i)
            tskin(i)  = tskin_old(i)
            canopy(i) = canopy_old(i)
            tprcp(i)  = tprcp_old(i)
            srflag(i) = srflag_old(i)

            snowxy(i) =  snow_old(i)
            tvxy(i)   =  tv_old(i)
            tgxy(i)   =  tg_old(i)

            canicexy(i)   = canice_old(i)
            canliqxy(i)   = canliq_old(i)
            eahxy(i)      = eah_old(i)
            tahxy(i)      = tah_old(i)
            fwetxy(i)     = fwet_old(i)
            sneqvoxy(i)   = sneqvo_old(i)
            alboldxy(i)   = albold_old(i)
            qsnowxy(i)    = qsnow_old(i)
            wslakexy(i)   = wslake_old(i)
            zwtxy(i)      = zwt_old(i)
            waxy(i)       = wa_old(i)
            wtxy(i)       = wt_old(i)
            lfmassxy(i)   = lfmass_old(i)
            rtmassxy(i)   = rtmass_old(i)
            stmassxy(i)   = stmass_old(i)
            woodxy(i)     = wood_old(i)
            stblcpxy(i)   = stblcp_old(i)
            fastcpxy(i)   = fastcp_old(i)
            xlaixy(i)     = xlai_old(i)
            xsaixy(i)     = xsai_old(i)
            taussxy(i)    = tauss_old(i)
            smcwtdxy(i)   = smcwtd_old(i)
            deeprechxy(i) = deeprech_old(i)
            rechxy(i)     = rech_old(i)

            do k = 1, km
              smc(i,k) = smc_old(i,k)
              stc(i,k) = stc_old(i,k)
              slc(i,k) = slc_old(i,k)
            enddo
!
            do k = 1, km
              smoiseq(i,k) = smoiseq_old(i,k)
            enddo

            do k = -2,0
              tsnoxy(i,k)  = tsno_old(i,k)
              snicexy(i,k) = snice_old(i,k)
              snliqxy(i,k) = snliq_old(i,k)
            enddo

            do k = -2,4
              zsnsoxy(i,k) =  zsnso_old(i,k)
            enddo
       else
            tskin(i) = tsurf(i)
          endif
        endif
      enddo
!
      return
!...................................
      end subroutine noahmpdrv_run
!-----------------------------------

      subroutine transfer_mp_parameters (vegtype,soiltype,slopetype,    &
     &                                          soilcolor,parameters)

        use noahmp_tables
        use module_sf_noahmplsm

        implicit none

        integer, intent(in)    :: vegtype
        integer, intent(in)    :: soiltype
        integer, intent(in)    :: slopetype
        integer, intent(in)    :: soilcolor

        type (noahmp_parameters), intent(out) :: parameters

        real    :: refdk
        real    :: refkdt
        real    :: frzk
        real    :: frzfact

        parameters%iswater   =  iswater_table
        parameters%isbarren  =  isbarren_table
        parameters%isice     =  isice_table
        parameters%eblforest =  eblforest_table

!-----------------------------------------------------------------------&
        parameters%urban_flag = .false.
        if( vegtype == isurban_table .or. vegtype == 31                 &
     &         .or.vegtype  == 32 .or. vegtype == 33) then
           parameters%urban_flag = .true.
        endif

!------------------------------------------------------------------------------------------!
! transfer veg parameters
!------------------------------------------------------------------------------------------!

        parameters%ch2op  =  ch2op_table(vegtype)       !maximum intercepted h2o per unit lai+sai (mm)
        parameters%dleaf  =  dleaf_table(vegtype)       !characteristic leaf dimension (m)
        parameters%z0mvt  =  z0mvt_table(vegtype)       !momentum roughness length (m)
        parameters%hvt    =    hvt_table(vegtype)       !top of canopy (m)
        parameters%hvb    =    hvb_table(vegtype)       !bottom of canopy (m)
        parameters%den    =    den_table(vegtype)       !tree density (no. of trunks per m2)
        parameters%rc     =     rc_table(vegtype)       !tree crown radius (m)
        parameters%mfsno  =  mfsno_table(vegtype)       !snowmelt m parameter ()
        parameters%saim   =   saim_table(vegtype,:)     !monthly stem area index, one-sided
        parameters%laim   =   laim_table(vegtype,:)     !monthly leaf area index, one-sided
        parameters%sla    =    sla_table(vegtype)       !single-side leaf area per kg [m2/kg]
        parameters%dilefc = dilefc_table(vegtype)       !coeficient for leaf stress death [1/s]
        parameters%dilefw = dilefw_table(vegtype)       !coeficient for leaf stress death [1/s]
        parameters%fragr  =  fragr_table(vegtype)       !fraction of growth respiration  !original was 0.3
        parameters%ltovrc = ltovrc_table(vegtype)       !leaf turnover [1/s]

        parameters%c3psn  =  c3psn_table(vegtype)       !photosynthetic pathway: 0. = c4, 1. = c3
        parameters%kc25   =   kc25_table(vegtype)       !co2 michaelis-menten constant at 25c (pa)
        parameters%akc    =    akc_table(vegtype)       !q10 for kc25
        parameters%ko25   =   ko25_table(vegtype)       !o2 michaelis-menten constant at 25c (pa)
        parameters%ako    =    ako_table(vegtype)       !q10 for ko25
        parameters%vcmx25 = vcmx25_table(vegtype)       !maximum rate of carboxylation at 25c (umol co2/m**2/s)
        parameters%avcmx  =  avcmx_table(vegtype)       !q10 for vcmx25
        parameters%bp     =     bp_table(vegtype)       !minimum leaf conductance (umol/m**2/s)
        parameters%mp     =     mp_table(vegtype)       !slope of conductance-to-photosynthesis relationship
        parameters%qe25   =   qe25_table(vegtype)       !quantum efficiency at 25c (umol co2 / umol photon)
        parameters%aqe    =    aqe_table(vegtype)       !q10 for qe25
        parameters%rmf25  =  rmf25_table(vegtype)       !leaf maintenance respiration at 25c (umol co2/m**2/s)
        parameters%rms25  =  rms25_table(vegtype)       !stem maintenance respiration at 25c (umol co2/kg bio/s)
        parameters%rmr25  =  rmr25_table(vegtype)       !root maintenance respiration at 25c (umol co2/kg bio/s)
        parameters%arm    =    arm_table(vegtype)       !q10 for maintenance respiration
        parameters%folnmx = folnmx_table(vegtype)       !foliage nitrogen concentration when f(n)=1 (%)
        parameters%tmin   =   tmin_table(vegtype)       !minimum temperature for photosynthesis (k)

        parameters%xl     =     xl_table(vegtype)       !leaf/stem orientation index
        parameters%rhol   =   rhol_table(vegtype,:)     !leaf reflectance: 1=vis, 2=nir
        parameters%rhos   =   rhos_table(vegtype,:)     !stem reflectance: 1=vis, 2=nir
        parameters%taul   =   taul_table(vegtype,:)     !leaf transmittance: 1=vis, 2=nir
        parameters%taus   =   taus_table(vegtype,:)     !stem transmittance: 1=vis, 2=nir

        parameters%mrp    =    mrp_table(vegtype)       !microbial respiration parameter (umol co2 /kg c/ s)
        parameters%cwpvt  =  cwpvt_table(vegtype)       !empirical canopy wind parameter

        parameters%wrrat  =  wrrat_table(vegtype)       !wood to non-wood ratio
        parameters%wdpool = wdpool_table(vegtype)       !wood pool (switch 1 or 0) depending on woody or not [-]
        parameters%tdlef  =  tdlef_table(vegtype)       !characteristic t for leaf freezing [k]

        parameters%nroot  =  nroot_table(vegtype)       !number of soil layers with root present
        parameters%rgl    =    rgl_table(vegtype)       !parameter used in radiation stress function
        parameters%rsmin  =     rs_table(vegtype)       !minimum stomatal resistance [s m-1]
        parameters%hs     =     hs_table(vegtype)       !parameter used in vapor pressure deficit function
        parameters%topt   =   topt_table(vegtype)       !optimum transpiration air temperature [k]
        parameters%rsmax  =  rsmax_table(vegtype)       !maximal stomatal resistance [s m-1]

!------------------------------------------------------------------------------------------!
! transfer rad parameters
!------------------------------------------------------------------------------------------!

         parameters%albsat    = albsat_table(soilcolor,:)
         parameters%albdry    = albdry_table(soilcolor,:)
         parameters%albice    = albice_table
         parameters%alblak    = alblak_table
         parameters%omegas    = omegas_table
         parameters%betads    = betads_table
         parameters%betais    = betais_table
         parameters%eg        = eg_table

!------------------------------------------------------------------------------------------!
! transfer global parameters
!------------------------------------------------------------------------------------------!

         parameters%co2       =    co2_table
         parameters%o2        =     o2_table
         parameters%timean    = timean_table
         parameters%fsatmx    = fsatmx_table
         parameters%z0sno     =  z0sno_table
         parameters%ssi       =    ssi_table
         parameters%swemx     =  swemx_table

! ----------------------------------------------------------------------
!  transfer soil parameters
! ----------------------------------------------------------------------

          parameters%bexp   = bexp_table   (soiltype)
          parameters%dksat  = dksat_table  (soiltype)
          parameters%dwsat  = dwsat_table  (soiltype)
          parameters%f1     = f1_table     (soiltype)
          parameters%psisat = psisat_table (soiltype)
          parameters%quartz = quartz_table (soiltype)
          parameters%smcdry = smcdry_table (soiltype)
          parameters%smcmax = smcmax_table (soiltype)
          parameters%smcref = smcref_table (soiltype)
          parameters%smcwlt = smcwlt_table (soiltype)

! ----------------------------------------------------------------------
! transfer genparm parameters
! ----------------------------------------------------------------------
          parameters%csoil  = csoil_table
          parameters%zbot   = zbot_table
          parameters%czil   = czil_table

          frzk   = frzk_table
          refdk  = refdk_table
          refkdt = refkdt_table
          parameters%kdt    = refkdt * parameters%dksat / refdk
          parameters%slope  = slope_table(slopetype)

          if(parameters%urban_flag)then  ! hardcoding some urban parameters for soil
             parameters%smcmax = 0.45
             parameters%smcref = 0.42
             parameters%smcwlt = 0.40
             parameters%smcdry = 0.40
             parameters%csoil  = 3.e6
          endif

      ! adjust frzk parameter to actual soil type: frzk * frzfact

!-----------------------------------------------------------------------&
          if(soiltype /= 14) then
            frzfact = (parameters%smcmax / parameters%smcref)           &
     &      * (0.412 / 0.468)
            parameters%frzx = frzk * frzfact
          end if

       end subroutine transfer_mp_parameters

!-----------------------------------------------------------------------&

      subroutine penman (sfctmp,sfcprs,ch,t2v,th2,prcp,fdown,ssoil,     &
     &                   cpfac,q2,q2sat,etp,snowng,frzgra,ffrozp,       &
     &                   dqsdt2,emissi_in,sncovr)

! etp is calcuated right after ssoil

! ----------------------------------------------------------------------
! subroutine penman
! ----------------------------------------------------------------------
! calculate potential evaporation for the current point.  various
! partial sums/products are also calculated and passed back to the
! calling routine for later use.
! ----------------------------------------------------------------------
      implicit none
      logical, intent(in)     :: snowng, frzgra
      real, intent(in)        :: ch, dqsdt2,fdown,prcp,ffrozp,          &
     &                           q2, q2sat,ssoil,cpfac, sfcprs, sfctmp, &
     &                           t2v, th2,emissi_in,sncovr
      real, intent(out)       :: etp
      real                    :: epsca,flx2,rch,rr,t24
      real                    :: a, delta, fnet,rad,rho,emissi,elcp1,lvs
      real                    :: elcpx

      real, parameter :: elcp = 2.4888e+3, lsubc = 2.501000e+6,cp = 1004.6
      real, parameter :: lsubs = 2.83e+6, rd = 287.05, cph2o = 4.1855e+3
      real, parameter :: cpice = 2.106e+3, lsubf   = 3.335e5
      real, parameter :: sigma = 5.6704e-8

! ----------------------------------------------------------------------
! executable code begins here:
! ----------------------------------------------------------------------
! ----------------------------------------------------------------------
! prepare partial quantities for penman equation.
! ----------------------------------------------------------------------
        emissi=emissi_in
        elcpx = elcp / cpfac
!       elcp1  = (1.0-sncovr)*elcpx  + sncovr*elcpx*lsubs/lsubc
        lvs    = (1.0-sncovr)*lsubc + sncovr*lsubs

      flx2 = 0.0
      delta = elcpx * dqsdt2
!     delta = elcp1 * dqsdt2
      t24 = sfctmp * sfctmp * sfctmp * sfctmp
       rr = t24 * 6.48e-8 / (sfcprs * ch) + 1.0
!     rr = emissi*t24 * 6.48e-8 / (sfcprs * ch) + 1.0
      rho = sfcprs / (rd * t2v)

! ----------------------------------------------------------------------
! adjust the partial sums / products with the latent heat
! effects caused by falling precipitation.
! ----------------------------------------------------------------------
      rch = rho * cp * cpfac * ch
      if (.not. snowng) then
         if (prcp >  0.0) rr = rr + cph2o * prcp / rch
      else
! ---- ...  fractional snowfall/rainfall
        rr = rr + (cpice*ffrozp+cph2o*(1.-ffrozp))                      &
     &       *prcp/rch
      end if

! ----------------------------------------------------------------------
! include the latent heat effects of frzng rain converting to ice on
! impact in the calculation of flx2 and fnet.
! ----------------------------------------------------------------------
!      fnet = fdown - sigma * t24- ssoil
      fnet = fdown -  emissi*sigma * t24- ssoil
      if (frzgra) then
         flx2 = - lsubf * prcp
         fnet = fnet - flx2
! ----------------------------------------------------------------------
! finish penman equation calculations.
! ----------------------------------------------------------------------
      end if
      rad = fnet / rch + th2- sfctmp
       a = elcpx * (q2sat - q2)
!     a = elcp1 * (q2sat - q2)
      epsca = (a * rr + rad * delta) / (delta + rr)
       etp = epsca * rch / lsubc
!     etp = epsca * rch / lvs

! ----------------------------------------------------------------------
      end subroutine penman

      end module noahmpdrv


	INTEGER FUNCTION NVXEAS  ( xlat, ylon, zdum, xlin, xele, xdum  )
C************************************************************************
C* NVXEAS								*
C*									*
C* This subroutine calls the routine which converts earth coordinates	*
C* (lat, lon) to image corrdinates (line, element).			*
C*									*
C* INTEGER NVXEAS  ( XLAT, YLON, ZDUM, XLIN, XELE, XDUM  )		*
C*									*
C* Input parameters:							*
C*	XLAT		REAL		Latitude			*
C*	YLON		REAL		Longitude			*
C*	ZDUM		REAL		Dummy arg			*
C*									*
C* Output Parameters:							*
C*	XLIN		REAL		Image line			*
C*	XELE		REAL		Image element			*
C*	XDUM		REAL		Dummy arg			*
C*									*
C* Return value:							*
C*			 0		OK				*
C*			-1		Unable to navigate point	*
C**									*
C* Log:									*
C* J. Cowie/COMET	 1/95	Added to allow GVAR nav			*
C* J. Cowie/COMET	12/00	Added RADR projection type		*
C* S. Chiswell/Unidata	 2/02	Added MSAT, GMSX, MOLL  projection type	*
C* S. Chiswell/Unidata	 8/06	Added MSG  projection type		*
C* M. James/Unidata	10/14	Added RECT projection type		*
C* M. James/Unidata	02/18	Added ABIN fixed grid projection type	*
C* S. Guan/NCEP          2/18   Added GOE4 for Netcd4 Himawari          *
C************************************************************************
	INCLUDE		'ERROR.PRM'
	INCLUDE		'SATDEF.CMN'
C
	INTEGER		GOSEAS, GVREAS, RDREAS, MSATEAS, GMSXEAS,
     +			MOLLEAS, MSGEAS, ABINEAS, GOSEAS4
C------------------------------------------------------------------------
C
C*	Call appropriate routine
C
	IF ( nvtypa .eq. 'MCGOES' ) THEN
	   iret = GOSEAS ( xlat, ylon, zdum, xlin, xele, xdum )
	ELSE IF ( nvtypa .eq. 'MCGOE4' ) THEN
	   iret = GOSEAS4 ( xlat, ylon, zdum, xlin, xele, xdum )
	ELSE IF ( nvtypa .eq. 'MCGVAR' ) THEN
	   iret = GVREAS ( xlat, ylon, zdum, xlin, xele, xdum )
	ELSE IF ( nvtypa .eq. 'MCRADR' ) THEN
	   iret = RDREAS ( xlat, ylon, zdum, xlin, xele, xdum )
	ELSE IF ( nvtypa .eq. 'MCMSAT' ) THEN
	   iret = MSATEAS ( xlat, ylon, zdum, xlin, xele, xdum )
	ELSE IF ( nvtypa .eq. 'MCMSG' ) THEN
	   iret = MSGEAS ( xlat, ylon, zdum, xlin, xele, xdum )
	ELSE IF ( nvtypa .eq. 'MCGMSX' ) THEN
	   iret = GMSXEAS ( xlat, ylon, zdum, xlin, xele, xdum )
	ELSE IF ( nvtypa .eq. 'MCMOLL' ) THEN
	   iret = MOLLEAS ( xlat, ylon, zdum, xlin, xele, xdum )
	ELSE IF ( nvtypa .eq. 'MCRECT' ) THEN
	   iret = RECTEAS ( xlat, ylon, zdum, xlin, xele, xdum )
	ELSE IF ( nvtypa .eq. 'MCABIN' ) THEN
	   iret = ABINEAS ( xlat, ylon, zdum, xlin, xele, xdum )
	ELSE
	   iret = -1
	END IF
C
	NVXEAS = iret
C
	RETURN
	END