landuse3.F90 Source File


This file depends on

sourcefile~~landuse3.f90~~EfferentGraph sourcefile~landuse3.f90 landuse3.F90 sourcefile~cable_define_types.f90 cable_define_types.F90 sourcefile~landuse3.f90->sourcefile~cable_define_types.f90 sourcefile~cable_iovars.f90 cable_iovars.F90 sourcefile~landuse3.f90->sourcefile~cable_iovars.f90 sourcefile~casa_dimension.f90 casa_dimension.F90 sourcefile~landuse3.f90->sourcefile~casa_dimension.f90 sourcefile~casa_param.f90 casa_param.F90 sourcefile~landuse3.f90->sourcefile~casa_param.f90 sourcefile~casa_phenology.f90 casa_phenology.F90 sourcefile~landuse3.f90->sourcefile~casa_phenology.f90 sourcefile~casa_variable.f90 casa_variable.F90 sourcefile~landuse3.f90->sourcefile~casa_variable.f90 sourcefile~landuse_constant.f90 landuse_constant.F90 sourcefile~landuse3.f90->sourcefile~landuse_constant.f90 sourcefile~cable_climate_type_mod.f90 cable_climate_type_mod.F90 sourcefile~cable_define_types.f90->sourcefile~cable_climate_type_mod.f90 sourcefile~cable_iovars.f90->sourcefile~cable_define_types.f90 sourcefile~casa_dimension.f90->sourcefile~cable_define_types.f90 sourcefile~casa_param.f90->sourcefile~casa_dimension.f90 sourcefile~casa_phenology.f90->sourcefile~casa_dimension.f90 sourcefile~casa_variable.f90->sourcefile~casa_dimension.f90 sourcefile~casa_variable.f90->sourcefile~casa_param.f90 sourcefile~landuse_constant.f90->sourcefile~cable_define_types.f90 sourcefile~landuse_constant.f90->sourcefile~casa_dimension.f90 sourcefile~cable_common.f90 cable_common.F90 sourcefile~cable_climate_type_mod.f90->sourcefile~cable_common.f90 sourcefile~grid_constants_cbl.f90 grid_constants_cbl.F90 sourcefile~cable_climate_type_mod.f90->sourcefile~grid_constants_cbl.f90 sourcefile~cable_runtime_opts_mod.f90 cable_runtime_opts_mod.F90 sourcefile~cable_common.f90->sourcefile~cable_runtime_opts_mod.f90

Files dependent on this one

sourcefile~~landuse3.f90~~AfferentGraph sourcefile~landuse3.f90 landuse3.F90 sourcefile~cable_mpimaster.f90 cable_mpimaster.F90 sourcefile~cable_mpimaster.f90->sourcefile~landuse3.f90 sourcefile~cable_serial.f90 cable_serial.F90 sourcefile~cable_serial.f90->sourcefile~landuse3.f90 sourcefile~landuse_inout.f90 landuse_inout.F90 sourcefile~landuse_inout.f90->sourcefile~landuse3.f90 sourcefile~cable_offline_driver.f90 cable_offline_driver.F90 sourcefile~cable_offline_driver.f90->sourcefile~cable_serial.f90

Source Code

MODULE landuse_variable
  use landuse_constant
  IMPLICIT NONE

  SAVE
  !*# Overview of `landuse_variable` module (landuse3.F90)
  !
  ! This MODULE applies land-use changes for CABLE.
  !
  ! This includes:
  !
  ! - plant functional type transitions
  ! - wood harvest
  ! - land management
  !
  !## Method
  !
  ! All variables in the CABLE restart file and the state variables will be
  ! calculated.
  !
  ! There are three groups of `landuse_mland` member variables. For example,
  ! let's say we have a variable named `var`, then:
  !
  ! - `luc%var_x(mland,mvmax)` contains data before land-use change,
  !   indexed on the number of land points (`mland`) and the maximum number of
  !   plant functional types (`mvmax`).
  ! - `luc%var_y(mland,mvmax)` contains data after land-use change, indexed
  !   on the number of land points (`mland`) and the maximum number of
  !   plant functional types (`mvmax`).
  ! - `lucmp%var(mp)` contains the variable data, indexed on the number of
  !   vegetation patches (`mp`).
  !
  ! The land-use change for each variable is applied in the form of a
  ! transformation matrix `T`, such that:
  !
  ! \[ \textbf{luc%var_y} = \textbf{luc%var_x} \cdot \textbf{T} \]
  !
  ! The procedure for applying a land-use transition is:
  !
  ! 1. Map a CABLE variable `var` from CABLE into a `landuse_mland` member
  !    variable `luc%var_x`.
  ! 2. Apply land-use change (either a plant functional type transition, wood
  !    harvest or other land management).
  ! 3. Write the value of `luc%var_x` into `luc%var_y`
  ! 4. Update the value of `mp` and write `luc%var_y` to `lucmp%var`
  !
  ! **WARNING:**
  !
  ! * There are external procedures in this file that should be
  ! moved to the `CONTAINS` clause of this module.
  ! * Any variables added to CABLE/CASA restart files must be reproduced here
  ! in both "landuse_mland" and "landuse_mp".
  !
  TYPE landuse_mland
    !! Variables indexed along land points and vegetation type
    ! patch generic
    INTEGER,   DIMENSION(:,:),       ALLOCATABLE :: iveg_x
    INTEGER,   DIMENSION(:,:),       ALLOCATABLE :: isoil_x
    INTEGER,   DIMENSION(:,:),       ALLOCATABLE :: soilorder_x
    INTEGER,   DIMENSION(:,:),       ALLOCATABLE :: phase_x
    real(r_2), DIMENSION(:,:),       ALLOCATABLE :: phen_x
    real(r_2), DIMENSION(:,:),       ALLOCATABLE :: aphen_x
    integer,   DIMENSION(:,:),       ALLOCATABLE :: doyphase3_x
    real(r_2), DIMENSION(:,:),       ALLOCATABLE :: frac_sapwood_x
    real(r_2), DIMENSION(:,:),       ALLOCATABLE :: sapwood_area_x
    INTEGER,   DIMENSION(:,:),       ALLOCATABLE :: isflag_x
    REAL(r_2), DIMENSION(:,:),       ALLOCATABLE :: patchfrac_x
    REAL(r_2), DIMENSION(:,:),       ALLOCATABLE :: lai_x
    REAL(r_2), DIMENSION(:,:),       ALLOCATABLE :: sla_x
    ! biophysical
    real(r_2), dimension(:,:,:), allocatable :: albsoilsn_x
    real(r_2), dimension(:,:,:), allocatable :: albedo_x
    real(r_2), dimension(:,:,:), allocatable :: albsoil_x
    real(r_2),dimension(:,:),   allocatable :: dgdtg_x
    real(r_2),dimension(:,:,:), allocatable :: gammzz_x
    real(r_2), dimension(:,:,:), allocatable :: tgg_x
    real(r_2), dimension(:,:,:), allocatable :: wb_x
    real(r_2), dimension(:,:,:), allocatable :: wbice_x
    real(r_2), dimension(:,:,:), allocatable :: tggsn_x
    real(r_2), dimension(:,:,:), allocatable :: ssdn_x
    real(r_2), dimension(:,:,:), allocatable :: smass_x
    real(r_2), dimension(:,:,:), allocatable :: sdepth_x
    real(r_2), dimension(:,:),   allocatable :: tss_x
    real(r_2), dimension(:,:),   allocatable :: rtsoil_x
    real(r_2), dimension(:,:),   allocatable :: runoff_x
    real(r_2), dimension(:,:),   allocatable :: rnof1_x
    real(r_2), dimension(:,:),   allocatable :: rnof2_x
    real(r_2), dimension(:,:),   allocatable :: ssdnn_x
    real(r_2), dimension(:,:),   allocatable :: snowd_x
    real(r_2), dimension(:,:),   allocatable :: snage_x
    real(r_2), dimension(:,:),   allocatable :: osnowd_x

    real(r_2), dimension(:,:),   allocatable :: cansto_x
    real(r_2), dimension(:,:),   allocatable :: ghflux_x
    real(r_2), dimension(:,:),   allocatable :: sghflux_x
    real(r_2), dimension(:,:),   allocatable :: ga_x
    real(r_2), dimension(:,:),   allocatable :: fev_x
    real(r_2), dimension(:,:),   allocatable :: fes_x
    real(r_2), dimension(:,:),   allocatable :: fhs_x
    real(r_2), dimension(:,:),   allocatable :: wbtot0_x
    real(r_2), dimension(:,:),   allocatable :: osnowd0_x
    real(r_2), dimension(:,:),   allocatable :: trad_x
    real(r_2), dimension(:,:),   allocatable :: GWwb_x
    real(r_2), dimension(:,:,:), allocatable :: cplantx_x
    real(r_2), dimension(:,:,:), allocatable :: csoilx_x

    REAL(r_2), DIMENSION(:,:),   ALLOCATABLE :: clabile_x
    REAL(r_2), DIMENSION(:,:,:), ALLOCATABLE :: cplant_x
    REAL(r_2), DIMENSION(:,:,:), ALLOCATABLE :: clitter_x
    REAL(r_2), DIMENSION(:,:,:), ALLOCATABLE :: csoil_x
    REAL(r_2), DIMENSION(:,:,:), ALLOCATABLE :: cwoodprod_x
    REAL(r_2), DIMENSION(:,:,:), ALLOCATABLE :: nplant_x
    REAL(r_2), DIMENSION(:,:,:), ALLOCATABLE :: nlitter_x
    REAL(r_2), DIMENSION(:,:,:), ALLOCATABLE :: nsoil_x
    REAL(r_2), DIMENSION(:,:),   ALLOCATABLE :: nsoilmin_x
    REAL(r_2), DIMENSION(:,:,:), ALLOCATABLE :: nwoodprod_x
    REAL(r_2), DIMENSION(:,:,:), ALLOCATABLE :: pplant_x
    REAL(r_2), DIMENSION(:,:,:), ALLOCATABLE :: plitter_x
    REAL(r_2), DIMENSION(:,:,:), ALLOCATABLE :: psoil_x
    REAL(r_2), DIMENSION(:,:),   ALLOCATABLE :: psoillab_x
    REAL(r_2), DIMENSION(:,:),   ALLOCATABLE :: psoilsorb_x
    REAL(r_2), DIMENSION(:,:),   ALLOCATABLE :: psoilocc_x
    REAL(r_2), DIMENSION(:,:,:), ALLOCATABLE :: pwoodprod_x

    INTEGER,   DIMENSION(:,:),       ALLOCATABLE :: iveg_y
    INTEGER,   DIMENSION(:,:),       ALLOCATABLE :: isoil_y
    INTEGER,   DIMENSION(:,:),       ALLOCATABLE :: soilorder_y
    INTEGER,   DIMENSION(:,:),       ALLOCATABLE :: phase_y
    real(r_2), DIMENSION(:,:),       ALLOCATABLE :: phen_y
    real(r_2), DIMENSION(:,:),       ALLOCATABLE :: aphen_y
    integer,   DIMENSION(:,:),       ALLOCATABLE :: doyphase3_y
    real(r_2), DIMENSION(:,:),       ALLOCATABLE :: frac_sapwood_y
    real(r_2), DIMENSION(:,:),       ALLOCATABLE :: sapwood_area_y
    INTEGER,   DIMENSION(:,:),       ALLOCATABLE :: isflag_y
    REAL(r_2), DIMENSION(:,:),   ALLOCATABLE :: patchfrac_y
    REAL(r_2), DIMENSION(:,:),   ALLOCATABLE :: lai_y
    REAL(r_2), DIMENSION(:,:),   ALLOCATABLE :: sla_y
    ! biophysical
    real(r_2), dimension(:,:,:), allocatable :: albsoilsn_y
    real(r_2), dimension(:,:,:), allocatable :: albedo_y
    real(r_2), dimension(:,:,:), allocatable :: albsoil_y
    real(r_2),dimension(:,:),   allocatable :: dgdtg_y
    real(r_2),dimension(:,:,:), allocatable :: gammzz_y
    real(r_2), dimension(:,:,:), allocatable :: tgg_y
    real(r_2), dimension(:,:,:), allocatable :: wb_y
    real(r_2), dimension(:,:,:), allocatable :: wbice_y
    real(r_2), dimension(:,:,:), allocatable :: tggsn_y
    real(r_2), dimension(:,:,:), allocatable :: ssdn_y
    real(r_2), dimension(:,:,:), allocatable :: smass_y
    real(r_2), dimension(:,:,:), allocatable :: sdepth_y
    real(r_2), dimension(:,:),   allocatable :: tss_y
    real(r_2), dimension(:,:),   allocatable :: rtsoil_y
    real(r_2), dimension(:,:),   allocatable :: runoff_y
    real(r_2), dimension(:,:),   allocatable :: rnof1_y
    real(r_2), dimension(:,:),   allocatable :: rnof2_y
    real(r_2), dimension(:,:),   allocatable :: ssdnn_y
    real(r_2), dimension(:,:),   allocatable :: snowd_y
    real(r_2), dimension(:,:),   allocatable :: snage_y
    real(r_2), dimension(:,:),   allocatable :: osnowd_y

    real(r_2), dimension(:,:),   allocatable :: cansto_y
    real(r_2), dimension(:,:),   allocatable :: ghflux_y
    real(r_2), dimension(:,:),   allocatable :: sghflux_y
    real(r_2), dimension(:,:),   allocatable :: ga_y
    real(r_2), dimension(:,:),   allocatable :: fev_y
    real(r_2), dimension(:,:),   allocatable :: fes_y
    real(r_2), dimension(:,:),   allocatable :: fhs_y
    real(r_2), dimension(:,:),   allocatable :: wbtot0_y
    real(r_2), dimension(:,:),   allocatable :: osnowd0_y
    real(r_2), dimension(:,:),   allocatable :: trad_y
    real(r_2), dimension(:,:),   allocatable :: GWwb_y
    real(r_2), dimension(:,:,:), allocatable :: cplantx_y
    real(r_2), dimension(:,:,:), allocatable :: csoilx_y

    REAL(r_2), DIMENSION(:,:),   ALLOCATABLE :: clabile_y
    REAL(r_2), DIMENSION(:,:,:), ALLOCATABLE :: cplant_y
    REAL(r_2), DIMENSION(:,:,:), ALLOCATABLE :: clitter_y
    REAL(r_2), DIMENSION(:,:,:), ALLOCATABLE :: csoil_y
    REAL(r_2), DIMENSION(:,:,:), ALLOCATABLE :: cwoodprod_y
    REAL(r_2), DIMENSION(:,:,:), ALLOCATABLE :: nplant_y
    REAL(r_2), DIMENSION(:,:,:), ALLOCATABLE :: nlitter_y
    REAL(r_2), DIMENSION(:,:,:), ALLOCATABLE :: nsoil_y
    REAL(r_2), DIMENSION(:,:),   ALLOCATABLE :: nsoilmin_y
    REAL(r_2), DIMENSION(:,:,:), ALLOCATABLE :: nwoodprod_y
    REAL(r_2), DIMENSION(:,:,:), ALLOCATABLE :: pplant_y
    REAL(r_2), DIMENSION(:,:,:), ALLOCATABLE :: plitter_y
    REAL(r_2), DIMENSION(:,:,:), ALLOCATABLE :: psoil_y
    REAL(r_2), DIMENSION(:,:),   ALLOCATABLE :: psoillab_y
    REAL(r_2), DIMENSION(:,:),   ALLOCATABLE :: psoilsorb_y
    REAL(r_2), DIMENSION(:,:),   ALLOCATABLE :: psoilocc_y
    REAL(r_2), DIMENSION(:,:,:), ALLOCATABLE :: pwoodprod_y

  ! landuse data
    REAL(r_2), DIMENSION(:,:),   ALLOCATABLE :: pftfrac
    REAL(r_2), DIMENSION(:,:),   ALLOCATABLE :: fharvw
    REAL(r_2), DIMENSION(:,:,:), ALLOCATABLE :: xluh2cable
    REAL(r_2), DIMENSION(:,:,:), ALLOCATABLE :: atransit
  END TYPE landuse_mland

  TYPE landuse_mp
   !! Variables indexed along the vegetation patches.

   ! generic patch properties
   integer,    dimension(:),        allocatable   :: iveg,isoil,soilorder,phase,isflag           !(mp)
   integer,    dimension(:),        allocatable   :: doyphase3                                   !(mp)
   real(r_2),  dimension(:),        allocatable   :: lat,lon                                     !(mp)
   real(r_2),  dimension(:),        allocatable   :: phen,aphen,frac_sapwood, sapwood_area       !(mp)
   real(r_2),  dimension(:),        allocatable   :: patchfrac,areacell,lai,sla               !float(mp)

   ! biophysical variables
   real(r_2),  dimension(:,:),      allocatable   :: albsoilsn,albedo,albsoil      !float(mp,rad)
   real(r_2),  dimension(:),        allocatable   :: dgdtg                         !double(mp)
   real(r_2),  dimension(:,:),      allocatable   :: gammzz                        !double(mp,soil)
   real(r_2),  dimension(:,:),      allocatable   :: tgg,wb,wbice                  !float(mp,soil)
   real(r_2),  dimension(:,:),      allocatable   :: tggsn,ssdn,smass,sdepth       !float(mp,snow)
   real(r_2),  dimension(:),        allocatable   :: tss,rtsoil,runoff,rnof1,rnof2, &
                                                         ssdnn,snowd,snage,osnowd,      &
                                                         cansto,ghflux,sghflux,ga,      &
                                                         fev,fes,fhs,wbtot0,osnowd0,    &
                                                         trad,GWwb                     !float(mp)
   real(r_2),  dimension(:,:),      allocatable   :: cplantx, csoilx               !float(mp,plant_carbon_pools/soil_carbon_pools)

   ! biogeochemical variables
   real(r_2),  dimension(:),        allocatable   :: sumcbal,sumnbal,sumpbal                              !float(mp)
   real(r_2),  dimension(:),        allocatable   :: clabile,nsoilmin,psoillab,psoilsorb,psoilocc         !float(mp)
   real(r_2),  dimension(:,:),      allocatable   :: cplant,nplant,pplant                                 !float(mp,mplant)
   real(r_2),  dimension(:,:),      allocatable   :: clitter,nlitter,plitter                              !float(mp,mlitter)
   real(r_2),  dimension(:,:),      allocatable   :: csoil,nsoil,psoil                                    !float(mp,msoil)
   real(r_2),  dimension(:,:),      allocatable   :: cwoodprod,nwoodprod,pwoodprod                        !float(mp,mwood)

 END TYPE landuse_mp

 CONTAINS

  SUBROUTINE landuse_allocate_mland(imland,luc)
  !! Allocates the `luc%%var(imland,mvmax)` variables
  !!
  !! **WARNING:** Need to use a separate ALLOCATE call for each array
   use landuse_constant
   IMPLICIT NONE
   TYPE(landuse_mland), INTENT(INOUT)  :: luc
   integer  imland
   ! patch-genric variables
   ALLOCATE(luc%iveg_x(imland,mvmax),             &
            luc%isoil_x(imland,mvmax),            &
            luc%soilorder_x(imland,mvmax),        &
            luc%phase_x(imland,mvmax),            &
            luc%phen_x(imland,mvmax),             &
            luc%aphen_x(imland,mvmax),            &
            luc%doyphase3_x(imland,mvmax),        &
            luc%frac_sapwood_x(imland,mvmax),     &
            luc%sapwood_area_x(imland,mvmax),     &
            luc%isflag_x(imland,mvmax),           &
            luc%patchfrac_x(imland,mvmax),        &
            luc%lai_x(imland,mvmax),              &
            luc%sla_x(imland,mvmax))

   ALLOCATE(luc%iveg_y(imland,mvmax),             &
            luc%isoil_y(imland,mvmax),            &
            luc%soilorder_y(imland,mvmax),        &
            luc%phase_y(imland,mvmax),            &
            luc%phen_y(imland,mvmax),             &
            luc%aphen_y(imland,mvmax),            &
            luc%doyphase3_y(imland,mvmax),        &
            luc%frac_sapwood_y(imland,mvmax),     &
            luc%sapwood_area_y(imland,mvmax),     &
            luc%isflag_y(imland,mvmax),           &
            luc%patchfrac_y(imland,mvmax),        &
            luc%lai_y(imland,mvmax),              &
            luc%sla_y(imland,mvmax))

    ! biophysical
   ALLOCATE(luc%albsoilsn_x(imland,mvmax,nrb),   &
            luc%albedo_x(imland,mvmax,nrb),      &
            luc%albsoil_x(imland,mvmax,nrb),     &
            luc%dgdtg_x(imland,mvmax),           &
            luc%gammzz_x(imland,mvmax,ms),       &
            luc%tgg_x(imland,mvmax,ms),          &
            luc%wb_x(imland,mvmax,ms),           &
            luc%wbice_x(imland,mvmax,ms),        &
            luc%tggsn_x(imland,mvmax,msn),       &
            luc%ssdn_x(imland,mvmax,msn),        &
            luc%smass_x(imland,mvmax,msn),       &
            luc%sdepth_x(imland,mvmax,msn),      &
            luc%tss_x(imland,mvmax),             &
            luc%rtsoil_x(imland,mvmax),          &
            luc%runoff_x(imland,mvmax),          &
            luc%rnof1_x(imland,mvmax),           &
            luc%rnof2_x(imland,mvmax),           &
            luc%ssdnn_x(imland,mvmax),           &
            luc%snowd_x(imland,mvmax),           &
            luc%snage_x(imland,mvmax),           &
            luc%osnowd_x(imland,mvmax),          &
            luc%cansto_x(imland,mvmax),          &
            luc%ghflux_x(imland,mvmax),          &
            luc%sghflux_x(imland,mvmax),         &
            luc%ga_x(imland,mvmax),              &
            luc%fev_x(imland,mvmax),             &
            luc%fes_x(imland,mvmax),             &
            luc%fhs_x(imland,mvmax),             &
            luc%wbtot0_x(imland,mvmax),          &
            luc%osnowd0_x(imland,mvmax),         &
            luc%trad_x(imland,mvmax),            &
            luc%GWwb_x(imland,mvmax),            &
            luc%cplantx_x(imland,mvmax,ncp),     &
            luc%csoilx_x(imland,mvmax,ncs))

   ALLOCATE(luc%albsoilsn_y(imland,mvmax,nrb),   &
            luc%albedo_y(imland,mvmax,nrb),      &
            luc%albsoil_y(imland,mvmax,nrb),     &
            luc%dgdtg_y(imland,mvmax),           &
            luc%gammzz_y(imland,mvmax,ms),       &
            luc%tgg_y(imland,mvmax,ms),          &
            luc%wb_y(imland,mvmax,ms),           &
            luc%wbice_y(imland,mvmax,ms),        &
            luc%tggsn_y(imland,mvmax,msn),       &
            luc%ssdn_y(imland,mvmax,msn),        &
            luc%smass_y(imland,mvmax,msn),       &
            luc%sdepth_y(imland,mvmax,msn),      &
            luc%tss_y(imland,mvmax),             &
            luc%rtsoil_y(imland,mvmax),          &
            luc%runoff_y(imland,mvmax),          &
            luc%rnof1_y(imland,mvmax),           &
            luc%rnof2_y(imland,mvmax),           &
            luc%ssdnn_y(imland,mvmax),           &
            luc%snowd_y(imland,mvmax),           &
            luc%snage_y(imland,mvmax),           &
            luc%osnowd_y(imland,mvmax),          &
            luc%cansto_y(imland,mvmax),          &
            luc%ghflux_y(imland,mvmax),          &
            luc%sghflux_y(imland,mvmax),         &
            luc%ga_y(imland,mvmax),              &
            luc%fev_y(imland,mvmax),             &
            luc%fes_y(imland,mvmax),             &
            luc%fhs_y(imland,mvmax),             &
            luc%wbtot0_y(imland,mvmax),          &
            luc%osnowd0_y(imland,mvmax),         &
            luc%trad_y(imland,mvmax),            &
            luc%GWwb_y(imland,mvmax),            &
            luc%cplantx_y(imland,mvmax,ncp),     &
            luc%csoilx_y(imland,mvmax,ncs))

    ! biogeochemical variables
   ALLOCATE(luc%cplant_x(imland,mvmax,mplant),    &
            luc%nplant_x(imland,mvmax,mplant),    &
            luc%pplant_x(imland,mvmax,mplant),    &
            luc%clitter_x(imland,mvmax,mlitter),  &
            luc%nlitter_x(imland,mvmax,mlitter),  &
            luc%plitter_x(imland,mvmax,mlitter),  &
            luc%csoil_x(imland,mvmax,msoil),      &
            luc%nsoil_x(imland,mvmax,msoil),      &
            luc%psoil_x(imland,mvmax,msoil),      &
            luc%clabile_x(imland,mvmax),          &
            luc%nsoilmin_x(imland,mvmax),         &
            luc%psoillab_x(imland,mvmax),         &
            luc%psoilsorb_x(imland,mvmax),        &
            luc%psoilocc_x(imland,mvmax),         &
            luc%cwoodprod_x(imland,mvmax,mwood),  &
            luc%nwoodprod_x(imland,mvmax,mwood),  &
            luc%pwoodprod_x(imland,mvmax,mwood),  &
            luc%cplant_y(imland,mvmax,mplant),    &
            luc%nplant_y(imland,mvmax,mplant),    &
            luc%pplant_y(imland,mvmax,mplant),    &
            luc%clitter_y(imland,mvmax,mlitter),  &
            luc%nlitter_y(imland,mvmax,mlitter),  &
            luc%plitter_y(imland,mvmax,mlitter),  &
            luc%csoil_y(imland,mvmax,msoil),      &
            luc%nsoil_y(imland,mvmax,msoil),      &
            luc%psoil_y(imland,mvmax,msoil),      &
            luc%clabile_y(imland,mvmax),          &
            luc%nsoilmin_y(imland,mvmax),         &
            luc%psoillab_y(imland,mvmax),         &
            luc%psoilsorb_y(imland,mvmax),        &
            luc%psoilocc_y(imland,mvmax),         &
            luc%cwoodprod_y(imland,mvmax,mwood),  &
            luc%nwoodprod_y(imland,mvmax,mwood),  &
            luc%pwoodprod_y(imland,mvmax,mwood))

    ! land-use variables
   ALLOCATE(luc%pftfrac(imland,mvtype),           &
            luc%fharvw(imland,mharvw),            &
            luc%xluh2cable(imland,mvmax,mstate),  &
            luc%atransit(imland,mvmax,mvmax))

    !        luc%phen_y(imland,mvmax),             &
    !        luc%aphen_y(imland,mvmax),            &
    !        luc%doyphase3_y(imland,mvmax),        &
    !        luc%frac_sapwood_y(imland,mvmax),     &
    !        luc%sapwood_area_y(imland,mvmax))
   ! Initialize temporary variables
           ! patch-genric variables
           luc%iveg_x   = -1;     luc%isoil_x=-1;          luc%soilorder_x=-1;     luc%phase_x=0;    luc%isflag_x=0
           luc%phen_x   = 0.0;    luc%aphen_x=0.0;         luc%doyphase3_x=-1;     luc%frac_sapwood_x=1.0;  luc%sapwood_area_x=0.0
           luc%patchfrac_x=0.0;   luc%lai_x=0.0;           luc%sla_x=0.0
           luc%iveg_y   = -1;     luc%isoil_y=-1;          luc%soilorder_y=-1;     luc%phase_y=0;    luc%isflag_y=0
           luc%phen_y   = 0.0;    luc%aphen_y=0.0;         luc%doyphase3_y=-1;     luc%frac_sapwood_y=1.0;  luc%sapwood_area_y=0.0
           luc%patchfrac_y=0.0;   luc%lai_y=0.0;           luc%sla_y=0.0

           ! biophysical
           luc%albsoilsn_x=0.0
           luc%albedo_x=0.0
           luc%albsoil_x=0.0
           luc%dgdtg_x=0.0
           luc%gammzz_x=0.0
           luc%tgg_x=0.0
           luc%wb_x=0.0
           luc%wbice_x=0.0
           luc%tggsn_x=0.0
           luc%ssdn_x=0.0
           luc%smass_x=0.0
           luc%sdepth_x=0.0
           luc%tss_x=0.0
           luc%rtsoil_x=0.0
           luc%runoff_x=0.0
           luc%rnof1_x=0.0
           luc%rnof2_x=0.0
           luc%ssdnn_x=0.0
           luc%snowd_x=0.0
           luc%snage_x=0.0
           luc%osnowd_x=0.0
           luc%cansto_x=0.0
           luc%ghflux_x=0.0
           luc%sghflux_x=0.0
           luc%ga_x=0.0
           luc%fev_x=0.0
           luc%fes_x=0.0
           luc%fhs_x=0.0
           luc%wbtot0_x=0.0
           luc%osnowd0_x=0.0
           luc%trad_x=0.0
           luc%GWwb_x=0.0
           luc%cplantx_x=0.0
           luc%csoilx_x=0.0

           luc%albsoilsn_y=0.0
           luc%albedo_y=0.0
           luc%albsoil_y=0.0
           luc%dgdtg_y=0.0
           luc%gammzz_y=0.0
           luc%tgg_y=0.0
           luc%wb_y=0.0
           luc%wbice_y=0.0
           luc%tggsn_y=0.0
           luc%ssdn_y=0.0
           luc%smass_y=0.0
           luc%sdepth_y=0.0
           luc%tss_y=0.0
           luc%rtsoil_y=0.0
           luc%runoff_y=0.0
           luc%rnof1_y=0.0
           luc%rnof2_y=0.0
           luc%ssdnn_y=0.0
           luc%snowd_y=0.0
           luc%snage_y=0.0
           luc%osnowd_y=0.0
           luc%cansto_y=0.0
           luc%ghflux_y=0.0
           luc%sghflux_y=0.0
           luc%ga_y=0.0
           luc%fev_y=0.0
           luc%fes_y=0.0
           luc%fhs_y=0.0
           luc%wbtot0_y=0.0
           luc%osnowd0_y=0.0
           luc%trad_y=0.0
           luc%GWwb_y=0.0
           luc%cplantx_y=0.0
           luc%csoilx_y=0.0

           ! biogeochemical
           luc%cplant_x  = 0.0;   luc%nplant_x   = 0.0;    luc%pplant_x   = 0.0
           luc%clitter_x = 0.0;   luc%nlitter_x  = 0.0;    luc%plitter_x  = 0.0
           luc%csoil_x   = 0.0;   luc%nsoil_x    = 0.0;    luc%psoil_x    = 0.0
           luc%clabile_x = 0.0;   luc%nsoilmin_x = 0.0;    luc%psoillab_x = 0.0
           luc%psoilsorb_x = 0.0; luc%psoilocc_x = 0.
           luc%cwoodprod_x=0.0;   luc%nwoodprod_x=0.0;     luc%pwoodprod_x=0.0

           luc%phase_y   = -1;    luc%patchfrac_y=0.0
           luc%cplant_y  = 0.0;   luc%nplant_y   = 0.0;    luc%pplant_y   = 0.0
           luc%clitter_y = 0.0;   luc%nlitter_y  = 0.0;    luc%plitter_y  = 0.0
           luc%csoil_y   = 0.0;   luc%nsoil_y    = 0.0;    luc%psoil_y    = 0.0
           luc%clabile_y = 0.0;   luc%nsoilmin_y = 0.0;    luc%psoillab_y = 0.0
           luc%psoilsorb_y = 0.0; luc%psoilocc_y = 0.0
           luc%cwoodprod_y=0.0;   luc%nwoodprod_y=0.0;     luc%pwoodprod_y=0.0

           luc%pftfrac = 0.0;     luc%fharvw=0.0;          luc%xluh2cable=0.0;    luc%atransit=0.0
   END SUBROUTINE landuse_allocate_mland

   SUBROUTINE landuse_deallocate_mland(luc)
   !! Deallocates the `luc%var(mland,mvmax)` variables
   !!
   !! **WARNING:** Need to deallocate in reverse order from the allocation.
   IMPLICIT NONE
   TYPE(landuse_mland), INTENT(INOUT)  :: luc

   !patch-generic variables
   DEALLOCATE(luc%iveg_x,      luc%isoil_x, luc%soilorder_x, luc%phase_x, luc%isflag_x)
   DEALLOCATE(luc%phen_x,      luc%aphen_x, luc%doyphase3_x, luc%frac_sapwood_x,  luc%sapwood_area_x)
   DEALLOCATE(luc%patchfrac_x, luc%lai_x,   luc%sla_x)

   DEALLOCATE(luc%iveg_y,      luc%isoil_y, luc%soilorder_y, luc%phase_y, luc%isflag_y)
   DEALLOCATE(luc%phen_y,      luc%aphen_y, luc%doyphase3_y, luc%frac_sapwood_y,  luc%sapwood_area_y)
   DEALLOCATE(luc%patchfrac_y, luc%lai_y,   luc%sla_y)


   ! biophysical variables
   DEALLOCATE(luc%albsoilsn_x,    &
              luc%albedo_x,       &
              luc%albsoil_x,      &
              luc%dgdtg_x,        &
              luc%gammzz_x,       &
              luc%tgg_x,          &
              luc%wb_x,           &
              luc%wbice_x,        &
              luc%tggsn_x,        &
              luc%ssdn_x,         &
              luc%smass_x,        &
              luc%sdepth_x,       &
              luc%tss_x,          &
              luc%rtsoil_x,       &
              luc%runoff_x,       &
              luc%rnof1_x,        &
              luc%rnof2_x,        &
              luc%ssdnn_x,        &
              luc%snowd_x,        &
              luc%snage_x,        &
              luc%osnowd_x,       &
              luc%cansto_x,       &
              luc%ghflux_x,       &
              luc%sghflux_x,      &
              luc%ga_x,           &
              luc%fev_x,          &
              luc%fes_x,          &
              luc%fhs_x,          &
              luc%wbtot0_x,       &
              luc%osnowd0_x,      &
              luc%trad_x,         &
              luc%GWwb_x,         &
              luc%cplantx_x,      &
              luc%csoilx_x)

   DEALLOCATE(luc%albsoilsn_y,    &
              luc%albedo_y,       &
              luc%albsoil_y,      &
              luc%dgdtg_y,        &
              luc%gammzz_y,       &
              luc%tgg_y,          &
              luc%wb_y,           &
              luc%wbice_y,        &
              luc%tggsn_y,        &
              luc%ssdn_y,         &
              luc%smass_y,        &
              luc%sdepth_y,       &
              luc%tss_y,          &
              luc%rtsoil_y,       &
              luc%runoff_y,       &
              luc%rnof1_y,        &
              luc%rnof2_y,        &
              luc%ssdnn_y,        &
              luc%snowd_y,        &
              luc%snage_y,        &
              luc%osnowd_y,       &
              luc%cansto_y,       &
              luc%ghflux_y,       &
              luc%sghflux_y,      &
              luc%ga_y,           &
              luc%fev_y,          &
              luc%fes_y,          &
              luc%fhs_y,          &
              luc%wbtot0_y,       &
              luc%osnowd0_y,      &
              luc%trad_y,         &
              luc%GWwb_y,         &
              luc%cplantx_y,      &
              luc%csoilx_y)

   ! biogeochemical variables
   DEALLOCATE(luc%cplant_x,          &
              luc%nplant_x,          &
              luc%pplant_x,          &
              luc%clitter_x,         &
              luc%nlitter_x,         &
              luc%plitter_x,         &
              luc%csoil_x,           &
              luc%nsoil_x,           &
              luc%psoil_x,           &
              luc%clabile_x,         &
              luc%nsoilmin_x,        &
              luc%psoillab_x,        &
              luc%psoilsorb_x,       &
              luc%psoilocc_x,        &
              luc%cwoodprod_x,       &
              luc%nwoodprod_x,       &
              luc%pwoodprod_x,       &
              luc%cplant_y,          &
              luc%nplant_y,          &
              luc%pplant_y,          &
              luc%clitter_y,         &
              luc%nlitter_y,         &
              luc%plitter_y,         &
              luc%csoil_y,           &
              luc%nsoil_y,           &
              luc%psoil_y,           &
              luc%clabile_y,         &
              luc%nsoilmin_y,        &
              luc%psoillab_y,        &
              luc%psoilsorb_y,       &
              luc%psoilocc_y,        &
              luc%cwoodprod_y,       &
              luc%nwoodprod_y,       &
              luc%pwoodprod_y)
   !land-use variables
   DEALLOCATE(luc%pftfrac,           &
              luc%fharvw,            &
              luc%xluh2cable,        &
              luc%atransit)

   END SUBROUTINE landuse_deallocate_mland

   SUBROUTINE landuse_allocate_mp(mpx,ms,msn,nrb,mplant,mlitter,msoil,mwood,ncp,ncs,lucmp)
   !! Allocates the `luc%var(mp)` variables.
   !!
   !! **WARNING:** Need to use a separate ALLOCATE call for each array
   integer    mpx,ms,msn,nrb,mplant,mlitter,msoil,mwood,ncp,ncs
   TYPE(landuse_mp), INTENT(INOUT)  :: lucmp

   ! generic patch properties
     allocate(lucmp%iveg(mpx),lucmp%isoil(mpx),lucmp%soilorder(mpx),lucmp%phase(mpx),lucmp%isflag(mpx))

     allocate(lucmp%lat(mpx),lucmp%lon(mpx))
     allocate(lucmp%doyphase3(mpx))
     allocate(lucmp%phen(mpx),lucmp%aphen(mpx),lucmp%frac_sapwood(mpx), lucmp%sapwood_area(mpx))       !(mp)

     allocate(lucmp%patchfrac(mpx),lucmp%areacell(mpx),lucmp%lai(mpx),lucmp%sla(mpx))

   ! biophysical variables
     allocate(lucmp%albsoilsn(mpx,nrb),lucmp%albedo(mpx,nrb),lucmp%albsoil(mpx,nrb))                !float(mp,rad)
     allocate(lucmp%dgdtg(mpx))                                                                     !double(mp)
     allocate(lucmp%gammzz(mpx,ms))                                                                    !double(mp,soil)
     allocate(lucmp%tgg(mpx,ms),lucmp%wb(mpx,ms),lucmp%wbice(mpx,ms))                               !float(mp,soil)
     allocate(lucmp%tggsn(mpx,msn),lucmp%ssdn(mpx,msn),lucmp%smass(mpx,msn),lucmp%sdepth(mpx,msn)) !float(mp,snow)

     allocate(lucmp%tss(mpx),lucmp%rtsoil(mpx),lucmp%runoff(mpx),lucmp%rnof1(mpx),lucmp%rnof2(mpx), &
              lucmp%ssdnn(mpx),lucmp%snowd(mpx),lucmp%snage(mpx),lucmp%osnowd(mpx),                 &
              lucmp%cansto(mpx),lucmp%ghflux(mpx),lucmp%sghflux(mpx),lucmp%ga(mpx),                 &
              lucmp%fev(mpx),lucmp%fes(mpx),lucmp%fhs(mpx),lucmp%wbtot0(mpx),lucmp%osnowd0(mpx),    &
              lucmp%trad(mpx),lucmp%GWwb(mpx))                                                  !float(mp)
     allocate(lucmp%cplantx(mpx,ncp), lucmp%csoilx(mpx,ncs))                                    !float(mp,ncp/ncs)

    ! biogeochemical variables
     allocate(lucmp%sumcbal(mpx),lucmp%sumnbal(mpx),lucmp%sumpbal(mpx))
     allocate(lucmp%clabile(mpx))
     allocate(lucmp%cplant(mpx,mplant),lucmp%nplant(mpx,mplant),lucmp%pplant(mpx,mplant))
     allocate(lucmp%clitter(mpx,mlitter),lucmp%nlitter(mpx,mlitter),lucmp%plitter(mpx,mlitter))
     allocate(lucmp%csoil(mpx,msoil),lucmp%nsoil(mpx,msoil),lucmp%psoil(mpx,msoil))
     allocate(lucmp%nsoilmin(mpx))
     allocate(lucmp%psoillab(mpx),lucmp%psoilsorb(mpx),lucmp%psoilocc(mpx))
     allocate(lucmp%cwoodprod(mpx,mwood),lucmp%nwoodprod(mpx,mwood),lucmp%pwoodprod(mpx,mwood))

     ! initialization
     lucmp%iveg=-1;lucmp%isoil=-1;lucmp%soilorder=-1;lucmp%phase=0;lucmp%isflag=0
     lucmp%doyphase3=-1;lucmp%phen=0.0;lucmp%aphen=0.0;lucmp%frac_sapwood=1.0;lucmp%sapwood_area=0.0       !(mp)

     lucmp%patchfrac=0.0;lucmp%areacell=0.0;lucmp%lai=0.0;lucmp%sla=0.0

     ! biophysical variables
     lucmp%albsoilsn(:,:)=0.0; lucmp%albedo(:,:)=0.0; lucmp%albsoil(:,:)=0.0                 !float(mp,rad)
     lucmp%dgdtg(:)=0.0                                                                      !double(mp)
     lucmp%gammzz(:,:)=0.0                                                                   !double(mp,soil)
     lucmp%tgg(:,:)=0.0;lucmp%wb(:,:)=0.0; lucmp%wbice(:,:)=0.0                              !float(mp,soil)
     lucmp%tggsn(:,:)=0.0; lucmp%ssdn(:,:)=0.0; lucmp%smass(:,:)=0.0; lucmp%sdepth(:,:)=0.0  !float(mp,snow)

     lucmp%tss(:)=0.0; lucmp%rtsoil(:)=0.0; lucmp%runoff(:)=0.0; lucmp%rnof1(:)=0.0; lucmp%rnof2(:)=0.0
     lucmp%ssdnn(:)=0.0; lucmp%snowd(:)=0.0; lucmp%snage(:)=0.0; lucmp%osnowd(:)=0.0
     lucmp%cansto(:)=0.0; lucmp%ghflux(:)=0.0; lucmp%sghflux(:)=0.0; lucmp%ga(:)=0.0
     lucmp%fev(:)=0.0; lucmp%fes(:)=0.0; lucmp%fhs(:)=0.0; lucmp%wbtot0(:)=0.0; lucmp%osnowd0(:)=0.0
     lucmp%trad(:)=0.0; lucmp%GWwb(:)=0.0                                              !float(mp)
     lucmp%cplantx(:,:)=0.0; lucmp%csoilx(:,:)=0.0                                     !float(mp,plant_carbon_pools/soil_carbon_pools)

     ! biogeochemical variables
     lucmp%sumcbal=0.0;lucmp%sumnbal=0.0;lucmp%sumpbal=0.0
     lucmp%clabile = 0.0
     lucmp%cplant=0.0;  lucmp%nplant=0.0;  lucmp%pplant=0.0
     lucmp%clitter=0.0; lucmp%nlitter=0.0; lucmp%plitter=0.0
     lucmp%csoil=0.0;   lucmp%nsoil=0.0;   lucmp%psoil=0.0
     lucmp%nsoilmin=0.0
     lucmp%psoillab=0.0;lucmp%psoilsorb=0.0;lucmp%psoilocc=0.0
     lucmp%cwoodprod=0.0;lucmp%nwoodprod=0.0;lucmp%pwoodprod=0.0
   END SUBROUTINE landuse_allocate_mp

   SUBROUTINE landuse_deallocate_mp(mpx,ms,msn,nrb,mplant,mlitter,msoil,mwood,lucmp)
   !! Deallocates the `luc%var(mp)` variables
   !!
   !! **WARNING:** Need to deallocate in reverse order from the allocation.
   integer     mpx,ms,msn,nrb,mplant,mlitter,msoil,mwood
   TYPE(landuse_mp), INTENT(INOUT)  :: lucmp
     ! patch-generic variables
     deallocate(lucmp%iveg,lucmp%isoil,lucmp%soilorder,lucmp%phase,lucmp%isflag)
     deallocate(lucmp%lat,lucmp%lon)
     deallocate(lucmp%doyphase3)
     deallocate(lucmp%phen,lucmp%aphen,lucmp%frac_sapwood, lucmp%sapwood_area)       !(mp)

     deallocate(lucmp%patchfrac,lucmp%areacell,lucmp%lai,lucmp%sla)

     ! biophysical variables
     deallocate(lucmp%albsoilsn,lucmp%albedo,lucmp%albsoil)                   !float(mp,rad)
     deallocate(lucmp%dgdtg)                                                  !double(mp)
     deallocate(lucmp%gammzz)                                                 !double(mp,soil)
     deallocate(lucmp%tgg,lucmp%wb,lucmp%wbice)                               !float(mp,soil)
     deallocate(lucmp%tggsn,lucmp%ssdn,lucmp%smass,lucmp%sdepth)             !float(mp,snow)

     deallocate(lucmp%tss,lucmp%rtsoil,lucmp%runoff,lucmp%rnof1,lucmp%rnof2,    &
              lucmp%ssdnn,lucmp%snowd,lucmp%snage,lucmp%osnowd,                 &
              lucmp%cansto,lucmp%ghflux,lucmp%sghflux,lucmp%ga,                 &
              lucmp%fev,lucmp%fes,lucmp%fhs,lucmp%wbtot0,lucmp%osnowd0,         &
              lucmp%trad,lucmp%GWwb)                        !float(mp)
     deallocate(lucmp%cplantx, lucmp%csoilx)                !float(mp,plant_carbon_pools/soil_carbon_pools)


     !biogeochemical variables
     deallocate(lucmp%sumcbal,lucmp%sumnbal,lucmp%sumpbal)
     deallocate(lucmp%clabile)
     deallocate(lucmp%cplant,lucmp%nplant,lucmp%pplant)
     deallocate(lucmp%clitter,lucmp%nlitter,lucmp%plitter)
     deallocate(lucmp%csoil,lucmp%nsoil,lucmp%psoil)
     deallocate(lucmp%nsoilmin)
     deallocate(lucmp%psoillab,lucmp%psoilsorb,lucmp%psoilocc)
     deallocate(lucmp%cwoodprod,lucmp%nwoodprod,lucmp%pwoodprod)

   END SUBROUTINE landuse_deallocate_mp

END MODULE landuse_variable

  subroutine landuse_driver(mlon,mlat,landmask,arealand,ssnow,soil,veg,bal,canopy,  &
                            phen,casapool,casabal,casamet,casabiome,casaflux,bgc,rad, &
                            cstart,cend,nap,lucmp)
  !! Main driver for the land-use change
  !
  USE cable_IO_vars_module, ONLY: mask,patch,landpt, latitude, longitude
  USE cable_def_types_mod,  ONLY: mp,mvtype,mstype,mland,r_2,ms,msn,nrb,ncp,ncs,           &
                                  soil_parameter_type, soil_snow_type, veg_parameter_type, &
                                  balances_type, canopy_type, bgc_pool_type, radiation_type
  USE casadimension,        ONLY: icycle,mplant,mlitter,msoil,mwood,mso
  USE casavariable,         ONLY: casa_pool,casa_balance,casa_met,casa_biome,casa_flux
  USE phenvariable,         ONLY: phen_variable
  USE landuse_variable
  IMPLICIT NONE
  TYPE (soil_snow_type)          :: ssnow   ! soil and snow variables
  TYPE (soil_parameter_type)     :: soil    ! soil parameters
  TYPE (veg_parameter_type)      :: veg     ! vegetation parameters
  TYPE (balances_type)           :: bal
  TYPE (canopy_type)             :: canopy
  TYPE (phen_variable)           :: phen
  TYPE (casa_pool)               :: casapool
  TYPE (casa_biome)              :: casabiome
  TYPE (casa_balance)            :: casabal
  TYPE (casa_met)                :: casamet
  TYPE (casa_flux)               :: casaflux
  TYPE (bgc_pool_type)           :: bgc
  TYPE (radiation_type)          :: rad    ! met data

  TYPE (landuse_mland)           :: luc
  TYPE (landuse_mp)              :: lucmp
  ! input
  integer mlon,mlat
  integer,       dimension(mlon,mlat)         :: landmask
  real(r_2),     dimension(mland)             :: arealand
  ! output
  ! "mland" variables
  integer,       dimension(mland)             :: cstart,cend,nap

  character*500   fxpft,fxluh2cable
  integer ivt,ee,hh,np,p,q,np1
  integer ncid,ok,xID,yID,varID,i,j,m,mpx

     print *, 'calling allocate mp: landuse'
     call landuse_allocate_mp(mp,ms,msn,nrb,mplant,mlitter,msoil,mwood,ncp,ncs,lucmp)
     print *, 'calling allocate mland: landuse'
     call landuse_allocate_mland(mland,luc)                                                     !setup "varx(mland,:)"
     print *, 'exiting  allocating mland: landuse'

     ! get the mapping matrix from state to plant functional type
     ! call landuse_getxluh2(mlat,mlon,landmask,luc,filename%fxluh2cable)    !"xluh2cable"
     ! call landuse_getdata(mlat,mlon,landmask,filename%fxpft,luc)     !"luc(t-1)" and "xpft(t-1)"

     ! get pool sizes and other states in the "restart", "gridinfo" and "poolout" file
     ! patch-generic variables
     do p=1,mp
!        print *, 'p', p, veg%iveg(p),soil%isoilm(p),ssnow%isflag(p)
        lucmp%iveg(p)      = veg%iveg(p)
        lucmp%isoil(p)     = soil%isoilm(p)
        lucmp%soilorder(p) = casamet%isorder(p)
        lucmp%isflag(p)    = ssnow%isflag(p)

     enddo
!     print *, 'point A: landuse'
!     !
!     print *, 'patchfraC',size(patch%frac)
!     print *, 'veglai= ',size(veg%vlai)
!     print *, 'landuse: casabiome:sla', size(casabiome%sla),  casabiome%sla(:)

     do p=1,mp
     !   print *, 'landuse b', p, veg%iveg(p),veg%vlai(p),patch(p)%frac

        lucmp%patchfrac(p) = patch(p)%frac             ! maybe we should create another variable for "primary%patch"
        lucmp%lai(p)       = veg%vlai(p)
        lucmp%sla(p)       = casabiome%sla(veg%iveg(p))
     enddo
!     print *, 'point b: landuse'

     ! biophysical variables
     do p=1,mp
        lucmp%albsoilsn(p,:) = ssnow%albsoilsn(p,:)
        lucmp%albedo(p,:)    = rad%albedo(p,:)
        lucmp%albsoil(p,:)   = soil%albsoil(p,:)
        lucmp%gammzz(p,:)    = ssnow%gammzz(p,:)
        lucmp%tgg(p,:)       = ssnow%tgg(p,:)
        lucmp%wb(p,:)        = ssnow%wb(p,:)
        lucmp%wbice(p,:)     = ssnow%wbice(p,:)
        lucmp%tggsn(p,:)     = ssnow%tggsn(p,:)
        lucmp%ssdn(p,:)      = ssnow%ssdn(p,:)
        lucmp%smass(p,:)     = ssnow%smass(p,:)
        lucmp%sdepth(p,:)    = ssnow%sdepth(p,:)
        lucmp%tss(p)         = ssnow%tss(p)
     enddo

!     print *, 'point C: landuse'
     lucmp%runoff(:)      = ssnow%runoff(:)
     lucmp%rnof1(:)       = ssnow%rnof1(:)
     lucmp%rnof2(:)       = ssnow%rnof2(:)
     lucmp%ssdnn(:)       = ssnow%ssdnn(:)
     lucmp%snowd(:)       = ssnow%snowd(:)
     lucmp%snage(:)       = ssnow%snage(:)
     lucmp%osnowd(:)      = ssnow%osnowd(:)
     lucmp%cansto(:)      = canopy%cansto(:)
     lucmp%ghflux(:)      = canopy%ghflux(:)
     lucmp%sghflux(:)     = canopy%sghflux(:)
!     print *, 'point D: landuse'
     lucmp%ga(:)          = canopy%ga(:)
     lucmp%dgdtg(:)       = canopy%dgdtg(:)
     lucmp%fev(:)         = canopy%fev(:)
     lucmp%fes(:)         = canopy%fes(:)
     lucmp%fhs(:)         = canopy%fhs(:)
     lucmp%wbtot0(:)      = bal%wbtot0(:)
     lucmp%osnowd0(:)     = bal%osnowd0(:)
     lucmp%trad(:)        = rad%trad(:)
     lucmp%GWwb(:)        = ssnow%GWwb(:)
     lucmp%cplantx(:,:)   = bgc%cplant(:,:)
     lucmp%csoilx(:,:)    = bgc%csoil(:,:)

!     print *, 'point E: landuse'
     ! biogeochemical variables
     do m=1,mland
       do np=cstart(m),cend(m)
          ivt = lucmp%iveg(np)
          if(ivt <=mvtype) then
             luc%pftfrac(m,ivt) = patch(np)%frac
          endif
       enddo
     enddo

     print *, 'point F: landuse'
     if(icycle>0) then
     do p=1,mp
!       print *, 'landuse F: ', p, phen%phase(p),phen%doyphase(p,3),phen%phen(p),phen%aphen(p)
!       print *, 'landuse F2: ',   casaflux%frac_sapwood(p),casaflux%sapwood_area(p)
!       print *, 'landuse F3: ', casapool%clabile(p),casapool%cplant(p,:),casapool%clitter(p,:),casapool%csoil(p,:),        &
!                               casapool%cwoodprod(p,:)
!       print *, 'landuse F4: ',casabal%sumcbal(p)

        lucmp%phase(p)       = phen%phase(p)
        lucmp%doyphase3(p)   = phen%doyphase(p,3)
        lucmp%phen(p)        = phen%phen(p)
        lucmp%aphen(p)       = phen%aphen(p)
        lucmp%frac_sapwood(p)= casaflux%frac_sapwood(p)
        lucmp%sapwood_area(p)= casaflux%sapwood_area(p)
        lucmp%clabile(p)     = casapool%clabile(p)
        lucmp%cplant(p,:)    = casapool%cplant(p,:)
        lucmp%clitter(p,:)   = casapool%clitter(p,:)
        lucmp%csoil(p,:)     = casapool%csoil(p,:)
        lucmp%cwoodprod(p,:) = casapool%cwoodprod(p,:)
        lucmp%sumcbal(p)     = casabal%sumcbal(p)
     enddo
     endif
!     print *, 'point G: landuse'
     if(icycle>1) then
     do p=1,mp
        lucmp%nplant(p,:)    = casapool%nplant(p,:)
        lucmp%nlitter(p,:)   = casapool%nlitter(p,:)
        lucmp%nsoil(p,:)     = casapool%nsoil(p,:)
        lucmp%nwoodprod(p,:) = casapool%nwoodprod(p,:)
        lucmp%nsoilmin(p)    = casapool%nsoilmin(p)
        lucmp%sumnbal(p)     = casabal%sumnbal(p)
     enddo
     endif
!     print *, 'point H: landuse'
     if(icycle >2) then
     do p=1,mp
        lucmp%pplant(p,:)    = casapool%pplant(p,:)
        lucmp%plitter(p,:)   = casapool%plitter(p,:)
        lucmp%psoil(p,:)     = casapool%psoil(p,:)
        lucmp%pwoodprod(p,:) = casapool%pwoodprod(p,:)
        lucmp%psoillab(p)    = casapool%psoillab(p)
        lucmp%psoilsorb(p)   = casapool%psoilsorb(p)
        lucmp%psoilocc(p)    = casapool%psoilocc(p)
        lucmp%sumpbal(p)     = casabal%sumpbal(p)
     enddo
     endif

     ! assign variables var(mp,:) to luc%var_x(mland,mvmax,:)
!     print *, 'calling mp2land: landuse'
     call landuse_mp2land(luc,lucmp,mp,cstart,cend)

     ! we need to deallocate "lucmp" because "mp" will be updated after land-use change
!     print *, 'calling deallocate mp: landuse'
     call landuse_deallocate_mp(mp,ms,msn,nrb,mplant,mlitter,msoil,mwood,lucmp)

!     print *, 'calling transitx: landuse'
     call landuse_transitx(luc,casabiome)

!     print *, 'calling checks: landuse'
     call landuse_checks(mlon,mlat,landmask,luc)

!     print *, 'calling update mland: landuse'
     call landuse_update_mland(luc)                    ! assign "var_y" to "var_x"

     ! update "cstart", "cend","nap" and "mp=>mpx"
      cstart=0;cend=0;nap=0
      np =0; cstart(:) = 0; cend(:) =0; nap(:) = 0
      do p=1,mland
         np1 =0
         if(sum(luc%patchfrac_y(p,:))<thresh_frac) then
            print *, 'WARNING! patch area sum too low',p,luc%patchfrac_y(p,:)
         else
            do q=1,mvmax
               if(luc%patchfrac_y(p,q) >thresh_frac) then
                  np  = np + 1
                  np1 = np1 + 1
                  if(np1==1) cstart(p) = np
              endif
            enddo
            cend(p) = np
            nap(p)  = max(0,cend(p)-cstart(p) +1)
         endif
      enddo
      mpx = np
     ! allocate "lucmp" with "mpx"
!     print *, 'calling allocate mp: landuse'
     call landuse_allocate_mp(mpx,ms,msn,nrb,mplant,mlitter,msoil,mwood,ncp,ncs,lucmp)

     ! assign lucmp%lat lucmp%lon
     do p=1,mland
        do q=cstart(p),cend(p)
           lucmp%lat(q) = latitude(p)
           lucmp%lon(q) = longitude(p)
        enddo
     enddo

!     print *, 'calling land2mpx: landuse'
     call landuse_land2mpx(luc,lucmp,mpx)
  !   call landuse_land2mpx(luc,lucmp,mpx,cstart,cend,nap)

!     print *, 'calling deallocate mland: landuse'
     call landuse_deallocate_mland(luc)

!     print *, 'landuse: exit landuse_driver mpx', mpx

     close(21)
211  format(i4,a120)
end subroutine landuse_driver

 SUBROUTINE landuse_mp2land(luc,lucmp,mp,cstart,cend)
 !! Assigns `lucmp%var(mp)` to `luc%var_x(mland,mvmax)`
 !
 use landuse_variable
 IMPLICIT NONE
 integer mp
 type(landuse_mland)   :: luc
 type(landuse_mp)      :: lucmp
 integer g,np,ivt,i
 integer,        dimension(mland)        :: cstart,cend

  do g=1,mland
     do ivt=1,mvmax
        luc%iveg_x(g,ivt) = ivt
     enddo

  do np= cstart(g),cend(g)

     ivt = lucmp%iveg(np)
     if(ivt<1.or.ivt>17) then
        print *, 'at landuse_mp2land: vegtype outy of range!',g,np,ivt
        print *, 'stop!'
     endif

     ! patch-genric variables
     luc%isoil_x(g,ivt)       = lucmp%isoil(np)
     luc%soilorder_x(g,ivt)   = lucmp%soilorder(np)
     luc%phase_x(g,ivt)       = lucmp%phase(np)

     luc%doyphase3_x(g,ivt)   = lucmp%doyphase3(np)
     luc%phen_x(g,ivt)        = lucmp%phen(np)
     luc%aphen_x(g,ivt)       = lucmp%aphen(np)
     luc%frac_sapwood_x(g,ivt)= lucmp%frac_sapwood(np)
     luc%sapwood_area_x(g,ivt)= lucmp%sapwood_area(np)

     luc%isflag_x(g,ivt)      = lucmp%isflag(np)
     luc%patchfrac_x(g,ivt)   = lucmp%patchfrac(np)
     luc%lai_x(g,ivt)         = lucmp%lai(np)
     luc%sla_x(g,ivt)         = lucmp%sla(np)

     ! biophysical variables
     do i=1,nrb
        luc%albsoilsn_x(g,ivt,i) = lucmp%albsoilsn(np,i)
        luc%albedo_x(g,ivt,i)    = lucmp%albedo(np,i)
        luc%albsoil_x(g,ivt,i)   = lucmp%albsoil(np,i)
     enddo

     luc%dgdtg_x(g,ivt)        = lucmp%dgdtg(np)

     do i=1,ms
        luc%gammzz_x(g,ivt,i)  = lucmp%gammzz(np,i)
        luc%tgg_x(g,ivt,i)     = lucmp%tgg(np,i)
        luc%wb_x(g,ivt,i)      = lucmp%wb(np,i)
        luc%wbice_x(g,ivt,i)   = lucmp%wbice(np,i)
     enddo

     do i=1,msn
        luc%tggsn_x(g,ivt,i)   = lucmp%tggsn(np,i)
        luc%ssdn_x(g,ivt,i)    = lucmp%ssdn(np,i)
        luc%smass_x(g,ivt,i)   = lucmp%smass(np,i)
        luc%sdepth_x(g,ivt,i)  = lucmp%sdepth(np,i)
     enddo

     luc%tss_x(g,ivt)          = lucmp%tss(np)
     luc%rtsoil_x(g,ivt)       = lucmp%rtsoil(np)
     luc%runoff_x(g,ivt)       = lucmp%runoff(np)
     luc%rnof1_x(g,ivt)        = lucmp%rnof1(np)
     luc%rnof2_x(g,ivt)        = lucmp%rnof2(np)
     luc%ssdnn_x(g,ivt)        = lucmp%ssdnn(np)
     luc%snowd_x(g,ivt)        = lucmp%snowd(np)
     luc%snage_x(g,ivt)        = lucmp%snage(np)
     luc%osnowd_x(g,ivt)       = lucmp%osnowd(np)
     luc%cansto_x(g,ivt)       = lucmp%cansto(np)
     luc%ghflux_x(g,ivt)       = lucmp%ghflux(np)
     luc%sghflux_x(g,ivt)      = lucmp%sghflux(np)
     luc%ga_x(g,ivt)           = lucmp%ga(np)
     luc%fev_x(g,ivt)          = lucmp%fev(np)
     luc%fes_x(g,ivt)          = lucmp%fes(np)
     luc%fhs_x(g,ivt)          = lucmp%fhs(np)
     luc%wbtot0_x(g,ivt)       = lucmp%wbtot0(np)
     luc%osnowd0_x(g,ivt)      = lucmp%osnowd0(np)
     luc%trad_x(g,ivt)         = lucmp%trad(np)
     luc%GWwb_x(g,ivt)         = lucmp%GWwb(np)

     do i =1,ncp
        luc%cplantx_x(g,ivt,i) = lucmp%cplantx(np,i)
     enddo
     do i=1,ncs
        luc%csoilx_x(g,ivt,i)  = lucmp%csoilx(np,i)
     enddo

     ! biogeochemical variables
     luc%clabile_x(g,ivt)     = lucmp%clabile(np)
     luc%cplant_x(g,ivt,:)    = lucmp%cplant(np,:)
     luc%clitter_x(g,ivt,:)   = lucmp%clitter(np,:)
     luc%csoil_x(g,ivt,:)     = lucmp%csoil(np,:)
     luc%cwoodprod_x(g,ivt,:) = lucmp%cwoodprod(np,:)

    IF(icycle>1) THEN
      luc%nplant_x(g,ivt,:)    = lucmp%nplant(np,:)
      luc%nlitter_x(g,ivt,:)   = lucmp%nlitter(np,:)
      luc%nsoil_x(g,ivt,:)     = lucmp%nsoil(np,:)
      luc%nsoilmin_x(g,ivt)    = lucmp%nsoilmin(np)
      luc%nwoodprod_x(g,ivt,:) = lucmp%nwoodprod(np,:)
    END IF
    IF(icycle>2) THEN
      luc%pplant_x(g,ivt,:)    = lucmp%pplant(np,:)
      luc%plitter_x(g,ivt,:)   = lucmp%plitter(np,:)
      luc%psoil_x(g,ivt,:)     = lucmp%psoil(np,:)
      luc%psoillab_x(g,ivt)    = lucmp%psoillab(np)
      luc%psoilsorb_x(g,ivt)   = lucmp%psoilsorb(np)
      luc%psoilocc_x(g,ivt)    = lucmp%psoilocc(np)
      luc%pwoodprod_x(g,ivt,:) = lucmp%pwoodprod(np,:)
    END IF

  enddo
  enddo

  ! patch-genric variables
  luc%isoil_y       = luc%isoil_x
  luc%soilorder_y   = luc%soilorder_x
  luc%phase_y       = luc%phase_x
  luc%isflag_y      = luc%isflag_x
  luc%patchfrac_y   = luc%patchfrac_x
  luc%lai_y         = luc%lai_x
  luc%sla_y         = luc%sla_x

  luc%doyphase3_y   = luc%doyphase3_x
  luc%phen_y        = luc%phen_x
  luc%aphen_y       = luc%aphen_x
  luc%frac_sapwood_y= luc%frac_sapwood_x
  luc%sapwood_area_y= luc%sapwood_area_x

  ! biophysical variables
  luc%albsoilsn_y   = luc%albsoilsn_x
  luc%albedo_y      = luc%albedo_x
  luc%albsoil_y     = luc%albsoil_x
  luc%dgdtg_y       = luc%dgdtg_x
  luc%gammzz_y      = luc%gammzz_x
  luc%tgg_y         = luc%tgg_x
  luc%wb_y          = luc%wb_x
  luc%wbice_y       = luc%wbice_x
  luc%tggsn_y       = luc%tggsn_x
  luc%ssdn_y        = luc%ssdn_x
  luc%smass_y       = luc%smass_x
  luc%sdepth_y      = luc%sdepth_x
  luc%tss_y         = luc%tss_x
  luc%rtsoil_y      = luc%rtsoil_x
  luc%runoff_y      = luc%runoff_x
  luc%rnof1_y       = luc%rnof1_x
  luc%rnof2_y       = luc%rnof2_x
  luc%ssdnn_y       = luc%ssdnn_x
  luc%snowd_y       = luc%snowd_x
  luc%snage_y       = luc%snage_x
  luc%osnowd_y      = luc%osnowd_x
  luc%cansto_y      = luc%cansto_x
  luc%ghflux_y      = luc%ghflux_x
  luc%sghflux_y     = luc%sghflux_x
  luc%ga_y          = luc%ga_x
  luc%fev_y         = luc%fev_x
  luc%fes_y         = luc%fes_x
  luc%fhs_y         = luc%fhs_x
  luc%wbtot0_y      = luc%wbtot0_x
  luc%osnowd0_y     = luc%osnowd0_x
  luc%trad_y        = luc%trad_x
  luc%GWwb_y        = luc%GWwb_x
  luc%cplantx_y     = luc%cplantx_x
  luc%csoilx_y      = luc%csoilx_x

  ! biogeochemical variables
  luc%clabile_y   = luc%clabile_x
  luc%cplant_y    = luc%cplant_x
  luc%clitter_y   = luc%clitter_x
  luc%csoil_y     = luc%csoil_x
  luc%cwoodprod_y = luc%cwoodprod_x

  IF(icycle>1) THEN
     luc%nplant_y    = luc%nplant_x
     luc%nlitter_y   = luc%nlitter_x
     luc%nsoil_y     = luc%nsoil_x
     luc%nsoilmin_y  = luc%nsoilmin_x
     luc%nwoodprod_y = luc%nwoodprod_x
  END IF
  IF(icycle>2) THEN
     luc%pplant_y    = luc%pplant_x
     luc%plitter_y   = luc%plitter_x
     luc%psoil_y     = luc%psoil_x
     luc%psoillab_y  = luc%psoillab_x
     luc%psoilsorb_y = luc%psoilsorb_x
     luc%psoilocc_y  = luc%psoilocc_x
     luc%pwoodprod_y = luc%pwoodprod_x
  END IF

END SUBROUTINE landuse_mp2land

SUBROUTINE landuse_transitx(luc,casabiome)
   !*## Purpose
   !
   ! This subroutine applies the land-use changes to the transfer of the C,
   ! N and P pools, the biophysical states, the soil texture and the soil
   ! order for each patch. Then it will seed the deforested land.
   !
   !## Order of procedure
   !
   ! 1. the transfer of different C, N and P pools resulting from land-use
   ! change in two steps
   !     1. calculate the change of a pool (`delvar`) using transition
   !     matrix (`T`)
   !     1. calculate `luc%var_y` as the sum of `luc%var_x + delvar`
   ! 2. update biophysical states, soil texture and soil order for each patch
   ! 3. seed any deforested land
   USE casaparm
   USE landuse_constant
   USE casavariable,        ONLY: casa_biome
   USE landuse_variable,    ONLY: landuse_mland

   USE cable_def_types_mod,  ONLY: mland,mvtype,r_2,nrb,ncp,ncs
   USE casadimension,        ONLY: icycle,mplant,mlitter,msoil,mwood

   IMPLICIT NONE
   TYPE(casa_biome)    :: casabiome
   TYPE(landuse_mland) :: luc
   integer,   dimension(mvtype)               :: ivt2
   real(r_2), dimension(mland,mvmax)          :: dclabile
   real(r_2), dimension(mland,mvmax,mplant)   :: dcplant,dnplant,dpplant
   real(r_2), dimension(mland,mvmax,mlitter)  :: dclitter,dnlitter,dplitter
   real(r_2), dimension(mland,mvmax,msoil)    :: dcsoil,dnsoil,dpsoil
   real(r_2), dimension(mland,mvmax)          :: dnsoilmin,dpsoillab,dpsoilsorb,dpsoilocc
   real(r_2), dimension(mland,mvmax,mwood)    :: dcwoodprod,dnwoodprod,dpwoodprod
   real(r_2), DIMENSION(3)                    :: ratioLignintoN
   real(r_2), DIMENSION(mvmax,3,3)            :: fromPtoL
   real(r_2), DIMENSION(mland,mvmax)          :: delarea
   real(r_2), DIMENSION(mvmax,mvmax)          :: afwhpri, afwhsec, transitx
   real(r_2), DIMENSION(mvmax)                :: delfwhpri,delfwhsec
   real(r_2), DIMENSION(3)                    :: totcwoodprod, totclitter, totcsoil
   real(r_2), DIMENSION(3)                    :: totnwoodprod, totnlitter, totnsoil
   real(r_2), DIMENSION(3)                    :: totpwoodprod, totplitter, totpsoil
   real(r_2)                                     totclabile, totnsoilmin, totpsoillab, totpsoilsorb, totpsoilocc
   real(r_2)                                     tempx
   integer p,d,r,q,r1,r2,r3,r4,ierror,ivt,k
   integer irb,is,icp,ics

   ! vegetation types for each 17-PFT: non-veg (0),grass(1),shrub(2), forest(3)
   ivt2=(/3,3,3,3,2,1,1,2,1,1,3,3,3,1,0,0,0/)
   delarea(:,:)     = 0.0
   dcplant(:,:,:)   = 0.0; dnplant(:,:,:)   = 0.0; dpplant(:,:,:)    = 0.0; dclabile(:,:) = 0.0
   dclitter(:,:,:)  = 0.0; dnlitter(:,:,:)  = 0.0; dplitter(:,:,:)   = 0.0
   dcsoil(:,:,:)    = 0.0; dnsoil(:,:,:)    = 0.0; dpsoil(:,:,:)     = 0.0
   dnsoilmin(:,:)   = 0.0; dpsoillab(:,:)   = 0.0; dpsoilsorb(:,:)   = 0.0; dpsoilocc(:,:) = 0.0
   dcwoodprod(:,:,:) =0.0; dnwoodprod(:,:,:)=0.0;  dpwoodprod(:,:,:) = 0.0

   do p = 1,mland
      fromPtoL(:,1,:)=1.0; fromPtoL(:,2,:) = 0.0
      do d=1,mvmax
         if(luc%cplant_x(p,d,leaf) > 0.001) then
            ! calculate the fraction of litter or root litter into metabolic litter pool
			   ! this could be replaced with a call to a subroutine
			   ! if same calculations in casa_cnp.F90 are isolated into a
            ! separate subroutine
			   !
            ivt=mvtype

            ratioLignintoN(leaf) = (luc%cplant_x(p,d,leaf) &
                                 /(max(1.0e-10,luc%nplant_x(p,d,leaf)) * casabiome%ftransNPtoL(ivt,leaf))) &
                                 * casabiome%fracLigninplant(ivt,leaf)
            ratioLignintoN(froot)= (luc%cplant_x(p,d,froot)&
                                 /(max(1.0e-10,luc%nplant_x(p,d,froot))* casabiome%ftransNPtoL(ivt,froot))) &
                                 * casabiome%fracLigninplant(ivt,froot)
            fromPtoL(d,metb,leaf)  = max(0.001, 0.85 - 0.018 *ratioLignintoN(leaf))
            fromPtoL(d,metb,froot) = max(0.001, 0.85 - 0.018 *ratioLignintoN(froot))
            fromPtoL(d,str,leaf)   = 1.0 - fromPtoL(d,metb,leaf)
            fromPtoL(d,str,froot)  = 1.0 - fromPtoL(d,metb,froot)
         endif
      enddo

      ! compute the transition matrix relating to primary forest harvest
      delfwhpri(1:mvmax) = 0.0; afwhpri(1:mvmax,1:mvmax) = 0.0
      if(luc%fharvw(p,1) >0.0) then
         ! calculate the transition matrix for primary land
          do d=1,mvtype
            if(d<11.or.d>13) then
               delfwhpri(d)  = luc%fharvw(p,1) * luc%xluh2cable(p,d,1)    ! donor    (positive)
            else
               delfwhpri(d) = -luc%fharvw(p,1) * luc%xluh2cable(p,r,3)    ! receiver (negative)
            endif
         enddo  ! of "d"
         call landuse_redistribution(p,mvmax,delfwhpri,afwhpri)
      endif

      transitx(1:mvmax,1:mvmax) = luc%atransit(p,1:mvmax,1:mvmax)+afwhpri(1:mvmax,1:mvmax)

      do d = 1,mvmax
      do r = 1,mvmax
         ! transfer leaf and root into litter (metabolic and structural litter),
         ! transfer wood into wood prodoct pool (three wood product pools)
         ! then calculate the delpool(p,d,:), and delpool(p,r,:) for C, N and P

         if(transitx(r,d) > 0.0.and.d/=r.and.luc%patchfrac_x(p,d)>0.0) then
            ! transfer the area from donor (d) to receiver (r)
            delarea(p,d) = delarea(p,d) - transitx(r,d)
            delarea(p,r) = delarea(p,r) + transitx(r,d)
            ! donor pool changes
            dcplant(p,d,:)    = dcplant(p,d,:)    - transitx(r,d) * luc%cplant_x(p,d,:)
            dclitter(p,d,:)   = dclitter(p,d,:)   - transitx(r,d) * luc%clitter_x(p,d,:)
            dcsoil(p,d,:)     = dcsoil(p,d,:)     - transitx(r,d) * luc%csoil_x(p,d,:)
            dclabile(p,d)     = dclabile(p,d)     - transitx(r,d) * luc%clabile_x(p,d)
            dcwoodprod(p,d,:) = dcwoodprod(p,d,:) - transitx(r,d) * luc%cwoodprod_x(p,d,:)

            ! receiver pool changes
            ! move the donor leaf and root biomass to receiver structural litter pool
            !(to avoid C:N imbalance)
            ! using max function to avoid dividing by zero, ypw 14/may/2008

            ! calculate the fraction of litter or root litter into metabolic litter pool

            dclitter(p,r,1) = dclitter(p,r,1) + transitx(r,d)  &
                            * (luc%clitter_x(p,d,1) + luc%cplant_x(p,d,leaf) * fromPtoL(d,metb,leaf) &
                                                    + luc%cplant_x(p,d,froot)* fromPtoL(d,metb,froot))
            dclitter(p,r,2) = dclitter(p,r,2) + transitx(r,d)  &
                            * (luc%clitter_x(p,d,2) + luc%cplant_x(p,d,leaf) * fromPtoL(d,str,leaf)  &
                                                    + luc%cplant_x(p,d,froot) *fromPtoL(d,str,froot))
            dcsoil(p,r,:)   = dcsoil(p,r,:)   + transitx(r,d) * luc%csoil_x(p,d,:)

            !move the labile carbon to receiving tile (maybe better to fast-decomposing wood product pool)
            dclabile(p,r)   = dclabile(p,r)   + transitx(r,d) * luc%clabile_x(p,d)

            !move the donor wood to receiver wood product pool including labile C
            dcwoodprod(p,r,1) = dcwoodprod(p,r,1) + transitx(r,d)   &
                                                  *(luc%cplant_x(p,d,wood)*fwoodprod(1) + luc%cwoodprod_x(p,d,1))

            dcwoodprod(p,r,2) = dcwoodprod(p,r,2) + transitx(r,d)   &
                                                  *(luc%cplant_x(p,d,wood)*fwoodprod(2) + luc%cwoodprod_x(p,d,2))

            dcwoodprod(p,r,3) = dcwoodprod(p,r,3) + transitx(r,d)   &
                                                  *(luc%cplant_x(p,d,wood)*fwoodprod(3) + luc%cwoodprod_x(p,d,3))

             if(icycle >1) then
                dnplant(p,d,:)  = dnplant(p,d,:)  - transitx(r,d) * luc%nplant_x(p,d,:)
                dnlitter(p,d,:) = dnlitter(p,d,:) - transitx(r,d) * luc%nlitter_x(p,d,:)
                dnsoil(p,d,:)   = dnsoil(p,d,:)   - transitx(r,d) * luc%nsoil_x(p,d,:)
                dnsoilmin(p,d)  = dnsoilmin(p,d)  - transitx(r,d) * luc%nsoilmin_x(p,d)

                dnlitter(p,r,1) = dnlitter(p,r,1) + transitx(r,d)  &
                                * (luc%nlitter_x(p,d,1) + luc%nplant_x(p,d,leaf) * fromPtoL(d,metb,leaf) &
                                                        + luc%nplant_x(p,d,froot)* fromPtoL(d,metb,froot))
                dnlitter(p,r,2) = dnlitter(p,r,2) + transitx(r,d)  &
                                * (luc%nlitter_x(p,d,2) + luc%nplant_x(p,d,leaf) * fromPtoL(d,str,leaf) &
                                                        + luc%nplant_x(p,d,froot) *fromPtoL(d,str,froot))
                dnsoil(p,r,:)   = dnsoil(p,r,:)   + transitx(r,d) * luc%nsoil_x(p,d,:)
                dnsoilmin(p,r)  = dnsoilmin(p,r)  + transitx(r,d) * luc%nsoilmin_x(p,d)
                dnwoodprod(p,r,:) = dnwoodprod(p,r,:) + transitx(r,d) &
                                                      *(fwoodprod(:)*luc%nplant_x(p,d,wood) + luc%nwoodprod_x(p,d,:))
             endif
             if(icycle >2) then
                dpplant(p,d,:)  = dpplant(p,d,:)  - transitx(r,d) * luc%pplant_x(p,d,:)
                dplitter(p,d,:) = dplitter(p,d,:) - transitx(r,d) * luc%nlitter_x(p,d,:)
                dpsoil(p,d,:)   = dpsoil(p,d,:)   - transitx(r,d) * luc%psoil_x(p,d,:)
                dpsoillab(p,d)  = dpsoillab(p,d)  - transitx(r,d) * luc%psoillab_x(p,d)
                dpsoilsorb(p,d) = dpsoilsorb(p,d) - transitx(r,d) * luc%psoilsorb_x(p,d)
                dpsoilocc(p,d)  = dpsoilocc(p,d)  - transitx(r,d) * luc%psoilocc_x(p,d)

                dplitter(p,r,1) = dplitter(p,r,1) + transitx(r,d)  &
                                * (luc%plitter_x(p,d,1) + luc%pplant_x(p,d,leaf) * fromPtoL(d,metb,leaf) &
                                                        + luc%pplant_x(p,d,froot)* fromPtoL(d,metb,froot))
                dplitter(p,r,2) = dplitter(p,r,2) + transitx(r,d)  &
                                * (luc%plitter_x(p,d,2) + luc%pplant_x(p,d,leaf) * fromPtoL(d,str,leaf) &
                                                        + luc%pplant_x(p,d,froot) *fromPtoL(d,str,froot))
                dpsoil(p,r,:)   = dpsoil(p,r,:)   + transitx(r,d) * luc%psoil_x(p,d,:)
                dpsoillab(p,r)  = dpsoillab(p,r)  + transitx(r,d) * luc%psoillab_x(p,d)
                dpsoilsorb(p,r) = dpsoilsorb(p,r) + transitx(r,d) * luc%psoilsorb_x(p,d)
                dpsoilocc(p,r)  = dpsoilocc(p,r)  + transitx(r,d) * luc%psoilocc_x(p,d)
                dpwoodprod(p,r,:) = dpwoodprod(p,r,:) + transitx(r,d)   &
                                                      * (fwoodprod(:) * luc%pplant_x(p,d,wood) +luc%pwoodprod_x(p,d,:))
             endif
         endif  ! of "atransit" >0.0, "luctype" >0 etc.
      enddo   ! of "d_tile"
      enddo   ! of "r_tile"

      !@@@@ here we deal with wood harvest from secondary forest (not done yet)

      luc%patchfrac_y(p,:)   = luc%patchfrac_x(p,:) + delarea(p,:)

      do d=1,mvmax
      luc%patchfrac_y(p,d)   = luc%patchfrac_x(p,d) + delarea(p,d)
      if(luc%patchfrac_y(p,d)>0.0) then
         luc%cplant_y(p,d,leaf)  = (luc%cplant_x(p,d,leaf) * luc%patchfrac_x(p,d) + dcplant(p,d,leaf))  &
                                    /luc%patchfrac_y(p,d)
         luc%cplant_y(p,d,wood)  = (luc%cplant_x(p,d,wood) * luc%patchfrac_x(p,d) + dcplant(p,d,wood))  &
                                    /luc%patchfrac_y(p,d)
         luc%cplant_y(p,d,froot) = (luc%cplant_x(p,d,froot)* luc%patchfrac_x(p,d) + dcplant(p,d,froot)) &
                                    /luc%patchfrac_y(p,d)
         luc%clabile_y(p,d)      = (luc%clabile_x(p,d)     * luc%patchfrac_x(p,d) + dclabile(p,d))      &
                                    /luc%patchfrac_y(p,d)
         luc%clitter_y(p,d,metb)  = (luc%clitter_x(p,d,metb) * luc%patchfrac_x(p,d) + dclitter(p,d,metb))  &
                                    /luc%patchfrac_y(p,d)
         luc%clitter_y(p,d,str)  = (luc%clitter_x(p,d,str) * luc%patchfrac_x(p,d) + dclitter(p,d,str))  &
                                    /luc%patchfrac_y(p,d)
         luc%clitter_y(p,d,cwd)  = (luc%clitter_x(p,d,cwd) * luc%patchfrac_x(p,d) + dclitter(p,d,cwd))  &
                                    /luc%patchfrac_y(p,d)
         luc%csoil_y(p,d,mic)    = (luc%csoil_x(p,d,mic)   * luc%patchfrac_x(p,d) + dcsoil(p,d,mic))    &
                                    /luc%patchfrac_y(p,d)
         luc%csoil_y(p,d,slow)   = (luc%csoil_x(p,d,slow)  * luc%patchfrac_x(p,d) + dcsoil(p,d,slow))   &
                                    /luc%patchfrac_y(p,d)
         luc%csoil_y(p,d,3)      = (luc%csoil_x(p,d,3)     * luc%patchfrac_x(p,d) + dcsoil(p,d,3))      &
                                    /luc%patchfrac_y(p,d)
         luc%cwoodprod_y(p,d,1)  = (luc%cwoodprod_x(p,d,1) * luc%patchfrac_x(p,d) + dcwoodprod(p,d,1))  &
                                    /luc%patchfrac_y(p,d)
         luc%cwoodprod_y(p,d,2)  = (luc%cwoodprod_x(p,d,2) * luc%patchfrac_x(p,d) + dcwoodprod(p,d,2))  &
                                    /luc%patchfrac_y(p,d)
         luc%cwoodprod_y(p,d,3)  = (luc%cwoodprod_x(p,d,3) * luc%patchfrac_x(p,d) + dcwoodprod(p,d,3))  &
                                    /luc%patchfrac_y(p,d)

         if(icycle >1) then
            luc%nplant_y(p,d,leaf)  = (luc%nplant_x(p,d,leaf) * luc%patchfrac_x(p,d) + dnplant(p,d,leaf))  &
                                    /luc%patchfrac_y(p,d)
            luc%nplant_y(p,d,wood)  = (luc%nplant_x(p,d,wood) * luc%patchfrac_x(p,d) + dnplant(p,d,wood))  &
                                    /luc%patchfrac_y(p,d)
            luc%nplant_y(p,d,froot) = (luc%nplant_x(p,d,froot)* luc%patchfrac_x(p,d) + dnplant(p,d,froot)) &
                                    /luc%patchfrac_y(p,d)
            luc%nlitter_y(p,d,metb) = (luc%nlitter_x(p,d,metb) * luc%patchfrac_x(p,d) + dnlitter(p,d,metb))  &
                                    /luc%patchfrac_y(p,d)
            luc%nlitter_y(p,d,str)  = (luc%nlitter_x(p,d,str) * luc%patchfrac_x(p,d) + dnlitter(p,d,str))  &
                                    /luc%patchfrac_y(p,d)
            luc%nlitter_y(p,d,cwd)  = (luc%nlitter_x(p,d,cwd) * luc%patchfrac_x(p,d) + dnlitter(p,d,cwd))  &
                                    /luc%patchfrac_y(p,d)
            luc%nsoil_y(p,d,mic)    = (luc%nsoil_x(p,d,mic)   * luc%patchfrac_x(p,d) + dnsoil(p,d,mic))    &
                                    /luc%patchfrac_y(p,d)
            luc%nsoil_y(p,d,slow)   = (luc%nsoil_x(p,d,slow)  * luc%patchfrac_x(p,d) + dnsoil(p,d,slow))   &
                                    /luc%patchfrac_y(p,d)
            luc%nsoil_y(p,d,3)      = (luc%nsoil_x(p,d,3)     * luc%patchfrac_x(p,d) + dnsoil(p,d,3))      &
                                    /luc%patchfrac_y(p,d)
            luc%nsoilmin_y(p,d)     = (luc%nsoilmin_x(p,d)    * luc%patchfrac_x(p,d) + dnsoilmin(p,d))      &
                                    /luc%patchfrac_y(p,d)

            luc%nwoodprod_y(p,d,1)  = (luc%nwoodprod_x(p,d,1) * luc%patchfrac_x(p,d) + dnwoodprod(p,d,1))  &
                                    /luc%patchfrac_y(p,d)
            luc%nwoodprod_y(p,d,2)  = (luc%nwoodprod_x(p,d,2) * luc%patchfrac_x(p,d) + dnwoodprod(p,d,2))  &
                                    /luc%patchfrac_y(p,d)
            luc%nwoodprod_y(p,d,3)  = (luc%nwoodprod_x(p,d,3) * luc%patchfrac_x(p,d) + dnwoodprod(p,d,3))  &
                                    /luc%patchfrac_y(p,d)
         endif
         if(icycle >2) then
            luc%pplant_y(p,d,leaf)  = (luc%pplant_x(p,d,leaf) * luc%patchfrac_x(p,d) + dpplant(p,d,leaf))  &
                                    /luc%patchfrac_y(p,d)
            luc%pplant_y(p,d,wood)  = (luc%pplant_x(p,d,wood) * luc%patchfrac_x(p,d) + dpplant(p,d,wood))  &
                                    /luc%patchfrac_y(p,d)
            luc%pplant_y(p,d,froot) = (luc%pplant_x(p,d,froot)* luc%patchfrac_x(p,d) + dpplant(p,d,froot)) &
                                    /luc%patchfrac_y(p,d)
            luc%plitter_y(p,d,metb)  = (luc%plitter_x(p,d,metb) * luc%patchfrac_x(p,d) + dplitter(p,d,metb))  &
                                    /luc%patchfrac_y(p,d)
            luc%plitter_y(p,d,str)  = (luc%plitter_x(p,d,str) * luc%patchfrac_x(p,d) + dplitter(p,d,str))  &
                                    /luc%patchfrac_y(p,d)
            luc%plitter_y(p,d,cwd)  = (luc%plitter_x(p,d,cwd) * luc%patchfrac_x(p,d) + dplitter(p,d,cwd))  &
                                    /luc%patchfrac_y(p,d)
            luc%psoil_y(p,d,mic)    = (luc%psoil_x(p,d,mic)   * luc%patchfrac_x(p,d) + dpsoil(p,d,mic))    &
                                    /luc%patchfrac_y(p,d)
            luc%psoil_y(p,d,slow)   = (luc%psoil_x(p,d,slow)  * luc%patchfrac_x(p,d) + dpsoil(p,d,slow))   &
                                    /luc%patchfrac_y(p,d)
            luc%psoil_y(p,d,3)      = (luc%psoil_x(p,d,3)     * luc%patchfrac_x(p,d) + dpsoil(p,d,3))      &
                                    /luc%patchfrac_y(p,d)
            luc%psoillab_y(p,d)     = (luc%psoillab_x(p,d)    * luc%patchfrac_x(p,d) + dpsoillab(p,d))     &
                                    /luc%patchfrac_y(p,d)
            luc%psoilsorb_y(p,d)    = (luc%psoilsorb_x(p,d)   * luc%patchfrac_x(p,d) + dpsoilsorb(p,d))    &
                                    /luc%patchfrac_y(p,d)
            luc%psoilocc_y(p,d)     = (luc%psoilocc_x(p,d)    * luc%patchfrac_x(p,d) + dpsoilocc(p,d))     &
                                    /luc%patchfrac_y(p,d)

            luc%pwoodprod_y(p,d,1)  = (luc%pwoodprod_x(p,d,1) * luc%patchfrac_x(p,d) + dpwoodprod(p,d,1))  &
                                    /luc%patchfrac_y(p,d)
            luc%pwoodprod_y(p,d,2)  = (luc%pwoodprod_x(p,d,2) * luc%patchfrac_x(p,d) + dpwoodprod(p,d,2))  &
                                    /luc%patchfrac_y(p,d)
            luc%pwoodprod_y(p,d,3)  = (luc%pwoodprod_x(p,d,3) * luc%patchfrac_x(p,d) + dpwoodprod(p,d,3))  &
                                    /luc%patchfrac_y(p,d)
         endif

      endif   ! luc%patchfrac_y(p,d)>0.0
      enddo   ! of "d"


      !update the biophysical variables here
      ! "isoil" and "soilorder" are contant within a landcell (see gridinfo)
      luc%isoil_y(p,1)     = dominantx(1,12,luc%patchfrac_x(p,1:mvmax),luc%isoil_x(p,1:mvmax))
      luc%soilorder_y(p,1) = dominantx(1,12,luc%patchfrac_x(p,1:mvmax),luc%soilorder_x(p,1:mvmax))
      ! may need to differentiate tree, grass and crop
      luc%phase_y(p,1)     = dominantx(0,3,luc%patchfrac_x(p,1:mvmax),luc%phase_x(p,1:mvmax))
      luc%doyphase3_y(p,1) = dominantx(0,365,luc%patchfrac_x(p,1:mvmax),luc%doyphase3_x(p,1:mvmax))
      do d=2,mvmax
         luc%isoil_y(p,d)     = luc%isoil_y(p,1)
         luc%soilorder_y(p,d) = luc%soilorder_y(p,1)
         luc%phase_y(p,d)     = luc%phase_y(p,1)
         luc%doyphase3_y(p,d) = luc%doyphase3_y(p,1)
      enddo

      do d=1,mvmax

         luc%iveg_y(p,d) = d

         luc%phen_y(p,d)  = avgpatchr2(d,luc%patchfrac_x(p,d),transitx(1:mvmax,1:mvmax),luc%phen_x(p,1:mvmax))
         luc%aphen_y(p,d) = avgpatchr2(d,luc%patchfrac_x(p,d),transitx(1:mvmax,1:mvmax),luc%aphen_x(p,1:mvmax))
         luc%frac_sapwood_y(p,d) =avgpatchr2(d,luc%patchfrac_x(p,d),transitx(1:mvmax,1:mvmax),luc%frac_sapwood_x(p,1:mvmax))
         luc%sapwood_area_y(p,d) =avgpatchr2(d,luc%patchfrac_x(p,d),transitx(1:mvmax,1:mvmax),luc%sapwood_area_x(p,1:mvmax))

         luc%sla_y(p,d) = luc%sla_x(p,d)
         luc%lai_y(p,d) = luc%sla_y(p,d) * max(0.0,luc%cplant_y(p,d,leaf))

         do irb=1,nrb
            luc%albsoilsn_y(p,d,irb)= avgpatchr2(d,luc%patchfrac_x(p,d),transitx(1:mvmax,1:mvmax),luc%albsoilsn_x(p,1:mvmax,irb))
            luc%albedo_y(p,d,irb)   = avgpatchr2(d,luc%patchfrac_x(p,d),transitx(1:mvmax,1:mvmax),luc%albedo_x(p,1:mvmax,irb))
            luc%albsoil_y(p,d,irb)  = avgpatchr2(d,luc%patchfrac_x(p,d),transitx(1:mvmax,1:mvmax),luc%albsoil_x(p,1:mvmax,irb))
         enddo

         luc%dgdtg_y(p,d) = avgpatchr2(d,luc%patchfrac_x(p,d),transitx(1:mvmax,1:mvmax),luc%dgdtg_x(p,1:mvmax))

         do is=1,ms
            luc%gammzz_y(p,d,is) = avgpatchr2(d,luc%patchfrac_x(p,d),transitx(1:mvmax,1:mvmax),luc%gammzz_x(p,1:mvmax,is))
            luc%tgg_y(p,d,is)    = avgpatchr2(d,luc%patchfrac_x(p,d),transitx(1:mvmax,1:mvmax),luc%tgg_x(p,1:mvmax,is))
            luc%wb_y(p,d,is)     = avgpatchr2(d,luc%patchfrac_x(p,d),transitx(1:mvmax,1:mvmax),luc%wb_x(p,1:mvmax,is))
            luc%wbice_y(p,d,is)  = avgpatchr2(d,luc%patchfrac_x(p,d),transitx(1:mvmax,1:mvmax),luc%wbice_x(p,1:mvmax,is))
         enddo

         do is=1,msn
            luc%tggsn_y(p,d,is)  = avgpatchr2(d,luc%patchfrac_x(p,d),transitx(1:mvmax,1:mvmax),luc%tggsn_x(p,1:mvmax,is))
            luc%ssdn_y(p,d,is)   = avgpatchr2(d,luc%patchfrac_x(p,d),transitx(1:mvmax,1:mvmax),luc%ssdn_x(p,1:mvmax,is))
            luc%smass_y(p,d,is)  = avgpatchr2(d,luc%patchfrac_x(p,d),transitx(1:mvmax,1:mvmax),luc%smass_x(p,1:mvmax,is))
            luc%sdepth_y(p,d,is) = avgpatchr2(d,luc%patchfrac_x(p,d),transitx(1:mvmax,1:mvmax),luc%sdepth_x(p,1:mvmax,is))
         enddo

         if(luc%smass_y(p,d,1)<=0.0) then
            luc%isflag_y(p,d) = 0
         else
            luc%isflag_y(p,d) = 1
         endif

         luc%tss_y(p,d)       = avgpatchr2(d,luc%patchfrac_x(p,d),transitx(1:mvmax,1:mvmax),luc%tss_x(p,1:mvmax))
         luc%rtsoil_y(p,d)    = avgpatchr2(d,luc%patchfrac_x(p,d),transitx(1:mvmax,1:mvmax),luc%rtsoil_x(p,1:mvmax))
         luc%runoff_y(p,d)    = avgpatchr2(d,luc%patchfrac_x(p,d),transitx(1:mvmax,1:mvmax),luc%runoff_x(p,1:mvmax))
         luc%rnof1_y(p,d)     = avgpatchr2(d,luc%patchfrac_x(p,d),transitx(1:mvmax,1:mvmax),luc%rnof1_x(p,1:mvmax))
         luc%rnof2_y(p,d)     = avgpatchr2(d,luc%patchfrac_x(p,d),transitx(1:mvmax,1:mvmax),luc%rnof2_x(p,1:mvmax))
         luc%ssdnn_y(p,d)     = avgpatchr2(d,luc%patchfrac_x(p,d),transitx(1:mvmax,1:mvmax),luc%ssdnn_x(p,1:mvmax))
         luc%snowd_y(p,d)     = avgpatchr2(d,luc%patchfrac_x(p,d),transitx(1:mvmax,1:mvmax),luc%snowd_x(p,1:mvmax))
         luc%snage_y(p,d)     = avgpatchr2(d,luc%patchfrac_x(p,d),transitx(1:mvmax,1:mvmax),luc%snage_x(p,1:mvmax))
         luc%osnowd_y(p,d)    = avgpatchr2(d,luc%patchfrac_x(p,d),transitx(1:mvmax,1:mvmax),luc%osnowd_x(p,1:mvmax))
         luc%cansto_y(p,d)    = avgpatchr2(d,luc%patchfrac_x(p,d),transitx(1:mvmax,1:mvmax),luc%cansto_x(p,1:mvmax))
         luc%ghflux_y(p,d)    = avgpatchr2(d,luc%patchfrac_x(p,d),transitx(1:mvmax,1:mvmax),luc%ghflux_x(p,1:mvmax))
         luc%sghflux_y(p,d)   = avgpatchr2(d,luc%patchfrac_x(p,d),transitx(1:mvmax,1:mvmax),luc%sghflux_x(p,1:mvmax))
         luc%ga_y(p,d)        = avgpatchr2(d,luc%patchfrac_x(p,d),transitx(1:mvmax,1:mvmax),luc%ga_x(p,1:mvmax))
         luc%fev_y(p,d)       = avgpatchr2(d,luc%patchfrac_x(p,d),transitx(1:mvmax,1:mvmax),luc%fev_x(p,1:mvmax))
         luc%fes_y(p,d)       = avgpatchr2(d,luc%patchfrac_x(p,d),transitx(1:mvmax,1:mvmax),luc%fes_x(p,1:mvmax))
         luc%fhs_y(p,d)       = avgpatchr2(d,luc%patchfrac_x(p,d),transitx(1:mvmax,1:mvmax),luc%fhs_x(p,1:mvmax))
         luc%wbtot0_y(p,d)    = avgpatchr2(d,luc%patchfrac_x(p,d),transitx(1:mvmax,1:mvmax),luc%wbtot0_x(p,1:mvmax))
         luc%osnowd0_y(p,d)   = avgpatchr2(d,luc%patchfrac_x(p,d),transitx(1:mvmax,1:mvmax),luc%osnowd0_x(p,1:mvmax))
         luc%trad_y(p,d)      = avgpatchr2(d,luc%patchfrac_x(p,d),transitx(1:mvmax,1:mvmax),luc%trad_x(p,1:mvmax))
         luc%GWwb_y(p,d)      = avgpatchr2(d,luc%patchfrac_x(p,d),transitx(1:mvmax,1:mvmax),luc%GWwb_x(p,1:mvmax))

         do icp=1,ncp
            luc%cplantx_y(p,d,icp) = avgpatchr2(d,luc%patchfrac_x(p,d),transitx(1:mvmax,1:mvmax),luc%cplantx_x(p,1:mvmax,icp))
         enddo

         do ics=1,ncs
            luc%csoilx_y(p,d,ics)  = avgpatchr2(d,luc%patchfrac_x(p,d),transitx(1:mvmax,1:mvmax),luc%csoilx_x(p,1:mvmax,ics))
         enddo

      enddo   ! of "d"


      ! adding seeding biomass if area > critical value but biomass is too low
      do d=1,mvmax
         ivt = d
         if(luc%patchfrac_x(p,d)<thresh_frac.and.luc%patchfrac_y(p,d)>thresh_frac) then  !newly-born patch
            if(d==1.or.d==2) then
               luc%phase_y(p,d) = 2
            else
               luc%phase_y(p,d) = 0
            endif
         else
            luc%phase_y(p,d) = luc%phase_x(p,d)
         endif

         if(luc%patchfrac_y(p,d) > thresh_frac.and.sum(luc%cplant_y(p,d,1:3))<fseedling) then
            if(ivt2(ivt)==1) then
               luc%cplant_y(p,d,:) = fseedling * fracgrassseed(:)
            else
               luc%cplant_y(p,d,:) = fseedling * fracwoodseed(:)
            endif
            if(icycle >1) then
               luc%nplant_y(p,d,:) = luc%cplant_y(p,d,:) * casabiome%ratioNCplantmax(ivt,:)
            endif
            if(icycle >2) then
               luc%pplant_y(p,d,:) = luc%nplant_y(p,d,:) /casabiome%ratioNPplantmin(ivt,:)
            endif
         endif
      enddo  ! of "d"

    enddo    ! of "p"

    CONTAINS
      function avgpatchr2(q,areax,x2y,x) result(avgr2)
      ! check note: workbook, 2017, p121
      integer q, k1, k2
      real(r_2)                         :: avgr2
      real(r_2)                         :: areax
      real(r_2)                         :: xloss,xgain,delareax
      real(r_2), dimension(mvmax,mvmax) :: x2y
      real(r_2), dimension(mvmax)       :: x

        avgr2=x(q)
        do k1=1,mvmax   ! loss
           if(k1/=q) then
              xloss = xloss + x2y(k1,q) * x(q)
              delareax = delareax - x2y(k1,q)
           endif
        enddo

        do k2=1,mvmax
           if(k2/=q) then
              xgain = xgain +x2y(q,k2)  * x(k2)
              delareax = delareax + x2y(q,k2)
           endif
        enddo
        if((areax+delareax) > thresh_frac) then
           avgr2= (x(q)*areax +xgain-xloss)/(areax+delareax)
        endif
      end function avgpatchr2


      function dominantx(xmin,xmax,fracx,xk) result(dominantint)
      ! take the value for the patch with maximum area fraction
      ! check note: workbook, 2017, p121
      integer dominantint
      integer xmin,xmax,k
      integer,   dimension(mvmax)       :: xk
      real(r_2), dimension(mvmax)       :: fracx
      real(r_2)  fracxmax

        dominantint = min(xmax,max(xmin,xk(1)))
        fracxmax  = fracx(1)
        do k=2,mvmax
           if(fracx(k)>fracxmax) then
              fracxmax = fracx(k)
              dominantint = xk(k)
           endif
        enddo
      end function dominantx


END SUBROUTINE landuse_transitx

   SUBROUTINE landuse_redistribution(p,mvmax,delfracx,atransx)
      !*## Purpose
      !
      ! Redistribution of the plant functional type transition to ensure that
      ! the change in plant functional type fractions from the state data is
      ! consistent with the estimates from previous states and transition.
      USE cable_def_types_mod,    ONLY: r_2
      implicit none
      real,    parameter                          :: thresh_frac=1.0e-6
      integer p,mvmax
      real(r_2),    dimension(mvmax,mvmax)  :: atransx
      ! local variables
      integer itemp,i,j,k,ndonor,nreceive,vi,vj,np
      real(r_2)     temp
      real(r_2),    dimension(mvmax,mvmax)  :: transx,transy
      real(r_2),    dimension(mvmax)        :: delx,delfracx,donor,receive
      integer,          dimension(mvmax)    :: ivt,ivtdonor,ivtreceive

       atransx(:,:)   = 0.0;     delx=delfracx

       ! check the sum is zero
       if(abs(sum(delx(1:mvmax)))>thresh_frac) then
          print *, 'unbalanced ', p,delx(1:mvmax),sum(delx(1:mvmax))
       endif

       do i=1,mvmax
          ivt(i) = i
       enddo

       ! sort data from the smallest to the largest
       ! receiveer: negative; donor: positive
       do j=mvmax-1,1,-1
          do i=1,j
             if(delx(i) < delx(i+1)) then
                temp      = delx(i)
                itemp     = ivt(i)
                delx(i)   = delx(i+1)
                ivt(i)    = ivt(i+1)
                delx(i+1) = temp
                ivt(i+1)  = itemp
             endif
          enddo
       enddo

       ! determine number of negative (receive) and positives (donor)
       ndonor=0;nreceive=0
       do i=1,mvmax
          if(delx(i) >0.0) ndonor = ndonor+1
          if(delx(i) <0.0) nreceive=nreceive+1
       enddo

       donor(1:ndonor)    = delx(1:ndonor)
       ivtdonor(1:ndonor) = ivt(1:ndonor)

       do i=mvmax,mvmax-nreceive+1,-1
          j=mvmax-i+1
          receive(j)    = delx(i)
          ivtreceive(j) = ivt(i)
       enddo

       ! donor to receive
       do i=1,ndonor
          if(donor(i) > 0.0) then
             do j=1,nreceive
                if(receive(j) <0.0) then
                   vi = ivtdonor(i)
                   vj = ivtreceive(j)
                   if(donor(i)>=-receive(j)) then
                      atransx(vj,vi) = atransx(vj,vi) - receive(j)
                      donor(i)       = donor(i) + receive(j)
                      receive(j)     = 0.0
                   else
                      atransx(vj,vi) = atransx(vj,vi) + donor(i)
                      receive(j)     = receive(j) + donor(i)
                      donor(i)       = 0.0
                   endif
                endif
             enddo  ! "j"
          endif
       enddo    ! "i"


       ! verify the results
       delx = delfracx
       do j=1,mvmax    ! primary land
       do i=11,13,1    ! secondary forest
          delx(j) = delx(j) - atransx(i,j)
          delx(i) = delx(i) + atransx(i,j)
       enddo
       enddo

       do i=1,mvmax
          if(delx(i) > thresh_frac) then
             print *, 'warning: landuse_redistribution faile ', p,i,delx(i)
          endif
       enddo

 END SUBROUTINE landuse_redistribution

 SUBROUTINE landuse_update_mland(luc)
 !! Assigns `luc%var_y` to `luc%var_x`
 USE landuse_variable,   ONLY: landuse_mland
 IMPLICIT NONE
 TYPE(landuse_mland) :: luc

    ! general patch variables
    luc%iveg_x      = luc%iveg_y
    luc%isoil_x     = luc%isoil_y
    luc%soilorder_x = luc%soilorder_y
    luc%phase_x     = luc%phase_y

    luc%doyphase3_x = luc%doyphase3_y
    luc%phen_x      = luc%phen_y
    luc%aphen_x     = luc%aphen_y
    luc%frac_sapwood_x=luc%frac_sapwood_y
    luc%sapwood_area_x=luc%sapwood_area_y

    luc%isflag_x    = luc%isflag_y
    luc%patchfrac_x = luc%patchfrac_y
    luc%lai_x       = luc%lai_y
    luc%sla_x       = luc%sla_y

    ! biophysical
    luc%albsoilsn_x  = luc%albsoilsn_y
    luc%albedo_x     = luc%albedo_y
    luc%albsoil_x    = luc%albsoil_y
    luc%dgdtg_x      = luc%dgdtg_y
    luc%gammzz_x     = luc%gammzz_y
    luc%tgg_x        = luc%tgg_y
    luc%wb_x         = luc%wb_y
    luc%wbice_x      = luc%wbice_y
    luc%tggsn_x      = luc%tggsn_y
    luc%ssdn_x       = luc%ssdn_y
    luc%smass_x      = luc%smass_y
    luc%sdepth_x     = luc%sdepth_y
    luc%tss_x        = luc%tss_y
    luc%rtsoil_x     = luc%rtsoil_y
    luc%runoff_x     = luc%runoff_y
    luc%rnof1_x      = luc%rnof1_y
    luc%rnof2_x      = luc%rnof2_y
    luc%ssdnn_x      = luc%ssdnn_y
    luc%snowd_x      = luc%snowd_y
    luc%snage_x      = luc%snage_y
    luc%osnowd_x     = luc%osnowd_y
    luc%cansto_x     = luc%cansto_y
    luc%ghflux_x     = luc%ghflux_y
    luc%sghflux_x    = luc%sghflux_y
    luc%ga_x         = luc%ga_y
    luc%fev_x        = luc%fev_y
    luc%fes_x        = luc%fes_y
    luc%fhs_x        = luc%fhs_y
    luc%wbtot0_x     = luc%wbtot0_y
    luc%osnowd0_x    = luc%osnowd0_y
    luc%trad_x       = luc%trad_y
    luc%GWwb_x       = luc%GWwb_y
    luc%cplantx_x    = luc%cplantx_y
    luc%csoilx_x     = luc%csoilx_y

    ! biogeochemical variables
    luc%cplant_x    = luc%cplant_y
    luc%nplant_x    = luc%nplant_y
    luc%pplant_x    = luc%pplant_y
    luc%clitter_x   = luc%clitter_y
    luc%nlitter_x   = luc%nlitter_y
    luc%plitter_x   = luc%plitter_y
    luc%csoil_x     = luc%csoil_y
    luc%nsoil_x     = luc%nsoil_y
    luc%psoil_x     = luc%psoil_y
    luc%clabile_x   = luc%clabile_y
    luc%nsoilmin_x  = luc%nsoilmin_y
    luc%psoillab_x  = luc%psoillab_y
    luc%psoilsorb_x = luc%psoilsorb_y
    luc%psoilocc_x  = luc%psoilocc_y
    luc%cwoodprod_x = luc%cwoodprod_y
    luc%nwoodprod_x = luc%nwoodprod_y
    luc%pwoodprod_x = luc%pwoodprod_y

 END SUBROUTINE landuse_update_mland

 SUBROUTINE landuse_land2mpx(luc,lucmp,mpx)
 !! Maps `luc%var_y(mland,mvmax)` to `lucmp%var(mp)`
 USE landuse_constant,     ONLY: mvmax
 USE landuse_variable
 USE cable_def_types_mod,  ONLY: mland
 IMPLICIT NONE
 TYPE(landuse_mland)         :: luc
 TYPE(landuse_mp)            :: lucmp
! integer, dimension(mland)   :: cstart,cend,nap
 integer mpx
 integer np,np1,p,q,n,npnew,npold

    npnew=0; npold=0
    do p=1,mland
       do q=1,mvmax
          if(luc%patchfrac_x(p,q)>thresh_frac) then
             npold=npold +1
          endif
          if(luc%patchfrac_y(p,q)>thresh_frac) then
             npnew = npnew +1
             lucmp%iveg(npnew)      = q
             lucmp%isoil(npnew)     = luc%isoil_y(p,q)
             lucmp%soilorder(npnew) = luc%soilorder_y(p,q)
             lucmp%phase(npnew)      = luc%phase_y(p,q)
             lucmp%isflag(npnew)     = luc%isflag_y(p,q)
             lucmp%patchfrac(npnew)  = luc%patchfrac_y(p,q)
             lucmp%lai(npnew)        = luc%lai_y(p,q)
             lucmp%sla(npnew)        = luc%sla_y(p,q)

             lucmp%doyphase3(npnew) = luc%doyphase3_y(p,q)
             lucmp%phen(npnew)      = luc%phen_y(p,q)
             lucmp%aphen(npnew)     = luc%aphen_y(p,q)
             lucmp%frac_sapwood(npnew) =luc%frac_sapwood_y(p,q)
             lucmp%sapwood_area(npnew) =luc%sapwood_area_y(p,q)

             ! biophysical
             lucmp%albsoilsn(npnew,:)= luc%albsoilsn_y(p,q,:)
             lucmp%albedo(npnew,:)   = luc%albedo_y(p,q,:)
             lucmp%albsoil(npnew,:)  = luc%albsoil_y(p,q,:)
             lucmp%dgdtg(npnew)      = luc%dgdtg_y(p,q)
             lucmp%gammzz(npnew,:)   = luc%gammzz_y(p,q,:)
             lucmp%tgg(npnew,:)      = luc%tgg_y(p,q,:)
             lucmp%wb(npnew,:)       = luc%wb_y(p,q,:)
             lucmp%wbice(npnew,:)    = luc%wbice_y(p,q,:)
             lucmp%tggsn(npnew,:)    = luc%tggsn_y(p,q,:)
             lucmp%ssdn(npnew,:)     = luc%ssdn_y(p,q,:)
             lucmp%smass(npnew,:)    = luc%smass_y(p,q,:)
             lucmp%sdepth(npnew,:)   = luc%sdepth_y(p,q,:)
             lucmp%tss(npnew)        = luc%tss_y(p,q)
             lucmp%rtsoil(npnew)     = luc%rtsoil_y(p,q)
             lucmp%runoff(npnew)     = luc%runoff_y(p,q)
             lucmp%rnof1(npnew)      = luc%rnof1_y(p,q)
             lucmp%rnof2(npnew)      = luc%rnof2_y(p,q)
             lucmp%ssdnn(npnew)      = luc%ssdnn_y(p,q)
             lucmp%snowd(npnew)      = luc%snowd_y(p,q)
             lucmp%snage(npnew)      = luc%snage_y(p,q)
             lucmp%osnowd(npnew)     = luc%osnowd_y(p,q)
             lucmp%cansto(npnew)     = luc%cansto_y(p,q)
             lucmp%ghflux(npnew)     = luc%ghflux_y(p,q)
             lucmp%sghflux(npnew)    = luc%sghflux_y(p,q)
             lucmp%ga(npnew)         = luc%ga_y(p,q)
             lucmp%fev(npnew)        = luc%fev_y(p,q)
             lucmp%fes(npnew)        = luc%fes_y(p,q)
             lucmp%fhs(npnew)        = luc%fhs_y(p,q)
             lucmp%wbtot0(npnew)     = luc%wbtot0_y(p,q)
             lucmp%osnowd0(npnew)    = luc%osnowd0_y(p,q)
             lucmp%trad(npnew)       = luc%trad_y(p,q)
             lucmp%GWwb(npnew)       = luc%GWwb_y(p,q)
             lucmp%cplantx(npnew,:)  = luc%cplantx_y(p,q,:)
             lucmp%csoilx(npnew,:)   = luc%csoilx_y(p,q,:)

             ! assign the new biogeochemocal state variables
             if(icycle > 0) then
                lucmp%cplant(npnew,:)    = luc%cplant_y(p,q,:)
                lucmp%clitter(npnew,:)   = luc%clitter_y(p,q,:)
                lucmp%csoil(npnew,:)     = luc%csoil_y(p,q,:)
                lucmp%clabile(npnew)     = luc%clabile_y(p,q)
                lucmp%cwoodprod(npnew,:) = luc%cwoodprod_y(p,q,:)
             endif
             if(icycle >1) then
                lucmp%nplant(npnew,:)    = luc%nplant_y(p,q,:)
                lucmp%nlitter(npnew,:)   = luc%nlitter_y(p,q,:)
                lucmp%nsoil(npnew,:)     = luc%nsoil_y(p,q,:)
                lucmp%nsoilmin(npnew)    = luc%nsoilmin_y(p,q)
                lucmp%nwoodprod(npnew,:) = luc%nwoodprod_y(p,q,:)
             endif
             if(icycle >2) then
                lucmp%pplant(npnew,:)    = luc%pplant_y(p,q,:)
                lucmp%plitter(npnew,:)   = luc%plitter_y(p,q,:)
                lucmp%psoil(npnew,:)     = luc%psoil_y(p,q,:)
                lucmp%psoillab(npnew)    = luc%psoillab_y(p,q)
                lucmp%psoilsorb(npnew)   = luc%psoilsorb_y(p,q)
                lucmp%psoilocc(npnew)    = luc%psoilocc_y(p,q)
                lucmp%pwoodprod(npnew,:) = luc%pwoodprod_y(p,q,:)
             endif
          endif
          !update patch_type
       enddo   ! end of "q"
    enddo  ! end of "p"

    print *, 'npnew npold', npnew,npold

 END SUBROUTINE landuse_land2mpx

 SUBROUTINE landuse_checks(mlon,mlat,landmask,luc)
 !! Checks the mass balance and writes the output CNP pool sizes for each
 !! plant functional type.
 use landuse_constant,     ONLY: mvmax
 use landuse_variable,     ONLY: landuse_mland
 USE cable_def_types_mod,  ONLY: mland,r_2

 IMPLICIT NONE
 integer mlon,mlat
 real, parameter      :: xunit = 1.0e-15
 TYPE(landuse_mland)  :: luc
 integer,       dimension(mlon,mlat) :: landmask
 real(r_2), dimension(mvmax)     :: areapft
 real(r_2), dimension(mvmax)     :: cpland,npland,ppland
 real(r_2), dimension(mvmax)     :: clland,nlland,plland
 real(r_2), dimension(mvmax)     :: csland,nsland,psland
 real(r_2), dimension(mvmax)     :: clabland,nsminland,pslabland,pssorbland,psoccland
 real(r_2), dimension(mvmax)     :: cwoodland,nwoodland,pwoodland
 integer n,v
 real(r_2)  totalc,totaln,totalp,totarea

    areapft=0.0
    totalc=0.0;      totaln=0.0;      totalp=0.0;     totarea=0.0
    cpland = 0.0;    npland = 0.0;    ppland=0.0
    clland = 0.0;    nlland = 0.0;    plland = 0.0
    csland = 0.0;    nsland = 0.0;    psland = 0.0
    nsminland=0.0;   pslabland=0.0;   pssorbland=0.0; psoccland = 0.0
    cwoodland = 0.0; nwoodland = 0.0; pwoodland = 0.0

    do n=1,mland
    do v=1,mvmax
    if(luc%patchfrac_y(n,v) > 0.0) then

       areapft(v)= areapft(v)+ luc%patchfrac_y(n,v)
       cpland(v) = cpland(v) + luc%patchfrac_y(n,v) * sum(luc%cplant_y(n,v,1:3))
       npland(v) = npland(v) + luc%patchfrac_y(n,v) * sum(luc%nplant_y(n,v,1:3))
       ppland(v) = ppland(v) + luc%patchfrac_y(n,v) * sum(luc%pplant_y(n,v,1:3))
       clland(v) = clland(v) + luc%patchfrac_y(n,v) * sum(luc%clitter_y(n,v,1:3))
       nlland(v) = nlland(v) + luc%patchfrac_y(n,v) * sum(luc%nlitter_y(n,v,1:3))
       plland(v) = plland(v) + luc%patchfrac_y(n,v) * sum(luc%plitter_y(n,v,1:3))
       csland(v) = csland(v) + luc%patchfrac_y(n,v) * sum(luc%csoil_y(n,v,1:3))
       nsland(v) = nsland(v) + luc%patchfrac_y(n,v) * sum(luc%nsoil_y(n,v,1:3))
       psland(v) = psland(v) + luc%patchfrac_y(n,v) * sum(luc%psoil_y(n,v,1:3))

       clabland(v)   = clabland(v)   + luc%patchfrac_y(n,v) * luc%clabile_y(n,v)
       nsminland(v)  = nsminland(v)  + luc%patchfrac_y(n,v) * luc%nsoilmin_y(n,v)
       pslabland(v)  = pslabland(v)  + luc%patchfrac_y(n,v) * luc%psoillab_y(n,v)
       pssorbland(v) = pssorbland(v) + luc%patchfrac_y(n,v) * luc%psoilsorb_y(n,v)
       psoccland(v)  = psoccland(v)  + luc%patchfrac_y(n,v) * luc%psoilocc_y(n,v)
       cwoodland(v)  = cwoodland(v)  + luc%patchfrac_y(n,v) * sum(luc%cwoodprod_y(n,v,1:3))
       nwoodland(v)  = nwoodland(v)  + luc%patchfrac_y(n,v) * sum(luc%nwoodprod_y(n,v,1:3))
       pwoodland(v)  = pwoodland(v)  + luc%patchfrac_y(n,v) * sum(luc%pwoodprod_y(n,v,1:3))
    endif
    enddo
    enddo

    totalc = sum(cpland+clland+csland+clabland+cwoodland)
    totaln = sum(npland+nlland+nsland+nsminland+nwoodland)
    totalp = sum(ppland+plland+psland+pslabland+pssorbland+psoccland+pwoodland)

    do v=1,mvmax
       write(21,201) v, areapft(v),cpland(v)+clland(v)+csland(v)+clabland(v)+cwoodland(v),     &
                        npland(v)+nlland(v)+nsland(v)+nsminland(v)+nwoodland(v),               &
                        ppland(v)+plland(v)+psland(v)+pslabland(v)+pssorbland(v)+psoccland(v)+pwoodland(v)
    enddo
    write(21,202) sum(areapft),totalc,totaln,totalp

201 format(i3,2x,20(f10.5,2x))
202 format(20(f10.5,2x))

 END SUBROUTINE landuse_checks