   subroutine endrun
   call abort
   return
   end
module TridiagonalMod

!-----------------------------------------------------------------------
!BOP
!
! !MODULE: TridiagonalMod
!
! !DESCRIPTION:
! Tridiagonal matrix solution
!
! !PUBLIC TYPES:
  implicit none
  save
!
! !PUBLIC MEMBER FUNCTIONS:
  public :: Tridiagonal
!
! !REVISION HISTORY:
! Created by Mariana Vertenstein
!
!EOP
!-----------------------------------------------------------------------

contains

!-----------------------------------------------------------------------
!BOP
!
! !IROUTINE: Tridiagonal
!
! !INTERFACE:
  subroutine Tridiagonal (lbc, ubc, lbj, ubj, jtop, numf, filter, &
                          a, b, c, r, u)
!
! !DESCRIPTION:
! Tridiagonal matrix solution
!
! !USES:
    use shr_kind_mod, only: r8 => shr_kind_r8
!
! !ARGUMENTS:
    implicit none
    integer , intent(in)    :: lbc, ubc               ! lbinning and ubing column indices
    integer , intent(in)    :: lbj, ubj               ! lbinning and ubing level indices
    integer , intent(in)    :: jtop(lbc:ubc)          ! top level for each column
    integer , intent(in)    :: numf                   ! filter dimension
    integer , intent(in)    :: filter(1:numf)         ! filter
    real(r8), intent(in)    :: a(lbc:ubc, lbj:ubj)    ! "a" left off diagonal of tridiagonal matrix
    real(r8), intent(in)    :: b(lbc:ubc, lbj:ubj)    ! "b" diagonal column for tridiagonal matrix
    real(r8), intent(in)    :: c(lbc:ubc, lbj:ubj)    ! "c" right off diagonal tridiagonal matrix
    real(r8), intent(in)    :: r(lbc:ubc, lbj:ubj)    ! "r" forcing term of tridiagonal matrix
    real(r8), intent(inout) :: u(lbc:ubc, lbj:ubj)    ! solution
!
! !CALLED FROM:
! subroutine BiogeophysicsLake in module BiogeophysicsLakeMod
! subroutine SoilTemperature in module SoilTemperatureMod
! subroutine SoilWater in module HydrologyMod
!
! !REVISION HISTORY:
! 15 September 1999: Yongjiu Dai; Initial code
! 15 December 1999:  Paul Houser and Jon Radakovich; F90 Revision
!  1 July 2003: Mariana Vertenstein; modified for vectorization
!
!
! !OTHER LOCAL VARIABLES:
!EOP
!
    integer  :: j,ci,fc                   !indices
    real(r8) :: gam(lbc:ubc,lbj:ubj)      !temporary
    real(r8) :: bet(lbc:ubc)              !temporary
!-----------------------------------------------------------------------

    ! Solve the matrix

!dir$ concurrent
!cdir nodep
    do fc = 1,numf
       ci = filter(fc)
       bet(ci) = b(ci,jtop(ci))
    end do

    do j = lbj, ubj
!dir$ prefervector
!dir$ concurrent
!cdir nodep
       do fc = 1,numf
          ci = filter(fc)
          if (j >= jtop(ci)) then
             if (j == jtop(ci)) then
                u(ci,j) = r(ci,j) / bet(ci)
              else
                gam(ci,j) = c(ci,j-1) / bet(ci)
                bet(ci) = b(ci,j) - a(ci,j) * gam(ci,j)
                u(ci,j) = (r(ci,j) - a(ci,j)*u(ci,j-1)) / bet(ci)

             end if
          end if
       end do
    end do

!Cray X1 unroll directive used here as work-around for compiler issue 2003/10/20
!dir$ unroll 0
    do j = ubj-1,lbj,-1
!dir$ prefervector
!dir$ concurrent
!cdir nodep
       do fc = 1,numf
          ci = filter(fc)
          if (j >= jtop(ci)) then
             u(ci,j) = u(ci,j) - gam(ci,j+1) * u(ci,j+1)

          end if
       end do
    end do

  end subroutine Tridiagonal

end module TridiagonalMod
module globals

!----------------------------------------------------------------------- 
!BOP
!
! !MODULE: globals
!
! !DESCRIPTION: 
! Module of global time-related control variables
!
! !USES:
  use shr_kind_mod, only: r8 => shr_kind_r8
!
! !PUBLIC TYPES:
  implicit none
!  save
  integer  :: nstep      !time step number
  real(r8):: dtime      !land model time step (sec)
!ylu add   dt may be same as dtime, dtime=get_step_size(), dt=real(get_step_size(),r8)
  real(r8):: dt         !radiation time step (sec)
  integer :: iyear0
  integer :: day_per_year  ! Get the number of days per year for currrent year

!end add
  logical :: is_perpetual  = .false.    ! true when using perpetual calendar

  integer :: year
  integer :: month      !current month (1 -> 12)
  integer :: day        !current day (1 -> 31)
  integer :: secs       ! seconds into current date
  real(r8):: calday     !calendar day

  integer :: yrp1
  integer :: monp1      !current month (1 -> 12)
  integer :: dayp1      !current day (1 -> 31)
  integer :: secp1
  real(r8):: caldayp1   !calendar day for next time step

  integer :: nbdate
!                              
!EOP
!----------------------------------------------------------------------- 
 contains
   subroutine globals_mod
   end subroutine globals_mod
end module globals
module nanMod

!-----------------------------------------------------------------------
!BOP
!
! !MODULE: nanMod
!
! !DESCRIPTION:
! Set parameters for the floating point flags "inf" Infinity
! and "nan" not-a-number. As well as "bigint" the point
! at which integers start to overflow. These values are used
! to initialize arrays with as a way to detect if arrays
! are being used before being set.
! Note that bigint is the largest possible 32-bit integer.
!
! !USES:
  use shr_kind_mod, only: r8 => shr_kind_r8
!
! !PUBLIC TYPES:
  implicit none
  save
#ifdef __PGI
! quiet nan for portland group compilers
  real(r8), parameter :: inf = O'0777600000000000000000'
  real(r8), parameter :: nan = O'0777700000000000000000'
  integer,  parameter :: bigint = O'17777777777'
#elif __GNUC__
  real(r8), parameter :: inf = 1.e19
  real(r8), parameter :: nan = 1.e21
  integer,  parameter :: bigint = O'17777777777'
#else
! signaling nan otherwise
  real(r8), parameter :: inf = O'0777600000000000000000'
  real(r8), parameter :: nan = O'0777610000000000000000'
  integer,  parameter :: bigint = O'17777777777'
#endif
!
! !REVISION HISTORY:
! Created by Mariana Vertenstein based on cam module created by
! CCM core group
!
!EOP
!-----------------------------------------------------------------------
 contains
   subroutine nanMod_mod
   end subroutine nanMod_mod
end module nanMod
!-----------------------------------------------------------------------
!BOP
!
! !ROUTINE: mkrank
!
! !INTERFACE:
subroutine mkrank (n, a, miss, iv, num)
!
! !DESCRIPTION:
! Return indices of largest [num] values in array [a]
!
! !USES:
  use shr_kind_mod, only: r8 => shr_kind_r8
!
! !ARGUMENTS:
  implicit none
  integer , intent(in) :: n        !array length
  real(r8), intent(in) :: a(0:n)   !array to be ranked
  integer , intent(in) :: miss     !missing data value
  integer , intent(in) :: num      !number of largest values requested
  integer , intent(out):: iv(num)  !index to [num] largest values in array [a]
!
! !CALLED FROM:
! subroutine mkpft
! subroutine mksoicol
! subroutine mksoitex
!
! !REVISION HISTORY:
! Author: Gordon Bonan
!
!EOP
!
! !LOCAL VARIABLES:
  real(r8) a_max       !maximum value in array
  integer i            !array index
  real(r8) delmax      !tolerance for finding if larger value
  integer m            !do loop index
  integer k            !do loop index
  logical exclude      !true if data value has already been chosen
!-----------------------------------------------------------------------

  delmax = 1.e-06

  ! Find index of largest non-zero number

  iv(1) = miss
  a_max = -9999.

  do i = 0, n
     if (a(i)>0. .and. (a(i)-a_max)>delmax) then
        a_max = a(i)
        iv(1)  = i
     end if
  end do

  ! iv(1) = miss indicates no values > 0. this is an error

  if (iv(1) == miss) then
     write (6,*) 'MKRANK error: iv(1) = missing'
     call endrun
  end if

  ! Find indices of the next [num]-1 largest non-zero number.
  ! iv(m) = miss if there are no more values > 0

  do m = 2, num
     iv(m) = miss
     a_max = -9999.
     do i = 0, n

        ! exclude if data value has already been chosen

        exclude = .false.
        do k = 1, m-1
           if (i == iv(k)) exclude = .true.
        end do

        ! if not already chosen, see if it is the largest of
        ! the remaining values

        if (.not. exclude) then
           if (a(i)>0. .and. (a(i)-a_max)>delmax) then
              a_max = a(i)
              iv(m)  = i
           end if
        end if
     end do
  end do

  return
end subroutine mkrank
module clm_varpar

!-----------------------------------------------------------------------
!BOP
!
! !MODULE: clm_varpar
!
! !DESCRIPTION:
! Module containing CLM parameters
!
! !USES:
  use shr_kind_mod, only: r8 => shr_kind_r8
!
! !PUBLIC TYPES:
  implicit none
  save
!
! Define land surface 2-d grid. This sets the model resolution according
! to cpp directives LSMLON and LSMLAT in preproc.h.
!
!  integer, parameter :: lsmlon = LSMLON     ! maximum number of longitude points on lsm grid
!  integer, parameter :: lsmlat = LSMLAT     ! number of latitude points on lsm grid
! tcx make it dynamic, read from surface dataset

  integer, parameter :: lsmlon   = 1           ! maximum number of longitude points on lsm grid
  integer, parameter :: lsmlat   = 1        ! number of latitude points on lsm grid

! Define number of levels

  integer, parameter :: nlevsoi     =  10   ! number of soil layers
  integer, parameter :: nlevlak     =  10   ! number of lake layers
  integer, parameter :: nlevsno     =   5   ! maximum number of snow layers
!ylu add
  integer, parameter :: nlevgrnd    =  10 ! 10 ! 10 ! 10 ! 10 ! 10 ! 10 ! 10 ! 10 ! 10 ! 15     ! number of ground layers (includes lower layers that are hydrologically inactive)
  integer, parameter :: nlevurb     = nlevgrnd! number of urban layers (must equal nlevgrnd right now)
!ylu end
! Define miscellaneous parameters

  integer, parameter :: numwat      =   5   ! number of water types (soil, ice, 2 lakes, wetland)
 ! integer, parameter :: npftpar     =  32   ! number of pft parameters (in LPJ - DGVM only)
  integer, parameter :: numrad      =   2   ! number of solar radiation bands: vis, nir
!ylu add 
  integer, parameter :: numsolar    =   2   ! number of solar type bands: direct, diffuse
!ylu end
  integer, parameter :: ndst        =   4   ! number of dust size classes (BGC only)
  integer, parameter :: dst_src_nbr =   3   ! number of size distns in src soil (BGC only)
  integer, parameter :: sz_nbr      = 200   ! number of sub-grid bins in large bin of dust size distribution (BGC only)
  integer, parameter :: nvoc        =   5   ! number of voc categories (BGC only)
!Not found in CLM3.5, putting back in from CLM3
!ylu remove
  integer, parameter :: numcol      =   8   !number of soil color types

! Define parameters for RTM river routing model

  integer, parameter :: rtmlon = 720  !number of rtm longitudes
  integer, parameter :: rtmlat = 360  !number of rtm latitudes

! Define indices used in surface file read
! maxpatch_pft  = max number of vegetated pfts in naturally vegetated landunit
! maxpatch_crop = max number of crop pfts in crop landunit
!ylu add 10/15/10
#if (defined CROP)
  integer, parameter :: numpft         = 20  ! number of plant types
  integer, parameter :: numcft         =  6     ! actual # of crops
  integer, parameter :: numveg         = 16     ! number of veg types (without specific crop)
#else
  integer, parameter :: numpft         = 16     ! actual # of pfts (without bare)
  integer, parameter :: numcft         =  2     ! actual # of crops
  integer, parameter :: numveg         = numpft ! number of veg types (without specific crop)
#endif
  integer, parameter :: maxpatch_urb   = 1  !  5  ! the current coupling not include urban. 
#ifdef CROP
  integer, parameter :: maxpatch_cft   = 4    !YL changed from 2 to 4
#else
  integer, parameter :: maxpatch_cft   = 2
#endif

  integer, parameter :: maxpatch_pft   = 4
  integer, parameter :: npatch_urban   = maxpatch_pft + 1
  integer, parameter :: npatch_lake    = npatch_urban + maxpatch_urb
  integer, parameter :: npatch_wet     = npatch_lake  + 1
  integer, parameter :: npatch_glacier = npatch_wet   + 1
  integer, parameter :: npatch_crop    = npatch_glacier + maxpatch_cft
  integer, parameter :: maxpatch       = npatch_crop

!ylu add
#if (defined CROP)
  integer, parameter :: max_pft_per_gcell = numpft+1 + 3 + maxpatch_urb
#else
  integer, parameter :: max_pft_per_gcell = numpft+1 + 3 + maxpatch_urb + numcft
#endif
 integer, parameter :: max_pft_per_lu    = max(numpft+1, numcft, maxpatch_urb)
  integer, parameter :: max_pft_per_col   = max(numpft+1, numcft, maxpatch_urb)


!Are these constants used?  I don't see max_col_per_lunit referenced anywhere.
!ylu remove
!  integer, parameter :: max_pft_per_gcell = numpft+1 + 4 + maxpatch_cft
!  integer, parameter :: max_pft_per_lu    = max(numpft+1, maxpatch_cft)
!  integer, parameter :: max_pft_per_col   = numpft+1

!  integer, parameter :: max_pft_per_col     = maxpatch_pft
!#if (defined NOCOMPETE)
!  integer, parameter :: max_col_per_lunit   = maxpatch_pft
!#else
!  integer, parameter :: max_col_per_lunit   = 1
!#endif
!Shouldn't this be 1?
!  integer, parameter :: max_lunit_per_gcell = 5            !(soil,urban,lake,wetland,glacier)

contains
	subroutine clm_varpar_mod
	end subroutine clm_varpar_mod
!------------------------------------------------------------------------------
end module clm_varpar
module clm_varcon
!----------------------------------------------------------------------- 
!BOP
!
! !MODULE: clm_varcon
!
! !DESCRIPTION: 
! Module containing various model constants 
!
! !USES:
  use shr_kind_mod, only: r8 => shr_kind_r8
  use clm_varpar, only : numcol,numrad,nlevlak,&
                         maxpatch_pft,numpft,nlevgrnd
!
! !PUBLIC TYPES:
  implicit none
  save
!
! !REVISION HISTORY:
! Created by Mariana Vertenstein
!
!EOP
!----------------------------------------------------------------------- 
  
  integer, private :: i  ! loop index
  !------------------------------------------------------------------
  ! Initialize physical constants
  !------------------------------------------------------------------
  real(r8), parameter :: cday   = 86400.0_r8   !sec in calendar day ~ sec

  integer,  parameter :: idx_Mie_snw_mx = 1471           ! number of effective radius indices used in Mie lookup table [idx]
  integer,  parameter :: idx_T_max      = 11             ! maxiumum temperature index used in aging lookup table [idx]
  integer,  parameter :: idx_Tgrd_max   = 31             ! maxiumum temperature gradient index used in aging lookup table [idx]
  integer,  parameter :: idx_rhos_max   = 8              ! maxiumum snow density index used in aging lookup table [idx]
  integer,  parameter :: numrad_snw  =   5               ! number of spectral bands used in snow model [nbr]


  real(r8), parameter :: pie    = 3.141592653589793_r8 ! pi
  real(r8), parameter :: rpi    = 3.141592653589793_r8 ! pi
  real(r8), parameter :: grav   = 9.80616_r8   !gravity constant [m/s2]
  real(r8), parameter :: sb     = 5.67e-8_r8   !stefan-boltzmann constant  [W/m2/K4]
  real(r8), parameter :: vkc    = 0.4_r8       !von Karman constant [-]
  real(r8), parameter :: rgas   = 8314.468_r8  !Universal gas constant ~ J/K/kmole
  real(r8), parameter :: rwat   = 461.5046_r8  !gas constant for water vapor [J/(kg K)]
  real(r8), parameter :: rair   = 287.0423_r8  !gas constant for dry air [J/kg/K]
  real(r8), parameter :: roverg = 47062.73_r8  !Rw/g constant = (8.3144/0.018)/(9.80616)*1000. mm/K
  real(r8), parameter :: cpliq  = 4.188e3_r8   !Specific heat of water [J/kg-K]
  real(r8), parameter :: cpice  = 2.11727e3_r8 !Specific heat of ice [J/kg-K]
  real(r8), parameter :: cpair  = 1.00464e3_r8 !specific heat of dry air [J/kg/K]
  real(r8), parameter :: hvap   = 2.501e6_r8   !Latent heat of evap for water [J/kg]
  real(r8), parameter :: hfus   = 3.337e5_r8   !Latent heat of fusion for ice [J/kg]
  real(r8), parameter :: hsub   = 2.501e6_r8+3.337e5_r8 !Latent heat of sublimation    [J/kg]
  real(r8), parameter :: denh2o = 1.000e3_r8   !density of liquid water [kg/m3]
  real(r8), parameter :: denice = 0.917e3_r8   !density of ice [kg/m3]
  real(r8), parameter :: tkair  = 0.023_r8        !thermal conductivity of air   [W/m/k]
  real(r8), parameter :: tkice  = 2.290_r8        !thermal conductivity of ice   [W/m/k]
  real(r8), parameter :: tkwat  = 0.6_r8          !thermal conductivity of water [W/m/k]
  real(r8), parameter :: tfrz   = 273.16_r8    !freezing temperature [K]
  real(r8), parameter :: tcrit  = 2.5_r8          !critical temperature to determine rain or snow
  real(r8), parameter :: po2    = 0.209_r8        !constant atmospheric partial pressure  O2 (mol/mol)
  real(r8), parameter :: pco2   = 355.e-06     !constant atmospheric partial pressure CO2 (mol/mol)
  real(r8), parameter :: pstd   = 101325.0_r8  !standard pressure ~ pascals

  real(r8), parameter :: bdsno = 250.            !bulk density snow (kg/m**3)

  real(r8), parameter :: re = 6.37122e6_r8*0.001 !radius of earth (km)
!CLM4 --ylu
  real(r8), public, parameter ::  secspday= 86400.0_r8  ! Seconds per day
  real(r8), public, parameter ::  spval = 1.e36_r8  ! special value for real data
  integer , public, parameter :: ispval = -9999     ! special value for int data
  real(r8) :: alpha_aero = 1.0_r8   !constant for aerodynamic parameter weighting
  real(r8) :: tlsai_crit = 2.0_r8   !critical value of elai+esai for which aerodynamic parameters are maximum
  real(r8) :: watmin = 0.01_r8      !minimum soil moisture (mm)


!!
  ! These are tunable constants from clm2_3

  real(r8), parameter :: zlnd = 0.01      !Roughness length for soil [m]
  real(r8), parameter :: zsno = 0.0024    !Roughness length for snow [m]
  real(r8), parameter :: csoilc = 0.004   !Drag coefficient for soil under canopy [-]
  real(r8), parameter :: capr   = 0.34    !Tuning factor to turn first layer T into surface T  
  real(r8), parameter :: cnfac  = 0.5     !Crank Nicholson factor between 0 and 1
  real(r8), parameter :: ssi    = 0.033   !Irreducible water saturation of snow
  real(r8), parameter :: wimp   = 0.05    !Water impremeable if porosity less than wimp
  real(r8), parameter :: pondmx = 10.0    !Ponding depth (mm)
!new from CLM4 ylu add
  real(r8) :: pondmx_urban = 1.0_r8  !Ponding depth for urban roof and impervious road (mm)
  real(r8) :: o2_molar_const = 0.209_r8   !constant atmospheric O2 molar ratio (mol/mol)
  real(r8), parameter :: maxwattabfract = 1.0 !Max water table fraction for landunit that is not wet or ice
!!!!!
!new from CLM4 add by ylu 
#if (defined C13)
  ! 4/14/05: PET
  ! Adding isotope code
  real(r8), parameter :: preind_atm_del13c = -6.0   ! preindustrial value for atmospheric del13C
  real(r8), parameter :: preind_atm_ratio = SHR_CONST_PDB + (preind_atm_del13c * SHR_CONST_PDB)/1000.0  ! 13C/12C
  real(r8) :: c13ratio = preind_atm_ratio/(1.0+preind_atm_ratio) ! 13C/(12+13)C preind atmosphere
#endif
  real(r8), parameter :: ht_efficiency_factor = 0.75_r8 !efficiency factor for urban heating (-)
  real(r8), parameter :: ac_efficiency_factor = 0.25_r8 !efficiency factor for urban air conditioning (-)
  real(r8) :: ht_wasteheat_factor = 1.0_r8/ht_efficiency_factor  !wasteheat factor for urban heating (-)
  real(r8) :: ac_wasteheat_factor = 1.0_r8/ac_efficiency_factor  !wasteheat factor for urban air conditioning (-)
  real(r8) :: wasteheat_limit = 100._r8  !limit on wasteheat (W/m2)


  !------------------------------------------------------------------
  ! Initialize water type constants
  !------------------------------------------------------------------

  ! "water" types 
  !   1     soil
  !   2     land ice (glacier)
  !   3     deep lake
  !   4     shallow lake
  !   5     wetland: swamp, marsh, etc

  integer,parameter :: istsoil = 1  !soil         "water" type
  integer,parameter :: istice  = 2  !land ice     "water" type
  integer,parameter :: istdlak = 3  !deep lake    "water" type
  integer,parameter :: istslak = 4  !shallow lake "water" type
  integer,parameter :: istwet  = 5  !wetland      "water" type
  integer,parameter :: isturb  = 6  !urban        landunit type
!new from CLM4 add by ylu 
#ifdef CROP
  integer,parameter :: istcrop = 7  !crop         landunit type
#endif
  integer,parameter :: icol_roof        = 61
  integer,parameter :: icol_sunwall     = 62
  integer,parameter :: icol_shadewall   = 63
  integer,parameter :: icol_road_imperv = 64
  integer,parameter :: icol_road_perv   = 65

!Yaqiong Lu mv fndepdyn and fpftdyn from clm_varctl to clm_varcon
  logical,            public :: set_caerdep_from_file = .true.  ! if reading in carbon aerosol deposition from file
  logical,            public :: set_dustdep_from_file = .true.  ! if reading in dust aerosol deposition from file
! Landunit logic
!
  logical, public :: create_crop_landunit = .false.     ! true => separate crop landunit is not created by default
  logical, public :: allocate_all_vegpfts = .false.     ! true => allocate memory for all possible vegetated pfts on
                                                        ! vegetated landunit if at least one pft has nonzero weight

  character(len=256), public :: faerdep      = ' '               ! aerosol depos
  character(len=256), public :: fndepdyn   = ' '        ! dynamic nitrogen deposition data file name
  character(len=256), public :: fpftdyn    = ' '        ! dynamic landuse dataset

  ! snow and aerosol Mie parameters:
  ! (arrays declared here, but are set in iniTimeConst)
  ! (idx_Mie_snw_mx is number of snow radii with defined parameters (i.e. from 30um to 1500um))

  ! direct-beam weighted ice optical properties
  real(r8) :: ss_alb_snw_drc(idx_Mie_snw_mx,numrad_snw)
  real(r8) :: asm_prm_snw_drc(idx_Mie_snw_mx,numrad_snw)
  real(r8) :: ext_cff_mss_snw_drc(idx_Mie_snw_mx,numrad_snw)

  ! diffuse radiation weighted ice optical properties
  real(r8) :: ss_alb_snw_dfs(idx_Mie_snw_mx,numrad_snw)
  real(r8) :: asm_prm_snw_dfs(idx_Mie_snw_mx,numrad_snw)
  real(r8) :: ext_cff_mss_snw_dfs(idx_Mie_snw_mx,numrad_snw)


  ! hydrophiliic BC
  real(r8) :: ss_alb_bc1(1,numrad_snw)
  real(r8) :: asm_prm_bc1(1,numrad_snw)
  real(r8) :: ext_cff_mss_bc1(1,numrad_snw)

  ! hydrophobic BC
  real(r8) :: ss_alb_bc2(1,numrad_snw)
  real(r8) :: asm_prm_bc2(1,numrad_snw)
  real(r8) :: ext_cff_mss_bc2(1,numrad_snw)

  ! hydrophobic OC
  real(r8) :: ss_alb_oc1(1,numrad_snw)
  real(r8) :: asm_prm_oc1(1,numrad_snw)
  real(r8) :: ext_cff_mss_oc1(1,numrad_snw)

  ! hydrophilic OC
  real(r8) :: ss_alb_oc2(1,numrad_snw)
  real(r8) :: asm_prm_oc2(1,numrad_snw)
  real(r8) :: ext_cff_mss_oc2(1,numrad_snw)

  ! dust species 1:
  real(r8) :: ss_alb_dst1(1,numrad_snw)
  real(r8) :: asm_prm_dst1(1,numrad_snw)
  real(r8) :: ext_cff_mss_dst1(1,numrad_snw)

  ! dust species 2:
  real(r8) :: ss_alb_dst2(1,numrad_snw)
  real(r8) :: asm_prm_dst2(1,numrad_snw)
  real(r8) :: ext_cff_mss_dst2(1,numrad_snw)

  ! dust species 3:
  real(r8) :: ss_alb_dst3(1,numrad_snw)
  real(r8) :: asm_prm_dst3(1,numrad_snw)
  real(r8) :: ext_cff_mss_dst3(1,numrad_snw)

  ! dust species 4:
  real(r8) :: ss_alb_dst4(1,numrad_snw)
  real(r8) :: asm_prm_dst4(1,numrad_snw)
  real(r8) :: ext_cff_mss_dst4(1,numrad_snw)

 data(ss_alb_bc1(1,i),i=1,5) / 0.515945305512804, 0.434313626536424, 0.346103765992635,& 
    0.275522926330555, 0.138576096442815/

 data(asm_prm_bc1(1,i),i=1,5) / 0.521517715996158, 0.34457189840306, 0.244048159248401,& 
    0.188518513380877, 0.103316928297739/

 data(ext_cff_mss_bc1(1,i),i=1,5) /25368.6111954733, 12520.3846877849, 7738.643174918, &
    5744.35461327268, 3526.76546641382/

 data(ss_alb_bc2(1,i),i=1,5) /0.287685315976181, 0.186577277125224, 0.123152237089201, &
    0.0883462885905543, 0.0403421562269378/

 data(asm_prm_bc2(1,i),i=1,5) /0.350231881885906, 0.211924244128064, 0.146188682542913, &
    0.112009439045293, 0.060565694843084/

 data(ext_cff_mss_bc2(1,i),i=1,5) / 11398.4540724821, 5922.76076637376, 4039.88947595266,& 
    3261.62137894056, 2223.60028513459/

 data(ss_alb_oc1(1,i),i=1,5) / 0.996738033108225, 0.993951726870337, 0.98995641641622, &
    0.986792757460599, 0.950852907010411/

 data(asm_prm_oc1(1,i),i=1,5) / 0.771317243327679, 0.745701825432596, 0.721705644101165,& 
    0.702407207901621, 0.643447858916726/

 data(ext_cff_mss_oc1(1,i),i=1,5) / 37773.5353898986, 22112.4459872647, 14719.3405499929,& 
    10940.4200945733, 5441.11949854352/

 data(ss_alb_oc2(1,i),i=1,5) / 0.963132440682188, 0.920560323320592, 0.860191636407288, &
    0.813824138511211, 0.744011091642019/

 data(asm_prm_oc2(1,i),i=1,5) / 0.618810265705101, 0.57310868510342, 0.537906606684992, &
    0.511257182926184, 0.440320412154112/

 data(ext_cff_mss_oc2(1,i),i=1,5) /3288.85206279517, 1485.50576885264, 871.90125135612, &
    606.005758817735, 247.996083891168/

 data(ss_alb_dst1(1,i),i=1,5) /0.97891105715305, 0.994175916042451, 0.993357580762207, &
    0.992545751316266, 0.953291550046772/

 data(asm_prm_dst1(1,i),i=1,5) /0.690908112844937, 0.717759065247993, 0.671511248292627,& 
    0.614225462567888, 0.436682950958558/

 data(ext_cff_mss_dst1(1,i),i=1,5) /2686.90326329624, 2419.98140297723, 1627.51690973548,& 
    1138.23252303209, 466.104227277046/

 data(ss_alb_dst2(1,i),i=1,5) / 0.943752248802793, 0.984191668599419, 0.989309063917025, &
    0.991793946836264, 0.982999590668913/

 data(asm_prm_dst2(1,i),i=1,5) /0.699478684452806, 0.651992387581091, 0.695738438913831, &
    0.724417176862696, 0.701481090364134/

 data(ext_cff_mss_dst2(1,i),i=1,5) /841.089434044834, 987.406197502421, 1183.52284776972, &
    1267.30625580205, 993.497508579304/

 data(ss_alb_dst3(1,i),i=1,5) /0.904044530646049, 0.964651629694555, 0.968275809551522, &
    0.972598419874107, 0.977612418329876/

 data(asm_prm_dst3(1,i),i=1,5) /0.785636278417498, 0.749796744517699, 0.683301177698451, &
    0.629720518882672, 0.665531587501598/

 data(ext_cff_mss_dst3(1,i),i=1,5) /387.85423560755, 419.109723948302, 399.559447343404, &
    397.191283865122, 503.14317519429/
 
 data(ss_alb_dst4(1,i),i=1,5) /0.849818195355416, 0.940460325044343, 0.948316305534169, &
    0.952841175117807, 0.955379528193802/
 
 data(asm_prm_dst4(1,i),i=1,5) /0.849818195355416, 0.940460325044343, 0.948316305534169, &
    0.952841175117807, 0.955379528193802/

 data(ext_cff_mss_dst4(1,i),i=1,5) /196.638063554016, 202.877379461792, 208.304425287341, &
    204.723737634461, 228.755667038372/


  ! best-fit parameters for snow aging defined over:
  !  11 temperatures from 225 to 273 K
  !  31 temperature gradients from 0 to 300 K/m
  !   8 snow densities from 0 to 350 kg/m3
  ! (arrays declared here, but are set in iniTimeConst)
  real(r8) :: snowage_tau(idx_T_max,idx_Tgrd_max,idx_rhos_max)
  real(r8) :: snowage_kappa(idx_T_max,idx_Tgrd_max,idx_rhos_max)
  real(r8) :: snowage_drdt0(idx_T_max,idx_Tgrd_max,idx_rhos_max)


  real, dimension(idx_Mie_snw_mx*numrad_snw) ::  &
                         xx_ext_cff_mss_snw_dfs  &
                        ,xx_ss_alb_snw_drc       &
                        ,xx_asm_prm_snw_drc      &
                        ,xx_ext_cff_mss_snw_drc  &
                        ,xx_ss_alb_snw_dfs       &
                        ,xx_asm_prm_snw_dfs      

  real, dimension(idx_rhos_max*idx_Tgrd_max*idx_T_max) ::   &
                         xx_snowage_tau                     &
                        ,xx_snowage_kappa                   &
                        ,xx_snowage_drdt0         


  real(r8) :: ndep ! Sum of NOy and NHx deposition (unit: g(N)/m2/year)
  data ndep/0.1600056/

  real(r8),dimension(1:12) :: bcphidry,bcphodry,bcphiwet,ocphidry,ocphodry,ocphiwet,dstx01wd,dstx01dd,dstx02wd,&
                          dstx02dd,dstx03wd,dstx03dd,dstx04wd,dstx04dd
  !hydrophilic BC wet deposition (unit: kg/m2/s)
  data(bcphiwet(i),i=1,12)/2.825279e-13,2.804302e-13,2.806464e-13,2.776603e-13,2.867702e-13,2.840975e-13,&
                           3.122134e-13,3.540193e-13,3.618796e-13,3.123423e-13,2.668725e-13,2.721869e-13/
  !hydrophilic BC dry deposition (unit: kg/m2/s)
  data(bcphidry(i),i=1,12)/4.379167e-14,4.140940e-14,3.956216e-14,3.461795e-14,3.561638e-14,3.812630e-14,&
                           4.509564e-14,5.387520e-14,4.985846e-14,4.057210e-14,3.778306e-14,4.178772e-14/
  !hydrophobic BC dry deposition (unit: kg/m2/s)
  data(bcphodry(i),i=1,12)/4.192595e-14,3.831034e-14,3.536048e-14,3.209042e-14,3.280311e-14,3.226350e-14,&
                           3.723765e-14,4.297412e-14,4.106369e-14,3.602615e-14,3.536953e-14,4.030912e-14/
  !hydrophilic OC wet deposition (unit: kg/m2/s)
  data(ocphiwet(i),i=1,12)/1.162276e-12,1.151254e-12,1.188579e-12,1.186147e-12,1.340542e-12,1.292835e-12,&
                           1.628738e-12,2.033289e-12,1.964814e-12,1.479005e-12,1.043205e-12,1.068595e-12/
  !hydrophilic OC dry deposition (unit: kg/m2/s)
  data(ocphidry(i),i=1,12)/2.152982e-13,1.993085e-13,1.982182e-13,1.799778e-13,2.096774e-13,2.264119e-13,&
                           3.075992e-13,3.972984e-13,3.344011e-13,2.181304e-13,1.666979e-13,1.974062e-13/
  !hydrophobic OC dry deposition (unit: kg/m2/s)
  data(ocphodry(i),i=1,12)/1.041400e-13,9.450685e-14,9.076748e-14,8.334433e-14,9.459879e-14,9.190213e-14,&
                           1.252610e-13,1.566317e-13,1.342872e-13,9.783121e-14,8.087127e-14,9.675401e-14/
  !DSTX01 wet deposition flux at bottom (unit: kg/m2/s)
  data(dstx01wd(i),i=1,12)/3.954503e-12,4.835873e-12,5.138886e-12,4.327863e-12,4.352995e-12,5.446991e-12,&
                           5.994205e-12,5.140828e-12,3.412828e-12,2.943823e-12,3.267167e-12,3.414306e-12/                           
  !DSTX01 dry deposition flux at bottom (unit: kg/m2/s)
  data(dstx01dd(i),i=1,12)/1.926454e-13,2.188806e-13,2.054299e-13,1.452168e-13,1.216905e-13,1.291714e-13,&
                           1.238305e-13,1.022406e-13,8.948773e-14,1.024716e-13,1.347662e-13,1.688275e-13/
  !DSTX02 wet deposition flux at bottom (unit: kg/m2/s)
  data(dstx02wd(i),i=1,12)/9.846976e-12,1.203580e-11,1.324912e-11,1.146517e-11,1.176165e-11,1.479383e-11,&
                           1.656127e-11,1.427957e-11,9.381504e-12,7.933820e-12,8.429268e-12,8.695841e-12/
  !DSTX02 dry deposition flux at bottom (unit: kg/m2/s)
  data(dstx02dd(i),i=1,12)/2.207384e-12,2.523390e-12,2.099760e-12,1.318037e-12,1.071989e-12,1.305896e-12,&
                           1.065086e-12,8.545297e-13,7.591564e-13,9.132561e-13,1.344110e-12,1.683045e-12/
  !DSTX03 wet deposition flux at bottom (unit: kg/m2/s)
  data(dstx03wd(i),i=1,12)/5.689729e-12,7.006299e-12,8.480560e-12,8.957637e-12,1.042770e-11,1.315425e-11,&
                           1.529579e-11,1.397714e-11,9.306412e-12,7.171395e-12,6.230214e-12,5.392280e-12/
  !DSTX03 dry deposition flux at bottom (unit: kg/m2/s)
  data(dstx03dd(i),i=1,12)/1.344186e-11,1.552927e-11,1.442798e-11,9.362479e-12,8.622053e-12,1.158499e-11,&
                           1.128677e-11,8.671572e-12,6.141916e-12,6.720502e-12,8.372052e-12,1.090343e-11/
  !DSTX04 wet deposition flux at bottom (unit: kg/m2/s)
  data(dstx04wd(i),i=1,12)/5.657587e-12,7.503811e-12,1.001585e-11,1.095202e-11,1.382148e-11,1.919693e-11,&
                           2.390845e-11,2.121497e-11,1.201019e-11,7.470685e-12,5.650550e-12,4.622456e-12/
  !DSTX04 dry deposition flux at bottom (unit: kg/m2/s)
  data(dstx04dd(i),i=1,12)/7.075009e-11,8.168510e-11,8.081875e-11,6.024911e-11,6.014012e-11,7.693025e-11,&
                           7.988822e-11,6.632887e-11,4.771782e-11,4.599348e-11,4.981839e-11,5.885732e-11/ 


  real(r8) :: organic(1:nlevgrnd)!organic matter density at soil levels 
                                 !(unit: kg/m3 (assumed carbon content 0.58 gC per gOM)
  data(organic(i),i=1,nlevgrnd)/0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0/
! The following data are global average for each soil layer
!  data(organic(i),i=1,nlevgrnd)/15.36,15.12,13.22,10.80,8.31,6.09,4.37,3.12,0.00,0.00/

 real(r8) :: fmax ! maximum fractional saturated area!
                  ! this parameter is for soil hydrology, and it is used in SoilHydrologyMod.F
                  ! this is an ajustable parameter for a specific region -- Jiming Jin
 data fmax/0.366/

 real(r8) :: efisop(1:6)! emission factors for isoprene (ug/m2/h1)
 data(efisop(i), i=1,6)/3025.2,& ! broadleaf trees
                        554.6 ,& ! fineleaf evergreen    
                        131.0 ,& ! fineleaf deciduous
                        2629.5,& ! shrubs
                        164.3 ,& ! grass
                        14.1/    ! crops
  !------------------------------------------------------------------
  ! Initialize miscellaneous radiation constants
  !------------------------------------------------------------------


  integer,parameter :: num_landcover_types  = 24  !24 (USGS)


  ! saturated soil albedos for 8 color classes: 1=vis, 2=nir

  real(r8) :: albsat(numcol,numrad) !wet soil albedo by color class and waveband
  data(albsat(i,1),i=1,8)/0.12,0.11,0.10,0.09,0.08,0.07,0.06,0.05/
  data(albsat(i,2),i=1,8)/0.24,0.22,0.20,0.18,0.16,0.14,0.12,0.10/

  ! dry soil albedos for 8 color classes: 1=vis, 2=nir 

  real(r8) :: albdry(numcol,numrad) !dry soil albedo by color class and waveband
  data(albdry(i,1),i=1,8)/0.24,0.22,0.20,0.18,0.16,0.14,0.12,0.10/
  data(albdry(i,2),i=1,8)/0.48,0.44,0.40,0.36,0.32,0.28,0.24,0.20/

  ! albedo land ice: 1=vis, 2=nir

  real(r8) :: albice(numrad)        !albedo land ice by waveband
  data (albice(i),i=1,numrad) /0.80, 0.55/

  ! albedo frozen lakes: 1=vis, 2=nir 

  real(r8) :: alblak(numrad)        !albedo frozen lakes by waveband
  data (alblak(i),i=1,numrad) /0.60, 0.40/

  ! omega,betad,betai for snow 

  real(r8),parameter :: betads  = 0.5       !two-stream parameter betad for snow
  real(r8),parameter :: betais  = 0.5       !two-stream parameter betai for snow
  real(r8) :: omegas(numrad)      !two-stream parameter omega for snow by band
  data (omegas(i),i=1,numrad) /0.8, 0.4/

  !------------------------------------------------------------------
  ! Soil and Lake depths are constants for now
  ! The values for the following arrays are set in routine iniTimeConst
  !------------------------------------------------------------------

  real(r8) :: zlak(1:nlevlak)     !lake z  (layers) 
  real(r8) :: dzlak(1:nlevlak)    !lake dz (thickness)
  real(r8) :: zsoi(1:nlevgrnd)     !soil z  (layers)
  real(r8) :: dzsoi(1:nlevgrnd)    !soil dz (thickness)
  real(r8) :: zisoi(0:nlevgrnd)    !soil zi (interfaces)  

    real(r8) :: sand(19)                           ! percent sand
    real(r8) :: clay(19)                           ! percent clay
    integer  :: soic(19)
    integer  :: plant(24,maxpatch_pft)
    real(r8) :: cover(24,maxpatch_pft)

    data(sand(i), i=1,19)/92.,80.,66.,20.,5.,43.,60.,&
      10.,32.,51., 6.,22.,39.7,0.,100.,54.,17.,100.,92./

    data(clay(i), i=1,19)/ 3., 5.,10.,15.,5.,18.,27.,&
      33.,33.,41.,47.,58.,14.7,0., 0., 8.5,54.,  0., 3./

    data(soic(i), i=1,19)/1,2,2,3,3,4,5,5,6,7,7,8,8,0,&
                          1,1,4,7,1/

!  soil type from MM5
! (1)  sand
! (2)  loamy-sand
! (3)  sandy-loam
! (4)  silt-loam
! (5)  silt
! (6)  loam
! (7)  sandy-clay-loam
! (8)  silty-clay-loam
! (9)  clay-loam
! (10) sandy-clay
! (11) silty-clay
! (12) clay
! (13) organic-material,
! (14) water
! (15) bedrock
! (16) other(land-ice)
! (17) playa
! (18) lava
! (19) white-sand
!----------------------------------------------------------------------------
  data (plant(i,1),i=1,24) / 0,  15,  15,  15,  15,  15, &
                            14,   9,   9,  14,   7,   3, &
                             4,   1,   1,   0,   0,   4, &
                            11,  11,   2,  11,  11,   0/
  data (cover(i,1),i=1,24) /100.,  85.,  85.,  85.,  50.,  40., &
                             60.,  80.,  50.,  70.,  75.,  50., &
                             95.,  75.,  37., 100., 100.,  80., &
                             10.,  30.,  13.,  20.,  10., 100./

  data (plant(i,2),i=1,24) / 0,   0,   0,   0,  14,   3, &
                            13,   0,  14,   6,   0,   0, &
                             0,   0,   7,   0,   0,   0, &
                             0,  12,   3,  12,  12,   0/
  data (cover(i,2),i=1,24) /  0.,  15.,  15.,  15.,  35.,  30., &
                             20.,  20.,  30.,  30.,  25.,  50., &
                              5.,  25.,  37.,   0.,   0.,  20., &
                             90.,  30.,  13.,  20.,  10.,   0./

  data (plant(i,3),i=1,24) / 0,   0,   0,   0,   0,   0, &
                             0,   0,   0,   0,   0,   0, &
                             0,   0,   0,   0,   0,   0, &
                             0,   0,  10,   0,   0,   0/

  data (cover(i,3),i=1,24) /  0.,   0.,   0.,   0.,  15.,  30., &
                             20.,   0.,  20.,   0.,   0.,   0., &
                              0.,   0.,  26.,   0.,   0.,   0., &
                              0.,  40.,  24.,  60.,  80.,   0./

  data (plant(i,4),i=1,24) / 0,   0,   0,   0,   0,   0, &
                             0,   0,   0,   0,   0,   0, &
                             0,   0,   0,   0,   0,   0, &
                             0,   0,   0,   0,   0,   0/

  data (cover(i,4),i=1,24) / 0.,   0.,   0.,   0.,   0.,   0., &
                             0.,   0.,   0.,   0.,   0.,   0., &
                             0.,   0.,   0.,   0.,   0.,   0., &
                             0.,   0.,  50.,   0.,   0.,   0./

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

!USGS vegetation 24 categories
!
!Urban and Built-Up Land            1
!Dryland Cropland and Pasture       2
!Irrigated Cropland and Pasture     3
!Mixed Dryland/Irrg. C.P.           4
!Cropland/Grassland Mosaic          5
!Cropland/Woodland Mosaic           6
!Grassland                          7
!Shrubland                          8
!Mixed Shrubland/Grassland          9
!Savanna                           10
!Deciduous Broadleaf Forest        11
!Deciduous Needleleaf Forest       12
!Evergreen Broadleaf Forest        13
!Evergreen Needleleaf Forest       14
!Mixed Forest                      15
!Water Bodies                      16
!Herbaceous Wetland                17
!Wooded Wetland                    18
!Barren or Sparsely Vegetated      19
!Herbaceous Tundra                 20
!Wooded Tundra                     21
!Mixed Tundra                      22
!Bare Ground Tundra                23
!Snow or Ice                       24
!-----------------------------------------------------------------------
    real(r8):: lai(numpft,12),sai(numpft,12)

    real(r8):: hvt(16),hvb(16)  

    data (hvt(i),i=1,16) /17.0,17.0,14.0,35.0,35.0,18.0,20.0,20.0,&
      0.5,0.5,0.5,0.5,0.5,0.5,0.5,0.5/
    data (hvb(i),i=1,16) /8.50, 8.50,7.00,1.00,1.00,10.00,11.50,11.50,&
      0.10,0.10,0.10,0.01,0.10,0.01,0.01,0.01/


    data (lai(1,i),i=1,12) &
        /4.1,4.2,4.6,4.8,4.9,5.0,4.8,4.7,4.6,4.2,4.0,4.0/
    data (lai(2,i),i=1,12) &
        /4.1,4.2,4.6,4.8,4.9,5.0,4.8,4.7,4.6,4.2,4.0,4.0/
    data (lai(3,i),i=1,12) &
        /0.0,0.0,0.0,0.6,1.2,2.0,2.6,1.7,1.0,0.5,0.2,0.0/
    data (lai(4,i),i=1,12) &
        /4.5,4.5,4.5,4.5,4.5,4.5,4.5,4.5,4.5,4.5,4.5,4.5/
    data (lai(5,i),i=1,12) &
        /4.5,4.5,4.5,4.5,4.5,4.5,4.5,4.5,4.5,4.5,4.5,4.5/
    data (lai(6,i),i=1,12) &
        /0.8,0.7,0.4,0.5,0.5,0.7,1.7,3.0,2.5,1.6,1.0,1.0/
    data (lai(7,i),i=1,12) &
        /0.0,0.0,0.3,1.2,3.0,4.7,4.5,3.4,1.2,0.3,0.0,0.0/
    data (lai(8,i),i=1,12) &
        /0.0,0.0,0.3,1.2,3.0,4.7,4.5,3.4,1.2,0.3,0.0,0.0/
    data (lai(9,i),i=1,12) &
        /1.0,1.0,1.0,1.0,1.0,1.0,1.0,1.0,1.0,1.0,1.0,1.0/
    data (lai(10,i),i=1,12) &
        /0.9,0.8,0.2,0.2,0.0,0.0,0.0,0.2,0.4,0.5,0.6,0.8/
    data (lai(11,i),i=1,12) &
        /0.0,0.0,0.0,0.0,0.0,0.2,1.4,1.2,0.0,0.0,0.0,0.0/
    data (lai(12,i),i=1,12) &
        /0.4,0.5,0.6,0.7,1.2,3.0,3.5,1.5,0.7,0.6,0.5,0.4/
    data (lai(13,i),i=1,12) &
        /0.0,0.0,0.0,0.0,0.0,0.2,1.4,1.2,0.0,0.0,0.0,0.0/
    data (lai(14,i),i=1,12) &
        /0.4,0.5,0.6,0.7,1.2,3.0,3.5,1.5,0.7,0.6,0.5,0.4/
    data (lai(15,i),i=1,12) &
        /0.0,0.0,0.0,0.0,1.0,2.0,3.0,3.0,1.5,0.0,0.0,0.0/
    data (lai(16,i),i=1,12) &
        /0.0,0.0,0.0,0.0,1.0,2.0,3.0,3.0,1.5,0.0,0.0,0.0/
!-----------------------------------------------------------------------
    data (sai(1,i),i=1,12) &
       /0.4,0.5,0.4,0.3,0.4,0.5,0.5,0.6,0.6,0.7,0.6,0.5/
    data (sai(2,i),i=1,12) &
       /0.4,0.5,0.4,0.3,0.4,0.5,0.5,0.6,0.6,0.7,0.6,0.5/
    data (sai(3,i),i=1,12) &
       /0.3,0.3,0.3,0.4,0.4,0.4,1.7,1.2,1.0,0.8,0.6,0.5/
    data (sai(4,i),i=1,12) &
       /0.5,0.5,0.5,0.5,0.5,0.5,0.5,0.5,0.5,0.5,0.5,0.5/
    data (sai(5,i),i=1,12) &
       /0.5,0.5,0.5,0.5,0.5,0.5,0.5,0.5,0.5,0.5,0.5,0.5/
    data (sai(6,i),i=1,12) &
       /0.4,0.3,0.5,0.3,0.3,0.3,0.3,0.7,0.7,1.1,0.9,0.2/
    data (sai(7,i),i=1,12) &
       /0.4,0.4,0.4,0.4,0.5,0.4,0.9,1.4,2.6,1.4,0.6,0.4/
    data (sai(8,i),i=1,12) &
       /0.4,0.4,0.4,0.4,0.5,0.4,0.9,1.4,2.6,1.4,0.6,0.4/
    data (sai(9,i),i=1,12) &
       /0.3,0.3,0.3,0.3,0.3,0.3,0.3,0.3,0.3,0.3,0.3,0.3/
    data (sai(10,i),i=1,12) &
       /0.1,0.2,0.6,0.1,0.6,0.0,0.1,0.1,0.1,0.1,0.1,0.1/
    data (sai(11,i),i=1,12) &
       /0.1,0.1,0.1,0.1,0.1,0.1,0.1,0.5,1.4,0.1,0.1,0.1/
    data (sai(12,i),i=1,12) &
       /0.3,0.3,0.3,0.3,0.3,0.4,0.8,2.3,1.1,0.4,0.4,0.4/
    data (sai(13,i),i=1,12) &
       /0.1,0.1,0.1,0.1,0.1,0.1,0.1,0.5,1.4,0.1,0.1,0.1/
    data (sai(14,i),i=1,12) &
       /0.3,0.3,0.3,0.3,0.3,0.4,0.8,2.3,1.1,0.4,0.4,0.4/
    data (sai(15,i),i=1,12) &
       /0.0,0.0,0.0,0.0,1.0,2.0,3.0,3.0,1.5,0.0,0.0,0.0/
    data (sai(16,i),i=1,12) &
       /0.0,0.0,0.0,0.0,1.0,2.0,3.0,3.0,1.5,0.0,0.0,0.0/
!----------------------------------------------------------------------------
  character(len=40) pftname(0:numpft)
  real(r8) dleaf(0:numpft)       !characteristic leaf dimension (m)
  real(r8) c3psn(0:numpft)       !photosynthetic pathway: 0. = c4, 1. = c3
  real(r8) vcmx25(0:numpft)      !max rate of carboxylation at 25C (umol CO2/m**2/s)
  real(r8) mp(0:numpft)          !slope of conductance-to-photosynthesis relationship
  real(r8) qe25(0:numpft)        !quantum efficiency at 25C (umol CO2 / umol photon)
  real(r8) xl(0:numpft)          !leaf/stem orientation index
  real(r8) rhol(0:numpft,numrad) !leaf reflectance: 1=vis, 2=nir
  real(r8) rhos(0:numpft,numrad) !stem reflectance: 1=vis, 2=nir
  real(r8) taul(0:numpft,numrad) !leaf transmittance: 1=vis, 2=nir
  real(r8) taus(0:numpft,numrad) !stem transmittance: 1=vis, 2=nir
  real(r8) z0mr(0:numpft)        !ratio of momentum roughness length to canopy top height (-)
  real(r8) displar(0:numpft)     !ratio of displacement height to canopy top height (-)
  real(r8) roota_par(0:numpft)   !CLM rooting distribution parameter [1/m]
  real(r8) rootb_par(0:numpft)   !CLM rooting distribution parameter [1/m]

data (pftname(i),i=1,16)/'needleleaf_evergreen_temperate_tree',&
                           'needleleaf_evergreen_boreal_tree'   ,&
                           'needleleaf_deciduous_boreal_tree'   ,&
                           'broadleaf_evergreen_tropical_tree'  ,&
                           'broadleaf_evergreen_temperate_tree' ,&
                           'broadleaf_deciduous_tropical_tree'  ,&
                           'broadleaf_deciduous_temperate_tree' ,&
                           'broadleaf_deciduous_boreal_tree'    ,&
                           'broadleaf_evergreen_shrub'          ,&
                           'broadleaf_deciduous_temperate_shrub',&
                           'broadleaf_deciduous_boreal_shrub'   ,&
                           'c3_arctic_grass'                    ,&
                           'c3_non-arctic_grass'                ,&
                           'c4_grass'                           ,&
                           'corn'                               ,&
                           'wheat'/

  data (z0mr(i),i=1,16)/ 0.055, 0.055, 0.055, 0.075, 0.075,  &
       0.055,0.055, 0.055, 0.120, 0.120, 0.120, 0.120, 0.120,&
       0.120, 0.120, 0.120/

  data (displar(i),i=1,16)/ 0.67, 0.67, 0.67, 0.67, 0.67, &
         0.67, 0.67, 0.67, 0.68, 0.68, 0.68, 0.68, 0.68,  &
         0.68, 0.68, 0.68/

  data (dleaf(i),i=1,16)/ 0.04, 0.04, 0.04, 0.04, 0.04,&
         0.04, 0.04, 0.04, 0.04, 0.04, 0.04, 0.04, 0.04,&
         0.04, 0.04, 0.04/

  data (c3psn(i),i=1,16)/1.0,1.0,1.0,1.0,1.0,1.0,1.0,1.0,&
        1.0,1.0,1.0,1.0,1.0,0.0,1.0,1.0/

  data (vcmx25(i),i=1,16)/51.0,43.0,43.0,75.0,69.0,40.0,&
       51.0,51.0,17.0,17.0,33.0,43.0,43.0,24.0,50.0,50.0/

  data (mp(i),i=1,16)/6.0,6.0,6.0,9.0,9.0,9.0,9.0,9.0,&
        9.0,9.0,9.0,9.0,9.0,5.0,9.0,9.0/

  data (qe25(i),i=1,16)/ 0.06, 0.06, 0.06, 0.06, 0.06,&
        0.06, 0.06, 0.06, 0.06, 0.06, 0.06, 0.06, 0.06,&
        0.04, 0.06, 0.06/

  data (rhol(i,1),i=1,16)/ 0.07, 0.07, 0.07, 0.10, 0.10,&
        0.10, 0.10, 0.10, 0.07, 0.10, 0.10, 0.11, 0.11,&
        0.11, 0.11, 0.11/

  data (rhol(i,2),i=1,16)/ 0.35, 0.35, 0.35, 0.45, 0.45,&
        0.45, 0.45, 0.45, 0.35, 0.45, 0.45, 0.58, 0.58, &
        0.58, 0.58, 0.58/

  data (rhos(i,1),i=1,16) /0.16, 0.16, 0.16, 0.16, 0.16,&
         0.16, 0.16, 0.16, 0.16, 0.16, 0.16, 0.36, 0.36,&
         0.36, 0.36, 0.36/

  data (rhos(i,2),i=1,16)/ 0.39, 0.39, 0.39, 0.39, 0.39,&
        0.39, 0.39, 0.39, 0.39, 0.39, 0.39, 0.58, 0.58, &
        0.58, 0.58, 0.58/

  data (taul(i,1),i=1,16)/ 0.05, 0.05, 0.05, 0.05, 0.05,&
        0.05, 0.05, 0.05, 0.05, 0.05, 0.05, 0.07, 0.07,&
        0.07, 0.07, 0.07/

  data (taul(i,2),i=1,16)/ 0.10, 0.10, 0.10, 0.25, 0.25,&
        0.25, 0.25, 0.25, 0.10, 0.25, 0.25, 0.25, 0.25, &
        0.25, 0.25, 0.25/

  data (taus(i,1),i=1,16)/0.001, 0.001, 0.001, 0.001,&
       0.001,0.001, 0.001, 0.001, 0.001, 0.001, 0.001,&
       0.220, 0.220, 0.220, 0.220, 0.220/

  data (taus(i,2),i=1,16)/ 0.001, 0.001, 0.001, 0.001,&
       0.001, 0.001, 0.001, 0.001, 0.001, 0.001, &
       0.001, 0.380, 0.380, 0.380, 0.380, 0.380/

  data (xl(i),i=1,16)/0.01,0.01,0.01,0.10,0.10, 0.01,&
       0.25, 0.25, 0.01, 0.25, 0.25, -0.30, -0.30,&
       -0.30, -0.30, -0.30/

  data (roota_par(i),i=1,16)/ 7.0, 7.0, 7.0, 7.0,&
      7.0, 6.0, 6.0, 6.0, 7.0, 7.0, 7.0, 11.0, &
      11.0, 11.0,  6.0,  6.0/

  data (rootb_par(i),i=1,16)/ 2.0, 2.0, 2.0, &
     1.0, 1.0, 2.0, 2.0, 2.0, 1.5, 1.5, 1.5, &
     2.0, 2.0, 2.0, 3.0, 3.0/

contains

 subroutine var_par
 end subroutine var_par

end module clm_varcon
module clm_varsur

!-----------------------------------------------------------------------
!BOP
!
! !MODULE: clm_varsur
!
! !DESCRIPTION:
! Module containing 2-d surface boundary data information
!
! !USES:
  use shr_kind_mod, only: r8 => shr_kind_r8
  use clm_varpar, only : maxpatch,lsmlon, lsmlat, nlevsoi
!
! !PUBLIC TYPES:
  implicit none
  save
!
! land model grid
!
!ylu add
 
!   real(r8),allocatable :: pctspec(:)         ! percent of spec lunits wrt gcell
!ylu end 

  integer :: numlon(lsmlat)             !longitude points for each latitude strip
  real(r8):: latixy(1)      !latitude of grid cell (degrees)
  real(r8):: longxy(1)      !longitude of grid cell (degrees)
  real(r8):: area(1)        !grid cell area (km**2)
  real(r8):: landarea                   !total land area for all gridcells (km^2)
  real(r8):: lats(lsmlat+1)             !grid cell latitude, southern edge (degrees)
  real(r8):: lonw(lsmlon+1,lsmlat)      !grid cell longitude, western edge (degrees)
  real(r8):: lsmedge(4)                 !North,East,South,West edges of grid (deg)
  logical :: pole_points                !true => grid has pole points
  logical :: fullgrid  = .true.         !true => no grid reduction towards poles
  logical :: offline_rdgrid             !true => read offline grid rather than creating it
!
! fractional land and mask
!
!  integer  landmask(smlon,lsmlat)      !land mask: 1 = land. 0 = ocean
!  real(r8) landfrac(lsmlon,lsmlat)      !fractional land
!
! surface boundary data
!
  real(r8), allocatable :: gti(:)
  integer , allocatable :: soic2d(:)   !soil color
  real(r8) , allocatable :: efisop2d(:,:) 
  real(r8), allocatable :: sand3d(:,:) !soil texture: percent sand
  real(r8), allocatable :: clay3d(:,:) !soil texture: percent clay
  real(r8), allocatable :: organic3d(:,:) !organic matter: kg/m3
  real(r8), allocatable :: pctgla(:)   !percent of grid cell that is glacier
  real(r8), allocatable :: pctlak(:)   !percent of grid cell that is lake
  real(r8), allocatable :: pctwet(:)   !percent of grid cell that is wetland
  real(r8), allocatable :: pcturb(:)   !percent of grid cell that is urbanized
  integer , allocatable :: vegxy(:,:) ! vegetation type
  real(r8), allocatable,target :: wtxy(:,:)  ! subgrid weights

!
! !PUBLIC MEMBER FUNCTIONS:
  public :: varsur_alloc    !allocates 2d surface data needed for initialization
  public :: varsur_dealloc  !deallocates 2d surface data needed for initialization
!
! !REVISION HISTORY:
! Created by Mariana Vertenstein
!
!EOP
!-----------------------------------------------------------------------

contains

!-----------------------------------------------------------------------
!BOP
!
! !IROUTINE: varsur_alloc
!
! !INTERFACE:
  subroutine varsur_alloc

!
! !DESCRIPTION:
! Allocate dynamic memory for module variables
!
! !ARGUMENTS:
    implicit none
!
! !REVISION HISTORY:
! Created by Mariana Vertenstein
!
!EOP
!
! LOCAL VARIABLES:
    integer :: ier,begg,endg                   !error code
    
  begg=1
  endg=1

!-----------------------------------------------------------------------
    allocate (vegxy(1,maxpatch), &
              wtxy(1,maxpatch),  &
              stat=ier)
    if (ier /= 0) then
       write(6,*)'initialize allocation error' 
       call endrun()
    endif



    allocate (soic2d(begg:endg), &
              gti(begg:endg), &
              efisop2d(1:6,begg:endg),&
              sand3d(begg:endg,nlevsoi), &
              clay3d(begg:endg,nlevsoi), &
              organic3d(begg:endg,nlevsoi), &
              pctgla(begg:endg), &
              pctlak(begg:endg), &
              pctwet(begg:endg), &
              pcturb(begg:endg), stat=ier)
    if (ier /= 0) then
       write(6,*)'varsur_alloc(): allocation error'
       call endrun()
    endif

  end subroutine varsur_alloc

!-----------------------------------------------------------------------
!BOP
!
! !IROUTINE: varsur_dealloc
!
! !INTERFACE:
  subroutine varsur_dealloc
!
! !DESCRIPTION:
! Deallocate dynamic memory for module variables
!
! !ARGUMENTS:
    implicit none
!
! !REVISION HISTORY:
! Created by Mariana Vertenstein
!
!EOP
!-----------------------------------------------------------------------

    deallocate (soic2d, &
                gti,    &
               efisop2d,&
                sand3d, &
                clay3d, &
               organic3d,&
                pctgla, &
                pctlak, &
                pctwet, &
                pcturb, &
                wtxy,   &
                vegxy)

  end subroutine varsur_dealloc

end module clm_varsur
!#include <misc.h>
!#include <preproc.h>

module clmtype

!----------------------------------------------------------------------- 
!BOP
!
! !MODULE: clmtype
!
! !DESCRIPTION: 
! Define derived type hierarchy. Includes declaration of
! the clm derived type and 1d mapping arrays. 
!
! -------------------------------------------------------- 
! gridcell types can have values of 
! -------------------------------------------------------- 
!   1 => default
! -------------------------------------------------------- 
! landunits types can have values of (see clm_varcon.F90)
! -------------------------------------------------------- 
!   1  => (istsoil) soil (vegetated or bare soil landunit)
!   2  => (istice)  land ice
!   3  => (istdlak) deep lake
!   4  => (istslak) shall lake (not currently implemented)
!   5  => (istwet)  wetland
!   6  => (isturb)  urban 
!   7  => (istcrop) crop (only for CROP configuration)
! -------------------------------------------------------- 
! column types can have values of
! -------------------------------------------------------- 
!   1  => (istsoil)          soil (vegetated or bare soil)
!   2  => (istice)           land ice
!   3  => (istdlak)          deep lake
!   4  => (istslak)          shallow lake 
!   5  => (istwet)           wetland
!   61 => (icol_roof)        urban roof
!   62 => (icol_sunwall)     urban sunwall
!   63 => (icol_shadewall)   urban shadewall
!   64 => (icol_road_imperv) urban impervious road
!   65 => (icol_road_perv)   urban pervious road
! -------------------------------------------------------- 
! pft types can have values of
! -------------------------------------------------------- 
!   0  => not vegetated
!   1  => needleleaf evergreen temperate tree
!   2  => needleleaf evergreen boreal tree
!   3  => needleleaf deciduous boreal tree
!   4  => broadleaf evergreen tropical tree
!   5  => broadleaf evergreen temperate tree
!   6  => broadleaf deciduous tropical tree
!   7  => broadleaf deciduous temperate tree
!   8  => broadleaf deciduous boreal tree
!   9  => broadleaf evergreen shrub
!   10 => broadleaf deciduous temperate shrub
!   11 => broadleaf deciduous boreal shrub
!   12 => c3 arctic grass
!   13 => c3 non-arctic grass
!   14 => c4 grass
!   15 => corn
!   16 => wheat
! -------------------------------------------------------- 
!
! !USES:
  use shr_kind_mod, only: r8 => shr_kind_r8
!
! !PUBLIC TYPES:
  implicit none

!                              
! !REVISION HISTORY:
! Created by Peter Thornton and Mariana Vertenstein
!
!*******************************************************************************
!----------------------------------------------------
! Begin definition of conservation check structures
!----------------------------------------------------
! energy balance structure
!----------------------------------------------------
type, public :: energy_balance_type
   real(r8), pointer :: errsoi(:)        !soil/lake energy conservation error (W/m**2)
   real(r8), pointer :: errseb(:)        !surface energy conservation error (W/m**2)
   real(r8), pointer :: errsol(:)        !solar radiation conservation error (W/m**2)
   real(r8), pointer :: errlon(:)        !longwave radiation conservation error (W/m**2)
end type energy_balance_type

!----------------------------------------------------
! water balance structure
!----------------------------------------------------
type, public :: water_balance_type
   real(r8), pointer :: begwb(:)         !water mass begining of the time step
   real(r8), pointer :: endwb(:)         !water mass end of the time step
   real(r8), pointer :: errh2o(:)        !water conservation error (mm H2O)
end type water_balance_type

!----------------------------------------------------
! carbon balance structure
!----------------------------------------------------
type, public :: carbon_balance_type
   real(r8), pointer :: begcb(:)         !carbon mass, beginning of time step (gC/m**2)
   real(r8), pointer :: endcb(:)         !carbon mass, end of time step (gC/m**2)
   real(r8), pointer :: errcb(:)         !carbon balance error for the timestep (gC/m**2)
end type carbon_balance_type

!----------------------------------------------------
! nitrogen balance structure
!----------------------------------------------------
type, public :: nitrogen_balance_type
   real(r8), pointer :: begnb(:)         !nitrogen mass, beginning of time step (gN/m**2)
   real(r8), pointer :: endnb(:)         !nitrogen mass, end of time step (gN/m**2)
   real(r8), pointer :: errnb(:)         !nitrogen balance error for the timestep (gN/m**2)
end type nitrogen_balance_type

!----------------------------------------------------
! End definition of conservation check structures
!----------------------------------------------------
!*******************************************************************************

!*******************************************************************************
!----------------------------------------------------
! Begin definition of structures defined at the pft_type level
!----------------------------------------------------
! pft physical state variables structure
!----------------------------------------------------
type, public :: pft_pstate_type
   integer , pointer :: frac_veg_nosno(:)       !fraction of vegetation not covered by snow (0 OR 1) [-] 
   integer , pointer :: frac_veg_nosno_alb(:)   !fraction of vegetation not covered by snow (0 OR 1) [-] 
   real(r8), pointer :: emv(:)                  !vegetation emissivity
   real(r8), pointer :: z0mv(:)                 !roughness length over vegetation, momentum [m]
   real(r8), pointer :: z0hv(:)                 !roughness length over vegetation, sensible heat [m]
   real(r8), pointer :: z0qv(:)                 !roughness length over vegetation, latent heat [m]
   real(r8), pointer :: rootfr(:,:)             !fraction of roots in each soil layer  (nlevgrnd)
   real(r8), pointer :: rootr(:,:)              !effective fraction of roots in each soil layer  (nlevgrnd)
   real(r8), pointer :: rresis(:,:)             !root resistance by layer (0-1)  (nlevgrnd)
   real(r8), pointer :: dewmx(:)                !Maximum allowed dew [mm]
   real(r8), pointer :: rssun(:)                !sunlit stomatal resistance (s/m)
   real(r8), pointer :: rssha(:)                !shaded stomatal resistance (s/m)
   real(r8), pointer :: laisun(:)               !sunlit projected leaf area index
   real(r8), pointer :: laisha(:)               !shaded projected leaf area index
   real(r8), pointer :: btran(:)                !transpiration wetness factor (0 to 1)
   real(r8), pointer :: fsun(:)                 !sunlit fraction of canopy
   real(r8), pointer :: tlai(:)                 !one-sided leaf area index, no burying by snow
   real(r8), pointer :: tsai(:)                 !one-sided stem area index, no burying by snow
   real(r8), pointer :: elai(:)                 !one-sided leaf area index with burying by snow
   real(r8), pointer :: esai(:)                 !one-sided stem area index with burying by snow
   real(r8), pointer :: fwet(:)                 !fraction of canopy that is wet (0 to 1)
   real(r8), pointer :: fdry(:)                 !fraction of foliage that is green and dry [-] (new)
   real(r8), pointer :: dt_veg(:)               !change in t_veg, last iteration (Kelvin)
   real(r8), pointer :: htop(:)                 !canopy top (m)
   real(r8), pointer :: hbot(:)                 !canopy bottom (m)
   real(r8), pointer :: z0m(:)                  !momentum roughness length (m)
   real(r8), pointer :: displa(:)               !displacement height (m)
   real(r8), pointer :: albd(:,:)               !surface albedo (direct)                       (numrad)
   real(r8), pointer :: albi(:,:)               !surface albedo (indirect)                      (numrad)
   real(r8), pointer :: fabd(:,:)               !flux absorbed by veg per unit direct flux     (numrad)
   real(r8), pointer :: fabi(:,:)               !flux absorbed by veg per unit diffuse flux    (numrad)
   real(r8), pointer :: ftdd(:,:)               !down direct flux below veg per unit dir flx   (numrad)
   real(r8), pointer :: ftid(:,:)               !down diffuse flux below veg per unit dir flx  (numrad)
   real(r8), pointer :: ftii(:,:)               !down diffuse flux below veg per unit dif flx  (numrad)
   real(r8), pointer :: u10(:)                  !10-m wind (m/s) (for dust model)
   real(r8), pointer :: ram1(:)                 !aerodynamical resistance (s/m)
   real(r8), pointer :: fv(:)                   !friction velocity (m/s) (for dust model)
   real(r8), pointer :: forc_hgt_u_pft(:)       !wind forcing height (10m+z0m+d) (m)
   real(r8), pointer :: forc_hgt_t_pft(:)       !temperature forcing height (10m+z0m+d) (m)
   real(r8), pointer :: forc_hgt_q_pft(:)       !specific humidity forcing height (10m+z0m+d) (m)
#if (defined CROP)
   real(r8), pointer :: hdidx(:)
   real(r8), pointer :: cumvd(:)
   real(r8), pointer :: htmx(:)      ! max hgt attained by a crop during yr
   real(r8), pointer :: vf(:)        ! vernalization factor for wheat
   real(r8), pointer :: gddmaturity(:)
   real(r8), pointer :: gdd0(:)
   real(r8), pointer :: gdd8(:)
   real(r8), pointer :: gdd10(:)
   real(r8), pointer :: gdd020(:)
   real(r8), pointer :: gdd820(:)
   real(r8), pointer :: gdd1020(:)
   real(r8), pointer :: gddplant(:)  ! accum gdd past planting date for crop
   real(r8), pointer :: gddtsoi(:)
   real(r8), pointer :: huileaf(:)
   real(r8), pointer :: huigrain(:)
   real(r8), pointer :: a10tmin(:)
   real(r8), pointer :: a5tmin(:)
   real(r8), pointer :: aleafi(:)
   real(r8), pointer :: astemi(:)
   real(r8), pointer :: aleaf(:)
   real(r8), pointer :: astem(:)
   integer , pointer :: croplive(:)
   integer , pointer :: cropplant(:) ! this and next could be 2-D to
   integer , pointer :: harvdate(:)  ! facilitate crop rotation
   integer , pointer :: idop(:)
   integer , pointer :: peaklai(:)   ! 1: max allowed lai; 0: not at max
#endif
   real(r8), pointer :: vds(:) 		        !deposition velocity term (m/s) (for dry dep SO4, NH4NO3)
   ! new variables for CN code
   real(r8), pointer :: slasun(:)     !specific leaf area for sunlit canopy, projected area basis (m^2/gC)
   real(r8), pointer :: slasha(:)     !specific leaf area for shaded canopy, projected area basis (m^2/gC)
   real(r8), pointer :: lncsun(:)     !leaf N concentration per unit projected LAI (gN leaf/m^2)
   real(r8), pointer :: lncsha(:)     !leaf N concentration per unit projected LAI (gN leaf/m^2)
   real(r8), pointer :: vcmxsun(:)    !sunlit leaf Vcmax (umolCO2/m^2/s)
   real(r8), pointer :: vcmxsha(:)    !shaded leaf Vcmax (umolCO2/m^2/s)
   real(r8), pointer :: gdir(:)       !leaf projection in solar direction (0 to 1)
   real(r8), pointer :: omega(:,:)    !fraction of intercepted radiation that is scattered (0 to 1)
   real(r8), pointer :: eff_kid(:,:)  !effective extinction coefficient for indirect from direct
   real(r8), pointer :: eff_kii(:,:)  !effective extinction coefficient for indirect from indirect
   real(r8), pointer :: sun_faid(:,:) !fraction sun canopy absorbed indirect from direct
   real(r8), pointer :: sun_faii(:,:) !fraction sun canopy absorbed indirect from indirect
   real(r8), pointer :: sha_faid(:,:) !fraction shade canopy absorbed indirect from direct
   real(r8), pointer :: sha_faii(:,:) !fraction shade canopy absorbed indirect from indirect
   ! 4/14/05: PET
   ! Adding isotope code
   real(r8), pointer :: cisun(:)       !sunlit intracellular CO2 (Pa)
   real(r8), pointer :: cisha(:)       !shaded intracellular CO2 (Pa)
#if (defined C13)
   real(r8), pointer :: alphapsnsun(:) !sunlit 13c fractionation ([])
   real(r8), pointer :: alphapsnsha(:) !shaded 13c fractionation ([])
#endif
   ! heald: added outside of CASA definition
   real(r8), pointer :: sandfrac(:)    ! sand fraction
   real(r8), pointer :: clayfrac(:)    ! clay fraction
   ! for dry deposition of chemical tracers
   real(r8), pointer :: mlaidiff(:)    ! difference between lai month one and month two
   real(r8), pointer :: rb1(:)         ! aerodynamical resistance (s/m)
   real(r8), pointer :: annlai(:,:)    ! 12 months of monthly lai from input data set  

   
#if (defined CASA)
   real(r8), pointer :: Closs(:,:)  ! C lost to atm
   real(r8), pointer :: Ctrans(:,:) ! C transfers out of pool types
   real(r8), pointer :: Resp_C(:,:) ! C respired
   real(r8), pointer :: Tpool_C(:,:)! Total C pool size
   real(r8), pointer :: eff(:,:)
   real(r8), pointer :: frac_donor(:,:)
   real(r8), pointer :: livefr(:,:) !live fraction
   real(r8), pointer :: pet(:)      !potential evaporation (mm h2o/s)
   real(r8), pointer :: co2flux(:)  ! net CO2 flux (g C/m2/sec) [+= atm]
   real(r8), pointer :: fnpp(:)     ! NPP  (g C/m2/sec)
   real(r8), pointer :: soilt(:)    !soil temp for top 30cm
   real(r8), pointer :: smoist(:)   !soil moisture for top 30cm
   real(r8), pointer :: sz(:)       !thickness of soil layers contributing to output
   real(r8), pointer :: watopt(:)   !optimal soil water content for et for top 30cm (mm3/mm3)
   real(r8), pointer :: watdry(:)   !soil water when et stops for top 30cm (mm3/mm3)
   real(r8), pointer :: soiltc(:)   !soil temp for entire column
   real(r8), pointer :: smoistc(:)  !soil moisture for entire column
   real(r8), pointer :: szc(:)      !thickness of soil layers contributing to output
   real(r8), pointer :: watoptc(:)  !optimal soil water content for et for entire column (mm3/mm3)
   real(r8), pointer :: watdryc(:)  !soil water when et stops for entire column (mm3/mm3)
   real(r8), pointer :: Wlim(:)     !Water limitation min value
   real(r8), pointer :: litterscalar(:)
   real(r8), pointer :: rootlitscalar(:)
   real(r8), pointer :: stressCD(:) ! cold and drought stress function (sec-1)
                                    ! add to "annK(m,LEAF)" and "annK(m,FROOT)"
                                    ! in casa_litterfall.F
   real(r8), pointer :: excessC(:)  ! excess Carbon (gC/m2/timestep)
   real(r8), pointer :: bgtemp(:)   ! temperature dependence
   real(r8), pointer :: bgmoist(:)  ! moisture dependence
   real(r8), pointer :: plai(:)     ! prognostic LAI (m2 leaf/m2 ground)
   real(r8), pointer :: Cflux(:)    ! Carbon flux
   real(r8), pointer :: XSCpool(:)
   real(r8), pointer :: tday(:)      ! daily accumulated temperature (deg C)
   real(r8), pointer :: tdayavg(:)   ! daily averaged temperature (deg C)
   real(r8), pointer :: tcount(:)    ! counter for daily avg temp
   real(r8), pointer :: degday(:)    ! accumulated degree days (deg C)
   real(r8), pointer :: ndegday(:)   ! counter for number of degree days
   real(r8), pointer :: stressT(:)   ! temperature stress function for leaf
                                     ! loss apply to Litterfall of deciduous veg   
   real(r8), pointer :: stressW(:)   ! water stress function for leaf loss
   real(r8), pointer :: iseabeg(:)   ! index for start of growing season
   real(r8), pointer :: nstepbeg(:)  ! nstep at start of growing season
   real(r8), pointer :: lgrow(:)     ! growing season index (0 or 1) to be
                                     ! passed daily to CASA to get NPP
#if (defined CLAMP)
   ! Summary variables added for the C-LAMP Experiments
   real(r8), pointer :: casa_agnpp(:)        ! above-ground net primary production [gC/m2/s]
   real(r8), pointer :: casa_ar(:)           ! autotrophic respiration [gC/m2/s]
   real(r8), pointer :: casa_bgnpp(:)        ! below-ground net primary production [gC/m2/s]
   real(r8), pointer :: casa_cwdc(:)         ! coarse woody debris C [gC/m2]
   real(r8), pointer :: casa_cwdc_hr(:)      ! cwd heterotrophic respiration [gC/m2/s]
   real(r8), pointer :: casa_cwdc_loss(:)    ! cwd C loss [gC/m2/s]
   real(r8), pointer :: casa_frootc(:)       ! fine root C [gC/m2]
   real(r8), pointer :: casa_frootc_alloc(:) ! fine root C allocation [gC/m2/s]
   real(r8), pointer :: casa_frootc_loss(:)  ! fine root C loss [gC/m2/s]
   real(r8), pointer :: casa_gpp(:)          ! gross primary production [gC/m2/s]
   real(r8), pointer :: casa_hr(:)           ! total heterotrophic respiration [gC/m2/s]
   real(r8), pointer :: casa_leafc(:)        ! leaf C [gC/m2]
   real(r8), pointer :: casa_leafc_alloc(:)  ! leaf C allocation [gC/m2/s]
   real(r8), pointer :: casa_leafc_loss(:)   ! leaf C loss [gC/m2/s]
   real(r8), pointer :: casa_litterc(:)      ! total litter C (excluding cwd C) [gC/m2]
   real(r8), pointer :: casa_litterc_hr(:)   ! litter heterotrophic respiration [gC/m2/s]
   real(r8), pointer :: casa_litterc_loss(:) ! litter C loss [gC/m2/s]
   real(r8), pointer :: casa_nee(:)          ! net ecosystem exchange [gC/m2/s]
   real(r8), pointer :: casa_nep(:)          ! net ecosystem production [gC/m2/s]
   real(r8), pointer :: casa_npp(:)          ! net primary production [gC/m2/s]
   real(r8), pointer :: casa_soilc(:)        ! total soil organic matter C (excluding cwd and litter C) [gC/m2]
   real(r8), pointer :: casa_soilc_hr(:)     ! soil heterotrophic respiration [gC/m2/s]
   real(r8), pointer :: casa_soilc_loss(:)   ! total soil organic matter C loss [gC/m2/s]
   real(r8), pointer :: casa_woodc(:)        ! wood C [gC/m2]
   real(r8), pointer :: casa_woodc_alloc(:)  ! wood C allocation [gC/m2/s]
   real(r8), pointer :: casa_woodc_loss(:)   ! wood C loss [gC/m2/s]
#endif
#endif
end type pft_pstate_type

!----------------------------------------------------
! pft ecophysiological constants structure
!----------------------------------------------------
type, public :: pft_epc_type
   integer , pointer :: noveg(:)                !value for not vegetated
   integer , pointer :: tree(:)                 !tree or not?
   real(r8), pointer :: smpso(:)                !soil water potential at full stomatal opening (mm)
   real(r8), pointer :: smpsc(:)                !soil water potential at full stomatal closure (mm)
   real(r8), pointer :: fnitr(:)                !foliage nitrogen limitation factor (-)
   real(r8), pointer :: foln(:)                 !foliage nitrogen (%)
   real(r8), pointer :: dleaf(:)                !characteristic leaf dimension (m)
   real(r8), pointer :: c3psn(:)                !photosynthetic pathway: 0. = c4, 1. = c3
   real(r8), pointer :: vcmx25(:)               !max rate of carboxylation at 25C (umol CO2/m**2/s)
   real(r8), pointer :: mp(:)                   !slope of conductance-to-photosynthesis relationship
   real(r8), pointer :: qe25(:)                 !quantum efficiency at 25C (umol CO2 / umol photon)
   real(r8), pointer :: xl(:)                   !leaf/stem orientation index
   real(r8), pointer :: rhol(:,:)               !leaf reflectance: 1=vis, 2=nir   (numrad)
   real(r8), pointer :: rhos(:,:)               !stem reflectance: 1=vis, 2=nir   (numrad)
   real(r8), pointer :: taul(:,:)               !leaf transmittance: 1=vis, 2=nir (numrad)
   real(r8), pointer :: taus(:,:)               !stem transmittance: 1=vis, 2=nir (numrad)
   real(r8), pointer :: z0mr(:)                 !ratio of momentum roughness length to canopy top height (-)
   real(r8), pointer :: displar(:)              !ratio of displacement height to canopy top height (-)
   real(r8), pointer :: roota_par(:)            !CLM rooting distribution parameter [1/m]
   real(r8), pointer :: rootb_par(:)            !CLM rooting distribution parameter [1/m]
   real(r8), pointer :: sla(:)                  !specific leaf area [m2 leaf g-1 carbon]
   ! new variables for CN code
   real(r8), pointer :: dwood(:)           !wood density (gC/m3)
   real(r8), pointer :: slatop(:)    !specific leaf area at top of canopy, projected area basis [m^2/gC]
   real(r8), pointer :: dsladlai(:)  !dSLA/dLAI, projected area basis [m^2/gC]
   real(r8), pointer :: leafcn(:)    !leaf C:N (gC/gN)
   real(r8), pointer :: flnr(:)      !fraction of leaf N in the Rubisco enzyme (gN Rubisco / gN leaf)
   real(r8), pointer :: woody(:)     !binary flag for woody lifeform (1=woody, 0=not woody)
   real(r8), pointer :: lflitcn(:)      !leaf litter C:N (gC/gN)
   real(r8), pointer :: frootcn(:)      !fine root C:N (gC/gN)
   real(r8), pointer :: livewdcn(:)     !live wood (phloem and ray parenchyma) C:N (gC/gN)
   real(r8), pointer :: deadwdcn(:)     !dead wood (xylem and heartwood) C:N (gC/gN)
#ifdef CROP
   real(r8), pointer :: graincn(:)      !grain C:N (gC/gN)
#endif
   real(r8), pointer :: froot_leaf(:)   !allocation parameter: new fine root C per new leaf C (gC/gC)
   real(r8), pointer :: stem_leaf(:)    !allocation parameter: new stem c per new leaf C (gC/gC)
   real(r8), pointer :: croot_stem(:)   !allocation parameter: new coarse root C per new stem C (gC/gC)
   real(r8), pointer :: flivewd(:)      !allocation parameter: fraction of new wood that is live (phloem and ray parenchyma) (no units)
   real(r8), pointer :: fcur(:)         !allocation parameter: fraction of allocation that goes to currently displayed growth, remainder to storage
   real(r8), pointer :: lf_flab(:)      !leaf litter labile fraction
   real(r8), pointer :: lf_fcel(:)      !leaf litter cellulose fraction
   real(r8), pointer :: lf_flig(:)      !leaf litter lignin fraction
   real(r8), pointer :: fr_flab(:)      !fine root litter labile fraction
   real(r8), pointer :: fr_fcel(:)      !fine root litter cellulose fraction
   real(r8), pointer :: fr_flig(:)      !fine root litter lignin fraction
   real(r8), pointer :: dw_fcel(:)      !dead wood cellulose fraction
   real(r8), pointer :: dw_flig(:)      !dead wood lignin fraction
   real(r8), pointer :: leaf_long(:)    !leaf longevity (yrs)
   real(r8), pointer :: evergreen(:)    !binary flag for evergreen leaf habit (0 or 1)
   real(r8), pointer :: stress_decid(:) !binary flag for stress-deciduous leaf habit (0 or 1)
   real(r8), pointer :: season_decid(:) !binary flag for seasonal-deciduous leaf habit (0 or 1)
   ! new variables for fire code
   real(r8), pointer :: resist(:)       !resistance to fire (no units)
end type pft_epc_type

#if (defined CNDV) || (defined CROP)
!----------------------------------------------------
! pft DGVM-specific ecophysiological constants structure
!----------------------------------------------------
type, public :: pft_dgvepc_type
   real(r8), pointer :: crownarea_max(:)   !tree maximum crown area [m2]
   real(r8), pointer :: tcmin(:)           !minimum coldest monthly mean temperature [units?]
   real(r8), pointer :: tcmax(:)           !maximum coldest monthly mean temperature [units?]
   real(r8), pointer :: gddmin(:)          !minimum growing degree days (at or above 5 C)
   real(r8), pointer :: twmax(:)           !upper limit of temperature of the warmest month [units?]
   real(r8), pointer :: reinickerp(:)      !parameter in allometric equation
   real(r8), pointer :: allom1(:)          !parameter in allometric
   real(r8), pointer :: allom2(:)          !parameter in allometric
   real(r8), pointer :: allom3(:)          !parameter in allometric
end type pft_dgvepc_type
#endif

!----------------------------------------------------
! pft ecophysiological variables structure
!----------------------------------------------------
type, public :: pft_epv_type
   real(r8), pointer :: dormant_flag(:)         !dormancy flag
   real(r8), pointer :: days_active(:)          !number of days since last dormancy
   real(r8), pointer :: onset_flag(:)           !onset flag
   real(r8), pointer :: onset_counter(:)        !onset days counter
   real(r8), pointer :: onset_gddflag(:)        !onset flag for growing degree day sum
   real(r8), pointer :: onset_fdd(:)            !onset freezing degree days counter
   real(r8), pointer :: onset_gdd(:)            !onset growing degree days
   real(r8), pointer :: onset_swi(:)            !onset soil water index
   real(r8), pointer :: offset_flag(:)          !offset flag
   real(r8), pointer :: offset_counter(:)       !offset days counter
   real(r8), pointer :: offset_fdd(:)           !offset freezing degree days counter
   real(r8), pointer :: offset_swi(:)           !offset soil water index
   real(r8), pointer :: lgsf(:)                 !long growing season factor [0-1]
   real(r8), pointer :: bglfr(:)                !background litterfall rate (1/s)
   real(r8), pointer :: bgtr(:)                 !background transfer growth rate (1/s)
   real(r8), pointer :: dayl(:)                 !daylength (seconds)
   real(r8), pointer :: prev_dayl(:)            !daylength from previous timestep (seconds)
   real(r8), pointer :: annavg_t2m(:)           !annual average 2m air temperature (K)
   real(r8), pointer :: tempavg_t2m(:)          !temporary average 2m air temperature (K)
   real(r8), pointer :: gpp(:)                  !GPP flux before downregulation (gC/m2/s)
   real(r8), pointer :: availc(:)               !C flux available for allocation (gC/m2/s)
   real(r8), pointer :: xsmrpool_recover(:)     !C flux assigned to recovery of negative cpool (gC/m2/s)
#if (defined C13)
   real(r8), pointer :: xsmrpool_c13ratio(:)    !C13/C(12+13) ratio for xsmrpool (proportion)
#endif
   real(r8), pointer :: alloc_pnow(:)           !fraction of current allocation to display as new growth (DIM)
   real(r8), pointer :: c_allometry(:)          !C allocation index (DIM)
   real(r8), pointer :: n_allometry(:)          !N allocation index (DIM)
   real(r8), pointer :: plant_ndemand(:)        !N flux required to support initial GPP (gN/m2/s)
   real(r8), pointer :: tempsum_potential_gpp(:)!temporary annual sum of potential GPP
   real(r8), pointer :: annsum_potential_gpp(:) !annual sum of potential GPP
   real(r8), pointer :: tempmax_retransn(:)     !temporary annual max of retranslocated N pool (gN/m2)
   real(r8), pointer :: annmax_retransn(:)      !annual max of retranslocated N pool (gN/m2)
   real(r8), pointer :: avail_retransn(:)       !N flux available from retranslocation pool (gN/m2/s)
   real(r8), pointer :: plant_nalloc(:)         !total allocated N flux (gN/m2/s)
   real(r8), pointer :: plant_calloc(:)         !total allocated C flux (gC/m2/s)
   real(r8), pointer :: excess_cflux(:)         !C flux not allocated due to downregulation (gC/m2/s)
   real(r8), pointer :: downreg(:)              !fractional reduction in GPP due to N limitation (DIM)
   real(r8), pointer :: prev_leafc_to_litter(:) !previous timestep leaf C litterfall flux (gC/m2/s)
   real(r8), pointer :: prev_frootc_to_litter(:)!previous timestep froot C litterfall flux (gC/m2/s)
   real(r8), pointer :: tempsum_npp(:)          !temporary annual sum of NPP (gC/m2/yr)
   real(r8), pointer :: annsum_npp(:)           !annual sum of NPP (gC/m2/yr)
#if (defined CNDV)
   real(r8), pointer :: tempsum_litfall(:)      !temporary annual sum of litfall (gC/m2/yr)
   real(r8), pointer :: annsum_litfall(:)       !annual sum of litfall (gC/m2/yr)
#endif
#if (defined C13)
   real(r8), pointer :: rc13_canair(:)          !C13O2/C12O2 in canopy air
   real(r8), pointer :: rc13_psnsun(:)          !C13O2/C12O2 in sunlit canopy psn flux
   real(r8), pointer :: rc13_psnsha(:)          !C13O2/C12O2 in shaded canopy psn flux
#endif
end type pft_epv_type                        

!----------------------------------------------------
! pft energy state variables structure
!----------------------------------------------------
type, public :: pft_estate_type
   real(r8), pointer :: t_ref2m(:)            !2 m height surface air temperature (Kelvin)
   real(r8), pointer :: t_ref2m_min(:)        !daily minimum of average 2 m height surface air temperature (K)
   real(r8), pointer :: t_ref2m_max(:)        !daily maximum of average 2 m height surface air temperature (K)
   real(r8), pointer :: t_ref2m_min_inst(:)   !instantaneous daily min of average 2 m height surface air temp (K)
   real(r8), pointer :: t_ref2m_max_inst(:)   !instantaneous daily max of average 2 m height surface air temp (K)
   real(r8), pointer :: q_ref2m(:)            !2 m height surface specific humidity (kg/kg)
   real(r8), pointer :: t_ref2m_u(:)          !Urban 2 m height surface air temperature (Kelvin)
   real(r8), pointer :: t_ref2m_r(:)          !Rural 2 m height surface air temperature (Kelvin)
   real(r8), pointer :: t_ref2m_min_u(:)      !Urban daily minimum of average 2 m height surface air temperature (K)
   real(r8), pointer :: t_ref2m_min_r(:)      !Rural daily minimum of average 2 m height surface air temperature (K)
   real(r8), pointer :: t_ref2m_max_u(:)      !Urban daily maximum of average 2 m height surface air temperature (K)
   real(r8), pointer :: t_ref2m_max_r(:)      !Rural daily maximum of average 2 m height surface air temperature (K)
   real(r8), pointer :: t_ref2m_min_inst_u(:) !Urban instantaneous daily min of average 2 m height surface air temp (K)
   real(r8), pointer :: t_ref2m_min_inst_r(:) !Rural instantaneous daily min of average 2 m height surface air temp (K)
   real(r8), pointer :: t_ref2m_max_inst_u(:) !Urban instantaneous daily max of average 2 m height surface air temp (K)
   real(r8), pointer :: t_ref2m_max_inst_r(:) !Rural instantaneous daily max of average 2 m height surface air temp (K)
   real(r8), pointer :: rh_ref2m(:)           !2 m height surface relative humidity (%)
   real(r8), pointer :: rh_ref2m_u(:)         !Urban 2 m height surface relative humidity (%)
   real(r8), pointer :: rh_ref2m_r(:)         !Rural 2 m height surface relative humidity (%)
   real(r8), pointer :: t_veg(:)              !vegetation temperature (Kelvin)
   real(r8), pointer :: thm(:)                !intermediate variable (forc_t+0.0098*forc_hgt_t_pft)
end type pft_estate_type

!----------------------------------------------------
! pft water state variables structure
!----------------------------------------------------
type, public :: pft_wstate_type
   real(r8), pointer :: h2ocan(:)         !canopy water (mm H2O)
end type pft_wstate_type

!----------------------------------------------------
! pft carbon state variables structure
!----------------------------------------------------
type, public :: pft_cstate_type
   real(r8), pointer :: leafcmax(:)           ! (gC/m2) ann max leaf C
#if (defined CROP)
   real(r8), pointer :: grainc(:)             ! (gC/m2) grain C
   real(r8), pointer :: grainc_storage(:)     ! (gC/m2) grain C storage
   real(r8), pointer :: grainc_xfer(:)        ! (gC/m2) grain C transfer
#endif
   real(r8), pointer :: leafc(:)              ! (gC/m2) leaf C
   real(r8), pointer :: leafc_storage(:)      ! (gC/m2) leaf C storage
   real(r8), pointer :: leafc_xfer(:)         ! (gC/m2) leaf C transfer
   real(r8), pointer :: frootc(:)             ! (gC/m2) fine root C
   real(r8), pointer :: frootc_storage(:)     ! (gC/m2) fine root C storage
   real(r8), pointer :: frootc_xfer(:)        ! (gC/m2) fine root C transfer
   real(r8), pointer :: livestemc(:)          ! (gC/m2) live stem C
   real(r8), pointer :: livestemc_storage(:)  ! (gC/m2) live stem C storage
   real(r8), pointer :: livestemc_xfer(:)     ! (gC/m2) live stem C transfer
   real(r8), pointer :: deadstemc(:)          ! (gC/m2) dead stem C
   real(r8), pointer :: deadstemc_storage(:)  ! (gC/m2) dead stem C storage
   real(r8), pointer :: deadstemc_xfer(:)     ! (gC/m2) dead stem C transfer
   real(r8), pointer :: livecrootc(:)         ! (gC/m2) live coarse root C
   real(r8), pointer :: livecrootc_storage(:) ! (gC/m2) live coarse root C storage
   real(r8), pointer :: livecrootc_xfer(:)    ! (gC/m2) live coarse root C transfer
   real(r8), pointer :: deadcrootc(:)         ! (gC/m2) dead coarse root C
   real(r8), pointer :: deadcrootc_storage(:) ! (gC/m2) dead coarse root C storage
   real(r8), pointer :: deadcrootc_xfer(:)    ! (gC/m2) dead coarse root C transfer
   real(r8), pointer :: gresp_storage(:)      ! (gC/m2) growth respiration storage
   real(r8), pointer :: gresp_xfer(:)         ! (gC/m2) growth respiration transfer
   real(r8), pointer :: cpool(:)              ! (gC/m2) temporary photosynthate C pool
   real(r8), pointer :: xsmrpool(:)           ! (gC/m2) abstract C pool to meet excess MR demand
   real(r8), pointer :: pft_ctrunc(:)         ! (gC/m2) pft-level sink for C truncation
   ! summary (diagnostic) state variables, not involved in mass balance
   real(r8), pointer :: dispvegc(:)           ! (gC/m2) displayed veg carbon, excluding storage and cpool
   real(r8), pointer :: storvegc(:)           ! (gC/m2) stored vegetation carbon, excluding cpool
   real(r8), pointer :: totvegc(:)            ! (gC/m2) total vegetation carbon, excluding cpool
   real(r8), pointer :: totpftc(:)            ! (gC/m2) total pft-level carbon, including cpool
#if (defined CLAMP) && (defined CN)
   ! CLAMP summary (diagnostic) variable
   real(r8), pointer :: woodc(:)              ! (gC/m2) wood C
#endif
end type pft_cstate_type

!----------------------------------------------------
! pft nitrogen state variables structure
!----------------------------------------------------
type, public :: pft_nstate_type
#if (defined CROP)
   real(r8), pointer :: grainn(:)             ! (gN/m2) grain N 
   real(r8), pointer :: grainn_storage(:)     ! (gN/m2) grain N storage
   real(r8), pointer :: grainn_xfer(:)        ! (gN/m2) grain N transfer
#endif
   real(r8), pointer :: leafn(:)              ! (gN/m2) leaf N 
   real(r8), pointer :: leafn_storage(:)      ! (gN/m2) leaf N storage
   real(r8), pointer :: leafn_xfer(:)         ! (gN/m2) leaf N transfer
   real(r8), pointer :: frootn(:)             ! (gN/m2) fine root N
   real(r8), pointer :: frootn_storage(:)     ! (gN/m2) fine root N storage
   real(r8), pointer :: frootn_xfer(:)        ! (gN/m2) fine root N transfer
   real(r8), pointer :: livestemn(:)          ! (gN/m2) live stem N
   real(r8), pointer :: livestemn_storage(:)  ! (gN/m2) live stem N storage
   real(r8), pointer :: livestemn_xfer(:)     ! (gN/m2) live stem N transfer
   real(r8), pointer :: deadstemn(:)          ! (gN/m2) dead stem N
   real(r8), pointer :: deadstemn_storage(:)  ! (gN/m2) dead stem N storage
   real(r8), pointer :: deadstemn_xfer(:)     ! (gN/m2) dead stem N transfer
   real(r8), pointer :: livecrootn(:)         ! (gN/m2) live coarse root N
   real(r8), pointer :: livecrootn_storage(:) ! (gN/m2) live coarse root N storage
   real(r8), pointer :: livecrootn_xfer(:)    ! (gN/m2) live coarse root N transfer
   real(r8), pointer :: deadcrootn(:)         ! (gN/m2) dead coarse root N
   real(r8), pointer :: deadcrootn_storage(:) ! (gN/m2) dead coarse root N storage
   real(r8), pointer :: deadcrootn_xfer(:)    ! (gN/m2) dead coarse root N transfer
   real(r8), pointer :: retransn(:)           ! (gN/m2) plant pool of retranslocated N
   real(r8), pointer :: npool(:)              ! (gN/m2) temporary plant N pool
   real(r8), pointer :: pft_ntrunc(:)         ! (gN/m2) pft-level sink for N truncation
   ! summary (diagnostic) state variables, not involved in mass balance
   real(r8), pointer :: dispvegn(:)           ! (gN/m2) displayed veg nitrogen, excluding storage
   real(r8), pointer :: storvegn(:)           ! (gN/m2) stored vegetation nitrogen
   real(r8), pointer :: totvegn(:)            ! (gN/m2) total vegetation nitrogen
   real(r8), pointer :: totpftn(:)            ! (gN/m2) total pft-level nitrogen
end type pft_nstate_type

!----------------------------------------------------
! pft VOC state variables structure
!----------------------------------------------------
type, public :: pft_vstate_type
   real(r8), pointer :: t_veg24(:)             ! 24hr average vegetation temperature (K)
   real(r8), pointer :: t_veg240(:)            ! 240hr average vegetation temperature (Kelvin)
   real(r8), pointer :: fsd24(:)               ! 24hr average of direct beam radiation 
   real(r8), pointer :: fsd240(:)              ! 240hr average of direct beam radiation 
   real(r8), pointer :: fsi24(:)               ! 24hr average of diffuse beam radiation 
   real(r8), pointer :: fsi240(:)              ! 240hr average of diffuse beam radiation 
   real(r8), pointer :: fsun24(:)              ! 24hr average of sunlit fraction of canopy 
   real(r8), pointer :: fsun240(:)             ! 240hr average of sunlit fraction of canopy
   real(r8), pointer :: elai_p(:)              ! leaf area index average over timestep 
end type pft_vstate_type

#if (defined CNDV) || (defined CROP)
!----------------------------------------------------
! pft DGVM state variables structure
!----------------------------------------------------
type, public :: pft_dgvstate_type
   real(r8), pointer :: agddtw(:)              !accumulated growing degree days above twmax
   real(r8), pointer :: agdd(:)                !accumulated growing degree days above 5
   real(r8), pointer :: t10(:)                 !10-day running mean of the 2 m temperature (K)
   real(r8), pointer :: t_mo(:)                !30-day average temperature (Kelvin)
   real(r8), pointer :: t_mo_min(:)            !annual min of t_mo (Kelvin)
   real(r8), pointer :: prec365(:)             !365-day running mean of tot. precipitation
   logical , pointer :: present(:)             !whether PFT present in patch
   logical , pointer :: pftmayexist(:)         !if .false. then exclude seasonal decid pfts from tropics
   real(r8), pointer :: nind(:)                !number of individuals (#/m**2)
   real(r8), pointer :: lm_ind(:)              !individual leaf mass
   real(r8), pointer :: lai_ind(:)             !LAI per individual
   real(r8), pointer :: fpcinc(:)              !foliar projective cover increment (fraction) 
   real(r8), pointer :: fpcgrid(:)             !foliar projective cover on gridcell (fraction)
   real(r8), pointer :: fpcgridold(:)          !last yr's fpcgrid
   real(r8), pointer :: crownarea(:)           !area that each individual tree takes up (m^2)
   real(r8), pointer :: greffic(:)
   real(r8), pointer :: heatstress(:)
end type pft_dgvstate_type
#endif

!----------------------------------------------------
! pft energy flux variables structure
!----------------------------------------------------
type, public :: pft_eflux_type
   real(r8), pointer :: sabg(:)              !solar radiation absorbed by ground (W/m**2)
   real(r8), pointer :: sabv(:)              !solar radiation absorbed by vegetation (W/m**2)
   real(r8), pointer :: fsa(:)               !solar radiation absorbed (total) (W/m**2)
   real(r8), pointer :: fsa_u(:)             !urban solar radiation absorbed (total) (W/m**2)
   real(r8), pointer :: fsa_r(:)             !rural solar radiation absorbed (total) (W/m**2)
   real(r8), pointer :: fsr(:)               !solar radiation reflected (W/m**2)
   real(r8), pointer :: parsun(:)            !average absorbed PAR for sunlit leaves (W/m**2)
   real(r8), pointer :: parsha(:)            !average absorbed PAR for shaded leaves (W/m**2)
   real(r8), pointer :: dlrad(:)             !downward longwave radiation below the canopy [W/m2]
   real(r8), pointer :: ulrad(:)             !upward longwave radiation above the canopy [W/m2]
   real(r8), pointer :: eflx_lh_tot(:)       !total latent heat flux (W/m**2)  [+ to atm]
   real(r8), pointer :: eflx_lh_tot_u(:)     !urban total latent heat flux (W/m**2)  [+ to atm]
   real(r8), pointer :: eflx_lh_tot_r(:)     !rural total latent heat flux (W/m**2)  [+ to atm]
   real(r8), pointer :: eflx_lh_grnd(:)      !ground evaporation heat flux (W/m**2) [+ to atm]
   real(r8), pointer :: eflx_soil_grnd(:)    !soil heat flux (W/m**2) [+ = into soil]
   real(r8), pointer :: eflx_soil_grnd_u(:)  !urban soil heat flux (W/m**2) [+ = into soil]
   real(r8), pointer :: eflx_soil_grnd_r(:)  !rural soil heat flux (W/m**2) [+ = into soil]
   real(r8), pointer :: eflx_sh_tot(:)       !total sensible heat flux (W/m**2) [+ to atm]
   real(r8), pointer :: eflx_sh_tot_u(:)     !urban total sensible heat flux (W/m**2) [+ to atm]
   real(r8), pointer :: eflx_sh_tot_r(:)     !rural total sensible heat flux (W/m**2) [+ to atm]
   real(r8), pointer :: eflx_sh_grnd(:)      !sensible heat flux from ground (W/m**2) [+ to atm]
   real(r8), pointer :: eflx_sh_veg(:)       !sensible heat flux from leaves (W/m**2) [+ to atm]
   real(r8), pointer :: eflx_lh_vege(:)      !veg evaporation heat flux (W/m**2) [+ to atm]
   real(r8), pointer :: eflx_lh_vegt(:)      !veg transpiration heat flux (W/m**2) [+ to atm]
   real(r8), pointer :: eflx_wasteheat_pft(:) !sensible heat flux from domestic heating/cooling sources of waste heat (W/m**2)
   real(r8), pointer :: eflx_heat_from_ac_pft(:) !sensible heat flux put back into canyon due to removal by AC (W/m**2)
   real(r8), pointer :: eflx_traffic_pft(:)      !traffic sensible heat flux (W/m**2)
   real(r8), pointer :: eflx_anthro(:)           !total anthropogenic heat flux (W/m**2)
   real(r8), pointer :: cgrnd(:)             !deriv. of soil energy flux wrt to soil temp [w/m2/k]
   real(r8), pointer :: cgrndl(:)            !deriv. of soil latent heat flux wrt soil temp [w/m**2/k]
   real(r8), pointer :: cgrnds(:)            !deriv. of soil sensible heat flux wrt soil temp [w/m2/k]
   real(r8), pointer :: eflx_gnet(:)         !net heat flux into ground (W/m**2)
   real(r8), pointer :: dgnetdT(:)           !derivative of net ground heat flux wrt soil temp (W/m**2 K)
   real(r8), pointer :: eflx_lwrad_out(:)    !emitted infrared (longwave) radiation (W/m**2)
   real(r8), pointer :: eflx_lwrad_net(:)    !net infrared (longwave) rad (W/m**2) [+ = to atm]
   real(r8), pointer :: eflx_lwrad_net_u(:)  !urban net infrared (longwave) rad (W/m**2) [+ = to atm]
   real(r8), pointer :: eflx_lwrad_net_r(:)  !rural net infrared (longwave) rad (W/m**2) [+ = to atm]
   real(r8), pointer :: netrad(:)            !net radiation (W/m**2) [+ = to sfc]
   real(r8), pointer :: fsds_vis_d(:)        !incident direct beam vis solar radiation (W/m**2)
   real(r8), pointer :: fsds_nir_d(:)        !incident direct beam nir solar radiation (W/m**2)
   real(r8), pointer :: fsds_vis_i(:)        !incident diffuse vis solar radiation (W/m**2)
   real(r8), pointer :: fsds_nir_i(:)        !incident diffuse nir solar radiation (W/m**2)
   real(r8), pointer :: fsr_vis_d(:)         !reflected direct beam vis solar radiation (W/m**2)
   real(r8), pointer :: fsr_nir_d(:)         !reflected direct beam nir solar radiation (W/m**2)
   real(r8), pointer :: fsr_vis_i(:)         !reflected diffuse vis solar radiation (W/m**2)
   real(r8), pointer :: fsr_nir_i(:)         !reflected diffuse nir solar radiation (W/m**2)
   real(r8), pointer :: fsds_vis_d_ln(:)     !incident direct beam vis solar radiation at local noon (W/m**2)
   real(r8), pointer :: fsds_nir_d_ln(:)     !incident direct beam nir solar radiation at local noon (W/m**2)
   real(r8), pointer :: fsr_vis_d_ln(:)      !reflected direct beam vis solar radiation at local noon (W/m**2)
   real(r8), pointer :: fsr_nir_d_ln(:)      !reflected direct beam nir solar radiation at local noon (W/m**2)
   real(r8), pointer :: sun_add(:,:)      !sun canopy absorbed direct from direct (W/m**2)
   real(r8), pointer :: tot_aid(:,:)      !total canopy absorbed indirect from direct (W/m**2)
   real(r8), pointer :: sun_aid(:,:)      !sun canopy absorbed indirect from direct (W/m**2)
   real(r8), pointer :: sun_aii(:,:)      !sun canopy absorbed indirect from indirect (W/m**2)
   real(r8), pointer :: sha_aid(:,:)      !shade canopy absorbed indirect from direct (W/m**2)
   real(r8), pointer :: sha_aii(:,:)      !shade canopy absorbed indirect from indirect (W/m**2)
   real(r8), pointer :: sun_atot(:,:)     !sun canopy total absorbed (W/m**2)
   real(r8), pointer :: sha_atot(:,:)     !shade canopy total absorbed (W/m**2)
   real(r8), pointer :: sun_alf(:,:)      !sun canopy total absorbed by leaves (W/m**2)
   real(r8), pointer :: sha_alf(:,:)      !shade canopy total absored by leaves (W/m**2)
   real(r8), pointer :: sun_aperlai(:,:)  !sun canopy total absorbed per unit LAI (W/m**2)
   real(r8), pointer :: sha_aperlai(:,:)  !shade canopy total absorbed per unit LAI (W/m**2)
   real(r8), pointer :: sabg_lyr(:,:)     ! absorbed radiation in each snow layer and top soil layer (pft,lyr) [W/m2]
   real(r8), pointer :: sfc_frc_aer(:)    ! surface forcing of snow with all aerosols (pft) [W/m2]
   real(r8), pointer :: sfc_frc_bc(:)     ! surface forcing of snow with BC (pft) [W/m2]
   real(r8), pointer :: sfc_frc_oc(:)     ! surface forcing of snow with OC (pft) [W/m2]
   real(r8), pointer :: sfc_frc_dst(:)    ! surface forcing of snow with dust (pft) [W/m2]
   real(r8), pointer :: sfc_frc_aer_sno(:)! surface forcing of snow with all aerosols, averaged only when snow is present (pft) [W/m2]
   real(r8), pointer :: sfc_frc_bc_sno(:) ! surface forcing of snow with BC, averaged only when snow is present (pft) [W/m2]
   real(r8), pointer :: sfc_frc_oc_sno(:) ! surface forcing of snow with OC, averaged only when snow is present (pft) [W/m2]
   real(r8), pointer :: sfc_frc_dst_sno(:)! surface forcing of snow with dust, averaged only when snow is present (pft) [W/m2]
   real(r8), pointer :: fsr_sno_vd(:)     ! reflected direct beam vis solar radiation from snow (W/m**2)
   real(r8), pointer :: fsr_sno_nd(:)     ! reflected direct beam NIR solar radiation from snow (W/m**2)
   real(r8), pointer :: fsr_sno_vi(:)     ! reflected diffuse vis solar radiation from snow (W/m**2)
   real(r8), pointer :: fsr_sno_ni(:)     ! reflected diffuse NIR solar radiation from snow (W/m**2)
   real(r8), pointer :: fsds_sno_vd(:)    ! incident visible, direct radiation on snow (for history files)  [W/m2]
   real(r8), pointer :: fsds_sno_nd(:)    ! incident near-IR, direct radiation on snow (for history files)  [W/m2]
   real(r8), pointer :: fsds_sno_vi(:)    ! incident visible, diffuse radiation on snow (for history files) [W/m2]
   real(r8), pointer :: fsds_sno_ni(:)    ! incident near-IR, diffuse radiation on snow (for history files) [W/m2]
end type pft_eflux_type

!----------------------------------------------------
! pft momentum flux variables structure
!----------------------------------------------------
type, public :: pft_mflux_type
   real(r8),pointer ::  taux(:)           !wind (shear) stress: e-w (kg/m/s**2)
   real(r8),pointer ::  tauy(:)           !wind (shear) stress: n-s (kg/m/s**2)
end type pft_mflux_type

!----------------------------------------------------
! pft water flux variables structure
!----------------------------------------------------
type, public :: pft_wflux_type
   real(r8), pointer :: qflx_prec_intr(:) !interception of precipitation [mm/s]
   real(r8), pointer :: qflx_prec_grnd(:) !water onto ground including canopy runoff [kg/(m2 s)]
   real(r8), pointer :: qflx_rain_grnd(:) !rain on ground after interception (mm H2O/s) [+]
   real(r8), pointer :: qflx_snow_grnd(:) !snow on ground after interception (mm H2O/s) [+]
   real(r8), pointer :: qflx_snwcp_ice(:) !excess snowfall due to snow capping (mm H2O /s) [+]
   real(r8), pointer :: qflx_snwcp_liq(:) !excess rainfall due to snow capping (mm H2O /s) [+]
   real(r8), pointer :: qflx_evap_veg(:)  !vegetation evaporation (mm H2O/s) (+ = to atm)
   real(r8), pointer :: qflx_tran_veg(:)  !vegetation transpiration (mm H2O/s) (+ = to atm)
   real(r8), pointer :: qflx_evap_can(:)  !evaporation from leaves and stems 
   real(r8), pointer :: qflx_evap_soi(:)  !soil evaporation (mm H2O/s) (+ = to atm)
   real(r8), pointer :: qflx_evap_tot(:)  !qflx_evap_soi + qflx_evap_veg + qflx_tran_veg
   real(r8), pointer :: qflx_evap_grnd(:) !ground surface evaporation rate (mm H2O/s) [+]
   real(r8), pointer :: qflx_dew_grnd(:)  !ground surface dew formation (mm H2O /s) [+]
   real(r8), pointer :: qflx_sub_snow(:)  !sublimation rate from snow pack (mm H2O /s) [+]
   real(r8), pointer :: qflx_dew_snow(:)  !surface dew added to snow pack (mm H2O /s) [+]
end type pft_wflux_type

!----------------------------------------------------
! pft carbon flux variables structure
!----------------------------------------------------
type, public :: pft_cflux_type
   real(r8), pointer :: psnsun(:)         !sunlit leaf photosynthesis (umol CO2 /m**2/ s)
   real(r8), pointer :: psnsha(:)         !shaded leaf photosynthesis (umol CO2 /m**2/ s)
   real(r8), pointer :: fpsn(:)           !photosynthesis (umol CO2 /m**2 /s)
   real(r8), pointer :: fco2(:)           !net CO2 flux (umol CO2 /m**2 /s) [+ = to atm]
   ! new variables for CN code
   ! gap mortality fluxes
   real(r8), pointer :: m_leafc_to_litter(:)                 ! leaf C mortality (gC/m2/s)
   real(r8), pointer :: m_leafc_storage_to_litter(:)         ! leaf C storage mortality (gC/m2/s)
   real(r8), pointer :: m_leafc_xfer_to_litter(:)            ! leaf C transfer mortality (gC/m2/s)
   real(r8), pointer :: m_frootc_to_litter(:)                ! fine root C mortality (gC/m2/s)
   real(r8), pointer :: m_frootc_storage_to_litter(:)        ! fine root C storage mortality (gC/m2/s)
   real(r8), pointer :: m_frootc_xfer_to_litter(:)           ! fine root C transfer mortality (gC/m2/s)
   real(r8), pointer :: m_livestemc_to_litter(:)             ! live stem C mortality (gC/m2/s)
   real(r8), pointer :: m_livestemc_storage_to_litter(:)     ! live stem C storage mortality (gC/m2/s)
   real(r8), pointer :: m_livestemc_xfer_to_litter(:)        ! live stem C transfer mortality (gC/m2/s)
   real(r8), pointer :: m_deadstemc_to_litter(:)             ! dead stem C mortality (gC/m2/s)
   real(r8), pointer :: m_deadstemc_storage_to_litter(:)     ! dead stem C storage mortality (gC/m2/s)
   real(r8), pointer :: m_deadstemc_xfer_to_litter(:)        ! dead stem C transfer mortality (gC/m2/s)
   real(r8), pointer :: m_livecrootc_to_litter(:)            ! live coarse root C mortality (gC/m2/s)
   real(r8), pointer :: m_livecrootc_storage_to_litter(:)    ! live coarse root C storage mortality (gC/m2/s)
   real(r8), pointer :: m_livecrootc_xfer_to_litter(:)       ! live coarse root C transfer mortality (gC/m2/s)
   real(r8), pointer :: m_deadcrootc_to_litter(:)            ! dead coarse root C mortality (gC/m2/s)
   real(r8), pointer :: m_deadcrootc_storage_to_litter(:)    ! dead coarse root C storage mortality (gC/m2/s)
   real(r8), pointer :: m_deadcrootc_xfer_to_litter(:)       ! dead coarse root C transfer mortality (gC/m2/s)
   real(r8), pointer :: m_gresp_storage_to_litter(:)         ! growth respiration storage mortality (gC/m2/s)
   real(r8), pointer :: m_gresp_xfer_to_litter(:)            ! growth respiration transfer mortality (gC/m2/s)
   ! harvest mortality fluxes
   real(r8), pointer :: hrv_leafc_to_litter(:)               ! leaf C harvest mortality (gC/m2/s)
   real(r8), pointer :: hrv_leafc_storage_to_litter(:)       ! leaf C storage harvest mortality (gC/m2/s)
   real(r8), pointer :: hrv_leafc_xfer_to_litter(:)          ! leaf C transfer harvest mortality (gC/m2/s)
   real(r8), pointer :: hrv_frootc_to_litter(:)              ! fine root C harvest mortality (gC/m2/s)
   real(r8), pointer :: hrv_frootc_storage_to_litter(:)      ! fine root C storage harvest mortality (gC/m2/s)
   real(r8), pointer :: hrv_frootc_xfer_to_litter(:)         ! fine root C transfer harvest mortality (gC/m2/s)
   real(r8), pointer :: hrv_livestemc_to_litter(:)           ! live stem C harvest mortality (gC/m2/s)
   real(r8), pointer :: hrv_livestemc_storage_to_litter(:)   ! live stem C storage harvest mortality (gC/m2/s)
   real(r8), pointer :: hrv_livestemc_xfer_to_litter(:)      ! live stem C transfer harvest mortality (gC/m2/s)
   real(r8), pointer :: hrv_deadstemc_to_prod10c(:)          ! dead stem C harvest to 10-year product pool (gC/m2/s)
   real(r8), pointer :: hrv_deadstemc_to_prod100c(:)         ! dead stem C harvest to 100-year product pool (gC/m2/s)
   real(r8), pointer :: hrv_deadstemc_storage_to_litter(:)   ! dead stem C storage harvest mortality (gC/m2/s)
   real(r8), pointer :: hrv_deadstemc_xfer_to_litter(:)      ! dead stem C transfer harvest mortality (gC/m2/s)
   real(r8), pointer :: hrv_livecrootc_to_litter(:)          ! live coarse root C harvest mortality (gC/m2/s)
   real(r8), pointer :: hrv_livecrootc_storage_to_litter(:)  ! live coarse root C storage harvest mortality (gC/m2/s)
   real(r8), pointer :: hrv_livecrootc_xfer_to_litter(:)     ! live coarse root C transfer harvest mortality (gC/m2/s)
   real(r8), pointer :: hrv_deadcrootc_to_litter(:)          ! dead coarse root C harvest mortality (gC/m2/s)
   real(r8), pointer :: hrv_deadcrootc_storage_to_litter(:)  ! dead coarse root C storage harvest mortality (gC/m2/s)
   real(r8), pointer :: hrv_deadcrootc_xfer_to_litter(:)     ! dead coarse root C transfer harvest mortality (gC/m2/s)
   real(r8), pointer :: hrv_gresp_storage_to_litter(:)       ! growth respiration storage harvest mortality (gC/m2/s)
   real(r8), pointer :: hrv_gresp_xfer_to_litter(:)          ! growth respiration transfer harvest mortality (gC/m2/s)
   real(r8), pointer :: hrv_xsmrpool_to_atm(:)               ! excess MR pool harvest mortality (gC/m2/s)
   ! PFT-level fire fluxes
   real(r8), pointer :: m_leafc_to_fire(:)                   ! leaf C fire loss (gC/m2/s)
   real(r8), pointer :: m_leafc_storage_to_fire(:)           ! leaf C storage fire loss (gC/m2/s)
   real(r8), pointer :: m_leafc_xfer_to_fire(:)              ! leaf C transfer fire loss (gC/m2/s)
   real(r8), pointer :: m_frootc_to_fire(:)                  ! fine root C fire loss (gC/m2/s)
   real(r8), pointer :: m_frootc_storage_to_fire(:)          ! fine root C storage fire loss (gC/m2/s)
   real(r8), pointer :: m_frootc_xfer_to_fire(:)             ! fine root C transfer fire loss (gC/m2/s)
   real(r8), pointer :: m_livestemc_to_fire(:)               ! live stem C fire loss (gC/m2/s)
   real(r8), pointer :: m_livestemc_storage_to_fire(:)       ! live stem C storage fire loss (gC/m2/s)
   real(r8), pointer :: m_livestemc_xfer_to_fire(:)          ! live stem C transfer fire loss (gC/m2/s)
   real(r8), pointer :: m_deadstemc_to_fire(:)               ! dead stem C fire loss (gC/m2/s)
   real(r8), pointer :: m_deadstemc_to_litter_fire(:)        ! dead stem C fire mortality to litter (gC/m2/s)
   real(r8), pointer :: m_deadstemc_storage_to_fire(:)       ! dead stem C storage fire loss (gC/m2/s)
   real(r8), pointer :: m_deadstemc_xfer_to_fire(:)          ! dead stem C transfer fire loss (gC/m2/s)
   real(r8), pointer :: m_livecrootc_to_fire(:)              ! live coarse root C fire loss (gC/m2/s)
   real(r8), pointer :: m_livecrootc_storage_to_fire(:)      ! live coarse root C storage fire loss (gC/m2/s)
   real(r8), pointer :: m_livecrootc_xfer_to_fire(:)         ! live coarse root C transfer fire loss (gC/m2/s)
   real(r8), pointer :: m_deadcrootc_to_fire(:)              ! dead coarse root C fire loss (gC/m2/s)
   real(r8), pointer :: m_deadcrootc_to_litter_fire(:)       ! dead coarse root C fire mortality to litter (gC/m2/s)
   real(r8), pointer :: m_deadcrootc_storage_to_fire(:)      ! dead coarse root C storage fire loss (gC/m2/s)
   real(r8), pointer :: m_deadcrootc_xfer_to_fire(:)         ! dead coarse root C transfer fire loss (gC/m2/s)
   real(r8), pointer :: m_gresp_storage_to_fire(:)           ! growth respiration storage fire loss (gC/m2/s)
   real(r8), pointer :: m_gresp_xfer_to_fire(:)              ! growth respiration transfer fire loss (gC/m2/s)
   ! phenology fluxes from transfer pools                     
#if (defined CROP)
   real(r8), pointer :: grainc_xfer_to_grainc(:)             ! grain C growth from storage (gC/m2/s)
#endif
   real(r8), pointer :: leafc_xfer_to_leafc(:)               ! leaf C growth from storage (gC/m2/s)
   real(r8), pointer :: frootc_xfer_to_frootc(:)             ! fine root C growth from storage (gC/m2/s)
   real(r8), pointer :: livestemc_xfer_to_livestemc(:)       ! live stem C growth from storage (gC/m2/s)
   real(r8), pointer :: deadstemc_xfer_to_deadstemc(:)       ! dead stem C growth from storage (gC/m2/s)
   real(r8), pointer :: livecrootc_xfer_to_livecrootc(:)     ! live coarse root C growth from storage (gC/m2/s)
   real(r8), pointer :: deadcrootc_xfer_to_deadcrootc(:)     ! dead coarse root C growth from storage (gC/m2/s)
   ! leaf and fine root litterfall                           
   real(r8), pointer :: leafc_to_litter(:)                   ! leaf C litterfall (gC/m2/s)
   real(r8), pointer :: frootc_to_litter(:)                  ! fine root C litterfall (gC/m2/s)
#if (defined CROP)
   real(r8), pointer :: livestemc_to_litter(:)               ! live stem C litterfall (gC/m2/s)
   real(r8), pointer :: grainc_to_food(:)                    ! grain C to food (gC/m2/s)
#endif
   ! maintenance respiration fluxes                          
   real(r8), pointer :: leaf_mr(:)                           ! leaf maintenance respiration (gC/m2/s)
   real(r8), pointer :: froot_mr(:)                          ! fine root maintenance respiration (gC/m2/s)
   real(r8), pointer :: livestem_mr(:)                       ! live stem maintenance respiration (gC/m2/s)
   real(r8), pointer :: livecroot_mr(:)                      ! live coarse root maintenance respiration (gC/m2/s)
   real(r8), pointer :: leaf_curmr(:)                        ! leaf maintenance respiration from current GPP (gC/m2/s)
   real(r8), pointer :: froot_curmr(:)                       ! fine root maintenance respiration from current GPP (gC/m2/s)
   real(r8), pointer :: livestem_curmr(:)                    ! live stem maintenance respiration from current GPP (gC/m2/s)
   real(r8), pointer :: livecroot_curmr(:)                   ! live coarse root maintenance respiration from current GPP (gC/m2/s)
   real(r8), pointer :: leaf_xsmr(:)                         ! leaf maintenance respiration from storage (gC/m2/s)
   real(r8), pointer :: froot_xsmr(:)                        ! fine root maintenance respiration from storage (gC/m2/s)
   real(r8), pointer :: livestem_xsmr(:)                     ! live stem maintenance respiration from storage (gC/m2/s)
   real(r8), pointer :: livecroot_xsmr(:)                    ! live coarse root maintenance respiration from storage (gC/m2/s)
   ! photosynthesis fluxes                                   
   real(r8), pointer :: psnsun_to_cpool(:)                   ! C fixation from sunlit canopy (gC/m2/s)
   real(r8), pointer :: psnshade_to_cpool(:)                 ! C fixation from shaded canopy (gC/m2/s)
   ! allocation fluxes, from current GPP                     
   real(r8), pointer :: cpool_to_xsmrpool(:)                 ! allocation to maintenance respiration storage pool (gC/m2/s)
#if (defined CROP)
   real(r8), pointer :: cpool_to_grainc(:)                   ! allocation to grain C (gC/m2/s)
   real(r8), pointer :: cpool_to_grainc_storage(:)           ! allocation to grain C storage (gC/m2/s)
#endif
   real(r8), pointer :: cpool_to_leafc(:)                    ! allocation to leaf C (gC/m2/s)
   real(r8), pointer :: cpool_to_leafc_storage(:)            ! allocation to leaf C storage (gC/m2/s)
   real(r8), pointer :: cpool_to_frootc(:)                   ! allocation to fine root C (gC/m2/s)
   real(r8), pointer :: cpool_to_frootc_storage(:)           ! allocation to fine root C storage (gC/m2/s)
   real(r8), pointer :: cpool_to_livestemc(:)                ! allocation to live stem C (gC/m2/s)
   real(r8), pointer :: cpool_to_livestemc_storage(:)        ! allocation to live stem C storage (gC/m2/s)
   real(r8), pointer :: cpool_to_deadstemc(:)                ! allocation to dead stem C (gC/m2/s)
   real(r8), pointer :: cpool_to_deadstemc_storage(:)        ! allocation to dead stem C storage (gC/m2/s)
   real(r8), pointer :: cpool_to_livecrootc(:)               ! allocation to live coarse root C (gC/m2/s)
   real(r8), pointer :: cpool_to_livecrootc_storage(:)       ! allocation to live coarse root C storage (gC/m2/s)
   real(r8), pointer :: cpool_to_deadcrootc(:)               ! allocation to dead coarse root C (gC/m2/s)
   real(r8), pointer :: cpool_to_deadcrootc_storage(:)       ! allocation to dead coarse root C storage (gC/m2/s)
   real(r8), pointer :: cpool_to_gresp_storage(:)            ! allocation to growth respiration storage (gC/m2/s)
   ! growth respiration fluxes                               
#if (defined CROP)
   real(r8), pointer :: xsmrpool_to_atm(:)
   real(r8), pointer :: cpool_grain_gr(:)                    ! grain growth respiration (gC/m2/s)
   real(r8), pointer :: cpool_grain_storage_gr(:)            ! grain growth respiration to storage (gC/m2/s)
   real(r8), pointer :: transfer_grain_gr(:)                 ! grain growth respiration from storage (gC/m2/s)
#endif
   real(r8), pointer :: cpool_leaf_gr(:)                     ! leaf growth respiration (gC/m2/s)
   real(r8), pointer :: cpool_leaf_storage_gr(:)             ! leaf growth respiration to storage (gC/m2/s)
   real(r8), pointer :: transfer_leaf_gr(:)                  ! leaf growth respiration from storage (gC/m2/s)
   real(r8), pointer :: cpool_froot_gr(:)                    ! fine root growth respiration (gC/m2/s)
   real(r8), pointer :: cpool_froot_storage_gr(:)            ! fine root  growth respiration to storage (gC/m2/s)
   real(r8), pointer :: transfer_froot_gr(:)                 ! fine root  growth respiration from storage (gC/m2/s)
   real(r8), pointer :: cpool_livestem_gr(:)                 ! live stem growth respiration (gC/m2/s)
   real(r8), pointer :: cpool_livestem_storage_gr(:)         ! live stem growth respiration to storage (gC/m2/s)
   real(r8), pointer :: transfer_livestem_gr(:)              ! live stem growth respiration from storage (gC/m2/s)
   real(r8), pointer :: cpool_deadstem_gr(:)                 ! dead stem growth respiration (gC/m2/s)
   real(r8), pointer :: cpool_deadstem_storage_gr(:)         ! dead stem growth respiration to storage (gC/m2/s)
   real(r8), pointer :: transfer_deadstem_gr(:)              ! dead stem growth respiration from storage (gC/m2/s)
   real(r8), pointer :: cpool_livecroot_gr(:)                ! live coarse root growth respiration (gC/m2/s)
   real(r8), pointer :: cpool_livecroot_storage_gr(:)        ! live coarse root growth respiration to storage (gC/m2/s)
   real(r8), pointer :: transfer_livecroot_gr(:)             ! live coarse root growth respiration from storage (gC/m2/s)
   real(r8), pointer :: cpool_deadcroot_gr(:)                ! dead coarse root growth respiration (gC/m2/s)
   real(r8), pointer :: cpool_deadcroot_storage_gr(:)        ! dead coarse root growth respiration to storage (gC/m2/s)
   real(r8), pointer :: transfer_deadcroot_gr(:)             ! dead coarse root growth respiration from storage (gC/m2/s)
   ! annual turnover of storage to transfer pools            
#if (defined CROP)
   real(r8), pointer :: grainc_storage_to_xfer(:)            ! grain C shift storage to transfer (gC/m2/s)
#endif
   real(r8), pointer :: leafc_storage_to_xfer(:)             ! leaf C shift storage to transfer (gC/m2/s)
   real(r8), pointer :: frootc_storage_to_xfer(:)            ! fine root C shift storage to transfer (gC/m2/s)
   real(r8), pointer :: livestemc_storage_to_xfer(:)         ! live stem C shift storage to transfer (gC/m2/s)
   real(r8), pointer :: deadstemc_storage_to_xfer(:)         ! dead stem C shift storage to transfer (gC/m2/s)
   real(r8), pointer :: livecrootc_storage_to_xfer(:)        ! live coarse root C shift storage to transfer (gC/m2/s)
   real(r8), pointer :: deadcrootc_storage_to_xfer(:)        ! dead coarse root C shift storage to transfer (gC/m2/s)
   real(r8), pointer :: gresp_storage_to_xfer(:)             ! growth respiration shift storage to transfer (gC/m2/s)
   ! turnover of livewood to deadwood
   real(r8), pointer :: livestemc_to_deadstemc(:)            ! live stem C turnover (gC/m2/s)
   real(r8), pointer :: livecrootc_to_deadcrootc(:)          ! live coarse root C turnover (gC/m2/s)
   ! summary (diagnostic) flux variables, not involved in mass balance
   real(r8), pointer :: gpp(:)            ! (gC/m2/s) gross primary production 
   real(r8), pointer :: mr(:)             ! (gC/m2/s) maintenance respiration
   real(r8), pointer :: current_gr(:)     ! (gC/m2/s) growth resp for new growth displayed in this timestep
   real(r8), pointer :: transfer_gr(:)    ! (gC/m2/s) growth resp for transfer growth displayed in this timestep
   real(r8), pointer :: storage_gr(:)     ! (gC/m2/s) growth resp for growth sent to storage for later display
   real(r8), pointer :: gr(:)             ! (gC/m2/s) total growth respiration
   real(r8), pointer :: ar(:)             ! (gC/m2/s) autotrophic respiration (MR + GR)
   real(r8), pointer :: rr(:)             ! (gC/m2/s) root respiration (fine root MR + total root GR)
   real(r8), pointer :: npp(:)            ! (gC/m2/s) net primary production
   real(r8), pointer :: agnpp(:)          ! (gC/m2/s) aboveground NPP
   real(r8), pointer :: bgnpp(:)          ! (gC/m2/s) belowground NPP
   real(r8), pointer :: litfall(:)        ! (gC/m2/s) litterfall (leaves and fine roots)
   real(r8), pointer :: vegfire(:)        ! (gC/m2/s) pft-level fire loss (obsolete, mark for removal)
   real(r8), pointer :: wood_harvestc(:)  ! (gC/m2/s) pft-level wood harvest (to product pools)
   real(r8), pointer :: pft_cinputs(:)    ! (gC/m2/s) pft-level carbon inputs (for balance checking)
   real(r8), pointer :: pft_coutputs(:)   ! (gC/m2/s) pft-level carbon outputs (for balance checking)
#if (defined CLAMP) && (defined CN)
   ! CLAMP summary (diagnostic) variables, not involved in mass balance
   real(r8), pointer :: frootc_alloc(:)   ! (gC/m2/s) pft-level fine root C alloc
   real(r8), pointer :: frootc_loss(:)    ! (gC/m2/s) pft-level fine root C loss
   real(r8), pointer :: leafc_alloc(:)    ! (gC/m2/s) pft-level leaf C alloc
   real(r8), pointer :: leafc_loss(:)     ! (gC/m2/s) pft-level leaf C loss
   real(r8), pointer :: woodc_alloc(:)    ! (gC/m2/s) pft-level wood C alloc
   real(r8), pointer :: woodc_loss(:)     ! (gC/m2/s) pft-level wood C loss
#endif
   ! new variables for fire code
   real(r8), pointer :: pft_fire_closs(:) ! (gC/m2/s) total pft-level fire C loss 
end type pft_cflux_type

!----------------------------------------------------
! pft nitrogen flux variables structure
!----------------------------------------------------
type, public :: pft_nflux_type
   ! new variables for CN code
   ! gap mortality fluxes
   real(r8), pointer :: m_leafn_to_litter(:)                ! leaf N mortality (gN/m2/s)
   real(r8), pointer :: m_frootn_to_litter(:)               ! fine root N mortality (gN/m2/s)
   real(r8), pointer :: m_leafn_storage_to_litter(:)        ! leaf N storage mortality (gN/m2/s)
   real(r8), pointer :: m_frootn_storage_to_litter(:)       ! fine root N storage mortality (gN/m2/s)
   real(r8), pointer :: m_livestemn_storage_to_litter(:)    ! live stem N storage mortality (gN/m2/s)
   real(r8), pointer :: m_deadstemn_storage_to_litter(:)    ! dead stem N storage mortality (gN/m2/s)
   real(r8), pointer :: m_livecrootn_storage_to_litter(:)   ! live coarse root N storage mortality (gN/m2/s)
   real(r8), pointer :: m_deadcrootn_storage_to_litter(:)   ! dead coarse root N storage mortality (gN/m2/s)
   real(r8), pointer :: m_leafn_xfer_to_litter(:)           ! leaf N transfer mortality (gN/m2/s)
   real(r8), pointer :: m_frootn_xfer_to_litter(:)          ! fine root N transfer mortality (gN/m2/s)
   real(r8), pointer :: m_livestemn_xfer_to_litter(:)       ! live stem N transfer mortality (gN/m2/s)
   real(r8), pointer :: m_deadstemn_xfer_to_litter(:)       ! dead stem N transfer mortality (gN/m2/s)
   real(r8), pointer :: m_livecrootn_xfer_to_litter(:)      ! live coarse root N transfer mortality (gN/m2/s)
   real(r8), pointer :: m_deadcrootn_xfer_to_litter(:)      ! dead coarse root N transfer mortality (gN/m2/s)
   real(r8), pointer :: m_livestemn_to_litter(:)            ! live stem N mortality (gN/m2/s)
   real(r8), pointer :: m_deadstemn_to_litter(:)            ! dead stem N mortality (gN/m2/s)
   real(r8), pointer :: m_livecrootn_to_litter(:)           ! live coarse root N mortality (gN/m2/s)
   real(r8), pointer :: m_deadcrootn_to_litter(:)           ! dead coarse root N mortality (gN/m2/s)
   real(r8), pointer :: m_retransn_to_litter(:)             ! retranslocated N pool mortality (gN/m2/s)
   ! harvest mortality fluxes
   real(r8), pointer :: hrv_leafn_to_litter(:)                ! leaf N harvest mortality (gN/m2/s)
   real(r8), pointer :: hrv_frootn_to_litter(:)               ! fine root N harvest mortality (gN/m2/s)
   real(r8), pointer :: hrv_leafn_storage_to_litter(:)        ! leaf N storage harvest mortality (gN/m2/s)
   real(r8), pointer :: hrv_frootn_storage_to_litter(:)       ! fine root N storage harvest mortality (gN/m2/s)
   real(r8), pointer :: hrv_livestemn_storage_to_litter(:)    ! live stem N storage harvest mortality (gN/m2/s)
   real(r8), pointer :: hrv_deadstemn_storage_to_litter(:)    ! dead stem N storage harvest mortality (gN/m2/s)
   real(r8), pointer :: hrv_livecrootn_storage_to_litter(:)   ! live coarse root N storage harvest mortality (gN/m2/s)
   real(r8), pointer :: hrv_deadcrootn_storage_to_litter(:)   ! dead coarse root N storage harvest mortality (gN/m2/s)
   real(r8), pointer :: hrv_leafn_xfer_to_litter(:)           ! leaf N transfer harvest mortality (gN/m2/s)
   real(r8), pointer :: hrv_frootn_xfer_to_litter(:)          ! fine root N transfer harvest mortality (gN/m2/s)
   real(r8), pointer :: hrv_livestemn_xfer_to_litter(:)       ! live stem N transfer harvest mortality (gN/m2/s)
   real(r8), pointer :: hrv_deadstemn_xfer_to_litter(:)       ! dead stem N transfer harvest mortality (gN/m2/s)
   real(r8), pointer :: hrv_livecrootn_xfer_to_litter(:)      ! live coarse root N transfer harvest mortality (gN/m2/s)
   real(r8), pointer :: hrv_deadcrootn_xfer_to_litter(:)      ! dead coarse root N transfer harvest mortality (gN/m2/s)
   real(r8), pointer :: hrv_livestemn_to_litter(:)            ! live stem N harvest mortality (gN/m2/s)
   real(r8), pointer :: hrv_deadstemn_to_prod10n(:)           ! dead stem N harvest to 10-year product pool (gN/m2/s)
   real(r8), pointer :: hrv_deadstemn_to_prod100n(:)          ! dead stem N harvest to 100-year product pool (gN/m2/s)
   real(r8), pointer :: hrv_livecrootn_to_litter(:)           ! live coarse root N harvest mortality (gN/m2/s)
   real(r8), pointer :: hrv_deadcrootn_to_litter(:)           ! dead coarse root N harvest mortality (gN/m2/s)
   real(r8), pointer :: hrv_retransn_to_litter(:)             ! retranslocated N pool harvest mortality (gN/m2/s)
   ! fire mortality fluxes
   real(r8), pointer :: m_leafn_to_fire(:)                  ! leaf N fire loss (gN/m2/s)
   real(r8), pointer :: m_leafn_storage_to_fire(:)          ! leaf N storage fire loss (gN/m2/s)
   real(r8), pointer :: m_leafn_xfer_to_fire(:)             ! leaf N transfer fire loss (gN/m2/s)
   real(r8), pointer :: m_frootn_to_fire(:)                 ! fine root N fire loss (gN/m2/s)
   real(r8), pointer :: m_frootn_storage_to_fire(:)         ! fine root N storage fire loss (gN/m2/s)
   real(r8), pointer :: m_frootn_xfer_to_fire(:)            ! fine root N transfer fire loss (gN/m2/s)
   real(r8), pointer :: m_livestemn_to_fire(:)              ! live stem N fire loss (gN/m2/s)
   real(r8), pointer :: m_livestemn_storage_to_fire(:)      ! live stem N storage fire loss (gN/m2/s)
   real(r8), pointer :: m_livestemn_xfer_to_fire(:)         ! live stem N transfer fire loss (gN/m2/s)
   real(r8), pointer :: m_deadstemn_to_fire(:)              ! dead stem N fire loss (gN/m2/s)
   real(r8), pointer :: m_deadstemn_to_litter_fire(:)       ! dead stem N fire mortality to litter (gN/m2/s)
   real(r8), pointer :: m_deadstemn_storage_to_fire(:)      ! dead stem N storage fire loss (gN/m2/s)
   real(r8), pointer :: m_deadstemn_xfer_to_fire(:)         ! dead stem N transfer fire loss (gN/m2/s)
   real(r8), pointer :: m_livecrootn_to_fire(:)             ! live coarse root N fire loss (gN/m2/s)
   real(r8), pointer :: m_livecrootn_storage_to_fire(:)     ! live coarse root N storage fire loss (gN/m2/s)
   real(r8), pointer :: m_livecrootn_xfer_to_fire(:)        ! live coarse root N transfer fire loss (gN/m2/s)
   real(r8), pointer :: m_deadcrootn_to_fire(:)             ! dead coarse root N fire loss (gN/m2/s)
   real(r8), pointer :: m_deadcrootn_to_litter_fire(:)      ! dead coarse root N fire mortality to litter (gN/m2/s)
   real(r8), pointer :: m_deadcrootn_storage_to_fire(:)     ! dead coarse root N storage fire loss (gN/m2/s)
   real(r8), pointer :: m_deadcrootn_xfer_to_fire(:)        ! dead coarse root N transfer fire loss (gN/m2/s)
   real(r8), pointer :: m_retransn_to_fire(:)               ! retranslocated N pool fire loss (gN/m2/s)
   ! phenology fluxes from transfer pool                     
#if (defined CROP)
   real(r8), pointer :: grainn_xfer_to_grainn(:)            ! grain N growth from storage (gN/m2/s)
#endif
   real(r8), pointer :: leafn_xfer_to_leafn(:)              ! leaf N growth from storage (gN/m2/s)
   real(r8), pointer :: frootn_xfer_to_frootn(:)            ! fine root N growth from storage (gN/m2/s)
   real(r8), pointer :: livestemn_xfer_to_livestemn(:)      ! live stem N growth from storage (gN/m2/s)
   real(r8), pointer :: deadstemn_xfer_to_deadstemn(:)      ! dead stem N growth from storage (gN/m2/s)
   real(r8), pointer :: livecrootn_xfer_to_livecrootn(:)    ! live coarse root N growth from storage (gN/m2/s)
   real(r8), pointer :: deadcrootn_xfer_to_deadcrootn(:)    ! dead coarse root N growth from storage (gN/m2/s)
   ! litterfall fluxes
#if (defined CROP)
   real(r8), pointer :: livestemn_to_litter(:)              ! livestem N to litter (gN/m2/s)
   real(r8), pointer :: grainn_to_food(:)                   ! grain N to food (gN/m2/s)
#endif
   real(r8), pointer :: leafn_to_litter(:)                  ! leaf N litterfall (gN/m2/s)
   real(r8), pointer :: leafn_to_retransn(:)                ! leaf N to retranslocated N pool (gN/m2/s)
   real(r8), pointer :: frootn_to_litter(:)                 ! fine root N litterfall (gN/m2/s)
   ! allocation fluxes
   real(r8), pointer :: retransn_to_npool(:)                ! deployment of retranslocated N (gN/m2/s)       
   real(r8), pointer :: sminn_to_npool(:)                   ! deployment of soil mineral N uptake (gN/m2/s)
#if (defined CROP)
   real(r8), pointer :: npool_to_grainn(:)                  ! allocation to grain N (gN/m2/s)
   real(r8), pointer :: npool_to_grainn_storage(:)          ! allocation to grain N storage (gN/m2/s)
#endif
   real(r8), pointer :: npool_to_leafn(:)                   ! allocation to leaf N (gN/m2/s)
   real(r8), pointer :: npool_to_leafn_storage(:)           ! allocation to leaf N storage (gN/m2/s)
   real(r8), pointer :: npool_to_frootn(:)                  ! allocation to fine root N (gN/m2/s)
   real(r8), pointer :: npool_to_frootn_storage(:)          ! allocation to fine root N storage (gN/m2/s)
   real(r8), pointer :: npool_to_livestemn(:)               ! allocation to live stem N (gN/m2/s)
   real(r8), pointer :: npool_to_livestemn_storage(:)       ! allocation to live stem N storage (gN/m2/s)
   real(r8), pointer :: npool_to_deadstemn(:)               ! allocation to dead stem N (gN/m2/s)
   real(r8), pointer :: npool_to_deadstemn_storage(:)       ! allocation to dead stem N storage (gN/m2/s)
   real(r8), pointer :: npool_to_livecrootn(:)              ! allocation to live coarse root N (gN/m2/s)
   real(r8), pointer :: npool_to_livecrootn_storage(:)      ! allocation to live coarse root N storage (gN/m2/s)
   real(r8), pointer :: npool_to_deadcrootn(:)              ! allocation to dead coarse root N (gN/m2/s)
   real(r8), pointer :: npool_to_deadcrootn_storage(:)      ! allocation to dead coarse root N storage (gN/m2/s)
   ! annual turnover of storage to transfer pools           
#if (defined CROP)
   real(r8), pointer :: grainn_storage_to_xfer(:)           ! grain N shift storage to transfer (gN/m2/s)
#endif
   real(r8), pointer :: leafn_storage_to_xfer(:)            ! leaf N shift storage to transfer (gN/m2/s)
   real(r8), pointer :: frootn_storage_to_xfer(:)           ! fine root N shift storage to transfer (gN/m2/s)
   real(r8), pointer :: livestemn_storage_to_xfer(:)        ! live stem N shift storage to transfer (gN/m2/s)
   real(r8), pointer :: deadstemn_storage_to_xfer(:)        ! dead stem N shift storage to transfer (gN/m2/s)
   real(r8), pointer :: livecrootn_storage_to_xfer(:)       ! live coarse root N shift storage to transfer (gN/m2/s)
   real(r8), pointer :: deadcrootn_storage_to_xfer(:)       ! dead coarse root N shift storage to transfer (gN/m2/s)
   ! turnover of livewood to deadwood, with retranslocation 
   real(r8), pointer :: livestemn_to_deadstemn(:)           ! live stem N turnover (gN/m2/s)
   real(r8), pointer :: livestemn_to_retransn(:)            ! live stem N to retranslocated N pool (gN/m2/s)
   real(r8), pointer :: livecrootn_to_deadcrootn(:)         ! live coarse root N turnover (gN/m2/s)
   real(r8), pointer :: livecrootn_to_retransn(:)           ! live coarse root N to retranslocated N pool (gN/m2/s)
   ! summary (diagnostic) flux variables, not involved in mass balance
   real(r8), pointer :: ndeploy(:)                          ! total N deployed to growth and storage (gN/m2/s)
   real(r8), pointer :: pft_ninputs(:)                      ! total N inputs to pft-level (gN/m2/s)
   real(r8), pointer :: pft_noutputs(:)                     ! total N outputs from pft-level (gN/m2/s)
   real(r8), pointer :: wood_harvestn(:)                    ! total N losses to wood product pools (gN/m2/s)
   ! new variables for fire code 
   real(r8), pointer :: pft_fire_nloss(:)                   ! total pft-level fire N loss (gN/m2/s) 
end type pft_nflux_type

!----------------------------------------------------
! pft VOC flux variables structure
!----------------------------------------------------
type, public :: pft_vflux_type
   real(r8), pointer :: vocflx_tot(:)     !total VOC flux into atmosphere [ug C m-2 h-1]
   real(r8), pointer :: vocflx(:,:)       !(nvoc) VOC flux [ug C m-2 h-1]
   real(r8), pointer :: vocflx_1(:)       !vocflx(1) (for history output) [ug C m-2 h-1]
   real(r8), pointer :: vocflx_2(:)       !vocflx(2) (for history output) [ug C m-2 h-1]
   real(r8), pointer :: vocflx_3(:)       !vocflx(3) (for history output) [ug C m-2 h-1]
   real(r8), pointer :: vocflx_4(:)       !vocflx(4) (for history output) [ug C m-2 h-1]
   real(r8), pointer :: vocflx_5(:)       !vocflx(5) (for history output) [ug C m-2 h-1]
   real(r8), pointer :: Eopt_out(:)       !Eopt coefficient
   real(r8), pointer :: topt_out(:)       !topt coefficient
   real(r8), pointer :: alpha_out(:)      !alpha coefficient
   real(r8), pointer :: cp_out(:)         !cp coefficient
   real(r8), pointer :: paru_out(:)
   real(r8), pointer :: par24u_out(:)
   real(r8), pointer :: par240u_out(:)
   real(r8), pointer :: para_out(:)
   real(r8), pointer :: par24a_out(:)
   real(r8), pointer :: par240a_out(:)
   real(r8), pointer :: gamma_out(:)
   real(r8), pointer :: gammaL_out(:)
   real(r8), pointer :: gammaT_out(:)
   real(r8), pointer :: gammaP_out(:)
   real(r8), pointer :: gammaA_out(:)
   real(r8), pointer :: gammaS_out(:)
end type pft_vflux_type

!----------------------------------------------------
! pft dry dep velocity variables structure
!----------------------------------------------------
type, public :: pft_depvd_type
   real(r8), pointer :: drydepvel(:,:)
end type pft_depvd_type

!----------------------------------------------------
! pft dust flux variables structure
!----------------------------------------------------
type, public :: pft_dflux_type
   real(r8), pointer :: flx_mss_vrt_dst(:,:)    !(ndst)  !surface dust emission (kg/m**2/s) [ + = to atm]
   real(r8), pointer :: flx_mss_vrt_dst_tot(:)  !total dust flux into atmosphere
   real(r8), pointer :: vlc_trb(:,:)            !(ndst) turbulent deposition velocity (m/s)
   real(r8), pointer :: vlc_trb_1(:)            !turbulent deposition velocity 1(m/s)
   real(r8), pointer :: vlc_trb_2(:)            !turbulent deposition velocity 2(m/s)
   real(r8), pointer :: vlc_trb_3(:)            !turbulent deposition velocity 3(m/s)
   real(r8), pointer :: vlc_trb_4(:)            !turbulent deposition velocity 4(m/s)
end type pft_dflux_type

!----------------------------------------------------
! End definition of structures defined at the pft_type level
!----------------------------------------------------
!*******************************************************************************


!*******************************************************************************
!----------------------------------------------------
! Begin definition of structures defined at the column_type level
!----------------------------------------------------
! column physical state variables structure
!----------------------------------------------------
type, public :: column_pstate_type
   type(pft_pstate_type) :: pps_a            !pft-level pstate variables averaged to the column
   integer , pointer :: snl(:)                !number of snow layers
   integer , pointer :: isoicol(:)            !soil color class
   real(r8), pointer :: bsw(:,:)              !Clapp and Hornberger "b" (nlevgrnd)  
   real(r8), pointer :: watsat(:,:)           !volumetric soil water at saturation (porosity) (nlevgrnd) 
   real(r8), pointer :: watdry(:,:)           !btran parameter for btran=0
   real(r8), pointer :: watopt(:,:)           !btran parameter for btran = 1
   real(r8), pointer :: hksat(:,:)            !hydraulic conductivity at saturation (mm H2O /s) (nlevgrnd) 
   real(r8), pointer :: sucsat(:,:)           !minimum soil suction (mm) (nlevgrnd) 
   real(r8), pointer :: hkdepth(:)            !decay factor (m)
   real(r8), pointer :: wtfact(:)             !maximum saturated fraction for a gridcell
   real(r8), pointer :: fracice(:,:)          !fractional impermeability (-)
   real(r8), pointer :: csol(:,:)             !heat capacity, soil solids (J/m**3/Kelvin) (nlevgrnd) 
   real(r8), pointer :: tkmg(:,:)             !thermal conductivity, soil minerals  [W/m-K] (new) (nlevgrnd) 
   real(r8), pointer :: tkdry(:,:)            !thermal conductivity, dry soil (W/m/Kelvin) (nlevgrnd) 
   real(r8), pointer :: tksatu(:,:)           !thermal conductivity, saturated soil [W/m-K] (new) (nlevgrnd) 
   real(r8), pointer :: smpmin(:)             !restriction for min of soil potential (mm) (new)
   real(r8), pointer :: gwc_thr(:)            !threshold soil moisture based on clay content
   real(r8), pointer :: mss_frc_cly_vld(:)    ![frc] Mass fraction clay limited to 0.20
   real(r8), pointer :: mbl_bsn_fct(:)        !basin factor
   logical , pointer :: do_capsnow(:)         !true => do snow capping
   real(r8), pointer :: snowdp(:)             !snow height (m)
   real(r8), pointer :: frac_sno(:)           !fraction of ground covered by snow (0 to 1)
   real(r8), pointer :: zi(:,:)               !interface level below a "z" level (m) (-nlevsno+0:nlevgrnd) 
   real(r8), pointer :: dz(:,:)               !layer thickness (m)  (-nlevsno+1:nlevgrnd) 
   real(r8), pointer :: z(:,:)                !layer depth (m) (-nlevsno+1:nlevgrnd) 
   real(r8), pointer :: frac_iceold(:,:)      !fraction of ice relative to the tot water (new) (-nlevsno+1:nlevgrnd) 
   integer , pointer :: imelt(:,:)            !flag for melting (=1), freezing (=2), Not=0 (new) (-nlevsno+1:nlevgrnd) 
   real(r8), pointer :: eff_porosity(:,:)     !effective porosity = porosity - vol_ice (nlevgrnd) 
   real(r8), pointer :: emg(:)                !ground emissivity
   real(r8), pointer :: z0mg(:)               !roughness length over ground, momentum [m]
   real(r8), pointer :: z0hg(:)               !roughness length over ground, sensible heat [m]
   real(r8), pointer :: z0qg(:)               !roughness length over ground, latent heat [m]
   real(r8), pointer :: htvp(:)               !latent heat of vapor of water (or sublimation) [j/kg]
   real(r8), pointer :: beta(:)               !coefficient of convective velocity [-]
   real(r8), pointer :: zii(:)                !convective boundary height [m]
   real(r8), pointer :: albgrd(:,:)           !ground albedo (direct) (numrad)
   real(r8), pointer :: albgri(:,:)           !ground albedo (diffuse) (numrad)
   real(r8), pointer :: rootr_column(:,:)     !effective fraction of roots in each soil layer (nlevgrnd)  
   real(r8), pointer :: rootfr_road_perv(:,:) !fraction of roots in each soil layer for urban pervious road
   real(r8), pointer :: rootr_road_perv(:,:)  !effective fraction of roots in each soil layer of urban pervious road
   real(r8), pointer :: wf(:)                 !soil water as frac. of whc for top 0.5 m
!  real(r8), pointer :: xirrig(:)             !irrigation rate
   real(r8), pointer :: max_dayl(:)           !maximum daylength for this column (s)
   ! new variables for CN code
   real(r8), pointer :: bsw2(:,:)        !Clapp and Hornberger "b" for CN code
   real(r8), pointer :: psisat(:,:)        !soil water potential at saturation for CN code (MPa)
   real(r8), pointer :: vwcsat(:,:)        !volumetric water content at saturation for CN code (m3/m3)
   real(r8), pointer :: decl(:)              ! solar declination angle (radians)
   real(r8), pointer :: coszen(:)            !cosine of solar zenith angle
   real(r8), pointer :: soilpsi(:,:)         !soil water potential in each soil layer (MPa)
   real(r8), pointer :: fpi(:)           !fraction of potential immobilization (no units)
   real(r8), pointer :: fpg(:)           !fraction of potential gpp (no units)
   real(r8), pointer :: annsum_counter(:) !seconds since last annual accumulator turnover
   real(r8), pointer :: cannsum_npp(:)    !annual sum of NPP, averaged from pft-level (gC/m2/yr)
   real(r8), pointer :: cannavg_t2m(:)    !annual average of 2m air temperature, averaged from pft-level (K)
   real(r8), pointer :: watfc(:,:)        !volumetric soil water at field capacity (nlevsoi)
   ! new variables for fire code
   real(r8), pointer :: me(:)                 !moisture of extinction (proportion) 
   real(r8), pointer :: fire_prob(:)          !daily fire probability (0-1) 
   real(r8), pointer :: mean_fire_prob(:)     !e-folding mean of daily fire probability (0-1) 
   real(r8), pointer :: fireseasonl(:)        !annual fire season length (days, <= 365) 
   real(r8), pointer :: farea_burned(:)       !timestep fractional area burned (proportion) 
   real(r8), pointer :: ann_farea_burned(:)   !annual total fractional area burned (proportion)
   real(r8), pointer :: albsnd_hst(:,:)       ! snow albedo, direct, for history files (col,bnd) [frc]
   real(r8), pointer :: albsni_hst(:,:)       ! snow albedo, diffuse, for history files (col,bnd) [frc]
   real(r8), pointer :: albsod(:,:)           ! soil albedo: direct (col,bnd) [frc]
   real(r8), pointer :: albsoi(:,:)           ! soil albedo: diffuse (col,bnd) [frc]
   real(r8), pointer :: flx_absdv(:,:)        ! absorbed flux per unit incident direct flux: VIS (col,lyr) [frc]
   real(r8), pointer :: flx_absdn(:,:)        ! absorbed flux per unit incident direct flux: NIR (col,lyr) [frc]
   real(r8), pointer :: flx_absiv(:,:)        ! absorbed flux per unit incident diffuse flux: VIS (col,lyr) [frc]
   real(r8), pointer :: flx_absin(:,:)        ! absorbed flux per unit incident diffuse flux: NIR (col,lyr) [frc]
   real(r8), pointer :: snw_rds(:,:)          ! snow grain radius (col,lyr) [m^-6, microns]
   real(r8), pointer :: snw_rds_top(:)        ! snow grain radius, top layer (col) [m^-6, microns]
   real(r8), pointer :: sno_liq_top(:)        ! snow liquid water fraction (mass), top layer (col) [fraction]
   real(r8), pointer :: mss_bcpho(:,:)        ! mass of hydrophobic BC in snow (col,lyr) [kg]
   real(r8), pointer :: mss_bcphi(:,:)        ! mass of hydrophillic BC in snow (col,lyr) [kg]
   real(r8), pointer :: mss_bctot(:,:)        ! total mass of BC in snow (pho+phi) (col,lyr) [kg]
   real(r8), pointer :: mss_bc_col(:)         ! column-integrated mass of total BC (col) [kg]
   real(r8), pointer :: mss_bc_top(:)         ! top-layer mass of total BC (col) [kg]
   real(r8), pointer :: mss_ocpho(:,:)        ! mass of hydrophobic OC in snow (col,lyr) [kg]
   real(r8), pointer :: mss_ocphi(:,:)        ! mass of hydrophillic OC in snow (col,lyr) [kg]
   real(r8), pointer :: mss_octot(:,:)        ! total mass of OC in snow (pho+phi) (col,lyr) [kg]
   real(r8), pointer :: mss_oc_col(:)         ! column-integrated mass of total OC (col) [kg]
   real(r8), pointer :: mss_oc_top(:)         ! top-layer mass of total OC (col) [kg]
   real(r8), pointer :: mss_dst1(:,:)         ! mass of dust species 1 in snow (col,lyr) [kg]
   real(r8), pointer :: mss_dst2(:,:)         ! mass of dust species 2 in snow (col,lyr) [kg]
   real(r8), pointer :: mss_dst3(:,:)         ! mass of dust species 3 in snow (col,lyr) [kg]
   real(r8), pointer :: mss_dst4(:,:)         ! mass of dust species 4 in snow (col,lyr) [kg]
   real(r8), pointer :: mss_dsttot(:,:)       ! total mass of dust in snow (col,lyr) [kg]
   real(r8), pointer :: mss_dst_col(:)        ! column-integrated mass of dust in snow (col) [kg]
   real(r8), pointer :: mss_dst_top(:)        ! top-layer mass of dust in snow (col) [kg]
   real(r8), pointer :: h2osno_top(:)         ! top-layer mass of snow (col) [kg]
   real(r8), pointer :: mss_cnc_bcphi(:,:)    ! mass concentration of hydrophilic BC in snow (col,lyr) [kg/kg]
   real(r8), pointer :: mss_cnc_bcpho(:,:)    ! mass concentration of hydrophilic BC in snow (col,lyr) [kg/kg]
   real(r8), pointer :: mss_cnc_ocphi(:,:)    ! mass concentration of hydrophilic OC in snow (col,lyr) [kg/kg]
   real(r8), pointer :: mss_cnc_ocpho(:,:)    ! mass concentration of hydrophilic OC in snow (col,lyr) [kg/kg]
   real(r8), pointer :: mss_cnc_dst1(:,:)     ! mass concentration of dust species 1 in snow (col,lyr) [kg/kg]
   real(r8), pointer :: mss_cnc_dst2(:,:)     ! mass concentration of dust species 2 in snow (col,lyr) [kg/kg]
   real(r8), pointer :: mss_cnc_dst3(:,:)     ! mass concentration of dust species 3 in snow (col,lyr) [kg/kg]
   real(r8), pointer :: mss_cnc_dst4(:,:)     ! mass concentration of dust species 4 in snow (col,lyr) [kg/kg]
   real(r8), pointer :: albgrd_pur(:,:)       ! pure snow ground direct albedo (numrad)
   real(r8), pointer :: albgri_pur(:,:)       ! pure snow ground diffuse albedo (numrad)
   real(r8), pointer :: albgrd_bc(:,:)        ! ground direct albedo without BC  (numrad)
   real(r8), pointer :: albgri_bc(:,:)        ! ground diffuse albedo without BC (numrad)
   real(r8), pointer :: albgrd_oc(:,:)        ! ground direct albedo without OC  (numrad)
   real(r8), pointer :: albgri_oc(:,:)        ! ground diffuse albedo without OC (numrad)
   real(r8), pointer :: albgrd_dst(:,:)       ! ground direct albedo without dust  (numrad)
   real(r8), pointer :: albgri_dst(:,:)       ! ground diffuse albedo without dust (numrad)
   real(r8), pointer :: dTdz_top(:)           ! temperature gradient in top layer  [K m-1]
   real(r8), pointer :: snot_top(:)           ! temperature of top snow layer [K]
end type column_pstate_type

!----------------------------------------------------
! column energy state variables structure
!----------------------------------------------------
type, public :: column_estate_type
   type(pft_estate_type):: pes_a              !pft-level energy state variables averaged to the column
   real(r8), pointer :: t_grnd(:)             !ground temperature (Kelvin)
   real(r8), pointer :: t_grnd_u(:)           !Urban ground temperature (Kelvin)
   real(r8), pointer :: t_grnd_r(:)           !Rural ground temperature (Kelvin)
   real(r8), pointer :: dt_grnd(:)            !change in t_grnd, last iteration (Kelvin)
   real(r8), pointer :: t_soisno(:,:)         !soil temperature (Kelvin)  (-nlevsno+1:nlevgrnd) 
   real(r8), pointer :: t_soi_10cm(:)         !soil temperature in top 10cm of soil (Kelvin)
   real(r8), pointer :: t_lake(:,:)           !lake temperature (Kelvin)  (1:nlevlak)          
   real(r8), pointer :: tssbef(:,:)           !soil/snow temperature before update (-nlevsno+1:nlevgrnd) 
   real(r8), pointer :: thv(:)                !virtual potential temperature (kelvin)
   real(r8), pointer :: hc_soi(:)             !soil heat content (MJ/m2)
   real(r8), pointer :: hc_soisno(:)          !soil plus snow heat content (MJ/m2)
end type column_estate_type

!----------------------------------------------------
! column water state variables structure
!----------------------------------------------------
type, public :: column_wstate_type
   type(pft_wstate_type):: pws_a             !pft-level water state variables averaged to the column
   real(r8), pointer :: h2osno(:)             !snow water (mm H2O)
   real(r8), pointer :: h2osoi_liq(:,:)       !liquid water (kg/m2) (new) (-nlevsno+1:nlevgrnd)    
   real(r8), pointer :: h2osoi_ice(:,:)       !ice lens (kg/m2) (new) (-nlevsno+1:nlevgrnd)    
   real(r8), pointer :: h2osoi_liqice_10cm(:) !liquid water + ice lens in top 10cm of soil (kg/m2)
   real(r8), pointer :: h2osoi_vol(:,:)       !volumetric soil water (0<=h2osoi_vol<=watsat) [m3/m3]  (nlevgrnd)  
   real(r8), pointer :: h2osno_old(:)         !snow mass for previous time step (kg/m2) (new)
   real(r8), pointer :: qg(:)                 !ground specific humidity [kg/kg]
   real(r8), pointer :: dqgdT(:)              !d(qg)/dT
   real(r8), pointer :: snowice(:)            !average snow ice lens
   real(r8), pointer :: snowliq(:)            !average snow liquid water
   real(r8) ,pointer :: soilalpha(:)          !factor that reduces ground saturated specific humidity (-)
   real(r8), pointer :: soilbeta(:)           !factor that reduces ground evaporation L&P1992(-)
   real(r8) ,pointer :: soilalpha_u(:)        !urban factor that reduces ground saturated specific humidity (-)
   real(r8), pointer :: zwt(:)                !water table depth
   real(r8), pointer :: fcov(:)               !fractional impermeable area
   real(r8), pointer :: wa(:)                 !water in the unconfined aquifer (mm)
   real(r8), pointer :: wt(:)                 !total water storage (unsaturated soil water + groundwater) (mm)
   real(r8), pointer :: qcharge(:)            !aquifer recharge rate (mm/s)
   real(r8), pointer :: smp_l(:,:)            !soil matric potential (mm)
   real(r8), pointer :: hk_l(:,:)             !hydraulic conductivity (mm/s)
   real(r8), pointer :: fsat(:)               !fractional area with water table at surface
end type column_wstate_type

!----------------------------------------------------
! column carbon state variables structure
!----------------------------------------------------
type, public :: column_cstate_type
   type(pft_cstate_type):: pcs_a              !pft-level carbon state variables averaged to the column
   ! NOTE: the soilc variable is used by the original CLM C-cycle code,
   ! and is not used by the CN code
   real(r8), pointer :: soilc(:)              !soil carbon (kg C /m**2)
   ! BGC variables
   real(r8), pointer :: cwdc(:)               ! (gC/m2) coarse woody debris C
   real(r8), pointer :: litr1c(:)             ! (gC/m2) litter labile C
   real(r8), pointer :: litr2c(:)             ! (gC/m2) litter cellulose C
   real(r8), pointer :: litr3c(:)             ! (gC/m2) litter lignin C
   real(r8), pointer :: soil1c(:)             ! (gC/m2) soil organic matter C (fast pool)
   real(r8), pointer :: soil2c(:)             ! (gC/m2) soil organic matter C (medium pool)
   real(r8), pointer :: soil3c(:)             ! (gC/m2) soil organic matter C (slow pool)
   real(r8), pointer :: soil4c(:)             ! (gC/m2) soil organic matter C (slowest pool)
   real(r8), pointer :: col_ctrunc(:)         ! (gC/m2) column-level sink for C truncation
   ! pools for dynamic landcover
   real(r8), pointer :: seedc(:)              ! (gC/m2) column-level pool for seeding new PFTs
   real(r8), pointer :: prod10c(:)            ! (gC/m2) wood product C pool, 10-year lifespan
   real(r8), pointer :: prod100c(:)           ! (gC/m2) wood product C pool, 100-year lifespan
   real(r8), pointer :: totprodc(:)           ! (gC/m2) total wood product C
   ! summary (diagnostic) state variables, not involved in mass balance
   real(r8), pointer :: totlitc(:)            ! (gC/m2) total litter carbon
   real(r8), pointer :: totsomc(:)            ! (gC/m2) total soil organic matter carbon
   real(r8), pointer :: totecosysc(:)         ! (gC/m2) total ecosystem carbon, incl veg but excl cpool
   real(r8), pointer :: totcolc(:)            ! (gC/m2) total column carbon, incl veg and cpool
   
end type column_cstate_type

!----------------------------------------------------
! column nitrogen state variables structure
!----------------------------------------------------
type, public :: column_nstate_type
   type(pft_nstate_type):: pns_a              !pft-level nitrogen state variables averaged to the column
   ! BGC variables
   real(r8), pointer :: cwdn(:)               ! (gN/m2) coarse woody debris N
   real(r8), pointer :: litr1n(:)             ! (gN/m2) litter labile N
   real(r8), pointer :: litr2n(:)             ! (gN/m2) litter cellulose N
   real(r8), pointer :: litr3n(:)             ! (gN/m2) litter lignin N
   real(r8), pointer :: soil1n(:)             ! (gN/m2) soil organic matter N (fast pool)
   real(r8), pointer :: soil2n(:)             ! (gN/m2) soil organic matter N (medium pool)
   real(r8), pointer :: soil3n(:)             ! (gN/m2) soil orgainc matter N (slow pool)
   real(r8), pointer :: soil4n(:)             ! (gN/m2) soil orgainc matter N (slowest pool)
   real(r8), pointer :: sminn(:)              ! (gN/m2) soil mineral N
   real(r8), pointer :: col_ntrunc(:)         ! (gN/m2) column-level sink for N truncation
   ! wood product pools, for dynamic landcover
   real(r8), pointer :: seedn(:)              ! (gN/m2) column-level pool for seeding new PFTs
   real(r8), pointer :: prod10n(:)            ! (gN/m2) wood product N pool, 10-year lifespan
   real(r8), pointer :: prod100n(:)           ! (gN/m2) wood product N pool, 100-year lifespan
   real(r8), pointer :: totprodn(:)           ! (gN/m2) total wood product N
   ! summary (diagnostic) state variables, not involved in mass balance
   real(r8), pointer :: totlitn(:)            ! (gN/m2) total litter nitrogen
   real(r8), pointer :: totsomn(:)            ! (gN/m2) total soil organic matter nitrogen
   real(r8), pointer :: totecosysn(:)         ! (gN/m2) total ecosystem nitrogen, incl veg 
   real(r8), pointer :: totcoln(:)            ! (gN/m2) total column nitrogen, incl veg
end type column_nstate_type

!----------------------------------------------------
! column VOC state variables structure
!----------------------------------------------------
type, public :: column_vstate_type
   type(pft_vstate_type):: pvs_a              !pft-level VOC state variables averaged to the column
end type column_vstate_type

#if (defined CNDV)
!----------------------------------------------------
! column DGVM state variables structure
!----------------------------------------------------
type, public :: column_dgvstate_type
   type(pft_dgvstate_type):: pdgvs_a
end type column_dgvstate_type
#endif

!----------------------------------------------------
! column dust state variables structure
!----------------------------------------------------
type, public :: column_dstate_type
   real(r8), pointer :: dummy_entry(:)
end type column_dstate_type

!----------------------------------------------------
! column energy flux variables structure
!----------------------------------------------------
type, public :: column_eflux_type
   type(pft_eflux_type):: pef_a	              ! pft-level energy flux variables averaged to the column
   real(r8), pointer :: eflx_snomelt(:)       ! snow melt heat flux (W/m**2)
   real(r8), pointer :: eflx_snomelt_u(:)     ! urban snow melt heat flux (W/m**2)
   real(r8), pointer :: eflx_snomelt_r(:)     ! rural snow melt heat flux (W/m**2)
   real(r8), pointer :: eflx_impsoil(:)	      ! implicit evaporation for soil temperature equation
   real(r8), pointer :: eflx_fgr12(:)         ! ground heat flux between soil layers 1 and 2 (W/m2)
   ! Urban variable
   real(r8), pointer :: eflx_building_heat(:) ! heat flux from urban building interior to urban walls, roof (W/m**2)
   real(r8), pointer :: eflx_urban_ac(:)      ! urban air conditioning flux (W/m**2)
   real(r8), pointer :: eflx_urban_heat(:)    ! urban heating flux (W/m**2)
end type column_eflux_type

!----------------------------------------------------
! column momentum flux variables structure
!----------------------------------------------------
type, public :: column_mflux_type
   type(pft_mflux_type)::  pmf_a        ! pft-level momentum flux variables averaged to the column
end type column_mflux_type

!----------------------------------------------------
! column water flux variables structure
!----------------------------------------------------
type, public :: column_wflux_type
   type(pft_wflux_type):: pwf_a	        ! pft-level water flux variables averaged to the column
   real(r8), pointer :: qflx_infl(:)	! infiltration (mm H2O /s)
   real(r8), pointer :: qflx_surf(:)	! surface runoff (mm H2O /s)
   real(r8), pointer :: qflx_drain(:) 	! sub-surface runoff (mm H2O /s)
   real(r8), pointer :: qflx_top_soil(:)! net water input into soil from top (mm/s)
   real(r8), pointer :: qflx_snomelt(:) ! snow melt (mm H2O /s)
   real(r8), pointer :: qflx_qrgwl(:) 	! qflx_surf at glaciers, wetlands, lakes
   real(r8), pointer :: qflx_runoff(:) 	! total runoff (qflx_drain+qflx_surf+qflx_qrgwl) (mm H2O /s)
   real(r8), pointer :: qflx_runoff_u(:)! Urban total runoff (qflx_drain+qflx_surf) (mm H2O /s)
   real(r8), pointer :: qflx_runoff_r(:)! Rural total runoff (qflx_drain+qflx_surf+qflx_qrgwl) (mm H2O /s)
   real(r8), pointer :: qmelt(:) 	! snow melt [mm/s]
   real(r8), pointer :: h2ocan_loss(:)  ! mass balance correction term for dynamic weights
   real(r8), pointer :: qflx_rsub_sat(:)    ! soil saturation excess [mm/s]
   real(r8), pointer :: flx_bc_dep_dry(:)   ! dry (BCPHO+BCPHI) BC deposition on ground (positive definite) (col) [kg/s]
   real(r8), pointer :: flx_bc_dep_wet(:)   ! wet (BCPHI) BC deposition on ground (positive definite) (col) [kg/s]
   real(r8), pointer :: flx_bc_dep_pho(:)   ! hydrophobic BC deposition on ground (positive definite) (col) [kg/s]
   real(r8), pointer :: flx_bc_dep_phi(:)   ! hydrophillic BC deposition on ground (positive definite) (col) [kg/s]
   real(r8), pointer :: flx_bc_dep(:)       ! total (dry+wet) BC deposition on ground (positive definite) (col) [kg/s]
   real(r8), pointer :: flx_oc_dep_dry(:)   ! dry (OCPHO+OCPHI) OC deposition on ground (positive definite) (col) [kg/s]
   real(r8), pointer :: flx_oc_dep_wet(:)   ! wet (OCPHI) OC deposition on ground (positive definite) (col) [kg/s]
   real(r8), pointer :: flx_oc_dep_pho(:)   ! hydrophobic OC deposition on ground (positive definite) (col) [kg/s]
   real(r8), pointer :: flx_oc_dep_phi(:)   ! hydrophillic OC deposition on ground (positive definite) (col) [kg/s]
   real(r8), pointer :: flx_oc_dep(:)       ! total (dry+wet) OC deposition on ground (positive definite) (col) [kg/s]
   real(r8), pointer :: flx_dst_dep_dry1(:) ! dust species 1 dry deposition on ground (positive definite) (col) [kg/s]
   real(r8), pointer :: flx_dst_dep_wet1(:) ! dust species 1 wet deposition on ground (positive definite) (col) [kg/s]
   real(r8), pointer :: flx_dst_dep_dry2(:) ! dust species 2 dry deposition on ground (positive definite) (col) [kg/s]
   real(r8), pointer :: flx_dst_dep_wet2(:) ! dust species 2 wet deposition on ground (positive definite) (col) [kg/s]
   real(r8), pointer :: flx_dst_dep_dry3(:) ! dust species 3 dry deposition on ground (positive definite) (col) [kg/s]
   real(r8), pointer :: flx_dst_dep_wet3(:) ! dust species 3 wet deposition on ground (positive definite) (col) [kg/s]
   real(r8), pointer :: flx_dst_dep_dry4(:) ! dust species 4 dry deposition on ground (positive definite) (col) [kg/s]
   real(r8), pointer :: flx_dst_dep_wet4(:) ! dust species 4 wet deposition on ground (positive definite) (col) [kg/s]
   real(r8), pointer :: flx_dst_dep(:)      ! total (dry+wet) dust deposition on ground (positive definite) (col) [kg/s]
   real(r8), pointer :: qflx_snofrz_lyr(:,:)! snow freezing rate (positive definite) (col,lyr) [kg m-2 s-1]
end type column_wflux_type

!----------------------------------------------------
! column carbon flux variables structure
!----------------------------------------------------
type, public :: column_cflux_type
   type(pft_cflux_type):: pcf_a                           !pft-level carbon flux variables averaged to the column
   ! new variables for CN code
   ! column-level gap mortality fluxes
   real(r8), pointer :: m_leafc_to_litr1c(:)              ! leaf C mortality to litter 1 C (gC/m2/s) 
   real(r8), pointer :: m_leafc_to_litr2c(:)              ! leaf C mortality to litter 2 C (gC/m2/s)
   real(r8), pointer :: m_leafc_to_litr3c(:)              ! leaf C mortality to litter 3 C (gC/m2/s)
   real(r8), pointer :: m_frootc_to_litr1c(:)             ! fine root C mortality to litter 1 C (gC/m2/s)
   real(r8), pointer :: m_frootc_to_litr2c(:)             ! fine root C mortality to litter 2 C (gC/m2/s)
   real(r8), pointer :: m_frootc_to_litr3c(:)             ! fine root C mortality to litter 3 C (gC/m2/s)
   real(r8), pointer :: m_livestemc_to_cwdc(:)            ! live stem C mortality to coarse woody debris C (gC/m2/s)
   real(r8), pointer :: m_deadstemc_to_cwdc(:)            ! dead stem C mortality to coarse woody debris C (gC/m2/s)
   real(r8), pointer :: m_livecrootc_to_cwdc(:)           ! live coarse root C mortality to coarse woody debris C (gC/m2/s)
   real(r8), pointer :: m_deadcrootc_to_cwdc(:)           ! dead coarse root C mortality to coarse woody debris C (gC/m2/s)
   real(r8), pointer :: m_leafc_storage_to_litr1c(:)      ! leaf C storage mortality to litter 1 C (gC/m2/s)
   real(r8), pointer :: m_frootc_storage_to_litr1c(:)     ! fine root C storage mortality to litter 1 C (gC/m2/s)
   real(r8), pointer :: m_livestemc_storage_to_litr1c(:)  ! live stem C storage mortality to litter 1 C (gC/m2/s)
   real(r8), pointer :: m_deadstemc_storage_to_litr1c(:)  ! dead stem C storage mortality to litter 1 C (gC/m2/s)
   real(r8), pointer :: m_livecrootc_storage_to_litr1c(:) ! live coarse root C storage mortality to litter 1 C (gC/m2/s)
   real(r8), pointer :: m_deadcrootc_storage_to_litr1c(:) ! dead coarse root C storage mortality to litter 1 C (gC/m2/s)
   real(r8), pointer :: m_gresp_storage_to_litr1c(:)      ! growth respiration storage mortality to litter 1 C (gC/m2/s)
   real(r8), pointer :: m_leafc_xfer_to_litr1c(:)         ! leaf C transfer mortality to litter 1 C (gC/m2/s)
   real(r8), pointer :: m_frootc_xfer_to_litr1c(:)        ! fine root C transfer mortality to litter 1 C (gC/m2/s)
   real(r8), pointer :: m_livestemc_xfer_to_litr1c(:)     ! live stem C transfer mortality to litter 1 C (gC/m2/s)
   real(r8), pointer :: m_deadstemc_xfer_to_litr1c(:)     ! dead stem C transfer mortality to litter 1 C (gC/m2/s)
   real(r8), pointer :: m_livecrootc_xfer_to_litr1c(:)    ! live coarse root C transfer mortality to litter 1 C (gC/m2/s)
   real(r8), pointer :: m_deadcrootc_xfer_to_litr1c(:)    ! dead coarse root C transfer mortality to litter 1 C (gC/m2/s)
   real(r8), pointer :: m_gresp_xfer_to_litr1c(:)         ! growth respiration transfer mortality to litter 1 C (gC/m2/s)
   ! column-level harvest mortality fluxes
   real(r8), pointer :: hrv_leafc_to_litr1c(:)               ! leaf C harvest mortality to litter 1 C (gC/m2/s)                         
   real(r8), pointer :: hrv_leafc_to_litr2c(:)               ! leaf C harvest mortality to litter 2 C (gC/m2/s)                        
   real(r8), pointer :: hrv_leafc_to_litr3c(:)               ! leaf C harvest mortality to litter 3 C (gC/m2/s)                        
   real(r8), pointer :: hrv_frootc_to_litr1c(:)              ! fine root C harvest mortality to litter 1 C (gC/m2/s)                   
   real(r8), pointer :: hrv_frootc_to_litr2c(:)              ! fine root C harvest mortality to litter 2 C (gC/m2/s)                   
   real(r8), pointer :: hrv_frootc_to_litr3c(:)              ! fine root C harvest mortality to litter 3 C (gC/m2/s)                   
   real(r8), pointer :: hrv_livestemc_to_cwdc(:)             ! live stem C harvest mortality to coarse woody debris C (gC/m2/s)        
   real(r8), pointer :: hrv_deadstemc_to_prod10c(:)          ! dead stem C harvest mortality to 10-year product pool (gC/m2/s)        
   real(r8), pointer :: hrv_deadstemc_to_prod100c(:)         ! dead stem C harvest mortality to 100-year product pool (gC/m2/s)        
   real(r8), pointer :: hrv_livecrootc_to_cwdc(:)            ! live coarse root C harvest mortality to coarse woody debris C (gC/m2/s) 
   real(r8), pointer :: hrv_deadcrootc_to_cwdc(:)            ! dead coarse root C harvest mortality to coarse woody debris C (gC/m2/s) 
   real(r8), pointer :: hrv_leafc_storage_to_litr1c(:)       ! leaf C storage harvest mortality to litter 1 C (gC/m2/s)                
   real(r8), pointer :: hrv_frootc_storage_to_litr1c(:)      ! fine root C storage harvest mortality to litter 1 C (gC/m2/s)           
   real(r8), pointer :: hrv_livestemc_storage_to_litr1c(:)   ! live stem C storage harvest mortality to litter 1 C (gC/m2/s)           
   real(r8), pointer :: hrv_deadstemc_storage_to_litr1c(:)   ! dead stem C storage harvest mortality to litter 1 C (gC/m2/s)           
   real(r8), pointer :: hrv_livecrootc_storage_to_litr1c(:)  ! live coarse root C storage harvest mortality to litter 1 C (gC/m2/s)    
   real(r8), pointer :: hrv_deadcrootc_storage_to_litr1c(:)  ! dead coarse root C storage harvest mortality to litter 1 C (gC/m2/s)    
   real(r8), pointer :: hrv_gresp_storage_to_litr1c(:)       ! growth respiration storage harvest mortality to litter 1 C (gC/m2/s)    
   real(r8), pointer :: hrv_leafc_xfer_to_litr1c(:)          ! leaf C transfer harvest mortality to litter 1 C (gC/m2/s)               
   real(r8), pointer :: hrv_frootc_xfer_to_litr1c(:)         ! fine root C transfer harvest mortality to litter 1 C (gC/m2/s)          
   real(r8), pointer :: hrv_livestemc_xfer_to_litr1c(:)      ! live stem C transfer harvest mortality to litter 1 C (gC/m2/s)          
   real(r8), pointer :: hrv_deadstemc_xfer_to_litr1c(:)      ! dead stem C transfer harvest mortality to litter 1 C (gC/m2/s)          
   real(r8), pointer :: hrv_livecrootc_xfer_to_litr1c(:)     ! live coarse root C transfer harvest mortality to litter 1 C (gC/m2/s)   
   real(r8), pointer :: hrv_deadcrootc_xfer_to_litr1c(:)     ! dead coarse root C transfer harvest mortality to litter 1 C (gC/m2/s)   
   real(r8), pointer :: hrv_gresp_xfer_to_litr1c(:)          ! growth respiration transfer harvest mortality to litter 1 C (gC/m2/s)   
   ! column-level fire fluxes
   real(r8), pointer :: m_deadstemc_to_cwdc_fire(:)       ! dead stem C to coarse woody debris C by fire (gC/m2/s)
   real(r8), pointer :: m_deadcrootc_to_cwdc_fire(:)      ! dead coarse root C to to woody debris C by fire (gC/m2/s)
   real(r8), pointer :: m_litr1c_to_fire(:)               ! litter 1 C fire loss (gC/m2/s)
   real(r8), pointer :: m_litr2c_to_fire(:)               ! litter 2 C fire loss (gC/m2/s)
   real(r8), pointer :: m_litr3c_to_fire(:)               ! litter 3 C fire loss (gC/m2/s)
   real(r8), pointer :: m_cwdc_to_fire(:)                 ! coarse woody debris C fire loss (gC/m2/s)
   ! litterfall fluxes
#if (defined CROP)
   real(r8), pointer :: grainc_to_litr1c(:)               ! grain C litterfall to litter 1 C (gC/m2/s)
   real(r8), pointer :: grainc_to_litr2c(:)               ! grain C litterfall to litter 2 C (gC/m2/s)
   real(r8), pointer :: grainc_to_litr3c(:)               ! grain C litterfall to litter 3 C (gC/m2/s)
   real(r8), pointer :: livestemc_to_litr1c(:)            ! livestem C litterfall to litter 1 C (gC/m2/s)
   real(r8), pointer :: livestemc_to_litr2c(:)            ! livestem C litterfall to litter 2 C (gC/m2/s)
   real(r8), pointer :: livestemc_to_litr3c(:)            ! livestem C litterfall to litter 3 C (gC/m2/s)
#endif
   real(r8), pointer :: leafc_to_litr1c(:)                ! leaf C litterfall to litter 1 C (gC/m2/s)
   real(r8), pointer :: leafc_to_litr2c(:)                ! leaf C litterfall to litter 2 C (gC/m2/s)
   real(r8), pointer :: leafc_to_litr3c(:)                ! leaf C litterfall to litter 3 C (gC/m2/s)
   real(r8), pointer :: frootc_to_litr1c(:)               ! fine root C litterfall to litter 1 C (gC/m2/s)
   real(r8), pointer :: frootc_to_litr2c(:)               ! fine root C litterfall to litter 2 C (gC/m2/s)
   real(r8), pointer :: frootc_to_litr3c(:)               ! fine root C litterfall to litter 3 C (gC/m2/s)
   ! decomposition fluxes
   real(r8), pointer :: cwdc_to_litr2c(:)     ! decomp. of coarse woody debris C to litter 2 C (gC/m2/s)
   real(r8), pointer :: cwdc_to_litr3c(:)     ! decomp. of coarse woody debris C to litter 3 C (gC/m2/s)
   real(r8), pointer :: litr1_hr(:)           ! het. resp. from litter 1 C (gC/m2/s)
   real(r8), pointer :: litr1c_to_soil1c(:)   ! decomp. of litter 1 C to SOM 1 C (gC/m2/s)
   real(r8), pointer :: litr2_hr(:)           ! het. resp. from litter 2 C (gC/m2/s)
   real(r8), pointer :: litr2c_to_soil2c(:)   ! decomp. of litter 2 C to SOM 2 C (gC/m2/s)
   real(r8), pointer :: litr3_hr(:)           ! het. resp. from litter 3 C (gC/m2/s)
   real(r8), pointer :: litr3c_to_soil3c(:)   ! decomp. of litter 3 C to SOM 3 C (gC/m2/s)
   real(r8), pointer :: soil1_hr(:)           ! het. resp. from SOM 1 C (gC/m2/s)
   real(r8), pointer :: soil1c_to_soil2c(:)   ! decomp. of SOM 1 C to SOM 2 C (gC/m2/s)
   real(r8), pointer :: soil2_hr(:)           ! het. resp. from SOM 2 C (gC/m2/s)
   real(r8), pointer :: soil2c_to_soil3c(:)   ! decomp. of SOM 2 C to SOM 3 C (gC/m2/s)
   real(r8), pointer :: soil3_hr(:)           ! het. resp. from SOM 3 C (gC/m2/s)
   real(r8), pointer :: soil3c_to_soil4c(:)   ! decomp. of SOM 3 C to SOM 4 C (gC/m2/s)
   real(r8), pointer :: soil4_hr(:)           ! het. resp. from SOM 4 C (gC/m2/s)
   ! dynamic landcover fluxes
#ifdef CN
   real(r8), pointer :: dwt_seedc_to_leaf(:)      ! (gC/m2/s) seed source to PFT-level
   real(r8), pointer :: dwt_seedc_to_deadstem(:)  ! (gC/m2/s) seed source to PFT-level
   real(r8), pointer :: dwt_conv_cflux(:)         ! (gC/m2/s) conversion C flux (immediate loss to atm)
   real(r8), pointer :: dwt_prod10c_gain(:)       ! (gC/m2/s) addition to 10-yr wood product pool
   real(r8), pointer :: dwt_prod100c_gain(:)      ! (gC/m2/s) addition to 100-yr wood product pool
   real(r8), pointer :: dwt_frootc_to_litr1c(:)   ! (gC/m2/s) fine root to litter due to landcover change
   real(r8), pointer :: dwt_frootc_to_litr2c(:)   ! (gC/m2/s) fine root to litter due to landcover change
   real(r8), pointer :: dwt_frootc_to_litr3c(:)   ! (gC/m2/s) fine root to litter due to landcover change
   real(r8), pointer :: dwt_livecrootc_to_cwdc(:) ! (gC/m2/s) live coarse root to CWD due to landcover change
   real(r8), pointer :: dwt_deadcrootc_to_cwdc(:) ! (gC/m2/s) dead coarse root to CWD due to landcover change
   real(r8), pointer :: dwt_closs(:)              ! (gC/m2/s) total carbon loss from product pools and conversion
   real(r8), pointer :: landuseflux(:)            ! (gC/m2/s) dwt_closs+product_closs
   real(r8), pointer :: landuptake(:)             ! (gC/m2/s) nee-landuseflux
   ! wood product pool loss fluxes
   real(r8), pointer :: prod10c_loss(:)           ! (gC/m2/s) decomposition loss from 10-yr wood product pool
   real(r8), pointer :: prod100c_loss(:)          ! (gC/m2/s) decomposition loss from 100-yr wood product pool
   real(r8), pointer :: product_closs(:)          ! (gC/m2/s) total wood product carbon loss
#endif
   ! summary (diagnostic) flux variables, not involved in mass balance
   real(r8), pointer :: lithr(:)         ! (gC/m2/s) litter heterotrophic respiration 
   real(r8), pointer :: somhr(:)         ! (gC/m2/s) soil organic matter heterotrophic respiration
   real(r8), pointer :: hr(:)            ! (gC/m2/s) total heterotrophic respiration
   real(r8), pointer :: sr(:)            ! (gC/m2/s) total soil respiration (HR + root resp)
   real(r8), pointer :: er(:)            ! (gC/m2/s) total ecosystem respiration, autotrophic + heterotrophic
   real(r8), pointer :: litfire(:)       ! (gC/m2/s) litter fire losses
   real(r8), pointer :: somfire(:)       ! (gC/m2/s) soil organic matter fire losses
   real(r8), pointer :: totfire(:)       ! (gC/m2/s) total ecosystem fire losses
   real(r8), pointer :: nep(:)           ! (gC/m2/s) net ecosystem production, excludes fire, landuse, and harvest flux, positive for sink
   real(r8), pointer :: nbp(:)           ! (gC/m2/s) net biome production, includes fire, landuse, and harvest flux, positive for sink
   real(r8), pointer :: nee(:)           ! (gC/m2/s) net ecosystem exchange of carbon, includes fire, landuse, harvest, and hrv_xsmrpool flux, positive for source
   real(r8), pointer :: col_cinputs(:)   ! (gC/m2/s) total column-level carbon inputs (for balance check)
   real(r8), pointer :: col_coutputs(:)  ! (gC/m2/s) total column-level carbon outputs (for balance check) 

#if (defined CLAMP) && (defined CN)
   ! CLAMP summary (diagnostic) flux variables, not involved in mass balance
   real(r8), pointer :: cwdc_hr(:)       ! (gC/m2/s) col-level coarse woody debris C heterotrophic respiration
   real(r8), pointer :: cwdc_loss(:)     ! (gC/m2/s) col-level coarse woody debris C loss
   real(r8), pointer :: litterc_loss(:)  ! (gC/m2/s) col-level litter C loss
#endif

   ! new variables for fire
   real(r8), pointer :: col_fire_closs(:) ! (gC/m2/s) total column-level fire C loss
end type column_cflux_type

!----------------------------------------------------
! column nitrogen flux variables structure
!----------------------------------------------------
type, public :: column_nflux_type
   type(pft_nflux_type):: pnf_a        !pft-level nitrogen flux variables averaged to the column
   ! new variables for CN code
   ! deposition fluxes
   real(r8), pointer :: ndep_to_sminn(:)                   ! atmospheric N deposition to soil mineral N (gN/m2/s)
   real(r8), pointer :: nfix_to_sminn(:)                   ! symbiotic/asymbiotic N fixation to soil mineral N (gN/m2/s) 
   ! column-level gap mortality fluxes
   real(r8), pointer :: m_leafn_to_litr1n(:)               ! leaf N mortality to litter 1 N (gC/m2/s)
   real(r8), pointer :: m_leafn_to_litr2n(:)               ! leaf N mortality to litter 2 N (gC/m2/s)
   real(r8), pointer :: m_leafn_to_litr3n(:)               ! leaf N mortality to litter 3 N (gC/m2/s)
   real(r8), pointer :: m_frootn_to_litr1n(:)              ! fine root N mortality to litter 1 N (gN/m2/s)
   real(r8), pointer :: m_frootn_to_litr2n(:)              ! fine root N mortality to litter 2 N (gN/m2/s)
   real(r8), pointer :: m_frootn_to_litr3n(:)              ! fine root N mortality to litter 3 N (gN/m2/s)
   real(r8), pointer :: m_livestemn_to_cwdn(:)             ! live stem N mortality to coarse woody debris N (gN/m2/s)
   real(r8), pointer :: m_deadstemn_to_cwdn(:)             ! dead stem N mortality to coarse woody debris N (gN/m2/s)
   real(r8), pointer :: m_livecrootn_to_cwdn(:)            ! live coarse root N mortality to coarse woody debris N (gN/m2/s)
   real(r8), pointer :: m_deadcrootn_to_cwdn(:)            ! dead coarse root N mortality to coarse woody debris N (gN/m2/s)
   real(r8), pointer :: m_retransn_to_litr1n(:)            ! retranslocated N pool mortality to litter 1 N (gN/m2/s)
   real(r8), pointer :: m_leafn_storage_to_litr1n(:)       ! leaf N storage mortality to litter 1 N (gN/m2/s)
   real(r8), pointer :: m_frootn_storage_to_litr1n(:)      ! fine root N storage mortality to litter 1 N (gN/m2/s)
   real(r8), pointer :: m_livestemn_storage_to_litr1n(:)   ! live stem N storage mortality to litter 1 N (gN/m2/s)
   real(r8), pointer :: m_deadstemn_storage_to_litr1n(:)   ! dead stem N storage mortality to litter 1 N (gN/m2/s)
   real(r8), pointer :: m_livecrootn_storage_to_litr1n(:)  ! live coarse root N storage mortality to litter 1 N (gN/m2/s)
   real(r8), pointer :: m_deadcrootn_storage_to_litr1n(:)  ! dead coarse root N storage mortality to litter 1 N (gN/m2/s)
   real(r8), pointer :: m_leafn_xfer_to_litr1n(:)          ! leaf N transfer mortality to litter 1 N (gN/m2/s)
   real(r8), pointer :: m_frootn_xfer_to_litr1n(:)         ! fine root N transfer mortality to litter 1 N (gN/m2/s)
   real(r8), pointer :: m_livestemn_xfer_to_litr1n(:)      ! live stem N transfer mortality to litter 1 N (gN/m2/s)
   real(r8), pointer :: m_deadstemn_xfer_to_litr1n(:)      ! dead stem N transfer mortality to litter 1 N (gN/m2/s)
   real(r8), pointer :: m_livecrootn_xfer_to_litr1n(:)     ! live coarse root N transfer mortality to litter 1 N (gN/m2/s)
   real(r8), pointer :: m_deadcrootn_xfer_to_litr1n(:)     ! dead coarse root N transfer mortality to litter 1 N (gN/m2/s)
   ! column-level harvest fluxes
   real(r8), pointer :: hrv_leafn_to_litr1n(:)               ! leaf N harvest mortality to litter 1 N (gC/m2/s)
   real(r8), pointer :: hrv_leafn_to_litr2n(:)               ! leaf N harvest mortality to litter 2 N (gC/m2/s)
   real(r8), pointer :: hrv_leafn_to_litr3n(:)               ! leaf N harvest mortality to litter 3 N (gC/m2/s)
   real(r8), pointer :: hrv_frootn_to_litr1n(:)              ! fine root N harvest mortality to litter 1 N (gN/m2/s)
   real(r8), pointer :: hrv_frootn_to_litr2n(:)              ! fine root N harvest mortality to litter 2 N (gN/m2/s)
   real(r8), pointer :: hrv_frootn_to_litr3n(:)              ! fine root N harvest mortality to litter 3 N (gN/m2/s)
   real(r8), pointer :: hrv_livestemn_to_cwdn(:)             ! live stem N harvest mortality to coarse woody debris N (gN/m2/s)
   real(r8), pointer :: hrv_deadstemn_to_prod10n(:)          ! dead stem N harvest mortality to 10-year product pool (gN/m2/s)
   real(r8), pointer :: hrv_deadstemn_to_prod100n(:)         ! dead stem N harvest mortality to 100-year product pool (gN/m2/s)
   real(r8), pointer :: hrv_livecrootn_to_cwdn(:)            ! live coarse root N harvest mortality to coarse woody debris N (gN/m2/s)
   real(r8), pointer :: hrv_deadcrootn_to_cwdn(:)            ! dead coarse root N harvest mortality to coarse woody debris N (gN/m2/s)
   real(r8), pointer :: hrv_retransn_to_litr1n(:)            ! retranslocated N pool harvest mortality to litter 1 N (gN/m2/s)
   real(r8), pointer :: hrv_leafn_storage_to_litr1n(:)       ! leaf N storage harvest mortality to litter 1 N (gN/m2/s)
   real(r8), pointer :: hrv_frootn_storage_to_litr1n(:)      ! fine root N storage harvest mortality to litter 1 N (gN/m2/s)
   real(r8), pointer :: hrv_livestemn_storage_to_litr1n(:)   ! live stem N storage harvest mortality to litter 1 N (gN/m2/s)
   real(r8), pointer :: hrv_deadstemn_storage_to_litr1n(:)   ! dead stem N storage harvest mortality to litter 1 N (gN/m2/s)
   real(r8), pointer :: hrv_livecrootn_storage_to_litr1n(:)  ! live coarse root N storage harvest mortality to litter 1 N (gN/m2/s)
   real(r8), pointer :: hrv_deadcrootn_storage_to_litr1n(:)  ! dead coarse root N storage harvest mortality to litter 1 N (gN/m2/s)
   real(r8), pointer :: hrv_leafn_xfer_to_litr1n(:)          ! leaf N transfer harvest mortality to litter 1 N (gN/m2/s)
   real(r8), pointer :: hrv_frootn_xfer_to_litr1n(:)         ! fine root N transfer harvest mortality to litter 1 N (gN/m2/s)
   real(r8), pointer :: hrv_livestemn_xfer_to_litr1n(:)      ! live stem N transfer harvest mortality to litter 1 N (gN/m2/s)
   real(r8), pointer :: hrv_deadstemn_xfer_to_litr1n(:)      ! dead stem N transfer harvest mortality to litter 1 N (gN/m2/s)
   real(r8), pointer :: hrv_livecrootn_xfer_to_litr1n(:)     ! live coarse root N transfer harvest mortality to litter 1 N (gN/m2/s)
   real(r8), pointer :: hrv_deadcrootn_xfer_to_litr1n(:)     ! dead coarse root N transfer harvest mortality to litter 1 N (gN/m2/s)
   ! column-level fire fluxes
   real(r8), pointer :: m_deadstemn_to_cwdn_fire(:)        ! dead stem N to coarse woody debris N by fire (gN/m2/s)
   real(r8), pointer :: m_deadcrootn_to_cwdn_fire(:)       ! dead coarse root N to to woody debris N by fire (gN/m2/s)
   real(r8), pointer :: m_litr1n_to_fire(:)                ! litter 1 N fire loss (gN/m2/s)
   real(r8), pointer :: m_litr2n_to_fire(:)                ! litter 2 N fire loss (gN/m2/s)
   real(r8), pointer :: m_litr3n_to_fire(:)                ! litter 3 N fire loss (gN/m2/s)
   real(r8), pointer :: m_cwdn_to_fire(:)                  ! coarse woody debris N fire loss (gN/m2/s)
   ! litterfall fluxes
#if (defined CROP)
   real(r8), pointer :: livestemn_to_litr1n(:)   ! livestem N litterfall to litter 1 N (gN/m2/s)
   real(r8), pointer :: livestemn_to_litr2n(:)   ! livestem N litterfall to litter 2 N (gN/m2/s)
   real(r8), pointer :: livestemn_to_litr3n(:)   ! livestem N litterfall to litter 3 N (gN/m2/s)
   real(r8), pointer :: grainn_to_litr1n(:)      ! grain N litterfall to litter 1 N (gN/m2/s)
   real(r8), pointer :: grainn_to_litr2n(:)      ! grain N litterfall to litter 2 N (gN/m2/s)
   real(r8), pointer :: grainn_to_litr3n(:)      ! grain N litterfall to litter 3 N (gN/m2/s)
#endif
   real(r8), pointer :: leafn_to_litr1n(:)       ! leaf N litterfall to litter 1 N (gN/m2/s)
   real(r8), pointer :: leafn_to_litr2n(:)       ! leaf N litterfall to litter 2 N (gN/m2/s)
   real(r8), pointer :: leafn_to_litr3n(:)       ! leaf N litterfall to litter 3 N (gN/m2/s)
   real(r8), pointer :: frootn_to_litr1n(:)      ! fine root N litterfall to litter 1 N (gN/m2/s)
   real(r8), pointer :: frootn_to_litr2n(:)      ! fine root N litterfall to litter 2 N (gN/m2/s)
   real(r8), pointer :: frootn_to_litr3n(:)      ! fine root N litterfall to litter 3 N (gN/m2/s)
   ! decomposition fluxes
   real(r8), pointer :: cwdn_to_litr2n(:)        ! decomp. of coarse woody debris N to litter 2 N (gN/m2/s)
   real(r8), pointer :: cwdn_to_litr3n(:)        ! decomp. of coarse woody debris N to litter 3 N (gN/m2/s)
   real(r8), pointer :: litr1n_to_soil1n(:)      ! decomp. of litter 1 N to SOM 1 N (gN/m2/s)
   real(r8), pointer :: sminn_to_soil1n_l1(:)    ! mineral N flux for decomp. of litter 1 to SOM 1 (gN/m2/s)
   real(r8), pointer :: litr2n_to_soil2n(:)      ! decomp. of litter 2 N to SOM 2 N (gN/m2/s)
   real(r8), pointer :: sminn_to_soil2n_l2(:)    ! mineral N flux for decomp. of litter 2 to SOM 2 (gN/m2/s)
   real(r8), pointer :: litr3n_to_soil3n(:)      ! decomp. of litter 3 N to SOM 3 N (gN/m2/s)
   real(r8), pointer :: sminn_to_soil3n_l3(:)    ! mineral N flux for decomp. of litter 3 to SOM 3 (gN/m2/s)
   real(r8), pointer :: soil1n_to_soil2n(:)      ! decomp. of SOM 1 N to SOM 2 N (gN/m2/s)
   real(r8), pointer :: sminn_to_soil2n_s1(:)    ! mineral N flux for decomp. of SOM 1 to SOM 2 (gN/m2/s)
   real(r8), pointer :: soil2n_to_soil3n(:)      ! decomp. of SOM 2 N to SOM 3 N (gN/m2/s)
   real(r8), pointer :: sminn_to_soil3n_s2(:)    ! mineral N flux for decomp. of SOM 2 to SOM 3 (gN/m2/s)
   real(r8), pointer :: soil3n_to_soil4n(:)      ! decomp. of SOM 3 N to SOM 4 N (gN/m2/s)
   real(r8), pointer :: sminn_to_soil4n_s3(:)    ! mineral N flux for decomp. of SOM 3 to SOM 4 (gN/m2/s)
   real(r8), pointer :: soil4n_to_sminn(:)       ! N mineralization for decomp. of SOM 4 (gN/m2/s)
   ! denitrification fluxes
   real(r8), pointer :: sminn_to_denit_l1s1(:)   ! denitrification for decomp. of litter 1 to SOM 1 (gN/m2/s) 
   real(r8), pointer :: sminn_to_denit_l2s2(:)   ! denitrification for decomp. of litter 2 to SOM 2 (gN/m2/s)
   real(r8), pointer :: sminn_to_denit_l3s3(:)   ! denitrification for decomp. of litter 3 to SOM 3 (gN/m2/s)
   real(r8), pointer :: sminn_to_denit_s1s2(:)   ! denitrification for decomp. of SOM 1 to SOM 2 (gN/m2/s)
   real(r8), pointer :: sminn_to_denit_s2s3(:)   ! denitrification for decomp. of SOM 2 to SOM 3 (gN/m2/s)
   real(r8), pointer :: sminn_to_denit_s3s4(:)   ! denitrification for decomp. of SOM 3 to SOM 4 (gN/m2/s)
   real(r8), pointer :: sminn_to_denit_s4(:)     ! denitrification for decomp. of SOM 4 (gN/m2/s)
   real(r8), pointer :: sminn_to_denit_excess(:) ! denitrification from excess mineral N pool (gN/m2/s)
   ! leaching fluxes
   real(r8), pointer :: sminn_leached(:)         ! soil mineral N pool loss to leaching (gN/m2/s)
   ! dynamic landcover fluxes
   real(r8), pointer :: dwt_seedn_to_leaf(:)      ! (gN/m2/s) seed source to PFT-level
   real(r8), pointer :: dwt_seedn_to_deadstem(:)  ! (gN/m2/s) seed source to PFT-level
   real(r8), pointer :: dwt_conv_nflux(:)         ! (gN/m2/s) conversion N flux (immediate loss to atm)
   real(r8), pointer :: dwt_prod10n_gain(:)       ! (gN/m2/s) addition to 10-yr wood product pool
   real(r8), pointer :: dwt_prod100n_gain(:)      ! (gN/m2/s) addition to 100-yr wood product pool
   real(r8), pointer :: dwt_frootn_to_litr1n(:)   ! (gN/m2/s) fine root to litter due to landcover change
   real(r8), pointer :: dwt_frootn_to_litr2n(:)   ! (gN/m2/s) fine root to litter due to landcover change
   real(r8), pointer :: dwt_frootn_to_litr3n(:)   ! (gN/m2/s) fine root to litter due to landcover change
   real(r8), pointer :: dwt_livecrootn_to_cwdn(:) ! (gN/m2/s) live coarse root to CWD due to landcover change
   real(r8), pointer :: dwt_deadcrootn_to_cwdn(:) ! (gN/m2/s) dead coarse root to CWD due to landcover change
   real(r8), pointer :: dwt_nloss(:)              ! (gN/m2/s) total nitrogen loss from product pools and conversion
   ! wood product pool loss fluxes
   real(r8), pointer :: prod10n_loss(:)           ! (gN/m2/s) decomposition loss from 10-yr wood product pool
   real(r8), pointer :: prod100n_loss(:)          ! (gN/m2/s) decomposition loss from 100-yr wood product pool
   real(r8), pointer :: product_nloss(:)          ! (gN/m2/s) total wood product nitrogen loss
   ! summary (diagnostic) flux variables, not involved in mass balance
   real(r8), pointer :: potential_immob(:)       ! potential N immobilization (gN/m2/s)
   real(r8), pointer :: actual_immob(:)          ! actual N immobilization (gN/m2/s)
   real(r8), pointer :: sminn_to_plant(:)        ! plant uptake of soil mineral N (gN/m2/s)
   real(r8), pointer :: supplement_to_sminn(:)   ! supplemental N supply (gN/m2/s)
   real(r8), pointer :: gross_nmin(:)            ! gross rate of N mineralization (gN/m2/s)
   real(r8), pointer :: net_nmin(:)              ! net rate of N mineralization (gN/m2/s)
   real(r8), pointer :: denit(:)                 ! total rate of denitrification (gN/m2/s)
   real(r8), pointer :: col_ninputs(:)           ! column-level N inputs (gN/m2/s)
   real(r8), pointer :: col_noutputs(:)          ! column-level N outputs (gN/m2/s)
   ! new variables for fire
   real(r8), pointer :: col_fire_nloss(:)        ! total column-level fire N loss (gN/m2/s)
end type column_nflux_type

!----------------------------------------------------
! column VOC flux variables structure
!----------------------------------------------------
type, public :: column_vflux_type
   type(pft_vflux_type):: pvf_a         !pft-level VOC flux variables averaged to the column
end type column_vflux_type

!----------------------------------------------------
! column dust flux variables structure
!----------------------------------------------------
type, public :: column_dflux_type
   type(pft_dflux_type):: pdf_a         !pft-level dust flux variables averaged to the column
end type column_dflux_type

!----------------------------------------------------
! End definition of structures defined at the column_type level
!----------------------------------------------------
!*******************************************************************************


!*******************************************************************************
!----------------------------------------------------
! Begin definition of structures defined at the landunit_type level
!----------------------------------------------------
! landunit physical state variables structure
! note - landunit type can be vegetated (includes bare soil), deep lake, 
! shallow lake, wetland, glacier or urban
!----------------------------------------------------
type, public :: landunit_pstate_type
   type(column_pstate_type):: cps_a            !column-level physical state variables averaged to landunit
   ! Urban variables
   real(r8), pointer :: t_building(:)         ! internal building temperature (K)
   real(r8), pointer :: t_building_max(:)     ! maximum internal building temperature (K)
   real(r8), pointer :: t_building_min(:)     ! minimum internal building temperature (K)
   real(r8), pointer :: tk_wall(:,:)          ! thermal conductivity of urban wall (W/m/K)
   real(r8), pointer :: tk_roof(:,:)          ! thermal conductivity of urban roof (W/m/K)
   real(r8), pointer :: tk_improad(:,:)       ! thermal conductivity of urban impervious road (W/m/K)
   real(r8), pointer :: cv_wall(:,:)          ! heat capacity of urban wall (J/m^3/K)
   real(r8), pointer :: cv_roof(:,:)          ! heat capacity of urban roof (J/m^3/K)
   real(r8), pointer :: cv_improad(:,:)       ! heat capacity of urban impervious road (J/m^3/K)
   real(r8), pointer :: thick_wall(:)         ! total thickness of urban wall (m)
   real(r8), pointer :: thick_roof(:)         ! total thickness of urban roof (m)
   integer, pointer :: nlev_improad(:)        ! number of impervious road layers (-)
   real(r8), pointer :: vf_sr(:)              ! view factor of sky for road
   real(r8), pointer :: vf_wr(:)              ! view factor of one wall for road
   real(r8), pointer :: vf_sw(:)              ! view factor of sky for one wall
   real(r8), pointer :: vf_rw(:)              ! view factor of road for one wall
   real(r8), pointer :: vf_ww(:)              ! view factor of opposing wall for one wall
   real(r8), pointer :: taf(:)                ! urban canopy air temperature (K)
   real(r8), pointer :: qaf(:)                ! urban canopy air specific humidity (kg/kg)
   real(r8), pointer :: sabs_roof_dir(:,:)       ! direct solar absorbed by roof per unit ground area per unit incident flux
   real(r8), pointer :: sabs_roof_dif(:,:)       ! diffuse solar absorbed by roof per unit ground area per unit incident flux
   real(r8), pointer :: sabs_sunwall_dir(:,:)    ! direct  solar absorbed by sunwall per unit wall area per unit incident flux
   real(r8), pointer :: sabs_sunwall_dif(:,:)    ! diffuse solar absorbed by sunwall per unit wall area per unit incident flux
   real(r8), pointer :: sabs_shadewall_dir(:,:)  ! direct  solar absorbed by shadewall per unit wall area per unit incident flux
   real(r8), pointer :: sabs_shadewall_dif(:,:)  ! diffuse solar absorbed by shadewall per unit wall area per unit incident flux
   real(r8), pointer :: sabs_improad_dir(:,:)    ! direct  solar absorbed by impervious road per unit ground area per unit incident flux
   real(r8), pointer :: sabs_improad_dif(:,:)    ! diffuse solar absorbed by impervious road per unit ground area per unit incident flux
   real(r8), pointer :: sabs_perroad_dir(:,:)    ! direct  solar absorbed by pervious road per unit ground area per unit incident flux
   real(r8), pointer :: sabs_perroad_dif(:,:)    ! diffuse solar absorbed by pervious road per unit ground area per unit incident flux
end type landunit_pstate_type

!----------------------------------------------------
! landunit energy state variables structure
!----------------------------------------------------
type, public :: landunit_estate_type
   type(column_estate_type):: ces_a            !column-level energy state variables averaged to landunit
end type landunit_estate_type

!----------------------------------------------------
! landunit water state variables structure
!----------------------------------------------------
type, public :: landunit_wstate_type
   type(column_wstate_type):: cws_a            !column-level water state variables averaged to landunit
end type landunit_wstate_type

!----------------------------------------------------
! landunit carbon state variables structure
!----------------------------------------------------
type, public :: landunit_cstate_type
   type(column_cstate_type):: ccs_a            !column-level carbon state variables averaged to landunit
end type landunit_cstate_type

!----------------------------------------------------
! landunit nitrogen state variables structure
!----------------------------------------------------
type, public :: landunit_nstate_type
   type(column_nstate_type):: cns_a            !column-level nitrogen state variables averaged to landunit
end type landunit_nstate_type

!----------------------------------------------------
! landunit VOC state variables structure
!----------------------------------------------------
type, public :: landunit_vstate_type
   real(r8):: dummy_entry
end type landunit_vstate_type

!----------------------------------------------------
! landunit DGVM state variables structure
!----------------------------------------------------
type, public :: landunit_dgvstate_type
   real(r8):: dummy_entry
end type landunit_dgvstate_type

!----------------------------------------------------
! landunit dust state variables structure
!----------------------------------------------------
type, public :: landunit_dstate_type
   type(column_dstate_type):: cds_a            !column-level dust state variables averaged to landunit
end type landunit_dstate_type

!----------------------------------------------------
! landunit energy flux variables structure
!----------------------------------------------------
type, public :: landunit_eflux_type
   type(column_eflux_type)::	cef_a		! column-level energy flux variables averaged to landunit
   ! Urban variables
   real(r8), pointer :: eflx_traffic_factor(:)  ! multiplicative traffic factor for sensible heat flux from urban traffic (-)
   real(r8), pointer :: eflx_traffic(:)         ! traffic sensible heat flux (W/m**2)
   real(r8), pointer :: eflx_wasteheat(:)       ! sensible heat flux from domestic heating/cooling sources of waste heat (W/m**2)
   real(r8), pointer :: eflx_heat_from_ac(:)    ! sensible heat flux to be put back into canyon due to removal by AC (W/m**2)
end type landunit_eflux_type

!----------------------------------------------------
! landunit momentum flux variables structure
!----------------------------------------------------
type, public :: landunit_mflux_type
   type(pft_mflux_type):: pmf_a                !pft-level momentum flux variables averaged to landunit
end type landunit_mflux_type

!----------------------------------------------------
! landunit water flux variables structure
!----------------------------------------------------
type, public :: landunit_wflux_type
   type(column_wflux_type):: cwf_a             !column-level water flux variables averaged to landunit
end type landunit_wflux_type

!----------------------------------------------------
! landunit carbon flux variables structure
!----------------------------------------------------
type, public :: landunit_cflux_type
   type(column_cflux_type):: ccf_a             !column-level carbon flux variables averaged to landunit
end type landunit_cflux_type

!----------------------------------------------------
! landunit nitrogen flux variables structure
!----------------------------------------------------
type, public :: landunit_nflux_type
   type(column_nflux_type):: cnf_a             !column-level nitrogen flux variables averaged to landunit
end type landunit_nflux_type

!----------------------------------------------------
! landunit VOC flux variables structure
!----------------------------------------------------
type, public :: landunit_vflux_type
   type(pft_vflux_type):: pvf_a                !pft-level VOC flux variables averaged to landunit
end type landunit_vflux_type

!----------------------------------------------------
! landunit dust flux variables structure
!----------------------------------------------------
type, public :: landunit_dflux_type
   type(pft_dflux_type):: pdf_a                !pft-level dust flux variables averaged to landunit
end type landunit_dflux_type

!----------------------------------------------------
! End definition of structures defined at the landunit_type level
!----------------------------------------------------
!*******************************************************************************


!*******************************************************************************
!----------------------------------------------------
! Begin definition of structures defined at the gridcell_type level
!----------------------------------------------------
! gridcell physical state variables structure
!----------------------------------------------------
type, public :: gridcell_pstate_type
   type(column_pstate_type):: cps_a   !column-level physical state variables averaged to gridcell
end type gridcell_pstate_type

!----------------------------------------------------
! gridcell energy state variables structure
!----------------------------------------------------
type, public :: gridcell_estate_type
   type(column_estate_type):: ces_a            !column-level energy state variables averaged to gridcell
   real(r8), pointer :: gc_heat1(:)            ! initial gridcell total heat content
   real(r8), pointer :: gc_heat2(:)            ! post land cover change total heat content
end type gridcell_estate_type

!----------------------------------------------------
! gridcell water state variables structure
!----------------------------------------------------
type, public :: gridcell_wstate_type
   type(column_wstate_type):: cws_a            !column-level water state variables averaged to gridcell
   real(r8), pointer :: gc_liq1(:)             ! initial gridcell total h2o liq content
   real(r8), pointer :: gc_liq2(:)             ! post land cover change total liq content
   real(r8), pointer :: gc_ice1(:)             ! initial gridcell total h2o liq content
   real(r8), pointer :: gc_ice2(:)             ! post land cover change total ice content
end type gridcell_wstate_type

!----------------------------------------------------
! gridcell carbon state variables structure
!----------------------------------------------------
type, public :: gridcell_cstate_type
   type(column_cstate_type):: ccs_a            !column-level carbon state variables averaged to gridcell
end type gridcell_cstate_type

!----------------------------------------------------
! gridcell nitrogen state variables structure
!----------------------------------------------------
type, public :: gridcell_nstate_type
   type(column_nstate_type):: cns_a            !column-level nitrogen state variables averaged to gridcell
end type gridcell_nstate_type

!----------------------------------------------------
! gridcell VOC state variables structure
!----------------------------------------------------
type, public :: gridcell_vstate_type
   type(column_vstate_type):: cvs_a            !column-level VOC state variables averaged to gridcell
end type gridcell_vstate_type

!----------------------------------------------------
! gridcell VOC emission factor variables structure (heald)
!----------------------------------------------------
type, public :: gridcell_efstate_type
   real(r8), pointer      :: efisop(:,:)    ! isoprene emission factors
end type gridcell_efstate_type

!----------------------------------------------------
! gridcell dust state variables structure
!----------------------------------------------------
type, public :: gridcell_dstate_type
   type(column_dstate_type):: cds_a            !column-level dust state variables averaged to gridcell
end type gridcell_dstate_type

#if (defined CNDV)
!----------------------------------------------------
! gridcell DGVM state variables structure
!----------------------------------------------------
type, public :: gridcell_dgvstate_type
   real(r8), pointer :: agdd20(:)      !20-yr running mean of agdd
   real(r8), pointer :: tmomin20(:)    !20-yr running mean of tmomin
   real(r8), pointer :: t10min(:)      !ann minimum of 10-day running mean (K)
end type gridcell_dgvstate_type
#endif

!----------------------------------------------------
! gridcell energy flux variables structure
!----------------------------------------------------
type, public :: gridcell_eflux_type
   type(column_eflux_type):: cef_a             !column-level energy flux variables averaged to gridcell
   real(r8), pointer :: eflx_sh_totg(:)   ! total grid-level sensible heat flux
   real(r8), pointer :: eflx_dynbal(:)    ! dynamic land cover change conversion energy flux
end type gridcell_eflux_type

!----------------------------------------------------
! gridcell momentum flux variables structure
!-- -------------------------------------------------
type, public :: gridcell_mflux_type
   type(pft_mflux_type):: pmf_a                !pft-level momentum flux variables averaged to gridcell
end type gridcell_mflux_type

!----------------------------------------------------
! gridcell water flux variables structure
!----------------------------------------------------
type, public :: gridcell_wflux_type
   type(column_wflux_type):: cwf_a             !column-level water flux variables averaged to gridcell
   real(r8), pointer :: qflx_runoffg(:)      ! total grid-level liq runoff
   real(r8), pointer :: qflx_snwcp_iceg(:)   ! total grid-level ice runoff
   real(r8), pointer :: qflx_liq_dynbal(:)   ! liq dynamic land cover change conversion runoff flux
   real(r8), pointer :: qflx_ice_dynbal(:)   ! ice dynamic land cover change conversion runoff flux
end type gridcell_wflux_type

!----------------------------------------------------
! gridcell carbon flux variables structure
!----------------------------------------------------
type, public :: gridcell_cflux_type
   type(column_cflux_type):: ccf_a             !column-level carbon flux variables averaged to gridcell
end type gridcell_cflux_type

!----------------------------------------------------
! gridcell nitrogen flux variables structure
!----------------------------------------------------
type, public :: gridcell_nflux_type
   type(column_nflux_type):: cnf_a             !column-level nitrogen flux variables averaged to gridcell
end type gridcell_nflux_type

!----------------------------------------------------
! gridcell VOC flux variables structure
!----------------------------------------------------
type, public :: gridcell_vflux_type
   type(pft_vflux_type):: pvf_a                !pft-level VOC flux variables averaged to gridcell
end type gridcell_vflux_type

!----------------------------------------------------
! gridcell dust flux variables structure
!----------------------------------------------------
type, public :: gridcell_dflux_type
   type(pft_dflux_type):: pdf_a                !pft-level dust flux variables averaged to gridcell
end type gridcell_dflux_type

!----------------------------------------------------
! End definition of structures defined at the gridcell_type level
!----------------------------------------------------
!*******************************************************************************


!*******************************************************************************
!----------------------------------------------------
! Begin definition of structures defined at the CLM level
!----------------------------------------------------
! CLM physical state variables structure
!----------------------------------------------------
type, public :: model_pstate_type
   type(column_pstate_type) :: cps_a           !column-level physical state variables globally averaged
end type model_pstate_type

!----------------------------------------------------
! CLM energy state variables structure
!----------------------------------------------------
type, public :: model_estate_type
   type(column_estate_type):: ces_a            !column-level energy state variables globally averaged
end type model_estate_type

!----------------------------------------------------
! CLM water state variables structure
!----------------------------------------------------
type, public :: model_wstate_type
   type(column_wstate_type):: cws_a            !column-level water state variables globally averaged
end type model_wstate_type

!----------------------------------------------------
! CLM carbon state variables structure
!----------------------------------------------------
type, public :: model_cstate_type
   type(column_cstate_type):: ccs_a            !column-level carbon state variables globally averaged
end type model_cstate_type

!----------------------------------------------------
! CLM nitrogen state variables structure
!----------------------------------------------------
type, public :: model_nstate_type
   type(column_nstate_type):: cns_a            !column-level nitrogen state variables globally averaged
end type model_nstate_type

!----------------------------------------------------
! CLM VOC state variables structure
!----------------------------------------------------
type, public :: model_vstate_type
   type(column_vstate_type):: cvs_a            !column-level VOC state variables globally averaged
end type model_vstate_type

!----------------------------------------------------
! CLM dust state variables structure
!----------------------------------------------------
type, public :: model_dstate_type
   type(column_dstate_type):: cds_a            !column-level dust state variables globally averaged
end type model_dstate_type

!----------------------------------------------------
! CLM energy flux variables structure
!----------------------------------------------------
type, public :: model_eflux_type
   type(column_eflux_type):: cef_a             !column-level energy flux variables globally averaged
end type model_eflux_type

!----------------------------------------------------
! CLM momentum flux variables structure
!----------------------------------------------------
type, public :: model_mflux_type
   type(pft_mflux_type):: pmf_a                !pft-level momentum flux variables globally averaged
end type model_mflux_type

!----------------------------------------------------
! CLM water flux variables structure
!----------------------------------------------------
type, public :: model_wflux_type
   type(column_wflux_type):: cwf_a             !column-level water flux variables globally averaged
end type model_wflux_type

!----------------------------------------------------
! CLM carbon flux variables structure
!----------------------------------------------------
type, public :: model_cflux_type
   type(column_cflux_type):: ccf_a             !column-level carbon flux variables globally averaged
end type model_cflux_type

!----------------------------------------------------
! CLM nitrogen flux variables structure
!----------------------------------------------------
type, public :: model_nflux_type
   type(column_nflux_type):: cnf_a             !column-level nitrogen flux variables globally averaged
end type model_nflux_type

!----------------------------------------------------
! CLM VOC flux variables structure
!----------------------------------------------------
type, public :: model_vflux_type
   type(pft_vflux_type):: pvf_a                !pft-level VOC flux variables globally averaged
end type model_vflux_type

!----------------------------------------------------
! CLM dust flux variables structure
!----------------------------------------------------
type, public :: model_dflux_type
   type(pft_dflux_type):: pdf_a                !pft-level dust flux variables globally averaged
end type model_dflux_type

!----------------------------------------------------
! End definition of structures defined at the model_type level
!----------------------------------------------------

!*******************************************************************************
!----------------------------------------------------
! Begin definition of spatial scaling hierarchy
!----------------------------------------------------

!----------------------------------------------------
! define the pft structure
!----------------------------------------------------

type, public :: pft_type

   ! g/l/c/p hierarchy, local g/l/c/p cells only
   integer, pointer :: column(:)        !index into column level quantities
   real(r8), pointer :: wtcol(:)        !weight (relative to column) 
   integer, pointer :: landunit(:)      !index into landunit level quantities
   real(r8), pointer :: wtlunit(:)      !weight (relative to landunit) 
   integer, pointer :: gridcell(:)      !index into gridcell level quantities
   real(r8), pointer :: wtgcell(:)      !weight (relative to gridcell) 

   ! topological mapping functionality
   integer , pointer :: itype(:)        !pft vegetation 
   integer , pointer :: mxy(:)          !m index for laixy(i,j,m),etc.
   real(r8), pointer :: area(:)         !total land area for this pft (km^2)

   ! conservation check structures for the pft level
   type(energy_balance_type)   :: pebal !energy balance structure
   type(water_balance_type)    :: pwbal !water balance structure
   type(carbon_balance_type)   :: pcbal !carbon balance structure
   type(nitrogen_balance_type) :: pnbal !nitrogen balance structure
   
#if (defined CNDV) || (defined CROP)
   ! DGVM state variables
   type(pft_dgvstate_type) :: pdgvs     !pft DGVM state variables
#endif
   
   ! CN ecophysiological variables
   type(pft_epv_type)    :: pepv        !pft ecophysiological variables
   
   ! state variables defined at the pft level
   type(pft_pstate_type) :: pps         !physical state variables
   type(pft_estate_type) :: pes         !pft energy state
   type(pft_wstate_type) :: pws         !pft water state
   type(pft_cstate_type) :: pcs         !pft carbon state
   type(pft_nstate_type) :: pns         !pft nitrogen state
   type(pft_vstate_type) :: pvs         !pft VOC state

   ! flux variables defined at the pft level
   type(pft_eflux_type)  :: pef         !pft energy flux
   type(pft_mflux_type)  :: pmf         !pft momentum flux
   type(pft_wflux_type)  :: pwf         !pft water flux
   type(pft_cflux_type)  :: pcf         !pft carbon flux
   type(pft_nflux_type)  :: pnf         !pft nitrogen flux
   type(pft_vflux_type)  :: pvf         !pft VOC flux
   type(pft_dflux_type)  :: pdf         !pft dust flux
   type(pft_depvd_type)  :: pdd         !dry dep velocity
   
#if (defined C13)
   ! 4/14/05: PET
   ! Adding isotope code
   type(pft_cstate_type) :: pc13s       !pft carbon-13 state
   type(pft_cflux_type)  :: pc13f       !pft carbon-13 flux
#endif
   
end type pft_type

!----------------------------------------------------
! define the column structure
!----------------------------------------------------

type, public :: column_type

   type(pft_type)   :: p       !plant functional type (pft) data structure 

   ! g/l/c/p hierarchy, local g/l/c/p cells only
   integer , pointer :: landunit(:)     !index into landunit level quantities
   real(r8), pointer :: wtlunit(:)      !weight (relative to landunit)
   integer , pointer :: gridcell(:)     !index into gridcell level quantities
   real(r8), pointer :: wtgcell(:)      !weight (relative to gridcell)
   integer , pointer :: pfti(:)         !beginning pft index for each column
   integer , pointer :: pftf(:)         !ending pft index for each column
   integer , pointer :: npfts(:)        !number of pfts for each column
   
   ! topological mapping functionality
   integer , pointer :: itype(:)        !column type
   real(r8), pointer :: area(:)         !total land area for this column (km^2)

   ! conservation check structures for the column level
   type(energy_balance_type)   :: cebal !energy balance structure
   type(water_balance_type)    :: cwbal !water balance structure
   type(carbon_balance_type)   :: ccbal !carbon balance structure
   type(nitrogen_balance_type) :: cnbal !nitrogen balance structure
   
   ! state variables defined at the column level
   type(column_pstate_type) :: cps      !column physical state variables
   type(column_estate_type) :: ces      !column energy state
   type(column_wstate_type) :: cws      !column water state
   type(column_cstate_type) :: ccs      !column carbon state
   type(column_nstate_type) :: cns      !column nitrogen state
   type(column_dstate_type) :: cds      !column dust state
   
   ! flux variables defined at the column level
   type(column_eflux_type) :: cef       !column energy flux
   type(column_mflux_type) :: cmf       !column momentum flux
   type(column_wflux_type) :: cwf       !column water flux
   type(column_cflux_type) :: ccf       !column carbon flux
   type(column_nflux_type) :: cnf       !column nitrogen flux
   type(column_vflux_type) :: cvf       !column VOC flux
   type(column_dflux_type) :: cdf       !column dust flux

#if (defined CNDV)
   ! dgvm variables defined at the column level
   type (column_dgvstate_type) :: cdgvs !column DGVM structure
#endif
   
#if (defined C13)
   ! 4/14/05: PET
   ! Adding isotope code
   type(column_cstate_type) :: cc13s    !column carbon-13 state
   type(column_cflux_type)  :: cc13f    !column carbon-13 flux
#endif
   
end type column_type

!----------------------------------------------------
! define the geomorphological land unit structure
!----------------------------------------------------

type, public :: landunit_type
   type(column_type) :: c                 !column data structure (soil/snow/canopy columns)

   ! g/l/c/p hierarchy, local g/l/c/p cells only
   integer , pointer :: gridcell(:)       !index into gridcell level quantities
   real(r8), pointer :: wtgcell(:)        !weight (relative to gridcell)
   integer , pointer :: coli(:)           !beginning column index per landunit
   integer , pointer :: colf(:)           !ending column index for each landunit
   integer , pointer :: ncolumns(:)       !number of columns for each landunit
   integer , pointer :: pfti(:)           !beginning pft index for each landunit
   integer , pointer :: pftf(:)           !ending pft index for each landunit
   integer , pointer :: npfts(:)          !number of pfts for each landunit

   real(r8), pointer :: area(:)          !total land area for this landunit (km^2)

   ! Urban canyon related properties
   real(r8), pointer :: canyon_hwr(:)     ! urban landunit canyon height to width ratio (-)   
   real(r8), pointer :: wtroad_perv(:)    ! urban landunit weight of pervious road column to total road (-)
   real(r8), pointer :: wtlunit_roof(:)   ! weight of roof with respect to urban landunit (-)

   ! Urban related info MV - this should be moved to land physical state - MV
   real(r8), pointer :: ht_roof(:)        ! height of urban roof (m)
   real(r8), pointer :: wind_hgt_canyon(:)! height above road at which wind in canyon is to be computed (m)
   real(r8), pointer :: z_0_town(:)       ! urban landunit momentum roughness length (m)
   real(r8), pointer :: z_d_town(:)       ! urban landunit displacement height (m)
   
   ! topological mapping functionality
   integer , pointer :: itype(:)        !landunit type
   logical , pointer :: ifspecial(:)    !BOOL: true=>landunit is not vegetated
   logical , pointer :: lakpoi(:)       !BOOL: true=>lake point
   logical , pointer :: urbpoi(:)       !BOOL: true=>urban point

   ! conservation check structures for the landunit level
   type(energy_balance_type)   :: lebal !energy balance structure
   type(water_balance_type)    :: lwbal !water balance structure
   type(carbon_balance_type)   :: lcbal !carbon balance structure
   type(nitrogen_balance_type) :: lnbal !nitrogen balance structure
   
   ! state variables defined at the land unit level
   type(landunit_pstate_type) :: lps    !land unit physical state variables
   type(landunit_estate_type) :: les    !average of energy states all columns
   type(landunit_wstate_type) :: lws    !average of water states all columns
   type(landunit_cstate_type) :: lcs    !average of carbon states all columns
   type(landunit_nstate_type) :: lns    !average of nitrogen states all columns
   type(landunit_vstate_type) :: lvs    !average of VOC states all columns
   type(landunit_dstate_type) :: lds    !average of dust states all columns
   
   ! flux variables defined at the landunit level
   type(landunit_eflux_type) :: lef     !average of energy fluxes all columns
   type(landunit_mflux_type) :: lmf     !average of momentum fluxes all columns
   type(landunit_wflux_type) :: lwf     !average of water fluxes all columns
   type(landunit_cflux_type) :: lcf     !average of carbon fluxes all columns
   type(landunit_nflux_type) :: lnf     !average of nitrogen fluxes all columns
   type(landunit_vflux_type) :: lvf     !average of VOC fluxes all columns
   type(landunit_dflux_type) :: ldf     !average of dust fluxes all columns
end type landunit_type

!----------------------------------------------------
! define the gridcell structure
!----------------------------------------------------

type, public :: gridcell_type

   type(landunit_type) :: l             !geomorphological landunits

   ! g/l/c/p hierarchy, local g/l/c/p cells only
   integer, pointer :: luni(:)          !beginning landunit index 
   integer, pointer :: lunf(:)          !ending landunit index 
   integer, pointer :: nlandunits(:)    !number of landunit for each gridcell
   integer, pointer :: coli(:)          !beginning column index
   integer, pointer :: colf(:)          !ending column index
   integer, pointer :: ncolumns(:)      !number of columns for each gridcell
   integer, pointer :: pfti(:)          !beginning pft index
   integer, pointer :: pftf(:)          !ending pft index
   integer, pointer :: npfts(:)         !number of pfts for each gridcell

   ! topological mapping functionality, local 1d gdc arrays
   integer , pointer :: gindex(:)       !global index
   real(r8), pointer :: area(:)         !total land area, gridcell (km^2)
   real(r8), pointer :: lat(:)          !latitude (radians)
   real(r8), pointer :: lon(:)          !longitude (radians)
   real(r8), pointer :: latdeg(:)       !latitude (degrees)
   real(r8), pointer :: londeg(:)       !longitude (degrees)
   integer , pointer :: gindex_a(:)     !"atm" global index
   real(r8), pointer :: lat_a(:) 	!"atm" latitude (radians) for albedo
   real(r8), pointer :: lon_a(:)        !"atm" longitude (radians) for albedo
   real(r8), pointer :: latdeg_a(:)     !"atm" latitude (degrees) for albedo
   real(r8), pointer :: londeg_a(:)     !"atm" longitude (degrees) for albedo

   ! conservation check structures for the gridcell level
   type(energy_balance_type)   :: gebal !energy balance structure
   type(water_balance_type)    :: gwbal !water balance structure
   type(carbon_balance_type)   :: gcbal !carbon balance structure
   type(nitrogen_balance_type) :: gnbal !nitrogen balance structure

#if (defined CNDV)
   ! dgvm variables defined at the gridcell level
   type(gridcell_dgvstate_type):: gdgvs !gridcell DGVM structure
#endif
   
   ! state variables defined at the gridcell level
   type(gridcell_pstate_type) :: gps    !gridcell physical state variables
   type(gridcell_estate_type) :: ges    !average of energy states all landunits
   type(gridcell_wstate_type) :: gws    !average of water states all landunits
   type(gridcell_cstate_type) :: gcs    !average of carbon states all landunits
   type(gridcell_nstate_type) :: gns    !average of nitrogen states all landus
   type(gridcell_vstate_type) :: gvs    !average of VOC states all landunits
   type(gridcell_efstate_type):: gve	!gridcell VOC emission factors
   type(gridcell_dstate_type) :: gds    !average of dust states all landunits
   
   ! flux variables defined at the gridcell level
   type(gridcell_eflux_type) :: gef     !average of energy fluxes all landunits
   type(gridcell_wflux_type) :: gwf     !average of water fluxes all landunits
   type(gridcell_cflux_type) :: gcf     !average of carbon fluxes all landunits
   type(gridcell_nflux_type) :: gnf     !average of nitrogen fluxes all landus
   type(gridcell_vflux_type) :: gvf     !average of VOC fluxes all landunits
   type(gridcell_dflux_type) :: gdf     !average of dust fluxes all landunits

end type gridcell_type

!----------------------------------------------------
! define the top-level (model) structure 
!----------------------------------------------------

type, public :: model_type
   ! lower level in hierarch
   type(gridcell_type) :: g    !gridicell data structure
   integer  :: ngridcells      !number of gridcells for this process
   real(r8) :: area            !total land area for all gridcells (km^2)

   ! conservation check structures for the clm (global) level
   type(energy_balance_type)   :: mebal !energy balance structure
   type(water_balance_type)    :: mwbal !water balance structure
   type(carbon_balance_type)   :: mcbal !carbon balnace structure
   type(nitrogen_balance_type) :: mnbal !nitrogen balance structure
   
   ! globally average state variables 
   type(model_pstate_type) ::  mps      !clm physical state variables
   type(model_estate_type) ::  mes      !average of energy states all gridcells
   type(model_wstate_type) ::  mws      !average of water states all gridcells
   type(model_cstate_type) ::  mcs      !average of carbon states all gridcells
   type(model_nstate_type) ::  mns      !average of nitrogen states all gcells
   type(model_vstate_type) ::  mvs      !average of VOC states all gridcells
   type(model_dstate_type) ::  mds      !average of dust states all gridcells
   
   ! globally averaged flux variables 
   type(model_eflux_type) ::   mef      !average of energy fluxes all gridcells
   type(model_wflux_type) ::   mwf      !average of water fluxes all gridcells
   type(model_cflux_type) ::   mcf      !average of carbon fluxes all gridcells
   type(model_nflux_type) ::   mnf      !average of nitrogen fluxes all gcells
   type(model_vflux_type) ::   mvf      !average of VOC fluxes all gridcells
   type(model_dflux_type) ::   mdf      !average of dust fluxes all gridcells
end type model_type

type atm2lnd_type
  real(r8), pointer :: forc_t(:)       !atmospheric temperature (Kelvin)
  real(r8), pointer :: forc_u(:)       !atm wind speed, east direction (m/s)
  real(r8), pointer :: forc_v(:)       !atm wind speed, north direction (m/s)
  real(r8), pointer :: forc_wind(:)    !atmospheric wind speed   
  real(r8), pointer :: forc_q(:)       !atmospheric specific humidity (kg/kg)
  real(r8), pointer :: forc_hgt(:)     !atmospheric reference height (m)
  real(r8), pointer :: forc_hgt_u(:)   !obs height of wind [m] (new)
  real(r8), pointer :: forc_hgt_t(:)   !obs height of temperature [m] (new)
  real(r8), pointer :: forc_hgt_q(:)   !obs height of humidity [m] (new)
  real(r8), pointer :: forc_pbot(:)    !atmospheric pressure (Pa)
  real(r8), pointer :: forc_th(:)      !atm potential temperature (Kelvin)
  real(r8), pointer :: forc_vp(:)      !atmospheric vapor pressure (Pa)
  real(r8), pointer :: forc_rho(:)     !density (kg/m**3)
  real(r8), pointer :: forc_rh(:)      !atmospheric relative humidity (%)
  real(r8), pointer :: forc_psrf(:)    !surface pressure (Pa)
  real(r8), pointer :: forc_pco2(:)    !CO2 partial pressure (Pa)
  real(r8), pointer :: forc_lwrad(:)   !downwrd IR longwave radiation (W/m**2)
  real(r8), pointer :: forc_solad(:,:) !direct beam radiation (numrad)
                                       !(vis=forc_sols , nir=forc_soll )
  real(r8), pointer :: forc_solai(:,:) !diffuse radiation (numrad)
                                       !(vis=forc_solsd, nir=forc_solld)
  real(r8), pointer :: forc_solar(:)   !incident solar radiation
  real(r8), pointer :: forc_rain(:)    !rain rate [mm/s]
  real(r8), pointer :: forc_snow(:)    !snow rate [mm/s]
  real(r8), pointer :: forc_ndep(:)    !nitrogen deposition rate (gN/m2/s)
  real(r8), pointer :: rainf(:)        !ALMA rain+snow [mm/s]
#if (defined C13)
  ! 4/14/05: PET
  ! Adding isotope code
  real(r8), pointer :: forc_pc13o2(:)  !C13O2 partial pressure (Pa)
#endif
  real(r8), pointer :: forc_po2(:)     !O2 partial pressure (Pa)
  real(r8), pointer :: forc_aer(:,:)   ! aerosol deposition array
end type atm2lnd_type

type(atm2lnd_type), public, target, save :: clm_a2l

!----------------------------------------------------
! End definition of spatial scaling hierarchy
!----------------------------------------------------
!*******************************************************************************

!*******************************************************************************
!----------------------------------------------------
! Declare single instance of clmtype
!----------------------------------------------------
type(model_type)    , public, target     , save :: clm3

!----------------------------------------------------
! Declare single instance of array of ecophysiological constant types
!----------------------------------------------------
type(pft_epc_type), public, target, save :: pftcon

#if (defined CNDV) || (defined CROP)
!----------------------------------------------------
! Declare single instance of array of dgvm ecophysiological constant types
!----------------------------------------------------
type(pft_dgvepc_type), public, target, save :: dgv_pftcon
#endif

character(len=8), parameter, public :: gratm  = 'atmgrid'   ! name of atmgrid
character(len=8), parameter, public :: grlnd  = 'lndgrid'   ! name of lndgrid
character(len=8), parameter, public :: nameg  = 'gridcell'  ! name of gridcells
character(len=8), parameter, public :: namel  = 'landunit'  ! name of landunits
character(len=8), parameter, public :: namec  = 'column'    ! name of columns
character(len=8), parameter, public :: namep  = 'pft'       ! name of pfts
character(len=8), parameter, public :: allrof = 'allrof'    ! name of rtm, runoff

!
!EOP
!----------------------------------------------------------------------- 
 contains
   subroutine clmtype_mod
   end subroutine clmtype_mod


end module clmtype  
MODULE module_sf_clm

!October 15, 2012
!Jiming Jin: initial coupling WRF with CLM 
!Yaqiong Lu and Jiming Jin:  CLM version 4.0 update with WRF
!
!------------------------------------------------------
  use shr_kind_mod, only: r8 => shr_kind_r8
  use clm_varpar, only: numpft, clm_varpar_mod,nlevgrnd, nlevsoi,nlevlak,nlevsno,maxpatch_pft
  use clm_varcon, only: hvap, hsub,tfrz, vkc, sb  ,&
                        snowage_drdt0,ndep,organic,fmax,efisop
  
!
CONTAINS
!
    subroutine clmdrv(zgcmxy     ,forc_qxy   ,ps   ,forc_txy    ,tsxy  &  
                   ,shxy       ,qfx        ,lhxy        ,soiflx      ,qgh       &
                   ,gsw, swdown,ra_sw_physics &   
                   ,history_interval ,flwdsxy    ,smstav      ,smstot      ,qsfxy     &
                   ,qdnxy      ,ivgtyp     ,isltyp      ,vegfra      ,albxy     &
                   ,znt        ,z0         ,tmn         ,xland       ,xice      &
                   ,emiss      ,snowc      ,qsfc        ,prec        ,maxpatch  &
                   ,num_soil_layers        ,dt          ,dzs         ,nstep     &
                   ,smois      ,tslb       ,snow        ,canwat      ,chs       &
                   ,chs2                                                        &
                   ,sh2o       ,snowh      ,forc_uxy    ,forc_vxy    ,shdmin    &
                   ,shdmax     ,acsnom     ,acsnow      ,dx          ,xlat      &
                   ,xlong,ht                                                    &   
                   ,ids,ide, jds,jde, kds,kde                    &
                   ,ims,ime, jms,jme, kms,kme                    &
                   ,its,ite, jts,jte, kts,kte                    &
                   ,inest, sf_urban_physics,                               &
!Optional urban
                CMR_SFCDIF,CHR_SFCDIF,CMC_SFCDIF,CHC_SFCDIF,   &
                tr_urb2d,tb_urb2d,tg_urb2d,tc_urb2d,qc_urb2d,  & !H urban
                uc_urb2d,                                       & !H urban
                xxxr_urb2d,xxxb_urb2d,xxxg_urb2d,xxxc_urb2d,    & !H urban
                trl_urb3d,tbl_urb3d,tgl_urb3d,                  & !H urban
                sh_urb2d,lh_urb2d,g_urb2d,rn_urb2d,ts_urb2d,    & !H urban
                psim_urb2d,psih_urb2d,u10_urb2d,v10_urb2d,      & !O urban
                GZ1OZ0_urb2d, AKMS_URB2D,                       & !O urban
                th2_urb2d,q2_urb2d,ust_urb2d,                   & !O urban
               declin_urb,cosz_urb2d,omg_urb2d,                & !I urban
                xlat_urb2d,                                     & !I urban
                num_roof_layers, num_wall_layers,               & !I urban
                num_road_layers, DZR, DZB, DZG,                 & !I urban
                FRC_URB2D, UTYPE_URB2D                          & ! urban
! subgrids
               ,numc,nump,sabv,sabg,lwup,snl, &
                snowdp,wtc,wtp,h2osno,t_grnd,t_veg,         &
                h2ocan,h2ocan_col,t2m_max,t2m_min,t2clm ,    &
                t_ref2m,h2osoi_liq_s1,                 &
                h2osoi_liq_s2,h2osoi_liq_s3,h2osoi_liq_s4,          &
                h2osoi_liq_s5,h2osoi_liq1,h2osoi_liq2,              &
                h2osoi_liq3,h2osoi_liq4,h2osoi_liq5,h2osoi_liq6,    &
                h2osoi_liq7,h2osoi_liq8,h2osoi_liq9,h2osoi_liq10,   &
                h2osoi_ice_s1,h2osoi_ice_s2,                        &
                h2osoi_ice_s3,h2osoi_ice_s4,h2osoi_ice_s5,          &
                h2osoi_ice1,h2osoi_ice2,h2osoi_ice3,h2osoi_ice4,    &
                h2osoi_ice5,h2osoi_ice6,h2osoi_ice7,                &
                h2osoi_ice8,h2osoi_ice9,h2osoi_ice10,               &
                t_soisno_s1,t_soisno_s2,t_soisno_s3,t_soisno_s4,    &
                t_soisno_s5,t_soisno1,t_soisno2,t_soisno3,          &
                t_soisno4,t_soisno5,t_soisno6,t_soisno7,            &
                t_soisno8,t_soisno9,t_soisno10,                     &
                dzsnow1,dzsnow2,dzsnow3,dzsnow4,dzsnow5,            &
                snowrds1,snowrds2,snowrds3,snowrds4,snowrds5,       &
                t_lake1,t_lake2,t_lake3,t_lake4,t_lake5,            &
                t_lake6,t_lake7,t_lake8,t_lake9,t_lake10,           &
                h2osoi_vol1,h2osoi_vol2,h2osoi_vol3,                &
                h2osoi_vol4,h2osoi_vol5,h2osoi_vol6,                &
                h2osoi_vol7,h2osoi_vol8,                            &
                h2osoi_vol9,h2osoi_vol10,                           &
                q_ref2m,                                   &
                ALBEDOsubgrid,LHsubgrid,HFXsubgrid,LWUPsubgrid,     &
                Q2subgrid,SABVsubgrid,SABGsubgrid,NRAsubgrid,SWUPsubgrid,&
                LHsoi,LHveg,LHtran,&
                alswvisdir, alswvisdif, alswnirdir, alswnirdif,      & ! clm
                swvisdir, swvisdif, swnirdir, swnirdif               & ! clm
#ifdef CN
!CROP&CN restart and outputs
                ,dyntlai,dyntsai,dyntop,dynbot &
                ,htmx,croplive,gdd1020,gdd820,gdd020,grainc,grainc_storage  &
                ,grainc_xfer,grainn,grainn_storage,grainn_xfer,days_active  &
                ,onset_flag,onset_counter,onset_gddflag,onset_fdd,onset_gdd &
                ,onset_swi,offset_flag,offset_counter,offset_fdd,offset_swi &
                ,dayl,annavg_t2m,tempavg_t2m,tempsum_potential_gpp          &
                ,annsum_potential_gpp,tempmax_retransn,annmax_retransn      &
                ,prev_leafc_to_litter,prev_frootc_to_litter,tempsum_npp     &
                ,annsum_npp,leafc,leafc_storage,leafc_xfer,frootc           &
                ,frootc_storage,frootc_xfer,livestemc,livestemc_storage     &
                ,livestemc_xfer,deadstemc,deadstemc_storage,deadstemc_xfer  &
                ,livecrootc,livecrootc_storage,livecrootc_xfer,deadcrootc   &
                ,deadcrootc_storage,deadcrootc_xfer,cpool,pft_ctrunc        &
                ,leafn,leafn_storage,leafn_xfer,frootn,frootn_storage       &
                ,frootn_xfer,livestemn,livestemn_storage,livestemn_xfer     &  
                ,deadstemn,deadstemn_storage,deadstemn_xfer,livecrootn      &
                ,livecrootn_storage,livecrootn_xfer,deadcrootn              &
                ,deadcrootn_storage,deadcrootn_xfer,npool,pft_ntrunc        &
                ,gresp_storage,gresp_xfer,xsmrpool,annsum_counter           &
                ,cannsum_npp,cannavg_t2m,wf,me,mean_fire_prob,cwdc,litr1c   &
                ,litr2c,litr3c,soil1c,soil2c,soil3c,soil4c,seedc,col_ctrunc &
                ,prod10c,prod100c,cwdn,litr1n,litr2n,litr3n,soil1n,soil2n   &
                ,soil3n,soil4n,seedn,col_ntrunc,prod10n,prod100n,sminn      &
                ,totlitc,dwt_seedc_to_leaf,dwt_seedc_to_deadstem,dwt_conv_cflux &
                ,dwt_prod10c_gain,dwt_prod100c_gain,prod100c_loss,dwt_frootc_to_litr1c &
                ,dwt_frootc_to_litr2c,dwt_frootc_to_litr3c,dwt_livecrootc_to_cwdc &
                ,dwt_deadcrootc_to_cwdc,dwt_seedn_to_leaf,dwt_seedn_to_deadstem &
                ,dwt_conv_nflux,dwt_prod10n_gain,dwt_prod100n_gain,prod100n_loss &
                ,dwt_frootn_to_litr1n,dwt_frootn_to_litr2n, dwt_frootn_to_litr3n &
                , dwt_livecrootn_to_cwdn,dwt_deadcrootn_to_cwdn,retransn &
#endif
                 )


  USE module_date_time
  USE module_sf_urban, only: urban
  USE module_configure

  implicit none

  integer,  intent(in)       ::     ids,ide, jds,jde, kds,kde,  &
                                    ims,ime, jms,jme, kms,kme,  &
                                    its,ite, jts,jte, kts,kte

  integer,intent(in)  :: num_soil_layers,maxpatch,nstep,sf_urban_physics,&
                         ra_sw_physics,history_interval
  real,dimension(ims:ime,1:num_soil_layers,jms:jme ),intent(inout) ::&
                                                         smois, & ! total soil moisture
                                                         sh2o,  & ! new soil liquid
                                                         tslb     ! TSLB     STEMP

  real,intent(in) :: dt,dx
  real(r8) :: dtt
  real, dimension(1:num_soil_layers), intent(in)::dzs

  real,dimension(ims:ime,jms:jme ),intent(inout) ::&
                    smstav     ,smstot                &
                   ,znt        ,snowc      ,qsfc       ,snow        ,snowh &
                   ,canwat     ,acsnom     ,acsnow,   emiss, z0

  real,dimension(ims:ime,jms:jme ),intent(in) ::&
                 vegfra, tmn,shdmin,shdmax

  real,dimension(ims:ime,jms:jme ),intent(in) ::&
                   qgh,chs,chs2

  real(r8) :: efisop_buf(6)
  logical :: found = .false.
  integer,   dimension(ims:ime,jms:jme ),intent(inout) :: numc,nump
  real,  dimension(ims:ime,jms:jme ),intent(inout) :: soiflx,sabv,sabg,lwup,t2m_max,t2m_min
  integer,  dimension(ims:ime,1:maxpatch,jms:jme ) :: snl,snl1
  real,  dimension(ims:ime,1:maxpatch,jms:jme ),intent(inout) ::  &
                snowdp,wtc,wtp,h2osno,t_grnd,t_veg,         &
                h2ocan,h2ocan_col,     &
                t_ref2m,h2osoi_liq_s1,              &
                h2osoi_liq_s2,h2osoi_liq_s3,h2osoi_liq_s4,          &
                h2osoi_liq_s5,h2osoi_liq1,h2osoi_liq2,              &
                h2osoi_liq3,h2osoi_liq4,h2osoi_liq5,h2osoi_liq6,    &
                h2osoi_liq7,h2osoi_liq8,h2osoi_liq9,h2osoi_liq10,   &
                h2osoi_ice_s1,h2osoi_ice_s2,                        &
                h2osoi_ice_s3,h2osoi_ice_s4,h2osoi_ice_s5,          &
                h2osoi_ice1,h2osoi_ice2,h2osoi_ice3,h2osoi_ice4,    &
                h2osoi_ice5,h2osoi_ice6,h2osoi_ice7,                &
                h2osoi_ice8,h2osoi_ice9,h2osoi_ice10,               &
                t_soisno_s1,t_soisno_s2,t_soisno_s3,t_soisno_s4,    &
                t_soisno_s5,t_soisno1,t_soisno2,t_soisno3,          &
                t_soisno4,t_soisno5,t_soisno6,t_soisno7,            &
                t_soisno8,t_soisno9,t_soisno10,                     &
                dzsnow1,dzsnow2,dzsnow3,dzsnow4,dzsnow5,            &
                snowrds1,snowrds2,snowrds3,snowrds4,snowrds5,       &
                t_lake1,t_lake2,t_lake3,t_lake4,t_lake5,            &
                t_lake6,t_lake7,t_lake8,t_lake9,t_lake10,           &
                h2osoi_vol1,h2osoi_vol2,h2osoi_vol3,                &
                h2osoi_vol4,h2osoi_vol5,h2osoi_vol6,                &
                h2osoi_vol7,h2osoi_vol8,                            &
                h2osoi_vol9,h2osoi_vol10,                           &
                q_ref2m,                                            &
                ALBEDOsubgrid,LHsubgrid,HFXsubgrid,LWUPsubgrid,     &
                Q2subgrid,SABVsubgrid,SABGsubgrid,NRAsubgrid,       &
                SWUPsubgrid,LHsoi,LHveg,LHtran

 real(r8) :: gti_buf

#ifdef CN
 real, dimension(ims:ime,1:maxpatch,jms:jme),intent(in) :: dyntlai,dyntsai,dyntop,dynbot

!ADD_NEW_VAR
  integer,   dimension(ims:ime,1:maxpatch,jms:jme ),intent(inout) :: croplive
  real,dimension(ims:ime,1:maxpatch,jms:jme),intent(inout) :: &
                 htmx,gdd1020,gdd820,gdd020,grainc,grainc_storage  &
                ,grainc_xfer,grainn,grainn_storage,grainn_xfer,days_active  &
                ,onset_flag,onset_counter,onset_gddflag,onset_fdd,onset_gdd &
                ,onset_swi,offset_flag,offset_counter,offset_fdd,offset_swi &
                ,dayl,annavg_t2m,tempavg_t2m,tempsum_potential_gpp          &
                ,annsum_potential_gpp,tempmax_retransn,annmax_retransn      &
                ,prev_leafc_to_litter,prev_frootc_to_litter,tempsum_npp     &
                ,annsum_npp,leafc,leafc_storage,leafc_xfer,frootc           &
                ,frootc_storage,frootc_xfer,livestemc,livestemc_storage     &
                ,livestemc_xfer,deadstemc,deadstemc_storage,deadstemc_xfer  &
                ,livecrootc,livecrootc_storage,livecrootc_xfer,deadcrootc   &
                ,deadcrootc_storage,deadcrootc_xfer,cpool,pft_ctrunc        &
                ,leafn,leafn_storage,leafn_xfer,frootn,frootn_storage       &
                ,frootn_xfer,livestemn,livestemn_storage,livestemn_xfer     &
                ,deadstemn,deadstemn_storage,deadstemn_xfer,livecrootn      &
                ,livecrootn_storage,livecrootn_xfer,deadcrootn              &
                ,deadcrootn_storage,deadcrootn_xfer,npool,pft_ntrunc        &
                ,gresp_storage,gresp_xfer,xsmrpool,annsum_counter           &
                ,cannsum_npp,cannavg_t2m,wf,me,mean_fire_prob,cwdc,litr1c   &
                ,litr2c,litr3c,soil1c,soil2c,soil3c,soil4c,seedc,col_ctrunc &
                ,prod10c,prod100c,cwdn,litr1n,litr2n,litr3n,soil1n,soil2n   &
                ,soil3n,soil4n,seedn,col_ntrunc,prod10n,prod100n,sminn      &
                ,totlitc,dwt_seedc_to_leaf,dwt_seedc_to_deadstem,dwt_conv_cflux &
                ,dwt_prod10c_gain,dwt_prod100c_gain,prod100c_loss,dwt_frootc_to_litr1c &
                ,dwt_frootc_to_litr2c,dwt_frootc_to_litr3c,dwt_livecrootc_to_cwdc &
                ,dwt_deadcrootc_to_cwdc,dwt_seedn_to_leaf,dwt_seedn_to_deadstem & 
                ,dwt_conv_nflux,dwt_prod10n_gain,dwt_prod100n_gain,prod100n_loss &
                ,dwt_frootn_to_litr1n,dwt_frootn_to_litr2n, dwt_frootn_to_litr3n &
                , dwt_livecrootn_to_cwdn,dwt_deadcrootn_to_cwdn,retransn 

#endif
!!!

  integer  :: i,j,m,inest,k
  real, dimension(ims:ime, kms:kme,jms:jme),intent(in) ::&
            forc_txy,forc_uxy,forc_vxy,forc_qxy,zgcmxy,ps
  
  real :: flwdsxy(ims:ime,jms:jme)           !downward longwave rad onto surface (W/m**2)
  real :: gsw(ims:ime,jms:jme)               !downward solar rad onto surface (W/m**2)

  real :: swdown(ims:ime,jms:jme)
  real, dimension(ims:ime,jms:jme),intent(in) :: swvisdir, swvisdif, swnirdir,swnirdif
  real, dimension(ims:ime,jms:jme),intent(out):: alswvisdir,alswvisdif,alswnirdir,alswnirdif

  real :: xlat (ims:ime,jms:jme)
  real :: xlong(ims:ime,jms:jme)
  real :: ht(ims:ime,jms:jme)
  real :: xland (ims:ime,jms:jme)
  real :: xice (ims:ime,jms:jme)
  real :: prec (ims:ime,jms:jme)              !total precipitation rate (mm; accumlated precipitation within DT)
  integer  :: ivgtyp(ims:ime,jms:jme)
  integer  :: isltyp (ims:ime,jms:jme)

  real :: albxy(ims:ime,jms:jme)           
  real :: tsxy(ims:ime,jms:jme)           
  real :: t2clm(ims:ime,jms:jme)
  real :: shxy(ims:ime,jms:jme)           
  real :: lhxy(ims:ime,jms:jme)           
  real :: qfx(ims:ime,jms:jme)   ! kg/(sm^2) =>mm/s       
  real :: qsfxy(ims:ime,jms:jme) 
  real :: qdnxy(ims:ime,jms:jme) 

  real(r8) :: alswvisdir_buf,alswvisdif_buf,alswnirdir_buf,alswnirdif_buf
  real(r8) :: swvisdir_buf,swvisdif_buf,swnirdir_buf,swnirdif_buf

  real(r8) :: albxy_buf
  real(r8) :: tsxy_buf,trefxy_buf
  real(r8) :: shxy_buf
  real(r8) :: lhxy_buf
  real(r8) :: qsfxy_buf
  real(r8) :: qdnxy_buf
  real(r8) :: soiflx_buf
  real(r8) :: sabv_buf
  real(r8) :: sabg_buf
  real(r8) :: lwup_buf
  real(r8) :: znt_buf
  real(r8) :: rhoxy_buf

  real(r8) :: swd_buf
  real(r8) :: forc_sols_buf
  real(r8) :: forc_soll_buf
  real(r8) :: forc_solsd_buf
  real(r8) :: forc_solld_buf
  real(r8) :: area_buf
  real(r8) :: forc_pbot_buf
  real(r8) :: forc_txy_buf
  real(r8) :: forc_uxy_buf
  real(r8) :: forc_vxy_buf
  real(r8) :: forc_qxy_buf
  real(r8) :: zgcmxy_buf
  real(r8) :: prec_buf
  real(r8) :: flwdsxy_buf
  real(r8) :: forc_psrfxy_buf

!ADD_NEW_VAR
  real(r8) :: forc_ndepxy_buf
!!!

  real(r8) :: xlat_buf 
  real(r8) :: xlon_buf

  real(r8),dimension(maxpatch,-nlevsno+1:nlevgrnd) :: dzclm
  real(r8),dimension(maxpatch,-nlevsno+1:nlevgrnd) :: zclm
  real(r8),dimension(maxpatch,-nlevsno:nlevgrnd)   :: ziclm

  real(r8),dimension(maxpatch,-nlevsno+1:nlevgrnd)   :: &
                          h2osoi_liq_buf, &
                          h2osoi_ice_buf, &
                          t_soisno_buf

  real(r8),dimension(maxpatch,-nlevsno+1:0) ::snw_rds_buf

      
  real(r8),dimension(maxpatch,1:num_soil_layers)   :: &
                         t_lake_buf, h2osoi_vol_buf
  integer  :: lndmsk
!------------------------------------------------------------------------
 real(r8),dimension(maxpatch) :: organic_buf

  real(r8), dimension(maxpatch)  ::                 &
                snowdp_buf,wtc_buf,wtp_buf,h2osno_buf,t_grnd_buf,t_veg_buf,         & 
                h2ocan_buf,h2ocan_col_buf,     &
                t_ref2m_buf, q_ref2m_buf,                          &
                albedosubgrid_buf, lhsubgrid_buf, hfxsubgrid_buf, lwupsubgrid_buf, &
                q2subgrid_buf,sabgsubgrid_buf,sabvsubgrid_buf,nrasubgrid_buf,swupsubgrid_buf,&
                lhsoi_buf,lhveg_buf,lhtran_buf,tlai_buf,tsai_buf,htop_buf,hbot_buf
#ifdef CN
!CROP&CN buf variables
  integer,dimension(maxpatch) :: croplive_buf
   real(r8), dimension(maxpatch)  ::  &
                 htmx_buf,gdd1020_buf,gdd820_buf,gdd020_buf,grainc_buf,grainc_storage_buf  &
                ,grainc_xfer_buf,grainn_buf,grainn_storage_buf,grainn_xfer_buf,days_active_buf  &
                ,onset_flag_buf,onset_counter_buf,onset_gddflag_buf,onset_fdd_buf,onset_gdd_buf &
                ,onset_swi_buf,offset_flag_buf,offset_counter_buf,offset_fdd_buf,offset_swi_buf &
                ,dayl_buf,annavg_t2m_buf,tempavg_t2m_buf,tempsum_potential_gpp_buf          &
                ,annsum_potential_gpp_buf,tempmax_retransn_buf,annmax_retransn_buf      &
                ,prev_leafc_to_litter_buf,prev_frootc_to_litter_buf,tempsum_npp_buf     &
                ,annsum_npp_buf,leafc_buf,leafc_storage_buf,leafc_xfer_buf,frootc_buf           &
                ,frootc_storage_buf,frootc_xfer_buf,livestemc_buf,livestemc_storage_buf     &
                ,livestemc_xfer_buf,deadstemc_buf,deadstemc_storage_buf,deadstemc_xfer_buf  &
                ,livecrootc_buf,livecrootc_storage_buf,livecrootc_xfer_buf,deadcrootc_buf   &
                ,deadcrootc_storage_buf,deadcrootc_xfer_buf,cpool_buf,pft_ctrunc_buf        &
                ,leafn_buf,leafn_storage_buf,leafn_xfer_buf,frootn_buf,frootn_storage_buf       &
                ,frootn_xfer_buf,livestemn_buf,livestemn_storage_buf,livestemn_xfer_buf     &
                ,deadstemn_buf,deadstemn_storage_buf,deadstemn_xfer_buf,livecrootn_buf      &
                ,livecrootn_storage_buf,livecrootn_xfer_buf,deadcrootn_buf              &
                ,deadcrootn_storage_buf,deadcrootn_xfer_buf,npool_buf,pft_ntrunc_buf        &
                ,gresp_storage_buf,gresp_xfer_buf,xsmrpool_buf,annsum_counter_buf           &
                ,cannsum_npp_buf,cannavg_t2m_buf,wf_buf,me_buf,mean_fire_prob_buf,cwdc_buf,litr1c_buf   &
                ,litr2c_buf,litr3c_buf,soil1c_buf,soil2c_buf,soil3c_buf,soil4c_buf,seedc_buf,col_ctrunc_buf &
                ,prod10c_buf,prod100c_buf,cwdn_buf,litr1n_buf,litr2n_buf,litr3n_buf,soil1n_buf,soil2n_buf   &
                ,soil3n_buf,soil4n_buf,seedn_buf,col_ntrunc_buf,prod10n_buf,prod100n_buf,sminn_buf&
                ,totlitc_buf,dwt_seedc_to_leaf_buf,dwt_seedc_to_deadstem_buf,dwt_conv_cflux_buf &
                ,dwt_prod10c_gain_buf,dwt_prod100c_gain_buf,prod100c_loss_buf,dwt_frootc_to_litr1c_buf &
                ,dwt_frootc_to_litr2c_buf,dwt_frootc_to_litr3c_buf,dwt_livecrootc_to_cwdc_buf &
                ,dwt_deadcrootc_to_cwdc_buf,dwt_seedn_to_leaf_buf,dwt_seedn_to_deadstem_buf &
                ,dwt_conv_nflux_buf,dwt_prod10n_gain_buf,dwt_prod100n_gain_buf,prod100n_loss_buf &
                ,dwt_frootn_to_litr1n_buf,dwt_frootn_to_litr2n_buf, dwt_frootn_to_litr3n_buf &
                , dwt_livecrootn_to_cwdn_buf,dwt_deadcrootn_to_cwdn_buf,retransn_buf  
#endif
! ----------------------------------------------------------------------
! DECLARATIONS START - urban
! ----------------------------------------------------------------------

! input variables surface_driver --> lsm 
     INTEGER, INTENT(IN) :: num_roof_layers
     INTEGER, INTENT(IN) :: num_wall_layers
     INTEGER, INTENT(IN) :: num_road_layers
     REAL, OPTIONAL, DIMENSION(1:num_roof_layers), INTENT(IN) :: DZR
     REAL, OPTIONAL, DIMENSION(1:num_wall_layers), INTENT(IN) :: DZB
     REAL, OPTIONAL, DIMENSION(1:num_road_layers), INTENT(IN) :: DZG
     REAL, OPTIONAL, INTENT(IN) :: DECLIN_URB
     REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(IN) :: COSZ_URB2D
     REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(IN) :: OMG_URB2D
     REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(IN) :: XLAT_URB2D

! input variables lsm --> urban
     INTEGER :: UTYPE_URB ! urban type [urban=1, suburban=2, rural=3]
     REAL :: TA_URB       ! potential temp at 1st atmospheric level [K]
     REAL :: QA_URB       ! mixing ratio at 1st atmospheric level  [kg/kg]
     REAL :: UA_URB       ! wind speed at 1st atmospheric level    [m/s]
     REAL :: U1_URB       ! u at 1st atmospheric level             [m/s]
     REAL :: V1_URB       ! v at 1st atmospheric level             [m/s]
     REAL :: SSG_URB      ! downward total short wave radiation    [W/m/m]
     REAL :: LLG_URB      ! downward long wave radiation           [W/m/m]
     REAL :: RAIN_URB     ! precipitation                          [mm/h]
     REAL :: RHOO_URB     ! air density                            [kg/m^3]
     REAL :: ZA_URB       ! first atmospheric level                [m]
     REAL :: DELT_URB     ! time step                              [s]
     REAL :: SSGD_URB     ! downward direct short wave radiation   [W/m/m]
     REAL :: SSGQ_URB     ! downward diffuse short wave radiation  [W/m/m]
     REAL :: XLAT_URB     ! latitude                               [deg]
     REAL :: COSZ_URB     ! cosz
     REAL :: OMG_URB      ! hour angle
     REAL :: ZNT_URB      ! roughness length                       [m]
     REAL :: TR_URB
     REAL :: TB_URB
     REAL :: TG_URB
     REAL :: TC_URB
     REAL :: QC_URB
     REAL :: UC_URB
     REAL :: XXXR_URB
     REAL :: XXXB_URB
     REAL :: XXXG_URB
     REAL :: XXXC_URB
     REAL, DIMENSION(1:num_roof_layers) :: TRL_URB  ! roof layer temp [K]
     REAL, DIMENSION(1:num_wall_layers) :: TBL_URB  ! wall layer temp [K]
     REAL, DIMENSION(1:num_road_layers) :: TGL_URB  ! road layer temp [K]
     LOGICAL  :: LSOLAR_URB

! state variable surface_driver <--> lsm <--> urban
     REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: TR_URB2D
     REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: TB_URB2D
     REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: TG_URB2D
     REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: TC_URB2D
     REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: QC_URB2D
     REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: UC_URB2D
     REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: XXXR_URB2D
     REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: XXXB_URB2D
     REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: XXXG_URB2D
     REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: XXXC_URB2D
     REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: SH_URB2D
     REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: LH_URB2D
     REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: G_URB2D
     REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: RN_URB2D
!
     REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: TS_URB2D

     REAL, OPTIONAL, DIMENSION( ims:ime, 1:num_roof_layers, jms:jme ), INTENT(INOUT) :: TRL_URB3D
     REAL, OPTIONAL, DIMENSION( ims:ime, 1:num_wall_layers, jms:jme ), INTENT(INOUT) :: TBL_URB3D
     REAL, OPTIONAL, DIMENSION( ims:ime, 1:num_road_layers, jms:jme ), INTENT(INOUT) :: TGL_URB3D

   REAL :: CMR_URB, CHR_URB, CMC_URB, CHC_URB

   REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: CMR_SFCDIF
   REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: CHR_SFCDIF
   REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: CMC_SFCDIF
   REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: CHC_SFCDIF

! output variable lsm --> surface_driver
     REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT) :: PSIM_URB2D
     REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT) :: PSIH_URB2D
     REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT) :: GZ1OZ0_URB2D
     REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT) :: U10_URB2D
     REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT) :: V10_URB2D
     REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT) :: TH2_URB2D
     REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT) :: Q2_URB2D
!
     REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT) :: AKMS_URB2D
!
     REAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT) :: UST_URB2D
     REAL, DIMENSION( ims:ime, jms:jme ), INTENT(IN) :: FRC_URB2D
     INTEGER, DIMENSION( ims:ime, jms:jme ), INTENT(IN) :: UTYPE_URB2D


! output variables urban --> lsm
     REAL :: TS_URB     ! surface radiative temperature    [K]
     REAL :: QS_URB     ! surface humidity                 [-]
     REAL :: SH_URB     ! sensible heat flux               [W/m/m]
     REAL :: LH_URB     ! latent heat flux                 [W/m/m]
     REAL :: LH_KINEMATIC_URB ! latent heat flux, kinetic  [kg/m/m/s]
     REAL :: SW_URB     ! upward short wave radiation flux [W/m/m]
     REAL :: ALB_URB    ! time-varying albedo            [fraction]
     REAL :: LW_URB     ! upward long wave radiation flux  [W/m/m]
     REAL :: G_URB      ! heat flux into the ground        [W/m/m]
     REAL :: RN_URB     ! net radiation                    [W/m/m]
     REAL :: PSIM_URB   ! shear f for momentum             [-]
     REAL :: PSIH_URB   ! shear f for heat                 [-]
     REAL :: GZ1OZ0_URB   ! shear f for heat                 [-]
     REAL :: U10_URB    ! wind u component at 10 m         [m/s]
     REAL :: V10_URB    ! wind v component at 10 m         [m/s]
     REAL :: TH2_URB    ! potential temperature at 2 m     [K]
     REAL :: Q2_URB     ! humidity at 2 m                  [-]
     REAL :: CHS_URB
     REAL :: CHS2_URB
     REAL :: UST_URB
! ----------------------------------------------------------------------
! DECLARATIONS END - urban
! ----------------------------------------------------------------------
 CHARACTER(len=24) ::  nextstep_date, cdate,simulation_start_date
 INTEGER simulation_start_year   , &
         simulation_start_month  , &
         simulation_start_day    , &
         simulation_start_hour   , &
         simulation_start_minute , &
         simulation_start_second

 integer  :: myr,mon,mday,mhr,mint,msc,mtsec,myr1,mon1,mday1,mhr1,mint1,msc1,mtsec1
 integer  :: myrs,mons,mdays,mhrs,mints,mscs,mtsecs
 integer  :: julyr,julday, julyr1,julday1
 integer  :: mbdate
 integer  :: msec,msec1
 integer  :: ns
 real(r8) :: calday,calday1
 real     :: gmt,gmt1
 integer(selected_int_kind(12))  :: idts
 integer  :: idt
 real(r8) :: dsqmin, dsq
 character*256 :: msg
 real :: mh_urb,stdh_urb,lp_urb,hgt_urb,frc_urb,lb_urb,check
 real, dimension(4) :: lf_urb
 
! ----------------------------------------------------------------------
   call clm_varpar_mod

   call CLMDebug('Now in clmdrv')

!  if((nlevsoi /= num_soil_layers) .or. (nlevlak/= num_soil_layers)) then
!    print*,'nlevsoi and nlevlak must be equal to num_soil_layers in CLM; Stop in module_sf_clm.F'
!    call endrun() 
!  end if

  dtt = dt
  
   write(msg,*) 'dt=',dt,'jts=',jts,'jte=',jte,'its=',its,'ite=',ite
   call CLMDebug(msg)

  CALL nl_get_simulation_start_year   ( 1, simulation_start_year   )
  CALL nl_get_simulation_start_month  ( 1, simulation_start_month  )
  CALL nl_get_simulation_start_day    ( 1, simulation_start_day    )
  CALL nl_get_simulation_start_hour   ( 1, simulation_start_hour   )
  CALL nl_get_simulation_start_minute ( 1, simulation_start_minute )
  CALL nl_get_simulation_start_second ( 1, simulation_start_second )
  WRITE ( simulation_start_date(1:19) , FMT = '(I4.4,"-",I2.2,"-",I2.2,"_",I2.2,":",I2.2,":",I2.2)' ) &
           simulation_start_year,simulation_start_month,simulation_start_day,&
           simulation_start_hour,simulation_start_minute,simulation_start_second
  simulation_start_date(1:24) = simulation_start_date(1:19)//'.0000'

  CALL split_date_char (simulation_start_date, myrs, mons, mdays, mhrs, mints, mscs, mtsecs) 

  idt  = nint(dtt)*nstep
  idts = nint(dtt)*nstep
  if(idt/=idts) then
     print*,'The integer idt and idts is too large; Stop in module_sf_clm.F', idt,idts
     call endrun()
  end if
  CALL geth_newdate (cdate(1:19), simulation_start_date(1:19), idt) ! dt in seconds
  cdate(1:24) = cdate(1:19)//'.0000'
  CALL split_date_char (cdate, myr, mon, mday, mhr, mint, msc, mtsec )
  CALL geth_newdate (nextstep_date(1:19), cdate(1:19), nint(dtt)) ! dtt in seconds
  nextstep_date(1:24) = nextstep_date(1:19)//'.0000'
  CALL split_date_char (nextstep_date, myr1, mon1, mday1, mhr1, mint1, msc1, mtsec1) 
  CALL get_julgmt(cdate,julyr,julday, gmt)   !module_date_time.F ../share/
  CALL get_julgmt(nextstep_date,julyr1,julday1, gmt1)

  msec  = mhr*3600  + mint*60
  msec1 = mhr1*3600 + mint1*60
  calday = julday  + gmt/24.0
  calday1= julday1 + gmt1/24.0
  mbdate = myrs*10000 + mons*100 + mdays


!write(6,*) 'at nstep=',nstep,'snowage_drdt0(1,31,8)=',snowage_drdt0(1,31,8)


  do j=jts,jte

   do i=its,ite
      if(xland(i,j) == 1.0) then
        lndmsk = 1
      else
        lndmsk = 0
      end if

  
    if(lndmsk == 1) then
      qsfxy_buf       = qsfxy(i,j)
      qdnxy_buf       = qdnxy(i,j)
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

      xlon_buf       = xlong(i,j) + 360.0
      xlat_buf       = xlat(i,j)
      albxy_buf      = albxy(i,j) 
      if(gsw(i,j)>0.0.and.albxy_buf<0.99.and.albxy_buf>0.0)then
         swd_buf     = gsw(i,j)/(1.-albxy_buf)
         swdown(i,j) = gsw(i,j)/(1.-albxy_buf)
      else
         swd_buf     = 0.0
         swdown(i,j) = 0.0
      end if

    if(ra_sw_physics .ne. 3) then   !if not CAM scheme, the use 0.35/0.15 for coupling --ylu
      forc_sols_buf  = swd_buf*0.35
      forc_soll_buf  = swd_buf*0.35
      forc_solsd_buf = swd_buf*0.15
      forc_solld_buf = swd_buf*0.15
    else                            !if use cam radiation, then we can directly use the seperate swd --ylu
      forc_sols_buf  = swvisdir(i,j)
      forc_soll_buf  = swnirdir(i,j)
      forc_solsd_buf = swvisdif(i,j)
      forc_solld_buf = swnirdif(i,j)
    end if
   

      area_buf       = dx*dx/1.e6 !(km^2)
      forc_pbot_buf  = ps(i,1,j) !Pa
      forc_txy_buf   = forc_txy(i,1,j)
      forc_uxy_buf   = forc_uxy(i,1,j)
      forc_vxy_buf   = forc_vxy(i,1,j)
      forc_qxy_buf   = forc_qxy(i,1,j)
      zgcmxy_buf     = zgcmxy(i,1,j)
      prec_buf       = prec(i,j)/dtt ! mm/s
      flwdsxy_buf    = flwdsxy(i,j)
      forc_psrfxy_buf= ps(i,1,j) ! Pa
!ADD_NEW_VAR
      forc_ndepxy_buf=ndep/(86400._r8 * 365._r8)
!!!

      efisop_buf(1:6) = efisop(1:6)
      gti_buf      = fmax


      soiflx(i,j) = 0.0
      sabv(i,j)   = 0.0
      sabg(i,j)   = 0.0
      lwup(i,j)   = 0.0
      soiflx_buf     = 0.0
      sabv_buf       = 0.0
      sabg_buf       = 0.0
      lwup_buf       = 0.0

     swvisdir_buf = swvisdir(i,j)
     swvisdif_buf = swvisdif(i,j)
     swnirdir_buf = swnirdir(i,j)
     swnirdif_buf = swnirdif(i,j)

     do m=1,maxpatch
      do k =1,nlevgrnd 
        zclm(m,k) =  0.025*(exp(0.5*(k-0.5))-1.)
      end do

       dzclm(m,1) = 0.5*(zclm(m,1)+zclm(m,2))
       do k = 2,nlevgrnd-1
         dzclm(m,k)= 0.5*(zclm(m,k+1)-zclm(m,k-1))
       enddo
       dzclm(m,nlevgrnd) = zclm(m,nlevgrnd)-zclm(m,nlevgrnd-1)

      ziclm(m,0) = 0.0
      do k =1,nlevgrnd-1 
        ziclm(m,k) =  0.5*(zclm(m,k) + zclm(m,k+1)) 
      end do
        ziclm(m,nlevgrnd) =  zclm(m,nlevgrnd) + 0.5*dzclm(m,nlevgrnd)

         dzclm(m,-4) = dzsnow5(i,m,j)
         dzclm(m,-3) = dzsnow4(i,m,j)
         dzclm(m,-2) = dzsnow3(i,m,j)
         dzclm(m,-1) = dzsnow2(i,m,j)
         dzclm(m,0)  = dzsnow1(i,m,j)


      do k=0,-nlevsno+1, -1
        zclm(m,k)     = ziclm(m,k) - 0.5*dzclm(m,k)
        ziclm(m,k-1)  = ziclm(m,k) - dzclm(m,k)
      end do

      snl1(i,m,j) = snl(i,m,j)
      snowdp_buf(m)     = snowdp(i,m,j)
!      snowage_buf(m)    = snowage(i,m,j)
      snw_rds_buf(m,-4) = snowrds5(i,m,j)
      snw_rds_buf(m,-3) = snowrds4(i,m,j)
      snw_rds_buf(m,-2) = snowrds3(i,m,j)
      snw_rds_buf(m,-1) = snowrds2(i,m,j)
      snw_rds_buf(m,0) = snowrds1(i,m,j)

      h2osoi_liq_buf(m,-4) = h2osoi_liq_s5(i,m,j)
      h2osoi_liq_buf(m,-3) = h2osoi_liq_s4(i,m,j)
      h2osoi_liq_buf(m,-2) = h2osoi_liq_s3(i,m,j)
      h2osoi_liq_buf(m,-1) = h2osoi_liq_s2(i,m,j)
      h2osoi_liq_buf(m,0)  = h2osoi_liq_s1(i,m,j)
      h2osoi_liq_buf(m,1)  = h2osoi_liq1(i,m,j)
      h2osoi_liq_buf(m,2)  = h2osoi_liq2(i,m,j)
      h2osoi_liq_buf(m,3)  = h2osoi_liq3(i,m,j)
      h2osoi_liq_buf(m,4)  = h2osoi_liq4(i,m,j)
      h2osoi_liq_buf(m,5)  = h2osoi_liq5(i,m,j)
      h2osoi_liq_buf(m,6)  = h2osoi_liq6(i,m,j)
      h2osoi_liq_buf(m,7)  = h2osoi_liq7(i,m,j)
      h2osoi_liq_buf(m,8)  = h2osoi_liq8(i,m,j)
      h2osoi_liq_buf(m,9)  = h2osoi_liq9(i,m,j)
      h2osoi_liq_buf(m,10) = h2osoi_liq10(i,m,j)

      h2osoi_ice_buf(m,-4) = h2osoi_ice_s5(i,m,j)
      h2osoi_ice_buf(m,-3) = h2osoi_ice_s4(i,m,j)
      h2osoi_ice_buf(m,-2) = h2osoi_ice_s3(i,m,j)
      h2osoi_ice_buf(m,-1) = h2osoi_ice_s2(i,m,j)
      h2osoi_ice_buf(m,0)  = h2osoi_ice_s1(i,m,j)
      h2osoi_ice_buf(m,1)  = h2osoi_ice1(i,m,j)
      h2osoi_ice_buf(m,2)  = h2osoi_ice2(i,m,j)
      h2osoi_ice_buf(m,3)  = h2osoi_ice3(i,m,j)
      h2osoi_ice_buf(m,4)  = h2osoi_ice4(i,m,j)
      h2osoi_ice_buf(m,5)  = h2osoi_ice5(i,m,j)
      h2osoi_ice_buf(m,6)  = h2osoi_ice6(i,m,j)
      h2osoi_ice_buf(m,7)  = h2osoi_ice7(i,m,j)
      h2osoi_ice_buf(m,8)  = h2osoi_ice8(i,m,j)
      h2osoi_ice_buf(m,9)  = h2osoi_ice9(i,m,j)
      h2osoi_ice_buf(m,10) = h2osoi_ice10(i,m,j)

      t_soisno_buf(m,-4) = t_soisno_s5(i,m,j)
      t_soisno_buf(m,-3) = t_soisno_s4(i,m,j)
      t_soisno_buf(m,-2) = t_soisno_s3(i,m,j)
      t_soisno_buf(m,-1) = t_soisno_s2(i,m,j)
      t_soisno_buf(m,0)  = t_soisno_s1(i,m,j)
      t_soisno_buf(m,1)  = t_soisno1(i,m,j)
      t_soisno_buf(m,2)  = t_soisno2(i,m,j)
      t_soisno_buf(m,3)  = t_soisno3(i,m,j)
      t_soisno_buf(m,4)  = t_soisno4(i,m,j)
      t_soisno_buf(m,5)  = t_soisno5(i,m,j)
      t_soisno_buf(m,6)  = t_soisno6(i,m,j)
      t_soisno_buf(m,7)  = t_soisno7(i,m,j)
      t_soisno_buf(m,8)  = t_soisno8(i,m,j)
      t_soisno_buf(m,9)  = t_soisno9(i,m,j)
      t_soisno_buf(m,10) = t_soisno10(i,m,j)


      t_lake_buf(m,1)  = t_lake1(i,m,j)
      t_lake_buf(m,2)  = t_lake2(i,m,j)
      t_lake_buf(m,3)  = t_lake3(i,m,j)
      t_lake_buf(m,4)  = t_lake4(i,m,j)
      t_lake_buf(m,5)  = t_lake5(i,m,j)
      t_lake_buf(m,6)  = t_lake6(i,m,j)
      t_lake_buf(m,7)  = t_lake7(i,m,j)
      t_lake_buf(m,8)  = t_lake8(i,m,j)
      t_lake_buf(m,9)  = t_lake9(i,m,j)
      t_lake_buf(m,10) = t_lake10(i,m,j)

      h2osoi_vol_buf(m,1)  = h2osoi_vol1(i,m,j)
      h2osoi_vol_buf(m,2)  = h2osoi_vol2(i,m,j)
      h2osoi_vol_buf(m,3)  = h2osoi_vol3(i,m,j)
      h2osoi_vol_buf(m,4)  = h2osoi_vol4(i,m,j)
      h2osoi_vol_buf(m,5)  = h2osoi_vol5(i,m,j)
      h2osoi_vol_buf(m,6)  = h2osoi_vol6(i,m,j)
      h2osoi_vol_buf(m,7)  = h2osoi_vol7(i,m,j)
      h2osoi_vol_buf(m,8)  = h2osoi_vol8(i,m,j)
      h2osoi_vol_buf(m,9)  = h2osoi_vol9(i,m,j)
      h2osoi_vol_buf(m,10) = h2osoi_vol10(i,m,j)

      t_grnd_buf(m)     = t_grnd(i,m,j)
      t_veg_buf(m)      = t_veg(i,m,j)
      h2ocan_buf(m)     = h2ocan(i,m,j)
      h2ocan_col_buf(m) = h2ocan_col(i,m,j)
      h2osno_buf(m)     = h2osno(i,m,j)
      albedosubgrid_buf(m) = albedosubgrid(i,m,j)
      lhsubgrid_buf(m)  = lhsubgrid(i,m,j)
      hfxsubgrid_buf(m) = hfxsubgrid(i,m,j)
      lwupsubgrid_buf(m)= lwupsubgrid(i,m,j)
      q2subgrid_buf(m)  = q2subgrid(i,m,j)
!ylu 01/14/09
      sabvsubgrid_buf(m) = sabvsubgrid(i,m,j)
      sabgsubgrid_buf(m) = sabgsubgrid(i,m,j)
      nrasubgrid_buf(m) = nrasubgrid(i,m,j)
      swupsubgrid_buf(m) = swupsubgrid(i,m,j)      
!ylu 04/07/09 add three component of LH to output file
     lhsoi_buf(m) = lhsoi(i,m,j)
     lhveg_buf(m) = lhveg(i,m,j)
     lhtran_buf(m) = lhtran(i,m,j) 
!!!
#ifdef CN
!ADD_NEW_VAR 02/14/2011
     tlai_buf(m) = dyntlai(i,m,j)
     tsai_buf(m) = dyntsai(i,m,j)
     htop_buf(m) = dyntop(i,m,j)
     hbot_buf(m) = dynbot(i,m,j)
#endif

     organic_buf(m) = organic(m)

      t_ref2m_buf(m)    = t_ref2m(i,m,j)
      q_ref2m_buf(m)    = q_ref2m(i,m,j)
#ifdef CN
!CROP CN VARS
!ylu 05/31/11
      htmx_buf(m)                   = htmx(i,m,j)
      croplive_buf(m)               = croplive(i,m,j)
      gdd1020_buf(m)                = gdd1020(i,m,j)
      gdd820_buf(m)                 = gdd820(i,m,j)
      gdd020_buf(m)                 = gdd020(i,m,j)
      grainc_buf(m)                 = grainc(i,m,j)
      grainc_storage_buf(m)         = grainc_storage(i,m,j)
      grainc_xfer_buf(m)            = grainc_xfer(i,m,j)
      grainn_buf(m)                 = grainn(i,m,j)
      grainn_storage_buf(m)         = grainn_storage(i,m,j)
      grainn_xfer_buf(m)            = grainn_xfer(i,m,j)
      days_active_buf(m)            = days_active(i,m,j)
      onset_flag_buf(m)             = onset_flag(i,m,j)
      onset_counter_buf(m)          = onset_counter(i,m,j)
      onset_gddflag_buf(m)          = onset_gddflag(i,m,j)
      onset_fdd_buf(m)              = onset_fdd(i,m,j) 
      onset_gdd_buf(m)              = onset_gdd(i,m,j)
      onset_swi_buf(m)              = onset_swi(i,m,j)
      offset_flag_buf(m)            = offset_flag(i,m,j)
      offset_counter_buf(m)         = offset_counter(i,m,j)
      offset_fdd_buf(m)             = offset_fdd(i,m,j)
      offset_swi_buf(m)             = offset_swi(i,m,j)
      dayl_buf(m)                   = dayl(i,m,j)
      annavg_t2m_buf(m)             = annavg_t2m(i,m,j)
      tempavg_t2m_buf(m)            = tempavg_t2m(i,m,j)
      tempsum_potential_gpp_buf(m)  = tempsum_potential_gpp(i,m,j)
      annsum_potential_gpp_buf(m)   = annsum_potential_gpp(i,m,j)
      tempmax_retransn_buf(m)       = tempmax_retransn(i,m,j)
      annmax_retransn_buf(m)        = annmax_retransn(i,m,j)
      prev_leafc_to_litter_buf(m)   = prev_leafc_to_litter(i,m,j)
      prev_frootc_to_litter_buf(m)  = prev_frootc_to_litter(i,m,j)
      tempsum_npp_buf(m)            = tempsum_npp(i,m,j)
      annsum_npp_buf(m)             = annsum_npp(i,m,j)
      leafc_buf(m)                  = leafc(i,m,j)
      leafc_storage_buf(m)          = leafc_storage(i,m,j)
      leafc_xfer_buf(m)             = leafc_xfer(i,m,j)
      frootc_buf(m)                 = frootc(i,m,j)
      frootc_storage_buf(m)         = frootc_storage(i,m,j)
      frootc_xfer_buf(m)            = frootc_xfer(i,m,j)
      livestemc_buf(m)              = livestemc(i,m,j)
      livestemc_storage_buf(m)      = livestemc_storage(i,m,j)
      livestemc_xfer_buf(m)         = livestemc_xfer(i,m,j)
      deadstemc_buf(m)              = deadstemc(i,m,j)
      deadstemc_storage_buf(m)      = deadstemc_storage(i,m,j)
      deadstemc_xfer_buf(m)         = deadstemc_xfer(i,m,j)
      livecrootc_buf(m)             = livecrootc(i,m,j)
      livecrootc_storage_buf(m)     = livecrootc_storage(i,m,j)
      livecrootc_xfer_buf(m)        = livecrootc_xfer(i,m,j)
      deadcrootc_buf(m)             = deadcrootc(i,m,j)
      deadcrootc_storage_buf(m)     = deadcrootc_storage(i,m,j)
      deadcrootc_xfer_buf(m)        = deadcrootc_xfer(i,m,j)
      cpool_buf(m)                  = cpool(i,m,j)
      pft_ctrunc_buf(m)             = pft_ctrunc(i,m,j)
      leafn_buf(m)                  = leafn(i,m,j)
      leafn_storage_buf(m)          = leafn_storage(i,m,j)
      leafn_xfer_buf(m)             = leafn_xfer(i,m,j)
      frootn_buf(m)                 = frootn(i,m,j)
      frootn_storage_buf(m)         = frootn_storage(i,m,j)
      frootn_xfer_buf(m)            = frootn_xfer(i,m,j)
      livestemn_buf(m)              = livestemn(i,m,j)
      livestemn_storage_buf(m)      = livestemn_storage(i,m,j)
      livestemn_xfer_buf(m)         = livestemn_xfer(i,m,j)
      deadstemn_buf(m)              = deadstemn(i,m,j)
      deadstemn_storage_buf(m)      = deadstemn_storage(i,m,j)
      deadstemn_xfer_buf(m)         = deadstemn_xfer(i,m,j)
      livecrootn_buf(m)             = livecrootn(i,m,j)
      livecrootn_storage_buf(m)     = livecrootn_storage(i,m,j)
      livecrootn_xfer_buf(m)        = livecrootn_xfer(i,m,j)
      deadcrootn_buf(m)             = deadcrootn(i,m,j)
      deadcrootn_storage_buf(m)     = deadcrootn_storage(i,m,j)
      deadcrootn_xfer_buf(m)        = deadcrootn_xfer(i,m,j)
      npool_buf(m)                  = npool(i,m,j)
      pft_ntrunc_buf(m)             = pft_ntrunc(i,m,j)
      gresp_storage_buf(m)          = gresp_storage(i,m,j)
      gresp_xfer_buf(m)             = gresp_xfer(i,m,j)
      xsmrpool_buf(m)               = xsmrpool(i,m,j)
      annsum_counter_buf(m)         = annsum_counter(i,m,j)
      cannsum_npp_buf(m)            = cannsum_npp(i,m,j)
      cannavg_t2m_buf(m)            = cannavg_t2m(i,m,j)
      wf_buf(m)                     = wf(i,m,j)
      me_buf(m)                     = me(i,m,j)
      mean_fire_prob_buf(m)         = mean_fire_prob(i,m,j)
      cwdc_buf(m)                   = cwdc(i,m,j)
      litr1c_buf(m)                 = litr1c(i,m,j)
      litr2c_buf(m)                 = litr2c(i,m,j)
      litr3c_buf(m)                 = litr3c(i,m,j)
      soil1c_buf(m)                 = soil1c(i,m,j)
      soil2c_buf(m)                 = soil2c(i,m,j)
      soil3c_buf(m)                 = soil3c(i,m,j)
      soil4c_buf(m)                 = soil4c(i,m,j)
      seedc_buf(m)                  = seedc(i,m,j)
      col_ctrunc_buf(m)             = col_ctrunc(i,m,j)
      prod10c_buf(m)                = prod10c(i,m,j)
      prod100c_buf(m)               = prod100c(i,m,j)
      cwdn_buf(m)                   = cwdn(i,m,j)
      litr1n_buf(m)                 = litr1n(i,m,j)
      litr2n_buf(m)                 = litr2n(i,m,j)
      litr3n_buf(m)                 = litr3n(i,m,j)
      soil1n_buf(m)                 = soil1n(i,m,j)
      soil2n_buf(m)                 = soil2n(i,m,j)
      soil3n_buf(m)                 = soil3n(i,m,j)
      soil4n_buf(m)                 = soil4n(i,m,j)
      seedn_buf(m)                  = seedn(i,m,j)
      col_ntrunc_buf(m)             = col_ntrunc(i,m,j)
      prod10n_buf(m)                = prod10n(i,m,j)
      prod100n_buf(m)               = prod100n(i,m,j)
      sminn_buf(m)                  = sminn(i,m,j)

      totlitc_buf(m)                = totlitc(i,m,j)
      dwt_seedc_to_leaf_buf(m)      = dwt_seedc_to_leaf(i,m,j)
      dwt_seedc_to_deadstem_buf(m)  = dwt_seedc_to_deadstem(i,m,j)
      dwt_conv_cflux_buf(m)         = dwt_conv_cflux(i,m,j) 
      dwt_prod10c_gain_buf(m)       = dwt_prod10c_gain(i,m,j)
      dwt_prod100c_gain_buf(m)      = dwt_prod100c_gain(i,m,j)
      prod100c_loss_buf(m)          = prod100c_loss(i,m,j)
      dwt_frootc_to_litr1c_buf(m)   = dwt_frootc_to_litr1c(i,m,j)
      dwt_frootc_to_litr2c_buf(m)   = dwt_frootc_to_litr2c(i,m,j)
      dwt_frootc_to_litr3c_buf(m)   = dwt_frootc_to_litr3c(i,m,j)
      dwt_livecrootc_to_cwdc_buf(m) = dwt_livecrootc_to_cwdc(i,m,j)
      dwt_deadcrootc_to_cwdc_buf(m) = dwt_deadcrootc_to_cwdc(i,m,j)
      dwt_seedn_to_leaf_buf(m)      = dwt_seedn_to_leaf(i,m,j)
      dwt_seedn_to_deadstem_buf(m)  = dwt_seedn_to_deadstem(i,m,j)
      dwt_conv_nflux_buf(m)         = dwt_conv_nflux(i,m,j)
      dwt_prod10n_gain_buf(m)       = dwt_prod10n_gain(i,m,j)
      dwt_prod100n_gain_buf(m)      = dwt_prod100n_gain(i,m,j)
      prod100n_loss_buf(m)          = prod100n_loss(i,m,j)
      dwt_frootn_to_litr1n_buf(m)   = dwt_frootn_to_litr1n(i,m,j)
      dwt_frootn_to_litr2n_buf(m)   = dwt_frootn_to_litr2n(i,m,j)
      dwt_frootn_to_litr3n_buf(m)   = dwt_frootn_to_litr3n(i,m,j)
      dwt_livecrootn_to_cwdn_buf(m) = dwt_livecrootn_to_cwdn(i,m,j)
      dwt_deadcrootn_to_cwdn_buf(m) = dwt_deadcrootn_to_cwdn(i,m,j)
      retransn_buf(m)               = retransn(i,m,j)
#endif
    end do !!!!!!!!!!!!!!!!! m=1, maxpatch
       
   !  if(lndmsk  == 1) then

          call clm(forc_txy_buf        ,forc_uxy_buf           ,forc_vxy_buf    &
                  ,forc_qxy_buf        ,zgcmxy_buf             ,prec_buf        &
                  ,flwdsxy_buf         ,forc_sols_buf          ,forc_soll_buf   &
                  ,forc_solsd_buf      ,forc_solld_buf         ,forc_pbot_buf   &
                  ,forc_psrfxy_buf     ,ivgtyp(i,j)            ,isltyp(i,j)     &
                  ,lndmsk              ,xlat_buf               ,xlon_buf        &
                  ,area_buf            ,dtt                    ,myr             &
                  ,mon                 ,mday                   ,msec            &
                  ,calday              ,myr1                   ,mon1            &
                  ,mday1               ,msec1                  ,calday1         &
                  ,mbdate              ,qsfxy_buf              ,qdnxy_buf       &
                  ,snl1(i,:,j)          ,snowdp_buf            ,snw_rds_buf     & 
                  ,dzclm               ,zclm                   ,ziclm           &
                  ,h2osno_buf          ,h2osoi_liq_buf         ,h2osoi_ice_buf  &
                  ,t_grnd_buf          ,t_soisno_buf           ,t_lake_buf      &
                  ,t_veg_buf           ,h2ocan_buf             ,h2ocan_col_buf  &
                  ,h2osoi_vol_buf      ,wtc_buf                ,wtp_buf         &
                  ,numc(i,j)           ,nump(i,j)                &
                  ,t_ref2m_buf         ,albxy_buf        ,tsxy_buf,  trefxy_buf        &
                  ,shxy_buf            ,lhxy_buf               ,nstep           &
                  ,inest               ,i                      ,j               &
                  ,soiflx_buf          ,sabv_buf               ,sabg_buf        &
                  ,lwup_buf            ,znt_buf                ,q_ref2m_buf     &
                  ,rhoxy_buf                                                    &
                  ,albedosubgrid_buf   ,lhsubgrid_buf          ,hfxsubgrid_buf  &
                  ,lwupsubgrid_buf     ,q2subgrid_buf          ,sabvsubgrid_buf &
                  ,sabgsubgrid_buf     ,nrasubgrid_buf         ,swupsubgrid_buf &
                  ,lhsoi_buf          ,lhveg_buf               ,lhtran_buf      &
                  ,organic_buf        ,efisop_buf              ,gti_buf         &
                  ,alswnirdir_buf  ,alswnirdif_buf,alswvisdir_buf,alswvisdif_buf&
#ifdef CN
!CROP and CN restart and outputs
                ,forc_ndepxy_buf    ,organic_buf  ,tlai_buf ,tsai_buf,htop_buf,hbot_buf    &  !ADD_NEW_VAR
                ,htmx_buf,croplive_buf,gdd1020_buf,gdd820_buf,gdd020_buf,grainc_buf,grainc_storage_buf  &
                ,grainc_xfer_buf,grainn_buf,grainn_storage_buf,grainn_xfer_buf,days_active_buf  &
                ,onset_flag_buf,onset_counter_buf,onset_gddflag_buf,onset_fdd_buf,onset_gdd_buf &
                ,onset_swi_buf,offset_flag_buf,offset_counter_buf,offset_fdd_buf,offset_swi_buf &
                ,dayl_buf,annavg_t2m_buf,tempavg_t2m_buf,tempsum_potential_gpp_buf          &
                ,annsum_potential_gpp_buf,tempmax_retransn_buf,annmax_retransn_buf      &
                ,prev_leafc_to_litter_buf,prev_frootc_to_litter_buf,tempsum_npp_buf     &
                ,annsum_npp_buf,leafc_buf,leafc_storage_buf,leafc_xfer_buf,frootc_buf           &
                ,frootc_storage_buf,frootc_xfer_buf,livestemc_buf,livestemc_storage_buf     &
                ,livestemc_xfer_buf,deadstemc_buf,deadstemc_storage_buf,deadstemc_xfer_buf  &
                ,livecrootc_buf,livecrootc_storage_buf,livecrootc_xfer_buf,deadcrootc_buf   &
                ,deadcrootc_storage_buf,deadcrootc_xfer_buf,cpool_buf,pft_ctrunc_buf        &
                ,leafn_buf,leafn_storage_buf,leafn_xfer_buf,frootn_buf,frootn_storage_buf       &
                ,frootn_xfer_buf,livestemn_buf,livestemn_storage_buf,livestemn_xfer_buf     &
                ,deadstemn_buf,deadstemn_storage_buf,deadstemn_xfer_buf,livecrootn_buf      &
                ,livecrootn_storage_buf,livecrootn_xfer_buf,deadcrootn_buf              &
                ,deadcrootn_storage_buf,deadcrootn_xfer_buf,npool_buf,pft_ntrunc_buf        &
                ,gresp_storage_buf,gresp_xfer_buf,xsmrpool_buf,annsum_counter_buf           &
                ,cannsum_npp_buf,cannavg_t2m_buf,wf_buf,me_buf,mean_fire_prob_buf,cwdc_buf,litr1c_buf   &
                ,litr2c_buf,litr3c_buf,soil1c_buf,soil2c_buf,soil3c_buf,soil4c_buf,seedc_buf,col_ctrunc_buf &
                ,prod10c_buf,prod100c_buf,cwdn_buf,litr1n_buf,litr2n_buf,litr3n_buf,soil1n_buf,soil2n_buf   &
                ,soil3n_buf,soil4n_buf,seedn_buf,col_ntrunc_buf,prod10n_buf,prod100n_buf,sminn_buf &
               ,totlitc_buf,dwt_seedc_to_leaf_buf,dwt_seedc_to_deadstem_buf,dwt_conv_cflux_buf &
                ,dwt_prod10c_gain_buf,dwt_prod100c_gain_buf,prod100c_loss_buf,dwt_frootc_to_litr1c_buf &
                ,dwt_frootc_to_litr2c_buf,dwt_frootc_to_litr3c_buf,dwt_livecrootc_to_cwdc_buf &
                ,dwt_deadcrootc_to_cwdc_buf,dwt_seedn_to_leaf_buf,dwt_seedn_to_deadstem_buf &
                ,dwt_conv_nflux_buf,dwt_prod10n_gain_buf,dwt_prod100n_gain_buf,prod100n_loss_buf &
                ,dwt_frootn_to_litr1n_buf,dwt_frootn_to_litr2n_buf, dwt_frootn_to_litr3n_buf &
                , dwt_livecrootn_to_cwdn_buf,dwt_deadcrootn_to_cwdn_buf,retransn_buf &                                                 
#endif
                  )
                 
                 if(albxy_buf ==  1) albxy_buf = 0.991

                  albxy(i,j)          = albxy_buf
                  call CLMDebug('get albxy')
                  snowh(i,j)          = sum(snowdp_buf(1:numc(i,j))*wtc_buf(1:numc(i,j)))
                  call CLMDebug('get snowh')
                  snow(i,j)           = sum(h2osno_buf(1:numc(i,j))*wtc_buf(1:numc(i,j)))
                  call CLMDebug('get snow')
                  canwat(i,j)         = sum(h2ocan_buf(1:nump(i,j))*wtp_buf(1:nump(i,j)))
                 call CLMDebug('get canwat') 
              if (ivgtyp(i,j) /= 16 .and. ivgtyp(i,j) /= 24) then
                  do k=1,nlevgrnd
                     smois(i,k,j)     = sum(h2osoi_vol_buf(1:numc(i,j),k)*wtc_buf(1:numc(i,j)))
                     tslb (i,k,j)     = sum(t_soisno_buf(1:numc(i,j),k)*wtc_buf(1:numc(i,j)))
                  end do !over levels
              end if
                  call CLMDebug('get tslb')
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

                  tsxy(i,j)           = tsxy_buf
                  qsfxy(i,j)          = qsfxy_buf
                  qdnxy(i,j)          = qdnxy_buf
                  soiflx(i,j)         = soiflx_buf
                  sabv(i,j)           = sabv_buf
                  sabg(i,j)           = sabg_buf
                  lwup(i,j)           = lwup_buf
                  znt(i,j)            = znt_buf
                  z0(i,j)             = znt(i,j)
                  alswvisdir(i,j)     = alswvisdir_buf
                  alswvisdif(i,j)     = alswvisdif_buf
                  alswnirdir(i,j)     = alswnirdir_buf
                  alswnirdif(i,j)     = alswnirdif_buf

                  t2clm(i,j)       = trefxy_buf
!Accumulate T2 MAX/MIN between history interval --Yaqiong Lu
                  if(mod(dt*(nstep-1),60.*history_interval)==0) then 
                    t2m_max(i,j) = 0.0
                    t2m_min(i,j) = 999.0
                  else
                    t2m_max(i,j) = max(t2m_max(i,j),t2clm(i,j)) !the t2m_max/min will save the max/min along each history interval chunk.  
                    t2m_min(i,j) = min(t2m_min(i,j),t2clm(i,j))
                  end if
             call CLMDebug('module clm mark1')
                  emiss(i,j) = lwup(i,j)/(sb * tsxy(i,j)**4)
                  shxy(i,j)           = shxy_buf
                  lhxy(i,j)           = lhxy_buf
                  if(tsxy(i,j)>=tfrz) then
                    qfx(i,j)          = lhxy_buf/hvap ! heat flux (W/m^2)=>mass flux(kg/(sm^2))
                  else
                    qfx(i,j)          = lhxy_buf/hsub ! heat flux (W/m^2)=>mass flux(kg/(sm^2))     
                  end if
                  
                  qsfc(i,j)  = forc_qxy(i,1,j) +qfx(i,j)/(rhoxy_buf*chs(i,j))

              do m=1,maxpatch
                  snowdp(i,m,j)       = snowdp_buf(m)
      !            snowage(i,m,j)      = snowage_buf(m)
 
                  snl(i,m,j)         = snl1(i,m,j)

                  dzsnow5(i,m,j)      = dzclm(m,-4)
                  dzsnow4(i,m,j)      = dzclm(m,-3)
                  dzsnow3(i,m,j)      = dzclm(m,-2)
                  dzsnow2(i,m,j)      = dzclm(m,-1)
                  dzsnow1(i,m,j)      = dzclm(m,0)

                  snowrds5(i,m,j)     = snw_rds_buf(m,-4)
                  snowrds4(i,m,j)     = snw_rds_buf(m,-3)
                  snowrds3(i,m,j)     = snw_rds_buf(m,-2)
                  snowrds2(i,m,j)     = snw_rds_buf(m,-1)
                  snowrds1(i,m,j)     = snw_rds_buf(m,0)

                  h2osno(i,m,j)       = h2osno_buf(m)
                  t_grnd(i,m,j)       = t_grnd_buf(m)
                  t_veg(i,m,j)        = t_veg_buf(m)
                  h2ocan(i,m,j)       = h2ocan_buf(m)
                  h2ocan_col(i,m,j)   = h2ocan_col_buf(m)
                  wtc(i,m,j)          = wtc_buf(m)
                  wtp(i,m,j)          = wtp_buf(m)
            call CLMDebug('module clm mark2')
                  
                  h2osoi_liq_s5(i,m,j) = h2osoi_liq_buf(m,-4)
                  h2osoi_liq_s4(i,m,j) = h2osoi_liq_buf(m,-3)
                  h2osoi_liq_s3(i,m,j) = h2osoi_liq_buf(m,-2)
                  h2osoi_liq_s2(i,m,j) = h2osoi_liq_buf(m,-1)
                  h2osoi_liq_s1(i,m,j) = h2osoi_liq_buf(m,0)
                  h2osoi_liq1(i,m,j)   = h2osoi_liq_buf(m,1)
                  h2osoi_liq2(i,m,j)   = h2osoi_liq_buf(m,2)
                  h2osoi_liq3(i,m,j)   = h2osoi_liq_buf(m,3)
                  h2osoi_liq4(i,m,j)   = h2osoi_liq_buf(m,4)
                  h2osoi_liq5(i,m,j)   = h2osoi_liq_buf(m,5)
                  h2osoi_liq6(i,m,j)   = h2osoi_liq_buf(m,6)
                  h2osoi_liq7(i,m,j)   = h2osoi_liq_buf(m,7)
                  h2osoi_liq8(i,m,j)   = h2osoi_liq_buf(m,8)
                  h2osoi_liq9(i,m,j)   = h2osoi_liq_buf(m,9)
                  h2osoi_liq10(i,m,j)  = h2osoi_liq_buf(m,10)

                  h2osoi_ice_s5(i,m,j) = h2osoi_ice_buf(m,-4)
                  h2osoi_ice_s4(i,m,j) = h2osoi_ice_buf(m,-3)
                  h2osoi_ice_s3(i,m,j) = h2osoi_ice_buf(m,-2)
                  h2osoi_ice_s2(i,m,j) = h2osoi_ice_buf(m,-1)
                  h2osoi_ice_s1(i,m,j) = h2osoi_ice_buf(m,0)
                  h2osoi_ice1(i,m,j)   = h2osoi_ice_buf(m,1)
                  h2osoi_ice2(i,m,j)   = h2osoi_ice_buf(m,2)
                  h2osoi_ice3(i,m,j)   = h2osoi_ice_buf(m,3)
                  h2osoi_ice4(i,m,j)   = h2osoi_ice_buf(m,4)
                  h2osoi_ice5(i,m,j)   = h2osoi_ice_buf(m,5)
                  h2osoi_ice6(i,m,j)   = h2osoi_ice_buf(m,6)
                  h2osoi_ice7(i,m,j)   = h2osoi_ice_buf(m,7)
                  h2osoi_ice8(i,m,j)   = h2osoi_ice_buf(m,8)
                  h2osoi_ice9(i,m,j)   = h2osoi_ice_buf(m,9)
                  h2osoi_ice10(i,m,j)  = h2osoi_ice_buf(m,10)

            call CLMDebug('module clm mark3')

                  t_soisno_s5(i,m,j) = t_soisno_buf(m,-4)
                  t_soisno_s4(i,m,j) = t_soisno_buf(m,-3)
                  t_soisno_s3(i,m,j) = t_soisno_buf(m,-2)
                  t_soisno_s2(i,m,j) = t_soisno_buf(m,-1)
                  t_soisno_s1(i,m,j) = t_soisno_buf(m,0)
                  t_soisno1(i,m,j)   = t_soisno_buf(m,1)
                  t_soisno2(i,m,j)   = t_soisno_buf(m,2)
                  t_soisno3(i,m,j)   = t_soisno_buf(m,3)
                  t_soisno4(i,m,j)   = t_soisno_buf(m,4)
                  t_soisno5(i,m,j)   = t_soisno_buf(m,5)
                  t_soisno6(i,m,j)   = t_soisno_buf(m,6)
                  t_soisno7(i,m,j)   = t_soisno_buf(m,7)
                  t_soisno8(i,m,j)   = t_soisno_buf(m,8)
                  t_soisno9(i,m,j)   = t_soisno_buf(m,9)
                  t_soisno10(i,m,j)  = t_soisno_buf(m,10)


                  t_lake1(i,m,j)   = t_lake_buf(m,1)
                  t_lake2(i,m,j)   = t_lake_buf(m,2)
                  t_lake3(i,m,j)   = t_lake_buf(m,3)
                  t_lake4(i,m,j)   = t_lake_buf(m,4)
                  t_lake5(i,m,j)   = t_lake_buf(m,5)
                  t_lake6(i,m,j)   = t_lake_buf(m,6)
                  t_lake7(i,m,j)   = t_lake_buf(m,7)
                  t_lake8(i,m,j)   = t_lake_buf(m,8)
                  t_lake9(i,m,j)   = t_lake_buf(m,9)
                  t_lake10(i,m,j)  = t_lake_buf(m,10)

                  h2osoi_vol1(i,m,j)   = h2osoi_vol_buf(m,1)
                  h2osoi_vol2(i,m,j)   = h2osoi_vol_buf(m,2)
                  h2osoi_vol3(i,m,j)   = h2osoi_vol_buf(m,3)
                  h2osoi_vol4(i,m,j)   = h2osoi_vol_buf(m,4)
                  h2osoi_vol5(i,m,j)   = h2osoi_vol_buf(m,5)
                  h2osoi_vol6(i,m,j)   = h2osoi_vol_buf(m,6)
                  h2osoi_vol7(i,m,j)   = h2osoi_vol_buf(m,7)
                  h2osoi_vol8(i,m,j)   = h2osoi_vol_buf(m,8)
                  h2osoi_vol9(i,m,j)   = h2osoi_vol_buf(m,9)
                  h2osoi_vol10(i,m,j)  = h2osoi_vol_buf(m,10)

            call CLMDebug('module clm mark4')

                  t_ref2m(i,m,j)      = t_ref2m_buf(m)    
                  q_ref2m(i,m,j)      = q_ref2m_buf(m)
!!!!New patch-level variables
                  albedosubgrid(i,m,j)= albedosubgrid_buf(m)
                  lhsubgrid(i,m,j)    = lhsubgrid_buf(m)
                  hfxsubgrid(i,m,j)   = hfxsubgrid_buf(m)
                  lwupsubgrid(i,m,j)  = lwupsubgrid_buf(m)
                  q2subgrid(i,m,j)    = q2subgrid_buf(m)
!!ylu 01/14/09
                  sabvsubgrid(i,m,j)  = sabvsubgrid_buf(m)
                  sabgsubgrid(i,m,j)  = sabgsubgrid_buf(m)
                  nrasubgrid(i,m,j)   = nrasubgrid_buf(m)
                  swupsubgrid(i,m,j)  = swupsubgrid_buf(m)
!ylu 04/07/09
                  lhsoi(i,m,j)       = lhsoi_buf(m)
                  lhveg(i,m,j)       = lhveg_buf(m)
                  lhtran(i,m,j)      = lhtran_buf(m)
#ifdef CN                  
                  dyntlai(i,m,j)     = tlai_buf(m)
                  dyntsai(i,m,j)     = tsai_buf(m)
                  dyntop(i,m,j)      = htop_buf(m)
                  dynbot(i,m,j)      = hbot_buf(m)

            call CLMDebug('module clm mark5')
!CROP CN VARS
!ylu 05/31/11
                    htmx(i,m,j)                        = htmx_buf(m)
                    croplive(i,m,j)                    = croplive_buf(m)
                    gdd1020(i,m,j)                     = gdd1020_buf(m)
                    gdd820(i,m,j)                      = gdd820_buf(m)
                    gdd020(i,m,j)                      = gdd020_buf(m)
                    grainc(i,m,j)                      = grainc_buf(m)
                    grainc_storage(i,m,j)              = grainc_storage_buf(m) 
                    grainc_xfer(i,m,j)                 = grainc_xfer_buf(m)
                    grainn(i,m,j)                      = grainn_buf(m)
                    grainn_storage(i,m,j)              = grainn_storage_buf(m)
                    grainn_xfer(i,m,j)                 = grainn_xfer_buf(m)
                    days_active(i,m,j)                 = days_active_buf(m)
                    onset_flag(i,m,j)                  = onset_flag_buf(m)
                    onset_counter(i,m,j)               = onset_counter_buf(m)
                    onset_gddflag(i,m,j)               = onset_gddflag_buf(m)
                    onset_fdd(i,m,j)                   = onset_fdd_buf(m)
                    onset_gdd(i,m,j)                   = onset_gdd_buf(m)
                    onset_swi(i,m,j)                   = onset_swi_buf(m)
                    offset_flag(i,m,j)                 = offset_flag_buf(m) 
                    offset_counter(i,m,j)              = offset_counter_buf(m)
                    offset_fdd(i,m,j)                  = offset_fdd_buf(m)
                    offset_swi(i,m,j)                  = offset_swi_buf(m)
                    dayl(i,m,j)                        = dayl_buf(m)
                    annavg_t2m(i,m,j)                  = annavg_t2m_buf(m)
                    tempavg_t2m(i,m,j)                 = tempavg_t2m_buf(m)
                    tempsum_potential_gpp(i,m,j)       = tempsum_potential_gpp_buf(m)
                    annsum_potential_gpp(i,m,j)        = annsum_potential_gpp_buf(m)
                    tempmax_retransn(i,m,j)            = tempmax_retransn_buf(m)
                    annmax_retransn(i,m,j)             = annmax_retransn_buf(m) 
                    prev_leafc_to_litter(i,m,j)        = prev_leafc_to_litter_buf(m)
                    prev_frootc_to_litter(i,m,j)       = prev_frootc_to_litter_buf(m)
                    tempsum_npp(i,m,j)                 = tempsum_npp_buf(m)
                    annsum_npp(i,m,j)                  = annsum_npp_buf(m)
                    leafc(i,m,j)                       = annsum_npp_buf(m)
                    leafc_storage(i,m,j)               = leafc_storage_buf(m)
                    leafc_xfer(i,m,j)                  = leafc_xfer_buf(m)
                    frootc(i,m,j)                      = frootc_buf(m)
                    frootc_storage(i,m,j)              = frootc_storage_buf(m)
                    frootc_xfer(i,m,j)                 = frootc_xfer_buf(m)
                    livestemc(i,m,j)                   = livestemc_buf(m)
                    livestemc_storage(i,m,j)           = livestemc_storage_buf(m)
                    livestemc_xfer(i,m,j)              = livestemc_xfer_buf(m)
                    deadstemc(i,m,j)                   = deadstemc_buf(m)
                    deadstemc_storage(i,m,j)           = deadstemc_storage_buf(m)
                    deadstemc_xfer(i,m,j)              = deadstemc_xfer_buf(m)
                    livecrootc(i,m,j)                  = livecrootc_buf(m)
                    livecrootc_storage(i,m,j)          = livecrootc_storage_buf(m)
                    livecrootc_xfer(i,m,j)             = livecrootc_xfer_buf(m)
                    deadcrootc(i,m,j)                  = deadcrootc_buf(m)
                    deadcrootc_storage(i,m,j)          = deadcrootc_storage_buf(m)
                    deadcrootc_xfer(i,m,j)             = deadcrootc_xfer_buf(m)
                    cpool(i,m,j)                       = cpool_buf(m)
                    pft_ctrunc(i,m,j)                  = pft_ctrunc_buf(m)
                    leafn(i,m,j)                       = leafn_buf(m)
                    leafn_storage(i,m,j)               = leafn_storage_buf(m)
                    leafn_xfer(i,m,j)                  = leafn_xfer_buf(m)
                    frootn(i,m,j)                      = frootn_buf(m)
                    frootn_storage(i,m,j)              = frootn_storage_buf(m)
                    frootn_xfer(i,m,j)                 = frootn_xfer_buf(m)
                    livestemn(i,m,j)                   = livestemn_buf(m)
                    livestemn_storage(i,m,j)           = livestemn_storage_buf(m)
                    livestemn_xfer(i,m,j)              = livestemn_xfer_buf(m)
                    deadstemn(i,m,j)                   = deadstemn_buf(m)
                    deadstemn_storage(i,m,j)           = deadstemn_storage_buf(m)
                    deadstemn_xfer(i,m,j)              = deadstemn_xfer_buf(m)
                    livecrootn(i,m,j)                  = livecrootn_buf(m)
                    livecrootn_storage(i,m,j)          = livecrootn_storage_buf(m)
                    livecrootn_xfer(i,m,j)             = livecrootn_xfer_buf(m)
                    deadcrootn(i,m,j)                  = deadcrootn_buf(m)
                    deadcrootn_storage(i,m,j)          = deadcrootn_storage_buf(m)
                    deadcrootn_xfer(i,m,j)             = deadcrootn_xfer_buf(m)
                    npool(i,m,j)                       = npool_buf(m)
                    pft_ntrunc(i,m,j)                  = pft_ntrunc_buf(m)
                    gresp_storage(i,m,j)               = gresp_storage_buf(m)
                    gresp_xfer(i,m,j)                  = gresp_xfer_buf(m) 
                    xsmrpool(i,m,j)                    = xsmrpool_buf(m)
                    annsum_counter(i,m,j)              = annsum_counter_buf(m)
                    cannsum_npp(i,m,j)                 = cannsum_npp_buf(m)
                    cannavg_t2m(i,m,j)                 = cannavg_t2m_buf(m)
                    wf(i,m,j)                          = wf_buf(m)
                    me(i,m,j)                          = me_buf(m)
                    mean_fire_prob(i,m,j)              = mean_fire_prob_buf(m)
                    cwdc(i,m,j)                        = cwdc_buf(m)
                    litr1c(i,m,j)                      = litr1c_buf(m)
                    litr2c(i,m,j)                      = litr2c_buf(m)
                    litr3c(i,m,j)                      = litr3c_buf(m) 
                    soil1c(i,m,j)                      = soil1c_buf(m)
                    soil2c(i,m,j)                      = soil2c_buf(m)
                    soil3c(i,m,j)                      = soil3c_buf(m)
                    soil4c(i,m,j)                      = soil4c_buf(m)
                    seedc(i,m,j)                       = seedc_buf(m)
                    col_ctrunc(i,m,j)                  = col_ctrunc_buf(m)
                    prod10c(i,m,j)                     = prod10c_buf(m)
                    prod100c(i,m,j)                    = prod100c_buf(m)
                    cwdn(i,m,j)                        = cwdn_buf(m)
                    litr1n(i,m,j)                      = litr1n_buf(m) 
                    litr2n(i,m,j)                      = litr2n_buf(m)
                    litr3n(i,m,j)                      = litr3n_buf(m) 
                    soil1n(i,m,j)                      = soil1n_buf(m)
                    soil2n(i,m,j)                      = soil2n_buf(m)
                    soil3n(i,m,j)                      = soil3n_buf(m)
                    soil4n(i,m,j)                      = soil4n_buf(m)
                    seedn(i,m,j)                       = seedn_buf(m)
                    col_ntrunc(i,m,j)                  = col_ntrunc_buf(m)
                    prod10n(i,m,j)                     = prod10n_buf(m)
                    prod100n(i,m,j)                    = prod100n_buf(m)
                    sminn(i,m,j)                       = sminn_buf(m) 
                    totlitc(i,m,j)                     = totlitc_buf(m)
                    dwt_seedc_to_leaf(i,m,j)           = dwt_seedc_to_leaf_buf(m)
                    dwt_seedc_to_deadstem(i,m,j)       = dwt_seedc_to_deadstem_buf(m)
                    dwt_conv_cflux(i,m,j)              = dwt_conv_cflux_buf(m)
                    dwt_prod10c_gain(i,m,j)            = dwt_prod10c_gain_buf(m)
                    dwt_prod100c_gain(i,m,j)           = dwt_prod100c_gain_buf(m)
                    prod100c_loss(i,m,j)               = prod100c_loss_buf(m)
                    dwt_frootc_to_litr1c(i,m,j)        = dwt_frootc_to_litr1c_buf(m)
                    dwt_frootc_to_litr2c(i,m,j)        = dwt_frootc_to_litr2c_buf(m)
                    dwt_frootc_to_litr3c(i,m,j)        = dwt_frootc_to_litr3c_buf(m)
                    dwt_livecrootc_to_cwdc(i,m,j)      = dwt_livecrootc_to_cwdc_buf(m)
                    dwt_deadcrootc_to_cwdc(i,m,j)      = dwt_deadcrootc_to_cwdc_buf(m)
                    dwt_seedn_to_leaf(i,m,j)           = dwt_seedn_to_leaf_buf(m)
                    dwt_seedn_to_deadstem(i,m,j)       = dwt_seedn_to_deadstem_buf(m)
                    dwt_conv_nflux(i,m,j)              = dwt_conv_nflux_buf(m)
                    dwt_prod10n_gain(i,m,j)            = dwt_prod10n_gain_buf(m)
                    dwt_prod100n_gain(i,m,j)           = dwt_prod100n_gain_buf(m)
                    prod100n_loss(i,m,j)               = prod100n_loss_buf(m)
                    dwt_frootn_to_litr1n(i,m,j)        = dwt_frootn_to_litr1n_buf(m)
                    dwt_frootn_to_litr2n(i,m,j)        = dwt_frootn_to_litr2n_buf(m)
                    dwt_frootn_to_litr3n(i,m,j)        = dwt_frootn_to_litr3n_buf(m)
                    dwt_livecrootn_to_cwdn(i,m,j)      =  dwt_livecrootn_to_cwdn_buf(m)
                    dwt_deadcrootn_to_cwdn(i,m,j)      = dwt_deadcrootn_to_cwdn_buf(m)
                    retransn(i,m,j)                    = retransn_buf(m)
#endif


              end do !!!!!!!!!!!!! m = 1, maxpatch
      end if
        call CLMDebug('good before call urban')
        IF (sf_urban_physics == 1 ) THEN                                              ! Beginning of UCM CALL if block
!--------------------------------------
! URBAN CANOPY MODEL START - urban
!--------------------------------------
! Input variables lsm --> urban


          IF( IVGTYP(I,J) == 1 .or. IVGTYP(I,J) == 31 .or. &
              IVGTYP(I,J) == 32 .or. IVGTYP(I,J) == 33 ) THEN

! Call urban
      forc_sols_buf  = swd_buf*0.35
      forc_soll_buf  = swd_buf*0.35
      forc_solsd_buf = swd_buf*0.15
      forc_solld_buf = swd_buf*0.15
      area_buf       = dx*dx/1.e6 !(km^2)
      forc_pbot_buf  = ps(i,1,j) ! Pa
      forc_txy_buf   = forc_txy(i,1,j)
      forc_uxy_buf   = forc_uxy(i,1,j)
      forc_vxy_buf   = forc_vxy(i,1,j)
      forc_qxy_buf   = forc_qxy(i,1,j)
      zgcmxy_buf     = zgcmxy(i,1,j)
      prec_buf       = prec(i,j)/dtt ! mm/s
      flwdsxy_buf    = flwdsxy(i,j) 
      forc_psrfxy_buf= ps(i,1,j) !  Pa
!
            UTYPE_URB = UTYPE_URB2D(I,J) !urban type (low, high or industrial)

            TA_URB    = forc_txy(i,1,j)  ! [K]
            QA_URB    = forc_qxy(i,1,j)  ! [kg/kg]
            UA_URB    = SQRT(forc_uxy(i,1,j)**2.+forc_vxy(i,1,j)**2.)
            U1_URB    = forc_uxy(i,1,j)
            V1_URB    = forc_vxy(i,1,j)
            IF(UA_URB < 1.) UA_URB=1.    ! [m/s]
            SSG_URB   = swd_buf            ! [W/m/m]
            SSGD_URB  = 0.8*swd_buf        ! [W/m/m]
            SSGQ_URB  = SSG_URB-SSGD_URB ! [W/m/m]
            LLG_URB   = flwdsxy(i,j)    ! [W/m/m]
            RAIN_URB  = prec(i,j)      ! [mm]
            RHOO_URB  = ps(i,1,j)/(287.04 * forc_txy(i,1,j) * (1.0+ 0.61 * forc_qxy(i,1,j))) ![kg/m/m/m]
            ZA_URB    = zgcmxy_buf             ! [m]
            DELT_URB  = DT               ! [sec]
            XLAT_URB  = XLAT_URB2D(I,J)  ! [deg]
            COSZ_URB  = COSZ_URB2D(I,J)  !
            OMG_URB   = OMG_URB2D(I,J)   !
            ZNT_URB   = ZNT(I,J)

            LSOLAR_URB = .FALSE.

            TR_URB = TR_URB2D(I,J)
            TB_URB = TB_URB2D(I,J)
            TG_URB = TG_URB2D(I,J)
            TC_URB = TC_URB2D(I,J)
            QC_URB = QC_URB2D(I,J)
            UC_URB = UC_URB2D(I,J)

            DO K = 1,num_roof_layers
              TRL_URB(K) = TRL_URB3D(I,K,J)
            END DO
            DO K = 1,num_wall_layers
              TBL_URB(K) = TBL_URB3D(I,K,J)
            END DO
            DO K = 1,num_road_layers
              TGL_URB(K) = TGL_URB3D(I,K,J)
            END DO

            XXXR_URB = XXXR_URB2D(I,J)
            XXXB_URB = XXXB_URB2D(I,J)
            XXXG_URB = XXXG_URB2D(I,J)
            XXXC_URB = XXXC_URB2D(I,J)
!
            CHS_URB  = CHS(I,J)
            CHS2_URB = CHS2(I,J)
! Jin
            IF (PRESENT(CMR_SFCDIF)) THEN
               CMR_URB = CMR_SFCDIF(I,J)
               CHR_URB = CHR_SFCDIF(I,J)
               CMC_URB = CMC_SFCDIF(I,J)
               CHC_URB = CHC_SFCDIF(I,J)
            ENDIF
! initialize NUDAPT variables to zero
            lp_urb = 0.
            lb_urb = 0.
            hgt_urb = 0.
            mh_urb = 0.
            stdh_urb = 0.
            do k = 1,4
              lf_urb(k) = 0.
            enddo
            frc_urb = FRC_URB2D(I,J)
            check = 0.
!

! Call urban
            CALL urban(LSOLAR_URB,                                      & ! I
                       num_roof_layers,num_wall_layers,num_road_layers, & ! C
                       DZR,DZB,DZG,                                     & ! C
                       UTYPE_URB,TA_URB,QA_URB,UA_URB,U1_URB,V1_URB,SSG_URB, & ! I
                       SSGD_URB,SSGQ_URB,LLG_URB,RAIN_URB,RHOO_URB,     & ! I
                       ZA_URB,DECLIN_URB,COSZ_URB,OMG_URB,              & ! I
                       XLAT_URB,DELT_URB,ZNT_URB,                       & ! I
                       CHS_URB, CHS2_URB,                               & ! I
                       TR_URB, TB_URB, TG_URB, TC_URB, QC_URB,UC_URB,   & ! H
                       TRL_URB,TBL_URB,TGL_URB,                         & ! H
                       XXXR_URB, XXXB_URB, XXXG_URB, XXXC_URB,          & ! H
                       TS_URB,QS_URB,SH_URB,LH_URB,LH_KINEMATIC_URB,    & ! O
                       SW_URB,ALB_URB,LW_URB,G_URB,RN_URB,PSIM_URB,PSIH_URB, & ! O
                       GZ1OZ0_URB,                                      & !O
                       CMR_URB, CHR_URB, CMC_URB, CHC_URB,              &
                       U10_URB, V10_URB, TH2_URB, Q2_URB,               & ! O
                       UST_URB,mh_urb, stdh_urb, lf_urb, lp_urb,        & ! 0
                       hgt_urb,frc_urb,lb_urb, check)

            TS_URB2D(I,J) = TS_URB

            albxy(i,j) = FRC_URB2D(I,J)*ALB_URB+(1-FRC_URB2D(I,J))*albxy_buf   ![-]
            shxy(i,j)  = FRC_URB2D(I,J)*SH_URB+(1-FRC_URB2D(I,J))*shxy_buf     ![W/m/m]
            qfx(i,j)   = FRC_URB2D(I,J)*LH_KINEMATIC_URB &
                     + (1-FRC_URB2D(I,J))*qfx(i,j)                ![kg/m/m/s]
            lhxy(i,j) = FRC_URB2D(I,J)*LH_URB+(1-FRC_URB2D(I,J))*lhxy_buf     ![W/m/m]
            soiflx(i,j) = FRC_URB2D(I,J)*G_URB+(1-FRC_URB2D(I,J))*soiflx_buf  ![W/m/m]
            tsxy(i,j)  = FRC_URB2D(I,J)*TS_URB+(1-FRC_URB2D(I,J))*tsxy_buf          ![K]
            qsfc(i,j)  = FRC_URB2D(I,J)*QS_URB+(1-FRC_URB2D(I,J))*qsfc(i,j)         ![-]

! Renew Urban State Varialbes

            TR_URB2D(I,J) = TR_URB
            TB_URB2D(I,J) = TB_URB
            TG_URB2D(I,J) = TG_URB
            TC_URB2D(I,J) = TC_URB
            QC_URB2D(I,J) = QC_URB
            UC_URB2D(I,J) = UC_URB

            DO K = 1,num_roof_layers
              TRL_URB3D(I,K,J) = TRL_URB(K)
            END DO
            DO K = 1,num_wall_layers
              TBL_URB3D(I,K,J) = TBL_URB(K)
            END DO
            DO K = 1,num_road_layers
              TGL_URB3D(I,K,J) = TGL_URB(K)
            END DO
            XXXR_URB2D(I,J) = XXXR_URB
            XXXB_URB2D(I,J) = XXXB_URB
            XXXG_URB2D(I,J) = XXXG_URB
            XXXC_URB2D(I,J) = XXXC_URB

            SH_URB2D(I,J)    = SH_URB
            LH_URB2D(I,J)    = LH_URB
            G_URB2D(I,J)     = G_URB
            RN_URB2D(I,J)    = RN_URB
            PSIM_URB2D(I,J)  = PSIM_URB
            PSIH_URB2D(I,J)  = PSIH_URB
            GZ1OZ0_URB2D(I,J)= GZ1OZ0_URB
            U10_URB2D(I,J)   = U10_URB
            V10_URB2D(I,J)   = V10_URB
            TH2_URB2D(I,J)   = TH2_URB
            Q2_URB2D(I,J)    = Q2_URB
            UST_URB2D(I,J)   = UST_URB
            AKMS_URB2D(I,J)  = vkc * UST_URB2D(I,J)/(GZ1OZ0_URB2D(I,J)-PSIM_URB2D(I,J))
            IF (PRESENT(CMR_SFCDIF)) THEN
               CMR_SFCDIF(I,J) = CMR_URB
               CHR_SFCDIF(I,J) = CHR_URB
               CMC_SFCDIF(I,J) = CMC_URB
               CHC_SFCDIF(I,J) = CHC_URB
            ENDIF
          END IF

         ENDIF                                   ! end of urban CALL if block


    do m=1,maxpatch
      if(snl(i,m,j)<-10 .or. snl(i,m,j) >10) found=.true. 
         
    end do
  
   if(found) then

        write(6,*) 'in module_sf_clm, right after clm(), found snl ERROR! at i=',i,'j=',j
        found=.false.
   end if



  end do ! of i loop
  end do ! of j loop

   do i=its,ite
    do j=jts,jte
     do m=1,maxpatch
      if(snl(i,m,j)<-10 .or. snl(i,m,j) >10) found=.true.
     end do 
      if(found) then
        write(6,*) 'in module_sf_clm, finish all clm loop, found snl ERROR! at i=',i,'j=',j
        write(6,*) 'snl(',i,':',j,')=',snl(i,:,j)
        found=.false.
       end if

    end do
  end do


        call CLMDebug('clmdrv() success finished')   !DEL 
end subroutine clmdrv
!------------------------------------------------------------------------
  subroutine clminit(VEGFRA,SNOW,SNOWC,SNOWH,CANWAT,SMSTAV,        &
                     SMSTOT, SFCRUNOFF,UDRUNOFF,ACSNOW,            &
                     ACSNOM,IVGTYP,ISLTYP,TSLB,SMOIS,SH2O,ZS,DZS,  &
                     FNDSOILW, FNDSNOWH,                           &
                     num_soil_layers, restart,                     &
                     allowed_to_read ,                             &
                     ids,ide, jds,jde, kds,kde,                    &
                     ims,ime, jms,jme, kms,kme,                    &
                     its,ite, jts,jte, kts,kte,                    &
                     maxpatch                                      &
                    ,numc,nump,snl,                                      &
                     snowdp,wtc,wtp,h2osno,t_grnd,t_veg,         &
                     h2ocan,h2ocan_col,t2m_max,t2m_min,     &
                     t_ref2m,h2osoi_liq_s1,              &
                     h2osoi_liq_s2,h2osoi_liq_s3,h2osoi_liq_s4,          &
                     h2osoi_liq_s5,h2osoi_liq1,h2osoi_liq2,              &
                     h2osoi_liq3,h2osoi_liq4,h2osoi_liq5,h2osoi_liq6,    &
                     h2osoi_liq7,h2osoi_liq8,h2osoi_liq9,h2osoi_liq10,   &
                     h2osoi_ice_s1,h2osoi_ice_s2,                        &
                     h2osoi_ice_s3,h2osoi_ice_s4,h2osoi_ice_s5,          &
                     h2osoi_ice1,h2osoi_ice2,h2osoi_ice3,h2osoi_ice4,    &
                     h2osoi_ice5,h2osoi_ice6,h2osoi_ice7,                &
                     h2osoi_ice8,h2osoi_ice9,h2osoi_ice10,               &
                     t_soisno_s1,t_soisno_s2,t_soisno_s3,t_soisno_s4,    &
                     t_soisno_s5,t_soisno1,t_soisno2,t_soisno3,          &
                     t_soisno4,t_soisno5,t_soisno6,t_soisno7,            &
                     t_soisno8,t_soisno9,t_soisno10,                     &
                     dzsnow1,dzsnow2,dzsnow3,dzsnow4,dzsnow5,            &
                     snowrds1,snowrds2,snowrds3,snowrds4,snowrds5,       &
                     t_lake1,t_lake2,t_lake3,t_lake4,t_lake5,            &
                     t_lake6,t_lake7,t_lake8,t_lake9,t_lake10,           &
                     h2osoi_vol1,h2osoi_vol2,h2osoi_vol3,                &
                     h2osoi_vol4,h2osoi_vol5,h2osoi_vol6,                &
                     h2osoi_vol7,h2osoi_vol8,                            &
                     h2osoi_vol9,h2osoi_vol10,                           &
                     ht,xland,xice                                        &
                    ,albedosubgrid,lhsubgrid,hfxsubgrid,lwupsubgrid,q2subgrid &
                    ,sabvsubgrid,sabgsubgrid,nrasubgrid,swupsubgrid,      &
                    lhsoi,lhveg,lhtran &
!#ifdef CN 
!                    ,dyntlai,dyntsai,dyntop,dynbot &  !ADD_NEW_VAR
!#endif
                                                                         )

  USE module_wrf_error
   use clm_varcon, only :snowage_tau,snowage_kappa,snowage_drdt0            &
                        ,ss_alb_snw_drc,asm_prm_snw_drc                     &
                        ,ext_cff_mss_snw_drc,ss_alb_snw_dfs,asm_prm_snw_dfs &
                        ,ext_cff_mss_snw_dfs      &
                        ,xx_ss_alb_snw_drc        &
                        ,xx_asm_prm_snw_drc       &
                        ,xx_ext_cff_mss_snw_drc   &
                        ,xx_ss_alb_snw_dfs        &
                        ,xx_asm_prm_snw_dfs       &
                        ,xx_ext_cff_mss_snw_dfs   &
                        ,xx_snowage_tau           &
                        ,xx_snowage_kappa         &
                        ,xx_snowage_drdt0         &
                        ,idx_Mie_snw_mx           &
                        ,idx_T_max                &
                        ,idx_Tgrd_max             &
                        ,idx_rhos_max             &
                        ,numrad_snw 

!New in CLM4_crop
!#if (defined CROP)
!    USE  CropIniMod      , only : initialcrop
!#endif

  implicit none

  INTEGER,  INTENT(IN   )   ::     ids,ide, jds,jde, kds,kde,  &
                                   ims,ime, jms,jme, kms,kme,  &
                                   its,ite, jts,jte, kts,kte

  logical, external :: wrf_dm_on_monitor
  integer :: ix

  INTEGER, INTENT(IN)       ::     num_soil_layers,maxpatch
    
   LOGICAL , INTENT(IN) :: restart , allowed_to_read

   REAL,    DIMENSION( num_soil_layers), INTENT(INOUT) :: zs, dzs

   REAL,    DIMENSION( ims:ime, num_soil_layers, jms:jme )    , &
            INTENT(INOUT)    ::                          SMOIS, &  !Total soil moisture
                                                         SH2O,  &  !liquid soil moisture
                                                         TSLB      !STEMP
     
   REAL,    DIMENSION( ims:ime, jms:jme )                     , &
            INTENT(INOUT)    ::                           SNOW, & 
                                                         SNOWH, &
                                                         SNOWC, &
                                                        CANWAT, &
                                                        SMSTAV, &
                                                        SMSTOT, &
                                                     SFCRUNOFF, &
                                                      UDRUNOFF, &
                                                        ACSNOW, &
                                                        VEGFRA, &
                                                        ACSNOM

   REAL,  DIMENSION( ims:ime, jms:jme ), INTENT(IN) :: HT
   INTEGER, DIMENSION( ims:ime, jms:jme )                     , &
            INTENT(IN)       ::                         IVGTYP, &
                                                        ISLTYP
   REAL, DIMENSION( ims:ime, jms:jme )                     , &
            INTENT(IN)       ::                         XLAND,xice
   LOGICAL, DIMENSION( ims:ime, jms:jme ) :: lake

   LOGICAL, INTENT(IN)       ::                      FNDSOILW , &
                                                     FNDSNOWH

  integer,   dimension(ims:ime,jms:jme ),intent(inout) :: numc,nump
  integer,   dimension(ims:ime,1:maxpatch,jms:jme ),intent(inout) :: snl
  real,  dimension(ims:ime,jms:jme ),intent(inout) :: t2m_max,t2m_min
  real,  dimension(ims:ime,1:maxpatch,jms:jme ),intent(inout) ::  &
                snowdp,wtc,wtp,h2osno,t_grnd,t_veg,         &
                h2ocan,h2ocan_col,   &
                t_ref2m,h2osoi_liq_s1,              &
                h2osoi_liq_s2,h2osoi_liq_s3,h2osoi_liq_s4,          &
                h2osoi_liq_s5,h2osoi_liq1,h2osoi_liq2,              &
                h2osoi_liq3,h2osoi_liq4,h2osoi_liq5,h2osoi_liq6,    &
                h2osoi_liq7,h2osoi_liq8,h2osoi_liq9,h2osoi_liq10,   &
                h2osoi_ice_s1,h2osoi_ice_s2,                        &
                h2osoi_ice_s3,h2osoi_ice_s4,h2osoi_ice_s5,          &
                h2osoi_ice1,h2osoi_ice2,h2osoi_ice3,h2osoi_ice4,    &
                h2osoi_ice5,h2osoi_ice6,h2osoi_ice7,                &
                h2osoi_ice8,h2osoi_ice9,h2osoi_ice10,               &
                t_soisno_s1,t_soisno_s2,t_soisno_s3,t_soisno_s4,    &
                t_soisno_s5,t_soisno1,t_soisno2,t_soisno3,          &
                t_soisno4,t_soisno5,t_soisno6,t_soisno7,            &
                t_soisno8,t_soisno9,t_soisno10,                     &
                dzsnow1,dzsnow2,dzsnow3,dzsnow4,dzsnow5,            &
                snowrds1,snowrds2,snowrds3,snowrds4,snowrds5,       &
                t_lake1,t_lake2,t_lake3,t_lake4,t_lake5,            &
                t_lake6,t_lake7,t_lake8,t_lake9,t_lake10,           &
                h2osoi_vol1,h2osoi_vol2,h2osoi_vol3,                &
                h2osoi_vol4,h2osoi_vol5,h2osoi_vol6,                &
                h2osoi_vol7,h2osoi_vol8,                            &
                h2osoi_vol9,h2osoi_vol10,                           &
                ALBEDOsubgrid,LHsubgrid,HFXsubgrid,LWUPsubgrid,     &
                Q2subgrid,SABVsubgrid,SABGsubgrid,NRAsubgrid,SWUPsubgrid,&
                LHsoi,LHveg,LHtran
#ifdef CN
     real,  dimension(ims:ime,1:maxpatch,jms:jme ),intent(inout) :: dyntlai,dyntsai,dyntop,dynbot    !ADD_NEW_VAR                                       
#endif


   INTEGER                   :: L
   REAL                      :: BX, SMCMAX, PSISAT, FREE
   INTEGER                   :: errflag
   INTEGER                   :: itf,jtf,j,i,k,m
   LOGICAL                   :: opened

   integer                   :: lu_unit

   call CLMDebug('Now in clminit.')

IF ( wrf_dm_on_monitor() ) THEN
     DO i=10,99
        INQUIRE ( i , OPENED = opened )
          IF ( .NOT. opened ) THEN
                lu_unit=i
                GOTO 2011
            ENDIF
         ENDDO
         lu_unit = -1
 2011   CONTINUE

        if(lu_unit<0) then
          write(6,*) 'Can not assign unit to read CLM input data in clminit'
          call endrun()
        end if

  open(lu_unit,file='CLM_ALB_ICE_DRC_DATA')
  read(lu_unit,*) ((ss_alb_snw_drc(i,j),j=1,numrad_snw),i=1,idx_Mie_snw_mx)
  close(lu_unit)

  open(lu_unit,file='CLM_ASM_ICE_DRC_DATA')
  read(lu_unit,*) ((asm_prm_snw_drc(i,j),j=1,numrad_snw),i=1,idx_Mie_snw_mx)
  close(lu_unit)

  open(lu_unit,file='CLM_EXT_ICE_DRC_DATA')
  read(lu_unit,*) ((ext_cff_mss_snw_drc(i,j),j=1,numrad_snw),i=1,idx_Mie_snw_mx)
  close(lu_unit)

  open(lu_unit,file='CLM_ALB_ICE_DFS_DATA')
  read(lu_unit,*) ((ss_alb_snw_dfs(i,j),j=1,numrad_snw),i=1,idx_Mie_snw_mx)
  close(lu_unit)

  open(lu_unit,file='CLM_ASM_ICE_DFS_DATA')
  read(lu_unit,*) ((asm_prm_snw_dfs(i,j),j=1,numrad_snw),i=1,idx_Mie_snw_mx)
  close(lu_unit)

  open(lu_unit,file='CLM_EXT_ICE_DFS_DATA')
  read(lu_unit,*) ((ext_cff_mss_snw_dfs(i,j),j=1,numrad_snw),i=1,idx_Mie_snw_mx)
  close(lu_unit)

  open(lu_unit,file='CLM_TAU_DATA')
  read(lu_unit,*) &
  (((snowage_tau(i,j,k),i=1,idx_T_max),j=1,idx_Tgrd_max),k=1,idx_rhos_max)
  close(lu_unit)

  open(lu_unit,file='CLM_KAPPA_DATA')
  read(lu_unit,*) &
  (((snowage_kappa(i,j,k),i=1,idx_T_max),j=1,idx_Tgrd_max),k=1,idx_rhos_max)
  close(lu_unit)

  open(lu_unit,file='CLM_DRDSDT0_DATA')
  read(lu_unit,*)&
  (((snowage_drdt0(i,j,k),i=1,idx_T_max),j=1,idx_Tgrd_max),k=1,idx_rhos_max)
  close(lu_unit)
END IF

  ix = 0
  do i=1, idx_Mie_snw_mx
  do j=1, numrad_snw
    ix = ix + 1
    xx_ss_alb_snw_drc(ix)      = ss_alb_snw_drc(i,j)
    xx_asm_prm_snw_drc(ix)     = asm_prm_snw_drc(i,j)
    xx_ext_cff_mss_snw_drc(ix) = ext_cff_mss_snw_drc(i,j)
    xx_ss_alb_snw_dfs(ix)      = ss_alb_snw_dfs(i,j)
    xx_asm_prm_snw_dfs(ix)     = asm_prm_snw_dfs(i,j)
    xx_ext_cff_mss_snw_dfs(ix) = ext_cff_mss_snw_dfs(i,j)
  end do
  end do


 ix = 0
 do i=1,idx_T_max
 do j=1,idx_Tgrd_max
 do k=1,idx_rhos_max
    ix = ix + 1
    xx_snowage_tau(ix)   = snowage_tau(i,j,k)
    xx_snowage_kappa(ix) = snowage_kappa(i,j,k)
    xx_snowage_drdt0(ix) = snowage_drdt0(i,j,k)
 end do
 end do
 end do

  CALL wrf_dm_bcast_real(xx_ss_alb_snw_drc,      numrad_snw*idx_Mie_snw_mx )
  CALL wrf_dm_bcast_real(xx_asm_prm_snw_drc,     numrad_snw*idx_Mie_snw_mx )
  CALL wrf_dm_bcast_real(xx_ext_cff_mss_snw_drc, numrad_snw*idx_Mie_snw_mx )

  CALL wrf_dm_bcast_real(xx_ss_alb_snw_dfs,      numrad_snw*idx_Mie_snw_mx )
  CALL wrf_dm_bcast_real(xx_asm_prm_snw_dfs,     numrad_snw*idx_Mie_snw_mx )
  CALL wrf_dm_bcast_real(xx_ext_cff_mss_snw_dfs, numrad_snw*idx_Mie_snw_mx )

  CALL wrf_dm_bcast_real(xx_snowage_tau,  idx_T_max*idx_Tgrd_max*idx_rhos_max)
  CALL wrf_dm_bcast_real(xx_snowage_kappa,idx_T_max*idx_Tgrd_max*idx_rhos_max)
  CALL wrf_dm_bcast_real(xx_snowage_drdt0,idx_T_max*idx_Tgrd_max*idx_rhos_max)

 IF(restart) return

   itf=min0(ite,ide-1)
   jtf=min0(jte,jde-1)


   errflag = 0
   DO j = jts,jtf
     DO i = its,itf
       IF ( ISLTYP( i,j ) .LT. 1 ) THEN
         errflag = 1
         WRITE(wrf_err_message,*)"CLM: clminit: out of range ISLTYP ",i,j,ISLTYP( i,j )
         CALL wrf_message(wrf_err_message)
       ENDIF
     ENDDO
   ENDDO
   IF ( errflag .EQ. 1 ) THEN
      CALL wrf_error_fatal( "CLM: clminit: out of range value "// &
                            "of ISLTYP. Is this field in the input?" )
   ENDIF
!------------------------------------------------------------------------------
          DO j = jts,jtf
          DO i = its,itf


          if((xland(i,j)-1.5).ge.0.)then

             If(xice(i,j).eq.1)print*,' SEA-ICE AT WATER POINT, i=',i,'j=',j
  
              smstav(i,j)=1.0
              smstot(i,j)=1.0
              smois(i,:,j)=1.0
              tslb(i,:,j)=273.16
            else if(xice(i,j).eq.1.)then

              smstav(i,j)=1.0
              smstot(i,j)=1.0
              smois(i,:,j)=1.0
            endif

            snowh(i,j)=snow(i,j)*0.005               ! SNOW in kg/m^2 and SNOWH in m

            snowdp(i,:,j) = snowh(i,j)

          ENDDO
          ENDDO

       do i=its,itf
       do j=jts,jtf
           snl(i,:,j) = 0                  !-999.0 
           h2osoi_liq_s5(i,:,j) = -999.0 
           h2osoi_liq_s4(i,:,j) = -999.0 
           h2osoi_liq_s3(i,:,j) = -999.0 
           h2osoi_liq_s2(i,:,j) = -999.0 
           h2osoi_liq_s1(i,:,j) = -999.0 
           h2osoi_liq1(i,:,j)   = -999.0 
           h2osoi_liq2(i,:,j)   = -999.0 
           h2osoi_liq3(i,:,j)   = -999.0 
           h2osoi_liq4(i,:,j)   = -999.0 
           h2osoi_liq5(i,:,j)   = -999.0 
           h2osoi_liq6(i,:,j)   = -999.0 
           h2osoi_liq7(i,:,j)   = -999.0 
           h2osoi_liq8(i,:,j)   = -999.0 
           h2osoi_liq9(i,:,j)   = -999.0 
           h2osoi_liq10(i,:,j)  = -999.0 

           h2osoi_ice_s5(i,:,j) = -999.0 
           h2osoi_ice_s4(i,:,j) = -999.0 
           h2osoi_ice_s3(i,:,j) = -999.0 
           h2osoi_ice_s2(i,:,j) = -999.0 
           h2osoi_ice_s1(i,:,j) = -999.0 
           h2osoi_ice1(i,:,j)   = -999.0 
           h2osoi_ice2(i,:,j)   = -999.0 
           h2osoi_ice3(i,:,j)   = -999.0 
           h2osoi_ice4(i,:,j)   = -999.0 
           h2osoi_ice5(i,:,j)   = -999.0 
           h2osoi_ice6(i,:,j)   = -999.0 
           h2osoi_ice7(i,:,j)   = -999.0 
           h2osoi_ice8(i,:,j)   = -999.0 
           h2osoi_ice9(i,:,j)   = -999.0 
           h2osoi_ice10(i,:,j)  = -999.0 

        !   snowage(i,:,j)= 0.0
!Could this be the snow bug?
!           if(ivgtyp(i,j).eq.24) then
!             h2osno(i,:,j) = 1000.0 ! mm
!           else
             h2osno(i,:,j) = snow(i,j) ! mm
!           end if
       end do
       end do

     !  write(6,*) '-------in clminit--------'
     !  write(6,*) 'snl=',snl
     !  call CLMDebug('clminit mark1')
!------------------------------------------------------------------------------
       do i=its,itf
       do j=jts,jtf
         numc(i,j) = 0
         nump(i,j) = 0
         wtc(i,:,j) = 0.0
         wtp(i,:,j) = 0.0
#ifdef CN
         dyntlai(i,:,j) = 0.0
         dyntsai(i,:,j) = 0.0
         dyntop(i,:,j) = 0.0
         dynbot(i,:,j) = 0.0
#endif
       end do
       end do
!------------------------------------------------------------------------------
       do i=its,itf
         do j=jts,jtf
!            if(ivgtyp(i,j)==16.and.ht(i,j)>=1.e-5) then
!!!!!!Lakes Disabled.  See comments above.
            if(0 == 1) then
!!!!!!
                lake(i,j)  = .true.
            else
                lake(i,j)  = .false.
            end if
        end do
       end do
!------------------------------------------------------------------------------
! for snow
      do m=1,maxpatch
      do i=its,itf
      do j=jts,jtf
               dzsnow1(i,m,j) = 0.0
               dzsnow2(i,m,j) = 0.0
               dzsnow3(i,m,j) = 0.0
               dzsnow4(i,m,j) = 0.0
               dzsnow5(i,m,j) = 0.0
               if(snowdp(i,m,j).lt.0.01) then
                     snl(i,m,j) = 0
                     dzsnow1(i,m,j) = 0.0
                     dzsnow2(i,m,j) = 0.0
                     dzsnow3(i,m,j) = 0.0
                     dzsnow4(i,m,j) = 0.0
                     dzsnow5(i,m,j) = 0.0
               else
                if(snowdp(i,m,j).ge.0.01.and.snowdp(i,m,j).le.0.03) then
                   snl(i,m,j) = -1
                   dzsnow1(i,m,j) = snowdp(i,m,j)
                else if(snowdp(i,m,j).gt.0.03.and.snowdp(i,m,j).le.0.04) then
                   snl(i,m,j) = -2
                   dzsnow2(i,m,j) = snowdp(i,m,j)/2.
                   dzsnow1(i,m,j) = snowdp(i,m,j)/2.
                else if(snowdp(i,m,j).gt.0.04.and.snowdp(i,m,j).le.0.07) then
                   snl(i,m,j) = -2
                   dzsnow2(i,m,j) = 0.02
                   dzsnow1(i,m,j) = snowdp(i,m,j)- dzsnow2(i,m,j)
                else if(snowdp(i,m,j).gt.0.07.and.snowdp(i,m,j).le.0.12) then
                   snl(i,m,j) = -3
                   dzsnow3(i,m,j) = 0.02
                   dzsnow2(i,m,j) = (snowdp(i,m,j) - 0.02)/2.0
                   dzsnow1(i,m,j) = (snowdp(i,m,j) - 0.02)/2.0
                else if(snowdp(i,m,j).gt.0.12.and.snowdp(i,m,j).le.0.18) then
                   snl(i,m,j) = -3
                   dzsnow3(i,m,j) = 0.02
                   dzsnow2(i,m,j) = 0.05
                   dzsnow1(i,m,j)= snowdp(i,m,j)-dzsnow3(i,m,j)-dzsnow2(i,m,j)
                else if(snowdp(i,m,j).gt.0.18.and.snowdp(i,m,j).le.0.29) then
                   snl(i,m,j) = -4
                   dzsnow4(i,m,j) = 0.02
                   dzsnow3(i,m,j) = 0.05
                   dzsnow2(i,m,j) = (snowdp(i,m,j)-dzsnow4(i,m,j)-dzsnow3(i,m,j))/2.0
                   dzsnow1(i,m,j) = dzsnow2(i,m,j)
                else if(snowdp(i,m,j).gt.0.29.and.snowdp(i,m,j).le.0.41) then
                   snl(i,m,j) = -4
                   dzsnow4(i,m,j) = 0.02
                   dzsnow3(i,m,j) = 0.05
                   dzsnow2(i,m,j) = 0.11
                   dzsnow1(i,m,j) = snowdp(i,m,j)-dzsnow4(i,m,j)-dzsnow3(i,m,j)-dzsnow2(i,m,j)
                else if(snowdp(i,m,j).gt.0.41.and.snowdp(i,m,j).le.0.64) then
                   snl(i,m,j) = -5
                   dzsnow5(i,m,j) = 0.02
                   dzsnow4(i,m,j) = 0.05
                   dzsnow3(i,m,j) = 0.11
                   dzsnow2(i,m,j) = (snowdp(i,m,j)-dzsnow5(i,m,j)-dzsnow4(i,m,j)-dzsnow3(i,m,j))/2.0
                   dzsnow1(i,m,j) = (snowdp(i,m,j)-dzsnow5(i,m,j)-dzsnow4(i,m,j)-dzsnow3(i,m,j))/2.0
                else if(snowdp(i,m,j).gt.0.64) then
                   snl(i,m,j) = -5
                   dzsnow5(i,m,j) = 0.02
                   dzsnow4(i,m,j)= 0.05
                   dzsnow3(i,m,j) = 0.11
                   dzsnow2(i,m,j) = 0.23
                   dzsnow1(i,m,j) = snowdp(i,m,j)-dzsnow5(i,m,j)-dzsnow4(i,m,j)-dzsnow3(i,m,j)-dzsnow2(i,m,j)
                end if
            end if ! start from snowdp(i,m,j).lt.0.01
       end do
       end do
       end do
 
      !write(6,*) 'after assign snl=',snl

!------------------------------------------------------------------------------
!snow radius
    do m=1,maxpatch
      do i=its,itf
        do j=jts,jtf
          if(snl(i,m,j) == -5) then
          snowrds1(i,m,j) = 54.526    !snw_rds_min = 54.526
          snowrds2(i,m,j) = 54.526
          snowrds3(i,m,j) = 54.526
          snowrds4(i,m,j) = 54.526
          snowrds5(i,m,j) = 54.526
          else if(snl(i,m,j) == -4) then
          snowrds1(i,m,j) = 54.526
          snowrds2(i,m,j) = 54.526
          snowrds3(i,m,j) = 54.526
          snowrds4(i,m,j) = 54.526
          snowrds5(i,m,j) = 0.0
           else if(snl(i,m,j) == -3) then
          snowrds1(i,m,j) = 54.526    
          snowrds2(i,m,j) = 54.526
          snowrds3(i,m,j) = 54.526
          snowrds4(i,m,j) = 0.0
          snowrds5(i,m,j) = 0.0
          else if(snl(i,m,j) == -2) then
          snowrds1(i,m,j) = 54.526
          snowrds2(i,m,j) = 54.526
          snowrds3(i,m,j) = 0.0
          snowrds4(i,m,j) = 0.0
          snowrds5(i,m,j) = 0.0
          else if(snl(i,m,j) == -1) then
          snowrds1(i,m,j) = 54.526
          snowrds2(i,m,j) = 0.0
          snowrds3(i,m,j) = 0.0
          snowrds4(i,m,j) = 0.0
          snowrds5(i,m,j) = 0.0
          else if(snl(i,m,j) == 0) then
          snowrds1(i,m,j) = 0.0
          snowrds2(i,m,j) = 0.0
          snowrds3(i,m,j) = 0.0
          snowrds4(i,m,j) = 0.0
          snowrds5(i,m,j) = 0.0
         end if
        end do
       end do
    end do


!------------------------------------------------------------------------------
       do i=its,itf
          do j=jts,jtf
              h2ocan(i,:,j) = 0.0
              h2ocan_col(i,:,j) = 0.0
              sfcrunoff(i,j) = 0.0 
              udrunoff(i,j) = 0.0
          end do
       end do
!------------------------------------------------------------------------------
! initialize temperature and moisture
      do i=its,itf
      do j=jts,jtf
           t_soisno_s5(i,:,j) = -999.0 
           t_soisno_s4(i,:,j) = -999.0 
           t_soisno_s3(i,:,j) = -999.0 
           t_soisno_s2(i,:,j) = -999.0 
           t_soisno_s1(i,:,j) = -999.0 
           t_soisno1(i,:,j)   = -999.0 
           t_soisno2(i,:,j)   = -999.0 
           t_soisno3(i,:,j)   = -999.0 
           t_soisno4(i,:,j)   = -999.0 
           t_soisno5(i,:,j)   = -999.0 
           t_soisno6(i,:,j)   = -999.0 
           t_soisno7(i,:,j)   = -999.0 
           t_soisno8(i,:,j)   = -999.0 
           t_soisno9(i,:,j)   = -999.0 
           t_soisno10(i,:,j)  = -999.0 

           t_lake1(i,:,j)     = -999.0 
           t_lake2(i,:,j)     = -999.0 
           t_lake3(i,:,j)     = -999.0 
           t_lake4(i,:,j)     = -999.0 
           t_lake5(i,:,j)     = -999.0 
           t_lake6(i,:,j)     = -999.0 
           t_lake7(i,:,j)     = -999.0 
           t_lake8(i,:,j)     = -999.0 
           t_lake9(i,:,j)     = -999.0 
           t_lake10(i,:,j)    = -999.0 
      end do
      end do

      do i=its,itf
      do j=jts,jtf
           do k=1,num_soil_layers
             if(ivgtyp(i,j).eq.24.and.tslb(i,k,j) .gt.tfrz) tslb(i,k,j)=tfrz
           end do
           t_soisno_s5(i,:,j) = tslb(i,1,j)
           t_soisno_s4(i,:,j) = tslb(i,1,j)
           t_soisno_s3(i,:,j) = tslb(i,1,j)
           t_soisno_s2(i,:,j) = tslb(i,1,j)
           t_soisno_s1(i,:,j) = tslb(i,1,j)
           t_soisno1(i,:,j) = tslb(i,1,j)
           t_soisno2(i,:,j) = tslb(i,2,j)
           t_soisno3(i,:,j) = tslb(i,3,j)
           t_soisno4(i,:,j) = tslb(i,4,j)
           t_soisno5(i,:,j) = tslb(i,5,j)
           t_soisno6(i,:,j) = tslb(i,6,j)
           t_soisno7(i,:,j) = tslb(i,7,j)
           t_soisno8(i,:,j) = tslb(i,8,j)
           t_soisno9(i,:,j) = tslb(i,9,j)
           t_soisno10(i,:,j)= tslb(i,10,j)

           t_grnd(i,:,j) = tslb(i,1,j)
           t_veg(i,:,j)  = tslb(i,1,j)
      end do 
      end do 

      do i=its,itf
      do j=jts,jtf
        if(lake(i,j)) then
              t_lake1(i,:,j)     = 277.0 
              t_lake2(i,:,j)     = 277.0 
              t_lake3(i,:,j)     = 277.0 
              t_lake4(i,:,j)     = 277.0 
              t_lake5(i,:,j)     = 277.0 
              t_lake6(i,:,j)     = 277.0 
              t_lake7(i,:,j)     = 277.0 
              t_lake8(i,:,j)     = 277.0 
              t_lake9(i,:,j)     = 277.0 
              t_lake10(i,:,j)    = 277.0 
              t_grnd(i,:,j)      = 277.0
        end if
      end do
      end do

        call CLMDebug('clminit mark2')
! for moisture

      do i=its,itf
      do j=jts,jtf
         h2osoi_vol1(i,:,j)   = smois(i,1,j)
         h2osoi_vol2(i,:,j)   = smois(i,2,j)
         h2osoi_vol3(i,:,j)   = smois(i,3,j)
         h2osoi_vol4(i,:,j)   = smois(i,4,j)
         h2osoi_vol5(i,:,j)   = smois(i,5,j)
         h2osoi_vol6(i,:,j)   = smois(i,6,j)
         h2osoi_vol7(i,:,j)   = smois(i,7,j)
         h2osoi_vol8(i,:,j)   = smois(i,8,j)
         h2osoi_vol9(i,:,j)   = smois(i,9,j)
         h2osoi_vol10(i,:,j)  = smois(i,10,j)

         h2osoi_liq_s5(i,:,j) = 0.0
         h2osoi_liq_s4(i,:,j) = 0.0
         h2osoi_liq_s3(i,:,j) = 0.0
         h2osoi_liq_s2(i,:,j) = 0.0
         h2osoi_liq_s1(i,:,j) = 0.0
         h2osoi_ice_s5(i,:,j) = 1.0 
         h2osoi_ice_s4(i,:,j) = 1.0 
         h2osoi_ice_s3(i,:,j) = 1.0 
         h2osoi_ice_s2(i,:,j) = 1.0 
         h2osoi_ice_s1(i,:,j) = 1.0 

         do m = 1, maxpatch
          if(t_soisno1(i,m,j) <tfrz.and.t_soisno1(i,m,j)/=-999.0) then
             h2osoi_ice1(i,m,j)   = dzs(1)*0.917e3*h2osoi_vol1(i,m,j)
             h2osoi_liq1(i,m,j)   = 0.0
          else if (t_soisno1(i,m,j) >= tfrz) then
             h2osoi_ice1(i,m,j)   = 0.0
             h2osoi_liq1(i,m,j)   = dzs(1)*1000.0*h2osoi_vol1(i,m,j)
          end if

          if(t_soisno2(i,m,j) <tfrz.and.t_soisno2(i,m,j)/=-999.0) then
             h2osoi_ice2(i,m,j)   = dzs(2)*0.917e3*h2osoi_vol2(i,m,j)
             h2osoi_liq2(i,m,j)   = 0.0
          else if (t_soisno2(i,m,j) >= tfrz) then
             h2osoi_ice2(i,m,j)   = 0.0
             h2osoi_liq2(i,m,j)   = dzs(2)*1000.0*h2osoi_vol2(i,m,j)
          end if

          if(t_soisno3(i,m,j) <tfrz.and.t_soisno3(i,m,j)/=-999.0) then
             h2osoi_ice3(i,m,j)   = dzs(3)*0.917e3*h2osoi_vol3(i,m,j)
             h2osoi_liq3(i,m,j)   = 0.0
          else if (t_soisno3(i,m,j) >= tfrz) then
             h2osoi_ice3(i,m,j)   = 0.0
             h2osoi_liq3(i,m,j)   = dzs(3)*1000.0*h2osoi_vol3(i,m,j)
          end if

          if(t_soisno4(i,m,j) <tfrz.and.t_soisno4(i,m,j)/=-999.0) then
             h2osoi_ice4(i,m,j)   = dzs(4)*0.917e4*h2osoi_vol4(i,m,j)
             h2osoi_liq4(i,m,j)   = 0.0
          else if (t_soisno4(i,m,j) >= tfrz) then
             h2osoi_ice4(i,m,j)   = 0.0
             h2osoi_liq4(i,m,j)   = dzs(4)*1000.0*h2osoi_vol4(i,m,j)
          end if

          if(t_soisno5(i,m,j) <tfrz.and.t_soisno5(i,m,j)/=-999.0) then
             h2osoi_ice5(i,m,j)   = dzs(5)*0.917e4*h2osoi_vol5(i,m,j)
             h2osoi_liq5(i,m,j)   = 0.0
          else if (t_soisno5(i,m,j) >= tfrz) then
             h2osoi_ice5(i,m,j)   = 0.0
             h2osoi_liq5(i,m,j)   = dzs(5)*1000.0*h2osoi_vol5(i,m,j)
          end if

          if(t_soisno6(i,m,j) <tfrz.and.t_soisno6(i,m,j)/=-999.0) then
             h2osoi_ice6(i,m,j)   = dzs(6)*0.917e4*h2osoi_vol6(i,m,j)
             h2osoi_liq6(i,m,j)   = 0.0
          else if (t_soisno6(i,m,j) >= tfrz) then
             h2osoi_ice6(i,m,j)   = 0.0
             h2osoi_liq6(i,m,j)   = dzs(6)*1000.0*h2osoi_vol6(i,m,j)
          end if

          if(t_soisno7(i,m,j) <tfrz.and.t_soisno7(i,m,j)/=-999.0) then
             h2osoi_ice7(i,m,j)   = dzs(7)*0.917e4*h2osoi_vol7(i,m,j)
             h2osoi_liq7(i,m,j)   = 0.0
          else if (t_soisno7(i,m,j) >= tfrz) then
             h2osoi_ice7(i,m,j)   = 0.0
             h2osoi_liq7(i,m,j)   = dzs(7)*1000.0*h2osoi_vol7(i,m,j)
          end if

          if(t_soisno8(i,m,j) <tfrz.and.t_soisno8(i,m,j)/=-999.0) then
             h2osoi_ice8(i,m,j)   = dzs(8)*0.917e4*h2osoi_vol8(i,m,j)
             h2osoi_liq8(i,m,j)   = 0.0
          else if (t_soisno8(i,m,j) >= tfrz) then
             h2osoi_ice8(i,m,j)   = 0.0
             h2osoi_liq8(i,m,j)   = dzs(8)*1000.0*h2osoi_vol8(i,m,j)
          end if

          if(t_soisno9(i,m,j) <tfrz.and.t_soisno9(i,m,j)/=-999.0) then
             h2osoi_ice9(i,m,j)   = dzs(9)*0.917e4*h2osoi_vol9(i,m,j)
             h2osoi_liq9(i,m,j)   = 0.0
          else if (t_soisno9(i,m,j) >= tfrz) then
             h2osoi_ice9(i,m,j)   = 0.0
             h2osoi_liq9(i,m,j)   = dzs(9)*1000.0*h2osoi_vol9(i,m,j)
          end if

          if(t_soisno10(i,m,j) <tfrz.and.t_soisno10(i,m,j)/=-999.0) then
             h2osoi_ice10(i,m,j)   = dzs(10)*0.917e4*h2osoi_vol10(i,m,j)
             h2osoi_liq10(i,m,j)   = 0.0
          else if (t_soisno10(i,m,j) >= tfrz) then
             h2osoi_ice10(i,m,j)   = 0.0
             h2osoi_liq10(i,m,j)   = dzs(10)*1000.0*h2osoi_vol10(i,m,j)
          end if
        end do

      end do
      end do
!------------------------------------------------------------------------------
 
      call CLMDebug('clminit mark 4') 
      do i=its,itf
      do j=jts,jtf
        t2m_max(i,j)             = tslb(i,1,j)
        t2m_min(i,j)             = tslb(i,1,j)
        t_ref2m(i,:,j)           = tslb(i,1,j)
        albedosubgrid(i,:,j) = 0.0
        lhsubgrid(i,:,j)     = 0.0
        hfxsubgrid(i,:,j)    = 0.0
        lwupsubgrid(i,:,j)   = 0.0
        q2subgrid(i,:,j)     = 0.0
        sabvsubgrid(i,:,j)   = 0.0
        sabgsubgrid(i,:,j)   = 0.0
        nrasubgrid(i,:,j)    = 0.0
        swupsubgrid(i,:,j)   = 0.0
!!
        lhsoi(i,:,j)  = 0.0
        lhveg(i,:,j)  = 0.0
        lhtran(i,:,j) = 0.0 
      end do
      end do

      do i=its,itf
      do j=jts,jtf
       do k=1, num_soil_layers
          if(tslb(i,k,j) >= tfrz )  then
            sh2o(i,k,j) = smois(i,k,j)
          else
            sh2o(i,k,j) = 0.0
          end if
       end do
      end do
      end do

   call CLMDebug('clminit done')
!------------------------------------------------------------------------------
 END SUBROUTINE clminit
!------------------------------------------------------------------------------
END MODULE module_sf_clm
module decompMod
!------------------------------------------------------------------------------
!BOP
!
! !MODULE: decompMod
!
! !USES:
  use shr_kind_mod, only : r8 => shr_kind_r8
  use clm_varpar  , only : lsmlon, lsmlat, maxpatch, maxpatch_pft, &
                           npatch_crop, npatch_urban, npatch_glacier
  use clm_varsur  , only : numlon

  implicit none

  integer, public :: ncells
  integer, public :: nlunits
  integer, public :: ncols
  integer, public :: npfts

  public initDecomp              ! initializes land surface decomposition
                                 ! into clumps and processors
  public get_gcell_info          ! updates gridcell, landunits, columns and
                                 ! pfts counters
  public get_gcell_xyind         ! returns ixy and jxy for each grid cell

  public get_proc_bounds         ! beg and end gridcell, landunit, column,
                                 ! pft indices for this processor

  save 

  private

  type gcell_decomp
     integer :: gsn     ! corresponding cell index in south->north gridcell array
     integer :: li      ! beginning landunit index
     integer :: lf      ! ending landunit index
     integer :: ci      ! beginning column index
     integer :: cf      ! ending column index
     integer :: pi      ! beginning pft index
     integer :: pf      ! ending pft index
  end type gcell_decomp
  type(gcell_decomp), allocatable :: gcelldc(:)

contains
!------------------------------------------------------------------------------
!BOP
!
! !IROUTINE: initDecomp
!
! !INTERFACE:
  subroutine initDecomp
!
! !DESCRIPTION:
! This subroutine initializes the land surface decomposition into a clump
! data structure.
!
! !USES:
    use clmtype
!
! !ARGUMENTS:
    implicit none
                                                           ! weights
!
! !LOCAL VARIABLES:
    integer :: ppc                    ! min number of pfts per clump
    integer :: lpc                    ! min number of landunits per clump
    integer :: ppclump                ! min pfts per clump
    integer :: i,j,cid,pid            ! indices
    integer :: gi,li,ci,pi            ! indices
    integer :: gf,lf,cf,pf            ! indices
    integer :: g,l,c,p,n,m            ! indices
    integer :: gdc,gsn                ! indices
    integer :: nzero                  ! first clump with zero gridcells
!    integer :: ncells                 ! total gridcells
!    integer :: nlunits                ! total landunits
!    integer :: ncols                  ! total columns
!    integer :: npfts                  ! total pfts
    integer :: nveg                   ! number of pfts in vegetated landunit
    integer :: numg                   ! total number of gridcells across all
                                      ! processors
    integer :: numl                   ! total number of landunits across all
                                      ! processors
    integer :: numc                   ! total number of columns across all
                                      ! processors
    integer :: nump                   ! total number of pfts across all
                                      ! processors
    logical :: error = .false.        ! temporary for finding full clump
    integer :: ilunits, icols, ipfts  ! temporaries
    integer :: ng                     ! temporaries
    integer :: nl                     ! temporaries
    integer :: nc                     ! temporaries
    integer :: np                     ! temporaries
    integer :: ier                    ! error code
    character*256 :: msg
    integer :: begg,endg

    begg=1
    endg=1
!

! !CALLED FROM:
! subroutine initialize
!
! !REVISION HISTORY:
! 2002.09.11  Forrest Hoffman  Creation.
!
!EOP
!------------------------------------------------------------------------------

    ! Find total global number of grid cells, landunits, columns and pfts

    ncells = 0
    nlunits = 0
    ncols = 0
    npfts = 0
    
    msg= ''
    write(msg,*) 'lsmlat=',lsmlat,'numlon=',numlon
    call CLMDebug(msg)
  
       do g = begg,endg
             call get_gcell_info (g,  nlunits=ilunits, ncols=icols, npfts=ipfts)
             ncells  = ncells  + 1
             nlunits = nlunits + ilunits
             ncols   = ncols   + icols
             npfts   = npfts   + ipfts
       end do

  end subroutine initDecomp
!------------------------------------------------------------------------------
!BOP
!
! !IROUTINE: get_gcell_info
!
! !INTERFACE:
   subroutine get_gcell_info (g, nlunits, ncols, npfts, &
                              nveg, wtveg, ncrop, wtcrop)
!

   use clm_varsur , only: wtxy
! !DESCRIPTION:
! Obtain gridcell properties.
!
! !ARGUMENTS:
     implicit none
     integer ,intent(in) :: g                                                       ! weights
     integer , optional, intent(out) :: nlunits  ! number of landunits
     integer , optional, intent(out) :: ncols    ! number of columns
     integer , optional, intent(out) :: npfts    ! number of pfts
     integer , optional, intent(out) :: nveg     ! number of vegetated pfts
                                                 ! in naturally vegetated
                                                 ! landunit
     real(r8), optional, intent(out) :: wtveg    ! weight (relative to
                                                 ! gridcell) of naturally
                                                 ! vegetated landunit
     integer , optional, intent(out) :: ncrop    ! number of crop pfts in
                                                 ! crop landunit
     real(r8), optional, intent(out) :: wtcrop   ! weight (relative to
                                                 ! gridcell) of crop landunit
!
! !CALLED FROM:
! subroutines initDecomp
!
! !REVISION HISTORY:
! 2002.09.11  Mariana Vertenstein  Creation.
!
!EOP
!
! !LOCAL VARIABLES:
     integer  :: m       ! loop index
     integer  :: nvegl   ! number of vegetated pfts in naturally vegetated landunit
     real(r8) :: wtvegl  ! weight (relative to gridcell) of vegetated landunit
     integer  :: nvegc   ! number of crop pfts in crop landunit
     real(r8) :: wtvegc  ! weight (relative to gridcell) of crop landunit
     integer  :: ilunits ! number of landunits in gridcell
     integer  :: icols   ! number of columns in gridcell
     integer  :: ipfts   ! number of pfts in gridcell
!------------------------------------------------------------------------------

     ! Initialize pfts, columns and landunits counters for gridcell

     ipfts   = 0
     icols   = 0
     ilunits = 0

     ! Set total number of pfts in gridcell
     do m = 1,maxpatch
        if (wtxy(g,m) > 0.0) ipfts = ipfts + 1
     end do

     ! Set naturally vegetated landunit

     nvegl = 0
     wtvegl = 0.0
     do m = 1, maxpatch_pft
        if (wtxy(g,m) > 0.0) then
           nvegl = nvegl + 1
           wtvegl = wtvegl + wtxy(g,m)
        end if
     end do
     if (nvegl > 0) ilunits = ilunits + 1
#if (defined NOCOMPETE)
     if (nvegl > 0) icols = icols + nvegl ! each pft on vegetated landunit has its own column
#else
     if (nvegl > 0) icols = icols + 1     ! the vegetated landunit has one column
#endif

     ! Set special landunits

     do m = npatch_urban, npatch_glacier
        if (wtxy(g,m) > 0.0) ilunits = ilunits + 1
        if (wtxy(g,m) > 0.0) icols = icols + 1
     end do

     ! Set crop landunit if appropriate

     nvegc = 0
     wtvegc = 0.0

        do m = npatch_glacier+1, npatch_crop
           if (wtxy(g,m) > 0.0) then
              nvegc = nvegc + 1
              wtvegc = wtvegc + wtxy(g,m)
           end if
        end do
        if (nvegc > 0) ilunits = ilunits + 1
        if (nvegc > 0) icols = icols + nvegc

     if (present(nlunits)) nlunits = ilunits
     if (present(ncols))   ncols   = icols
     if (present(npfts))   npfts   = ipfts
     if (present(nveg))    nveg    = nvegl
     if (present(wtveg))   wtveg   = wtvegl
     if (present(ncrop))   ncrop   = nvegc
     if (present(wtcrop))  wtcrop  = wtvegc

 end subroutine get_gcell_info

!------------------------------------------------------------------------------
!BOP
!
! !IROUTINE: get_proc_bounds
!
! !INTERFACE:
   subroutine get_proc_bounds (begg, endg, begl, endl, begc, endc, &
                               begp, endp)
!
! !ARGUMENTS:
     implicit none
     integer,optional, intent(out) :: begp, endp  ! proc beginning and ending
                                         ! pft indices
     integer,optional, intent(out) :: begc, endc  ! proc beginning and ending
                                         ! column indices
     integer,optional, intent(out) :: begl, endl  ! proc beginning and ending
                                         ! landunit indices
     integer,optional, intent(out) :: begg, endg  ! proc beginning and ending
                                         ! gridcell indices
! !DESCRIPTION:
! Retrieve gridcell, landunit, column, and pft bounds for process.
!
! !REVISION HISTORY:
! 2003.09.12  Mariana Vertenstein  Creation.
!
!EOP
!------------------------------------------------------------------------------

     if(present(begp)) begp = 1
     if(present(endp)) endp = npfts
     if(present(begc)) begc = 1
     if(present(endc)) endc = ncols
     if(present(begl)) begl = 1
     if(present(endl)) endl = nlunits
     if(present(begg)) begg = 1
     if(present(endg)) endg = 1

   end subroutine get_proc_bounds

!------------------------------------------------------------------------------
!BOP
!
! !IROUTINE: get_gcell_xyind
!
! !INTERFACE:
   subroutine get_gcell_xyind(lbg, ubg)
!
! !DESCRIPTION:
! Retrieve x,y indices of a gridcell.
!
! !ARGUMENTS:
     implicit none
     integer, intent(in) :: lbg
     integer, intent(in) :: ubg
!
! !REVISION HISTORY:
! 2003.09.12  Mariana Vertenstein  Creation.
!
!EOP
!
! !LOCAL VARIABLES:
     integer :: g     ! indices
     integer :: i, j
     integer :: ier                    ! error code
!------------------------------------------------------------------------------

!dir$ concurrent
!cdir nodep
    allocate(gcelldc(ncells), stat=ier)
    g = 0

       do j=1,lsmlat
          numlon(j) = lsmlon
       end do


    do j = 1, lsmlat
       do i = 1, numlon(j)
          g = g + 1
       end do
    end do
    do g = lbg,ubg
    end do
    deallocate(gcelldc)

   end subroutine get_gcell_xyind

end module decompMod
!==============================================================================
subroutine CLMDebug( str )

  IMPLICIT NONE
  CHARACTER*(*), str

#if (defined DEBUGCLM)
  print*, TRIM(str)
  call flush(6)
#endif

end subroutine CLMDebug

module clmtypeInitMod

!-----------------------------------------------------------------------
!BOP
!
! !MODULE: clmtypeInitMod
!
! !DESCRIPTION:
! Allocate clmtype components and initialize them to signaling NaN.
!
! !USES:
  use shr_kind_mod, only : r8 => shr_kind_r8
  use nanMod      , only : nan, bigint
  use clmtype
  use clm_varpar  , only : maxpatch_pft, nlevsno, nlevgrnd, numrad, nlevlak, &
                           numpft, ndst, nvoc, nlevurb, nlevsoi
!
! !PUBLIC TYPES:
  implicit none
  save
!
! !PUBLIC MEMBER FUNCTIONS:
  public :: initClmtype
!
! !REVISION HISTORY:
! Created by Peter Thornton and Mariana Vertenstein
! Modified by Colette L. Heald (05/06) for VOC emission factors
! 3/17/08 David Lawrence, changed nlevsoi to nlevgrnd where appropriate
!
! !PRIVATE MEMBER FUNCTIONS:
  private :: init_pft_type
  private :: init_column_type
  private :: init_landunit_type
  private :: init_gridcell_type
  private :: init_energy_balance_type
  private :: init_water_balance_type
  private :: init_pft_ecophys_constants
#if (defined CNDV) || (defined CROP)
  private :: init_pft_DGVMecophys_constants
#endif
  private :: init_pft_pstate_type
  private :: init_pft_epv_type
#if (defined CNDV) || (defined CROP)
  private :: init_pft_pdgvstate_type
#endif
  private :: init_pft_vstate_type
  private :: init_pft_estate_type
  private :: init_pft_wstate_type
  private :: init_pft_cstate_type
  private :: init_pft_nstate_type
  private :: init_pft_eflux_type
  private :: init_pft_mflux_type
  private :: init_pft_wflux_type
  private :: init_pft_cflux_type
  private :: init_pft_nflux_type
  private :: init_pft_vflux_type
  private :: init_pft_dflux_type
  private :: init_pft_depvd_type
  private :: init_column_pstate_type
  private :: init_column_estate_type
  private :: init_column_wstate_type
  private :: init_column_cstate_type
  private :: init_column_nstate_type
  private :: init_column_eflux_type
  private :: init_column_wflux_type
  private :: init_column_cflux_type
  private :: init_column_nflux_type
  private :: init_landunit_pstate_type
  private :: init_landunit_eflux_type
  private :: init_gridcell_pstate_type
  private :: init_gridcell_efstate_type
  private :: init_gridcell_wflux_type
!ylu add these two subroutine was called but not declared in clm4
  private :: init_gridcell_wstate_type
  private :: init_gridcell_estate_type
  private :: init_atm2lnd_type



!have to deallocate all the allocated vars at every time step
  private :: dealloc_pft_type
  private :: dealloc_column_type
  private :: dealloc_landunit_type
  private :: dealloc_gridcell_type
  private :: dealloc_energy_balance_type
  private :: dealloc_water_balance_type
  private :: dealloc_pft_ecophys_constants
#if (defined CNDV) || (defined CROP)
  private :: dealloc_pft_DGVMecophys_constants
#endif
  private :: dealloc_pft_pstate_type
  private :: dealloc_pft_epv_type
#if (defined CNDV) || (defined CROP)
  private :: dealloc_pft_pdgvstate_type
#endif
  private :: dealloc_pft_vstate_type
  private :: dealloc_pft_estate_type
  private :: dealloc_pft_wstate_type
  private :: dealloc_pft_cstate_type
  private :: dealloc_pft_nstate_type
  private :: dealloc_pft_eflux_type
  private :: dealloc_pft_mflux_type
  private :: dealloc_pft_wflux_type
  private :: dealloc_pft_cflux_type
  private :: dealloc_pft_nflux_type
  private :: dealloc_pft_vflux_type
  private :: dealloc_pft_dflux_type
  private :: dealloc_pft_depvd_type
  private :: dealloc_column_pstate_type
  private :: dealloc_column_estate_type
  private :: dealloc_column_wstate_type
  private :: dealloc_column_cstate_type
  private :: dealloc_column_nstate_type
  private :: dealloc_column_eflux_type
  private :: dealloc_column_wflux_type
  private :: dealloc_column_cflux_type
  private :: dealloc_column_nflux_type
  private :: dealloc_landunit_pstate_type
  private :: dealloc_landunit_eflux_type
  private :: dealloc_gridcell_pstate_type
  private :: dealloc_gridcell_efstate_type
  private :: dealloc_gridcell_wflux_type
!ylu add these two subroutine was called but not declared in clm4
  private :: dealloc_gridcell_wstate_type
  private :: dealloc_gridcell_estate_type
  private :: dealloc_atm2lnd_type


!EOP
!----------------------------------------------------

contains

!------------------------------------------------------------------------
!BOP
!
! !IROUTINE: initClmtype
!
! !INTERFACE:
  subroutine initClmtype()
!
! !DESCRIPTION:
! Initialize clmtype components to signaling nan
! The following clmtype components should NOT be initialized here
! since they are set in routine clm_map which is called before this
! routine is invoked
!    *%area, *%wt, *%wtlnd, *%wtxy, *%ixy, *%jxy, *%mxy, %snindex
!    *%ifspecial, *%ityplun, *%itype
!    *%pfti, *%pftf, *%pftn
!    *%coli, *%colf, *%coln
!    *%luni, *%lunf, *%lunn
!
! !USES:
    use decompMod , only : get_proc_bounds
!
! !ARGUMENTS:
    implicit none
!
! !REVISION HISTORY:
! Created by Mariana Vertenstein
!
!EOP
!
! LOCAL VARAIBLES:
    integer :: begp, endp   ! per-proc beginning and ending pft indices
    integer :: begc, endc   ! per-proc beginning and ending column indices
    integer :: begl, endl   ! per-proc beginning and ending landunit indices
    integer :: begg, endg   ! per-proc gridcell ending gridcell indices
!------------------------------------------------------------------------

    ! Determine necessary indices

    call get_proc_bounds(begg, endg, begl, endl, begc, endc, begp, endp)

    call init_pft_type     (begp, endp, clm3%g%l%c%p)
    call init_column_type  (begc, endc, clm3%g%l%c)
    call init_landunit_type(begl, endl, clm3%g%l)
    call init_gridcell_type(begg, endg, clm3%g)

    ! pft ecophysiological constants

    call init_pft_ecophys_constants()

#if (defined CNDV)
    ! pft DGVM-specific ecophysiological constants

    call init_pft_DGVMecophys_constants()
#endif

    ! energy balance structures (all levels)

    call init_energy_balance_type(begp, endp, clm3%g%l%c%p%pebal)
    call init_energy_balance_type(begc, endc, clm3%g%l%c%cebal)
    call init_energy_balance_type(begl, endl, clm3%g%l%lebal)
    call init_energy_balance_type(begg, endg, clm3%g%gebal)
    call init_energy_balance_type(1,       1, clm3%mebal)

    ! water balance structures (all levels)

    call init_water_balance_type(begp, endp, clm3%g%l%c%p%pwbal)
    call init_water_balance_type(begc, endc, clm3%g%l%c%cwbal)
    call init_water_balance_type(begl, endl, clm3%g%l%lwbal)
    call init_water_balance_type(begg, endg, clm3%g%gwbal)
    call init_water_balance_type(1,       1, clm3%mwbal)

    ! carbon balance structures (pft and column levels)

    call init_carbon_balance_type(begp, endp, clm3%g%l%c%p%pcbal)
    call init_carbon_balance_type(begc, endc, clm3%g%l%c%ccbal)

    ! nitrogen balance structures (pft and column levels)

    call init_nitrogen_balance_type(begp, endp, clm3%g%l%c%p%pnbal)
    call init_nitrogen_balance_type(begc, endc, clm3%g%l%c%cnbal)

    ! pft physical state variables at pft level and averaged to the column

    call init_pft_pstate_type(begp, endp, clm3%g%l%c%p%pps)
    call init_pft_pstate_type(begc, endc, clm3%g%l%c%cps%pps_a)

    ! pft ecophysiological variables (only at the pft level for now)
    call init_pft_epv_type(begp, endp, clm3%g%l%c%p%pepv)

#if (defined CNDV) || (defined CROP)
    ! pft DGVM state variables at pft level and averaged to column

    call init_pft_pdgvstate_type(begp, endp, clm3%g%l%c%p%pdgvs)
#endif
#if (defined CNDV)
    call init_pft_pdgvstate_type(begc, endc, clm3%g%l%c%cdgvs%pdgvs_a)
#endif
    call init_pft_vstate_type(begp, endp, clm3%g%l%c%p%pvs)

    ! pft energy state variables at the pft level and averaged to the column

    call init_pft_estate_type(begp, endp, clm3%g%l%c%p%pes)
    call init_pft_estate_type(begc, endc, clm3%g%l%c%ces%pes_a)

    ! pft water state variables at the pft level and averaged to the column

    call init_pft_wstate_type(begp, endp, clm3%g%l%c%p%pws)
    call init_pft_wstate_type(begc, endc, clm3%g%l%c%cws%pws_a)

    ! pft carbon state variables at the pft level and averaged to the column

    call init_pft_cstate_type(begp, endp, clm3%g%l%c%p%pcs)
    call init_pft_cstate_type(begc, endc, clm3%g%l%c%ccs%pcs_a)
#if (defined C13)
    ! 4/14/05: PET
    ! Adding isotope code
    call init_pft_cstate_type(begp, endp, clm3%g%l%c%p%pc13s)
    call init_pft_cstate_type(begc, endc, clm3%g%l%c%cc13s%pcs_a)
#endif

    ! pft nitrogen state variables at the pft level and averaged to the column

    call init_pft_nstate_type(begp, endp, clm3%g%l%c%p%pns)
    call init_pft_nstate_type(begc, endc, clm3%g%l%c%cns%pns_a)

    ! pft energy flux variables at pft level and averaged to column

    call init_pft_eflux_type(begp, endp, clm3%g%l%c%p%pef)
    call init_pft_eflux_type(begc, endc, clm3%g%l%c%cef%pef_a)

    ! pft momentum flux variables at pft level and averaged to the column

    call init_pft_mflux_type(begp, endp, clm3%g%l%c%p%pmf)
    call init_pft_mflux_type(begc, endc, clm3%g%l%c%cmf%pmf_a)

    ! pft water flux variables

    call init_pft_wflux_type(begp, endp, clm3%g%l%c%p%pwf)
    call init_pft_wflux_type(begc, endc, clm3%g%l%c%cwf%pwf_a)

    ! pft carbon flux variables at pft level and averaged to column

    call init_pft_cflux_type(begp, endp, clm3%g%l%c%p%pcf)
    call init_pft_cflux_type(begc, endc, clm3%g%l%c%ccf%pcf_a)
#if (defined C13)
    ! 4/14/05: PET
    ! Adding isotope code
    call init_pft_cflux_type(begp, endp, clm3%g%l%c%p%pc13f)
    call init_pft_cflux_type(begc, endc, clm3%g%l%c%cc13f%pcf_a)
#endif

    ! pft nitrogen flux variables at pft level and averaged to column

    call init_pft_nflux_type(begp, endp, clm3%g%l%c%p%pnf)
    call init_pft_nflux_type(begc, endc, clm3%g%l%c%cnf%pnf_a)

    ! pft VOC flux variables at pft level and averaged to column

    call init_pft_vflux_type(begp, endp, clm3%g%l%c%p%pvf)
    call init_pft_vflux_type(begc, endc, clm3%g%l%c%cvf%pvf_a)

    ! gridcell VOC emission factors (heald, 05/06)

    call init_gridcell_efstate_type(begg, endg, clm3%g%gve)

    ! pft dust flux variables at pft level and averaged to column

    call init_pft_dflux_type(begp, endp, clm3%g%l%c%p%pdf)
    call init_pft_dflux_type(begc, endc, clm3%g%l%c%cdf%pdf_a)

    ! pft dry dep velocity variables at pft level and averaged to column

    call init_pft_depvd_type(begp, endp, clm3%g%l%c%p%pdd)

    ! column physical state variables at column level and averaged to
    ! the landunit and gridcell and model

    call init_column_pstate_type(begc, endc, clm3%g%l%c%cps)
    call init_column_pstate_type(begl, endl, clm3%g%l%lps%cps_a)
    call init_column_pstate_type(begg, endg, clm3%g%gps%cps_a)
    call init_column_pstate_type(1,       1, clm3%mps%cps_a)

    ! column energy state variables at column level and averaged to
    ! the landunit and gridcell and model

    call init_column_estate_type(begc, endc, clm3%g%l%c%ces)
    call init_column_estate_type(begl, endl, clm3%g%l%les%ces_a)
    call init_column_estate_type(begg, endg, clm3%g%ges%ces_a)
    call init_column_estate_type(1,       1, clm3%mes%ces_a)

    ! column water state variables at column level and averaged to
    ! the landunit and gridcell and model

    call init_column_wstate_type(begc, endc, clm3%g%l%c%cws)
    call init_column_wstate_type(begl, endl, clm3%g%l%lws%cws_a)
    call init_column_wstate_type(begg, endg, clm3%g%gws%cws_a)
    call init_column_wstate_type(1,       1, clm3%mws%cws_a)

    ! column carbon state variables at column level and averaged to
    ! the landunit and gridcell and model

    call init_column_cstate_type(begc, endc, clm3%g%l%c%ccs)
    call init_column_cstate_type(begl, endl, clm3%g%l%lcs%ccs_a)
    call init_column_cstate_type(begg, endg, clm3%g%gcs%ccs_a)
    call init_column_cstate_type(1,       1, clm3%mcs%ccs_a)
#if (defined C13)
    ! 4/14/05: PET
    ! Adding isotope code
    call init_column_cstate_type(begc, endc, clm3%g%l%c%cc13s)
#endif

    ! column nitrogen state variables at column level and averaged to
    ! the landunit and gridcell and model

    call init_column_nstate_type(begc, endc, clm3%g%l%c%cns)
    call init_column_nstate_type(begl, endl, clm3%g%l%lns%cns_a)
    call init_column_nstate_type(begg, endg, clm3%g%gns%cns_a)
    call init_column_nstate_type(1,       1, clm3%mns%cns_a)

    ! column energy flux variables at column level and averaged to
    ! the landunit and gridcell and model

    call init_column_eflux_type(begc, endc, clm3%g%l%c%cef)
    call init_column_eflux_type(begl, endl, clm3%g%l%lef%cef_a)
    call init_column_eflux_type(begg, endg, clm3%g%gef%cef_a)
    call init_column_eflux_type(1,       1, clm3%mef%cef_a)

    ! column water flux variables at column level and averaged to
    ! landunit, gridcell and model level

    call init_column_wflux_type(begc, endc, clm3%g%l%c%cwf)
    call init_column_wflux_type(begl, endl, clm3%g%l%lwf%cwf_a)
    call init_column_wflux_type(begg, endg, clm3%g%gwf%cwf_a)
    call init_column_wflux_type(1,       1, clm3%mwf%cwf_a)

    ! column carbon flux variables at column level

    call init_column_cflux_type(begc, endc, clm3%g%l%c%ccf)
#if (defined C13)
    ! 4/14/05: PET
    ! Adding isotope code
    call init_column_cflux_type(begc, endc, clm3%g%l%c%cc13f)
#endif

    ! column nitrogen flux variables at column level

    call init_column_nflux_type(begc, endc, clm3%g%l%c%cnf)

    ! land unit physical state variables

    call init_landunit_pstate_type(begl, endl, clm3%g%l%lps)

    ! land unit energy flux variables 

    call init_landunit_eflux_type(begl, endl, clm3%g%l%lef)

#if (defined CNDV)
    ! gridcell DGVM variables

    call init_gridcell_dgvstate_type(begg, endg, clm3%g%gdgvs)
#endif

    ! gridcell physical state variables

    call init_gridcell_pstate_type(begg, endg, clm3%g%gps)

    ! gridcell: water flux variables

    call init_gridcell_wflux_type(begg, endg, clm3%g%gwf)

    ! gridcell: energy flux variables

    call init_gridcell_eflux_type(begg, endg, clm3%g%gef)

    ! gridcell: water state variables

    call init_gridcell_wstate_type(begg, endg, clm3%g%gws)

    ! gridcell: energy state variables

    call init_gridcell_estate_type(begg, endg, clm3%g%ges)

    call init_atm2lnd_type  (begg    , endg    , clm_a2l)

  end subroutine initClmtype

!------------------------------------------------------------------------
!BOP
!
! !IROUTINE: init_pft_type
!
! !INTERFACE:
  subroutine init_pft_type (beg, end, p)
!
! !DESCRIPTION:
! Initialize components of pft_type structure
!
! !ARGUMENTS:
    implicit none
    integer, intent(in) :: beg, end
    type(pft_type), intent(inout):: p
!
! !REVISION HISTORY:
! Created by Mariana Vertenstein
!
!EOP
!------------------------------------------------------------------------

    allocate(p%gridcell(beg:end),p%wtgcell(beg:end))
    allocate(p%landunit(beg:end),p%wtlunit(beg:end))
    allocate(p%column  (beg:end),p%wtcol  (beg:end))

    allocate(p%itype(beg:end))
    allocate(p%mxy(beg:end))
    allocate(p%area(beg:end))

  end subroutine init_pft_type

!------------------------------------------------------------------------
!BOP
!
! !IROUTINE: init_column_type
!
! !INTERFACE:
  subroutine init_column_type (beg, end, c)
!
! !DESCRIPTION:
! Initialize components of column_type structure
!
! !ARGUMENTS:
    implicit none
    integer, intent(in) :: beg, end
    type(column_type), intent(inout):: c
!
! !REVISION HISTORY:
! Created by Mariana Vertenstein
!
!EOP
!------------------------------------------------------------------------

   allocate(c%gridcell(beg:end),c%wtgcell(beg:end))
   allocate(c%landunit(beg:end),c%wtlunit(beg:end))

   allocate(c%pfti(beg:end),c%pftf(beg:end),c%npfts(beg:end))

   allocate(c%itype(beg:end))

   allocate(c%area(beg:end))

  end subroutine init_column_type

!------------------------------------------------------------------------
!BOP
!
! !IROUTINE: init_landunit_type
!
! !INTERFACE:
  subroutine init_landunit_type (beg, end,l)
!
! !DESCRIPTION:
! Initialize components of landunit_type structure
!
! !ARGUMENTS:
    implicit none
    integer, intent(in) :: beg, end
    type(landunit_type), intent(inout):: l
!
! !REVISION HISTORY:
! Created by Mariana Vertenstein
!
!EOP
!------------------------------------------------------------------------

   allocate(l%gridcell(beg:end),l%wtgcell(beg:end))

   allocate(l%coli(beg:end),l%colf(beg:end),l%ncolumns(beg:end))
   allocate(l%pfti(beg:end),l%pftf(beg:end),l%npfts   (beg:end))

   allocate(l%itype(beg:end))
   allocate(l%ifspecial(beg:end))
   allocate(l%lakpoi(beg:end))
   allocate(l%urbpoi(beg:end))

   ! MV - these should be moved to landunit physical state -MV
   allocate(l%canyon_hwr(beg:end))
   allocate(l%wtroad_perv(beg:end))
   allocate(l%ht_roof(beg:end))
   allocate(l%wtlunit_roof(beg:end))
   allocate(l%wind_hgt_canyon(beg:end))
   allocate(l%z_0_town(beg:end))
   allocate(l%z_d_town(beg:end))
   allocate(l%area(beg:end))


   l%canyon_hwr(beg:end)  = nan
   l%wtroad_perv(beg:end) = nan
   l%ht_roof(beg:end) = nan
   l%wtlunit_roof(beg:end) = nan
   l%wind_hgt_canyon(beg:end) = nan
   l%z_0_town(beg:end) = nan
   l%z_d_town(beg:end) = nan

  end subroutine init_landunit_type

!------------------------------------------------------------------------
!BOP
!
! !IROUTINE: init_gridcell_type
!
! !INTERFACE:
  subroutine init_gridcell_type (beg, end,g)
!
! !DESCRIPTION:
! Initialize components of gridcell_type structure
!
! !ARGUMENTS:
    implicit none
    integer, intent(in) :: beg, end
    type(gridcell_type), intent(inout):: g
!
! !REVISION HISTORY:
! Created by Mariana Vertenstein
!
!EOP
!------------------------------------------------------------------------

   allocate(g%luni(beg:end),g%lunf(beg:end),g%nlandunits(beg:end))
   allocate(g%coli(beg:end),g%colf(beg:end),g%ncolumns  (beg:end))
   allocate(g%pfti(beg:end),g%pftf(beg:end),g%npfts     (beg:end))

   allocate(g%gindex(beg:end))
   allocate(g%area(beg:end))
   allocate(g%lat(beg:end))
   allocate(g%lon(beg:end))
   allocate(g%latdeg(beg:end))
   allocate(g%londeg(beg:end))
   allocate(g%gindex_a(beg:end))
   allocate(g%lat_a(beg:end))
   allocate(g%lon_a(beg:end))
   allocate(g%latdeg_a(beg:end))
   allocate(g%londeg_a(beg:end))

  end subroutine init_gridcell_type

!------------------------------------------------------------------------
!BOP
!
! !IROUTINE: init_energy_balance_type
!
! !INTERFACE:
  subroutine init_energy_balance_type(beg, end, ebal)
!
! !DESCRIPTION:
! Initialize energy balance variables
!
! !ARGUMENTS:
    implicit none
    integer, intent(in) :: beg, end
    type(energy_balance_type), intent(inout):: ebal
!
! !REVISION HISTORY:
! Created by Mariana Vertenstein
!
!EOP
!------------------------------------------------------------------------

    allocate(ebal%errsoi(beg:end))
    allocate(ebal%errseb(beg:end))
    allocate(ebal%errsol(beg:end))
    allocate(ebal%errlon(beg:end))

    ebal%errsoi(beg:end) = nan
    ebal%errseb(beg:end) = nan
    ebal%errsol(beg:end) = nan
    ebal%errlon(beg:end) = nan

  end subroutine init_energy_balance_type

!------------------------------------------------------------------------
!BOP
!
! !IROUTINE: init_water_balance_type
!
! !INTERFACE:
  subroutine init_water_balance_type(beg, end, wbal)
!
! !DESCRIPTION:
! Initialize water balance variables
!
! !ARGUMENTS:
    implicit none
    integer, intent(in) :: beg, end
    type(water_balance_type), intent(inout):: wbal
!
! !REVISION HISTORY:
! Created by Mariana Vertenstein
!
!EOP
!------------------------------------------------------------------------

    allocate(wbal%begwb(beg:end))
    allocate(wbal%endwb(beg:end))
    allocate(wbal%errh2o(beg:end))

    wbal%begwb(beg:end) = nan
    wbal%endwb(beg:end) = nan
    wbal%errh2o(beg:end) = nan

  end subroutine init_water_balance_type

!------------------------------------------------------------------------
!BOP
!
! !IROUTINE: init_carbon_balance_type
!
! !INTERFACE:
  subroutine init_carbon_balance_type(beg, end, cbal)
!
! !DESCRIPTION:
! Initialize carbon balance variables
!
! !ARGUMENTS:
    implicit none
    integer, intent(in) :: beg, end
    type(carbon_balance_type), intent(inout):: cbal
!
! !REVISION HISTORY:
! Created by Peter Thornton, 12/11/2003
!
!EOP
!------------------------------------------------------------------------

    allocate(cbal%begcb(beg:end))
    allocate(cbal%endcb(beg:end))
    allocate(cbal%errcb(beg:end))

    cbal%begcb(beg:end) = nan
    cbal%endcb(beg:end) = nan
    cbal%errcb(beg:end) = nan

  end subroutine init_carbon_balance_type

!------------------------------------------------------------------------
!BOP
!
! !IROUTINE: init_nitrogen_balance_type
!
! !INTERFACE:
  subroutine init_nitrogen_balance_type(beg, end, nbal)
!
! !DESCRIPTION:
! Initialize nitrogen balance variables
!
! !ARGUMENTS:
    implicit none
    integer, intent(in) :: beg, end
    type(nitrogen_balance_type), intent(inout):: nbal
!
! !REVISION HISTORY:
! Created by Peter Thornton, 12/11/2003
!
!EOP
!------------------------------------------------------------------------

    allocate(nbal%begnb(beg:end))
    allocate(nbal%endnb(beg:end))
    allocate(nbal%errnb(beg:end))

    nbal%begnb(beg:end) = nan
    nbal%endnb(beg:end) = nan
    nbal%errnb(beg:end) = nan

  end subroutine init_nitrogen_balance_type

!------------------------------------------------------------------------
!BOP
!
! !IROUTINE: init_pft_ecophys_constants
!
! !INTERFACE:
  subroutine init_pft_ecophys_constants()
!
! !DESCRIPTION:
! Initialize pft physical state
!
! !ARGUMENTS:
    implicit none
!
! !REVISION HISTORY:
! Created by Mariana Vertenstein
!
!EOP
!------------------------------------------------------------------------

    allocate(pftcon%noveg(0:numpft))
    allocate(pftcon%tree(0:numpft))
    allocate(pftcon%smpso(0:numpft)) 
    allocate(pftcon%smpsc(0:numpft)) 
    allocate(pftcon%fnitr(0:numpft))
    allocate(pftcon%foln(0:numpft))
    allocate(pftcon%dleaf(0:numpft))
    allocate(pftcon%c3psn(0:numpft))
    allocate(pftcon%vcmx25(0:numpft))
    allocate(pftcon%mp(0:numpft))
    allocate(pftcon%qe25(0:numpft))
    allocate(pftcon%xl(0:numpft))
    allocate(pftcon%rhol(0:numpft,numrad))
    allocate(pftcon%rhos(0:numpft,numrad))
    allocate(pftcon%taul(0:numpft,numrad))
    allocate(pftcon%taus(0:numpft,numrad))
    allocate(pftcon%z0mr(0:numpft))
    allocate(pftcon%displar(0:numpft))
    allocate(pftcon%roota_par(0:numpft))
    allocate(pftcon%rootb_par(0:numpft))
    allocate(pftcon%sla(0:numpft))
    allocate(pftcon%slatop(0:numpft))
    allocate(pftcon%dsladlai(0:numpft))
    allocate(pftcon%leafcn(0:numpft))
    allocate(pftcon%flnr(0:numpft))
    allocate(pftcon%woody(0:numpft))
    allocate(pftcon%lflitcn(0:numpft))
    allocate(pftcon%frootcn(0:numpft))
    allocate(pftcon%livewdcn(0:numpft))
    allocate(pftcon%deadwdcn(0:numpft))
#ifdef CROP
    allocate(pftcon%graincn(0:numpft))
#endif
    allocate(pftcon%froot_leaf(0:numpft))
    allocate(pftcon%stem_leaf(0:numpft))
    allocate(pftcon%croot_stem(0:numpft))
    allocate(pftcon%flivewd(0:numpft))
    allocate(pftcon%fcur(0:numpft))
    allocate(pftcon%lf_flab(0:numpft))
    allocate(pftcon%lf_fcel(0:numpft))
    allocate(pftcon%lf_flig(0:numpft))
    allocate(pftcon%fr_flab(0:numpft))
    allocate(pftcon%fr_fcel(0:numpft))
    allocate(pftcon%fr_flig(0:numpft))
    allocate(pftcon%dw_fcel(0:numpft))
    allocate(pftcon%dw_flig(0:numpft))
    allocate(pftcon%leaf_long(0:numpft))
    allocate(pftcon%evergreen(0:numpft))
    allocate(pftcon%stress_decid(0:numpft))
    allocate(pftcon%season_decid(0:numpft))
    allocate(pftcon%resist(0:numpft))
    allocate(pftcon%dwood(0:numpft))

    pftcon%noveg(:) = bigint
    pftcon%tree(:) = bigint
    pftcon%smpso(:) = nan
    pftcon%smpsc(:) = nan
    pftcon%fnitr(:) = nan
    pftcon%foln(:) = nan
    pftcon%dleaf(:) = nan
    pftcon%c3psn(:) = nan
    pftcon%vcmx25(:) = nan
    pftcon%mp(:) = nan
    pftcon%qe25(:) = nan
    pftcon%xl(:) = nan
    pftcon%rhol(:,:numrad) = nan
    pftcon%rhos(:,:numrad) = nan
    pftcon%taul(:,:numrad) = nan
    pftcon%taus(:,:numrad) = nan
    pftcon%z0mr(:) = nan
    pftcon%displar(:) = nan
    pftcon%roota_par(:) = nan
    pftcon%rootb_par(:) = nan
    pftcon%sla(:) = nan
    pftcon%slatop(:) = nan
    pftcon%dsladlai(:) = nan
    pftcon%leafcn(:) = nan
    pftcon%flnr(:) = nan
    pftcon%woody(:) = nan
    pftcon%lflitcn(:) = nan
    pftcon%frootcn(:) = nan
    pftcon%livewdcn(:) = nan
    pftcon%deadwdcn(:) = nan
#ifdef CROP
    pftcon%graincn(:) = nan
#endif
    pftcon%froot_leaf(:) = nan
    pftcon%stem_leaf(:) = nan
    pftcon%croot_stem(:) = nan
    pftcon%flivewd(:) = nan
    pftcon%fcur(:) = nan
    pftcon%lf_flab(:) = nan
    pftcon%lf_fcel(:) = nan
    pftcon%lf_flig(:) = nan
    pftcon%fr_flab(:) = nan
    pftcon%fr_fcel(:) = nan
    pftcon%fr_flig(:) = nan
    pftcon%dw_fcel(:) = nan
    pftcon%dw_flig(:) = nan
    pftcon%leaf_long(:) = nan
    pftcon%evergreen(:) = nan
    pftcon%stress_decid(:) = nan
    pftcon%season_decid(:) = nan
    pftcon%resist(:) = nan
    pftcon%dwood(:) = nan

  end subroutine init_pft_ecophys_constants

#if (defined CNDV) || (defined CROP)
!------------------------------------------------------------------------
!BOP
!
! !IROUTINE: init_pft_DGVMecophys_constants
!
! !INTERFACE:
  subroutine init_pft_DGVMecophys_constants()
!
! !DESCRIPTION:
! Initialize pft physical state
!
! !ARGUMENTS:
    implicit none
!
! !REVISION HISTORY:
! Created by Mariana Vertenstein
!
!EOP
!------------------------------------------------------------------------

    allocate(dgv_pftcon%crownarea_max(0:numpft))
    allocate(dgv_pftcon%tcmin(0:numpft))
    allocate(dgv_pftcon%tcmax(0:numpft))
    allocate(dgv_pftcon%gddmin(0:numpft))
    allocate(dgv_pftcon%twmax(0:numpft))
    allocate(dgv_pftcon%reinickerp(0:numpft))
    allocate(dgv_pftcon%allom1(0:numpft))
    allocate(dgv_pftcon%allom2(0:numpft))
    allocate(dgv_pftcon%allom3(0:numpft))

    dgv_pftcon%crownarea_max(:) = nan
    dgv_pftcon%tcmin(:) = nan
    dgv_pftcon%tcmax(:) = nan
    dgv_pftcon%gddmin(:) = nan
    dgv_pftcon%twmax(:) = nan
    dgv_pftcon%reinickerp(:) = nan
    dgv_pftcon%allom1(:) = nan
    dgv_pftcon%allom2(:) = nan
    dgv_pftcon%allom3(:) = nan

  end subroutine init_pft_DGVMecophys_constants
#endif

!------------------------------------------------------------------------
!BOP
!
! !IROUTINE: init_pft_pstate_type
!
! !INTERFACE:
  subroutine init_pft_pstate_type(beg, end, pps)
!
! !DESCRIPTION:
! Initialize pft physical state
!
! !USES:
    use clm_varcon, only : spval
#if (defined CASA)
    use CASAMod   , only : npools, nresp_pools, nlive, npool_types
#endif
! !ARGUMENTS:
    implicit none
    integer, intent(in) :: beg, end
    type (pft_pstate_type), intent(inout):: pps
!
! !REVISION HISTORY:
! Created by Mariana Vertenstein
!
!EOP
!------------------------------------------------------------------------

    allocate(pps%frac_veg_nosno(beg:end))
    allocate(pps%frac_veg_nosno_alb(beg:end))
    allocate(pps%emv(beg:end))
    allocate(pps%z0mv(beg:end))
    allocate(pps%z0hv(beg:end))
    allocate(pps%z0qv(beg:end))
    allocate(pps%rootfr(beg:end,1:nlevgrnd))
    allocate(pps%rootr(beg:end,1:nlevgrnd))
    allocate(pps%rresis(beg:end,1:nlevgrnd))
    allocate(pps%dewmx(beg:end))
    allocate(pps%rssun(beg:end))
    allocate(pps%rssha(beg:end))
    allocate(pps%laisun(beg:end))
    allocate(pps%laisha(beg:end))
    allocate(pps%btran(beg:end))
    allocate(pps%fsun(beg:end))
    allocate(pps%tlai(beg:end))
    allocate(pps%tsai(beg:end))
    allocate(pps%elai(beg:end))
    allocate(pps%esai(beg:end))
    allocate(pps%fwet(beg:end))
    allocate(pps%fdry(beg:end))
    allocate(pps%dt_veg(beg:end))
    allocate(pps%htop(beg:end))
    allocate(pps%hbot(beg:end))
    allocate(pps%z0m(beg:end))
    allocate(pps%displa(beg:end))
    allocate(pps%albd(beg:end,1:numrad))
    allocate(pps%albi(beg:end,1:numrad))
    allocate(pps%fabd(beg:end,1:numrad))
    allocate(pps%fabi(beg:end,1:numrad))
    allocate(pps%ftdd(beg:end,1:numrad))
    allocate(pps%ftid(beg:end,1:numrad))
    allocate(pps%ftii(beg:end,1:numrad))
    allocate(pps%u10(beg:end))
    allocate(pps%fv(beg:end))
    allocate(pps%ram1(beg:end))
#if (defined CROP)
    allocate(pps%hdidx(beg:end))
    allocate(pps%cumvd(beg:end))
    allocate(pps%htmx(beg:end))
    allocate(pps%vf(beg:end))
    allocate(pps%gddmaturity(beg:end))
    allocate(pps%gdd0(beg:end))
    allocate(pps%gdd8(beg:end))
    allocate(pps%gdd10(beg:end))
    allocate(pps%gdd020(beg:end))
    allocate(pps%gdd820(beg:end))
    allocate(pps%gdd1020(beg:end))
    allocate(pps%gddplant(beg:end))
    allocate(pps%gddtsoi(beg:end))
    allocate(pps%huileaf(beg:end))
    allocate(pps%huigrain(beg:end))
    allocate(pps%a10tmin(beg:end))
    allocate(pps%a5tmin(beg:end))
    allocate(pps%aleafi(beg:end))
    allocate(pps%astemi(beg:end))
    allocate(pps%aleaf(beg:end))
    allocate(pps%astem(beg:end))
    allocate(pps%croplive(beg:end))
    allocate(pps%cropplant(beg:end)) !,numpft)) ! make 2-D if using
    allocate(pps%harvdate(beg:end))  !,numpft)) ! crop rotation
    allocate(pps%idop(beg:end))
    allocate(pps%peaklai(beg:end))
#endif
    allocate(pps%vds(beg:end))
    allocate(pps%slasun(beg:end))
    allocate(pps%slasha(beg:end))
    allocate(pps%lncsun(beg:end))
    allocate(pps%lncsha(beg:end))
    allocate(pps%vcmxsun(beg:end))
    allocate(pps%vcmxsha(beg:end))
    allocate(pps%gdir(beg:end))
    allocate(pps%omega(beg:end,1:numrad))
    allocate(pps%eff_kid(beg:end,1:numrad))
    allocate(pps%eff_kii(beg:end,1:numrad))
    allocate(pps%sun_faid(beg:end,1:numrad))
    allocate(pps%sun_faii(beg:end,1:numrad))
    allocate(pps%sha_faid(beg:end,1:numrad))
    allocate(pps%sha_faii(beg:end,1:numrad))
    allocate(pps%forc_hgt_u_pft(beg:end))
    allocate(pps%forc_hgt_t_pft(beg:end))
    allocate(pps%forc_hgt_q_pft(beg:end))
    ! 4/14/05: PET
    ! Adding isotope code
    allocate(pps%cisun(beg:end))
    allocate(pps%cisha(beg:end))
#if (defined C13)
    allocate(pps%alphapsnsun(beg:end))
    allocate(pps%alphapsnsha(beg:end))
#endif
    ! heald: added from CASA definition
    allocate(pps%sandfrac(beg:end))
    allocate(pps%clayfrac(beg:end))
    pps%sandfrac(beg:end) = nan
    pps%clayfrac(beg:end) = nan
    allocate(pps%mlaidiff(beg:end))
    allocate(pps%rb1(beg:end))
    allocate(pps%annlai(12,beg:end))
    pps%mlaidiff(beg:end) = nan
    pps%rb1(beg:end) = nan
    pps%annlai(:,:) = nan

    
#if (defined CASA)
    allocate(pps%Closs(beg:end,npools))  ! C lost to atm
    allocate(pps%Ctrans(beg:end,npool_types))  ! C transfers out of pool types
    allocate(pps%Resp_C(beg:end,npools))
    allocate(pps%Tpool_C(beg:end,npools))! Total C pool size
    allocate(pps%eff(beg:end,nresp_pools))
    allocate(pps%frac_donor(beg:end,nresp_pools))
    allocate(pps%livefr(beg:end,nlive))  !live fraction
    allocate(pps%pet(beg:end))           !potential evaporation (mm h2o/s)
    allocate(pps%co2flux(beg:end))       ! net CO2 flux (g C/m2/sec) [+= atm]
    allocate(pps%fnpp(beg:end))          ! NPP  (g C/m2/sec)
    allocate(pps%soilt(beg:end))         !soil temp for top 30cm
    allocate(pps%smoist(beg:end))        !soil moisture for top 30cm
    allocate(pps%sz(beg:end))
    allocate(pps%watopt(beg:end))
    allocate(pps%watdry(beg:end))
    allocate(pps%soiltc(beg:end))         !soil temp for entire column
    allocate(pps%smoistc(beg:end))        !soil moisture for entire column
    allocate(pps%szc(beg:end))
    allocate(pps%watoptc(beg:end))
    allocate(pps%watdryc(beg:end))
    allocate(pps%Wlim(beg:end))
    allocate(pps%litterscalar(beg:end))
    allocate(pps%rootlitscalar(beg:end))
    allocate(pps%stressCD(beg:end))
    allocate(pps%excessC(beg:end))       ! excess Carbon (gC/m2/timestep)
    allocate(pps%bgtemp(beg:end))
    allocate(pps%bgmoist(beg:end))
    allocate(pps%plai(beg:end))          ! prognostic LAI (m2 leaf/m2 ground)
    allocate(pps%Cflux(beg:end))
    allocate(pps%XSCpool(beg:end))
    allocate(pps%tday(beg:end))     ! daily accumulated temperature (deg C)
    allocate(pps%tdayavg(beg:end))  ! daily averaged temperature (deg C)
    allocate(pps%tcount(beg:end))   ! counter for daily avg temp
    allocate(pps%degday(beg:end))   ! accumulated degree days (deg C)
    allocate(pps%ndegday(beg:end))  ! counter for number of degree days
    allocate(pps%stressT(beg:end))
    allocate(pps%stressW(beg:end))  ! water stress function for leaf loss
    allocate(pps%iseabeg(beg:end))  ! index for start of growing season
    allocate(pps%nstepbeg(beg:end)) ! nstep at start of growing season
    allocate(pps%lgrow(beg:end))    ! growing season index (0 or 1) to be
                                    ! passed daily to CASA to get NPP
#if (defined CLAMP)
    ! Summary variables added for the C-LAMP Experiments
    allocate(pps%casa_agnpp(beg:end))
    allocate(pps%casa_ar(beg:end))
    allocate(pps%casa_bgnpp(beg:end))
    allocate(pps%casa_cwdc(beg:end))
    allocate(pps%casa_cwdc_hr(beg:end))
    allocate(pps%casa_cwdc_loss(beg:end))
    allocate(pps%casa_frootc(beg:end))
    allocate(pps%casa_frootc_alloc(beg:end))
    allocate(pps%casa_frootc_loss(beg:end))
    allocate(pps%casa_gpp(beg:end))
    allocate(pps%casa_hr(beg:end))
    allocate(pps%casa_leafc(beg:end))
    allocate(pps%casa_leafc_alloc(beg:end))
    allocate(pps%casa_leafc_loss(beg:end))
    allocate(pps%casa_litterc(beg:end))
    allocate(pps%casa_litterc_hr(beg:end))
    allocate(pps%casa_litterc_loss(beg:end))
    allocate(pps%casa_nee(beg:end))
    allocate(pps%casa_nep(beg:end))
    allocate(pps%casa_npp(beg:end))
    allocate(pps%casa_soilc(beg:end))
    allocate(pps%casa_soilc_hr(beg:end))
    allocate(pps%casa_soilc_loss(beg:end))
    allocate(pps%casa_woodc(beg:end))
    allocate(pps%casa_woodc_alloc(beg:end))
    allocate(pps%casa_woodc_loss(beg:end))
#endif
#endif

    pps%frac_veg_nosno(beg:end) = bigint
    pps%frac_veg_nosno_alb(beg:end) = 0
    pps%emv(beg:end) = nan
    pps%z0mv(beg:end) = nan
    pps%z0hv(beg:end) = nan
    pps%z0qv(beg:end) = nan
    pps%rootfr(beg:end,:nlevgrnd) = spval
    pps%rootr (beg:end,:nlevgrnd) = spval
    pps%rresis(beg:end,:nlevgrnd) = spval
    pps%dewmx(beg:end) = nan
    pps%rssun(beg:end) = nan
    pps%rssha(beg:end) = nan
    pps%laisun(beg:end) = nan
    pps%laisha(beg:end) = nan
    pps%btran(beg:end) = nan
    pps%fsun(beg:end) = spval
    pps%tlai(beg:end) = 0._r8
    pps%tsai(beg:end) = 0._r8
    pps%elai(beg:end) = 0._r8
    pps%esai(beg:end) = 0._r8
    pps%fwet(beg:end) = nan
    pps%fdry(beg:end) = nan
    pps%dt_veg(beg:end) = nan
    pps%htop(beg:end) = 0._r8
    pps%hbot(beg:end) = 0._r8
    pps%z0m(beg:end) = nan
    pps%displa(beg:end) = nan
    pps%albd(beg:end,:numrad) = nan
    pps%albi(beg:end,:numrad) = nan
    pps%fabd(beg:end,:numrad) = nan
    pps%fabi(beg:end,:numrad) = nan
    pps%ftdd(beg:end,:numrad) = nan
    pps%ftid(beg:end,:numrad) = nan
    pps%ftii(beg:end,:numrad) = nan
    pps%u10(beg:end) = nan
    pps%fv(beg:end) = nan
    pps%ram1(beg:end) = nan
#if (defined CROP)
    pps%hdidx(beg:end) = nan
    pps%cumvd(beg:end) = nan
    pps%htmx(beg:end) = nan
    pps%vf(beg:end) = nan
    pps%gddmaturity(beg:end) = nan
    pps%gdd0(beg:end) = nan
    pps%gdd8(beg:end) = nan
    pps%gdd10(beg:end) = nan
    pps%gdd020(beg:end) = nan
    pps%gdd820(beg:end) = nan
    pps%gdd1020(beg:end) = nan
    pps%gddplant(beg:end) = nan
    pps%gddtsoi(beg:end) = nan
    pps%huileaf(beg:end) = nan
    pps%huigrain(beg:end) = nan
    pps%a10tmin(beg:end) = nan
    pps%a5tmin(beg:end) = nan
    pps%aleafi(beg:end) = nan
    pps%astemi(beg:end) = nan
    pps%aleaf(beg:end) = nan
    pps%astem(beg:end) = nan
    pps%croplive(beg:end) = bigint
    pps%cropplant(beg:end) = bigint
    pps%harvdate(beg:end) = bigint
    pps%idop(beg:end) = bigint
    pps%peaklai(beg:end) = bigint
#endif
    pps%vds(beg:end) = nan
    pps%slasun(beg:end) = nan
    pps%slasha(beg:end) = nan
    pps%lncsun(beg:end) = nan
    pps%lncsha(beg:end) = nan
    pps%vcmxsun(beg:end) = nan
    pps%vcmxsha(beg:end) = nan
    pps%gdir(beg:end) = nan
    pps%omega(beg:end,1:numrad) = nan
    pps%eff_kid(beg:end,1:numrad) = nan
    pps%eff_kii(beg:end,1:numrad) = nan
    pps%sun_faid(beg:end,1:numrad) = nan
    pps%sun_faii(beg:end,1:numrad) = nan
    pps%sha_faid(beg:end,1:numrad) = nan
    pps%sha_faii(beg:end,1:numrad) = nan
    pps%forc_hgt_u_pft(beg:end) = nan
    pps%forc_hgt_t_pft(beg:end) = nan
    pps%forc_hgt_q_pft(beg:end) = nan
    ! 4/14/05: PET
    ! Adding isotope code
    pps%cisun(beg:end) = nan
    pps%cisha(beg:end) = nan
#if (defined C13)
    pps%alphapsnsun(beg:end) = nan
    pps%alphapsnsha(beg:end) = nan
#endif

#if (defined CASA)
    pps%Closs(beg:end,:npools) = spval   !init w/ spval the variables that
    pps%Ctrans(beg:end,:npool_types) = spval   !init w/ spval the variables that
    pps%Resp_C(beg:end,:npools) = nan    !go to history, because CASA
    pps%Tpool_C(beg:end,:npools) = spval !routines do not get called on
    pps%livefr(beg:end,:nlive) = spval   !first timestep of nsrest=0 and
    pps%pet(beg:end) = spval             !history would get nans
    pps%co2flux(beg:end) = nan           !in the first timestep
    pps%fnpp(beg:end) = nan
    pps%excessC(beg:end) = spval
    pps%bgtemp(beg:end) = spval
    pps%bgmoist(beg:end) = spval
    pps%plai(beg:end) = spval
    pps%Cflux(beg:end) = nan
    pps%XSCpool(beg:end) = spval
    pps%tdayavg(beg:end) = spval
    pps%degday(beg:end) = spval
    pps%stressT(beg:end) = spval
    pps%stressW(beg:end) = spval
    pps%stressCD(beg:end) = spval
    pps%iseabeg(beg:end) = spval
    pps%nstepbeg(beg:end) = spval
    pps%lgrow(beg:end) = spval
    pps%eff(beg:end,:nresp_pools) = nan
    pps%frac_donor(beg:end,:nresp_pools) = nan
    pps%soilt(beg:end) = spval                  ! on history file
    pps%smoist(beg:end) = spval                 ! on history file
    pps%sz(beg:end) = nan
    pps%watopt(beg:end) = nan
    pps%watdry(beg:end) = nan
    pps%soiltc(beg:end) = nan
    pps%smoistc(beg:end) = nan
    pps%szc(beg:end) = nan
    pps%watoptc(beg:end) = spval                ! on history file
    pps%watdryc(beg:end) = spval                ! on history file
    pps%Wlim(beg:end) = spval                   ! on history file
    pps%litterscalar(beg:end) = nan
    pps%rootlitscalar(beg:end) = nan
    pps%tday(beg:end) = nan
    pps%tcount(beg:end) = nan
    pps%ndegday(beg:end) = nan
#if (defined CLAMP)
    ! Summary variables added for the C-LAMP Experiments
    pps%casa_agnpp(beg:end) = nan
    pps%casa_ar(beg:end) = nan
    pps%casa_bgnpp(beg:end) = nan
    pps%casa_cwdc(beg:end) = nan
    pps%casa_cwdc_hr(beg:end) = nan
    pps%casa_cwdc_loss(beg:end) = nan
    pps%casa_frootc(beg:end) = nan
    pps%casa_frootc_alloc(beg:end) = nan
    pps%casa_frootc_loss(beg:end) = nan
    pps%casa_gpp(beg:end) = nan
    pps%casa_hr(beg:end) = nan
    pps%casa_leafc(beg:end) = nan
    pps%casa_leafc_alloc(beg:end) = nan
    pps%casa_leafc_loss(beg:end) = nan
    pps%casa_litterc(beg:end) = nan
    pps%casa_litterc_loss(beg:end) = nan
    pps%casa_nee(beg:end) = nan
    pps%casa_nep(beg:end) = nan
    pps%casa_npp(beg:end) = nan
    pps%casa_soilc(beg:end) = nan
    pps%casa_soilc_hr(beg:end) = nan
    pps%casa_soilc_loss(beg:end) = nan
    pps%casa_woodc(beg:end) = nan
    pps%casa_woodc_alloc(beg:end) = nan
    pps%casa_woodc_loss(beg:end) = nan
#endif
#endif

  end subroutine init_pft_pstate_type

!------------------------------------------------------------------------
!BOP
!
! !IROUTINE: init_pft_epv_type
!
! !INTERFACE:
  subroutine init_pft_epv_type(beg, end, pepv)
!
! !DESCRIPTION:
! Initialize pft ecophysiological variables
!
! !ARGUMENTS:
    implicit none
    integer, intent(in) :: beg, end
    type (pft_epv_type), intent(inout):: pepv
!
! !REVISION HISTORY:
! Created by Peter Thornton
!
!EOP
!------------------------------------------------------------------------

    allocate(pepv%dormant_flag(beg:end))
    allocate(pepv%days_active(beg:end))
    allocate(pepv%onset_flag(beg:end))
    allocate(pepv%onset_counter(beg:end))
    allocate(pepv%onset_gddflag(beg:end))
    allocate(pepv%onset_fdd(beg:end))
    allocate(pepv%onset_gdd(beg:end))
    allocate(pepv%onset_swi(beg:end))
    allocate(pepv%offset_flag(beg:end))
    allocate(pepv%offset_counter(beg:end))
    allocate(pepv%offset_fdd(beg:end))
    allocate(pepv%offset_swi(beg:end))
    allocate(pepv%lgsf(beg:end))
    allocate(pepv%bglfr(beg:end))
    allocate(pepv%bgtr(beg:end))
    allocate(pepv%dayl(beg:end))
    allocate(pepv%prev_dayl(beg:end))
    allocate(pepv%annavg_t2m(beg:end))
    allocate(pepv%tempavg_t2m(beg:end))
    allocate(pepv%gpp(beg:end))
    allocate(pepv%availc(beg:end))
    allocate(pepv%xsmrpool_recover(beg:end))
#if (defined C13)
    allocate(pepv%xsmrpool_c13ratio(beg:end))
#endif
    allocate(pepv%alloc_pnow(beg:end))
    allocate(pepv%c_allometry(beg:end))
    allocate(pepv%n_allometry(beg:end))
    allocate(pepv%plant_ndemand(beg:end))
    allocate(pepv%tempsum_potential_gpp(beg:end))
    allocate(pepv%annsum_potential_gpp(beg:end))
    allocate(pepv%tempmax_retransn(beg:end))
    allocate(pepv%annmax_retransn(beg:end))
    allocate(pepv%avail_retransn(beg:end))
    allocate(pepv%plant_nalloc(beg:end))
    allocate(pepv%plant_calloc(beg:end))
    allocate(pepv%excess_cflux(beg:end))
    allocate(pepv%downreg(beg:end))
    allocate(pepv%prev_leafc_to_litter(beg:end))
    allocate(pepv%prev_frootc_to_litter(beg:end))
    allocate(pepv%tempsum_npp(beg:end))
    allocate(pepv%annsum_npp(beg:end))
#if (defined CNDV)
    allocate(pepv%tempsum_litfall(beg:end))
    allocate(pepv%annsum_litfall(beg:end))
#endif
#if (defined C13)
    ! 4/21/05, PET
    ! Adding isotope code
    allocate(pepv%rc13_canair(beg:end))
    allocate(pepv%rc13_psnsun(beg:end))
    allocate(pepv%rc13_psnsha(beg:end))
#endif

    pepv%dormant_flag(beg:end) = nan
    pepv%days_active(beg:end) = nan
    pepv%onset_flag(beg:end) = nan
    pepv%onset_counter(beg:end) = nan
    pepv%onset_gddflag(beg:end) = nan
    pepv%onset_fdd(beg:end) = nan
    pepv%onset_gdd(beg:end) = nan
    pepv%onset_swi(beg:end) = nan
    pepv%offset_flag(beg:end) = nan
    pepv%offset_counter(beg:end) = nan
    pepv%offset_fdd(beg:end) = nan
    pepv%offset_swi(beg:end) = nan
    pepv%lgsf(beg:end) = nan
    pepv%bglfr(beg:end) = nan
    pepv%bgtr(beg:end) = nan
    pepv%dayl(beg:end) = nan
    pepv%prev_dayl(beg:end) = nan
    pepv%annavg_t2m(beg:end) = nan
    pepv%tempavg_t2m(beg:end) = nan
    pepv%gpp(beg:end) = nan
    pepv%availc(beg:end) = nan
    pepv%xsmrpool_recover(beg:end) = nan
#if (defined C13)
    pepv%xsmrpool_c13ratio(beg:end) = nan
#endif
    pepv%alloc_pnow(beg:end) = nan
    pepv%c_allometry(beg:end) = nan
    pepv%n_allometry(beg:end) = nan
    pepv%plant_ndemand(beg:end) = nan
    pepv%tempsum_potential_gpp(beg:end) = nan
    pepv%annsum_potential_gpp(beg:end) = nan
    pepv%tempmax_retransn(beg:end) = nan
    pepv%annmax_retransn(beg:end) = nan
    pepv%avail_retransn(beg:end) = nan
    pepv%plant_nalloc(beg:end) = nan
    pepv%plant_calloc(beg:end) = nan
    pepv%excess_cflux(beg:end) = nan
    pepv%downreg(beg:end) = nan
    pepv%prev_leafc_to_litter(beg:end) = nan
    pepv%prev_frootc_to_litter(beg:end) = nan
    pepv%tempsum_npp(beg:end) = nan
    pepv%annsum_npp(beg:end) = nan
#if (defined CNDV)
    pepv%tempsum_litfall(beg:end) = nan
    pepv%annsum_litfall(beg:end) = nan
#endif
#if (defined C13)
    ! 4/21/05, PET
    ! Adding isotope code
    pepv%rc13_canair(beg:end) = nan
    pepv%rc13_psnsun(beg:end) = nan
    pepv%rc13_psnsha(beg:end) = nan
#endif
    
  end subroutine init_pft_epv_type

#if (defined CNDV) || (defined CROP)
!------------------------------------------------------------------------
!BOP
!
! !IROUTINE: init_pft_pdgvstate_type
!
! !INTERFACE:
  subroutine init_pft_pdgvstate_type(beg, end, pdgvs)
!
! !DESCRIPTION:
! Initialize pft DGVM state variables
!
! !ARGUMENTS:
    implicit none
    integer, intent(in) :: beg, end
    type (pft_dgvstate_type), intent(inout):: pdgvs
!
! !REVISION HISTORY:
! Created by Mariana Vertenstein
!
!EOP
!------------------------------------------------------------------------

    allocate(pdgvs%agddtw(beg:end))
    allocate(pdgvs%agdd(beg:end))
    allocate(pdgvs%t10(beg:end))
    allocate(pdgvs%t_mo(beg:end))
    allocate(pdgvs%t_mo_min(beg:end))
    allocate(pdgvs%prec365(beg:end))
    allocate(pdgvs%present(beg:end))
    allocate(pdgvs%pftmayexist(beg:end))
    allocate(pdgvs%nind(beg:end))
    allocate(pdgvs%lm_ind(beg:end))
    allocate(pdgvs%lai_ind(beg:end))
    allocate(pdgvs%fpcinc(beg:end))
    allocate(pdgvs%fpcgrid(beg:end))
    allocate(pdgvs%fpcgridold(beg:end))
    allocate(pdgvs%crownarea(beg:end))
    allocate(pdgvs%greffic(beg:end))
    allocate(pdgvs%heatstress(beg:end))

    pdgvs%agddtw(beg:end)           = nan
    pdgvs%agdd(beg:end)             = nan
    pdgvs%t10(beg:end)              = nan
    pdgvs%t_mo(beg:end)             = nan
    pdgvs%t_mo_min(beg:end)         = nan
    pdgvs%prec365(beg:end)          = nan
    pdgvs%present(beg:end)          = .false.
    pdgvs%pftmayexist(beg:end)      = .true.
    pdgvs%nind(beg:end)             = nan
    pdgvs%lm_ind(beg:end)           = nan
    pdgvs%lai_ind(beg:end)          = nan
    pdgvs%fpcinc(beg:end)           = nan
    pdgvs%fpcgrid(beg:end)          = nan
    pdgvs%fpcgridold(beg:end)       = nan
    pdgvs%crownarea(beg:end)        = nan
    pdgvs%greffic(beg:end)          = nan
    pdgvs%heatstress(beg:end)       = nan

  end subroutine init_pft_pdgvstate_type
#endif

!------------------------------------------------------------------------
!BOP
!
! !IROUTINE: init_pft_vstate_type
!
! !INTERFACE:
  subroutine init_pft_vstate_type(beg, end, pvs)
!
! !DESCRIPTION:
! Initialize pft VOC variables
!
! !USES:
    use clm_varcon, only : spval
! !ARGUMENTS:
    implicit none
    integer, intent(in) :: beg, end
    type (pft_vstate_type), intent(inout):: pvs
!
! !REVISION HISTORY:
! Created by Erik Kluzek
!
!EOP
!------------------------------------------------------------------------

    allocate(pvs%t_veg24 (beg:end))
    allocate(pvs%t_veg240(beg:end))
    allocate(pvs%fsd24   (beg:end))
    allocate(pvs%fsd240  (beg:end))
    allocate(pvs%fsi24   (beg:end))
    allocate(pvs%fsi240  (beg:end))
    allocate(pvs%fsun24  (beg:end))
    allocate(pvs%fsun240 (beg:end))
    allocate(pvs%elai_p  (beg:end))

    pvs%t_veg24 (beg:end)   = spval
    pvs%t_veg240(beg:end)   = spval
    pvs%fsd24   (beg:end)   = spval
    pvs%fsd240  (beg:end)   = spval
    pvs%fsi24   (beg:end)   = spval
    pvs%fsi240  (beg:end)   = spval
    pvs%fsun24  (beg:end)   = spval
    pvs%fsun240 (beg:end)   = spval
    pvs%elai_p  (beg:end)   = spval
  end subroutine init_pft_vstate_type

!------------------------------------------------------------------------
!BOP
!
! !IROUTINE: init_pft_estate_type
!
! !INTERFACE:
  subroutine init_pft_estate_type(beg, end, pes)
!
! !DESCRIPTION:
! Initialize pft energy state
!
! !ARGUMENTS:
    implicit none
    integer, intent(in) :: beg, end
    type (pft_estate_type), intent(inout):: pes
!
! !REVISION HISTORY:
! Created by Mariana Vertenstein
!
!EOP
!------------------------------------------------------------------------

    allocate(pes%t_ref2m(beg:end))
    allocate(pes%t_ref2m_min(beg:end))
    allocate(pes%t_ref2m_max(beg:end))
    allocate(pes%t_ref2m_min_inst(beg:end))
    allocate(pes%t_ref2m_max_inst(beg:end))
    allocate(pes%q_ref2m(beg:end))
    allocate(pes%t_ref2m_u(beg:end))
    allocate(pes%t_ref2m_r(beg:end))
    allocate(pes%t_ref2m_min_u(beg:end))
    allocate(pes%t_ref2m_min_r(beg:end))
    allocate(pes%t_ref2m_max_u(beg:end))
    allocate(pes%t_ref2m_max_r(beg:end))
    allocate(pes%t_ref2m_min_inst_u(beg:end))
    allocate(pes%t_ref2m_min_inst_r(beg:end))
    allocate(pes%t_ref2m_max_inst_u(beg:end))
    allocate(pes%t_ref2m_max_inst_r(beg:end))
    allocate(pes%rh_ref2m(beg:end))
    allocate(pes%rh_ref2m_u(beg:end))
    allocate(pes%rh_ref2m_r(beg:end))
    allocate(pes%t_veg(beg:end))
    allocate(pes%thm(beg:end))

    pes%t_ref2m(beg:end) = nan
    pes%t_ref2m_min(beg:end) = nan
    pes%t_ref2m_max(beg:end) = nan
    pes%t_ref2m_min_inst(beg:end) = nan
    pes%t_ref2m_max_inst(beg:end) = nan
    pes%q_ref2m(beg:end) = nan
    pes%t_ref2m_u(beg:end) = nan
    pes%t_ref2m_r(beg:end) = nan
    pes%t_ref2m_min_u(beg:end) = nan
    pes%t_ref2m_min_r(beg:end) = nan
    pes%t_ref2m_max_u(beg:end) = nan
    pes%t_ref2m_max_r(beg:end) = nan
    pes%t_ref2m_min_inst_u(beg:end) = nan
    pes%t_ref2m_min_inst_r(beg:end) = nan
    pes%t_ref2m_max_inst_u(beg:end) = nan
    pes%t_ref2m_max_inst_r(beg:end) = nan
    pes%rh_ref2m(beg:end) = nan
    pes%rh_ref2m_u(beg:end) = nan
    pes%rh_ref2m_r(beg:end) = nan
    pes%t_veg(beg:end) = nan
    pes%thm(beg:end) = nan

  end subroutine init_pft_estate_type

!------------------------------------------------------------------------
!BOP
!
! !IROUTINE: init_pft_wstate_type
!
! !INTERFACE:
  subroutine init_pft_wstate_type(beg, end, pws)
!
! !DESCRIPTION:
! Initialize pft water state
!
! !ARGUMENTS:
    implicit none
    integer, intent(in) :: beg, end
    type (pft_wstate_type), intent(inout):: pws !pft water state
!
! !REVISION HISTORY:
! Created by Mariana Vertenstein
!
!EOP
!------------------------------------------------------------------------

    allocate(pws%h2ocan(beg:end))
    pws%h2ocan(beg:end) = nan

  end subroutine init_pft_wstate_type

!------------------------------------------------------------------------
!BOP
!
! !IROUTINE: init_pft_cstate_type
!
! !INTERFACE:
  subroutine init_pft_cstate_type(beg, end, pcs)
!
! !DESCRIPTION:
! Initialize pft carbon state
!
! !ARGUMENTS:
    implicit none
    integer, intent(in) :: beg, end
    type (pft_cstate_type), intent(inout):: pcs !pft carbon state
!
! !REVISION HISTORY:
! Created by Peter Thornton
!
!EOP
!------------------------------------------------------------------------

    allocate(pcs%leafc(beg:end))
    allocate(pcs%leafc_storage(beg:end))
    allocate(pcs%leafc_xfer(beg:end))
    allocate(pcs%frootc(beg:end))
    allocate(pcs%frootc_storage(beg:end))
    allocate(pcs%frootc_xfer(beg:end))
    allocate(pcs%livestemc(beg:end))
    allocate(pcs%livestemc_storage(beg:end))
    allocate(pcs%livestemc_xfer(beg:end))
    allocate(pcs%deadstemc(beg:end))
    allocate(pcs%deadstemc_storage(beg:end))
    allocate(pcs%deadstemc_xfer(beg:end))
    allocate(pcs%livecrootc(beg:end))
    allocate(pcs%livecrootc_storage(beg:end))
    allocate(pcs%livecrootc_xfer(beg:end))
    allocate(pcs%deadcrootc(beg:end))
    allocate(pcs%deadcrootc_storage(beg:end))
    allocate(pcs%deadcrootc_xfer(beg:end))
    allocate(pcs%gresp_storage(beg:end))
    allocate(pcs%gresp_xfer(beg:end))
    allocate(pcs%cpool(beg:end))
    allocate(pcs%xsmrpool(beg:end))
    allocate(pcs%pft_ctrunc(beg:end))
    allocate(pcs%dispvegc(beg:end))
    allocate(pcs%storvegc(beg:end))
    allocate(pcs%totvegc(beg:end))
    allocate(pcs%totpftc(beg:end))
    allocate(pcs%leafcmax(beg:end))
#if (defined CROP)
    allocate(pcs%grainc(beg:end))
    allocate(pcs%grainc_storage(beg:end))
    allocate(pcs%grainc_xfer(beg:end))
#endif
#if (defined CLAMP) && (defined CN)
    !CLAMP
    allocate(pcs%woodc(beg:end))
#endif

    pcs%leafc(beg:end) = nan
    pcs%leafc_storage(beg:end) = nan
    pcs%leafc_xfer(beg:end) = nan
    pcs%frootc(beg:end) = nan
    pcs%frootc_storage(beg:end) = nan
    pcs%frootc_xfer(beg:end) = nan
    pcs%livestemc(beg:end) = nan
    pcs%livestemc_storage(beg:end) = nan
    pcs%livestemc_xfer(beg:end) = nan
    pcs%deadstemc(beg:end) = nan
    pcs%deadstemc_storage(beg:end) = nan
    pcs%deadstemc_xfer(beg:end) = nan
    pcs%livecrootc(beg:end) = nan
    pcs%livecrootc_storage(beg:end) = nan
    pcs%livecrootc_xfer(beg:end) = nan
    pcs%deadcrootc(beg:end) = nan
    pcs%deadcrootc_storage(beg:end) = nan
    pcs%deadcrootc_xfer(beg:end) = nan
    pcs%gresp_storage(beg:end) = nan
    pcs%gresp_xfer(beg:end) = nan
    pcs%cpool(beg:end) = nan
    pcs%xsmrpool(beg:end) = nan
    pcs%pft_ctrunc(beg:end) = nan
    pcs%dispvegc(beg:end) = nan
    pcs%storvegc(beg:end) = nan
    pcs%totvegc(beg:end) = nan
    pcs%totpftc(beg:end) = nan
    pcs%leafcmax(beg:end) = nan
#if (defined CROP)
    pcs%grainc(beg:end) = nan
    pcs%grainc_storage(beg:end) = nan
    pcs%grainc_xfer(beg:end) = nan
#endif
#if (defined CLAMP) && (defined CN)
    !CLAMP
    pcs%woodc(beg:end) = nan
#endif

  end subroutine init_pft_cstate_type

!------------------------------------------------------------------------
!BOP
!
! !IROUTINE: init_pft_nstate_type
!
! !INTERFACE:
  subroutine init_pft_nstate_type(beg, end, pns)
!
! !DESCRIPTION:
! Initialize pft nitrogen state
!
! !ARGUMENTS:
    implicit none
    integer, intent(in) :: beg, end
    type (pft_nstate_type), intent(inout):: pns !pft nitrogen state
!
! !REVISION HISTORY:
! Created by Peter Thornton
!
!EOP
!------------------------------------------------------------------------

#if (defined CROP)
    allocate(pns%grainn(beg:end))
    allocate(pns%grainn_storage(beg:end))
    allocate(pns%grainn_xfer(beg:end))
#endif
    allocate(pns%leafn(beg:end))
    allocate(pns%leafn_storage(beg:end))
    allocate(pns%leafn_xfer(beg:end))
    allocate(pns%frootn(beg:end))
    allocate(pns%frootn_storage(beg:end))
    allocate(pns%frootn_xfer(beg:end))
    allocate(pns%livestemn(beg:end))
    allocate(pns%livestemn_storage(beg:end))
    allocate(pns%livestemn_xfer(beg:end))
    allocate(pns%deadstemn(beg:end))
    allocate(pns%deadstemn_storage(beg:end))
    allocate(pns%deadstemn_xfer(beg:end))
    allocate(pns%livecrootn(beg:end))
    allocate(pns%livecrootn_storage(beg:end))
    allocate(pns%livecrootn_xfer(beg:end))
    allocate(pns%deadcrootn(beg:end))
    allocate(pns%deadcrootn_storage(beg:end))
    allocate(pns%deadcrootn_xfer(beg:end))
    allocate(pns%retransn(beg:end))
    allocate(pns%npool(beg:end))
    allocate(pns%pft_ntrunc(beg:end))
    allocate(pns%dispvegn(beg:end))
    allocate(pns%storvegn(beg:end))
    allocate(pns%totvegn(beg:end))
    allocate(pns%totpftn(beg:end))

#if (defined CROP)
    pns%grainn(beg:end) = nan
    pns%grainn_storage(beg:end) = nan
    pns%grainn_xfer(beg:end) = nan
#endif
    pns%leafn(beg:end) = nan
    pns%leafn_storage(beg:end) = nan
    pns%leafn_xfer(beg:end) = nan
    pns%frootn(beg:end) = nan
    pns%frootn_storage(beg:end) = nan
    pns%frootn_xfer(beg:end) = nan
    pns%livestemn(beg:end) = nan
    pns%livestemn_storage(beg:end) = nan
    pns%livestemn_xfer(beg:end) = nan
    pns%deadstemn(beg:end) = nan
    pns%deadstemn_storage(beg:end) = nan
    pns%deadstemn_xfer(beg:end) = nan
    pns%livecrootn(beg:end) = nan
    pns%livecrootn_storage(beg:end) = nan
    pns%livecrootn_xfer(beg:end) = nan
    pns%deadcrootn(beg:end) = nan
    pns%deadcrootn_storage(beg:end) = nan
    pns%deadcrootn_xfer(beg:end) = nan
    pns%retransn(beg:end) = nan
    pns%npool(beg:end) = nan
    pns%pft_ntrunc(beg:end) = nan
    pns%dispvegn(beg:end) = nan
    pns%storvegn(beg:end) = nan
    pns%totvegn(beg:end) = nan
    pns%totpftn(beg:end) = nan

  end subroutine init_pft_nstate_type
!------------------------------------------------------------------------
!BOP
!
! !IROUTINE: init_pft_eflux_type
!
! !INTERFACE:
  subroutine init_pft_eflux_type(beg, end, pef)
!
! !DESCRIPTION:
! Initialize pft energy flux variables
!
! !ARGUMENTS:
    implicit none
    integer, intent(in) :: beg, end
    type (pft_eflux_type), intent(inout):: pef
!
! !REVISION HISTORY:
! Created by Mariana Vertenstein
!
!EOP
!------------------------------------------------------------------------

    allocate(pef%sabg(beg:end))
    allocate(pef%sabv(beg:end))
    allocate(pef%fsa(beg:end))
    allocate(pef%fsa_u(beg:end))
    allocate(pef%fsa_r(beg:end))
    allocate(pef%fsr(beg:end))
    allocate(pef%parsun(beg:end))
    allocate(pef%parsha(beg:end))
    allocate(pef%dlrad(beg:end))
    allocate(pef%ulrad(beg:end))
    allocate(pef%eflx_lh_tot(beg:end))
    allocate(pef%eflx_lh_tot_u(beg:end))
    allocate(pef%eflx_lh_tot_r(beg:end))
    allocate(pef%eflx_lh_grnd(beg:end))
    allocate(pef%eflx_soil_grnd(beg:end))
    allocate(pef%eflx_soil_grnd_u(beg:end))
    allocate(pef%eflx_soil_grnd_r(beg:end))
    allocate(pef%eflx_sh_tot(beg:end))
    allocate(pef%eflx_sh_tot_u(beg:end))
    allocate(pef%eflx_sh_tot_r(beg:end))
    allocate(pef%eflx_sh_grnd(beg:end))
    allocate(pef%eflx_sh_veg(beg:end))
    allocate(pef%eflx_lh_vege(beg:end))
    allocate(pef%eflx_lh_vegt(beg:end))
    allocate(pef%eflx_wasteheat_pft(beg:end))
    allocate(pef%eflx_heat_from_ac_pft(beg:end))
    allocate(pef%eflx_traffic_pft(beg:end))
    allocate(pef%eflx_anthro(beg:end))
    allocate(pef%cgrnd(beg:end))
    allocate(pef%cgrndl(beg:end))
    allocate(pef%cgrnds(beg:end))
    allocate(pef%eflx_gnet(beg:end))
    allocate(pef%dgnetdT(beg:end))
    allocate(pef%eflx_lwrad_out(beg:end))
    allocate(pef%eflx_lwrad_net(beg:end))
    allocate(pef%eflx_lwrad_net_u(beg:end))
    allocate(pef%eflx_lwrad_net_r(beg:end))
    allocate(pef%netrad(beg:end))
    allocate(pef%fsds_vis_d(beg:end))
    allocate(pef%fsds_nir_d(beg:end))
    allocate(pef%fsds_vis_i(beg:end))
    allocate(pef%fsds_nir_i(beg:end))
    allocate(pef%fsr_vis_d(beg:end))
    allocate(pef%fsr_nir_d(beg:end))
    allocate(pef%fsr_vis_i(beg:end))
    allocate(pef%fsr_nir_i(beg:end))
    allocate(pef%fsds_vis_d_ln(beg:end))
    allocate(pef%fsds_nir_d_ln(beg:end))
    allocate(pef%fsr_vis_d_ln(beg:end))
    allocate(pef%fsr_nir_d_ln(beg:end))
    allocate(pef%sun_add(beg:end,1:numrad))
    allocate(pef%tot_aid(beg:end,1:numrad))
    allocate(pef%sun_aid(beg:end,1:numrad))
    allocate(pef%sun_aii(beg:end,1:numrad))
    allocate(pef%sha_aid(beg:end,1:numrad))
    allocate(pef%sha_aii(beg:end,1:numrad))
    allocate(pef%sun_atot(beg:end,1:numrad))
    allocate(pef%sha_atot(beg:end,1:numrad))
    allocate(pef%sun_alf(beg:end,1:numrad))
    allocate(pef%sha_alf(beg:end,1:numrad))
    allocate(pef%sun_aperlai(beg:end,1:numrad))
    allocate(pef%sha_aperlai(beg:end,1:numrad))
    allocate(pef%sabg_lyr(beg:end,-nlevsno+1:1))
    allocate(pef%sfc_frc_aer(beg:end))
    allocate(pef%sfc_frc_bc(beg:end))
    allocate(pef%sfc_frc_oc(beg:end))
    allocate(pef%sfc_frc_dst(beg:end))
    allocate(pef%sfc_frc_aer_sno(beg:end))
    allocate(pef%sfc_frc_bc_sno(beg:end))
    allocate(pef%sfc_frc_oc_sno(beg:end))
    allocate(pef%sfc_frc_dst_sno(beg:end))
    allocate(pef%fsr_sno_vd(beg:end))
    allocate(pef%fsr_sno_nd(beg:end))
    allocate(pef%fsr_sno_vi(beg:end))
    allocate(pef%fsr_sno_ni(beg:end))
    allocate(pef%fsds_sno_vd(beg:end))
    allocate(pef%fsds_sno_nd(beg:end))
    allocate(pef%fsds_sno_vi(beg:end))
    allocate(pef%fsds_sno_ni(beg:end))

    pef%sabg(beg:end) = nan
    pef%sabv(beg:end) = nan
    pef%fsa(beg:end) = nan
    pef%fsa_u(beg:end) = nan
    pef%fsa_r(beg:end) = nan
    pef%fsr(beg:end) = nan
    pef%parsun(beg:end) = nan
    pef%parsha(beg:end) = nan
    pef%dlrad(beg:end) = nan
    pef%ulrad(beg:end) = nan
    pef%eflx_lh_tot(beg:end) = nan
    pef%eflx_lh_tot_u(beg:end) = nan
    pef%eflx_lh_tot_r(beg:end) = nan
    pef%eflx_lh_grnd(beg:end) = nan
    pef%eflx_soil_grnd(beg:end) = nan
    pef%eflx_soil_grnd_u(beg:end) = nan
    pef%eflx_soil_grnd_r(beg:end) = nan
    pef%eflx_sh_tot(beg:end) = nan
    pef%eflx_sh_tot_u(beg:end) = nan
    pef%eflx_sh_tot_r(beg:end) = nan
    pef%eflx_sh_grnd(beg:end) = nan
    pef%eflx_sh_veg(beg:end) = nan
    pef%eflx_lh_vege(beg:end) = nan
    pef%eflx_lh_vegt(beg:end) = nan
    pef%eflx_wasteheat_pft(beg:end) = nan
    pef%eflx_heat_from_ac_pft(beg:end) = nan
    pef%eflx_traffic_pft(beg:end) = nan
    pef%eflx_anthro(beg:end) = nan
    pef%cgrnd(beg:end) = nan
    pef%cgrndl(beg:end) = nan
    pef%cgrnds(beg:end) = nan
    pef%eflx_gnet(beg:end) = nan
    pef%dgnetdT(beg:end) = nan
    pef%eflx_lwrad_out(beg:end) = nan
    pef%eflx_lwrad_net(beg:end) = nan
    pef%eflx_lwrad_net_u(beg:end) = nan
    pef%eflx_lwrad_net_r(beg:end) = nan
    pef%netrad(beg:end) = nan
    pef%fsds_vis_d(beg:end) = nan
    pef%fsds_nir_d(beg:end) = nan
    pef%fsds_vis_i(beg:end) = nan
    pef%fsds_nir_i(beg:end) = nan
    pef%fsr_vis_d(beg:end) = nan
    pef%fsr_nir_d(beg:end) = nan
    pef%fsr_vis_i(beg:end) = nan
    pef%fsr_nir_i(beg:end) = nan
    pef%fsds_vis_d_ln(beg:end) = nan
    pef%fsds_nir_d_ln(beg:end) = nan
    pef%fsr_vis_d_ln(beg:end) = nan
    pef%fsr_nir_d_ln(beg:end) = nan
    pef%sun_add(beg:end,1:numrad) = nan
    pef%tot_aid(beg:end,1:numrad) = nan
    pef%sun_aid(beg:end,1:numrad) = nan
    pef%sun_aii(beg:end,1:numrad) = nan
    pef%sha_aid(beg:end,1:numrad) = nan
    pef%sha_aii(beg:end,1:numrad) = nan
    pef%sun_atot(beg:end,1:numrad) = nan
    pef%sha_atot(beg:end,1:numrad) = nan
    pef%sun_alf(beg:end,1:numrad) = nan
    pef%sha_alf(beg:end,1:numrad) = nan
    pef%sun_aperlai(beg:end,1:numrad) = nan
    pef%sha_aperlai(beg:end,1:numrad) = nan
    pef%sabg_lyr(beg:end,-nlevsno+1:1) = nan
    pef%sfc_frc_aer(beg:end) = nan
    pef%sfc_frc_bc(beg:end) = nan
    pef%sfc_frc_oc(beg:end) = nan
    pef%sfc_frc_dst(beg:end) = nan
    pef%sfc_frc_aer_sno(beg:end) = nan
    pef%sfc_frc_bc_sno(beg:end) = nan
    pef%sfc_frc_oc_sno(beg:end) = nan
    pef%sfc_frc_dst_sno(beg:end) = nan
    pef%fsr_sno_vd(beg:end) = nan
    pef%fsr_sno_nd(beg:end) = nan
    pef%fsr_sno_vi(beg:end) = nan
    pef%fsr_sno_ni(beg:end) = nan
    pef%fsds_sno_vd(beg:end) = nan
    pef%fsds_sno_nd(beg:end) = nan
    pef%fsds_sno_vi(beg:end) = nan
    pef%fsds_sno_ni(beg:end) = nan
  end subroutine init_pft_eflux_type

!------------------------------------------------------------------------
!BOP
!
! !IROUTINE: init_pft_mflux_type
!
! !INTERFACE:
  subroutine init_pft_mflux_type(beg, end, pmf)
!
! !DESCRIPTION:
! Initialize pft momentum flux variables
!
! !ARGUMENTS:
    implicit none
    integer, intent(in) :: beg, end
    type (pft_mflux_type), intent(inout) :: pmf
!
! !REVISION HISTORY:
! Created by Mariana Vertenstein
!
!EOP
!------------------------------------------------------------------------

    allocate(pmf%taux(beg:end))
    allocate(pmf%tauy(beg:end))

    pmf%taux(beg:end) = nan
    pmf%tauy(beg:end) = nan

  end subroutine init_pft_mflux_type

!------------------------------------------------------------------------
!BOP
!
! !IROUTINE: init_pft_wflux_type
!
! !INTERFACE:
  subroutine init_pft_wflux_type(beg, end, pwf)
!
! !DESCRIPTION:
! Initialize pft water flux variables
!
! !ARGUMENTS:
    implicit none
    integer, intent(in) :: beg, end
    type (pft_wflux_type), intent(inout) :: pwf
!
! !REVISION HISTORY:
! Created by Mariana Vertenstein
!
!EOP
!------------------------------------------------------------------------

    allocate(pwf%qflx_prec_intr(beg:end))
    allocate(pwf%qflx_prec_grnd(beg:end))
    allocate(pwf%qflx_rain_grnd(beg:end))
    allocate(pwf%qflx_snow_grnd(beg:end))
    allocate(pwf%qflx_snwcp_liq(beg:end))
    allocate(pwf%qflx_snwcp_ice(beg:end))
    allocate(pwf%qflx_evap_veg(beg:end))
    allocate(pwf%qflx_tran_veg(beg:end))
    allocate(pwf%qflx_evap_can(beg:end))
    allocate(pwf%qflx_evap_soi(beg:end))
    allocate(pwf%qflx_evap_tot(beg:end))
    allocate(pwf%qflx_evap_grnd(beg:end))
    allocate(pwf%qflx_dew_grnd(beg:end))
    allocate(pwf%qflx_sub_snow(beg:end))
    allocate(pwf%qflx_dew_snow(beg:end))

    pwf%qflx_prec_intr(beg:end) = nan
    pwf%qflx_prec_grnd(beg:end) = nan
    pwf%qflx_rain_grnd(beg:end) = nan
    pwf%qflx_snow_grnd(beg:end) = nan
    pwf%qflx_snwcp_liq(beg:end) = nan
    pwf%qflx_snwcp_ice(beg:end) = nan
    pwf%qflx_evap_veg(beg:end) = nan
    pwf%qflx_tran_veg(beg:end) = nan
    pwf%qflx_evap_can(beg:end) = nan
    pwf%qflx_evap_soi(beg:end) = nan
    pwf%qflx_evap_tot(beg:end) = nan
    pwf%qflx_evap_grnd(beg:end) = nan
    pwf%qflx_dew_grnd(beg:end) = nan
    pwf%qflx_sub_snow(beg:end) = nan
    pwf%qflx_dew_snow(beg:end) = nan

  end subroutine init_pft_wflux_type

!------------------------------------------------------------------------
!BOP
!
! !IROUTINE: init_pft_cflux_type
!
! !INTERFACE:
  subroutine init_pft_cflux_type(beg, end, pcf)
!
! !DESCRIPTION:
! Initialize pft carbon flux variables
!
! !ARGUMENTS:
    implicit none
    integer, intent(in) :: beg, end
    type (pft_cflux_type), intent(inout) :: pcf
!
! !REVISION HISTORY:
! Created by Mariana Vertenstein
!
!EOP
!------------------------------------------------------------------------

    allocate(pcf%psnsun(beg:end))
    allocate(pcf%psnsha(beg:end))
    allocate(pcf%fpsn(beg:end))
    allocate(pcf%fco2(beg:end))

    allocate(pcf%m_leafc_to_litter(beg:end))
    allocate(pcf%m_frootc_to_litter(beg:end))
    allocate(pcf%m_leafc_storage_to_litter(beg:end))
    allocate(pcf%m_frootc_storage_to_litter(beg:end))
    allocate(pcf%m_livestemc_storage_to_litter(beg:end))
    allocate(pcf%m_deadstemc_storage_to_litter(beg:end))
    allocate(pcf%m_livecrootc_storage_to_litter(beg:end))
    allocate(pcf%m_deadcrootc_storage_to_litter(beg:end))
    allocate(pcf%m_leafc_xfer_to_litter(beg:end))
    allocate(pcf%m_frootc_xfer_to_litter(beg:end))
    allocate(pcf%m_livestemc_xfer_to_litter(beg:end))
    allocate(pcf%m_deadstemc_xfer_to_litter(beg:end))
    allocate(pcf%m_livecrootc_xfer_to_litter(beg:end))
    allocate(pcf%m_deadcrootc_xfer_to_litter(beg:end))
    allocate(pcf%m_livestemc_to_litter(beg:end))
    allocate(pcf%m_deadstemc_to_litter(beg:end))
    allocate(pcf%m_livecrootc_to_litter(beg:end))
    allocate(pcf%m_deadcrootc_to_litter(beg:end))
    allocate(pcf%m_gresp_storage_to_litter(beg:end))
    allocate(pcf%m_gresp_xfer_to_litter(beg:end))
    allocate(pcf%hrv_leafc_to_litter(beg:end))             
    allocate(pcf%hrv_leafc_storage_to_litter(beg:end))     
    allocate(pcf%hrv_leafc_xfer_to_litter(beg:end))        
    allocate(pcf%hrv_frootc_to_litter(beg:end))            
    allocate(pcf%hrv_frootc_storage_to_litter(beg:end))    
    allocate(pcf%hrv_frootc_xfer_to_litter(beg:end))       
    allocate(pcf%hrv_livestemc_to_litter(beg:end))         
    allocate(pcf%hrv_livestemc_storage_to_litter(beg:end)) 
    allocate(pcf%hrv_livestemc_xfer_to_litter(beg:end))    
    allocate(pcf%hrv_deadstemc_to_prod10c(beg:end))        
    allocate(pcf%hrv_deadstemc_to_prod100c(beg:end))       
    allocate(pcf%hrv_deadstemc_storage_to_litter(beg:end)) 
    allocate(pcf%hrv_deadstemc_xfer_to_litter(beg:end))    
    allocate(pcf%hrv_livecrootc_to_litter(beg:end))        
    allocate(pcf%hrv_livecrootc_storage_to_litter(beg:end))
    allocate(pcf%hrv_livecrootc_xfer_to_litter(beg:end))   
    allocate(pcf%hrv_deadcrootc_to_litter(beg:end))        
    allocate(pcf%hrv_deadcrootc_storage_to_litter(beg:end))
    allocate(pcf%hrv_deadcrootc_xfer_to_litter(beg:end))   
    allocate(pcf%hrv_gresp_storage_to_litter(beg:end))     
    allocate(pcf%hrv_gresp_xfer_to_litter(beg:end))        
    allocate(pcf%hrv_xsmrpool_to_atm(beg:end))                 
    allocate(pcf%m_leafc_to_fire(beg:end))
    allocate(pcf%m_frootc_to_fire(beg:end))
    allocate(pcf%m_leafc_storage_to_fire(beg:end))
    allocate(pcf%m_frootc_storage_to_fire(beg:end))
    allocate(pcf%m_livestemc_storage_to_fire(beg:end))
    allocate(pcf%m_deadstemc_storage_to_fire(beg:end))
    allocate(pcf%m_livecrootc_storage_to_fire(beg:end))
    allocate(pcf%m_deadcrootc_storage_to_fire(beg:end))
    allocate(pcf%m_leafc_xfer_to_fire(beg:end))
    allocate(pcf%m_frootc_xfer_to_fire(beg:end))
    allocate(pcf%m_livestemc_xfer_to_fire(beg:end))
    allocate(pcf%m_deadstemc_xfer_to_fire(beg:end))
    allocate(pcf%m_livecrootc_xfer_to_fire(beg:end))
    allocate(pcf%m_deadcrootc_xfer_to_fire(beg:end))
    allocate(pcf%m_livestemc_to_fire(beg:end))
    allocate(pcf%m_deadstemc_to_fire(beg:end))
    allocate(pcf%m_deadstemc_to_litter_fire(beg:end))
    allocate(pcf%m_livecrootc_to_fire(beg:end))
    allocate(pcf%m_deadcrootc_to_fire(beg:end))
    allocate(pcf%m_deadcrootc_to_litter_fire(beg:end))
    allocate(pcf%m_gresp_storage_to_fire(beg:end))
    allocate(pcf%m_gresp_xfer_to_fire(beg:end))
    allocate(pcf%leafc_xfer_to_leafc(beg:end))
    allocate(pcf%frootc_xfer_to_frootc(beg:end))
    allocate(pcf%livestemc_xfer_to_livestemc(beg:end))
    allocate(pcf%deadstemc_xfer_to_deadstemc(beg:end))
    allocate(pcf%livecrootc_xfer_to_livecrootc(beg:end))
    allocate(pcf%deadcrootc_xfer_to_deadcrootc(beg:end))
    allocate(pcf%leafc_to_litter(beg:end))
    allocate(pcf%frootc_to_litter(beg:end))
    allocate(pcf%leaf_mr(beg:end))
    allocate(pcf%froot_mr(beg:end))
    allocate(pcf%livestem_mr(beg:end))
    allocate(pcf%livecroot_mr(beg:end))
    allocate(pcf%leaf_curmr(beg:end))
    allocate(pcf%froot_curmr(beg:end))
    allocate(pcf%livestem_curmr(beg:end))
    allocate(pcf%livecroot_curmr(beg:end))
    allocate(pcf%leaf_xsmr(beg:end))
    allocate(pcf%froot_xsmr(beg:end))
    allocate(pcf%livestem_xsmr(beg:end))
    allocate(pcf%livecroot_xsmr(beg:end))
    allocate(pcf%psnsun_to_cpool(beg:end))
    allocate(pcf%psnshade_to_cpool(beg:end))
    allocate(pcf%cpool_to_xsmrpool(beg:end))
    allocate(pcf%cpool_to_leafc(beg:end))
    allocate(pcf%cpool_to_leafc_storage(beg:end))
    allocate(pcf%cpool_to_frootc(beg:end))
    allocate(pcf%cpool_to_frootc_storage(beg:end))
    allocate(pcf%cpool_to_livestemc(beg:end))
    allocate(pcf%cpool_to_livestemc_storage(beg:end))
    allocate(pcf%cpool_to_deadstemc(beg:end))
    allocate(pcf%cpool_to_deadstemc_storage(beg:end))
    allocate(pcf%cpool_to_livecrootc(beg:end))
    allocate(pcf%cpool_to_livecrootc_storage(beg:end))
    allocate(pcf%cpool_to_deadcrootc(beg:end))
    allocate(pcf%cpool_to_deadcrootc_storage(beg:end))
    allocate(pcf%cpool_to_gresp_storage(beg:end))
    allocate(pcf%cpool_leaf_gr(beg:end))
    allocate(pcf%cpool_leaf_storage_gr(beg:end))
    allocate(pcf%transfer_leaf_gr(beg:end))
    allocate(pcf%cpool_froot_gr(beg:end))
    allocate(pcf%cpool_froot_storage_gr(beg:end))
    allocate(pcf%transfer_froot_gr(beg:end))
    allocate(pcf%cpool_livestem_gr(beg:end))
    allocate(pcf%cpool_livestem_storage_gr(beg:end))
    allocate(pcf%transfer_livestem_gr(beg:end))
    allocate(pcf%cpool_deadstem_gr(beg:end))
    allocate(pcf%cpool_deadstem_storage_gr(beg:end))
    allocate(pcf%transfer_deadstem_gr(beg:end))
    allocate(pcf%cpool_livecroot_gr(beg:end))
    allocate(pcf%cpool_livecroot_storage_gr(beg:end))
    allocate(pcf%transfer_livecroot_gr(beg:end))
    allocate(pcf%cpool_deadcroot_gr(beg:end))
    allocate(pcf%cpool_deadcroot_storage_gr(beg:end))
    allocate(pcf%transfer_deadcroot_gr(beg:end))
    allocate(pcf%leafc_storage_to_xfer(beg:end))
    allocate(pcf%frootc_storage_to_xfer(beg:end))
    allocate(pcf%livestemc_storage_to_xfer(beg:end))
    allocate(pcf%deadstemc_storage_to_xfer(beg:end))
    allocate(pcf%livecrootc_storage_to_xfer(beg:end))
    allocate(pcf%deadcrootc_storage_to_xfer(beg:end))
    allocate(pcf%gresp_storage_to_xfer(beg:end))
    allocate(pcf%livestemc_to_deadstemc(beg:end))
    allocate(pcf%livecrootc_to_deadcrootc(beg:end))
    allocate(pcf%gpp(beg:end))
    allocate(pcf%mr(beg:end))
    allocate(pcf%current_gr(beg:end))
    allocate(pcf%transfer_gr(beg:end))
    allocate(pcf%storage_gr(beg:end))
    allocate(pcf%gr(beg:end))
    allocate(pcf%ar(beg:end))
    allocate(pcf%rr(beg:end))
    allocate(pcf%npp(beg:end))
    allocate(pcf%agnpp(beg:end))
    allocate(pcf%bgnpp(beg:end))
    allocate(pcf%litfall(beg:end))
    allocate(pcf%vegfire(beg:end))
    allocate(pcf%wood_harvestc(beg:end))
    allocate(pcf%pft_cinputs(beg:end))
    allocate(pcf%pft_coutputs(beg:end))
    allocate(pcf%pft_fire_closs(beg:end))
#if (defined CROP)
    allocate(pcf%xsmrpool_to_atm(beg:end))
    allocate(pcf%grainc_xfer_to_grainc(beg:end))
    allocate(pcf%livestemc_to_litter(beg:end))
    allocate(pcf%grainc_to_food(beg:end))
    allocate(pcf%cpool_to_grainc(beg:end))
    allocate(pcf%cpool_to_grainc_storage(beg:end))
    allocate(pcf%cpool_grain_gr(beg:end))
    allocate(pcf%cpool_grain_storage_gr(beg:end))
    allocate(pcf%transfer_grain_gr(beg:end))
    allocate(pcf%grainc_storage_to_xfer(beg:end))
#endif
#if (defined CLAMP) && (defined CN)
    !CLAMP
    allocate(pcf%frootc_alloc(beg:end))
    allocate(pcf%frootc_loss(beg:end))
    allocate(pcf%leafc_alloc(beg:end))
    allocate(pcf%leafc_loss(beg:end))
    allocate(pcf%woodc_alloc(beg:end))
    allocate(pcf%woodc_loss(beg:end))
#endif

    pcf%psnsun(beg:end) = nan
    pcf%psnsha(beg:end) = nan
    pcf%fpsn(beg:end) = nan
    pcf%fco2(beg:end) = 0._r8

    pcf%m_leafc_to_litter(beg:end) = nan
    pcf%m_frootc_to_litter(beg:end) = nan
    pcf%m_leafc_storage_to_litter(beg:end) = nan
    pcf%m_frootc_storage_to_litter(beg:end) = nan
    pcf%m_livestemc_storage_to_litter(beg:end) = nan
    pcf%m_deadstemc_storage_to_litter(beg:end) = nan
    pcf%m_livecrootc_storage_to_litter(beg:end) = nan
    pcf%m_deadcrootc_storage_to_litter(beg:end) = nan
    pcf%m_leafc_xfer_to_litter(beg:end) = nan
    pcf%m_frootc_xfer_to_litter(beg:end) = nan
    pcf%m_livestemc_xfer_to_litter(beg:end) = nan
    pcf%m_deadstemc_xfer_to_litter(beg:end) = nan
    pcf%m_livecrootc_xfer_to_litter(beg:end) = nan
    pcf%m_deadcrootc_xfer_to_litter(beg:end) = nan
    pcf%m_livestemc_to_litter(beg:end) = nan
    pcf%m_deadstemc_to_litter(beg:end) = nan
    pcf%m_livecrootc_to_litter(beg:end) = nan
    pcf%m_deadcrootc_to_litter(beg:end) = nan
    pcf%m_gresp_storage_to_litter(beg:end) = nan
    pcf%m_gresp_xfer_to_litter(beg:end) = nan
    pcf%hrv_leafc_to_litter(beg:end) = nan             
    pcf%hrv_leafc_storage_to_litter(beg:end) = nan     
    pcf%hrv_leafc_xfer_to_litter(beg:end) = nan        
    pcf%hrv_frootc_to_litter(beg:end) = nan            
    pcf%hrv_frootc_storage_to_litter(beg:end) = nan    
    pcf%hrv_frootc_xfer_to_litter(beg:end) = nan       
    pcf%hrv_livestemc_to_litter(beg:end) = nan         
    pcf%hrv_livestemc_storage_to_litter(beg:end) = nan 
    pcf%hrv_livestemc_xfer_to_litter(beg:end) = nan    
    pcf%hrv_deadstemc_to_prod10c(beg:end) = nan        
    pcf%hrv_deadstemc_to_prod100c(beg:end) = nan       
    pcf%hrv_deadstemc_storage_to_litter(beg:end) = nan 
    pcf%hrv_deadstemc_xfer_to_litter(beg:end) = nan    
    pcf%hrv_livecrootc_to_litter(beg:end) = nan        
    pcf%hrv_livecrootc_storage_to_litter(beg:end) = nan
    pcf%hrv_livecrootc_xfer_to_litter(beg:end) = nan   
    pcf%hrv_deadcrootc_to_litter(beg:end) = nan        
    pcf%hrv_deadcrootc_storage_to_litter(beg:end) = nan
    pcf%hrv_deadcrootc_xfer_to_litter(beg:end) = nan   
    pcf%hrv_gresp_storage_to_litter(beg:end) = nan     
    pcf%hrv_gresp_xfer_to_litter(beg:end) = nan        
    pcf%hrv_xsmrpool_to_atm(beg:end) = nan                 
    pcf%m_leafc_to_fire(beg:end) = nan
    pcf%m_frootc_to_fire(beg:end) = nan
    pcf%m_leafc_storage_to_fire(beg:end) = nan
    pcf%m_frootc_storage_to_fire(beg:end) = nan
    pcf%m_livestemc_storage_to_fire(beg:end) = nan
    pcf%m_deadstemc_storage_to_fire(beg:end) = nan
    pcf%m_livecrootc_storage_to_fire(beg:end) = nan
    pcf%m_deadcrootc_storage_to_fire(beg:end) = nan
    pcf%m_leafc_xfer_to_fire(beg:end) = nan
    pcf%m_frootc_xfer_to_fire(beg:end) = nan
    pcf%m_livestemc_xfer_to_fire(beg:end) = nan
    pcf%m_deadstemc_xfer_to_fire(beg:end) = nan
    pcf%m_livecrootc_xfer_to_fire(beg:end) = nan
    pcf%m_deadcrootc_xfer_to_fire(beg:end) = nan
    pcf%m_livestemc_to_fire(beg:end) = nan
    pcf%m_deadstemc_to_fire(beg:end) = nan
    pcf%m_deadstemc_to_litter_fire(beg:end) = nan
    pcf%m_livecrootc_to_fire(beg:end) = nan
    pcf%m_deadcrootc_to_fire(beg:end) = nan
    pcf%m_deadcrootc_to_litter_fire(beg:end) = nan
    pcf%m_gresp_storage_to_fire(beg:end) = nan
    pcf%m_gresp_xfer_to_fire(beg:end) = nan
    pcf%leafc_xfer_to_leafc(beg:end) = nan
    pcf%frootc_xfer_to_frootc(beg:end) = nan
    pcf%livestemc_xfer_to_livestemc(beg:end) = nan
    pcf%deadstemc_xfer_to_deadstemc(beg:end) = nan
    pcf%livecrootc_xfer_to_livecrootc(beg:end) = nan
    pcf%deadcrootc_xfer_to_deadcrootc(beg:end) = nan
    pcf%leafc_to_litter(beg:end) = nan
    pcf%frootc_to_litter(beg:end) = nan
    pcf%leaf_mr(beg:end) = nan
    pcf%froot_mr(beg:end) = nan
    pcf%livestem_mr(beg:end) = nan
    pcf%livecroot_mr(beg:end) = nan
    pcf%leaf_curmr(beg:end) = nan
    pcf%froot_curmr(beg:end) = nan
    pcf%livestem_curmr(beg:end) = nan
    pcf%livecroot_curmr(beg:end) = nan
    pcf%leaf_xsmr(beg:end) = nan
    pcf%froot_xsmr(beg:end) = nan
    pcf%livestem_xsmr(beg:end) = nan
    pcf%livecroot_xsmr(beg:end) = nan
    pcf%psnsun_to_cpool(beg:end) = nan
    pcf%psnshade_to_cpool(beg:end) = nan
    pcf%cpool_to_xsmrpool(beg:end) = nan
    pcf%cpool_to_leafc(beg:end) = nan
    pcf%cpool_to_leafc_storage(beg:end) = nan
    pcf%cpool_to_frootc(beg:end) = nan
    pcf%cpool_to_frootc_storage(beg:end) = nan
    pcf%cpool_to_livestemc(beg:end) = nan
    pcf%cpool_to_livestemc_storage(beg:end) = nan
    pcf%cpool_to_deadstemc(beg:end) = nan
    pcf%cpool_to_deadstemc_storage(beg:end) = nan
    pcf%cpool_to_livecrootc(beg:end) = nan
    pcf%cpool_to_livecrootc_storage(beg:end) = nan
    pcf%cpool_to_deadcrootc(beg:end) = nan
    pcf%cpool_to_deadcrootc_storage(beg:end) = nan
    pcf%cpool_to_gresp_storage(beg:end) = nan
    pcf%cpool_leaf_gr(beg:end) = nan
    pcf%cpool_leaf_storage_gr(beg:end) = nan
    pcf%transfer_leaf_gr(beg:end) = nan
    pcf%cpool_froot_gr(beg:end) = nan
    pcf%cpool_froot_storage_gr(beg:end) = nan
    pcf%transfer_froot_gr(beg:end) = nan
    pcf%cpool_livestem_gr(beg:end) = nan
    pcf%cpool_livestem_storage_gr(beg:end) = nan
    pcf%transfer_livestem_gr(beg:end) = nan
    pcf%cpool_deadstem_gr(beg:end) = nan
    pcf%cpool_deadstem_storage_gr(beg:end) = nan
    pcf%transfer_deadstem_gr(beg:end) = nan
    pcf%cpool_livecroot_gr(beg:end) = nan
    pcf%cpool_livecroot_storage_gr(beg:end) = nan
    pcf%transfer_livecroot_gr(beg:end) = nan
    pcf%cpool_deadcroot_gr(beg:end) = nan
    pcf%cpool_deadcroot_storage_gr(beg:end) = nan
    pcf%transfer_deadcroot_gr(beg:end) = nan
    pcf%leafc_storage_to_xfer(beg:end) = nan
    pcf%frootc_storage_to_xfer(beg:end) = nan
    pcf%livestemc_storage_to_xfer(beg:end) = nan
    pcf%deadstemc_storage_to_xfer(beg:end) = nan
    pcf%livecrootc_storage_to_xfer(beg:end) = nan
    pcf%deadcrootc_storage_to_xfer(beg:end) = nan
    pcf%gresp_storage_to_xfer(beg:end) = nan
    pcf%livestemc_to_deadstemc(beg:end) = nan
    pcf%livecrootc_to_deadcrootc(beg:end) = nan
    pcf%gpp(beg:end) = nan
    pcf%mr(beg:end) = nan
    pcf%current_gr(beg:end) = nan
    pcf%transfer_gr(beg:end) = nan
    pcf%storage_gr(beg:end) = nan
    pcf%gr(beg:end) = nan
    pcf%ar(beg:end) = nan
    pcf%rr(beg:end) = nan
    pcf%npp(beg:end) = nan
    pcf%agnpp(beg:end) = nan
    pcf%bgnpp(beg:end) = nan
    pcf%litfall(beg:end) = nan
    pcf%vegfire(beg:end) = nan
    pcf%wood_harvestc(beg:end) = nan
    pcf%pft_cinputs(beg:end) = nan
    pcf%pft_coutputs(beg:end) = nan
    pcf%pft_fire_closs(beg:end) = nan
#if (defined CROP)
    pcf%xsmrpool_to_atm(beg:end) = nan
    pcf%grainc_xfer_to_grainc(beg:end) = nan
    pcf%livestemc_to_litter(beg:end) = nan
    pcf%grainc_to_food(beg:end) = nan
    pcf%cpool_to_grainc(beg:end) = nan
    pcf%cpool_to_grainc_storage(beg:end) = nan
    pcf%cpool_grain_gr(beg:end) = nan
    pcf%cpool_grain_storage_gr(beg:end) = nan
    pcf%transfer_grain_gr(beg:end) = nan
    pcf%grainc_storage_to_xfer(beg:end) = nan
#endif
#if (defined CLAMP) && (defined CN)
    !CLAMP
    pcf%frootc_alloc(beg:end) = nan
    pcf%frootc_loss(beg:end) = nan
    pcf%leafc_alloc(beg:end) = nan
    pcf%leafc_loss(beg:end) = nan
    pcf%woodc_alloc(beg:end) = nan
    pcf%woodc_loss(beg:end) = nan
#endif

  end subroutine init_pft_cflux_type

!------------------------------------------------------------------------
!BOP
!
! !IROUTINE: init_pft_nflux_type
!
! !INTERFACE:
  subroutine init_pft_nflux_type(beg, end, pnf)
!
! !DESCRIPTION:
! Initialize pft nitrogen flux variables
!
! !ARGUMENTS:
    implicit none
    integer, intent(in) :: beg, end
    type (pft_nflux_type), intent(inout) :: pnf
!
! !REVISION HISTORY:
! Created by Mariana Vertenstein
!
!EOP
!------------------------------------------------------------------------

    allocate(pnf%m_leafn_to_litter(beg:end))
    allocate(pnf%m_frootn_to_litter(beg:end))
    allocate(pnf%m_leafn_storage_to_litter(beg:end))
    allocate(pnf%m_frootn_storage_to_litter(beg:end))
    allocate(pnf%m_livestemn_storage_to_litter(beg:end))
    allocate(pnf%m_deadstemn_storage_to_litter(beg:end))
    allocate(pnf%m_livecrootn_storage_to_litter(beg:end))
    allocate(pnf%m_deadcrootn_storage_to_litter(beg:end))
    allocate(pnf%m_leafn_xfer_to_litter(beg:end))
    allocate(pnf%m_frootn_xfer_to_litter(beg:end))
    allocate(pnf%m_livestemn_xfer_to_litter(beg:end))
    allocate(pnf%m_deadstemn_xfer_to_litter(beg:end))
    allocate(pnf%m_livecrootn_xfer_to_litter(beg:end))
    allocate(pnf%m_deadcrootn_xfer_to_litter(beg:end))
    allocate(pnf%m_livestemn_to_litter(beg:end))
    allocate(pnf%m_deadstemn_to_litter(beg:end))
    allocate(pnf%m_livecrootn_to_litter(beg:end))
    allocate(pnf%m_deadcrootn_to_litter(beg:end))
    allocate(pnf%m_retransn_to_litter(beg:end))
    allocate(pnf%hrv_leafn_to_litter(beg:end))             
    allocate(pnf%hrv_frootn_to_litter(beg:end))            
    allocate(pnf%hrv_leafn_storage_to_litter(beg:end))     
    allocate(pnf%hrv_frootn_storage_to_litter(beg:end))    
    allocate(pnf%hrv_livestemn_storage_to_litter(beg:end)) 
    allocate(pnf%hrv_deadstemn_storage_to_litter(beg:end)) 
    allocate(pnf%hrv_livecrootn_storage_to_litter(beg:end))
    allocate(pnf%hrv_deadcrootn_storage_to_litter(beg:end))
    allocate(pnf%hrv_leafn_xfer_to_litter(beg:end))        
    allocate(pnf%hrv_frootn_xfer_to_litter(beg:end))       
    allocate(pnf%hrv_livestemn_xfer_to_litter(beg:end))    
    allocate(pnf%hrv_deadstemn_xfer_to_litter(beg:end))    
    allocate(pnf%hrv_livecrootn_xfer_to_litter(beg:end))   
    allocate(pnf%hrv_deadcrootn_xfer_to_litter(beg:end))   
    allocate(pnf%hrv_livestemn_to_litter(beg:end))         
    allocate(pnf%hrv_deadstemn_to_prod10n(beg:end))        
    allocate(pnf%hrv_deadstemn_to_prod100n(beg:end))       
    allocate(pnf%hrv_livecrootn_to_litter(beg:end))        
    allocate(pnf%hrv_deadcrootn_to_litter(beg:end))        
    allocate(pnf%hrv_retransn_to_litter(beg:end))              
    allocate(pnf%m_leafn_to_fire(beg:end))
    allocate(pnf%m_frootn_to_fire(beg:end))
    allocate(pnf%m_leafn_storage_to_fire(beg:end))
    allocate(pnf%m_frootn_storage_to_fire(beg:end))
    allocate(pnf%m_livestemn_storage_to_fire(beg:end))
    allocate(pnf%m_deadstemn_storage_to_fire(beg:end))
    allocate(pnf%m_livecrootn_storage_to_fire(beg:end))
    allocate(pnf%m_deadcrootn_storage_to_fire(beg:end))
    allocate(pnf%m_leafn_xfer_to_fire(beg:end))
    allocate(pnf%m_frootn_xfer_to_fire(beg:end))
    allocate(pnf%m_livestemn_xfer_to_fire(beg:end))
    allocate(pnf%m_deadstemn_xfer_to_fire(beg:end))
    allocate(pnf%m_livecrootn_xfer_to_fire(beg:end))
    allocate(pnf%m_deadcrootn_xfer_to_fire(beg:end))
    allocate(pnf%m_livestemn_to_fire(beg:end))
    allocate(pnf%m_deadstemn_to_fire(beg:end))
    allocate(pnf%m_deadstemn_to_litter_fire(beg:end))
    allocate(pnf%m_livecrootn_to_fire(beg:end))
    allocate(pnf%m_deadcrootn_to_fire(beg:end))
    allocate(pnf%m_deadcrootn_to_litter_fire(beg:end))
    allocate(pnf%m_retransn_to_fire(beg:end))
    allocate(pnf%leafn_xfer_to_leafn(beg:end))
    allocate(pnf%frootn_xfer_to_frootn(beg:end))
    allocate(pnf%livestemn_xfer_to_livestemn(beg:end))
    allocate(pnf%deadstemn_xfer_to_deadstemn(beg:end))
    allocate(pnf%livecrootn_xfer_to_livecrootn(beg:end))
    allocate(pnf%deadcrootn_xfer_to_deadcrootn(beg:end))
    allocate(pnf%leafn_to_litter(beg:end))
    allocate(pnf%leafn_to_retransn(beg:end))
    allocate(pnf%frootn_to_litter(beg:end))
    allocate(pnf%retransn_to_npool(beg:end))
    allocate(pnf%sminn_to_npool(beg:end))
    allocate(pnf%npool_to_leafn(beg:end))
    allocate(pnf%npool_to_leafn_storage(beg:end))
    allocate(pnf%npool_to_frootn(beg:end))
    allocate(pnf%npool_to_frootn_storage(beg:end))
    allocate(pnf%npool_to_livestemn(beg:end))
    allocate(pnf%npool_to_livestemn_storage(beg:end))
    allocate(pnf%npool_to_deadstemn(beg:end))
    allocate(pnf%npool_to_deadstemn_storage(beg:end))
    allocate(pnf%npool_to_livecrootn(beg:end))
    allocate(pnf%npool_to_livecrootn_storage(beg:end))
    allocate(pnf%npool_to_deadcrootn(beg:end))
    allocate(pnf%npool_to_deadcrootn_storage(beg:end))
    allocate(pnf%leafn_storage_to_xfer(beg:end))
    allocate(pnf%frootn_storage_to_xfer(beg:end))
    allocate(pnf%livestemn_storage_to_xfer(beg:end))
    allocate(pnf%deadstemn_storage_to_xfer(beg:end))
    allocate(pnf%livecrootn_storage_to_xfer(beg:end))
    allocate(pnf%deadcrootn_storage_to_xfer(beg:end))
    allocate(pnf%livestemn_to_deadstemn(beg:end))
    allocate(pnf%livestemn_to_retransn(beg:end))
    allocate(pnf%livecrootn_to_deadcrootn(beg:end))
    allocate(pnf%livecrootn_to_retransn(beg:end))
    allocate(pnf%ndeploy(beg:end))
    allocate(pnf%pft_ninputs(beg:end))
    allocate(pnf%pft_noutputs(beg:end))
    allocate(pnf%wood_harvestn(beg:end))
    allocate(pnf%pft_fire_nloss(beg:end))
#if (defined CROP)
    allocate(pnf%grainn_xfer_to_grainn(beg:end))
    allocate(pnf%livestemn_to_litter(beg:end))
    allocate(pnf%grainn_to_food(beg:end))
    allocate(pnf%npool_to_grainn(beg:end))
    allocate(pnf%npool_to_grainn_storage(beg:end))
    allocate(pnf%grainn_storage_to_xfer(beg:end))
#endif

    pnf%m_leafn_to_litter(beg:end) = nan
    pnf%m_frootn_to_litter(beg:end) = nan
    pnf%m_leafn_storage_to_litter(beg:end) = nan
    pnf%m_frootn_storage_to_litter(beg:end) = nan
    pnf%m_livestemn_storage_to_litter(beg:end) = nan
    pnf%m_deadstemn_storage_to_litter(beg:end) = nan
    pnf%m_livecrootn_storage_to_litter(beg:end) = nan
    pnf%m_deadcrootn_storage_to_litter(beg:end) = nan
    pnf%m_leafn_xfer_to_litter(beg:end) = nan
    pnf%m_frootn_xfer_to_litter(beg:end) = nan
    pnf%m_livestemn_xfer_to_litter(beg:end) = nan
    pnf%m_deadstemn_xfer_to_litter(beg:end) = nan
    pnf%m_livecrootn_xfer_to_litter(beg:end) = nan
    pnf%m_deadcrootn_xfer_to_litter(beg:end) = nan
    pnf%m_livestemn_to_litter(beg:end) = nan
    pnf%m_deadstemn_to_litter(beg:end) = nan
    pnf%m_livecrootn_to_litter(beg:end) = nan
    pnf%m_deadcrootn_to_litter(beg:end) = nan
    pnf%m_retransn_to_litter(beg:end) = nan
    pnf%hrv_leafn_to_litter(beg:end) = nan             
    pnf%hrv_frootn_to_litter(beg:end) = nan            
    pnf%hrv_leafn_storage_to_litter(beg:end) = nan     
    pnf%hrv_frootn_storage_to_litter(beg:end) = nan    
    pnf%hrv_livestemn_storage_to_litter(beg:end) = nan 
    pnf%hrv_deadstemn_storage_to_litter(beg:end) = nan 
    pnf%hrv_livecrootn_storage_to_litter(beg:end) = nan
    pnf%hrv_deadcrootn_storage_to_litter(beg:end) = nan
    pnf%hrv_leafn_xfer_to_litter(beg:end) = nan        
    pnf%hrv_frootn_xfer_to_litter(beg:end) = nan       
    pnf%hrv_livestemn_xfer_to_litter(beg:end) = nan    
    pnf%hrv_deadstemn_xfer_to_litter(beg:end) = nan    
    pnf%hrv_livecrootn_xfer_to_litter(beg:end) = nan   
    pnf%hrv_deadcrootn_xfer_to_litter(beg:end) = nan   
    pnf%hrv_livestemn_to_litter(beg:end) = nan         
    pnf%hrv_deadstemn_to_prod10n(beg:end) = nan        
    pnf%hrv_deadstemn_to_prod100n(beg:end) = nan       
    pnf%hrv_livecrootn_to_litter(beg:end) = nan        
    pnf%hrv_deadcrootn_to_litter(beg:end) = nan        
    pnf%hrv_retransn_to_litter(beg:end) = nan           
    pnf%m_leafn_to_fire(beg:end) = nan
    pnf%m_frootn_to_fire(beg:end) = nan
    pnf%m_leafn_storage_to_fire(beg:end) = nan
    pnf%m_frootn_storage_to_fire(beg:end) = nan
    pnf%m_livestemn_storage_to_fire(beg:end) = nan
    pnf%m_deadstemn_storage_to_fire(beg:end) = nan
    pnf%m_livecrootn_storage_to_fire(beg:end) = nan
    pnf%m_deadcrootn_storage_to_fire(beg:end) = nan
    pnf%m_leafn_xfer_to_fire(beg:end) = nan
    pnf%m_frootn_xfer_to_fire(beg:end) = nan
    pnf%m_livestemn_xfer_to_fire(beg:end) = nan
    pnf%m_deadstemn_xfer_to_fire(beg:end) = nan
    pnf%m_livecrootn_xfer_to_fire(beg:end) = nan
    pnf%m_deadcrootn_xfer_to_fire(beg:end) = nan
    pnf%m_livestemn_to_fire(beg:end) = nan
    pnf%m_deadstemn_to_fire(beg:end) = nan
    pnf%m_deadstemn_to_litter_fire(beg:end) = nan
    pnf%m_livecrootn_to_fire(beg:end) = nan
    pnf%m_deadcrootn_to_fire(beg:end) = nan
    pnf%m_deadcrootn_to_litter_fire(beg:end) = nan
    pnf%m_retransn_to_fire(beg:end) = nan
    pnf%leafn_xfer_to_leafn(beg:end) = nan
    pnf%frootn_xfer_to_frootn(beg:end) = nan
    pnf%livestemn_xfer_to_livestemn(beg:end) = nan
    pnf%deadstemn_xfer_to_deadstemn(beg:end) = nan
    pnf%livecrootn_xfer_to_livecrootn(beg:end) = nan
    pnf%deadcrootn_xfer_to_deadcrootn(beg:end) = nan
    pnf%leafn_to_litter(beg:end) = nan
    pnf%leafn_to_retransn(beg:end) = nan
    pnf%frootn_to_litter(beg:end) = nan
    pnf%retransn_to_npool(beg:end) = nan
    pnf%sminn_to_npool(beg:end) = nan
    pnf%npool_to_leafn(beg:end) = nan
    pnf%npool_to_leafn_storage(beg:end) = nan
    pnf%npool_to_frootn(beg:end) = nan
    pnf%npool_to_frootn_storage(beg:end) = nan
    pnf%npool_to_livestemn(beg:end) = nan
    pnf%npool_to_livestemn_storage(beg:end) = nan
    pnf%npool_to_deadstemn(beg:end) = nan
    pnf%npool_to_deadstemn_storage(beg:end) = nan
    pnf%npool_to_livecrootn(beg:end) = nan
    pnf%npool_to_livecrootn_storage(beg:end) = nan
    pnf%npool_to_deadcrootn(beg:end) = nan
    pnf%npool_to_deadcrootn_storage(beg:end) = nan
    pnf%leafn_storage_to_xfer(beg:end) = nan
    pnf%frootn_storage_to_xfer(beg:end) = nan
    pnf%livestemn_storage_to_xfer(beg:end) = nan
    pnf%deadstemn_storage_to_xfer(beg:end) = nan
    pnf%livecrootn_storage_to_xfer(beg:end) = nan
    pnf%deadcrootn_storage_to_xfer(beg:end) = nan
    pnf%livestemn_to_deadstemn(beg:end) = nan
    pnf%livestemn_to_retransn(beg:end) = nan
    pnf%livecrootn_to_deadcrootn(beg:end) = nan
    pnf%livecrootn_to_retransn(beg:end) = nan
    pnf%ndeploy(beg:end) = nan
    pnf%pft_ninputs(beg:end) = nan
    pnf%pft_noutputs(beg:end) = nan
    pnf%wood_harvestn(beg:end) = nan
    pnf%pft_fire_nloss(beg:end) = nan
#if (defined CROP)
    pnf%grainn_xfer_to_grainn(beg:end) = nan
    pnf%livestemn_to_litter(beg:end) = nan
    pnf%grainn_to_food(beg:end) = nan
    pnf%npool_to_grainn(beg:end) = nan
    pnf%npool_to_grainn_storage(beg:end) = nan
    pnf%grainn_storage_to_xfer(beg:end) = nan
#endif

  end subroutine init_pft_nflux_type

!------------------------------------------------------------------------
!BOP
!
! !IROUTINE: init_pft_vflux_type
!
! !INTERFACE:
  subroutine init_pft_vflux_type(beg, end, pvf)
!
! !DESCRIPTION:
! Initialize pft VOC flux variables
!
    use clm_varcon, only : spval
! !ARGUMENTS:
    implicit none
    integer, intent(in) :: beg, end
    type (pft_vflux_type), intent(inout) :: pvf
!
! !REVISION HISTORY:
! Created by Mariana Vertenstein
! (heald, 08/06)
!
!EOP
!------------------------------------------------------------------------

    allocate(pvf%vocflx_tot(beg:end))
    allocate(pvf%vocflx(beg:end,1:nvoc))
    allocate(pvf%vocflx_1(beg:end))
    allocate(pvf%vocflx_2(beg:end))
    allocate(pvf%vocflx_3(beg:end))
    allocate(pvf%vocflx_4(beg:end))
    allocate(pvf%vocflx_5(beg:end))
    allocate(pvf%Eopt_out(beg:end))
    allocate(pvf%topt_out(beg:end))
    allocate(pvf%alpha_out(beg:end))
    allocate(pvf%cp_out(beg:end))
    allocate(pvf%para_out(beg:end))
    allocate(pvf%par24a_out(beg:end))
    allocate(pvf%par240a_out(beg:end))
    allocate(pvf%paru_out(beg:end))
    allocate(pvf%par24u_out(beg:end))
    allocate(pvf%par240u_out(beg:end))
    allocate(pvf%gamma_out(beg:end))
    allocate(pvf%gammaL_out(beg:end))
    allocate(pvf%gammaT_out(beg:end))
    allocate(pvf%gammaP_out(beg:end))
    allocate(pvf%gammaA_out(beg:end))
    allocate(pvf%gammaS_out(beg:end))

    pvf%vocflx_tot(beg:end) = spval
    pvf%vocflx(beg:end,1:nvoc) = spval
    pvf%vocflx_1(beg:end) = spval
    pvf%vocflx_2(beg:end) = spval
    pvf%vocflx_3(beg:end) = spval
    pvf%vocflx_4(beg:end) = spval
    pvf%vocflx_5(beg:end) = spval
    pvf%Eopt_out(beg:end) = nan
    pvf%topt_out(beg:end) = nan
    pvf%alpha_out(beg:end) = nan
    pvf%cp_out(beg:end) = nan
    pvf%para_out(beg:end) = nan
    pvf%par24a_out(beg:end) = nan
    pvf%par240a_out(beg:end) = nan
    pvf%paru_out(beg:end) = nan
    pvf%par24u_out(beg:end) = nan
    pvf%par240u_out(beg:end) = nan
    pvf%gamma_out(beg:end) = nan
    pvf%gammaL_out(beg:end) = nan
    pvf%gammaT_out(beg:end) = nan
    pvf%gammaP_out(beg:end) = nan
    pvf%gammaA_out(beg:end) = nan
    pvf%gammaS_out(beg:end) = nan

  end subroutine init_pft_vflux_type

!------------------------------------------------------------------------
!BOP
!
! !IROUTINE: init_pft_dflux_type
!
! !INTERFACE:
  subroutine init_pft_dflux_type(beg, end, pdf)
!
! !DESCRIPTION:
! Initialize pft dust flux variables
!
! !ARGUMENTS:
    implicit none
    integer, intent(in) :: beg, end
    type (pft_dflux_type), intent(inout):: pdf
!
! !REVISION HISTORY:
! Created by Mariana Vertenstein
!
!EOP
!------------------------------------------------------------------------

    allocate(pdf%flx_mss_vrt_dst(beg:end,1:ndst))
    allocate(pdf%flx_mss_vrt_dst_tot(beg:end))
    allocate(pdf%vlc_trb(beg:end,1:ndst))
    allocate(pdf%vlc_trb_1(beg:end))
    allocate(pdf%vlc_trb_2(beg:end))
    allocate(pdf%vlc_trb_3(beg:end))
    allocate(pdf%vlc_trb_4(beg:end))

    pdf%flx_mss_vrt_dst(beg:end,1:ndst) = nan
    pdf%flx_mss_vrt_dst_tot(beg:end) = nan
    pdf%vlc_trb(beg:end,1:ndst) = nan
    pdf%vlc_trb_1(beg:end) = nan
    pdf%vlc_trb_2(beg:end) = nan
    pdf%vlc_trb_3(beg:end) = nan
    pdf%vlc_trb_4(beg:end) = nan

  end subroutine init_pft_dflux_type

!------------------------------------------------------------------------
!BOP
!
! !IROUTINE: init_pft_depvd_type
!
! !INTERFACE:
  subroutine init_pft_depvd_type(beg, end, pdd)

!    use seq_drydep_mod, only:  n_drydep
!
! !DESCRIPTION:
! Initialize pft dep velocity variables
!
! !ARGUMENTS:
    implicit none
    integer, intent(in) :: beg, end
    type (pft_depvd_type), intent(inout):: pdd
    integer :: i
!
! !REVISION HISTORY:
! Created by James Sulzman 541-929-6183
!
!EOP
!------------------------------------------------------------------------

!    if ( n_drydep > 0 )then
!       allocate(pdd%drydepvel(beg:end,n_drydep))
!       pdd%drydepvel = nan
!    end if

  end subroutine init_pft_depvd_type

!------------------------------------------------------------------------
!BOP
!
! !IROUTINE: init_column_pstate_type
!
! !INTERFACE:
  subroutine init_column_pstate_type(beg, end, cps)
!
! !DESCRIPTION:
! Initialize column physical state variables
!
! !USES:
    use clm_varcon, only : spval
! !ARGUMENTS:
    implicit none
    integer, intent(in) :: beg, end
    type (column_pstate_type), intent(inout):: cps
!
! !REVISION HISTORY:
! Created by Mariana Vertenstein
!
!EOP
!------------------------------------------------------------------------

    allocate(cps%snl(beg:end))      !* cannot be averaged up
    allocate(cps%isoicol(beg:end))  !* cannot be averaged up
    allocate(cps%bsw(beg:end,nlevgrnd))
    allocate(cps%watsat(beg:end,nlevgrnd))
    allocate(cps%watfc(beg:end,nlevgrnd))
    allocate(cps%watdry(beg:end,nlevgrnd)) 
    allocate(cps%watopt(beg:end,nlevgrnd)) 
    allocate(cps%hksat(beg:end,nlevgrnd))
    allocate(cps%sucsat(beg:end,nlevgrnd))
    allocate(cps%csol(beg:end,nlevgrnd))
    allocate(cps%tkmg(beg:end,nlevgrnd))
    allocate(cps%tkdry(beg:end,nlevgrnd))
    allocate(cps%tksatu(beg:end,nlevgrnd))
    allocate(cps%smpmin(beg:end))
    allocate(cps%hkdepth(beg:end))
    allocate(cps%wtfact(beg:end))
    allocate(cps%fracice(beg:end,nlevgrnd))
    allocate(cps%gwc_thr(beg:end))
    allocate(cps%mss_frc_cly_vld(beg:end))
    allocate(cps%mbl_bsn_fct(beg:end))
    allocate(cps%do_capsnow(beg:end))
    allocate(cps%snowdp(beg:end))
    allocate(cps%frac_sno (beg:end))
    allocate(cps%zi(beg:end,-nlevsno+0:nlevgrnd))
    allocate(cps%dz(beg:end,-nlevsno+1:nlevgrnd))
    allocate(cps%z (beg:end,-nlevsno+1:nlevgrnd))
    allocate(cps%frac_iceold(beg:end,-nlevsno+1:nlevgrnd))
    allocate(cps%imelt(beg:end,-nlevsno+1:nlevgrnd))
    allocate(cps%eff_porosity(beg:end,nlevgrnd))
    allocate(cps%emg(beg:end))
    allocate(cps%z0mg(beg:end))
    allocate(cps%z0hg(beg:end))
    allocate(cps%z0qg(beg:end))
    allocate(cps%htvp(beg:end))
    allocate(cps%beta(beg:end))
    allocate(cps%zii(beg:end))
    allocate(cps%albgrd(beg:end,numrad))
    allocate(cps%albgri(beg:end,numrad))
    allocate(cps%rootr_column(beg:end,nlevgrnd))
    allocate(cps%rootfr_road_perv(beg:end,nlevgrnd))
    allocate(cps%rootr_road_perv(beg:end,nlevgrnd))
    allocate(cps%wf(beg:end))
!   allocate(cps%xirrig(beg:end))
    allocate(cps%max_dayl(beg:end))
    allocate(cps%bsw2(beg:end,nlevgrnd))
    allocate(cps%psisat(beg:end,nlevgrnd))
    allocate(cps%vwcsat(beg:end,nlevgrnd))
    allocate(cps%soilpsi(beg:end,nlevgrnd))
    allocate(cps%decl(beg:end))
    allocate(cps%coszen(beg:end))
    allocate(cps%fpi(beg:end))
    allocate(cps%fpg(beg:end))
    allocate(cps%annsum_counter(beg:end))
    allocate(cps%cannsum_npp(beg:end))
    allocate(cps%cannavg_t2m(beg:end))
    allocate(cps%me(beg:end))
    allocate(cps%fire_prob(beg:end))
    allocate(cps%mean_fire_prob(beg:end))
    allocate(cps%fireseasonl(beg:end))
    allocate(cps%farea_burned(beg:end))
    allocate(cps%ann_farea_burned(beg:end))
    allocate(cps%albsnd_hst(beg:end,numrad))
    allocate(cps%albsni_hst(beg:end,numrad))
    allocate(cps%albsod(beg:end,numrad))
    allocate(cps%albsoi(beg:end,numrad))
    allocate(cps%flx_absdv(beg:end,-nlevsno+1:1))
    allocate(cps%flx_absdn(beg:end,-nlevsno+1:1))
    allocate(cps%flx_absiv(beg:end,-nlevsno+1:1))
    allocate(cps%flx_absin(beg:end,-nlevsno+1:1))
    allocate(cps%snw_rds(beg:end,-nlevsno+1:0))
    allocate(cps%snw_rds_top(beg:end))
    allocate(cps%sno_liq_top(beg:end))
    allocate(cps%mss_bcpho(beg:end,-nlevsno+1:0))
    allocate(cps%mss_bcphi(beg:end,-nlevsno+1:0))
    allocate(cps%mss_bctot(beg:end,-nlevsno+1:0))
    allocate(cps%mss_bc_col(beg:end))
    allocate(cps%mss_bc_top(beg:end))
    allocate(cps%mss_ocpho(beg:end,-nlevsno+1:0))
    allocate(cps%mss_ocphi(beg:end,-nlevsno+1:0))
    allocate(cps%mss_octot(beg:end,-nlevsno+1:0))
    allocate(cps%mss_oc_col(beg:end))
    allocate(cps%mss_oc_top(beg:end))
    allocate(cps%mss_dst1(beg:end,-nlevsno+1:0))
    allocate(cps%mss_dst2(beg:end,-nlevsno+1:0))
    allocate(cps%mss_dst3(beg:end,-nlevsno+1:0))
    allocate(cps%mss_dst4(beg:end,-nlevsno+1:0))
    allocate(cps%mss_dsttot(beg:end,-nlevsno+1:0))
    allocate(cps%mss_dst_col(beg:end))
    allocate(cps%mss_dst_top(beg:end))
    allocate(cps%h2osno_top(beg:end))
    allocate(cps%mss_cnc_bcphi(beg:end,-nlevsno+1:0))
    allocate(cps%mss_cnc_bcpho(beg:end,-nlevsno+1:0))
    allocate(cps%mss_cnc_ocphi(beg:end,-nlevsno+1:0))
    allocate(cps%mss_cnc_ocpho(beg:end,-nlevsno+1:0))
    allocate(cps%mss_cnc_dst1(beg:end,-nlevsno+1:0))
    allocate(cps%mss_cnc_dst2(beg:end,-nlevsno+1:0))
    allocate(cps%mss_cnc_dst3(beg:end,-nlevsno+1:0))
    allocate(cps%mss_cnc_dst4(beg:end,-nlevsno+1:0))
    allocate(cps%albgrd_pur(beg:end,numrad))
    allocate(cps%albgri_pur(beg:end,numrad))
    allocate(cps%albgrd_bc(beg:end,numrad))
    allocate(cps%albgri_bc(beg:end,numrad))
    allocate(cps%albgrd_oc(beg:end,numrad))
    allocate(cps%albgri_oc(beg:end,numrad))
    allocate(cps%albgrd_dst(beg:end,numrad))
    allocate(cps%albgri_dst(beg:end,numrad))
    allocate(cps%dTdz_top(beg:end))
    allocate(cps%snot_top(beg:end))

    cps%isoicol(beg:end) = bigint
    cps%bsw(beg:end,1:nlevgrnd) = nan
    cps%watsat(beg:end,1:nlevgrnd) = nan
    cps%watfc(beg:end,1:nlevgrnd) = nan
    cps%watdry(beg:end,1:nlevgrnd) = nan
    cps%watopt(beg:end,1:nlevgrnd) = nan
    cps%hksat(beg:end,1:nlevgrnd) = nan
    cps%sucsat(beg:end,1:nlevgrnd) = nan
    cps%csol(beg:end,1:nlevgrnd) = nan
    cps%tkmg(beg:end,1:nlevgrnd) = nan
    cps%tkdry(beg:end,1:nlevgrnd) = nan
    cps%tksatu(beg:end,1:nlevgrnd) = nan
    cps%smpmin(beg:end) = nan
    cps%hkdepth(beg:end) = nan
    cps%wtfact(beg:end) = nan
    cps%fracice(beg:end,1:nlevgrnd) = nan
    cps%gwc_thr(beg:end) = nan
    cps%mss_frc_cly_vld(beg:end) = nan
    cps%mbl_bsn_fct(beg:end) = nan
    cps%do_capsnow (beg:end)= .false.
    cps%snowdp(beg:end) = nan
    cps%frac_sno(beg:end) = nan
    cps%zi(beg:end,-nlevsno+0:nlevgrnd) = nan
    cps%dz(beg:end,-nlevsno+1:nlevgrnd) = nan
    cps%z (beg:end,-nlevsno+1:nlevgrnd) = nan
    cps%frac_iceold(beg:end,-nlevsno+1:nlevgrnd) = spval
    cps%imelt(beg:end,-nlevsno+1:nlevgrnd) = bigint
    cps%eff_porosity(beg:end,1:nlevgrnd) = spval
    cps%emg(beg:end) = nan
    cps%z0mg(beg:end) = nan
    cps%z0hg(beg:end) = nan
    cps%z0qg(beg:end) = nan
    cps%htvp(beg:end) = nan
    cps%beta(beg:end) = nan
    cps%zii(beg:end) = nan
    cps%albgrd(beg:end,:numrad) = nan
    cps%albgri(beg:end,:numrad) = nan
    cps%rootr_column(beg:end,1:nlevgrnd) = spval
    cps%rootfr_road_perv(beg:end,1:nlevurb) = nan
    cps%rootr_road_perv(beg:end,1:nlevurb) = nan
    cps%wf(beg:end) = nan
!   cps%xirrig(beg:end) = 0._r8
    cps%bsw2(beg:end,1:nlevgrnd) = nan
    cps%psisat(beg:end,1:nlevgrnd) = nan
    cps%vwcsat(beg:end,1:nlevgrnd) = nan
    cps%soilpsi(beg:end,1:nlevgrnd) = spval
    cps%decl(beg:end) = nan
    cps%coszen(beg:end) = nan
    cps%fpi(beg:end) = nan
    cps%fpg(beg:end) = nan
    cps%annsum_counter(beg:end) = nan
    cps%cannsum_npp(beg:end) = nan
    cps%cannavg_t2m(beg:end) = nan
    cps%me(beg:end) = nan
    cps%fire_prob(beg:end) = nan
    cps%mean_fire_prob(beg:end) = nan
    cps%fireseasonl(beg:end) = nan
    cps%farea_burned(beg:end) = nan
    cps%ann_farea_burned(beg:end) = nan
    cps%albsnd_hst(beg:end,:numrad) = spval
    cps%albsni_hst(beg:end,:numrad) = spval
    cps%albsod(beg:end,:numrad) = nan
    cps%albsoi(beg:end,:numrad) = nan
    cps%flx_absdv(beg:end,-nlevsno+1:1) = spval
    cps%flx_absdn(beg:end,-nlevsno+1:1) = spval
    cps%flx_absiv(beg:end,-nlevsno+1:1) = spval
    cps%flx_absin(beg:end,-nlevsno+1:1) = spval
    cps%snw_rds(beg:end,-nlevsno+1:0) = nan
    cps%snw_rds_top(beg:end) = nan
    cps%sno_liq_top(beg:end) = nan
    cps%mss_bcpho(beg:end,-nlevsno+1:0) = nan
    cps%mss_bcphi(beg:end,-nlevsno+1:0) = nan
    cps%mss_bctot(beg:end,-nlevsno+1:0) = nan
    cps%mss_bc_col(beg:end) = nan
    cps%mss_bc_top(beg:end) = nan
    cps%mss_ocpho(beg:end,-nlevsno+1:0) = nan
    cps%mss_ocphi(beg:end,-nlevsno+1:0) = nan
    cps%mss_octot(beg:end,-nlevsno+1:0) = nan
    cps%mss_oc_col(beg:end) = nan
    cps%mss_oc_top(beg:end) = nan
    cps%mss_dst1(beg:end,-nlevsno+1:0) = nan
    cps%mss_dst2(beg:end,-nlevsno+1:0) = nan
    cps%mss_dst3(beg:end,-nlevsno+1:0) = nan
    cps%mss_dst4(beg:end,-nlevsno+1:0) = nan
    cps%mss_dsttot(beg:end,-nlevsno+1:0) = nan
    cps%mss_dst_col(beg:end) = nan
    cps%mss_dst_top(beg:end) = nan
    cps%h2osno_top(beg:end) = nan
    cps%mss_cnc_bcphi(beg:end,-nlevsno+1:0) = nan
    cps%mss_cnc_bcpho(beg:end,-nlevsno+1:0) = nan
    cps%mss_cnc_ocphi(beg:end,-nlevsno+1:0) = nan
    cps%mss_cnc_ocpho(beg:end,-nlevsno+1:0) = nan
    cps%mss_cnc_dst1(beg:end,-nlevsno+1:0) = nan
    cps%mss_cnc_dst2(beg:end,-nlevsno+1:0) = nan
    cps%mss_cnc_dst3(beg:end,-nlevsno+1:0) = nan
    cps%mss_cnc_dst4(beg:end,-nlevsno+1:0) = nan
    cps%albgrd_pur(beg:end,:numrad) = nan
    cps%albgri_pur(beg:end,:numrad) = nan
    cps%albgrd_bc(beg:end,:numrad) = nan
    cps%albgri_bc(beg:end,:numrad) = nan
    cps%albgrd_oc(beg:end,:numrad) = nan
    cps%albgri_oc(beg:end,:numrad) = nan 
    cps%albgrd_dst(beg:end,:numrad) = nan
    cps%albgri_dst(beg:end,:numrad) = nan
    cps%dTdz_top(beg:end) = nan
    cps%snot_top(beg:end) = nan
  end subroutine init_column_pstate_type

!------------------------------------------------------------------------
!BOP
!
! !IROUTINE: init_column_estate_type
!
! !INTERFACE:
  subroutine init_column_estate_type(beg, end, ces)
!
! !DESCRIPTION:
! Initialize column energy state variables
!
! !USES:
    use clm_varcon, only : spval
! !ARGUMENTS:
    implicit none
    integer, intent(in) :: beg, end
    type (column_estate_type), intent(inout):: ces
!
! !REVISION HISTORY:
! Created by Mariana Vertenstein
!
!EOP
!------------------------------------------------------------------------
    allocate(ces%t_grnd(beg:end))
    allocate(ces%t_grnd_u(beg:end))
    allocate(ces%t_grnd_r(beg:end))
    allocate(ces%dt_grnd(beg:end))
    allocate(ces%t_soisno(beg:end,-nlevsno+1:nlevgrnd))
    allocate(ces%t_soi_10cm(beg:end))
    allocate(ces%t_lake(beg:end,1:nlevlak))
    allocate(ces%tssbef(beg:end,-nlevsno+1:nlevgrnd))
    allocate(ces%thv(beg:end))
    allocate(ces%hc_soi(beg:end))
    allocate(ces%hc_soisno(beg:end))

    ces%t_grnd(beg:end)    = nan
    ces%t_grnd_u(beg:end)  = nan
    ces%t_grnd_r(beg:end)  = nan
    ces%dt_grnd(beg:end)   = nan
    ces%t_soisno(beg:end,-nlevsno+1:nlevgrnd) = spval
    ces%t_soi_10cm(beg:end) = spval
    ces%t_lake(beg:end,1:nlevlak)            = nan
    ces%tssbef(beg:end,-nlevsno+1:nlevgrnd)   = nan
    ces%thv(beg:end)       = nan
    ces%hc_soi(beg:end)    = nan
    ces%hc_soisno(beg:end) = nan

  end subroutine init_column_estate_type

!------------------------------------------------------------------------
!BOP
!
! !IROUTINE: init_column_wstate_type
!
! !INTERFACE:
  subroutine init_column_wstate_type(beg, end, cws)
!
! !DESCRIPTION:
! Initialize column water state variables
!
! !USES:
    use clm_varcon, only : spval
! !ARGUMENTS:
    implicit none
    integer, intent(in) :: beg, end
    type (column_wstate_type), intent(inout):: cws !column water state
!
! !REVISION HISTORY:
! Created by Mariana Vertenstein
!
!EOP
!------------------------------------------------------------------------

    allocate(cws%h2osno(beg:end))
    allocate(cws%h2osoi_liq(beg:end,-nlevsno+1:nlevgrnd))
    allocate(cws%h2osoi_ice(beg:end,-nlevsno+1:nlevgrnd))
    allocate(cws%h2osoi_liqice_10cm(beg:end))
    allocate(cws%h2osoi_vol(beg:end,1:nlevgrnd))
    allocate(cws%h2osno_old(beg:end))
    allocate(cws%qg(beg:end))
    allocate(cws%dqgdT(beg:end))
    allocate(cws%snowice(beg:end))
    allocate(cws%snowliq(beg:end))
    allocate(cws%soilalpha(beg:end))
    allocate(cws%soilbeta(beg:end))
    allocate(cws%soilalpha_u(beg:end))
    allocate(cws%zwt(beg:end))
    allocate(cws%fcov(beg:end))
    allocate(cws%fsat(beg:end))
    allocate(cws%wa(beg:end))
    allocate(cws%wt(beg:end))
    allocate(cws%qcharge(beg:end))
    allocate(cws%smp_l(beg:end,1:nlevgrnd))
    allocate(cws%hk_l(beg:end,1:nlevgrnd))

    cws%h2osno(beg:end) = nan
    cws%h2osoi_liq(beg:end,-nlevsno+1:nlevgrnd)= spval
    cws%h2osoi_ice(beg:end,-nlevsno+1:nlevgrnd) = spval
    cws%h2osoi_liqice_10cm(beg:end) = spval
    cws%h2osoi_vol(beg:end,1:nlevgrnd) = spval
    cws%h2osno_old(beg:end) = nan
    cws%qg(beg:end) = nan
    cws%dqgdT(beg:end) = nan
    cws%snowice(beg:end) = nan
    cws%snowliq(beg:end) = nan
    cws%soilalpha(beg:end) = nan
    cws%soilbeta(beg:end) = nan
    cws%soilalpha_u(beg:end) = nan
    cws%zwt(beg:end) = nan
    cws%fcov(beg:end) = nan
    cws%fsat(beg:end) = nan
    cws%wa(beg:end) = nan
    cws%wt(beg:end) = nan
    cws%qcharge(beg:end) = nan
    cws%smp_l(beg:end,1:nlevgrnd) = spval
    cws%hk_l(beg:end,1:nlevgrnd) = spval

  end subroutine init_column_wstate_type

!------------------------------------------------------------------------
!BOP
!
! !IROUTINE: init_column_cstate_type
!
! !INTERFACE:
  subroutine init_column_cstate_type(beg, end, ccs)
!
! !DESCRIPTION:
! Initialize column carbon state variables
!
! !ARGUMENTS:
    implicit none
    integer, intent(in) :: beg, end
    type (column_cstate_type), intent(inout):: ccs
!
! !REVISION HISTORY:
! Created by Mariana Vertenstein
!
!EOP
!------------------------------------------------------------------------

    allocate(ccs%soilc(beg:end))
    allocate(ccs%cwdc(beg:end))
    allocate(ccs%litr1c(beg:end))
    allocate(ccs%litr2c(beg:end))
    allocate(ccs%litr3c(beg:end))
    allocate(ccs%soil1c(beg:end))
    allocate(ccs%soil2c(beg:end))
    allocate(ccs%soil3c(beg:end))
    allocate(ccs%soil4c(beg:end))
    allocate(ccs%seedc(beg:end))
    allocate(ccs%col_ctrunc(beg:end))
    allocate(ccs%prod10c(beg:end))
    allocate(ccs%prod100c(beg:end))
    allocate(ccs%totprodc(beg:end))
    allocate(ccs%totlitc(beg:end))
    allocate(ccs%totsomc(beg:end))
    allocate(ccs%totecosysc(beg:end))
    allocate(ccs%totcolc(beg:end))

    ccs%soilc(beg:end) = nan
    ccs%cwdc(beg:end) = nan
    ccs%litr1c(beg:end) = nan
    ccs%litr2c(beg:end) = nan
    ccs%litr3c(beg:end) = nan
    ccs%soil1c(beg:end) = nan
    ccs%soil2c(beg:end) = nan
    ccs%soil3c(beg:end) = nan
    ccs%soil4c(beg:end) = nan
    ccs%seedc(beg:end) = nan
    ccs%col_ctrunc(beg:end) = nan
    ccs%prod10c(beg:end) = nan
    ccs%prod100c(beg:end) = nan
    ccs%totprodc(beg:end) = nan
    ccs%totlitc(beg:end) = nan
    ccs%totsomc(beg:end) = nan
    ccs%totecosysc(beg:end) = nan
    ccs%totcolc(beg:end) = nan

  end subroutine init_column_cstate_type

!------------------------------------------------------------------------
!BOP
!
! !IROUTINE: init_column_nstate_type
!
! !INTERFACE:
  subroutine init_column_nstate_type(beg, end, cns)
!
! !DESCRIPTION:
! Initialize column nitrogen state variables
!
! !ARGUMENTS:
    implicit none
    integer, intent(in) :: beg, end
    type (column_nstate_type), intent(inout):: cns
!
! !REVISION HISTORY:
! Created by Peter Thornton
!
!EOP
!------------------------------------------------------------------------

    allocate(cns%cwdn(beg:end))
    allocate(cns%litr1n(beg:end))
    allocate(cns%litr2n(beg:end))
    allocate(cns%litr3n(beg:end))
    allocate(cns%soil1n(beg:end))
    allocate(cns%soil2n(beg:end))
    allocate(cns%soil3n(beg:end))
    allocate(cns%soil4n(beg:end))
    allocate(cns%sminn(beg:end))
    allocate(cns%col_ntrunc(beg:end))
    allocate(cns%seedn(beg:end))
    allocate(cns%prod10n(beg:end))
    allocate(cns%prod100n(beg:end))
    allocate(cns%totprodn(beg:end))
    allocate(cns%totlitn(beg:end))
    allocate(cns%totsomn(beg:end))
    allocate(cns%totecosysn(beg:end))
    allocate(cns%totcoln(beg:end))

    cns%cwdn(beg:end) = nan
    cns%litr1n(beg:end) = nan
    cns%litr2n(beg:end) = nan
    cns%litr3n(beg:end) = nan
    cns%soil1n(beg:end) = nan
    cns%soil2n(beg:end) = nan
    cns%soil3n(beg:end) = nan
    cns%soil4n(beg:end) = nan
    cns%sminn(beg:end) = nan
    cns%col_ntrunc(beg:end) = nan
    cns%seedn(beg:end) = nan
    cns%prod10n(beg:end) = nan
    cns%prod100n(beg:end) = nan
    cns%totprodn(beg:end) = nan
    cns%totlitn(beg:end) = nan
    cns%totsomn(beg:end) = nan
    cns%totecosysn(beg:end) = nan
    cns%totcoln(beg:end) = nan

  end subroutine init_column_nstate_type

!------------------------------------------------------------------------
!BOP
!
! !IROUTINE: init_column_eflux_type
!
! !INTERFACE:
  subroutine init_column_eflux_type(beg, end, cef)
!
! !DESCRIPTION:
! Initialize column energy flux variables
!
! !ARGUMENTS:
    implicit none
    integer, intent(in) :: beg, end
    type (column_eflux_type), intent(inout):: cef
!
! !REVISION HISTORY:
! Created by Mariana Vertenstein
!
!EOP
!------------------------------------------------------------------------

    allocate(cef%eflx_snomelt(beg:end))
    allocate(cef%eflx_snomelt_u(beg:end))
    allocate(cef%eflx_snomelt_r(beg:end))
    allocate(cef%eflx_impsoil(beg:end))
    allocate(cef%eflx_fgr12(beg:end))
    allocate(cef%eflx_building_heat(beg:end))
    allocate(cef%eflx_urban_ac(beg:end))
    allocate(cef%eflx_urban_heat(beg:end))

    cef%eflx_snomelt(beg:end)       = nan
    cef%eflx_snomelt_u(beg:end)       = nan
    cef%eflx_snomelt_r(beg:end)       = nan
    cef%eflx_impsoil(beg:end)       = nan
    cef%eflx_fgr12(beg:end)         = nan
    cef%eflx_building_heat(beg:end) = nan
    cef%eflx_urban_ac(beg:end) = nan
    cef%eflx_urban_heat(beg:end) = nan

  end subroutine init_column_eflux_type

!------------------------------------------------------------------------
!BOP
!
! !IROUTINE: init_column_wflux_type
!
! !INTERFACE:
  subroutine init_column_wflux_type(beg, end, cwf)
!
! !DESCRIPTION:
! Initialize column water flux variables
!
! !USES:
    use clm_varcon, only : spval
! !ARGUMENTS:
    implicit none
    integer, intent(in) :: beg, end
    type (column_wflux_type), intent(inout):: cwf
!
! !REVISION HISTORY:
! Created by Mariana Vertenstein
!
!EOP
!------------------------------------------------------------------------

    allocate(cwf%qflx_infl(beg:end))
    allocate(cwf%qflx_surf(beg:end))
    allocate(cwf%qflx_drain(beg:end))
    allocate(cwf%qflx_top_soil(beg:end))
    allocate(cwf%qflx_snomelt(beg:end))
    allocate(cwf%qflx_qrgwl(beg:end))
    allocate(cwf%qflx_runoff(beg:end))
    allocate(cwf%qflx_runoff_u(beg:end))
    allocate(cwf%qflx_runoff_r(beg:end))
    allocate(cwf%qmelt(beg:end))
    allocate(cwf%h2ocan_loss(beg:end))
    allocate(cwf%qflx_rsub_sat(beg:end))
    allocate(cwf%flx_bc_dep_dry(beg:end))
    allocate(cwf%flx_bc_dep_wet(beg:end))
    allocate(cwf%flx_bc_dep_pho(beg:end))
    allocate(cwf%flx_bc_dep_phi(beg:end))
    allocate(cwf%flx_bc_dep(beg:end))
    allocate(cwf%flx_oc_dep_dry(beg:end))
    allocate(cwf%flx_oc_dep_wet(beg:end))
    allocate(cwf%flx_oc_dep_pho(beg:end))
    allocate(cwf%flx_oc_dep_phi(beg:end))
    allocate(cwf%flx_oc_dep(beg:end))
    allocate(cwf%flx_dst_dep_dry1(beg:end))
    allocate(cwf%flx_dst_dep_wet1(beg:end))
    allocate(cwf%flx_dst_dep_dry2(beg:end))
    allocate(cwf%flx_dst_dep_wet2(beg:end))
    allocate(cwf%flx_dst_dep_dry3(beg:end))
    allocate(cwf%flx_dst_dep_wet3(beg:end))
    allocate(cwf%flx_dst_dep_dry4(beg:end))
    allocate(cwf%flx_dst_dep_wet4(beg:end))
    allocate(cwf%flx_dst_dep(beg:end))
    allocate(cwf%qflx_snofrz_lyr(beg:end,-nlevsno+1:0))

    cwf%qflx_infl(beg:end) = nan
    cwf%qflx_surf(beg:end) = nan
    cwf%qflx_drain(beg:end) = nan
    cwf%qflx_top_soil(beg:end) = nan
    cwf%qflx_snomelt(beg:end) = nan
    cwf%qflx_qrgwl(beg:end) = nan
    cwf%qflx_runoff(beg:end) = nan
    cwf%qflx_runoff_u(beg:end) = nan
    cwf%qflx_runoff_r(beg:end) = nan
    cwf%qmelt(beg:end) = nan
    cwf%h2ocan_loss(beg:end) = nan
    cwf%qflx_rsub_sat(beg:end) = nan
    cwf%flx_bc_dep_dry(beg:end) = nan
    cwf%flx_bc_dep_wet(beg:end) = nan
    cwf%flx_bc_dep_pho(beg:end) = nan
    cwf%flx_bc_dep_phi(beg:end) = nan
    cwf%flx_bc_dep(beg:end) = nan
    cwf%flx_oc_dep_dry(beg:end) = nan
    cwf%flx_oc_dep_wet(beg:end) = nan
    cwf%flx_oc_dep_pho(beg:end) = nan
    cwf%flx_oc_dep_phi(beg:end) = nan
    cwf%flx_oc_dep(beg:end) = nan
    cwf%flx_dst_dep_dry1(beg:end) = nan
    cwf%flx_dst_dep_wet1(beg:end) = nan
    cwf%flx_dst_dep_dry2(beg:end) = nan
    cwf%flx_dst_dep_wet2(beg:end) = nan
    cwf%flx_dst_dep_dry3(beg:end) = nan
    cwf%flx_dst_dep_wet3(beg:end) = nan
    cwf%flx_dst_dep_dry4(beg:end) = nan
    cwf%flx_dst_dep_wet4(beg:end) = nan
    cwf%flx_dst_dep(beg:end) = nan
    cwf%qflx_snofrz_lyr(beg:end,-nlevsno+1:0) = spval

  end subroutine init_column_wflux_type

!------------------------------------------------------------------------
!BOP
!
! !IROUTINE: init_column_cflux_type
!
! !INTERFACE:
  subroutine init_column_cflux_type(beg, end, ccf)
!
! !DESCRIPTION:
! Initialize column carbon flux variables
!
! !ARGUMENTS:
    implicit none
    integer, intent(in) :: beg, end
    type (column_cflux_type), intent(inout):: ccf
!
! !REVISION HISTORY:
! Created by Peter Thornton
!
!EOP
!------------------------------------------------------------------------

    allocate(ccf%m_leafc_to_litr1c(beg:end))
    allocate(ccf%m_leafc_to_litr2c(beg:end))
    allocate(ccf%m_leafc_to_litr3c(beg:end))
    allocate(ccf%m_frootc_to_litr1c(beg:end))
    allocate(ccf%m_frootc_to_litr2c(beg:end))
    allocate(ccf%m_frootc_to_litr3c(beg:end))
    allocate(ccf%m_leafc_storage_to_litr1c(beg:end))
    allocate(ccf%m_frootc_storage_to_litr1c(beg:end))
    allocate(ccf%m_livestemc_storage_to_litr1c(beg:end))
    allocate(ccf%m_deadstemc_storage_to_litr1c(beg:end))
    allocate(ccf%m_livecrootc_storage_to_litr1c(beg:end))
    allocate(ccf%m_deadcrootc_storage_to_litr1c(beg:end))
    allocate(ccf%m_leafc_xfer_to_litr1c(beg:end))
    allocate(ccf%m_frootc_xfer_to_litr1c(beg:end))
    allocate(ccf%m_livestemc_xfer_to_litr1c(beg:end))
    allocate(ccf%m_deadstemc_xfer_to_litr1c(beg:end))
    allocate(ccf%m_livecrootc_xfer_to_litr1c(beg:end))
    allocate(ccf%m_deadcrootc_xfer_to_litr1c(beg:end))
    allocate(ccf%m_livestemc_to_cwdc(beg:end))
    allocate(ccf%m_deadstemc_to_cwdc(beg:end))
    allocate(ccf%m_livecrootc_to_cwdc(beg:end))
    allocate(ccf%m_deadcrootc_to_cwdc(beg:end))
    allocate(ccf%m_gresp_storage_to_litr1c(beg:end))
    allocate(ccf%m_gresp_xfer_to_litr1c(beg:end))
    allocate(ccf%m_deadstemc_to_cwdc_fire(beg:end))
    allocate(ccf%m_deadcrootc_to_cwdc_fire(beg:end))
    allocate(ccf%hrv_leafc_to_litr1c(beg:end))             
    allocate(ccf%hrv_leafc_to_litr2c(beg:end))             
    allocate(ccf%hrv_leafc_to_litr3c(beg:end))             
    allocate(ccf%hrv_frootc_to_litr1c(beg:end))            
    allocate(ccf%hrv_frootc_to_litr2c(beg:end))            
    allocate(ccf%hrv_frootc_to_litr3c(beg:end))            
    allocate(ccf%hrv_livestemc_to_cwdc(beg:end))           
    allocate(ccf%hrv_deadstemc_to_prod10c(beg:end))        
    allocate(ccf%hrv_deadstemc_to_prod100c(beg:end))       
    allocate(ccf%hrv_livecrootc_to_cwdc(beg:end))          
    allocate(ccf%hrv_deadcrootc_to_cwdc(beg:end))          
    allocate(ccf%hrv_leafc_storage_to_litr1c(beg:end))     
    allocate(ccf%hrv_frootc_storage_to_litr1c(beg:end))    
    allocate(ccf%hrv_livestemc_storage_to_litr1c(beg:end)) 
    allocate(ccf%hrv_deadstemc_storage_to_litr1c(beg:end)) 
    allocate(ccf%hrv_livecrootc_storage_to_litr1c(beg:end))
    allocate(ccf%hrv_deadcrootc_storage_to_litr1c(beg:end))
    allocate(ccf%hrv_gresp_storage_to_litr1c(beg:end))     
    allocate(ccf%hrv_leafc_xfer_to_litr1c(beg:end))        
    allocate(ccf%hrv_frootc_xfer_to_litr1c(beg:end))       
    allocate(ccf%hrv_livestemc_xfer_to_litr1c(beg:end))    
    allocate(ccf%hrv_deadstemc_xfer_to_litr1c(beg:end))    
    allocate(ccf%hrv_livecrootc_xfer_to_litr1c(beg:end))   
    allocate(ccf%hrv_deadcrootc_xfer_to_litr1c(beg:end))   
    allocate(ccf%hrv_gresp_xfer_to_litr1c(beg:end))        
    allocate(ccf%m_litr1c_to_fire(beg:end))
    allocate(ccf%m_litr2c_to_fire(beg:end))
    allocate(ccf%m_litr3c_to_fire(beg:end))
    allocate(ccf%m_cwdc_to_fire(beg:end))
#if (defined CROP)
    allocate(ccf%grainc_to_litr1c(beg:end))
    allocate(ccf%grainc_to_litr2c(beg:end))
    allocate(ccf%grainc_to_litr3c(beg:end))
    allocate(ccf%livestemc_to_litr1c(beg:end))
    allocate(ccf%livestemc_to_litr2c(beg:end))
    allocate(ccf%livestemc_to_litr3c(beg:end))
#endif
    allocate(ccf%leafc_to_litr1c(beg:end))
    allocate(ccf%leafc_to_litr2c(beg:end))
    allocate(ccf%leafc_to_litr3c(beg:end))
    allocate(ccf%frootc_to_litr1c(beg:end))
    allocate(ccf%frootc_to_litr2c(beg:end))
    allocate(ccf%frootc_to_litr3c(beg:end))
    allocate(ccf%cwdc_to_litr2c(beg:end))
    allocate(ccf%cwdc_to_litr3c(beg:end))
    allocate(ccf%litr1_hr(beg:end))
    allocate(ccf%litr1c_to_soil1c(beg:end))
    allocate(ccf%litr2_hr(beg:end))
    allocate(ccf%litr2c_to_soil2c(beg:end))
    allocate(ccf%litr3_hr(beg:end))
    allocate(ccf%litr3c_to_soil3c(beg:end))
    allocate(ccf%soil1_hr(beg:end))
    allocate(ccf%soil1c_to_soil2c(beg:end))
    allocate(ccf%soil2_hr(beg:end))
    allocate(ccf%soil2c_to_soil3c(beg:end))
    allocate(ccf%soil3_hr(beg:end))
    allocate(ccf%soil3c_to_soil4c(beg:end))
    allocate(ccf%soil4_hr(beg:end))
#ifdef CN
    allocate(ccf%dwt_seedc_to_leaf(beg:end))
    allocate(ccf%dwt_seedc_to_deadstem(beg:end))
    allocate(ccf%dwt_conv_cflux(beg:end))
    allocate(ccf%dwt_prod10c_gain(beg:end))
    allocate(ccf%dwt_prod100c_gain(beg:end))
    allocate(ccf%dwt_frootc_to_litr1c(beg:end))
    allocate(ccf%dwt_frootc_to_litr2c(beg:end))
    allocate(ccf%dwt_frootc_to_litr3c(beg:end))
    allocate(ccf%dwt_livecrootc_to_cwdc(beg:end))
    allocate(ccf%dwt_deadcrootc_to_cwdc(beg:end))
    allocate(ccf%dwt_closs(beg:end))
    allocate(ccf%landuseflux(beg:end))
    allocate(ccf%landuptake(beg:end))
    allocate(ccf%prod10c_loss(beg:end))
    allocate(ccf%prod100c_loss(beg:end))
    allocate(ccf%product_closs(beg:end))
#endif
    allocate(ccf%lithr(beg:end))
    allocate(ccf%somhr(beg:end))
    allocate(ccf%hr(beg:end))
    allocate(ccf%sr(beg:end))
    allocate(ccf%er(beg:end))
    allocate(ccf%litfire(beg:end))
    allocate(ccf%somfire(beg:end))
    allocate(ccf%totfire(beg:end))
    allocate(ccf%nep(beg:end))
    allocate(ccf%nbp(beg:end))
    allocate(ccf%nee(beg:end))
    allocate(ccf%col_cinputs(beg:end))
    allocate(ccf%col_coutputs(beg:end))
    allocate(ccf%col_fire_closs(beg:end))

#if (defined CLAMP) && (defined CN)
    !CLAMP
    allocate(ccf%cwdc_hr(beg:end))
    allocate(ccf%cwdc_loss(beg:end))
    allocate(ccf%litterc_loss(beg:end))
#endif

    ccf%m_leafc_to_litr1c(beg:end)                = nan
    ccf%m_leafc_to_litr2c(beg:end)                = nan
    ccf%m_leafc_to_litr3c(beg:end)                = nan
    ccf%m_frootc_to_litr1c(beg:end)               = nan
    ccf%m_frootc_to_litr2c(beg:end)               = nan
    ccf%m_frootc_to_litr3c(beg:end)               = nan
    ccf%m_leafc_storage_to_litr1c(beg:end)        = nan
    ccf%m_frootc_storage_to_litr1c(beg:end)       = nan
    ccf%m_livestemc_storage_to_litr1c(beg:end)    = nan
    ccf%m_deadstemc_storage_to_litr1c(beg:end)    = nan
    ccf%m_livecrootc_storage_to_litr1c(beg:end)   = nan
    ccf%m_deadcrootc_storage_to_litr1c(beg:end)   = nan
    ccf%m_leafc_xfer_to_litr1c(beg:end)           = nan
    ccf%m_frootc_xfer_to_litr1c(beg:end)          = nan
    ccf%m_livestemc_xfer_to_litr1c(beg:end)       = nan
    ccf%m_deadstemc_xfer_to_litr1c(beg:end)       = nan
    ccf%m_livecrootc_xfer_to_litr1c(beg:end)      = nan
    ccf%m_deadcrootc_xfer_to_litr1c(beg:end)      = nan
    ccf%m_livestemc_to_cwdc(beg:end)              = nan
    ccf%m_deadstemc_to_cwdc(beg:end)              = nan
    ccf%m_livecrootc_to_cwdc(beg:end)             = nan
    ccf%m_deadcrootc_to_cwdc(beg:end)             = nan
    ccf%m_gresp_storage_to_litr1c(beg:end)        = nan
    ccf%m_gresp_xfer_to_litr1c(beg:end)           = nan
    ccf%m_deadstemc_to_cwdc_fire(beg:end)         = nan
    ccf%m_deadcrootc_to_cwdc_fire(beg:end)        = nan
    ccf%hrv_leafc_to_litr1c(beg:end)              = nan             
    ccf%hrv_leafc_to_litr2c(beg:end)              = nan             
    ccf%hrv_leafc_to_litr3c(beg:end)              = nan             
    ccf%hrv_frootc_to_litr1c(beg:end)             = nan            
    ccf%hrv_frootc_to_litr2c(beg:end)             = nan            
    ccf%hrv_frootc_to_litr3c(beg:end)             = nan            
    ccf%hrv_livestemc_to_cwdc(beg:end)            = nan           
    ccf%hrv_deadstemc_to_prod10c(beg:end)         = nan        
    ccf%hrv_deadstemc_to_prod100c(beg:end)        = nan       
    ccf%hrv_livecrootc_to_cwdc(beg:end)           = nan          
    ccf%hrv_deadcrootc_to_cwdc(beg:end)           = nan          
    ccf%hrv_leafc_storage_to_litr1c(beg:end)      = nan     
    ccf%hrv_frootc_storage_to_litr1c(beg:end)     = nan    
    ccf%hrv_livestemc_storage_to_litr1c(beg:end)  = nan 
    ccf%hrv_deadstemc_storage_to_litr1c(beg:end)  = nan 
    ccf%hrv_livecrootc_storage_to_litr1c(beg:end) = nan
    ccf%hrv_deadcrootc_storage_to_litr1c(beg:end) = nan
#if (defined CROP)
    ccf%grainc_to_litr1c(beg:end) = nan
    ccf%grainc_to_litr2c(beg:end) = nan
    ccf%grainc_to_litr3c(beg:end) = nan
    ccf%livestemc_to_litr1c(beg:end) = nan
    ccf%livestemc_to_litr2c(beg:end) = nan
    ccf%livestemc_to_litr3c(beg:end) = nan
#endif
    ccf%hrv_gresp_storage_to_litr1c(beg:end)      = nan     
    ccf%hrv_leafc_xfer_to_litr1c(beg:end)         = nan        
    ccf%hrv_frootc_xfer_to_litr1c(beg:end)        = nan       
    ccf%hrv_livestemc_xfer_to_litr1c(beg:end)     = nan    
    ccf%hrv_deadstemc_xfer_to_litr1c(beg:end)     = nan    
    ccf%hrv_livecrootc_xfer_to_litr1c(beg:end)    = nan   
    ccf%hrv_deadcrootc_xfer_to_litr1c(beg:end)    = nan   
    ccf%hrv_gresp_xfer_to_litr1c(beg:end)         = nan        
    ccf%m_litr1c_to_fire(beg:end)                 = nan
    ccf%m_litr2c_to_fire(beg:end)                 = nan
    ccf%m_litr3c_to_fire(beg:end)                 = nan
    ccf%m_cwdc_to_fire(beg:end)                   = nan
    ccf%leafc_to_litr1c(beg:end)                  = nan
    ccf%leafc_to_litr2c(beg:end)                  = nan
    ccf%leafc_to_litr3c(beg:end)                  = nan
    ccf%frootc_to_litr1c(beg:end)                 = nan
    ccf%frootc_to_litr2c(beg:end)                 = nan
    ccf%frootc_to_litr3c(beg:end)                 = nan
    ccf%cwdc_to_litr2c(beg:end)                   = nan
    ccf%cwdc_to_litr3c(beg:end)                   = nan
    ccf%litr1_hr(beg:end)                         = nan
    ccf%litr1c_to_soil1c(beg:end)                 = nan
    ccf%litr2_hr(beg:end)                         = nan
    ccf%litr2c_to_soil2c(beg:end)                 = nan
    ccf%litr3_hr(beg:end)                         = nan
    ccf%litr3c_to_soil3c(beg:end)                 = nan
    ccf%soil1_hr(beg:end)                         = nan
    ccf%soil1c_to_soil2c(beg:end)                 = nan
    ccf%soil2_hr(beg:end)                         = nan
    ccf%soil2c_to_soil3c(beg:end)                 = nan
    ccf%soil3_hr(beg:end)                         = nan
    ccf%soil3c_to_soil4c(beg:end)                 = nan
    ccf%soil4_hr(beg:end)                         = nan
#if (defined CN)
    ccf%dwt_seedc_to_leaf(beg:end)                = nan
    ccf%dwt_seedc_to_deadstem(beg:end)            = nan
    ccf%dwt_conv_cflux(beg:end)                   = nan
    ccf%dwt_prod10c_gain(beg:end)                 = nan
    ccf%dwt_prod100c_gain(beg:end)                = nan
    ccf%dwt_frootc_to_litr1c(beg:end)             = nan
    ccf%dwt_frootc_to_litr2c(beg:end)             = nan
    ccf%dwt_frootc_to_litr3c(beg:end)             = nan
    ccf%dwt_livecrootc_to_cwdc(beg:end)           = nan
    ccf%dwt_deadcrootc_to_cwdc(beg:end)           = nan
    ccf%dwt_closs(beg:end)                        = nan
    ccf%landuseflux(beg:end)                      = nan
    ccf%landuptake(beg:end)                       = nan
    ccf%prod10c_loss(beg:end)                     = nan
    ccf%prod100c_loss(beg:end)                    = nan
    ccf%product_closs(beg:end)                    = nan
#endif
    ccf%lithr(beg:end)                            = nan
    ccf%somhr(beg:end)                            = nan
    ccf%hr(beg:end)                               = nan
    ccf%sr(beg:end)                               = nan
    ccf%er(beg:end)                               = nan
    ccf%litfire(beg:end)                          = nan
    ccf%somfire(beg:end)                          = nan
    ccf%totfire(beg:end)                          = nan
    ccf%nep(beg:end)                              = nan
    ccf%nbp(beg:end)                              = nan
    ccf%nee(beg:end)                              = nan
    ccf%col_cinputs(beg:end)                      = nan
    ccf%col_coutputs(beg:end)                     = nan
    ccf%col_fire_closs(beg:end)                   = nan

#if (defined CLAMP) && (defined CN)
    !CLAMP
    ccf%cwdc_hr(beg:end)                          = nan
    ccf%cwdc_loss(beg:end)                        = nan
    ccf%litterc_loss(beg:end)                     = nan
#endif

  end subroutine init_column_cflux_type

!------------------------------------------------------------------------
!BOP
!
! !IROUTINE: init_column_nflux_type
!
! !INTERFACE:
  subroutine init_column_nflux_type(beg, end, cnf)
!
! !DESCRIPTION:
! Initialize column nitrogen flux variables
!
! !ARGUMENTS:
    implicit none
    integer, intent(in) :: beg, end
    type (column_nflux_type), intent(inout):: cnf
!
! !REVISION HISTORY:
! Created by Peter Thornton
!
!EOP
!------------------------------------------------------------------------

    allocate(cnf%ndep_to_sminn(beg:end))
    allocate(cnf%nfix_to_sminn(beg:end))
    allocate(cnf%m_leafn_to_litr1n(beg:end))
    allocate(cnf%m_leafn_to_litr2n(beg:end))
    allocate(cnf%m_leafn_to_litr3n(beg:end))
    allocate(cnf%m_frootn_to_litr1n(beg:end))
    allocate(cnf%m_frootn_to_litr2n(beg:end))
    allocate(cnf%m_frootn_to_litr3n(beg:end))
    allocate(cnf%m_leafn_storage_to_litr1n(beg:end))
    allocate(cnf%m_frootn_storage_to_litr1n(beg:end))
    allocate(cnf%m_livestemn_storage_to_litr1n(beg:end))
    allocate(cnf%m_deadstemn_storage_to_litr1n(beg:end))
    allocate(cnf%m_livecrootn_storage_to_litr1n(beg:end))
    allocate(cnf%m_deadcrootn_storage_to_litr1n(beg:end))
    allocate(cnf%m_leafn_xfer_to_litr1n(beg:end))
    allocate(cnf%m_frootn_xfer_to_litr1n(beg:end))
    allocate(cnf%m_livestemn_xfer_to_litr1n(beg:end))
    allocate(cnf%m_deadstemn_xfer_to_litr1n(beg:end))
    allocate(cnf%m_livecrootn_xfer_to_litr1n(beg:end))
    allocate(cnf%m_deadcrootn_xfer_to_litr1n(beg:end))
    allocate(cnf%m_livestemn_to_cwdn(beg:end))
    allocate(cnf%m_deadstemn_to_cwdn(beg:end))
    allocate(cnf%m_livecrootn_to_cwdn(beg:end))
    allocate(cnf%m_deadcrootn_to_cwdn(beg:end))
    allocate(cnf%m_retransn_to_litr1n(beg:end))
    allocate(cnf%hrv_leafn_to_litr1n(beg:end))             
    allocate(cnf%hrv_leafn_to_litr2n(beg:end))             
    allocate(cnf%hrv_leafn_to_litr3n(beg:end))             
    allocate(cnf%hrv_frootn_to_litr1n(beg:end))            
    allocate(cnf%hrv_frootn_to_litr2n(beg:end))            
    allocate(cnf%hrv_frootn_to_litr3n(beg:end))            
    allocate(cnf%hrv_livestemn_to_cwdn(beg:end))           
    allocate(cnf%hrv_deadstemn_to_prod10n(beg:end))        
    allocate(cnf%hrv_deadstemn_to_prod100n(beg:end))       
    allocate(cnf%hrv_livecrootn_to_cwdn(beg:end))          
    allocate(cnf%hrv_deadcrootn_to_cwdn(beg:end))          
    allocate(cnf%hrv_retransn_to_litr1n(beg:end))          
    allocate(cnf%hrv_leafn_storage_to_litr1n(beg:end))     
    allocate(cnf%hrv_frootn_storage_to_litr1n(beg:end))    
    allocate(cnf%hrv_livestemn_storage_to_litr1n(beg:end)) 
    allocate(cnf%hrv_deadstemn_storage_to_litr1n(beg:end)) 
    allocate(cnf%hrv_livecrootn_storage_to_litr1n(beg:end))
    allocate(cnf%hrv_deadcrootn_storage_to_litr1n(beg:end))
    allocate(cnf%hrv_leafn_xfer_to_litr1n(beg:end))        
    allocate(cnf%hrv_frootn_xfer_to_litr1n(beg:end))       
    allocate(cnf%hrv_livestemn_xfer_to_litr1n(beg:end))    
    allocate(cnf%hrv_deadstemn_xfer_to_litr1n(beg:end))    
    allocate(cnf%hrv_livecrootn_xfer_to_litr1n(beg:end))   
    allocate(cnf%hrv_deadcrootn_xfer_to_litr1n(beg:end))   
    allocate(cnf%m_deadstemn_to_cwdn_fire(beg:end))
    allocate(cnf%m_deadcrootn_to_cwdn_fire(beg:end))
    allocate(cnf%m_litr1n_to_fire(beg:end))
    allocate(cnf%m_litr2n_to_fire(beg:end))
    allocate(cnf%m_litr3n_to_fire(beg:end))
    allocate(cnf%m_cwdn_to_fire(beg:end))
#if (defined CROP)
    allocate(cnf%grainn_to_litr1n(beg:end))
    allocate(cnf%grainn_to_litr2n(beg:end))
    allocate(cnf%grainn_to_litr3n(beg:end))
    allocate(cnf%livestemn_to_litr1n(beg:end))
    allocate(cnf%livestemn_to_litr2n(beg:end))
    allocate(cnf%livestemn_to_litr3n(beg:end))
#endif
    allocate(cnf%leafn_to_litr1n(beg:end))
    allocate(cnf%leafn_to_litr2n(beg:end))
    allocate(cnf%leafn_to_litr3n(beg:end))
    allocate(cnf%frootn_to_litr1n(beg:end))
    allocate(cnf%frootn_to_litr2n(beg:end))
    allocate(cnf%frootn_to_litr3n(beg:end))
    allocate(cnf%cwdn_to_litr2n(beg:end))
    allocate(cnf%cwdn_to_litr3n(beg:end))
    allocate(cnf%litr1n_to_soil1n(beg:end))
    allocate(cnf%sminn_to_soil1n_l1(beg:end))
    allocate(cnf%litr2n_to_soil2n(beg:end))
    allocate(cnf%sminn_to_soil2n_l2(beg:end))
    allocate(cnf%litr3n_to_soil3n(beg:end))
    allocate(cnf%sminn_to_soil3n_l3(beg:end))
    allocate(cnf%soil1n_to_soil2n(beg:end))
    allocate(cnf%sminn_to_soil2n_s1(beg:end))
    allocate(cnf%soil2n_to_soil3n(beg:end))
    allocate(cnf%sminn_to_soil3n_s2(beg:end))
    allocate(cnf%soil3n_to_soil4n(beg:end))
    allocate(cnf%sminn_to_soil4n_s3(beg:end))
    allocate(cnf%soil4n_to_sminn(beg:end))
    allocate(cnf%sminn_to_denit_l1s1(beg:end))
    allocate(cnf%sminn_to_denit_l2s2(beg:end))
    allocate(cnf%sminn_to_denit_l3s3(beg:end))
    allocate(cnf%sminn_to_denit_s1s2(beg:end))
    allocate(cnf%sminn_to_denit_s2s3(beg:end))
    allocate(cnf%sminn_to_denit_s3s4(beg:end))
    allocate(cnf%sminn_to_denit_s4(beg:end))
    allocate(cnf%sminn_to_denit_excess(beg:end))
    allocate(cnf%sminn_leached(beg:end))
    allocate(cnf%dwt_seedn_to_leaf(beg:end))
    allocate(cnf%dwt_seedn_to_deadstem(beg:end))
    allocate(cnf%dwt_conv_nflux(beg:end))
    allocate(cnf%dwt_prod10n_gain(beg:end))
    allocate(cnf%dwt_prod100n_gain(beg:end))
    allocate(cnf%dwt_frootn_to_litr1n(beg:end))
    allocate(cnf%dwt_frootn_to_litr2n(beg:end))
    allocate(cnf%dwt_frootn_to_litr3n(beg:end))
    allocate(cnf%dwt_livecrootn_to_cwdn(beg:end))
    allocate(cnf%dwt_deadcrootn_to_cwdn(beg:end))
    allocate(cnf%dwt_nloss(beg:end))
    allocate(cnf%prod10n_loss(beg:end))
    allocate(cnf%prod100n_loss(beg:end))
    allocate(cnf%product_nloss(beg:end))
    allocate(cnf%potential_immob(beg:end))
    allocate(cnf%actual_immob(beg:end))
    allocate(cnf%sminn_to_plant(beg:end))
    allocate(cnf%supplement_to_sminn(beg:end))
    allocate(cnf%gross_nmin(beg:end))
    allocate(cnf%net_nmin(beg:end))
    allocate(cnf%denit(beg:end))
    allocate(cnf%col_ninputs(beg:end))
    allocate(cnf%col_noutputs(beg:end))
    allocate(cnf%col_fire_nloss(beg:end))

    cnf%ndep_to_sminn(beg:end) = nan
    cnf%nfix_to_sminn(beg:end) = nan
    cnf%m_leafn_to_litr1n(beg:end) = nan
    cnf%m_leafn_to_litr2n(beg:end) = nan
    cnf%m_leafn_to_litr3n(beg:end) = nan
    cnf%m_frootn_to_litr1n(beg:end) = nan
    cnf%m_frootn_to_litr2n(beg:end) = nan
    cnf%m_frootn_to_litr3n(beg:end) = nan
    cnf%m_leafn_storage_to_litr1n(beg:end) = nan
    cnf%m_frootn_storage_to_litr1n(beg:end) = nan
    cnf%m_livestemn_storage_to_litr1n(beg:end) = nan
    cnf%m_deadstemn_storage_to_litr1n(beg:end) = nan
    cnf%m_livecrootn_storage_to_litr1n(beg:end) = nan
    cnf%m_deadcrootn_storage_to_litr1n(beg:end) = nan
    cnf%m_leafn_xfer_to_litr1n(beg:end) = nan
    cnf%m_frootn_xfer_to_litr1n(beg:end) = nan
    cnf%m_livestemn_xfer_to_litr1n(beg:end) = nan
    cnf%m_deadstemn_xfer_to_litr1n(beg:end) = nan
    cnf%m_livecrootn_xfer_to_litr1n(beg:end) = nan
    cnf%m_deadcrootn_xfer_to_litr1n(beg:end) = nan
    cnf%m_livestemn_to_cwdn(beg:end) = nan
    cnf%m_deadstemn_to_cwdn(beg:end) = nan
    cnf%m_livecrootn_to_cwdn(beg:end) = nan
    cnf%m_deadcrootn_to_cwdn(beg:end) = nan
    cnf%m_retransn_to_litr1n(beg:end) = nan
    cnf%hrv_leafn_to_litr1n(beg:end) = nan             
    cnf%hrv_leafn_to_litr2n(beg:end) = nan             
    cnf%hrv_leafn_to_litr3n(beg:end) = nan             
    cnf%hrv_frootn_to_litr1n(beg:end) = nan            
    cnf%hrv_frootn_to_litr2n(beg:end) = nan            
    cnf%hrv_frootn_to_litr3n(beg:end) = nan            
    cnf%hrv_livestemn_to_cwdn(beg:end) = nan           
    cnf%hrv_deadstemn_to_prod10n(beg:end) = nan        
    cnf%hrv_deadstemn_to_prod100n(beg:end) = nan       
    cnf%hrv_livecrootn_to_cwdn(beg:end) = nan          
    cnf%hrv_deadcrootn_to_cwdn(beg:end) = nan          
    cnf%hrv_retransn_to_litr1n(beg:end) = nan          
    cnf%hrv_leafn_storage_to_litr1n(beg:end) = nan     
    cnf%hrv_frootn_storage_to_litr1n(beg:end) = nan    
    cnf%hrv_livestemn_storage_to_litr1n(beg:end) = nan 
    cnf%hrv_deadstemn_storage_to_litr1n(beg:end) = nan 
    cnf%hrv_livecrootn_storage_to_litr1n(beg:end) = nan
    cnf%hrv_deadcrootn_storage_to_litr1n(beg:end) = nan
    cnf%hrv_leafn_xfer_to_litr1n(beg:end) = nan        
    cnf%hrv_frootn_xfer_to_litr1n(beg:end) = nan       
    cnf%hrv_livestemn_xfer_to_litr1n(beg:end) = nan    
    cnf%hrv_deadstemn_xfer_to_litr1n(beg:end) = nan    
    cnf%hrv_livecrootn_xfer_to_litr1n(beg:end) = nan   
    cnf%hrv_deadcrootn_xfer_to_litr1n(beg:end) = nan   
    cnf%m_deadstemn_to_cwdn_fire(beg:end) = nan
    cnf%m_deadcrootn_to_cwdn_fire(beg:end) = nan
    cnf%m_litr1n_to_fire(beg:end) = nan
    cnf%m_litr2n_to_fire(beg:end) = nan
    cnf%m_litr3n_to_fire(beg:end) = nan
    cnf%m_cwdn_to_fire(beg:end) = nan
#if (defined CROP)
    cnf%grainn_to_litr1n(beg:end) = nan
    cnf%grainn_to_litr2n(beg:end) = nan
    cnf%grainn_to_litr3n(beg:end) = nan
    cnf%livestemn_to_litr1n(beg:end) = nan
    cnf%livestemn_to_litr2n(beg:end) = nan
    cnf%livestemn_to_litr3n(beg:end) = nan
#endif
    cnf%leafn_to_litr1n(beg:end) = nan
    cnf%leafn_to_litr2n(beg:end) = nan
    cnf%leafn_to_litr3n(beg:end) = nan
    cnf%frootn_to_litr1n(beg:end) = nan
    cnf%frootn_to_litr2n(beg:end) = nan
    cnf%frootn_to_litr3n(beg:end) = nan
    cnf%cwdn_to_litr2n(beg:end) = nan
    cnf%cwdn_to_litr3n(beg:end) = nan
    cnf%litr1n_to_soil1n(beg:end) = nan
    cnf%sminn_to_soil1n_l1(beg:end) = nan
    cnf%litr2n_to_soil2n(beg:end) = nan
    cnf%sminn_to_soil2n_l2(beg:end) = nan
    cnf%litr3n_to_soil3n(beg:end) = nan
    cnf%sminn_to_soil3n_l3(beg:end) = nan
    cnf%soil1n_to_soil2n(beg:end) = nan
    cnf%sminn_to_soil2n_s1(beg:end) = nan
    cnf%soil2n_to_soil3n(beg:end) = nan
    cnf%sminn_to_soil3n_s2(beg:end) = nan
    cnf%soil3n_to_soil4n(beg:end) = nan
    cnf%sminn_to_soil4n_s3(beg:end) = nan
    cnf%soil4n_to_sminn(beg:end) = nan
    cnf%sminn_to_denit_l1s1(beg:end) = nan
    cnf%sminn_to_denit_l2s2(beg:end) = nan
    cnf%sminn_to_denit_l3s3(beg:end) = nan
    cnf%sminn_to_denit_s1s2(beg:end) = nan
    cnf%sminn_to_denit_s2s3(beg:end) = nan
    cnf%sminn_to_denit_s3s4(beg:end) = nan
    cnf%sminn_to_denit_s4(beg:end) = nan
    cnf%sminn_to_denit_excess(beg:end) = nan
    cnf%sminn_leached(beg:end) = nan
    cnf%dwt_seedn_to_leaf(beg:end) = nan
    cnf%dwt_seedn_to_deadstem(beg:end) = nan
    cnf%dwt_conv_nflux(beg:end) = nan
    cnf%dwt_prod10n_gain(beg:end) = nan
    cnf%dwt_prod100n_gain(beg:end) = nan
    cnf%dwt_frootn_to_litr1n(beg:end) = nan
    cnf%dwt_frootn_to_litr2n(beg:end) = nan
    cnf%dwt_frootn_to_litr3n(beg:end) = nan
    cnf%dwt_livecrootn_to_cwdn(beg:end) = nan
    cnf%dwt_deadcrootn_to_cwdn(beg:end) = nan
    cnf%dwt_nloss(beg:end) = nan
    cnf%prod10n_loss(beg:end) = nan
    cnf%prod100n_loss(beg:end) = nan
    cnf%product_nloss(beg:end) = nan
    cnf%potential_immob(beg:end) = nan
    cnf%actual_immob(beg:end) = nan
    cnf%sminn_to_plant(beg:end) = nan
    cnf%supplement_to_sminn(beg:end) = nan
    cnf%gross_nmin(beg:end) = nan
    cnf%net_nmin(beg:end) = nan
    cnf%denit(beg:end) = nan
    cnf%col_ninputs(beg:end) = nan
    cnf%col_noutputs(beg:end) = nan
    cnf%col_fire_nloss(beg:end) = nan

  end subroutine init_column_nflux_type

!------------------------------------------------------------------------
!BOP
!
! !IROUTINE: init_landunit_pstate_type
!
! !INTERFACE:
  subroutine init_landunit_pstate_type(beg, end, lps)
!
! !DESCRIPTION:
! Initialize landunit physical state variables
!
! !ARGUMENTS:
    implicit none
    integer, intent(in) :: beg, end
    type (landunit_pstate_type), intent(inout):: lps
!
! !REVISION HISTORY:
! Created by Mariana Vertenstein
!
!EOP
!------------------------------------------------------------------------

    allocate(lps%t_building(beg:end))
    allocate(lps%t_building_max(beg:end))
    allocate(lps%t_building_min(beg:end))
    allocate(lps%tk_wall(beg:end,nlevurb))
    allocate(lps%tk_roof(beg:end,nlevurb))
    allocate(lps%tk_improad(beg:end,nlevgrnd))
    allocate(lps%cv_wall(beg:end,nlevurb))
    allocate(lps%cv_roof(beg:end,nlevurb))
    allocate(lps%cv_improad(beg:end,nlevgrnd))
    allocate(lps%thick_wall(beg:end))
    allocate(lps%thick_roof(beg:end))
    allocate(lps%nlev_improad(beg:end))
    allocate(lps%vf_sr(beg:end))
    allocate(lps%vf_wr(beg:end))
    allocate(lps%vf_sw(beg:end))
    allocate(lps%vf_rw(beg:end))
    allocate(lps%vf_ww(beg:end))
    allocate(lps%taf(beg:end))
    allocate(lps%qaf(beg:end))
    allocate(lps%sabs_roof_dir(beg:end,1:numrad))
    allocate(lps%sabs_roof_dif(beg:end,1:numrad))
    allocate(lps%sabs_sunwall_dir(beg:end,1:numrad))
    allocate(lps%sabs_sunwall_dif(beg:end,1:numrad))
    allocate(lps%sabs_shadewall_dir(beg:end,1:numrad))
    allocate(lps%sabs_shadewall_dif(beg:end,1:numrad))
    allocate(lps%sabs_improad_dir(beg:end,1:numrad))
    allocate(lps%sabs_improad_dif(beg:end,1:numrad))
    allocate(lps%sabs_perroad_dir(beg:end,1:numrad))
    allocate(lps%sabs_perroad_dif(beg:end,1:numrad))

    lps%t_building(beg:end) = nan
    lps%t_building_max(beg:end) = nan
    lps%t_building_min(beg:end) = nan
    lps%tk_wall(beg:end,1:nlevurb) = nan
    lps%tk_roof(beg:end,1:nlevurb) = nan
    lps%tk_improad(beg:end,1:nlevgrnd) = nan
    lps%cv_wall(beg:end,1:nlevurb) = nan
    lps%cv_roof(beg:end,1:nlevurb) = nan
    lps%cv_improad(beg:end,1:nlevgrnd) = nan
    lps%cv_improad(beg:end,1:5) = nan
    lps%thick_wall(beg:end) = nan
    lps%thick_roof(beg:end) = nan
    lps%nlev_improad(beg:end) = bigint
    lps%vf_sr(beg:end) = nan
    lps%vf_wr(beg:end) = nan
    lps%vf_sw(beg:end) = nan
    lps%vf_rw(beg:end) = nan
    lps%vf_ww(beg:end) = nan
    lps%taf(beg:end) = nan
    lps%qaf(beg:end) = nan
    lps%sabs_roof_dir(beg:end,1:numrad) = nan
    lps%sabs_roof_dif(beg:end,1:numrad) = nan
    lps%sabs_sunwall_dir(beg:end,1:numrad) = nan
    lps%sabs_sunwall_dif(beg:end,1:numrad) = nan
    lps%sabs_shadewall_dir(beg:end,1:numrad) = nan
    lps%sabs_shadewall_dif(beg:end,1:numrad) = nan
    lps%sabs_improad_dir(beg:end,1:numrad) = nan
    lps%sabs_improad_dif(beg:end,1:numrad) = nan
    lps%sabs_perroad_dir(beg:end,1:numrad) = nan
    lps%sabs_perroad_dif(beg:end,1:numrad) = nan

  end subroutine init_landunit_pstate_type

!------------------------------------------------------------------------
!BOP
!
! !IROUTINE: init_landunit_eflux_type
!
! !INTERFACE:
  subroutine init_landunit_eflux_type(beg, end, lef)
!
! !DESCRIPTION: 
! Initialize landunit energy flux variables
!
! !ARGUMENTS:
    implicit none
    integer, intent(in) :: beg, end 
    type (landunit_eflux_type), intent(inout):: lef 
!
! !REVISION HISTORY:
! Created by Keith Oleson
!
!EOP
!------------------------------------------------------------------------

    allocate(lef%eflx_traffic(beg:end))
    allocate(lef%eflx_traffic_factor(beg:end))
    allocate(lef%eflx_wasteheat(beg:end))
    allocate(lef%eflx_heat_from_ac(beg:end))

    lef%eflx_traffic(beg:end) = nan
    lef%eflx_traffic_factor(beg:end) = nan
    lef%eflx_wasteheat(beg:end) = nan
    lef%eflx_heat_from_ac(beg:end) = nan

  end subroutine init_landunit_eflux_type

#if (defined CNDV)
!------------------------------------------------------------------------
!BOP
!
! !IROUTINE: init_gridcell_dgvstate_type
!
! !INTERFACE:
  subroutine init_gridcell_dgvstate_type(beg, end, gps)
!
! !DESCRIPTION:
! Initialize gridcell DGVM variables
!
! !ARGUMENTS:
    implicit none
    integer, intent(in) :: beg, end
    type (gridcell_dgvstate_type), intent(inout):: gps
!
! !REVISION HISTORY:
! Created by Mariana Vertenstein
!
!EOP
!------------------------------------------------------------------------

    allocate(gps%agdd20(beg:end))
    allocate(gps%tmomin20(beg:end))
    allocate(gps%t10min(beg:end))
    gps%agdd20(beg:end) = nan
    gps%tmomin20(beg:end) = nan
    gps%t10min(beg:end) = nan

  end subroutine init_gridcell_dgvstate_type
#endif

!------------------------------------------------------------------------
!BOP
!
! !IROUTINE: init_gridcell_pstate_type
!
! !INTERFACE:
  subroutine init_gridcell_pstate_type(beg, end, gps)
!
! !DESCRIPTION:
! Initialize gridcell physical state variables
!
! !ARGUMENTS:
    implicit none
    integer, intent(in) :: beg, end
    type (gridcell_pstate_type), intent(inout):: gps
!
! !REVISION HISTORY:
! Created by Mariana Vertenstein
!
!EOP
!------------------------------------------------------------------------
    
    
    !allocate(gps%bcphiwet2t(beg:end,1:2))
    !allocate(gps%bcphidry2t(beg:end,1:2))
    !allocate(gps%bcphodry2t(beg:end,1:2))
    !allocate(gps%ocphiwet2t(beg:end,1:2))
    !allocate(gps%ocphidry2t(beg:end,1:2))
    !allocate(gps%ocphodry2t(beg:end,1:2))
    !allocate(gps%dstx01wd2t(beg:end,1:2))
    !allocate(gps%dstx01dd2t(beg:end,1:2))
    !allocate(gps%dstx02wd2t(beg:end,1:2))
    !allocate(gps%dstx02dd2t(beg:end,1:2))
    !allocate(gps%dstx03wd2t(beg:end,1:2))
    !allocate(gps%dstx03dd2t(beg:end,1:2))
    !allocate(gps%dstx04wd2t(beg:end,1:2))
    !allocate(gps%dstx04dd2t(beg:end,1:2))
    
    !gps%bcphiwet2t(beg:end,1:2) = nan
    !gps%bcphidry2t(beg:end,1:2) = nan
    !gps%bcphodry2t(beg:end,1:2) = nan
    !gps%ocphiwet2t(beg:end,1:2) = nan
    !gps%ocphidry2t(beg:end,1:2) = nan
    !gps%ocphodry2t(beg:end,1:2) = nan
    !gps%dstx01wd2t(beg:end,1:2) = nan
    !gps%dstx01dd2t(beg:end,1:2) = nan
    !gps%dstx02wd2t(beg:end,1:2) = nan
    !gps%dstx02dd2t(beg:end,1:2) = nan
    !gps%dstx03wd2t(beg:end,1:2) = nan
    !gps%dstx03dd2t(beg:end,1:2) = nan
    !gps%dstx04wd2t(beg:end,1:2) = nan
    !gps%dstx04dd2t(beg:end,1:2) = nan

  end subroutine init_gridcell_pstate_type

!------------------------------------------------------------------------
!BOP
!
! !IROUTINE: init_gridcell_efstate_type
!
! !INTERFACE:
  subroutine init_gridcell_efstate_type(beg, end, gve)
!
! !DESCRIPTION:
! Initialize gridcell isoprene emission factor variables
!
! !ARGUMENTS:
    implicit none
    integer, intent(in) :: beg, end
    type (gridcell_efstate_type), intent(inout) :: gve
!
! !REVISION HISTORY:
! Created by Mariana Vertenstein (heald)
!
!EOP
!------------------------------------------------------------------------

    allocate(gve%efisop(6,beg:end))
    gve%efisop(:,beg:end) = nan

  end subroutine init_gridcell_efstate_type

!------------------------------------------------------------------------
!BOP
!
! !IROUTINE: init_gridcell_wflux_type
!
! !INTERFACE:
  subroutine init_gridcell_wflux_type(beg, end, gwf)
!
! !DESCRIPTION:
! Initialize gridcell water flux variables
!
! !ARGUMENTS:
    implicit none
    integer, intent(in) :: beg, end
    type (gridcell_wflux_type), intent(inout):: gwf
!
! !REVISION HISTORY:
! Created by Mariana Vertenstein
!
!EOP
!------------------------------------------------------------------------

    allocate(gwf%qflx_runoffg(beg:end))
    allocate(gwf%qflx_snwcp_iceg(beg:end))
    allocate(gwf%qflx_liq_dynbal(beg:end))
    allocate(gwf%qflx_ice_dynbal(beg:end))

    gwf%qflx_runoffg(beg:end) = nan
    gwf%qflx_snwcp_iceg(beg:end) = nan
    gwf%qflx_liq_dynbal(beg:end) = nan
    gwf%qflx_ice_dynbal(beg:end) = nan

  end subroutine init_gridcell_wflux_type

!------------------------------------------------------------------------
!BOP
!
! !IROUTINE: init_gridcell_eflux_type
!
! !INTERFACE:
  subroutine init_gridcell_eflux_type(beg, end, gef)
!
! !DESCRIPTION:
! Initialize gridcell energy flux variables
!
! !ARGUMENTS:
    implicit none
    integer, intent(in) :: beg, end
    type (gridcell_eflux_type), intent(inout):: gef
!
! !REVISION HISTORY:
! Created by David Lawrence
!
!EOP
!------------------------------------------------------------------------
    allocate(gef%eflx_sh_totg(beg:end))
    allocate(gef%eflx_dynbal(beg:end))

    gef%eflx_sh_totg(beg:end) = nan
    gef%eflx_dynbal(beg:end) = nan

  end subroutine init_gridcell_eflux_type

!------------------------------------------------------------------------
!BOP
!
! !IROUTINE: init_gridcell_wstate_type
!
! !INTERFACE:
  subroutine init_gridcell_wstate_type(beg, end, gws)
!
! !DESCRIPTION:
! Initialize gridcell water state variables
!
! !ARGUMENTS:
    implicit none
    integer, intent(in) :: beg, end
    type (gridcell_wstate_type), intent(inout):: gws
!
! !REVISION HISTORY:
! Created by David Lawrence
!
!EOP
!------------------------------------------------------------------------
    allocate(gws%gc_liq1(beg:end))
    allocate(gws%gc_liq2(beg:end))
    allocate(gws%gc_ice1(beg:end))     
    allocate(gws%gc_ice2(beg:end))    

    gws%gc_liq1(beg:end) = nan
    gws%gc_liq2(beg:end) = nan
    gws%gc_ice1(beg:end) = nan     
    gws%gc_ice2(beg:end) = nan    

  end subroutine init_gridcell_wstate_type

!------------------------------------------------------------------------
!BOP
!
! !IROUTINE: init_gridcell_estate_type
!
! !INTERFACE:
  subroutine init_gridcell_estate_type(beg, end, ges)
!
! !DESCRIPTION:
! Initialize gridcell energy state variables     
!
! !ARGUMENTS:
    implicit none
    integer, intent(in) :: beg, end
    type (gridcell_estate_type), intent(inout):: ges
!
! !REVISION HISTORY:
! Created by David Lawrence
!
!EOP
!------------------------------------------------------------------------
    allocate(ges%gc_heat1(beg:end))     
    allocate(ges%gc_heat2(beg:end))    

    ges%gc_heat1(beg:end) = nan     
    ges%gc_heat2(beg:end) = nan    

  end subroutine init_gridcell_estate_type


! !INTERFACE:
  subroutine init_atm2lnd_type(beg, end, a2l)
!
! !DESCRIPTION:
! Initialize atmospheric variables required by the land
! 
! !ARGUMENTS:
  implicit none
  integer, intent(in) :: beg, end
  type (atm2lnd_type), intent(inout):: a2l
! 
! !REVISION HISTORY:
! Created by Mariana Vertenstein
! Modified by T Craig, 11/01/05 for finemesh project
!
!
! !LOCAL VARIABLES:
!EOP
  real(r8) :: ival   ! initial value
  integer  :: beg_atm, end_atm
!------------------------------------------------------------------------

  allocate(a2l%forc_t(beg:end))
  allocate(a2l%forc_u(beg:end))
  allocate(a2l%forc_v(beg:end))
  allocate(a2l%forc_wind(beg:end))
  allocate(a2l%forc_q(beg:end))
  allocate(a2l%forc_rh(beg:end))
  allocate(a2l%forc_hgt(beg:end))
  allocate(a2l%forc_hgt_u(beg:end))
  allocate(a2l%forc_hgt_t(beg:end))
  allocate(a2l%forc_hgt_q(beg:end))
  allocate(a2l%forc_pbot(beg:end))
  allocate(a2l%forc_th(beg:end))
  allocate(a2l%forc_vp(beg:end))
  allocate(a2l%forc_rho(beg:end))
  allocate(a2l%forc_psrf(beg:end))
  allocate(a2l%forc_pco2(beg:end))
  allocate(a2l%forc_lwrad(beg:end))
  allocate(a2l%forc_solad(beg:end,numrad))
  allocate(a2l%forc_solai(beg:end,numrad))
  allocate(a2l%forc_solar(beg:end))
  allocate(a2l%forc_rain(beg:end))
  allocate(a2l%forc_snow(beg:end))
  allocate(a2l%forc_ndep(beg:end))
  allocate(a2l%rainf(beg:end))
#if (defined C13)
  ! 4/14/05: PET
  ! Adding isotope code
  allocate(a2l%forc_pc13o2(beg:end))
#endif
  allocate(a2l%forc_po2(beg:end))
  allocate(a2l%forc_aer(beg:end,14))

! ival = nan      ! causes core dump in map_maparray, tcx fix
  ival = 0.0_r8

  a2l%forc_t(beg:end) = ival
  a2l%forc_u(beg:end) = ival
  a2l%forc_v(beg:end) = ival
  a2l%forc_wind(beg:end) = ival
  a2l%forc_q(beg:end) = ival
  a2l%forc_rh(beg:end) = ival
  a2l%forc_hgt(beg:end) = ival
  a2l%forc_hgt_u(beg:end) = ival
  a2l%forc_hgt_t(beg:end) = ival
  a2l%forc_hgt_q(beg:end) = ival
  a2l%forc_pbot(beg:end) = ival
  a2l%forc_th(beg:end) = ival
  a2l%forc_vp(beg:end) = ival
  a2l%forc_rho(beg:end) = ival
  a2l%forc_psrf(beg:end) = ival
  a2l%forc_pco2(beg:end) = ival
  a2l%forc_lwrad(beg:end) = ival
  a2l%forc_solad(beg:end,1:numrad) = ival
  a2l%forc_solai(beg:end,1:numrad) = ival
  a2l%forc_solar(beg:end) = ival
  a2l%forc_rain(beg:end) = ival
  a2l%forc_snow(beg:end) = ival
  a2l%forc_ndep(beg:end) = ival
  a2l%rainf(beg:end) = nan
#if (defined C13)
  ! 4/14/05: PET
  ! Adding isotope code
  a2l%forc_pc13o2(beg:end) = ival
#endif
  a2l%forc_po2(beg:end) = ival
  a2l%forc_aer(beg:end,:) = ival

end subroutine init_atm2lnd_type





  subroutine clmtype_dealloc()
!
! !ARGUMENTS:
    implicit none

    call dealloc_pft_type     (    clm3%g%l%c%p)
    call dealloc_column_type  (    clm3%g%l%c)
    call dealloc_landunit_type(    clm3%g%l)
    call dealloc_gridcell_type(    clm3%g)
   ! pft ecophysiological constants
  
    call dealloc_pft_ecophys_constants()
  
#if (defined CNDV)
    ! pft DGVM-specific ecophysiological constants
  
    call dealloc_pft_DGVMecophys_constants()
#endif
  
    ! energy balance structures (all levels)

    call dealloc_energy_balance_type(    clm3%g%l%c%p%pebal)
    call dealloc_energy_balance_type(    clm3%g%l%c%cebal)
    call dealloc_energy_balance_type(    clm3%g%l%lebal)
    call dealloc_energy_balance_type(    clm3%g%gebal)
    call dealloc_energy_balance_type(          clm3%mebal)

    ! water balance structures (all levels)

    call dealloc_water_balance_type(    clm3%g%l%c%p%pwbal)
    call dealloc_water_balance_type(    clm3%g%l%c%cwbal)
    call dealloc_water_balance_type(    clm3%g%l%lwbal)
    call dealloc_water_balance_type(    clm3%g%gwbal)
    call dealloc_water_balance_type(          clm3%mwbal)

    ! carbon balance structures (pft and column levels)

    call dealloc_carbon_balance_type(    clm3%g%l%c%p%pcbal)
    call dealloc_carbon_balance_type(    clm3%g%l%c%ccbal)

    ! nitrogen balance structures (pft and column levels)

    call dealloc_nitrogen_balance_type(    clm3%g%l%c%p%pnbal)
    call dealloc_nitrogen_balance_type(    clm3%g%l%c%cnbal)
    
    ! pft physical state variables at pft level and averaged to the column

    call dealloc_pft_pstate_type(    clm3%g%l%c%p%pps)
    call dealloc_pft_pstate_type(    clm3%g%l%c%cps%pps_a)

    ! pft ecophysiological variables (only at the pft level for now)
    call dealloc_pft_epv_type(    clm3%g%l%c%p%pepv)

#if (defined CNDV) || (defined CROP)
    ! pft DGVM state variables at pft level and averaged to column
    
    call dealloc_pft_pdgvstate_type(    clm3%g%l%c%p%pdgvs)
#endif
#if (defined CNDV)
    call dealloc_pft_pdgvstate_type(    clm3%g%l%c%cdgvs%pdgvs_a)
#endif
    call dealloc_pft_vstate_type(    clm3%g%l%c%p%pvs)
    
    ! pft energy state variables at the pft level and averaged to the column

    call dealloc_pft_estate_type(    clm3%g%l%c%p%pes)
    call dealloc_pft_estate_type(    clm3%g%l%c%ces%pes_a)

    ! pft water state variables at the pft level and averaged to the column

    call dealloc_pft_wstate_type(    clm3%g%l%c%p%pws)
    call dealloc_pft_wstate_type(    clm3%g%l%c%cws%pws_a)
    
    ! pft carbon state variables at the pft level and averaged to the column

    call dealloc_pft_cstate_type(    clm3%g%l%c%p%pcs)
    call dealloc_pft_cstate_type(    clm3%g%l%c%ccs%pcs_a)
#if (defined C13)
    ! 4/14/05: PET
    ! Adding isotope code
    call dealloc_pft_cstate_type(    clm3%g%l%c%p%pc13s)
    call dealloc_pft_cstate_type(    clm3%g%l%c%cc13s%pcs_a)
#endif

    ! pft nitrogen state variables at the pft level and averaged to the column

    call dealloc_pft_nstate_type(    clm3%g%l%c%p%pns)
    call dealloc_pft_nstate_type(    clm3%g%l%c%cns%pns_a)

    ! pft energy flux variables at pft level and averaged to column

    call dealloc_pft_eflux_type(    clm3%g%l%c%p%pef)
    call dealloc_pft_eflux_type(    clm3%g%l%c%cef%pef_a)

    ! pft momentum flux variables at pft level and averaged to the column

    call dealloc_pft_mflux_type(    clm3%g%l%c%p%pmf)
    call dealloc_pft_mflux_type(    clm3%g%l%c%cmf%pmf_a)

    ! pft water flux variables

    call dealloc_pft_wflux_type(    clm3%g%l%c%p%pwf)
    call dealloc_pft_wflux_type(    clm3%g%l%c%cwf%pwf_a)

    ! pft carbon flux variables at pft level and averaged to column

    call dealloc_pft_cflux_type(    clm3%g%l%c%p%pcf)
    call dealloc_pft_cflux_type(    clm3%g%l%c%ccf%pcf_a)
#if (defined C13)
    ! 4/14/05: PET
    ! Adding isotope code
    call dealloc_pft_cflux_type(    clm3%g%l%c%p%pc13f)
    call dealloc_pft_cflux_type(    clm3%g%l%c%cc13f%pcf_a)
#endif

    ! pft nitrogen flux variables at pft level and averaged to column

    call dealloc_pft_nflux_type(    clm3%g%l%c%p%pnf)
    call dealloc_pft_nflux_type(    clm3%g%l%c%cnf%pnf_a)

    ! pft VOC flux variables at pft level and averaged to column

    call dealloc_pft_vflux_type(    clm3%g%l%c%p%pvf)
    call dealloc_pft_vflux_type(    clm3%g%l%c%cvf%pvf_a)

    ! gridcell VOC emission factors (heald, 05/06)

    call dealloc_gridcell_efstate_type(    clm3%g%gve)

    ! pft dust flux variables at pft level and averaged to column

    call dealloc_pft_dflux_type(    clm3%g%l%c%p%pdf)
    call dealloc_pft_dflux_type(    clm3%g%l%c%cdf%pdf_a)

    ! pft dry dep velocity variables at pft level and averaged to column

    call dealloc_pft_depvd_type(    clm3%g%l%c%p%pdd)

    ! column physical state variables at column level and averaged to
    ! the landunit and gridcell and model

    call dealloc_column_pstate_type(    clm3%g%l%c%cps)
    call dealloc_column_pstate_type(    clm3%g%l%lps%cps_a)
    call dealloc_column_pstate_type(    clm3%g%gps%cps_a)
    call dealloc_column_pstate_type(          clm3%mps%cps_a)
    
    ! column energy state variables at column level and averaged to
    ! the landunit and gridcell and model

    call dealloc_column_estate_type(    clm3%g%l%c%ces)
    call dealloc_column_estate_type(    clm3%g%l%les%ces_a)
    call dealloc_column_estate_type(    clm3%g%ges%ces_a)
    call dealloc_column_estate_type(          clm3%mes%ces_a)
    
    ! column water state variables at column level and averaged to
    ! the landunit and gridcell and model

    call dealloc_column_wstate_type(    clm3%g%l%c%cws)
    call dealloc_column_wstate_type(    clm3%g%l%lws%cws_a)
    call dealloc_column_wstate_type(    clm3%g%gws%cws_a)
    call dealloc_column_wstate_type(          clm3%mws%cws_a)

    ! column carbon state variables at column level and averaged to
    ! the landunit and gridcell and model

    call dealloc_column_cstate_type(    clm3%g%l%c%ccs)
    call dealloc_column_cstate_type(    clm3%g%l%lcs%ccs_a)
    call dealloc_column_cstate_type(    clm3%g%gcs%ccs_a)
    call dealloc_column_cstate_type(          clm3%mcs%ccs_a)
#if (defined C13)
    ! 4/14/05: PET
    ! Adding isotope code
    call dealloc_column_cstate_type(    clm3%g%l%c%cc13s)
#endif

    ! column nitrogen state variables at column level and averaged to
    ! the landunit and gridcell and model
    
    call dealloc_column_nstate_type(    clm3%g%l%c%cns)
    call dealloc_column_nstate_type(    clm3%g%l%lns%cns_a)
    call dealloc_column_nstate_type(    clm3%g%gns%cns_a)
    call dealloc_column_nstate_type(          clm3%mns%cns_a)

    ! column energy flux variables at column level and averaged to
    ! the landunit and gridcell and model

    call dealloc_column_eflux_type(    clm3%g%l%c%cef)
    call dealloc_column_eflux_type(    clm3%g%l%lef%cef_a)
    call dealloc_column_eflux_type(    clm3%g%gef%cef_a)
    call dealloc_column_eflux_type(          clm3%mef%cef_a)

    ! column water flux variables at column level and averaged to
    ! landunit, gridcell and model level

    call dealloc_column_wflux_type(    clm3%g%l%c%cwf)
    call dealloc_column_wflux_type(    clm3%g%l%lwf%cwf_a)
    call dealloc_column_wflux_type(    clm3%g%gwf%cwf_a)
    call dealloc_column_wflux_type(          clm3%mwf%cwf_a)
    
    ! column carbon flux variables at column level

    call dealloc_column_cflux_type(    clm3%g%l%c%ccf)
#if (defined C13)
    ! 4/14/05: PET
    ! Adding isotope code
    call dealloc_column_cflux_type(    clm3%g%l%c%cc13f)
#endif

    ! column nitrogen flux variables at column level

    call dealloc_column_nflux_type(    clm3%g%l%c%cnf)

    ! land unit physical state variables

    call dealloc_landunit_pstate_type(    clm3%g%l%lps)
   call CLMDebug('mark1')
    ! land unit energy flux variables 

    call dealloc_landunit_eflux_type(    clm3%g%l%lef)

#if (defined CNDV)
    ! gridcell DGVM variables

    call dealloc_gridcell_dgvstate_type(    clm3%g%gdgvs)
#endif

    ! gridcell physical state variables

    call dealloc_gridcell_pstate_type(    clm3%g%gps)

    ! gridcell: water flux variables

    call dealloc_gridcell_wflux_type(    clm3%g%gwf)

    ! gridcell: energy flux variables

    call dealloc_gridcell_eflux_type(    clm3%g%gef)

       call CLMDebug('mark2')

    ! gridcell: water state variables

    call dealloc_gridcell_wstate_type(    clm3%g%gws)

    ! gridcell: energy state variables

    call dealloc_gridcell_estate_type(    clm3%g%ges)

     call CLMDebug('mark3')

    call dealloc_atm2lnd_type  ( clm_a2l)

     call CLMDebug('done clmtype_dealloc')

end subroutine clmtype_dealloc


!------------------------------------------------------------------------
!BOP
!
! !IROUTINE: dealloc_pft_type
!
! !INTERFACE:
  subroutine dealloc_pft_type (    p)
!
    implicit none
    type(pft_type), intent(inout):: p

    deallocate(p%gridcell ,p%wtgcell )
    deallocate(p%landunit ,p%wtlunit )
    deallocate(p%column   ,p%wtcol   )

    deallocate(p%itype )
    deallocate(p%mxy )
    deallocate(p%area)

  end subroutine dealloc_pft_type

! !IROUTINE: dealloc_column_type
!
! !INTERFACE:
  subroutine dealloc_column_type (    c)
!
  implicit none
! !REVISION HISTORY:
! Created by Mariana Vertenstein
!
!EOP
!------------------------------------------------------------------------
    type(column_type), intent(inout):: c

   deallocate(c%gridcell ,c%wtgcell )
   deallocate(c%landunit ,c%wtlunit )    

   deallocate(c%pfti ,c%pftf ,c%npfts )

   deallocate(c%itype )

   deallocate(c%area)

  end subroutine dealloc_column_type

!------------------------------------------------------------------------
!BOP
! 
! !IROUTINE: dealloc_landunit_type
!
! !INTERFACE:
  subroutine dealloc_landunit_type (   l)
!
! !DESCRIPTION:
! Initialize components of landunit_type structure
! 
! !ARGUMENTS:
    implicit none
    type(landunit_type), intent(inout):: l
!
! !REVISION HISTORY:
! Created by Mariana Vertenstein
!   
!EOP
!------------------------------------------------------------------------

   deallocate(l%gridcell ,l%wtgcell )

   deallocate(l%coli ,l%colf ,l%ncolumns )
   deallocate(l%pfti ,l%pftf ,l%npfts    )

   deallocate(l%itype )
   deallocate(l%ifspecial )
   deallocate(l%lakpoi )
   deallocate(l%urbpoi )

   ! MV - these should be moved to landunit physical state -MV
   deallocate(l%canyon_hwr )
   deallocate(l%wtroad_perv )
   deallocate(l%ht_roof )
   deallocate(l%wtlunit_roof )
   deallocate(l%wind_hgt_canyon )
   deallocate(l%z_0_town )
   deallocate(l%z_d_town )

   deallocate(l%area)


  end subroutine dealloc_landunit_type

!------------------------------------------------------------------------
!BOP
!
! !IROUTINE: dealloc_gridcell_type
!
! !INTERFACE:
  subroutine dealloc_gridcell_type (   g)
!
! !DESCRIPTION:
! Initialize components of gridcell_type structure
!
! !ARGUMENTS:
    implicit none
    type(gridcell_type), intent(inout):: g
!
! !REVISION HISTORY:
! Created by Mariana Vertenstein
!
!EOP
!------------------------------------------------------------------------

   deallocate(g%luni ,g%lunf ,g%nlandunits )
   deallocate(g%coli ,g%colf ,g%ncolumns   )
   deallocate(g%pfti ,g%pftf ,g%npfts      )

   deallocate(g%gindex )
   deallocate(g%area )
   deallocate(g%lat )
   deallocate(g%lon )
   deallocate(g%latdeg )
   deallocate(g%londeg )
   deallocate(g%gindex_a )
   deallocate(g%lat_a )
   deallocate(g%lon_a )
   deallocate(g%latdeg_a )
   deallocate(g%londeg_a )

  end subroutine dealloc_gridcell_type

!------------------------------------------------------------------------
!BOP
!
                                                                               ! !IROUTINE: dealloc_energy_balance_type
!  
! !INTERFACE:
  subroutine dealloc_energy_balance_type(    ebal)
!
! !DESCRIPTION:
! Initialize energy balance variables
!  
! !ARGUMENTS:
    implicit none
    type(energy_balance_type), intent(inout):: ebal
!
! !REVISION HISTORY:
! Created by Mariana Vertenstein
!  
!EOP
!------------------------------------------------------------------------
   
    deallocate(ebal%errsoi )
    deallocate(ebal%errseb )
    deallocate(ebal%errsol )
    deallocate(ebal%errlon )


  end subroutine dealloc_energy_balance_type

!------------------------------------------------------------------------
!BOP
!
! !IROUTINE: dealloc_water_balance_type
!   
! !INTERFACE:
  subroutine dealloc_water_balance_type(    wbal)
!
! !DESCRIPTION:
! Initialize water balance variables
!
! !ARGUMENTS:
    implicit none
    type(water_balance_type), intent(inout):: wbal
!  
! !REVISION HISTORY: 
! Created by Mariana Vertenstein
!
!EOP
!------------------------------------------------------------------------
   
    deallocate(wbal%begwb )
    deallocate(wbal%endwb )
    deallocate(wbal%errh2o )
   

  end subroutine dealloc_water_balance_type

!------------------------------------------------------------------------
!BOP
! !IROUTINE: dealloc_carbon_balance_type
!
! !INTERFACE:
  subroutine dealloc_carbon_balance_type(    cbal)
!
! !DESCRIPTION:
! Initialize carbon balance variables
!
! !ARGUMENTS:
    implicit none
    type(carbon_balance_type), intent(inout):: cbal
!
! !REVISION HISTORY:
! Created by Peter Thornton, 12/11/2003
!
!EOP
!------------------------------------------------------------------------

    deallocate(cbal%begcb )
    deallocate(cbal%endcb )
    deallocate(cbal%errcb )


  end subroutine dealloc_carbon_balance_type

!------------------------------------------------------------------------
!BOP
!
! !IROUTINE: dealloc_nitrogen_balance_type
!
! !INTERFACE:
  subroutine dealloc_nitrogen_balance_type(    nbal)
!
! !DESCRIPTION:
! Initialize nitrogen balance variables
!
! !ARGUMENTS:
    implicit none
    type(nitrogen_balance_type), intent(inout):: nbal
!
! !REVISION HISTORY:
! Created by Peter Thornton, 12/11/2003
!
!EOP
!------------------------------------------------------------------------

    deallocate(nbal%begnb )
    deallocate(nbal%endnb )
    deallocate(nbal%errnb )


  end subroutine dealloc_nitrogen_balance_type

!------------------------------------------------------------------------
!BOP
!
! !IROUTINE: dealloc_pft_ecophys_constants
! !INTERFACE:
  subroutine dealloc_pft_ecophys_constants()
!
! !DESCRIPTION:
! Initialize pft physical state
!
! !ARGUMENTS:
    implicit none
!
! !REVISION HISTORY:
! Created by Mariana Vertenstein
!   
!EOP
!------------------------------------------------------------------------

    deallocate(pftcon%noveg )
    deallocate(pftcon%tree )
    deallocate(pftcon%smpso ) 
    deallocate(pftcon%smpsc )
    deallocate(pftcon%fnitr )
    deallocate(pftcon%foln )
    deallocate(pftcon%dleaf )
    deallocate(pftcon%c3psn )
    deallocate(pftcon%vcmx25 )
    deallocate(pftcon%mp )
    deallocate(pftcon%qe25 )
    deallocate(pftcon%xl )
    deallocate(pftcon%rhol)
    deallocate(pftcon%rhos)
    deallocate(pftcon%taul)
    deallocate(pftcon%taus)
    deallocate(pftcon%z0mr )
    deallocate(pftcon%displar )
    deallocate(pftcon%roota_par )
    deallocate(pftcon%rootb_par )
    deallocate(pftcon%sla )
    deallocate(pftcon%slatop )
    deallocate(pftcon%dsladlai )
    deallocate(pftcon%leafcn )
    deallocate(pftcon%flnr )
    deallocate(pftcon%woody )
    deallocate(pftcon%lflitcn )
    deallocate(pftcon%frootcn )
    deallocate(pftcon%livewdcn ) 
    deallocate(pftcon%deadwdcn )
#ifdef CROP
    deallocate(pftcon%graincn )
#endif
    deallocate(pftcon%froot_leaf )
    deallocate(pftcon%stem_leaf )
    deallocate(pftcon%croot_stem )
    deallocate(pftcon%flivewd )
    deallocate(pftcon%fcur )
    deallocate(pftcon%lf_flab )
    deallocate(pftcon%lf_fcel )
    deallocate(pftcon%lf_flig )
    deallocate(pftcon%fr_flab )
    deallocate(pftcon%fr_fcel )
    deallocate(pftcon%fr_flig )
    deallocate(pftcon%dw_fcel )
    deallocate(pftcon%dw_flig )
    deallocate(pftcon%leaf_long )
    deallocate(pftcon%evergreen )
    deallocate(pftcon%stress_decid )
    deallocate(pftcon%season_decid )
    deallocate(pftcon%resist )
    deallocate(pftcon%dwood )


  end subroutine dealloc_pft_ecophys_constants

#if (defined CNDV) || (defined CROP)
!------------------------------------------------------------------------
!BOP
!
! !IROUTINE: dealloc_pft_DGVMecophys_constants
!
! !INTERFACE:
  subroutine dealloc_pft_DGVMecophys_constants()
! !DESCRIPTION:
! Initialize pft physical state
!
! !ARGUMENTS:
    implicit none
!   
! !REVISION HISTORY:
! Created by Mariana Vertenstein
!   
!EOP
!------------------------------------------------------------------------
    
    deallocate(dgv_pftcon%crownarea_max )
    deallocate(dgv_pftcon%tcmin )
    deallocate(dgv_pftcon%tcmax )
    deallocate(dgv_pftcon%gddmin )
    deallocate(dgv_pftcon%twmax )
    deallocate(dgv_pftcon%reinickerp )
    deallocate(dgv_pftcon%allom1 )
    deallocate(dgv_pftcon%allom2 )
    deallocate(dgv_pftcon%allom3 )
    
    
  end subroutine dealloc_pft_DGVMecophys_constants
#endif

!------------------------------------------------------------------------
!BOP
!   
! !IROUTINE: dealloc_pft_pstate_type
!   
! !INTERFACE:
  subroutine dealloc_pft_pstate_type(    pps)
!   
! !DESCRIPTION:
! Initialize pft physical state
!   
! !USES:
    use clm_varcon, only : spval
#if (defined CASA)
    use CASAMod   , only : npools, nresp_pools, nlive, npool_types
#endif
! !ARGUMENTS:
    implicit none
    type (pft_pstate_type), intent(inout):: pps
! 
! !REVISION HISTORY:
! Created by Mariana Vertenstein
!
!EOP
!------------------------------------------------------------------------

    deallocate(pps%frac_veg_nosno )
    deallocate(pps%frac_veg_nosno_alb )
    deallocate(pps%emv )
    deallocate(pps%z0mv )
    deallocate(pps%z0hv )
    deallocate(pps%z0qv )
    deallocate(pps%rootfr )
    deallocate(pps%rootr )
    deallocate(pps%rresis )
    deallocate(pps%dewmx )
    deallocate(pps%rssun )
    deallocate(pps%rssha )
    deallocate(pps%laisun )
    deallocate(pps%laisha )
    deallocate(pps%btran )
    deallocate(pps%fsun )
    deallocate(pps%tlai )
    deallocate(pps%tsai )
    deallocate(pps%elai )
    deallocate(pps%esai )
    deallocate(pps%fwet )
    deallocate(pps%fdry )
    deallocate(pps%dt_veg )
    deallocate(pps%htop )
    deallocate(pps%hbot )
    deallocate(pps%z0m )
    deallocate(pps%displa )
    deallocate(pps%albd )
    deallocate(pps%albi )
    deallocate(pps%fabd )
    deallocate(pps%fabi )
    deallocate(pps%ftdd )
    deallocate(pps%ftid )
    deallocate(pps%ftii )
    deallocate(pps%u10 )
    deallocate(pps%fv )
    deallocate(pps%ram1 )
#if (defined CROP)
    deallocate(pps%hdidx )
    deallocate(pps%cumvd )
    deallocate(pps%htmx )
    deallocate(pps%vf )
    deallocate(pps%gddmaturity )
    deallocate(pps%gdd0 )
    deallocate(pps%gdd8 )
    deallocate(pps%gdd10 )
    deallocate(pps%gdd020 )
    deallocate(pps%gdd820 )
    deallocate(pps%gdd1020 )
    deallocate(pps%gddplant )
    deallocate(pps%gddtsoi )
    deallocate(pps%huileaf )
    deallocate(pps%huigrain )
    deallocate(pps%a10tmin )
    deallocate(pps%a5tmin )
    deallocate(pps%aleafi )
    deallocate(pps%astemi )
    deallocate(pps%aleaf )
    deallocate(pps%astem )
    deallocate(pps%croplive )
    deallocate(pps%cropplant ) !,numpft)) ! make 2-D if using
    deallocate(pps%harvdate )  !,numpft)) ! crop rotation
    deallocate(pps%idop )
    deallocate(pps%peaklai )
#endif
    deallocate(pps%vds )
    deallocate(pps%slasun )
    deallocate(pps%slasha )
    deallocate(pps%lncsun )
    deallocate(pps%lncsha )
    deallocate(pps%vcmxsun )
    deallocate(pps%vcmxsha )
    deallocate(pps%gdir ) 
    deallocate(pps%omega )
    deallocate(pps%eff_kid )
    deallocate(pps%eff_kii )
    deallocate(pps%sun_faid )
    deallocate(pps%sun_faii )
    deallocate(pps%sha_faid )
    deallocate(pps%sha_faii )
    deallocate(pps%forc_hgt_u_pft )
    deallocate(pps%forc_hgt_t_pft )
    deallocate(pps%forc_hgt_q_pft )
    ! 4/14/05: PET
    ! Adding isotope code
    deallocate(pps%cisun )
    deallocate(pps%cisha )
#if (defined C13)
    deallocate(pps%alphapsnsun )
    deallocate(pps%alphapsnsha )
#endif
    ! heald: added from CASA defdeallocion
    deallocate(pps%sandfrac )
    deallocate(pps%clayfrac )
    deallocate(pps%mlaidiff )
    deallocate(pps%rb1 )
    deallocate(pps%annlai)
    
    
#if (defined CASA)
    deallocate(pps%Closs)  ! C lost to atm
    deallocate(pps%Ctrans)  ! C transfers out of pool types
    deallocate(pps%Resp_C)
    deallocate(pps%Tpool_C)! Total C pool size
    deallocate(pps%eff)
    deallocate(pps%frac_donor)
    deallocate(pps%livefr)  !live fraction
    deallocate(pps%pet )           !potential evaporation (mm h2o/s)
    deallocate(pps%co2flux )       ! net CO2 flux (g C/m2/sec) [+= atm]
    deallocate(pps%fnpp )          ! NPP  (g C/m2/sec)
    deallocate(pps%soilt )         !soil temp for top 30cm
    deallocate(pps%smoist )        !soil moisture for top 30cm
    deallocate(pps%sz )
    deallocate(pps%watopt ) 
    deallocate(pps%watdry )
    deallocate(pps%soiltc )         !soil temp for entire column
    deallocate(pps%smoistc )        !soil moisture for entire column
    deallocate(pps%szc )
    deallocate(pps%watoptc )
    deallocate(pps%watdryc )
    deallocate(pps%Wlim )
    deallocate(pps%litterscalar )
    deallocate(pps%rootlitscalar )
    deallocate(pps%stressCD )
    deallocate(pps%excessC )       ! excess Carbon (gC/m2/timestep)
    deallocate(pps%bgtemp )
    deallocate(pps%bgmoist )
    deallocate(pps%plai )          ! prognostic LAI (m2 leaf/m2 ground)
    deallocate(pps%Cflux )
    deallocate(pps%XSCpool )
    deallocate(pps%tday )     ! daily accumulated temperature (deg C)
    deallocate(pps%tdayavg )  ! daily averaged temperature (deg C)
    deallocate(pps%tcount )   ! counter for daily avg temp
    deallocate(pps%degday )   ! accumulated degree days (deg C)
    deallocate(pps%ndegday )  ! counter for number of degree days
    deallocate(pps%stressT )
    deallocate(pps%stressW )  ! water stress function for leaf loss
    deallocate(pps%iseabeg )  ! index for start of growing season
    deallocate(pps%nstepbeg ) ! nstep at start of growing season
    deallocate(pps%lgrow )    ! growing season index (0 or 1) to be
                                    ! passed daily to CASA to get NPP
#if (defined CLAMP)
    ! Summary variables added for the C-LAMP Experiments
    deallocate(pps%casa_agnpp )
    deallocate(pps%casa_ar )
    deallocate(pps%casa_bgnpp )
    deallocate(pps%casa_cwdc )
    deallocate(pps%casa_cwdc_hr )
    deallocate(pps%casa_cwdc_loss )
    deallocate(pps%casa_frootc )
    deallocate(pps%casa_frootc_alloc )
    deallocate(pps%casa_frootc_loss )
    deallocate(pps%casa_gpp )
    deallocate(pps%casa_hr )
    deallocate(pps%casa_leafc )
    deallocate(pps%casa_leafc_alloc )
    deallocate(pps%casa_leafc_loss )
    deallocate(pps%casa_litterc )
    deallocate(pps%casa_litterc_hr )
    deallocate(pps%casa_litterc_loss )
    deallocate(pps%casa_nee )
    deallocate(pps%casa_nep )
    deallocate(pps%casa_npp )
    deallocate(pps%casa_soilc )
    deallocate(pps%casa_soilc_hr )
    deallocate(pps%casa_soilc_loss )
    deallocate(pps%casa_woodc )
    deallocate(pps%casa_woodc_alloc )
    deallocate(pps%casa_woodc_loss )
#endif
#endif
  end subroutine dealloc_pft_pstate_type
    
!------------------------------------------------------------------------
!BOP
!   
! !IROUTINE: dealloc_pft_epv_type
!   
! !INTERFACE: 
  subroutine dealloc_pft_epv_type(    pepv)
!   
! !DESCRIPTION:  
! Initialize pft ecophysiological variables
!   
! !ARGUMENTS:
    implicit none 
    type (pft_epv_type), intent(inout):: pepv
!   
! !REVISION HISTORY:
! Created by Peter Thornton
!   
!EOP
!------------------------------------------------------------------------
    
    deallocate(pepv%dormant_flag )
    deallocate(pepv%days_active )
    deallocate(pepv%onset_flag )
    deallocate(pepv%onset_counter )
    deallocate(pepv%onset_gddflag )
    deallocate(pepv%onset_fdd )
    deallocate(pepv%onset_gdd )
    deallocate(pepv%onset_swi )
    deallocate(pepv%offset_flag )
    deallocate(pepv%offset_counter )
    deallocate(pepv%offset_fdd )
    deallocate(pepv%offset_swi )
    deallocate(pepv%lgsf )
    deallocate(pepv%bglfr )
    deallocate(pepv%bgtr )
    deallocate(pepv%dayl )
    deallocate(pepv%prev_dayl )
    deallocate(pepv%annavg_t2m )
    deallocate(pepv%tempavg_t2m )
    deallocate(pepv%gpp ) 
    deallocate(pepv%availc )
    deallocate(pepv%xsmrpool_recover )
#if (defined C13)
    deallocate(pepv%xsmrpool_c13ratio )
#endif
    deallocate(pepv%alloc_pnow )
    deallocate(pepv%c_allometry )
    deallocate(pepv%n_allometry )
    deallocate(pepv%plant_ndemand )
    deallocate(pepv%tempsum_potential_gpp )
    deallocate(pepv%annsum_potential_gpp )
    deallocate(pepv%tempmax_retransn )
    deallocate(pepv%annmax_retransn )
    deallocate(pepv%avail_retransn )
    deallocate(pepv%plant_nalloc )
    deallocate(pepv%plant_calloc )
    deallocate(pepv%excess_cflux )
    deallocate(pepv%downreg )
    deallocate(pepv%prev_leafc_to_litter )
    deallocate(pepv%prev_frootc_to_litter )
    deallocate(pepv%tempsum_npp )
    deallocate(pepv%annsum_npp )
#if (defined CNDV)
    deallocate(pepv%tempsum_litfall )
    deallocate(pepv%annsum_litfall )
#endif
#if (defined C13)
    ! 4/21/05, PET
    ! Adding isotope code
    deallocate(pepv%rc13_canair )
    deallocate(pepv%rc13_psnsun )
    deallocate(pepv%rc13_psnsha )
#endif

    
  end subroutine dealloc_pft_epv_type
    
#if (defined CNDV) || (defined CROP)
!------------------------------------------------------------------------
!BOP
!   
! !IROUTINE: dealloc_pft_pdgvstate_type
!   
! !INTERFACE:
  subroutine dealloc_pft_pdgvstate_type(    pdgvs)
!
! !DESCRIPTION:
! Initialize pft DGVM state variables
!   
! !ARGUMENTS:
    implicit none
    type (pft_dgvstate_type), intent(inout):: pdgvs
!   
! !REVISION HISTORY:
! Created by Mariana Vertenstein
!   
!EOP
!------------------------------------------------------------------------
    
    deallocate(pdgvs%agddtw )
    deallocate(pdgvs%agdd )
    deallocate(pdgvs%t10 )
    deallocate(pdgvs%t_mo )
    deallocate(pdgvs%t_mo_min )
    deallocate(pdgvs%prec365 )
    deallocate(pdgvs%present )
    deallocate(pdgvs%pftmayexist )
    deallocate(pdgvs%nind )
    deallocate(pdgvs%lm_ind )
    deallocate(pdgvs%lai_ind )
    deallocate(pdgvs%fpcinc )
    deallocate(pdgvs%fpcgrid )
    deallocate(pdgvs%fpcgridold )
    deallocate(pdgvs%crownarea )
    deallocate(pdgvs%greffic )
    deallocate(pdgvs%heatstress ) 
  end subroutine dealloc_pft_pdgvstate_type
#endif
!
! !IROUTINE: dealloc_pft_vstate_type
!
! !INTERFACE:
  subroutine dealloc_pft_vstate_type(    pvs)
!
! !DESCRIPTION:
! Initialize pft VOC variables
!
! !USES:
! !ARGUMENTS:
    implicit none
    type (pft_vstate_type), intent(inout):: pvs
!
! !REVISION HISTORY:
! Created by Erik Kluzek
!
!EOP
!------------------------------------------------------------------------

    deallocate(pvs%t_veg24  )
    deallocate(pvs%t_veg240 )
    deallocate(pvs%fsd24    )
    deallocate(pvs%fsd240   )
    deallocate(pvs%fsi24    )
    deallocate(pvs%fsi240   )
    deallocate(pvs%fsun24   )
    deallocate(pvs%fsun240  )
    deallocate(pvs%elai_p   )

  end subroutine dealloc_pft_vstate_type

!------------------------------------------------------------------------
!BOP
!
! !IROUTINE: dealloc_pft_estate_type
!
! !INTERFACE:
  subroutine dealloc_pft_estate_type(    pes)
!
! !DESCRIPTION:
! Initialize pft energy state
!
! !ARGUMENTS:
    implicit none
    type (pft_estate_type), intent(inout):: pes
!
! !REVISION HISTORY:
    deallocate(pes%t_ref2m )
    deallocate(pes%t_ref2m_min )
    deallocate(pes%t_ref2m_max )
    deallocate(pes%t_ref2m_min_inst )
    deallocate(pes%t_ref2m_max_inst )
    deallocate(pes%q_ref2m )
    deallocate(pes%t_ref2m_u )
    deallocate(pes%t_ref2m_r )
    deallocate(pes%t_ref2m_min_u )
    deallocate(pes%t_ref2m_min_r )
    deallocate(pes%t_ref2m_max_u )
    deallocate(pes%t_ref2m_max_r )
    deallocate(pes%t_ref2m_min_inst_u )
    deallocate(pes%t_ref2m_min_inst_r )
    deallocate(pes%t_ref2m_max_inst_u )
    deallocate(pes%t_ref2m_max_inst_r )
    deallocate(pes%rh_ref2m )
    deallocate(pes%rh_ref2m_u )
    deallocate(pes%rh_ref2m_r )
    deallocate(pes%t_veg )
    deallocate(pes%thm )


  end subroutine dealloc_pft_estate_type

!------------------------------------------------------------------------
!BOP
!
! !IROUTINE: dealloc_pft_wstate_type
! 
! !INTERFACE:
  subroutine dealloc_pft_wstate_type(    pws)
!
! !DESCRIPTION:
! Initialize pft water state
!   
! !ARGUMENTS:
    implicit none
    type (pft_wstate_type), intent(inout):: pws !pft water state
                                                                                  !
! !REVISION HISTORY:
! Created by Mariana Vertenstein
!
!EOP
!------------------------------------------------------------------------

    deallocate(pws%h2ocan )

  end subroutine dealloc_pft_wstate_type

!------------------------------------------------------------------------
!BOP
!
! !IROUTINE: dealloc_pft_cstate_type
!
! !INTERFACE:
  subroutine dealloc_pft_cstate_type(    pcs)
!
! !DESCRIPTION:
! Initialize pft carbon state
!
! !ARGUMENTS:
    implicit none
    type (pft_cstate_type), intent(inout):: pcs !pft carbon state
!
! !REVISION HISTORY:
! Created by Peter Thornton
!
!EOP
!------------------------------------------------------------------------

    deallocate(pcs%leafc )
    deallocate(pcs%leafc_storage )
    deallocate(pcs%leafc_xfer )
    deallocate(pcs%frootc )
    deallocate(pcs%frootc_storage )
    deallocate(pcs%frootc_xfer )
    deallocate(pcs%livestemc )
    deallocate(pcs%livestemc_storage )
    deallocate(pcs%livestemc_xfer )
    deallocate(pcs%deadstemc )
    deallocate(pcs%deadstemc_storage )
    deallocate(pcs%deadstemc_xfer )
    deallocate(pcs%livecrootc )
    deallocate(pcs%livecrootc_storage )
    deallocate(pcs%livecrootc_xfer )
    deallocate(pcs%deadcrootc )
    deallocate(pcs%deadcrootc_storage )
    deallocate(pcs%deadcrootc_xfer )
    deallocate(pcs%gresp_storage )
    deallocate(pcs%gresp_xfer )
    deallocate(pcs%cpool )
    deallocate(pcs%xsmrpool )
    deallocate(pcs%pft_ctrunc )
    deallocate(pcs%dispvegc )
    deallocate(pcs%storvegc )
    deallocate(pcs%totvegc )
    deallocate(pcs%totpftc )
    deallocate(pcs%leafcmax )
#if (defined CROP)
    deallocate(pcs%grainc )
    deallocate(pcs%grainc_storage )
    deallocate(pcs%grainc_xfer )
#endif
#if (defined CLAMP) && (defined CN)
    !CLAMP
    deallocate(pcs%woodc )
#endif

    
  end subroutine dealloc_pft_cstate_type
    
!------------------------------------------------------------------------
!BOP
!   
! !IROUTINE: dealloc_pft_nstate_type
!   
! !INTERFACE:
  subroutine dealloc_pft_nstate_type(    pns)
!   
! !DESCRIPTION:
! Initialize pft nitrogen state
!   
! !ARGUMENTS:
    implicit none
    type (pft_nstate_type), intent(inout):: pns !pft nitrogen state
!   
! !REVISION HISTORY:
! Created by Peter Thornton

#if (defined CROP)
    deallocate(pns%grainn )
    deallocate(pns%grainn_storage )
    deallocate(pns%grainn_xfer )
#endif
    deallocate(pns%leafn )
    deallocate(pns%leafn_storage )
    deallocate(pns%leafn_xfer )
    deallocate(pns%frootn )
    deallocate(pns%frootn_storage )
    deallocate(pns%frootn_xfer )
    deallocate(pns%livestemn )
    deallocate(pns%livestemn_storage )
    deallocate(pns%livestemn_xfer )
    deallocate(pns%deadstemn )
    deallocate(pns%deadstemn_storage )
    deallocate(pns%deadstemn_xfer )
    deallocate(pns%livecrootn )
    deallocate(pns%livecrootn_storage )
    deallocate(pns%livecrootn_xfer )
    deallocate(pns%deadcrootn )
    deallocate(pns%deadcrootn_storage )
    deallocate(pns%deadcrootn_xfer )
    deallocate(pns%retransn )
    deallocate(pns%npool )
    deallocate(pns%pft_ntrunc )
    deallocate(pns%dispvegn )
    deallocate(pns%storvegn )
    deallocate(pns%totvegn )
    deallocate(pns%totpftn )
 end subroutine dealloc_pft_nstate_type
! !IROUTINE: dealloc_pft_eflux_type
!   
! !INTERFACE:
  subroutine dealloc_pft_eflux_type(    pef)
!
! !DESCRIPTION:
! Initialize pft energy flux variables
!   
! !ARGUMENTS:
    implicit none
    type (pft_eflux_type), intent(inout):: pef
!   
! !REVISION HISTORY:
! Created by Mariana Vertenstein
!   
!EOP
!------------------------------------------------------------------------
    
    deallocate(pef%sabg )
    deallocate(pef%sabv )
    deallocate(pef%fsa )
    deallocate(pef%fsa_u )
    deallocate(pef%fsa_r )
    deallocate(pef%fsr ) 
    deallocate(pef%parsun )
    deallocate(pef%parsha ) 
    deallocate(pef%dlrad )
    deallocate(pef%ulrad ) 
    deallocate(pef%eflx_lh_tot )
    deallocate(pef%eflx_lh_tot_u )
    deallocate(pef%eflx_lh_tot_r )
    deallocate(pef%eflx_lh_grnd )
    deallocate(pef%eflx_soil_grnd )
    deallocate(pef%eflx_soil_grnd_u )
    deallocate(pef%eflx_soil_grnd_r )
    deallocate(pef%eflx_sh_tot )
    deallocate(pef%eflx_sh_tot_u )
    deallocate(pef%eflx_sh_tot_r )
    deallocate(pef%eflx_sh_grnd )
    deallocate(pef%eflx_sh_veg )
    deallocate(pef%eflx_lh_vege )
    deallocate(pef%eflx_lh_vegt )
    deallocate(pef%eflx_wasteheat_pft )
    deallocate(pef%eflx_heat_from_ac_pft )
    deallocate(pef%eflx_traffic_pft )
    deallocate(pef%eflx_anthro )
    deallocate(pef%cgrnd )
    deallocate(pef%cgrndl )
    deallocate(pef%cgrnds ) 
    deallocate(pef%eflx_gnet )
    deallocate(pef%dgnetdT )
    deallocate(pef%eflx_lwrad_out )
    deallocate(pef%eflx_lwrad_net )
    deallocate(pef%eflx_lwrad_net_u )
    deallocate(pef%eflx_lwrad_net_r )
    deallocate(pef%netrad )
    deallocate(pef%fsds_vis_d )
    deallocate(pef%fsds_nir_d )
    deallocate(pef%fsds_vis_i )
    deallocate(pef%fsds_nir_i )
    deallocate(pef%fsr_vis_d )
    deallocate(pef%fsr_nir_d )
    deallocate(pef%fsr_vis_i )
                                                                         
    deallocate(pef%fsr_nir_i )
    deallocate(pef%fsds_vis_d_ln )
    deallocate(pef%fsds_nir_d_ln )
    deallocate(pef%fsr_vis_d_ln )
    deallocate(pef%fsr_nir_d_ln )
    deallocate(pef%sun_add )
    deallocate(pef%tot_aid )
    deallocate(pef%sun_aid )
    deallocate(pef%sun_aii )
    deallocate(pef%sha_aid )
    deallocate(pef%sha_aii )
    deallocate(pef%sun_atot )
    deallocate(pef%sha_atot )
    deallocate(pef%sun_alf )
    deallocate(pef%sha_alf )
    deallocate(pef%sun_aperlai )
    deallocate(pef%sha_aperlai )
    deallocate(pef%sabg_lyr)
    deallocate(pef%sfc_frc_aer )
    deallocate(pef%sfc_frc_bc )
    deallocate(pef%sfc_frc_oc )
    deallocate(pef%sfc_frc_dst )
    deallocate(pef%sfc_frc_aer_sno )
    deallocate(pef%sfc_frc_bc_sno )
    deallocate(pef%sfc_frc_oc_sno )
    deallocate(pef%sfc_frc_dst_sno )
    deallocate(pef%fsr_sno_vd )
    deallocate(pef%fsr_sno_nd )
    deallocate(pef%fsr_sno_vi )
    deallocate(pef%fsr_sno_ni )
    deallocate(pef%fsds_sno_vd )
    deallocate(pef%fsds_sno_nd )
    deallocate(pef%fsds_sno_vi )
    deallocate(pef%fsds_sno_ni )
  end subroutine dealloc_pft_eflux_type
    
!------------------------------------------------------------------------
!BOP
!   
! !IROUTINE: dealloc_pft_mflux_type
!   
! !INTERFACE:
  subroutine dealloc_pft_mflux_type(    pmf)
!   
! !DESCRIPTION:
! Initialize pft momentum flux variables
!   
! !ARGUMENTS:
    implicit none
    type (pft_mflux_type), intent(inout) :: pmf
   deallocate(pmf%taux )
    deallocate(pmf%tauy )


  end subroutine dealloc_pft_mflux_type

!------------------------------------------------------------------------
!BOP
!
! !IROUTINE: dealloc_pft_wflux_type
!
! !INTERFACE:
  subroutine dealloc_pft_wflux_type(    pwf)
!
! !DESCRIPTION:
! Initialize pft water flux variables
!
! !ARGUMENTS:
    implicit none
    type (pft_wflux_type), intent(inout) :: pwf
!
! !REVISION HISTORY:
! Created by Mariana Vertenstein
!
!EOP
!------------------------------------------------------------------------

    deallocate(pwf%qflx_prec_intr )
    deallocate(pwf%qflx_prec_grnd )
    deallocate(pwf%qflx_rain_grnd )
    deallocate(pwf%qflx_snow_grnd )
    deallocate(pwf%qflx_snwcp_liq )
    deallocate(pwf%qflx_snwcp_ice )
    deallocate(pwf%qflx_evap_veg )
    deallocate(pwf%qflx_tran_veg )
    deallocate(pwf%qflx_evap_can )
    deallocate(pwf%qflx_evap_soi )
    deallocate(pwf%qflx_evap_tot )
    deallocate(pwf%qflx_evap_grnd )
    deallocate(pwf%qflx_dew_grnd )
    deallocate(pwf%qflx_sub_snow )
    deallocate(pwf%qflx_dew_snow )

  end subroutine dealloc_pft_wflux_type

!------------------------------------------------------------------------
!BOP
!
! !IROUTINE: dealloc_pft_cflux_type
!
! !INTERFACE: 
  subroutine dealloc_pft_cflux_type(    pcf)
!
! !DESCRIPTION:
! Initialize pft carbon flux variables
!
! !ARGUMENTS:
    implicit none
    type (pft_cflux_type), intent(inout) :: pcf
!
! !REVISION HISTORY:
! Created by Mariana Vertenstein
!
!EOP
!------------------------------------------------------------------------

    deallocate(pcf%psnsun )
    deallocate(pcf%psnsha )  
    deallocate(pcf%fpsn )
    deallocate(pcf%fco2 )

    deallocate(pcf%m_leafc_to_litter )
    deallocate(pcf%m_frootc_to_litter )
    deallocate(pcf%m_leafc_storage_to_litter )
    deallocate(pcf%m_frootc_storage_to_litter )
    deallocate(pcf%m_livestemc_storage_to_litter )
    deallocate(pcf%m_deadstemc_storage_to_litter )
    deallocate(pcf%m_livecrootc_storage_to_litter )
    deallocate(pcf%m_deadcrootc_storage_to_litter )
    deallocate(pcf%m_leafc_xfer_to_litter )
    deallocate(pcf%m_frootc_xfer_to_litter )
    deallocate(pcf%m_livestemc_xfer_to_litter )
    deallocate(pcf%m_deadstemc_xfer_to_litter )
    deallocate(pcf%m_livecrootc_xfer_to_litter )
    deallocate(pcf%m_deadcrootc_xfer_to_litter )
    deallocate(pcf%m_livestemc_to_litter )
    deallocate(pcf%m_deadstemc_to_litter )
    deallocate(pcf%m_livecrootc_to_litter )
    deallocate(pcf%m_deadcrootc_to_litter )
    deallocate(pcf%m_gresp_storage_to_litter )
    deallocate(pcf%m_gresp_xfer_to_litter )
    deallocate(pcf%hrv_leafc_to_litter )
    deallocate(pcf%hrv_leafc_storage_to_litter )
    deallocate(pcf%hrv_leafc_xfer_to_litter )
    deallocate(pcf%hrv_frootc_to_litter )
    deallocate(pcf%hrv_frootc_storage_to_litter )
    deallocate(pcf%hrv_frootc_xfer_to_litter )
    deallocate(pcf%hrv_livestemc_to_litter )
    deallocate(pcf%hrv_livestemc_storage_to_litter )
    deallocate(pcf%hrv_livestemc_xfer_to_litter )
    deallocate(pcf%hrv_deadstemc_to_prod10c )
    deallocate(pcf%hrv_deadstemc_to_prod100c )
    deallocate(pcf%hrv_deadstemc_storage_to_litter )
    deallocate(pcf%hrv_deadstemc_xfer_to_litter )
    deallocate(pcf%hrv_livecrootc_to_litter )
    deallocate(pcf%hrv_livecrootc_storage_to_litter )
    deallocate(pcf%hrv_livecrootc_xfer_to_litter )
    deallocate(pcf%hrv_deadcrootc_to_litter )
    deallocate(pcf%hrv_deadcrootc_storage_to_litter )
    deallocate(pcf%hrv_deadcrootc_xfer_to_litter )
    deallocate(pcf%hrv_gresp_storage_to_litter )
    deallocate(pcf%hrv_gresp_xfer_to_litter )
    deallocate(pcf%hrv_xsmrpool_to_atm )
    deallocate(pcf%m_leafc_to_fire )
    deallocate(pcf%m_frootc_to_fire )
    deallocate(pcf%m_leafc_storage_to_fire )
    deallocate(pcf%m_frootc_storage_to_fire )
    deallocate(pcf%m_livestemc_storage_to_fire )
    deallocate(pcf%m_deadstemc_storage_to_fire )
    deallocate(pcf%m_livecrootc_storage_to_fire )
    deallocate(pcf%m_deadcrootc_storage_to_fire )
    deallocate(pcf%m_leafc_xfer_to_fire )
    deallocate(pcf%m_frootc_xfer_to_fire )
    deallocate(pcf%m_livestemc_xfer_to_fire )
    deallocate(pcf%m_deadstemc_xfer_to_fire )
    deallocate(pcf%m_livecrootc_xfer_to_fire )
    deallocate(pcf%m_deadcrootc_xfer_to_fire )
    deallocate(pcf%m_livestemc_to_fire )
    deallocate(pcf%m_deadstemc_to_fire )
    deallocate(pcf%m_deadstemc_to_litter_fire )
    deallocate(pcf%m_livecrootc_to_fire )
    deallocate(pcf%m_deadcrootc_to_fire )
    deallocate(pcf%m_deadcrootc_to_litter_fire )
    deallocate(pcf%m_gresp_storage_to_fire )
    deallocate(pcf%m_gresp_xfer_to_fire )
    deallocate(pcf%leafc_xfer_to_leafc )
    deallocate(pcf%frootc_xfer_to_frootc )
    deallocate(pcf%livestemc_xfer_to_livestemc )
    deallocate(pcf%deadstemc_xfer_to_deadstemc )
    deallocate(pcf%livecrootc_xfer_to_livecrootc )
    deallocate(pcf%deadcrootc_xfer_to_deadcrootc )
    deallocate(pcf%leafc_to_litter )
    deallocate(pcf%frootc_to_litter )
    deallocate(pcf%leaf_mr )
    deallocate(pcf%froot_mr )
    deallocate(pcf%livestem_mr )
    deallocate(pcf%livecroot_mr )
    deallocate(pcf%leaf_curmr )
    deallocate(pcf%froot_curmr )
    deallocate(pcf%livestem_curmr )
    deallocate(pcf%livecroot_curmr )
    deallocate(pcf%leaf_xsmr )
    deallocate(pcf%froot_xsmr )
    deallocate(pcf%livestem_xsmr )
    deallocate(pcf%livecroot_xsmr )
    deallocate(pcf%psnsun_to_cpool )
    deallocate(pcf%psnshade_to_cpool )
    deallocate(pcf%cpool_to_xsmrpool )
    deallocate(pcf%cpool_to_leafc )
    deallocate(pcf%cpool_to_leafc_storage )
    deallocate(pcf%cpool_to_frootc )
    deallocate(pcf%cpool_to_frootc_storage )
    deallocate(pcf%cpool_to_livestemc )
    deallocate(pcf%cpool_to_livestemc_storage )
    deallocate(pcf%cpool_to_deadstemc )
    deallocate(pcf%cpool_to_deadstemc_storage )
    deallocate(pcf%cpool_to_livecrootc )
    deallocate(pcf%cpool_to_livecrootc_storage )
    deallocate(pcf%cpool_to_deadcrootc )
    deallocate(pcf%cpool_to_deadcrootc_storage )
    deallocate(pcf%cpool_to_gresp_storage )
    deallocate(pcf%cpool_leaf_gr )
    deallocate(pcf%cpool_leaf_storage_gr )
    deallocate(pcf%transfer_leaf_gr )
    deallocate(pcf%cpool_froot_gr )
    deallocate(pcf%cpool_froot_storage_gr )
    deallocate(pcf%transfer_froot_gr )
    deallocate(pcf%cpool_livestem_gr )
    deallocate(pcf%cpool_livestem_storage_gr )
    deallocate(pcf%transfer_livestem_gr )
    deallocate(pcf%cpool_deadstem_gr )
    deallocate(pcf%cpool_deadstem_storage_gr )
    deallocate(pcf%transfer_deadstem_gr )
    deallocate(pcf%cpool_livecroot_gr )
    deallocate(pcf%cpool_livecroot_storage_gr )
    deallocate(pcf%transfer_livecroot_gr )
    deallocate(pcf%cpool_deadcroot_gr )
    deallocate(pcf%cpool_deadcroot_storage_gr )
    deallocate(pcf%transfer_deadcroot_gr )
    deallocate(pcf%leafc_storage_to_xfer )
    deallocate(pcf%frootc_storage_to_xfer ) 
    deallocate(pcf%livestemc_storage_to_xfer )
    deallocate(pcf%deadstemc_storage_to_xfer )
    deallocate(pcf%livecrootc_storage_to_xfer )
    deallocate(pcf%deadcrootc_storage_to_xfer )
    deallocate(pcf%gresp_storage_to_xfer )
    deallocate(pcf%livestemc_to_deadstemc )
    deallocate(pcf%livecrootc_to_deadcrootc )
    deallocate(pcf%gpp )
    deallocate(pcf%mr )
    deallocate(pcf%current_gr )
    deallocate(pcf%transfer_gr )
    deallocate(pcf%storage_gr )
    deallocate(pcf%gr )
    deallocate(pcf%ar )
    deallocate(pcf%rr )
    deallocate(pcf%npp )
    deallocate(pcf%agnpp )
    deallocate(pcf%bgnpp )
    deallocate(pcf%litfall )
    deallocate(pcf%vegfire )
    deallocate(pcf%wood_harvestc )
    deallocate(pcf%pft_cinputs )
    deallocate(pcf%pft_coutputs )
    deallocate(pcf%pft_fire_closs )
#if (defined CROP)
    deallocate(pcf%xsmrpool_to_atm )
    deallocate(pcf%grainc_xfer_to_grainc )
    deallocate(pcf%livestemc_to_litter )
    deallocate(pcf%grainc_to_food )
    deallocate(pcf%cpool_to_grainc )
    deallocate(pcf%cpool_to_grainc_storage )
    deallocate(pcf%cpool_grain_gr )
    deallocate(pcf%cpool_grain_storage_gr )
    deallocate(pcf%transfer_grain_gr )
    deallocate(pcf%grainc_storage_to_xfer )
#endif
#if (defined CLAMP) && (defined CN)
    !CLAMP
    deallocate(pcf%frootc_alloc )
    deallocate(pcf%frootc_loss )
    deallocate(pcf%leafc_alloc )
    deallocate(pcf%leafc_loss )
    deallocate(pcf%woodc_alloc )
    deallocate(pcf%woodc_loss )
#endif
  end subroutine dealloc_pft_cflux_type

!------------------------------------------------------------------------
!BOP
!
! !IROUTINE: dealloc_pft_nflux_type
!
! !INTERFACE:
  subroutine dealloc_pft_nflux_type(    pnf)
!
! !DESCRIPTION:
! Initialize pft nitrogen flux variables
!
! !ARGUMENTS:
    implicit none
    type (pft_nflux_type), intent(inout) :: pnf
!
! !REVISION HISTORY:
! Created by Mariana Vertenstein
!
!EOP
!------------------------------------------------------------------------

    deallocate(pnf%m_leafn_to_litter )
    deallocate(pnf%m_frootn_to_litter )
    deallocate(pnf%m_leafn_storage_to_litter )
    deallocate(pnf%m_frootn_storage_to_litter )
    deallocate(pnf%m_livestemn_storage_to_litter )
    deallocate(pnf%m_deadstemn_storage_to_litter )
    deallocate(pnf%m_livecrootn_storage_to_litter )
    deallocate(pnf%m_deadcrootn_storage_to_litter )
    deallocate(pnf%m_leafn_xfer_to_litter )
    deallocate(pnf%m_frootn_xfer_to_litter )
    deallocate(pnf%m_livestemn_xfer_to_litter )
    deallocate(pnf%m_deadstemn_xfer_to_litter )
    deallocate(pnf%m_livecrootn_xfer_to_litter )
    deallocate(pnf%m_deadcrootn_xfer_to_litter )
    deallocate(pnf%m_livestemn_to_litter )
    deallocate(pnf%m_deadstemn_to_litter )
    deallocate(pnf%m_livecrootn_to_litter )
    deallocate(pnf%m_deadcrootn_to_litter )
    deallocate(pnf%m_retransn_to_litter )
    deallocate(pnf%hrv_leafn_to_litter )
    deallocate(pnf%hrv_frootn_to_litter )
    deallocate(pnf%hrv_leafn_storage_to_litter )
    deallocate(pnf%hrv_frootn_storage_to_litter )
    deallocate(pnf%hrv_livestemn_storage_to_litter )
    deallocate(pnf%hrv_deadstemn_storage_to_litter )
    deallocate(pnf%hrv_livecrootn_storage_to_litter )
    deallocate(pnf%hrv_deadcrootn_storage_to_litter )
    deallocate(pnf%hrv_leafn_xfer_to_litter )
    deallocate(pnf%hrv_frootn_xfer_to_litter )
    deallocate(pnf%hrv_livestemn_xfer_to_litter )
    deallocate(pnf%hrv_deadstemn_xfer_to_litter )
    deallocate(pnf%hrv_livecrootn_xfer_to_litter )
    deallocate(pnf%hrv_deadcrootn_xfer_to_litter )
    deallocate(pnf%hrv_livestemn_to_litter )
    deallocate(pnf%hrv_deadstemn_to_prod10n )
    deallocate(pnf%hrv_deadstemn_to_prod100n )
    deallocate(pnf%hrv_livecrootn_to_litter )
    deallocate(pnf%hrv_deadcrootn_to_litter )
    deallocate(pnf%hrv_retransn_to_litter )
    deallocate(pnf%m_leafn_to_fire )
    deallocate(pnf%m_frootn_to_fire )
    deallocate(pnf%m_leafn_storage_to_fire )
    deallocate(pnf%m_frootn_storage_to_fire )
    deallocate(pnf%m_livestemn_storage_to_fire )
    deallocate(pnf%m_deadstemn_storage_to_fire )
    deallocate(pnf%m_livecrootn_storage_to_fire )
    deallocate(pnf%m_deadcrootn_storage_to_fire )
    deallocate(pnf%m_leafn_xfer_to_fire )
    deallocate(pnf%m_frootn_xfer_to_fire )
    deallocate(pnf%m_livestemn_xfer_to_fire )
    deallocate(pnf%m_deadstemn_xfer_to_fire )
    deallocate(pnf%m_livecrootn_xfer_to_fire )
    deallocate(pnf%m_deadcrootn_xfer_to_fire )
    deallocate(pnf%m_livestemn_to_fire )
    deallocate(pnf%m_deadstemn_to_fire )
    deallocate(pnf%m_deadstemn_to_litter_fire )
    deallocate(pnf%m_livecrootn_to_fire )
    deallocate(pnf%m_deadcrootn_to_fire )
    deallocate(pnf%m_deadcrootn_to_litter_fire )
    deallocate(pnf%m_retransn_to_fire )
    deallocate(pnf%leafn_xfer_to_leafn )
    deallocate(pnf%frootn_xfer_to_frootn )
    deallocate(pnf%livestemn_xfer_to_livestemn )
    deallocate(pnf%deadstemn_xfer_to_deadstemn )
    deallocate(pnf%livecrootn_xfer_to_livecrootn )
    deallocate(pnf%deadcrootn_xfer_to_deadcrootn )
    deallocate(pnf%leafn_to_litter ) 
    deallocate(pnf%leafn_to_retransn )
    deallocate(pnf%frootn_to_litter )
    deallocate(pnf%retransn_to_npool )
    deallocate(pnf%sminn_to_npool )
    deallocate(pnf%npool_to_leafn )
    deallocate(pnf%npool_to_leafn_storage )
    deallocate(pnf%npool_to_frootn )
    deallocate(pnf%npool_to_frootn_storage )
    deallocate(pnf%npool_to_livestemn )
    deallocate(pnf%npool_to_livestemn_storage )
    deallocate(pnf%npool_to_deadstemn )
    deallocate(pnf%npool_to_deadstemn_storage )
    deallocate(pnf%npool_to_livecrootn )
    deallocate(pnf%npool_to_livecrootn_storage )
    deallocate(pnf%npool_to_deadcrootn )
    deallocate(pnf%npool_to_deadcrootn_storage )
    deallocate(pnf%leafn_storage_to_xfer )
    deallocate(pnf%frootn_storage_to_xfer )
    deallocate(pnf%livestemn_storage_to_xfer )
    deallocate(pnf%deadstemn_storage_to_xfer )
    deallocate(pnf%livecrootn_storage_to_xfer )
    deallocate(pnf%deadcrootn_storage_to_xfer )
    deallocate(pnf%livestemn_to_deadstemn )
    deallocate(pnf%livestemn_to_retransn )
    deallocate(pnf%livecrootn_to_deadcrootn )
    deallocate(pnf%livecrootn_to_retransn )
    deallocate(pnf%ndeploy )
    deallocate(pnf%pft_ninputs )
    deallocate(pnf%pft_noutputs )
    deallocate(pnf%wood_harvestn )
    deallocate(pnf%pft_fire_nloss )
#if (defined CROP)
    deallocate(pnf%grainn_xfer_to_grainn )
    deallocate(pnf%livestemn_to_litter )
    deallocate(pnf%grainn_to_food )
    deallocate(pnf%npool_to_grainn )
    deallocate(pnf%npool_to_grainn_storage )
    deallocate(pnf%grainn_storage_to_xfer )
#endif
  end subroutine dealloc_pft_nflux_type

!------------------------------------------------------------------------
!BOP
!
! !IROUTINE: dealloc_pft_vflux_type
!
! !INTERFACE:
  subroutine dealloc_pft_vflux_type(    pvf)
!
! !DESCRIPTION:
! Initialize pft VOC flux variables
!
! !ARGUMENTS:
    implicit none
    type (pft_vflux_type), intent(inout) :: pvf
!
! !REVISION HISTORY:
! Created by Mariana Vertenstein
! (heald, 08/06)
!
!EOP
!------------------------------------------------------------------------

    deallocate(pvf%vocflx_tot )
    deallocate(pvf%vocflx)
    deallocate(pvf%vocflx_1 )
    deallocate(pvf%vocflx_2 )
    deallocate(pvf%vocflx_3 )
    deallocate(pvf%vocflx_4 )
    deallocate(pvf%vocflx_5 )
    deallocate(pvf%Eopt_out )
    deallocate(pvf%topt_out )
    deallocate(pvf%alpha_out )
    deallocate(pvf%cp_out )
    deallocate(pvf%para_out )
    deallocate(pvf%par24a_out )
    deallocate(pvf%par240a_out )
    deallocate(pvf%paru_out )
    deallocate(pvf%par24u_out )
    deallocate(pvf%par240u_out )
    deallocate(pvf%gamma_out )
    deallocate(pvf%gammaL_out )
    deallocate(pvf%gammaT_out )
    deallocate(pvf%gammaP_out )
    deallocate(pvf%gammaA_out )
    deallocate(pvf%gammaS_out )
  end subroutine dealloc_pft_vflux_type 

!------------------------------------------------------------------------
!BOP
!
! !IROUTINE: dealloc_pft_dflux_type
!
! !INTERFACE:
  subroutine dealloc_pft_dflux_type(    pdf)
!   
! !DESCRIPTION:
! Initialize pft dust flux variables
!
! !ARGUMENTS:
    implicit none
    type (pft_dflux_type), intent(inout):: pdf
!
! !REVISION HISTORY:
! Created by Mariana Vertenstein
!   
!EOP
!------------------------------------------------------------------------
    
    deallocate(pdf%flx_mss_vrt_dst)
    deallocate(pdf%flx_mss_vrt_dst_tot )
    deallocate(pdf%vlc_trb)
    deallocate(pdf%vlc_trb_1 )
    deallocate(pdf%vlc_trb_2 )
    deallocate(pdf%vlc_trb_3 )
    deallocate(pdf%vlc_trb_4 )
    
    
  end subroutine dealloc_pft_dflux_type

  subroutine dealloc_pft_depvd_type(    pdd)

!
! !DESCRIPTION:
! Initialize pft dep velocity variables
!
! !ARGUMENTS:
    implicit none
    type (pft_depvd_type), intent(inout):: pdd
!
! !REVISION HISTORY:
! Created by James Sulzman 541-929-6183
!
!EOP
!------------------------------------------------------------------------

!   if (allocated(pdd%drydepvel))  deallocate(pdd%drydepvel)

  end subroutine dealloc_pft_depvd_type

!------------------------------------------------------------------------
!BOP
!
! !IROUTINE: dealloc_column_pstate_type
!
! !INTERFACE:
  subroutine dealloc_column_pstate_type(    cps)
!
! !DESCRIPTION:
! Initialize column physical state variables
!
! !USES:
! !ARGUMENTS:
    implicit none
    type (column_pstate_type), intent(inout):: cps
!
! !REVISION HISTORY:
! Created by Mariana Vertenstein
!
!EOP
!------------------------------------------------------------------------

    deallocate(cps%snl )      !* cannot be averaged up
    deallocate(cps%isoicol )  !* cannot be averaged up
    deallocate(cps%bsw)
    deallocate(cps%watsat)
    deallocate(cps%watfc)
    deallocate(cps%watdry)
    deallocate(cps%watopt)
    deallocate(cps%hksat)
    deallocate(cps%sucsat)
    deallocate(cps%csol)
    deallocate(cps%tkmg)
    deallocate(cps%tkdry)
    deallocate(cps%tksatu)
    deallocate(cps%smpmin )
    deallocate(cps%hkdepth )
    deallocate(cps%wtfact )
    deallocate(cps%fracice)
    deallocate(cps%gwc_thr )
    deallocate(cps%mss_frc_cly_vld )
    deallocate(cps%mbl_bsn_fct )
    deallocate(cps%do_capsnow )
    deallocate(cps%snowdp )
    deallocate(cps%frac_sno  )
    deallocate(cps%zi)
    deallocate(cps%dz)
    deallocate(cps%z )
    deallocate(cps%frac_iceold)
    deallocate(cps%imelt)
    deallocate(cps%eff_porosity)
    deallocate(cps%emg )
    deallocate(cps%z0mg )
    deallocate(cps%z0hg )
    deallocate(cps%z0qg )
    deallocate(cps%htvp )
    deallocate(cps%beta )
    deallocate(cps%zii )
    deallocate(cps%albgrd)
    deallocate(cps%albgri)
    deallocate(cps%rootr_column)
    deallocate(cps%rootfr_road_perv)
    deallocate(cps%rootr_road_perv)
    deallocate(cps%wf )
!   deallocate(cps%xirrig )
    deallocate(cps%max_dayl )
    deallocate(cps%bsw2)
    deallocate(cps%psisat)
    deallocate(cps%vwcsat)
    deallocate(cps%soilpsi)
    deallocate(cps%decl )
    deallocate(cps%coszen )
    deallocate(cps%fpi )
    deallocate(cps%fpg )
    deallocate(cps%annsum_counter )
    deallocate(cps%cannsum_npp )
    deallocate(cps%cannavg_t2m )
    deallocate(cps%me )
    deallocate(cps%fire_prob )
    deallocate(cps%mean_fire_prob )
    deallocate(cps%fireseasonl )
    deallocate(cps%farea_burned )
    deallocate(cps%ann_farea_burned )
    deallocate(cps%albsnd_hst)
    deallocate(cps%albsni_hst)
    deallocate(cps%albsod)
    deallocate(cps%albsoi)
    deallocate(cps%flx_absdv)
    deallocate(cps%flx_absdn)
    deallocate(cps%flx_absiv )
    deallocate(cps%flx_absin )
    deallocate(cps%snw_rds )
    deallocate(cps%snw_rds_top )
    deallocate(cps%sno_liq_top )
    deallocate(cps%mss_bcpho )
    deallocate(cps%mss_bcphi )
    deallocate(cps%mss_bctot )
    deallocate(cps%mss_bc_col )
    deallocate(cps%mss_bc_top )
    deallocate(cps%mss_ocpho )
    deallocate(cps%mss_ocphi )
    deallocate(cps%mss_octot )
    deallocate(cps%mss_oc_col )
    deallocate(cps%mss_oc_top )
    deallocate(cps%mss_dst1 )
    deallocate(cps%mss_dst2 )
    deallocate(cps%mss_dst3 )
    deallocate(cps%mss_dst4 )
    deallocate(cps%mss_dsttot )
    deallocate(cps%mss_dst_col )
    deallocate(cps%mss_dst_top )
    deallocate(cps%h2osno_top )
    deallocate(cps%mss_cnc_bcphi )
    deallocate(cps%mss_cnc_bcpho )
    deallocate(cps%mss_cnc_ocphi )
    deallocate(cps%mss_cnc_ocpho )
    deallocate(cps%mss_cnc_dst1 )
    deallocate(cps%mss_cnc_dst2 )
    deallocate(cps%mss_cnc_dst3 )
    deallocate(cps%mss_cnc_dst4 )
    deallocate(cps%albgrd_pur )
    deallocate(cps%albgri_pur )
    deallocate(cps%albgrd_bc )
    deallocate(cps%albgri_bc )
    deallocate(cps%albgrd_oc )
    deallocate(cps%albgri_oc )
    deallocate(cps%albgrd_dst )
    deallocate(cps%albgri_dst )
    deallocate(cps%dTdz_top )
    deallocate(cps%snot_top )

  end subroutine dealloc_column_pstate_type

!------------------------------------------------------------------------
!BOP
!
! !IROUTINE: dealloc_column_estate_type
!
! !INTERFACE:
  subroutine dealloc_column_estate_type(    ces)
!
! !DESCRIPTION:
! Initialize column energy state variables
!
! !USES:
! !ARGUMENTS:
    implicit none
    type (column_estate_type), intent(inout):: ces
!
! !REVISION HISTORY:
! Created by Mariana Vertenstein
!
!EOP
!------------------------------------------------------------------------
    deallocate(ces%t_grnd )
    deallocate(ces%t_grnd_u )
    deallocate(ces%t_grnd_r )
    deallocate(ces%dt_grnd )
    deallocate(ces%t_soisno)
    deallocate(ces%t_soi_10cm )
    deallocate(ces%t_lake)
    deallocate(ces%tssbef)
    deallocate(ces%thv )
    deallocate(ces%hc_soi )
    deallocate(ces%hc_soisno )


  end subroutine dealloc_column_estate_type

!------------------------------------------------------------------------
!BOP
!
! !IROUTINE: dealloc_column_wstate_type
!
! !INTERFACE:
  subroutine dealloc_column_wstate_type(    cws)
!
! !USES:
! !ARGUMENTS:
    implicit none 
    type (column_wstate_type), intent(inout):: cws !column water state
!
! !REVISION HISTORY:
! Created by Mariana Vertenstein
!
!EOP
!------------------------------------------------------------------------
  
    deallocate(cws%h2osno )
    deallocate(cws%h2osoi_liq)
    deallocate(cws%h2osoi_ice)
    deallocate(cws%h2osoi_liqice_10cm )
    deallocate(cws%h2osoi_vol )
    deallocate(cws%h2osno_old )
    deallocate(cws%qg )
    deallocate(cws%dqgdT )
    deallocate(cws%snowice ) 
    deallocate(cws%snowliq )
    deallocate(cws%soilalpha )
    deallocate(cws%soilbeta )
    deallocate(cws%soilalpha_u )
    deallocate(cws%zwt )
    deallocate(cws%fcov )
    deallocate(cws%fsat )
    deallocate(cws%wa )
    deallocate(cws%wt )
    deallocate(cws%qcharge )
    deallocate(cws%smp_l ) 
    deallocate(cws%hk_l )
    

  end subroutine dealloc_column_wstate_type

!------------------------------------------------------------------------
!BOP
! 
! !IROUTINE: dealloc_column_cstate_type
!
! !INTERFACE:
  subroutine dealloc_column_cstate_type(    ccs)
! !DESCRIPTION:
! Initialize column carbon state variables
!
! !ARGUMENTS:
    implicit none
    type (column_cstate_type), intent(inout):: ccs
!
! !REVISION HISTORY:
! Created by Mariana Vertenstein
!
!EOP
!------------------------------------------------------------------------

    deallocate(ccs%soilc )
    deallocate(ccs%cwdc )
    deallocate(ccs%litr1c )
    deallocate(ccs%litr2c )
    deallocate(ccs%litr3c )
    deallocate(ccs%soil1c )
    deallocate(ccs%soil2c )
    deallocate(ccs%soil3c )
    deallocate(ccs%soil4c )
    deallocate(ccs%seedc )
    deallocate(ccs%col_ctrunc )
    deallocate(ccs%prod10c )
    deallocate(ccs%prod100c )
    deallocate(ccs%totprodc )
    deallocate(ccs%totlitc )
    deallocate(ccs%totsomc )
    deallocate(ccs%totecosysc )
    deallocate(ccs%totcolc )


  end subroutine dealloc_column_cstate_type

!------------------------------------------------------------------------
!BOP
!
! !IROUTINE: dealloc_column_nstate_type
!
! !INTERFACE:
  subroutine dealloc_column_nstate_type(    cns)
!
! !DESCRIPTION:
! Initialize column nitrogen state variables
!
! !ARGUMENTS:
    implicit none
    type (column_nstate_type), intent(inout):: cns
!
! !REVISION HISTORY:
! Created by Peter Thornton  
!   
!EOP
!------------------------------------------------------------------------

    deallocate(cns%cwdn )
    deallocate(cns%litr1n )
    deallocate(cns%litr2n )
    deallocate(cns%litr3n )
    deallocate(cns%soil1n )
    deallocate(cns%soil2n )
    deallocate(cns%soil3n )
    deallocate(cns%soil4n )
    deallocate(cns%sminn )
    deallocate(cns%col_ntrunc )
    deallocate(cns%seedn )
    deallocate(cns%prod10n )
    deallocate(cns%prod100n )
    deallocate(cns%totprodn )
    deallocate(cns%totlitn )
    deallocate(cns%totsomn )
    deallocate(cns%totecosysn )
    deallocate(cns%totcoln )
    
    
  end subroutine dealloc_column_nstate_type
    
!------------------------------------------------------------------------
!BOP
! 
! !IROUTINE: dealloc_column_eflux_type
!
! !INTERFACE:
  subroutine dealloc_column_eflux_type(    cef)
!
! !DESCRIPTION:
! Initialize column energy flux variables
! 
! !ARGUMENTS:
    implicit none
    type (column_eflux_type), intent(inout):: cef
! !REVISION HISTORY:
! Created by Mariana Vertenstein
!
!EOP
!------------------------------------------------------------------------

    deallocate(cef%eflx_snomelt )
    deallocate(cef%eflx_snomelt_u )
    deallocate(cef%eflx_snomelt_r )
    deallocate(cef%eflx_impsoil )
    deallocate(cef%eflx_fgr12 )
    deallocate(cef%eflx_building_heat )
    deallocate(cef%eflx_urban_ac )
    deallocate(cef%eflx_urban_heat )


  end subroutine dealloc_column_eflux_type

!------------------------------------------------------------------------
!BOP
!
! !IROUTINE: dealloc_column_wflux_type
!
! !INTERFACE:
  subroutine dealloc_column_wflux_type(    cwf)
!
! !DESCRIPTION:
! Initialize column water flux variables
!
! !USES:
! !ARGUMENTS:
    implicit none
    type (column_wflux_type), intent(inout):: cwf
!
! !REVISION HISTORY:
! Created by Mariana Vertenstein
!
!EOP
!------------------------------------------------------------------------

    deallocate(cwf%qflx_infl )
    deallocate(cwf%qflx_surf )
    deallocate(cwf%qflx_drain )
    deallocate(cwf%qflx_top_soil )
    deallocate(cwf%qflx_snomelt )
    deallocate(cwf%qflx_qrgwl )
    deallocate(cwf%qflx_runoff )
    deallocate(cwf%qflx_runoff_u )
    deallocate(cwf%qflx_runoff_r )
    deallocate(cwf%qmelt )
    deallocate(cwf%h2ocan_loss )
    deallocate(cwf%qflx_rsub_sat )
    deallocate(cwf%flx_bc_dep_dry )
    deallocate(cwf%flx_bc_dep_wet )
    deallocate(cwf%flx_bc_dep_pho )
    deallocate(cwf%flx_bc_dep_phi )
    deallocate(cwf%flx_bc_dep )
    deallocate(cwf%flx_oc_dep_dry )
    deallocate(cwf%flx_oc_dep_wet )
    deallocate(cwf%flx_oc_dep_pho )
    deallocate(cwf%flx_oc_dep_phi )
    deallocate(cwf%flx_oc_dep )
    deallocate(cwf%flx_dst_dep_dry1 )
    deallocate(cwf%flx_dst_dep_wet1 )
    deallocate(cwf%flx_dst_dep_dry2 )
    deallocate(cwf%flx_dst_dep_wet2 )
    deallocate(cwf%flx_dst_dep_dry3 )
    deallocate(cwf%flx_dst_dep_wet3 ) 
    deallocate(cwf%flx_dst_dep_dry4 )
    deallocate(cwf%flx_dst_dep_wet4 )
    deallocate(cwf%flx_dst_dep )
    deallocate(cwf%qflx_snofrz_lyr)
    
  end subroutine dealloc_column_wflux_type
    
!------------------------------------------------------------------------
!BOP
!   
! !IROUTINE: dealloc_column_cflux_type
!   
! !INTERFACE:
  subroutine dealloc_column_cflux_type(    ccf)
!   
! !DESCRIPTION:
! Initialize column carbon flux variables
!   
! !ARGUMENTS:
    implicit none
    type (column_cflux_type), intent(inout):: ccf
!
! !REVISION HISTORY:
! Created by Peter Thornton
!
!EOP
!------------------------------------------------------------------------

    deallocate(ccf%m_leafc_to_litr1c )
    deallocate(ccf%m_leafc_to_litr2c )
    deallocate(ccf%m_leafc_to_litr3c )
    deallocate(ccf%m_frootc_to_litr1c )
    deallocate(ccf%m_frootc_to_litr2c )
    deallocate(ccf%m_frootc_to_litr3c )
    deallocate(ccf%m_leafc_storage_to_litr1c )
    deallocate(ccf%m_frootc_storage_to_litr1c )
    deallocate(ccf%m_livestemc_storage_to_litr1c )
    deallocate(ccf%m_deadstemc_storage_to_litr1c )
    deallocate(ccf%m_livecrootc_storage_to_litr1c )
    deallocate(ccf%m_deadcrootc_storage_to_litr1c )
    deallocate(ccf%m_leafc_xfer_to_litr1c )
    deallocate(ccf%m_frootc_xfer_to_litr1c )
    deallocate(ccf%m_livestemc_xfer_to_litr1c )
    deallocate(ccf%m_deadstemc_xfer_to_litr1c )
    deallocate(ccf%m_livecrootc_xfer_to_litr1c )
    deallocate(ccf%m_deadcrootc_xfer_to_litr1c )
    deallocate(ccf%m_livestemc_to_cwdc )
    deallocate(ccf%m_deadstemc_to_cwdc )
    deallocate(ccf%m_livecrootc_to_cwdc )
    deallocate(ccf%m_deadcrootc_to_cwdc )
    deallocate(ccf%m_gresp_storage_to_litr1c )
    deallocate(ccf%m_gresp_xfer_to_litr1c )
    deallocate(ccf%m_deadstemc_to_cwdc_fire )
    deallocate(ccf%m_deadcrootc_to_cwdc_fire )
    deallocate(ccf%hrv_leafc_to_litr1c )
    deallocate(ccf%hrv_leafc_to_litr2c )
    deallocate(ccf%hrv_leafc_to_litr3c )
    deallocate(ccf%hrv_frootc_to_litr1c )
    deallocate(ccf%hrv_frootc_to_litr2c )
    deallocate(ccf%hrv_frootc_to_litr3c )
    deallocate(ccf%hrv_livestemc_to_cwdc )
    deallocate(ccf%hrv_deadstemc_to_prod10c )
    deallocate(ccf%hrv_deadstemc_to_prod100c )
    deallocate(ccf%hrv_livecrootc_to_cwdc )
    deallocate(ccf%hrv_deadcrootc_to_cwdc )
    deallocate(ccf%hrv_leafc_storage_to_litr1c )
    deallocate(ccf%hrv_frootc_storage_to_litr1c )
    deallocate(ccf%hrv_livestemc_storage_to_litr1c )
    deallocate(ccf%hrv_deadstemc_storage_to_litr1c )
    deallocate(ccf%hrv_livecrootc_storage_to_litr1c )
    deallocate(ccf%hrv_deadcrootc_storage_to_litr1c )
    deallocate(ccf%hrv_gresp_storage_to_litr1c )
    deallocate(ccf%hrv_leafc_xfer_to_litr1c )
    deallocate(ccf%hrv_frootc_xfer_to_litr1c )
    deallocate(ccf%hrv_livestemc_xfer_to_litr1c )
    deallocate(ccf%hrv_deadstemc_xfer_to_litr1c )
    deallocate(ccf%hrv_livecrootc_xfer_to_litr1c )
    deallocate(ccf%hrv_deadcrootc_xfer_to_litr1c )
    deallocate(ccf%hrv_gresp_xfer_to_litr1c )
    deallocate(ccf%m_litr1c_to_fire )
    deallocate(ccf%m_litr2c_to_fire )
    deallocate(ccf%m_litr3c_to_fire )
    deallocate(ccf%m_cwdc_to_fire )
#if (defined CROP)
    deallocate(ccf%grainc_to_litr1c )
    deallocate(ccf%grainc_to_litr2c )
    deallocate(ccf%grainc_to_litr3c )
    deallocate(ccf%livestemc_to_litr1c )
    deallocate(ccf%livestemc_to_litr2c )
    deallocate(ccf%livestemc_to_litr3c )
#endif
    deallocate(ccf%leafc_to_litr1c )
    deallocate(ccf%leafc_to_litr2c )
    deallocate(ccf%leafc_to_litr3c )
    deallocate(ccf%frootc_to_litr1c )
    deallocate(ccf%frootc_to_litr2c )
    deallocate(ccf%frootc_to_litr3c )
    deallocate(ccf%cwdc_to_litr2c )
    deallocate(ccf%cwdc_to_litr3c )
    deallocate(ccf%litr1_hr )
    deallocate(ccf%litr1c_to_soil1c )
    deallocate(ccf%litr2_hr )
    deallocate(ccf%litr2c_to_soil2c )
    deallocate(ccf%litr3_hr )
    deallocate(ccf%litr3c_to_soil3c )
    deallocate(ccf%soil1_hr )
    deallocate(ccf%soil1c_to_soil2c )
    deallocate(ccf%soil2_hr )
    deallocate(ccf%soil2c_to_soil3c )
    deallocate(ccf%soil3_hr )
    deallocate(ccf%soil3c_to_soil4c )
    deallocate(ccf%soil4_hr )
#ifdef CN
    deallocate(ccf%dwt_seedc_to_leaf ) 
    deallocate(ccf%dwt_seedc_to_deadstem )
    deallocate(ccf%dwt_conv_cflux )
    deallocate(ccf%dwt_prod10c_gain )
    deallocate(ccf%dwt_prod100c_gain )
    deallocate(ccf%dwt_frootc_to_litr1c )
    deallocate(ccf%dwt_frootc_to_litr2c )
    deallocate(ccf%dwt_frootc_to_litr3c )
    deallocate(ccf%dwt_livecrootc_to_cwdc )
    deallocate(ccf%dwt_deadcrootc_to_cwdc )
    deallocate(ccf%dwt_closs )
    deallocate(ccf%landuseflux )
    deallocate(ccf%landuptake )
    deallocate(ccf%prod10c_loss )
    deallocate(ccf%prod100c_loss )
    deallocate(ccf%product_closs )
#endif
    deallocate(ccf%lithr )
    deallocate(ccf%somhr )
    deallocate(ccf%hr )
    deallocate(ccf%sr )
    deallocate(ccf%er )
    deallocate(ccf%litfire )
    deallocate(ccf%somfire )
    deallocate(ccf%totfire )
    deallocate(ccf%nep )
    deallocate(ccf%nbp )
    deallocate(ccf%nee )
    deallocate(ccf%col_cinputs )
    deallocate(ccf%col_coutputs )
    deallocate(ccf%col_fire_closs )
    
#if (defined CLAMP) && (defined CN) 
    !CLAMP
    deallocate(ccf%cwdc_hr )
    deallocate(ccf%cwdc_loss )
    deallocate(ccf%litterc_loss )
#endif
    
 end subroutine dealloc_column_cflux_type




  subroutine dealloc_column_nflux_type(    cnf)
!
! !DESCRIPTION:
! Initialize column nitrogen flux variables
!
! !ARGUMENTS:
    implicit none
    type (column_nflux_type), intent(inout):: cnf
!
! !REVISION HISTORY:
! Created by Peter Thornton
!
!EOP
!------------------------------------------------------------------------

    deallocate(cnf%ndep_to_sminn )
    deallocate(cnf%nfix_to_sminn )
    deallocate(cnf%m_leafn_to_litr1n )
    deallocate(cnf%m_leafn_to_litr2n )
    deallocate(cnf%m_leafn_to_litr3n )
    deallocate(cnf%m_frootn_to_litr1n )
    deallocate(cnf%m_frootn_to_litr2n )
    deallocate(cnf%m_frootn_to_litr3n )
    deallocate(cnf%m_leafn_storage_to_litr1n )
    deallocate(cnf%m_frootn_storage_to_litr1n )
    deallocate(cnf%m_livestemn_storage_to_litr1n )
    deallocate(cnf%m_deadstemn_storage_to_litr1n )
    deallocate(cnf%m_livecrootn_storage_to_litr1n )
    deallocate(cnf%m_deadcrootn_storage_to_litr1n )
    deallocate(cnf%m_leafn_xfer_to_litr1n )
    deallocate(cnf%m_frootn_xfer_to_litr1n )
    deallocate(cnf%m_livestemn_xfer_to_litr1n )
    deallocate(cnf%m_deadstemn_xfer_to_litr1n )
    deallocate(cnf%m_livecrootn_xfer_to_litr1n )
    deallocate(cnf%m_deadcrootn_xfer_to_litr1n )
    deallocate(cnf%m_livestemn_to_cwdn )
    deallocate(cnf%m_deadstemn_to_cwdn )
    deallocate(cnf%m_livecrootn_to_cwdn )
    deallocate(cnf%m_deadcrootn_to_cwdn )
    deallocate(cnf%m_retransn_to_litr1n )
    deallocate(cnf%hrv_leafn_to_litr1n )
    deallocate(cnf%hrv_leafn_to_litr2n )
    deallocate(cnf%hrv_leafn_to_litr3n )
    deallocate(cnf%hrv_frootn_to_litr1n )
    deallocate(cnf%hrv_frootn_to_litr2n )
    deallocate(cnf%hrv_frootn_to_litr3n )
    deallocate(cnf%hrv_livestemn_to_cwdn )
    deallocate(cnf%hrv_deadstemn_to_prod10n )
    deallocate(cnf%hrv_deadstemn_to_prod100n )
    deallocate(cnf%hrv_livecrootn_to_cwdn )
    deallocate(cnf%hrv_deadcrootn_to_cwdn )
    deallocate(cnf%hrv_retransn_to_litr1n )
    deallocate(cnf%hrv_leafn_storage_to_litr1n )
    deallocate(cnf%hrv_frootn_storage_to_litr1n )
    deallocate(cnf%hrv_livestemn_storage_to_litr1n )
    deallocate(cnf%hrv_deadstemn_storage_to_litr1n )
    deallocate(cnf%hrv_livecrootn_storage_to_litr1n )
    deallocate(cnf%hrv_deadcrootn_storage_to_litr1n )
    deallocate(cnf%hrv_leafn_xfer_to_litr1n )
    deallocate(cnf%hrv_frootn_xfer_to_litr1n )
    deallocate(cnf%hrv_livestemn_xfer_to_litr1n )
    deallocate(cnf%hrv_deadstemn_xfer_to_litr1n )
    deallocate(cnf%hrv_livecrootn_xfer_to_litr1n )
    deallocate(cnf%hrv_deadcrootn_xfer_to_litr1n )
    deallocate(cnf%m_deadstemn_to_cwdn_fire )
    deallocate(cnf%m_deadcrootn_to_cwdn_fire )
    deallocate(cnf%m_litr1n_to_fire )
    deallocate(cnf%m_litr2n_to_fire )
    deallocate(cnf%m_litr3n_to_fire )
    deallocate(cnf%m_cwdn_to_fire )
#if (defined CROP)
    deallocate(cnf%grainn_to_litr1n )
    deallocate(cnf%grainn_to_litr2n )
    deallocate(cnf%grainn_to_litr3n )
    deallocate(cnf%livestemn_to_litr1n )
    deallocate(cnf%livestemn_to_litr2n )
    deallocate(cnf%livestemn_to_litr3n )
#endif
    deallocate(cnf%leafn_to_litr1n )
    deallocate(cnf%leafn_to_litr2n )
    deallocate(cnf%leafn_to_litr3n )
    deallocate(cnf%frootn_to_litr1n )
    deallocate(cnf%frootn_to_litr2n )
    deallocate(cnf%frootn_to_litr3n )
    deallocate(cnf%cwdn_to_litr2n )
    deallocate(cnf%cwdn_to_litr3n )
    deallocate(cnf%litr1n_to_soil1n ) 
    deallocate(cnf%sminn_to_soil1n_l1 )
    deallocate(cnf%litr2n_to_soil2n ) 
    deallocate(cnf%sminn_to_soil2n_l2 )
    deallocate(cnf%litr3n_to_soil3n )
    deallocate(cnf%sminn_to_soil3n_l3 )
    deallocate(cnf%soil1n_to_soil2n )
    deallocate(cnf%sminn_to_soil2n_s1 )
    deallocate(cnf%soil2n_to_soil3n )
    deallocate(cnf%sminn_to_soil3n_s2 )
    deallocate(cnf%soil3n_to_soil4n )
    deallocate(cnf%sminn_to_soil4n_s3 )
    deallocate(cnf%soil4n_to_sminn )
    deallocate(cnf%sminn_to_denit_l1s1 )
    deallocate(cnf%sminn_to_denit_l2s2 )
    deallocate(cnf%sminn_to_denit_l3s3 )
    deallocate(cnf%sminn_to_denit_s1s2 )
    deallocate(cnf%sminn_to_denit_s2s3 )
    deallocate(cnf%sminn_to_denit_s3s4 )
    deallocate(cnf%sminn_to_denit_s4 )
    deallocate(cnf%sminn_to_denit_excess )
    deallocate(cnf%sminn_leached )
    deallocate(cnf%dwt_seedn_to_leaf ) 
    deallocate(cnf%dwt_seedn_to_deadstem )
    deallocate(cnf%dwt_conv_nflux )
    deallocate(cnf%dwt_prod10n_gain )
    deallocate(cnf%dwt_prod100n_gain )
    deallocate(cnf%dwt_frootn_to_litr1n )
    deallocate(cnf%dwt_frootn_to_litr2n )
    deallocate(cnf%dwt_frootn_to_litr3n ) 
    deallocate(cnf%dwt_livecrootn_to_cwdn )
    deallocate(cnf%dwt_deadcrootn_to_cwdn )
    deallocate(cnf%dwt_nloss )
    deallocate(cnf%prod10n_loss )
    deallocate(cnf%prod100n_loss )
    deallocate(cnf%product_nloss )
    deallocate(cnf%potential_immob )
    deallocate(cnf%actual_immob )
    deallocate(cnf%sminn_to_plant )
    deallocate(cnf%supplement_to_sminn )
    deallocate(cnf%gross_nmin )
    deallocate(cnf%net_nmin )
    deallocate(cnf%denit )
    deallocate(cnf%col_ninputs )
    deallocate(cnf%col_noutputs )
   deallocate(cnf%col_fire_nloss )

  end subroutine dealloc_column_nflux_type
    
!------------------------------------------------------------------------
!BOP
!   
! !IROUTINE: dealloc_landunit_pstate_type
!   
! !INTERFACE:
  subroutine dealloc_landunit_pstate_type(    lps)
!   
! !ARGUMENTS:
    implicit none
    type (landunit_pstate_type), intent(inout):: lps
!
! !REVISION HISTORY:
! Created by Mariana Vertenstein
!
!EOP
!------------------------------------------------------------------------

    deallocate(lps%t_building )
    deallocate(lps%t_building_max )
    deallocate(lps%t_building_min )
    deallocate(lps%tk_wall)
    deallocate(lps%tk_roof)
    deallocate(lps%tk_improad)
    deallocate(lps%cv_wall)
    deallocate(lps%cv_roof)
    deallocate(lps%cv_improad)
    deallocate(lps%thick_wall )
    deallocate(lps%thick_roof )
    deallocate(lps%nlev_improad )
    deallocate(lps%vf_sr )
    deallocate(lps%vf_wr )
    deallocate(lps%vf_sw )
    deallocate(lps%vf_rw )
    deallocate(lps%vf_ww )
    deallocate(lps%taf )
    deallocate(lps%qaf )
    deallocate(lps%sabs_roof_dir )
    deallocate(lps%sabs_roof_dif )
    deallocate(lps%sabs_sunwall_dir )
    deallocate(lps%sabs_sunwall_dif )
    deallocate(lps%sabs_shadewall_dir )
    deallocate(lps%sabs_shadewall_dif )
    deallocate(lps%sabs_improad_dir )
    deallocate(lps%sabs_improad_dif )
    deallocate(lps%sabs_perroad_dir )
    deallocate(lps%sabs_perroad_dif )
  end subroutine dealloc_landunit_pstate_type

!------------------------------------------------------------------------
!BOP
!
! !IROUTINE: dealloc_landunit_eflux_type
!   
! !INTERFACE:
  subroutine dealloc_landunit_eflux_type(    lef)
!   
! !DESCRIPTION: 
! Initialize landunit energy flux variables
!   
! !ARGUMENTS:
    implicit none
    type (landunit_eflux_type), intent(inout):: lef
!   
! !REVISION HISTORY:
! Created by Keith Oleson
!   
!EOP
!------------------------------------------------------------------------
    
    deallocate(lef%eflx_traffic )
    deallocate(lef%eflx_traffic_factor )
    deallocate(lef%eflx_wasteheat ) 
    deallocate(lef%eflx_heat_from_ac )
    
    
  end subroutine dealloc_landunit_eflux_type

#if (defined CNDV)
!------------------------------------------------------------------------
!BOP
!   
! !IROUTINE: dealloc_gridcell_dgvstate_type
!   
! !INTERFACE:
  subroutine dealloc_gridcell_dgvstate_type(    gps)
!   
! !DESCRIPTION:
! Initialize gridcell DGVM variables
!   
! !ARGUMENTS:  
    implicit none
    type (gridcell_dgvstate_type), intent(inout):: gps
!   
! !REVISION HISTORY:
! Created by Mariana Vertenstein
!   
!EOP
!------------------------------------------------------------------------
    
    deallocate(gps%agdd20 )
    deallocate(gps%tmomin20 )
    deallocate(gps%t10min )

  end subroutine dealloc_gridcell_dgvstate_type
#endif

!------------------------------------------------------------------------
!BOP
!
! !IROUTINE: dealloc_gridcell_pstate_type
!
! !INTERFACE:
  subroutine dealloc_gridcell_pstate_type(    gps)
!
! !DESCRIPTION:
! Initialize gridcell physical state variables
!
! !ARGUMENTS:
    implicit none
    type (gridcell_pstate_type), intent(inout):: gps
!
! !REVISION HISTORY:
! Created by Mariana Vertenstein
!
!EOP
!------------------------------------------------------------------------



  end subroutine dealloc_gridcell_pstate_type



 subroutine dealloc_gridcell_efstate_type(    gve)
!
! !DESCRIPTION:
! Initialize gridcell isoprene emission factor variables
!
! !ARGUMENTS:
    implicit none
    type (gridcell_efstate_type), intent(inout) :: gve
!
! !REVISION HISTORY:
! Created by Mariana Vertenstein (heald)
!
!EOP
!------------------------------------------------------------------------

    deallocate(gve%efisop)
    
  end subroutine dealloc_gridcell_efstate_type

!------------------------------------------------------------------------
!BOP
!
! !IROUTINE: dealloc_gridcell_wflux_type
!
! !INTERFACE:
  subroutine dealloc_gridcell_wflux_type(    gwf)
!
! !DESCRIPTION:
! Initialize gridcell water flux variables
!   
! !ARGUMENTS:
    implicit none
    type (gridcell_wflux_type), intent(inout):: gwf
!   
! !REVISION HISTORY:
! Created by Mariana Vertenstein
!   
!EOP
!------------------------------------------------------------------------

    deallocate(gwf%qflx_runoffg )
    deallocate(gwf%qflx_snwcp_iceg )
    deallocate(gwf%qflx_liq_dynbal )
    deallocate(gwf%qflx_ice_dynbal )
    
    
  end subroutine dealloc_gridcell_wflux_type
    
!------------------------------------------------------------------------
!BOP
!
! !IROUTINE: dealloc_gridcell_eflux_type
!
 !INTERFACE:
  subroutine dealloc_gridcell_eflux_type(    gef)
!
! !DESCRIPTION:
! Initialize gridcell energy flux variables
!
! !ARGUMENTS:
    implicit none
    type (gridcell_eflux_type), intent(inout):: gef
!
! !REVISION HISTORY:
! Created by David Lawrence
!
!EOP
!------------------------------------------------------------------------
    deallocate(gef%eflx_sh_totg )
    deallocate(gef%eflx_dynbal )


  end subroutine dealloc_gridcell_eflux_type

!------------------------------------------------------------------------
!BOP
!
! !IROUTINE: dealloc_gridcell_wstate_type
!
! !INTERFACE:
  subroutine dealloc_gridcell_wstate_type(    gws)
!
! !DESCRIPTION:
! Initialize gridcell water state variables
!
! !ARGUMENTS:
    implicit none
    type (gridcell_wstate_type), intent(inout):: gws
!
! !REVISION HISTORY:
! Created by David Lawrence
!
!EOP
!------------------------------------------------------------------------
    deallocate(gws%gc_liq1 )
    deallocate(gws%gc_liq2 )
    deallocate(gws%gc_ice1 )
    deallocate(gws%gc_ice2 )


  end subroutine dealloc_gridcell_wstate_type

!------------------------------------------------------------------------
!BOP
!
! !IROUTINE: dealloc_gridcell_estate_type
!
! !INTERFACE:
  subroutine dealloc_gridcell_estate_type(    ges)
! !DESCRIPTION:
! Initialize gridcell energy state variables     
! 
! !ARGUMENTS:
    implicit none
    type (gridcell_estate_type), intent(inout):: ges
!
! !REVISION HISTORY:
! Created by David Lawrence  
!   
!EOP
!------------------------------------------------------------------------
    deallocate(ges%gc_heat1 )
    deallocate(ges%gc_heat2 )

    
  end subroutine dealloc_gridcell_estate_type

   
   subroutine dealloc_atm2lnd_type(a2l)
    implicit none
  type (atm2lnd_type), intent(inout):: a2l
!
! !REVISION HISTORY:
! Created by Mariana Vertenstein
! Modified by T Craig, 11/01/05 for finemesh project
!
!
! !LOCAL VARIABLES:
!EOP
!------------------------------------------------------------------------

  deallocate(a2l%forc_t)
  deallocate(a2l%forc_u)
  deallocate(a2l%forc_v)
  deallocate(a2l%forc_wind)
  deallocate(a2l%forc_q)
  deallocate(a2l%forc_rh)
  deallocate(a2l%forc_hgt)
  deallocate(a2l%forc_hgt_u)
  deallocate(a2l%forc_hgt_t)
  deallocate(a2l%forc_hgt_q)
  deallocate(a2l%forc_pbot)
  deallocate(a2l%forc_th)
  deallocate(a2l%forc_vp)
  deallocate(a2l%forc_rho)
  deallocate(a2l%forc_psrf)
  deallocate(a2l%forc_pco2)
  deallocate(a2l%forc_lwrad)
  deallocate(a2l%forc_solad)
  deallocate(a2l%forc_solai)
  deallocate(a2l%forc_solar)
  deallocate(a2l%forc_rain)
  deallocate(a2l%forc_snow)
  deallocate(a2l%forc_ndep)
  deallocate(a2l%rainf)
#if (defined C13)
  ! 4/14/05: PET
  ! Adding isotope code
  deallocate(a2l%forc_pc13o2)
#endif
  deallocate(a2l%forc_po2)
  deallocate(a2l%forc_aer)

 end  subroutine dealloc_atm2lnd_type                                               




end module clmtypeInitMod
module pftvarcon

!----------------------------------------------------------------------- 
!BOP
!
! !MODULE: pftvarcon
! 
! !DESCRIPTION: 
! Module containing vegetation constants and method to 
! eads and initialize vegetation (PFT) constants.
!
! !USES:
  use shr_kind_mod, only: r8 => shr_kind_r8
  use clm_varpar,only : numpft, numrad

!
! !PUBLIC TYPES:
  implicit none
  save
!
! Vegetation type constants
!ylu add
! Set specific vegetation type values



  integer,parameter :: noveg                  = 0                 !value for not vegetated 
  integer,parameter :: ndllf_evr_tmp_tree     = 1  !value for Needleleaf evergreen temperate tree
  integer,parameter :: ndllf_evr_brl_tree     = 2  !value for Needleleaf evergreen boreal tree
  integer,parameter :: ndllf_dcd_brl_tree     = 3  !value for Needleleaf deciduous boreal tree
  integer,parameter :: nbrdlf_evr_trp_tree    = 4  !value for Broadleaf evergreen tropical tree
  integer,parameter :: nbrdlf_evr_tmp_tree    = 5  !value for Broadleaf evergreen temperate tree
  integer,parameter :: nbrdlf_dcd_trp_tree    = 6  !value for Broadleaf deciduous tropical tree
  integer,parameter :: nbrdlf_dcd_tmp_tree    = 7  !value for Broadleaf deciduous temperate tree
  integer,parameter :: nbrdlf_dcd_brl_tree    = 8  !value for Broadleaf deciduous boreal tree
  integer :: ntree                  !value for last type of tree
  integer,parameter :: nbrdlf_evr_shrub       = 9  !value for Broadleaf evergreen shrub
  integer,parameter :: nbrdlf_dcd_tmp_shrub   = 10 !value for Broadleaf deciduous temperate shrub
  integer,parameter :: nbrdlf_dcd_brl_shrub   = 11 !value for Broadleaf deciduous boreal shrub
  integer,parameter :: nc3_arctic_grass       = 12 !value for C3 arctic grass
  integer,parameter :: nc3_nonarctic_grass    = 13 !value for C3 non-arctic grass
  integer,parameter :: nc4_grass              = 14 !value for C4 grass
  integer,parameter :: nc3crop                = 15 !value for generic C3 crop
  integer,parameter :: nc4crop                = 16 !value for generic C4 crop
#if (defined CROP)
  integer :: npcropmin              !value for first crop
  integer,parameter :: ncorn                  = 17 !value for corn
  integer,parameter :: nswheat                = 18 !value for spring wheat
  integer,parameter :: nwwheat                = 19 !value for winter wheat
  integer,parameter :: nsoybean               = 20 !value for soybean
  integer :: npcropmax              !value for last prognostic crop in list
  real(r8):: mxtmp(0:numpft)        !parameter used in accFlds
  real(r8):: baset(0:numpft)        !parameter used in accFlds
  real(r8):: declfact(0:numpft)     !parameter used in CNAllocation
  real(r8):: bfact(0:numpft)        !parameter used in CNAllocation
  real(r8):: aleaff(0:numpft)       !parameter used in CNAllocation
  real(r8):: arootf(0:numpft)       !parameter used in CNAllocation
  real(r8):: astemf(0:numpft)       !parameter used in CNAllocation
  real(r8):: arooti(0:numpft)       !parameter used in CNAllocation
  real(r8):: fleafi(0:numpft)       !parameter used in CNAllocation
  real(r8):: allconsl(0:numpft)     !parameter used in CNAllocation
  real(r8):: allconss(0:numpft)     !parameter used in CNAllocation
  real(r8):: ztopmx(0:numpft)       !parameter used in CNVegStructUpdate
  real(r8):: laimx(0:numpft)        !parameter used in CNVegStructUpdate
  real(r8):: gddmin(0:numpft)       !parameter used in CNPhenology
  real(r8):: hybgdd(0:numpft)       !parameter used in CNPhenology
  real(r8):: lfemerg(0:numpft)      !parameter used in CNPhenology
  real(r8):: grnfill(0:numpft)      !parameter used in CNPhenology
  integer :: mxmat(0:numpft)        !parameter used in CNPhenology
#endif

  real(r8):: crop(0:numpft)        ! crop pft: 0. = not crop, 1. = crop pft

!-----------------------------------------------------------------------
  character(len=40) pftname(0:numpft)
  real(r8):: dleaf(0:numpft)       !characteristic leaf dimension (m)
  real(r8):: c3psn(0:numpft)       !photosynthetic pathway: 0. = c4, 1. = c3
  real(r8):: vcmx25(0:numpft)      !max rate of carboxylation at 25C (umol CO2/m**2/s)
  real(r8):: mp(0:numpft)          !slope of conductance-to-photosynthesis relationship
  real(r8):: qe25(0:numpft)        !quantum efficiency at 25C (umol CO2 / umol photon)
  real(r8):: xl(0:numpft)          !leaf/stem orientation index
  real(r8):: rhol(0:numpft,numrad) !leaf reflectance: 1=vis, 2=nir
  real(r8):: rhos(0:numpft,numrad) !stem reflectance: 1=vis, 2=nir
  real(r8):: taul(0:numpft,numrad) !leaf transmittance: 1=vis, 2=nir
  real(r8):: taus(0:numpft,numrad) !stem transmittance: 1=vis, 2=nir
  real(r8):: z0mr(0:numpft)        !ratio of momentum roughness length to canopy top height (-)
  real(r8):: displar(0:numpft)     !ratio of displacement height to canopy top height (-)
  real(r8):: roota_par(0:numpft)   !CLM rooting distribution parameter [1/m]
  real(r8):: rootb_par(0:numpft)   !CLM rooting distribution parameter [1/m]
  real(r8):: slatop(0:numpft)      !SLA at top of canopy [m^2/gC]
  real(r8):: dsladlai(0:numpft)    !dSLA/dLAI [m^2/gC]
  real(r8):: leafcn(0:numpft)      !leaf C:N [gC/gN]
  real(r8):: flnr(0:numpft)        !fraction of leaf N in Rubisco [no units]
  real(r8):: smpso(0:numpft)       !soil water potential at full stomatal opening (mm)
  real(r8):: smpsc(0:numpft)       !soil water potential at full stomatal closure (mm)
  real(r8):: fnitr(0:numpft)       !foliage nitrogen limitation factor (-)
  real(r8):: woody(0:numpft)       !woody lifeform flag (0 or 1)
  real(r8):: lflitcn(0:numpft)      !leaf litter C:N (gC/gN)
  real(r8):: frootcn(0:numpft)      !fine root C:N (gC/gN)
  real(r8):: livewdcn(0:numpft)     !live wood (phloem and ray parenchyma) C:N (gC/gN)
  real(r8):: deadwdcn(0:numpft)     !dead wood (xylem and heartwood) C:N (gC/gN)
  real(r8):: froot_leaf(0:numpft)   !allocation parameter: new fine root C per new leaf C (gC/gC) 
  real(r8):: stem_leaf(0:numpft)    !allocation parameter: new stem c per new leaf C (gC/gC)
  real(r8):: croot_stem(0:numpft)   !allocation parameter: new coarse root C per new stem C (gC/gC)
  real(r8):: flivewd(0:numpft)      !allocation parameter: fraction of new wood that is live (phloem and ray parenchyma) (no units)
  real(r8):: fcur(0:numpft)         !allocation parameter: fraction of allocation that goes to currently displayed growth, remainder to storage
  real(r8):: lf_flab(0:numpft)      !leaf litter labile fraction
  real(r8):: lf_fcel(0:numpft)      !leaf litter cellulose fraction
  real(r8):: lf_flig(0:numpft)      !leaf litter lignin fraction
  real(r8):: fr_flab(0:numpft)      !fine root litter labile fraction
  real(r8):: fr_fcel(0:numpft)      !fine root litter cellulose fraction
  real(r8):: fr_flig(0:numpft)      !fine root litter lignin fraction
  real(r8):: dw_fcel(0:numpft)      !dead wood cellulose fraction
  real(r8):: dw_flig(0:numpft)      !dead wood lignin fraction
  real(r8):: leaf_long(0:numpft)    !leaf longevity (yrs)
  real(r8):: evergreen(0:numpft)    !binary flag for evergreen leaf habit (0 or 1)
  real(r8):: stress_decid(0:numpft) !binary flag for stress-deciduous leaf habit (0 or 1)
  real(r8):: season_decid(0:numpft) !binary flag for seasonal-deciduous leaf habit (0 or 1)
  ! new pft parameters for CN-fire code
  real(r8):: resist(0:numpft)       !resistance to fire (no units)
  real(r8):: pftpar20(0:numpft)       !tree maximum crown area (m2)
  real(r8):: pftpar28(0:numpft)       !min coldest monthly mean temperature
  real(r8):: pftpar29(0:numpft)       !max coldest monthly mean temperature
  real(r8):: pftpar30(0:numpft)       !min growing degree days (>= 5 deg C)
  real(r8):: pftpar31(0:numpft)       !upper limit of temperature of the warmest month (twmax)
  ! for crop
  real(r8):: graincn(0:numpft)      !grain C:N (gC/gN)
 

  real(r8), parameter :: reinickerp = 1.6_r8 !parameter in allometric equation
  real(r8), parameter :: dwood  = 2.5e5_r8   !cn wood density (gC/m3); lpj:2.0e5
  real(r8), parameter :: allom1 = 100.0_r8   !parameters in
  real(r8), parameter :: allom2 =  40.0_r8   !...allometric
  real(r8), parameter :: allom3 =   0.5_r8   !...equations
  real(r8), parameter :: allom1s = 250.0_r8  !modified for shrubs by
  real(r8), parameter :: allom2s =   8.0_r8  !X.D.Z



! Created by Sam Levis (put into module form by Mariana Vertenstein)

    character(len=40) expected_pftnames(0:numpft) 

    integer, private :: i  ! loop index





   data (expected_pftnames(i),i=1,numpft) / &
                 'needleleaf_evergreen_temperate_tree'  &
               , 'needleleaf_evergreen_boreal_tree   '  &
               , 'needleleaf_deciduous_boreal_tree   '  &
               , 'broadleaf_evergreen_tropical_tree  '  &
               , 'broadleaf_evergreen_temperate_tree '  &
               , 'broadleaf_deciduous_tropical_tree  '  &
               , 'broadleaf_deciduous_temperate_tree '  &
               , 'broadleaf_deciduous_boreal_tree    '  &
               , 'broadleaf_evergreen_shrub          '  &
               , 'broadleaf_deciduous_temperate_shrub'  &
               , 'broadleaf_deciduous_boreal_shrub   '  &
               , 'c3_arctic_grass                    '  &
               , 'c3_non-arctic_grass                '  &
               , 'c4_grass                           '  &
               , 'c3_crop                            '  &
               , 'c4_crop                            '  &
#if (defined CROP)
               , 'corn                               '  &
               , 'spring_wheat                       '  &
               , 'winter_wheat                       '  &
               , 'soybean                            '  &
#endif
    /

!ylu 10/18/10 add new physiology data for CLM4 and CROP

data (pftname(i),i=1,numpft)/'needleleaf_evergreen_temperate_tree'&
               , 'needleleaf_evergreen_boreal_tree   '  &
               , 'needleleaf_deciduous_boreal_tree   '  &
               , 'broadleaf_evergreen_tropical_tree  '  &
               , 'broadleaf_evergreen_temperate_tree '  &
               , 'broadleaf_deciduous_tropical_tree  '  &
               , 'broadleaf_deciduous_temperate_tree '  &
               , 'broadleaf_deciduous_boreal_tree    '  &
               , 'broadleaf_evergreen_shrub          '  &
               , 'broadleaf_deciduous_temperate_shrub'  &
               , 'broadleaf_deciduous_boreal_shrub   '  &
               , 'c3_arctic_grass                    '  &
               , 'c3_non-arctic_grass                '  &
               , 'c4_grass                           '  &
               , 'c3_crop                            '  &
               , 'c4_crop                            '  &
#if (defined CROP)
               , 'corn                               '  &
               , 'spring_wheat                       '  &
               , 'winter_wheat                       '  &
               , 'soybean                            '  &
#endif
    /

  data (z0mr(i),i=1,numpft)/ 0.055,0.055,0.055,0.075,0.075,&
         0.055,0.055,0.055,0.120,0.120,0.120,0.120,0.120,&
         0.120,0.120,0.120&
#if (defined CROP)
         ,0.120,0.120,0.120,0.120/
#else      
         /
#endif

  data (displar(i),i=1,numpft)/0.67,0.67,0.67,0.67,0.67,0.67,&
         0.67,0.67,0.68,0.68,0.68,0.68,0.68,0.68,0.68,0.68&
#if (defined CROP)
         ,0.68,0.68,0.68,0.68/
#else      
         /
#endif

  data (dleaf(i),i=1,numpft)/ 0.04,0.04,0.04,0.04,0.04,0.04,&
         0.04,0.04,0.04,0.04,0.04,0.04,0.04,0.04,0.04,0.04&
#if (defined CROP)
         ,0.04,0.04,0.04,0.04/
#else      
         /
#endif

  data (c3psn(i),i=1,numpft)/1,1,1,1,1,1,1,1,1,1,1,1,1,0,1,1&
#if (defined CROP)
       ,0,1,1,1 /
#else      
         /
#endif 

  data (vcmx25(i),i=1,numpft)/51,43,51,75,69,40,51,51,17,17,&
         33,43,43,24,50,50&
#if (defined CROP)
        ,50,50,50,50 /
#else      
         /
#endif 

  data (mp(i),i=1,numpft)/6,6,6,9,9,9,9,9,9,9,9,9,9,5,9,9&
#if (defined CROP)
      ,4,9,9,9/
#else      
         /
#endif

  data (qe25(i),i=1,numpft)/ 0.06,0.06,0.06,0.06,0.06,0.06,&
       0.06,0.06,0.06,0.06,0.06,0.06,0.06,0.04,0.06,0.06&
#if (defined CROP)
      ,0.04,0.06,0.06,0.06/
#else      
         /
#endif

  data (rhol(i,1),i=1,numpft)/0.07,0.07,0.07,0.10,0.10,0.10,&
       0.10,0.10,0.07,0.10,0.10,0.11,0.11,0.11,0.11,0.11&
#if (defined CROP)
      ,0.11,0.11,0.11,0.11/
#else      
         /
#endif


  data (rhol(i,2),i=1,numpft)/ 0.35,0.35,0.35,0.45,0.45,0.45,&
        0.45,0.45,0.35,0.45,0.45,0.35,0.35,0.35,0.35,0.35&
#if (defined CROP)
        ,0.35,0.35,0.35,0.35/
#else      
         /
#endif

  data (rhos(i,1),i=1,numpft) /0.16,0.16,0.16,0.16,0.16,0.16,&
       0.16,0.16,0.16,0.16,0.16,0.31,0.31,0.31,0.31,0.31&
#if (defined CROP)
       ,0.31,0.31,0.31,0.31/  
#else      
         /
#endif


  data (rhos(i,2),i=1,numpft)/0.39,0.39,0.39,0.39,0.39,0.39,&
       0.39,0.39,0.39,0.39,0.39,0.53,0.53,0.53,0.53,0.53&
#if (defined CROP)
      ,0.53,0.53,0.53,0.53/
#else      
         /
#endif

  data (taul(i,1),i=1,numpft)/0.05,0.05,0.05,0.05,0.05,0.05,&
       0.05,0.05,0.05,0.05,0.05,0.05,0.05,0.05,0.05,0.05&
#if (defined CROP)
      ,0.05,0.05,0.05,0.05/
#else      
         /
#endif


  data (taul(i,2),i=1,numpft)/0.10,0.10,0.10,0.25,0.25,0.25,&
      0.25,0.25,0.10,0.25,0.25,0.34,0.34,0.34,0.34,0.34&
#if (defined CROP)
      ,0.34,0.34,0.34,0.34/
#else      
         /
#endif


  data (taus(i,1),i=1,numpft)/0.001,0.001,0.001,0.001,0.001,&
      0.001,0.001,0.001,0.001,0.001,0.001,0.120,0.120,0.120,0.120,0.120&
#if (defined CROP) 
     ,0.120,0.120,0.120,0.120/
#else      
         /
#endif


  data (taus(i,2),i=1,numpft)/ 0.001,0.001,0.001,0.001,0.001,0.001,&
     0.001,0.001,0.001,0.001,0.001,0.250,0.250,0.250,0.250,0.250&
#if (defined CROP)
,0.250,0.250,0.250,0.250/
#else      
         /
#endif

  data (xl(i),i=1,numpft)/0.01, 0.01, 0.01, 0.10, 0.10, 0.01,&
     0.25, 0.25, 0.01, 0.25, 0.25,-0.30,-0.30,-0.30,-0.30,-0.30&
#if (defined CROP)
    ,-0.50, 0.65, 0.65,-0.50/
#else      
         /
#endif

  data (roota_par(i),i=1,numpft)/ 7, 7, 7, 7, 7, 6, 6, 6, 7,&
       7, 7,11,11,11, 6, 6&
#if (defined CROP)
      , 6, 6, 6, 6/
#else      
         /
#endif

  data (rootb_par(i),i=1,numpft)/ 2.0,2.0,2.0,1.0,1.0,2.0,2.0,&
       2.0,1.5,1.5,1.5,2.0,2.0,2.0,3.0,3.0&
#if (defined CROP)
      ,3.0,3.0,3.0,3.0/
#else      
         /
#endif 

  data (slatop(i),i=1,numpft)/0.010,0.008,0.024,0.012,0.012,0.030,&
       0.030,0.030,0.012,0.030,0.030,0.030,0.030,0.030,0.030,0.030&
#if (defined CROP)
      ,0.050,0.070,0.070,0.070/
#else      
         /
#endif 

  data (dsladlai(i),i=1,numpft)/0.00125,0.00100,0.00300,0.00150,0.00150,&
       0.00400,0.00400,0.00400,0.00000,0.00000,0.00000,0.00000,0.00000,&
       0.00000,0.00000,0.00000&
#if (defined CROP)
       ,0.00000,0.00000,0.00000,0.00000/
#else      
         /
#endif 

  data (leafcn(i),i=1,numpft)/35,40,25,30,30,25,25,25,30,25,25,&
       25,25,25,25,25&
#if (defined CROP)
      ,25,25,25,25/
#else      
         /
#endif

 data (flnr(i),i=1,numpft)/0.05,0.04,0.08,0.06,0.06,0.09,0.09,0.09,&
      0.06,0.09,0.09,0.09,0.09,0.09,0.10,0.10&
#if (defined CROP)
     ,0.10,0.20,0.20,0.10/
#else      
         /
#endif

 data (smpso(i),i=1,numpft)/-66000,-66000,-66000,-66000,-66000,-35000,&
     -35000,-35000,-83000,-83000,-83000,-74000,-74000,-74000,-74000,-74000&
#if (defined CROP)
      ,-74000,-74000,-74000,-74000/
#else      
         /
#endif

 data (smpsc(i),i=1,numpft)/-255000,-255000,-255000,-255000,-255000,-224000,&
     -224000,-224000,-428000,-428000,-428000,-275000,-275000,-275000,-275000,-275000&
#if (defined CROP)
     ,-275000,-275000,-275000,-275000/
#else      
         /
#endif

 data(fnitr(i),i=1,numpft)/0.72,0.78,0.79,0.83,0.71,0.66,0.64,0.70,0.62,&
     0.60,0.76,0.68,0.61,0.64,0.61,0.61&
#if (defined CROP)
    ,0.61,0.61,0.61,0.61/
#else       
         /
#endif


 data(woody(i),i=1,numpft)/1,1,1,1,1,1,1,1,1,1,1,0,0,0,0,0&
#if (defined CROP)
     ,0,0,0,0/
#else      
         /
#endif


 data(lflitcn(i),i=1,numpft)/70,80,50,60,60,50,50,50,60,50,50,50,50,50,50,50&
#if (defined CROP)
  ,25,25,25,25/ 
#else      
         /
#endif


 data(frootcn(i),i=1,numpft)/42,42,42,42,42,42,42,42,42,42,42,42,42,42,42,42&
#if (defined CROP)
   ,42,42,42,42/
#else      
         /
#endif

 data(livewdcn(i),i=1,numpft)/50,50,50,50,50,50,50,50,50,50,50, 50, 50, 50, 50, 50&
#if (defined CROP)
   ,50,50,50,50/
#else      
         /
#endif

 data(deadwdcn(i),i=1,numpft)/500,500,500,500,500,500,500,500,500,500,500,&
       500,  500,  500,  500,  500&
#if (defined CROP)
     ,500,500,500,500/
#else      
         /
#endif


 data(froot_leaf(i),i=1,numpft)/1,1,1,1,1,1,1,1,1,1,1,1,2,2,2,2&
#if (defined CROP)
      ,2,2,2,2/
#else      
         /
#endif

 data(stem_leaf(i),i=1,numpft)/-1.0,-1.0,-1.0,-1.0,-1.0,-1.0,-1.0,-1.0,&
       0.2, 0.2, 0.2, 0.0, 0.0, 0.0, 0.0, 0.0&
#if (defined CROP)
     , 0.0, 0.0, 0.0, 0.0/
#else      
         /
#endif


 data(croot_stem(i),i=1,numpft)/0.3,0.3,0.3,0.3,0.3,0.3,0.3,0.3,0.3,0.3,&
       0.3,0.0,0.0,0.0,0.0,0.0&
#if (defined CROP)
       ,0.0,0.0,0.0,0.0/
#else      
         /
#endif

 data(flivewd(i),i=1,numpft)/0.1,0.1,0.1,0.1,0.1,0.1,0.1,0.1,0.5,0.5,0.1,&
       0.0,0.0,0.0,0.0,0.0&
#if (defined CROP)
      ,1.0,1.0,1.0,1.0/
#else      
         /
#endif


 data(fcur(i),i=1,numpft)/1,1,0,1,1,0,0,0,1,0,0,0,0,0,0,0&
#if (defined CROP)   
   ,1,1,1,1/
#else      
         /
#endif

 data(lf_flab(i),i=1,numpft)/0.25,0.25,0.25,0.25,0.25,0.25,0.25,0.25,0.25,&
      0.25,0.25,0.25,0.25,0.25,0.25,0.25&
#if (defined CROP) 
     ,0.25,0.25,0.25,0.25/
#else      
         /
#endif

 data(lf_fcel(i),i=1,numpft)/0.5,0.5,0.5,0.5,0.5,0.5,0.5,0.5,0.5,0.5,0.5,&
      0.5,0.5,0.5,0.5,0.5&
#if (defined CROP)     
     ,0.5,0.5,0.5,0.5/
#else      
         /
#endif

 data(lf_flig(i),i=1,numpft)/0.25,0.25,0.25,0.25,0.25,0.25,0.25,0.25,0.25,&
      0.25,0.25,0.25,0.25,0.25,0.25,0.25&
#if (defined CROP) 
     ,0.25,0.25,0.25,0.25/
#else      
         /
#endif

 data(fr_flab(i),i=1,numpft)/0.25,0.25,0.25,0.25,0.25,0.25,0.25,0.25,0.25,&
      0.25,0.25,0.25,0.25,0.25,0.25,0.25&
#if (defined CROP)
      ,0.25,0.25,0.25,0.25/
#else      
         /
#endif

 data(fr_fcel(i),i=1,numpft)/0.5,0.5,0.5,0.5,0.5,0.5,0.5,0.5,0.5,0.5,0.5,&
      0.5,0.5,0.5,0.5,0.5&
#if (defined CROP)  
     ,0.5,0.5,0.5,0.5/
#else      
         /
#endif

 data(fr_flig(i),i=1,numpft)/0.25,0.25,0.25,0.25,0.25,0.25,0.25,0.25,0.25,&
      0.25,0.25,0.25,0.25,0.25,0.25,0.25&
#if (defined CROP)
     ,0.25,0.25,0.25,0.25/
#else       
         /
#endif

 data(dw_fcel(i),i=1,numpft)/0.75,0.75,0.75,0.75,0.75,0.75,0.75,0.75,0.75,&
      0.75,0.75,0.75,0.75,0.75,0.75,0.75&
#if (defined CROP)
     ,0.75,0.75,0.75,0.75/
#else      
         /
#endif


 data(dw_flig(i),i=1,numpft)/0.25,0.25,0.25,0.25,0.25,0.25,0.25,0.25,0.25,&
      0.25,0.25,0.25,0.25,0.25,0.25,0.25&
#if (defined CROP)     
     ,0.25,0.25,0.25,0.25/
#else      
         /
#endif


 data(leaf_long(i),i=1,numpft)/3.0,6.0,1.0,1.5,1.5,1.0,1.0,1.0,1.5,1.0,1.0,&
       1.0,1.0,1.0,1.0,1.0&
#if (defined CROP)   
      ,1.0,1.0,1.0,1.0/
#else      
         /
#endif

 
 data(evergreen(i),i=1,numpft)/1,1,0,1,1,0,0,0,1,0,0,0,0,0,0,0&
#if (defined CROP) 
    ,0,0,0,0/
#else      
         /
#endif

 
 data(stress_decid(i),i=1,numpft)/0,0,0,0,0,1,0,0,0,1,1,1,1,1,1,1&
#if (defined CROP)
    ,0,0,0,0/
#else      
         /
#endif

 
 data(season_decid(i),i=1,numpft)/0,0,1,0,0,0,1,1,0,0,0,0,0,0,0,0&
#if (defined CROP)    
    ,0,0,0,0/
#else      
         /
#endif

 data(resist(i),i=1,numpft)/0.12,0.12,0.12,0.12,0.12,0.12,0.12,0.12,&
     0.12,0.12,0.12,0.12,0.12,0.12,1.00,1.00&
#if (defined CROP)
    ,1.00,1.00,1.00,1.00/
#else      
         /
#endif


 data(pftpar20(i),i=1,numpft)/15,15,15,15,15,15,15,15, 5, 5, 5, 0, 0, 0, 0, 0&
#if (defined CROP)
    , 0, 0, 0, 0/
#else      
         /
#endif


 data(pftpar28(i),i=1,numpft)/ -2.0,  -32.5, 9999.9,   15.5,    3.0,   15.5,&
       -17.0,-1000.0, 9999.9,  -17.0,-1000.0,-1000.0,  -17.0,15.5, 9999.9, 9999.9&
#if (defined CROP)
   , 9999.9, 9999.9, 9999.9, 9999.9/
#else      
         /
#endif


 data(pftpar29(i),i=1,numpft)/ 22.0,  -2.0,  -2.0,1000.0,  18.8,1000.0,  15.5,&
      -2.0,1000.0,1000.0,  -2.0, -17.0,  15.5,1000.0,1000.0,1000.0&
#if (defined CROP)
     ,1000.0,1000.0,1000.0,1000.0/
#else      
         /
#endif

 data(pftpar30(i),i=1,numpft)/900, 600, 350,   0,1200,   0,1200, 350,   0,1200,&
       350,   0,   0,   0,   0,   0&
#if (defined CROP)
    ,   0,   0,   0,   0/
#else      
         /
#endif


 data(pftpar31(i),i=1,numpft)/1000,  23,  23,1000,1000,1000,1000,  23,1000,1000,&
       23,1000,1000,1000,1000,1000&
#if (defined CROP)
      ,1000,1000,1000,1000/
#else      
         /
#endif


 data(graincn(i),i=1,numpft)/0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0&
#if (defined CROP)    
     ,50,50,50,50/
#else      
         /
#endif



  public :: pftconrd ! Read and initialize vegetation (PFT) constants 


!
!EOP
!----------------------------------------------------------------------- 

contains

!-----------------------------------------------------------------------
!BOP
!
! !IROUTINE: pftconrd
!
! !INTERFACE:
  subroutine pftconrd

    use nanMod    , only : inf



!
! !DESCRIPTION: 
! Read and initialize vegetation (PFT) constants 
!
! !USES:
!
! !ARGUMENTS:
    implicit none
!
! !CALLED FROM:
! routine initialize in module initializeMod
!
! !REVISION HISTORY:
! Created by Gordon Bonan
!
!EOP
!
! !LOCAL VARIABLES:
    integer :: i,n              !loop indices
    integer :: ier              !error code
!-----------------------------------------------------------------------


    ! Set value for last type of tree

    ntree = nbrdlf_dcd_brl_tree  !value for last type of tree

    ! Set value for non-vegetated

!ylu moved to top    noveg = 0  !value


!ylu add

#if (defined CROP)
    npcropmin            = ncorn                ! first prognostic crop
    npcropmax            = nsoybean             ! last prognostic crop in list
#endif


    ! Assign unit number to file. Get local file. 
    ! Open file and read PFT's.
    ! Close and release file.

    crop(:)  = 0
    crop(nc3crop:numpft) = 1
  
!  crop(15) = 1
!    crop(16) = 1


#if (defined CROP)
       mxtmp(:)                      =  0._r8
       mxtmp(ncorn)                  = 30._r8
       mxtmp(nswheat)                = 26._r8
       mxtmp(nwwheat)                = 26._r8
       mxtmp(nsoybean)               = 30._r8

       baset(:)                      =  0._r8
       baset(ncorn)                  =  8._r8
       baset(nswheat)                =  0._r8
       baset(nwwheat)                =  0._r8
       baset(nsoybean)               = 10._r8

       declfact(:)                   = 0.00_r8
     declfact(npcropmin:npcropmax) = 1.05_r8

       bfact(:)                      = 0.00_r8
       bfact(npcropmin:npcropmax)    = 0.10_r8

       aleaff(:)                     = 0._r8

       arootf(:)                     = 0.00_r8
       arootf(ncorn)                 = 0.05_r8
       arootf(nsoybean)              = 0.20_r8

       astemf(:)                     = 0.00_r8
       astemf(nswheat)               = 0.05_r8
       astemf(nwwheat)               = 0.05_r8
       astemf(nsoybean)              = 0.30_r8

       arooti(:)                     = 0.0_r8
       arooti(ncorn)                 = 0.4_r8
       arooti(nswheat)               = 0.3_r8
       arooti(nwwheat)               = 0.3_r8
       arooti(nsoybean)              = 0.5_r8

       fleafi(:)                     = 0.000_r8
       fleafi(ncorn)                 = 0.800_r8
       fleafi(nswheat)               = 0.750_r8
       fleafi(nwwheat)               = 0.425_r8
       fleafi(nsoybean)              = 0.850_r8

       allconsl(:)                   = 0._r8
       allconsl(ncorn)               = 5._r8
       allconsl(nswheat)             = 3._r8
       allconsl(nwwheat)             = 3._r8
       allconsl(nsoybean)            = 2._r8

       allconss(:)                   = 0._r8
       allconss(ncorn)               = 2._r8
       allconss(nswheat)             = 1._r8
       allconss(nwwheat)             = 1._r8
       allconss(nsoybean)            = 5._r8

       ztopmx(:)                     = 0.00_r8
       ztopmx(ncorn)                 = 2.50_r8
       ztopmx(nswheat)               = 1.20_r8
       ztopmx(nwwheat)               = 1.20_r8
       ztopmx(nsoybean)              = 0.75_r8

       laimx(:)                      = 0._r8
       laimx(ncorn)                  = 5._r8
       laimx(nswheat)                = 7._r8
       laimx(nwwheat)                = 7._r8
       laimx(nsoybean)               = 6._r8

       gddmin(:)                     =  0._r8
       gddmin(ncorn)                 = 50._r8
       gddmin(nswheat)               = 50._r8
       gddmin(nwwheat)               = 50._r8
       gddmin(nsoybean)              = 50._r8

       hybgdd(:)                     =    0._r8
       hybgdd(ncorn)                 = 1700._r8
       hybgdd(nswheat)               = 1700._r8
       hybgdd(nwwheat)               = 1700._r8
       hybgdd(nsoybean)              = 1900._r8

       lfemerg(:)                    = 0.00_r8
       lfemerg(ncorn)                = 0.03_r8
       lfemerg(nswheat)              = 0.05_r8
       lfemerg(nwwheat)              = 0.05_r8
       lfemerg(nsoybean)             = 0.03_r8
       grnfill(:)                    = 0.00_r8
       grnfill(ncorn)                = 0.65_r8
       grnfill(nswheat)              = 0.60_r8
       grnfill(nwwheat)              = 0.40_r8
       grnfill(nsoybean)             = 0.70_r8

       mxmat(:)                      = 0
       mxmat(ncorn)                  = 165
       mxmat(nswheat)                = 150
       mxmat(nwwheat)                = 265
       mxmat(nsoybean)               = 150
#endif

    pftname(noveg)      = 'not_vegetated'
       z0mr(noveg)         = 0._r8
       displar(noveg)      = 0._r8
       dleaf(noveg)        = 0._r8
       c3psn(noveg)        = 1._r8
       vcmx25(noveg)       = 0._r8
       mp(noveg)           = 9._r8
       qe25(noveg)         = 0._r8
       rhol(noveg,1)       = 0._r8
       rhol(noveg,2)       = 0._r8
       rhos(noveg,1)       = 0._r8
       rhos(noveg,2)       = 0._r8
       taul(noveg,1)       = 0._r8
       taul(noveg,2)       = 0._r8
       taus(noveg,1)       = 0._r8
       taus(noveg,2)       = 0._r8
       xl(noveg)           = 0._r8
       roota_par(noveg)    = 0._r8
       rootb_par(noveg)    = 0._r8
       crop(noveg)         = 0._r8
       smpso(noveg)        = 0._r8
       smpsc(noveg)        = 0._r8
       fnitr(noveg)        = 0._r8
       slatop(noveg)       = 0._r8
       dsladlai(noveg)     = 0._r8
       leafcn(noveg)       = 1._r8
       flnr(noveg)         = 0._r8
       ! begin variables used only for CN code
       woody(noveg)        = 0._r8
       lflitcn(noveg)      = 1._r8
       frootcn(noveg)      = 1._r8
       livewdcn(noveg)     = 1._r8
       deadwdcn(noveg)     = 1._r8
#if (defined CROP)
       ! begin variables used only for CROP
       graincn(noveg)      = 1._r8
       mxtmp(noveg)        = 0._r8
       baset(noveg)        = 0._r8
       declfact(noveg)     = 0._r8
       bfact(noveg)        = 0._r8
       aleaff(noveg)       = 0._r8
       arootf(noveg)       = 0._r8
       astemf(noveg)       = 0._r8
       arooti(noveg)       = 0._r8
       fleafi(noveg)       = 0._r8
       allconsl(noveg)     = 0._r8
       allconss(noveg)     = 0._r8
       ztopmx(noveg)       = 0._r8
       laimx(noveg)        = 0._r8
       gddmin(noveg)       = 0._r8
       hybgdd(noveg)       = 0._r8
       lfemerg(noveg)      = 0._r8
       grnfill(noveg)      = 0._r8
       mxmat(noveg)        = 0
       ! end variables used only for CROP
#endif
       froot_leaf(noveg)   = 0._r8
       stem_leaf(noveg)    = 0._r8
       croot_stem(noveg)   = 0._r8
       flivewd(noveg)      = 0._r8
       fcur(noveg)         = 0._r8
       lf_flab(noveg)      = 0._r8
       lf_fcel(noveg)      = 0._r8
       lf_flig(noveg)      = 0._r8
       fr_flab(noveg)      = 0._r8
       fr_fcel(noveg)      = 0._r8
       fr_flig(noveg)      = 0._r8
       dw_fcel(noveg)      = 0._r8
       dw_flig(noveg)      = 0._r8
       leaf_long(noveg)    = 0._r8
       evergreen(noveg)    = 0._r8
       stress_decid(noveg) = 0._r8
       season_decid(noveg) = 0._r8
       resist(noveg)       = 1._r8
       pftpar20(noveg) = inf
       pftpar28(noveg) = 9999.9_r8
       pftpar29(noveg) = 1000.0_r8
       pftpar30(noveg) =    0.0_r8
       pftpar31(noveg) = 1000.0_r8


  end subroutine pftconrd

end module pftvarcon

module pftdynMod

!---------------------------------------------------------------------------
!BOP
!
! !MODULE: pftdynMod
!
! !USES:
  use clmtype
  use decompMod   , only : get_proc_bounds
  use clm_varpar  , only : max_pft_per_col
  use shr_kind_mod, only : r8 => shr_kind_r8
!
! !DESCRIPTION:
! Determine pft weights at current time using dynamic landuse datasets.
! ASSUMES that only have one dynamic landuse dataset.
!
! !PUBLIC TYPES:
! implicit none
  private
  save
  public :: pftdyn_init            !not used 02/23/11 ylu
  public :: pftdyn_interp          !not used 02/23/11 ylu
  public :: pftdyn_wbal_init       !not used 02/23/11 ylu
  public :: pftdyn_wbal            !not used 02/23/11 ylu
#ifdef CN
  public :: pftdyn_cnbal           !Call in driver.F
#ifdef CNDV
  public :: pftwt_init             !not used 02/23/11 ylu
  public :: pftwt_interp           !not used 02/23/11 ylu 
#endif
  public :: CNHarvest              !Call in CNEcosystemDynMod.F
  public :: CNHarvestPftToColumn   !not used 02/23/11 ylu
#endif
!
! !REVISION HISTORY:
! Created by Peter Thornton
! slevis modified to handle CNDV and CROP
! 19 May 2009: PET - modified to handle harvest fluxes
!
!EOP
!
! ! PRIVATE TYPES
  real(r8), parameter :: days_per_year = 365._r8
  integer , pointer   :: yearspft(:)
  real(r8), pointer   :: wtpft1(:,:)   
  real(r8), pointer   :: wtpft2(:,:)
  real(r8), pointer   :: harvest(:)   
  real(r8), pointer   :: wtcol_old(:)
  integer :: nt1
  integer :: nt2
  integer :: ntimes
  logical :: do_harvest
  integer :: ncid
!---------------------------------------------------------------------------

contains
  
  
#ifdef CN
!-----------------------------------------------------------------------
!BOP
!
! !ROUTINE: pftdyn_cnbal
!
! !INTERFACE:
  subroutine pftdyn_cnbal()
!
! !DESCRIPTION:
! modify pft-level state and flux variables to maintain carbon and nitrogen balance with
! dynamic pft-weights.
!
! !USES:
    use shr_kind_mod, only : r8 => shr_kind_r8
    use shr_const_mod,only : SHR_CONST_PDB
    use decompMod   , only : get_proc_bounds
    use clm_varcon  , only : istsoil
#ifdef CROP
    use clm_varcon  , only : istcrop
#endif
    use clm_varpar  , only : numveg, numpft
#if (defined C13)
    use clm_varcon  , only : c13ratio
#endif
!    use clm_time_manager, only : get_step_size
    use globals     , only: dt
!
! !ARGUMENTS:
    implicit none
!
!
! !LOCAL VARIABLES:
!EOP
    integer  :: begp, endp    ! proc beginning and ending pft indices
    integer  :: begc, endc    ! proc beginning and ending column indices
    integer  :: begl, endl    ! proc beginning and ending landunit indices
    integer  :: begg, endg    ! proc beginning and ending gridcell indices
    integer  :: pi,p,c,l,g    ! indices
    integer  :: ier           ! error code
    real(r8) :: dwt           ! change in pft weight (relative to column)
!    real(r8) :: dt            ! land model time step (sec)
    real(r8) :: init_h2ocan   ! initial canopy water mass
    real(r8) :: new_h2ocan    ! canopy water mass after weight shift
    real(r8), allocatable :: dwt_leafc_seed(:)       ! pft-level mass gain due to seeding of new area
    real(r8), allocatable :: dwt_leafn_seed(:)       ! pft-level mass gain due to seeding of new area
#if (defined C13)
    real(r8), allocatable :: dwt_leafc13_seed(:)     ! pft-level mass gain due to seeding of new area
#endif
    real(r8), allocatable :: dwt_deadstemc_seed(:)       ! pft-level mass gain due to seeding of new area
    real(r8), allocatable :: dwt_deadstemn_seed(:)       ! pft-level mass gain due to seeding of new area
#if (defined C13)
    real(r8), allocatable :: dwt_deadstemc13_seed(:)     ! pft-level mass gain due to seeding of new area
#endif
    real(r8), allocatable :: dwt_frootc_to_litter(:)       ! pft-level mass loss due to weight shift
    real(r8), allocatable :: dwt_livecrootc_to_litter(:)   ! pft-level mass loss due to weight shift
    real(r8), allocatable :: dwt_deadcrootc_to_litter(:)   ! pft-level mass loss due to weight shift
#if (defined C13)
    real(r8), allocatable, target :: dwt_frootc13_to_litter(:)     ! pft-level mass loss due to weight shift
    real(r8), allocatable, target :: dwt_livecrootc13_to_litter(:) ! pft-level mass loss due to weight shift
    real(r8), allocatable, target :: dwt_deadcrootc13_to_litter(:) ! pft-level mass loss due to weight shift
#endif
    real(r8), allocatable, target :: dwt_frootn_to_litter(:)       ! pft-level mass loss due to weight shift
    real(r8), allocatable, target :: dwt_livecrootn_to_litter(:)   ! pft-level mass loss due to weight shift
    real(r8), allocatable, target :: dwt_deadcrootn_to_litter(:)   ! pft-level mass loss due to weight shift
    real(r8), allocatable :: conv_cflux(:)         ! pft-level mass loss due to weight shift
    real(r8), allocatable :: prod10_cflux(:)       ! pft-level mass loss due to weight shift
    real(r8), allocatable :: prod100_cflux(:)      ! pft-level mass loss due to weight shift
#if (defined C13)
    real(r8), allocatable, target :: conv_c13flux(:)       ! pft-level mass loss due to weight shift
    real(r8), allocatable, target :: prod10_c13flux(:)     ! pft-level mass loss due to weight shift
    real(r8), allocatable, target :: prod100_c13flux(:)    ! pft-level mass loss due to weight shift
#endif
    real(r8), allocatable, target :: conv_nflux(:)         ! pft-level mass loss due to weight shift
    real(r8), allocatable, target :: prod10_nflux(:)       ! pft-level mass loss due to weight shift
    real(r8), allocatable, target :: prod100_nflux(:)      ! pft-level mass loss due to weight shift
#if (defined C13)
    real(r8) :: c3_del13c     ! typical del13C for C3 photosynthesis (permil, relative to PDB)
    real(r8) :: c4_del13c     ! typical del13C for C4 photosynthesis (permil, relative to PDB)
    real(r8) :: c3_r1         ! isotope ratio (13c/12c) for C3 photosynthesis
    real(r8) :: c4_r1         ! isotope ratio (13c/12c) for C4 photosynthesis
    real(r8) :: c3_r2         ! isotope ratio (13c/[12c+13c]) for C3 photosynthesis
    real(r8) :: c4_r2         ! isotope ratio (13c/[12c+13c]) for C4 photosynthesis
#endif
    real(r8) :: t1,t2,wt_new,wt_old
    real(r8) :: init_state, change_state, new_state
	real(r8) :: tot_leaf, pleaf, pstor, pxfer
	real(r8) :: leafc_seed, leafn_seed
	real(r8) :: deadstemc_seed, deadstemn_seed
#if (defined C13)
        real(r8) :: leafc13_seed, deadstemc13_seed
#endif
    real(r8), pointer :: dwt_ptr0, dwt_ptr1, dwt_ptr2, dwt_ptr3, ptr
    real(r8) :: pconv(0:numpft)    ! proportion of deadstem to conversion flux
    real(r8) :: pprod10(0:numpft)  ! proportion of deadstem to 10-yr product pool
    real(r8) :: pprod100(0:numpft) ! proportion of deadstem to 100-yr product pool
    type(landunit_type), pointer :: lptr         ! pointer to landunit derived subtype
    type(column_type),   pointer :: cptr         ! pointer to column derived subtype
    type(pft_type)   ,   pointer :: pptr         ! pointer to pft derived subtype
    character(len=32) :: subname='pftdyn_cbal' ! subroutine name
!-----------------------------------------------------------------------
    
    ! (dangerous hardwiring) (should put this into pftphysiology file)
    ! set deadstem proportions
    ! veg type:      0       1       2       3       4       5       6       7       8       9      10      11      12     &
    !                13      14      15      16
    pconv(0:numveg)   = &
                 (/0.0_r8, 0.6_r8, 0.6_r8, 0.6_r8, 0.6_r8, 0.6_r8, 0.6_r8, 0.6_r8, 0.6_r8, 0.8_r8, 0.8_r8, 0.8_r8, 1.0_r8, &
                   1.0_r8, 1.0_r8, 1.0_r8, 1.0_r8/)
    pprod10(0:numveg) = &
                 (/0.0_r8, 0.3_r8, 0.3_r8, 0.3_r8, 0.4_r8, 0.3_r8, 0.4_r8, 0.3_r8, 0.3_r8, 0.2_r8, 0.2_r8, 0.2_r8, 0.0_r8, &
                   0.0_r8, 0.0_r8, 0.0_r8, 0.0_r8/)
    pprod100(0:numveg) = &
                 (/0.0_r8, 0.1_r8, 0.1_r8, 0.1_r8, 0.0_r8, 0.1_r8, 0.0_r8, 0.1_r8, 0.1_r8, 0.0_r8, 0.0_r8, 0.0_r8, 0.0_r8, &
                   0.0_r8, 0.0_r8, 0.0_r8, 0.0_r8/)
#ifdef CROP
    !                17 - 20 (dangerous hardwiring)
    pconv(numveg+1:numpft)   =    0.0_r8
    pprod10(numveg+1:numpft) =    0.0_r8
    pprod100(numveg+1:numpft) =   0.0_r8
#endif
    
    ! Set pointers into derived type

    lptr => clm3%g%l
    cptr => clm3%g%l%c
    pptr => clm3%g%l%c%p

    ! Get relevant sizes

    call get_proc_bounds(begg, endg, begl, endl, begc, endc, begp, endp)

    ! Allocate pft-level mass loss arrays
    allocate(dwt_leafc_seed(begp:endp), stat=ier)
    if (ier /= 0) then
          write(6,*)subname,' allocation error for dwt_leafc_seed'; call endrun()
    end if
    allocate(dwt_leafn_seed(begp:endp), stat=ier)
    if (ier /= 0) then
          write(6,*)subname,' allocation error for dwt_leafn_seed'; call endrun()
    end if
#if (defined C13)
    allocate(dwt_leafc13_seed(begp:endp), stat=ier)
    if (ier /= 0) then
          write(6,*)subname,' allocation error for dwt_leafc13_seed'; call endrun()
    end if
#endif
    allocate(dwt_deadstemc_seed(begp:endp), stat=ier)
    if (ier /= 0) then
          write(6,*)subname,' allocation error for dwt_deadstemc_seed'; call endrun()
    end if
    allocate(dwt_deadstemn_seed(begp:endp), stat=ier)
    if (ier /= 0) then
          write(6,*)subname,' allocation error for dwt_deadstemn_seed'; call endrun()
    end if
#if (defined C13)
    allocate(dwt_deadstemc13_seed(begp:endp), stat=ier)
    if (ier /= 0) then
          write(6,*)subname,' allocation error for dwt_deadstemc13_seed'; call endrun()
    end if
#endif
    allocate(dwt_frootc_to_litter(begp:endp), stat=ier)
    if (ier /= 0) then
          write(6,*)subname,' allocation error for dwt_frootc_to_litter'; call endrun()
    end if
    allocate(dwt_livecrootc_to_litter(begp:endp), stat=ier)
    if (ier /= 0) then
          write(6,*)subname,' allocation error for dwt_livecrootc_to_litter'; call endrun()
    end if
    allocate(dwt_deadcrootc_to_litter(begp:endp), stat=ier)
    if (ier /= 0) then
          write(6,*)subname,' allocation error for dwt_deadcrootc_to_litter'; call endrun()
    end if
#if (defined C13)
    allocate(dwt_frootc13_to_litter(begp:endp), stat=ier)
    if (ier /= 0) then
          write(6,*)subname,' allocation error for dwt_frootc13_to_litter'; call endrun()
    end if
    allocate(dwt_livecrootc13_to_litter(begp:endp), stat=ier)
    if (ier /= 0) then
          write(6,*)subname,' allocation error for dwt_livecrootc13_to_litter'; call endrun()
    end if
    allocate(dwt_deadcrootc13_to_litter(begp:endp), stat=ier)
    if (ier /= 0) then
          write(6,*)subname,' allocation error for dwt_deadcrootc13_to_litter'; call endrun()
    end if
#endif
    allocate(dwt_frootn_to_litter(begp:endp), stat=ier)
    if (ier /= 0) then
          write(6,*)subname,' allocation error for dwt_frootn_to_litter'; call endrun()
    end if
    allocate(dwt_livecrootn_to_litter(begp:endp), stat=ier)
    if (ier /= 0) then
          write(6,*)subname,' allocation error for dwt_livecrootn_to_litter'; call endrun()
    end if
    allocate(dwt_deadcrootn_to_litter(begp:endp), stat=ier)
    if (ier /= 0) then
          write(6,*)subname,' allocation error for dwt_deadcrootn_to_litter'; call endrun()
    end if
    allocate(conv_cflux(begp:endp), stat=ier)
    if (ier /= 0) then
          write(6,*)subname,' allocation error for conv_cflux'; call endrun()
    end if
    allocate(prod10_cflux(begp:endp), stat=ier)
    if (ier /= 0) then
          write(6,*)subname,' allocation error for prod10_cflux'; call endrun()
    end if
    allocate(prod100_cflux(begp:endp), stat=ier)
    if (ier /= 0) then
          write(6,*)subname,' allocation error for prod100_cflux'; call endrun()
    end if
#if (defined C13)
    allocate(conv_c13flux(begp:endp), stat=ier)
    if (ier /= 0) then
          write(6,*)subname,' allocation error for conv_c13flux'; call endrun()
    end if
    allocate(prod10_c13flux(begp:endp), stat=ier)
    if (ier /= 0) then
          write(6,*)subname,' allocation error for prod10_c13flux'; call endrun()
    end if
    allocate(prod100_c13flux(begp:endp), stat=ier)
    if (ier /= 0) then
          write(6,*)subname,' allocation error for prod100_c13flux'; call endrun()
    end if
#endif
    allocate(conv_nflux(begp:endp), stat=ier)
    if (ier /= 0) then
          write(6,*)subname,' allocation error for conv_nflux'; call endrun()
    end if
    allocate(prod10_nflux(begp:endp), stat=ier)
    if (ier /= 0) then
          write(6,*)subname,' allocation error for prod10_nflux'; call endrun()
    end if
    allocate(prod100_nflux(begp:endp), stat=ier)
    if (ier /= 0) then
          write(6,*)subname,' allocation error for prod100_nflux'; call endrun()
    end if

    ! Get time step
!    dt = real( get_step_size(), r8 )

	do p = begp,endp
		! initialize all the pft-level local flux arrays
		dwt_leafc_seed(p) = 0._r8
		dwt_leafn_seed(p) = 0._r8
#if (defined C13)
		dwt_leafc13_seed(p) = 0._r8
#endif
		dwt_deadstemc_seed(p) = 0._r8
		dwt_deadstemn_seed(p) = 0._r8
#if (defined C13)
		dwt_deadstemc13_seed(p) = 0._r8
#endif
		dwt_frootc_to_litter(p) = 0._r8
		dwt_livecrootc_to_litter(p) = 0._r8
		dwt_deadcrootc_to_litter(p) = 0._r8
#if (defined C13)
		dwt_frootc13_to_litter(p) = 0._r8
		dwt_livecrootc13_to_litter(p) = 0._r8
		dwt_deadcrootc13_to_litter(p) = 0._r8
#endif
		dwt_frootn_to_litter(p) = 0._r8
		dwt_livecrootn_to_litter(p) = 0._r8
		dwt_deadcrootn_to_litter(p) = 0._r8
		conv_cflux(p) = 0._r8
		prod10_cflux(p) = 0._r8
		prod100_cflux(p) = 0._r8
#if (defined C13)
		conv_c13flux(p) = 0._r8
		prod10_c13flux(p) = 0._r8
		prod100_c13flux(p) = 0._r8
#endif
		conv_nflux(p) = 0._r8
		prod10_nflux(p) = 0._r8
		prod100_nflux(p) = 0._r8
       
		l = pptr%landunit(p)
		c = pptr%column(p)
#if (defined CNDV) || (! defined CROP)
		if (lptr%itype(l) == istsoil) then ! CNDV incompatible with dynLU
#else
		if (lptr%itype(l) == istsoil .or. lptr%itype(l) == istcrop) then
#endif

			! calculate the change in weight for the timestep
			dwt = pptr%wtcol(p)-wtcol_old(p)

			! PFTs for which weight increases on this timestep
			if (dwt > 0._r8) then

				! first identify PFTs that are initiating on this timestep
				! and set all the necessary state and flux variables
				if (wtcol_old(p) == 0._r8) then

					! set initial conditions for PFT that is being initiated
					! in this time step.  Based on the settings in cnIniTimeVar.

					! pft-level carbon state variables
					pptr%pcs%leafc(p)              = 0._r8
					pptr%pcs%leafc_storage(p)      = 0._r8
					pptr%pcs%leafc_xfer(p)         = 0._r8
					pptr%pcs%frootc(p)             = 0._r8
					pptr%pcs%frootc_storage(p)     = 0._r8
					pptr%pcs%frootc_xfer(p)        = 0._r8
					pptr%pcs%livestemc(p)          = 0._r8
					pptr%pcs%livestemc_storage(p)  = 0._r8
					pptr%pcs%livestemc_xfer(p)     = 0._r8
					pptr%pcs%deadstemc(p)          = 0._r8
					pptr%pcs%deadstemc_storage(p)  = 0._r8
					pptr%pcs%deadstemc_xfer(p)     = 0._r8
					pptr%pcs%livecrootc(p)         = 0._r8
					pptr%pcs%livecrootc_storage(p) = 0._r8
					pptr%pcs%livecrootc_xfer(p)    = 0._r8
					pptr%pcs%deadcrootc(p)         = 0._r8
					pptr%pcs%deadcrootc_storage(p) = 0._r8
					pptr%pcs%deadcrootc_xfer(p)    = 0._r8
					pptr%pcs%gresp_storage(p)      = 0._r8
					pptr%pcs%gresp_xfer(p)         = 0._r8
					pptr%pcs%cpool(p)              = 0._r8
					pptr%pcs%xsmrpool(p)           = 0._r8
					pptr%pcs%pft_ctrunc(p)         = 0._r8
					pptr%pcs%dispvegc(p)           = 0._r8
					pptr%pcs%storvegc(p)           = 0._r8
					pptr%pcs%totvegc(p)            = 0._r8
					pptr%pcs%totpftc(p)            = 0._r8

#if (defined C13)
					! pft-level carbon-13 state variables
					pptr%pc13s%leafc(p)              = 0._r8
					pptr%pc13s%leafc_storage(p)      = 0._r8
					pptr%pc13s%leafc_xfer(p)         = 0._r8
					pptr%pc13s%frootc(p)             = 0._r8
					pptr%pc13s%frootc_storage(p)     = 0._r8
					pptr%pc13s%frootc_xfer(p)        = 0._r8
					pptr%pc13s%livestemc(p)          = 0._r8
					pptr%pc13s%livestemc_storage(p)  = 0._r8
					pptr%pc13s%livestemc_xfer(p)     = 0._r8
					pptr%pc13s%deadstemc(p)          = 0._r8
					pptr%pc13s%deadstemc_storage(p)  = 0._r8
					pptr%pc13s%deadstemc_xfer(p)     = 0._r8
					pptr%pc13s%livecrootc(p)         = 0._r8
					pptr%pc13s%livecrootc_storage(p) = 0._r8
					pptr%pc13s%livecrootc_xfer(p)    = 0._r8
					pptr%pc13s%deadcrootc(p)         = 0._r8
					pptr%pc13s%deadcrootc_storage(p) = 0._r8
					pptr%pc13s%deadcrootc_xfer(p)    = 0._r8
					pptr%pc13s%gresp_storage(p)      = 0._r8
					pptr%pc13s%gresp_xfer(p)         = 0._r8
					pptr%pc13s%cpool(p)              = 0._r8
					pptr%pc13s%xsmrpool(p)           = 0._r8
					pptr%pc13s%pft_ctrunc(p)         = 0._r8
					pptr%pc13s%dispvegc(p)           = 0._r8
					pptr%pc13s%storvegc(p)           = 0._r8
					pptr%pc13s%totvegc(p)            = 0._r8
					pptr%pc13s%totpftc(p)            = 0._r8
#endif

					! pft-level nitrogen state variables
					pptr%pns%leafn(p)	           = 0._r8
					pptr%pns%leafn_storage(p)      = 0._r8
					pptr%pns%leafn_xfer(p)         = 0._r8
					pptr%pns%frootn(p)	           = 0._r8
					pptr%pns%frootn_storage(p)     = 0._r8
					pptr%pns%frootn_xfer(p)        = 0._r8
					pptr%pns%livestemn(p)	       = 0._r8
					pptr%pns%livestemn_storage(p)  = 0._r8
					pptr%pns%livestemn_xfer(p)     = 0._r8
					pptr%pns%deadstemn(p)	       = 0._r8
					pptr%pns%deadstemn_storage(p)  = 0._r8
					pptr%pns%deadstemn_xfer(p)     = 0._r8
					pptr%pns%livecrootn(p)         = 0._r8
					pptr%pns%livecrootn_storage(p) = 0._r8
					pptr%pns%livecrootn_xfer(p)    = 0._r8
					pptr%pns%deadcrootn(p)         = 0._r8
					pptr%pns%deadcrootn_storage(p) = 0._r8
					pptr%pns%deadcrootn_xfer(p)    = 0._r8
					pptr%pns%retransn(p)	       = 0._r8
					pptr%pns%npool(p)	           = 0._r8
					pptr%pns%pft_ntrunc(p)         = 0._r8
					pptr%pns%dispvegn(p)           = 0._r8
					pptr%pns%storvegn(p)           = 0._r8
					pptr%pns%totvegn(p)            = 0._r8
					pptr%pns%totpftn (p)           = 0._r8

					! initialize same flux and epv variables that are set
					! in CNiniTimeVar
					pptr%pcf%psnsun(p) = 0._r8
					pptr%pcf%psnsha(p) = 0._r8
#if (defined C13)
					pptr%pc13f%psnsun(p) = 0._r8
					pptr%pc13f%psnsha(p) = 0._r8
#endif
					pptr%pps%laisun(p) = 0._r8
					pptr%pps%laisha(p) = 0._r8
					pptr%pps%lncsun(p) = 0._r8
					pptr%pps%lncsha(p) = 0._r8
					pptr%pps%vcmxsun(p) = 0._r8
					pptr%pps%vcmxsha(p) = 0._r8
#if (defined C13)
					pptr%pps%alphapsnsun(p) = 0._r8
					pptr%pps%alphapsnsha(p) = 0._r8
#endif

					pptr%pepv%dormant_flag(p) = 1._r8
					pptr%pepv%days_active(p) = 0._r8
					pptr%pepv%onset_flag(p) = 0._r8
					pptr%pepv%onset_counter(p) = 0._r8
					pptr%pepv%onset_gddflag(p) = 0._r8
					pptr%pepv%onset_fdd(p) = 0._r8
					pptr%pepv%onset_gdd(p) = 0._r8
					pptr%pepv%onset_swi(p) = 0.0_r8
					pptr%pepv%offset_flag(p) = 0._r8
					pptr%pepv%offset_counter(p) = 0._r8
					pptr%pepv%offset_fdd(p) = 0._r8
					pptr%pepv%offset_swi(p) = 0._r8
					pptr%pepv%lgsf(p) = 0._r8
					pptr%pepv%bglfr(p) = 0._r8
					pptr%pepv%bgtr(p) = 0._r8
					! difference from CNiniTimeVar: using column-level
					! information to initialize annavg_t2m.
					pptr%pepv%annavg_t2m(p) = cptr%cps%cannavg_t2m(c)
					pptr%pepv%tempavg_t2m(p) = 0._r8
					pptr%pepv%gpp(p) = 0._r8
					pptr%pepv%availc(p) = 0._r8
					pptr%pepv%xsmrpool_recover(p) = 0._r8
#if (defined C13)
					pptr%pepv%xsmrpool_c13ratio(p) = c13ratio
#endif
					pptr%pepv%alloc_pnow(p) = 1._r8
					pptr%pepv%c_allometry(p) = 0._r8
					pptr%pepv%n_allometry(p) = 0._r8
					pptr%pepv%plant_ndemand(p) = 0._r8
					pptr%pepv%tempsum_potential_gpp(p) = 0._r8
					pptr%pepv%annsum_potential_gpp(p) = 0._r8
					pptr%pepv%tempmax_retransn(p) = 0._r8
					pptr%pepv%annmax_retransn(p) = 0._r8
					pptr%pepv%avail_retransn(p) = 0._r8
					pptr%pepv%plant_nalloc(p) = 0._r8
					pptr%pepv%plant_calloc(p) = 0._r8
					pptr%pepv%excess_cflux(p) = 0._r8
					pptr%pepv%downreg(p) = 0._r8
					pptr%pepv%prev_leafc_to_litter(p) = 0._r8
					pptr%pepv%prev_frootc_to_litter(p) = 0._r8
					pptr%pepv%tempsum_npp(p) = 0._r8
					pptr%pepv%annsum_npp(p) = 0._r8
#if (defined C13)
					pptr%pepv%rc13_canair(p) = 0._r8
					pptr%pepv%rc13_psnsun(p) = 0._r8
					pptr%pepv%rc13_psnsha(p) = 0._r8
#endif

				end if  ! end initialization of new pft

				! (still in dwt > 0 block)

				! set the seed sources for leaf and deadstem
				! leaf source is split later between leaf, leaf_storage, leaf_xfer
				leafc_seed   = 0._r8
				leafn_seed   = 0._r8
#if (defined C13)
				leafc13_seed = 0._r8
#endif
				deadstemc_seed   = 0._r8
				deadstemn_seed   = 0._r8
#if (defined C13)
				deadstemc13_seed = 0._r8
#endif
				if (pptr%itype(p) /= 0) then
					leafc_seed = 1._r8
					leafn_seed  = leafc_seed / pftcon%leafcn(pptr%itype(p))
					if (pftcon%woody(pptr%itype(p)) == 1._r8) then
						deadstemc_seed = 0.1_r8
						deadstemn_seed = deadstemc_seed / pftcon%deadwdcn(pptr%itype(p))
					end if

#if (defined C13)
					! 13c state is initialized assuming del13c = -28 permil for C3, and -13 permil for C4.
					! That translates to ratios of (13c/(12c+13c)) of 0.01080455 for C3, and 0.01096945 for C4
					! based on the following formulae: 
					! r1 (13/12) = PDB + (del13c * PDB)/1000.0
					! r2 (13/(13+12)) = r1/(1+r1)
					! PDB = 0.0112372_R8  (ratio of 13C/12C in Pee Dee Belemnite, C isotope standard)
					c3_del13c = -28._r8
					c4_del13c = -13._r8
					c3_r1 = SHR_CONST_PDB + ((c3_del13c*SHR_CONST_PDB)/1000._r8)
					c3_r2 = c3_r1/(1._r8 + c3_r1)
					c4_r1 = SHR_CONST_PDB + ((c4_del13c*SHR_CONST_PDB)/1000._r8)
					c4_r2 = c4_r1/(1._r8 + c4_r1)

					if (pftcon%c3psn(pptr%itype(p)) == 1._r8) then
						leafc13_seed     = leafc_seed     * c3_r2
						deadstemc13_seed = deadstemc_seed * c3_r2
					else
						leafc13_seed     = leafc_seed     * c4_r2
						deadstemc13_seed = deadstemc_seed * c4_r2
					end if 
#endif
				end if

				! When PFT area expands (dwt > 0), the pft-level mass density 
				! is modified to conserve the original pft mass distributed
				! over the new (larger) area, plus a term to account for the 
				! introduction of new seed source for leaf and deadstem
				t1 = wtcol_old(p)/pptr%wtcol(p)
				t2 = dwt/pptr%wtcol(p)

				tot_leaf = pptr%pcs%leafc(p) + pptr%pcs%leafc_storage(p) + pptr%pcs%leafc_xfer(p)
				pleaf = 0._r8
				pstor = 0._r8
				pxfer = 0._r8
				if (tot_leaf /= 0._r8) then
					! when adding seed source to non-zero leaf state, use current proportions
					pleaf = pptr%pcs%leafc(p)/tot_leaf
					pstor = pptr%pcs%leafc_storage(p)/tot_leaf
					pxfer = pptr%pcs%leafc_xfer(p)/tot_leaf
				else
					! when initiating from zero leaf state, use evergreen flag to set proportions
					if (pftcon%evergreen(pptr%itype(p)) == 1._r8) then
						pleaf = 1._r8
					else
						pstor = 1._r8
					end if
				end if 
				pptr%pcs%leafc(p)         = pptr%pcs%leafc(p)*t1         + leafc_seed*pleaf*t2
				pptr%pcs%leafc_storage(p) = pptr%pcs%leafc_storage(p)*t1 + leafc_seed*pstor*t2
				pptr%pcs%leafc_xfer(p)    = pptr%pcs%leafc_xfer(p)*t1    + leafc_seed*pxfer*t2
				pptr%pcs%frootc(p)  		   = pptr%pcs%frootc(p) 			* t1
				pptr%pcs%frootc_storage(p)     = pptr%pcs%frootc_storage(p) 	* t1
				pptr%pcs%frootc_xfer(p) 	   = pptr%pcs%frootc_xfer(p)		* t1
				pptr%pcs%livestemc(p)		   = pptr%pcs%livestemc(p)  		* t1
				pptr%pcs%livestemc_storage(p)  = pptr%pcs%livestemc_storage(p)  * t1
				pptr%pcs%livestemc_xfer(p)     = pptr%pcs%livestemc_xfer(p) 	* t1
				pptr%pcs%deadstemc(p)     = pptr%pcs%deadstemc(p)*t1     + deadstemc_seed*t2
				pptr%pcs%deadstemc_storage(p)  = pptr%pcs%deadstemc_storage(p)  * t1
				pptr%pcs%deadstemc_xfer(p)     = pptr%pcs%deadstemc_xfer(p) 	* t1
				pptr%pcs%livecrootc(p)  	   = pptr%pcs%livecrootc(p) 		* t1
				pptr%pcs%livecrootc_storage(p) = pptr%pcs%livecrootc_storage(p) * t1
				pptr%pcs%livecrootc_xfer(p)    = pptr%pcs%livecrootc_xfer(p)	* t1
				pptr%pcs%deadcrootc(p)  	   = pptr%pcs%deadcrootc(p) 		* t1
				pptr%pcs%deadcrootc_storage(p) = pptr%pcs%deadcrootc_storage(p) * t1
				pptr%pcs%deadcrootc_xfer(p)    = pptr%pcs%deadcrootc_xfer(p)	* t1
				pptr%pcs%gresp_storage(p)	   = pptr%pcs%gresp_storage(p)  	* t1
				pptr%pcs%gresp_xfer(p)  	   = pptr%pcs%gresp_xfer(p) 		* t1
				pptr%pcs%cpool(p)			   = pptr%pcs%cpool(p)  			* t1
				pptr%pcs%xsmrpool(p)		   = pptr%pcs%xsmrpool(p)			* t1
				pptr%pcs%pft_ctrunc(p)  	   = pptr%pcs%pft_ctrunc(p) 		* t1
				pptr%pcs%dispvegc(p)		   = pptr%pcs%dispvegc(p)			* t1
				pptr%pcs%storvegc(p)		   = pptr%pcs%storvegc(p)			* t1
				pptr%pcs%totvegc(p) 		   = pptr%pcs%totvegc(p)			* t1
				pptr%pcs%totpftc(p) 		   = pptr%pcs%totpftc(p)			* t1

#if (defined C13)
				! pft-level carbon-13 state variables 
				tot_leaf = pptr%pc13s%leafc(p) + pptr%pc13s%leafc_storage(p) + pptr%pc13s%leafc_xfer(p)
				pleaf = 0._r8
				pstor = 0._r8
				pxfer = 0._r8
				if (tot_leaf /= 0._r8) then
					pleaf = pptr%pc13s%leafc(p)/tot_leaf
					pstor = pptr%pc13s%leafc_storage(p)/tot_leaf
					pxfer = pptr%pc13s%leafc_xfer(p)/tot_leaf
				else
					! when initiating from zero leaf state, use evergreen flag to set proportions
					if (pftcon%evergreen(pptr%itype(p)) == 1._r8) then
						pleaf = 1._r8
					else
						pstor = 1._r8
					end if
				end if 
				pptr%pc13s%leafc(p)         = pptr%pc13s%leafc(p)*t1         + leafc13_seed*pleaf*t2
				pptr%pc13s%leafc_storage(p) = pptr%pc13s%leafc_storage(p)*t1 + leafc13_seed*pstor*t2
				pptr%pc13s%leafc_xfer(p)    = pptr%pc13s%leafc_xfer(p)*t1    + leafc13_seed*pxfer*t2
				pptr%pc13s%frootc(p)			 = pptr%pc13s%frootc(p) 		* t1
				pptr%pc13s%frootc_storage(p)	         = pptr%pc13s%frootc_storage(p) 	* t1
				pptr%pc13s%frootc_xfer(p)		 = pptr%pc13s%frootc_xfer(p)		* t1
				pptr%pc13s%livestemc(p) 		 = pptr%pc13s%livestemc(p)  		* t1
				pptr%pc13s%livestemc_storage(p)          = pptr%pc13s%livestemc_storage(p)      * t1
				pptr%pc13s%livestemc_xfer(p)	         = pptr%pc13s%livestemc_xfer(p) 	* t1
				pptr%pc13s%deadstemc(p)                  = pptr%pc13s%deadstemc(p)*t1     + deadstemc13_seed*t2
				pptr%pc13s%deadstemc_storage(p)          = pptr%pc13s%deadstemc_storage(p)      * t1
				pptr%pc13s%deadstemc_xfer(p)	         = pptr%pc13s%deadstemc_xfer(p) 	* t1
				pptr%pc13s%livecrootc(p)		 = pptr%pc13s%livecrootc(p) 		* t1
				pptr%pc13s%livecrootc_storage(p)         = pptr%pc13s%livecrootc_storage(p)     * t1
				pptr%pc13s%livecrootc_xfer(p)	         = pptr%pc13s%livecrootc_xfer(p)	* t1
				pptr%pc13s%deadcrootc(p)		 = pptr%pc13s%deadcrootc(p) 		* t1
				pptr%pc13s%deadcrootc_storage(p)         = pptr%pc13s%deadcrootc_storage(p)     * t1
				pptr%pc13s%deadcrootc_xfer(p)	         = pptr%pc13s%deadcrootc_xfer(p)	* t1
				pptr%pc13s%gresp_storage(p) 	         = pptr%pc13s%gresp_storage(p)  	* t1
				pptr%pc13s%gresp_xfer(p)		 = pptr%pc13s%gresp_xfer(p) 		* t1
				pptr%pc13s%cpool(p) 			 = pptr%pc13s%cpool(p)  		* t1
				pptr%pc13s%xsmrpool(p)  		 = pptr%pc13s%xsmrpool(p)		* t1
				pptr%pc13s%pft_ctrunc(p)		 = pptr%pc13s%pft_ctrunc(p) 		* t1
				pptr%pc13s%dispvegc(p)  		 = pptr%pc13s%dispvegc(p)		* t1
				pptr%pc13s%storvegc(p)  		 = pptr%pc13s%storvegc(p)		* t1
				pptr%pc13s%totvegc(p)			 = pptr%pc13s%totvegc(p)		* t1
				pptr%pc13s%totpftc(p)			 = pptr%pc13s%totpftc(p)		* t1
#endif

				tot_leaf = pptr%pns%leafn(p) + pptr%pns%leafn_storage(p) + pptr%pns%leafn_xfer(p)
				pleaf = 0._r8
				pstor = 0._r8
				pxfer = 0._r8
				if (tot_leaf /= 0._r8) then
					pleaf = pptr%pns%leafn(p)/tot_leaf
					pstor = pptr%pns%leafn_storage(p)/tot_leaf
					pxfer = pptr%pns%leafn_xfer(p)/tot_leaf
				else
					! when initiating from zero leaf state, use evergreen flag to set proportions
					if (pftcon%evergreen(pptr%itype(p)) == 1._r8) then
						pleaf = 1._r8
					else
						pstor = 1._r8
					end if
				end if 
				! pft-level nitrogen state variables
				pptr%pns%leafn(p)         = pptr%pns%leafn(p)*t1         + leafn_seed*pleaf*t2
				pptr%pns%leafn_storage(p) = pptr%pns%leafn_storage(p)*t1 + leafn_seed*pstor*t2
				pptr%pns%leafn_xfer(p)    = pptr%pns%leafn_xfer(p)*t1    + leafn_seed*pxfer*t2
				pptr%pns%frootn(p)  		   = pptr%pns%frootn(p) 		* t1
				pptr%pns%frootn_storage(p)         = pptr%pns%frootn_storage(p) 	* t1
				pptr%pns%frootn_xfer(p) 	   = pptr%pns%frootn_xfer(p)		* t1
				pptr%pns%livestemn(p)		   = pptr%pns%livestemn(p)  		* t1
				pptr%pns%livestemn_storage(p)      = pptr%pns%livestemn_storage(p)      * t1
				pptr%pns%livestemn_xfer(p)         = pptr%pns%livestemn_xfer(p) 	* t1
				pptr%pns%deadstemn(p)              = pptr%pns%deadstemn(p)*t1     + deadstemn_seed*t2
				pptr%pns%deadstemn_storage(p)      = pptr%pns%deadstemn_storage(p)      * t1
				pptr%pns%deadstemn_xfer(p)         = pptr%pns%deadstemn_xfer(p) 	* t1
				pptr%pns%livecrootn(p)  	   = pptr%pns%livecrootn(p) 		* t1
				pptr%pns%livecrootn_storage(p)     = pptr%pns%livecrootn_storage(p)     * t1
				pptr%pns%livecrootn_xfer(p)        = pptr%pns%livecrootn_xfer(p)	* t1
				pptr%pns%deadcrootn(p)  	   = pptr%pns%deadcrootn(p) 		* t1
				pptr%pns%deadcrootn_storage(p)     = pptr%pns%deadcrootn_storage(p)     * t1
				pptr%pns%deadcrootn_xfer(p)        = pptr%pns%deadcrootn_xfer(p)        * t1
				pptr%pns%retransn(p)		   = pptr%pns%retransn(p)		* t1
				pptr%pns%npool(p)		   = pptr%pns%npool(p)  		* t1
				pptr%pns%pft_ntrunc(p)  	   = pptr%pns%pft_ntrunc(p)        	* t1
				pptr%pns%dispvegn(p)		   = pptr%pns%dispvegn(p)		* t1
				pptr%pns%storvegn(p)		   = pptr%pns%storvegn(p)		* t1
				pptr%pns%totvegn(p) 		   = pptr%pns%totvegn(p)		* t1
				pptr%pns%totpftn(p) 		   = pptr%pns%totpftn(p)		* t1

				! update temporary seed source arrays
				! These are calculated in terms of the required contributions from
				! column-level seed source
				dwt_leafc_seed(p)   = leafc_seed   * dwt
#if (defined C13)
				dwt_leafc13_seed(p) = leafc13_seed * dwt
#endif
				dwt_leafn_seed(p)   = leafn_seed   * dwt
				dwt_deadstemc_seed(p)   = deadstemc_seed   * dwt
#if (defined C13)
				dwt_deadstemc13_seed(p) = deadstemc13_seed * dwt
#endif
				dwt_deadstemn_seed(p)   = deadstemn_seed   * dwt

			else if (dwt < 0._r8) then

				! if the pft lost weight on the timestep, then the carbon and nitrogen state
				! variables are directed to litter, CWD, and wood product pools.

				! N.B. : the conv_cflux, prod10_cflux, and prod100_cflux fluxes are accumulated
				! as negative values, but the fluxes for pft-to-litter are accumulated as 
				! positive values

				! set local weight variables for this pft
				wt_new = pptr%wtcol(p)
				wt_old = wtcol_old(p)

				!---------------
				! C state update
				!---------------

				! leafc 
				ptr => pptr%pcs%leafc(p)
				init_state = ptr*wt_old
				change_state = ptr*dwt
				new_state = init_state+change_state
				if (wt_new /= 0._r8) then
					ptr = new_state/wt_new
					conv_cflux(p) = conv_cflux(p) + change_state
				else
					ptr = 0._r8
					conv_cflux(p) = conv_cflux(p) - init_state
				end if

				! leafc_storage 
				ptr => pptr%pcs%leafc_storage(p)
				init_state = ptr*wt_old
				change_state = ptr*dwt
				new_state = init_state+change_state
				if (wt_new /= 0._r8) then
					ptr = new_state/wt_new
					conv_cflux(p) = conv_cflux(p) + change_state
				else
					ptr = 0._r8
					conv_cflux(p) = conv_cflux(p) - init_state
				end if

				! leafc_xfer 
				ptr => pptr%pcs%leafc_xfer(p)
				init_state = ptr*wt_old
				change_state = ptr*dwt
				new_state = init_state+change_state
				if (wt_new /= 0._r8) then
					ptr = new_state/wt_new
					conv_cflux(p) = conv_cflux(p) + change_state
				else
					ptr = 0._r8
					conv_cflux(p) = conv_cflux(p) - init_state
				end if

				! frootc 
				ptr => pptr%pcs%frootc(p)
				init_state = ptr*wt_old
				change_state = ptr*dwt
				new_state = init_state+change_state
				if (wt_new /= 0._r8) then
					ptr = new_state/wt_new
					dwt_frootc_to_litter(p) = dwt_frootc_to_litter(p) - change_state
				else
					ptr = 0._r8
					dwt_frootc_to_litter(p) = dwt_frootc_to_litter(p) + init_state
				end if

				! frootc_storage 
				ptr => pptr%pcs%frootc_storage(p)
				init_state = ptr*wt_old
				change_state = ptr*dwt
				new_state = init_state+change_state
				if (wt_new /= 0._r8) then
					ptr = new_state/wt_new
					conv_cflux(p) = conv_cflux(p) + change_state
				else
					ptr = 0._r8
					conv_cflux(p) = conv_cflux(p) - init_state
				end if

				! frootc_xfer 
				ptr => pptr%pcs%frootc_xfer(p)
				init_state = ptr*wt_old
				change_state = ptr*dwt
				new_state = init_state+change_state
				if (wt_new /= 0._r8) then
					ptr = new_state/wt_new
					conv_cflux(p) = conv_cflux(p) + change_state
				else
					ptr = 0._r8
					conv_cflux(p) = conv_cflux(p) - init_state
				end if

				! livestemc 
				ptr => pptr%pcs%livestemc(p)
				init_state = ptr*wt_old
				change_state = ptr*dwt
				new_state = init_state+change_state
				if (wt_new /= 0._r8) then
					ptr = new_state/wt_new
					conv_cflux(p) = conv_cflux(p) + change_state
				else
					ptr = 0._r8
					conv_cflux(p) = conv_cflux(p) - init_state
				end if

				! livestemc_storage 
				ptr => pptr%pcs%livestemc_storage(p)
				init_state = ptr*wt_old
				change_state = ptr*dwt
				new_state = init_state+change_state
				if (wt_new /= 0._r8) then
					ptr = new_state/wt_new
					conv_cflux(p) = conv_cflux(p) + change_state
				else
					ptr = 0._r8
					conv_cflux(p) = conv_cflux(p) - init_state
				end if

				! livestemc_xfer 
				ptr => pptr%pcs%livestemc_xfer(p)
				init_state = ptr*wt_old
				change_state = ptr*dwt
				new_state = init_state+change_state
				if (wt_new /= 0._r8) then
					ptr = new_state/wt_new
					conv_cflux(p) = conv_cflux(p) + change_state
				else
					ptr = 0._r8
					conv_cflux(p) = conv_cflux(p) - init_state
				end if

				! deadstemc 
				ptr => pptr%pcs%deadstemc(p)
				init_state = ptr*wt_old
				change_state = ptr*dwt
				new_state = init_state+change_state
				if (wt_new /= 0._r8) then
					ptr = new_state/wt_new
					conv_cflux(p) = conv_cflux(p) + change_state*pconv(pptr%itype(p))
					prod10_cflux(p) = prod10_cflux(p) + change_state*pprod10(pptr%itype(p))
					prod100_cflux(p) = prod100_cflux(p) + change_state*pprod100(pptr%itype(p))
				else
					ptr = 0._r8
					conv_cflux(p) = conv_cflux(p) - init_state*pconv(pptr%itype(p))
					prod10_cflux(p) = prod10_cflux(p) - init_state*pprod10(pptr%itype(p))
					prod100_cflux(p) = prod100_cflux(p) - init_state*pprod100(pptr%itype(p))
				end if

				! deadstemc_storage 
				ptr => pptr%pcs%deadstemc_storage(p)
				init_state = ptr*wt_old
				change_state = ptr*dwt
				new_state = init_state+change_state
				if (wt_new /= 0._r8) then
					ptr = new_state/wt_new
					conv_cflux(p) = conv_cflux(p) + change_state
				else
					ptr = 0._r8
					conv_cflux(p) = conv_cflux(p) - init_state
				end if

				! deadstemc_xfer 
				ptr => pptr%pcs%deadstemc_xfer(p)
				init_state = ptr*wt_old
				change_state = ptr*dwt
				new_state = init_state+change_state
				if (wt_new /= 0._r8) then
					ptr = new_state/wt_new
					conv_cflux(p) = conv_cflux(p) + change_state
				else
					ptr = 0._r8
					conv_cflux(p) = conv_cflux(p) - init_state
				end if

				! livecrootc 
				ptr => pptr%pcs%livecrootc(p)
				init_state = ptr*wt_old
				change_state = ptr*dwt
				new_state = init_state+change_state
				if (wt_new /= 0._r8) then
					ptr = new_state/wt_new
					dwt_livecrootc_to_litter(p) = dwt_livecrootc_to_litter(p) - change_state
				else
					ptr = 0._r8
					dwt_livecrootc_to_litter(p) = dwt_livecrootc_to_litter(p) + init_state
				end if

				! livecrootc_storage 
				ptr => pptr%pcs%livecrootc_storage(p)
				init_state = ptr*wt_old
				change_state = ptr*dwt
				new_state = init_state+change_state
				if (wt_new /= 0._r8) then
					ptr = new_state/wt_new
					conv_cflux(p) = conv_cflux(p) + change_state
				else
					ptr = 0._r8
					conv_cflux(p) = conv_cflux(p) - init_state
				end if

				! livecrootc_xfer 
				ptr => pptr%pcs%livecrootc_xfer(p)
				init_state = ptr*wt_old
				change_state = ptr*dwt
				new_state = init_state+change_state
				if (wt_new /= 0._r8) then
					ptr = new_state/wt_new
					conv_cflux(p) = conv_cflux(p) + change_state
				else
					ptr = 0._r8
					conv_cflux(p) = conv_cflux(p) - init_state
				end if

				! deadcrootc 
				ptr => pptr%pcs%deadcrootc(p)
				init_state = ptr*wt_old
				change_state = ptr*dwt
				new_state = init_state+change_state
				if (wt_new /= 0._r8) then
					ptr = new_state/wt_new
					dwt_deadcrootc_to_litter(p) = dwt_deadcrootc_to_litter(p) - change_state
				else
					ptr = 0._r8
					dwt_deadcrootc_to_litter(p) = dwt_deadcrootc_to_litter(p) + init_state
				end if

				! deadcrootc_storage 
				ptr => pptr%pcs%deadcrootc_storage(p)
				init_state = ptr*wt_old
				change_state = ptr*dwt
				new_state = init_state+change_state
				if (wt_new /= 0._r8) then
					ptr = new_state/wt_new
					conv_cflux(p) = conv_cflux(p) + change_state
				else
					ptr = 0._r8
					conv_cflux(p) = conv_cflux(p) - init_state
				end if

				! deadcrootc_xfer 
				ptr => pptr%pcs%deadcrootc_xfer(p)
				init_state = ptr*wt_old
				change_state = ptr*dwt
				new_state = init_state+change_state
				if (wt_new /= 0._r8) then
					ptr = new_state/wt_new
					conv_cflux(p) = conv_cflux(p) + change_state
				else
					ptr = 0._r8
					conv_cflux(p) = conv_cflux(p) - init_state
				end if

				! gresp_storage 
				ptr => pptr%pcs%gresp_storage(p)
				init_state = ptr*wt_old
				change_state = ptr*dwt
				new_state = init_state+change_state
				if (wt_new /= 0._r8) then
					ptr = new_state/wt_new
					conv_cflux(p) = conv_cflux(p) + change_state
				else
					ptr = 0._r8
					conv_cflux(p) = conv_cflux(p) - init_state
				end if

				! gresp_xfer 
				ptr => pptr%pcs%gresp_xfer(p)
				init_state = ptr*wt_old
				change_state = ptr*dwt
				new_state = init_state+change_state
				if (wt_new /= 0._r8) then
					ptr = new_state/wt_new
					conv_cflux(p) = conv_cflux(p) + change_state
				else
					ptr = 0._r8
					conv_cflux(p) = conv_cflux(p) - init_state
				end if

				! cpool 
				ptr => pptr%pcs%cpool(p)
				init_state = ptr*wt_old
				change_state = ptr*dwt
				new_state = init_state+change_state
				if (wt_new /= 0._r8) then
					ptr = new_state/wt_new
					conv_cflux(p) = conv_cflux(p) + change_state
				else
					ptr = 0._r8
					conv_cflux(p) = conv_cflux(p) - init_state
				end if

				! xsmrpool 
				ptr => pptr%pcs%xsmrpool(p)
				init_state = ptr*wt_old
				change_state = ptr*dwt
				new_state = init_state+change_state
				if (wt_new /= 0._r8) then
					ptr = new_state/wt_new
					conv_cflux(p) = conv_cflux(p) + change_state
				else
					ptr = 0._r8
					conv_cflux(p) = conv_cflux(p) - init_state
				end if

				! pft_ctrunc 
				ptr => pptr%pcs%pft_ctrunc(p)
				init_state = ptr*wt_old
				change_state = ptr*dwt
				new_state = init_state+change_state
				if (wt_new /= 0._r8) then
					ptr = new_state/wt_new
					conv_cflux(p) = conv_cflux(p) + change_state
				else
					ptr = 0._r8
					conv_cflux(p) = conv_cflux(p) - init_state
				end if

#if (defined C13)
				!-----------------
				! C13 state update
				!-----------------

				! set pointers to the conversion and product pool fluxes for this pft
				! dwt_ptr0 is reserved for local assignment to dwt_xxx_to_litter fluxes
				dwt_ptr1 => conv_c13flux(p)
				dwt_ptr2 => prod10_c13flux(p)
				dwt_ptr3 => prod100_c13flux(p)

				! leafc 
				ptr => pptr%pc13s%leafc(p)
				init_state = ptr*wt_old
				change_state = ptr*dwt
				new_state = init_state+change_state
				if (wt_new /= 0._r8) then
					ptr = new_state/wt_new
					dwt_ptr1 = dwt_ptr1 + change_state
				else
					ptr = 0._r8
					dwt_ptr1 = dwt_ptr1 - init_state
				end if

				! leafc_storage 
				ptr => pptr%pc13s%leafc_storage(p)
				init_state = ptr*wt_old
				change_state = ptr*dwt
				new_state = init_state+change_state
				if (wt_new /= 0._r8) then
					ptr = new_state/wt_new
					dwt_ptr1 = dwt_ptr1 + change_state
				else
					ptr = 0._r8
					dwt_ptr1 = dwt_ptr1 - init_state
				end if

				! leafc_xfer 
				ptr => pptr%pc13s%leafc_xfer(p)
				init_state = ptr*wt_old
				change_state = ptr*dwt
				new_state = init_state+change_state
				if (wt_new /= 0._r8) then
					ptr = new_state/wt_new
					dwt_ptr1 = dwt_ptr1 + change_state
				else
					ptr = 0._r8
					dwt_ptr1 = dwt_ptr1 - init_state
				end if

				! frootc 
				ptr => pptr%pc13s%frootc(p)
				dwt_ptr0 => dwt_frootc13_to_litter(p)
				init_state = ptr*wt_old
				change_state = ptr*dwt
				new_state = init_state+change_state
				if (wt_new /= 0._r8) then
					ptr = new_state/wt_new
					dwt_ptr0 = dwt_ptr0 - change_state
				else
					ptr = 0._r8
					dwt_ptr0 = dwt_ptr0 + init_state
				end if

				! frootc_storage 
				ptr => pptr%pc13s%frootc_storage(p)
				init_state = ptr*wt_old
				change_state = ptr*dwt
				new_state = init_state+change_state
				if (wt_new /= 0._r8) then
					ptr = new_state/wt_new
					dwt_ptr1 = dwt_ptr1 + change_state
				else
					ptr = 0._r8
					dwt_ptr1 = dwt_ptr1 - init_state
				end if

				! frootc_xfer 
				ptr => pptr%pc13s%frootc_xfer(p)
				init_state = ptr*wt_old
				change_state = ptr*dwt
				new_state = init_state+change_state
				if (wt_new /= 0._r8) then
					ptr = new_state/wt_new
					dwt_ptr1 = dwt_ptr1 + change_state
				else
					ptr = 0._r8
					dwt_ptr1 = dwt_ptr1 - init_state
				end if

				! livestemc 
				ptr => pptr%pc13s%livestemc(p)
				init_state = ptr*wt_old
				change_state = ptr*dwt
				new_state = init_state+change_state
				if (wt_new /= 0._r8) then
					ptr = new_state/wt_new
					dwt_ptr1 = dwt_ptr1 + change_state
				else
					ptr = 0._r8
					dwt_ptr1 = dwt_ptr1 - init_state
				end if

				! livestemc_storage 
				ptr => pptr%pc13s%livestemc_storage(p)
				init_state = ptr*wt_old
				change_state = ptr*dwt
				new_state = init_state+change_state
				if (wt_new /= 0._r8) then
					ptr = new_state/wt_new
					dwt_ptr1 = dwt_ptr1 + change_state
				else
					ptr = 0._r8
					dwt_ptr1 = dwt_ptr1 - init_state
				end if

				! livestemc_xfer 
				ptr => pptr%pc13s%livestemc_xfer(p)
				init_state = ptr*wt_old
				change_state = ptr*dwt
				new_state = init_state+change_state
				if (wt_new /= 0._r8) then
					ptr = new_state/wt_new
					dwt_ptr1 = dwt_ptr1 + change_state
				else
					ptr = 0._r8
					dwt_ptr1 = dwt_ptr1 - init_state
				end if

				! deadstemc 
				ptr => pptr%pc13s%deadstemc(p)
				init_state = ptr*wt_old
				change_state = ptr*dwt
				new_state = init_state+change_state
				if (wt_new /= 0._r8) then
					ptr = new_state/wt_new
					dwt_ptr1 = dwt_ptr1 + change_state*pconv(pptr%itype(p))
					dwt_ptr2 = dwt_ptr2 + change_state*pprod10(pptr%itype(p))
					dwt_ptr3 = dwt_ptr3 + change_state*pprod100(pptr%itype(p))
				else
					ptr = 0._r8
					dwt_ptr1 = dwt_ptr1 - init_state*pconv(pptr%itype(p))
					dwt_ptr2 = dwt_ptr2 - init_state*pprod10(pptr%itype(p))
					dwt_ptr3 = dwt_ptr3 - init_state*pprod100(pptr%itype(p))
				end if

				! deadstemc_storage 
				ptr => pptr%pc13s%deadstemc_storage(p)
				init_state = ptr*wt_old
				change_state = ptr*dwt
				new_state = init_state+change_state
				if (wt_new /= 0._r8) then
					ptr = new_state/wt_new
					dwt_ptr1 = dwt_ptr1 + change_state
				else
					ptr = 0._r8
					dwt_ptr1 = dwt_ptr1 - init_state
				end if

				! deadstemc_xfer 
				ptr => pptr%pc13s%deadstemc_xfer(p)
				init_state = ptr*wt_old
				change_state = ptr*dwt
				new_state = init_state+change_state
				if (wt_new /= 0._r8) then
					ptr = new_state/wt_new
					dwt_ptr1 = dwt_ptr1 + change_state
				else
					ptr = 0._r8
					dwt_ptr1 = dwt_ptr1 - init_state
				end if

				! livecrootc 
				ptr => pptr%pc13s%livecrootc(p)
				dwt_ptr0 => dwt_livecrootc13_to_litter(p)
				init_state = ptr*wt_old
				change_state = ptr*dwt
				new_state = init_state+change_state
				if (wt_new /= 0._r8) then
					ptr = new_state/wt_new
					dwt_ptr0 = dwt_ptr0 - change_state
				else
					ptr = 0._r8
					dwt_ptr0 = dwt_ptr0 + init_state
				end if

				! livecrootc_storage 
				ptr => pptr%pc13s%livecrootc_storage(p)
				init_state = ptr*wt_old
				change_state = ptr*dwt
				new_state = init_state+change_state
				if (wt_new /= 0._r8) then
					ptr = new_state/wt_new
					dwt_ptr1 = dwt_ptr1 + change_state
				else
					ptr = 0._r8
					dwt_ptr1 = dwt_ptr1 - init_state
				end if

				! livecrootc_xfer 
				ptr => pptr%pc13s%livecrootc_xfer(p)
				init_state = ptr*wt_old
				change_state = ptr*dwt
				new_state = init_state+change_state
				if (wt_new /= 0._r8) then
					ptr = new_state/wt_new
					dwt_ptr1 = dwt_ptr1 + change_state
				else
					ptr = 0._r8
					dwt_ptr1 = dwt_ptr1 - init_state
				end if

				! deadcrootc 
				ptr => pptr%pc13s%deadcrootc(p)
				dwt_ptr0 => dwt_deadcrootc13_to_litter(p)
				init_state = ptr*wt_old
				change_state = ptr*dwt
				new_state = init_state+change_state
				if (wt_new /= 0._r8) then
					ptr = new_state/wt_new
					dwt_ptr0 = dwt_ptr0 - change_state
				else
					ptr = 0._r8
					dwt_ptr0 = dwt_ptr0 + init_state
				end if

				! deadcrootc_storage 
				ptr => pptr%pc13s%deadcrootc_storage(p)
				init_state = ptr*wt_old
				change_state = ptr*dwt
				new_state = init_state+change_state
				if (wt_new /= 0._r8) then
					ptr = new_state/wt_new
					dwt_ptr1 = dwt_ptr1 + change_state
				else
					ptr = 0._r8
					dwt_ptr1 = dwt_ptr1 - init_state
				end if

				! deadcrootc_xfer 
				ptr => pptr%pc13s%deadcrootc_xfer(p)
				init_state = ptr*wt_old
				change_state = ptr*dwt
				new_state = init_state+change_state
				if (wt_new /= 0._r8) then
					ptr = new_state/wt_new
					dwt_ptr1 = dwt_ptr1 + change_state
				else
					ptr = 0._r8
					dwt_ptr1 = dwt_ptr1 - init_state
				end if

				! gresp_storage 
				ptr => pptr%pc13s%gresp_storage(p)
				init_state = ptr*wt_old
				change_state = ptr*dwt
				new_state = init_state+change_state
				if (wt_new /= 0._r8) then
					ptr = new_state/wt_new
					dwt_ptr1 = dwt_ptr1 + change_state
				else
					ptr = 0._r8
					dwt_ptr1 = dwt_ptr1 - init_state
				end if

				! gresp_xfer 
				ptr => pptr%pc13s%gresp_xfer(p)
				init_state = ptr*wt_old
				change_state = ptr*dwt
				new_state = init_state+change_state
				if (wt_new /= 0._r8) then
					ptr = new_state/wt_new
					dwt_ptr1 = dwt_ptr1 + change_state
				else
					ptr = 0._r8
					dwt_ptr1 = dwt_ptr1 - init_state
				end if

				! cpool 
				ptr => pptr%pc13s%cpool(p)
				init_state = ptr*wt_old
				change_state = ptr*dwt
				new_state = init_state+change_state
				if (wt_new /= 0._r8) then
					ptr = new_state/wt_new
					dwt_ptr1 = dwt_ptr1 + change_state
				else
					ptr = 0._r8
					dwt_ptr1 = dwt_ptr1 - init_state
				end if

				! pft_ctrunc 
				ptr => pptr%pc13s%pft_ctrunc(p)
				init_state = ptr*wt_old
				change_state = ptr*dwt
				new_state = init_state+change_state
				if (wt_new /= 0._r8) then
					ptr = new_state/wt_new
					dwt_ptr1 = dwt_ptr1 + change_state
				else
					ptr = 0._r8
					dwt_ptr1 = dwt_ptr1 - init_state
				end if
#endif

				!---------------
				! N state update
				!---------------

				! set pointers to the conversion and product pool fluxes for this pft
				! dwt_ptr0 is reserved for local assignment to dwt_xxx_to_litter fluxes
				dwt_ptr1 => conv_nflux(p)
				dwt_ptr2 => prod10_nflux(p)
				dwt_ptr3 => prod100_nflux(p)

				! leafn 
				ptr => pptr%pns%leafn(p)
				init_state = ptr*wt_old
				change_state = ptr*dwt
				new_state = init_state+change_state
				if (wt_new /= 0._r8) then
					ptr = new_state/wt_new
					dwt_ptr1 = dwt_ptr1 + change_state
				else
					ptr = 0._r8
					dwt_ptr1 = dwt_ptr1 - init_state
				end if

				! leafn_storage  
				ptr => pptr%pns%leafn_storage(p)
				init_state = ptr*wt_old
				change_state = ptr*dwt
				new_state = init_state+change_state
				if (wt_new /= 0._r8) then
					ptr = new_state/wt_new
					dwt_ptr1 = dwt_ptr1 + change_state
				else
					ptr = 0._r8
					dwt_ptr1 = dwt_ptr1 - init_state
				end if

				! leafn_xfer  
				ptr => pptr%pns%leafn_xfer(p)
				init_state = ptr*wt_old
				change_state = ptr*dwt
				new_state = init_state+change_state
				if (wt_new /= 0._r8) then
					ptr = new_state/wt_new
					dwt_ptr1 = dwt_ptr1 + change_state
				else
					ptr = 0._r8
					dwt_ptr1 = dwt_ptr1 - init_state
				end if

				! frootn 
				ptr => pptr%pns%frootn(p)
				dwt_ptr0 => dwt_frootn_to_litter(p)
				init_state = ptr*wt_old
				change_state = ptr*dwt
				new_state = init_state+change_state
				if (wt_new /= 0._r8) then
					ptr = new_state/wt_new
					dwt_ptr0 = dwt_ptr0 - change_state
				else
					ptr = 0._r8
					dwt_ptr0 = dwt_ptr0 + init_state
				end if

				! frootn_storage 
				ptr => pptr%pns%frootn_storage(p)
				init_state = ptr*wt_old
				change_state = ptr*dwt
				new_state = init_state+change_state
				if (wt_new /= 0._r8) then
					ptr = new_state/wt_new
					dwt_ptr1 = dwt_ptr1 + change_state
				else
					ptr = 0._r8
					dwt_ptr1 = dwt_ptr1 - init_state
				end if

				! frootn_xfer  
				ptr => pptr%pns%frootn_xfer(p)
				init_state = ptr*wt_old
				change_state = ptr*dwt
				new_state = init_state+change_state
				if (wt_new /= 0._r8) then
					ptr = new_state/wt_new
					dwt_ptr1 = dwt_ptr1 + change_state
				else
					ptr = 0._r8
					dwt_ptr1 = dwt_ptr1 - init_state
				end if

				! livestemn  
				ptr => pptr%pns%livestemn(p)
				init_state = ptr*wt_old
				change_state = ptr*dwt
				new_state = init_state+change_state
				if (wt_new /= 0._r8) then
					ptr = new_state/wt_new
					dwt_ptr1 = dwt_ptr1 + change_state
				else
					ptr = 0._r8
					dwt_ptr1 = dwt_ptr1 - init_state
				end if

				! livestemn_storage 
				ptr => pptr%pns%livestemn_storage(p)
				init_state = ptr*wt_old
				change_state = ptr*dwt
				new_state = init_state+change_state
				if (wt_new /= 0._r8) then
					ptr = new_state/wt_new
					dwt_ptr1 = dwt_ptr1 + change_state
				else
					ptr = 0._r8
					dwt_ptr1 = dwt_ptr1 - init_state
				end if

				! livestemn_xfer 
				ptr => pptr%pns%livestemn_xfer(p)
				init_state = ptr*wt_old
				change_state = ptr*dwt
				new_state = init_state+change_state
				if (wt_new /= 0._r8) then
					ptr = new_state/wt_new
					dwt_ptr1 = dwt_ptr1 + change_state
				else
					ptr = 0._r8
					dwt_ptr1 = dwt_ptr1 - init_state
				end if

				! deadstemn 
				ptr => pptr%pns%deadstemn(p)
				init_state = ptr*wt_old
				change_state = ptr*dwt
				new_state = init_state+change_state
				if (wt_new /= 0._r8) then
					ptr = new_state/wt_new
					dwt_ptr1 = dwt_ptr1 + change_state*pconv(pptr%itype(p))
					dwt_ptr2 = dwt_ptr2 + change_state*pprod10(pptr%itype(p))
					dwt_ptr3 = dwt_ptr3 + change_state*pprod100(pptr%itype(p))
				else
					ptr = 0._r8
					dwt_ptr1 = dwt_ptr1 - init_state*pconv(pptr%itype(p))
					dwt_ptr2 = dwt_ptr2 - init_state*pprod10(pptr%itype(p))
					dwt_ptr3 = dwt_ptr3 - init_state*pprod100(pptr%itype(p))
				end if

				! deadstemn_storage 
				ptr => pptr%pns%deadstemn_storage(p)
				init_state = ptr*wt_old
				change_state = ptr*dwt
				new_state = init_state+change_state
				if (wt_new /= 0._r8) then
					ptr = new_state/wt_new
					dwt_ptr1 = dwt_ptr1 + change_state
				else
					ptr = 0._r8
					dwt_ptr1 = dwt_ptr1 - init_state
				end if

				! deadstemn_xfer 
				ptr => pptr%pns%deadstemn_xfer(p)
				init_state = ptr*wt_old
				change_state = ptr*dwt
				new_state = init_state+change_state
				if (wt_new /= 0._r8) then
					ptr = new_state/wt_new
					dwt_ptr1 = dwt_ptr1 + change_state
				else
					ptr = 0._r8
					dwt_ptr1 = dwt_ptr1 - init_state
				end if

				! livecrootn 
				ptr => pptr%pns%livecrootn(p)
				dwt_ptr0 => dwt_livecrootn_to_litter(p)
				init_state = ptr*wt_old
				change_state = ptr*dwt
				new_state = init_state+change_state
				if (wt_new /= 0._r8) then
					ptr = new_state/wt_new
					dwt_ptr0 = dwt_ptr0 - change_state
				else
					ptr = 0._r8
					dwt_ptr0 = dwt_ptr0 + init_state
				end if

				! livecrootn_storage  
				ptr => pptr%pns%livecrootn_storage(p)
				init_state = ptr*wt_old
				change_state = ptr*dwt
				new_state = init_state+change_state
				if (wt_new /= 0._r8) then
					ptr = new_state/wt_new
					dwt_ptr1 = dwt_ptr1 + change_state
				else
					ptr = 0._r8
					dwt_ptr1 = dwt_ptr1 - init_state
				end if

				! livecrootn_xfer  
				ptr => pptr%pns%livecrootn_xfer(p)
				init_state = ptr*wt_old
				change_state = ptr*dwt
				new_state = init_state+change_state
				if (wt_new /= 0._r8) then
					ptr = new_state/wt_new
					dwt_ptr1 = dwt_ptr1 + change_state
				else
					ptr = 0._r8
					dwt_ptr1 = dwt_ptr1 - init_state
				end if

				! deadcrootn 
				ptr => pptr%pns%deadcrootn(p)
				dwt_ptr0 => dwt_deadcrootn_to_litter(p)
				init_state = ptr*wt_old
				change_state = ptr*dwt
				new_state = init_state+change_state
				if (wt_new /= 0._r8) then
					ptr = new_state/wt_new
					dwt_ptr0 = dwt_ptr0 - change_state
				else
					ptr = 0._r8
					dwt_ptr0 = dwt_ptr0 + init_state
				end if

				! deadcrootn_storage  
				ptr => pptr%pns%deadcrootn_storage(p)
				init_state = ptr*wt_old
				change_state = ptr*dwt
				new_state = init_state+change_state
				if (wt_new /= 0._r8) then
					ptr = new_state/wt_new
					dwt_ptr1 = dwt_ptr1 + change_state
				else
					ptr = 0._r8
					dwt_ptr1 = dwt_ptr1 - init_state
				end if

				! deadcrootn_xfer  
				ptr => pptr%pns%deadcrootn_xfer(p)
				init_state = ptr*wt_old
				change_state = ptr*dwt
				new_state = init_state+change_state
				if (wt_new /= 0._r8) then
					ptr = new_state/wt_new
					dwt_ptr1 = dwt_ptr1 + change_state
				else
					ptr = 0._r8
					dwt_ptr1 = dwt_ptr1 - init_state
				end if

				! retransn  
				ptr => pptr%pns%retransn(p)
				init_state = ptr*wt_old
				change_state = ptr*dwt
				new_state = init_state+change_state
				if (wt_new /= 0._r8) then
					ptr = new_state/wt_new
					dwt_ptr1 = dwt_ptr1 + change_state
				else
					ptr = 0._r8
					dwt_ptr1 = dwt_ptr1 - init_state
				end if

				! npool  
				ptr => pptr%pns%npool(p)
				init_state = ptr*wt_old
				change_state = ptr*dwt
				new_state = init_state+change_state
				if (wt_new /= 0._r8) then
					ptr = new_state/wt_new
					dwt_ptr1 = dwt_ptr1 + change_state
				else
					ptr = 0._r8
					dwt_ptr1 = dwt_ptr1 - init_state
				end if
				
				! pft_ntrunc  
				ptr => pptr%pns%pft_ntrunc(p)
				init_state = ptr*wt_old
				change_state = ptr*dwt
				new_state = init_state+change_state
				if (wt_new /= 0._r8) then
					ptr = new_state/wt_new
					dwt_ptr1 = dwt_ptr1 + change_state
				else
					ptr = 0._r8
					dwt_ptr1 = dwt_ptr1 - init_state
				end if
				
			end if       ! weight decreasing
		end if           ! is soil
	end do               ! pft loop
    
	! calculate column-level seeding fluxes
	do pi = 1,max_pft_per_col
		do c = begc, endc
			if ( pi <=  cptr%npfts(c) ) then
				p = cptr%pfti(c) + pi - 1
				
				! C fluxes
				cptr%ccf%dwt_seedc_to_leaf(c) = cptr%ccf%dwt_seedc_to_leaf(c) + dwt_leafc_seed(p)/dt
				cptr%ccf%dwt_seedc_to_deadstem(c) = cptr%ccf%dwt_seedc_to_deadstem(c) &
                                                                    + dwt_deadstemc_seed(p)/dt
				
#if (defined C13)
				! C13 fluxes
                                cptr%cc13f%dwt_seedc_to_leaf(c) = cptr%cc13f%dwt_seedc_to_leaf(c) + dwt_leafc13_seed(p)/dt
                                cptr%cc13f%dwt_seedc_to_deadstem(c) = cptr%cc13f%dwt_seedc_to_deadstem(c) &
                                                                      + dwt_deadstemc13_seed(p)/dt
#endif
				
				! N fluxes
				cptr%cnf%dwt_seedn_to_leaf(c) = cptr%cnf%dwt_seedn_to_leaf(c) + dwt_leafn_seed(p)/dt
				cptr%cnf%dwt_seedn_to_deadstem(c) = cptr%cnf%dwt_seedn_to_deadstem(c) &
                                                                    + dwt_deadstemn_seed(p)/dt
			end if
		end do
	end do


	! calculate pft-to-column for fluxes into litter and CWD pools
	do pi = 1,max_pft_per_col
		do c = begc, endc
			if ( pi <=  cptr%npfts(c) ) then
				p = cptr%pfti(c) + pi - 1

				! fine root litter carbon fluxes
				cptr%ccf%dwt_frootc_to_litr1c(c) = cptr%ccf%dwt_frootc_to_litr1c(c) + &
                                                            (dwt_frootc_to_litter(p)*pftcon%fr_flab(pptr%itype(p)))/dt
				cptr%ccf%dwt_frootc_to_litr2c(c) = cptr%ccf%dwt_frootc_to_litr2c(c) + &
                                                            (dwt_frootc_to_litter(p)*pftcon%fr_fcel(pptr%itype(p)))/dt
				cptr%ccf%dwt_frootc_to_litr3c(c) = cptr%ccf%dwt_frootc_to_litr3c(c) + &
                                                            (dwt_frootc_to_litter(p)*pftcon%fr_flig(pptr%itype(p)))/dt

#if (defined C13)
				! fine root litter C13 fluxes
				cptr%cc13f%dwt_frootc_to_litr1c(c) = cptr%cc13f%dwt_frootc_to_litr1c(c) + &
                                                            (dwt_frootc13_to_litter(p)*pftcon%fr_flab(pptr%itype(p)))/dt
				cptr%cc13f%dwt_frootc_to_litr2c(c) = cptr%cc13f%dwt_frootc_to_litr2c(c) + &
                                                            (dwt_frootc13_to_litter(p)*pftcon%fr_fcel(pptr%itype(p)))/dt
				cptr%cc13f%dwt_frootc_to_litr3c(c) = cptr%cc13f%dwt_frootc_to_litr3c(c) + &
                                                            (dwt_frootc13_to_litter(p)*pftcon%fr_flig(pptr%itype(p)))/dt
#endif

				! fine root litter nitrogen fluxes
				cptr%cnf%dwt_frootn_to_litr1n(c) = cptr%cnf%dwt_frootn_to_litr1n(c) + &
                                                            (dwt_frootn_to_litter(p)*pftcon%fr_flab(pptr%itype(p)))/dt
				cptr%cnf%dwt_frootn_to_litr2n(c) = cptr%cnf%dwt_frootn_to_litr2n(c) + &
                                                            (dwt_frootn_to_litter(p)*pftcon%fr_fcel(pptr%itype(p)))/dt
				cptr%cnf%dwt_frootn_to_litr3n(c) = cptr%cnf%dwt_frootn_to_litr3n(c) + &
                                                            (dwt_frootn_to_litter(p)*pftcon%fr_flig(pptr%itype(p)))/dt

				! livecroot fluxes to cwd
				cptr%ccf%dwt_livecrootc_to_cwdc(c) = cptr%ccf%dwt_livecrootc_to_cwdc(c) + &
                                                            (dwt_livecrootc_to_litter(p))/dt
#if (defined C13)
				cptr%cc13f%dwt_livecrootc_to_cwdc(c) = cptr%cc13f%dwt_livecrootc_to_cwdc(c) + &
                                                            (dwt_livecrootc13_to_litter(p))/dt
#endif
				cptr%cnf%dwt_livecrootn_to_cwdn(c) = cptr%cnf%dwt_livecrootn_to_cwdn(c) + &
                                                            (dwt_livecrootn_to_litter(p))/dt

				! deadcroot fluxes to cwd
				cptr%ccf%dwt_deadcrootc_to_cwdc(c) = cptr%ccf%dwt_deadcrootc_to_cwdc(c) + &
                                                            (dwt_deadcrootc_to_litter(p))/dt
#if (defined C13)
				cptr%cc13f%dwt_deadcrootc_to_cwdc(c) = cptr%cc13f%dwt_deadcrootc_to_cwdc(c) + &
                                                            (dwt_deadcrootc13_to_litter(p))/dt
#endif
				cptr%cnf%dwt_deadcrootn_to_cwdn(c) = cptr%cnf%dwt_deadcrootn_to_cwdn(c) + &
                                                            (dwt_deadcrootn_to_litter(p))/dt
			end if
		end do
	end do

	! calculate pft-to-column for fluxes into product pools and conversion flux
	do pi = 1,max_pft_per_col
		do c = begc,endc
			if (pi <= cptr%npfts(c)) then
				p = cptr%pfti(c) + pi - 1

				! column-level fluxes are accumulated as positive fluxes.
				! column-level C flux updates
				cptr%ccf%dwt_conv_cflux(c) = cptr%ccf%dwt_conv_cflux(c) - conv_cflux(p)/dt
				cptr%ccf%dwt_prod10c_gain(c) = cptr%ccf%dwt_prod10c_gain(c) - prod10_cflux(p)/dt
				cptr%ccf%dwt_prod100c_gain(c) = cptr%ccf%dwt_prod100c_gain(c) - prod100_cflux(p)/dt

#if (defined C13)
				! column-level C13 flux updates
				cptr%cc13f%dwt_conv_cflux(c) = cptr%cc13f%dwt_conv_cflux(c) - conv_c13flux(p)/dt
				cptr%cc13f%dwt_prod10c_gain(c) = cptr%cc13f%dwt_prod10c_gain(c) - prod10_c13flux(p)/dt
				cptr%cc13f%dwt_prod100c_gain(c) = cptr%cc13f%dwt_prod100c_gain(c) - prod100_c13flux(p)/dt
#endif

				! column-level N flux updates
				cptr%cnf%dwt_conv_nflux(c) = cptr%cnf%dwt_conv_nflux(c) - conv_nflux(p)/dt
				cptr%cnf%dwt_prod10n_gain(c) = cptr%cnf%dwt_prod10n_gain(c) - prod10_nflux(p)/dt
				cptr%cnf%dwt_prod100n_gain(c) = cptr%cnf%dwt_prod100n_gain(c) - prod100_nflux(p)/dt

			end if
		end do
	end do

	! Deallocate pft-level flux arrays
        deallocate(dwt_leafc_seed)
        deallocate(dwt_leafn_seed)
#if (defined C13)
        deallocate(dwt_leafc13_seed)
#endif
        deallocate(dwt_deadstemc_seed)
        deallocate(dwt_deadstemn_seed)
#if (defined C13)
        deallocate(dwt_deadstemc13_seed)
#endif
	deallocate(dwt_frootc_to_litter)
	deallocate(dwt_livecrootc_to_litter)
	deallocate(dwt_deadcrootc_to_litter)
#if (defined C13)
	deallocate(dwt_frootc13_to_litter)
	deallocate(dwt_livecrootc13_to_litter)
	deallocate(dwt_deadcrootc13_to_litter)
#endif
	deallocate(dwt_frootn_to_litter)
	deallocate(dwt_livecrootn_to_litter)
	deallocate(dwt_deadcrootn_to_litter)
	deallocate(conv_cflux)
	deallocate(prod10_cflux)
	deallocate(prod100_cflux)
#if (defined C13)
	deallocate(conv_c13flux)
	deallocate(prod10_c13flux)
	deallocate(prod100_c13flux)
#endif
	deallocate(conv_nflux)
	deallocate(prod10_nflux)
	deallocate(prod100_nflux)
    
end subroutine pftdyn_cnbal
#endif


!-----------------------------------------------------------------------
!BOP
!
! !IROUTINE: CNHarvest
!
! !INTERFACE:
subroutine CNHarvest (num_soilc, filter_soilc, num_soilp, filter_soilp)
!
! !DESCRIPTION:
! Harvest mortality routine for coupled carbon-nitrogen code (CN)
!
! !USES:
   use clmtype
   use pftvarcon, only : noveg, nbrdlf_evr_shrub
!
! !ARGUMENTS:
   implicit none
   integer, intent(in) :: num_soilc       ! number of soil columns in filter
   integer, intent(in) :: filter_soilc(:) ! column filter for soil points
   integer, intent(in) :: num_soilp       ! number of soil pfts in filter
   integer, intent(in) :: filter_soilp(:) ! pft filter for soil points
!
! !CALLED FROM:
! subroutine CNEcosystemDyn
!
! !REVISION HISTORY:
! 3/29/04: Created by Peter Thornton
!
! !LOCAL VARIABLES:
!
! local pointers to implicit in arrays
   integer , pointer :: pgridcell(:)   ! pft-level index into gridcell-level quantities
   integer , pointer :: ivt(:)         ! pft vegetation type

   real(r8), pointer :: leafc(:)              ! (gC/m2) leaf C
   real(r8), pointer :: frootc(:)             ! (gC/m2) fine root C
   real(r8), pointer :: livestemc(:)          ! (gC/m2) live stem C
   real(r8), pointer :: deadstemc(:)          ! (gC/m2) dead stem C
   real(r8), pointer :: livecrootc(:)         ! (gC/m2) live coarse root C
   real(r8), pointer :: deadcrootc(:)         ! (gC/m2) dead coarse root C
   real(r8), pointer :: xsmrpool(:)           ! (gC/m2) abstract C pool to meet excess MR demand
   real(r8), pointer :: leafc_storage(:)      ! (gC/m2) leaf C storage
   real(r8), pointer :: frootc_storage(:)     ! (gC/m2) fine root C storage
   real(r8), pointer :: livestemc_storage(:)  ! (gC/m2) live stem C storage
   real(r8), pointer :: deadstemc_storage(:)  ! (gC/m2) dead stem C storage
   real(r8), pointer :: livecrootc_storage(:) ! (gC/m2) live coarse root C storage
   real(r8), pointer :: deadcrootc_storage(:) ! (gC/m2) dead coarse root C storage
   real(r8), pointer :: gresp_storage(:)      ! (gC/m2) growth respiration storage
   real(r8), pointer :: leafc_xfer(:)         ! (gC/m2) leaf C transfer
   real(r8), pointer :: frootc_xfer(:)        ! (gC/m2) fine root C transfer
   real(r8), pointer :: livestemc_xfer(:)     ! (gC/m2) live stem C transfer
   real(r8), pointer :: deadstemc_xfer(:)     ! (gC/m2) dead stem C transfer
   real(r8), pointer :: livecrootc_xfer(:)    ! (gC/m2) live coarse root C transfer
   real(r8), pointer :: deadcrootc_xfer(:)    ! (gC/m2) dead coarse root C transfer
   real(r8), pointer :: gresp_xfer(:)         ! (gC/m2) growth respiration transfer
   real(r8), pointer :: leafn(:)              ! (gN/m2) leaf N
   real(r8), pointer :: frootn(:)             ! (gN/m2) fine root N
   real(r8), pointer :: livestemn(:)          ! (gN/m2) live stem N
   real(r8), pointer :: deadstemn(:)          ! (gN/m2) dead stem N
   real(r8), pointer :: livecrootn(:)         ! (gN/m2) live coarse root N
   real(r8), pointer :: deadcrootn(:)         ! (gN/m2) dead coarse root N
   real(r8), pointer :: retransn(:)           ! (gN/m2) plant pool of retranslocated N
   real(r8), pointer :: leafn_storage(:)      ! (gN/m2) leaf N storage
   real(r8), pointer :: frootn_storage(:)     ! (gN/m2) fine root N storage
   real(r8), pointer :: livestemn_storage(:)  ! (gN/m2) live stem N storage
   real(r8), pointer :: deadstemn_storage(:)  ! (gN/m2) dead stem N storage
   real(r8), pointer :: livecrootn_storage(:) ! (gN/m2) live coarse root N storage
   real(r8), pointer :: deadcrootn_storage(:) ! (gN/m2) dead coarse root N storage
   real(r8), pointer :: leafn_xfer(:)         ! (gN/m2) leaf N transfer
   real(r8), pointer :: frootn_xfer(:)        ! (gN/m2) fine root N transfer
   real(r8), pointer :: livestemn_xfer(:)     ! (gN/m2) live stem N transfer
   real(r8), pointer :: deadstemn_xfer(:)     ! (gN/m2) dead stem N transfer
   real(r8), pointer :: livecrootn_xfer(:)    ! (gN/m2) live coarse root N transfer
   real(r8), pointer :: deadcrootn_xfer(:)    ! (gN/m2) dead coarse root N transfer
!
! local pointers to implicit in/out arrays
!
! local pointers to implicit out arrays
   real(r8), pointer :: hrv_leafc_to_litter(:)
   real(r8), pointer :: hrv_frootc_to_litter(:)
   real(r8), pointer :: hrv_livestemc_to_litter(:)
   real(r8), pointer :: hrv_deadstemc_to_prod10c(:)
   real(r8), pointer :: hrv_deadstemc_to_prod100c(:)
   real(r8), pointer :: hrv_livecrootc_to_litter(:)
   real(r8), pointer :: hrv_deadcrootc_to_litter(:)
   real(r8), pointer :: hrv_xsmrpool_to_atm(:)
   real(r8), pointer :: hrv_leafc_storage_to_litter(:)
   real(r8), pointer :: hrv_frootc_storage_to_litter(:)
   real(r8), pointer :: hrv_livestemc_storage_to_litter(:)
   real(r8), pointer :: hrv_deadstemc_storage_to_litter(:)
   real(r8), pointer :: hrv_livecrootc_storage_to_litter(:)
   real(r8), pointer :: hrv_deadcrootc_storage_to_litter(:)
   real(r8), pointer :: hrv_gresp_storage_to_litter(:)
   real(r8), pointer :: hrv_leafc_xfer_to_litter(:)
   real(r8), pointer :: hrv_frootc_xfer_to_litter(:)
   real(r8), pointer :: hrv_livestemc_xfer_to_litter(:)
   real(r8), pointer :: hrv_deadstemc_xfer_to_litter(:)
   real(r8), pointer :: hrv_livecrootc_xfer_to_litter(:)
   real(r8), pointer :: hrv_deadcrootc_xfer_to_litter(:)
   real(r8), pointer :: hrv_gresp_xfer_to_litter(:)
   real(r8), pointer :: hrv_leafn_to_litter(:)
   real(r8), pointer :: hrv_frootn_to_litter(:)
   real(r8), pointer :: hrv_livestemn_to_litter(:)
   real(r8), pointer :: hrv_deadstemn_to_prod10n(:)
   real(r8), pointer :: hrv_deadstemn_to_prod100n(:)
   real(r8), pointer :: hrv_livecrootn_to_litter(:)
   real(r8), pointer :: hrv_deadcrootn_to_litter(:)
   real(r8), pointer :: hrv_retransn_to_litter(:)
   real(r8), pointer :: hrv_leafn_storage_to_litter(:)
   real(r8), pointer :: hrv_frootn_storage_to_litter(:)
   real(r8), pointer :: hrv_livestemn_storage_to_litter(:)
   real(r8), pointer :: hrv_deadstemn_storage_to_litter(:)
   real(r8), pointer :: hrv_livecrootn_storage_to_litter(:)
   real(r8), pointer :: hrv_deadcrootn_storage_to_litter(:)
   real(r8), pointer :: hrv_leafn_xfer_to_litter(:)
   real(r8), pointer :: hrv_frootn_xfer_to_litter(:)
   real(r8), pointer :: hrv_livestemn_xfer_to_litter(:)
   real(r8), pointer :: hrv_deadstemn_xfer_to_litter(:)
   real(r8), pointer :: hrv_livecrootn_xfer_to_litter(:)
   real(r8), pointer :: hrv_deadcrootn_xfer_to_litter(:)
!
! !OTHER LOCAL VARIABLES:
   integer :: p                         ! pft index
   integer :: g                         ! gridcell index
   integer :: fp                        ! pft filter index
   real(r8):: am                        ! rate for fractional harvest mortality (1/yr)
   real(r8):: m                         ! rate for fractional harvest mortality (1/s)
   real(r8) :: pprod10(1:8)   ! proportion of deadstem to 10-yr product pool  (for tree pfts - 1 through 8)
!EOP
!-----------------------------------------------------------------------

   ! assign local pointers to pft-level arrays
   pgridcell                      => clm3%g%l%c%p%gridcell
   
   ivt                            => clm3%g%l%c%p%itype
   leafc                          => clm3%g%l%c%p%pcs%leafc
   frootc                         => clm3%g%l%c%p%pcs%frootc
   livestemc                      => clm3%g%l%c%p%pcs%livestemc
   deadstemc                      => clm3%g%l%c%p%pcs%deadstemc
   livecrootc                     => clm3%g%l%c%p%pcs%livecrootc
   deadcrootc                     => clm3%g%l%c%p%pcs%deadcrootc
   xsmrpool                       => clm3%g%l%c%p%pcs%xsmrpool
   leafc_storage                  => clm3%g%l%c%p%pcs%leafc_storage
   frootc_storage                 => clm3%g%l%c%p%pcs%frootc_storage
   livestemc_storage              => clm3%g%l%c%p%pcs%livestemc_storage
   deadstemc_storage              => clm3%g%l%c%p%pcs%deadstemc_storage
   livecrootc_storage             => clm3%g%l%c%p%pcs%livecrootc_storage
   deadcrootc_storage             => clm3%g%l%c%p%pcs%deadcrootc_storage
   gresp_storage                  => clm3%g%l%c%p%pcs%gresp_storage
   leafc_xfer                     => clm3%g%l%c%p%pcs%leafc_xfer
   frootc_xfer                    => clm3%g%l%c%p%pcs%frootc_xfer
   livestemc_xfer                 => clm3%g%l%c%p%pcs%livestemc_xfer
   deadstemc_xfer                 => clm3%g%l%c%p%pcs%deadstemc_xfer
   livecrootc_xfer                => clm3%g%l%c%p%pcs%livecrootc_xfer
   deadcrootc_xfer                => clm3%g%l%c%p%pcs%deadcrootc_xfer
   gresp_xfer                     => clm3%g%l%c%p%pcs%gresp_xfer
   leafn                          => clm3%g%l%c%p%pns%leafn
   frootn                         => clm3%g%l%c%p%pns%frootn
   livestemn                      => clm3%g%l%c%p%pns%livestemn
   deadstemn                      => clm3%g%l%c%p%pns%deadstemn
   livecrootn                     => clm3%g%l%c%p%pns%livecrootn
   deadcrootn                     => clm3%g%l%c%p%pns%deadcrootn
   retransn                       => clm3%g%l%c%p%pns%retransn
   leafn_storage                  => clm3%g%l%c%p%pns%leafn_storage
   frootn_storage                 => clm3%g%l%c%p%pns%frootn_storage
   livestemn_storage              => clm3%g%l%c%p%pns%livestemn_storage
   deadstemn_storage              => clm3%g%l%c%p%pns%deadstemn_storage
   livecrootn_storage             => clm3%g%l%c%p%pns%livecrootn_storage
   deadcrootn_storage             => clm3%g%l%c%p%pns%deadcrootn_storage
   leafn_xfer                     => clm3%g%l%c%p%pns%leafn_xfer
   frootn_xfer                    => clm3%g%l%c%p%pns%frootn_xfer
   livestemn_xfer                 => clm3%g%l%c%p%pns%livestemn_xfer
   deadstemn_xfer                 => clm3%g%l%c%p%pns%deadstemn_xfer
   livecrootn_xfer                => clm3%g%l%c%p%pns%livecrootn_xfer
   deadcrootn_xfer                => clm3%g%l%c%p%pns%deadcrootn_xfer
   hrv_leafc_to_litter              => clm3%g%l%c%p%pcf%hrv_leafc_to_litter
   hrv_frootc_to_litter             => clm3%g%l%c%p%pcf%hrv_frootc_to_litter
   hrv_livestemc_to_litter          => clm3%g%l%c%p%pcf%hrv_livestemc_to_litter
   hrv_deadstemc_to_prod10c         => clm3%g%l%c%p%pcf%hrv_deadstemc_to_prod10c
   hrv_deadstemc_to_prod100c        => clm3%g%l%c%p%pcf%hrv_deadstemc_to_prod100c
   hrv_livecrootc_to_litter         => clm3%g%l%c%p%pcf%hrv_livecrootc_to_litter
   hrv_deadcrootc_to_litter         => clm3%g%l%c%p%pcf%hrv_deadcrootc_to_litter
   hrv_xsmrpool_to_atm              => clm3%g%l%c%p%pcf%hrv_xsmrpool_to_atm
   hrv_leafc_storage_to_litter      => clm3%g%l%c%p%pcf%hrv_leafc_storage_to_litter
   hrv_frootc_storage_to_litter     => clm3%g%l%c%p%pcf%hrv_frootc_storage_to_litter
   hrv_livestemc_storage_to_litter  => clm3%g%l%c%p%pcf%hrv_livestemc_storage_to_litter
   hrv_deadstemc_storage_to_litter  => clm3%g%l%c%p%pcf%hrv_deadstemc_storage_to_litter
   hrv_livecrootc_storage_to_litter => clm3%g%l%c%p%pcf%hrv_livecrootc_storage_to_litter
   hrv_deadcrootc_storage_to_litter => clm3%g%l%c%p%pcf%hrv_deadcrootc_storage_to_litter
   hrv_gresp_storage_to_litter      => clm3%g%l%c%p%pcf%hrv_gresp_storage_to_litter
   hrv_leafc_xfer_to_litter         => clm3%g%l%c%p%pcf%hrv_leafc_xfer_to_litter
   hrv_frootc_xfer_to_litter        => clm3%g%l%c%p%pcf%hrv_frootc_xfer_to_litter
   hrv_livestemc_xfer_to_litter     => clm3%g%l%c%p%pcf%hrv_livestemc_xfer_to_litter
   hrv_deadstemc_xfer_to_litter     => clm3%g%l%c%p%pcf%hrv_deadstemc_xfer_to_litter
   hrv_livecrootc_xfer_to_litter    => clm3%g%l%c%p%pcf%hrv_livecrootc_xfer_to_litter
   hrv_deadcrootc_xfer_to_litter    => clm3%g%l%c%p%pcf%hrv_deadcrootc_xfer_to_litter
   hrv_gresp_xfer_to_litter         => clm3%g%l%c%p%pcf%hrv_gresp_xfer_to_litter
   hrv_leafn_to_litter              => clm3%g%l%c%p%pnf%hrv_leafn_to_litter
   hrv_frootn_to_litter             => clm3%g%l%c%p%pnf%hrv_frootn_to_litter
   hrv_livestemn_to_litter          => clm3%g%l%c%p%pnf%hrv_livestemn_to_litter
   hrv_deadstemn_to_prod10n         => clm3%g%l%c%p%pnf%hrv_deadstemn_to_prod10n
   hrv_deadstemn_to_prod100n        => clm3%g%l%c%p%pnf%hrv_deadstemn_to_prod100n
   hrv_livecrootn_to_litter         => clm3%g%l%c%p%pnf%hrv_livecrootn_to_litter
   hrv_deadcrootn_to_litter         => clm3%g%l%c%p%pnf%hrv_deadcrootn_to_litter
   hrv_retransn_to_litter           => clm3%g%l%c%p%pnf%hrv_retransn_to_litter
   hrv_leafn_storage_to_litter      => clm3%g%l%c%p%pnf%hrv_leafn_storage_to_litter
   hrv_frootn_storage_to_litter     => clm3%g%l%c%p%pnf%hrv_frootn_storage_to_litter
   hrv_livestemn_storage_to_litter  => clm3%g%l%c%p%pnf%hrv_livestemn_storage_to_litter
   hrv_deadstemn_storage_to_litter  => clm3%g%l%c%p%pnf%hrv_deadstemn_storage_to_litter
   hrv_livecrootn_storage_to_litter => clm3%g%l%c%p%pnf%hrv_livecrootn_storage_to_litter
   hrv_deadcrootn_storage_to_litter => clm3%g%l%c%p%pnf%hrv_deadcrootn_storage_to_litter
   hrv_leafn_xfer_to_litter         => clm3%g%l%c%p%pnf%hrv_leafn_xfer_to_litter
   hrv_frootn_xfer_to_litter        => clm3%g%l%c%p%pnf%hrv_frootn_xfer_to_litter
   hrv_livestemn_xfer_to_litter     => clm3%g%l%c%p%pnf%hrv_livestemn_xfer_to_litter
   hrv_deadstemn_xfer_to_litter     => clm3%g%l%c%p%pnf%hrv_deadstemn_xfer_to_litter
   hrv_livecrootn_xfer_to_litter    => clm3%g%l%c%p%pnf%hrv_livecrootn_xfer_to_litter
   hrv_deadcrootn_xfer_to_litter    => clm3%g%l%c%p%pnf%hrv_deadcrootn_xfer_to_litter

   ! set deadstem proportions to 10-year product pool. 
   ! remainder (1-pprod10) is assumed to go to 100-year product pool
   ! veg type:       1        2        3       4        5       6        7        8      
   pprod10 =    (/0.75_r8, 0.75_r8, 0.75_r8, 1.0_r8, 0.75_r8, 1.0_r8, 0.75_r8, 0.75_r8/)

   ! pft loop
   do fp = 1,num_soilp
      p = filter_soilp(fp)
      g = pgridcell(p)
      
      ! If this is a tree pft, then
      ! get the annual harvest "mortality" rate (am) from harvest array
      ! and convert to rate per second
      if (ivt(p) > noveg .and. ivt(p) < nbrdlf_evr_shrub) then

         if (do_harvest) then
            am = harvest(g)
            m  = am/(365._r8 * 86400._r8)
         else
            m = 0._r8
         end if   

         ! pft-level harvest carbon fluxes
         ! displayed pools
         hrv_leafc_to_litter(p)               = leafc(p)               * m
         hrv_frootc_to_litter(p)              = frootc(p)              * m
         hrv_livestemc_to_litter(p)           = livestemc(p)           * m
         hrv_deadstemc_to_prod10c(p)          = deadstemc(p)           * m * pprod10(ivt(p))
         hrv_deadstemc_to_prod100c(p)         = deadstemc(p)           * m * (1.0_r8 - pprod10(ivt(p)))
         hrv_livecrootc_to_litter(p)          = livecrootc(p)          * m
         hrv_deadcrootc_to_litter(p)          = deadcrootc(p)          * m
         hrv_xsmrpool_to_atm(p)               = xsmrpool(p)            * m

         ! storage pools
         hrv_leafc_storage_to_litter(p)       = leafc_storage(p)       * m
         hrv_frootc_storage_to_litter(p)      = frootc_storage(p)      * m
         hrv_livestemc_storage_to_litter(p)   = livestemc_storage(p)   * m
         hrv_deadstemc_storage_to_litter(p)   = deadstemc_storage(p)   * m
         hrv_livecrootc_storage_to_litter(p)  = livecrootc_storage(p)  * m
         hrv_deadcrootc_storage_to_litter(p)  = deadcrootc_storage(p)  * m
         hrv_gresp_storage_to_litter(p)       = gresp_storage(p)       * m

         ! transfer pools
         hrv_leafc_xfer_to_litter(p)          = leafc_xfer(p)          * m
         hrv_frootc_xfer_to_litter(p)         = frootc_xfer(p)         * m
         hrv_livestemc_xfer_to_litter(p)      = livestemc_xfer(p)      * m
         hrv_deadstemc_xfer_to_litter(p)      = deadstemc_xfer(p)      * m
         hrv_livecrootc_xfer_to_litter(p)     = livecrootc_xfer(p)     * m
         hrv_deadcrootc_xfer_to_litter(p)     = deadcrootc_xfer(p)     * m
         hrv_gresp_xfer_to_litter(p)          = gresp_xfer(p)          * m

         ! pft-level harvest mortality nitrogen fluxes
         ! displayed pools
         hrv_leafn_to_litter(p)               = leafn(p)               * m
         hrv_frootn_to_litter(p)              = frootn(p)              * m
         hrv_livestemn_to_litter(p)           = livestemn(p)           * m
         hrv_deadstemn_to_prod10n(p)          = deadstemn(p)           * m * pprod10(ivt(p))
         hrv_deadstemn_to_prod100n(p)         = deadstemn(p)           * m * (1.0_r8 - pprod10(ivt(p)))
         hrv_livecrootn_to_litter(p)          = livecrootn(p)          * m
         hrv_deadcrootn_to_litter(p)          = deadcrootn(p)          * m
         hrv_retransn_to_litter(p)            = retransn(p)            * m

         ! storage pools
         hrv_leafn_storage_to_litter(p)       = leafn_storage(p)       * m
         hrv_frootn_storage_to_litter(p)      = frootn_storage(p)      * m
         hrv_livestemn_storage_to_litter(p)   = livestemn_storage(p)   * m
         hrv_deadstemn_storage_to_litter(p)   = deadstemn_storage(p)   * m
         hrv_livecrootn_storage_to_litter(p)  = livecrootn_storage(p)  * m
         hrv_deadcrootn_storage_to_litter(p)  = deadcrootn_storage(p)  * m

         ! transfer pools
         hrv_leafn_xfer_to_litter(p)          = leafn_xfer(p)          * m
         hrv_frootn_xfer_to_litter(p)         = frootn_xfer(p)         * m
         hrv_livestemn_xfer_to_litter(p)      = livestemn_xfer(p)      * m
         hrv_deadstemn_xfer_to_litter(p)      = deadstemn_xfer(p)      * m
         hrv_livecrootn_xfer_to_litter(p)     = livecrootn_xfer(p)     * m
         hrv_deadcrootn_xfer_to_litter(p)     = deadcrootn_xfer(p)     * m
         
      end if  ! end tree block

   end do ! end of pft loop

   ! gather all pft-level litterfall fluxes from harvest to the column
   ! for litter C and N inputs

   call CNHarvestPftToColumn(num_soilc, filter_soilc)

end subroutine CNHarvest
!-----------------------------------------------------------------------

!-----------------------------------------------------------------------
!BOP
!
! !IROUTINE: CNHarvestPftToColumn
!
! !INTERFACE:
subroutine CNHarvestPftToColumn (num_soilc, filter_soilc)
!
! !DESCRIPTION:
! called at the end of CNHarvest to gather all pft-level harvest litterfall fluxes
! to the column level and assign them to the three litter pools
!
! !USES:
  use clmtype
  use clm_varpar, only : max_pft_per_col, maxpatch_pft
!
! !ARGUMENTS:
  implicit none
  integer, intent(in) :: num_soilc       ! number of soil columns in filter
  integer, intent(in) :: filter_soilc(:) ! soil column filter
!
! !CALLED FROM:
! subroutine CNphenology
!
! !REVISION HISTORY:
! 9/8/03: Created by Peter Thornton
!
! !LOCAL VARIABLES:
!
! local pointers to implicit in scalars
   integer , pointer :: ivt(:)      ! pft vegetation type
   real(r8), pointer :: wtcol(:)    ! pft weight relative to column (0-1)
   real(r8), pointer :: pwtgcell(:) ! weight of pft relative to corresponding gridcell
   real(r8), pointer :: lf_flab(:)  ! leaf litter labile fraction
   real(r8), pointer :: lf_fcel(:)  ! leaf litter cellulose fraction
   real(r8), pointer :: lf_flig(:)  ! leaf litter lignin fraction
   real(r8), pointer :: fr_flab(:)  ! fine root litter labile fraction
   real(r8), pointer :: fr_fcel(:)  ! fine root litter cellulose fraction
   real(r8), pointer :: fr_flig(:)  ! fine root litter lignin fraction
   integer , pointer :: npfts(:)    ! number of pfts for each column
   integer , pointer :: pfti(:)     ! beginning pft index for each column
   real(r8), pointer :: hrv_leafc_to_litter(:)
   real(r8), pointer :: hrv_frootc_to_litter(:)
   real(r8), pointer :: hrv_livestemc_to_litter(:)
   real(r8), pointer :: phrv_deadstemc_to_prod10c(:)
   real(r8), pointer :: phrv_deadstemc_to_prod100c(:)
   real(r8), pointer :: hrv_livecrootc_to_litter(:)
   real(r8), pointer :: hrv_deadcrootc_to_litter(:)
   real(r8), pointer :: hrv_leafc_storage_to_litter(:)
   real(r8), pointer :: hrv_frootc_storage_to_litter(:)
   real(r8), pointer :: hrv_livestemc_storage_to_litter(:)
   real(r8), pointer :: hrv_deadstemc_storage_to_litter(:)
   real(r8), pointer :: hrv_livecrootc_storage_to_litter(:)
   real(r8), pointer :: hrv_deadcrootc_storage_to_litter(:)
   real(r8), pointer :: hrv_gresp_storage_to_litter(:)
   real(r8), pointer :: hrv_leafc_xfer_to_litter(:)
   real(r8), pointer :: hrv_frootc_xfer_to_litter(:)
   real(r8), pointer :: hrv_livestemc_xfer_to_litter(:)
   real(r8), pointer :: hrv_deadstemc_xfer_to_litter(:)
   real(r8), pointer :: hrv_livecrootc_xfer_to_litter(:)
   real(r8), pointer :: hrv_deadcrootc_xfer_to_litter(:)
   real(r8), pointer :: hrv_gresp_xfer_to_litter(:)
   real(r8), pointer :: hrv_leafn_to_litter(:)
   real(r8), pointer :: hrv_frootn_to_litter(:)
   real(r8), pointer :: hrv_livestemn_to_litter(:)
   real(r8), pointer :: phrv_deadstemn_to_prod10n(:)
   real(r8), pointer :: phrv_deadstemn_to_prod100n(:)
   real(r8), pointer :: hrv_livecrootn_to_litter(:)
   real(r8), pointer :: hrv_deadcrootn_to_litter(:)
   real(r8), pointer :: hrv_retransn_to_litter(:)
   real(r8), pointer :: hrv_leafn_storage_to_litter(:)
   real(r8), pointer :: hrv_frootn_storage_to_litter(:)
   real(r8), pointer :: hrv_livestemn_storage_to_litter(:)
   real(r8), pointer :: hrv_deadstemn_storage_to_litter(:)
   real(r8), pointer :: hrv_livecrootn_storage_to_litter(:)
   real(r8), pointer :: hrv_deadcrootn_storage_to_litter(:)
   real(r8), pointer :: hrv_leafn_xfer_to_litter(:)
   real(r8), pointer :: hrv_frootn_xfer_to_litter(:)
   real(r8), pointer :: hrv_livestemn_xfer_to_litter(:)
   real(r8), pointer :: hrv_deadstemn_xfer_to_litter(:)
   real(r8), pointer :: hrv_livecrootn_xfer_to_litter(:)
   real(r8), pointer :: hrv_deadcrootn_xfer_to_litter(:)
!
! local pointers to implicit in/out arrays
   real(r8), pointer :: hrv_leafc_to_litr1c(:)
   real(r8), pointer :: hrv_leafc_to_litr2c(:)
   real(r8), pointer :: hrv_leafc_to_litr3c(:)
   real(r8), pointer :: hrv_frootc_to_litr1c(:)
   real(r8), pointer :: hrv_frootc_to_litr2c(:)
   real(r8), pointer :: hrv_frootc_to_litr3c(:)
   real(r8), pointer :: hrv_livestemc_to_cwdc(:)
   real(r8), pointer :: chrv_deadstemc_to_prod10c(:)
   real(r8), pointer :: chrv_deadstemc_to_prod100c(:)
   real(r8), pointer :: hrv_livecrootc_to_cwdc(:)
   real(r8), pointer :: hrv_deadcrootc_to_cwdc(:)
   real(r8), pointer :: hrv_leafc_storage_to_litr1c(:)
   real(r8), pointer :: hrv_frootc_storage_to_litr1c(:)
   real(r8), pointer :: hrv_livestemc_storage_to_litr1c(:)
   real(r8), pointer :: hrv_deadstemc_storage_to_litr1c(:)
   real(r8), pointer :: hrv_livecrootc_storage_to_litr1c(:)
   real(r8), pointer :: hrv_deadcrootc_storage_to_litr1c(:)
   real(r8), pointer :: hrv_gresp_storage_to_litr1c(:)
   real(r8), pointer :: hrv_leafc_xfer_to_litr1c(:)
   real(r8), pointer :: hrv_frootc_xfer_to_litr1c(:)
   real(r8), pointer :: hrv_livestemc_xfer_to_litr1c(:)
   real(r8), pointer :: hrv_deadstemc_xfer_to_litr1c(:)
   real(r8), pointer :: hrv_livecrootc_xfer_to_litr1c(:)
   real(r8), pointer :: hrv_deadcrootc_xfer_to_litr1c(:)
   real(r8), pointer :: hrv_gresp_xfer_to_litr1c(:)
   real(r8), pointer :: hrv_leafn_to_litr1n(:)
   real(r8), pointer :: hrv_leafn_to_litr2n(:)
   real(r8), pointer :: hrv_leafn_to_litr3n(:)
   real(r8), pointer :: hrv_frootn_to_litr1n(:)
   real(r8), pointer :: hrv_frootn_to_litr2n(:)
   real(r8), pointer :: hrv_frootn_to_litr3n(:)
   real(r8), pointer :: hrv_livestemn_to_cwdn(:)
   real(r8), pointer :: chrv_deadstemn_to_prod10n(:)
   real(r8), pointer :: chrv_deadstemn_to_prod100n(:)
   real(r8), pointer :: hrv_livecrootn_to_cwdn(:)
   real(r8), pointer :: hrv_deadcrootn_to_cwdn(:)
   real(r8), pointer :: hrv_retransn_to_litr1n(:)
   real(r8), pointer :: hrv_leafn_storage_to_litr1n(:)
   real(r8), pointer :: hrv_frootn_storage_to_litr1n(:)
   real(r8), pointer :: hrv_livestemn_storage_to_litr1n(:)
   real(r8), pointer :: hrv_deadstemn_storage_to_litr1n(:)
   real(r8), pointer :: hrv_livecrootn_storage_to_litr1n(:)
   real(r8), pointer :: hrv_deadcrootn_storage_to_litr1n(:)
   real(r8), pointer :: hrv_leafn_xfer_to_litr1n(:)
   real(r8), pointer :: hrv_frootn_xfer_to_litr1n(:)
   real(r8), pointer :: hrv_livestemn_xfer_to_litr1n(:)
   real(r8), pointer :: hrv_deadstemn_xfer_to_litr1n(:)
   real(r8), pointer :: hrv_livecrootn_xfer_to_litr1n(:)
   real(r8), pointer :: hrv_deadcrootn_xfer_to_litr1n(:)
!
! local pointers to implicit out arrays
!
!
! !OTHER LOCAL VARIABLES:
   integer :: fc,c,pi,p               ! indices
!EOP
!-----------------------------------------------------------------------

   ! assign local pointers
   lf_flab                        => pftcon%lf_flab
   lf_fcel                        => pftcon%lf_fcel
   lf_flig                        => pftcon%lf_flig
   fr_flab                        => pftcon%fr_flab
   fr_fcel                        => pftcon%fr_fcel
   fr_flig                        => pftcon%fr_flig

   ! assign local pointers to column-level arrays
   npfts                          => clm3%g%l%c%npfts
   pfti                           => clm3%g%l%c%pfti
   hrv_leafc_to_litr1c              => clm3%g%l%c%ccf%hrv_leafc_to_litr1c
   hrv_leafc_to_litr2c              => clm3%g%l%c%ccf%hrv_leafc_to_litr2c
   hrv_leafc_to_litr3c              => clm3%g%l%c%ccf%hrv_leafc_to_litr3c
   hrv_frootc_to_litr1c             => clm3%g%l%c%ccf%hrv_frootc_to_litr1c
   hrv_frootc_to_litr2c             => clm3%g%l%c%ccf%hrv_frootc_to_litr2c
   hrv_frootc_to_litr3c             => clm3%g%l%c%ccf%hrv_frootc_to_litr3c
   hrv_livestemc_to_cwdc            => clm3%g%l%c%ccf%hrv_livestemc_to_cwdc
   chrv_deadstemc_to_prod10c        => clm3%g%l%c%ccf%hrv_deadstemc_to_prod10c
   chrv_deadstemc_to_prod100c       => clm3%g%l%c%ccf%hrv_deadstemc_to_prod100c
   hrv_livecrootc_to_cwdc           => clm3%g%l%c%ccf%hrv_livecrootc_to_cwdc
   hrv_deadcrootc_to_cwdc           => clm3%g%l%c%ccf%hrv_deadcrootc_to_cwdc
   hrv_leafc_storage_to_litr1c      => clm3%g%l%c%ccf%hrv_leafc_storage_to_litr1c
   hrv_frootc_storage_to_litr1c     => clm3%g%l%c%ccf%hrv_frootc_storage_to_litr1c
   hrv_livestemc_storage_to_litr1c  => clm3%g%l%c%ccf%hrv_livestemc_storage_to_litr1c
   hrv_deadstemc_storage_to_litr1c  => clm3%g%l%c%ccf%hrv_deadstemc_storage_to_litr1c
   hrv_livecrootc_storage_to_litr1c => clm3%g%l%c%ccf%hrv_livecrootc_storage_to_litr1c
   hrv_deadcrootc_storage_to_litr1c => clm3%g%l%c%ccf%hrv_deadcrootc_storage_to_litr1c
   hrv_gresp_storage_to_litr1c      => clm3%g%l%c%ccf%hrv_gresp_storage_to_litr1c
   hrv_leafc_xfer_to_litr1c         => clm3%g%l%c%ccf%hrv_leafc_xfer_to_litr1c
   hrv_frootc_xfer_to_litr1c        => clm3%g%l%c%ccf%hrv_frootc_xfer_to_litr1c
   hrv_livestemc_xfer_to_litr1c     => clm3%g%l%c%ccf%hrv_livestemc_xfer_to_litr1c
   hrv_deadstemc_xfer_to_litr1c     => clm3%g%l%c%ccf%hrv_deadstemc_xfer_to_litr1c
   hrv_livecrootc_xfer_to_litr1c    => clm3%g%l%c%ccf%hrv_livecrootc_xfer_to_litr1c
   hrv_deadcrootc_xfer_to_litr1c    => clm3%g%l%c%ccf%hrv_deadcrootc_xfer_to_litr1c
   hrv_gresp_xfer_to_litr1c         => clm3%g%l%c%ccf%hrv_gresp_xfer_to_litr1c
   hrv_leafn_to_litr1n              => clm3%g%l%c%cnf%hrv_leafn_to_litr1n
   hrv_leafn_to_litr2n              => clm3%g%l%c%cnf%hrv_leafn_to_litr2n
   hrv_leafn_to_litr3n              => clm3%g%l%c%cnf%hrv_leafn_to_litr3n
   hrv_frootn_to_litr1n             => clm3%g%l%c%cnf%hrv_frootn_to_litr1n
   hrv_frootn_to_litr2n             => clm3%g%l%c%cnf%hrv_frootn_to_litr2n
   hrv_frootn_to_litr3n             => clm3%g%l%c%cnf%hrv_frootn_to_litr3n
   hrv_livestemn_to_cwdn            => clm3%g%l%c%cnf%hrv_livestemn_to_cwdn
   chrv_deadstemn_to_prod10n        => clm3%g%l%c%cnf%hrv_deadstemn_to_prod10n
   chrv_deadstemn_to_prod100n       => clm3%g%l%c%cnf%hrv_deadstemn_to_prod100n
   hrv_livecrootn_to_cwdn           => clm3%g%l%c%cnf%hrv_livecrootn_to_cwdn
   hrv_deadcrootn_to_cwdn           => clm3%g%l%c%cnf%hrv_deadcrootn_to_cwdn
   hrv_retransn_to_litr1n           => clm3%g%l%c%cnf%hrv_retransn_to_litr1n
   hrv_leafn_storage_to_litr1n      => clm3%g%l%c%cnf%hrv_leafn_storage_to_litr1n
   hrv_frootn_storage_to_litr1n     => clm3%g%l%c%cnf%hrv_frootn_storage_to_litr1n
   hrv_livestemn_storage_to_litr1n  => clm3%g%l%c%cnf%hrv_livestemn_storage_to_litr1n
   hrv_deadstemn_storage_to_litr1n  => clm3%g%l%c%cnf%hrv_deadstemn_storage_to_litr1n
   hrv_livecrootn_storage_to_litr1n => clm3%g%l%c%cnf%hrv_livecrootn_storage_to_litr1n
   hrv_deadcrootn_storage_to_litr1n => clm3%g%l%c%cnf%hrv_deadcrootn_storage_to_litr1n
   hrv_leafn_xfer_to_litr1n         => clm3%g%l%c%cnf%hrv_leafn_xfer_to_litr1n
   hrv_frootn_xfer_to_litr1n        => clm3%g%l%c%cnf%hrv_frootn_xfer_to_litr1n
   hrv_livestemn_xfer_to_litr1n     => clm3%g%l%c%cnf%hrv_livestemn_xfer_to_litr1n
   hrv_deadstemn_xfer_to_litr1n     => clm3%g%l%c%cnf%hrv_deadstemn_xfer_to_litr1n
   hrv_livecrootn_xfer_to_litr1n    => clm3%g%l%c%cnf%hrv_livecrootn_xfer_to_litr1n
   hrv_deadcrootn_xfer_to_litr1n    => clm3%g%l%c%cnf%hrv_deadcrootn_xfer_to_litr1n

   ! assign local pointers to pft-level arrays
   ivt                            => clm3%g%l%c%p%itype
   wtcol                          => clm3%g%l%c%p%wtcol
   pwtgcell                       => clm3%g%l%c%p%wtgcell  
   hrv_leafc_to_litter              => clm3%g%l%c%p%pcf%hrv_leafc_to_litter
   hrv_frootc_to_litter             => clm3%g%l%c%p%pcf%hrv_frootc_to_litter
   hrv_livestemc_to_litter          => clm3%g%l%c%p%pcf%hrv_livestemc_to_litter
   phrv_deadstemc_to_prod10c        => clm3%g%l%c%p%pcf%hrv_deadstemc_to_prod10c
   phrv_deadstemc_to_prod100c       => clm3%g%l%c%p%pcf%hrv_deadstemc_to_prod100c
   hrv_livecrootc_to_litter         => clm3%g%l%c%p%pcf%hrv_livecrootc_to_litter
   hrv_deadcrootc_to_litter         => clm3%g%l%c%p%pcf%hrv_deadcrootc_to_litter
   hrv_leafc_storage_to_litter      => clm3%g%l%c%p%pcf%hrv_leafc_storage_to_litter
   hrv_frootc_storage_to_litter     => clm3%g%l%c%p%pcf%hrv_frootc_storage_to_litter
   hrv_livestemc_storage_to_litter  => clm3%g%l%c%p%pcf%hrv_livestemc_storage_to_litter
   hrv_deadstemc_storage_to_litter  => clm3%g%l%c%p%pcf%hrv_deadstemc_storage_to_litter
   hrv_livecrootc_storage_to_litter => clm3%g%l%c%p%pcf%hrv_livecrootc_storage_to_litter
   hrv_deadcrootc_storage_to_litter => clm3%g%l%c%p%pcf%hrv_deadcrootc_storage_to_litter
   hrv_gresp_storage_to_litter      => clm3%g%l%c%p%pcf%hrv_gresp_storage_to_litter
   hrv_leafc_xfer_to_litter         => clm3%g%l%c%p%pcf%hrv_leafc_xfer_to_litter
   hrv_frootc_xfer_to_litter        => clm3%g%l%c%p%pcf%hrv_frootc_xfer_to_litter
   hrv_livestemc_xfer_to_litter     => clm3%g%l%c%p%pcf%hrv_livestemc_xfer_to_litter
   hrv_deadstemc_xfer_to_litter     => clm3%g%l%c%p%pcf%hrv_deadstemc_xfer_to_litter
   hrv_livecrootc_xfer_to_litter    => clm3%g%l%c%p%pcf%hrv_livecrootc_xfer_to_litter
   hrv_deadcrootc_xfer_to_litter    => clm3%g%l%c%p%pcf%hrv_deadcrootc_xfer_to_litter
   hrv_gresp_xfer_to_litter         => clm3%g%l%c%p%pcf%hrv_gresp_xfer_to_litter
   hrv_leafn_to_litter              => clm3%g%l%c%p%pnf%hrv_leafn_to_litter
   hrv_frootn_to_litter             => clm3%g%l%c%p%pnf%hrv_frootn_to_litter
   hrv_livestemn_to_litter          => clm3%g%l%c%p%pnf%hrv_livestemn_to_litter
   phrv_deadstemn_to_prod10n        => clm3%g%l%c%p%pnf%hrv_deadstemn_to_prod10n
   phrv_deadstemn_to_prod100n       => clm3%g%l%c%p%pnf%hrv_deadstemn_to_prod100n
   hrv_livecrootn_to_litter         => clm3%g%l%c%p%pnf%hrv_livecrootn_to_litter
   hrv_deadcrootn_to_litter         => clm3%g%l%c%p%pnf%hrv_deadcrootn_to_litter
   hrv_retransn_to_litter           => clm3%g%l%c%p%pnf%hrv_retransn_to_litter
   hrv_leafn_storage_to_litter      => clm3%g%l%c%p%pnf%hrv_leafn_storage_to_litter
   hrv_frootn_storage_to_litter     => clm3%g%l%c%p%pnf%hrv_frootn_storage_to_litter
   hrv_livestemn_storage_to_litter  => clm3%g%l%c%p%pnf%hrv_livestemn_storage_to_litter
   hrv_deadstemn_storage_to_litter  => clm3%g%l%c%p%pnf%hrv_deadstemn_storage_to_litter
   hrv_livecrootn_storage_to_litter => clm3%g%l%c%p%pnf%hrv_livecrootn_storage_to_litter
   hrv_deadcrootn_storage_to_litter => clm3%g%l%c%p%pnf%hrv_deadcrootn_storage_to_litter
   hrv_leafn_xfer_to_litter         => clm3%g%l%c%p%pnf%hrv_leafn_xfer_to_litter
   hrv_frootn_xfer_to_litter        => clm3%g%l%c%p%pnf%hrv_frootn_xfer_to_litter
   hrv_livestemn_xfer_to_litter     => clm3%g%l%c%p%pnf%hrv_livestemn_xfer_to_litter
   hrv_deadstemn_xfer_to_litter     => clm3%g%l%c%p%pnf%hrv_deadstemn_xfer_to_litter
   hrv_livecrootn_xfer_to_litter    => clm3%g%l%c%p%pnf%hrv_livecrootn_xfer_to_litter
   hrv_deadcrootn_xfer_to_litter    => clm3%g%l%c%p%pnf%hrv_deadcrootn_xfer_to_litter

   do pi = 1,maxpatch_pft
      do fc = 1,num_soilc
         c = filter_soilc(fc)

         if (pi <=  npfts(c)) then
            p = pfti(c) + pi - 1

            if (pwtgcell(p)>0._r8) then

               ! leaf harvest mortality carbon fluxes
               hrv_leafc_to_litr1c(c) = hrv_leafc_to_litr1c(c) + &
                  hrv_leafc_to_litter(p) * lf_flab(ivt(p)) * wtcol(p)
               hrv_leafc_to_litr2c(c) = hrv_leafc_to_litr2c(c) + &
                  hrv_leafc_to_litter(p) * lf_fcel(ivt(p)) * wtcol(p)
               hrv_leafc_to_litr3c(c) = hrv_leafc_to_litr3c(c) + &
                  hrv_leafc_to_litter(p) * lf_flig(ivt(p)) * wtcol(p)

               ! fine root harvest mortality carbon fluxes
               hrv_frootc_to_litr1c(c) = hrv_frootc_to_litr1c(c) + &
                  hrv_frootc_to_litter(p) * fr_flab(ivt(p)) * wtcol(p)
               hrv_frootc_to_litr2c(c) = hrv_frootc_to_litr2c(c) + &
                  hrv_frootc_to_litter(p) * fr_fcel(ivt(p)) * wtcol(p)
               hrv_frootc_to_litr3c(c) = hrv_frootc_to_litr3c(c) + &
                  hrv_frootc_to_litter(p) * fr_flig(ivt(p)) * wtcol(p)

               ! wood harvest mortality carbon fluxes
               hrv_livestemc_to_cwdc(c)  = hrv_livestemc_to_cwdc(c)  + &
                  hrv_livestemc_to_litter(p)  * wtcol(p)
               chrv_deadstemc_to_prod10c(c)  = chrv_deadstemc_to_prod10c(c)  + &
                  phrv_deadstemc_to_prod10c(p)  * wtcol(p)
               chrv_deadstemc_to_prod100c(c)  = chrv_deadstemc_to_prod100c(c)  + &
                  phrv_deadstemc_to_prod100c(p)  * wtcol(p)
               hrv_livecrootc_to_cwdc(c) = hrv_livecrootc_to_cwdc(c) + &
                  hrv_livecrootc_to_litter(p) * wtcol(p)
               hrv_deadcrootc_to_cwdc(c) = hrv_deadcrootc_to_cwdc(c) + &
                  hrv_deadcrootc_to_litter(p) * wtcol(p)

               ! storage harvest mortality carbon fluxes
               hrv_leafc_storage_to_litr1c(c)      = hrv_leafc_storage_to_litr1c(c)      + &
                  hrv_leafc_storage_to_litter(p)      * wtcol(p)
               hrv_frootc_storage_to_litr1c(c)     = hrv_frootc_storage_to_litr1c(c)     + &
                  hrv_frootc_storage_to_litter(p)     * wtcol(p)
               hrv_livestemc_storage_to_litr1c(c)  = hrv_livestemc_storage_to_litr1c(c)  + &
                  hrv_livestemc_storage_to_litter(p)  * wtcol(p)
               hrv_deadstemc_storage_to_litr1c(c)  = hrv_deadstemc_storage_to_litr1c(c)  + &
                  hrv_deadstemc_storage_to_litter(p)  * wtcol(p)
               hrv_livecrootc_storage_to_litr1c(c) = hrv_livecrootc_storage_to_litr1c(c) + &
                  hrv_livecrootc_storage_to_litter(p) * wtcol(p)
               hrv_deadcrootc_storage_to_litr1c(c) = hrv_deadcrootc_storage_to_litr1c(c) + &
                  hrv_deadcrootc_storage_to_litter(p) * wtcol(p)
               hrv_gresp_storage_to_litr1c(c)      = hrv_gresp_storage_to_litr1c(c)      + &
                  hrv_gresp_storage_to_litter(p)      * wtcol(p)

               ! transfer harvest mortality carbon fluxes
               hrv_leafc_xfer_to_litr1c(c)      = hrv_leafc_xfer_to_litr1c(c)      + &
                  hrv_leafc_xfer_to_litter(p)      * wtcol(p)
               hrv_frootc_xfer_to_litr1c(c)     = hrv_frootc_xfer_to_litr1c(c)     + &
                  hrv_frootc_xfer_to_litter(p)     * wtcol(p)
               hrv_livestemc_xfer_to_litr1c(c)  = hrv_livestemc_xfer_to_litr1c(c)  + &
                  hrv_livestemc_xfer_to_litter(p)  * wtcol(p)
               hrv_deadstemc_xfer_to_litr1c(c)  = hrv_deadstemc_xfer_to_litr1c(c)  + &
                  hrv_deadstemc_xfer_to_litter(p)  * wtcol(p)
               hrv_livecrootc_xfer_to_litr1c(c) = hrv_livecrootc_xfer_to_litr1c(c) + &
                  hrv_livecrootc_xfer_to_litter(p) * wtcol(p)
               hrv_deadcrootc_xfer_to_litr1c(c) = hrv_deadcrootc_xfer_to_litr1c(c) + &
                  hrv_deadcrootc_xfer_to_litter(p) * wtcol(p)
               hrv_gresp_xfer_to_litr1c(c)      = hrv_gresp_xfer_to_litr1c(c)      + &
                  hrv_gresp_xfer_to_litter(p)      * wtcol(p)

               ! leaf harvest mortality nitrogen fluxes
               hrv_leafn_to_litr1n(c) = hrv_leafn_to_litr1n(c) + &
                  hrv_leafn_to_litter(p) * lf_flab(ivt(p)) * wtcol(p)
               hrv_leafn_to_litr2n(c) = hrv_leafn_to_litr2n(c) + &
                  hrv_leafn_to_litter(p) * lf_fcel(ivt(p)) * wtcol(p)
               hrv_leafn_to_litr3n(c) = hrv_leafn_to_litr3n(c) + &
                  hrv_leafn_to_litter(p) * lf_flig(ivt(p)) * wtcol(p)

               ! fine root litter nitrogen fluxes
               hrv_frootn_to_litr1n(c) = hrv_frootn_to_litr1n(c) + &
                  hrv_frootn_to_litter(p) * fr_flab(ivt(p)) * wtcol(p)
               hrv_frootn_to_litr2n(c) = hrv_frootn_to_litr2n(c) + &
                  hrv_frootn_to_litter(p) * fr_fcel(ivt(p)) * wtcol(p)
               hrv_frootn_to_litr3n(c) = hrv_frootn_to_litr3n(c) + &
                  hrv_frootn_to_litter(p) * fr_flig(ivt(p)) * wtcol(p)

               ! wood harvest mortality nitrogen fluxes
               hrv_livestemn_to_cwdn(c)  = hrv_livestemn_to_cwdn(c)  + &
                  hrv_livestemn_to_litter(p)  * wtcol(p)
               chrv_deadstemn_to_prod10n(c)  = chrv_deadstemn_to_prod10n(c)  + &
                  phrv_deadstemn_to_prod10n(p)  * wtcol(p)
               chrv_deadstemn_to_prod100n(c)  = chrv_deadstemn_to_prod100n(c)  + &
                  phrv_deadstemn_to_prod100n(p)  * wtcol(p)
               hrv_livecrootn_to_cwdn(c) = hrv_livecrootn_to_cwdn(c) + &
                  hrv_livecrootn_to_litter(p) * wtcol(p)
               hrv_deadcrootn_to_cwdn(c) = hrv_deadcrootn_to_cwdn(c) + &
                  hrv_deadcrootn_to_litter(p) * wtcol(p)

               ! retranslocated N pool harvest mortality fluxes
               hrv_retransn_to_litr1n(c) = hrv_retransn_to_litr1n(c) + &
                  hrv_retransn_to_litter(p) * wtcol(p)

               ! storage harvest mortality nitrogen fluxes
               hrv_leafn_storage_to_litr1n(c)      = hrv_leafn_storage_to_litr1n(c)      + &
                  hrv_leafn_storage_to_litter(p)      * wtcol(p)
               hrv_frootn_storage_to_litr1n(c)     = hrv_frootn_storage_to_litr1n(c)     + &
                  hrv_frootn_storage_to_litter(p)     * wtcol(p)
               hrv_livestemn_storage_to_litr1n(c)  = hrv_livestemn_storage_to_litr1n(c)  + &
                  hrv_livestemn_storage_to_litter(p)  * wtcol(p)
               hrv_deadstemn_storage_to_litr1n(c)  = hrv_deadstemn_storage_to_litr1n(c)  + &
                  hrv_deadstemn_storage_to_litter(p)  * wtcol(p)
               hrv_livecrootn_storage_to_litr1n(c) = hrv_livecrootn_storage_to_litr1n(c) + &
                  hrv_livecrootn_storage_to_litter(p) * wtcol(p)
               hrv_deadcrootn_storage_to_litr1n(c) = hrv_deadcrootn_storage_to_litr1n(c) + &
                  hrv_deadcrootn_storage_to_litter(p) * wtcol(p)

               ! transfer harvest mortality nitrogen fluxes
               hrv_leafn_xfer_to_litr1n(c)      = hrv_leafn_xfer_to_litr1n(c)      + &
                  hrv_leafn_xfer_to_litter(p)      * wtcol(p)
               hrv_frootn_xfer_to_litr1n(c)     = hrv_frootn_xfer_to_litr1n(c)     + &
                  hrv_frootn_xfer_to_litter(p)     * wtcol(p)
               hrv_livestemn_xfer_to_litr1n(c)  = hrv_livestemn_xfer_to_litr1n(c)  + &
                  hrv_livestemn_xfer_to_litter(p)  * wtcol(p)
               hrv_deadstemn_xfer_to_litr1n(c)  = hrv_deadstemn_xfer_to_litr1n(c)  + &
                  hrv_deadstemn_xfer_to_litter(p)  * wtcol(p)
               hrv_livecrootn_xfer_to_litr1n(c) = hrv_livecrootn_xfer_to_litr1n(c) + &
                  hrv_livecrootn_xfer_to_litter(p) * wtcol(p)
               hrv_deadcrootn_xfer_to_litr1n(c) = hrv_deadcrootn_xfer_to_litr1n(c) + &
                  hrv_deadcrootn_xfer_to_litter(p) * wtcol(p)

            end if
         end if

      end do

   end do

end subroutine CNHarvestPftToColumn
!-----------------------------------------------------------------------

! !ROUTINE: pftdyn_wbal_init
!
! !INTERFACE:
  subroutine pftdyn_wbal_init()
!
! !DESCRIPTION:
! initialize the column-level mass-balance correction term.
! Called in every timestep.
!
! !USES:
!
! !ARGUMENTS:
    implicit none
!
!
! !LOCAL VARIABLES:
!EOP
    integer  :: begp, endp    ! proc beginning and ending pft indices
    integer  :: begc, endc    ! proc beginning and ending column indices
    integer  :: begl, endl    ! proc beginning and ending landunit indices
    integer  :: begg, endg    ! proc beginning and ending gridcell indices
    integer  :: c             ! indices
    type(column_type),   pointer :: cptr         ! pointer to column derived subtype
!-----------------------------------------------------------------------

    ! Set pointers into derived type

    cptr => clm3%g%l%c

    ! Get relevant sizes

    call get_proc_bounds(begg, endg, begl, endl, begc, endc, begp, endp)

    ! set column-level canopy water mass balance correction flux
    ! term to 0 at the beginning of every timestep

    do c = begc,endc
       cptr%cwf%h2ocan_loss(c) = 0._r8
    end do

  end subroutine pftdyn_wbal_init



end module pftdynMod

module filterMod

!-----------------------------------------------------------------------
!BOP
!
! !MODULE: filterMod
!
! !DESCRIPTION:
! Module of filters used for processing columns and pfts of particular
! types, including lake, non-lake, urban, soil, snow, non-snow, and
! naturally-vegetated patches.
!
! !USES:
  use shr_kind_mod, only: r8 => shr_kind_r8
!
! !PUBLIC TYPES:
  implicit none
  save


  type clumpfilter
#if (defined CNDV)
     integer, pointer :: natvegp(:)      ! CNDV nat-vegetated (present) filter (pfts)
     integer :: num_natvegp              ! number of pfts in nat-vegetated filter
#endif
#if (defined CROP)
     integer, pointer :: pcropp(:)       ! prognostic crop filter (pfts)
     integer :: num_pcropp               ! number of pfts in prognostic crop filter
     integer, pointer :: soilnopcropp(:) ! soil w/o prog. crops (pfts)
     integer :: num_soilnopcropp         ! number of pfts in soil w/o prog crops
#endif

     integer, pointer :: lakep(:)        ! lake filter (pfts)
     integer :: num_lakep                ! number of pfts in lake filter
     integer, pointer :: nolakep(:)      ! non-lake filter (pfts)
     integer :: num_nolakep              ! number of pfts in non-lake filter
     integer, pointer :: lakec(:)        ! lake filter (columns)
     integer :: num_lakec                ! number of columns in lake filter
     integer, pointer :: nolakec(:)      ! non-lake filter (columns)
     integer :: num_nolakec              ! number of columns in non-lake filter

     integer, pointer :: soilc(:)        ! soil filter (columns)
     integer :: num_soilc                ! number of columns in soil filter 
     integer, pointer :: soilp(:)        ! soil filter (pfts)
     integer :: num_soilp                ! number of pfts in soil filter 

     integer, pointer :: snowc(:)        ! snow filter (columns) 
     integer :: num_snowc                ! number of columns in snow filter 
     integer, pointer :: nosnowc(:)      ! non-snow filter (columns) 
     integer :: num_nosnowc              ! number of columns in non-snow filter 

     integer, pointer :: hydrologyc(:)   ! hydrology filter (columns)
     integer :: num_hydrologyc           ! number of columns in hydrology filter 

     integer, pointer :: urbanl(:)       ! urban filter (landunits)
     integer :: num_urbanl               ! number of landunits in urban filter 
     integer, pointer :: nourbanl(:)     ! non-urban filter (landunits)
     integer :: num_nourbanl             ! number of landunits in non-urban filter 

     integer, pointer :: urbanc(:)       ! urban filter (columns)
     integer :: num_urbanc               ! number of columns in urban filter
     integer, pointer :: nourbanc(:)     ! non-urban filter (columns)
     integer :: num_nourbanc             ! number of columns in non-urban filter

     integer, pointer :: urbanp(:)       ! urban filter (pfts)
     integer :: num_urbanp               ! number of pfts in urban filter
     integer, pointer :: nourbanp(:)     ! non-urban filter (pfts)
     integer :: num_nourbanp             ! number of pfts in non-urban filter

     integer, pointer :: nolakeurbanp(:) ! non-lake, non-urban filter (pfts)
     integer :: num_nolakeurbanp         ! number of pfts in non-lake, non-urban filter

  end type clumpfilter
  public clumpfilter

  type(clumpfilter), public :: filter
!
  public allocFilters   ! allocate memory for filters
  public setFilters     ! set filters
  public filters_dealloc
!
! !REVISION HISTORY:
! Created by Mariana Vertenstein
! 11/13/03, Peter Thornton: Added soilp and num_soilp
! Jan/08, S. Levis: Added crop-related filters
!
!EOP
!-----------------------------------------------------------------------

contains

!------------------------------------------------------------------------
!BOP
!
! !IROUTINE: allocFilters
!
! !INTERFACE:
  subroutine allocFilters()
!
! !DESCRIPTION:
! Allocate CLM filters.
!
! !USES:
    use clmtype
    use decompMod , only : get_proc_bounds
!
! !ARGUMENTS:
    implicit none
!
! !REVISION HISTORY:
! Created by Mariana Vertenstein
! 2004.04.27 DGVM naturally-vegetated filter added by Forrest Hoffman
!
!EOP
!
! LOCAL VARAIBLES:
    integer :: begp, endp  ! per-clump beginning and ending pft indices
    integer :: begc, endc  ! per-clump beginning and ending column indices
    integer :: begl, endl  ! per-clump beginning and ending landunit indices
    integer :: begg, endg  ! per-clump beginning and ending gridcell indices
!------------------------------------------------------------------------

    ! Determine clump variables for this processor

       call get_proc_bounds(begg, endg, begl, endl, begc, endc, begp, endp)

       allocate(filter%lakep(endp-begp+1))
       allocate(filter%nolakep(endp-begp+1))
       allocate(filter%nolakeurbanp(endp-begp+1))

       allocate(filter%lakec(endc-begc+1))
       allocate(filter%nolakec(endc-begc+1))

       allocate(filter%soilc(endc-begc+1))
       allocate(filter%soilp(endp-begp+1))

       allocate(filter%snowc(endc-begc+1))
       allocate(filter%nosnowc(endc-begc+1))

#if (defined CNDV)
       allocate(filter%natvegp(endp-begp+1))
#endif

       allocate(filter%hydrologyc(endc-begc+1))

       allocate(filter%urbanp(endp-begp+1))
       allocate(filter%nourbanp(endp-begp+1))

       allocate(filter%urbanc(endc-begc+1))
       allocate(filter%nourbanc(endc-begc+1))

       allocate(filter%urbanl(endl-begl+1))
       allocate(filter%nourbanl(endl-begl+1))

#if (defined CROP)
       allocate(filter%pcropp(endp-begp+1))
       allocate(filter%soilnopcropp(endp-begp+1))
#endif

  end subroutine allocFilters

!------------------------------------------------------------------------
!BOP
!
! !IROUTINE: setFilters
!
! !INTERFACE:
  subroutine setFilters()
!
! !DESCRIPTION:
! Set CLM filters.
!
! !USES:
    use clmtype
    use decompMod , only : get_proc_bounds
#if (defined CROP)
    use pftvarcon , only : npcropmin
#endif
    use clm_varcon, only : istsoil, isturb, icol_road_perv
#ifdef CROP
    use clm_varcon, only : istcrop
#endif
!
! !ARGUMENTS:
    implicit none
!
! !REVISION HISTORY:
! Created by Mariana Vertenstein
! 2004.04.27 DGVM naturally-vegetated filter added by Forrest Hoffman
! 2005.09.12 Urban related filters added by Mariana Vertenstein
!
!EOP
!
! LOCAL VARAIBLES:
    integer , pointer :: ctype(:) ! column type
    integer :: c,l,p       ! column, landunit, pft indices
    integer :: fl          ! lake filter index
    integer :: fnl,fnlu    ! non-lake filter index
    integer :: fs          ! soil filter index
    integer :: f, fn       ! general indices
    integer :: begp, endp  ! per-clump beginning and ending pft indices
    integer :: begc, endc  ! per-clump beginning and ending column indices
    integer :: begl, endl  ! per-clump beginning and ending landunit indices
    integer :: begg, endg  ! per-clump beginning and ending gridcell indices
!------------------------------------------------------------------------

    ctype => clm3%g%l%c%itype

    ! Loop over clumps on this processor


       ! Determine clump boundaries

       call get_proc_bounds(begg, endg, begl, endl, begc, endc, begp, endp)

       ! Create lake and non-lake filters at column-level 

       fl = 0
       fnl = 0
       do c = begc,endc
          l = clm3%g%l%c%landunit(c)
          if (clm3%g%l%lakpoi(l)) then
             fl = fl + 1
             filter%lakec(fl) = c
          else
             fnl = fnl + 1
             filter%nolakec(fnl) = c
          end if
       end do
       filter%num_lakec = fl
       filter%num_nolakec = fnl

       ! Create lake and non-lake filters at pft-level 
       ! Filter will only be active if weight of pft wrt gcell is nonzero

       fl = 0
       fnl = 0
       fnlu = 0
       do p = begp,endp
          if (clm3%g%l%c%p%wtgcell(p) > 0._r8) then
             l = clm3%g%l%c%p%landunit(p)
             if (clm3%g%l%lakpoi(l) ) then
                fl = fl + 1
                filter%lakep(fl) = p
             else
                fnl = fnl + 1
                filter%nolakep(fnl) = p
                if (clm3%g%l%itype(l) /= isturb) then
                   fnlu = fnlu + 1
                   filter%nolakeurbanp(fnlu) = p
                end if
             end if
          end if
       end do
       filter%num_lakep = fl
       filter%num_nolakep = fnl
       filter%num_nolakeurbanp = fnlu

       ! Create soil filter at column-level

       fs = 0
       do c = begc,endc
          l = clm3%g%l%c%landunit(c)
#ifndef CROP
          if (clm3%g%l%itype(l) == istsoil) then
#else
          if (clm3%g%l%itype(l) == istsoil .or. clm3%g%l%itype(l) == istcrop) then
#endif
             fs = fs + 1
             filter%soilc(fs) = c
          end if
       end do
       filter%num_soilc = fs

       ! Create soil filter at pft-level
       ! Filter will only be active if weight of pft wrt gcell is nonzero

       fs = 0
       do p = begp,endp
          if (clm3%g%l%c%p%wtgcell(p) > 0._r8) then
             l = clm3%g%l%c%p%landunit(p)
#ifndef CROP
             if (clm3%g%l%itype(l) == istsoil) then
#else
             if (clm3%g%l%itype(l) == istsoil .or. clm3%g%l%itype(l) == istcrop) then
#endif
                fs = fs + 1
                filter%soilp(fs) = p
             end if
          end if
       end do
       filter%num_soilp = fs

#if (defined CROP)
       ! Create prognostic crop and soil w/o prog. crop filters at pft-level
       ! according to where the CROP model should be used

       fl = 0
       fnl = 0
       do p = begp,endp
          if (clm3%g%l%c%p%wtgcell(p) > 0._r8) then
             if (clm3%g%l%c%p%itype(p) >= npcropmin) then !skips 2 generic crop types
                fl = fl + 1
                filter%pcropp(fl) = p
             else
                l = clm3%g%l%c%p%landunit(p)
                if (clm3%g%l%itype(l) == istsoil .or. clm3%g%l%itype(l) == istcrop) then
                   fnl = fnl + 1
                   filter%soilnopcropp(fnl) = p
                end if
             end if
          end if
       end do
       filter%num_pcropp = fl
#endif

       ! Create column-level hydrology filter (soil and Urban pervious road cols) 

       f = 0
       do c = begc,endc
          l = clm3%g%l%c%landunit(c)
#ifndef CROP
          if (clm3%g%l%itype(l) == istsoil .or. ctype(c) == icol_road_perv ) then
#else
          if (clm3%g%l%itype(l) == istsoil .or. clm3%g%l%itype(l) == istcrop .or. ctype(c) == icol_road_perv ) then
#endif
             f = f + 1
             filter%hydrologyc(f) = c
          end if
       end do
       filter%num_hydrologyc = f

       ! Create landunit-level urban and non-urban filters

       f = 0
       fn = 0
       do l = begl,endl
          if (clm3%g%l%itype(l) == isturb) then
             f = f + 1
             filter%urbanl(f) = l
          else
             fn = fn + 1
             filter%nourbanl(fn) = l
          end if
       end do
       filter%num_urbanl = f
       filter%num_nourbanl = fn

       ! Create column-level urban and non-urban filters

       f = 0
       fn = 0
       do c = begc,endc
          l = clm3%g%l%c%landunit(c)
          if (clm3%g%l%itype(l) == isturb) then
             f = f + 1
             filter%urbanc(f) = c
          else
             fn = fn + 1
             filter%nourbanc(fn) = c
          end if
       end do
       filter%num_urbanc = f
       filter%num_nourbanc = fn

       ! Create pft-level urban and non-urban filters

       f = 0
       fn = 0
       do p = begp,endp
          l = clm3%g%l%c%p%landunit(p)
          if (clm3%g%l%itype(l) == isturb .and. clm3%g%l%c%p%wtgcell(p) > 0._r8) then
             f = f + 1
             filter%urbanp(f) = p
          else
             fn = fn + 1
             filter%nourbanp(fn) = p 
          end if
       end do
       filter%num_urbanp = f
       filter%num_nourbanp = fn

       ! Note: snow filters are reconstructed each time step in Hydrology2
       ! Note: CNDV "pft present" filter is reconstructed each time CNDV is run


  end subroutine setFilters

  subroutine filters_dealloc
!
    implicit none
     
       deallocate(filter%lakep)
   call CLMDebug('mark1')
       deallocate(filter%nolakep)
       deallocate(filter%nolakeurbanp)

       deallocate(filter%lakec)
       deallocate(filter%nolakec)

       deallocate(filter%soilc)
       deallocate(filter%soilp)

   
       deallocate(filter%snowc)
       deallocate(filter%nosnowc)

#if (defined CNDV)
       deallocate(filter%natvegp)
#endif

       deallocate(filter%hydrologyc)

       deallocate(filter%urbanp)
       deallocate(filter%nourbanp)

       deallocate(filter%urbanc)
       deallocate(filter%nourbanc)

       deallocate(filter%urbanl)
       deallocate(filter%nourbanl)

#if (defined CROP)
       deallocate(filter%pcropp)
       deallocate(filter%soilnopcropp)
#endif

  call CLMDebug('done  filters_dealloc')
  end subroutine filters_dealloc


end module filterMod

!-----------------------------------------------------------------------
!BOP
!
! !ROUTINE: iniTimeConst
!
! !INTERFACE:
subroutine iniTimeConst
!
! !DESCRIPTION:
! Initialize time invariant clm variables
! 1) removed references to shallow lake - since it is not used
! 2) ***Make c%z, c%zi and c%dz allocatable depending on if you
!    have lake or soil
! 3) rootfr only initialized for soil points
!
! !USES:
  use shr_kind_mod, only : r8 => shr_kind_r8
  use nanMod      , only : nan
  use clmtype
  use decompMod   , only : get_proc_bounds
  use clm_varpar  , only : nlevsoi, nlevgrnd, nlevlak, lsmlon, lsmlat, numpft, numrad, nlevurb
  use clm_varcon  , only : istice, istdlak, istwet, isturb, &
                           icol_roof, icol_sunwall, icol_shadewall, icol_road_perv, icol_road_imperv, &
                           zlak, dzlak, zsoi, dzsoi, zisoi, spval
  use pftvarcon   , only : noveg, ntree, roota_par, rootb_par,  &
                           smpso, smpsc, fnitr, nbrdlf_dcd_brl_shrub, &
                           z0mr, displar, dleaf, rhol, rhos, taul, taus, xl, &
                           qe25, vcmx25, mp, c3psn, slatop, dsladlai, leafcn, flnr, woody, &
                           lflitcn, frootcn, livewdcn, deadwdcn, froot_leaf, stem_leaf, croot_stem, &
                           flivewd, fcur, lf_flab, lf_fcel, lf_flig, fr_flab, fr_fcel, fr_flig, &
                           dw_fcel, dw_flig, leaf_long, evergreen, stress_decid, season_decid, &
                           resist, pftpar20, pftpar28, pftpar29, pftpar30, pftpar31, &
                           allom1s, allom2s, &
                           allom1 , allom2 , allom3  , reinickerp, dwood
#if (defined CROP)
  use pftvarcon   , only : graincn
#endif
  use globals     , only : nstep
  use clm_varsur  , only : gti,soic2d,efisop2d,sand3d,clay3d,organic3d
!
! !ARGUMENTS:
  implicit none
!
! !CALLED FROM:
! subroutine initialize in module initializeMod.
!
! !REVISION HISTORY:
! Created by Gordon Bonan.
! Updated to clm2.1 data structrues by Mariana Vertenstein
! 4/26/05, Peter Thornton: Eliminated exponential decrease in saturated hydraulic
!   conductivity (hksat) with depth. 
! Updated: Colette L. Heald (05/06) reading in VOC emission factors
! 27 February 2008: Keith Oleson; Qing Liu (2004) saturated hydraulic conductivity 
! and matric potential
! 29 February 2008: David Lawrence; modified soil thermal and hydraulic properties to
! account for organic matter
! 18 March 2008: David Lawrence; nlevgrnd changes
! 03/28/08 Mark Flanner, read in netcdf files for SNICAR parameters
!
! !LOCAL VARIABLES:
!
! local pointers to implicit in arguments
!
  integer , pointer :: ivt(:)             !  vegetation type index
  integer , pointer :: pcolumn(:)         ! column index of corresponding pft
  integer , pointer :: pgridcell(:)       ! gridcell index of corresponding pft
  integer , pointer :: clandunit(:)       ! landunit index of column
  integer , pointer :: cgridcell(:)       ! gridcell index of column
  integer , pointer :: ctype(:)           ! column type index
  integer , pointer :: ltype(:)           ! landunit type index
  real(r8), pointer :: thick_wall(:)      ! total thickness of urban wall
  real(r8), pointer :: thick_roof(:)      ! total thickness of urban roof
  real(r8), pointer :: lat(:)             ! gridcell latitude (radians)
!
! local pointers to implicit out arguments
!
  real(r8), pointer :: z(:,:)             ! layer depth (m)
  real(r8), pointer :: zi(:,:)            ! interface level below a "z" level (m)
  real(r8), pointer :: dz(:,:)            ! layer thickness depth (m)
  real(r8), pointer :: rootfr(:,:)        ! fraction of roots in each soil layer
  real(r8), pointer :: rootfr_road_perv(:,:) ! fraction of roots in each soil layer for urban pervious road
  real(r8), pointer :: rresis(:,:)        !root resistance by layer (0-1)  (nlevgrnd)	
  real(r8), pointer :: dewmx(:)           ! maximum allowed dew [mm]
  real(r8), pointer :: bsw(:,:)           ! Clapp and Hornberger "b" (nlevgrnd)  
  real(r8), pointer :: bsw2(:,:)          ! Clapp and Hornberger "b" for CN code
  real(r8), pointer :: psisat(:,:)        ! soil water potential at saturation for CN code (MPa)
  real(r8), pointer :: vwcsat(:,:)        ! volumetric water content at saturation for CN code (m3/m3)
  real(r8), pointer :: watsat(:,:)        ! volumetric soil water at saturation (porosity) (nlevgrnd) 
  real(r8), pointer :: watfc(:,:)         ! volumetric soil water at field capacity (nlevsoi)
  real(r8), pointer :: watdry(:,:)        ! btran parameter for btran=0
  real(r8), pointer :: watopt(:,:)        ! btran parameter for btran = 1
  real(r8), pointer :: hksat(:,:)         ! hydraulic conductivity at saturation (mm H2O /s) (nlevgrnd) 
  real(r8), pointer :: sucsat(:,:)        ! minimum soil suction (mm) (nlevgrnd) 
  real(r8), pointer :: csol(:,:)          ! heat capacity, soil solids (J/m**3/Kelvin) (nlevgrnd) 
  real(r8), pointer :: tkmg(:,:)          ! thermal conductivity, soil minerals  [W/m-K] (new) (nlevgrnd) 
  real(r8), pointer :: tkdry(:,:)         ! thermal conductivity, dry soil (W/m/Kelvin) (nlevgrnd) 
  real(r8), pointer :: tksatu(:,:)        ! thermal conductivity, saturated soil [W/m-K] (new) (nlevgrnd) 
  real(r8), pointer :: wtfact(:)          ! maximum saturated fraction for a gridcell
  real(r8), pointer :: smpmin(:)          ! restriction for min of soil potential (mm) (new)
  real(r8), pointer :: hkdepth(:)         ! decay factor (m)
  integer , pointer :: isoicol(:)         ! soil color class
  real(r8), pointer :: gwc_thr(:)         ! threshold soil moisture based on clay content
  real(r8), pointer :: mss_frc_cly_vld(:) ! [frc] Mass fraction clay limited to 0.20
  real(r8), pointer :: forc_ndep(:)       ! nitrogen deposition rate (gN/m2/s)
  real(r8), pointer :: efisop(:,:)        ! emission factors for isoprene (ug isoprene m-2 h-1)
  real(r8), pointer :: max_dayl(:)        ! maximum daylength (s)
  real(r8), pointer :: sandfrac(:)
  real(r8), pointer :: clayfrac(:)
!
!
! !OTHER LOCAL VARIABLES:
!EOP
  integer  :: ncid             ! netCDF file id 
  integer  :: n,j,ib,lev,bottom! indices
  integer  :: g,l,c,p          ! indices
  integer  :: m                ! vegetation type index
  real(r8) :: bd               ! bulk density of dry soil material [kg/m^3]
  real(r8) :: tkm              ! mineral conductivity
  real(r8) :: xksat            ! maximum hydraulic conductivity of soil [mm/s]
  real(r8) :: scalez = 0.025_r8   ! Soil layer thickness discretization (m)
  real(r8) :: clay,sand        ! temporaries
  real(r8) :: slope,intercept        ! temporary, for rooting distribution
  real(r8) :: temp, max_decl   ! temporary, for calculation of max_dayl
  integer  :: begp, endp       ! per-proc beginning and ending pft indices
  integer  :: begc, endc       ! per-proc beginning and ending column indices
  integer  :: begl, endl       ! per-proc beginning and ending landunit indices
  integer  :: begg, endg       ! per-proc gridcell ending gridcell indices


  real(r8) :: om_frac                ! organic matter fraction
  real(r8) :: om_watsat    = 0.9_r8  ! porosity of organic soil
  real(r8) :: om_hksat     = 0.1_r8  ! saturated hydraulic conductivity of organic soil [mm/s]
  real(r8) :: om_tkm       = 0.25_r8 ! thermal conductivity of organic soil (Farouki, 1986) [W/m/K]
  real(r8) :: om_sucsat    = 10.3_r8 ! saturated suction for organic matter (Letts, 2000)
  real(r8) :: om_csol      = 2.5_r8  ! heat capacity of peat soil *10^6 (J/K m3) (Farouki, 1986)
  real(r8) :: om_tkd       = 0.05_r8 ! thermal conductivity of dry organic soil (Farouki, 1981)
  real(r8) :: om_b         = 2.7_r8  ! Clapp Hornberger paramater for oragnic soil (Letts, 2000)
  real(r8) :: organic_max  = 130._r8 ! organic matter (kg/m3) where soil is assumed to act like peat 
  real(r8) :: csol_bedrock = 2.0e6_r8 ! vol. heat capacity of granite/sandstone  J/(m3 K)(Shabbir, 2000)
  real(r8) :: pc           = 0.5_r8   ! percolation threshold
  real(r8) :: pcbeta       = 0.139_r8 ! percolation exponent
  real(r8) :: perc_frac               ! "percolating" fraction of organic soil
  real(r8) :: perc_norm               ! normalize to 1 when 100% organic soil
  real(r8) :: uncon_hksat             ! series conductivity of mineral/organic soil
  real(r8) :: uncon_frac              ! fraction of "unconnected" soil
  integer  :: start(3),count(3)      ! netcdf start/count arrays
  integer  :: varid                  ! netCDF id's
  integer  :: ret

  integer  :: ier                                ! error status
  character(len=256) :: locfn                    ! local filename
  character(len= 32) :: subname = 'iniTimeConst' ! subroutine name
  integer :: mxsoil_color                        ! maximum number of soil color classes
  real(r8), allocatable :: zurb_wall(:,:)        ! wall (layer node depth)
  real(r8), allocatable :: zurb_roof(:,:)        ! roof (layer node depth)
  real(r8), allocatable :: dzurb_wall(:,:)       ! wall (layer thickness)
  real(r8), allocatable :: dzurb_roof(:,:)       ! roof (layer thickness)
  real(r8), allocatable :: ziurb_wall(:,:)       ! wall (layer interface)
  real(r8), allocatable :: ziurb_roof(:,:)       ! roof (layer interface)
!------------------------------------------------------------------------

  integer :: closelatidx,closelonidx
  real(r8):: closelat,closelon
  integer :: iostat

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

 !  write(6,*) 'Attempting to initialize time invariant variables'

  call get_proc_bounds(begg, endg, begl, endl, begc, endc, begp, endp)


  efisop          => clm3%g%gve%efisop

  ! Assign local pointers to derived subtypes components (gridcell-level)
  lat             => clm3%g%lat
     
  ! Assign local pointers to derived subtypes components (landunit-level)

  ltype               => clm3%g%l%itype
  thick_wall          => clm3%g%l%lps%thick_wall
  thick_roof          => clm3%g%l%lps%thick_roof

  ! Assign local pointers to derived subtypes components (column-level)

  ctype           => clm3%g%l%c%itype
  clandunit       => clm3%g%l%c%landunit
  cgridcell       => clm3%g%l%c%gridcell
  z               => clm3%g%l%c%cps%z
  dz              => clm3%g%l%c%cps%dz
  zi              => clm3%g%l%c%cps%zi
  bsw             => clm3%g%l%c%cps%bsw
  bsw2            => clm3%g%l%c%cps%bsw2
  psisat          => clm3%g%l%c%cps%psisat
  vwcsat          => clm3%g%l%c%cps%vwcsat
  watsat          => clm3%g%l%c%cps%watsat
  watfc           => clm3%g%l%c%cps%watfc
  watdry          => clm3%g%l%c%cps%watdry  
  watopt          => clm3%g%l%c%cps%watopt  
  rootfr_road_perv => clm3%g%l%c%cps%rootfr_road_perv
  hksat           => clm3%g%l%c%cps%hksat
  sucsat          => clm3%g%l%c%cps%sucsat
  tkmg            => clm3%g%l%c%cps%tkmg
  tksatu          => clm3%g%l%c%cps%tksatu
  tkdry           => clm3%g%l%c%cps%tkdry
  csol            => clm3%g%l%c%cps%csol
  smpmin          => clm3%g%l%c%cps%smpmin
  hkdepth         => clm3%g%l%c%cps%hkdepth
  wtfact          => clm3%g%l%c%cps%wtfact
  isoicol         => clm3%g%l%c%cps%isoicol
  gwc_thr         => clm3%g%l%c%cps%gwc_thr
  mss_frc_cly_vld => clm3%g%l%c%cps%mss_frc_cly_vld
  max_dayl        => clm3%g%l%c%cps%max_dayl
  forc_ndep       => clm_a2l%forc_ndep


  ! Assign local pointers to derived subtypes components (pft-level)

  ivt             => clm3%g%l%c%p%itype
  pgridcell       => clm3%g%l%c%p%gridcell
  pcolumn         => clm3%g%l%c%p%column
  dewmx           => clm3%g%l%c%p%pps%dewmx
  rootfr          => clm3%g%l%c%p%pps%rootfr
  rresis          => clm3%g%l%c%p%pps%rresis
  sandfrac        => clm3%g%l%c%p%pps%sandfrac
  clayfrac        => clm3%g%l%c%p%pps%clayfrac

  allocate(zurb_wall(begl:endl,nlevurb), zurb_roof(begl:endl,nlevurb), &
           dzurb_wall(begl:endl,nlevurb), dzurb_roof(begl:endl,nlevurb), &
           ziurb_wall(begl:endl,0:nlevurb), ziurb_roof(begl:endl,0:nlevurb),  stat=ier)
  if (ier /= 0) then
     call endrun( 'iniTimeConst: allocation error for zurb_wall,zurb_roof,dzurb_wall,dzurb_roof,ziurb_wall,ziurb_roof' )
  end if

  ! --------------------------------------------------------------------
  ! Read soil color, sand and clay from surface dataset 
  ! --------------------------------------------------------------------

  call CLMDebug('TimeConst mark1')
  
  do p = begp,endp
     g = pgridcell(p)
     sandfrac(p) = sand3d(g,1)/100.0_r8
     clayfrac(p) = clay3d(g,1)/100.0_r8
  end do


   do m = 0,numpft
      if (m <= ntree) then
         pftcon%tree(m) = 1
      else
         pftcon%tree(m) = 0
      end if
      pftcon%z0mr(m) = z0mr(m)
      pftcon%displar(m) = displar(m)
      pftcon%dleaf(m) = dleaf(m)
      pftcon%xl(m) = xl(m)
      do ib = 1,numrad
         pftcon%rhol(m,ib) = rhol(m,ib)
         pftcon%rhos(m,ib) = rhos(m,ib)
         pftcon%taul(m,ib) = taul(m,ib)
         pftcon%taus(m,ib) = taus(m,ib)
      end do
      pftcon%qe25(m) = qe25(m)
      pftcon%vcmx25(m) = vcmx25(m)
      pftcon%mp(m) = mp(m)
      pftcon%c3psn(m) = c3psn(m)
      pftcon%slatop(m) = slatop(m)
      pftcon%dsladlai(m) = dsladlai(m)
      pftcon%leafcn(m) = leafcn(m)
      pftcon%flnr(m) = flnr(m)
      pftcon%smpso(m) = smpso(m)
      pftcon%smpsc(m) = smpsc(m)
      pftcon%fnitr(m) = fnitr(m)
      pftcon%woody(m) = woody(m)
      pftcon%lflitcn(m) = lflitcn(m)
      pftcon%frootcn(m) = frootcn(m)
      pftcon%livewdcn(m) = livewdcn(m)
      pftcon%deadwdcn(m) = deadwdcn(m)
#if (defined CROP)
      pftcon%graincn(m) = graincn(m)
#endif
      pftcon%froot_leaf(m) = froot_leaf(m)
      pftcon%stem_leaf(m) = stem_leaf(m)
      pftcon%croot_stem(m) = croot_stem(m)
      pftcon%flivewd(m) = flivewd(m)
      pftcon%fcur(m) = fcur(m)
      pftcon%lf_flab(m) = lf_flab(m)
      pftcon%lf_fcel(m) = lf_fcel(m)
      pftcon%lf_flig(m) = lf_flig(m)
      pftcon%fr_flab(m) = fr_flab(m)
      pftcon%fr_fcel(m) = fr_fcel(m)
      pftcon%fr_flig(m) = fr_flig(m)
      pftcon%dw_fcel(m) = dw_fcel(m)
      pftcon%dw_flig(m) = dw_flig(m)
      pftcon%leaf_long(m) = leaf_long(m)
      pftcon%evergreen(m) = evergreen(m)
      pftcon%stress_decid(m) = stress_decid(m)
      pftcon%season_decid(m) = season_decid(m)
      pftcon%resist(m) = resist(m)
      pftcon%dwood(m) = dwood
   end do

#ifdef CNDV
   do m = 0,numpft
      dgv_pftcon%crownarea_max(m) = pftpar20(m)
      dgv_pftcon%tcmin(m) = pftpar28(m)
      dgv_pftcon%tcmax(m) = pftpar29(m)
      dgv_pftcon%gddmin(m) = pftpar30(m)
      dgv_pftcon%twmax(m) = pftpar31(m)
      dgv_pftcon%reinickerp(m) = reinickerp
      dgv_pftcon%allom1(m) = allom1
      dgv_pftcon%allom2(m) = allom2
      dgv_pftcon%allom3(m) = allom3
      ! modification for shrubs by X.D.Z
      if (m > ntree .and. m <= nbrdlf_dcd_brl_shrub ) then 
         dgv_pftcon%allom1(m) = allom1s
         dgv_pftcon%allom2(m) = allom2s
      end if
   end do
#endif

   ! --------------------------------------------------------------------
   ! Define layer structure for soil, lakes, urban walls and roof 
   ! Vertical profile of snow is not initialized here 
   ! --------------------------------------------------------------------

   ! Lake layers (assumed same for all lake patches)

   dzlak(1) = 0.1_r8
   dzlak(2) = 1._r8
   dzlak(3) = 2._r8
   dzlak(4) = 3._r8
   dzlak(5) = 4._r8
   dzlak(6) = 5._r8
   dzlak(7) = 7._r8
   dzlak(8) = 7._r8
   dzlak(9) = 10.45_r8
   dzlak(10)= 10.45_r8

   zlak(1) =  0.05_r8
   zlak(2) =  0.6_r8
   zlak(3) =  2.1_r8
   zlak(4) =  4.6_r8
   zlak(5) =  8.1_r8
   zlak(6) = 12.6_r8
   zlak(7) = 18.6_r8
   zlak(8) = 25.6_r8
   zlak(9) = 34.325_r8
   zlak(10)= 44.775_r8

   ! Soil layers and interfaces (assumed same for all non-lake patches)
   ! "0" refers to soil surface and "nlevsoi" refers to the bottom of model soil

   do j = 1, nlevgrnd
      zsoi(j) = scalez*(exp(0.5_r8*(j-0.5_r8))-1._r8)    !node depths
   enddo

   dzsoi(1) = 0.5_r8*(zsoi(1)+zsoi(2))             !thickness b/n two interfaces
   do j = 2,nlevgrnd-1
      dzsoi(j)= 0.5_r8*(zsoi(j+1)-zsoi(j-1))
   enddo
   dzsoi(nlevgrnd) = zsoi(nlevgrnd)-zsoi(nlevgrnd-1)

   zisoi(0) = 0._r8
   do j = 1, nlevgrnd-1
      zisoi(j) = 0.5_r8*(zsoi(j)+zsoi(j+1))         !interface depths
   enddo
   zisoi(nlevgrnd) = zsoi(nlevgrnd) + 0.5_r8*dzsoi(nlevgrnd)

   ! Column level initialization for urban wall and roof layers and interfaces
   do l = begl, endl

   ! "0" refers to urban wall/roof surface and "nlevsoi" refers to urban wall/roof bottom
    if (ltype(l)==isturb) then
   
      do j = 1, nlevurb
        zurb_wall(l,j) = (j-0.5)*(thick_wall(l)/float(nlevurb))  !node depths
      end do
      do j = 1, nlevurb
        zurb_roof(l,j) = (j-0.5)*(thick_roof(l)/float(nlevurb))  !node depths
      end do

      dzurb_wall(l,1) = 0.5*(zurb_wall(l,1)+zurb_wall(l,2))    !thickness b/n two interfaces
      do j = 2,nlevurb-1
        dzurb_wall(l,j)= 0.5*(zurb_wall(l,j+1)-zurb_wall(l,j-1)) 
      enddo
      dzurb_wall(l,nlevurb) = zurb_wall(l,nlevurb)-zurb_wall(l,nlevurb-1)

      dzurb_roof(l,1) = 0.5*(zurb_roof(l,1)+zurb_roof(l,2))    !thickness b/n two interfaces
      do j = 2,nlevurb-1
        dzurb_roof(l,j)= 0.5*(zurb_roof(l,j+1)-zurb_roof(l,j-1)) 
      enddo
      dzurb_roof(l,nlevurb) = zurb_roof(l,nlevurb)-zurb_roof(l,nlevurb-1)

      ziurb_wall(l,0) = 0.
      do j = 1, nlevurb-1
        ziurb_wall(l,j) = 0.5*(zurb_wall(l,j)+zurb_wall(l,j+1))          !interface depths
      enddo
      ziurb_wall(l,nlevurb) = zurb_wall(l,nlevurb) + 0.5*dzurb_wall(l,nlevurb)

      ziurb_roof(l,0) = 0.
      do j = 1, nlevurb-1
        ziurb_roof(l,j) = 0.5*(zurb_roof(l,j)+zurb_roof(l,j+1))          !interface depths
      enddo
      ziurb_roof(l,nlevurb) = zurb_roof(l,nlevurb) + 0.5*dzurb_roof(l,nlevurb)
    end if
   end do

   ! --------------------------------------------------------------------
   ! Initialize nitrogen deposition values 
   ! for now these are constants by gridcell, eventually they
   ! will be variables from the atmosphere, and at some point in between
   ! they will be specified time varying fields.
   ! --------------------------------------------------------------------

   ! Grid level initialization
   do g = begg, endg

      ! nitrogen deposition (forcing flux from atmosphere)
      ! convert rate from 1/yr -> 1/s

!ndep moved to module_sf_clm and clm      
!      forc_ndep(g) = ndep(g)/(86400._r8 * 365._r8)
      
      ! VOC emission factors
      ! Set gridcell and landunit indices
      efisop(:,g)=efisop2d(:,g)

   end do
   
 !  write(6,*) 'efisop=',efisop

   call CLMDebug('mark2')

   ! --------------------------------------------------------------------
   ! Initialize soil and lake levels
   ! Initialize soil color, thermal and hydraulic properties
   ! --------------------------------------------------------------------

   ! Column level initialization
   do c = begc, endc

      ! Set gridcell and landunit indices
      g = cgridcell(c)
      l = clandunit(c)
      
      ! initialize maximum daylength, based on latitude and maximum declination
      ! maximum declination hardwired for present-day orbital parameters, 
      ! +/- 23.4667 degrees = +/- 0.409571 radians, use negative value for S. Hem
      call CLMDebug('mark21')
      max_decl = 0.409571
      if (lat(g) .lt. 0._r8) max_decl = -max_decl
      temp = -(sin(lat(g))*sin(max_decl))/(cos(lat(g)) * cos(max_decl))
      temp = min(1._r8,max(-1._r8,temp))
      max_dayl(c) = 2.0_r8 * 13750.9871_r8 * acos(temp)
      ! Initialize restriction for min of soil potential (mm)
      smpmin(c) = -1.e8_r8

      ! Decay factor (m)
      hkdepth(c) = 1._r8/2.5_r8

  call CLMDebug('mark22')
      ! Maximum saturated fraction
      wtfact(c) = gti(g)
   call CLMDebug('mark23')

      ! Soil color
      isoicol(c) = soic2d(g)

      ! Soil hydraulic and thermal properties
        ! Note that urban roof, sunwall and shadewall thermal properties used to 
        ! derive thermal conductivity and heat capacity are set to special 
        ! value because thermal conductivity and heat capacity for urban 
        ! roof, sunwall and shadewall are prescribed in SoilThermProp.F90 in 
        ! SoilTemperatureMod.F90
      if (ltype(l)==istdlak .or. ltype(l)==istwet .or. ltype(l)==istice) then
         do lev = 1,nlevgrnd
            bsw(c,lev)    = spval
            bsw2(c,lev)   = spval
            psisat(c,lev) = spval
            vwcsat(c,lev) = spval
            watsat(c,lev) = spval
            watfc(c,lev)  = spval
            hksat(c,lev)  = spval
            sucsat(c,lev) = spval
            tkmg(c,lev)   = spval
            tksatu(c,lev) = spval
            tkdry(c,lev)  = spval
            if (ltype(l)==istwet .and. lev > nlevsoi) then
               csol(c,lev) = csol_bedrock
            else
               csol(c,lev)= spval
            endif
            watdry(c,lev) = spval 
            watopt(c,lev) = spval 
         end do
      else if (ltype(l)==isturb .and. (ctype(c) /= icol_road_perv) .and. (ctype(c) /= icol_road_imperv) )then
         ! Urban Roof, sunwall, shadewall properties set to special value
         do lev = 1,nlevurb
            watsat(c,lev) = spval
            watfc(c,lev)  = spval
            bsw(c,lev)    = spval
            bsw2(c,lev)   = spval
            psisat(c,lev) = spval
            vwcsat(c,lev) = spval
            hksat(c,lev)  = spval
            sucsat(c,lev) = spval
            tkmg(c,lev)   = spval
            tksatu(c,lev) = spval
            tkdry(c,lev)  = spval
            csol(c,lev)   = spval
            watdry(c,lev) = spval 
            watopt(c,lev) = spval 
         end do
      else  ! soil columns of both urban and non-urban types
         do lev = 1,nlevgrnd
            ! duplicate clay and sand values from 10th soil layer
            if (lev .le. nlevsoi) then
               clay    = clay3d(g,lev)
               sand    = sand3d(g,lev)
               om_frac = (organic3d(g,lev)/organic_max)**2._r8
            else
               clay    = clay3d(g,nlevsoi)
               sand    = sand3d(g,nlevsoi)
               om_frac = 0._r8
            endif
            ! No organic matter for urban
            if (ltype(l)==isturb) then
              om_frac = 0._r8
            end if
            ! Note that the following properties are overwritten for urban impervious road 
            ! layers that are not soil in SoilThermProp.F90 within SoilTemperatureMod.F90
            watsat(c,lev) = 0.489_r8 - 0.00126_r8*sand
            bsw(c,lev)    = 2.91 + 0.159*clay
            sucsat(c,lev) = 10._r8 * ( 10._r8**(1.88_r8-0.0131_r8*sand) )
            bd            = (1._r8-watsat(c,lev))*2.7e3_r8 
            watsat(c,lev) = (1._r8 - om_frac)*watsat(c,lev) + om_watsat*om_frac
            tkm           = (1._r8-om_frac)*(8.80_r8*sand+2.92_r8*clay)/(sand+clay)+om_tkm*om_frac ! W/(m K)
            bsw(c,lev)    = (1._r8-om_frac)*(2.91_r8 + 0.159_r8*clay) + om_frac*om_b   
            bsw2(c,lev)   = -(3.10_r8 + 0.157_r8*clay - 0.003_r8*sand)
            psisat(c,lev) = -(exp((1.54_r8 - 0.0095_r8*sand + 0.0063_r8*(100.0_r8-sand-clay))*log(10.0_r8))*9.8e-5_r8)
            vwcsat(c,lev) = (50.5_r8 - 0.142_r8*sand - 0.037_r8*clay)/100.0_r8
            sucsat(c,lev) = (1._r8-om_frac)*sucsat(c,lev) + om_sucsat*om_frac  
            xksat         = 0.0070556 *( 10.**(-0.884+0.0153*sand) ) ! mm/s

            ! perc_frac is zero unless perf_frac greater than percolation threshold
            if (om_frac > pc) then
               perc_norm=(1._r8 - pc)**(-pcbeta)
               perc_frac=perc_norm*(om_frac - pc)**pcbeta
            else
               perc_frac=0._r8
            endif
            ! uncon_frac is fraction of mineral soil plus fraction of "nonpercolating" organic soil
            uncon_frac=(1._r8-om_frac)+(1._r8-perc_frac)*om_frac
            ! uncon_hksat is series addition of mineral/organic conductivites
            if (om_frac .lt. 1._r8) then
              uncon_hksat=uncon_frac/((1._r8-om_frac)/xksat &
                   +((1._r8-perc_frac)*om_frac)/om_hksat)
            else
              uncon_hksat = 0._r8
            end if
            hksat(c,lev)  = uncon_frac*uncon_hksat + (perc_frac*om_frac)*om_hksat

            tkmg(c,lev)   = tkm ** (1._r8- watsat(c,lev))           
            tksatu(c,lev) = tkmg(c,lev)*0.57_r8**watsat(c,lev)
            tkdry(c,lev)  = ((0.135_r8*bd + 64.7_r8) / (2.7e3_r8 - 0.947_r8*bd))*(1._r8-om_frac) + &
                            om_tkd*om_frac  
            csol(c,lev)   = ((1._r8-om_frac)*(2.128_r8*sand+2.385_r8*clay) / (sand+clay) +   &
                           om_csol*om_frac)*1.e6_r8  ! J/(m3 K)  
            if (lev .gt. nlevsoi) then
               csol(c,lev) = csol_bedrock
            endif
            watdry(c,lev) = watsat(c,lev) * (316230._r8/sucsat(c,lev)) ** (-1._r8/bsw(c,lev)) 
            watopt(c,lev) = watsat(c,lev) * (158490._r8/sucsat(c,lev)) ** (-1._r8/bsw(c,lev)) 
            !! added by K.Sakaguchi for beta from Lee and Pielke, 1992
            ! water content at field capacity, defined as hk = 0.1 mm/day
            ! used eqn (7.70) in CLM3 technote with k = 0.1 (mm/day) / 86400 (day/sec)
            watfc(c,lev) = watsat(c,lev) * (0.1_r8 / (hksat(c,lev)*86400._r8))**(1._r8/(2._r8*bsw(c,lev)+3._r8))
         end do
         !
         ! Urban pervious and impervious road
         !
         ! Impervious road layers -- same as above except set watdry and watopt as missing
         if (ctype(c) == icol_road_imperv) then
            do lev = 1,nlevgrnd
               watdry(c,lev) = spval 
               watopt(c,lev) = spval 
            end do
         ! pervious road layers -- same as above except also set rootfr_road_perv
         ! Currently, pervious road has same properties as soil
         else if (ctype(c) == icol_road_perv) then 
            do lev = 1, nlevgrnd
               rootfr_road_perv(c,lev) = 0._r8
            enddo
            do lev = 1,nlevsoi
               rootfr_road_perv(c,lev) = 0.1_r8  ! uniform profile
            end do
         end if
      endif
      ! Define lake or non-lake levels, layers and interfaces
      if (ltype(l) == istdlak) then
         z(c,1:nlevlak)  = zlak(1:nlevlak)
         dz(c,1:nlevlak) = dzlak(1:nlevlak)
      else if (ltype(l) == isturb) then
         if (ctype(c)==icol_sunwall .or. ctype(c)==icol_shadewall) then
            z(c,1:nlevurb)  = zurb_wall(l,1:nlevurb)
            zi(c,0:nlevurb) = ziurb_wall(l,0:nlevurb)
            dz(c,1:nlevurb) = dzurb_wall(l,1:nlevurb)
         else if (ctype(c)==icol_roof) then
            z(c,1:nlevurb)  = zurb_roof(l,1:nlevurb)
            zi(c,0:nlevurb) = ziurb_roof(l,0:nlevurb)
            dz(c,1:nlevurb) = dzurb_roof(l,1:nlevurb)
         else
            z(c,1:nlevurb)  = zsoi(1:nlevurb)
            zi(c,0:nlevurb) = zisoi(0:nlevurb)
            dz(c,1:nlevurb) = dzsoi(1:nlevurb)
         end if
      else
         z(c,1:nlevgrnd)  = zsoi(1:nlevgrnd)
         zi(c,0:nlevgrnd) = zisoi(0:nlevgrnd)
         dz(c,1:nlevgrnd) = dzsoi(1:nlevgrnd)
      end if

      ! Initialize terms needed for dust model
      clay = clay3d(g,1)
      gwc_thr(c) = 0.17_r8 + 0.14_r8*clay*0.01_r8
      mss_frc_cly_vld(c) = min(clay*0.01_r8, 0.20_r8)

   end do


    call CLMDebug('mark3')
   ! pft level initialization
   do p = begp, endp

      ! Initialize maximum allowed dew

      dewmx(p)  = 0.1_r8

      ! Initialize root fraction (computing from surface, d is depth in meter):
      ! Y = 1 -1/2 (exp(-ad)+exp(-bd) under the constraint that
      ! Y(d =0.1m) = 1-beta^(10 cm) and Y(d=d_obs)=0.99 with
      ! beta & d_obs given in Zeng et al. (1998).

      c = pcolumn(p)
      if (ivt(p) /= noveg) then
         do lev = 1, nlevgrnd
            rootfr(p,lev) = 0._r8
         enddo
         do lev = 1, nlevsoi-1
            rootfr(p,lev) = .5_r8*( exp(-roota_par(ivt(p)) * zi(c,lev-1))  &
                               + exp(-rootb_par(ivt(p)) * zi(c,lev-1))  &
                               - exp(-roota_par(ivt(p)) * zi(c,lev  ))  &
                               - exp(-rootb_par(ivt(p)) * zi(c,lev  )) )
         end do
         rootfr(p,nlevsoi) = .5_r8*( exp(-roota_par(ivt(p)) * zi(c,nlevsoi-1))  &
                                + exp(-rootb_par(ivt(p)) * zi(c,nlevsoi-1)) )
         rootfr(p,nlevsoi+1:nlevgrnd) =  0.0_r8

      else
         rootfr(p,1:nlevsoi) = 0._r8
      endif
      
      ! initialize rresis, for use in ecosystemdyn
      do lev = 1,nlevgrnd
         rresis(p,lev) = 0._r8
      end do

   end do ! end pft level initialization
   
#if (defined CN)
   ! initialize the CN variables for special landunits, including lake points
   if(nstep==1)  call CNiniSpecial()
#endif





   call CLMDebug('Successfully initialized time invariant variables')

  deallocate(zurb_wall)
  deallocate(zurb_roof)
  deallocate(dzurb_wall)
  deallocate(dzurb_roof)
  deallocate(ziurb_wall)
  deallocate(ziurb_roof)


end subroutine iniTimeConst

module QSatMod

!-----------------------------------------------------------------------
!BOP
!
! !MODULE: QSatMod
!
! !DESCRIPTION:
! Computes saturation mixing ratio and the change in saturation
!
! !PUBLIC TYPES:
  implicit none
  save
!
! !PUBLIC MEMBER FUNCTIONS:
  public :: QSat
!
! !REVISION HISTORY:
! Created by Mariana Vertenstein
!
!EOP
!-----------------------------------------------------------------------

contains

!-----------------------------------------------------------------------
!BOP
!
! !IROUTINE: QSat
!
! !INTERFACE:
  subroutine QSat (T, p, es, esdT, qs, qsdT)
!
! !DESCRIPTION:
! Computes saturation mixing ratio and the change in saturation
! mixing ratio with respect to temperature.
! Reference:  Polynomial approximations from:
!             Piotr J. Flatau, et al.,1992:  Polynomial fits to saturation
!             vapor pressure.  Journal of Applied Meteorology, 31, 1507-1513.
!
! !USES:
    use shr_kind_mod , only: r8 => shr_kind_r8
    use shr_const_mod, only: SHR_CONST_TKFRZ
!
! !ARGUMENTS:
    implicit none
    real(r8), intent(in)  :: T        ! temperature (K)
    real(r8), intent(in)  :: p        ! surface atmospheric pressure (pa)
    real(r8), intent(out) :: es       ! vapor pressure (pa)
    real(r8), intent(out) :: esdT     ! d(es)/d(T)
    real(r8), intent(out) :: qs       ! humidity (kg/kg)
    real(r8), intent(out) :: qsdT     ! d(qs)/d(T)
!
! !CALLED FROM:
! subroutine Biogeophysics1 in module Biogeophysics1Mod
! subroutine BiogeophysicsLake in module BiogeophysicsLakeMod
! subroutine CanopyFluxesMod CanopyFluxesMod
!
! !REVISION HISTORY:
! 15 September 1999: Yongjiu Dai; Initial code
! 15 December 1999:  Paul Houser and Jon Radakovich; F90 Revision
!
!
! !LOCAL VARIABLES:
!EOP
!
    real(r8) :: T_limit
    real(r8) :: td,vp,vp1,vp2
!
! For water vapor (temperature range 0C-100C)
!
    real(r8), parameter :: a0 =  6.11213476_r8
    real(r8), parameter :: a1 =  0.444007856_r8
    real(r8), parameter :: a2 =  0.143064234e-01_r8
    real(r8), parameter :: a3 =  0.264461437e-03_r8
    real(r8), parameter :: a4 =  0.305903558e-05_r8
    real(r8), parameter :: a5 =  0.196237241e-07_r8
    real(r8), parameter :: a6 =  0.892344772e-10_r8
    real(r8), parameter :: a7 = -0.373208410e-12_r8
    real(r8), parameter :: a8 =  0.209339997e-15_r8
!
! For derivative:water vapor
!
    real(r8), parameter :: b0 =  0.444017302_r8
    real(r8), parameter :: b1 =  0.286064092e-01_r8
    real(r8), parameter :: b2 =  0.794683137e-03_r8
    real(r8), parameter :: b3 =  0.121211669e-04_r8
    real(r8), parameter :: b4 =  0.103354611e-06_r8
    real(r8), parameter :: b5 =  0.404125005e-09_r8
    real(r8), parameter :: b6 = -0.788037859e-12_r8
    real(r8), parameter :: b7 = -0.114596802e-13_r8
    real(r8), parameter :: b8 =  0.381294516e-16_r8
!
! For ice (temperature range -75C-0C)
!
    real(r8), parameter :: c0 =  6.11123516_r8
    real(r8), parameter :: c1 =  0.503109514_r8
    real(r8), parameter :: c2 =  0.188369801e-01_r8
    real(r8), parameter :: c3 =  0.420547422e-03_r8
    real(r8), parameter :: c4 =  0.614396778e-05_r8
    real(r8), parameter :: c5 =  0.602780717e-07_r8
    real(r8), parameter :: c6 =  0.387940929e-09_r8
    real(r8), parameter :: c7 =  0.149436277e-11_r8
    real(r8), parameter :: c8 =  0.262655803e-14_r8
!
! For derivative:ice
!
    real(r8), parameter :: d0 =  0.503277922_r8
    real(r8), parameter :: d1 =  0.377289173e-01_r8
    real(r8), parameter :: d2 =  0.126801703e-02_r8
    real(r8), parameter :: d3 =  0.249468427e-04_r8
    real(r8), parameter :: d4 =  0.313703411e-06_r8
    real(r8), parameter :: d5 =  0.257180651e-08_r8
    real(r8), parameter :: d6 =  0.133268878e-10_r8
    real(r8), parameter :: d7 =  0.394116744e-13_r8
    real(r8), parameter :: d8 =  0.498070196e-16_r8
!-----------------------------------------------------------------------

    T_limit = T - SHR_CONST_TKFRZ
    if (T_limit > 100.0_r8) T_limit=100.0_r8
    if (T_limit < -75.0_r8) T_limit=-75.0_r8

    td       = T_limit
    if (td >= 0.0_r8) then
       es   = a0 + td*(a1 + td*(a2 + td*(a3 + td*(a4 &
            + td*(a5 + td*(a6 + td*(a7 + td*a8)))))))
       esdT = b0 + td*(b1 + td*(b2 + td*(b3 + td*(b4 &
            + td*(b5 + td*(b6 + td*(b7 + td*b8)))))))
    else
       es   = c0 + td*(c1 + td*(c2 + td*(c3 + td*(c4 &
            + td*(c5 + td*(c6 + td*(c7 + td*c8)))))))
       esdT = d0 + td*(d1 + td*(d2 + td*(d3 + td*(d4 &
            + td*(d5 + td*(d6 + td*(d7 + td*d8)))))))
    endif

    es    = es    * 100._r8            ! pa
    esdT  = esdT  * 100._r8            ! pa/K

    vp    = 1.0_r8   / (p - 0.378_r8*es)
    vp1   = 0.622_r8 * vp
    vp2   = vp1   * vp

    qs    = es    * vp1             ! kg/kg
    qsdT  = esdT  * vp2 * p         ! 1 / K

  end subroutine QSat

end module QSatMod
module initGridcellsMod

!Edited to 3.5 from Jiming Jin's 3.0 version by Zack Subin, 7/17/08.
!Latdeg, londeg, & area for l, c, & p, and itype for g, was eliminated.
!To prevent redoing equations, areas are put back in clmtype, but 
!latdeg & londeg are redundant and left out.

!-----------------------------------------------------------------------
!BOP
!
! !MODULE: initGridcellsMod
!
! !DESCRIPTION:
! Initializes sub-grid mapping for each land grid cell
!
! !USES:
  use shr_kind_mod, only: r8 => shr_kind_r8
  use clmtype
  use clm_varpar, only : lsmlon, lsmlat,npatch_urban,npatch_glacier,npatch_crop, maxpatch, maxpatch_pft
  use clm_varsur, only : wtxy,vegxy,numlon, area, latixy, longxy

! !PUBLIC TYPES:
  implicit none
  private
  save
!
! !PUBLIC MEMBER FUNCTIONS:
  public initGridcells      ! Initialize sub-grid gridcell mapping
!
! !PIVATE MEMBER FUNCTIONS:
  private landunit_veg_compete
  private landunit_veg_noncompete
  private landunit_special
  private landunit_crop_noncompete
!
! !REVISION HISTORY:
! Created by Mariana Vertenstein
!
!EOP
!
! !LOCAL MODULE VARIABLES:
  type(gridcell_type), pointer :: gptr  ! pointer to gridcell derived subtype
  type(landunit_type), pointer :: lptr  ! pointer to landunit derived subtype
  type(column_type)  , pointer :: cptr  ! pointer to column derived subtype
  type(pft_type)     , pointer :: pptr  ! pointer to pft derived subtype
!-----------------------------------------------------------------------

contains

!------------------------------------------------------------------------
!BOP
!
! !IROUTINE: initGridcells
!
! !INTERFACE:
  subroutine initGridcells
!
! !DESCRIPTION:
! Initialize sub-grid mapping and allocates space for derived type
! hierarchy.  For each land gridcell determine landunit, column and
! pft properties.  Note that ngcells, nlunits, ncols and npfts are
! per-processor totals here and are currently not used for anything other
! than placeholders.  Determine if there are any vegetated landunits and
! if so---the weight of the vegetated landunit relative to the gridcell
! The first landunit contains all the vegetated patches (if any) For now,
! the vegetated patches will all be gathered on a single landunit, with
! each vegetated type having its own column on that landunit.  The special
! patches (urban, lake, wetland, glacier) each get their own landunit
! having a single column and one non-vegetated pfts
!
! !USES:
    use decompMod , only : get_proc_bounds, get_gcell_xyind, &
                           get_gcell_info 
    use clm_varcon, only : pie
!
! !ARGUMENTS:
    implicit none
                                                          ! weights
!
! !REVISION HISTORY:
! Created by Peter Thornton and Mariana Vertenstein
!
!EOP
!
! !LOCAL VARIABLES:
    integer :: g,i,j,m,n,gi,li,ci,pi ! indices
    integer :: ngcells     ! temporary dummy
    integer :: nlunits     ! temporary dummy
    integer :: ncols       ! temporary dummy
    integer :: npfts       ! temporary dummy
    integer :: nveg        ! number of pfts in naturally vegetated landunit
    real(r8):: wtveg       ! weight (relative to gridcell) of naturally vegetated landunit
    integer :: ncrop       ! number of crop pfts in crop landunit
    real(r8):: wtcrop      ! weight (relative to gridcell) of crop landunit
    integer :: begp, endp  ! per-proc beginning and ending pft indices
    integer :: begc, endc  ! per-proc beginning and ending column indices
    integer :: begl, endl  ! per-proc beginning and ending landunit indices
    integer :: begg, endg  ! per-proc gridcell ending gridcell indices
    integer :: ier         ! error status
    integer :: ilunits, icols, ipfts  ! temporaries
!New variables -- comment for now, probably not needed
!    integer :: nlake          ! number of pfts (columns) in lake landunit
!    real(r8):: wtlake         ! weight (gridcell) of lake landunit
!    integer :: nwetland       ! number of pfts (columns) in wetland landunit
!    real(r8):: wtwetland      ! weight (gridcell) of wetland landunit
!    integer :: nglacier       ! number of pfts (columns) in glacier landunit
!    real(r8):: wtglacier      ! weight (gridcell) of glacier landunit
!!!!!!!!!!!!!
!------------------------------------------------------------------------

    ! Set pointers into derived types for this module

    gptr => clm3%g
    lptr => clm3%g%l
    cptr => clm3%g%l%c
    pptr => clm3%g%l%c%p

    ! Determine necessary indices

    call get_proc_bounds(begg, endg, begl, endl, begc, endc, begp, endp)
    call get_gcell_xyind(begg, endg)


    ! Determine number of land gridcells on this processor

    clm3%ngridcells = endg - begg + 1

    ! Determine gridcell properties.
    ! Set area, weight, and type information for this gridcell.
    ! For now there is only one type of gridcell, value = 1
    ! Still need to resolve the calculation of area for the gridcell

    ngcells = begg-1
    nlunits = begl-1
    ncols   = begc-1
    npfts   = begp-1

    do gi = begg, endg

       ! Get 2d grid indices


!
       gptr%area(gi)   = area(gi)

  call CLMDebug('mark0')
!       gptr%itype(gi)  = 1
      !gptr%wtglob(g)  = gptr%area(g)/clm3%area
       gptr%lat(gi)    = latixy(gi) * pie/180.
       gptr%lon(gi)    = longxy(gi) * pie/180.
       gptr%latdeg(gi) = latixy(gi)
       gptr%londeg(gi) = longxy(gi)
!      gptr%landfrac(gi) = landfrac(i,j)
!

       gptr%luni(gi) = nlunits + 1
       gptr%coli(gi) = ncols   + 1
       gptr%pfti(gi) = npfts   + 1

       call get_gcell_info(gi, nlunits=ilunits, ncols=icols, npfts=ipfts)

       ngcells = ngcells + 1
       nlunits = nlunits + ilunits
       ncols   = ncols   + icols
       npfts   = npfts   + ipfts

       gptr%lunf(gi) = nlunits
       gptr%colf(gi) = ncols
       gptr%pftf(gi) = npfts

       gptr%nlandunits(gi) = gptr%lunf(gi) - gptr%luni(gi) + 1
       gptr%ncolumns(gi)   = gptr%colf(gi) - gptr%coli(gi) + 1
       gptr%npfts(gi)      = gptr%pftf(gi) - gptr%pfti(gi) + 1

    end do

     call CLMDebug('mark1')

    ! For each land gridcell determine landunit, column and pft properties.

    ngcells = 0
    nlunits = 0
    ncols   = 0
    npfts   = 0

    li = begl - 1
    ci = begc - 1
    pi = begp - 1

    do gi = begg,endg

       ! Determine 2d lat and lon indices


       ! Obtain gridcell properties

       call get_gcell_info(gi, nveg=nveg, wtveg=wtveg, ncrop=ncrop, wtcrop=wtcrop)

       ! Determine naturally vegetated landunit

#if (defined NOCOMPETE)
       if (nveg > 0) call landunit_veg_noncompete(nveg, wtveg,  i, j, gi, li, ci, pi)
#else
       if (nveg > 0) call landunit_veg_compete(nveg, wtveg, i, j, gi, li, ci, pi)
#endif

       ! Determine crop landunit.

       if (ncrop > 0) call landunit_crop_noncompete(ncrop, wtcrop,  i, j, gi, li, ci, pi)

       ! Determine special landunits (urban, lake, wetland, glacier).

       do m = npatch_urban, npatch_glacier
          if (wtxy(gi,m) > 0.) call landunit_special(i, j, m, gi, li, ci, pi)
       end do

    end do


  end subroutine initGridcells

!------------------------------------------------------------------------
!BOP
!
! !IROUTINE: landunit_veg_compete
!
! !INTERFACE:
  subroutine landunit_veg_compete (nveg, wtveg,  i, j, &
                                   gi, li, ci, pi)
!
! !DESCRIPTION:
! Initialize vegetated landunit with competition
!
! !USES:
    use clm_varcon, only : istsoil
!
! !ARGUMENTS:
    implicit none
    integer , intent(in) :: nveg   ! number of vegetated patches in gridcell
    real(r8), intent(in) :: wtveg  ! weight relative to gridcell of veg
                                   ! landunit
    integer , intent(in) :: i      ! 2d longitude index
    integer , intent(in) :: j      ! 2d latitude index
    integer , intent(in) :: gi     ! gridcell index
    integer , intent(inout) :: li  ! landunit index
    integer , intent(inout) :: ci  ! column index
    integer , intent(inout) :: pi  ! pft index
!
! !REVISION HISTORY:
! Created by Mariana Vertenstein
!
!EOP
!
! !LOCAL VARIABLES:
    integer  :: m                          ! indices
!------------------------------------------------------------------------

    ! Set landunit properties
    ! Increment landunits and set indices into lower levels in hierarchy and higher levels
    ! in hierarchy and topological mapping functionality

    li = li + 1
    lptr%ncolumns(li) = 1
    lptr%coli(li) = ci + 1
    lptr%colf(li) = ci + 1
    lptr%npfts(li) = nveg
    lptr%pfti(li) = pi + 1
    lptr%pftf(li) = pi + nveg
!
    lptr%area(li) = gptr%area(gi) * wtveg
!
    lptr%gridcell(li) = gi
    lptr%wtgcell(li) = wtveg
!
!    lptr%latdeg(li) = latixy(i,j)
!    lptr%londeg(li) = longxy(i,j)
!
    lptr%ifspecial(li) = .false.
    lptr%lakpoi(li) = .false.
    lptr%urbpoi(li) = .false.
    lptr%itype(li) = istsoil

    ! Set column properties for this landunit
    ! Increment column  - set only one column on compete landunit -  and set indices into
    ! lower levels in hierarchy, higher levels in hierarchy and topological mapping
    ! functionality (currently all columns have type 1)

    ci = ci + 1
    cptr%npfts(ci) = nveg
    cptr%pfti(ci) = pi + 1
    cptr%pftf(ci) = pi + nveg
 


!
    cptr%area(ci) = lptr%area(li)
!
    cptr%landunit(ci) = li
    cptr%gridcell(ci) = gi
    cptr%wtlunit(ci) = 1.0
    cptr%wtgcell(ci) = wtveg
!
!    cptr%latdeg(ci) = latixy(i,j)
!    cptr%londeg(ci) = longxy(i,j)
!
    cptr%itype(ci) = 1

    ! Set pft properties for this landunit
    ! Topological mapping functionality

!dir$ concurrent
!cdir nodep
    do m = 1,maxpatch_pft
       if (wtxy(gi,m) > 0.) then
          pi = pi+1
          pptr%column(pi) = ci
          pptr%landunit(pi) = li
          pptr%gridcell(pi) = gi
          pptr%wtcol(pi) = wtxy(gi,m) / wtveg
          pptr%wtlunit(pi) = wtxy(gi,m) / wtveg
          pptr%wtgcell(pi) = wtxy(gi,m)
!
          pptr%area(pi) = cptr%area(ci) * pptr%wtcol(pi)
!
          pptr%mxy(pi) = m
!
!          pptr%latdeg(pi) = latixy(i,j)
!          pptr%londeg(pi) = longxy(i,j)
!
          pptr%itype(pi) = vegxy(gi,m)
       end if ! non-zero weight for this pft
    end do ! loop through maxpatch_pft

  end subroutine landunit_veg_compete

!------------------------------------------------------------------------
!BOP
!
! !IROUTINE: landunit_veg_noncompete
!
! !INTERFACE:
  subroutine landunit_veg_noncompete (nveg, wtveg, i, j, &
                                      gi, li, ci, pi)
!
! !DESCRIPTION:
! Initialize vegetated landunit without competition
!
! !USES:
    use clm_varcon, only : istsoil
!
! !ARGUMENTS:
    implicit none
    integer , intent(in) :: nveg       ! number of vegetated patches in gridcell
    real(r8), intent(in) :: wtveg      ! weight relative to gridcell of veg landunit
    integer , intent(in) :: i          ! 2d longitude index
    integer , intent(in) :: j          ! 2d latitude index
    integer , intent(in) :: gi         ! gridcell index
    integer , intent(inout) :: li      ! landunit index
    integer , intent(inout) :: ci      ! column index
    integer , intent(inout) :: pi      ! pft index
!
! !REVISION HISTORY:
! Created by Mariana Vertenstein
!
!EOP
!
! !LOCAL VARIABLES:
    integer  :: m                          ! indices
    real(r8) :: wtlunit                    ! weight relative to landunit
!------------------------------------------------------------------------

    ! Set landunit properties
    ! Increment landunits and set indices into lower levels in hierarchy and higher levels
    ! in hierarchy and topological mapping functionality

    li = li + 1
    lptr%ncolumns(li) = nveg
    lptr%coli(li) = ci + 1
    lptr%colf(li) = ci + nveg
    lptr%npfts(li) = nveg
    lptr%pfti(li) = pi + 1
    lptr%pftf(li) = pi + nveg
!
    lptr%area(li) = gptr%area(gi) * wtveg
!
    lptr%gridcell(li) = gi
    lptr%wtgcell(li) = wtveg
!
!    lptr%latdeg(li) = latixy(i,j)
!    lptr%londeg(li) = longxy(i,j)
!
    lptr%ifspecial(li) = .false.
    lptr%lakpoi(li) = .false.
    lptr%itype(li) = istsoil

    ! Set column properties for this landunit
    ! Increment column  - each column has its own pft -  and set indices into
    ! lower levels in hierarchy, higher levels in hierarchy and topological mapping
    ! functionality (currently all columns have type 1)
    ! Set column and pft properties
    ! Loop through regular (vegetated) patches, assign one column for each
    ! vegetated patch with non-zero weight. The weights for each column on
    ! the vegetated landunit must add to one when summed over the landunit,
    ! so the wtxy(i,j,m) values are taken relative to the total wtveg.

!dir$ concurrent
!cdir nodep
    do m = 1, maxpatch_pft
       if (wtxy(gi,m) > 0.) then

          ! Determine weight relative to landunit of pft/column

          wtlunit = wtxy(gi,m) / wtveg

          ! Increment number of columns on landunit

          ci = ci + 1
          cptr%npfts(ci) = 1
          cptr%pfti(ci) = ci
          cptr%pftf(ci) = ci
!
          cptr%area(ci) = lptr%area(li) * wtlunit
!
          cptr%landunit(ci) = li
          cptr%gridcell(ci) = gi
          cptr%wtlunit(ci) = wtlunit
!
          cptr%wtgcell(ci) = cptr%area(ci) / gptr%area(gi)
!
!
!          cptr%latdeg(ci) = latixy(i,j)
!          cptr%londeg(ci) = longxy(i,j)
!
          cptr%itype(ci) = 1

          ! Increment number of pfts on this landunit
          ! Set area, weight (relative to column) and type information for this pft
          ! For now, a single pft per column, so weight = 1
          ! pft type comes from the m dimension of wtxy()
          ! Set grid index, weight (relative to grid cell)
          ! and m index (needed for laixy, etc. reference)

          pi = pi + 1
          pptr%column(pi) = ci
          pptr%landunit(pi) = li
          pptr%gridcell(pi) = gi
          pptr%wtcol(pi) = 1.0
          pptr%wtlunit(pi) = cptr%wtlunit(ci)
!
          pptr%area(pi) = cptr%area(ci)
          pptr%wtgcell(pi) = pptr%area(pi) / gptr%area(gi)
!
          pptr%mxy(pi) = m
!
!          pptr%latdeg(pi) = latixy(i,j)
!          pptr%londeg(pi) = longxy(i,j)
!
          pptr%itype(pi) = vegxy(gi,m)

       end if   ! end if non-zero weight
    end do   ! end loop through the possible vegetated patch indices

  end subroutine landunit_veg_noncompete

!------------------------------------------------------------------------
!BOP
!
! !IROUTINE: landunit_special
!
! !INTERFACE:
  subroutine landunit_special ( i, j, m, gi, li, ci, pi)
!
! !DESCRIPTION:
! Initialize special landunits (urban, lake, wetland, glacier)
!
! !USES:
    use pftvarcon, only : noveg
    use clm_varcon, only : istice, istwet, istdlak, isturb
    use clm_varpar, only : npatch_lake, npatch_wet 
!
! !ARGUMENTS:
    implicit none
    integer, intent(in) :: i            !2-dim longitude index
    integer, intent(in) :: j            !2-dim latitude index
    integer, intent(in) :: m            !2-dim PFT patch index
    integer, intent(in) :: gi           !gridcell index
    integer, intent(inout) :: li        !landunit index
    integer, intent(inout) :: ci        !column index
    integer, intent(inout) :: pi        !pft index
!
! !REVISION HISTORY:
! Created by Mariana Vertenstein
!
!EOP
!
! !LOCAL VARIABLES:
    integer  :: c             !column loop index
    integer  :: ncols         !number of columns
    integer  :: npfts         !number of pfts
    integer  :: ier           !error status
    real(r8) :: weight        !temporary weight
    integer  :: itype         !landunit type
!------------------------------------------------------------------------

    ! Define landunit type

    if (m == npatch_lake) then         !deep lake (from pctlak)
       itype = istdlak
    else if (m == npatch_wet) then     !wetland (from pctwet)
       itype = istwet
    else if (m == npatch_glacier) then !glacier (from pctgla)
       itype = istice
    else if (m == npatch_urban) then   !urban (from pcturb)
       itype = isturb
    else                               !error
       write(6,*)'special landunit are currently only:', &
            ' deep lake, wetland, glacier or urban)'
       call endrun()
    endif

    ! Determine landunit index and landunit properties

    li = li + 1
    lptr%ncolumns(li) = 1
    lptr%coli(li) = ci + 1
    lptr%colf(li) = ci + 1
    lptr%npfts(li) = 1
    lptr%pfti(li) = pi + 1
    lptr%pftf(li) = pi + 1
!
    lptr%area(li) = gptr%area(gi) * wtxy(gi,m)
    lptr%gridcell(li) = gi
    lptr%wtgcell(li) = lptr%area(li) / gptr%area(gi)
!
!
!    lptr%latdeg(li) = latixy(i,j)
!    lptr%londeg(li) = longxy(i,j)
!
    lptr%ifspecial(li) = .true.
    if (itype == istdlak) then
       lptr%lakpoi(li) = .true.
    else
       lptr%lakpoi(li) = .false.
    end if
    lptr%itype(li) = itype

    ! For the special landunits there currently is only one column
    ! Later, the age classes will be implemented on different columns within
    ! the same landunit, so the column type will correspond to an age class

    ncols = 1

    ! Loop through columns for this landunit and set the column properties
    ! We know that there is only one column for the special landunit - but
    ! the loop is included for future consistency.

    do c = 1,ncols

       ! Determine column index and column properties
       ! For now all columns have the same type, value = 1

       weight = 1.0/ncols

       ci = ci + c
       cptr%npfts(ci) = 1
       cptr%pfti(ci) = pi + 1
       cptr%pftf(ci) = pi + 1


!
       cptr%area(ci) = lptr%area(li) * weight
!
       cptr%landunit(ci) = li
       cptr%gridcell(ci) = gi
       cptr%wtlunit(ci) = weight
!
       cptr%wtgcell(ci) = cptr%area(ci) / gptr%area(gi)
!
!
!       cptr%latdeg(ci) = latixy(i,j)
!       cptr%londeg(ci) = longxy(i,j)
!
       cptr%itype(ci) = 1

       ! Determine pft index and pft properties
       ! Each column has one non-vegetated pft
       ! Set area, weight (relative to column), and type information
       ! for this non-vegetated pft
       ! Set grid index, weight (relative to grid cell) and
       ! m index (needed for laixy, etc. reference)

       npfts = 1
       weight = 1.0/npfts

       pi = pi + 1
       pptr%column(pi) = ci
       pptr%landunit(pi) = li
       pptr%gridcell(pi) = gi
!
       pptr%area(pi) = lptr%area(li) * weight
!
       pptr%wtcol(pi) = weight
       pptr%wtlunit(pi) = cptr%wtlunit(ci)
!
       pptr%wtgcell(pi) = pptr%area(pi) / gptr%area(gi)
!
       pptr%mxy(pi) = m
!
!       pptr%latdeg(pi) = latixy(i,j)
!       pptr%londeg(pi) = longxy(i,j)
!
       pptr%itype(pi) = noveg

    end do   ! end loop through ncolumns

  end subroutine landunit_special

!------------------------------------------------------------------------
!BOP
!
! !IROUTINE: landunit_crop_noncompete
!
! !INTERFACE:
  subroutine landunit_crop_noncompete (ncrop, wtcrop,  i, j, &
                                       gi, li, ci, pi)
!
! !DESCRIPTION:
! Initialize crop landunit without competition
!
! !USES:
    use clm_varcon, only : istsoil
#ifdef CN
    use clm_varcon, only : istsoil,istcrop
#endif

    use clm_varpar, only : npatch_crop
!
! !ARGUMENTS:
    implicit none
    integer , intent(in) :: ncrop       ! number of vegetated patches in gridcell
    real(r8), intent(in) :: wtcrop      ! weight relative to gridcell of veg landunit
    integer , intent(in) :: i          ! 2d longitude index
    integer , intent(in) :: j          ! 2d latitude index
    integer , intent(in) :: gi         ! gridcell index
    integer , intent(inout) :: li      ! landunit index
    integer , intent(inout) :: ci      ! column index
    integer , intent(inout) :: pi      ! pft index
!
! !REVISION HISTORY:
! Created by Sam Levis
!
!EOP
!
! !LOCAL VARIABLES:
    integer  :: m                          ! indices
    real(r8) :: wtlunit                    ! weight relative to landunit
!------------------------------------------------------------------------

    ! Set landunit properties
    ! Increment landunits and set indices into lower levels in hierarchy and higher levels
    ! in hierarchy and topological mapping functionality

    li = li + 1
    lptr%ncolumns(li) = ncrop
    lptr%coli(li) = ci + 1
    lptr%colf(li) = ci + ncrop
    lptr%npfts(li) = ncrop
    lptr%pfti(li) = pi + 1
    lptr%pftf(li) = pi + ncrop
!
    lptr%area(li) = gptr%area(gi) * wtcrop
    lptr%gridcell(li) = gi
    lptr%wtgcell(li) = wtcrop
!
!
!    lptr%latdeg(li) = latixy(i,j)
!    lptr%londeg(li) = longxy(i,j)
!
    lptr%ifspecial(li) = .false.
    lptr%lakpoi(li) = .false.
    lptr%urbpoi(li)    = .false.
#ifdef CROP
    lptr%itype(li) = istcrop
#else
    lptr%itype(li) = istsoil
#endif
    ! Set column properties for this landunit
    ! Increment column  - each column has its own pft -  and set indices into
    ! lower levels in hierarchy, higher levels in hierarchy and topological mapping
    ! functionality (currently all columns have type 1)
    ! Set column and pft properties
    ! Loop through regular (vegetated) patches, assign one column for each
    ! vegetated patch with non-zero weight. The weights for each column on
    ! the vegetated landunit must add to one when summed over the landunit,
    ! so the wtxy(i,j,m) values are taken relative to the total wtcrop.

!dir$ concurrent
!cdir nodep
    do m = npatch_glacier+1, npatch_crop
       if (wtxy(gi,m) > 0.) then

          ! Determine weight of crop pft/column relative to crop landunit

          wtlunit = wtxy(gi,m) / wtcrop

          ! Increment number of columns on landunit

          ci = ci + 1
          cptr%npfts(ci) = 1
!
          cptr%area(ci) = lptr%area(li) * wtlunit
          cptr%landunit(ci) = li
          cptr%gridcell(ci) = gi
          cptr%wtlunit(ci) = wtlunit
          cptr%wtgcell(ci) = cptr%area(ci) / gptr%area(gi)
!
!
!          cptr%latdeg(ci) = latixy(i,j)
!          cptr%londeg(ci) = longxy(i,j)
!
          cptr%itype(ci) = 1

          ! Increment number of pfts on this landunit
          ! Set area, weight (relative to column) and type information for this pft
          ! For now, a single pft per column, so weight relative to column is 1
          ! pft type comes from the m dimension of wtxy()
          ! Set grid index, weight relative to grid cell and m index (needed for laixy, etc.)

          pi = pi + 1
          pptr%column(pi) = ci
          pptr%landunit(pi) = li
          pptr%gridcell(pi) = gi
!
          pptr%wtcol(pi) = 1.0
          pptr%wtlunit(pi) = cptr%wtlunit(ci)
          pptr%area(pi) = cptr%area(ci)
          pptr%wtgcell(pi) = pptr%area(pi) / gptr%area(gi)
!
          pptr%mxy(pi) = m
!
!          pptr%latdeg(pi) = latixy(i,j)
!          pptr%londeg(pi) = longxy(i,j)
!
          pptr%itype(pi) = vegxy(gi,m)

          ! Set pft indices for column

          cptr%pfti(ci) = pi
          cptr%pftf(ci) = pi
 


 
       end if   ! end if non-zero weight
    end do   ! end loop through the possible vegetated patch indices

  end subroutine landunit_crop_noncompete

end module initGridcellsMod

module FracWetMod

!-----------------------------------------------------------------------
!BOP
!
! !MODULE: FracWetMod
!
! !DESCRIPTION:
! Determine fraction of vegetated surfaces which are wet and
! fraction of elai which is dry.
!
! !PUBLIC TYPES:
  implicit none
  save
!
! !PUBLIC MEMBER FUNCTIONS:
  public :: FracWet
!
! !REVISION HISTORY:
! Created by Mariana Vertenstein
!
!EOP
!-----------------------------------------------------------------------

contains

!-----------------------------------------------------------------------
!BOP
!
! !IROUTINE: FracWet
!
! !INTERFACE:
  subroutine FracWet(numf, filter)
!
! !DESCRIPTION:
! Determine fraction of vegetated surfaces which are wet and
! fraction of elai which is dry. The variable ``fwet'' is the
! fraction of all vegetation surfaces which are wet including
! stem area which contribute to evaporation. The variable ``fdry''
! is the fraction of elai which is dry because only leaves
! can transpire.  Adjusted for stem area which does not transpire.
!
! !USES:
    use shr_kind_mod, only: r8 => shr_kind_r8
    use clmtype
!
! !ARGUMENTS:
    implicit none
    integer, intent(in) :: numf                  ! number of filter non-lake points
    integer, intent(in) :: filter(numf)          ! pft filter for non-lake points
!
! !CALLED FROM:
! subroutine Hydrology1 in module Hydrology1Mod
!
! !REVISION HISTORY:
! Created by Keith Oleson and M. Vertenstein
! 03/08/29 Mariana Vertenstein : Migrated to vectorized code
!
! !LOCAL VARIABLES:
!
! local pointers to implicit in arguments
!
    integer , pointer :: frac_veg_nosno(:) ! fraction of veg not covered by snow (0/1 now) [-]
    real(r8), pointer :: dewmx(:)          ! Maximum allowed dew [mm]
    real(r8), pointer :: elai(:)           ! one-sided leaf area index with burying by snow
    real(r8), pointer :: esai(:)           ! one-sided stem area index with burying by snow
    real(r8), pointer :: h2ocan(:)         ! total canopy water (mm H2O)
!
! local pointers to implicit out arguments
!
    real(r8), pointer :: fwet(:)           ! fraction of canopy that is wet (0 to 1)
    real(r8), pointer :: fdry(:)           ! fraction of foliage that is green and dry [-] (new)
!
!
! !OTHER LOCAL VARIABLES:
!EOP
!
    integer  :: fp,p             ! indices
    real(r8) :: vegt             ! frac_veg_nosno*lsai
    real(r8) :: dewmxi           ! inverse of maximum allowed dew [1/mm]
!-----------------------------------------------------------------------

    ! Assign local pointers to derived subtypes components (pft-level)

    frac_veg_nosno => clm3%g%l%c%p%pps%frac_veg_nosno
    dewmx => clm3%g%l%c%p%pps%dewmx
    elai => clm3%g%l%c%p%pps%elai
    esai => clm3%g%l%c%p%pps%esai
    h2ocan => clm3%g%l%c%p%pws%h2ocan
    fwet => clm3%g%l%c%p%pps%fwet
    fdry => clm3%g%l%c%p%pps%fdry

    ! Compute fraction of canopy that is wet and dry

!dir$ concurrent
!cdir nodep
    do fp = 1,numf
       p = filter(fp)
       if (frac_veg_nosno(p) == 1) then
          if (h2ocan(p) > 0._r8) then
             vegt    = frac_veg_nosno(p)*(elai(p) + esai(p))
             dewmxi  = 1.0_r8/dewmx(p)
             fwet(p) = ((dewmxi/vegt)*h2ocan(p))**0.666666666666_r8
             fwet(p) = min (fwet(p),1.0_r8)   ! Check for maximum limit of fwet
          else
             fwet(p) = 0._r8
          end if
          fdry(p) = (1._r8-fwet(p))*elai(p)/(elai(p)+esai(p))
#if (defined PERGRO)
          fwet(p) = 0._r8
          fdry(p) = elai(p)/(elai(p)+esai(p))
#endif
       else
          fwet(p) = 0._r8
          fdry(p) = 0._r8
       end if
    end do

  end subroutine FracWet

end module FracWetMod

module FrictionVelocityMod

!------------------------------------------------------------------------------
!BOP
!
! !MODULE: FrictionVelocityMod
!
! !DESCRIPTION:
! Calculation of the friction velocity, relation for potential
! temperature and humidity profiles of surface boundary layer.
!
! !USES:
  use shr_kind_mod, only: r8 => shr_kind_r8
!
! !PUBLIC TYPES:
  implicit none
  save
!
! !PUBLIC MEMBER FUNCTIONS:
  public :: FrictionVelocity       ! Calculate friction velocity
  public :: MoninObukIni           ! Initialization of the Monin-Obukhov length
!
! !PRIVATE MEMBER FUNCTIONS:
  private :: StabilityFunc1        ! Stability function for rib < 0.
  private :: StabilityFunc2        ! Stability function for rib < 0.
!
! !REVISION HISTORY:
! Created by Mariana Vertenstein
!
!EOP
!------------------------------------------------------------------------------

contains

!------------------------------------------------------------------------------
!BOP
!
! !IROUTINE: FrictionVelocity
!
! !INTERFACE:
  subroutine FrictionVelocity(lbn, ubn, fn, filtern, &
                              displa, z0m, z0h, z0q, &
                              obu, iter, ur, um, ustar, &
                              temp1, temp2, temp12m, temp22m, fm, landunit_index)
!
! !DESCRIPTION:
! Calculation of the friction velocity, relation for potential
! temperature and humidity profiles of surface boundary layer.
! The scheme is based on the work of Zeng et al. (1998):
! Intercomparison of bulk aerodynamic algorithms for the computation
! of sea surface fluxes using TOGA CORE and TAO data. J. Climate,
! Vol. 11, 2628-2644.
!
! !USES:
   use clmtype
   use clm_varcon, only : vkc
!
! !ARGUMENTS:
   implicit none
   integer , intent(in)  :: lbn, ubn         ! pft/landunit array bounds
   integer , intent(in)  :: fn               ! number of filtered pft/landunit elements
   integer , intent(in)  :: filtern(fn)      ! pft/landunit filter
   real(r8), intent(in)  :: displa(lbn:ubn)  ! displacement height (m)
   real(r8), intent(in)  :: z0m(lbn:ubn)     ! roughness length over vegetation, momentum [m]
   real(r8), intent(in)  :: z0h(lbn:ubn)     ! roughness length over vegetation, sensible heat [m]
   real(r8), intent(in)  :: z0q(lbn:ubn)     ! roughness length over vegetation, latent heat [m]
   real(r8), intent(in)  :: obu(lbn:ubn)     ! monin-obukhov length (m)
   integer,  intent(in)  :: iter             ! iteration number
   real(r8), intent(in)  :: ur(lbn:ubn)      ! wind speed at reference height [m/s]
   real(r8), intent(in)  :: um(lbn:ubn)      ! wind speed including the stablity effect [m/s]
   logical,  optional, intent(in)  :: landunit_index  ! optional argument that defines landunit or pft level
   real(r8), intent(out) :: ustar(lbn:ubn)   ! friction velocity [m/s]
   real(r8), intent(out) :: temp1(lbn:ubn)   ! relation for potential temperature profile
   real(r8), intent(out) :: temp12m(lbn:ubn) ! relation for potential temperature profile applied at 2-m
   real(r8), intent(out) :: temp2(lbn:ubn)   ! relation for specific humidity profile
   real(r8), intent(out) :: temp22m(lbn:ubn) ! relation for specific humidity profile applied at 2-m
   real(r8), intent(inout) :: fm(lbn:ubn)    ! diagnose 10m wind (DUST only)
!
! !CALLED FROM:
!
! !REVISION HISTORY:
! 15 September 1999: Yongjiu Dai; Initial code
! 15 December 1999:  Paul Houser and Jon Radakovich; F90 Revision
! 12/19/01, Peter Thornton
! Added arguments to eliminate passing clm derived type into this function.
! Created by Mariana Vertenstein
!
! !LOCAL VARIABLES:
!
! local pointers to implicit in arguments
!
   integer , pointer :: ngridcell(:)      !pft/landunit gridcell index
   real(r8), pointer :: forc_hgt_u_pft(:) !observational height of wind at pft level [m]
   real(r8), pointer :: forc_hgt_t_pft(:) !observational height of temperature at pft level [m]
   real(r8), pointer :: forc_hgt_q_pft(:) !observational height of specific humidity at pft level [m]
   integer , pointer :: pfti(:)           !beginning pfti index for landunit
   integer , pointer :: pftf(:)           !final pft index for landunit
!
! local pointers to implicit out arguments
!
   real(r8), pointer :: u10(:)         ! 10-m wind (m/s) (for dust model)
   real(r8), pointer :: fv(:)          ! friction velocity (m/s) (for dust model)
   real(r8), pointer :: vds(:)         ! dry deposition velocity term (m/s) (for SO4 NH4NO3)
!
!
! !OTHER LOCAL VARIABLES:
!EOP
!
   real(r8), parameter :: zetam = 1.574_r8 ! transition point of flux-gradient relation (wind profile)
   real(r8), parameter :: zetat = 0.465_r8 ! transition point of flux-gradient relation (temp. profile)
   integer :: f                            ! pft/landunit filter index
   integer :: n                            ! pft/landunit index
   integer :: g                            ! gridcell index
   integer :: pp                           ! pfti,pftf index
   real(r8):: zldis(lbn:ubn)               ! reference height "minus" zero displacement heght [m]
   real(r8):: zeta(lbn:ubn)                ! dimensionless height used in Monin-Obukhov theory
#if (defined DUST)
   real(r8) :: tmp1,tmp2,tmp3,tmp4         ! Used to diagnose the 10 meter wind
   real(r8) :: fmnew                       ! Used to diagnose the 10 meter wind
   real(r8) :: fm10                        ! Used to diagnose the 10 meter wind
   real(r8) :: zeta10                      ! Used to diagnose the 10 meter wind
#endif
   real(r8) :: vds_tmp                     ! Temporary for dry deposition velocity
!------------------------------------------------------------------------------

   ! Assign local pointers to derived type members (gridcell-level)

   if (present(landunit_index)) then
     ngridcell  => clm3%g%l%gridcell
   else
     ngridcell  => clm3%g%l%c%p%gridcell
   end if

   vds        => clm3%g%l%c%p%pps%vds
   u10        => clm3%g%l%c%p%pps%u10
   fv         => clm3%g%l%c%p%pps%fv

   ! Assign local pointers to derived type members (pft or landunit-level)

   pfti             => clm3%g%l%pfti
   pftf             => clm3%g%l%pftf

   ! Assign local pointers to derived type members (pft-level)

   forc_hgt_u_pft => clm3%g%l%c%p%pps%forc_hgt_u_pft
   forc_hgt_t_pft => clm3%g%l%c%p%pps%forc_hgt_t_pft
   forc_hgt_q_pft => clm3%g%l%c%p%pps%forc_hgt_q_pft

   ! Adjustment factors for unstable (moz < 0) or stable (moz > 0) conditions.

#if (!defined PERGRO)

!dir$ concurrent
!cdir nodep
   do f = 1, fn
      n = filtern(f)
      g = ngridcell(n)

      ! Wind profile

      if (present(landunit_index)) then
        zldis(n) = forc_hgt_u_pft(pfti(n))-displa(n)
      else
        zldis(n) = forc_hgt_u_pft(n)-displa(n)
      end if
      zeta(n) = zldis(n)/obu(n)
      if (zeta(n) < -zetam) then
         ustar(n) = vkc*um(n)/(log(-zetam*obu(n)/z0m(n))&
              - StabilityFunc1(-zetam) &
              + StabilityFunc1(z0m(n)/obu(n)) &
              + 1.14_r8*((-zeta(n))**0.333_r8-(zetam)**0.333_r8))
      else if (zeta(n) < 0._r8) then
         ustar(n) = vkc*um(n)/(log(zldis(n)/z0m(n))&
              - StabilityFunc1(zeta(n))&
              + StabilityFunc1(z0m(n)/obu(n)))
      else if (zeta(n) <=  1._r8) then
         ustar(n) = vkc*um(n)/(log(zldis(n)/z0m(n)) + 5._r8*zeta(n) -5._r8*z0m(n)/obu(n))
      else
         ustar(n) = vkc*um(n)/(log(obu(n)/z0m(n))+5._r8-5._r8*z0m(n)/obu(n) &
              +(5._r8*log(zeta(n))+zeta(n)-1._r8))
      end if
      
      if (zeta(n) < 0._r8) then
         vds_tmp = 2.e-3_r8*ustar(n) * ( 1._r8 + (300._r8/(-obu(n)))**0.666_r8)
      else
         vds_tmp = 2.e-3_r8*ustar(n)
      endif

      if (present(landunit_index)) then
         do pp = pfti(n),pftf(n)
            vds(pp) = vds_tmp
         end do
      else
         vds(n) = vds_tmp
      end if

      ! Temperature profile

      if (present(landunit_index)) then
        zldis(n) = forc_hgt_t_pft(pfti(n))-displa(n)
      else
        zldis(n) = forc_hgt_t_pft(n)-displa(n)
      end if
      zeta(n) = zldis(n)/obu(n)
      if (zeta(n) < -zetat) then
         temp1(n) = vkc/(log(-zetat*obu(n)/z0h(n))&
              - StabilityFunc2(-zetat) &
              + StabilityFunc2(z0h(n)/obu(n)) &
              + 0.8_r8*((zetat)**(-0.333_r8)-(-zeta(n))**(-0.333_r8)))
      else if (zeta(n) < 0._r8) then
         temp1(n) = vkc/(log(zldis(n)/z0h(n)) &
              - StabilityFunc2(zeta(n)) &
              + StabilityFunc2(z0h(n)/obu(n)))
      else if (zeta(n) <=  1._r8) then
         temp1(n) = vkc/(log(zldis(n)/z0h(n)) + 5._r8*zeta(n) - 5._r8*z0h(n)/obu(n))
      else
         temp1(n) = vkc/(log(obu(n)/z0h(n)) + 5._r8 - 5._r8*z0h(n)/obu(n) &
              + (5._r8*log(zeta(n))+zeta(n)-1._r8))
      end if

      ! Humidity profile

      if (present(landunit_index)) then
       if (forc_hgt_q_pft(pfti(n)) == forc_hgt_t_pft(pfti(n)) .and. z0q(n) == z0h(n)) then
         temp2(n) = temp1(n)
       else
         zldis(n) = forc_hgt_q_pft(pfti(n))-displa(n)
         zeta(n) = zldis(n)/obu(n)
         if (zeta(n) < -zetat) then
            temp2(n) = vkc/(log(-zetat*obu(n)/z0q(n)) &
                 - StabilityFunc2(-zetat) &
                 + StabilityFunc2(z0q(n)/obu(n)) &
                 + 0.8_r8*((zetat)**(-0.333_r8)-(-zeta(n))**(-0.333_r8)))
         else if (zeta(n) < 0._r8) then
            temp2(n) = vkc/(log(zldis(n)/z0q(n)) &
                 - StabilityFunc2(zeta(n)) &
                 + StabilityFunc2(z0q(n)/obu(n)))
         else if (zeta(n) <=  1._r8) then
            temp2(n) = vkc/(log(zldis(n)/z0q(n)) + 5._r8*zeta(n)-5._r8*z0q(n)/obu(n))
         else
            temp2(n) = vkc/(log(obu(n)/z0q(n)) + 5._r8 - 5._r8*z0q(n)/obu(n) &
                 + (5._r8*log(zeta(n))+zeta(n)-1._r8))
         end if
       end if
      else
       if (forc_hgt_q_pft(n) == forc_hgt_t_pft(n) .and. z0q(n) == z0h(n)) then
         temp2(n) = temp1(n)
       else
         zldis(n) = forc_hgt_q_pft(n)-displa(n)
         zeta(n) = zldis(n)/obu(n)
         if (zeta(n) < -zetat) then
            temp2(n) = vkc/(log(-zetat*obu(n)/z0q(n)) &
                 - StabilityFunc2(-zetat) &
                 + StabilityFunc2(z0q(n)/obu(n)) &
                 + 0.8_r8*((zetat)**(-0.333_r8)-(-zeta(n))**(-0.333_r8)))
         else if (zeta(n) < 0._r8) then
            temp2(n) = vkc/(log(zldis(n)/z0q(n)) &
                 - StabilityFunc2(zeta(n)) &
                 + StabilityFunc2(z0q(n)/obu(n)))
         else if (zeta(n) <=  1._r8) then
            temp2(n) = vkc/(log(zldis(n)/z0q(n)) + 5._r8*zeta(n)-5._r8*z0q(n)/obu(n))
         else
            temp2(n) = vkc/(log(obu(n)/z0q(n)) + 5._r8 - 5._r8*z0q(n)/obu(n) &
                 + (5._r8*log(zeta(n))+zeta(n)-1._r8))
         end if
       endif
      endif

      ! Temperature profile applied at 2-m

      zldis(n) = 2.0_r8 + z0h(n)
      zeta(n) = zldis(n)/obu(n)
      if (zeta(n) < -zetat) then
         temp12m(n) = vkc/(log(-zetat*obu(n)/z0h(n))&
              - StabilityFunc2(-zetat) &
              + StabilityFunc2(z0h(n)/obu(n)) &
              + 0.8_r8*((zetat)**(-0.333_r8)-(-zeta(n))**(-0.333_r8)))
      else if (zeta(n) < 0._r8) then
         temp12m(n) = vkc/(log(zldis(n)/z0h(n)) &
              - StabilityFunc2(zeta(n))  &
              + StabilityFunc2(z0h(n)/obu(n)))
      else if (zeta(n) <=  1._r8) then
         temp12m(n) = vkc/(log(zldis(n)/z0h(n)) + 5._r8*zeta(n) - 5._r8*z0h(n)/obu(n))
      else
         temp12m(n) = vkc/(log(obu(n)/z0h(n)) + 5._r8 - 5._r8*z0h(n)/obu(n) &
              + (5._r8*log(zeta(n))+zeta(n)-1._r8))
      end if

      ! Humidity profile applied at 2-m

      if (z0q(n) == z0h(n)) then
         temp22m(n) = temp12m(n)
      else
         zldis(n) = 2.0_r8 + z0q(n)
         zeta(n) = zldis(n)/obu(n)
         if (zeta(n) < -zetat) then
            temp22m(n) = vkc/(log(-zetat*obu(n)/z0q(n)) - &
                 StabilityFunc2(-zetat) + StabilityFunc2(z0q(n)/obu(n)) &
                 + 0.8_r8*((zetat)**(-0.333_r8)-(-zeta(n))**(-0.333_r8)))
         else if (zeta(n) < 0._r8) then
            temp22m(n) = vkc/(log(zldis(n)/z0q(n)) - &
                 StabilityFunc2(zeta(n))+StabilityFunc2(z0q(n)/obu(n)))
         else if (zeta(n) <=  1._r8) then
            temp22m(n) = vkc/(log(zldis(n)/z0q(n)) + 5._r8*zeta(n)-5._r8*z0q(n)/obu(n))
         else
            temp22m(n) = vkc/(log(obu(n)/z0q(n)) + 5._r8 - 5._r8*z0q(n)/obu(n) &
                 + (5._r8*log(zeta(n))+zeta(n)-1._r8))
         end if
      end if

#if (defined DUST)
      ! diagnose 10-m wind for dust model (dstmbl.F)
      ! Notes from C. Zender's dst.F:
      ! According to Bon96 p. 62, the displacement height d (here displa) is
      ! 0.0 <= d <= 0.34 m in dust source regions (i.e., regions w/o trees).
      ! Therefore d <= 0.034*z1 and may safely be neglected.
      ! Code from LSM routine SurfaceTemperature was used to obtain u10

      if (present(landunit_index)) then
        zldis(n) = forc_hgt_u_pft(pfti(n))-displa(n)
      else
        zldis(n) = forc_hgt_u_pft(n)-displa(n)
      end if
      zeta(n) = zldis(n)/obu(n)
      if (min(zeta(n), 1._r8) < 0._r8) then
         tmp1 = (1._r8 - 16._r8*min(zeta(n),1._r8))**0.25_r8
         tmp2 = log((1._r8+tmp1*tmp1)/2._r8)
         tmp3 = log((1._r8+tmp1)/2._r8)
         fmnew = 2._r8*tmp3 + tmp2 - 2._r8*atan(tmp1) + 1.5707963_r8
      else
         fmnew = -5._r8*min(zeta(n),1._r8)
      endif
      if (iter == 1) then
         fm(n) = fmnew
      else
         fm(n) = 0.5_r8 * (fm(n)+fmnew)
      end if
      zeta10 = min(10._r8/obu(n), 1._r8)
      if (zeta(n) == 0._r8) zeta10 = 0._r8
      if (zeta10 < 0._r8) then
         tmp1 = (1.0_r8 - 16.0_r8 * zeta10)**0.25_r8
         tmp2 = log((1.0_r8 + tmp1*tmp1)/2.0_r8)
         tmp3 = log((1.0_r8 + tmp1)/2.0_r8)
         fm10 = 2.0_r8*tmp3 + tmp2 - 2.0_r8*atan(tmp1) + 1.5707963_r8
      else                ! not stable
         fm10 = -5.0_r8 * zeta10
      end if
      if (present(landunit_index)) then
        tmp4 = log( max( 1.0_8, forc_hgt_u_pft(pfti(n)) / 10._r8) )
      else 
        tmp4 = log( max( 1.0_8, forc_hgt_u_pft(n) / 10._r8) )
      end if
      if (present(landunit_index)) then
        do pp = pfti(n),pftf(n)
          u10(pp) = ur(n) - ustar(n)/vkc * (tmp4 - fm(n) + fm10)
          fv(pp)  = ustar(n)
        end do 
      else
        u10(n) = ur(n) - ustar(n)/vkc * (tmp4 - fm(n) + fm10)
        fv(n)  = ustar(n)
      end if
#endif

   end do
#endif


#if (defined PERGRO)

   !===============================================================================
   ! The following only applies when PERGRO is defined
   !===============================================================================

!dir$ concurrent
!cdir nodep
   do f = 1, fn
      n = filtern(f)
      g = ngridcell(n)

      if (present(landunit_index)) then
        zldis(n) = forc_hgt_u_pft(pfti(n))-displa(n)
      else
        zldis(n) = forc_hgt_u_pft(n)-displa(n)
      end if
      zeta(n) = zldis(n)/obu(n)
      if (zeta(n) < -zetam) then           ! zeta < -1
         ustar(n) = vkc * um(n) / log(-zetam*obu(n)/z0m(n))
      else if (zeta(n) < 0._r8) then         ! -1 <= zeta < 0
         ustar(n) = vkc * um(n) / log(zldis(n)/z0m(n))
      else if (zeta(n) <= 1._r8) then        !  0 <= ztea <= 1
         ustar(n)=vkc * um(n)/log(zldis(n)/z0m(n))
      else                             !  1 < zeta, phi=5+zeta
         ustar(n)=vkc * um(n)/log(obu(n)/z0m(n))
      endif

      if (present(landunit_index)) then
        zldis(n) = forc_hgt_t_pft(pfti(n))-displa(n)
      else
        zldis(n) = forc_hgt_t_pft(n)-displa(n)
      end if
      zeta(n) = zldis(n)/obu(n)
      if (zeta(n) < -zetat) then
         temp1(n)=vkc/log(-zetat*obu(n)/z0h(n))
      else if (zeta(n) < 0._r8) then
         temp1(n)=vkc/log(zldis(n)/z0h(n))
      else if (zeta(n) <= 1._r8) then
         temp1(n)=vkc/log(zldis(n)/z0h(n))
      else
         temp1(n)=vkc/log(obu(n)/z0h(n))
      end if

      if (present(landunit_index)) then
        zldis(n) = forc_hgt_q_pft(pfti(n))-displa(n)
      else
        zldis(n) = forc_hgt_q_pft(n)-displa(n)
      end if
      zeta(n) = zldis(n)/obu(n)
      if (zeta(n) < -zetat) then
         temp2(n)=vkc/log(-zetat*obu(n)/z0q(n))
      else if (zeta(n) < 0._r8) then
         temp2(n)=vkc/log(zldis(n)/z0q(n))
      else if (zeta(n) <= 1._r8) then
         temp2(n)=vkc/log(zldis(n)/z0q(n))
      else
         temp2(n)=vkc/log(obu(n)/z0q(n))
      end if

      zldis(n) = 2.0_r8 + z0h(n)
      zeta(n) = zldis(n)/obu(n)
      if (zeta(n) < -zetat) then
         temp12m(n)=vkc/log(-zetat*obu(n)/z0h(n))
      else if (zeta(n) < 0._r8) then
         temp12m(n)=vkc/log(zldis(n)/z0h(n))
      else if (zeta(n) <= 1._r8) then
         temp12m(n)=vkc/log(zldis(n)/z0h(n))
      else
         temp12m(n)=vkc/log(obu(n)/z0h(n))
      end if

      zldis(n) = 2.0_r8 + z0q(n)
      zeta(n) = zldis(n)/obu(n)
      if (zeta(n) < -zetat) then
         temp22m(n)=vkc/log(-zetat*obu(n)/z0q(n))
      else if (zeta(n) < 0._r8) then
         temp22m(n)=vkc/log(zldis(n)/z0q(n))
      else if (zeta(n) <= 1._r8) then
         temp22m(n)=vkc/log(zldis(n)/z0q(n))
      else
         temp22m(n)=vkc/log(obu(n)/z0q(n))
      end if
#if (defined DUST)
      ! diagnose 10-m wind for dust model (dstmbl.F)
      ! Notes from C. Zender's dst.F:
      ! According to Bon96 p. 62, the displacement height d (here displa) is
      ! 0.0 <= d <= 0.34 m in dust source regions (i.e., regions w/o trees).
      ! Therefore d <= 0.034*z1 and may safely be neglected.
      ! Code from LSM routine SurfaceTemperature was used to obtain u10

      if (present(landunit_index)) then
        zldis(n) = forc_hgt_u_pft(pfti(n))-displa(n)
      else
        zldis(n) = forc_hgt_u_pft(n)-displa(n)
      end if 
      zeta(n) = zldis(n)/obu(n)
      if (min(zeta(n), 1._r8) < 0._r8) then
         tmp1 = (1._r8 - 16._r8*min(zeta(n),1._r8))**0.25_r8
         tmp2 = log((1._r8+tmp1*tmp1)/2._r8)
         tmp3 = log((1._r8+tmp1)/2._r8)
         fmnew = 2._r8*tmp3 + tmp2 - 2._r8*atan(tmp1) + 1.5707963_r8
      else
         fmnew = -5._r8*min(zeta(n),1._r8)
      endif
      if (iter == 1) then
         fm(n) = fmnew
      else
         fm(n) = 0.5_r8 * (fm(n)+fmnew)
      end if
      zeta10 = min(10._r8/obu(n), 1._r8)
      if (zeta(n) == 0._r8) zeta10 = 0._r8
      if (zeta10 < 0._r8) then
         tmp1 = (1.0_r8 - 16.0 * zeta10)**0.25_r8
         tmp2 = log((1.0_r8 + tmp1*tmp1)/2.0_r8)
         tmp3 = log((1.0_r8 + tmp1)/2.0_r8)
         fm10 = 2.0_r8*tmp3 + tmp2 - 2.0_r8*atan(tmp1) + 1.5707963_r8
      else                ! not stable
         fm10 = -5.0_r8 * zeta10
      end if
      if (present(landunit_index)) then
        tmp4 = log( max( 1.0_r8, forc_hgt_u_pft(pfti(n)) / 10._r8 ) )
      else
        tmp4 = log( max( 1.0_r8, forc_hgt_u_pft(n) / 10._r8 ) )
      end if
      if (present(landunit_index)) then
        do pp = pfti(n),pftf(n)
          u10(pp) = ur(n) - ustar(n)/vkc * (tmp4 - fm(n) + fm10)
          fv(pp)  = ustar(n)
        end do 
      else
        u10(n) = ur(n) - ustar(n)/vkc * (tmp4 - fm(n) + fm10)
        fv(n)  = ustar(n)
      end if
#endif
   end do

#endif

   end subroutine FrictionVelocity

!------------------------------------------------------------------------------
!BOP
!
! !IROUTINE: StabilityFunc
!
! !INTERFACE:
   real(r8) function StabilityFunc1(zeta)
!
! !DESCRIPTION:
! Stability function for rib < 0.
!
! !USES:
      use shr_const_mod, only: SHR_CONST_PI
!
! !ARGUMENTS:
      implicit none
      real(r8), intent(in) :: zeta  ! dimensionless height used in Monin-Obukhov theory
!
! !CALLED FROM:
! subroutine FrictionVelocity in this module
!
! !REVISION HISTORY:
! 15 September 1999: Yongjiu Dai; Initial code
! 15 December 1999:  Paul Houser and Jon Radakovich; F90 Revision
!
!
! !LOCAL VARIABLES:
!EOP
      real(r8) :: chik, chik2
!------------------------------------------------------------------------------

      chik2 = sqrt(1._r8-16._r8*zeta)
      chik = sqrt(chik2)
      StabilityFunc1 = 2._r8*log((1._r8+chik)*0.5_r8) &
           + log((1._r8+chik2)*0.5_r8)-2._r8*atan(chik)+SHR_CONST_PI*0.5_r8

    end function StabilityFunc1

!------------------------------------------------------------------------------
!BOP
!
! !IROUTINE: StabilityFunc2
!
! !INTERFACE:
   real(r8) function StabilityFunc2(zeta)
!
! !DESCRIPTION:
! Stability function for rib < 0.
!
! !USES:
     use shr_const_mod, only: SHR_CONST_PI
!
! !ARGUMENTS:
     implicit none
     real(r8), intent(in) :: zeta  ! dimensionless height used in Monin-Obukhov theory
!
! !CALLED FROM:
! subroutine FrictionVelocity in this module
!
! !REVISION HISTORY:
! 15 September 1999: Yongjiu Dai; Initial code
! 15 December 1999:  Paul Houser and Jon Radakovich; F90 Revision
!
!
! !LOCAL VARIABLES:
!EOP
     real(r8) :: chik2
!------------------------------------------------------------------------------

     chik2 = sqrt(1._r8-16._r8*zeta)
     StabilityFunc2 = 2._r8*log((1._r8+chik2)*0.5_r8)

   end function StabilityFunc2

!-----------------------------------------------------------------------
!BOP
!
! !IROUTINE: MoninObukIni
!
! !INTERFACE:
  subroutine MoninObukIni (ur, thv, dthv, zldis, z0m, um, obu)
!
! !DESCRIPTION:
! Initialization of the Monin-Obukhov length.
! The scheme is based on the work of Zeng et al. (1998):
! Intercomparison of bulk aerodynamic algorithms for the computation
! of sea surface fluxes using TOGA CORE and TAO data. J. Climate,
! Vol. 11, 2628-2644.
!
! !USES:
    use clm_varcon, only : grav
!
! !ARGUMENTS:
    implicit none
    real(r8), intent(in)  :: ur    ! wind speed at reference height [m/s]
    real(r8), intent(in)  :: thv   ! virtual potential temperature (kelvin)
    real(r8), intent(in)  :: dthv  ! diff of vir. poten. temp. between ref. height and surface
    real(r8), intent(in)  :: zldis ! reference height "minus" zero displacement heght [m]
    real(r8), intent(in)  :: z0m   ! roughness length, momentum [m]
    real(r8), intent(out) :: um    ! wind speed including the stability effect [m/s]
    real(r8), intent(out) :: obu   ! monin-obukhov length (m)
!
! !CALLED FROM:
! subroutine BareGroundFluxes in module BareGroundFluxesMod.F90
! subroutine BiogeophysicsLake in module BiogeophysicsLakeMod.F90
! subroutine CanopyFluxes in module CanopyFluxesMod.F90
!
! !REVISION HISTORY:
! 15 September 1999: Yongjiu Dai; Initial code
! 15 December 1999:  Paul Houser and Jon Radakovich; F90 Revision
!
!
! !LOCAL VARIABLES:
!EOP
!
    real(r8) :: wc    ! convective velocity [m/s]
    real(r8) :: rib   ! bulk Richardson number
    real(r8) :: zeta  ! dimensionless height used in Monin-Obukhov theory
    real(r8) :: ustar ! friction velocity [m/s]
!-----------------------------------------------------------------------

    ! Initial values of u* and convective velocity

    ustar=0.06_r8
    wc=0.5_r8
    if (dthv >= 0._r8) then
       um=max(ur,0.1_r8)
    else
       um=sqrt(ur*ur+wc*wc)
    endif

    rib=grav*zldis*dthv/(thv*um*um)
#if (defined PERGRO)
    rib = 0._r8
#endif

    if (rib >= 0._r8) then      ! neutral or stable
       zeta = rib*log(zldis/z0m)/(1._r8-5._r8*min(rib,0.19_r8))
       zeta = min(2._r8,max(zeta,0.01_r8 ))
    else                     ! unstable
       zeta=rib*log(zldis/z0m)
       zeta = max(-100._r8,min(zeta,-0.01_r8 ))
    endif

    obu=zldis/zeta

  end subroutine MoninObukIni

end module FrictionVelocityMod

module VOCEmissionMod

!-----------------------------------------------------------------------
!BOP
!
! !MODULE: VOCEmissionMod
!
! !DESCRIPTION:
! Volatile organic compound emission
!
! !USES:
!
! !PUBLIC TYPES:
  implicit none
  save
!
! !PUBLIC MEMBER FUNCTIONS:
  public :: VOCEmission
!
! !REVISION HISTORY:
! Created by Mariana Vertenstein
!
!EOP
!-----------------------------------------------------------------------

contains

!-----------------------------------------------------------------------
!BOP
!
! !IROUTINE: VOCEmission
!
! !INTERFACE:
  subroutine VOCEmission (lbp, ubp, num_soilp, filter_soilp )
!
! ! NEW DESCRIPTION
! Volatile organic compound emission
! This code simulates volatile organic compound emissions following:
! 1. Isoprene: Guenther et al., 2006 description of MEGAN emissions
!     following equations 2-9, 16-17, 20
! 2. Monoterpenes/OVOCs/ORVOCs/CO: algorithm presented in Guenther, A., 
!    1999: Modeling Biogenic Volatile Organic Compound Emissions to the 
!    Atmosphere. In Reactive Hydrocarbons in the Atmosphere, Ch. 3
!    With updates from MEGAN online user's guide 
!    ( http://acd.ucar.edu/~guenther/MEGAN/MEGANusersguide.pdf)
! This model relies on the assumption that 90% of isoprene and monoterpene
! emissions originate from canopy foliage:
!    E= epsilon * gamma * rho
! VOC flux (E) [ugC m-2 h-1] is calculated from baseline emission
! factors (epsilon) [ugC m-2 h-1] which are mapped for each PFT (isoprene)
! or constant for each PFT (others).  Note that for constant EFs the units
! of [ugC g-1 h-1] must be multiplied by the source density factor.
! The emission activity factor (gamma) [unitless] for isoprene includes 
! dependence on PPFT, temperature, LAI, leaf age and soil moisture.  
! The canopy environment constant was calculated offline for CLM+CAM at 
! standard conditions.
! The emission activity factor for the other emissions depends on temperature.
! We assume that the escape efficiency (rho) here is unity following
! Guenther et al., 2006.
! Subroutine written to operate at the patch level.
! IN FINAL IMPLEMENTATION, REMEMBER:
! 1. may wish to call this routine only as freq. as rad. calculations
! 2. may wish to place epsilon values directly in pft-physiology file
! Output: vocflx(nvoc) !VOC flux [ug C m-2 h-1]
!
!
! !USES:
    use shr_kind_mod , only : r8 => shr_kind_r8
    use clmtype
    use clm_varpar   , only : nvoc, numpft
    use shr_const_mod, only : SHR_CONST_RGAS
    use clm_varcon   , only : denice
    use clm_varpar   , only : nlevsoi
    use pftvarcon    , only : ndllf_evr_tmp_tree,  ndllf_evr_brl_tree,    &
                              ndllf_dcd_brl_tree,  nbrdlf_evr_trp_tree,   &
                              nbrdlf_evr_tmp_tree, nbrdlf_dcd_brl_shrub,  &
                              nbrdlf_dcd_trp_tree, nbrdlf_dcd_tmp_tree,   &
                              nbrdlf_dcd_brl_tree, nbrdlf_evr_shrub,      &
                              nc3_arctic_grass,    nc4_grass,    noveg
!
! !ARGUMENTS:
    implicit none
    integer, intent(in) :: lbp, ubp                    ! pft bounds
    integer, intent(in) :: num_soilp                   ! number of columns in soil pft filter
    integer, intent(in) :: filter_soilp(num_soilp)     ! pft filter for soil
!
! !CALLED FROM:
!
! !REVISION HISTORY:
! Author: Sam Levis
! 2/1/02, Peter Thornton: migration to new data structure
! 4/15/06, Colette L. Heald: modify for updated MEGAN model (Guenther et al., 2006)
!
! !LOCAL VARIABLES:
!
! local pointers to implicit in arguments
!
    integer , pointer :: pgridcell(:)     ! gridcell index of corresponding pft
    integer , pointer :: pcolumn(:)       ! column index of corresponding pft
    integer , pointer :: ivt(:)           ! pft vegetation type for current
    real(r8), pointer :: t_veg(:)         ! pft vegetation temperature (Kelvin)
    real(r8), pointer :: fsun(:)          ! sunlit fraction of canopy
    real(r8), pointer :: elai(:)          ! one-sided leaf area index with burying by snow
    real(r8), pointer :: clayfrac(:)      ! fraction of soil that is clay
    real(r8), pointer :: sandfrac(:)      ! fraction of soil that is sand
    real(r8), pointer :: forc_solad(:,:)  ! direct beam radiation (visible only)
    real(r8), pointer :: forc_solai(:,:)  ! diffuse radiation     (visible only)
    real(r8), pointer :: sla(:)           ! specific leaf area [m2 leaf g-1 C]
    real(r8), pointer :: h2osoi_vol(:,:)  ! volumetric soil water (m3/m3)
    real(r8), pointer :: h2osoi_ice(:,:)  ! ice soil content (kg/m3)
    real(r8), pointer :: dz(:,:)          ! depth of layer (m)
    real(r8), pointer :: coszen(:)        ! cosine of solar zenith angle
    real(r8), pointer :: efisop(:,:)      ! emission factors for isoprene for each pft [ug C m-2 h-1]
    real(r8), pointer :: elai_p(:)        ! one-sided leaf area index from previous timestep
    real(r8), pointer :: t_veg24(:)       ! avg pft vegetation temperature for last 24 hrs
    real(r8), pointer :: t_veg240(:)      ! avg pft vegetation temperature for last 240 hrs
    real(r8), pointer :: fsun24(:)        ! sunlit fraction of canopy last 24 hrs
    real(r8), pointer :: fsun240(:)       ! sunlit fraction of canopy last 240 hrs
    real(r8), pointer :: forc_solad24(:)  ! direct beam radiation last 24hrs  (visible only)
    real(r8), pointer :: forc_solai24(:)  ! diffuse radiation  last 24hrs     (visible only)
    real(r8), pointer :: forc_solad240(:) ! direct beam radiation last 240hrs (visible only)
    real(r8), pointer :: forc_solai240(:) ! diffuse radiation  last 240hrs    (visible only)
    real(r8), pointer :: bsw(:,:)         ! Clapp and Hornberger "b" (nlevgrnd)
    real(r8), pointer :: watsat(:,:)      ! volumetric soil water at saturation (porosity) (nlevgrnd)
    real(r8), pointer :: sucsat(:,:)      ! minimum soil suction (mm) (nlevgrnd)

    real(r8), parameter :: smpmax = 2.57e5_r8 ! maximum soil matrix potential
!
! local pointers to original implicit out arrays
!
    real(r8), pointer :: vocflx(:,:)      ! VOC flux [ug C m-2 h-1]
    real(r8), pointer :: vocflx_tot(:)    ! VOC flux [ug C m-2 h-1]
    real(r8), pointer :: vocflx_1(:)      ! VOC flux(1) [ug C m-2 h-1]
    real(r8), pointer :: vocflx_2(:)      ! VOC flux(2) [ug C m-2 h-1]
    real(r8), pointer :: vocflx_3(:)      ! VOC flux(3) [ug C m-2 h-1]
    real(r8), pointer :: vocflx_4(:)      ! VOC flux(4) [ug C m-2 h-1]
    real(r8), pointer :: vocflx_5(:)      ! VOC flux(5) [ug C m-2 h-1]
    real(r8), pointer :: Eopt_out(:)     
    real(r8), pointer :: topt_out(:)
    real(r8), pointer :: alpha_out(:)
    real(r8), pointer :: cp_out(:)
    real(r8), pointer :: paru_out(:)
    real(r8), pointer :: par24u_out(:)
    real(r8), pointer :: par240u_out(:)
    real(r8), pointer :: para_out(:)
    real(r8), pointer :: par24a_out(:)
    real(r8), pointer :: par240a_out(:)
    real(r8), pointer :: gamma_out(:)
    real(r8), pointer :: gammaT_out(:)
    real(r8), pointer :: gammaP_out(:)
    real(r8), pointer :: gammaL_out(:)
    real(r8), pointer :: gammaA_out(:)
    real(r8), pointer :: gammaS_out(:)
!
!
! !OTHER LOCAL VARIABLES:
!EOP
!
    integer  :: fp,p,g,c,n,j            ! indices
    integer  :: ct_bad
    real(r8) :: epsilon(lbp:ubp)        ! emission factor [ugC m-2 h-1]
    real(r8) :: par                     ! temporary
    real(r8) :: par24                   ! temporary
    real(r8) :: par240                  ! temporary
    real(r8) :: density                 ! source density factor [g dry wgt foliar mass/m2 ground]
    real(r8) :: gamma(lbp:ubp)          ! activity factor (accounting for light, T, age, LAI conditions)
    real(r8) :: gamma_p                 ! activity factor for PPFD
    real(r8) :: gamma_l                 ! activity factor for PPFD & LAI
    real(r8) :: gamma_t                 ! activity factor for temperature
    real(r8) :: gamma_a                 ! activity factor for leaf age
    real(r8) :: gamma_sm                ! activity factor for soil moisture
    real(r8) :: x                       ! temporary 
    real(r8) :: Eopt                    ! temporary 
    real(r8) :: topt                    ! temporary 
    real(r8) :: cp                      ! temporary
    real(r8) :: alpha                   ! temporary
    real(r8) :: elai_prev               ! lai for previous timestep
    real(r8) :: fnew, fgro, fmat, fsen  ! fractions of leaves at different phenological stages
    real(r8) :: nl                      ! temporary number of soil levels
    real(r8) :: theta_ice               ! water content in ice in m3/m3
    real(r8) :: wilt                    ! wilting point in m3/m3
    real(r8) :: theta1                  ! temporary
!
! Constants
!
    real(r8), parameter :: R   = SHR_CONST_RGAS*0.001_r8 ! univ. gas constant [J K-1 mol-1]
    real(r8), parameter :: scale_mw =0.882_r8            ! conversion factor for isoprene -> carbon
    real(r8), parameter :: alpha_fix = 0.001_r8          ! empirical coefficient
    real(r8), parameter :: cp_fix = 1.21_r8              ! empirical coefficient
    real(r8), parameter :: ct1 = 95.0_r8                 ! empirical coefficient (70 in User's Guide)
    real(r8), parameter :: ct2 = 230.0_r8                ! empirical coefficient  (200 in User's Guide)
    real(r8), parameter :: ct3 = 0.00831_r8              ! empirical coefficient (0.0083 in User's Guide)
    real(r8), parameter :: topt_fix = 317._r8            ! std temperature [K]
    real(r8), parameter :: Eopt_fix = 2.26_r8            ! empirical coefficient
    real(r8), parameter :: tstd = 303.15_r8              ! std temperature [K]
    real(r8), parameter :: bet = 0.09_r8                 ! beta empirical coefficient [K-1]
    real(r8), parameter :: clai1 = 0.49_r8               ! empirical coefficient
    real(r8), parameter :: clai2 = 0.2_r8                ! empirical coefficient
    real(r8), parameter :: clai3 = 5.0_r8                ! empirical coefficient
    real(r8), parameter :: Anew = 0.01_r8                ! relative emission factor for new plants
    real(r8), parameter :: Agro = 0.5_r8                 ! relative emission factor for new plants
    real(r8), parameter :: Amat = 1.0_r8                 ! relative emission factor for new plants
    real(r8), parameter :: Asen = 0.33_r8                ! relative emission factor for new plants
    real(r8), parameter :: cce = 0.40_r8                 ! factor to set emissions to unity @ std
    real(r8), parameter :: cce1 = 0.47_r8                ! same as Cce but for non-accumulated vars
    real(r8), parameter :: ca1 = 0.004_r8                ! empirical coefficent for alpha
    real(r8), parameter :: ca2 = 0.0005_r8               ! empirical coefficent for alpha
    real(r8), parameter :: ca3 = 0.0468_r8               ! empirical coefficent for cp
    real(r8), parameter :: par0_sun = 200._r8            ! std conditions for past 24 hrs [umol/m2/s]
    real(r8), parameter :: par0_shade = 50._r8           ! std conditions for past 24 hrs [umol/m2/s]
    real(r8), parameter :: co1 = 313._r8                 ! empirical coefficient
    real(r8), parameter :: co2 = 0.6_r8                  ! empirical coefficient
    real(r8), parameter :: co3 = 2.034_r8                ! empirical coefficient
    real(r8), parameter :: co4 = 0.05_r8                 ! empirical coefficient
    real(r8), parameter :: tstd0 = 297_r8                ! std temperature [K]
    real(r8), parameter :: deltheta1=0.06_r8             ! empirical coefficient
!
! These are the values from version of genesis-ibis / 1000.
! CN calculates its own sla [m2 leaf g-1 C]
! Divide by 2 in the equation to get dry weight foliar mass from grams carbon
!
    real(r8) :: hardwire_sla(0:numpft)
    real(r8) :: slarea(lbp:ubp)           ! Specific leaf areas [m2 leaf g-1 C]
    real(r8) :: hardwire_droot(0:numpft)  ! Root depth [m]
!-----------------------------------------------------------------------

    ! Assign local pointers to derived type members (gridcell-level)
    forc_solad => clm_a2l%forc_solad
    forc_solai => clm_a2l%forc_solai
    efisop     => clm3%g%gve%efisop

    ! Assign local pointers to derived subtypes components (column-level)
    h2osoi_vol       => clm3%g%l%c%cws%h2osoi_vol
    h2osoi_ice       => clm3%g%l%c%cws%h2osoi_ice
    dz               => clm3%g%l%c%cps%dz
    bsw              => clm3%g%l%c%cps%bsw
    watsat           => clm3%g%l%c%cps%watsat
    sucsat           => clm3%g%l%c%cps%sucsat

    ! Assign local pointers to derived subtypes components (pft-level)
    pgridcell        => clm3%g%l%c%p%gridcell
    pcolumn          => clm3%g%l%c%p%column
    ivt              => clm3%g%l%c%p%itype
    t_veg            => clm3%g%l%c%p%pes%t_veg
    fsun             => clm3%g%l%c%p%pps%fsun
    elai             => clm3%g%l%c%p%pps%elai
    clayfrac         => clm3%g%l%c%p%pps%clayfrac
    sandfrac         => clm3%g%l%c%p%pps%sandfrac
    vocflx           => clm3%g%l%c%p%pvf%vocflx
    vocflx_tot       => clm3%g%l%c%p%pvf%vocflx_tot
    vocflx_1         => clm3%g%l%c%p%pvf%vocflx_1
    vocflx_2         => clm3%g%l%c%p%pvf%vocflx_2
    vocflx_3         => clm3%g%l%c%p%pvf%vocflx_3
    vocflx_4         => clm3%g%l%c%p%pvf%vocflx_4
    vocflx_5         => clm3%g%l%c%p%pvf%vocflx_5
    Eopt_out         => clm3%g%l%c%p%pvf%Eopt_out
    topt_out         => clm3%g%l%c%p%pvf%topt_out
    alpha_out        => clm3%g%l%c%p%pvf%alpha_out
    cp_out           => clm3%g%l%c%p%pvf%cp_out
    paru_out         => clm3%g%l%c%p%pvf%paru_out
    par24u_out       => clm3%g%l%c%p%pvf%par24u_out
    par240u_out      => clm3%g%l%c%p%pvf%par240u_out
    para_out         => clm3%g%l%c%p%pvf%para_out
    par24a_out       => clm3%g%l%c%p%pvf%par24a_out
    par240a_out      => clm3%g%l%c%p%pvf%par240a_out
    gammaL_out       => clm3%g%l%c%p%pvf%gammaL_out
    gammaT_out       => clm3%g%l%c%p%pvf%gammaT_out
    gammaP_out       => clm3%g%l%c%p%pvf%gammaP_out
    gammaA_out       => clm3%g%l%c%p%pvf%gammaA_out
    gammaS_out       => clm3%g%l%c%p%pvf%gammaS_out
    gamma_out        => clm3%g%l%c%p%pvf%gamma_out
    sla              => clm3%g%l%c%p%pps%slasha

    t_veg24          => clm3%g%l%c%p%pvs%t_veg24
    t_veg240         => clm3%g%l%c%p%pvs%t_veg240
    forc_solad24     => clm3%g%l%c%p%pvs%fsd24
    forc_solad240    => clm3%g%l%c%p%pvs%fsd240
    forc_solai24     => clm3%g%l%c%p%pvs%fsi24
    forc_solai240    => clm3%g%l%c%p%pvs%fsi240
    fsun24           => clm3%g%l%c%p%pvs%fsun24
    fsun240          => clm3%g%l%c%p%pvs%fsun240
    elai_p           => clm3%g%l%c%p%pvs%elai_p

    hardwire_sla(noveg)                                    = 0._r8     ! bare-soil

    hardwire_sla(ndllf_evr_tmp_tree)                       = 0.0125_r8 !needleleaf
    hardwire_sla(ndllf_evr_brl_tree)                       = 0.0125_r8 !Gordon Bonan suggests NET = 0.0076
    hardwire_sla(ndllf_dcd_brl_tree)                       = 0.0125_r8 !Gordon Bonan suggests NDT = 0.0200

    hardwire_sla(nbrdlf_evr_trp_tree)                      = 0.0250_r8 !broadleaf
    hardwire_sla(nbrdlf_evr_tmp_tree)                      = 0.0250_r8 !Gordon Bonan suggests BET = 0.0178
    hardwire_sla(nbrdlf_dcd_trp_tree)                      = 0.0250_r8 !Gordon Bonan suggests BDT = 0.0274
    hardwire_sla(nbrdlf_dcd_tmp_tree:nbrdlf_dcd_brl_shrub) = 0.0250_r8 

    hardwire_sla(nc3_arctic_grass:numpft)                  = 0.0200_r8 !grass/crop

! root depth (m) (defined based on Zeng et al., 2001, cf Guenther 2006)

    hardwire_droot(noveg)                                     = 0._r8   ! bare-soil
    hardwire_droot(ndllf_evr_tmp_tree:ndllf_evr_brl_tree)     = 1.8_r8  ! evergreen tree
    hardwire_droot(ndllf_dcd_brl_tree)                        = 2.0_r8  ! needleleaf deciduous boreal tree
    hardwire_droot(nbrdlf_evr_trp_tree:nbrdlf_evr_tmp_tree)   = 3.0_r8  ! broadleaf evergreen tree
    hardwire_droot(nbrdlf_dcd_trp_tree:nbrdlf_dcd_brl_tree)   = 2.0_r8  ! broadleaf deciduous tree
    hardwire_droot(nbrdlf_evr_shrub:nbrdlf_dcd_brl_shrub)     = 2.5_r8  ! shrub
    hardwire_droot(nc3_arctic_grass:numpft)                   = 1.5_r8  ! grass/crop

! initialize variables which get passed to the atmosphere
    vocflx(lbp:ubp, :)=0._r8

    ! Determine specific leaf array
    do fp = 1,num_soilp
       p = filter_soilp(fp)

       slarea(p) = hardwire_sla(ivt(p))

    end do


    ! Begin loop through voc species
    !_______________________________________________________________________________

    do n = 1, nvoc
       select case (n)

       case(1)	

          do fp = 1,num_soilp
             p = filter_soilp(fp)
             g = pgridcell(p)


             ! epsilon: use gridded values for 6 PFTs specified by MEGAN following
             ! -------  Guenther et al. (2006).  Map the numpft CLM PFTs to these 6.
             !          Units: [ug C m-2 h-1] (convert input files from units of 
             !                 [ug isop m-2 h-1])
    	     epsilon(p) = 0._r8

             ! isoprenes:
             if (     ivt(p) == ndllf_evr_tmp_tree  &
             .or.     ivt(p) == ndllf_evr_brl_tree) then     !fineleaf evergreen
                	epsilon(p) = efisop(2,g)*scale_mw
             else if (ivt(p) == ndllf_dcd_brl_tree) then     !fineleaf deciduous
                	epsilon(p) = efisop(3,g)*scale_mw
             else if (ivt(p) >= nbrdlf_evr_trp_tree &
             .and.    ivt(p) <= nbrdlf_dcd_brl_tree) then    !broadleaf trees
                	epsilon(p) = efisop(1,g)*scale_mw
             else if (ivt(p) >= nbrdlf_evr_shrub &
             .and.    ivt(p) <= nbrdlf_dcd_brl_shrub) then   !shrubs
                	epsilon(p) = efisop(4,g)*scale_mw
             else if (ivt(p) >= nc3_arctic_grass &
             .and.    ivt(p) <= nc4_grass) then              !grass
                	epsilon(p) = efisop(5,g)*scale_mw
             else if (ivt(p) >  nc4_grass) then              !crops
                	epsilon(p) =efisop(6,g)*scale_mw
             end if

          end do

       case(2)

          do fp = 1,num_soilp
             p = filter_soilp(fp)
             g = pgridcell(p)

             ! epsilon: use values from table 3 in Guenther (1997) which originate in
             ! -------  Guenther et al. (1995). In the comments below, I mention the pft
             !          category as described in table 3. Some values were taken directly
             !          from Guenther et al. (1995). Units: [ugC g-1 h-1]
             !          Values were updated on 1/2002 (Guenther, personal communication)

             ! monoterpenes:
             epsilon(p) = 0._r8
             ! monoterpenes:
             if (     ivt(p) >= ndllf_evr_tmp_tree &
             .and.    ivt(p) <= ndllf_evr_brl_tree) then     !needleleaf evergreen
                epsilon(p) = 2.0_r8
             else if (ivt(p) == ndllf_dcd_brl_tree) then     !needleleaf deciduous
                epsilon(p) = 1.6_r8
             else if (ivt(p) >= nbrdlf_evr_trp_tree  &
             .and.    ivt(p) <= nbrdlf_dcd_brl_tree) then    !broadleaf everg trop
                epsilon(p) = 0.4_r8
             else if (ivt(p) >= nbrdlf_evr_shrub &
             .and.    ivt(p) <= nbrdlf_dcd_brl_shrub) then   !other woody veg
                epsilon(p) = 0.8_r8
             else if (ivt(p) >= nc3_arctic_grass &
             .and.    ivt(p) <= numpft) then                 !grass & crop
                epsilon(p) = 0.1_r8
             end if
          end do

       case (3)
          do fp = 1,num_soilp
             p = filter_soilp(fp)
             g = pgridcell(p)

             ! other VOCs (OVOCs)
             epsilon(p) = 1.0_r8                 !Guenther (personal communication)
          end do

       case (4)
          do fp = 1,num_soilp
             p = filter_soilp(fp)
             g = pgridcell(p)

             ! other reactive VOCs (ORVOCs)
             epsilon(p) = 1.0_r8                 !Guenther (personal communication)
          end do

       case (5)
          do fp = 1,num_soilp
             p = filter_soilp(fp)
             g = pgridcell(p)

             ! CO
             epsilon(p) = 0.3_r8                 !Guenther (personal communication)
          end do


       case default

          write(6,*)'only nvocs up to index 5 are currently supported'
          call endrun()

       end select
       
       
       ct_bad=0

       select case (n)

       case (1)

          do fp = 1,num_soilp
             p = filter_soilp(fp)
             g = pgridcell(p)
             c = pcolumn(p)


             ! gamma: Activity factor. Units [dimensionless]
             ! =====  For isoprene include activity factors for LAI,PPFD, T, leaf age, and soil moisture

             ! Activity factor for LAI (Guenther et al., 2006)
             !------------------------
             ! Guenther et al., 2006 eq 3
             if ( (fsun240(p) > 0.0_r8) .and. (fsun240(p) < 1.e30_r8) ) then 
                 gamma_l = cce * elai(p)
             else
                 gamma_l = cce1 * elai(p)
             end if
	     gammaL_out(p)=gamma_l

             ! Activity factor for PPFD (Guenther et al., 2006)
             !-------------------------
	     ! With distinction between sunlit and shaded leafs, weight scalings by
             ! fsun and fshade 
             ! Scale total incident par by fraction of sunlit leaves (added on 1/2002)
             ! multiply w/m2 by 4.6 to get umol/m2/s for par (added 8/14/02)

             ! fvitt -- forc_solad240, forc_solai240 can be zero when CLM finidat is specified
             !          which will cause par240 to be zero and produce NaNs via log(par240)
             ! dml   -- fsun240 can be equal to or greater than one before 10 day averages are
             !           set on startup or if a new pft comes online during land cover change.
             !           Avoid this problem by only doing calculations with fsun240 when fsun240 is
             !           between 0 and 1
             if ( (fsun240(p) > 0._r8) .and. (fsun240(p) < 1._r8) .and.  (forc_solad240(p) > 0._r8) &
             .and. (forc_solai240(p) > 0._r8)) then
                ! With alpha and cp calculated based on eq 6 and 7:
                ! Note indexing for accumulated variables is all at pft level
                ! SUN:
                par = (forc_solad(g,1) + fsun(p) * forc_solai(g,1)) * 4.6_r8
                par24 = (forc_solad24(p) + fsun24(p) * forc_solai24(p)) * 4.6_r8
                par240 = (forc_solad240(p) + fsun240(p) * forc_solai240(p)) * 4.6_r8
                alpha = ca1 - ca2 * log(par240)
                cp = ca3 * exp(ca2 * (par24-par0_sun))*par240**(0.6_r8)
                gamma_p = fsun(p) * ( cp * alpha*par * (1._r8 + alpha*alpha*par*par)**(-0.5_r8) )
	        paru_out(p)=par
		par24u_out(p)=par24
                par240u_out(p)=par240
                ! SHADE:
                par = ((1._r8 - fsun(p)) * forc_solai(g,1)) * 4.6_r8
                par24 = ((1._r8 - fsun24(p)) * forc_solai24(p)) * 4.6_r8
                par240 = ((1._r8 - fsun240(p)) * forc_solai240(p)) * 4.6_r8
                alpha = ca1 - ca2 * log(par240)
                cp = ca3 * exp(ca2 * (par24-par0_shade))*par240**(0.6_r8)
                par = ((1._r8 - fsun(p)) * forc_solai(g,1)) * 4.6_r8
                gamma_p = gamma_p + (1-fsun(p)) * (cp*alpha*par*(1._r8 + alpha*alpha*par*par)**(-0.5_r8))
                para_out(p)=par
		par24a_out(p)=par24
 		par240a_out(p)=par240
             else
                ! With fixed alpha and cp (from MEGAN User's Guide):
                ! SUN: direct + diffuse  
                par = (forc_solad(g,1) + fsun(p) * forc_solai(g,1)) * 4.6_r8
                alpha = alpha_fix
                cp = cp_fix
                gamma_p = fsun(p) * ( cp * alpha*par * (1._r8 + alpha*alpha*par*par)**(-0.5_r8) )
		paru_out(p)=par
	        par24u_out(p)=-999
	        par240u_out(p)=-999
                ! SHADE: diffuse 
                par = ((1._r8 - fsun(p)) * forc_solai(g,1)) * 4.6_r8
                gamma_p = gamma_p + (1-fsun(p)) * (cp*alpha*par*(1._r8 + alpha*alpha*par*par)**(-0.5_r8))
		para_out(p)=par
                par24a_out(p)=-999
                par240a_out(p)=-999
             end if 
             alpha_out(p)=alpha
             cp_out(p)=cp
             gammaP_out(p)=gamma_p


             ! Activity factor for temperature (Guenther et al., 2006)
             !--------------------------------
             if ( (t_veg240(p) > 0.0_r8) .and. (t_veg240(p) < 1.e30_r8) ) then 
                ! topt and Eopt from eq 8 and 9:
                topt = co1 + (co2 * (t_veg240(p)-tstd0))
                Eopt = co3 * exp (co4 * (t_veg24(p)-tstd0)) * exp(co4 * (t_veg240(p) -tstd0))
	     else
                topt = topt_fix
                Eopt = Eopt_fix
             endif 
             x = ( (1._r8/topt) - (1._r8/(t_veg(p))) ) / ct3
             gamma_t = Eopt * ( ct2 * exp(ct1 * x)/(ct2 - ct1 * (1._r8 - exp(ct2 * x))) )
             topt_out(p)=topt
             Eopt_out(p)=Eopt
             gammaT_out(p)=gamma_t


             ! Activity factor for leaf age (Guenther et al., 2006)
             !-----------------------------
             ! If not CNDV elai is constant therefore gamma_a=1.0
             ! gamma_a set to unity for evergreens (PFTs 1, 2, 4, 5)
             ! Note that we assume here that the time step is shorter than the number of 
             !days after budbreak required to induce isoprene emissions (ti=12 days) and 
             ! the number of days after budbreak to reach peak emission (tm=28 days)
	     if ( (ivt(p) == ndllf_dcd_brl_tree) .or. (ivt(p) >= nbrdlf_dcd_trp_tree) ) then  ! non-evergreen

                if ( (elai_p(p) > 0.0_r8) .and. (elai_p(p) < 1.e30_r8) )then 
                   elai_prev = 2._r8*elai_p(p)-elai(p)  ! have accumulated average lai over last timestep
                   if (elai_prev == elai(p)) then
                      fnew = 0.0_r8
                      fgro = 0.0_r8
                      fmat = 1.0_r8
                      fsen = 0.0_r8
                   else if (elai_prev > elai(p)) then
                      fnew = 0.0_r8
                      fgro = 0.0_r8
                      fmat = 1.0_r8 - (elai_prev - elai(p))/elai_prev
                      fsen = (elai_prev - elai(p))/elai_prev
                   else if (elai_prev < elai(p)) then
                      fnew = 1 - (elai_prev / elai(p))
                      fgro = 0.0_r8
                      fmat = (elai_prev / elai(p))
                      fsen = 0.0_r8
                   end if             
                
                   gamma_a = fnew * Anew + fgro * Agro + fmat * Amat + fsen * Asen
	        else
                   gamma_a = 1.0_r8
                end if

             else
                gamma_a = 1.0_r8
             end if
             gammaA_out(p)=gamma_a


             ! Activity factor for soil moisture (Guenther et al., 2006) 
             !----------------------------------
             ! Calculate the mean scaling factor throughout the root depth.
             ! wilting point potential is in units of matric potential (mm) 
             ! (1 J/Kg = 0.001 MPa, approx = 0.1 m)
             ! convert to volumetric soil water using equation 7.118 of the CLM4 Technical Note
             if ((clayfrac(p) > 0) .and. (sandfrac(p) > 0)) then 
               gamma_sm = 0._r8
	       nl=0._r8

               do j = 1,nlevsoi
	         if  (sum(dz(c,1:j)) < hardwire_droot(ivt(p)))  then
                   theta_ice = h2osoi_ice(c,j)/(dz(c,j)*denice)
                   wilt = ((smpmax/sucsat(c,j))**(-1._r8/bsw(c,j))) * (watsat(c,j) - theta_ice)
                   theta1 = wilt + deltheta1
                   if (h2osoi_vol(c,j) >= theta1) then 
             	      gamma_sm = gamma_sm + 1._r8
                   else if ( (h2osoi_vol(c,j) > wilt) .and. (h2osoi_vol(c,j) < theta1) ) then
		      gamma_sm = gamma_sm + ( h2osoi_vol(c,j) - wilt ) / deltheta1
                   else
		      gamma_sm = gamma_sm + 0._r8
                   end if
		   nl=nl+1._r8
                 end if
 	       end do 

	       if (nl > 0) then
	         gamma_sm = gamma_sm/nl
	       endif
             else
	       gamma_sm = 1.0_r8
             end if
             gammaS_out(p)=gamma_sm


             ! Calculate total scaling factor
             !--------------------------------
	     gamma(p) = gamma_l * gamma_p * gamma_t * gamma_a * gamma_sm
             if ( (gamma(p) >=0.0_r8) .and. (gamma(p)< 100._r8) ) then
                gamma_out(p)=gamma(p)
	     else
                gamma_out(p)=gamma(p)
                write(6,*) 'clh GAMMA: ',gamma(p),gamma_l,gamma_p,gamma_t,gamma_a,gamma_sm
             end if

          end do

       case (2,3,4,5)

          do fp = 1,num_soilp
             p = filter_soilp(fp)
             g = pgridcell(p)

             ! gamma: Activity factor. Units [dimensionless]
             ! -----  For monoterpenes, OVOCs, ORVOCs, CO include simple activity factors 
             !        for LAI and T only (Guenther et al., 1995)
             gamma_t = exp(bet * (t_veg(p) - tstd))
	     gamma(p)=gamma_t

          end do

       end select

       do fp = 1,num_soilp
          p = filter_soilp(fp)
          g = pgridcell(p)

          ! density: Source density factor [g dry weight foliar mass m-2 ground]
          ! -------  Other than isoprene, need to convert EF units from 
          ! [ug g-1 h-1] to [ug m-2 h-1]
          if (ivt(p) > noveg) then
             density = elai(p) / (slarea(p) * 0.5_r8)
          else
             density = 0._r8
          end if

          ! calculate the voc flux
          ! ----------------------
	  select case (n)

          case(1)
              vocflx(p,n) = epsilon(p) * gamma(p) 

          case(2,3,4,5)
              vocflx(p,n) = epsilon(p) * gamma(p) * density

          end select


       end do   ! end pft loop

    end do   ! end voc species loop
    !_______________________________________________________________________________

    ! Calculate total voc flux and individual components for history output

    do fp = 1,num_soilp
       p = filter_soilp(fp)
       vocflx_tot(p) = 0._r8
    end do
    do n = 1, nvoc
       do fp = 1,num_soilp
          p = filter_soilp(fp)
          vocflx_tot(p) = vocflx_tot(p) + vocflx(p,n)
       end do
    end do
    do fp = 1,num_soilp
       p = filter_soilp(fp)
       g = pgridcell(p)
       vocflx_1(p) = vocflx(p,1)
       vocflx_2(p) = vocflx(p,2)
       vocflx_3(p) = vocflx(p,3)
       vocflx_4(p) = vocflx(p,4)
       vocflx_5(p) = vocflx(p,5)
    end do

  end subroutine VOCEmission

end module VOCEmissionMod
module dynlandMod

!---------------------------------------------------------------------------
!BOP
!
! !MODULE: dynlandMod
!
! !USES:
   use clmtype
   use decompMod   , only : get_proc_bounds
   use shr_kind_mod, only : r8 => shr_kind_r8
!
! !DESCRIPTION:
! Compute heat and water content to track conservation wrt dynamic land use
!
! !PUBLIC TYPES:
   implicit none
   private
   save
   public :: dynland_hwcontent
!
! !REVISION HISTORY:
!    2009-feb-20 B. Kauffman, created by
!
!EOP
!
! ! PRIVATE TYPES

!===============================================================================

contains
  
!===============================================================================
!BOP
!
! !ROUTINE: dynland_hwcontent
!
! !INTERFACE:

   subroutine dynland_hwcontent(begg,endg,gcell_liq,gcell_ice,gcell_heat)
 
! !DESCRIPTION:
!    Compute grid-level heat and water content
!
! !REVISION HISTORY:
!    2009-feb-20 B. Kauffman, created by
!
! !USES:

   use clm_varcon, only : istsoil,istice,istwet, istdlak,istslak,isturb
#ifdef CROP
   use clm_varcon, only : istcrop
#endif
   use clm_varcon, only : icol_road_perv,icol_road_imperv,icol_roof
   use clm_varcon, only : icol_sunwall,icol_shadewall
   use clm_varcon, only : cpice,  cpliq
   use clm_varpar, only : nlevsno, nlevgrnd

   implicit none

! !ARGUMENTS:

   integer , intent(in)  :: begg, endg              ! proc beg & end gridcell indices
   real(r8), intent(out) :: gcell_liq(begg:endg)
   real(r8), intent(out) :: gcell_ice  (begg:endg)
   real(r8), intent(out) :: gcell_heat (begg:endg)
 
! !LOCAL VARIABLES:
!EOP

   integer  :: li,lf         ! loop initial/final indicies
   integer  :: ci,cf         ! loop initial/final indicies
   integer  :: pi,pf         ! loop initial/final indicies

   integer  :: g,l,c,p,k     ! loop indicies (grid,lunit,column,pft,vertical level)

   real(r8) :: wtgcell       ! weight relative to grid cell
   real(r8) :: wtcol         ! weight relative to column
   real(r8) :: liq           ! sum of liquid water at column level
   real(r8) :: ice           ! sum of frozen water at column level
   real(r8) :: heat          ! sum of heat content at column level
   real(r8) :: cv            ! heat capacity [J/(m^2 K)]

   integer ,pointer :: ltype(:)          ! landunit type index
   integer ,pointer :: ctype(:)          ! column   type index
   integer ,pointer :: ptype(:)          ! pft      type index

   integer,  pointer :: nlev_improad(:)  ! number of impervious road layers
   real(r8), pointer :: cv_wall(:,:)     ! thermal conductivity of urban wall
   real(r8), pointer :: cv_roof(:,:)     ! thermal conductivity of urban roof
   real(r8), pointer :: cv_improad(:,:)  ! thermal conductivity of urban impervious road

   integer , pointer :: snl(:)           ! number of snow layers
   real(r8), pointer :: t_soisno(:,:)    ! soil temperature (Kelvin)
   real(r8), pointer :: h2osno(:)        ! snow water (mm H2O)
   real(r8), pointer :: h2osoi_liq(:,:)  ! liquid water (kg/m2)
   real(r8), pointer :: h2osoi_ice(:,:)  ! frozen water (kg/m2)
   real(r8), pointer :: watsat(:,:)      ! volumetric soil water at saturation (porosity)
   real(r8), pointer :: csol(:,:)        ! heat capacity, soil solids (J/m**3/Kelvin)
   real(r8), pointer :: dz(:,:)          ! layer depth (m)
   real(r8), pointer :: wa(:,:)          ! h2o in underground aquifer

   type(gridcell_type), pointer :: gptr  ! pointer to gridcell derived subtype
   type(landunit_type), pointer :: lptr  ! pointer to landunit derived subtype
   type(column_type)  , pointer :: cptr  ! pointer to column derived subtype
   type(pft_type)     , pointer :: pptr  ! pointer to pft derived subtype

!-------------------------------------------------------------------------------
! Note: this routine does not compute heat or water content of lakes.
!
!-------------------------------------------------------------------------------

   ! Set pointers into derived type

   gptr => clm3%g
   lptr => clm3%g%l
   cptr => clm3%g%l%c
   pptr => clm3%g%l%c%p

   ltype => clm3%g%l%itype
   ctype => clm3%g%l%c%itype
   ptype => clm3%g%l%c%p%itype

   nlev_improad => clm3%g%l%lps%nlev_improad
   cv_wall      => clm3%g%l%lps%cv_wall
   cv_roof      => clm3%g%l%lps%cv_roof
   cv_improad   => clm3%g%l%lps%cv_improad

   snl          => clm3%g%l%c%cps%snl
   watsat       => clm3%g%l%c%cps%watsat
   csol         => clm3%g%l%c%cps%csol
   dz           => clm3%g%l%c%cps%dz
   t_soisno     => clm3%g%l%c%ces%t_soisno
   h2osoi_liq   => clm3%g%l%c%cws%h2osoi_liq
   h2osoi_ice   => clm3%g%l%c%cws%h2osoi_ice
   h2osno       => clm3%g%l%c%cws%h2osno

   ! Get relevant sizes

   do g = begg,endg ! loop over grid cells

      gcell_liq  (g) = 0.0_r8   ! sum for one grid cell
      gcell_ice  (g) = 0.0_r8   ! sum for one grid cell
      gcell_heat (g) = 0.0_r8   ! sum for one grid cell

      li = gptr%luni(g)
      lf = gptr%lunf(g)
      do l = li,lf   ! loop over land units  

         ci = lptr%coli(l)
         cf = lptr%colf(l)
         do c = ci,cf   ! loop over columns

            liq   = 0.0_r8 ! sum for one column
            ice   = 0.0_r8
            heat  = 0.0_r8

            !--- water & ice, above ground only ---
#ifndef CROP
            if ( (ltype(l) == istsoil                                  )  &
#else
            if ( (ltype(l) == istsoil .or. ltype(l) == istcrop         )  &
#endif
            .or. (ltype(l) == istwet                                   )  &
            .or. (ltype(l) == istice                                   )  &
            .or. (ltype(l) == isturb .and. ctype(c) == icol_roof       )  &
            .or. (ltype(l) == isturb .and. ctype(c) == icol_road_imperv)  &
            .or. (ltype(l) == isturb .and. ctype(c) == icol_road_perv  )) then

               if ( snl(c) < 0 ) then
                  do k = snl(c)+1,0 ! loop over snow layers
                     liq   = liq   + clm3%g%l%c%cws%h2osoi_liq(c,k)
                     ice   = ice   + clm3%g%l%c%cws%h2osoi_ice(c,k)
                  end do
               else                 ! no snow layers exist
                  ice = ice + cptr%cws%h2osno(c)
               end if
            end if

            !--- water & ice, below ground only ---
#ifndef CROP
            if ( (ltype(l) == istsoil                                  )  &
#else
            if ( (ltype(l) == istsoil .or. ltype(l) == istcrop         )  &
#endif
            .or. (ltype(l) == istwet                                   )  &
            .or. (ltype(l) == istice                                   )  &
            .or. (ltype(l) == isturb .and. ctype(c) == icol_road_perv  )) then
               do k = 1,nlevgrnd
                  liq   = liq   + cptr%cws%h2osoi_liq(c,k)
                  ice   = ice   + cptr%cws%h2osoi_ice(c,k)
               end do
            end if

            !--- water in aquifer ---
#ifndef CROP
            if ( (ltype(l) == istsoil                                  )  &
#else
            if ( (ltype(l) == istsoil .or. ltype(l) == istcrop         )  &
#endif
            .or. (ltype(l) == istwet                                   )  &
            .or. (ltype(l) == istice                                   )  &
            .or. (ltype(l) == isturb .and. ctype(c) == icol_road_perv  )) then
               liq = liq + cptr%cws%wa(c)
            end if

            !--- water in canopy (at pft level) ---
#ifndef CROP
            if (ltype(l) == istsoil                         ) then
#else
            if (ltype(l) == istsoil .or. ltype(l) == istcrop) then   ! note: soil specified at LU level
#endif
               pi = cptr%pfti(c)
               pf = cptr%pftf(c)
               do p = pi,pf ! loop over pfts
                  wtcol = pptr%wtcol(p)
                  liq = liq + pptr%pws%h2ocan(p) * wtcol
               end do
            end if

            if ( (ltype(l) /= istslak) .and. ltype(l) /= istdlak) then

               !--- heat content, below ground only ---
               do k = 1,nlevgrnd
                  if (ctype(c)==icol_sunwall .OR. ctype(c)==icol_shadewall) then
                      cv = cv_wall(l,k) * dz(c,k)
                   else if (ctype(c) == icol_roof) then
                      cv = cv_roof(l,k) * dz(c,k)
                   else if (ctype(c) == icol_road_imperv .and. k >= 1 .and. k <= nlev_improad(l)) then
                      cv = cv_improad(l,k) * dz(c,k)
                   else if (ltype(l) /= istwet .AND. ltype(l) /= istice) then
                      cv = csol(c,k)*(1-watsat(c,k))*dz(c,k) + (h2osoi_ice(c,k)*cpice + h2osoi_liq(c,k)*cpliq)
                   else
                      cv = (h2osoi_ice(c,k)*cpice + h2osoi_liq(c,k)*cpliq)
                   endif
                   heat = heat + cv*t_soisno(c,k) / 1.e6_r8 
                end do

               !--- heat content, above ground only ---
               if ( snl(c) < 0 ) then
                  do k = snl(c)+1,0 ! loop over snow layers
                     cv = cpliq*h2osoi_liq(c,k) + cpice*h2osoi_ice(c,k)
                     heat = heat + cv*t_soisno(c,k) / 1.e6_r8
                  end do
               else if ( h2osno(c) > 0.0_r8) then
                  k = 1
                  cv = cpice*h2osno(c)
                  heat = heat + cv*t_soisno(c,k) / 1.e6_r8
               end if

            end if

            !--- scale x/m^2 column-level values into x/m^2 gridcell-level values ---
            wtgcell = cptr%wtgcell(c)
            gcell_liq  (g) = gcell_liq  (g) + liq   * wtgcell
            gcell_ice  (g) = gcell_ice  (g) + ice   * wtgcell
            gcell_heat (g) = gcell_heat (g) + heat  * wtgcell

         end do ! column loop      
      end do ! landunit loop
   end do ! grid cell loop

   end subroutine dynland_hwcontent

!===============================================================================

end module dynlandMod

module subgridAveMod

!-----------------------------------------------------------------------
!BOP
!
! !MODULE: subgridAveMod
!
! !DESCRIPTION:
! Utilities to perfrom subgrid averaging
!
! !USES:
  use shr_kind_mod, only: r8 => shr_kind_r8
  use clmtype , only : clm3
  use clm_varcon, only : spval, isturb,  icol_roof, icol_sunwall, icol_shadewall, &
                         icol_road_perv, icol_road_imperv

! !PUBLIC TYPES:
  implicit none
  save
!
! !PUBLIC MEMBER FUNCTIONS:
  public :: p2c   ! Perfrom an average from pfts to columns
  public :: p2l   ! Perfrom an average from pfts to landunits
  public :: p2g   ! Perfrom an average from pfts to gridcells
  public :: c2l   ! Perfrom an average from columns to landunits
  public :: c2g   ! Perfrom an average from columns to gridcells
  public :: l2g   ! Perfrom an average from landunits to gridcells

  interface p2c
     module procedure p2c_1d
     module procedure p2c_2d
     module procedure p2c_1d_filter
     module procedure p2c_2d_filter
  end interface
  interface p2l
     module procedure p2l_1d
     module procedure p2l_2d
  end interface
  interface p2g
     module procedure p2g_1d
     module procedure p2g_2d
  end interface
  interface c2l
     module procedure c2l_1d
     module procedure c2l_2d
  end interface
  interface c2g
     module procedure c2g_1d
     module procedure c2g_2d
  end interface
  interface l2g
     module procedure l2g_1d
     module procedure l2g_2d
  end interface
!
! !REVISION HISTORY:
! Created by Mariana Vertenstein 12/03
!
!EOP
!-----------------------------------------------------------------------

contains

!-----------------------------------------------------------------------
!BOP
!
! !IROUTINE: p2c_1d
!
! !INTERFACE:
  subroutine p2c_1d (lbp, ubp, lbc, ubc, parr, carr, p2c_scale_type)
!
! !DESCRIPTION:
! Perfrom subgrid-average from pfts to columns.
! Averaging is only done for points that are not equal to "spval".
!
! !USES:
    use clm_varpar, only : max_pft_per_col
!
! !ARGUMENTS:
    implicit none
    integer , intent(in)  :: lbp, ubp              ! beginning and ending pft
    integer , intent(in)  :: lbc, ubc              ! beginning and ending column
    real(r8), intent(in)  :: parr(lbp:ubp)         ! pft array
    real(r8), intent(out) :: carr(lbc:ubc)         ! column array
    character(len=*), intent(in) :: p2c_scale_type ! scale type
!
! !REVISION HISTORY:
! Created by Mariana Vertenstein 12/03
!
!
! !LOCAL VARIABLES:
!EOP
    integer  :: pi,p,c,index           ! indices
    real(r8) :: scale_p2c(lbp:ubp)     ! scale factor for column->landunit mapping
    logical  :: found                  ! temporary for error check
    real(r8) :: sumwt(lbc:ubc)         ! sum of weights
    real(r8), pointer :: wtcol(:)      ! weight of pft relative to column
    integer , pointer :: pcolumn(:)    ! column index of corresponding pft
    integer , pointer :: npfts(:)      ! number of pfts in column
    integer , pointer :: pfti(:)       ! initial pft index in column
!------------------------------------------------------------------------

    wtcol    => clm3%g%l%c%p%wtcol
    pcolumn  => clm3%g%l%c%p%column
    npfts    => clm3%g%l%c%npfts
    pfti     => clm3%g%l%c%pfti

    if (p2c_scale_type == 'unity') then
       do p = lbp,ubp
          scale_p2c(p) = 1.0_r8
       end do
    else
       write(6,*)'p2c_1d error: scale type ',p2c_scale_type,' not supported'
       call endrun()
    end if

    carr(lbc:ubc) = spval
    sumwt(lbc:ubc) = 0._r8
#if (defined CPP_VECTOR)
!dir$ nointerchange
    do pi = 1,max_pft_per_col
!dir$ concurrent
!cdir nodep
       do c = lbc,ubc
          if (pi <= npfts(c)) then
             p = pfti(c) + pi - 1
             if (wtcol(p) /= 0._r8) then
                if (parr(p) /= spval) then
                   carr(c) = 0._r8
                end if
             end if
          end if
       end do
    end do
!dir$ nointerchange
    do pi = 1,max_pft_per_col
!dir$ concurrent
!cdir nodep
       do c = lbc,ubc
          if (pi <= npfts(c)) then
             p = pfti(c) + pi - 1
             if (wtcol(p) /= 0._r8) then
                if (parr(p) /= spval) then
                   carr(c) = carr(c) + parr(p) * scale_p2c(p) * wtcol(p)
                   sumwt(c) = sumwt(c) + wtcol(p)
                end if
             end if
          end if
       end do
    end do
#else
    do p = lbp,ubp
       if (wtcol(p) /= 0._r8) then
          if (parr(p) /= spval) then
             c = pcolumn(p)
             if (sumwt(c) == 0._r8) carr(c) = 0._r8
             carr(c) = carr(c) + parr(p) * scale_p2c(p) * wtcol(p)
             sumwt(c) = sumwt(c) + wtcol(p)
          end if
       end if
    end do
#endif
    found = .false.
    do c = lbc,ubc
       if (sumwt(c) > 1.0_r8 + 1.e-6_r8) then
          found = .true.
          index = c
       else if (sumwt(c) /= 0._r8) then
          carr(c) = carr(c)/sumwt(c)
       end if
    end do
    if (found) then
       write(6,*)'p2c error: sumwt is greater than 1.0 at c= ',index
       call endrun()
    end if

  end subroutine p2c_1d

!-----------------------------------------------------------------------
!BOP
!
! !IROUTINE: p2c_2d
!
! !INTERFACE:
  subroutine p2c_2d (lbp, ubp, lbc, ubc, num2d, parr, carr, p2c_scale_type)
!
! !DESCRIPTION:
! Perfrom subgrid-average from landunits to gridcells.
! Averaging is only done for points that are not equal to "spval".
!
! !USES:
    use clm_varpar, only : max_pft_per_col
!
! !ARGUMENTS:
    implicit none
    integer , intent(in)  :: lbp, ubp              ! beginning and ending pft
    integer , intent(in)  :: lbc, ubc              ! beginning and ending column
    integer , intent(in)  :: num2d                 ! size of second dimension
    real(r8), intent(in)  :: parr(lbp:ubp,num2d)   ! pft array
    real(r8), intent(out) :: carr(lbc:ubc,num2d)   ! column array
    character(len=*), intent(in) :: p2c_scale_type ! scale type
!
! !REVISION HISTORY:
! Created by Mariana Vertenstein 12/03
!
!
! !LOCAL VARIABLES:
!EOP
    integer  :: j,pi,p,c,index         ! indices
    real(r8) :: scale_p2c(lbp:ubp)     ! scale factor for column->landunit mapping
    logical  :: found                  ! temporary for error check
    real(r8) :: sumwt(lbc:ubc)         ! sum of weights
    real(r8), pointer :: wtcol(:)      ! weight of pft relative to column
    integer , pointer :: pcolumn(:)    ! column index of corresponding pft
    integer , pointer :: npfts(:)      ! number of pfts in column
    integer , pointer :: pfti(:)       ! initial pft index in column
!------------------------------------------------------------------------

    wtcol    => clm3%g%l%c%p%wtcol
    pcolumn  => clm3%g%l%c%p%column
    npfts    => clm3%g%l%c%npfts
    pfti     => clm3%g%l%c%pfti

    if (p2c_scale_type == 'unity') then
       do p = lbp,ubp
          scale_p2c(p) = 1.0_r8
       end do
    else
       write(6,*)'p2c_2d error: scale type ',p2c_scale_type,' not supported'
       call endrun()
    end if

    carr(:,:) = spval
    do j = 1,num2d
       sumwt(:) = 0._r8
#if (defined CPP_VECTOR)
!dir$ nointerchange
       do pi = 1,max_pft_per_col
!dir$ concurrent
!cdir nodep
          do c = lbc,ubc
             if (pi <= npfts(c)) then
                p = pfti(c) + pi - 1
                if (wtcol(p) /= 0._r8) then
                   if (parr(p,j) /= spval) then
                      carr(c,j) = 0._r8
                   end if
                end if
             end if
          end do
       end do
!dir$ nointerchange
       do pi = 1,max_pft_per_col
!dir$ concurrent
!cdir nodep
          do c = lbc,ubc
             if (pi <= npfts(c)) then
                p = pfti(c) + pi - 1
                if (wtcol(p) /= 0._r8) then
                   if (parr(p,j) /= spval) then
                      carr(c,j) = carr(c,j) + parr(p,j) * scale_p2c(p) * wtcol(p)
                      sumwt(c) = sumwt(c) + wtcol(p)
                   end if
                end if
             end if
          end do
       end do
#else
       do p = lbp,ubp
          if (wtcol(p) /= 0._r8) then
             if (parr(p,j) /= spval) then
                c = pcolumn(p)
                if (sumwt(c) == 0._r8) carr(c,j) = 0._r8
                carr(c,j) = carr(c,j) + parr(p,j) * scale_p2c(p) * wtcol(p)
                sumwt(c) = sumwt(c) + wtcol(p)
             end if
          end if
       end do
#endif
       found = .false.
       do c = lbc,ubc
          if (sumwt(c) > 1.0_r8 + 1.e-6_r8) then
             found = .true.
             index = c
          else if (sumwt(c) /= 0._r8) then
             carr(c,j) = carr(c,j)/sumwt(c)
          end if
       end do
       if (found) then
          write(6,*)'p2c_2d error: sumwt is greater than 1.0 at c= ',index,' lev= ',j
          call endrun()
       end if
    end do 
  end subroutine p2c_2d

!-----------------------------------------------------------------------
!BOP
!
! !IROUTINE: p2c_1d_filter
!
! !INTERFACE:
  subroutine p2c_1d_filter (numfc, filterc, pftarr, colarr)
!
! !DESCRIPTION:
! perform pft to column averaging for single level pft arrays
!
! !USES:
    use clm_varpar, only : max_pft_per_col
!
! !ARGUMENTS:
    implicit none
    integer , intent(in)  :: numfc
    integer , intent(in)  :: filterc(numfc)
    real(r8), pointer     :: pftarr(:)
    real(r8), pointer     :: colarr(:)
!
! !REVISION HISTORY:
! Created by Mariana Vertenstein 12/03
!
!
! !LOCAL VARIABLES:
!EOP
    integer :: fc,c,pi,p           ! indices
    integer , pointer :: npfts(:)
    integer , pointer :: pfti(:)
    integer , pointer :: pftf(:)
    real(r8), pointer :: wtcol(:)
    real(r8), pointer :: wtgcell(:)
!-----------------------------------------------------------------------

    npfts   => clm3%g%l%c%npfts
    pfti    => clm3%g%l%c%pfti
    pftf    => clm3%g%l%c%pftf
    wtcol   => clm3%g%l%c%p%wtcol
    wtgcell => clm3%g%l%c%p%wtgcell

#if (defined CPP_VECTOR)
!dir$ concurrent
!cdir nodep
    do fc = 1,numfc
       c = filterc(fc)
       colarr(c) = 0._r8
    end do
!dir$ nointerchange
    do pi = 1,max_pft_per_col
!dir$ concurrent
!cdir nodep
       do fc = 1,numfc
          c = filterc(fc)
          if ( pi <=  npfts(c) ) then
             p = pfti(c) + pi - 1
             if (wtgcell(p) > 0._r8) colarr(c) = colarr(c) + pftarr(p) * wtcol(p)
          end if
       end do
    end do
#else
    do fc = 1,numfc
       c = filterc(fc)
       colarr(c) = 0._r8
       do p = pfti(c), pftf(c)
          if (wtgcell(p) > 0._r8) colarr(c) = colarr(c) + pftarr(p) * wtcol(p)
       end do
    end do
#endif

  end subroutine p2c_1d_filter

!-----------------------------------------------------------------------
!BOP
!
! !IROUTINE: p2c_2d_filter
!
! !INTERFACE:
  subroutine p2c_2d_filter (lev, numfc, filterc, pftarr, colarr)
!
! !DESCRIPTION:
! perform pft to column averaging for multi level pft arrays
!
! !USES:
    use clm_varpar, only : max_pft_per_col

! !ARGUMENTS:
    implicit none
    integer , intent(in)  :: lev
    integer , intent(in)  :: numfc
    integer , intent(in)  :: filterc(numfc)
    real(r8), pointer     :: pftarr(:,:)
    real(r8), pointer     :: colarr(:,:)
!
! !REVISION HISTORY:
! Created by Mariana Vertenstein 12/03
!
!
! !LOCAL VARIABLES:
!EOP
    integer :: fc,c,pi,p,j    ! indices
    integer , pointer :: npfts(:)
    integer , pointer :: pfti(:)
    integer , pointer :: pftf(:)
    real(r8), pointer :: wtcol(:)
!-----------------------------------------------------------------------

    npfts => clm3%g%l%c%npfts
    pfti  => clm3%g%l%c%pfti
    pftf  => clm3%g%l%c%pftf
    wtcol => clm3%g%l%c%p%wtcol

#if (defined CPP_VECTOR)
    do j = 1,lev
!dir$ concurrent
!cdir nodep
       do fc = 1,numfc
          c = filterc(fc)
          colarr(c,j) = 0._r8
       end do
!dir$ nointerchange
       do pi = 1,max_pft_per_col
!dir$ concurrent
!cdir nodep
          do fc = 1,numfc
             c = filterc(fc)
             if ( pi <=  npfts(c) ) then
                p = pfti(c) + pi - 1
                colarr(c,j) = colarr(c,j) + pftarr(p,j) * wtcol(p)
             end if
          end do
       end do
    end do
#else
    do j = 1,lev
       do fc = 1,numfc
          c = filterc(fc)
          colarr(c,j) = 0._r8
          do p = pfti(c), pftf(c)
             colarr(c,j) = colarr(c,j) + pftarr(p,j) * wtcol(p)
          end do
       end do
    end do
#endif

  end subroutine p2c_2d_filter

!-----------------------------------------------------------------------
!BOP
!
! !IROUTINE: p2l_1d
!
! !INTERFACE:
  subroutine p2l_1d (lbp, ubp, lbc, ubc, lbl, ubl, parr, larr, &
       p2c_scale_type, c2l_scale_type)
!
! !DESCRIPTION:
! Perfrom subgrid-average from pfts to landunits
! Averaging is only done for points that are not equal to "spval".
!
! !USES:
    use clm_varpar, only : max_pft_per_lu
!
! !ARGUMENTS:
    implicit none
    integer , intent(in)  :: lbp, ubp              ! beginning and ending pft indices
    integer , intent(in)  :: lbc, ubc              ! beginning and ending column indices
    integer , intent(in)  :: lbl, ubl              ! beginning and ending landunit indices
    real(r8), intent(in)  :: parr(lbp:ubp)         ! input column array
    real(r8), intent(out) :: larr(lbl:ubl)         ! output landunit array
    character(len=*), intent(in) :: p2c_scale_type ! scale factor type for averaging
    character(len=*), intent(in) :: c2l_scale_type ! scale factor type for averaging
!
! !REVISION HISTORY:
! Created by Mariana Vertenstein 12/03
!
!
! !LOCAL VARIABLES:
!EOP
    integer  :: pi,p,c,l,index         ! indices
    logical  :: found                  ! temporary for error check
    real(r8) :: sumwt(lbl:ubl)         ! sum of weights
    real(r8) :: scale_p2c(lbc:ubc)     ! scale factor for pft->column mapping
    real(r8) :: scale_c2l(lbc:ubc)     ! scale factor for column->landunit mapping
    real(r8), pointer :: wtlunit(:)    ! weight of pft relative to landunit
    integer , pointer :: pcolumn(:)    ! column of corresponding pft
    integer , pointer :: plandunit(:)  ! landunit of corresponding pft
    integer , pointer :: npfts(:)      ! number of pfts in landunit
    integer , pointer :: pfti(:)       ! initial pft index in landunit
    integer , pointer :: clandunit(:)  ! landunit of corresponding column
    integer , pointer :: ctype(:)      ! column type
    integer , pointer :: ltype(:)      ! landunit type
    real(r8), pointer :: canyon_hwr(:) ! urban canyon height to width ratio
!------------------------------------------------------------------------

    canyon_hwr => clm3%g%l%canyon_hwr
    ltype      => clm3%g%l%itype
    ctype      => clm3%g%l%c%itype
    clandunit  => clm3%g%l%c%landunit
    wtlunit    => clm3%g%l%c%p%wtlunit
    pcolumn    => clm3%g%l%c%p%column
    plandunit  => clm3%g%l%c%p%landunit
    npfts      => clm3%g%l%npfts
    pfti       => clm3%g%l%pfti

    if (c2l_scale_type == 'unity') then
       do c = lbc,ubc
          scale_c2l(c) = 1.0_r8
       end do
    else if (c2l_scale_type == 'urbanf') then
       do c = lbc,ubc
          l = clandunit(c) 
          if (ltype(l) == isturb) then
             if (ctype(c) == icol_sunwall) then
                scale_c2l(c) = 3.0 * canyon_hwr(l) 
             else if (ctype(c) == icol_shadewall) then
                scale_c2l(c) = 3.0 * canyon_hwr(l) 
             else if (ctype(c) == icol_road_perv .or. ctype(c) == icol_road_imperv) then
                scale_c2l(c) = 3.0_r8
             else if (ctype(c) == icol_roof) then
                scale_c2l(c) = 1.0_r8
             end if
          else
             scale_c2l(c) = 1.0_r8
          end if
       end do
    else if (c2l_scale_type == 'urbans') then
       do c = lbc,ubc
          l = clandunit(c) 
          if (ltype(l) == isturb) then
             if (ctype(c) == icol_sunwall) then
                scale_c2l(c) = (3.0 * canyon_hwr(l)) / (2.*canyon_hwr(l) + 1.)
             else if (ctype(c) == icol_shadewall) then
                scale_c2l(c) = (3.0 * canyon_hwr(l)) / (2.*canyon_hwr(l) + 1.)
             else if (ctype(c) == icol_road_perv .or. ctype(c) == icol_road_imperv) then
                scale_c2l(c) = 3.0 / (2.*canyon_hwr(l) + 1.)
             else if (ctype(c) == icol_roof) then
                scale_c2l(c) = 1.0_r8
             end if
          else
             scale_c2l(c) = 1.0_r8
          end if
       end do
    else if (c2l_scale_type == 'urbanh') then
       do c = lbc,ubc
          l = clandunit(c) 
          if (ltype(l) == isturb) then
             if (ctype(c) == icol_sunwall) then
                scale_c2l(c) = spval
             else if (ctype(c) == icol_shadewall) then
                scale_c2l(c) = spval
             else if (ctype(c) == icol_road_perv .or. ctype(c) == icol_road_imperv) then
                scale_c2l(c) = spval
             else if (ctype(c) == icol_roof) then
                scale_c2l(c) = spval
             end if
          else
             scale_c2l(c) = 1.0_r8
          end if
       end do
    else
       write(6,*)'p2l_1d error: scale type ',c2l_scale_type,' not supported'
       call endrun()
    end if

    if (p2c_scale_type == 'unity') then
       do p = lbp,ubp
          scale_p2c(p) = 1.0_r8
       end do
    else
       write(6,*)'p2l_1d error: scale type ',p2c_scale_type,' not supported'
       call endrun()
    end if

    larr(:) = spval
    sumwt(:) = 0._r8
#if (defined CPP_VECTOR)
!dir$ nointerchange
    do pi = 1,max_pft_per_lu
!dir$ concurrent
!cdir nodep
       do l = lbl,ubl
          if (pi <= npfts(l)) then
             p = pfti(l) + pi - 1
             if (wtlunit(p) /= 0._r8) then
                if (parr(p) /= spval) then
                   larr(l) = 0._r8
                end if
             end if
          end if
       end do
    end do
!dir$ nointerchange
    do pi = 1,max_pft_per_lu
!dir$ concurrent
!cdir nodep
       do l = lbl,ubl
          if (pi <= npfts(l)) then
             p = pfti(l) + pi - 1
             if (wtlunit(p) /= 0._r8) then
                c = pcolumn(p)
                if (parr(p) /= spval .and. scale_c2l(c) /= spval) then
                   larr(l) = larr(l) + parr(p) * scale_p2c(p) * scale_c2l(c) * wtlunit(p)
                   sumwt(l) = sumwt(l) + wtlunit(p)
                end if
             end if
          end if
       end do
    end do
#else
    do p = lbp,ubp
       if (wtlunit(p) /= 0._r8) then
          c = pcolumn(p)
          if (parr(p) /= spval .and. scale_c2l(c) /= spval) then
             l = plandunit(p)
             if (sumwt(l) == 0._r8) larr(l) = 0._r8
             larr(l) = larr(l) + parr(p) * scale_p2c(p) * scale_c2l(c) * wtlunit(p)
             sumwt(l) = sumwt(l) + wtlunit(p)
          end if
       end if
    end do
#endif
    found = .false.
    do l = lbl,ubl
       if (sumwt(l) > 1.0_r8 + 1.e-6_r8) then
          found = .true.
          index = l
       else if (sumwt(l) /= 0._r8) then
          larr(l) = larr(l)/sumwt(l)
       end if
    end do
    if (found) then
       write(6,*)'p2l_1d error: sumwt is greater than 1.0 at l= ',index
       call endrun()
    end if

  end subroutine p2l_1d

!-----------------------------------------------------------------------
!BOP
!
! !IROUTINE: p2l_2d
!
! !INTERFACE:
  subroutine p2l_2d(lbp, ubp, lbc, ubc, lbl, ubl, num2d, parr, larr, &
       p2c_scale_type, c2l_scale_type)
!
! !DESCRIPTION:
! Perfrom subgrid-average from pfts to landunits
! Averaging is only done for points that are not equal to "spval".
!
! !USES:
    use clm_varpar, only : max_pft_per_lu
!
! !ARGUMENTS:
    implicit none
    integer , intent(in)  :: lbp, ubp              ! beginning and ending pft indices
    integer , intent(in)  :: lbc, ubc              ! beginning and ending column indices
    integer , intent(in)  :: lbl, ubl              ! beginning and ending landunit indices
    integer , intent(in)  :: num2d                 ! size of second dimension
    real(r8), intent(in)  :: parr(lbp:ubp,num2d)   ! input pft array
    real(r8), intent(out) :: larr(lbl:ubl,num2d)   ! output gridcell array
    character(len=*), intent(in) :: p2c_scale_type ! scale factor type for averaging
    character(len=*), intent(in) :: c2l_scale_type ! scale factor type for averaging
!
! !REVISION HISTORY:
! Created by Mariana Vertenstein 12/03
!
!
! !LOCAL VARIABLES:
!EOP
    integer  :: j,pi,p,c,l,index       ! indices
    logical  :: found                  ! temporary for error check
    real(r8) :: sumwt(lbl:ubl)         ! sum of weights
    real(r8) :: scale_p2c(lbc:ubc)     ! scale factor for pft->column mapping
    real(r8) :: scale_c2l(lbc:ubc)     ! scale factor for column->landunit mapping
    real(r8), pointer :: wtlunit(:)    ! weight of pft relative to landunit
    integer , pointer :: pcolumn(:)    ! column of corresponding pft
    integer , pointer :: plandunit(:)  ! landunit of corresponding pft
    integer , pointer :: npfts(:)      ! number of pfts in landunit
    integer , pointer :: pfti(:)       ! initial pft index in landunit
    integer , pointer :: clandunit(:)  ! landunit of corresponding column
    integer , pointer :: ctype(:)      ! column type
    integer , pointer :: ltype(:)      ! landunit type
    real(r8), pointer :: canyon_hwr(:) ! urban canyon height to width ratio
!------------------------------------------------------------------------

    canyon_hwr => clm3%g%l%canyon_hwr
    ltype      => clm3%g%l%itype
    clandunit  => clm3%g%l%c%landunit
    ctype      => clm3%g%l%c%itype
    wtlunit   => clm3%g%l%c%p%wtlunit
    pcolumn   => clm3%g%l%c%p%column
    plandunit => clm3%g%l%c%p%landunit
    npfts     => clm3%g%l%npfts
    pfti      => clm3%g%l%pfti

    if (c2l_scale_type == 'unity') then
       do c = lbc,ubc
          scale_c2l(c) = 1.0_r8
       end do
    else if (c2l_scale_type == 'urbanf') then
       do c = lbc,ubc
          l = clandunit(c) 
          if (ltype(l) == isturb) then
             if (ctype(c) == icol_sunwall) then
                scale_c2l(c) = 3.0 * canyon_hwr(l) 
             else if (ctype(c) == icol_shadewall) then
                scale_c2l(c) = 3.0 * canyon_hwr(l) 
             else if (ctype(c) == icol_road_perv .or. ctype(c) == icol_road_imperv) then
                scale_c2l(c) = 3.0_r8
             else if (ctype(c) == icol_roof) then
                scale_c2l(c) = 1.0_r8
             end if
          else
             scale_c2l(c) = 1.0_r8
          end if
       end do
    else if (c2l_scale_type == 'urbans') then
       do c = lbc,ubc
          l = clandunit(c) 
          if (ltype(l) == isturb) then
             if (ctype(c) == icol_sunwall) then
                scale_c2l(c) = (3.0 * canyon_hwr(l)) / (2.*canyon_hwr(l) + 1.)
             else if (ctype(c) == icol_shadewall) then
                scale_c2l(c) = (3.0 * canyon_hwr(l)) / (2.*canyon_hwr(l) + 1.)
             else if (ctype(c) == icol_road_perv .or. ctype(c) == icol_road_imperv) then
                scale_c2l(c) = 3.0 / (2.*canyon_hwr(l) + 1.)
             else if (ctype(c) == icol_roof) then
                scale_c2l(c) = 1.0_r8
             end if
          else
             scale_c2l(c) = 1.0_r8
          end if
       end do
    else if (c2l_scale_type == 'urbanh') then
       do c = lbc,ubc
          l = clandunit(c) 
          if (ltype(l) == isturb) then
             if (ctype(c) == icol_sunwall) then
                scale_c2l(c) = spval
             else if (ctype(c) == icol_shadewall) then
                scale_c2l(c) = spval
             else if (ctype(c) == icol_road_perv .or. ctype(c) == icol_road_imperv) then
                scale_c2l(c) = spval
             else if (ctype(c) == icol_roof) then
                scale_c2l(c) = spval
             end if
          else
             scale_c2l(c) = 1.0_r8
          end if
       end do
    else
       write(6,*)'p2l_2d error: scale type ',c2l_scale_type,' not supported'
       call endrun()
    end if

    if (p2c_scale_type == 'unity') then
       do p = lbp,ubp
          scale_p2c(p) = 1.0_r8
       end do
    else
       write(6,*)'p2l_2d error: scale type ',p2c_scale_type,' not supported'
       call endrun()
    end if

    larr(:,:) = spval
    do j = 1,num2d
       sumwt(:) = 0._r8
#if (defined CPP_VECTOR)
!dir$ nointerchange
       do pi = 1,max_pft_per_lu
!dir$ concurrent
!cdir nodep
          do l = lbl,ubl
             if (pi <= npfts(l)) then
                p = pfti(l) + pi - 1
                if (wtlunit(p) /= 0._r8) then
                   if (parr(p,j) /= spval) then
                      larr(l,j) = 0._r8
                   end if
                end if
             end if
          end do
       end do
!dir$ nointerchange
       do pi = 1,max_pft_per_lu
!dir$ concurrent
!cdir nodep
          do l = lbl,ubl
             if (pi <= npfts(l)) then
                p = pfti(l) + pi - 1
                if (wtlunit(p) /= 0._r8) then
                   c = pcolumn(p)
                   if (parr(p,j) /= spval .and. scale_c2l(c) /= spval) then
                      larr(l,j) = larr(l,j) + parr(p,j) * scale_p2c(p) * scale_c2l(c) * wtlunit(p)
                      sumwt(l) = sumwt(l) + wtlunit(p)
                   end if
                end if
             end if
          end do
       end do
#else
       do p = lbp,ubp
          if (wtlunit(p) /= 0._r8) then
             c = pcolumn(p)
             if (parr(p,j) /= spval .and. scale_c2l(c) /= spval) then
                l = plandunit(p)
                if (sumwt(l) == 0._r8) larr(l,j) = 0._r8
                larr(l,j) = larr(l,j) + parr(p,j) * scale_p2c(p) * scale_c2l(c) * wtlunit(p)
                sumwt(l) = sumwt(l) + wtlunit(p)
             end if
          end if
       end do
#endif
       found = .false.
       do l = lbl,ubl
          if (sumwt(l) > 1.0_r8 + 1.e-6_r8) then
             found = .true.
             index = l
          else if (sumwt(l) /= 0._r8) then
             larr(l,j) = larr(l,j)/sumwt(l)
          end if
       end do
       if (found) then
          write(6,*)'p2l_2d error: sumwt is greater than 1.0 at l= ',index,' j= ',j
          call endrun()
       end if
    end do

  end subroutine p2l_2d

!-----------------------------------------------------------------------
!BOP
!
! !IROUTINE: p2g_1d
!
! !INTERFACE:
  subroutine p2g_1d(lbp, ubp, lbc, ubc, lbl, ubl, lbg, ubg, parr, garr, &
       p2c_scale_type, c2l_scale_type, l2g_scale_type)
!
! !DESCRIPTION:
! Perfrom subgrid-average from pfts to gridcells.
! Averaging is only done for points that are not equal to "spval".
!
! !USES:
    use clm_varpar, only : max_pft_per_gcell
!
! !ARGUMENTS:
    implicit none
    integer , intent(in)  :: lbp, ubp            ! beginning and ending pft indices
    integer , intent(in)  :: lbc, ubc            ! beginning and ending column indices
    integer , intent(in)  :: lbl, ubl            ! beginning and ending landunit indices
    integer , intent(in)  :: lbg, ubg            ! beginning and ending gridcell indices
    real(r8), intent(in)  :: parr(lbp:ubp)       ! input pft array
    real(r8), intent(out) :: garr(lbg:ubg)       ! output gridcell array
    character(len=*), intent(in) :: p2c_scale_type ! scale factor type for averaging
    character(len=*), intent(in) :: c2l_scale_type ! scale factor type for averaging
    character(len=*), intent(in) :: l2g_scale_type ! scale factor type for averaging
!
! !REVISION HISTORY:
! Created by Mariana Vertenstein 12/03
!
!  !LOCAL VARIABLES:
!EOP
    integer  :: pi,p,c,l,g,index       ! indices
    logical  :: found                  ! temporary for error check
    real(r8) :: scale_p2c(lbp:ubp)     ! scale factor
    real(r8) :: scale_c2l(lbc:ubc)     ! scale factor
    real(r8) :: scale_l2g(lbl:ubl)     ! scale factor
    real(r8) :: sumwt(lbg:ubg)         ! sum of weights
    real(r8), pointer :: wtgcell(:)    ! weight of pfts relative to gridcells
    integer , pointer :: pcolumn(:)    ! column of corresponding pft
    integer , pointer :: plandunit(:)  ! landunit of corresponding pft
    integer , pointer :: pgridcell(:)  ! gridcell of corresponding pft
    integer , pointer :: npfts(:)      ! number of pfts in gridcell
    integer , pointer :: pfti(:)       ! initial pft index in gridcell
    integer , pointer :: ctype(:)      ! column type
    integer , pointer :: clandunit(:)  ! landunit of corresponding column
    integer , pointer :: ltype(:)      ! landunit type
    real(r8), pointer :: canyon_hwr(:) ! urban canyon height to width ratio
!------------------------------------------------------------------------

    canyon_hwr => clm3%g%l%canyon_hwr
    ltype      => clm3%g%l%itype
    clandunit  => clm3%g%l%c%landunit
    ctype      => clm3%g%l%c%itype
    wtgcell   => clm3%g%l%c%p%wtgcell
    pcolumn   => clm3%g%l%c%p%column
    pgridcell => clm3%g%l%c%p%gridcell
    plandunit => clm3%g%l%c%p%landunit
    npfts     => clm3%g%npfts
    pfti      => clm3%g%pfti

    if (l2g_scale_type == 'unity') then
       do l = lbl,ubl
          scale_l2g(l) = 1.0_r8
       end do
    else
       write(6,*)'p2g_1d error: scale type ',l2g_scale_type,' not supported'
       call endrun()
    end if

    if (c2l_scale_type == 'unity') then
       do c = lbc,ubc
          scale_c2l(c) = 1.0_r8
       end do
    else if (c2l_scale_type == 'urbanf') then
       do c = lbc,ubc
          l = clandunit(c) 
          if (ltype(l) == isturb) then
             if (ctype(c) == icol_sunwall) then
                scale_c2l(c) = 3.0 * canyon_hwr(l) 
             else if (ctype(c) == icol_shadewall) then
                scale_c2l(c) = 3.0 * canyon_hwr(l) 
             else if (ctype(c) == icol_road_perv .or. ctype(c) == icol_road_imperv) then
                scale_c2l(c) = 3.0_r8
             else if (ctype(c) == icol_roof) then
                scale_c2l(c) = 1.0_r8
             end if
          else
             scale_c2l(c) = 1.0_r8
          end if
       end do
    else if (c2l_scale_type == 'urbans') then
       do c = lbc,ubc
          l = clandunit(c) 
          if (ltype(l) == isturb) then
             if (ctype(c) == icol_sunwall) then
                scale_c2l(c) = (3.0 * canyon_hwr(l)) / (2.*canyon_hwr(l) + 1.)
             else if (ctype(c) == icol_shadewall) then
                scale_c2l(c) = (3.0 * canyon_hwr(l)) / (2.*canyon_hwr(l) + 1.)
             else if (ctype(c) == icol_road_perv .or. ctype(c) == icol_road_imperv) then
                scale_c2l(c) = 3.0 / (2.*canyon_hwr(l) + 1.)
             else if (ctype(c) == icol_roof) then
                scale_c2l(c) = 1.0_r8
             end if
          else
             scale_c2l(c) = 1.0_r8
          end if
       end do
    else if (c2l_scale_type == 'urbanh') then
       do c = lbc,ubc
          l = clandunit(c) 
          if (ltype(l) == isturb) then
             if (ctype(c) == icol_sunwall) then
                scale_c2l(c) = spval
             else if (ctype(c) == icol_shadewall) then
                scale_c2l(c) = spval
             else if (ctype(c) == icol_road_perv .or. ctype(c) == icol_road_imperv) then
                scale_c2l(c) = spval
             else if (ctype(c) == icol_roof) then
                scale_c2l(c) = spval
             end if
          else
             scale_c2l(c) = 1.0_r8
          end if
       end do
    else
       write(6,*)'p2g_1d error: scale type ',c2l_scale_type,' not supported'
       call endrun()
    end if

    if (p2c_scale_type == 'unity') then
       do p = lbp,ubp
          scale_p2c(p) = 1.0_r8
       end do
    else
       write(6,*)'p2g_1d error: scale type ',c2l_scale_type,' not supported'
       call endrun()
    end if

    garr(:) = spval
    sumwt(:) = 0._r8
#if (defined CPP_VECTOR)
!dir$ nointerchange
    do pi = 1,max_pft_per_gcell
!dir$ concurrent
!cdir nodep
       do g = lbg,ubg
          if (pi <= npfts(g)) then
             p = pfti(g) + pi - 1
             if (wtgcell(p) /= 0._r8) then
                if (parr(p) /= spval) then
                   garr(g) = 0._r8
                end if
             end if
          end if
       end do
    end do
!dir$ nointerchange
    do pi = 1,max_pft_per_gcell
!dir$ concurrent
!cdir nodep
       do g = lbg,ubg
          if (pi <= npfts(g)) then
             p = pfti(g) + pi - 1
             if (wtgcell(p) /= 0._r8) then
                c = pcolumn(p)
                if (parr(p) /= spval .and. scale_c2l(c) /= spval) then
                   l = plandunit(p)
                   garr(g) = garr(g) + parr(p) * scale_p2c(p) * scale_c2l(c) * scale_l2g(l) * wtgcell(p)
                   sumwt(g) = sumwt(g) + wtgcell(p)
                end if
             end if
          end if
       end do
    end do
#else
    do p = lbp,ubp
       if (wtgcell(p) /= 0._r8) then
          c = pcolumn(p)
          if (parr(p) /= spval .and. scale_c2l(c) /= spval) then
             l = plandunit(p)
             g = pgridcell(p)
             if (sumwt(g) == 0._r8) garr(g) = 0._r8
             garr(g) = garr(g) + parr(p) * scale_p2c(p) * scale_c2l(c) * scale_l2g(l) * wtgcell(p)
             sumwt(g) = sumwt(g) + wtgcell(p)
          end if
       end if
    end do
#endif
    found = .false.
    do g = lbg, ubg
       if (sumwt(g) > 1.0_r8 + 1.e-6_r8) then
          found = .true.
          index = g
       else if (sumwt(g) /= 0._r8) then
          garr(g) = garr(g)/sumwt(g)
       end if
    end do
    if (found) then
       write(6,*)'p2g_1d error: sumwt is greater than 1.0 at g= ',index
       call endrun()
    end if

  end subroutine p2g_1d

!-----------------------------------------------------------------------
!BOP
!
! !IROUTINE: p2g_2d
!
! !INTERFACE:
  subroutine p2g_2d(lbp, ubp, lbc, ubc, lbl, ubl, lbg, ubg, num2d, &
       parr, garr, p2c_scale_type, c2l_scale_type, l2g_scale_type)
!
! !DESCRIPTION:
! Perfrom subgrid-average from pfts to gridcells.
! Averaging is only done for points that are not equal to "spval".
!
! !USES:
    use clm_varpar, only : max_pft_per_gcell
!
! !ARGUMENTS:
    implicit none
    integer , intent(in)  :: lbp, ubp              ! beginning and ending pft indices
    integer , intent(in)  :: lbc, ubc              ! beginning and ending column indices
    integer , intent(in)  :: lbl, ubl              ! beginning and ending landunit indices
    integer , intent(in)  :: lbg, ubg              ! beginning and ending gridcell indices
    integer , intent(in)  :: num2d                 ! size of second dimension
    real(r8), intent(in)  :: parr(lbp:ubp,num2d)   ! input pft array
    real(r8), intent(out) :: garr(lbg:ubg,num2d)   ! output gridcell array
    character(len=*), intent(in) :: p2c_scale_type ! scale factor type for averaging
    character(len=*), intent(in) :: c2l_scale_type ! scale factor type for averaging
    character(len=*), intent(in) :: l2g_scale_type ! scale factor type for averaging
!
! !REVISION HISTORY:
! Created by Mariana Vertenstein 12/03
!
!
! !LOCAL VARIABLES:
!EOP
    integer  :: j,pi,p,c,l,g,index     ! indices
    logical  :: found                  ! temporary for error check
    real(r8) :: scale_p2c(lbp:ubp)     ! scale factor
    real(r8) :: scale_c2l(lbc:ubc)     ! scale factor
    real(r8) :: scale_l2g(lbl:ubl)     ! scale factor
    real(r8) :: sumwt(lbg:ubg)         ! sum of weights
    real(r8), pointer :: wtgcell(:)    ! weight of pfts relative to gridcells
    integer , pointer :: pcolumn(:)    ! column of corresponding pft
    integer , pointer :: plandunit(:)  ! landunit of corresponding pft
    integer , pointer :: pgridcell(:)  ! gridcell of corresponding pft
    integer , pointer :: npfts(:)      ! number of pfts in gridcell
    integer , pointer :: pfti(:)       ! initial pft index in gridcell
    integer , pointer :: clandunit(:)  ! landunit of corresponding column
    integer , pointer :: ctype(:)      ! column type
    integer , pointer :: ltype(:)      ! landunit type
    real(r8), pointer :: canyon_hwr(:) ! urban canyon height to width ratio
!------------------------------------------------------------------------

    canyon_hwr   => clm3%g%l%canyon_hwr
    ltype        => clm3%g%l%itype
    clandunit    => clm3%g%l%c%landunit
    ctype        => clm3%g%l%c%itype
    wtgcell      => clm3%g%l%c%p%wtgcell
    pcolumn      => clm3%g%l%c%p%column
    pgridcell    => clm3%g%l%c%p%gridcell
    plandunit    => clm3%g%l%c%p%landunit
    npfts        => clm3%g%npfts
    pfti         => clm3%g%pfti

    if (l2g_scale_type == 'unity') then
       do l = lbl,ubl
          scale_l2g(l) = 1.0_r8
       end do
    else
       write(6,*)'p2g_2d error: scale type ',l2g_scale_type,' not supported'
       call endrun()
    end if

    if (c2l_scale_type == 'unity') then
       do c = lbc,ubc
          scale_c2l(c) = 1.0_r8
       end do
    else if (c2l_scale_type == 'urbanf') then
       do c = lbc,ubc
          l = clandunit(c) 
          if (ltype(l) == isturb) then
             if (ctype(c) == icol_sunwall) then
                scale_c2l(c) = 3.0 * canyon_hwr(l) 
             else if (ctype(c) == icol_shadewall) then
                scale_c2l(c) = 3.0 * canyon_hwr(l) 
             else if (ctype(c) == icol_road_perv .or. ctype(c) == icol_road_imperv) then
                scale_c2l(c) = 3.0_r8
             else if (ctype(c) == icol_roof) then
                scale_c2l(c) = 1.0_r8
             end if
          else
             scale_c2l(c) = 1.0_r8
          end if
       end do
    else if (c2l_scale_type == 'urbans') then
       do c = lbc,ubc
          l = clandunit(c) 
          if (ltype(l) == isturb) then
             if (ctype(c) == icol_sunwall) then
                scale_c2l(c) = (3.0 * canyon_hwr(l)) / (2.*canyon_hwr(l) + 1.)
             else if (ctype(c) == icol_shadewall) then
                scale_c2l(c) = (3.0 * canyon_hwr(l)) / (2.*canyon_hwr(l) + 1.)
             else if (ctype(c) == icol_road_perv .or. ctype(c) == icol_road_imperv) then
                scale_c2l(c) = 3.0 / (2.*canyon_hwr(l) + 1.)
             else if (ctype(c) == icol_roof) then
                scale_c2l(c) = 1.0_r8
             end if
          else
             scale_c2l(c) = 1.0_r8
          end if
       end do
    else if (c2l_scale_type == 'urbanh') then
       do c = lbc,ubc
          l = clandunit(c) 
          if (ltype(l) == isturb) then
             if (ctype(c) == icol_sunwall) then
                scale_c2l(c) = spval 
             else if (ctype(c) == icol_shadewall) then
                scale_c2l(c) = spval
             else if (ctype(c) == icol_road_perv .or. ctype(c) == icol_road_imperv) then
                scale_c2l(c) = spval
             else if (ctype(c) == icol_roof) then
                scale_c2l(c) = spval 
             end if
          else
             scale_c2l(c) = 1.0_r8
          end if
       end do
    else
       write(6,*)'p2g_2d error: scale type ',c2l_scale_type,' not supported'
       call endrun()
    end if

    if (p2c_scale_type == 'unity') then
       do p = lbp,ubp
          scale_p2c(p) = 1.0_r8
       end do
    else
       write(6,*)'p2g_2d error: scale type ',c2l_scale_type,' not supported'
       call endrun()
    end if

    garr(:,:) = spval
    do j = 1,num2d
       sumwt(:) = 0._r8
#if (defined CPP_VECTOR)
!dir$ nointerchange
       do pi = 1,max_pft_per_gcell
!dir$ concurrent
!cdir nodep
          do g = lbg,ubg
             if (pi <= npfts(g)) then
                p = pfti(g) + pi - 1
                if (wtgcell(p) /= 0._r8) then
                   if (parr(p,j) /= spval) then
                      garr(g,j) = 0._r8
                   end if
                end if
             end if
          end do
       end do
!dir$ nointerchange
       do pi = 1,max_pft_per_gcell
!dir$ concurrent
!cdir nodep
          do g = lbg,ubg
             if (pi <= npfts(g)) then
                p = pfti(g) + pi - 1
                if (wtgcell(p) /= 0._r8) then
                   c = pcolumn(p)
                   if (parr(p,j) /= spval .and. scale_c2l(c) /= spval) then
                      l = plandunit(p)
                      garr(g,j) = garr(g,j) + parr(p,j) * scale_p2c(p) * scale_c2l(c) * scale_l2g(l) * wtgcell(p)
                      sumwt(g) = sumwt(g) + wtgcell(p)
                   end if
                end if
             end if
          end do
       end do
#else
       do p = lbp,ubp
          if (wtgcell(p) /= 0._r8) then
             c = pcolumn(p)
             if (parr(p,j) /= spval .and. scale_c2l(c) /= spval) then
                l = plandunit(p)
                g = pgridcell(p)
                if (sumwt(g) == 0._r8) garr(g,j) = 0._r8
                garr(g,j) = garr(g,j) + parr(p,j) * scale_p2c(p) * scale_c2l(c) * scale_l2g(l) * wtgcell(p)
                sumwt(g) = sumwt(g) + wtgcell(p)
             end if
          end if
       end do
#endif
       found = .false.
       do g = lbg, ubg
          if (sumwt(g) > 1.0_r8 + 1.e-6_r8) then
             found = .true.
             index = g
          else if (sumwt(g) /= 0._r8) then
             garr(g,j) = garr(g,j)/sumwt(g)
          end if
       end do
       if (found) then
          write(6,*)'p2g_2d error: sumwt gt 1.0 at g/sumwt = ',index,sumwt(index)
          call endrun()
       end if
    end do

  end subroutine p2g_2d

!-----------------------------------------------------------------------
!BOP
!
! !IROUTINE: c2l_1d
!
! !INTERFACE:
  subroutine c2l_1d (lbc, ubc, lbl, ubl, carr, larr, c2l_scale_type)
!
! !DESCRIPTION:
! Perfrom subgrid-average from columns to landunits
! Averaging is only done for points that are not equal to "spval".
!
! !ARGUMENTS:
    implicit none
    integer , intent(in)  :: lbc, ubc      ! beginning and ending column indices
    integer , intent(in)  :: lbl, ubl      ! beginning and ending landunit indices
    real(r8), intent(in)  :: carr(lbc:ubc) ! input column array
    real(r8), intent(out) :: larr(lbl:ubl) ! output landunit array
    character(len=*), intent(in) :: c2l_scale_type ! scale factor type for averaging
!
! !REVISION HISTORY:
! Created by Mariana Vertenstein 12/03
!
!
! !LOCAL VARIABLES:
!EOP
    integer  :: ci,c,l,index           ! indices
    integer  :: max_col_per_lu         ! max columns per landunit; on the fly
    logical  :: found                  ! temporary for error check
    real(r8) :: scale_c2l(lbc:ubc)     ! scale factor for column->landunit mapping
    real(r8) :: sumwt(lbl:ubl)         ! sum of weights
    real(r8), pointer :: wtlunit(:)    ! weight of landunits relative to gridcells
    integer , pointer :: clandunit(:)  ! gridcell of corresponding column
    integer , pointer :: ncolumns(:)   ! number of columns in landunit
    integer , pointer :: coli(:)       ! initial column index in landunit
    integer , pointer :: ctype(:)      ! column type
    integer , pointer :: ltype(:)      ! landunit type
    real(r8), pointer :: canyon_hwr(:) ! urban canyon height to width ratio
!------------------------------------------------------------------------

    ctype      => clm3%g%l%c%itype
    ltype      => clm3%g%l%itype
    canyon_hwr => clm3%g%l%canyon_hwr
    wtlunit    => clm3%g%l%c%wtlunit
    clandunit  => clm3%g%l%c%landunit
    ncolumns   => clm3%g%l%ncolumns
    coli       => clm3%g%l%coli

    if (c2l_scale_type == 'unity') then
       do c = lbc,ubc
          scale_c2l(c) = 1.0_r8
       end do
    else if (c2l_scale_type == 'urbanf') then
       do c = lbc,ubc
          l = clandunit(c) 
          if (ltype(l) == isturb) then
             if (ctype(c) == icol_sunwall) then
                scale_c2l(c) = 3.0 * canyon_hwr(l) 
             else if (ctype(c) == icol_shadewall) then
                scale_c2l(c) = 3.0 * canyon_hwr(l) 
             else if (ctype(c) == icol_road_perv .or. ctype(c) == icol_road_imperv) then
                scale_c2l(c) = 3.0_r8
             else if (ctype(c) == icol_roof) then
                scale_c2l(c) = 1.0_r8
             end if
          else
             scale_c2l(c) = 1.0_r8
          end if
       end do
    else if (c2l_scale_type == 'urbans') then
       do c = lbc,ubc
          l = clandunit(c) 
          if (ltype(l) == isturb) then
             if (ctype(c) == icol_sunwall) then
                scale_c2l(c) = (3.0 * canyon_hwr(l)) / (2.*canyon_hwr(l) + 1.)
             else if (ctype(c) == icol_shadewall) then
                scale_c2l(c) = (3.0 * canyon_hwr(l)) / (2.*canyon_hwr(l) + 1.)
             else if (ctype(c) == icol_road_perv .or. ctype(c) == icol_road_imperv) then
                scale_c2l(c) = 3.0 / (2.*canyon_hwr(l) + 1.)
             else if (ctype(c) == icol_roof) then
                scale_c2l(c) = 1.0_r8
             end if
          else
             scale_c2l(c) = 1.0_r8
          end if
       end do
    else if (c2l_scale_type == 'urbanh') then
       do c = lbc,ubc
          l = clandunit(c) 
          if (ltype(l) == isturb) then
             if (ctype(c) == icol_sunwall) then
                scale_c2l(c) = spval
             else if (ctype(c) == icol_shadewall) then
                scale_c2l(c) = spval
             else if (ctype(c) == icol_road_perv .or. ctype(c) == icol_road_imperv) then
                scale_c2l(c) = spval
             else if (ctype(c) == icol_roof) then
                scale_c2l(c) = spval
             end if
          else
             scale_c2l(c) = 1.0_r8
          end if
       end do
    else
       write(6,*)'c2l_1d error: scale type ',c2l_scale_type,' not supported'
       call endrun()
    end if

    larr(:) = spval
    sumwt(:) = 0._r8
#if (defined CPP_VECTOR)
    max_col_per_lu = 0
    do l = lbl,ubl
       max_col_per_lu = max(ncolumns(l), max_col_per_lu)
    end do
!dir$ nointerchange
    do ci = 1,max_col_per_lu
!dir$ concurrent
!cdir nodep
       do l = lbl,ubl
          if (ci <= ncolumns(l)) then
             c = coli(l) + ci - 1
             if (wtlunit(c) /= 0._r8) then
                if (carr(c) /= spval) then
                   larr(l) = 0._r8
                end if
             end if
          end if
       end do
    end do
!dir$ nointerchange
    do ci = 1,max_col_per_lu
!dir$ concurrent
!cdir nodep
       do l = lbl,ubl
          if (ci <= ncolumns(l)) then
             c = coli(l) + ci - 1
             if (wtlunit(c) /= 0._r8) then
                if (carr(c) /= spval .and. scale_c2l(c) /= spval) then
                   larr(l) = larr(l) + carr(c) * scale_c2l(c) * wtlunit(c)
                   sumwt(l) = sumwt(l) + wtlunit(c)
                end if
             end if
          end if
      end do
    end do
#else
    do c = lbc,ubc
       if (wtlunit(c) /= 0._r8) then
          if (carr(c) /= spval .and. scale_c2l(c) /= spval) then
             l = clandunit(c)
             if (sumwt(l) == 0._r8) larr(l) = 0._r8
             larr(l) = larr(l) + carr(c) * scale_c2l(c) * wtlunit(c)
             sumwt(l) = sumwt(l) + wtlunit(c)
          end if
       end if
    end do
#endif
    found = .false.
    do l = lbl,ubl
       if (sumwt(l) > 1.0_r8 + 1.e-6_r8) then
          found = .true.
          index = l
       else if (sumwt(l) /= 0._r8) then
          larr(l) = larr(l)/sumwt(l)
       end if
    end do
    if (found) then
       write(6,*)'c2l_1d error: sumwt is greater than 1.0 at l= ',index
       call endrun()
    end if

  end subroutine c2l_1d

!-----------------------------------------------------------------------
!BOP
!
! !IROUTINE: c2l_2d
!
! !INTERFACE:
  subroutine c2l_2d (lbc, ubc, lbl, ubl, num2d, carr, larr, c2l_scale_type)
!
! !DESCRIPTION:
! Perfrom subgrid-average from columns to landunits
! Averaging is only done for points that are not equal to "spval".
!
! !ARGUMENTS:
    implicit none
    integer , intent(in)  :: lbc, ubc            ! beginning and ending column indices
    integer , intent(in)  :: lbl, ubl            ! beginning and ending landunit indices
    integer , intent(in)  :: num2d               ! size of second dimension
    real(r8), intent(in)  :: carr(lbc:ubc,num2d) ! input column array
    real(r8), intent(out) :: larr(lbl:ubl,num2d) ! output landunit array
    character(len=*), intent(in) :: c2l_scale_type ! scale factor type for averaging
!
! !REVISION HISTORY:
! Created by Mariana Vertenstein 12/03
!
!
! !LOCAL VARIABLES:
!EOP
    integer  :: j,l,ci,c,index         ! indices
    integer  :: max_col_per_lu         ! max columns per landunit; on the fly
    logical  :: found                  ! temporary for error check
    real(r8) :: scale_c2l(lbc:ubc)        ! scale factor for column->landunit mapping
    real(r8) :: sumwt(lbl:ubl)         ! sum of weights
    real(r8), pointer :: wtlunit(:)    ! weight of column relative to landunit
    integer , pointer :: clandunit(:)  ! landunit of corresponding column
    integer , pointer :: ncolumns(:)   ! number of columns in landunit
    integer , pointer :: coli(:)       ! initial column index in landunit
    integer , pointer :: ctype(:)      ! column type
    integer , pointer :: ltype(:)      ! landunit type
    real(r8), pointer :: canyon_hwr(:) ! urban canyon height to width ratio
!------------------------------------------------------------------------

    ctype      => clm3%g%l%c%itype
    ltype      => clm3%g%l%itype
    canyon_hwr => clm3%g%l%canyon_hwr
    wtlunit    => clm3%g%l%c%wtlunit
    clandunit  => clm3%g%l%c%landunit
    ncolumns   => clm3%g%l%ncolumns
    coli       => clm3%g%l%coli

    if (c2l_scale_type == 'unity') then
       do c = lbc,ubc
          scale_c2l(c) = 1.0_r8
       end do
    else if (c2l_scale_type == 'urbanf') then
       do c = lbc,ubc
          l = clandunit(c) 
          if (ltype(l) == isturb) then
             if (ctype(c) == icol_sunwall) then
                scale_c2l(c) = 3.0 * canyon_hwr(l) 
             else if (ctype(c) == icol_shadewall) then
                scale_c2l(c) = 3.0 * canyon_hwr(l) 
             else if (ctype(c) == icol_road_perv .or. ctype(c) == icol_road_imperv) then
                scale_c2l(c) = 3.0_r8
             else if (ctype(c) == icol_roof) then
                scale_c2l(c) = 1.0_r8
             end if
          else
             scale_c2l(c) = 1.0_r8
          end if
       end do
    else if (c2l_scale_type == 'urbans') then
       do c = lbc,ubc
          l = clandunit(c) 
          if (ltype(l) == isturb) then
             if (ctype(c) == icol_sunwall) then
                scale_c2l(c) = (3.0 * canyon_hwr(l)) / (2.*canyon_hwr(l) + 1.)
             else if (ctype(c) == icol_shadewall) then
                scale_c2l(c) = (3.0 * canyon_hwr(l)) / (2.*canyon_hwr(l) + 1.)
             else if (ctype(c) == icol_road_perv .or. ctype(c) == icol_road_imperv) then
                scale_c2l(c) = 3.0 / (2.*canyon_hwr(l) + 1.)
             else if (ctype(c) == icol_roof) then
                scale_c2l(c) = 1.0_r8
             end if
          else
             scale_c2l(c) = 1.0_r8
          end if
       end do
    else if (c2l_scale_type == 'urbanh') then
       do c = lbc,ubc
          l = clandunit(c) 
          if (ltype(l) == isturb) then
             if (ctype(c) == icol_sunwall) then
                scale_c2l(c) = spval
             else if (ctype(c) == icol_shadewall) then
                scale_c2l(c) = spval
             else if (ctype(c) == icol_road_perv .or. ctype(c) == icol_road_imperv) then
                scale_c2l(c) = spval
             else if (ctype(c) == icol_roof) then
                scale_c2l(c) = spval
             end if
          else
             scale_c2l(c) = 1.0_r8
          end if
       end do
    else
       write(6,*)'c2l_2d error: scale type ',c2l_scale_type,' not supported'
       call endrun()
    end if

#if (defined CPP_VECTOR)
    max_col_per_lu = 0
    do l = lbl,ubl
       max_col_per_lu = max(ncolumns(l), max_col_per_lu)
    end do
#endif

    larr(:,:) = spval
    do j = 1,num2d
       sumwt(:) = 0._r8
#if (defined CPP_VECTOR)
!dir$ nointerchange
       do ci = 1,max_col_per_lu
!dir$ concurrent
!cdir nodep
          do l = lbl,ubl
             if (ci <= ncolumns(l)) then
                c = coli(l) + ci - 1
                if (wtlunit(c) /= 0._r8) then
                   if (carr(c,j) /= spval) then
                      larr(l,j) = 0._r8
                   end if
                end if
             end if
          end do
       end do
!dir$ nointerchange
       do ci = 1,max_col_per_lu
!dir$ concurrent
!cdir nodep
          do l = lbl,ubl
             if (ci <= ncolumns(l)) then
                c = coli(l) + ci - 1
                if (wtlunit(c) /= 0._r8) then
                   if (carr(c,j) /= spval .and. scale_c2l(c) /= spval) then
                      larr(l,j) = larr(l,j) + carr(c,j) * scale_c2l(c) * wtlunit(c)
                      sumwt(l) = sumwt(l) + wtlunit(c)
                   end if
                end if
             end if
          end do
       end do
#else
       do c = lbc,ubc
          if (wtlunit(c) /= 0._r8) then
             if (carr(c,j) /= spval .and. scale_c2l(c) /= spval) then
                l = clandunit(c)
                if (sumwt(l) == 0._r8) larr(l,j) = 0._r8
                larr(l,j) = larr(l,j) + carr(c,j) * scale_c2l(c) * wtlunit(c)
                sumwt(l) = sumwt(l) + wtlunit(c)
             end if
          end if
       end do
#endif
       found = .false.
       do l = lbl,ubl
          if (sumwt(l) > 1.0_r8 + 1.e-6_r8) then
             found = .true.
             index = l
          else if (sumwt(l) /= 0._r8) then
             larr(l,j) = larr(l,j)/sumwt(l)
          end if
       end do
       if (found) then
          write(6,*)'c2l_2d error: sumwt is greater than 1.0 at l= ',index,' lev= ',j
          call endrun()
       end if
    end do

  end subroutine c2l_2d

!-----------------------------------------------------------------------
!BOP
!
! !IROUTINE: c2g_1d
!
! !INTERFACE:
  subroutine c2g_1d(lbc, ubc, lbl, ubl, lbg, ubg, carr, garr, &
       c2l_scale_type, l2g_scale_type)
!
! !DESCRIPTION:
! Perfrom subgrid-average from columns to gridcells.
! Averaging is only done for points that are not equal to "spval".
!
! !ARGUMENTS:
    implicit none
    integer , intent(in)  :: lbc, ubc              ! beginning and ending column indices
    integer , intent(in)  :: lbl, ubl              ! beginning and ending landunit indices
    integer , intent(in)  :: lbg, ubg              ! beginning and ending landunit indices
    real(r8), intent(in)  :: carr(lbc:ubc)         ! input column array
    real(r8), intent(out) :: garr(lbg:ubg)         ! output gridcell array
    character(len=*), intent(in) :: c2l_scale_type ! scale factor type for averaging
    character(len=*), intent(in) :: l2g_scale_type ! scale factor type for averaging
!
! !REVISION HISTORY:
! Created by Mariana Vertenstein 12/03
!
!
! !LOCAL VARIABLES:
!EOP
    integer  :: ci,c,l,g,index         ! indices
    integer  :: max_col_per_gcell      ! max columns per gridcell; on the fly
    logical  :: found                  ! temporary for error check
    real(r8) :: scale_c2l(lbc:ubc)     ! scale factor
    real(r8) :: scale_l2g(lbl:ubl)     ! scale factor
    real(r8) :: sumwt(lbg:ubg)         ! sum of weights
    real(r8), pointer :: wtgcell(:)    ! weight of columns relative to gridcells
    integer , pointer :: clandunit(:)  ! landunit of corresponding column
    integer , pointer :: cgridcell(:)  ! gridcell of corresponding column
    integer , pointer :: ncolumns(:)   ! number of columns in gridcell
    integer , pointer :: coli(:)       ! initial column index in gridcell
    integer , pointer :: ctype(:)      ! column type
    integer , pointer :: ltype(:)      ! landunit type
    real(r8), pointer :: canyon_hwr(:) ! urban canyon height to width ratio
!------------------------------------------------------------------------

    ctype      => clm3%g%l%c%itype
    ltype      => clm3%g%l%itype
    canyon_hwr => clm3%g%l%canyon_hwr
    wtgcell    => clm3%g%l%c%wtgcell
    clandunit  => clm3%g%l%c%landunit
    cgridcell  => clm3%g%l%c%gridcell
    ncolumns   => clm3%g%ncolumns
    coli       => clm3%g%coli

    if (l2g_scale_type == 'unity') then
       do l = lbl,ubl
          scale_l2g(l) = 1.0_r8
       end do
    else
       write(6,*)'c2l_1d error: scale type ',l2g_scale_type,' not supported'
       call endrun()
    end if

    if (c2l_scale_type == 'unity') then
       do c = lbc,ubc
          scale_c2l(c) = 1.0_r8
       end do
    else if (c2l_scale_type == 'urbanf') then
       do c = lbc,ubc
          l = clandunit(c) 
          if (ltype(l) == isturb) then
             if (ctype(c) == icol_sunwall) then
                scale_c2l(c) = 3.0 * canyon_hwr(l) 
             else if (ctype(c) == icol_shadewall) then
                scale_c2l(c) = 3.0 * canyon_hwr(l) 
             else if (ctype(c) == icol_road_perv .or. ctype(c) == icol_road_imperv) then
                scale_c2l(c) = 3.0_r8
             else if (ctype(c) == icol_roof) then
                scale_c2l(c) = 1.0_r8
             end if
          else
             scale_c2l(c) = 1.0_r8
          end if
       end do
    else if (c2l_scale_type == 'urbans') then
       do c = lbc,ubc
          l = clandunit(c) 
          if (ltype(l) == isturb) then
             if (ctype(c) == icol_sunwall) then
                scale_c2l(c) = (3.0 * canyon_hwr(l)) / (2.*canyon_hwr(l) + 1.)
             else if (ctype(c) == icol_shadewall) then
                scale_c2l(c) = (3.0 * canyon_hwr(l)) / (2.*canyon_hwr(l) + 1.)
             else if (ctype(c) == icol_road_perv .or. ctype(c) == icol_road_imperv) then
                scale_c2l(c) = 3.0 / (2.*canyon_hwr(l) + 1.)
             else if (ctype(c) == icol_roof) then
                scale_c2l(c) = 1.0_r8
             end if
          else
             scale_c2l(c) = 1.0_r8
          end if
       end do
    else if (c2l_scale_type == 'urbanh') then
       do c = lbc,ubc
          l = clandunit(c) 
          if (ltype(l) == isturb) then
             if (ctype(c) == icol_sunwall) then
                scale_c2l(c) = spval
             else if (ctype(c) == icol_shadewall) then
                scale_c2l(c) = spval
             else if (ctype(c) == icol_road_perv .or. ctype(c) == icol_road_imperv) then
                scale_c2l(c) = spval
             else if (ctype(c) == icol_roof) then
                scale_c2l(c) = spval
             end if
          else
             scale_c2l(c) = 1.0_r8
          end if
       end do
    else
       write(6,*)'c2l_1d error: scale type ',c2l_scale_type,' not supported'
       call endrun()
    end if

    garr(:) = spval
    sumwt(:) = 0._r8
#if (defined CPP_VECTOR)
    max_col_per_gcell = 0
    do g = lbg,ubg
       max_col_per_gcell = max(ncolumns(g), max_col_per_gcell)
    end do
!dir$ nointerchange
    do ci = 1,max_col_per_gcell
!dir$ concurrent
!cdir nodep
       do g = lbg,ubg
          if (ci <= ncolumns(g)) then
             c = coli(g) + ci - 1
             if (wtgcell(c) /= 0._r8) then
                if (carr(c) /= spval) then
                   garr(g) = 0._r8
                end if
             end if
          end if
       end do
    end do
!dir$ nointerchange
    do ci = 1,max_col_per_gcell
!dir$ concurrent
!cdir nodep
       do g = lbg,ubg
          if (ci <= ncolumns(g)) then
             c = coli(g) + ci - 1
             if (wtgcell(c) /= 0._r8) then
                if (carr(c) /= spval .and. scale_c2l(c) /= spval) then
                   l = clandunit(c)
                   garr(g) = garr(g) + carr(c) * scale_c2l(c) * scale_l2g(l) * wtgcell(c)
                   sumwt(g) = sumwt(g) + wtgcell(c)
                end if
             end if
          end if
       end do
    end do
#else
    do c = lbc,ubc
       if ( wtgcell(c) /= 0._r8) then
          if (carr(c) /= spval .and. scale_c2l(c) /= spval) then
             l = clandunit(c)
             g = cgridcell(c)
             if (sumwt(g) == 0._r8) garr(g) = 0._r8
             garr(g) = garr(g) + carr(c) * scale_c2l(c) * scale_l2g(l) * wtgcell(c)
             sumwt(g) = sumwt(g) + wtgcell(c)
          end if
       end if
    end do
#endif
    found = .false.
    do g = lbg, ubg
       if (sumwt(g) > 1.0_r8 + 1.e-6_r8) then
          found = .true.
          index = g
       else if (sumwt(g) /= 0._r8) then
          garr(g) = garr(g)/sumwt(g)
       end if
    end do
    if (found) then
       write(6,*)'c2g_1d error: sumwt is greater than 1.0 at g= ',index
       call endrun()
    end if

  end subroutine c2g_1d

!-----------------------------------------------------------------------
!BOP
!
! !IROUTINE: c2g_2d
!
! !INTERFACE:
  subroutine c2g_2d(lbc, ubc, lbl, ubl, lbg, ubg, num2d, carr, garr, &
       c2l_scale_type, l2g_scale_type)
!
! !DESCRIPTION:
! Perfrom subgrid-average from columns to gridcells.
! Averaging is only done for points that are not equal to "spval".
!
! !ARGUMENTS:
    implicit none
    integer , intent(in)  :: lbc, ubc              ! beginning and ending column indices
    integer , intent(in)  :: lbl, ubl              ! beginning and ending landunit indices
    integer , intent(in)  :: lbg, ubg              ! beginning and ending gridcell indices
    integer , intent(in)  :: num2d                 ! size of second dimension
    real(r8), intent(in)  :: carr(lbc:ubc,num2d)   ! input column array
    real(r8), intent(out) :: garr(lbg:ubg,num2d)   ! output gridcell array
    character(len=*), intent(in) :: c2l_scale_type ! scale factor type for averaging
    character(len=*), intent(in) :: l2g_scale_type ! scale factor type for averaging
!
! !REVISION HISTORY:
! Created by Mariana Vertenstein 12/03
!
!
! !LOCAL VARIABLES:
!EOP
    integer  :: j,ci,c,g,l,index       ! indices
    integer  :: max_col_per_gcell      ! max columns per gridcell; on the fly
    logical  :: found                  ! temporary for error check
    real(r8) :: scale_c2l(lbc:ubc)     ! scale factor
    real(r8) :: scale_l2g(lbl:ubl)     ! scale factor
    real(r8) :: sumwt(lbg:ubg)         ! sum of weights
    real(r8), pointer :: wtgcell(:)    ! weight of columns relative to gridcells
    integer , pointer :: clandunit(:)  ! landunit of corresponding column
    integer , pointer :: cgridcell(:)  ! gridcell of corresponding column
    integer , pointer :: ncolumns(:)   ! number of columns in gridcell
    integer , pointer :: coli(:)       ! initial column index in gridcell
    integer , pointer :: ctype(:)      ! column type
    integer , pointer :: ltype(:)      ! landunit type
    real(r8), pointer :: canyon_hwr(:) ! urban canyon height to width ratio
!------------------------------------------------------------------------

    ctype      => clm3%g%l%c%itype
    ltype      => clm3%g%l%itype
    canyon_hwr => clm3%g%l%canyon_hwr
    wtgcell    => clm3%g%l%c%wtgcell
    clandunit  => clm3%g%l%c%landunit
    cgridcell  => clm3%g%l%c%gridcell
    ncolumns   => clm3%g%ncolumns
    coli       => clm3%g%coli

    if (l2g_scale_type == 'unity') then
       do l = lbl,ubl
          scale_l2g(l) = 1.0_r8
       end do
    else
       write(6,*)'c2g_2d error: scale type ',l2g_scale_type,' not supported'
       call endrun()
    end if
    if (c2l_scale_type == 'unity') then
       do c = lbc,ubc
          scale_c2l(c) = 1.0_r8
       end do
    else if (c2l_scale_type == 'urbanf') then
       do c = lbc,ubc
          l = clandunit(c) 
          if (ltype(l) == isturb) then
             if (ctype(c) == icol_sunwall) then
                scale_c2l(c) = 3.0 * canyon_hwr(l) 
             else if (ctype(c) == icol_shadewall) then
                scale_c2l(c) = 3.0 * canyon_hwr(l) 
             else if (ctype(c) == icol_road_perv .or. ctype(c) == icol_road_imperv) then
                scale_c2l(c) = 3.0_r8
             else if (ctype(c) == icol_roof) then
                scale_c2l(c) = 1.0_r8
             end if
          else
             scale_c2l(c) = 1.0_r8
          end if
       end do
    else if (c2l_scale_type == 'urbans') then
       do c = lbc,ubc
          l = clandunit(c) 
          if (ltype(l) == isturb) then
             if (ctype(c) == icol_sunwall) then
                scale_c2l(c) = (3.0 * canyon_hwr(l)) / (2.*canyon_hwr(l) + 1.)
             else if (ctype(c) == icol_shadewall) then
                scale_c2l(c) = (3.0 * canyon_hwr(l)) / (2.*canyon_hwr(l) + 1.)
             else if (ctype(c) == icol_road_perv .or. ctype(c) == icol_road_imperv) then
                scale_c2l(c) = 3.0 / (2.*canyon_hwr(l) + 1.)
             else if (ctype(c) == icol_roof) then
                scale_c2l(c) = 1.0_r8
             end if
          else
             scale_c2l(c) = 1.0_r8
          end if
       end do
    else if (c2l_scale_type == 'urbanh') then
       do c = lbc,ubc
          l = clandunit(c) 
          if (ltype(l) == isturb) then
             if (ctype(c) == icol_sunwall) then
                scale_c2l(c) = spval
             else if (ctype(c) == icol_shadewall) then
                scale_c2l(c) = spval
             else if (ctype(c) == icol_road_perv .or. ctype(c) == icol_road_imperv) then
                scale_c2l(c) = spval
             else if (ctype(c) == icol_roof) then
                scale_c2l(c) = spval
             end if
          else
             scale_c2l(c) = 1.0_r8
          end if
       end do
    else
       write(6,*)'c2g_2d error: scale type ',c2l_scale_type,' not supported'
       call endrun()
    end if

#if (defined CPP_VECTOR)
    max_col_per_gcell = 0
    do g = lbg,ubg
       max_col_per_gcell = max(ncolumns(g), max_col_per_gcell)
    end do
#endif

    garr(:,:) = spval
    do j = 1,num2d
       sumwt(:) = 0._r8
#if (defined CPP_VECTOR)
!dir$ nointerchange
       do ci = 1,max_col_per_gcell
!dir$ concurrent
!cdir nodep
          do g = lbg,ubg
             if (ci <= ncolumns(g)) then
                c = coli(g) + ci - 1
                if (wtgcell(c) /= 0._r8) then
                   if (carr(c,j) /= spval) then
                      garr(g,j) = 0._r8
                   end if
                end if
             end if
          end do
       end do
!dir$ nointerchange
       do ci = 1,max_col_per_gcell
!dir$ concurrent
!cdir nodep
          do g = lbg,ubg
             if (ci <= ncolumns(g)) then
                c = coli(g) + ci - 1
                if (wtgcell(c) /= 0._r8) then
                   if (carr(c,j) /= spval .and. scale_c2l(c) /= spval) then
                      l = clandunit(c)
                      garr(g,j) = garr(g,j) + carr(c,j) * scale_c2l(c) * scale_l2g(l) * wtgcell(c)
                      sumwt(g) = sumwt(g) + wtgcell(c)
                   end if
                end if
             end if
          end do
       end do
#else
       do c = lbc,ubc
          if (wtgcell(c) /= 0._r8) then
             if (carr(c,j) /= spval .and. scale_c2l(c) /= spval) then
                l = clandunit(c)
                g = cgridcell(c)
                if (sumwt(g) == 0._r8) garr(g,j) = 0._r8
                garr(g,j) = garr(g,j) + carr(c,j) * scale_c2l(c) * scale_l2g(l) * wtgcell(c)
                sumwt(g) = sumwt(g) + wtgcell(c)
             end if
          end if
       end do
#endif
       found = .false.
       do g = lbg, ubg
          if (sumwt(g) > 1.0_r8 + 1.e-6_r8) then
             found = .true.
             index = g
          else if (sumwt(g) /= 0._r8) then
             garr(g,j) = garr(g,j)/sumwt(g)
          end if
       end do
       if (found) then
          write(6,*)'c2g_2d error: sumwt is greater than 1.0 at g= ',index
          call endrun()
       end if
    end do

  end subroutine c2g_2d

!-----------------------------------------------------------------------
!BOP
!
! !IROUTINE: l2g_1d
!
! !INTERFACE:
  subroutine l2g_1d(lbl, ubl, lbg, ubg, larr, garr, l2g_scale_type)
!
! !DESCRIPTION:
! Perfrom subgrid-average from landunits to gridcells.
! Averaging is only done for points that are not equal to "spval".
!
! !ARGUMENTS:
    implicit none
    integer , intent(in)  :: lbl, ubl       ! beginning and ending sub landunit indices
    integer , intent(in)  :: lbg, ubg       ! beginning and ending gridcell indices
    real(r8), intent(in)  :: larr(lbl:ubl)  ! input landunit array
    real(r8), intent(out) :: garr(lbg:ubg)  ! output gridcell array
    character(len=*), intent(in) :: l2g_scale_type ! scale factor type for averaging
!
! !REVISION HISTORY:
! Created by Mariana Vertenstein 12/03
!
!
! !LOCAL VARIABLES:
!EOP
    integer  :: li,l,g,index           ! indices
    integer  :: max_lu_per_gcell       ! max landunits per gridcell; on the fly
    logical  :: found                  ! temporary for error check
    real(r8) :: scale_l2g(lbl:ubl)     ! scale factor
    real(r8) :: sumwt(lbg:ubg)         ! sum of weights
    real(r8), pointer :: wtgcell(:)    ! weight of landunits relative to gridcells
    integer , pointer :: lgridcell(:)  ! gridcell of corresponding landunit
    integer , pointer :: nlandunits(:) ! number of landunits in gridcell
    integer , pointer :: luni(:)       ! initial landunit index in gridcell
!------------------------------------------------------------------------

    wtgcell    => clm3%g%l%wtgcell
    lgridcell  => clm3%g%l%gridcell
    nlandunits => clm3%g%nlandunits
    luni       => clm3%g%luni

    if (l2g_scale_type == 'unity') then
       do l = lbl,ubl
          scale_l2g(l) = 1.0_r8
       end do
    else
       write(6,*)'l2g_1d error: scale type ',l2g_scale_type,' not supported'
       call endrun()
    end if

    garr(:) = spval
    sumwt(:) = 0._r8
#if (defined CPP_VECTOR)
    max_lu_per_gcell = 0
    do g = lbg,ubg
       max_lu_per_gcell = max(nlandunits(g), max_lu_per_gcell)
    end do
!dir$ nointerchange
    do li = 1,max_lu_per_gcell
!dir$ concurrent
!cdir nodep
       do g = lbg,ubg
          if (li <= nlandunits(g)) then
             l = luni(g) + li - 1
             if (wtgcell(l) /= 0._r8) then
                if (larr(l) /= spval) then
                   garr(g) = 0._r8
                end if
             end if
          end if
       end do
    end do
!dir$ nointerchange
    do li = 1,max_lu_per_gcell
!dir$ concurrent
!cdir nodep
       do g = lbg,ubg
          if (li <= nlandunits(g)) then
             l = luni(g) + li - 1
             if (wtgcell(l) /= 0._r8) then
                if (larr(l) /= spval) then
                   garr(g) = garr(g) + larr(l) * scale_l2g(l) * wtgcell(l)
                   sumwt(g) = sumwt(g) + wtgcell(l)
                end if
             end if
          end if
       end do
    end do
#else
    do l = lbl,ubl
       if (wtgcell(l) /= 0._r8) then
          if (larr(l) /= spval) then
             g = lgridcell(l)
             if (sumwt(g) == 0._r8) garr(g) = 0._r8
             garr(g) = garr(g) + larr(l) * scale_l2g(l) * wtgcell(l)
             sumwt(g) = sumwt(g) + wtgcell(l)
          end if
       end if
    end do
#endif
    found = .false.
    do g = lbg, ubg
       if (sumwt(g) > 1.0_r8 + 1.e-6_r8) then
          found = .true.
          index = g
       else if (sumwt(g) /= 0._r8) then
          garr(g) = garr(g)/sumwt(g)
       end if
    end do
    if (found) then
       write(6,*)'l2g_1d error: sumwt is greater than 1.0 at g= ',index
       call endrun()
    end if

  end subroutine l2g_1d

!-----------------------------------------------------------------------
!BOP
!
! !IROUTINE: l2g_2d
!
! !INTERFACE:
  subroutine l2g_2d(lbl, ubl, lbg, ubg, num2d, larr, garr, l2g_scale_type)
!
! !DESCRIPTION:
! Perfrom subgrid-average from landunits to gridcells.
! Averaging is only done for points that are not equal to "spval".
!
! !ARGUMENTS:
    implicit none
    integer , intent(in)  :: lbl, ubl             ! beginning and ending column indices
    integer , intent(in)  :: lbg, ubg             ! beginning and ending gridcell indices
    integer , intent(in)  :: num2d                ! size of second dimension
    real(r8), intent(in)  :: larr(lbl:ubl,num2d)  ! input landunit array
    real(r8), intent(out) :: garr(lbg:ubg,num2d)  ! output gridcell array
    character(len=*), intent(in) :: l2g_scale_type ! scale factor type for averaging
!
! !REVISION HISTORY:
! Created by Mariana Vertenstein 12/03
!
!
! !LOCAL VARIABLES:
!EOP
    integer  :: j,g,li,l,index         ! indices
    integer  :: max_lu_per_gcell       ! max landunits per gridcell; on the fly
    logical  :: found                  ! temporary for error check
    real(r8) :: scale_l2g(lbl:ubl)     ! scale factor
    real(r8) :: sumwt(lbg:ubg)         ! sum of weights
    real(r8), pointer :: wtgcell(:)    ! weight of landunits relative to gridcells
    integer , pointer :: lgridcell(:)  ! gridcell of corresponding landunit
    integer , pointer :: nlandunits(:) ! number of landunits in gridcell
    integer , pointer :: luni(:)       ! initial landunit index in gridcell
!------------------------------------------------------------------------

    wtgcell   => clm3%g%l%wtgcell
    lgridcell => clm3%g%l%gridcell
    nlandunits => clm3%g%nlandunits
    luni       => clm3%g%luni

    if (l2g_scale_type == 'unity') then
       do l = lbl,ubl
          scale_l2g(l) = 1.0_r8
       end do
    else
       write(6,*)'l2g_2d error: scale type ',l2g_scale_type,' not supported'
       call endrun()
    end if

#if (defined CPP_VECTOR)
    max_lu_per_gcell = 0
    do g = lbg,ubg
       max_lu_per_gcell = max(nlandunits(g), max_lu_per_gcell)
    end do
#endif

    garr(:,:) = spval
    do j = 1,num2d
       sumwt(:) = 0._r8
#if (defined CPP_VECTOR)
!dir$ nointerchange
       do li = 1,max_lu_per_gcell
!dir$ concurrent
!cdir nodep
          do g = lbg,ubg
             if (li <= nlandunits(g)) then
                l = luni(g) + li - 1
                if (wtgcell(l) /= 0._r8) then
                   if (larr(l,j) /= spval) then
                      garr(g,j) = 0._r8
                   end if
                end if
             end if
          end do
       end do
!dir$ nointerchange
       do li = 1,max_lu_per_gcell
!dir$ concurrent
!cdir nodep
          do g = lbg,ubg
             if (li <= nlandunits(g)) then
                l = luni(g) + li - 1
                if (wtgcell(l) /= 0._r8) then
                   if (larr(l,j) /= spval) then
                      garr(g,j) = garr(g,j) + larr(l,j) * scale_l2g(l) * wtgcell(l)
                      sumwt(g) = sumwt(g) + wtgcell(l)
                   end if
                end if
             end if
          end do
       end do
#else
       do l = lbl,ubl
          if (wtgcell(l) /= 0._r8) then
             if (larr(l,j) /= spval) then
                g = lgridcell(l)
                if (sumwt(g) == 0._r8) garr(g,j) = 0._r8
                garr(g,j) = garr(g,j) + larr(l,j) * scale_l2g(l) * wtgcell(l)
                sumwt(g) = sumwt(g) + wtgcell(l)
             end if
          end if
       end do
#endif
       found = .false.
       do g = lbg,ubg
          if (sumwt(g) > 1.0_r8 + 1.e-6_r8) then
             found = .true.
             index= g
          else if (sumwt(g) /= 0._r8) then
             garr(g,j) = garr(g,j)/sumwt(g)
          end if
       end do
       if (found) then
          write(6,*)'l2g_2d error: sumwt is greater than 1.0 at g= ',index,' lev= ',j
          call endrun()
       end if
    end do

  end subroutine l2g_2d

end module subgridAveMod
module pft2colMod

!-----------------------------------------------------------------------
!BOP
!
! !MODULE: pft2colMod
!
! !DESCRIPTION:
! Contains calls to methods to perfom averages over from pfts to columns
! for model variables.
!
! !USES:
  use shr_kind_mod, only: r8 => shr_kind_r8
  use subgridAveMod
  use clmtype
!
! !PUBLIC TYPES:
  implicit none
  save
!
! !PUBLIC MEMBER FUNCTIONS:
  public :: p2c  ! obtain column properties from average over column pfts
!
! !REVISION HISTORY:
! 03/09/08: Created by Mariana Vertenstein
!
!EOP
!-----------------------------------------------------------------------

contains

!-----------------------------------------------------------------------
!BOP
!
! !IROUTINE: pft2col
!
! !INTERFACE:
  subroutine pft2col (lbc, ubc, num_nolakec, filter_nolakec)
!
! !DESCRIPTION:
! Averages over all pfts for variables defined over both soil and lake
! to provide the column-level averages of state and flux variables
! defined at the pft level.
!
! !ARGUMENTS:
    implicit none
    integer, intent(in) :: lbc, ubc                    ! column bounds
    integer, intent(in) :: num_nolakec                 ! number of column non-lake points in column filter
    integer, intent(in) :: filter_nolakec(ubc-lbc+1)   ! column filter for non-lake points
!
! !REVISION HISTORY:
! 03/09/08: Created by Mariana Vertenstein
!
!EOP
!
! !OTHER LOCAL VARIABLES:
    integer :: c,fc                      ! indices
    integer :: num_allc                  ! number of total column points
    integer :: filter_allc(ubc-lbc+1)    ! filter for all column points
    real(r8), pointer :: ptrp(:)         ! pointer to input pft array
    real(r8), pointer :: ptrc(:)         ! pointer to output column array
! -----------------------------------------------------------------

    ! Set up a filter for all column points

    num_allc = ubc-lbc+1
    fc = 0
    do c = lbc,ubc
       fc = fc + 1
       filter_allc(fc) = c
    end do

    ! Averaging for pft water state variables

    ptrp => clm3%g%l%c%p%pws%h2ocan
    ptrc => clm3%g%l%c%cws%pws_a%h2ocan
    call p2c (num_nolakec, filter_nolakec, ptrp, ptrc)

    ! Averaging for pft water flux variables

    ptrp => clm3%g%l%c%p%pwf%qflx_evap_tot
    ptrc => clm3%g%l%c%cwf%pwf_a%qflx_evap_tot
    call p2c (num_allc, filter_allc, ptrp, ptrc)

    ptrp => clm3%g%l%c%p%pwf%qflx_rain_grnd
    ptrc => clm3%g%l%c%cwf%pwf_a%qflx_rain_grnd
    call p2c (num_nolakec, filter_nolakec, ptrp, ptrc)

    ptrp => clm3%g%l%c%p%pwf%qflx_snow_grnd
    ptrc => clm3%g%l%c%cwf%pwf_a%qflx_snow_grnd
    call p2c (num_nolakec, filter_nolakec, ptrp, ptrc)

!    ptrp => clm3%g%l%c%p%pwf%qflx_snowcap
!    ptrc => clm3%g%l%c%cwf%pwf_a%qflx_snowcap
!    call p2c (num_nolakec, filter_nolakec, ptrp, ptrc)
!CLM4 
    ptrp => clm3%g%l%c%p%pwf%qflx_snwcp_liq
    ptrc => clm3%g%l%c%cwf%pwf_a%qflx_snwcp_liq
    call p2c (num_allc, filter_allc, ptrp, ptrc)

    ptrp => clm3%g%l%c%p%pwf%qflx_snwcp_ice
    ptrc => clm3%g%l%c%cwf%pwf_a%qflx_snwcp_ice
    call p2c (num_allc, filter_allc, ptrp, ptrc)
!!!

    ptrp => clm3%g%l%c%p%pwf%qflx_tran_veg
    ptrc => clm3%g%l%c%cwf%pwf_a%qflx_tran_veg
    call p2c (num_nolakec, filter_nolakec, ptrp, ptrc)

    ptrp => clm3%g%l%c%p%pwf%qflx_evap_grnd
    ptrc => clm3%g%l%c%cwf%pwf_a%qflx_evap_grnd
    call p2c (num_nolakec, filter_nolakec, ptrp, ptrc)

    ptrp => clm3%g%l%c%p%pwf%qflx_dew_grnd
    ptrc => clm3%g%l%c%cwf%pwf_a%qflx_dew_grnd
    call p2c (num_nolakec, filter_nolakec, ptrp, ptrc)

    ptrp => clm3%g%l%c%p%pwf%qflx_sub_snow
    ptrc => clm3%g%l%c%cwf%pwf_a%qflx_sub_snow
    call p2c (num_nolakec, filter_nolakec, ptrp, ptrc)

    ptrp => clm3%g%l%c%p%pwf%qflx_dew_snow
    ptrc => clm3%g%l%c%cwf%pwf_a%qflx_dew_snow
    call p2c (num_nolakec, filter_nolakec, ptrp, ptrc)

  end subroutine pft2col

end module pft2colMod
!===============================================================================
! SVN $Id: shr_orb_mod.F90 6752 2007-10-04 21:02:15Z jwolfe $
! SVN $URL: https://svn-ccsm-models.cgd.ucar.edu/csm_share/trunk_tags/share3_090706b/shr/shr_orb_mod.F90 $
!===============================================================================

MODULE shr_orb_mod

   use shr_kind_mod
   use shr_const_mod

   IMPLICIT none

   !----------------------------------------------------------------------------
   ! PUBLIC: Interfaces and global data
   !----------------------------------------------------------------------------
   public :: shr_orb_cosz
   public :: shr_orb_params
   public :: shr_orb_decl
!   public :: shr_orb_print

   real   (SHR_KIND_R8),public,parameter :: SHR_ORB_UNDEF_REAL = 1.e36_SHR_KIND_R8 ! undefined real 
   integer,public,parameter :: SHR_ORB_UNDEF_INT  = 2000000000        ! undefined int

   !----------------------------------------------------------------------------
   ! PRIVATE: by default everything else is private to this module
   !----------------------------------------------------------------------------
   private

   real   (SHR_KIND_R8),parameter :: pi                 = SHR_CONST_PI
   real   (SHR_KIND_R8),parameter :: SHR_ORB_ECCEN_MIN  =   0.0_SHR_KIND_R8 ! min value for eccen
   real   (SHR_KIND_R8),parameter :: SHR_ORB_ECCEN_MAX  =   0.1_SHR_KIND_R8 ! max value for eccen
   real   (SHR_KIND_R8),parameter :: SHR_ORB_OBLIQ_MIN  = -90.0_SHR_KIND_R8 ! min value for obliq
   real   (SHR_KIND_R8),parameter :: SHR_ORB_OBLIQ_MAX  = +90.0_SHR_KIND_R8 ! max value for obliq
   real   (SHR_KIND_R8),parameter :: SHR_ORB_MVELP_MIN  =   0.0_SHR_KIND_R8 ! min value for mvelp
   real   (SHR_KIND_R8),parameter :: SHR_ORB_MVELP_MAX  = 360.0_SHR_KIND_R8 ! max value for mvelp

!===============================================================================
CONTAINS
!===============================================================================

real(SHR_KIND_R8) FUNCTION shr_orb_cosz(jday,lat,lon,declin)

   !----------------------------------------------------------------------------
   !
   ! FUNCTION to return the cosine of the solar zenith angle.
   ! Assumes 365.0 days/year.
   !
   !--------------- Code History -----------------------------------------------
   !
   ! Original Author: Brian Kauffman
   ! Date:            Jan/98
   ! History:         adapted from statement FUNCTION in share/orb_cosz.h
   !
   !----------------------------------------------------------------------------

   real   (SHR_KIND_R8),intent(in) :: jday   ! Julian cal day (1.xx to 365.xx)
   real   (SHR_KIND_R8),intent(in) :: lat    ! Centered latitude (radians)
   real   (SHR_KIND_R8),intent(in) :: lon    ! Centered longitude (radians)
   real   (SHR_KIND_R8),intent(in) :: declin ! Solar declination (radians)

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

   shr_orb_cosz = sin(lat)*sin(declin) - &
   &              cos(lat)*cos(declin)*cos(jday*2.0_SHR_KIND_R8*pi + lon)

END FUNCTION shr_orb_cosz

!===============================================================================

SUBROUTINE shr_orb_params( iyear_AD , eccen  , obliq , mvelp     ,     &
           &               obliqr   , lambm0 , mvelpp)

!-------------------------------------------------------------------------------
!
! Calculate earths orbital parameters using Dave Threshers formula which 
! came from Berger, Andre.  1978  "A Simple Algorithm to Compute Long-Term 
! Variations of Daily Insolation".  Contribution 18, Institute of Astronomy 
! and Geophysics, Universite Catholique de Louvain, Louvain-la-Neuve, Belgium
!
!------------------------------Code history-------------------------------------
!
! Original Author: Erik Kluzek
! Date:            Oct/97
!
!-------------------------------------------------------------------------------

   !----------------------------- Arguments ------------------------------------
   real   (SHR_KIND_R8),intent(inout) :: eccen     ! orbital eccentricity
   real   (SHR_KIND_R8),intent(inout) :: obliq     ! obliquity in degrees
   real   (SHR_KIND_R8),intent(inout) :: mvelp     ! moving vernal equinox long
   integer,intent(in)    :: iyear_AD  ! Year to calculate orbit for
   real   (SHR_KIND_R8),intent(out)   :: obliqr    ! Earths obliquity in rad
   real   (SHR_KIND_R8),intent(out)   :: lambm0    ! Mean long of perihelion at
                                                   ! vernal equinox (radians)
   real   (SHR_KIND_R8),intent(out)   :: mvelpp    ! moving vernal equinox long
                                                   ! of perihelion plus pi (rad)

   !------------------------------ Parameters ----------------------------------
   integer,parameter :: poblen =47 ! # of elements in series wrt obliquity
   integer,parameter :: pecclen=19 ! # of elements in series wrt eccentricity
   integer,parameter :: pmvelen=78 ! # of elements in series wrt vernal equinox
   real   (SHR_KIND_R8),parameter :: psecdeg = 1.0_SHR_KIND_R8/3600.0_SHR_KIND_R8 ! arc sec to deg conversion

   real   (SHR_KIND_R8) :: degrad = pi/180._SHR_KIND_R8   ! degree to radian conversion factor
   real   (SHR_KIND_R8) :: yb4_1950AD         ! number of years before 1950 AD
 
   ! Cosine series data for computation of obliquity: amplitude (arc seconds),
   ! rate (arc seconds/year), phase (degrees).
 
   real   (SHR_KIND_R8), parameter :: obamp(poblen) =  & ! amplitudes for obliquity cos series
   &      (/   -2462.2214466_SHR_KIND_R8, -857.3232075_SHR_KIND_R8, -629.3231835_SHR_KIND_R8,   &
   &            -414.2804924_SHR_KIND_R8, -311.7632587_SHR_KIND_R8,  308.9408604_SHR_KIND_R8,   &
   &            -162.5533601_SHR_KIND_R8, -116.1077911_SHR_KIND_R8,  101.1189923_SHR_KIND_R8,   &
   &             -67.6856209_SHR_KIND_R8,   24.9079067_SHR_KIND_R8,   22.5811241_SHR_KIND_R8,   &
   &             -21.1648355_SHR_KIND_R8,  -15.6549876_SHR_KIND_R8,   15.3936813_SHR_KIND_R8,   &
   &              14.6660938_SHR_KIND_R8,  -11.7273029_SHR_KIND_R8,   10.2742696_SHR_KIND_R8,   &
   &               6.4914588_SHR_KIND_R8,    5.8539148_SHR_KIND_R8,   -5.4872205_SHR_KIND_R8,   &
   &              -5.4290191_SHR_KIND_R8,    5.1609570_SHR_KIND_R8,    5.0786314_SHR_KIND_R8,   &
   &              -4.0735782_SHR_KIND_R8,    3.7227167_SHR_KIND_R8,    3.3971932_SHR_KIND_R8,   &
   &              -2.8347004_SHR_KIND_R8,   -2.6550721_SHR_KIND_R8,   -2.5717867_SHR_KIND_R8,   &
   &              -2.4712188_SHR_KIND_R8,    2.4625410_SHR_KIND_R8,    2.2464112_SHR_KIND_R8,   &
   &              -2.0755511_SHR_KIND_R8,   -1.9713669_SHR_KIND_R8,   -1.8813061_SHR_KIND_R8,   &
   &              -1.8468785_SHR_KIND_R8,    1.8186742_SHR_KIND_R8,    1.7601888_SHR_KIND_R8,   &
   &              -1.5428851_SHR_KIND_R8,    1.4738838_SHR_KIND_R8,   -1.4593669_SHR_KIND_R8,   &
   &               1.4192259_SHR_KIND_R8,   -1.1818980_SHR_KIND_R8,    1.1756474_SHR_KIND_R8,   &
   &              -1.1316126_SHR_KIND_R8,    1.0896928_SHR_KIND_R8/)
 
   real   (SHR_KIND_R8), parameter :: obrate(poblen) = & ! rates for obliquity cosine series
   &        (/  31.609974_SHR_KIND_R8, 32.620504_SHR_KIND_R8, 24.172203_SHR_KIND_R8,   &
   &            31.983787_SHR_KIND_R8, 44.828336_SHR_KIND_R8, 30.973257_SHR_KIND_R8,   &
   &            43.668246_SHR_KIND_R8, 32.246691_SHR_KIND_R8, 30.599444_SHR_KIND_R8,   &
   &            42.681324_SHR_KIND_R8, 43.836462_SHR_KIND_R8, 47.439436_SHR_KIND_R8,   &
   &            63.219948_SHR_KIND_R8, 64.230478_SHR_KIND_R8,  1.010530_SHR_KIND_R8,   &
   &             7.437771_SHR_KIND_R8, 55.782177_SHR_KIND_R8,  0.373813_SHR_KIND_R8,   &
   &            13.218362_SHR_KIND_R8, 62.583231_SHR_KIND_R8, 63.593761_SHR_KIND_R8,   &
   &            76.438310_SHR_KIND_R8, 45.815258_SHR_KIND_R8,  8.448301_SHR_KIND_R8,   &
   &            56.792707_SHR_KIND_R8, 49.747842_SHR_KIND_R8, 12.058272_SHR_KIND_R8,   &
   &            75.278220_SHR_KIND_R8, 65.241008_SHR_KIND_R8, 64.604291_SHR_KIND_R8,   &
   &             1.647247_SHR_KIND_R8,  7.811584_SHR_KIND_R8, 12.207832_SHR_KIND_R8,   &
   &            63.856665_SHR_KIND_R8, 56.155990_SHR_KIND_R8, 77.448840_SHR_KIND_R8,   &
   &             6.801054_SHR_KIND_R8, 62.209418_SHR_KIND_R8, 20.656133_SHR_KIND_R8,   &
   &            48.344406_SHR_KIND_R8, 55.145460_SHR_KIND_R8, 69.000539_SHR_KIND_R8,   &
   &            11.071350_SHR_KIND_R8, 74.291298_SHR_KIND_R8, 11.047742_SHR_KIND_R8,   &
   &             0.636717_SHR_KIND_R8, 12.844549_SHR_KIND_R8/)
 
   real   (SHR_KIND_R8), parameter :: obphas(poblen) = & ! phases for obliquity cosine series
   &      (/    251.9025_SHR_KIND_R8, 280.8325_SHR_KIND_R8, 128.3057_SHR_KIND_R8,   &
   &            292.7252_SHR_KIND_R8,  15.3747_SHR_KIND_R8, 263.7951_SHR_KIND_R8,   &
   &            308.4258_SHR_KIND_R8, 240.0099_SHR_KIND_R8, 222.9725_SHR_KIND_R8,   &
   &            268.7809_SHR_KIND_R8, 316.7998_SHR_KIND_R8, 319.6024_SHR_KIND_R8,   &
   &            143.8050_SHR_KIND_R8, 172.7351_SHR_KIND_R8,  28.9300_SHR_KIND_R8,   &
   &            123.5968_SHR_KIND_R8,  20.2082_SHR_KIND_R8,  40.8226_SHR_KIND_R8,   &
   &            123.4722_SHR_KIND_R8, 155.6977_SHR_KIND_R8, 184.6277_SHR_KIND_R8,   &
   &            267.2772_SHR_KIND_R8,  55.0196_SHR_KIND_R8, 152.5268_SHR_KIND_R8,   &
   &             49.1382_SHR_KIND_R8, 204.6609_SHR_KIND_R8,  56.5233_SHR_KIND_R8,   &
   &            200.3284_SHR_KIND_R8, 201.6651_SHR_KIND_R8, 213.5577_SHR_KIND_R8,   &
   &             17.0374_SHR_KIND_R8, 164.4194_SHR_KIND_R8,  94.5422_SHR_KIND_R8,   &
   &            131.9124_SHR_KIND_R8,  61.0309_SHR_KIND_R8, 296.2073_SHR_KIND_R8,   &
   &            135.4894_SHR_KIND_R8, 114.8750_SHR_KIND_R8, 247.0691_SHR_KIND_R8,   &
   &            256.6114_SHR_KIND_R8,  32.1008_SHR_KIND_R8, 143.6804_SHR_KIND_R8,   &
   &             16.8784_SHR_KIND_R8, 160.6835_SHR_KIND_R8,  27.5932_SHR_KIND_R8,   &
   &            348.1074_SHR_KIND_R8,  82.6496_SHR_KIND_R8/)
 
   ! Cosine/sine series data for computation of eccentricity and fixed vernal 
   ! equinox longitude of perihelion (fvelp): amplitude, 
   ! rate (arc seconds/year), phase (degrees).
 
   real   (SHR_KIND_R8), parameter :: ecamp (pecclen) = & ! ampl for eccen/fvelp cos/sin series
   &      (/   0.01860798_SHR_KIND_R8,  0.01627522_SHR_KIND_R8, -0.01300660_SHR_KIND_R8,   &
   &           0.00988829_SHR_KIND_R8, -0.00336700_SHR_KIND_R8,  0.00333077_SHR_KIND_R8,   &
   &          -0.00235400_SHR_KIND_R8,  0.00140015_SHR_KIND_R8,  0.00100700_SHR_KIND_R8,   &
   &           0.00085700_SHR_KIND_R8,  0.00064990_SHR_KIND_R8,  0.00059900_SHR_KIND_R8,   &
   &           0.00037800_SHR_KIND_R8, -0.00033700_SHR_KIND_R8,  0.00027600_SHR_KIND_R8,   &
   &           0.00018200_SHR_KIND_R8, -0.00017400_SHR_KIND_R8, -0.00012400_SHR_KIND_R8,   &
   &           0.00001250_SHR_KIND_R8/)
 
   real   (SHR_KIND_R8), parameter :: ecrate(pecclen) = & ! rates for eccen/fvelp cos/sin series
   &      (/    4.2072050_SHR_KIND_R8,  7.3460910_SHR_KIND_R8, 17.8572630_SHR_KIND_R8,  &
   &           17.2205460_SHR_KIND_R8, 16.8467330_SHR_KIND_R8,  5.1990790_SHR_KIND_R8,  &
   &           18.2310760_SHR_KIND_R8, 26.2167580_SHR_KIND_R8,  6.3591690_SHR_KIND_R8,  &
   &           16.2100160_SHR_KIND_R8,  3.0651810_SHR_KIND_R8, 16.5838290_SHR_KIND_R8,  &
   &           18.4939800_SHR_KIND_R8,  6.1909530_SHR_KIND_R8, 18.8677930_SHR_KIND_R8,  &
   &           17.4255670_SHR_KIND_R8,  6.1860010_SHR_KIND_R8, 18.4174410_SHR_KIND_R8,  &
   &            0.6678630_SHR_KIND_R8/)
 
   real   (SHR_KIND_R8), parameter :: ecphas(pecclen) = & ! phases for eccen/fvelp cos/sin series
   &      (/    28.620089_SHR_KIND_R8, 193.788772_SHR_KIND_R8, 308.307024_SHR_KIND_R8,  &
   &           320.199637_SHR_KIND_R8, 279.376984_SHR_KIND_R8,  87.195000_SHR_KIND_R8,  &
   &           349.129677_SHR_KIND_R8, 128.443387_SHR_KIND_R8, 154.143880_SHR_KIND_R8,  &
   &           291.269597_SHR_KIND_R8, 114.860583_SHR_KIND_R8, 332.092251_SHR_KIND_R8,  &
   &           296.414411_SHR_KIND_R8, 145.769910_SHR_KIND_R8, 337.237063_SHR_KIND_R8,  &
   &           152.092288_SHR_KIND_R8, 126.839891_SHR_KIND_R8, 210.667199_SHR_KIND_R8,  &
   &            72.108838_SHR_KIND_R8/)
 
   ! Sine series data for computation of moving vernal equinox longitude of 
   ! perihelion: amplitude (arc seconds), rate (arc sec/year), phase (degrees).      
 
   real   (SHR_KIND_R8), parameter :: mvamp (pmvelen) = & ! amplitudes for mvelp sine series 
   &      (/   7391.0225890_SHR_KIND_R8, 2555.1526947_SHR_KIND_R8, 2022.7629188_SHR_KIND_R8,  &
   &          -1973.6517951_SHR_KIND_R8, 1240.2321818_SHR_KIND_R8,  953.8679112_SHR_KIND_R8,  &
   &           -931.7537108_SHR_KIND_R8,  872.3795383_SHR_KIND_R8,  606.3544732_SHR_KIND_R8,  &
   &           -496.0274038_SHR_KIND_R8,  456.9608039_SHR_KIND_R8,  346.9462320_SHR_KIND_R8,  &
   &           -305.8412902_SHR_KIND_R8,  249.6173246_SHR_KIND_R8, -199.1027200_SHR_KIND_R8,  &
   &            191.0560889_SHR_KIND_R8, -175.2936572_SHR_KIND_R8,  165.9068833_SHR_KIND_R8,  &
   &            161.1285917_SHR_KIND_R8,  139.7878093_SHR_KIND_R8, -133.5228399_SHR_KIND_R8,  &
   &            117.0673811_SHR_KIND_R8,  104.6907281_SHR_KIND_R8,   95.3227476_SHR_KIND_R8,  &
   &             86.7824524_SHR_KIND_R8,   86.0857729_SHR_KIND_R8,   70.5893698_SHR_KIND_R8,  &
   &            -69.9719343_SHR_KIND_R8,  -62.5817473_SHR_KIND_R8,   61.5450059_SHR_KIND_R8,  &
   &            -57.9364011_SHR_KIND_R8,   57.1899832_SHR_KIND_R8,  -57.0236109_SHR_KIND_R8,  &
   &            -54.2119253_SHR_KIND_R8,   53.2834147_SHR_KIND_R8,   52.1223575_SHR_KIND_R8,  &
   &            -49.0059908_SHR_KIND_R8,  -48.3118757_SHR_KIND_R8,  -45.4191685_SHR_KIND_R8,  &
   &            -42.2357920_SHR_KIND_R8,  -34.7971099_SHR_KIND_R8,   34.4623613_SHR_KIND_R8,  &
   &            -33.8356643_SHR_KIND_R8,   33.6689362_SHR_KIND_R8,  -31.2521586_SHR_KIND_R8,  &
   &            -30.8798701_SHR_KIND_R8,   28.4640769_SHR_KIND_R8,  -27.1960802_SHR_KIND_R8,  &
   &             27.0860736_SHR_KIND_R8,  -26.3437456_SHR_KIND_R8,   24.7253740_SHR_KIND_R8,  &
   &             24.6732126_SHR_KIND_R8,   24.4272733_SHR_KIND_R8,   24.0127327_SHR_KIND_R8,  &
   &             21.7150294_SHR_KIND_R8,  -21.5375347_SHR_KIND_R8,   18.1148363_SHR_KIND_R8,  &
   &            -16.9603104_SHR_KIND_R8,  -16.1765215_SHR_KIND_R8,   15.5567653_SHR_KIND_R8,  &
   &             15.4846529_SHR_KIND_R8,   15.2150632_SHR_KIND_R8,   14.5047426_SHR_KIND_R8,  &
   &            -14.3873316_SHR_KIND_R8,   13.1351419_SHR_KIND_R8,   12.8776311_SHR_KIND_R8,  &
   &             11.9867234_SHR_KIND_R8,   11.9385578_SHR_KIND_R8,   11.7030822_SHR_KIND_R8,  &
   &             11.6018181_SHR_KIND_R8,  -11.2617293_SHR_KIND_R8,  -10.4664199_SHR_KIND_R8,  &
   &             10.4333970_SHR_KIND_R8,  -10.2377466_SHR_KIND_R8,   10.1934446_SHR_KIND_R8,  &
   &            -10.1280191_SHR_KIND_R8,   10.0289441_SHR_KIND_R8,  -10.0034259_SHR_KIND_R8/)
 
   real   (SHR_KIND_R8), parameter :: mvrate(pmvelen) = & ! rates for mvelp sine series 
   &      (/    31.609974_SHR_KIND_R8, 32.620504_SHR_KIND_R8, 24.172203_SHR_KIND_R8,   &
   &             0.636717_SHR_KIND_R8, 31.983787_SHR_KIND_R8,  3.138886_SHR_KIND_R8,   &
   &            30.973257_SHR_KIND_R8, 44.828336_SHR_KIND_R8,  0.991874_SHR_KIND_R8,   &
   &             0.373813_SHR_KIND_R8, 43.668246_SHR_KIND_R8, 32.246691_SHR_KIND_R8,   &
   &            30.599444_SHR_KIND_R8,  2.147012_SHR_KIND_R8, 10.511172_SHR_KIND_R8,   &
   &            42.681324_SHR_KIND_R8, 13.650058_SHR_KIND_R8,  0.986922_SHR_KIND_R8,   &
   &             9.874455_SHR_KIND_R8, 13.013341_SHR_KIND_R8,  0.262904_SHR_KIND_R8,   &
   &             0.004952_SHR_KIND_R8,  1.142024_SHR_KIND_R8, 63.219948_SHR_KIND_R8,   &
   &             0.205021_SHR_KIND_R8,  2.151964_SHR_KIND_R8, 64.230478_SHR_KIND_R8,   &
   &            43.836462_SHR_KIND_R8, 47.439436_SHR_KIND_R8,  1.384343_SHR_KIND_R8,   &
   &             7.437771_SHR_KIND_R8, 18.829299_SHR_KIND_R8,  9.500642_SHR_KIND_R8,   &
   &             0.431696_SHR_KIND_R8,  1.160090_SHR_KIND_R8, 55.782177_SHR_KIND_R8,   &
   &            12.639528_SHR_KIND_R8,  1.155138_SHR_KIND_R8,  0.168216_SHR_KIND_R8,   &
   &             1.647247_SHR_KIND_R8, 10.884985_SHR_KIND_R8,  5.610937_SHR_KIND_R8,   &
   &            12.658184_SHR_KIND_R8,  1.010530_SHR_KIND_R8,  1.983748_SHR_KIND_R8,   &
   &            14.023871_SHR_KIND_R8,  0.560178_SHR_KIND_R8,  1.273434_SHR_KIND_R8,   &
   &            12.021467_SHR_KIND_R8, 62.583231_SHR_KIND_R8, 63.593761_SHR_KIND_R8,   &
   &            76.438310_SHR_KIND_R8,  4.280910_SHR_KIND_R8, 13.218362_SHR_KIND_R8,   &
   &            17.818769_SHR_KIND_R8,  8.359495_SHR_KIND_R8, 56.792707_SHR_KIND_R8,   &
   &            8.448301_SHR_KIND_R8,  1.978796_SHR_KIND_R8,  8.863925_SHR_KIND_R8,   &
   &             0.186365_SHR_KIND_R8,  8.996212_SHR_KIND_R8,  6.771027_SHR_KIND_R8,   &
   &            45.815258_SHR_KIND_R8, 12.002811_SHR_KIND_R8, 75.278220_SHR_KIND_R8,   &
   &            65.241008_SHR_KIND_R8, 18.870667_SHR_KIND_R8, 22.009553_SHR_KIND_R8,   &
   &            64.604291_SHR_KIND_R8, 11.498094_SHR_KIND_R8,  0.578834_SHR_KIND_R8,   &
   &             9.237738_SHR_KIND_R8, 49.747842_SHR_KIND_R8,  2.147012_SHR_KIND_R8,   &
   &             1.196895_SHR_KIND_R8,  2.133898_SHR_KIND_R8,  0.173168_SHR_KIND_R8/)

   real   (SHR_KIND_R8), parameter :: mvphas(pmvelen) = & ! phases for mvelp sine series
   &      (/    251.9025_SHR_KIND_R8, 280.8325_SHR_KIND_R8, 128.3057_SHR_KIND_R8,   &
   &            348.1074_SHR_KIND_R8, 292.7252_SHR_KIND_R8, 165.1686_SHR_KIND_R8,   &
   &            263.7951_SHR_KIND_R8,  15.3747_SHR_KIND_R8,  58.5749_SHR_KIND_R8,   &
   &             40.8226_SHR_KIND_R8, 308.4258_SHR_KIND_R8, 240.0099_SHR_KIND_R8,   &
   &            222.9725_SHR_KIND_R8, 106.5937_SHR_KIND_R8, 114.5182_SHR_KIND_R8,   &
   &            268.7809_SHR_KIND_R8, 279.6869_SHR_KIND_R8,  39.6448_SHR_KIND_R8,   &
   &            126.4108_SHR_KIND_R8, 291.5795_SHR_KIND_R8, 307.2848_SHR_KIND_R8,   &
   &             18.9300_SHR_KIND_R8, 273.7596_SHR_KIND_R8, 143.8050_SHR_KIND_R8,   &
   &            191.8927_SHR_KIND_R8, 125.5237_SHR_KIND_R8, 172.7351_SHR_KIND_R8,   &
   &            316.7998_SHR_KIND_R8, 319.6024_SHR_KIND_R8,  69.7526_SHR_KIND_R8,   &
   &            123.5968_SHR_KIND_R8, 217.6432_SHR_KIND_R8,  85.5882_SHR_KIND_R8,   &
   &            156.2147_SHR_KIND_R8,  66.9489_SHR_KIND_R8,  20.2082_SHR_KIND_R8,   &
   &            250.7568_SHR_KIND_R8,  48.0188_SHR_KIND_R8,   8.3739_SHR_KIND_R8,   &
   &             17.0374_SHR_KIND_R8, 155.3409_SHR_KIND_R8,  94.1709_SHR_KIND_R8,   &
   &            221.1120_SHR_KIND_R8,  28.9300_SHR_KIND_R8, 117.1498_SHR_KIND_R8,   &
   &            320.5095_SHR_KIND_R8, 262.3602_SHR_KIND_R8, 336.2148_SHR_KIND_R8,   &
   &            233.0046_SHR_KIND_R8, 155.6977_SHR_KIND_R8, 184.6277_SHR_KIND_R8,   &
   &            267.2772_SHR_KIND_R8,  78.9281_SHR_KIND_R8, 123.4722_SHR_KIND_R8,   &
   &            188.7132_SHR_KIND_R8, 180.1364_SHR_KIND_R8,  49.1382_SHR_KIND_R8,   &
   &            152.5268_SHR_KIND_R8,  98.2198_SHR_KIND_R8,  97.4808_SHR_KIND_R8,   &
   &            221.5376_SHR_KIND_R8, 168.2438_SHR_KIND_R8, 161.1199_SHR_KIND_R8,   &
   &             55.0196_SHR_KIND_R8, 262.6495_SHR_KIND_R8, 200.3284_SHR_KIND_R8,   &
   &            201.6651_SHR_KIND_R8, 294.6547_SHR_KIND_R8,  99.8233_SHR_KIND_R8,   &
   &            213.5577_SHR_KIND_R8, 154.1631_SHR_KIND_R8, 232.7153_SHR_KIND_R8,   &
   &            138.3034_SHR_KIND_R8, 204.6609_SHR_KIND_R8, 106.5938_SHR_KIND_R8,   &
   &            250.4676_SHR_KIND_R8, 332.3345_SHR_KIND_R8,  27.3039_SHR_KIND_R8/)
 
   !---------------------------Local variables----------------------------------
   integer :: i       ! Index for series summations
   real   (SHR_KIND_R8) :: obsum   ! Obliquity series summation
   real   (SHR_KIND_R8) :: cossum  ! Cos series summation for eccentricity/fvelp
   real   (SHR_KIND_R8) :: sinsum  ! Sin series summation for eccentricity/fvelp
   real   (SHR_KIND_R8) :: fvelp   ! Fixed vernal equinox long of perihelion
   real   (SHR_KIND_R8) :: mvsum   ! mvelp series summation
   real   (SHR_KIND_R8) :: beta    ! Intermediate argument for lambm0
   real   (SHR_KIND_R8) :: years   ! Years to time of interest ( pos <=> future)
   real   (SHR_KIND_R8) :: eccen2  ! eccentricity squared
   real   (SHR_KIND_R8) :: eccen3  ! eccentricity cubed

   !-------------------------- Formats -----------------------------------------
!   character(*),parameter :: svnID  = "SVN " // &
!   "$Id: shr_orb_mod.F90 6752 2007-10-04 21:02:15Z jwolfe $"
!   character(*),parameter :: svnURL = "SVN <unknown URL>" 
!  character(*),parameter :: svnURL = "SVN " // &
!  "$URL: https://svn-ccsm-models.cgd.ucar.edu/csm_share/trunk_tags/share3_090706b/shr/shr_orb_mod.F90 $"
!   character(len=*),parameter :: F00 = "('(shr_orb_params) ',4a)"
!   character(len=*),parameter :: F01 = "('(shr_orb_params) ',a,i9)"
!   character(len=*),parameter :: F02 = "('(shr_orb_params) ',a,f6.3)"
!   character(len=*),parameter :: F03 = "('(shr_orb_params) ',a,es14.6)"

   !----------------------------------------------------------------------------
   ! radinp and algorithms below will need a degree to radian conversion factor
 
!   if ( log_print .and. s_loglev > 0 ) then
!     write(s_logunit,F00) 'Calculate characteristics of the orbit:'
!     write(s_logunit,F00) svnID
!     write(s_logunit,F00) svnURL
!   end if
 
   ! Check for flag to use input orbit parameters
 
!   IF ( iyear_AD == SHR_ORB_UNDEF_INT ) THEN

      ! Check input obliq, eccen, and mvelp to ensure reasonable
 
!      if( obliq == SHR_ORB_UNDEF_REAL )then
!         write(s_logunit,F00) 'Have to specify orbital parameters:'
!         write(s_logunit,F00) 'Either set: iyear_AD, OR [obliq, eccen, and mvelp]:'
!         write(s_logunit,F00) 'iyear_AD is the year to simulate orbit for (ie. 1950): '
!         write(s_logunit,F00) 'obliq, eccen, mvelp specify the orbit directly:'
!         write(s_logunit,F00) 'The AMIP II settings (for a 1995 orbit) are: '
!         write(s_logunit,F00) ' obliq =  23.4441'
!         write(s_logunit,F00) ' eccen =   0.016715'
!         write(s_logunit,F00) ' mvelp = 102.7'
!         call shr_sys_abort()
!      else if ( log_print ) then
!         write(s_logunit,F00) 'Use input orbital parameters: '
!      end if
!      if( (obliq < SHR_ORB_OBLIQ_MIN).or.(obliq > SHR_ORB_OBLIQ_MAX) ) then
!         write(s_logunit,F03) 'Input obliquity unreasonable: ', obliq
!         call shr_sys_abort()
!      end if
!      if( (eccen < SHR_ORB_ECCEN_MIN).or.(eccen > SHR_ORB_ECCEN_MAX) ) then
!         write(s_logunit,F03) 'Input eccentricity unreasonable: ', eccen
!         call shr_sys_abort()
!      end if
!      if( (mvelp < SHR_ORB_MVELP_MIN).or.(mvelp > SHR_ORB_MVELP_MAX) ) then
!         write(s_logunit,F03) 'Input mvelp unreasonable: ' , mvelp
!         call shr_sys_abort()
!      end if
!      eccen2 = eccen*eccen
!      eccen3 = eccen2*eccen

!   ELSE  ! Otherwise calculate based on years before present
 
!      if ( log_print .and. s_loglev > 0) then
!         write(s_logunit,F01) 'Calculate orbit for year: ' , iyear_AD
!      end if

      yb4_1950AD = 1950.0_SHR_KIND_R8 - real(iyear_AD,SHR_KIND_R8)
      if ( abs(yb4_1950AD) .gt. 1000000.0_SHR_KIND_R8 )then
!         write(s_logunit,F00) 'orbit only valid for years+-1000000'
!         write(s_logunit,F00) 'Relative to 1950 AD'
!         write(s_logunit,F03) '# of years before 1950: ',yb4_1950AD
!         write(s_logunit,F01) 'Year to simulate was  : ',iyear_AD
!         call shr_sys_abort()
          write(6,*) 'Error in shr_orb,  abs(yb4_1950AD) .gt. 1000000.0_SHR_KIND_R8'
          call endrun()
      end if
 
      ! The following calculates the earths obliquity, orbital eccentricity
      ! (and various powers of it) and vernal equinox mean longitude of
      ! perihelion for years in the past (future = negative of years past),
      ! using constants (see parameter section) given in the program of:
      !
      ! Berger, Andre.  1978  A Simple Algorithm to Compute Long-Term Variations
      ! of Daily Insolation.  Contribution 18, Institute of Astronomy and
      ! Geophysics, Universite Catholique de Louvain, Louvain-la-Neuve, Belgium.
      !
      ! and formulas given in the paper (where less precise constants are also
      ! given):
      !
      ! Berger, Andre.  1978.  Long-Term Variations of Daily Insolation and
      ! Quaternary Climatic Changes.  J. of the Atmo. Sci. 35:2362-2367
      !
      ! The algorithm is valid only to 1,000,000 years past or hence.
      ! For a solution valid to 5-10 million years past see the above author.
      ! Algorithm below is better for years closer to present than is the
      ! 5-10 million year solution.
      !
      ! Years to time of interest must be negative of years before present
      ! (1950) in formulas that follow. 
 
      years = - yb4_1950AD
 
      ! In the summations below, cosine or sine arguments, which end up in
      ! degrees, must be converted to radians via multiplication by degrad.
      !
      ! Summation of cosine series for obliquity (epsilon in Berger 1978) in
      ! degrees. Convert the amplitudes and rates, which are in arc secs, into
      ! degrees via multiplication by psecdeg (arc seconds to degrees conversion
      ! factor).  For obliq, first term is Berger 1978 epsilon star; second
      ! term is series summation in degrees.
  
      obsum = 0.0_SHR_KIND_R8
      do i = 1, poblen
         obsum = obsum + obamp(i)*psecdeg*cos((obrate(i)*psecdeg*years + &
         &       obphas(i))*degrad)
      end do
      obliq = 23.320556_SHR_KIND_R8 + obsum
 
      ! Summation of cosine and sine series for computation of eccentricity 
      ! (eccen; e in Berger 1978) and fixed vernal equinox longitude of 
      ! perihelion (fvelp; pi in Berger 1978), which is used for computation 
      ! of moving vernal equinox longitude of perihelion.  Convert the rates, 
      ! which are in arc seconds, into degrees via multiplication by psecdeg.
 
      cossum = 0.0_SHR_KIND_R8
      do i = 1, pecclen
        cossum = cossum+ecamp(i)*cos((ecrate(i)*psecdeg*years+ecphas(i))*degrad)
      end do
 
      sinsum = 0.0_SHR_KIND_R8
      do i = 1, pecclen
        sinsum = sinsum+ecamp(i)*sin((ecrate(i)*psecdeg*years+ecphas(i))*degrad)
      end do
 
      ! Use summations to calculate eccentricity
 
      eccen2 = cossum*cossum + sinsum*sinsum
      eccen  = sqrt(eccen2)
      eccen3 = eccen2*eccen
 
      ! A series of cases for fvelp, which is in radians.
         
      if (abs(cossum) .le. 1.0E-8_SHR_KIND_R8) then
        if (sinsum .eq. 0.0_SHR_KIND_R8) then
          fvelp = 0.0_SHR_KIND_R8
        else if (sinsum .lt. 0.0_SHR_KIND_R8) then
          fvelp = 1.5_SHR_KIND_R8*pi
        else if (sinsum .gt. 0.0_SHR_KIND_R8) then
          fvelp = .5_SHR_KIND_R8*pi
        endif
      else if (cossum .lt. 0.0_SHR_KIND_R8) then
        fvelp = atan(sinsum/cossum) + pi
      else if (cossum .gt. 0.0_SHR_KIND_R8) then
        if (sinsum .lt. 0.0_SHR_KIND_R8) then
          fvelp = atan(sinsum/cossum) + 2.0_SHR_KIND_R8*pi
        else
          fvelp = atan(sinsum/cossum)
        endif
      endif
 
      ! Summation of sin series for computation of moving vernal equinox long
      ! of perihelion (mvelp; omega bar in Berger 1978) in degrees.  For mvelp,
      ! first term is fvelp in degrees; second term is Berger 1978 psi bar 
      ! times years and in degrees; third term is Berger 1978 zeta; fourth 
      ! term is series summation in degrees.  Convert the amplitudes and rates,
      ! which are in arc seconds, into degrees via multiplication by psecdeg.  
      ! Series summation plus second and third terms constitute Berger 1978
      ! psi, which is the general precession.
 
      mvsum = 0.0_SHR_KIND_R8
      do i = 1, pmvelen
        mvsum = mvsum + mvamp(i)*psecdeg*sin((mvrate(i)*psecdeg*years + &
        &       mvphas(i))*degrad)
      end do
      mvelp = fvelp/degrad + 50.439273_SHR_KIND_R8*psecdeg*years + 3.392506_SHR_KIND_R8 + mvsum
 
      ! Cases to make sure mvelp is between 0 and 360.
 
      do while (mvelp .lt. 0.0_SHR_KIND_R8)
        mvelp = mvelp + 360.0_SHR_KIND_R8
      end do
      do while (mvelp .ge. 360.0_SHR_KIND_R8)
        mvelp = mvelp - 360.0_SHR_KIND_R8
      end do

!   END IF  ! end of test on whether to calculate or use input orbital params
 
   ! Orbit needs the obliquity in radians
 
   obliqr = obliq*degrad
 
   ! 180 degrees must be added to mvelp since observations are made from the
   ! earth and the sun is considered (wrongly for the algorithm) to go around
   ! the earth. For a more graphic explanation see Appendix B in:
   !
   ! A. Berger, M. Loutre and C. Tricot. 1993.  Insolation and Earth Orbital
   ! Periods.  J. of Geophysical Research 98:10,341-10,362.
   !
   ! Additionally, orbit will need this value in radians. So mvelp becomes
   ! mvelpp (mvelp plus pi)
 
   mvelpp = (mvelp + 180._SHR_KIND_R8)*degrad
 
   ! Set up an argument used several times in lambm0 calculation ahead.
 
   beta = sqrt(1._SHR_KIND_R8 - eccen2)
 
   ! The mean longitude at the vernal equinox (lambda m nought in Berger
   ! 1978; in radians) is calculated from the following formula given in 
   ! Berger 1978.  At the vernal equinox the true longitude (lambda in Berger
   ! 1978) is 0.

   lambm0 = 2._SHR_KIND_R8*((.5_SHR_KIND_R8*eccen + .125_SHR_KIND_R8*eccen3)*(1._SHR_KIND_R8 + beta)*sin(mvelpp)  &
   &      - .250_SHR_KIND_R8*eccen2*(.5_SHR_KIND_R8    + beta)*sin(2._SHR_KIND_R8*mvelpp)            &
   &      + .125_SHR_KIND_R8*eccen3*(1._SHR_KIND_R8/3._SHR_KIND_R8 + beta)*sin(3._SHR_KIND_R8*mvelpp))
 
!   if ( log_print ) then
!     write(s_logunit,F03) '------ Computed Orbital Parameters ------'
!     write(s_logunit,F03) 'Eccentricity      = ',eccen
!     write(s_logunit,F03) 'Obliquity (deg)   = ',obliq
!     write(s_logunit,F03) 'Obliquity (rad)   = ',obliqr
!     write(s_logunit,F03) 'Long of perh(deg) = ',mvelp
!     write(s_logunit,F03) 'Long of perh(rad) = ',mvelpp
!     write(s_logunit,F03) 'Long at v.e.(rad) = ',lambm0
!     write(s_logunit,F03) '-----------------------------------------'
!   end if
 
END SUBROUTINE shr_orb_params

!===============================================================================

SUBROUTINE shr_orb_decl(calday ,eccen ,mvelpp ,lambm0 ,obliqr ,delta ,eccf)

!-------------------------------------------------------------------------------
!
! Compute earth/orbit parameters using formula suggested by
! Duane Thresher.
!
!---------------------------Code history----------------------------------------
!
! Original version:  Erik Kluzek
! Date:              Oct/1997
!
!-------------------------------------------------------------------------------

   !------------------------------Arguments--------------------------------
   real   (SHR_KIND_R8),intent(in)  :: calday ! Calendar day, including fraction
   real   (SHR_KIND_R8),intent(in)  :: eccen  ! Eccentricity
   real   (SHR_KIND_R8),intent(in)  :: obliqr ! Earths obliquity in radians
   real   (SHR_KIND_R8),intent(in)  :: lambm0 ! Mean long of perihelion at the 
                                              ! vernal equinox (radians)
   real   (SHR_KIND_R8),intent(in)  :: mvelpp ! moving vernal equinox longitude
                                              ! of perihelion plus pi (radians)
   real   (SHR_KIND_R8),intent(out) :: delta  ! Solar declination angle in rad
   real   (SHR_KIND_R8),intent(out) :: eccf   ! Earth-sun distance factor (ie. (1/r)**2)
 
   !---------------------------Local variables-----------------------------
   real   (SHR_KIND_R8),parameter :: dayspy = 365.0_SHR_KIND_R8  ! days per year
   real   (SHR_KIND_R8),parameter :: ve     = 80.5_SHR_KIND_R8   ! Calday of vernal equinox
                                                     ! assumes Jan 1 = calday 1
 
   real   (SHR_KIND_R8) ::   lambm  ! Lambda m, mean long of perihelion (rad)
   real   (SHR_KIND_R8) ::   lmm    ! Intermediate argument involving lambm
   real   (SHR_KIND_R8) ::   lamb   ! Lambda, the earths long of perihelion
   real   (SHR_KIND_R8) ::   invrho ! Inverse normalized sun/earth distance
   real   (SHR_KIND_R8) ::   sinl   ! Sine of lmm
 
   ! Compute eccentricity factor and solar declination using
   ! day value where a round day (such as 213.0) refers to 0z at
   ! Greenwich longitude.
   !
   ! Use formulas from Berger, Andre 1978: Long-Term Variations of Daily
   ! Insolation and Quaternary Climatic Changes. J. of the Atmo. Sci.
   ! 35:2362-2367.
   !
   ! To get the earths true longitude (position in orbit; lambda in Berger 
   ! 1978) which is necessary to find the eccentricity factor and declination,
   ! must first calculate the mean longitude (lambda m in Berger 1978) at
   ! the present day.  This is done by adding to lambm0 (the mean longitude
   ! at the vernal equinox, set as March 21 at noon, when lambda=0; in radians)
   ! an increment (delta lambda m in Berger 1978) that is the number of
   ! days past or before (a negative increment) the vernal equinox divided by
   ! the days in a model year times the 2*pi radians in a complete orbit.
 
   lambm = lambm0 + (calday - ve)*2._SHR_KIND_R8*pi/dayspy
   lmm   = lambm  - mvelpp
 
   ! The earths true longitude, in radians, is then found from
   ! the formula in Berger 1978:
 
   sinl  = sin(lmm)
   lamb  = lambm  + eccen*(2._SHR_KIND_R8*sinl + eccen*(1.25_SHR_KIND_R8*sin(2._SHR_KIND_R8*lmm)  &
   &     + eccen*((13.0_SHR_KIND_R8/12.0_SHR_KIND_R8)*sin(3._SHR_KIND_R8*lmm) - 0.25_SHR_KIND_R8*sinl)))
 
   ! Using the obliquity, eccentricity, moving vernal equinox longitude of
   ! perihelion (plus), and earths true longitude, the declination (delta)
   ! and the normalized earth/sun distance (rho in Berger 1978; actually inverse
   ! rho will be used), and thus the eccentricity factor (eccf), can be 
   ! calculated from formulas given in Berger 1978.
 
   invrho = (1._SHR_KIND_R8 + eccen*cos(lamb - mvelpp)) / (1._SHR_KIND_R8 - eccen*eccen)
 
   ! Set solar declination and eccentricity factor
 
   delta  = asin(sin(obliqr)*sin(lamb))
   eccf   = invrho*invrho
 
   return
 
END SUBROUTINE shr_orb_decl

!===============================================================================


END MODULE shr_orb_mod
module surfFileMod

!----------------------------------------------------------------------- 
!BOP
!
! !MODULE: surfFileMod
! 
! !DESCRIPTION: 
! Contains methods for reading in surface data file and determining
! two-dimensional subgrid weights as well as writing out new surface
! dataset. When reading in the surface dataset, determines array 
! which sets the PFT for each of the [maxpatch] patches and 
! array which sets the relative abundance of the PFT. 
! Also fills in the PFTs for vegetated portion of each grid cell. 
! Fractional areas for these points pertain to "vegetated" 
! area not to total grid area. Need to adjust them for fraction of grid 
! that is vegetated. Also fills in urban, lake, wetland, and glacier patches.
!
! !PUBLIC TYPES:
  implicit none
  save
!
! !PUBLIC MEMBER FUNCTIONS:
  public :: surfrd  !Read surface dataset and determine subgrid weights
!  public :: surfwrt !Write surface dataset
!
! !REVISION HISTORY:
! Created by Mariana Vertenstein
!
!EOP
!----------------------------------------------------------------------- 

contains

!-----------------------------------------------------------------------
!BOP
!
! !IROUTINE: surfrd
!
! !INTERFACE:
!Yaqiong Lu 01/13/2009
  subroutine surfrd(organicxy,efisopxy,gtixy,ilx,jlx,iveg,isl,lndmsk)
!
! !DESCRIPTION: 
! Read the surface dataset and create subgrid weights.
! The model's surface dataset recognizes 5 basic land cover types within 
! a grid cell: lake, wetland, urban, glacier, and vegetated. The vegetated 
! portion of the grid cell is comprised of up to [maxpatch_pft] PFTs. These
! subgrid patches are read in explicitly for each grid cell. This is in
! contrast to LSMv1, where the PFTs were built implicitly from biome types.
! Read surface boundary data with the exception of 
! monthly lai,sai,and heights at top and bottom of canopy 
! on [lsmlon] x [lsmlat] grid. 
!    o real edges of grid
!    o integer  number of longitudes per latitude
!    o real latitude  of grid cell (degrees)
!    o real longitude of grid cell (degrees)
!    o integer surface type: 0 = ocean or 1 = land
!    o integer soil color (1 to 9) for use with soil albedos
!    o real soil texture, %sand, for thermal and hydraulic properties
!    o real soil texture, %clay, for thermal and hydraulic properties
!    o real % of cell covered by lake    for use as subgrid patch
!    o real % of cell covered by wetland for use as subgrid patch
!    o real % of cell that is urban      for use as subgrid patch
!    o real % of cell that is glacier    for use as subgrid patch
!    o integer PFTs
!    o real % abundance PFTs (as a percent of vegetated area)
!
! OFFLINE MODE ONLY:
! Surface grid edges -- Grids do not have to be global. 
! If grid is read in from dataset, grid is assumed to be global 
! (does not have to be regular, however)
! If grid is generated by model, grid does not have to be global but must then
! define the north, east, south, and west edges:
!
!    o lsmedge(1)    = northern edge of grid (degrees): >  -90 and <= 90
!    o lsmedge(2)    = eastern edge of grid (degrees) : see following notes
!    o lsmedge(3)    = southern edge of grid (degrees): >= -90 and <  90
!    o lsmedge(4)    = western edge of grid (degrees) : see following notes
!
!      For partial grids, northern and southern edges are any latitude
!      between 90 (North Pole) and -90 (South Pole). Western and eastern
!      edges are any longitude between -180 and 180, with longitudes
!      west of Greenwich negative. That is, western edge >= -180 and < 180;
!      eastern edge > western edge and <= 180.
!
!      For global grids, northern and southern edges are 90 (North Pole)
!      and -90 (South Pole). The western and eastern edges depend on
!      whether the grid starts at Dateline or Greenwich. Regardless,
!      these edges must span 360 degrees. Examples:
!
!                              West edge    East edge
!                            ---------------------------------------------------
!  (1) Dateline            :        -180 to 180        (negative W of Greenwich)
!  (2) Greenwich (centered):    0 - dx/2 to 360 - dx/2
!
!    Grid 1 is the grid for offline mode
!    Grid 2 is the grid for cam and csm mode since the NCAR CAM 
!    starts at Greenwich, centered on Greenwich 
!
! !USES:
    use shr_kind_mod, only: r8 => shr_kind_r8
    use clm_varpar                      !parameters
    use pftvarcon, only : noveg, crop  !vegetation type (PFT) 
    use clm_varcon,only : sand,clay,soic,plant,cover,num_landcover_types
    use clm_varsur      , only :gti, wtxy,vegxy,soic2d,sand3d,clay3d,organic3d,efisop2d &
                                 ,pctgla,pctlak,pctwet,pcturb     !surface data 
    use decompMod , only: get_proc_bounds
!
! !ARGUMENTS:
    implicit none
!!ylu add new variables:
    integer :: ilx,jlx
    real(r8) :: organicxy(maxpatch)
    real(r8) :: efisopxy(6)
    real(r8) :: gtixy
!
! !CALLED FROM:
! subroutine initialize in module initializeMod
!
! !REVISION HISTORY:
! Created by Mariana Vertenstein, Sam Levis and Gordon Bonan
!
!EOP
!   variables from MM5 11/25/2003 Jiming Jin

    integer  :: iveg,isl,lndmsk
!
! !LOCAL VARIABLES:
    integer  :: g,k,m,k1,k2,begg,endg                            ! indices
    integer  :: ncid,dimid,varid                         ! netCDF id's
    integer  :: ier                                      ! error status
    integer ,allocatable :: pft(:,:)            ! PFT
    integer ,allocatable :: cft(:,:)            ! CFT
    real(r8),allocatable :: pctcft_lunit(:,:)   ! % of crop lunit area for CFTs
    real(r8),allocatable :: pctpft_lunit(:,:)   ! % of vegetated lunit area PFTs
    real(r8), allocatable :: pctpft(:,:)               ! percent of vegetated gridcell area for PFTs
!ylu change pctspec to pctspec1, pctspec now to be a vector in clm_varsur,so pctspec can be used in pftdynMod.F
    real(r8) :: pctspec1                                  ! percent of gridcell made up of special landunits
    integer  :: cropcount                                ! temporary counter
    real(r8) :: sumscl                                   ! temporory scalar sum
    real(r8),allocatable :: sumvec(:)                                   ! temporary vector sum
    logical  :: found                                    ! temporary for error check
    integer  :: iindx, jindx                             ! temporary for error check
    integer  :: miss = 99999                             ! missing data indicator
    real(r8) :: wst(0:numpft)                            ! as[signed?] pft at specific i, j
    integer  :: wsti(maxpatch_pft)                       ! ranked indices of largest values in wst
    real(r8) :: wst_sum                                  ! sum of %pft
    real(r8) :: sumpct                                   ! sum of %pft over maxpatch_pft
    real(r8) :: diff                                     ! the difference (wst_sum - sumpct)
    real(r8) :: rmax                                     ! maximum patch cover
!ylu 01/16/2009
    integer  :: pftid
!!-------------------------------------------------------------------------
       ! Initialize surface data to fill value
  call CLMDebug('surfrd-mark1')
    call get_proc_bounds(begg=begg, endg=endg)

   call CLMDebug('get begg,endg')

       soic2d(:)   = -999
       sand3d(:,:) = -999.
       clay3d(:,:) = -999.
       pctlak(:)   = 0.0
       pctwet(:)   = 0.0
       pcturb(:)   = 0.0
       pctgla(:)   = 0.0
 !ylu
      pftid        = 0
    call CLMDebug('allocate sumvec')
    allocate(sumvec(begg:endg))
    call CLMDebug('allocate cft')
    allocate(cft(begg:endg,numcft))
    call CLMDebug('allocate pft')
    allocate(pft(begg:endg,maxpatch_pft))
    call CLMDebug('allocate pctpft_lunit')
    allocate(pctcft_lunit(begg:endg,numcft))
    call CLMDebug('allocate pctpft_lunit')
    allocate(pctpft_lunit(begg:endg,maxpatch_pft))
    call CLMDebug('allocate pctpft')  
    allocate(pctpft(begg:endg,0:numpft))
       pctpft(:,:) = 0.0
      pft(:,:)    = 0 
      call CLMDebug('surfrd-mark')

       ! Obtain netcdf file and read surface data

       do g=begg,endg

           soic2d(g) = soic(isl)
           efisop2d(:,g) = efisopxy(:)
          gti(g) = gtixy
           do k=1,nlevsoi
             sand3d(g,k)  = sand(isl)
             clay3d(g,k)  = clay(isl)
             organic3d(g,k) = organicxy(k) 
          end do

          call CLMDebug('surfrd-mark2')

!---------------------------------------------------
! in current versions of CLM, the lake scheme has problems 
! in simulating deep lakes. Esepcially, observed lake depth data should
! be used in the lake scheme. Wetland and glacier schemes haven't been developed
! within CLM. Thus, the following lines are temporirially commented out
! -- Jiming Jin 10/18/2012   

!           if(iveg == 17 .or. iveg == 18) then
!              pctwet(g)      = 100.0 
!           elseif(iveg.eq.16.and.lndmsk.eq.1) then
!              pctlak(g)      = 100.0
!           elseif(iveg.eq.24) then 
!              pctgla(g)      = 100.0
!           end if
!----------------------------------------------------
           do m=1,maxpatch_pft
               pft(g,m) = plant(iveg,m)
               if(cover(iveg,m).ne.0.0) then
                pctpft(g,pft(g,m)) = cover(iveg,m)
               end if
           end do

!CLM caculates urban separately. See module_sf_clm
!             pcturb(g) = 0
!             if(pctgla(g) .eq. 100 .or. pctlak(g) .eq. 100 .or.pctwet(g) .eq. 100) then
!                pftid = 1    !no pft distribution for this grid cell 
!                pctpft(g,0) = 100.
!                pctpft(g,1:numpft) = 0.
!                pft(g,:) = 0.
!              end if
!---------------------------------------------------------------------
         end do
           call CLMDebug('surfrd--mark3')
       ! Error check: valid PFTs and sum of cover must equal 100

#ifndef DGVM
       sumvec(:) = abs(sum(pctpft,dim=2)-100.)
          do g=begg,endg
             do m = 1, maxpatch_pft
              if (pft(g,m)<0 .or. pft(g,m)>numpft) then
                   write(6,*)'SURFRD error: invalid PFT for g,m=',ilx,jlx,m,pft(g,m)
                   call endrun
                end if
             end do
!ylu
              if (sumvec(g)>1.e-04 .and. pftid == 0) then 
               write(6,*)'SURFRD error: PFT cover ne 100 for g=',ilx,jlx
                do m=1,maxpatch_pft
                   write(6,*)'m= ',m,' pft= ',pft(g,m)
                end do
                write(6,*)'sumvec= ',sumvec(g)
                call endrun
             end if
          end do
#endif
          call CLMDebug('surfrd--mark4')
          ! 1. pctpft must go back to %vegetated landunit instead of %gridcell
          ! 2. pctpft bare = 100 when landmask = 1 and 100% special landunit
          ! NB: (1) and (2) do not apply to crops.
          ! For now keep all cfts (< 4 anyway) instead of 4 most dominant cfts

           do g=begg,endg 
               cft(g,:) = 0
                pctcft_lunit(g,:) = 0.
                cropcount = 0
                pctspec1 = pcturb(g) + pctgla(g) + pctlak(g) + pctwet(g)
                if (pctspec1 < 100.) then
                   do m = 0, numpft
                      if (crop(m) == 1. .and. pctpft(g,m) > 0.) then
                         cropcount = cropcount + 1
                         if (cropcount > maxpatch_cft) then
                            write(6,*) 'ERROR surfFileMod: cropcount>maxpatch_cft'
                            call endrun()
                         end if
                         cft(g,cropcount) = m
                         pctcft_lunit(g,cropcount) = pctpft(g,m) !* 100./(100.-pctspec)
                         pctpft(g,m) = 0.0
                      else if (crop(m) == 0.) then
                         pctpft(g,m) = pctpft(g,m) !* 100./(100.-pctspec)
                       end if
                   end do
                else if (pctspec1 == 100.) then
                   pctpft(g,0)        = 100.
                   pctpft(g,1:numpft) =   0.
                end if
             end do
          
          call CLMDebug('surfrd-mark5')
          ! Find pft and pct arrays
          ! Save percent cover by PFT [wst] and total percent cover [wst_sum]

             do g=begg,endg

                wst_sum = 0.
                sumpct = 0
                do m = 0, numpft
                   wst(m) = pctpft(g,m)
                   wst_sum = wst_sum + pctpft(g,m)
                end do

                ! Rank [wst] in ascendg order to obtain the top [maxpatch_pft] PFTs
!ylu  for lake, glacier,wetland, pft = noveg ,pftid = 1
                if (pftid .eq. 0) call mkrank (numpft, wst, miss, wsti, maxpatch_pft)

                ! Fill in [pft] and [pctpft] with data for top [maxpatch_pft] PFTs.
                ! If land model grid cell is ocean, set to no PFTs.
                ! If land model grid cell is land then:
                !  1. If [pctlnd_o] = 0, there is no PFT data from the input grid.
                !     Since need land data, use bare ground.
                !  2. If [pctlnd_o] > 0, there is PFT data from the input grid but:
                !     a. use the chosen PFT so long as it is not a missing value
                !     b. missing value means no more PFTs with cover > 0

                 if (pftid .eq. 0) then   ! vegetated grid
                   do m = 1, maxpatch_pft
                      if(wsti(m) /= miss) then
                          pft(g,m) = wsti(m)
                          pctpft_lunit(g,m) = wst(wsti(m))
                       else
                         pft(g,m) = noveg
                         pctpft_lunit(g,m) = 0.
                       end if
                      sumpct = sumpct + pctpft_lunit(g,m)
                   end do
                else                       ! grid with other type =100        ! model grid wants ocean
                   do m = 1, maxpatch_pft
                      pft(g,m) = 0
                      pctpft_lunit(g,m) = 0.
                   end do
                end if
          call CLMDebug('surfrd--mark6')

                ! Correct for the case of more than [maxpatch_pft] PFTs present

                if (sumpct < wst_sum) then
                   diff  = wst_sum - sumpct
                   sumpct = 0.
                   do m = 1, maxpatch_pft
                      pctpft_lunit(g,m) = pctpft_lunit(g,m) + diff/maxpatch_pft
                      sumpct = sumpct + pctpft_lunit(g,m)
                   end do
                end if

                ! Error check: make sure have a valid PFT

                do m = 1,maxpatch_pft
                   if (pft(g,m) < 0 .or. pft(g,m) > numpft) then
                      write (6,*)'surfrd error: invalid PFT at gridcell g=',ilx,jlx,pft(g,m)
                      call endrun()
                   end if
                end do

                ! As done in mksrfdatMod.F90 for other percentages, truncate pctpft to
                ! ensure that weight relative to landunit is not nonzero
                ! (i.e. a very small number such as 1e-16) where it really should be zero

                do m=1,maxpatch_pft
                   pctpft_lunit(g,m) = float(nint(pctpft_lunit(g,m)))
                end do
                do m=1,maxpatch_cft
                   pctcft_lunit(g,m) = float(nint(pctcft_lunit(g,m)))
                end do

                ! Make sure sum of PFT cover == 100 for land points. If not,
                ! subtract excess from most dominant PFT.
          call CLMDebug('surfrd--mark7')
                rmax = -9999.
                k1 = -9999
                k2 = -9999
                sumpct = 0.
                do m = 1, maxpatch_pft
                   sumpct = sumpct + pctpft_lunit(g,m)
                   if (pctpft_lunit(g,m) > rmax) then
                      k1 = m
                      rmax = pctpft_lunit(g,m)
                   end if
                end do
                do m = 1, maxpatch_cft
                   sumpct = sumpct + pctcft_lunit(g,m)
                   if (pctcft_lunit(g,m) > rmax) then
                      k2 = m
                      rmax = pctcft_lunit(g,m)
                   end if
                end do
                if (k1 == -9999 .and. k2 == -9999) then
                   write(6,*)'surfrd error: largest PFT patch not found'
                   call endrun()
                 else if(pftid /=1) then  
                   if (sumpct < 95 .or. sumpct > 105.) then
                      write(6,*)'surfrd error: sum of PFT cover =',sumpct,' at g=',ilx,jlx
                      call endrun()
                   else if (sumpct /= 100. .and. k2 /= -9999) then
                      pctcft_lunit(g,k2) = pctcft_lunit(g,k2) - (sumpct-100.)
                   else if (sumpct /= 100.) then
                      pctpft_lunit(g,k1) = pctpft_lunit(g,k1) - (sumpct-100.)
                   end if
                end if

                ! Error check: make sure PFTs sum to 100% cover

                sumpct = 0.
                do m = 1, maxpatch_pft
                   sumpct = sumpct + pctpft_lunit(g,m)
                end do
                do m = 1, maxpatch_cft
                   sumpct = sumpct + pctcft_lunit(g,m)
                end do
              if (pftid == 0) then    
                   if (abs(sumpct - 100.) > 0.000001) then
                      write(6,*)'surfFileMod error: sum(pct) over maxpatch_pft is not = 100.'
                      write(6,*)sumpct, g
                      call endrun()
                   end if
                   if (sumpct < -0.000001) then
                      write(6,*)'surfFileMod error: sum(pct) over maxpatch_pft is < 0.'
                      write(6,*)sumpct, g
                      call endrun()
                   end if
                end if

             end do   ! end of g loop

          call CLMDebug('surfrd--mark8')

       ! Error check: glacier, lake, wetland, urban sum must be less than 100

       found = .false.
          do g=begg,endg
             sumscl = pctlak(g)+pctwet(g)+pcturb(g)+pctgla(g)
             if (sumscl > 100.+1.e-04) then
                found = .true.
                iindx = ilx
                jindx = jlx
                exit
             end if
          if (found) exit
       end do
       if ( found ) then
          write(6,*)'surfrd error: PFT cover>100 for g=',ilx,jlx
          call endrun()
       end if

       ! Error check that urban parameterization is not yet finished

#ifndef TESTZACK
       found = .false.
          do g=begg,endg
             if (pcturb(g) /= 0.) then
                found = .true.
                iindx = ilx
                jindx = jlx
                exit
             end if
          if (found) exit
       end do
       if ( found ) then
          write (6,*)'surfrd error: urban parameterization not implemented at g= ',ilx,jlx
          call endrun()
       end if
#endif

    ! Determine array [veg], which sets the PFT for each of the [maxpatch]
    ! patches and array [wt], which sets the relative abundance of the PFT.
    ! Fill in PFTs for vegetated portion of grid cell. Fractional areas for
    ! these points [pctpft] pertain to "vegetated" area not to total grid area.
    ! So need to adjust them for fraction of grid that is vegetated.
    ! Next, fill in urban, lake, wetland, and glacier patches.

    vegxy(:,:) = 0
    wtxy(:,:)  = 0.
       do g=begg,endg
          if (lndmsk == 1) then
             sumscl = pcturb(g)+pctlak(g)+pctwet(g)+pctgla(g)
             do m = 1, maxpatch_pft
!ylu changed according to CLM4
#ifdef CNDV 
             if (create_crop_landunit) then ! been through surfrd_wtxy_veg_all
                if (crop(m-1) == 0) then    ! so update natural vegetation only
                   wtxy(g,m) = 0._r8       ! crops should have values >= 0.
               end if
            else                   ! not been through surfrd_wtxy_veg_all
               wtxy(g,m) = 0._r8  ! so update all vegetation
               vegxy(g,m) = m - 1 ! 0 (bare ground) to maxpatch_pft-1 (= 16)
            end if
!!!       
   call CLMDebug('surfrd--mark8')

!                vegxy(g,m) = noveg !spinup initialization
!                wtxy(g,m) = 1.0/maxpatch_pft * (100.-sumscl)/100.
#else
                vegxy(g,m) = pft(g,m)
                wtxy(g,m) = pctpft_lunit(g,m) * (100.-sumscl)/10000.
#endif
             end do
             vegxy(g,npatch_urban) = noveg
             wtxy(g,npatch_urban) = pcturb(g)/100.
             vegxy(g,npatch_lake)  = noveg
             wtxy(g,npatch_lake)  = pctlak(g)/100.
             vegxy(g,npatch_wet)   = noveg
             wtxy(g,npatch_wet)   = pctwet(g)/100.
             vegxy(g,npatch_glacier) = noveg
             wtxy(g,npatch_glacier) = pctgla(g)/100.

             do m = 1,maxpatch_cft
#ifdef DGVM
                   vegxy(g,npatch_glacier+m) = noveg ! currently assume crop=0 if DGVM mode
                   wtxy(g,npatch_glacier+m)= 0.
#else
                   vegxy(g,npatch_glacier+m) = cft(g,m)
                   wtxy(g,npatch_glacier+m)= pctcft_lunit(g,m) * (100.-sumscl)/10000.
#endif
            end do
          end if
    end do

    found = .false.
    sumvec(:) = abs(sum(wtxy,dim=2)-1.)
      do g=begg,endg
          if (sumvec(g) > 1.e-06 .and. lndmsk==1) then
             found = .true.
             iindx = ilx
             jindx = jlx
             exit
          endif
       if (found) exit
    end do
    if ( found ) then
       write (6,*)'surfrd error: WT > 1 or <1  occurs at g= ',iindx,jindx
       call endrun()
    end if
          call CLMDebug('surfrd done')


    deallocate(sumvec)
    deallocate(cft)
    deallocate(pft)
    deallocate(pctcft_lunit)
    deallocate(pctpft_lunit)
    deallocate(pctpft)


  end subroutine surfrd

end module surfFileMod

module SNICARMod

!-----------------------------------------------------------------------
!BOP
!
! !MODULE: SNICARMod
!
! !DESCRIPTION:
! Calculate albedo of snow containing impurities 
! and the evolution of snow effective radius
!
! !USES:
  use shr_kind_mod  , only : r8 => shr_kind_r8
  use shr_const_mod , only : SHR_CONST_RHOICE
  use clm_varcon, only: ss_alb_bc1,asm_prm_bc1,ext_cff_mss_bc1,ss_alb_bc2,asm_prm_bc2,ext_cff_mss_bc2&
                        ,ss_alb_oc1,asm_prm_oc1,ext_cff_mss_oc1,ss_alb_oc2,asm_prm_oc2,ext_cff_mss_oc2&
                        ,ss_alb_dst1,asm_prm_dst1,ext_cff_mss_dst1,ss_alb_dst2,asm_prm_dst2,ext_cff_mss_dst2 &
                        ,ss_alb_dst3,asm_prm_dst3,ext_cff_mss_dst3,ss_alb_dst4,asm_prm_dst4,ext_cff_mss_dst4 & 
                        ,ss_alb_snw_drc,asm_prm_snw_drc,ext_cff_mss_snw_drc,ss_alb_snw_dfs,asm_prm_snw_dfs &
                        ,ext_cff_mss_snw_dfs,snowage_tau,snowage_kappa,snowage_drdt0 &
                        ,xx_ss_alb_snw_drc        &
                        ,xx_asm_prm_snw_drc       &
                        ,xx_ext_cff_mss_snw_drc   &
                        ,xx_ss_alb_snw_dfs        &
                        ,xx_asm_prm_snw_dfs       &
                        ,xx_ext_cff_mss_snw_dfs   &
                        ,xx_snowage_tau           &
                        ,xx_snowage_kappa         &
                        ,xx_snowage_drdt0         &
                        ,idx_Mie_snw_mx           &
                        ,idx_T_max                &
                        ,idx_Tgrd_max             &
                        ,idx_rhos_max             &
                        ,numrad_snw

  implicit none
  save
!
! !PUBLIC MEMBER FUNCTIONS:
  public :: SNICAR_RT        ! Snow albedo and vertically-resolved solar absorption
  public :: SnowAge_grain    ! Snow effective grain size evolution
!
! !PUBLIC DATA MEMBERS:

  real(r8), public, parameter :: snw_rds_min = 54.526_r8  ! minimum allowed snow effective radius (also "fresh snow" value) [microns]
  integer,  public, parameter :: sno_nbr_aer =   8        ! number of aerosol species in snowpack (indices described above) [nbr]
  logical,  public, parameter :: DO_SNO_OC =    .false.   ! parameter to include organic carbon (OC) in snowpack radiative calculations
  logical,  public, parameter :: DO_SNO_AER =   .true.    ! parameter to include aerosols in snowpack radiative calculations

  real(r8), public, parameter :: scvng_fct_mlt_bcphi = 0.20_r8   ! scavenging factor for hydrophillic BC inclusion in meltwater [frc]
  real(r8), public, parameter :: scvng_fct_mlt_bcpho = 0.03_r8   ! scavenging factor for hydrophobic BC inclusion in meltwater [frc]
  real(r8), public, parameter :: scvng_fct_mlt_ocphi = 0.20_r8   ! scavenging factor for hydrophillic OC inclusion in meltwater [frc]
  real(r8), public, parameter :: scvng_fct_mlt_ocpho = 0.03_r8   ! scavenging factor for hydrophobic OC inclusion in meltwater [frc]
  real(r8), public, parameter :: scvng_fct_mlt_dst1  = 0.02_r8   ! scavenging factor for dust species 1 inclusion in meltwater [frc]
  real(r8), public, parameter :: scvng_fct_mlt_dst2  = 0.02_r8   ! scavenging factor for dust species 2 inclusion in meltwater [frc]
  real(r8), public, parameter :: scvng_fct_mlt_dst3  = 0.01_r8   ! scavenging factor for dust species 3 inclusion in meltwater [frc]
  real(r8), public, parameter :: scvng_fct_mlt_dst4  = 0.01_r8   ! scavenging factor for dust species 4 inclusion in meltwater [frc]

! !PRIVATE MEMBER FUNCTIONS:

!
! !PRIVATE DATA MEMBERS:
  ! Aerosol species indices:
  !  1= hydrophillic black carbon 
  !  2= hydrophobic black carbon
  !  3= hydrophilic organic carbon
  !  4= hydrophobic organic carbon
  !  5= dust species 1
  !  6= dust species 2
  !  7= dust species 3
  !  8= dust species 4
  integer,  parameter :: nir_bnd_bgn =   2               ! first band index in near-IR spectrum [idx]
  integer,  parameter :: nir_bnd_end =   5               ! ending near-IR band index [idx]

  integer,  parameter :: idx_T_min      = 1              ! minimum temperature index used in aging lookup table [idx]
  integer,  parameter :: idx_Tgrd_min   = 1              ! minimum temperature gradient index used in aging lookup table [idx]
  integer,  parameter :: idx_rhos_min   = 1              ! minimum snow density index used in aging lookup table [idx]

  integer,  parameter :: snw_rds_max_tbl = 1500          ! maximum effective radius defined in Mie lookup table [microns]
  integer,  parameter :: snw_rds_min_tbl = 30            ! minimium effective radius defined in Mie lookup table [microns]
  real(r8), parameter :: snw_rds_max     = 1500._r8      ! maximum allowed snow effective radius [microns]
  real(r8), parameter :: snw_rds_refrz   = 1000._r8      ! effective radius of re-frozen snow [microns]

  real(r8), parameter :: min_snw = 1.0E-30_r8            ! minimum snow mass required for SNICAR RT calculation [kg m-2]

  !real(r8), parameter :: C1_liq_Brun89 = 1.28E-17_r8    ! constant for liquid water grain growth [m3 s-1], from Brun89
  real(r8), parameter :: C1_liq_Brun89 = 0._r8           ! constant for liquid water grain growth [m3 s-1], from Brun89: zeroed to accomodate dry snow aging
  real(r8), parameter :: C2_liq_Brun89 = 4.22E-13_r8     ! constant for liquid water grain growth [m3 s-1], from Brun89: corrected for LWC in units of percent

  real(r8), parameter :: tim_cns_bc_rmv  = 2.2E-8_r8     ! time constant for removal of BC in snow on sea-ice [s-1] (50% mass removal/year)
  real(r8), parameter :: tim_cns_oc_rmv  = 2.2E-8_r8     ! time constant for removal of OC in snow on sea-ice [s-1] (50% mass removal/year)
  real(r8), parameter :: tim_cns_dst_rmv = 2.2E-8_r8     ! time constant for removal of dust in snow on sea-ice [s-1] (50% mass removal/year)

  ! scaling of the snow aging rate (tuning option):
  logical :: flg_snoage_scl    = .false.                 ! flag for scaling the snow aging rate by some arbitrary factor
  real(r8), parameter :: xdrdt = 1.0_r8                  ! arbitrary factor applied to snow aging rate

 
!
! !REVISION HISTORY:
! Created by Mark Flanner
!
!EOP
!-----------------------------------------------------------------------

contains

!-----------------------------------------------------------------------
!BOP
!
! !IROUTINE: SNICAR_RT
!
!
! !CALLED FROM:
! subroutine SurfaceAlbedo in module SurfaceAlbedoMod (CLM)
! subroutine albice (CSIM)
!
! !REVISION HISTORY:
! Author: Mark Flanner
!
! !INTERFACE:
  
  subroutine SNICAR_RT (flg_snw_ice, lbc, ubc, num_nourbanc, filter_nourbanc,  &
                        coszen, flg_slr_in, h2osno_liq, h2osno_ice, snw_rds,   &
                        mss_cnc_aer_in, albsfc, albout, flx_abs)

    !
    ! !DESCRIPTION:
    ! Determine reflectance of, and vertically-resolved solar absorption in, 
    ! snow with impurities.
    !
    ! Original references on physical models of snow reflectance include: 
    ! Wiscombe and Warren [1980] and Warren and Wiscombe [1980],
    ! Journal of Atmospheric Sciences, 37,
    !
    ! The multi-layer solution for multiple-scattering used here is from:
    ! Toon et al. [1989], Rapid calculation of radiative heating rates 
    ! and photodissociation rates in inhomogeneous multiple scattering atmospheres, 
    ! J. Geophys. Res., 94, D13, 16287-16301
    !
    ! The implementation of the SNICAR model in CLM/CSIM is described in:
    ! Flanner, M., C. Zender, J. Randerson, and P. Rasch [2007], 
    ! Present-day climate forcing and response from black carbon in snow,
    ! J. Geophys. Res., 112, D11202, doi: 10.1029/2006JD008003

    
    ! !USES:
    use clmtype
    use clm_varpar       , only : nlevsno, numrad
    use shr_const_mod    , only : SHR_CONST_PI
    use globals          , only : nstep

    !
    ! !ARGUMENTS:
    implicit none
    integer , intent(in)  :: flg_snw_ice                          ! flag: =1 when called from CLM, =2 when called from CSIM
    integer , intent(in)  :: lbc, ubc                             ! column index bounds [unitless]
    integer , intent(in)  :: num_nourbanc                         ! number of columns in non-urban filter
    integer , intent(in)  :: filter_nourbanc(ubc-lbc+1)           ! column filter for non-urban points
    real(r8), intent(in)  :: coszen(lbc:ubc)                      ! cosine of solar zenith angle for next time step (col) [unitless]
    integer , intent(in)  :: flg_slr_in                           ! flag: =1 for direct-beam incident flux, =2 for diffuse incident flux
    real(r8), intent(in)  :: h2osno_liq(lbc:ubc,-nlevsno+1:0)     ! liquid water content (col,lyr) [kg/m2]
    real(r8), intent(in)  :: h2osno_ice(lbc:ubc,-nlevsno+1:0)     ! ice content (col,lyr) [kg/m2]
    integer,  intent(in)  :: snw_rds(lbc:ubc,-nlevsno+1:0)        ! snow effective radius (col,lyr) [microns, m^-6]
    real(r8), intent(in)  :: mss_cnc_aer_in(lbc:ubc,-nlevsno+1:0,sno_nbr_aer)  ! mass concentration of all aerosol species (col,lyr,aer) [kg/kg]
    real(r8), intent(in)  :: albsfc(lbc:ubc,numrad)               ! albedo of surface underlying snow (col,bnd) [frc]
    real(r8), intent(out) :: albout(lbc:ubc,numrad)               ! snow albedo, averaged into 2 bands (=0 if no sun or no snow) (col,bnd) [frc]
    real(r8), intent(out) :: flx_abs(lbc:ubc,-nlevsno+1:1,numrad) ! absorbed flux in each layer per unit flux incident on top of snowpack (col,lyr,bnd) [frc]

    !
    ! !LOCAL VARIABLES:
    !
    ! local pointers to implicit in arguments
    !
    integer,  pointer :: snl(:)              ! negative number of snow layers (col) [nbr]
    real(r8), pointer :: h2osno(:)           ! snow liquid water equivalent (col) [kg/m2]   
    integer,  pointer :: clandunit(:)        ! corresponding landunit of column (col) [idx] (debugging only)
    integer,  pointer :: cgridcell(:)        ! columns's gridcell index (col) [idx] (debugging only)
    integer,  pointer :: ltype(:)            ! landunit type (lnd) (debugging only)
    real(r8), pointer :: londeg(:)           ! longitude (degrees) (debugging only)
    real(r8), pointer :: latdeg(:)           ! latitude (degrees) (debugging only)
!
! !OTHER LOCAL VARIABLES:
!EOP
!-----------------------------------------------------------------------
    !
    ! variables for snow radiative transfer calculations

    ! Local variables representing single-column values of arrays:
    integer :: snl_lcl                            ! negative number of snow layers [nbr]
    integer :: snw_rds_lcl(-nlevsno+1:0)          ! snow effective radius [m^-6]
    real(r8):: flx_slrd_lcl(1:numrad_snw)         ! direct beam incident irradiance [W/m2] (set to 1)
    real(r8):: flx_slri_lcl(1:numrad_snw)         ! diffuse incident irradiance [W/m2] (set to 1)
    real(r8):: mss_cnc_aer_lcl(-nlevsno+1:0,1:sno_nbr_aer) ! aerosol mass concentration (lyr,aer_nbr) [kg/kg]
    real(r8):: h2osno_lcl                         ! total column snow mass [kg/m2]
    real(r8):: h2osno_liq_lcl(-nlevsno+1:0)       ! liquid water mass [kg/m2]
    real(r8):: h2osno_ice_lcl(-nlevsno+1:0)       ! ice mass [kg/m2]
    real(r8):: albsfc_lcl(1:numrad_snw)           ! albedo of underlying surface [frc]
    real(r8):: ss_alb_snw_lcl(-nlevsno+1:0)       ! single-scatter albedo of ice grains (lyr) [frc]
    real(r8):: asm_prm_snw_lcl(-nlevsno+1:0)      ! asymmetry parameter of ice grains (lyr) [frc]
    real(r8):: ext_cff_mss_snw_lcl(-nlevsno+1:0)  ! mass extinction coefficient of ice grains (lyr) [m2/kg]
    real(r8):: ss_alb_aer_lcl(sno_nbr_aer)        ! single-scatter albedo of aerosol species (aer_nbr) [frc] 
    real(r8):: asm_prm_aer_lcl(sno_nbr_aer)       ! asymmetry parameter of aerosol species (aer_nbr) [frc]
    real(r8):: ext_cff_mss_aer_lcl(sno_nbr_aer)   ! mass extinction coefficient of aerosol species (aer_nbr) [m2/kg]


    ! Other local variables
    integer :: APRX_TYP                           ! two-stream approximation type (1=Eddington, 2=Quadrature, 3=Hemispheric Mean) [nbr]
    integer :: DELTA                              ! flag to use Delta approximation (Joseph, 1976) (1= use, 0= don't use)
    real(r8):: flx_wgt(1:numrad_snw)              ! weights applied to spectral bands, specific to direct and diffuse cases (bnd) [frc]
   
    integer :: flg_nosnl                          ! flag: =1 if there is snow, but zero snow layers, =0 if at least 1 snow layer [flg]   
    integer :: trip                               ! flag: =1 to redo RT calculation if result is unrealistic
    integer :: flg_dover                          ! defines conditions for RT redo (explained below)

    real(r8):: albedo                             ! temporary snow albedo [frc]
    real(r8):: flx_sum                            ! temporary summation variable for NIR weighting
    real(r8):: albout_lcl(numrad_snw)             ! snow albedo by band [frc]
    real(r8):: flx_abs_lcl(-nlevsno+1:1,numrad_snw)! absorbed flux per unit incident flux at top of snowpack (lyr,bnd) [frc]
 
    real(r8):: L_snw(-nlevsno+1:0)                ! h2o mass (liquid+solid) in snow layer (lyr) [kg/m2]
    real(r8):: tau_snw(-nlevsno+1:0)              ! snow optical depth (lyr) [unitless]
    real(r8):: L_aer(-nlevsno+1:0,sno_nbr_aer)    ! aerosol mass in snow layer (lyr,nbr_aer) [kg/m2] 
    real(r8):: tau_aer(-nlevsno+1:0,sno_nbr_aer)  ! aerosol optical depth (lyr,nbr_aer) [unitless]
    real(r8):: tau_sum                            ! cumulative (snow+aerosol) optical depth [unitless]
    real(r8):: tau_clm(-nlevsno+1:0)              ! column optical depth from layer bottom to snowpack top (lyr) [unitless] 
    real(r8):: omega_sum                          ! temporary summation of single-scatter albedo of all aerosols [frc]
    real(r8):: g_sum                              ! temporary summation of asymmetry parameter of all aerosols [frc]

    real(r8):: tau(-nlevsno+1:0)                  ! weighted optical depth of snow+aerosol layer (lyr) [unitless]
    real(r8):: omega(-nlevsno+1:0)                ! weighted single-scatter albedo of snow+aerosol layer (lyr) [frc]
    real(r8):: g(-nlevsno+1:0)                    ! weighted asymmetry parameter of snow+aerosol layer (lyr) [frc]
    real(r8):: tau_star(-nlevsno+1:0)             ! transformed (i.e. Delta-Eddington) optical depth of snow+aerosol layer (lyr) [unitless]
    real(r8):: omega_star(-nlevsno+1:0)           ! transformed (i.e. Delta-Eddington) SSA of snow+aerosol layer (lyr) [frc]
    real(r8):: g_star(-nlevsno+1:0)               ! transformed (i.e. Delta-Eddington) asymmetry paramater of snow+aerosol layer (lyr) [frc]
   
    integer :: g_idx, c_idx, l_idx                ! gridcell, column, and landunit indices [idx]
    integer :: bnd_idx                            ! spectral band index (1 <= bnd_idx <= numrad_snw) [idx]
    integer :: rds_idx                            ! snow effective radius index for retrieving Mie parameters from lookup table [idx]
    integer :: snl_btm                            ! index of bottom snow layer (0) [idx]
    integer :: snl_top                            ! index of top snow layer (-4 to 0) [idx]
    integer :: fc                                 ! column filter index
    integer :: i                                  ! layer index [idx]
    integer :: j                                  ! aerosol number index [idx]
    integer :: n                                  ! tridiagonal matrix index [idx]
    integer :: m                                  ! secondary layer index [idx]
    integer :: ix,k                               ! an index
   
    real(r8):: F_direct(-nlevsno+1:0)             ! direct-beam radiation at bottom of layer interface (lyr) [W/m^2]
    real(r8):: F_net(-nlevsno+1:0)                ! net radiative flux at bottom of layer interface (lyr) [W/m^2]
    real(r8):: F_abs(-nlevsno+1:0)                ! net absorbed radiative energy (lyr) [W/m^2]
    real(r8):: F_abs_sum                          ! total absorbed energy in column [W/m^2]
    real(r8):: F_sfc_pls                          ! upward radiative flux at snowpack top [W/m^2]
    real(r8):: F_btm_net                          ! net flux at bottom of snowpack [W/m^2]                    
    real(r8):: F_sfc_net                          ! net flux at top of snowpack [W/m^2]
    real(r8):: energy_sum                         ! sum of all energy terms; should be 0.0 [W/m^2]
    real(r8):: F_direct_btm                       ! direct-beam radiation at bottom of snowpack [W/m^2]
    real(r8):: mu_not                             ! cosine of solar zenith angle (used locally) [frc]

    integer :: err_idx                            ! counter for number of times through error loop [nbr]
    real(r8):: lat_coord                          ! gridcell latitude (debugging only)
    real(r8):: lon_coord                          ! gridcell longitude (debugging only)
    integer :: sfctype                            ! underlying surface type (debugging only)
    real(r8):: pi                                 ! 3.1415...


    ! intermediate variables for radiative transfer approximation:
    real(r8):: gamma1(-nlevsno+1:0)               ! two-stream coefficient from Toon et al. (lyr) [unitless]
    real(r8):: gamma2(-nlevsno+1:0)               ! two-stream coefficient from Toon et al. (lyr) [unitless]
    real(r8):: gamma3(-nlevsno+1:0)               ! two-stream coefficient from Toon et al. (lyr) [unitless]
    real(r8):: gamma4(-nlevsno+1:0)               ! two-stream coefficient from Toon et al. (lyr) [unitless]
    real(r8):: lambda(-nlevsno+1:0)               ! two-stream coefficient from Toon et al. (lyr) [unitless]
    real(r8):: GAMMA(-nlevsno+1:0)                ! two-stream coefficient from Toon et al. (lyr) [unitless]
    real(r8):: mu_one                             ! two-stream coefficient from Toon et al. (lyr) [unitless]
    real(r8):: e1(-nlevsno+1:0)                   ! tri-diag intermediate variable from Toon et al. (lyr) 
    real(r8):: e2(-nlevsno+1:0)                   ! tri-diag intermediate variable from Toon et al. (lyr) 
    real(r8):: e3(-nlevsno+1:0)                   ! tri-diag intermediate variable from Toon et al. (lyr) 
    real(r8):: e4(-nlevsno+1:0)                   ! tri-diag intermediate variable from Toon et al. (lyr) 
    real(r8):: C_pls_btm(-nlevsno+1:0)            ! intermediate variable: upward flux at bottom interface (lyr) [W/m2]
    real(r8):: C_mns_btm(-nlevsno+1:0)            ! intermediate variable: downward flux at bottom interface (lyr) [W/m2]
    real(r8):: C_pls_top(-nlevsno+1:0)            ! intermediate variable: upward flux at top interface (lyr) [W/m2]
    real(r8):: C_mns_top(-nlevsno+1:0)            ! intermediate variable: downward flux at top interface (lyr) [W/m2]
    real(r8):: A(-2*nlevsno+1:0)                  ! tri-diag intermediate variable from Toon et al. (2*lyr)
    real(r8):: B(-2*nlevsno+1:0)                  ! tri-diag intermediate variable from Toon et al. (2*lyr)
    real(r8):: D(-2*nlevsno+1:0)                  ! tri-diag intermediate variable from Toon et al. (2*lyr)
    real(r8):: E(-2*nlevsno+1:0)                  ! tri-diag intermediate variable from Toon et al. (2*lyr)
    real(r8):: AS(-2*nlevsno+1:0)                 ! tri-diag intermediate variable from Toon et al. (2*lyr)
    real(r8):: DS(-2*nlevsno+1:0)                 ! tri-diag intermediate variable from Toon et al. (2*lyr)
    real(r8):: X(-2*nlevsno+1:0)                  ! tri-diag intermediate variable from Toon et al. (2*lyr)
    real(r8):: Y(-2*nlevsno+1:0)                  ! tri-diag intermediate variable from Toon et al. (2*lyr)


    ! Assign local pointers to derived subtypes components (column-level)
    ! (CLM-specific)
    if (flg_snw_ice == 1) then
       snl            => clm3%g%l%c%cps%snl
       h2osno         => clm3%g%l%c%cws%h2osno
       clandunit      => clm3%g%l%c%landunit  ! (debug only)
       cgridcell      => clm3%g%l%c%gridcell  ! (debug only)
       ltype          => clm3%g%l%itype       ! (debug only)
       londeg         => clm3%g%londeg        ! (debug only)
       latdeg         => clm3%g%latdeg        ! (debug only)
    endif

  ix = 0
  do i=1, idx_Mie_snw_mx
  do j=1, numrad_snw
    ix = ix+1
    ss_alb_snw_drc(i,j)        = xx_ss_alb_snw_drc(ix)
    asm_prm_snw_drc(i,j)       = xx_asm_prm_snw_drc(ix)
    ext_cff_mss_snw_drc(i,j)   = xx_ext_cff_mss_snw_drc(ix)
    ss_alb_snw_dfs(i,j)        = xx_ss_alb_snw_dfs(ix)
    asm_prm_snw_dfs(i,j)       = xx_asm_prm_snw_dfs(ix)
    ext_cff_mss_snw_dfs(i,j)   = xx_ext_cff_mss_snw_dfs(ix)
  end do
  end do


 ix = 0
 do i=1,idx_T_max
 do j=1,idx_Tgrd_max
 do k=1,idx_rhos_max
    ix = ix + 1
    snowage_tau(i,j,k)   = xx_snowage_tau(ix)
    snowage_kappa(i,j,k) = xx_snowage_kappa(ix)
    snowage_drdt0(i,j,k) = xx_snowage_drdt0(ix)
 end do
 end do
 end do

 
    ! Define constants
    pi = SHR_CONST_PI

    ! always use Delta approximation for snow
    DELTA = 1


    ! Loop over all non-urban columns
    ! (when called from CSIM, there is only one column)
    do fc = 1,num_nourbanc
       c_idx = filter_nourbanc(fc)


       ! Zero absorbed radiative fluxes:
       do i=-nlevsno+1,1,1
          flx_abs_lcl(:,:)   = 0._r8
          flx_abs(c_idx,i,:) = 0._r8
       enddo
       
       ! set snow/ice mass to be used for RT:
       if (flg_snw_ice == 1) then
          h2osno_lcl = h2osno(c_idx)
       else
          h2osno_lcl = h2osno_ice(c_idx,0)
       endif


       ! Qualifier for computing snow RT: 
       !  1) sunlight from atmosphere model 
       !  2) minimum amount of snow on ground. 
       !     Otherwise, set snow albedo to zero
       if ((coszen(c_idx) > 0._r8) .and. (h2osno_lcl > min_snw)) then     

          ! Set variables specific to CLM
          if (flg_snw_ice == 1) then
             ! Assign local (single-column) variables to global values
             ! If there is snow, but zero snow layers, we must create a layer locally.
             ! This layer is presumed to have the fresh snow effective radius.
             if (snl(c_idx) > -1) then
                flg_nosnl         =  1
                snl_lcl           =  -1
                h2osno_ice_lcl(0) =  h2osno_lcl
                h2osno_liq_lcl(0) =  0._r8
                snw_rds_lcl(0)    =  nint(snw_rds_min)
             else
                flg_nosnl         =  0
                snl_lcl           =  snl(c_idx)
                h2osno_liq_lcl(:) =  h2osno_liq(c_idx,:)
                h2osno_ice_lcl(:) =  h2osno_ice(c_idx,:)
                snw_rds_lcl(:)    =  snw_rds(c_idx,:)
             endif
            
             snl_btm   = 0
             snl_top   = snl_lcl+1


             ! for debugging only
             l_idx     = clandunit(c_idx)
             g_idx     = cgridcell(c_idx)
             sfctype   = ltype(l_idx)
             lat_coord = latdeg(g_idx)
             lon_coord = londeg(g_idx)


          ! Set variables specific to CSIM
          else
             flg_nosnl         = 0
             snl_lcl           = -1
             h2osno_liq_lcl(:) = h2osno_liq(c_idx,:)
             h2osno_ice_lcl(:) = h2osno_ice(c_idx,:)
             snw_rds_lcl(:)    = snw_rds(c_idx,:)
             snl_btm           = 0
             snl_top           = 0
             sfctype           = -1
             lat_coord         = -90
             lon_coord         = 0
          endif

          ! Set local aerosol array
          do j=1,sno_nbr_aer
             mss_cnc_aer_lcl(:,j) = mss_cnc_aer_in(c_idx,:,j)
          enddo


          ! Set spectral underlying surface albedos to their corresponding VIS or NIR albedos
          albsfc_lcl(1)                       = albsfc(c_idx,1)
          albsfc_lcl(nir_bnd_bgn:nir_bnd_end) = albsfc(c_idx,2)


          ! Error check for snow grain size:
          do i=snl_top,snl_btm,1
             if ((snw_rds_lcl(i) < snw_rds_min_tbl) .or. (snw_rds_lcl(i) > snw_rds_max_tbl)) then
                write (6,*) "SNICAR ERROR: snow grain radius of ", snw_rds_lcl(i), " out of bounds."
                write (6,*) "NSTEP= ", nstep
                write (6,*) "flg_snw_ice= ", flg_snw_ice
                write (6,*) "column: ", c_idx, " level: ", i, " snl(c)= ", snl_lcl
                write (6,*) "lat= ", lat_coord, " lon= ", lon_coord
                write (6,*) "h2osno(c)= ", h2osno_lcl
                call endrun()
             endif
          enddo

          ! Incident flux weighting parameters
          !  - sum of all VIS bands must equal 1
          !  - sum of all NIR bands must equal 1
          !
          ! Spectral bands (5-band case)
          !  Band 1: 0.3-0.7um (VIS)
          !  Band 2: 0.7-1.0um (NIR)
          !  Band 3: 1.0-1.2um (NIR)
          !  Band 4: 1.2-1.5um (NIR)
          !  Band 5: 1.5-5.0um (NIR)
          !
          ! The following weights are appropriate for surface-incident flux in a mid-latitude winter atmosphere
          !
          ! 3-band weights
          if (numrad_snw==3) then
             ! Direct:
             if (flg_slr_in == 1) then
                flx_wgt(1) = 1._r8
                flx_wgt(2) = 0.66628670195247_r8
                flx_wgt(3) = 0.33371329804753_r8
             ! Diffuse:
             elseif (flg_slr_in == 2) then
                flx_wgt(1) = 1._r8
                flx_wgt(2) = 0.77887652162877_r8
                flx_wgt(3) = 0.22112347837123_r8
             endif

          ! 5-band weights
          elseif(numrad_snw==5) then
             ! Direct:
             if (flg_slr_in == 1) then
                flx_wgt(1) = 1._r8
                flx_wgt(2) = 0.49352158521175_r8
                flx_wgt(3) = 0.18099494230665_r8
                flx_wgt(4) = 0.12094898498813_r8
                flx_wgt(5) = 0.20453448749347_r8
             ! Diffuse:
             elseif (flg_slr_in == 2) then
                flx_wgt(1) = 1._r8
                flx_wgt(2) = 0.58581507618433_r8
                flx_wgt(3) = 0.20156903770812_r8
                flx_wgt(4) = 0.10917889346386_r8
                flx_wgt(5) = 0.10343699264369_r8
             endif
          endif

          ! Loop over snow spectral bands
          do bnd_idx = 1,numrad_snw

             mu_not    = coszen(c_idx)  ! must set here, because of error handling
             flg_dover = 1              ! default is to redo
             err_idx   = 0              ! number of times through loop

             do while (flg_dover > 0)

                ! DEFAULT APPROXIMATIONS:
                !  VIS:       Delta-Eddington
                !  NIR (all): Delta-Hemispheric Mean
                !  WARNING:   DO NOT USE DELTA-EDDINGTON FOR NIR DIFFUSE - this sometimes results in negative albedo
                !  
                ! ERROR CONDITIONS:
                !  Conditions which cause "trip", resulting in redo of RT approximation:
                !   1. negative absorbed flux
                !   2. total absorbed flux greater than incident flux
                !   3. negative albedo
                !   NOTE: These errors have only been encountered in spectral bands 4 and 5
                !
                ! ERROR HANDLING
                !  1st error (flg_dover=2): switch approximation (Edd->HM or HM->Edd)
                !  2nd error (flg_dover=3): change zenith angle by 0.02 (this happens about 1 in 10^6 cases)
                !  3rd error (flg_dover=4): switch approximation with new zenith
                !  Subsequent errors: repeatedly change zenith and approximations...
              
                if (bnd_idx == 1) then
                   if (flg_dover == 2) then
                      APRX_TYP = 3
                   elseif (flg_dover == 3) then
                      APRX_TYP = 1
                      if (coszen(c_idx) > 0.5_r8) then
                         mu_not = mu_not - 0.02_r8
                      else
                         mu_not = mu_not + 0.02_r8
                      endif
                   elseif (flg_dover == 4) then
                      APRX_TYP = 3
                   else
                      APRX_TYP = 1
                   endif
                   
                else
                   if (flg_dover == 2) then
                      APRX_TYP = 1
                   elseif (flg_dover == 3) then
                      APRX_TYP = 3
                      if (coszen(c_idx) > 0.5_r8) then
                         mu_not = mu_not - 0.02_r8
                      else
                         mu_not = mu_not + 0.02_r8
                      endif
                   elseif (flg_dover == 4) then
                      APRX_TYP = 1
                   else
                      APRX_TYP = 3
                   endif

                endif

                ! Set direct or diffuse incident irradiance to 1
                ! (This has to be within the bnd loop because mu_not is adjusted in rare cases)
                if (flg_slr_in == 1) then
                   flx_slrd_lcl(bnd_idx) = 1._r8/(mu_not*pi) ! this corresponds to incident irradiance of 1.0
                   flx_slri_lcl(bnd_idx) = 0._r8
                else
                   flx_slrd_lcl(bnd_idx) = 0._r8
                   flx_slri_lcl(bnd_idx) = 1._r8
                endif

                ! Pre-emptive error handling: aerosols can reap havoc on these absorptive bands.
                ! Since extremely high soot concentrations have a negligible effect on these bands, zero them.
                if ( (numrad_snw == 5).and.((bnd_idx == 5).or.(bnd_idx == 4)) ) then
                   mss_cnc_aer_lcl(:,:) = 0._r8
                endif

                if ( (numrad_snw == 3).and.(bnd_idx == 3) ) then
                   mss_cnc_aer_lcl(:,:) = 0._r8
                endif

                ! Define local Mie parameters based on snow grain size and aerosol species,
                !  retrieved from a lookup table.
                if (flg_slr_in == 1) then
                   do i=snl_top,snl_btm,1
                      rds_idx = snw_rds_lcl(i) - snw_rds_min_tbl + 1
                      ! snow optical properties (direct radiation)
                      ss_alb_snw_lcl(i)      = ss_alb_snw_drc(rds_idx,bnd_idx)
                      asm_prm_snw_lcl(i)     = asm_prm_snw_drc(rds_idx,bnd_idx)
                      ext_cff_mss_snw_lcl(i) = ext_cff_mss_snw_drc(rds_idx,bnd_idx)
                     
                   enddo
                elseif (flg_slr_in == 2) then
                   do i=snl_top,snl_btm,1
                      rds_idx = snw_rds_lcl(i) - snw_rds_min_tbl + 1
                      ! snow optical properties (diffuse radiation)
                      ss_alb_snw_lcl(i)      = ss_alb_snw_dfs(rds_idx,bnd_idx)
                      asm_prm_snw_lcl(i)     = asm_prm_snw_dfs(rds_idx,bnd_idx)
                      ext_cff_mss_snw_lcl(i) = ext_cff_mss_snw_dfs(rds_idx,bnd_idx)
                   enddo
                endif
              
     
                ! aerosol species 1 optical properties
                ss_alb_aer_lcl(1)        = ss_alb_bc1(1,bnd_idx)      
                asm_prm_aer_lcl(1)       = asm_prm_bc1(1,bnd_idx)
                ext_cff_mss_aer_lcl(1)   = ext_cff_mss_bc1(1,bnd_idx)
                
                ! aerosol species 2 optical properties
                ss_alb_aer_lcl(2)        = ss_alb_bc2(1,bnd_idx)      
                asm_prm_aer_lcl(2)       = asm_prm_bc2(1,bnd_idx)
                ext_cff_mss_aer_lcl(2)   = ext_cff_mss_bc2(1,bnd_idx)
                
                ! aerosol species 3 optical properties
                ss_alb_aer_lcl(3)        = ss_alb_oc1(1,bnd_idx)      
                asm_prm_aer_lcl(3)       = asm_prm_oc1(1,bnd_idx)
                ext_cff_mss_aer_lcl(3)   = ext_cff_mss_oc1(1,bnd_idx)
                
                ! aerosol species 4 optical properties
                ss_alb_aer_lcl(4)        = ss_alb_oc2(1,bnd_idx)      
                asm_prm_aer_lcl(4)       = asm_prm_oc2(1,bnd_idx)
                ext_cff_mss_aer_lcl(4)   = ext_cff_mss_oc2(1,bnd_idx)

                ! aerosol species 5 optical properties
                ss_alb_aer_lcl(5)        = ss_alb_dst1(1,bnd_idx)      
                asm_prm_aer_lcl(5)       = asm_prm_dst1(1,bnd_idx)
                ext_cff_mss_aer_lcl(5)   = ext_cff_mss_dst1(1,bnd_idx)
                
                ! aerosol species 6 optical properties
                ss_alb_aer_lcl(6)        = ss_alb_dst2(1,bnd_idx)      
                asm_prm_aer_lcl(6)       = asm_prm_dst2(1,bnd_idx)
                ext_cff_mss_aer_lcl(6)   = ext_cff_mss_dst2(1,bnd_idx)
                
                ! aerosol species 7 optical properties
                ss_alb_aer_lcl(7)        = ss_alb_dst3(1,bnd_idx)      
                asm_prm_aer_lcl(7)       = asm_prm_dst3(1,bnd_idx)
                ext_cff_mss_aer_lcl(7)   = ext_cff_mss_dst3(1,bnd_idx)
                
                ! aerosol species 8 optical properties
                ss_alb_aer_lcl(8)        = ss_alb_dst4(1,bnd_idx)      
                asm_prm_aer_lcl(8)       = asm_prm_dst4(1,bnd_idx)
                ext_cff_mss_aer_lcl(8)   = ext_cff_mss_dst4(1,bnd_idx)
                

                ! 1. snow and aerosol layer column mass (L_snw, L_aer [kg/m^2])
                ! 2. optical Depths (tau_snw, tau_aer)
                ! 3. weighted Mie properties (tau, omega, g)

                ! Weighted Mie parameters of each layer
                do i=snl_top,snl_btm,1
                   L_snw(i)   = h2osno_ice_lcl(i)+h2osno_liq_lcl(i)

                   tau_snw(i) = L_snw(i)*ext_cff_mss_snw_lcl(i)

                   do j=1,sno_nbr_aer
                      L_aer(i,j)   = L_snw(i)*mss_cnc_aer_lcl(i,j)
                      tau_aer(i,j) = L_aer(i,j)*ext_cff_mss_aer_lcl(j)
                   enddo

                   tau_sum   = 0._r8
                   omega_sum = 0._r8
                   g_sum     = 0._r8
  
                   do j=1,sno_nbr_aer
                      tau_sum    = tau_sum + tau_aer(i,j) 
                      omega_sum  = omega_sum + (tau_aer(i,j)*ss_alb_aer_lcl(j))
                      g_sum      = g_sum + (tau_aer(i,j)*ss_alb_aer_lcl(j)*asm_prm_aer_lcl(j))
                   enddo

                   tau(i)    = tau_sum + tau_snw(i)
                   if(tau(i) == 0) then
                      write(6,*) 'FATAL ERROR in SNICAR RT, tau(',i,') is the denominatoer can not equal to ',tau(i)
                       call endrun()
                   end if

                   omega(i)  = (1/tau(i))*(omega_sum+(ss_alb_snw_lcl(i)*tau_snw(i)))
                   g(i)      = (1/(tau(i)*omega(i)))*(g_sum+ (asm_prm_snw_lcl(i)*ss_alb_snw_lcl(i)*tau_snw(i)))
                enddo

                ! DELTA transformations, if requested
                if (DELTA == 1) then
                   do i=snl_top,snl_btm,1
                      g_star(i)     = g(i)/(1+g(i))
                      omega_star(i) = ((1-(g(i)**2))*omega(i)) / (1-(omega(i)*(g(i)**2)))
                      tau_star(i)   = (1-(omega(i)*(g(i)**2)))*tau(i)
                   enddo
                else
                   do i=snl_top,snl_btm,1
                      g_star(i)     = g(i)
                      omega_star(i) = omega(i)
                      tau_star(i)   = tau(i)
                   enddo
                endif

                ! Total column optical depth:
                ! tau_clm(i) = total optical depth above the bottom of layer i
                tau_clm(snl_top) = 0._r8
                do i=snl_top+1,snl_btm,1
                   tau_clm(i) = tau_clm(i-1)+tau_star(i-1)
                enddo

                ! Direct radiation at bottom of snowpack:
                F_direct_btm = albsfc_lcl(bnd_idx)*mu_not*exp(-(tau_clm(snl_btm)+tau_star(snl_btm))/mu_not)*pi*flx_slrd_lcl(bnd_idx)

                ! Intermediates
                ! Gamma values are approximation-specific.

                ! Eddington
                if (APRX_TYP==1) then
                   do i=snl_top,snl_btm,1
                      gamma1(i) = (7-(omega_star(i)*(4+(3*g_star(i)))))/4
                      gamma2(i) = -(1-(omega_star(i)*(4-(3*g_star(i)))))/4
                      gamma3(i) = (2-(3*g_star(i)*mu_not))/4
                      gamma4(i) = 1-gamma3(i)
                      mu_one    = 0.5
                   enddo
                   
                ! Quadrature
                elseif (APRX_TYP==2) then
                   do i=snl_top,snl_btm,1
                      gamma1(i) = (3**0.5)*(2-(omega_star(i)*(1+g_star(i))))/2
                      gamma2(i) = omega_star(i)*(3**0.5)*(1-g_star(i))/2
                      gamma3(i) = (1-((3**0.5)*g_star(i)*mu_not))/2
                      gamma4(i) = 1-gamma3(i)
                      mu_one    = 1/(3**0.5)
                   enddo

                ! Hemispheric Mean
                elseif (APRX_TYP==3) then
                   do i=snl_top,snl_btm,1
                      gamma1(i) = 2 - (omega_star(i)*(1+g_star(i)))
                      gamma2(i) = omega_star(i)*(1-g_star(i))
                      gamma3(i) = (1-((3**0.5)*g_star(i)*mu_not))/2
                      gamma4(i) = 1-gamma3(i)
                      mu_one    = 0.5
                   enddo
                endif

                ! Intermediates for tri-diagonal solution
                do i=snl_top,snl_btm,1
                   lambda(i) = sqrt(abs((gamma1(i)**2) - (gamma2(i)**2)))
                   GAMMA(i)  = gamma2(i)/(gamma1(i)+lambda(i))

                   e1(i)     = 1+(GAMMA(i)*exp(-lambda(i)*tau_star(i)))
                   e2(i)     = 1-(GAMMA(i)*exp(-lambda(i)*tau_star(i)))
                   e3(i)     = GAMMA(i) + exp(-lambda(i)*tau_star(i))
                   e4(i)     = GAMMA(i) - exp(-lambda(i)*tau_star(i))
                enddo !enddo over snow layers


                ! Intermediates for tri-diagonal solution
                do i=snl_top,snl_btm,1
                   if (flg_slr_in == 1) then

                      C_pls_btm(i) = (omega_star(i)*pi*flx_slrd_lcl(bnd_idx)* &
                                     exp(-(tau_clm(i)+tau_star(i))/mu_not)*   &
                                     (((gamma1(i)-(1/mu_not))*gamma3(i))+     &
                                     (gamma4(i)*gamma2(i))))/((lambda(i)**2)-(1/(mu_not**2)))

                      C_mns_btm(i) = (omega_star(i)*pi*flx_slrd_lcl(bnd_idx)* &
                                     exp(-(tau_clm(i)+tau_star(i))/mu_not)*   &
                                     (((gamma1(i)+(1/mu_not))*gamma4(i))+     &
                                     (gamma2(i)*gamma3(i))))/((lambda(i)**2)-(1/(mu_not**2)))

                      C_pls_top(i) = (omega_star(i)*pi*flx_slrd_lcl(bnd_idx)* &
                                     exp(-tau_clm(i)/mu_not)*(((gamma1(i)-(1/mu_not))* &
                                     gamma3(i))+(gamma4(i)*gamma2(i))))/((lambda(i)**2)-(1/(mu_not**2)))

                      C_mns_top(i) = (omega_star(i)*pi*flx_slrd_lcl(bnd_idx)* &
                                     exp(-tau_clm(i)/mu_not)*(((gamma1(i)+(1/mu_not))* &
                                     gamma4(i))+(gamma2(i)*gamma3(i))))/((lambda(i)**2)-(1/(mu_not**2)))

                   else
                      C_pls_btm(i) = 0._r8
                      C_mns_btm(i) = 0._r8
                      C_pls_top(i) = 0._r8
                      C_mns_top(i) = 0._r8
                   endif
                enddo

                ! Coefficients for tridiaganol matrix solution
                do i=2*snl_lcl+1,0,1

                   !Boundary values for i=1 and i=2*snl_lcl, specifics for i=odd and i=even    
                   if (i==(2*snl_lcl+1)) then
                      A(i) = 0
                      B(i) = e1(snl_top)
                      D(i) = -e2(snl_top)
                      E(i) = flx_slri_lcl(bnd_idx)-C_mns_top(snl_top)

                   elseif(i==0) then
                      A(i) = e1(snl_btm)-(albsfc_lcl(bnd_idx)*e3(snl_btm))
                      B(i) = e2(snl_btm)-(albsfc_lcl(bnd_idx)*e4(snl_btm))
                      D(i) = 0
                      E(i) = F_direct_btm-C_pls_btm(snl_btm)+(albsfc_lcl(bnd_idx)*C_mns_btm(snl_btm))

                   elseif(mod(i,2)==-1) then   ! If odd and i>=3 (n=1 for i=3)
                      n=floor(i/2.0)
                      A(i) = (e2(n)*e3(n))-(e4(n)*e1(n))
                      B(i) = (e1(n)*e1(n+1))-(e3(n)*e3(n+1))
                      D(i) = (e3(n)*e4(n+1))-(e1(n)*e2(n+1))
                      E(i) = (e3(n)*(C_pls_top(n+1)-C_pls_btm(n)))+(e1(n)*(C_mns_btm(n)-C_mns_top(n+1)))

                   elseif(mod(i,2)==0) then    ! If even and i<=2*snl_lcl
                      n=(i/2)
                      A(i) = (e2(n+1)*e1(n))-(e3(n)*e4(n+1))
                      B(i) = (e2(n)*e2(n+1))-(e4(n)*e4(n+1))
                      D(i) = (e1(n+1)*e4(n+1))-(e2(n+1)*e3(n+1))
                      E(i) = (e2(n+1)*(C_pls_top(n+1)-C_pls_btm(n)))+(e4(n+1)*(C_mns_top(n+1)-C_mns_btm(n))) 
                   endif
                enddo

                AS(0) = A(0)/B(0)
                DS(0) = E(0)/B(0)

                do i=-1,(2*snl_lcl+1),-1
                   X(i)  = 1/(B(i)-(D(i)*AS(i+1)))
                   AS(i) = A(i)*X(i)
                   DS(i) = (E(i)-(D(i)*DS(i+1)))*X(i)
                enddo

                Y(2*snl_lcl+1) = DS(2*snl_lcl+1)
                do i=(2*snl_lcl+2),0,1
                   Y(i) = DS(i)-(AS(i)*Y(i-1))
                enddo

                ! Downward direct-beam and net flux (F_net) at the base of each layer:
                do i=snl_top,snl_btm,1
                   F_direct(i) = mu_not*pi*flx_slrd_lcl(bnd_idx)*exp(-(tau_clm(i)+tau_star(i))/mu_not)
                   F_net(i)    = (Y(2*i-1)*(e1(i)-e3(i))) + (Y(2*i)*(e2(i)-e4(i))) + &
                                 C_pls_btm(i) - C_mns_btm(i) - F_direct(i)
                enddo

                ! Upward flux at snowpack top:
                F_sfc_pls = (Y(2*snl_lcl+1)*(exp(-lambda(snl_top)*tau_star(snl_top))+ &
                            GAMMA(snl_top))) + (Y(2*snl_lcl+2)*(exp(-lambda(snl_top)* &
                            tau_star(snl_top))-GAMMA(snl_top))) + C_pls_top(snl_top)

                ! Net flux at bottom = absorbed radiation by underlying surface:
                F_btm_net = -F_net(snl_btm)


                ! Bulk column albedo and surface net flux
                albedo    = F_sfc_pls/((mu_not*pi*flx_slrd_lcl(bnd_idx))+flx_slri_lcl(bnd_idx))
                F_sfc_net = F_sfc_pls - ((mu_not*pi*flx_slrd_lcl(bnd_idx))+flx_slri_lcl(bnd_idx))

                trip = 0
                ! Absorbed flux in each layer
                do i=snl_top,snl_btm,1
                   if(i==snl_top) then
                      F_abs(i) = F_net(i)-F_sfc_net
                   else
                      F_abs(i) = F_net(i)-F_net(i-1)
                   endif
                   flx_abs_lcl(i,bnd_idx) = F_abs(i)
                  
          
                   ! ERROR check: negative absorption
                   if (flx_abs_lcl(i,bnd_idx) < -0.00001) then
                      trip = 1
                   endif
                enddo
                
                flx_abs_lcl(1,bnd_idx) = F_btm_net
             
                if (flg_nosnl == 1) then
                   ! If there are no snow layers (but still snow), all absorbed energy must be in top soil layer
                   !flx_abs_lcl(:,bnd_idx) = 0._r8
                   !flx_abs_lcl(1,bnd_idx) = F_abs(0) + F_btm_net

                   ! changed on 20070408:
                   ! OK to put absorbed energy in the fictitous snow layer because routine SurfaceRadiation
                   ! handles the case of no snow layers. Then, if a snow layer is addded between now and
                   ! SurfaceRadiation (called in Hydrology1), absorbed energy will be properly distributed.
                   flx_abs_lcl(0,bnd_idx) = F_abs(0)
                   flx_abs_lcl(1,bnd_idx) = F_btm_net
                endif
                
                !Underflow check (we've already tripped the error condition above)
                do i=snl_top,1,1
                   if (flx_abs_lcl(i,bnd_idx) < 0._r8) then
                      flx_abs_lcl(i,bnd_idx) = 0._r8
                   endif
                enddo

                F_abs_sum = 0._r8
                do i=snl_top,snl_btm,1
                   F_abs_sum = F_abs_sum + F_abs(i)
                enddo


                !ERROR check: absorption greater than incident flux
                ! (should make condition more generic than "1._r8")
                if (F_abs_sum > 1._r8) then
                   trip = 1
                endif

                !ERROR check:
                if ((albedo < 0._r8).and.(trip==0)) then
                   write(6,*) 'ERROR: albedo <0 = ', albedo
                   trip = 1
                endif
                
                ! Set conditions for redoing RT calculation 
                if ((trip == 1).and.(flg_dover == 1)) then
                   flg_dover = 2
                elseif ((trip == 1).and.(flg_dover == 2)) then
                   flg_dover = 3
                elseif ((trip == 1).and.(flg_dover == 3)) then
                   flg_dover = 4
                elseif((trip == 1).and.(flg_dover == 4).and.(err_idx < 20)) then
                   flg_dover = 3
                   err_idx = err_idx + 1
                   write(6,*) "SNICAR WARNING: Both approximations failed with new zenith angle :(. Zenith= ", mu_not, &
                                  " called from: ", flg_snw_ice, " flg_slr= ", flg_slr_in, " bnd= ", bnd_idx, " Moving the sun..."
                elseif((trip == 1).and.(flg_dover == 4).and.(err_idx >= 20)) then
                   flg_dover = 0
                   write(6,*) "SNICAR ERROR: FOUND A WORMHOLE. STUCK IN INFINITE LOOP! Called from: ", flg_snw_ice
                   write(6,*) "SNICAR STATS: snw_rds(0)= ", snw_rds(c_idx,0)
                   write(6,*) "SNICAR STATS: L_snw(0)= ", L_snw(0)
                   write(6,*) "SNICAR STATS: h2osno= ", h2osno_lcl, " snl= ", snl_lcl
                   write(6,*) "SNICAR STATS: soot1(0)= ", mss_cnc_aer_lcl(0,1)
                   write(6,*) "SNICAR STATS: soot2(0)= ", mss_cnc_aer_lcl(0,2)
                   write(6,*) "SNICAR STATS: dust1(0)= ", mss_cnc_aer_lcl(0,3)
                   write(6,*) "SNICAR STATS: dust2(0)= ", mss_cnc_aer_lcl(0,4)
                   write(6,*) "SNICAR STATS: dust3(0)= ", mss_cnc_aer_lcl(0,5)
                   write(6,*) "SNICAR STATS: dust4(0)= ", mss_cnc_aer_lcl(0,6)
                  
                   call endrun()
                else
                   flg_dover = 0
                endif

             enddo !enddo while (flg_dover > 0)
             
             ! Energy conservation check:
             ! Incident direct+diffuse radiation equals (absorbed+bulk_transmitted+bulk_reflected)
             energy_sum = (mu_not*pi*flx_slrd_lcl(bnd_idx)) + flx_slri_lcl(bnd_idx) - (F_abs_sum + F_btm_net + F_sfc_pls)
             if (abs(energy_sum) > 0.00001_r8) then
                write (6,"(a,e12.6,a,i6,a,i6)") "SNICAR ERROR: Energy conservation error of : ", energy_sum, &
                             " at timestep: ", nstep, " at column: ", c_idx
                call endrun()
             endif

             albout_lcl(bnd_idx) = albedo


             ! Check that albedo is less than 1
             if (albout_lcl(bnd_idx) > 1.0) then

                write (6,*) "SNICAR ERROR: Albedo > 1.0 at c: ", c_idx, " NSTEP= ",nstep
                write (6,*) "SNICAR STATS: bnd_idx= ",bnd_idx
                write (6,*) "SNICAR STATS: albout_lcl(bnd)= ",albout_lcl(bnd_idx), " albsfc_lcl(bnd_idx)= ",albsfc_lcl(bnd_idx)
                write (6,*) "SNICAR STATS: landtype= ", sfctype
                write (6,*) "SNICAR STATS: h2osno= ", h2osno_lcl, " snl= ", snl_lcl
                write (6,*) "SNICAR STATS: coszen= ", coszen(c_idx), " flg_slr= ", flg_slr_in

                write (6,*) "SNICAR STATS: soot(-4)= ", mss_cnc_aer_lcl(-4,1)
                write (6,*) "SNICAR STATS: soot(-3)= ", mss_cnc_aer_lcl(-3,1)
                write (6,*) "SNICAR STATS: soot(-2)= ", mss_cnc_aer_lcl(-2,1)
                write (6,*) "SNICAR STATS: soot(-1)= ", mss_cnc_aer_lcl(-1,1)
                write (6,*) "SNICAR STATS: soot(0)= ", mss_cnc_aer_lcl(0,1)

                write (6,*) "SNICAR STATS: L_snw(-4)= ", L_snw(-4)
                write (6,*) "SNICAR STATS: L_snw(-3)= ", L_snw(-3)
                write (6,*) "SNICAR STATS: L_snw(-2)= ", L_snw(-2)
                write (6,*) "SNICAR STATS: L_snw(-1)= ", L_snw(-1)
                write (6,*) "SNICAR STATS: L_snw(0)= ", L_snw(0)

                write (6,*) "SNICAR STATS: snw_rds(-4)= ", snw_rds(c_idx,-4)
                write (6,*) "SNICAR STATS: snw_rds(-3)= ", snw_rds(c_idx,-3)
                write (6,*) "SNICAR STATS: snw_rds(-2)= ", snw_rds(c_idx,-2)
                write (6,*) "SNICAR STATS: snw_rds(-1)= ", snw_rds(c_idx,-1)
                write (6,*) "SNICAR STATS: snw_rds(0)= ", snw_rds(c_idx,0)
                
                call endrun()
             endif
             
          enddo   ! loop over wvl bands


          ! Weight output NIR albedo appropriately
          albout(c_idx,1) = albout_lcl(1)
          flx_sum         = 0._r8
          do bnd_idx= nir_bnd_bgn,nir_bnd_end
             flx_sum = flx_sum + flx_wgt(bnd_idx)*albout_lcl(bnd_idx)
          end do
          albout(c_idx,2) = flx_sum / sum(flx_wgt(nir_bnd_bgn:nir_bnd_end))

          ! Weight output NIR absorbed layer fluxes (flx_abs) appropriately
          flx_abs(c_idx,:,1) = flx_abs_lcl(:,1)
          do i=snl_top,1,1
             flx_sum = 0._r8
             do bnd_idx= nir_bnd_bgn,nir_bnd_end
                flx_sum = flx_sum + flx_wgt(bnd_idx)*flx_abs_lcl(i,bnd_idx)
             enddo
             flx_abs(c_idx,i,2) = flx_sum / sum(flx_wgt(nir_bnd_bgn:nir_bnd_end))          
          end do


          ! Write diagnostics, if desired. (default is to not compile this)
#if 0
             write(6,*) "SNICAR STATS: NSTEP= ", nstep
             write(6,*) "SNICAR STATS: Col: ", c_idx
             write(6,*) "SNICAR STATS: snl(c)= ",snl_lcl
             write(6,*) "SNICAR STATS: cosine zenith= ", coszen(c_idx)
             write(6,*) "SNICAR STATS: h2osno(c): ", h2osno_lcl

             write(6,*) "SNICAR STATS: albout_lcl(1): ", albout_lcl(1)
             write(6,*) "SNICAR STATS: albout_lcl(2): ", albout_lcl(2)
             write(6,*) "SNICAR STATS: albout_lcl(3): ", albout_lcl(3)
             write(6,*) "SNICAR STATS: albout_lcl(4): ", albout_lcl(4) 
             write(6,*) "SNICAR STATS: albout_lcl(5): ", albout_lcl(5)
             write(6,*) "SNICAR STATS: albout(1): ", albout(c_idx,1)
             write(6,*) "SNICAR STATS: albout(2): ", albout(c_idx,2)

             write(6,*) "SNICAR STATS: NIR flx_abs(-4): ", flx_abs(c_idx,-4,2)
             write(6,*) "SNICAR STATS: NIR flx_abs(-3): ", flx_abs(c_idx,-3,2)
             write(6,*) "SNICAR STATS: NIR flx_abs(-2): ", flx_abs(c_idx,-2,2)
             write(6,*) "SNICAR STATS: NIR flx_abs(-1): ", flx_abs(c_idx,-1,2) 
             write(6,*) "SNICAR STATS: NIR flx_abs(0): ", flx_abs(c_idx,0,2)

             write(6,*) "SNICAR STATS: TOPLYR ABS, BND 1= ", flx_abs_lcl(snl_top,1)
             write(6,*) "SNICAR STATS: TOPLYR ABS, BND 2= ", flx_abs_lcl(snl_top,2)
             write(6,*) "SNICAR STATS: TOPLYR ABS, BND 3= ", flx_abs_lcl(snl_top,3)
             write(6,*) "SNICAR STATS: TOPLYR ABS, BND 4= ", flx_abs_lcl(snl_top,4)
             write(6,*) "SNICAR STATS: TOPLYR ABS, BND 5= ", flx_abs_lcl(snl_top,5)

             write (6,*) "SNICAR STATS: L_snw(-4)= ", L_snw(-4)
             write (6,*) "SNICAR STATS: L_snw(-3)= ", L_snw(-3)
             write (6,*) "SNICAR STATS: L_snw(-2)= ", L_snw(-2)
             write (6,*) "SNICAR STATS: L_snw(-1)= ", L_snw(-1)
             write (6,*) "SNICAR STATS: L_snw(0)= ", L_snw(0)

             write (6,*) "SNICAR STATS: snw_rds(-4)= ", snw_rds(c_idx,-4)
             write (6,*) "SNICAR STATS: snw_rds(-3)= ", snw_rds(c_idx,-3)
             write (6,*) "SNICAR STATS: snw_rds(-2)= ", snw_rds(c_idx,-2)
             write (6,*) "SNICAR STATS: snw_rds(-1)= ", snw_rds(c_idx,-1)
             write (6,*) "SNICAR STATS: snw_rds(0)= ", snw_rds(c_idx,0)
#endif

       ! If snow < minimum_snow, but > 0, and there is sun, set albedo to underlying surface albedo
       elseif ( (coszen(c_idx) > 0._r8) .and. (h2osno_lcl < min_snw) .and. (h2osno_lcl > 0._r8) ) then
          albout(c_idx,1) = albsfc(c_idx,1)
          albout(c_idx,2) = albsfc(c_idx,2)

       ! There is either zero snow, or no sun
       else
          albout(c_idx,1) = 0._r8
          albout(c_idx,2) = 0._r8
       endif    ! if column has snow and coszen > 0

    enddo    ! loop over all columns


  end subroutine SNICAR_RT


!-----------------------------------------------------------------------
!BOP
!
! !IROUTINE: SnowAge_grain
!
! !INTERFACE:
  subroutine SnowAge_grain(lbc, ubc, num_snowc, filter_snowc, num_nosnowc, filter_nosnowc)
    !
    ! !DESCRIPTION:
    ! Updates the snow effective grain size (radius). 
    ! Contributions to grain size evolution are from:
    !   1. vapor redistribution (dry snow) 
    !   2. liquid water redistribution (wet snow)
    !   3. re-freezing of liquid water
    ! 
    ! Vapor redistribution: Method is to retrieve 3 best-bit parameters that
    ! depend on snow temperature, temperature gradient, and density,
    ! that are derived from the microphysical model described in: 
    ! Flanner and Zender (2006), Linking snowpack microphysics and albedo
    ! evolution, J. Geophys. Res., 111, D12208, doi:10.1029/2005JD006834. 
    ! The parametric equation has the form: 
    ! dr/dt = drdt_0*(tau/(dr_fresh+tau))^(1/kappa), where:
    !   r is the effective radius,
    !   tau and kappa are best-fit parameters,
    !   drdt_0 is the initial rate of change of effective radius, and
    !   dr_fresh is the difference between the current and fresh snow states 
    !  (r_current - r_fresh).
    !
    ! Liquid water redistribution: Apply the grain growth function from:
    !   Brun, E. (1989), Investigation of wet-snow metamorphism in respect of 
    !   liquid-water content, Annals of Glaciology, 13, 22-26.
    !   There are two parameters that describe the grain growth rate as 
    !   a function of snow liquid water content (LWC). The "LWC=0" parameter
    !   is zeroed here because we are accounting for dry snowing with a 
    !   different representation
    !
    ! Re-freezing of liquid water: Assume that re-frozen liquid water clumps
    !   into an arbitrarily large effective grain size (snw_rds_refrz). 
    !   The phenomenon is observed (Grenfell), but so far unquantified, as far as 
    !   I am aware.
    !
    !
    ! !USES:
    use clmtype
    use clm_varpar       , only : nlevsno
    use clm_varcon       , only : spval
    use shr_const_mod    , only : SHR_CONST_RHOICE, SHR_CONST_PI
    use globals          , only : dtime
    !
    ! !ARGUMENTS:
    implicit none
    integer, intent(in) :: lbc, ubc                  ! column bounds
    integer, intent(in) :: num_snowc                 ! number of column snow points in column filter
    integer, intent(in) :: filter_snowc(ubc-lbc+1)   ! column filter for snow points
    integer, intent(in) :: num_nosnowc               ! number of column non-snow points in column filter
    integer, intent(in) :: filter_nosnowc(ubc-lbc+1) ! column filter for non-snow points
    !
    !
    ! !CALLED FROM: clm_driver1
    !

    ! !LOCAL VARIABLES:
    !
    ! local pointers to implicit arguments
    !

    real(r8), pointer :: t_soisno(:,:)         ! soil and snow temperature (col,lyr) [K]
    integer,  pointer :: snl(:)                ! negative number of snow layers (col) [nbr]
    real(r8), pointer :: t_grnd(:)             ! ground temperature (col) [K]
    real(r8), pointer :: dz(:,:)               ! layer thickness (col,lyr) [m]
    real(r8), pointer :: h2osno(:)             ! snow water (col) [mm H2O]
    real(r8), pointer :: snw_rds(:,:)          ! effective grain radius (col,lyr) [microns, m-6]
    real(r8), pointer :: snw_rds_top(:)        ! effective grain radius, top layer (col) [microns, m-6]
    real(r8), pointer :: sno_liq_top(:)        ! liquid water fraction (mass) in top snow layer (col) [frc]
    real(r8), pointer :: h2osoi_liq(:,:)       ! liquid water content (col,lyr) [kg m-2]
    real(r8), pointer :: h2osoi_ice(:,:)       ! ice content (col,lyr) [kg m-2]
    real(r8), pointer :: snot_top(:)           ! snow temperature in top layer (col) [K]
    real(r8), pointer :: dTdz_top(:)           ! temperature gradient in top layer (col) [K m-1]
    real(r8), pointer :: qflx_snow_grnd_col(:) ! snow on ground after interception (col) [kg m-2 s-1]
    real(r8), pointer :: qflx_snwcp_ice(:)     ! excess precipitation due to snow capping [kg m-2 s-1]
    real(r8), pointer :: qflx_snofrz_lyr(:,:)  ! snow freezing rate (col,lyr) [kg m-2 s-1]
    logical , pointer :: do_capsnow(:)         ! true => do snow capping
 
    !
    ! !OTHER LOCAL VARIABLES:
    !
    integer :: snl_top                      ! top snow layer index [idx]
    integer :: snl_btm                      ! bottom snow layer index [idx]
    integer :: i                            ! layer index [idx]
    integer :: c_idx                        ! column index [idx]
    integer :: fc                           ! snow column filter index [idx]
    integer :: T_idx                        ! snow aging lookup table temperature index [idx]
    integer :: Tgrd_idx                     ! snow aging lookup table temperature gradient index [idx]
    integer :: rhos_idx                     ! snow aging lookup table snow density index [idx]
    real(r8) :: t_snotop                    ! temperature at upper layer boundary [K]
    real(r8) :: t_snobtm                    ! temperature at lower layer boundary [K]
    real(r8) :: dTdz(lbc:ubc,-nlevsno:0)    ! snow temperature gradient (col,lyr) [K m-1]
    real(r8) :: bst_tau                     ! snow aging parameter retrieved from lookup table [hour]
    real(r8) :: bst_kappa                   ! snow aging parameter retrieved from lookup table [unitless]
    real(r8) :: bst_drdt0                   ! snow aging parameter retrieved from lookup table [um hr-1]
    real(r8) :: dr                          ! incremental change in snow effective radius [um]
    real(r8) :: dr_wet                      ! incremental change in snow effective radius from wet growth [um]
    real(r8) :: dr_fresh                    ! difference between fresh snow r_e and current r_e [um]
    real(r8) :: newsnow                     ! fresh snowfall [kg m-2]
    real(r8) :: refrzsnow                   ! re-frozen snow [kg m-2]
    real(r8) :: frc_newsnow                 ! fraction of layer mass that is new snow [frc]
    real(r8) :: frc_oldsnow                 ! fraction of layer mass that is old snow [frc]
    real(r8) :: frc_refrz                   ! fraction of layer mass that is re-frozen snow [frc]
    real(r8) :: frc_liq                     ! fraction of layer mass that is liquid water[frc]    
    real(r8) :: rhos                        ! snow density [kg m-3]
    real(r8) :: h2osno_lyr                  ! liquid + solid H2O in snow layer [kg m-2]


    ! Assign local pointers to derived subtypes components (column-level)
    t_soisno           => clm3%g%l%c%ces%t_soisno
    snl                => clm3%g%l%c%cps%snl
    t_grnd             => clm3%g%l%c%ces%t_grnd
    dz                 => clm3%g%l%c%cps%dz
    h2osno             => clm3%g%l%c%cws%h2osno
    snw_rds            => clm3%g%l%c%cps%snw_rds
    h2osoi_liq         => clm3%g%l%c%cws%h2osoi_liq
    h2osoi_ice         => clm3%g%l%c%cws%h2osoi_ice
    snot_top           => clm3%g%l%c%cps%snot_top
    dTdz_top           => clm3%g%l%c%cps%dTdz_top
    snw_rds_top        => clm3%g%l%c%cps%snw_rds_top
    sno_liq_top        => clm3%g%l%c%cps%sno_liq_top
    qflx_snow_grnd_col => clm3%g%l%c%cwf%pwf_a%qflx_snow_grnd
    qflx_snwcp_ice     => clm3%g%l%c%cwf%pwf_a%qflx_snwcp_ice
    qflx_snofrz_lyr    => clm3%g%l%c%cwf%qflx_snofrz_lyr
    do_capsnow         => clm3%g%l%c%cps%do_capsnow
  


    ! loop over columns that have at least one snow layer
    do fc = 1, num_snowc
       c_idx = filter_snowc(fc)

       snl_btm = 0
       snl_top = snl(c_idx) + 1

       ! loop over snow layers
       do i=snl_top,snl_btm,1
          !
          !**********  1. DRY SNOW AGING  ***********
          !
          h2osno_lyr = h2osoi_liq(c_idx,i) + h2osoi_ice(c_idx,i)

          ! temperature gradient
          if (i == snl_top) then 
             ! top layer
             t_snotop = t_grnd(c_idx)
             t_snobtm = (t_soisno(c_idx,i+1)*dz(c_idx,i) + t_soisno(c_idx,i)*dz(c_idx,i+1)) / (dz(c_idx,i)+dz(c_idx,i+1))
          else
             t_snotop = (t_soisno(c_idx,i-1)*dz(c_idx,i) + t_soisno(c_idx,i)*dz(c_idx,i-1)) / (dz(c_idx,i)+dz(c_idx,i-1))
             t_snobtm = (t_soisno(c_idx,i+1)*dz(c_idx,i) + t_soisno(c_idx,i)*dz(c_idx,i+1)) / (dz(c_idx,i)+dz(c_idx,i+1))
          endif
          
          dTdz(c_idx,i) = abs((t_snotop - t_snobtm) / dz(c_idx,i))
          
          ! snow density
          rhos = (h2osoi_liq(c_idx,i)+h2osoi_ice(c_idx,i)) / dz(c_idx,i)

          ! best-fit table indecies
          T_idx    = nint((t_soisno(c_idx,i)-223) / 5) + 1
          Tgrd_idx = nint(dTdz(c_idx,i) / 10) + 1
          rhos_idx = nint((rhos-50) / 50) + 1

          ! boundary check:
          if (T_idx < idx_T_min) then 
             T_idx = idx_T_min
          endif
          if (T_idx > idx_T_max) then 
             T_idx = idx_T_max
          endif
          if (Tgrd_idx < idx_Tgrd_min) then 
             Tgrd_idx = idx_Tgrd_min
          endif
          if (Tgrd_idx > idx_Tgrd_max) then 
             Tgrd_idx = idx_Tgrd_max
          endif
          if (rhos_idx < idx_rhos_min) then 
             rhos_idx = idx_rhos_min
          endif
          if (rhos_idx > idx_rhos_max) then 
             rhos_idx = idx_rhos_max
          endif
             
          ! best-fit parameters
          bst_tau   = snowage_tau(T_idx,Tgrd_idx,rhos_idx)
          bst_kappa = snowage_kappa(T_idx,Tgrd_idx,rhos_idx)     
          bst_drdt0 = snowage_drdt0(T_idx,Tgrd_idx,rhos_idx)

          ! change in snow effective radius, using best-fit parameters
          dr_fresh = snw_rds(c_idx,i)-snw_rds_min
          dr = (bst_drdt0*(bst_tau/(dr_fresh+bst_tau))**(1/bst_kappa)) * (dtime/3600)

          !
          !**********  2. WET SNOW AGING  ***********
          !
          ! We are assuming wet and dry evolution occur simultaneously, and 
          ! the contributions from both can be summed. 
          ! This is justified by setting the linear offset constant C1_liq_Brun89 to zero [Brun, 1989]
          
          ! liquid water faction
          frc_liq = min(0.1_r8, (h2osoi_liq(c_idx,i) / (h2osoi_liq(c_idx,i)+h2osoi_ice(c_idx,i))))

          !dr_wet = 1E6_r8*(dtime*(C1_liq_Brun89 + C2_liq_Brun89*(frc_liq**(3))) / (4*SHR_CONST_PI*(snw_rds(c_idx,i)/1E6)**(2)))
          !simplified, units of microns:
          dr_wet = 1E18_r8*(dtime*(C2_liq_Brun89*(frc_liq**(3))) / (4*SHR_CONST_PI*snw_rds(c_idx,i)**(2)))

          dr = dr + dr_wet
    
          !
          !**********  3. SNOWAGE SCALING (TURNED OFF BY DEFAULT)  *************
          !
          ! Multiply rate of change of effective radius by some constant, xdrdt
          if (flg_snoage_scl) then
             dr = dr*xdrdt
          endif

          
          !
          !**********  4. INCREMENT EFFECTIVE RADIUS, ACCOUNTING FOR:  ***********
          !               DRY AGING
          !               WET AGING
          !               FRESH SNOW
          !               RE-FREEZING
          !
          ! new snowfall [kg/m2]
          if (do_capsnow(c_idx)) then
             newsnow = max(0._r8, (qflx_snwcp_ice(c_idx)*dtime))
          else
             newsnow = max(0._r8, (qflx_snow_grnd_col(c_idx)*dtime))
          endif

          ! snow that has re-frozen [kg/m2]
          refrzsnow = max(0._r8, (qflx_snofrz_lyr(c_idx,i)*dtime))
          
          ! fraction of layer mass that is re-frozen
          frc_refrz = refrzsnow / h2osno_lyr
                  
          ! fraction of layer mass that is new snow
          if (i == snl_top) then
             frc_newsnow = newsnow / h2osno_lyr
          else
             frc_newsnow = 0._r8
          endif

          if ((frc_refrz + frc_newsnow) > 1._r8) then
             frc_refrz = frc_refrz / (frc_refrz + frc_newsnow)
             frc_newsnow = 1._r8 - frc_refrz
             frc_oldsnow = 0._r8
          else
             frc_oldsnow = 1._r8 - frc_refrz - frc_newsnow
          endif

          ! mass-weighted mean of fresh snow, old snow, and re-frozen snow effective radius
          snw_rds(c_idx,i) = (snw_rds(c_idx,i)+dr)*frc_oldsnow + snw_rds_min*frc_newsnow + snw_rds_refrz*frc_refrz

             
          !
          !**********  5. CHECK BOUNDARIES   ***********
          !
          ! boundary check
          if (snw_rds(c_idx,i) < snw_rds_min) then
             snw_rds(c_idx,i) = snw_rds_min
          endif

          if (snw_rds(c_idx,i) > snw_rds_max) then
             snw_rds(c_idx,i) = snw_rds_max
          end if

          ! set top layer variables for history files
          if (i == snl_top) then
             snot_top(c_idx)    = t_soisno(c_idx,i)
             dTdz_top(c_idx)    = dTdz(c_idx,i)
             snw_rds_top(c_idx) = snw_rds(c_idx,i)
             sno_liq_top(c_idx) = h2osoi_liq(c_idx,i) / (h2osoi_liq(c_idx,i)+h2osoi_ice(c_idx,i))
          endif

       enddo
    enddo

    ! Special case: snow on ground, but not enough to have defined a snow layer:
    !   set snw_rds to fresh snow grain size:
    do fc = 1, num_nosnowc
       c_idx = filter_nosnowc(fc)
       if (h2osno(c_idx) > 0._r8) then
          snw_rds(c_idx,0) = snw_rds_min
       endif
    enddo
        
  end subroutine SnowAge_grain

!--------------------------------------------------------------------------------------------------
!ylu removed SnowOptics_init,SnowAge_init, all vars defined in clm_varcon, and some will read in
!table in clmi
!--------------------------------------------------------------------------------------------------



end module SNICARMod
!-----------------------------------------------------------------------
!BOP
!
! !IROUTINE: mkarbinit
!
! !INTERFACE:
subroutine mkarbinit(snlx   ,snowdpx ,   dzclmx  ,zclmx      ,&
                  ziclmx    ,h2osnox ,h2osoi_liqx,h2osoi_icex,t_grndx,&
                  t_soisnox ,t_lakex ,t_vegx    ,h2ocanx ,h2ocan_colx,&
                  h2osoi_volx,t_ref2mx,snw_rdsx &
#ifdef CN
                   ,tlaix,tsaix,htopx,hbotx &
#endif
)

! !DESCRIPTION:
! Initializes the following time varying variables:
! water      : h2osno, h2ocan, h2osoi_liq, h2osoi_ice, h2osoi_vol
! snow       : snowdp, snowage, snl, dz, z, zi
! temperature: t_soisno, t_veg, t_grnd
! The variable, h2osoi_vol, is needed by clm_soilalb -this is not needed on
! restart since it is computed before the soil albedo computation is called.
! The remaining variables are initialized by calls to ecosystem dynamics
! and albedo subroutines.
!
! !USES:
  use shr_kind_mod , only : r8 => shr_kind_r8
  use clmtype
  use decompMod    , only : get_proc_bounds
  use clm_varpar   , only : nlevgrnd,nlevsoi, nlevsno, nlevlak,maxpatch
  use clm_varcon   , only : bdsno, istice, istwet, istsoil, &
                            denice, denh2o, spval, sb, tfrz
  use SNICARMod    , only : snw_rds_min
  use globals      , only : nstep

!
! !ARGUMENTS:
  implicit none
!
! !CALLED FROM:
! subroutine iniTimeVar
!
! !REVISION HISTORY:
! Created by Mariana Vertenstein
!
! !LOCAL VARIABLES:
!
! local pointers to implicit in arguments
!
  integer , pointer :: pcolumn(:)        ! column index associated with each pft
  integer , pointer :: clandunit(:)      ! landunit index associated with each column
  integer , pointer :: ltype(:)          ! landunit type
  logical , pointer :: lakpoi(:)         ! true => landunit is a lake point
  real(r8), pointer :: dz(:,:)           ! layer thickness depth (m)
  real(r8), pointer :: zi(:,:)       ! interface depth (m) over snow only
  real(r8), pointer :: z(:,:)       ! interface depth (m) over snow only
  real(r8), pointer :: watsat(:,:)       ! volumetric soil water at saturation (porosity) (nlevsoi)
  real(r8), pointer :: h2osoi_ice(:,:)   ! ice lens (kg/m2)
  real(r8), pointer :: h2osoi_liq(:,:)   ! liquid water (kg/m2)
  real(r8), pointer :: bsw2(:,:)         ! Clapp and Hornberger "b" for CN code
  real(r8), pointer :: psisat(:,:)       ! soil water potential at saturation for CN code (MPa)
  real(r8), pointer :: vwcsat(:,:)       ! volumetric water content at saturation for CN code (m3/m3)
!  real(r8), pointer :: zi(:,:)           ! interface level below a "z" level (m)
!Is it different now, not just for snow?????
  real(r8), pointer :: wa(:)             ! water in the unconfined aquifer (mm)
  real(r8), pointer :: wt(:)             ! total water storage (unsaturated soil water + groundwater) (mm)
  real(r8), pointer :: zwt(:)            ! water table depth (m)
  real(r8), pointer :: h2ocan_loss(:)    ! canopy water mass balance term (column)
!!!!!!!!!!!!!!!!!!!!!!!!

!
! local pointers to implicit out arguments
!
  integer , pointer :: snl(:)            ! number of snow layers
  real(r8), pointer :: t_soisno(:,:)     ! soil temperature (Kelvin)  (-nlevsno+1:nlevsoi)
  real(r8), pointer :: t_lake(:,:)       ! lake temperature (Kelvin)  (1:nlevlak)
  real(r8), pointer :: t_grnd(:)         ! ground temperature (Kelvin)
  real(r8), pointer :: t_veg(:)          ! vegetation temperature (Kelvin)
  real(r8), pointer :: h2osoi_vol(:,:)   ! volumetric soil water (0<=h2osoi_vol<=watsat) [m3/m3]
  real(r8), pointer :: h2ocan_col(:)     ! canopy water (mm H2O) (column-level)
  real(r8), pointer :: h2ocan_pft(:)     ! canopy water (mm H2O) (pft-level)
  real(r8), pointer :: h2osno(:)         ! snow water (mm H2O)
  real(r8), pointer :: snowdp(:)         ! snow height (m)
#ifdef CN
  real(r8), pointer :: tlai(:)     ! one-sided leaf area index, no burying by snow
  real(r8), pointer :: tsai(:)     ! one-sided stem area index, no burying by snow
  real(r8), pointer :: htop(:)     ! canopy top (m)
  real(r8), pointer :: hbot(:)     ! canopy bottom (m)
#endif
   real(r8), pointer :: t_ref2m(:)     ! 2 m height surface air temperature (Kelvin)
    real(r8) :: t_ref2mx(maxpatch)



! real(r8), pointer :: snowage(:)        ! non dimensional snow age [-] (new)
  real(r8), pointer :: eflx_lwrad_out(:) ! emitted infrared (longwave) radiation (W/m**2)
!New variables
  real(r8), pointer :: soilpsi(:,:)    ! soil water potential in each soil layer (MPa)
!!!!!!!!!!!!!!!

! The following vraiables for a  WRF restart run
    integer   :: snlx(maxpatch)
    real(r8)  :: snowdpx(maxpatch)
!    real(r8)  :: snowagex(maxpatch)
    real(r8)  :: h2osnox(maxpatch)
    real(r8)  :: t_grndx(maxpatch)
    real(r8)  :: t_vegx(maxpatch)
    real(r8)  :: h2ocanx(maxpatch)
    real(r8)  :: h2ocan_colx(maxpatch)

    real(r8)  :: snw_rdsx(maxpatch,-nlevsno+1:0)
    real(r8)  :: t_lakex(maxpatch,nlevlak)
    real(r8)  :: t_soisnox(maxpatch,-nlevsno+1:nlevgrnd)
    real(r8)  :: h2osoi_liqx(maxpatch,-nlevsno+1:nlevgrnd)
    real(r8)  :: h2osoi_icex(maxpatch,-nlevsno+1:nlevgrnd)
    real(r8)  :: dzclmx(maxpatch,-nlevsno+1:nlevgrnd)
    real(r8)  :: zclmx(maxpatch,-nlevsno+1:nlevgrnd)
    real(r8)  :: ziclmx(maxpatch,-nlevsno:nlevgrnd)
    real(r8)  :: h2osoi_volx(maxpatch,nlevgrnd)
#ifdef CN
    real(r8)  :: tlaix(maxpatch)
    real(r8)  :: tsaix(maxpatch)
    real(r8)  :: htopx(maxpatch)
    real(r8)  :: hbotx(maxpatch)
#endif


    real(r8), pointer :: snw_rds(:,:)       ! effective snow grain radius (col,lyr) [microns, m^-6]
    real(r8), pointer :: snw_rds_top(:)     ! snow grain size, top (col) [microns]
    real(r8), pointer :: sno_liq_top(:)     ! liquid water fraction (mass) in top snow layer (col) [frc]
    real(r8), pointer :: mss_bcpho(:,:)     ! mass of hydrophobic BC in snow (col,lyr) [kg]
    real(r8), pointer :: mss_bcphi(:,:)     ! mass of hydrophillic BC in snow (col,lyr) [kg]
    real(r8), pointer :: mss_bctot(:,:)     ! total mass of BC (pho+phi) (col,lyr) [kg]
    real(r8), pointer :: mss_bc_col(:)      ! total mass of BC in snow column (col) [kg]
    real(r8), pointer :: mss_bc_top(:)      ! total mass of BC in top snow layer (col) [kg]
    real(r8), pointer :: mss_cnc_bcphi(:,:) ! mass concentration of BC species 1 (col,lyr) [kg/kg]
    real(r8), pointer :: mss_cnc_bcpho(:,:) ! mass concentration of BC species 2 (col,lyr) [kg/kg]
    real(r8), pointer :: mss_ocpho(:,:)     ! mass of hydrophobic OC in snow (col,lyr) [kg]
    real(r8), pointer :: mss_ocphi(:,:)     ! mass of hydrophillic OC in snow (col,lyr) [kg]
    real(r8), pointer :: mss_octot(:,:)     ! total mass of OC (pho+phi) (col,lyr) [kg]
    real(r8), pointer :: mss_oc_col(:)      ! total mass of OC in snow column (col) [kg]
    real(r8), pointer :: mss_oc_top(:)      ! total mass of OC in top snow layer (col) [kg]
    real(r8), pointer :: mss_cnc_ocphi(:,:) ! mass concentration of OC species 1 (col,lyr) [kg/kg]
    real(r8), pointer :: mss_cnc_ocpho(:,:) ! mass concentration of OC species 2 (col,lyr) [kg/kg]
    real(r8), pointer :: mss_dst1(:,:)      ! mass of dust species 1 in snow (col,lyr) [kg]
    real(r8), pointer :: mss_dst2(:,:)      ! mass of dust species 2 in snow (col,lyr) [kg]
    real(r8), pointer :: mss_dst3(:,:)      ! mass of dust species 3 in snow (col,lyr) [kg]
    real(r8), pointer :: mss_dst4(:,:)      ! mass of dust species 4 in snow (col,lyr) [kg]
    real(r8), pointer :: mss_dsttot(:,:)    ! total mass of dust in snow (col,lyr) [kg]
    real(r8), pointer :: mss_dst_col(:)     ! total mass of dust in snow column (col) [kg]
    real(r8), pointer :: mss_dst_top(:)     ! total mass of dust in top snow layer (col) [kg]
    real(r8), pointer :: mss_cnc_dst1(:,:)  ! mass concentration of dust species 1 (col,lyr) [kg/kg]
    real(r8), pointer :: mss_cnc_dst2(:,:)  ! mass concentration of dust species 2 (col,lyr) [kg/kg]
    real(r8), pointer :: mss_cnc_dst3(:,:)  ! mass concentration of dust species 3 (col,lyr) [kg/kg]
    real(r8), pointer :: mss_cnc_dst4(:,:)  ! mass concentration of dust species 4 (col,lyr) [kg/kg]


!
!EeP
!
! !OTHER LOCAL VARIABLES:
  integer :: j,l,c,p      ! indices
  integer :: begp, endp   ! per-proc beginning and ending pft indices
  integer :: begc, endc   ! per-proc beginning and ending column indices
  integer :: begl, endl   ! per-proc beginning and ending landunit indices
  integer :: begg, endg   ! per-proc gridcell ending gridcell indices
  real(r8):: vwc,psi      ! for calculating soilpsi

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

  ! Assign local pointers to derived subtypes components (landunit-level)

  ltype => clm3%g%l%itype
  lakpoi => clm3%g%l%lakpoi

  ! Assign local pointers to derived subtypes components (column-level)

  clandunit  => clm3%g%l%c%landunit
  snl        => clm3%g%l%c%cps%snl
  dz         => clm3%g%l%c%cps%dz
  zi         => clm3%g%l%c%cps%zi
  z          => clm3%g%l%c%cps%z
  watsat     => clm3%g%l%c%cps%watsat
  h2osoi_ice => clm3%g%l%c%cws%h2osoi_ice   
  h2osoi_liq => clm3%g%l%c%cws%h2osoi_liq   
  h2osoi_vol => clm3%g%l%c%cws%h2osoi_vol
  h2ocan_col => clm3%g%l%c%cws%pws_a%h2ocan 
 ! snowage    => clm3%g%l%c%cps%snowage     
  snowdp     => clm3%g%l%c%cps%snowdp
   h2osno     => clm3%g%l%c%cws%h2osno
  t_soisno   => clm3%g%l%c%ces%t_soisno
  t_lake     => clm3%g%l%c%ces%t_lake
  t_grnd     => clm3%g%l%c%ces%t_grnd
!New variables
    bsw2       => clm3%g%l%c%cps%bsw2
    vwcsat     => clm3%g%l%c%cps%vwcsat
    psisat     => clm3%g%l%c%cps%psisat
    soilpsi    => clm3%g%l%c%cps%soilpsi
    wa         => clm3%g%l%c%cws%wa
    wt         => clm3%g%l%c%cws%wt
    zwt        => clm3%g%l%c%cws%zwt
    h2ocan_loss => clm3%g%l%c%cwf%h2ocan_loss
!!!!!!
    snw_rds          => clm3%g%l%c%cps%snw_rds
    snw_rds_top      => clm3%g%l%c%cps%snw_rds_top
    sno_liq_top      => clm3%g%l%c%cps%sno_liq_top
    mss_bcpho        => clm3%g%l%c%cps%mss_bcpho
    mss_bcphi        => clm3%g%l%c%cps%mss_bcphi
    mss_bctot        => clm3%g%l%c%cps%mss_bctot
    mss_bc_col       => clm3%g%l%c%cps%mss_bc_col
    mss_bc_top       => clm3%g%l%c%cps%mss_bc_top
    mss_cnc_bcphi    => clm3%g%l%c%cps%mss_cnc_bcphi
    mss_cnc_bcpho    => clm3%g%l%c%cps%mss_cnc_bcpho
    mss_ocpho        => clm3%g%l%c%cps%mss_ocpho
    mss_ocphi        => clm3%g%l%c%cps%mss_ocphi
    mss_octot        => clm3%g%l%c%cps%mss_octot
    mss_oc_col       => clm3%g%l%c%cps%mss_oc_col
    mss_oc_top       => clm3%g%l%c%cps%mss_oc_top
    mss_cnc_ocphi    => clm3%g%l%c%cps%mss_cnc_ocphi
    mss_cnc_ocpho    => clm3%g%l%c%cps%mss_cnc_ocpho
    mss_dst1         => clm3%g%l%c%cps%mss_dst1
    mss_dst2         => clm3%g%l%c%cps%mss_dst2
    mss_dst3         => clm3%g%l%c%cps%mss_dst3
    mss_dst4         => clm3%g%l%c%cps%mss_dst4
    mss_dsttot       => clm3%g%l%c%cps%mss_dsttot
    mss_dst_col      => clm3%g%l%c%cps%mss_dst_col
    mss_dst_top      => clm3%g%l%c%cps%mss_dst_top
    mss_cnc_dst1     => clm3%g%l%c%cps%mss_cnc_dst1
    mss_cnc_dst2     => clm3%g%l%c%cps%mss_cnc_dst2
    mss_cnc_dst3     => clm3%g%l%c%cps%mss_cnc_dst3
    mss_cnc_dst4     => clm3%g%l%c%cps%mss_cnc_dst4



  t_ref2m        => clm3%g%l%c%p%pes%t_ref2m
#ifdef CN
  htop               => clm3%g%l%c%p%pps%htop
  hbot               => clm3%g%l%c%p%pps%hbot
  tlai               => clm3%g%l%c%p%pps%tlai
  tsai               => clm3%g%l%c%p%pps%tsai
#endif
  ! Assign local pointers to derived subtypes components (pft-level)
  
  pcolumn => clm3%g%l%c%p%column
  h2ocan_pft => clm3%g%l%c%p%pws%h2ocan
  t_veg => clm3%g%l%c%p%pes%t_veg
  eflx_lwrad_out => clm3%g%l%c%p%pef%eflx_lwrad_out
    
  ! Determine subgrid bounds on this processor
    
  call get_proc_bounds(begg, endg, begl, endl, begc, endc, begp, endp)
    
  ! ========================================================================
  ! Set snow water
  ! ========================================================================
    
  ! NOTE: h2ocan, h2osno, snowdp and snowage has valid values everywhere
    
  ! canopy water (pft level)
    
  do p = begp, endp
     h2ocan_pft(p) = h2ocanx(p)
     t_ref2m(p) = t_ref2mx(p)
#ifdef CN
     htop(p) = htopx(p) 
     hbot(p) = hbotx(p) 
     tlai(p) = tlaix(p) 
     write(6,*) 'tlaix(',p,')=',tlaix(p)
     tsai(p) = tsaix(p) 
#endif
  end do
    
    
    
!dir$ concurrent
!cdir nodep
  do c = begc,endc   
    
     ! canopy water (column level)
    
     h2ocan_col(c) = h2ocan_colx(c)

!New variable: canopy water loss
     h2ocan_loss(c) = 0._r8

     ! snow water
  
        h2osno(c) = h2osnox(c)

     ! snow depth

     snowdp(c)  = snowdpx(c)

     ! snow age

   !  snowage(c) = snowagex(c)


  end do


  ! ========================================================================
  ! Set snow layer number, depth and thickiness
  ! ========================================================================

  do c = begc,endc
!   snl(c) = snlx(c)
   dz(c,-nlevsno+1:0)  = dzclmx(c,-nlevsno+1:0)
   z(c,-nlevsno+1:0)   = zclmx(c,-nlevsno+1:0)
   zi(c,-nlevsno+0:0)  = ziclmx(c,-nlevsno+0:0)
  end do


  do c = begc,endc
   snl(c) = snlx(c)
   dz(c,1:nlevgrnd)  = dzclmx(c,1:nlevgrnd)
   z(c,1:nlevgrnd)   = zclmx(c,1:nlevgrnd)
   zi(c,1:nlevgrnd)  = ziclmx(c,1:nlevgrnd)
  end do



!   write(6,*) 'snlx=',snlx

  ! ========================================================================
  ! Set snow/soil temperature
  ! ========================================================================

  ! NOTE:
  ! t_soisno only has valid values over non-lake
  ! t_lake   only has valid values over lake
  ! t_grnd has valid values over all land
  ! t_veg  has valid values over all land

!dir$ concurrent
!cdir nodep
  do c = begc,endc
     t_soisno(c,-nlevsno+1:nlevgrnd) = t_soisnox(c,-nlevsno+1:nlevgrnd)  !in CLM4,nlevsoil=>nlevgrnd
     t_lake(c,1:nlevlak) = t_lakex(c,1:nlevlak)
     t_grnd(c)  = t_grndx(c)
  end do

 ! write(6,*) 'in mkabinit, t_soisnox=',t_soisnox

!dir$ concurrent
!cdir nodep
  do p = begp, endp
     c = pcolumn(p)
     t_veg(p) = t_vegx(c)
     eflx_lwrad_out(p) = sb * (t_grnd(c))**4
  end do

  ! ========================================================================
  ! Set snow/soil ice and liquid mass
  ! ========================================================================
  
  ! volumetric water is set first and liquid content and ice lens are obtained
  ! NOTE: h2osoi_vol, h2osoi_liq and h2osoi_ice only have valid values over soil
   
  do c = begc,endc
      do j=1,nlevgrnd
          h2osoi_vol(c,j)  = h2osoi_volx(c,j)
      end do
      do j=-nlevsno+1,nlevgrnd
          h2osoi_liq(c,j)  = h2osoi_liqx(c,j)
          h2osoi_ice(c,j)  = h2osoi_icex(c,j)
      end do
  end do
  

      call CLMDebug('initialize SNICAR')
   !   write(6,*) 'snl=',snl
    ! initialize SNICAR fields:
    ! may need to change later.
    do c = begc,endc
       mss_bctot(c,:) = 0._r8
       mss_bcpho(c,:) = 0._r8   !r
       mss_bcphi(c,:) = 0._r8   !r
       mss_cnc_bcphi(c,:)=0._r8
       mss_cnc_bcpho(c,:)=0._r8
  
       mss_octot(c,:) = 0._r8 
       mss_ocpho(c,:) = 0._r8   !r
       mss_ocphi(c,:) = 0._r8   !r
       mss_cnc_ocphi(c,:)=0._r8
       mss_cnc_ocpho(c,:)=0._r8

       mss_dst1(c,:) = 0._r8   !r
       mss_dst2(c,:) = 0._r8   !r
       mss_dst3(c,:) = 0._r8   !r
       mss_dst4(c,:) = 0._r8   !r 5layers
       mss_dsttot(c,:) = 0._r8
       mss_cnc_dst1(c,:)=0._r8
       mss_cnc_dst2(c,:)=0._r8
       mss_cnc_dst3(c,:)=0._r8
       mss_cnc_dst4(c,:)=0._r8


!   if(nstep == 1) then

!       if (snl(c) < 0) then
!          snw_rds(c,snl(c)+1:0)        = snw_rds_min
!          snw_rds(c,-nlevsno+1:snl(c)) = 0._r8
!          snw_rds_top(c)               = snw_rds_min
!          sno_liq_top(c) = h2osoi_liq(c,snl(c)+1) / (h2osoi_liq(c,snl(c)+1)+h2osoi_ice(c,snl(c)+1))
!      elseif (h2osno(c) > 0._r8) then
!          snw_rds(c,0)             = snw_rds_min
!          snw_rds(c,-nlevsno+1:-1) = 0._r8
!          snw_rds_top(c)           = spval
!          sno_liq_top(c)           = spval
!       else
!          snw_rds(c,:)   = 0._r8
!          snw_rds_top(c) = spval
!          sno_liq_top(c) = spval
!       endif
!     else
     snw_rds(c,-nlevsno+1:0) = snw_rdsx(c,-nlevsno+1:0)
!     end if



    enddo

        call CLMDebug('mark1')


!New variables
    wa(begc:endc)  = 5000._r8
    wt(begc:endc)  = 5000._r8
    zwt(begc:endc) = 0._r8
!!!!!!!!

!Switched loop order
  do c = begc,endc
!For new variables
        l = clandunit(c)
        if (.not. lakpoi(l)) then  !not lake
          wa(c)  = 4800._r8
          wt(c)  = wa(c)
          zwt(c) = (25._r8 + zi(c,nlevsoi)) - wa(c)/0.2_r8 /1000._r8  ! One meter below soil column
       end if
!!!!!!!
     do j = 1,nlevgrnd    !changed nlevsoi => nlevgrnd

        l = clandunit(c)
        if (.not. lakpoi(l)) then  !not lake
           ! volumetric water  
           if(h2osoi_vol(c,j) > watsat(c,j)) then
              h2osoi_vol(c,j) = watsat(c,j)
              if(h2osoi_liq(c,j)/(dz(c,j)*denh2o)+ &
                 h2osoi_ice(c,j)/(dz(c,j)*denice)> &
                 h2osoi_vol(c,j) ) then
                 if(t_soisno(c,j) > tfrz) then
                    h2osoi_liq(c,j) = dz(c,j)*denh2o*watsat(c,j)
                    h2osoi_ice(c,j) = 0.0
                 else
                    h2osoi_liq(c,j) = 0.0
                    h2osoi_ice(c,j) = dz(c,j)*denice*watsat(c,j)
                 end if
              end if

           endif


!For CN
#if (defined CN)
             ! soil water potential (added 10/21/03, PET)
             ! required for CN code
             if (ltype(l) == istsoil) then
                if (h2osoi_liq(c,j) > 0._r8) then
                   vwc = h2osoi_liq(c,j)/(dz(c,j)*denh2o)
                   psi = psisat(c,j) * (vwc/vwcsat(c,j))**bsw2(c,j)
                   soilpsi(c,j) = max(psi, -15.0_r8)
                   soilpsi(c,j) = min(soilpsi(c,j),0.0_r8)
                end if
             end if
#endif
!!!!!!!!!!!!!!
    
        end if
     end do
  end do
#ifdef DGVM
  ! Determine new subgrid weights and areas (obtained
  ! from new value of fpcgrid read in above) - this is needed
  ! here to avoid round off level errors on restart before
  ! lpj is called the first time

  call resetWeightsDGVM(begg, endg, begc, endc, begp, endp)
#endif

   call CLMDebug('done mkarbinit')

end subroutine mkarbinit

module aerdepMOD

!-----------------------------------------------------------------------
! This entire module will be removed....................
!BOP
!
! !MODULE: aerdepMod
!
! !DESCRIPTION:
! read an interpolate aerosol deposition data
!
! !USES:
  use shr_kind_mod,    only : r8 => shr_kind_r8
  use clm_varcon     , only : secspday,set_caerdep_from_file, set_dustdep_from_file
  use decompMod    , only : get_proc_bounds


!
! !PUBLIC TYPES:
  implicit none

  private

! !INCLUDES:
  
!
! !PUBLIC MEMBER FUNCTIONS:
  public :: interpMonthlyAerdep   ! interpolate monthly aerosol deposition data
  public :: aerdepini             ! aerosol deposition initialization

!
! !REVISION HISTORY:
! Created by Mark Flanner, 
!   based on vegetation interpolation schemes in STATICEcosystemDynMod
!    2009-Apr-17 B. Kauffman -- added multi-year time series functionality
!
!
! !PRIVATE MEMBER FUNCTIONS:
  private :: readMonthlyAerdep       ! read monthly aerosol deposition data for two months

!
! !PRIVATE TYPES:
!EOP

  real(r8), save, private, allocatable :: bcphiwet2t(:,:)
  real(r8), save, private, allocatable :: bcphidry2t(:,:)
  real(r8), save, private, allocatable :: bcphodry2t(:,:)
  real(r8), save, private, allocatable :: ocphiwet2t(:,:)
  real(r8), save, private, allocatable :: ocphidry2t(:,:)
  real(r8), save, private, allocatable :: ocphodry2t(:,:)
  real(r8), save, private, allocatable :: dstx01wd2t(:,:)
  real(r8), save, private, allocatable :: dstx01dd2t(:,:)
  real(r8), save, private, allocatable :: dstx02wd2t(:,:)
  real(r8), save, private, allocatable :: dstx02dd2t(:,:)
  real(r8), save, private, allocatable :: dstx03wd2t(:,:)
  real(r8), save, private, allocatable :: dstx03dd2t(:,:)
  real(r8), save, private, allocatable :: dstx04wd2t(:,:)
  real(r8), save, private, allocatable :: dstx04dd2t(:,:)

  integer,parameter  :: nt =12      ! size of time(:) array
  real(r8) :: time(12) ! data time, elapsed days since 0000-01-01 0s
  real(r8),parameter  :: daysPerYear = 365.0_r8 ! days per year

  integer,parameter :: debug = 1 ! internal debug level

!================================================================================

contains

!================================================================================
!BOP
!
! !IROUTINE: aerdepini
!
! !INTERFACE:
  subroutine aerdepini()
!
! !DESCRIPTION:
! Dynamically allocate memory and set to signaling NaN.
!
! !USES:
    use nanMod         , only : nan
!
! !ARGUMENTS:
    implicit none

!
! !REVISION HISTORY:
!    2009-Apr-17 B. Kauffman -- added multi-year time series functionality
!
!
! !LOCAL VARIABLES:
!EOP
    integer :: ier         ! error code
    integer :: begg,endg   ! local beg and end p index

    character(256) :: locfn          ! local file name
    integer :: ncid,dimid,varid      ! input netCDF id's

!    integer,allocatable :: cdate(:)  ! calendar date yyyymmdd
!    integer,allocatable :: eday(:)   ! elapsed days since 0000-01-01
!    integer,allocatable :: secs(:)   ! elapsed secs within current date
    integer             :: n         ! loop index
    integer             :: m1,m2     ! month 1, month 2

    integer, parameter :: ndaypm(12) = &
         (/31,28,31,30,31,30,31,31,30,31,30,31/) !days per month

    character(*),parameter :: subName =   '(aerdepini) '
    character(*),parameter :: F00     = "('(aerdepini) ',4a)"
    character(*),parameter :: F01     = "('(aerdepini) ',a,4f13.3)"

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

    call get_proc_bounds(begg=begg,endg=endg)

    if ( set_caerdep_from_file )then
       ier = 0
       if(.not.allocated(bcphiwet2t)) then
          allocate(bcphiwet2t(begg:endg,2))
          allocate(bcphidry2t(begg:endg,2))
          allocate(bcphodry2t(begg:endg,2))
          allocate(ocphiwet2t(begg:endg,2))
          allocate(ocphidry2t(begg:endg,2))
          allocate(ocphodry2t(begg:endg,2))
       endif
          
       if (ier /= 0)  then
          write(6,*) 'aerdepini allocation error'
          call endrun()
       end if 

        bcphiwet2t(begg:endg,1:2) = nan
        bcphidry2t(begg:endg,1:2) = nan
        bcphodry2t(begg:endg,1:2) = nan
        ocphiwet2t(begg:endg,1:2) = nan
        ocphidry2t(begg:endg,1:2) = nan
        ocphodry2t(begg:endg,1:2) = nan
    end if

    if ( set_dustdep_from_file )then

       allocate(dstx01wd2t(begg:endg,2))
       allocate(dstx01dd2t(begg:endg,2))
       allocate(dstx02wd2t(begg:endg,2))
       allocate(dstx02dd2t(begg:endg,2))
       allocate(dstx03wd2t(begg:endg,2))
       allocate(dstx03dd2t(begg:endg,2))
       allocate(dstx04wd2t(begg:endg,2))
       allocate(dstx04dd2t(begg:endg,2))

       if (ier /= 0) then 
         write(6,*) 'aerdepini allocation error'
         call endrun()
       end if


       dstx01wd2t(begg:endg,1:2) = nan
       dstx01dd2t(begg:endg,1:2) = nan
       dstx02wd2t(begg:endg,1:2) = nan
       dstx02dd2t(begg:endg,1:2) = nan
       dstx03wd2t(begg:endg,1:2) = nan
       dstx03dd2t(begg:endg,1:2) = nan
       dstx04wd2t(begg:endg,1:2) = nan
       dstx04dd2t(begg:endg,1:2) = nan

    end if

   !----------------------------------------------------------------------------
   ! read time axis from data file
   !----------------------------------------------------------------------------

      n = 365
      time( 1) = n + float(ndaypm( 1))/2.0_r8 ; n = n + ndaypm( 1)
      time( 2) = n + float(ndaypm( 2))/2.0_r8 ; n = n + ndaypm( 2)
      time( 3) = n + float(ndaypm( 3))/2.0_r8 ; n = n + ndaypm( 3)
      time( 4) = n + float(ndaypm( 4))/2.0_r8 ; n = n + ndaypm( 4)
      time( 5) = n + float(ndaypm( 5))/2.0_r8 ; n = n + ndaypm( 5)
      time( 6) = n + float(ndaypm( 6))/2.0_r8 ; n = n + ndaypm( 6)
      time( 7) = n + float(ndaypm( 7))/2.0_r8 ; n = n + ndaypm( 7)
      time( 8) = n + float(ndaypm( 8))/2.0_r8 ; n = n + ndaypm( 8)
      time( 9) = n + float(ndaypm( 9))/2.0_r8 ; n = n + ndaypm( 9)
      time(10) = n + float(ndaypm(10))/2.0_r8 ; n = n + ndaypm(10)
      time(11) = n + float(ndaypm(11))/2.0_r8 ; n = n + ndaypm(11)
      time(12) = n + float(ndaypm(12))/2.0_r8

  end subroutine aerdepini

!================================================================================
!BOP
!
! !IROUTINE: interpMonthlyAerdep
!
! !INTERFACE:
  subroutine interpMonthlyAerdep (kmo, kda)
!
! !DESCRIPTION:
! Determine if 2 new months of data are to be read.
!
! !USES:
    use clmtype
    use globals           , only : dtime
!
! !ARGUMENTS:
    implicit none
!
! !REVISION HISTORY:
!    2009-Apr-17 B. Kauffman -- added multi-year time series functionality
!  Adapted by Mark Flanner
!
!

!
! local pointers to implicit out arguments
!
    real(r8), pointer :: forc_aer(:,:)   ! aerosol deposition rate (kg/m2/s)

! !LOCAL VARIABLES:
!EOP
    real(r8):: timwt_aer(2)  ! time weights for month 1 and month 2 (aerosol deposition)
    integer :: kmo         ! month (1, ..., 12)
    integer :: kda         ! day of month (1, ..., 31)
    integer :: g
    integer :: begg,endg                  ! beg and end local g index

    integer       :: n         ! counter to prevent infinite LB/UB search
    integer       :: edays     ! elapsed days since 0000-01-01 0s (excluding partial days)
    real(r8)      :: t         ! model time, elapsed days since 0000-01-01
    integer ,save :: nLB = 0   ! tLB = time(nLB)
    integer ,save :: nUB = 1   ! tUB = time(nUB)
    real(r8),save :: tLB =-1.0 ! upper bound time sample, model time is in [tLB,tUB]
    real(r8),save :: tUB =-2.0 ! lower bound time sample, model time is in [tLB,tUB]
    real(r8)      :: fUB,fLB   ! t-interp fracs for UB,LB
    logical ,save :: firstCallA = .true.   ! id 1st occurance of case A
    logical ,save :: firstCallB = .true.   ! id 1st occurance of case B
    logical ,save :: firstCallC = .true.   ! id 1st occurance of case C
    character(1)  :: case                  ! flags case A, B, or C
    logical       ::  readNewData          ! T <=> read new LB,UB data
    
    character(*),parameter :: subName =  '(interpMonthlyAerdep) '
    character(*),parameter :: F00    = "('(interpMonthlyAerdep) ',4a)"
    character(*),parameter :: F01    = "('(interpMonthlyAerdep) ',a,i4.4,2('-',i2.2),3f11.2,2i6,2x,2f6.3)"
    character(*),parameter :: F02    = "('(interpMonthlyAerdep) ',a,i4.4,2('-',i2.2),i7,'s ',f12.3)"

!-------------------------------------------------------------------------------
! WARNING: this is (and has always been) hard-coded to assume 365 days per year
!-------------------------------------------------------------------------------

    ! Determine necessary indices
    call get_proc_bounds(begg=begg,endg=endg)
    

    ! Assign local pointers to derived subtypes components (gridcell level)
    forc_aer     => clm_a2l%forc_aer
    
   !----------------------------------------------------------------------------
   ! find input data LB & UB, time units are elapsed days since 0000-01-01
   !----------------------------------------------------------------------------

   CASE = "B"                    ! => interpolate within input time series
   if (t < time( 1) ) CASE = "A" ! => loop over 1st  year of input data
   if (t > time(nt) ) CASE = "C" ! => loop over last year of input data

   if ( case == "A" ) then 
      !--- CASE A: loop over first year of data ----------------------
      if ( firstCallA ) then
         nLB = 0 ; tLB = -2.0
         nUB = 1 ; tUB = -1.0 ! forces search for new LB,UB
         firstCallA = .false.
      end if
      t = mod(t,daysPerYear) + daysPerYear ! CASE A: put t in year 1
      n = 0
      readNewData = .false.
      do while (t < tLB  .or.  tUB < t)
         readNewData = .true.
         !--- move tUB,tLB forward in time ---
         nLB = nLB + 1 ; if (nLB > 12) nLB = 1
         nUB = nLB + 1 ; if (nUB > 12) nUB = 1
         tLB = mod(time(nLB),daysPerYear) + daysPerYear ! set year to 1
         tUB = mod(time(nUB),daysPerYear) + daysPerYear 
         !--- deal with wrap around situation ---
         if (nLB == 12) then 
            if (tLB <= t ) then
               tUB = tUB + daysPerYear ! put UB in year 2
            else if (t < tUB ) then
               tLB = tLB - daysPerYear ! put LB in year 1
            else
               write(6,*) "ERROR: in case A aerinterp" 
               call endrun()
            end if
         end if
         !--- prevent infinite search ---
         n = n + 1
         if (n > 12) then
             write(6,F01) "ERROR: date,tLB,t,tUB = ",kmo,kda,tLB,t,tUB
             call endrun()
         end if
      end do
   else if ( case == "C" ) then 
      !--- CASE C: loop over last year of data -----------------------
      if ( firstCallC ) then
         nLB = nt-12 ; tLB = -2.0
         nUB = nt-11 ; tUB = -1.0 ! forces search for new LB,UB
         firstCallC = .false.
      end if
      t = mod(t,daysPerYear) + daysPerYear ! set year to 1
      n = 0
      readNewData = .false.
      do while (t < tLB  .or.  tUB < t)
         readNewData = .true.
         !--- move tUB,tLB forward in time ---
         nLB = nLB + 1 ; if (nLB > nt) nLB = nt - 11
         nUB = nLB + 1 ; if (nUB > nt) nUB = nt - 11
         tLB = mod(time(nLB),daysPerYear) + daysPerYear ! set year to 1
         tUB = mod(time(nUB),daysPerYear) + daysPerYear 
         !--- deal with wrap around situation ---
         if (nLB == nt) then 
            if (tLB <= t ) then
               tUB = tUB + daysPerYear ! put UB in year 2
               else if (t < tUB ) then
               tLB = tLB - daysPerYear ! put LB in year 1
            else 
               write(6,*) "ERROR: in case A second aerinterp"
               call endrun()
            end if
         end if
         !--- prevent infinite search ---
         n = n + 1
         if (n > 12) then
             write(6,F01) "ERROR: date,tLB,t,tUB = ",kmo,kda,tLB,t,tUB
             call endrun()
         end if
      end do
   else
      !--- CASE B: interpolate within time series --------------------
      if ( firstCallB ) then
         nLB = 0 ; tLB = -2.0
         nUB = 1 ; tUB = -1.0 ! forces search for new LB,UB
         firstCallB = .false.
      end if
      readNewData = .false.
      do while (tUB < t) 
         readNewData = .true.
         nLB = nLB + 1
         nUB = nLB + 1
         tLB = time(nLB)
         tUB = time(nUB)
         if (nUB > nt) then 
          write(6,*) "ERROR: nt < nUB aerinterp"
          call endrun()
         end if
      end do
   end if

      call readMonthlyAerdep (kmo,kda) ! input the new LB,UB data

   !----------------------------------------------------------------------------
   ! interpolate aerosol deposition data into 'forcing' array:
   !----------------------------------------------------------------------------
   fLB = (tUB - t)/(tUB - tLB)
   fUB = 1.0_r8 - fLB

    do g = begg, endg
       if ( set_caerdep_from_file )then
          forc_aer(g, 1) = fLB*bcphidry2t(g,1)  + fUB*bcphidry2t(g,2)
          forc_aer(g, 2) = fLB*bcphodry2t(g,1)  + fUB*bcphodry2t(g,2)
          forc_aer(g, 3) = fLB*bcphiwet2t(g,1)  + fUB*bcphiwet2t(g,2)
          forc_aer(g, 4) = fLB*ocphidry2t(g,1)  + fUB*ocphidry2t(g,2)
          forc_aer(g, 5) = fLB*ocphodry2t(g,1)  + fUB*ocphodry2t(g,2)
          forc_aer(g, 6) = fLB*ocphiwet2t(g,1)  + fUB*ocphiwet2t(g,2)
       end if
       if ( set_dustdep_from_file )then
          forc_aer(g, 7) = fLB*dstx01wd2t(g,1)  + fUB*dstx01wd2t(g,2)
          forc_aer(g, 8) = fLB*dstx01dd2t(g,1)  + fUB*dstx01dd2t(g,2)
          forc_aer(g, 9) = fLB*dstx02wd2t(g,1)  + fUB*dstx02wd2t(g,2)
          forc_aer(g,10) = fLB*dstx02dd2t(g,1)  + fUB*dstx02dd2t(g,2)
          forc_aer(g,11) = fLB*dstx03wd2t(g,1)  + fUB*dstx03wd2t(g,2)
          forc_aer(g,12) = fLB*dstx03dd2t(g,1)  + fUB*dstx03dd2t(g,2)
          forc_aer(g,13) = fLB*dstx04wd2t(g,1)  + fUB*dstx04wd2t(g,2)
          forc_aer(g,14) = fLB*dstx04dd2t(g,1)  + fUB*dstx04dd2t(g,2)
       end if
    enddo

  call aerdealloc()

  end subroutine interpMonthlyAerdep

!---------------------------------------------
!Revised readMonthlyAerdep for coupling model
!---------------------------------------------
  subroutine readMonthlyAerdep(kmo, kda)

   use clm_varcon , only :bcphidry,bcphodry,bcphiwet,ocphidry,ocphodry,ocphiwet,dstx01wd,dstx01dd,dstx02wd,&
                          dstx02dd,dstx03wd,dstx03dd,dstx04wd,dstx04dd

! !ARGUMENTS:
    implicit none
    integer, intent(in) :: kmo            ! month (1, ..., 12)
    integer, intent(in) :: kda            ! day of month (1, ..., 31)

! LOCAL VARIABLES:
    integer :: k,g
    integer :: begg
    integer :: endg
    integer :: begl
    integer :: endl
    integer :: begc
    integer :: endc
    integer :: begp
    integer :: endp
    real(r8):: t           ! a fraction: kda/ndaypm
    integer :: it(2)       ! month 1 and month 2 (step 1)
    integer :: months(2)   ! months to be interpolated (1 to 12)
    integer, dimension(12) :: ndaypm= &
         (/31,28,31,30,31,30,31,31,30,31,30,31/) !days per month
!-----------------------------------------------------------------------

    t = (kda-0.5) / ndaypm(kmo)
    it(1) = t + 0.5
    it(2) = it(1) + 1
    months(1) = kmo + it(1) - 1
    months(2) = kmo + it(2) - 1
    if (months(1) <  1) months(1) = 12
    if (months(2) > 12) months(2) = 1

       call get_proc_bounds (begg, endg, begl, endl, begc, endc, begp, endp)


  do g = begg,endg
    do k=1,2
      bcphidry2t(g,k) = bcphidry(months(k))
      bcphodry2t(g,k) = bcphodry(months(k))
      bcphiwet2t(g,k) = bcphiwet(months(k))
      ocphidry2t(g,k) = ocphidry(months(k))
      ocphodry2t(g,k) = ocphodry(months(k))
      ocphiwet2t(g,k) = ocphiwet(months(k))
  
      dstx01wd2t(g,k) = dstx01wd(months(k))
      dstx01dd2t(g,k) = dstx01dd(months(k))
      dstx02wd2t(g,k) = dstx02wd(months(k))
      dstx02dd2t(g,k) = dstx02dd(months(k))
      dstx03wd2t(g,k) = dstx03wd(months(k))
      dstx03dd2t(g,k) = dstx03dd(months(k))
      dstx04wd2t(g,k) = dstx04wd(months(k))
      dstx04dd2t(g,k) = dstx04dd(months(k))
    end do
  end do

  end subroutine readMonthlyAerdep

  

  subroutine aerdealloc

  implicit none 
     if(allocated(bcphidry2t)) deallocate(bcphidry2t)
     if(allocated(bcphodry2t)) deallocate(bcphodry2t)
     if(allocated(bcphiwet2t)) deallocate(bcphiwet2t)
     if(allocated(ocphidry2t)) deallocate(ocphidry2t)
     if(allocated(ocphodry2t)) deallocate(ocphodry2t)
     if(allocated(ocphiwet2t)) deallocate(ocphiwet2t)
     if(allocated(dstx01wd2t)) deallocate(dstx01wd2t)
     if(allocated(dstx01dd2t)) deallocate(dstx01dd2t)
     if(allocated(dstx02wd2t)) deallocate(dstx02wd2t)
     if(allocated(dstx02dd2t)) deallocate(dstx02dd2t)
     if(allocated(dstx03wd2t)) deallocate(dstx03wd2t)
     if(allocated(dstx03dd2t)) deallocate(dstx03dd2t)
     if(allocated(dstx04wd2t)) deallocate(dstx04wd2t)
     if(allocated(dstx04dd2t)) deallocate(dstx04dd2t)

  end subroutine aerdealloc

end module aerdepMod
module accumulMod

!-----------------------------------------------------------------------
!BOP
!
! !MODULE: accumulMod
!
! !DESCRIPTION:
! This module contains generic subroutines that can be used to
! define, accumulate and extract  user-specified fields over
! user-defined intervals. Each interval  and accumulation type is
! unique to each field processed.
! Subroutine [init_accumulator] defines the values of the accumulated
! field data structure. Subroutine [update_accum_field] does
! the actual accumulation for a given field.
! Four types of accumulations are possible:
! - Average over time interval. Time average fields are only
!   valid at the end of the averaging interval.
! - Running mean over time interval. Running means are valid once the
!   length of the simulation exceeds the
! - Running accumulation over time interval. Accumulated fields are
!   continuously accumulated. The trigger value "-99999." resets
!   the accumulation to zero.
!
! !USES:
  use shr_kind_mod, only: r8 => shr_kind_r8
  use clm_varpar  , only: maxpatch
!
! !PUBLIC TYPES:
  implicit none
  save
!
! !PUBLIC MEMBER FUNCTIONS:
  public :: init_accum_field     ! Initialize an accumulator field
  public :: accum_dealloc
  public :: extract_accum_field  ! Extracts the current value of an accumulator field
  interface extract_accum_field
     module procedure extract_accum_field_sl ! Extract current val of single-level accumulator field
     module procedure extract_accum_field_ml ! Extract current val of multi-level accumulator field
  end interface
  public :: update_accum_field
  interface update_accum_field               ! Updates the current value of an accumulator field
     module procedure update_accum_field_sl  ! Update single-level accumulator field
     module procedure update_accum_field_ml  ! Update multi-level accumulator field
  end interface
!
! !REVISION HISTORY:
! Created by Sam Levis
! Updated to clm2.1 data structures by Mariana Vertenstein
! Updated to include all subgrid type and multilevel fields, M. Vertenstein 03/2003
!
!EOP
!
  private
!
! PRIVATE TYPES:
!
  type accum_field
     character(len=  8) :: name     !field name
     character(len=128) :: desc     !field description
     character(len=  8) :: units    !field units
     character(len=  8) :: acctype  !accumulation type: ["timeavg","runmean","runaccum"]
     character(len=  8) :: type1d   !subgrid type: ["gridcell","landunit","column" or "pft"]
     character(len=  8) :: type2d   !type2d ('','levsoi','numrad',..etc. )
     integer :: beg1d               !subgrid type beginning index
     integer :: end1d               !subgrid type ending index
     integer :: num1d               !total subgrid points
     integer :: numlev              !number of vertical levels in field
     real(r8):: initval             !initial value of accumulated field
     real(r8), pointer :: val(:,:)  !accumulated field
     integer :: period              !field accumulation period (in model time steps)
  end type accum_field


  integer, parameter :: max_accum = 100    !maximum number of accumulated fields
  type (accum_field) :: accum(max_accum)   !array accumulated fields
  integer :: naccflds = 0 
!------------------------------------------------------------------------

contains

!------------------------------------------------------------------------
!BOP
!
! !IROUTINE: init_accum_field
!
! !INTERFACE:
  subroutine init_accum_field (name, units, desc, &
       accum_type, accum_period, numlev, subgrid_type, init_value,type2d)


!
! !DESCRIPTION:
! Initialize accumulation fields. This subroutine sets:
! o name  of accumulated field
! o units of accumulated field
! o accumulation type of accumulated field
! o description of accumulated fields: accdes
! o accumulation period for accumulated field (in iterations)
! o initial value of accumulated field
!
! !USES:
    use clm_varcon,    only : cday
    use globals,       only : dtime
    use decompMod,     only : get_proc_bounds
!
! !ARGUMENTS:
    implicit none
    character(len=*), intent(in) :: name           !field name
    character(len=*), intent(in) :: units          !field units
    character(len=*), intent(in) :: desc           !field description
    character(len=*), intent(in) :: accum_type     !field type: tavg, runm, runa, ins
    integer , intent(in) :: accum_period           !field accumulation period
    character(len=*), intent(in)   :: subgrid_type !["gridcell","landunit","column" or "pft"]
    integer , intent(in) :: numlev                 !number of vertical levels
    real(r8), intent(in) :: init_value             !field initial or reset value
    character(len=*), intent(in), optional :: type2d !level type (optional) - needed if numlev > 1

!
! !REVISION HISTORY:
! Created by Mariana Vertenstein 03/2003
!
!EOP
!
! LOCAL VARIABLES:
    integer :: nf           ! field index
    integer :: beg1d,end1d  ! beggining and end subgrid indices
    integer :: num1d        ! total number subgrid indices
    integer :: begp, endp   ! per-proc beginning and ending pft indices
    integer :: begc, endc   ! per-proc beginning and ending column indices
    integer :: begl, endl   ! per-proc beginning and ending landunit indices
    integer :: begg, endg   ! per-proc gridcell ending gridcell indices

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

    ! Determine necessary indices

    call get_proc_bounds(begg, endg, begl, endl, begc, endc, begp, endp)

    ! update field index
    ! Consistency check that number of accumulated does not exceed maximum.

! this needs to be changed

!    naccflds = nct


    if (naccflds > max_accum) then
       write (6,*) 'INIT_ACCUM_FIELD error: user-defined accumulation fields ', &
            'equal to ',naccflds,' exceeds max_accum'
       call endrun
    end if
    nf = naccflds

    ! Note accumulation period must be converted from days
    ! to number of iterations

    accum(nf)%name = trim(name)
    accum(nf)%units = trim(units)
    accum(nf)%desc = trim(desc)
    accum(nf)%acctype = trim(accum_type)
    accum(nf)%initval = init_value
    accum(nf)%period = accum_period
    if (accum(nf)%period < 0) then
       accum(nf)%period = -accum(nf)%period * nint(cday) / dtime
    end if

    select case (trim(subgrid_type))
    case ('gridcell')
       beg1d = begg
       end1d = endg
       num1d = endg - begg + 1
    case ('landunit')
       beg1d = begl
       end1d = endl
       num1d = endl - begl + 1
    case ('column')
       beg1d = begc
       end1d = endc
       num1d = endc - begc + 1
    case ('pft')
       beg1d = begp
       end1d = endp
       num1d = endp - begp + 1
    case default
       write(6,*)'INIT_ACCUM_FIELD: unknown subgrid type ',subgrid_type
       call endrun ()
    end select

    accum(nf)%type1d = trim(subgrid_type)
    accum(nf)%beg1d = beg1d
    accum(nf)%end1d = end1d
    accum(nf)%num1d = num1d
    accum(nf)%numlev = numlev

    if (present(type2d)) then
       accum(nf)%type2d = type2d
    else
       accum(nf)%type2d = ' '
    end if

    ! Allocate and initialize accumulation field

! Here numlev is always equal to 1 
    allocate(accum(nf)%val(beg1d:end1d,numlev))
    accum(nf)%val(beg1d:end1d,1) = init_value

  end subroutine init_accum_field

!------------------------------------------------------------------------
!BOP
!
! !IROUTINE: extract_accum_field_sl
!
! !INTERFACE:
  subroutine extract_accum_field_sl (name, field, nstep)
!
! !DESCRIPTION:
! Extract single-level accumulated field.
! This routine extracts the field values from the multi-level
! accumulation field. It extracts the current value except if
! the field type is a time average. In this case, an absurd value
! is assigned to  indicate the time average is not yet valid.
!
! !USES:
    use clm_varcon, only : spval
!
! !ARGUMENTS:
    implicit none
    character(len=*), intent(in) :: name     !field name
    real(r8), pointer, dimension(:) :: field !field values for current time step
    integer , intent(in) :: nstep            !timestep index
!
! !REVISION HISTORY:
! Created by Sam Levis
! Updated to clm2.1 data structures by Mariana Vertenstein
! Updated to include all subgrid type and multilevel fields, Mariana Vertenstein 03-2003
!
!EOP
!
! LOCAL VARIABLES:
    integer :: i,k,nf        !indices
    integer :: beg,end         !subgrid beginning,ending indices
!------------------------------------------------------------------------

    ! find field index. return if "name" is not on list

    nf = 0
!dir$ concurrent
!cdir nodep
    do i = 1, naccflds
       if (name == accum(i)%name) nf = i
    end do
    if (nf == 0) then
       write(6,*) 'EXTRACT_ACCUM_FIELD_SL error: field name ',name,' not found'
       call endrun
    endif

    ! error check

    beg = accum(nf)%beg1d
    end = accum(nf)%end1d
    if (size(field,dim=1) /= end-beg+1) then
       write(6,*)'ERROR in extract_accum_field for field ',accum(nf)%name
       write(6,*)'size of first dimension of field is ',&
            size(field,dim=1),' and should be ',end-beg+1
       call endrun
    endif

    ! extract field

    if (accum(nf)%acctype == 'timeavg' .and. &
         mod(nstep,accum(nf)%period) /= 0) then
!dir$ concurrent
!cdir nodep
       do k = beg,end
          field(k) = spval  !assign absurd value when avg not ready
       end do
    else
!dir$ concurrent
!cdir nodep
       do k = beg,end
          field(k) = accum(nf)%val(k,1)
       end do
    end if

  end subroutine extract_accum_field_sl

!------------------------------------------------------------------------
!BOP
!
! !IROUTINE: extract_accum_field_ml
!
! !INTERFACE:
  subroutine extract_accum_field_ml (name, field, nstep)
!
! !DESCRIPTION:
! Extract mutli-level accumulated field.
! This routine extracts the field values from the multi-level
! accumulation field. It extracts the current value except if
! the field type is a time average. In this case, an absurd value
! is assigned to  indicate the time average is not yet valid.
!
! !USES:
    use clm_varcon, only : spval
!
! !ARGUMENTS:
    implicit none
    character(len=*), intent(in) :: name       !field name
    real(r8), pointer, dimension(:,:) :: field !field values for current time step
    integer, intent(in) :: nstep               !timestep index
!
! !REVISION HISTORY:
! Created by Sam Levis
! Updated to clm2.1 data structures by Mariana Vertenstein
! Updated to include all subgrid type and multilevel fields, M. Vertenstein 03/2003
!
!EOP
!
! LOCAL VARIABLES:
    integer :: i,j,k,nf        !indices
    integer :: beg,end         !subgrid beginning,ending indices
    integer :: numlev          !number of vertical levels
!------------------------------------------------------------------------

    ! find field index. return if "name" is not on list

    nf = 0
    do i = 1, naccflds
       if (name == accum(i)%name) nf = i
    end do
    if (nf == 0) then
       write(6,*) 'EXTRACT_ACCUM_FIELD_ML error: field name ',name,' not found'
       call endrun
    endif

    ! error check

    numlev = accum(nf)%numlev
    beg = accum(nf)%beg1d
    end = accum(nf)%end1d
    if (size(field,dim=1) /= end-beg+1) then
       write(6,*)'ERROR in extract_accum_field for field ',accum(nf)%name
       write(6,*)'size of first dimension of field is ',&
            size(field,dim=1),' and should be ',end-beg+1
       call endrun
    else if (size(field,dim=2) /= numlev) then
       write(6,*)'ERROR in extract_accum_field for field ',accum(nf)%name
       write(6,*)'size of second dimension of field iis ',&
            size(field,dim=2),' and should be ',numlev
       call endrun
    endif

    !extract field

    if (accum(nf)%acctype == 'timeavg' .and. &
         mod(nstep,accum(nf)%period) /= 0) then
       do j = 1,numlev
!dir$ concurrent
!cdir nodep
          do k = beg,end
             field(k,j) = spval  !assign absurd value when avg not ready
          end do
       end do
    else
       do j = 1,numlev
!dir$ concurrent
!cdir nodep
          do k = beg,end
             field(k,j) = accum(nf)%val(k,j)
          end do
       end do
    end if

  end subroutine extract_accum_field_ml

!------------------------------------------------------------------------
!BOP
!
! !IROUTINE: update_accum_field_sl
!
! !INTERFACE:
  subroutine update_accum_field_sl (name, field, nstep)
!
! !DESCRIPTION:
! Accumulate single level field over specified time interval.
! The appropriate field is accumulated in the array [accval].
!
! !ARGUMENTS:
    implicit none
    character(len=*), intent(in) :: name     !field name
    real(r8), pointer, dimension(:) :: field !field values for current time step
    integer , intent(in) :: nstep            !time step index
!
! !REVISION HISTORY:
! Created by Sam Levis
! Updated to clm2.1 data structures by Mariana Vertenstein
! Updated to include all subgrid type and multilevel fields by M. Vertenstein 03/2003
!
!EOP
!
! LOCAL VARIABLES:
    integer :: i,k,nf              !indices
    integer :: accper              !temporary accumulation period
    integer :: beg,end             !subgrid beginning,ending indices
!------------------------------------------------------------------------

    ! find field index. return if "name" is not on list

    nf = 0
    do i = 1, naccflds
       if (name == accum(i)%name) nf = i
    end do
    if (nf == 0) then
       write(6,*) 'UPDATE_ACCUM_FIELD_SL error: field name ',name,' not found'
       call endrun
    endif

    ! error check

    beg = accum(nf)%beg1d
    end = accum(nf)%end1d
    if (size(field,dim=1) /= end-beg+1) then
       write(6,*)'ERROR in UPDATE_ACCUM_FIELD_SL for field ',accum(nf)%name
       write(6,*)'size of first dimension of field is ',size(field,dim=1),&
            ' and should be ',end-beg+1
       call endrun
    endif

    ! accumulate field

    if (accum(nf)%acctype /= 'timeavg' .AND. &
        accum(nf)%acctype /= 'runmean' .AND. &
        accum(nf)%acctype /= 'runaccum') then
       write(6,*) 'UPDATE_ACCUM_FIELD_SL error: incorrect accumulation type'
       write(6,*) ' was specified for field ',name
       write(6,*)' accumulation type specified is ',accum(nf)%acctype
       write(6,*)' only [timeavg, runmean, runaccum] are currently acceptable'
       call endrun()
    end if


    ! reset accumulated field value if necessary and  update
    ! accumulation field
    ! running mean never reset

    if (accum(nf)%acctype == 'timeavg') then

       !time average field reset every accumulation period
       !normalize at end of accumulation period

       if ((mod(nstep,accum(nf)%period) == 1) .and. (nstep /= 0)) then
          accum(nf)%val(beg:end,1) = 0._r8
       end if
       accum(nf)%val(beg:end,1) =  accum(nf)%val(beg:end,1) + field(beg:end)
       if (mod(nstep,accum(nf)%period) == 0) then
          accum(nf)%val(beg:end,1) = accum(nf)%val(beg:end,1) / accum(nf)%period
       endif

    else if (accum(nf)%acctype == 'runmean') then

       !running mean - reset accumulation period until greater than nstep

       accper = min (nstep,accum(nf)%period)
       accum(nf)%val(beg:end,1) = ((accper-1)*accum(nf)%val(beg:end,1) + field(beg:end)) / accper

    else if (accum(nf)%acctype == 'runaccum') then

       !running accumulation field reset at trigger -99999

!dir$ concurrent
!cdir nodep
       do k = beg,end
          if (nint(field(k)) == -99999) then
             accum(nf)%val(k,1) = 0._r8
          end if
       end do
       accum(nf)%val(beg:end,1) = min(max(accum(nf)%val(beg:end,1) + field(beg:end), 0._r8), 99999._r8)

    end if

  end subroutine update_accum_field_sl

!------------------------------------------------------------------------
!BOP
!
! !IROUTINE: update_accum_field_ml
!
! !INTERFACE:
  subroutine update_accum_field_ml (name, field, nstep)
!
! !DESCRIPTION:
! Accumulate multi level field over specified time interval.
!
! !ARGUMENTS:
    implicit none
    character(len=*), intent(in) :: name       !field name
    real(r8), pointer, dimension(:,:) :: field !field values for current time step
    integer , intent(in) :: nstep              !time step index
!
! !REVISION HISTORY:
! Created by Sam Levis
! Updated to clm2.1 data structures by Mariana Vertenstein
! Updated to include all subgrid type and multilevel fields by M. Vertenstein 03/2003
!
!EOP
!
! LOCAL VARIABLES:
    integer :: i,j,k,nf            !indices
    integer :: accper              !temporary accumulation period
    integer :: beg,end             !subgrid beginning,ending indices
    integer :: numlev              !number of vertical levels
!------------------------------------------------------------------------

    ! find field index. return if "name" is not on list

    nf = 0
    do i = 1, naccflds
       if (name == accum(i)%name) nf = i
    end do
    if (nf == 0) then
       write(6,*) 'UPDATE_ACCUM_FIELD_ML error: field name ',name,' not found'
       call endrun
    endif

    ! error check

    numlev = accum(nf)%numlev
    beg = accum(nf)%beg1d
    end = accum(nf)%end1d
    if (size(field,dim=1) /= end-beg+1) then
       write(6,*)'ERROR in UPDATE_ACCUM_FIELD_ML for field ',accum(nf)%name
       write(6,*)'size of first dimension of field is ',size(field,dim=1),&
            ' and should be ',end-beg+1
       call endrun
    else if (size(field,dim=2) /= numlev) then
       write(6,*)'ERROR in UPDATE_ACCUM_FIELD_ML for field ',accum(nf)%name
       write(6,*)'size of second dimension of field is ',size(field,dim=2),&
            ' and should be ',numlev
       call endrun
    endif

    ! accumulate field

    if (accum(nf)%acctype /= 'timeavg' .AND. &
        accum(nf)%acctype /= 'runmean' .AND. &
        accum(nf)%acctype /= 'runaccum') then
       write(6,*) 'UPDATE_ACCUM_FIELD_ML error: incorrect accumulation type'
       write(6,*) ' was specified for field ',name
       write(6,*)' accumulation type specified is ',accum(nf)%acctype
       write(6,*)' only [timeavg, runmean, runaccum] are currently acceptable'
       call endrun()
    end if

    ! accumulate field

    ! reset accumulated field value if necessary and  update
    ! accumulation field
    ! running mean never reset

    if (accum(nf)%acctype == 'timeavg') then

       !time average field reset every accumulation period
       !normalize at end of accumulation period

       if ((mod(nstep,accum(nf)%period) == 1) .and. (nstep /= 0)) then
          accum(nf)%val(beg:end,1:numlev) = 0._r8
       endif
       accum(nf)%val(beg:end,1:numlev) =  accum(nf)%val(beg:end,1:numlev) + field(beg:end,1:numlev)
       if (mod(nstep,accum(nf)%period) == 0) then
          accum(nf)%val(beg:end,1:numlev) = accum(nf)%val(beg:end,1:numlev) / accum(nf)%period
       endif

    else if (accum(nf)%acctype == 'runmean') then

       !running mean - reset accumulation period until greater than nstep

       accper = min (nstep,accum(nf)%period)
       accum(nf)%val(beg:end,1:numlev) = &
            ((accper-1)*accum(nf)%val(beg:end,1:numlev) + field(beg:end,1:numlev)) / accper

    else if (accum(nf)%acctype == 'runaccum') then

       !running accumulation field reset at trigger -99999

       do j = 1,numlev
!dir$ concurrent
!cdir nodep
          do k = beg,end
             if (nint(field(k,j)) == -99999) then
                accum(nf)%val(k,j) = 0._r8
             end if
          end do
       end do
       accum(nf)%val(beg:end,1:numlev) = &
            min(max(accum(nf)%val(beg:end,1:numlev) + field(beg:end,1:numlev), 0._r8), 99999._r8)

    end if

  end subroutine update_accum_field_ml

!-----------------------------------------------------------------------
!BOP
!
! !IROUTINE: accum_dealloc
!
! !INTERFACE:
  subroutine accum_dealloc
!
! !DESCRIPTION:
! Deallocate dynamic memory for module variables
!
! !ARGUMENTS:
    implicit none
    integer :: i
!EOP
!-----------------------------------------------------------------------

    do i = 1,naccflds
      deallocate (accum(i)%val) 
    end do

  end subroutine accum_dealloc


end module accumulMod
module accFldsMod

!-----------------------------------------------------------------------
!BOP
!
! !MODULE: accFldsMod
!
! !DESCRIPTION:
! This module contains subroutines that initialize, update and extract
! the user-specified fields over user-defined intervals. Each interval
! and accumulation type is unique to each field processed.
! Subroutine [initAccumFlds] defines the fields to be processed
! and the type of accumulation. Subroutine [updateAccumFlds] does
! the actual accumulation for a given field. Fields are accumulated
! by calls to subroutine [update_accum_field]. To accumulate a field,
! it must first be defined in subroutine [initAccumFlds] and then
! accumulated by calls to [updateAccumFlds].
! Four types of accumulations are possible:
!   o average over time interval
!   o running mean over time interval
!   o running accumulation over time interval
! Time average fields are only valid at the end of the averaging interval.
! Running means are valid once the length of the simulation exceeds the
! averaging interval. Accumulated fields are continuously accumulated.
! The trigger value "-99999." resets the accumulation to zero.
!
! !USES:
  use shr_kind_mod, only: r8 => shr_kind_r8
!
! !PUBLIC TYPES:
  implicit none
  save
!
! !PUBLIC MEMBER FUNCTIONS:
  public :: initAccFlds     ! Initialization accumulator fields
  public :: initAccClmtype  ! Initialize clmtype variables obtained from accum fields
  public :: updateAccFlds   ! Update accumulator fields
!
! !REVISION HISTORY:
! Created by M. Vertenstein 03/2003
!
!EOP

contains

!------------------------------------------------------------------------
!BOP
!
! !IROUTINE: initAccFlds()
!
! !INTERFACE:
!#if (defined CNDV)
!  subroutine initAccFlds(t_ref2m  ,tda   ,t10    ,fnpsn10   ,prec365,&
!                         agdd0    ,agdd5 ,agddtw ,agdd)
!#else
  subroutine initAccFlds()
!#endif
!
! !DESCRIPTION:
! Initializes accumulator and sets up array of accumulated fields
!
! !USES:
    use decompMod    , only : get_proc_bounds
    use accumulMod   , only : init_accum_field
    use globals      , only : dtime, nstep
    use clm_varcon   , only : cday, tfrz
    use nanMod       , only : bigint
    use clm_varpar   , only : maxpatch
    use shr_const_mod, only : SHR_CONST_TKFRZ

!
! !ARGUMENTS:
    implicit none
!
! !REVISION HISTORY::
! Created by M. Vertenstein 03/2003
!
! LOCAL VARIABLES:
!
    integer, parameter :: not_used = bigint
!------------------------------------------------------------------------

   call init_accum_field(name='TREFAV', units='K', &
         desc='average over an hour of 2-m temperature', &
         accum_type='timeavg', accum_period=nint(3600._r8/dtime), &
         subgrid_type='pft', numlev=1, init_value=0._r8)

    ! Hourly average of Urban 2m temperature.

    call init_accum_field(name='TREFAV_U', units='K', &
         desc='average over an hour of urban 2-m temperature', &
         accum_type='timeavg', accum_period=nint(3600._r8/dtime), &
         subgrid_type='pft', numlev=1, init_value=0._r8)

    ! Hourly average of Rural 2m temperature.

    call init_accum_field(name='TREFAV_R', units='K', &
         desc='average over an hour of rural 2-m temperature', &
         accum_type='timeavg', accum_period=nint(3600._r8/dtime), &
         subgrid_type='pft', numlev=1, init_value=0._r8)

    ! 24hr average of vegetation temperature (heald, 04/06)
    call init_accum_field (name='T_VEG24', units='K', &
         desc='24hr average of vegetation temperature', &
         accum_type='runmean', accum_period=-1, &
         subgrid_type='pft', numlev=1, init_value=0._r8)

    ! 240hr average of vegetation temperature (heald, 04/06)
    call init_accum_field (name='T_VEG240', units='K', &
         desc='240hr average of vegetation temperature', &
         accum_type='runmean', accum_period=-10, &
         subgrid_type='pft', numlev=1, init_value=0._r8)

    ! 24hr average of direct solar radiation (heald, 04/06)
    call init_accum_field (name='FSD24', units='W/m2', &
         desc='24hr average of direct solar radiation', &
         accum_type='runmean', accum_period=-1, &
         subgrid_type='pft', numlev=1, init_value=0._r8)

    ! 240hr average of direct solar radiation (heald, 04/06)
    call init_accum_field (name='FSD240', units='W/m2', &
         desc='240hr average of direct solar radiation', &
         accum_type='runmean', accum_period=-10, &
         subgrid_type='pft', numlev=1, init_value=0._r8)

    ! 24hr average of diffuse solar radiation (heald, 04/06)
    call init_accum_field (name='FSI24', units='W/m2', &
         desc='24hr average of diffuse solar radiation', &
         accum_type='runmean', accum_period=-1, &
         subgrid_type='pft', numlev=1, init_value=0._r8)

    ! 240hr average of diffuse solar radiation (heald, 04/06)
    call init_accum_field (name='FSI240', units='W/m2', &
         desc='240hr average of diffuse solar radiation', &
         accum_type='runmean', accum_period=-10, &
         subgrid_type='pft', numlev=1, init_value=0._r8)

    ! 24hr average of fraction of canopy that is sunlit (heald, 04/06)
    call init_accum_field (name='FSUN24', units='fraction', &
         desc='24hr average of diffuse solar radiation', &
         accum_type='runmean', accum_period=-1, &
         subgrid_type='pft', numlev=1, init_value=0._r8)

    ! 240hr average of fraction of canopy that is sunlit (heald, 04/06)
    call init_accum_field (name='FSUN240', units='fraction', &
         desc='240hr average of diffuse solar radiation', &
         accum_type='runmean', accum_period=-10, &
         subgrid_type='pft', numlev=1, init_value=0._r8)

    ! Average of LAI from previous and current timestep (heald, 04/06)
    call init_accum_field (name='LAIP', units='m2/m2', &
         desc='leaf area index average over timestep', &
         accum_type='runmean', accum_period=1, &
         subgrid_type='pft', numlev=1, init_value=0._r8)

#if (defined CNDV)
    ! 30-day average of 2m temperature.

    call init_accum_field (name='TDA', units='K', &
         desc='30-day average of 2-m temperature', &
         accum_type='timeavg', accum_period=-30, &
         subgrid_type='pft', numlev=1, init_value=0._r8)

    ! The following are running means.
    ! The accumulation period is set to 10 days for a 10-day running mean.
    call init_accum_field (name='T10', units='K', &
         desc='10-day running mean of 2-m temperature', &
         accum_type='runmean', accum_period=-10, &
         subgrid_type='pft', numlev=1,init_value=SHR_CONST_TKFRZ+20._r8)

    call init_accum_field (name='PREC365', units='MM H2O/S', &
         desc='365-day running mean of total precipitation', &
         accum_type='runmean', accum_period=-365, &
         subgrid_type='pft', numlev=1, init_value=0._r8)

    ! The following are accumulated fields.
    ! These types of fields are accumulated until a trigger value resets
    ! the accumulation to zero (see subroutine update_accum_field).
    ! Hence, [accper] is not valid.

    call init_accum_field (name='AGDDTW', units='K', &
         desc='growing degree-days base twmax', &
         accum_type='runaccum', accum_period=not_used, &
         subgrid_type='pft', numlev=1, init_value=0._r8)

    call init_accum_field (name='AGDD', units='K', &
         desc='growing degree-days base 5C', &
         accum_type='runaccum', accum_period=not_used,  &
         subgrid_type='pft', numlev=1, init_value=0._r8)
#endif

#if (defined CROP)
    ! 10-day average of min 2m temperature.

    call init_accum_field (name='TDM10', units='K', &
         desc='10-day running mean of min 2-m temperature', &
         accum_type='runmean', accum_period=-10, &
         subgrid_type='pft', numlev=1, init_value=SHR_CONST_TKFRZ)

    ! 5-day average of min 2m temperature.

    call init_accum_field (name='TDM5', units='K', &
         desc='5-day running mean of min 2-m temperature', &
         accum_type='runmean', accum_period=-5, &
         subgrid_type='pft', numlev=1, init_value=SHR_CONST_TKFRZ)

    ! All GDD summations are relative to the planting date
    ! (Kucharik & Brye 2003)

    call init_accum_field (name='GDD0', units='K', &
         desc='growing degree-days base 0C from planting', &
         accum_type='runaccum', accum_period=not_used, &
         subgrid_type='pft', numlev=1, init_value=0._r8)

    call init_accum_field (name='GDD8', units='K', &
         desc='growing degree-days base 8C from planting', &
         accum_type='runaccum', accum_period=not_used, &
         subgrid_type='pft', numlev=1, init_value=0._r8)

    call init_accum_field (name='GDD10', units='K', &
         desc='growing degree-days base 10C from planting', &
         accum_type='runaccum', accum_period=not_used,  &
         subgrid_type='pft', numlev=1, init_value=0._r8)

    call init_accum_field (name='GDDPLANT', units='K', &
         desc='growing degree-days from planting', &
         accum_type='runaccum', accum_period=not_used,  &
         subgrid_type='pft', numlev=1, init_value=0._r8)
    
    call init_accum_field (name='GDDTSOI', units='K', &
         desc='growing degree-days from planting (top two soil layers)', &
         accum_type='runaccum', accum_period=not_used,  &
         subgrid_type='pft', numlev=1, init_value=0._r8)
#endif

    ! Print output of accumulated fields

!    call print_accum_fields()

  end subroutine initAccFlds

!------------------------------------------------------------------------
!BOP
!
! !IROUTINE: updateAccFlds
!
! !INTERFACE:
  subroutine updateAccFlds()
!
! !DESCRIPTION:
! Update and/or extract accumulated fields
!
! !USES:
    use clmtype
    use decompMod    , only : get_proc_bounds
    use clm_varcon   , only : spval
    use shr_const_mod, only : SHR_CONST_CDAY, SHR_CONST_TKFRZ
    use pftvarcon    , only : ndllf_dcd_brl_tree 
    use globals      , only : dtime, nstep, secs,day,dayp1,month
    use accumulMod   , only : update_accum_field, extract_accum_field
#if (defined CROP)
    use pftvarcon    , only : nwwheat, mxtmp, baset
!    use clm_time_manager , only : get_start_date
#endif
!
! !ARGUMENTS:
    implicit none
!
! !REVISION HISTORY:
! Created by M. Vertenstein 03/2003
!
! !LOCAL VARIABLES:
!
! local pointers to implicit in arguments
!
    integer , pointer :: itype(:)            ! pft vegetation
    integer , pointer :: pgridcell(:)        ! index into gridcell level quantities
    real(r8), pointer :: forc_t(:)           ! atmospheric temperature (Kelvin)
    real(r8), pointer :: forc_rain(:)        ! rain rate [mm/s]
    real(r8), pointer :: forc_snow(:)        ! snow rate [mm/s]
    real(r8), pointer :: t_ref2m(:)          ! 2 m height surface air temperature (Kelvin)
    real(r8), pointer :: t_ref2m_u(:)        ! Urban 2 m height surface air temperature (Kelvin)
    real(r8), pointer :: t_ref2m_r(:)        ! Rural 2 m height surface air temperature (Kelvin)
    logical , pointer :: urbpoi(:)           ! true => landunit is an urban point
   logical , pointer :: ifspecial(:)        ! true => landunit is not vegetated
    integer , pointer :: plandunit(:)        ! landunit index associated with each pft
#if (defined CROP)
    real(r8), pointer :: vf(:)
    real(r8), pointer :: t_soisno(:,:)
    real(r8), pointer :: h2osoi_liq(:,:)
    real(r8), pointer :: watsat(:,:)
    real(r8), pointer :: dz(:,:)
    real(r8), pointer :: latdeg(:)           ! latitude (radians)
    integer , pointer :: croplive(:)
    integer , pointer :: pcolumn(:)          ! index into column level quantities
#endif


!
! local pointers to implicit out arguments
!
    ! heald (04/06): variables to be accumulated for VOC emissions
    real(r8), pointer :: t_veg(:)            ! pft vegetation temperature (Kelvin) 
    real(r8), pointer :: forc_solad(:,:)     ! direct beam radiation (visible only)
    real(r8), pointer :: forc_solai(:,:)     ! diffuse radiation     (visible only)
    real(r8), pointer :: fsun(:)             ! sunlit fraction of canopy 
    real(r8), pointer :: elai(:)             ! one-sided leaf area index with burying by snow 
    ! heald (04/06): accumulated variables for VOC emissions
    real(r8), pointer :: t_veg24(:)          ! 24hr average vegetation temperature (K)
    real(r8), pointer :: t_veg240(:)         ! 240hr average vegetation temperature (Kelvin)
    real(r8), pointer :: fsd24(:)            ! 24hr average of direct beam radiation 
    real(r8), pointer :: fsd240(:)           ! 240hr average of direct beam radiation 
    real(r8), pointer :: fsi24(:)            ! 24hr average of diffuse beam radiation 
    real(r8), pointer :: fsi240(:)           ! 240hr average of diffuse beam radiation 
    real(r8), pointer :: fsun24(:)           ! 24hr average of sunlit fraction of canopy 
    real(r8), pointer :: fsun240(:)          ! 240hr average of sunlit fraction of canopy
    real(r8), pointer :: elai_p(:)           ! leaf area index average over timestep 

    real(r8), pointer :: t_ref2m_min(:)      ! daily minimum of average 2 m height surface air temperature (K)
    real(r8), pointer :: t_ref2m_max(:)      ! daily maximum of average 2 m height surface air temperature (K)
    real(r8), pointer :: t_ref2m_min_inst(:) ! instantaneous daily min of average 2 m height surface air temp (K)
    real(r8), pointer :: t_ref2m_max_inst(:) ! instantaneous daily max of average 2 m height surface air temp (K)
    real(r8), pointer :: t_ref2m_min_u(:)    ! Urban daily minimum of average 2 m height surface air temperature (K)
    real(r8), pointer :: t_ref2m_min_r(:)    ! Rural daily minimum of average 2 m height surface air temperature (K)
    real(r8), pointer :: t_ref2m_max_u(:)    ! Urban daily maximum of average 2 m height surface air temperature (K)
    real(r8), pointer :: t_ref2m_max_r(:)    ! Rural daily maximum of average 2 m height surface air temperature (K)
    real(r8), pointer :: t_ref2m_min_inst_u(:) ! Urban instantaneous daily min of average 2 m height surface air temp (K)
    real(r8), pointer :: t_ref2m_min_inst_r(:) ! Rural instantaneous daily min of average 2 m height surface air temp (K)
    real(r8), pointer :: t_ref2m_max_inst_u(:) ! Urban instantaneous daily max of average 2 m height surface air temp (K)
    real(r8), pointer :: t_ref2m_max_inst_r(:) ! Rural instantaneous daily max of average 2 m height surface air temp (K)
#if (defined CNDV)
    real(r8), pointer :: t10(:)              ! 10-day running mean of the 2 m temperature (K)
    real(r8), pointer :: t_mo(:)             ! 30-day average temperature (Kelvin)
    real(r8), pointer :: t_mo_min(:)         ! annual min of t_mo (Kelvin)
    real(r8), pointer :: prec365(:)          ! 365-day running mean of tot. precipitation
    real(r8), pointer :: agddtw(:)           ! accumulated growing degree days above twmax
    real(r8), pointer :: agdd(:)             ! accumulated growing degree days above 5
    real(r8), pointer :: twmax(:)            ! upper limit of temperature of the warmest month
#endif
#if (defined CROP)
    real(r8), pointer :: gdd0(:)             ! growing degree-days base 0C'
    real(r8), pointer :: gdd8(:)             ! growing degree-days base 8C from planting
    real(r8), pointer :: gdd10(:)            ! growing degree-days base 10C from planting
    real(r8), pointer :: gddplant(:)         ! growing degree-days from planting
    real(r8), pointer :: gddtsoi(:)          ! growing degree-days from planting (top two soil layers)
    real(r8), pointer :: a10tmin(:)          ! 10-day running mean of min 2-m temperature
    real(r8), pointer :: a5tmin(:)           ! 5-day running mean of min 2-m temperature
#endif
!
!   
! !OTHER LOCAL VARIABLES:
!EOP
    integer :: g,l,c,p                   ! indices
    integer :: itypveg                   ! vegetation type
!    integer :: dtime                     ! timestep size [seconds]
!    integer :: nstep                     ! timestep number
!    integer :: year                      ! year (0, ...) for nstep
!    integer :: month                     ! month (1, ..., 12) for nstep
!    integer :: day                       ! day of month (1, ..., 31) for nstep
!    integer :: secs                      ! seconds into current date for nstep
    logical :: end_cd                    ! temporary for is_end_curr_day() value
    integer :: ier                       ! error status
    integer :: begp, endp                !  per-proc beginning and ending pft indices
    integer :: begc, endc                !  per-proc beginning and ending column indices
    integer :: begl, endl                !  per-proc beginning and ending landunit indices
    integer :: begg, endg                !  per-proc gridcell ending gridcell indices
    real(r8), pointer :: rbufslp(:)      ! temporary single level - pft level


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

    ! Determine necessary indices

    call get_proc_bounds(begg, endg, begl, endl, begc, endc, begp, endp)

    ! Assign local pointers to derived subtypes components (gridcell-level)

    forc_t => clm_a2l%forc_t
    forc_rain => clm_a2l%forc_rain
    forc_snow => clm_a2l%forc_snow

    forc_solad => clm_a2l%forc_solad        ! (heald 04/06)
    forc_solai => clm_a2l%forc_solai        ! (heald 04/06)

   ! Assign local pointers to derived subtypes components (landunit-level)
    ifspecial  => clm3%g%l%ifspecial
    urbpoi     => clm3%g%l%urbpoi


    ! Assign local pointers to derived subtypes components (pft-level)

    itype            => clm3%g%l%c%p%itype
    pgridcell        => clm3%g%l%c%p%gridcell
    t_ref2m          => clm3%g%l%c%p%pes%t_ref2m
    t_ref2m_max_inst => clm3%g%l%c%p%pes%t_ref2m_max_inst
    t_ref2m_min_inst => clm3%g%l%c%p%pes%t_ref2m_min_inst
    t_ref2m_max      => clm3%g%l%c%p%pes%t_ref2m_max
    t_ref2m_min      => clm3%g%l%c%p%pes%t_ref2m_min
    t_ref2m_u        => clm3%g%l%c%p%pes%t_ref2m_u
    t_ref2m_r        => clm3%g%l%c%p%pes%t_ref2m_r
    t_ref2m_max_u    => clm3%g%l%c%p%pes%t_ref2m_max_u
    t_ref2m_max_r    => clm3%g%l%c%p%pes%t_ref2m_max_r
    t_ref2m_min_u    => clm3%g%l%c%p%pes%t_ref2m_min_u
    t_ref2m_min_r    => clm3%g%l%c%p%pes%t_ref2m_min_r
    t_ref2m_max_inst_u => clm3%g%l%c%p%pes%t_ref2m_max_inst_u
    t_ref2m_max_inst_r => clm3%g%l%c%p%pes%t_ref2m_max_inst_r
    t_ref2m_min_inst_u => clm3%g%l%c%p%pes%t_ref2m_min_inst_u
    t_ref2m_min_inst_r => clm3%g%l%c%p%pes%t_ref2m_min_inst_r
    plandunit        => clm3%g%l%c%p%landunit
#if (defined CNDV)
    t_mo             => clm3%g%l%c%p%pdgvs%t_mo
    t_mo_min         => clm3%g%l%c%p%pdgvs%t_mo_min
    t10              => clm3%g%l%c%p%pdgvs%t10
    prec365          => clm3%g%l%c%p%pdgvs%prec365
    agddtw           => clm3%g%l%c%p%pdgvs%agddtw
    agdd             => clm3%g%l%c%p%pdgvs%agdd
    twmax            => dgv_pftcon%twmax
#endif
#if (defined CROP)
    gdd0             => clm3%g%l%c%p%pps%gdd0
    gdd8             => clm3%g%l%c%p%pps%gdd8
    gdd10            => clm3%g%l%c%p%pps%gdd10
    gddplant         => clm3%g%l%c%p%pps%gddplant
    gddtsoi          => clm3%g%l%c%p%pps%gddtsoi
    a10tmin          => clm3%g%l%c%p%pps%a10tmin
    a5tmin           => clm3%g%l%c%p%pps%a5tmin
    vf               => clm3%g%l%c%p%pps%vf
    t_soisno         => clm3%g%l%c%ces%t_soisno
    h2osoi_liq       => clm3%g%l%c%cws%h2osoi_liq
    watsat           => clm3%g%l%c%cps%watsat
    dz               => clm3%g%l%c%cps%dz
    latdeg           => clm3%g%latdeg
    croplive         => clm3%g%l%c%p%pps%croplive
    pcolumn          => clm3%g%l%c%p%column
#endif
    t_veg24          => clm3%g%l%c%p%pvs%t_veg24           ! (heald 04/06)
    t_veg240         => clm3%g%l%c%p%pvs%t_veg240          ! (heald 04/06)
    fsd24            => clm3%g%l%c%p%pvs%fsd24             ! (heald 04/06)
    fsd240           => clm3%g%l%c%p%pvs%fsd240            ! (heald 04/06)
    fsi24            => clm3%g%l%c%p%pvs%fsi24             ! (heald 04/06)
    fsi240           => clm3%g%l%c%p%pvs%fsi240            ! (heald 04/06)
    fsun24           => clm3%g%l%c%p%pvs%fsun24            ! (heald 04/06)
    fsun240          => clm3%g%l%c%p%pvs%fsun240           ! (heald 04/06)
    elai_p           => clm3%g%l%c%p%pvs%elai_p            ! (heald 04/06)
    t_veg            => clm3%g%l%c%p%pes%t_veg             ! (heald 04/06)
    fsun             => clm3%g%l%c%p%pps%fsun              ! (heald 04/06)
    elai             => clm3%g%l%c%p%pps%elai              ! (heald 04/06)

    ! Don't do any accumulation if nstep is zero
    ! (only applies to coupled or cam mode)

    if (nstep == 0) return

    ! NOTE: currently only single level pft fields are used below
    ! Variables are declared above that should make it easy to incorporate
    ! multi-level or single-level fields of any subgrid type

    ! Allocate needed dynamic memory for single level pft field

    allocate(rbufslp(begp:endp), stat=ier)
    if (ier/=0) then
       write(6,*)'update_accum_hist allocation error for rbuf1dp'
       call endrun
    endif

    ! Accumulate and extract TREFAV - hourly average 2m air temperature
    ! Used to compute maximum and minimum of hourly averaged 2m reference
    ! temperature over a day. Note that "spval" is returned by the call to
    ! accext if the time step does not correspond to the end of an
    ! accumulation interval. First, initialize the necessary values for
    ! an initial run at the first time step the accumulator is called

    call update_accum_field  ('TREFAV', t_ref2m, nstep)
    call extract_accum_field ('TREFAV', rbufslp, nstep)

    if(dayp1-day.eq.1) then
      end_cd =  .true.
    else
      end_cd =  .false.
    end if

!dir$ concurrent
!cdir nodep
    do p = begp,endp
       if (rbufslp(p) /= spval) then
          t_ref2m_max_inst(p) = max(rbufslp(p), t_ref2m_max_inst(p))
          t_ref2m_min_inst(p) = min(rbufslp(p), t_ref2m_min_inst(p))
       endif
       if (end_cd) then
          t_ref2m_max(p) = t_ref2m_max_inst(p)
          t_ref2m_min(p) = t_ref2m_min_inst(p)
          t_ref2m_max_inst(p) = -spval
          t_ref2m_min_inst(p) =  spval
       else if (secs == int(dtime)) then
          t_ref2m_max(p) = spval
          t_ref2m_min(p) = spval
       endif
    end do

    ! Accumulate and extract TREFAV_U - hourly average urban 2m air temperature
    ! Used to compute maximum and minimum of hourly averaged 2m reference
    ! temperature over a day. Note that "spval" is returned by the call to
    ! accext if the time step does not correspond to the end of an
    ! accumulation interval. First, initialize the necessary values for
    ! an initial run at the first time step the accumulator is called
    
    call update_accum_field  ('TREFAV_U', t_ref2m_u, nstep)
    call extract_accum_field ('TREFAV_U', rbufslp, nstep)
    do p = begp,endp
       l = plandunit(p)
       if (rbufslp(p) /= spval) then
          t_ref2m_max_inst_u(p) = max(rbufslp(p), t_ref2m_max_inst_u(p))
          t_ref2m_min_inst_u(p) = min(rbufslp(p), t_ref2m_min_inst_u(p))
       endif
       if (end_cd) then
         if (urbpoi(l)) then
          t_ref2m_max_u(p) = t_ref2m_max_inst_u(p)
          t_ref2m_min_u(p) = t_ref2m_min_inst_u(p)
          t_ref2m_max_inst_u(p) = -spval
          t_ref2m_min_inst_u(p) =  spval
         end if 
       else if (secs == int(dtime)) then
          t_ref2m_max_u(p) = spval
          t_ref2m_min_u(p) = spval
       endif
    end do
    
    ! Accumulate and extract TREFAV_R - hourly average rural 2m air temperature
    ! Used to compute maximum and minimum of hourly averaged 2m reference
    ! temperature over a day. Note that "spval" is returned by the call to
    ! accext if the time step does not correspond to the end of an
    ! accumulation interval. First, initialize the necessary values for
    ! an initial run at the first time step the accumulator is called
    
    call update_accum_field  ('TREFAV_R', t_ref2m_r, nstep)
    call extract_accum_field ('TREFAV_R', rbufslp, nstep)
    do p = begp,endp
       l = plandunit(p)
       if (rbufslp(p) /= spval) then
          t_ref2m_max_inst_r(p) = max(rbufslp(p), t_ref2m_max_inst_r(p))
          t_ref2m_min_inst_r(p) = min(rbufslp(p), t_ref2m_min_inst_r(p))
       endif
       if (end_cd) then
         if (.not.(ifspecial(l))) then
          t_ref2m_max_r(p) = t_ref2m_max_inst_r(p)
          t_ref2m_min_r(p) = t_ref2m_min_inst_r(p)
          t_ref2m_max_inst_r(p) = -spval
          t_ref2m_min_inst_r(p) =  spval
        end if
       else if (secs == int(dtime)) then
          t_ref2m_max_r(p) = spval
          t_ref2m_min_r(p) = spval
       endif
    end do

    ! Accumulate and extract T_VEG24 & T_VEG240 (heald 04/06)
    do p = begp,endp
       rbufslp(p) = t_veg(p)
    end do
    call update_accum_field  ('T_VEG24', rbufslp, nstep)
    call extract_accum_field ('T_VEG24', t_veg24, nstep)
    call update_accum_field  ('T_VEG240', rbufslp, nstep)
    call extract_accum_field ('T_VEG240', t_veg240, nstep)

    ! Accumulate and extract forc_solad24 & forc_solad240 (heald 04/06)
    do p = begp,endp
       g = pgridcell(p)
       rbufslp(p) = forc_solad(g,1)
    end do
    call update_accum_field  ('FSD240', rbufslp, nstep)
    call extract_accum_field ('FSD240', fsd240, nstep)
    call update_accum_field  ('FSD24', rbufslp, nstep)
    call extract_accum_field ('FSD24', fsd24, nstep)

    ! Accumulate and extract forc_solai24 & forc_solai240 (heald 04/06)
    do p = begp,endp
       g = pgridcell(p)
       rbufslp(p) = forc_solai(g,1)
    end do
    call update_accum_field  ('FSI24', rbufslp, nstep)
    call extract_accum_field ('FSI24', fsi24, nstep)
    call update_accum_field  ('FSI240', rbufslp, nstep)
    call extract_accum_field ('FSI240', fsi240, nstep)

    ! Accumulate and extract fsun24 & fsun240 (heald 04/06)
    do p = begp,endp
       rbufslp(p) = fsun(p)
    end do
    call update_accum_field  ('FSUN24', rbufslp, nstep)
    call extract_accum_field ('FSUN24', fsun24, nstep)
    call update_accum_field  ('FSUN240', rbufslp, nstep)
    call extract_accum_field ('FSUN240', fsun240, nstep)

    ! Accumulate and extract elai_p (heald 04/06)
    do p = begp,endp
       rbufslp(p) = elai(p)
    end do
    call update_accum_field  ('LAIP', rbufslp, nstep)
    call extract_accum_field ('LAIP', elai_p, nstep)



#if (defined CNDV)
    ! Accumulate and extract TDA
    ! (accumulates TBOT as 30-day average)
    ! Also determine t_mo_min

!dir$ concurrent
!cdir nodep
    do p = begp,endp
       g = pgridcell(p)
       rbufslp(p) = forc_t(g)
    end do
    call update_accum_field  ('TDA', rbufslp, nstep)
    call extract_accum_field ('TDA', rbufslp, nstep)
!dir$ concurrent
!cdir nodep
    do p = begp,endp
       t_mo(p) = rbufslp(p)
       t_mo_min(p) = min(t_mo_min(p), rbufslp(p))
    end do

    ! Accumulate and extract T10
    !(acumulates TSA as 10-day running mean)

    call update_accum_field  ('T10', t_ref2m, nstep)
    call extract_accum_field ('T10', t10, nstep)

    ! Accumulate and extract FNPSN10
    !(accumulates fpsn-frmf as 10-day running mean)



!dir$ concurrent
!cdir nodep
!    do p = begp,endp
!       rbufslp(p) = fpsn(p) - frmf(p)
!    end do
!    call update_accum_field  ('FNPSN10', rbufslp, nstep)
!    call extract_accum_field ('FNPSN10', fnpsn10, nstep)

    ! Accumulate and extract PREC365
    ! (accumulates total precipitation as 365-day running mean)

!dir$ concurrent
!cdir nodep
    do p = begp,endp
       g = pgridcell(p)
       rbufslp(p) = forc_rain(g) + forc_snow(g)
    end do
    call update_accum_field  ('PREC365', rbufslp, nstep)
    call extract_accum_field ('PREC365', prec365, nstep)

    ! Accumulate growing degree days based on 10-day running mean temperature.
    ! Accumulate GDD above 0C and -5C using extracted t10 from accumulated variable.
    ! The trigger to reset the accumulated values to zero is -99999.
    ! agddtw is currently reset at the end of each year in subr. lpj

    ! Accumulate and extract AGDDO

!dir$ concurrent
!cdir nodep
    do p = begp,endp
       rbufslp(p) = (t10(p) - tfrz) * dtime / cday
       if (rbufslp(p) < 0._r8) rbufslp(p) = -99999.
    end do
    call update_accum_field  ('AGDD0', rbufslp, nstep)
    call extract_accum_field ('AGDD0', agdd0, nstep)

    ! Accumulate and extract AGDD5

!dir$ concurrent
!cdir nodep
    do p = begp,endp
       rbufslp(p) = (t10(p) - (tfrz - 5.0))*dtime / cday
       if (rbufslp(p) < 0._r8) rbufslp(p) = -99999.
    end do
    call update_accum_field  ('AGDD5', rbufslp, nstep)
    call extract_accum_field ('AGDD5', agdd5, nstep)

    ! Accumulate and extract AGDDTW

!dir$ concurrent
!cdir nodep
    do p = begp,endp
       itypveg = itype(p)
       rbufslp(p) = max(0.0, (t10(p) - (tfrz+pftpar(itypveg,31))) &
            * dtime/cday)
    end do
    call update_accum_field  ('AGDDTW', rbufslp, nstep)
    call extract_accum_field ('AGDDTW', agddtw, nstep)

    ! Accumulate and extract AGDD

!dir$ concurrent
!cdir nodep
    do p = begp,endp
       rbufslp(p) = max(0.0, (t_ref2m(p) - (tfrz + 5.0)) &
            * dtime/cday)
    end do
    call update_accum_field  ('AGDD', rbufslp, nstep)
    call extract_accum_field ('AGDD', agdd, nstep)
#endif

!CLM4
#if (defined CROP)
    ! Accumulate and extract TDM10

    do p = begp,endp
       rbufslp(p) = min(t_ref2m_min(p),t_ref2m_min_inst(p)) !slevis: ok choice?
       if (rbufslp(p) > 1.e30_r8) rbufslp(p) = SHR_CONST_TKFRZ !and were 'min'&
    end do                                         !'min_inst' not initialized?
    call update_accum_field  ('TDM10', rbufslp, nstep)
    call extract_accum_field ('TDM10', a10tmin, nstep)

    ! Accumulate and extract TDM5

    do p = begp,endp
       rbufslp(p) = min(t_ref2m_min(p),t_ref2m_min_inst(p)) !slevis: ok choice?
       if (rbufslp(p) > 1.e30_r8) rbufslp(p) = SHR_CONST_TKFRZ !and were 'min'&
    end do                                         !'min_inst' not initialized?
    call update_accum_field  ('TDM5', rbufslp, nstep)
    call extract_accum_field ('TDM5', a5tmin, nstep)

    ! Accumulate and extract GDD0

    do p = begp,endp
       itypveg = itype(p)
       g = pgridcell(p)
       if (month==1 .and. day==1 .and. secs==int(dtime)) then
          rbufslp(p) = -99999._r8 ! reset gdd
       else if (( month > 3 .and. month < 10 .and. latdeg(g) >= 0._r8) .or. &
                ((month > 9 .or.  month < 4) .and. latdeg(g) <  0._r8)     ) then
          rbufslp(p) = max(0._r8, min(26._r8, t_ref2m(p)-SHR_CONST_TKFRZ)) &
                       * dtime/SHR_CONST_CDAY
       else
          rbufslp(p) = 0._r8      ! keeps gdd unchanged at other times (eg, through Dec in NH)
       end if
    end do
    call update_accum_field  ('GDD0', rbufslp, nstep)
    call extract_accum_field ('GDD0', gdd0, nstep)

    ! Accumulate and extract GDD8

    do p = begp,endp
       itypveg = itype(p)
       g = pgridcell(p)
       if (month==1 .and. day==1 .and. secs==int(dtime)) then
          rbufslp(p) = -99999._r8 ! reset gdd
       else if (( month > 3 .and. month < 10 .and. latdeg(g) >= 0._r8) .or. &
                ((month > 9 .or.  month < 4) .and. latdeg(g) <  0._r8)     ) then
          rbufslp(p) = max(0._r8, min(30._r8, &
                                      t_ref2m(p)-(SHR_CONST_TKFRZ + 8._r8))) &
                       * dtime/SHR_CONST_CDAY
       else
          rbufslp(p) = 0._r8      ! keeps gdd unchanged at other times (eg, through Dec in NH)
       end if
    end do
    call update_accum_field  ('GDD8', rbufslp, nstep)
    call extract_accum_field ('GDD8', gdd8, nstep)

    ! Accumulate and extract GDD10

    do p = begp,endp
       itypveg = itype(p)
       g = pgridcell(p)
       if (month==1 .and. day==1 .and. secs==int(dtime)) then
          rbufslp(p) = -99999._r8 ! reset gdd
       else if (( month > 3 .and. month < 10 .and. latdeg(g) >= 0._r8) .or. &
                ((month > 9 .or.  month < 4) .and. latdeg(g) <  0._r8)     ) then
          rbufslp(p) = max(0._r8, min(30._r8, &
                                      t_ref2m(p)-(SHR_CONST_TKFRZ + 10._r8))) &
                       * dtime/SHR_CONST_CDAY
       else
          rbufslp(p) = 0._r8      ! keeps gdd unchanged at other times (eg, through Dec in NH)
       end if
    end do
    call update_accum_field  ('GDD10', rbufslp, nstep)
    call extract_accum_field ('GDD10', gdd10, nstep)

    ! Accumulate and extract GDDPLANT

    do p = begp,endp
       if (croplive(p) == 1) then ! relative to planting date
          itypveg = itype(p)
          rbufslp(p) = max(0._r8, min(mxtmp(itypveg), &
                                      t_ref2m(p)-(SHR_CONST_TKFRZ + baset(itypveg)))) &
                       * dtime/SHR_CONST_CDAY
          if (itypveg == nwwheat) rbufslp(p) = rbufslp(p)*vf(p)
       else
          rbufslp(p) = -99999._r8
       end if
    end do
    call update_accum_field  ('GDDPLANT', rbufslp, nstep)
    call extract_accum_field ('GDDPLANT', gddplant, nstep)

    ! Accumulate and extract GDDTSOI
    ! In agroibis this variable is calculated
    ! to 0.05 m, so here we use the top two soil layers

    do p = begp,endp
       if (croplive(p) == 1) then ! relative to planting date
          itypveg = itype(p)
          c = pcolumn(p)
          rbufslp(p) = max(0._r8, min(mxtmp(itypveg), &
           ((t_soisno(c,1)*dz(c,1)+t_soisno(c,2)*dz(c,2))/(dz(c,1)+dz(c,2))) - &
           (SHR_CONST_TKFRZ + baset(itypveg)))) * dtime/SHR_CONST_CDAY
          if (itypveg == nwwheat) rbufslp(p) = rbufslp(p)*vf(p)
       else
          rbufslp(p) = -99999._r8
       end if
    end do
    call update_accum_field  ('GDDTSOI', rbufslp, nstep)
    call extract_accum_field ('GDDTSOI', gddtsoi, nstep)

#endif


    ! Deallocate dynamic memory

    deallocate(rbufslp)

  end subroutine updateAccFlds

!-----------------------------------------------------------------------
!BOP
!
! !IROUTINE: initAccClmtype
!
! !INTERFACE:
  subroutine initAccClmtype  !(t2m_max,t2m_min,t2m_max_inst,t2m_min_inst)
!
! !DESCRIPTION:
! Initialize clmtype variables that are associated with
! time accumulated fields. This routine is called in an initial run
! at nstep=0 for cam and csm mode and at nstep=1 for offline mode.
! This routine is also always called for a restart run and
! therefore must be called after the restart file is read in
! and the accumulated fields are obtained.
!
! !USES:
    use shr_kind_mod, only: r8 => shr_kind_r8
    use clmtype
    use decompMod   , only : get_proc_bounds
    use accumulMod  , only : extract_accum_field
    use clm_varcon  , only : spval
    use globals     , only : nstep
!
! !ARGUMENTS:
    implicit none
!
! !CALLED FROM:
!
! !REVISION HISTORY:
! Created by Mariana Vertenstein
!
! !LOCAL VARIABLES:
!
! local pointers to implicit out arguments
!
    real(r8), pointer :: t_ref2m_min(:)      ! daily minimum of average 2 m height surface air temperature (K)
    real(r8), pointer :: t_ref2m_max(:)      ! daily maximum of average 2 m height surface air temperature (K)
    real(r8), pointer :: t_ref2m_min_inst(:) ! instantaneous daily min of average 2 m height surface air temp (K)
    real(r8), pointer :: t_ref2m_max_inst(:) ! instantaneous daily max of average 2 m height surface air temp (K)
    real(r8), pointer :: t_ref2m_min_u(:)    ! Urban daily minimum of average 2 m height surface air temperature (K)
    real(r8), pointer :: t_ref2m_min_r(:)    ! Rural daily minimum of average 2 m height surface air temperature (K)
    real(r8), pointer :: t_ref2m_max_u(:)    ! Urban daily maximum of average 2 m height surface air temperature (K)
    real(r8), pointer :: t_ref2m_max_r(:)    ! Rural daily maximum of average 2 m height surface air temperature (K)
    real(r8), pointer :: t_ref2m_min_inst_u(:) ! Urban instantaneous daily min of average 2 m height surface air temp (K)
    real(r8), pointer :: t_ref2m_min_inst_r(:) ! Rural instantaneous daily min of average 2 m height surface air temp (K)
    real(r8), pointer :: t_ref2m_max_inst_u(:) ! Urban instantaneous daily max of average 2 m height surface air temp (K)
    real(r8), pointer :: t_ref2m_max_inst_r(:) ! Rural instantaneous daily max of average 2 m height surface air temp (K)
#ifdef CNDV
    real(r8), pointer :: t10(:)              ! 10-day running mean of the 2 m temperature (K)
    real(r8), pointer :: t_mo(:)             ! 30-day average temperature (Kelvin)
    real(r8), pointer :: prec365(:)          ! 365-day running mean of tot. precipitation
    real(r8), pointer :: agddtw(:)           ! accumulated growing degree days above twmax
    real(r8), pointer :: agdd(:)             ! accumulated growing degree days above 5
#endif
#if (defined CROP)
    real(r8), pointer :: gdd0(:)             ! growing degree-days base 0C'
    real(r8), pointer :: gdd8(:)             ! growing degree-days base 8C from planting
    real(r8), pointer :: gdd10(:)            ! growing degree-days base 10C from planting
    real(r8), pointer :: gddplant(:)         ! growing degree-days from planting
    real(r8), pointer :: gddtsoi(:)          ! growing degree-days from planting (top two soil layers)
    real(r8), pointer :: a10tmin(:)          ! 10-day running mean of min 2-m temperature
    real(r8), pointer :: a5tmin(:)           ! 5-day running mean of min 2-m temperature
#endif
    ! heald (04/06): accumulated variables for VOC emissions
    real(r8), pointer :: t_veg24(:)          ! 24hr average vegetation temperature (K)
    real(r8), pointer :: t_veg240(:)         ! 240hr average vegetation temperature (Kelvin)
    real(r8), pointer :: fsd24(:)            ! 24hr average of direct beam radiation 
    real(r8), pointer :: fsd240(:)           ! 240hr average of direct beam radiation 
    real(r8), pointer :: fsi24(:)            ! 24hr average of diffuse beam radiation 
    real(r8), pointer :: fsi240(:)           ! 240hr average of diffuse beam radiation 
    real(r8), pointer :: fsun24(:)           ! 24hr average of sunlit fraction of canopy 
    real(r8), pointer :: fsun240(:)          ! 240hr average of sunlit fraction of canopy
    real(r8), pointer :: elai_p(:)           ! leaf area index average over timestep 
!
! !LOCAL VARIABLES:
!
!
! !OTHER LOCAL VARIABLES:
!EOP
    integer :: p            ! indices
!    integer :: nstep        ! time step
    integer :: ier          ! error status
    integer :: begp, endp   ! per-proc beginning and ending pft indices
    integer :: begc, endc   ! per-proc beginning and ending column indices
    integer :: begl, endl   ! per-proc beginning and ending landunit indices
    integer :: begg, endg   ! per-proc gridcell ending gridcell indices
    real(r8), pointer :: rbufslp(:)  ! temporary
    character(len=32) :: subname = 'initAccClmtype'  ! subroutine name
!-----------------------------------------------------------------------


    ! Assign local pointers to derived subtypes components (pft-level)

    t_ref2m_max_inst => clm3%g%l%c%p%pes%t_ref2m_max_inst
    t_ref2m_min_inst => clm3%g%l%c%p%pes%t_ref2m_min_inst
    t_ref2m_max      => clm3%g%l%c%p%pes%t_ref2m_max
    t_ref2m_min      => clm3%g%l%c%p%pes%t_ref2m_min
    t_ref2m_max_inst_u => clm3%g%l%c%p%pes%t_ref2m_max_inst_u
    t_ref2m_max_inst_r => clm3%g%l%c%p%pes%t_ref2m_max_inst_r
    t_ref2m_min_inst_u => clm3%g%l%c%p%pes%t_ref2m_min_inst_u
    t_ref2m_min_inst_r => clm3%g%l%c%p%pes%t_ref2m_min_inst_r
    t_ref2m_max_u      => clm3%g%l%c%p%pes%t_ref2m_max_u
    t_ref2m_max_r      => clm3%g%l%c%p%pes%t_ref2m_max_r
    t_ref2m_min_u      => clm3%g%l%c%p%pes%t_ref2m_min_u
    t_ref2m_min_r      => clm3%g%l%c%p%pes%t_ref2m_min_r
#if (defined CNDV)
    t10              => clm3%g%l%c%p%pdgvs%t10
    t_mo             => clm3%g%l%c%p%pdgvs%t_mo
    prec365          => clm3%g%l%c%p%pdgvs%prec365
    agddtw           => clm3%g%l%c%p%pdgvs%agddtw
    agdd             => clm3%g%l%c%p%pdgvs%agdd
#endif
#if (defined CROP)
    gdd0             => clm3%g%l%c%p%pps%gdd0
    gdd8             => clm3%g%l%c%p%pps%gdd8
    gdd10            => clm3%g%l%c%p%pps%gdd10
    gddplant         => clm3%g%l%c%p%pps%gddplant
    gddtsoi          => clm3%g%l%c%p%pps%gddtsoi
    a10tmin          => clm3%g%l%c%p%pps%a10tmin
    a5tmin           => clm3%g%l%c%p%pps%a5tmin
#endif
    ! heald (04/06): accumulated variables for VOC emissions
    t_veg24          => clm3%g%l%c%p%pvs%t_veg24
    t_veg240         => clm3%g%l%c%p%pvs%t_veg240
    fsd24            => clm3%g%l%c%p%pvs%fsd24
    fsd240           => clm3%g%l%c%p%pvs%fsd240
    fsi24            => clm3%g%l%c%p%pvs%fsi24
    fsi240           => clm3%g%l%c%p%pvs%fsi240
    fsun24           => clm3%g%l%c%p%pvs%fsun24
    fsun240          => clm3%g%l%c%p%pvs%fsun240
    elai_p           => clm3%g%l%c%p%pvs%elai_p


    ! Determine necessary indices

    call get_proc_bounds(begg, endg, begl, endl, begc, endc, begp, endp)

    ! Initialize 2m ref temperature max and min values

    do p = begp,endp
          t_ref2m_max(p) = spval
          t_ref2m_min(p) = spval
          t_ref2m_max_inst(p) = -spval
          t_ref2m_min_inst(p) =  spval
          t_ref2m_max_u(p) = spval
          t_ref2m_max_r(p) = spval
          t_ref2m_min_u(p) = spval
          t_ref2m_min_r(p) = spval
          t_ref2m_max_inst_u(p) = -spval
          t_ref2m_max_inst_r(p) = -spval
          t_ref2m_min_inst_u(p) =  spval
          t_ref2m_min_inst_r(p) =  spval
    end do


    ! Allocate needed dynamic memory for single level pft field

    allocate(rbufslp(begp:endp), stat=ier)
    if (ier/=0) then
       write(6,*)'update_accum_hist allocation error for rbufslp'
       call endrun
    endif

    ! Initialize clmtype variables that are to be time accumulated

    call extract_accum_field ('T_VEG24', rbufslp, nstep)
    do p = begp,endp
       t_veg24(p) = rbufslp(p)
    end do
    
    call extract_accum_field ('T_VEG240', rbufslp, nstep)
    do p = begp,endp
       t_veg240(p) = rbufslp(p)
    end do
    
    call extract_accum_field ('FSD24', rbufslp, nstep)
    do p = begp,endp
       fsd24(p) = rbufslp(p)
    end do
    
    call extract_accum_field ('FSD240', rbufslp, nstep)
    do p = begp,endp
       fsd240(p) = rbufslp(p)
    end do
    
    call extract_accum_field ('FSI24', rbufslp, nstep)
    do p = begp,endp
       fsi24(p) = rbufslp(p)
    end do

    call extract_accum_field ('FSI240', rbufslp, nstep)
    do p = begp,endp
       fsi240(p) = rbufslp(p)
    end do

    call extract_accum_field ('FSUN24', rbufslp, nstep)
    do p = begp,endp
       fsun24(p) = rbufslp(p)
    end do

    call extract_accum_field ('FSUN240', rbufslp, nstep)
    do p = begp,endp
       fsun240(p) = rbufslp(p)
    end do

    call extract_accum_field ('LAIP', rbufslp, nstep)
    do p = begp,endp
       elai_p(p) = rbufslp(p)
    end do

#if (defined CROP)

    call extract_accum_field ('GDD0', rbufslp, nstep)
    do p = begp,endp
       gdd0(p) = rbufslp(p)
    end do

    call extract_accum_field ('GDD8', rbufslp, nstep)
    do p = begp,endp
       gdd8(p) = rbufslp(p)
    end do

    call extract_accum_field ('GDD10', rbufslp, nstep)
    do p = begp,endp
       gdd10(p) = rbufslp(p)
    end do

    call extract_accum_field ('GDDPLANT', rbufslp, nstep)
    do p = begp,endp
       gddplant(p) = rbufslp(p)
    end do

    call extract_accum_field ('GDDTSOI', rbufslp, nstep)
    do p = begp,endp
       gddtsoi(p) = rbufslp(p)
    end do

    call extract_accum_field ('TDM10', rbufslp, nstep)
    do p = begp,endp
       a10tmin(p) = rbufslp(p)
    end do

    call extract_accum_field ('TDM5', rbufslp, nstep)
    do p = begp,endp
       a5tmin(p) = rbufslp(p)
    end do

#endif 

#if (defined CNDV)

    call extract_accum_field ('T10', rbufslp, nstep)
    do p = begp,endp
       t10(p) = rbufslp(p)
    end do

    call extract_accum_field ('TDA', rbufslp, nstep)
    do p = begp,endp
       t_mo(p) = rbufslp(p)
    end do

    call extract_accum_field ('PREC365', rbufslp, nstep)
    do p = begp,endp
       prec365(p) = rbufslp(p)
    end do 

    call extract_accum_field ('AGDDTW', rbufslp, nstep)
    do p = begp,endp
       agddtw(p) = rbufslp(p)
    end do 

    call extract_accum_field ('AGDD', rbufslp, nstep)
    do p = begp,endp
       agdd(p) = rbufslp(p)
    end do 

#endif
    deallocate(rbufslp)


  end subroutine initAccClmtype

end module accFldsMod

module SurfaceRadiationMod

!------------------------------------------------------------------------------
!BOP
!
! !MODULE: SurfaceRadiationMod
!
! !DESCRIPTION:
! Calculate solar fluxes absorbed by vegetation and ground surface
!
! !USES:
   use shr_kind_mod, only: r8 => shr_kind_r8
   use globals, only : nstep
!
! !PUBLIC TYPES:
  implicit none
  save
!
! !PUBLIC MEMBER FUNCTIONS:
  public :: SurfaceRadiation ! Solar fluxes absorbed by veg and ground surface
!
! !REVISION HISTORY:
! Created by Mariana Vertenstein
! 11/26/03, Peter Thornton: Added new routine for improved treatment of
!    sunlit/shaded canopy radiation.
! 4/26/05, Peter Thornton: Adopted the sun/shade algorithm as the default,
!    removed the old SurfaceRadiation(), and renamed SurfaceRadiationSunShade()
!    as SurfaceRadiation().
!
!EOP
!------------------------------------------------------------------------------

contains

!------------------------------------------------------------------------------
!BOP
!
! !IROUTINE: SurfaceRadiation
!
! !INTERFACE:
   subroutine SurfaceRadiation(lbp, ubp, num_nourbanp, filter_nourbanp)
!
! !DESCRIPTION: 
! Solar fluxes absorbed by vegetation and ground surface
! Note possible problem when land is on different grid than atmosphere.
! Land may have sun above the horizon (coszen > 0) but atmosphere may
! have sun below the horizon (forc_solad = 0 and forc_solai = 0). This is okay
! because all fluxes (absorbed, reflected, transmitted) are multiplied
! by the incoming flux and all will equal zero.
! Atmosphere may have sun above horizon (forc_solad > 0 and forc_solai > 0) but
! land may have sun below horizon. This is okay because fabd, fabi,
! ftdd, ftid, and ftii all equal zero so that sabv=sabg=fsa=0. Also,
! albd and albi equal one so that fsr=forc_solad+forc_solai. In other words, all
! the radiation is reflected. NDVI should equal zero in this case.
! However, the way the code is currently implemented this is only true
! if (forc_solad+forc_solai)|vis = (forc_solad+forc_solai)|nir.
! Output variables are parsun,parsha,sabv,sabg,fsa,fsr,ndvi
!
! !USES:
     use clmtype
     use clm_varpar      , only : numrad
     use clm_varcon      , only : spval, istsoil
#ifdef CROP
     use clm_varcon      , only : istcrop
#endif
     use clm_varpar      , only : nlevsno
     use SNICARMod       , only : DO_SNO_OC
     use globals         , only : dtime, secs
!
! !ARGUMENTS:
     implicit none
     integer, intent(in) :: lbp, ubp                   ! pft upper and lower bounds
     integer, intent(in) :: num_nourbanp               ! number of pfts in non-urban points in pft filter
     integer, intent(in) :: filter_nourbanp(ubp-lbp+1) ! pft filter for non-urban points
!
! !CALLED FROM:
! subroutine Biogeophysics1 in module Biogeophysics1Mod
! subroutine BiogeophysicsLake in module BiogeophysicsLakeMod
!
! !REVISION HISTORY:
! Author: Gordon Bonan
! 2/18/02, Peter Thornton: Migrated to new data structures. Added a pft loop.
! 6/05/03, Peter Thornton: Modified sunlit/shaded canopy treatment. Original code
! had all radiation being absorbed in the sunlit canopy, and now the sunlit and shaded
! canopies are each given the appropriate fluxes.  There was also an inconsistency in
! the original code, where parsun was not being scaled by leaf area, and so represented
! the entire canopy flux.  This goes into Stomata (in CanopyFluxes) where it is assumed
! to be a flux per unit leaf area. In addition, the fpsn flux coming out of Stomata was
! being scaled back up to the canopy by multiplying by lai, but the input radiation flux was
! for the entire canopy to begin with.  Corrected this inconsistency in this version, so that
! the parsun and parsha fluxes going into canopy fluxes are per unit lai in the sunlit and
! shaded canopies.
! 6/9/03, Peter Thornton: Moved coszen from g%gps to c%cps to avoid problem
! with OpenMP threading over columns, where different columns hit the radiation
! time step at different times during execution.
! 6/10/03, Peter Thornton: Added constraint on negative tot_aid, instead of
! exiting with error. Appears to be happening only at roundoff level.
! 6/11/03, Peter Thornton: Moved calculation of ext inside if (coszen),
! and added check on laisun = 0 and laisha = 0 in calculation of sun_aperlai
! and sha_aperlai.
! 11/26/03, Peter Thornton: During migration to new vector code, created 
!   this as a new routine to handle sunlit/shaded canopy calculations.
! 03/28/08, Mark Flanner: Incorporated SNICAR, including absorbed solar radiation
!   in each snow layer and top soil layer, and optional radiative forcing calculation
!
! !LOCAL VARIABLES:
!
! local pointers to original implicit in arguments
!
     integer , pointer :: ivt(:)           ! pft vegetation type
     integer , pointer :: pcolumn(:)       ! pft's column index
     integer , pointer :: pgridcell(:)     ! pft's gridcell index
     real(r8), pointer :: pwtgcell(:)      ! pft's weight relative to corresponding gridcell
     real(r8), pointer :: elai(:)          ! one-sided leaf area index with burying by snow
     real(r8), pointer :: esai(:)          ! one-sided stem area index with burying by snow
     real(r8), pointer :: londeg(:)        ! longitude (degrees)
     real(r8), pointer :: latdeg(:)        ! latitude (degrees)
     real(r8), pointer :: slasun(:)        ! specific leaf area for sunlit canopy, projected area basis (m^2/gC)
     real(r8), pointer :: slasha(:)        ! specific leaf area for shaded canopy, projected area basis (m^2/gC)
     real(r8), pointer :: gdir(:)	   ! leaf projection in solar direction (0 to 1)
     real(r8), pointer :: omega(:,:)       ! fraction of intercepted radiation that is scattered (0 to 1)
     real(r8), pointer :: coszen(:)	   ! cosine of solar zenith angle
     real(r8), pointer :: forc_solad(:,:)  ! direct beam radiation (W/m**2)
     real(r8), pointer :: forc_solai(:,:)  ! diffuse radiation (W/m**2)
     real(r8), pointer :: fabd(:,:)        ! flux absorbed by veg per unit direct flux
     real(r8), pointer :: fabi(:,:)        ! flux absorbed by veg per unit diffuse flux
     real(r8), pointer :: ftdd(:,:)        ! down direct flux below veg per unit dir flx
     real(r8), pointer :: ftid(:,:)        ! down diffuse flux below veg per unit dir flx
     real(r8), pointer :: ftii(:,:)        ! down diffuse flux below veg per unit dif flx
     real(r8), pointer :: albgrd(:,:)      ! ground albedo (direct)
     real(r8), pointer :: albgri(:,:)      ! ground albedo (diffuse)
     real(r8), pointer :: albd(:,:)        ! surface albedo (direct)
     real(r8), pointer :: albi(:,:)        ! surface albedo (diffuse)
     real(r8), pointer :: slatop(:)        ! specific leaf area at top of canopy, projected area basis [m^2/gC]
     real(r8), pointer :: dsladlai(:)      ! dSLA/dLAI, projected area basis [m^2/gC]
!
! local pointers to original implicit out arguments
!
     real(r8), pointer :: fsun(:)          ! sunlit fraction of canopy
     real(r8), pointer :: laisun(:)        ! sunlit leaf area
     real(r8), pointer :: laisha(:)        ! shaded leaf area
     real(r8), pointer :: sabg(:)          ! solar radiation absorbed by ground (W/m**2)
     real(r8), pointer :: sabv(:)          ! solar radiation absorbed by vegetation (W/m**2)
     real(r8), pointer :: fsa(:)           ! solar radiation absorbed (total) (W/m**2)
     real(r8), pointer :: fsa_r(:)         ! rural solar radiation absorbed (total) (W/m**2)
     integer , pointer :: ityplun(:)       ! landunit type
     integer , pointer :: plandunit(:)     ! index into landunit level quantities
     real(r8), pointer :: parsun(:)        ! average absorbed PAR for sunlit leaves (W/m**2)
     real(r8), pointer :: parsha(:)        ! average absorbed PAR for shaded leaves (W/m**2)
     real(r8), pointer :: fsr(:)           ! solar radiation reflected (W/m**2)
     real(r8), pointer :: fsds_vis_d(:)    ! incident direct beam vis solar radiation (W/m**2)
     real(r8), pointer :: fsds_nir_d(:)    ! incident direct beam nir solar radiation (W/m**2)
     real(r8), pointer :: fsds_vis_i(:)    ! incident diffuse vis solar radiation (W/m**2)
     real(r8), pointer :: fsds_nir_i(:)    ! incident diffuse nir solar radiation (W/m**2)
     real(r8), pointer :: fsr_vis_d(:)     ! reflected direct beam vis solar radiation (W/m**2)
     real(r8), pointer :: fsr_nir_d(:)     ! reflected direct beam nir solar radiation (W/m**2)
     real(r8), pointer :: fsr_vis_i(:)     ! reflected diffuse vis solar radiation (W/m**2)
     real(r8), pointer :: fsr_nir_i(:)     ! reflected diffuse nir solar radiation (W/m**2)
     real(r8), pointer :: fsds_vis_d_ln(:) ! incident direct beam vis solar rad at local noon (W/m**2)
     real(r8), pointer :: fsds_nir_d_ln(:) ! incident direct beam nir solar rad at local noon (W/m**2)
     real(r8), pointer :: fsr_vis_d_ln(:)  ! reflected direct beam vis solar rad at local noon (W/m**2)
     real(r8), pointer :: fsr_nir_d_ln(:)  ! reflected direct beam nir solar rad at local noon (W/m**2)
     real(r8), pointer :: eff_kid(:,:)     ! effective extinction coefficient for indirect from direct
     real(r8), pointer :: eff_kii(:,:)     ! effective extinction coefficient for indirect from indirect
     real(r8), pointer :: sun_faid(:,:)    ! fraction sun canopy absorbed indirect from direct
     real(r8), pointer :: sun_faii(:,:)    ! fraction sun canopy absorbed indirect from indirect
     real(r8), pointer :: sha_faid(:,:)    ! fraction shade canopy absorbed indirect from direct
     real(r8), pointer :: sha_faii(:,:)    ! fraction shade canopy absorbed indirect from indirect
     real(r8), pointer :: sun_add(:,:)     ! sun canopy absorbed direct from direct (W/m**2)
     real(r8), pointer :: tot_aid(:,:)     ! total canopy absorbed indirect from direct (W/m**2)
     real(r8), pointer :: sun_aid(:,:)     ! sun canopy absorbed indirect from direct (W/m**2)
     real(r8), pointer :: sun_aii(:,:)     ! sun canopy absorbed indirect from indirect (W/m**2)
     real(r8), pointer :: sha_aid(:,:)     ! shade canopy absorbed indirect from direct (W/m**2)
     real(r8), pointer :: sha_aii(:,:)     ! shade canopy absorbed indirect from indirect (W/m**2)
     real(r8), pointer :: sun_atot(:,:)    ! sun canopy total absorbed (W/m**2)
     real(r8), pointer :: sha_atot(:,:)    ! shade canopy total absorbed (W/m**2)
     real(r8), pointer :: sun_alf(:,:)     ! sun canopy total absorbed by leaves (W/m**2)
     real(r8), pointer :: sha_alf(:,:)     ! shade canopy total absored by leaves (W/m**2)
     real(r8), pointer :: sun_aperlai(:,:) ! sun canopy total absorbed per unit LAI (W/m**2)
     real(r8), pointer :: sha_aperlai(:,:) ! shade canopy total absorbed per unit LAI (W/m**2)
     real(r8), pointer :: flx_absdv(:,:)   ! direct flux absorption factor (col,lyr): VIS [frc]
     real(r8), pointer :: flx_absdn(:,:)   ! direct flux absorption factor (col,lyr): NIR [frc]
     real(r8), pointer :: flx_absiv(:,:)   ! diffuse flux absorption factor (col,lyr): VIS [frc]
     real(r8), pointer :: flx_absin(:,:)   ! diffuse flux absorption factor (col,lyr): NIR [frc]
     integer , pointer :: snl(:)           ! negative number of snow layers [nbr]
     real(r8), pointer :: albgrd_pur(:,:)    ! pure snow ground albedo (direct)
     real(r8), pointer :: albgri_pur(:,:)    ! pure snow ground albedo (diffuse)
     real(r8), pointer :: albgrd_bc(:,:)     ! ground albedo without BC (direct) (col,bnd)
     real(r8), pointer :: albgri_bc(:,:)     ! ground albedo without BC (diffuse) (col,bnd)
     real(r8), pointer :: albgrd_oc(:,:)     ! ground albedo without OC (direct) (col,bnd)
     real(r8), pointer :: albgri_oc(:,:)     ! ground albedo without OC (diffuse) (col,bnd)
     real(r8), pointer :: albgrd_dst(:,:)    ! ground albedo without dust (direct) (col,bnd)
     real(r8), pointer :: albgri_dst(:,:)    ! ground albedo without dust (diffuse) (col,bnd)
     real(r8), pointer :: albsnd_hst(:,:)    ! snow albedo, direct, for history files (col,bnd) [frc]
     real(r8), pointer :: albsni_hst(:,:)    ! snow ground albedo, diffuse, for history files (col,bnd
     real(r8), pointer :: sabg_lyr(:,:)      ! absorbed radiative flux (pft,lyr) [W/m2]
     real(r8), pointer :: sfc_frc_aer(:)     ! surface forcing of snow with all aerosols (pft) [W/m2]
     real(r8), pointer :: sfc_frc_bc(:)      ! surface forcing of snow with BC (pft) [W/m2]
     real(r8), pointer :: sfc_frc_oc(:)      ! surface forcing of snow with OC (pft) [W/m2]
     real(r8), pointer :: sfc_frc_dst(:)     ! surface forcing of snow with dust (pft) [W/m2]
     real(r8), pointer :: sfc_frc_aer_sno(:) ! surface forcing of snow with all aerosols, averaged only when snow is present (pft) [W/m2]
     real(r8), pointer :: sfc_frc_bc_sno(:)  ! surface forcing of snow with BC, averaged only when snow is present (pft) [W/m2]
     real(r8), pointer :: sfc_frc_oc_sno(:)  ! surface forcing of snow with OC, averaged only when snow is present (pft) [W/m2]
     real(r8), pointer :: sfc_frc_dst_sno(:) ! surface forcing of snow with dust, averaged only when snow is present (pft) [W/m2]
     real(r8), pointer :: frac_sno(:)      ! fraction of ground covered by snow (0 to 1)
     real(r8), pointer :: fsr_sno_vd(:)    ! reflected visible, direct radiation from snow (for history files) (pft) [W/m2]
     real(r8), pointer :: fsr_sno_nd(:)    ! reflected near-IR, direct radiation from snow (for history files) (pft) [W/m2]
     real(r8), pointer :: fsr_sno_vi(:)    ! reflected visible, diffuse radiation from snow (for history files) (pft) [W/m2]
     real(r8), pointer :: fsr_sno_ni(:)    ! reflected near-IR, diffuse radiation from snow (for history files) (pft) [W/m2]
     real(r8), pointer :: fsds_sno_vd(:)   ! incident visible, direct radiation on snow (for history files) (pft) [W/m2]
     real(r8), pointer :: fsds_sno_nd(:)   ! incident near-IR, direct radiation on snow (for history files) (pft) [W/m2]
     real(r8), pointer :: fsds_sno_vi(:)   ! incident visible, diffuse radiation on snow (for history files) (pft) [W/m2]
     real(r8), pointer :: fsds_sno_ni(:)   ! incident near-IR, diffuse radiation on snow (for history files) (pft) [W/m2]
     real(r8), pointer :: snowdp(:)        ! snow height (m)

!
!
! !OTHER LOCAL VARIABLES:
!EOP
!
     integer , parameter :: nband = numrad    ! number of solar radiation waveband classes
     real(r8), parameter :: mpe = 1.e-06_r8   ! prevents overflow for division by zero
     integer  :: fp                  ! non-urban filter pft index
     integer  :: p                   ! pft index
     integer  :: c                   ! column index
     integer  :: l                   ! landunit index
     integer  :: g                   ! grid cell index
     integer  :: ib                  ! waveband number (1=vis, 2=nir)
     real(r8) :: absrad              ! absorbed solar radiation (W/m**2)
     real(r8) :: rnir                ! reflected solar radiation [nir] (W/m**2)
     real(r8) :: rvis                ! reflected solar radiation [vis] (W/m**2)
     real(r8) :: laifra              ! leaf area fraction of canopy
     real(r8) :: trd(lbp:ubp,numrad) ! transmitted solar radiation: direct (W/m**2)
     real(r8) :: tri(lbp:ubp,numrad) ! transmitted solar radiation: diffuse (W/m**2)
     real(r8) :: cad(lbp:ubp,numrad) ! direct beam absorbed by canopy (W/m**2)
     real(r8) :: cai(lbp:ubp,numrad) ! diffuse radiation absorbed by canopy (W/m**2)
     real(r8) :: vai(lbp:ubp)        ! total leaf area index + stem area index, one sided
     real(r8) :: ext                 ! optical depth direct beam per unit LAI+SAI
     real(r8) :: t1, t2              ! temporary variables
     real(r8) :: cosz
     integer  :: local_secp1         ! seconds into current date in local time
     integer  :: i                   ! layer index [idx]
     real(r8) :: sabg_snl_sum        ! temporary, absorbed energy in all active snow layers [W/m2]
     real(r8) :: absrad_pur          ! temp: absorbed solar radiation by pure snow [W/m2]
     real(r8) :: absrad_bc           ! temp: absorbed solar radiation without BC [W/m2]
     real(r8) :: absrad_oc           ! temp: absorbed solar radiation without OC [W/m2]
     real(r8) :: absrad_dst          ! temp: absorbed solar radiation without dust [W/m2]
     real(r8) :: sabg_pur(lbp:ubp)   ! solar radiation absorbed by ground with pure snow [W/m2]
     real(r8) :: sabg_bc(lbp:ubp)    ! solar radiation absorbed by ground without BC [W/m2]
     real(r8) :: sabg_oc(lbp:ubp)    ! solar radiation absorbed by ground without OC [W/m2]
     real(r8) :: sabg_dst(lbp:ubp)   ! solar radiation absorbed by ground without dust [W/m2]
!------------------------------------------------------------------------------

     ! Assign local pointers to multi-level derived type members (gridcell level)

     londeg        => clm3%g%londeg
     latdeg        => clm3%g%latdeg
     forc_solad    => clm_a2l%forc_solad
     forc_solai    => clm_a2l%forc_solai

     ! Assign local pointers to multi-level derived type members (landunit level)

     ityplun => clm3%g%l%itype

     ! Assign local pointers to multi-level derived type members (column level)

     albgrd        => clm3%g%l%c%cps%albgrd
     albgri        => clm3%g%l%c%cps%albgri
     coszen        => clm3%g%l%c%cps%coszen

     ! Assign local pointers to derived type members (pft-level)

     plandunit     => clm3%g%l%c%p%landunit
     ivt           => clm3%g%l%c%p%itype
     pcolumn       => clm3%g%l%c%p%column
     pgridcell     => clm3%g%l%c%p%gridcell
     pwtgcell      => clm3%g%l%c%p%wtgcell
     elai          => clm3%g%l%c%p%pps%elai
     esai          => clm3%g%l%c%p%pps%esai
     slasun        => clm3%g%l%c%p%pps%slasun
     slasha        => clm3%g%l%c%p%pps%slasha
     gdir          => clm3%g%l%c%p%pps%gdir
     omega         => clm3%g%l%c%p%pps%omega
     laisun        => clm3%g%l%c%p%pps%laisun
     laisha        => clm3%g%l%c%p%pps%laisha
     fabd          => clm3%g%l%c%p%pps%fabd
     fabi          => clm3%g%l%c%p%pps%fabi
     ftdd          => clm3%g%l%c%p%pps%ftdd
     ftid          => clm3%g%l%c%p%pps%ftid
     ftii          => clm3%g%l%c%p%pps%ftii
     albd          => clm3%g%l%c%p%pps%albd
     albi          => clm3%g%l%c%p%pps%albi
     fsun          => clm3%g%l%c%p%pps%fsun
     sabg          => clm3%g%l%c%p%pef%sabg
     sabv          => clm3%g%l%c%p%pef%sabv
     snowdp        => clm3%g%l%c%cps%snowdp
     fsa           => clm3%g%l%c%p%pef%fsa
     fsa_r         => clm3%g%l%c%p%pef%fsa_r
     fsr           => clm3%g%l%c%p%pef%fsr
     parsun        => clm3%g%l%c%p%pef%parsun
     parsha        => clm3%g%l%c%p%pef%parsha
     fsds_vis_d    => clm3%g%l%c%p%pef%fsds_vis_d
     fsds_nir_d    => clm3%g%l%c%p%pef%fsds_nir_d
     fsds_vis_i    => clm3%g%l%c%p%pef%fsds_vis_i
     fsds_nir_i    => clm3%g%l%c%p%pef%fsds_nir_i
     fsr_vis_d     => clm3%g%l%c%p%pef%fsr_vis_d
     fsr_nir_d     => clm3%g%l%c%p%pef%fsr_nir_d
     fsr_vis_i     => clm3%g%l%c%p%pef%fsr_vis_i
     fsr_nir_i     => clm3%g%l%c%p%pef%fsr_nir_i
     fsds_vis_d_ln => clm3%g%l%c%p%pef%fsds_vis_d_ln
     fsds_nir_d_ln => clm3%g%l%c%p%pef%fsds_nir_d_ln
     fsr_vis_d_ln  => clm3%g%l%c%p%pef%fsr_vis_d_ln
     fsr_nir_d_ln  => clm3%g%l%c%p%pef%fsr_nir_d_ln
     eff_kid       => clm3%g%l%c%p%pps%eff_kid
     eff_kii       => clm3%g%l%c%p%pps%eff_kii
     sun_faid      => clm3%g%l%c%p%pps%sun_faid
     sun_faii      => clm3%g%l%c%p%pps%sun_faii
     sha_faid      => clm3%g%l%c%p%pps%sha_faid
     sha_faii      => clm3%g%l%c%p%pps%sha_faii
     sun_add       => clm3%g%l%c%p%pef%sun_add
     tot_aid       => clm3%g%l%c%p%pef%tot_aid
     sun_aid       => clm3%g%l%c%p%pef%sun_aid
     sun_aii       => clm3%g%l%c%p%pef%sun_aii
     sha_aid       => clm3%g%l%c%p%pef%sha_aid
     sha_aii       => clm3%g%l%c%p%pef%sha_aii
     sun_atot      => clm3%g%l%c%p%pef%sun_atot
     sha_atot      => clm3%g%l%c%p%pef%sha_atot
     sun_alf       => clm3%g%l%c%p%pef%sun_alf
     sha_alf       => clm3%g%l%c%p%pef%sha_alf
     sun_aperlai   => clm3%g%l%c%p%pef%sun_aperlai
     sha_aperlai   => clm3%g%l%c%p%pef%sha_aperlai
     
     ! Assign local pointers to derived type members (ecophysiological)

     slatop           => pftcon%slatop
     dsladlai         => pftcon%dsladlai
     frac_sno         => clm3%g%l%c%cps%frac_sno
     flx_absdv        => clm3%g%l%c%cps%flx_absdv
     flx_absdn        => clm3%g%l%c%cps%flx_absdn
     flx_absiv        => clm3%g%l%c%cps%flx_absiv
     flx_absin        => clm3%g%l%c%cps%flx_absin
     sabg_lyr         => clm3%g%l%c%p%pef%sabg_lyr
     snl              => clm3%g%l%c%cps%snl
     sfc_frc_aer      => clm3%g%l%c%p%pef%sfc_frc_aer
     sfc_frc_aer_sno  => clm3%g%l%c%p%pef%sfc_frc_aer_sno
     albgrd_pur       => clm3%g%l%c%cps%albgrd_pur
     albgri_pur       => clm3%g%l%c%cps%albgri_pur
     sfc_frc_bc       => clm3%g%l%c%p%pef%sfc_frc_bc
     sfc_frc_bc_sno   => clm3%g%l%c%p%pef%sfc_frc_bc_sno
     albgrd_bc        => clm3%g%l%c%cps%albgrd_bc
     albgri_bc        => clm3%g%l%c%cps%albgri_bc
     sfc_frc_oc       => clm3%g%l%c%p%pef%sfc_frc_oc
     sfc_frc_oc_sno   => clm3%g%l%c%p%pef%sfc_frc_oc_sno
     albgrd_oc        => clm3%g%l%c%cps%albgrd_oc
     albgri_oc        => clm3%g%l%c%cps%albgri_oc
     sfc_frc_dst      => clm3%g%l%c%p%pef%sfc_frc_dst
     sfc_frc_dst_sno  => clm3%g%l%c%p%pef%sfc_frc_dst_sno
     albgrd_dst       => clm3%g%l%c%cps%albgrd_dst
     albgri_dst       => clm3%g%l%c%cps%albgri_dst
     albsnd_hst       => clm3%g%l%c%cps%albsnd_hst
     albsni_hst       => clm3%g%l%c%cps%albsni_hst
     fsr_sno_vd       => clm3%g%l%c%p%pef%fsr_sno_vd
     fsr_sno_nd       => clm3%g%l%c%p%pef%fsr_sno_nd
     fsr_sno_vi       => clm3%g%l%c%p%pef%fsr_sno_vi
     fsr_sno_ni       => clm3%g%l%c%p%pef%fsr_sno_ni
     fsds_sno_vd      => clm3%g%l%c%p%pef%fsds_sno_vd
     fsds_sno_nd      => clm3%g%l%c%p%pef%fsds_sno_nd
     fsds_sno_vi      => clm3%g%l%c%p%pef%fsds_sno_vi
     fsds_sno_ni      => clm3%g%l%c%p%pef%fsds_sno_ni

     
     ! Determine fluxes

!dir$ concurrent
!cdir nodep
     do fp = 1,num_nourbanp
        p = filter_nourbanp(fp)
        if (pwtgcell(p)>0._r8) then ! was redundant b/c filter already included wt>0; not redundant anymore with chg in filter definition
           sabg(p)       = 0._r8
           sabv(p)       = 0._r8
           fsa(p)        = 0._r8
           l = plandunit(p)
#ifndef CROP
           if (ityplun(l)==istsoil) then
#else
           if (ityplun(l)==istsoil .or. ityplun(l)==istcrop) then
#endif
             fsa_r(p)      = 0._r8
           end if
           sabg_lyr(p,:) = 0._r8
           sabg_pur(p)   = 0._r8
           sabg_bc(p)    = 0._r8
           sabg_oc(p)    = 0._r8
           sabg_dst(p)   = 0._r8
        end if
     end do 

     ! Loop over pfts to calculate fsun, etc
!dir$ concurrent
!cdir nodep
     do fp = 1,num_nourbanp
        p = filter_nourbanp(fp)
        if (pwtgcell(p)>0._r8) then ! see comment with this line above
           c = pcolumn(p)
           g = pgridcell(p)
        
           vai(p) = elai(p) + esai(p)
           if (coszen(c) > 0._r8 .and. elai(p) > 0._r8 .and. gdir(p) > 0._r8) then
              cosz = max(0.001_r8, coszen(c))
              ext = gdir(p)/cosz
              t1 = min(ext*elai(p), 40.0_r8)
              t2 = exp(-t1)
              fsun(p) = (1._r8-t2)/t1
              
              ! new control on low lai, to avoid numerical problems in
              ! calculation of slasun, slasha
              ! PET: 2/29/04
              
              if (elai(p) > 0.01_r8) then
                 laisun(p) = elai(p)*fsun(p)
                 laisha(p) = elai(p)*(1._r8-fsun(p))
                 
                 ! calculate the average specific leaf area for sunlit and shaded
                 ! canopies, when effective LAI > 0
                 slasun(p) = (t2*dsladlai(ivt(p))*ext*elai(p) + &
                              t2*dsladlai(ivt(p)) + &
                              t2*slatop(ivt(p))*ext - &
                              dsladlai(ivt(p)) - &
                              slatop(ivt(p))*ext) / &
                              (ext*(t2-1._r8))
                 slasha(p) = ((slatop(ivt(p)) + &
                             (dsladlai(ivt(p)) * elai(p)/2.0_r8)) * elai(p) - &
                             laisun(p)*slasun(p)) / laisha(p)
              else
                 ! special case for low elai
                 fsun(p) = 1._r8
                 laisun(p) = elai(p)
                 laisha(p) = 0._r8
                 slasun(p) = slatop(ivt(p))
                 slasha(p) = 0._r8
              end if
           else
              fsun(p)   = 0._r8
              laisun(p) = 0._r8
              laisha(p) = elai(p)
              slasun(p) = 0._r8
              slasha(p) = 0._r8
           end if
        end if
     end do
        
     ! Loop over nband wavebands
     do ib = 1, nband
!dir$ concurrent
!cdir nodep
        do fp = 1,num_nourbanp
           p = filter_nourbanp(fp)
           if (pwtgcell(p)>0._r8) then ! see comment with this line above
              c = pcolumn(p)
              g = pgridcell(p)
              
              ! Absorbed by canopy
              
              cad(p,ib) = forc_solad(g,ib)*fabd(p,ib)
              cai(p,ib) = forc_solai(g,ib)*fabi(p,ib)
              sabv(p) = sabv(p) + cad(p,ib) + cai(p,ib)
              fsa(p)  = fsa(p)  + cad(p,ib) + cai(p,ib)
              l = plandunit(p)
#ifndef CROP
              if (ityplun(l)==istsoil) then
#else
              if (ityplun(l)==istsoil .or. ityplun(l)==istcrop) then
#endif
                fsa_r(p)  = fsa_r(p)  + cad(p,ib) + cai(p,ib)
              end if
              
              ! Transmitted = solar fluxes incident on ground
              
              trd(p,ib) = forc_solad(g,ib)*ftdd(p,ib)
              tri(p,ib) = forc_solad(g,ib)*ftid(p,ib) + forc_solai(g,ib)*ftii(p,ib)
    
              ! Solar radiation absorbed by ground surface
              
              absrad  = trd(p,ib)*(1._r8-albgrd(c,ib)) + tri(p,ib)*(1._r8-albgri(c,ib))
              sabg(p) = sabg(p) + absrad
              fsa(p)  = fsa(p)  + absrad
#ifndef CROP
              if (ityplun(l)==istsoil) then
#else
              if (ityplun(l)==istsoil .or. ityplun(l)==istcrop) then
#endif
                fsa_r(p)  = fsa_r(p)  + absrad
              end if

#if (defined SNICAR_FRC)
              ! Solar radiation absorbed by ground surface without BC
              absrad_bc = trd(p,ib)*(1._r8-albgrd_bc(c,ib)) + tri(p,ib)*(1._r8-albgri_bc(c,ib))
              sabg_bc(p) = sabg_bc(p) + absrad_bc

              ! Solar radiation absorbed by ground surface without OC
              absrad_oc = trd(p,ib)*(1._r8-albgrd_oc(c,ib)) + tri(p,ib)*(1._r8-albgri_oc(c,ib))
              sabg_oc(p) = sabg_oc(p) + absrad_oc

              ! Solar radiation absorbed by ground surface without dust
              absrad_dst = trd(p,ib)*(1._r8-albgrd_dst(c,ib)) + tri(p,ib)*(1._r8-albgri_dst(c,ib))
              sabg_dst(p) = sabg_dst(p) + absrad_dst

              ! Solar radiation absorbed by ground surface without any aerosols
              absrad_pur = trd(p,ib)*(1._r8-albgrd_pur(c,ib)) + tri(p,ib)*(1._r8-albgri_pur(c,ib))
              sabg_pur(p) = sabg_pur(p) + absrad_pur
#endif


              ! New sunlit.shaded canopy algorithm
              
              if (coszen(c) > 0._r8 .and. elai(p) > 0._r8 .and. gdir(p) > 0._r8 ) then
                 
                 ! 1. calculate flux of direct beam radiation absorbed in the 
                 ! sunlit canopy as direct (sun_add), and the flux of direct
                 ! beam radiation absorbed in the total canopy as indirect
                 
                 sun_add(p,ib) = forc_solad(g,ib) * (1._r8-ftdd(p,ib)) * (1._r8-omega(p,ib))
                 tot_aid(p,ib) = (forc_solad(g,ib) * fabd(p,ib)) - sun_add(p,ib)
                 
                 ! the following constraint set to catch round-off level errors
                 ! that can cause negative tot_aid
                 
                 tot_aid(p,ib) = max(tot_aid(p,ib), 0._r8)
                 
                 ! 2. calculate the effective extinction coefficients for indirect
                 ! transmission originating from direct and indirect streams,
                 ! using ftid and ftii
                 
                 !eff_kid(p,ib) = -(log(ftid(p,ib)))/vai(p)
                 !eff_kii(p,ib) = -(log(ftii(p,ib)))/vai(p)
                 
                 ! 3. calculate the fraction of indirect radiation being absorbed 
                 ! in the sunlit and shaded canopy fraction. Some of this indirect originates in
                 ! the direct beam and some originates in the indirect beam.

                 !sun_faid(p,ib) = 1.-exp(-eff_kid(p,ib) * vaisun(p))
                 !sun_faii(p,ib) = 1.-exp(-eff_kii(p,ib) * vaisun(p))
                 sun_faid(p,ib) = fsun(p)
                 sun_faii(p,ib) = fsun(p)
                 sha_faid(p,ib) = 1._r8-sun_faid(p,ib)
                 sha_faii(p,ib) = 1._r8-sun_faii(p,ib)

                 ! 4. calculate the total indirect flux absorbed by the sunlit
                 ! and shaded canopy based on these fractions and the fabd and
                 ! fabi from surface albedo calculations

                 sun_aid(p,ib) = tot_aid(p,ib) * sun_faid(p,ib)
                 sun_aii(p,ib) = forc_solai(g,ib)*fabi(p,ib)*sun_faii(p,ib)
                 sha_aid(p,ib) = tot_aid(p,ib) * sha_faid(p,ib)
                 sha_aii(p,ib) = forc_solai(g,ib)*fabi(p,ib)*sha_faii(p,ib)
                 
                 ! 5. calculate the total flux absorbed in the sunlit and shaded
                 ! canopy as the sum of these terms
                 
                 sun_atot(p,ib) = sun_add(p,ib) + sun_aid(p,ib) + sun_aii(p,ib)
                 sha_atot(p,ib) = sha_aid(p,ib) + sha_aii(p,ib)
                 
                 ! 6. calculate the total flux absorbed by leaves in the sunlit
                 ! and shaded canopies
                 
                 laifra = elai(p)/vai(p)
                 sun_alf(p,ib) = sun_atot(p,ib) * laifra
                 sha_alf(p,ib) = sha_atot(p,ib) * laifra
                 
                 ! 7. calculate the fluxes per unit lai in the sunlit and shaded
                 ! canopies
                 
                 if (laisun(p) > 0._r8) then
                    sun_aperlai(p,ib) = sun_alf(p,ib)/laisun(p)
                 else
                    sun_aperlai(p,ib) = 0._r8
                 endif
                 if (laisha(p) > 0._r8) then
                    sha_aperlai(p,ib) = sha_alf(p,ib)/laisha(p)
                 else
                    sha_aperlai(p,ib) = 0._r8
                 endif
             
              else   ! coszen = 0 or elai = 0
                 
                 sun_add(p,ib)     = 0._r8
                 tot_aid(p,ib)     = 0._r8
                 eff_kid(p,ib)     = 0._r8
                 eff_kii(p,ib)     = 0._r8
                 sun_faid(p,ib)    = 0._r8
                 sun_faii(p,ib)    = 0._r8
                 sha_faid(p,ib)    = 0._r8
                 sha_faii(p,ib)    = 0._r8
                 sun_aid(p,ib)     = 0._r8
                 sun_aii(p,ib)     = 0._r8
                 sha_aid(p,ib)     = 0._r8
                 sha_aii(p,ib)     = 0._r8
                 sun_atot(p,ib)    = 0._r8
                 sha_atot(p,ib)    = 0._r8
                 sun_alf(p,ib)     = 0._r8
                 sha_alf(p,ib)     = 0._r8
                 sun_aperlai(p,ib) = 0._r8
                 sha_aperlai(p,ib) = 0._r8
                 
              end if
           end if
        end do ! end of pft loop
     end do ! end nbands loop   

     
     !   compute absorbed flux in each snow layer and top soil layer,
     !   based on flux factors computed in the radiative transfer portion of SNICAR.
     do fp = 1,num_nourbanp
        p = filter_nourbanp(fp)
        if (pwtgcell(p)>0._r8) then
           c = pcolumn(p)
           sabg_snl_sum = 0._r8

           ! CASE1: No snow layers: all energy is absorbed in top soil layer
           if (snl(c) == 0) then
              sabg_lyr(p,:) = 0._r8
              sabg_lyr(p,1) = sabg(p)
              sabg_snl_sum  = sabg_lyr(p,1)
   
           ! CASE 2: Snow layers present: absorbed radiation is scaled according to 
           ! flux factors computed by SNICAR
           else
              do i = -nlevsno+1,1,1
                 sabg_lyr(p,i) = flx_absdv(c,i)*trd(p,1) + flx_absdn(c,i)*trd(p,2) + &
                                 flx_absiv(c,i)*tri(p,1) + flx_absin(c,i)*tri(p,2)
                 ! summed radiation in active snow layers:
                 if (i >= snl(c)+1) then
                    sabg_snl_sum = sabg_snl_sum + sabg_lyr(p,i)
                 endif
              enddo
   
              ! Error handling: The situation below can occur when solar radiation is 
              ! NOT computed every timestep.
              ! When the number of snow layers has changed in between computations of the 
              ! absorbed solar energy in each layer, we must redistribute the absorbed energy
              ! to avoid physically unrealistic conditions. The assumptions made below are 
              ! somewhat arbitrary, but this situation does not arise very frequently. 
              ! This error handling is implemented to accomodate any value of the
              ! radiation frequency.
              if (abs(sabg_snl_sum-sabg(p)) > 0.00001_r8) then
                 if (snl(c) == 0) then
                    sabg_lyr(p,-4:0) = 0._r8
                    sabg_lyr(p,1) = sabg(p)
                 elseif (snl(c) == -1) then
                    sabg_lyr(p,-4:-1) = 0._r8
                    sabg_lyr(p,0) = sabg(p)*0.6_r8
                    sabg_lyr(p,1) = sabg(p)*0.4_r8
                 else
                    sabg_lyr(p,:) = 0._r8
                    sabg_lyr(p,snl(c)+1) = sabg(p)*0.75_r8
                    sabg_lyr(p,snl(c)+2) = sabg(p)*0.25_r8
                 endif
              endif

              ! If shallow snow depth, all solar radiation absorbed in top or top two snow layers
              ! to prevent unrealistic timestep soil warming 
              if (snowdp(c) < 0.10_r8) then
                 if (snl(c) == 0) then
                    sabg_lyr(p,-4:0) = 0._r8
                    sabg_lyr(p,1) = sabg(p)
                 elseif (snl(c) == -1) then
                    sabg_lyr(p,-4:-1) = 0._r8
                    sabg_lyr(p,0) = sabg(p)
                    sabg_lyr(p,1) = 0._r8
                 else
                    sabg_lyr(p,:) = 0._r8
                    sabg_lyr(p,snl(c)+1) = sabg(p)*0.75_r8
                    sabg_lyr(p,snl(c)+2) = sabg(p)*0.25_r8
                 endif
              endif

           endif

           ! This situation should not happen:
           if (abs(sum(sabg_lyr(p,:))-sabg(p)) > 0.00001_r8) then
              write(6,*) "SNICAR ERROR: Absorbed ground radiation not equal to summed snow layer radiation. pft = ",   &
                             p," Col= ", c, " Diff= ",sum(sabg_lyr(p,:))-sabg(p), " sabg(p)= ", sabg(p), " sabg_sum(p)= ", &
                             sum(sabg_lyr(p,:)), " snl(c)= ", snl(c)
              write(6,*) "flx_absdv1= ", trd(p,1)*(1.-albgrd(c,1)), "flx_absdv2= ", sum(flx_absdv(c,:))*trd(p,1)
              write(6,*) "flx_absiv1= ", tri(p,1)*(1.-albgri(c,1))," flx_absiv2= ", sum(flx_absiv(c,:))*tri(p,1)
              write(6,*) "flx_absdn1= ", trd(p,2)*(1.-albgrd(c,2))," flx_absdn2= ", sum(flx_absdn(c,:))*trd(p,2)
              write(6,*) "flx_absin1= ", tri(p,2)*(1.-albgri(c,2))," flx_absin2= ", sum(flx_absin(c,:))*tri(p,2)
   
              write(6,*) "albgrd_nir= ", albgrd(c,2)
              write(6,*) "coszen= ", coszen(c)
              call endrun()
           endif

 
#if (defined SNICAR_FRC)

           ! BC aerosol forcing (pft-level):
           sfc_frc_bc(p) = sabg(p) - sabg_bc(p)
   
           ! OC aerosol forcing (pft-level):
           if (DO_SNO_OC) then
              sfc_frc_oc(p) = sabg(p) - sabg_oc(p)
           else
              sfc_frc_oc(p) = 0._r8
           endif
   
           ! dust aerosol forcing (pft-level):
           sfc_frc_dst(p) = sabg(p) - sabg_dst(p)
   
           ! all-aerosol forcing (pft-level):
           sfc_frc_aer(p) = sabg(p) - sabg_pur(p)        
           
           ! forcings averaged only over snow:
           if (frac_sno(c) > 0._r8) then
              sfc_frc_bc_sno(p)  = sfc_frc_bc(p)/frac_sno(c)
              sfc_frc_oc_sno(p)  = sfc_frc_oc(p)/frac_sno(c)
              sfc_frc_dst_sno(p) = sfc_frc_dst(p)/frac_sno(c)
              sfc_frc_aer_sno(p) = sfc_frc_aer(p)/frac_sno(c)
           else
              sfc_frc_bc_sno(p)  = spval
              sfc_frc_oc_sno(p)  = spval
              sfc_frc_dst_sno(p) = spval
              sfc_frc_aer_sno(p) = spval
           endif

#endif
        endif
     enddo


!dir$ concurrent
!cdir nodep
     do fp = 1,num_nourbanp
        p = filter_nourbanp(fp)
        if (pwtgcell(p)>0._r8) then ! see comment with this line above
           g = pgridcell(p)
        
           ! Final step of new sunlit/shaded canopy algorithm
           ! 8. calculate the total and per-unit-lai fluxes for PAR in the
           ! sunlit and shaded canopy leaf fractions
           
           parsun(p) = sun_aperlai(p,1)
           parsha(p) = sha_aperlai(p,1)
           
           ! The following code is duplicated from SurfaceRadiation
           ! NDVI and reflected solar radiation
           
           rvis = albd(p,1)*forc_solad(g,1) + albi(p,1)*forc_solai(g,1)
           rnir = albd(p,2)*forc_solad(g,2) + albi(p,2)*forc_solai(g,2)
           fsr(p) = rvis + rnir
           
           fsds_vis_d(p) = forc_solad(g,1)
           fsds_nir_d(p) = forc_solad(g,2)
           fsds_vis_i(p) = forc_solai(g,1)
           fsds_nir_i(p) = forc_solai(g,2)
           fsr_vis_d(p)  = albd(p,1)*forc_solad(g,1)
           fsr_nir_d(p)  = albd(p,2)*forc_solad(g,2)
           fsr_vis_i(p)  = albi(p,1)*forc_solai(g,1)
           fsr_nir_i(p)  = albi(p,2)*forc_solai(g,2)
           
           local_secp1 = secs + nint((londeg(g)/15._r8*3600._r8)/dtime)*dtime
           local_secp1 = mod(local_secp1,86400)
           if (local_secp1 == 43200) then
              fsds_vis_d_ln(p) = forc_solad(g,1)
              fsds_nir_d_ln(p) = forc_solad(g,2)
              fsr_vis_d_ln(p) = albd(p,1)*forc_solad(g,1)
              fsr_nir_d_ln(p) = albd(p,2)*forc_solad(g,2)
           else
              fsds_vis_d_ln(p) = spval
              fsds_nir_d_ln(p) = spval
              fsr_vis_d_ln(p) = spval
              fsr_nir_d_ln(p) = spval
           end if

           ! diagnostic variables (downwelling and absorbed radiation partitioning) for history files
           ! (OPTIONAL)
           c = pcolumn(p)
           if (snl(c) < 0) then
              fsds_sno_vd(p) = forc_solad(g,1)
              fsds_sno_nd(p) = forc_solad(g,2)
              fsds_sno_vi(p) = forc_solai(g,1)
              fsds_sno_ni(p) = forc_solai(g,2)

              fsr_sno_vd(p) = fsds_vis_d(p)*albsnd_hst(c,1)
              fsr_sno_nd(p) = fsds_nir_d(p)*albsnd_hst(c,2)
              fsr_sno_vi(p) = fsds_vis_i(p)*albsni_hst(c,1)
              fsr_sno_ni(p) = fsds_nir_i(p)*albsni_hst(c,2)
           else
              fsds_sno_vd(p) = spval
              fsds_sno_nd(p) = spval
              fsds_sno_vi(p) = spval
              fsds_sno_ni(p) = spval

              fsr_sno_vd(p) = spval
              fsr_sno_nd(p) = spval
              fsr_sno_vi(p) = spval
              fsr_sno_ni(p) = spval
           endif

        end if
     end do 

   end subroutine SurfaceRadiation

end module SurfaceRadiationMod

module SurfaceAlbedoMod

!-----------------------------------------------------------------------
!BOP
!
! !MODULE: SurfaceAlbedoMod
!
! !DESCRIPTION:
! Performs surface albedo calculations
!
! !PUBLIC TYPES:
  use clm_varcon , only : istsoil
#ifdef CROP
  use clm_varcon , only : istcrop
#endif
  use shr_kind_mod, only : r8 => shr_kind_r8
  use clm_varpar  , only : nlevsno
  use SNICARMod   , only : sno_nbr_aer, SNICAR_RT, DO_SNO_AER, DO_SNO_OC
  use globals, only : nstep
  implicit none
  save
!
! !PUBLIC MEMBER FUNCTIONS:
  public :: SurfaceAlbedo  ! Surface albedo and two-stream fluxes
!
! !PRIVATE MEMBER FUNCTIONS:
  private :: SoilAlbedo    ! Determine ground surface albedo
  private :: TwoStream     ! Two-stream fluxes for canopy radiative transfer
!
! !REVISION HISTORY:
! Created by Mariana Vertenstein
!
!EOP
!-----------------------------------------------------------------------

contains

!-----------------------------------------------------------------------
!BOP
!
! !IROUTINE: SurfaceAlbedo
!
! !INTERFACE:
  subroutine SurfaceAlbedo(lbg, ubg, lbc, ubc, lbp, ubp, &
                           num_nourbanc, filter_nourbanc, &
                           num_nourbanp, filter_nourbanp, &
                           nextsw_cday, declinp1)
!
! !DESCRIPTION:
! Surface albedo and two-stream fluxes
! Surface albedos. Also fluxes (per unit incoming direct and diffuse
! radiation) reflected, transmitted, and absorbed by vegetation.
! Also sunlit fraction of the canopy.
! The calling sequence is:
! -> SurfaceAlbedo:   albedos for next time step
!    -> SoilAlbedo:   soil/lake/glacier/wetland albedos
!    -> SNICAR_RT:   snow albedos: direct beam (SNICAR)
!    -> SNICAR_RT:   snow albedos: diffuse (SNICAR)
!    -> TwoStream:    absorbed, reflected, transmitted solar fluxes (vis dir,vis dif, nir dir, nir dif)
!

! !USES:
    use clmtype
    use clm_varpar      , only : numrad
    use shr_orb_mod
!
! !ARGUMENTS:
    implicit none
    integer , intent(in) :: lbg, ubg                   ! gridcell bounds
    integer , intent(in) :: lbc, ubc                   ! column bounds
    integer , intent(in) :: lbp, ubp                   ! pft bounds
    integer , intent(in) :: num_nourbanc               ! number of columns in non-urban filter
    integer , intent(in) :: filter_nourbanc(ubc-lbc+1) ! column filter for non-urban points
    integer , intent(in) :: num_nourbanp               ! number of pfts in non-urban filter
    integer , intent(in) :: filter_nourbanp(ubp-lbp+1) ! pft filter for non-urban points
    real(r8), intent(in) :: nextsw_cday                   ! calendar day at Greenwich (1.00, ..., 365.99)
    real(r8), intent(in) :: declinp1                   ! declination angle (radians) for next time step
!
! !CALLED FROM:
! subroutine clm_driver1
! subroutine iniTimeVar
!
! !REVISION HISTORY:
! Author: Gordon Bonan
! 2/1/02, Peter Thornton: Migrate to new data structures
! 8/20/03, Mariana Vertenstein: Vectorized routine
! 11/3/03, Peter Thornton: added decl(c) output for use in CN code.
! 03/28/08, Mark Flanner: added SNICAR, which required reversing the
!  order of calls to SNICAR_RT and SoilAlbedo and the location where
!  ground albedo is calculated
!
! !LOCAL VARIABLES:
!
! local pointers to implicit in arguments
!
    integer , pointer :: pgridcell(:) ! gridcell of corresponding pft
    integer , pointer :: plandunit(:) ! index into landunit level quantities
    integer , pointer :: itypelun(:)  ! landunit type
    integer , pointer :: pcolumn(:)   ! column of corresponding pft
    integer , pointer :: cgridcell(:) ! gridcell of corresponding column
    real(r8), pointer :: pwtgcell(:)  ! weight of pft wrt corresponding gridcell
    real(r8), pointer :: lat(:)       ! gridcell latitude (radians)
    real(r8), pointer :: lon(:)       ! gridcell longitude (radians)
    real(r8), pointer :: elai(:)      ! one-sided leaf area index with burying by snow
    real(r8), pointer :: esai(:)      ! one-sided stem area index with burying by snow
    real(r8), pointer :: h2osno(:)    ! snow water (mm H2O)
    real(r8), pointer :: rhol(:,:)    ! leaf reflectance: 1=vis, 2=nir
    real(r8), pointer :: rhos(:,:)    ! stem reflectance: 1=vis, 2=nir
    real(r8), pointer :: taul(:,:)    ! leaf transmittance: 1=vis, 2=nir
    real(r8), pointer :: taus(:,:)    ! stem transmittance: 1=vis, 2=nir
    integer , pointer :: ivt(:)       ! pft vegetation type
!
! local pointers toimplicit out arguments
!
    real(r8), pointer :: coszen(:)	    ! cosine of solar zenith angle
    real(r8), pointer :: fsun(:)            ! sunlit fraction of canopy
    real(r8), pointer :: albgrd(:,:)        ! ground albedo (direct)
    real(r8), pointer :: albgri(:,:)        ! ground albedo (diffuse)
    real(r8), pointer :: albd(:,:)          ! surface albedo (direct)
    real(r8), pointer :: albi(:,:)          ! surface albedo (diffuse)
    real(r8), pointer :: fabd(:,:)          ! flux absorbed by veg per unit direct flux
    real(r8), pointer :: fabi(:,:)          ! flux absorbed by veg per unit diffuse flux
    real(r8), pointer :: ftdd(:,:)          ! down direct flux below veg per unit dir flx
    real(r8), pointer :: ftid(:,:)          ! down diffuse flux below veg per unit dir flx
    real(r8), pointer :: ftii(:,:)          ! down diffuse flux below veg per unit dif flx
    real(r8), pointer :: decl(:)            ! solar declination angle (radians)
    real(r8), pointer :: gdir(:)            ! leaf projection in solar direction (0 to 1)
    real(r8), pointer :: omega(:,:)         ! fraction of intercepted radiation that is scattered (0 to 1)
    real(r8), pointer :: frac_sno(:)        ! fraction of ground covered by snow (0 to 1)
    real(r8), pointer :: h2osoi_liq(:,:)    ! liquid water content (col,lyr) [kg/m2]
    real(r8), pointer :: h2osoi_ice(:,:)    ! ice lens content (col,lyr) [kg/m2]
    real(r8), pointer :: mss_cnc_bcphi(:,:) ! mass concentration of hydrophilic BC (col,lyr) [kg/kg]
    real(r8), pointer :: mss_cnc_bcpho(:,:) ! mass concentration of hydrophobic BC (col,lyr) [kg/kg]
    real(r8), pointer :: mss_cnc_ocphi(:,:) ! mass concentration of hydrophilic OC (col,lyr) [kg/kg]
    real(r8), pointer :: mss_cnc_ocpho(:,:) ! mass concentration of hydrophobic OC (col,lyr) [kg/kg]
    real(r8), pointer :: mss_cnc_dst1(:,:)  ! mass concentration of dust aerosol species 1 (col,lyr) [kg/kg]
    real(r8), pointer :: mss_cnc_dst2(:,:)  ! mass concentration of dust aerosol species 2 (col,lyr) [kg/kg]
    real(r8), pointer :: mss_cnc_dst3(:,:)  ! mass concentration of dust aerosol species 3 (col,lyr) [kg/kg]
    real(r8), pointer :: mss_cnc_dst4(:,:)  ! mass concentration of dust aerosol species 4 (col,lyr) [kg/kg]
    real(r8), pointer :: albsod(:,:)        ! direct-beam soil albedo (col,bnd) [frc]
    real(r8), pointer :: albsoi(:,:)        ! diffuse soil albedo (col,bnd) [frc]
    real(r8), pointer :: flx_absdv(:,:)     ! direct flux absorption factor (col,lyr): VIS [frc]
    real(r8), pointer :: flx_absdn(:,:)     ! direct flux absorption factor (col,lyr): NIR [frc]
    real(r8), pointer :: flx_absiv(:,:)     ! diffuse flux absorption factor (col,lyr): VIS [frc]
    real(r8), pointer :: flx_absin(:,:)     ! diffuse flux absorption factor (col,lyr): NIR [frc]
    real(r8), pointer :: snw_rds(:,:)       ! snow grain radius (col,lyr) [microns]
    real(r8), pointer :: albgrd_pur(:,:)    ! pure snow ground albedo (direct)
    real(r8), pointer :: albgri_pur(:,:)    ! pure snow ground albedo (diffuse)
    real(r8), pointer :: albgrd_bc(:,:)     ! ground albedo without BC (direct)
    real(r8), pointer :: albgri_bc(:,:)     ! ground albedo without BC (diffuse)
    real(r8), pointer :: albgrd_oc(:,:)     ! ground albedo without OC (direct)
    real(r8), pointer :: albgri_oc(:,:)     ! ground albedo without OC (diffuse)
    real(r8), pointer :: albgrd_dst(:,:)    ! ground albedo without dust (direct)
    real(r8), pointer :: albgri_dst(:,:)    ! ground albedo without dust (diffuse)
    real(r8), pointer :: albsnd_hst(:,:)    ! snow albedo, direct, for history files (col,bnd) [frc]
    real(r8), pointer :: albsni_hst(:,:)    ! snow ground albedo, diffuse, for history files (col,bnd) [frc]
!
!
! !OTHER LOCAL VARIABLES:
!EOP
!
    real(r8), parameter :: mpe = 1.e-06_r8 ! prevents overflow for division by zero
    integer  :: fp,fc,g,c,p                ! indices
    integer  :: ib                         ! band index
    integer  :: ic                         ! 0=unit incoming direct; 1=unit incoming diffuse
    real(r8) :: wl(lbp:ubp)                ! fraction of LAI+SAI that is LAI
    real(r8) :: ws(lbp:ubp)                ! fraction of LAI+SAI that is SAI
    real(r8) :: vai(lbp:ubp)               ! elai+esai
    real(r8) :: rho(lbp:ubp,numrad)        ! leaf/stem refl weighted by fraction LAI and SAI
    real(r8) :: tau(lbp:ubp,numrad)        ! leaf/stem tran weighted by fraction LAI and SAI
    real(r8) :: ftdi(lbp:ubp,numrad)       ! down direct flux below veg per unit dif flux = 0
    real(r8) :: albsnd(lbc:ubc,numrad)     ! snow albedo (direct)
    real(r8) :: albsni(lbc:ubc,numrad)     ! snow albedo (diffuse)
    real(r8) :: ext(lbp:ubp)               ! optical depth direct beam per unit LAI+SAI
    real(r8) :: coszen_gcell(lbg:ubg)      ! cosine solar zenith angle for next time step (gridcell level)
    real(r8) :: coszen_col(lbc:ubc)        ! cosine solar zenith angle for next time step (pft level)
    real(r8) :: coszen_pft(lbp:ubp)        ! cosine solar zenith angle for next time step (pft level)
    integer  :: num_vegsol                 ! number of vegetated pfts where coszen>0
    integer  :: filter_vegsol(ubp-lbp+1)   ! pft filter where vegetated and coszen>0
    integer  :: num_novegsol               ! number of vegetated pfts where coszen>0
    integer  :: filter_novegsol(ubp-lbp+1) ! pft filter where vegetated and coszen>0
    integer, parameter :: nband =numrad    ! number of solar radiation waveband classes
    integer  :: flg_slr                    ! flag for SNICAR (=1 if direct, =2 if diffuse)
    integer  :: flg_snw_ice                ! flag for SNICAR (=1 when called from CLM, =2 when called from sea-ice)
    real(r8) :: albsnd_pur(lbc:ubc,numrad) ! direct pure snow albedo (radiative forcing)
    real(r8) :: albsni_pur(lbc:ubc,numrad) ! diffuse pure snow albedo (radiative forcing)
    real(r8) :: albsnd_bc(lbc:ubc,numrad)  ! direct snow albedo without BC (radiative forcing)
    real(r8) :: albsni_bc(lbc:ubc,numrad)  ! diffuse snow albedo without BC (radiative forcing)
    real(r8) :: albsnd_oc(lbc:ubc,numrad)  ! direct snow albedo without OC (radiative forcing)
    real(r8) :: albsni_oc(lbc:ubc,numrad)  ! diffuse snow albedo without OC (radiative forcing)
    real(r8) :: albsnd_dst(lbc:ubc,numrad) ! direct snow albedo without dust (radiative forcing)
    real(r8) :: albsni_dst(lbc:ubc,numrad) ! diffuse snow albedo without dust (radiative forcing)
    integer  :: i                          ! index for layers [idx]
    real(r8) :: flx_absd_snw(lbc:ubc,-nlevsno+1:1,numrad)   ! flux absorption factor for just snow (direct) [frc]
    real(r8) :: flx_absi_snw(lbc:ubc,-nlevsno+1:1,numrad)   ! flux absorption factor for just snow (diffuse) [frc]
    real(r8) :: foo_snw(lbc:ubc,-nlevsno+1:1,numrad)        ! dummy array for forcing calls
    real(r8) :: albsfc(lbc:ubc,numrad)                      ! albedo of surface underneath snow (col,bnd) 
    real(r8) :: h2osno_liq(lbc:ubc,-nlevsno+1:0)            ! liquid snow content (col,lyr) [kg m-2]
    real(r8) :: h2osno_ice(lbc:ubc,-nlevsno+1:0)            ! ice content in snow (col,lyr) [kg m-2]
    integer  :: snw_rds_in(lbc:ubc,-nlevsno+1:0)            ! snow grain size sent to SNICAR (col,lyr) [microns]
    real(r8) :: mss_cnc_aer_in_frc_pur(lbc:ubc,-nlevsno+1:0,sno_nbr_aer) ! mass concentration of aerosol species for forcing calculation (zero) (col,lyr,aer) [kg kg-1]
    real(r8) :: mss_cnc_aer_in_frc_bc(lbc:ubc,-nlevsno+1:0,sno_nbr_aer)  ! mass concentration of aerosol species for BC forcing (col,lyr,aer) [kg kg-1]
    real(r8) :: mss_cnc_aer_in_frc_oc(lbc:ubc,-nlevsno+1:0,sno_nbr_aer)  ! mass concentration of aerosol species for OC forcing (col,lyr,aer) [kg kg-1]
    real(r8) :: mss_cnc_aer_in_frc_dst(lbc:ubc,-nlevsno+1:0,sno_nbr_aer) ! mass concentration of aerosol species for dust forcing (col,lyr,aer) [kg kg-1]
    real(r8) :: mss_cnc_aer_in_fdb(lbc:ubc,-nlevsno+1:0,sno_nbr_aer)     ! mass concentration of all aerosol species for feedback calculation (col,lyr,aer) [kg kg-1]
  !-----------------------------------------------------------------------

    ! Assign local pointers to derived subtypes components (gridcell-level)

    lat       => clm3%g%lat_a
    lon       => clm3%g%lon_a

    ! Assign local pointers to derived subtypes components (landunit level)

    itypelun       => clm3%g%l%itype

    ! Assign local pointers to derived subtypes components (column-level)

    cgridcell      => clm3%g%l%c%gridcell
    h2osno         => clm3%g%l%c%cws%h2osno
    albgrd         => clm3%g%l%c%cps%albgrd
    albgri         => clm3%g%l%c%cps%albgri
    decl           => clm3%g%l%c%cps%decl 
    coszen         => clm3%g%l%c%cps%coszen 
    albsod         => clm3%g%l%c%cps%albsod
    albsoi         => clm3%g%l%c%cps%albsoi
    frac_sno       => clm3%g%l%c%cps%frac_sno
    flx_absdv      => clm3%g%l%c%cps%flx_absdv
    flx_absdn      => clm3%g%l%c%cps%flx_absdn
    flx_absiv      => clm3%g%l%c%cps%flx_absiv
    flx_absin      => clm3%g%l%c%cps%flx_absin
    h2osoi_liq     => clm3%g%l%c%cws%h2osoi_liq
    h2osoi_ice     => clm3%g%l%c%cws%h2osoi_ice
    snw_rds        => clm3%g%l%c%cps%snw_rds
    albgrd_pur     => clm3%g%l%c%cps%albgrd_pur
    albgri_pur     => clm3%g%l%c%cps%albgri_pur
    albgrd_bc      => clm3%g%l%c%cps%albgrd_bc
    albgri_bc      => clm3%g%l%c%cps%albgri_bc
    albgrd_oc      => clm3%g%l%c%cps%albgrd_oc
    albgri_oc      => clm3%g%l%c%cps%albgri_oc
    albgrd_dst     => clm3%g%l%c%cps%albgrd_dst
    albgri_dst     => clm3%g%l%c%cps%albgri_dst
    mss_cnc_bcphi  => clm3%g%l%c%cps%mss_cnc_bcphi
    mss_cnc_bcpho  => clm3%g%l%c%cps%mss_cnc_bcpho
    mss_cnc_ocphi  => clm3%g%l%c%cps%mss_cnc_ocphi
    mss_cnc_ocpho  => clm3%g%l%c%cps%mss_cnc_ocpho
    mss_cnc_dst1   => clm3%g%l%c%cps%mss_cnc_dst1
    mss_cnc_dst2   => clm3%g%l%c%cps%mss_cnc_dst2
    mss_cnc_dst3   => clm3%g%l%c%cps%mss_cnc_dst3
    mss_cnc_dst4   => clm3%g%l%c%cps%mss_cnc_dst4
    albsnd_hst     => clm3%g%l%c%cps%albsnd_hst
    albsni_hst     => clm3%g%l%c%cps%albsni_hst

    ! Assign local pointers to derived subtypes components (pft-level)

    plandunit => clm3%g%l%c%p%landunit
    pgridcell => clm3%g%l%c%p%gridcell
    pcolumn   => clm3%g%l%c%p%column
    pwtgcell  => clm3%g%l%c%p%wtgcell
    albd      => clm3%g%l%c%p%pps%albd
    albi      => clm3%g%l%c%p%pps%albi
    fabd      => clm3%g%l%c%p%pps%fabd
    fabi      => clm3%g%l%c%p%pps%fabi
    ftdd      => clm3%g%l%c%p%pps%ftdd
    ftid      => clm3%g%l%c%p%pps%ftid
    ftii      => clm3%g%l%c%p%pps%ftii
    fsun      => clm3%g%l%c%p%pps%fsun
    elai      => clm3%g%l%c%p%pps%elai
    esai      => clm3%g%l%c%p%pps%esai
    gdir      => clm3%g%l%c%p%pps%gdir
    omega     => clm3%g%l%c%p%pps%omega
    ivt       => clm3%g%l%c%p%itype
    rhol      => pftcon%rhol
    rhos      => pftcon%rhos
    taul      => pftcon%taul
    taus      => pftcon%taus
    

    ! Cosine solar zenith angle for next time step

    do g = lbg, ubg
       coszen_gcell(g) = shr_orb_cosz (nextsw_cday, lat(g), lon(g), declinp1)
    end do

    ! Save coszen and declination values to  clm3 data structures for
    ! use in other places in the CN and urban code

    do c = lbc,ubc
       g = cgridcell(c)
       coszen_col(c) = coszen_gcell(g)
       coszen(c) = coszen_col(c)
       decl(c) = declinp1
    end do

    do fp = 1,num_nourbanp
       p = filter_nourbanp(fp)
!      if (pwtgcell(p)>0._r8) then ! "if" added due to chg in filter definition
       g = pgridcell(p)
       coszen_pft(p) = coszen_gcell(g)
!      end if ! then removed for CNDV (and dyn. landuse?) cases to work
    end do

    ! Initialize output because solar radiation only done if coszen > 0

    do ib = 1, numrad
       do fc = 1,num_nourbanc
          c = filter_nourbanc(fc)
          albgrd(c,ib)     = 0._r8
          albgri(c,ib)     = 0._r8
          albgrd_pur(c,ib) = 0._r8
          albgri_pur(c,ib) = 0._r8
          albgrd_bc(c,ib)  = 0._r8
          albgri_bc(c,ib)  = 0._r8
          albgrd_oc(c,ib)  = 0._r8
          albgri_oc(c,ib)  = 0._r8
          albgrd_dst(c,ib) = 0._r8
          albgri_dst(c,ib) = 0._r8
          do i=-nlevsno+1,1,1
             flx_absdv(c,i) = 0._r8
             flx_absdn(c,i) = 0._r8
             flx_absiv(c,i) = 0._r8
             flx_absin(c,i) = 0._r8
          enddo
       end do
       do fp = 1,num_nourbanp
          p = filter_nourbanp(fp)
!         if (pwtgcell(p)>0._r8) then ! "if" added due to chg in filter definition
          albd(p,ib) = 1._r8
          albi(p,ib) = 1._r8
          fabd(p,ib) = 0._r8
          fabi(p,ib) = 0._r8
          ftdd(p,ib) = 0._r8
          ftid(p,ib) = 0._r8
          ftii(p,ib) = 0._r8
          omega(p,ib)= 0._r8
          if (ib==1) then
             gdir(p) = 0._r8
          end if
!         end if ! then removed for CNDV (and dyn. landuse?) cases to work
       end do
    end do

    ! SoilAlbedo called before SNICAR_RT
    ! so that reflectance of soil beneath snow column is known 
    ! ahead of time for snow RT calculation.

    ! Snow albedos
    ! Note that snow albedo routine will only compute nonzero snow albedos
    ! where h2osno> 0 and coszen > 0
    
    ! Ground surface albedos
    ! Note that ground albedo routine will only compute nonzero snow albedos
    ! where coszen > 0

    call SoilAlbedo(lbc, ubc, num_nourbanc, filter_nourbanc, &
                    coszen_col, albsnd, albsni) 

    ! set variables to pass to SNICAR.
    
    flg_snw_ice = 1   ! calling from CLM, not CSIM
    do c=lbc,ubc
       albsfc(c,:)     = albsoi(c,:)
       h2osno_liq(c,:) = h2osoi_liq(c,-nlevsno+1:0)
       h2osno_ice(c,:) = h2osoi_ice(c,-nlevsno+1:0)
       snw_rds_in(c,:) = nint(snw_rds(c,:))

       ! zero aerosol input arrays
       mss_cnc_aer_in_frc_pur(c,:,:) = 0._r8
       mss_cnc_aer_in_frc_bc(c,:,:)  = 0._r8
       mss_cnc_aer_in_frc_oc(c,:,:)  = 0._r8
       mss_cnc_aer_in_frc_dst(c,:,:) = 0._r8
       mss_cnc_aer_in_fdb(c,:,:)     = 0._r8
  


    end do




    ! Set aerosol input arrays
    ! feedback input arrays have been zeroed
    ! set soot and dust aerosol concentrations:
    if (DO_SNO_AER) then
       mss_cnc_aer_in_fdb(lbc:ubc,:,1) = mss_cnc_bcphi(lbc:ubc,:)
       mss_cnc_aer_in_fdb(lbc:ubc,:,2) = mss_cnc_bcpho(lbc:ubc,:)
       
       ! DO_SNO_OC is set in SNICAR_varpar. Default case is to ignore OC concentrations because:
       !  1) Knowledge of their optical properties is primitive
       !  2) When 'water-soluble' OPAC optical properties are applied to OC in snow, 
       !     it has a negligible darkening effect.
       if (DO_SNO_OC) then
          mss_cnc_aer_in_fdb(lbc:ubc,:,3) = mss_cnc_ocphi(lbc:ubc,:)
          mss_cnc_aer_in_fdb(lbc:ubc,:,4) = mss_cnc_ocpho(lbc:ubc,:)
       endif
       
       mss_cnc_aer_in_fdb(lbc:ubc,:,5) = mss_cnc_dst1(lbc:ubc,:)
       mss_cnc_aer_in_fdb(lbc:ubc,:,6) = mss_cnc_dst2(lbc:ubc,:)
       mss_cnc_aer_in_fdb(lbc:ubc,:,7) = mss_cnc_dst3(lbc:ubc,:)
       mss_cnc_aer_in_fdb(lbc:ubc,:,8) = mss_cnc_dst4(lbc:ubc,:)
    endif


! If radiative forcing is being calculated, first estimate clean-snow albedo
! NOTE: To invoke radiative forcing, user must define #SNICAR_FRC in misc.h or cpp
#if (defined SNICAR_FRC)

    ! 1. BC input array:
    !  set dust and (optionally) OC concentrations, so BC_FRC=[(BC+OC+dust)-(OC+dust)]
    mss_cnc_aer_in_frc_bc(lbc:ubc,:,5) = mss_cnc_dst1(lbc:ubc,:)
    mss_cnc_aer_in_frc_bc(lbc:ubc,:,6) = mss_cnc_dst2(lbc:ubc,:)
    mss_cnc_aer_in_frc_bc(lbc:ubc,:,7) = mss_cnc_dst3(lbc:ubc,:)
    mss_cnc_aer_in_frc_bc(lbc:ubc,:,8) = mss_cnc_dst4(lbc:ubc,:)
    if (DO_SNO_OC) then
       mss_cnc_aer_in_frc_bc(lbc:ubc,:,3) = mss_cnc_ocphi(lbc:ubc,:)
       mss_cnc_aer_in_frc_bc(lbc:ubc,:,4) = mss_cnc_ocpho(lbc:ubc,:)
    endif

    ! BC FORCING CALCULATIONS
    flg_slr = 1; ! direct-beam
    call SNICAR_RT(flg_snw_ice, lbc, ubc, num_nourbanc, filter_nourbanc,    &
                   coszen_col, flg_slr, h2osno_liq, h2osno_ice, snw_rds_in, &
                   mss_cnc_aer_in_frc_bc, albsfc, albsnd_bc, foo_snw)
    
    flg_slr = 2; ! diffuse
    call SNICAR_RT(flg_snw_ice, lbc, ubc, num_nourbanc, filter_nourbanc,    &
                   coszen_col, flg_slr, h2osno_liq, h2osno_ice, snw_rds_in, &
                   mss_cnc_aer_in_frc_bc, albsfc, albsni_bc, foo_snw)


    ! 2. OC input array:
    !  set BC and dust concentrations, so OC_FRC=[(BC+OC+dust)-(BC+dust)]
    if (DO_SNO_OC) then
       mss_cnc_aer_in_frc_oc(lbc:ubc,:,1) = mss_cnc_bcphi(lbc:ubc,:)
       mss_cnc_aer_in_frc_oc(lbc:ubc,:,2) = mss_cnc_bcpho(lbc:ubc,:)
       mss_cnc_aer_in_frc_oc(lbc:ubc,:,5) = mss_cnc_dst1(lbc:ubc,:)
       mss_cnc_aer_in_frc_oc(lbc:ubc,:,6) = mss_cnc_dst2(lbc:ubc,:)
       mss_cnc_aer_in_frc_oc(lbc:ubc,:,7) = mss_cnc_dst3(lbc:ubc,:)
       mss_cnc_aer_in_frc_oc(lbc:ubc,:,8) = mss_cnc_dst4(lbc:ubc,:)
    
       ! OC FORCING CALCULATIONS
       flg_slr = 1; ! direct-beam
       call SNICAR_RT(flg_snw_ice, lbc, ubc, num_nourbanc, filter_nourbanc,    &
                      coszen_col, flg_slr, h2osno_liq, h2osno_ice, snw_rds_in, &
                      mss_cnc_aer_in_frc_oc, albsfc, albsnd_oc, foo_snw)
    
       flg_slr = 2; ! diffuse
       call SNICAR_RT(flg_snw_ice, lbc, ubc, num_nourbanc, filter_nourbanc,    &
                      coszen_col, flg_slr, h2osno_liq, h2osno_ice, snw_rds_in, &
                      mss_cnc_aer_in_frc_oc, albsfc, albsni_oc, foo_snw)
    endif
    
    ! 3. DUST input array:
    ! set BC and OC concentrations, so DST_FRC=[(BC+OC+dust)-(BC+OC)]
    mss_cnc_aer_in_frc_dst(lbc:ubc,:,1) = mss_cnc_bcphi(lbc:ubc,:)
    mss_cnc_aer_in_frc_dst(lbc:ubc,:,2) = mss_cnc_bcpho(lbc:ubc,:)
    if (DO_SNO_OC) then
       mss_cnc_aer_in_frc_dst(lbc:ubc,:,3) = mss_cnc_ocphi(lbc:ubc,:)
       mss_cnc_aer_in_frc_dst(lbc:ubc,:,4) = mss_cnc_ocpho(lbc:ubc,:)
    endif
    
    ! DUST FORCING CALCULATIONS
    flg_slr = 1; ! direct-beam
    call SNICAR_RT(flg_snw_ice, lbc, ubc, num_nourbanc, filter_nourbanc,    &
                   coszen_col, flg_slr, h2osno_liq, h2osno_ice, snw_rds_in, &
                   mss_cnc_aer_in_frc_dst, albsfc, albsnd_dst, foo_snw)
    
    flg_slr = 2; ! diffuse
    call SNICAR_RT(flg_snw_ice, lbc, ubc, num_nourbanc, filter_nourbanc,    &
                   coszen_col, flg_slr, h2osno_liq, h2osno_ice, snw_rds_in, &
                   mss_cnc_aer_in_frc_dst, albsfc, albsni_dst, foo_snw)


    ! 4. ALL AEROSOL FORCING CALCULATION
    ! (pure snow albedo)
    flg_slr = 1; ! direct-beam
    call SNICAR_RT(flg_snw_ice, lbc, ubc, num_nourbanc, filter_nourbanc,    &
                   coszen_col, flg_slr, h2osno_liq, h2osno_ice, snw_rds_in, &
                   mss_cnc_aer_in_frc_pur, albsfc, albsnd_pur, foo_snw)
    
    flg_slr = 2; ! diffuse
    call SNICAR_RT(flg_snw_ice, lbc, ubc, num_nourbanc, filter_nourbanc,    &
                   coszen_col, flg_slr, h2osno_liq, h2osno_ice, snw_rds_in, &
                   mss_cnc_aer_in_frc_pur, albsfc, albsni_pur, foo_snw)

#endif


    ! CLIMATE FEEDBACK CALCULATIONS, ALL AEROSOLS:
    flg_slr = 1; ! direct-beam
    call SNICAR_RT(flg_snw_ice, lbc, ubc, num_nourbanc, filter_nourbanc,    &
                   coszen_col, flg_slr, h2osno_liq, h2osno_ice, snw_rds_in, &
                   mss_cnc_aer_in_fdb, albsfc, albsnd, flx_absd_snw)

    flg_slr = 2; ! diffuse
    call SNICAR_RT(flg_snw_ice, lbc, ubc, num_nourbanc, filter_nourbanc,    &
                   coszen_col, flg_slr, h2osno_liq, h2osno_ice, snw_rds_in, &
                   mss_cnc_aer_in_fdb, albsfc, albsni, flx_absi_snw)

    ! ground albedos and snow-fraction weighting of snow absorption factors
    do ib = 1, nband
       do fc = 1,num_nourbanc
          c = filter_nourbanc(fc)
          if (coszen(c) > 0._r8) then
             ! ground albedo was originally computed in SoilAlbedo, but is now computed here
             ! because the order of SoilAlbedo and SNICAR_RT was switched for SNICAR.
             albgrd(c,ib) = albsod(c,ib)*(1._r8-frac_sno(c)) + albsnd(c,ib)*frac_sno(c)
             albgri(c,ib) = albsoi(c,ib)*(1._r8-frac_sno(c)) + albsni(c,ib)*frac_sno(c)

             ! albedos for radiative forcing calculations:
#if (defined SNICAR_FRC)
             ! BC forcing albedo
             albgrd_bc(c,ib) = albsod(c,ib)*(1.-frac_sno(c)) + albsnd_bc(c,ib)*frac_sno(c)
             albgri_bc(c,ib) = albsoi(c,ib)*(1.-frac_sno(c)) + albsni_bc(c,ib)*frac_sno(c)
             
             if (DO_SNO_OC) then
                ! OC forcing albedo
                albgrd_oc(c,ib) = albsod(c,ib)*(1.-frac_sno(c)) + albsnd_oc(c,ib)*frac_sno(c)
                albgri_oc(c,ib) = albsoi(c,ib)*(1.-frac_sno(c)) + albsni_oc(c,ib)*frac_sno(c)
             endif

             ! dust forcing albedo
             albgrd_dst(c,ib) = albsod(c,ib)*(1.-frac_sno(c)) + albsnd_dst(c,ib)*frac_sno(c)
             albgri_dst(c,ib) = albsoi(c,ib)*(1.-frac_sno(c)) + albsni_dst(c,ib)*frac_sno(c)

             ! pure snow albedo for all-aerosol radiative forcing
             albgrd_pur(c,ib) = albsod(c,ib)*(1.-frac_sno(c)) + albsnd_pur(c,ib)*frac_sno(c)
             albgri_pur(c,ib) = albsoi(c,ib)*(1.-frac_sno(c)) + albsni_pur(c,ib)*frac_sno(c)
#endif

             ! also in this loop (but optionally in a different loop for vectorized code)
             !  weight snow layer radiative absorption factors based on snow fraction and soil albedo
             !  (NEEDED FOR ENERGY CONSERVATION)
             do i = -nlevsno+1,1,1
                if (ib == 1) then
                   flx_absdv(c,i) = flx_absd_snw(c,i,ib)*frac_sno(c) + &
                        ((1.-frac_sno(c))*(1-albsod(c,ib))*(flx_absd_snw(c,i,ib)/(1.-albsnd(c,ib))))
                   flx_absiv(c,i) = flx_absi_snw(c,i,ib)*frac_sno(c) + &
                        ((1.-frac_sno(c))*(1-albsoi(c,ib))*(flx_absi_snw(c,i,ib)/(1.-albsni(c,ib))))
                elseif (ib == 2) then
                   flx_absdn(c,i) = flx_absd_snw(c,i,ib)*frac_sno(c) + &
                        ((1.-frac_sno(c))*(1-albsod(c,ib))*(flx_absd_snw(c,i,ib)/(1.-albsnd(c,ib))))
                   flx_absin(c,i) = flx_absi_snw(c,i,ib)*frac_sno(c) + &
                        ((1.-frac_sno(c))*(1-albsoi(c,ib))*(flx_absi_snw(c,i,ib)/(1.-albsni(c,ib))))
                endif
             enddo
          endif
       enddo
    enddo

    ! for diagnostics, set snow albedo to spval over non-snow points 
    ! so that it is not averaged in history buffer
    ! (OPTIONAL)
    do ib = 1, nband
       do fc = 1,num_nourbanc
          c = filter_nourbanc(fc)
          if ((coszen(c) > 0._r8) .and. (h2osno(c) > 0._r8)) then
             albsnd_hst(c,ib) = albsnd(c,ib)
             albsni_hst(c,ib) = albsni(c,ib)
          else
             albsnd_hst(c,ib) = 0._r8
             albsni_hst(c,ib) = 0._r8
          endif
       enddo
    enddo

    ! Create solar-vegetated filter for the following calculations

    num_vegsol = 0
    num_novegsol = 0

  
    do fp = 1,num_nourbanp
       p = filter_nourbanp(fp)


         if (coszen_pft(p) > 0._r8) then
#ifndef CROP
             if (itypelun(plandunit(p)) == istsoil  &
                 .and. (elai(p) + esai(p)) > 0._r8        &
                 .and. pwtgcell(p) > 0._r8) then
#else
             if ((itypelun(plandunit(p)) == istsoil .or.  &
                  itypelun(plandunit(p)) == istcrop     ) &
                 .and. (elai(p) + esai(p)) > 0._r8        &
                 .and. pwtgcell(p) > 0._r8) then
#endif
                num_vegsol = num_vegsol + 1
                filter_vegsol(num_vegsol) = p
             else
                num_novegsol = num_novegsol + 1
                filter_novegsol(num_novegsol) = p
             end if
          end if
    end do

    ! Weight reflectance/transmittance by lai and sai
    ! Only perform on vegetated pfts where coszen > 0

    do fp = 1,num_vegsol
       p = filter_vegsol(fp)
       vai(p) = elai(p) + esai(p)
       wl(p) = elai(p) / max( vai(p), mpe )
       ws(p) = esai(p) / max( vai(p), mpe )
    end do

    do ib = 1, numrad
       do fp = 1,num_vegsol
          p = filter_vegsol(fp)
          rho(p,ib) = max( rhol(ivt(p),ib)*wl(p) + rhos(ivt(p),ib)*ws(p), mpe )
          tau(p,ib) = max( taul(ivt(p),ib)*wl(p) + taus(ivt(p),ib)*ws(p), mpe )
       end do
    end do

    ! Calculate surface albedos and fluxes 
    ! Only perform on vegetated pfts where coszen > 0

    call TwoStream (lbc, ubc, lbp, ubp, filter_vegsol, num_vegsol, &
                    coszen_pft, vai, rho, tau)
       
    ! Determine values for non-vegetated pfts where coszen > 0

    do ib = 1,numrad
       do fp = 1,num_novegsol
          p = filter_novegsol(fp)
          c = pcolumn(p)
          fabd(p,ib) = 0._r8
          fabi(p,ib) = 0._r8
          ftdd(p,ib) = 1._r8
          ftid(p,ib) = 0._r8
          ftii(p,ib) = 1._r8
          albd(p,ib) = albgrd(c,ib)
          albi(p,ib) = albgri(c,ib)
          gdir(p) = 0._r8
       end do
    end do

  end subroutine SurfaceAlbedo


!-----------------------------------------------------------------------
!BOP
!
! !IROUTINE: SoilAlbedo
!
! !INTERFACE:
  subroutine SoilAlbedo (lbc, ubc, num_nourbanc, filter_nourbanc, coszen, albsnd, albsni)
!
! !DESCRIPTION:
! Determine ground surface albedo, accounting for snow
!
! !USES:
    use clmtype
    use clm_varpar, only : numrad
    use clm_varcon, only : albsat, albdry, alblak, albice, tfrz, istice
!
! !ARGUMENTS:
    implicit none
    integer , intent(in) :: lbc, ubc                   ! column bounds
    integer , intent(in) :: num_nourbanc               ! number of columns in non-urban points in column filter
    integer , intent(in) :: filter_nourbanc(ubc-lbc+1) ! column filter for non-urban points
    real(r8), intent(in) :: coszen(lbc:ubc)            ! cos solar zenith angle next time step (column-level)
    real(r8), intent(in) :: albsnd(lbc:ubc,numrad)     ! snow albedo (direct)
    real(r8), intent(in) :: albsni(lbc:ubc,numrad)     ! snow albedo (diffuse)
!
! !CALLED FROM:
! subroutine SurfaceAlbedo in this module
!
! !REVISION HISTORY:
! Author: Gordon Bonan
! 2/5/02, Peter Thornton: Migrated to new data structures.
! 8/20/03, Mariana Vertenstein: Vectorized routine
! 03/28/08, Mark Flanner: changes for SNICAR
!
! !LOCAL VARIABLES:
!
! local pointers to original implicit in arguments
!
    integer , pointer :: clandunit(:)    ! landunit of corresponding column
    integer , pointer :: ltype(:)        ! landunit type
    integer , pointer :: isoicol(:)      ! soil color class
    real(r8), pointer :: t_grnd(:)       ! ground temperature (Kelvin)
    real(r8), pointer :: frac_sno(:)     ! fraction of ground covered by snow (0 to 1)
    real(r8), pointer :: h2osoi_vol(:,:) ! volumetric soil water [m3/m3]
!
! local pointers to original implicit out arguments
!
    real(r8), pointer:: albgrd(:,:)      ! ground albedo (direct)
    real(r8), pointer:: albgri(:,:)      ! ground albedo (diffuse)
    ! albsod and albsoi are now clm_type variables so they can be used by SNICAR.
    real(r8), pointer :: albsod(:,:)        ! soil albedo (direct)
    real(r8), pointer :: albsoi(:,:)        ! soil albedo (diffuse)
!
!
! !OTHER LOCAL VARIABLES:
!EOP
!
    integer, parameter :: nband =numrad ! number of solar radiation waveband classes
    integer  :: fc            ! non-urban filter column index
    integer  :: c,l           ! indices
    integer  :: ib            ! waveband number (1=vis, 2=nir)
    real(r8) :: inc           ! soil water correction factor for soil albedo
    ! albsod and albsoi are now clm_type variables so they can be used by SNICAR.
    !real(r8) :: albsod        ! soil albedo (direct)
    !real(r8) :: albsoi        ! soil albedo (diffuse)
    integer  :: soilcol       ! soilcolor
!-----------------------------------------------------------------------
!dir$ inlinenever SoilAlbedo

    ! Assign local pointers to derived subtypes components (column-level)

    clandunit  => clm3%g%l%c%landunit
    isoicol    => clm3%g%l%c%cps%isoicol
    t_grnd     => clm3%g%l%c%ces%t_grnd
    frac_sno   => clm3%g%l%c%cps%frac_sno
    h2osoi_vol => clm3%g%l%c%cws%h2osoi_vol
    albgrd     => clm3%g%l%c%cps%albgrd
    albgri     => clm3%g%l%c%cps%albgri
    albsod     => clm3%g%l%c%cps%albsod
    albsoi     => clm3%g%l%c%cps%albsoi

    ! Assign local pointers to derived subtypes components (landunit-level)

    ltype      => clm3%g%l%itype

    ! Compute soil albedos

    do ib = 1, nband
       do fc = 1,num_nourbanc
          c = filter_nourbanc(fc)
          if (coszen(c) > 0._r8) then
             l = clandunit(c)

#ifndef CROP
             if (ltype(l) == istsoil)  then ! soil
#else
             if (ltype(l) == istsoil .or. ltype(l) == istcrop)  then ! soil
#endif
                inc    = max(0.11_r8-0.40_r8*h2osoi_vol(c,1), 0._r8)
                soilcol = isoicol(c)
                ! changed from local variable to clm_type:
                !albsod = min(albsat(soilcol,ib)+inc, albdry(soilcol,ib))
                !albsoi = albsod
                albsod(c,ib) = min(albsat(soilcol,ib)+inc, albdry(soilcol,ib))
                albsoi(c,ib) = albsod(c,ib)
             else if (ltype(l) == istice)  then          ! land ice
                ! changed from local variable to clm_type:
                !albsod = albice(ib)
                !albsoi = albsod
                albsod(c,ib) = albice(ib)
                albsoi(c,ib) = albsod(c,ib)
             else if (t_grnd(c) > tfrz) then             ! unfrozen lake, wetland
                ! changed from local variable to clm_type:
                !albsod = 0.05_r8/(max(0.001_r8,coszen(c)) + 0.15_r8)
                !albsoi = albsod
                albsod(c,ib) = 0.05_r8/(max(0.001_r8,coszen(c)) + 0.15_r8)
                albsoi(c,ib) = albsod(c,ib)
             else                                     ! frozen lake, wetland
                ! changed from local variable to clm_type:
                !albsod = alblak(ib)
                !albsoi = albsod
                albsod(c,ib) = alblak(ib)
                albsoi(c,ib) = albsod(c,ib)
             end if

             ! Weighting is done in SurfaceAlbedo, after the call to SNICAR_RT
             ! This had to be done, because SoilAlbedo is called before SNICAR_RT, so at
             ! this point, snow albedo is not yet known.
          end if
       end do
    end do

  end subroutine SoilAlbedo

!-----------------------------------------------------------------------
!BOP
!
! !IROUTINE: TwoStream
!
! !INTERFACE:
  subroutine TwoStream (lbc, ubc, lbp, ubp, filter_vegsol, num_vegsol, &
                        coszen, vai, rho, tau)
!
! !DESCRIPTION:
! Two-stream fluxes for canopy radiative transfer
! Use two-stream approximation of Dickinson (1983) Adv Geophysics
! 25:305-353 and Sellers (1985) Int J Remote Sensing 6:1335-1372
! to calculate fluxes absorbed by vegetation, reflected by vegetation,
! and transmitted through vegetation for unit incoming direct or diffuse
! flux given an underlying surface with known albedo.
!
! !USES:
    use clmtype
    use clm_varpar, only : numrad
    use clm_varcon, only : omegas, tfrz, betads, betais
!
! !ARGUMENTS:
    implicit none
    integer , intent(in)  :: lbc, ubc                 ! column bounds
    integer , intent(in)  :: lbp, ubp                 ! pft bounds
    integer , intent(in)  :: filter_vegsol(ubp-lbp+1) ! filter for vegetated pfts with coszen>0
    integer , intent(in)  :: num_vegsol               ! number of vegetated pfts where coszen>0
    real(r8), intent(in)  :: coszen(lbp:ubp)          ! cosine solar zenith angle for next time step
    real(r8), intent(in)  :: vai(lbp:ubp)             ! elai+esai
    real(r8), intent(in)  :: rho(lbp:ubp,numrad)      ! leaf/stem refl weighted by fraction LAI and SAI
    real(r8), intent(in)  :: tau(lbp:ubp,numrad)      ! leaf/stem tran weighted by fraction LAI and SAI
!
! !CALLED FROM:
! subroutine SurfaceAlbedo in this module
!
! !REVISION HISTORY:
! Author: Gordon Bonan
! Modified for speedup: Mariana Vertenstein, 8/26/02
! Vectorized routine: Mariana Vertenstein:  8/20/03
!
! !LOCAL VARIABLES:
!
! local pointers to implicit in scalars
!
    integer , pointer :: pcolumn(:)    ! column of corresponding pft
    real(r8), pointer :: albgrd(:,:)   ! ground albedo (direct) (column-level)
    real(r8), pointer :: albgri(:,:)   ! ground albedo (diffuse)(column-level)
    real(r8), pointer :: t_veg(:)      ! vegetation temperature (Kelvin)
    real(r8), pointer :: fwet(:)       ! fraction of canopy that is wet (0 to 1)
    integer , pointer :: ivt(:)        ! pft vegetation type
    real(r8), pointer :: xl(:)         ! ecophys const - leaf/stem orientation index
!
! local pointers to implicit out scalars
!
    real(r8), pointer :: albd(:,:)     ! surface albedo (direct)
    real(r8), pointer :: albi(:,:)     ! surface albedo (diffuse)
    real(r8), pointer :: fabd(:,:)     ! flux absorbed by veg per unit direct flux
    real(r8), pointer :: fabi(:,:)     ! flux absorbed by veg per unit diffuse flux
    real(r8), pointer :: ftdd(:,:)     ! down direct flux below veg per unit dir flx
    real(r8), pointer :: ftid(:,:)     ! down diffuse flux below veg per unit dir flx
    real(r8), pointer :: ftii(:,:)     ! down diffuse flux below veg per unit dif flx
    real(r8), pointer :: gdir(:)		   ! leaf projection in solar direction (0 to 1)
	 real(r8), pointer :: omega(:,:)    ! fraction of intercepted radiation that is scattered (0 to 1)
!
!
! !OTHER LOCAL VARIABLES:
!EOP
!
    integer  :: fp,p,c           ! array indices
    !integer  :: ic               ! 0=unit incoming direct; 1=unit incoming diffuse
    integer  :: ib               ! waveband number
    real(r8) :: cosz             ! 0.001 <= coszen <= 1.000
    real(r8) :: asu              ! single scattering albedo
    real(r8) :: chil(lbp:ubp)    ! -0.4 <= xl <= 0.6
    real(r8) :: twostext(lbp:ubp)! optical depth of direct beam per unit leaf area
    real(r8) :: avmu(lbp:ubp)    ! average diffuse optical depth
    real(r8) :: omegal           ! omega for leaves
    real(r8) :: betai            ! upscatter parameter for diffuse radiation
    real(r8) :: betail           ! betai for leaves
    real(r8) :: betad            ! upscatter parameter for direct beam radiation
    real(r8) :: betadl           ! betad for leaves
    real(r8) :: tmp0,tmp1,tmp2,tmp3,tmp4,tmp5,tmp6,tmp7,tmp8,tmp9 ! temporary
    real(r8) :: p1,p2,p3,p4,s1,s2,u1,u2,u3                        ! temporary
    real(r8) :: b,c1,d,d1,d2,f,h,h1,h2,h3,h4,h5,h6,h7,h8,h9,h10   ! temporary
    real(r8) :: phi1,phi2,sigma                                   ! temporary
    real(r8) :: temp0(lbp:ubp),temp1,temp2(lbp:ubp)               ! temporary
    real(r8) :: t1
!-----------------------------------------------------------------------

    ! Assign local pointers to derived subtypes components (column-level)

    albgrd  => clm3%g%l%c%cps%albgrd
    albgri  => clm3%g%l%c%cps%albgri

    ! Assign local pointers to derived subtypes components (pft-level)

    pcolumn => clm3%g%l%c%p%column
    fwet    => clm3%g%l%c%p%pps%fwet
    t_veg   => clm3%g%l%c%p%pes%t_veg
    ivt     => clm3%g%l%c%p%itype
    albd    => clm3%g%l%c%p%pps%albd
    albi    => clm3%g%l%c%p%pps%albi
    fabd    => clm3%g%l%c%p%pps%fabd
    fabi    => clm3%g%l%c%p%pps%fabi
    ftdd    => clm3%g%l%c%p%pps%ftdd
    ftid    => clm3%g%l%c%p%pps%ftid
    ftii    => clm3%g%l%c%p%pps%ftii
    gdir    => clm3%g%l%c%p%pps%gdir
    omega   => clm3%g%l%c%p%pps%omega
    xl      => pftcon%xl

    ! Calculate two-stream parameters omega, betad, betai, avmu, gdir, twostext.
    ! Omega, betad, betai are adjusted for snow. Values for omega*betad
    ! and omega*betai are calculated and then divided by the new omega
    ! because the product omega*betai, omega*betad is used in solution.
    ! Also, the transmittances and reflectances (tau, rho) are linear
    ! weights of leaf and stem values.


    do fp = 1,num_vegsol
       p = filter_vegsol(fp)
       
       ! note that the following limit only acts on cosz values > 0 and less than 
       ! 0.001, not on values cosz = 0, since these zero have already been filtered
       ! out in filter_vegsol
       cosz = max(0.001_r8, coszen(p))
       
       chil(p) = min( max(xl(ivt(p)), -0.4_r8), 0.6_r8 )
       if (abs(chil(p)) <= 0.01_r8) chil(p) = 0.01_r8
       phi1 = 0.5_r8 - 0.633_r8*chil(p) - 0.330_r8*chil(p)*chil(p)
       phi2 = 0.877_r8 * (1._r8-2._r8*phi1)
       gdir(p) = phi1 + phi2*cosz
       twostext(p) = gdir(p)/cosz
       avmu(p) = ( 1._r8 - phi1/phi2 * log((phi1+phi2)/phi1) ) / phi2
       temp0(p) = gdir(p) + phi2*cosz
       temp1 = phi1*cosz
       temp2(p) = ( 1._r8 - temp1/temp0(p) * log((temp1+temp0(p))/temp1) )
    end do

    do ib = 1, numrad
       do fp = 1,num_vegsol
          p = filter_vegsol(fp)
          c = pcolumn(p)

          omegal = rho(p,ib) + tau(p,ib)
          asu = 0.5_r8*omegal*gdir(p)/temp0(p) *temp2(p)
          betadl = (1._r8+avmu(p)*twostext(p))/(omegal*avmu(p)*twostext(p))*asu
          betail = 0.5_r8 * ((rho(p,ib)+tau(p,ib)) + (rho(p,ib)-tau(p,ib)) &
               * ((1._r8+chil(p))/2._r8)**2) / omegal

          ! Adjust omega, betad, and betai for intercepted snow

          if (t_veg(p) > tfrz) then                             !no snow
             tmp0 = omegal
             tmp1 = betadl
             tmp2 = betail
          else
             tmp0 =   (1._r8-fwet(p))*omegal        + fwet(p)*omegas(ib)
             tmp1 = ( (1._r8-fwet(p))*omegal*betadl + fwet(p)*omegas(ib)*betads ) / tmp0
             tmp2 = ( (1._r8-fwet(p))*omegal*betail + fwet(p)*omegas(ib)*betais ) / tmp0
          end if
          omega(p,ib) = tmp0           
          betad = tmp1 
          betai = tmp2  

          ! Absorbed, reflected, transmitted fluxes per unit incoming radiation

          b = 1._r8 - omega(p,ib) + omega(p,ib)*betai
          c1 = omega(p,ib)*betai
          tmp0 = avmu(p)*twostext(p)
          d = tmp0 * omega(p,ib)*betad
          f = tmp0 * omega(p,ib)*(1._r8-betad)
          tmp1 = b*b - c1*c1
          h = sqrt(tmp1) / avmu(p)
          sigma = tmp0*tmp0 - tmp1
          p1 = b + avmu(p)*h
          p2 = b - avmu(p)*h
          p3 = b + tmp0
          p4 = b - tmp0
          
          ! PET, 03/01/04: added this test to avoid floating point errors in exp()
          ! EBK, 04/15/08: always do this for all modes -- not just CN


          t1 = min(h*vai(p), 40._r8)
          s1 = exp(-t1)
          t1 = min(twostext(p)*vai(p), 40._r8)
          s2 = exp(-t1)
          
          ! Determine fluxes for vegetated pft for unit incoming direct 
          ! Loop over incoming direct and incoming diffuse
          ! 0=unit incoming direct; 1=unit incoming diffuse

          ! ic = 0 unit incoming direct flux
          ! ========================================

          u1 = b - c1/albgrd(c,ib)
          u2 = b - c1*albgrd(c,ib)
          u3 = f + c1*albgrd(c,ib)

          tmp2 = u1 - avmu(p)*h
          tmp3 = u1 + avmu(p)*h
          d1 = p1*tmp2/s1 - p2*tmp3*s1
          tmp4 = u2 + avmu(p)*h
          tmp5 = u2 - avmu(p)*h
          d2 = tmp4/s1 - tmp5*s1
          h1 = -d*p4 - c1*f
          tmp6 = d - h1*p3/sigma
          tmp7 = ( d - c1 - h1/sigma*(u1+tmp0) ) * s2
          h2 = ( tmp6*tmp2/s1 - p2*tmp7 ) / d1
          h3 = - ( tmp6*tmp3*s1 - p1*tmp7 ) / d1
          h4 = -f*p3 - c1*d
          tmp8 = h4/sigma
          tmp9 = ( u3 - tmp8*(u2-tmp0) ) * s2
          h5 = - ( tmp8*tmp4/s1 + tmp9 ) / d2
          h6 = ( tmp8*tmp5*s1 + tmp9 ) / d2
          h7 = (c1*tmp2) / (d1*s1)
          h8 = (-c1*tmp3*s1) / d1
          h9 = tmp4 / (d2*s1)
          h10 = (-tmp5*s1) / d2

          ! Downward direct and diffuse fluxes below vegetation (ic = 0)

          ftdd(p,ib) = s2
          ftid(p,ib) = h4*s2/sigma + h5*s1 + h6/s1
   

          ! Flux reflected by vegetation (ic = 0)

          albd(p,ib) = h1/sigma + h2 + h3

          ! Flux absorbed by vegetation (ic = 0)

          fabd(p,ib) = 1._r8 - albd(p,ib) &
               - (1._r8-albgrd(c,ib))*ftdd(p,ib) - (1._r8-albgri(c,ib))*ftid(p,ib)

          ! ic = 1 unit incoming diffuse
          ! ========================================

          u1 = b - c1/albgri(c,ib)
          u2 = b - c1*albgri(c,ib)
          u3 = f + c1*albgri(c,ib)

          tmp2 = u1 - avmu(p)*h
          tmp3 = u1 + avmu(p)*h
          d1 = p1*tmp2/s1 - p2*tmp3*s1
          tmp4 = u2 + avmu(p)*h
          tmp5 = u2 - avmu(p)*h
          d2 = tmp4/s1 - tmp5*s1
          h1 = -d*p4 - c1*f
          tmp6 = d - h1*p3/sigma
          tmp7 = ( d - c1 - h1/sigma*(u1+tmp0) ) * s2
          h2 = ( tmp6*tmp2/s1 - p2*tmp7 ) / d1
          h3 = - ( tmp6*tmp3*s1 - p1*tmp7 ) / d1
          h4 = -f*p3 - c1*d
          tmp8 = h4/sigma
          tmp9 = ( u3 - tmp8*(u2-tmp0) ) * s2
          h5 = - ( tmp8*tmp4/s1 + tmp9 ) / d2
          h6 = ( tmp8*tmp5*s1 + tmp9 ) / d2
          h7 = (c1*tmp2) / (d1*s1)
          h8 = (-c1*tmp3*s1) / d1
          h9 = tmp4 / (d2*s1)
          h10 = (-tmp5*s1) / d2

          ! Downward direct and diffuse fluxes below vegetation

          ftii(p,ib) = h9*s1 + h10/s1

          ! Flux reflected by vegetation

          albi(p,ib) = h7 + h8

          ! Flux absorbed by vegetation

          fabi(p,ib) = 1._r8 - albi(p,ib) - (1._r8-albgri(c,ib))*ftii(p,ib)

       end do   ! end of pft loop
    end do   ! end of radiation band loop

  end subroutine TwoStream

end module SurfaceAlbedoMod

module SoilTemperatureMod

!-----------------------------------------------------------------------
!BOP
!
! !MODULE: SoilTemperatureMod
!
! !DESCRIPTION:
! Calculates snow and soil temperatures including phase change
!
! !PUBLIC TYPES:
  implicit none
  save
!
! !PUBLIC MEMBER FUNCTIONS:
  public :: SoilTemperature  ! Snow and soil temperatures including phase change
!
! !PRIVATE MEMBER FUNCTIONS:
  private :: SoilThermProp   ! Set therm conductivities and heat cap of snow/soil layers
  private :: PhaseChange     ! Calculation of the phase change within snow and soil layers
!
! !REVISION HISTORY:
! Created by Mariana Vertenstein
!
!EOP
!-----------------------------------------------------------------------

contains

!-----------------------------------------------------------------------
!BOP
!
! !IROUTINE: SoilTemperature
!
! !INTERFACE:
  subroutine SoilTemperature(lbl, ubl, lbc, ubc, num_urbanl, filter_urbanl, &
                             num_nolakec, filter_nolakec, xmf, fact)
!
! !DESCRIPTION:
! Snow and soil temperatures including phase change
! o The volumetric heat capacity is calculated as a linear combination
!   in terms of the volumetric fraction of the constituent phases.
! o The thermal conductivity of soil is computed from
!   the algorithm of Johansen (as reported by Farouki 1981), and the
!   conductivity of snow is from the formulation used in
!   SNTHERM (Jordan 1991).
! o Boundary conditions:
!   F = Rnet - Hg - LEg (top),  F= 0 (base of the soil column).
! o Soil / snow temperature is predicted from heat conduction
!   in 10 soil layers and up to 5 snow layers.
!   The thermal conductivities at the interfaces between two
!   neighboring layers (j, j+1) are derived from an assumption that
!   the flux across the interface is equal to that from the node j
!   to the interface and the flux from the interface to the node j+1.
!   The equation is solved using the Crank-Nicholson method and
!   results in a tridiagonal system equation.
!
! !USES:
    use shr_kind_mod  , only : r8 => shr_kind_r8
    use clmtype
    use clm_varcon    , only : sb, capr, cnfac, hvap, isturb, &
                               icol_roof, icol_sunwall, icol_shadewall, &
                               icol_road_perv, icol_road_imperv, istwet
    use clm_varpar    , only : nlevsno, nlevgrnd, max_pft_per_col, nlevurb
    use TridiagonalMod, only : Tridiagonal
    use globals       , only : dtime
!
! !ARGUMENTS:
    implicit none
    integer , intent(in)  :: lbc, ubc                    ! column bounds
    integer , intent(in)  :: num_nolakec                 ! number of column non-lake points in column filter
    integer , intent(in)  :: filter_nolakec(ubc-lbc+1)   ! column filter for non-lake points
    integer , intent(in)  :: lbl, ubl                    ! landunit-index bounds
    integer , intent(in)  :: num_urbanl                  ! number of urban landunits in clump
    integer , intent(in)  :: filter_urbanl(ubl-lbl+1)    ! urban landunit filter
    real(r8), intent(out) :: xmf(lbc:ubc)                ! total latent heat of phase change of ground water
    real(r8), intent(out) :: fact(lbc:ubc, -nlevsno+1:nlevgrnd) ! used in computing tridiagonal matrix
!
! !CALLED FROM:
! subroutine Biogeophysics2 in module Biogeophysics2Mod
!
! !REVISION HISTORY:
! 15 September 1999: Yongjiu Dai; Initial code
! 15 December 1999:  Paul Houser and Jon Radakovich; F90 Revision
! 12/19/01, Peter Thornton
! Changed references for tg to t_grnd, for consistency with the
! rest of the code (tg eliminated as redundant)
! 2/14/02, Peter Thornton: Migrated to new data structures. Added pft loop
! in calculation of net ground heat flux.
! 3/18/08, David Lawrence: Change nlevsoi to nlevgrnd for deep soil
! 03/28/08, Mark Flanner: Changes to allow solar radiative absorption in all snow layers and top soil layer
! !LOCAL VARIABLES:
!
! local pointers to original implicit in arguments
!
    integer , pointer :: pgridcell(:)       ! pft's gridcell index
    integer , pointer :: plandunit(:)       ! pft's landunit index
    integer , pointer :: clandunit(:)       ! column's landunit
    integer , pointer :: ltype(:)           ! landunit type
    integer , pointer :: ctype(:)           ! column type
    integer , pointer :: npfts(:)           ! column's number of pfts 
    integer , pointer :: pfti(:)            ! column's beginning pft index 
    real(r8), pointer :: pwtcol(:)          ! weight of pft relative to column
    real(r8), pointer :: pwtgcell(:)        ! weight of pft relative to corresponding gridcell
    real(r8), pointer :: forc_lwrad(:)      ! downward infrared (longwave) radiation (W/m**2)
    integer , pointer :: snl(:)             ! number of snow layers
    real(r8), pointer :: htvp(:)            ! latent heat of vapor of water (or sublimation) [j/kg]
    real(r8), pointer :: emg(:)             ! ground emissivity
    real(r8), pointer :: cgrnd(:)           ! deriv. of soil energy flux wrt to soil temp [w/m2/k]
    real(r8), pointer :: dlrad(:)           ! downward longwave radiation blow the canopy [W/m2]
    real(r8), pointer :: sabg(:)            ! solar radiation absorbed by ground (W/m**2)
    integer , pointer :: frac_veg_nosno(:)  ! fraction of vegetation not covered by snow (0 OR 1 now) [-] (new)
    real(r8), pointer :: eflx_sh_grnd(:)    ! sensible heat flux from ground (W/m**2) [+ to atm]
    real(r8), pointer :: qflx_evap_soi(:)   ! soil evaporation (mm H2O/s) (+ = to atm)
    real(r8), pointer :: qflx_tran_veg(:)   ! vegetation transpiration (mm H2O/s) (+ = to atm)
    real(r8), pointer :: zi(:,:)            ! interface level below a "z" level (m)
    real(r8), pointer :: dz(:,:)            ! layer depth (m)
    real(r8), pointer :: z(:,:)             ! layer thickness (m)
    real(r8), pointer :: t_soisno(:,:)      ! soil temperature (Kelvin)
    real(r8), pointer :: eflx_lwrad_net(:)  ! net infrared (longwave) rad (W/m**2) [+ = to atm]
    real(r8), pointer :: tssbef(:,:)        ! temperature at previous time step [K]
    real(r8), pointer :: t_building(:)      ! internal building temperature (K)
    real(r8), pointer :: t_building_max(:)  ! maximum internal building temperature (K)
    real(r8), pointer :: t_building_min(:)  ! minimum internal building temperature (K)
    real(r8), pointer :: hc_soi(:)          ! soil heat content (MJ/m2)
    real(r8), pointer :: hc_soisno(:)       ! soil plus snow plus lake heat content (MJ/m2)
    real(r8), pointer :: eflx_fgr12(:)      ! heat flux between soil layer 1 and 2 (W/m2)
    real(r8), pointer :: eflx_traffic(:)    ! traffic sensible heat flux (W/m**2)
    real(r8), pointer :: eflx_wasteheat(:)  ! sensible heat flux from urban heating/cooling sources of waste heat (W/m**2)
    real(r8), pointer :: eflx_wasteheat_pft(:)  ! sensible heat flux from urban heating/cooling sources of waste heat (W/m**2)
    real(r8), pointer :: eflx_heat_from_ac(:) !sensible heat flux put back into canyon due to removal by AC (W/m**2)
    real(r8), pointer :: eflx_heat_from_ac_pft(:) !sensible heat flux put back into canyon due to removal by AC (W/m**2)
    real(r8), pointer :: eflx_traffic_pft(:)    ! traffic sensible heat flux (W/m**2)
    real(r8), pointer :: eflx_anthro(:)         ! total anthropogenic heat flux (W/m**2)
    real(r8), pointer :: canyon_hwr(:)      ! urban canyon height to width ratio
    real(r8), pointer :: wtlunit_roof(:)    ! weight of roof with respect to landunit
! 
! local pointers to  original implicit inout arguments
!
    real(r8), pointer :: t_grnd(:)          ! ground surface temperature [K]
!
! local pointers to original implicit out arguments
!
    real(r8), pointer :: eflx_gnet(:)          ! net ground heat flux into the surface (W/m**2)
    real(r8), pointer :: dgnetdT(:)            ! temperature derivative of ground net heat flux
    real(r8), pointer :: eflx_building_heat(:) ! heat flux from urban building interior to walls, roof (W/m**2)

! variables needed for SNICAR
    real(r8), pointer :: sabg_lyr(:,:)      ! absorbed solar radiation (pft,lyr) [W/m2]
    real(r8), pointer :: h2osno(:)          ! total snow water (col) [kg/m2]
    real(r8), pointer :: h2osoi_liq(:,:)    ! liquid water (col,lyr) [kg/m2]
    real(r8), pointer :: h2osoi_ice(:,:)    ! ice content (col,lyr) [kg/m2]

! Urban building HAC fluxes
    real(r8), pointer :: eflx_urban_ac(:)      ! urban air conditioning flux (W/m**2)
    real(r8), pointer :: eflx_urban_heat(:)    ! urban heating flux (W/m**2)
!
!
! !OTHER LOCAL VARIABLES:
!EOP
!
    integer  :: j,c,p,l,g,pi                       !  indices
    integer  :: fc                                 ! lake filtered column indices
    integer  :: fl                                 ! urban filtered landunit indices
    integer  :: jtop(lbc:ubc)                      ! top level at each column
    real(r8) :: at (lbc:ubc,-nlevsno+1:nlevgrnd)   ! "a" vector for tridiagonal matrix
    real(r8) :: bt (lbc:ubc,-nlevsno+1:nlevgrnd)   ! "b" vector for tridiagonal matrix
    real(r8) :: ct (lbc:ubc,-nlevsno+1:nlevgrnd)   ! "c" vector for tridiagonal matrix
    real(r8) :: rt (lbc:ubc,-nlevsno+1:nlevgrnd)   ! "r" vector for tridiagonal solution
    real(r8) :: cv (lbc:ubc,-nlevsno+1:nlevgrnd)   ! heat capacity [J/(m2 K)]
    real(r8) :: tk (lbc:ubc,-nlevsno+1:nlevgrnd)   ! thermal conductivity [W/(m K)]
    real(r8) :: fn (lbc:ubc,-nlevsno+1:nlevgrnd)   ! heat diffusion through the layer interface [W/m2]
    real(r8) :: fn1(lbc:ubc,-nlevsno+1:nlevgrnd)   ! heat diffusion through the layer interface [W/m2]
    real(r8) :: brr(lbc:ubc,-nlevsno+1:nlevgrnd)   ! temporary
    real(r8) :: dzm                                ! used in computing tridiagonal matrix
    real(r8) :: dzp                                ! used in computing tridiagonal matrix
    real(r8) :: hs(lbc:ubc)                        ! net energy flux into the surface (w/m2)
    real(r8) :: dhsdT(lbc:ubc)                     ! d(hs)/dT
    real(r8) :: lwrad_emit(lbc:ubc)                ! emitted longwave radiation
    real(r8) :: dlwrad_emit(lbc:ubc)               ! time derivative of emitted longwave radiation
    integer  :: lyr_top                            ! index of top layer of snowpack (-4 to 0) [idx]
    real(r8) :: sabg_lyr_col(lbc:ubc,-nlevsno+1:1) ! absorbed solar radiation (col,lyr) [W/m2]
    real(r8) :: eflx_gnet_top                      ! net energy flux into surface layer, pft-level [W/m2]
    real(r8) :: hs_top(lbc:ubc)                    ! net energy flux into surface layer (col) [W/m2]
    logical  :: cool_on(lbl:ubl)                   ! is urban air conditioning on?
    logical  :: heat_on(lbl:ubl)                   ! is urban heating on?
!-----------------------------------------------------------------------

    ! Assign local pointers to derived subtypes components (gridcell-level)

    forc_lwrad     => clm_a2l%forc_lwrad

    ! Assign local pointers to derived subtypes components (landunit-level)

    ltype          => clm3%g%l%itype
    t_building     => clm3%g%l%lps%t_building
    t_building_max => clm3%g%l%lps%t_building_max
    t_building_min => clm3%g%l%lps%t_building_min
    eflx_traffic   => clm3%g%l%lef%eflx_traffic
    canyon_hwr     => clm3%g%l%canyon_hwr
    eflx_wasteheat => clm3%g%l%lef%eflx_wasteheat
    eflx_heat_from_ac => clm3%g%l%lef%eflx_heat_from_ac
    wtlunit_roof   => clm3%g%l%wtlunit_roof

    ! Assign local pointers to derived subtypes components (column-level)

    ctype          => clm3%g%l%c%itype
    clandunit      => clm3%g%l%c%landunit
    npfts          => clm3%g%l%c%npfts
    pfti           => clm3%g%l%c%pfti
    snl            => clm3%g%l%c%cps%snl
    htvp           => clm3%g%l%c%cps%htvp
    emg            => clm3%g%l%c%cps%emg
    t_grnd         => clm3%g%l%c%ces%t_grnd
    hc_soi         => clm3%g%l%c%ces%hc_soi
    hc_soisno      => clm3%g%l%c%ces%hc_soisno
    eflx_fgr12     => clm3%g%l%c%cef%eflx_fgr12
    zi             => clm3%g%l%c%cps%zi
    dz             => clm3%g%l%c%cps%dz
    z              => clm3%g%l%c%cps%z
    t_soisno       => clm3%g%l%c%ces%t_soisno
    eflx_building_heat => clm3%g%l%c%cef%eflx_building_heat
    tssbef             => clm3%g%l%c%ces%tssbef
    eflx_urban_ac      => clm3%g%l%c%cef%eflx_urban_ac
    eflx_urban_heat    => clm3%g%l%c%cef%eflx_urban_heat

    ! Assign local pointers to derived subtypes components (pft-level)

    pgridcell      => clm3%g%l%c%p%gridcell
    plandunit      => clm3%g%l%c%p%landunit
    pwtcol         => clm3%g%l%c%p%wtcol
    pwtgcell       => clm3%g%l%c%p%wtgcell  
    frac_veg_nosno => clm3%g%l%c%p%pps%frac_veg_nosno
    cgrnd          => clm3%g%l%c%p%pef%cgrnd
    dlrad          => clm3%g%l%c%p%pef%dlrad
    sabg           => clm3%g%l%c%p%pef%sabg
    eflx_sh_grnd   => clm3%g%l%c%p%pef%eflx_sh_grnd
    qflx_evap_soi  => clm3%g%l%c%p%pwf%qflx_evap_soi
    qflx_tran_veg  => clm3%g%l%c%p%pwf%qflx_tran_veg
    eflx_gnet      => clm3%g%l%c%p%pef%eflx_gnet
    dgnetdT        => clm3%g%l%c%p%pef%dgnetdT
    eflx_lwrad_net => clm3%g%l%c%p%pef%eflx_lwrad_net
    eflx_wasteheat_pft => clm3%g%l%c%p%pef%eflx_wasteheat_pft
    eflx_heat_from_ac_pft => clm3%g%l%c%p%pef%eflx_heat_from_ac_pft
    eflx_traffic_pft => clm3%g%l%c%p%pef%eflx_traffic_pft
    eflx_anthro => clm3%g%l%c%p%pef%eflx_anthro

    sabg_lyr       => clm3%g%l%c%p%pef%sabg_lyr
    h2osno         => clm3%g%l%c%cws%h2osno
    h2osoi_liq     => clm3%g%l%c%cws%h2osoi_liq
    h2osoi_ice     => clm3%g%l%c%cws%h2osoi_ice


    ! Compute ground surface and soil temperatures

    ! Thermal conductivity and Heat capacity

    call SoilThermProp(lbc, ubc, num_nolakec, filter_nolakec, tk, cv)

    ! Net ground heat flux into the surface and its temperature derivative
    ! Added a pfts loop here to get the average of hs and dhsdT over 
    ! all PFTs on the column. Precalculate the terms that do not depend on PFT.

!dir$ concurrent
!cdir nodep
    do fc = 1,num_nolakec
       c = filter_nolakec(fc)
       lwrad_emit(c)  =    emg(c) * sb * t_grnd(c)**4
       dlwrad_emit(c) = 4._r8*emg(c) * sb * t_grnd(c)**3
    end do

    hs(lbc:ubc) = 0._r8
    dhsdT(lbc:ubc) = 0._r8
    do pi = 1,max_pft_per_col
!dir$ concurrent
!cdir nodep
       do fc = 1,num_nolakec
          c = filter_nolakec(fc)
          if ( pi <= npfts(c) ) then
             p = pfti(c) + pi - 1
             l = plandunit(p)
             g = pgridcell(p)
             if (pwtgcell(p)>0._r8) then
                if (ltype(l) /= isturb) then
                   eflx_gnet(p) = sabg(p) + dlrad(p) &
                                  + (1-frac_veg_nosno(p))*emg(c)*forc_lwrad(g) - lwrad_emit(c) &
                                  - (eflx_sh_grnd(p)+qflx_evap_soi(p)*htvp(c))
                else
                   ! For urban columns we use the net longwave radiation (eflx_lwrad_net) because of 
                   ! interactions between urban columns.
                   
                   ! All wasteheat and traffic flux goes into canyon floor
                   if (ctype(c) == icol_road_perv .or. ctype(c) == icol_road_imperv) then
                      eflx_wasteheat_pft(p) = eflx_wasteheat(l)/(1._r8-wtlunit_roof(l))
                      eflx_heat_from_ac_pft(p) = eflx_heat_from_ac(l)/(1._r8-wtlunit_roof(l))
                      eflx_traffic_pft(p) = eflx_traffic(l)/(1._r8-wtlunit_roof(l))
                   else
                      eflx_wasteheat_pft(p) = 0._r8
                      eflx_heat_from_ac_pft(p) = 0._r8
                      eflx_traffic_pft(p) = 0._r8
                   end if
                   ! Include transpiration term because needed for pervious road
                   ! and include wasteheat and traffic flux
                   eflx_gnet(p) = sabg(p) + dlrad(p)  &
                                  - eflx_lwrad_net(p) &
                                  - (eflx_sh_grnd(p) + qflx_evap_soi(p)*htvp(c) + qflx_tran_veg(p)*hvap) &
                                  + eflx_wasteheat_pft(p) + eflx_heat_from_ac_pft(p) + eflx_traffic_pft(p)
                   eflx_anthro(p) = eflx_wasteheat_pft(p) + eflx_traffic_pft(p)
                end if
                dgnetdT(p) = - cgrnd(p) - dlwrad_emit(c)
                hs(c) = hs(c) + eflx_gnet(p) * pwtcol(p)
                dhsdT(c) = dhsdT(c) + dgnetdT(p) * pwtcol(p)
             end if
          end if
       end do
    end do

    !       Additional calculations with SNICAR: 
    !       Set up tridiagonal matrix in a new manner. There is now 
    !       absorbed solar radiation in each snow layer, instead of 
    !       only the surface. Following the current implementation, 
    !       absorbed solar flux should be: S + ((delS/delT)*dT), 
    !       where S is absorbed radiation, and T is temperature. Now, 
    !       assume delS/delT is zero, then it is OK to just add S 
    !       to each layer

    ! Initialize:
    sabg_lyr_col(lbc:ubc,-nlevsno+1:1) = 0._r8
    hs_top(lbc:ubc) = 0._r8

    do pi = 1,max_pft_per_col
!dir$ concurrent
!cdir nodep
       do fc = 1,num_nolakec
          c = filter_nolakec(fc)
          lyr_top = snl(c) + 1
          if ( pi <= npfts(c) ) then
             p = pfti(c) + pi - 1
             l = plandunit(p)
             if (pwtgcell(p)>0._r8) then
                g = pgridcell(p)
                if (ltype(l) /= isturb )then

                   eflx_gnet_top = sabg_lyr(p,lyr_top) + dlrad(p) + (1-frac_veg_nosno(p))*emg(c)*forc_lwrad(g) &
                        - lwrad_emit(c) - (eflx_sh_grnd(p)+qflx_evap_soi(p)*htvp(c))

                   hs_top(c) = hs_top(c) + eflx_gnet_top*pwtcol(p)
             
                   do j = lyr_top,1,1
                      sabg_lyr_col(c,j) = sabg_lyr_col(c,j) + sabg_lyr(p,j) * pwtcol(p)
                   enddo
                else

                   hs_top(c) = hs_top(c) + eflx_gnet(p)*pwtcol(p)

                   sabg_lyr_col(c,lyr_top) = sabg_lyr_col(c,lyr_top) + sabg(p) * pwtcol(p)
             
                endif
             endif

          endif
       enddo
    enddo

    ! Restrict internal building temperature to between min and max
    ! and determine if heating or air conditioning is on
    do fl = 1,num_urbanl
       l = filter_urbanl(fl)
       if (ltype(l) == isturb) then
          cool_on(l) = .false. 
          heat_on(l) = .false. 
          if (t_building(l) > t_building_max(l)) then
            t_building(l) = t_building_max(l)
            cool_on(l) = .true.
            heat_on(l) = .false.
          else if (t_building(l) < t_building_min(l)) then
            t_building(l) = t_building_min(l)
            cool_on(l) = .false.
            heat_on(l) = .true.
          end if
       end if
    end do

    ! Determine heat diffusion through the layer interface and factor used in computing
    ! tridiagonal matrix and set up vector r and vectors a, b, c that define tridiagonal
    ! matrix and solve system

    do j = -nlevsno+1,nlevgrnd
!dir$ concurrent
!cdir nodep
       do fc = 1,num_nolakec
          c = filter_nolakec(fc)
          l = clandunit(c)
          if (j >= snl(c)+1) then
             if (j == snl(c)+1) then
                if (ctype(c)==icol_sunwall .or. ctype(c)==icol_shadewall .or. ctype(c)==icol_roof) then
                  fact(c,j) = dtime/cv(c,j)
 
                else
                  fact(c,j) = dtime/cv(c,j) * dz(c,j) / (0.5_r8*(z(c,j)-zi(c,j-1)+capr*(z(c,j+1)-zi(c,j-1))))

         
     
             end if
                fn(c,j) = tk(c,j)*(t_soisno(c,j+1)-t_soisno(c,j))/(z(c,j+1)-z(c,j))
             else if (j <= nlevgrnd-1) then
                fact(c,j) = dtime/cv(c,j)



                fn(c,j) = tk(c,j)*(t_soisno(c,j+1)-t_soisno(c,j))/(z(c,j+1)-z(c,j))
                dzm     = (z(c,j)-z(c,j-1))
             else if (j == nlevgrnd) then
                fact(c,j) = dtime/cv(c,j)


                ! For urban sunwall, shadewall, and roof columns, there is a non-zero heat flux across
                ! the bottom "soil" layer and the equations are derived assuming a prescribed internal
                ! building temperature. (See Oleson urban notes of 6/18/03).
                if (ctype(c)==icol_sunwall .or. ctype(c)==icol_shadewall .or. ctype(c)==icol_roof) then
                   fn(c,j) = tk(c,j) * (t_building(l) - cnfac*t_soisno(c,j))/(zi(c,j) - z(c,j))
                else
                   fn(c,j) = 0._r8
                end if
             end if
          end if
       enddo
    end do

    do j = -nlevsno+1,nlevgrnd
!dir$ concurrent
!cdir nodep
       do fc = 1,num_nolakec
          c = filter_nolakec(fc)
          l = clandunit(c)
          if (j >= snl(c)+1) then
             if (j == snl(c)+1) then
                dzp     = z(c,j+1)-z(c,j)
                at(c,j) = 0._r8
                bt(c,j) = 1+(1._r8-cnfac)*fact(c,j)*tk(c,j)/dzp-fact(c,j)*dhsdT(c)

              
                ct(c,j) =  -(1._r8-cnfac)*fact(c,j)*tk(c,j)/dzp
                ! changed hs to hs_top
                rt(c,j) = t_soisno(c,j) +  fact(c,j)*( hs_top(c) - dhsdT(c)*t_soisno(c,j) + cnfac*fn(c,j) )
             else if (j <= nlevgrnd-1) then
                dzm     = (z(c,j)-z(c,j-1))
                dzp     = (z(c,j+1)-z(c,j))
                at(c,j) =   - (1._r8-cnfac)*fact(c,j)* tk(c,j-1)/dzm
                bt(c,j) = 1._r8+ (1._r8-cnfac)*fact(c,j)*(tk(c,j)/dzp + tk(c,j-1)/dzm)


 
                ct(c,j) =   - (1._r8-cnfac)*fact(c,j)* tk(c,j)/dzp

                ! if this is a snow layer or the top soil layer,
                ! add absorbed solar flux to factor 'rt'
                if (j <= 1) then
                   rt(c,j) = t_soisno(c,j) + cnfac*fact(c,j)*( fn(c,j) - fn(c,j-1) ) + (fact(c,j)*sabg_lyr_col(c,j))
                else
                   rt(c,j) = t_soisno(c,j) + cnfac*fact(c,j)*( fn(c,j) - fn(c,j-1) )
                endif

             else if (j == nlevgrnd) then

                ! For urban sunwall, shadewall, and roof columns, there is a non-zero heat flux across
                ! the bottom "soil" layer and the equations are derived assuming a prescribed internal
                ! building temperature. (See Oleson urban notes of 6/18/03).
                if (ctype(c)==icol_sunwall .or. ctype(c)==icol_shadewall .or. ctype(c)==icol_roof) then
                   dzm     = ( z(c,j)-z(c,j-1))
                   dzp     = (zi(c,j)-z(c,j))
                   at(c,j) =   - (1._r8-cnfac)*fact(c,j)*(tk(c,j-1)/dzm)
                   bt(c,j) = 1._r8+ (1._r8-cnfac)*fact(c,j)*(tk(c,j-1)/dzm + tk(c,j)/dzp)
 


                   ct(c,j) = 0._r8
                   rt(c,j) = t_soisno(c,j) + fact(c,j)*( fn(c,j) - cnfac*fn(c,j-1) )
                else
                   dzm     = (z(c,j)-z(c,j-1))
                   at(c,j) =   - (1._r8-cnfac)*fact(c,j)*tk(c,j-1)/dzm
                   bt(c,j) = 1._r8+ (1._r8-cnfac)*fact(c,j)*tk(c,j-1)/dzm


                   ct(c,j) = 0._r8
                   rt(c,j) = t_soisno(c,j) - cnfac*fact(c,j)*fn(c,j-1)
                end if
 




             end if

          end if
       enddo
    end do

!dir$ concurrent
!cdir nodep
    do fc = 1,num_nolakec
       c = filter_nolakec(fc)
       jtop(c) = snl(c) + 1
    end do
  
    call Tridiagonal(lbc, ubc, -nlevsno+1, nlevgrnd, jtop, num_nolakec, filter_nolakec, &
                     at, bt, ct, rt, t_soisno(lbc:ubc,-nlevsno+1:nlevgrnd))


    ! Melting or Freezing

    do j = -nlevsno+1,nlevgrnd
!dir$ concurrent
!cdir nodep
       do fc = 1,num_nolakec
          c = filter_nolakec(fc)
          l = clandunit(c)
          if (j >= snl(c)+1) then
             if (j <= nlevgrnd-1) then
                fn1(c,j) = tk(c,j)*(t_soisno(c,j+1)-t_soisno(c,j))/(z(c,j+1)-z(c,j))
             else if (j == nlevgrnd) then

                ! For urban sunwall, shadewall, and roof columns, there is a non-zero heat flux across
                ! the bottom "soil" layer and the equations are derived assuming a prescribed internal
                ! building temperature. (See Oleson urban notes of 6/18/03).
                ! Note new formulation for fn, this will be used below in brr computation
                if (ctype(c)==icol_sunwall .or. ctype(c)==icol_shadewall .or. ctype(c)==icol_roof) then
                   fn1(c,j) = tk(c,j) * (t_building(l) - t_soisno(c,j))/(zi(c,j) - z(c,j))
                   fn(c,j)  = tk(c,j) * (t_building(l) - tssbef(c,j))/(zi(c,j) - z(c,j))
                else
                   fn1(c,j) = 0._r8
                end if
             end if
          end if
       end do
    end do

    do fc = 1,num_nolakec
       c = filter_nolakec(fc)
       l = clandunit(c)
       if (ltype(l) == isturb) then
         eflx_building_heat(c) = cnfac*fn(c,nlevurb) + (1-cnfac)*fn1(c,nlevurb)
         if (cool_on(l)) then
           eflx_urban_ac(c) = abs(eflx_building_heat(c))
           eflx_urban_heat(c) = 0._r8
         else if (heat_on(l)) then
           eflx_urban_ac(c) = 0._r8
           eflx_urban_heat(c) = abs(eflx_building_heat(c))
         else
           eflx_urban_ac(c) = 0._r8
           eflx_urban_heat(c) = 0._r8
         end if
       end if
    end do

    do j = -nlevsno+1,nlevgrnd
!dir$ prefervector
!dir$ concurrent
!cdir nodep
       do fc = 1,num_nolakec
          c = filter_nolakec(fc)
          l = clandunit(c)
          if (j >= snl(c)+1) then
             if (j == snl(c)+1) then
                brr(c,j) = cnfac*fn(c,j) + (1._r8-cnfac)*fn1(c,j)
             else
                brr(c,j) = cnfac*(fn(c,j)-fn(c,j-1)) + (1._r8-cnfac)*(fn1(c,j)-fn1(c,j-1))
             end if
          end if
       end do
    end do

    call PhaseChange (lbc, ubc, num_nolakec, filter_nolakec, fact, brr, hs, dhsdT, xmf, hs_top, sabg_lyr_col)


!dir$ concurrent
!cdir nodep
    do fc = 1,num_nolakec
       c = filter_nolakec(fc)
       t_grnd(c) = t_soisno(c,snl(c)+1)
    end do


! Initialize soil heat content
!dir$ concurrent
!cdir nodep
    do fc = 1,num_nolakec
       c = filter_nolakec(fc)
       l = clandunit(c)
       if (ltype(l) /= isturb) then
         hc_soisno(c) = 0._r8
         hc_soi(c)    = 0._r8
       end if
       eflx_fgr12(c)= 0._r8
    end do

! Calculate soil heat content and soil plus snow heat content
    do j = -nlevsno+1,nlevgrnd
!dir$ prefervector
!dir$ concurrent
!cdir nodep
       do fc = 1,num_nolakec
          c = filter_nolakec(fc)
          l = clandunit(c)
          eflx_fgr12(c) = -cnfac*fn(c,1) - (1._r8-cnfac)*fn1(c,1)
          if (ltype(l) /= isturb) then
            if (j >= snl(c)+1) then
               hc_soisno(c) = hc_soisno(c) + cv(c,j)*t_soisno(c,j) / 1.e6_r8
            endif
            if (j >= 1) then
               hc_soi(c) = hc_soi(c) + cv(c,j)*t_soisno(c,j) / 1.e6_r8
            end if
          end if
       end do
    end do

  end subroutine SoilTemperature

!-----------------------------------------------------------------------
!BOP
!
! !IROUTINE: SoilThermProp
!
! !INTERFACE:
  subroutine SoilThermProp (lbc, ubc,  num_nolakec, filter_nolakec, tk, cv)
!
! !DESCRIPTION:
! Calculation of thermal conductivities and heat capacities of
! snow/soil layers
! (1) The volumetric heat capacity is calculated as a linear combination
!     in terms of the volumetric fraction of the constituent phases.
!
! (2) The thermal conductivity of soil is computed from the algorithm of
!     Johansen (as reported by Farouki 1981), and of snow is from the
!     formulation used in SNTHERM (Jordan 1991).
! The thermal conductivities at the interfaces between two neighboring
! layers (j, j+1) are derived from an assumption that the flux across
! the interface is equal to that from the node j to the interface and the
! flux from the interface to the node j+1.
!
! !USES:
    use shr_kind_mod, only : r8 => shr_kind_r8
    use clmtype
    use clm_varcon  , only : denh2o, denice, tfrz, tkwat, tkice, tkair, &
                             cpice,  cpliq,  istice, istwet, &
                             icol_roof, icol_sunwall, icol_shadewall, &
                             icol_road_perv, icol_road_imperv
    use clm_varpar  , only : nlevsno, nlevgrnd, nlevurb, nlevsoi
!
! !ARGUMENTS:
    implicit none
    integer , intent(in)  :: lbc, ubc                       ! column bounds
    integer , intent(in)  :: num_nolakec                    ! number of column non-lake points in column filter
    integer , intent(in)  :: filter_nolakec(ubc-lbc+1)      ! column filter for non-lake points
    real(r8), intent(out) :: cv(lbc:ubc,-nlevsno+1:nlevgrnd)! heat capacity [J/(m2 K)]
    real(r8), intent(out) :: tk(lbc:ubc,-nlevsno+1:nlevgrnd)! thermal conductivity [W/(m K)]
!
! !CALLED FROM:
! subroutine SoilTemperature in this module
!
! !REVISION HISTORY:
! 15 September 1999: Yongjiu Dai; Initial code
! 15 December 1999:  Paul Houser and Jon Radakovich; F90 Revision
! 2/13/02, Peter Thornton: migrated to new data structures
! 7/01/03, Mariana Vertenstein: migrated to vector code
!
! !LOCAL VARIABLES:
!
! local pointers to original implicit in scalars
!
    integer , pointer :: ctype(:)         ! column type
    integer , pointer :: clandunit(:)     ! column's landunit
    integer , pointer :: ltype(:)       ! landunit type
    integer , pointer :: snl(:)           ! number of snow layers
    real(r8), pointer :: h2osno(:)        ! snow water (mm H2O)
!
! local pointers to original implicit in arrays
!
    real(r8), pointer :: watsat(:,:)      ! volumetric soil water at saturation (porosity)
    real(r8), pointer :: tksatu(:,:)      ! thermal conductivity, saturated soil [W/m-K]
    real(r8), pointer :: tkmg(:,:)        ! thermal conductivity, soil minerals  [W/m-K]
    real(r8), pointer :: tkdry(:,:)       ! thermal conductivity, dry soil (W/m/Kelvin)
    real(r8), pointer :: csol(:,:)        ! heat capacity, soil solids (J/m**3/Kelvin)
    real(r8), pointer :: dz(:,:)          ! layer depth (m)
    real(r8), pointer :: zi(:,:)          ! interface level below a "z" level (m)
    real(r8), pointer :: z(:,:)           ! layer thickness (m)
    real(r8), pointer :: t_soisno(:,:)    ! soil temperature (Kelvin)
    real(r8), pointer :: h2osoi_liq(:,:)  ! liquid water (kg/m2)
    real(r8), pointer :: h2osoi_ice(:,:)  ! ice lens (kg/m2)
    real(r8), pointer :: tk_wall(:,:)     ! thermal conductivity of urban wall
    real(r8), pointer :: tk_roof(:,:)     ! thermal conductivity of urban roof
    real(r8), pointer :: tk_improad(:,:)  ! thermal conductivity of urban impervious road
    real(r8), pointer :: cv_wall(:,:)     ! thermal conductivity of urban wall
    real(r8), pointer :: cv_roof(:,:)     ! thermal conductivity of urban roof
    real(r8), pointer :: cv_improad(:,:)  ! thermal conductivity of urban impervious road
    integer,  pointer :: nlev_improad(:)  ! number of impervious road layers

!
!
! !OTHER LOCAL VARIABLES:
!EOP
!
    integer  :: l,c,j                     ! indices
    integer  :: fc                        ! lake filtered column indices
    real(r8) :: bw                        ! partial density of water (ice + liquid)
    real(r8) :: dksat                     ! thermal conductivity for saturated soil (j/(k s m))
    real(r8) :: dke                       ! kersten number
    real(r8) :: fl                        ! fraction of liquid or unfrozen water to total water
    real(r8) :: satw                      ! relative total water content of soil.
    real(r8) :: thk(lbc:ubc,-nlevsno+1:nlevgrnd) ! thermal conductivity of layer
    real(r8) :: thk_bedrock = 3.0_r8      ! thermal conductivity of 'typical' saturated granitic rock 
                                          ! (Clauser and Huenges, 1995)(W/m/K)
!-----------------------------------------------------------------------

    ! Assign local pointers to derived subtypes components (landunit-level)

    ltype    => clm3%g%l%itype

    ! Assign local pointers to derived subtypes components (column-level)

    ctype      => clm3%g%l%c%itype
    clandunit  => clm3%g%l%c%landunit
    snl        => clm3%g%l%c%cps%snl
    h2osno     => clm3%g%l%c%cws%h2osno
    watsat     => clm3%g%l%c%cps%watsat
    tksatu     => clm3%g%l%c%cps%tksatu
    tkmg       => clm3%g%l%c%cps%tkmg
    tkdry      => clm3%g%l%c%cps%tkdry
    csol       => clm3%g%l%c%cps%csol
    dz         => clm3%g%l%c%cps%dz
    zi         => clm3%g%l%c%cps%zi
    z          => clm3%g%l%c%cps%z
    t_soisno   => clm3%g%l%c%ces%t_soisno
    h2osoi_liq => clm3%g%l%c%cws%h2osoi_liq
    h2osoi_ice => clm3%g%l%c%cws%h2osoi_ice
    tk_wall    => clm3%g%l%lps%tk_wall
    tk_roof    => clm3%g%l%lps%tk_roof
    tk_improad => clm3%g%l%lps%tk_improad
    cv_wall    => clm3%g%l%lps%cv_wall
    cv_roof    => clm3%g%l%lps%cv_roof
    cv_improad => clm3%g%l%lps%cv_improad
    nlev_improad => clm3%g%l%lps%nlev_improad

    ! Thermal conductivity of soil from Farouki (1981)
    ! Urban values are from Masson et al. 2002, Evaluation of the Town Energy Balance (TEB)
    ! scheme with direct measurements from dry districts in two cities, J. Appl. Meteorol.,
    ! 41, 1011-1026.

    do j = -nlevsno+1,nlevgrnd
!dir$ concurrent
!cdir nodep
       do fc = 1, num_nolakec
          c = filter_nolakec(fc)

          ! Only examine levels from 1->nlevgrnd
          if (j >= 1) then    
             l = clandunit(c)
             if (ctype(c) == icol_sunwall .OR. ctype(c) == icol_shadewall) then
                thk(c,j) = tk_wall(l,j)
             else if (ctype(c) == icol_roof) then
                thk(c,j) = tk_roof(l,j)
             else if (ctype(c) == icol_road_imperv .and. j >= 1 .and. j <= nlev_improad(l)) then
                thk(c,j) = tk_improad(l,j)
             else if (ltype(l) /= istwet .AND. ltype(l) /= istice) then
                satw = (h2osoi_liq(c,j)/denh2o + h2osoi_ice(c,j)/denice)/(dz(c,j)*watsat(c,j))
                satw = min(1._r8, satw)
                if (satw > .1e-6_r8) then
                   fl = h2osoi_liq(c,j)/(h2osoi_ice(c,j)+h2osoi_liq(c,j))
                   if (t_soisno(c,j) >= tfrz) then       ! Unfrozen soil
                      dke = max(0._r8, log10(satw) + 1.0_r8)
                      dksat = tksatu(c,j)
                   else                               ! Frozen soil
                      dke = satw
                      dksat = tkmg(c,j)*0.249_r8**(fl*watsat(c,j))*2.29_r8**watsat(c,j)
                   endif
                   thk(c,j) = dke*dksat + (1._r8-dke)*tkdry(c,j)
                else
                   thk(c,j) = tkdry(c,j)
                endif
                if (j > nlevsoi) thk(c,j) = thk_bedrock
             else if (ltype(l) == istice) then
                thk(c,j) = tkwat
                if (t_soisno(c,j) < tfrz) thk(c,j) = tkice
             else if (ltype(l) == istwet) then                         
                if (j > nlevsoi) then 
                   thk(c,j) = thk_bedrock
                else
                   thk(c,j) = tkwat
                   if (t_soisno(c,j) < tfrz) thk(c,j) = tkice
                endif
             endif


 
          endif

          ! Thermal conductivity of snow, which from Jordan (1991) pp. 18
          ! Only examine levels from snl(c)+1 -> 0 where snl(c) < 1
          if (snl(c)+1 < 1 .AND. (j >= snl(c)+1) .AND. (j <= 0)) then  
             bw = (h2osoi_ice(c,j)+h2osoi_liq(c,j))/dz(c,j)
             thk(c,j) = tkair + (7.75e-5_r8 *bw + 1.105e-6_r8*bw*bw)*(tkice-tkair)
          end if



       end do
    end do

    ! Thermal conductivity at the layer interface

    do j = -nlevsno+1,nlevgrnd
!dir$ concurrent
!cdir nodep
       do fc = 1,num_nolakec
          c = filter_nolakec(fc)
          if (j >= snl(c)+1 .AND. j <= nlevgrnd-1) then
             tk(c,j) = thk(c,j)*thk(c,j+1)*(z(c,j+1)-z(c,j)) &
                       /(thk(c,j)*(z(c,j+1)-zi(c,j))+thk(c,j+1)*(zi(c,j)-z(c,j)))
          else if (j == nlevgrnd) then

             ! For urban sunwall, shadewall, and roof columns, there is a non-zero heat flux across
             ! the bottom "soil" layer and the equations are derived assuming a prescribed internal
             ! building temperature. (See Oleson urban notes of 6/18/03).
             if (ctype(c)==icol_sunwall .OR. ctype(c)==icol_shadewall .OR. ctype(c)==icol_roof) then
                tk(c,j) = thk(c,j)
             else
                tk(c,j) = 0._r8
             end if
          end if
       end do
    end do

    ! Soil heat capacity, from de Vires (1963)
    ! Urban values are from Masson et al. 2002, Evaluation of the Town Energy Balance (TEB)
    ! scheme with direct measurements from dry districts in two cities, J. Appl. Meteorol.,
    ! 41, 1011-1026.
 
    do j = 1, nlevgrnd
!dir$ concurrent
!cdir nodep
       do fc = 1,num_nolakec
          c = filter_nolakec(fc)
          l = clandunit(c)
          if (ctype(c)==icol_sunwall .OR. ctype(c)==icol_shadewall) then
             cv(c,j) = cv_wall(l,j) * dz(c,j)
 
          else if (ctype(c) == icol_roof) then
             cv(c,j) = cv_roof(l,j) * dz(c,j)

          else if (ctype(c) == icol_road_imperv .and. j >= 1 .and. j <= nlev_improad(l)) then
             cv(c,j) = cv_improad(l,j) * dz(c,j)

          else if (ltype(l) /= istwet .AND. ltype(l) /= istice) then
             cv(c,j) = csol(c,j)*(1-watsat(c,j))*dz(c,j) + (h2osoi_ice(c,j)*cpice + h2osoi_liq(c,j)*cpliq)

          else if (ltype(l) == istwet) then 
             cv(c,j) = (h2osoi_ice(c,j)*cpice + h2osoi_liq(c,j)*cpliq)

             if (j > nlevsoi) cv(c,j) = csol(c,j)*dz(c,j)
          else if (ltype(l) == istice) then 
             cv(c,j) = (h2osoi_ice(c,j)*cpice + h2osoi_liq(c,j)*cpliq)

          endif
          if (j == 1) then
             if (snl(c)+1 == 1 .AND. h2osno(c) > 0._r8) then
                cv(c,j) = cv(c,j) + cpice*h2osno(c)

             end if
          end if
       enddo
    end do

    ! Snow heat capacity

    do j = -nlevsno+1,0
!dir$ concurrent
!cdir nodep
       do fc = 1,num_nolakec
          c = filter_nolakec(fc)
          if (snl(c)+1 < 1 .and. j >= snl(c)+1) then
             cv(c,j) = cpliq*h2osoi_liq(c,j) + cpice*h2osoi_ice(c,j)
          end if
       end do
    end do

  end subroutine SoilThermProp

!-----------------------------------------------------------------------
!BOP
!
! !IROUTINE: PhaseChange
!
! !INTERFACE:
  subroutine PhaseChange (lbc, ubc, num_nolakec, filter_nolakec, fact, &
                          brr, hs, dhsdT, xmf, hs_top, sabg_lyr_col)
!
! !DESCRIPTION:
! Calculation of the phase change within snow and soil layers:
! (1) Check the conditions for which the phase change may take place,
!     i.e., the layer temperature is great than the freezing point
!     and the ice mass is not equal to zero (i.e. melting),
!     or the layer temperature is less than the freezing point
!     and the liquid water mass is greater than the allowable supercooled 
!     liquid water calculated from freezing point depression (i.e. freezing).
! (2) Assess the rate of phase change from the energy excess (or deficit)
!     after setting the layer temperature to freezing point.
! (3) Re-adjust the ice and liquid mass, and the layer temperature
!
! !USES:
    use shr_kind_mod , only : r8 => shr_kind_r8
    use clmtype
    use clm_varcon  , only : tfrz, hfus, grav, istsoil, isturb, icol_road_perv
#ifdef CROP
    use clm_varcon  , only : istcrop
#endif
    use clm_varpar  , only : nlevsno, nlevgrnd
    use globals     , only : dtime
!
! !ARGUMENTS:
    implicit none
    integer , intent(in) :: lbc, ubc                             ! column bounds
    integer , intent(in) :: num_nolakec                          ! number of column non-lake points in column filter
    integer , intent(in) :: filter_nolakec(ubc-lbc+1)            ! column filter for non-lake points
    real(r8), intent(in) :: brr   (lbc:ubc, -nlevsno+1:nlevgrnd) ! temporary
    real(r8), intent(in) :: fact  (lbc:ubc, -nlevsno+1:nlevgrnd) ! temporary
    real(r8), intent(in) :: hs    (lbc:ubc)                      ! net ground heat flux into the surface
    real(r8), intent(in) :: dhsdT (lbc:ubc)                      ! temperature derivative of "hs"
    real(r8), intent(out):: xmf   (lbc:ubc)                      ! total latent heat of phase change
    real(r8), intent(in) :: hs_top(lbc:ubc)                      ! net heat flux into the top snow layer [W/m2]
    real(r8), intent(in) :: sabg_lyr_col(lbc:ubc,-nlevsno+1:1)   ! absorbed solar radiation (col,lyr) [W/m2]

!
! !CALLED FROM:
! subroutine SoilTemperature in this module
!
! !REVISION HISTORY:
! 15 September 1999: Yongjiu Dai; Initial code
! 15 December 1999:  Paul Houser and Jon Radakovich; F90 Revision
! 2/14/02, Peter Thornton: Migrated to new data structures.
! 7/01/03, Mariana Vertenstein: Migrated to vector code
! 04/25/07 Keith Oleson: CLM3.5 Hydrology
! 03/28/08 Mark Flanner: accept new arguments and calculate freezing rate of h2o in snow
!
! !LOCAL VARIABLES:
!
! local pointers to original implicit in scalars
!
    integer , pointer :: snl(:)           !number of snow layers
    real(r8), pointer :: h2osno(:)        !snow water (mm H2O)
    integer , pointer :: ltype(:)         !landunit type
    integer , pointer :: clandunit(:)     !column's landunit
    integer , pointer :: ctype(:)         !column type
!
! local pointers to original implicit inout scalars
!
    real(r8), pointer :: snowdp(:)        !snow height (m)
!
! local pointers to original implicit out scalars
!
    real(r8), pointer :: qflx_snomelt(:)  !snow melt (mm H2O /s)
    real(r8), pointer :: eflx_snomelt(:)  !snow melt heat flux (W/m**2)
    real(r8), pointer :: eflx_snomelt_u(:)!urban snow melt heat flux (W/m**2)
    real(r8), pointer :: eflx_snomelt_r(:)!rural snow melt heat flux (W/m**2)
    real(r8), pointer :: qflx_snofrz_lyr(:,:)  !snow freezing rate (positive definite) (col,lyr) [kg m-2 s-1]
!
! local pointers to original implicit in arrays
!
    real(r8), pointer :: h2osoi_liq(:,:)  !liquid water (kg/m2) (new)
    real(r8), pointer :: h2osoi_ice(:,:)  !ice lens (kg/m2) (new)
    real(r8), pointer :: tssbef(:,:)      !temperature at previous time step [K]
    real(r8), pointer :: sucsat(:,:)      !minimum soil suction (mm)
    real(r8), pointer :: watsat(:,:)      !volumetric soil water at saturation (porosity)
    real(r8), pointer :: bsw(:,:)         !Clapp and Hornberger "b"
    real(r8), pointer :: dz(:,:)          !layer thickness (m)
!
! local pointers to original implicit inout arrays
!
    real(r8), pointer :: t_soisno(:,:)    !soil temperature (Kelvin)
!
! local pointers to original implicit out arrays
!
    integer, pointer :: imelt(:,:)        !flag for melting (=1), freezing (=2), Not=0 (new)
!
!
! !OTHER LOCAL VARIABLES:
!EOP
!
    integer  :: j,c,g,l                            !do loop index
    integer  :: fc                                 !lake filtered column indices
    real(r8) :: heatr                              !energy residual or loss after melting or freezing
    real(r8) :: temp1                              !temporary variables [kg/m2]
    real(r8) :: hm(lbc:ubc,-nlevsno+1:nlevgrnd)    !energy residual [W/m2]
    real(r8) :: xm(lbc:ubc,-nlevsno+1:nlevgrnd)    !melting or freezing within a time step [kg/m2]
    real(r8) :: wmass0(lbc:ubc,-nlevsno+1:nlevgrnd)!initial mass of ice and liquid (kg/m2)
    real(r8) :: wice0 (lbc:ubc,-nlevsno+1:nlevgrnd)!initial mass of ice (kg/m2)
    real(r8) :: wliq0 (lbc:ubc,-nlevsno+1:nlevgrnd)!initial mass of liquid (kg/m2)
    real(r8) :: supercool(lbc:ubc,nlevgrnd)        !supercooled water in soil (kg/m2) 
    real(r8) :: propor                             !proportionality constant (-)
    real(r8) :: tinc                               !t(n+1)-t(n) (K)
    real(r8) :: smp                                !frozen water potential (mm)
!-----------------------------------------------------------------------

    ! Assign local pointers to derived subtypes components (column-level)

    snl          => clm3%g%l%c%cps%snl
    h2osno       => clm3%g%l%c%cws%h2osno
    snowdp       => clm3%g%l%c%cps%snowdp
    qflx_snomelt => clm3%g%l%c%cwf%qflx_snomelt
    eflx_snomelt => clm3%g%l%c%cef%eflx_snomelt
    eflx_snomelt_u => clm3%g%l%c%cef%eflx_snomelt_u
    eflx_snomelt_r => clm3%g%l%c%cef%eflx_snomelt_r
    h2osoi_liq   => clm3%g%l%c%cws%h2osoi_liq
    h2osoi_ice   => clm3%g%l%c%cws%h2osoi_ice
    imelt        => clm3%g%l%c%cps%imelt
    t_soisno     => clm3%g%l%c%ces%t_soisno
    tssbef       => clm3%g%l%c%ces%tssbef
    bsw          => clm3%g%l%c%cps%bsw
    sucsat       => clm3%g%l%c%cps%sucsat
    watsat       => clm3%g%l%c%cps%watsat
    dz           => clm3%g%l%c%cps%dz
    ctype        => clm3%g%l%c%itype
    clandunit    => clm3%g%l%c%landunit
    ltype        => clm3%g%l%itype
    qflx_snofrz_lyr => clm3%g%l%c%cwf%qflx_snofrz_lyr


    ! Initialization

!dir$ concurrent
!cdir nodep
    do fc = 1,num_nolakec
       c = filter_nolakec(fc)
       qflx_snomelt(c) = 0._r8
       xmf(c) = 0._r8
       qflx_snofrz_lyr(c,-nlevsno+1:0) = 0._r8
    end do

    do j = -nlevsno+1,nlevgrnd       ! all layers
!dir$ concurrent
!cdir nodep
       do fc = 1,num_nolakec
          c = filter_nolakec(fc)
          if (j >= snl(c)+1) then

             ! Initialization
             imelt(c,j) = 0
             hm(c,j) = 0._r8
             xm(c,j) = 0._r8
             wice0(c,j) = h2osoi_ice(c,j)
             wliq0(c,j) = h2osoi_liq(c,j)
             wmass0(c,j) = h2osoi_ice(c,j) + h2osoi_liq(c,j)
          endif   ! end of snow layer if-block
       end do   ! end of column-loop
    enddo   ! end of level-loop

    do j = -nlevsno+1,0             ! snow layers 
!dir$ concurrent
!cdir nodep
       do fc = 1,num_nolakec
          c = filter_nolakec(fc)
          if (j >= snl(c)+1) then

             ! Melting identification
             ! If ice exists above melt point, melt some to liquid.
             if (h2osoi_ice(c,j) > 0._r8 .AND. t_soisno(c,j) > tfrz) then
                imelt(c,j) = 1
                t_soisno(c,j) = tfrz
             endif

             ! Freezing identification
             ! If liquid exists below melt point, freeze some to ice.
             if (h2osoi_liq(c,j) > 0._r8 .AND. t_soisno(c,j) < tfrz) then
                imelt(c,j) = 2
                t_soisno(c,j) = tfrz
             endif
          endif   ! end of snow layer if-block
       end do   ! end of column-loop
    enddo   ! end of level-loop

    do j = 1,nlevgrnd             ! soil layers 
!dir$ concurrent
!cdir nodep
       do fc = 1,num_nolakec
          c = filter_nolakec(fc)
          l = clandunit(c)
          if (h2osoi_ice(c,j) > 0. .AND. t_soisno(c,j) > tfrz) then
             imelt(c,j) = 1
             t_soisno(c,j) = tfrz
          endif

          ! from Zhao (1997) and Koren (1999)
          supercool(c,j) = 0.0_r8
#ifndef CROP
          if (ltype(l) == istsoil .or. ctype(c) == icol_road_perv) then
#else
          if (ltype(l) == istsoil .or. ltype(l) == istcrop .or. ctype(c) == icol_road_perv) then
#endif
             if(t_soisno(c,j) < tfrz) then
                smp = hfus*(tfrz-t_soisno(c,j))/(grav*t_soisno(c,j)) * 1000._r8  !(mm)
                supercool(c,j) = watsat(c,j)*(smp/sucsat(c,j))**(-1._r8/bsw(c,j))
                supercool(c,j) = supercool(c,j)*dz(c,j)*1000._r8       ! (mm)
             endif
          endif

          if (h2osoi_liq(c,j) > supercool(c,j) .AND. t_soisno(c,j) < tfrz) then
             imelt(c,j) = 2
             t_soisno(c,j) = tfrz
          endif

          ! If snow exists, but its thickness is less than the critical value (0.01 m)
          if (snl(c)+1 == 1 .AND. h2osno(c) > 0._r8 .AND. j == 1) then
             if (t_soisno(c,j) > tfrz) then
                imelt(c,j) = 1
                t_soisno(c,j) = tfrz
             endif
          endif
       end do
    enddo

    do j = -nlevsno+1,nlevgrnd       ! all layers
!dir$ concurrent
!cdir nodep
       do fc = 1,num_nolakec
          c = filter_nolakec(fc)

          if (j >= snl(c)+1) then

             ! Calculate the energy surplus and loss for melting and freezing
             if (imelt(c,j) > 0) then
                tinc = t_soisno(c,j)-tssbef(c,j)
                
                ! added unique cases for this calculation,
                ! to account for absorbed solar radiation in each layer
                if (j == snl(c)+1) then
                   ! top layer
                   hm(c,j) = hs_top(c) + dhsdT(c)*tinc + brr(c,j) - tinc/fact(c,j)
                elseif (j <= 1) then
                   ! snow layer or top soil layer (where sabg_lyr_col is defined)
                   hm(c,j) = brr(c,j) - tinc/fact(c,j) + sabg_lyr_col(c,j)
                else
                   ! soil layer
                   hm(c,j) = brr(c,j) - tinc/fact(c,j)
                endif

             endif

             ! These two errors were checked carefully (Y. Dai).  They result from the
             ! computed error of "Tridiagonal-Matrix" in subroutine "thermal".
             if (imelt(c,j) == 1 .AND. hm(c,j) < 0._r8) then
                hm(c,j) = 0._r8
                imelt(c,j) = 0
             endif
             if (imelt(c,j) == 2 .AND. hm(c,j) > 0._r8) then
                hm(c,j) = 0._r8
                imelt(c,j) = 0
             endif

             ! The rate of melting and freezing

             if (imelt(c,j) > 0 .and. abs(hm(c,j)) > 0._r8) then
                xm(c,j) = hm(c,j)*dtime/hfus                           ! kg/m2

                ! If snow exists, but its thickness is less than the critical value
                ! (1 cm). Note: more work is needed to determine how to tune the
                ! snow depth for this case
                if (j == 1) then
                   if (snl(c)+1 == 1 .AND. h2osno(c) > 0._r8 .AND. xm(c,j) > 0._r8) then
                      temp1 = h2osno(c)                           ! kg/m2
                      h2osno(c) = max(0._r8,temp1-xm(c,j))
                      propor = h2osno(c)/temp1
                      snowdp(c) = propor * snowdp(c)
                      heatr = hm(c,j) - hfus*(temp1-h2osno(c))/dtime   ! W/m2
                      if (heatr > 0._r8) then
                         xm(c,j) = heatr*dtime/hfus                    ! kg/m2
                         hm(c,j) = heatr                               ! W/m2
                      else
                         xm(c,j) = 0._r8
                         hm(c,j) = 0._r8
                      endif
                      qflx_snomelt(c) = max(0._r8,(temp1-h2osno(c)))/dtime   ! kg/(m2 s)
                      xmf(c) = hfus*qflx_snomelt(c)
                   endif
                endif

                heatr = 0._r8
                if (xm(c,j) > 0._r8) then
                   h2osoi_ice(c,j) = max(0._r8, wice0(c,j)-xm(c,j))
                   heatr = hm(c,j) - hfus*(wice0(c,j)-h2osoi_ice(c,j))/dtime
                else if (xm(c,j) < 0._r8) then
                   if (j <= 0) then
                      h2osoi_ice(c,j) = min(wmass0(c,j), wice0(c,j)-xm(c,j))  ! snow
                   else
                      if (wmass0(c,j) < supercool(c,j)) then
                         h2osoi_ice(c,j) = 0._r8
                      else
                         h2osoi_ice(c,j) = min(wmass0(c,j) - supercool(c,j),wice0(c,j)-xm(c,j))
                      endif
                   endif
                   heatr = hm(c,j) - hfus*(wice0(c,j)-h2osoi_ice(c,j))/dtime
                endif

                h2osoi_liq(c,j) = max(0._r8,wmass0(c,j)-h2osoi_ice(c,j))

                if (abs(heatr) > 0._r8) then
                   if (j > snl(c)+1) then
                      t_soisno(c,j) = t_soisno(c,j) + fact(c,j)*heatr
                   else
                      t_soisno(c,j) = t_soisno(c,j) + fact(c,j)*heatr/(1._r8-fact(c,j)*dhsdT(c))
                   endif
                   if (j <= 0) then    ! snow
                      if (h2osoi_liq(c,j)*h2osoi_ice(c,j)>0._r8) t_soisno(c,j) = tfrz
                   end if
                endif

                xmf(c) = xmf(c) + hfus * (wice0(c,j)-h2osoi_ice(c,j))/dtime

                if (imelt(c,j) == 1 .AND. j < 1) then
                   qflx_snomelt(c) = qflx_snomelt(c) + max(0._r8,(wice0(c,j)-h2osoi_ice(c,j)))/dtime
                endif

                ! layer freezing mass flux (positive):
                if (imelt(c,j) == 2 .AND. j < 1) then
                   qflx_snofrz_lyr(c,j) = max(0._r8,(h2osoi_ice(c,j)-wice0(c,j)))/dtime
                endif

             endif

          endif   ! end of snow layer if-block
       end do   ! end of column-loop
    enddo   ! end of level-loop

    ! Needed for history file output

!dir$ concurrent
!cdir nodep
    do fc = 1,num_nolakec
       c = filter_nolakec(fc)
       eflx_snomelt(c) = qflx_snomelt(c) * hfus
       l = clandunit(c)
       if (ltype(l) == isturb) then
         eflx_snomelt_u(c) = eflx_snomelt(c)
#ifndef CROP
       else if (ltype(l) == istsoil) then
#else
       else if (ltype(l) == istsoil .or. ltype(l) == istcrop) then
#endif
         eflx_snomelt_r(c) = eflx_snomelt(c)
       end if
    end do

  end subroutine PhaseChange


end module SoilTemperatureMod

module SoilHydrologyMod

!-----------------------------------------------------------------------
!BOP
!
! !MODULE: SoilHydrologyMod
!
! !DESCRIPTION:
! Calculate soil hydrology
!
! !PUBLIC TYPES:
  implicit none
  save
!
! !PUBLIC MEMBER FUNCTIONS:
  public :: SurfaceRunoff  ! Calculate surface runoff
  public :: Infiltration   ! Calculate infiltration into surface soil layer
  public :: SoilWater      ! Calculate soil hydrology
  public :: Drainage       ! Calculate subsurface drainage
!
! !REVISION HISTORY:
! Created by Mariana Vertenstein
! 04/25/07 Keith Oleson: CLM3.5 hydrology
!
!EOP
!-----------------------------------------------------------------------

contains

!-----------------------------------------------------------------------
!BOP
!
! !IROUTINE: SurfaceRunoff
!
! !INTERFACE:
  subroutine SurfaceRunoff (lbc, ubc, lbp, ubp, num_hydrologyc, filter_hydrologyc, &
                            num_urbanc, filter_urbanc, vol_liq, icefrac)
!
! !DESCRIPTION:
! Calculate surface runoff
!
! !USES:
    use shr_kind_mod    , only : r8 => shr_kind_r8
    use clmtype
    use clm_varcon      , only : denice, denh2o, wimp, pondmx_urban, &
                                 icol_roof, icol_sunwall, icol_shadewall, &
                                 icol_road_imperv, icol_road_perv
                             
    use clm_varpar      , only : nlevsoi, maxpatch_pft
    use globals         , only : dtime
!
! !ARGUMENTS:
    implicit none
    integer , intent(in)  :: lbc, ubc                     ! column bounds
    integer , intent(in)  :: lbp, ubp                     ! pft bounds   
    integer , intent(in)  :: num_hydrologyc               ! number of column soil points in column filter
    integer , intent(in)  :: filter_hydrologyc(ubc-lbc+1) ! column filter for soil points
    integer , intent(in)  :: num_urbanc                   ! number of column urban points in column filter
    integer , intent(in)  :: filter_urbanc(ubc-lbc+1)     ! column filter for urban points
    real(r8), intent(out) :: vol_liq(lbc:ubc,1:nlevsoi)   ! partial volume of liquid water in layer
    real(r8), intent(out) :: icefrac(lbc:ubc,1:nlevsoi)   ! fraction of ice in layer (-)
!
! !CALLED FROM:
! subroutine Hydrology2 in module Hydrology2Mod
!
! !REVISION HISTORY:
! 15 September 1999: Yongjiu Dai; Initial code
! 12 November 1999:  Z.-L. Yang and G.-Y. Niu
! 15 December 1999:  Paul Houser and Jon Radakovich; F90 Revision
! 2/26/02, Peter Thornton: Migrated to new data structures.
! 4/26/05, David Lawrence: Made surface runoff for dry soils a function
!   of rooting fraction in top three soil layers.
! 04/25/07  Keith Oleson: Completely new routine for CLM3.5 hydrology
!
! !LOCAL VARIABLES:
!
! local pointers to original implicit in arguments
!
    integer , pointer :: cgridcell(:)      ! gridcell index for each column
    integer , pointer :: ctype(:)          ! column type index
    real(r8), pointer :: qflx_top_soil(:)  !net water input into soil from top (mm/s)
    real(r8), pointer :: watsat(:,:)       !volumetric soil water at saturation (porosity)
    real(r8), pointer :: hkdepth(:)        !decay factor (m)
    real(r8), pointer :: zwt(:)            !water table depth (m)
    real(r8), pointer :: fcov(:)           !fractional impermeable area
    real(r8), pointer :: fsat(:)           !fractional area with water table at surface
    real(r8), pointer :: dz(:,:)           !layer depth (m)
    real(r8), pointer :: h2osoi_ice(:,:)   !ice lens (kg/m2)
    real(r8), pointer :: h2osoi_liq(:,:)   !liquid water (kg/m2)
    real(r8), pointer :: wtfact(:)         !maximum saturated fraction for a gridcell
    real(r8), pointer :: hksat(:,:)        ! hydraulic conductivity at saturation (mm H2O /s)
    real(r8), pointer :: bsw(:,:)          ! Clapp and Hornberger "b"
    real(r8), pointer :: sucsat(:,:)       ! minimum soil suction (mm)
    integer , pointer :: snl(:)            ! minus number of snow layers
    real(r8), pointer :: qflx_evap_grnd(:) ! ground surface evaporation rate (mm H2O/s) [+]
    real(r8), pointer :: zi(:,:)           ! interface level below a "z" level (m)
!
! local pointers to original implicit out arguments
!
    real(r8), pointer :: qflx_surf(:)      ! surface runoff (mm H2O /s)
    real(r8), pointer :: eff_porosity(:,:) ! effective porosity = porosity - vol_ice
    real(r8), pointer :: fracice(:,:)      !fractional impermeability (-)
!
!EOP
!
! !OTHER LOCAL VARIABLES:
!
    integer  :: c,j,fc,g                   !indices
    real(r8) :: xs(lbc:ubc)                ! excess soil water above urban ponding limit
    real(r8) :: vol_ice(lbc:ubc,1:nlevsoi) !partial volume of ice lens in layer
    real(r8) :: fff(lbc:ubc)               !decay factor (m-1)
    real(r8) :: s1                         !variable to calculate qinmax
    real(r8) :: su                         !variable to calculate qinmax
    real(r8) :: v                          !variable to calculate qinmax
    real(r8) :: qinmax                     !maximum infiltration capacity (mm/s)

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

    ! Assign local pointers to derived subtype components (column-level)

    ctype         => clm3%g%l%c%itype
    qflx_top_soil => clm3%g%l%c%cwf%qflx_top_soil
    qflx_surf     => clm3%g%l%c%cwf%qflx_surf
    watsat        => clm3%g%l%c%cps%watsat
    hkdepth       => clm3%g%l%c%cps%hkdepth
    dz            => clm3%g%l%c%cps%dz
    h2osoi_ice    => clm3%g%l%c%cws%h2osoi_ice
    h2osoi_liq    => clm3%g%l%c%cws%h2osoi_liq
    fcov          => clm3%g%l%c%cws%fcov
    fsat          => clm3%g%l%c%cws%fsat
    eff_porosity  => clm3%g%l%c%cps%eff_porosity
    wtfact        => clm3%g%l%c%cps%wtfact
    zwt           => clm3%g%l%c%cws%zwt
    fracice       => clm3%g%l%c%cps%fracice
    hksat         => clm3%g%l%c%cps%hksat
    bsw           => clm3%g%l%c%cps%bsw
    sucsat        => clm3%g%l%c%cps%sucsat
    snl            => clm3%g%l%c%cps%snl
    qflx_evap_grnd => clm3%g%l%c%cwf%pwf_a%qflx_evap_grnd
    zi            => clm3%g%l%c%cps%zi


    do j = 1,nlevsoi
!dir$ concurrent
!cdir nodep
       do fc = 1, num_hydrologyc
          c = filter_hydrologyc(fc)

          ! Porosity of soil, partial volume of ice and liquid, fraction of ice in each layer,
          ! fractional impermeability
   
          vol_ice(c,j) = min(watsat(c,j), h2osoi_ice(c,j)/(dz(c,j)*denice))
          eff_porosity(c,j) = max(0.01_r8,watsat(c,j)-vol_ice(c,j))
          vol_liq(c,j) = min(eff_porosity(c,j), h2osoi_liq(c,j)/(dz(c,j)*denh2o))

          icefrac(c,j) = min(1._r8,h2osoi_ice(c,j)/(h2osoi_ice(c,j)+h2osoi_liq(c,j)))

          fracice(c,j) = max(0._r8,exp(-3._r8*(1._r8-icefrac(c,j)))- exp(-3._r8))/(1.0_r8-exp(-3._r8))
       end do
    end do

    ! Saturated fraction

!dir$ concurrent
!cdir nodep
    do fc = 1, num_hydrologyc
       c = filter_hydrologyc(fc)
       fff(c) = 0.5_r8
       fsat(c) = wtfact(c) * exp(-0.5_r8*fff(c)*zwt(c))
       fcov(c) = (1._r8 - fracice(c,1)) * fsat(c) + fracice(c,1)
    end do

!dir$ concurrent
!cdir nodep
    do fc = 1, num_hydrologyc
       c = filter_hydrologyc(fc)

       ! Maximum infiltration capacity
       s1        = max(0.01_r8,vol_liq(c,1)/max(wimp,eff_porosity(c,1)))
       su        = max(0._r8,(s1-fcov(c)) / (max(0.01_r8,1._r8-fcov(c))))
       v         = -bsw(c,1)*sucsat(c,1)/(0.5_r8*dz(c,1)*1000._r8)
       qinmax    = (1._r8+v*(su-1._r8))*hksat(c,1)

       ! Surface runoff
       qflx_surf(c) =  fcov(c) * qflx_top_soil(c) + &
                       (1._r8-fcov(c)) * max(0._r8, qflx_top_soil(c)-qinmax)

    end do

    ! Determine water in excess of ponding limit for urban roof and impervious road.
    ! Excess goes to surface runoff. No surface runoff for sunwall and shadewall.

!dir$ concurrent
!cdir nodep
    do fc = 1, num_urbanc
       c = filter_urbanc(fc)
       if (ctype(c) == icol_roof .or. ctype(c) == icol_road_imperv) then

          ! If there are snow layers then all qflx_top_soil goes to surface runoff
          if (snl(c) < 0) then
             qflx_surf(c) = max(0._r8,qflx_top_soil(c))
          else
             xs(c) = max(0._r8, &
                         h2osoi_liq(c,1)/dtime + qflx_top_soil(c) - qflx_evap_grnd(c) - &
                         pondmx_urban/dtime)
             if (xs(c) > 0.) then
                h2osoi_liq(c,1) = pondmx_urban
             else
                h2osoi_liq(c,1) = max(0._r8,h2osoi_liq(c,1)+ &
                                     (qflx_top_soil(c)-qflx_evap_grnd(c))*dtime)
             end if
             qflx_surf(c) = xs(c)
          end if
       else if (ctype(c) == icol_sunwall .or. ctype(c) == icol_shadewall) then
         qflx_surf(c) = 0._r8
       end if
    end do

  end subroutine SurfaceRunoff

!-----------------------------------------------------------------------
!BOP
!
! !IROUTINE: Infiltration
!
! !INTERFACE:
  subroutine Infiltration(lbc, ubc, num_hydrologyc, filter_hydrologyc, &
                          num_urbanc, filter_urbanc)
!
! !DESCRIPTION:
! Calculate infiltration into surface soil layer (minus the evaporation)
!
! !USES:
    use shr_kind_mod, only : r8 => shr_kind_r8
    use clm_varcon  , only : icol_roof, icol_road_imperv, icol_sunwall, icol_shadewall, &
                             icol_road_perv
    use clmtype
!
! !ARGUMENTS:
    implicit none
    integer, intent(in) :: lbc, ubc                     ! column bounds
    integer, intent(in) :: num_hydrologyc               ! number of column soil points in column filter
    integer, intent(in) :: filter_hydrologyc(ubc-lbc+1) ! column filter for soil points
    integer, intent(in) :: num_urbanc                   ! number of column urban points in column filter
    integer, intent(in) :: filter_urbanc(ubc-lbc+1)     ! column filter for urban points
!
! !CALLED FROM:
!
! !REVISION HISTORY:
! 15 September 1999: Yongjiu Dai; Initial code
! 12 November 1999:  Z.-L. Yang and G.-Y. Niu
! 15 December 1999:  Paul Houser and Jon Radakovich; F90 Revision
! 2/27/02, Peter Thornton: Migrated to new data structures.
!
! !LOCAL VARIABLES:
!
! local pointers to original implicit in arguments
!
    integer , pointer :: ctype(:)         ! column type index
    integer , pointer :: snl(:)           ! minus number of snow layers
    real(r8), pointer :: qflx_top_soil(:) ! net water input into soil from top (mm/s)
    real(r8), pointer :: qflx_surf(:)     ! surface runoff (mm H2O /s)
    real(r8), pointer :: qflx_evap_grnd(:)! ground surface evaporation rate (mm H2O/s) [+]
!
! local pointers to original implicit out arguments
!
    real(r8), pointer :: qflx_infl(:)      !infiltration (mm H2O /s)
!
!EOP
!
! !OTHER LOCAL VARIABLES:
!
    integer :: c, fc    !indices
!-----------------------------------------------------------------------

    ! Assign local pointers to derived type members (column-level)

    ctype          => clm3%g%l%c%itype
    snl            => clm3%g%l%c%cps%snl
    qflx_top_soil  => clm3%g%l%c%cwf%qflx_top_soil
    qflx_surf      => clm3%g%l%c%cwf%qflx_surf
    qflx_infl      => clm3%g%l%c%cwf%qflx_infl
    qflx_evap_grnd => clm3%g%l%c%cwf%pwf_a%qflx_evap_grnd

    ! Infiltration into surface soil layer (minus the evaporation)

!dir$ concurrent
!cdir nodep
    do fc = 1, num_hydrologyc
       c = filter_hydrologyc(fc)
       if (snl(c) >= 0) then
          qflx_infl(c) = qflx_top_soil(c) - qflx_surf(c) - qflx_evap_grnd(c)
       else
          qflx_infl(c) = qflx_top_soil(c) - qflx_surf(c)
       end if
    end do

    ! No infiltration for impervious urban surfaces

!dir$ concurrent
!cdir nodep
    do fc = 1, num_urbanc
       c = filter_urbanc(fc)
       if (ctype(c) /= icol_road_perv) then
          qflx_infl(c) = 0._r8
       end if
    end do
    
  end subroutine Infiltration

!-----------------------------------------------------------------------
!BOP
!
! !IROUTINE: SoilWater
!
! !INTERFACE:
  subroutine SoilWater(lbc, ubc, num_hydrologyc, filter_hydrologyc, &
                       num_urbanc, filter_urbanc, &
                       vol_liq, dwat, hk, dhkdw)
!
! !DESCRIPTION:
! Soil hydrology
! Soil moisture is predicted from a 10-layer model (as with soil
! temperature), in which the vertical soil moisture transport is governed
! by infiltration, runoff, gradient diffusion, gravity, and root
! extraction through canopy transpiration.  The net water applied to the
! surface layer is the snowmelt plus precipitation plus the throughfall
! of canopy dew minus surface runoff and evaporation.
! CLM3.5 uses a zero-flow bottom boundary condition.
!
! The vertical water flow in an unsaturated porous media is described by
! Darcy's law, and the hydraulic conductivity and the soil negative
! potential vary with soil water content and soil texture based on the work
! of Clapp and Hornberger (1978) and Cosby et al. (1984). The equation is
! integrated over the layer thickness, in which the time rate of change in
! water mass must equal the net flow across the bounding interface, plus the
! rate of internal source or sink. The terms of water flow across the layer
! interfaces are linearly expanded by using first-order Taylor expansion.
! The equations result in a tridiagonal system equation.
!
! Note: length units here are all millimeter
! (in temperature subroutine uses same soil layer
! structure required but lengths are m)
!
! Richards equation:
!
! d wat      d     d wat d psi
! ----- = - -- [ k(----- ----- - 1) ] + S
!   dt      dz       dz  d wat
!
! where: wat = volume of water per volume of soil (mm**3/mm**3)
! psi = soil matrix potential (mm)
! dt  = time step (s)
! z   = depth (mm)
! dz  = thickness (mm)
! qin = inflow at top (mm h2o /s)
! qout= outflow at bottom (mm h2o /s)
! s   = source/sink flux (mm h2o /s)
! k   = hydraulic conductivity (mm h2o /s)
!
!                       d qin                  d qin
! qin[n+1] = qin[n] +  --------  d wat(j-1) + --------- d wat(j)
!                       d wat(j-1)             d wat(j)
!                ==================|=================
!                                  < qin
!
!                 d wat(j)/dt * dz = qin[n+1] - qout[n+1] + S(j)
!
!                                  > qout
!                ==================|=================
!                        d qout               d qout
! qout[n+1] = qout[n] + --------- d wat(j) + --------- d wat(j+1)
!                        d wat(j)             d wat(j+1)
!
!
! Solution: linearize k and psi about d wat and use tridiagonal
! system of equations to solve for d wat,
! where for layer j
!
!
! r_j = a_j [d wat_j-1] + b_j [d wat_j] + c_j [d wat_j+1]
!
! !USES:
    use shr_kind_mod, only: r8 => shr_kind_r8
    use clmtype
    use clm_varcon    , only : wimp, icol_roof, icol_road_imperv
    use clm_varpar    , only : nlevsoi, max_pft_per_col
    use shr_const_mod , only : SHR_CONST_TKFRZ, SHR_CONST_LATICE, SHR_CONST_G
    use TridiagonalMod, only : Tridiagonal
    use globals       , only : dtime
!
! !ARGUMENTS:
    implicit none
    integer , intent(in)  :: lbc, ubc                     ! column bounds
    integer , intent(in)  :: num_hydrologyc               ! number of column soil points in column filter
    integer , intent(in)  :: filter_hydrologyc(ubc-lbc+1) ! column filter for soil points
    integer , intent(in)  :: num_urbanc                   ! number of column urban points in column filter
    integer , intent(in)  :: filter_urbanc(ubc-lbc+1)     ! column filter for urban points
    real(r8), intent(in)  :: vol_liq(lbc:ubc,1:nlevsoi)   ! soil water per unit volume [mm/mm]
    real(r8), intent(out) :: dwat(lbc:ubc,1:nlevsoi)      ! change of soil water [m3/m3]
    real(r8), intent(out) :: hk(lbc:ubc,1:nlevsoi)        ! hydraulic conductivity [mm h2o/s]
    real(r8), intent(out) :: dhkdw(lbc:ubc,1:nlevsoi)     ! d(hk)/d(vol_liq)
!
! !CALLED FROM:
! subroutine Hydrology2 in module Hydrology2Mod
!
! !REVISION HISTORY:
! 15 September 1999: Yongjiu Dai; Initial code
! 15 December 1999:  Paul Houser and Jon Radakovich; F90 Revision
! 2/27/02, Peter Thornton: Migrated to new data structures. Includes
! treatment of multiple PFTs on a single soil column.
! 04/25/07 Keith Oleson: CLM3.5 hydrology
!
! !LOCAL VARIABLES:
!
! local pointers to original implicit in arguments
!
    integer , pointer :: ctype(:)             ! column type index
    integer , pointer :: npfts(:)             ! column's number of pfts - ADD
    real(r8), pointer :: pwtcol(:)            ! weight relative to column for each pft
    real(r8), pointer :: pwtgcell(:)          ! weight relative to gridcell for each pft
    real(r8), pointer :: z(:,:)               ! layer depth (m)
    real(r8), pointer :: dz(:,:)              ! layer thickness (m)
    real(r8), pointer :: smpmin(:)            ! restriction for min of soil potential (mm)
    real(r8), pointer :: qflx_infl(:)         ! infiltration (mm H2O /s)
    real(r8), pointer :: qflx_tran_veg_pft(:) ! vegetation transpiration (mm H2O/s) (+ = to atm)
    real(r8), pointer :: qflx_tran_veg_col(:) ! vegetation transpiration (mm H2O/s) (+ = to atm)
    real(r8), pointer :: eff_porosity(:,:)    ! effective porosity = porosity - vol_ice
    real(r8), pointer :: watsat(:,:)          ! volumetric soil water at saturation (porosity)
    real(r8), pointer :: hksat(:,:)           ! hydraulic conductivity at saturation (mm H2O /s)
    real(r8), pointer :: bsw(:,:)             ! Clapp and Hornberger "b"
    real(r8), pointer :: sucsat(:,:)          ! minimum soil suction (mm)
    real(r8), pointer :: t_soisno(:,:)        ! soil temperature (Kelvin)
    real(r8), pointer :: rootr_pft(:,:)       ! effective fraction of roots in each soil layer
    integer , pointer :: pfti(:)              ! beginning pft index for each column
    real(r8), pointer :: fracice(:,:)         ! fractional impermeability (-)
    real(r8), pointer :: h2osoi_vol(:,:)      ! volumetric soil water (0<=h2osoi_vol<=watsat) [m3/m3]
    real(r8), pointer :: qcharge(:)           ! aquifer recharge rate (mm/s)
    real(r8), pointer :: hkdepth(:)           ! decay factor (m)
    real(r8), pointer :: zwt(:)               ! water table depth (m)
    real(r8), pointer :: zi(:,:)              ! interface level below a "z" level (m)
!
! local pointers to original implicit inout arguments
!
    real(r8), pointer :: h2osoi_liq(:,:)      ! liquid water (kg/m2)
!
! local pointer s to original implicit out arguments
!
    real(r8), pointer :: rootr_col(:,:)       ! effective fraction of roots in each soil layer
    real(r8), pointer :: smp_l(:,:)             ! soil matrix potential [mm]
    real(r8), pointer :: hk_l(:,:)              ! hydraulic conductivity (mm/s)
!
!EOP
!
! !OTHER LOCAL VARIABLES:
!
    integer  :: p,c,fc,j                  ! do loop indices
    integer  :: jtop(lbc:ubc)             ! top level at each column
    real(r8) :: amx(lbc:ubc,1:nlevsoi+1)  ! "a" left off diagonal of tridiagonal matrix
    real(r8) :: bmx(lbc:ubc,1:nlevsoi+1)  ! "b" diagonal column for tridiagonal matrix
    real(r8) :: cmx(lbc:ubc,1:nlevsoi+1)  ! "c" right off diagonal tridiagonal matrix
    real(r8) :: rmx(lbc:ubc,1:nlevsoi+1)  ! "r" forcing term of tridiagonal matrix
    real(r8) :: zmm(lbc:ubc,1:nlevsoi+1)  ! layer depth [mm]
    real(r8) :: dzmm(lbc:ubc,1:nlevsoi+1) ! layer thickness [mm]
    real(r8) :: den                       ! used in calculating qin, qout
    real(r8) :: dqidw0(lbc:ubc,1:nlevsoi+1) ! d(qin)/d(vol_liq(i-1))
    real(r8) :: dqidw1(lbc:ubc,1:nlevsoi+1) ! d(qin)/d(vol_liq(i))
    real(r8) :: dqodw1(lbc:ubc,1:nlevsoi+1) ! d(qout)/d(vol_liq(i))
    real(r8) :: dqodw2(lbc:ubc,1:nlevsoi+1) ! d(qout)/d(vol_liq(i+1))
    real(r8) :: dsmpdw(lbc:ubc,1:nlevsoi+1) ! d(smp)/d(vol_liq)
    real(r8) :: num                         ! used in calculating qin, qout
    real(r8) :: qin(lbc:ubc,1:nlevsoi+1)    ! flux of water into soil layer [mm h2o/s]
    real(r8) :: qout(lbc:ubc,1:nlevsoi+1)   ! flux of water out of soil layer [mm h2o/s]
    real(r8) :: s_node                    ! soil wetness
    real(r8) :: s1                        ! "s" at interface of layer
    real(r8) :: s2                        ! k*s**(2b+2)
    real(r8) :: smp(lbc:ubc,1:nlevsoi)    ! soil matrix potential [mm]
    real(r8) :: sdamp                     ! extrapolates soiwat dependence of evaporation
    integer  :: pi                        ! pft index
    real(r8) :: temp(lbc:ubc)             ! accumulator for rootr weighting
    integer  :: jwt(lbc:ubc)              ! index of the soil layer right above the water table (-)
    real(r8) :: smp1,dsmpdw1,wh,wh_zwt,ka
    real(r8) :: dwat2(lbc:ubc,1:nlevsoi+1)
    real(r8) :: dzq                         ! used in calculating qin, qout (difference in equilbirium matric potential)
    real(r8) :: zimm(lbc:ubc,0:nlevsoi)     ! layer interface depth [mm]
    real(r8) :: zq(lbc:ubc,1:nlevsoi+1)     ! equilibrium matric potential for each layer [mm]
    real(r8) :: vol_eq(lbc:ubc,1:nlevsoi+1) ! equilibrium volumetric water content
    real(r8) :: tempi                       ! temp variable for calculating vol_eq
    real(r8) :: temp0                       ! temp variable for calculating vol_eq
    real(r8) :: voleq1                      ! temp variable for calculating vol_eq
    real(r8) :: zwtmm(lbc:ubc)              ! water table depth [mm]
!-----------------------------------------------------------------------

    ! Assign local pointers to derived type members (column-level)

    qcharge           => clm3%g%l%c%cws%qcharge
    hkdepth           => clm3%g%l%c%cps%hkdepth
    zi                => clm3%g%l%c%cps%zi
    zwt               => clm3%g%l%c%cws%zwt
    ctype             => clm3%g%l%c%itype
    npfts             => clm3%g%l%c%npfts
    z                 => clm3%g%l%c%cps%z
    dz                => clm3%g%l%c%cps%dz
    smpmin            => clm3%g%l%c%cps%smpmin
    watsat            => clm3%g%l%c%cps%watsat
    hksat             => clm3%g%l%c%cps%hksat
    bsw               => clm3%g%l%c%cps%bsw
    sucsat            => clm3%g%l%c%cps%sucsat
    eff_porosity      => clm3%g%l%c%cps%eff_porosity
    rootr_col         => clm3%g%l%c%cps%rootr_column
    t_soisno          => clm3%g%l%c%ces%t_soisno
    h2osoi_liq        => clm3%g%l%c%cws%h2osoi_liq
    h2osoi_vol        => clm3%g%l%c%cws%h2osoi_vol
    qflx_infl         => clm3%g%l%c%cwf%qflx_infl
    fracice           => clm3%g%l%c%cps%fracice
    qflx_tran_veg_col => clm3%g%l%c%cwf%pwf_a%qflx_tran_veg
    pfti              => clm3%g%l%c%pfti
    smp_l             => clm3%g%l%c%cws%smp_l
    hk_l              => clm3%g%l%c%cws%hk_l

    ! Assign local pointers to derived type members (pft-level)

    qflx_tran_veg_pft => clm3%g%l%c%p%pwf%qflx_tran_veg
    rootr_pft         => clm3%g%l%c%p%pps%rootr
    pwtcol            => clm3%g%l%c%p%wtcol
    pwtgcell          => clm3%g%l%c%p%wtgcell



    ! Because the depths in this routine are in mm, use local
    ! variable arrays instead of pointers

    do j = 1, nlevsoi
!dir$ concurrent
!cdir nodep
       do fc = 1, num_hydrologyc
          c = filter_hydrologyc(fc)
          zmm(c,j) = z(c,j)*1.e3_r8
          dzmm(c,j) = dz(c,j)*1.e3_r8
          zimm(c,j) = zi(c,j)*1.e3_r8
       end do
    end do

    do fc = 1, num_hydrologyc 
       c = filter_hydrologyc(fc)
       zimm(c,0) = 0.0_r8
       zwtmm(c)  = zwt(c)*1.e3_r8
    end do

    ! First step is to calculate the column-level effective rooting
    ! fraction in each soil layer. This is done outside the usual
    ! PFT-to-column averaging routines because it is not a simple
    ! weighted average of the PFT level rootr arrays. Instead, the
    ! weighting depends on both the per-unit-area transpiration
    ! of the PFT and the PFTs area relative to all PFTs.

    temp(:) = 0._r8

    do j = 1, nlevsoi
!dir$ concurrent
!cdir nodep
       do fc = 1, num_hydrologyc
          c = filter_hydrologyc(fc)
          rootr_col(c,j) = 0._r8
       end do
    end do

    do pi = 1,max_pft_per_col
       do j = 1,nlevsoi
!dir$ concurrent
!cdir nodep
          do fc = 1, num_hydrologyc
             c = filter_hydrologyc(fc)
             if (pi <= npfts(c)) then
                p = pfti(c) + pi - 1
                if (pwtgcell(p)>0._r8) then
                   rootr_col(c,j) = rootr_col(c,j) + rootr_pft(p,j) * qflx_tran_veg_pft(p) * pwtcol(p)
                end if
             end if
          end do
       end do
!dir$ concurrent
!cdir nodep
       do fc = 1, num_hydrologyc
          c = filter_hydrologyc(fc)
          if (pi <= npfts(c)) then
             p = pfti(c) + pi - 1
             if (pwtgcell(p)>0._r8) then
                temp(c) = temp(c) + qflx_tran_veg_pft(p) * pwtcol(p)
             end if
          end if
       end do
    end do

    do j = 1, nlevsoi
!dir$ concurrent
!cdir nodep
       do fc = 1, num_hydrologyc
          c = filter_hydrologyc(fc)
          if (temp(c) /= 0._r8) then
             rootr_col(c,j) = rootr_col(c,j)/temp(c)
          end if
       end do
    end do

    !compute jwt index
    ! The layer index of the first unsaturated layer, i.e., the layer right above
    ! the water table

!dir$ concurrent
!cdir nodep
    do fc = 1, num_hydrologyc
       c = filter_hydrologyc(fc)
       jwt(c) = nlevsoi
       do j = 2,nlevsoi
          if(zwt(c) <= zi(c,j)) then
             jwt(c) = j-1
             exit
          end if
       enddo
    end do

    ! calculate the equilibrium water content based on the water table depth
            
    do j=1,nlevsoi 
       do fc=1, num_hydrologyc
          c = filter_hydrologyc(fc)
          if ((zwtmm(c) .lt. zimm(c,j-1))) then   !fully saturated when wtd is less than the layer top
             vol_eq(c,j) = watsat(c,j)
            
          ! use the weighted average from the saturated part (depth > wtd) and the equilibrium solution for the
          ! rest of the layer

          else if ((zwtmm(c) .lt. zimm(c,j)) .and. (zwtmm(c) .gt. zimm(c,j-1))) then
             tempi = 1.0_r8
             temp0 = (((sucsat(c,j)+zwtmm(c)-zimm(c,j-1))/sucsat(c,j)))**(1._r8-1._r8/bsw(c,j))
             voleq1 = -sucsat(c,j)*watsat(c,j)/(1._r8-1._r8/bsw(c,j))/(zwtmm(c)-zimm(c,j-1))*(tempi-temp0)
             vol_eq(c,j) = (voleq1*(zwtmm(c)-zimm(c,j-1)) + watsat(c,j)*(zimm(c,j)-zwtmm(c)))/(zimm(c,j)-zimm(c,j-1))
             vol_eq(c,j) = min(watsat(c,j),vol_eq(c,j))
             vol_eq(c,j) = max(vol_eq(c,j),0.0_r8)
          else
             tempi = (((sucsat(c,j)+zwtmm(c)-zimm(c,j))/sucsat(c,j)))**(1._r8-1._r8/bsw(c,j))
             temp0 = (((sucsat(c,j)+zwtmm(c)-zimm(c,j-1))/sucsat(c,j)))**(1._r8-1._r8/bsw(c,j))
             vol_eq(c,j) = -sucsat(c,j)*watsat(c,j)/(1._r8-1._r8/bsw(c,j))/(zimm(c,j)-zimm(c,j-1))*(tempi-temp0)
             vol_eq(c,j) = max(vol_eq(c,j),0.0_r8)
             vol_eq(c,j) = min(watsat(c,j),vol_eq(c,j))
          endif
          zq(c,j) = -sucsat(c,j)*(max(vol_eq(c,j)/watsat(c,j),0.01_r8))**(-bsw(c,j))
          zq(c,j) = max(smpmin(c), zq(c,j))
       end do
    end do

    ! If water table is below soil column calculate zq for the 11th layer
    j = nlevsoi
    do fc=1, num_hydrologyc
       c = filter_hydrologyc(fc)
       if(jwt(c) == nlevsoi) then 
          tempi = 1._r8
          temp0 = (((sucsat(c,j)+zwtmm(c)-zimm(c,j))/sucsat(c,j)))**(1._r8-1._r8/bsw(c,j))
          vol_eq(c,j+1) = -sucsat(c,j)*watsat(c,j)/(1._r8-1._r8/bsw(c,j))/(zwtmm(c)-zimm(c,j))*(tempi-temp0)
          vol_eq(c,j+1) = max(vol_eq(c,j+1),0.0_r8)
          vol_eq(c,j+1) = min(watsat(c,j),vol_eq(c,j+1))
          zq(c,j+1) = -sucsat(c,j)*(max(vol_eq(c,j+1)/watsat(c,j),0.01_r8))**(-bsw(c,j))
          zq(c,j+1) = max(smpmin(c), zq(c,j+1))
       end if
    end do

    ! Hydraulic conductivity and soil matric potential and their derivatives

    sdamp = 0._r8
    do j = 1, nlevsoi
!dir$ concurrent
!cdir nodep
       do fc = 1, num_hydrologyc
          c = filter_hydrologyc(fc)

          s1 = 0.5_r8*(h2osoi_vol(c,j) + h2osoi_vol(c,min(nlevsoi, j+1))) / &
               (0.5_r8*(watsat(c,j)+watsat(c,min(nlevsoi, j+1))))
          s1 = min(1._r8, s1)
          s2 = hksat(c,j)*s1**(2._r8*bsw(c,j)+2._r8)

          hk(c,j) = (1._r8-0.5_r8*(fracice(c,j)+fracice(c,min(nlevsoi, j+1))))*s1*s2

          dhkdw(c,j) = (1._r8-0.5_r8*(fracice(c,j)+fracice(c,min(nlevsoi, j+1))))* &
                       (2._r8*bsw(c,j)+3._r8)*s2*0.5_r8/watsat(c,j)

          s_node = max(h2osoi_vol(c,j)/watsat(c,j), 0.01_r8)
          s_node = min(1.0_r8, s_node)

          smp(c,j) = -sucsat(c,j)*s_node**(-bsw(c,j))
          smp(c,j) = max(smpmin(c), smp(c,j))

          dsmpdw(c,j) = -bsw(c,j)*smp(c,j)/(s_node*watsat(c,j))

          smp_l(c,j) = smp(c,j)
          hk_l(c,j) = hk(c,j)

       end do
    end do

    ! aquifer (11th) layer
!dir$ concurrent
!cdir nodep
    do fc = 1, num_hydrologyc
       c = filter_hydrologyc(fc)
       zmm(c,nlevsoi+1) = 0.5*(1.e3_r8*zwt(c) + zmm(c,nlevsoi))
       if(jwt(c) < nlevsoi) then
         dzmm(c,nlevsoi+1) = dzmm(c,nlevsoi)
       else
         dzmm(c,nlevsoi+1) = (1.e3_r8*zwt(c) - zmm(c,nlevsoi))
       end if
    end do

    ! Set up r, a, b, and c vectors for tridiagonal solution

    ! Node j=1 (top)

    j = 1
!dir$ concurrent
!cdir nodep
    do fc = 1, num_hydrologyc
       c = filter_hydrologyc(fc)
       qin(c,j)    = qflx_infl(c)
       den    = (zmm(c,j+1)-zmm(c,j))
       dzq    = (zq(c,j+1)-zq(c,j))
       num    = (smp(c,j+1)-smp(c,j)) - dzq
       qout(c,j)   = -hk(c,j)*num/den
       dqodw1(c,j) = -(-hk(c,j)*dsmpdw(c,j)   + num*dhkdw(c,j))/den
       dqodw2(c,j) = -( hk(c,j)*dsmpdw(c,j+1) + num*dhkdw(c,j))/den
       rmx(c,j) =  qin(c,j) - qout(c,j) - qflx_tran_veg_col(c) * rootr_col(c,j)
       amx(c,j) =  0._r8
       bmx(c,j) =  dzmm(c,j)*(sdamp+1._r8/dtime) + dqodw1(c,j)
       cmx(c,j) =  dqodw2(c,j)
    end do

    ! Nodes j=2 to j=nlevsoi-1

    do j = 2, nlevsoi - 1
!dir$ concurrent
!cdir nodep
       do fc = 1, num_hydrologyc
          c = filter_hydrologyc(fc)
          den    = (zmm(c,j) - zmm(c,j-1))
          dzq    = (zq(c,j)-zq(c,j-1))
          num    = (smp(c,j)-smp(c,j-1)) - dzq
          qin(c,j)    = -hk(c,j-1)*num/den
          dqidw0(c,j) = -(-hk(c,j-1)*dsmpdw(c,j-1) + num*dhkdw(c,j-1))/den
          dqidw1(c,j) = -( hk(c,j-1)*dsmpdw(c,j)   + num*dhkdw(c,j-1))/den
          den    = (zmm(c,j+1)-zmm(c,j))
          dzq    = (zq(c,j+1)-zq(c,j))
          num    = (smp(c,j+1)-smp(c,j)) - dzq
          qout(c,j)   = -hk(c,j)*num/den
          dqodw1(c,j) = -(-hk(c,j)*dsmpdw(c,j)   + num*dhkdw(c,j))/den
          dqodw2(c,j) = -( hk(c,j)*dsmpdw(c,j+1) + num*dhkdw(c,j))/den
          rmx(c,j)    =  qin(c,j) - qout(c,j) - qflx_tran_veg_col(c)*rootr_col(c,j)
          amx(c,j)    = -dqidw0(c,j)
          bmx(c,j)    =  dzmm(c,j)/dtime - dqidw1(c,j) + dqodw1(c,j)
          cmx(c,j)    =  dqodw2(c,j)
       end do
    end do

    ! Node j=nlevsoi (bottom)

    j = nlevsoi
!dir$ concurrent
!cdir nodep
    do fc = 1, num_hydrologyc
       c = filter_hydrologyc(fc)
       if(j > jwt(c)) then !water table is in soil column
         den    = (zmm(c,j) - zmm(c,j-1))
         dzq    = (zq(c,j)-zq(c,j-1))
         num    = (smp(c,j)-smp(c,j-1)) - dzq
         qin(c,j)    = -hk(c,j-1)*num/den
         dqidw0(c,j) = -(-hk(c,j-1)*dsmpdw(c,j-1) + num*dhkdw(c,j-1))/den
         dqidw1(c,j) = -( hk(c,j-1)*dsmpdw(c,j)   + num*dhkdw(c,j-1))/den
         qout(c,j)   =  0._r8
         dqodw1(c,j) =  0._r8
         rmx(c,j)    =  qin(c,j) - qout(c,j) - qflx_tran_veg_col(c)*rootr_col(c,j)
         amx(c,j)    = -dqidw0(c,j)
         bmx(c,j)    =  dzmm(c,j)/dtime - dqidw1(c,j) + dqodw1(c,j)
         cmx(c,j)    =  0._r8

         !scs: next set up aquifer layer; hydrologically inactive
         rmx(c,j+1) = 0._r8
         amx(c,j+1) = 0._r8
         bmx(c,j+1) = dzmm(c,j+1)/dtime
         cmx(c,j+1) = 0._r8
       else ! water table is below soil column

         !scs: compute aquifer soil moisture as average of layer 10 and saturation
         s_node = max(0.5*(1.0_r8+h2osoi_vol(c,j)/watsat(c,j)), 0.01_r8)
         s_node = min(1.0_r8, s_node)

         !scs: compute smp for aquifer layer
         smp1 = -sucsat(c,j)*s_node**(-bsw(c,j))
         smp1 = max(smpmin(c), smp1)

         !scs: compute dsmpdw for aquifer layer
         dsmpdw1 = -bsw(c,j)*smp1/(s_node*watsat(c,j))

         !scs: first set up bottom layer of soil column
         den    = (zmm(c,j) - zmm(c,j-1))
         dzq    = (zq(c,j)-zq(c,j-1))
         num    = (smp(c,j)-smp(c,j-1)) - dzq
         qin(c,j)    = -hk(c,j-1)*num/den
         dqidw0(c,j) = -(-hk(c,j-1)*dsmpdw(c,j-1) + num*dhkdw(c,j-1))/den
         dqidw1(c,j) = -( hk(c,j-1)*dsmpdw(c,j)   + num*dhkdw(c,j-1))/den
         den    = (zmm(c,j+1)-zmm(c,j))
         dzq    = (zq(c,j+1)-zq(c,j))
         num    = (smp1-smp(c,j)) - dzq
         qout(c,j)   = -hk(c,j)*num/den
         dqodw1(c,j) = -(-hk(c,j)*dsmpdw(c,j)   + num*dhkdw(c,j))/den
         dqodw2(c,j) = -( hk(c,j)*dsmpdw1 + num*dhkdw(c,j))/den

         rmx(c,j) =  qin(c,j) - qout(c,j) - qflx_tran_veg_col(c)*rootr_col(c,j)
         amx(c,j) = -dqidw0(c,j)
         bmx(c,j) =  dzmm(c,j)/dtime - dqidw1(c,j) + dqodw1(c,j)
         cmx(c,j) =  dqodw2(c,j)

         !scs: next set up aquifer layer; den/num unchanged, qin=qout
         qin(c,j+1)    = qout(c,j)
         dqidw0(c,j+1) = -(-hk(c,j)*dsmpdw(c,j) + num*dhkdw(c,j))/den
         dqidw1(c,j+1) = -( hk(c,j)*dsmpdw1   + num*dhkdw(c,j))/den
         qout(c,j+1)   =  0._r8  ! zero-flow bottom boundary condition
         dqodw1(c,j+1) =  0._r8  ! zero-flow bottom boundary condition
         rmx(c,j+1) =  qin(c,j+1) - qout(c,j+1)
         amx(c,j+1) = -dqidw0(c,j+1)
         bmx(c,j+1) =  dzmm(c,j+1)/dtime - dqidw1(c,j+1) + dqodw1(c,j+1)
         cmx(c,j+1) =  0._r8
       endif
    end do

    ! Solve for dwat

    jtop(:) = 1
    call Tridiagonal(lbc, ubc, 1, nlevsoi+1, jtop, num_hydrologyc, filter_hydrologyc, &
                     amx, bmx, cmx, rmx, dwat2 )
    !scs: set dwat
    do fc = 1,num_hydrologyc
       c = filter_hydrologyc(fc)
       do j = 1, nlevsoi
          dwat(c,j)=dwat2(c,j)
       end do
    end do

    ! Renew the mass of liquid water
    !scs: also compute qcharge from dwat in aquifer layer
    !scs: update in drainage for case jwt < nlevsoi

!dir$ concurrent
!cdir nodep
    do fc = 1,num_hydrologyc
       c = filter_hydrologyc(fc)
       do j = 1, nlevsoi
          h2osoi_liq(c,j) = h2osoi_liq(c,j) + dwat2(c,j)*dzmm(c,j)
       end do

       !scs: calculate qcharge for case jwt < nlevsoi
       if(jwt(c) < nlevsoi) then
          wh_zwt = 0._r8   !since wh_zwt = -sucsat - zq_zwt, where zq_zwt = -sucsat

          s_node = max(h2osoi_vol(c,jwt(c))/watsat(c,jwt(c)), 0.01_r8)
          s_node = min(1.0_r8, s_node)

          !scs: use average moisture between water table and layer jwt
          s1 = 0.5_r8*(1.0+s_node)
          s1 = min(1._r8, s1)

          !scs: this is the expression for unsaturated hk
          ka = hksat(c,jwt(c))*s1**(2._r8*bsw(c,jwt(c))+3._r8)

          ! Recharge rate qcharge to groundwater (positive to aquifer)
          smp1 = -sucsat(c,jwt(c))*s_node**(-bsw(c,jwt(c)))
          smp1 = max(smpmin(c), smp(c,jwt(c)))
          wh      = smp1 - zq(c,jwt(c))
          qcharge(c) = -ka * (wh_zwt-wh)  /((zwt(c)-z(c,jwt(c)))*1000._r8)

          ! To limit qcharge  (for the first several timesteps)
          qcharge(c) = max(-10.0_r8/dtime,qcharge(c))
          qcharge(c) = min( 10.0_r8/dtime,qcharge(c))
       else
          !scs: if water table is below soil column, compute qcharge from dwat2(11)
          qcharge(c) = dwat2(c,nlevsoi+1)*dzmm(c,nlevsoi+1)/dtime
       endif
    end do

  end subroutine SoilWater

!-----------------------------------------------------------------------
!BOP
!
! !IROUTINE: Drainage
!
! !INTERFACE:
  subroutine Drainage(lbc, ubc, num_hydrologyc, filter_hydrologyc, &
                      num_urbanc, filter_urbanc, vol_liq, hk, &
                      icefrac)
!
! !DESCRIPTION:
! Calculate subsurface drainage
!
! !USES:
    use shr_kind_mod, only : r8 => shr_kind_r8
    use clmtype
    use clm_varcon  , only : pondmx, tfrz, icol_roof, icol_road_imperv, icol_road_perv, watmin
    use clm_varpar  , only : nlevsoi
    use globals     , only : dtime
!
! !ARGUMENTS:
    implicit none
    integer , intent(in) :: lbc, ubc                     ! column bounds
    integer , intent(in) :: num_hydrologyc               ! number of column soil points in column filter
    integer , intent(in) :: num_urbanc                   ! number of column urban points in column filter
    integer , intent(in) :: filter_urbanc(ubc-lbc+1)     ! column filter for urban points
    integer , intent(in) :: filter_hydrologyc(ubc-lbc+1) ! column filter for soil points
    real(r8), intent(in) :: vol_liq(lbc:ubc,1:nlevsoi)   ! partial volume of liquid water in layer
    real(r8), intent(in) :: hk(lbc:ubc,1:nlevsoi)        ! hydraulic conductivity (mm h2o/s)
    real(r8), intent(in) :: icefrac(lbc:ubc,1:nlevsoi)   ! fraction of ice in layer
!
! !CALLED FROM:
!
! !REVISION HISTORY:
! 15 September 1999: Yongjiu Dai; Initial code
! 12 November 1999:  Z.-L. Yang and G.-Y. Niu
! 15 December 1999:  Paul Houser and Jon Radakovich; F90 Revision
! 4/26/05, Peter Thornton and David Lawrence: Turned off drainage from
! middle soil layers for both wet and dry fractions.
! 04/25/07  Keith Oleson: Completely new routine for CLM3.5 hydrology
! 27 February 2008: Keith Oleson; Saturation excess modification
!
! !LOCAL VARIABLES:
!
! local pointers to original implicit in arguments
!
    integer , pointer :: ctype(:)          !column type index
    integer , pointer :: snl(:)            !number of snow layers
    real(r8), pointer :: qflx_snwcp_liq(:) !excess rainfall due to snow capping (mm H2O /s) [+]
    real(r8), pointer :: qflx_dew_grnd(:)  !ground surface dew formation (mm H2O /s) [+]
    real(r8), pointer :: qflx_dew_snow(:)  !surface dew added to snow pack (mm H2O /s) [+]
    real(r8), pointer :: qflx_sub_snow(:)  !sublimation rate from snow pack (mm H2O /s) [+]
    real(r8), pointer :: dz(:,:)           !layer depth (m)
    real(r8), pointer :: bsw(:,:)          !Clapp and Hornberger "b"
    real(r8), pointer :: eff_porosity(:,:) !effective porosity = porosity - vol_ice
    real(r8), pointer :: t_soisno(:,:)     !soil temperature (Kelvin)
    real(r8), pointer :: hksat(:,:)        !hydraulic conductivity at saturation (mm H2O /s)
    real(r8), pointer :: sucsat(:,:)       !minimum soil suction (mm)
    real(r8), pointer :: z(:,:)            !layer depth (m)
    real(r8), pointer :: zi(:,:)           !interface level below a "z" level (m)
    real(r8), pointer :: watsat(:,:)       !volumetric soil water at saturation (porosity)
    real(r8), pointer :: hkdepth(:)        !decay factor (m)
    real(r8), pointer :: zwt(:)            !water table depth (m)
    real(r8), pointer :: wa(:)             !water in the unconfined aquifer (mm)
    real(r8), pointer :: wt(:)             !total water storage (unsaturated soil water + groundwater) (mm)
    real(r8), pointer :: qcharge(:)        !aquifer recharge rate (mm/s)
!
! local pointers to original implicit inout arguments
!
    real(r8), pointer :: h2osoi_ice(:,:)   !ice lens (kg/m2)
    real(r8), pointer :: h2osoi_liq(:,:)   !liquid water (kg/m2)
!
! local pointers to original implicit out arguments
!
    real(r8), pointer :: qflx_drain(:)     !sub-surface runoff (mm H2O /s)
    real(r8), pointer :: qflx_qrgwl(:)     !qflx_surf at glaciers, wetlands, lakes (mm H2O /s)
    real(r8), pointer :: eflx_impsoil(:)   !implicit evaporation for soil temperature equation
    real(r8), pointer :: qflx_rsub_sat(:)  !soil saturation excess [mm h2o/s]
!
!EOP
!
! !OTHER LOCAL VARIABLES:
!
!KO    integer  :: c,j,fc                   !indices
!KO
    integer  :: c,j,fc,i                 !indices
!KO
    real(r8) :: xs(lbc:ubc)              !water needed to bring soil moisture to watmin (mm)
    real(r8) :: dzmm(lbc:ubc,1:nlevsoi)  !layer thickness (mm)
    integer  :: jwt(lbc:ubc)             !index of the soil layer right above the water table (-)
    real(r8) :: rsub_bot(lbc:ubc)        !subsurface runoff - bottom drainage (mm/s)
    real(r8) :: rsub_top(lbc:ubc)        !subsurface runoff - topographic control (mm/s)
    real(r8) :: fff(lbc:ubc)             !decay factor (m-1)
    real(r8) :: xsi(lbc:ubc)             !excess soil water above saturation at layer i (mm)
    real(r8) :: xsia(lbc:ubc)            !available pore space at layer i (mm)
    real(r8) :: xs1(lbc:ubc)             !excess soil water above saturation at layer 1 (mm)
    real(r8) :: smpfz(1:nlevsoi)         !matric potential of layer right above water table (mm)
    real(r8) :: wtsub                    !summation of hk*dzmm for layers below water table (mm**2/s)
    real(r8) :: rous                     !aquifer yield (-)
    real(r8) :: wh                       !smpfz(jwt)-z(jwt) (mm)
    real(r8) :: wh_zwt                   !water head at the water table depth (mm)
    real(r8) :: ws                       !summation of pore space of layers below water table (mm)
    real(r8) :: s_node                   !soil wetness (-)
    real(r8) :: dzsum                    !summation of dzmm of layers below water table (mm)
    real(r8) :: icefracsum               !summation of icefrac*dzmm of layers below water table (-)
    real(r8) :: fracice_rsub(lbc:ubc)    !fractional impermeability of soil layers (-)
    real(r8) :: ka                       !hydraulic conductivity of the aquifer (mm/s)
    real(r8) :: dza                      !fff*(zwt-z(jwt)) (-)
!KO
    real(r8) :: available_h2osoi_liq     !available soil liquid water in a layer
!KO
!-----------------------------------------------------------------------

    ! Assign local pointers to derived subtypes components (column-level)

    ctype          => clm3%g%l%c%itype
!   cgridcell      => clm3%g%l%c%gridcell

    snl           => clm3%g%l%c%cps%snl
    dz            => clm3%g%l%c%cps%dz
    bsw           => clm3%g%l%c%cps%bsw
    t_soisno      => clm3%g%l%c%ces%t_soisno
    hksat         => clm3%g%l%c%cps%hksat
    sucsat        => clm3%g%l%c%cps%sucsat
    z             => clm3%g%l%c%cps%z
    zi            => clm3%g%l%c%cps%zi
    watsat        => clm3%g%l%c%cps%watsat
    hkdepth       => clm3%g%l%c%cps%hkdepth
    zwt           => clm3%g%l%c%cws%zwt
    wa            => clm3%g%l%c%cws%wa
    wt            => clm3%g%l%c%cws%wt
    qcharge       => clm3%g%l%c%cws%qcharge
    eff_porosity  => clm3%g%l%c%cps%eff_porosity
    qflx_snwcp_liq => clm3%g%l%c%cwf%pwf_a%qflx_snwcp_liq
    qflx_dew_grnd => clm3%g%l%c%cwf%pwf_a%qflx_dew_grnd
    qflx_dew_snow => clm3%g%l%c%cwf%pwf_a%qflx_dew_snow
    qflx_sub_snow => clm3%g%l%c%cwf%pwf_a%qflx_sub_snow
    qflx_drain    => clm3%g%l%c%cwf%qflx_drain
    qflx_qrgwl    => clm3%g%l%c%cwf%qflx_qrgwl
    qflx_rsub_sat => clm3%g%l%c%cwf%qflx_rsub_sat
    eflx_impsoil  => clm3%g%l%c%cef%eflx_impsoil
    h2osoi_liq    => clm3%g%l%c%cws%h2osoi_liq
    h2osoi_ice    => clm3%g%l%c%cws%h2osoi_ice


    ! Convert layer thicknesses from m to mm

    do j = 1,nlevsoi
!dir$ concurrent
!cdir nodep
       do fc = 1, num_hydrologyc
          c = filter_hydrologyc(fc)
          dzmm(c,j) = dz(c,j)*1.e3_r8
       end do
    end do

    ! Initial set

!dir$ concurrent
!cdir nodep
    do fc = 1, num_hydrologyc
       c = filter_hydrologyc(fc)
       qflx_drain(c)    = 0._r8 
       rsub_bot(c)      = 0._r8
       qflx_rsub_sat(c) = 0._r8
       rsub_top(c)      = 0._r8
       fracice_rsub(c)  = 0._r8
    end do

    ! The layer index of the first unsaturated layer, i.e., the layer right above
    ! the water table

!dir$ concurrent
!cdir nodep
    do fc = 1, num_hydrologyc
       c = filter_hydrologyc(fc)
       jwt(c) = nlevsoi
       do j = 2,nlevsoi
          if(zwt(c) <= zi(c,j)) then
             jwt(c) = j-1
             exit
          end if
       enddo
    end do

    ! Topographic runoff
!dir$ concurrent
!cdir nodep
    do fc = 1, num_hydrologyc
       c = filter_hydrologyc(fc)
       fff(c)         = 1._r8/ hkdepth(c)
       dzsum = 0._r8
       icefracsum = 0._r8
       do j = jwt(c), nlevsoi
          dzsum  = dzsum + dzmm(c,j)
          icefracsum = icefracsum + icefrac(c,j) * dzmm(c,j)
       end do
       fracice_rsub(c) = max(0._r8,exp(-3._r8*(1._r8-(icefracsum/dzsum)))- exp(-3._r8))/(1.0_r8-exp(-3._r8))
       rsub_top(c)    = (1._r8 - fracice_rsub(c)) * 5.5e-3_r8 * exp(-fff(c)*zwt(c))
    end do

    rous = 0.2_r8

    ! Water table calculation

!dir$ concurrent
!cdir nodep
    do fc = 1, num_hydrologyc
       c = filter_hydrologyc(fc)

       ! Water storage in aquifer + soil
       wt(c)  = wt(c) + (qcharge(c) - rsub_top(c)) * dtime

       if(jwt(c) == nlevsoi) then             ! water table is below the soil column
          wa(c)  = wa(c) + (qcharge(c) -rsub_top(c)) * dtime
          wt(c)  = wa(c)
          zwt(c)     = (zi(c,nlevsoi) + 25._r8) - wa(c)/1000._r8/rous
          h2osoi_liq(c,nlevsoi) = h2osoi_liq(c,nlevsoi) + max(0._r8,(wa(c)-5000._r8))
          wa(c)  = min(wa(c), 5000._r8)
       else                                ! water table within soil layers
          if (jwt(c) == nlevsoi-1) then       ! water table within bottom soil layer

             zwt(c) = zi(c,nlevsoi)- (wt(c)-rous*1000._r8*25._r8) /eff_porosity(c,nlevsoi)/1000._r8

          else                                   ! water table within soil layers 1-9
             ws = 0._r8   ! water used to fill soil air pores regardless of water content
             do j = jwt(c)+2,nlevsoi
               ws = ws + eff_porosity(c,j) * 1000._r8 * dz(c,j)
             enddo
             zwt(c) = zi(c,jwt(c)+1)-(wt(c)-rous*1000_r8*25._r8-ws) /eff_porosity(c,jwt(c)+1)/1000._r8
          endif

          wtsub = 0._r8
          do j = jwt(c)+1, nlevsoi
             wtsub = wtsub + hk(c,j)*dzmm(c,j)
          end do

          ! Remove subsurface runoff
          do j = jwt(c)+1, nlevsoi 
             h2osoi_liq(c,j) = h2osoi_liq(c,j) - rsub_top(c)*dtime*hk(c,j)*dzmm(c,j)/wtsub
          end do
       end if

       zwt(c) = max(0.05_r8,zwt(c))
       zwt(c) = min(80._r8,zwt(c))

    end do

    !  excessive water above saturation added to the above unsaturated layer like a bucket
    !  if column fully saturated, excess water goes to runoff

    do j = nlevsoi,2,-1
!dir$ concurrent
!cdir nodep
       do fc = 1, num_hydrologyc
          c = filter_hydrologyc(fc)
          xsi(c)            = max(h2osoi_liq(c,j)-eff_porosity(c,j)*dzmm(c,j),0._r8)
          h2osoi_liq(c,j)   = min(eff_porosity(c,j)*dzmm(c,j), h2osoi_liq(c,j))
          h2osoi_liq(c,j-1) = h2osoi_liq(c,j-1) + xsi(c)
       end do
    end do

!dir$ concurrent
!cdir nodep
    do fc = 1, num_hydrologyc
       c = filter_hydrologyc(fc)
       xs1(c)          = max(max(h2osoi_liq(c,1),0._r8)-max(0._r8,(pondmx+watsat(c,1)*dzmm(c,1)-h2osoi_ice(c,1))),0._r8)
       h2osoi_liq(c,1) = min(max(0._r8,pondmx+watsat(c,1)*dzmm(c,1)-h2osoi_ice(c,1)), h2osoi_liq(c,1))
       qflx_rsub_sat(c)     = xs1(c) / dtime
    end do

    ! Limit h2osoi_liq to be greater than or equal to watmin.
    ! Get water needed to bring h2osoi_liq equal watmin from lower layer.
    ! If insufficient water in soil layers, get from aquifer water

    do j = 1, nlevsoi-1
!dir$ concurrent
!cdir nodep
       do fc = 1, num_hydrologyc
          c = filter_hydrologyc(fc)
!KO          if (h2osoi_liq(c,j) < 0._r8) then
!KO
          if (h2osoi_liq(c,j) < watmin) then
!KO
             xs(c) = watmin - h2osoi_liq(c,j)
          else
             xs(c) = 0._r8
          end if
          h2osoi_liq(c,j  ) = h2osoi_liq(c,j  ) + xs(c)
          h2osoi_liq(c,j+1) = h2osoi_liq(c,j+1) - xs(c)
       end do
    end do

!KO    j = nlevsoi
!KO!dir$ concurrent
!KO!cdir nodep
!KO    do fc = 1, num_hydrologyc
!KO       c = filter_hydrologyc(fc)
!KO       if (h2osoi_liq(c,j) < watmin) then
!KO          xs(c) = watmin-h2osoi_liq(c,j)
!KO       else
!KO          xs(c) = 0._r8
!KO       end if
!KO       h2osoi_liq(c,j) = h2osoi_liq(c,j) + xs(c)
!KO       wa(c) = wa(c) - xs(c)
!KO       wt(c) = wt(c) - xs(c)
!KO    end do

!KO
! Get water for bottom layer from layers above if possible
    j = nlevsoi
!dir$ concurrent
!cdir nodep
    do fc = 1, num_hydrologyc
       c = filter_hydrologyc(fc)
       if (h2osoi_liq(c,j) < watmin) then
          xs(c) = watmin-h2osoi_liq(c,j)
          searchforwater: do i = nlevsoi-1, 1, -1
             available_h2osoi_liq = max(h2osoi_liq(c,i)-watmin-xs(c),0._r8)
             if (available_h2osoi_liq .ge. xs(c)) then
               h2osoi_liq(c,j) = h2osoi_liq(c,j) + xs(c)
               h2osoi_liq(c,i) = h2osoi_liq(c,i) - xs(c)
               xs(c) = 0._r8
               exit searchforwater
             else
               h2osoi_liq(c,j) = h2osoi_liq(c,j) + available_h2osoi_liq
               h2osoi_liq(c,i) = h2osoi_liq(c,i) - available_h2osoi_liq
               xs(c) = xs(c) - available_h2osoi_liq
             end if
          end do searchforwater
       else
          xs(c) = 0._r8
       end if
! Needed in case there is no water to be found
       h2osoi_liq(c,j) = h2osoi_liq(c,j) + xs(c)
       wt(c) = wt(c) - xs(c)
! Instead of removing water from aquifer where it eventually
! shows up as excess drainage to the ocean, take it back out of 
! drainage
       rsub_top(c) = rsub_top(c) - xs(c)/dtime
    end do
!KO

!dir$ concurrent
!cdir nodep
    do fc = 1, num_hydrologyc
       c = filter_hydrologyc(fc)

       ! Sub-surface runoff and drainage

       qflx_drain(c) = qflx_rsub_sat(c) + rsub_top(c)

       ! Set imbalance for snow capping

       qflx_qrgwl(c) = qflx_snwcp_liq(c)

       ! Implicit evaporation term is now zero

       eflx_impsoil(c) = 0._r8

       ! Renew the ice and liquid mass due to condensation

       if (snl(c)+1 >= 1) then
          h2osoi_liq(c,1) = h2osoi_liq(c,1) + qflx_dew_grnd(c) * dtime
          h2osoi_ice(c,1) = h2osoi_ice(c,1) + (qflx_dew_snow(c) * dtime)
          if (qflx_sub_snow(c)*dtime > h2osoi_ice(c,1)) then
             qflx_sub_snow(c) = h2osoi_ice(c,1)/dtime
             h2osoi_ice(c,1) = 0._r8
          else
             h2osoi_ice(c,1) = h2osoi_ice(c,1) - (qflx_sub_snow(c) * dtime)
          end if
       end if
    end do

    ! No drainage for urban columns (except for pervious road as computed above)

!dir$ concurrent
!cdir nodep
    do fc = 1, num_urbanc
       c = filter_urbanc(fc)
       if (ctype(c) /= icol_road_perv) then
         qflx_drain(c) = 0._r8
         ! This must be done for roofs and impervious road (walls will be zero)
         qflx_qrgwl(c) = qflx_snwcp_liq(c)
         eflx_impsoil(c) = 0._r8
       end if

       ! Renew the ice and liquid mass due to condensation for urban roof and impervious road

       if (ctype(c) == icol_roof .or. ctype(c) == icol_road_imperv) then
         if (snl(c)+1 >= 1) then
            h2osoi_liq(c,1) = h2osoi_liq(c,1) + qflx_dew_grnd(c) * dtime
            h2osoi_ice(c,1) = h2osoi_ice(c,1) + (qflx_dew_snow(c) * dtime)
            if (qflx_sub_snow(c)*dtime > h2osoi_ice(c,1)) then
               qflx_sub_snow(c) = h2osoi_ice(c,1)/dtime
               h2osoi_ice(c,1) = 0._r8
            else
               h2osoi_ice(c,1) = h2osoi_ice(c,1) - (qflx_sub_snow(c) * dtime)
            end if
         end if
       end if

    end do


  end subroutine Drainage

end module SoilHydrologyMod

module SnowHydrologyMod

!-----------------------------------------------------------------------
!BOP
!
! !MODULE: SnowHydrologyMod
!
! !DESCRIPTION:
! Calculate snow hydrology.
!
! !USES:
  use shr_kind_mod, only: r8 => shr_kind_r8
  use clm_varpar  , only : nlevsno
!
! !PUBLIC TYPES:
  implicit none
  save
!
! !PUBLIC MEMBER FUNCTIONS:
  public :: SnowWater         ! Change of snow mass and the snow water onto soil
  public :: SnowCompaction    ! Change in snow layer thickness due to compaction
  public :: CombineSnowLayers ! Combine snow layers less than a min thickness
  public :: DivideSnowLayers  ! Subdivide snow layers if they exceed maximum thickness
  public :: BuildSnowFilter   ! Construct snow/no-snow filters
!
! !PRIVATE MEMBER FUNCTIONS:
  private :: Combo            ! Returns the combined variables: dz, t, wliq, wice.
!
! !REVISION HISTORY:
! Created by Mariana Vertenstein
!
!EOP
!-----------------------------------------------------------------------

contains

!-----------------------------------------------------------------------
!BOP
!
! !IROUTINE: SnowWater
!
! !INTERFACE:
  subroutine SnowWater(lbc, ubc, num_snowc, filter_snowc, &
                       num_nosnowc, filter_nosnowc)
!
! !DESCRIPTION:
! Evaluate the change of snow mass and the snow water onto soil.
! Water flow within snow is computed by an explicit and non-physical
! based scheme, which permits a part of liquid water over the holding
! capacity (a tentative value is used, i.e. equal to 0.033*porosity) to
! percolate into the underlying layer.  Except for cases where the
! porosity of one of the two neighboring layers is less than 0.05, zero
! flow is assumed. The water flow out of the bottom of the snow pack will
! participate as the input of the soil water and runoff.  This subroutine
! uses a filter for columns containing snow which must be constructed prior
! to being called.
!
! !USES:
    use clmtype
    use clm_varcon  , only : denh2o, denice, wimp, ssi
    use SNICARMod         , only : scvng_fct_mlt_bcphi, scvng_fct_mlt_bcpho, &
                                   scvng_fct_mlt_ocphi, scvng_fct_mlt_ocpho, &
                                   scvng_fct_mlt_dst1,  scvng_fct_mlt_dst2,  &
                                   scvng_fct_mlt_dst3,  scvng_fct_mlt_dst4
    use globals    , only : dtime
!
! !ARGUMENTS:
    implicit none
    integer, intent(in) :: lbc, ubc                    ! column bounds
    integer, intent(in) :: num_snowc                   ! number of snow points in column filter
    integer, intent(in) :: filter_snowc(ubc-lbc+1)     ! column filter for snow points
    integer, intent(in) :: num_nosnowc                 ! number of non-snow points in column filter
    integer, intent(in) :: filter_nosnowc(ubc-lbc+1)   ! column filter for non-snow points
!
! !CALLED FROM:
!
! !REVISION HISTORY:
! 15 September 1999: Yongjiu Dai; Initial code
! 15 December 1999:  Paul Houser and Jon Radakovich; F90 Revision
! 15 November 2000: Mariana Vertenstein
! 2/26/02, Peter Thornton: Migrated to new data structures.
! 03/28/08, Mark Flanner: Added aerosol deposition and flushing with meltwater
!
! !LOCAL VARIABLES:
!
! local pointers to implicit in arguments
!
    integer , pointer :: snl(:)              !number of snow layers
    logical , pointer :: do_capsnow(:)       !true => do snow capping
    real(r8), pointer :: qflx_snomelt(:)     !snow melt (mm H2O /s)
    real(r8), pointer :: qflx_rain_grnd(:)   !rain on ground after interception (mm H2O/s) [+]
    real(r8), pointer :: qflx_sub_snow(:)    !sublimation rate from snow pack (mm H2O /s) [+]
    real(r8), pointer :: qflx_evap_grnd(:)   !ground surface evaporation rate (mm H2O/s) [+]
    real(r8), pointer :: qflx_dew_snow(:)    !surface dew added to snow pack (mm H2O /s) [+]
    real(r8), pointer :: qflx_dew_grnd(:)    !ground surface dew formation (mm H2O /s) [+]
    real(r8), pointer :: dz(:,:)             !layer depth (m)
!
! local pointers to implicit out arguments
!
    real(r8), pointer :: qflx_top_soil(:)     !net water input into soil from top (mm/s)
!
! local pointers to implicit inout arguments
!
    real(r8), pointer :: h2osoi_ice(:,:)     !ice lens (kg/m2)
    real(r8), pointer :: h2osoi_liq(:,:)     !liquid water (kg/m2)
    integer , pointer :: cgridcell(:)        ! columns's gridcell (col) 
    real(r8), pointer :: mss_bcphi(:,:)      ! hydrophillic BC mass in snow (col,lyr) [kg]
    real(r8), pointer :: mss_bcpho(:,:)      ! hydrophobic BC mass in snow (col,lyr) [kg]
    real(r8), pointer :: mss_ocphi(:,:)      ! hydrophillic OC mass in snow (col,lyr) [kg]
    real(r8), pointer :: mss_ocpho(:,:)      ! hydrophobic OC mass in snow (col,lyr) [kg]
    real(r8), pointer :: mss_dst1(:,:)       ! mass of dust species 1 in snow (col,lyr) [kg]
    real(r8), pointer :: mss_dst2(:,:)       ! mass of dust species 2 in snow (col,lyr) [kg]
    real(r8), pointer :: mss_dst3(:,:)       ! mass of dust species 3 in snow (col,lyr) [kg]
    real(r8), pointer :: mss_dst4(:,:)       ! mass of dust species 4 in snow (col,lyr) [kg]
    real(r8), pointer :: flx_bc_dep_dry(:)   ! dry BC deposition (col) [kg m-2 s-1]
    real(r8), pointer :: flx_bc_dep_wet(:)   ! wet BC deposition (col) [kg m-2 s-1]
    real(r8), pointer :: flx_bc_dep(:)       ! total BC deposition (col) [kg m-2 s-1]
    real(r8), pointer :: flx_bc_dep_pho(:)   ! hydrophobic BC deposition (col) [kg m-1 s-1]
    real(r8), pointer :: flx_bc_dep_phi(:)   ! hydrophillic BC deposition (col) [kg m-1 s-1]
    real(r8), pointer :: flx_oc_dep_dry(:)   ! dry OC deposition (col) [kg m-2 s-1]
    real(r8), pointer :: flx_oc_dep_wet(:)   ! wet OC deposition (col) [kg m-2 s-1]
    real(r8), pointer :: flx_oc_dep(:)       ! total OC deposition (col) [kg m-2 s-1]
    real(r8), pointer :: flx_oc_dep_pho(:)   ! hydrophobic OC deposition (col) [kg m-1 s-1]
    real(r8), pointer :: flx_oc_dep_phi(:)   ! hydrophillic OC deposition (col) [kg m-1 s-1]
    real(r8), pointer :: flx_dst_dep_dry1(:) ! dry dust (species 1) deposition (col) [kg m-2 s-1]
    real(r8), pointer :: flx_dst_dep_wet1(:) ! wet dust (species 1) deposition (col) [kg m-2 s-1]
    real(r8), pointer :: flx_dst_dep_dry2(:) ! dry dust (species 2) deposition (col) [kg m-2 s-1]
    real(r8), pointer :: flx_dst_dep_wet2(:) ! wet dust (species 2) deposition (col) [kg m-2 s-1]
    real(r8), pointer :: flx_dst_dep_dry3(:) ! dry dust (species 3) deposition (col) [kg m-2 s-1]
    real(r8), pointer :: flx_dst_dep_wet3(:) ! wet dust (species 3) deposition (col) [kg m-2 s-1]
    real(r8), pointer :: flx_dst_dep_dry4(:) ! dry dust (species 4) deposition (col) [kg m-2 s-1]
    real(r8), pointer :: flx_dst_dep_wet4(:) ! wet dust (species 4) deposition (col) [kg m-2 s-1]
    real(r8), pointer :: flx_dst_dep(:)      ! total dust deposition (col) [kg m-2 s-1]
    real(r8), pointer :: forc_aer(:,:)       ! aerosol deposition from atmosphere model (grd,aer) [kg m-1 s-1]

!
!
! !OTHER LOCAL VARIABLES:
!EOP
!
    integer  :: c, j, fc                           !do loop/array indices
    real(r8) :: qin(lbc:ubc)                       !water flow into the elmement (mm/s) 
    real(r8) :: qout(lbc:ubc)                      !water flow out of the elmement (mm/s)
    real(r8) :: wgdif                              !ice mass after minus sublimation
    real(r8) :: vol_liq(lbc:ubc,-nlevsno+1:0)      !partial volume of liquid water in layer
    real(r8) :: vol_ice(lbc:ubc,-nlevsno+1:0)      !partial volume of ice lens in layer
    real(r8) :: eff_porosity(lbc:ubc,-nlevsno+1:0) !effective porosity = porosity - vol_ice
    integer  :: g                                 ! gridcell loop index
    real(r8) :: qin_bc_phi(lbc:ubc)               ! flux of hydrophilic BC into layer [kg]
    real(r8) :: qout_bc_phi(lbc:ubc)              ! flux of hydrophilic BC out of layer [kg]
    real(r8) :: qin_bc_pho(lbc:ubc)               ! flux of hydrophobic BC into layer [kg]
    real(r8) :: qout_bc_pho(lbc:ubc)              ! flux of hydrophobic BC out of layer [kg]
    real(r8) :: qin_oc_phi(lbc:ubc)               ! flux of hydrophilic OC into layer [kg]
    real(r8) :: qout_oc_phi(lbc:ubc)              ! flux of hydrophilic OC out of layer [kg]
    real(r8) :: qin_oc_pho(lbc:ubc)               ! flux of hydrophobic OC into layer [kg]
    real(r8) :: qout_oc_pho(lbc:ubc)              ! flux of hydrophobic OC out of layer [kg]
    real(r8) :: qin_dst1(lbc:ubc)                 ! flux of dust species 1 into layer [kg]
    real(r8) :: qout_dst1(lbc:ubc)                ! flux of dust species 1 out of layer [kg]
    real(r8) :: qin_dst2(lbc:ubc)                 ! flux of dust species 2 into layer [kg]
    real(r8) :: qout_dst2(lbc:ubc)                ! flux of dust species 2 out of layer [kg]
    real(r8) :: qin_dst3(lbc:ubc)                 ! flux of dust species 3 into layer [kg]
    real(r8) :: qout_dst3(lbc:ubc)                ! flux of dust species 3 out of layer [kg]
    real(r8) :: qin_dst4(lbc:ubc)                 ! flux of dust species 4 into layer [kg]
    real(r8) :: qout_dst4(lbc:ubc)                ! flux of dust species 4 out of layer [kg]
    real(r8) :: mss_liqice                        ! mass of liquid+ice in a layer
 
!-----------------------------------------------------------------------

    ! Assign local pointers to derived subtype components (column-level)

    snl              => clm3%g%l%c%cps%snl
    do_capsnow       => clm3%g%l%c%cps%do_capsnow
    qflx_snomelt     => clm3%g%l%c%cwf%qflx_snomelt
    qflx_rain_grnd   => clm3%g%l%c%cwf%pwf_a%qflx_rain_grnd
    qflx_sub_snow    => clm3%g%l%c%cwf%pwf_a%qflx_sub_snow
    qflx_evap_grnd   => clm3%g%l%c%cwf%pwf_a%qflx_evap_grnd
    qflx_dew_snow    => clm3%g%l%c%cwf%pwf_a%qflx_dew_snow
    qflx_dew_grnd    => clm3%g%l%c%cwf%pwf_a%qflx_dew_grnd
    qflx_top_soil    => clm3%g%l%c%cwf%qflx_top_soil
    dz               => clm3%g%l%c%cps%dz
    h2osoi_ice       => clm3%g%l%c%cws%h2osoi_ice
    h2osoi_liq       => clm3%g%l%c%cws%h2osoi_liq
    cgridcell        => clm3%g%l%c%gridcell
    mss_bcphi        => clm3%g%l%c%cps%mss_bcphi
    mss_bcpho        => clm3%g%l%c%cps%mss_bcpho
    mss_ocphi        => clm3%g%l%c%cps%mss_ocphi
    mss_ocpho        => clm3%g%l%c%cps%mss_ocpho
    mss_dst1         => clm3%g%l%c%cps%mss_dst1
    mss_dst2         => clm3%g%l%c%cps%mss_dst2
    mss_dst3         => clm3%g%l%c%cps%mss_dst3
    mss_dst4         => clm3%g%l%c%cps%mss_dst4
    flx_bc_dep       => clm3%g%l%c%cwf%flx_bc_dep
    flx_bc_dep_wet   => clm3%g%l%c%cwf%flx_bc_dep_wet
    flx_bc_dep_dry   => clm3%g%l%c%cwf%flx_bc_dep_dry
    flx_bc_dep_phi   => clm3%g%l%c%cwf%flx_bc_dep_phi
    flx_bc_dep_pho   => clm3%g%l%c%cwf%flx_bc_dep_pho
    flx_oc_dep       => clm3%g%l%c%cwf%flx_oc_dep
    flx_oc_dep_wet   => clm3%g%l%c%cwf%flx_oc_dep_wet
    flx_oc_dep_dry   => clm3%g%l%c%cwf%flx_oc_dep_dry
    flx_oc_dep_phi   => clm3%g%l%c%cwf%flx_oc_dep_phi
    flx_oc_dep_pho   => clm3%g%l%c%cwf%flx_oc_dep_pho
    flx_dst_dep      => clm3%g%l%c%cwf%flx_dst_dep
    flx_dst_dep_wet1 => clm3%g%l%c%cwf%flx_dst_dep_wet1
    flx_dst_dep_dry1 => clm3%g%l%c%cwf%flx_dst_dep_dry1
    flx_dst_dep_wet2 => clm3%g%l%c%cwf%flx_dst_dep_wet2
    flx_dst_dep_dry2 => clm3%g%l%c%cwf%flx_dst_dep_dry2
    flx_dst_dep_wet3 => clm3%g%l%c%cwf%flx_dst_dep_wet3
    flx_dst_dep_dry3 => clm3%g%l%c%cwf%flx_dst_dep_dry3
    flx_dst_dep_wet4 => clm3%g%l%c%cwf%flx_dst_dep_wet4
    flx_dst_dep_dry4 => clm3%g%l%c%cwf%flx_dst_dep_dry4
    forc_aer         => clm_a2l%forc_aer


    ! Renew the mass of ice lens (h2osoi_ice) and liquid (h2osoi_liq) in the
    ! surface snow layer resulting from sublimation (frost) / evaporation (condense)

!dir$ concurrent
!cdir nodep
    do fc = 1,num_snowc
       c = filter_snowc(fc)
       if (do_capsnow(c)) then
          wgdif = h2osoi_ice(c,snl(c)+1) - qflx_sub_snow(c)*dtime
          h2osoi_ice(c,snl(c)+1) = wgdif

          if (wgdif < 0._r8) then
             h2osoi_ice(c,snl(c)+1) = 0._r8
             h2osoi_liq(c,snl(c)+1) = h2osoi_liq(c,snl(c)+1) + wgdif
          end if
          h2osoi_liq(c,snl(c)+1) = h2osoi_liq(c,snl(c)+1) - qflx_evap_grnd(c) * dtime
       else
          wgdif = h2osoi_ice(c,snl(c)+1) + (qflx_dew_snow(c) - qflx_sub_snow(c)) * dtime
          h2osoi_ice(c,snl(c)+1) = wgdif
          if (wgdif < 0._r8) then
             h2osoi_ice(c,snl(c)+1) = 0._r8
             h2osoi_liq(c,snl(c)+1) = h2osoi_liq(c,snl(c)+1) + wgdif

          end if
          h2osoi_liq(c,snl(c)+1) = h2osoi_liq(c,snl(c)+1) +  &
               (qflx_rain_grnd(c) + qflx_dew_grnd(c) - qflx_evap_grnd(c)) * dtime

       end if
       h2osoi_liq(c,snl(c)+1) = max(0._r8, h2osoi_liq(c,snl(c)+1))

    end do

    ! Porosity and partial volume

    do j = -nlevsno+1, 0
!dir$ concurrent
!cdir nodep
       do fc = 1, num_snowc
          c = filter_snowc(fc)
          if (j >= snl(c)+1) then
             vol_ice(c,j) = min(1._r8, h2osoi_ice(c,j)/(dz(c,j)*denice))
             eff_porosity(c,j) = 1._r8 - vol_ice(c,j)
             vol_liq(c,j) = min(eff_porosity(c,j),h2osoi_liq(c,j)/(dz(c,j)*denh2o))
          end if
       end do
    end do

    ! Capillary forces within snow are usually two or more orders of magnitude
    ! less than those of gravity. Only gravity terms are considered.
    ! the genernal expression for water flow is "K * ss**3", however,
    ! no effective parameterization for "K".  Thus, a very simple consideration
    ! (not physically based) is introduced:
    ! when the liquid water of layer exceeds the layer's holding
    ! capacity, the excess meltwater adds to the underlying neighbor layer.

    ! Also compute aerosol fluxes through snowpack in this loop:
    ! 1) compute aerosol mass in each layer
    ! 2) add aerosol mass flux from above layer to mass of this layer
    ! 3) qout_xxx is mass flux of aerosol species xxx out bottom of
    !    layer in water flow, proportional to (current) concentration
    !    of aerosol in layer multiplied by a scavenging ratio.
    ! 4) update mass of aerosol in top layer, accordingly
    ! 5) update mass concentration of aerosol accordingly

    qin(:) = 0._r8
    qin_bc_phi(:) = 0._r8
    qin_bc_pho(:) = 0._r8
    qin_oc_phi(:) = 0._r8
    qin_oc_pho(:) = 0._r8
    qin_dst1(:)   = 0._r8
    qin_dst2(:)   = 0._r8
    qin_dst3(:)   = 0._r8
    qin_dst4(:)   = 0._r8

    do j = -nlevsno+1, 0
!dir$ concurrent
!cdir nodep
       do fc = 1, num_snowc
          c = filter_snowc(fc)
          if (j >= snl(c)+1) then
             h2osoi_liq(c,j) = h2osoi_liq(c,j) + qin(c)
             
             mss_bcphi(c,j) = mss_bcphi(c,j) + qin_bc_phi(c)
             mss_bcpho(c,j) = mss_bcpho(c,j) + qin_bc_pho(c)
             mss_ocphi(c,j) = mss_ocphi(c,j) + qin_oc_phi(c)
             mss_ocpho(c,j) = mss_ocpho(c,j) + qin_oc_pho(c)
             mss_dst1(c,j)  = mss_dst1(c,j) + qin_dst1(c)
             mss_dst2(c,j)  = mss_dst2(c,j) + qin_dst2(c)
             mss_dst3(c,j)  = mss_dst3(c,j) + qin_dst3(c)
             mss_dst4(c,j)  = mss_dst4(c,j) + qin_dst4(c)

             if (j <= -1) then
                ! No runoff over snow surface, just ponding on surface
                if (eff_porosity(c,j) < wimp .OR. eff_porosity(c,j+1) < wimp) then
                   qout(c) = 0._r8
                else
                   qout(c) = max(0._r8,(vol_liq(c,j)-ssi*eff_porosity(c,j))*dz(c,j))
                   qout(c) = min(qout(c),(1._r8-vol_ice(c,j+1)-vol_liq(c,j+1))*dz(c,j+1))
                end if
             else
                qout(c) = max(0._r8,(vol_liq(c,j) - ssi*eff_porosity(c,j))*dz(c,j))
             end if
             qout(c) = qout(c)*1000._r8
             h2osoi_liq(c,j) = h2osoi_liq(c,j) - qout(c)
             qin(c) = qout(c)

             ! mass of ice+water: in extremely rare circumstances, this can
             ! be zero, even though there is a snow layer defined. In
             ! this case, set the mass to a very small value to
             ! prevent division by zero.
             mss_liqice = h2osoi_liq(c,j)+h2osoi_ice(c,j)
             if (mss_liqice < 1E-30_r8) then
                mss_liqice = 1E-30_r8
             endif
         
             ! BCPHI:
             ! 1. flux with meltwater:
             qout_bc_phi(c) = qout(c)*scvng_fct_mlt_bcphi*(mss_bcphi(c,j)/mss_liqice)
             if (qout_bc_phi(c) > mss_bcphi(c,j)) then
                qout_bc_phi(c) = mss_bcphi(c,j)
             endif
             mss_bcphi(c,j) = mss_bcphi(c,j) - qout_bc_phi(c)
             qin_bc_phi(c) = qout_bc_phi(c)

             ! BCPHO:
             ! 1. flux with meltwater:
             qout_bc_pho(c) = qout(c)*scvng_fct_mlt_bcpho*(mss_bcpho(c,j)/mss_liqice)
             if (qout_bc_pho(c) > mss_bcpho(c,j)) then
                qout_bc_pho(c) = mss_bcpho(c,j)
             endif
             mss_bcpho(c,j) = mss_bcpho(c,j) - qout_bc_pho(c)
             qin_bc_pho(c) = qout_bc_pho(c)

             ! OCPHI:
             ! 1. flux with meltwater:
             qout_oc_phi(c) = qout(c)*scvng_fct_mlt_ocphi*(mss_ocphi(c,j)/mss_liqice)
             if (qout_oc_phi(c) > mss_ocphi(c,j)) then
                qout_oc_phi(c) = mss_ocphi(c,j)
             endif
             mss_ocphi(c,j) = mss_ocphi(c,j) - qout_oc_phi(c)
             qin_oc_phi(c) = qout_oc_phi(c)

             ! OCPHO:
             ! 1. flux with meltwater:
             qout_oc_pho(c) = qout(c)*scvng_fct_mlt_ocpho*(mss_ocpho(c,j)/mss_liqice)
             if (qout_oc_pho(c) > mss_ocpho(c,j)) then
                qout_oc_pho(c) = mss_ocpho(c,j)
             endif
             mss_ocpho(c,j) = mss_ocpho(c,j) - qout_oc_pho(c)
             qin_oc_pho(c) = qout_oc_pho(c)

             ! DUST 1:
             ! 1. flux with meltwater:
             qout_dst1(c) = qout(c)*scvng_fct_mlt_dst1*(mss_dst1(c,j)/mss_liqice)
             if (qout_dst1(c) > mss_dst1(c,j)) then
                qout_dst1(c) = mss_dst1(c,j)
             endif
             mss_dst1(c,j) = mss_dst1(c,j) - qout_dst1(c)
             qin_dst1(c) = qout_dst1(c)

             ! DUST 2:
             ! 1. flux with meltwater:
             qout_dst2(c) = qout(c)*scvng_fct_mlt_dst2*(mss_dst2(c,j)/mss_liqice)
             if (qout_dst2(c) > mss_dst2(c,j)) then
                qout_dst2(c) = mss_dst2(c,j)
             endif
             mss_dst2(c,j) = mss_dst2(c,j) - qout_dst2(c)
             qin_dst2(c) = qout_dst2(c)

             ! DUST 3:
             ! 1. flux with meltwater:
             qout_dst3(c) = qout(c)*scvng_fct_mlt_dst3*(mss_dst3(c,j)/mss_liqice)
             if (qout_dst3(c) > mss_dst3(c,j)) then
                qout_dst3(c) = mss_dst3(c,j)
             endif
             mss_dst3(c,j) = mss_dst3(c,j) - qout_dst3(c)
             qin_dst3(c) = qout_dst3(c)

             ! DUST 4:
             ! 1. flux with meltwater:
             qout_dst4(c) = qout(c)*scvng_fct_mlt_dst4*(mss_dst4(c,j)/mss_liqice)
             if (qout_dst4(c) > mss_dst4(c,j)) then
                qout_dst4(c) = mss_dst4(c,j)
             endif
             mss_dst4(c,j) = mss_dst4(c,j) - qout_dst4(c)
             qin_dst4(c) = qout_dst4(c)
             
          end if
       end do
    end do

!dir$ concurrent
!cdir nodep
    do fc = 1, num_snowc
       c = filter_snowc(fc)
       ! Qout from snow bottom
       qflx_top_soil(c) = qout(c) / dtime
    end do

!dir$ concurrent
!cdir nodep
    do fc = 1, num_nosnowc
       c = filter_nosnowc(fc)
       qflx_top_soil(c) = qflx_rain_grnd(c) + qflx_snomelt(c)
    end do

    
    !  set aerosol deposition fluxes from forcing array
    !  The forcing array is either set from an external file 
    !  or from fluxes received from the atmosphere model
    do c = lbc,ubc
       g = cgridcell(c)
       
       flx_bc_dep_dry(c)   = forc_aer(g,1) + forc_aer(g,2)
       flx_bc_dep_wet(c)   = forc_aer(g,3)
       flx_bc_dep_phi(c)   = forc_aer(g,1) + forc_aer(g,3)
       flx_bc_dep_pho(c)   = forc_aer(g,2)
       flx_bc_dep(c)       = forc_aer(g,1) + forc_aer(g,2) + forc_aer(g,3)
       
       flx_oc_dep_dry(c)   = forc_aer(g,4) + forc_aer(g,5)
       flx_oc_dep_wet(c)   = forc_aer(g,6)
       flx_oc_dep_phi(c)   = forc_aer(g,4) + forc_aer(g,6)
       flx_oc_dep_pho(c)   = forc_aer(g,5)
       flx_oc_dep(c)       = forc_aer(g,4) + forc_aer(g,5) + forc_aer(g,6)
       
       flx_dst_dep_wet1(c) = forc_aer(g,7)
       flx_dst_dep_dry1(c) = forc_aer(g,8)
       flx_dst_dep_wet2(c) = forc_aer(g,9)
       flx_dst_dep_dry2(c) = forc_aer(g,10)
       flx_dst_dep_wet3(c) = forc_aer(g,11)
       flx_dst_dep_dry3(c) = forc_aer(g,12)
       flx_dst_dep_wet4(c) = forc_aer(g,13)
       flx_dst_dep_dry4(c) = forc_aer(g,14)
       flx_dst_dep(c)      = forc_aer(g,7) + forc_aer(g,8) + forc_aer(g,9) + &
                             forc_aer(g,10) + forc_aer(g,11) + forc_aer(g,12) + &
                             forc_aer(g,13) + forc_aer(g,14)
    
    end do

    ! aerosol deposition fluxes into top layer
    ! This is done after the inter-layer fluxes so that some aerosol
    ! is in the top layer after deposition, and is not immediately
    ! washed out before radiative calculations are done
    do fc = 1, num_snowc
       c = filter_snowc(fc)
       mss_bcphi(c,snl(c)+1) = mss_bcphi(c,snl(c)+1) + (flx_bc_dep_phi(c)*dtime)
       mss_bcpho(c,snl(c)+1) = mss_bcpho(c,snl(c)+1) + (flx_bc_dep_pho(c)*dtime)
       mss_ocphi(c,snl(c)+1) = mss_ocphi(c,snl(c)+1) + (flx_oc_dep_phi(c)*dtime)
       mss_ocpho(c,snl(c)+1) = mss_ocpho(c,snl(c)+1) + (flx_oc_dep_pho(c)*dtime)
       
       mss_dst1(c,snl(c)+1) = mss_dst1(c,snl(c)+1) + (flx_dst_dep_dry1(c) + flx_dst_dep_wet1(c))*dtime
       mss_dst2(c,snl(c)+1) = mss_dst2(c,snl(c)+1) + (flx_dst_dep_dry2(c) + flx_dst_dep_wet2(c))*dtime
       mss_dst3(c,snl(c)+1) = mss_dst3(c,snl(c)+1) + (flx_dst_dep_dry3(c) + flx_dst_dep_wet3(c))*dtime
       mss_dst4(c,snl(c)+1) = mss_dst4(c,snl(c)+1) + (flx_dst_dep_dry4(c) + flx_dst_dep_wet4(c))*dtime
    end do

  end subroutine SnowWater

!-----------------------------------------------------------------------
!BOP
!
! !IROUTINE: SnowCompaction
!
! !INTERFACE:
  subroutine SnowCompaction(lbc, ubc, num_snowc, filter_snowc)
!
! !DESCRIPTION:
! Determine the change in snow layer thickness due to compaction and
! settling.
! Three metamorphisms of changing snow characteristics are implemented,
! i.e., destructive, overburden, and melt. The treatments of the former
! two are from SNTHERM.89 and SNTHERM.99 (1991, 1999). The contribution
! due to melt metamorphism is simply taken as a ratio of snow ice
! fraction after the melting versus before the melting.
!
! !USES:
    use clmtype
    use clm_varcon  , only : denice, denh2o, tfrz
    use globals     , only : dtime
!
! !ARGUMENTS:
    implicit none
    integer, intent(in) :: lbc, ubc                ! column bounds
    integer, intent(in) :: num_snowc               ! number of column snow points in column filter
    integer, intent(in) :: filter_snowc(ubc-lbc+1) ! column filter for snow points
!
! !CALLED FROM:
! subroutine Hydrology2 in module Hydrology2Mod
!
! !REVISION HISTORY:
! 15 September 1999: Yongjiu Dai; Initial code
! 15 December 1999:  Paul Houser and Jon Radakovich; F90 Revision
! 2/28/02, Peter Thornton: Migrated to new data structures
! 2/29/08, David Lawrence: Revised snow overburden to be include 0.5 weight of current layer
!
! !LOCAL VARIABLES:
!
! local pointers to implicit in scalars
!
    integer,  pointer :: snl(:)             !number of snow layers
!
! local pointers to implicit in arguments
!
    integer,  pointer :: imelt(:,:)        !flag for melting (=1), freezing (=2), Not=0
    real(r8), pointer :: frac_iceold(:,:)  !fraction of ice relative to the tot water
    real(r8), pointer :: t_soisno(:,:)     !soil temperature (Kelvin)
    real(r8), pointer :: h2osoi_ice(:,:)   !ice lens (kg/m2)
    real(r8), pointer :: h2osoi_liq(:,:)   !liquid water (kg/m2)
!
! local pointers to implicit inout arguments
!
    real(r8), pointer :: dz(:,:)           !layer depth (m)
!
!
! !OTHER LOCAL VARIABLES:
!EOP
!
    integer :: j, c, fc                   ! indices
    real(r8), parameter :: c2 = 23.e-3_r8    ! [m3/kg]
    real(r8), parameter :: c3 = 2.777e-6_r8  ! [1/s]
    real(r8), parameter :: c4 = 0.04_r8      ! [1/K]
    real(r8), parameter :: c5 = 2.0_r8       !
    real(r8), parameter :: dm = 100.0_r8     ! Upper Limit on Destructive Metamorphism Compaction [kg/m3]
    real(r8), parameter :: eta0 = 9.e+5_r8   ! The Viscosity Coefficient Eta0 [kg-s/m2]
    real(r8) :: burden(lbc:ubc) ! pressure of overlying snow [kg/m2]
    real(r8) :: ddz1   ! Rate of settling of snowpack due to destructive metamorphism.
    real(r8) :: ddz2   ! Rate of compaction of snowpack due to overburden.
    real(r8) :: ddz3   ! Rate of compaction of snowpack due to melt [1/s]
    real(r8) :: dexpf  ! expf=exp(-c4*(273.15-t_soisno)).
    real(r8) :: fi     ! Fraction of ice relative to the total water content at current time step
    real(r8) :: td     ! t_soisno - tfrz [K]
    real(r8) :: pdzdtc ! Nodal rate of change in fractional-thickness due to compaction [fraction/s]
    real(r8) :: void   ! void (1 - vol_ice - vol_liq)
    real(r8) :: wx     ! water mass (ice+liquid) [kg/m2]
    real(r8) :: bi     ! partial density of ice [kg/m3]

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

    ! Assign local pointers to derived subtypes (column-level)

    snl         => clm3%g%l%c%cps%snl
    dz          => clm3%g%l%c%cps%dz
    imelt       => clm3%g%l%c%cps%imelt
    frac_iceold => clm3%g%l%c%cps%frac_iceold
    t_soisno    => clm3%g%l%c%ces%t_soisno
    h2osoi_ice  => clm3%g%l%c%cws%h2osoi_ice
    h2osoi_liq  => clm3%g%l%c%cws%h2osoi_liq


    ! Begin calculation - note that the following column loops are only invoked if snl(c) < 0

    burden(:) = 0._r8

    do j = -nlevsno+1, 0
!dir$ concurrent
!cdir nodep
       do fc = 1, num_snowc
          c = filter_snowc(fc)
          if (j >= snl(c)+1) then

             wx = h2osoi_ice(c,j) + h2osoi_liq(c,j)
             void = 1._r8 - (h2osoi_ice(c,j)/denice + h2osoi_liq(c,j)/denh2o) / dz(c,j)

             ! Allow compaction only for non-saturated node and higher ice lens node.
             if (void > 0.001_r8 .and. h2osoi_ice(c,j) > .1_r8) then
                bi = h2osoi_ice(c,j) / dz(c,j)
                fi = h2osoi_ice(c,j) / wx
                td = tfrz-t_soisno(c,j)
                dexpf = exp(-c4*td)

                ! Settling as a result of destructive metamorphism

                ddz1 = -c3*dexpf
                if (bi > dm) ddz1 = ddz1*exp(-46.0e-3_r8*(bi-dm))

                ! Liquid water term

                if (h2osoi_liq(c,j) > 0.01_r8*dz(c,j)) ddz1=ddz1*c5

                ! Compaction due to overburden

                ddz2 = -(burden(c)+wx/2._r8)*exp(-0.08_r8*td - c2*bi)/eta0 

                ! Compaction occurring during melt

                if (imelt(c,j) == 1) then
                   ddz3 = - 1._r8/dtime * max(0._r8,(frac_iceold(c,j) - fi)/frac_iceold(c,j))
                else
                   ddz3 = 0._r8
                end if

                ! Time rate of fractional change in dz (units of s-1)

                pdzdtc = ddz1 + ddz2 + ddz3

                ! The change in dz due to compaction

                dz(c,j) = dz(c,j) * (1._r8+pdzdtc*dtime)
             end if

             ! Pressure of overlying snow

             burden(c) = burden(c) + wx

          end if
       end do
    end do

  end subroutine SnowCompaction

!-----------------------------------------------------------------------
!BOP
!
! !IROUTINE: CombineSnowLayers
!
! !INTERFACE:
  subroutine CombineSnowLayers(lbc, ubc, num_snowc, filter_snowc)
!
! !DESCRIPTION:
! Combine snow layers that are less than a minimum thickness or mass
! If the snow element thickness or mass is less than a prescribed minimum,
! then it is combined with a neighboring element.  The subroutine
! clm\_combo.f90 then executes the combination of mass and energy.
!
! !USES:
    use clmtype
    use clm_varcon, only : istsoil, isturb
#ifdef CROP
    use clm_varcon, only : istcrop
#endif
!
! !ARGUMENTS:
    implicit none
    integer, intent(in)    :: lbc, ubc                    ! column bounds
    integer, intent(inout) :: num_snowc                   ! number of column snow points in column filter
    integer, intent(inout) :: filter_snowc(ubc-lbc+1)     ! column filter for snow points
!
! !CALLED FROM:
! subroutine Hydrology2 in module Hydrology2Mod
!
! !REVISION HISTORY:
! 15 September 1999: Yongjiu Dai; Initial code
! 15 December 1999:  Paul Houser and Jon Radakovich; F90 Revision
! 2/28/02, Peter Thornton: Migrated to new data structures.
! 03/28/08, Mark Flanner: Added aerosol masses and snow grain radius
!
! !LOCAL VARIABLES:
!
! local pointers to implicit in arguments
!
    integer, pointer :: clandunit(:)       !landunit index for each column
    integer, pointer :: ltype(:)           !landunit type
!
! local pointers to implicit inout arguments
!
    integer , pointer :: snl(:)            !number of snow layers
    real(r8), pointer :: h2osno(:)         !snow water (mm H2O)
    real(r8), pointer :: snowdp(:)         !snow height (m)
    real(r8), pointer :: dz(:,:)           !layer depth (m)
    real(r8), pointer :: zi(:,:)           !interface level below a "z" level (m)
    real(r8), pointer :: t_soisno(:,:)     !soil temperature (Kelvin)
    real(r8), pointer :: h2osoi_ice(:,:)   !ice lens (kg/m2)
    real(r8), pointer :: h2osoi_liq(:,:)   !liquid water (kg/m2)
!
! local pointers to implicit out arguments
!
    real(r8), pointer :: z(:,:)          ! layer thickness (m)
    real(r8), pointer :: mss_bcphi(:,:)  ! hydrophilic BC mass in snow (col,lyr) [kg]
    real(r8), pointer :: mss_bcpho(:,:)  ! hydrophobic BC mass in snow (col,lyr) [kg]
    real(r8), pointer :: mss_ocphi(:,:)  ! hydrophilic OC mass in snow (col,lyr) [kg]
    real(r8), pointer :: mss_ocpho(:,:)  ! hydrophobic OC mass in snow (col,lyr) [kg]
    real(r8), pointer :: mss_dst1(:,:)   ! dust species 1 mass in snow (col,lyr) [kg]
    real(r8), pointer :: mss_dst2(:,:)   ! dust species 2 mass in snow (col,lyr) [kg]
    real(r8), pointer :: mss_dst3(:,:)   ! dust species 3 mass in snow (col,lyr) [kg]
    real(r8), pointer :: mss_dst4(:,:)   ! dust species 4 mass in snow (col,lyr) [kg]
    real(r8), pointer :: snw_rds(:,:)    ! effective snow grain radius (col,lyr) [microns, m^-6]
!
!
! !OTHER LOCAL VARIABLES:
!EOP
!
    integer :: c, fc                 ! column indices
    integer :: i,k                   ! loop indices
    integer :: j,l                   ! node indices
    integer :: msn_old(lbc:ubc)      ! number of top snow layer
    integer :: mssi(lbc:ubc)         ! node index
    integer :: neibor                ! adjacent node selected for combination
    real(r8):: zwice(lbc:ubc)        ! total ice mass in snow
    real(r8):: zwliq (lbc:ubc)       ! total liquid water in snow
    real(r8):: dzmin(5)              ! minimum of top snow layer

    data dzmin /0.010_r8, 0.015_r8, 0.025_r8, 0.055_r8, 0.115_r8/
!-----------------------------------------------------------------------

    ! Assign local pointers to derived subtypes (landunit-level)

    ltype      => clm3%g%l%itype

    ! Assign local pointers to derived subtypes (column-level)

    clandunit  => clm3%g%l%c%landunit
    snl        => clm3%g%l%c%cps%snl
    snowdp     => clm3%g%l%c%cps%snowdp
    h2osno     => clm3%g%l%c%cws%h2osno
    dz         => clm3%g%l%c%cps%dz
    zi         => clm3%g%l%c%cps%zi
    z          => clm3%g%l%c%cps%z
    t_soisno   => clm3%g%l%c%ces%t_soisno
    h2osoi_ice => clm3%g%l%c%cws%h2osoi_ice
    h2osoi_liq => clm3%g%l%c%cws%h2osoi_liq
    mss_bcphi  => clm3%g%l%c%cps%mss_bcphi
    mss_bcpho  => clm3%g%l%c%cps%mss_bcpho
    mss_ocphi  => clm3%g%l%c%cps%mss_ocphi
    mss_ocpho  => clm3%g%l%c%cps%mss_ocpho
    mss_dst1   => clm3%g%l%c%cps%mss_dst1
    mss_dst2   => clm3%g%l%c%cps%mss_dst2
    mss_dst3   => clm3%g%l%c%cps%mss_dst3
    mss_dst4   => clm3%g%l%c%cps%mss_dst4
    snw_rds    => clm3%g%l%c%cps%snw_rds


    ! Check the mass of ice lens of snow, when the total is less than a small value,
    ! combine it with the underlying neighbor.

!dir$ concurrent
!cdir nodep
    do fc = 1, num_snowc
       c = filter_snowc(fc)
       msn_old(c) = snl(c)
    end do

    ! The following loop is NOT VECTORIZED

    do fc = 1, num_snowc
       c = filter_snowc(fc)
       l = clandunit(c)
       do j = msn_old(c)+1,0
          if (h2osoi_ice(c,j) <= .1_r8) then
#ifndef CROP
             if (ltype(l) == istsoil .or. ltype(l)==isturb) then
#else
             if (ltype(l) == istsoil .or. ltype(l)==isturb .or. ltype(l) == istcrop) then
#endif
                h2osoi_liq(c,j+1) = h2osoi_liq(c,j+1) + h2osoi_liq(c,j)
                h2osoi_ice(c,j+1) = h2osoi_ice(c,j+1) + h2osoi_ice(c,j)
                
                ! NOTE: Temperature, and similarly snw_rds, of the
                ! underlying snow layer are NOT adjusted in this case. 
                ! Because the layer being eliminated has a small mass, 
                ! this should not make a large difference, but it 
                ! would be more thorough to do so.
                if (j /= 0) then
                   mss_bcphi(c,j+1) = mss_bcphi(c,j+1) + mss_bcphi(c,j)
                   mss_bcpho(c,j+1) = mss_bcpho(c,j+1) + mss_bcpho(c,j)
                   mss_ocphi(c,j+1) = mss_ocphi(c,j+1) + mss_ocphi(c,j)
                   mss_ocpho(c,j+1) = mss_ocpho(c,j+1) + mss_ocpho(c,j)
                   mss_dst1(c,j+1)  = mss_dst1(c,j+1) + mss_dst1(c,j)
                   mss_dst2(c,j+1)  = mss_dst2(c,j+1) + mss_dst2(c,j)
                   mss_dst3(c,j+1)  = mss_dst3(c,j+1) + mss_dst3(c,j)
                   mss_dst4(c,j+1)  = mss_dst4(c,j+1) + mss_dst4(c,j)
                end if

#ifndef CROP
             else if (ltype(l) /= istsoil .and. ltype(l) /= isturb .and. j /= 0) then
#else
             else if (ltype(l) /= istsoil .and. ltype(l) /= isturb .and. ltype(l) /= istcrop .and. j /= 0) then
#endif
                h2osoi_liq(c,j+1) = h2osoi_liq(c,j+1) + h2osoi_liq(c,j)
                h2osoi_ice(c,j+1) = h2osoi_ice(c,j+1) + h2osoi_ice(c,j)
                
                mss_bcphi(c,j+1) = mss_bcphi(c,j+1) + mss_bcphi(c,j)
                mss_bcpho(c,j+1) = mss_bcpho(c,j+1) + mss_bcpho(c,j)
                mss_ocphi(c,j+1) = mss_ocphi(c,j+1) + mss_ocphi(c,j)
                mss_ocpho(c,j+1) = mss_ocpho(c,j+1) + mss_ocpho(c,j)
                mss_dst1(c,j+1)  = mss_dst1(c,j+1) + mss_dst1(c,j)
                mss_dst2(c,j+1)  = mss_dst2(c,j+1) + mss_dst2(c,j)
                mss_dst3(c,j+1)  = mss_dst3(c,j+1) + mss_dst3(c,j)
                mss_dst4(c,j+1)  = mss_dst4(c,j+1) + mss_dst4(c,j)

             end if

             ! shift all elements above this down one.
             if (j > snl(c)+1 .and. snl(c) < -1) then
                do i = j, snl(c)+2, -1
                   t_soisno(c,i)   = t_soisno(c,i-1)
                   h2osoi_liq(c,i) = h2osoi_liq(c,i-1)
                   h2osoi_ice(c,i) = h2osoi_ice(c,i-1)
                   
                   mss_bcphi(c,i)   = mss_bcphi(c,i-1)
                   mss_bcpho(c,i)   = mss_bcpho(c,i-1)
                   mss_ocphi(c,i)   = mss_ocphi(c,i-1)
                   mss_ocpho(c,i)   = mss_ocpho(c,i-1)
                   mss_dst1(c,i)    = mss_dst1(c,i-1)
                   mss_dst2(c,i)    = mss_dst2(c,i-1)
                   mss_dst3(c,i)    = mss_dst3(c,i-1)
                   mss_dst4(c,i)    = mss_dst4(c,i-1)
                   snw_rds(c,i)     = snw_rds(c,i-1)

                   dz(c,i)         = dz(c,i-1)
                end do
             end if
             snl(c) = snl(c) + 1
          end if
       end do
    end do

!dir$ concurrent
!cdir nodep
    do fc = 1, num_snowc
       c = filter_snowc(fc)
       h2osno(c) = 0._r8
       snowdp(c) = 0._r8
       zwice(c)  = 0._r8
       zwliq(c)  = 0._r8
    end do

    do j = -nlevsno+1,0
!dir$ concurrent
!cdir nodep
       do fc = 1, num_snowc
          c = filter_snowc(fc)
          if (j >= snl(c)+1) then
             h2osno(c) = h2osno(c) + h2osoi_ice(c,j) + h2osoi_liq(c,j)
             snowdp(c) = snowdp(c) + dz(c,j)
             zwice(c)  = zwice(c) + h2osoi_ice(c,j)
             zwliq(c)  = zwliq(c) + h2osoi_liq(c,j)
          end if
       end do
    end do

    ! Check the snow depth - all snow gone
    ! The liquid water assumes ponding on soil surface.

!dir$ concurrent
!cdir nodep
    do fc = 1, num_snowc
       c = filter_snowc(fc)
       l = clandunit(c)
       if (snowdp(c) < 0.01_r8 .and. snowdp(c) > 0._r8) then
          snl(c) = 0
          h2osno(c) = zwice(c)

          mss_bcphi(c,:) = 0._r8
          mss_bcpho(c,:) = 0._r8
          mss_ocphi(c,:) = 0._r8
          mss_ocpho(c,:) = 0._r8
          mss_dst1(c,:)  = 0._r8
          mss_dst2(c,:)  = 0._r8
          mss_dst3(c,:)  = 0._r8
          mss_dst4(c,:)  = 0._r8

          if (h2osno(c) <= 0._r8) snowdp(c) = 0._r8
#ifndef CROP
          if (ltype(l) == istsoil .or. ltype(l) == isturb) then
#else
          if (ltype(l) == istsoil .or. ltype(l) == isturb .or. ltype(l) == istcrop) then
#endif
             h2osoi_liq(c,1) = h2osoi_liq(c,1) + zwliq(c)
          end if
       end if
    end do

    ! Check the snow depth - snow layers combined
    ! The following loop IS NOT VECTORIZED

    do fc = 1, num_snowc
       c = filter_snowc(fc)

       ! Two or more layers

       if (snl(c) < -1) then

          msn_old(c) = snl(c)
          mssi(c) = 1

          do i = msn_old(c)+1,0
             if (dz(c,i) < dzmin(mssi(c))) then

                if (i == snl(c)+1) then
                   ! If top node is removed, combine with bottom neighbor.
                   neibor = i + 1
                else if (i == 0) then
                   ! If the bottom neighbor is not snow, combine with the top neighbor.
                   neibor = i - 1
                else
                   ! If none of the above special cases apply, combine with the thinnest neighbor
                   neibor = i + 1
                   if ((dz(c,i-1)+dz(c,i)) < (dz(c,i+1)+dz(c,i))) neibor = i-1
                end if

                ! Node l and j are combined and stored as node j.
                if (neibor > i) then
                   j = neibor
                   l = i
                else
                   j = i
                   l = neibor
                end if

                ! this should be included in 'Combo' for consistency,
                ! but functionally it is the same to do it here
                mss_bcphi(c,j)=mss_bcphi(c,j)+mss_bcphi(c,l)
                mss_bcpho(c,j)=mss_bcpho(c,j)+mss_bcpho(c,l)
                mss_ocphi(c,j)=mss_ocphi(c,j)+mss_ocphi(c,l)
                mss_ocpho(c,j)=mss_ocpho(c,j)+mss_ocpho(c,l)
                mss_dst1(c,j)=mss_dst1(c,j)+mss_dst1(c,l)
                mss_dst2(c,j)=mss_dst2(c,j)+mss_dst2(c,l)
                mss_dst3(c,j)=mss_dst3(c,j)+mss_dst3(c,l)
                mss_dst4(c,j)=mss_dst4(c,j)+mss_dst4(c,l)
                ! mass-weighted combination of effective grain size:
                snw_rds(c,j) = (snw_rds(c,j)*(h2osoi_liq(c,j)+h2osoi_ice(c,j)) + &
                               snw_rds(c,l)*(h2osoi_liq(c,l)+h2osoi_ice(c,l))) / &
                               (h2osoi_liq(c,j)+h2osoi_ice(c,j)+h2osoi_liq(c,l)+h2osoi_ice(c,l))

                call Combo (dz(c,j), h2osoi_liq(c,j), h2osoi_ice(c,j), &
                   t_soisno(c,j), dz(c,l), h2osoi_liq(c,l), h2osoi_ice(c,l), t_soisno(c,l) )

                ! Now shift all elements above this down one.
                if (j-1 > snl(c)+1) then
                   do k = j-1, snl(c)+2, -1
                      t_soisno(c,k) = t_soisno(c,k-1)
                      h2osoi_ice(c,k) = h2osoi_ice(c,k-1)
                      h2osoi_liq(c,k) = h2osoi_liq(c,k-1)

                      mss_bcphi(c,k) = mss_bcphi(c,k-1)
                      mss_bcpho(c,k) = mss_bcpho(c,k-1)
                      mss_ocphi(c,k) = mss_ocphi(c,k-1)
                      mss_ocpho(c,k) = mss_ocpho(c,k-1)
                      mss_dst1(c,k)  = mss_dst1(c,k-1)
                      mss_dst2(c,k)  = mss_dst2(c,k-1)
                      mss_dst3(c,k)  = mss_dst3(c,k-1)
                      mss_dst4(c,k)  = mss_dst4(c,k-1)
                      snw_rds(c,k)   = snw_rds(c,k-1)

                      dz(c,k) = dz(c,k-1)
                   end do
                end if

                ! Decrease the number of snow layers
                snl(c) = snl(c) + 1
                if (snl(c) >= -1) EXIT

             else

                ! The layer thickness is greater than the prescribed minimum value
                mssi(c) = mssi(c) + 1

             end if
          end do

       end if

    end do

    ! Reset the node depth and the depth of layer interface

    do j = 0, -nlevsno+1, -1
!dir$ concurrent
!cdir nodep
       do fc = 1, num_snowc
          c = filter_snowc(fc)
          if (j >= snl(c) + 1) then
             z(c,j) = zi(c,j) - 0.5_r8*dz(c,j)
             zi(c,j-1) = zi(c,j) - dz(c,j)
          end if
       end do
    end do

  end subroutine CombineSnowLayers

!-----------------------------------------------------------------------
!BOP
!
! !IROUTINE: DivideSnowLayers
!
! !INTERFACE:
  subroutine DivideSnowLayers(lbc, ubc, num_snowc, filter_snowc)
!
! !DESCRIPTION:
! Subdivides snow layers if they exceed their prescribed maximum thickness.
!
! !USES:
    use clmtype
    use clm_varcon,  only : tfrz 
!
! !ARGUMENTS:
    implicit none
    integer, intent(in)    :: lbc, ubc                    ! column bounds
    integer, intent(inout) :: num_snowc                   ! number of column snow points in column filter
    integer, intent(inout) :: filter_snowc(ubc-lbc+1)     ! column filter for snow points
!
! !CALLED FROM:
! subroutine Hydrology2 in module Hydrology2Mod
!
! !REVISION HISTORY:
! 15 September 1999: Yongjiu Dai; Initial code
! 15 December 1999:  Paul Houser and Jon Radakovich; F90 Revision
! 2/28/02, Peter Thornton: Migrated to new data structures.
! 2/29/08, David Lawrence: Snowpack T profile maintained during layer splitting
! 03/28/08, Mark Flanner: Added aerosol masses and snow grain radius
!
! !LOCAL VARIABLES:
!
! local pointers to implicit inout arguments
!
    integer , pointer :: snl(:)            !number of snow layers
    real(r8), pointer :: dz(:,:)           !layer depth (m)
    real(r8), pointer :: zi(:,:)           !interface level below a "z" level (m)
    real(r8), pointer :: t_soisno(:,:)     !soil temperature (Kelvin)
    real(r8), pointer :: h2osoi_ice(:,:)   !ice lens (kg/m2)
    real(r8), pointer :: h2osoi_liq(:,:)   !liquid water (kg/m2)
!
! local pointers to implicit out arguments
!
    real(r8), pointer :: z(:,:)          ! layer thickness (m)
    real(r8), pointer :: mss_bcphi(:,:)  ! hydrophilic BC mass in snow (col,lyr) [kg]
    real(r8), pointer :: mss_bcpho(:,:)  ! hydrophobic BC mass in snow (col,lyr) [kg]
    real(r8), pointer :: mss_ocphi(:,:)  ! hydrophilic OC mass in snow (col,lyr) [kg]
    real(r8), pointer :: mss_ocpho(:,:)  ! hydrophobic OC mass in snow (col,lyr) [kg]
    real(r8), pointer :: mss_dst1(:,:)   ! dust species 1 mass in snow (col,lyr) [kg]
    real(r8), pointer :: mss_dst2(:,:)   ! dust species 2 mass in snow (col,lyr) [kg]
    real(r8), pointer :: mss_dst3(:,:)   ! dust species 3 mass in snow (col,lyr) [kg]
    real(r8), pointer :: mss_dst4(:,:)   ! dust species 4 mass in snow (col,lyr) [kg]
    real(r8), pointer :: snw_rds(:,:)    ! effective snow grain radius (col,lyr) [microns, m^-6]
!
!
! !OTHER LOCAL VARIABLES:
!EOP
!
    integer  :: j, c, fc               ! indices
    real(r8) :: drr                    ! thickness of the combined [m]
    integer  :: msno                   ! number of snow layer 1 (top) to msno (bottom)
    real(r8) :: dzsno(lbc:ubc,nlevsno) ! Snow layer thickness [m]
    real(r8) :: swice(lbc:ubc,nlevsno) ! Partial volume of ice [m3/m3]
    real(r8) :: swliq(lbc:ubc,nlevsno) ! Partial volume of liquid water [m3/m3]
    real(r8) :: tsno(lbc:ubc ,nlevsno) ! Nodel temperature [K]
    real(r8) :: zwice                  ! temporary
    real(r8) :: zwliq                  ! temporary
    real(r8) :: propor                 ! temporary
    real(r8) :: dtdz                   ! temporary

    ! temporary variables mimicking the structure of other layer division variables
    real(r8) :: mbc_phi(lbc:ubc,nlevsno) ! mass of BC in each snow layer
    real(r8) :: zmbc_phi                 ! temporary
    real(r8) :: mbc_pho(lbc:ubc,nlevsno) ! mass of BC in each snow layer
    real(r8) :: zmbc_pho                 ! temporary
    real(r8) :: moc_phi(lbc:ubc,nlevsno) ! mass of OC in each snow layer
    real(r8) :: zmoc_phi                 ! temporary
    real(r8) :: moc_pho(lbc:ubc,nlevsno) ! mass of OC in each snow layer
    real(r8) :: zmoc_pho                 ! temporary
    real(r8) :: mdst1(lbc:ubc,nlevsno)   ! mass of dust 1 in each snow layer
    real(r8) :: zmdst1                   ! temporary
    real(r8) :: mdst2(lbc:ubc,nlevsno)   ! mass of dust 2 in each snow layer
    real(r8) :: zmdst2                   ! temporary
    real(r8) :: mdst3(lbc:ubc,nlevsno)   ! mass of dust 3 in each snow layer
    real(r8) :: zmdst3                   ! temporary
    real(r8) :: mdst4(lbc:ubc,nlevsno)   ! mass of dust 4 in each snow layer
    real(r8) :: zmdst4                   ! temporary
    real(r8) :: rds(lbc:ubc,nlevsno)

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

    ! Assign local pointers to derived subtype components (column-level)

    snl        => clm3%g%l%c%cps%snl
    dz         => clm3%g%l%c%cps%dz
    zi         => clm3%g%l%c%cps%zi
    z          => clm3%g%l%c%cps%z
    t_soisno   => clm3%g%l%c%ces%t_soisno
    h2osoi_ice => clm3%g%l%c%cws%h2osoi_ice
    h2osoi_liq => clm3%g%l%c%cws%h2osoi_liq
    mss_bcphi  => clm3%g%l%c%cps%mss_bcphi
    mss_bcpho  => clm3%g%l%c%cps%mss_bcpho
    mss_ocphi  => clm3%g%l%c%cps%mss_ocphi
    mss_ocpho  => clm3%g%l%c%cps%mss_ocpho
    mss_dst1   => clm3%g%l%c%cps%mss_dst1
    mss_dst2   => clm3%g%l%c%cps%mss_dst2
    mss_dst3   => clm3%g%l%c%cps%mss_dst3
    mss_dst4   => clm3%g%l%c%cps%mss_dst4
    snw_rds    => clm3%g%l%c%cps%snw_rds
    

    ! Begin calculation - note that the following column loops are only invoked
    ! for snow-covered columns

    do j = 1,nlevsno
!dir$ concurrent
!cdir nodep
       do fc = 1, num_snowc
          c = filter_snowc(fc)
          if (j <= abs(snl(c))) then
             dzsno(c,j) = dz(c,j+snl(c))
             swice(c,j) = h2osoi_ice(c,j+snl(c))
             swliq(c,j) = h2osoi_liq(c,j+snl(c))
             tsno(c,j)  = t_soisno(c,j+snl(c))

             mbc_phi(c,j) = mss_bcphi(c,j+snl(c))
             mbc_pho(c,j) = mss_bcpho(c,j+snl(c))
             moc_phi(c,j) = mss_ocphi(c,j+snl(c))
             moc_pho(c,j) = mss_ocpho(c,j+snl(c))
             mdst1(c,j)   = mss_dst1(c,j+snl(c))
             mdst2(c,j)   = mss_dst2(c,j+snl(c))
             mdst3(c,j)   = mss_dst3(c,j+snl(c))
             mdst4(c,j)   = mss_dst4(c,j+snl(c))
             rds(c,j)     = snw_rds(c,j+snl(c))

          end if
       end do
    end do

!dir$ concurrent
!cdir nodep
    do fc = 1, num_snowc
       c = filter_snowc(fc)

       msno = abs(snl(c))

       if (msno == 1) then
          ! Specify a new snow layer
          if (dzsno(c,1) > 0.03_r8) then
             msno = 2
             dzsno(c,1) = dzsno(c,1)/2._r8
             swice(c,1) = swice(c,1)/2._r8
             swliq(c,1) = swliq(c,1)/2._r8
             dzsno(c,2) = dzsno(c,1)
             swice(c,2) = swice(c,1)
             swliq(c,2) = swliq(c,1)
             tsno(c,2)  = tsno(c,1)
             
             mbc_phi(c,1) = mbc_phi(c,1)/2._r8
             mbc_phi(c,2) = mbc_phi(c,1)
             mbc_pho(c,1) = mbc_pho(c,1)/2._r8
             mbc_pho(c,2) = mbc_pho(c,1)
             moc_phi(c,1) = moc_phi(c,1)/2._r8
             moc_phi(c,2) = moc_phi(c,1)
             moc_pho(c,1) = moc_pho(c,1)/2._r8
             moc_pho(c,2) = moc_pho(c,1)
             mdst1(c,1) = mdst1(c,1)/2._r8
             mdst1(c,2) = mdst1(c,1)
             mdst2(c,1) = mdst2(c,1)/2._r8
             mdst2(c,2) = mdst2(c,1)
             mdst3(c,1) = mdst3(c,1)/2._r8
             mdst3(c,2) = mdst3(c,1)
             mdst4(c,1) = mdst4(c,1)/2._r8
             mdst4(c,2) = mdst4(c,1)
             rds(c,2) = rds(c,1)

          end if
       end if

       if (msno > 1) then
          if (dzsno(c,1) > 0.02_r8) then
             drr = dzsno(c,1) - 0.02_r8
             propor = drr/dzsno(c,1)
             zwice = propor*swice(c,1)
             zwliq = propor*swliq(c,1)

             zmbc_phi = propor*mbc_phi(c,1)
             zmbc_pho = propor*mbc_pho(c,1)
             zmoc_phi = propor*moc_phi(c,1)
             zmoc_pho = propor*moc_pho(c,1)
             zmdst1 = propor*mdst1(c,1)
             zmdst2 = propor*mdst2(c,1)
             zmdst3 = propor*mdst3(c,1)
             zmdst4 = propor*mdst4(c,1)

             propor = 0.02_r8/dzsno(c,1)
             swice(c,1) = propor*swice(c,1)
             swliq(c,1) = propor*swliq(c,1)

             mbc_phi(c,1) = propor*mbc_phi(c,1)
             mbc_pho(c,1) = propor*mbc_pho(c,1)
             moc_phi(c,1) = propor*moc_phi(c,1)
             moc_pho(c,1) = propor*moc_pho(c,1)
             mdst1(c,1) = propor*mdst1(c,1)
             mdst2(c,1) = propor*mdst2(c,1)
             mdst3(c,1) = propor*mdst3(c,1)
             mdst4(c,1) = propor*mdst4(c,1)

             dzsno(c,1) = 0.02_r8

             mbc_phi(c,2) = mbc_phi(c,2)+zmbc_phi  ! (combo)
             mbc_pho(c,2) = mbc_pho(c,2)+zmbc_pho  ! (combo)
             moc_phi(c,2) = moc_phi(c,2)+zmoc_phi  ! (combo)
             moc_pho(c,2) = moc_pho(c,2)+zmoc_pho  ! (combo)
             mdst1(c,2) = mdst1(c,2)+zmdst1  ! (combo)
             mdst2(c,2) = mdst2(c,2)+zmdst2  ! (combo)
             mdst3(c,2) = mdst3(c,2)+zmdst3  ! (combo)
             mdst4(c,2) = mdst4(c,2)+zmdst4  ! (combo)
             rds(c,2) = rds(c,1) ! (combo)

             call Combo (dzsno(c,2), swliq(c,2), swice(c,2), tsno(c,2), drr, &
                  zwliq, zwice, tsno(c,1))

             ! Subdivide a new layer
             if (msno <= 2 .and. dzsno(c,2) > 0.07_r8) then
                msno = 3
                dtdz = (tsno(c,1) - tsno(c,2))/((dzsno(c,1)+dzsno(c,2))/2._r8) 
                dzsno(c,2) = dzsno(c,2)/2._r8
                swice(c,2) = swice(c,2)/2._r8
                swliq(c,2) = swliq(c,2)/2._r8
                dzsno(c,3) = dzsno(c,2)
                swice(c,3) = swice(c,2)
                swliq(c,3) = swliq(c,2)
                tsno(c,3) = tsno(c,2) - dtdz*dzsno(c,2)/2._r8
                if (tsno(c,3) >= tfrz) then 
                   tsno(c,3)  = tsno(c,2)
                else
                   tsno(c,2) = tsno(c,2) + dtdz*dzsno(c,2)/2._r8 
                endif

                mbc_phi(c,2) = mbc_phi(c,2)/2._r8
                mbc_phi(c,3) = mbc_phi(c,2)
                mbc_pho(c,2) = mbc_pho(c,2)/2._r8
                mbc_pho(c,3) = mbc_pho(c,2)
                moc_phi(c,2) = moc_phi(c,2)/2._r8
                moc_phi(c,3) = moc_phi(c,2)
                moc_pho(c,2) = moc_pho(c,2)/2._r8
                moc_pho(c,3) = moc_pho(c,2)
                mdst1(c,2) = mdst1(c,2)/2._r8
                mdst1(c,3) = mdst1(c,2)
                mdst2(c,2) = mdst2(c,2)/2._r8
                mdst2(c,3) = mdst2(c,2)
                mdst3(c,2) = mdst3(c,2)/2._r8
                mdst3(c,3) = mdst3(c,2)
                mdst4(c,2) = mdst4(c,2)/2._r8
                mdst4(c,3) = mdst4(c,2)
                rds(c,3) = rds(c,2)

             end if
          end if
       end if

       if (msno > 2) then
          if (dzsno(c,2) > 0.05_r8) then
             drr = dzsno(c,2) - 0.05_r8
             propor = drr/dzsno(c,2)
             zwice = propor*swice(c,2)
             zwliq = propor*swliq(c,2)
             
             zmbc_phi = propor*mbc_phi(c,2)
             zmbc_pho = propor*mbc_pho(c,2)
             zmoc_phi = propor*moc_phi(c,2)
             zmoc_pho = propor*moc_pho(c,2)
             zmdst1 = propor*mdst1(c,2)
             zmdst2 = propor*mdst2(c,2)
             zmdst3 = propor*mdst3(c,2)
             zmdst4 = propor*mdst4(c,2)

             propor = 0.05_r8/dzsno(c,2)
             swice(c,2) = propor*swice(c,2)
             swliq(c,2) = propor*swliq(c,2)

             mbc_phi(c,2) = propor*mbc_phi(c,2)
             mbc_pho(c,2) = propor*mbc_pho(c,2)
             moc_phi(c,2) = propor*moc_phi(c,2)
             moc_pho(c,2) = propor*moc_pho(c,2)
             mdst1(c,2) = propor*mdst1(c,2)
             mdst2(c,2) = propor*mdst2(c,2)
             mdst3(c,2) = propor*mdst3(c,2)
             mdst4(c,2) = propor*mdst4(c,2)

             dzsno(c,2) = 0.05_r8

             mbc_phi(c,3) = mbc_phi(c,3)+zmbc_phi  ! (combo)
             mbc_pho(c,3) = mbc_pho(c,3)+zmbc_pho  ! (combo)
             moc_phi(c,3) = moc_phi(c,3)+zmoc_phi  ! (combo)
             moc_pho(c,3) = moc_pho(c,3)+zmoc_pho  ! (combo)
             mdst1(c,3) = mdst1(c,3)+zmdst1  ! (combo)
             mdst2(c,3) = mdst2(c,3)+zmdst2  ! (combo)
             mdst3(c,3) = mdst3(c,3)+zmdst3  ! (combo)
             mdst4(c,3) = mdst4(c,3)+zmdst4  ! (combo)
             rds(c,3) = rds(c,2) ! (combo)

             call Combo (dzsno(c,3), swliq(c,3), swice(c,3), tsno(c,3), drr, &
                  zwliq, zwice, tsno(c,2))

             ! Subdivided a new layer
             if (msno <= 3 .and. dzsno(c,3) > 0.18_r8) then
                msno =  4
                dtdz = (tsno(c,2) - tsno(c,3))/((dzsno(c,2)+dzsno(c,3))/2._r8) 
                dzsno(c,3) = dzsno(c,3)/2._r8
                swice(c,3) = swice(c,3)/2._r8
                swliq(c,3) = swliq(c,3)/2._r8
                dzsno(c,4) = dzsno(c,3)
                swice(c,4) = swice(c,3)
                swliq(c,4) = swliq(c,3)
                tsno(c,4) = tsno(c,3) - dtdz*dzsno(c,3)/2._r8
                if (tsno(c,4) >= tfrz) then 
                   tsno(c,4)  = tsno(c,3)
                else
                   tsno(c,3) = tsno(c,3) + dtdz*dzsno(c,3)/2._r8 
                endif
                
                mbc_phi(c,3) = mbc_phi(c,3)/2._r8
                mbc_phi(c,4) = mbc_phi(c,3)
                mbc_pho(c,3) = mbc_pho(c,3)/2._r8
                mbc_pho(c,4) = mbc_pho(c,3)
                moc_phi(c,3) = moc_phi(c,3)/2._r8
                moc_phi(c,4) = moc_phi(c,3)
                moc_pho(c,3) = moc_pho(c,3)/2._r8
                moc_pho(c,4) = moc_pho(c,3)
                mdst1(c,3) = mdst1(c,3)/2._r8
                mdst1(c,4) = mdst1(c,3)
                mdst2(c,3) = mdst2(c,3)/2._r8
                mdst2(c,4) = mdst2(c,3)
                mdst3(c,3) = mdst3(c,3)/2._r8
                mdst3(c,4) = mdst3(c,3)
                mdst4(c,3) = mdst4(c,3)/2._r8
                mdst4(c,4) = mdst4(c,3)
                rds(c,4) = rds(c,3)

             end if
          end if
       end if

       if (msno > 3) then
          if (dzsno(c,3) > 0.11_r8) then
             drr = dzsno(c,3) - 0.11_r8
             propor = drr/dzsno(c,3)
             zwice = propor*swice(c,3)
             zwliq = propor*swliq(c,3)
             
             zmbc_phi = propor*mbc_phi(c,3)
             zmbc_pho = propor*mbc_pho(c,3)
             zmoc_phi = propor*moc_phi(c,3)
             zmoc_pho = propor*moc_pho(c,3)
             zmdst1 = propor*mdst1(c,3)
             zmdst2 = propor*mdst2(c,3)
             zmdst3 = propor*mdst3(c,3)
             zmdst4 = propor*mdst4(c,3)

             propor = 0.11_r8/dzsno(c,3)
             swice(c,3) = propor*swice(c,3)
             swliq(c,3) = propor*swliq(c,3)

             mbc_phi(c,3) = propor*mbc_phi(c,3)
             mbc_pho(c,3) = propor*mbc_pho(c,3)
             moc_phi(c,3) = propor*moc_phi(c,3)
             moc_pho(c,3) = propor*moc_pho(c,3)
             mdst1(c,3) = propor*mdst1(c,3)
             mdst2(c,3) = propor*mdst2(c,3)
             mdst3(c,3) = propor*mdst3(c,3)
             mdst4(c,3) = propor*mdst4(c,3)

             dzsno(c,3) = 0.11_r8

             mbc_phi(c,4) = mbc_phi(c,4)+zmbc_phi  ! (combo)
             mbc_pho(c,4) = mbc_pho(c,4)+zmbc_pho  ! (combo)
             moc_phi(c,4) = moc_phi(c,4)+zmoc_phi  ! (combo)
             moc_pho(c,4) = moc_pho(c,4)+zmoc_pho  ! (combo)
             mdst1(c,4) = mdst1(c,4)+zmdst1  ! (combo)
             mdst2(c,4) = mdst2(c,4)+zmdst2  ! (combo)
             mdst3(c,4) = mdst3(c,4)+zmdst3  ! (combo)
             mdst4(c,4) = mdst4(c,4)+zmdst4  ! (combo)
             rds(c,4) = rds(c,3) ! (combo)

             call Combo (dzsno(c,4), swliq(c,4), swice(c,4), tsno(c,4), drr, &
                  zwliq, zwice, tsno(c,3))

             ! Subdivided a new layer
             if (msno <= 4 .and. dzsno(c,4) > 0.41_r8) then
                msno = 5
                dtdz = (tsno(c,3) - tsno(c,4))/((dzsno(c,3)+dzsno(c,4))/2._r8) 
                dzsno(c,4) = dzsno(c,4)/2._r8
                swice(c,4) = swice(c,4)/2._r8
                swliq(c,4) = swliq(c,4)/2._r8
                dzsno(c,5) = dzsno(c,4)
                swice(c,5) = swice(c,4)
                swliq(c,5) = swliq(c,4)
                tsno(c,5) = tsno(c,4) - dtdz*dzsno(c,4)/2._r8 
                if (tsno(c,5) >= tfrz) then 
                   tsno(c,5)  = tsno(c,4)
                else
                   tsno(c,4) = tsno(c,4) + dtdz*dzsno(c,4)/2._r8 
                endif

                mbc_phi(c,4) = mbc_phi(c,4)/2._r8
                mbc_phi(c,5) = mbc_phi(c,4)
                mbc_pho(c,4) = mbc_pho(c,4)/2._r8
                mbc_pho(c,5) = mbc_pho(c,4)              
                moc_phi(c,4) = moc_phi(c,4)/2._r8
                moc_phi(c,5) = moc_phi(c,4)
                moc_pho(c,4) = moc_pho(c,4)/2._r8
                moc_pho(c,5) = moc_pho(c,4)
                mdst1(c,4) = mdst1(c,4)/2._r8
                mdst1(c,5) = mdst1(c,4)
                mdst2(c,4) = mdst2(c,4)/2._r8
                mdst2(c,5) = mdst2(c,4)
                mdst3(c,4) = mdst3(c,4)/2._r8
                mdst3(c,5) = mdst3(c,4)
                mdst4(c,4) = mdst4(c,4)/2._r8
                mdst4(c,5) = mdst4(c,4)
                rds(c,5) = rds(c,4)

             end if
          end if
       end if

       if (msno > 4) then
          if (dzsno(c,4) > 0.23_r8) then
             drr = dzsno(c,4) - 0.23_r8
             propor = drr/dzsno(c,4)
             zwice = propor*swice(c,4)
             zwliq = propor*swliq(c,4)
             
             zmbc_phi = propor*mbc_phi(c,4)
             zmbc_pho = propor*mbc_pho(c,4)
             zmoc_phi = propor*moc_phi(c,4)
             zmoc_pho = propor*moc_pho(c,4)
             zmdst1 = propor*mdst1(c,4)
             zmdst2 = propor*mdst2(c,4)
             zmdst3 = propor*mdst3(c,4)
             zmdst4 = propor*mdst4(c,4)

             propor = 0.23_r8/dzsno(c,4)
             swice(c,4) = propor*swice(c,4)
             swliq(c,4) = propor*swliq(c,4)

             mbc_phi(c,4) = propor*mbc_phi(c,4)
             mbc_pho(c,4) = propor*mbc_pho(c,4)
             moc_phi(c,4) = propor*moc_phi(c,4)
             moc_pho(c,4) = propor*moc_pho(c,4)
             mdst1(c,4) = propor*mdst1(c,4)
             mdst2(c,4) = propor*mdst2(c,4)
             mdst3(c,4) = propor*mdst3(c,4)
             mdst4(c,4) = propor*mdst4(c,4)

             dzsno(c,4) = 0.23_r8

             mbc_phi(c,5) = mbc_phi(c,5)+zmbc_phi  ! (combo)
             mbc_pho(c,5) = mbc_pho(c,5)+zmbc_pho  ! (combo)
             moc_phi(c,5) = moc_phi(c,5)+zmoc_phi  ! (combo)
             moc_pho(c,5) = moc_pho(c,5)+zmoc_pho  ! (combo)
             mdst1(c,5) = mdst1(c,5)+zmdst1  ! (combo)
             mdst2(c,5) = mdst2(c,5)+zmdst2  ! (combo)
             mdst3(c,5) = mdst3(c,5)+zmdst3  ! (combo)
             mdst4(c,5) = mdst4(c,5)+zmdst4  ! (combo)
             rds(c,5) = rds(c,4) ! (combo)

             call Combo (dzsno(c,5), swliq(c,5), swice(c,5), tsno(c,5), drr, &
                  zwliq, zwice, tsno(c,4))
          end if
       end if

       snl(c) = -msno

    end do

    do j = -nlevsno+1,0
!dir$ concurrent
!cdir nodep
       do fc = 1, num_snowc
          c = filter_snowc(fc)
          if (j >= snl(c)+1) then
             dz(c,j)         = dzsno(c,j-snl(c))
             h2osoi_ice(c,j) = swice(c,j-snl(c))
             h2osoi_liq(c,j) = swliq(c,j-snl(c))
             t_soisno(c,j)   = tsno(c,j-snl(c))

             mss_bcphi(c,j)   = mbc_phi(c,j-snl(c))
             mss_bcpho(c,j)   = mbc_pho(c,j-snl(c))
             mss_ocphi(c,j)   = moc_phi(c,j-snl(c))
             mss_ocpho(c,j)   = moc_pho(c,j-snl(c))
             mss_dst1(c,j)    = mdst1(c,j-snl(c))
             mss_dst2(c,j)    = mdst2(c,j-snl(c))
             mss_dst3(c,j)    = mdst3(c,j-snl(c))
             mss_dst4(c,j)    = mdst4(c,j-snl(c))
             snw_rds(c,j)     = rds(c,j-snl(c))

          end if
       end do
    end do

    do j = 0, -nlevsno+1, -1
!dir$ concurrent
!cdir nodep
       do fc = 1, num_snowc
          c = filter_snowc(fc)
          if (j >= snl(c)+1) then
             z(c,j)    = zi(c,j) - 0.5_r8*dz(c,j)
             zi(c,j-1) = zi(c,j) - dz(c,j)
          end if
       end do
    end do

  end subroutine DivideSnowLayers

!-----------------------------------------------------------------------
!BOP
!
! !IROUTINE: Combo
!
! !INTERFACE:
  subroutine Combo(dz,  wliq,  wice, t, dz2, wliq2, wice2, t2)
!
! !DESCRIPTION:
! Combines two elements and returns the following combined
! variables: dz, t, wliq, wice.
! The combined temperature is based on the equation:
! the sum of the enthalpies of the two elements =
! that of the combined element.
!
! !USES:
    use clm_varcon,  only : cpice, cpliq, tfrz, hfus
!
! !ARGUMENTS:
    implicit none
    real(r8), intent(in)    :: dz2   ! nodal thickness of 2 elements being combined [m]
    real(r8), intent(in)    :: wliq2 ! liquid water of element 2 [kg/m2]
    real(r8), intent(in)    :: wice2 ! ice of element 2 [kg/m2]
    real(r8), intent(in)    :: t2    ! nodal temperature of element 2 [K]
    real(r8), intent(inout) :: dz    ! nodal thickness of 1 elements being combined [m]
    real(r8), intent(inout) :: wliq  ! liquid water of element 1
    real(r8), intent(inout) :: wice  ! ice of element 1 [kg/m2]
    real(r8), intent(inout) :: t     ! nodel temperature of elment 1 [K]
!
! !CALLED FROM:
! subroutine CombineSnowLayers in this module
! subroutine DivideSnowLayers in this module
!
! !REVISION HISTORY:
! 15 September 1999: Yongjiu Dai; Initial code
! 15 December 1999:  Paul Houser and Jon Radakovich; F90 Revision
!
!
! !LOCAL VARIABLES:
!EOP
!
    real(r8) :: dzc   ! Total thickness of nodes 1 and 2 (dzc=dz+dz2).
    real(r8) :: wliqc ! Combined liquid water [kg/m2]
    real(r8) :: wicec ! Combined ice [kg/m2]
    real(r8) :: tc    ! Combined node temperature [K]
    real(r8) :: h     ! enthalpy of element 1 [J/m2]
    real(r8) :: h2    ! enthalpy of element 2 [J/m2]
    real(r8) :: hc    ! temporary
!-----------------------------------------------------------------------

    dzc = dz+dz2
    wicec = (wice+wice2)
    wliqc = (wliq+wliq2)
    h = (cpice*wice+cpliq*wliq) * (t-tfrz)+hfus*wliq
    h2= (cpice*wice2+cpliq*wliq2) * (t2-tfrz)+hfus*wliq2

    hc = h + h2
    tc = tfrz + (hc - hfus*wliqc) / (cpice*wicec + cpliq*wliqc)

    dz = dzc
    wice = wicec
    wliq = wliqc
    t = tc

  end subroutine Combo

!-----------------------------------------------------------------------
!BOP
!
! !IROUTINE: BuildSnowFilter
!
! !INTERFACE:
  subroutine BuildSnowFilter(lbc, ubc, num_nolakec, filter_nolakec, &
                             num_snowc, filter_snowc, &
                             num_nosnowc, filter_nosnowc)
!
! !DESCRIPTION:
! Constructs snow filter for use in vectorized loops for snow hydrology.
!
! !USES:
    use clmtype
!
! !ARGUMENTS:
    implicit none
    integer, intent(in)  :: lbc, ubc                    ! column bounds
    integer, intent(in)  :: num_nolakec                 ! number of column non-lake points in column filter
    integer, intent(in)  :: filter_nolakec(ubc-lbc+1)   ! column filter for non-lake points
    integer, intent(out) :: num_snowc                   ! number of column snow points in column filter
    integer, intent(out) :: filter_snowc(ubc-lbc+1)     ! column filter for snow points
    integer, intent(out) :: num_nosnowc                 ! number of column non-snow points in column filter
    integer, intent(out) :: filter_nosnowc(ubc-lbc+1)   ! column filter for non-snow points
!
! !CALLED FROM:
! subroutine Hydrology2 in Hydrology2Mod
! subroutine CombineSnowLayers in this module
!
! !REVISION HISTORY:
! 2003 July 31: Forrest Hoffman
!
! !LOCAL VARIABLES:
! local pointers to implicit in arguments
    integer , pointer :: snl(:)                        ! number of snow layers
!
!
! !OTHER LOCAL VARIABLES:
!EOP
    integer  :: fc, c
!-----------------------------------------------------------------------

    ! Assign local pointers to derived subtype components (column-level)

    snl => clm3%g%l%c%cps%snl

    ! Build snow/no-snow filters for other subroutines

    num_snowc = 0
    num_nosnowc = 0
    do fc = 1, num_nolakec
       c = filter_nolakec(fc)
       if (snl(c) < 0) then
          num_snowc = num_snowc + 1
          filter_snowc(num_snowc) = c
       else
          num_nosnowc = num_nosnowc + 1
          filter_nosnowc(num_nosnowc) = c
       end if
    end do

  end subroutine BuildSnowFilter

end module SnowHydrologyMod
module STATICEcosysdynMOD

!#if (!defined DGVM)
#if (!defined CN)
!-----------------------------------------------------------------------
!BOP
!
! !MODULE: STATICEcosysDynMod
!
! !DESCRIPTION:
! Static Ecosystem dynamics: phenology, vegetation.
!
! !USES:
  use shr_kind_mod, only: r8 => shr_kind_r8
   use decompMod    , only : get_proc_bounds
!
! !PUBLIC TYPES:
  implicit none
  save
!
! !PUBLIC MEMBER FUNCTIONS:
  public :: EcosystemDyn       ! Ecosystem dynamics: phenology, vegetation
  public :: EcosystemDynini    ! Dynamically allocate memory
  public :: interpMonthlyVeg   ! interpolate monthly vegetation data

!
! !REVISION HISTORY:
! Created by Mariana Vertenstein
!
!EOP
!
! !PRIVATE MEMBER FUNCTIONS:
  private :: readMonthlyVegetation   ! read monthly vegetation data for two months
!
! PRIVATE TYPES:
  integer , private :: InterpMonths1         ! saved month index
  real(r8), private :: timwt(2)              ! time weights for month 1 and month 2
  real(r8),  allocatable :: mlai1(:) ! lai for interpolation (month 1)
  real(r8),  allocatable :: mlai2(:) ! lai for interpolation (month 2)
  real(r8),  allocatable :: msai1(:) ! sai for interpolation (month 1)
  real(r8),  allocatable :: msai2(:) ! sai for interpolation (month 2)
  real(r8),  allocatable :: mhvt1(:) ! top vegetation height for interpolation (month 1)
  real(r8),  allocatable :: mhvt2(:) ! top vegetation height for interpolation (month 2)
  real(r8),  allocatable :: mhvb1(:) ! bottom vegetation height for interpolation(month 1)
  real(r8),  allocatable :: mhvb2(:) ! bottom vegetation height for interpolation(month 2)
!-----------------------------------------------------------------------

contains

!-----------------------------------------------------------------------
!BOP
!
! !IROUTINE: EcosystemDynini
!
! !INTERFACE:
  subroutine EcosystemDynini ()
!
! !DESCRIPTION:
! Dynamically allocate memory and set to signaling NaN.
!
! !USES:
    use nanMod
! !ARGUMENTS:
    implicit none
!
! !REVISION HISTORY:
!
!EOP
!
! LOCAL VARIABLES:
    integer :: ier    ! error code
    integer :: begg
    integer :: endg
    integer :: begl
    integer :: endl
    integer :: begc
    integer :: endc
    integer :: begp
    integer :: endp
!-----------------------------------------------------------------------

    InterpMonths1 = -999  ! saved month index
! begg,begl,begc,begp are all equal to 1
    call get_proc_bounds (begg, endg, begl, endl, begc, endc, begp, endp)
    ier = 0

    if(.not.allocated(mlai1)) allocate (mlai1(begp:endp))
    if(.not.allocated(mlai2)) allocate (mlai2(begp:endp))
    if(.not.allocated(msai1)) allocate (msai1(begp:endp))
    if(.not.allocated(msai2)) allocate (msai2(begp:endp))
    if(.not.allocated(mhvt1)) allocate (mhvt1(begp:endp))
    if(.not.allocated(mhvt2)) allocate (mhvt2(begp:endp))
    if(.not.allocated(mhvb1)) allocate (mhvb1(begp:endp))
    if(.not.allocated(mhvb2)) allocate (mhvb2(begp:endp))


!    if(.not.allocated(mlai1))allocate (mlai1(endp), mlai2(endp), &
!              msai1(endp), msai2(endp), &
!              mhvt1(endp), mhvt2(endp), &
!              mhvb1(endp), mhvb2(endp), stat=ier)

    if (ier /= 0) then
       write (6,*) 'EcosystemDynini allocation error'
       call endrun
    end if

   call CLMDebug('EcosystemDynini mark1')

    mlai1(:) = nan
    mlai2(:) = nan
    msai1(:) = nan
    msai2(:) = nan
    mhvt1(:) = nan
    mhvt2(:) = nan
    mhvb1(:) = nan
    mhvb2(:) = nan




  end subroutine EcosystemDynini

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

!
! !IROUTINE: EcosystemDyn
!
! !INTERFACE:
  subroutine EcosystemDyn(lbp, ubp, num_nolakep, filter_nolakep, doalb)
!
! !DESCRIPTION:
! Ecosystem dynamics: phenology, vegetation
! Calculates leaf areas (tlai, elai),  stem areas (tsai, esai) and
! height (htop).
!
! !USES:
    use clmtype
!
! !ARGUMENTS:
    implicit none
    integer, intent(in) :: lbp, ubp                    ! pft bounds
    integer, intent(in) :: num_nolakep                 ! number of column non-lake points in pft filter
    integer, intent(in) :: filter_nolakep(ubp-lbp+1)   ! pft filter for non-lake points
    logical, intent(in) :: doalb                       ! true = surface albedo calculation time step
!
! !CALLED FROM:
!
! !REVISION HISTORY:
! Author: Gordon Bonan
! 2/1/02, Peter Thornton: Migrated to new data structure.
!
! !LOCAL VARIABLES:
!
! local pointers to implicit in arguments
!
    integer , pointer :: pcolumn(:)  ! column index associated with each pft
    real(r8), pointer :: snowdp(:)   ! snow height (m)
!
! local pointers to implicit out arguments
!
    real(r8), pointer :: tlai(:)     ! one-sided leaf area index, no burying by snow
    real(r8), pointer :: tsai(:)     ! one-sided stem area index, no burying by snow
    real(r8), pointer :: htop(:)     ! canopy top (m)
    real(r8), pointer :: hbot(:)     ! canopy bottom (m)
    real(r8), pointer :: elai(:)     ! one-sided leaf area index with burying by snow
    real(r8), pointer :: esai(:)     ! one-sided stem area index with burying by snow
    integer , pointer :: frac_veg_nosno_alb(:) ! frac of vegetation not covered by snow [-]
!
!EOP
!
! !OTHER LOCAL VARIABLES:
!
    integer  :: fp,p,c   ! indices
    real(r8) :: ol       ! thickness of canopy layer covered by snow (m)
    real(r8) :: fb       ! fraction of canopy layer covered by snow
!-----------------------------------------------------------------------

    if (doalb) then

       ! Assign local pointers to derived type scalar members (column-level)

       snowdp  => clm3%g%l%c%cps%snowdp

       ! Assign local pointers to derived type scalar members (pftlevel)

       pcolumn => clm3%g%l%c%p%column
       tlai    => clm3%g%l%c%p%pps%tlai
       tsai    => clm3%g%l%c%p%pps%tsai
       elai    => clm3%g%l%c%p%pps%elai
       esai    => clm3%g%l%c%p%pps%esai
       htop    => clm3%g%l%c%p%pps%htop
       hbot    => clm3%g%l%c%p%pps%hbot
       frac_veg_nosno_alb => clm3%g%l%c%p%pps%frac_veg_nosno_alb

!dir$ concurrent
!cdir nodep
       do fp = 1, num_nolakep
          p = filter_nolakep(fp)
          c = pcolumn(p)

          ! need to update elai and esai only every albedo time step so do not
          ! have any inconsistency in lai and sai between SurfaceAlbedo calls (i.e.,
          ! if albedos are not done every time step).
          ! leaf phenology
          ! Set leaf and stem areas based on day of year
          ! Interpolate leaf area index, stem area index, and vegetation heights
          ! between two monthly
          ! The weights below (timwt(1) and timwt(2)) were obtained by a call to
          ! routine InterpMonthlyVeg in subroutine NCARlsm.
          !                 Field   Monthly Values
          !                -------------------------
          ! leaf area index LAI  <- mlai1 and mlai2
          ! leaf area index SAI  <- msai1 and msai2
          ! top height      HTOP <- mhvt1 and mhvt2
          ! bottom height   HBOT <- mhvb1 and mhvb2

          tlai(p) = timwt(1)*mlai1(p) + timwt(2)*mlai2(p)
          tsai(p) = timwt(1)*msai1(p) + timwt(2)*msai2(p)
          htop(p) = timwt(1)*mhvt1(p) + timwt(2)*mhvt2(p)
          hbot(p) = timwt(1)*mhvb1(p) + timwt(2)*mhvb2(p)

          ! adjust lai and sai for burying by snow. if exposed lai and sai
          ! are less than 0.05, set equal to zero to prevent numerical
          ! problems associated with very small lai and sai.

          ol = min( max(snowdp(c)-hbot(p), 0._r8), htop(p)-hbot(p))
          fb = 1. - ol / max(1.e-06_r8, htop(p)-hbot(p))
          elai(p) = max(tlai(p)*fb, 0.0_r8)
          esai(p) = max(tsai(p)*fb, 0.0_r8)
          if (elai(p) < 0.05) elai(p) = 0._r8
          if (esai(p) < 0.05) esai(p) = 0._r8

          ! Fraction of vegetation free of snow

          if ((elai(p) + esai(p)) >= 0.05) then
             frac_veg_nosno_alb(p) = 1
          else
             frac_veg_nosno_alb(p) = 0
          end if

       end do ! end of pft loop

    end if  !end of if-doalb block

  end subroutine EcosystemDyn

!-----------------------------------------------------------------------
!BOP
!
! !IROUTINE: interpMonthlyVeg
!
! !INTERFACE:
  subroutine interpMonthlyVeg (kmo, kda)


!
! !DESCRIPTION:
! Determine if 2 new months of data are to be read.
!
! !USES:
! !ARGUMENTS:
    implicit none
!
! !REVISION HISTORY:
! Created by Mariana Vertenstein
!
!EOP
!
! LOCAL VARIABLES:
    integer :: kyr         ! year (0, ...) for nstep+1
    integer :: kmo         ! month (1, ..., 12)
    integer :: kda         ! day of month (1, ..., 31)
    integer :: ksec        ! seconds into current date for nstep+1
    real(r8):: dtime       ! land model time step (sec)
    real(r8):: t           ! a fraction: kda/ndaypm
    integer :: it(2)       ! month 1 and month 2 (step 1)
    integer :: months(2)   ! months to be interpolated (1 to 12)
    integer, dimension(12) :: ndaypm= &
         (/31,28,31,30,31,30,31,31,30,31,30,31/) !days per month
!-----------------------------------------------------------------------

    t = (kda-0.5) / ndaypm(kmo)
    it(1) = t + 0.5
    it(2) = it(1) + 1
    months(1) = kmo + it(1) - 1
    months(2) = kmo + it(2) - 1
    if (months(1) <  1) months(1) = 12
    if (months(2) > 12) months(2) = 1
    timwt(1) = (it(1)+0.5) - t
    timwt(2) = 1.-timwt(1)

     


       call CLMDebug(' call readMonthlyVegetation')
       call readMonthlyVegetation(kmo, kda, months)

  end subroutine interpMonthlyVeg

!-----------------------------------------------------------------------
!BOP
!
! !IROUTINE: readMonthlyVegetation
!
! !INTERFACE:
!  subroutine readMonthlyVegetation (kmo, kda, months)

  subroutine readMonthlyVegetation(kmo, kda, months)
!
! !DESCRIPTION:
! Read monthly vegetation data for two consec. months.
!
! !USES:
    use clmtype
    use clm_varpar  , only : lsmlon, lsmlat, maxpatch_pft, maxpatch,  numpft
    use clm_varcon , only: hvt, hvb ,lai,sai
!
! !ARGUMENTS:
    implicit none
    integer, intent(in) :: kmo            ! month (1, ..., 12)
    integer, intent(in) :: kda            ! day of month (1, ..., 31)
    integer, intent(in) :: months(2)      ! months to be interpolated (1 to 12)

!
! !REVISION HISTORY:
! Created by Sam Levis
!
!EOP
!
! LOCAL VARIABLES:
    integer :: i,j,k,l,m,p,ivt            ! indices
    integer :: begg
    integer :: endg
    integer :: begl
    integer :: endl
    integer :: begc
    integer :: endc
    integer :: begp
    integer :: endp

    integer :: ier                        ! error code
!-----------------------------------------------------------------------

! begg,begl,begc,begp are all equal to 1
      call get_proc_bounds (begg, endg, begl, endl, begc, endc, begp, endp)
      do k=1,2
          do p = begp, endp
            ! i = clm3%g%l%c%p%ixy(p)
            ! j = clm3%g%l%c%p%jxy(p)
             m = clm3%g%l%c%p%mxy(p)
             ivt = clm3%g%l%c%p%itype(p)
          call CLMDebug('mark1') 
             ! Assign lai/sai/hgtt/hgtb to the top [maxpatch_pft] pfts
             ! as determined in subroutine surfrd
              
                if((m <= maxpatch_pft.and.ivt/=0).or.ivt==15.or.ivt==16)then!vegetated pft
              !  if(ivt/=0.or.ivt==15.or.ivt==16)then!vegetated pft
 
                   if (k == 1) then
                   call CLMDebug('if (k == 1) m1')
                      mlai1(p) = lai(ivt,months(k))
                   
                      msai1(p) = sai(ivt,months(k))
                      mhvt1(p) = hvt(ivt)
                      mhvb1(p) = hvb(ivt)
                   else !if (k == 2)
                   call CLMDebug('else m1')
                      mlai2(p) = lai(ivt,months(k))
                      msai2(p) = sai(ivt,months(k))
                      mhvt2(p) = hvt(ivt)
                      mhvb2(p) = hvb(ivt)
                   end if
              else  
                 call CLMDebug('non vegetated')                      ! non-vegetated pft
                    if (k == 1) then
                     call CLMDebug('if (k == 1) m2')
                     call CLMDebug('test')
                      mlai1(p) = 0_r8

                      msai1(p) = 0_r8
                      mhvt1(p) = 0_r8
                      call CLMDebug('mhvb1(p)')
                       mhvb1(p) = 0_r8

                   else !if (k == 2)
                     call CLMDebug('else m2')
                      mlai2(p) = 0.
                      msai2(p) = 0.
                      mhvt2(p) = 0.
                      mhvb2(p) = 0.
                   end if
                end if

          end do   ! end of loop over pfts

       end do   ! end of loop over months
 
   call CLMDebug('done readMonthlyVegetation')

  end subroutine readMonthlyVegetation

!-----------------------------------------------------------------------
!BOP
!
! !IROUTINE: EcosystemDyn_dealloc
!
! !INTERFACE:
  subroutine EcosystemDyn_dealloc ()
!
    implicit none
!
!EOP
!-----------------------------------------------------------------------

    if(allocated(mlai1)) deallocate (mlai1)
    if(allocated(mlai2)) deallocate (mlai2)
    if(allocated(msai1)) deallocate (msai1)
    if(allocated(msai2)) deallocate (msai2)
    if(allocated(mhvt1)) deallocate (mhvt1)
    if(allocated(mhvt2)) deallocate (mhvt2)
    if(allocated(mhvb1)) deallocate (mhvb1)
    if(allocated(mhvb2)) deallocate (mhvb2)

  end subroutine EcosystemDyn_dealloc

#endif

end module STATICEcosysDynMod

module HydrologyLakeMod

!-----------------------------------------------------------------------
!BOP
!
! !MODULE: HydrologyLakeMod
!
! !DESCRIPTION:
! Calculate lake hydrology
!
! !PUBLIC TYPES:
  implicit none
  save
!
! !PUBLIC MEMBER FUNCTIONS:
  public :: HydrologyLake
!
! !REVISION HISTORY:
! Created by Mariana Vertenstein
!
!EOP
!-----------------------------------------------------------------------

contains

!-----------------------------------------------------------------------
!BOP
!
! !IROUTINE: HydrologyLake
!
! !INTERFACE:
  subroutine HydrologyLake(lbp, ubp, num_lakep, filter_lakep)
!
! !DESCRIPTION:
! Calculate lake hydrology
!
! WARNING: This subroutine assumes lake columns have one and only one pft.
!
! !USES:
    use shr_kind_mod, only: r8 => shr_kind_r8
    use clmtype
    use clm_varcon  , only : hfus, tfrz, spval
    use globals     , only : dtime
!
! !ARGUMENTS:
    implicit none
    integer, intent(in) :: lbp, ubp                ! pft-index bounds
    integer, intent(in) :: num_lakep               ! number of pft non-lake points in pft filter
    integer, intent(in) :: filter_lakep(ubp-lbp+1) ! pft filter for non-lake points
!
! !CALLED FROM:
! subroutine clm_driver1
!
! !REVISION HISTORY:
! Author: Gordon Bonan
! 15 September 1999: Yongjiu Dai; Initial code
! 15 December 1999:  Paul Houser and Jon Radakovich; F90 Revision
! 3/4/02: Peter Thornton; Migrated to new data structures.
!
! !LOCAL VARIABLES:
!
! local pointers to implicit in arrays
!
    integer , pointer :: pcolumn(:)         !pft's column index
    integer , pointer :: pgridcell(:)       !pft's gridcell index
    real(r8), pointer :: begwb(:)         !water mass begining of the time step
    real(r8), pointer :: forc_snow(:)     !snow rate [mm/s]
    real(r8), pointer :: forc_rain(:)     !rain rate [mm/s]
    logical , pointer :: do_capsnow(:)    !true => do snow capping
    real(r8), pointer :: t_grnd(:)        !ground temperature (Kelvin)
    real(r8), pointer :: qmelt(:)         !snow melt [mm/s]
    real(r8), pointer :: qflx_evap_soi(:) !soil evaporation (mm H2O/s) (+ = to atm)
    real(r8), pointer :: qflx_evap_tot(:) !qflx_evap_soi + qflx_evap_veg + qflx_tran_veg
!
! local pointers to implicit inout arrays
!
    real(r8), pointer :: h2osno(:)        !snow water (mm H2O)
!
! local pointers to implicit out arrays
!
    real(r8), pointer :: endwb(:)         !water mass end of the time step
    real(r8), pointer :: snowdp(:)        !snow height (m)
    real(r8), pointer :: snowice(:)       !average snow ice lens
    real(r8), pointer :: snowliq(:)       !average snow liquid water
    real(r8), pointer :: eflx_snomelt(:)  !snow melt heat flux (W/m**2)
    real(r8), pointer :: qflx_infl(:)     !infiltration (mm H2O /s)
    real(r8), pointer :: qflx_snomelt(:)  !snow melt (mm H2O /s)
    real(r8), pointer :: qflx_surf(:)     !surface runoff (mm H2O /s)
    real(r8), pointer :: qflx_drain(:)    !sub-surface runoff (mm H2O /s)
    real(r8), pointer :: qflx_qrgwl(:)    !qflx_surf at glaciers, wetlands, lakes
    real(r8), pointer :: qflx_runoff(:)   !total runoff (qflx_drain+qflx_surf+qflx_qrgwl) (mm H2O /s)
    real(r8), pointer :: qflx_snwcp_ice(:)!excess snowfall due to snow capping (mm H2O /s) [+]`
    real(r8), pointer :: qflx_evap_tot_col(:) !pft quantity averaged to the column (assuming one pft)
    real(r8) ,pointer :: soilalpha(:)     !factor that reduces ground saturated specific humidity (-)
    real(r8), pointer :: zwt(:)           !water table depth
    real(r8), pointer :: fcov(:)          !fractional impermeable area
    real(r8), pointer :: fsat(:)          !fractional area with water table at surface
    real(r8), pointer :: qcharge(:)       !aquifer recharge rate (mm/s)
!
! local pointers to implicit out multi-level arrays
!
    real(r8), pointer :: rootr_column(:,:) !effective fraction of roots in each soil layer
    real(r8), pointer :: h2osoi_vol(:,:)   !volumetric soil water (0<=h2osoi_vol<=watsat) [m3/m3]
    real(r8), pointer :: h2osoi_ice(:,:)   !ice lens (kg/m2)
    real(r8), pointer :: h2osoi_liq(:,:)   !liquid water (kg/m2)
!
!
! !OTHER LOCAL VARIABLES:
!EOP
    real(r8), parameter :: snow_bd = 250._r8  !constant snow bulk density
    integer  :: fp, p, c, g    ! indices
    real(r8) :: qflx_evap_grnd ! ground surface evaporation rate (mm h2o/s)
    real(r8) :: qflx_dew_grnd  ! ground surface dew formation (mm h2o /s) [+]
    real(r8) :: qflx_sub_snow  ! sublimation rate from snow pack (mm h2o /s) [+]
    real(r8) :: qflx_dew_snow  ! surface dew added to snow pack (mm h2o /s) [+]
!-----------------------------------------------------------------------

    ! Assign local pointers to derived type gridcell members

    forc_snow    => clm_a2l%forc_snow
    forc_rain    => clm_a2l%forc_rain

    ! Assign local pointers to derived type column members

    begwb          => clm3%g%l%c%cwbal%begwb
    endwb          => clm3%g%l%c%cwbal%endwb
    do_capsnow     => clm3%g%l%c%cps%do_capsnow
    snowdp         => clm3%g%l%c%cps%snowdp
    t_grnd         => clm3%g%l%c%ces%t_grnd
    h2osno         => clm3%g%l%c%cws%h2osno
    snowice        => clm3%g%l%c%cws%snowice
    snowliq        => clm3%g%l%c%cws%snowliq
    eflx_snomelt   => clm3%g%l%c%cef%eflx_snomelt
    qmelt          => clm3%g%l%c%cwf%qmelt
    qflx_snomelt   => clm3%g%l%c%cwf%qflx_snomelt
    qflx_surf      => clm3%g%l%c%cwf%qflx_surf
    qflx_qrgwl     => clm3%g%l%c%cwf%qflx_qrgwl
    qflx_runoff    => clm3%g%l%c%cwf%qflx_runoff
    qflx_snwcp_ice => clm3%g%l%c%cwf%pwf_a%qflx_snwcp_ice
    qflx_drain     => clm3%g%l%c%cwf%qflx_drain
    qflx_infl      => clm3%g%l%c%cwf%qflx_infl
    rootr_column   => clm3%g%l%c%cps%rootr_column
    h2osoi_vol     => clm3%g%l%c%cws%h2osoi_vol
    h2osoi_ice     => clm3%g%l%c%cws%h2osoi_ice
    h2osoi_liq     => clm3%g%l%c%cws%h2osoi_liq
    qflx_evap_tot_col => clm3%g%l%c%cwf%pwf_a%qflx_evap_tot
    soilalpha      => clm3%g%l%c%cws%soilalpha
    zwt            => clm3%g%l%c%cws%zwt
    fcov           => clm3%g%l%c%cws%fcov
    fsat           => clm3%g%l%c%cws%fsat
    qcharge        => clm3%g%l%c%cws%qcharge

    ! Assign local pointers to derived type pft members

    pcolumn       => clm3%g%l%c%p%column
    pgridcell     => clm3%g%l%c%p%gridcell
    qflx_evap_soi => clm3%g%l%c%p%pwf%qflx_evap_soi
    qflx_evap_tot => clm3%g%l%c%p%pwf%qflx_evap_tot


    do fp = 1, num_lakep
       p = filter_lakep(fp)
       c = pcolumn(p)
       g = pgridcell(p)

       ! Snow on the lake ice
       ! Note that these are only local variables, as per the original
       ! Hydrology_Lake code. So even though these names correspond to
       ! variables in clmtype, this routine is not updating the
       ! values of the clmtype variables. (PET, 3/4/02)

       qflx_evap_grnd = 0._r8
       qflx_sub_snow = 0._r8
       qflx_dew_snow = 0._r8
       qflx_dew_grnd = 0._r8

       if (qflx_evap_soi(p) >= 0._r8) then

          ! Sublimation: do not allow for more sublimation than there is snow
          ! after melt.  Remaining surface evaporation used for infiltration.

          qflx_sub_snow = min(qflx_evap_soi(p), h2osno(c)/dtime-qmelt(c))
          qflx_evap_grnd = qflx_evap_soi(p) - qflx_sub_snow

       else

          if (t_grnd(c) < tfrz-0.1_r8) then
             qflx_dew_snow = abs(qflx_evap_soi(p))
          else
             qflx_dew_grnd = abs(qflx_evap_soi(p))
          end if

       end if

       ! Update snow pack

       if (do_capsnow(c)) then
          h2osno(c) = h2osno(c) - (qmelt(c) + qflx_sub_snow)*dtime
          qflx_snwcp_ice(c) = forc_snow(g) + qflx_dew_snow
       else
          h2osno(c) = h2osno(c) + (forc_snow(g)-qmelt(c)-qflx_sub_snow+qflx_dew_snow)*dtime
          qflx_snwcp_ice(c) = 0._r8
       end if
       h2osno(c) = max(h2osno(c), 0._r8)

#if (defined PERGRO)
       if (abs(h2osno(c)) < 1.e-10_r8) h2osno(c) = 0._r8
#else
       h2osno(c) = max(h2osno(c), 0._r8)
#endif

       ! No snow if lake unfrozen

       if (t_grnd(c) > tfrz) h2osno(c) = 0._r8

       ! Snow depth

       snowdp(c) = h2osno(c)/snow_bd !Assume a constant snow bulk density = 250.

       ! Determine ending water balance

       endwb(c) = h2osno(c)

       ! The following are needed for global average on history tape.
       ! Note that components that are not displayed over lake on history tape
       ! must be set to spval here

       eflx_snomelt(c)   = qmelt(c)*hfus
       qflx_infl(c)      = 0._r8
       qflx_snomelt(c)   = qmelt(c)
       qflx_surf(c)      = 0._r8
       qflx_drain(c)     = 0._r8
       rootr_column(c,:) = spval
       snowice(c)        = spval
       snowliq(c)        = spval
       soilalpha(c)      = spval
       zwt(c)            = spval
       fcov(c)           = spval
       fsat(c)           = spval
       qcharge(c)        = spval
       h2osoi_vol(c,:)   = spval
       h2osoi_ice(c,:)   = spval
       h2osoi_liq(c,:)   = spval
       qflx_qrgwl(c)     = forc_rain(g) + forc_snow(g) - qflx_evap_tot(p) - qflx_snwcp_ice(c) - &
                           (endwb(c)-begwb(c))/dtime
       qflx_runoff(c)    = qflx_drain(c) + qflx_surf(c) + qflx_qrgwl(c)

       ! The pft average must be done here for output to history tape

       qflx_evap_tot_col(c) = qflx_evap_tot(p)

    end do

  end subroutine HydrologyLake

end module HydrologyLakeMod

module Hydrology1Mod

!-----------------------------------------------------------------------
!BOP
!
! !MODULE:  Hydrology1Mod
!
! !DESCRIPTION:
! Calculation of
! (1) water storage of intercepted precipitation
! (2) direct throughfall and canopy drainage of precipitation
! (3) the fraction of foliage covered by water and the fraction
!     of foliage that is dry and transpiring.
! (4) snow layer initialization if the snow accumulation exceeds 10 mm.
!
! !PUBLIC TYPES:
   implicit none
   save
!
! !PUBLIC MEMBER FUNCTIONS:
   public :: Hydrology1
!
! !REVISION HISTORY:
! Created by Mariana Vertenstein
!
!EOP
!-----------------------------------------------------------------------

contains

!-----------------------------------------------------------------------
!BOP
!
! !IROUTINE: Hydrology1
!
! !INTERFACE:
   subroutine Hydrology1(lbc, ubc, lbp, ubp, num_nolakec, filter_nolakec, &
                         num_nolakep, filter_nolakep)
!
! !DESCRIPTION:
! Calculation of
! (1) water storage of intercepted precipitation
! (2) direct throughfall and canopy drainage of precipitation
! (3) the fraction of foliage covered by water and the fraction
!     of foliage that is dry and transpiring.
! (4) snow layer initialization if the snow accumulation exceeds 10 mm.
! Note:  The evaporation loss is taken off after the calculation of leaf
! temperature in the subroutine clm\_leaftem.f90, not in this subroutine.
!
! !USES:
    use shr_kind_mod , only : r8 => shr_kind_r8
    use clmtype
    use clm_varcon   , only : tfrz, istice, istwet, istsoil, isturb, &
                              icol_roof, icol_sunwall, icol_shadewall
#ifdef CROP
    use clm_varcon   , only : istcrop
#endif
    use FracWetMod   , only : FracWet
    use subgridAveMod, only : p2c
    use SNICARMod    , only : snw_rds_min
    use globals      , only : dtime
!
! !ARGUMENTS:
    implicit none
    integer, intent(in) :: lbp, ubp                     ! pft bounds
    integer, intent(in) :: lbc, ubc                     ! column bounds
    integer, intent(in) :: num_nolakec                  ! number of column non-lake points in column filter
    integer, intent(in) :: filter_nolakec(ubc-lbc+1)    ! column filter for non-lake points
    integer, intent(in) :: num_nolakep                  ! number of pft non-lake points in pft filter
    integer, intent(in) :: filter_nolakep(ubp-lbp+1)    ! pft filter for non-lake points
!
! !CALLED FROM:
! subroutine clm_driver1
!
! !REVISION HISTORY:
! 15 September 1999: Yongjiu Dai; Initial code
! 15 December 1999:  Paul Houser and Jon Radakovich; F90 Revision
! 2/15/02, Peter Thornton: Migrated to new data structures. Required
! adding a PFT loop.
! 4/26/05, Peter Thornton: Made the canopy interception factor fpi max=0.25
!   the default behavior
!
! !LOCAL VARIABLES:
!
! local pointers to original implicit in arrays
!
    integer , pointer :: cgridcell(:)      ! columns's gridcell
    integer , pointer :: clandunit(:)      ! columns's landunit
    integer , pointer :: pgridcell(:)      ! pft's gridcell
    integer , pointer :: plandunit(:)      ! pft's landunit
    integer , pointer :: pcolumn(:)        ! pft's column
    integer , pointer :: npfts(:)          ! number of pfts in column
    integer , pointer :: pfti(:)           ! column's beginning pft index
    integer , pointer :: ltype(:)          ! landunit type
    integer , pointer :: ctype(:)          ! column type
    real(r8), pointer :: forc_rain(:)      ! rain rate [mm/s]
    real(r8), pointer :: forc_snow(:)      ! snow rate [mm/s]
    real(r8), pointer :: forc_t(:)         ! atmospheric temperature (Kelvin)
    logical , pointer :: do_capsnow(:)     ! true => do snow capping
    real(r8), pointer :: t_grnd(:)         ! ground temperature (Kelvin)
    real(r8), pointer :: dewmx(:)          ! Maximum allowed dew [mm]
    integer , pointer :: frac_veg_nosno(:) ! fraction of veg not covered by snow (0/1 now) [-]
    real(r8), pointer :: elai(:)           ! one-sided leaf area index with burying by snow
    real(r8), pointer :: esai(:)           ! one-sided stem area index with burying by snow
    real(r8), pointer :: h2ocan_loss(:)    ! canopy water mass balance term (column)
!
! local pointers to original implicit inout arrays
!
    integer , pointer :: snl(:)            ! number of snow layers
    real(r8), pointer :: snowdp(:)         ! snow height (m)
    real(r8), pointer :: h2osno(:)         ! snow water (mm H2O)
    real(r8), pointer :: h2ocan(:)         ! total canopy water (mm H2O)
!
! local pointers to original implicit out arrays
!
    real(r8), pointer :: qflx_prec_intr(:)     ! interception of precipitation [mm/s]
    real(r8), pointer :: qflx_prec_grnd(:)     ! water onto ground including canopy runoff [kg/(m2 s)]
    real(r8), pointer :: qflx_snwcp_liq(:)     ! excess rainfall due to snow capping (mm H2O /s) [+]
    real(r8), pointer :: qflx_snwcp_ice(:)     ! excess snowfall due to snow capping (mm H2O /s) [+]
    real(r8), pointer :: qflx_snow_grnd_pft(:) ! snow on ground after interception (mm H2O/s) [+]
    real(r8), pointer :: qflx_snow_grnd_col(:) ! snow on ground after interception (mm H2O/s) [+]
    real(r8), pointer :: qflx_rain_grnd(:)     ! rain on ground after interception (mm H2O/s) [+]
    real(r8), pointer :: fwet(:)               ! fraction of canopy that is wet (0 to 1)
    real(r8), pointer :: fdry(:)               ! fraction of foliage that is green and dry [-] (new)
    real(r8), pointer :: zi(:,:)               ! interface level below a "z" level (m)
    real(r8), pointer :: dz(:,:)               ! layer depth (m)
    real(r8), pointer :: z(:,:)                ! layer thickness (m)
    real(r8), pointer :: t_soisno(:,:)         ! soil temperature (Kelvin)
    real(r8), pointer :: h2osoi_ice(:,:)       ! ice lens (kg/m2)
    real(r8), pointer :: h2osoi_liq(:,:)       ! liquid water (kg/m2)
    real(r8), pointer :: frac_iceold(:,:)      ! fraction of ice relative to the tot water
    real(r8), pointer :: snw_rds(:,:)          ! effective snow grain radius (col,lyr) [microns, m^-6]
    real(r8), pointer :: mss_bcpho(:,:)        ! mass of hydrophobic BC in snow (col,lyr) [kg]
    real(r8), pointer :: mss_bcphi(:,:)        ! mass of hydrophilic BC in snow (col,lyr) [kg]
    real(r8), pointer :: mss_bctot(:,:)        ! total mass of BC in snow (col,lyr) [kg]
    real(r8), pointer :: mss_bc_col(:)         ! total column mass of BC in snow (col,lyr) [kg]
    real(r8), pointer :: mss_bc_top(:)         ! total top-layer mass of BC (col,lyr) [kg]
    real(r8), pointer :: mss_ocpho(:,:)        ! mass of hydrophobic OC in snow (col,lyr) [kg]
    real(r8), pointer :: mss_ocphi(:,:)        ! mass of hydrophilic OC in snow (col,lyr) [kg]
    real(r8), pointer :: mss_octot(:,:)        ! total mass of OC in snow (col,lyr) [kg]
    real(r8), pointer :: mss_oc_col(:)         ! total column mass of OC in snow (col,lyr) [kg]
    real(r8), pointer :: mss_oc_top(:)         ! total top-layer mass of OC (col,lyr) [kg]
    real(r8), pointer :: mss_dst1(:,:)         ! mass of dust species 1 in snow (col,lyr) [kg]
    real(r8), pointer :: mss_dst2(:,:)         ! mass of dust species 2 in snow (col,lyr) [kg]
    real(r8), pointer :: mss_dst3(:,:)         ! mass of dust species 3 in snow (col,lyr) [kg]
    real(r8), pointer :: mss_dst4(:,:)         ! mass of dust species 4 in snow (col,lyr) [kg]
    real(r8), pointer :: mss_dsttot(:,:)       ! total mass of dust in snow (col,lyr) [kg]
    real(r8), pointer :: mss_dst_col(:)        ! total column mass of dust in snow (col,lyr) [kg]
    real(r8), pointer :: mss_dst_top(:)        ! total top-layer mass of dust in snow (col,lyr) [kg]
!
!
! !OTHER LOCAL VARIABLES:
!EOP
!
    integer  :: f                            ! filter index
    integer  :: pi                           ! pft index
    integer  :: p                            ! pft index
    integer  :: c                            ! column index
    integer  :: l                            ! landunit index
    integer  :: g                            ! gridcell index
    integer  :: newnode                      ! flag when new snow node is set, (1=yes, 0=no)
    real(r8) :: h2ocanmx                     ! maximum allowed water on canopy [mm]
    real(r8) :: fpi                          ! coefficient of interception
    real(r8) :: xrun                         ! excess water that exceeds the leaf capacity [mm/s]
    real(r8) :: dz_snowf                     ! layer thickness rate change due to precipitation [mm/s]
    real(r8) :: bifall                       ! bulk density of newly fallen dry snow [kg/m3]
    real(r8) :: fracsnow(lbp:ubp)            ! frac of precipitation that is snow
    real(r8) :: fracrain(lbp:ubp)            ! frac of precipitation that is rain
    real(r8) :: qflx_candrip(lbp:ubp)        ! rate of canopy runoff and snow falling off canopy [mm/s]
    real(r8) :: qflx_through_rain(lbp:ubp)   ! direct rain throughfall [mm/s]
    real(r8) :: qflx_through_snow(lbp:ubp)   ! direct snow throughfall [mm/s]
    real(r8) :: qflx_prec_grnd_snow(lbp:ubp) ! snow precipitation incident on ground [mm/s]
    real(r8) :: qflx_prec_grnd_rain(lbp:ubp) ! rain precipitation incident on ground [mm/s]
!-----------------------------------------------------------------------

    ! Assign local pointers to derived type members (gridcell-level)

    pgridcell          => clm3%g%l%c%p%gridcell
    forc_rain          => clm_a2l%forc_rain
    forc_snow          => clm_a2l%forc_snow
    forc_t             => clm_a2l%forc_t

    ! Assign local pointers to derived type members (landunit-level)

    ltype              => clm3%g%l%itype

    ! Assign local pointers to derived type members (column-level)

    cgridcell          => clm3%g%l%c%gridcell
    clandunit          => clm3%g%l%c%landunit
    ctype              => clm3%g%l%c%itype
    pfti               => clm3%g%l%c%pfti
    npfts              => clm3%g%l%c%npfts
    do_capsnow         => clm3%g%l%c%cps%do_capsnow
    t_grnd             => clm3%g%l%c%ces%t_grnd
    snl                => clm3%g%l%c%cps%snl
    snowdp             => clm3%g%l%c%cps%snowdp
    h2osno             => clm3%g%l%c%cws%h2osno
    zi                 => clm3%g%l%c%cps%zi
    dz                 => clm3%g%l%c%cps%dz
    z                  => clm3%g%l%c%cps%z
    frac_iceold        => clm3%g%l%c%cps%frac_iceold
    t_soisno           => clm3%g%l%c%ces%t_soisno
    h2osoi_ice         => clm3%g%l%c%cws%h2osoi_ice
    h2osoi_liq         => clm3%g%l%c%cws%h2osoi_liq
    qflx_snow_grnd_col => clm3%g%l%c%cwf%pwf_a%qflx_snow_grnd
    h2ocan_loss        => clm3%g%l%c%cwf%h2ocan_loss
    snw_rds            => clm3%g%l%c%cps%snw_rds
    mss_bcpho          => clm3%g%l%c%cps%mss_bcpho
    mss_bcphi          => clm3%g%l%c%cps%mss_bcphi
    mss_bctot          => clm3%g%l%c%cps%mss_bctot
    mss_bc_col         => clm3%g%l%c%cps%mss_bc_col
    mss_bc_top         => clm3%g%l%c%cps%mss_bc_top
    mss_ocpho          => clm3%g%l%c%cps%mss_ocpho
    mss_ocphi          => clm3%g%l%c%cps%mss_ocphi
    mss_octot          => clm3%g%l%c%cps%mss_octot
    mss_oc_col         => clm3%g%l%c%cps%mss_oc_col
    mss_oc_top         => clm3%g%l%c%cps%mss_oc_top
    mss_dst1           => clm3%g%l%c%cps%mss_dst1
    mss_dst2           => clm3%g%l%c%cps%mss_dst2
    mss_dst3           => clm3%g%l%c%cps%mss_dst3
    mss_dst4           => clm3%g%l%c%cps%mss_dst4
    mss_dsttot         => clm3%g%l%c%cps%mss_dsttot
    mss_dst_col        => clm3%g%l%c%cps%mss_dst_col
    mss_dst_top        => clm3%g%l%c%cps%mss_dst_top

    ! Assign local pointers to derived type members (pft-level)

    plandunit          => clm3%g%l%c%p%landunit
    pcolumn            => clm3%g%l%c%p%column
    dewmx              => clm3%g%l%c%p%pps%dewmx
    frac_veg_nosno     => clm3%g%l%c%p%pps%frac_veg_nosno
    elai               => clm3%g%l%c%p%pps%elai
    esai               => clm3%g%l%c%p%pps%esai
    h2ocan             => clm3%g%l%c%p%pws%h2ocan
    qflx_prec_intr     => clm3%g%l%c%p%pwf%qflx_prec_intr
    qflx_prec_grnd     => clm3%g%l%c%p%pwf%qflx_prec_grnd
    qflx_snwcp_liq     => clm3%g%l%c%p%pwf%qflx_snwcp_liq
    qflx_snwcp_ice     => clm3%g%l%c%p%pwf%qflx_snwcp_ice
    qflx_snow_grnd_pft => clm3%g%l%c%p%pwf%qflx_snow_grnd
    qflx_rain_grnd     => clm3%g%l%c%p%pwf%qflx_rain_grnd
    fwet               => clm3%g%l%c%p%pps%fwet
    fdry               => clm3%g%l%c%p%pps%fdry



    ! Start pft loop

    do f = 1, num_nolakep
       p = filter_nolakep(f)
       g = pgridcell(p)
       l = plandunit(p)
       c = pcolumn(p)
       
       ! Canopy interception and precipitation onto ground surface
       ! Add precipitation to leaf water

#ifndef CROP
       if (ltype(l)==istsoil .or. ltype(l)==istwet .or. ltype(l)==isturb)then
#else
       if (ltype(l)==istsoil .or. ltype(l)==istwet .or. ltype(l)==isturb .or. &
           ltype(l)==istcrop) then
#endif

          qflx_candrip(p) = 0._r8      ! rate of canopy runoff
          qflx_through_snow(p) = 0._r8 ! rain precipitation direct through canopy
          qflx_through_rain(p) = 0._r8 ! snow precipitation direct through canopy
          qflx_prec_intr(p) = 0._r8    ! total intercepted precipitation
          fracsnow(p) = 0._r8          ! fraction of input precip that is snow
          fracrain(p) = 0._r8          ! fraction of input precip that is rain

          if (ctype(c) /= icol_sunwall .and. ctype(c) /= icol_shadewall) then
             if (frac_veg_nosno(p) == 1 .and. (forc_rain(g) + forc_snow(g)) > 0._r8) then

                ! determine fraction of input precipitation that is snow and rain

                fracsnow(p) = forc_snow(g)/(forc_snow(g) + forc_rain(g))
                fracrain(p) = forc_rain(g)/(forc_snow(g) + forc_rain(g))
                
                ! The leaf water capacities for solid and liquid are different,
                ! generally double for snow, but these are of somewhat less
                ! significance for the water budget because of lower evap. rate at
                ! lower temperature.  Hence, it is reasonable to assume that
                ! vegetation storage of solid water is the same as liquid water.
                h2ocanmx = dewmx(p) * (elai(p) + esai(p))
                
                ! Coefficient of interception
                ! set fraction of potential interception to max 0.25
                fpi = 0.25_r8*(1._r8 - exp(-0.5_r8*(elai(p) + esai(p))))
                
                ! Direct throughfall
                qflx_through_snow(p) = forc_snow(g) * (1._r8-fpi)
                qflx_through_rain(p) = forc_rain(g) * (1._r8-fpi)
                
                ! Intercepted precipitation [mm/s]
                qflx_prec_intr(p) = (forc_snow(g) + forc_rain(g)) * fpi
                
                ! Water storage of intercepted precipitation and dew
                h2ocan(p) = max(0._r8, h2ocan(p) + dtime*qflx_prec_intr(p))
                
                ! Initialize rate of canopy runoff and snow falling off canopy
                qflx_candrip(p) = 0._r8
                
                ! Excess water that exceeds the leaf capacity
                xrun = (h2ocan(p) - h2ocanmx)/dtime
                
                ! Test on maximum dew on leaf
                ! Note if xrun > 0 then h2ocan must be at least h2ocanmx
                if (xrun > 0._r8) then
                   qflx_candrip(p) = xrun
                   h2ocan(p) = h2ocanmx
                end if
                
             end if
          end if

       else if (ltype(l) == istice) then

          h2ocan(p)            = 0._r8
          qflx_candrip(p)      = 0._r8
          qflx_through_snow(p) = 0._r8
          qflx_through_rain(p) = 0._r8
          qflx_prec_intr(p)    = 0._r8
          fracsnow(p)          = 0._r8
          fracrain(p)          = 0._r8

       end if

       ! Precipitation onto ground (kg/(m2 s))
       ! PET, 1/18/2005: Added new terms for mass balance correction
       ! due to dynamic pft weight shifting (column-level h2ocan_loss)
       ! Because the fractionation between rain and snow is indeterminate if
       ! rain + snow = 0, I am adding this very small flux only to the rain
       ! components.

       if (ctype(c) /= icol_sunwall .and. ctype(c) /= icol_shadewall) then
          if (frac_veg_nosno(p) == 0) then
             qflx_prec_grnd_snow(p) = forc_snow(g)
             qflx_prec_grnd_rain(p) = forc_rain(g) + h2ocan_loss(c)
          else
             qflx_prec_grnd_snow(p) = qflx_through_snow(p) + (qflx_candrip(p) * fracsnow(p))
             qflx_prec_grnd_rain(p) = qflx_through_rain(p) + (qflx_candrip(p) * fracrain(p)) + h2ocan_loss(c)
          end if
       ! Urban sunwall and shadewall have no intercepted precipitation
       else
          qflx_prec_grnd_snow(p) = 0.
          qflx_prec_grnd_rain(p) = 0.
       end if
       qflx_prec_grnd(p) = qflx_prec_grnd_snow(p) + qflx_prec_grnd_rain(p)

       if (do_capsnow(c)) then
          qflx_snwcp_liq(p) = qflx_prec_grnd_rain(p)
          qflx_snwcp_ice(p) = qflx_prec_grnd_snow(p)
          qflx_snow_grnd_pft(p) = 0._r8
          qflx_rain_grnd(p) = 0._r8
       else
          qflx_snwcp_liq(p) = 0._r8
          qflx_snwcp_ice(p) = 0._r8
          qflx_snow_grnd_pft(p) = qflx_prec_grnd_snow(p)           ! ice onto ground (mm/s)
          qflx_rain_grnd(p)     = qflx_prec_grnd_rain(p)           ! liquid water onto ground (mm/s)
       end if

    end do ! (end pft loop)

    ! Determine the fraction of foliage covered by water and the
    ! fraction of foliage that is dry and transpiring.

    call FracWet(num_nolakep, filter_nolakep)

    ! Update column level state variables for snow.

    call p2c(num_nolakec, filter_nolakec, qflx_snow_grnd_pft, qflx_snow_grnd_col)

    ! Determine snow height and snow water

    do f = 1, num_nolakec
       c = filter_nolakec(f)
       l = clandunit(c)
       g = cgridcell(c)

       ! Use Alta relationship, Anderson(1976); LaChapelle(1961),
       ! U.S.Department of Agriculture Forest Service, Project F,
       ! Progress Rep. 1, Alta Avalanche Study Center:Snow Layer Densification.

       if (do_capsnow(c)) then
          dz_snowf = 0._r8
       else
          if (forc_t(g) > tfrz + 2._r8) then
             bifall=50._r8 + 1.7_r8*(17.0_r8)**1.5_r8
          else if (forc_t(g) > tfrz - 15._r8) then
             bifall=50._r8 + 1.7_r8*(forc_t(g) - tfrz + 15._r8)**1.5_r8
          else
             bifall=50._r8
          end if
          dz_snowf = qflx_snow_grnd_col(c)/bifall
          snowdp(c) = snowdp(c) + dz_snowf*dtime
          h2osno(c) = h2osno(c) + qflx_snow_grnd_col(c)*dtime  ! snow water equivalent (mm)
       end if

       if (ltype(l)==istwet .and. t_grnd(c)>tfrz) then
          h2osno(c)=0._r8
          snowdp(c)=0._r8
       end if

       ! When the snow accumulation exceeds 10 mm, initialize snow layer
       ! Currently, the water temperature for the precipitation is simply set
       ! as the surface air temperature

       newnode = 0    ! flag for when snow node will be initialized
       if (snl(c) == 0 .and. qflx_snow_grnd_col(c) > 0.0_r8 .and. snowdp(c) >= 0.01_r8) then
          newnode = 1
          snl(c) = -1
          dz(c,0) = snowdp(c)                       ! meter
          z(c,0) = -0.5_r8*dz(c,0)
          zi(c,-1) = -dz(c,0)
          t_soisno(c,0) = min(tfrz, forc_t(g))      ! K
          h2osoi_ice(c,0) = h2osno(c)               ! kg/m2
          h2osoi_liq(c,0) = 0._r8                   ! kg/m2
          frac_iceold(c,0) = 1._r8
       

          ! intitialize SNICAR variables for fresh snow:
          snw_rds(c,0)    = snw_rds_min

          mss_bcpho(c,:)  = 0._r8
          mss_bcphi(c,:)  = 0._r8
          mss_bctot(c,:)  = 0._r8
          mss_bc_col(c)   = 0._r8
          mss_bc_top(c)   = 0._r8

          mss_ocpho(c,:)  = 0._r8
          mss_ocphi(c,:)  = 0._r8
          mss_octot(c,:)  = 0._r8
          mss_oc_col(c)   = 0._r8
          mss_oc_top(c)   = 0._r8

          mss_dst1(c,:)   = 0._r8
          mss_dst2(c,:)   = 0._r8
          mss_dst3(c,:)   = 0._r8
          mss_dst4(c,:)   = 0._r8
          mss_dsttot(c,:) = 0._r8
          mss_dst_col(c)  = 0._r8
          mss_dst_top(c)  = 0._r8
       end if

       ! The change of ice partial density of surface node due to precipitation.
       ! Only ice part of snowfall is added here, the liquid part will be added
       ! later.

       if (snl(c) < 0 .and. newnode == 0) then
          h2osoi_ice(c,snl(c)+1) = h2osoi_ice(c,snl(c)+1)+dtime*qflx_snow_grnd_col(c)

  
          dz(c,snl(c)+1) = dz(c,snl(c)+1)+dz_snowf*dtime
       end if

    end do

  end subroutine Hydrology1

end module Hydrology1Mod

module Hydrology2Mod

!-----------------------------------------------------------------------
!BOP
!
! !MODULE: Hydrology2Mod
!
! !DESCRIPTION:
! Calculation of soil/snow hydrology.
!
! !PUBLIC TYPES:
  implicit none
  save
!
! !PUBLIC MEMBER FUNCTIONS:
  public :: Hydrology2        ! Calculates soil/snow hydrology
!
! !REVISION HISTORY:
! 2/28/02 Peter Thornton: Migrated to new data structures.
! 7/12/03 Forrest Hoffman ,Mariana Vertenstein : Migrated to vector code
! 11/05/03 Peter Thornton: Added calculation of soil water potential
!   for use in CN phenology code.
! 04/25/07 Keith Oleson: CLM3.5 Hydrology
!
!EOP
!-----------------------------------------------------------------------

contains

!-----------------------------------------------------------------------
!BOP
!
! !IROUTINE: Hydrology2
!
! !INTERFACE:
  subroutine Hydrology2(lbc, ubc, lbp, ubp, &
                        num_nolakec, filter_nolakec, &
                        num_hydrologyc, filter_hydrologyc, &
                        num_urbanc, filter_urbanc, &
                        num_snowc, filter_snowc, &
                        num_nosnowc, filter_nosnowc)
!
! !DESCRIPTION:
! This is the main subroutine to execute the calculation of soil/snow
! hydrology
! Calling sequence is:
!  Hydrology2:                 surface hydrology driver
!    -> SnowWater:             change of snow mass and snow water onto soil
!    -> SurfaceRunoff:         surface runoff
!    -> Infiltration:          infiltration into surface soil layer
!    -> SoilWater:             soil water movement between layers
!          -> Tridiagonal      tridiagonal matrix solution
!    -> Drainage:              subsurface runoff
!    -> SnowCompaction:        compaction of snow layers
!    -> CombineSnowLayers:     combine snow layers that are thinner than minimum
!    -> DivideSnowLayers:      subdivide snow layers that are thicker than maximum
!
! !USES:
    use shr_kind_mod, only: r8 => shr_kind_r8
    use clmtype
    use clm_varcon      , only : denh2o, denice, spval, &
                                 istice, istwet, istsoil, isturb, &
                                 icol_roof, icol_road_imperv, icol_road_perv, icol_sunwall, &
                                 icol_shadewall
#ifdef CROP
    use clm_varcon      , only : istcrop
#endif
    use clm_varpar      , only : nlevgrnd, nlevsno, nlevsoi
    use SnowHydrologyMod, only : SnowCompaction, CombineSnowLayers, DivideSnowLayers, &
                                 SnowWater, BuildSnowFilter
    use SoilHydrologyMod, only : Infiltration, SoilWater, Drainage, SurfaceRunoff
    use globals         , only : nstep,dtime,is_perpetual
!
! !ARGUMENTS:
    implicit none
    integer, intent(in) :: lbc, ubc                    ! column bounds
    integer, intent(in) :: lbp, ubp                    ! pft bounds
    integer, intent(in) :: num_nolakec                 ! number of column non-lake points in column filter
    integer, intent(in) :: filter_nolakec(ubc-lbc+1)   ! column filter for non-lake points
    integer, intent(in) :: num_hydrologyc              ! number of column soil points in column filter
    integer, intent(in) :: filter_hydrologyc(ubc-lbc+1)! column filter for soil points
    integer, intent(in) :: num_urbanc                  ! number of column urban points in column filter
    integer, intent(in) :: filter_urbanc(ubc-lbc+1)    ! column filter for urban points
    integer  :: num_snowc                  ! number of column snow points
    integer  :: filter_snowc(ubc-lbc+1)    ! column filter for snow points
    integer  :: num_nosnowc                ! number of column non-snow points
    integer  :: filter_nosnowc(ubc-lbc+1)  ! column filter for non-snow points
!
! !CALLED FROM:
! subroutine clm_driver1
!
! !REVISION HISTORY:
! Created by Mariana Vertenstein
!
! !LOCAL VARIABLES:
!
! local pointers to implicit in arguments
!
    integer , pointer :: cgridcell(:)     ! column's gridcell
    integer , pointer :: clandunit(:)     ! column's landunit
    integer , pointer :: ityplun(:)       ! landunit type
    integer , pointer :: ctype(:)         ! column type
    integer , pointer :: snl(:)           ! number of snow layers
    real(r8), pointer :: h2ocan(:)        ! canopy water (mm H2O)
    real(r8), pointer :: h2osno(:)        ! snow water (mm H2O)
    real(r8), pointer :: watsat(:,:)      ! volumetric soil water at saturation (porosity)
    real(r8), pointer :: sucsat(:,:)      ! minimum soil suction (mm)
    real(r8), pointer :: bsw(:,:)         ! Clapp and Hornberger "b"
    real(r8), pointer :: z(:,:)           ! layer depth  (m)
    real(r8), pointer :: forc_rain(:)     ! rain rate [mm/s]
    real(r8), pointer :: forc_snow(:)     ! snow rate [mm/s]
    real(r8), pointer :: begwb(:)         ! water mass begining of the time step
    real(r8), pointer :: qflx_evap_tot(:) ! qflx_evap_soi + qflx_evap_veg + qflx_tran_veg
    real(r8), pointer :: bsw2(:,:)        ! Clapp and Hornberger "b" for CN code
    real(r8), pointer :: psisat(:,:)      ! soil water potential at saturation for CN code (MPa)
    real(r8), pointer :: vwcsat(:,:)      ! volumetric water content at saturation for CN code (m3/m3)
!
! local pointers to implicit inout arguments
!
    real(r8), pointer :: dz(:,:)          ! layer thickness depth (m)
    real(r8), pointer :: zi(:,:)          ! interface depth (m)
    real(r8), pointer :: zwt(:)           ! water table depth (m)
    real(r8), pointer :: fcov(:)          ! fractional impermeable area
    real(r8), pointer :: fsat(:)          ! fractional area with water table at surface
    real(r8), pointer :: wa(:)            ! water in the unconfined aquifer (mm)
    real(r8), pointer :: qcharge(:)       ! aquifer recharge rate (mm/s)
    real(r8), pointer :: smp_l(:,:)       ! soil matrix potential [mm]
    real(r8), pointer :: hk_l(:,:)        ! hydraulic conductivity (mm/s)
    real(r8), pointer :: qflx_rsub_sat(:) ! soil saturation excess [mm h2o/s]
!
! local pointers to implicit out arguments
!
    real(r8), pointer :: endwb(:)         ! water mass end of the time step
    real(r8), pointer :: wf(:)            ! soil water as frac. of whc for top 0.5 m
    real(r8), pointer :: snowice(:)       ! average snow ice lens
    real(r8), pointer :: snowliq(:)       ! average snow liquid water
    real(r8), pointer :: t_grnd(:)        ! ground temperature (Kelvin)
    real(r8), pointer :: t_soisno(:,:)    ! soil temperature (Kelvin)
    real(r8), pointer :: h2osoi_ice(:,:)  ! ice lens (kg/m2)
    real(r8), pointer :: h2osoi_liq(:,:)  ! liquid water (kg/m2)
    real(r8), pointer :: t_soi_10cm(:)         ! soil temperature in top 10cm of soil (Kelvin)
    real(r8), pointer :: h2osoi_liqice_10cm(:) ! liquid water + ice lens in top 10cm of soil (kg/m2)
    real(r8), pointer :: h2osoi_vol(:,:)  ! volumetric soil water (0<=h2osoi_vol<=watsat) [m3/m3]
    real(r8), pointer :: qflx_drain(:)    ! sub-surface runoff (mm H2O /s)
    real(r8), pointer :: qflx_surf(:)     ! surface runoff (mm H2O /s)
    real(r8), pointer :: qflx_infl(:)     ! infiltration (mm H2O /s)
    real(r8), pointer :: qflx_qrgwl(:)    ! qflx_surf at glaciers, wetlands, lakes
    real(r8), pointer :: qflx_runoff(:)   ! total runoff (qflx_drain+qflx_surf+qflx_qrgwl) (mm H2O /s)
    real(r8), pointer :: qflx_runoff_u(:) ! Urban total runoff (qflx_drain+qflx_surf) (mm H2O /s)
    real(r8), pointer :: qflx_runoff_r(:) ! Rural total runoff (qflx_drain+qflx_surf+qflx_qrgwl) (mm H2O /s)
    real(r8), pointer :: t_grnd_u(:)      ! Urban ground temperature (Kelvin)
    real(r8), pointer :: t_grnd_r(:)      ! Rural ground temperature (Kelvin)
    real(r8), pointer :: qflx_snwcp_ice(:)! excess snowfall due to snow capping (mm H2O /s) [+]`
    real(r8), pointer :: soilpsi(:,:)     ! soil water potential in each soil layer (MPa)

    real(r8), pointer :: snot_top(:)        ! snow temperature in top layer (col) [K]
    real(r8), pointer :: dTdz_top(:)        ! temperature gradient in top layer (col) [K m-1]
    real(r8), pointer :: snw_rds(:,:)       ! effective snow grain radius (col,lyr) [microns, m^-6]
    real(r8), pointer :: snw_rds_top(:)     ! effective snow grain size, top layer(col) [microns]
    real(r8), pointer :: sno_liq_top(:)     ! liquid water fraction in top snow layer (col) [frc]
    real(r8), pointer :: frac_sno(:)        ! snow cover fraction (col) [frc]
    real(r8), pointer :: h2osno_top(:)      ! mass of snow in top layer (col) [kg]

    real(r8), pointer :: mss_bcpho(:,:)     ! mass of hydrophobic BC in snow (col,lyr) [kg]
    real(r8), pointer :: mss_bcphi(:,:)     ! mass of hydrophillic BC in snow (col,lyr) [kg]
    real(r8), pointer :: mss_bctot(:,:)     ! total mass of BC (pho+phi) (col,lyr) [kg]
    real(r8), pointer :: mss_bc_col(:)      ! total mass of BC in snow column (col) [kg]
    real(r8), pointer :: mss_bc_top(:)      ! total mass of BC in top snow layer (col) [kg]
    real(r8), pointer :: mss_cnc_bcphi(:,:) ! mass concentration of BC species 1 (col,lyr) [kg/kg]
    real(r8), pointer :: mss_cnc_bcpho(:,:) ! mass concentration of BC species 2 (col,lyr) [kg/kg]
    real(r8), pointer :: mss_ocpho(:,:)     ! mass of hydrophobic OC in snow (col,lyr) [kg]
    real(r8), pointer :: mss_ocphi(:,:)     ! mass of hydrophillic OC in snow (col,lyr) [kg]
    real(r8), pointer :: mss_octot(:,:)     ! total mass of OC (pho+phi) (col,lyr) [kg]
    real(r8), pointer :: mss_oc_col(:)      ! total mass of OC in snow column (col) [kg]
    real(r8), pointer :: mss_oc_top(:)      ! total mass of OC in top snow layer (col) [kg]
    real(r8), pointer :: mss_cnc_ocphi(:,:) ! mass concentration of OC species 1 (col,lyr) [kg/kg]
    real(r8), pointer :: mss_cnc_ocpho(:,:) ! mass concentration of OC species 2 (col,lyr) [kg/kg]

    real(r8), pointer :: mss_dst1(:,:)      ! mass of dust species 1 in snow (col,lyr) [kg]
    real(r8), pointer :: mss_dst2(:,:)      ! mass of dust species 2 in snow (col,lyr) [kg]
    real(r8), pointer :: mss_dst3(:,:)      ! mass of dust species 3 in snow (col,lyr) [kg]
    real(r8), pointer :: mss_dst4(:,:)      ! mass of dust species 4 in snow (col,lyr) [kg]
    real(r8), pointer :: mss_dsttot(:,:)    ! total mass of dust in snow (col,lyr) [kg]
    real(r8), pointer :: mss_dst_col(:)     ! total mass of dust in snow column (col) [kg]
    real(r8), pointer :: mss_dst_top(:)     ! total mass of dust in top snow layer (col) [kg]
    real(r8), pointer :: mss_cnc_dst1(:,:)  ! mass concentration of dust species 1 (col,lyr) [kg/kg]
    real(r8), pointer :: mss_cnc_dst2(:,:)  ! mass concentration of dust species 2 (col,lyr) [kg/kg]
    real(r8), pointer :: mss_cnc_dst3(:,:)  ! mass concentration of dust species 3 (col,lyr) [kg/kg]
    real(r8), pointer :: mss_cnc_dst4(:,:)  ! mass concentration of dust species 4 (col,lyr) [kg/kg]
    logical , pointer :: do_capsnow(:)      ! true => do snow capping
!
!
! !OTHER LOCAL VARIABLES:
!EOP
!
    integer  :: g,l,c,j,fc                 ! indices
    real(r8) :: vol_liq(lbc:ubc,1:nlevgrnd)! partial volume of liquid water in layer
    real(r8) :: icefrac(lbc:ubc,1:nlevgrnd)! ice fraction in layer
    real(r8) :: dwat(lbc:ubc,1:nlevgrnd)   ! change in soil water
    real(r8) :: hk(lbc:ubc,1:nlevgrnd)     ! hydraulic conductivity (mm h2o/s)
    real(r8) :: dhkdw(lbc:ubc,1:nlevgrnd)  ! d(hk)/d(vol_liq)
    real(r8) :: psi,vwc,fsattmp            ! temporary variables for soilpsi calculation
#if (defined CN) || (defined CASA)
    real(r8) :: watdry                     ! temporary
    real(r8) :: rwat(lbc:ubc)              ! soil water wgted by depth to maximum depth of 0.5 m
    real(r8) :: swat(lbc:ubc)              ! same as rwat but at saturation
    real(r8) :: rz(lbc:ubc)                ! thickness of soil layers contributing to rwat (m)
    real(r8) :: tsw                        ! volumetric soil water to 0.5 m
    real(r8) :: stsw                       ! volumetric soil water to 0.5 m at saturation
#endif
    real(r8) :: snowmass                   ! liquid+ice snow mass in a layer [kg/m2]
    real(r8) :: snowcap_scl_fct            ! temporary factor used to correct for snow capping
    real(r8) :: fracl                      ! fraction of soil layer contributing to 10cm total soil water

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

    ! Assign local pointers to derived subtypes components (gridcell-level)

    forc_rain => clm_a2l%forc_rain
    forc_snow => clm_a2l%forc_snow

    ! Assign local pointers to derived subtypes components (landunit-level)

    ityplun => clm3%g%l%itype

    ! Assign local pointers to derived subtypes components (column-level)

    cgridcell         => clm3%g%l%c%gridcell
    clandunit         => clm3%g%l%c%landunit
    ctype             => clm3%g%l%c%itype
    snl               => clm3%g%l%c%cps%snl
    t_grnd            => clm3%g%l%c%ces%t_grnd
    h2ocan            => clm3%g%l%c%cws%pws_a%h2ocan
    h2osno            => clm3%g%l%c%cws%h2osno
    wf                => clm3%g%l%c%cps%wf
    snowice           => clm3%g%l%c%cws%snowice
    snowliq           => clm3%g%l%c%cws%snowliq
    zwt               => clm3%g%l%c%cws%zwt
    fcov              => clm3%g%l%c%cws%fcov
    fsat              => clm3%g%l%c%cws%fsat
    wa                => clm3%g%l%c%cws%wa
    qcharge           => clm3%g%l%c%cws%qcharge
    watsat            => clm3%g%l%c%cps%watsat
    sucsat            => clm3%g%l%c%cps%sucsat
    bsw               => clm3%g%l%c%cps%bsw
    z                 => clm3%g%l%c%cps%z
    dz                => clm3%g%l%c%cps%dz
    zi                => clm3%g%l%c%cps%zi
    t_soisno          => clm3%g%l%c%ces%t_soisno
    h2osoi_ice        => clm3%g%l%c%cws%h2osoi_ice
    h2osoi_liq        => clm3%g%l%c%cws%h2osoi_liq
    h2osoi_vol        => clm3%g%l%c%cws%h2osoi_vol
    t_soi_10cm         => clm3%g%l%c%ces%t_soi_10cm
    h2osoi_liqice_10cm => clm3%g%l%c%cws%h2osoi_liqice_10cm
    qflx_evap_tot     => clm3%g%l%c%cwf%pwf_a%qflx_evap_tot
    qflx_drain        => clm3%g%l%c%cwf%qflx_drain
    qflx_surf         => clm3%g%l%c%cwf%qflx_surf
    qflx_infl         => clm3%g%l%c%cwf%qflx_infl
    qflx_qrgwl        => clm3%g%l%c%cwf%qflx_qrgwl
    endwb             => clm3%g%l%c%cwbal%endwb
    begwb             => clm3%g%l%c%cwbal%begwb
    bsw2              => clm3%g%l%c%cps%bsw2
    psisat            => clm3%g%l%c%cps%psisat
    vwcsat            => clm3%g%l%c%cps%vwcsat
    soilpsi           => clm3%g%l%c%cps%soilpsi
    smp_l             => clm3%g%l%c%cws%smp_l
    hk_l              => clm3%g%l%c%cws%hk_l
    qflx_rsub_sat     => clm3%g%l%c%cwf%qflx_rsub_sat
    qflx_runoff       => clm3%g%l%c%cwf%qflx_runoff
    qflx_runoff_u     => clm3%g%l%c%cwf%qflx_runoff_u
    qflx_runoff_r     => clm3%g%l%c%cwf%qflx_runoff_r
    t_grnd_u          => clm3%g%l%c%ces%t_grnd_u
    t_grnd_r          => clm3%g%l%c%ces%t_grnd_r
    snot_top          => clm3%g%l%c%cps%snot_top
    dTdz_top          => clm3%g%l%c%cps%dTdz_top
    snw_rds           => clm3%g%l%c%cps%snw_rds    
    snw_rds_top       => clm3%g%l%c%cps%snw_rds_top
    sno_liq_top       => clm3%g%l%c%cps%sno_liq_top
    frac_sno          => clm3%g%l%c%cps%frac_sno
    h2osno_top        => clm3%g%l%c%cps%h2osno_top
    mss_bcpho         => clm3%g%l%c%cps%mss_bcpho
    mss_bcphi         => clm3%g%l%c%cps%mss_bcphi
    mss_bctot         => clm3%g%l%c%cps%mss_bctot
    mss_bc_col        => clm3%g%l%c%cps%mss_bc_col
    mss_bc_top        => clm3%g%l%c%cps%mss_bc_top
    mss_cnc_bcphi     => clm3%g%l%c%cps%mss_cnc_bcphi
    mss_cnc_bcpho     => clm3%g%l%c%cps%mss_cnc_bcpho
    mss_ocpho         => clm3%g%l%c%cps%mss_ocpho
    mss_ocphi         => clm3%g%l%c%cps%mss_ocphi
    mss_octot         => clm3%g%l%c%cps%mss_octot
    mss_oc_col        => clm3%g%l%c%cps%mss_oc_col
    mss_oc_top        => clm3%g%l%c%cps%mss_oc_top
    mss_cnc_ocphi     => clm3%g%l%c%cps%mss_cnc_ocphi
    mss_cnc_ocpho     => clm3%g%l%c%cps%mss_cnc_ocpho
    mss_dst1          => clm3%g%l%c%cps%mss_dst1
    mss_dst2          => clm3%g%l%c%cps%mss_dst2
    mss_dst3          => clm3%g%l%c%cps%mss_dst3
    mss_dst4          => clm3%g%l%c%cps%mss_dst4
    mss_dsttot        => clm3%g%l%c%cps%mss_dsttot
    mss_dst_col       => clm3%g%l%c%cps%mss_dst_col
    mss_dst_top       => clm3%g%l%c%cps%mss_dst_top
    mss_cnc_dst1      => clm3%g%l%c%cps%mss_cnc_dst1
    mss_cnc_dst2      => clm3%g%l%c%cps%mss_cnc_dst2
    mss_cnc_dst3      => clm3%g%l%c%cps%mss_cnc_dst3
    mss_cnc_dst4      => clm3%g%l%c%cps%mss_cnc_dst4
    qflx_snwcp_ice    => clm3%g%l%c%cwf%pwf_a%qflx_snwcp_ice
    do_capsnow        => clm3%g%l%c%cps%do_capsnow

    ! Determine time step and step size

    ! Determine initial snow/no-snow filters (will be modified possibly by
    ! routines CombineSnowLayers and DivideSnowLayers below

    call BuildSnowFilter(lbc, ubc, num_nolakec, filter_nolakec, &
         num_snowc, filter_snowc, num_nosnowc, filter_nosnowc)

    ! Determine the change of snow mass and the snow water onto soil

    call SnowWater(lbc, ubc, num_snowc, filter_snowc, num_nosnowc, filter_nosnowc)

    ! Determine soil hydrology

    call SurfaceRunoff(lbc, ubc, lbp, ubp, num_hydrologyc, filter_hydrologyc, &
                       num_urbanc, filter_urbanc, &
                       vol_liq, icefrac )

  

    call Infiltration(lbc, ubc,  num_hydrologyc, filter_hydrologyc, &
                      num_urbanc, filter_urbanc)




    call SoilWater(lbc, ubc, num_hydrologyc, filter_hydrologyc, &
                   num_urbanc, filter_urbanc, &
                   vol_liq, dwat, hk, dhkdw)



    call Drainage(lbc, ubc, num_hydrologyc, filter_hydrologyc, &
                  num_urbanc, filter_urbanc, &
                  vol_liq, hk, icefrac)


    if (.not. is_perpetual) then

       ! Natural compaction and metamorphosis.

       call SnowCompaction(lbc, ubc, num_snowc, filter_snowc)



       ! Combine thin snow elements

       call CombineSnowLayers(lbc, ubc, num_snowc, filter_snowc)


       ! Divide thick snow elements

       call DivideSnowLayers(lbc, ubc, num_snowc, filter_snowc)


    else

       do fc = 1, num_snowc
          c = filter_snowc(fc)
          h2osno(c) = 0._r8
       end do
       do j = -nlevsno+1,0
          do fc = 1, num_snowc
             c = filter_snowc(fc)
             if (j >= snl(c)+1) then
                h2osno(c) = h2osno(c) + h2osoi_ice(c,j) + h2osoi_liq(c,j)
             end if
          end do
       end do

    end if

    ! Set empty snow layers to zero

    do j = -nlevsno+1,0
       do fc = 1, num_snowc
          c = filter_snowc(fc)
          if (j <= snl(c) .and. snl(c) > -nlevsno) then
             h2osoi_ice(c,j) = 0._r8
             h2osoi_liq(c,j) = 0._r8
             t_soisno(c,j) = 0._r8
             dz(c,j) = 0._r8
             z(c,j) = 0._r8
             zi(c,j-1) = 0._r8
          end if
       end do
    end do



    ! Build new snow filter

    call BuildSnowFilter(lbc, ubc, num_nolakec, filter_nolakec, &
         num_snowc, filter_snowc, num_nosnowc, filter_nosnowc)

    ! Vertically average t_soisno and sum of h2osoi_liq and h2osoi_ice
    ! over all snow layers for history output

    do fc = 1, num_snowc
       c = filter_snowc(fc)
       snowice(c) = 0._r8
       snowliq(c) = 0._r8
    end do
    do fc = 1, num_nosnowc
       c = filter_nosnowc(fc)
       snowice(c) = spval
       snowliq(c) = spval
    end do

    do j = -nlevsno+1, 0
       do fc = 1, num_snowc
          c = filter_snowc(fc)
          if (j >= snl(c)+1) then
             snowice(c) = snowice(c) + h2osoi_ice(c,j)
             snowliq(c) = snowliq(c) + h2osoi_liq(c,j)
          end if
       end do
    end do

    ! Determine ground temperature, ending water balance and volumetric soil water
    ! Calculate soil temperature and total water (liq+ice) in top 10cm of soil
    do fc = 1, num_nolakec
       c = filter_nolakec(fc)
       l = clandunit(c)
       if (ityplun(l) /= isturb) then
          t_soi_10cm(c) = 0._r8
          h2osoi_liqice_10cm(c) = 0._r8
       end if
    end do
    do j = 1, nlevsoi
       do fc = 1, num_nolakec
          c = filter_nolakec(fc)
          l = clandunit(c)
          if (ityplun(l) /= isturb) then
            if (zi(c,j) <= 0.1_r8) then
              fracl = 1._r8
              t_soi_10cm(c) = t_soi_10cm(c) + t_soisno(c,j)*dz(c,j)*fracl
              h2osoi_liqice_10cm(c) = h2osoi_liqice_10cm(c) + (h2osoi_liq(c,j)+h2osoi_ice(c,j))* &
                                       fracl
            else
              if (zi(c,j) > 0.1_r8 .and. zi(c,j-1) .lt. 0.1_r8) then
                 fracl = (0.1_r8 - zi(c,j-1))/dz(c,j)
                 t_soi_10cm(c) = t_soi_10cm(c) + t_soisno(c,j)*dz(c,j)*fracl
                 h2osoi_liqice_10cm(c) = h2osoi_liqice_10cm(c) + (h2osoi_liq(c,j)+h2osoi_ice(c,j))* &
                                          fracl
              end if
            end if
          end if
       end do
    end do

    do fc = 1, num_nolakec
       
       c = filter_nolakec(fc)
       l = clandunit(c)

       t_grnd(c) = t_soisno(c,snl(c)+1)
       if (ityplun(l) /= isturb) then
          t_soi_10cm(c) = t_soi_10cm(c)/0.1_r8
       end if
       if (ityplun(l)==isturb) then
         t_grnd_u(c) = t_soisno(c,snl(c)+1)
       end if
#ifndef CROP
       if (ityplun(l)==istsoil) then
#else
       if (ityplun(l)==istsoil .or. ityplun(l)==istcrop) then
#endif
         t_grnd_r(c) = t_soisno(c,snl(c)+1)
       end if
       if (ctype(c) == icol_roof .or. ctype(c) == icol_sunwall &
          .or. ctype(c) == icol_shadewall .or. ctype(c) == icol_road_imperv) then
         endwb(c) = h2ocan(c) + h2osno(c)
       else
         endwb(c) = h2ocan(c) + h2osno(c) + wa(c)
       end if
    end do

    do j = 1, nlevgrnd
       do fc = 1, num_nolakec
          c = filter_nolakec(fc)
          endwb(c) = endwb(c) + h2osoi_ice(c,j) + h2osoi_liq(c,j)
          h2osoi_vol(c,j) = h2osoi_liq(c,j)/(dz(c,j)*denh2o) + h2osoi_ice(c,j)/(dz(c,j)*denice)
       end do
    end do

    ! Determine wetland and land ice hydrology (must be placed here
    ! since need snow updated from CombineSnowLayers)

    do fc = 1,num_nolakec
       c = filter_nolakec(fc)
       l = clandunit(c)
       g = cgridcell(c)
       if (ityplun(l)==istwet .or. ityplun(l)==istice) then
          qflx_drain(c) = 0._r8
          qflx_surf(c)  = 0._r8
          qflx_infl(c)  = 0._r8
          qflx_qrgwl(c) = forc_rain(g) + forc_snow(g) - qflx_evap_tot(c) - qflx_snwcp_ice(c) - &
                          (endwb(c)-begwb(c))/dtime
          fcov(c)       = spval
          fsat(c)       = spval
          qcharge(c)    = spval
          qflx_rsub_sat(c) = spval
       else if (ityplun(l) == isturb .and. ctype(c) /= icol_road_perv) then
          fcov(c)       = spval
          fsat(c)       = spval
          qcharge(c)    = spval
          qflx_rsub_sat(c) = spval
       end if

       qflx_runoff(c) = qflx_drain(c) + qflx_surf(c) + qflx_qrgwl(c)
       if (ityplun(l)==isturb) then
         qflx_runoff_u(c) = qflx_drain(c) + qflx_surf(c)
#ifndef CROP
       else if (ityplun(l)==istsoil) then
#else
       else if (ityplun(l)==istsoil .or. ityplun(l)==istcrop) then
#endif
         qflx_runoff_r(c) = qflx_drain(c) + qflx_surf(c) + qflx_qrgwl(c)
       end if
    end do

#if (defined CN) || (defined CASA)
    do j = 1, nlevgrnd
       do fc = 1, num_hydrologyc
          c = filter_hydrologyc(fc)
          
          if (h2osoi_liq(c,j) > 0._r8) then
             vwc = h2osoi_liq(c,j)/(dz(c,j)*denh2o)
            
             ! the following limit set to catch very small values of 
             ! fractional saturation that can crash the calculation of psi
           
             fsattmp = max(vwc/vwcsat(c,j), 0.001_r8)
             psi = psisat(c,j) * (fsattmp)**bsw2(c,j)
             soilpsi(c,j) = min(max(psi,-15.0_r8),0._r8)
          else 
             soilpsi(c,j) = -15.0_r8
          end if
       end do
    end do
#endif

#if (defined CN) || (defined CASA)
    ! Available soil water up to a depth of 0.5 m.
    ! Potentially available soil water (=whc) up to a depth of 0.5 m.
    ! Water content as fraction of whc up to a depth of 0.5 m.

    do fc = 1, num_hydrologyc
       c = filter_hydrologyc(fc)
       rwat(c) = 0._r8
       swat(c) = 0._r8
       rz(c)   = 0._r8
    end do

    do j = 1, nlevgrnd
       do fc = 1, num_hydrologyc
          c = filter_hydrologyc(fc)
          !if (z(c,j)+0.5_r8*dz(c,j) <= 0.5_r8) then
          if (z(c,j)+0.5_r8*dz(c,j) <= 0.05_r8) then
             watdry = watsat(c,j) * (316230._r8/sucsat(c,j)) ** (-1._r8/bsw(c,j))
             rwat(c) = rwat(c) + (h2osoi_vol(c,j)-watdry) * dz(c,j)
             swat(c) = swat(c) + (watsat(c,j)    -watdry) * dz(c,j)
             rz(c) = rz(c) + dz(c,j)
          end if
       end do
    end do

    do fc = 1, num_hydrologyc
       c = filter_hydrologyc(fc)
       if (rz(c) /= 0._r8) then
          tsw  = rwat(c)/rz(c)
          stsw = swat(c)/rz(c)
       else
          watdry = watsat(c,1) * (316230._r8/sucsat(c,1)) ** (-1._r8/bsw(c,1))
          tsw = h2osoi_vol(c,1) - watdry
          stsw = watsat(c,1) - watdry
       end if
       wf(c) = tsw/stsw
    end do
#endif


    !  Calculate column-integrated aerosol masses, and
    !  mass concentrations for radiative calculations and output
    !  (based on new snow level state, after SnowFilter is rebuilt.
    !  NEEDS TO BE AFTER SnowFiler is rebuilt, otherwise there 
    !  can be zero snow layers but an active column in filter)

    do fc = 1, num_snowc
       c = filter_snowc(fc)

       ! Zero column-integrated aerosol mass before summation
       mss_bc_col(c)  = 0._r8
       mss_oc_col(c)  = 0._r8
       mss_dst_col(c) = 0._r8

       do j = -nlevsno+1, 0

          ! layer mass of snow:
          snowmass = h2osoi_ice(c,j)+h2osoi_liq(c,j)

          ! Correct the top layer aerosol mass to account for snow capping. 
          ! This approach conserves the aerosol mass concentration
          ! (but not the aerosol amss) when snow-capping is invoked

          if (j == snl(c)+1) then
             if (do_capsnow(c)) then
                snowcap_scl_fct = snowmass / (snowmass+(qflx_snwcp_ice(c)*dtime))

                mss_bcpho(c,j) = mss_bcpho(c,j)*snowcap_scl_fct
                mss_bcphi(c,j) = mss_bcphi(c,j)*snowcap_scl_fct
                mss_ocpho(c,j) = mss_ocpho(c,j)*snowcap_scl_fct
                mss_ocphi(c,j) = mss_ocphi(c,j)*snowcap_scl_fct
                
                mss_dst1(c,j)  = mss_dst1(c,j)*snowcap_scl_fct
                mss_dst2(c,j)  = mss_dst2(c,j)*snowcap_scl_fct
                mss_dst3(c,j)  = mss_dst3(c,j)*snowcap_scl_fct
                mss_dst4(c,j)  = mss_dst4(c,j)*snowcap_scl_fct 
             endif
          endif

          if (j >= snl(c)+1) then
             mss_bctot(c,j)     = mss_bcpho(c,j) + mss_bcphi(c,j)
             mss_bc_col(c)      = mss_bc_col(c)  + mss_bctot(c,j)
             mss_cnc_bcphi(c,j) = mss_bcphi(c,j) / snowmass
             mss_cnc_bcpho(c,j) = mss_bcpho(c,j) / snowmass

             mss_octot(c,j)     = mss_ocpho(c,j) + mss_ocphi(c,j)
             mss_oc_col(c)      = mss_oc_col(c)  + mss_octot(c,j)
             mss_cnc_ocphi(c,j) = mss_ocphi(c,j) / snowmass
             mss_cnc_ocpho(c,j) = mss_ocpho(c,j) / snowmass
             
             mss_dsttot(c,j)    = mss_dst1(c,j)  + mss_dst2(c,j) + mss_dst3(c,j) + mss_dst4(c,j)
             mss_dst_col(c)     = mss_dst_col(c) + mss_dsttot(c,j)
             mss_cnc_dst1(c,j)  = mss_dst1(c,j)  / snowmass
             mss_cnc_dst2(c,j)  = mss_dst2(c,j)  / snowmass
             mss_cnc_dst3(c,j)  = mss_dst3(c,j)  / snowmass
             mss_cnc_dst4(c,j)  = mss_dst4(c,j)  / snowmass
         
          else
             !set variables of empty snow layers to zero
             snw_rds(c,j)       = 0._r8

             mss_bcpho(c,j)     = 0._r8
             mss_bcphi(c,j)     = 0._r8
             mss_bctot(c,j)     = 0._r8
             mss_cnc_bcphi(c,j) = 0._r8
             mss_cnc_bcpho(c,j) = 0._r8

             mss_ocpho(c,j)     = 0._r8
             mss_ocphi(c,j)     = 0._r8
             mss_octot(c,j)     = 0._r8
             mss_cnc_ocphi(c,j) = 0._r8
             mss_cnc_ocpho(c,j) = 0._r8

             mss_dst1(c,j)      = 0._r8
             mss_dst2(c,j)      = 0._r8
             mss_dst3(c,j)      = 0._r8
             mss_dst4(c,j)      = 0._r8
             mss_dsttot(c,j)    = 0._r8
             mss_cnc_dst1(c,j)  = 0._r8
             mss_cnc_dst2(c,j)  = 0._r8
             mss_cnc_dst3(c,j)  = 0._r8
             mss_cnc_dst4(c,j)  = 0._r8
          endif
       enddo
       
       ! top-layer diagnostics
       h2osno_top(c)  = h2osoi_ice(c,snl(c)+1) + h2osoi_liq(c,snl(c)+1)
       mss_bc_top(c)  = mss_bctot(c,snl(c)+1)
       mss_oc_top(c)  = mss_octot(c,snl(c)+1)
       mss_dst_top(c) = mss_dsttot(c,snl(c)+1)
    enddo
    
    ! Zero mass variables in columns without snow
    do fc = 1, num_nosnowc
       c = filter_nosnowc(fc)
            
       h2osno_top(c)      = 0._r8
       snw_rds(c,:)       = 0._r8

       mss_bc_top(c)      = 0._r8
       mss_bc_col(c)      = 0._r8    
       mss_bcpho(c,:)     = 0._r8
       mss_bcphi(c,:)     = 0._r8
       mss_bctot(c,:)     = 0._r8
       mss_cnc_bcphi(c,:) = 0._r8
       mss_cnc_bcpho(c,:) = 0._r8

       mss_oc_top(c)      = 0._r8
       mss_oc_col(c)      = 0._r8    
       mss_ocpho(c,:)     = 0._r8
       mss_ocphi(c,:)     = 0._r8
       mss_octot(c,:)     = 0._r8
       mss_cnc_ocphi(c,:) = 0._r8
       mss_cnc_ocpho(c,:) = 0._r8

       mss_dst_top(c)     = 0._r8
       mss_dst_col(c)     = 0._r8
       mss_dst1(c,:)      = 0._r8
       mss_dst2(c,:)      = 0._r8
       mss_dst3(c,:)      = 0._r8
       mss_dst4(c,:)      = 0._r8
       mss_dsttot(c,:)    = 0._r8
       mss_cnc_dst1(c,:)  = 0._r8
       mss_cnc_dst2(c,:)  = 0._r8
       mss_cnc_dst3(c,:)  = 0._r8
       mss_cnc_dst4(c,:)  = 0._r8

       ! top-layer diagnostics (spval is not averaged when computing history fields)
       snot_top(c)        = spval
       dTdz_top(c)        = spval
       snw_rds_top(c)     = spval
       sno_liq_top(c)     = spval
    enddo

  end subroutine Hydrology2

end module Hydrology2Mod

module DriverInitMod

!-----------------------------------------------------------------------
!BOP
!
! !MODULE: clm_driverInitMod
!
! !DESCRIPTION:
! Initialization of clm driver variables needed from previous timestep
!
! !PUBLIC TYPES:
  implicit none
  save
!
! !PUBLIC MEMBER FUNCTIONS:
  public :: DriverInit
!
! !REVISION HISTORY:
! Created by Mariana Vertenstein
!
!EOP
!-----------------------------------------------------------------------

contains

!-----------------------------------------------------------------------
!BOP
!
! !IROUTINE: clm_driverInit
!
! !INTERFACE:
  subroutine DriverInit(lbc, ubc, lbp, ubp, &
             num_nolakec, filter_nolakec, num_lakec, filter_lakec)
!
! !DESCRIPTION:
! Initialization of clm driver variables needed from previous timestep
!
! !USES:
    use shr_kind_mod , only : r8 => shr_kind_r8
    use clmtype
    use clm_varpar   , only : nlevsno
    use subgridAveMod, only : p2c

!
! !ARGUMENTS:
    implicit none
    integer, intent(in) :: lbc, ubc                    ! column-index bounds
    integer, intent(in) :: lbp, ubp                    ! pft-index bounds
    integer, intent(in) :: num_nolakec                 ! number of column non-lake points in column filter
    integer, intent(in) :: filter_nolakec(ubc-lbc+1)   ! column filter for non-lake points
    integer, intent(in) :: num_lakec                   ! number of column non-lake points in column filter
    integer, intent(in) :: filter_lakec(ubc-lbc+1)     ! column filter for non-lake points
!
! !CALLED FROM:
! subroutine driver1
!
! !REVISION HISTORY:
! Created by Mariana Vertenstein
!
!
! !LOCAL VARIABLES:
!
! local pointers to original implicit in variables
!
    real(r8), pointer :: pwtgcell(:)           ! weight of pft wrt corresponding gridcell
    integer , pointer :: snl(:)                ! number of snow layers
    real(r8), pointer :: h2osno(:)             ! snow water (mm H2O)
    integer , pointer :: frac_veg_nosno_alb(:) ! fraction of vegetation not covered by snow (0 OR 1) [-]
    integer , pointer :: frac_veg_nosno(:)     ! fraction of vegetation not covered by snow (0 OR 1 now) [-] (pft-level)
    real(r8), pointer :: h2osoi_ice(:,:)       ! ice lens (kg/m2)
    real(r8), pointer :: h2osoi_liq(:,:)       ! liquid water (kg/m2)
!
! local pointers to original implicit out variables
!
    logical , pointer :: do_capsnow(:)         ! true => do snow capping
    real(r8), pointer :: h2osno_old(:)         ! snow water (mm H2O) at previous time step
    real(r8), pointer :: frac_iceold(:,:)      ! fraction of ice relative to the tot water
!
! !OTHER LOCAL VARIABLES:
!EOP
!
    integer :: c, p, f, j, fc            ! indices
!-----------------------------------------------------------------------

    ! Assign local pointers to derived type members (column-level)

    snl                => clm3%g%l%c%cps%snl
    h2osno             => clm3%g%l%c%cws%h2osno
    h2osno_old         => clm3%g%l%c%cws%h2osno_old
    do_capsnow         => clm3%g%l%c%cps%do_capsnow
    frac_iceold        => clm3%g%l%c%cps%frac_iceold
    h2osoi_ice         => clm3%g%l%c%cws%h2osoi_ice
    h2osoi_liq         => clm3%g%l%c%cws%h2osoi_liq
    frac_veg_nosno_alb => clm3%g%l%c%p%pps%frac_veg_nosno_alb
    frac_veg_nosno     => clm3%g%l%c%p%pps%frac_veg_nosno

    ! Assign local pointers to derived type members (pft-level)

    pwtgcell           => clm3%g%l%c%p%wtgcell

    do c = lbc, ubc

      ! Save snow mass at previous time step
      h2osno_old(c) = h2osno(c)

      ! Decide whether to cap snow
      if (h2osno(c) > 1000._r8) then
         do_capsnow(c) = .true.
      else
         do_capsnow(c) = .false.
      end if

    end do

    ! Initialize fraction of vegetation not covered by snow (pft-level)

    do p = lbp,ubp
       if (pwtgcell(p)>0._r8) then
          frac_veg_nosno(p) = frac_veg_nosno_alb(p)
       else
          frac_veg_nosno(p) = 0._r8
       end if
    end do

    ! Initialize set of previous time-step variables
    ! Ice fraction of snow at previous time step

    do j = -nlevsno+1,0
      do f = 1, num_nolakec
         c = filter_nolakec(f)
         if (j >= snl(c) + 1) then
            frac_iceold(c,j) = h2osoi_ice(c,j)/(h2osoi_liq(c,j)+h2osoi_ice(c,j))
         end if
      end do
    end do

  end subroutine DriverInit

end module DriverInitMod

module CanopyFluxesMod

!------------------------------------------------------------------------------
!BOP
!
! !MODULE: CanopyFluxesMod
!
! !DESCRIPTION:
! Calculates the leaf temperature and the leaf fluxes,
! transpiration, photosynthesis and  updates the dew
! accumulation due to evaporation.
!
! !USES:
!
! !PUBLIC TYPES:
   implicit none
   save
!
! !PUBLIC MEMBER FUNCTIONS:
   public :: CanopyFluxes !Calculates the leaf temperature and leaf fluxes
!
! !PRIVATE MEMBER FUNCTIONS:
   private :: Stomata     !Leaf stomatal resistance and leaf photosynthesis
!
! !REVISION HISTORY:
! Created by Mariana Vertenstein
! 4/25/05, Peter Thornton: replaced old Stomata subroutine with what
!   used to be called StomataCN, as part of migration to new sun/shade
!   algorithms. 
!
!EOP
!------------------------------------------------------------------------------

contains

!------------------------------------------------------------------------------
!BOP
!
! !IROUTINE: CanopyFluxes 
!
! !INTERFACE:
  subroutine CanopyFluxes(lbg, ubg, lbc, ubc, lbp, ubp, &
                          num_nolakep, filter_nolakep)
!
! !DESCRIPTION:
! 1. Calculates the leaf temperature:
! 2. Calculates the leaf fluxes, transpiration, photosynthesis and
!    updates the dew accumulation due to evaporation.
!
! Method:
! Use the Newton-Raphson iteration to solve for the foliage
! temperature that balances the surface energy budget:
!
! f(t_veg) = Net radiation - Sensible - Latent = 0
! f(t_veg) + d(f)/d(t_veg) * dt_veg = 0     (*)
!
! Note:
! (1) In solving for t_veg, t_grnd is given from the previous timestep.
! (2) The partial derivatives of aerodynamical resistances, which cannot
!     be determined analytically, are ignored for d(H)/dT and d(LE)/dT
! (3) The weighted stomatal resistance of sunlit and shaded foliage is used
! (4) Canopy air temperature and humidity are derived from => Hc + Hg = Ha
!                                                          => Ec + Eg = Ea
! (5) Energy loss is due to: numerical truncation of energy budget equation
!     (*); and "ecidif" (see the code) which is dropped into the sensible
!     heat
! (6) The convergence criteria: the difference, del = t_veg(n+1)-t_veg(n)
!     and del2 = t_veg(n)-t_veg(n-1) less than 0.01 K, and the difference
!     of water flux from the leaf between the iteration step (n+1) and (n)
!     less than 0.1 W/m2; or the iterative steps over 40.
!
! !USES:
    use shr_kind_mod       , only : r8 => shr_kind_r8
    use clmtype
    use clm_varpar         , only : nlevgrnd, nlevsno
    use clm_varcon         , only : sb, cpair, hvap, vkc, grav, denice, &
                                    denh2o, tfrz, csoilc, tlsai_crit, alpha_aero
    use QSatMod            , only : QSat
    use FrictionVelocityMod, only : FrictionVelocity, MoninObukIni
    use globals            , only : dtime
!
! !ARGUMENTS:
    implicit none
    integer, intent(in) :: lbg, ubg                    ! gridcell bounds
    integer, intent(in) :: lbc, ubc                    ! column bounds
    integer, intent(in) :: lbp, ubp                    ! pft bounds
    integer, intent(in) :: num_nolakep                 ! number of column non-lake points in pft filter
    integer, intent(in) :: filter_nolakep(ubp-lbp+1)   ! pft filter for non-lake points
!
! !CALLED FROM:
! subroutine Biogeophysics1 in module Biogeophysics1Mod
!
! !REVISION HISTORY:
! 15 September 1999: Yongjiu Dai; Initial code
! 15 December 1999:  Paul Houser and Jon Radakovich; F90 Revision
! 12/19/01, Peter Thornton
! Changed tg to t_grnd for consistency with other routines
! 1/29/02, Peter Thornton
! Migrate to new data structures, new calling protocol. For now co2 and
! o2 partial pressures are hardwired, but they should be coming in from
! forc_pco2 and forc_po2. Keeping the same hardwired values as in CLM2 to
! assure bit-for-bit results in the first comparisons.
! 27 February 2008: Keith Oleson; Sparse/dense aerodynamic parameters from
! X. Zeng
! 6 March 2009: Peter Thornton; Daylength control on Vcmax, from Bill Bauerle
!
! !LOCAL VARIABLES:
!
! local pointers to implicit in variables
!
   integer , pointer :: frac_veg_nosno(:) ! frac of veg not covered by snow (0 OR 1 now) [-]
   integer , pointer :: ivt(:)         ! pft vegetation type
   integer , pointer :: pcolumn(:)     ! pft's column index
   integer , pointer :: plandunit(:)   ! pft's landunit index
   integer , pointer :: pgridcell(:)   ! pft's gridcell index
   real(r8), pointer :: forc_th(:)     ! atmospheric potential temperature (Kelvin)
   real(r8), pointer :: t_grnd(:)      ! ground surface temperature [K]
   real(r8), pointer :: thm(:)         ! intermediate variable (forc_t+0.0098*forc_hgt_t_pft)
   real(r8), pointer :: qg(:)          ! specific humidity at ground surface [kg/kg]
   real(r8), pointer :: thv(:)         ! virtual potential temperature (kelvin)
   real(r8), pointer :: z0mv(:)        ! roughness length over vegetation, momentum [m]
   real(r8), pointer :: z0hv(:)        ! roughness length over vegetation, sensible heat [m]
   real(r8), pointer :: z0qv(:)        ! roughness length over vegetation, latent heat [m]
   real(r8), pointer :: z0mg(:)        ! roughness length of ground, momentum [m]
   real(r8), pointer :: dqgdT(:)       ! temperature derivative of "qg"
   real(r8), pointer :: htvp(:)        ! latent heat of evaporation (/sublimation) [J/kg]
   real(r8), pointer :: emv(:)         ! ground emissivity
   real(r8), pointer :: emg(:)         ! vegetation emissivity
   real(r8), pointer :: forc_pbot(:)   ! atmospheric pressure (Pa)
   real(r8), pointer :: forc_pco2(:)   ! partial pressure co2 (Pa)
#if (defined C13)
   ! 4/14/05: PET
   ! Adding isotope code
   real(r8), pointer :: forc_pc13o2(:) ! partial pressure c13o2 (Pa)
#endif
   
   real(r8), pointer :: forc_po2(:)    ! partial pressure o2 (Pa)
   real(r8), pointer :: forc_q(:)      ! atmospheric specific humidity (kg/kg)
   real(r8), pointer :: forc_u(:)      ! atmospheric wind speed in east direction (m/s)
   real(r8), pointer :: forc_v(:)      ! atmospheric wind speed in north direction (m/s)
   real(r8), pointer :: forc_hgt_u_pft(:) !observational height of wind at pft level [m]
   real(r8), pointer :: forc_rho(:)    ! density (kg/m**3)
   real(r8), pointer :: forc_lwrad(:)  ! downward infrared (longwave) radiation (W/m**2)
   real(r8), pointer :: displa(:)      ! displacement height (m)
   real(r8), pointer :: elai(:)        ! one-sided leaf area index with burying by snow
   real(r8), pointer :: esai(:)        ! one-sided stem area index with burying by snow
   real(r8), pointer :: fdry(:)        ! fraction of foliage that is green and dry [-]
   real(r8), pointer :: fwet(:)        ! fraction of canopy that is wet (0 to 1)
   real(r8), pointer :: laisun(:)      ! sunlit leaf area
   real(r8), pointer :: laisha(:)      ! shaded leaf area
   real(r8), pointer :: sabv(:)        ! solar radiation absorbed by vegetation (W/m**2)
   real(r8), pointer :: watsat(:,:)    ! volumetric soil water at saturation (porosity)
   real(r8), pointer :: watdry(:,:)    ! btran parameter for btran=0
   real(r8), pointer :: watopt(:,:)    ! btran parameter for btran = 1
   real(r8), pointer :: h2osoi_ice(:,:)! ice lens (kg/m2)
   real(r8), pointer :: h2osoi_liq(:,:)! liquid water (kg/m2)
   real(r8), pointer :: dz(:,:)        ! layer depth (m)
   real(r8), pointer :: t_soisno(:,:)  ! soil temperature (Kelvin)
   real(r8), pointer :: sucsat(:,:)    ! minimum soil suction (mm)
   real(r8), pointer :: bsw(:,:)       ! Clapp and Hornberger "b"
   real(r8), pointer :: rootfr(:,:)    ! fraction of roots in each soil layer
   real(r8), pointer :: dleaf(:)       ! characteristic leaf dimension (m)
   real(r8), pointer :: smpso(:)       ! soil water potential at full stomatal opening (mm)
   real(r8), pointer :: smpsc(:)       ! soil water potential at full stomatal closure (mm)
   real(r8), pointer :: frac_sno(:)    ! fraction of ground covered by snow (0 to 1)
   real(r8), pointer :: htop(:)        ! canopy top(m)
   real(r8), pointer :: snowdp(:)      ! snow height (m)
   real(r8), pointer :: soilbeta(:)    ! soil wetness relative to field capacity
   real(r8), pointer :: lat(:)         ! latitude (radians)
   real(r8), pointer :: decl(:)        ! declination angle (radians)
   real(r8), pointer :: max_dayl(:)    !maximum daylength for this column (s)
   
!
! local pointers to implicit inout arguments
!
   real(r8), pointer :: cgrnds(:)      ! deriv. of soil sensible heat flux wrt soil temp [w/m2/k]
   real(r8), pointer :: cgrndl(:)      ! deriv. of soil latent heat flux wrt soil temp [w/m**2/k]
   real(r8), pointer :: t_veg(:)       ! vegetation temperature (Kelvin)
   real(r8), pointer :: t_ref2m(:)     ! 2 m height surface air temperature (Kelvin)
   real(r8), pointer :: q_ref2m(:)     ! 2 m height surface specific humidity (kg/kg)
   real(r8), pointer :: t_ref2m_r(:)   ! Rural 2 m height surface air temperature (Kelvin)
   real(r8), pointer :: rh_ref2m(:)    ! 2 m height surface relative humidity (%)
   real(r8), pointer :: rh_ref2m_r(:)  ! Rural 2 m height surface relative humidity (%)
   real(r8), pointer :: h2ocan(:)      ! canopy water (mm H2O)
   real(r8), pointer :: cisun(:)       !sunlit intracellular CO2 (Pa)
   real(r8), pointer :: cisha(:)       !shaded intracellular CO2 (Pa)
!
! local pointers to implicit out arguments
!
   real(r8), pointer :: rb1(:)             ! boundary layer resistance (s/m)
   real(r8), pointer :: cgrnd(:)           ! deriv. of soil energy flux wrt to soil temp [w/m2/k]
   real(r8), pointer :: dlrad(:)           ! downward longwave radiation below the canopy [W/m2]
   real(r8), pointer :: ulrad(:)           ! upward longwave radiation above the canopy [W/m2]
   real(r8), pointer :: ram1(:)            ! aerodynamical resistance (s/m)
   real(r8), pointer :: btran(:)           ! transpiration wetness factor (0 to 1)
   real(r8), pointer :: rssun(:)           ! sunlit stomatal resistance (s/m)
   real(r8), pointer :: rssha(:)           ! shaded stomatal resistance (s/m)
   real(r8), pointer :: psnsun(:)          ! sunlit leaf photosynthesis (umol CO2 /m**2/ s)
   real(r8), pointer :: psnsha(:)          ! shaded leaf photosynthesis (umol CO2 /m**2/ s)
#if (defined C13)
   ! 4/14/05: PET
   ! Adding isotope code
   real(r8), pointer :: c13_psnsun(:)      ! sunlit leaf photosynthesis (umol 13CO2 /m**2/ s)
   real(r8), pointer :: c13_psnsha(:)      ! shaded leaf photosynthesis (umol 13CO2 /m**2/ s)
   ! 4/21/05: PET
   ! Adding isotope code
	real(r8), pointer :: rc13_canair(:)     !C13O2/C12O2 in canopy air
   real(r8), pointer :: rc13_psnsun(:)     !C13O2/C12O2 in sunlit canopy psn flux
   real(r8), pointer :: rc13_psnsha(:)     !C13O2/C12O2 in shaded canopy psn flux
   real(r8), pointer :: alphapsnsun(:)     !fractionation factor in sunlit canopy psn flux
   real(r8), pointer :: alphapsnsha(:)     !fractionation factor in shaded canopy psn flux
#endif
   
   real(r8), pointer :: qflx_tran_veg(:)   ! vegetation transpiration (mm H2O/s) (+ = to atm)
   real(r8), pointer :: dt_veg(:)          ! change in t_veg, last iteration (Kelvin)
   real(r8), pointer :: qflx_evap_veg(:)   ! vegetation evaporation (mm H2O/s) (+ = to atm)
   real(r8), pointer :: eflx_sh_veg(:)     ! sensible heat flux from leaves (W/m**2) [+ to atm]
   real(r8), pointer :: taux(:)            ! wind (shear) stress: e-w (kg/m/s**2)
   real(r8), pointer :: tauy(:)            ! wind (shear) stress: n-s (kg/m/s**2)
   real(r8), pointer :: eflx_sh_grnd(:)    ! sensible heat flux from ground (W/m**2) [+ to atm]
   real(r8), pointer :: qflx_evap_soi(:)   ! soil evaporation (mm H2O/s) (+ = to atm)
   real(r8), pointer :: fpsn(:)            ! photosynthesis (umol CO2 /m**2 /s)
   real(r8), pointer :: rootr(:,:)         ! effective fraction of roots in each soil layer
   real(r8), pointer :: rresis(:,:)        ! root resistance by layer (0-1)  (nlevgrnd)	
!
!
! !OTHER LOCAL VARIABLES:
!EOP
!
   real(r8), parameter :: btran0 = 0.0_r8  ! initial value
   real(r8), parameter :: zii = 1000.0_r8  ! convective boundary layer height [m]
   real(r8), parameter :: beta = 1.0_r8    ! coefficient of conective velocity [-]
   real(r8), parameter :: delmax = 1.0_r8  ! maxchange in  leaf temperature [K]
   real(r8), parameter :: dlemin = 0.1_r8  ! max limit for energy flux convergence [w/m2]
   real(r8), parameter :: dtmin = 0.01_r8  ! max limit for temperature convergence [K]
   integer , parameter :: itmax = 40       ! maximum number of iteration [-]
   integer , parameter :: itmin = 2        ! minimum number of iteration [-]
   !added by K.Sakaguchi for litter resistance
   real(r8), parameter :: lai_dl = 0.5_r8  ! placeholder for (dry) plant litter area index (m2/m2)
   real(r8), parameter :: z_dl = 0.05_r8   ! placeholder for (dry) litter layer thickness (m)
   !added by K.Sakaguchi for stability formulation
   real(r8), parameter :: ria  = 0.5_r8    ! free parameter for stable formulation (currently = 0.5, "gamma" in Sakaguchi&Zeng,2008)
   real(r8) :: zldis(lbp:ubp)        ! reference height "minus" zero displacement height [m]
   real(r8) :: zeta                  ! dimensionless height used in Monin-Obukhov theory
   real(r8) :: wc                    ! convective velocity [m/s]
   real(r8) :: dth(lbp:ubp)          ! diff of virtual temp. between ref. height and surface
   real(r8) :: dthv(lbp:ubp)         ! diff of vir. poten. temp. between ref. height and surface
   real(r8) :: dqh(lbp:ubp)          ! diff of humidity between ref. height and surface
   real(r8) :: obu(lbp:ubp)          ! Monin-Obukhov length (m)
   real(r8) :: um(lbp:ubp)           ! wind speed including the stablity effect [m/s]
   real(r8) :: ur(lbp:ubp)           ! wind speed at reference height [m/s]
   real(r8) :: uaf(lbp:ubp)          ! velocity of air within foliage [m/s]
   real(r8) :: temp1(lbp:ubp)        ! relation for potential temperature profile
   real(r8) :: temp12m(lbp:ubp)      ! relation for potential temperature profile applied at 2-m
   real(r8) :: temp2(lbp:ubp)        ! relation for specific humidity profile
   real(r8) :: temp22m(lbp:ubp)      ! relation for specific humidity profile applied at 2-m
   real(r8) :: ustar(lbp:ubp)        ! friction velocity [m/s]
   real(r8) :: tstar                 ! temperature scaling parameter
   real(r8) :: qstar                 ! moisture scaling parameter
   real(r8) :: thvstar               ! virtual potential temperature scaling parameter
   real(r8) :: taf(lbp:ubp)          ! air temperature within canopy space [K]
   real(r8) :: qaf(lbp:ubp)          ! humidity of canopy air [kg/kg]
   real(r8) :: rpp                   ! fraction of potential evaporation from leaf [-]
   real(r8) :: rppdry                ! fraction of potential evaporation through transp [-]
   real(r8) :: cf                    ! heat transfer coefficient from leaves [-]
   real(r8) :: rb(lbp:ubp)           ! leaf boundary layer resistance [s/m]
   real(r8) :: rah(lbp:ubp,2)        ! thermal resistance [s/m]
   real(r8) :: raw(lbp:ubp,2)        ! moisture resistance [s/m]
   real(r8) :: wta                   ! heat conductance for air [m/s]
   real(r8) :: wtg(lbp:ubp)          ! heat conductance for ground [m/s]
   real(r8) :: wtl                   ! heat conductance for leaf [m/s]
   real(r8) :: wta0(lbp:ubp)         ! normalized heat conductance for air [-]
   real(r8) :: wtl0(lbp:ubp)         ! normalized heat conductance for leaf [-]
   real(r8) :: wtg0                  ! normalized heat conductance for ground [-]
   real(r8) :: wtal(lbp:ubp)         ! normalized heat conductance for air and leaf [-]
   real(r8) :: wtga                  ! normalized heat cond. for air and ground  [-]
   real(r8) :: wtaq                  ! latent heat conductance for air [m/s]
   real(r8) :: wtlq                  ! latent heat conductance for leaf [m/s]
   real(r8) :: wtgq(lbp:ubp)         ! latent heat conductance for ground [m/s]
   real(r8) :: wtaq0(lbp:ubp)        ! normalized latent heat conductance for air [-]
   real(r8) :: wtlq0(lbp:ubp)        ! normalized latent heat conductance for leaf [-]
   real(r8) :: wtgq0                 ! normalized heat conductance for ground [-]
   real(r8) :: wtalq(lbp:ubp)        ! normalized latent heat cond. for air and leaf [-]
   real(r8) :: wtgaq                 ! normalized latent heat cond. for air and ground [-]
   real(r8) :: el(lbp:ubp)           ! vapor pressure on leaf surface [pa]
   real(r8) :: deldT                 ! derivative of "el" on "t_veg" [pa/K]
   real(r8) :: qsatl(lbp:ubp)        ! leaf specific humidity [kg/kg]
   real(r8) :: qsatldT(lbp:ubp)      ! derivative of "qsatl" on "t_veg"
   real(r8) :: e_ref2m               ! 2 m height surface saturated vapor pressure [Pa]
   real(r8) :: de2mdT                ! derivative of 2 m height surface saturated vapor pressure on t_ref2m
   real(r8) :: qsat_ref2m            ! 2 m height surface saturated specific humidity [kg/kg]
   real(r8) :: dqsat2mdT             ! derivative of 2 m height surface saturated specific humidity on t_ref2m
   real(r8) :: air(lbp:ubp),bir(lbp:ubp),cir(lbp:ubp)  ! atmos. radiation temporay set
   real(r8) :: dc1,dc2               ! derivative of energy flux [W/m2/K]
   real(r8) :: delt                  ! temporary
   real(r8) :: delq(lbp:ubp)         ! temporary
   real(r8) :: del(lbp:ubp)          ! absolute change in leaf temp in current iteration [K]
   real(r8) :: del2(lbp:ubp)         ! change in leaf temperature in previous iteration [K]
   real(r8) :: dele(lbp:ubp)         ! change in latent heat flux from leaf [K]
   real(r8) :: dels                  ! change in leaf temperature in current iteration [K]
   real(r8) :: det(lbp:ubp)          ! maximum leaf temp. change in two consecutive iter [K]
   real(r8) :: efeb(lbp:ubp)         ! latent heat flux from leaf (previous iter) [mm/s]
   real(r8) :: efeold                ! latent heat flux from leaf (previous iter) [mm/s]
   real(r8) :: efpot                 ! potential latent energy flux [kg/m2/s]
   real(r8) :: efe(lbp:ubp)          ! water flux from leaf [mm/s]
   real(r8) :: efsh                  ! sensible heat from leaf [mm/s]
   real(r8) :: obuold(lbp:ubp)       ! monin-obukhov length from previous iteration
   real(r8) :: tlbef(lbp:ubp)        ! leaf temperature from previous iteration [K]
   real(r8) :: ecidif                ! excess energies [W/m2]
   real(r8) :: err(lbp:ubp)          ! balance error
   real(r8) :: erre                  ! balance error
   real(r8) :: co2(lbp:ubp)          ! atmospheric co2 partial pressure (pa)
#if (defined C13)
   ! 4/14/05: PET
   ! Adding isotope code
   real(r8) :: c13o2(lbp:ubp)        ! atmospheric c13o2 partial pressure (pa)
#endif
   
   real(r8) :: o2(lbp:ubp)           ! atmospheric o2 partial pressure (pa)
   real(r8) :: svpts(lbp:ubp)        ! saturation vapor pressure at t_veg (pa)
   real(r8) :: eah(lbp:ubp)          ! canopy air vapor pressure (pa)
   real(r8) :: s_node                ! vol_liq/eff_porosity
   real(r8) :: smp_node              ! matrix potential
   real(r8) :: vol_ice               ! partial volume of ice lens in layer
   real(r8) :: eff_porosity          ! effective porosity in layer
   real(r8) :: vol_liq               ! partial volume of liquid water in layer
   integer  :: itlef                 ! counter for leaf temperature iteration [-]
   integer  :: nmozsgn(lbp:ubp)      ! number of times stability changes sign
   real(r8) :: w                     ! exp(-LSAI)
   real(r8) :: csoilcn               ! interpolated csoilc for less than dense canopies
   real(r8) :: fm(lbp:ubp)           ! needed for BGC only to diagnose 10m wind speed
   real(r8) :: wtshi                 ! sensible heat resistance for air, grnd and leaf [-]
   real(r8) :: wtsqi                 ! latent heat resistance for air, grnd and leaf [-]
   integer  :: j                     ! soil/snow level index
   integer  :: p                     ! pft index
   integer  :: c                     ! column index
   integer  :: l                     ! landunit index
   integer  :: g                     ! gridcell index
   integer  :: fp                    ! lake filter pft index
   integer  :: fn                    ! number of values in pft filter
   integer  :: fnorig                ! number of values in pft filter copy
   integer  :: fnold                 ! temporary copy of pft count
   integer  :: f                     ! filter index
   integer  :: filterp(ubp-lbp+1)    ! temporary filter
   integer  :: fporig(ubp-lbp+1)     ! temporary filter
   real(r8) :: displa_loc(lbp:ubp)   ! temporary copy
   real(r8) :: z0mv_loc(lbp:ubp)     ! temporary copy
   real(r8) :: z0hv_loc(lbp:ubp)     ! temporary copy
   real(r8) :: z0qv_loc(lbp:ubp)     ! temporary copy
   logical  :: found                 ! error flag for canopy above forcing hgt
   integer  :: index                 ! pft index for error
   real(r8) :: egvf                  ! effective green vegetation fraction
   real(r8) :: lt                    ! elai+esai
   real(r8) :: ri                    ! stability parameter for under canopy air (unitless)
   real(r8) :: csoilb                ! turbulent transfer coefficient over bare soil (unitless)
   real(r8) :: ricsoilc              ! modified transfer coefficient under dense canopy (unitless)
   real(r8) :: snowdp_c              ! critical snow depth to cover plant litter (m)
   real(r8) :: rdl                   ! dry litter layer resistance for water vapor  (s/m)
   real(r8) :: elai_dl               ! exposed (dry) plant litter area index
   real(r8) :: fsno_dl               ! effective snow cover over plant litter
   real(r8) :: dayl                  ! daylength (s)
   real(r8) :: temp                  ! temporary, for daylength calculation
   real(r8) :: dayl_factor(lbp:ubp)  ! scalar (0-1) for daylength effect on Vcmax
!------------------------------------------------------------------------------

   ! Assign local pointers to derived type members (gridcell-level)

   forc_lwrad     => clm_a2l%forc_lwrad
   forc_pco2      => clm_a2l%forc_pco2
#if (defined C13)
   forc_pc13o2    => clm_a2l%forc_pc13o2
#endif
   forc_po2       => clm_a2l%forc_po2
   forc_q         => clm_a2l%forc_q
   forc_pbot      => clm_a2l%forc_pbot
   forc_u         => clm_a2l%forc_u
   forc_v         => clm_a2l%forc_v
   forc_th        => clm_a2l%forc_th
   forc_rho       => clm_a2l%forc_rho
   lat            => clm3%g%lat

   ! Assign local pointers to derived type members (column-level)

   t_soisno       => clm3%g%l%c%ces%t_soisno
   watsat         => clm3%g%l%c%cps%watsat
   watdry         => clm3%g%l%c%cps%watdry 
   watopt         => clm3%g%l%c%cps%watopt 
   h2osoi_ice     => clm3%g%l%c%cws%h2osoi_ice
   dz             => clm3%g%l%c%cps%dz
   h2osoi_liq     => clm3%g%l%c%cws%h2osoi_liq
   sucsat         => clm3%g%l%c%cps%sucsat
   bsw            => clm3%g%l%c%cps%bsw
   emg            => clm3%g%l%c%cps%emg
   t_grnd         => clm3%g%l%c%ces%t_grnd
   qg             => clm3%g%l%c%cws%qg
   thv            => clm3%g%l%c%ces%thv
   dqgdT          => clm3%g%l%c%cws%dqgdT
   htvp           => clm3%g%l%c%cps%htvp
   z0mg           => clm3%g%l%c%cps%z0mg
   frac_sno       => clm3%g%l%c%cps%frac_sno
   snowdp         => clm3%g%l%c%cps%snowdp
   soilbeta       => clm3%g%l%c%cws%soilbeta
   decl           => clm3%g%l%c%cps%decl
   max_dayl       => clm3%g%l%c%cps%max_dayl

   ! Assign local pointers to derived type members (pft-level)

   rb1            => clm3%g%l%c%p%pps%rb1
   ivt            => clm3%g%l%c%p%itype
   pcolumn        => clm3%g%l%c%p%column
   plandunit      => clm3%g%l%c%p%landunit
   pgridcell      => clm3%g%l%c%p%gridcell
   frac_veg_nosno => clm3%g%l%c%p%pps%frac_veg_nosno
   btran          => clm3%g%l%c%p%pps%btran
   rootfr         => clm3%g%l%c%p%pps%rootfr
   rootr          => clm3%g%l%c%p%pps%rootr
   rresis         => clm3%g%l%c%p%pps%rresis
   emv            => clm3%g%l%c%p%pps%emv
   t_veg          => clm3%g%l%c%p%pes%t_veg
   displa         => clm3%g%l%c%p%pps%displa
   z0mv           => clm3%g%l%c%p%pps%z0mv
   z0hv           => clm3%g%l%c%p%pps%z0hv
   z0qv           => clm3%g%l%c%p%pps%z0qv
   ram1           => clm3%g%l%c%p%pps%ram1
   htop           => clm3%g%l%c%p%pps%htop
   rssun          => clm3%g%l%c%p%pps%rssun
   rssha          => clm3%g%l%c%p%pps%rssha
   cisun          => clm3%g%l%c%p%pps%cisun
   cisha          => clm3%g%l%c%p%pps%cisha
   psnsun         => clm3%g%l%c%p%pcf%psnsun
   psnsha         => clm3%g%l%c%p%pcf%psnsha
#if (defined C13)
   ! 4/14/05: PET
   ! Adding isotope code
   c13_psnsun     => clm3%g%l%c%p%pc13f%psnsun
   c13_psnsha     => clm3%g%l%c%p%pc13f%psnsha
   ! 4/21/05: PET
   ! Adding isotope code
   rc13_canair    => clm3%g%l%c%p%pepv%rc13_canair
   rc13_psnsun    => clm3%g%l%c%p%pepv%rc13_psnsun
   rc13_psnsha    => clm3%g%l%c%p%pepv%rc13_psnsha
   alphapsnsun    => clm3%g%l%c%p%pps%alphapsnsun
   alphapsnsha    => clm3%g%l%c%p%pps%alphapsnsha
#endif
   
   elai           => clm3%g%l%c%p%pps%elai
   esai           => clm3%g%l%c%p%pps%esai
   fdry           => clm3%g%l%c%p%pps%fdry
   laisun         => clm3%g%l%c%p%pps%laisun
   laisha         => clm3%g%l%c%p%pps%laisha
   qflx_tran_veg  => clm3%g%l%c%p%pwf%qflx_tran_veg
   fwet           => clm3%g%l%c%p%pps%fwet
   h2ocan         => clm3%g%l%c%p%pws%h2ocan
   dt_veg         => clm3%g%l%c%p%pps%dt_veg
   sabv           => clm3%g%l%c%p%pef%sabv
   qflx_evap_veg  => clm3%g%l%c%p%pwf%qflx_evap_veg
   eflx_sh_veg    => clm3%g%l%c%p%pef%eflx_sh_veg
   taux           => clm3%g%l%c%p%pmf%taux
   tauy           => clm3%g%l%c%p%pmf%tauy
   eflx_sh_grnd   => clm3%g%l%c%p%pef%eflx_sh_grnd
   qflx_evap_soi  => clm3%g%l%c%p%pwf%qflx_evap_soi
   t_ref2m        => clm3%g%l%c%p%pes%t_ref2m
   q_ref2m        => clm3%g%l%c%p%pes%q_ref2m
   t_ref2m_r      => clm3%g%l%c%p%pes%t_ref2m_r
   rh_ref2m_r     => clm3%g%l%c%p%pes%rh_ref2m_r
   rh_ref2m       => clm3%g%l%c%p%pes%rh_ref2m
   dlrad          => clm3%g%l%c%p%pef%dlrad
   ulrad          => clm3%g%l%c%p%pef%ulrad
   cgrnds         => clm3%g%l%c%p%pef%cgrnds
   cgrndl         => clm3%g%l%c%p%pef%cgrndl
   cgrnd          => clm3%g%l%c%p%pef%cgrnd
   fpsn           => clm3%g%l%c%p%pcf%fpsn
   forc_hgt_u_pft => clm3%g%l%c%p%pps%forc_hgt_u_pft
   thm            => clm3%g%l%c%p%pes%thm
      
   ! Assign local pointers to derived type members (ecophysiological)

   dleaf          => pftcon%dleaf
   smpso          => pftcon%smpso
   smpsc          => pftcon%smpsc



   ! Filter pfts where frac_veg_nosno is non-zero

   fn = 0
   do fp = 1,num_nolakep
      p = filter_nolakep(fp)
      if (frac_veg_nosno(p) /= 0) then
         fn = fn + 1
         filterp(fn) = p
      end if
   end do

   ! Initialize

   do f = 1, fn
      p = filterp(f)
      del(p)    = 0._r8  ! change in leaf temperature from previous iteration
      efeb(p)   = 0._r8  ! latent head flux from leaf for previous iteration
      wtlq0(p)  = 0._r8
      wtalq(p)  = 0._r8
      wtgq(p)   = 0._r8
      wtaq0(p)  = 0._r8
      obuold(p) = 0._r8
      btran(p)  = btran0
   end do
   
   ! calculate daylength control for Vcmax
   do f = 1, fn
      p=filterp(f)
      c=pcolumn(p)
      g=pgridcell(p)
      ! calculate daylength
      temp = -(sin(lat(g))*sin(decl(c)))/(cos(lat(g)) * cos(decl(c)))
      temp = min(1._r8,max(-1._r8,temp))
      dayl = 2.0_r8 * 13750.9871_r8 * acos(temp)
      ! calculate dayl_factor as the ratio of (current:max dayl)^2
      ! set a minimum of 0.01 (1%) for the dayl_factor
      dayl_factor(p)=min(1._r8,max(0.01_r8,(dayl*dayl)/(max_dayl(c)*max_dayl(c))))
#if (defined NO_DAYLEN_VCMAX)
      dayl_factor(p) = 1.0_r8
#endif
   end do

   rb1(lbp:ubp) = 0._r8

   ! Effective porosity of soil, partial volume of ice and liquid (needed for btran)
   ! and root resistance factors

   do j = 1,nlevgrnd
!dir$ concurrent
!cdir nodep
      do f = 1, fn
         p = filterp(f)
         c = pcolumn(p)
         l = plandunit(p)

         ! Root resistance factors

         vol_ice = min(watsat(c,j), h2osoi_ice(c,j)/(dz(c,j)*denice))
         eff_porosity = watsat(c,j)-vol_ice
         vol_liq = min(eff_porosity, h2osoi_liq(c,j)/(dz(c,j)*denh2o))
         if (vol_liq .le. 0._r8 .or. t_soisno(c,j) .le. tfrz-2._r8) then
            rootr(p,j) = 0._r8
         else
            s_node = max(vol_liq/eff_porosity,0.01_r8)
            smp_node = max(smpsc(ivt(p)), -sucsat(c,j)*s_node**(-bsw(c,j)))

            rresis(p,j) = min( (eff_porosity/watsat(c,j))* &
                          (smp_node - smpsc(ivt(p))) / (smpso(ivt(p)) - smpsc(ivt(p))), 1._r8)
            rootr(p,j) = rootfr(p,j)*rresis(p,j)
            btran(p) = btran(p) + rootr(p,j)
         endif 
      end do
   end do

   ! Normalize root resistances to get layer contribution to ET

   do j = 1,nlevgrnd
!dir$ concurrent
!cdir nodep
      do f = 1, fn
         p = filterp(f)
         if (btran(p) .gt. btran0) then
           rootr(p,j) = rootr(p,j)/btran(p)
         else
           rootr(p,j) = 0._r8
         end if
      end do
   end do

 ! Modify aerodynamic parameters for sparse/dense canopy (X. Zeng)
   do f = 1, fn
      p = filterp(f)
      c = pcolumn(p)

      lt = min(elai(p)+esai(p), tlsai_crit)
      egvf =(1._r8 - alpha_aero * exp(-lt)) / (1._r8 - alpha_aero * exp(-tlsai_crit))
      displa(p) = egvf * displa(p)
      z0mv(p)   = exp(egvf * log(z0mv(p)) + (1._r8 - egvf) * log(z0mg(c)))
      z0hv(p)   = z0mv(p)
      z0qv(p)   = z0mv(p)

  end do

   found = .false.
!dir$ concurrent
!cdir nodep
   do f = 1, fn
      p = filterp(f)
      c = pcolumn(p)
      g = pgridcell(p)

      ! Net absorbed longwave radiation by canopy and ground
      ! =air+bir*t_veg**4+cir*t_grnd(c)**4

      air(p) =   emv(p) * (1._r8+(1._r8-emv(p))*(1._r8-emg(c))) * forc_lwrad(g)
      bir(p) = - (2._r8-emv(p)*(1._r8-emg(c))) * emv(p) * sb
      cir(p) =   emv(p)*emg(c)*sb

      ! Saturated vapor pressure, specific humidity, and their derivatives
      ! at the leaf surface

      call QSat (t_veg(p), forc_pbot(g), el(p), deldT, qsatl(p), qsatldT(p))

      ! Determine atmospheric co2 and o2

      co2(p) = forc_pco2(g)
      o2(p)  = forc_po2(g)
      
#if (defined C13)
      ! 4/14/05: PET
      ! Adding isotope code
      c13o2(p) = forc_pc13o2(g)
#endif
      
      ! Initialize flux profile

      nmozsgn(p) = 0

      taf(p) = (t_grnd(c) + thm(p))/2._r8
      qaf(p) = (forc_q(g)+qg(c))/2._r8

      ur(p) = max(1.0_r8,sqrt(forc_u(g)*forc_u(g)+forc_v(g)*forc_v(g)))
      dth(p) = thm(p)-taf(p)
      dqh(p) = forc_q(g)-qaf(p)
      delq(p) = qg(c) - qaf(p)
      dthv(p) = dth(p)*(1._r8+0.61_r8*forc_q(g))+0.61_r8*forc_th(g)*dqh(p)
      zldis(p) = forc_hgt_u_pft(p) - displa(p)

      ! Check to see if the forcing height is below the canopy height
      if (zldis(p) < 0._r8) then
         found = .true.
         index = p
      end if

   end do

   if (found) then
      write(6,*)'Error: Forcing height is below canopy height for pft index ',index
      call endrun()
   end if

!dir$ concurrent
!cdir nodep
   do f = 1, fn
      p = filterp(f)
      c = pcolumn(p)

      ! Initialize Monin-Obukhov length and wind speed

      call MoninObukIni(ur(p), thv(c), dthv(p), zldis(p), z0mv(p), um(p), obu(p))

   end do

   ! Set counter for leaf temperature iteration (itlef)

   itlef = 0    
   fnorig = fn
   fporig(1:fn) = filterp(1:fn)

   ! Make copies so that array sections are not passed in function calls to friction velocity
   
!dir$ concurrent
!cdir nodep
   do f = 1, fn
      p = filterp(f)
      displa_loc(p) = displa(p)
      z0mv_loc(p) = z0mv(p)
      z0hv_loc(p) = z0hv(p)
      z0qv_loc(p) = z0qv(p)
   end do

   ! Begin stability iteration

   ITERATION : do while (itlef <= itmax .and. fn > 0)

      ! Determine friction velocity, and potential temperature and humidity
      ! profiles of the surface boundary layer

      call FrictionVelocity (lbp, ubp, fn, filterp, &
                             displa_loc, z0mv_loc, z0hv_loc, z0qv_loc, &
                             obu, itlef+1, ur, um, ustar, &
                             temp1, temp2, temp12m, temp22m, fm)

!dir$ concurrent
!cdir nodep
      do f = 1, fn
         p = filterp(f)
         c = pcolumn(p)
         g = pgridcell(p)

         tlbef(p) = t_veg(p)
         del2(p) = del(p)

         ! Determine aerodynamic resistances

         ram1(p)  = 1._r8/(ustar(p)*ustar(p)/um(p))
         rah(p,1) = 1._r8/(temp1(p)*ustar(p))
         raw(p,1) = 1._r8/(temp2(p)*ustar(p))

         ! Bulk boundary layer resistance of leaves

         uaf(p) = um(p)*sqrt( 1._r8/(ram1(p)*um(p)) )
         cf  = 0.01_r8/(sqrt(uaf(p))*sqrt(dleaf(ivt(p))))
         rb(p)  = 1._r8/(cf*uaf(p))
         rb1(p) = rb(p)
  
         ! Parameterization for variation of csoilc with canopy density from
         ! X. Zeng, University of Arizona

         w = exp(-(elai(p)+esai(p)))

         ! changed by K.Sakaguchi from here
         ! transfer coefficient over bare soil is changed to a local variable
         ! just for readability of the code (from line 680)
         csoilb = (vkc/(0.13_r8*(z0mg(c)*uaf(p)/1.5e-5_r8)**0.45_r8))

         !compute the stability parameter for ricsoilc  ("S" in Sakaguchi&Zeng,2008)

         ri = ( grav*htop(p) * (taf(p) - t_grnd(c)) ) / (taf(p) * uaf(p) **2.00_r8)

         !! modify csoilc value (0.004) if the under-canopy is in stable condition

         if ( (taf(p) - t_grnd(c) ) > 0._r8) then
               ! decrease the value of csoilc by dividing it with (1+gamma*min(S, 10.0))
               ! ria ("gmanna" in Sakaguchi&Zeng, 2008) is a constant (=0.5)
               ricsoilc = csoilc / (1.00_r8 + ria*min( ri, 10.0_r8) )
               csoilcn = csoilb*w + ricsoilc*(1._r8-w)
         else
              csoilcn = csoilb*w + csoilc*(1._r8-w)
         end if

         !! Sakaguchi changes for stability formulation ends here

         rah(p,2) = 1._r8/(csoilcn*uaf(p))
         raw(p,2) = rah(p,2)

         ! Stomatal resistances for sunlit and shaded fractions of canopy.
         ! Done each iteration to account for differences in eah, tv.

         svpts(p) = el(p)                         ! pa
         eah(p) = forc_pbot(g) * qaf(p) / 0.622_r8   ! pa
      end do

      ! 4/25/05, PET: Now calling the sun/shade version of Stomata by default
      call Stomata (fn, filterp, lbp, ubp, svpts, eah, o2, co2, rb, dayl_factor, phase='sun')
      call Stomata (fn, filterp, lbp, ubp, svpts, eah, o2, co2, rb, dayl_factor, phase='sha')

!dir$ concurrent
!cdir nodep
      do f = 1, fn
         p = filterp(f)
         c = pcolumn(p)
         g = pgridcell(p)

         ! Sensible heat conductance for air, leaf and ground
         ! Moved the original subroutine in-line...

         wta    = 1._r8/rah(p,1)             ! air
         wtl    = (elai(p)+esai(p))/rb(p)    ! leaf
         wtg(p) = 1._r8/rah(p,2)             ! ground
         wtshi  = 1._r8/(wta+wtl+wtg(p))

         wtl0(p) = wtl*wtshi         ! leaf
         wtg0    = wtg(p)*wtshi      ! ground
         wta0(p) = wta*wtshi         ! air

         wtga    = wta0(p)+wtg0      ! ground + air
         wtal(p) = wta0(p)+wtl0(p)   ! air + leaf

         ! Fraction of potential evaporation from leaf

         if (fdry(p) .gt. 0._r8) then
            rppdry  = fdry(p)*rb(p)*(laisun(p)/(rb(p)+rssun(p)) + &
                                     laisha(p)/(rb(p)+rssha(p)))/elai(p)
         else
            rppdry = 0._r8
         end if
         efpot = forc_rho(g)*wtl*(qsatl(p)-qaf(p))

         if (efpot > 0._r8) then
            if (btran(p) > btran0) then
               qflx_tran_veg(p) = efpot*rppdry
               rpp = rppdry + fwet(p)
            else
               !No transpiration if btran below 1.e-10
               rpp = fwet(p)
               qflx_tran_veg(p) = 0._r8
            end if
            !Check total evapotranspiration from leaves
            rpp = min(rpp, (qflx_tran_veg(p)+h2ocan(p)/dtime)/efpot)
         else
            !No transpiration if potential evaporation less than zero
            rpp = 1._r8
            qflx_tran_veg(p) = 0._r8
         end if

         ! Update conductances for changes in rpp
         ! Latent heat conductances for ground and leaf.
         ! Air has same conductance for both sensible and latent heat.
         ! Moved the original subroutine in-line...

         wtaq    = frac_veg_nosno(p)/raw(p,1)                        ! air
         wtlq    = frac_veg_nosno(p)*(elai(p)+esai(p))/rb(p) * rpp   ! leaf

         !Litter layer resistance. Added by K.Sakaguchi
         snowdp_c = z_dl ! critical depth for 100% litter burial by snow (=litter thickness)
         fsno_dl = snowdp(c)/snowdp_c    ! effective snow cover for (dry)plant litter
         elai_dl = lai_dl*(1._r8 - min(fsno_dl,1._r8)) ! exposed (dry)litter area index
         rdl = ( 1._r8 - exp(-elai_dl) ) / ( 0.004_r8*uaf(p)) ! dry litter layer resistance

         ! add litter resistance and Lee and Pielke 1992 beta
         if (delq(p) .lt. 0._r8) then  !dew. Do not apply beta for negative flux (follow old rsoil)
            wtgq(p) = frac_veg_nosno(p)/(raw(p,2)+rdl)
         else
            wtgq(p) = soilbeta(c)*frac_veg_nosno(p)/(raw(p,2)+rdl)
         end if

         wtsqi   = 1._r8/(wtaq+wtlq+wtgq(p))

         wtgq0    = wtgq(p)*wtsqi      ! ground
         wtlq0(p) = wtlq*wtsqi         ! leaf
         wtaq0(p) = wtaq*wtsqi         ! air

         wtgaq    = wtaq0(p)+wtgq0     ! air + ground
         wtalq(p) = wtaq0(p)+wtlq0(p)  ! air + leaf

         dc1 = forc_rho(g)*cpair*wtl
         dc2 = hvap*forc_rho(g)*wtlq

         efsh   = dc1*(wtga*t_veg(p)-wtg0*t_grnd(c)-wta0(p)*thm(p))
         efe(p) = dc2*(wtgaq*qsatl(p)-wtgq0*qg(c)-wtaq0(p)*forc_q(g))

         ! Evaporation flux from foliage

         erre = 0._r8
         if (efe(p)*efeb(p) < 0._r8) then
            efeold = efe(p)
            efe(p)  = 0.1_r8*efeold
            erre = efe(p) - efeold
         end if
         dt_veg(p) = (sabv(p) + air(p) + bir(p)*t_veg(p)**4 + &
              cir(p)*t_grnd(c)**4 - efsh - efe(p)) / &
              (- 4._r8*bir(p)*t_veg(p)**3 +dc1*wtga +dc2*wtgaq*qsatldT(p))
         t_veg(p) = tlbef(p) + dt_veg(p)
         dels = dt_veg(p)
         del(p)  = abs(dels)
         err(p) = 0._r8
         if (del(p) > delmax) then
            dt_veg(p) = delmax*dels/del(p)
            t_veg(p) = tlbef(p) + dt_veg(p)
            err(p) = sabv(p) + air(p) + bir(p)*tlbef(p)**3*(tlbef(p) + &
                 4._r8*dt_veg(p)) + cir(p)*t_grnd(c)**4 - &
                 (efsh + dc1*wtga*dt_veg(p)) - (efe(p) + &
                 dc2*wtgaq*qsatldT(p)*dt_veg(p))
         end if

         ! Fluxes from leaves to canopy space
         ! "efe" was limited as its sign changes frequently.  This limit may
         ! result in an imbalance in "hvap*qflx_evap_veg" and
         ! "efe + dc2*wtgaq*qsatdt_veg"

         efpot = forc_rho(g)*wtl*(wtgaq*(qsatl(p)+qsatldT(p)*dt_veg(p)) &
            -wtgq0*qg(c)-wtaq0(p)*forc_q(g))
         qflx_evap_veg(p) = rpp*efpot
         
         ! Calculation of evaporative potentials (efpot) and
         ! interception losses; flux in kg m**-2 s-1.  ecidif
         ! holds the excess energy if all intercepted water is evaporated
         ! during the timestep.  This energy is later added to the
         ! sensible heat flux.

         ecidif = 0._r8
         if (efpot > 0._r8 .and. btran(p) > btran0) then
            qflx_tran_veg(p) = efpot*rppdry
         else
            qflx_tran_veg(p) = 0._r8
         end if
         ecidif = max(0._r8, qflx_evap_veg(p)-qflx_tran_veg(p)-h2ocan(p)/dtime)
         qflx_evap_veg(p) = min(qflx_evap_veg(p),qflx_tran_veg(p)+h2ocan(p)/dtime)

         ! The energy loss due to above two limits is added to
         ! the sensible heat flux.

         eflx_sh_veg(p) = efsh + dc1*wtga*dt_veg(p) + err(p) + erre + hvap*ecidif

         ! Re-calculate saturated vapor pressure, specific humidity, and their
         ! derivatives at the leaf surface

         call QSat(t_veg(p), forc_pbot(g), el(p), deldT, qsatl(p), qsatldT(p))

         ! Update vegetation/ground surface temperature, canopy air
         ! temperature, canopy vapor pressure, aerodynamic temperature, and
         ! Monin-Obukhov stability parameter for next iteration.

         taf(p) = wtg0*t_grnd(c) + wta0(p)*thm(p) + wtl0(p)*t_veg(p)
         qaf(p) = wtlq0(p)*qsatl(p) + wtgq0*qg(c) + forc_q(g)*wtaq0(p)

         ! Update Monin-Obukhov length and wind speed including the
         ! stability effect

         dth(p) = thm(p)-taf(p)
         dqh(p) = forc_q(g)-qaf(p)
         delq(p) = wtalq(p)*qg(c)-wtlq0(p)*qsatl(p)-wtaq0(p)*forc_q(g)

         tstar = temp1(p)*dth(p)
         qstar = temp2(p)*dqh(p)

         thvstar = tstar*(1._r8+0.61_r8*forc_q(g)) + 0.61_r8*forc_th(g)*qstar
         zeta = zldis(p)*vkc*grav*thvstar/(ustar(p)**2*thv(c))

         if (zeta >= 0._r8) then     !stable
            zeta = min(2._r8,max(zeta,0.01_r8))
            um(p) = max(ur(p),0.1_r8)
         else                     !unstable
            zeta = max(-100._r8,min(zeta,-0.01_r8))
            wc = beta*(-grav*ustar(p)*thvstar*zii/thv(c))**0.333_r8
            um(p) = sqrt(ur(p)*ur(p)+wc*wc)
         end if
         obu(p) = zldis(p)/zeta

         if (obuold(p)*obu(p) < 0._r8) nmozsgn(p) = nmozsgn(p)+1
         if (nmozsgn(p) >= 4) obu(p) = zldis(p)/(-0.01_r8)
         obuold(p) = obu(p)

      end do   ! end of filtered pft loop

      ! Test for convergence

      itlef = itlef+1
      if (itlef > itmin) then
!dir$ concurrent
!cdir nodep
         do f = 1, fn
            p = filterp(f)
            dele(p) = abs(efe(p)-efeb(p))
            efeb(p) = efe(p)
            det(p)  = max(del(p),del2(p))
         end do
         fnold = fn
         fn = 0
         do f = 1, fnold
            p = filterp(f)
            if (.not. (det(p) < dtmin .and. dele(p) < dlemin)) then
               fn = fn + 1
               filterp(fn) = p
            end if
         end do
      end if

   end do ITERATION     ! End stability iteration

   fn = fnorig
   filterp(1:fn) = fporig(1:fn)

!dir$ concurrent
!cdir nodep
   do f = 1, fn
      p = filterp(f)
      c = pcolumn(p)
      g = pgridcell(p)

      ! Energy balance check in canopy

      err(p) = sabv(p) + air(p) + bir(p)*tlbef(p)**3*(tlbef(p) + 4._r8*dt_veg(p)) &
         + cir(p)*t_grnd(c)**4 - eflx_sh_veg(p) - hvap*qflx_evap_veg(p)

      ! Fluxes from ground to canopy space

      delt    = wtal(p)*t_grnd(c)-wtl0(p)*t_veg(p)-wta0(p)*thm(p)
      taux(p) = -forc_rho(g)*forc_u(g)/ram1(p)
      tauy(p) = -forc_rho(g)*forc_v(g)/ram1(p)
      eflx_sh_grnd(p) = cpair*forc_rho(g)*wtg(p)*delt
      qflx_evap_soi(p) = forc_rho(g)*wtgq(p)*delq(p)

      ! 2 m height air temperature

      t_ref2m(p) = thm(p) + temp1(p)*dth(p)*(1._r8/temp12m(p) - 1._r8/temp1(p))
      t_ref2m_r(p) = t_ref2m(p)

      ! 2 m height specific humidity

      q_ref2m(p) = forc_q(g) + temp2(p)*dqh(p)*(1._r8/temp22m(p) - 1._r8/temp2(p))

      ! 2 m height relative humidity

      call QSat(t_ref2m(p), forc_pbot(g), e_ref2m, de2mdT, qsat_ref2m, dqsat2mdT)
      rh_ref2m(p) = min(100._r8, q_ref2m(p) / qsat_ref2m * 100._r8)
      rh_ref2m_r(p) = rh_ref2m(p)

      ! Downward longwave radiation below the canopy

      dlrad(p) = (1._r8-emv(p))*emg(c)*forc_lwrad(g) + &
         emv(p)*emg(c)*sb*tlbef(p)**3*(tlbef(p) + 4._r8*dt_veg(p))

      ! Upward longwave radiation above the canopy

      ulrad(p) = ((1._r8-emg(c))*(1._r8-emv(p))*(1._r8-emv(p))*forc_lwrad(g) &
         + emv(p)*(1._r8+(1._r8-emg(c))*(1._r8-emv(p)))*sb*tlbef(p)**3*(tlbef(p) + &
         4._r8*dt_veg(p)) + emg(c)*(1._r8-emv(p))*sb*t_grnd(c)**4)

      ! Derivative of soil energy flux with respect to soil temperature

      cgrnds(p) = cgrnds(p) + cpair*forc_rho(g)*wtg(p)*wtal(p)
      cgrndl(p) = cgrndl(p) + forc_rho(g)*wtgq(p)*wtalq(p)*dqgdT(c)
      cgrnd(p)  = cgrnds(p) + cgrndl(p)*htvp(c)

      ! Update dew accumulation (kg/m2)
      
      h2ocan(p) = max(0._r8,h2ocan(p)+(qflx_tran_veg(p)-qflx_evap_veg(p))*dtime)
      
      ! total photosynthesis

      fpsn(p) = psnsun(p)*laisun(p) + psnsha(p)*laisha(p)
      
#if (defined CN) && (defined C13)
      ! 4/14/05: PET
      ! Adding isotope code
      rc13_canair(p) = c13o2(p)/(co2(p)-c13o2(p))
      rc13_psnsun(p) = rc13_canair(p)/alphapsnsun(p)
      rc13_psnsha(p) = rc13_canair(p)/alphapsnsha(p)
      c13_psnsun(p) = psnsun(p) * (rc13_psnsun(p)/(1._r8+rc13_psnsun(p)))
      c13_psnsha(p) = psnsha(p) * (rc13_psnsha(p)/(1._r8+rc13_psnsha(p)))
#endif     
      
   end do

   ! Filter out pfts which have small energy balance errors; report others

   fnold = fn
   fn = 0
   do f = 1, fnold
      p = filterp(f)
      if (abs(err(p)) > 0.1_r8) then
         fn = fn + 1
         filterp(fn) = p
      end if
   end do

   do f = 1, fn
      p = filterp(f)
      write(6,*) 'energy balance in canopy ',p,', err=',err(p)
   end do

   end subroutine CanopyFluxes

!------------------------------------------------------------------------------
!BOP
!
! !IROUTINE: Stomata
!
! !INTERFACE:
   subroutine Stomata (fn, filterp, lbp, ubp, ei, ea, o2, co2, rb, dayl_factor, phase)
!
! !DESCRIPTION: 
! Leaf stomatal resistance and leaf photosynthesis. Modifications for CN code.

! !REVISION HISTORY:
! 22 January 2004: Created by Peter Thornton
! 4/14/05: Peter Thornton: Converted Ci from local variable to pps struct member
!    now returns cisun or cisha per pft as implicit output argument.
!    Also sets alphapsnsun and alphapsnsha.
! 4/25/05, Peter Thornton: Adopted as the default code for CLM, together with
!   modifications for sun/shade canopy.  Renamed from StomataCN to Stomata,
!   and eliminating the older Stomata subroutine
! 3/6/09: Peter Thornton; added dayl_factor control on Vcmax, from Bill Bauerle

! !USES:
     use shr_kind_mod , only : r8 => shr_kind_r8
     use shr_const_mod, only : SHR_CONST_TKFRZ, SHR_CONST_RGAS
     use clmtype
     use pftvarcon    , only : nbrdlf_dcd_tmp_shrub
#ifdef CROP
     use pftvarcon    , only : nsoybean
#endif
!
! !ARGUMENTS:
     implicit none
     integer , intent(in)    :: fn                 ! size of pft filter
     integer , intent(in)    :: filterp(fn)        ! pft filter
     integer , intent(in)    :: lbp, ubp           ! pft bounds
     real(r8), intent(in)    :: ei(lbp:ubp)        ! vapor pressure inside leaf (sat vapor press at tl) (pa)
     real(r8), intent(in)    :: ea(lbp:ubp)        ! vapor pressure of canopy air (pa)
     real(r8), intent(in)    :: o2(lbp:ubp)        ! atmospheric o2 concentration (pa)
     real(r8), intent(in)    :: co2(lbp:ubp)       ! atmospheric co2 concentration (pa)
     real(r8), intent(inout) :: rb(lbp:ubp)        ! boundary layer resistance (s/m)
     real(r8), intent(in)    :: dayl_factor(lbp:ubp) ! scalar (0-1) for daylength
     character(len=*), intent(in) :: phase         ! 'sun' or 'sha'
!
! !CALLED FROM:
! subroutine CanopyFluxes in this module
!
! !LOCAL VARIABLES:
!
! local pointers to implicit in variables
! new ecophys variables (leafcn, flnr) added 1/26/04
!
     integer , pointer :: pcolumn(:)     ! pft's column index
     integer , pointer :: pgridcell(:)   ! pft's gridcell index
     integer , pointer :: ivt(:)         ! pft vegetation type
     real(r8), pointer :: qe25(:)        ! quantum efficiency at 25C (umol CO2 / umol photon)
     real(r8), pointer :: vcmx25(:)      ! max rate of carboxylation at 25C (umol CO2/m**2/s)
     real(r8), pointer :: c3psn(:)       ! photosynthetic pathway: 0. = c4, 1. = c3
     real(r8), pointer :: mp(:)          ! slope of conductance-to-photosynthesis relationship
     real(r8), pointer :: tgcm(:)        ! air temperature at agcm reference height (kelvin)
     real(r8), pointer :: forc_pbot(:)   ! atmospheric pressure (Pa)
     real(r8), pointer :: tl(:)          ! leaf temperature (Kelvin)
     real(r8), pointer :: btran(:)       ! soil water transpiration factor (0 to 1)
     real(r8), pointer :: apar(:)        ! par absorbed per unit lai (w/m**2)
     real(r8), pointer :: leafcn(:)      ! leaf C:N (gC/gN)
     real(r8), pointer :: flnr(:)        ! fraction of leaf N in the Rubisco enzyme (gN Rubisco / gN leaf)
     real(r8), pointer :: sla(:)         ! specific leaf area, projected area basis (m^2/gC)
     real(r8), pointer :: fnitr(:)       ! foliage nitrogen limitation factor (-)
!
! local pointers to implicit inout variables
!
     real(r8), pointer :: rs(:)          ! leaf stomatal resistance (s/m)
     real(r8), pointer :: psn(:)         ! foliage photosynthesis (umol co2 /m**2/ s) [always +]
     real(r8), pointer :: ci(:)          ! intracellular leaf CO2 (Pa)
#if (defined C13)
     real(r8), pointer :: alphapsn(:)    ! 13C fractionation factor for PSN ()
#endif

!
! local pointers to implicit out variables
!
     real(r8), pointer :: lnc(:)         ! leaf N concentration per unit projected LAI (gN leaf/m^2)
     real(r8), pointer :: vcmx(:)        ! maximum rate of carboxylation (umol co2/m**2/s)
!
!
! !LOCAL VARIABLES:
!EOP
!
     real(r8), parameter :: mpe = 1.e-6_r8   ! prevents overflow error if division by zero
     integer , parameter :: niter = 3     ! number of iterations
     integer  :: f,p,c,g ! indices
     integer  :: iter    ! iteration index
     real(r8) :: ab      ! used in statement functions
     real(r8) :: bc      ! used in statement functions
     real(r8) :: f1      ! generic temperature response (statement function)
     real(r8) :: f2      ! generic temperature inhibition (statement function)
     real(r8) :: tc      ! leaf temperature (degree celsius)
     real(r8) :: cs      ! co2 concentration at leaf surface (pa)
     real(r8) :: kc      ! co2 michaelis-menten constant (pa)
     real(r8) :: ko      ! o2 michaelis-menten constant (pa)
     real(r8) :: atmp    ! intermediate calculations for rs
     real(r8) :: btmp    ! intermediate calculations for rs
     real(r8) :: ctmp    ! intermediate calculations for rs
     real(r8) :: q       ! intermediate calculations for rs
     real(r8) :: r1,r2   ! roots for rs
     real(r8) :: ppf     ! absorb photosynthetic photon flux (umol photons/m**2/s)
     real(r8) :: wc      ! rubisco limited photosynthesis (umol co2/m**2/s)
     real(r8) :: wj      ! light limited photosynthesis (umol co2/m**2/s)
     real(r8) :: we      ! export limited photosynthesis (umol co2/m**2/s)
     real(r8) :: cp      ! co2 compensation point (pa)
     real(r8) :: awc     ! intermediate calcuation for wc
     real(r8) :: j       ! electron transport (umol co2/m**2/s)
     real(r8) :: cea     ! constrain ea or else model blows up
     real(r8) :: cf      ! s m**2/umol -> s/m
     real(r8) :: rsmax0  ! maximum stomatal resistance [s/m]
     real(r8) :: kc25    ! co2 michaelis-menten constant at 25c (pa)
     real(r8) :: akc     ! q10 for kc25
     real(r8) :: ko25    ! o2 michaelis-menten constant at 25c (pa)
     real(r8) :: ako     ! q10 for ko25
     real(r8) :: avcmx   ! q10 for vcmx25
     real(r8) :: bp      ! minimum leaf conductance (umol/m**2/s)
     ! additional variables for new treatment of Vcmax, Peter Thornton, 1/26/04
     real(r8) :: act25   ! (umol/mgRubisco/min) Rubisco activity at 25 C
     real(r8) :: act     ! (umol/mgRubisco/min) Rubisco activity
     real(r8) :: q10act  ! (DIM) Q_10 for Rubisco activity
     real(r8) :: fnr     ! (gRubisco/gN in Rubisco)
!------------------------------------------------------------------------------

     ! Set statement functions

     f1(ab,bc) = ab**((bc-25._r8)/10._r8)
     f2(ab) = 1._r8 + exp((-2.2e05_r8+710._r8*(ab+SHR_CONST_TKFRZ))/(SHR_CONST_RGAS*0.001_r8*(ab+SHR_CONST_TKFRZ)))

     ! Assign local pointers to derived type members (pft-level)

     pcolumn   => clm3%g%l%c%p%column
     pgridcell => clm3%g%l%c%p%gridcell
     ivt       => clm3%g%l%c%p%itype
     tl        => clm3%g%l%c%p%pes%t_veg
     btran     => clm3%g%l%c%p%pps%btran
     if (phase == 'sun') then
        apar   => clm3%g%l%c%p%pef%parsun
        rs     => clm3%g%l%c%p%pps%rssun
        psn    => clm3%g%l%c%p%pcf%psnsun
        ci     => clm3%g%l%c%p%pps%cisun
#if (defined C13)
        alphapsn  => clm3%g%l%c%p%pps%alphapsnsun
#endif
        sla    => clm3%g%l%c%p%pps%slasun
        lnc    => clm3%g%l%c%p%pps%lncsun   
        vcmx   => clm3%g%l%c%p%pps%vcmxsun   
     else if (phase == 'sha') then
        apar   => clm3%g%l%c%p%pef%parsha
        rs     => clm3%g%l%c%p%pps%rssha
        psn    => clm3%g%l%c%p%pcf%psnsha
        ci     => clm3%g%l%c%p%pps%cisha
        sla    => clm3%g%l%c%p%pps%slasha   
#if (defined C13)
        alphapsn  => clm3%g%l%c%p%pps%alphapsnsha
#endif
        lnc    => clm3%g%l%c%p%pps%lncsha   
        vcmx   => clm3%g%l%c%p%pps%vcmxsha
     end if

     ! Assign local pointers to derived type members (gridcell-level)

     forc_pbot => clm_a2l%forc_pbot

     ! Assign local pointers to derived type members (column-level)

     tgcm        => clm3%g%l%c%p%pes%thm

     ! Assign local pointers to pft constants
     ! new ecophys constants added 1/26/04

     qe25      => pftcon%qe25
     vcmx25    => pftcon%vcmx25
     c3psn     => pftcon%c3psn
     mp        => pftcon%mp
     leafcn    => pftcon%leafcn
     flnr      => pftcon%flnr
     fnitr     => pftcon%fnitr

     ! Set constant values

     kc25  = 30._r8
     akc   = 2.1_r8
     ko25  = 30000._r8
     ako   = 1.2_r8
     avcmx = 2.4_r8
     bp    = 2000._r8

     ! New constants for CN code, added 1/26/04

     act25 = 3.6_r8
     q10act = 2.4_r8
     fnr = 7.16_r8
     
     ! Convert rubisco activity units from umol/mgRubisco/min -> umol/gRubisco/s

     act25 = act25 * 1000.0_r8 / 60.0_r8

!dir$ concurrent
!cdir nodep
     do f = 1, fn
        p = filterp(f)
        c = pcolumn(p)
        g = pgridcell(p)

        ! Initialize rs=rsmax and psn=0 because calculations are performed only
        ! when apar > 0, in which case rs <= rsmax and psn >= 0
        ! Set constants

        rsmax0 = 2.e4_r8
        cf = forc_pbot(g)/(SHR_CONST_RGAS*0.001_r8*tgcm(p))*1.e06_r8
        if (apar(p) <= 0._r8) then          ! night time
           rs(p) = min(rsmax0, 1._r8/bp * cf)
           psn(p) = 0._r8
           lnc(p) = 0._r8
           vcmx(p) = 0._r8
#if (defined C13)
           alphapsn(p) = 1._r8
#endif
        else                             ! day time
           tc = tl(p) - SHR_CONST_TKFRZ
           ppf = 4.6_r8 * apar(p)                  
           j = ppf * qe25(ivt(p))
           kc = kc25 * f1(akc,tc)       
           ko = ko25 * f1(ako,tc)
           awc = kc * (1._r8+o2(p)/ko)
           cp = 0.5_r8*kc/ko*o2(p)*0.21_r8

           ! Modification for shrubs proposed by X.D.Z
           ! Why does he prefer this line here instead of in subr.
           ! CanopyFluxes? (slevis)
           ! Equivalent modification for soy following AgroIBIS
#if (defined CNDV)
           if (ivt(p) == nbrdlf_dcd_tmp_shrub) btran(p) = min(1._r8, btran(p) * 3.33_r8)
#endif
#if (defined CROP)
           if (ivt(p) == nsoybean) btran(p) = min(1._r8, btran(p) * 1.25_r8)
#endif
           
           ! new calculations for vcmax, 1/26/04
           lnc(p) = 1._r8 / (sla(p) * leafcn(ivt(p)))
		   act = act25 * f1(q10act,tc)
#if (defined CN)
           vcmx(p) = lnc(p) * flnr(ivt(p)) * fnr * act / f2(tc) * btran(p) * dayl_factor(p)
#else
           vcmx(p) = lnc(p) * flnr(ivt(p)) * fnr * act / f2(tc) * btran(p) * dayl_factor(p) * fnitr(ivt(p))
#endif
           
           ! First guess ci

           ci(p) = 0.7_r8*co2(p)*c3psn(ivt(p)) + 0.4_r8*co2(p)*(1._r8-c3psn(ivt(p)))

           ! rb: s/m -> s m**2 / umol

           rb(p) = rb(p)/cf 

           ! Constrain ea

           cea = max(0.25_r8*ei(p)*c3psn(ivt(p))+0.40_r8*ei(p)*(1._r8-c3psn(ivt(p))), min(ea(p),ei(p)) ) 

           ! ci iteration for 'actual' photosynthesis

#if (defined NEC_SX)
!NEC NEC NEC
           !
           ! ITER = 1
           !
           wj = max(ci(p)-cp,0._r8)*j/(ci(p)+2._r8*cp)*c3psn(ivt(p)) + j*(1._r8-c3psn(ivt(p)))
           wc = max(ci(p)-cp,0._r8)*vcmx(p)/(ci(p)+awc)*c3psn(ivt(p)) + vcmx(p)*(1._r8-c3psn(ivt(p)))
           we = 0.5_r8*vcmx(p)*c3psn(ivt(p)) + 4000._r8*vcmx(p)*ci(p)/forc_pbot(g)*(1._r8-c3psn(ivt(p))) 
           psn(p) = min(wj,wc,we) 
           cs = max( co2(p)-1.37_r8*rb(p)*forc_pbot(g)*psn(p), mpe )
           atmp = mp(ivt(p))*psn(p)*forc_pbot(g)*cea / (cs*ei(p)) + bp
           btmp = ( mp(ivt(p))*psn(p)*forc_pbot(g)/cs + bp ) * rb(p) - 1._r8
           ctmp = -rb(p)
           if (btmp >= 0._r8) then
              q = -0.5_r8*( btmp + sqrt(btmp*btmp-4._r8*atmp*ctmp) )
           else
              q = -0.5_r8*( btmp - sqrt(btmp*btmp-4._r8*atmp*ctmp) )
           end if
           r1 = q/atmp
           r2 = ctmp/q
           rs(p) = max(r1,r2)
           ci(p) = max( cs-psn(p)*forc_pbot(g)*1.65_r8*rs(p), 0._r8 )
           !
           ! ITER = 2
           !
           wj = max(ci(p)-cp,0._r8)*j/(ci(p)+2._r8*cp)*c3psn(ivt(p)) + j*(1._r8-c3psn(ivt(p)))
           wc = max(ci(p)-cp,0._r8)*vcmx(p)/(ci(p)+awc)*c3psn(ivt(p)) + vcmx(p)*(1._r8-c3psn(ivt(p)))
           we = 0.5_r8*vcmx(p)*c3psn(ivt(p)) + 4000._r8*vcmx(p)*ci(p)/forc_pbot(g)*(1._r8-c3psn(ivt(p))) 
           psn(p) = min(wj,wc,we) 
           cs = max( co2(p)-1.37_r8*rb(p)*forc_pbot(g)*psn(p), mpe )
           atmp = mp(ivt(p))*psn(p)*forc_pbot(g)*cea / (cs*ei(p)) + bp
           btmp = ( mp(ivt(p))*psn(p)*forc_pbot(g)/cs + bp ) * rb(p) - 1._r8
           ctmp = -rb(p)
           if (btmp >= 0._r8) then
              q = -0.5_r8*( btmp + sqrt(btmp*btmp-4._r8*atmp*ctmp) )
           else
              q = -0.5_r8*( btmp - sqrt(btmp*btmp-4._r8*atmp*ctmp) )
           end if
           r1 = q/atmp
           r2 = ctmp/q
           rs(p) = max(r1,r2)
           ci(p) = max( cs-psn(p)*forc_pbot(g)*1.65_r8*rs(p), 0._r8 )
           !
           ! ITER = 3
           !
           wj = max(ci(p)-cp,0._r8)*j/(ci(p)+2._r8*cp)*c3psn(ivt(p)) + j*(1._r8-c3psn(ivt(p)))
           wc = max(ci(p)-cp,0._r8)*vcmx(p)/(ci(p)+awc)*c3psn(ivt(p)) + vcmx(p)*(1._r8-c3psn(ivt(p)))
           we = 0.5_r8*vcmx(p)*c3psn(ivt(p)) + 4000._r8*vcmx(p)*ci(p)/forc_pbot(g)*(1._r8-c3psn(ivt(p))) 
           psn(p) = min(wj,wc,we) 
           cs = max( co2(p)-1.37_r8*rb(p)*forc_pbot(g)*psn(p), mpe )
           atmp = mp(ivt(p))*psn(p)*forc_pbot(g)*cea / (cs*ei(p)) + bp
           btmp = ( mp(ivt(p))*psn(p)*forc_pbot(g)/cs + bp ) * rb(p) - 1._r8
           ctmp = -rb(p)
           if (btmp >= 0._r8) then
              q = -0.5_r8*( btmp + sqrt(btmp*btmp-4._r8*atmp*ctmp) )
           else
              q = -0.5_r8*( btmp - sqrt(btmp*btmp-4._r8*atmp*ctmp) )
           end if
           r1 = q/atmp
           r2 = ctmp/q
           rs(p) = max(r1,r2)
           ci(p) = max( cs-psn(p)*forc_pbot(g)*1.65_r8*rs(p), 0._r8 )
!NEC NEC NEC
#else
           do iter = 1, niter
              wj = max(ci(p)-cp,0._r8)*j/(ci(p)+2._r8*cp)*c3psn(ivt(p)) + j*(1._r8-c3psn(ivt(p)))
              wc = max(ci(p)-cp,0._r8)*vcmx(p)/(ci(p)+awc)*c3psn(ivt(p)) + vcmx(p)*(1._r8-c3psn(ivt(p)))
              we = 0.5_r8*vcmx(p)*c3psn(ivt(p)) + 4000._r8*vcmx(p)*ci(p)/forc_pbot(g)*(1._r8-c3psn(ivt(p))) 
              psn(p) = min(wj,wc,we) 
              cs = max( co2(p)-1.37_r8*rb(p)*forc_pbot(g)*psn(p), mpe )
              atmp = mp(ivt(p))*psn(p)*forc_pbot(g)*cea / (cs*ei(p)) + bp
              btmp = ( mp(ivt(p))*psn(p)*forc_pbot(g)/cs + bp ) * rb(p) - 1._r8
              ctmp = -rb(p)
              if (btmp >= 0._r8) then
                 q = -0.5_r8*( btmp + sqrt(btmp*btmp-4._r8*atmp*ctmp) )
              else
                 q = -0.5_r8*( btmp - sqrt(btmp*btmp-4._r8*atmp*ctmp) )
              end if
              r1 = q/atmp
              r2 = ctmp/q
              rs(p) = max(r1,r2)
              ci(p) = max( cs-psn(p)*forc_pbot(g)*1.65_r8*rs(p), 0._r8 )
           end do
#endif

           ! rs, rb:  s m**2 / umol -> s/m 

           rs(p) = min(rsmax0, rs(p)*cf)
           rb(p) = rb(p) * cf 
           
#if (defined C13)
           ! 4/14/05: PET
           ! Adding isotope code
           alphapsn(p) = 1._r8 + (((c3psn(ivt(p)) * (4.4_r8 + (22.6_r8*(ci(p)/co2(p))))) + &
                         ((1._r8 - c3psn(ivt(p))) * 4.4_r8))/1000._r8)
#endif
           
        end if

     end do

  end subroutine Stomata

end module CanopyFluxesMod
 subroutine biochem_to_wrf(htmx_buf,croplive_buf,gdd1020_buf,gdd820_buf,gdd020_buf,grainc_buf,grainc_storage_buf  &
                ,grainc_xfer_buf,grainn_buf,grainn_storage_buf,grainn_xfer_buf,days_active_buf  &
                ,onset_flag_buf,onset_counter_buf,onset_gddflag_buf,onset_fdd_buf,onset_gdd_buf &
                ,onset_swi_buf,offset_flag_buf,offset_counter_buf,offset_fdd_buf,offset_swi_buf &
                ,dayl_buf,annavg_t2m_buf,tempavg_t2m_buf,tempsum_potential_gpp_buf          &
                ,annsum_potential_gpp_buf,tempmax_retransn_buf,annmax_retransn_buf      &
                ,prev_leafc_to_litter_buf,prev_frootc_to_litter_buf,tempsum_npp_buf     &
                ,annsum_npp_buf,leafc_buf,leafc_storage_buf,leafc_xfer_buf,frootc_buf           &
                ,frootc_storage_buf,frootc_xfer_buf,livestemc_buf,livestemc_storage_buf     &
                ,livestemc_xfer_buf,deadstemc_buf,deadstemc_storage_buf,deadstemc_xfer_buf  &
                ,livecrootc_buf,livecrootc_storage_buf,livecrootc_xfer_buf,deadcrootc_buf   &
                ,deadcrootc_storage_buf,deadcrootc_xfer_buf,cpool_buf,pft_ctrunc_buf        &
                ,leafn_buf,leafn_storage_buf,leafn_xfer_buf,frootn_buf,frootn_storage_buf       &
                ,frootn_xfer_buf,livestemn_buf,livestemn_storage_buf,livestemn_xfer_buf     &
                ,deadstemn_buf,deadstemn_storage_buf,deadstemn_xfer_buf,livecrootn_buf      &
                ,livecrootn_storage_buf,livecrootn_xfer_buf,deadcrootn_buf              &
                ,deadcrootn_storage_buf,deadcrootn_xfer_buf,npool_buf,pft_ntrunc_buf        &
                ,gresp_storage_buf,gresp_xfer_buf,xsmrpool_buf,annsum_counter_buf           &
                ,cannsum_npp_buf,cannavg_t2m_buf,wf_buf,me_buf,mean_fire_prob_buf,cwdc_buf,litr1c_buf   &
                ,litr2c_buf,litr3c_buf,soil1c_buf,soil2c_buf,soil3c_buf,soil4c_buf,seedc_buf,col_ctrunc_buf &
                ,prod10c_buf,prod100c_buf,cwdn_buf,litr1n_buf,litr2n_buf,litr3n_buf,soil1n_buf,soil2n_buf   &
                ,soil3n_buf,soil4n_buf,seedn_buf,col_ntrunc_buf,prod10n_buf,prod100n_buf,sminn_buf &
               ,totlitc_buf,dwt_seedc_to_leaf_buf,dwt_seedc_to_deadstem_buf,dwt_conv_cflux_buf &
                ,dwt_prod10c_gain_buf,dwt_prod100c_gain_buf,prod100c_loss_buf,dwt_frootc_to_litr1c_buf &
                ,dwt_frootc_to_litr2c_buf,dwt_frootc_to_litr3c_buf,dwt_livecrootc_to_cwdc_buf &
                ,dwt_deadcrootc_to_cwdc_buf,dwt_seedn_to_leaf_buf,dwt_seedn_to_deadstem_buf &
                ,dwt_conv_nflux_buf,dwt_prod10n_gain_buf,dwt_prod100n_gain_buf,prod100n_loss_buf &
                ,dwt_frootn_to_litr1n_buf,dwt_frootn_to_litr2n_buf, dwt_frootn_to_litr3n_buf &
                , dwt_livecrootn_to_cwdn_buf,dwt_deadcrootn_to_cwdn_buf,retransn_buf &
                 )

#if (defined CN)
!-----------------------------------------------------------------------
! !USES:
  use shr_kind_mod, only: r8 => shr_kind_r8
    use clmtype
    use decompMod, only : get_proc_bounds
    use clm_varpar, only: maxpatch
!
! !PUBLIC TYPES:
  implicit none
  save
!-----------------------------------------------------------------------
! !LOCAL VARIABLES:
    integer :: c,p          ! indices
    integer :: begp, endp   ! per-proc beginning and ending pft indices
    integer :: begc, endc   ! per-proc beginning and ending column indices
    integer :: begl, endl   ! per-proc beginning and ending landunit indices
    integer :: begg, endg   ! per-proc gridcell ending gridcell indices

!-----------------------------------------------------------------------
  integer,dimension(maxpatch) :: croplive_buf
   real(r8), dimension(maxpatch)  ::  &
                 htmx_buf,gdd1020_buf,gdd820_buf,gdd020_buf,grainc_buf,grainc_storage_buf  &
                ,grainc_xfer_buf,grainn_buf,grainn_storage_buf,grainn_xfer_buf,days_active_buf  &
                ,onset_flag_buf,onset_counter_buf,onset_gddflag_buf,onset_fdd_buf,onset_gdd_buf &
                ,onset_swi_buf,offset_flag_buf,offset_counter_buf,offset_fdd_buf,offset_swi_buf &
                ,dayl_buf,annavg_t2m_buf,tempavg_t2m_buf,tempsum_potential_gpp_buf          &
                ,annsum_potential_gpp_buf,tempmax_retransn_buf,annmax_retransn_buf      &
                ,prev_leafc_to_litter_buf,prev_frootc_to_litter_buf,tempsum_npp_buf     &
                ,annsum_npp_buf,leafc_buf,leafc_storage_buf,leafc_xfer_buf,frootc_buf           &
                ,frootc_storage_buf,frootc_xfer_buf,livestemc_buf,livestemc_storage_buf     &
                ,livestemc_xfer_buf,deadstemc_buf,deadstemc_storage_buf,deadstemc_xfer_buf  &
                ,livecrootc_buf,livecrootc_storage_buf,livecrootc_xfer_buf,deadcrootc_buf   &
                ,deadcrootc_storage_buf,deadcrootc_xfer_buf,cpool_buf,pft_ctrunc_buf        &
                ,leafn_buf,leafn_storage_buf,leafn_xfer_buf,frootn_buf,frootn_storage_buf       &
                ,frootn_xfer_buf,livestemn_buf,livestemn_storage_buf,livestemn_xfer_buf     &
                ,deadstemn_buf,deadstemn_storage_buf,deadstemn_xfer_buf,livecrootn_buf      &
                ,livecrootn_storage_buf,livecrootn_xfer_buf,deadcrootn_buf              &
                ,deadcrootn_storage_buf,deadcrootn_xfer_buf,npool_buf,pft_ntrunc_buf        &
                ,gresp_storage_buf,gresp_xfer_buf,xsmrpool_buf,annsum_counter_buf           &
                ,cannsum_npp_buf,cannavg_t2m_buf,wf_buf,me_buf,mean_fire_prob_buf,cwdc_buf,litr1c_buf   &
                ,litr2c_buf,litr3c_buf,soil1c_buf,soil2c_buf,soil3c_buf,soil4c_buf,seedc_buf,col_ctrunc_buf &
                ,prod10c_buf,prod100c_buf,cwdn_buf,litr1n_buf,litr2n_buf,litr3n_buf,soil1n_buf,soil2n_buf   &
                ,soil3n_buf,soil4n_buf,seedn_buf,col_ntrunc_buf,prod10n_buf,prod100n_buf,sminn_buf &
                ,totlitc_buf,dwt_seedc_to_leaf_buf,dwt_seedc_to_deadstem_buf,dwt_conv_cflux_buf &
                ,dwt_prod10c_gain_buf,dwt_prod100c_gain_buf,prod100c_loss_buf,dwt_frootc_to_litr1c_buf &
                ,dwt_frootc_to_litr2c_buf,dwt_frootc_to_litr3c_buf,dwt_livecrootc_to_cwdc_buf &
                ,dwt_deadcrootc_to_cwdc_buf,dwt_seedn_to_leaf_buf,dwt_seedn_to_deadstem_buf &
                ,dwt_conv_nflux_buf,dwt_prod10n_gain_buf,dwt_prod100n_gain_buf,prod100n_loss_buf &
                ,dwt_frootn_to_litr1n_buf,dwt_frootn_to_litr2n_buf, dwt_frootn_to_litr3n_buf &
                , dwt_livecrootn_to_cwdn_buf,dwt_deadcrootn_to_cwdn_buf,retransn_buf
    


    ! Determine necessary subgrid bounds

    call get_proc_bounds(begg, endg, begl, endl, begc, endc, begp, endp)

!coloum level

   do c=begc,endc
    annsum_counter_buf(c)                 = clm3%g%l%c%cps%annsum_counter(c)
    cannsum_npp_buf(c)                    = clm3%g%l%c%cps%cannsum_npp(c)
    cannavg_t2m_buf(c)                    = clm3%g%l%c%cps%cannavg_t2m(c)
    wf_buf(c)                             = clm3%g%l%c%cps%wf(c)
    me_buf(c)                             = clm3%g%l%c%cps%me(c)
    mean_fire_prob_buf(c)                 = clm3%g%l%c%cps%mean_fire_prob(c)
    cwdc_buf(c)                           = clm3%g%l%c%ccs%cwdc(c)
    litr1c_buf(c)                         = clm3%g%l%c%ccs%litr1c(c)
    litr2c_buf(c)                         = clm3%g%l%c%ccs%litr2c(c)
    litr3c_buf(c)                         = clm3%g%l%c%ccs%litr3c(c)
    soil1c_buf(c)                         = clm3%g%l%c%ccs%soil1c(c)
    soil2c_buf(c)                         = clm3%g%l%c%ccs%soil2c(c)
    soil3c_buf(c)                         = clm3%g%l%c%ccs%soil3c(c)
    soil4c_buf(c)                         = clm3%g%l%c%ccs%soil4c(c)
    col_ctrunc_buf(c)                     = clm3%g%l%c%ccs%col_ctrunc(c)
    cwdn_buf(c)                           = clm3%g%l%c%cns%cwdn(c)
    litr1n_buf(c)                         = clm3%g%l%c%cns%litr1n(c)
    litr2n_buf(c)                         = clm3%g%l%c%cns%litr2n(c)
    litr3n_buf(c)                         = clm3%g%l%c%cns%litr3n(c)
    soil1n_buf(c)                         = clm3%g%l%c%cns%soil1n(c)
    soil2n_buf(c)                         = clm3%g%l%c%cns%soil2n(c)
    soil3n_buf(c)                         = clm3%g%l%c%cns%soil3n(c)
    soil4n_buf(c)                         = clm3%g%l%c%cns%soil4n(c)
    col_ntrunc_buf(c)                     = clm3%g%l%c%cns%col_ntrunc(c)
    seedc_buf(c)                          = clm3%g%l%c%ccs%seedc(c)
    prod10c_buf(c)                        = clm3%g%l%c%ccs%prod10c(c)
    prod100c_buf(c)                       = clm3%g%l%c%ccs%prod100c(c)
    seedn_buf(c)                          = clm3%g%l%c%cns%seedn(c)
    prod10n_buf(c)                        = clm3%g%l%c%cns%prod10n(c)
    prod100n_buf(c)                       = clm3%g%l%c%cns%prod100n(c)
    dwt_seedc_to_leaf_buf(c)              = clm3%g%l%c%ccf%dwt_seedc_to_leaf(c)
    dwt_seedc_to_deadstem_buf(c)          = clm3%g%l%c%ccf%dwt_seedc_to_deadstem(c) 
    dwt_conv_cflux_buf(c)                 = clm3%g%l%c%ccf%dwt_conv_cflux(c) 
    dwt_prod10c_gain_buf(c)               = clm3%g%l%c%ccf%dwt_prod10c_gain(c)
    dwt_prod100c_gain_buf(c)              = clm3%g%l%c%ccf%dwt_prod100c_gain(c)
    prod100c_loss_buf(c)                  = clm3%g%l%c%ccf%prod100c_loss(c) 
    dwt_frootc_to_litr1c_buf(c)           = clm3%g%l%c%ccf%dwt_frootc_to_litr1c(c) 
    dwt_frootc_to_litr2c_buf(c)           = clm3%g%l%c%ccf%dwt_frootc_to_litr2c(c) 
    dwt_frootc_to_litr3c_buf(c)           = clm3%g%l%c%ccf%dwt_frootc_to_litr3c(c) 
    dwt_livecrootc_to_cwdc_buf(c)         = clm3%g%l%c%ccf%dwt_livecrootc_to_cwdc(c)
    dwt_deadcrootc_to_cwdc_buf(c)         = clm3%g%l%c%ccf%dwt_deadcrootc_to_cwdc(c)
    dwt_seedn_to_leaf_buf(c)              = clm3%g%l%c%cnf%dwt_seedn_to_leaf(c) 
    dwt_seedn_to_deadstem_buf(c)          = clm3%g%l%c%cnf%dwt_seedn_to_deadstem(c) 
    dwt_conv_nflux_buf(c)                 = clm3%g%l%c%cnf%dwt_conv_nflux(c) 
    dwt_prod10n_gain_buf(c)               = clm3%g%l%c%cnf%dwt_prod10n_gain(c) 
    dwt_prod100n_gain_buf(c)              = clm3%g%l%c%cnf%dwt_prod100n_gain(c)
    prod100n_loss_buf(c)                  = clm3%g%l%c%cnf%prod100n_loss(c) 
    dwt_frootn_to_litr1n_buf(c)           = clm3%g%l%c%cnf%dwt_frootn_to_litr1n(c)
    dwt_frootn_to_litr2n_buf(c)           = clm3%g%l%c%cnf%dwt_frootn_to_litr2n(c)
    dwt_frootn_to_litr3n_buf(c)           = clm3%g%l%c%cnf%dwt_frootn_to_litr3n(c)
    dwt_livecrootn_to_cwdn_buf(c)         = clm3%g%l%c%cnf%dwt_livecrootn_to_cwdn(c)
    dwt_deadcrootn_to_cwdn_buf(c)         = clm3%g%l%c%cnf%dwt_deadcrootn_to_cwdn(c)



   end do



    ! pft type dgvm physical state - annpsnpot
    do p = begp,endp
    leafc_buf(p)                          = clm3%g%l%c%p%pcs%leafc(p)
    leafc_storage_buf(p)                  = clm3%g%l%c%p%pcs%leafc_storage(p)
    leafc_xfer_buf(p)                     = clm3%g%l%c%p%pcs%leafc_xfer(p)
#if (defined CROP)
    grainc_buf(p)                         = clm3%g%l%c%p%pcs%grainc(p)
    grainc_storage_buf(p)                 = clm3%g%l%c%p%pcs%grainc_storage(p)
    grainc_xfer_buf(p)                    = clm3%g%l%c%p%pcs%grainc_xfer(p)
    gdd020_buf(p)                         = clm3%g%l%c%p%pps%gdd020(p)
    gdd820_buf(p)                         = clm3%g%l%c%p%pps%gdd820(p)
    gdd1020_buf(p)                        = clm3%g%l%c%p%pps%gdd1020(p)
    croplive_buf(p)                       = clm3%g%l%c%p%pps%croplive(p)
    htmx_buf(p)                           = clm3%g%l%c%p%pps%htmx(p)
#endif
    frootc_buf(p)                         = clm3%g%l%c%p%pcs%frootc(p)
    frootc_storage_buf(p)                 = clm3%g%l%c%p%pcs%frootc_storage(p)
    frootc_xfer_buf(p)                    = clm3%g%l%c%p%pcs%frootc_xfer(p)
    livestemc_buf(p)                      = clm3%g%l%c%p%pcs%livestemc(p)
    livestemc_storage_buf(p)              = clm3%g%l%c%p%pcs%livestemc_storage(p)
    livestemc_xfer_buf(p)                 = clm3%g%l%c%p%pcs%livestemc_xfer(p)
    deadstemc_buf(p)                      = clm3%g%l%c%p%pcs%deadstemc(p)
    deadstemc_storage_buf(p)              = clm3%g%l%c%p%pcs%deadstemc_storage(p)
    deadstemc_xfer_buf(p)                 = clm3%g%l%c%p%pcs%deadstemc_xfer(p)
    livecrootc_buf(p)                     = clm3%g%l%c%p%pcs%livecrootc(p)
    livecrootc_storage_buf(p)             = clm3%g%l%c%p%pcs%livecrootc_storage(p)
    livecrootc_xfer_buf(p)                = clm3%g%l%c%p%pcs%livecrootc_xfer(p)
    deadcrootc_buf(p)                     = clm3%g%l%c%p%pcs%deadcrootc(p)
    deadcrootc_storage_buf(p)             = clm3%g%l%c%p%pcs%deadcrootc_storage(p)
    deadcrootc_xfer_buf(p)                = clm3%g%l%c%p%pcs%deadcrootc_xfer(p)
    gresp_storage_buf(p)                  = clm3%g%l%c%p%pcs%gresp_storage(p)
    gresp_xfer_buf(p)                     = clm3%g%l%c%p%pcs%gresp_xfer(p)
    cpool_buf(p)                          = clm3%g%l%c%p%pcs%cpool(p)
    xsmrpool_buf(p)                       = clm3%g%l%c%p%pcs%xsmrpool(p)
      leafn_buf(p)                        = clm3%g%l%c%p%pns%leafn(p)
    leafn_storage_buf(p)                  = clm3%g%l%c%p%pns%leafn_storage(p)
    leafn_xfer_buf(p)                     = clm3%g%l%c%p%pns%leafn_xfer(p)
#if (defined CROP)
    grainn_buf(p)                         = clm3%g%l%c%p%pns%grainn(p)
    grainn_storage_buf(p)                 = clm3%g%l%c%p%pns%grainn_storage(p)
    grainn_xfer_buf(p)                    = clm3%g%l%c%p%pns%grainn_xfer(p)
#endif
    frootn_buf(p)                         = clm3%g%l%c%p%pns%frootn(p)
    frootn_storage_buf(p)                 = clm3%g%l%c%p%pns%frootn_storage(p)
    frootn_xfer_buf(p)                    = clm3%g%l%c%p%pns%frootn_xfer(p)
    livestemn_buf(p)                      = clm3%g%l%c%p%pns%livestemn(p)
    livestemn_storage_buf(p)              = clm3%g%l%c%p%pns%livestemn_storage(p)
    livestemn_xfer_buf(p)                 = clm3%g%l%c%p%pns%livestemn_xfer(p)
    deadstemn_buf(p)                      = clm3%g%l%c%p%pns%deadstemn(p)
    deadstemn_storage_buf(p)              = clm3%g%l%c%p%pns%deadstemn_storage(p)
    deadstemn_xfer_buf(p)                 = clm3%g%l%c%p%pns%deadstemn_xfer(p)
    livecrootn_buf(p)                     = clm3%g%l%c%p%pns%livecrootn(p)
    livecrootn_storage_buf(p)             = clm3%g%l%c%p%pns%livecrootn_storage(p)
    livecrootn_xfer_buf(p)                = clm3%g%l%c%p%pns%livecrootn_xfer(p)
    deadcrootn_buf(p)                     = clm3%g%l%c%p%pns%deadcrootn(p)
    deadcrootn_storage_buf(p)             = clm3%g%l%c%p%pns%deadcrootn_storage(p)
    deadcrootn_xfer_buf(p)                = clm3%g%l%c%p%pns%deadcrootn_xfer(p)
    npool_buf(p)                          = clm3%g%l%c%p%pns%npool(p)
    retransn_buf(p)                       = clm3%g%l%c%p%pns%retransn(p)
    days_active_buf(p)                    = clm3%g%l%c%p%pepv%days_active(p)
    onset_flag_buf(p)                     = clm3%g%l%c%p%pepv%onset_flag(p)
    onset_counter_buf(p)                  = clm3%g%l%c%p%pepv%onset_counter(p)
    onset_gddflag_buf(p)                  = clm3%g%l%c%p%pepv%onset_gddflag(p)
    onset_fdd_buf(p)                      = clm3%g%l%c%p%pepv%onset_fdd(p)
    onset_gdd_buf(p)                      = clm3%g%l%c%p%pepv%onset_gdd(p)
    onset_swi_buf(p)                      = clm3%g%l%c%p%pepv%onset_swi(p)
    offset_flag_buf(p)                    = clm3%g%l%c%p%pepv%offset_flag(p)
    offset_counter_buf(p)                 = clm3%g%l%c%p%pepv%offset_counter(p)
    offset_fdd_buf(p)                     = clm3%g%l%c%p%pepv%offset_fdd(p)
    offset_swi_buf(p)                     = clm3%g%l%c%p%pepv%offset_swi(p)
      dayl_buf(p)                         = clm3%g%l%c%p%pepv%dayl(p)
    annavg_t2m_buf(p)                     = clm3%g%l%c%p%pepv%annavg_t2m(p)
    tempavg_t2m_buf(p)                    = clm3%g%l%c%p%pepv%tempavg_t2m(p)
    tempsum_potential_gpp_buf(p)          = clm3%g%l%c%p%pepv%tempsum_potential_gpp(p)
    annsum_potential_gpp_buf(p)           = clm3%g%l%c%p%pepv%annsum_potential_gpp(p)
    tempmax_retransn_buf(p)               = clm3%g%l%c%p%pepv%tempmax_retransn(p)
    annmax_retransn_buf(p)                = clm3%g%l%c%p%pepv%annmax_retransn(p)
    prev_frootc_to_litter_buf(p)          = clm3%g%l%c%p%pepv%prev_frootc_to_litter(p)
    prev_leafc_to_litter_buf(p)           = clm3%g%l%c%p%pepv%prev_leafc_to_litter(p)
    pft_ctrunc_buf(p)                     = clm3%g%l%c%p%pcs%pft_ctrunc(p)
    pft_ntrunc_buf(p)                     = clm3%g%l%c%p%pns%pft_ntrunc(p)
    tempsum_npp_buf(p)                    = clm3%g%l%c%p%pepv%tempsum_npp(p)
    annsum_npp_buf(p)                     = clm3%g%l%c%p%pepv%annsum_npp(p)


    end do

#endif
  end subroutine biochem_to_wrf

!------------------------------------------------------------------------
subroutine biophy_to_wrf(snl      ,snowdp  ,dzclm      ,zclm        ,&
                      ziclm       ,h2osno  ,h2osoi_liq   ,h2osoi_ice ,t_grnd      ,&
                      t_soisno    ,t_lake  ,t_veg        ,h2ocan     ,h2ocan_col  ,&
                      h2osoi_vol  ,wtc     ,wtp          ,numc       ,nump        ,&
                      htop        ,tsai       &
                      ,t_ref2m ,znt          ,q_ref2m,snw_rds) 
!
! !DESCRIPTION: 
! Read/Write biogeophysics information to/from restart file. 
!
! !USES:
    use shr_kind_mod, only: r8 => shr_kind_r8
    use clmtype
    use clm_varpar, only : nlevgrnd,numrad,maxpatch,nlevsno,nlevlak
    use clm_varcon, only : denice, denh2o
    use nanMod, only : nan
    use decompMod , only : get_proc_bounds
    use pftvarcon , only : noveg
!
! !ARGUMENTS:
    implicit none

! The following vraiables for a WRF restart run
    integer   :: snl(maxpatch)
    integer   :: frac_veg_nosno_alb(maxpatch)
    real(r8)  :: snowdp(maxpatch)
!    real(r8)  :: snowage(maxpatch)
    real(r8)  :: frac_sno(maxpatch)
    real(r8)  :: albd(numrad,maxpatch)
    real(r8)  :: albi(numrad,maxpatch)
    real(r8)  :: albgrd(numrad,maxpatch)
    real(r8)  :: albgri(numrad,maxpatch)
    real(r8)  :: h2osno(maxpatch)
    real(r8)  :: t_grnd(maxpatch)
    real(r8)  :: fwet(maxpatch)
    real(r8)  :: tlai(maxpatch)
    real(r8)  :: tsai(maxpatch)
    real(r8)  :: elai(maxpatch)
    real(r8)  :: esai(maxpatch)
    real(r8)  :: fsun(maxpatch)
    real(r8)  :: htop(maxpatch)
    real(r8)  :: hbot(maxpatch)
    real(r8)  :: fabd(numrad,maxpatch)
    real(r8)  :: fabi(numrad,maxpatch)
    real(r8)  :: ftdd(numrad,maxpatch)
    real(r8)  :: ftid(numrad,maxpatch)
    real(r8)  :: ftii(numrad,maxpatch)
    real(r8)  :: t_veg(maxpatch)
    real(r8)  :: h2ocan(maxpatch)
    real(r8)  :: h2ocan_col(maxpatch)
    real(r8)  :: wtc(maxpatch)
    real(r8)  :: wtp(maxpatch)

  real(r8)  :: snw_rds(maxpatch,-nlevsno+1:0)
  real(r8)  :: t_lake(maxpatch,nlevlak)
  real(r8)  :: t_soisno(maxpatch,-nlevsno+1:nlevgrnd)
  real(r8)  :: h2osoi_liq(maxpatch,-nlevsno+1:nlevgrnd)
  real(r8)  :: h2osoi_ice(maxpatch,-nlevsno+1:nlevgrnd)
  real(r8)  :: dzclm(maxpatch,-nlevsno+1:nlevgrnd)
  real(r8)  :: zclm(maxpatch,-nlevsno+1:nlevgrnd)
  real(r8)  :: ziclm(maxpatch,-nlevsno:nlevgrnd)
  real(r8)  :: h2osoi_vol(maxpatch,nlevgrnd)

    real(r8)  :: t_ref2m(maxpatch)
    real(r8)  :: q_ref2m(maxpatch)

    real(r8)  :: znt(maxpatch)
!
! !LOCAL VARIABLES:
    integer :: g,l,c,p,j    ! indices
    real(r8):: pftsum       ! temporary used for pft averaging for columns
    integer :: begp, endp   ! per-proc beginning and ending pft indices
    integer :: begc, endc   ! per-proc beginning and ending column indices
    integer :: begl, endl   ! per-proc beginning and ending landunit indices
    integer :: begg, endg   ! per-proc gridcell ending gridcell indices
    integer :: numc, nump
!-----------------------------------------------------------------------
    call get_proc_bounds(begg, endg, begl, endl, begc, endc, begp, endp)

    numc = endc-begc+1
    nump = endp-begp+1

    ! Column physical state - snl
    do c = begc,endc
       snl(c) = clm3%g%l%c%cps%snl(c)
    end do


    ! Column physical state - snowdp
    do c = begc,endc
       snowdp(c) =  clm3%g%l%c%cps%snowdp(c)
    end do

    do j = -nlevsno+1,0
     do c = begc,endc
       snw_rds(c,j) = clm3%g%l%c%cps%snw_rds(c,j)
     end do
    end do


    ! Column physical state - snowage
!    do c = begc,endc
!       snowage(c) = clm3%g%l%c%cps%snowage(c)
!    end do

    ! Column physical state - frac_sno
    do c = begc,endc
       frac_sno(c) = clm3%g%l%c%cps%frac_sno(c)
    end do

    ! Column physical state - dz (snow)
    do j = -nlevsno+1,0
       do c = begc,endc
          dzclm(c,j) = clm3%g%l%c%cps%dz(c,j)
       end do
    end do

    ! Column physical state - z (snow)
    do j = -nlevsno+1,0
       do c = begc,endc
          zclm(c,j) = clm3%g%l%c%cps%z(c,j)
       end do
    end do

    do j = -nlevsno,0
       do c = begc,endc
          ziclm(c,j) = clm3%g%l%c%cps%zi(c,j)
       end do
    end do

    !pft type physical state variable - albd
    do j = 1,numrad
       do p = begp,endp
          albd(j,p) = clm3%g%l%c%p%pps%albd(p,j)
       end do
    end do

    !pft type physical state variable - albi
    do j = 1,numrad
       do p = begp,endp
          albi(j,p) = clm3%g%l%c%p%pps%albi(p,j)
       end do
    end do

    !column type physical state variable - albgrd
    do j = 1,numrad
       do c = begc,endc
          albgrd(j,c) = clm3%g%l%c%cps%albgrd(c,j)
       end do
    end do

    !column type physical state variable - albgri
    do j = 1,numrad
       do c = begc,endc
          albgri(j,c) = clm3%g%l%c%cps%albgri(c,j)
       end do
    end do

   ! column water state variable - h2osno
    do c = begc,endc
       h2osno(c) = clm3%g%l%c%cws%h2osno(c)
    end do

   ! column water state variable - h2osoi_liq
    do j = -nlevsno+1,nlevgrnd
       do c = begc,endc
          h2osoi_liq(c,j) = clm3%g%l%c%cws%h2osoi_liq(c,j)
       end do
    end do

   ! column water state variable - h2osoi_ice
    do j = -nlevsno+1,nlevgrnd
       do c = begc,endc
          h2osoi_ice(c,j) = clm3%g%l%c%cws%h2osoi_ice(c,j)
       end do
    end do

   ! column energy state variable - t_grnd
    do c = begc,endc
       t_grnd(c) = clm3%g%l%c%ces%t_grnd(c)
    end do




   ! pft energy state variable - t_ref2m
    do p = begp,endp
       t_ref2m(p) = clm3%g%l%c%p%pes%t_ref2m(p)
    end do

   ! pft energy state variable - q_ref2m
    do p = begp,endp
       q_ref2m(p) = clm3%g%l%c%p%pes%q_ref2m(p)
    end do

   ! column energy state variable - t_soisno
    do j = -nlevsno+1,nlevgrnd
       do c = begc,endc
          t_soisno(c,j) = clm3%g%l%c%ces%t_soisno(c,j)
       end do
    end do

    !column type energy state variable - t_lake
    do j = 1,nlevlak
       do c = begc,endc
          t_lake(c,j) = clm3%g%l%c%ces%t_lake(c,j) 
       end do
    end do

    ! pft type physical state variable - frac_veg_nosno_alb 
    do p = begp,endp
       frac_veg_nosno_alb(p) = clm3%g%l%c%p%pps%frac_veg_nosno_alb(p) 
    end do

    ! pft type physical state variable - fwet
    do p = begp,endp
       fwet(p) = clm3%g%l%c%p%pps%fwet(p)
    end do

    ! pft type physical state variable - tlai
    do p = begp,endp
       tlai(p) = clm3%g%l%c%p%pps%tlai(p)
    end do

    ! pft type physical state variable - tsai
    do p = begp,endp
       tsai(p) =  clm3%g%l%c%p%pps%tsai(p)
    end do

    ! pft type physical state variable - elai
    do p = begp,endp
       elai(p) = clm3%g%l%c%p%pps%elai(p)
    end do

    ! pft type physical state variable - esai
    do p = begp,endp
       esai(p)= clm3%g%l%c%p%pps%esai(p)
    end do

    ! pft type physical state variable - fsun
    do p = begp,endp
       fsun(p)= clm3%g%l%c%p%pps%fsun(p)
    end do

    ! pft type physical state variable - htop
    do p = begp,endp
       htop(p)= clm3%g%l%c%p%pps%htop(p)
    end do

    ! pft type physical state variable - hbot
    do p = begp,endp
       hbot(p)= clm3%g%l%c%p%pps%hbot(p)
    end do

    ! pft type physical state variable - fabd
    do j = 1,numrad
       do p = begp,endp
          fabd(j,p) = clm3%g%l%c%p%pps%fabd(p,j)
       end do
    end do

    ! pft type physical state variable - fabi
    do j = 1,numrad
       do p = begp,endp
          fabi(j,p) = clm3%g%l%c%p%pps%fabi(p,j)
       end do
    end do

    ! pft type physical state variable - ftdd
    do j = 1,numrad
       do p = begp,endp
          ftdd(j,p) = clm3%g%l%c%p%pps%ftdd(p,j)
       end do
    end do

    ! pft type physical state variable - ftid
    do j = 1,numrad
       do p = begp,endp
          ftid(j,p) = clm3%g%l%c%p%pps%ftid(p,j)
       end do
    end do

    ! pft type physical state variable - ftii
    do j = 1,numrad
       do p = begp,endp
          ftii(j,p) = clm3%g%l%c%p%pps%ftii(p,j)
       end do
    end do

    ! pft type energy state variable - t_veg
    do p = begp,endp
       t_veg(p) = clm3%g%l%c%p%pes%t_veg(p)
    end do

    ! pft type water state variable - h2ocan 
    do p = begp,endp
       h2ocan(p) = clm3%g%l%c%p%pws%h2ocan(p)
    end do

    do p = begp,endp
        c  = clm3%g%l%c%p%column(p)
       if(clm3%g%l%c%p%itype(p)/=noveg) then
          znt(p) = clm3%g%l%c%p%pps%z0mv(p)
       else
          znt(p) = clm3%g%l%c%cps%z0mg(c)
       end if
    end do

    ! For read only:
    ! Determine average over all column pfts for h2ocan, needed by begwb
    ! computation in routine driver.F90) - this needs to be done after the
    ! weights are reset in the DGVM case
    ! The following should not be vectorized
       do c = begc,endc
          clm3%g%l%c%cws%pws_a%h2ocan(c) = 0.
       end do
       do p = begp,endp
          c = clm3%g%l%c%p%column(p)
          clm3%g%l%c%cws%pws_a%h2ocan(c) =  clm3%g%l%c%cws%pws_a%h2ocan(c) &
               + clm3%g%l%c%p%pws%h2ocan(p) * clm3%g%l%c%p%wtcol(p)
          h2ocan_col(c)  = clm3%g%l%c%cws%pws_a%h2ocan(c)
       end do

    ! For read only:
    ! Determine volumetric soil water
    do j = 1,nlevgrnd
        do c = begc,endc
            clm3%g%l%c%cws%h2osoi_vol(c,j) = &
                clm3%g%l%c%cws%h2osoi_liq(c,j)/(clm3%g%l%c%cps%dz(c,j)*denh2o) &
              + clm3%g%l%c%cws%h2osoi_ice(c,j)/(clm3%g%l%c%cps%dz(c,j)*denice)
            h2osoi_vol(c,j) = clm3%g%l%c%cws%h2osoi_vol(c,j)
        end do
     end do


    do c = begc,endc
         wtc(c)   = clm3%g%l%c%wtgcell(c)
    end do

    do p = begp,endp
         wtp(p)  = clm3%g%l%c%p%wtgcell(p)
    end do
    
  end subroutine biophy_to_wrf
!===========================================================================================================
module BalanceCheckMod

!-----------------------------------------------------------------------
!BOP
!
! !MODULE: BalanceCheckMod
!
! !DESCRIPTION:
! Water and energy balance check.
!
! !USES:
  use shr_kind_mod, only: r8 => shr_kind_r8
!
! !PUBLIC TYPES:
  implicit none
  save
!
! !PUBLIC MEMBER FUNCTIONS:
  public :: BeginWaterBalance  ! Initialize water balance check
  public :: BalanceCheck       ! Water and energy balance check
!
! !REVISION HISTORY:
! Created by Mariana Vertenstein
!
!EOP
!-----------------------------------------------------------------------

contains

!-----------------------------------------------------------------------
!BOP
!
! !IROUTINE: BeginWaterBalance
!
! !INTERFACE:
  subroutine BeginWaterBalance(lbc, ubc, lbp, ubp, &
             num_nolakec, filter_nolakec, num_lakec, filter_lakec, &
             num_hydrologyc, filter_hydrologyc)
!
! !DESCRIPTION:
! Initialize column-level water balance at beginning of time step
!
! !USES:
    use shr_kind_mod , only : r8 => shr_kind_r8
    use clmtype
    use clm_varpar   , only : nlevgrnd, nlevsoi
    use subgridAveMod, only : p2c
    use clm_varcon   , only : icol_roof, icol_sunwall, icol_shadewall, icol_road_perv, &
                              icol_road_imperv
!
! !ARGUMENTS:
    implicit none
    integer, intent(in) :: lbc, ubc                    ! column-index bounds
    integer, intent(in) :: lbp, ubp                    ! pft-index bounds
    integer, intent(in) :: num_nolakec                 ! number of column non-lake points in column filter
    integer, intent(in) :: filter_nolakec(ubc-lbc+1)   ! column filter for non-lake points
    integer, intent(in) :: num_lakec                   ! number of column non-lake points in column filter
    integer, intent(in) :: filter_lakec(ubc-lbc+1)     ! column filter for non-lake points
    integer , intent(in)  :: num_hydrologyc               ! number of column soil points in column filter
    integer , intent(in)  :: filter_hydrologyc(ubc-lbc+1) ! column filter for soil points
!
! !CALLED FROM:
! subroutine clm_driver1
!
! !REVISION HISTORY:
! Created by Peter Thornton
!
!EOP
!
! !LOCAL VARIABLES:
!
! local pointers to original implicit in variables
!
    real(r8), pointer :: h2osno(:)             ! snow water (mm H2O)
    real(r8), pointer :: h2osoi_ice(:,:)       ! ice lens (kg/m2)
    real(r8), pointer :: h2osoi_liq(:,:)       ! liquid water (kg/m2)
    real(r8), pointer :: h2ocan_pft(:)         ! canopy water (mm H2O) (pft-level) 
    real(r8), pointer :: wa(:)                 ! water in the unconfined aquifer (mm)
    integer , pointer :: ctype(:)              ! column type 
    real(r8), pointer :: zwt(:)                ! water table depth (m)
    real(r8), pointer :: zi(:,:)               ! interface level below a "z" level (m)
!
! local pointers to original implicit out variables
!
    real(r8), pointer :: h2ocan_col(:)         ! canopy water (mm H2O) (column level)
    real(r8), pointer :: begwb(:)              ! water mass begining of the time step
!
! !OTHER LOCAL VARIABLES:
!
    integer :: c, p, f, j, fc            ! indices
!-----------------------------------------------------------------------

    ! Assign local pointers to derived type members (column-level)

    h2osno             => clm3%g%l%c%cws%h2osno
    h2osoi_ice         => clm3%g%l%c%cws%h2osoi_ice
    h2osoi_liq         => clm3%g%l%c%cws%h2osoi_liq
    begwb              => clm3%g%l%c%cwbal%begwb
    h2ocan_col         => clm3%g%l%c%cws%pws_a%h2ocan
    wa                 => clm3%g%l%c%cws%wa
    ctype              => clm3%g%l%c%itype
    zwt                => clm3%g%l%c%cws%zwt
    zi                 => clm3%g%l%c%cps%zi

    ! Assign local pointers to derived type members (pft-level)

    h2ocan_pft         => clm3%g%l%c%p%pws%h2ocan

    ! Determine beginning water balance for time step
    ! pft-level canopy water averaged to column
    call p2c(num_nolakec, filter_nolakec, h2ocan_pft, h2ocan_col)

    do f = 1, num_hydrologyc
       c = filter_hydrologyc(f)
       if(zwt(c) <= zi(c,nlevsoi)) then
          wa(c) = 5000._r8
       end if
    end do

    do f = 1, num_nolakec
       c = filter_nolakec(f)
       if (ctype(c) == icol_roof .or. ctype(c) == icol_sunwall &
          .or. ctype(c) == icol_shadewall .or. ctype(c) == icol_road_imperv) then
         begwb(c) = h2ocan_col(c) + h2osno(c)
       else
         begwb(c) = h2ocan_col(c) + h2osno(c) + wa(c)
       end if
    end do
    do j = 1, nlevgrnd
      do f = 1, num_nolakec
         c = filter_nolakec(f)
         begwb(c) = begwb(c) + h2osoi_ice(c,j) + h2osoi_liq(c,j)
      end do
    end do

    do f = 1, num_lakec
       c = filter_lakec(f)
       begwb(c) = h2osno(c)
    end do

  end subroutine BeginWaterBalance
!-----------------------------------------------------------------------

!-----------------------------------------------------------------------
!BOP
!
! !IROUTINE: BalanceCheck
!
! !INTERFACE:
  subroutine BalanceCheck(lbp, ubp, lbc, ubc, lbl, ubl, lbg, ubg)
!
! !DESCRIPTION:
! This subroutine accumulates the numerical truncation errors of the water
! and energy balance calculation. It is helpful to see the performance of
! the process of integration.
!
! The error for energy balance:
!
! error = abs(Net radiation - change of internal energy - Sensible heat
!             - Latent heat)
!
! The error for water balance:
!
! error = abs(precipitation - change of water storage - evaporation - runoff)
!
! !USES:
    use clmtype
    use subgridAveMod
    use globals , only :nstep, dtime
    use clm_varcon   , only : isturb, icol_roof, icol_sunwall, icol_shadewall, &
                              spval, icol_road_perv, icol_road_imperv
!
! !ARGUMENTS:
    implicit none
    integer :: lbp, ubp ! pft-index bounds
    integer :: lbc, ubc ! column-index bounds
    integer :: lbl, ubl ! landunit-index bounds
    integer :: lbg, ubg ! grid-index bounds
!
! !CALLED FROM:
! subroutine clm_driver
!
! !REVISION HISTORY:
! 15 September 1999: Yongjiu Dai; Initial code
! 15 December 1999:  Paul Houser and Jon Radakovich; F90 Revision
! 10 November 2000: Mariana Vertenstein
! Migrated to new data structures by Mariana Vertenstein and
! Peter Thornton
!
! !LOCAL VARIABLES:
!
! local pointers to original implicit in arguments
!
    integer , pointer :: pgridcell(:)       ! pft's gridcell index
    integer , pointer :: plandunit(:)       ! pft's landunit index
    integer , pointer :: cgridcell(:)       ! column's gridcell index
    integer , pointer :: ltype(:)           ! landunit type 
    integer , pointer :: ctype(:)           ! column type 
    real(r8), pointer :: pwtgcell(:)        ! pft's weight relative to corresponding gridcell
    real(r8), pointer :: cwtgcell(:)        ! column's weight relative to corresponding gridcell
    real(r8), pointer :: forc_rain(:)       ! rain rate [mm/s]
    real(r8), pointer :: forc_snow(:)       ! snow rate [mm/s]
    real(r8), pointer :: forc_lwrad(:)      ! downward infrared (longwave) radiation (W/m**2)
    real(r8), pointer :: endwb(:)           ! water mass end of the time step
    real(r8), pointer :: begwb(:)           ! water mass begining of the time step
    real(r8), pointer :: fsa(:)             ! solar radiation absorbed (total) (W/m**2)
    real(r8), pointer :: fsr(:)             ! solar radiation reflected (W/m**2)
    real(r8), pointer :: eflx_lwrad_out(:)  ! emitted infrared (longwave) radiation (W/m**2)
    real(r8), pointer :: eflx_lwrad_net(:)  ! net infrared (longwave) rad (W/m**2) [+ = to atm]
    real(r8), pointer :: sabv(:)            ! solar radiation absorbed by vegetation (W/m**2)
    real(r8), pointer :: sabg(:)            ! solar radiation absorbed by ground (W/m**2)
    real(r8), pointer :: eflx_sh_tot(:)     ! total sensible heat flux (W/m**2) [+ to atm]
    real(r8), pointer :: eflx_sh_totg(:)    ! total sensible heat flux at grid level (W/m**2) [+ to atm]
    real(r8), pointer :: eflx_dynbal(:)     ! energy conversion flux due to dynamic land cover change(W/m**2) [+ to atm]
    real(r8), pointer :: eflx_lh_tot(:)     ! total latent heat flux (W/m8*2)  [+ to atm]
    real(r8), pointer :: eflx_soil_grnd(:)  ! soil heat flux (W/m**2) [+ = into soil]
    real(r8), pointer :: qflx_evap_tot(:)   ! qflx_evap_soi + qflx_evap_veg + qflx_tran_veg
    real(r8), pointer :: qflx_surf(:)       ! surface runoff (mm H2O /s)
    real(r8), pointer :: qflx_qrgwl(:)      ! qflx_surf at glaciers, wetlands, lakes
    real(r8), pointer :: qflx_drain(:)      ! sub-surface runoff (mm H2O /s)
    real(r8), pointer :: qflx_runoff(:)     ! total runoff (mm H2O /s)
    real(r8), pointer :: qflx_runoffg(:)    ! total runoff at gridcell level inc land cover change flux (mm H2O /s)
    real(r8), pointer :: qflx_liq_dynbal(:) ! liq runoff due to dynamic land cover change (mm H2O /s)
    real(r8), pointer :: qflx_snwcp_ice(:)  ! excess snowfall due to snow capping (mm H2O /s) [+]`
    real(r8), pointer :: qflx_snwcp_iceg(:) ! excess snowfall due to snow cap inc land cover change flux (mm H20/s)
    real(r8), pointer :: qflx_ice_dynbal(:) ! ice runoff due to dynamic land cover change (mm H2O /s)
    real(r8), pointer :: forc_solad(:,:)    ! direct beam radiation (vis=forc_sols , nir=forc_soll )
    real(r8), pointer :: forc_solai(:,:)    ! diffuse radiation     (vis=forc_solsd, nir=forc_solld)
    real(r8), pointer :: eflx_traffic_pft(:)    ! traffic sensible heat flux (W/m**2)
    real(r8), pointer :: eflx_wasteheat_pft(:)  ! sensible heat flux from urban heating/cooling sources of waste heat (W/m**2)
    real(r8), pointer :: canyon_hwr(:)      ! ratio of building height to street width
    real(r8), pointer :: eflx_heat_from_ac_pft(:) !sensible heat flux put back into canyon due to removal by AC (W/m**2)
!
! local pointers to original implicit out arguments
!
    real(r8), pointer :: errh2o(:)          ! water conservation error (mm H2O)
    real(r8), pointer :: errsol(:)          ! solar radiation conservation error (W/m**2)
    real(r8), pointer :: errlon(:)          ! longwave radiation conservation error (W/m**2)
    real(r8), pointer :: errseb(:)          ! surface energy conservation error (W/m**2)
    real(r8), pointer :: netrad(:)          ! net radiation (positive downward) (W/m**2)
    real(r8), pointer :: errsoi_col(:)      ! column-level soil/lake energy conservation error (W/m**2)
!
!EOP
!
! !OTHER LOCAL VARIABLES:
    integer  :: p,c,l,g                     ! indices
    logical  :: found                       ! flag in search loop
    integer  :: indexp,indexc,indexl,indexg ! index of first found in search loop
    real(r8) :: forc_rain_col(lbc:ubc)      ! column level rain rate [mm/s]
    real(r8) :: forc_snow_col(lbc:ubc)      ! column level snow rate [mm/s]
!-----------------------------------------------------------------------

    ! Assign local pointers to derived type scalar members (gridcell-level)

    forc_rain         => clm_a2l%forc_rain
    forc_snow         => clm_a2l%forc_snow
    forc_lwrad        => clm_a2l%forc_lwrad
    forc_solad        => clm_a2l%forc_solad
    forc_solai        => clm_a2l%forc_solai

    ! Assign local pointers to derived type scalar members (landunit-level)

    ltype             => clm3%g%l%itype
    canyon_hwr        => clm3%g%l%canyon_hwr

    ! Assign local pointers to derived type scalar members (column-level)

    ctype             => clm3%g%l%c%itype
    cgridcell         => clm3%g%l%c%gridcell
    cwtgcell          => clm3%g%l%c%wtgcell
    endwb             => clm3%g%l%c%cwbal%endwb
    begwb             => clm3%g%l%c%cwbal%begwb
    qflx_surf         => clm3%g%l%c%cwf%qflx_surf
    qflx_qrgwl        => clm3%g%l%c%cwf%qflx_qrgwl
    qflx_drain        => clm3%g%l%c%cwf%qflx_drain
    qflx_runoff       => clm3%g%l%c%cwf%qflx_runoff
    qflx_snwcp_ice    => clm3%g%l%c%cwf%pwf_a%qflx_snwcp_ice
    qflx_evap_tot     => clm3%g%l%c%cwf%pwf_a%qflx_evap_tot
    errh2o            => clm3%g%l%c%cwbal%errh2o
    errsoi_col        => clm3%g%l%c%cebal%errsoi

    ! Assign local pointers to derived type scalar members (pft-level)

    pgridcell         => clm3%g%l%c%p%gridcell
    plandunit         => clm3%g%l%c%p%landunit
    pwtgcell          => clm3%g%l%c%p%wtgcell
    fsa               => clm3%g%l%c%p%pef%fsa
    fsr               => clm3%g%l%c%p%pef%fsr
    eflx_lwrad_out    => clm3%g%l%c%p%pef%eflx_lwrad_out
    eflx_lwrad_net    => clm3%g%l%c%p%pef%eflx_lwrad_net
    sabv              => clm3%g%l%c%p%pef%sabv
    sabg              => clm3%g%l%c%p%pef%sabg
    eflx_sh_tot       => clm3%g%l%c%p%pef%eflx_sh_tot
    eflx_lh_tot       => clm3%g%l%c%p%pef%eflx_lh_tot
    eflx_soil_grnd    => clm3%g%l%c%p%pef%eflx_soil_grnd
    errsol            => clm3%g%l%c%p%pebal%errsol
    errseb            => clm3%g%l%c%p%pebal%errseb
    errlon            => clm3%g%l%c%p%pebal%errlon
    netrad            => clm3%g%l%c%p%pef%netrad
    eflx_wasteheat_pft => clm3%g%l%c%p%pef%eflx_wasteheat_pft
    eflx_heat_from_ac_pft => clm3%g%l%c%p%pef%eflx_heat_from_ac_pft
    eflx_traffic_pft  => clm3%g%l%c%p%pef%eflx_traffic_pft

    ! Assign local pointers to derived type scalar members (gridcell-level)

    qflx_runoffg       => clm3%g%gwf%qflx_runoffg
    qflx_liq_dynbal    => clm3%g%gwf%qflx_liq_dynbal
    qflx_snwcp_iceg    => clm3%g%gwf%qflx_snwcp_iceg
    qflx_ice_dynbal    => clm3%g%gwf%qflx_ice_dynbal
    eflx_sh_totg       => clm3%g%gef%eflx_sh_totg
    eflx_dynbal        => clm3%g%gef%eflx_dynbal

    ! Get step size and time step


    ! Determine column level incoming snow and rain
    ! Assume no incident precipitation on urban wall columns (as in Hydrology1Mod.F90).

    do c = lbc,ubc
       g = cgridcell(c)
       if (ctype(c) == icol_sunwall .or.  ctype(c) == icol_shadewall) then
          forc_rain_col(c) = 0.
          forc_snow_col(c) = 0.
       else
          forc_rain_col(c) = forc_rain(g)
          forc_snow_col(c) = forc_snow(g)
       end if
    end do

    ! Water balance check

    do c = lbc, ubc
       g = cgridcell(c)
      
       errh2o(c) = endwb(c) - begwb(c) &
            - (forc_rain_col(c) + forc_snow_col(c) - qflx_evap_tot(c) - qflx_surf(c) &
            - qflx_qrgwl(c) - qflx_drain(c) - qflx_snwcp_ice(c)) * dtime

    end do

    found = .false.
    do c = lbc, ubc
       if (cwtgcell(c) > 0._r8 .and. abs(errh2o(c)) > 1e-7_r8) then
          found = .true.
          indexc = c
       end if
    end do
    if ( found ) then
 !      write(6,*)'WARNING:  water balance error ',&
 !           ' nstep = ',nstep,' indexc= ',indexc,' errh2o= ',errh2o(indexc)
       if ((ctype(indexc) .eq. icol_roof .or. ctype(indexc) .eq. icol_road_imperv .or. &
            ctype(indexc) .eq. icol_road_perv) .and. abs(errh2o(indexc)) > 1.e-1 .and. (nstep > 2) ) then
          write(6,*)'clm urban model is stopping - error is greater than 1.e-1'
          write(6,*)'nstep = ',nstep,' indexc= ',indexc,' errh2o= ',errh2o(indexc)
          write(6,*)'ctype(indexc): ',ctype(indexc)
          write(6,*)'forc_rain    = ',forc_rain_col(indexc)
          write(6,*)'forc_snow    = ',forc_snow_col(indexc)
          write(6,*)'endwb        = ',endwb(indexc)
          write(6,*)'begwb        = ',begwb(indexc)
          write(6,*)'qflx_evap_tot= ',qflx_evap_tot(indexc)
          write(6,*)'qflx_surf    = ',qflx_surf(indexc)
          write(6,*)'qflx_qrgwl   = ',qflx_qrgwl(indexc)
          write(6,*)'qflx_drain   = ',qflx_drain(indexc)
          write(6,*)'qflx_snwcp_ice   = ',qflx_snwcp_ice(indexc)
          write(6,*)'clm model is stopping'
          call endrun()
       else if (abs(errh2o(indexc)) > .10_r8 .and. (nstep > 2) ) then
          write(6,*)'clm model is stopping - error is greater than .10'
          write(6,*)'nstep = ',nstep,' indexc= ',indexc,' errh2o= ',errh2o(indexc)
          write(6,*)'ctype(indexc): ',ctype(indexc)
          write(6,*)'forc_rain    = ',forc_rain_col(indexc)
          write(6,*)'forc_snow    = ',forc_snow_col(indexc)
          write(6,*)'endwb        = ',endwb(indexc)
          write(6,*)'begwb        = ',begwb(indexc)
          write(6,*)'qflx_evap_tot= ',qflx_evap_tot(indexc)
          write(6,*)'qflx_surf    = ',qflx_surf(indexc)
          write(6,*)'qflx_qrgwl   = ',qflx_qrgwl(indexc)
          write(6,*)'qflx_drain   = ',qflx_drain(indexc)
          write(6,*)'qflx_snwcp_ice   = ',qflx_snwcp_ice(indexc)
          write(6,*)'clm model is stopping'
          call endrun()
       end if
    end if

    ! Energy balance checks

    do p = lbp, ubp
       if (pwtgcell(p)>0._r8) then
          g = pgridcell(p)
          l = plandunit(p)

          ! Solar radiation energy balance
          ! Do not do this check for an urban pft since it will not balance on a per-column
          ! level because of interactions between columns and since a separate check is done
          ! in the urban radiation module
          if (ltype(l) /= isturb) then
             errsol(p) = fsa(p) + fsr(p) &
                  - (forc_solad(g,1) + forc_solad(g,2) + forc_solai(g,1) + forc_solai(g,2))
          else
             errsol(p) = spval
          end if
          
          ! Longwave radiation energy balance
          ! Do not do this check for an urban pft since it will not balance on a per-column
          ! level because of interactions between columns and since a separate check is done
          ! in the urban radiation module
          if (ltype(l) /= isturb) then
             errlon(p) = eflx_lwrad_out(p) - eflx_lwrad_net(p) - forc_lwrad(g)
          else
             errlon(p) = spval
          end if
          
          ! Surface energy balance
          ! Changed to using (eflx_lwrad_net) here instead of (forc_lwrad - eflx_lwrad_out) because
          ! there are longwave interactions between urban columns (and therefore pfts). 
          ! For surfaces other than urban, (eflx_lwrad_net) equals (forc_lwrad - eflx_lwrad_out),
          ! and a separate check is done above for these terms.
          
          if (ltype(l) /= isturb) then
             errseb(p) = sabv(p) + sabg(p) + forc_lwrad(g) - eflx_lwrad_out(p) &
                         - eflx_sh_tot(p) - eflx_lh_tot(p) - eflx_soil_grnd(p)
          else
             errseb(p) = sabv(p) + sabg(p) &
                         - eflx_lwrad_net(p) &
                         - eflx_sh_tot(p) - eflx_lh_tot(p) - eflx_soil_grnd(p) &
                         + eflx_wasteheat_pft(p) + eflx_heat_from_ac_pft(p) + eflx_traffic_pft(p)
          end if
          netrad(p) = fsa(p) - eflx_lwrad_net(p)
       end if
    end do

    ! Solar radiation energy balance check

    found = .false.
    do p = lbp, ubp
       if (pwtgcell(p)>0._r8) then
          if ( (errsol(p) /= spval) .and. (abs(errsol(p)) > .10_r8) ) then
             found = .true.
             indexp = p
             indexg = pgridcell(p)
          end if
       end if
    end do
    if ( found  .and. (nstep > 2) ) then
       write(6,100)'BalanceCheck: solar radiation balance error', nstep, indexp, errsol(indexp)
       write(6,*)'fsa          = ',fsa(indexp)
       write(6,*)'fsr          = ',fsr(indexp)
       write(6,*)'forc_solad(1)= ',forc_solad(indexg,1)
       write(6,*)'forc_solad(2)= ',forc_solad(indexg,2)
       write(6,*)'forc_solai(1)= ',forc_solai(indexg,1)
       write(6,*)'forc_solai(2)= ',forc_solai(indexg,2)
       write(6,*)'forc_tot     = ',forc_solad(indexg,1)+forc_solad(indexg,2)&
                                  +forc_solai(indexg,1)+forc_solai(indexg,2)
       write(6,*)'clm model is stopping'
       call endrun()
    end if

    ! Longwave radiation energy balance check

    found = .false.
    do p = lbp, ubp
       if (pwtgcell(p)>0._r8) then
          if ( (errlon(p) /= spval) .and. (abs(errlon(p)) > .10_r8) ) then
             found = .true.
             indexp = p
          end if
       end if
    end do
    if ( found  .and. (nstep > 2) ) then
       write(6,100)'BalanceCheck: longwave enery balance error',nstep,indexp,errlon(indexp)
       write(6,*)'clm model is stopping'
       call endrun()
    end if

    ! Surface energy balance check

    found = .false.
    do p = lbp, ubp
       if (pwtgcell(p)>0._r8) then
          if (abs(errseb(p)) > .10_r8 ) then
             found = .true.
             indexp = p
          end if
       end if
    end do
    if ( found  .and. (nstep > 2) ) then
       write(6,100)'BalanceCheck: surface flux energy balance error',nstep,indexp,errseb(indexp)
       write(6,*)' sabv           = ',sabv(indexp)
       write(6,*)' sabg           = ',sabg(indexp)
       write(6,*)' eflx_lwrad_net = ',eflx_lwrad_net(indexp)
       write(6,*)' eflx_sh_tot    = ',eflx_sh_tot(indexp)
       write(6,*)' eflx_lh_tot    = ',eflx_lh_tot(indexp)
       write(6,*)' eflx_soil_grnd = ',eflx_soil_grnd(indexp)
       write(6,*)'clm model is stopping'
       call endrun()
    end if

    ! Soil energy balance check

    found = .false.
    do c = lbc, ubc
       if (abs(errsoi_col(c)) > 1.0e-7_r8 ) then
          found = .true.
          indexc = c
       end if
    end do
    if ( found ) then
       write(6,100)'BalanceCheck: soil balance error',nstep,indexc,errsoi_col(indexc)
       if (abs(errsoi_col(indexc)) > .10_r8 .and. (nstep > 2) ) then
          write(6,*)'clm model is stopping'
          call endrun()
       end if
    end if

    ! Update SH and RUNOFF for dynamic land cover change energy and water fluxes
    call c2g( lbc, ubc, lbl, ubl, lbg, ubg,                &
              qflx_runoff(lbc:ubc), qflx_runoffg(lbg:ubg), &
              c2l_scale_type= 'urbanf', l2g_scale_type='unity' )
    do g = lbg, ubg
       qflx_runoffg(g) = qflx_runoffg(g) - qflx_liq_dynbal(g)
    enddo

    call c2g( lbc, ubc, lbl, ubl, lbg, ubg,                      &
              qflx_snwcp_ice(lbc:ubc), qflx_snwcp_iceg(lbg:ubg), &
              c2l_scale_type= 'urbanf', l2g_scale_type='unity' )
    do g = lbg, ubg
       qflx_snwcp_iceg(g) = qflx_snwcp_iceg(g) - qflx_ice_dynbal(g)
    enddo

    call p2g( lbp, ubp, lbc, ubc, lbl, ubl, lbg, ubg,      &
              eflx_sh_tot(lbp:ubp), eflx_sh_totg(lbg:ubg), &
              p2c_scale_type='unity',c2l_scale_type='urbanf',l2g_scale_type='unity')
    do g = lbg, ubg
       eflx_sh_totg(g) =  eflx_sh_totg(g) - eflx_dynbal(g)
    enddo

100 format (1x,a,' nstep =',i10,' point =',i6,' imbalance =',f12.6,' W/m2')
200 format (1x,a,' nstep =',i10,' point =',i6,' imbalance =',f12.6,' mm')

  end subroutine BalanceCheck

end module BalanceCheckMod
!=================================================================================================
module BareGroundFluxesMod

!------------------------------------------------------------------------------
!BOP
!
! !MODULE: BareGroundFluxesMod
!
! !DESCRIPTION:
! Compute sensible and latent fluxes and their derivatives with respect
! to ground temperature using ground temperatures from previous time step.
!
! !USES:
   use shr_kind_mod, only: r8 => shr_kind_r8
!
! !PUBLIC TYPES:
   implicit none
   save
!
! !PUBLIC MEMBER FUNCTIONS:
   public :: BareGroundFluxes   ! Calculate sensible and latent heat fluxes
!
! !REVISION HISTORY:
! Created by Mariana Vertenstein
!
!EOP
!------------------------------------------------------------------------------

contains

!------------------------------------------------------------------------------
!BOP
!
! !IROUTINE: BareGroundFluxes
!
! !INTERFACE:
  subroutine BareGroundFluxes(lbp, ubp, num_nolakep, filter_nolakep)
!
! !DESCRIPTION:
! Compute sensible and latent fluxes and their derivatives with respect
! to ground temperature using ground temperatures from previous time step.
!
! !USES:
    use clmtype
    use clm_varpar         , only : nlevgrnd
    use clm_varcon         , only : cpair, vkc, grav, denice, denh2o, istsoil
#ifdef CROP
    use clm_varcon         , only : istcrop
#endif
    use shr_const_mod      , only : SHR_CONST_RGAS
    use FrictionVelocityMod, only : FrictionVelocity, MoninObukIni
    use QSatMod            , only : QSat
!
! !ARGUMENTS:
    implicit none
    integer, intent(in) :: lbp, ubp                     ! pft bounds
    integer, intent(in) :: num_nolakep                  ! number of pft non-lake points in pft filter
    integer, intent(in) :: filter_nolakep(ubp-lbp+1)    ! pft filter for non-lake points
!
! !CALLED FROM:
! subroutine Biogeophysics1 in module Biogeophysics1Mod
!
! !REVISION HISTORY:
! 15 September 1999: Yongjiu Dai; Initial code
! 15 December 1999:  Paul Houser and Jon Radakovich; F90 Revision
! 12/19/01, Peter Thornton
! This routine originally had a long list of parameters, and also a reference to
! the entire clm derived type.  For consistency, only the derived type reference
! is passed (now pointing to the current column and pft), and the other original
! parameters are initialized locally. Using t_grnd instead of tg (tg eliminated
! as redundant).
! 1/23/02, PET: Added pft reference as parameter. All outputs will be written
! to the pft data structures, and averaged to the column level outside of
! this routine.
!
! !LOCAL VARIABLES:
!
! local pointers to implicit in arguments
!
    integer , pointer :: pcolumn(:)        ! pft's column index
    integer , pointer :: pgridcell(:)      ! pft's gridcell index
    integer , pointer :: plandunit(:)      ! pft's landunit index
    integer , pointer :: ltype(:)          ! landunit type
    integer , pointer :: frac_veg_nosno(:) ! fraction of vegetation not covered by snow (0 OR 1) [-]
    real(r8), pointer :: t_grnd(:)         ! ground surface temperature [K]
    real(r8), pointer :: thm(:)            ! intermediate variable (forc_t+0.0098*forc_hgt_t_pft)
    real(r8), pointer :: qg(:)             ! specific humidity at ground surface [kg/kg]
    real(r8), pointer :: thv(:)            ! virtual potential temperature (kelvin)
    real(r8), pointer :: dqgdT(:)          ! temperature derivative of "qg"
    real(r8), pointer :: htvp(:)           ! latent heat of evaporation (/sublimation) [J/kg]
    real(r8), pointer :: beta(:)           ! coefficient of conective velocity [-]
    real(r8), pointer :: zii(:)            ! convective boundary height [m]
    real(r8), pointer :: forc_u(:)         ! atmospheric wind speed in east direction (m/s)
    real(r8), pointer :: forc_v(:)         ! atmospheric wind speed in north direction (m/s)
    real(r8), pointer :: forc_t(:)         ! atmospheric temperature (Kelvin)
    real(r8), pointer :: forc_th(:)        ! atmospheric potential temperature (Kelvin)
    real(r8), pointer :: forc_q(:)         ! atmospheric specific humidity (kg/kg)
    real(r8), pointer :: forc_rho(:)       ! density (kg/m**3)
    real(r8), pointer :: forc_pbot(:)      ! atmospheric pressure (Pa)
    real(r8), pointer :: forc_hgt_u_pft(:) ! observational height of wind at pft level [m]
    real(r8), pointer :: psnsun(:)         ! sunlit leaf photosynthesis (umol CO2 /m**2/ s)
    real(r8), pointer :: psnsha(:)         ! shaded leaf photosynthesis (umol CO2 /m**2/ s)
    real(r8), pointer :: z0mg_col(:)       ! roughness length, momentum [m]
    real(r8), pointer :: h2osoi_ice(:,:)   ! ice lens (kg/m2)
    real(r8), pointer :: h2osoi_liq(:,:)   ! liquid water (kg/m2)
    real(r8), pointer :: dz(:,:)           ! layer depth (m)
    real(r8), pointer :: watsat(:,:)       ! volumetric soil water at saturation (porosity)
    real(r8), pointer :: frac_sno(:)       ! fraction of ground covered by snow (0 to 1)
    real(r8), pointer :: soilbeta(:)       ! soil wetness relative to field capacity
!
! local pointers to implicit inout arguments
!
    real(r8), pointer :: z0hg_col(:)       ! roughness length, sensible heat [m]
    real(r8), pointer :: z0qg_col(:)       ! roughness length, latent heat [m]
!
! local pointers to implicit out arguments
!
    real(r8), pointer :: dlrad(:)         ! downward longwave radiation below the canopy [W/m2]
    real(r8), pointer :: ulrad(:)         ! upward longwave radiation above the canopy [W/m2]
    real(r8), pointer :: cgrnds(:)        ! deriv, of soil sensible heat flux wrt soil temp [w/m2/k]
    real(r8), pointer :: cgrndl(:)        ! deriv of soil latent heat flux wrt soil temp [w/m**2/k]
    real(r8), pointer :: cgrnd(:)         ! deriv. of soil energy flux wrt to soil temp [w/m2/k]
    real(r8), pointer :: taux(:)          ! wind (shear) stress: e-w (kg/m/s**2)
    real(r8), pointer :: tauy(:)          ! wind (shear) stress: n-s (kg/m/s**2)
    real(r8), pointer :: eflx_sh_grnd(:)  ! sensible heat flux from ground (W/m**2) [+ to atm]
    real(r8), pointer :: eflx_sh_tot(:)   ! total sensible heat flux (W/m**2) [+ to atm]
    real(r8), pointer :: qflx_evap_soi(:) ! soil evaporation (mm H2O/s) (+ = to atm)
    real(r8), pointer :: qflx_evap_tot(:) ! qflx_evap_soi + qflx_evap_veg + qflx_tran_veg
    real(r8), pointer :: t_ref2m(:)       ! 2 m height surface air temperature (Kelvin)
    real(r8), pointer :: q_ref2m(:)       ! 2 m height surface specific humidity (kg/kg)
    real(r8), pointer :: t_ref2m_r(:)     ! Rural 2 m height surface air temperature (Kelvin)
    real(r8), pointer :: rh_ref2m_r(:)    ! Rural 2 m height surface relative humidity (%)
    real(r8), pointer :: rh_ref2m(:)      ! 2 m height surface relative humidity (%)
    real(r8), pointer :: t_veg(:)         ! vegetation temperature (Kelvin)
    real(r8), pointer :: btran(:)         ! transpiration wetness factor (0 to 1)
    real(r8), pointer :: rssun(:)         ! sunlit stomatal resistance (s/m)
    real(r8), pointer :: rssha(:)         ! shaded stomatal resistance (s/m)
    real(r8), pointer :: ram1(:)          ! aerodynamical resistance (s/m)
    real(r8), pointer :: fpsn(:)          ! photosynthesis (umol CO2 /m**2 /s)
    real(r8), pointer :: rootr(:,:)       ! effective fraction of roots in each soil layer
    real(r8), pointer :: rresis(:,:)      ! root resistance by layer (0-1)  (nlevgrnd)	
!
!
! !OTHER LOCAL VARIABLES:
!EOP
!
    integer, parameter  :: niters = 3  ! maximum number of iterations for surface temperature
    integer  :: p,c,g,f,j,l            ! indices
    integer  :: filterp(ubp-lbp+1)     ! pft filter for vegetated pfts
    integer  :: fn                     ! number of values in local pft filter
    integer  :: fp                     ! lake filter pft index
    integer  :: iter                   ! iteration index
    real(r8) :: zldis(lbp:ubp)         ! reference height "minus" zero displacement height [m]
    real(r8) :: displa(lbp:ubp)        ! displacement height [m]
    real(r8) :: zeta                   ! dimensionless height used in Monin-Obukhov theory
    real(r8) :: wc                     ! convective velocity [m/s]
    real(r8) :: dth(lbp:ubp)           ! diff of virtual temp. between ref. height and surface
    real(r8) :: dthv                   ! diff of vir. poten. temp. between ref. height and surface
    real(r8) :: dqh(lbp:ubp)           ! diff of humidity between ref. height and surface
    real(r8) :: obu(lbp:ubp)           ! Monin-Obukhov length (m)
    real(r8) :: ur(lbp:ubp)            ! wind speed at reference height [m/s]
    real(r8) :: um(lbp:ubp)            ! wind speed including the stablity effect [m/s]
    real(r8) :: temp1(lbp:ubp)         ! relation for potential temperature profile
    real(r8) :: temp12m(lbp:ubp)       ! relation for potential temperature profile applied at 2-m
    real(r8) :: temp2(lbp:ubp)         ! relation for specific humidity profile
    real(r8) :: temp22m(lbp:ubp)       ! relation for specific humidity profile applied at 2-m
    real(r8) :: ustar(lbp:ubp)         ! friction velocity [m/s]
    real(r8) :: tstar                  ! temperature scaling parameter
    real(r8) :: qstar                  ! moisture scaling parameter
    real(r8) :: thvstar                ! virtual potential temperature scaling parameter
    real(r8) :: cf                     ! heat transfer coefficient from leaves [-]
    real(r8) :: ram                    ! aerodynamical resistance [s/m]
    real(r8) :: rah                    ! thermal resistance [s/m]
    real(r8) :: raw                    ! moisture resistance [s/m]
    real(r8) :: raih                   ! temporary variable [kg/m2/s]
    real(r8) :: raiw                   ! temporary variable [kg/m2/s]
    real(r8) :: fm(lbp:ubp)            ! needed for BGC only to diagnose 10m wind speed
    real(r8) :: z0mg_pft(lbp:ubp)
    real(r8) :: z0hg_pft(lbp:ubp)
    real(r8) :: z0qg_pft(lbp:ubp)
    real(r8) :: e_ref2m                ! 2 m height surface saturated vapor pressure [Pa]
    real(r8) :: de2mdT                 ! derivative of 2 m height surface saturated vapor pressure on t_ref2m
    real(r8) :: qsat_ref2m             ! 2 m height surface saturated specific humidity [kg/kg]
    real(r8) :: dqsat2mdT              ! derivative of 2 m height surface saturated specific humidity on t_ref2m 
    real(r8) :: www                    ! surface soil wetness [-]
!------------------------------------------------------------------------------

    ! Assign local pointers to derived type members (gridcell-level)

    forc_th    => clm_a2l%forc_th
    forc_pbot  => clm_a2l%forc_pbot
    forc_t     => clm_a2l%forc_t
    forc_u     => clm_a2l%forc_u
    forc_v     => clm_a2l%forc_v
    forc_rho   => clm_a2l%forc_rho
    forc_q     => clm_a2l%forc_q

    ! Assign local pointers to derived type members (landunit-level)

    ltype      => clm3%g%l%itype

    ! Assign local pointers to derived type members (column-level)

    pcolumn => clm3%g%l%c%p%column
    pgridcell => clm3%g%l%c%p%gridcell
    frac_veg_nosno => clm3%g%l%c%p%pps%frac_veg_nosno
    dlrad => clm3%g%l%c%p%pef%dlrad
    ulrad => clm3%g%l%c%p%pef%ulrad
    t_grnd => clm3%g%l%c%ces%t_grnd
    qg => clm3%g%l%c%cws%qg
    z0mg_col => clm3%g%l%c%cps%z0mg
    z0hg_col => clm3%g%l%c%cps%z0hg
    z0qg_col => clm3%g%l%c%cps%z0qg
    thv => clm3%g%l%c%ces%thv
    beta => clm3%g%l%c%cps%beta
    zii => clm3%g%l%c%cps%zii
    ram1 => clm3%g%l%c%p%pps%ram1
    cgrnds => clm3%g%l%c%p%pef%cgrnds
    cgrndl => clm3%g%l%c%p%pef%cgrndl
    cgrnd => clm3%g%l%c%p%pef%cgrnd
    dqgdT => clm3%g%l%c%cws%dqgdT
    htvp => clm3%g%l%c%cps%htvp
    watsat         => clm3%g%l%c%cps%watsat
    h2osoi_ice     => clm3%g%l%c%cws%h2osoi_ice
    dz             => clm3%g%l%c%cps%dz
    h2osoi_liq     => clm3%g%l%c%cws%h2osoi_liq
    frac_sno       => clm3%g%l%c%cps%frac_sno
    soilbeta       => clm3%g%l%c%cws%soilbeta

    ! Assign local pointers to derived type members (pft-level)

    taux => clm3%g%l%c%p%pmf%taux
    tauy => clm3%g%l%c%p%pmf%tauy
    eflx_sh_grnd => clm3%g%l%c%p%pef%eflx_sh_grnd
    eflx_sh_tot => clm3%g%l%c%p%pef%eflx_sh_tot
    qflx_evap_soi => clm3%g%l%c%p%pwf%qflx_evap_soi
    qflx_evap_tot => clm3%g%l%c%p%pwf%qflx_evap_tot
    t_ref2m => clm3%g%l%c%p%pes%t_ref2m
    q_ref2m => clm3%g%l%c%p%pes%q_ref2m
    t_ref2m_r => clm3%g%l%c%p%pes%t_ref2m_r
    rh_ref2m_r => clm3%g%l%c%p%pes%rh_ref2m_r
    plandunit => clm3%g%l%c%p%landunit
    rh_ref2m => clm3%g%l%c%p%pes%rh_ref2m
    t_veg => clm3%g%l%c%p%pes%t_veg
    thm => clm3%g%l%c%p%pes%thm
    btran => clm3%g%l%c%p%pps%btran
    rssun => clm3%g%l%c%p%pps%rssun
    rssha => clm3%g%l%c%p%pps%rssha
    rootr => clm3%g%l%c%p%pps%rootr
    rresis => clm3%g%l%c%p%pps%rresis
    psnsun => clm3%g%l%c%p%pcf%psnsun
    psnsha => clm3%g%l%c%p%pcf%psnsha
    fpsn => clm3%g%l%c%p%pcf%fpsn
    forc_hgt_u_pft => clm3%g%l%c%p%pps%forc_hgt_u_pft

    ! Filter pfts where frac_veg_nosno is zero

    fn = 0
    do fp = 1,num_nolakep
       p = filter_nolakep(fp)
       if (frac_veg_nosno(p) == 0) then
          fn = fn + 1
          filterp(fn) = p
       end if
    end do

    ! Compute sensible and latent fluxes and their derivatives with respect
    ! to ground temperature using ground temperatures from previous time step

!dir$ concurrent
!cdir nodep
    do f = 1, fn
       p = filterp(f)
       c = pcolumn(p)
       g = pgridcell(p)

       ! Initialization variables

       displa(p) = 0._r8
       dlrad(p)  = 0._r8
       ulrad(p)  = 0._r8

       ur(p) = max(1.0_r8,sqrt(forc_u(g)*forc_u(g)+forc_v(g)*forc_v(g)))
       dth(p) = thm(p)-t_grnd(c)
       dqh(p) = forc_q(g)-qg(c)
       dthv = dth(p)*(1._r8+0.61_r8*forc_q(g))+0.61_r8*forc_th(g)*dqh(p)
       zldis(p) = forc_hgt_u_pft(p)

       ! Copy column roughness to local pft-level arrays

       z0mg_pft(p) = z0mg_col(c)
       z0hg_pft(p) = z0hg_col(c)
       z0qg_pft(p) = z0qg_col(c)

       ! Initialize Monin-Obukhov length and wind speed

       call MoninObukIni(ur(p), thv(c), dthv, zldis(p), z0mg_pft(p), um(p), obu(p))

    end do

    ! Perform stability iteration
    ! Determine friction velocity, and potential temperature and humidity
    ! profiles of the surface boundary layer

    do iter = 1, niters

       call FrictionVelocity(lbp, ubp, fn, filterp, &
                             displa, z0mg_pft, z0hg_pft, z0qg_pft, &
                             obu, iter, ur, um, ustar, &
                             temp1, temp2, temp12m, temp22m, fm)

!dir$ concurrent
!cdir nodep
       do f = 1, fn
          p = filterp(f)
          c = pcolumn(p)
          g = pgridcell(p)

          tstar = temp1(p)*dth(p)
          qstar = temp2(p)*dqh(p)
          z0hg_pft(p) = z0mg_pft(p)/exp(0.13_r8 * (ustar(p)*z0mg_pft(p)/1.5e-5_r8)**0.45_r8)
          z0qg_pft(p) = z0hg_pft(p)

          thvstar = tstar*(1._r8+0.61_r8*forc_q(g)) + 0.61_r8*forc_th(g)*qstar
          zeta = zldis(p)*vkc*grav*thvstar/(ustar(p)**2*thv(c))

          if (zeta >= 0._r8) then                   !stable
             zeta = min(2._r8,max(zeta,0.01_r8))
             um(p) = max(ur(p),0.1_r8)
          else                                      !unstable
             zeta = max(-100._r8,min(zeta,-0.01_r8))
             wc = beta(c)*(-grav*ustar(p)*thvstar*zii(c)/thv(c))**0.333_r8
             um(p) = sqrt(ur(p)*ur(p) + wc*wc)
          end if
          obu(p) = zldis(p)/zeta
       end do

    end do ! end stability iteration

     do j = 1, nlevgrnd
!dir$ concurrent
!cdir nodep
       do f = 1, fn
          p = filterp(f)
          rootr(p,j) = 0._r8
          rresis(p,j) = 0._r8
        end do
     end do

!dir$ prefervector
!dir$ concurrent
!cdir nodep
    do f = 1, fn
       p = filterp(f)
       c = pcolumn(p)
       g = pgridcell(p)
       l = plandunit(p)

       ! Determine aerodynamic resistances

       ram     = 1._r8/(ustar(p)*ustar(p)/um(p))
       rah     = 1._r8/(temp1(p)*ustar(p))
       raw     = 1._r8/(temp2(p)*ustar(p))
       raih    = forc_rho(g)*cpair/rah

       ! Soil evaporation resistance
       www     = (h2osoi_liq(c,1)/denh2o+h2osoi_ice(c,1)/denice)/dz(c,1)/watsat(c,1)
       www     = min(max(www,0.0_r8),1._r8)

       !changed by K.Sakaguchi. Soilbeta is used for evaporation
       if (dqh(p) .gt. 0._r8) then   !dew  (beta is not applied, just like rsoil used to be)
          raiw    = forc_rho(g)/(raw)
       else
       ! Lee and Pielke 1992 beta is applied
          raiw    = soilbeta(c)*forc_rho(g)/(raw)
       end if

       ram1(p) = ram  !pass value to global variable

       ! Output to pft-level data structures
       ! Derivative of fluxes with respect to ground temperature

       cgrnds(p) = raih
       cgrndl(p) = raiw*dqgdT(c)
       cgrnd(p)  = cgrnds(p) + htvp(c)*cgrndl(p)

       ! Surface fluxes of momentum, sensible and latent heat
       ! using ground temperatures from previous time step

       taux(p)          = -forc_rho(g)*forc_u(g)/ram
       tauy(p)          = -forc_rho(g)*forc_v(g)/ram
       eflx_sh_grnd(p)  = -raih*dth(p)
 
       eflx_sh_tot(p)   = eflx_sh_grnd(p)
       qflx_evap_soi(p) = -raiw*dqh(p)
       qflx_evap_tot(p) = qflx_evap_soi(p)

       ! 2 m height air temperature

       t_ref2m(p) = thm(p) + temp1(p)*dth(p)*(1._r8/temp12m(p) - 1._r8/temp1(p))

       ! 2 m height specific humidity

       q_ref2m(p) = forc_q(g) + temp2(p)*dqh(p)*(1._r8/temp22m(p) - 1._r8/temp2(p))

       ! 2 m height relative humidity
                                                                                
       call QSat(t_ref2m(p), forc_pbot(g), e_ref2m, de2mdT, qsat_ref2m, dqsat2mdT)
       rh_ref2m(p) = min(100._r8, q_ref2m(p) / qsat_ref2m * 100._r8)

#ifndef CROP
       if (ltype(l) == istsoil) then
#else
       if (ltype(l) == istsoil .or. ltype(l) == istcrop) then
#endif
         rh_ref2m_r(p) = rh_ref2m(p)
         t_ref2m_r(p) = t_ref2m(p)
       end if

       ! Variables needed by history tape

       t_veg(p) = forc_t(g)
       btran(p) = 0._r8
       cf = forc_pbot(g)/(SHR_CONST_RGAS*0.001_r8*thm(p))*1.e06_r8
       rssun(p) = 1._r8/1.e15_r8 * cf
       rssha(p) = 1._r8/1.e15_r8 * cf

       ! Add the following to avoid NaN

       psnsun(p) = 0._r8
       psnsha(p) = 0._r8
       fpsn(p) = 0._r8
       clm3%g%l%c%p%pps%lncsun(p) = 0._r8
       clm3%g%l%c%p%pps%lncsha(p) = 0._r8
       clm3%g%l%c%p%pps%vcmxsun(p) = 0._r8
       clm3%g%l%c%p%pps%vcmxsha(p) = 0._r8
       ! adding code for isotopes, 8/17/05, PET
       clm3%g%l%c%p%pps%cisun(p) = 0._r8
       clm3%g%l%c%p%pps%cisha(p) = 0._r8
#if (defined C13)
       clm3%g%l%c%p%pps%alphapsnsun(p) = 0._r8
       clm3%g%l%c%p%pps%alphapsnsha(p) = 0._r8
       clm3%g%l%c%p%pepv%rc13_canair(p) = 0._r8
       clm3%g%l%c%p%pepv%rc13_psnsun(p) = 0._r8
       clm3%g%l%c%p%pepv%rc13_psnsha(p) = 0._r8
       clm3%g%l%c%p%pc13f%psnsun(p) = 0._r8
       clm3%g%l%c%p%pc13f%psnsha(p) = 0._r8
       clm3%g%l%c%p%pc13f%fpsn(p) = 0._r8
#endif

    end do

  end subroutine BareGroundFluxes

end module BareGroundFluxesMod

module Biogeophysics1Mod

!------------------------------------------------------------------------------
!BOP
!
! !MODULE: Biogeophysics1Mod
!
! !DESCRIPTION:
! Performs calculation of leaf temperature and surface fluxes.
! Biogeophysics2.F90 then determines soil/snow and ground
! temperatures and updates the surface fluxes for the new ground
! temperature.
!
! !USES:
   use shr_kind_mod, only: r8 => shr_kind_r8
   use globals , only:nstep
!
! !PUBLIC TYPES:
   implicit none
   save
!
! !PUBLIC MEMBER FUNCTIONS:
   public :: Biogeophysics1   ! Calculate leaf temperature and surface fluxes
!
! !REVISION HISTORY:
! Created by Mariana Vertenstein
!
!EOP
!------------------------------------------------------------------------------

contains

!------------------------------------------------------------------------------
!BOP
!
! !IROUTINE: Biogeophysics1
!
! !INTERFACE:
  subroutine Biogeophysics1(lbg, ubg, lbc, ubc, lbp, ubp, &
       num_nolakec, filter_nolakec, num_nolakep, filter_nolakep)
!
! !DESCRIPTION:
! This is the main subroutine to execute the calculation of leaf temperature
! and surface fluxes. Biogeophysics2.F90 then determines soil/snow and ground
! temperatures and updates the surface fluxes for the new ground
! temperature.
!
! Calling sequence is:
! Biogeophysics1:           surface biogeophysics driver
!  -> QSat:                 saturated vapor pressure, specific humidity, and
!                           derivatives at ground surface and derivatives at
!                           leaf surface using updated leaf temperature
! Leaf temperature
! Foliage energy conservation is given by the foliage energy budget
! equation:
!                Rnet - Hf - LEf = 0
! The equation is solved by Newton-Raphson iteration, in which this
! iteration includes the calculation of the photosynthesis and
! stomatal resistance, and the integration of turbulent flux profiles.
! The sensible and latent heat transfer between foliage and atmosphere
! and ground is linked by the equations:
!                Ha = Hf + Hg and Ea = Ef + Eg
!
! !USES:
    use clmtype
    use clm_varcon         , only : denh2o, denice, roverg, hvap, hsub, &
                                    istice, istwet, istsoil, isturb, istdlak, &
                                    zlnd, zsno, tfrz, &
                                    icol_roof, icol_sunwall, icol_shadewall,     &
                                    icol_road_imperv, icol_road_perv, tfrz, spval, istdlak
#ifdef CROP
    use clm_varcon         , only : istcrop
#endif
    use clm_varpar         , only : nlevgrnd, nlevurb, nlevsno, max_pft_per_gcell, nlevsoi
    use QSatMod            , only : QSat
    use shr_const_mod      , only : SHR_CONST_PI
!
! !ARGUMENTS:
    implicit none
    integer, intent(in) :: lbg, ubg                    ! gridcell-index bounds
    integer, intent(in) :: lbc, ubc                    ! column-index bounds
    integer, intent(in) :: lbp, ubp                    ! pft-index bounds
    integer, intent(in) :: num_nolakec                 ! number of column non-lake points in column filter
    integer, intent(in) :: filter_nolakec(ubc-lbc+1)   ! column filter for non-lake points
    integer, intent(in) :: num_nolakep                 ! number of column non-lake points in pft filter
    integer, intent(in) :: filter_nolakep(ubp-lbp+1)   ! pft filter for non-lake points
!
! !CALLED FROM:
! subroutine clm_driver1
!
! !REVISION HISTORY:
! 15 September 1999: Yongjiu Dai; Initial code
! 15 December 1999:  Paul Houser and Jon Radakovich; F90 Revision
! Migrated to clm2.0 by Keith Oleson and Mariana Vertenstein
! Migrated to clm2.1 new data structures by Peter Thornton and M. Vertenstein
! 27 February 2008: Keith Oleson; weighted soil/snow emissivity
!
! !LOCAL VARIABLES:
!
! local pointers to implicit in arguments
!
    integer , pointer :: ivt(:)           !pft vegetation type
    integer , pointer :: ityplun(:)       !landunit type
    integer , pointer :: clandunit(:)     !column's landunit index
    integer , pointer :: cgridcell(:)     !column's gridcell index
    real(r8), pointer :: pwtgcell(:)      !weight relative to gridcell for each pft
    integer , pointer :: ctype(:)         !column type
    real(r8), pointer :: forc_pbot(:)     !atmospheric pressure (Pa)
    real(r8), pointer :: forc_q(:)        !atmospheric specific humidity (kg/kg)
    real(r8), pointer :: forc_t(:)        !atmospheric temperature (Kelvin)
    real(r8), pointer :: forc_hgt_t(:)    !observational height of temperature [m]
    real(r8), pointer :: forc_hgt_u(:)    !observational height of wind [m]
    real(r8), pointer :: forc_hgt_q(:)    !observational height of specific humidity [m]
    integer , pointer :: npfts(:)         !number of pfts on gridcell
    integer , pointer :: pfti(:)          !initial pft on gridcell
    integer , pointer :: plandunit(:)     !pft's landunit index
    real(r8), pointer :: forc_hgt_u_pft(:) !observational height of wind at pft level [m]
    real(r8), pointer :: forc_hgt_t_pft(:) !observational height of temperature at pft level [m]
    real(r8), pointer :: forc_hgt_q_pft(:) !observational height of specific humidity at pft level [m]
    integer , pointer :: frac_veg_nosno(:) !fraction of vegetation not covered by snow (0 OR 1) [-]
    integer , pointer :: pgridcell(:)      !pft's gridcell index
    integer , pointer :: pcolumn(:)        !pft's column index
    real(r8), pointer :: z_0_town(:)      !momentum roughness length of urban landunit (m)
    real(r8), pointer :: z_d_town(:)      !displacement height of urban landunit (m)
    real(r8), pointer :: forc_th(:)       !atmospheric potential temperature (Kelvin)
    real(r8), pointer :: forc_u(:)        !atmospheric wind speed in east direction (m/s)
    real(r8), pointer :: forc_v(:)        !atmospheric wind speed in north direction (m/s)
    real(r8), pointer :: smpmin(:)        !restriction for min of soil potential (mm)
    integer , pointer :: snl(:)           !number of snow layers
    real(r8), pointer :: frac_sno(:)      !fraction of ground covered by snow (0 to 1)
    real(r8), pointer :: h2osno(:)        !snow water (mm H2O)
    real(r8), pointer :: elai(:)          !one-sided leaf area index with burying by snow
    real(r8), pointer :: esai(:)          !one-sided stem area index with burying by snow
    real(r8), pointer :: z0mr(:)          !ratio of momentum roughness length to canopy top height (-)
    real(r8), pointer :: displar(:)       !ratio of displacement height to canopy top height (-)
    real(r8), pointer :: htop(:)          !canopy top (m)
    real(r8), pointer :: dz(:,:)          !layer depth (m)
    real(r8), pointer :: t_soisno(:,:)    !soil temperature (Kelvin)
    real(r8), pointer :: h2osoi_liq(:,:)  !liquid water (kg/m2)
    real(r8), pointer :: h2osoi_ice(:,:)  !ice lens (kg/m2)
    real(r8), pointer :: watsat(:,:)      !volumetric soil water at saturation (porosity)
    real(r8), pointer :: sucsat(:,:)      !minimum soil suction (mm)
    real(r8), pointer :: bsw(:,:)         !Clapp and Hornberger "b"
    real(r8), pointer :: watfc(:,:)       !volumetric soil water at field capacity
    real(r8), pointer :: watopt(:,:)      !volumetric soil moisture corresponding to no restriction on ET from urban pervious surface
    real(r8), pointer :: watdry(:,:)      !volumetric soil moisture corresponding to no restriction on ET from urban pervious surface
    real(r8), pointer :: rootfr_road_perv(:,:) !fraction of roots in each soil layer for urban pervious road
    real(r8), pointer :: rootr_road_perv(:,:) !effective fraction of roots in each soil layer for urban pervious road
!
! local pointers to implicit out arguments
!
    real(r8), pointer :: t_grnd(:)        !ground temperature (Kelvin)
    real(r8), pointer :: qg(:)            !ground specific humidity [kg/kg]
    real(r8), pointer :: dqgdT(:)         !d(qg)/dT
    real(r8), pointer :: emg(:)           !ground emissivity
    real(r8), pointer :: htvp(:)          !latent heat of vapor of water (or sublimation) [j/kg]
    real(r8), pointer :: beta(:)          !coefficient of convective velocity [-]
    real(r8), pointer :: zii(:)           !convective boundary height [m]
    real(r8), pointer :: thm(:)           !intermediate variable (forc_t+0.0098*forc_hgt_t_pft)
    real(r8), pointer :: thv(:)           !virtual potential temperature (kelvin)
    real(r8), pointer :: z0mg(:)          !roughness length over ground, momentum [m]
    real(r8), pointer :: z0hg(:)          !roughness length over ground, sensible heat [m]
    real(r8), pointer :: z0qg(:)          !roughness length over ground, latent heat [m]
    real(r8), pointer :: emv(:)           !vegetation emissivity
    real(r8), pointer :: z0m(:)           !momentum roughness length (m)
    real(r8), pointer :: displa(:)        !displacement height (m)
    real(r8), pointer :: z0mv(:)          !roughness length over vegetation, momentum [m]
    real(r8), pointer :: z0hv(:)          !roughness length over vegetation, sensible heat [m]
    real(r8), pointer :: z0qv(:)          !roughness length over vegetation, latent heat [m]
    real(r8), pointer :: eflx_sh_tot(:)   !total sensible heat flux (W/m**2) [+ to atm]
    real(r8), pointer :: eflx_sh_tot_u(:) !urban total sensible heat flux (W/m**2) [+ to atm]
    real(r8), pointer :: eflx_sh_tot_r(:) !rural total sensible heat flux (W/m**2) [+ to atm]
    real(r8), pointer :: eflx_lh_tot(:)   !total latent heat flux (W/m8*2)  [+ to atm]
    real(r8), pointer :: eflx_lh_tot_u(:) !urban total latent heat flux (W/m**2)  [+ to atm]
    real(r8), pointer :: eflx_lh_tot_r(:) !rural total latent heat flux (W/m**2)  [+ to atm]
    real(r8), pointer :: eflx_sh_veg(:)   !sensible heat flux from leaves (W/m**2) [+ to atm]
    real(r8), pointer :: qflx_evap_tot(:) !qflx_evap_soi + qflx_evap_veg + qflx_tran_veg
    real(r8), pointer :: qflx_evap_veg(:) !vegetation evaporation (mm H2O/s) (+ = to atm)
    real(r8), pointer :: qflx_tran_veg(:) !vegetation transpiration (mm H2O/s) (+ = to atm)
    real(r8), pointer :: cgrnd(:)         !deriv. of soil energy flux wrt to soil temp [w/m2/k]
    real(r8), pointer :: cgrnds(:)        !deriv. of soil sensible heat flux wrt soil temp [w/m2/k]
    real(r8), pointer :: cgrndl(:)        !deriv. of soil latent heat flux wrt soil temp [w/m**2/k]
    real(r8) ,pointer :: tssbef(:,:)      !soil/snow temperature before update
    real(r8) ,pointer :: soilalpha(:)     !factor that reduces ground saturated specific humidity (-)
    real(r8) ,pointer :: soilbeta(:)      !factor that reduces ground evaporation
    real(r8) ,pointer :: soilalpha_u(:)   !Urban factor that reduces ground saturated specific humidity (-)
!
!
! !OTHER LOCAL VARIABLES:
!EOP
!
    integer  :: g,l,c,p !indices
    integer  :: j       !soil/snow level index
    integer  :: fp      !lake filter pft index
    integer  :: fc      !lake filter column index
    real(r8) :: qred    !soil surface relative humidity
    real(r8) :: avmuir  !ir inverse optical depth per unit leaf area
    real(r8) :: eg      !water vapor pressure at temperature T [pa]
    real(r8) :: qsatg   !saturated humidity [kg/kg]
    real(r8) :: degdT   !d(eg)/dT
    real(r8) :: qsatgdT !d(qsatg)/dT
    real(r8) :: fac     !soil wetness of surface layer
    real(r8) :: psit    !negative potential of soil
    real(r8) :: hr      !relative humidity
    real(r8) :: hr_road_perv  !relative humidity for urban pervious road
    real(r8) :: wx      !partial volume of ice and water of surface layer
    real(r8) :: fac_fc        !soil wetness of surface layer relative to field capacity
    real(r8) :: eff_porosity  ! effective porosity in layer
    real(r8) :: vol_ice       ! partial volume of ice lens in layer
    real(r8) :: vol_liq       ! partial volume of liquid water in layer
    integer  :: pi            !index
!------------------------------------------------------------------------------

   ! Assign local pointers to derived type members (gridcell-level)

    forc_hgt_t    => clm_a2l%forc_hgt_t
    forc_pbot     => clm_a2l%forc_pbot
    forc_q        => clm_a2l%forc_q
    forc_t        => clm_a2l%forc_t
    forc_th       => clm_a2l%forc_th
    forc_u        => clm_a2l%forc_u
    forc_v        => clm_a2l%forc_v
    forc_hgt_u    => clm_a2l%forc_hgt_u
    forc_hgt_q    => clm_a2l%forc_hgt_q
    npfts         => clm3%g%npfts
    pfti          => clm3%g%pfti

    ! Assign local pointers to derived type members (landunit-level)

    ityplun       => clm3%g%l%itype
    z_0_town      => clm3%g%l%z_0_town
    z_d_town      => clm3%g%l%z_d_town

    ! Assign local pointers to derived type members (column-level)

    cgridcell     => clm3%g%l%c%gridcell
    clandunit     => clm3%g%l%c%landunit
    ctype         => clm3%g%l%c%itype
    beta          => clm3%g%l%c%cps%beta
    dqgdT         => clm3%g%l%c%cws%dqgdT
    emg           => clm3%g%l%c%cps%emg
    frac_sno      => clm3%g%l%c%cps%frac_sno
    h2osno        => clm3%g%l%c%cws%h2osno
    htvp          => clm3%g%l%c%cps%htvp
    qg            => clm3%g%l%c%cws%qg
    smpmin        => clm3%g%l%c%cps%smpmin
    snl           => clm3%g%l%c%cps%snl
    t_grnd        => clm3%g%l%c%ces%t_grnd
    thv           => clm3%g%l%c%ces%thv
    z0hg          => clm3%g%l%c%cps%z0hg
    z0mg          => clm3%g%l%c%cps%z0mg
    z0qg          => clm3%g%l%c%cps%z0qg
    zii           => clm3%g%l%c%cps%zii
    bsw           => clm3%g%l%c%cps%bsw
    dz            => clm3%g%l%c%cps%dz
    h2osoi_ice    => clm3%g%l%c%cws%h2osoi_ice
    h2osoi_liq    => clm3%g%l%c%cws%h2osoi_liq
    soilalpha     => clm3%g%l%c%cws%soilalpha
    soilbeta      => clm3%g%l%c%cws%soilbeta
    soilalpha_u   => clm3%g%l%c%cws%soilalpha_u
    sucsat        => clm3%g%l%c%cps%sucsat
    t_soisno      => clm3%g%l%c%ces%t_soisno
    tssbef        => clm3%g%l%c%ces%tssbef
    watsat        => clm3%g%l%c%cps%watsat
    watfc         => clm3%g%l%c%cps%watfc
    watdry        => clm3%g%l%c%cps%watdry
    watopt        => clm3%g%l%c%cps%watopt
    rootfr_road_perv => clm3%g%l%c%cps%rootfr_road_perv
    rootr_road_perv  => clm3%g%l%c%cps%rootr_road_perv

    ! Assign local pointers to derived type members (pft-level)

    ivt           => clm3%g%l%c%p%itype
    elai          => clm3%g%l%c%p%pps%elai
    esai          => clm3%g%l%c%p%pps%esai
    htop          => clm3%g%l%c%p%pps%htop
    emv           => clm3%g%l%c%p%pps%emv
    z0m           => clm3%g%l%c%p%pps%z0m
    displa        => clm3%g%l%c%p%pps%displa
    z0mv          => clm3%g%l%c%p%pps%z0mv
    z0hv          => clm3%g%l%c%p%pps%z0hv
    z0qv          => clm3%g%l%c%p%pps%z0qv
    eflx_sh_tot   => clm3%g%l%c%p%pef%eflx_sh_tot
    eflx_sh_tot_u => clm3%g%l%c%p%pef%eflx_sh_tot_u
    eflx_sh_tot_r => clm3%g%l%c%p%pef%eflx_sh_tot_r
    eflx_lh_tot   => clm3%g%l%c%p%pef%eflx_lh_tot
    eflx_lh_tot_u => clm3%g%l%c%p%pef%eflx_lh_tot_u
    eflx_lh_tot_r => clm3%g%l%c%p%pef%eflx_lh_tot_r
    eflx_sh_veg   => clm3%g%l%c%p%pef%eflx_sh_veg
    qflx_evap_tot => clm3%g%l%c%p%pwf%qflx_evap_tot
    qflx_evap_veg => clm3%g%l%c%p%pwf%qflx_evap_veg
    qflx_tran_veg => clm3%g%l%c%p%pwf%qflx_tran_veg
    cgrnd         => clm3%g%l%c%p%pef%cgrnd
    cgrnds        => clm3%g%l%c%p%pef%cgrnds
    cgrndl        => clm3%g%l%c%p%pef%cgrndl
    forc_hgt_u_pft => clm3%g%l%c%p%pps%forc_hgt_u_pft
    forc_hgt_t_pft => clm3%g%l%c%p%pps%forc_hgt_t_pft
    forc_hgt_q_pft => clm3%g%l%c%p%pps%forc_hgt_q_pft
    plandunit      => clm3%g%l%c%p%landunit
    frac_veg_nosno => clm3%g%l%c%p%pps%frac_veg_nosno
    thm            => clm3%g%l%c%p%pes%thm
    pgridcell      => clm3%g%l%c%p%gridcell
    pcolumn        => clm3%g%l%c%p%column
    pwtgcell       => clm3%g%l%c%p%wtgcell

    ! Assign local pointers to derived type members (ecophysiological)

    z0mr          => pftcon%z0mr
    displar       => pftcon%displar

    do j = -nlevsno+1, nlevgrnd
       do fc = 1,num_nolakec
          c = filter_nolakec(fc)
          tssbef(c,j) = t_soisno(c,j)
       end do
    end do

    do fc = 1,num_nolakec
       c = filter_nolakec(fc)
       l = clandunit(c)
       g = cgridcell(c)

       if (ctype(c) == icol_road_perv) then
          hr_road_perv = 0._r8
       end if

       ! begin calculations that relate only to the column level
       ! Ground and soil temperatures from previous time step

       t_grnd(c) = t_soisno(c,snl(c)+1)
       ! Saturated vapor pressure, specific humidity and their derivatives
       ! at ground surface

       qred = 1._r8
       if (ityplun(l)/=istwet .AND. ityplun(l)/=istice) then
#ifndef CROP
          if (ityplun(l) == istsoil) then
#else
          if (ityplun(l) == istsoil .or. ityplun(l) == istcrop) then
#endif
             wx   = (h2osoi_liq(c,1)/denh2o+h2osoi_ice(c,1)/denice)/dz(c,1)
             fac  = min(1._r8, wx/watsat(c,1))
             fac  = max( fac, 0.01_r8 )
             psit = -sucsat(c,1) * fac ** (-bsw(c,1))
             psit = max(smpmin(c), psit)
             hr   = exp(psit/roverg/t_grnd(c))
             qred = (1.-frac_sno(c))*hr + frac_sno(c)

             !! Lee and Pielke 1992 beta, added by K.Sakaguchi
             if (wx < watfc(c,1) ) then  !when water content of ths top layer is less than that at F.C.
                fac_fc  = min(1._r8, wx/watfc(c,1))  !eqn5.66 but divided by theta at field capacity
                fac_fc  = max( fac_fc, 0.01_r8 )
                ! modifiy soil beta by snow cover. soilbeta for snow surface is one
                soilbeta(c) = (1._r8-frac_sno(c))*0.25_r8*(1._r8 - cos(SHR_CONST_PI*fac_fc))**2._r8 &
                              + frac_sno(c)
             else   !when water content of ths top layer is more than that at F.C.
                soilbeta(c) = 1._r8
             end if

             soilalpha(c) = qred
          ! Pervious road depends on water in total soil column
          else if (ctype(c) == icol_road_perv) then
             do j = 1, nlevsoi
                if (t_soisno(c,j) >= tfrz) then
                   vol_ice = min(watsat(c,j), h2osoi_ice(c,j)/(dz(c,j)*denice))
                   eff_porosity = watsat(c,j)-vol_ice
                   vol_liq = min(eff_porosity, h2osoi_liq(c,j)/(dz(c,j)*denh2o))
                   fac = min( max(vol_liq-watdry(c,j),0._r8) / (watopt(c,j)-watdry(c,j)), 1._r8 )
                else
                   fac = 0._r8
                end if
                rootr_road_perv(c,j) = rootfr_road_perv(c,j)*fac
                hr_road_perv = hr_road_perv + rootr_road_perv(c,j)
             end do
             ! Allows for sublimation of snow or dew on snow
             qred = (1.-frac_sno(c))*hr_road_perv + frac_sno(c)

             ! Normalize root resistances to get layer contribution to total ET
             if (hr_road_perv .gt. 0._r8) then
                do j = 1, nlevsoi
                   rootr_road_perv(c,j) = rootr_road_perv(c,j)/hr_road_perv
                end do
             end if
             soilalpha_u(c) = qred
             soilbeta(c) = 0._r8
          else if (ctype(c) == icol_sunwall .or. ctype(c) == icol_shadewall) then
             qred = 0._r8
             soilbeta(c) = 0._r8
             soilalpha_u(c) = spval
          else if (ctype(c) == icol_roof .or. ctype(c) == icol_road_imperv) then
             qred = 1._r8
             soilbeta(c) = 0._r8
             soilalpha_u(c) = spval
          end if
       else
          soilalpha(c) = spval
          soilbeta(c) =   1._r8
       end if

       call QSat(t_grnd(c), forc_pbot(g), eg, degdT, qsatg, qsatgdT)

       qg(c) = qred*qsatg
       dqgdT(c) = qred*qsatgdT

       if (qsatg > forc_q(g) .and. forc_q(g) > qred*qsatg) then
          qg(c) = forc_q(g)
          dqgdT(c) = 0._r8
       end if

       ! Ground emissivity - only calculate for non-urban landunits 
       ! Urban emissivities are currently read in from data file

       if (ityplun(l) /= isturb) then
          if (ityplun(l)==istice) then
             emg(c) = 0.97_r8
          else
             emg(c) = (1._r8-frac_sno(c))*0.96_r8 + frac_sno(c)*0.97_r8
          end if
       end if

       ! Latent heat. We arbitrarily assume that the sublimation occurs
       ! only as h2osoi_liq = 0

       htvp(c) = hvap
       if (h2osoi_liq(c,snl(c)+1) <= 0._r8 .and. h2osoi_ice(c,snl(c)+1) > 0._r8) htvp(c) = hsub

       ! Switch between vaporization and sublimation causes rapid solution
       ! separation in perturbation growth test

#if (defined PERGRO)
       htvp(c) = hvap
#endif

       ! Ground roughness lengths over non-lake columns (includes bare ground, ground
       ! underneath canopy, wetlands, etc.)

       if (frac_sno(c) > 0._r8) then
          z0mg(c) = zsno
       else
          z0mg(c) = zlnd
       end if
       z0hg(c) = z0mg(c)            ! initial set only
       z0qg(c) = z0mg(c)            ! initial set only

       ! Potential, virtual potential temperature, and wind speed at the
       ! reference height

       beta(c) = 1._r8
       zii(c)  = 1000._r8
       thv(c)  = forc_th(g)*(1._r8+0.61_r8*forc_q(g))

    end do ! (end of columns loop)
    
    ! Initialization

    do fp = 1,num_nolakep
       p = filter_nolakep(fp)

       ! Initial set (needed for history tape fields)

       eflx_sh_tot(p) = 0._r8
       l = plandunit(p)
       if (ityplun(l) == isturb) then
         eflx_sh_tot_u(p) = 0._r8
#ifndef CROP
       else if (ityplun(l) == istsoil) then
#else
       else if (ityplun(l) == istsoil .or. ityplun(l) == istcrop) then 
#endif
         eflx_sh_tot_r(p) = 0._r8
       end if
       eflx_lh_tot(p) = 0._r8
       if (ityplun(l) == isturb) then
         eflx_lh_tot_u(p) = 0._r8
#ifndef CROP
       else if (ityplun(l) == istsoil) then
#else
       else if (ityplun(l) == istsoil .or. ityplun(l) == istcrop) then 
#endif
         eflx_lh_tot_r(p) = 0._r8
       end if
       eflx_sh_veg(p) = 0._r8
       qflx_evap_tot(p) = 0._r8
       qflx_evap_veg(p) = 0._r8
       qflx_tran_veg(p) = 0._r8

       ! Initial set for calculation

       cgrnd(p)  = 0._r8
       cgrnds(p) = 0._r8
       cgrndl(p) = 0._r8

       ! Vegetation Emissivity

       avmuir = 1._r8
       emv(p) = 1._r8-exp(-(elai(p)+esai(p))/avmuir)

       ! Roughness lengths over vegetation

       z0m(p)    = z0mr(ivt(p)) * htop(p)
       displa(p) = displar(ivt(p)) * htop(p)

       z0mv(p)   = z0m(p)
       z0hv(p)   = z0mv(p)
       z0qv(p)   = z0mv(p)
    end do

    ! Make forcing height a pft-level quantity that is the atmospheric forcing 
    ! height plus each pft's z0m+displa
    do pi = 1,max_pft_per_gcell
       do g = lbg, ubg
          if (pi <= npfts(g)) then
            p = pfti(g) + pi - 1
            if (pwtgcell(p) > 0._r8) then 
              l = plandunit(p)
              c = pcolumn(p)
#ifndef CROP
              if (ityplun(l) == istsoil) then
#else
              if (ityplun(l) == istsoil .or. ityplun(l) == istcrop) then
#endif
                if (frac_veg_nosno(p) == 0) then
                  forc_hgt_u_pft(p) = forc_hgt_u(g) + z0mg(c) + displa(p)
                  forc_hgt_t_pft(p) = forc_hgt_t(g) + z0mg(c) + displa(p)
                  forc_hgt_q_pft(p) = forc_hgt_q(g) + z0mg(c) + displa(p)
                else
                  forc_hgt_u_pft(p) = forc_hgt_u(g) + z0m(p) + displa(p)
                  forc_hgt_t_pft(p) = forc_hgt_t(g) + z0m(p) + displa(p)
                  forc_hgt_q_pft(p) = forc_hgt_q(g) + z0m(p) + displa(p)
                end if
              else if (ityplun(l) == istice .or. ityplun(l) == istwet) then
                forc_hgt_u_pft(p) = forc_hgt_u(g) + z0mg(c)
                forc_hgt_t_pft(p) = forc_hgt_t(g) + z0mg(c)
                forc_hgt_q_pft(p) = forc_hgt_q(g) + z0mg(c)
              else if (ityplun(l) == istdlak) then
                ! Should change the roughness lengths to shared constants
                if (t_grnd(c) >= tfrz) then
                  forc_hgt_u_pft(p) = forc_hgt_u(g) + 0.01_r8
                  forc_hgt_t_pft(p) = forc_hgt_t(g) + 0.01_r8
                  forc_hgt_q_pft(p) = forc_hgt_q(g) + 0.01_r8
                else
                  forc_hgt_u_pft(p) = forc_hgt_u(g) + 0.04_r8
                  forc_hgt_t_pft(p) = forc_hgt_t(g) + 0.04_r8
                  forc_hgt_q_pft(p) = forc_hgt_q(g) + 0.04_r8
                end if
              else if (ityplun(l) == isturb) then
                forc_hgt_u_pft(p) = forc_hgt_u(g) + z_0_town(l) + z_d_town(l)
                forc_hgt_t_pft(p) = forc_hgt_t(g) + z_0_town(l) + z_d_town(l)
                forc_hgt_q_pft(p) = forc_hgt_q(g) + z_0_town(l) + z_d_town(l)
              end if
            end if
          end if
       end do
    end do

    do fp = 1,num_nolakep
       p = filter_nolakep(fp)
       g = pgridcell(p)

       thm(p)  = forc_t(g) + 0.0098_r8*forc_hgt_t_pft(p)

    end do

  end subroutine Biogeophysics1

end module Biogeophysics1Mod
!=================================================================================================
module Biogeophysics2Mod

!-----------------------------------------------------------------------
!BOP
!
! !MODULE: Biogeophysics2Mod
!
! !DESCRIPTION:
! Performs the calculation of soil/snow and ground temperatures
! and updates surface fluxes based on the new ground temperature.
!
! !USES:
  use shr_kind_mod, only: r8 => shr_kind_r8
  use globals, only: nstep
!
! !PUBLIC TYPES:
  implicit none
  save
!
! !PUBLIC MEMBER FUNCTIONS:
  public :: Biogeophysics2   ! Calculate soil/snow and ground temperatures
!
! !REVISION HISTORY:
! Created by Mariana Vertenstein
!
!EOP
!-----------------------------------------------------------------------

contains

!-----------------------------------------------------------------------
!BOP
!
! !IROUTINE: Biogeophysics2
!
! !INTERFACE:
  subroutine Biogeophysics2 (lbl, ubl, lbc, ubc, lbp, ubp, &
             num_urbanl, filter_urbanl, num_nolakec, filter_nolakec, &
             num_nolakep, filter_nolakep)
!
! !DESCRIPTION:
! This is the main subroutine to execute the calculation of soil/snow and
! ground temperatures and update surface fluxes based on the new ground
! temperature
!
! Calling sequence is:
! Biogeophysics2:             surface biogeophysics driver
!    -> SoilTemperature:      soil/snow and ground temperatures
!          -> SoilTermProp    thermal conductivities and heat capacities
!          -> Tridiagonal     tridiagonal matrix solution
!          -> PhaseChange     phase change of liquid/ice contents
!
! (1) Snow and soil temperatures
!     o The volumetric heat capacity is calculated as a linear combination
!       in terms of the volumetric fraction of the constituent phases.
!     o The thermal conductivity of soil is computed from
!       the algorithm of Johansen (as reported by Farouki 1981), and the
!       conductivity of snow is from the formulation used in
!       SNTHERM (Jordan 1991).
!     o Boundary conditions:
!       F = Rnet - Hg - LEg (top),  F= 0 (base of the soil column).
!     o Soil / snow temperature is predicted from heat conduction
!       in 10 soil layers and up to 5 snow layers.
!       The thermal conductivities at the interfaces between two
!       neighboring layers (j, j+1) are derived from an assumption that
!       the flux across the interface is equal to that from the node j
!       to the interface and the flux from the interface to the node j+1.
!       The equation is solved using the Crank-Nicholson method and
!       results in a tridiagonal system equation.
!
! (2) Phase change (see PhaseChange.F90)
!
! !USES:
    use clmtype
    use clm_varcon        , only : hvap, cpair, grav, vkc, tfrz, sb, &
                                   isturb, icol_roof, icol_sunwall, icol_shadewall, istsoil
#ifdef CROP
    use clm_varcon        , only : istcrop
#endif
    use clm_varpar        , only : nlevsno, nlevgrnd, max_pft_per_col
    use SoilTemperatureMod, only : SoilTemperature
    use subgridAveMod     , only : p2c
    use globals           , only : dtime
!
! !ARGUMENTS:
    implicit none
    integer, intent(in) :: lbp, ubp                    ! pft bounds
    integer, intent(in) :: lbc, ubc                    ! column bounds
    integer, intent(in) :: lbl, ubl                    ! landunit bounds
    integer, intent(in) :: num_nolakec                 ! number of column non-lake points in column filter
    integer, intent(in) :: filter_nolakec(ubc-lbc+1)   ! column filter for non-lake points
    integer, intent(in) :: num_urbanl                  ! number of urban landunits in clump
    integer, intent(in) :: filter_urbanl(ubl-lbl+1)    ! urban landunit filter
    integer, intent(in) :: num_nolakep                 ! number of column non-lake points in pft filter
    integer, intent(in) :: filter_nolakep(ubp-lbp+1)   ! pft filter for non-lake points
!
! !CALLED FROM:
! subroutine clm_driver1
!
! !REVISION HISTORY:
! 15 September 1999: Yongjiu Dai; Initial code
! 15 December 1999:  Paul Houser and Jon Radakovich; F90 Revision
! Migrated to clm2.0 by Keith Oleson and Mariana Vertenstein
! Migrated to clm2.1 new data structures by Peter Thornton and M. Vertenstein
!
! !LOCAL VARIABLES:
!
! local pointers to implicit in arguments
!
    integer , pointer :: ctype(:)                ! column type
    integer , pointer :: ltype(:)                ! landunit type
    integer , pointer :: pcolumn(:)         ! pft's column index
    integer , pointer :: plandunit(:)            ! pft's landunit index
    integer , pointer :: pgridcell(:)       ! pft's gridcell index
    real(r8), pointer :: pwtgcell(:)        ! pft's weight relative to corresponding column
    integer , pointer :: npfts(:)           ! column's number of pfts 
    integer , pointer :: pfti(:)            ! column's beginning pft index 
    integer , pointer :: snl(:)             ! number of snow layers
    logical , pointer :: do_capsnow(:)      ! true => do snow capping
    real(r8), pointer :: forc_lwrad(:)      ! downward infrared (longwave) radiation (W/m**2)
    real(r8), pointer :: emg(:)             ! ground emissivity
    real(r8), pointer :: htvp(:)            ! latent heat of vapor of water (or sublimation) [j/kg]
    real(r8), pointer :: t_grnd(:)          ! ground temperature (Kelvin)
    integer , pointer :: frac_veg_nosno(:)  ! fraction of vegetation not covered by snow (0 OR 1 now) [-]
    real(r8), pointer :: cgrnds(:)          ! deriv, of soil sensible heat flux wrt soil temp [w/m2/k]
    real(r8), pointer :: cgrndl(:)          ! deriv of soil latent heat flux wrt soil temp [w/m**2/k]
    real(r8), pointer :: sabg(:)            ! solar radiation absorbed by ground (W/m**2)
    real(r8), pointer :: dlrad(:)           ! downward longwave radiation below the canopy [W/m2]
    real(r8), pointer :: ulrad(:)           ! upward longwave radiation above the canopy [W/m2]
    real(r8), pointer :: eflx_sh_veg(:)     ! sensible heat flux from leaves (W/m**2) [+ to atm]
    real(r8), pointer :: qflx_evap_veg(:)   ! vegetation evaporation (mm H2O/s) (+ = to atm)
    real(r8), pointer :: qflx_tran_veg(:)   ! vegetation transpiration (mm H2O/s) (+ = to atm)
    real(r8), pointer :: qflx_evap_can(:)   ! evaporation from leaves and stems (mm H2O/s) (+ = to atm)
    real(r8), pointer :: wtcol(:)           ! pft weight relative to column
    real(r8), pointer :: tssbef(:,:)        ! soil/snow temperature before update
    real(r8), pointer :: t_soisno(:,:)      ! soil temperature (Kelvin)
    real(r8), pointer :: h2osoi_ice(:,:)    ! ice lens (kg/m2) (new)
    real(r8), pointer :: h2osoi_liq(:,:)    ! liquid water (kg/m2) (new)
    real(r8), pointer :: eflx_building_heat(:)   ! heat flux from urban building interior to walls, roof
    real(r8), pointer :: eflx_traffic_pft(:)    ! traffic sensible heat flux (W/m**2)
    real(r8), pointer :: eflx_wasteheat_pft(:)  ! sensible heat flux from urban heating/cooling sources of waste heat (W/m**2)
    real(r8), pointer :: eflx_heat_from_ac_pft(:) ! sensible heat flux put back into canyon due to removal by AC (W/m**2)
    real(r8), pointer :: canyon_hwr(:)      ! ratio of building height to street width (-)
 
! local pointers to implicit inout arguments
!
    real(r8), pointer :: eflx_sh_grnd(:)    ! sensible heat flux from ground (W/m**2) [+ to atm]
    real(r8), pointer :: qflx_evap_soi(:)   ! soil evaporation (mm H2O/s) (+ = to atm)
    real(r8), pointer :: qflx_snwcp_liq(:)  ! excess rainfall due to snow capping (mm H2O /s)
    real(r8), pointer :: qflx_snwcp_ice(:)  ! excess snowfall due to snow capping (mm H2O /s)
! 
! local pointers to implicit out arguments
! 
    real(r8), pointer :: dt_grnd(:)         ! change in t_grnd, last iteration (Kelvin)
    real(r8), pointer :: eflx_soil_grnd(:)  ! soil heat flux (W/m**2) [+ = into soil]
    real(r8), pointer :: eflx_soil_grnd_u(:)! urban soil heat flux (W/m**2) [+ = into soil]
    real(r8), pointer :: eflx_soil_grnd_r(:)! rural soil heat flux (W/m**2) [+ = into soil]
    real(r8), pointer :: eflx_sh_tot(:)     ! total sensible heat flux (W/m**2) [+ to atm]
    real(r8), pointer :: eflx_sh_tot_u(:)   ! urban total sensible heat flux (W/m**2) [+ to atm]
    real(r8), pointer :: eflx_sh_tot_r(:)   ! rural total sensible heat flux (W/m**2) [+ to atm]
    real(r8), pointer :: qflx_evap_tot(:)   ! qflx_evap_soi + qflx_evap_veg + qflx_tran_veg
    real(r8), pointer :: eflx_lh_tot(:)     ! total latent heat flux (W/m**2)  [+ to atm]
    real(r8), pointer :: eflx_lh_tot_u(:)   ! urban total latent heat flux (W/m**2)  [+ to atm]
    real(r8), pointer :: eflx_lh_tot_r(:)   ! rural total latent heat flux (W/m**2)  [+ to atm]
    real(r8), pointer :: qflx_evap_grnd(:)  ! ground surface evaporation rate (mm H2O/s) [+]
    real(r8), pointer :: qflx_sub_snow(:)   ! sublimation rate from snow pack (mm H2O /s) [+]
    real(r8), pointer :: qflx_dew_snow(:)   ! surface dew added to snow pack (mm H2O /s) [+]
    real(r8), pointer :: qflx_dew_grnd(:)   ! ground surface dew formation (mm H2O /s) [+]
    real(r8), pointer :: eflx_lwrad_out(:)  ! emitted infrared (longwave) radiation (W/m**2)
    real(r8), pointer :: eflx_lwrad_net(:)  ! net infrared (longwave) rad (W/m**2) [+ = to atm]
    real(r8), pointer :: eflx_lwrad_net_u(:)  ! urban net infrared (longwave) rad (W/m**2) [+ = to atm]
    real(r8), pointer :: eflx_lwrad_net_r(:)  ! rural net infrared (longwave) rad (W/m**2) [+ = to atm]
    real(r8), pointer :: eflx_lh_vege(:)    ! veg evaporation heat flux (W/m**2) [+ to atm]
    real(r8), pointer :: eflx_lh_vegt(:)    ! veg transpiration heat flux (W/m**2) [+ to atm]
    real(r8), pointer :: eflx_lh_grnd(:)    ! ground evaporation heat flux (W/m**2) [+ to atm]
    real(r8), pointer :: errsoi_pft(:)      ! pft-level soil/lake energy conservation error (W/m**2)
    real(r8), pointer :: errsoi_col(:)      ! column-level soil/lake energy conservation error (W/m**2)
!
!
! !OTHER LOCAL VARIABLES:
!EOP
!
    integer  :: p,c,g,j,pi,l         ! indices
    integer  :: fc,fp                ! lake filtered column and pft indices
    real(r8) :: egsmax(lbc:ubc)      ! max. evaporation which soil can provide at one time step
    real(r8) :: egirat(lbc:ubc)      ! ratio of topsoil_evap_tot : egsmax
    real(r8) :: tinc(lbc:ubc)        ! temperature difference of two time step
    real(r8) :: xmf(lbc:ubc)         ! total latent heat of phase change of ground water
    real(r8) :: sumwt(lbc:ubc)       ! temporary
    real(r8) :: evaprat(lbp:ubp)     ! ratio of qflx_evap_soi/topsoil_evap_tot
    real(r8) :: save_qflx_evap_soi   ! temporary storage for qflx_evap_soi
    real(r8) :: topsoil_evap_tot(lbc:ubc)          ! column-level total evaporation from top soil layer
    real(r8) :: fact(lbc:ubc, -nlevsno+1:nlevgrnd)  ! used in computing tridiagonal matrix
    real(r8) :: eflx_lwrad_del(lbp:ubp)            ! update due to eflx_lwrad
!-----------------------------------------------------------------------

    ! Assign local pointers to derived subtypes components (gridcell-level)

    forc_lwrad => clm_a2l%forc_lwrad

    ! Assign local pointers to derived subtypes components (landunit-level)

    ltype      => clm3%g%l%itype
    canyon_hwr     => clm3%g%l%canyon_hwr

    ! Assign local pointers to derived subtypes components (column-level)

    ctype      => clm3%g%l%c%itype
    npfts      => clm3%g%l%c%npfts
    pfti       => clm3%g%l%c%pfti
    snl        => clm3%g%l%c%cps%snl
    do_capsnow => clm3%g%l%c%cps%do_capsnow
    htvp       => clm3%g%l%c%cps%htvp
    emg        => clm3%g%l%c%cps%emg
    t_grnd     => clm3%g%l%c%ces%t_grnd
    dt_grnd    => clm3%g%l%c%ces%dt_grnd
    t_soisno   => clm3%g%l%c%ces%t_soisno
    tssbef     => clm3%g%l%c%ces%tssbef
    h2osoi_ice => clm3%g%l%c%cws%h2osoi_ice
    h2osoi_liq => clm3%g%l%c%cws%h2osoi_liq
    errsoi_col => clm3%g%l%c%cebal%errsoi
    eflx_building_heat => clm3%g%l%c%cef%eflx_building_heat

    ! Assign local pointers to derived subtypes components (pft-level)

    pcolumn        => clm3%g%l%c%p%column
    plandunit      => clm3%g%l%c%p%landunit
    pgridcell      => clm3%g%l%c%p%gridcell
    pwtgcell       => clm3%g%l%c%p%wtgcell
    frac_veg_nosno => clm3%g%l%c%p%pps%frac_veg_nosno
    sabg           => clm3%g%l%c%p%pef%sabg
    dlrad          => clm3%g%l%c%p%pef%dlrad
    ulrad          => clm3%g%l%c%p%pef%ulrad
    eflx_sh_grnd   => clm3%g%l%c%p%pef%eflx_sh_grnd
    eflx_sh_veg    => clm3%g%l%c%p%pef%eflx_sh_veg
    qflx_evap_soi  => clm3%g%l%c%p%pwf%qflx_evap_soi
    qflx_evap_veg  => clm3%g%l%c%p%pwf%qflx_evap_veg
    qflx_tran_veg  => clm3%g%l%c%p%pwf%qflx_tran_veg
    qflx_evap_can  => clm3%g%l%c%p%pwf%qflx_evap_can
    qflx_snwcp_liq => clm3%g%l%c%p%pwf%qflx_snwcp_liq
    qflx_snwcp_ice => clm3%g%l%c%p%pwf%qflx_snwcp_ice
    qflx_evap_tot  => clm3%g%l%c%p%pwf%qflx_evap_tot
    qflx_evap_grnd => clm3%g%l%c%p%pwf%qflx_evap_grnd
    qflx_sub_snow  => clm3%g%l%c%p%pwf%qflx_sub_snow
    qflx_dew_snow  => clm3%g%l%c%p%pwf%qflx_dew_snow
    qflx_dew_grnd  => clm3%g%l%c%p%pwf%qflx_dew_grnd
    eflx_soil_grnd => clm3%g%l%c%p%pef%eflx_soil_grnd
    eflx_soil_grnd_u => clm3%g%l%c%p%pef%eflx_soil_grnd_u
    eflx_soil_grnd_r => clm3%g%l%c%p%pef%eflx_soil_grnd_r
    eflx_sh_tot    => clm3%g%l%c%p%pef%eflx_sh_tot
    eflx_sh_tot_u  => clm3%g%l%c%p%pef%eflx_sh_tot_u
    eflx_sh_tot_r  => clm3%g%l%c%p%pef%eflx_sh_tot_r
    eflx_lh_tot    => clm3%g%l%c%p%pef%eflx_lh_tot
    eflx_lh_tot_u    => clm3%g%l%c%p%pef%eflx_lh_tot_u
    eflx_lh_tot_r    => clm3%g%l%c%p%pef%eflx_lh_tot_r
    eflx_lwrad_out => clm3%g%l%c%p%pef%eflx_lwrad_out
    eflx_lwrad_net => clm3%g%l%c%p%pef%eflx_lwrad_net
    eflx_lwrad_net_u => clm3%g%l%c%p%pef%eflx_lwrad_net_u
    eflx_lwrad_net_r => clm3%g%l%c%p%pef%eflx_lwrad_net_r
    eflx_lh_vege   => clm3%g%l%c%p%pef%eflx_lh_vege
    eflx_lh_vegt   => clm3%g%l%c%p%pef%eflx_lh_vegt
    eflx_lh_grnd   => clm3%g%l%c%p%pef%eflx_lh_grnd
    cgrnds         => clm3%g%l%c%p%pef%cgrnds
    cgrndl         => clm3%g%l%c%p%pef%cgrndl
    eflx_sh_grnd   => clm3%g%l%c%p%pef%eflx_sh_grnd
    qflx_evap_soi  => clm3%g%l%c%p%pwf%qflx_evap_soi
    errsoi_pft     => clm3%g%l%c%p%pebal%errsoi
    wtcol          => clm3%g%l%c%p%wtcol
    eflx_wasteheat_pft => clm3%g%l%c%p%pef%eflx_wasteheat_pft
    eflx_heat_from_ac_pft => clm3%g%l%c%p%pef%eflx_heat_from_ac_pft
    eflx_traffic_pft => clm3%g%l%c%p%pef%eflx_traffic_pft


    ! Determine soil temperatures including surface soil temperature

    call SoilTemperature(lbl, ubl, lbc, ubc, num_urbanl, filter_urbanl, &
                         num_nolakec, filter_nolakec, xmf , fact)

    do fc = 1,num_nolakec
       c = filter_nolakec(fc)
       j = snl(c)+1

       ! Calculate difference in soil temperature from last time step, for
       ! flux corrections

       tinc(c) = t_soisno(c,j) - tssbef(c,j)

       ! Determine ratio of topsoil_evap_tot

       egsmax(c) = (h2osoi_ice(c,j)+h2osoi_liq(c,j)) / dtime

       ! added to trap very small negative soil water,ice

       if (egsmax(c) < 0._r8) then
          egsmax(c) = 0._r8
       end if
    end do

    ! A preliminary pft loop to determine if corrections are required for
    ! excess evaporation from the top soil layer... Includes new logic
    ! to distribute the corrections between pfts on the basis of their
    ! evaporative demands.
    ! egirat holds the ratio of demand to availability if demand is
    ! greater than availability, or 1.0 otherwise.
    ! Correct fluxes to present soil temperature

    do fp = 1,num_nolakep
       p = filter_nolakep(fp)
       c = pcolumn(p)
       eflx_sh_grnd(p) = eflx_sh_grnd(p) + tinc(c)*cgrnds(p)

       qflx_evap_soi(p) = qflx_evap_soi(p) + tinc(c)*cgrndl(p)
    end do

    ! Set the column-average qflx_evap_soi as the weighted average over all pfts
    ! but only count the pfts that are evaporating

    do fc = 1,num_nolakec
       c = filter_nolakec(fc)
       topsoil_evap_tot(c) = 0._r8
       sumwt(c) = 0._r8
    end do

    do pi = 1,max_pft_per_col
       do fc = 1,num_nolakec
          c = filter_nolakec(fc)
          if ( pi <= npfts(c) ) then
             p = pfti(c) + pi - 1
             if (pwtgcell(p)>0._r8) then
                topsoil_evap_tot(c) = topsoil_evap_tot(c) + qflx_evap_soi(p) * wtcol(p)
             end if
          end if
       end do
    end do

    ! Calculate ratio for rescaling pft-level fluxes to meet availability

    do fc = 1,num_nolakec
       c = filter_nolakec(fc)
       if (topsoil_evap_tot(c) > egsmax(c)) then
          egirat(c) = (egsmax(c)/topsoil_evap_tot(c))
       else
          egirat(c) = 1.0_r8
       end if
    end do

    do fp = 1,num_nolakep
       p = filter_nolakep(fp)
       c = pcolumn(p)
       l = plandunit(p)
       g = pgridcell(p)
       j = snl(c)+1

       ! Correct soil fluxes for possible evaporation in excess of top layer water
       ! excess energy is added to the sensible heat flux from soil

       if (egirat(c) < 1.0_r8) then
          save_qflx_evap_soi = qflx_evap_soi(p)
          qflx_evap_soi(p) = qflx_evap_soi(p) * egirat(c)
          eflx_sh_grnd(p) = eflx_sh_grnd(p) + (save_qflx_evap_soi - qflx_evap_soi(p))*htvp(c)

       end if

       ! Ground heat flux
       
        

       if (ltype(l) /= isturb) then
          eflx_soil_grnd(p) = sabg(p) + dlrad(p) &
                              + (1-frac_veg_nosno(p))*emg(c)*forc_lwrad(g) &
                              - emg(c)*sb*tssbef(c,j)**3*(tssbef(c,j) + 4._r8*tinc(c)) &
                              - (eflx_sh_grnd(p) + qflx_evap_soi(p)*htvp(c))



#ifndef CROP
          if (ltype(l) == istsoil) then
#else
          if (ltype(l) == istsoil .or. ltype(l) == istcrop) then
#endif
            eflx_soil_grnd_r(p) = eflx_soil_grnd(p)
          end if
       else
          ! For all urban columns we use the net longwave radiation (eflx_lwrad_net) since
          ! the term (emg*sb*tssbef(snl+1)**4) is not the upward longwave flux because of 
          ! interactions between urban columns.

          eflx_lwrad_del(p) = 4._r8*emg(c)*sb*tssbef(c,j)**3*tinc(c)
          ! Include transpiration term because needed for pervious road
          ! and wasteheat and traffic flux
          eflx_soil_grnd(p) = sabg(p) + dlrad(p) &
                              - eflx_lwrad_net(p) - eflx_lwrad_del(p) &
                              - (eflx_sh_grnd(p) + qflx_evap_soi(p)*htvp(c) + qflx_tran_veg(p)*hvap) &
                              + eflx_wasteheat_pft(p) + eflx_heat_from_ac_pft(p) + eflx_traffic_pft(p)
          eflx_soil_grnd_u(p) = eflx_soil_grnd(p)
       end if

       ! Total fluxes (vegetation + ground)

       eflx_sh_tot(p) = eflx_sh_veg(p) + eflx_sh_grnd(p)



       qflx_evap_tot(p) = qflx_evap_veg(p) + qflx_evap_soi(p)
       eflx_lh_tot(p)= hvap*qflx_evap_veg(p) + htvp(c)*qflx_evap_soi(p)
#ifndef CROP
       if (ltype(l) == istsoil) then
#else
       if (ltype(l) == istsoil .or. ltype(l) == istcrop) then
#endif
         eflx_lh_tot_r(p)= eflx_lh_tot(p)
         eflx_sh_tot_r(p)= eflx_sh_tot(p)
       else if (ltype(l) == isturb) then
         eflx_lh_tot_u(p)= eflx_lh_tot(p)
         eflx_sh_tot_u(p)= eflx_sh_tot(p)
       end if

       ! Assign ground evaporation to sublimation from soil ice or to dew
       ! on snow or ground

       qflx_evap_grnd(p) = 0._r8
       qflx_sub_snow(p) = 0._r8
       qflx_dew_snow(p) = 0._r8
       qflx_dew_grnd(p) = 0._r8

       if (qflx_evap_soi(p) >= 0._r8) then
          ! for evaporation partitioning between liquid evap and ice sublimation, 
	  ! use the ratio of liquid to (liquid+ice) in the top layer to determine split
	  if ((h2osoi_liq(c,j)+h2osoi_ice(c,j)) > 0.) then
             qflx_evap_grnd(p) = max(qflx_evap_soi(p)*(h2osoi_liq(c,j)/(h2osoi_liq(c,j)+h2osoi_ice(c,j))), 0._r8)
	  else
	     qflx_evap_grnd(p) = 0.
	  end if
          qflx_sub_snow(p) = qflx_evap_soi(p) - qflx_evap_grnd(p)
       else
          if (t_grnd(c) < tfrz) then
             qflx_dew_snow(p) = abs(qflx_evap_soi(p))
          else
             qflx_dew_grnd(p) = abs(qflx_evap_soi(p))
          end if
       end if

       ! Update the pft-level qflx_snwcp
       ! This was moved in from Hydrology2 to keep all pft-level
       ! calculations out of Hydrology2

       if (snl(c) < 0 .and. do_capsnow(c)) then
          qflx_snwcp_liq(p) = qflx_snwcp_liq(p) + qflx_dew_grnd(p)
          qflx_snwcp_ice(p) = qflx_snwcp_ice(p) + qflx_dew_snow(p)
       end if

       ! Variables needed by history tape

       qflx_evap_can(p)  = qflx_evap_veg(p) - qflx_tran_veg(p)
       eflx_lh_vege(p)   = (qflx_evap_veg(p) - qflx_tran_veg(p)) * hvap
       eflx_lh_vegt(p)   = qflx_tran_veg(p) * hvap
       eflx_lh_grnd(p)   = qflx_evap_soi(p) * htvp(c)

    end do

    ! Soil Energy balance check

    do fp = 1,num_nolakep
       p = filter_nolakep(fp)
       c = pcolumn(p)
       errsoi_pft(p) = eflx_soil_grnd(p) - xmf(c)

       ! For urban sunwall, shadewall, and roof columns, the "soil" energy balance check
       ! must include the heat flux from the interior of the building.
       if (ctype(c)==icol_sunwall .or. ctype(c)==icol_shadewall .or. ctype(c)==icol_roof) then
          errsoi_pft(p) = errsoi_pft(p) + eflx_building_heat(c) 
       end if
    end do
    do j = -nlevsno+1,nlevgrnd
       do fp = 1,num_nolakep
          p = filter_nolakep(fp)
          c = pcolumn(p)
          if (j >= snl(c)+1) then
             errsoi_pft(p) = errsoi_pft(p) - (t_soisno(c,j)-tssbef(c,j))/fact(c,j)
          end if
       end do
    end do

    ! Outgoing long-wave radiation from vegetation + ground
    ! For conservation we put the increase of ground longwave to outgoing
    ! For urban pfts, ulrad=0 and (1-fracveg_nosno)=1, and eflx_lwrad_out and eflx_lwrad_net 
    ! are calculated in UrbanRadiation. The increase of ground longwave is added directly 
    ! to the outgoing longwave and the net longwave.

    do fp = 1,num_nolakep
       p = filter_nolakep(fp)
       c = pcolumn(p)
       l = plandunit(p)
       g = pgridcell(p)
       j = snl(c)+1

       if (ltype(l) /= isturb) then
          eflx_lwrad_out(p) = ulrad(p) &
                              + (1-frac_veg_nosno(p))*(1.-emg(c))*forc_lwrad(g) &
                              + (1-frac_veg_nosno(p))*emg(c)*sb*tssbef(c,j)**4 &
                              + 4.*emg(c)*sb*tssbef(c,j)**3*tinc(c)
          eflx_lwrad_net(p) = eflx_lwrad_out(p) - forc_lwrad(g)
#ifndef CROP
          if (ltype(l) == istsoil) then
#else
          if (ltype(l) == istsoil .or. ltype(l) == istcrop) then
#endif
            eflx_lwrad_net_r(p) = eflx_lwrad_out(p) - forc_lwrad(g)
          end if
       else
          eflx_lwrad_out(p) = eflx_lwrad_out(p) + eflx_lwrad_del(p)
          eflx_lwrad_net(p) = eflx_lwrad_net(p) + eflx_lwrad_del(p)
          eflx_lwrad_net_u(p) = eflx_lwrad_net_u(p) + eflx_lwrad_del(p)
       end if
    end do

    ! lake balance for errsoi is not over pft
    ! therefore obtain column-level radiative temperature

    call p2c(num_nolakec, filter_nolakec, errsoi_pft, errsoi_col)

  end subroutine Biogeophysics2

end module Biogeophysics2Mod

!=================================================================================================
module BiogeophysicsLakeMod

!-----------------------------------------------------------------------
!BOP
!
! !MODULE: BiogeophysicsLakeMod
!
! !DESCRIPTION:
! Calculates lake temperatures and surface fluxes.
!
! !PUBLIC TYPES:
  implicit none
  save
!
! !PUBLIC MEMBER FUNCTIONS:
  public :: BiogeophysicsLake

! !REVISION HISTORY:
! Created by Mariana Vertenstein
!
!EOP
!-----------------------------------------------------------------------

contains

!-----------------------------------------------------------------------
!BOP
!
! !IROUTINE: BiogeophysicsLake
!
! !INTERFACE:
  subroutine BiogeophysicsLake(lbc, ubc, lbp, ubp, num_lakec, filter_lakec, &
                               num_lakep, filter_lakep)
!
! !DESCRIPTION:
! Calculates lake temperatures and surface fluxes.
! Lake temperatures are determined from a one-dimensional thermal
! stratification model based on eddy diffusion concepts to
! represent vertical mixing of heat.
!
! d ts    d            d ts     1 ds
! ---- = -- [(km + ke) ----] + -- --
!  dt    dz             dz     cw dz
!
! where: ts = temperature (kelvin)
!         t = time (s)
!         z = depth (m)
!        km = molecular diffusion coefficient (m**2/s)
!        ke = eddy diffusion coefficient (m**2/s)
!        cw = heat capacity (j/m**3/kelvin)
!         s = heat source term (w/m**2)
!
! There are two types of lakes:
!   Deep lakes are 50 m.
!   Shallow lakes are 10 m deep.
!
!   For unfrozen deep lakes:    ke > 0 and    convective mixing
!   For unfrozen shallow lakes: ke = 0 and no convective mixing
!
! Use the Crank-Nicholson method to set up tridiagonal system of equations to
! solve for ts at time n+1, where the temperature equation for layer i is
! r_i = a_i [ts_i-1] n+1 + b_i [ts_i] n+1 + c_i [ts_i+1] n+1
!
! The solution conserves energy as:
!
! cw*([ts(      1)] n+1 - [ts(      1)] n)*dz(      1)/dt + ... +
! cw*([ts(nlevlak)] n+1 - [ts(nlevlak)] n)*dz(nlevlak)/dt = fin
!
! where:
! [ts] n   = old temperature (kelvin)
! [ts] n+1 = new temperature (kelvin)
! fin      = heat flux into lake (w/m**2)
!          = beta*sabg + forc_lwrad - eflx_lwrad_out - eflx_sh_tot - eflx_lh_tot
!            - hm + phi(1) + ... + phi(nlevlak)
!
! WARNING: This subroutine assumes lake columns have one and only one pft.
!
! !USES:
    use shr_kind_mod, only: r8 => shr_kind_r8
    use clmtype
    use clm_varpar         , only : nlevlak
    use clm_varcon         , only : hvap, hsub, hfus, cpair, cpliq, cpice, tkwat, tkice, &
                                    sb, vkc, grav, denh2o, tfrz, spval
    use QSatMod            , only : QSat
    use FrictionVelocityMod, only : FrictionVelocity, MoninObukIni
    use TridiagonalMod     , only : Tridiagonal
    use globals            , only : dtime
!
! !ARGUMENTS:
    implicit none
    integer, intent(in) :: lbc, ubc                ! column-index bounds
    integer, intent(in) :: lbp, ubp                ! pft-index bounds
    integer, intent(in) :: num_lakec               ! number of column non-lake points in column filter
    integer, intent(in) :: filter_lakec(ubc-lbc+1) ! column filter for non-lake points
    integer, intent(in) :: num_lakep               ! number of column non-lake points in pft filter
    integer, intent(in) :: filter_lakep(ubp-lbp+1) ! pft filter for non-lake points
!
! !CALLED FROM:
! subroutine clm_driver1
!
! !REVISION HISTORY:
! Author: Gordon Bonan
! 15 September 1999: Yongjiu Dai; Initial code
! 15 December 1999:  Paul Houser and Jon Radakovich; F90 Revision
! Migrated to clm2.1 new data structures by Peter Thornton and M. Vertenstein
!
! !LOCAL VARIABLES:
!
! local pointers to implicit in arguments
!
    integer , pointer :: pcolumn(:)         ! pft's column index
    integer , pointer :: pgridcell(:)       ! pft's gridcell index
    integer , pointer :: cgridcell(:)       ! column's gridcell index
    real(r8), pointer :: forc_t(:)          ! atmospheric temperature (Kelvin)
    real(r8), pointer :: forc_pbot(:)       ! atmospheric pressure (Pa)
    real(r8), pointer :: forc_hgt_u_pft(:)  ! observational height of wind at pft level [m]
    real(r8), pointer :: forc_hgt_t_pft(:)  ! observational height of temperature at pft level [m]
    real(r8), pointer :: forc_hgt_q_pft(:)  ! observational height of specific humidity at pft level [m]
    real(r8), pointer :: forc_th(:)         ! atmospheric potential temperature (Kelvin)
    real(r8), pointer :: forc_q(:)          ! atmospheric specific humidity (kg/kg)
    real(r8), pointer :: forc_u(:)          ! atmospheric wind speed in east direction (m/s)
    real(r8), pointer :: forc_v(:)          ! atmospheric wind speed in north direction (m/s)
    real(r8), pointer :: forc_lwrad(:)      ! downward infrared (longwave) radiation (W/m**2)
    real(r8), pointer :: forc_rho(:)        ! density (kg/m**3)
    real(r8), pointer :: forc_snow(:)       ! snow rate [mm/s]
    real(r8), pointer :: forc_rain(:)       ! rain rate [mm/s]
    real(r8), pointer :: t_grnd(:)          ! ground temperature (Kelvin)
    real(r8), pointer :: hc_soisno(:)       ! soil plus snow plus lake heat content (MJ/m2)
    real(r8), pointer :: h2osno(:)          ! snow water (mm H2O)
    real(r8), pointer :: snowdp(:)          ! snow height (m)
    real(r8), pointer :: sabg(:)            ! solar radiation absorbed by ground (W/m**2)
    real(r8), pointer :: lat(:)             ! latitude (radians)
    real(r8), pointer :: dz(:,:)            ! layer thickness (m)
    real(r8), pointer :: z(:,:)             ! layer depth (m)
!
! local pointers to implicit out arguments
!
    real(r8), pointer :: qflx_prec_grnd(:)  ! water onto ground including canopy runoff [kg/(m2 s)]
    real(r8), pointer :: qflx_evap_soi(:)   ! soil evaporation (mm H2O/s) (+ = to atm)
    real(r8), pointer :: qflx_evap_tot(:)   ! qflx_evap_soi + qflx_evap_veg + qflx_tran_veg
    real(r8), pointer :: qflx_snwcp_liq(:)  ! excess rainfall due to snow capping (mm H2O /s) [+]`
    real(r8), pointer :: qflx_snwcp_ice(:)  ! excess snowfall due to snow capping (mm H2O /s) [+]`
    real(r8), pointer :: eflx_sh_grnd(:)    ! sensible heat flux from ground (W/m**2) [+ to atm]
    real(r8), pointer :: eflx_lwrad_out(:)  ! emitted infrared (longwave) radiation (W/m**2)
    real(r8), pointer :: eflx_lwrad_net(:)  ! net infrared (longwave) rad (W/m**2) [+ = to atm]
    real(r8), pointer :: eflx_soil_grnd(:)  ! soil heat flux (W/m**2) [+ = into soil]
    real(r8), pointer :: eflx_sh_tot(:)     ! total sensible heat flux (W/m**2) [+ to atm]
    real(r8), pointer :: eflx_lh_tot(:)     ! total latent heat flux (W/m8*2)  [+ to atm]
    real(r8), pointer :: eflx_lh_grnd(:)    ! ground evaporation heat flux (W/m**2) [+ to atm]
    real(r8), pointer :: t_veg(:)           ! vegetation temperature (Kelvin)
    real(r8), pointer :: t_ref2m(:)         ! 2 m height surface air temperature (Kelvin)
    real(r8), pointer :: q_ref2m(:)         ! 2 m height surface specific humidity (kg/kg)
    real(r8), pointer :: rh_ref2m(:)        ! 2 m height surface relative humidity (%)
    real(r8), pointer :: taux(:)            ! wind (shear) stress: e-w (kg/m/s**2)
    real(r8), pointer :: tauy(:)            ! wind (shear) stress: n-s (kg/m/s**2)
    real(r8), pointer :: qmelt(:)           ! snow melt [mm/s]
    real(r8), pointer :: ram1(:)            ! aerodynamical resistance (s/m)
    real(r8), pointer :: errsoi(:)          ! soil/lake energy conservation error (W/m**2)
    real(r8), pointer :: t_lake(:,:)        ! lake temperature (Kelvin)
!
!
! !OTHER LOCAL VARIABLES:
!EOP
!
    integer , parameter  :: idlak = 1     ! index of lake, 1 = deep lake, 2 = shallow lake
    integer , parameter  :: niters = 3    ! maximum number of iterations for surface temperature
    real(r8), parameter :: beta1 = 1._r8  ! coefficient of connective velocity (in computing W_*) [-]
    real(r8), parameter :: emg = 0.97_r8     ! ground emissivity (0.97 for snow)
    real(r8), parameter :: zii = 1000._r8 ! convective boundary height [m]
    real(r8), parameter :: p0 = 1._r8     ! neutral value of turbulent prandtl number
    integer  :: i,j,fc,fp,g,c,p         ! do loop or array index
    integer  :: fncopy                  ! number of values in pft filter copy
    integer  :: fnold                   ! previous number of pft filter values
    integer  :: fpcopy(num_lakep)       ! pft filter copy for iteration loop
    integer  :: num_unfrzc              ! number of values in unfrozen column filter
    integer  :: filter_unfrzc(ubc-lbc+1)! unfrozen column filter
    integer  :: iter                    ! iteration index
    integer  :: nmozsgn(lbp:ubp)        ! number of times moz changes sign
    integer  :: jtop(lbc:ubc)           ! number of levels for each column (all 1)
    real(r8) :: ax                      !
    real(r8) :: bx                      !
    real(r8) :: degdT                   ! d(eg)/dT
    real(r8) :: dqh(lbp:ubp)            ! diff of humidity between ref. height and surface
    real(r8) :: dth(lbp:ubp)            ! diff of virtual temp. between ref. height and surface
    real(r8) :: dthv                    ! diff of vir. poten. temp. between ref. height and surface
    real(r8) :: dzsur(lbc:ubc)          !
    real(r8) :: eg                      ! water vapor pressure at temperature T [pa]
    real(r8) :: hm                      ! energy residual [W/m2]
    real(r8) :: htvp(lbc:ubc)           ! latent heat of vapor of water (or sublimation) [j/kg]
    real(r8) :: obu(lbp:ubp)            ! monin-obukhov length (m)
    real(r8) :: obuold(lbp:ubp)         ! monin-obukhov length of previous iteration
    real(r8) :: qsatg(lbc:ubc)          ! saturated humidity [kg/kg]
    real(r8) :: qsatgdT(lbc:ubc)        ! d(qsatg)/dT
    real(r8) :: qstar                   ! moisture scaling parameter
    real(r8) :: ram(lbp:ubp)            ! aerodynamical resistance [s/m]
    real(r8) :: rah(lbp:ubp)            ! thermal resistance [s/m]
    real(r8) :: raw(lbp:ubp)            ! moisture resistance [s/m]
    real(r8) :: stftg3(lbp:ubp)         ! derivative of fluxes w.r.t ground temperature
    real(r8) :: temp1(lbp:ubp)          ! relation for potential temperature profile
    real(r8) :: temp12m(lbp:ubp)        ! relation for potential temperature profile applied at 2-m
    real(r8) :: temp2(lbp:ubp)          ! relation for specific humidity profile
    real(r8) :: temp22m(lbp:ubp)        ! relation for specific humidity profile applied at 2-m
    real(r8) :: tgbef(lbc:ubc)          ! initial ground temperature
    real(r8) :: thm(lbp:ubp)            ! intermediate variable (forc_t+0.0098*forc_hgt_t_pft)
    real(r8) :: thv(lbc:ubc)            ! virtual potential temperature (kelvin)
    real(r8) :: thvstar                 ! virtual potential temperature scaling parameter
    real(r8) :: tksur                   ! thermal conductivity of snow/soil (w/m/kelvin)
    real(r8) :: tstar                   ! temperature scaling parameter
    real(r8) :: um(lbp:ubp)             ! wind speed including the stablity effect [m/s]
    real(r8) :: ur(lbp:ubp)             ! wind speed at reference height [m/s]
    real(r8) :: ustar(lbp:ubp)          ! friction velocity [m/s]
    real(r8) :: wc                      ! convective velocity [m/s]
    real(r8) :: zeta                    ! dimensionless height used in Monin-Obukhov theory
    real(r8) :: zldis(lbp:ubp)          ! reference height "minus" zero displacement height [m]
    real(r8) :: displa(lbp:ubp)         ! displacement (always zero) [m]
    real(r8) :: z0mg(lbp:ubp)           ! roughness length over ground, momentum [m]
    real(r8) :: z0hg(lbp:ubp)           ! roughness length over ground, sensible heat [m]
    real(r8) :: z0qg(lbp:ubp)           ! roughness length over ground, latent heat [m]
    real(r8) :: beta(2)                 ! fraction solar rad absorbed at surface: depends on lake type
    real(r8) :: za(2)                   ! base of surface absorption layer (m): depends on lake type
    real(r8) :: eta(2)                  ! light extinction coefficient (/m): depends on lake type
    real(r8) :: a(lbc:ubc,nlevlak)      ! "a" vector for tridiagonal matrix
    real(r8) :: b(lbc:ubc,nlevlak)      ! "b" vector for tridiagonal matrix
    real(r8) :: c1(lbc:ubc,nlevlak)     ! "c" vector for tridiagonal matrix
    real(r8) :: r(lbc:ubc,nlevlak)      ! "r" vector for tridiagonal solution
    real(r8) :: rhow(lbc:ubc,nlevlak)   ! density of water (kg/m**3)
    real(r8) :: phi(lbc:ubc,nlevlak)    ! solar radiation absorbed by layer (w/m**2)
    real(r8) :: kme(lbc:ubc,nlevlak)    ! molecular + eddy diffusion coefficient (m**2/s)
    real(r8) :: cwat                    ! specific heat capacity of water (j/m**3/kelvin)
    real(r8) :: ws(lbc:ubc)             ! surface friction velocity (m/s)
    real(r8) :: ks(lbc:ubc)             ! coefficient
    real(r8) :: in                      ! relative flux of solar radiation into layer
    real(r8) :: out                     ! relative flux of solar radiation out of layer
    real(r8) :: ri                      ! richardson number
    real(r8) :: fin(lbc:ubc)            ! heat flux into lake - flux out of lake (w/m**2)
    real(r8) :: ocvts(lbc:ubc)          ! (cwat*(t_lake[n  ])*dz
    real(r8) :: ncvts(lbc:ubc)          ! (cwat*(t_lake[n+1])*dz
    real(r8) :: m1                      ! intermediate variable for calculating r, a, b, c
    real(r8) :: m2                      ! intermediate variable for calculating r, a, b, c
    real(r8) :: m3                      ! intermediate variable for calculating r, a, b, c
    real(r8) :: ke                      ! eddy diffusion coefficient (m**2/s)
    real(r8) :: km                      ! molecular diffusion coefficient (m**2/s)
    real(r8) :: zin                     ! depth at top of layer (m)
    real(r8) :: zout                    ! depth at bottom of layer (m)
    real(r8) :: drhodz                  ! d [rhow] /dz (kg/m**4)
    real(r8) :: n2                      ! brunt-vaisala frequency (/s**2)
    real(r8) :: num                     ! used in calculating ri
    real(r8) :: den                     ! used in calculating ri
    real(r8) :: tav(lbc:ubc)            ! used in aver temp for convectively mixed layers
    real(r8) :: nav(lbc:ubc)            ! used in aver temp for convectively mixed layers
    real(r8) :: phidum                  ! temporary value of phi
    real(r8) :: u2m                     ! 2 m wind speed (m/s)
    real(r8) :: fm(lbp:ubp)             ! needed for BGC only to diagnose 10m wind speed
    real(r8) :: e_ref2m                 ! 2 m height surface saturated vapor pressure [Pa]
    real(r8) :: de2mdT                  ! derivative of 2 m height surface saturated vapor pressure on t_ref2m
    real(r8) :: qsat_ref2m              ! 2 m height surface saturated specific humidity [kg/kg]
    real(r8) :: dqsat2mdT               ! derivative of 2 m height surface saturated specific humidity on t_ref2m
!
! Constants for lake temperature model
!
    data beta/0.4_r8, 0.4_r8/  ! (deep lake, shallow lake)
    data za  /0.6_r8, 0.5_r8/
    data eta /0.1_r8, 0.5_r8/
!-----------------------------------------------------------------------

    ! Assign local pointers to derived type members (gridcell-level)

    forc_t         => clm_a2l%forc_t
    forc_pbot      => clm_a2l%forc_pbot
    forc_th        => clm_a2l%forc_th
    forc_q         => clm_a2l%forc_q
    forc_u         => clm_a2l%forc_u
    forc_v         => clm_a2l%forc_v
    forc_rho       => clm_a2l%forc_rho
    forc_lwrad     => clm_a2l%forc_lwrad
    forc_snow      => clm_a2l%forc_snow
    forc_rain      => clm_a2l%forc_rain
    lat            => clm3%g%lat

    ! Assign local pointers to derived type members (column-level)

    cgridcell      => clm3%g%l%c%gridcell
    dz             => clm3%g%l%c%cps%dz
    z              => clm3%g%l%c%cps%z
    t_lake         => clm3%g%l%c%ces%t_lake
    h2osno         => clm3%g%l%c%cws%h2osno
    snowdp         => clm3%g%l%c%cps%snowdp
    t_grnd         => clm3%g%l%c%ces%t_grnd
    hc_soisno      => clm3%g%l%c%ces%hc_soisno
    errsoi         => clm3%g%l%c%cebal%errsoi
    qmelt          => clm3%g%l%c%cwf%qmelt

    ! Assign local pointers to derived type members (pft-level)

    pcolumn        => clm3%g%l%c%p%column
    pgridcell      => clm3%g%l%c%p%gridcell
    sabg           => clm3%g%l%c%p%pef%sabg
    t_ref2m        => clm3%g%l%c%p%pes%t_ref2m
    q_ref2m        => clm3%g%l%c%p%pes%q_ref2m
    rh_ref2m       => clm3%g%l%c%p%pes%rh_ref2m
    t_veg          => clm3%g%l%c%p%pes%t_veg
    eflx_lwrad_out => clm3%g%l%c%p%pef%eflx_lwrad_out
    eflx_lwrad_net => clm3%g%l%c%p%pef%eflx_lwrad_net
    eflx_soil_grnd => clm3%g%l%c%p%pef%eflx_soil_grnd
    eflx_lh_tot    => clm3%g%l%c%p%pef%eflx_lh_tot
    eflx_lh_grnd   => clm3%g%l%c%p%pef%eflx_lh_grnd
    eflx_sh_grnd   => clm3%g%l%c%p%pef%eflx_sh_grnd
    eflx_sh_tot    => clm3%g%l%c%p%pef%eflx_sh_tot
    ram1           => clm3%g%l%c%p%pps%ram1
    taux           => clm3%g%l%c%p%pmf%taux
    tauy           => clm3%g%l%c%p%pmf%tauy
    qflx_prec_grnd => clm3%g%l%c%p%pwf%qflx_prec_grnd
    qflx_evap_soi  => clm3%g%l%c%p%pwf%qflx_evap_soi
    qflx_evap_tot  => clm3%g%l%c%p%pwf%qflx_evap_tot
    forc_hgt_u_pft => clm3%g%l%c%p%pps%forc_hgt_u_pft
    forc_hgt_t_pft => clm3%g%l%c%p%pps%forc_hgt_t_pft
    forc_hgt_q_pft => clm3%g%l%c%p%pps%forc_hgt_q_pft
    qflx_snwcp_ice => clm3%g%l%c%p%pwf%qflx_snwcp_ice    
    qflx_snwcp_liq => clm3%g%l%c%p%pwf%qflx_snwcp_liq    



    ! Begin calculations

    do fc = 1, num_lakec
       c = filter_lakec(fc)
       g = cgridcell(c)

       ! Initialize quantities computed below

       ocvts(c) = 0._r8
       ncvts(c) = 0._r8
       hc_soisno(c) = 0._r8

       ! Surface temperature and fluxes

       dzsur(c) = dz(c,1) + snowdp(c)

       ! Saturated vapor pressure, specific humidity and their derivatives
       ! at lake surface

       call QSat(t_grnd(c), forc_pbot(g), eg, degdT, qsatg(c), qsatgdT(c))

       ! Potential, virtual potential temperature, and wind speed at the
       ! reference height

       !zii = 1000.    ! m  (pbl height)
       thv(c) = forc_th(g)*(1._r8+0.61_r8*forc_q(g))     ! virtual potential T
    end do

    do fp = 1, num_lakep
       p = filter_lakep(fp)
       c = pcolumn(p)
       g = pgridcell(p)

       nmozsgn(p) = 0
       obuold(p) = 0._r8
       displa(p) = 0._r8
       thm(p) = forc_t(g) + 0.0098_r8*forc_hgt_t_pft(p)   ! intermediate variable

       ! Roughness lengths

       if (t_grnd(c) >= tfrz) then   ! for unfrozen lake
          z0mg(p) = 0.01_r8
       else                          ! for frozen lake
          z0mg(p) = 0.04_r8
       end if
       z0hg(p) = z0mg(p)
       z0qg(p) = z0mg(p)

       ! Latent heat

#if (defined PERGRO)
       htvp(c) = hvap
#else
       if (forc_t(g) > tfrz) then
          htvp(c) = hvap
       else
          htvp(c) = hsub
       end if
#endif

       ! Initialize stability variables

       ur(p)    = max(1.0_r8,sqrt(forc_u(g)*forc_u(g)+forc_v(g)*forc_v(g)))
       dth(p)   = thm(p)-t_grnd(c)
       dqh(p)   = forc_q(g)-qsatg(c)
       dthv     = dth(p)*(1._r8+0.61_r8*forc_q(g))+0.61_r8*forc_th(g)*dqh(p)
       zldis(p) = forc_hgt_u_pft(p) - 0._r8

       ! Initialize Monin-Obukhov length and wind speed

       call MoninObukIni(ur(p), thv(c), dthv, zldis(p), z0mg(p), um(p), obu(p))

    end do

    iter = 1
    fncopy = num_lakep
    fpcopy(1:num_lakep) = filter_lakep(1:num_lakep)

    ! Begin stability iteration

    ITERATION : do while (iter <= niters .and. fncopy > 0)

       ! Determine friction velocity, and potential temperature and humidity
       ! profiles of the surface boundary layer

       call FrictionVelocity(lbp, ubp, fncopy, fpcopy, &
                             displa, z0mg, z0hg, z0qg, &
                             obu, iter, ur, um, ustar, &
                             temp1, temp2, temp12m, temp22m, fm)

       do fp = 1, fncopy
          p = fpcopy(fp)
          c = pcolumn(p)
          g = pgridcell(p)

          tgbef(c) = t_grnd(c)
          if (t_grnd(c) > tfrz) then
             tksur = tkwat
          else
             tksur = tkice
          end if

          ! Determine aerodynamic resistances

          ram(p)  = 1._r8/(ustar(p)*ustar(p)/um(p))
          rah(p)  = 1._r8/(temp1(p)*ustar(p))
          raw(p)  = 1._r8/(temp2(p)*ustar(p))
          ram1(p) = ram(p)   !pass value to global variable

          ! Get derivative of fluxes with respect to ground temperature

          stftg3(p) = emg*sb*tgbef(c)*tgbef(c)*tgbef(c)

          ax  = sabg(p) + emg*forc_lwrad(g) + 3._r8*stftg3(p)*tgbef(c) &
               + forc_rho(g)*cpair/rah(p)*thm(p) &
               - htvp(c)*forc_rho(g)/raw(p)*(qsatg(c)-qsatgdT(c)*tgbef(c) - forc_q(g)) &
               + tksur*t_lake(c,1)/dzsur(c)

          bx  = 4._r8*stftg3(p) + forc_rho(g)*cpair/rah(p) &
               + htvp(c)*forc_rho(g)/raw(p)*qsatgdT(c) + tksur/dzsur(c)

          t_grnd(c) = ax/bx

          ! Surface fluxes of momentum, sensible and latent heat
          ! using ground temperatures from previous time step

          eflx_sh_grnd(p) = forc_rho(g)*cpair*(t_grnd(c)-thm(p))/rah(p)
          qflx_evap_soi(p) = forc_rho(g)*(qsatg(c)+qsatgdT(c)*(t_grnd(c)-tgbef(c))-forc_q(g))/raw(p)

          ! Re-calculate saturated vapor pressure, specific humidity and their
          ! derivatives at lake surface

          call QSat(t_grnd(c), forc_pbot(g), eg, degdT, qsatg(c), qsatgdT(c))

          dth(p)=thm(p)-t_grnd(c)
          dqh(p)=forc_q(g)-qsatg(c)

          tstar = temp1(p)*dth(p)
          qstar = temp2(p)*dqh(p)

          !not used
          !dthv=dth(p)*(1.+0.61*forc_q(g))+0.61*forc_th(g)*dqh(p)
          thvstar=tstar*(1._r8+0.61_r8*forc_q(g)) + 0.61_r8*forc_th(g)*qstar
          zeta=zldis(p)*vkc * grav*thvstar/(ustar(p)**2*thv(c))

          if (zeta >= 0._r8) then     !stable
             zeta = min(2._r8,max(zeta,0.01_r8))
             um(p) = max(ur(p),0.1_r8)
          else                     !unstable
             zeta = max(-100._r8,min(zeta,-0.01_r8))
             wc = beta1*(-grav*ustar(p)*thvstar*zii/thv(c))**0.333_r8
             um(p) = sqrt(ur(p)*ur(p)+wc*wc)
          end if
          obu(p) = zldis(p)/zeta

          if (obuold(p)*obu(p) < 0._r8) nmozsgn(p) = nmozsgn(p)+1

          obuold(p) = obu(p)

       end do   ! end of filtered pft loop

       iter = iter + 1
       if (iter <= niters ) then
          ! Rebuild copy of pft filter for next pass through the ITERATION loop

          fnold = fncopy
          fncopy = 0
          do fp = 1, fnold
             p = fpcopy(fp)
             if (nmozsgn(p) < 3) then
                fncopy = fncopy + 1
                fpcopy(fncopy) = p
             end if
          end do   ! end of filtered pft loop
       end if

    end do ITERATION   ! end of stability iteration

    do fp = 1, num_lakep
       p = filter_lakep(fp)
       c = pcolumn(p)
       g = pgridcell(p)

       ! initialize snow cap terms to zero for lake columns
       qflx_snwcp_ice(p) = 0._r8
       qflx_snwcp_liq(p) = 0._r8

       ! If there is snow on the ground and t_grnd > tfrz: reset t_grnd = tfrz.
       ! Re-evaluate ground fluxes. Energy imbalance used to melt snow.
       ! h2osno > 0.5 prevents spurious fluxes.
       ! note that qsatg and qsatgdT should be f(tgbef) (PET: not sure what this
       ! comment means)

       if (h2osno(c) > 0.5_r8 .AND. t_grnd(c) > tfrz) then
          t_grnd(c) = tfrz
          eflx_sh_grnd(p) = forc_rho(g)*cpair*(t_grnd(c)-thm(p))/rah(p)
          qflx_evap_soi(p) = forc_rho(g)*(qsatg(c)+qsatgdT(c)*(t_grnd(c)-tgbef(c)) - forc_q(g))/raw(p)
       end if

       ! Net longwave from ground to atmosphere

       eflx_lwrad_out(p) = (1._r8-emg)*forc_lwrad(g) + stftg3(p)*(-3._r8*tgbef(c)+4._r8*t_grnd(c))

       ! Ground heat flux

       eflx_soil_grnd(p) = sabg(p) + forc_lwrad(g) - eflx_lwrad_out(p) - &
            eflx_sh_grnd(p) - htvp(c)*qflx_evap_soi(p)

       taux(p) = -forc_rho(g)*forc_u(g)/ram(p)
       tauy(p) = -forc_rho(g)*forc_v(g)/ram(p)

       eflx_sh_tot(p)   = eflx_sh_grnd(p)
       qflx_evap_tot(p) = qflx_evap_soi(p)
       eflx_lh_tot(p)   = htvp(c)*qflx_evap_soi(p)
       eflx_lh_grnd(p)  = htvp(c)*qflx_evap_soi(p)

       ! 2 m height air temperature
       t_ref2m(p) = thm(p) + temp1(p)*dth(p)*(1._r8/temp12m(p) - 1._r8/temp1(p))

       ! 2 m height specific humidity
       q_ref2m(p) = forc_q(g) + temp2(p)*dqh(p)*(1._r8/temp22m(p) - 1._r8/temp2(p))

       ! 2 m height relative humidity

       call QSat(t_ref2m(p), forc_pbot(g), e_ref2m, de2mdT, qsat_ref2m, dqsat2mdT)
       rh_ref2m(p) = min(100._r8, q_ref2m(p) / qsat_ref2m * 100._r8)

       ! Energy residual used for melting snow
       if (h2osno(c) > 0._r8 .AND. t_grnd(c) >= tfrz) then
          hm = min(h2osno(c)*hfus/dtime, max(eflx_soil_grnd(p),0._r8))
       else
          hm = 0._r8
       end if
       qmelt(c) = hm/hfus             ! snow melt (mm/s)

       ! Prepare for lake layer temperature calculations below

       fin(c) = beta(idlak) * sabg(p) + forc_lwrad(g) - (eflx_lwrad_out(p) + &
            eflx_sh_tot(p) + eflx_lh_tot(p) + hm)
       u2m = max(1.0_r8,ustar(p)/vkc*log(2._r8/z0mg(p)))

       ws(c) = 1.2e-03_r8 * u2m
       ks(c) = 6.6_r8*sqrt(abs(sin(lat(g))))*(u2m**(-1.84_r8))

    end do

    ! Eddy diffusion +  molecular diffusion coefficient (constants):
    ! eddy diffusion coefficient used for unfrozen deep lakes only

    cwat = cpliq*denh2o ! a constant
    km = tkwat/cwat     ! a constant

    ! Lake density

    do j = 1, nlevlak
       do fc = 1, num_lakec
          c = filter_lakec(fc)
          rhow(c,j) = 1000._r8*( 1.0_r8 - 1.9549e-05_r8*(abs(t_lake(c,j)-277._r8))**1.68_r8 )
       end do
    end do

    do j = 1, nlevlak-1
       do fc = 1, num_lakec
          c = filter_lakec(fc)
          drhodz = (rhow(c,j+1)-rhow(c,j)) / (z(c,j+1)-z(c,j))
          n2 = -grav / rhow(c,j) * drhodz
          num = 40._r8 * n2 * (vkc*z(c,j))**2
          den = max( (ws(c)**2) * exp(-2._r8*ks(c)*z(c,j)), 1.e-10_r8 )
          ri = ( -1._r8 + sqrt( max(1._r8+num/den, 0._r8) ) ) / 20._r8
          if (t_grnd(c) > tfrz) then
             ! valid for deep lake only (idlak == 1)
             ke = vkc*ws(c)*z(c,j)/p0 * exp(-ks(c)*z(c,j)) / (1._r8+37._r8*ri*ri)
          else
             ke = 0._r8
          end if
          kme(c,j) = km + ke
       end do
    end do

    do fc = 1, num_lakec
       c = filter_lakec(fc)
       kme(c,nlevlak) = kme(c,nlevlak-1)
       ! set number of column levels for use by Tridiagonal below
       jtop(c) = 1
    end do

    ! Heat source term: unfrozen lakes only

    do j = 1, nlevlak
       do fp = 1, num_lakep
          p = filter_lakep(fp)
          c = pcolumn(p)

          zin  = z(c,j) - 0.5_r8*dz(c,j)
          zout = z(c,j) + 0.5_r8*dz(c,j)
          in  = exp( -eta(idlak)*max(  zin-za(idlak),0._r8 ) )
          out = exp( -eta(idlak)*max( zout-za(idlak),0._r8 ) )

          ! Assume solar absorption is only in the considered depth
          if (j == nlevlak) out = 0._r8
          if (t_grnd(c) > tfrz) then
             phidum = (in-out) * sabg(p) * (1._r8-beta(idlak))
          else if (j == 1) then
             phidum = sabg(p) * (1._r8-beta(idlak))
          else
             phidum = 0._r8
          end if
          phi(c,j) = phidum
       end do
    end do

    ! Sum cwat*t_lake*dz for energy check

    do j = 1, nlevlak
       do fc = 1, num_lakec
          c = filter_lakec(fc)

          ocvts(c) = ocvts(c) + cwat*t_lake(c,j)*dz(c,j)
       end do
    end do

    ! Set up vector r and vectors a, b, c that define tridiagonal matrix

    do fc = 1, num_lakec
       c = filter_lakec(fc)

       j = 1
       m2 = dz(c,j)/kme(c,j) + dz(c,j+1)/kme(c,j+1)
       m3 = dtime/dz(c,j)
       r(c,j) = t_lake(c,j) + (fin(c)+phi(c,j))*m3/cwat - (t_lake(c,j)-t_lake(c,j+1))*m3/m2
       a(c,j) = 0._r8
       b(c,j) = 1._r8 + m3/m2
       c1(c,j) = -m3/m2

       j = nlevlak
       m1 = dz(c,j-1)/kme(c,j-1) + dz(c,j)/kme(c,j)
       m3 = dtime/dz(c,j)
       r(c,j) = t_lake(c,j) + phi(c,j)*m3/cwat + (t_lake(c,j-1)-t_lake(c,j))*m3/m1
       a(c,j) = -m3/m1
       b(c,j) = 1._r8 + m3/m1
       c1(c,j) = 0._r8
    end do

    do j = 2, nlevlak-1
       do fc = 1, num_lakec
          c = filter_lakec(fc)

          m1 = dz(c,j-1)/kme(c,j-1) + dz(c,j  )/kme(c,j  )
          m2 = dz(c,j  )/kme(c,j  ) + dz(c,j+1)/kme(c,j+1)
          m3 = dtime/dz(c,j)
          r(c,j) = t_lake(c,j) + phi(c,j)*m3/cwat + &
             (t_lake(c,j-1) - t_lake(c,j  ))*m3/m1 - &
             (t_lake(c,j  ) - t_lake(c,j+1))*m3/m2

          a(c,j) = -m3/m1
          b(c,j) = 1._r8 + m3/m1 + m3/m2
          c1(c,j) = -m3/m2
       end do
    end do

    ! Solve for t_lake: a, b, c, r, u

    call Tridiagonal(lbc, ubc, 1, nlevlak, jtop, num_lakec, filter_lakec, &
                     a, b, c1, r, t_lake(lbc:ubc,1:nlevlak))

    ! Convective mixing: make sure cwat*dz*ts is conserved.  Valid only for
    ! deep lakes (idlak == 1).

    num_unfrzc = 0
    do fc = 1, num_lakec
       c = filter_lakec(fc)
       if (t_grnd(c) > tfrz) then
          num_unfrzc = num_unfrzc + 1
          filter_unfrzc(num_unfrzc) = c
       end if
    end do

    do j = 1, nlevlak-1
       do fc = 1, num_unfrzc
          c = filter_unfrzc(fc)
          tav(c) = 0._r8
          nav(c) = 0._r8
       end do

       do i = 1, j+1
          do fc = 1, num_unfrzc
             c = filter_unfrzc(fc)
             if (rhow(c,j) > rhow(c,j+1)) then
                tav(c) = tav(c) + t_lake(c,i)*dz(c,i)
                nav(c) = nav(c) + dz(c,i)
             end if
          end do
       end do

       do fc = 1, num_unfrzc
          c = filter_unfrzc(fc)
          if (rhow(c,j) > rhow(c,j+1)) then
             tav(c) = tav(c)/nav(c)
          end if
       end do

       do i = 1, j+1
          do fc = 1, num_unfrzc
             c = filter_unfrzc(fc)
             if (nav(c) > 0._r8) then
                t_lake(c,i) = tav(c)
                rhow(c,i) = 1000._r8*( 1.0_r8 - 1.9549e-05_r8*(abs(t_lake(c,i)-277._r8))**1.68_r8 )
             end if
          end do
       end do
    end do

    ! Sum cwat*t_lake*dz and total energy into lake for energy check

    do j = 1, nlevlak
       do fc = 1, num_lakec
          c = filter_lakec(fc)
          ncvts(c) = ncvts(c) + cwat*t_lake(c,j)*dz(c,j)
          hc_soisno(c) = hc_soisno(c) + cwat*t_lake(c,j)*dz(c,j) /1.e6_r8
          if (j == nlevlak) then 
             hc_soisno(c) = hc_soisno(c) +  &
                            cpice*h2osno(c)*t_grnd(c)*snowdp(c) /1.e6_r8
          endif
          fin(c) = fin(c) + phi(c,j)
       end do
    end do

    ! The following are needed for global average on history tape.

    do fp = 1, num_lakep
       p = filter_lakep(fp)
       c = pcolumn(p)
       g = pgridcell(p)
       errsoi(c) = (ncvts(c)-ocvts(c)) / dtime - fin(c)
       t_veg(p) = forc_t(g)
       eflx_lwrad_net(p)  = eflx_lwrad_out(p) - forc_lwrad(g)
       qflx_prec_grnd(p) = forc_rain(g) + forc_snow(g)
    end do

  end subroutine BiogeophysicsLake

end module BiogeophysicsLakeMod
!========================================================================================
module CNAllocationMod
#ifdef CN

!-----------------------------------------------------------------------
!BOP
!
! !MODULE: CNAllocationMod
!
! !DESCRIPTION:
! Module holding routines used in allocation model for coupled carbon
! nitrogen code.
!
! !USES:
  use shr_kind_mod, only: r8 => shr_kind_r8
  implicit none
  save
  private
! !PUBLIC MEMBER FUNCTIONS:
  public :: CNAllocation
!
! !REVISION HISTORY:
! 8/5/03: Created by Peter Thornton
!
!EOP
!-----------------------------------------------------------------------

contains

!-----------------------------------------------------------------------
!BOP
!
! !IROUTINE: CNAllocation
!
! !INTERFACE:
subroutine CNAllocation (lbp, ubp, lbc, ubc, &
       num_soilc, filter_soilc, num_soilp, filter_soilp)
!
! !DESCRIPTION:
!
! !USES:
   use clmtype
!   use clm_varctl, only: iulog
!   use shr_sys_mod, only: shr_sys_flush
!   use clm_time_manager, only: get_step_size
   use globals, only : dt
   use pft2colMod, only: p2c
#if (defined CROP)
   use pftvarcon , only: npcropmin, declfact, bfact, aleaff, arootf, astemf, arooti, fleafi, allconsl, allconss
#endif
!
! !ARGUMENTS:
   implicit none
   integer, intent(in) :: lbp, ubp        ! pft-index bounds
   integer, intent(in) :: lbc, ubc        ! column-index bounds
   integer, intent(in) :: num_soilc       ! number of soil columns in filter
   integer, intent(in) :: filter_soilc(:) ! filter for soil columns
   integer, intent(in) :: num_soilp       ! number of soil pfts in filter
   integer, intent(in) :: filter_soilp(:) ! filter for soil pfts
!
! !CALLED FROM:
! subroutine CNdecompAlloc in module CNdecompMod.F90
!
! !REVISION HISTORY:
! 8/5/03: Created by Peter Thornton
! 10/23/03, Peter Thornton: migrated to vector data structures
!
! !LOCAL VARIABLES:
! local pointers to implicit in arrays
!
   ! pft level
   integer , pointer :: ivt(:)        ! pft vegetation type
   integer , pointer :: pcolumn(:)    ! pft's column index
   real(r8), pointer :: lgsf(:)       ! long growing season factor [0-1]
   real(r8), pointer :: xsmrpool(:)      ! (kgC/m2) temporary photosynthate C pool
   real(r8), pointer :: retransn(:)   ! (kgN/m2) plant pool of retranslocated N
   real(r8), pointer :: psnsun(:)     ! sunlit leaf-level photosynthesis (umol CO2 /m**2/ s)
   real(r8), pointer :: psnsha(:)     ! shaded leaf-level photosynthesis (umol CO2 /m**2/ s)
#if (defined C13)
   real(r8), pointer :: c13_psnsun(:) ! C13 sunlit leaf-level photosynthesis (umol CO2 /m**2/ s)
   real(r8), pointer :: c13_psnsha(:) ! C13 shaded leaf-level photosynthesis (umol CO2 /m**2/ s)
#endif
   real(r8), pointer :: laisun(:)     ! sunlit projected leaf area index
   real(r8), pointer :: laisha(:)     ! shaded projected leaf area index
   real(r8), pointer :: leaf_mr(:)
   real(r8), pointer :: froot_mr(:)
   real(r8), pointer :: livestem_mr(:)
   real(r8), pointer :: livecroot_mr(:)
   real(r8), pointer :: leaf_curmr(:)
   real(r8), pointer :: froot_curmr(:)
   real(r8), pointer :: livestem_curmr(:)
   real(r8), pointer :: livecroot_curmr(:)
   real(r8), pointer :: leaf_xsmr(:)
   real(r8), pointer :: froot_xsmr(:)
   real(r8), pointer :: livestem_xsmr(:)
   real(r8), pointer :: livecroot_xsmr(:)
   ! column level
   real(r8), pointer :: sminn(:)      ! (kgN/m2) soil mineral N
   ! ecophysiological constants
   real(r8), pointer :: woody(:)      ! binary flag for woody lifeform (1=woody, 0=not woody)
   real(r8), pointer :: froot_leaf(:) ! allocation parameter: new fine root C per new leaf C (gC/gC)
   real(r8), pointer :: croot_stem(:) ! allocation parameter: new coarse root C per new stem C (gC/gC)
   real(r8), pointer :: stem_leaf(:)  ! allocation parameter: new stem c per new leaf C (gC/gC)
   real(r8), pointer :: flivewd(:)    ! allocation parameter: fraction of new wood that is live (phloem and ray parenchyma) (no units)
   real(r8), pointer :: leafcn(:)     ! leaf C:N (gC/gN)
   real(r8), pointer :: frootcn(:)    ! fine root C:N (gC/gN)
   real(r8), pointer :: livewdcn(:)   ! live wood (phloem and ray parenchyma) C:N (gC/gN)
   real(r8), pointer :: deadwdcn(:)   ! dead wood (xylem and heartwood) C:N (gC/gN)
   real(r8), pointer :: fcur2(:)      ! allocation parameter: fraction of allocation that goes to currently displayed growth, remainder to storage
   integer, pointer :: plandunit(:)   ! index into landunit level quantities
   integer, pointer :: clandunit(:)   ! index into landunit level quantities
   integer , pointer :: itypelun(:)   ! landunit type
#if (defined CROP)
   integer , pointer :: croplive(:)   ! planted, not harvested = 1; else 0
   integer , pointer :: peaklai(:)    ! 1: max allowed lai; 0: not at max
   real(r8), pointer :: gddmaturity(:)! gdd needed to harvest
   real(r8), pointer :: huileaf(:)    ! heat unit index needed from planting to leaf emergence
   real(r8), pointer :: huigrain(:)   ! same to reach vegetative maturity
   real(r8), pointer :: hui(:)        ! =gdd since planting (gddplant)
   real(r8), pointer :: leafout(:)    ! =gdd from top soil layer temperature
   real(r8), pointer :: aleafi(:)     ! saved allocation coefficient from phase 2
   real(r8), pointer :: astemi(:)     ! saved allocation coefficient from phase 2
   real(r8), pointer :: aleaf(:)      ! leaf allocation coefficient
   real(r8), pointer :: astem(:)      ! stem allocation coefficient
   real(r8), pointer :: graincn(:)    ! grain C:N (gC/gN)
#endif
!
! local pointers to implicit in/out arrays
!
   ! pft level
   real(r8), pointer :: gpp(:)                   ! GPP flux before downregulation (gC/m2/s)
   real(r8), pointer :: availc(:)                ! C flux available for allocation (gC/m2/s)
   real(r8), pointer :: xsmrpool_recover(:)         ! C flux assigned to recovery of negative cpool (gC/m2/s)
   real(r8), pointer :: c_allometry(:)           ! C allocation index (DIM)
   real(r8), pointer :: n_allometry(:)           ! N allocation index (DIM)
   real(r8), pointer :: plant_ndemand(:)         ! N flux required to support initial GPP (gN/m2/s)
   real(r8), pointer :: tempsum_potential_gpp(:) ! temporary annual sum of potential GPP 
   real(r8), pointer :: tempmax_retransn(:)      ! temporary annual max of retranslocated N pool (gN/m2)
   real(r8), pointer :: annsum_potential_gpp(:)  ! annual sum of potential GPP
   real(r8), pointer :: avail_retransn(:)        ! N flux available from retranslocation pool (gN/m2/s)
   real(r8), pointer :: annmax_retransn(:)       ! annual max of retranslocated N pool
   real(r8), pointer :: plant_nalloc(:)          ! total allocated N flux (gN/m2/s)
   real(r8), pointer :: plant_calloc(:)          ! total allocated C flux (gC/m2/s)
   real(r8), pointer :: excess_cflux(:)          ! C flux not allocated due to downregulation (gC/m2/s)
   real(r8), pointer :: downreg(:)               ! fractional reduction in GPP due to N limitation (DIM)
   real(r8), pointer :: annsum_npp(:)            ! annual sum of NPP, for wood allocation
   real(r8), pointer :: cpool_to_xsmrpool(:)
   real(r8), pointer :: psnsun_to_cpool(:)
   real(r8), pointer :: psnshade_to_cpool(:)
#if (defined C13)
   real(r8), pointer :: c13_psnsun_to_cpool(:)
   real(r8), pointer :: c13_psnshade_to_cpool(:)
#endif
   real(r8), pointer :: cpool_to_leafc(:)
   real(r8), pointer :: cpool_to_leafc_storage(:)
   real(r8), pointer :: cpool_to_frootc(:)
   real(r8), pointer :: cpool_to_frootc_storage(:)
   real(r8), pointer :: cpool_to_livestemc(:)
   real(r8), pointer :: cpool_to_livestemc_storage(:)
   real(r8), pointer :: cpool_to_deadstemc(:)
   real(r8), pointer :: cpool_to_deadstemc_storage(:)
   real(r8), pointer :: cpool_to_livecrootc(:)
   real(r8), pointer :: cpool_to_livecrootc_storage(:)
   real(r8), pointer :: cpool_to_deadcrootc(:)
   real(r8), pointer :: cpool_to_deadcrootc_storage(:)
   real(r8), pointer :: cpool_to_gresp_storage(:)
   real(r8), pointer :: retransn_to_npool(:)
   real(r8), pointer :: sminn_to_npool(:)
#if (defined CROP)
   real(r8), pointer :: cpool_to_grainc(:)
   real(r8), pointer :: cpool_to_grainc_storage(:)
   real(r8), pointer :: npool_to_grainn(:)
   real(r8), pointer :: npool_to_grainn_storage(:)
#endif
   real(r8), pointer :: npool_to_leafn(:)
   real(r8), pointer :: npool_to_leafn_storage(:)
   real(r8), pointer :: npool_to_frootn(:)
   real(r8), pointer :: npool_to_frootn_storage(:)
   real(r8), pointer :: npool_to_livestemn(:)
   real(r8), pointer :: npool_to_livestemn_storage(:)
   real(r8), pointer :: npool_to_deadstemn(:)
   real(r8), pointer :: npool_to_deadstemn_storage(:)
   real(r8), pointer :: npool_to_livecrootn(:)
   real(r8), pointer :: npool_to_livecrootn_storage(:)
   real(r8), pointer :: npool_to_deadcrootn(:)
   real(r8), pointer :: npool_to_deadcrootn_storage(:)
   ! column level
   real(r8), pointer :: fpi(:) ! fraction of potential immobilization (no units)
   real(r8), pointer :: fpg(:) ! fraction of potential gpp (no units)
   real(r8), pointer :: potential_immob(:)
   real(r8), pointer :: actual_immob(:)
   real(r8), pointer :: sminn_to_plant(:)
   real(r8), pointer :: sminn_to_denit_excess(:)
   real(r8), pointer :: supplement_to_sminn(:)
!
! local pointers to implicit out arrays
!
!
! !OTHER LOCAL VARIABLES:
   integer :: c,p                  !indices
   integer :: fp                   !lake filter pft index
   integer :: fc                   !lake filter column index
!   real(r8):: dt                   !decomp timestep (seconds)
   integer :: nlimit               !flag for N limitation
   real(r8), pointer:: col_plant_ndemand(:)    !column-level plant N demand
   real(r8):: dayscrecover         !number of days to recover negative cpool
   real(r8):: mr                   !maintenance respiration (gC/m2/s)
   real(r8):: f1,f2,f3,f4,g1,g2    !allocation parameters
   real(r8):: cnl,cnfr,cnlw,cndw   !C:N ratios for leaf, fine root, and wood
   real(r8):: grperc, grpnow       !growth respirarion parameters
   real(r8):: fcur                 !fraction of current psn displayed as growth
   real(r8):: sum_ndemand          !total column N demand (gN/m2/s)
   real(r8):: gresp_storage        !temporary variable for growth resp to storage
   real(r8):: nlc                  !temporary variable for total new leaf carbon allocation
   real(r8):: bdnr                 !bulk denitrification rate (1/s)
   real(r8):: curmr, curmr_ratio   !xsmrpool temporary variables
#if (defined CROP)
   real(r8) f5                     !grain allocation parameter
   real(r8) cng                    !C:N ratio for grain (= cnlw for now; slevis)
   real(r8) fleaf                  !fraction allocated to leaf

   real(r8), pointer :: arepr(:)   !reproduction allocation coefficient
   real(r8), pointer :: aroot(:)   !root allocation coefficient
#endif

!EOP
!-----------------------------------------------------------------------
   ! Assign local pointers to derived type arrays (in)
   ivt                         => clm3%g%l%c%p%itype
   pcolumn                     => clm3%g%l%c%p%column
   plandunit                   => clm3%g%l%c%p%landunit
   clandunit                   => clm3%g%l%c%landunit
   itypelun                    => clm3%g%l%itype
   lgsf                        => clm3%g%l%c%p%pepv%lgsf
   xsmrpool                    => clm3%g%l%c%p%pcs%xsmrpool
   retransn                    => clm3%g%l%c%p%pns%retransn
   psnsun                      => clm3%g%l%c%p%pcf%psnsun
   psnsha                      => clm3%g%l%c%p%pcf%psnsha
#if (defined C13)
   c13_psnsun                  => clm3%g%l%c%p%pc13f%psnsun
   c13_psnsha                  => clm3%g%l%c%p%pc13f%psnsha
#endif
   laisun                      => clm3%g%l%c%p%pps%laisun
   laisha                      => clm3%g%l%c%p%pps%laisha
   leaf_mr                     => clm3%g%l%c%p%pcf%leaf_mr
   froot_mr                    => clm3%g%l%c%p%pcf%froot_mr
   livestem_mr                 => clm3%g%l%c%p%pcf%livestem_mr
   livecroot_mr                => clm3%g%l%c%p%pcf%livecroot_mr
   leaf_curmr                  => clm3%g%l%c%p%pcf%leaf_curmr
   froot_curmr                 => clm3%g%l%c%p%pcf%froot_curmr
   livestem_curmr              => clm3%g%l%c%p%pcf%livestem_curmr
   livecroot_curmr             => clm3%g%l%c%p%pcf%livecroot_curmr
   leaf_xsmr                   => clm3%g%l%c%p%pcf%leaf_xsmr
   froot_xsmr                  => clm3%g%l%c%p%pcf%froot_xsmr
   livestem_xsmr               => clm3%g%l%c%p%pcf%livestem_xsmr
   livecroot_xsmr              => clm3%g%l%c%p%pcf%livecroot_xsmr
   sminn                       => clm3%g%l%c%cns%sminn
   woody                       => pftcon%woody
   froot_leaf                  => pftcon%froot_leaf
   croot_stem                  => pftcon%croot_stem
   stem_leaf                   => pftcon%stem_leaf
   flivewd                     => pftcon%flivewd
   leafcn                      => pftcon%leafcn
   frootcn                     => pftcon%frootcn
   livewdcn                    => pftcon%livewdcn
   deadwdcn                    => pftcon%deadwdcn
   fcur2                       => pftcon%fcur
#if (defined CROP)
   gddmaturity                 => clm3%g%l%c%p%pps%gddmaturity
   huileaf                     => clm3%g%l%c%p%pps%huileaf
   huigrain                    => clm3%g%l%c%p%pps%huigrain
   hui                         => clm3%g%l%c%p%pps%gddplant
   leafout                     => clm3%g%l%c%p%pps%gddtsoi
   croplive                    => clm3%g%l%c%p%pps%croplive
   peaklai                     => clm3%g%l%c%p%pps%peaklai
   graincn                     => pftcon%graincn
#endif
   ! Assign local pointers to derived type arrays (out)
   gpp                         => clm3%g%l%c%p%pepv%gpp
   availc                      => clm3%g%l%c%p%pepv%availc
   xsmrpool_recover            => clm3%g%l%c%p%pepv%xsmrpool_recover
   c_allometry                 => clm3%g%l%c%p%pepv%c_allometry
   n_allometry                 => clm3%g%l%c%p%pepv%n_allometry
   plant_ndemand               => clm3%g%l%c%p%pepv%plant_ndemand
   tempsum_potential_gpp       => clm3%g%l%c%p%pepv%tempsum_potential_gpp
   tempmax_retransn            => clm3%g%l%c%p%pepv%tempmax_retransn
   annsum_potential_gpp        => clm3%g%l%c%p%pepv%annsum_potential_gpp
   avail_retransn              => clm3%g%l%c%p%pepv%avail_retransn
   annmax_retransn             => clm3%g%l%c%p%pepv%annmax_retransn
   plant_nalloc                => clm3%g%l%c%p%pepv%plant_nalloc
   plant_calloc                => clm3%g%l%c%p%pepv%plant_calloc
   excess_cflux                => clm3%g%l%c%p%pepv%excess_cflux
   downreg                     => clm3%g%l%c%p%pepv%downreg
   annsum_npp                  => clm3%g%l%c%p%pepv%annsum_npp
   cpool_to_xsmrpool           => clm3%g%l%c%p%pcf%cpool_to_xsmrpool
   psnsun_to_cpool             => clm3%g%l%c%p%pcf%psnsun_to_cpool
   psnshade_to_cpool           => clm3%g%l%c%p%pcf%psnshade_to_cpool
#if (defined C13)
   c13_psnsun_to_cpool         => clm3%g%l%c%p%pc13f%psnsun_to_cpool
   c13_psnshade_to_cpool       => clm3%g%l%c%p%pc13f%psnshade_to_cpool
#endif
   cpool_to_leafc              => clm3%g%l%c%p%pcf%cpool_to_leafc
   cpool_to_leafc_storage      => clm3%g%l%c%p%pcf%cpool_to_leafc_storage
   cpool_to_frootc             => clm3%g%l%c%p%pcf%cpool_to_frootc
   cpool_to_frootc_storage     => clm3%g%l%c%p%pcf%cpool_to_frootc_storage
   cpool_to_livestemc          => clm3%g%l%c%p%pcf%cpool_to_livestemc
   cpool_to_livestemc_storage  => clm3%g%l%c%p%pcf%cpool_to_livestemc_storage
   cpool_to_deadstemc          => clm3%g%l%c%p%pcf%cpool_to_deadstemc
   cpool_to_deadstemc_storage  => clm3%g%l%c%p%pcf%cpool_to_deadstemc_storage
   cpool_to_livecrootc         => clm3%g%l%c%p%pcf%cpool_to_livecrootc
   cpool_to_livecrootc_storage => clm3%g%l%c%p%pcf%cpool_to_livecrootc_storage
   cpool_to_deadcrootc         => clm3%g%l%c%p%pcf%cpool_to_deadcrootc
   cpool_to_deadcrootc_storage => clm3%g%l%c%p%pcf%cpool_to_deadcrootc_storage
   cpool_to_gresp_storage      => clm3%g%l%c%p%pcf%cpool_to_gresp_storage
#if (defined CROP)
   cpool_to_grainc             => clm3%g%l%c%p%pcf%cpool_to_grainc
   cpool_to_grainc_storage     => clm3%g%l%c%p%pcf%cpool_to_grainc_storage
   npool_to_grainn             => clm3%g%l%c%p%pnf%npool_to_grainn
   npool_to_grainn_storage     => clm3%g%l%c%p%pnf%npool_to_grainn_storage
#endif
   retransn_to_npool           => clm3%g%l%c%p%pnf%retransn_to_npool
   sminn_to_npool              => clm3%g%l%c%p%pnf%sminn_to_npool
   npool_to_leafn              => clm3%g%l%c%p%pnf%npool_to_leafn
   npool_to_leafn_storage      => clm3%g%l%c%p%pnf%npool_to_leafn_storage
   npool_to_frootn             => clm3%g%l%c%p%pnf%npool_to_frootn
   npool_to_frootn_storage     => clm3%g%l%c%p%pnf%npool_to_frootn_storage
   npool_to_livestemn          => clm3%g%l%c%p%pnf%npool_to_livestemn
   npool_to_livestemn_storage  => clm3%g%l%c%p%pnf%npool_to_livestemn_storage
   npool_to_deadstemn          => clm3%g%l%c%p%pnf%npool_to_deadstemn
   npool_to_deadstemn_storage  => clm3%g%l%c%p%pnf%npool_to_deadstemn_storage
   npool_to_livecrootn         => clm3%g%l%c%p%pnf%npool_to_livecrootn
   npool_to_livecrootn_storage => clm3%g%l%c%p%pnf%npool_to_livecrootn_storage
   npool_to_deadcrootn         => clm3%g%l%c%p%pnf%npool_to_deadcrootn
   npool_to_deadcrootn_storage => clm3%g%l%c%p%pnf%npool_to_deadcrootn_storage
   fpi                         => clm3%g%l%c%cps%fpi
   fpg                         => clm3%g%l%c%cps%fpg
   potential_immob             => clm3%g%l%c%cnf%potential_immob
   actual_immob                => clm3%g%l%c%cnf%actual_immob
   sminn_to_plant              => clm3%g%l%c%cnf%sminn_to_plant
   sminn_to_denit_excess       => clm3%g%l%c%cnf%sminn_to_denit_excess
   supplement_to_sminn         => clm3%g%l%c%cnf%supplement_to_sminn
#if (defined CROP)
   aleafi                      => clm3%g%l%c%p%pps%aleafi
   astemi                      => clm3%g%l%c%p%pps%astemi
   aleaf                       => clm3%g%l%c%p%pps%aleaf
   astem                       => clm3%g%l%c%p%pps%astem

   allocate(arepr(lbp:ubp))
   allocate(aroot(lbp:ubp))
#endif

   ! set time steps
!   dt = real( get_step_size(), r8 )

   ! set some space-and-time constant parameters 
   dayscrecover = 30.0_r8
   grperc = 0.3_r8
   grpnow = 1.0_r8
   bdnr = 0.5_r8 * (dt/86400._r8)

   ! loop over pfts to assess the total plant N demand
   do fp=1,num_soilp
      p = filter_soilp(fp)

      ! get the time step total gross photosynthesis
      ! this is coming from the canopy fluxes code, and is the
      ! gpp that is used to control stomatal conductance.
      ! For the nitrogen downregulation code, this is assumed
      ! to be the potential gpp, and the actual gpp will be
      ! reduced due to N limitation. 
      
      ! Convert psn from umol/m2/s -> gC/m2/s

      ! The input psn (psnsun and psnsha) are expressed per unit LAI
      ! in the sunlit and shaded canopy, respectively. These need to be
      ! scaled by laisun and laisha to get the total gpp for allocation

      psnsun_to_cpool(p) = psnsun(p) * laisun(p) * 12.011e-6_r8
      psnshade_to_cpool(p) = psnsha(p) * laisha(p) * 12.011e-6_r8
#if (defined C13)
      c13_psnsun_to_cpool(p) = c13_psnsun(p) * laisun(p) * 12.011e-6_r8
      c13_psnshade_to_cpool(p) = c13_psnsha(p) * laisha(p) * 12.011e-6_r8
#endif
      
      gpp(p) = psnsun_to_cpool(p) + psnshade_to_cpool(p)

      ! get the time step total maintenance respiration
      ! These fluxes should already be in gC/m2/s

      mr = leaf_mr(p) + froot_mr(p)
      if (woody(ivt(p)) == 1.0_r8) then
         mr = mr + livestem_mr(p) + livecroot_mr(p)
      end if

      ! carbon flux available for allocation
      availc(p) = gpp(p) - mr
      
      ! new code added for isotope calculations, 7/1/05, PET
      ! If mr > gpp, then some mr comes from gpp, the rest comes from
      ! cpool (xsmr)
      curmr_ratio = 1._r8
      if (mr > 0._r8 .and. availc(p) < 0._r8) then
         curmr = gpp(p)
         curmr_ratio = curmr / mr
      end if
      leaf_curmr(p) = leaf_mr(p) * curmr_ratio
      leaf_xsmr(p) = leaf_mr(p) - leaf_curmr(p)
      froot_curmr(p) = froot_mr(p) * curmr_ratio
      froot_xsmr(p) = froot_mr(p) - froot_curmr(p)
      livestem_curmr(p) = livestem_mr(p) * curmr_ratio
      livestem_xsmr(p) = livestem_mr(p) - livestem_curmr(p)
      livecroot_curmr(p) = livecroot_mr(p) * curmr_ratio
      livecroot_xsmr(p) = livecroot_mr(p) - livecroot_curmr(p)
      
      ! no allocation when available c is negative
      availc(p) = max(availc(p),0.0_r8)

      ! test for an xsmrpool deficit
      if (xsmrpool(p) < 0.0_r8) then
         ! Running a deficit in the xsmrpool, so the first priority is to let
         ! some availc from this timestep accumulate in xsmrpool.
         ! Determine rate of recovery for xsmrpool deficit

         xsmrpool_recover(p) = -xsmrpool(p)/(dayscrecover*86400.0_r8)
         if (xsmrpool_recover(p) < availc(p)) then
             ! available carbon reduced by amount for xsmrpool recovery
             availc(p) = availc(p) - xsmrpool_recover(p)
         else
             ! all of the available carbon goes to xsmrpool recovery
             xsmrpool_recover(p) = availc(p)
             availc(p) = 0.0_r8
         end if
         cpool_to_xsmrpool(p) = xsmrpool_recover(p)
      end if

      f1 = froot_leaf(ivt(p))
      f2 = croot_stem(ivt(p))
     
      ! modified wood allocation to be 2.2 at npp=800 gC/m2/yr, 0.2 at npp=0,
      ! constrained so that it does not go lower than 0.2 (under negative annsum_npp)
      ! This variable allocation is only for trees. Shrubs have a constant
      ! allocation as specified in the pft-physiology file.  The value is also used
      ! as a trigger here: -1.0 means to use the dynamic allocation (trees).
      if (stem_leaf(ivt(p)) == -1._r8) then
         f3 = (2.7/(1.0+exp(-0.004*(annsum_npp(p) - 300.0)))) - 0.4
      else
         f3 = stem_leaf(ivt(p))
      end if
      
      f4 = flivewd(ivt(p))
      g1 = grperc
      g2 = grpnow
      cnl = leafcn(ivt(p))
      cnfr = frootcn(ivt(p))
      cnlw = livewdcn(ivt(p))
      cndw = deadwdcn(ivt(p))

      ! calculate f1 to f5 for prog crops following AgroIBIS subr phenocrop

#if (defined CROP)

      f5 = 0._r8 ! continued intializations from above

      if (ivt(p) >= npcropmin .and. croplive(p) == 1) then ! skip 2 generic crops

         ! same phases appear in subroutine CropPhenology

         ! Phase 1 completed:
         ! ==================
         ! if hui is less than the number of gdd needed for filling of grain
         ! leaf emergence also has to have taken place for lai changes to occur
         ! and carbon assimilation
         ! Next phase: leaf emergence to start of leaf decline

         if (leafout(p) >= huileaf(p) .and. hui(p) < huigrain(p)) then

            ! allocation rules for crops based on maturity and linear decrease
            ! of amount allocated to roots over course of the growing season

            if (peaklai(p) == 1) then ! lai at maximum allowed
               arepr(p) = 0._r8
               aleaf(p) = 1.e-5_r8
               astem(p) = 0._r8
               aroot(p) = 1._r8 - arepr(p) - aleaf(p) - astem(p)
            else
               arepr(p) = 0._r8
               aroot(p) = max(0._r8, min(1._r8, arooti(ivt(p)) -   &
                              (arooti(ivt(p)) - arootf(ivt(p))) *  &
                              min(1._r8, hui(p)/gddmaturity(p))))
               fleaf = fleafi(ivt(p)) * (exp(-bfact(ivt(p))) -         &
                             exp(-bfact(ivt(p))*hui(p)/huigrain(p))) / &
                             (exp(-bfact(ivt(p)))-1) ! fraction alloc to leaf (from J Norman alloc curve)
               aleaf(p) = max(1.e-5_r8, (1._r8 - aroot(p)) * fleaf)
               astem(p) = 1._r8 - arepr(p) - aleaf(p) - aroot(p)
            end if

            ! AgroIBIS included here an immediate adjustment to aleaf & astem if the 
            ! predicted lai from the above allocation coefficients exceeded laimx.
            ! We have decided to live with lais slightly higher than laimx by
            ! enforcing the cap in the following tstep through the peaklai logic above.

            astemi(p) = astem(p) ! save for use by equations after shift
            aleafi(p) = aleaf(p) ! to reproductive phenology stage begins

            ! Phase 2 completed:
            ! ==================
            ! shift allocation either when enough gdd are accumulated or maximum number
            ! of days has elapsed since planting

         else if (hui(p) >= huigrain(p)) then

            aroot(p) = max(0._r8, min(1._r8, arooti(ivt(p)) - &
                      (arooti(ivt(p)) - arootf(ivt(p))) * min(1._r8, hui(p)/gddmaturity(p))))
            if (astemi(p) > astemf(ivt(p))) then
               astem(p) = max(0._r8, max(astemf(ivt(p)), astem(p) * &
                              (1._r8 - min((hui(p)-                 &
                              huigrain(p))/((gddmaturity(p)*declfact(ivt(p)))- &
                              huigrain(p)),1._r8)**allconss(ivt(p)) )))
            end if
            if (aleafi(p) > aleaff(ivt(p))) then
               aleaf(p) = max(1.e-5_r8, max(aleaff(ivt(p)), aleaf(p) * &
                              (1._r8 - min((hui(p)-                    &
                              huigrain(p))/((gddmaturity(p)*declfact(ivt(p)))- &
                              huigrain(p)),1._r8)**allconsl(ivt(p)) )))
            end if
            arepr(p) = 1._r8 - aroot(p) - astem(p) - aleaf(p)
            astem(p) = astem(p)+arepr(p)
            arepr(p) = 0._r8

         else                   ! pre emergence
            aleaf(p) = 1.e-5_r8 ! allocation coefficients should be irrelevant
            astem(p) = 0._r8    ! because crops have no live carbon pools;
            aroot(p) = 0._r8    ! this applies to this "else" and to the "else"
         end if                 ! a few lines down

         f1 = aroot(p) / aleaf(p)
         f3 = astem(p) / aleaf(p)
         f5 = arepr(p) / aleaf(p)
         g1 = 0.25_r8

      else if (ivt(p) >= npcropmin) then ! skip 2 generic crops
         f1 = 0._r8
         f3 = 0._r8
         f5 = 0._r8
         g1 = 0.25_r8
      end if
#endif
 
      write(6,*) 'CNAllocation, check n_allometry'

      ! based on available C, use constant allometric relationships to
      ! determine N requirements
      if (woody(ivt(p)) == 1.0_r8) then
         c_allometry(p) = (1._r8+g1)*(1._r8+f1+f3*(1._r8+f2))
         n_allometry(p) = 1._r8/cnl + f1/cnfr + (f3*f4*(1._r8+f2))/cnlw + &
                       (f3*(1._r8-f4)*(1._r8+f2))/cndw
         write(6,*) 'if (woody(ivt(p)) == 1.0_r8) n_allometry(',p,')=',n_allometry(p)
#if (defined CROP)
      else if (ivt(p) >= npcropmin) then ! skip generic crops
         c_allometry(p) = (1._r8+g1)*(1._r8+f1+f3*(1._r8+f2))
         n_allometry(p) = 1._r8/cnl + f1/cnfr + (f3*f4*(1._r8+f2))/cnlw + &
                       (f3*(1._r8-f4)*(1._r8+f2))/cndw
          write(6,*) 'else if (ivt(p) >= npcropmin) n_allometry(',p,')=',n_allometry(p)
          write(6,*) 'cnl = leafcn(',ivt(p),')=',leafcn(ivt(p))
          write(6,*) 'cnlw = livewdcn(',ivt(p),')=',livewdcn(ivt(p))
          write(6,*) 'cnfr = frootcn(',ivt(p),')=',frootcn(ivt(p)) 
          write(6,*) 'cndw = deadwdcn(',ivt(p),')=',deadwdcn(ivt(p)) 
          write(6,*) 'f4 = flivewd(',ivt(p),')=',flivewd(ivt(p))
          write(6,*) 'f1=',f1
          write(6,*) 'f2=',f2 
          write(6,*) 'f3=',f3    
          write(6,*) 'f5=',f5 
       
#endif
      else
         c_allometry(p) = 1._r8+g1+f1+f1*g1
         n_allometry(p) = 1._r8/cnl + f1/cnfr
         write(6,*) 'else  n_allometry(',p,')=',n_allometry(p)
      end if
      plant_ndemand(p) = availc(p)*(n_allometry(p)/c_allometry(p))
     write(6,*) 'CNAllocation, check plant_ndemand first'
     write(6,*) 'plant_ndemand(',p,')=',plant_ndemand(p)
     write(6,*) 'availc(',p,')=',availc(p)
     write(6,*) 'n_allometry(',p,')=',n_allometry(p)
     write(6,*) 'c_allometry(',p,')=',c_allometry(p)

      ! retranslocated N deployment depends on seasonal cycle of potential GPP
      ! (requires one year run to accumulate demand)

      tempsum_potential_gpp(p) = tempsum_potential_gpp(p) + gpp(p)

      ! Adding the following line to carry max retransn info to CN Annual Update
      tempmax_retransn(p) = max(tempmax_retransn(p),retransn(p))

      if (annsum_potential_gpp(p) > 0.0_r8) then
         avail_retransn(p) = (annmax_retransn(p)/2.0)*(gpp(p)/annsum_potential_gpp(p))/dt
      else
         avail_retransn(p) = 0.0_r8
      end if

      ! make sure available retrans N doesn't exceed storage
      avail_retransn(p) = min(avail_retransn(p), retransn(p)/dt)

      ! modify plant N demand according to the availability of
      ! retranslocated N
      ! take from retransn pool at most the flux required to meet
      ! plant ndemand

      if (plant_ndemand(p) > avail_retransn(p)) then
         retransn_to_npool(p) = avail_retransn(p)
      else
         retransn_to_npool(p) = plant_ndemand(p)
      end if
      plant_ndemand(p) = plant_ndemand(p) - retransn_to_npool(p)
      write(6,*) 'CNAllocation, check plant_ndemand second time'
      write(6,*) 'retransn_to_npool(',p,')=',retransn_to_npool(p)
      write(6,*) 'CNAllocation, plant_ndemand(',p,')=',plant_ndemand(p)
   end do ! end pft loop

   ! now use the p2c routine to get the column-averaged plant_ndemand
   allocate(col_plant_ndemand(lbc:ubc))
   call p2c(num_soilc,filter_soilc,plant_ndemand,col_plant_ndemand)

   ! column loop to resolve plant/heterotroph competition for mineral N
   do fc=1,num_soilc
      c = filter_soilc(fc)

      sum_ndemand = col_plant_ndemand(c) + potential_immob(c)

      if (sum_ndemand*dt < sminn(c)) then
         ! N availability is not limiting immobilization of plant
         ! uptake, and both can proceed at their potential rates

         nlimit = 0
         fpi(c) = 1.0_r8
         actual_immob(c) = potential_immob(c)
         sminn_to_plant(c) = col_plant_ndemand(c)

         ! under conditions of excess N, some proportion is asusmed to
         ! be lost to denitrification, in addition to the constant
         ! proportion lost in the decomposition pathways

         sminn_to_denit_excess(c) = bdnr*((sminn(c)/dt) - sum_ndemand)
      else

#if (!defined SUPLN)
         ! N availability can not satisfy the sum of immobilization and
         ! plant growth demands, so these two demands compete for available
         ! soil mineral N resource.

         nlimit = 1
         if (sum_ndemand > 0.0_r8) then
            actual_immob(c) = (sminn(c)/dt)*(potential_immob(c) / sum_ndemand)
         else
            actual_immob(c) = 0.0_r8
         end if

         if (potential_immob(c) > 0.0_r8) then
            fpi(c) = actual_immob(c) / potential_immob(c)
         else
            fpi(c) = 0.0_r8
         end if

         sminn_to_plant(c) = (sminn(c)/dt) - actual_immob(c)
#else
         ! this code block controls the addition of N to sminn pool
         ! to eliminate any N limitation, when SUPLN is set.  This lets the
         ! model behave essentially as a carbon-only model, but with the
         ! benefit of keeping trrack of the N additions needed to
         ! eliminate N limitations, so there is still a diagnostic quantity
         ! that describes the degree of N limitation at steady-state.

         nlimit = 1
         fpi(c) = 1.0_r8
         actual_immob(c) = potential_immob(c)
         sminn_to_plant(c) = col_plant_ndemand(c)
         supplement_to_sminn(c) = sum_ndemand - (sminn(c)/dt)
#endif
      end if

      ! calculate the fraction of potential growth that can be
      ! acheived with the N available to plants

      if (col_plant_ndemand(c) > 0.0_r8) then
         fpg(c) = sminn_to_plant(c) / col_plant_ndemand(c)
      else
         fpg(c) = 1.0_r8
      end if

   end do ! end of column loop

   ! start new pft loop to distribute the available N between the
   ! competing pfts on the basis of relative demand, and allocate C and N to
   ! new growth and storage

   do fp=1,num_soilp
      p = filter_soilp(fp)
      c = pcolumn(p)

      ! set some local allocation variables
      f1 = froot_leaf(ivt(p))
      f2 = croot_stem(ivt(p))

      ! modified wood allocation to be 2.2 at npp=800 gC/m2/yr, 0.2 at npp=0,
      ! constrained so that it does not go lower than 0.2 (under negative annsum_npp)
      ! There was an error in this formula in previous version, where the coefficient
      ! was 0.004 instead of 0.0025.
      ! This variable allocation is only for trees. Shrubs have a constant
      ! allocation as specified in the pft-physiology file.  The value is also used
      ! as a trigger here: -1.0 means to use the dynamic allocation (trees).
      if (stem_leaf(ivt(p)) == -1._r8) then
        f3 = (2.7/(1.0+exp(-0.004*(annsum_npp(p) - 300.0)))) - 0.4
      else
        f3 = stem_leaf(ivt(p))
      end if
      
      f4 = flivewd(ivt(p))
      g1 = grperc
      g2 = grpnow
      cnl = leafcn(ivt(p))
      cnfr = frootcn(ivt(p))
      cnlw = livewdcn(ivt(p))
      cndw = deadwdcn(ivt(p))
      fcur = fcur2(ivt(p))

#if (defined CROP)
      if (ivt(p) >= npcropmin .and. croplive(p) == 1) then ! skip 2 generic crops
         f1 = aroot(p) / aleaf(p)
         f3 = astem(p) / aleaf(p)
         f5 = arepr(p) / aleaf(p)
         g1 = 0.25_r8
      else if (ivt(p) >= npcropmin) then ! skip 2 generic crops
         f1 = 0._r8
         f3 = 0._r8
         f5 = 0._r8
         g1 = 0.25_r8
      end if
      cng = graincn(ivt(p))
#endif

      ! increase fcur linearly with ndays_active, until fcur reaches 1.0 at
      ! ndays_active = 365.  This prevents the continued storage of C and N.
      ! turning off this correction (PET, 12/11/03), instead using bgtr in
      ! phenology algorithm.
      !fcur = fcur + (1._r8 - fcur)*lgsf(p)

      sminn_to_npool(p) = plant_ndemand(p) * fpg(c)
      plant_nalloc(p) = sminn_to_npool(p) + retransn_to_npool(p)

      ! calculate the associated carbon allocation, and the excess
      ! carbon flux that must be accounted for through downregulation

      plant_calloc(p) = plant_nalloc(p) * (c_allometry(p)/n_allometry(p))
      excess_cflux(p) = availc(p) - plant_calloc(p)

      ! reduce gpp fluxes due to N limitation
      if (gpp(p) > 0.0_r8) then
         downreg(p) = excess_cflux(p)/gpp(p)
         psnsun_to_cpool(p) = psnsun_to_cpool(p)*(1._r8 - downreg(p))
         psnshade_to_cpool(p) = psnshade_to_cpool(p)*(1._r8 - downreg(p))
#if (defined C13)
         c13_psnsun_to_cpool(p) = c13_psnsun_to_cpool(p)*(1._r8 - downreg(p))
         c13_psnshade_to_cpool(p) = c13_psnshade_to_cpool(p)*(1._r8 - downreg(p))
#endif
      end if

      ! calculate the amount of new leaf C dictated by these allocation
      ! decisions, and calculate the daily fluxes of C and N to current
      ! growth and storage pools

      ! fcur is the proportion of this day's growth that is displayed now,
      ! the remainder going into storage for display next year through the
      ! transfer pools

      nlc = plant_calloc(p) / c_allometry(p)
      write(6,*) 'in CNAllocation, nlc=',nlc,'fcur=',fcur
      write(6,*) 'f1=',f1,'f2=',f2,'f3=',f3,'f4=',f4,'f5=',f5
      cpool_to_leafc(p)          = nlc * fcur
      cpool_to_leafc_storage(p)  = nlc * (1._r8 - fcur)
      cpool_to_frootc(p)         = nlc * f1 * fcur
      cpool_to_frootc_storage(p) = nlc * f1 * (1._r8 - fcur)
      if (woody(ivt(p)) == 1._r8) then
         cpool_to_livestemc(p)          = nlc * f3 * f4 * fcur
         cpool_to_livestemc_storage(p)  = nlc * f3 * f4 * (1._r8 - fcur)
         cpool_to_deadstemc(p)          = nlc * f3 * (1._r8 - f4) * fcur
         cpool_to_deadstemc_storage(p)  = nlc * f3 * (1._r8 - f4) * (1._r8 - fcur)
         cpool_to_livecrootc(p)         = nlc * f2 * f3 * f4 * fcur
         cpool_to_livecrootc_storage(p) = nlc * f2 * f3 * f4 * (1._r8 - fcur)
         cpool_to_deadcrootc(p)         = nlc * f2 * f3 * (1._r8 - f4) * fcur
         cpool_to_deadcrootc_storage(p) = nlc * f2 * f3 * (1._r8 - f4) * (1._r8 - fcur)
      end if
#if (defined CROP)
      if (ivt(p) >= npcropmin) then ! skip 2 generic crops
         cpool_to_livestemc(p)          = nlc * f3 * f4 * fcur
         cpool_to_livestemc_storage(p)  = nlc * f3 * f4 * (1._r8 - fcur)
         cpool_to_deadstemc(p)          = nlc * f3 * (1._r8 - f4) * fcur
         cpool_to_deadstemc_storage(p)  = nlc * f3 * (1._r8 - f4) * (1._r8 - fcur)
         cpool_to_livecrootc(p)         = nlc * f2 * f3 * f4 * fcur
         cpool_to_livecrootc_storage(p) = nlc * f2 * f3 * f4 * (1._r8 - fcur)
         cpool_to_deadcrootc(p)         = nlc * f2 * f3 * (1._r8 - f4) * fcur
         cpool_to_deadcrootc_storage(p) = nlc * f2 * f3 * (1._r8 - f4) * (1._r8 - fcur)
         cpool_to_grainc(p)             = nlc * f5 * fcur
         cpool_to_grainc_storage(p)     = nlc * f5 * (1._r8 -fcur)
      end if
#endif

      ! corresponding N fluxes
      npool_to_leafn(p)          = (nlc / cnl) * fcur
      npool_to_leafn_storage(p)  = (nlc / cnl) * (1._r8 - fcur)
      npool_to_frootn(p)         = (nlc * f1 / cnfr) * fcur
      npool_to_frootn_storage(p) = (nlc * f1 / cnfr) * (1._r8 - fcur)
      if (woody(ivt(p)) == 1._r8) then
         npool_to_livestemn(p)          = (nlc * f3 * f4 / cnlw) * fcur
         npool_to_livestemn_storage(p)  = (nlc * f3 * f4 / cnlw) * (1._r8 - fcur)
         npool_to_deadstemn(p)          = (nlc * f3 * (1._r8 - f4) / cndw) * fcur
         npool_to_deadstemn_storage(p)  = (nlc * f3 * (1._r8 - f4) / cndw) * (1._r8 - fcur)
         npool_to_livecrootn(p)         = (nlc * f2 * f3 * f4 / cnlw) * fcur
         npool_to_livecrootn_storage(p) = (nlc * f2 * f3 * f4 / cnlw) * (1._r8 - fcur)
         npool_to_deadcrootn(p)         = (nlc * f2 * f3 * (1._r8 - f4) / cndw) * fcur
         npool_to_deadcrootn_storage(p) = (nlc * f2 * f3 * (1._r8 - f4) / cndw) * (1._r8 - fcur)
      end if
#if (defined CROP)
      if (ivt(p) >= npcropmin) then ! skip 2 generic crops
         npool_to_livestemn(p)          = (nlc * f3 * f4 / cnlw) * fcur
         npool_to_livestemn_storage(p)  = (nlc * f3 * f4 / cnlw) * (1._r8 - fcur)
         npool_to_deadstemn(p)          = (nlc * f3 * (1._r8 - f4) / cndw) * fcur
         npool_to_deadstemn_storage(p)  = (nlc * f3 * (1._r8 - f4) / cndw) * (1._r8 - fcur)
         npool_to_livecrootn(p)         = (nlc * f2 * f3 * f4 / cnlw) * fcur
         npool_to_livecrootn_storage(p) = (nlc * f2 * f3 * f4 / cnlw) * (1._r8 - fcur)
         npool_to_deadcrootn(p)         = (nlc * f2 * f3 * (1._r8 - f4) / cndw) * fcur
         npool_to_deadcrootn_storage(p) = (nlc * f2 * f3 * (1._r8 - f4) / cndw) * (1._r8 - fcur)
         npool_to_grainn(p)             = (nlc * f5 / cng) * fcur
         npool_to_grainn_storage(p)     = (nlc * f5 / cng) * (1._r8 -fcur)
      end if
#endif

      ! Calculate the amount of carbon that needs to go into growth
      ! respiration storage to satisfy all of the storage growth demands.
      ! Allows for the fraction of growth respiration that is released at the
      ! time of fixation, versus the remaining fraction that is stored for
      ! release at the time of display. Note that all the growth respiration
      ! fluxes that get released on a given timestep are calculated in growth_resp(),
      ! but that the storage of C for growth resp during display of transferred
      ! growth is assigned here.

      gresp_storage = cpool_to_leafc_storage(p) + cpool_to_frootc_storage(p)
      if (woody(ivt(p)) == 1._r8) then
         gresp_storage = gresp_storage + cpool_to_livestemc_storage(p)
         gresp_storage = gresp_storage + cpool_to_deadstemc_storage(p)
         gresp_storage = gresp_storage + cpool_to_livecrootc_storage(p)
         gresp_storage = gresp_storage + cpool_to_deadcrootc_storage(p)
      end if
#if (defined CROP)
      if (ivt(p) >= npcropmin) then ! skip 2 generic crops
         gresp_storage = gresp_storage + cpool_to_livestemc_storage(p)
         gresp_storage = gresp_storage + cpool_to_grainc_storage(p)
      end if
#endif
      cpool_to_gresp_storage(p) = gresp_storage * g1 * (1._r8 - g2)

   end do ! end pft loop

   deallocate(col_plant_ndemand)
#if (defined CROP)
   deallocate(arepr)
   deallocate(aroot)
#endif

end subroutine CNAllocation

#endif

end module CNAllocationMod
module CNAnnualUpdateMod
#ifdef CN

!-----------------------------------------------------------------------
!BOP
!
! !MODULE: CNAnnualUpdateMod
!
! !DESCRIPTION:
! Module for updating annual summation variables
!
! !USES:
    use shr_kind_mod, only: r8 => shr_kind_r8
    implicit none
    save
    private
! !PUBLIC MEMBER FUNCTIONS:
    public:: CNAnnualUpdate
!
! !REVISION HISTORY:
! 4/23/2004: Created by Peter Thornton
!
!EOP
!-----------------------------------------------------------------------

contains

!-----------------------------------------------------------------------
!BOP
!
! !IROUTINE: CNAnnualUpdate
!
! !INTERFACE:
subroutine CNAnnualUpdate(lbc, ubc, lbp, ubp, num_soilc, filter_soilc, &
                          num_soilp, filter_soilp)
!
! !DESCRIPTION:
! On the radiation time step, update annual summation variables
!
! !USES:
   use clmtype
!   use clm_time_manager, only: get_step_size, get_days_per_year
   use clm_varcon      , only: secspday
   use pft2colMod      , only: p2c
!Yaqiong Lu add for coupling
   use globals         , only: dt,day_per_year 
!
! !ARGUMENTS:
   implicit none
   integer, intent(in) :: lbc, ubc        ! column bounds
   integer, intent(in) :: lbp, ubp        ! pft bounds
   integer, intent(in) :: num_soilc       ! number of soil columns in filter
   integer, intent(in) :: filter_soilc(ubc-lbc+1) ! filter for soil columns
   integer, intent(in) :: num_soilp       ! number of soil pfts in filter
   integer, intent(in) :: filter_soilp(ubp-lbp+1) ! filter for soil pfts
!
! !CALLED FROM:
! subroutine clm_driver1
!
! !REVISION HISTORY:
! 10/1/03: Created by Peter Thornton
!
! !LOCAL VARIABLES:
! local pointers to implicit in scalars
!
   integer , pointer :: pcolumn(:)               ! index into column level
                                                 ! quantities
!
! local pointers to implicit in/out scalars
!
   real(r8), pointer :: annsum_counter(:)        ! seconds since last annual accumulator turnover
   real(r8), pointer :: tempsum_potential_gpp(:) ! temporary annual sum of potential GPP
   real(r8), pointer :: annsum_potential_gpp(:)  ! annual sum of potential GPP
   real(r8), pointer :: tempmax_retransn(:)      ! temporary annual max of retranslocated N pool (gN/m2)
   real(r8), pointer :: annmax_retransn(:)       ! annual max of retranslocated N pool (gN/m2)
   real(r8), pointer :: tempavg_t2m(:)           ! temporary average 2m air temperature (K)
   real(r8), pointer :: annavg_t2m(:)            ! annual average 2m air temperature (K)
   real(r8), pointer :: tempsum_npp(:)           ! temporary sum NPP (gC/m2/yr)
   real(r8), pointer :: annsum_npp(:)            ! annual sum NPP (gC/m2/yr)
   real(r8), pointer :: cannsum_npp(:)           ! column annual sum NPP (gC/m2/yr)
   real(r8), pointer :: cannavg_t2m(:)    !annual average of 2m air temperature, averaged from pft-level (K)
#if (defined CNDV)
   real(r8), pointer :: tempsum_litfall(:)       ! temporary sum litfall (gC/m2/yr)
   real(r8), pointer :: annsum_litfall(:)        ! annual sum litfall (gC/m2/yr)
#endif
!
! local pointers to implicit out scalars
!
!
! !OTHER LOCAL VARIABLES:
   integer :: c,p          ! indices
   integer :: fp,fc        ! lake filter indices
   character*256 :: msg


!   real(r8):: dt           ! radiation time step (seconds)

!EOP
!-----------------------------------------------------------------------
   ! assign local pointers to derived type arrays
   annsum_counter        => clm3%g%l%c%cps%annsum_counter
   tempsum_potential_gpp => clm3%g%l%c%p%pepv%tempsum_potential_gpp
   annsum_potential_gpp  => clm3%g%l%c%p%pepv%annsum_potential_gpp
   tempmax_retransn      => clm3%g%l%c%p%pepv%tempmax_retransn
   annmax_retransn       => clm3%g%l%c%p%pepv%annmax_retransn
   tempavg_t2m           => clm3%g%l%c%p%pepv%tempavg_t2m
   annavg_t2m            => clm3%g%l%c%p%pepv%annavg_t2m
   tempsum_npp           => clm3%g%l%c%p%pepv%tempsum_npp
   annsum_npp            => clm3%g%l%c%p%pepv%annsum_npp
   cannsum_npp           => clm3%g%l%c%cps%cannsum_npp
   cannavg_t2m           => clm3%g%l%c%cps%cannavg_t2m
#if (defined CNDV)
   tempsum_litfall       => clm3%g%l%c%p%pepv%tempsum_litfall
   annsum_litfall        => clm3%g%l%c%p%pepv%annsum_litfall
#endif
   pcolumn               => clm3%g%l%c%p%column

   ! set time steps
!   dt = real( get_step_size(), r8 )
      call CLMDebug('CNannual-assign done')
   ! column loop
   do fc = 1,num_soilc
      c = filter_soilc(fc)
      annsum_counter(c) = annsum_counter(c) + dt
    end do

      
      write(msg,*) 'annsum_counter(filter_soilc(1))=',annsum_counter(filter_soilc(1))
      call CLMDebug(msg)

     call CLMDebug('CNannual-mark1')
#if (defined CNDV) || (defined CROP)
   ! In the future -- ONLY use this code and remove the similar part below
   ! So the #ifdef on CNDV and CROP would be removed
   if (annsum_counter(filter_soilc(1)) >= day_per_year * secspday) then ! new (slevis)
#endif
   ! pft loop
   do fp = 1,num_soilp
      p = filter_soilp(fp)
#if (!defined CNDV) && (!defined CROP)
      ! In the future -- REMOVE this code and use the equivalent code above always
      c = pcolumn(p)                                                ! old (slevis)
      if (annsum_counter(c) >= day_per_year * secspday) then ! old (slevis)
#endif
     call CLMDebug('CNannual-mark2')
         ! update annual plant ndemand accumulator
         annsum_potential_gpp(p)  = tempsum_potential_gpp(p)
         tempsum_potential_gpp(p) = 0._r8
     call CLMDebug('CNannual-mark3')

         ! update annual total N retranslocation accumulator
         annmax_retransn(p)  = tempmax_retransn(p)
         tempmax_retransn(p) = 0._r8
     call CLMDebug('CNannual-mark4')

         ! update annual average 2m air temperature accumulator
         annavg_t2m(p)  = tempavg_t2m(p)
          tempavg_t2m(p) = 0._r8

         write(6,*) 'CNAnnualUpdateMod, annavg_t2m(',p,')=',annavg_t2m(p)
     call CLMDebug('CNannual-mark5')

         ! update annual NPP accumulator, convert to annual total
         annsum_npp(p) = tempsum_npp(p) * dt
         tempsum_npp(p) = 0._r8
         write(6,*) 'CNAnnualUpdateMod, annsum_npp(',p,')=',annsum_npp(p)
       
     call CLMDebug('CNannual-mark6')

#if (defined CNDV)
         ! update annual litfall accumulator, convert to annual total
         annsum_litfall(p) = tempsum_litfall(p) * dt
         tempsum_litfall(p) = 0._r8
#endif
#if (!defined CNDV) && (!defined CROP)
      end if ! old (slevis)
#endif
   end do

   ! use p2c routine to get selected column-average pft-level fluxes and states
    call CLMDebug('CNannual-call p2c')
   call p2c(num_soilc, filter_soilc, annsum_npp, cannsum_npp)
   call p2c(num_soilc, filter_soilc, annavg_t2m, cannavg_t2m)
#if (defined CNDV) || (defined CROP)
   end if ! new (slevis)
#endif
    call CLMDebug('CNannual-mark4')
   ! column loop
   do fc = 1,num_soilc
      c = filter_soilc(fc)
      if (annsum_counter(c) >= day_per_year * secspday) annsum_counter(c) = 0._r8
   end do

end subroutine CNAnnualUpdate
!-----------------------------------------------------------------------
#endif

end module CNAnnualUpdateMod
module CNBalanceCheckMod
#ifdef CN

!-----------------------------------------------------------------------
!BOP
!
! !MODULE: CNBalanceCheckMod
!
! !DESCRIPTION:
! Module for carbon mass balance checking.
!
! !USES:
!    use abortutils  , only: endrun
    use shr_kind_mod, only: r8 => shr_kind_r8
!    use clm_varctl  , only: iulog
    implicit none
    save
    private
! !PUBLIC MEMBER FUNCTIONS:
    public :: BeginCBalance
    public :: BeginNBalance
    public :: CBalanceCheck
    public :: NBalanceCheck
!
! !REVISION HISTORY:
! 4/23/2004: Created by Peter Thornton
!
!EOP
!-----------------------------------------------------------------------

contains

!-----------------------------------------------------------------------
!BOP
!
! !IROUTINE: BeginCBalance
!
! !INTERFACE:
subroutine BeginCBalance(lbc, ubc, num_soilc, filter_soilc)
!
! !DESCRIPTION:
! On the radiation time step, calculate the beginning carbon balance for mass
! conservation checks.
!
! !USES:
   use clmtype
!
! !ARGUMENTS:
   implicit none
   integer, intent(in) :: lbc, ubc        ! column bounds
   integer, intent(in) :: num_soilc       ! number of soil columns filter
   integer, intent(in) :: filter_soilc(ubc-lbc+1) ! filter for soil columns
!
! !CALLED FROM:
! subroutine clm_driver1
!
! !REVISION HISTORY:
! 2/4/05: Created by Peter Thornton
!
! !LOCAL VARIABLES:
! local pointers to implicit in arrays
   real(r8), pointer :: totcolc(:)            ! (gC/m2) total column carbon, incl veg and cpool
!
! local pointers to implicit out arrays
   real(r8), pointer :: col_begcb(:)   ! carbon mass, beginning of time step (gC/m**2)
!
! !OTHER LOCAL VARIABLES:
   integer :: c     ! indices
   integer :: fc   ! lake filter indices
!
!EOP
!-----------------------------------------------------------------------
   ! assign local pointers at the column level
   col_begcb                      => clm3%g%l%c%ccbal%begcb
   totcolc                        => clm3%g%l%c%ccs%totcolc

   ! column loop
   do fc = 1,num_soilc
      c = filter_soilc(fc)
 
      ! calculate beginning column-level carbon balance,
      ! for mass conservation check
 
      col_begcb(c) = totcolc(c)

   end do ! end of columns loop
 

end subroutine BeginCBalance
!-----------------------------------------------------------------------

!-----------------------------------------------------------------------
!BOP
!
! !IROUTINE: BeginNBalance
!
! !INTERFACE:
subroutine BeginNBalance(lbc, ubc, num_soilc, filter_soilc)
!
! !DESCRIPTION:
! On the radiation time step, calculate the beginning nitrogen balance for mass
! conservation checks.
!
! !USES:
   use clmtype
!
! !ARGUMENTS:
   implicit none
   integer, intent(in) :: lbc, ubc        ! column bounds
   integer, intent(in) :: num_soilc       ! number of soil columns filter
   integer, intent(in) :: filter_soilc(ubc-lbc+1) ! filter for soil columns
!
! !CALLED FROM:
! subroutine clm_driver1
!
! !REVISION HISTORY:
! 2/4/05: Created by Peter Thornton
!
! !LOCAL VARIABLES:
! local pointers to implicit in arrays
   real(r8), pointer :: totcoln(:)            ! (gN/m2) total column nitrogen, incl veg
!
! local pointers to implicit out arrays
   real(r8), pointer :: col_begnb(:)   ! nitrogen mass, beginning of time step (gN/m**2)
!
! !OTHER LOCAL VARIABLES:
   integer :: c     ! indices
   integer :: fc   ! lake filter indices
!
!EOP
!-----------------------------------------------------------------------
   ! assign local pointers at the column level
   col_begnb                      => clm3%g%l%c%cnbal%begnb
   totcoln                        => clm3%g%l%c%cns%totcoln

   ! column loop
   do fc = 1,num_soilc
      c = filter_soilc(fc)
 
      ! calculate beginning column-level nitrogen balance,
      ! for mass conservation check
 
      col_begnb(c) = totcoln(c)

   end do ! end of columns loop
 
end subroutine BeginNBalance
!-----------------------------------------------------------------------

!-----------------------------------------------------------------------
!BOP
!
! !IROUTINE: CBalanceCheck
!
! !INTERFACE:
subroutine CBalanceCheck(lbc, ubc, num_soilc, filter_soilc)
!
! !DESCRIPTION:
! On the radiation time step, perform carbon mass conservation check for column and pft
!
! !USES:
   use clmtype
   use globals, only: dt
!   use clm_time_manager, only: get_step_size
!
! !ARGUMENTS:
   implicit none
   integer, intent(in) :: lbc, ubc        ! column bounds
   integer, intent(in) :: num_soilc       ! number of soil columns in filter
   integer, intent(in) :: filter_soilc(ubc-lbc+1) ! filter for soil columns
!
! !CALLED FROM:
! subroutine clm_driver1
!
! !REVISION HISTORY:
! 12/9/03: Created by Peter Thornton
!
! !LOCAL VARIABLES:
!
! local pointers to implicit in arrays
   real(r8), pointer :: totcolc(:)            ! (gC/m2) total column carbon, incl veg and cpool
   real(r8), pointer :: gpp(:)            ! (gC/m2/s) gross primary production 
   real(r8), pointer :: er(:)            ! (gC/m2/s) total ecosystem respiration, autotrophic + heterotrophic
   real(r8), pointer :: col_fire_closs(:) ! (gC/m2/s) total column-level fire C loss
   real(r8), pointer :: col_hrv_xsmrpool_to_atm(:)  ! excess MR pool harvest mortality (gC/m2/s)
   real(r8), pointer :: dwt_closs(:)              ! (gC/m2/s) total carbon loss from product pools and conversion
   real(r8), pointer :: product_closs(:)      ! (gC/m2/s) total wood product carbon loss
!
! local pointers to implicit out arrays
   real(r8), pointer :: col_cinputs(:)  ! (gC/m2/s) total column-level carbon inputs (for balance check)
   real(r8), pointer :: col_coutputs(:) ! (gC/m2/s) total column-level carbon outputs (for balance check)
   real(r8), pointer :: col_begcb(:)    ! carbon mass, beginning of time step (gC/m**2)
   real(r8), pointer :: col_endcb(:)    ! carbon mass, end of time step (gC/m**2)
   real(r8), pointer :: col_errcb(:)    ! carbon balance error for the timestep (gC/m**2)
!
! !OTHER LOCAL VARIABLES:
   integer :: c,err_index  ! indices
   integer :: fc          ! lake filter indices
   logical :: err_found      ! error flag
!   real(r8):: dt             ! radiation time step (seconds)
!EOP
!-----------------------------------------------------------------------

    ! assign local pointers to column-level arrays
	totcolc                        => clm3%g%l%c%ccs%totcolc
	gpp                            => clm3%g%l%c%ccf%pcf_a%gpp
	er                             => clm3%g%l%c%ccf%er
	col_fire_closs                 => clm3%g%l%c%ccf%col_fire_closs
	col_hrv_xsmrpool_to_atm        => clm3%g%l%c%ccf%pcf_a%hrv_xsmrpool_to_atm
	dwt_closs                      => clm3%g%l%c%ccf%dwt_closs
	product_closs                  => clm3%g%l%c%ccf%product_closs
	
    col_cinputs                    => clm3%g%l%c%ccf%col_cinputs
    col_coutputs                   => clm3%g%l%c%ccf%col_coutputs
    col_begcb                      => clm3%g%l%c%ccbal%begcb
    col_endcb                      => clm3%g%l%c%ccbal%endcb
    col_errcb                      => clm3%g%l%c%ccbal%errcb

   ! set time steps
!ylu removed
!   dt = real( get_step_size(), r8 )

   err_found = .false.
   ! column loop
   do fc = 1,num_soilc
      c = filter_soilc(fc)

      ! calculate the total column-level carbon storage, for mass conservation check

      col_endcb(c) = totcolc(c)

      ! calculate total column-level inputs
	  
	  col_cinputs(c) = gpp(c)
	  
      ! calculate total column-level outputs
	  ! er = ar + hr, col_fire_closs includes pft-level fire losses

      col_coutputs(c) = er(c) + col_fire_closs(c) + dwt_closs(c) + product_closs(c) + col_hrv_xsmrpool_to_atm(c)

      ! calculate the total column-level carbon balance error for this time step

      col_errcb(c) = (col_cinputs(c) - col_coutputs(c))*dt - &
         (col_endcb(c) - col_begcb(c))

      ! check for significant errors
      if (abs(col_errcb(c)) > 1e-8_r8) then
         err_found = .true.
         err_index = c
      end if
      
   end do ! end of columns loop

   if (err_found) then
      c = err_index
      write(6,*)'column cbalance error = ', col_errcb(c), c
      write(6,*)'begcb       = ',col_begcb(c)
      write(6,*)'endcb       = ',col_endcb(c)
      write(6,*)'delta store = ',col_endcb(c)-col_begcb(c)
      write(6,*)'input mass  = ',col_cinputs(c)*dt
      write(6,*)'output mass = ',col_coutputs(c)*dt
      write(6,*)'net flux    = ',(col_cinputs(c)-col_coutputs(c))*dt
	  write(6,*)'nee         = ',clm3%g%l%c%ccf%nee(c) * dt
	  write(6,*)'gpp         = ',gpp(c) * dt
	  write(6,*)'er          = ',er(c) * dt
	  write(6,*)'col_fire_closs         = ',col_fire_closs(c) * dt
     write(6,*)'col_hrv_xsmrpool_to_atm = ',col_hrv_xsmrpool_to_atm(c) * dt
	  write(6,*)'dwt_closs         = ',dwt_closs(c) * dt
	  write(6,*)'product_closs         = ',product_closs(c) * dt
      call endrun()
   end if


end subroutine CBalanceCheck
!-----------------------------------------------------------------------

!-----------------------------------------------------------------------
!BOP
!
! !IROUTINE: NBalanceCheck
!
! !INTERFACE:
subroutine NBalanceCheck(lbc, ubc, num_soilc, filter_soilc)
!
! !DESCRIPTION:
! On the radiation time step, perform nitrogen mass conservation check
! for column and pft
!
! !USES:
   use clmtype
   use globals, only: dt
!   use clm_time_manager, only: get_step_size
!
! !ARGUMENTS:
   implicit none
   integer, intent(in) :: lbc, ubc        ! column bounds
   integer, intent(in) :: num_soilc       ! number of soil columns in filter
   integer, intent(in) :: filter_soilc(ubc-lbc+1) ! filter for soil columns
!
! !CALLED FROM:
! subroutine clm_driver1
!
! !REVISION HISTORY:
! 12/9/03: Created by Peter Thornton
!
! !LOCAL VARIABLES:
!
! local pointers to implicit in arrays
   real(r8), pointer :: totcoln(:)               ! (gN/m2) total column nitrogen, incl veg
   real(r8), pointer :: ndep_to_sminn(:)         ! atmospheric N deposition to soil mineral N (gN/m2/s)
   real(r8), pointer :: nfix_to_sminn(:)         ! symbiotic/asymbiotic N fixation to soil mineral N (gN/m2/s) 
   real(r8), pointer :: supplement_to_sminn(:)   ! supplemental N supply (gN/m2/s)
   real(r8), pointer :: denit(:)                 ! total rate of denitrification (gN/m2/s)
   real(r8), pointer :: sminn_leached(:)         ! soil mineral N pool loss to leaching (gN/m2/s)
   real(r8), pointer :: col_fire_nloss(:)        ! total column-level fire N loss (gN/m2/s)
   real(r8), pointer :: dwt_nloss(:)              ! (gN/m2/s) total nitrogen loss from product pools and conversion
   real(r8), pointer :: product_nloss(:)          ! (gN/m2/s) total wood product nitrogen loss
!
! local pointers to implicit in/out arrays
!
! local pointers to implicit out arrays
   real(r8), pointer :: col_ninputs(:)           ! column-level N inputs (gN/m2/s)
   real(r8), pointer :: col_noutputs(:)          ! column-level N outputs (gN/m2/s)
   real(r8), pointer :: col_begnb(:)             ! nitrogen mass, beginning of time step (gN/m**2)
   real(r8), pointer :: col_endnb(:)             ! nitrogen mass, end of time step (gN/m**2)
   real(r8), pointer :: col_errnb(:)             ! nitrogen balance error for the timestep (gN/m**2)
!
! !OTHER LOCAL VARIABLES:
   integer :: c,err_index    ! indices
   integer :: fc             ! lake filter indices
   logical :: err_found      ! error flag
!   real(r8):: dt             ! radiation time step (seconds)
!EOP
!-----------------------------------------------------------------------
    ! assign local pointers to column-level arrays

    totcoln                        => clm3%g%l%c%cns%totcoln
	ndep_to_sminn                  => clm3%g%l%c%cnf%ndep_to_sminn
    nfix_to_sminn                  => clm3%g%l%c%cnf%nfix_to_sminn
    supplement_to_sminn            => clm3%g%l%c%cnf%supplement_to_sminn
    denit                          => clm3%g%l%c%cnf%denit
    sminn_leached                  => clm3%g%l%c%cnf%sminn_leached
    col_fire_nloss                 => clm3%g%l%c%cnf%col_fire_nloss
    dwt_nloss                      => clm3%g%l%c%cnf%dwt_nloss
    product_nloss                  => clm3%g%l%c%cnf%product_nloss

    col_ninputs                    => clm3%g%l%c%cnf%col_ninputs
    col_noutputs                   => clm3%g%l%c%cnf%col_noutputs
    col_begnb                      => clm3%g%l%c%cnbal%begnb
    col_endnb                      => clm3%g%l%c%cnbal%endnb
    col_errnb                      => clm3%g%l%c%cnbal%errnb

   ! set time steps  
!   dt = real( get_step_size(), r8 )  !already set in globals module --ylu 10/27/10

   err_found = .false.
   ! column loop
   do fc = 1,num_soilc
      c=filter_soilc(fc)

      ! calculate the total column-level nitrogen storage, for mass conservation check

      col_endnb(c) = totcoln(c)

      ! calculate total column-level inputs

      col_ninputs(c) = ndep_to_sminn(c) + nfix_to_sminn(c) + supplement_to_sminn(c)

      ! calculate total column-level outputs

      col_noutputs(c) = denit(c) + sminn_leached(c) + col_fire_nloss(c) + dwt_nloss(c) + product_nloss(c)

      ! calculate the total column-level nitrogen balance error for this time step

      col_errnb(c) = (col_ninputs(c) - col_noutputs(c))*dt - &
         (col_endnb(c) - col_begnb(c))

      if (abs(col_errnb(c)) > 1e-8_r8) then
         err_found = .true.
         err_index = c
      end if

   end do ! end of columns loop

   if (err_found) then
      c = err_index
      write(6,*)'column nbalance error = ', col_errnb(c), c
      write(6,*)'begnb       = ',col_begnb(c)
      write(6,*)'endnb       = ',col_endnb(c)
      write(6,*)'delta store = ',col_endnb(c)-col_begnb(c)
      write(6,*)'input mass  = ',col_ninputs(c)*dt
      write(6,*)'output mass = ',col_noutputs(c)*dt
      write(6,*)'net flux    = ',(col_ninputs(c)-col_noutputs(c))*dt
      call endrun()
   end if

end subroutine NBalanceCheck
!-----------------------------------------------------------------------
#endif

end module CNBalanceCheckMod
module CNCStateUpdate1Mod
#ifdef CN

!-----------------------------------------------------------------------
!BOP
!
! !MODULE: CStateUpdate1Mod
!
! !DESCRIPTION:
! Module for carbon state variable update, non-mortality fluxes.
!
! !USES:
    use shr_kind_mod, only: r8 => shr_kind_r8
    implicit none
    save
    private
!
! !PUBLIC MEMBER FUNCTIONS:
    public:: CStateUpdate1
    public:: CStateUpdate0
!
! !REVISION HISTORY:
! 4/23/2004: Created by Peter Thornton
!
!EOP
!-----------------------------------------------------------------------

contains


!-----------------------------------------------------------------------
!BOP
!
! !IROUTINE: CStateUpdate0
!
! !INTERFACE:
subroutine CStateUpdate0(num_soilp, filter_soilp)
!
! !DESCRIPTION:
! On the radiation time step, update cpool carbon state
!
! !USES:
   use clmtype
!ylu removed
!   use clm_time_manager, only: get_step_size
  use globals, only: dt  
!
! !ARGUMENTS:
   implicit none
   integer, intent(in) :: num_soilp       ! number of soil pfts in filter
   integer, intent(in) :: filter_soilp(:) ! filter for soil pfts
!
! !CALLED FROM:
! subroutine CNEcosystemDyn
!
! !REVISION HISTORY:
! 7/1/05: Created by Peter Thornton
!
! !LOCAL VARIABLES:
! local pointers to implicit in arrays
   real(r8), pointer :: psnshade_to_cpool(:)
   real(r8), pointer :: psnsun_to_cpool(:)
!
! local pointers to implicit in/out arrays
   real(r8), pointer :: cpool(:)              ! (gC/m2) temporary photosynthate C pool
! !OTHER LOCAL VARIABLES:
   integer :: p     ! indices
   integer :: fp   ! lake filter indices
!   real(r8):: dt      ! radiation time step (seconds)
!
!EOP
!-----------------------------------------------------------------------
    ! assign local pointers at the pft level
    cpool                          => clm3%g%l%c%p%pcs%cpool
    psnshade_to_cpool              => clm3%g%l%c%p%pcf%psnshade_to_cpool
    psnsun_to_cpool                => clm3%g%l%c%p%pcf%psnsun_to_cpool

    ! set time steps
!    dt = real( get_step_size(), r8 )

    ! pft loop
    do fp = 1,num_soilp
       p = filter_soilp(fp)
       ! gross photosynthesis fluxes
       cpool(p) = cpool(p) + psnsun_to_cpool(p)*dt
       cpool(p) = cpool(p) + psnshade_to_cpool(p)*dt
    end do

end subroutine CStateUpdate0
!-----------------------------------------------------------------------

!-----------------------------------------------------------------------
!BOP
!
! !IROUTINE: CStateUpdate1
!
! !INTERFACE:
subroutine CStateUpdate1(num_soilc, filter_soilc, num_soilp, filter_soilp)
!
! !DESCRIPTION:
! On the radiation time step, update all the prognostic carbon state
! variables (except for gap-phase mortality and fire fluxes)
!
! !USES:
   use clmtype
!   use clm_time_manager, only: get_step_size
   use globals, only: dt
#if (defined CROP)
   use pftvarcon , only: npcropmin
#endif
!
! !ARGUMENTS:
   implicit none
   integer, intent(in) :: num_soilc       ! number of soil columns filter
   integer, intent(in) :: filter_soilc(:) ! filter for soil columns
   integer, intent(in) :: num_soilp       ! number of soil pfts in filter
   integer, intent(in) :: filter_soilp(:) ! filter for soil pfts
!
! !CALLED FROM:
! subroutine CNEcosystemDyn
!
! !REVISION HISTORY:
! 8/1/03: Created by Peter Thornton
! 12/5/03, Peter Thornton: Added livewood turnover fluxes
!
! !LOCAL VARIABLES:
! local pointers to implicit in arrays
!
   real(r8), pointer :: woody(:)       ! binary flag for woody lifeform (1=woody, 0=not woody)
   real(r8), pointer :: cwdc_to_litr2c(:)
   real(r8), pointer :: cwdc_to_litr3c(:)
#if (defined CROP)
   integer , pointer :: harvdate(:) ! harvest date
   real(r8), pointer :: xsmrpool_to_atm(:)
   real(r8), pointer :: grainc_to_litr1c(:)
   real(r8), pointer :: grainc_to_litr2c(:)
   real(r8), pointer :: grainc_to_litr3c(:)
   real(r8), pointer :: livestemc_to_litr1c(:)
   real(r8), pointer :: livestemc_to_litr2c(:)
   real(r8), pointer :: livestemc_to_litr3c(:)
#endif
   real(r8), pointer :: frootc_to_litr1c(:)
   real(r8), pointer :: frootc_to_litr2c(:)
   real(r8), pointer :: frootc_to_litr3c(:)
   real(r8), pointer :: leafc_to_litr1c(:)
   real(r8), pointer :: leafc_to_litr2c(:)
   real(r8), pointer :: leafc_to_litr3c(:)
   real(r8), pointer :: litr1_hr(:)
   real(r8), pointer :: litr1c_to_soil1c(:)
   real(r8), pointer :: litr2_hr(:)
   real(r8), pointer :: litr2c_to_soil2c(:)
   real(r8), pointer :: litr3_hr(:)
   real(r8), pointer :: litr3c_to_soil3c(:)
   real(r8), pointer :: soil1_hr(:)
   real(r8), pointer :: soil1c_to_soil2c(:)
   real(r8), pointer :: soil2_hr(:)
   real(r8), pointer :: soil2c_to_soil3c(:)
   real(r8), pointer :: soil3_hr(:)
   real(r8), pointer :: soil3c_to_soil4c(:)
   real(r8), pointer :: soil4_hr(:)
   real(r8), pointer :: col_ctrunc(:)    ! (gC/m2) column-level sink for C truncation
   integer , pointer :: ivt(:)           ! pft vegetation type
   real(r8), pointer :: deadcrootc_xfer_to_deadcrootc(:)
   real(r8), pointer :: deadstemc_xfer_to_deadstemc(:)
   real(r8), pointer :: frootc_xfer_to_frootc(:)
   real(r8), pointer :: leafc_xfer_to_leafc(:)
   real(r8), pointer :: livecrootc_xfer_to_livecrootc(:)
   real(r8), pointer :: livestemc_xfer_to_livestemc(:)
   real(r8), pointer :: cpool_to_xsmrpool(:)
   real(r8), pointer :: cpool_to_deadcrootc(:)
   real(r8), pointer :: cpool_to_deadcrootc_storage(:)
   real(r8), pointer :: cpool_to_deadstemc(:)
   real(r8), pointer :: cpool_to_deadstemc_storage(:)
   real(r8), pointer :: cpool_to_frootc(:)
   real(r8), pointer :: cpool_to_frootc_storage(:)
   real(r8), pointer :: cpool_to_gresp_storage(:)
   real(r8), pointer :: cpool_to_leafc(:)
   real(r8), pointer :: cpool_to_leafc_storage(:)
   real(r8), pointer :: cpool_to_livecrootc(:)
   real(r8), pointer :: cpool_to_livecrootc_storage(:)
   real(r8), pointer :: cpool_to_livestemc(:)
   real(r8), pointer :: cpool_to_livestemc_storage(:)
   real(r8), pointer :: deadcrootc_storage_to_xfer(:)
   real(r8), pointer :: deadstemc_storage_to_xfer(:)
   real(r8), pointer :: frootc_storage_to_xfer(:)
   real(r8), pointer :: frootc_to_litter(:)
   real(r8), pointer :: gresp_storage_to_xfer(:)
   real(r8), pointer :: leafc_storage_to_xfer(:)
   real(r8), pointer :: leafc_to_litter(:)
   real(r8), pointer :: livecrootc_storage_to_xfer(:)
   real(r8), pointer :: livecrootc_to_deadcrootc(:)
   real(r8), pointer :: livestemc_storage_to_xfer(:)
   real(r8), pointer :: livestemc_to_deadstemc(:)
   real(r8), pointer :: livestem_mr(:)
   real(r8), pointer :: froot_mr(:)
   real(r8), pointer :: leaf_mr(:)
   real(r8), pointer :: livecroot_mr(:)
   real(r8), pointer :: livestem_curmr(:)
   real(r8), pointer :: froot_curmr(:)
   real(r8), pointer :: leaf_curmr(:)
   real(r8), pointer :: livecroot_curmr(:)
   real(r8), pointer :: livestem_xsmr(:)
   real(r8), pointer :: froot_xsmr(:)
   real(r8), pointer :: leaf_xsmr(:)
   real(r8), pointer :: livecroot_xsmr(:)
   real(r8), pointer :: cpool_deadcroot_gr(:)
   real(r8), pointer :: cpool_deadcroot_storage_gr(:)
   real(r8), pointer :: cpool_deadstem_gr(:)
   real(r8), pointer :: cpool_deadstem_storage_gr(:)
   real(r8), pointer :: cpool_froot_gr(:)
   real(r8), pointer :: cpool_froot_storage_gr(:)
   real(r8), pointer :: cpool_leaf_gr(:)
   real(r8), pointer :: cpool_leaf_storage_gr(:)
   real(r8), pointer :: cpool_livecroot_gr(:)
   real(r8), pointer :: cpool_livecroot_storage_gr(:)
   real(r8), pointer :: cpool_livestem_gr(:)
   real(r8), pointer :: cpool_livestem_storage_gr(:)
   real(r8), pointer :: transfer_deadcroot_gr(:)
   real(r8), pointer :: transfer_deadstem_gr(:)
   real(r8), pointer :: transfer_froot_gr(:)
   real(r8), pointer :: transfer_leaf_gr(:)
   real(r8), pointer :: transfer_livecroot_gr(:)
   real(r8), pointer :: transfer_livestem_gr(:)
#if (defined CROP)
   real(r8), pointer :: cpool_to_grainc(:)
   real(r8), pointer :: cpool_to_grainc_storage(:)
   real(r8), pointer :: grainc_storage_to_xfer(:)
   real(r8), pointer :: livestemc_to_litter(:)
   real(r8), pointer :: grainc_to_food(:)
   real(r8), pointer :: grainc_xfer_to_grainc(:)
   real(r8), pointer :: cpool_grain_gr(:)
   real(r8), pointer :: cpool_grain_storage_gr(:)
   real(r8), pointer :: transfer_grain_gr(:)
#endif
!
! local pointers to implicit in/out arrays
#if (defined CROP)
   real(r8), pointer :: grainc(:)
   real(r8), pointer :: grainc_storage(:)
   real(r8), pointer :: grainc_xfer(:)
#endif
   real(r8), pointer :: cwdc(:)          ! (gC/m2) coarse woody debris C
   real(r8), pointer :: litr1c(:)        ! (gC/m2) litter labile C
   real(r8), pointer :: litr2c(:)        ! (gC/m2) litter cellulose C
   real(r8), pointer :: litr3c(:)        ! (gC/m2) litter lignin C
   real(r8), pointer :: soil1c(:)        ! (gC/m2) soil organic matter C (fast pool)
   real(r8), pointer :: soil2c(:)        ! (gC/m2) soil organic matter C (medium pool)
   real(r8), pointer :: soil3c(:)        ! (gC/m2) soil organic matter C (slow pool)
   real(r8), pointer :: soil4c(:)        ! (gC/m2) soil organic matter C (slowest pool)
   real(r8), pointer :: cpool(:)              ! (gC/m2) temporary photosynthate C pool
   real(r8), pointer :: xsmrpool(:)           ! (gC/m2) execss maint resp C pool
   real(r8), pointer :: deadcrootc(:)         ! (gC/m2) dead coarse root C
   real(r8), pointer :: deadcrootc_storage(:) ! (gC/m2) dead coarse root C storage
   real(r8), pointer :: deadcrootc_xfer(:)    ! (gC/m2) dead coarse root C transfer
   real(r8), pointer :: deadstemc(:)          ! (gC/m2) dead stem C
   real(r8), pointer :: deadstemc_storage(:)  ! (gC/m2) dead stem C storage
   real(r8), pointer :: deadstemc_xfer(:)     ! (gC/m2) dead stem C transfer
   real(r8), pointer :: frootc(:)             ! (gC/m2) fine root C
   real(r8), pointer :: frootc_storage(:)     ! (gC/m2) fine root C storage
   real(r8), pointer :: frootc_xfer(:)        ! (gC/m2) fine root C transfer
   real(r8), pointer :: gresp_storage(:)      ! (gC/m2) growth respiration storage
   real(r8), pointer :: gresp_xfer(:)         ! (gC/m2) growth respiration transfer
   real(r8), pointer :: leafc(:)              ! (gC/m2) leaf C
   real(r8), pointer :: leafc_storage(:)      ! (gC/m2) leaf C storage
   real(r8), pointer :: leafc_xfer(:)         ! (gC/m2) leaf C transfer
   real(r8), pointer :: livecrootc(:)         ! (gC/m2) live coarse root C
   real(r8), pointer :: livecrootc_storage(:) ! (gC/m2) live coarse root C storage
   real(r8), pointer :: livecrootc_xfer(:)    ! (gC/m2) live coarse root C transfer
   real(r8), pointer :: livestemc(:)          ! (gC/m2) live stem C
   real(r8), pointer :: livestemc_storage(:)  ! (gC/m2) live stem C storage
   real(r8), pointer :: livestemc_xfer(:)     ! (gC/m2) live stem C transfer
   real(r8), pointer :: pft_ctrunc(:)         ! (gC/m2) pft-level sink for C truncation

! local pointers for dynamic landcover fluxes and states
   real(r8), pointer :: dwt_seedc_to_leaf(:)
   real(r8), pointer :: dwt_seedc_to_deadstem(:)
   real(r8), pointer :: dwt_frootc_to_litr1c(:)
   real(r8), pointer :: dwt_frootc_to_litr2c(:)
   real(r8), pointer :: dwt_frootc_to_litr3c(:)
   real(r8), pointer :: dwt_livecrootc_to_cwdc(:)
   real(r8), pointer :: dwt_deadcrootc_to_cwdc(:)
   real(r8), pointer :: seedc(:)

!
! !OTHER LOCAL VARIABLES:
   integer :: c,p     ! indices
   integer :: fp,fc   ! lake filter indices
!   real(r8):: dt      ! radiation time step (seconds)
!
!EOP
!-----------------------------------------------------------------------
    ! assign local pointers
    woody                          => pftcon%woody

    ! assign local pointers at the column level
    cwdc_to_litr2c                 => clm3%g%l%c%ccf%cwdc_to_litr2c
    cwdc_to_litr3c                 => clm3%g%l%c%ccf%cwdc_to_litr3c
    frootc_to_litr1c               => clm3%g%l%c%ccf%frootc_to_litr1c
    frootc_to_litr2c               => clm3%g%l%c%ccf%frootc_to_litr2c
    frootc_to_litr3c               => clm3%g%l%c%ccf%frootc_to_litr3c
    leafc_to_litr1c                => clm3%g%l%c%ccf%leafc_to_litr1c
    leafc_to_litr2c                => clm3%g%l%c%ccf%leafc_to_litr2c
    leafc_to_litr3c                => clm3%g%l%c%ccf%leafc_to_litr3c
#if (defined CROP)
    grainc_to_litr1c               => clm3%g%l%c%ccf%grainc_to_litr1c
    grainc_to_litr2c               => clm3%g%l%c%ccf%grainc_to_litr2c
    grainc_to_litr3c               => clm3%g%l%c%ccf%grainc_to_litr3c
    livestemc_to_litr1c            => clm3%g%l%c%ccf%livestemc_to_litr1c
    livestemc_to_litr2c            => clm3%g%l%c%ccf%livestemc_to_litr2c
    livestemc_to_litr3c            => clm3%g%l%c%ccf%livestemc_to_litr3c
#endif
    litr1_hr                       => clm3%g%l%c%ccf%litr1_hr
    litr1c_to_soil1c               => clm3%g%l%c%ccf%litr1c_to_soil1c
    litr2_hr                       => clm3%g%l%c%ccf%litr2_hr
    litr2c_to_soil2c               => clm3%g%l%c%ccf%litr2c_to_soil2c
    litr3_hr                       => clm3%g%l%c%ccf%litr3_hr
    litr3c_to_soil3c               => clm3%g%l%c%ccf%litr3c_to_soil3c
    soil1_hr                       => clm3%g%l%c%ccf%soil1_hr
    soil1c_to_soil2c               => clm3%g%l%c%ccf%soil1c_to_soil2c
    soil2_hr                       => clm3%g%l%c%ccf%soil2_hr
    soil2c_to_soil3c               => clm3%g%l%c%ccf%soil2c_to_soil3c
    soil3_hr                       => clm3%g%l%c%ccf%soil3_hr
    soil3c_to_soil4c               => clm3%g%l%c%ccf%soil3c_to_soil4c
    soil4_hr                       => clm3%g%l%c%ccf%soil4_hr
    col_ctrunc                     => clm3%g%l%c%ccs%col_ctrunc
    cwdc                           => clm3%g%l%c%ccs%cwdc
    litr1c                         => clm3%g%l%c%ccs%litr1c
    litr2c                         => clm3%g%l%c%ccs%litr2c
    litr3c                         => clm3%g%l%c%ccs%litr3c
    soil1c                         => clm3%g%l%c%ccs%soil1c
    soil2c                         => clm3%g%l%c%ccs%soil2c
    soil3c                         => clm3%g%l%c%ccs%soil3c
    soil4c                         => clm3%g%l%c%ccs%soil4c
    ! new pointers for dynamic landcover
    dwt_seedc_to_leaf              => clm3%g%l%c%ccf%dwt_seedc_to_leaf
    dwt_seedc_to_deadstem          => clm3%g%l%c%ccf%dwt_seedc_to_deadstem
    dwt_frootc_to_litr1c           => clm3%g%l%c%ccf%dwt_frootc_to_litr1c
    dwt_frootc_to_litr2c           => clm3%g%l%c%ccf%dwt_frootc_to_litr2c
    dwt_frootc_to_litr3c           => clm3%g%l%c%ccf%dwt_frootc_to_litr3c
    dwt_livecrootc_to_cwdc         => clm3%g%l%c%ccf%dwt_livecrootc_to_cwdc
    dwt_deadcrootc_to_cwdc         => clm3%g%l%c%ccf%dwt_deadcrootc_to_cwdc
    seedc                          => clm3%g%l%c%ccs%seedc

    ! assign local pointers at the pft level
    ivt                            => clm3%g%l%c%p%itype
    cpool_deadcroot_gr             => clm3%g%l%c%p%pcf%cpool_deadcroot_gr
    cpool_deadcroot_storage_gr     => clm3%g%l%c%p%pcf%cpool_deadcroot_storage_gr
    cpool_deadstem_gr              => clm3%g%l%c%p%pcf%cpool_deadstem_gr
    cpool_deadstem_storage_gr      => clm3%g%l%c%p%pcf%cpool_deadstem_storage_gr
    cpool_froot_gr                 => clm3%g%l%c%p%pcf%cpool_froot_gr
    cpool_froot_storage_gr         => clm3%g%l%c%p%pcf%cpool_froot_storage_gr
    cpool_leaf_gr                  => clm3%g%l%c%p%pcf%cpool_leaf_gr
    cpool_leaf_storage_gr          => clm3%g%l%c%p%pcf%cpool_leaf_storage_gr
    cpool_livecroot_gr             => clm3%g%l%c%p%pcf%cpool_livecroot_gr
    cpool_livecroot_storage_gr     => clm3%g%l%c%p%pcf%cpool_livecroot_storage_gr
    cpool_livestem_gr              => clm3%g%l%c%p%pcf%cpool_livestem_gr
    cpool_livestem_storage_gr      => clm3%g%l%c%p%pcf%cpool_livestem_storage_gr
    cpool_to_xsmrpool              => clm3%g%l%c%p%pcf%cpool_to_xsmrpool
    cpool_to_deadcrootc            => clm3%g%l%c%p%pcf%cpool_to_deadcrootc
    cpool_to_deadcrootc_storage    => clm3%g%l%c%p%pcf%cpool_to_deadcrootc_storage
    cpool_to_deadstemc             => clm3%g%l%c%p%pcf%cpool_to_deadstemc
    cpool_to_deadstemc_storage     => clm3%g%l%c%p%pcf%cpool_to_deadstemc_storage
    cpool_to_frootc                => clm3%g%l%c%p%pcf%cpool_to_frootc
    cpool_to_frootc_storage        => clm3%g%l%c%p%pcf%cpool_to_frootc_storage
    cpool_to_gresp_storage         => clm3%g%l%c%p%pcf%cpool_to_gresp_storage
    cpool_to_leafc                 => clm3%g%l%c%p%pcf%cpool_to_leafc
    cpool_to_leafc_storage         => clm3%g%l%c%p%pcf%cpool_to_leafc_storage
    cpool_to_livecrootc            => clm3%g%l%c%p%pcf%cpool_to_livecrootc
    cpool_to_livecrootc_storage    => clm3%g%l%c%p%pcf%cpool_to_livecrootc_storage
    cpool_to_livestemc             => clm3%g%l%c%p%pcf%cpool_to_livestemc
    cpool_to_livestemc_storage     => clm3%g%l%c%p%pcf%cpool_to_livestemc_storage
    deadcrootc_storage_to_xfer     => clm3%g%l%c%p%pcf%deadcrootc_storage_to_xfer
    deadcrootc_xfer_to_deadcrootc  => clm3%g%l%c%p%pcf%deadcrootc_xfer_to_deadcrootc
    deadstemc_storage_to_xfer      => clm3%g%l%c%p%pcf%deadstemc_storage_to_xfer
    deadstemc_xfer_to_deadstemc    => clm3%g%l%c%p%pcf%deadstemc_xfer_to_deadstemc
    froot_mr                       => clm3%g%l%c%p%pcf%froot_mr
    froot_curmr                    => clm3%g%l%c%p%pcf%froot_curmr
    froot_xsmr                     => clm3%g%l%c%p%pcf%froot_xsmr
    frootc_storage_to_xfer         => clm3%g%l%c%p%pcf%frootc_storage_to_xfer
    frootc_to_litter               => clm3%g%l%c%p%pcf%frootc_to_litter
    frootc_xfer_to_frootc          => clm3%g%l%c%p%pcf%frootc_xfer_to_frootc
    gresp_storage_to_xfer          => clm3%g%l%c%p%pcf%gresp_storage_to_xfer
    leaf_mr                        => clm3%g%l%c%p%pcf%leaf_mr
    leaf_curmr                     => clm3%g%l%c%p%pcf%leaf_curmr
    leaf_xsmr                      => clm3%g%l%c%p%pcf%leaf_xsmr
    leafc_storage_to_xfer          => clm3%g%l%c%p%pcf%leafc_storage_to_xfer
    leafc_to_litter                => clm3%g%l%c%p%pcf%leafc_to_litter
    leafc_xfer_to_leafc            => clm3%g%l%c%p%pcf%leafc_xfer_to_leafc
    livecroot_mr                   => clm3%g%l%c%p%pcf%livecroot_mr
    livecroot_curmr                => clm3%g%l%c%p%pcf%livecroot_curmr
    livecroot_xsmr                 => clm3%g%l%c%p%pcf%livecroot_xsmr
    livecrootc_storage_to_xfer     => clm3%g%l%c%p%pcf%livecrootc_storage_to_xfer
    livecrootc_to_deadcrootc       => clm3%g%l%c%p%pcf%livecrootc_to_deadcrootc
    livecrootc_xfer_to_livecrootc  => clm3%g%l%c%p%pcf%livecrootc_xfer_to_livecrootc
    livestem_mr                    => clm3%g%l%c%p%pcf%livestem_mr
    livestem_curmr                 => clm3%g%l%c%p%pcf%livestem_curmr
    livestem_xsmr                  => clm3%g%l%c%p%pcf%livestem_xsmr
    livestemc_storage_to_xfer      => clm3%g%l%c%p%pcf%livestemc_storage_to_xfer
    livestemc_to_deadstemc         => clm3%g%l%c%p%pcf%livestemc_to_deadstemc
    livestemc_xfer_to_livestemc    => clm3%g%l%c%p%pcf%livestemc_xfer_to_livestemc
    transfer_deadcroot_gr          => clm3%g%l%c%p%pcf%transfer_deadcroot_gr
    transfer_deadstem_gr           => clm3%g%l%c%p%pcf%transfer_deadstem_gr
    transfer_froot_gr              => clm3%g%l%c%p%pcf%transfer_froot_gr
    transfer_leaf_gr               => clm3%g%l%c%p%pcf%transfer_leaf_gr
    transfer_livecroot_gr          => clm3%g%l%c%p%pcf%transfer_livecroot_gr
    transfer_livestem_gr           => clm3%g%l%c%p%pcf%transfer_livestem_gr
#if (defined CROP)
    harvdate                       => clm3%g%l%c%p%pps%harvdate
    xsmrpool_to_atm                => clm3%g%l%c%p%pcf%xsmrpool_to_atm
    cpool_grain_gr                 => clm3%g%l%c%p%pcf%cpool_grain_gr
    cpool_grain_storage_gr         => clm3%g%l%c%p%pcf%cpool_grain_storage_gr
    cpool_to_grainc                => clm3%g%l%c%p%pcf%cpool_to_grainc
    cpool_to_grainc_storage        => clm3%g%l%c%p%pcf%cpool_to_grainc_storage
    livestemc_to_litter            => clm3%g%l%c%p%pcf%livestemc_to_litter
    grainc_storage_to_xfer         => clm3%g%l%c%p%pcf%grainc_storage_to_xfer
    grainc_to_food                 => clm3%g%l%c%p%pcf%grainc_to_food
    grainc_xfer_to_grainc          => clm3%g%l%c%p%pcf%grainc_xfer_to_grainc
    transfer_grain_gr              => clm3%g%l%c%p%pcf%transfer_grain_gr
    grainc                         => clm3%g%l%c%p%pcs%grainc
    grainc_storage                 => clm3%g%l%c%p%pcs%grainc_storage
    grainc_xfer                    => clm3%g%l%c%p%pcs%grainc_xfer
#endif
    cpool                          => clm3%g%l%c%p%pcs%cpool
    xsmrpool                          => clm3%g%l%c%p%pcs%xsmrpool
    deadcrootc                     => clm3%g%l%c%p%pcs%deadcrootc
    deadcrootc_storage             => clm3%g%l%c%p%pcs%deadcrootc_storage
    deadcrootc_xfer                => clm3%g%l%c%p%pcs%deadcrootc_xfer
    deadstemc                      => clm3%g%l%c%p%pcs%deadstemc
    deadstemc_storage              => clm3%g%l%c%p%pcs%deadstemc_storage
    deadstemc_xfer                 => clm3%g%l%c%p%pcs%deadstemc_xfer
    frootc                         => clm3%g%l%c%p%pcs%frootc
    frootc_storage                 => clm3%g%l%c%p%pcs%frootc_storage
    frootc_xfer                    => clm3%g%l%c%p%pcs%frootc_xfer
    gresp_storage                  => clm3%g%l%c%p%pcs%gresp_storage
    gresp_xfer                     => clm3%g%l%c%p%pcs%gresp_xfer
    leafc                          => clm3%g%l%c%p%pcs%leafc
    leafc_storage                  => clm3%g%l%c%p%pcs%leafc_storage
    leafc_xfer                     => clm3%g%l%c%p%pcs%leafc_xfer
    livecrootc                     => clm3%g%l%c%p%pcs%livecrootc
    livecrootc_storage             => clm3%g%l%c%p%pcs%livecrootc_storage
    livecrootc_xfer                => clm3%g%l%c%p%pcs%livecrootc_xfer
    livestemc                      => clm3%g%l%c%p%pcs%livestemc
    livestemc_storage              => clm3%g%l%c%p%pcs%livestemc_storage
    livestemc_xfer                 => clm3%g%l%c%p%pcs%livestemc_xfer
    pft_ctrunc                     => clm3%g%l%c%p%pcs%pft_ctrunc

    ! set time steps
!    dt = real( get_step_size(), r8 )

    ! column loop
    do fc = 1,num_soilc
       c = filter_soilc(fc)
 
       ! column level fluxes
 
       ! plant to litter fluxes
       ! leaf litter
       litr1c(c) = litr1c(c) + leafc_to_litr1c(c)*dt
       litr2c(c) = litr2c(c) + leafc_to_litr2c(c)*dt
       litr3c(c) = litr3c(c) + leafc_to_litr3c(c)*dt
       ! fine root litter
       litr1c(c) = litr1c(c) + frootc_to_litr1c(c)*dt
       litr2c(c) = litr2c(c) + frootc_to_litr2c(c)*dt
       litr3c(c) = litr3c(c) + frootc_to_litr3c(c)*dt
#if (defined CROP)
       ! livestem litter
       litr1c(c) = litr1c(c) + livestemc_to_litr1c(c)*dt
       litr2c(c) = litr2c(c) + livestemc_to_litr2c(c)*dt
       litr3c(c) = litr3c(c) + livestemc_to_litr3c(c)*dt
       ! grain litter
       litr1c(c) = litr1c(c) + grainc_to_litr1c(c)*dt
       litr2c(c) = litr2c(c) + grainc_to_litr2c(c)*dt
       litr3c(c) = litr3c(c) + grainc_to_litr3c(c)*dt
#endif
       
       ! seeding fluxes, from dynamic landcover
	    seedc(c) = seedc(c) - dwt_seedc_to_leaf(c) * dt
	    seedc(c) = seedc(c) - dwt_seedc_to_deadstem(c) * dt
	   
	    ! fluxes into litter and CWD, from dynamic landcover
       litr1c(c) = litr1c(c) + dwt_frootc_to_litr1c(c)*dt
       litr2c(c) = litr2c(c) + dwt_frootc_to_litr2c(c)*dt
       litr3c(c) = litr3c(c) + dwt_frootc_to_litr3c(c)*dt
       cwdc(c)   = cwdc(c)   + dwt_livecrootc_to_cwdc(c)*dt
       cwdc(c)   = cwdc(c)   + dwt_deadcrootc_to_cwdc(c)*dt
       
       ! litter and SOM HR fluxes
       litr1c(c) = litr1c(c) - litr1_hr(c)*dt
       litr2c(c) = litr2c(c) - litr2_hr(c)*dt
       litr3c(c) = litr3c(c) - litr3_hr(c)*dt
       soil1c(c) = soil1c(c) - soil1_hr(c)*dt
       soil2c(c) = soil2c(c) - soil2_hr(c)*dt
       soil3c(c) = soil3c(c) - soil3_hr(c)*dt
       soil4c(c) = soil4c(c) - soil4_hr(c)*dt
 
       ! CWD to litter fluxes
       cwdc(c)   = cwdc(c)   - cwdc_to_litr2c(c)*dt
       litr2c(c) = litr2c(c) + cwdc_to_litr2c(c)*dt
       cwdc(c)   = cwdc(c)   - cwdc_to_litr3c(c)*dt
       litr3c(c) = litr3c(c) + cwdc_to_litr3c(c)*dt
 
       ! litter to SOM fluxes
       litr1c(c) = litr1c(c) - litr1c_to_soil1c(c)*dt
       soil1c(c) = soil1c(c) + litr1c_to_soil1c(c)*dt
       litr2c(c) = litr2c(c) - litr2c_to_soil2c(c)*dt
       soil2c(c) = soil2c(c) + litr2c_to_soil2c(c)*dt
       litr3c(c) = litr3c(c) - litr3c_to_soil3c(c)*dt
       soil3c(c) = soil3c(c) + litr3c_to_soil3c(c)*dt
 
       ! SOM to SOM fluxes
       soil1c(c) = soil1c(c) - soil1c_to_soil2c(c)*dt
       soil2c(c) = soil2c(c) + soil1c_to_soil2c(c)*dt
       soil2c(c) = soil2c(c) - soil2c_to_soil3c(c)*dt
       soil3c(c) = soil3c(c) + soil2c_to_soil3c(c)*dt
       soil3c(c) = soil3c(c) - soil3c_to_soil4c(c)*dt
       soil4c(c) = soil4c(c) + soil3c_to_soil4c(c)*dt
 
    end do ! end of columns loop
 
    ! pft loop
    do fp = 1,num_soilp
       p = filter_soilp(fp)
 
       ! phenology: transfer growth fluxes
       leafc(p)           = leafc(p)       + leafc_xfer_to_leafc(p)*dt
       leafc_xfer(p)      = leafc_xfer(p)  - leafc_xfer_to_leafc(p)*dt
       frootc(p)          = frootc(p)      + frootc_xfer_to_frootc(p)*dt
       frootc_xfer(p)     = frootc_xfer(p) - frootc_xfer_to_frootc(p)*dt
       if (woody(ivt(p)) == 1._r8) then
           livestemc(p)       = livestemc(p)           + livestemc_xfer_to_livestemc(p)*dt
           livestemc_xfer(p)  = livestemc_xfer(p)  - livestemc_xfer_to_livestemc(p)*dt
           write(6,*) 'in CNCStateUpdate1Mod,before,deadstemc(',p,')=',deadstemc(p)
           deadstemc(p)       = deadstemc(p)           + deadstemc_xfer_to_deadstemc(p)*dt
           write(6,*) 'in CNCStateUpdate1Mod,deadstemc_xfer_to_deadstemc(',p,')=',deadstemc_xfer_to_deadstemc(p)
           write(6,*) 'in CNCStateUpdate1Mod,after, deadstemc(',p,')=',deadstemc(p) 
           deadstemc_xfer(p)  = deadstemc_xfer(p)  - deadstemc_xfer_to_deadstemc(p)*dt
           livecrootc(p)      = livecrootc(p)          + livecrootc_xfer_to_livecrootc(p)*dt
           livecrootc_xfer(p) = livecrootc_xfer(p) - livecrootc_xfer_to_livecrootc(p)*dt
           deadcrootc(p)      = deadcrootc(p)          + deadcrootc_xfer_to_deadcrootc(p)*dt
           deadcrootc_xfer(p) = deadcrootc_xfer(p) - deadcrootc_xfer_to_deadcrootc(p)*dt
       end if
#if (defined CROP)
       if (ivt(p) >= npcropmin) then ! skip 2 generic crops
           ! lines here for consistency; the transfer terms are zero
           livestemc(p)       = livestemc(p)      + livestemc_xfer_to_livestemc(p)*dt
           livestemc_xfer(p)  = livestemc_xfer(p) - livestemc_xfer_to_livestemc(p)*dt
           grainc(p)          = grainc(p)         + grainc_xfer_to_grainc(p)*dt
           grainc_xfer(p)     = grainc_xfer(p)    - grainc_xfer_to_grainc(p)*dt
       end if
#endif
 
       ! phenology: litterfall fluxes
       leafc(p) = leafc(p) - leafc_to_litter(p)*dt
       frootc(p) = frootc(p) - frootc_to_litter(p)*dt
 
       ! livewood turnover fluxes
       if (woody(ivt(p)) == 1._r8) then
           livestemc(p)  = livestemc(p)  - livestemc_to_deadstemc(p)*dt
           deadstemc(p)  = deadstemc(p)  + livestemc_to_deadstemc(p)*dt
            write(6,*) 'in CNCStateUpdate1Mod,livestemc_to_deadstemc(',p,')=',livestemc_to_deadstemc(p)
            write(6,*) 'in CNCStateUpdate1Mod,after, deadstemc(',p,')=',deadstemc(p)
           livecrootc(p) = livecrootc(p) - livecrootc_to_deadcrootc(p)*dt
           deadcrootc(p) = deadcrootc(p) + livecrootc_to_deadcrootc(p)*dt
       end if
#if (defined CROP)
       if (ivt(p) >= npcropmin) then ! skip 2 generic crops
           livestemc(p)  = livestemc(p)  - livestemc_to_litter(p)*dt
           grainc(p)     = grainc(p)     - grainc_to_food(p)*dt
       end if
#endif

       ! maintenance respiration fluxes from cpool
       cpool(p) = cpool(p) - cpool_to_xsmrpool(p)*dt
       cpool(p) = cpool(p) - leaf_curmr(p)*dt
       cpool(p) = cpool(p) - froot_curmr(p)*dt
       if (woody(ivt(p)) == 1._r8) then
           cpool(p) = cpool(p) - livestem_curmr(p)*dt
           cpool(p) = cpool(p) - livecroot_curmr(p)*dt
       end if
#if (defined CROP)
       if (ivt(p) >= npcropmin) then ! skip 2 generic crops
           cpool(p) = cpool(p) - livestem_curmr(p)*dt
       end if
#endif
       ! maintenance respiration fluxes from xsmrpool
       xsmrpool(p) = xsmrpool(p) + cpool_to_xsmrpool(p)*dt
       xsmrpool(p) = xsmrpool(p) - leaf_xsmr(p)*dt
       xsmrpool(p) = xsmrpool(p) - froot_xsmr(p)*dt
       if (woody(ivt(p)) == 1._r8) then
           xsmrpool(p) = xsmrpool(p) - livestem_xsmr(p)*dt
           xsmrpool(p) = xsmrpool(p) - livecroot_xsmr(p)*dt
       end if
#if (defined CROP)
       if (ivt(p) >= npcropmin) then ! skip 2 generic crops
           xsmrpool(p) = xsmrpool(p) - livestem_xsmr(p)*dt
           if (harvdate(p) < 999) then ! beginning at harvest, send to atm
              xsmrpool_to_atm(p) = xsmrpool_to_atm(p) + xsmrpool(p)/dt
              xsmrpool(p) = xsmrpool(p) - xsmrpool_to_atm(p)*dt
           end if
       end if
#endif
 
       ! allocation fluxes
       cpool(p)           = cpool(p)          - cpool_to_leafc(p)*dt
       leafc(p)           = leafc(p)          + cpool_to_leafc(p)*dt
       cpool(p)           = cpool(p)          - cpool_to_leafc_storage(p)*dt
       leafc_storage(p)   = leafc_storage(p)  + cpool_to_leafc_storage(p)*dt
       cpool(p)           = cpool(p)          - cpool_to_frootc(p)*dt
       frootc(p)          = frootc(p)         + cpool_to_frootc(p)*dt
       cpool(p)           = cpool(p)          - cpool_to_frootc_storage(p)*dt
       frootc_storage(p)  = frootc_storage(p) + cpool_to_frootc_storage(p)*dt
       write(6,*) 'm1 cpool(',p,')=',cpool(p)
       if (woody(ivt(p)) == 1._r8) then
           cpool(p)               = cpool(p)              - cpool_to_livestemc(p)*dt
           livestemc(p)           = livestemc(p)          + cpool_to_livestemc(p)*dt
           cpool(p)               = cpool(p)              - cpool_to_livestemc_storage(p)*dt
           livestemc_storage(p)   = livestemc_storage(p)  + cpool_to_livestemc_storage(p)*dt
           cpool(p)               = cpool(p)              - cpool_to_deadstemc(p)*dt
           deadstemc(p)           = deadstemc(p)          + cpool_to_deadstemc(p)*dt
           write(6,*) 'cpool_to_deadstemc(',p,')=',cpool_to_deadstemc(p)
           write(6,*) 'deadstemc(',p,')=',deadstemc(p)
           write(6,*) 'm2 cpool=',cpool
           cpool(p)               = cpool(p)              - cpool_to_deadstemc_storage(p)*dt
           deadstemc_storage(p)   = deadstemc_storage(p)  + cpool_to_deadstemc_storage(p)*dt
           cpool(p)               = cpool(p)              - cpool_to_livecrootc(p)*dt
           livecrootc(p)          = livecrootc(p)         + cpool_to_livecrootc(p)*dt
           cpool(p)               = cpool(p)              - cpool_to_livecrootc_storage(p)*dt
           livecrootc_storage(p)  = livecrootc_storage(p) + cpool_to_livecrootc_storage(p)*dt
           cpool(p)               = cpool(p)              - cpool_to_deadcrootc(p)*dt
           deadcrootc(p)          = deadcrootc(p)         + cpool_to_deadcrootc(p)*dt
           cpool(p)               = cpool(p)              - cpool_to_deadcrootc_storage(p)*dt
           deadcrootc_storage(p)  = deadcrootc_storage(p) + cpool_to_deadcrootc_storage(p)*dt
       end if
#if (defined CROP)
       if (ivt(p) >= npcropmin) then ! skip 2 generic crops
           cpool(p)               = cpool(p)              - cpool_to_livestemc(p)*dt
           livestemc(p)           = livestemc(p)          + cpool_to_livestemc(p)*dt
           cpool(p)               = cpool(p)              - cpool_to_livestemc_storage(p)*dt
           livestemc_storage(p)   = livestemc_storage(p)  + cpool_to_livestemc_storage(p)*dt
           cpool(p)               = cpool(p)              - cpool_to_grainc(p)*dt
           grainc(p)              = grainc(p)             + cpool_to_grainc(p)*dt
           cpool(p)               = cpool(p)              - cpool_to_grainc_storage(p)*dt
           grainc_storage(p)      = grainc_storage(p)     + cpool_to_grainc_storage(p)*dt
       end if
#endif
         write(6,*) 'm3 cpool=',cpool
 

       ! growth respiration fluxes for current growth
       cpool(p) = cpool(p) - cpool_leaf_gr(p)*dt
       cpool(p) = cpool(p) - cpool_froot_gr(p)*dt
       if (woody(ivt(p)) == 1._r8) then
           cpool(p) = cpool(p) - cpool_livestem_gr(p)*dt
           cpool(p) = cpool(p) - cpool_deadstem_gr(p)*dt
           cpool(p) = cpool(p) - cpool_livecroot_gr(p)*dt
           cpool(p) = cpool(p) - cpool_deadcroot_gr(p)*dt
       end if
#if (defined CROP)
       if (ivt(p) >= npcropmin) then ! skip 2 generic crops
           cpool(p) = cpool(p) - cpool_livestem_gr(p)*dt
           cpool(p) = cpool(p) - cpool_grain_gr(p)*dt
       end if
#endif
 
       ! growth respiration for transfer growth
       gresp_xfer(p) = gresp_xfer(p) - transfer_leaf_gr(p)*dt
       gresp_xfer(p) = gresp_xfer(p) - transfer_froot_gr(p)*dt
       if (woody(ivt(p)) == 1._r8) then
           gresp_xfer(p) = gresp_xfer(p) - transfer_livestem_gr(p)*dt
           gresp_xfer(p) = gresp_xfer(p) - transfer_deadstem_gr(p)*dt
           gresp_xfer(p) = gresp_xfer(p) - transfer_livecroot_gr(p)*dt
           gresp_xfer(p) = gresp_xfer(p) - transfer_deadcroot_gr(p)*dt
       end if
#if (defined CROP)
       if (ivt(p) >= npcropmin) then ! skip 2 generic crops
           gresp_xfer(p) = gresp_xfer(p) - transfer_livestem_gr(p)*dt
           gresp_xfer(p) = gresp_xfer(p) - transfer_grain_gr(p)*dt
       end if
#endif
 
       ! growth respiration at time of storage
       cpool(p) = cpool(p) - cpool_leaf_storage_gr(p)*dt
       cpool(p) = cpool(p) - cpool_froot_storage_gr(p)*dt
       if (woody(ivt(p)) == 1._r8) then
           cpool(p) = cpool(p) - cpool_livestem_storage_gr(p)*dt
           cpool(p) = cpool(p) - cpool_deadstem_storage_gr(p)*dt
           cpool(p) = cpool(p) - cpool_livecroot_storage_gr(p)*dt
           cpool(p) = cpool(p) - cpool_deadcroot_storage_gr(p)*dt
       end if
#if (defined CROP)
       if (ivt(p) >= npcropmin) then ! skip 2 generic crops
           cpool(p) = cpool(p) - cpool_livestem_storage_gr(p)*dt
           cpool(p) = cpool(p) - cpool_grain_storage_gr(p)*dt
       end if
#endif
 
       ! growth respiration stored for release during transfer growth
       cpool(p)         = cpool(p)         - cpool_to_gresp_storage(p)*dt
       gresp_storage(p) = gresp_storage(p) + cpool_to_gresp_storage(p)*dt
 
       ! move storage pools into transfer pools
       leafc_storage(p)   = leafc_storage(p)   - leafc_storage_to_xfer(p)*dt
       leafc_xfer(p)  = leafc_xfer(p)  + leafc_storage_to_xfer(p)*dt
       frootc_storage(p)  = frootc_storage(p)  - frootc_storage_to_xfer(p)*dt
       frootc_xfer(p) = frootc_xfer(p) + frootc_storage_to_xfer(p)*dt
       if (woody(ivt(p)) == 1._r8) then
           livestemc_storage(p)  = livestemc_storage(p)   - livestemc_storage_to_xfer(p)*dt
           livestemc_xfer(p)     = livestemc_xfer(p)  + livestemc_storage_to_xfer(p)*dt
           deadstemc_storage(p)  = deadstemc_storage(p)   - deadstemc_storage_to_xfer(p)*dt
           deadstemc_xfer(p)     = deadstemc_xfer(p)  + deadstemc_storage_to_xfer(p)*dt
           livecrootc_storage(p) = livecrootc_storage(p)  - livecrootc_storage_to_xfer(p)*dt
           livecrootc_xfer(p)    = livecrootc_xfer(p) + livecrootc_storage_to_xfer(p)*dt
           deadcrootc_storage(p) = deadcrootc_storage(p)  - deadcrootc_storage_to_xfer(p)*dt
           deadcrootc_xfer(p)    = deadcrootc_xfer(p) + deadcrootc_storage_to_xfer(p)*dt
           gresp_storage(p)      = gresp_storage(p)       - gresp_storage_to_xfer(p)*dt
           gresp_xfer(p)         = gresp_xfer(p)      + gresp_storage_to_xfer(p)*dt
       end if
#if (defined CROP)
       if (ivt(p) >= npcropmin) then ! skip 2 generic crops
           ! lines here for consistency; the transfer terms are zero
           livestemc_storage(p)  = livestemc_storage(p) - livestemc_storage_to_xfer(p)*dt
           livestemc_xfer(p)     = livestemc_xfer(p)    + livestemc_storage_to_xfer(p)*dt
           grainc_storage(p)     = grainc_storage(p)    - grainc_storage_to_xfer(p)*dt
           grainc_xfer(p)        = grainc_xfer(p)       + grainc_storage_to_xfer(p)*dt
       end if
#endif
 
    end do ! end of pft loop


end subroutine CStateUpdate1
!-----------------------------------------------------------------------
#endif

end module CNCStateUpdate1Mod
module CNCStateUpdate2Mod
#ifdef CN

!-----------------------------------------------------------------------
!BOP
!
! !MODULE: CStateUpdate2Mod
!
! !DESCRIPTION:
! Module for carbon state variable update, mortality fluxes.
!
! !USES:
    use shr_kind_mod, only: r8 => shr_kind_r8
    implicit none
    save
    private
! !PUBLIC MEMBER FUNCTIONS:
    public:: CStateUpdate2
    public:: CStateUpdate2h
!
! !REVISION HISTORY:
! 4/23/2004: Created by Peter Thornton
!
!EOP
!-----------------------------------------------------------------------

contains

!-----------------------------------------------------------------------
!BOP
!
! !IROUTINE: CStateUpdate2
!
! !INTERFACE:
subroutine CStateUpdate2(num_soilc, filter_soilc, num_soilp, filter_soilp)
!
! !DESCRIPTION:
! On the radiation time step, update all the prognostic carbon state
! variables affected by gap-phase mortality fluxes
!
! !USES:
   use clmtype
!   use clm_time_manager, only: get_step_size
   use globals, only: dt
!
! !ARGUMENTS:
   implicit none
   integer, intent(in) :: num_soilc       ! number of soil columns in filter
   integer, intent(in) :: filter_soilc(:) ! filter for soil columns
   integer, intent(in) :: num_soilp       ! number of soil pfts in filter
   integer, intent(in) :: filter_soilp(:) ! filter for soil pfts
!
! !CALLED FROM:
! subroutine CNEcosystemDyn
!
! !REVISION HISTORY:
! 3/29/04: Created by Peter Thornton
!
! !LOCAL VARIABLES:
! local pointers to implicit in arrays
   real(r8), pointer :: m_deadcrootc_storage_to_litr1c(:)
   real(r8), pointer :: m_deadcrootc_to_cwdc(:)
   real(r8), pointer :: m_deadcrootc_xfer_to_litr1c(:)
   real(r8), pointer :: m_deadstemc_storage_to_litr1c(:)
   real(r8), pointer :: m_deadstemc_to_cwdc(:)
   real(r8), pointer :: m_deadstemc_xfer_to_litr1c(:)
   real(r8), pointer :: m_frootc_storage_to_litr1c(:)
   real(r8), pointer :: m_frootc_to_litr1c(:)
   real(r8), pointer :: m_frootc_to_litr2c(:)
   real(r8), pointer :: m_frootc_to_litr3c(:)
   real(r8), pointer :: m_frootc_xfer_to_litr1c(:)
   real(r8), pointer :: m_gresp_storage_to_litr1c(:)
   real(r8), pointer :: m_gresp_xfer_to_litr1c(:)
   real(r8), pointer :: m_leafc_storage_to_litr1c(:)
   real(r8), pointer :: m_leafc_to_litr1c(:)
   real(r8), pointer :: m_leafc_to_litr2c(:)
   real(r8), pointer :: m_leafc_to_litr3c(:)
   real(r8), pointer :: m_leafc_xfer_to_litr1c(:)
   real(r8), pointer :: m_livecrootc_storage_to_litr1c(:)
   real(r8), pointer :: m_livecrootc_to_cwdc(:)
   real(r8), pointer :: m_livecrootc_xfer_to_litr1c(:)
   real(r8), pointer :: m_livestemc_storage_to_litr1c(:)
   real(r8), pointer :: m_livestemc_to_cwdc(:)
   real(r8), pointer :: m_livestemc_xfer_to_litr1c(:)
   real(r8), pointer :: m_deadcrootc_storage_to_litter(:)
   real(r8), pointer :: m_deadcrootc_to_litter(:)
   real(r8), pointer :: m_deadcrootc_xfer_to_litter(:)
   real(r8), pointer :: m_deadstemc_storage_to_litter(:)
   real(r8), pointer :: m_deadstemc_to_litter(:)
   real(r8), pointer :: m_deadstemc_xfer_to_litter(:)
   real(r8), pointer :: m_frootc_storage_to_litter(:)
   real(r8), pointer :: m_frootc_to_litter(:)
   real(r8), pointer :: m_frootc_xfer_to_litter(:)
   real(r8), pointer :: m_gresp_storage_to_litter(:)
   real(r8), pointer :: m_gresp_xfer_to_litter(:)
   real(r8), pointer :: m_leafc_storage_to_litter(:)
   real(r8), pointer :: m_leafc_to_litter(:)
   real(r8), pointer :: m_leafc_xfer_to_litter(:)
   real(r8), pointer :: m_livecrootc_storage_to_litter(:)
   real(r8), pointer :: m_livecrootc_to_litter(:)
   real(r8), pointer :: m_livecrootc_xfer_to_litter(:)
   real(r8), pointer :: m_livestemc_storage_to_litter(:)
   real(r8), pointer :: m_livestemc_to_litter(:)
   real(r8), pointer :: m_livestemc_xfer_to_litter(:)
!
! local pointers to implicit in/out arrays
   real(r8), pointer :: cwdc(:)               ! (gC/m2) coarse woody debris C
   real(r8), pointer :: litr1c(:)             ! (gC/m2) litter labile C
   real(r8), pointer :: litr2c(:)             ! (gC/m2) litter cellulose C
   real(r8), pointer :: litr3c(:)             ! (gC/m2) litter lignin C
   real(r8), pointer :: deadcrootc(:)         ! (gC/m2) dead coarse root C
   real(r8), pointer :: deadcrootc_storage(:) ! (gC/m2) dead coarse root C storage
   real(r8), pointer :: deadcrootc_xfer(:)    !(gC/m2) dead coarse root C transfer
   real(r8), pointer :: deadstemc(:)          ! (gC/m2) dead stem C
   real(r8), pointer :: deadstemc_storage(:)  ! (gC/m2) dead stem C storage
   real(r8), pointer :: deadstemc_xfer(:)     ! (gC/m2) dead stem C transfer
   real(r8), pointer :: frootc(:)             ! (gC/m2) fine root C
   real(r8), pointer :: frootc_storage(:)     ! (gC/m2) fine root C storage
   real(r8), pointer :: frootc_xfer(:)        ! (gC/m2) fine root C transfer
   real(r8), pointer :: gresp_storage(:)      ! (gC/m2) growth respiration storage
   real(r8), pointer :: gresp_xfer(:)         ! (gC/m2) growth respiration transfer
   real(r8), pointer :: leafc(:)              ! (gC/m2) leaf C
   real(r8), pointer :: leafc_storage(:)      ! (gC/m2) leaf C storage
   real(r8), pointer :: leafc_xfer(:)         ! (gC/m2) leaf C transfer
   real(r8), pointer :: livecrootc(:)         ! (gC/m2) live coarse root C
   real(r8), pointer :: livecrootc_storage(:) ! (gC/m2) live coarse root C storage
   real(r8), pointer :: livecrootc_xfer(:)    !(gC/m2) live coarse root C transfer
   real(r8), pointer :: livestemc(:)          ! (gC/m2) live stem C
   real(r8), pointer :: livestemc_storage(:)  ! (gC/m2) live stem C storage
   real(r8), pointer :: livestemc_xfer(:)     ! (gC/m2) live stem C transfer
!
!
! local pointers to implicit out arrays
!
!
! !OTHER LOCAL VARIABLES:
   integer :: c,p      ! indices
   integer :: fp,fc    ! lake filter indices
!   real(r8):: dt       ! radiation time step (seconds)
!
!EOP
!-----------------------------------------------------------------------
    ! assign local pointers at the column level
    m_deadcrootc_storage_to_litr1c => clm3%g%l%c%ccf%m_deadcrootc_storage_to_litr1c
    m_deadcrootc_to_cwdc           => clm3%g%l%c%ccf%m_deadcrootc_to_cwdc
    m_deadcrootc_xfer_to_litr1c    => clm3%g%l%c%ccf%m_deadcrootc_xfer_to_litr1c
    m_deadstemc_storage_to_litr1c  => clm3%g%l%c%ccf%m_deadstemc_storage_to_litr1c
    m_deadstemc_to_cwdc            => clm3%g%l%c%ccf%m_deadstemc_to_cwdc
    m_deadstemc_xfer_to_litr1c     => clm3%g%l%c%ccf%m_deadstemc_xfer_to_litr1c
    m_frootc_storage_to_litr1c     => clm3%g%l%c%ccf%m_frootc_storage_to_litr1c
    m_frootc_to_litr1c             => clm3%g%l%c%ccf%m_frootc_to_litr1c
    m_frootc_to_litr2c             => clm3%g%l%c%ccf%m_frootc_to_litr2c
    m_frootc_to_litr3c             => clm3%g%l%c%ccf%m_frootc_to_litr3c
    m_frootc_xfer_to_litr1c        => clm3%g%l%c%ccf%m_frootc_xfer_to_litr1c
    m_gresp_storage_to_litr1c      => clm3%g%l%c%ccf%m_gresp_storage_to_litr1c
    m_gresp_xfer_to_litr1c         => clm3%g%l%c%ccf%m_gresp_xfer_to_litr1c
    m_leafc_storage_to_litr1c      => clm3%g%l%c%ccf%m_leafc_storage_to_litr1c
    m_leafc_to_litr1c              => clm3%g%l%c%ccf%m_leafc_to_litr1c
    m_leafc_to_litr2c              => clm3%g%l%c%ccf%m_leafc_to_litr2c
    m_leafc_to_litr3c              => clm3%g%l%c%ccf%m_leafc_to_litr3c
    m_leafc_xfer_to_litr1c         => clm3%g%l%c%ccf%m_leafc_xfer_to_litr1c
    m_livecrootc_storage_to_litr1c => clm3%g%l%c%ccf%m_livecrootc_storage_to_litr1c
    m_livecrootc_to_cwdc           => clm3%g%l%c%ccf%m_livecrootc_to_cwdc
    m_livecrootc_xfer_to_litr1c    => clm3%g%l%c%ccf%m_livecrootc_xfer_to_litr1c
    m_livestemc_storage_to_litr1c  => clm3%g%l%c%ccf%m_livestemc_storage_to_litr1c
    m_livestemc_to_cwdc            => clm3%g%l%c%ccf%m_livestemc_to_cwdc
    m_livestemc_xfer_to_litr1c     => clm3%g%l%c%ccf%m_livestemc_xfer_to_litr1c
    cwdc                           => clm3%g%l%c%ccs%cwdc
    litr1c                         => clm3%g%l%c%ccs%litr1c
    litr2c                         => clm3%g%l%c%ccs%litr2c
    litr3c                         => clm3%g%l%c%ccs%litr3c

    ! assign local pointers at the pft level
    m_deadcrootc_storage_to_litter => clm3%g%l%c%p%pcf%m_deadcrootc_storage_to_litter
    m_deadcrootc_to_litter         => clm3%g%l%c%p%pcf%m_deadcrootc_to_litter
    m_deadcrootc_xfer_to_litter    => clm3%g%l%c%p%pcf%m_deadcrootc_xfer_to_litter
    m_deadstemc_storage_to_litter  => clm3%g%l%c%p%pcf%m_deadstemc_storage_to_litter
    m_deadstemc_to_litter          => clm3%g%l%c%p%pcf%m_deadstemc_to_litter
    m_deadstemc_xfer_to_litter     => clm3%g%l%c%p%pcf%m_deadstemc_xfer_to_litter
    m_frootc_storage_to_litter     => clm3%g%l%c%p%pcf%m_frootc_storage_to_litter
    m_frootc_to_litter             => clm3%g%l%c%p%pcf%m_frootc_to_litter
    m_frootc_xfer_to_litter        => clm3%g%l%c%p%pcf%m_frootc_xfer_to_litter
    m_gresp_storage_to_litter      => clm3%g%l%c%p%pcf%m_gresp_storage_to_litter
    m_gresp_xfer_to_litter         => clm3%g%l%c%p%pcf%m_gresp_xfer_to_litter
    m_leafc_storage_to_litter      => clm3%g%l%c%p%pcf%m_leafc_storage_to_litter
    m_leafc_to_litter              => clm3%g%l%c%p%pcf%m_leafc_to_litter
    m_leafc_xfer_to_litter         => clm3%g%l%c%p%pcf%m_leafc_xfer_to_litter
    m_livecrootc_storage_to_litter => clm3%g%l%c%p%pcf%m_livecrootc_storage_to_litter
    m_livecrootc_to_litter         => clm3%g%l%c%p%pcf%m_livecrootc_to_litter
    m_livecrootc_xfer_to_litter    => clm3%g%l%c%p%pcf%m_livecrootc_xfer_to_litter
    m_livestemc_storage_to_litter  => clm3%g%l%c%p%pcf%m_livestemc_storage_to_litter
    m_livestemc_to_litter          => clm3%g%l%c%p%pcf%m_livestemc_to_litter
    m_livestemc_xfer_to_litter     => clm3%g%l%c%p%pcf%m_livestemc_xfer_to_litter
    deadcrootc                     => clm3%g%l%c%p%pcs%deadcrootc
    deadcrootc_storage             => clm3%g%l%c%p%pcs%deadcrootc_storage
    deadcrootc_xfer                => clm3%g%l%c%p%pcs%deadcrootc_xfer
    deadstemc                      => clm3%g%l%c%p%pcs%deadstemc
    deadstemc_storage              => clm3%g%l%c%p%pcs%deadstemc_storage
    deadstemc_xfer                 => clm3%g%l%c%p%pcs%deadstemc_xfer
    frootc                         => clm3%g%l%c%p%pcs%frootc
    frootc_storage                 => clm3%g%l%c%p%pcs%frootc_storage
    frootc_xfer                    => clm3%g%l%c%p%pcs%frootc_xfer
    gresp_storage                  => clm3%g%l%c%p%pcs%gresp_storage
    gresp_xfer                     => clm3%g%l%c%p%pcs%gresp_xfer
    leafc                          => clm3%g%l%c%p%pcs%leafc
    leafc_storage                  => clm3%g%l%c%p%pcs%leafc_storage
    leafc_xfer                     => clm3%g%l%c%p%pcs%leafc_xfer
    livecrootc                     => clm3%g%l%c%p%pcs%livecrootc
    livecrootc_storage             => clm3%g%l%c%p%pcs%livecrootc_storage
    livecrootc_xfer                => clm3%g%l%c%p%pcs%livecrootc_xfer
    livestemc                      => clm3%g%l%c%p%pcs%livestemc
    livestemc_storage              => clm3%g%l%c%p%pcs%livestemc_storage
    livestemc_xfer                 => clm3%g%l%c%p%pcs%livestemc_xfer

    ! set time steps
!    dt = real( get_step_size(), r8 )

    ! column loop
    do fc = 1,num_soilc
       c = filter_soilc(fc)

       ! column level carbon fluxes from gap-phase mortality

       ! leaf to litter
       litr1c(c) = litr1c(c) + m_leafc_to_litr1c(c) * dt
       litr2c(c) = litr2c(c) + m_leafc_to_litr2c(c) * dt
       litr3c(c) = litr3c(c) + m_leafc_to_litr3c(c) * dt

       ! fine root to litter
       litr1c(c) = litr1c(c) + m_frootc_to_litr1c(c) * dt
       litr2c(c) = litr2c(c) + m_frootc_to_litr2c(c) * dt
       litr3c(c) = litr3c(c) + m_frootc_to_litr3c(c) * dt

       ! wood to CWD
       cwdc(c) = cwdc(c) + m_livestemc_to_cwdc(c)  * dt
       cwdc(c) = cwdc(c) + m_deadstemc_to_cwdc(c)  * dt
       cwdc(c) = cwdc(c) + m_livecrootc_to_cwdc(c) * dt
       cwdc(c) = cwdc(c) + m_deadcrootc_to_cwdc(c) * dt

       ! storage pools to litter
       litr1c(c) = litr1c(c) + m_leafc_storage_to_litr1c(c)      * dt
       litr1c(c) = litr1c(c) + m_frootc_storage_to_litr1c(c)     * dt
       litr1c(c) = litr1c(c) + m_livestemc_storage_to_litr1c(c)  * dt
       litr1c(c) = litr1c(c) + m_deadstemc_storage_to_litr1c(c)  * dt
       litr1c(c) = litr1c(c) + m_livecrootc_storage_to_litr1c(c) * dt
       litr1c(c) = litr1c(c) + m_deadcrootc_storage_to_litr1c(c) * dt
       litr1c(c) = litr1c(c) + m_gresp_storage_to_litr1c(c)      * dt

       ! transfer pools to litter
       litr1c(c) = litr1c(c) + m_leafc_xfer_to_litr1c(c)      * dt
       litr1c(c) = litr1c(c) + m_frootc_xfer_to_litr1c(c)     * dt
       litr1c(c) = litr1c(c) + m_livestemc_xfer_to_litr1c(c)  * dt
       litr1c(c) = litr1c(c) + m_deadstemc_xfer_to_litr1c(c)  * dt
       litr1c(c) = litr1c(c) + m_livecrootc_xfer_to_litr1c(c) * dt
       litr1c(c) = litr1c(c) + m_deadcrootc_xfer_to_litr1c(c) * dt
       litr1c(c) = litr1c(c) + m_gresp_xfer_to_litr1c(c)      * dt

    end do ! end of columns loop

    ! pft loop
    do fp = 1,num_soilp
       p = filter_soilp(fp)

       ! pft-level carbon fluxes from gap-phase mortality
       ! displayed pools
       leafc(p)               = leafc(p)              - m_leafc_to_litter(p)              * dt
       frootc(p)              = frootc(p)             - m_frootc_to_litter(p)             * dt
       livestemc(p)           = livestemc(p)          - m_livestemc_to_litter(p)          * dt
       write(6,*) 'in CStateUpdate2, before deadstemc(',p,')=',deadstemc(p)

       deadstemc(p)           = deadstemc(p)          - m_deadstemc_to_litter(p)          * dt
       write(6,*) 'in CStateUpdate2, deadstemc(',p,')=',deadstemc(p)
       write(6,*) 'in CStateUpdate2, m_deadstemc_to_litter(',p,')=',m_deadstemc_to_litter(p)
       livecrootc(p)          = livecrootc(p)         - m_livecrootc_to_litter(p)         * dt
       deadcrootc(p)          = deadcrootc(p)         - m_deadcrootc_to_litter(p)         * dt

       ! storage pools
       leafc_storage(p)       = leafc_storage(p)      - m_leafc_storage_to_litter(p)      * dt
       frootc_storage(p)      = frootc_storage(p)     - m_frootc_storage_to_litter(p)     * dt
       livestemc_storage(p)   = livestemc_storage(p)  - m_livestemc_storage_to_litter(p)  * dt
       deadstemc_storage(p)   = deadstemc_storage(p)  - m_deadstemc_storage_to_litter(p)  * dt
 
       livecrootc_storage(p)  = livecrootc_storage(p) - m_livecrootc_storage_to_litter(p) * dt
       deadcrootc_storage(p)  = deadcrootc_storage(p) - m_deadcrootc_storage_to_litter(p) * dt
       gresp_storage(p)       = gresp_storage(p)      - m_gresp_storage_to_litter(p)      * dt

       ! transfer pools
       leafc_xfer(p)          = leafc_xfer(p)         - m_leafc_xfer_to_litter(p)         * dt
       frootc_xfer(p)         = frootc_xfer(p)        - m_frootc_xfer_to_litter(p)        * dt
       livestemc_xfer(p)      = livestemc_xfer(p)     - m_livestemc_xfer_to_litter(p)     * dt
       deadstemc_xfer(p)      = deadstemc_xfer(p)     - m_deadstemc_xfer_to_litter(p)     * dt
       livecrootc_xfer(p)     = livecrootc_xfer(p)    - m_livecrootc_xfer_to_litter(p)    * dt
       deadcrootc_xfer(p)     = deadcrootc_xfer(p)    - m_deadcrootc_xfer_to_litter(p)    * dt
       gresp_xfer(p)          = gresp_xfer(p)         - m_gresp_xfer_to_litter(p)         * dt

    end do ! end of pft loop

end subroutine CStateUpdate2
!-----------------------------------------------------------------------

!-----------------------------------------------------------------------
!BOP
!
! !IROUTINE: CStateUpdate2h
!
! !INTERFACE:
subroutine CStateUpdate2h(num_soilc, filter_soilc, num_soilp, filter_soilp)
!
! !DESCRIPTION:
! Update all the prognostic carbon state
! variables affected by harvest mortality fluxes
!
! !USES:
   use clmtype
!   use clm_time_manager, only: get_step_size
   use globals, only: dt
!
! !ARGUMENTS:
   implicit none
   integer, intent(in) :: num_soilc       ! number of soil columns in filter
   integer, intent(in) :: filter_soilc(:) ! filter for soil columns
   integer, intent(in) :: num_soilp       ! number of soil pfts in filter
   integer, intent(in) :: filter_soilp(:) ! filter for soil pfts
!
! !CALLED FROM:
! subroutine CNEcosystemDyn
!
! !REVISION HISTORY:
! 5/20/09: Created by Peter Thornton
!
! !LOCAL VARIABLES:
! local pointers to implicit in arrays
   real(r8), pointer :: hrv_deadcrootc_storage_to_litr1c(:)
   real(r8), pointer :: hrv_deadcrootc_to_cwdc(:)
   real(r8), pointer :: hrv_deadcrootc_xfer_to_litr1c(:)
   real(r8), pointer :: hrv_deadstemc_storage_to_litr1c(:)
   real(r8), pointer :: hrv_deadstemc_xfer_to_litr1c(:)
   real(r8), pointer :: hrv_frootc_storage_to_litr1c(:)
   real(r8), pointer :: hrv_frootc_to_litr1c(:)
   real(r8), pointer :: hrv_frootc_to_litr2c(:)
   real(r8), pointer :: hrv_frootc_to_litr3c(:)
   real(r8), pointer :: hrv_frootc_xfer_to_litr1c(:)
   real(r8), pointer :: hrv_gresp_storage_to_litr1c(:)
   real(r8), pointer :: hrv_gresp_xfer_to_litr1c(:)
   real(r8), pointer :: hrv_leafc_storage_to_litr1c(:)
   real(r8), pointer :: hrv_leafc_to_litr1c(:)
   real(r8), pointer :: hrv_leafc_to_litr2c(:)
   real(r8), pointer :: hrv_leafc_to_litr3c(:)
   real(r8), pointer :: hrv_leafc_xfer_to_litr1c(:)
   real(r8), pointer :: hrv_livecrootc_storage_to_litr1c(:)
   real(r8), pointer :: hrv_livecrootc_to_cwdc(:)
   real(r8), pointer :: hrv_livecrootc_xfer_to_litr1c(:)
   real(r8), pointer :: hrv_livestemc_storage_to_litr1c(:)
   real(r8), pointer :: hrv_livestemc_to_cwdc(:)
   real(r8), pointer :: hrv_livestemc_xfer_to_litr1c(:)
   real(r8), pointer :: hrv_deadcrootc_storage_to_litter(:)
   real(r8), pointer :: hrv_deadcrootc_to_litter(:)
   real(r8), pointer :: hrv_deadcrootc_xfer_to_litter(:)
   real(r8), pointer :: hrv_deadstemc_storage_to_litter(:)
   real(r8), pointer :: hrv_deadstemc_to_prod10c(:)
   real(r8), pointer :: hrv_deadstemc_to_prod100c(:)
   real(r8), pointer :: hrv_deadstemc_xfer_to_litter(:)
   real(r8), pointer :: hrv_frootc_storage_to_litter(:)
   real(r8), pointer :: hrv_frootc_to_litter(:)
   real(r8), pointer :: hrv_frootc_xfer_to_litter(:)
   real(r8), pointer :: hrv_gresp_storage_to_litter(:)
   real(r8), pointer :: hrv_gresp_xfer_to_litter(:)
   real(r8), pointer :: hrv_leafc_storage_to_litter(:)
   real(r8), pointer :: hrv_leafc_to_litter(:)
   real(r8), pointer :: hrv_leafc_xfer_to_litter(:)
   real(r8), pointer :: hrv_livecrootc_storage_to_litter(:)
   real(r8), pointer :: hrv_livecrootc_to_litter(:)
   real(r8), pointer :: hrv_livecrootc_xfer_to_litter(:)
   real(r8), pointer :: hrv_livestemc_storage_to_litter(:)
   real(r8), pointer :: hrv_livestemc_to_litter(:)
   real(r8), pointer :: hrv_livestemc_xfer_to_litter(:)
   real(r8), pointer :: hrv_xsmrpool_to_atm(:)
!
! local pointers to implicit in/out arrays
   real(r8), pointer :: cwdc(:)               ! (gC/m2) coarse woody debris C
   real(r8), pointer :: litr1c(:)             ! (gC/m2) litter labile C
   real(r8), pointer :: litr2c(:)             ! (gC/m2) litter cellulose C
   real(r8), pointer :: litr3c(:)             ! (gC/m2) litter lignin C
   real(r8), pointer :: deadcrootc(:)         ! (gC/m2) dead coarse root C
   real(r8), pointer :: deadcrootc_storage(:) ! (gC/m2) dead coarse root C storage
   real(r8), pointer :: deadcrootc_xfer(:)    ! (gC/m2) dead coarse root C transfer
   real(r8), pointer :: deadstemc(:)          ! (gC/m2) dead stem C
   real(r8), pointer :: deadstemc_storage(:)  ! (gC/m2) dead stem C storage
   real(r8), pointer :: deadstemc_xfer(:)     ! (gC/m2) dead stem C transfer
   real(r8), pointer :: frootc(:)             ! (gC/m2) fine root C
   real(r8), pointer :: frootc_storage(:)     ! (gC/m2) fine root C storage
   real(r8), pointer :: frootc_xfer(:)        ! (gC/m2) fine root C transfer
   real(r8), pointer :: gresp_storage(:)      ! (gC/m2) growth respiration storage
   real(r8), pointer :: gresp_xfer(:)         ! (gC/m2) growth respiration transfer
   real(r8), pointer :: leafc(:)              ! (gC/m2) leaf C
   real(r8), pointer :: leafc_storage(:)      ! (gC/m2) leaf C storage
   real(r8), pointer :: leafc_xfer(:)         ! (gC/m2) leaf C transfer
   real(r8), pointer :: livecrootc(:)         ! (gC/m2) live coarse root C
   real(r8), pointer :: livecrootc_storage(:) ! (gC/m2) live coarse root C storage
   real(r8), pointer :: livecrootc_xfer(:)    ! (gC/m2) live coarse root C transfer
   real(r8), pointer :: livestemc(:)          ! (gC/m2) live stem C
   real(r8), pointer :: livestemc_storage(:)  ! (gC/m2) live stem C storage
   real(r8), pointer :: livestemc_xfer(:)     ! (gC/m2) live stem C transfer
   real(r8), pointer :: xsmrpool(:)           ! (gC/m2) abstract C pool to meet excess MR demand
!
!
! local pointers to implicit out arrays
!
!
! !OTHER LOCAL VARIABLES:
   integer :: c,p      ! indices
   integer :: fp,fc    ! lake filter indices
!   real(r8):: dt       ! radiation time step (seconds)
!
!EOP
!-----------------------------------------------------------------------
    ! assign local pointers at the column level
    hrv_deadcrootc_storage_to_litr1c => clm3%g%l%c%ccf%hrv_deadcrootc_storage_to_litr1c
    hrv_deadcrootc_to_cwdc           => clm3%g%l%c%ccf%hrv_deadcrootc_to_cwdc
    hrv_deadcrootc_xfer_to_litr1c    => clm3%g%l%c%ccf%hrv_deadcrootc_xfer_to_litr1c
    hrv_deadstemc_storage_to_litr1c  => clm3%g%l%c%ccf%hrv_deadstemc_storage_to_litr1c
    hrv_deadstemc_xfer_to_litr1c     => clm3%g%l%c%ccf%hrv_deadstemc_xfer_to_litr1c
    hrv_frootc_storage_to_litr1c     => clm3%g%l%c%ccf%hrv_frootc_storage_to_litr1c
    hrv_frootc_to_litr1c             => clm3%g%l%c%ccf%hrv_frootc_to_litr1c
    hrv_frootc_to_litr2c             => clm3%g%l%c%ccf%hrv_frootc_to_litr2c
    hrv_frootc_to_litr3c             => clm3%g%l%c%ccf%hrv_frootc_to_litr3c
    hrv_frootc_xfer_to_litr1c        => clm3%g%l%c%ccf%hrv_frootc_xfer_to_litr1c
    hrv_gresp_storage_to_litr1c      => clm3%g%l%c%ccf%hrv_gresp_storage_to_litr1c
    hrv_gresp_xfer_to_litr1c         => clm3%g%l%c%ccf%hrv_gresp_xfer_to_litr1c
    hrv_leafc_storage_to_litr1c      => clm3%g%l%c%ccf%hrv_leafc_storage_to_litr1c
    hrv_leafc_to_litr1c              => clm3%g%l%c%ccf%hrv_leafc_to_litr1c
    hrv_leafc_to_litr2c              => clm3%g%l%c%ccf%hrv_leafc_to_litr2c
    hrv_leafc_to_litr3c              => clm3%g%l%c%ccf%hrv_leafc_to_litr3c
    hrv_leafc_xfer_to_litr1c         => clm3%g%l%c%ccf%hrv_leafc_xfer_to_litr1c
    hrv_livecrootc_storage_to_litr1c => clm3%g%l%c%ccf%hrv_livecrootc_storage_to_litr1c
    hrv_livecrootc_to_cwdc           => clm3%g%l%c%ccf%hrv_livecrootc_to_cwdc
    hrv_livecrootc_xfer_to_litr1c    => clm3%g%l%c%ccf%hrv_livecrootc_xfer_to_litr1c
    hrv_livestemc_storage_to_litr1c  => clm3%g%l%c%ccf%hrv_livestemc_storage_to_litr1c
    hrv_livestemc_to_cwdc            => clm3%g%l%c%ccf%hrv_livestemc_to_cwdc
    hrv_livestemc_xfer_to_litr1c     => clm3%g%l%c%ccf%hrv_livestemc_xfer_to_litr1c
    cwdc                           => clm3%g%l%c%ccs%cwdc
    litr1c                         => clm3%g%l%c%ccs%litr1c
    litr2c                         => clm3%g%l%c%ccs%litr2c
    litr3c                         => clm3%g%l%c%ccs%litr3c

    ! assign local pointers at the pft level
    hrv_deadcrootc_storage_to_litter => clm3%g%l%c%p%pcf%hrv_deadcrootc_storage_to_litter
    hrv_deadcrootc_to_litter         => clm3%g%l%c%p%pcf%hrv_deadcrootc_to_litter
    hrv_deadcrootc_xfer_to_litter    => clm3%g%l%c%p%pcf%hrv_deadcrootc_xfer_to_litter
    hrv_deadstemc_storage_to_litter  => clm3%g%l%c%p%pcf%hrv_deadstemc_storage_to_litter
    hrv_deadstemc_to_prod10c         => clm3%g%l%c%p%pcf%hrv_deadstemc_to_prod10c
    hrv_deadstemc_to_prod100c        => clm3%g%l%c%p%pcf%hrv_deadstemc_to_prod100c
    hrv_deadstemc_xfer_to_litter     => clm3%g%l%c%p%pcf%hrv_deadstemc_xfer_to_litter
    hrv_frootc_storage_to_litter     => clm3%g%l%c%p%pcf%hrv_frootc_storage_to_litter
    hrv_frootc_to_litter             => clm3%g%l%c%p%pcf%hrv_frootc_to_litter
    hrv_frootc_xfer_to_litter        => clm3%g%l%c%p%pcf%hrv_frootc_xfer_to_litter
    hrv_gresp_storage_to_litter      => clm3%g%l%c%p%pcf%hrv_gresp_storage_to_litter
    hrv_gresp_xfer_to_litter         => clm3%g%l%c%p%pcf%hrv_gresp_xfer_to_litter
    hrv_leafc_storage_to_litter      => clm3%g%l%c%p%pcf%hrv_leafc_storage_to_litter
    hrv_leafc_to_litter              => clm3%g%l%c%p%pcf%hrv_leafc_to_litter
    hrv_leafc_xfer_to_litter         => clm3%g%l%c%p%pcf%hrv_leafc_xfer_to_litter
    hrv_livecrootc_storage_to_litter => clm3%g%l%c%p%pcf%hrv_livecrootc_storage_to_litter
    hrv_livecrootc_to_litter         => clm3%g%l%c%p%pcf%hrv_livecrootc_to_litter
    hrv_livecrootc_xfer_to_litter    => clm3%g%l%c%p%pcf%hrv_livecrootc_xfer_to_litter
    hrv_livestemc_storage_to_litter  => clm3%g%l%c%p%pcf%hrv_livestemc_storage_to_litter
    hrv_livestemc_to_litter          => clm3%g%l%c%p%pcf%hrv_livestemc_to_litter
    hrv_livestemc_xfer_to_litter     => clm3%g%l%c%p%pcf%hrv_livestemc_xfer_to_litter
    hrv_xsmrpool_to_atm              => clm3%g%l%c%p%pcf%hrv_xsmrpool_to_atm
    deadcrootc                     => clm3%g%l%c%p%pcs%deadcrootc
    deadcrootc_storage             => clm3%g%l%c%p%pcs%deadcrootc_storage
    deadcrootc_xfer                => clm3%g%l%c%p%pcs%deadcrootc_xfer
    deadstemc                      => clm3%g%l%c%p%pcs%deadstemc
    deadstemc_storage              => clm3%g%l%c%p%pcs%deadstemc_storage
    deadstemc_xfer                 => clm3%g%l%c%p%pcs%deadstemc_xfer
    frootc                         => clm3%g%l%c%p%pcs%frootc
    frootc_storage                 => clm3%g%l%c%p%pcs%frootc_storage
    frootc_xfer                    => clm3%g%l%c%p%pcs%frootc_xfer
    gresp_storage                  => clm3%g%l%c%p%pcs%gresp_storage
    gresp_xfer                     => clm3%g%l%c%p%pcs%gresp_xfer
    leafc                          => clm3%g%l%c%p%pcs%leafc
    leafc_storage                  => clm3%g%l%c%p%pcs%leafc_storage
    leafc_xfer                     => clm3%g%l%c%p%pcs%leafc_xfer
    livecrootc                     => clm3%g%l%c%p%pcs%livecrootc
    livecrootc_storage             => clm3%g%l%c%p%pcs%livecrootc_storage
    livecrootc_xfer                => clm3%g%l%c%p%pcs%livecrootc_xfer
    livestemc                      => clm3%g%l%c%p%pcs%livestemc
    livestemc_storage              => clm3%g%l%c%p%pcs%livestemc_storage
    livestemc_xfer                 => clm3%g%l%c%p%pcs%livestemc_xfer
    xsmrpool                       => clm3%g%l%c%p%pcs%xsmrpool

    ! set time steps
!    dt = real( get_step_size(), r8 )

    ! column loop
    do fc = 1,num_soilc
       c = filter_soilc(fc)

       ! column level carbon fluxes from harvest mortality

       ! leaf to litter
       litr1c(c) = litr1c(c) + hrv_leafc_to_litr1c(c) * dt
       litr2c(c) = litr2c(c) + hrv_leafc_to_litr2c(c) * dt
       litr3c(c) = litr3c(c) + hrv_leafc_to_litr3c(c) * dt

       ! fine root to litter
       litr1c(c) = litr1c(c) + hrv_frootc_to_litr1c(c) * dt
       litr2c(c) = litr2c(c) + hrv_frootc_to_litr2c(c) * dt
       litr3c(c) = litr3c(c) + hrv_frootc_to_litr3c(c) * dt

       ! wood to CWD
       cwdc(c) = cwdc(c) + hrv_livestemc_to_cwdc(c)  * dt
       cwdc(c) = cwdc(c) + hrv_livecrootc_to_cwdc(c) * dt
       cwdc(c) = cwdc(c) + hrv_deadcrootc_to_cwdc(c) * dt

       ! wood to product pools - states updated in CNWoodProducts()

       ! storage pools to litter
       litr1c(c) = litr1c(c) + hrv_leafc_storage_to_litr1c(c)      * dt
       litr1c(c) = litr1c(c) + hrv_frootc_storage_to_litr1c(c)     * dt
       litr1c(c) = litr1c(c) + hrv_livestemc_storage_to_litr1c(c)  * dt
       litr1c(c) = litr1c(c) + hrv_deadstemc_storage_to_litr1c(c)  * dt
       litr1c(c) = litr1c(c) + hrv_livecrootc_storage_to_litr1c(c) * dt
       litr1c(c) = litr1c(c) + hrv_deadcrootc_storage_to_litr1c(c) * dt
       litr1c(c) = litr1c(c) + hrv_gresp_storage_to_litr1c(c)      * dt

       ! transfer pools to litter
       litr1c(c) = litr1c(c) + hrv_leafc_xfer_to_litr1c(c)      * dt
       litr1c(c) = litr1c(c) + hrv_frootc_xfer_to_litr1c(c)     * dt
       litr1c(c) = litr1c(c) + hrv_livestemc_xfer_to_litr1c(c)  * dt
       litr1c(c) = litr1c(c) + hrv_deadstemc_xfer_to_litr1c(c)  * dt
       litr1c(c) = litr1c(c) + hrv_livecrootc_xfer_to_litr1c(c) * dt
       litr1c(c) = litr1c(c) + hrv_deadcrootc_xfer_to_litr1c(c) * dt
       litr1c(c) = litr1c(c) + hrv_gresp_xfer_to_litr1c(c)      * dt

    end do ! end of columns loop

    ! pft loop
    do fp = 1,num_soilp
       p = filter_soilp(fp)

       ! pft-level carbon fluxes from harvest mortality
       ! displayed pools
       leafc(p)               = leafc(p)              - hrv_leafc_to_litter(p)              * dt
       frootc(p)              = frootc(p)             - hrv_frootc_to_litter(p)             * dt
       livestemc(p)           = livestemc(p)          - hrv_livestemc_to_litter(p)          * dt
       deadstemc(p)           = deadstemc(p)          - hrv_deadstemc_to_prod10c(p)         * dt
       deadstemc(p)           = deadstemc(p)          - hrv_deadstemc_to_prod100c(p)        * dt
       livecrootc(p)          = livecrootc(p)         - hrv_livecrootc_to_litter(p)         * dt
       deadcrootc(p)          = deadcrootc(p)         - hrv_deadcrootc_to_litter(p)         * dt
       
       ! xsmrpool
       xsmrpool(p)            = xsmrpool(p)           - hrv_xsmrpool_to_atm(p)              * dt

       ! storage pools
       leafc_storage(p)       = leafc_storage(p)      - hrv_leafc_storage_to_litter(p)      * dt
       frootc_storage(p)      = frootc_storage(p)     - hrv_frootc_storage_to_litter(p)     * dt
       livestemc_storage(p)   = livestemc_storage(p)  - hrv_livestemc_storage_to_litter(p)  * dt
       deadstemc_storage(p)   = deadstemc_storage(p)  - hrv_deadstemc_storage_to_litter(p)  * dt
       livecrootc_storage(p)  = livecrootc_storage(p) - hrv_livecrootc_storage_to_litter(p) * dt
       deadcrootc_storage(p)  = deadcrootc_storage(p) - hrv_deadcrootc_storage_to_litter(p) * dt
       gresp_storage(p)       = gresp_storage(p)      - hrv_gresp_storage_to_litter(p)      * dt

       ! transfer pools
       leafc_xfer(p)          = leafc_xfer(p)         - hrv_leafc_xfer_to_litter(p)         * dt
       frootc_xfer(p)         = frootc_xfer(p)        - hrv_frootc_xfer_to_litter(p)        * dt
       livestemc_xfer(p)      = livestemc_xfer(p)     - hrv_livestemc_xfer_to_litter(p)     * dt
       deadstemc_xfer(p)      = deadstemc_xfer(p)     - hrv_deadstemc_xfer_to_litter(p)     * dt
       livecrootc_xfer(p)     = livecrootc_xfer(p)    - hrv_livecrootc_xfer_to_litter(p)    * dt
       deadcrootc_xfer(p)     = deadcrootc_xfer(p)    - hrv_deadcrootc_xfer_to_litter(p)    * dt
       gresp_xfer(p)          = gresp_xfer(p)         - hrv_gresp_xfer_to_litter(p)         * dt

    end do ! end of pft loop

end subroutine CStateUpdate2h
!-----------------------------------------------------------------------
#endif

end module CNCStateUpdate2Mod
module CNCStateUpdate3Mod
#ifdef CN

!-----------------------------------------------------------------------
!BOP
!
! !MODULE: CStateUpdate3Mod
!
! !DESCRIPTION:
! Module for carbon state variable update, mortality fluxes.
!
! !USES:
    use shr_kind_mod, only: r8 => shr_kind_r8
    implicit none
    save
    private
! !PUBLIC MEMBER FUNCTIONS:
    public:: CStateUpdate3
!
! !REVISION HISTORY:
! 7/27/2004: Created by Peter Thornton
!
!EOP
!-----------------------------------------------------------------------

contains

!-----------------------------------------------------------------------
!BOP
!
! !IROUTINE: CStateUpdate3
!
! !INTERFACE:
subroutine CStateUpdate3(num_soilc, filter_soilc, num_soilp, filter_soilp)
!
! !DESCRIPTION:
! On the radiation time step, update all the prognostic carbon state
! variables affected by fire fluxes
!
! !USES:
   use clmtype
!   use clm_time_manager, only: get_step_size
   use globals  , only: dt
!
! !ARGUMENTS:
   implicit none
   integer, intent(in) :: num_soilc       ! number of soil columns in filter
   integer, intent(in) :: filter_soilc(:) ! filter for soil columns
   integer, intent(in) :: num_soilp       ! number of soil pfts in filter
   integer, intent(in) :: filter_soilp(:) ! filter for soil pfts
!
! !CALLED FROM:
! subroutine CNEcosystemDyn
!
! !REVISION HISTORY:
! 3/29/04: Created by Peter Thornton
!
! !LOCAL VARIABLES:
! local pointers to implicit in arrays
   real(r8), pointer :: m_cwdc_to_fire(:)
   real(r8), pointer :: m_deadcrootc_to_cwdc_fire(:)
   real(r8), pointer :: m_deadstemc_to_cwdc_fire(:)
   real(r8), pointer :: m_litr1c_to_fire(:)
   real(r8), pointer :: m_litr2c_to_fire(:)
   real(r8), pointer :: m_litr3c_to_fire(:)
   real(r8), pointer :: m_deadcrootc_storage_to_fire(:)
   real(r8), pointer :: m_deadcrootc_to_fire(:)
   real(r8), pointer :: m_deadcrootc_to_litter_fire(:)
   real(r8), pointer :: m_deadcrootc_xfer_to_fire(:)
   real(r8), pointer :: m_deadstemc_storage_to_fire(:)
   real(r8), pointer :: m_deadstemc_to_fire(:)
   real(r8), pointer :: m_deadstemc_to_litter_fire(:)
   real(r8), pointer :: m_deadstemc_xfer_to_fire(:)
   real(r8), pointer :: m_frootc_storage_to_fire(:)
   real(r8), pointer :: m_frootc_to_fire(:)
   real(r8), pointer :: m_frootc_xfer_to_fire(:)
   real(r8), pointer :: m_gresp_storage_to_fire(:)
   real(r8), pointer :: m_gresp_xfer_to_fire(:)
   real(r8), pointer :: m_leafc_storage_to_fire(:)
   real(r8), pointer :: m_leafc_to_fire(:)
   real(r8), pointer :: m_leafc_xfer_to_fire(:)
   real(r8), pointer :: m_livecrootc_storage_to_fire(:)
   real(r8), pointer :: m_livecrootc_to_fire(:)
   real(r8), pointer :: m_livecrootc_xfer_to_fire(:)
   real(r8), pointer :: m_livestemc_storage_to_fire(:)
   real(r8), pointer :: m_livestemc_to_fire(:)
   real(r8), pointer :: m_livestemc_xfer_to_fire(:)
!
! local pointers to implicit in/out arrays
   real(r8), pointer :: cwdc(:)               ! (gC/m2) coarse woody debris C
   real(r8), pointer :: litr1c(:)             ! (gC/m2) litter labile C
   real(r8), pointer :: litr2c(:)             ! (gC/m2) litter cellulose C
   real(r8), pointer :: litr3c(:)             ! (gC/m2) litter lignin C
   real(r8), pointer :: deadcrootc(:)         ! (gC/m2) dead coarse root C
   real(r8), pointer :: deadcrootc_storage(:) ! (gC/m2) dead coarse root C storage
   real(r8), pointer :: deadcrootc_xfer(:)    ! (gC/m2) dead coarse root C transfer
   real(r8), pointer :: deadstemc(:)          ! (gC/m2) dead stem C
   real(r8), pointer :: deadstemc_storage(:)  ! (gC/m2) dead stem C storage
   real(r8), pointer :: deadstemc_xfer(:)     ! (gC/m2) dead stem C transfer
   real(r8), pointer :: frootc(:)             ! (gC/m2) fine root C
   real(r8), pointer :: frootc_storage(:)     ! (gC/m2) fine root C storage
   real(r8), pointer :: frootc_xfer(:)        ! (gC/m2) fine root C transfer
   real(r8), pointer :: gresp_storage(:)      ! (gC/m2) growth respiration storage
   real(r8), pointer :: gresp_xfer(:)         ! (gC/m2) growth respiration transfer
   real(r8), pointer :: leafc(:)              ! (gC/m2) leaf C
   real(r8), pointer :: leafc_storage(:)      ! (gC/m2) leaf C storage
   real(r8), pointer :: leafc_xfer(:)         ! (gC/m2) leaf C transfer
   real(r8), pointer :: livecrootc(:)         ! (gC/m2) live coarse root C
   real(r8), pointer :: livecrootc_storage(:) ! (gC/m2) live coarse root C storage
   real(r8), pointer :: livecrootc_xfer(:)    ! (gC/m2) live coarse root C transfer
   real(r8), pointer :: livestemc(:)          ! (gC/m2) live stem C
   real(r8), pointer :: livestemc_storage(:)  ! (gC/m2) live stem C storage
   real(r8), pointer :: livestemc_xfer(:)     ! (gC/m2) live stem C transfer
!
! local pointers to implicit out arrays
!
! !OTHER LOCAL VARIABLES:
   integer :: c,p      ! indices
   integer :: fp,fc    ! lake filter indices
!   real(r8):: dt       ! radiation time step (seconds)

!EOP
!-----------------------------------------------------------------------

    ! assign local pointers at the column level
    m_cwdc_to_fire                 => clm3%g%l%c%ccf%m_cwdc_to_fire
    m_deadcrootc_to_cwdc_fire      => clm3%g%l%c%ccf%m_deadcrootc_to_cwdc_fire
    m_deadstemc_to_cwdc_fire       => clm3%g%l%c%ccf%m_deadstemc_to_cwdc_fire
    m_litr1c_to_fire               => clm3%g%l%c%ccf%m_litr1c_to_fire
    m_litr2c_to_fire               => clm3%g%l%c%ccf%m_litr2c_to_fire
    m_litr3c_to_fire               => clm3%g%l%c%ccf%m_litr3c_to_fire
    cwdc                           => clm3%g%l%c%ccs%cwdc
    litr1c                         => clm3%g%l%c%ccs%litr1c
    litr2c                         => clm3%g%l%c%ccs%litr2c
    litr3c                         => clm3%g%l%c%ccs%litr3c

    ! assign local pointers at the column level
    m_deadcrootc_storage_to_fire   => clm3%g%l%c%p%pcf%m_deadcrootc_storage_to_fire
    m_deadcrootc_to_fire           => clm3%g%l%c%p%pcf%m_deadcrootc_to_fire
    m_deadcrootc_to_litter_fire    => clm3%g%l%c%p%pcf%m_deadcrootc_to_litter_fire
    m_deadcrootc_xfer_to_fire      => clm3%g%l%c%p%pcf%m_deadcrootc_xfer_to_fire
    m_deadstemc_storage_to_fire    => clm3%g%l%c%p%pcf%m_deadstemc_storage_to_fire
    m_deadstemc_to_fire            => clm3%g%l%c%p%pcf%m_deadstemc_to_fire
    m_deadstemc_to_litter_fire     => clm3%g%l%c%p%pcf%m_deadstemc_to_litter_fire
    m_deadstemc_xfer_to_fire       => clm3%g%l%c%p%pcf%m_deadstemc_xfer_to_fire
    m_frootc_storage_to_fire       => clm3%g%l%c%p%pcf%m_frootc_storage_to_fire
    m_frootc_to_fire               => clm3%g%l%c%p%pcf%m_frootc_to_fire
    m_frootc_xfer_to_fire          => clm3%g%l%c%p%pcf%m_frootc_xfer_to_fire
    m_gresp_storage_to_fire        => clm3%g%l%c%p%pcf%m_gresp_storage_to_fire
    m_gresp_xfer_to_fire           => clm3%g%l%c%p%pcf%m_gresp_xfer_to_fire
    m_leafc_storage_to_fire        => clm3%g%l%c%p%pcf%m_leafc_storage_to_fire
    m_leafc_to_fire                => clm3%g%l%c%p%pcf%m_leafc_to_fire
    m_leafc_xfer_to_fire           => clm3%g%l%c%p%pcf%m_leafc_xfer_to_fire
    m_livecrootc_storage_to_fire   => clm3%g%l%c%p%pcf%m_livecrootc_storage_to_fire
    m_livecrootc_to_fire           => clm3%g%l%c%p%pcf%m_livecrootc_to_fire
    m_livecrootc_xfer_to_fire      => clm3%g%l%c%p%pcf%m_livecrootc_xfer_to_fire
    m_livestemc_storage_to_fire    => clm3%g%l%c%p%pcf%m_livestemc_storage_to_fire
    m_livestemc_to_fire            => clm3%g%l%c%p%pcf%m_livestemc_to_fire
    m_livestemc_xfer_to_fire       => clm3%g%l%c%p%pcf%m_livestemc_xfer_to_fire
    deadcrootc                     => clm3%g%l%c%p%pcs%deadcrootc
    deadcrootc_storage             => clm3%g%l%c%p%pcs%deadcrootc_storage
    deadcrootc_xfer                => clm3%g%l%c%p%pcs%deadcrootc_xfer
    deadstemc                      => clm3%g%l%c%p%pcs%deadstemc
    deadstemc_storage              => clm3%g%l%c%p%pcs%deadstemc_storage
    deadstemc_xfer                 => clm3%g%l%c%p%pcs%deadstemc_xfer
    frootc                         => clm3%g%l%c%p%pcs%frootc
    frootc_storage                 => clm3%g%l%c%p%pcs%frootc_storage
    frootc_xfer                    => clm3%g%l%c%p%pcs%frootc_xfer
    gresp_storage                  => clm3%g%l%c%p%pcs%gresp_storage
    gresp_xfer                     => clm3%g%l%c%p%pcs%gresp_xfer
    leafc                          => clm3%g%l%c%p%pcs%leafc
    leafc_storage                  => clm3%g%l%c%p%pcs%leafc_storage
    leafc_xfer                     => clm3%g%l%c%p%pcs%leafc_xfer
    livecrootc                     => clm3%g%l%c%p%pcs%livecrootc
    livecrootc_storage             => clm3%g%l%c%p%pcs%livecrootc_storage
    livecrootc_xfer                => clm3%g%l%c%p%pcs%livecrootc_xfer
    livestemc                      => clm3%g%l%c%p%pcs%livestemc
    livestemc_storage              => clm3%g%l%c%p%pcs%livestemc_storage
    livestemc_xfer                 => clm3%g%l%c%p%pcs%livestemc_xfer

    ! set time steps
!    dt = real( get_step_size(), r8 )

    ! column loop
    do fc = 1,num_soilc
       c = filter_soilc(fc)

       ! column level carbon fluxes from fire

       ! pft-level wood to column-level CWD (uncombusted wood)
       cwdc(c) = cwdc(c) + m_deadstemc_to_cwdc_fire(c) * dt
       cwdc(c) = cwdc(c) + m_deadcrootc_to_cwdc_fire(c) * dt

       ! litter and CWD losses to fire
       litr1c(c) = litr1c(c) - m_litr1c_to_fire(c) * dt
       litr2c(c) = litr2c(c) - m_litr2c_to_fire(c) * dt
       litr3c(c) = litr3c(c) - m_litr3c_to_fire(c) * dt
       cwdc(c)   = cwdc(c)   - m_cwdc_to_fire(c)   * dt

    end do ! end of columns loop

    ! pft loop
    do fp = 1,num_soilp
       p = filter_soilp(fp)

       ! pft-level carbon fluxes from fire
       ! displayed pools
       leafc(p)               = leafc(p)               - m_leafc_to_fire(p)               * dt
       frootc(p)              = frootc(p)              - m_frootc_to_fire(p)              * dt
       livestemc(p)           = livestemc(p)           - m_livestemc_to_fire(p)           * dt
       deadstemc(p)           = deadstemc(p)           - m_deadstemc_to_fire(p)           * dt
       deadstemc(p)           = deadstemc(p)           - m_deadstemc_to_litter_fire(p)    * dt
       livecrootc(p)          = livecrootc(p)          - m_livecrootc_to_fire(p)          * dt
       deadcrootc(p)          = deadcrootc(p)          - m_deadcrootc_to_fire(p)          * dt
       deadcrootc(p)          = deadcrootc(p)          - m_deadcrootc_to_litter_fire(p)   * dt

       ! storage pools
       leafc_storage(p)       = leafc_storage(p)       - m_leafc_storage_to_fire(p)       * dt
       frootc_storage(p)      = frootc_storage(p)      - m_frootc_storage_to_fire(p)      * dt
       livestemc_storage(p)   = livestemc_storage(p)   - m_livestemc_storage_to_fire(p)   * dt
       deadstemc_storage(p)   = deadstemc_storage(p)   - m_deadstemc_storage_to_fire(p)   * dt
       livecrootc_storage(p)  = livecrootc_storage(p)  - m_livecrootc_storage_to_fire(p)  * dt
       deadcrootc_storage(p)  = deadcrootc_storage(p)  - m_deadcrootc_storage_to_fire(p)  * dt
       gresp_storage(p)       = gresp_storage(p)       - m_gresp_storage_to_fire(p)       * dt

       ! transfer pools
       leafc_xfer(p)      = leafc_xfer(p)      - m_leafc_xfer_to_fire(p)      * dt
       frootc_xfer(p)     = frootc_xfer(p)     - m_frootc_xfer_to_fire(p)     * dt
       livestemc_xfer(p)  = livestemc_xfer(p)  - m_livestemc_xfer_to_fire(p)  * dt
       deadstemc_xfer(p)  = deadstemc_xfer(p)  - m_deadstemc_xfer_to_fire(p)  * dt
       livecrootc_xfer(p) = livecrootc_xfer(p) - m_livecrootc_xfer_to_fire(p) * dt
       deadcrootc_xfer(p) = deadcrootc_xfer(p) - m_deadcrootc_xfer_to_fire(p) * dt
       gresp_xfer(p)      = gresp_xfer(p)      - m_gresp_xfer_to_fire(p)      * dt

    end do ! end of pft loop

end subroutine CStateUpdate3
!-----------------------------------------------------------------------
#endif

end module CNCStateUpdate3Mod
module CNDecompMod
#ifdef CN

!-----------------------------------------------------------------------
!BOP
!
! !MODULE: CNDecompMod
!
! !DESCRIPTION:
! Module holding routines used in litter and soil decomposition model
! for coupled carbon-nitrogen code.
!
! !USES:
   use shr_kind_mod , only: r8 => shr_kind_r8
   use shr_const_mod, only: SHR_CONST_TKFRZ
   use CNAllocationMod, only: CNAllocation

   implicit none
   save
   private
! !PUBLIC MEMBER FUNCTIONS:
   public:: CNDecompAlloc
!
! !REVISION HISTORY:
! 8/15/03: Created by Peter Thornton
! 10/23/03, Peter Thornton: migrated to vector data structures
!
!EOP
!-----------------------------------------------------------------------

contains

!-----------------------------------------------------------------------
!BOP
!
! !IROUTINE: CNDecompAlloc
!
! !INTERFACE:
subroutine CNDecompAlloc (lbp, ubp, lbc, ubc, num_soilc, filter_soilc, &
   num_soilp, filter_soilp)
!
! !DESCRIPTION:
!
! !USES:
   use clmtype
   use CNAllocationMod, only: CNAllocation
! ylu removed
!   use clm_time_manager, only: get_step_size
   use pft2colMod, only: p2c
   use globals, only :dt
!
! !ARGUMENTS:
   implicit none
   integer, intent(in) :: lbp, ubp        ! pft-index bounds
   integer, intent(in) :: lbc, ubc        ! column-index bounds
   integer, intent(in) :: num_soilc       ! number of soil columns in filter
   integer, intent(in) :: filter_soilc(:) ! filter for soil columns
   integer, intent(in) :: num_soilp       ! number of soil pfts in filter
   integer, intent(in) :: filter_soilp(:) ! filter for soil pfts
!
! !CALLED FROM:
! subroutine CNEcosystemDyn in module CNEcosystemDynMod.F90
!
! !REVISION HISTORY:
! 8/15/03: Created by Peter Thornton
!
! !LOCAL VARIABLES:
! local pointers to implicit in scalars
!
   ! column level
   real(r8), pointer :: t_soisno(:,:)    ! soil temperature (Kelvin)  (-nlevsno+1:nlevgrnd)
   real(r8), pointer :: psisat(:,:)      ! soil water potential at saturation for CN code (MPa)
   real(r8), pointer :: soilpsi(:,:)     ! soil water potential in each soil layer (MPa)
   real(r8), pointer :: dz(:,:)          ! soil layer thickness (m)
   real(r8), pointer :: cwdc(:)          ! (gC/m2) coarse woody debris C
   real(r8), pointer :: litr1c(:)        ! (kgC/m2) litter labile C
   real(r8), pointer :: litr2c(:)        ! (kgC/m2) litter cellulose C
   real(r8), pointer :: litr3c(:)        ! (kgC/m2) litter lignin C
   real(r8), pointer :: soil1c(:)        ! (kgC/m2) soil organic matter C (fast pool)
   real(r8), pointer :: soil2c(:)        ! (kgC/m2) soil organic matter C (medium pool)
   real(r8), pointer :: soil3c(:)        ! (kgC/m2) soil organic matter C (slow pool)
   real(r8), pointer :: soil4c(:)        ! (kgC/m2) soil organic matter C (slowest pool)
   real(r8), pointer :: cwdn(:)          ! (gN/m2) coarse woody debris N
   real(r8), pointer :: litr1n(:)        ! (kgN/m2) litter labile N
   real(r8), pointer :: litr2n(:)        ! (kgN/m2) litter cellulose N
   real(r8), pointer :: litr3n(:)        ! (kgN/m2) litter lignin N
   integer, pointer :: clandunit(:)      ! index into landunit level quantities
   integer , pointer :: itypelun(:)      ! landunit type
   ! pft level
   real(r8), pointer :: rootfr(:,:)      ! fraction of roots in each soil layer  (nlevgrnd)
!
! local pointers to implicit in/out scalars
!
   real(r8), pointer :: fpi(:)           ! fraction of potential immobilization (no units)
   real(r8), pointer :: cwdc_to_litr2c(:)
   real(r8), pointer :: cwdc_to_litr3c(:)
   real(r8), pointer :: litr1_hr(:)
   real(r8), pointer :: litr1c_to_soil1c(:)
   real(r8), pointer :: litr2_hr(:)
   real(r8), pointer :: litr2c_to_soil2c(:)
   real(r8), pointer :: litr3_hr(:)
   real(r8), pointer :: litr3c_to_soil3c(:)
   real(r8), pointer :: soil1_hr(:)
   real(r8), pointer :: soil1c_to_soil2c(:)
   real(r8), pointer :: soil2_hr(:)
   real(r8), pointer :: soil2c_to_soil3c(:)
   real(r8), pointer :: soil3_hr(:)
   real(r8), pointer :: soil3c_to_soil4c(:)
   real(r8), pointer :: soil4_hr(:)
   real(r8), pointer :: cwdn_to_litr2n(:)
   real(r8), pointer :: cwdn_to_litr3n(:)
   real(r8), pointer :: potential_immob(:)
   real(r8), pointer :: litr1n_to_soil1n(:)
   real(r8), pointer :: sminn_to_soil1n_l1(:)
   real(r8), pointer :: litr2n_to_soil2n(:)
   real(r8), pointer :: sminn_to_soil2n_l2(:)
   real(r8), pointer :: litr3n_to_soil3n(:)
   real(r8), pointer :: sminn_to_soil3n_l3(:)
   real(r8), pointer :: soil1n_to_soil2n(:)
   real(r8), pointer :: sminn_to_soil2n_s1(:)
   real(r8), pointer :: soil2n_to_soil3n(:)
   real(r8), pointer :: sminn_to_soil3n_s2(:)
   real(r8), pointer :: soil3n_to_soil4n(:)
   real(r8), pointer :: sminn_to_soil4n_s3(:)
   real(r8), pointer :: soil4n_to_sminn(:)
   real(r8), pointer :: sminn_to_denit_l1s1(:)
   real(r8), pointer :: sminn_to_denit_l2s2(:)
   real(r8), pointer :: sminn_to_denit_l3s3(:)
   real(r8), pointer :: sminn_to_denit_s1s2(:)
   real(r8), pointer :: sminn_to_denit_s2s3(:)
   real(r8), pointer :: sminn_to_denit_s3s4(:)
   real(r8), pointer :: sminn_to_denit_s4(:)
   real(r8), pointer :: sminn_to_denit_excess(:)
   real(r8), pointer :: gross_nmin(:)
   real(r8), pointer :: net_nmin(:)
!
! local pointers to implicit out scalars
!
! !OTHER LOCAL VARIABLES:
   integer :: c,j          !indices
   integer :: fc           !lake filter column index
!ylu removed 10-22-10
!   real(r8):: dt           !decomp timestep (seconds)
   real(r8):: dtd          !decomp timestep (days)
   real(r8), pointer:: fr(:,:)   !column-level rooting fraction by soil depth
   real(r8):: frw(lbc:ubc)          !rooting fraction weight
   real(r8):: t_scalar(lbc:ubc)     !soil temperature scalar for decomp
   real(r8):: minpsi, maxpsi        !limits for soil water scalar for decomp
   real(r8):: psi                   !temporary soilpsi for water scalar
   real(r8):: w_scalar(lbc:ubc)     !soil water scalar for decomp
   real(r8):: rate_scalar  !combined rate scalar for decomp
   real(r8):: cn_l1(lbc:ubc)        !C:N for litter 1
   real(r8):: cn_l2(lbc:ubc)        !C:N for litter 2
   real(r8):: cn_l3(lbc:ubc)        !C:N for litter 3
   real(r8):: cn_s1        !C:N for SOM 1
   real(r8):: cn_s2        !C:N for SOM 2
   real(r8):: cn_s3        !C:N for SOM 3
   real(r8):: cn_s4        !C:N for SOM 4
   real(r8):: rf_l1s1      !respiration fraction litter 1 -> SOM 1
   real(r8):: rf_l2s2      !respiration fraction litter 2 -> SOM 2
   real(r8):: rf_l3s3      !respiration fraction litter 3 -> SOM 3
   real(r8):: rf_s1s2      !respiration fraction SOM 1 -> SOM 2
   real(r8):: rf_s2s3      !respiration fraction SOM 2 -> SOM 3
   real(r8):: rf_s3s4      !respiration fraction SOM 3 -> SOM 4
   real(r8):: k_l1         !decomposition rate constant litter 1
   real(r8):: k_l2         !decomposition rate constant litter 2
   real(r8):: k_l3         !decomposition rate constant litter 3
   real(r8):: k_s1         !decomposition rate constant SOM 1
   real(r8):: k_s2         !decomposition rate constant SOM 2
   real(r8):: k_s3         !decomposition rate constant SOM 3
   real(r8):: k_s4         !decomposition rate constant SOM 3
   real(r8):: k_frag       !fragmentation rate constant CWD
   real(r8):: ck_l1        !corrected decomposition rate constant litter 1
   real(r8):: ck_l2        !corrected decomposition rate constant litter 2
   real(r8):: ck_l3        !corrected decomposition rate constant litter 3
   real(r8):: ck_s1        !corrected decomposition rate constant SOM 1
   real(r8):: ck_s2        !corrected decomposition rate constant SOM 2
   real(r8):: ck_s3        !corrected decomposition rate constant SOM 3
   real(r8):: ck_s4        !corrected decomposition rate constant SOM 3
   real(r8):: ck_frag      !corrected fragmentation rate constant CWD
   real(r8):: cwd_fcel     !cellulose fraction of coarse woody debris
   real(r8):: cwd_flig     !lignin fraction of coarse woody debris
   real(r8):: cwdc_loss    !fragmentation rate for CWD carbon (gC/m2/s)
   real(r8):: cwdn_loss    !fragmentation rate for CWD nitrogen (gN/m2/s)
   real(r8):: plitr1c_loss(lbc:ubc) !potential C loss from litter 1
   real(r8):: plitr2c_loss(lbc:ubc) !potential C loss from litter 2
   real(r8):: plitr3c_loss(lbc:ubc) !potential C loss from litter 3
   real(r8):: psoil1c_loss(lbc:ubc) !potential C loss from SOM 1
   real(r8):: psoil2c_loss(lbc:ubc) !potential C loss from SOM 2
   real(r8):: psoil3c_loss(lbc:ubc) !potential C loss from SOM 3
   real(r8):: psoil4c_loss(lbc:ubc) !potential C loss from SOM 4
   real(r8):: pmnf_l1s1(lbc:ubc)    !potential mineral N flux, litter 1 -> SOM 1
   real(r8):: pmnf_l2s2(lbc:ubc)    !potential mineral N flux, litter 2 -> SOM 2
   real(r8):: pmnf_l3s3(lbc:ubc)    !potential mineral N flux, litter 3 -> SOM 3
   real(r8):: pmnf_s1s2(lbc:ubc)    !potential mineral N flux, SOM 1 -> SOM 2
   real(r8):: pmnf_s2s3(lbc:ubc)    !potential mineral N flux, SOM 2 -> SOM 3
   real(r8):: pmnf_s3s4(lbc:ubc)    !potential mineral N flux, SOM 3 -> SOM 4
   real(r8):: pmnf_s4(lbc:ubc)      !potential mineral N flux, SOM 4
   real(r8):: immob(lbc:ubc)        !potential N immobilization
   real(r8):: ratio        !temporary variable
   real(r8):: dnp          !denitrification proportion
   integer :: nlevdecomp ! bottom layer to consider for decomp controls
   real(r8):: spinup_scalar         !multiplier for AD_SPINUP algorithm
!EOP
!-----------------------------------------------------------------------
   ! Assign local pointers to derived type arrays
   t_soisno              => clm3%g%l%c%ces%t_soisno
   psisat                => clm3%g%l%c%cps%psisat
   soilpsi               => clm3%g%l%c%cps%soilpsi
   dz                    => clm3%g%l%c%cps%dz
   cwdc                  => clm3%g%l%c%ccs%cwdc
   litr1c                => clm3%g%l%c%ccs%litr1c
   litr2c                => clm3%g%l%c%ccs%litr2c
   litr3c                => clm3%g%l%c%ccs%litr3c
   soil1c                => clm3%g%l%c%ccs%soil1c
   soil2c                => clm3%g%l%c%ccs%soil2c
   soil3c                => clm3%g%l%c%ccs%soil3c
   soil4c                => clm3%g%l%c%ccs%soil4c
   cwdn                  => clm3%g%l%c%cns%cwdn
   litr1n                => clm3%g%l%c%cns%litr1n
   litr2n                => clm3%g%l%c%cns%litr2n
   litr3n                => clm3%g%l%c%cns%litr3n
   fpi                   => clm3%g%l%c%cps%fpi
   cwdc_to_litr2c        => clm3%g%l%c%ccf%cwdc_to_litr2c
   cwdc_to_litr3c        => clm3%g%l%c%ccf%cwdc_to_litr3c
   litr1_hr              => clm3%g%l%c%ccf%litr1_hr
   litr1c_to_soil1c      => clm3%g%l%c%ccf%litr1c_to_soil1c
   litr2_hr              => clm3%g%l%c%ccf%litr2_hr
   litr2c_to_soil2c      => clm3%g%l%c%ccf%litr2c_to_soil2c
   litr3_hr              => clm3%g%l%c%ccf%litr3_hr
   litr3c_to_soil3c      => clm3%g%l%c%ccf%litr3c_to_soil3c
   soil1_hr              => clm3%g%l%c%ccf%soil1_hr
   soil1c_to_soil2c      => clm3%g%l%c%ccf%soil1c_to_soil2c
   soil2_hr              => clm3%g%l%c%ccf%soil2_hr
   soil2c_to_soil3c      => clm3%g%l%c%ccf%soil2c_to_soil3c
   soil3_hr              => clm3%g%l%c%ccf%soil3_hr
   soil3c_to_soil4c      => clm3%g%l%c%ccf%soil3c_to_soil4c
   soil4_hr              => clm3%g%l%c%ccf%soil4_hr
   cwdn_to_litr2n        => clm3%g%l%c%cnf%cwdn_to_litr2n
   cwdn_to_litr3n        => clm3%g%l%c%cnf%cwdn_to_litr3n
   potential_immob       => clm3%g%l%c%cnf%potential_immob
   litr1n_to_soil1n      => clm3%g%l%c%cnf%litr1n_to_soil1n
   sminn_to_soil1n_l1    => clm3%g%l%c%cnf%sminn_to_soil1n_l1
   litr2n_to_soil2n      => clm3%g%l%c%cnf%litr2n_to_soil2n
   sminn_to_soil2n_l2    => clm3%g%l%c%cnf%sminn_to_soil2n_l2
   litr3n_to_soil3n      => clm3%g%l%c%cnf%litr3n_to_soil3n
   sminn_to_soil3n_l3    => clm3%g%l%c%cnf%sminn_to_soil3n_l3
   soil1n_to_soil2n      => clm3%g%l%c%cnf%soil1n_to_soil2n
   sminn_to_soil2n_s1    => clm3%g%l%c%cnf%sminn_to_soil2n_s1
   soil2n_to_soil3n      => clm3%g%l%c%cnf%soil2n_to_soil3n
   sminn_to_soil3n_s2    => clm3%g%l%c%cnf%sminn_to_soil3n_s2
   soil3n_to_soil4n      => clm3%g%l%c%cnf%soil3n_to_soil4n
   sminn_to_soil4n_s3    => clm3%g%l%c%cnf%sminn_to_soil4n_s3
   soil4n_to_sminn       => clm3%g%l%c%cnf%soil4n_to_sminn
   sminn_to_denit_l1s1   => clm3%g%l%c%cnf%sminn_to_denit_l1s1
   sminn_to_denit_l2s2   => clm3%g%l%c%cnf%sminn_to_denit_l2s2
   sminn_to_denit_l3s3   => clm3%g%l%c%cnf%sminn_to_denit_l3s3
   sminn_to_denit_s1s2   => clm3%g%l%c%cnf%sminn_to_denit_s1s2
   sminn_to_denit_s2s3   => clm3%g%l%c%cnf%sminn_to_denit_s2s3
   sminn_to_denit_s3s4   => clm3%g%l%c%cnf%sminn_to_denit_s3s4
   sminn_to_denit_s4     => clm3%g%l%c%cnf%sminn_to_denit_s4
   sminn_to_denit_excess => clm3%g%l%c%cnf%sminn_to_denit_excess
   gross_nmin            => clm3%g%l%c%cnf%gross_nmin
   net_nmin              => clm3%g%l%c%cnf%net_nmin
   rootfr                => clm3%g%l%c%p%pps%rootfr
   clandunit             => clm3%g%l%c%landunit
   itypelun              => clm3%g%l%itype

   ! set time steps
!   dt = real( get_step_size(), r8 )
   dtd = dt/86400.0_r8

   ! set soil organic matter compartment C:N ratios (from Biome-BGC v4.2.0)
   cn_s1 = 12.0_r8
   cn_s2 = 12.0_r8
   cn_s3 = 10.0_r8
   cn_s4 = 10.0_r8

   ! set respiration fractions for fluxes between compartments
   ! (from Biome-BGC v4.2.0)
   rf_l1s1 = 0.39_r8
   rf_l2s2 = 0.55_r8
   rf_l3s3 = 0.29_r8
   rf_s1s2 = 0.28_r8
   rf_s2s3 = 0.46_r8
   rf_s3s4 = 0.55

   ! set the cellulose and lignin fractions for coarse woody debris
   cwd_fcel = 0.76_r8
   cwd_flig = 0.24_r8

   ! set initial base rates for decomposition mass loss (1/day)
   ! (from Biome-BGC v4.2.0, using three SOM pools)
   ! Value inside log function is the discrete-time values for a
   ! daily time step model, and the result of the log function is
   ! the corresponding continuous-time decay rate (1/day), following
   ! Olson, 1963.
   k_l1 = -log(1.0_r8-0.7_r8)
   k_l2 = -log(1.0_r8-0.07_r8)
   k_l3 = -log(1.0_r8-0.014_r8)
   k_s1 = -log(1.0_r8-0.07_r8)
   k_s2 = -log(1.0_r8-0.014_r8)
   k_s3 = -log(1.0_r8-0.0014_r8)
   k_s4 = -log(1.0_r8-0.0001_r8)
   k_frag = -log(1.0_r8-0.001_r8)

   ! calculate the new discrete-time decay rate for model timestep
   k_l1 = 1.0_r8-exp(-k_l1*dtd)
   k_l2 = 1.0_r8-exp(-k_l2*dtd)
   k_l3 = 1.0_r8-exp(-k_l3*dtd)
   k_s1 = 1.0_r8-exp(-k_s1*dtd)
   k_s2 = 1.0_r8-exp(-k_s2*dtd)
   k_s3 = 1.0_r8-exp(-k_s3*dtd)
   k_s4 = 1.0_r8-exp(-k_s4*dtd)
   k_frag = 1.0_r8-exp(-k_frag*dtd)
   
   ! The following code implements the acceleration part of the AD spinup
   ! algorithm, by multiplying all of the SOM decomposition base rates by 10.0.

#if (defined AD_SPINUP)
   spinup_scalar = 20._r8
   k_s1 = k_s1 * spinup_scalar
   k_s2 = k_s2 * spinup_scalar
   k_s3 = k_s3 * spinup_scalar
   k_s4 = k_s4 * spinup_scalar
#endif

   ! calculate function to weight the temperature and water potential scalars
   ! for decomposition control.  


   ! the following normalizes values in fr so that they
   ! sum to 1.0 across top nlevdecomp levels on a column
   frw(lbc:ubc) = 0._r8
   nlevdecomp=5
   allocate(fr(lbc:ubc,nlevdecomp))
   do j=1,nlevdecomp
!dir$ concurrent
!cdir nodep
      do fc = 1,num_soilc
         c = filter_soilc(fc)
         frw(c) = frw(c) + dz(c,j)
      end do
   end do
   do j = 1,nlevdecomp
!dir$ concurrent
!dir$ prefervector
!cdir nodep
      do fc = 1,num_soilc
         c = filter_soilc(fc)
         if (frw(c) /= 0._r8) then
            fr(c,j) = dz(c,j) / frw(c)
         else
            fr(c,j) = 0._r8
         end if
      end do
   end do

   ! calculate rate constant scalar for soil temperature
   ! assuming that the base rate constants are assigned for non-moisture
   ! limiting conditions at 25 C. 
   ! Peter Thornton: 3/13/09
   ! Replaced the Lloyd and Taylor function with a Q10 formula, with Q10 = 1.5
   ! as part of the modifications made to improve the seasonal cycle of 
   ! atmospheric CO2 concentration in global simulations. This does not impact
   ! the base rates at 25 C, which are calibrated from microcosm studies.
   t_scalar(:) = 0._r8
   do j = 1,nlevdecomp
!dir$ concurrent
!cdir nodep
      do fc = 1,num_soilc
         c = filter_soilc(fc)
         t_scalar(c)=t_scalar(c) + (1.5**((t_soisno(c,j)-(SHR_CONST_TKFRZ+25._r8))/10._r8))*fr(c,j)
      end do
   end do

   ! calculate the rate constant scalar for soil water content.
   ! Uses the log relationship with water potential given in
   ! Andren, O., and K. Paustian, 1987. Barley straw decomposition in the field:
   ! a comparison of models. Ecology, 68(5):1190-1200.
   ! and supported by data in
   ! Orchard, V.A., and F.J. Cook, 1983. Relationship between soil respiration
   ! and soil moisture. Soil Biol. Biochem., 15(4):447-453.

   minpsi = -10.0_r8;
   w_scalar(:) = 0._r8
   do j = 1,nlevdecomp
!dir$ concurrent
!cdir nodep
      do fc = 1,num_soilc
         c = filter_soilc(fc)
         maxpsi = psisat(c,j)
         psi = min(soilpsi(c,j),maxpsi)
         ! decomp only if soilpsi is higher than minpsi
         if (psi > minpsi) then
            w_scalar(c) = w_scalar(c) + (log(minpsi/psi)/log(minpsi/maxpsi))*fr(c,j)
         end if
      end do
   end do

   ! set initial values for potential C and N fluxes
   plitr1c_loss(:) = 0._r8
   plitr2c_loss(:) = 0._r8
   plitr3c_loss(:) = 0._r8
   psoil1c_loss(:) = 0._r8
   psoil2c_loss(:) = 0._r8
   psoil3c_loss(:) = 0._r8
   psoil4c_loss(:) = 0._r8
   pmnf_l1s1(:) = 0._r8
   pmnf_l2s2(:) = 0._r8
   pmnf_l3s3(:) = 0._r8
   pmnf_s1s2(:) = 0._r8
   pmnf_s2s3(:) = 0._r8
   pmnf_s3s4(:) = 0._r8
   pmnf_s4(:) = 0._r8

   ! column loop to calculate potential decomp rates and total immobilization
   ! demand.
!dir$ concurrent
!cdir nodep
   do fc = 1,num_soilc
      c = filter_soilc(fc)

      ! calculate litter compartment C:N ratios
      if (litr1n(c) > 0._r8) cn_l1(c) = litr1c(c)/litr1n(c)
      if (litr2n(c) > 0._r8) cn_l2(c) = litr2c(c)/litr2n(c)
      if (litr3n(c) > 0._r8) cn_l3(c) = litr3c(c)/litr3n(c)

      ! calculate the final rate scalar as the product of temperature and water
      ! rate scalars, and correct the base decomp rates

      rate_scalar = t_scalar(c) * w_scalar(c)
      ck_l1 = k_l1 * rate_scalar
      ck_l2 = k_l2 * rate_scalar
      ck_l3 = k_l3 * rate_scalar
      ck_s1 = k_s1 * rate_scalar
      ck_s2 = k_s2 * rate_scalar
      ck_s3 = k_s3 * rate_scalar
      ck_s4 = k_s4 * rate_scalar
      ck_frag = k_frag * rate_scalar

      ! calculate the non-nitrogen-limited fluxes
      ! these fluxes include the  "/ dt" term to put them on a
      ! per second basis, since the rate constants have been
      ! calculated on a per timestep basis.

      ! CWD fragmentation -> litter pools
      cwdc_loss = cwdc(c) * ck_frag / dt
      cwdc_to_litr2c(c) = cwdc_loss * cwd_fcel
      cwdc_to_litr3c(c) = cwdc_loss * cwd_flig
      cwdn_loss = cwdn(c) * ck_frag / dt
      cwdn_to_litr2n(c) = cwdn_loss * cwd_fcel
      cwdn_to_litr3n(c) = cwdn_loss * cwd_flig

      ! litter 1 -> SOM 1
      if (litr1c(c) > 0._r8) then
         plitr1c_loss(c) = litr1c(c) * ck_l1 / dt
         ratio = 0._r8
         if (litr1n(c) > 0._r8) ratio = cn_s1/cn_l1(c)
         pmnf_l1s1(c) = (plitr1c_loss(c) * (1.0_r8 - rf_l1s1 - ratio))/cn_s1
      end if

      ! litter 2 -> SOM 2
      if (litr2c(c) > 0._r8) then
         plitr2c_loss(c) = litr2c(c) * ck_l2 / dt
         ratio = 0._r8
         if (litr2n(c) > 0._r8) ratio = cn_s2/cn_l2(c)
         pmnf_l2s2(c) = (plitr2c_loss(c) * (1.0_r8 - rf_l2s2 - ratio))/cn_s2
      end if

      ! litter 3 -> SOM 3
      if (litr3c(c) > 0._r8) then
         plitr3c_loss(c) = litr3c(c) * ck_l3 / dt
         ratio = 0._r8
         if (litr3n(c) > 0._r8) ratio = cn_s3/cn_l3(c)
         pmnf_l3s3(c) = (plitr3c_loss(c) * (1.0_r8 - rf_l3s3 - ratio))/cn_s3
      end if

      ! SOM 1 -> SOM 2
      if (soil1c(c) > 0._r8) then
         psoil1c_loss(c) = soil1c(c) * ck_s1 / dt
         pmnf_s1s2(c) = (psoil1c_loss(c) * (1.0_r8 - rf_s1s2 - (cn_s2/cn_s1)))/cn_s2
      end if

      ! SOM 2 -> SOM 3
      if (soil2c(c) > 0._r8) then
         psoil2c_loss(c) = soil2c(c) * ck_s2 / dt
         pmnf_s2s3(c) = (psoil2c_loss(c) * (1.0_r8 - rf_s2s3 - (cn_s3/cn_s2)))/cn_s3
      end if

      ! SOM 3 -> SOM 4
      if (soil3c(c) > 0._r8) then
         psoil3c_loss(c) = soil3c(c) * ck_s3 / dt
         pmnf_s3s4(c) = (psoil3c_loss(c) * (1.0_r8 - rf_s3s4 - (cn_s4/cn_s3)))/cn_s4
      end if

      ! Loss from SOM 4 is entirely respiration (no downstream pool)
      if (soil4c(c) > 0._r8) then
         psoil4c_loss(c) = soil4c(c) * ck_s4 / dt
         pmnf_s4(c) = -psoil4c_loss(c)/cn_s4
      end if

      ! Sum up all the potential immobilization fluxes (positive pmnf flux)
      ! and all the mineralization fluxes (negative pmnf flux)

      immob(c) = 0._r8
      ! litter 1 -> SOM 1
      if (pmnf_l1s1(c) > 0._r8) then
         immob(c) = immob(c) + pmnf_l1s1(c)
      else
         gross_nmin(c) = gross_nmin(c) - pmnf_l1s1(c)
      end if

      ! litter 2 -> SOM 2
      if (pmnf_l2s2(c) > 0._r8) then
         immob(c) = immob(c) + pmnf_l2s2(c)
      else
         gross_nmin(c) = gross_nmin(c) - pmnf_l2s2(c)
      end if

      ! litter 3 -> SOM 3
      if (pmnf_l3s3(c) > 0._r8) then
         immob(c) = immob(c) + pmnf_l3s3(c)
      else
         gross_nmin(c) = gross_nmin(c) - pmnf_l3s3(c)
      end if

      ! SOM 1 -> SOM 2
      if (pmnf_s1s2(c) > 0._r8) then
         immob(c) = immob(c) + pmnf_s1s2(c)
      else
         gross_nmin(c) = gross_nmin(c) - pmnf_s1s2(c)
      end if

      ! SOM 2 -> SOM 3
      if (pmnf_s2s3(c) > 0._r8) then
         immob(c) = immob(c) + pmnf_s2s3(c)
      else
         gross_nmin(c) = gross_nmin(c) - pmnf_s2s3(c)
      end if

      ! SOM 3 -> SOM 4
      if (pmnf_s3s4(c) > 0._r8) then
         immob(c) = immob(c) + pmnf_s3s4(c)
      else
         gross_nmin(c) = gross_nmin(c) - pmnf_s3s4(c)
      end if

      ! SOM 4
      gross_nmin(c) = gross_nmin(c) - pmnf_s4(c)

      potential_immob(c) = immob(c)

   end do ! end column loop

   ! now that potential N immobilization is known, call allocation
   ! to resolve the competition between plants and soil heterotrophs
   ! for available soil mineral N resource.

   call CNAllocation(lbp, ubp, lbc,ubc,num_soilc,filter_soilc,num_soilp,filter_soilp)

   ! column loop to calculate actual immobilization and decomp rates, following
   ! resolution of plant/heterotroph  competition for mineral N

   dnp = 0.01_r8

!dir$ concurrent
!cdir nodep
   do fc = 1,num_soilc
      c = filter_soilc(fc)

      ! upon return from CNAllocation, the fraction of potential immobilization
      ! has been set (cps%fpi). now finish the decomp calculations.
      ! Only the immobilization steps are limited by fpi (pmnf > 0)
      ! Also calculate denitrification losses as a simple proportion
      ! of mineralization flux.

      ! litter 1 fluxes (labile pool)
      if (litr1c(c) > 0._r8) then
         if (pmnf_l1s1(c) > 0._r8) then
            plitr1c_loss(c) = plitr1c_loss(c) * fpi(c)
            pmnf_l1s1(c) = pmnf_l1s1(c) * fpi(c)
            sminn_to_denit_l1s1(c) = 0._r8
         else
            sminn_to_denit_l1s1(c) = -dnp * pmnf_l1s1(c)
         end if
         litr1_hr(c) = rf_l1s1 * plitr1c_loss(c)
         litr1c_to_soil1c(c) = (1._r8 - rf_l1s1) * plitr1c_loss(c)
         if (litr1n(c) > 0._r8) litr1n_to_soil1n(c) = plitr1c_loss(c) / cn_l1(c)
         sminn_to_soil1n_l1(c) = pmnf_l1s1(c)
         net_nmin(c) = net_nmin(c) - pmnf_l1s1(c)
      end if

      ! litter 2 fluxes (cellulose pool)
      if (litr2c(c) > 0._r8) then
         if (pmnf_l2s2(c) > 0._r8) then
            plitr2c_loss(c) = plitr2c_loss(c) * fpi(c)
            pmnf_l2s2(c) = pmnf_l2s2(c) * fpi(c)
            sminn_to_denit_l2s2(c) = 0._r8
         else
            sminn_to_denit_l2s2(c) = -dnp * pmnf_l2s2(c)
         end if
         litr2_hr(c) = rf_l2s2 * plitr2c_loss(c)
         litr2c_to_soil2c(c) = (1._r8 - rf_l2s2) * plitr2c_loss(c)
         if (litr2n(c) > 0._r8) litr2n_to_soil2n(c) = plitr2c_loss(c) / cn_l2(c)
         sminn_to_soil2n_l2(c) = pmnf_l2s2(c)
         net_nmin(c) = net_nmin(c) - pmnf_l2s2(c)
      end if

      ! litter 3 fluxes (lignin pool)
      if (litr3c(c) > 0._r8) then
         if (pmnf_l3s3(c) > 0._r8) then
            plitr3c_loss(c) = plitr3c_loss(c) * fpi(c)
            pmnf_l3s3(c) = pmnf_l3s3(c) * fpi(c)
            sminn_to_denit_l3s3(c) = 0._r8
         else
            sminn_to_denit_l3s3(c) = -dnp * pmnf_l3s3(c)
         end if
         litr3_hr(c) = rf_l3s3 * plitr3c_loss(c)
         litr3c_to_soil3c(c) = (1._r8 - rf_l3s3) * plitr3c_loss(c)
         if (litr3n(c) > 0._r8) litr3n_to_soil3n(c) = plitr3c_loss(c) / cn_l3(c)
         sminn_to_soil3n_l3(c) = pmnf_l3s3(c)
         net_nmin(c) = net_nmin(c) - pmnf_l3s3(c)
      end if

      ! SOM 1 fluxes (fast rate soil organic matter pool)
      if (soil1c(c) > 0._r8) then
         if (pmnf_s1s2(c) > 0._r8) then
            psoil1c_loss(c) = psoil1c_loss(c) * fpi(c)
            pmnf_s1s2(c) = pmnf_s1s2(c) * fpi(c)
            sminn_to_denit_s1s2(c) = 0._r8
         else
            sminn_to_denit_s1s2(c) = -dnp * pmnf_s1s2(c)
         end if
         soil1_hr(c) = rf_s1s2 * psoil1c_loss(c)
         soil1c_to_soil2c(c) = (1._r8 - rf_s1s2) * psoil1c_loss(c)
         soil1n_to_soil2n(c) = psoil1c_loss(c) / cn_s1
         sminn_to_soil2n_s1(c) = pmnf_s1s2(c)
         net_nmin(c) = net_nmin(c) - pmnf_s1s2(c)
      end if

      ! SOM 2 fluxes (medium rate soil organic matter pool)
      if (soil2c(c) > 0._r8) then
         if (pmnf_s2s3(c) > 0._r8) then
            psoil2c_loss(c) = psoil2c_loss(c) * fpi(c)
            pmnf_s2s3(c) = pmnf_s2s3(c) * fpi(c)
            sminn_to_denit_s2s3(c) = 0._r8
         else
            sminn_to_denit_s2s3(c) = -dnp * pmnf_s2s3(c)
         end if
         soil2_hr(c) = rf_s2s3 * psoil2c_loss(c)
         soil2c_to_soil3c(c) = (1._r8 - rf_s2s3) * psoil2c_loss(c)
         soil2n_to_soil3n(c) = psoil2c_loss(c) / cn_s2
         sminn_to_soil3n_s2(c) = pmnf_s2s3(c)
         net_nmin(c) = net_nmin(c) - pmnf_s2s3(c)
      end if

      ! SOM 3 fluxes (slow rate soil organic matter pool)
      if (soil3c(c) > 0._r8) then
         if (pmnf_s3s4(c) > 0._r8) then
            psoil3c_loss(c) = psoil3c_loss(c) * fpi(c)
            pmnf_s3s4(c) = pmnf_s3s4(c) * fpi(c)
            sminn_to_denit_s3s4(c) = 0._r8
         else
            sminn_to_denit_s3s4(c) = -dnp * pmnf_s3s4(c)
         end if
         soil3_hr(c) = rf_s3s4 * psoil3c_loss(c)
         soil3c_to_soil4c(c) = (1._r8 - rf_s3s4) * psoil3c_loss(c)
         soil3n_to_soil4n(c) = psoil3c_loss(c) / cn_s3
         sminn_to_soil4n_s3(c) = pmnf_s3s4(c)
         net_nmin(c) = net_nmin(c) - pmnf_s3s4(c)
      end if

      ! SOM 4 fluxes (slowest rate soil organic matter pool)
      if (soil4c(c) > 0._r8) then
         soil4_hr(c) = psoil4c_loss(c)
         soil4n_to_sminn(c) = psoil4c_loss(c) / cn_s4
         sminn_to_denit_s4(c) = -dnp * pmnf_s4(c)
         net_nmin(c) = net_nmin(c) - pmnf_s4(c)
      end if

   end do

   deallocate(fr)

end subroutine CNDecompAlloc
!-----------------------------------------------------------------------
#endif

end module CNDecompMod
module CNSetValueMod

#if (defined CN)

!-----------------------------------------------------------------------
!BOP
!
! !MODULE: CNSetValueMod
!
! !DESCRIPTION:
! contains code to set all CN variables to specified value
! Used for both initialization of special landunit values, and
! setting fluxes to 0.0 at the beginning of each time step
! 3/23/09, Peter Thornton: Added new subroutine, CNZeroFluxes_dwt(), 
!     which initialize flux variables used in the pftdyn
!     routines. This is called from clm_driver1, as
!     these variables need to be initialized outside of the clumps loop.
!
! !USES:
    use shr_kind_mod, only: r8 => shr_kind_r8
    use clm_varpar  , only: nlevgrnd
!ylu remove    use clm_varctl  , only: iulog
    use clmtype
    implicit none
    save
    private
! !PUBLIC MEMBER FUNCTIONS:
    public :: CNZeroFluxes
    public :: CNZeroFluxes_dwt
    public :: CNSetPps
    public :: CNSetPepv
    public :: CNSetPcs
    public :: CNSetPns
    public :: CNSetPcf
    public :: CNSetPnf
    public :: CNSetCps
    public :: CNSetCcs
    public :: CNSetCns
    public :: CNSetCcf
    public :: CNSetCnf
! !PRIVATE MEMBER FUNCTIONS:
!
! !REVISION HISTORY:
! 9/04/03: Created by Peter Thornton
!
!EOP
!-----------------------------------------------------------------------

contains

!-----------------------------------------------------------------------
!BOP
!
! !IROUTINE: CNZeroFluxes
!
! !INTERFACE:
subroutine CNZeroFluxes(num_filterc, filterc, num_filterp, filterp)
!
! !DESCRIPTION:
!
! !USES:
!
! !ARGUMENTS:
    implicit none
    integer, intent(in) :: num_filterc ! number of good values in filterc
    integer, intent(in) :: filterc(:)  ! column filter
    integer, intent(in) :: num_filterp ! number of good values in filterp
    integer, intent(in) :: filterp(:)  ! pft filter
!
! !CALLED FROM:
! subroutine CNEcosystemDyn in module CNEcosystemDynMod.F90
!
! !REVISION HISTORY:
! 9/04/03: Created by Peter Thornton
!
! !LOCAL VARIABLES:
! local pointers to implicit in scalars
!
!
! local pointers to implicit in/out scalars
!
!
! local pointers to implicit out scalars
!
!
! !OTHER LOCAL VARIABLES:
!EOP
!-----------------------------------------------------------------------

    ! zero the column-level C and N fluxes
    call CNSetCcf(num_filterc, filterc, 0._r8, clm3%g%l%c%ccf)
#if (defined C13)
    call CNSetCcf(num_filterc, filterc, 0._r8, clm3%g%l%c%cc13f)
#endif
    call CNSetCnf(num_filterc, filterc, 0._r8, clm3%g%l%c%cnf)

    ! zero the column-average pft-level C and N fluxes
    call CNSetPcf(num_filterc, filterc, 0._r8, clm3%g%l%c%ccf%pcf_a)
    call CNSetPnf(num_filterc, filterc, 0._r8, clm3%g%l%c%cnf%pnf_a)

    ! zero the pft-level C and N fluxes
    call CNSetPcf(num_filterp, filterp, 0._r8, clm3%g%l%c%p%pcf)
#if (defined C13)
    call CNSetPcf(num_filterp, filterp, 0._r8, clm3%g%l%c%p%pc13f)
#endif
    call CNSetPnf(num_filterp, filterp, 0._r8, clm3%g%l%c%p%pnf)

end subroutine CNZeroFluxes
!-----------------------------------------------------------------------

!-----------------------------------------------------------------------
!BOP
!
! !IROUTINE: CNZeroFluxes_dwt
!
! !INTERFACE:
subroutine CNZeroFluxes_dwt()
!
! !DESCRIPTION:
!
! !USES:
    use decompMod   , only : get_proc_bounds
!
! !ARGUMENTS:
    implicit none
!
! !CALLED FROM:
! subroutine clm_driver1
!
! !REVISION HISTORY:
! 3/23/09: Created by Peter Thornton
!
! !LOCAL VARIABLES:
! local pointers to implicit in scalars
!
!
! local pointers to implicit in/out scalars
!
!
! local pointers to implicit out scalars
!
!
! !OTHER LOCAL VARIABLES:
    integer  :: begp, endp    ! proc beginning and ending pft indices
    integer  :: begc, endc    ! proc beginning and ending column indices
    integer  :: begl, endl    ! proc beginning and ending landunit indices
    integer  :: begg, endg    ! proc beginning and ending gridcell indices
    integer  :: c, p          ! indices
    type(column_type),   pointer :: cptr         ! pointer to column derived subtype
!EOP
!-----------------------------------------------------------------------

    call get_proc_bounds(begg, endg, begl, endl, begc, endc, begp, endp)
    cptr => clm3%g%l%c
    ! set column-level conversion and product pool fluxes
    ! to 0 at the beginning of every timestep

    do c = begc,endc
       ! C fluxes
       cptr%ccf%dwt_seedc_to_leaf(c) = 0._r8
       cptr%ccf%dwt_seedc_to_deadstem(c) = 0._r8
       cptr%ccf%dwt_conv_cflux(c) = 0._r8
       cptr%ccf%dwt_prod10c_gain(c) = 0._r8
       cptr%ccf%dwt_prod100c_gain(c) = 0._r8
       cptr%ccf%dwt_frootc_to_litr1c(c) = 0._r8
       cptr%ccf%dwt_frootc_to_litr2c(c) = 0._r8
       cptr%ccf%dwt_frootc_to_litr3c(c) = 0._r8
       cptr%ccf%dwt_livecrootc_to_cwdc(c) = 0._r8
       cptr%ccf%dwt_deadcrootc_to_cwdc(c) = 0._r8
#if (defined C13)
       ! C13 fluxes
       cptr%cc13f%dwt_seedc_to_leaf(c) = 0._r8
       cptr%cc13f%dwt_seedc_to_deadstem(c) = 0._r8
       cptr%cc13f%dwt_conv_cflux(c) = 0._r8
       cptr%cc13f%dwt_prod10c_gain(c) = 0._r8
       cptr%cc13f%dwt_prod100c_gain(c) = 0._r8
       cptr%cc13f%dwt_frootc_to_litr1c(c) = 0._r8
       cptr%cc13f%dwt_frootc_to_litr2c(c) = 0._r8
       cptr%cc13f%dwt_frootc_to_litr3c(c) = 0._r8
       cptr%cc13f%dwt_livecrootc_to_cwdc(c) = 0._r8
       cptr%cc13f%dwt_deadcrootc_to_cwdc(c) = 0._r8
#endif
       ! N fluxes
       cptr%cnf%dwt_seedn_to_leaf(c) = 0._r8
       cptr%cnf%dwt_seedn_to_deadstem(c) = 0._r8
       cptr%cnf%dwt_conv_nflux(c) = 0._r8
       cptr%cnf%dwt_prod10n_gain(c) = 0._r8
       cptr%cnf%dwt_prod100n_gain(c) = 0._r8
       cptr%cnf%dwt_frootn_to_litr1n(c) = 0._r8
       cptr%cnf%dwt_frootn_to_litr2n(c) = 0._r8
       cptr%cnf%dwt_frootn_to_litr3n(c) = 0._r8
       cptr%cnf%dwt_livecrootn_to_cwdn(c) = 0._r8
       cptr%cnf%dwt_deadcrootn_to_cwdn(c) = 0._r8
    end do
#if (defined CN)
    do p = begp,endp
       cptr%p%pcs%dispvegc(p)   = 0._r8
       cptr%p%pcs%storvegc(p)   = 0._r8
       cptr%p%pcs%totpftc(p)    = 0._r8
#if (defined C13)
       cptr%p%pc13s%dispvegc(p) = 0._r8
       cptr%p%pc13s%storvegc(p) = 0._r8
       cptr%p%pc13s%totpftc(p)  = 0._r8
#endif
       cptr%p%pns%dispvegn(p)   = 0._r8
       cptr%p%pns%storvegn(p)   = 0._r8
       cptr%p%pns%totvegn(p)    = 0._r8
       cptr%p%pns%totpftn(p)    = 0._r8
    end do
#endif
    
end subroutine CNZeroFluxes_dwt
!-----------------------------------------------------------------------

!-----------------------------------------------------------------------
!BOP
!
! !IROUTINE: CNSetPps
!
! !INTERFACE:
subroutine CNSetPps(num, filter, val, pps)
!
! !DESCRIPTION:
! Set pft physical state variables
! !USES:
    use clm_varpar  , only : numrad
!
! !ARGUMENTS:
    implicit none
    integer , intent(in) :: num
    integer , intent(in) :: filter(:)
    real(r8), intent(in) :: val
    type (pft_pstate_type), intent(inout) :: pps
!
! !REVISION HISTORY:
! Created by Peter Thornton
!
! !LOCAL VARIABLES:
! local pointers to implicit in/out arrays
!
! !OTHER LOCAL VARIABLES:
   integer :: fi,i,j     ! loop index
!EOP
!------------------------------------------------------------------------

   do fi = 1,num
      i = filter(fi)
      pps%slasun(i) = val
      pps%slasha(i) = val
      pps%lncsun(i) = val
      pps%lncsha(i) = val
      pps%vcmxsun(i) = val
      pps%vcmxsha(i) = val
      pps%gdir(i) = val
   end do

   do j = 1,numrad
      do fi = 1,num
         i = filter(fi)
         pps%omega(i,j) = val
         pps%eff_kid(i,j) = val
         pps%eff_kii(i,j) = val
         pps%sun_faid(i,j) = val
         pps%sun_faii(i,j) = val
         pps%sha_faid(i,j) = val
         pps%sha_faii(i,j) = val
      end do
   end do

end subroutine CNSetPps
!-----------------------------------------------------------------------

!-----------------------------------------------------------------------
!BOP
!
! !IROUTINE: CNSetPepv
!
! !INTERFACE:
subroutine CNSetPepv (num, filter, val, pepv)
!
! !DESCRIPTION:
! Set pft ecophysiological variables
!
! !ARGUMENTS:
    implicit none
    integer , intent(in) :: num
    integer , intent(in) :: filter(:)
    real(r8), intent(in) :: val
    type (pft_epv_type), intent(inout) :: pepv
!
! !REVISION HISTORY:
! Created by Peter Thornton
!
! !LOCAL VARIABLES:
! local pointers to implicit in/out arrays
!
! !OTHER LOCAL VARIABLES:
   integer :: fi,i     ! loop index
!EOP
!------------------------------------------------------------------------

   do fi = 1,num
      i = filter(fi)
      pepv%dormant_flag(i) = val
      pepv%days_active(i) = val
      pepv%onset_flag(i) = val
      pepv%onset_counter(i) = val
      pepv%onset_gddflag(i) = val
      pepv%onset_fdd(i) = val
      pepv%onset_gdd(i) = val
      pepv%onset_swi(i) = val
      pepv%offset_flag(i) = val
      pepv%offset_counter(i) = val
      pepv%offset_fdd(i) = val
      pepv%offset_swi(i) = val
      pepv%lgsf(i) = val
      pepv%bglfr(i) = val
      pepv%bgtr(i) = val
      pepv%dayl(i) = val
      pepv%prev_dayl(i) = val
      pepv%annavg_t2m(i) = val
      pepv%tempavg_t2m(i) = val
      pepv%gpp(i) = val
      pepv%availc(i) = val
      pepv%xsmrpool_recover(i) = val
#if (defined C13)
      pepv%xsmrpool_c13ratio(i) = val
#endif
      pepv%alloc_pnow(i) = val
      pepv%c_allometry(i) = val
      pepv%n_allometry(i) = val
      pepv%plant_ndemand(i) = val
      pepv%tempsum_potential_gpp(i) = val
      pepv%annsum_potential_gpp(i) = val
      pepv%tempmax_retransn(i) = val
      pepv%annmax_retransn(i) = val
      pepv%avail_retransn(i) = val
      pepv%plant_nalloc(i) = val
      pepv%plant_calloc(i) = val
      pepv%excess_cflux(i) = val
      pepv%downreg(i) = val
      pepv%prev_leafc_to_litter(i) = val
      pepv%prev_frootc_to_litter(i) = val
      pepv%tempsum_npp(i) = val
      pepv%annsum_npp(i) = val
#if (defined CNDV)
      pepv%tempsum_litfall(i) = val
      pepv%annsum_litfall(i) = val
#endif
   end do

end subroutine CNSetPepv
!-----------------------------------------------------------------------

!-----------------------------------------------------------------------
!BOP
!
! !IROUTINE: CNSetPcs
!
! !INTERFACE:
subroutine CNSetPcs (num, filter, val, pcs)
!
! !DESCRIPTION:
! Set pft carbon state variables
!
! !ARGUMENTS:
    implicit none
    integer , intent(in) :: num
    integer , intent(in) :: filter(:)
    real(r8), intent(in) :: val
    type (pft_cstate_type), intent(inout) :: pcs
!
! !REVISION HISTORY:
! Created by Peter Thornton
!
! !LOCAL VARIABLES:
! local pointers to implicit in/out arrays
!
! !OTHER LOCAL VARIABLES:
   integer :: fi,i     ! loop index
!EOP
!------------------------------------------------------------------------

   do fi = 1,num
      i = filter(fi)
      pcs%leafc(i) = val
      pcs%leafc_storage(i) = val
      pcs%leafc_xfer(i) = val
      pcs%frootc(i) = val
      pcs%frootc_storage(i) = val
      pcs%frootc_xfer(i) = val
      pcs%livestemc(i) = val
      pcs%livestemc_storage(i) = val
      pcs%livestemc_xfer(i) = val
      pcs%deadstemc(i) = val
      pcs%deadstemc_storage(i) = val
      pcs%deadstemc_xfer(i) = val
      pcs%livecrootc(i) = val
      pcs%livecrootc_storage(i) = val
      pcs%livecrootc_xfer(i) = val
      pcs%deadcrootc(i) = val
      pcs%deadcrootc_storage(i) = val
      pcs%deadcrootc_xfer(i) = val
      pcs%gresp_storage(i) = val
      pcs%gresp_xfer(i) = val
      pcs%cpool(i) = val
      pcs%xsmrpool(i) = val
      pcs%pft_ctrunc(i) = val
      pcs%dispvegc(i) = val
      pcs%storvegc(i) = val
      pcs%totvegc(i) = val
      pcs%totpftc(i) = val

#if (defined CLAMP)
      ! CLAMP variables
      pcs%woodc(i) = val
#endif

#if (defined CROP)
      pcs%grainc(i)         = val
      pcs%grainc_storage(i) = val
      pcs%grainc_xfer(i)    = val
#endif
   end do

end subroutine CNSetPcs
!-----------------------------------------------------------------------

!-----------------------------------------------------------------------
!BOP
!
! !IROUTINE: CNSetPns
!
! !INTERFACE:
subroutine CNSetPns(num, filter, val, pns)
!
! !DESCRIPTION:
! Set pft nitrogen state variables
!
! !ARGUMENTS:
    implicit none
    integer , intent(in) :: num
    integer , intent(in) :: filter(:)
    real(r8), intent(in) :: val
    type (pft_nstate_type), intent(inout) :: pns
!
! !REVISION HISTORY:
! Created by Peter Thornton
!
! !LOCAL VARIABLES:
! local pointers to implicit in/out arrays
!
! !OTHER LOCAL VARIABLES:
   integer :: fi,i     ! loop index
!EOP
!------------------------------------------------------------------------

   do fi = 1,num
      i = filter(fi)
      pns%leafn(i) = val
      pns%leafn_storage(i) = val
      pns%leafn_xfer(i) = val
      pns%frootn(i) = val
      pns%frootn_storage(i) = val
      pns%frootn_xfer(i) = val
      pns%livestemn(i) = val
      pns%livestemn_storage(i) = val
      pns%livestemn_xfer(i) = val
      pns%deadstemn(i) = val
      pns%deadstemn_storage(i) = val
      pns%deadstemn_xfer(i) = val
      pns%livecrootn(i) = val
      pns%livecrootn_storage(i) = val
      pns%livecrootn_xfer(i) = val
      pns%deadcrootn(i) = val
      pns%deadcrootn_storage(i) = val
      pns%deadcrootn_xfer(i) = val
      pns%retransn(i) = val
      pns%npool(i) = val
      pns%pft_ntrunc(i) = val
      pns%dispvegn(i) = val
      pns%storvegn(i) = val
      pns%totvegn(i) = val
      pns%totpftn(i) = val
#if (defined CROP)
      pns%grainn(i)         = val
      pns%grainn_storage(i) = val
      pns%grainn_xfer(i)    = val
#endif
   end do

end subroutine CNSetPns
!-----------------------------------------------------------------------

!-----------------------------------------------------------------------
!BOP
!
! !IROUTINE: CNSetPcf
!
! !INTERFACE:
subroutine CNSetPcf(num, filter, val, pcf)
!
! !DESCRIPTION:
! Set pft carbon flux variables
!
! !ARGUMENTS:
    implicit none
    integer , intent(in) :: num
    integer , intent(in) :: filter(:)
    real(r8), intent(in) :: val
    type (pft_cflux_type), intent(inout) :: pcf
!
! !REVISION HISTORY:
! Created by Peter Thornton
!
! !LOCAL VARIABLES:
! local pointers to implicit in/out arrays
!
! !OTHER LOCAL VARIABLES:
   integer :: fi,i     ! loop index
!EOP
!------------------------------------------------------------------------

   do fi = 1,num
      i = filter(fi)
      pcf%m_leafc_to_litter(i) = val
      pcf%m_frootc_to_litter(i) = val
      pcf%m_leafc_storage_to_litter(i) = val
      pcf%m_frootc_storage_to_litter(i) = val
      pcf%m_livestemc_storage_to_litter(i) = val
      pcf%m_deadstemc_storage_to_litter(i) = val
      pcf%m_livecrootc_storage_to_litter(i) = val
      pcf%m_deadcrootc_storage_to_litter(i) = val
      pcf%m_leafc_xfer_to_litter(i) = val
      pcf%m_frootc_xfer_to_litter(i) = val
      pcf%m_livestemc_xfer_to_litter(i) = val
      pcf%m_deadstemc_xfer_to_litter(i) = val
      pcf%m_livecrootc_xfer_to_litter(i) = val
      pcf%m_deadcrootc_xfer_to_litter(i) = val
      pcf%m_livestemc_to_litter(i) = val
      pcf%m_deadstemc_to_litter(i) = val
      pcf%m_livecrootc_to_litter(i) = val
      pcf%m_deadcrootc_to_litter(i) = val
      pcf%m_gresp_storage_to_litter(i) = val
      pcf%m_gresp_xfer_to_litter(i) = val
      pcf%hrv_leafc_to_litter(i) = val             
      pcf%hrv_leafc_storage_to_litter(i) = val     
      pcf%hrv_leafc_xfer_to_litter(i) = val        
      pcf%hrv_frootc_to_litter(i) = val            
      pcf%hrv_frootc_storage_to_litter(i) = val    
      pcf%hrv_frootc_xfer_to_litter(i) = val       
      pcf%hrv_livestemc_to_litter(i) = val         
      pcf%hrv_livestemc_storage_to_litter(i) = val 
      pcf%hrv_livestemc_xfer_to_litter(i) = val    
      pcf%hrv_deadstemc_to_prod10c(i) = val        
      pcf%hrv_deadstemc_to_prod100c(i) = val       
      pcf%hrv_deadstemc_storage_to_litter(i) = val 
      pcf%hrv_deadstemc_xfer_to_litter(i) = val    
      pcf%hrv_livecrootc_to_litter(i) = val        
      pcf%hrv_livecrootc_storage_to_litter(i) = val
      pcf%hrv_livecrootc_xfer_to_litter(i) = val   
      pcf%hrv_deadcrootc_to_litter(i) = val        
      pcf%hrv_deadcrootc_storage_to_litter(i) = val
      pcf%hrv_deadcrootc_xfer_to_litter(i) = val   
      pcf%hrv_gresp_storage_to_litter(i) = val     
      pcf%hrv_gresp_xfer_to_litter(i) = val        
      pcf%hrv_xsmrpool_to_atm(i) = val                 
      pcf%m_leafc_to_fire(i) = val
      pcf%m_frootc_to_fire(i) = val
      pcf%m_leafc_storage_to_fire(i) = val
      pcf%m_frootc_storage_to_fire(i) = val
      pcf%m_livestemc_storage_to_fire(i) = val
      pcf%m_deadstemc_storage_to_fire(i) = val
      pcf%m_livecrootc_storage_to_fire(i) = val
      pcf%m_deadcrootc_storage_to_fire(i) = val
      pcf%m_leafc_xfer_to_fire(i) = val
      pcf%m_frootc_xfer_to_fire(i) = val
      pcf%m_livestemc_xfer_to_fire(i) = val
      pcf%m_deadstemc_xfer_to_fire(i) = val
      pcf%m_livecrootc_xfer_to_fire(i) = val
      pcf%m_deadcrootc_xfer_to_fire(i) = val
      pcf%m_livestemc_to_fire(i) = val
      pcf%m_deadstemc_to_fire(i) = val
      pcf%m_deadstemc_to_litter_fire(i) = val
      pcf%m_livecrootc_to_fire(i) = val
      pcf%m_deadcrootc_to_fire(i) = val
      pcf%m_deadcrootc_to_litter_fire(i) = val
      pcf%m_gresp_storage_to_fire(i) = val
      pcf%m_gresp_xfer_to_fire(i) = val
      pcf%leafc_xfer_to_leafc(i) = val
      pcf%frootc_xfer_to_frootc(i) = val
      pcf%livestemc_xfer_to_livestemc(i) = val
      pcf%deadstemc_xfer_to_deadstemc(i) = val
      pcf%livecrootc_xfer_to_livecrootc(i) = val
      pcf%deadcrootc_xfer_to_deadcrootc(i) = val
      pcf%leafc_to_litter(i) = val
      pcf%frootc_to_litter(i) = val
      pcf%leaf_mr(i) = val
      pcf%froot_mr(i) = val
      pcf%livestem_mr(i) = val
      pcf%livecroot_mr(i) = val
      pcf%leaf_curmr(i) = val
      pcf%froot_curmr(i) = val
      pcf%livestem_curmr(i) = val
      pcf%livecroot_curmr(i) = val
      pcf%leaf_xsmr(i) = val
      pcf%froot_xsmr(i) = val
      pcf%livestem_xsmr(i) = val
      pcf%livecroot_xsmr(i) = val
      pcf%psnsun_to_cpool(i) = val
      pcf%psnshade_to_cpool(i) = val
      pcf%cpool_to_xsmrpool(i) = val
      pcf%cpool_to_leafc(i) = val
      pcf%cpool_to_leafc_storage(i) = val
      pcf%cpool_to_frootc(i) = val
      pcf%cpool_to_frootc_storage(i) = val
      pcf%cpool_to_livestemc(i) = val
      pcf%cpool_to_livestemc_storage(i) = val
      pcf%cpool_to_deadstemc(i) = val
      pcf%cpool_to_deadstemc_storage(i) = val
      pcf%cpool_to_livecrootc(i) = val
      pcf%cpool_to_livecrootc_storage(i) = val
      pcf%cpool_to_deadcrootc(i) = val
      pcf%cpool_to_deadcrootc_storage(i) = val
      pcf%cpool_to_gresp_storage(i) = val
      pcf%cpool_leaf_gr(i) = val
      pcf%cpool_leaf_storage_gr(i) = val
      pcf%transfer_leaf_gr(i) = val
      pcf%cpool_froot_gr(i) = val
      pcf%cpool_froot_storage_gr(i) = val
      pcf%transfer_froot_gr(i) = val
      pcf%cpool_livestem_gr(i) = val
      pcf%cpool_livestem_storage_gr(i) = val
      pcf%transfer_livestem_gr(i) = val
      pcf%cpool_deadstem_gr(i) = val
      pcf%cpool_deadstem_storage_gr(i) = val
      pcf%transfer_deadstem_gr(i) = val
      pcf%cpool_livecroot_gr(i) = val
      pcf%cpool_livecroot_storage_gr(i) = val
      pcf%transfer_livecroot_gr(i) = val
      pcf%cpool_deadcroot_gr(i) = val
      pcf%cpool_deadcroot_storage_gr(i) = val
      pcf%transfer_deadcroot_gr(i) = val
      pcf%leafc_storage_to_xfer(i) = val
      pcf%frootc_storage_to_xfer(i) = val
      pcf%livestemc_storage_to_xfer(i) = val
      pcf%deadstemc_storage_to_xfer(i) = val
      pcf%livecrootc_storage_to_xfer(i) = val
      pcf%deadcrootc_storage_to_xfer(i) = val
      pcf%gresp_storage_to_xfer(i) = val
      pcf%livestemc_to_deadstemc(i) = val
      pcf%livecrootc_to_deadcrootc(i) = val
      pcf%gpp(i) = val
      pcf%mr(i) = val
      pcf%current_gr(i) = val
      pcf%transfer_gr(i) = val
      pcf%storage_gr(i) = val
      pcf%gr(i) = val
      pcf%ar(i) = val
      pcf%rr(i) = val
      pcf%npp(i) = val
      pcf%agnpp(i) = val
      pcf%bgnpp(i) = val
      pcf%litfall(i) = val
      pcf%vegfire(i) = val
      pcf%wood_harvestc(i) = val
      pcf%pft_cinputs(i) = val
      pcf%pft_coutputs(i) = val
      pcf%pft_fire_closs(i) = val

#if (defined CLAMP)
      !CLAMP
      pcf%frootc_alloc(i) = val
      pcf%frootc_loss(i) = val
      pcf%leafc_alloc(i) = val
      pcf%leafc_loss(i) = val
      pcf%woodc_alloc(i) = val
      pcf%woodc_loss(i) = val
#endif
#if (defined CROP)
      pcf%xsmrpool_to_atm(i)         = val
      pcf%livestemc_to_litter(i)     = val
      pcf%grainc_to_food(i)          = val
      pcf%grainc_xfer_to_grainc(i)   = val
      pcf%cpool_to_grainc(i)         = val
      pcf%cpool_to_grainc_storage(i) = val
      pcf%cpool_grain_gr(i)          = val
      pcf%cpool_grain_storage_gr(i)  = val
      pcf%transfer_grain_gr(i)       = val
      pcf%grainc_storage_to_xfer(i)  = val
#endif
   end do

end subroutine CNSetPcf
!-----------------------------------------------------------------------

!-----------------------------------------------------------------------
!BOP
!
! !IROUTINE: CNSetPnf
!
! !INTERFACE:
subroutine CNSetPnf(num, filter, val, pnf)
!
! !DESCRIPTION:
! Set pft nitrogen flux variables
!
! !ARGUMENTS:
    implicit none
    integer , intent(in) :: num
    integer , intent(in) :: filter(:)
    real(r8), intent(in) :: val
    type (pft_nflux_type), intent(inout) :: pnf
!
! !REVISION HISTORY:
! Created by Peter Thornton
!
! !LOCAL VARIABLES:
! local pointers to implicit in/out arrays
!
! !OTHER LOCAL VARIABLES:
   integer :: fi,i     ! loop index
!EOP
!------------------------------------------------------------------------

   do fi = 1,num
      i=filter(fi)
      pnf%m_leafn_to_litter(i) = val
      pnf%m_frootn_to_litter(i) = val
      pnf%m_leafn_storage_to_litter(i) = val
      pnf%m_frootn_storage_to_litter(i) = val
      pnf%m_livestemn_storage_to_litter(i) = val
      pnf%m_deadstemn_storage_to_litter(i) = val
      pnf%m_livecrootn_storage_to_litter(i) = val
      pnf%m_deadcrootn_storage_to_litter(i) = val
      pnf%m_leafn_xfer_to_litter(i) = val
      pnf%m_frootn_xfer_to_litter(i) = val
      pnf%m_livestemn_xfer_to_litter(i) = val
      pnf%m_deadstemn_xfer_to_litter(i) = val
      pnf%m_livecrootn_xfer_to_litter(i) = val
      pnf%m_deadcrootn_xfer_to_litter(i) = val
      pnf%m_livestemn_to_litter(i) = val
      pnf%m_deadstemn_to_litter(i) = val
      pnf%m_livecrootn_to_litter(i) = val
      pnf%m_deadcrootn_to_litter(i) = val
      pnf%m_retransn_to_litter(i) = val
      pnf%hrv_leafn_to_litter(i) = val             
      pnf%hrv_frootn_to_litter(i) = val            
      pnf%hrv_leafn_storage_to_litter(i) = val     
      pnf%hrv_frootn_storage_to_litter(i) = val    
      pnf%hrv_livestemn_storage_to_litter(i) = val 
      pnf%hrv_deadstemn_storage_to_litter(i) = val 
      pnf%hrv_livecrootn_storage_to_litter(i) = val
      pnf%hrv_deadcrootn_storage_to_litter(i) = val
      pnf%hrv_leafn_xfer_to_litter(i) = val        
      pnf%hrv_frootn_xfer_to_litter(i) = val       
      pnf%hrv_livestemn_xfer_to_litter(i) = val    
      pnf%hrv_deadstemn_xfer_to_litter(i) = val    
      pnf%hrv_livecrootn_xfer_to_litter(i) = val   
      pnf%hrv_deadcrootn_xfer_to_litter(i) = val   
      pnf%hrv_livestemn_to_litter(i) = val         
      pnf%hrv_deadstemn_to_prod10n(i) = val        
      pnf%hrv_deadstemn_to_prod100n(i) = val       
      pnf%hrv_livecrootn_to_litter(i) = val        
      pnf%hrv_deadcrootn_to_litter(i) = val        
      pnf%hrv_retransn_to_litter(i) = val           
      pnf%m_leafn_to_fire(i) = val
      pnf%m_frootn_to_fire(i) = val
      pnf%m_leafn_storage_to_fire(i) = val
      pnf%m_frootn_storage_to_fire(i) = val
      pnf%m_livestemn_storage_to_fire(i) = val
      pnf%m_deadstemn_storage_to_fire(i) = val
      pnf%m_livecrootn_storage_to_fire(i) = val
      pnf%m_deadcrootn_storage_to_fire(i) = val
      pnf%m_leafn_xfer_to_fire(i) = val
      pnf%m_frootn_xfer_to_fire(i) = val
      pnf%m_livestemn_xfer_to_fire(i) = val
      pnf%m_deadstemn_xfer_to_fire(i) = val
      pnf%m_livecrootn_xfer_to_fire(i) = val
      pnf%m_deadcrootn_xfer_to_fire(i) = val
      pnf%m_livestemn_to_fire(i) = val
      pnf%m_deadstemn_to_fire(i) = val
      pnf%m_deadstemn_to_litter_fire(i) = val
      pnf%m_livecrootn_to_fire(i) = val
      pnf%m_deadcrootn_to_fire(i) = val
      pnf%m_deadcrootn_to_litter_fire(i) = val
      pnf%m_retransn_to_fire(i) = val
      pnf%leafn_xfer_to_leafn(i) = val
      pnf%frootn_xfer_to_frootn(i) = val
      pnf%livestemn_xfer_to_livestemn(i) = val
      pnf%deadstemn_xfer_to_deadstemn(i) = val
      pnf%livecrootn_xfer_to_livecrootn(i) = val
      pnf%deadcrootn_xfer_to_deadcrootn(i) = val
      pnf%leafn_to_litter(i) = val
      pnf%leafn_to_retransn(i) = val
      pnf%frootn_to_litter(i) = val
      pnf%retransn_to_npool(i) = val
      pnf%sminn_to_npool(i) = val
      pnf%npool_to_leafn(i) = val
      pnf%npool_to_leafn_storage(i) = val
      pnf%npool_to_frootn(i) = val
      pnf%npool_to_frootn_storage(i) = val
      pnf%npool_to_livestemn(i) = val
      pnf%npool_to_livestemn_storage(i) = val
      pnf%npool_to_deadstemn(i) = val
      pnf%npool_to_deadstemn_storage(i) = val
      pnf%npool_to_livecrootn(i) = val
      pnf%npool_to_livecrootn_storage(i) = val
      pnf%npool_to_deadcrootn(i) = val
      pnf%npool_to_deadcrootn_storage(i) = val
      pnf%leafn_storage_to_xfer(i) = val
      pnf%frootn_storage_to_xfer(i) = val
      pnf%livestemn_storage_to_xfer(i) = val
      pnf%deadstemn_storage_to_xfer(i) = val
      pnf%livecrootn_storage_to_xfer(i) = val
      pnf%deadcrootn_storage_to_xfer(i) = val
      pnf%livestemn_to_deadstemn(i) = val
      pnf%livestemn_to_retransn(i) = val
      pnf%livecrootn_to_deadcrootn(i) = val
      pnf%livecrootn_to_retransn(i) = val
      pnf%ndeploy(i) = val
      pnf%pft_ninputs(i) = val
      pnf%pft_noutputs(i) = val
      pnf%wood_harvestn(i) = val
      pnf%pft_fire_nloss(i) = val
#if (defined CROP)
      pnf%livestemn_to_litter(i)     = val
      pnf%grainn_to_food(i)          = val
      pnf%grainn_xfer_to_grainn(i)   = val
      pnf%npool_to_grainn(i)         = val
      pnf%npool_to_grainn_storage(i) = val
      pnf%grainn_storage_to_xfer(i)  = val
#endif
   end do

end subroutine CNSetPnf
!-----------------------------------------------------------------------

!-----------------------------------------------------------------------
!BOP
!
! !IROUTINE: CNSetCps
!
! !INTERFACE:
subroutine CNSetCps(num, filter, val, cps)
!
! !DESCRIPTION:
! Set column physical state variables
!
! !ARGUMENTS:
    implicit none
    integer , intent(in) :: num
    integer , intent(in) :: filter(:)
    real(r8), intent(in) :: val
    type (column_pstate_type), intent(inout) :: cps
!
! !REVISION HISTORY:
! Created by Peter Thornton
!
! !LOCAL VARIABLES:
! local pointers to implicit in/out arrays
!
! !OTHER LOCAL VARIABLES:
   integer :: fi,i,j     ! loop index
!EOP
!------------------------------------------------------------------------

   do fi = 1,num
      i = filter(fi)
      cps%decl(i) = val
      cps%coszen(i) = val
      cps%fpi(i) = val
      cps%fpg(i) = val
      cps%annsum_counter(i) = val
      cps%cannsum_npp(i) = val
      cps%cannavg_t2m(i) = val
      cps%wf(i) = val
      cps%me(i) = val
      cps%fire_prob(i) = val
      cps%mean_fire_prob(i) = val
      cps%fireseasonl(i) = val
      cps%farea_burned(i) = val
      cps%ann_farea_burned(i) = val
   end do

   do j = 1,nlevgrnd
      do fi = 1,num
         i = filter(fi)
         cps%bsw2(i,j) = val
         cps%psisat(i,j) = val
         cps%vwcsat(i,j) = val
         cps%soilpsi(i,j) = val
      end do
   end do

end subroutine CNSetCps
!-----------------------------------------------------------------------

!-----------------------------------------------------------------------
!BOP
!
! !IROUTINE: CNSetCcs
!
! !INTERFACE:
subroutine CNSetCcs(num, filter, val, ccs)
!
! !DESCRIPTION:
! Set column carbon state variables
!
! !ARGUMENTS:
    implicit none
    integer , intent(in) :: num
    integer , intent(in) :: filter(:)
    real(r8), intent(in) :: val
    type (column_cstate_type), intent(inout) :: ccs
!
! !REVISION HISTORY:
! Created by Peter Thornton
!
! !LOCAL VARIABLES:
! local pointers to implicit in/out arrays
!
! !OTHER LOCAL VARIABLES:
   integer :: fi,i     ! loop index
!EOP
!------------------------------------------------------------------------

   do fi = 1,num
      i = filter(fi)
      ccs%cwdc(i) = val
      ccs%litr1c(i) = val
      ccs%litr2c(i) = val
      ccs%litr3c(i) = val
      ccs%soil1c(i) = val
      ccs%soil2c(i) = val
      ccs%soil3c(i) = val
      ccs%soil4c(i) = val
      ccs%col_ctrunc(i) = val
      ccs%totlitc(i) = val
      ccs%totsomc(i) = val
      ccs%totecosysc(i) = val
      ccs%totcolc(i) = val

   end do

end subroutine CNSetCcs
!-----------------------------------------------------------------------

!-----------------------------------------------------------------------
!BOP
!
! !IROUTINE: CNSetCns
!
! !INTERFACE:
subroutine CNSetCns(num, filter, val, cns)
!
! !DESCRIPTION:
! Set column nitrogen state variables
!
! !ARGUMENTS:
    implicit none
    integer , intent(in) :: num
    integer , intent(in) :: filter(:)
    real(r8), intent(in) :: val
    type (column_nstate_type), intent(inout) :: cns
!
! !REVISION HISTORY:
! Created by Peter Thornton
!
! !LOCAL VARIABLES:
! local pointers to implicit in/out arrays
!
! !OTHER LOCAL VARIABLES:
   integer :: fi,i     ! loop index
!EOP
!------------------------------------------------------------------------

   do fi = 1,num
      i = filter(fi)
      cns%cwdn(i) = val
      cns%litr1n(i) = val
      cns%litr2n(i) = val
      cns%litr3n(i) = val
      cns%soil1n(i) = val
      cns%soil2n(i) = val
      cns%soil3n(i) = val
      cns%soil4n(i) = val
      cns%sminn(i) = val
      cns%col_ntrunc(i) = val
      cns%totlitn(i) = val
      cns%totsomn(i) = val
      cns%totecosysn(i) = val
      cns%totcoln(i) = val
   end do

end subroutine CNSetCns
!-----------------------------------------------------------------------

!-----------------------------------------------------------------------
!BOP
!
! !IROUTINE: CNSetCcf
!
! !INTERFACE:
subroutine CNSetCcf(num, filter, val, ccf)
!
! !DESCRIPTION:
! Set column carbon flux variables
!
! !ARGUMENTS:
    implicit none
    integer , intent(in) :: num
    integer , intent(in) :: filter(:)
    real(r8), intent(in) :: val
    type (column_cflux_type), intent(inout) :: ccf
!
! !REVISION HISTORY:
! Created by Peter Thornton
!
! !LOCAL VARIABLES:
! local pointers to implicit in/out arrays
!
! !OTHER LOCAL VARIABLES:
   integer :: fi,i     ! loop index
!EOP
!------------------------------------------------------------------------

   do fi = 1,num
      i = filter(fi)
      ccf%m_leafc_to_litr1c(i)                = val
      ccf%m_leafc_to_litr2c(i)                = val
      ccf%m_leafc_to_litr3c(i)                = val
      ccf%m_frootc_to_litr1c(i)               = val
      ccf%m_frootc_to_litr2c(i)               = val
      ccf%m_frootc_to_litr3c(i)               = val
      ccf%m_leafc_storage_to_litr1c(i)        = val
      ccf%m_frootc_storage_to_litr1c(i)       = val
      ccf%m_livestemc_storage_to_litr1c(i)    = val
      ccf%m_deadstemc_storage_to_litr1c(i)    = val
      ccf%m_livecrootc_storage_to_litr1c(i)   = val
      ccf%m_deadcrootc_storage_to_litr1c(i)   = val
      ccf%m_leafc_xfer_to_litr1c(i)           = val
      ccf%m_frootc_xfer_to_litr1c(i)          = val
      ccf%m_livestemc_xfer_to_litr1c(i)       = val
      ccf%m_deadstemc_xfer_to_litr1c(i)       = val
      ccf%m_livecrootc_xfer_to_litr1c(i)      = val
      ccf%m_deadcrootc_xfer_to_litr1c(i)      = val
      ccf%m_livestemc_to_cwdc(i)              = val
      ccf%m_deadstemc_to_cwdc(i)              = val
      ccf%m_livecrootc_to_cwdc(i)             = val
      ccf%m_deadcrootc_to_cwdc(i)             = val
      ccf%m_gresp_storage_to_litr1c(i)        = val
      ccf%m_gresp_xfer_to_litr1c(i)           = val
      ccf%hrv_leafc_to_litr1c(i)              = val             
      ccf%hrv_leafc_to_litr2c(i)              = val             
      ccf%hrv_leafc_to_litr3c(i)              = val             
      ccf%hrv_frootc_to_litr1c(i)             = val            
      ccf%hrv_frootc_to_litr2c(i)             = val            
      ccf%hrv_frootc_to_litr3c(i)             = val            
      ccf%hrv_livestemc_to_cwdc(i)            = val           
      ccf%hrv_deadstemc_to_prod10c(i)         = val        
      ccf%hrv_deadstemc_to_prod100c(i)        = val       
      ccf%hrv_livecrootc_to_cwdc(i)           = val          
      ccf%hrv_deadcrootc_to_cwdc(i)           = val          
      ccf%hrv_leafc_storage_to_litr1c(i)      = val     
      ccf%hrv_frootc_storage_to_litr1c(i)     = val    
      ccf%hrv_livestemc_storage_to_litr1c(i)  = val 
      ccf%hrv_deadstemc_storage_to_litr1c(i)  = val 
      ccf%hrv_livecrootc_storage_to_litr1c(i) = val
      ccf%hrv_deadcrootc_storage_to_litr1c(i) = val
#if (defined CROP)
      ccf%livestemc_to_litr1c(i) = val
      ccf%livestemc_to_litr2c(i) = val
      ccf%livestemc_to_litr3c(i) = val
      ccf%grainc_to_litr1c(i)    = val
      ccf%grainc_to_litr2c(i)    = val
      ccf%grainc_to_litr3c(i)    = val
#endif
      ccf%hrv_gresp_storage_to_litr1c(i)      = val
      ccf%hrv_leafc_xfer_to_litr1c(i)         = val
      ccf%hrv_frootc_xfer_to_litr1c(i)        = val
      ccf%hrv_livestemc_xfer_to_litr1c(i)     = val
      ccf%hrv_deadstemc_xfer_to_litr1c(i)     = val
      ccf%hrv_livecrootc_xfer_to_litr1c(i)    = val
      ccf%hrv_deadcrootc_xfer_to_litr1c(i)    = val
      ccf%hrv_gresp_xfer_to_litr1c(i)         = val
      ccf%m_deadstemc_to_cwdc_fire(i)         = val
      ccf%m_deadcrootc_to_cwdc_fire(i)        = val
      ccf%m_litr1c_to_fire(i)                 = val
      ccf%m_litr2c_to_fire(i)                 = val
      ccf%m_litr3c_to_fire(i)                 = val
      ccf%m_cwdc_to_fire(i)                   = val
      ccf%prod10c_loss(i)                     = val
      ccf%prod100c_loss(i)                    = val
      ccf%product_closs(i)                    = val
      ccf%leafc_to_litr1c(i)                  = val
      ccf%leafc_to_litr2c(i)                  = val
      ccf%leafc_to_litr3c(i)                  = val
      ccf%frootc_to_litr1c(i)                 = val
      ccf%frootc_to_litr2c(i)                 = val
      ccf%frootc_to_litr3c(i)                 = val
      ccf%cwdc_to_litr2c(i)                   = val
      ccf%cwdc_to_litr3c(i)                   = val
      ccf%litr1_hr(i)                         = val
      ccf%litr1c_to_soil1c(i)                 = val
      ccf%litr2_hr(i)                         = val
      ccf%litr2c_to_soil2c(i)                 = val
      ccf%litr3_hr(i)                         = val
      ccf%litr3c_to_soil3c(i)                 = val
      ccf%soil1_hr(i)                         = val
      ccf%soil1c_to_soil2c(i)                 = val
      ccf%soil2_hr(i)                         = val
      ccf%soil2c_to_soil3c(i)                 = val
      ccf%soil3_hr(i)                         = val
      ccf%soil3c_to_soil4c(i)                 = val
      ccf%soil4_hr(i)                         = val
      ccf%lithr(i)                            = val
      ccf%somhr(i)                            = val
      ccf%hr(i)                               = val
      ccf%sr(i)                               = val
      ccf%er(i)                               = val
      ccf%litfire(i)                          = val
      ccf%somfire(i)                          = val
      ccf%totfire(i)                          = val
      ccf%nep(i)                              = val
      ccf%nbp(i)                              = val
      ccf%nee(i)                              = val
      ccf%col_cinputs(i)                      = val
      ccf%col_coutputs(i)                     = val
      ccf%col_fire_closs(i)                   = val

#if (defined CLAMP)
      !CLAMP
      ccf%cwdc_hr(i)                          = val
      ccf%cwdc_loss(i)                        = val
      ccf%litterc_loss(i)                     = val
#endif

  end do

end subroutine CNSetCcf
!-----------------------------------------------------------------------

!-----------------------------------------------------------------------
!BOP
!
! !IROUTINE: CNSetCnf
!
! !INTERFACE:
subroutine CNSetCnf(num, filter, val, cnf)
!
! !DESCRIPTION:
! Set column nitrogen flux variables
!
! !ARGUMENTS:
    implicit none
    integer , intent(in) :: num
    integer , intent(in) :: filter(:)
    real(r8), intent(in) :: val
    type (column_nflux_type), intent(inout) :: cnf
!
! !REVISION HISTORY:
! Created by Peter Thornton
!
! !LOCAL VARIABLES:
! local pointers to implicit in/out arrays
!
! !OTHER LOCAL VARIABLES:
   integer :: fi,i     ! loop index
!EOP
!------------------------------------------------------------------------

   do fi = 1,num
      i = filter(fi)
      cnf%ndep_to_sminn(i) = val
      cnf%nfix_to_sminn(i) = val
      cnf%m_leafn_to_litr1n(i) = val
      cnf%m_leafn_to_litr2n(i) = val
      cnf%m_leafn_to_litr3n(i) = val
      cnf%m_frootn_to_litr1n(i) = val
      cnf%m_frootn_to_litr2n(i) = val
      cnf%m_frootn_to_litr3n(i) = val
      cnf%m_leafn_storage_to_litr1n(i) = val
      cnf%m_frootn_storage_to_litr1n(i) = val
      cnf%m_livestemn_storage_to_litr1n(i) = val
      cnf%m_deadstemn_storage_to_litr1n(i) = val
      cnf%m_livecrootn_storage_to_litr1n(i) = val
      cnf%m_deadcrootn_storage_to_litr1n(i) = val
      cnf%m_leafn_xfer_to_litr1n(i) = val
      cnf%m_frootn_xfer_to_litr1n(i) = val
      cnf%m_livestemn_xfer_to_litr1n(i) = val
      cnf%m_deadstemn_xfer_to_litr1n(i) = val
      cnf%m_livecrootn_xfer_to_litr1n(i) = val
      cnf%m_deadcrootn_xfer_to_litr1n(i) = val
      cnf%m_livestemn_to_cwdn(i) = val
      cnf%m_deadstemn_to_cwdn(i) = val
      cnf%m_livecrootn_to_cwdn(i) = val
      cnf%m_deadcrootn_to_cwdn(i) = val
      cnf%m_retransn_to_litr1n(i) = val
      cnf%hrv_leafn_to_litr1n(i) = val             
      cnf%hrv_leafn_to_litr2n(i) = val             
      cnf%hrv_leafn_to_litr3n(i) = val             
      cnf%hrv_frootn_to_litr1n(i) = val            
      cnf%hrv_frootn_to_litr2n(i) = val            
      cnf%hrv_frootn_to_litr3n(i) = val            
      cnf%hrv_livestemn_to_cwdn(i) = val           
      cnf%hrv_deadstemn_to_prod10n(i) = val        
      cnf%hrv_deadstemn_to_prod100n(i) = val       
      cnf%hrv_livecrootn_to_cwdn(i) = val          
      cnf%hrv_deadcrootn_to_cwdn(i) = val          
      cnf%hrv_retransn_to_litr1n(i) = val          
      cnf%hrv_leafn_storage_to_litr1n(i) = val     
      cnf%hrv_frootn_storage_to_litr1n(i) = val    
      cnf%hrv_livestemn_storage_to_litr1n(i) = val 
      cnf%hrv_deadstemn_storage_to_litr1n(i) = val 
      cnf%hrv_livecrootn_storage_to_litr1n(i) = val
      cnf%hrv_deadcrootn_storage_to_litr1n(i) = val
      cnf%hrv_leafn_xfer_to_litr1n(i) = val        
      cnf%hrv_frootn_xfer_to_litr1n(i) = val       
      cnf%hrv_livestemn_xfer_to_litr1n(i) = val    
      cnf%hrv_deadstemn_xfer_to_litr1n(i) = val    
      cnf%hrv_livecrootn_xfer_to_litr1n(i) = val   
      cnf%hrv_deadcrootn_xfer_to_litr1n(i) = val   
      cnf%m_deadstemn_to_cwdn_fire(i) = val
      cnf%m_deadcrootn_to_cwdn_fire(i) = val
      cnf%m_litr1n_to_fire(i) = val
      cnf%m_litr2n_to_fire(i) = val
      cnf%m_litr3n_to_fire(i) = val
      cnf%m_cwdn_to_fire(i) = val
      cnf%prod10n_loss(i) = val
      cnf%prod100n_loss(i) = val
      cnf%product_nloss(i) = val
#if (defined CROP)
      cnf%grainn_to_litr1n(i)    = val
      cnf%grainn_to_litr2n(i)    = val
      cnf%grainn_to_litr3n(i)    = val
      cnf%livestemn_to_litr1n(i) = val
      cnf%livestemn_to_litr2n(i) = val
      cnf%livestemn_to_litr3n(i) = val
#endif
      cnf%leafn_to_litr1n(i) = val
      cnf%leafn_to_litr2n(i) = val
      cnf%leafn_to_litr3n(i) = val
      cnf%frootn_to_litr1n(i) = val
      cnf%frootn_to_litr2n(i) = val
      cnf%frootn_to_litr3n(i) = val
      cnf%cwdn_to_litr2n(i) = val
      cnf%cwdn_to_litr3n(i) = val
      cnf%litr1n_to_soil1n(i) = val
      cnf%sminn_to_soil1n_l1(i) = val
      cnf%litr2n_to_soil2n(i) = val
      cnf%sminn_to_soil2n_l2(i) = val
      cnf%litr3n_to_soil3n(i) = val
      cnf%sminn_to_soil3n_l3(i) = val
      cnf%soil1n_to_soil2n(i) = val
      cnf%sminn_to_soil2n_s1(i) = val
      cnf%soil2n_to_soil3n(i) = val
      cnf%sminn_to_soil3n_s2(i) = val
      cnf%soil3n_to_soil4n(i) = val
      cnf%sminn_to_soil4n_s3(i) = val
      cnf%soil4n_to_sminn(i) = val
      cnf%sminn_to_denit_l1s1(i) = val
      cnf%sminn_to_denit_l2s2(i) = val
      cnf%sminn_to_denit_l3s3(i) = val
      cnf%sminn_to_denit_s1s2(i) = val
      cnf%sminn_to_denit_s2s3(i) = val
      cnf%sminn_to_denit_s3s4(i) = val
      cnf%sminn_to_denit_s4(i) = val
      cnf%sminn_to_denit_excess(i) = val
      cnf%sminn_leached(i) = val
      cnf%potential_immob(i) = val
      cnf%actual_immob(i) = val
      cnf%sminn_to_plant(i) = val
      cnf%supplement_to_sminn(i) = val
      cnf%gross_nmin(i) = val
      cnf%net_nmin(i) = val
      cnf%denit(i) = val
      cnf%col_ninputs(i) = val
      cnf%col_noutputs(i) = val
      cnf%col_fire_nloss(i) = val
   end do

end subroutine CNSetCnf
!-----------------------------------------------------------------------

#endif

end module CNSetValueMod
module CNFireMod
#ifdef CN

!-----------------------------------------------------------------------
!BOP
!
! !MODULE: CNFireMod
!
! !DESCRIPTION:
! Module holding routines fire mod
! nitrogen code.
!
! !USES:
  use shr_kind_mod , only: r8 => shr_kind_r8
  use shr_const_mod, only: SHR_CONST_PI,SHR_CONST_TKFRZ
  use pft2colMod   , only: p2c
!  use clm_varctl   , only: iulog
  implicit none
  save
  private
! !PUBLIC MEMBER FUNCTIONS:
  public :: CNFireArea
  public :: CNFireFluxes
!
! !REVISION HISTORY:
!
!EOP
!-----------------------------------------------------------------------

contains

!-----------------------------------------------------------------------
!BOP
!
! !IROUTINE: CNFireArea
!
! !INTERFACE:
subroutine CNFireArea (num_soilc, filter_soilc)
!
! !DESCRIPTION:
! Computes column-level area affected by fire in each timestep
! based on statistical fire model in Thonicke et al. 2001.
!
! !USES:
   use clmtype
!   use clm_time_manager, only: get_step_size, get_nstep
   use globals    , only: dt,nstep
   use clm_varpar  , only: max_pft_per_col
!
! !ARGUMENTS:
   implicit none
   integer, intent(in) :: num_soilc       ! number of soil columns in filter
   integer, intent(in) :: filter_soilc(:) ! filter for soil columns
!
! !CALLED FROM:
! subroutine CNEcosystemDyn in module CNEcosystemDynMod.F90
!
! !REVISION HISTORY:
! !LOCAL VARIABLES:
! local pointers to implicit in scalars
!
   ! pft-level
   real(r8), pointer :: wtcol(:)        ! pft weight on the column
   integer , pointer :: ivt(:)          ! vegetation type for this pft
   real(r8), pointer :: woody(:)        ! binary flag for woody lifeform (1=woody, 0=not woody)
   ! column-level
   integer , pointer :: npfts(:)        ! number of pfts on the column
   integer , pointer :: pfti(:)         ! pft index array
   real(r8), pointer :: pwtgcell(:)     ! weight of pft relative to corresponding gridcell
   real(r8), pointer :: wf(:)           ! soil water as frac. of whc for top 0.5 m
   real(r8), pointer :: t_grnd(:)       ! ground temperature (Kelvin)
   real(r8), pointer :: totlitc(:)      ! (gC/m2) total litter C (not including cwdc)
   real(r8), pointer :: cwdc(:)         ! (gC/m2) coarse woody debris C
   ! PET 5/20/08, test to increase fire area
   real(r8), pointer :: totvegc(:)    ! (gC/m2) total veg C (column-level mean)
   ! pointers for column averaging
!
! local pointers to implicit in/out scalars
!
   ! column-level
   real(r8), pointer :: me(:)               ! column-level moisture of extinction (proportion)
   real(r8), pointer :: fire_prob(:)        ! daily fire probability (0-1)
   real(r8), pointer :: mean_fire_prob(:)   ! e-folding mean of daily fire probability (0-1)
   real(r8), pointer :: fireseasonl(:)      ! annual fire season length (days, <= 365)
   real(r8), pointer :: farea_burned(:)     ! fractional area burned in this timestep (proportion)
   real(r8), pointer :: ann_farea_burned(:) ! annual total fractional area burned (proportion)
!
! !OTHER LOCAL VARIABLES:
!   real(r8), parameter:: minfuel = 200.0_r8 ! dead fuel threshold to carry a fire (gC/m2)
! PET, 5/30/08: changed from 200 to 100 gC/m2, since the original paper didn't specify
! the units as carbon, I am assuming that they were in dry biomass, so carbon would be ~50%
   real(r8), parameter:: minfuel = 100.0_r8 ! dead fuel threshold to carry a fire (gC/m2)
   real(r8), parameter:: me_woody = 0.3_r8  ! moisture of extinction for woody PFTs (proportion)
   real(r8), parameter:: me_herb  = 0.2_r8  ! moisture of extinction for herbaceous PFTs (proportion)
   real(r8), parameter:: ef_time = 1.0_r8   ! e-folding time constant (years)
   integer :: fc,c,pi,p ! index variables
!   real(r8):: dt        ! time step variable (s)
   real(r8):: fuelc     ! temporary column-level litter + cwd C (gC/m2)
   integer :: nef       ! number of e-folding timesteps
   real(r8):: ef_nsteps ! number of e-folding timesteps (real)
!   integer :: nstep     ! current timestep number
   real(r8):: m         ! top-layer soil moisture (proportion)
   real(r8):: mep       ! pft-level moisture of extinction [proportion]
   real(r8):: s2        ! (mean_fire_prob - 1.0)
!EOP
!-----------------------------------------------------------------------
   ! assign local pointers to derived type members (pft-level)
   wtcol            => clm3%g%l%c%p%wtcol
   ivt              => clm3%g%l%c%p%itype
   pwtgcell         => clm3%g%l%c%p%wtgcell  
   woody            => pftcon%woody

   ! assign local pointers to derived type members (column-level)
   npfts            => clm3%g%l%c%npfts
   pfti             => clm3%g%l%c%pfti
   wf               => clm3%g%l%c%cps%wf
   me               => clm3%g%l%c%cps%me
   fire_prob        => clm3%g%l%c%cps%fire_prob
   mean_fire_prob   => clm3%g%l%c%cps%mean_fire_prob
   fireseasonl      => clm3%g%l%c%cps%fireseasonl
   farea_burned     => clm3%g%l%c%cps%farea_burned
   ann_farea_burned => clm3%g%l%c%cps%ann_farea_burned
   t_grnd           => clm3%g%l%c%ces%t_grnd
   totlitc          => clm3%g%l%c%ccs%totlitc
   cwdc             => clm3%g%l%c%ccs%cwdc
   ! PET 5/20/08, test to increase fire area
   totvegc          => clm3%g%l%c%ccs%pcs_a%totvegc

   ! pft to column average for moisture of extinction
   do fc = 1,num_soilc
      c = filter_soilc(fc)
      me(c) = 0._r8
   end do
   mep = me_woody
   do pi = 1,max_pft_per_col
      do fc = 1,num_soilc
         c = filter_soilc(fc)
         if (pi <=  npfts(c)) then
            p = pfti(c) + pi - 1
            if (pwtgcell(p)>0._r8) then
               if (woody(ivt(p)) == 1) then
                  mep = me_woody
               else
                  mep = me_herb
               end if
            end if
            me(c) = me(c) + mep*wtcol(p)
         end if
      end do
   end do

   ! Get model step size
!   dt = real( get_step_size(), r8 )

   ! Set the number of timesteps for e-folding.
   ! When the simulation has run fewer than this number of steps,
   ! re-scale the e-folding time to get a stable early estimate.
!   nstep = get_nstep()
   nef = (ef_time*365._r8*86400._r8)/dt
   ef_nsteps = max(1,min(nstep,nef))
   
   ! test code, added 6/6/05, PET
   ! setting ef_nsteps to full count regardless of nstep, to see if this
   ! gets rid of transient in fire stats for initial run from spunup 
   ! initial conditions
   ef_nsteps = nef

   ! begin column loop to calculate fractional area affected by fire

   do fc = 1, num_soilc
      c = filter_soilc(fc)

      ! dead fuel C (total litter + CWD)
      fuelc = totlitc(c) + cwdc(c)
      ! PET 5/20/08, test to increase fire area
      ! PET, 5/30/08. going back to original treatment using dead fuel only
      ! fuelc = fuelc + totvegc(c)

      ! m is the fractional soil mositure in the top layer (taken here
      ! as the top 0.5 m)
      ! PET 5/30/08 - note that this has been changed in Hydrology to use top 5 cm.
      m = max(0._r8,wf(c))


      ! Calculate the probability of at least one fire in a day
      ! in the gridcell. minfuel is the limit for dead fuels below which
      ! fire is assumed unable to spread.

      if (t_grnd(c)>SHR_CONST_TKFRZ .and. fuelc>minfuel .and. me(c)>0._r8 .and. m<=me(c)) then
         fire_prob(c) = exp(-SHR_CONST_PI * (m/me(c))**2)
      else
         fire_prob(c) = 0._r8
      end if

      ! Use e-folding to keep a running mean of daily fire probability,
      ! which is then used to calculate annual fractional area burned.
      ! mean_fire_prob corresponds to the variable s from Thonicke.
      ! fireseasonl corresponds to the variable N from Thonicke.
      ! ann_farea_burned corresponds to the variable A from Thonicke.

      mean_fire_prob(c) = (mean_fire_prob(c)*(ef_nsteps-1._r8) + fire_prob(c))/ef_nsteps
      fireseasonl(c) = mean_fire_prob(c) * 365._r8
      s2 = mean_fire_prob(c)-1._r8
      ann_farea_burned(c) = mean_fire_prob(c)*exp(s2/(0.45_r8*(s2**3) + 2.83_r8*(s2**2) + 2.96_r8*s2 + 1.04_r8))

      ! Estimate the fractional area of the column affected by fire in this time step.
      ! Over a year this should sum to a value near the annual
      ! fractional area burned from equations above.

      if (fireseasonl(c) > 0._r8) then
         farea_burned(c) = (fire_prob(c)/fireseasonl(c)) * ann_farea_burned(c) * (dt/86400._r8)
      else
         farea_burned(c) = 0._r8
      end if

#if (defined NOFIRE)
     ! set the fire area 0 if NOFIRE flag is on

     farea_burned(c) = 0._r8
#endif

   end do  ! end of column loop

end subroutine CNFireArea
!-----------------------------------------------------------------------

!-----------------------------------------------------------------------
!BOP
!
! !IROUTINE: CNFireFluxes
!
! !INTERFACE:
subroutine CNFireFluxes (num_soilc, filter_soilc, num_soilp, filter_soilp)
!
! !DESCRIPTION:
! Fire effects routine for coupled carbon-nitrogen code (CN).
! Relies primarily on estimate of fractional area burned in this
! timestep, from CNFireArea().
!
! !USES:
   use clmtype
!   use clm_time_manager, only: get_step_size
   use globals , only: dt
 !
! !ARGUMENTS:
   implicit none
   integer, intent(in) :: num_soilc       ! number of soil columns in filter
   integer, intent(in) :: filter_soilc(:) ! filter for soil columns
   integer, intent(in) :: num_soilp       ! number of soil pfts in filter
   integer, intent(in) :: filter_soilp(:) ! filter for soil pfts
!
! !CALLED FROM:
! subroutine CNEcosystemDyn()
!
! !REVISION HISTORY:
! 7/23/04: Created by Peter Thornton
!
! !LOCAL VARIABLES:
! local pointers to implicit in scalars
!
#if (defined CNDV)
   real(r8), pointer :: nind(:)         ! number of individuals (#/m2)
#endif
   integer , pointer :: ivt(:)          ! pft vegetation type
   real(r8), pointer :: woody(:)        ! binary flag for woody lifeform (1=woody, 0=not woody)
   real(r8), pointer :: resist(:)       ! resistance to fire (no units)
   integer , pointer :: pcolumn(:)      ! pft's column index
   real(r8), pointer :: farea_burned(:) ! timestep fractional area burned (proportion)
   real(r8), pointer :: m_cwdc_to_fire(:)
   real(r8), pointer :: m_deadcrootc_to_cwdc_fire(:)
   real(r8), pointer :: m_deadstemc_to_cwdc_fire(:)
   real(r8), pointer :: m_litr1c_to_fire(:)             
   real(r8), pointer :: m_litr2c_to_fire(:)             
   real(r8), pointer :: m_litr3c_to_fire(:)             
   real(r8), pointer :: cwdc(:)               ! (gC/m2) coarse woody debris C
   real(r8), pointer :: litr1c(:)             ! (gC/m2) litter labile C
   real(r8), pointer :: litr2c(:)             ! (gC/m2) litter cellulose C
   real(r8), pointer :: litr3c(:)             ! (gC/m2) litter lignin C
   real(r8), pointer :: m_cwdn_to_fire(:)              
   real(r8), pointer :: m_deadcrootn_to_cwdn_fire(:)
   real(r8), pointer :: m_deadstemn_to_cwdn_fire(:)
   real(r8), pointer :: m_litr1n_to_fire(:)             
   real(r8), pointer :: m_litr2n_to_fire(:)             
   real(r8), pointer :: m_litr3n_to_fire(:)             
   real(r8), pointer :: cwdn(:)               ! (gN/m2) coarse woody debris N
   real(r8), pointer :: litr1n(:)             ! (gN/m2) litter labile N
   real(r8), pointer :: litr2n(:)             ! (gN/m2) litter cellulose N
   real(r8), pointer :: litr3n(:)             ! (gN/m2) litter lignin N
   real(r8), pointer :: m_deadcrootc_storage_to_fire(:) 
   real(r8), pointer :: m_deadcrootc_to_fire(:)         
   real(r8), pointer :: m_deadcrootc_to_litter_fire(:)         
   real(r8), pointer :: m_deadcrootc_xfer_to_fire(:)
   real(r8), pointer :: m_deadstemc_storage_to_fire(:)  
   real(r8), pointer :: m_deadstemc_to_fire(:)
   real(r8), pointer :: m_deadstemc_to_litter_fire(:)
   real(r8), pointer :: m_deadstemc_to_litter(:)
   real(r8), pointer :: m_livestemc_to_litter(:)
   real(r8), pointer :: m_deadcrootc_to_litter(:)
   real(r8), pointer :: m_livecrootc_to_litter(:)
   real(r8), pointer :: m_deadstemc_xfer_to_fire(:) 
   real(r8), pointer :: m_frootc_storage_to_fire(:)     
   real(r8), pointer :: m_frootc_to_fire(:)             
   real(r8), pointer :: m_frootc_xfer_to_fire(:)    
   real(r8), pointer :: m_gresp_storage_to_fire(:)      
   real(r8), pointer :: m_gresp_xfer_to_fire(:)    
   real(r8), pointer :: m_leafc_storage_to_fire(:)      
   real(r8), pointer :: m_leafc_to_fire(:)             
   real(r8), pointer :: m_leafc_xfer_to_fire(:)     
   real(r8), pointer :: m_livecrootc_storage_to_fire(:) 
   real(r8), pointer :: m_livecrootc_to_fire(:)         
   real(r8), pointer :: m_livecrootc_xfer_to_fire(:)
   real(r8), pointer :: m_livestemc_storage_to_fire(:)  
   real(r8), pointer :: m_livestemc_to_fire(:)          
   real(r8), pointer :: m_livestemc_xfer_to_fire(:) 
   real(r8), pointer :: deadcrootc(:)         ! (gC/m2) dead coarse root C
   real(r8), pointer :: deadcrootc_storage(:) ! (gC/m2) dead coarse root C storage
   real(r8), pointer :: deadcrootc_xfer(:)    !(gC/m2) dead coarse root C transfer
   real(r8), pointer :: deadstemc(:)          ! (gC/m2) dead stem C
   real(r8), pointer :: deadstemc_storage(:)  ! (gC/m2) dead stem C storage
   real(r8), pointer :: deadstemc_xfer(:)     ! (gC/m2) dead stem C transfer
   real(r8), pointer :: frootc(:)             ! (gC/m2) fine root C
   real(r8), pointer :: frootc_storage(:)     ! (gC/m2) fine root C storage
   real(r8), pointer :: frootc_xfer(:)        ! (gC/m2) fine root C transfer
   real(r8), pointer :: gresp_storage(:)      ! (gC/m2) growth respiration storage
   real(r8), pointer :: gresp_xfer(:)         ! (gC/m2) growth respiration transfer
   real(r8), pointer :: leafc(:)              ! (gC/m2) leaf C
   real(r8), pointer :: leafcmax(:)           ! (gC/m2) ann max leaf C
   real(r8), pointer :: leafc_storage(:)      ! (gC/m2) leaf C storage
   real(r8), pointer :: leafc_xfer(:)         ! (gC/m2) leaf C transfer
   real(r8), pointer :: livecrootc(:)         ! (gC/m2) live coarse root C
   real(r8), pointer :: livecrootc_storage(:) ! (gC/m2) live coarse root C storage
   real(r8), pointer :: livecrootc_xfer(:)    !(gC/m2) live coarse root C transfer
   real(r8), pointer :: livestemc(:)          ! (gC/m2) live stem C
   real(r8), pointer :: livestemc_storage(:)  ! (gC/m2) live stem C storage
   real(r8), pointer :: livestemc_xfer(:)     ! (gC/m2) live stem C transfer
   real(r8), pointer :: m_deadcrootn_storage_to_fire(:) 
   real(r8), pointer :: m_deadcrootn_to_fire(:)         
   real(r8), pointer :: m_deadcrootn_to_litter_fire(:)         
   real(r8), pointer :: m_deadcrootn_xfer_to_fire(:)
   real(r8), pointer :: m_deadstemn_storage_to_fire(:)  
   real(r8), pointer :: m_deadstemn_to_fire(:)          
   real(r8), pointer :: m_deadstemn_to_litter_fire(:)          
   real(r8), pointer :: m_deadstemn_xfer_to_fire(:) 
   real(r8), pointer :: m_frootn_storage_to_fire(:)     
   real(r8), pointer :: m_frootn_to_fire(:)             
   real(r8), pointer :: m_frootn_xfer_to_fire(:)    
   real(r8), pointer :: m_leafn_storage_to_fire(:)      
   real(r8), pointer :: m_leafn_to_fire(:)              
   real(r8), pointer :: m_leafn_xfer_to_fire(:)     
   real(r8), pointer :: m_livecrootn_storage_to_fire(:) 
   real(r8), pointer :: m_livecrootn_to_fire(:)         
   real(r8), pointer :: m_livecrootn_xfer_to_fire(:)
   real(r8), pointer :: m_livestemn_storage_to_fire(:)  
   real(r8), pointer :: m_livestemn_to_fire(:)          
   real(r8), pointer :: m_livestemn_xfer_to_fire(:) 
   real(r8), pointer :: m_retransn_to_fire(:)           
   real(r8), pointer :: deadcrootn(:)         ! (gN/m2) dead coarse root N
   real(r8), pointer :: deadcrootn_storage(:) ! (gN/m2) dead coarse root N storage
   real(r8), pointer :: deadcrootn_xfer(:)    ! (gN/m2) dead coarse root N transfer
   real(r8), pointer :: deadstemn(:)          ! (gN/m2) dead stem N
   real(r8), pointer :: deadstemn_storage(:)  ! (gN/m2) dead stem N storage
   real(r8), pointer :: deadstemn_xfer(:)     ! (gN/m2) dead stem N transfer
   real(r8), pointer :: frootn(:)             ! (gN/m2) fine root N
   real(r8), pointer :: frootn_storage(:)     ! (gN/m2) fine root N storage
   real(r8), pointer :: frootn_xfer(:)        ! (gN/m2) fine root N transfer
   real(r8), pointer :: leafn(:)              ! (gN/m2) leaf N 
   real(r8), pointer :: leafn_storage(:)      ! (gN/m2) leaf N storage
   real(r8), pointer :: leafn_xfer(:)         ! (gN/m2) leaf N transfer
   real(r8), pointer :: livecrootn(:)         ! (gN/m2) live coarse root N
   real(r8), pointer :: livecrootn_storage(:) ! (gN/m2) live coarse root N storage
   real(r8), pointer :: livecrootn_xfer(:)    ! (gN/m2) live coarse root N transfer
   real(r8), pointer :: livestemn(:)          ! (gN/m2) live stem N
   real(r8), pointer :: livestemn_storage(:)  ! (gN/m2) live stem N storage
   real(r8), pointer :: livestemn_xfer(:)     ! (gN/m2) live stem N transfer
   real(r8), pointer :: retransn(:)           ! (gN/m2) plant pool of retranslocated N
!
! !OTHER LOCAL VARIABLES:
   !real(r8), parameter:: wcf = 0.2_r8 ! wood combustion fraction
   real(r8), parameter:: wcf = 0.4_r8 ! wood combustion fraction
   integer :: c,p                  ! indices
   integer :: fp,fc                ! filter indices
   real(r8):: f                    ! rate for fire effects (1/s)
!   real(r8):: dt                   ! time step variable (s)
!EOP
!-----------------------------------------------------------------------

   ! assign local pointers

#if (defined CNDV)
    nind                           => clm3%g%l%c%p%pdgvs%nind
#endif
    ivt                            => clm3%g%l%c%p%itype
    pcolumn                        => clm3%g%l%c%p%column
    woody                          => pftcon%woody
    resist                         => pftcon%resist
    farea_burned                   => clm3%g%l%c%cps%farea_burned
    m_cwdc_to_fire                 => clm3%g%l%c%ccf%m_cwdc_to_fire
    m_deadcrootc_to_cwdc_fire      => clm3%g%l%c%ccf%m_deadcrootc_to_cwdc_fire
    m_deadstemc_to_cwdc_fire       => clm3%g%l%c%ccf%m_deadstemc_to_cwdc_fire
    m_litr1c_to_fire               => clm3%g%l%c%ccf%m_litr1c_to_fire
    m_litr2c_to_fire               => clm3%g%l%c%ccf%m_litr2c_to_fire
    m_litr3c_to_fire               => clm3%g%l%c%ccf%m_litr3c_to_fire
    cwdc                           => clm3%g%l%c%ccs%cwdc
    litr1c                         => clm3%g%l%c%ccs%litr1c
    litr2c                         => clm3%g%l%c%ccs%litr2c
    litr3c                         => clm3%g%l%c%ccs%litr3c
    m_cwdn_to_fire                 => clm3%g%l%c%cnf%m_cwdn_to_fire
    m_deadcrootn_to_cwdn_fire      => clm3%g%l%c%cnf%m_deadcrootn_to_cwdn_fire
    m_deadstemn_to_cwdn_fire       => clm3%g%l%c%cnf%m_deadstemn_to_cwdn_fire
    m_litr1n_to_fire               => clm3%g%l%c%cnf%m_litr1n_to_fire
    m_litr2n_to_fire               => clm3%g%l%c%cnf%m_litr2n_to_fire
    m_litr3n_to_fire               => clm3%g%l%c%cnf%m_litr3n_to_fire
    cwdn                           => clm3%g%l%c%cns%cwdn
    litr1n                         => clm3%g%l%c%cns%litr1n
    litr2n                         => clm3%g%l%c%cns%litr2n
    litr3n                         => clm3%g%l%c%cns%litr3n
    m_deadcrootc_storage_to_fire   => clm3%g%l%c%p%pcf%m_deadcrootc_storage_to_fire
    m_deadcrootc_to_fire           => clm3%g%l%c%p%pcf%m_deadcrootc_to_fire
    m_deadcrootc_to_litter_fire    => clm3%g%l%c%p%pcf%m_deadcrootc_to_litter_fire
    m_deadcrootc_xfer_to_fire      => clm3%g%l%c%p%pcf%m_deadcrootc_xfer_to_fire
    m_deadstemc_storage_to_fire    => clm3%g%l%c%p%pcf%m_deadstemc_storage_to_fire
    m_deadstemc_to_fire            => clm3%g%l%c%p%pcf%m_deadstemc_to_fire
    m_deadstemc_to_litter_fire     => clm3%g%l%c%p%pcf%m_deadstemc_to_litter_fire
    m_deadstemc_to_litter          => clm3%g%l%c%p%pcf%m_deadstemc_to_litter
    m_livestemc_to_litter          => clm3%g%l%c%p%pcf%m_livestemc_to_litter
    m_deadcrootc_to_litter         => clm3%g%l%c%p%pcf%m_deadcrootc_to_litter
    m_livecrootc_to_litter         => clm3%g%l%c%p%pcf%m_livecrootc_to_litter
    m_deadstemc_xfer_to_fire       => clm3%g%l%c%p%pcf%m_deadstemc_xfer_to_fire
    m_frootc_storage_to_fire       => clm3%g%l%c%p%pcf%m_frootc_storage_to_fire
    m_frootc_to_fire               => clm3%g%l%c%p%pcf%m_frootc_to_fire
    m_frootc_xfer_to_fire          => clm3%g%l%c%p%pcf%m_frootc_xfer_to_fire
    m_gresp_storage_to_fire        => clm3%g%l%c%p%pcf%m_gresp_storage_to_fire
    m_gresp_xfer_to_fire           => clm3%g%l%c%p%pcf%m_gresp_xfer_to_fire
    m_leafc_storage_to_fire        => clm3%g%l%c%p%pcf%m_leafc_storage_to_fire
    m_leafc_to_fire                => clm3%g%l%c%p%pcf%m_leafc_to_fire
    m_leafc_xfer_to_fire           => clm3%g%l%c%p%pcf%m_leafc_xfer_to_fire
    m_livecrootc_storage_to_fire   => clm3%g%l%c%p%pcf%m_livecrootc_storage_to_fire
    m_livecrootc_to_fire           => clm3%g%l%c%p%pcf%m_livecrootc_to_fire
    m_livecrootc_xfer_to_fire      => clm3%g%l%c%p%pcf%m_livecrootc_xfer_to_fire
    m_livestemc_storage_to_fire    => clm3%g%l%c%p%pcf%m_livestemc_storage_to_fire
    m_livestemc_to_fire            => clm3%g%l%c%p%pcf%m_livestemc_to_fire
    m_livestemc_xfer_to_fire       => clm3%g%l%c%p%pcf%m_livestemc_xfer_to_fire
    deadcrootc                     => clm3%g%l%c%p%pcs%deadcrootc
    deadcrootc_storage             => clm3%g%l%c%p%pcs%deadcrootc_storage
    deadcrootc_xfer                => clm3%g%l%c%p%pcs%deadcrootc_xfer
    deadstemc                      => clm3%g%l%c%p%pcs%deadstemc
    deadstemc_storage              => clm3%g%l%c%p%pcs%deadstemc_storage
    deadstemc_xfer                 => clm3%g%l%c%p%pcs%deadstemc_xfer
    frootc                         => clm3%g%l%c%p%pcs%frootc
    frootc_storage                 => clm3%g%l%c%p%pcs%frootc_storage
    frootc_xfer                    => clm3%g%l%c%p%pcs%frootc_xfer
    gresp_storage                  => clm3%g%l%c%p%pcs%gresp_storage
    gresp_xfer                     => clm3%g%l%c%p%pcs%gresp_xfer
    leafc                          => clm3%g%l%c%p%pcs%leafc
    leafcmax                       => clm3%g%l%c%p%pcs%leafcmax
    leafc_storage                  => clm3%g%l%c%p%pcs%leafc_storage
    leafc_xfer                     => clm3%g%l%c%p%pcs%leafc_xfer
    livecrootc                     => clm3%g%l%c%p%pcs%livecrootc
    livecrootc_storage             => clm3%g%l%c%p%pcs%livecrootc_storage
    livecrootc_xfer                => clm3%g%l%c%p%pcs%livecrootc_xfer
    livestemc                      => clm3%g%l%c%p%pcs%livestemc
    livestemc_storage              => clm3%g%l%c%p%pcs%livestemc_storage
    livestemc_xfer                 => clm3%g%l%c%p%pcs%livestemc_xfer
    m_deadcrootn_storage_to_fire   => clm3%g%l%c%p%pnf%m_deadcrootn_storage_to_fire
    m_deadcrootn_to_fire           => clm3%g%l%c%p%pnf%m_deadcrootn_to_fire
    m_deadcrootn_to_litter_fire    => clm3%g%l%c%p%pnf%m_deadcrootn_to_litter_fire
    m_deadcrootn_xfer_to_fire      => clm3%g%l%c%p%pnf%m_deadcrootn_xfer_to_fire
    m_deadstemn_storage_to_fire    => clm3%g%l%c%p%pnf%m_deadstemn_storage_to_fire
    m_deadstemn_to_fire            => clm3%g%l%c%p%pnf%m_deadstemn_to_fire
    m_deadstemn_to_litter_fire     => clm3%g%l%c%p%pnf%m_deadstemn_to_litter_fire
    m_deadstemn_xfer_to_fire       => clm3%g%l%c%p%pnf%m_deadstemn_xfer_to_fire
    m_frootn_storage_to_fire       => clm3%g%l%c%p%pnf%m_frootn_storage_to_fire
    m_frootn_to_fire               => clm3%g%l%c%p%pnf%m_frootn_to_fire
    m_frootn_xfer_to_fire          => clm3%g%l%c%p%pnf%m_frootn_xfer_to_fire
    m_leafn_storage_to_fire        => clm3%g%l%c%p%pnf%m_leafn_storage_to_fire
    m_leafn_to_fire                => clm3%g%l%c%p%pnf%m_leafn_to_fire
    m_leafn_xfer_to_fire           => clm3%g%l%c%p%pnf%m_leafn_xfer_to_fire
    m_livecrootn_storage_to_fire   => clm3%g%l%c%p%pnf%m_livecrootn_storage_to_fire
    m_livecrootn_to_fire           => clm3%g%l%c%p%pnf%m_livecrootn_to_fire
    m_livecrootn_xfer_to_fire      => clm3%g%l%c%p%pnf%m_livecrootn_xfer_to_fire
    m_livestemn_storage_to_fire    => clm3%g%l%c%p%pnf%m_livestemn_storage_to_fire
    m_livestemn_to_fire            => clm3%g%l%c%p%pnf%m_livestemn_to_fire
    m_livestemn_xfer_to_fire       => clm3%g%l%c%p%pnf%m_livestemn_xfer_to_fire
    m_retransn_to_fire             => clm3%g%l%c%p%pnf%m_retransn_to_fire
    deadcrootn                     => clm3%g%l%c%p%pns%deadcrootn
    deadcrootn_storage             => clm3%g%l%c%p%pns%deadcrootn_storage
    deadcrootn_xfer                => clm3%g%l%c%p%pns%deadcrootn_xfer
    deadstemn                      => clm3%g%l%c%p%pns%deadstemn
    deadstemn_storage              => clm3%g%l%c%p%pns%deadstemn_storage
    deadstemn_xfer                 => clm3%g%l%c%p%pns%deadstemn_xfer
    frootn                         => clm3%g%l%c%p%pns%frootn
    frootn_storage                 => clm3%g%l%c%p%pns%frootn_storage
    frootn_xfer                    => clm3%g%l%c%p%pns%frootn_xfer
    leafn                          => clm3%g%l%c%p%pns%leafn
    leafn_storage                  => clm3%g%l%c%p%pns%leafn_storage
    leafn_xfer                     => clm3%g%l%c%p%pns%leafn_xfer
    livecrootn                     => clm3%g%l%c%p%pns%livecrootn
    livecrootn_storage             => clm3%g%l%c%p%pns%livecrootn_storage
    livecrootn_xfer                => clm3%g%l%c%p%pns%livecrootn_xfer
    livestemn                      => clm3%g%l%c%p%pns%livestemn
    livestemn_storage              => clm3%g%l%c%p%pns%livestemn_storage
    livestemn_xfer                 => clm3%g%l%c%p%pns%livestemn_xfer
    retransn                       => clm3%g%l%c%p%pns%retransn


   ! Get model step size

!   dt = real( get_step_size(), r8 )

   ! pft loop
   do fp = 1,num_soilp
      p = filter_soilp(fp)
      c = pcolumn(p)

      ! get the column-level fractional area burned for this timestep
      ! and convert to a rate per second, then scale by the pft-level
      ! fire resistance
      f = (farea_burned(c) / dt) * (1._r8 - resist(ivt(p)))
      write(6,*) 'CNFire,farea_burned(',c,')=',farea_burned(c)
      write(6,*) 'CNFire,resist(',ivt(p),')=',resist(ivt(p))
      write(6,*) 'CNFire,dt=',dt
      write(6,*) 'CNFire,f=',f 
      ! apply this rate to the pft state variables to get flux rates

      ! NOTE: the deadstem and deadcroot pools are only partly consumed
      ! by fire, and the remaining affected fraction goes to the column-level
      ! as litter (coarse woody debris). This is controlled by wcf, the woody
      ! combustion fraction.

      ! carbon fluxes
      m_leafc_to_fire(p)               =  leafc(p)              * f
      m_leafc_storage_to_fire(p)       =  leafc_storage(p)      * f
      m_leafc_xfer_to_fire(p)          =  leafc_xfer(p)         * f
      m_frootc_to_fire(p)              =  frootc(p)             * f
      m_frootc_storage_to_fire(p)      =  frootc_storage(p)     * f
      m_frootc_xfer_to_fire(p)         =  frootc_xfer(p)        * f
      m_livestemc_to_fire(p)           =  livestemc(p)          * f
      m_livestemc_storage_to_fire(p)   =  livestemc_storage(p)  * f
      m_livestemc_xfer_to_fire(p)      =  livestemc_xfer(p)     * f
      m_deadstemc_to_fire(p)           =  deadstemc(p)          * f*wcf
      m_deadstemc_to_litter_fire(p)    =  deadstemc(p)          * f*(1._r8 - wcf)
      write(6,*) 'CNFire, deadstemc(',p,')=',deadstemc(p)

      m_deadstemc_storage_to_fire(p)   =  deadstemc_storage(p)  * f
      m_deadstemc_xfer_to_fire(p)      =  deadstemc_xfer(p)     * f
      m_livecrootc_to_fire(p)          =  livecrootc(p)         * f
      m_livecrootc_storage_to_fire(p)  =  livecrootc_storage(p) * f
      m_livecrootc_xfer_to_fire(p)     =  livecrootc_xfer(p)    * f
      m_deadcrootc_to_fire(p)          =  deadcrootc(p)         * f*wcf
      m_deadcrootc_to_litter_fire(p)   =  deadcrootc(p)         * f*(1._r8 - wcf)
      write(6,*) 'CNFire, deadcrootc(',p,')=',deadcrootc(p)
      
      m_deadcrootc_storage_to_fire(p)  =  deadcrootc_storage(p) * f
      m_deadcrootc_xfer_to_fire(p)     =  deadcrootc_xfer(p)    * f
      m_gresp_storage_to_fire(p)       =  gresp_storage(p)      * f
      m_gresp_xfer_to_fire(p)          =  gresp_xfer(p)         * f

      ! nitrogen fluxes
      m_leafn_to_fire(p)               =  leafn(p)              * f
      m_leafn_storage_to_fire(p)       =  leafn_storage(p)      * f
      m_leafn_xfer_to_fire(p)          =  leafn_xfer(p)         * f
      m_frootn_to_fire(p)              =  frootn(p)             * f
      m_frootn_storage_to_fire(p)      =  frootn_storage(p)     * f
      m_frootn_xfer_to_fire(p)         =  frootn_xfer(p)        * f
      m_livestemn_to_fire(p)           =  livestemn(p)          * f
      m_livestemn_storage_to_fire(p)   =  livestemn_storage(p)  * f
      m_livestemn_xfer_to_fire(p)      =  livestemn_xfer(p)     * f
      m_deadstemn_to_fire(p)           =  deadstemn(p)          * f*wcf
      m_deadstemn_to_litter_fire(p)    =  deadstemn(p)          * f*(1._r8 - wcf)
      write(6,*) 'CNFire, deadstemn(',p,')=',deadstemn(p)


      m_deadstemn_storage_to_fire(p)   =  deadstemn_storage(p)  * f
      m_deadstemn_xfer_to_fire(p)      =  deadstemn_xfer(p)     * f
      m_livecrootn_to_fire(p)          =  livecrootn(p)         * f
      m_livecrootn_storage_to_fire(p)  =  livecrootn_storage(p) * f
      m_livecrootn_xfer_to_fire(p)     =  livecrootn_xfer(p)    * f
      m_deadcrootn_to_fire(p)          =  deadcrootn(p)         * f*wcf
      m_deadcrootn_to_litter_fire(p)   =  deadcrootn(p)         * f*(1._r8 - wcf)
      write(6,*) 'CNFire, deadcrootn(',p,')=',deadcrootn(p)

      m_deadcrootn_storage_to_fire(p)  =  deadcrootn_storage(p) * f
      m_deadcrootn_xfer_to_fire(p)     =  deadcrootn_xfer(p)    * f
      m_retransn_to_fire(p)            =  retransn(p)           * f

#if (defined CNDV)
      ! Carbon per individual (c) remains constant in gap mortality & fire
      ! but individuals are removed from the population P (#/m2 naturally
      ! vegetated area), so
      !
      ! c = Cnew*FPC/Pnew = Cold*FPC/Pold
      !
      ! where C = carbon/m2 pft area & FPC = pft area/naturally vegetated area.
      ! FPC does not change from mortality or fire. FPC changes from Light and
      ! Establishment at the end of the year. So...
      !
      ! Pnew = Pold * Cnew / Cold
      !
      ! where "new" refers to after mortality & fire, while "old" refers to
      ! before mortality & fire. For C I use total wood. (slevis)
      !
      ! nind calculation placed here for convenience; nind could be updated
      ! once per year instead if we saved Cold for that calculation;
      ! as is, nind slowly decreases through the year, while fpcgrid remains
      ! unchanged; this affects the htop calculation in CNVegStructUpdate

      if (woody(ivt(p)) == 1._r8) then
         if (livestemc(p)+deadstemc(p)+m_livestemc_to_litter(p)*dt+ &
                                       m_deadstemc_to_litter(p)*dt > 0._r8) then
            nind(p) = nind(p) * (livestemc(p)  + deadstemc(p) +       &
                                 livecrootc(p) + deadcrootc(p) - dt * &
                                 (m_livestemc_to_fire(p)  +           &
                                  m_livecrootc_to_fire(p) +           &
                                  m_deadstemc_to_fire(p)  +           &
                                  m_deadcrootc_to_fire(p) +           &
                                  m_deadcrootc_to_litter_fire(p) +    &
                                  m_deadstemc_to_litter_fire(p))) /   &
                                (livestemc(p)  + deadstemc(p) +       &
                                 livecrootc(p) + deadcrootc(p) + dt * &
                                 (m_livestemc_to_litter(p)  +         &
                                  m_livecrootc_to_litter(p) +         &
                                  m_deadcrootc_to_litter(p) +         &
                                  m_deadstemc_to_litter(p)))
         else
            nind(p) = 0._r8
         end if
      end if

      ! annual dgvm calculations use lm_ind = leafcmax * fpcgrid / nind
      ! leafcmax is reset to 0 once per yr
      ! could calculate leafcmax in CSummary instead; if so, should remove
      ! subtraction of m_leafc_to_fire(p)*dt from the calculation (slevis)

      leafcmax(p) = max(leafc(p)-m_leafc_to_fire(p)*dt, leafcmax(p))
      if (ivt(p) == 0) leafcmax(p) = 0._r8
#endif

   end do  ! end of pfts loop

   ! send the fire affected but uncombusted woody fraction to the column-level cwd fluxes
   ! use p2c for weighted averaging from pft to column
   call p2c(num_soilc, filter_soilc, m_deadstemc_to_litter_fire, m_deadstemc_to_cwdc_fire)
   call p2c(num_soilc, filter_soilc, m_deadcrootc_to_litter_fire, m_deadcrootc_to_cwdc_fire)
   call p2c(num_soilc, filter_soilc, m_deadstemn_to_litter_fire, m_deadstemn_to_cwdn_fire)
   call p2c(num_soilc, filter_soilc, m_deadcrootn_to_litter_fire, m_deadcrootn_to_cwdn_fire)

   ! column loop
   do fc = 1,num_soilc
      c = filter_soilc(fc)

      ! get the column-level fractional area burned for this timestep
      ! and convert to a rate per second, then scale by the pft-level
      ! fire resistance

      f = farea_burned(c) / dt

      ! apply this rate to the column state variables to get flux rates

      ! NOTE: the coarse woody debris pools are only partly consumed
      ! by fire. This is controlled by wcf, the woody
      ! combustion fraction. For now using the same fraction for standing
      ! wood (deadstem and deadcroot pools) and woody litter (cwd pools).
      ! May be a good idea later to modify this to use different fractions
      ! for different woody pools, or make the combustion fraction a dynamic
      ! variable.

      ! carbon fluxes
      m_litr1c_to_fire(c) = litr1c(c) * f
      m_litr2c_to_fire(c) = litr2c(c) * f
      m_litr3c_to_fire(c) = litr3c(c) * f
      m_cwdc_to_fire(c)   = cwdc(c)   * f*wcf

      ! nitrogen fluxes
      m_litr1n_to_fire(c) = litr1n(c) * f
      m_litr2n_to_fire(c) = litr2n(c) * f
      m_litr3n_to_fire(c) = litr3n(c) * f
      m_cwdn_to_fire(c)   = cwdn(c)   * f*wcf

   end do  ! end of column loop

end subroutine CNFireFluxes

!-----------------------------------------------------------------------
#endif

end module CNFireMod
module CNGRespMod
#ifdef CN

!-----------------------------------------------------------------------
!BOP
!
! !MODULE: CNGRespMod
!
! !DESCRIPTION:
! Module for growth respiration fluxes,
! for coupled carbon-nitrogen code.
!
! !USES:
   use shr_kind_mod, only: r8 => shr_kind_r8
   implicit none
   save
   private
! !PUBLIC MEMBER FUNCTIONS:
   public :: CNGResp
!
! !REVISION HISTORY:
! 9/12/03: Created by Peter Thornton
! 10/27/03, Peter Thornton: migrated to vector data structures
!
!EOP
!-----------------------------------------------------------------------

contains

!-----------------------------------------------------------------------
!BOP
!
! !IROUTINE: CNGResp
!
! !INTERFACE:
subroutine CNGResp(num_soilp, filter_soilp)
!
! !DESCRIPTION:
! On the radiation time step, update all the prognostic carbon state
! variables
!
! !USES:
   use clmtype
#ifdef CROP
   use pftvarcon, only : npcropmin
#endif
!
! !ARGUMENTS:
   implicit none
   integer, intent(in) :: num_soilp       ! number of soil pfts in filter
   integer, intent(in) :: filter_soilp(:) ! filter for soil pfts
!
! !CALLED FROM:
! subroutine CNEcosystemDyn, in module CNEcosystemDynMod.F90
!
! !REVISION HISTORY:
! 8/1/03: Created by Peter Thornton
!
! !LOCAL VARIABLES:
! local pointers to implicit in scalars
!
   integer , pointer :: ivt(:)         ! pft vegetation type
   real(r8), pointer :: cpool_to_leafc(:)
   real(r8), pointer :: cpool_to_leafc_storage(:)
   real(r8), pointer :: cpool_to_frootc(:)
   real(r8), pointer :: cpool_to_frootc_storage(:)
   real(r8), pointer :: cpool_to_livestemc(:)
   real(r8), pointer :: cpool_to_livestemc_storage(:)
   real(r8), pointer :: cpool_to_deadstemc(:)
   real(r8), pointer :: cpool_to_deadstemc_storage(:)
   real(r8), pointer :: cpool_to_livecrootc(:)
   real(r8), pointer :: cpool_to_livecrootc_storage(:)
   real(r8), pointer :: cpool_to_deadcrootc(:)
   real(r8), pointer :: cpool_to_deadcrootc_storage(:)
#if (defined CROP)
   real(r8), pointer :: cpool_to_grainc(:)
   real(r8), pointer :: cpool_to_grainc_storage(:)
   real(r8), pointer :: grainc_xfer_to_grainc(:)
#endif
   real(r8), pointer :: leafc_xfer_to_leafc(:)
   real(r8), pointer :: frootc_xfer_to_frootc(:)
   real(r8), pointer :: livestemc_xfer_to_livestemc(:)
   real(r8), pointer :: deadstemc_xfer_to_deadstemc(:)
   real(r8), pointer :: livecrootc_xfer_to_livecrootc(:)
   real(r8), pointer :: deadcrootc_xfer_to_deadcrootc(:)
   real(r8), pointer :: woody(:) !binary flag for woody lifeform (1=woody, 0=not woody)
!
! local pointers to implicit in/out scalars
!
#if (defined CROP)
   real(r8), pointer :: cpool_grain_gr(:)
   real(r8), pointer :: cpool_grain_storage_gr(:)
   real(r8), pointer :: transfer_grain_gr(:)
#endif
   real(r8), pointer :: cpool_leaf_gr(:)
   real(r8), pointer :: cpool_leaf_storage_gr(:)
   real(r8), pointer :: transfer_leaf_gr(:)
   real(r8), pointer :: cpool_froot_gr(:)
   real(r8), pointer :: cpool_froot_storage_gr(:)
   real(r8), pointer :: transfer_froot_gr(:)
   real(r8), pointer :: cpool_livestem_gr(:)
   real(r8), pointer :: cpool_livestem_storage_gr(:)
   real(r8), pointer :: transfer_livestem_gr(:)
   real(r8), pointer :: cpool_deadstem_gr(:)
   real(r8), pointer :: cpool_deadstem_storage_gr(:)
   real(r8), pointer :: transfer_deadstem_gr(:)
   real(r8), pointer :: cpool_livecroot_gr(:)
   real(r8), pointer :: cpool_livecroot_storage_gr(:)
   real(r8), pointer :: transfer_livecroot_gr(:)
   real(r8), pointer :: cpool_deadcroot_gr(:)
   real(r8), pointer :: cpool_deadcroot_storage_gr(:)
   real(r8), pointer :: transfer_deadcroot_gr(:)
!
! local pointers to implicit out scalars
!
!
! !OTHER LOCAL VARIABLES:
   integer :: p                ! indices
   integer :: fp               ! lake filter pft index
   real(r8):: grperc, grpnow   ! growth respirarion parameters

!EOP
!-----------------------------------------------------------------------
   ! Assign local pointers to derived type arrays (in)
   ivt                           => clm3%g%l%c%p%itype
   cpool_to_leafc                => clm3%g%l%c%p%pcf%cpool_to_leafc
   cpool_to_leafc_storage        => clm3%g%l%c%p%pcf%cpool_to_leafc_storage
   cpool_to_frootc               => clm3%g%l%c%p%pcf%cpool_to_frootc
   cpool_to_frootc_storage       => clm3%g%l%c%p%pcf%cpool_to_frootc_storage
   cpool_to_livestemc            => clm3%g%l%c%p%pcf%cpool_to_livestemc
   cpool_to_livestemc_storage    => clm3%g%l%c%p%pcf%cpool_to_livestemc_storage
   cpool_to_deadstemc            => clm3%g%l%c%p%pcf%cpool_to_deadstemc
   cpool_to_deadstemc_storage    => clm3%g%l%c%p%pcf%cpool_to_deadstemc_storage
   cpool_to_livecrootc           => clm3%g%l%c%p%pcf%cpool_to_livecrootc
   cpool_to_livecrootc_storage   => clm3%g%l%c%p%pcf%cpool_to_livecrootc_storage
   cpool_to_deadcrootc           => clm3%g%l%c%p%pcf%cpool_to_deadcrootc
   cpool_to_deadcrootc_storage   => clm3%g%l%c%p%pcf%cpool_to_deadcrootc_storage
#if (defined CROP)
   cpool_to_grainc               => clm3%g%l%c%p%pcf%cpool_to_grainc
   cpool_to_grainc_storage       => clm3%g%l%c%p%pcf%cpool_to_grainc_storage
   grainc_xfer_to_grainc         => clm3%g%l%c%p%pcf%grainc_xfer_to_grainc
#endif
   leafc_xfer_to_leafc           => clm3%g%l%c%p%pcf%leafc_xfer_to_leafc
   frootc_xfer_to_frootc         => clm3%g%l%c%p%pcf%frootc_xfer_to_frootc
   livestemc_xfer_to_livestemc   => clm3%g%l%c%p%pcf%livestemc_xfer_to_livestemc
   deadstemc_xfer_to_deadstemc   => clm3%g%l%c%p%pcf%deadstemc_xfer_to_deadstemc
   livecrootc_xfer_to_livecrootc => clm3%g%l%c%p%pcf%livecrootc_xfer_to_livecrootc
   deadcrootc_xfer_to_deadcrootc => clm3%g%l%c%p%pcf%deadcrootc_xfer_to_deadcrootc
   woody => pftcon%woody

   ! Assign local pointers to derived type arrays (out)
#if (defined CROP)
   cpool_grain_gr                => clm3%g%l%c%p%pcf%cpool_grain_gr
   cpool_grain_storage_gr        => clm3%g%l%c%p%pcf%cpool_grain_storage_gr
   transfer_grain_gr             => clm3%g%l%c%p%pcf%transfer_grain_gr
#endif
   cpool_leaf_gr                 => clm3%g%l%c%p%pcf%cpool_leaf_gr
   cpool_leaf_storage_gr         => clm3%g%l%c%p%pcf%cpool_leaf_storage_gr
   transfer_leaf_gr              => clm3%g%l%c%p%pcf%transfer_leaf_gr
   cpool_froot_gr                => clm3%g%l%c%p%pcf%cpool_froot_gr
   cpool_froot_storage_gr        => clm3%g%l%c%p%pcf%cpool_froot_storage_gr
   transfer_froot_gr             => clm3%g%l%c%p%pcf%transfer_froot_gr
   cpool_livestem_gr             => clm3%g%l%c%p%pcf%cpool_livestem_gr
   cpool_livestem_storage_gr     => clm3%g%l%c%p%pcf%cpool_livestem_storage_gr
   transfer_livestem_gr          => clm3%g%l%c%p%pcf%transfer_livestem_gr
   cpool_deadstem_gr             => clm3%g%l%c%p%pcf%cpool_deadstem_gr
   cpool_deadstem_storage_gr     => clm3%g%l%c%p%pcf%cpool_deadstem_storage_gr
   transfer_deadstem_gr          => clm3%g%l%c%p%pcf%transfer_deadstem_gr
   cpool_livecroot_gr            => clm3%g%l%c%p%pcf%cpool_livecroot_gr
   cpool_livecroot_storage_gr    => clm3%g%l%c%p%pcf%cpool_livecroot_storage_gr
   transfer_livecroot_gr         => clm3%g%l%c%p%pcf%transfer_livecroot_gr
   cpool_deadcroot_gr            => clm3%g%l%c%p%pcf%cpool_deadcroot_gr
   cpool_deadcroot_storage_gr    => clm3%g%l%c%p%pcf%cpool_deadcroot_storage_gr
   transfer_deadcroot_gr         => clm3%g%l%c%p%pcf%transfer_deadcroot_gr

   ! set some parameters (temporary, these will eventually go into
   ! either pepc, or parameter file
   grperc = 0.3_r8
   grpnow = 1.0_r8

   ! Loop through pfts
   ! start pft loop
   do fp = 1,num_soilp
      p = filter_soilp(fp)

   call CLMDebug('CNGResp--mark1')
#if (defined CROP)
      if (ivt(p) >= npcropmin) then ! skip 2 generic crops
         grperc = 0.25_r8 ! had to set this again in CNAllocation
         cpool_livestem_gr(p)          = cpool_to_livestemc(p) * grperc
         cpool_livestem_storage_gr(p)  = cpool_to_livestemc_storage(p) * grperc * grpnow
    call CLMDebug('CNGResp--mark11')
         transfer_livestem_gr(p)       = livestemc_xfer_to_livestemc(p) * grperc * (1._r8 - grpnow)
         cpool_grain_gr(p)             = cpool_to_grainc(p) * grperc
    call CLMDebug('CNGResp--mark12')
         cpool_grain_storage_gr(p)     = cpool_to_grainc_storage(p) * grperc * grpnow
         transfer_grain_gr(p)          = grainc_xfer_to_grainc(p) * grperc * (1._r8 - grpnow)
      else
         grperc = 0.3_r8 ! need the else b/c the value from before the loop will not get used after
      end if             ! grperc is set to 0.25 once
#endif
   call CLMDebug('CNGResp--mark2')

      ! leaf and fine root growth respiration
      cpool_leaf_gr(p)          = cpool_to_leafc(p) * grperc
      cpool_leaf_storage_gr(p)  = cpool_to_leafc_storage(p) * grperc * grpnow
      transfer_leaf_gr(p)       = leafc_xfer_to_leafc(p) * grperc * (1._r8 - grpnow)
      cpool_froot_gr(p)         = cpool_to_frootc(p) * grperc
      cpool_froot_storage_gr(p) = cpool_to_frootc_storage(p) * grperc * grpnow
      transfer_froot_gr(p)      = frootc_xfer_to_frootc(p) * grperc * (1._r8 - grpnow)
   call CLMDebug('CNGResp--mark3')

      if (woody(ivt(p)) == 1._r8) then
          cpool_livestem_gr(p)          = cpool_to_livestemc(p) * grperc
          cpool_livestem_storage_gr(p)  = cpool_to_livestemc_storage(p) * grperc * grpnow
          transfer_livestem_gr(p)       = livestemc_xfer_to_livestemc(p) * grperc * (1._r8 - grpnow)
          cpool_deadstem_gr(p)          = cpool_to_deadstemc(p) * grperc
          cpool_deadstem_storage_gr(p)  = cpool_to_deadstemc_storage(p) * grperc * grpnow
          transfer_deadstem_gr(p)       = deadstemc_xfer_to_deadstemc(p) * grperc * (1._r8 - grpnow)
          cpool_livecroot_gr(p)         = cpool_to_livecrootc(p) * grperc
          cpool_livecroot_storage_gr(p) = cpool_to_livecrootc_storage(p) * grperc * grpnow
          transfer_livecroot_gr(p)      = livecrootc_xfer_to_livecrootc(p) * grperc * (1._r8 - grpnow)
          cpool_deadcroot_gr(p)         = cpool_to_deadcrootc(p) * grperc
          cpool_deadcroot_storage_gr(p) = cpool_to_deadcrootc_storage(p) * grperc * grpnow
          transfer_deadcroot_gr(p)      = deadcrootc_xfer_to_deadcrootc(p) * grperc * (1._r8 - grpnow)
      end if

   end do

end subroutine CNGResp

#endif

end module CNGRespMod
module CNGapMortalityMod
#ifdef CN

!-----------------------------------------------------------------------
!BOP
!
! !MODULE: CNGapMortalityMod
!
! !DESCRIPTION:
! Module holding routines used in gap mortality for coupled carbon
! nitrogen code.
!
! !USES:
  use shr_kind_mod, only: r8 => shr_kind_r8
  implicit none
  save
  private
! !PUBLIC MEMBER FUNCTIONS:
  public :: CNGapMortality
!
! !REVISION HISTORY:
! 3/29/04: Created by Peter Thornton
!
!EOP
!-----------------------------------------------------------------------

contains

!-----------------------------------------------------------------------
!BOP
!
! !IROUTINE: CNGapMortality
!
! !INTERFACE:
subroutine CNGapMortality (num_soilc, filter_soilc, num_soilp, filter_soilp)
!
! !DESCRIPTION:
! Gap-phase mortality routine for coupled carbon-nitrogen code (CN)
!
! !USES:
   use clmtype
!   use clm_time_manager, only: get_days_per_year
   use globals, only: day_per_year
!
! !ARGUMENTS:
   implicit none
   integer, intent(in) :: num_soilc       ! number of soil columns in filter
   integer, intent(in) :: filter_soilc(:) ! column filter for soil points
   integer, intent(in) :: num_soilp       ! number of soil pfts in filter
   integer, intent(in) :: filter_soilp(:) ! pft filter for soil points
!
! !CALLED FROM:
! subroutine CNEcosystemDyn
!
! !REVISION HISTORY:
! 3/29/04: Created by Peter Thornton
!
! !LOCAL VARIABLES:
!
! local pointers to implicit in arrays
   integer , pointer :: ivt(:)         ! pft vegetation type
   real(r8), pointer :: woody(:)       ! binary flag for woody lifeform
                                       ! (1=woody, 0=not woody)
   real(r8), pointer :: leafc(:)              ! (gC/m2) leaf C
   real(r8), pointer :: frootc(:)             ! (gC/m2) fine root C
   real(r8), pointer :: livestemc(:)          ! (gC/m2) live stem C
   real(r8), pointer :: deadstemc(:)          ! (gC/m2) dead stem C
   real(r8), pointer :: livecrootc(:)         ! (gC/m2) live coarse root C
   real(r8), pointer :: deadcrootc(:)         ! (gC/m2) dead coarse root C
   real(r8), pointer :: leafc_storage(:)      ! (gC/m2) leaf C storage
   real(r8), pointer :: frootc_storage(:)     ! (gC/m2) fine root C storage
   real(r8), pointer :: livestemc_storage(:)  ! (gC/m2) live stem C storage
   real(r8), pointer :: deadstemc_storage(:)  ! (gC/m2) dead stem C storage
   real(r8), pointer :: livecrootc_storage(:) ! (gC/m2) live coarse root C storage
   real(r8), pointer :: deadcrootc_storage(:) ! (gC/m2) dead coarse root C storage
   real(r8), pointer :: gresp_storage(:)      ! (gC/m2) growth respiration storage
   real(r8), pointer :: leafc_xfer(:)         ! (gC/m2) leaf C transfer
   real(r8), pointer :: frootc_xfer(:)        ! (gC/m2) fine root C transfer
   real(r8), pointer :: livestemc_xfer(:)     ! (gC/m2) live stem C transfer
   real(r8), pointer :: deadstemc_xfer(:)     ! (gC/m2) dead stem C transfer
   real(r8), pointer :: livecrootc_xfer(:)    ! (gC/m2) live coarse root C transfer
   real(r8), pointer :: deadcrootc_xfer(:)    ! (gC/m2) dead coarse root C transfer
   real(r8), pointer :: gresp_xfer(:)         ! (gC/m2) growth respiration transfer
   real(r8), pointer :: leafn(:)              ! (gN/m2) leaf N
   real(r8), pointer :: frootn(:)             ! (gN/m2) fine root N
   real(r8), pointer :: livestemn(:)          ! (gN/m2) live stem N
   real(r8), pointer :: deadstemn(:)          ! (gN/m2) dead stem N
   real(r8), pointer :: livecrootn(:)         ! (gN/m2) live coarse root N
   real(r8), pointer :: deadcrootn(:)         ! (gN/m2) dead coarse root N
   real(r8), pointer :: retransn(:)           ! (gN/m2) plant pool of retranslocated N
   real(r8), pointer :: leafn_storage(:)      ! (gN/m2) leaf N storage
   real(r8), pointer :: frootn_storage(:)     ! (gN/m2) fine root N storage
   real(r8), pointer :: livestemn_storage(:)  ! (gN/m2) live stem N storage
   real(r8), pointer :: deadstemn_storage(:)  ! (gN/m2) dead stem N storage
   real(r8), pointer :: livecrootn_storage(:) ! (gN/m2) live coarse root N storage
   real(r8), pointer :: deadcrootn_storage(:) ! (gN/m2) dead coarse root N storage
   real(r8), pointer :: leafn_xfer(:)         ! (gN/m2) leaf N transfer
   real(r8), pointer :: frootn_xfer(:)        ! (gN/m2) fine root N transfer
   real(r8), pointer :: livestemn_xfer(:)     ! (gN/m2) live stem N transfer
   real(r8), pointer :: deadstemn_xfer(:)     ! (gN/m2) dead stem N transfer
   real(r8), pointer :: livecrootn_xfer(:)    ! (gN/m2) live coarse root N transfer
   real(r8), pointer :: deadcrootn_xfer(:)    ! (gN/m2) dead coarse root N transfer
#if (defined CNDV)
   real(r8), pointer :: greffic(:)
   real(r8), pointer :: heatstress(:)
#endif
!
! local pointers to implicit in/out arrays
!
! local pointers to implicit out arrays
   real(r8), pointer :: m_leafc_to_litter(:)
   real(r8), pointer :: m_frootc_to_litter(:)
   real(r8), pointer :: m_livestemc_to_litter(:)
   real(r8), pointer :: m_deadstemc_to_litter(:)
   real(r8), pointer :: m_livecrootc_to_litter(:)
   real(r8), pointer :: m_deadcrootc_to_litter(:)
   real(r8), pointer :: m_leafc_storage_to_litter(:)
   real(r8), pointer :: m_frootc_storage_to_litter(:)
   real(r8), pointer :: m_livestemc_storage_to_litter(:)
   real(r8), pointer :: m_deadstemc_storage_to_litter(:)
   real(r8), pointer :: m_livecrootc_storage_to_litter(:)
   real(r8), pointer :: m_deadcrootc_storage_to_litter(:)
   real(r8), pointer :: m_gresp_storage_to_litter(:)
   real(r8), pointer :: m_leafc_xfer_to_litter(:)
   real(r8), pointer :: m_frootc_xfer_to_litter(:)
   real(r8), pointer :: m_livestemc_xfer_to_litter(:)
   real(r8), pointer :: m_deadstemc_xfer_to_litter(:)
   real(r8), pointer :: m_livecrootc_xfer_to_litter(:)
   real(r8), pointer :: m_deadcrootc_xfer_to_litter(:)
   real(r8), pointer :: m_gresp_xfer_to_litter(:)
   real(r8), pointer :: m_leafn_to_litter(:)
   real(r8), pointer :: m_frootn_to_litter(:)
   real(r8), pointer :: m_livestemn_to_litter(:)
   real(r8), pointer :: m_deadstemn_to_litter(:)
   real(r8), pointer :: m_livecrootn_to_litter(:)
   real(r8), pointer :: m_deadcrootn_to_litter(:)
   real(r8), pointer :: m_retransn_to_litter(:)
   real(r8), pointer :: m_leafn_storage_to_litter(:)
   real(r8), pointer :: m_frootn_storage_to_litter(:)
   real(r8), pointer :: m_livestemn_storage_to_litter(:)
   real(r8), pointer :: m_deadstemn_storage_to_litter(:)
   real(r8), pointer :: m_livecrootn_storage_to_litter(:)
   real(r8), pointer :: m_deadcrootn_storage_to_litter(:)
   real(r8), pointer :: m_leafn_xfer_to_litter(:)
   real(r8), pointer :: m_frootn_xfer_to_litter(:)
   real(r8), pointer :: m_livestemn_xfer_to_litter(:)
   real(r8), pointer :: m_deadstemn_xfer_to_litter(:)
   real(r8), pointer :: m_livecrootn_xfer_to_litter(:)
   real(r8), pointer :: m_deadcrootn_xfer_to_litter(:)
!
! !OTHER LOCAL VARIABLES:
   integer :: p                         ! pft index
   integer :: fp                        ! pft filter index
   real(r8):: am                        ! rate for fractional mortality (1/yr)
   real(r8):: m                         ! rate for fractional mortality (1/s)
   real(r8):: mort_max                  ! asymptotic max mortality rate (/yr)
   real(r8), parameter :: k_mort = 0.3  !coeff of growth efficiency in mortality equation
!EOP
!-----------------------------------------------------------------------

   ! assign local pointers
   woody                          => pftcon%woody

   ! assign local pointers to pft-level arrays
   ivt                            => clm3%g%l%c%p%itype
   leafc                          => clm3%g%l%c%p%pcs%leafc
   frootc                         => clm3%g%l%c%p%pcs%frootc
   livestemc                      => clm3%g%l%c%p%pcs%livestemc
   deadstemc                      => clm3%g%l%c%p%pcs%deadstemc
   livecrootc                     => clm3%g%l%c%p%pcs%livecrootc
   deadcrootc                     => clm3%g%l%c%p%pcs%deadcrootc
   leafc_storage                  => clm3%g%l%c%p%pcs%leafc_storage
   frootc_storage                 => clm3%g%l%c%p%pcs%frootc_storage
   livestemc_storage              => clm3%g%l%c%p%pcs%livestemc_storage
   deadstemc_storage              => clm3%g%l%c%p%pcs%deadstemc_storage
   livecrootc_storage             => clm3%g%l%c%p%pcs%livecrootc_storage
   deadcrootc_storage             => clm3%g%l%c%p%pcs%deadcrootc_storage
   gresp_storage                  => clm3%g%l%c%p%pcs%gresp_storage
   leafc_xfer                     => clm3%g%l%c%p%pcs%leafc_xfer
   frootc_xfer                    => clm3%g%l%c%p%pcs%frootc_xfer
   livestemc_xfer                 => clm3%g%l%c%p%pcs%livestemc_xfer
   deadstemc_xfer                 => clm3%g%l%c%p%pcs%deadstemc_xfer
   livecrootc_xfer                => clm3%g%l%c%p%pcs%livecrootc_xfer
   deadcrootc_xfer                => clm3%g%l%c%p%pcs%deadcrootc_xfer
   gresp_xfer                     => clm3%g%l%c%p%pcs%gresp_xfer
   leafn                          => clm3%g%l%c%p%pns%leafn
   frootn                         => clm3%g%l%c%p%pns%frootn
   livestemn                      => clm3%g%l%c%p%pns%livestemn
   deadstemn                      => clm3%g%l%c%p%pns%deadstemn
   livecrootn                     => clm3%g%l%c%p%pns%livecrootn
   deadcrootn                     => clm3%g%l%c%p%pns%deadcrootn
   retransn                       => clm3%g%l%c%p%pns%retransn
   leafn_storage                  => clm3%g%l%c%p%pns%leafn_storage
   frootn_storage                 => clm3%g%l%c%p%pns%frootn_storage
   livestemn_storage              => clm3%g%l%c%p%pns%livestemn_storage
   deadstemn_storage              => clm3%g%l%c%p%pns%deadstemn_storage
   livecrootn_storage             => clm3%g%l%c%p%pns%livecrootn_storage
   deadcrootn_storage             => clm3%g%l%c%p%pns%deadcrootn_storage
   leafn_xfer                     => clm3%g%l%c%p%pns%leafn_xfer
   frootn_xfer                    => clm3%g%l%c%p%pns%frootn_xfer
   livestemn_xfer                 => clm3%g%l%c%p%pns%livestemn_xfer
   deadstemn_xfer                 => clm3%g%l%c%p%pns%deadstemn_xfer
   livecrootn_xfer                => clm3%g%l%c%p%pns%livecrootn_xfer
   deadcrootn_xfer                => clm3%g%l%c%p%pns%deadcrootn_xfer
   m_leafc_to_litter              => clm3%g%l%c%p%pcf%m_leafc_to_litter
   m_frootc_to_litter             => clm3%g%l%c%p%pcf%m_frootc_to_litter
   m_livestemc_to_litter          => clm3%g%l%c%p%pcf%m_livestemc_to_litter
   m_deadstemc_to_litter          => clm3%g%l%c%p%pcf%m_deadstemc_to_litter
   m_livecrootc_to_litter         => clm3%g%l%c%p%pcf%m_livecrootc_to_litter
   m_deadcrootc_to_litter         => clm3%g%l%c%p%pcf%m_deadcrootc_to_litter
   m_leafc_storage_to_litter      => clm3%g%l%c%p%pcf%m_leafc_storage_to_litter
   m_frootc_storage_to_litter     => clm3%g%l%c%p%pcf%m_frootc_storage_to_litter
   m_livestemc_storage_to_litter  => clm3%g%l%c%p%pcf%m_livestemc_storage_to_litter
   m_deadstemc_storage_to_litter  => clm3%g%l%c%p%pcf%m_deadstemc_storage_to_litter
   m_livecrootc_storage_to_litter => clm3%g%l%c%p%pcf%m_livecrootc_storage_to_litter
   m_deadcrootc_storage_to_litter => clm3%g%l%c%p%pcf%m_deadcrootc_storage_to_litter
   m_gresp_storage_to_litter      => clm3%g%l%c%p%pcf%m_gresp_storage_to_litter
   m_leafc_xfer_to_litter         => clm3%g%l%c%p%pcf%m_leafc_xfer_to_litter
   m_frootc_xfer_to_litter        => clm3%g%l%c%p%pcf%m_frootc_xfer_to_litter
   m_livestemc_xfer_to_litter     => clm3%g%l%c%p%pcf%m_livestemc_xfer_to_litter
   m_deadstemc_xfer_to_litter     => clm3%g%l%c%p%pcf%m_deadstemc_xfer_to_litter
   m_livecrootc_xfer_to_litter    => clm3%g%l%c%p%pcf%m_livecrootc_xfer_to_litter
   m_deadcrootc_xfer_to_litter    => clm3%g%l%c%p%pcf%m_deadcrootc_xfer_to_litter
   m_gresp_xfer_to_litter         => clm3%g%l%c%p%pcf%m_gresp_xfer_to_litter
   m_leafn_to_litter              => clm3%g%l%c%p%pnf%m_leafn_to_litter
   m_frootn_to_litter             => clm3%g%l%c%p%pnf%m_frootn_to_litter
   m_livestemn_to_litter          => clm3%g%l%c%p%pnf%m_livestemn_to_litter
   m_deadstemn_to_litter          => clm3%g%l%c%p%pnf%m_deadstemn_to_litter
   m_livecrootn_to_litter         => clm3%g%l%c%p%pnf%m_livecrootn_to_litter
   m_deadcrootn_to_litter         => clm3%g%l%c%p%pnf%m_deadcrootn_to_litter
   m_retransn_to_litter           => clm3%g%l%c%p%pnf%m_retransn_to_litter
   m_leafn_storage_to_litter      => clm3%g%l%c%p%pnf%m_leafn_storage_to_litter
   m_frootn_storage_to_litter     => clm3%g%l%c%p%pnf%m_frootn_storage_to_litter
   m_livestemn_storage_to_litter  => clm3%g%l%c%p%pnf%m_livestemn_storage_to_litter
   m_deadstemn_storage_to_litter  => clm3%g%l%c%p%pnf%m_deadstemn_storage_to_litter
   m_livecrootn_storage_to_litter => clm3%g%l%c%p%pnf%m_livecrootn_storage_to_litter
   m_deadcrootn_storage_to_litter => clm3%g%l%c%p%pnf%m_deadcrootn_storage_to_litter
   m_leafn_xfer_to_litter         => clm3%g%l%c%p%pnf%m_leafn_xfer_to_litter
   m_frootn_xfer_to_litter        => clm3%g%l%c%p%pnf%m_frootn_xfer_to_litter
   m_livestemn_xfer_to_litter     => clm3%g%l%c%p%pnf%m_livestemn_xfer_to_litter
   m_deadstemn_xfer_to_litter     => clm3%g%l%c%p%pnf%m_deadstemn_xfer_to_litter
   m_livecrootn_xfer_to_litter    => clm3%g%l%c%p%pnf%m_livecrootn_xfer_to_litter
   m_deadcrootn_xfer_to_litter    => clm3%g%l%c%p%pnf%m_deadcrootn_xfer_to_litter
#if (defined CNDV)
   greffic                        => clm3%g%l%c%p%pdgvs%greffic
   heatstress                     => clm3%g%l%c%p%pdgvs%heatstress
#endif

   ! set the mortality rate based on annual rate
   am = 0.02_r8

   ! pft loop
   do fp = 1,num_soilp
      p = filter_soilp(fp)

#if (defined CNDV)
   ! Stress mortality from lpj's subr Mortality.

      if (woody(ivt(p)) == 1._r8) then

         if (ivt(p) == 8) then
            mort_max = 0.03_r8 ! BDT boreal
         else
            mort_max = 0.01_r8 ! original value for all pfts
         end if

         ! heatstress and greffic calculated in Establishment once/yr

         ! Mortality rate inversely related to growth efficiency
         ! (Prentice et al 1993)
         am = mort_max / (1._r8 + k_mort * greffic(p))

         am = min(1._r8, am + heatstress(p))
      else ! lpj didn't set this for grasses; cn does
         ! set the mortality rate based on annual rate
         am = 0.02_r8
      end if
#endif
!ylu removed and add
!      m  = am/(get_days_per_year() * 86400._r8)
      m  = am/(day_per_year * 86400._r8)
 
      write(6,*) 'am=',am
      write(6,*) 'day_per_year=',day_per_year
 
      ! pft-level gap mortality carbon fluxes
      ! displayed pools
      m_leafc_to_litter(p)               = leafc(p)               * m
      m_frootc_to_litter(p)              = frootc(p)              * m
      m_livestemc_to_litter(p)           = livestemc(p)           * m
      m_deadstemc_to_litter(p)           = deadstemc(p)           * m
      m_livecrootc_to_litter(p)          = livecrootc(p)          * m
      m_deadcrootc_to_litter(p)          = deadcrootc(p)          * m

      ! storage pools
      m_leafc_storage_to_litter(p)       = leafc_storage(p)       * m
      m_frootc_storage_to_litter(p)      = frootc_storage(p)      * m
      m_livestemc_storage_to_litter(p)   = livestemc_storage(p)   * m
      m_deadstemc_storage_to_litter(p)   = deadstemc_storage(p)   * m
      m_livecrootc_storage_to_litter(p)  = livecrootc_storage(p)  * m
      m_deadcrootc_storage_to_litter(p)  = deadcrootc_storage(p)  * m
      m_gresp_storage_to_litter(p)       = gresp_storage(p)       * m

      ! transfer pools
      m_leafc_xfer_to_litter(p)          = leafc_xfer(p)          * m
      m_frootc_xfer_to_litter(p)         = frootc_xfer(p)         * m
      m_livestemc_xfer_to_litter(p)      = livestemc_xfer(p)      * m
      m_deadstemc_xfer_to_litter(p)      = deadstemc_xfer(p)      * m
      m_livecrootc_xfer_to_litter(p)     = livecrootc_xfer(p)     * m
      m_deadcrootc_xfer_to_litter(p)     = deadcrootc_xfer(p)     * m
      m_gresp_xfer_to_litter(p)          = gresp_xfer(p)          * m

      ! pft-level gap mortality nitrogen fluxes
      ! displayed pools
      m_leafn_to_litter(p)               = leafn(p)               * m
      m_frootn_to_litter(p)              = frootn(p)              * m
      m_livestemn_to_litter(p)           = livestemn(p)           * m
      m_deadstemn_to_litter(p)           = deadstemn(p)           * m
      write(6,*) 'deadstemn(',p,')=',deadstemn(p)
      write(6,*) 'm_deadstemn_to_litter(',p,')=', m_deadstemn_to_litter(p) 
      m_livecrootn_to_litter(p)          = livecrootn(p)          * m
      m_deadcrootn_to_litter(p)          = deadcrootn(p)          * m
      m_retransn_to_litter(p)            = retransn(p)            * m

      ! storage pools
      m_leafn_storage_to_litter(p)       = leafn_storage(p)       * m
      m_frootn_storage_to_litter(p)      = frootn_storage(p)      * m
      m_livestemn_storage_to_litter(p)   = livestemn_storage(p)   * m
      m_deadstemn_storage_to_litter(p)   = deadstemn_storage(p)   * m
      m_livecrootn_storage_to_litter(p)  = livecrootn_storage(p)  * m
      m_deadcrootn_storage_to_litter(p)  = deadcrootn_storage(p)  * m

      ! transfer pools
      m_leafn_xfer_to_litter(p)          = leafn_xfer(p)          * m
      m_frootn_xfer_to_litter(p)         = frootn_xfer(p)         * m
      m_livestemn_xfer_to_litter(p)      = livestemn_xfer(p)      * m
      m_deadstemn_xfer_to_litter(p)      = deadstemn_xfer(p)      * m
      m_livecrootn_xfer_to_litter(p)     = livecrootn_xfer(p)     * m
      m_deadcrootn_xfer_to_litter(p)     = deadcrootn_xfer(p)     * m

   end do ! end of pft loop

   ! gather all pft-level litterfall fluxes to the column
   ! for litter C and N inputs

   call CNGapPftToColumn(num_soilc, filter_soilc)

end subroutine CNGapMortality
!-----------------------------------------------------------------------

!-----------------------------------------------------------------------
!BOP
!
! !IROUTINE: CNGapPftToColumn
!
! !INTERFACE:
subroutine CNGapPftToColumn (num_soilc, filter_soilc)
!
! !DESCRIPTION:
! called in the middle of CNGapMoratlity to gather all pft-level gap mortality fluxes
! to the column level and assign them to the three litter pools
!
! !USES:
  use clmtype
  use clm_varpar, only : maxpatch_pft
!
! !ARGUMENTS:
  implicit none
  integer, intent(in) :: num_soilc       ! number of soil columns in filter
  integer, intent(in) :: filter_soilc(:) ! soil column filter
!
! !CALLED FROM:
! subroutine CNphenology
!
! !REVISION HISTORY:
! 9/8/03: Created by Peter Thornton
!
! !LOCAL VARIABLES:
!
! local pointers to implicit in scalars
   integer , pointer :: ivt(:)      ! pft vegetation type
   real(r8), pointer :: wtcol(:)    ! pft weight relative to column (0-1)
   real(r8), pointer :: pwtgcell(:) ! weight of pft relative to corresponding gridcell
   real(r8), pointer :: lf_flab(:)  ! leaf litter labile fraction
   real(r8), pointer :: lf_fcel(:)  ! leaf litter cellulose fraction
   real(r8), pointer :: lf_flig(:)  ! leaf litter lignin fraction
   real(r8), pointer :: fr_flab(:)  ! fine root litter labile fraction
   real(r8), pointer :: fr_fcel(:)  ! fine root litter cellulose fraction
   real(r8), pointer :: fr_flig(:)  ! fine root litter lignin fraction
   integer , pointer :: npfts(:)    ! number of pfts for each column
   integer , pointer :: pfti(:)     ! beginning pft index for each column
   real(r8), pointer :: m_leafc_to_litter(:)
   real(r8), pointer :: m_frootc_to_litter(:)
   real(r8), pointer :: m_livestemc_to_litter(:)
   real(r8), pointer :: m_deadstemc_to_litter(:)
   real(r8), pointer :: m_livecrootc_to_litter(:)
   real(r8), pointer :: m_deadcrootc_to_litter(:)
   real(r8), pointer :: m_leafc_storage_to_litter(:)
   real(r8), pointer :: m_frootc_storage_to_litter(:)
   real(r8), pointer :: m_livestemc_storage_to_litter(:)
   real(r8), pointer :: m_deadstemc_storage_to_litter(:)
   real(r8), pointer :: m_livecrootc_storage_to_litter(:)
   real(r8), pointer :: m_deadcrootc_storage_to_litter(:)
   real(r8), pointer :: m_gresp_storage_to_litter(:)
   real(r8), pointer :: m_leafc_xfer_to_litter(:)
   real(r8), pointer :: m_frootc_xfer_to_litter(:)
   real(r8), pointer :: m_livestemc_xfer_to_litter(:)
   real(r8), pointer :: m_deadstemc_xfer_to_litter(:)
   real(r8), pointer :: m_livecrootc_xfer_to_litter(:)
   real(r8), pointer :: m_deadcrootc_xfer_to_litter(:)
   real(r8), pointer :: m_gresp_xfer_to_litter(:)
   real(r8), pointer :: m_leafn_to_litter(:)
   real(r8), pointer :: m_frootn_to_litter(:)
   real(r8), pointer :: m_livestemn_to_litter(:)
   real(r8), pointer :: m_deadstemn_to_litter(:)
   real(r8), pointer :: m_livecrootn_to_litter(:)
   real(r8), pointer :: m_deadcrootn_to_litter(:)
   real(r8), pointer :: m_retransn_to_litter(:)
   real(r8), pointer :: m_leafn_storage_to_litter(:)
   real(r8), pointer :: m_frootn_storage_to_litter(:)
   real(r8), pointer :: m_livestemn_storage_to_litter(:)
   real(r8), pointer :: m_deadstemn_storage_to_litter(:)
   real(r8), pointer :: m_livecrootn_storage_to_litter(:)
   real(r8), pointer :: m_deadcrootn_storage_to_litter(:)
   real(r8), pointer :: m_leafn_xfer_to_litter(:)
   real(r8), pointer :: m_frootn_xfer_to_litter(:)
   real(r8), pointer :: m_livestemn_xfer_to_litter(:)
   real(r8), pointer :: m_deadstemn_xfer_to_litter(:)
   real(r8), pointer :: m_livecrootn_xfer_to_litter(:)
   real(r8), pointer :: m_deadcrootn_xfer_to_litter(:)
!
! local pointers to implicit in/out arrays
   real(r8), pointer :: m_leafc_to_litr1c(:)
   real(r8), pointer :: m_leafc_to_litr2c(:)
   real(r8), pointer :: m_leafc_to_litr3c(:)
   real(r8), pointer :: m_frootc_to_litr1c(:)
   real(r8), pointer :: m_frootc_to_litr2c(:)
   real(r8), pointer :: m_frootc_to_litr3c(:)
   real(r8), pointer :: m_livestemc_to_cwdc(:)
   real(r8), pointer :: m_deadstemc_to_cwdc(:)
   real(r8), pointer :: m_livecrootc_to_cwdc(:)
   real(r8), pointer :: m_deadcrootc_to_cwdc(:)
   real(r8), pointer :: m_leafc_storage_to_litr1c(:)
   real(r8), pointer :: m_frootc_storage_to_litr1c(:)
   real(r8), pointer :: m_livestemc_storage_to_litr1c(:)
   real(r8), pointer :: m_deadstemc_storage_to_litr1c(:)
   real(r8), pointer :: m_livecrootc_storage_to_litr1c(:)
   real(r8), pointer :: m_deadcrootc_storage_to_litr1c(:)
   real(r8), pointer :: m_gresp_storage_to_litr1c(:)
   real(r8), pointer :: m_leafc_xfer_to_litr1c(:)
   real(r8), pointer :: m_frootc_xfer_to_litr1c(:)
   real(r8), pointer :: m_livestemc_xfer_to_litr1c(:)
   real(r8), pointer :: m_deadstemc_xfer_to_litr1c(:)
   real(r8), pointer :: m_livecrootc_xfer_to_litr1c(:)
   real(r8), pointer :: m_deadcrootc_xfer_to_litr1c(:)
   real(r8), pointer :: m_gresp_xfer_to_litr1c(:)
   real(r8), pointer :: m_leafn_to_litr1n(:)
   real(r8), pointer :: m_leafn_to_litr2n(:)
   real(r8), pointer :: m_leafn_to_litr3n(:)
   real(r8), pointer :: m_frootn_to_litr1n(:)
   real(r8), pointer :: m_frootn_to_litr2n(:)
   real(r8), pointer :: m_frootn_to_litr3n(:)
   real(r8), pointer :: m_livestemn_to_cwdn(:)
   real(r8), pointer :: m_deadstemn_to_cwdn(:)
   real(r8), pointer :: m_livecrootn_to_cwdn(:)
   real(r8), pointer :: m_deadcrootn_to_cwdn(:)
   real(r8), pointer :: m_retransn_to_litr1n(:)
   real(r8), pointer :: m_leafn_storage_to_litr1n(:)
   real(r8), pointer :: m_frootn_storage_to_litr1n(:)
   real(r8), pointer :: m_livestemn_storage_to_litr1n(:)
   real(r8), pointer :: m_deadstemn_storage_to_litr1n(:)
   real(r8), pointer :: m_livecrootn_storage_to_litr1n(:)
   real(r8), pointer :: m_deadcrootn_storage_to_litr1n(:)
   real(r8), pointer :: m_leafn_xfer_to_litr1n(:)
   real(r8), pointer :: m_frootn_xfer_to_litr1n(:)
   real(r8), pointer :: m_livestemn_xfer_to_litr1n(:)
   real(r8), pointer :: m_deadstemn_xfer_to_litr1n(:)
   real(r8), pointer :: m_livecrootn_xfer_to_litr1n(:)
   real(r8), pointer :: m_deadcrootn_xfer_to_litr1n(:)
!
! local pointers to implicit out arrays
!
!
! !OTHER LOCAL VARIABLES:
   integer :: fc,c,pi,p               ! indices
!EOP
!-----------------------------------------------------------------------

   ! assign local pointers
   lf_flab                        => pftcon%lf_flab
   lf_fcel                        => pftcon%lf_fcel
   lf_flig                        => pftcon%lf_flig
   fr_flab                        => pftcon%fr_flab
   fr_fcel                        => pftcon%fr_fcel
   fr_flig                        => pftcon%fr_flig

   ! assign local pointers to column-level arrays
   npfts                          => clm3%g%l%c%npfts
   pfti                           => clm3%g%l%c%pfti
   m_leafc_to_litr1c              => clm3%g%l%c%ccf%m_leafc_to_litr1c
   m_leafc_to_litr2c              => clm3%g%l%c%ccf%m_leafc_to_litr2c
   m_leafc_to_litr3c              => clm3%g%l%c%ccf%m_leafc_to_litr3c
   m_frootc_to_litr1c             => clm3%g%l%c%ccf%m_frootc_to_litr1c
   m_frootc_to_litr2c             => clm3%g%l%c%ccf%m_frootc_to_litr2c
   m_frootc_to_litr3c             => clm3%g%l%c%ccf%m_frootc_to_litr3c
   m_livestemc_to_cwdc            => clm3%g%l%c%ccf%m_livestemc_to_cwdc
   m_deadstemc_to_cwdc            => clm3%g%l%c%ccf%m_deadstemc_to_cwdc
   m_livecrootc_to_cwdc           => clm3%g%l%c%ccf%m_livecrootc_to_cwdc
   m_deadcrootc_to_cwdc           => clm3%g%l%c%ccf%m_deadcrootc_to_cwdc
   m_leafc_storage_to_litr1c      => clm3%g%l%c%ccf%m_leafc_storage_to_litr1c
   m_frootc_storage_to_litr1c     => clm3%g%l%c%ccf%m_frootc_storage_to_litr1c
   m_livestemc_storage_to_litr1c  => clm3%g%l%c%ccf%m_livestemc_storage_to_litr1c
   m_deadstemc_storage_to_litr1c  => clm3%g%l%c%ccf%m_deadstemc_storage_to_litr1c
   m_livecrootc_storage_to_litr1c => clm3%g%l%c%ccf%m_livecrootc_storage_to_litr1c
   m_deadcrootc_storage_to_litr1c => clm3%g%l%c%ccf%m_deadcrootc_storage_to_litr1c
   m_gresp_storage_to_litr1c      => clm3%g%l%c%ccf%m_gresp_storage_to_litr1c
   m_leafc_xfer_to_litr1c         => clm3%g%l%c%ccf%m_leafc_xfer_to_litr1c
   m_frootc_xfer_to_litr1c        => clm3%g%l%c%ccf%m_frootc_xfer_to_litr1c
   m_livestemc_xfer_to_litr1c     => clm3%g%l%c%ccf%m_livestemc_xfer_to_litr1c
   m_deadstemc_xfer_to_litr1c     => clm3%g%l%c%ccf%m_deadstemc_xfer_to_litr1c
   m_livecrootc_xfer_to_litr1c    => clm3%g%l%c%ccf%m_livecrootc_xfer_to_litr1c
   m_deadcrootc_xfer_to_litr1c    => clm3%g%l%c%ccf%m_deadcrootc_xfer_to_litr1c
   m_gresp_xfer_to_litr1c         => clm3%g%l%c%ccf%m_gresp_xfer_to_litr1c
   m_leafn_to_litr1n              => clm3%g%l%c%cnf%m_leafn_to_litr1n
   m_leafn_to_litr2n              => clm3%g%l%c%cnf%m_leafn_to_litr2n
   m_leafn_to_litr3n              => clm3%g%l%c%cnf%m_leafn_to_litr3n
   m_frootn_to_litr1n             => clm3%g%l%c%cnf%m_frootn_to_litr1n
   m_frootn_to_litr2n             => clm3%g%l%c%cnf%m_frootn_to_litr2n
   m_frootn_to_litr3n             => clm3%g%l%c%cnf%m_frootn_to_litr3n
   m_livestemn_to_cwdn            => clm3%g%l%c%cnf%m_livestemn_to_cwdn
   m_deadstemn_to_cwdn            => clm3%g%l%c%cnf%m_deadstemn_to_cwdn
   m_livecrootn_to_cwdn           => clm3%g%l%c%cnf%m_livecrootn_to_cwdn
   m_deadcrootn_to_cwdn           => clm3%g%l%c%cnf%m_deadcrootn_to_cwdn
   m_retransn_to_litr1n           => clm3%g%l%c%cnf%m_retransn_to_litr1n
   m_leafn_storage_to_litr1n      => clm3%g%l%c%cnf%m_leafn_storage_to_litr1n
   m_frootn_storage_to_litr1n     => clm3%g%l%c%cnf%m_frootn_storage_to_litr1n
   m_livestemn_storage_to_litr1n  => clm3%g%l%c%cnf%m_livestemn_storage_to_litr1n
   m_deadstemn_storage_to_litr1n  => clm3%g%l%c%cnf%m_deadstemn_storage_to_litr1n
   m_livecrootn_storage_to_litr1n => clm3%g%l%c%cnf%m_livecrootn_storage_to_litr1n
   m_deadcrootn_storage_to_litr1n => clm3%g%l%c%cnf%m_deadcrootn_storage_to_litr1n
   m_leafn_xfer_to_litr1n         => clm3%g%l%c%cnf%m_leafn_xfer_to_litr1n
   m_frootn_xfer_to_litr1n        => clm3%g%l%c%cnf%m_frootn_xfer_to_litr1n
   m_livestemn_xfer_to_litr1n     => clm3%g%l%c%cnf%m_livestemn_xfer_to_litr1n
   m_deadstemn_xfer_to_litr1n     => clm3%g%l%c%cnf%m_deadstemn_xfer_to_litr1n
   m_livecrootn_xfer_to_litr1n    => clm3%g%l%c%cnf%m_livecrootn_xfer_to_litr1n
   m_deadcrootn_xfer_to_litr1n    => clm3%g%l%c%cnf%m_deadcrootn_xfer_to_litr1n

   ! assign local pointers to pft-level arrays
   ivt                            => clm3%g%l%c%p%itype
   wtcol                          => clm3%g%l%c%p%wtcol
   pwtgcell                       => clm3%g%l%c%p%wtgcell  
   m_leafc_to_litter              => clm3%g%l%c%p%pcf%m_leafc_to_litter
   m_frootc_to_litter             => clm3%g%l%c%p%pcf%m_frootc_to_litter
   m_livestemc_to_litter          => clm3%g%l%c%p%pcf%m_livestemc_to_litter
   m_deadstemc_to_litter          => clm3%g%l%c%p%pcf%m_deadstemc_to_litter
   m_livecrootc_to_litter         => clm3%g%l%c%p%pcf%m_livecrootc_to_litter
   m_deadcrootc_to_litter         => clm3%g%l%c%p%pcf%m_deadcrootc_to_litter
   m_leafc_storage_to_litter      => clm3%g%l%c%p%pcf%m_leafc_storage_to_litter
   m_frootc_storage_to_litter     => clm3%g%l%c%p%pcf%m_frootc_storage_to_litter
   m_livestemc_storage_to_litter  => clm3%g%l%c%p%pcf%m_livestemc_storage_to_litter
   m_deadstemc_storage_to_litter  => clm3%g%l%c%p%pcf%m_deadstemc_storage_to_litter
   m_livecrootc_storage_to_litter => clm3%g%l%c%p%pcf%m_livecrootc_storage_to_litter
   m_deadcrootc_storage_to_litter => clm3%g%l%c%p%pcf%m_deadcrootc_storage_to_litter
   m_gresp_storage_to_litter      => clm3%g%l%c%p%pcf%m_gresp_storage_to_litter
   m_leafc_xfer_to_litter         => clm3%g%l%c%p%pcf%m_leafc_xfer_to_litter
   m_frootc_xfer_to_litter        => clm3%g%l%c%p%pcf%m_frootc_xfer_to_litter
   m_livestemc_xfer_to_litter     => clm3%g%l%c%p%pcf%m_livestemc_xfer_to_litter
   m_deadstemc_xfer_to_litter     => clm3%g%l%c%p%pcf%m_deadstemc_xfer_to_litter
   m_livecrootc_xfer_to_litter    => clm3%g%l%c%p%pcf%m_livecrootc_xfer_to_litter
   m_deadcrootc_xfer_to_litter    => clm3%g%l%c%p%pcf%m_deadcrootc_xfer_to_litter
   m_gresp_xfer_to_litter         => clm3%g%l%c%p%pcf%m_gresp_xfer_to_litter
   m_leafn_to_litter              => clm3%g%l%c%p%pnf%m_leafn_to_litter
   m_frootn_to_litter             => clm3%g%l%c%p%pnf%m_frootn_to_litter
   m_livestemn_to_litter          => clm3%g%l%c%p%pnf%m_livestemn_to_litter
   m_deadstemn_to_litter          => clm3%g%l%c%p%pnf%m_deadstemn_to_litter
   m_livecrootn_to_litter         => clm3%g%l%c%p%pnf%m_livecrootn_to_litter
   m_deadcrootn_to_litter         => clm3%g%l%c%p%pnf%m_deadcrootn_to_litter
   m_retransn_to_litter           => clm3%g%l%c%p%pnf%m_retransn_to_litter
   m_leafn_storage_to_litter      => clm3%g%l%c%p%pnf%m_leafn_storage_to_litter
   m_frootn_storage_to_litter     => clm3%g%l%c%p%pnf%m_frootn_storage_to_litter
   m_livestemn_storage_to_litter  => clm3%g%l%c%p%pnf%m_livestemn_storage_to_litter
   m_deadstemn_storage_to_litter  => clm3%g%l%c%p%pnf%m_deadstemn_storage_to_litter
   m_livecrootn_storage_to_litter => clm3%g%l%c%p%pnf%m_livecrootn_storage_to_litter
   m_deadcrootn_storage_to_litter => clm3%g%l%c%p%pnf%m_deadcrootn_storage_to_litter
   m_leafn_xfer_to_litter         => clm3%g%l%c%p%pnf%m_leafn_xfer_to_litter
   m_frootn_xfer_to_litter        => clm3%g%l%c%p%pnf%m_frootn_xfer_to_litter
   m_livestemn_xfer_to_litter     => clm3%g%l%c%p%pnf%m_livestemn_xfer_to_litter
   m_deadstemn_xfer_to_litter     => clm3%g%l%c%p%pnf%m_deadstemn_xfer_to_litter
   m_livecrootn_xfer_to_litter    => clm3%g%l%c%p%pnf%m_livecrootn_xfer_to_litter
   m_deadcrootn_xfer_to_litter    => clm3%g%l%c%p%pnf%m_deadcrootn_xfer_to_litter

   do pi = 1,maxpatch_pft
      do fc = 1,num_soilc
         c = filter_soilc(fc)

         if (pi <=  npfts(c)) then
            p = pfti(c) + pi - 1

            if (pwtgcell(p)>0._r8) then

               ! leaf gap mortality carbon fluxes
               m_leafc_to_litr1c(c) = m_leafc_to_litr1c(c) + &
                  m_leafc_to_litter(p) * lf_flab(ivt(p)) * wtcol(p)
               m_leafc_to_litr2c(c) = m_leafc_to_litr2c(c) + &
                  m_leafc_to_litter(p) * lf_fcel(ivt(p)) * wtcol(p)
               m_leafc_to_litr3c(c) = m_leafc_to_litr3c(c) + &
                  m_leafc_to_litter(p) * lf_flig(ivt(p)) * wtcol(p)

               ! fine root gap mortality carbon fluxes
               m_frootc_to_litr1c(c) = m_frootc_to_litr1c(c) + &
                  m_frootc_to_litter(p) * fr_flab(ivt(p)) * wtcol(p)
               m_frootc_to_litr2c(c) = m_frootc_to_litr2c(c) + &
                  m_frootc_to_litter(p) * fr_fcel(ivt(p)) * wtcol(p)
               m_frootc_to_litr3c(c) = m_frootc_to_litr3c(c) + &
                  m_frootc_to_litter(p) * fr_flig(ivt(p)) * wtcol(p)

               ! wood gap mortality carbon fluxes
               m_livestemc_to_cwdc(c)  = m_livestemc_to_cwdc(c)  + &
                  m_livestemc_to_litter(p)  * wtcol(p)
               m_deadstemc_to_cwdc(c)  = m_deadstemc_to_cwdc(c)  + &
                  m_deadstemc_to_litter(p)  * wtcol(p)
               m_livecrootc_to_cwdc(c) = m_livecrootc_to_cwdc(c) + &
                  m_livecrootc_to_litter(p) * wtcol(p)
               m_deadcrootc_to_cwdc(c) = m_deadcrootc_to_cwdc(c) + &
                  m_deadcrootc_to_litter(p) * wtcol(p)

               ! storage gap mortality carbon fluxes
               m_leafc_storage_to_litr1c(c)      = m_leafc_storage_to_litr1c(c)      + &
                  m_leafc_storage_to_litter(p)      * wtcol(p)
               m_frootc_storage_to_litr1c(c)     = m_frootc_storage_to_litr1c(c)     + &
                  m_frootc_storage_to_litter(p)     * wtcol(p)
               m_livestemc_storage_to_litr1c(c)  = m_livestemc_storage_to_litr1c(c)  + &
                  m_livestemc_storage_to_litter(p)  * wtcol(p)
               m_deadstemc_storage_to_litr1c(c)  = m_deadstemc_storage_to_litr1c(c)  + &
                  m_deadstemc_storage_to_litter(p)  * wtcol(p)
               m_livecrootc_storage_to_litr1c(c) = m_livecrootc_storage_to_litr1c(c) + &
                  m_livecrootc_storage_to_litter(p) * wtcol(p)
               m_deadcrootc_storage_to_litr1c(c) = m_deadcrootc_storage_to_litr1c(c) + &
                  m_deadcrootc_storage_to_litter(p) * wtcol(p)
               m_gresp_storage_to_litr1c(c)      = m_gresp_storage_to_litr1c(c)      + &
                  m_gresp_storage_to_litter(p)      * wtcol(p)

               ! transfer gap mortality carbon fluxes
               m_leafc_xfer_to_litr1c(c)      = m_leafc_xfer_to_litr1c(c)      + &
                  m_leafc_xfer_to_litter(p)      * wtcol(p)
               m_frootc_xfer_to_litr1c(c)     = m_frootc_xfer_to_litr1c(c)     + &
                  m_frootc_xfer_to_litter(p)     * wtcol(p)
               m_livestemc_xfer_to_litr1c(c)  = m_livestemc_xfer_to_litr1c(c)  + &
                  m_livestemc_xfer_to_litter(p)  * wtcol(p)
               m_deadstemc_xfer_to_litr1c(c)  = m_deadstemc_xfer_to_litr1c(c)  + &
                  m_deadstemc_xfer_to_litter(p)  * wtcol(p)
               m_livecrootc_xfer_to_litr1c(c) = m_livecrootc_xfer_to_litr1c(c) + &
                  m_livecrootc_xfer_to_litter(p) * wtcol(p)
               m_deadcrootc_xfer_to_litr1c(c) = m_deadcrootc_xfer_to_litr1c(c) + &
                  m_deadcrootc_xfer_to_litter(p) * wtcol(p)
               m_gresp_xfer_to_litr1c(c)      = m_gresp_xfer_to_litr1c(c)      + &
                  m_gresp_xfer_to_litter(p)      * wtcol(p)

               ! leaf gap mortality nitrogen fluxes
               m_leafn_to_litr1n(c) = m_leafn_to_litr1n(c) + &
                  m_leafn_to_litter(p) * lf_flab(ivt(p)) * wtcol(p)
               m_leafn_to_litr2n(c) = m_leafn_to_litr2n(c) + &
                  m_leafn_to_litter(p) * lf_fcel(ivt(p)) * wtcol(p)
               m_leafn_to_litr3n(c) = m_leafn_to_litr3n(c) + &
                  m_leafn_to_litter(p) * lf_flig(ivt(p)) * wtcol(p)

               ! fine root litter nitrogen fluxes
               m_frootn_to_litr1n(c) = m_frootn_to_litr1n(c) + &
                  m_frootn_to_litter(p) * fr_flab(ivt(p)) * wtcol(p)
               m_frootn_to_litr2n(c) = m_frootn_to_litr2n(c) + &
                  m_frootn_to_litter(p) * fr_fcel(ivt(p)) * wtcol(p)
               m_frootn_to_litr3n(c) = m_frootn_to_litr3n(c) + &
                  m_frootn_to_litter(p) * fr_flig(ivt(p)) * wtcol(p)

               ! wood gap mortality nitrogen fluxes
               m_livestemn_to_cwdn(c)  = m_livestemn_to_cwdn(c)  + &
                  m_livestemn_to_litter(p)  * wtcol(p)
               m_deadstemn_to_cwdn(c)  = m_deadstemn_to_cwdn(c)  + &
                  m_deadstemn_to_litter(p)  * wtcol(p)
               m_livecrootn_to_cwdn(c) = m_livecrootn_to_cwdn(c) + &
                  m_livecrootn_to_litter(p) * wtcol(p)
               m_deadcrootn_to_cwdn(c) = m_deadcrootn_to_cwdn(c) + &
                  m_deadcrootn_to_litter(p) * wtcol(p)

               ! retranslocated N pool gap mortality fluxes
               m_retransn_to_litr1n(c) = m_retransn_to_litr1n(c) + &
                  m_retransn_to_litter(p) * wtcol(p)

               ! storage gap mortality nitrogen fluxes
               m_leafn_storage_to_litr1n(c)      = m_leafn_storage_to_litr1n(c)      + &
                  m_leafn_storage_to_litter(p)      * wtcol(p)
               m_frootn_storage_to_litr1n(c)     = m_frootn_storage_to_litr1n(c)     + &
                  m_frootn_storage_to_litter(p)     * wtcol(p)
               m_livestemn_storage_to_litr1n(c)  = m_livestemn_storage_to_litr1n(c)  + &
                  m_livestemn_storage_to_litter(p)  * wtcol(p)
               m_deadstemn_storage_to_litr1n(c)  = m_deadstemn_storage_to_litr1n(c)  + &
                  m_deadstemn_storage_to_litter(p)  * wtcol(p)
               m_livecrootn_storage_to_litr1n(c) = m_livecrootn_storage_to_litr1n(c) + &
                  m_livecrootn_storage_to_litter(p) * wtcol(p)
               m_deadcrootn_storage_to_litr1n(c) = m_deadcrootn_storage_to_litr1n(c) + &
                  m_deadcrootn_storage_to_litter(p) * wtcol(p)

               ! transfer gap mortality nitrogen fluxes
               m_leafn_xfer_to_litr1n(c)      = m_leafn_xfer_to_litr1n(c)      + &
                  m_leafn_xfer_to_litter(p)      * wtcol(p)
               m_frootn_xfer_to_litr1n(c)     = m_frootn_xfer_to_litr1n(c)     + &
                  m_frootn_xfer_to_litter(p)     * wtcol(p)
               m_livestemn_xfer_to_litr1n(c)  = m_livestemn_xfer_to_litr1n(c)  + &
                  m_livestemn_xfer_to_litter(p)  * wtcol(p)
               m_deadstemn_xfer_to_litr1n(c)  = m_deadstemn_xfer_to_litr1n(c)  + &
                  m_deadstemn_xfer_to_litter(p)  * wtcol(p)
               m_livecrootn_xfer_to_litr1n(c) = m_livecrootn_xfer_to_litr1n(c) + &
                  m_livecrootn_xfer_to_litter(p) * wtcol(p)
               m_deadcrootn_xfer_to_litr1n(c) = m_deadcrootn_xfer_to_litr1n(c) + &
                  m_deadcrootn_xfer_to_litter(p) * wtcol(p)

            end if
         end if

      end do

   end do

end subroutine CNGapPftToColumn
!-----------------------------------------------------------------------

#endif

end module CNGapMortalityMod
module CNMRespMod
#ifdef CN

!-----------------------------------------------------------------------
!BOP
!
! !MODULE: CNMRespMod
!
! !DESCRIPTION:
! Module holding maintenance respiration routines for coupled carbon
! nitrogen code.
!
! !USES:
   use shr_kind_mod , only: r8 => shr_kind_r8
   use clm_varpar   , only: nlevgrnd
   use shr_const_mod, only: SHR_CONST_TKFRZ
   implicit none
   save
   private
! !PUBLIC MEMBER FUNCTIONS:
   public :: CNMResp
!
! !REVISION HISTORY:
! 8/14/03: Created by Peter Thornton
! 10/23/03, Peter Thornton: Migrated all subroutines to vector data structures.
!
!EOP
!-----------------------------------------------------------------------

contains

!-----------------------------------------------------------------------
!BOP
!
! !IROUTINE: CNMResp
!
! !INTERFACE:
subroutine CNMResp(lbc, ubc, num_soilc, filter_soilc, num_soilp, filter_soilp)
!
! !DESCRIPTION:
!
! !USES:
   use clmtype
!
! !ARGUMENTS:
   implicit none
   integer, intent(in) :: lbc, ubc                    ! column-index bounds
   integer, intent(in) :: num_soilc                 ! number of soil points in column filter
   integer, intent(in) :: filter_soilc(:)   ! column filter for soil points
   integer, intent(in) :: num_soilp                 ! number of soil points in pft filter
   integer, intent(in) :: filter_soilp(:)   ! pft filter for soil points
!
! !CALLED FROM:
! subroutine CNEcosystemDyn in module CNEcosystemDynMod.F90
!
! !REVISION HISTORY:
! 8/14/03: Created by Peter Thornton
!
! !LOCAL VARIABLES:
! local pointers to implicit in arrays
!
   ! column level
   real(r8), pointer :: t_soisno(:,:) ! soil temperature (Kelvin)  (-nlevsno+1:nlevgrnd)
   ! pft level
   real(r8), pointer :: t_ref2m(:)    ! 2 m height surface air temperature (Kelvin)
   real(r8), pointer :: leafn(:)      ! (kgN/m2) leaf N
   real(r8), pointer :: frootn(:)     ! (kgN/m2) fine root N
   real(r8), pointer :: livestemn(:)  ! (kgN/m2) live stem N
   real(r8), pointer :: livecrootn(:) ! (kgN/m2) live coarse root N
   real(r8), pointer :: rootfr(:,:)   ! fraction of roots in each soil layer  (nlevgrnd)
   integer , pointer :: ivt(:)        ! pft vegetation type
   integer , pointer :: pcolumn(:)    ! index into column level quantities
   integer , pointer :: plandunit(:)  ! index into landunit level quantities
   integer , pointer :: clandunit(:)  ! index into landunit level quantities
   integer , pointer :: itypelun(:)   ! landunit type
   ! ecophysiological constants
   real(r8), pointer :: woody(:)      ! binary flag for woody lifeform (1=woody, 0=not woody)
!
! local pointers to implicit in/out arrays
!
   ! pft level
   real(r8), pointer :: leaf_mr(:)
   real(r8), pointer :: froot_mr(:)
   real(r8), pointer :: livestem_mr(:)
   real(r8), pointer :: livecroot_mr(:)
!
! !OTHER LOCAL VARIABLES:
   integer :: c,p,j          ! indices
   integer :: fp             ! soil filter pft index
   integer :: fc             ! soil filter column index
   real(r8):: mr             ! maintenance respiration (gC/m2/s)
   real(r8):: br             ! base rate (gC/gN/s)
   real(r8):: q10            ! temperature dependence
   real(r8):: tc             ! temperature correction, 2m air temp (unitless)
   real(r8):: tcsoi(lbc:ubc,nlevgrnd) ! temperature correction by soil layer (unitless)
!EOP
!-----------------------------------------------------------------------
   ! Assign local pointers to derived type arrays
   t_soisno       => clm3%g%l%c%ces%t_soisno
   t_ref2m        => clm3%g%l%c%p%pes%t_ref2m
   leafn          => clm3%g%l%c%p%pns%leafn
   frootn         => clm3%g%l%c%p%pns%frootn
   livestemn      => clm3%g%l%c%p%pns%livestemn
   livecrootn     => clm3%g%l%c%p%pns%livecrootn
   rootfr         => clm3%g%l%c%p%pps%rootfr
   leaf_mr        => clm3%g%l%c%p%pcf%leaf_mr
   froot_mr       => clm3%g%l%c%p%pcf%froot_mr
   livestem_mr    => clm3%g%l%c%p%pcf%livestem_mr
   livecroot_mr   => clm3%g%l%c%p%pcf%livecroot_mr
   ivt            => clm3%g%l%c%p%itype
   pcolumn        => clm3%g%l%c%p%column
   plandunit      => clm3%g%l%c%p%landunit
   clandunit      => clm3%g%l%c%landunit
   itypelun       => clm3%g%l%itype
   woody          => pftcon%woody

   ! base rate for maintenance respiration is from:
   ! M. Ryan, 1991. Effects of climate change on plant respiration.
   ! Ecological Applications, 1(2), 157-167.
   ! Original expression is br = 0.0106 molC/(molN h)
   ! Conversion by molecular weights of C and N gives 2.525e-6 gC/(gN s)
   br = 2.525e-6_r8
   ! Peter Thornton: 3/13/09 
   ! Q10 was originally set to 2.0, an arbitrary choice, but reduced to 1.5 as part of the tuning
   ! to improve seasonal cycle of atmospheric CO2 concentration in global
   ! simulatoins
   q10 = 1.5_r8

   ! column loop to calculate temperature factors in each soil layer
   do j=1,nlevgrnd
!dir$ concurrent
!cdir nodep
      do fc = 1, num_soilc
         c = filter_soilc(fc)

         ! calculate temperature corrections for each soil layer, for use in
         ! estimating fine root maintenance respiration with depth

         tcsoi(c,j) = q10**((t_soisno(c,j)-SHR_CONST_TKFRZ - 20.0_r8)/10.0_r8)
      end do
   end do

   ! pft loop for leaves and live wood
!dir$ concurrent
!cdir nodep
   do fp = 1, num_soilp
      p = filter_soilp(fp)

      ! calculate maintenance respiration fluxes in
      ! gC/m2/s for each of the live plant tissues.
      ! Leaf and live wood MR

      tc = q10**((t_ref2m(p)-SHR_CONST_TKFRZ - 20.0_r8)/10.0_r8)
      leaf_mr(p) = leafn(p)*br*tc
      write(6,*) 'check leaf_mr in CNMRespMod'
      write(6,*) 'leafn(',p,')=',leafn(p)
      write(6,*) 'tc=',tc
      write(6,*) 'q10=',q10
      write(6,*) 't_ref2m(',p,')=',t_ref2m(p)

      if (woody(ivt(p)) == 1) then
         livestem_mr(p) = livestemn(p)*br*tc
         livecroot_mr(p) = livecrootn(p)*br*tc
      end if
   end do

   ! soil and pft loop for fine root
   do j = 1,nlevgrnd
!dir$ concurrent
!cdir nodep
      do fp = 1,num_soilp
         p = filter_soilp(fp)
         c = pcolumn(p)

         ! Fine root MR
         ! rootfr(j) sums to 1.0 over all soil layers, and
         ! describes the fraction of root mass that is in each
         ! layer.  This is used with the layer temperature correction
         ! to estimate the total fine root maintenance respiration as a
         ! function of temperature and N content.

         froot_mr(p) = froot_mr(p) + frootn(p)*br*tcsoi(c,j)*rootfr(p,j)
      end do
   end do

end subroutine CNMResp

#endif

end module CNMRespMod
module CNNDynamicsMod
#ifdef CN

!-----------------------------------------------------------------------
!BOP
!
! !MODULE: CNNDynamicsMod
!
! !DESCRIPTION:
! Module for mineral nitrogen dynamics (deposition, fixation, leaching)
! for coupled carbon-nitrogen code.
!
! !USES:
   use shr_kind_mod, only: r8 => shr_kind_r8
   implicit none
   save
   private
! !PUBLIC MEMBER FUNCTIONS:
   public :: CNNDeposition
   public :: CNNFixation
   public :: CNNLeaching
!
! !REVISION HISTORY:
! 6/1/04: Created by Peter Thornton
!
!EOP
!-----------------------------------------------------------------------

contains

!-----------------------------------------------------------------------
!BOP
!
! !IROUTINE: CNNDeposition
!
! !INTERFACE:
subroutine CNNDeposition( lbc, ubc )
!
! !DESCRIPTION:
! On the radiation time step, update the nitrogen deposition rate
! from atmospheric forcing. For now it is assumed that all the atmospheric
! N deposition goes to the soil mineral N pool.
! This could be updated later to divide the inputs between mineral N absorbed
! directly into the canopy and mineral N entering the soil pool.
!
! !USES:
   use clmtype

! ylu removed  use clm_atmlnd   , only : clm_a2l
!
! !ARGUMENTS:
   implicit none
   integer, intent(in) :: lbc, ubc        ! column bounds
!
! !CALLED FROM:
! subroutine CNEcosystemDyn, in module CNEcosystemDynMod.F90
!
! !REVISION HISTORY:
! 6/1/04: Created by Peter Thornton
! 11/06/09: Copy to all columns NOT just over soil. S. Levis
!
! !LOCAL VARIABLES:
! local pointers to implicit in scalars
!
   real(r8), pointer :: forc_ndep(:)  ! nitrogen deposition rate (gN/m2/s)
   integer , pointer :: gridcell(:)   ! index into gridcell level quantities
!
! local pointers to implicit out scalars
!
   real(r8), pointer :: ndep_to_sminn(:)
!
! !OTHER LOCAL VARIABLES:
   integer :: g,c                    ! indices

!EOP
!-----------------------------------------------------------------------
   ! Assign local pointers to derived type arrays (in)
!TODO_ylu:
   forc_ndep     => clm_a2l%forc_ndep
   gridcell      => clm3%g%l%c%gridcell

   ! Assign local pointers to derived type arrays (out)
   ndep_to_sminn => clm3%g%l%c%cnf%ndep_to_sminn

   ! Loop through columns
   do c = lbc, ubc
      g = gridcell(c)

      ndep_to_sminn(c) = forc_ndep(g)
      
   end do

end subroutine CNNDeposition

!-----------------------------------------------------------------------
!BOP
!
! !IROUTINE: CNNFixation
!
! !INTERFACE:
subroutine CNNFixation(num_soilc, filter_soilc)
!
! !DESCRIPTION:
! On the radiation time step, update the nitrogen fixation rate
! as a function of annual total NPP. This rate gets updated once per year.
! All N fixation goes to the soil mineral N pool.
!
! !USES:
   use clmtype
!ylu remove, seems not been used
!   use clm_varctl, only: iulog
!   use shr_sys_mod, only: shr_sys_flush
!
! !ARGUMENTS:
   implicit none
   integer, intent(in) :: num_soilc       ! number of soil columns in filter
   integer, intent(in) :: filter_soilc(:) ! filter for soil columns
!
! !CALLED FROM:
! subroutine CNEcosystemDyn, in module CNEcosystemDynMod.F90
!
! !REVISION HISTORY:
! 6/1/04: Created by Peter Thornton
! 2/14/05, PET: After looking at a number of point simulations,
!               it looks like a constant Nfix might be more efficient and 
!               maybe more realistic - setting to constant 0.4 gN/m2/yr.
!
! !LOCAL VARIABLES:
! local pointers to implicit in scalars
!
   real(r8), pointer :: cannsum_npp(:) ! nitrogen deposition rate (gN/m2/s)
!
! local pointers to implicit out scalars
!
   real(r8), pointer :: nfix_to_sminn(:)
!
! !OTHER LOCAL VARIABLES:
   integer  :: c,fc                  ! indices
   real(r8) :: t                     ! temporary

!EOP
!-----------------------------------------------------------------------
   ! Assign local pointers to derived type arrays (in)
   cannsum_npp   => clm3%g%l%c%cps%cannsum_npp

   ! Assign local pointers to derived type arrays (out)
   nfix_to_sminn => clm3%g%l%c%cnf%nfix_to_sminn

   ! Loop through columns
   do fc = 1,num_soilc
      c = filter_soilc(fc)

      ! the value 0.001666 is set to give 100 TgN/yr when global
      ! NPP = 60 PgC/yr.  (Cleveland et al., 1999)
      ! Convert from gN/m2/yr -> gN/m2/s
      !t = cannsum_npp(c) * 0.001666_r8 / (86400._r8 * 365._r8)
      t = (1.8_r8 * (1._r8 - exp(-0.003_r8 * cannsum_npp(c))))/(86400._r8 * 365._r8)
      nfix_to_sminn(c) = max(0._r8,t)
      ! PET 2/14/05: commenting out the dependence on NPP, and
      ! forcing Nfix to global constant = 0.4 gN/m2/yr
      !nfix_to_sminn(c) = 0.4 / (86400._r8*365._r8)

   end do

end subroutine CNNFixation

!-----------------------------------------------------------------------
!BOP
!
! !IROUTINE: CNNLeaching
!
! !INTERFACE:
subroutine CNNLeaching(lbc, ubc, num_soilc, filter_soilc)
!
! !DESCRIPTION:
! On the radiation time step, update the nitrogen leaching rate
! as a function of soluble mineral N and total soil water outflow.
!
! !USES:
   use clmtype
   use clm_varpar      , only : nlevsoi
!ylu removed
!   use clm_time_manager    , only : get_step_size
    use globals, only : dt
!
! !ARGUMENTS:
   implicit none
   integer, intent(in) :: lbc, ubc        ! column bounds
   integer, intent(in) :: num_soilc       ! number of soil columns in filter
   integer, intent(in) :: filter_soilc(:) ! filter for soil columns
!
! !CALLED FROM:
! subroutine CNEcosystemDyn
!
! !REVISION HISTORY:
! 6/9/04: Created by Peter Thornton
!
! !LOCAL VARIABLES:
! local pointers to implicit in scalars
!
   real(r8), pointer :: h2osoi_liq(:,:)  ! liquid water (kg/m2) (new) (-nlevsno+1:nlevgrnd)
   real(r8), pointer :: qflx_drain(:)    ! sub-surface runoff (mm H2O /s)
   real(r8), pointer :: sminn(:)         ! (gN/m2) soil mineral N
!
! local pointers to implicit out scalars
!
   real(r8), pointer :: sminn_leached(:) ! rate of mineral N leaching (gN/m2/s)
!
! !OTHER LOCAL VARIABLES:
   integer  :: j,c,fc             ! indices
!ylu removed 10-22-10
!   real(r8) :: dt                 ! radiation time step (seconds)
   real(r8) :: tot_water(lbc:ubc) ! total column liquid water (kg water/m2)
   real(r8) :: sf                 ! soluble fraction of mineral N (unitless)
   real(r8) :: disn_conc          ! dissolved mineral N concentration
                                  ! (gN/kg water)

!EOP
!-----------------------------------------------------------------------
   ! Assign local pointers to derived type arrays (in)
   h2osoi_liq    => clm3%g%l%c%cws%h2osoi_liq
   qflx_drain    => clm3%g%l%c%cwf%qflx_drain
   sminn         => clm3%g%l%c%cns%sminn

   ! Assign local pointers to derived type arrays (out)
   sminn_leached => clm3%g%l%c%cnf%sminn_leached

   ! set time steps
!ylu removed
!  dt = real( get_step_size(), r8 )

   ! Assume that 10% of the soil mineral N is in a soluble form
   sf = 0.1_r8

   ! calculate the total soil water
   tot_water(lbc:ubc) = 0._r8
   do j = 1,nlevsoi
      do fc = 1,num_soilc
         c = filter_soilc(fc)
         tot_water(c) = tot_water(c) + h2osoi_liq(c,j)
      end do
   end do

   ! Loop through columns
   do fc = 1,num_soilc
      c = filter_soilc(fc)

      ! calculate the dissolved mineral N concentration (gN/kg water)
      ! assumes that 10% of mineral nitrogen is soluble
      disn_conc = 0._r8
      if (tot_water(c) > 0._r8) then
         disn_conc = (sf * sminn(c))/tot_water(c)
      end if

      ! calculate the N leaching flux as a function of the dissolved
      ! concentration and the sub-surface drainage flux
      sminn_leached(c) = disn_conc * qflx_drain(c)

      ! limit the flux based on current sminn state
      ! only let at most the assumed soluble fraction
      ! of sminn be leached on any given timestep
      sminn_leached(c) = min(sminn_leached(c), (sf * sminn(c))/dt)
      
      ! limit the flux to a positive value
      sminn_leached(c) = max(sminn_leached(c), 0._r8)

   end do

end subroutine CNNLeaching

#endif

end module CNNDynamicsMod
module CNNStateUpdate1Mod
#ifdef CN

!-----------------------------------------------------------------------
!BOP
!
! !MODULE: NStateUpdate1Mod
!
! !DESCRIPTION:
! Module for nitrogen state variable updates, non-mortality fluxes.
!
! !USES:
    use shr_kind_mod, only: r8 => shr_kind_r8
    implicit none
    save
    private
! !PUBLIC MEMBER FUNCTIONS:
    public:: NStateUpdate1
!
! !REVISION HISTORY:
! 4/23/2004: Created by Peter Thornton
!
!EOP
!-----------------------------------------------------------------------

contains

!-----------------------------------------------------------------------
!BOP
!
! !IROUTINE: NStateUpdate1
!
! !INTERFACE:
subroutine NStateUpdate1(num_soilc, filter_soilc, num_soilp, filter_soilp)
!
! !DESCRIPTION:
! On the radiation time step, update all the prognostic nitrogen state
! variables (except for gap-phase mortality and fire fluxes)
!
! !USES:
   use clmtype
!   use clm_time_manager, only: get_step_size
 use globals, only: dt
#if (defined CROP)
   use pftvarcon , only: npcropmin
#endif
!
! !ARGUMENTS:
   implicit none
   integer, intent(in) :: num_soilc       ! number of soil columns in filter
   integer, intent(in) :: filter_soilc(:) ! filter for soil columns
   integer, intent(in) :: num_soilp       ! number of soil pfts in filter
   integer, intent(in) :: filter_soilp(:) ! filter for soil pfts
!
! !CALLED FROM:
! subroutine CNEcosystemDyn
!
! !REVISION HISTORY:
! 8/1/03: Created by Peter Thornton
!
! !LOCAL VARIABLES:
! local pointers to implicit in scalars
!
   integer , pointer :: ivt(:)         ! pft vegetation type
   real(r8), pointer :: woody(:)       ! binary flag for woody lifeform (1=woody, 0=not woody)
   real(r8), pointer :: cwdn_to_litr2n(:)
   real(r8), pointer :: cwdn_to_litr3n(:)
#if (defined CROP)
   real(r8), pointer :: grainn_to_litr1n(:)
   real(r8), pointer :: grainn_to_litr2n(:)
   real(r8), pointer :: grainn_to_litr3n(:)
   real(r8), pointer :: livestemn_to_litr1n(:)
   real(r8), pointer :: livestemn_to_litr2n(:)
   real(r8), pointer :: livestemn_to_litr3n(:)
#endif
   real(r8), pointer :: frootn_to_litr1n(:)
   real(r8), pointer :: frootn_to_litr2n(:)
   real(r8), pointer :: frootn_to_litr3n(:)
   real(r8), pointer :: leafn_to_litr1n(:)
   real(r8), pointer :: leafn_to_litr2n(:)
   real(r8), pointer :: leafn_to_litr3n(:)
   real(r8), pointer :: litr1n_to_soil1n(:)
   real(r8), pointer :: litr2n_to_soil2n(:)
   real(r8), pointer :: litr3n_to_soil3n(:)
   real(r8), pointer :: ndep_to_sminn(:)
   real(r8), pointer :: nfix_to_sminn(:)
   real(r8), pointer :: sminn_to_denit_excess(:)
   real(r8), pointer :: sminn_to_denit_l1s1(:)
   real(r8), pointer :: sminn_to_denit_l2s2(:)
   real(r8), pointer :: sminn_to_denit_l3s3(:)
   real(r8), pointer :: sminn_to_denit_s1s2(:)
   real(r8), pointer :: sminn_to_denit_s2s3(:)
   real(r8), pointer :: sminn_to_denit_s3s4(:)
   real(r8), pointer :: sminn_to_denit_s4(:)
   real(r8), pointer :: sminn_to_plant(:)
   real(r8), pointer :: sminn_to_soil1n_l1(:)
   real(r8), pointer :: sminn_to_soil2n_l2(:)
   real(r8), pointer :: sminn_to_soil2n_s1(:)
   real(r8), pointer :: sminn_to_soil3n_l3(:)
   real(r8), pointer :: sminn_to_soil3n_s2(:)
   real(r8), pointer :: sminn_to_soil4n_s3(:)
   real(r8), pointer :: soil1n_to_soil2n(:)
   real(r8), pointer :: soil2n_to_soil3n(:)
   real(r8), pointer :: soil3n_to_soil4n(:)
   real(r8), pointer :: soil4n_to_sminn(:)
   real(r8), pointer :: supplement_to_sminn(:)
   real(r8), pointer :: deadcrootn_storage_to_xfer(:)
   real(r8), pointer :: deadcrootn_xfer_to_deadcrootn(:)
   real(r8), pointer :: deadstemn_storage_to_xfer(:)
   real(r8), pointer :: deadstemn_xfer_to_deadstemn(:)
   real(r8), pointer :: frootn_storage_to_xfer(:)
   real(r8), pointer :: frootn_to_litter(:)
   real(r8), pointer :: frootn_xfer_to_frootn(:)
   real(r8), pointer :: leafn_storage_to_xfer(:)
   real(r8), pointer :: leafn_to_litter(:)
   real(r8), pointer :: leafn_to_retransn(:)
   real(r8), pointer :: leafn_xfer_to_leafn(:)
   real(r8), pointer :: livecrootn_storage_to_xfer(:)
   real(r8), pointer :: livecrootn_to_deadcrootn(:)
   real(r8), pointer :: livecrootn_to_retransn(:)
   real(r8), pointer :: livecrootn_xfer_to_livecrootn(:)
   real(r8), pointer :: livestemn_storage_to_xfer(:)
   real(r8), pointer :: livestemn_to_deadstemn(:)
   real(r8), pointer :: livestemn_to_retransn(:)
   real(r8), pointer :: livestemn_xfer_to_livestemn(:)
   real(r8), pointer :: npool_to_deadcrootn(:)
   real(r8), pointer :: npool_to_deadcrootn_storage(:)
   real(r8), pointer :: npool_to_deadstemn(:)
   real(r8), pointer :: npool_to_deadstemn_storage(:)
   real(r8), pointer :: npool_to_frootn(:)
   real(r8), pointer :: npool_to_frootn_storage(:)
   real(r8), pointer :: npool_to_leafn(:)
   real(r8), pointer :: npool_to_leafn_storage(:)
   real(r8), pointer :: npool_to_livecrootn(:)
   real(r8), pointer :: npool_to_livecrootn_storage(:)
   real(r8), pointer :: npool_to_livestemn(:)
   real(r8), pointer :: npool_to_livestemn_storage(:)
   real(r8), pointer :: retransn_to_npool(:)
   real(r8), pointer :: sminn_to_npool(:)
#if (defined CROP)
   real(r8), pointer :: grainn_storage_to_xfer(:)
   real(r8), pointer :: grainn_to_food(:)
   real(r8), pointer :: grainn_xfer_to_grainn(:)
   real(r8), pointer :: livestemn_to_litter(:)
   real(r8), pointer :: npool_to_grainn(:)
   real(r8), pointer :: npool_to_grainn_storage(:)
#endif
!
! local pointers to implicit in/out scalars
#if (defined CROP)
   real(r8), pointer :: grainn(:)             ! (gN/m2) grain N
   real(r8), pointer :: grainn_storage(:)     ! (gN/m2) grain N storage
   real(r8), pointer :: grainn_xfer(:)        ! (gN/m2) grain N transfer
#endif
   real(r8), pointer :: litr1n(:)             ! (gN/m2) litter labile N
   real(r8), pointer :: litr2n(:)             ! (gN/m2) litter cellulose N
   real(r8), pointer :: litr3n(:)             ! (gN/m2) litter lignin N
   real(r8), pointer :: sminn(:)              ! (gN/m2) soil mineral N
   real(r8), pointer :: soil1n(:)             ! (gN/m2) soil organic matter N (fast pool)
   real(r8), pointer :: soil2n(:)             ! (gN/m2) soil organic matter N (medium pool)
   real(r8), pointer :: soil3n(:)             ! (gN/m2) soil orgainc matter N (slow pool)
   real(r8), pointer :: soil4n(:)             ! (gN/m2) soil orgainc matter N (slowest pool)
   real(r8), pointer :: cwdn(:)               ! (gN/m2) coarse woody debris N
   real(r8), pointer :: frootn(:)             ! (gN/m2) fine root N
   real(r8), pointer :: frootn_storage(:)     ! (gN/m2) fine root N storage
   real(r8), pointer :: frootn_xfer(:)        ! (gN/m2) fine root N transfer
   real(r8), pointer :: leafn(:)              ! (gN/m2) leaf N
   real(r8), pointer :: leafn_storage(:)      ! (gN/m2) leaf N storage
   real(r8), pointer :: leafn_xfer(:)         ! (gN/m2) leaf N transfer
   real(r8), pointer :: livecrootn(:)         ! (gN/m2) live coarse root N
   real(r8), pointer :: livecrootn_storage(:) ! (gN/m2) live coarse root N storage
   real(r8), pointer :: livecrootn_xfer(:)    ! (gN/m2) live coarse root N transfer
   real(r8), pointer :: livestemn(:)          ! (gN/m2) live stem N
   real(r8), pointer :: livestemn_storage(:)  ! (gN/m2) live stem N storage
   real(r8), pointer :: livestemn_xfer(:)     ! (gN/m2) live stem N transfer
   real(r8), pointer :: deadcrootn(:)         ! (gN/m2) dead coarse root N
   real(r8), pointer :: deadcrootn_storage(:) ! (gN/m2) dead coarse root N storage
   real(r8), pointer :: deadcrootn_xfer(:)    ! (gN/m2) dead coarse root N transfer
   real(r8), pointer :: deadstemn(:)          ! (gN/m2) dead stem N
   real(r8), pointer :: deadstemn_storage(:)  ! (gN/m2) dead stem N storage
   real(r8), pointer :: deadstemn_xfer(:)     ! (gN/m2) dead stem N transfer
   real(r8), pointer :: retransn(:)           ! (gN/m2) plant pool of retranslocated N
   real(r8), pointer :: npool(:)              ! (gN/m2) temporary plant N pool

! local pointers for dynamic landcover fluxes and states
   real(r8), pointer :: dwt_seedn_to_leaf(:)
   real(r8), pointer :: dwt_seedn_to_deadstem(:)
   real(r8), pointer :: dwt_frootn_to_litr1n(:)
   real(r8), pointer :: dwt_frootn_to_litr2n(:)
   real(r8), pointer :: dwt_frootn_to_litr3n(:)
   real(r8), pointer :: dwt_livecrootn_to_cwdn(:)
   real(r8), pointer :: dwt_deadcrootn_to_cwdn(:)
   real(r8), pointer :: seedn(:)
!
! local pointers to implicit out scalars
   real(r8), pointer :: col_begnb(:)   ! nitrogen mass, beginning of time step (gN/m**2)
   real(r8), pointer :: pft_begnb(:)   ! nitrogen mass, beginning of time step (gN/m**2)
!
! !OTHER LOCAL VARIABLES:
   integer :: c,p      ! indices
   integer :: fp,fc    ! lake filter indices
!   real(r8):: dt       ! radiation time step (seconds)

!EOP
!-----------------------------------------------------------------------
   ! assign local pointers
   woody                          => pftcon%woody

   ! assign local pointers at the column level
   cwdn_to_litr2n                 => clm3%g%l%c%cnf%cwdn_to_litr2n
   cwdn_to_litr3n                 => clm3%g%l%c%cnf%cwdn_to_litr3n
#if (defined CROP)
   livestemn_to_litr1n            => clm3%g%l%c%cnf%livestemn_to_litr1n
   livestemn_to_litr2n            => clm3%g%l%c%cnf%livestemn_to_litr2n
   livestemn_to_litr3n            => clm3%g%l%c%cnf%livestemn_to_litr3n
   grainn_to_litr1n               => clm3%g%l%c%cnf%grainn_to_litr1n
   grainn_to_litr2n               => clm3%g%l%c%cnf%grainn_to_litr2n
   grainn_to_litr3n               => clm3%g%l%c%cnf%grainn_to_litr3n
#endif
   frootn_to_litr1n               => clm3%g%l%c%cnf%frootn_to_litr1n
   frootn_to_litr2n               => clm3%g%l%c%cnf%frootn_to_litr2n
   frootn_to_litr3n               => clm3%g%l%c%cnf%frootn_to_litr3n
   leafn_to_litr1n                => clm3%g%l%c%cnf%leafn_to_litr1n
   leafn_to_litr2n                => clm3%g%l%c%cnf%leafn_to_litr2n
   leafn_to_litr3n                => clm3%g%l%c%cnf%leafn_to_litr3n
   litr1n_to_soil1n               => clm3%g%l%c%cnf%litr1n_to_soil1n
   litr2n_to_soil2n               => clm3%g%l%c%cnf%litr2n_to_soil2n
   litr3n_to_soil3n               => clm3%g%l%c%cnf%litr3n_to_soil3n
   ndep_to_sminn                  => clm3%g%l%c%cnf%ndep_to_sminn
   nfix_to_sminn                  => clm3%g%l%c%cnf%nfix_to_sminn
   sminn_to_denit_excess          => clm3%g%l%c%cnf%sminn_to_denit_excess
   sminn_to_denit_l1s1            => clm3%g%l%c%cnf%sminn_to_denit_l1s1
   sminn_to_denit_l2s2            => clm3%g%l%c%cnf%sminn_to_denit_l2s2
   sminn_to_denit_l3s3            => clm3%g%l%c%cnf%sminn_to_denit_l3s3
   sminn_to_denit_s1s2            => clm3%g%l%c%cnf%sminn_to_denit_s1s2
   sminn_to_denit_s2s3            => clm3%g%l%c%cnf%sminn_to_denit_s2s3
   sminn_to_denit_s3s4            => clm3%g%l%c%cnf%sminn_to_denit_s3s4
   sminn_to_denit_s4              => clm3%g%l%c%cnf%sminn_to_denit_s4
   sminn_to_plant                 => clm3%g%l%c%cnf%sminn_to_plant
   sminn_to_soil1n_l1             => clm3%g%l%c%cnf%sminn_to_soil1n_l1
   sminn_to_soil2n_l2             => clm3%g%l%c%cnf%sminn_to_soil2n_l2
   sminn_to_soil2n_s1             => clm3%g%l%c%cnf%sminn_to_soil2n_s1
   sminn_to_soil3n_l3             => clm3%g%l%c%cnf%sminn_to_soil3n_l3
   sminn_to_soil3n_s2             => clm3%g%l%c%cnf%sminn_to_soil3n_s2
   sminn_to_soil4n_s3             => clm3%g%l%c%cnf%sminn_to_soil4n_s3
   soil1n_to_soil2n               => clm3%g%l%c%cnf%soil1n_to_soil2n
   soil2n_to_soil3n               => clm3%g%l%c%cnf%soil2n_to_soil3n
   soil3n_to_soil4n               => clm3%g%l%c%cnf%soil3n_to_soil4n
   soil4n_to_sminn                => clm3%g%l%c%cnf%soil4n_to_sminn
   supplement_to_sminn            => clm3%g%l%c%cnf%supplement_to_sminn
   cwdn                           => clm3%g%l%c%cns%cwdn
   litr1n                         => clm3%g%l%c%cns%litr1n
   litr2n                         => clm3%g%l%c%cns%litr2n
   litr3n                         => clm3%g%l%c%cns%litr3n
   sminn                          => clm3%g%l%c%cns%sminn
   soil1n                         => clm3%g%l%c%cns%soil1n
   soil2n                         => clm3%g%l%c%cns%soil2n
   soil3n                         => clm3%g%l%c%cns%soil3n
   soil4n                         => clm3%g%l%c%cns%soil4n
   ! new pointers for dynamic landcover
   dwt_seedn_to_leaf          => clm3%g%l%c%cnf%dwt_seedn_to_leaf
   dwt_seedn_to_deadstem      => clm3%g%l%c%cnf%dwt_seedn_to_deadstem
   dwt_frootn_to_litr1n 	  => clm3%g%l%c%cnf%dwt_frootn_to_litr1n
   dwt_frootn_to_litr2n 	  => clm3%g%l%c%cnf%dwt_frootn_to_litr2n
   dwt_frootn_to_litr3n 	  => clm3%g%l%c%cnf%dwt_frootn_to_litr3n
   dwt_livecrootn_to_cwdn	  => clm3%g%l%c%cnf%dwt_livecrootn_to_cwdn
   dwt_deadcrootn_to_cwdn	  => clm3%g%l%c%cnf%dwt_deadcrootn_to_cwdn
   seedn			  => clm3%g%l%c%cns%seedn

   ! assign local pointers at the pft level
   ivt                            => clm3%g%l%c%p%itype
   deadcrootn_storage_to_xfer     => clm3%g%l%c%p%pnf%deadcrootn_storage_to_xfer
   deadcrootn_xfer_to_deadcrootn  => clm3%g%l%c%p%pnf%deadcrootn_xfer_to_deadcrootn
   deadstemn_storage_to_xfer      => clm3%g%l%c%p%pnf%deadstemn_storage_to_xfer
   deadstemn_xfer_to_deadstemn    => clm3%g%l%c%p%pnf%deadstemn_xfer_to_deadstemn
   frootn_storage_to_xfer         => clm3%g%l%c%p%pnf%frootn_storage_to_xfer
   frootn_to_litter               => clm3%g%l%c%p%pnf%frootn_to_litter
   frootn_xfer_to_frootn          => clm3%g%l%c%p%pnf%frootn_xfer_to_frootn
   leafn_storage_to_xfer          => clm3%g%l%c%p%pnf%leafn_storage_to_xfer
   leafn_to_litter                => clm3%g%l%c%p%pnf%leafn_to_litter
   leafn_to_retransn              => clm3%g%l%c%p%pnf%leafn_to_retransn
   leafn_xfer_to_leafn            => clm3%g%l%c%p%pnf%leafn_xfer_to_leafn
   livecrootn_storage_to_xfer     => clm3%g%l%c%p%pnf%livecrootn_storage_to_xfer
   livecrootn_to_deadcrootn       => clm3%g%l%c%p%pnf%livecrootn_to_deadcrootn
   livecrootn_to_retransn         => clm3%g%l%c%p%pnf%livecrootn_to_retransn
   livecrootn_xfer_to_livecrootn  => clm3%g%l%c%p%pnf%livecrootn_xfer_to_livecrootn
   livestemn_storage_to_xfer      => clm3%g%l%c%p%pnf%livestemn_storage_to_xfer
   livestemn_to_deadstemn         => clm3%g%l%c%p%pnf%livestemn_to_deadstemn
   livestemn_to_retransn          => clm3%g%l%c%p%pnf%livestemn_to_retransn
   livestemn_xfer_to_livestemn    => clm3%g%l%c%p%pnf%livestemn_xfer_to_livestemn
   npool_to_deadcrootn            => clm3%g%l%c%p%pnf%npool_to_deadcrootn
   npool_to_deadcrootn_storage    => clm3%g%l%c%p%pnf%npool_to_deadcrootn_storage
   npool_to_deadstemn             => clm3%g%l%c%p%pnf%npool_to_deadstemn
   npool_to_deadstemn_storage     => clm3%g%l%c%p%pnf%npool_to_deadstemn_storage
   npool_to_frootn                => clm3%g%l%c%p%pnf%npool_to_frootn
   npool_to_frootn_storage        => clm3%g%l%c%p%pnf%npool_to_frootn_storage
   npool_to_leafn                 => clm3%g%l%c%p%pnf%npool_to_leafn
   npool_to_leafn_storage         => clm3%g%l%c%p%pnf%npool_to_leafn_storage
   npool_to_livecrootn            => clm3%g%l%c%p%pnf%npool_to_livecrootn
   npool_to_livecrootn_storage    => clm3%g%l%c%p%pnf%npool_to_livecrootn_storage
   npool_to_livestemn             => clm3%g%l%c%p%pnf%npool_to_livestemn
   npool_to_livestemn_storage     => clm3%g%l%c%p%pnf%npool_to_livestemn_storage
   retransn_to_npool              => clm3%g%l%c%p%pnf%retransn_to_npool
   sminn_to_npool                 => clm3%g%l%c%p%pnf%sminn_to_npool
#if (defined CROP)
   grainn_storage_to_xfer         => clm3%g%l%c%p%pnf%grainn_storage_to_xfer
   grainn_to_food                 => clm3%g%l%c%p%pnf%grainn_to_food
   grainn_xfer_to_grainn          => clm3%g%l%c%p%pnf%grainn_xfer_to_grainn
   livestemn_to_litter            => clm3%g%l%c%p%pnf%livestemn_to_litter
   npool_to_grainn                => clm3%g%l%c%p%pnf%npool_to_grainn
   npool_to_grainn_storage        => clm3%g%l%c%p%pnf%npool_to_grainn_storage
   grainn                         => clm3%g%l%c%p%pns%grainn
   grainn_storage                 => clm3%g%l%c%p%pns%grainn_storage
   grainn_xfer                    => clm3%g%l%c%p%pns%grainn_xfer
#endif
   deadcrootn                     => clm3%g%l%c%p%pns%deadcrootn
   deadcrootn_storage             => clm3%g%l%c%p%pns%deadcrootn_storage
   deadcrootn_xfer                => clm3%g%l%c%p%pns%deadcrootn_xfer
   deadstemn                      => clm3%g%l%c%p%pns%deadstemn
   deadstemn_storage              => clm3%g%l%c%p%pns%deadstemn_storage
   deadstemn_xfer                 => clm3%g%l%c%p%pns%deadstemn_xfer
   frootn                         => clm3%g%l%c%p%pns%frootn
   frootn_storage                 => clm3%g%l%c%p%pns%frootn_storage
   frootn_xfer                    => clm3%g%l%c%p%pns%frootn_xfer
   leafn                          => clm3%g%l%c%p%pns%leafn
   leafn_storage                  => clm3%g%l%c%p%pns%leafn_storage
   leafn_xfer                     => clm3%g%l%c%p%pns%leafn_xfer
   livecrootn                     => clm3%g%l%c%p%pns%livecrootn
   livecrootn_storage             => clm3%g%l%c%p%pns%livecrootn_storage
   livecrootn_xfer                => clm3%g%l%c%p%pns%livecrootn_xfer
   livestemn                      => clm3%g%l%c%p%pns%livestemn
   livestemn_storage              => clm3%g%l%c%p%pns%livestemn_storage
   livestemn_xfer                 => clm3%g%l%c%p%pns%livestemn_xfer
   npool                          => clm3%g%l%c%p%pns%npool
   retransn                       => clm3%g%l%c%p%pns%retransn

   ! set time steps
!   dt = real( get_step_size(), r8 )

   ! column loop
   do fc = 1,num_soilc
      c = filter_soilc(fc)

      ! column-level fluxes

      ! N deposition and fixation
      sminn(c) = sminn(c) + ndep_to_sminn(c)*dt
      sminn(c) = sminn(c) + nfix_to_sminn(c)*dt

      ! plant to litter fluxes
      ! leaf litter
      litr1n(c) = litr1n(c) + leafn_to_litr1n(c)*dt
      litr2n(c) = litr2n(c) + leafn_to_litr2n(c)*dt
      litr3n(c) = litr3n(c) + leafn_to_litr3n(c)*dt
      ! fine root litter
      litr1n(c) = litr1n(c) + frootn_to_litr1n(c)*dt
      litr2n(c) = litr2n(c) + frootn_to_litr2n(c)*dt
      litr3n(c) = litr3n(c) + frootn_to_litr3n(c)*dt
#if (defined CROP)
      ! livestem litter
      litr1n(c) = litr1n(c) + livestemn_to_litr1n(c)*dt
      litr2n(c) = litr2n(c) + livestemn_to_litr2n(c)*dt
      litr3n(c) = litr3n(c) + livestemn_to_litr3n(c)*dt
      ! grain litter
      litr1n(c) = litr1n(c) + grainn_to_litr1n(c)*dt
      litr2n(c) = litr2n(c) + grainn_to_litr2n(c)*dt
      litr3n(c) = litr3n(c) + grainn_to_litr3n(c)*dt
#endif

       ! seeding fluxes, from dynamic landcover
	   seedn(c) = seedn(c) - dwt_seedn_to_leaf(c) * dt
	   seedn(c) = seedn(c) - dwt_seedn_to_deadstem(c) * dt
	   
      ! fluxes into litter and CWD, from dynamic landcover
      litr1n(c) = litr1n(c) + dwt_frootn_to_litr1n(c)*dt
      litr2n(c) = litr2n(c) + dwt_frootn_to_litr2n(c)*dt
      litr3n(c) = litr3n(c) + dwt_frootn_to_litr3n(c)*dt
      cwdn(c)	= cwdn(c)   + dwt_livecrootn_to_cwdn(c)*dt
      cwdn(c)	= cwdn(c)   + dwt_deadcrootn_to_cwdn(c)*dt
      
      ! CWD to litter fluxes
      cwdn(c)   = cwdn(c)   - cwdn_to_litr2n(c)*dt
      litr2n(c) = litr2n(c) + cwdn_to_litr2n(c)*dt
      cwdn(c)   = cwdn(c)   - cwdn_to_litr3n(c)*dt
      litr3n(c) = litr3n(c) + cwdn_to_litr3n(c)*dt

      ! update litter states
      litr1n(c) = litr1n(c) - litr1n_to_soil1n(c)*dt
      litr2n(c) = litr2n(c) - litr2n_to_soil2n(c)*dt
      litr3n(c) = litr3n(c) - litr3n_to_soil3n(c)*dt

      ! update SOM states
      soil1n(c) = soil1n(c) + &
         (litr1n_to_soil1n(c) + sminn_to_soil1n_l1(c) - soil1n_to_soil2n(c))*dt
      soil2n(c) = soil2n(c) + &
         (litr2n_to_soil2n(c) + sminn_to_soil2n_l2(c) + &
          soil1n_to_soil2n(c) + sminn_to_soil2n_s1(c) - soil2n_to_soil3n(c))*dt
      soil3n(c) = soil3n(c) + &
         (litr3n_to_soil3n(c) + sminn_to_soil3n_l3(c) + &
          soil2n_to_soil3n(c) + sminn_to_soil3n_s2(c) - soil3n_to_soil4n(c))*dt
      soil4n(c) = soil4n(c) + &
         (soil3n_to_soil4n(c) + sminn_to_soil4n_s3(c) - soil4n_to_sminn(c))*dt

      ! immobilization/mineralization in litter-to-SOM and SOM-to-SOM fluxes
      sminn(c)  = sminn(c)  - &
         (sminn_to_soil1n_l1(c) + sminn_to_soil2n_l2(c) + &
          sminn_to_soil3n_l3(c) + sminn_to_soil2n_s1(c) + &
          sminn_to_soil3n_s2(c) + sminn_to_soil4n_s3(c) - &
          soil4n_to_sminn(c))*dt

      ! denitrification fluxes
      sminn(c) = sminn(c) - &
         (sminn_to_denit_l1s1(c) + sminn_to_denit_l2s2(c) + &
          sminn_to_denit_l3s3(c) + sminn_to_denit_s1s2(c) + &
          sminn_to_denit_s2s3(c) + sminn_to_denit_s3s4(c) + &
          sminn_to_denit_s4(c)   + sminn_to_denit_excess(c))*dt

      ! total plant uptake from mineral N
      sminn(c) = sminn(c) - sminn_to_plant(c)*dt

      ! flux that prevents N limitation (when SUPLN is set)
      sminn(c) = sminn(c) + supplement_to_sminn(c)*dt

   end do ! end of column loop

   ! pft loop
   do fp = 1,num_soilp
      p = filter_soilp(fp)

      ! phenology: transfer growth fluxes
      leafn(p)       = leafn(p)       + leafn_xfer_to_leafn(p)*dt
      leafn_xfer(p)  = leafn_xfer(p)  - leafn_xfer_to_leafn(p)*dt
      frootn(p)      = frootn(p)      + frootn_xfer_to_frootn(p)*dt
      frootn_xfer(p) = frootn_xfer(p) - frootn_xfer_to_frootn(p)*dt
      if (woody(ivt(p)) == 1.0_r8) then
          livestemn(p)       = livestemn(p)       + livestemn_xfer_to_livestemn(p)*dt
          livestemn_xfer(p)  = livestemn_xfer(p)  - livestemn_xfer_to_livestemn(p)*dt
          deadstemn(p)       = deadstemn(p)       + deadstemn_xfer_to_deadstemn(p)*dt
          deadstemn_xfer(p)  = deadstemn_xfer(p)  - deadstemn_xfer_to_deadstemn(p)*dt
          livecrootn(p)      = livecrootn(p)      + livecrootn_xfer_to_livecrootn(p)*dt
          livecrootn_xfer(p) = livecrootn_xfer(p) - livecrootn_xfer_to_livecrootn(p)*dt
          deadcrootn(p)      = deadcrootn(p)      + deadcrootn_xfer_to_deadcrootn(p)*dt
          deadcrootn_xfer(p) = deadcrootn_xfer(p) - deadcrootn_xfer_to_deadcrootn(p)*dt
      end if
#if (defined CROP)
      if (ivt(p) >= npcropmin) then ! skip 2 generic crops
          ! lines here for consistency; the transfer terms are zero
          livestemn(p)       = livestemn(p)      + livestemn_xfer_to_livestemn(p)*dt
          livestemn_xfer(p)  = livestemn_xfer(p) - livestemn_xfer_to_livestemn(p)*dt
          grainn(p)          = grainn(p)         + grainn_xfer_to_grainn(p)*dt
          grainn_xfer(p)     = grainn_xfer(p)    - grainn_xfer_to_grainn(p)*dt
          write(6,*) 'in CNNStateUpdate1, grainn(',p,')=',grainn(p)
          write(6,*) 'in CNNStateUpdate1, grainn_xfer_to_grainn(',p,')=',grainn_xfer_to_grainn(p)
      end if
#endif

      ! phenology: litterfall and retranslocation fluxes
      leafn(p)    = leafn(p)    - leafn_to_litter(p)*dt
      frootn(p)   = frootn(p)   - frootn_to_litter(p)*dt
      leafn(p)    = leafn(p)    - leafn_to_retransn(p)*dt
      retransn(p) = retransn(p) + leafn_to_retransn(p)*dt

      ! live wood turnover and retranslocation fluxes
      if (woody(ivt(p)) == 1._r8) then
          livestemn(p)  = livestemn(p)  - livestemn_to_deadstemn(p)*dt
          deadstemn(p)  = deadstemn(p)  + livestemn_to_deadstemn(p)*dt
          livestemn(p)  = livestemn(p)  - livestemn_to_retransn(p)*dt
          retransn(p)   = retransn(p)   + livestemn_to_retransn(p)*dt
          livecrootn(p) = livecrootn(p) - livecrootn_to_deadcrootn(p)*dt
          deadcrootn(p) = deadcrootn(p) + livecrootn_to_deadcrootn(p)*dt
          livecrootn(p) = livecrootn(p) - livecrootn_to_retransn(p)*dt
          retransn(p)   = retransn(p)   + livecrootn_to_retransn(p)*dt
      end if
#if (defined CROP)
      if (ivt(p) >= npcropmin) then ! skip 2 generic crops
          livestemn(p)  = livestemn(p)  - livestemn_to_litter(p)*dt
          livestemn(p)  = livestemn(p)  - livestemn_to_retransn(p)*dt
          retransn(p)   = retransn(p)   + livestemn_to_retransn(p)*dt
          grainn(p)     = grainn(p)     - grainn_to_food(p)*dt
      end if
#endif

      ! uptake from soil mineral N pool
      npool(p) = npool(p) + sminn_to_npool(p)*dt

      ! deployment from retranslocation pool
      npool(p)    = npool(p)    + retransn_to_npool(p)*dt
      retransn(p) = retransn(p) - retransn_to_npool(p)*dt

      ! allocation fluxes
      npool(p)           = npool(p)          - npool_to_leafn(p)*dt
      leafn(p)           = leafn(p)          + npool_to_leafn(p)*dt
      npool(p)           = npool(p)          - npool_to_leafn_storage(p)*dt
      leafn_storage(p)   = leafn_storage(p)  + npool_to_leafn_storage(p)*dt
      npool(p)           = npool(p)          - npool_to_frootn(p)*dt
      frootn(p)          = frootn(p)         + npool_to_frootn(p)*dt
      npool(p)           = npool(p)          - npool_to_frootn_storage(p)*dt
      frootn_storage(p)  = frootn_storage(p) + npool_to_frootn_storage(p)*dt
      if (woody(ivt(p)) == 1._r8) then
          npool(p)              = npool(p)              - npool_to_livestemn(p)*dt
          livestemn(p)          = livestemn(p)          + npool_to_livestemn(p)*dt
          npool(p)              = npool(p)              - npool_to_livestemn_storage(p)*dt
          livestemn_storage(p)  = livestemn_storage(p)  + npool_to_livestemn_storage(p)*dt
          npool(p)              = npool(p)              - npool_to_deadstemn(p)*dt
          deadstemn(p)          = deadstemn(p)          + npool_to_deadstemn(p)*dt
          npool(p)              = npool(p)              - npool_to_deadstemn_storage(p)*dt
          deadstemn_storage(p)  = deadstemn_storage(p)  + npool_to_deadstemn_storage(p)*dt
          npool(p)              = npool(p)              - npool_to_livecrootn(p)*dt
          livecrootn(p)         = livecrootn(p)         + npool_to_livecrootn(p)*dt
          npool(p)              = npool(p)              - npool_to_livecrootn_storage(p)*dt
          livecrootn_storage(p) = livecrootn_storage(p) + npool_to_livecrootn_storage(p)*dt
          npool(p)              = npool(p)              - npool_to_deadcrootn(p)*dt
          deadcrootn(p)         = deadcrootn(p)         + npool_to_deadcrootn(p)*dt
          npool(p)              = npool(p)              - npool_to_deadcrootn_storage(p)*dt
          deadcrootn_storage(p) = deadcrootn_storage(p) + npool_to_deadcrootn_storage(p)*dt
      end if
#if (defined CROP)
      if (ivt(p) >= npcropmin) then ! skip 2 generic crops
          npool(p)              = npool(p)              - npool_to_livestemn(p)*dt
          livestemn(p)          = livestemn(p)          + npool_to_livestemn(p)*dt
          npool(p)              = npool(p)              - npool_to_livestemn_storage(p)*dt
          livestemn_storage(p)  = livestemn_storage(p)  + npool_to_livestemn_storage(p)*dt
          npool(p)              = npool(p)              - npool_to_grainn(p)*dt
          grainn(p)             = grainn(p)             + npool_to_grainn(p)*dt
          npool(p)              = npool(p)              - npool_to_grainn_storage(p)*dt
          grainn_storage(p)     = grainn_storage(p)     + npool_to_grainn_storage(p)*dt
      end if
#endif

      ! move storage pools into transfer pools
      leafn_storage(p)  = leafn_storage(p)  - leafn_storage_to_xfer(p)*dt
      leafn_xfer(p)     = leafn_xfer(p)     + leafn_storage_to_xfer(p)*dt
      frootn_storage(p) = frootn_storage(p) - frootn_storage_to_xfer(p)*dt
      frootn_xfer(p)    = frootn_xfer(p)    + frootn_storage_to_xfer(p)*dt
      if (woody(ivt(p)) == 1._r8) then
          livestemn_storage(p)  = livestemn_storage(p)  - livestemn_storage_to_xfer(p)*dt
          livestemn_xfer(p)     = livestemn_xfer(p)     + livestemn_storage_to_xfer(p)*dt
          deadstemn_storage(p)  = deadstemn_storage(p)  - deadstemn_storage_to_xfer(p)*dt
          deadstemn_xfer(p)     = deadstemn_xfer(p)     + deadstemn_storage_to_xfer(p)*dt
          livecrootn_storage(p) = livecrootn_storage(p) - livecrootn_storage_to_xfer(p)*dt
          livecrootn_xfer(p)    = livecrootn_xfer(p)    + livecrootn_storage_to_xfer(p)*dt
          deadcrootn_storage(p) = deadcrootn_storage(p) - deadcrootn_storage_to_xfer(p)*dt
          deadcrootn_xfer(p)    = deadcrootn_xfer(p)    + deadcrootn_storage_to_xfer(p)*dt
      end if
#if (defined CROP)
      if (ivt(p) >= npcropmin) then ! skip 2 generic crops
          ! lines here for consistency; the transfer terms are zero
          livestemn_storage(p)  = livestemn_storage(p) - livestemn_storage_to_xfer(p)*dt
          livestemn_xfer(p)     = livestemn_xfer(p)    + livestemn_storage_to_xfer(p)*dt
          grainn_storage(p)     = grainn_storage(p)    - grainn_storage_to_xfer(p)*dt
          grainn_xfer(p)        = grainn_xfer(p)       + grainn_storage_to_xfer(p)*dt
      end if
#endif

   end do
           write(6,*) 'after NStateUpdate1,deadstemn=',deadstemn

end subroutine NStateUpdate1
!-----------------------------------------------------------------------

#endif

end module CNNStateUpdate1Mod
module CNNStateUpdate2Mod
#ifdef CN

!-----------------------------------------------------------------------
!BOP
!
! !MODULE: NStateUpdate2Mod
!
! !DESCRIPTION:
! Module for nitrogen state variable update, mortality fluxes.
!
! !USES:
    use shr_kind_mod, only: r8 => shr_kind_r8
    implicit none
    save
    private
! !PUBLIC MEMBER FUNCTIONS:
    public:: NStateUpdate2
    public:: NStateUpdate2h
!
! !REVISION HISTORY:
! 4/23/2004: Created by Peter Thornton
!
!EOP
!-----------------------------------------------------------------------

contains

!-----------------------------------------------------------------------
!BOP
!
! !IROUTINE: NStateUpdate2
!
! !INTERFACE:
subroutine NStateUpdate2(num_soilc, filter_soilc, num_soilp, filter_soilp)
!
! !DESCRIPTION:
! On the radiation time step, update all the prognostic nitrogen state
! variables affected by gap-phase mortality fluxes
!
! !USES:
   use clmtype
!   use clm_time_manager, only: get_step_size
   use globals,only: dt
!
! !ARGUMENTS:
   implicit none
   integer, intent(in) :: num_soilc       ! number of soil columns in filter
   integer, intent(in) :: filter_soilc(:) ! filter for soil columns
   integer, intent(in) :: num_soilp       ! number of soil pfts in filter
   integer, intent(in) :: filter_soilp(:) ! filter for soil pfts
!
! !CALLED FROM:
! subroutine CNEcosystemDyn
!
! !REVISION HISTORY:
! 8/1/03: Created by Peter Thornton
!
! !LOCAL VARIABLES:
! local pointers to implicit in scalars
!
   real(r8), pointer :: m_deadcrootn_storage_to_litr1n(:)
   real(r8), pointer :: m_deadcrootn_to_cwdn(:)
   real(r8), pointer :: m_deadcrootn_xfer_to_litr1n(:)
   real(r8), pointer :: m_deadstemn_storage_to_litr1n(:)
   real(r8), pointer :: m_deadstemn_to_cwdn(:)
   real(r8), pointer :: m_deadstemn_xfer_to_litr1n(:)
   real(r8), pointer :: m_frootn_storage_to_litr1n(:)
   real(r8), pointer :: m_frootn_to_litr1n(:)
   real(r8), pointer :: m_frootn_to_litr2n(:)
   real(r8), pointer :: m_frootn_to_litr3n(:)
   real(r8), pointer :: m_frootn_xfer_to_litr1n(:)
   real(r8), pointer :: m_leafn_storage_to_litr1n(:)
   real(r8), pointer :: m_leafn_to_litr1n(:)
   real(r8), pointer :: m_leafn_to_litr2n(:)
   real(r8), pointer :: m_leafn_to_litr3n(:)
   real(r8), pointer :: m_leafn_xfer_to_litr1n(:)
   real(r8), pointer :: m_livecrootn_storage_to_litr1n(:)
   real(r8), pointer :: m_livecrootn_to_cwdn(:)
   real(r8), pointer :: m_livecrootn_xfer_to_litr1n(:)
   real(r8), pointer :: m_livestemn_storage_to_litr1n(:)
   real(r8), pointer :: m_livestemn_to_cwdn(:)
   real(r8), pointer :: m_livestemn_xfer_to_litr1n(:)
   real(r8), pointer :: m_retransn_to_litr1n(:)
   real(r8), pointer :: m_deadcrootn_storage_to_litter(:)
   real(r8), pointer :: m_deadcrootn_to_litter(:)
   real(r8), pointer :: m_deadcrootn_xfer_to_litter(:)
   real(r8), pointer :: m_deadstemn_storage_to_litter(:)
   real(r8), pointer :: m_deadstemn_to_litter(:)
   real(r8), pointer :: m_deadstemn_xfer_to_litter(:)
   real(r8), pointer :: m_frootn_storage_to_litter(:)
   real(r8), pointer :: m_frootn_to_litter(:)
   real(r8), pointer :: m_frootn_xfer_to_litter(:)
   real(r8), pointer :: m_leafn_storage_to_litter(:)
   real(r8), pointer :: m_leafn_to_litter(:)
   real(r8), pointer :: m_leafn_xfer_to_litter(:)
   real(r8), pointer :: m_livecrootn_storage_to_litter(:)
   real(r8), pointer :: m_livecrootn_to_litter(:)
   real(r8), pointer :: m_livecrootn_xfer_to_litter(:)
   real(r8), pointer :: m_livestemn_storage_to_litter(:)
   real(r8), pointer :: m_livestemn_to_litter(:)
   real(r8), pointer :: m_livestemn_xfer_to_litter(:)
   real(r8), pointer :: m_retransn_to_litter(:)
!
! local pointers to implicit in/out scalars
   real(r8), pointer :: cwdn(:)               ! (gN/m2) coarse woody debris N
   real(r8), pointer :: litr1n(:)             ! (gN/m2) litter labile N
   real(r8), pointer :: litr2n(:)             ! (gN/m2) litter cellulose N
   real(r8), pointer :: litr3n(:)             ! (gN/m2) litter lignin N
   real(r8), pointer :: deadcrootn(:)         ! (gN/m2) dead coarse root N
   real(r8), pointer :: deadcrootn_storage(:) ! (gN/m2) dead coarse root N storage
   real(r8), pointer :: deadcrootn_xfer(:)    ! (gN/m2) dead coarse root N transfer
   real(r8), pointer :: deadstemn(:)          ! (gN/m2) dead stem N
   real(r8), pointer :: deadstemn_storage(:)  ! (gN/m2) dead stem N storage
   real(r8), pointer :: deadstemn_xfer(:)     ! (gN/m2) dead stem N transfer
   real(r8), pointer :: frootn(:)             ! (gN/m2) fine root N
   real(r8), pointer :: frootn_storage(:)     ! (gN/m2) fine root N storage
   real(r8), pointer :: frootn_xfer(:)        ! (gN/m2) fine root N transfer
   real(r8), pointer :: leafn(:)              ! (gN/m2) leaf N
   real(r8), pointer :: leafn_storage(:)      ! (gN/m2) leaf N storage
   real(r8), pointer :: leafn_xfer(:)         ! (gN/m2) leaf N transfer
   real(r8), pointer :: livecrootn(:)         ! (gN/m2) live coarse root N
   real(r8), pointer :: livecrootn_storage(:) ! (gN/m2) live coarse root N storage
   real(r8), pointer :: livecrootn_xfer(:)    ! (gN/m2) live coarse root N transfer
   real(r8), pointer :: livestemn(:)          ! (gN/m2) live stem N
   real(r8), pointer :: livestemn_storage(:)  ! (gN/m2) live stem N storage
   real(r8), pointer :: livestemn_xfer(:)     ! (gN/m2) live stem N transfer
   real(r8), pointer :: retransn(:)           ! (gN/m2) plant pool of retranslocated N
!
! local pointers to implicit out scalars
!
!
! !OTHER LOCAL VARIABLES:
   integer :: c,p         ! indices
   integer :: fp,fc       ! lake filter indices
!   real(r8):: dt          ! radiation time step (seconds)

!EOP
!-----------------------------------------------------------------------
    ! assign local pointers at the column level
    m_deadcrootn_storage_to_litr1n => clm3%g%l%c%cnf%m_deadcrootn_storage_to_litr1n
    m_deadcrootn_to_cwdn           => clm3%g%l%c%cnf%m_deadcrootn_to_cwdn
    m_deadcrootn_xfer_to_litr1n    => clm3%g%l%c%cnf%m_deadcrootn_xfer_to_litr1n
    m_deadstemn_storage_to_litr1n  => clm3%g%l%c%cnf%m_deadstemn_storage_to_litr1n
    m_deadstemn_to_cwdn            => clm3%g%l%c%cnf%m_deadstemn_to_cwdn
    m_deadstemn_xfer_to_litr1n     => clm3%g%l%c%cnf%m_deadstemn_xfer_to_litr1n
    m_frootn_storage_to_litr1n     => clm3%g%l%c%cnf%m_frootn_storage_to_litr1n
    m_frootn_to_litr1n             => clm3%g%l%c%cnf%m_frootn_to_litr1n
    m_frootn_to_litr2n             => clm3%g%l%c%cnf%m_frootn_to_litr2n
    m_frootn_to_litr3n             => clm3%g%l%c%cnf%m_frootn_to_litr3n
    m_frootn_xfer_to_litr1n        => clm3%g%l%c%cnf%m_frootn_xfer_to_litr1n
    m_leafn_storage_to_litr1n      => clm3%g%l%c%cnf%m_leafn_storage_to_litr1n
    m_leafn_to_litr1n              => clm3%g%l%c%cnf%m_leafn_to_litr1n
    m_leafn_to_litr2n              => clm3%g%l%c%cnf%m_leafn_to_litr2n
    m_leafn_to_litr3n              => clm3%g%l%c%cnf%m_leafn_to_litr3n
    m_leafn_xfer_to_litr1n         => clm3%g%l%c%cnf%m_leafn_xfer_to_litr1n
    m_livecrootn_storage_to_litr1n => clm3%g%l%c%cnf%m_livecrootn_storage_to_litr1n
    m_livecrootn_to_cwdn           => clm3%g%l%c%cnf%m_livecrootn_to_cwdn
    m_livecrootn_xfer_to_litr1n    => clm3%g%l%c%cnf%m_livecrootn_xfer_to_litr1n
    m_livestemn_storage_to_litr1n  => clm3%g%l%c%cnf%m_livestemn_storage_to_litr1n
    m_livestemn_to_cwdn            => clm3%g%l%c%cnf%m_livestemn_to_cwdn
    m_livestemn_xfer_to_litr1n     => clm3%g%l%c%cnf%m_livestemn_xfer_to_litr1n
    m_retransn_to_litr1n           => clm3%g%l%c%cnf%m_retransn_to_litr1n
    cwdn                           => clm3%g%l%c%cns%cwdn
    litr1n                         => clm3%g%l%c%cns%litr1n
    litr2n                         => clm3%g%l%c%cns%litr2n
    litr3n                         => clm3%g%l%c%cns%litr3n

    ! assign local pointers at the pft level
    m_deadcrootn_storage_to_litter => clm3%g%l%c%p%pnf%m_deadcrootn_storage_to_litter
    m_deadcrootn_to_litter         => clm3%g%l%c%p%pnf%m_deadcrootn_to_litter
    m_deadcrootn_xfer_to_litter    => clm3%g%l%c%p%pnf%m_deadcrootn_xfer_to_litter
    m_deadstemn_storage_to_litter  => clm3%g%l%c%p%pnf%m_deadstemn_storage_to_litter
    m_deadstemn_to_litter          => clm3%g%l%c%p%pnf%m_deadstemn_to_litter
    m_deadstemn_xfer_to_litter     => clm3%g%l%c%p%pnf%m_deadstemn_xfer_to_litter
    m_frootn_storage_to_litter     => clm3%g%l%c%p%pnf%m_frootn_storage_to_litter
    m_frootn_to_litter             => clm3%g%l%c%p%pnf%m_frootn_to_litter
    m_frootn_xfer_to_litter        => clm3%g%l%c%p%pnf%m_frootn_xfer_to_litter
    m_leafn_storage_to_litter      => clm3%g%l%c%p%pnf%m_leafn_storage_to_litter
    m_leafn_to_litter              => clm3%g%l%c%p%pnf%m_leafn_to_litter
    m_leafn_xfer_to_litter         => clm3%g%l%c%p%pnf%m_leafn_xfer_to_litter
    m_livecrootn_storage_to_litter => clm3%g%l%c%p%pnf%m_livecrootn_storage_to_litter
    m_livecrootn_to_litter         => clm3%g%l%c%p%pnf%m_livecrootn_to_litter
    m_livecrootn_xfer_to_litter    => clm3%g%l%c%p%pnf%m_livecrootn_xfer_to_litter
    m_livestemn_storage_to_litter  => clm3%g%l%c%p%pnf%m_livestemn_storage_to_litter
    m_livestemn_to_litter          => clm3%g%l%c%p%pnf%m_livestemn_to_litter
    m_livestemn_xfer_to_litter     => clm3%g%l%c%p%pnf%m_livestemn_xfer_to_litter
    m_retransn_to_litter           => clm3%g%l%c%p%pnf%m_retransn_to_litter
    deadcrootn                     => clm3%g%l%c%p%pns%deadcrootn
    deadcrootn_storage             => clm3%g%l%c%p%pns%deadcrootn_storage
    deadcrootn_xfer                => clm3%g%l%c%p%pns%deadcrootn_xfer
    deadstemn                      => clm3%g%l%c%p%pns%deadstemn
    deadstemn_storage              => clm3%g%l%c%p%pns%deadstemn_storage
    deadstemn_xfer                 => clm3%g%l%c%p%pns%deadstemn_xfer
    frootn                         => clm3%g%l%c%p%pns%frootn
    frootn_storage                 => clm3%g%l%c%p%pns%frootn_storage
    frootn_xfer                    => clm3%g%l%c%p%pns%frootn_xfer
    leafn                          => clm3%g%l%c%p%pns%leafn
    leafn_storage                  => clm3%g%l%c%p%pns%leafn_storage
    leafn_xfer                     => clm3%g%l%c%p%pns%leafn_xfer
    livecrootn                     => clm3%g%l%c%p%pns%livecrootn
    livecrootn_storage             => clm3%g%l%c%p%pns%livecrootn_storage
    livecrootn_xfer                => clm3%g%l%c%p%pns%livecrootn_xfer
    livestemn                      => clm3%g%l%c%p%pns%livestemn
    livestemn_storage              => clm3%g%l%c%p%pns%livestemn_storage
    livestemn_xfer                 => clm3%g%l%c%p%pns%livestemn_xfer
    retransn                       => clm3%g%l%c%p%pns%retransn

   ! set time steps
 !  dt = real( get_step_size(), r8 )

   ! column loop
   do fc = 1,num_soilc
      c = filter_soilc(fc)

      ! column-level nitrogen fluxes from gap-phase mortality

      ! leaf to litter
      litr1n(c) = litr1n(c) + m_leafn_to_litr1n(c) * dt
      litr2n(c) = litr2n(c) + m_leafn_to_litr2n(c) * dt
      litr3n(c) = litr3n(c) + m_leafn_to_litr3n(c) * dt

      ! fine root to litter
      litr1n(c) = litr1n(c) + m_frootn_to_litr1n(c) * dt
      litr2n(c) = litr2n(c) + m_frootn_to_litr2n(c) * dt
      litr3n(c) = litr3n(c) + m_frootn_to_litr3n(c) * dt

      ! wood to CWD
      cwdn(c) = cwdn(c) + m_livestemn_to_cwdn(c)  * dt
      cwdn(c) = cwdn(c) + m_deadstemn_to_cwdn(c)  * dt
      cwdn(c) = cwdn(c) + m_livecrootn_to_cwdn(c) * dt
      cwdn(c) = cwdn(c) + m_deadcrootn_to_cwdn(c) * dt

      ! retranslocated N pool to litter
      litr1n(c) = litr1n(c) + m_retransn_to_litr1n(c) * dt

      ! storage pools to litter
      litr1n(c) = litr1n(c) + m_leafn_storage_to_litr1n(c)      * dt
      litr1n(c) = litr1n(c) + m_frootn_storage_to_litr1n(c)     * dt
      litr1n(c) = litr1n(c) + m_livestemn_storage_to_litr1n(c)  * dt
      litr1n(c) = litr1n(c) + m_deadstemn_storage_to_litr1n(c)  * dt
      litr1n(c) = litr1n(c) + m_livecrootn_storage_to_litr1n(c) * dt
      litr1n(c) = litr1n(c) + m_deadcrootn_storage_to_litr1n(c) * dt

      ! transfer pools to litter
      litr1n(c) = litr1n(c) + m_leafn_xfer_to_litr1n(c)      * dt
      litr1n(c) = litr1n(c) + m_frootn_xfer_to_litr1n(c)     * dt
      litr1n(c) = litr1n(c) + m_livestemn_xfer_to_litr1n(c)  * dt
      litr1n(c) = litr1n(c) + m_deadstemn_xfer_to_litr1n(c)  * dt
      litr1n(c) = litr1n(c) + m_livecrootn_xfer_to_litr1n(c) * dt
      litr1n(c) = litr1n(c) + m_deadcrootn_xfer_to_litr1n(c) * dt

   end do ! end of column loop

   ! pft loop
   do fp = 1,num_soilp
      p = filter_soilp(fp)

      ! pft-level nitrogen fluxes from gap-phase mortality
      ! displayed pools
      leafn(p)      = leafn(p)      - m_leafn_to_litter(p)      * dt
      frootn(p)     = frootn(p)     - m_frootn_to_litter(p)     * dt
      livestemn(p)  = livestemn(p)  - m_livestemn_to_litter(p)  * dt
      deadstemn(p)  = deadstemn(p)  - m_deadstemn_to_litter(p)  * dt
      livecrootn(p) = livecrootn(p) - m_livecrootn_to_litter(p) * dt
      deadcrootn(p) = deadcrootn(p) - m_deadcrootn_to_litter(p) * dt
      retransn(p)   = retransn(p)   - m_retransn_to_litter(p)   * dt

      ! storage pools
      leafn_storage(p)      = leafn_storage(p)      - m_leafn_storage_to_litter(p)      * dt
      frootn_storage(p)     = frootn_storage(p)     - m_frootn_storage_to_litter(p)     * dt
      livestemn_storage(p)  = livestemn_storage(p)  - m_livestemn_storage_to_litter(p)  * dt
      deadstemn_storage(p)  = deadstemn_storage(p)  - m_deadstemn_storage_to_litter(p)  * dt
      livecrootn_storage(p) = livecrootn_storage(p) - m_livecrootn_storage_to_litter(p) * dt
      deadcrootn_storage(p) = deadcrootn_storage(p) - m_deadcrootn_storage_to_litter(p) * dt

      ! transfer pools
      leafn_xfer(p)      = leafn_xfer(p)      - m_leafn_xfer_to_litter(p)      * dt
      frootn_xfer(p)     = frootn_xfer(p)     - m_frootn_xfer_to_litter(p)     * dt
      livestemn_xfer(p)  = livestemn_xfer(p)  - m_livestemn_xfer_to_litter(p)  * dt
      deadstemn_xfer(p)  = deadstemn_xfer(p)  - m_deadstemn_xfer_to_litter(p)  * dt
      livecrootn_xfer(p) = livecrootn_xfer(p) - m_livecrootn_xfer_to_litter(p) * dt
      deadcrootn_xfer(p) = deadcrootn_xfer(p) - m_deadcrootn_xfer_to_litter(p) * dt

   end do

end subroutine NStateUpdate2
!-----------------------------------------------------------------------

!-----------------------------------------------------------------------
!BOP
!
! !IROUTINE: NStateUpdate2h
!
! !INTERFACE:
subroutine NStateUpdate2h(num_soilc, filter_soilc, num_soilp, filter_soilp)
!
! !DESCRIPTION:
! Update all the prognostic nitrogen state
! variables affected by harvest mortality fluxes
!
! !USES:
   use clmtype
!   use clm_time_manager, only: get_step_size
  use globals, only: dt
!
! !ARGUMENTS:
   implicit none
   integer, intent(in) :: num_soilc       ! number of soil columns in filter
   integer, intent(in) :: filter_soilc(:) ! filter for soil columns
   integer, intent(in) :: num_soilp       ! number of soil pfts in filter
   integer, intent(in) :: filter_soilp(:) ! filter for soil pfts
!
! !CALLED FROM:
! subroutine CNEcosystemDyn
!
! !REVISION HISTORY:
! 8/1/03: Created by Peter Thornton
!
! !LOCAL VARIABLES:
! local pointers to implicit in scalars
!
   real(r8), pointer :: hrv_deadcrootn_storage_to_litr1n(:)
   real(r8), pointer :: hrv_deadcrootn_to_cwdn(:)
   real(r8), pointer :: hrv_deadcrootn_xfer_to_litr1n(:)
   real(r8), pointer :: hrv_deadstemn_storage_to_litr1n(:)
   real(r8), pointer :: hrv_deadstemn_xfer_to_litr1n(:)
   real(r8), pointer :: hrv_frootn_storage_to_litr1n(:)
   real(r8), pointer :: hrv_frootn_to_litr1n(:)
   real(r8), pointer :: hrv_frootn_to_litr2n(:)
   real(r8), pointer :: hrv_frootn_to_litr3n(:)
   real(r8), pointer :: hrv_frootn_xfer_to_litr1n(:)
   real(r8), pointer :: hrv_leafn_storage_to_litr1n(:)
   real(r8), pointer :: hrv_leafn_to_litr1n(:)
   real(r8), pointer :: hrv_leafn_to_litr2n(:)
   real(r8), pointer :: hrv_leafn_to_litr3n(:)
   real(r8), pointer :: hrv_leafn_xfer_to_litr1n(:)
   real(r8), pointer :: hrv_livecrootn_storage_to_litr1n(:)
   real(r8), pointer :: hrv_livecrootn_to_cwdn(:)
   real(r8), pointer :: hrv_livecrootn_xfer_to_litr1n(:)
   real(r8), pointer :: hrv_livestemn_storage_to_litr1n(:)
   real(r8), pointer :: hrv_livestemn_to_cwdn(:)
   real(r8), pointer :: hrv_livestemn_xfer_to_litr1n(:)
   real(r8), pointer :: hrv_retransn_to_litr1n(:)
   real(r8), pointer :: hrv_deadcrootn_storage_to_litter(:)
   real(r8), pointer :: hrv_deadcrootn_to_litter(:)
   real(r8), pointer :: hrv_deadcrootn_xfer_to_litter(:)
   real(r8), pointer :: hrv_deadstemn_storage_to_litter(:)
   real(r8), pointer :: hrv_deadstemn_to_prod10n(:)
   real(r8), pointer :: hrv_deadstemn_to_prod100n(:)
   real(r8), pointer :: hrv_deadstemn_xfer_to_litter(:)
   real(r8), pointer :: hrv_frootn_storage_to_litter(:)
   real(r8), pointer :: hrv_frootn_to_litter(:)
   real(r8), pointer :: hrv_frootn_xfer_to_litter(:)
   real(r8), pointer :: hrv_leafn_storage_to_litter(:)
   real(r8), pointer :: hrv_leafn_to_litter(:)
   real(r8), pointer :: hrv_leafn_xfer_to_litter(:)
   real(r8), pointer :: hrv_livecrootn_storage_to_litter(:)
   real(r8), pointer :: hrv_livecrootn_to_litter(:)
   real(r8), pointer :: hrv_livecrootn_xfer_to_litter(:)
   real(r8), pointer :: hrv_livestemn_storage_to_litter(:)
   real(r8), pointer :: hrv_livestemn_to_litter(:)
   real(r8), pointer :: hrv_livestemn_xfer_to_litter(:)
   real(r8), pointer :: hrv_retransn_to_litter(:)
!
! local pointers to implicit in/out scalars
   real(r8), pointer :: cwdn(:)               ! (gN/m2) coarse woody debris N
   real(r8), pointer :: litr1n(:)             ! (gN/m2) litter labile N
   real(r8), pointer :: litr2n(:)             ! (gN/m2) litter cellulose N
   real(r8), pointer :: litr3n(:)             ! (gN/m2) litter lignin N
   real(r8), pointer :: deadcrootn(:)         ! (gN/m2) dead coarse root N
   real(r8), pointer :: deadcrootn_storage(:) ! (gN/m2) dead coarse root N storage
   real(r8), pointer :: deadcrootn_xfer(:)    ! (gN/m2) dead coarse root N transfer
   real(r8), pointer :: deadstemn(:)          ! (gN/m2) dead stem N
   real(r8), pointer :: deadstemn_storage(:)  ! (gN/m2) dead stem N storage
   real(r8), pointer :: deadstemn_xfer(:)     ! (gN/m2) dead stem N transfer
   real(r8), pointer :: frootn(:)             ! (gN/m2) fine root N
   real(r8), pointer :: frootn_storage(:)     ! (gN/m2) fine root N storage
   real(r8), pointer :: frootn_xfer(:)        ! (gN/m2) fine root N transfer
   real(r8), pointer :: leafn(:)              ! (gN/m2) leaf N
   real(r8), pointer :: leafn_storage(:)      ! (gN/m2) leaf N storage
   real(r8), pointer :: leafn_xfer(:)         ! (gN/m2) leaf N transfer
   real(r8), pointer :: livecrootn(:)         ! (gN/m2) live coarse root N
   real(r8), pointer :: livecrootn_storage(:) ! (gN/m2) live coarse root N storage
   real(r8), pointer :: livecrootn_xfer(:)    ! (gN/m2) live coarse root N transfer
   real(r8), pointer :: livestemn(:)          ! (gN/m2) live stem N
   real(r8), pointer :: livestemn_storage(:)  ! (gN/m2) live stem N storage
   real(r8), pointer :: livestemn_xfer(:)     ! (gN/m2) live stem N transfer
   real(r8), pointer :: retransn(:)           ! (gN/m2) plant pool of retranslocated N
!
! local pointers to implicit out scalars
!
!
! !OTHER LOCAL VARIABLES:
   integer :: c,p         ! indices
   integer :: fp,fc       ! lake filter indices
!   real(r8):: dt          ! radiation time step (seconds)

!EOP
!-----------------------------------------------------------------------
    ! assign local pointers at the column level
    hrv_deadcrootn_storage_to_litr1n => clm3%g%l%c%cnf%hrv_deadcrootn_storage_to_litr1n
    hrv_deadcrootn_to_cwdn           => clm3%g%l%c%cnf%hrv_deadcrootn_to_cwdn
    hrv_deadcrootn_xfer_to_litr1n    => clm3%g%l%c%cnf%hrv_deadcrootn_xfer_to_litr1n
    hrv_deadstemn_storage_to_litr1n  => clm3%g%l%c%cnf%hrv_deadstemn_storage_to_litr1n
    hrv_deadstemn_xfer_to_litr1n     => clm3%g%l%c%cnf%hrv_deadstemn_xfer_to_litr1n
    hrv_frootn_storage_to_litr1n     => clm3%g%l%c%cnf%hrv_frootn_storage_to_litr1n
    hrv_frootn_to_litr1n             => clm3%g%l%c%cnf%hrv_frootn_to_litr1n
    hrv_frootn_to_litr2n             => clm3%g%l%c%cnf%hrv_frootn_to_litr2n
    hrv_frootn_to_litr3n             => clm3%g%l%c%cnf%hrv_frootn_to_litr3n
    hrv_frootn_xfer_to_litr1n        => clm3%g%l%c%cnf%hrv_frootn_xfer_to_litr1n
    hrv_leafn_storage_to_litr1n      => clm3%g%l%c%cnf%hrv_leafn_storage_to_litr1n
    hrv_leafn_to_litr1n              => clm3%g%l%c%cnf%hrv_leafn_to_litr1n
    hrv_leafn_to_litr2n              => clm3%g%l%c%cnf%hrv_leafn_to_litr2n
    hrv_leafn_to_litr3n              => clm3%g%l%c%cnf%hrv_leafn_to_litr3n
    hrv_leafn_xfer_to_litr1n         => clm3%g%l%c%cnf%hrv_leafn_xfer_to_litr1n
    hrv_livecrootn_storage_to_litr1n => clm3%g%l%c%cnf%hrv_livecrootn_storage_to_litr1n
    hrv_livecrootn_to_cwdn           => clm3%g%l%c%cnf%hrv_livecrootn_to_cwdn
    hrv_livecrootn_xfer_to_litr1n    => clm3%g%l%c%cnf%hrv_livecrootn_xfer_to_litr1n
    hrv_livestemn_storage_to_litr1n  => clm3%g%l%c%cnf%hrv_livestemn_storage_to_litr1n
    hrv_livestemn_to_cwdn            => clm3%g%l%c%cnf%hrv_livestemn_to_cwdn
    hrv_livestemn_xfer_to_litr1n     => clm3%g%l%c%cnf%hrv_livestemn_xfer_to_litr1n
    hrv_retransn_to_litr1n           => clm3%g%l%c%cnf%hrv_retransn_to_litr1n
    cwdn                           => clm3%g%l%c%cns%cwdn
    litr1n                         => clm3%g%l%c%cns%litr1n
    litr2n                         => clm3%g%l%c%cns%litr2n
    litr3n                         => clm3%g%l%c%cns%litr3n

    ! assign local pointers at the pft level
    hrv_deadcrootn_storage_to_litter => clm3%g%l%c%p%pnf%hrv_deadcrootn_storage_to_litter
    hrv_deadcrootn_to_litter         => clm3%g%l%c%p%pnf%hrv_deadcrootn_to_litter
    hrv_deadcrootn_xfer_to_litter    => clm3%g%l%c%p%pnf%hrv_deadcrootn_xfer_to_litter
    hrv_deadstemn_storage_to_litter  => clm3%g%l%c%p%pnf%hrv_deadstemn_storage_to_litter
    hrv_deadstemn_to_prod10n         => clm3%g%l%c%p%pnf%hrv_deadstemn_to_prod10n
    hrv_deadstemn_to_prod100n        => clm3%g%l%c%p%pnf%hrv_deadstemn_to_prod100n
    hrv_deadstemn_xfer_to_litter     => clm3%g%l%c%p%pnf%hrv_deadstemn_xfer_to_litter
    hrv_frootn_storage_to_litter     => clm3%g%l%c%p%pnf%hrv_frootn_storage_to_litter
    hrv_frootn_to_litter             => clm3%g%l%c%p%pnf%hrv_frootn_to_litter
    hrv_frootn_xfer_to_litter        => clm3%g%l%c%p%pnf%hrv_frootn_xfer_to_litter
    hrv_leafn_storage_to_litter      => clm3%g%l%c%p%pnf%hrv_leafn_storage_to_litter
    hrv_leafn_to_litter              => clm3%g%l%c%p%pnf%hrv_leafn_to_litter
    hrv_leafn_xfer_to_litter         => clm3%g%l%c%p%pnf%hrv_leafn_xfer_to_litter
    hrv_livecrootn_storage_to_litter => clm3%g%l%c%p%pnf%hrv_livecrootn_storage_to_litter
    hrv_livecrootn_to_litter         => clm3%g%l%c%p%pnf%hrv_livecrootn_to_litter
    hrv_livecrootn_xfer_to_litter    => clm3%g%l%c%p%pnf%hrv_livecrootn_xfer_to_litter
    hrv_livestemn_storage_to_litter  => clm3%g%l%c%p%pnf%hrv_livestemn_storage_to_litter
    hrv_livestemn_to_litter          => clm3%g%l%c%p%pnf%hrv_livestemn_to_litter
    hrv_livestemn_xfer_to_litter     => clm3%g%l%c%p%pnf%hrv_livestemn_xfer_to_litter
    hrv_retransn_to_litter           => clm3%g%l%c%p%pnf%hrv_retransn_to_litter
    deadcrootn                     => clm3%g%l%c%p%pns%deadcrootn
    deadcrootn_storage             => clm3%g%l%c%p%pns%deadcrootn_storage
    deadcrootn_xfer                => clm3%g%l%c%p%pns%deadcrootn_xfer
    deadstemn                      => clm3%g%l%c%p%pns%deadstemn
    deadstemn_storage              => clm3%g%l%c%p%pns%deadstemn_storage
    deadstemn_xfer                 => clm3%g%l%c%p%pns%deadstemn_xfer
    frootn                         => clm3%g%l%c%p%pns%frootn
    frootn_storage                 => clm3%g%l%c%p%pns%frootn_storage
    frootn_xfer                    => clm3%g%l%c%p%pns%frootn_xfer
    leafn                          => clm3%g%l%c%p%pns%leafn
    leafn_storage                  => clm3%g%l%c%p%pns%leafn_storage
    leafn_xfer                     => clm3%g%l%c%p%pns%leafn_xfer
    livecrootn                     => clm3%g%l%c%p%pns%livecrootn
    livecrootn_storage             => clm3%g%l%c%p%pns%livecrootn_storage
    livecrootn_xfer                => clm3%g%l%c%p%pns%livecrootn_xfer
    livestemn                      => clm3%g%l%c%p%pns%livestemn
    livestemn_storage              => clm3%g%l%c%p%pns%livestemn_storage
    livestemn_xfer                 => clm3%g%l%c%p%pns%livestemn_xfer
    retransn                       => clm3%g%l%c%p%pns%retransn

   ! set time steps
!   dt = real( get_step_size(), r8 )

   ! column loop
   do fc = 1,num_soilc
      c = filter_soilc(fc)

      ! column-level nitrogen fluxes from harvest mortality

      ! leaf to litter
      litr1n(c) = litr1n(c) + hrv_leafn_to_litr1n(c) * dt
      litr2n(c) = litr2n(c) + hrv_leafn_to_litr2n(c) * dt
      litr3n(c) = litr3n(c) + hrv_leafn_to_litr3n(c) * dt

      ! fine root to litter
      litr1n(c) = litr1n(c) + hrv_frootn_to_litr1n(c) * dt
      litr2n(c) = litr2n(c) + hrv_frootn_to_litr2n(c) * dt
      litr3n(c) = litr3n(c) + hrv_frootn_to_litr3n(c) * dt

      ! wood to CWD
      cwdn(c) = cwdn(c) + hrv_livestemn_to_cwdn(c)  * dt
      cwdn(c) = cwdn(c) + hrv_livecrootn_to_cwdn(c) * dt
      cwdn(c) = cwdn(c) + hrv_deadcrootn_to_cwdn(c) * dt

      ! wood to product pools - updates done in CNWoodProducts()
      
      ! retranslocated N pool to litter
      litr1n(c) = litr1n(c) + hrv_retransn_to_litr1n(c) * dt

      ! storage pools to litter
      litr1n(c) = litr1n(c) + hrv_leafn_storage_to_litr1n(c)      * dt
      litr1n(c) = litr1n(c) + hrv_frootn_storage_to_litr1n(c)     * dt
      litr1n(c) = litr1n(c) + hrv_livestemn_storage_to_litr1n(c)  * dt
      litr1n(c) = litr1n(c) + hrv_deadstemn_storage_to_litr1n(c)  * dt
      litr1n(c) = litr1n(c) + hrv_livecrootn_storage_to_litr1n(c) * dt
      litr1n(c) = litr1n(c) + hrv_deadcrootn_storage_to_litr1n(c) * dt

      ! transfer pools to litter
      litr1n(c) = litr1n(c) + hrv_leafn_xfer_to_litr1n(c)      * dt
      litr1n(c) = litr1n(c) + hrv_frootn_xfer_to_litr1n(c)     * dt
      litr1n(c) = litr1n(c) + hrv_livestemn_xfer_to_litr1n(c)  * dt
      litr1n(c) = litr1n(c) + hrv_deadstemn_xfer_to_litr1n(c)  * dt
      litr1n(c) = litr1n(c) + hrv_livecrootn_xfer_to_litr1n(c) * dt
      litr1n(c) = litr1n(c) + hrv_deadcrootn_xfer_to_litr1n(c) * dt

   end do ! end of column loop

   ! pft loop
   do fp = 1,num_soilp
      p = filter_soilp(fp)

      ! pft-level nitrogen fluxes from harvest mortality
      ! displayed pools
      leafn(p)      = leafn(p)      - hrv_leafn_to_litter(p)      * dt
      frootn(p)     = frootn(p)     - hrv_frootn_to_litter(p)     * dt
      livestemn(p)  = livestemn(p)  - hrv_livestemn_to_litter(p)  * dt
      deadstemn(p)  = deadstemn(p)  - hrv_deadstemn_to_prod10n(p) * dt
      deadstemn(p)  = deadstemn(p)  - hrv_deadstemn_to_prod100n(p)* dt
      livecrootn(p) = livecrootn(p) - hrv_livecrootn_to_litter(p) * dt
      deadcrootn(p) = deadcrootn(p) - hrv_deadcrootn_to_litter(p) * dt
      retransn(p)   = retransn(p)   - hrv_retransn_to_litter(p)   * dt

      ! storage pools
      leafn_storage(p)      = leafn_storage(p)      - hrv_leafn_storage_to_litter(p)      * dt
      frootn_storage(p)     = frootn_storage(p)     - hrv_frootn_storage_to_litter(p)     * dt
      livestemn_storage(p)  = livestemn_storage(p)  - hrv_livestemn_storage_to_litter(p)  * dt
      deadstemn_storage(p)  = deadstemn_storage(p)  - hrv_deadstemn_storage_to_litter(p)  * dt
      livecrootn_storage(p) = livecrootn_storage(p) - hrv_livecrootn_storage_to_litter(p) * dt
      deadcrootn_storage(p) = deadcrootn_storage(p) - hrv_deadcrootn_storage_to_litter(p) * dt

      ! transfer pools
      leafn_xfer(p)      = leafn_xfer(p)      - hrv_leafn_xfer_to_litter(p)      * dt
      frootn_xfer(p)     = frootn_xfer(p)     - hrv_frootn_xfer_to_litter(p)     * dt
      livestemn_xfer(p)  = livestemn_xfer(p)  - hrv_livestemn_xfer_to_litter(p)  * dt
      deadstemn_xfer(p)  = deadstemn_xfer(p)  - hrv_deadstemn_xfer_to_litter(p)  * dt
      livecrootn_xfer(p) = livecrootn_xfer(p) - hrv_livecrootn_xfer_to_litter(p) * dt
      deadcrootn_xfer(p) = deadcrootn_xfer(p) - hrv_deadcrootn_xfer_to_litter(p) * dt

   end do

end subroutine NStateUpdate2h
!-----------------------------------------------------------------------

#endif

end module CNNStateUpdate2Mod
module CNNStateUpdate3Mod
#ifdef CN

!-----------------------------------------------------------------------
!BOP
!
! !MODULE: NStateUpdate3Mod
!
! !DESCRIPTION:
! Module for nitrogen state variable update, mortality fluxes.
! Also, sminn leaching flux.
!
! !USES:
    use shr_kind_mod, only: r8 => shr_kind_r8
    implicit none
    save
    private
! !PUBLIC MEMBER FUNCTIONS:
    public:: NStateUpdate3
!
! !REVISION HISTORY:
! 7/27/2004: Created by Peter Thornton
!
!EOP
!-----------------------------------------------------------------------

contains

!-----------------------------------------------------------------------
!BOP
!
! !IROUTINE: NStateUpdate3
!
! !INTERFACE:
subroutine NStateUpdate3(num_soilc, filter_soilc, num_soilp, filter_soilp)
!
! !DESCRIPTION:
! On the radiation time step, update all the prognostic nitrogen state
! variables affected by gap-phase mortality fluxes. Also the Sminn leaching flux.
!
! !USES:
   use clmtype
!   use clm_time_manager, only: get_step_size
   use globals ,  only: dt
!
! !ARGUMENTS:
   implicit none
   integer, intent(in) :: num_soilc       ! number of soil columns in filter
   integer, intent(in) :: filter_soilc(:) ! filter for soil columns
   integer, intent(in) :: num_soilp       ! number of soil pfts in filter
   integer, intent(in) :: filter_soilp(:) ! filter for soil pfts
!
! !CALLED FROM:
! subroutine CNEcosystemDyn
!
! !REVISION HISTORY:
! 8/1/03: Created by Peter Thornton
!
! !LOCAL VARIABLES:
! local pointers to implicit in scalars
   real(r8), pointer :: sminn_leached(:) 
   real(r8), pointer :: m_cwdn_to_fire(:)
   real(r8), pointer :: m_deadcrootn_to_cwdn_fire(:)
   real(r8), pointer :: m_deadstemn_to_cwdn_fire(:)
   real(r8), pointer :: m_litr1n_to_fire(:)
   real(r8), pointer :: m_litr2n_to_fire(:)
   real(r8), pointer :: m_litr3n_to_fire(:)
   real(r8), pointer :: m_deadcrootn_storage_to_fire(:)
   real(r8), pointer :: m_deadcrootn_to_fire(:)
   real(r8), pointer :: m_deadcrootn_to_litter_fire(:)
   real(r8), pointer :: m_deadcrootn_xfer_to_fire(:)
   real(r8), pointer :: m_deadstemn_storage_to_fire(:)
   real(r8), pointer :: m_deadstemn_to_fire(:)
   real(r8), pointer :: m_deadstemn_to_litter_fire(:)
   real(r8), pointer :: m_deadstemn_xfer_to_fire(:)
   real(r8), pointer :: m_frootn_storage_to_fire(:)
   real(r8), pointer :: m_frootn_to_fire(:)
   real(r8), pointer :: m_frootn_xfer_to_fire(:)
   real(r8), pointer :: m_leafn_storage_to_fire(:)
   real(r8), pointer :: m_leafn_to_fire(:)
   real(r8), pointer :: m_leafn_xfer_to_fire(:)
   real(r8), pointer :: m_livecrootn_storage_to_fire(:)
   real(r8), pointer :: m_livecrootn_to_fire(:)
   real(r8), pointer :: m_livecrootn_xfer_to_fire(:)
   real(r8), pointer :: m_livestemn_storage_to_fire(:)
   real(r8), pointer :: m_livestemn_to_fire(:)
   real(r8), pointer :: m_livestemn_xfer_to_fire(:)
   real(r8), pointer :: m_retransn_to_fire(:)
!
! local pointers to implicit in/out scalars
   real(r8), pointer :: sminn(:)              ! (gN/m2) soil mineral N
   real(r8), pointer :: cwdn(:)               ! (gN/m2) coarse woody debris N
   real(r8), pointer :: litr1n(:)             ! (gN/m2) litter labile N
   real(r8), pointer :: litr2n(:)             ! (gN/m2) litter cellulose N
   real(r8), pointer :: litr3n(:)             ! (gN/m2) litter lignin N
   real(r8), pointer :: deadcrootn(:)         ! (gN/m2) dead coarse root N
   real(r8), pointer :: deadcrootn_storage(:) ! (gN/m2) dead coarse root N storage
   real(r8), pointer :: deadcrootn_xfer(:)    ! (gN/m2) dead coarse root N transfer
   real(r8), pointer :: deadstemn(:)          ! (gN/m2) dead stem N
   real(r8), pointer :: deadstemn_storage(:)  ! (gN/m2) dead stem N storage
   real(r8), pointer :: deadstemn_xfer(:)     ! (gN/m2) dead stem N transfer
   real(r8), pointer :: frootn(:)             ! (gN/m2) fine root N
   real(r8), pointer :: frootn_storage(:)     ! (gN/m2) fine root N storage
   real(r8), pointer :: frootn_xfer(:)        ! (gN/m2) fine root N transfer
   real(r8), pointer :: leafn(:)              ! (gN/m2) leaf N
   real(r8), pointer :: leafn_storage(:)      ! (gN/m2) leaf N storage
   real(r8), pointer :: leafn_xfer(:)         ! (gN/m2) leaf N transfer
   real(r8), pointer :: livecrootn(:)         ! (gN/m2) live coarse root N
   real(r8), pointer :: livecrootn_storage(:) ! (gN/m2) live coarse root N storage
   real(r8), pointer :: livecrootn_xfer(:)    ! (gN/m2) live coarse root N transfer
   real(r8), pointer :: livestemn(:)          ! (gN/m2) live stem N
   real(r8), pointer :: livestemn_storage(:)  ! (gN/m2) live stem N storage
   real(r8), pointer :: livestemn_xfer(:)     ! (gN/m2) live stem N transfer
   real(r8), pointer :: retransn(:)           ! (gN/m2) plant pool of retranslocated N
!
! local pointers to implicit out scalars
!
! !OTHER LOCAL VARIABLES:
   integer :: c,p        ! indices
   integer :: fp,fc      ! lake filter indices
!   real(r8):: dt         ! radiation time step (seconds)

!EOP
!-----------------------------------------------------------------------

    ! assign local pointers at the column level
    sminn_leached                  => clm3%g%l%c%cnf%sminn_leached
    m_cwdn_to_fire                 => clm3%g%l%c%cnf%m_cwdn_to_fire
    m_deadcrootn_to_cwdn_fire      => clm3%g%l%c%cnf%m_deadcrootn_to_cwdn_fire
    m_deadstemn_to_cwdn_fire       => clm3%g%l%c%cnf%m_deadstemn_to_cwdn_fire
    m_litr1n_to_fire               => clm3%g%l%c%cnf%m_litr1n_to_fire
    m_litr2n_to_fire               => clm3%g%l%c%cnf%m_litr2n_to_fire
    m_litr3n_to_fire               => clm3%g%l%c%cnf%m_litr3n_to_fire
    sminn                          => clm3%g%l%c%cns%sminn
    cwdn                           => clm3%g%l%c%cns%cwdn
    litr1n                         => clm3%g%l%c%cns%litr1n
    litr2n                         => clm3%g%l%c%cns%litr2n
    litr3n                         => clm3%g%l%c%cns%litr3n

    ! assign local pointers at the pft level
    m_deadcrootn_storage_to_fire   => clm3%g%l%c%p%pnf%m_deadcrootn_storage_to_fire
    m_deadcrootn_to_fire           => clm3%g%l%c%p%pnf%m_deadcrootn_to_fire
    m_deadcrootn_to_litter_fire    => clm3%g%l%c%p%pnf%m_deadcrootn_to_litter_fire
    m_deadcrootn_xfer_to_fire      => clm3%g%l%c%p%pnf%m_deadcrootn_xfer_to_fire
    m_deadstemn_storage_to_fire    => clm3%g%l%c%p%pnf%m_deadstemn_storage_to_fire
    m_deadstemn_to_fire            => clm3%g%l%c%p%pnf%m_deadstemn_to_fire
    m_deadstemn_to_litter_fire     => clm3%g%l%c%p%pnf%m_deadstemn_to_litter_fire
    m_deadstemn_xfer_to_fire       => clm3%g%l%c%p%pnf%m_deadstemn_xfer_to_fire
    m_frootn_storage_to_fire       => clm3%g%l%c%p%pnf%m_frootn_storage_to_fire
    m_frootn_to_fire               => clm3%g%l%c%p%pnf%m_frootn_to_fire
    m_frootn_xfer_to_fire          => clm3%g%l%c%p%pnf%m_frootn_xfer_to_fire
    m_leafn_storage_to_fire        => clm3%g%l%c%p%pnf%m_leafn_storage_to_fire
    m_leafn_to_fire                => clm3%g%l%c%p%pnf%m_leafn_to_fire
    m_leafn_xfer_to_fire           => clm3%g%l%c%p%pnf%m_leafn_xfer_to_fire
    m_livecrootn_storage_to_fire   => clm3%g%l%c%p%pnf%m_livecrootn_storage_to_fire
    m_livecrootn_to_fire           => clm3%g%l%c%p%pnf%m_livecrootn_to_fire
    m_livecrootn_xfer_to_fire      => clm3%g%l%c%p%pnf%m_livecrootn_xfer_to_fire
    m_livestemn_storage_to_fire    => clm3%g%l%c%p%pnf%m_livestemn_storage_to_fire
    m_livestemn_to_fire            => clm3%g%l%c%p%pnf%m_livestemn_to_fire
    m_livestemn_xfer_to_fire       => clm3%g%l%c%p%pnf%m_livestemn_xfer_to_fire
    m_retransn_to_fire             => clm3%g%l%c%p%pnf%m_retransn_to_fire
    deadcrootn                     => clm3%g%l%c%p%pns%deadcrootn
    deadcrootn_storage             => clm3%g%l%c%p%pns%deadcrootn_storage
    deadcrootn_xfer                => clm3%g%l%c%p%pns%deadcrootn_xfer
    deadstemn                      => clm3%g%l%c%p%pns%deadstemn
    deadstemn_storage              => clm3%g%l%c%p%pns%deadstemn_storage
    deadstemn_xfer                 => clm3%g%l%c%p%pns%deadstemn_xfer
    frootn                         => clm3%g%l%c%p%pns%frootn
    frootn_storage                 => clm3%g%l%c%p%pns%frootn_storage
    frootn_xfer                    => clm3%g%l%c%p%pns%frootn_xfer
    leafn                          => clm3%g%l%c%p%pns%leafn
    leafn_storage                  => clm3%g%l%c%p%pns%leafn_storage
    leafn_xfer                     => clm3%g%l%c%p%pns%leafn_xfer
    livecrootn                     => clm3%g%l%c%p%pns%livecrootn
    livecrootn_storage             => clm3%g%l%c%p%pns%livecrootn_storage
    livecrootn_xfer                => clm3%g%l%c%p%pns%livecrootn_xfer
    livestemn                      => clm3%g%l%c%p%pns%livestemn
    livestemn_storage              => clm3%g%l%c%p%pns%livestemn_storage
    livestemn_xfer                 => clm3%g%l%c%p%pns%livestemn_xfer
    retransn                       => clm3%g%l%c%p%pns%retransn

   ! set time steps
!   dt = real( get_step_size(), r8 )

   ! column loop
   do fc = 1,num_soilc
      c = filter_soilc(fc)

      ! mineral N loss due to leaching
      sminn(c) = sminn(c) - sminn_leached(c) * dt

      ! column level nitrogen fluxes from fire
      
      ! pft-level wood to column-level CWD (uncombusted wood)
      cwdn(c) = cwdn(c) + m_deadstemn_to_cwdn_fire(c) * dt
      cwdn(c) = cwdn(c) + m_deadcrootn_to_cwdn_fire(c) * dt

      ! litter and CWD losses to fire
      litr1n(c) = litr1n(c) - m_litr1n_to_fire(c) * dt
      litr2n(c) = litr2n(c) - m_litr2n_to_fire(c) * dt
      litr3n(c) = litr3n(c) - m_litr3n_to_fire(c) * dt
      cwdn(c)   = cwdn(c)   - m_cwdn_to_fire(c)   * dt

   end do ! end of column loop

   ! pft loop
   do fp = 1,num_soilp
      p = filter_soilp(fp)

      ! pft-level nitrogen fluxes from fire
      ! displayed pools
      leafn(p)      = leafn(p)      - m_leafn_to_fire(p)             * dt
      frootn(p)     = frootn(p)     - m_frootn_to_fire(p)            * dt
      livestemn(p)  = livestemn(p)  - m_livestemn_to_fire(p)         * dt
      deadstemn(p)  = deadstemn(p)  - m_deadstemn_to_fire(p)         * dt
      deadstemn(p)  = deadstemn(p)  - m_deadstemn_to_litter_fire(p)  * dt
      livecrootn(p) = livecrootn(p) - m_livecrootn_to_fire(p)        * dt
      deadcrootn(p) = deadcrootn(p) - m_deadcrootn_to_fire(p)        * dt
      deadcrootn(p) = deadcrootn(p) - m_deadcrootn_to_litter_fire(p) * dt

      ! storage pools
      leafn_storage(p)      = leafn_storage(p)      - m_leafn_storage_to_fire(p)      * dt
      frootn_storage(p)     = frootn_storage(p)     - m_frootn_storage_to_fire(p)     * dt
      livestemn_storage(p)  = livestemn_storage(p)  - m_livestemn_storage_to_fire(p)  * dt
      deadstemn_storage(p)  = deadstemn_storage(p)  - m_deadstemn_storage_to_fire(p)  * dt
      livecrootn_storage(p) = livecrootn_storage(p) - m_livecrootn_storage_to_fire(p) * dt
      deadcrootn_storage(p) = deadcrootn_storage(p) - m_deadcrootn_storage_to_fire(p) * dt

      ! transfer pools
      leafn_xfer(p)      = leafn_xfer(p)      - m_leafn_xfer_to_fire(p)      * dt
      frootn_xfer(p)     = frootn_xfer(p)     - m_frootn_xfer_to_fire(p)     * dt
      livestemn_xfer(p)  = livestemn_xfer(p)  - m_livestemn_xfer_to_fire(p)  * dt
      deadstemn_xfer(p)  = deadstemn_xfer(p)  - m_deadstemn_xfer_to_fire(p)  * dt
      livecrootn_xfer(p) = livecrootn_xfer(p) - m_livecrootn_xfer_to_fire(p) * dt
      deadcrootn_xfer(p) = deadcrootn_xfer(p) - m_deadcrootn_xfer_to_fire(p) * dt

      ! retranslocated N pool
      retransn(p) = retransn(p) - m_retransn_to_fire(p) * dt

   end do

end subroutine NStateUpdate3
!-----------------------------------------------------------------------
#endif

end module CNNStateUpdate3Mod
module CNPhenologyMod
#ifdef CN

!-----------------------------------------------------------------------
!BOP
!
! !MODULE: CNPhenologyMod
!
! !DESCRIPTION:
! Module holding routines used in phenology model for coupled carbon
! nitrogen code.
!
! !USES:
  use clmtype
  use shr_kind_mod, only: r8 => shr_kind_r8
#if (defined CROP)
  use clm_varcon  , only: tfrz
!  use clm_varctl  , only: iulog
!ylu remove
! use shr_sys_mod , only: shr_sys_flush
#endif
  implicit none
  save
  private

! local variables to the whole module

#if (defined CROP)
  integer, parameter :: irotation = 0 ! eventually from dataset? (slevis)
#endif

! !PUBLIC MEMBER FUNCTIONS:
  public :: CNPhenology
!
! !REVISION HISTORY:
! 8/1/03: Created by Peter Thornton
! 10/23/03, Peter Thornton: migrated all routines to vector data structures
! 2/4/08,  slevis: adding crop phenology from AgroIBIS
!
!EOP
!-----------------------------------------------------------------------

contains

!-----------------------------------------------------------------------
!BOP
!
! !IROUTINE: CNPhenology
!
! !INTERFACE:
#if (defined CROP)
subroutine CNPhenology (num_soilc, filter_soilc, num_soilp, filter_soilp, num_pcropp, filter_pcropp)
#else
subroutine CNPhenology (num_soilc, filter_soilc, num_soilp, filter_soilp)
#endif
!
! !DESCRIPTION:
! Dynamic phenology routine for coupled carbon-nitrogen code (CN)
! 1. grass phenology
!
! !USES:
!
! !ARGUMENTS:
   integer, intent(in) :: num_soilc       ! number of soil columns in filter
   integer, intent(in) :: filter_soilc(:) ! filter for soil columns
   integer, intent(in) :: num_soilp       ! number of soil pfts in filter
   integer, intent(in) :: filter_soilp(:) ! filter for soil pfts
#if (defined CROP)
   integer, intent(in) :: num_pcropp      ! number of prog. crop pfts in filter
   integer, intent(in) :: filter_pcropp(:)! filter for prognostic crop pfts
#endif
!
! !CALLED FROM:
! subroutine CNEcosystemDyn in module CNEcosystemDynMod.F90
!
! !REVISION HISTORY:
! 7/28/03: Created by Peter Thornton
! 9/05/03, Peter Thornton: moved from call with (p) to call with (c)
! 10/3/03, Peter Thornton: added subroutine calls for different phenology types
! 11/7/03, Peter Thornton: moved phenology type tests into phenology type
!    routines, and moved onset, offset, background litfall routines into
!    main phenology call.
! !LOCAL VARIABLES:
! local pointers to implicit in arrays
!
! local pointers to implicit in/out scalars
!
! local pointers to implicit out scalars
!
! !OTHER LOCAL VARIABLES:
!EOP
!-----------------------------------------------------------------------

   ! each of the following phenology type routines includes a filter
   ! to operate only on the relevant pfts

#if (defined CROP)
   call CNPhenologyClimate(num_soilp, filter_soilp, num_pcropp, filter_pcropp)
#else
   call CNPhenologyClimate(num_soilp, filter_soilp)
#endif
   
   call CNEvergreenPhenology(num_soilp, filter_soilp)

   call CNSeasonDecidPhenology(num_soilp, filter_soilp)

   call CNStressDecidPhenology(num_soilp, filter_soilp)

#if (defined CROP)
   call CropPhenology(num_pcropp, filter_pcropp)
#endif

   ! the same onset and offset routines are called regardless of
   ! phenology type - they depend only on onset_flag, offset_flag, bglfr, and bgtr

   call CNOnsetGrowth(num_soilp, filter_soilp)

   call CNOffsetLitterfall(num_soilp, filter_soilp)

   call CNBackgroundLitterfall(num_soilp, filter_soilp)

   call CNLivewoodTurnover(num_soilp, filter_soilp)

   ! gather all pft-level litterfall fluxes to the column
   ! for litter C and N inputs

   call CNLitterToColumn(num_soilc, filter_soilc)

end subroutine CNPhenology
!-----------------------------------------------------------------------

!-----------------------------------------------------------------------
!BOP
!
! !IROUTINE: CNPhenologyClimate
!
! !INTERFACE:
#if (defined CROP)
subroutine CNPhenologyClimate (num_soilp, filter_soilp, num_pcropp, filter_pcropp)
#else
subroutine CNPhenologyClimate (num_soilp, filter_soilp)
#endif
!
! !DESCRIPTION:
! For coupled carbon-nitrogen code (CN).
!
! !USES:
!   use clm_time_manager, only: get_step_size
      use globals, only : dt
#if (defined CROP)
!   use clm_time_manager, only: get_start_date, get_curr_date
     use globals, only: iyear0,year,month,day,secs  !ylu add
#endif
!
! !ARGUMENTS:
   integer, intent(in) :: num_soilp       ! number of soil pfts in filter
   integer, intent(in) :: filter_soilp(:) ! filter for soil pfts
#if (defined CROP)
   integer, intent(in) :: num_pcropp      ! number of prognostic crops in filter
   integer, intent(in) :: filter_pcropp(:)! filter for prognostic crop pfts
#endif
!
! !CALLED FROM:
! subroutine CNPhenology
!
! !REVISION HISTORY:
! 3/13/07: Created by Peter Thornton
!
! !LOCAL VARIABLES:
! local pointers to implicit in scalars
!
   integer , pointer :: ivt(:)       ! pft vegetation type
   ! ecophysiological constants
   real(r8), pointer :: t_ref2m(:)            ! 2m air temperature (K)
   real(r8), pointer :: tempavg_t2m(:)     ! temp. avg 2m air temperature (K)
#if (defined CROP)
   real(r8), pointer :: gdd0(:)            ! growing deg. days base 0 deg C
   real(r8), pointer :: gdd8(:)            !                        8
   real(r8), pointer :: gdd10(:)           !                       10 (ddays)
   real(r8), pointer :: gdd020(:)          ! 20-yr means of same variables
   real(r8), pointer :: gdd820(:)
   real(r8), pointer :: gdd1020(:)
   real(r8), pointer :: latdeg(:)          ! latitude (radians)
   integer , pointer :: pgridcell(:)       ! pft's gridcell index
#endif
!
! local pointers to implicit in/out scalars
!
!
! local pointers to implicit out scalars
!
! !OTHER LOCAL VARIABLES:
   integer :: p                      ! indices
   integer :: fp             !lake filter pft index
!   real(r8):: dt             !radiation time step delta t (seconds)
   real(r8):: fracday        !dtime as a fraction of day
#if (defined CROP)
!   integer iyear0 ! initial year of initial run
   integer kyr    ! current year
   integer kmo    !         month of year  (1, ..., 12)
   integer kda    !         day of month   (1, ..., 31)
   integer mcsec  !         seconds of day (0, ..., 86400)
#endif
!EOP
!-----------------------------------------------------------------------

   ! assign local pointers to derived type arrays
   ivt       => clm3%g%l%c%p%itype
   t_ref2m                       => clm3%g%l%c%p%pes%t_ref2m
   tempavg_t2m                   => clm3%g%l%c%p%pepv%tempavg_t2m

#if (defined CROP)
   gdd0                          => clm3%g%l%c%p%pps%gdd0
   gdd8                          => clm3%g%l%c%p%pps%gdd8
   gdd10                         => clm3%g%l%c%p%pps%gdd10
   gdd020                        => clm3%g%l%c%p%pps%gdd020
   gdd820                        => clm3%g%l%c%p%pps%gdd820
   gdd1020                       => clm3%g%l%c%p%pps%gdd1020
   latdeg                        => clm3%g%latdeg
   pgridcell                     => clm3%g%l%c%p%gridcell

   ! get time-related info
!ylu removed and add 
!   call get_start_date(iyear0, kmo, kda, mcsec)
!   call get_curr_date (   kyr, kmo, kda, mcsec)
    kyr=year
    kmo=month
    kda=day
    mcsec=secs
    

#endif

   ! set time steps
!ylu removed
!   dt = real( get_step_size(), r8 )
   fracday = dt/86400.0_r8

   do fp = 1,num_soilp
      p = filter_soilp(fp)
	  tempavg_t2m(p) = tempavg_t2m(p) + t_ref2m(p) * (fracday/365._r8)
   end do

! The following lines come from ibis's climate.f + stats.f
! gdd SUMMATIONS ARE RELATIVE TO THE PLANTING DATE (see subr. updateAccFlds)

#if (defined CROP)
   do fp = 1,num_pcropp
      p = filter_pcropp(fp)
          if (kmo == 1 .and. kda == 1 .and. kyr-iyear0 == 0) then ! YR 1:
             gdd020(p)  = 0._r8                                   ! set gdd..20 variables to 0
             gdd820(p)  = 0._r8                                   ! and crops will not be planted
             gdd1020(p) = 0._r8
          end if

          if (kmo == 1 .and. kda == 1 .and. mcsec == 0) then           ! <-- END of EVERY YR:
             if (kyr-iyear0 == 1) then                                 ! <-- END of YR 1
                gdd020(p)  = gdd0(p)                                   ! <-- END of YR 1
                gdd820(p)  = gdd8(p)                                   ! <-- END of YR 1
                gdd1020(p) = gdd10(p)                                  ! <-- END of YR 1
             end if                                                    ! <-- END of YR 1
             gdd020(p)  = (19._r8 * gdd020(p)  + gdd0(p))  / 20._r8 ! gdd..20 must be long term avgs
             gdd820(p)  = (19._r8 * gdd820(p)  + gdd8(p))  / 20._r8 ! so ignore results for yrs 1 & 2
             gdd1020(p) = (19._r8 * gdd1020(p) + gdd10(p)) / 20._r8
          end if
   end do
#endif

end subroutine CNPhenologyClimate
!-----------------------------------------------------------------------

!-----------------------------------------------------------------------
!BOP
!
! !IROUTINE: CNEvergreenPhenology
!
! !INTERFACE:
subroutine CNEvergreenPhenology (num_soilp, filter_soilp)
!
! !DESCRIPTION:
! For coupled carbon-nitrogen code (CN).
!
! !USES:
!
! !ARGUMENTS:
   integer, intent(in) :: num_soilp       ! number of soil pfts in filter
   integer, intent(in) :: filter_soilp(:) ! filter for soil pfts
!
! !CALLED FROM:
! subroutine CNPhenology
!
! !REVISION HISTORY:
! 10/2/03: Created by Peter Thornton
!
! !LOCAL VARIABLES:
! local pointers to implicit in scalars
!
   integer , pointer :: ivt(:)       ! pft vegetation type
   ! ecophysiological constants
   real(r8), pointer :: evergreen(:) ! binary flag for evergreen leaf habit (0 or 1)
   real(r8), pointer :: leaf_long(:) ! leaf longevity (yrs)
!
! local pointers to implicit in/out scalars
!
   real(r8), pointer :: bglfr(:)     ! background litterfall rate (1/s)
   real(r8), pointer :: bgtr(:)      ! background transfer growth rate (1/s)
   real(r8), pointer :: lgsf(:)      ! long growing season factor [0-1]
!
! local pointers to implicit out scalars
!
! !OTHER LOCAL VARIABLES:
   integer :: p                      ! indices
   integer :: fp                     ! lake filter pft index
!EOP
!-----------------------------------------------------------------------

   ! assign local pointers to derived type arrays
   ivt       => clm3%g%l%c%p%itype
   evergreen => pftcon%evergreen
   leaf_long => pftcon%leaf_long
   bglfr     => clm3%g%l%c%p%pepv%bglfr
   bgtr      => clm3%g%l%c%p%pepv%bgtr
   lgsf      => clm3%g%l%c%p%pepv%lgsf

   do fp = 1,num_soilp
      p = filter_soilp(fp)
      if (evergreen(ivt(p)) == 1._r8) then
          bglfr(p) = 1._r8/(leaf_long(ivt(p))*365._r8*86400._r8)
          bgtr(p)  = 0._r8
          lgsf(p)  = 0._r8
      end if
   end do

end subroutine CNEvergreenPhenology
!-----------------------------------------------------------------------

!-----------------------------------------------------------------------
!BOP
!
! !IROUTINE: CNSeasonDecidPhenology
!
! !INTERFACE:
subroutine CNSeasonDecidPhenology (num_soilp, filter_soilp)
!
! !DESCRIPTION:
! For coupled carbon-nitrogen code (CN).
! This routine handles the seasonal deciduous phenology code (temperate
! deciduous vegetation that has only one growing season per year).
!
! !USES:
!ylu removed
!   use clm_time_manager, only: get_step_size
   use globals, only : dt
   use shr_const_mod, only: SHR_CONST_TKFRZ, SHR_CONST_PI
!
! !ARGUMENTS:
   integer, intent(in) :: num_soilp       ! number of soil pfts in filter
   integer, intent(in) :: filter_soilp(:) ! filter for soil pfts
!
! !CALLED FROM:
! subroutine CNPhenology
!
! !REVISION HISTORY:
! 10/6/03: Created by Peter Thornton
! 10/24/03, Peter Thornton: migrated to vector data structures
!
! !LOCAL VARIABLES:
! local pointers to implicit in scalars
   integer , pointer :: ivt(:)                ! pft vegetation type
   integer , pointer :: pcolumn(:)            ! pft's column index
   integer , pointer :: pgridcell(:)          ! pft's gridcell index
   real(r8), pointer :: latdeg(:)             ! latitude (radians)
   real(r8), pointer :: decl(:)               ! solar declination (radians)
   real(r8), pointer :: t_soisno(:,:)         ! soil temperature (Kelvin)  (-nlevsno+1:nlevgrnd)
   real(r8), pointer :: soilpsi(:,:)          ! soil water potential in each soil layer (MPa)
   real(r8), pointer :: leafc_storage(:)      ! (kgC/m2) leaf C storage
   real(r8), pointer :: frootc_storage(:)     ! (kgC/m2) fine root C storage
   real(r8), pointer :: livestemc_storage(:)  ! (kgC/m2) live stem C storage
   real(r8), pointer :: deadstemc_storage(:)  ! (kgC/m2) dead stem C storage
   real(r8), pointer :: livecrootc_storage(:) ! (kgC/m2) live coarse root C storage
   real(r8), pointer :: deadcrootc_storage(:) ! (kgC/m2) dead coarse root C storage
   real(r8), pointer :: gresp_storage(:)      ! (kgC/m2) growth respiration storage
   real(r8), pointer :: leafn_storage(:)      ! (kgN/m2) leaf N storage
   real(r8), pointer :: frootn_storage(:)     ! (kgN/m2) fine root N storage
   real(r8), pointer :: livestemn_storage(:)  ! (kgN/m2) live stem N storage
   real(r8), pointer :: deadstemn_storage(:)  ! (kgN/m2) dead stem N storage
   real(r8), pointer :: livecrootn_storage(:) ! (kgN/m2) live coarse root N storage
   real(r8), pointer :: deadcrootn_storage(:) ! (kgN/m2) dead coarse root N storage
   ! ecophysiological constants
   real(r8), pointer :: season_decid(:) ! binary flag for seasonal-deciduous leaf habit (0 or 1)
   real(r8), pointer :: woody(:)        ! binary flag for woody lifeform (1=woody, 0=not woody)
!
! local pointers to implicit in/out scalars
   real(r8), pointer :: dormant_flag(:)    ! dormancy flag
   real(r8), pointer :: days_active(:)     ! number of days since last dormancy
   real(r8), pointer :: onset_flag(:)      ! onset flag
   real(r8), pointer :: onset_counter(:)   ! onset counter (seconds)
   real(r8), pointer :: onset_gddflag(:)   ! onset freeze flag
   real(r8), pointer :: onset_gdd(:)       ! onset growing degree days
   real(r8), pointer :: offset_flag(:)     ! offset flag
   real(r8), pointer :: offset_counter(:)  ! offset counter (seconds)
   real(r8), pointer :: dayl(:)            ! daylength (seconds)
   real(r8), pointer :: prev_dayl(:)       ! daylength from previous albedo timestep (seconds)
   real(r8), pointer :: annavg_t2m(:)      ! annual average 2m air temperature (K)
   real(r8), pointer :: prev_leafc_to_litter(:)  ! previous timestep leaf C litterfall flux (gC/m2/s)
   real(r8), pointer :: prev_frootc_to_litter(:) ! previous timestep froot C litterfall flux (gC/m2/s)
   real(r8), pointer :: lgsf(:)            ! long growing season factor [0-1]
   real(r8), pointer :: bglfr(:)           ! background litterfall rate (1/s)
   real(r8), pointer :: bgtr(:)            ! background transfer growth rate (1/s)
   real(r8), pointer :: leafc_xfer_to_leafc(:)
   real(r8), pointer :: frootc_xfer_to_frootc(:)
   real(r8), pointer :: livestemc_xfer_to_livestemc(:)
   real(r8), pointer :: deadstemc_xfer_to_deadstemc(:)
   real(r8), pointer :: livecrootc_xfer_to_livecrootc(:)
   real(r8), pointer :: deadcrootc_xfer_to_deadcrootc(:)
   real(r8), pointer :: leafn_xfer_to_leafn(:)
   real(r8), pointer :: frootn_xfer_to_frootn(:)
   real(r8), pointer :: livestemn_xfer_to_livestemn(:)
   real(r8), pointer :: deadstemn_xfer_to_deadstemn(:)
   real(r8), pointer :: livecrootn_xfer_to_livecrootn(:)
   real(r8), pointer :: deadcrootn_xfer_to_deadcrootn(:)
   real(r8), pointer :: leafc_xfer(:)      ! (kgC/m2) leaf C transfer
   real(r8), pointer :: frootc_xfer(:)     ! (kgC/m2) fine root C transfer
   real(r8), pointer :: livestemc_xfer(:)  ! (kgC/m2) live stem C transfer
   real(r8), pointer :: deadstemc_xfer(:)  ! (kgC/m2) dead stem C transfer
   real(r8), pointer :: livecrootc_xfer(:) ! (kgC/m2) live coarse root C transfer
   real(r8), pointer :: deadcrootc_xfer(:) ! (kgC/m2) dead coarse root C transfer
   real(r8), pointer :: leafn_xfer(:)      ! (kgN/m2) leaf N transfer
   real(r8), pointer :: frootn_xfer(:)     ! (kgN/m2) fine root N transfer
   real(r8), pointer :: livestemn_xfer(:)  ! (kgN/m2) live stem N transfer
   real(r8), pointer :: deadstemn_xfer(:)  ! (kgN/m2) dead stem N transfer
   real(r8), pointer :: livecrootn_xfer(:) ! (kgN/m2) live coarse root N transfer
   real(r8), pointer :: deadcrootn_xfer(:) ! (kgN/m2) dead coarse root N transfer
   real(r8), pointer :: leafc_storage_to_xfer(:)
   real(r8), pointer :: frootc_storage_to_xfer(:)
   real(r8), pointer :: livestemc_storage_to_xfer(:)
   real(r8), pointer :: deadstemc_storage_to_xfer(:)
   real(r8), pointer :: livecrootc_storage_to_xfer(:)
   real(r8), pointer :: deadcrootc_storage_to_xfer(:)
   real(r8), pointer :: gresp_storage_to_xfer(:)
   real(r8), pointer :: leafn_storage_to_xfer(:)
   real(r8), pointer :: frootn_storage_to_xfer(:)
   real(r8), pointer :: livestemn_storage_to_xfer(:)
   real(r8), pointer :: deadstemn_storage_to_xfer(:)
   real(r8), pointer :: livecrootn_storage_to_xfer(:)
   real(r8), pointer :: deadcrootn_storage_to_xfer(:)
#if (defined CNDV)
   logical , pointer :: pftmayexist(:)     ! exclude seasonal decid pfts from tropics
#endif
!
! local pointers to implicit out scalars
!
! !OTHER LOCAL VARIABLES:
   integer :: c,p            !indices
   integer :: fp             !lake filter pft index
!   real(r8):: dt             !radiation time step delta t (seconds)
   real(r8):: fracday        !dtime as a fraction of day
   real(r8):: crit_dayl      !critical daylength for offset (seconds)
   real(r8):: ws_flag        !winter-summer solstice flag (0 or 1)
   real(r8):: crit_onset_gdd !critical onset growing degree-day sum
   real(r8):: ndays_on       !number of days to complete onset
   real(r8):: ndays_off      !number of days to complete offset
   real(r8):: soilt
   real(r8):: lat            !latitude (radians)
   real(r8):: temp           !temporary variable for daylength calculation
   real(r8):: fstor2tran     !fraction of storage to move to transfer on each onset

!EOP
!-----------------------------------------------------------------------
   ! Assign local pointers to derived type arrays (in)
   ivt                           => clm3%g%l%c%p%itype
   pcolumn                       => clm3%g%l%c%p%column
   pgridcell                     => clm3%g%l%c%p%gridcell
   latdeg                        => clm3%g%latdeg
   decl                          => clm3%g%l%c%cps%decl
   t_soisno                      => clm3%g%l%c%ces%t_soisno
   leafc_storage                 => clm3%g%l%c%p%pcs%leafc_storage
   frootc_storage                => clm3%g%l%c%p%pcs%frootc_storage
   livestemc_storage             => clm3%g%l%c%p%pcs%livestemc_storage
   deadstemc_storage             => clm3%g%l%c%p%pcs%deadstemc_storage
   livecrootc_storage            => clm3%g%l%c%p%pcs%livecrootc_storage
   deadcrootc_storage            => clm3%g%l%c%p%pcs%deadcrootc_storage
   gresp_storage                 => clm3%g%l%c%p%pcs%gresp_storage
   leafn_storage                 => clm3%g%l%c%p%pns%leafn_storage
   frootn_storage                => clm3%g%l%c%p%pns%frootn_storage
   livestemn_storage             => clm3%g%l%c%p%pns%livestemn_storage
   deadstemn_storage             => clm3%g%l%c%p%pns%deadstemn_storage
   livecrootn_storage            => clm3%g%l%c%p%pns%livecrootn_storage
   deadcrootn_storage            => clm3%g%l%c%p%pns%deadcrootn_storage
   season_decid                  => pftcon%season_decid
   woody                         => pftcon%woody

   ! Assign local pointers to derived type arrays (out)
   dormant_flag                  => clm3%g%l%c%p%pepv%dormant_flag
   days_active                   => clm3%g%l%c%p%pepv%days_active
   onset_flag                    => clm3%g%l%c%p%pepv%onset_flag
   onset_counter                 => clm3%g%l%c%p%pepv%onset_counter
   onset_gddflag                 => clm3%g%l%c%p%pepv%onset_gddflag
   onset_gdd                     => clm3%g%l%c%p%pepv%onset_gdd
   offset_flag                   => clm3%g%l%c%p%pepv%offset_flag
   offset_counter                => clm3%g%l%c%p%pepv%offset_counter
   dayl                          => clm3%g%l%c%p%pepv%dayl
   prev_dayl                     => clm3%g%l%c%p%pepv%prev_dayl
   annavg_t2m                    => clm3%g%l%c%p%pepv%annavg_t2m
   prev_leafc_to_litter          => clm3%g%l%c%p%pepv%prev_leafc_to_litter
   prev_frootc_to_litter         => clm3%g%l%c%p%pepv%prev_frootc_to_litter
   bglfr                         => clm3%g%l%c%p%pepv%bglfr
   bgtr                          => clm3%g%l%c%p%pepv%bgtr
   lgsf                          => clm3%g%l%c%p%pepv%lgsf
   leafc_xfer_to_leafc           => clm3%g%l%c%p%pcf%leafc_xfer_to_leafc
   frootc_xfer_to_frootc         => clm3%g%l%c%p%pcf%frootc_xfer_to_frootc
   livestemc_xfer_to_livestemc   => clm3%g%l%c%p%pcf%livestemc_xfer_to_livestemc
   deadstemc_xfer_to_deadstemc   => clm3%g%l%c%p%pcf%deadstemc_xfer_to_deadstemc
   livecrootc_xfer_to_livecrootc => clm3%g%l%c%p%pcf%livecrootc_xfer_to_livecrootc
   deadcrootc_xfer_to_deadcrootc => clm3%g%l%c%p%pcf%deadcrootc_xfer_to_deadcrootc
   leafn_xfer_to_leafn           => clm3%g%l%c%p%pnf%leafn_xfer_to_leafn
   frootn_xfer_to_frootn         => clm3%g%l%c%p%pnf%frootn_xfer_to_frootn
   livestemn_xfer_to_livestemn   => clm3%g%l%c%p%pnf%livestemn_xfer_to_livestemn
   deadstemn_xfer_to_deadstemn   => clm3%g%l%c%p%pnf%deadstemn_xfer_to_deadstemn
   livecrootn_xfer_to_livecrootn => clm3%g%l%c%p%pnf%livecrootn_xfer_to_livecrootn
   deadcrootn_xfer_to_deadcrootn => clm3%g%l%c%p%pnf%deadcrootn_xfer_to_deadcrootn
   leafc_xfer                    => clm3%g%l%c%p%pcs%leafc_xfer
   frootc_xfer                   => clm3%g%l%c%p%pcs%frootc_xfer
   livestemc_xfer                => clm3%g%l%c%p%pcs%livestemc_xfer
   deadstemc_xfer                => clm3%g%l%c%p%pcs%deadstemc_xfer
   livecrootc_xfer               => clm3%g%l%c%p%pcs%livecrootc_xfer
   deadcrootc_xfer               => clm3%g%l%c%p%pcs%deadcrootc_xfer
   leafn_xfer                    => clm3%g%l%c%p%pns%leafn_xfer
   frootn_xfer                   => clm3%g%l%c%p%pns%frootn_xfer
   livestemn_xfer                => clm3%g%l%c%p%pns%livestemn_xfer
   deadstemn_xfer                => clm3%g%l%c%p%pns%deadstemn_xfer
   livecrootn_xfer               => clm3%g%l%c%p%pns%livecrootn_xfer
   deadcrootn_xfer               => clm3%g%l%c%p%pns%deadcrootn_xfer
   leafc_storage_to_xfer         => clm3%g%l%c%p%pcf%leafc_storage_to_xfer
   frootc_storage_to_xfer        => clm3%g%l%c%p%pcf%frootc_storage_to_xfer
   livestemc_storage_to_xfer     => clm3%g%l%c%p%pcf%livestemc_storage_to_xfer
   deadstemc_storage_to_xfer     => clm3%g%l%c%p%pcf%deadstemc_storage_to_xfer
   livecrootc_storage_to_xfer    => clm3%g%l%c%p%pcf%livecrootc_storage_to_xfer
   deadcrootc_storage_to_xfer    => clm3%g%l%c%p%pcf%deadcrootc_storage_to_xfer
   gresp_storage_to_xfer         => clm3%g%l%c%p%pcf%gresp_storage_to_xfer
   leafn_storage_to_xfer         => clm3%g%l%c%p%pnf%leafn_storage_to_xfer
   frootn_storage_to_xfer        => clm3%g%l%c%p%pnf%frootn_storage_to_xfer
   livestemn_storage_to_xfer     => clm3%g%l%c%p%pnf%livestemn_storage_to_xfer
   deadstemn_storage_to_xfer     => clm3%g%l%c%p%pnf%deadstemn_storage_to_xfer
   livecrootn_storage_to_xfer    => clm3%g%l%c%p%pnf%livecrootn_storage_to_xfer
   deadcrootn_storage_to_xfer    => clm3%g%l%c%p%pnf%deadcrootn_storage_to_xfer
#if (defined CNDV)
   pftmayexist                   => clm3%g%l%c%p%pdgvs%pftmayexist
#endif

   ! set time steps
!   dt = real( get_step_size(), r8 )
   fracday = dt/86400.0_r8

   ! critical daylength from Biome-BGC, v4.1.2
   crit_dayl = 39300._r8
   ndays_on = 30._r8
   ndays_off = 15._r8

   ! transfer parameters
   fstor2tran = 0.5_r8

   ! start pft loop
   do fp = 1,num_soilp
      p = filter_soilp(fp)
      c = pcolumn(p)

      if (season_decid(ivt(p)) == 1._r8) then

         ! set background litterfall rate, background transfer rate, and
         ! long growing season factor to 0 for seasonal deciduous types
         bglfr(p) = 0._r8
         bgtr(p) = 0._r8
         lgsf(p) = 0._r8

         ! onset gdd sum from Biome-BGC, v4.1.2
         crit_onset_gdd = exp(4.8_r8 + 0.13_r8*(annavg_t2m(p) - SHR_CONST_TKFRZ))

         ! use solar declination information stored during Surface Albedo()
         ! and latitude from gps to calcluate daylength (convert latitude from degrees to radians)
         ! the constant 13750.9871 is the number of seconds per radian of hour-angle

         prev_dayl(p) = dayl(p)
         lat = (SHR_CONST_PI/180._r8)*latdeg(pgridcell(p))
         temp = -(sin(lat)*sin(decl(c)))/(cos(lat) * cos(decl(c)))
         temp = min(1._r8,max(-1._r8,temp))
         dayl(p) = 2.0_r8 * 13750.9871_r8 * acos(temp)

         ! set flag for solstice period (winter->summer = 1, summer->winter = 0)
         if (dayl(p) >= prev_dayl(p)) then
            ws_flag = 1._r8
         else
            ws_flag = 0._r8
         end if

         ! update offset_counter and test for the end of the offset period
         if (offset_flag(p) == 1.0_r8) then
            ! decrement counter for offset period
            offset_counter(p) = offset_counter(p) - dt

            ! if this is the end of the offset_period, reset phenology
            ! flags and indices
            if (offset_counter(p) == 0.0_r8) then
               ! this code block was originally handled by call cn_offset_cleanup(p)
               ! inlined during vectorization

               offset_flag(p) = 0._r8
               offset_counter(p) = 0._r8
               dormant_flag(p) = 1._r8
               days_active(p) = 0._r8
#if (defined CNDV)
               pftmayexist(p) = .true.
#endif

               ! reset the previous timestep litterfall flux memory
               prev_leafc_to_litter(p) = 0._r8
               prev_frootc_to_litter(p) = 0._r8
            end if
         end if

         ! update onset_counter and test for the end of the onset period
         if (onset_flag(p) == 1.0_r8) then
            ! decrement counter for onset period
            onset_counter(p) = onset_counter(p) - dt

            ! if this is the end of the onset period, reset phenology
            ! flags and indices
            if (onset_counter(p) == 0.0_r8) then
               ! this code block was originally handled by call cn_onset_cleanup(p)
               ! inlined during vectorization

               onset_flag(p) = 0.0_r8
               onset_counter(p) = 0.0_r8
               ! set all transfer growth rates to 0.0
               leafc_xfer_to_leafc(p)   = 0.0_r8
               frootc_xfer_to_frootc(p) = 0.0_r8
               leafn_xfer_to_leafn(p)   = 0.0_r8
               frootn_xfer_to_frootn(p) = 0.0_r8
               if (woody(ivt(p)) == 1.0_r8) then
                  livestemc_xfer_to_livestemc(p)   = 0.0_r8
                  deadstemc_xfer_to_deadstemc(p)   = 0.0_r8
                  livecrootc_xfer_to_livecrootc(p) = 0.0_r8
                  deadcrootc_xfer_to_deadcrootc(p) = 0.0_r8
                  livestemn_xfer_to_livestemn(p)   = 0.0_r8
                  deadstemn_xfer_to_deadstemn(p)   = 0.0_r8
                  livecrootn_xfer_to_livecrootn(p) = 0.0_r8
                  deadcrootn_xfer_to_deadcrootn(p) = 0.0_r8
               end if
               ! set transfer pools to 0.0
               leafc_xfer(p) = 0.0_r8
               leafn_xfer(p) = 0.0_r8
               frootc_xfer(p) = 0.0_r8
               frootn_xfer(p) = 0.0_r8
               if (woody(ivt(p)) == 1.0_r8) then
                  livestemc_xfer(p) = 0.0_r8
                  livestemn_xfer(p) = 0.0_r8
                  deadstemc_xfer(p) = 0.0_r8
                  deadstemn_xfer(p) = 0.0_r8
                  livecrootc_xfer(p) = 0.0_r8
                  livecrootn_xfer(p) = 0.0_r8
                  deadcrootc_xfer(p) = 0.0_r8
                  deadcrootn_xfer(p) = 0.0_r8
               end if
            end if
         end if

         ! test for switching from dormant period to growth period
         if (dormant_flag(p) == 1.0_r8) then

            ! Test to turn on growing degree-day sum, if off.
            ! switch on the growing degree day sum on the winter solstice

            if (onset_gddflag(p) == 0._r8 .and. ws_flag == 1._r8) then
               onset_gddflag(p) = 1._r8
               onset_gdd(p) = 0._r8
            end if

            ! Test to turn off growing degree-day sum, if on.
            ! This test resets the growing degree day sum if it gets past
            ! the summer solstice without reaching the threshold value.
            ! In that case, it will take until the next winter solstice
            ! before the growing degree-day summation starts again.

            if (onset_gddflag(p) == 1._r8 .and. ws_flag == 0._r8) then
               onset_gddflag(p) = 0._r8
               onset_gdd(p) = 0._r8
            end if

            ! if the gdd flag is set, and if the soil is above freezing
            ! then accumulate growing degree days for onset trigger

            soilt = t_soisno(c,3)
            if (onset_gddflag(p) == 1.0_r8 .and. soilt > SHR_CONST_TKFRZ) then
               onset_gdd(p) = onset_gdd(p) + (soilt-SHR_CONST_TKFRZ)*fracday
            end if

            ! set onset_flag if critical growing degree-day sum is exceeded
            if (onset_gdd(p) > crit_onset_gdd) then
               onset_flag(p) = 1.0_r8
               dormant_flag(p) = 0.0_r8
               onset_gddflag(p) = 0.0_r8
               onset_gdd(p) = 0.0_r8
               onset_counter(p) = ndays_on * 86400.0_r8

               ! move all the storage pools into transfer pools,
               ! where they will be transfered to displayed growth over the onset period.
               ! this code was originally handled with call cn_storage_to_xfer(p)
               ! inlined during vectorization

               ! set carbon fluxes for shifting storage pools to transfer pools
               leafc_storage_to_xfer(p)  = fstor2tran * leafc_storage(p)/dt
               frootc_storage_to_xfer(p) = fstor2tran * frootc_storage(p)/dt
               if (woody(ivt(p)) == 1.0_r8) then
                  livestemc_storage_to_xfer(p)  = fstor2tran * livestemc_storage(p)/dt
                  deadstemc_storage_to_xfer(p)  = fstor2tran * deadstemc_storage(p)/dt
                  livecrootc_storage_to_xfer(p) = fstor2tran * livecrootc_storage(p)/dt
                  deadcrootc_storage_to_xfer(p) = fstor2tran * deadcrootc_storage(p)/dt
                  gresp_storage_to_xfer(p)      = fstor2tran * gresp_storage(p)/dt
               end if

               ! set nitrogen fluxes for shifting storage pools to transfer pools
               leafn_storage_to_xfer(p)  = fstor2tran * leafn_storage(p)/dt
               frootn_storage_to_xfer(p) = fstor2tran * frootn_storage(p)/dt
               if (woody(ivt(p)) == 1.0_r8) then
                  livestemn_storage_to_xfer(p)  = fstor2tran * livestemn_storage(p)/dt
                  deadstemn_storage_to_xfer(p)  = fstor2tran * deadstemn_storage(p)/dt
                  livecrootn_storage_to_xfer(p) = fstor2tran * livecrootn_storage(p)/dt
                  deadcrootn_storage_to_xfer(p) = fstor2tran * deadcrootn_storage(p)/dt
               end if
            end if

         ! test for switching from growth period to offset period
         else if (offset_flag(p) == 0.0_r8) then
#if (defined CNDV)
            ! If days_active > 355, then remove pft in
            ! CNDVEstablishment at the end of the year.
            ! days_active > 355 is a symptom of seasonal decid. pfts occurring in
            ! gridcells where dayl never drops below crit_dayl.
            ! This results in TLAI>1e4 in a few gridcells.
            days_active(p) = days_active(p) + fracday
            if (days_active(p) > 355._r8) pftmayexist(p) = .false.
#endif

            ! only begin to test for offset daylength once past the summer sol
            if (ws_flag == 0._r8 .and. dayl(p) < crit_dayl) then
               offset_flag(p) = 1._r8
               offset_counter(p) = ndays_off * 86400.0_r8
               prev_leafc_to_litter(p) = 0._r8
               prev_frootc_to_litter(p) = 0._r8
            end if
         end if

      end if ! end if seasonal deciduous

   end do ! end of pft loop

end subroutine CNSeasonDecidPhenology
!-----------------------------------------------------------------------

!-----------------------------------------------------------------------
!BOP
!
! !IROUTINE: CNStressDecidPhenology
!
! !INTERFACE:
subroutine CNStressDecidPhenology (num_soilp, filter_soilp)
!
! !DESCRIPTION:
! This routine handles phenology for vegetation types, such as grasses and
! tropical drought deciduous trees, that respond to cold and drought stress
! signals and that can have multiple growing seasons in a given year.
! This routine allows for the possibility that leaves might persist year-round
! in the absence of a suitable stress trigger, by switching to an essentially
! evergreen habit, but maintaining a deciduous leaf longevity, while waiting
! for the next stress trigger.  This is in contrast to the seasonal deciduous
! algorithm (for temperate deciduous trees) that forces a single growing season
! per year.
!
! !USES:
!   use clm_time_manager, only: get_step_size
    use globals, only : dt
   use shr_const_mod, only: SHR_CONST_TKFRZ, SHR_CONST_PI
!
! !ARGUMENTS:
   integer, intent(in) :: num_soilp       ! number of soil pfts in filter
   integer, intent(in) :: filter_soilp(:) ! filter for soil pfts
!
! !CALLED FROM:
! subroutine CNPhenology
!
! !REVISION HISTORY:
! 10/27/03: Created by Peter Thornton
! 01/29/04: Made onset_gdd critical sum a function of temperature, as in
!           seasonal deciduous algorithm.
!
! !LOCAL VARIABLES:
! local pointers to implicit in scalars
!
   integer , pointer :: ivt(:)                ! pft vegetation type
   integer , pointer :: pcolumn(:)            ! pft's column index
   integer , pointer :: pgridcell(:)          ! pft's gridcell index
   real(r8), pointer :: latdeg(:)             ! latitude (degree)
   real(r8), pointer :: decl(:)               ! solar declination (radians)
   real(r8), pointer :: leafc_storage(:)      ! (kgC/m2) leaf C storage
   real(r8), pointer :: frootc_storage(:)     ! (kgC/m2) fine root C storage
   real(r8), pointer :: livestemc_storage(:)  ! (kgC/m2) live stem C storage
   real(r8), pointer :: deadstemc_storage(:)  ! (kgC/m2) dead stem C storage
   real(r8), pointer :: livecrootc_storage(:) ! (kgC/m2) live coarse root C storage
   real(r8), pointer :: deadcrootc_storage(:) ! (kgC/m2) dead coarse root C storage
   real(r8), pointer :: gresp_storage(:)      ! (kgC/m2) growth respiration storage
   real(r8), pointer :: leafn_storage(:)      ! (kgN/m2) leaf N storage
   real(r8), pointer :: frootn_storage(:)     ! (kgN/m2) fine root N storage
   real(r8), pointer :: livestemn_storage(:)  ! (kgN/m2) live stem N storage
   real(r8), pointer :: deadstemn_storage(:)  ! (kgN/m2) dead stem N storage
   real(r8), pointer :: livecrootn_storage(:) ! (kgN/m2) live coarse root N storage
   real(r8), pointer :: deadcrootn_storage(:) ! (kgN/m2) dead coarse root N storage
   real(r8), pointer :: t_soisno(:,:)         ! soil temperature (Kelvin)  (-nlevsno+1:nlevgrnd)
   real(r8), pointer :: soilpsi(:,:)          ! soil water potential in each soil layer (MPa)
   real(r8), pointer :: leaf_long(:)          ! leaf longevity (yrs)
   real(r8), pointer :: stress_decid(:)       ! binary flag for stress-deciduous leaf habit (0 or 1)
   real(r8), pointer :: woody(:)              ! binary flag for woody lifeform (1=woody, 0=not woody)

!
! local pointers to implicit in/out scalars
!
   real(r8), pointer :: dormant_flag(:)    ! dormancy flag
   real(r8), pointer :: days_active(:)     ! number of days since last dormancy
   real(r8), pointer :: onset_flag(:)      ! onset flag
   real(r8), pointer :: onset_counter(:)   ! onset counter (seconds)
   real(r8), pointer :: onset_gddflag(:)   ! onset flag for growing degree day sum
   real(r8), pointer :: onset_fdd(:)       ! onset freezing degree days counter
   real(r8), pointer :: onset_gdd(:)       ! onset growing degree days
   real(r8), pointer :: onset_swi(:)       ! onset soil water index
   real(r8), pointer :: offset_flag(:)     ! offset flag
   real(r8), pointer :: offset_counter(:)  ! offset counter (seconds)
   real(r8), pointer :: dayl(:)            ! daylength (seconds)
   real(r8), pointer :: offset_fdd(:)      ! offset freezing degree days counter
   real(r8), pointer :: offset_swi(:)      ! offset soil water index
   real(r8), pointer :: annavg_t2m(:)      ! annual average 2m air temperature (K)
   real(r8), pointer :: lgsf(:)            ! long growing season factor [0-1]
   real(r8), pointer :: bglfr(:)           ! background litterfall rate (1/s)
   real(r8), pointer :: bgtr(:)            ! background transfer growth rate (1/s)
   real(r8), pointer :: prev_leafc_to_litter(:)  ! previous timestep leaf C litterfall flux (gC/m2/s)
   real(r8), pointer :: prev_frootc_to_litter(:) ! previous timestep froot C litterfall flux (gC/m2/s)
   real(r8), pointer :: leafc_xfer_to_leafc(:)
   real(r8), pointer :: frootc_xfer_to_frootc(:)
   real(r8), pointer :: livestemc_xfer_to_livestemc(:)
   real(r8), pointer :: deadstemc_xfer_to_deadstemc(:)
   real(r8), pointer :: livecrootc_xfer_to_livecrootc(:)
   real(r8), pointer :: deadcrootc_xfer_to_deadcrootc(:)
   real(r8), pointer :: leafn_xfer_to_leafn(:)
   real(r8), pointer :: frootn_xfer_to_frootn(:)
   real(r8), pointer :: livestemn_xfer_to_livestemn(:)
   real(r8), pointer :: deadstemn_xfer_to_deadstemn(:)
   real(r8), pointer :: livecrootn_xfer_to_livecrootn(:)
   real(r8), pointer :: deadcrootn_xfer_to_deadcrootn(:)
   real(r8), pointer :: leafc_xfer(:)      ! (kgC/m2) leaf C transfer
   real(r8), pointer :: frootc_xfer(:)     ! (kgC/m2) fine root C transfer
   real(r8), pointer :: livestemc_xfer(:)  ! (kgC/m2) live stem C transfer
   real(r8), pointer :: deadstemc_xfer(:)  ! (kgC/m2) dead stem C transfer
   real(r8), pointer :: livecrootc_xfer(:) ! (kgC/m2) live coarse root C transfer
   real(r8), pointer :: deadcrootc_xfer(:) ! (kgC/m2) dead coarse root C transfer
   real(r8), pointer :: leafn_xfer(:)      ! (kgN/m2) leaf N transfer
   real(r8), pointer :: frootn_xfer(:)     ! (kgN/m2) fine root N transfer
   real(r8), pointer :: livestemn_xfer(:)  ! (kgN/m2) live stem N transfer
   real(r8), pointer :: deadstemn_xfer(:)  ! (kgN/m2) dead stem N transfer
   real(r8), pointer :: livecrootn_xfer(:) ! (kgN/m2) live coarse root N transfer
   real(r8), pointer :: deadcrootn_xfer(:) ! (kgN/m2) dead coarse root N transfer
   real(r8), pointer :: leafc_storage_to_xfer(:)
   real(r8), pointer :: frootc_storage_to_xfer(:)
   real(r8), pointer :: livestemc_storage_to_xfer(:)
   real(r8), pointer :: deadstemc_storage_to_xfer(:)
   real(r8), pointer :: livecrootc_storage_to_xfer(:)
   real(r8), pointer :: deadcrootc_storage_to_xfer(:)
   real(r8), pointer :: gresp_storage_to_xfer(:)
   real(r8), pointer :: leafn_storage_to_xfer(:)
   real(r8), pointer :: frootn_storage_to_xfer(:)
   real(r8), pointer :: livestemn_storage_to_xfer(:)
   real(r8), pointer :: deadstemn_storage_to_xfer(:)
   real(r8), pointer :: livecrootn_storage_to_xfer(:)
   real(r8), pointer :: deadcrootn_storage_to_xfer(:)
!
! local pointers to implicit out scalars
!
!
! !OTHER LOCAL VARIABLES:
   integer :: c,p             ! indices
   integer :: fp              ! lake filter pft index
   real(r8):: fracday         ! dtime as a fraction of day
!   real(r8):: dt              ! radiation time step delta t (seconds)
   real(r8):: crit_onset_fdd  ! critical number of freezing days
   real(r8):: crit_onset_gdd  ! degree days for onset trigger
   real(r8):: crit_offset_fdd ! critical number of freezing degree days
                              ! to trigger offset
   real(r8):: crit_onset_swi  ! water stress days for offset trigger
   real(r8):: crit_offset_swi ! water stress days for offset trigger
   real(r8):: soilpsi_on      ! water potential for onset trigger (MPa)
   real(r8):: soilpsi_off     ! water potential for offset trigger (MPa)
   real(r8):: ndays_on        ! number of days to complete onset
   real(r8):: ndays_off       ! number of days to complete offset
   real(r8):: soilt           ! temperature of top soil layer
   real(r8):: psi             ! water stress of top soil layer
   real(r8):: lat             !latitude (radians)
   real(r8):: temp            !temporary variable for daylength calculation
   real(r8):: fstor2tran      ! fraction of storage to move to transfer
                              ! on each onset
!EOP
!-----------------------------------------------------------------------
   ! Assign local pointers to derived type arrays (in)
    ivt                            => clm3%g%l%c%p%itype
    pcolumn                        => clm3%g%l%c%p%column
    pgridcell                      => clm3%g%l%c%p%gridcell
    latdeg                         => clm3%g%latdeg
    decl                           => clm3%g%l%c%cps%decl
    leafc_storage                  => clm3%g%l%c%p%pcs%leafc_storage
    frootc_storage                 => clm3%g%l%c%p%pcs%frootc_storage
    livestemc_storage              => clm3%g%l%c%p%pcs%livestemc_storage
    deadstemc_storage              => clm3%g%l%c%p%pcs%deadstemc_storage
    livecrootc_storage             => clm3%g%l%c%p%pcs%livecrootc_storage
    deadcrootc_storage             => clm3%g%l%c%p%pcs%deadcrootc_storage
    gresp_storage                  => clm3%g%l%c%p%pcs%gresp_storage
    leafn_storage                  => clm3%g%l%c%p%pns%leafn_storage
    frootn_storage                 => clm3%g%l%c%p%pns%frootn_storage
    livestemn_storage              => clm3%g%l%c%p%pns%livestemn_storage
    deadstemn_storage              => clm3%g%l%c%p%pns%deadstemn_storage
    livecrootn_storage             => clm3%g%l%c%p%pns%livecrootn_storage
    deadcrootn_storage             => clm3%g%l%c%p%pns%deadcrootn_storage
    soilpsi                        => clm3%g%l%c%cps%soilpsi
    t_soisno                       => clm3%g%l%c%ces%t_soisno
    leaf_long                      => pftcon%leaf_long
    woody                          => pftcon%woody
    stress_decid                   => pftcon%stress_decid

   ! Assign local pointers to derived type arrays (out)
    dormant_flag                   => clm3%g%l%c%p%pepv%dormant_flag
    days_active                    => clm3%g%l%c%p%pepv%days_active
    onset_flag                     => clm3%g%l%c%p%pepv%onset_flag
    onset_counter                  => clm3%g%l%c%p%pepv%onset_counter
    onset_gddflag                  => clm3%g%l%c%p%pepv%onset_gddflag
    onset_fdd                      => clm3%g%l%c%p%pepv%onset_fdd
    onset_gdd                      => clm3%g%l%c%p%pepv%onset_gdd
    onset_swi                      => clm3%g%l%c%p%pepv%onset_swi
    offset_flag                    => clm3%g%l%c%p%pepv%offset_flag
    offset_counter                 => clm3%g%l%c%p%pepv%offset_counter
    dayl                           => clm3%g%l%c%p%pepv%dayl
    offset_fdd                     => clm3%g%l%c%p%pepv%offset_fdd
    offset_swi                     => clm3%g%l%c%p%pepv%offset_swi
    annavg_t2m                     => clm3%g%l%c%p%pepv%annavg_t2m
    prev_leafc_to_litter           => clm3%g%l%c%p%pepv%prev_leafc_to_litter
    prev_frootc_to_litter          => clm3%g%l%c%p%pepv%prev_frootc_to_litter
    lgsf                           => clm3%g%l%c%p%pepv%lgsf
    bglfr                          => clm3%g%l%c%p%pepv%bglfr
    bgtr                           => clm3%g%l%c%p%pepv%bgtr
    leafc_xfer_to_leafc            => clm3%g%l%c%p%pcf%leafc_xfer_to_leafc
    frootc_xfer_to_frootc          => clm3%g%l%c%p%pcf%frootc_xfer_to_frootc
    livestemc_xfer_to_livestemc    => clm3%g%l%c%p%pcf%livestemc_xfer_to_livestemc
    deadstemc_xfer_to_deadstemc    => clm3%g%l%c%p%pcf%deadstemc_xfer_to_deadstemc
    livecrootc_xfer_to_livecrootc  => clm3%g%l%c%p%pcf%livecrootc_xfer_to_livecrootc
    deadcrootc_xfer_to_deadcrootc  => clm3%g%l%c%p%pcf%deadcrootc_xfer_to_deadcrootc
    leafn_xfer_to_leafn            => clm3%g%l%c%p%pnf%leafn_xfer_to_leafn
    frootn_xfer_to_frootn          => clm3%g%l%c%p%pnf%frootn_xfer_to_frootn
    livestemn_xfer_to_livestemn    => clm3%g%l%c%p%pnf%livestemn_xfer_to_livestemn
    deadstemn_xfer_to_deadstemn    => clm3%g%l%c%p%pnf%deadstemn_xfer_to_deadstemn
    livecrootn_xfer_to_livecrootn  => clm3%g%l%c%p%pnf%livecrootn_xfer_to_livecrootn
    deadcrootn_xfer_to_deadcrootn  => clm3%g%l%c%p%pnf%deadcrootn_xfer_to_deadcrootn
    leafc_xfer                     => clm3%g%l%c%p%pcs%leafc_xfer
    frootc_xfer                    => clm3%g%l%c%p%pcs%frootc_xfer
    livestemc_xfer                 => clm3%g%l%c%p%pcs%livestemc_xfer
    deadstemc_xfer                 => clm3%g%l%c%p%pcs%deadstemc_xfer
    livecrootc_xfer                => clm3%g%l%c%p%pcs%livecrootc_xfer
    deadcrootc_xfer                => clm3%g%l%c%p%pcs%deadcrootc_xfer
    leafn_xfer                     => clm3%g%l%c%p%pns%leafn_xfer
    frootn_xfer                    => clm3%g%l%c%p%pns%frootn_xfer
    livestemn_xfer                 => clm3%g%l%c%p%pns%livestemn_xfer
    deadstemn_xfer                 => clm3%g%l%c%p%pns%deadstemn_xfer
    livecrootn_xfer                => clm3%g%l%c%p%pns%livecrootn_xfer
    deadcrootn_xfer                => clm3%g%l%c%p%pns%deadcrootn_xfer
    leafc_storage_to_xfer          => clm3%g%l%c%p%pcf%leafc_storage_to_xfer
    frootc_storage_to_xfer         => clm3%g%l%c%p%pcf%frootc_storage_to_xfer
    livestemc_storage_to_xfer      => clm3%g%l%c%p%pcf%livestemc_storage_to_xfer
    deadstemc_storage_to_xfer      => clm3%g%l%c%p%pcf%deadstemc_storage_to_xfer
    livecrootc_storage_to_xfer     => clm3%g%l%c%p%pcf%livecrootc_storage_to_xfer
    deadcrootc_storage_to_xfer     => clm3%g%l%c%p%pcf%deadcrootc_storage_to_xfer
    gresp_storage_to_xfer          => clm3%g%l%c%p%pcf%gresp_storage_to_xfer
    leafn_storage_to_xfer          => clm3%g%l%c%p%pnf%leafn_storage_to_xfer
    frootn_storage_to_xfer         => clm3%g%l%c%p%pnf%frootn_storage_to_xfer
    livestemn_storage_to_xfer      => clm3%g%l%c%p%pnf%livestemn_storage_to_xfer
    deadstemn_storage_to_xfer      => clm3%g%l%c%p%pnf%deadstemn_storage_to_xfer
    livecrootn_storage_to_xfer     => clm3%g%l%c%p%pnf%livecrootn_storage_to_xfer
    deadcrootn_storage_to_xfer     => clm3%g%l%c%p%pnf%deadcrootn_storage_to_xfer

   ! set time steps
!   dt = real( get_step_size(), r8 )
   fracday = dt/86400.0_r8

   ! set some local parameters - these will be moved into
   ! parameter file after testing

   ! onset parameters
   crit_onset_fdd = 15.0_r8
   ! critical onset gdd now being calculated as a function of annual
   ! average 2m temp.
   ! crit_onset_gdd = 150.0 ! c3 grass value
   ! crit_onset_gdd = 1000.0   ! c4 grass value
   crit_onset_swi = 15.0_r8
   soilpsi_on = -2.0_r8
   ndays_on = 30.0_r8

   ! offset parameters
   crit_offset_fdd = 15.0_r8
   crit_offset_swi = 15.0_r8
   soilpsi_off = -2.0_r8
   ndays_off = 15.0_r8

   ! transfer parameters
   fstor2tran = 0.5_r8

   do fp = 1,num_soilp
      p = filter_soilp(fp)
      c = pcolumn(p)

      if (stress_decid(ivt(p)) == 1._r8) then
         soilt = t_soisno(c,3)
         psi = soilpsi(c,3)

         ! use solar declination information stored during Surface Albedo()
         ! and latitude from gps to calcluate daylength (convert latitude from degrees to radians)
         ! the constant 13750.9871 is the number of seconds per radian of hour-angle

         lat = (SHR_CONST_PI/180._r8)*latdeg(pgridcell(p))
         temp = -(sin(lat)*sin(decl(c)))/(cos(lat) * cos(decl(c)))
         temp = min(1._r8,max(-1._r8,temp))
         dayl(p) = 2.0_r8 * 13750.9871_r8 * acos(temp)

         ! onset gdd sum from Biome-BGC, v4.1.2
         crit_onset_gdd = exp(4.8_r8 + 0.13_r8*(annavg_t2m(p) - SHR_CONST_TKFRZ))


         ! update offset_counter and test for the end of the offset period
         if (offset_flag(p) == 1._r8) then
            ! decrement counter for offset period
            offset_counter(p) = offset_counter(p) - dt

            ! if this is the end of the offset_period, reset phenology
            ! flags and indices
            if (offset_counter(p) == 0._r8) then
               ! this code block was originally handled by call cn_offset_cleanup(p)
               ! inlined during vectorization
               offset_flag(p) = 0._r8
               offset_counter(p) = 0._r8
               dormant_flag(p) = 1._r8
               days_active(p) = 0._r8

               ! reset the previous timestep litterfall flux memory
               prev_leafc_to_litter(p) = 0._r8
               prev_frootc_to_litter(p) = 0._r8
            end if
         end if

         ! update onset_counter and test for the end of the onset period
         if (onset_flag(p) == 1.0_r8) then
            ! decrement counter for onset period
            onset_counter(p) = onset_counter(p) - dt

            ! if this is the end of the onset period, reset phenology
            ! flags and indices
            if (onset_counter(p) == 0.0_r8) then
               ! this code block was originally handled by call cn_onset_cleanup(p)
               ! inlined during vectorization
               onset_flag(p) = 0._r8
               onset_counter(p) = 0._r8
               ! set all transfer growth rates to 0.0
               leafc_xfer_to_leafc(p)   = 0._r8
               frootc_xfer_to_frootc(p) = 0._r8
               leafn_xfer_to_leafn(p)   = 0._r8
               frootn_xfer_to_frootn(p) = 0._r8
               if (woody(ivt(p)) == 1.0_r8) then
                  livestemc_xfer_to_livestemc(p)   = 0._r8
                  deadstemc_xfer_to_deadstemc(p)   = 0._r8
                  livecrootc_xfer_to_livecrootc(p) = 0._r8
                  deadcrootc_xfer_to_deadcrootc(p) = 0._r8
                  livestemn_xfer_to_livestemn(p)   = 0._r8
                  deadstemn_xfer_to_deadstemn(p)   = 0._r8
                  livecrootn_xfer_to_livecrootn(p) = 0._r8
                  deadcrootn_xfer_to_deadcrootn(p) = 0._r8
               end if
               ! set transfer pools to 0.0
               leafc_xfer(p) = 0._r8
               leafn_xfer(p) = 0._r8
               frootc_xfer(p) = 0._r8
               frootn_xfer(p) = 0._r8
               if (woody(ivt(p)) == 1.0_r8) then
                  livestemc_xfer(p) = 0._r8
                  livestemn_xfer(p) = 0._r8
                  deadstemc_xfer(p) = 0._r8
                  deadstemn_xfer(p) = 0._r8
                  livecrootc_xfer(p) = 0._r8
                  livecrootn_xfer(p) = 0._r8
                  deadcrootc_xfer(p) = 0._r8
                  deadcrootn_xfer(p) = 0._r8
               end if
            end if
         end if

         ! test for switching from dormant period to growth period
         if (dormant_flag(p) == 1._r8) then

            ! keep track of the number of freezing degree days in this
            ! dormancy period (only if the freeze flag has not previously been set
            ! for this dormancy period

            if (onset_gddflag(p) == 0._r8 .and. soilt < SHR_CONST_TKFRZ) onset_fdd(p) = onset_fdd(p) + fracday

            ! if the number of freezing degree days exceeds a critical value,
            ! then onset will require both wet soils and a critical soil
            ! temperature sum.  If this case is triggered, reset any previously
            ! accumulated value in onset_swi, so that onset now depends on
            ! the accumulated soil water index following the freeze trigger

            if (onset_fdd(p) > crit_onset_fdd) then
                onset_gddflag(p) = 1._r8
                onset_fdd(p) = 0._r8
                onset_swi(p) = 0._r8
            end if

            ! if the freeze flag is set, and if the soil is above freezing
            ! then accumulate growing degree days for onset trigger

            if (onset_gddflag(p) == 1._r8 .and. soilt > SHR_CONST_TKFRZ) then
               onset_gdd(p) = onset_gdd(p) + (soilt-SHR_CONST_TKFRZ)*fracday
            end if

            ! if soils are wet, accumulate soil water index for onset trigger
            if (psi >= soilpsi_on) onset_swi(p) = onset_swi(p) + fracday

            ! if critical soil water index is exceeded, set onset_flag, and
            ! then test for soil temperature criteria

            if (onset_swi(p) > crit_onset_swi) then
                onset_flag(p) = 1._r8

                ! only check soil temperature criteria if freeze flag set since
                ! beginning of last dormancy.  If freeze flag set and growing
                ! degree day sum (since freeze trigger) is lower than critical
                ! value, then override the onset_flag set from soil water.

                if (onset_gddflag(p) == 1._r8 .and. onset_gdd(p) < crit_onset_gdd) onset_flag(p) = 0._r8
            end if
            
            ! only allow onset if dayl > 6hrs
            if (onset_flag(p) == 1._r8 .and. dayl(p) <= 21600._r8) then
                onset_flag(p) = 0._r8
            end if

            ! if this is the beginning of the onset period
            ! then reset the phenology flags and indices

            if (onset_flag(p) == 1._r8) then
               dormant_flag(p) = 0._r8
               days_active(p) = 0._r8
               onset_gddflag(p) = 0._r8
               onset_fdd(p) = 0._r8
               onset_gdd(p) = 0._r8
               onset_swi(p) = 0._r8
               onset_counter(p) = ndays_on * 86400._r8

               ! call subroutine to move all the storage pools into transfer pools,
               ! where they will be transfered to displayed growth over the onset period.
               ! this code was originally handled with call cn_storage_to_xfer(p)
               ! inlined during vectorization

               ! set carbon fluxes for shifting storage pools to transfer pools
               leafc_storage_to_xfer(p)  = fstor2tran * leafc_storage(p)/dt
               frootc_storage_to_xfer(p) = fstor2tran * frootc_storage(p)/dt
               if (woody(ivt(p)) == 1.0_r8) then
                  livestemc_storage_to_xfer(p)  = fstor2tran * livestemc_storage(p)/dt
                  deadstemc_storage_to_xfer(p)  = fstor2tran * deadstemc_storage(p)/dt
                  livecrootc_storage_to_xfer(p) = fstor2tran * livecrootc_storage(p)/dt
                  deadcrootc_storage_to_xfer(p) = fstor2tran * deadcrootc_storage(p)/dt
                  gresp_storage_to_xfer(p)      = fstor2tran * gresp_storage(p)/dt
               end if

               ! set nitrogen fluxes for shifting storage pools to transfer pools
               leafn_storage_to_xfer(p)  = fstor2tran * leafn_storage(p)/dt
               frootn_storage_to_xfer(p) = fstor2tran * frootn_storage(p)/dt
               if (woody(ivt(p)) == 1.0_r8) then
                  livestemn_storage_to_xfer(p)  = fstor2tran * livestemn_storage(p)/dt
                  deadstemn_storage_to_xfer(p)  = fstor2tran * deadstemn_storage(p)/dt
                  livecrootn_storage_to_xfer(p) = fstor2tran * livecrootn_storage(p)/dt
                  deadcrootn_storage_to_xfer(p) = fstor2tran * deadcrootn_storage(p)/dt
               end if
            end if

         ! test for switching from growth period to offset period
         else if (offset_flag(p) == 0._r8) then

            ! if soil water potential lower than critical value, accumulate
            ! as stress in offset soil water index

            if (psi <= soilpsi_off) then
               offset_swi(p) = offset_swi(p) + fracday

               ! if the offset soil water index exceeds critical value, and
               ! if this is not the middle of a previously initiated onset period,
               ! then set flag to start the offset period and reset index variables

               if (offset_swi(p) >= crit_offset_swi .and. onset_flag(p) == 0._r8) offset_flag(p) = 1._r8

            ! if soil water potential higher than critical value, reduce the
            ! offset water stress index.  By this mechanism, there must be a
            ! sustained period of water stress to initiate offset.

            else if (psi >= soilpsi_on) then
               offset_swi(p) = offset_swi(p) - fracday
               offset_swi(p) = max(offset_swi(p),0._r8)
            end if

            ! decrease freezing day accumulator for warm soil
            if (offset_fdd(p) > 0._r8 .and. soilt > SHR_CONST_TKFRZ) then
                offset_fdd(p) = offset_fdd(p) - fracday
                offset_fdd(p) = max(0._r8, offset_fdd(p))
            end if

            ! increase freezing day accumulator for cold soil
            if (soilt <= SHR_CONST_TKFRZ) then
               offset_fdd(p) = offset_fdd(p) + fracday

               ! if freezing degree day sum is greater than critical value, initiate offset
               if (offset_fdd(p) > crit_offset_fdd .and. onset_flag(p) == 0._r8) offset_flag(p) = 1._r8
            end if
            
            ! force offset if daylength is < 6 hrs
            if (dayl(p) <= 21600._r8) then
            	offset_flag(p) = 1._r8
            end if

            ! if this is the beginning of the offset period
            ! then reset flags and indices
            if (offset_flag(p) == 1._r8) then
               offset_fdd(p) = 0._r8
               offset_swi(p) = 0._r8
               offset_counter(p) = ndays_off * 86400._r8
               prev_leafc_to_litter(p) = 0._r8
               prev_frootc_to_litter(p) = 0._r8
            end if
         end if

         ! keep track of number of days since last dormancy for control on
         ! fraction of new growth to send to storage for next growing season

         if (dormant_flag(p) == 0.0_r8) then
             days_active(p) = days_active(p) + fracday
         end if

         ! calculate long growing season factor (lgsf)
         ! only begin to calculate a lgsf greater than 0.0 once the number
         ! of days active exceeds 365.
         lgsf(p) = max(min((days_active(p)-365._r8)/365._r8, 1._r8),0._r8)

         ! set background litterfall rate, when not in the phenological offset period
         if (offset_flag(p) == 1._r8) then
            bglfr(p) = 0._r8
         else
            ! calculate the background litterfall rate (bglfr)
            ! in units 1/s, based on leaf longevity (yrs) and correction for long growing season

            bglfr(p) = (1._r8/(leaf_long(ivt(p))*365._r8*86400._r8))*lgsf(p)
         end if

         ! set background transfer rate when active but not in the phenological onset period
         if (onset_flag(p) == 1._r8) then
            bgtr(p) = 0._r8
         else
            ! the background transfer rate is calculated as the rate that would result
            ! in complete turnover of the storage pools in one year at steady state,
            ! once lgsf has reached 1.0 (after 730 days active).

            bgtr(p) = (1._r8/(365._r8*86400._r8))*lgsf(p)

            ! set carbon fluxes for shifting storage pools to transfer pools

            leafc_storage_to_xfer(p)  = leafc_storage(p) * bgtr(p)
            frootc_storage_to_xfer(p) = frootc_storage(p) * bgtr(p)
            if (woody(ivt(p)) == 1.0_r8) then
               livestemc_storage_to_xfer(p)  = livestemc_storage(p) * bgtr(p)
               deadstemc_storage_to_xfer(p)  = deadstemc_storage(p) * bgtr(p)
               livecrootc_storage_to_xfer(p) = livecrootc_storage(p) * bgtr(p)
               deadcrootc_storage_to_xfer(p) = deadcrootc_storage(p) * bgtr(p)
               gresp_storage_to_xfer(p)      = gresp_storage(p) * bgtr(p)
            end if

            ! set nitrogen fluxes for shifting storage pools to transfer pools
            leafn_storage_to_xfer(p)  = leafn_storage(p) * bgtr(p)
            frootn_storage_to_xfer(p) = frootn_storage(p) * bgtr(p)
            if (woody(ivt(p)) == 1.0_r8) then
               livestemn_storage_to_xfer(p)  = livestemn_storage(p) * bgtr(p)
               deadstemn_storage_to_xfer(p)  = deadstemn_storage(p) * bgtr(p)
               livecrootn_storage_to_xfer(p) = livecrootn_storage(p) * bgtr(p)
               deadcrootn_storage_to_xfer(p) = deadcrootn_storage(p) * bgtr(p)
            end if
         end if

      end if ! end if stress deciduous

   end do ! end of pft loop

end subroutine CNStressDecidPhenology
!-----------------------------------------------------------------------

!-----------------------------------------------------------------------
#if (defined CROP)
!BOP
!
! !IROUTINE: CropPhenology
!
! !INTERFACE:
subroutine CropPhenology(num_pcropp, filter_pcropp)

! !DESCRIPTION:
! Code from AgroIBIS to determine crop phenology and code from CN to
! handle CN fluxes during the phenological onset & offset periods.

! !USES:
!  use clm_time_manager, only : get_curr_date, get_curr_calday, get_step_size
    use globals, only: dt,secs,year,month,day,calday
   use pftvarcon       , only : ncorn, nswheat, nwwheat, nsoybean, gddmin, hybgdd, lfemerg, grnfill, mxmat


! !ARGUMENTS:
  integer, intent(in) :: num_pcropp       ! number of prog crop pfts in filter
  integer, intent(in) :: filter_pcropp(:) ! filter for prognostic crop pfts

! !CALLED FROM:
! subroutine CNPhenology
!
! !REVISION HISTORY:
! 2/5/08:  slevis created according to AgroIBIS subroutines of Kucharik et al.
! 7/14/08: slevis adapted crop cycles to southern hemisphere

! local variables

      integer kyr       ! current year
      integer kmo       !         month of year  (1, ..., 12)
      integer kda       !         day of month   (1, ..., 31)
      integer mcsec     !         seconds of day (0, ..., 86400)
      integer jday      ! julian day of the year
      integer fp,p      ! pft indices
      integer c         ! column indices
      integer g         ! gridcell indices
      integer idpp      ! number of days past planting
      integer pmmin     ! earliest month to plant winter wheat
      integer pdmin     ! earliest day in earliest month to plant
      integer pmmax     ! latest possible month (month) and
      integer pdmax     ! latest day in latest month to plant
!      real(r8) dt       ! radiation time step delta t (seconds)
      real(r8) pmintemp ! max 5-day avg min temp for planting winter wheat; else min 10-day avg min (K)
      real(r8) ptemp    ! min 10-day avg temp for planting (K)
      real(r8) crmcorn

! pointers

      integer , pointer :: pgridcell(:)! pft's gridcell index
      integer , pointer :: pcolumn(:)  ! pft's column index
      integer , pointer :: ivt(:)      ! pft
      integer , pointer :: idop(:)     ! date of planting
      integer , pointer :: harvdate(:) ! harvest date
      integer , pointer :: croplive(:) ! planted, not harvested = 1; else 0
      integer , pointer :: cropplant(:)! crop may be planted = 0; else = 1
      real(r8), pointer :: gddmaturity(:) ! gdd needed to harvest
      real(r8), pointer :: huileaf(:)  ! heat unit index needed from planting to leaf emergence
      real(r8), pointer :: huigrain(:) ! same to reach vegetative maturity
      real(r8), pointer :: hui(:)      ! =gdd since planting (gddplant)
      real(r8), pointer :: leafout(:)  ! =gdd from top soil layer temperature
      real(r8), pointer :: tlai(:)        ! one-sided leaf area index, no burying by snow
      real(r8), pointer :: gdd020(:)
      real(r8), pointer :: gdd820(:)
      real(r8), pointer :: gdd1020(:)
      real(r8), pointer :: a5tmin(:)
      real(r8), pointer :: a10tmin(:)
      real(r8), pointer :: t10(:)
      real(r8), pointer :: cumvd(:)    ! cumulative vernalization d?ependence?
      real(r8), pointer :: hdidx(:)    ! cold hardening index?
      real(r8), pointer :: vf(:)       ! vernalization factor
      real(r8), pointer :: t_ref2m_min(:)
      real(r8), pointer :: bglfr(:)    ! background litterfall rate (1/s)
      real(r8), pointer :: bgtr(:)     ! background transfer growth rate (1/s)
      real(r8), pointer :: lgsf(:)     ! long growing season factor [0-1]
      real(r8), pointer :: onset_flag(:)     ! onset flag
      real(r8), pointer :: offset_flag(:)    ! offset flag
      real(r8), pointer :: onset_counter(:)  ! onset counter
      real(r8), pointer :: offset_counter(:) ! offset counter
      real(r8), pointer :: leaf_long(:)      ! leaf longevity (yrs)
      real(r8), pointer :: leafc_xfer(:)
      real(r8), pointer :: leafn_xfer(:)
      real(r8), pointer :: leafcn(:)         ! leaf C:N (gC/gN)
      real(r8), pointer :: dwt_seedc_to_leaf(:) !
      real(r8), pointer :: dwt_seedn_to_leaf(:) !
      real(r8), pointer :: latdeg(:)            ! latitude (radians)

      pgridcell      => clm3%g%l%c%p%gridcell
      pcolumn        => clm3%g%l%c%p%column
      ivt            => clm3%g%l%c%p%itype
      idop           => clm3%g%l%c%p%pps%idop
      harvdate       => clm3%g%l%c%p%pps%harvdate
      croplive       => clm3%g%l%c%p%pps%croplive
      cropplant      => clm3%g%l%c%p%pps%cropplant
      gddmaturity    => clm3%g%l%c%p%pps%gddmaturity
      huileaf        => clm3%g%l%c%p%pps%huileaf
      huigrain       => clm3%g%l%c%p%pps%huigrain
      hui            => clm3%g%l%c%p%pps%gddplant
      leafout        => clm3%g%l%c%p%pps%gddtsoi
      tlai           => clm3%g%l%c%p%pps%tlai
      gdd020         => clm3%g%l%c%p%pps%gdd020
      gdd820         => clm3%g%l%c%p%pps%gdd820
      gdd1020        => clm3%g%l%c%p%pps%gdd1020
      a5tmin         => clm3%g%l%c%p%pps%a5tmin
      a10tmin        => clm3%g%l%c%p%pps%a10tmin
      t10            => clm3%g%l%c%p%pdgvs%t10
      cumvd          => clm3%g%l%c%p%pps%cumvd
      hdidx          => clm3%g%l%c%p%pps%hdidx
      vf             => clm3%g%l%c%p%pps%vf
      t_ref2m_min    => clm3%g%l%c%p%pes%t_ref2m_min
      bglfr          => clm3%g%l%c%p%pepv%bglfr
      bgtr           => clm3%g%l%c%p%pepv%bgtr
      lgsf           => clm3%g%l%c%p%pepv%lgsf
      onset_flag     => clm3%g%l%c%p%pepv%onset_flag
      offset_flag    => clm3%g%l%c%p%pepv%offset_flag
      onset_counter  => clm3%g%l%c%p%pepv%onset_counter
      offset_counter => clm3%g%l%c%p%pepv%offset_counter
      leafc_xfer     => clm3%g%l%c%p%pcs%leafc_xfer
      leafn_xfer     => clm3%g%l%c%p%pns%leafn_xfer
      leaf_long      => pftcon%leaf_long
      leafcn         => pftcon%leafcn
      dwt_seedc_to_leaf => clm3%g%l%c%ccf%dwt_seedc_to_leaf
      dwt_seedn_to_leaf => clm3%g%l%c%cnf%dwt_seedn_to_leaf
      latdeg            => clm3%g%latdeg

! ---------------------------------------
!ylu removed and add
      ! get time info
!      dt = get_step_size()
!      jday = get_curr_calday()
!      call get_curr_date(kyr, kmo, kda, mcsec)
      
      jday=calday
      kyr=year
      kmo=month
      kda=day
      mcsec=secs    

!ylu end

! irotation = 4 => harvest >= 1crops/yr; harvest & other vars may need to chg
! for irotation>0 to work; for now assume unchanging crops from yr to yr except
! when moving to a new surface-data file at which point I would start the run
! clean, ie reset everything assuming no memory of the past; this may be a
! problem if we switch surface-data files while certain grid cells are in the
! middle of their growing season. Any relevant issues for the SH? (slevis)

      call rotation() ! here? in do-loop as rotation(p)? elsewhere? call 1/yr (slevis)

      do fp = 1, num_pcropp
         p = filter_pcropp(fp)
         c = pcolumn(p)
         g = pgridcell(p)

         ! background litterfall and transfer rates; long growing season factor

         bglfr(p) = 0._r8 ! this value changes later in a crop's life cycle
         bgtr(p)  = 0._r8
         lgsf(p)  = 0._r8

         ! ---------------------------------
         ! from AgroIBIS subroutine planting
         ! ---------------------------------

         ! in order to allow a crop to be planted only once each year
         ! initialize cropplant = 0, but hold it = 1 through the end of the year

         ! initialize other variables that are calculated for crops
         ! on an annual basis in cropresidue subroutine

         if ((jday ==   1 .and. mcsec == 0 .and. latdeg(g) >= 0._r8) .or. & ! NH
             (jday == 182 .and. mcsec == 0 .and. latdeg(g) < 0._r8 )) then  ! SH

            ! make sure variables aren't changed at beginning of the year
            ! for a crop that is currently planted (e.g. winter wheat)

            if (croplive(p) == 0)  then
               cropplant(p) = 0
               idop(p)      = 999

               ! keep next for continuous, annual winter wheat type crop;
               ! if we removed elseif,
               ! winter wheat grown continuously would amount to a wheat/fallow
               ! rotation because wheat would only be planted every other year

            else if (croplive(p) == 1 .and. ivt(p) == nwwheat) then
               cropplant(p) = 0
!           else ! not possible to have croplive==1 and ivt==cornORsoy? (slevis)
            end if

         end if

         if (croplive(p) == 0 .and. cropplant(p) == 0) then

            ! gdd needed for * chosen crop and a likely hybrid (for that region) *
            ! to reach full physiological maturity

            ! based on accumulated seasonal average growing degree days from
            ! April 1 - Sept 30 (inclusive)
            ! for corn and soybeans in the United States -
            ! decided upon by what the typical average growing season length is
            ! and the gdd needed to reach maturity in those regions

            ! first choice is used for spring wheat and/or soybeans and maize

            ! slevis: ibis reads xinpdate in io.f from control.crops.nc variable name 'plantdate'
            !         According to Chris Kucharik, the dataset of
            !         xinpdate was generated from a previous model run at 0.5 deg resolution

            ! winter wheat : use gdd0 as a limit to plant winter wheat

            if (ivt(p) == nwwheat) then

               ! minimum temperature required for crop planting and vegetative growth
               ! from EPIC model parameterizations

               ! the planting range in the US for maize is typically from April 10 - May 10
               ! the most active planting date in US for soybean is typically May 15 - June 20
               ! spring wheat planting dates are typically early April through mid-May
               ! in line with maize
               ! winter wheat is from Sept. 1 through early Nov., and is typically planted
               ! within 10-14 days of the first likely frost event.

               ! typically winter wheat is planted when ave min temperature gets
               ! to about 40 F and is planted no later than November

               ! slevis: added distinction between NH and SH

               if (latdeg(g) >= 0._r8) then
                  pmmin = 9
                  pmmax = 11
               else
                  pmmin = 3
                  pmmax = 5
               end if
               pdmin    = 1
               pdmax    = 30
               pmintemp = tfrz + 5._r8

               ! add check to only plant winter wheat after other crops (soybean, maize)
               ! have been harvested

               ! *** remember order of planting is crucial - in terms of which crops you want
               ! to be grown in what order ***

               ! in this case, corn or soybeans are assumed to be planted before
               ! wheat would be in any particular year that both pfts are allowed
               ! to grow in the same grid cell (e.g., double-cropping)

               ! slevis: harvdate below needs cropplant(p)==0 above to be cropplant(p,ivt(p))==0
               !         where ivt(p) has rotated to winter wheat because
               !         cropplant == 1 through the end of the year for a harvested crop.
               !         Also harvdate(p) should be harvdate(p,ivt(p)) and should be
               !         updated on Jan 1st instead of at harvest (slevis)
               if (a5tmin(p)             <= pmintemp .and. &
                   kmo                   >= pmmin    .and. &
                   kda                   >= pdmin    .and.(&
                   irotation            == 0       ).and. &
                   gdd020(p)             >= gddmin(ivt(p))) then

                  cumvd(p)       = 0._r8
                  hdidx(p)       = 0._r8
                  vf(p)          = 0._r8
                  croplive(p)    = 1
                  cropplant(p)   = 1
                  idop(p)        = jday
                  harvdate(p)    = 999
                  gddmaturity(p) = hybgdd(ivt(p))
                  leafc_xfer(p) = 1._r8 ! initial seed at planting to appear
                  leafn_xfer(p) = leafc_xfer(p) / leafcn(ivt(p)) ! with onset
                  dwt_seedc_to_leaf(c) = dwt_seedc_to_leaf(c) + leafc_xfer(p)/dt
                  dwt_seedn_to_leaf(c) = dwt_seedn_to_leaf(c) + leafn_xfer(p)/dt

                  ! latest possible date to plant winter wheat and after all other crops were harvested for that year
                  ! slevis: same comments concerning cropplant & harvdate
                  ! slevis: this is not how I would have written this if-elseif statement
                  !         to plant winter wheat between Sep 1st and Nov 30th. Chris
                  !         explains that the else if ensures winter wheat planting by
                  !         Nov 30th if the a5tmin limit is not achieved. I'm probably stuck
                  !         on the kmo>= and kda>= which suggest to me any date after Nov 29th.
                  !         I think they could have been kmo== and kda== and worked the same.
                  !         It may also reduce confusion to separate parts of the if statement.
                  !         Eg, harvdate, irotation, and gdd020 do not change as the kmo and kda
                  !         statements switch from false to true and are common to the if part
                  !         of the statement.

               else if (kmo                   >=  pmmax .and. &
                        kda                   >=  pdmax .and.(&
                         irotation            == 0     ).and. &
                        gdd020(p)             >= gddmin(ivt(p))) then

                  cumvd(p)       = 0._r8
                  hdidx(p)       = 0._r8
                  vf(p)          = 0._r8
                  croplive(p)    = 1
                  cropplant(p)   = 1
                  idop(p)        = jday
                  harvdate(p)    = 999
                  gddmaturity(p) = hybgdd(ivt(p))
                  leafc_xfer(p) = 1._r8 ! initial seed at planting to appear
                  leafn_xfer(p) = leafc_xfer(p) / leafcn(ivt(p)) ! with onset
                  dwt_seedc_to_leaf(c) = dwt_seedc_to_leaf(c) + leafc_xfer(p)/dt
                  dwt_seedn_to_leaf(c) = dwt_seedn_to_leaf(c) + leafn_xfer(p)/dt
               else
                  gddmaturity(p) = 0._r8
               end if

            else ! not winter wheat... slevis: added distinction between NH and SH
               if (ivt(p) == nsoybean) then
                  if (latdeg(g) >= 0._r8) then
                     pmmin = 5
                     pmmax = 6
                  else
                     pmmin = 11
                     pmmax = 12
                  end if
                  pmintemp = tfrz + 6._r8
                  ptemp = tfrz + 13._r8
               else if (ivt(p) == ncorn) then
                  if (latdeg(g) >= 0._r8) then
                     pmmin = 4
                     pmmax = 6
                  else
                     pmmin = 10
                     pmmax = 12
                  end if
                  pmintemp = tfrz + 6._r8
                  ptemp = tfrz + 10._r8
               else if (ivt(p) == nswheat) then
                  if (latdeg(g) >= 0._r8) then
                     pmmin = 4
                     pmmax = 6
                  else
                     pmmin = 10
                     pmmax = 12
                  end if
                  pmintemp = tfrz - 1._r8
                  ptemp = tfrz + 7._r8
               end if
               pdmin = 1
               pdmax = 15

               ! slevis: the jday if statement confused me in a similar way to the one before.
               !         The idea is that jday will equal idop sooner or later in the year
               !         while the gdd part is either true or false for the year.
               !         Replace the jday if statement with the more complete but commented out one from AgroIBIS
               if (t10(p) > ptemp .and. a10tmin(p) > pmintemp .and. &
                   kmo >= pmmin .and. kda >= pdmin .and.            &
                   kmo <= pmmax .and. gdd820(p) >= gddmin(ivt(p))) then

                  ! impose limit on growing season length needed
                  ! for crop maturity - for cold weather constraints
                  croplive(p)  = 1
                  cropplant(p) = 1
                  idop(p)      = jday
                  harvdate(p)  = 999

                  ! go a specified amount of time before/after
                  ! climatological date
                  if (ivt(p)==nsoybean) gddmaturity(p)=min(gdd1020(p),hybgdd(ivt(p)))
                  if (ivt(p)==ncorn) then
                     gddmaturity(p)=max(950._r8, min(gdd820(p)*0.85_r8, hybgdd(ivt(p))))
                     gddmaturity(p)=max(950._r8, min(gddmaturity(p)+150._r8,1850._r8))
                  end if
                  if (ivt(p)==nswheat) gddmaturity(p)=min(gdd020(p),hybgdd(ivt(p)))

                  leafc_xfer(p) = 1._r8 ! initial seed at planting to appear
                  leafn_xfer(p) = leafc_xfer(p) / leafcn(ivt(p)) ! with onset
                  dwt_seedc_to_leaf(c) = dwt_seedc_to_leaf(c) + leafc_xfer(p)/dt
                  dwt_seedn_to_leaf(c) = dwt_seedn_to_leaf(c) + leafn_xfer(p)/dt

               else if (kmo == pmmax .and. kda == pdmax .and. gdd820(p) > 0._r8) then
                  croplive(p)  = 1
                  cropplant(p) = 1
                  idop(p)      = jday
                  harvdate(p)  = 999

                  if (ivt(p)==nsoybean) gddmaturity(p)=min(gdd1020(p),hybgdd(ivt(p)))
                  if (ivt(p)==ncorn) gddmaturity(p)=max(950._r8, min(gdd820(p)*0.85_r8, hybgdd(ivt(p))))
                  if (ivt(p)==nswheat) gddmaturity(p)=min(gdd020(p),hybgdd(ivt(p)))

                  leafc_xfer(p) = 1._r8 ! initial seed at planting to appear
                  leafn_xfer(p) = leafc_xfer(p) / leafcn(ivt(p)) ! with onset
                  dwt_seedc_to_leaf(c) = dwt_seedc_to_leaf(c) + leafc_xfer(p)/dt
                  dwt_seedn_to_leaf(c) = dwt_seedn_to_leaf(c) + leafn_xfer(p)/dt

               else
                  gddmaturity(p) = 0._r8
               end if
            end if ! crop pft distinction

            ! crop phenology (gdd thresholds) controlled by gdd needed for
            ! maturity (physiological) which is based on the average gdd
            ! accumulation and hybrids in United States from April 1 - Sept 30

            ! calculate threshold from phase 1 to phase 2:
            ! threshold for attaining leaf emergence (based on fraction of
            ! gdd(i) -- climatological average)
            ! Hayhoe and Dwyer, 1990, Can. J. Soil Sci 70:493-497
            ! Carlson and Gage, 1989, Agric. For. Met., 45: 313-324
            ! J.T. Ritchie, 1991: Modeling Plant and Soil systems

            huileaf(p) = lfemerg(ivt(p)) * gddmaturity(p) ! 3-7% in wheat

            ! calculate threshhold from phase 2 to phase 3:
            ! from leaf emergence to beginning of grain-fill period
            ! this hypothetically occurs at the end of tassling, not the beginning
            ! tassel initiation typically begins at 0.5-0.55 * gddmaturity

            ! calculate linear relationship between huigrain fraction and relative
            ! maturity rating for maize

            if (ivt(p) == ncorn) then
               crmcorn = max(73._r8, min(135._r8, (gddmaturity(p)+ 53.683_r8)/13.882_r8))
               huigrain(p) = -0.002_r8  * (crmcorn - 73._r8) + grnfill(ivt(p))
               huigrain(p) = min(max(huigrain(p), grnfill(ivt(p))-0.1_r8), grnfill(ivt(p)))
               huigrain(p) = huigrain(p) * gddmaturity(p)     ! Cabelguenne et
            else
               huigrain(p) = grnfill(ivt(p)) * gddmaturity(p) ! al. 1999
            end if

         end if ! crop not live nor planted

         ! ----------------------------------
         ! from AgroIBIS subroutine phenocrop
         ! ----------------------------------

         ! all of the phenology changes are based on the total number of gdd needed
         ! to change to the next phase - based on fractions of the total gdd typical
         ! for  that region based on the April 1 - Sept 30 window of development

         ! crop phenology (gdd thresholds) controlled by gdd needed for
         ! maturity (physiological) which is based on the average gdd
         ! accumulation and hybrids in United States from April 1 - Sept 30
         
         ! Phase 1: Planting to leaf emergence (now in CNAllocation)
         ! Phase 2: Leaf emergence to beginning of grain fill (general LAI accumulation)
         ! Phase 3: Grain fill to physiological maturity and harvest (LAI decline)
         ! Harvest: if gdd past grain fill initiation exceeds limit
         ! or number of days past planting reaches a maximum, the crop has
         ! reached physiological maturity and plant is harvested;
         ! crop could be live or dead at this stage - these limits
         ! could lead to reaching physiological maturity or determining
         ! a harvest date for a crop killed by an early frost (see next comments)
         ! --- --- ---
         ! keeping comments without the code (slevis):
         ! if minimum temperature, t_ref2m_min <= freeze kill threshold, tkill
         ! for 3 consecutive days and lai is above a minimum,
         ! plant will be damaged/killed. This function is more for spring freeze events
         ! or for early fall freeze events

         ! spring wheat is affected by this, winter wheat kill function
         ! is determined in crops.f - is a more elaborate function of
         ! cold hardening of the plant

         ! currently simulates too many grid cells killed by freezing temperatures

         ! removed on March 12 2002 - C. Kucharik
         ! until it can be a bit more refined, or used at a smaller scale.
         ! we really have no way of validating this routine
         ! too difficult to implement on 0.5 degree scale grid cells
         ! --- --- ---

         onset_flag(p)  = 0._r8 ! CN terminology to trigger certain
         offset_flag(p) = 0._r8 ! carbon and nitrogen transfers

         if (croplive(p) == 1) then

            ! call vernalization if winter wheat planted, living, and the
            ! vernalization factor is not 1;
            ! vf affects the calculation of gddtsoi & gddplant

            if (t_ref2m_min(p) < 1.e30_r8 .and. vf(p) /= 1._r8 .and. ivt(p) == nwwheat) then
               call vernalization(p)
            end if

            ! days past planting may determine harvest

            if (jday >= idop(p)) then
               idpp = jday - idop(p)
            else
               idpp = 365+jday - idop(p)
            end if

            ! onset_counter initialized to zero when croplive == 0
            ! offset_counter relevant only at time step of harvest

            onset_counter(p) = onset_counter(p) - dt

            ! enter phase 2 onset for one time step:
            ! transfer seed carbon to leaf emergence

            if (leafout(p) >= huileaf(p) .and. hui(p) < huigrain(p) .and. idpp < mxmat(ivt(p))) then
               if (abs(onset_counter(p)) > 1.e-6_r8) then
                  onset_flag(p)    = 1._r8
                  onset_counter(p) = dt
               else
                  onset_counter(p) = dt ! ensure no re-entry to onset of phase2
               end if

            ! enter harvest for one time step:
            ! - transfer live biomass to litter and to crop yield
            ! - send xsmrpool to the atmosphere
            ! if onset and harvest needed to last longer than one timestep
            ! the onset_counter would change from dt and you'd need to make
            ! changes to the offset subroutine below

            else if (hui(p) >= gddmaturity(p) .or. idpp >= mxmat(ivt(p))) then
               if (harvdate(p) == 999) harvdate(p) = jday
               croplive(p) = 0           ! no re-entry in greater if-block
               if (tlai(p) > 0._r8) then ! plant had emerged before harvest
                  offset_flag(p) = 1._r8
                  offset_counter(p) = dt
               else                      ! plant never emerged from the ground
                  dwt_seedc_to_leaf(c) = dwt_seedc_to_leaf(c) - leafc_xfer(p)/dt
                  dwt_seedn_to_leaf(c) = dwt_seedn_to_leaf(c) - leafn_xfer(p)/dt
                  leafc_xfer(p) = 0._r8  ! revert planting transfers
                  leafn_xfer(p) = leafc_xfer(p) / leafcn(ivt(p))
               end if

            ! enter phase 3 while previous criteria fail and next is true;
            ! in terms of order, phase 3 occurs before harvest, but when
            ! harvest *can* occur, we want it to have first priority.
            ! AgroIBIS uses a complex formula for lai decline.
            ! Use CN's simple formula at least as a place holder (slevis)

            else if (hui(p) >= huigrain(p)) then
               bglfr(p) = 1._r8/(leaf_long(ivt(p))*365._r8*86400._r8)
            end if

         else   ! crop not live
            onset_counter(p) = 0._r8
            leafc_xfer(p) = 0._r8
            leafn_xfer(p) = leafc_xfer(p) / leafcn(ivt(p))
         end if ! croplive is 1 or 0

      end do ! prognostic crops loop

end subroutine CropPhenology
!-----------------------------------------------------------------------

!-----------------------------------------------------------------------
!BOP
!
! !IROUTINE: rotation
!
! !INTERFACE:
  subroutine rotation() ! uncomment when ready (slevis)

! subroutine used to plant different crop types in different years
! to simulate typical crop rotations in the United States
! could be modified in future if rotations would include natural
! vegetation types such as grasslands or biofuel (switchgrass) crops
!
! currently three main types of rotations are used
! if irotation ==
! 2: maize/soybean rotation (alternating)
! 3: maize/soybean/spring wheat
! 4: soybean/winter wheat/maize
!
! note: by doing continuous winter wheat, land is fallow
! only from harvest (june-july) through planting (Sept-Nov).

    !USES:
!   use clm_time_manager, only : get_curr_date

! local variables

!     real(r8) xfrac

!     integer  kyr    ! year
!     integer  kmo    ! month (1, ..., 12)
!     integer  kda    ! day of month (1, ..., 31)
!     integer  mcsec  ! current seconds of current date (0, ..., 86400)
!     integer  iyrrot
!     integer  idiv
!     integer  p

!     integer irotation

! pointers

!     integer , pointer :: ivt(:) !plant functional type (value from 0:numpft)

!     ivt        => clm3%g%l%c%p%itype

! begin grid
! in this case, irotation also is the number of crops in a specified rotation
! slevis: except when irotation = 4
!
! assumes that natural vegetation existence arrays are set to 0.0
! in climate.f (existence)

! look at the fraction remainder to determine which crop should
! be planted

!     if (irotation == 1) idiv = 3
!     if (irotation == 2) idiv = 2
!     if (irotation == 3) idiv = 3
!     if (irotation == 4) idiv = 3

! In orig code, if not restart, iyrrot=1950. Why? Fert data starts at 1945.
! Else iyrrot=irstyear, but why not = base year?
! With iyrrot=irstyear I think xfrac will reset at every restart.
! In any case, we need to get irstyear to calc xfrac. (slevis)

!     write(11,*) 'irstyear =', irstyear
!     call shr_sys_flush(11)
!     iyrrot = irstyear
!     call get_curr_date(kyr, kmo, kda, mcsec)
!     xfrac = mod ((kyr - iyrrot), idiv)

!     do p = begp, endp ! replace two lines with crop filter
!        if (crop(ivt(p)) == 1.) then

! 2:
! two-crop rotation (standard soybean/corn)
! alternate between even / odd years

!           if (irotation == 2) then
!              if (xfrac == 0.0) then
!                 ivt(p) = ncorn
!              else
!                 ivt(p) = nsoybean
!              end if
! 3:
! rotation with 3 crops (corn, soybean, spring wheat)

!           else if (irotation == 3) then
!              if (xfrac == 0.0) then
!                 ivt(p) = nsoybean
!              else if (xfrac == 1.0) then
!                 ivt(p) = ncorn
!              else
!                 ivt(p) = nswheat
!              end if

! 4:
! 3 crop rotation with winter wheat and soybean planted in same year
! winter wheat harvested in year 2
! maize grown in year 3

!           else if (irotation == 4) then

! soybean planted/harvested
! winter wheat planted

!              if (xfrac == 0.0) then
!                 ivt(p) = nsoybean ! NB: ivt(p) (+ other vars?) must change at
!!                ivt(p) = nwwheat  !     harvest of the first crop; slevis
                                    !     FOR NOW irotation=4 NOT USED
! winter wheat harvested in year 2

!              else if (xfrac == 1.0) then
!                 ivt(p) = nwwheat

! maize planted/harvested in year 3

!              else
!                 ivt(p) = ncorn
!              end if

!           end if
!        end if
!     end do

  end subroutine rotation
!-----------------------------------------------------------------------

!-----------------------------------------------------------------------
!BOP
!
! !IROUTINE: vernalization
!
! !INTERFACE:
  subroutine vernalization(p)

! * * * only call for winter wheat * * *
!
! subroutine calculates vernalization and photoperiod effects on
! gdd accumulation in winter wheat varieties. Thermal time accumulation
! is reduced in 1st period until plant is fully vernalized. During this
! time of emergence to spikelet formation, photoperiod can also have a
! drastic effect on plant development.

! local variables

      real(r8) p1d, p1v
      real(r8) tcrown
      real(r8) vd, vd1, vd2
      real(r8) tkil, tbase
      real(r8) hti

      integer  c,g
      integer, intent(in) :: p

! pointers

      integer , pointer :: pcolumn(:)  ! pft's column index
      integer , pointer :: croplive(:)
      real(r8), pointer :: hdidx(:)
      real(r8), pointer :: cumvd(:)
      real(r8), pointer :: vf(:)
      real(r8), pointer :: gddmaturity(:) ! gdd needed to harvest
      real(r8), pointer :: huigrain(:)    ! heat unit index needed to reach vegetative maturity
      real(r8), pointer :: tlai(:)        ! one-sided leaf area index, no burying by snow
      real(r8), pointer :: t_ref2m(:)
      real(r8), pointer :: t_ref2m_min(:)
      real(r8), pointer :: t_ref2m_max(:)
      real(r8), pointer :: snowdp(:)

      pcolumn     => clm3%g%l%c%p%column
      croplive    => clm3%g%l%c%p%pps%croplive
      hdidx       => clm3%g%l%c%p%pps%hdidx
      cumvd       => clm3%g%l%c%p%pps%cumvd
      vf          => clm3%g%l%c%p%pps%vf
      gddmaturity => clm3%g%l%c%p%pps%gddmaturity
      huigrain    => clm3%g%l%c%p%pps%huigrain
      tlai        => clm3%g%l%c%p%pps%tlai
      t_ref2m     => clm3%g%l%c%p%pes%t_ref2m
      t_ref2m_min => clm3%g%l%c%p%pes%t_ref2m_min
      t_ref2m_max => clm3%g%l%c%p%pes%t_ref2m_max
      snowdp      => clm3%g%l%c%cps%snowdp

      ! photoperiod factor calculation
      ! genetic constant - can be modified

        p1d = 0.004_r8  ! average for genotypes from Ritchey, 1991.
                        ! Modeling plant & soil systems: Wheat phasic developmt
        p1v = 0.003_r8  ! average for genotypes from Ritchey, 1991.

        c = pcolumn(p)

        ! for all equations - temperatures must be in degrees (C)
        ! calculate temperature of crown of crop (e.g., 3 cm soil temperature)
        ! snow depth in centimeters

        if (t_ref2m(p) < tfrz) then !slevis: t_ref2m inst of td=daily avg (K)
           tcrown = 2._r8 + (t_ref2m(p) - tfrz) * (0.4_r8 + 0.0018_r8 * &
                    (min(snowdp(c)*100._r8, 15._r8) - 15._r8)**2)
        else !slevis: snowdp inst of adsnod=daily average (m)
           tcrown = t_ref2m(p) - tfrz
        end if

        ! vernalization factor calculation
        ! if vf(p) = 1.  then plant is fully vernalized - and thermal time
        ! accumulation in phase 1 will be unaffected
        ! refers to gddtsoi & gddplant, defined in the accumulation routines (slevis)
        ! reset vf, cumvd, and hdidx to 0 at planting of crop (slevis)

        if (t_ref2m_max(p) > tfrz) then
           if (t_ref2m_min(p) <= tfrz+15._r8) then
             vd1      = 1.4_r8 - 0.0778_r8 * tcrown
             vd2      = 0.5_r8 + 13.44_r8 / ((t_ref2m_max(p)-t_ref2m_min(p)+3._r8)**2) * tcrown
             vd       = max(0._r8, min(1._r8, vd1, vd2))
             cumvd(p) = cumvd(p) + vd
           end if

           if (cumvd(p) < 10._r8 .and. t_ref2m_max(p) > tfrz+30._r8) then
             cumvd(p) = cumvd(p) - 0.5_r8 * (t_ref2m_max(p) - tfrz - 30._r8)
           end if
           cumvd(p) = max(0._r8, cumvd(p))       ! must be > 0

           vf(p) = 1._r8 - p1v * (50._r8 - cumvd(p))
           vf(p) = max(0._r8, min(vf(p), 1._r8)) ! must be between 0 - 1
        end if

        ! calculate cold hardening of plant
        ! determines for winter wheat varieties whether the plant has completed
        ! a period of cold hardening to protect it from freezing temperatures. If
        ! not, then exposure could result in death or killing of plants.

        ! there are two distinct phases of hardening

        tbase = 0._r8
        hti = 1._r8
        if (t_ref2m_min(p) <= tfrz-3._r8 .or. hdidx(p) /= 0._r8) then
           if (hdidx(p) >= hti) then   ! done with phase 1
              hdidx(p) = hdidx(p) + 0.083_r8
              hdidx(p) = min(hdidx(p), hti*2._r8)
           end if

           if (t_ref2m_max(p) >= tbase + tfrz + 10._r8) then
              hdidx(p) = hdidx(p) - 0.02_r8 * (t_ref2m_max(p)-tbase-tfrz-10._r8)
              if (hdidx(p) > hti) hdidx(p) = hdidx(p) - 0.02_r8 * (t_ref2m_max(p)-tbase-tfrz-10._r8)
              hdidx(p) = max(0._r8, hdidx(p))
           end if

        else if (tcrown >= tbase-1._r8) then
           if (tcrown <= tbase+8._r8) then
              hdidx(p) = hdidx(p) + 0.1_r8 - (tcrown-tbase+3.5_r8)**2 / 506._r8
              if (hdidx(p) >= hti .and. tcrown <= tbase + 0._r8) then
                 hdidx(p) = hdidx(p) + 0.083_r8
                 hdidx(p) = min(hdidx(p), hti*2._r8)
              end if
           end if

           if (t_ref2m_max(p) >= tbase + tfrz + 10._r8) then
              hdidx(p) = hdidx(p) - 0.02_r8 * (t_ref2m_max(p)-tbase-tfrz-10._r8)
              if (hdidx(p) > hti) hdidx(p) = hdidx(p) - 0.02_r8 * (t_ref2m_max(p)-tbase-tfrz-10._r8)
              hdidx(p) = max(0._r8, hdidx(p))
           end if
        end if

        ! calculate what the wheat killing temperature
        ! there is a linear inverse relationship between
        ! hardening of the plant and the killing temperature or
        ! threshold that the plant can withstand
        ! when plant is fully-hardened (hdidx = 2), the killing threshold is -18 C

        ! will have to develop some type of relationship that reduces LAI and
        ! biomass pools in response to cold damaged crop

        if (t_ref2m_min(p) <= tfrz - 6._r8) then
           tkil = (tbase - 6._r8) - 6._r8 * hdidx(p)
           if (tkil >= tcrown) then
              if ((0.95_r8 - 0.02_r8 * (tcrown - tkil)**2) >= 0.02_r8) then
                 write (6,*)  'crop damaged by cold temperatures at p,c =', p,c
              else if (tlai(p) > 0._r8) then ! slevis: kill if past phase1
                 gddmaturity(p) = 0._r8      !         by forcing through
                 huigrain(p)    = 0._r8      !         harvest
                 write (6,*)  '95% of crop killed by cold temperatures at p,c =', p,c
              end if
           end if
        end if

  end subroutine vernalization
#endif
!-----------------------------------------------------------------------

!-----------------------------------------------------------------------
!BOP
!
! !IROUTINE: CNOnsetGrowth
!
! !INTERFACE:
subroutine CNOnsetGrowth (num_soilp, filter_soilp)
!
! !DESCRIPTION:
! Determines the flux of stored C and N from transfer pools to display
! pools during the phenological onset period.
!
! !USES:
!ylu removed
!   use clm_time_manager, only: get_step_size
     use globals, only: dt
#ifdef CROP
   use pftvarcon       , only: npcropmin
#endif

!
! !ARGUMENTS:
   integer, intent(in) :: num_soilp       ! number of soil pfts in filter
   integer, intent(in) :: filter_soilp(:) ! filter for soil pfts
!
! !CALLED FROM:
! subroutine CNPhenology
!
! !REVISION HISTORY:
! 10/27/03: Created by Peter Thornton
!
! !LOCAL VARIABLES:
! local pointers to implicit in scalars
!
   integer , pointer :: ivt(:)             ! pft vegetation type
   real(r8), pointer :: onset_flag(:)      ! onset flag
   real(r8), pointer :: onset_counter(:)   ! onset days counter
   real(r8), pointer :: leafc_xfer(:)      ! (kgC/m2) leaf C transfer
   real(r8), pointer :: frootc_xfer(:)     ! (kgC/m2) fine root C transfer
   real(r8), pointer :: livestemc_xfer(:)  ! (kgC/m2) live stem C transfer
   real(r8), pointer :: deadstemc_xfer(:)  ! (kgC/m2) dead stem C transfer
   real(r8), pointer :: livecrootc_xfer(:) ! (kgC/m2) live coarse root C transfer
   real(r8), pointer :: deadcrootc_xfer(:) ! (kgC/m2) dead coarse root C transfer
   real(r8), pointer :: leafn_xfer(:)      ! (kgN/m2) leaf N transfer
   real(r8), pointer :: frootn_xfer(:)     ! (kgN/m2) fine root N transfer
   real(r8), pointer :: livestemn_xfer(:)  ! (kgN/m2) live stem N transfer
   real(r8), pointer :: deadstemn_xfer(:)  ! (kgN/m2) dead stem N transfer
   real(r8), pointer :: livecrootn_xfer(:) ! (kgN/m2) live coarse root N transfer
   real(r8), pointer :: deadcrootn_xfer(:) ! (kgN/m2) dead coarse root N transfer
   real(r8), pointer :: woody(:)           ! binary flag for woody lifeform (1=woody, 0=not woody)
   real(r8), pointer :: bgtr(:)            ! background transfer growth rate (1/s)
!
! local pointers to implicit in/out scalars
!
   real(r8), pointer :: leafc_xfer_to_leafc(:)
   real(r8), pointer :: frootc_xfer_to_frootc(:)
   real(r8), pointer :: livestemc_xfer_to_livestemc(:)
   real(r8), pointer :: deadstemc_xfer_to_deadstemc(:)
   real(r8), pointer :: livecrootc_xfer_to_livecrootc(:)
   real(r8), pointer :: deadcrootc_xfer_to_deadcrootc(:)
   real(r8), pointer :: leafn_xfer_to_leafn(:)
   real(r8), pointer :: frootn_xfer_to_frootn(:)
   real(r8), pointer :: livestemn_xfer_to_livestemn(:)
#if (defined CROP) 
   real(r8), pointer :: grainn_xfer_to_grainn(:)
   real(r8), pointer :: grainn_xfer(:)
#endif  

   real(r8), pointer :: deadstemn_xfer_to_deadstemn(:)
   real(r8), pointer :: livecrootn_xfer_to_livecrootn(:)
   real(r8), pointer :: deadcrootn_xfer_to_deadcrootn(:)
!
! local pointers to implicit out scalars
!
! !OTHER LOCAL VARIABLES:
   integer :: p            ! indices
   integer :: fp           ! lake filter pft index
!   real(r8):: dt           ! radiation time step delta t (seconds)
   real(r8):: t1           ! temporary variable

!EOP
!-----------------------------------------------------------------------
   ! assign local pointers to derived type arrays (in)
    ivt                            => clm3%g%l%c%p%itype
    onset_flag                     => clm3%g%l%c%p%pepv%onset_flag
    onset_counter                  => clm3%g%l%c%p%pepv%onset_counter
    leafc_xfer                     => clm3%g%l%c%p%pcs%leafc_xfer
    frootc_xfer                    => clm3%g%l%c%p%pcs%frootc_xfer
    livestemc_xfer                 => clm3%g%l%c%p%pcs%livestemc_xfer
    deadstemc_xfer                 => clm3%g%l%c%p%pcs%deadstemc_xfer
    livecrootc_xfer                => clm3%g%l%c%p%pcs%livecrootc_xfer
    deadcrootc_xfer                => clm3%g%l%c%p%pcs%deadcrootc_xfer
    leafn_xfer                     => clm3%g%l%c%p%pns%leafn_xfer
    frootn_xfer                    => clm3%g%l%c%p%pns%frootn_xfer
    livestemn_xfer                 => clm3%g%l%c%p%pns%livestemn_xfer
    deadstemn_xfer                 => clm3%g%l%c%p%pns%deadstemn_xfer
    livecrootn_xfer                => clm3%g%l%c%p%pns%livecrootn_xfer
    deadcrootn_xfer                => clm3%g%l%c%p%pns%deadcrootn_xfer
    bgtr                           => clm3%g%l%c%p%pepv%bgtr
    woody                          => pftcon%woody

   ! assign local pointers to derived type arrays (out)
    leafc_xfer_to_leafc            => clm3%g%l%c%p%pcf%leafc_xfer_to_leafc
    frootc_xfer_to_frootc          => clm3%g%l%c%p%pcf%frootc_xfer_to_frootc
    livestemc_xfer_to_livestemc    => clm3%g%l%c%p%pcf%livestemc_xfer_to_livestemc
    deadstemc_xfer_to_deadstemc    => clm3%g%l%c%p%pcf%deadstemc_xfer_to_deadstemc
    livecrootc_xfer_to_livecrootc  => clm3%g%l%c%p%pcf%livecrootc_xfer_to_livecrootc
    deadcrootc_xfer_to_deadcrootc  => clm3%g%l%c%p%pcf%deadcrootc_xfer_to_deadcrootc
    leafn_xfer_to_leafn            => clm3%g%l%c%p%pnf%leafn_xfer_to_leafn
    frootn_xfer_to_frootn          => clm3%g%l%c%p%pnf%frootn_xfer_to_frootn
    livestemn_xfer_to_livestemn    => clm3%g%l%c%p%pnf%livestemn_xfer_to_livestemn
    deadstemn_xfer_to_deadstemn    => clm3%g%l%c%p%pnf%deadstemn_xfer_to_deadstemn
    livecrootn_xfer_to_livecrootn  => clm3%g%l%c%p%pnf%livecrootn_xfer_to_livecrootn
    deadcrootn_xfer_to_deadcrootn  => clm3%g%l%c%p%pnf%deadcrootn_xfer_to_deadcrootn
#if (defined CROP)
    grainn_xfer_to_grainn          => clm3%g%l%c%p%pnf%grainn_xfer_to_grainn
    grainn_xfer                    => clm3%g%l%c%p%pns%grainn_xfer
#endif

   ! set time steps
!   dt = real( get_step_size(), r8 )

   ! pft loop
   do fp = 1,num_soilp
      p = filter_soilp(fp)

      ! only calculate these fluxes during onset period
      if (onset_flag(p) == 1._r8) then

         ! The transfer rate is a linearly decreasing function of time,
         ! going to zero on the last timestep of the onset period

         if (onset_counter(p) == dt) then
             t1 = 1.0_r8 / dt
         else
             t1 = 2.0_r8 / (onset_counter(p))
         end if
         leafc_xfer_to_leafc(p)   = t1 * leafc_xfer(p)
         frootc_xfer_to_frootc(p) = t1 * frootc_xfer(p)
         leafn_xfer_to_leafn(p)   = t1 * leafn_xfer(p)
         frootn_xfer_to_frootn(p) = t1 * frootn_xfer(p)
         if (woody(ivt(p)) == 1.0_r8) then
             livestemc_xfer_to_livestemc(p)   = t1 * livestemc_xfer(p)
             deadstemc_xfer_to_deadstemc(p)   = t1 * deadstemc_xfer(p)
             livecrootc_xfer_to_livecrootc(p) = t1 * livecrootc_xfer(p)
             deadcrootc_xfer_to_deadcrootc(p) = t1 * deadcrootc_xfer(p)
             livestemn_xfer_to_livestemn(p)   = t1 * livestemn_xfer(p)
             deadstemn_xfer_to_deadstemn(p)   = t1 * deadstemn_xfer(p)
             livecrootn_xfer_to_livecrootn(p) = t1 * livecrootn_xfer(p)
             deadcrootn_xfer_to_deadcrootn(p) = t1 * deadcrootn_xfer(p)
          end if
!ylu add calculation on grainn_xfer_to_grainn,need to check with Sam
#if (defined CROP)
      if (ivt(p) >= npcropmin) then 
             grainn_xfer_to_grainn(p) = t1 * grainn_xfer(p)
      end if
#endif

      end if ! end if onset period

      ! calculate the background rate of transfer growth (used for stress
      ! deciduous algorithm). In this case, all of the mass in the transfer
      ! pools should be moved to displayed growth in each timestep.

      if (bgtr(p) > 0._r8) then
         leafc_xfer_to_leafc(p)   = leafc_xfer(p) / dt
         frootc_xfer_to_frootc(p) = frootc_xfer(p) / dt
         leafn_xfer_to_leafn(p)   = leafn_xfer(p) / dt
         frootn_xfer_to_frootn(p) = frootn_xfer(p) / dt
         if (woody(ivt(p)) == 1.0_r8) then
             livestemc_xfer_to_livestemc(p)   = livestemc_xfer(p) / dt
             deadstemc_xfer_to_deadstemc(p)   = deadstemc_xfer(p) / dt
             livecrootc_xfer_to_livecrootc(p) = livecrootc_xfer(p) / dt
             deadcrootc_xfer_to_deadcrootc(p) = deadcrootc_xfer(p) / dt
             livestemn_xfer_to_livestemn(p)   = livestemn_xfer(p) / dt
             deadstemn_xfer_to_deadstemn(p)   = deadstemn_xfer(p) / dt
             livecrootn_xfer_to_livecrootn(p) = livecrootn_xfer(p) / dt
             deadcrootn_xfer_to_deadcrootn(p) = deadcrootn_xfer(p) / dt
         end if
!ylu add calculation on grainn_xfer_to_grainn,need to check with Sam
#if (defined CROP)
      if (ivt(p) >= npcropmin) then
             grainn_xfer_to_grainn(p) = grainn_xfer(p) / dt
      end if
#endif


      end if ! end if bgtr

   end do ! end pft loop

end subroutine CNOnsetGrowth
!-----------------------------------------------------------------------

!-----------------------------------------------------------------------
!BOP
!
! !IROUTINE: CNOffsetLitterfall
!
! !INTERFACE:
subroutine CNOffsetLitterfall (num_soilp, filter_soilp)
!
! !DESCRIPTION:
! Determines the flux of C and N from displayed pools to litter
! pools during the phenological offset period.
!
! !USES:
!ylu removed
!   use clm_time_manager, only: get_step_size
 use globals, only: dt
#ifdef CROP
   use pftvarcon       , only: npcropmin
#endif
!
! !ARGUMENTS:
   integer, intent(in) :: num_soilp       ! number of soil pfts in filter
   integer, intent(in) :: filter_soilp(:) ! filter for soil pfts
!
! !CALLED FROM:
! subroutine CNPhenology
!
! !REVISION HISTORY:
! 10/27/03: Created by Peter Thornton
!
! !LOCAL VARIABLES:
! local pointers to implicit in scalars
!
   integer , pointer :: ivt(:)                   ! pft vegetation type
   real(r8), pointer :: offset_flag(:)           ! offset flag
   real(r8), pointer :: offset_counter(:)        ! offset days counter
   real(r8), pointer :: leafc(:)                 ! (kgC/m2) leaf C
   real(r8), pointer :: frootc(:)                ! (kgC/m2) fine root C
   real(r8), pointer :: cpool_to_leafc(:)
   real(r8), pointer :: cpool_to_frootc(:)
#if (defined CROP)
!  integer , pointer :: pcolumn(:)               ! pft's column index
   real(r8), pointer :: grainc(:)                ! (kgC/m2) grain C
   real(r8), pointer :: livestemc(:)             ! (kgC/m2) livestem C
   real(r8), pointer :: cpool_to_grainc(:)
   real(r8), pointer :: cpool_to_livestemc(:)
   real(r8), pointer :: livewdcn(:)              ! live wood C:N (gC/gN)
   real(r8), pointer :: graincn(:)               ! grain C:N (gC/gN)
#endif
   real(r8), pointer :: leafcn(:)                ! leaf C:N (gC/gN)
   real(r8), pointer :: lflitcn(:)               ! leaf litter C:N (gC/gN)
   real(r8), pointer :: frootcn(:)               ! fine root C:N (gC/gN)
!
! local pointers to implicit in/out scalars
!
   real(r8), pointer :: prev_leafc_to_litter(:)  ! previous timestep leaf C litterfall flux (gC/m2/s)
   real(r8), pointer :: prev_frootc_to_litter(:) ! previous timestep froot C litterfall flux (gC/m2/s)
   real(r8), pointer :: leafc_to_litter(:)
   real(r8), pointer :: frootc_to_litter(:)
   real(r8), pointer :: leafn_to_litter(:)
   real(r8), pointer :: leafn_to_retransn(:)
   real(r8), pointer :: frootn_to_litter(:)
#if (defined CROP)
   real(r8), pointer :: livestemc_to_litter(:)
   real(r8), pointer :: grainc_to_food(:)
   real(r8), pointer :: livestemn_to_litter(:)
   real(r8), pointer :: grainn_to_food(:)
#endif
!
! local pointers to implicit out scalars
!
!
! !OTHER LOCAL VARIABLES:
   integer :: p, c         ! indices
   integer :: fp           ! lake filter pft index
!   real(r8):: dt           ! radiation time step delta t (seconds)
   real(r8):: t1           ! temporary variable

!EOP
!-----------------------------------------------------------------------
   ! assign local pointers to derived type arrays (in)
    ivt                            => clm3%g%l%c%p%itype
    offset_flag                    => clm3%g%l%c%p%pepv%offset_flag
    offset_counter                 => clm3%g%l%c%p%pepv%offset_counter
    leafc                          => clm3%g%l%c%p%pcs%leafc
    frootc                         => clm3%g%l%c%p%pcs%frootc
#if (defined CROP)
    grainc                         => clm3%g%l%c%p%pcs%grainc
    livestemc                      => clm3%g%l%c%p%pcs%livestemc
    cpool_to_grainc                => clm3%g%l%c%p%pcf%cpool_to_grainc
    cpool_to_livestemc             => clm3%g%l%c%p%pcf%cpool_to_livestemc
#endif
    cpool_to_leafc                 => clm3%g%l%c%p%pcf%cpool_to_leafc
    cpool_to_frootc                => clm3%g%l%c%p%pcf%cpool_to_frootc
    leafcn                         => pftcon%leafcn
    lflitcn                        => pftcon%lflitcn
    frootcn                        => pftcon%frootcn
#if (defined CROP)
    livewdcn                       => pftcon%livewdcn
    graincn                        => pftcon%graincn
#endif

   ! assign local pointers to derived type arrays (out)
    prev_leafc_to_litter           => clm3%g%l%c%p%pepv%prev_leafc_to_litter
    prev_frootc_to_litter          => clm3%g%l%c%p%pepv%prev_frootc_to_litter
    leafc_to_litter                => clm3%g%l%c%p%pcf%leafc_to_litter
    frootc_to_litter               => clm3%g%l%c%p%pcf%frootc_to_litter
#if (defined CROP)
    livestemc_to_litter            => clm3%g%l%c%p%pcf%livestemc_to_litter
    grainc_to_food                 => clm3%g%l%c%p%pcf%grainc_to_food
    livestemn_to_litter            => clm3%g%l%c%p%pnf%livestemn_to_litter
    grainn_to_food                 => clm3%g%l%c%p%pnf%grainn_to_food
#endif
    leafn_to_litter                => clm3%g%l%c%p%pnf%leafn_to_litter
    leafn_to_retransn              => clm3%g%l%c%p%pnf%leafn_to_retransn
    frootn_to_litter               => clm3%g%l%c%p%pnf%frootn_to_litter

   ! set time steps
!   dt = real( get_step_size(), r8 )

   ! The litterfall transfer rate starts at 0.0 and increases linearly
   ! over time, with displayed growth going to 0.0 on the last day of litterfall

   do fp = 1,num_soilp
      p = filter_soilp(fp)

      ! only calculate fluxes during offset period
      if (offset_flag(p) == 1._r8) then

         if (offset_counter(p) == dt) then
             t1 = 1.0_r8 / dt
             leafc_to_litter(p)  = t1 * leafc(p)  + cpool_to_leafc(p)
             frootc_to_litter(p) = t1 * frootc(p) + cpool_to_frootc(p)
#if (defined CROP)
             ! this assumes that offset_counter == dt for crops
             ! if this were ever changed, we'd need to add code to the "else"
             if (ivt(p) >= npcropmin) then
                grainc_to_food(p) = t1 * grainc(p)  + cpool_to_grainc(p) 
                livestemc_to_litter(p) = t1 * livestemc(p)  + cpool_to_livestemc(p)
             end if
#endif
         else
             t1 = dt * 2.0_r8 / (offset_counter(p) * offset_counter(p))
             leafc_to_litter(p)  = prev_leafc_to_litter(p)  + t1*(leafc(p)  - prev_leafc_to_litter(p)*offset_counter(p))
             frootc_to_litter(p) = prev_frootc_to_litter(p) + t1*(frootc(p) - prev_frootc_to_litter(p)*offset_counter(p))
         end if

         ! calculate the leaf N litterfall and retranslocation
         leafn_to_litter(p)   = leafc_to_litter(p)  / lflitcn(ivt(p))
         leafn_to_retransn(p) = (leafc_to_litter(p) / leafcn(ivt(p))) - leafn_to_litter(p)

         ! calculate fine root N litterfall (no retranslocation of fine root N)
         frootn_to_litter(p) = frootc_to_litter(p) / frootcn(ivt(p))

#if (defined CROP)
         if (ivt(p) >= npcropmin) then
            livestemn_to_litter(p) = livestemc_to_litter(p) / livewdcn(ivt(p))
            grainn_to_food(p) = grainc_to_food(p) / graincn(ivt(p))
         end if
#endif

         ! save the current litterfall fluxes
         prev_leafc_to_litter(p)  = leafc_to_litter(p)
         prev_frootc_to_litter(p) = frootc_to_litter(p)

      end if ! end if offset period

   end do ! end pft loop

end subroutine CNOffsetLitterfall
!-----------------------------------------------------------------------

!-----------------------------------------------------------------------
!BOP
!
! !IROUTINE: CNBackgroundLitterfall
!
! !INTERFACE:
subroutine CNBackgroundLitterfall (num_soilp, filter_soilp)
!
! !DESCRIPTION:
! Determines the flux of C and N from displayed pools to litter
! pools as the result of background litter fall.
!
! !USES:
!ylu removed
!   use clm_time_manager, only: get_step_size
 use globals, only: dt
!
! !ARGUMENTS:
   integer, intent(in) :: num_soilp       ! number of soil pfts in filter
   integer, intent(in) :: filter_soilp(:) ! filter for soil pfts
!
! !CALLED FROM:
! subroutine CNPhenology
!
! !REVISION HISTORY:
! 10/2/03: Created by Peter Thornton
! 10/24/03, Peter Thornton: migrated to vector data structures
!
! !LOCAL VARIABLES:
! local pointers to implicit in scalars
!
   ! pft level
   integer , pointer :: ivt(:)       ! pft vegetation type
   real(r8), pointer :: bglfr(:)     ! background litterfall rate (1/s)
   real(r8), pointer :: leafc(:)     ! (kgC/m2) leaf C
   real(r8), pointer :: frootc(:)    ! (kgC/m2) fine root C
   ! ecophysiological constants
   real(r8), pointer :: leafcn(:)    ! leaf C:N (gC/gN)
   real(r8), pointer :: lflitcn(:)   ! leaf litter C:N (gC/gN)
   real(r8), pointer :: frootcn(:)   ! fine root C:N (gC/gN)
!
! local pointers to implicit in/out scalars
!
   real(r8), pointer :: leafc_to_litter(:)
   real(r8), pointer :: frootc_to_litter(:)
   real(r8), pointer :: leafn_to_litter(:)
   real(r8), pointer :: leafn_to_retransn(:)
   real(r8), pointer :: frootn_to_litter(:)
!
! local pointers to implicit out scalars
!
!
! !OTHER LOCAL VARIABLES:
   integer :: p            ! indices
   integer :: fp           ! lake filter pft index
!   real(r8):: dt           ! decomp timestep (seconds)

!EOP
!-----------------------------------------------------------------------
   ! assign local pointers to derived type arrays (in)
    ivt                            => clm3%g%l%c%p%itype
    bglfr                          => clm3%g%l%c%p%pepv%bglfr
    leafc                          => clm3%g%l%c%p%pcs%leafc
    frootc                         => clm3%g%l%c%p%pcs%frootc
    leafcn                         => pftcon%leafcn
    lflitcn                        => pftcon%lflitcn
    frootcn                        => pftcon%frootcn

   ! assign local pointers to derived type arrays (out)
    leafc_to_litter                => clm3%g%l%c%p%pcf%leafc_to_litter
    frootc_to_litter               => clm3%g%l%c%p%pcf%frootc_to_litter
    leafn_to_litter                => clm3%g%l%c%p%pnf%leafn_to_litter
    leafn_to_retransn              => clm3%g%l%c%p%pnf%leafn_to_retransn
    frootn_to_litter               => clm3%g%l%c%p%pnf%frootn_to_litter

   ! set time steps
!   dt = real( get_step_size(), r8 )

   ! pft loop
   do fp = 1,num_soilp
      p = filter_soilp(fp)

      ! only calculate these fluxes if the background litterfall rate is non-zero
      if (bglfr(p) > 0._r8) then
         ! units for bglfr are already 1/s
         leafc_to_litter(p)  = bglfr(p) * leafc(p)
         frootc_to_litter(p) = bglfr(p) * frootc(p)

         ! calculate the leaf N litterfall and retranslocation
         leafn_to_litter(p)   = leafc_to_litter(p)  / lflitcn(ivt(p))
         leafn_to_retransn(p) = (leafc_to_litter(p) / leafcn(ivt(p))) - leafn_to_litter(p)

         ! calculate fine root N litterfall (no retranslocation of fine root N)
         frootn_to_litter(p) = frootc_to_litter(p) / frootcn(ivt(p))

      end if

   end do

end subroutine CNBackgroundLitterfall
!-----------------------------------------------------------------------

!-----------------------------------------------------------------------
!BOP
!
! !IROUTINE: CNLivewoodTurnover
!
! !INTERFACE:
subroutine CNLivewoodTurnover (num_soilp, filter_soilp)
!
! !DESCRIPTION:
! Determines the flux of C and N from live wood to
! dead wood pools, for stem and coarse root.
!
! !USES:
!ylu removed
!   use clm_time_manager, only: get_step_size
 use globals, only: dt
!
! !ARGUMENTS:
   integer, intent(in) :: num_soilp       ! number of soil pfts in filter
   integer, intent(in) :: filter_soilp(:) ! filter for soil pfts
!
! !CALLED FROM:
! subroutine CNPhenology
!
! !REVISION HISTORY:
! 12/5/03: created by Peter Thornton
!
! !LOCAL VARIABLES:
! local pointers to implicit in scalars
!
   ! pft level
   integer , pointer :: ivt(:)         ! pft vegetation type
   real(r8), pointer :: livestemc(:)   ! (gC/m2) live stem C
   real(r8), pointer :: livecrootc(:)  ! (gC/m2) live coarse root C
   real(r8), pointer :: livestemn(:)   ! (gN/m2) live stem N
   real(r8), pointer :: livecrootn(:)  ! (gN/m2) live coarse root N
   ! ecophysiological constants
   real(r8), pointer :: woody(:)       ! binary flag for woody lifeform (1=woody, 0=not woody)
   real(r8), pointer :: livewdcn(:)    ! live wood (phloem and ray parenchyma) C:N (gC/gN)
   real(r8), pointer :: deadwdcn(:)    ! dead wood (xylem and heartwood) C:N (gC/gN)
!
! local pointers to implicit in/out scalars
!
   real(r8), pointer :: livestemc_to_deadstemc(:)
   real(r8), pointer :: livecrootc_to_deadcrootc(:)
   real(r8), pointer :: livestemn_to_deadstemn(:)
   real(r8), pointer :: livestemn_to_retransn(:)
   real(r8), pointer :: livecrootn_to_deadcrootn(:)
   real(r8), pointer :: livecrootn_to_retransn(:)
!
! local pointers to implicit out scalars
!
!
! !OTHER LOCAL VARIABLES:
   integer :: p            ! indices
   integer :: fp           ! lake filter pft index
!   real(r8):: dt           ! decomp timestep (seconds)
   real(r8):: lwtop        ! live wood turnover proportion (annual fraction)
   real(r8):: ctovr        ! temporary variable for carbon turnover
   real(r8):: ntovr        ! temporary variable for nitrogen turnover

!EOP
!-----------------------------------------------------------------------
   ! assign local pointers to derived type arrays (in)
    ivt                            => clm3%g%l%c%p%itype
    livestemc                      => clm3%g%l%c%p%pcs%livestemc
    livecrootc                     => clm3%g%l%c%p%pcs%livecrootc
    livestemn                      => clm3%g%l%c%p%pns%livestemn
    livecrootn                     => clm3%g%l%c%p%pns%livecrootn
    woody                          => pftcon%woody
    livewdcn                       => pftcon%livewdcn
    deadwdcn                       => pftcon%deadwdcn

   ! assign local pointers to derived type arrays (out)
    livestemc_to_deadstemc         => clm3%g%l%c%p%pcf%livestemc_to_deadstemc
    livecrootc_to_deadcrootc       => clm3%g%l%c%p%pcf%livecrootc_to_deadcrootc
    livestemn_to_deadstemn         => clm3%g%l%c%p%pnf%livestemn_to_deadstemn
    livestemn_to_retransn          => clm3%g%l%c%p%pnf%livestemn_to_retransn
    livecrootn_to_deadcrootn       => clm3%g%l%c%p%pnf%livecrootn_to_deadcrootn
    livecrootn_to_retransn         => clm3%g%l%c%p%pnf%livecrootn_to_retransn

   ! set time steps
!   dt = real( get_step_size(), r8 )

   ! set the global parameter for livewood turnover rate
   ! define as an annual fraction (0.7), and convert to fraction per second
   lwtop = 0.7_r8 / 31536000.0_r8

   ! pft loop
   do fp = 1,num_soilp
      p = filter_soilp(fp)

      ! only calculate these fluxes for woody types
      if (woody(ivt(p)) > 0._r8) then

         ! live stem to dead stem turnover

         ctovr = livestemc(p) * lwtop
         ntovr = ctovr / livewdcn(ivt(p))
         livestemc_to_deadstemc(p) = ctovr
         livestemn_to_deadstemn(p) = ctovr / deadwdcn(ivt(p))
         livestemn_to_retransn(p)  = ntovr - livestemn_to_deadstemn(p)

         ! live coarse root to dead coarse root turnover

         ctovr = livecrootc(p) * lwtop
         ntovr = ctovr / livewdcn(ivt(p))
         livecrootc_to_deadcrootc(p) = ctovr
         livecrootn_to_deadcrootn(p) = ctovr / deadwdcn(ivt(p))
         livecrootn_to_retransn(p)  = ntovr - livecrootn_to_deadcrootn(p)

      end if

   end do

end subroutine CNLivewoodTurnover
!-----------------------------------------------------------------------

!-----------------------------------------------------------------------
!BOP
!
! !IROUTINE: CNLitterToColumn
!
! !INTERFACE:
subroutine CNLitterToColumn (num_soilc, filter_soilc)
!
! !DESCRIPTION:
! called at the end of cn_phenology to gather all pft-level litterfall fluxes
! to the column level and assign them to the three litter pools
!
! !USES:
  use clm_varpar, only : max_pft_per_col
#ifdef CROP
  use pftvarcon , only : npcropmin
#endif
!
! !ARGUMENTS:
  integer, intent(in) :: num_soilc       ! number of soil columns in filter
  integer, intent(in) :: filter_soilc(:) ! filter for soil columns
!
! !CALLED FROM:
! subroutine CNPhenology
!
! !REVISION HISTORY:
! 9/8/03: Created by Peter Thornton
!
! !LOCAL VARIABLES:
! local pointers to implicit in scalars
!
   integer , pointer :: ivt(:)          ! pft vegetation type
   real(r8), pointer :: wtcol(:)        ! weight (relative to column) for this pft (0-1)
   real(r8), pointer :: pwtgcell(:)     ! weight of pft relative to corresponding gridcell
   real(r8), pointer :: leafc_to_litter(:)
   real(r8), pointer :: frootc_to_litter(:)
#if (defined CROP)
   real(r8), pointer :: livestemc_to_litter(:)
   real(r8), pointer :: grainc_to_food(:)
   real(r8), pointer :: livestemn_to_litter(:)
   real(r8), pointer :: grainn_to_food(:)
#endif
   real(r8), pointer :: leafn_to_litter(:)
   real(r8), pointer :: frootn_to_litter(:)
   real(r8), pointer :: lf_flab(:)      ! leaf litter labile fraction
   real(r8), pointer :: lf_fcel(:)      ! leaf litter cellulose fraction
   real(r8), pointer :: lf_flig(:)      ! leaf litter lignin fraction
   real(r8), pointer :: fr_flab(:)      ! fine root litter labile fraction
   real(r8), pointer :: fr_fcel(:)      ! fine root litter cellulose fraction
   real(r8), pointer :: fr_flig(:)      ! fine root litter lignin fraction
   integer , pointer :: npfts(:)        ! number of pfts for each column
   integer , pointer :: pfti(:)         ! beginning pft index for each column
!
! local pointers to implicit in/out scalars
!
   real(r8), pointer :: leafc_to_litr1c(:)
   real(r8), pointer :: leafc_to_litr2c(:)
   real(r8), pointer :: leafc_to_litr3c(:)
   real(r8), pointer :: frootc_to_litr1c(:)
   real(r8), pointer :: frootc_to_litr2c(:)
   real(r8), pointer :: frootc_to_litr3c(:)
#if (defined CROP)
   real(r8), pointer :: livestemc_to_litr1c(:)
   real(r8), pointer :: livestemc_to_litr2c(:)
   real(r8), pointer :: livestemc_to_litr3c(:)
   real(r8), pointer :: livestemn_to_litr1n(:)
   real(r8), pointer :: livestemn_to_litr2n(:)
   real(r8), pointer :: livestemn_to_litr3n(:)
   real(r8), pointer :: grainc_to_litr1c(:)
   real(r8), pointer :: grainc_to_litr2c(:)
   real(r8), pointer :: grainc_to_litr3c(:)
   real(r8), pointer :: grainn_to_litr1n(:)
   real(r8), pointer :: grainn_to_litr2n(:)
   real(r8), pointer :: grainn_to_litr3n(:)
#endif
   real(r8), pointer :: leafn_to_litr1n(:)
   real(r8), pointer :: leafn_to_litr2n(:)
   real(r8), pointer :: leafn_to_litr3n(:)
   real(r8), pointer :: frootn_to_litr1n(:)
   real(r8), pointer :: frootn_to_litr2n(:)
   real(r8), pointer :: frootn_to_litr3n(:)
!
! local pointers to implicit out scalars
!
!
! !OTHER LOCAL VARIABLES:
    integer :: fc,c,pi,p
!EOP
!-----------------------------------------------------------------------
   ! assign local pointers to derived type arrays (in)
    ivt                            => clm3%g%l%c%p%itype
    wtcol                          => clm3%g%l%c%p%wtcol
    pwtgcell                       => clm3%g%l%c%p%wtgcell  
    leafc_to_litter                => clm3%g%l%c%p%pcf%leafc_to_litter
    frootc_to_litter               => clm3%g%l%c%p%pcf%frootc_to_litter
#if (defined CROP)
    livestemc_to_litter            => clm3%g%l%c%p%pcf%livestemc_to_litter
    grainc_to_food                 => clm3%g%l%c%p%pcf%grainc_to_food
    livestemn_to_litter            => clm3%g%l%c%p%pnf%livestemn_to_litter
    grainn_to_food                 => clm3%g%l%c%p%pnf%grainn_to_food
#endif
    leafn_to_litter                => clm3%g%l%c%p%pnf%leafn_to_litter
    frootn_to_litter               => clm3%g%l%c%p%pnf%frootn_to_litter
    npfts                          => clm3%g%l%c%npfts
    pfti                           => clm3%g%l%c%pfti
    lf_flab                        => pftcon%lf_flab
    lf_fcel                        => pftcon%lf_fcel
    lf_flig                        => pftcon%lf_flig
    fr_flab                        => pftcon%fr_flab
    fr_fcel                        => pftcon%fr_fcel
    fr_flig                        => pftcon%fr_flig

   ! assign local pointers to derived type arrays (out)
    leafc_to_litr1c                => clm3%g%l%c%ccf%leafc_to_litr1c
    leafc_to_litr2c                => clm3%g%l%c%ccf%leafc_to_litr2c
    leafc_to_litr3c                => clm3%g%l%c%ccf%leafc_to_litr3c
    frootc_to_litr1c               => clm3%g%l%c%ccf%frootc_to_litr1c
    frootc_to_litr2c               => clm3%g%l%c%ccf%frootc_to_litr2c
    frootc_to_litr3c               => clm3%g%l%c%ccf%frootc_to_litr3c
#if (defined CROP)
    grainc_to_litr1c               => clm3%g%l%c%ccf%grainc_to_litr1c
    grainc_to_litr2c               => clm3%g%l%c%ccf%grainc_to_litr2c
    grainc_to_litr3c               => clm3%g%l%c%ccf%grainc_to_litr3c
    livestemc_to_litr1c            => clm3%g%l%c%ccf%livestemc_to_litr1c
    livestemc_to_litr2c            => clm3%g%l%c%ccf%livestemc_to_litr2c
    livestemc_to_litr3c            => clm3%g%l%c%ccf%livestemc_to_litr3c
    livestemn_to_litr1n            => clm3%g%l%c%cnf%livestemn_to_litr1n
    livestemn_to_litr2n            => clm3%g%l%c%cnf%livestemn_to_litr2n
    livestemn_to_litr3n            => clm3%g%l%c%cnf%livestemn_to_litr3n
    grainn_to_litr1n               => clm3%g%l%c%cnf%grainn_to_litr1n
    grainn_to_litr2n               => clm3%g%l%c%cnf%grainn_to_litr2n
    grainn_to_litr3n               => clm3%g%l%c%cnf%grainn_to_litr3n
#endif
    leafn_to_litr1n                => clm3%g%l%c%cnf%leafn_to_litr1n
    leafn_to_litr2n                => clm3%g%l%c%cnf%leafn_to_litr2n
    leafn_to_litr3n                => clm3%g%l%c%cnf%leafn_to_litr3n
    frootn_to_litr1n               => clm3%g%l%c%cnf%frootn_to_litr1n
    frootn_to_litr2n               => clm3%g%l%c%cnf%frootn_to_litr2n
    frootn_to_litr3n               => clm3%g%l%c%cnf%frootn_to_litr3n

   do pi = 1,max_pft_per_col
      do fc = 1,num_soilc
         c = filter_soilc(fc)

         if ( pi <=  npfts(c) ) then
            p = pfti(c) + pi - 1
            if (pwtgcell(p)>0._r8) then

               ! leaf litter carbon fluxes
               leafc_to_litr1c(c) = leafc_to_litr1c(c) + leafc_to_litter(p) * lf_flab(ivt(p)) * wtcol(p)
               leafc_to_litr2c(c) = leafc_to_litr2c(c) + leafc_to_litter(p) * lf_fcel(ivt(p)) * wtcol(p)
               leafc_to_litr3c(c) = leafc_to_litr3c(c) + leafc_to_litter(p) * lf_flig(ivt(p)) * wtcol(p)

               ! leaf litter nitrogen fluxes
               leafn_to_litr1n(c) = leafn_to_litr1n(c) + leafn_to_litter(p) * lf_flab(ivt(p)) * wtcol(p)
               leafn_to_litr2n(c) = leafn_to_litr2n(c) + leafn_to_litter(p) * lf_fcel(ivt(p)) * wtcol(p)
               leafn_to_litr3n(c) = leafn_to_litr3n(c) + leafn_to_litter(p) * lf_flig(ivt(p)) * wtcol(p)

               ! fine root litter carbon fluxes
               frootc_to_litr1c(c) = frootc_to_litr1c(c) + frootc_to_litter(p) * fr_flab(ivt(p)) * wtcol(p)
               frootc_to_litr2c(c) = frootc_to_litr2c(c) + frootc_to_litter(p) * fr_fcel(ivt(p)) * wtcol(p)
               frootc_to_litr3c(c) = frootc_to_litr3c(c) + frootc_to_litter(p) * fr_flig(ivt(p)) * wtcol(p)

               ! fine root litter nitrogen fluxes
               frootn_to_litr1n(c) = frootn_to_litr1n(c) + frootn_to_litter(p) * fr_flab(ivt(p)) * wtcol(p)
               frootn_to_litr2n(c) = frootn_to_litr2n(c) + frootn_to_litter(p) * fr_fcel(ivt(p)) * wtcol(p)
               frootn_to_litr3n(c) = frootn_to_litr3n(c) + frootn_to_litter(p) * fr_flig(ivt(p)) * wtcol(p)


#if (defined CROP)
               ! agroibis puts crop stem litter together with leaf litter
               ! so I've used the leaf lf_f* parameters instead of making
               ! new ones for now (slevis)
               ! also for simplicity I've put "food" into the litter pools
               if (ivt(p) >= npcropmin) then ! add livestemc to litter
                  ! stem litter carbon fluxes
                  livestemc_to_litr1c(c) = livestemc_to_litr1c(c) + livestemc_to_litter(p) * lf_flab(ivt(p)) * wtcol(p)
                  livestemc_to_litr2c(c) = livestemc_to_litr2c(c) + livestemc_to_litter(p) * lf_fcel(ivt(p)) * wtcol(p)
                  livestemc_to_litr3c(c) = livestemc_to_litr3c(c) + livestemc_to_litter(p) * lf_flig(ivt(p)) * wtcol(p)

                  ! stem litter nitrogen fluxes
                  livestemn_to_litr1n(c) = livestemn_to_litr1n(c) + livestemn_to_litter(p) * lf_flab(ivt(p)) * wtcol(p)
                  livestemn_to_litr2n(c) = livestemn_to_litr2n(c) + livestemn_to_litter(p) * lf_fcel(ivt(p)) * wtcol(p)
                  livestemn_to_litr3n(c) = livestemn_to_litr3n(c) + livestemn_to_litter(p) * lf_flig(ivt(p)) * wtcol(p)

                  ! grain litter carbon fluxes
                  grainc_to_litr1c(c) = grainc_to_litr1c(c) + grainc_to_food(p) * lf_flab(ivt(p)) * wtcol(p)
                  grainc_to_litr2c(c) = grainc_to_litr2c(c) + grainc_to_food(p) * lf_fcel(ivt(p)) * wtcol(p)
                  grainc_to_litr3c(c) = grainc_to_litr3c(c) + grainc_to_food(p) * lf_flig(ivt(p)) * wtcol(p)

                  ! grain litter nitrogen fluxes
                  grainn_to_litr1n(c) = grainn_to_litr1n(c) + grainn_to_food(p) * lf_flab(ivt(p)) * wtcol(p)
                  grainn_to_litr2n(c) = grainn_to_litr2n(c) + grainn_to_food(p) * lf_fcel(ivt(p)) * wtcol(p)
                  grainn_to_litr3n(c) = grainn_to_litr3n(c) + grainn_to_food(p) * lf_flig(ivt(p)) * wtcol(p)
               end if
#endif
            end if
         end if

      end do

   end do

end subroutine CNLitterToColumn
!-----------------------------------------------------------------------
#endif

end module CNPhenologyMod
module CNPrecisionControlMod

#ifdef CN

!----------------------------------------------------------------------- 
!BOP
!
! !MODULE: CNPrecisionControlMod
! 
! !DESCRIPTION:
! controls on very low values in critical state variables 
! 
! !USES:
    use shr_kind_mod, only: r8 => shr_kind_r8
    implicit none
    save
    private
! !PUBLIC MEMBER FUNCTIONS:
    public:: CNPrecisionControl
!
! !REVISION HISTORY:
! 4/23/2004: Created by Peter Thornton
!
!EOP
!----------------------------------------------------------------------- 

contains

!-----------------------------------------------------------------------
!BOP
!
! !IROUTINE: CNPrecisionControl
!
! !INTERFACE:
subroutine CNPrecisionControl(num_soilc, filter_soilc, num_soilp, filter_soilp)
!
! !DESCRIPTION: 
! On the radiation time step, force leaf and deadstem c and n to 0 if
! they get too small.
!
! !USES:
   use clmtype
!   use abortutils,   only: endrun
!   use clm_varctl,   only: iulog
!
! !ARGUMENTS:
   implicit none
   integer, intent(in) :: num_soilc       ! number of soil columns in filter
   integer, intent(in) :: filter_soilc(:) ! filter for soil columns
   integer, intent(in) :: num_soilp       ! number of soil pfts in filter
   integer, intent(in) :: filter_soilp(:) ! filter for soil pfts
!
! !CALLED FROM:
! subroutine CNEcosystemDyn
!
! !REVISION HISTORY:
! 8/1/03: Created by Peter Thornton
!
! !LOCAL VARIABLES:
! local pointers to implicit in scalars
   real(r8), pointer :: col_ctrunc(:)         ! (gC/m2) column-level sink for C truncation
   real(r8), pointer :: cwdc(:)               ! (gC/m2) coarse woody debris C
   real(r8), pointer :: litr1c(:)             ! (gC/m2) litter labile C
   real(r8), pointer :: litr2c(:)             ! (gC/m2) litter cellulose C
   real(r8), pointer :: litr3c(:)             ! (gC/m2) litter lignin C
   real(r8), pointer :: soil1c(:)             ! (gC/m2) soil organic matter C (fast pool)
   real(r8), pointer :: soil2c(:)             ! (gC/m2) soil organic matter C (medium pool)
   real(r8), pointer :: soil3c(:)             ! (gC/m2) soil organic matter C (slow pool)
   real(r8), pointer :: soil4c(:)             ! (gC/m2) soil organic matter C (slowest pool)
#if (defined C13)
   real(r8), pointer :: c13_col_ctrunc(:)     ! (gC/m2) column-level sink for C truncation
   real(r8), pointer :: c13_cwdc(:)           ! (gC/m2) coarse woody debris C
   real(r8), pointer :: c13_litr1c(:)         ! (gC/m2) litter labile C
   real(r8), pointer :: c13_litr2c(:)         ! (gC/m2) litter cellulose C
   real(r8), pointer :: c13_litr3c(:)         ! (gC/m2) litter lignin C
   real(r8), pointer :: c13_soil1c(:)         ! (gC/m2) soil organic matter C (fast pool)
   real(r8), pointer :: c13_soil2c(:)         ! (gC/m2) soil organic matter C (medium pool)
   real(r8), pointer :: c13_soil3c(:)         ! (gC/m2) soil organic matter C (slow pool)
   real(r8), pointer :: c13_soil4c(:)         ! (gC/m2) soil organic matter C (slowest pool)
#endif
   real(r8), pointer :: col_ntrunc(:)         ! (gN/m2) column-level sink for N truncation
   real(r8), pointer :: cwdn(:)               ! (gN/m2) coarse woody debris N
   real(r8), pointer :: litr1n(:)             ! (gN/m2) litter labile N
   real(r8), pointer :: litr2n(:)             ! (gN/m2) litter cellulose N
   real(r8), pointer :: litr3n(:)             ! (gN/m2) litter lignin N
   real(r8), pointer :: soil1n(:)             ! (gN/m2) soil organic matter N (fast pool)
   real(r8), pointer :: soil2n(:)             ! (gN/m2) soil organic matter N (medium pool)
   real(r8), pointer :: soil3n(:)             ! (gN/m2) soil orgainc matter N (slow pool)
   real(r8), pointer :: soil4n(:)             ! (gN/m2) soil orgainc matter N (slowest pool)
   real(r8), pointer :: cpool(:)              ! (gC/m2) temporary photosynthate C pool
   real(r8), pointer :: deadcrootc(:)         ! (gC/m2) dead coarse root C
   real(r8), pointer :: deadcrootc_storage(:) ! (gC/m2) dead coarse root C storage
   real(r8), pointer :: deadcrootc_xfer(:)    ! (gC/m2) dead coarse root C transfer
   real(r8), pointer :: deadstemc(:)          ! (gC/m2) dead stem C
   real(r8), pointer :: deadstemc_storage(:)  ! (gC/m2) dead stem C storage
   real(r8), pointer :: deadstemc_xfer(:)     ! (gC/m2) dead stem C transfer
   real(r8), pointer :: frootc(:)             ! (gC/m2) fine root C
   real(r8), pointer :: frootc_storage(:)     ! (gC/m2) fine root C storage
   real(r8), pointer :: frootc_xfer(:)        ! (gC/m2) fine root C transfer
   real(r8), pointer :: gresp_storage(:)      ! (gC/m2) growth respiration storage
   real(r8), pointer :: gresp_xfer(:)         ! (gC/m2) growth respiration transfer
   real(r8), pointer :: leafc(:)              ! (gC/m2) leaf C
   real(r8), pointer :: leafc_storage(:)      ! (gC/m2) leaf C storage
   real(r8), pointer :: leafc_xfer(:)         ! (gC/m2) leaf C transfer
   real(r8), pointer :: livecrootc(:)         ! (gC/m2) live coarse root C
   real(r8), pointer :: livecrootc_storage(:) ! (gC/m2) live coarse root C storage
   real(r8), pointer :: livecrootc_xfer(:)    ! (gC/m2) live coarse root C transfer
   real(r8), pointer :: livestemc(:)          ! (gC/m2) live stem C
   real(r8), pointer :: livestemc_storage(:)  ! (gC/m2) live stem C storage
   real(r8), pointer :: livestemc_xfer(:)     ! (gC/m2) live stem C transfer
   real(r8), pointer :: pft_ctrunc(:)         ! (gC/m2) pft-level sink for C truncation
#if (defined CROP)
   real(r8), pointer :: xsmrpool(:)           ! (gC/m2) execss maint resp C pool
   real(r8), pointer :: grainc(:)             ! (gC/m2) grain C
   real(r8), pointer :: grainc_storage(:)     ! (gC/m2) grain C storage
   real(r8), pointer :: grainc_xfer(:)        ! (gC/m2) grain C transfer
#if (defined C13)
   real(r8), pointer :: c13_xsmrpool(:)           ! (gC/m2) execss maint resp C pool
   real(r8), pointer :: c13_grainc(:)             ! (gC/m2) grain C
   real(r8), pointer :: c13_grainc_storage(:)     ! (gC/m2) grain C storage
   real(r8), pointer :: c13_grainc_xfer(:)        ! (gC/m2) grain C transfer
#endif
#endif
#if (defined C13)
   real(r8), pointer :: c13_cpool(:)              ! (gC/m2) temporary photosynthate C pool
   real(r8), pointer :: c13_deadcrootc(:)         ! (gC/m2) dead coarse root C
   real(r8), pointer :: c13_deadcrootc_storage(:) ! (gC/m2) dead coarse root C storage
   real(r8), pointer :: c13_deadcrootc_xfer(:)    ! (gC/m2) dead coarse root C transfer
   real(r8), pointer :: c13_deadstemc(:)          ! (gC/m2) dead stem C
   real(r8), pointer :: c13_deadstemc_storage(:)  ! (gC/m2) dead stem C storage
   real(r8), pointer :: c13_deadstemc_xfer(:)     ! (gC/m2) dead stem C transfer
   real(r8), pointer :: c13_frootc(:)             ! (gC/m2) fine root C
   real(r8), pointer :: c13_frootc_storage(:)     ! (gC/m2) fine root C storage
   real(r8), pointer :: c13_frootc_xfer(:)        ! (gC/m2) fine root C transfer
   real(r8), pointer :: c13_gresp_storage(:)      ! (gC/m2) growth respiration storage
   real(r8), pointer :: c13_gresp_xfer(:)         ! (gC/m2) growth respiration transfer
   real(r8), pointer :: c13_leafc(:)              ! (gC/m2) leaf C
   real(r8), pointer :: c13_leafc_storage(:)      ! (gC/m2) leaf C storage
   real(r8), pointer :: c13_leafc_xfer(:)         ! (gC/m2) leaf C transfer
   real(r8), pointer :: c13_livecrootc(:)         ! (gC/m2) live coarse root C
   real(r8), pointer :: c13_livecrootc_storage(:) ! (gC/m2) live coarse root C storage
   real(r8), pointer :: c13_livecrootc_xfer(:)    ! (gC/m2) live coarse root C transfer
   real(r8), pointer :: c13_livestemc(:)          ! (gC/m2) live stem C
   real(r8), pointer :: c13_livestemc_storage(:)  ! (gC/m2) live stem C storage
   real(r8), pointer :: c13_livestemc_xfer(:)     ! (gC/m2) live stem C transfer
   real(r8), pointer :: c13_pft_ctrunc(:)         ! (gC/m2) pft-level sink for C truncation
#endif
   real(r8), pointer :: deadcrootn(:)         ! (gN/m2) dead coarse root N
   real(r8), pointer :: deadcrootn_storage(:) ! (gN/m2) dead coarse root N storage
   real(r8), pointer :: deadcrootn_xfer(:)    ! (gN/m2) dead coarse root N transfer
   real(r8), pointer :: deadstemn(:)          ! (gN/m2) dead stem N
   real(r8), pointer :: deadstemn_storage(:)  ! (gN/m2) dead stem N storage
   real(r8), pointer :: deadstemn_xfer(:)     ! (gN/m2) dead stem N transfer
   real(r8), pointer :: frootn(:)             ! (gN/m2) fine root N
   real(r8), pointer :: frootn_storage(:)     ! (gN/m2) fine root N storage
   real(r8), pointer :: frootn_xfer(:)        ! (gN/m2) fine root N transfer
   real(r8), pointer :: leafn(:)              ! (gN/m2) leaf N 
   real(r8), pointer :: leafn_storage(:)      ! (gN/m2) leaf N storage
   real(r8), pointer :: leafn_xfer(:)         ! (gN/m2) leaf N transfer
   real(r8), pointer :: livecrootn(:)         ! (gN/m2) live coarse root N
   real(r8), pointer :: livecrootn_storage(:) ! (gN/m2) live coarse root N storage
   real(r8), pointer :: livecrootn_xfer(:)    ! (gN/m2) live coarse root N transfer
#if (defined CROP)
   real(r8), pointer :: grainn(:)             ! (gC/m2) grain N
   real(r8), pointer :: grainn_storage(:)     ! (gC/m2) grain N storage
   real(r8), pointer :: grainn_xfer(:)        ! (gC/m2) grain N transfer
#endif
   real(r8), pointer :: livestemn(:)          ! (gN/m2) live stem N
   real(r8), pointer :: livestemn_storage(:)  ! (gN/m2) live stem N storage
   real(r8), pointer :: livestemn_xfer(:)     ! (gN/m2) live stem N transfer
   real(r8), pointer :: npool(:)              ! (gN/m2) temporary plant N pool
   real(r8), pointer :: pft_ntrunc(:)         ! (gN/m2) pft-level sink for N truncation
   real(r8), pointer :: retransn(:)           ! (gN/m2) plant pool of retranslocated N
!
! local pointers to implicit in/out scalars
!
! local pointers to implicit out scalars
!
! !OTHER LOCAL VARIABLES:
   integer :: c,p      ! indices
   integer :: fp,fc    ! lake filter indices
   real(r8):: pc,pn    ! truncation terms for pft-level corrections
   real(r8):: cc,cn    ! truncation terms for column-level corrections
#if (defined C13)
   real(r8):: pc13     ! truncation terms for pft-level corrections
   real(r8):: cc13     ! truncation terms for column-level corrections
#endif
   real(r8):: ccrit    ! critical carbon state value for truncation
   real(r8):: ncrit    ! critical nitrogen state value for truncation
    
!EOP
!-----------------------------------------------------------------------
    ! assign local pointers at the column level
    col_ctrunc                     => clm3%g%l%c%ccs%col_ctrunc
    cwdc                           => clm3%g%l%c%ccs%cwdc
    litr1c                         => clm3%g%l%c%ccs%litr1c
    litr2c                         => clm3%g%l%c%ccs%litr2c
    litr3c                         => clm3%g%l%c%ccs%litr3c
    soil1c                         => clm3%g%l%c%ccs%soil1c
    soil2c                         => clm3%g%l%c%ccs%soil2c
    soil3c                         => clm3%g%l%c%ccs%soil3c
    soil4c                         => clm3%g%l%c%ccs%soil4c
#if (defined C13)
    c13_col_ctrunc                     => clm3%g%l%c%cc13s%col_ctrunc
    c13_cwdc                           => clm3%g%l%c%cc13s%cwdc
    c13_litr1c                         => clm3%g%l%c%cc13s%litr1c
    c13_litr2c                         => clm3%g%l%c%cc13s%litr2c
    c13_litr3c                         => clm3%g%l%c%cc13s%litr3c
    c13_soil1c                         => clm3%g%l%c%cc13s%soil1c
    c13_soil2c                         => clm3%g%l%c%cc13s%soil2c
    c13_soil3c                         => clm3%g%l%c%cc13s%soil3c
    c13_soil4c                         => clm3%g%l%c%cc13s%soil4c
#endif
    col_ntrunc                     => clm3%g%l%c%cns%col_ntrunc
    cwdn                           => clm3%g%l%c%cns%cwdn
    litr1n                         => clm3%g%l%c%cns%litr1n
    litr2n                         => clm3%g%l%c%cns%litr2n
    litr3n                         => clm3%g%l%c%cns%litr3n
    soil1n                         => clm3%g%l%c%cns%soil1n
    soil2n                         => clm3%g%l%c%cns%soil2n
    soil3n                         => clm3%g%l%c%cns%soil3n
    soil4n                         => clm3%g%l%c%cns%soil4n

    ! assign local pointers at the pft level
    cpool                          => clm3%g%l%c%p%pcs%cpool
    deadcrootc                     => clm3%g%l%c%p%pcs%deadcrootc
    deadcrootc_storage             => clm3%g%l%c%p%pcs%deadcrootc_storage
    deadcrootc_xfer                => clm3%g%l%c%p%pcs%deadcrootc_xfer
    deadstemc                      => clm3%g%l%c%p%pcs%deadstemc
    deadstemc_storage              => clm3%g%l%c%p%pcs%deadstemc_storage
    deadstemc_xfer                 => clm3%g%l%c%p%pcs%deadstemc_xfer
    frootc                         => clm3%g%l%c%p%pcs%frootc
    frootc_storage                 => clm3%g%l%c%p%pcs%frootc_storage
    frootc_xfer                    => clm3%g%l%c%p%pcs%frootc_xfer
    gresp_storage                  => clm3%g%l%c%p%pcs%gresp_storage
    gresp_xfer                     => clm3%g%l%c%p%pcs%gresp_xfer
    leafc                          => clm3%g%l%c%p%pcs%leafc
    leafc_storage                  => clm3%g%l%c%p%pcs%leafc_storage
    leafc_xfer                     => clm3%g%l%c%p%pcs%leafc_xfer
    livecrootc                     => clm3%g%l%c%p%pcs%livecrootc
    livecrootc_storage             => clm3%g%l%c%p%pcs%livecrootc_storage
    livecrootc_xfer                => clm3%g%l%c%p%pcs%livecrootc_xfer
    livestemc                      => clm3%g%l%c%p%pcs%livestemc
    livestemc_storage              => clm3%g%l%c%p%pcs%livestemc_storage
    livestemc_xfer                 => clm3%g%l%c%p%pcs%livestemc_xfer
    pft_ctrunc                     => clm3%g%l%c%p%pcs%pft_ctrunc
#if (defined CROP)
    xsmrpool                       => clm3%g%l%c%p%pcs%xsmrpool
    grainc                         => clm3%g%l%c%p%pcs%grainc
    grainc_storage                 => clm3%g%l%c%p%pcs%grainc_storage
    grainc_xfer                    => clm3%g%l%c%p%pcs%grainc_xfer
#if (defined C13)
    c13_xsmrpool                       => clm3%g%l%c%p%pc13s%xsmrpool
    c13_grainc                         => clm3%g%l%c%p%pc13s%grainc
    c13_grainc_storage                 => clm3%g%l%c%p%pc13s%grainc_storage
    c13_grainc_xfer                    => clm3%g%l%c%p%pc13s%grainc_xfer
#endif
#endif
#if (defined C13)
    c13_cpool                          => clm3%g%l%c%p%pc13s%cpool
    c13_deadcrootc                     => clm3%g%l%c%p%pc13s%deadcrootc
    c13_deadcrootc_storage             => clm3%g%l%c%p%pc13s%deadcrootc_storage
    c13_deadcrootc_xfer                => clm3%g%l%c%p%pc13s%deadcrootc_xfer
    c13_deadstemc                      => clm3%g%l%c%p%pc13s%deadstemc
    c13_deadstemc_storage              => clm3%g%l%c%p%pc13s%deadstemc_storage
    c13_deadstemc_xfer                 => clm3%g%l%c%p%pc13s%deadstemc_xfer
    c13_frootc                         => clm3%g%l%c%p%pc13s%frootc
    c13_frootc_storage                 => clm3%g%l%c%p%pc13s%frootc_storage
    c13_frootc_xfer                    => clm3%g%l%c%p%pc13s%frootc_xfer
    c13_gresp_storage                  => clm3%g%l%c%p%pc13s%gresp_storage
    c13_gresp_xfer                     => clm3%g%l%c%p%pc13s%gresp_xfer
    c13_leafc                          => clm3%g%l%c%p%pc13s%leafc
    c13_leafc_storage                  => clm3%g%l%c%p%pc13s%leafc_storage
    c13_leafc_xfer                     => clm3%g%l%c%p%pc13s%leafc_xfer
    c13_livecrootc                     => clm3%g%l%c%p%pc13s%livecrootc
    c13_livecrootc_storage             => clm3%g%l%c%p%pc13s%livecrootc_storage
    c13_livecrootc_xfer                => clm3%g%l%c%p%pc13s%livecrootc_xfer
    c13_livestemc                      => clm3%g%l%c%p%pc13s%livestemc
    c13_livestemc_storage              => clm3%g%l%c%p%pc13s%livestemc_storage
    c13_livestemc_xfer                 => clm3%g%l%c%p%pc13s%livestemc_xfer
    c13_pft_ctrunc                     => clm3%g%l%c%p%pc13s%pft_ctrunc
#endif
    deadcrootn                     => clm3%g%l%c%p%pns%deadcrootn
    deadcrootn_storage             => clm3%g%l%c%p%pns%deadcrootn_storage
    deadcrootn_xfer                => clm3%g%l%c%p%pns%deadcrootn_xfer
    deadstemn                      => clm3%g%l%c%p%pns%deadstemn
    deadstemn_storage              => clm3%g%l%c%p%pns%deadstemn_storage
    deadstemn_xfer                 => clm3%g%l%c%p%pns%deadstemn_xfer
    frootn                         => clm3%g%l%c%p%pns%frootn
    frootn_storage                 => clm3%g%l%c%p%pns%frootn_storage
    frootn_xfer                    => clm3%g%l%c%p%pns%frootn_xfer
    leafn                          => clm3%g%l%c%p%pns%leafn
    leafn_storage                  => clm3%g%l%c%p%pns%leafn_storage
    leafn_xfer                     => clm3%g%l%c%p%pns%leafn_xfer
    livecrootn                     => clm3%g%l%c%p%pns%livecrootn
    livecrootn_storage             => clm3%g%l%c%p%pns%livecrootn_storage
    livecrootn_xfer                => clm3%g%l%c%p%pns%livecrootn_xfer
#if (defined CROP)
    grainn                         => clm3%g%l%c%p%pns%grainn
    grainn_storage                 => clm3%g%l%c%p%pns%grainn_storage
    grainn_xfer                    => clm3%g%l%c%p%pns%grainn_xfer
#endif
    livestemn                      => clm3%g%l%c%p%pns%livestemn
    livestemn_storage              => clm3%g%l%c%p%pns%livestemn_storage
    livestemn_xfer                 => clm3%g%l%c%p%pns%livestemn_xfer
    npool                          => clm3%g%l%c%p%pns%npool
    pft_ntrunc                     => clm3%g%l%c%p%pns%pft_ntrunc
    retransn                       => clm3%g%l%c%p%pns%retransn
   
   ! set the critical carbon state value for truncation (gC/m2)
   ccrit = 1.e-8_r8
   ! set the critical nitrogen state value for truncation (gN/m2)
   ncrit = 1.e-8_r8
   
   ! pft loop
   do fp = 1,num_soilp
      p = filter_soilp(fp)
      
      ! initialize the pft-level C and N truncation terms
      pc = 0._r8
#if (defined C13)
      pc13 = 0._r8
#endif
      pn = 0._r8
      
      ! do tests on state variables for precision control
      ! for linked C-N state variables, perform precision test on
      ! the C component, but truncate C, C13, and N components
      write(6,*) '******************************************'     
      write(6,*) 'CHECK cn variables in CNPrecisionControl'
      write(6,*) '******************************************'    
      write(6,*) 'leafc(',p,')=',leafc(p)   
      write(6,*) 'leafn(',p,')=',leafn(p)
      write(6,*) 'leafc_storage(',p,')=',leafc_storage(p)
      write(6,*) 'leafn_storage(',p,')=',leafn_storage(p)
      write(6,*) 'leafc_xfer(',p,')=',leafc_xfer(p)
      write(6,*) 'leafn_xfer(',p,')=',leafn_xfer(p)
      write(6,*) 'frootc(',p,')=',frootc(p)
      write(6,*) 'frootc_storage(',p,')=',frootc_storage(p)
      write(6,*) 'frootn(',p,')=',frootn(p)
      write(6,*) 'frootn_storage(',p,')=',frootn_storage(p)
      write(6,*) 'frootc_xfer(',p,')=',frootc_xfer(p)
      write(6,*) 'frootn_xfer(',p,')=',frootn_xfer(p)
      write(6,*) 'grainc(',p,')=',grainc(p)
      write(6,*) 'grainc_storage(',p,')=',grainc_storage(p) 
      write(6,*) 'grainc_xfer(',p,')=',grainc_xfer(p)
      write(6,*) 'grainn(',p,')=',grainn(p)
      write(6,*) 'grainn_storage(',p,')=',grainn_storage(p)
      write(6,*) 'grainn_xfer(',p,')=',grainn_xfer(p)
      write(6,*) 'livestemc(',p,')=',livestemc(p)
      write(6,*) 'livestemc_storage(',p,')=',livestemc_storage(p)
      write(6,*) 'livestemc_xfer(',p,')=',livestemc_xfer(p)
      write(6,*) 'livestemn(',p,')=',livestemn(p)
      write(6,*) 'livestemn_storage(',p,')=',livestemn_storage(p)
      write(6,*) 'livestemn_xfer(',p,')=',livestemn_xfer(p)
      write(6,*) 'deadstemc(',p,')=',deadstemc(p)
      write(6,*) 'deadstemc_storage(',p,')=',deadstemc_storage(p)
      write(6,*) 'deadstemc_xfer(',p,')=',deadstemc_xfer(p)
      write(6,*) 'deadstemn(',p,')=',deadstemn(p)
      write(6,*) 'deadstemn_storage(',p,')=',deadstemn_storage(p)
      write(6,*) 'deadstemn_xfer(',p,')=',deadstemn_xfer(p)
      write(6,*) 'livecrootc(',p,')=',livecrootc(p)
      write(6,*) 'livecrootc_storage(',p,')=',livecrootc_storage(p)
      write(6,*) 'livecrootc_xfer(',p,')=',livecrootc_xfer(p)
      write(6,*) 'livecrootn(',p,')=',livecrootn(p)
      write(6,*) 'livecrootn_storage(',p,')=',livecrootn_storage(p)
      write(6,*) 'livecrootn_xfer(',p,')=',livecrootn_xfer(p)
      write(6,*) 'deadcrootc(',p,')=',deadcrootc(p)
      write(6,*) 'deadcrootc_storage(',p,')=',deadcrootc_storage(p)
      write(6,*) 'deadcrootc_xfer(',p,')=',deadcrootc_xfer(p)
      write(6,*) 'deadcrootn(',p,')=',deadcrootn(p)
      write(6,*) 'deadcrootn_storage(',p,')=',deadcrootn_storage(p)
      write(6,*) 'deadcrootn_xfer(',p,')=',deadcrootn_xfer(p)
      write(6,*) 'gresp_storage(',p,')=',gresp_storage(p)
      write(6,*) 'gresp_xfer(',p,')=',gresp_xfer(p)
      write(6,*) 'cpool(',p,')=',cpool(p)
      write(6,*) 'npool(',p,')=',npool(p)
      write(6,*) 'xsmrpool(',p,')=',xsmrpool(p)
      write(6,*) 'retransn(',p,')=',retransn(p)
      write(6,*) '******************************************'

 



      ! leaf C and N
      if (abs(leafc(p)) < ccrit) then
          pc = pc + leafc(p)
          leafc(p) = 0._r8
#if (defined C13)
          pc13 = pc13 + c13_leafc(p)
          c13_leafc(p) = 0._r8
#endif
          pn = pn + leafn(p)
          leafn(p) = 0._r8
      end if

      ! leaf storage C and N
      if (abs(leafc_storage(p)) < ccrit) then
          pc = pc + leafc_storage(p)
          leafc_storage(p) = 0._r8
#if (defined C13)
          pc13 = pc13 + c13_leafc_storage(p)
          c13_leafc_storage(p) = 0._r8
#endif
          pn = pn + leafn_storage(p)
          leafn_storage(p) = 0._r8
      end if
          
      ! leaf transfer C and N
      if (abs(leafc_xfer(p)) < ccrit) then
          pc = pc + leafc_xfer(p)
          leafc_xfer(p) = 0._r8
#if (defined C13)
          pc13 = pc13 + c13_leafc_xfer(p)
          c13_leafc_xfer(p) = 0._r8
#endif
          pn = pn + leafn_xfer(p)
          leafn_xfer(p) = 0._r8
      end if
          
      ! froot C and N
      if (abs(frootc(p)) < ccrit) then
          pc = pc + frootc(p)
          frootc(p) = 0._r8
#if (defined C13)
          pc13 = pc13 + c13_frootc(p)
          c13_frootc(p) = 0._r8
#endif
          pn = pn + frootn(p)
          frootn(p) = 0._r8
      end if

      ! froot storage C and N
      if (abs(frootc_storage(p)) < ccrit) then
          pc = pc + frootc_storage(p)
          frootc_storage(p) = 0._r8
#if (defined C13)
          pc13 = pc13 + c13_frootc_storage(p)
          c13_frootc_storage(p) = 0._r8
#endif
          pn = pn + frootn_storage(p)
          frootn_storage(p) = 0._r8
      end if
          
      ! froot transfer C and N
      if (abs(frootc_xfer(p)) < ccrit) then
          pc = pc + frootc_xfer(p)
          frootc_xfer(p) = 0._r8
#if (defined C13)
          pc13 = pc13 + c13_frootc_xfer(p)
          c13_frootc_xfer(p) = 0._r8
#endif
          pn = pn + frootn_xfer(p)
          frootn_xfer(p) = 0._r8
      end if
          
#if (defined CROP)
      ! grain C and N
      if (abs(grainc(p)) < ccrit) then
          pc = pc + grainc(p)
          grainc(p) = 0._r8
#if (defined C13)
          pc13 = pc13 + c13_grainc(p)
          c13_grainc(p) = 0._r8
#endif
          pn = pn + grainn(p)
          grainn(p) = 0._r8
      end if

      ! grain storage C and N
      if (abs(grainc_storage(p)) < ccrit) then
          pc = pc + grainc_storage(p)
          grainc_storage(p) = 0._r8
#if (defined C13)
          pc13 = pc13 + c13_grainc_storage(p)
          c13_grainc_storage(p) = 0._r8
#endif
          pn = pn + grainn_storage(p)
          grainn_storage(p) = 0._r8
      end if
          
      ! grain transfer C and N
      if (abs(grainc_xfer(p)) < ccrit) then
          pc = pc + grainc_xfer(p)
          grainc_xfer(p) = 0._r8
#if (defined C13)
          pc13 = pc13 + c13_grainc_xfer(p)
          c13_grainc_xfer(p) = 0._r8
#endif
          pn = pn + grainn_xfer(p)
          grainn_xfer(p) = 0._r8
      end if
#endif
          
      ! livestem C and N
      if (abs(livestemc(p)) < ccrit) then
          pc = pc + livestemc(p)
          livestemc(p) = 0._r8
#if (defined C13)
          pc13 = pc13 + c13_livestemc(p)
          c13_livestemc(p) = 0._r8
#endif
          pn = pn + livestemn(p)
          livestemn(p) = 0._r8
      end if

      ! livestem storage C and N
      if (abs(livestemc_storage(p)) < ccrit) then
          pc = pc + livestemc_storage(p)
          livestemc_storage(p) = 0._r8
#if (defined C13)
          pc13 = pc13 + c13_livestemc_storage(p)
          c13_livestemc_storage(p) = 0._r8
#endif
          pn = pn + livestemn_storage(p)
          livestemn_storage(p) = 0._r8
      end if
          
      ! livestem transfer C and N
      if (abs(livestemc_xfer(p)) < ccrit) then
          pc = pc + livestemc_xfer(p)
          livestemc_xfer(p) = 0._r8
#if (defined C13)
          pc13 = pc13 + c13_livestemc_xfer(p)
          c13_livestemc_xfer(p) = 0._r8
#endif
          pn = pn + livestemn_xfer(p)
          livestemn_xfer(p) = 0._r8
      end if
          
      ! deadstem C and N
      if (abs(deadstemc(p)) < ccrit) then
          pc = pc + deadstemc(p)
          deadstemc(p) = 0._r8
#if (defined C13)
          pc13 = pc13 + c13_deadstemc(p)
          c13_deadstemc(p) = 0._r8
#endif
          pn = pn + deadstemn(p)
          deadstemn(p) = 0._r8
      end if

      ! deadstem storage C and N
      if (abs(deadstemc_storage(p)) < ccrit) then
          pc = pc + deadstemc_storage(p)
          deadstemc_storage(p) = 0._r8
#if (defined C13)
          pc13 = pc13 + c13_deadstemc_storage(p)
          c13_deadstemc_storage(p) = 0._r8
#endif
          pn = pn + deadstemn_storage(p)
          deadstemn_storage(p) = 0._r8
      end if
          
      ! deadstem transfer C and N
      if (abs(deadstemc_xfer(p)) < ccrit) then
          pc = pc + deadstemc_xfer(p)
          deadstemc_xfer(p) = 0._r8
#if (defined C13)
          pc13 = pc13 + c13_deadstemc_xfer(p)
          c13_deadstemc_xfer(p) = 0._r8
#endif
          pn = pn + deadstemn_xfer(p)
          deadstemn_xfer(p) = 0._r8
      end if
          
      ! livecroot C and N
      if (abs(livecrootc(p)) < ccrit) then
          pc = pc + livecrootc(p)
          livecrootc(p) = 0._r8
#if (defined C13)
          pc13 = pc13 + c13_livecrootc(p)
          c13_livecrootc(p) = 0._r8
#endif
          pn = pn + livecrootn(p)
          livecrootn(p) = 0._r8
      end if

      ! livecroot storage C and N
      if (abs(livecrootc_storage(p)) < ccrit) then
          pc = pc + livecrootc_storage(p)
          livecrootc_storage(p) = 0._r8
#if (defined C13)
          pc13 = pc13 + c13_livecrootc_storage(p)
          c13_livecrootc_storage(p) = 0._r8
#endif
          pn = pn + livecrootn_storage(p)
          livecrootn_storage(p) = 0._r8
      end if
          
      ! livecroot transfer C and N
      if (abs(livecrootc_xfer(p)) < ccrit) then
          pc = pc + livecrootc_xfer(p)
          livecrootc_xfer(p) = 0._r8
#if (defined C13)
          pc13 = pc13 + c13_livecrootc_xfer(p)
          c13_livecrootc_xfer(p) = 0._r8
#endif
          pn = pn + livecrootn_xfer(p)
          livecrootn_xfer(p) = 0._r8
      end if
          
      ! deadcroot C and N
      if (abs(deadcrootc(p)) < ccrit) then
          pc = pc + deadcrootc(p)
          deadcrootc(p) = 0._r8
#if (defined C13)
          pc13 = pc13 + c13_deadcrootc(p)
          c13_deadcrootc(p) = 0._r8
#endif
          pn = pn + deadcrootn(p)
          deadcrootn(p) = 0._r8
      end if

      ! deadcroot storage C and N
      if (abs(deadcrootc_storage(p)) < ccrit) then
          pc = pc + deadcrootc_storage(p)
          deadcrootc_storage(p) = 0._r8
#if (defined C13)
          pc13 = pc13 + c13_deadcrootc_storage(p)
          c13_deadcrootc_storage(p) = 0._r8
#endif
          pn = pn + deadcrootn_storage(p)
          deadcrootn_storage(p) = 0._r8
      end if
          
      ! deadcroot transfer C and N
      if (abs(deadcrootc_xfer(p)) < ccrit) then
          pc = pc + deadcrootc_xfer(p)
          deadcrootc_xfer(p) = 0._r8
#if (defined C13)
          pc13 = pc13 + c13_deadcrootc_xfer(p)
          c13_deadcrootc_xfer(p) = 0._r8
#endif
          pn = pn + deadcrootn_xfer(p)
          deadcrootn_xfer(p) = 0._r8
      end if
          
      ! gresp_storage (C only)
      if (abs(gresp_storage(p)) < ccrit) then
          pc = pc + gresp_storage(p)
          gresp_storage(p) = 0._r8
#if (defined C13)
          pc13 = pc13 + c13_gresp_storage(p)
          c13_gresp_storage(p) = 0._r8
#endif
      end if

      ! gresp_xfer (C only)
      if (abs(gresp_xfer(p)) < ccrit) then
          pc = pc + gresp_xfer(p)
          gresp_xfer(p) = 0._r8
#if (defined C13)
          pc13 = pc13 + c13_gresp_xfer(p)
          c13_gresp_xfer(p) = 0._r8
#endif
      end if
          
      ! cpool (C only)
      if (abs(cpool(p)) < ccrit) then
          pc = pc + cpool(p)
          cpool(p) = 0._r8
#if (defined C13)
          pc13 = pc13 + c13_cpool(p)
          c13_cpool(p) = 0._r8
#endif
      end if
          
#if (defined CROP)
      ! xsmrpool (C only)
      if (abs(xsmrpool(p)) < ccrit) then
          pc = pc + xsmrpool(p)
          xsmrpool(p) = 0._r8
#if (defined C13)
          pc13 = pc13 + c13_xsmrpool(p)
          c13_xsmrpool(p) = 0._r8
#endif
      end if
#endif
          
      ! retransn (N only)
      if (abs(retransn(p)) < ncrit) then
          pn = pn + retransn(p)
          retransn(p) = 0._r8
      end if
          
      ! npool (N only)
      if (abs(npool(p)) < ncrit) then
          pn = pn + npool(p)
          npool(p) = 0._r8
      end if
      
       write(6,*) 'before pft_ctrunc(',p,')=',pft_ctrunc(p)
      pft_ctrunc(p) = pft_ctrunc(p) + pc
      write(6,*) 'in CNPrecisionControl,check pft_ctrunc'
      write(6,*) 'pc=',pc
      write(6,*) 'after pft_ctrunc(',p,')=',pft_ctrunc(p)

#if (defined C13)
      c13_pft_ctrunc(p) = c13_pft_ctrunc(p) + pc13
#endif
      pft_ntrunc(p) = pft_ntrunc(p) + pn
          
   end do ! end of pft loop

   ! column loop
   do fc = 1,num_soilc
      c = filter_soilc(fc)
      
      ! initialize the column-level C and N truncation terms
      cc = 0._r8
#if (defined C13)
      cc13 = 0._r8
#endif
      cn = 0._r8
      
      ! do tests on state variables for precision control
      ! for linked C-N state variables, perform precision test on
      ! the C component, but truncate both C and N components
      
      ! coarse woody debris C and N
      if (abs(cwdc(c)) < ccrit) then
          cc = cc + cwdc(c)
          cwdc(c) = 0._r8
#if (defined C13)
          cc13 = cc13 + c13_cwdc(c)
          c13_cwdc(c) = 0._r8
#endif
          cn = cn + cwdn(c)
          cwdn(c) = 0._r8
      end if

      ! litr1 C and N
      if (abs(litr1c(c)) < ccrit) then
          cc = cc + litr1c(c)
          litr1c(c) = 0._r8
#if (defined C13)
          cc13 = cc13 + c13_litr1c(c)
          c13_litr1c(c) = 0._r8
#endif
          cn = cn + litr1n(c)
          litr1n(c) = 0._r8
      end if

      ! litr2 C and N
      if (abs(litr2c(c)) < ccrit) then
          cc = cc + litr2c(c)
          litr2c(c) = 0._r8
#if (defined C13)
          cc13 = cc13 + c13_litr2c(c)
          c13_litr2c(c) = 0._r8
#endif
          cn = cn + litr2n(c)
          litr2n(c) = 0._r8
      end if

      ! litr3 C and N
      if (abs(litr3c(c)) < ccrit) then
          cc = cc + litr3c(c)
          litr3c(c) = 0._r8
#if (defined C13)
          cc13 = cc13 + c13_litr3c(c)
          c13_litr3c(c) = 0._r8
#endif
          cn = cn + litr3n(c)
          litr3n(c) = 0._r8
      end if

      ! soil1 C and N
      if (abs(soil1c(c)) < ccrit) then
          cc = cc + soil1c(c)
          soil1c(c) = 0._r8
#if (defined C13)
          cc13 = cc13 + c13_soil1c(c)
          c13_soil1c(c) = 0._r8
#endif
          cn = cn + soil1n(c)
          soil1n(c) = 0._r8
      end if

      ! soil2 C and N
      if (abs(soil2c(c)) < ccrit) then
          cc = cc + soil2c(c)
          soil2c(c) = 0._r8
#if (defined C13)
          cc13 = cc13 + c13_soil2c(c)
          c13_soil2c(c) = 0._r8
#endif
          cn = cn + soil2n(c)
          soil2n(c) = 0._r8
      end if

      ! soil3 C and N
      if (abs(soil3c(c)) < ccrit) then
          cc = cc + soil3c(c)
          soil3c(c) = 0._r8
#if (defined C13)
          cc13 = cc13 + c13_soil3c(c)
          c13_soil3c(c) = 0._r8
#endif
          cn = cn + soil3n(c)
          soil3n(c) = 0._r8
      end if
      
      ! soil4 C and N
      if (abs(soil4c(c)) < ccrit) then
          cc = cc + soil4c(c)
          soil4c(c) = 0._r8
#if (defined C13)
          cc13 = cc13 + c13_soil4c(c)
          c13_soil4c(c) = 0._r8
#endif
          cn = cn + soil4n(c)
          soil4n(c) = 0._r8
      end if
      
      ! not doing precision control on soil mineral N, since it will
      ! be getting the N truncation flux anyway.
      
      col_ctrunc(c) = col_ctrunc(c) + cc
#if (defined C13)
      c13_col_ctrunc(c) = c13_col_ctrunc(c) + cc13
#endif
      col_ntrunc(c) = col_ntrunc(c) + cn
      
   end do   ! end of column loop

end subroutine CNPrecisionControl
!-----------------------------------------------------------------------
#endif

end module CNPrecisionControlMod
module CNSummaryMod

#ifdef CN

!-----------------------------------------------------------------------
!BOP
!
! !MODULE: CNSummaryMod
!
! !DESCRIPTION:
! Module for carbon and nitrogen summary calculations
!
! !USES:
    use shr_kind_mod, only: r8 => shr_kind_r8
    implicit none
    save
    private
! !PUBLIC MEMBER FUNCTIONS:
    public :: CSummary
    public :: NSummary
!
! !REVISION HISTORY:
! 4/23/2004: Created by Peter Thornton
!
!EOP
!-----------------------------------------------------------------------

contains

!-----------------------------------------------------------------------
!BOP
!
! !IROUTINE: CSummary
!
! !INTERFACE:
subroutine CSummary(num_soilc, filter_soilc, num_soilp, filter_soilp)
!
! !DESCRIPTION:
! On the radiation time step, perform pft and column-level carbon
! summary calculations
!
! !USES:
   use clmtype
!ylu changed
!   use pft2colMod, only: p2c
   use subgridAveMod, only : p2c
!ylu remove
!   use clm_varctl, only: iulog
!   use shr_sys_mod, only: shr_sys_flush
!
! !ARGUMENTS:
   implicit none
   integer, intent(in) :: num_soilc       ! number of soil columns in filter
   integer, intent(in) :: filter_soilc(:) ! filter for soil columns
   integer, intent(in) :: num_soilp       ! number of soil pfts in filter
   integer, intent(in) :: filter_soilp(:) ! filter for soil pfts
!
! !CALLED FROM:
! subroutine CNEcosystemDyn
!
! !REVISION HISTORY:
! 12/9/03: Created by Peter Thornton
!
! !LOCAL VARIABLES:
! local pointers to implicit in scalars
   real(r8), pointer :: col_fire_closs(:)     ! (gC/m2/s) total column-level fire C loss
   real(r8), pointer :: er(:)                 ! (gC/m2/s) total ecosystem respiration, autotrophic + heterotrophic
   real(r8), pointer :: hr(:)                 ! (gC/m2/s) total heterotrophic respiration
   real(r8), pointer :: litfire(:)            ! (gC/m2/s) litter fire losses
   real(r8), pointer :: lithr(:)              ! (gC/m2/s) litter heterotrophic respiration 
   real(r8), pointer :: litr1_hr(:)       
   real(r8), pointer :: litr2_hr(:)        
   real(r8), pointer :: litr3_hr(:)        
   real(r8), pointer :: m_cwdc_to_fire(:)
   real(r8), pointer :: m_litr1c_to_fire(:)             
   real(r8), pointer :: m_litr2c_to_fire(:)             
   real(r8), pointer :: m_litr3c_to_fire(:)             
   real(r8), pointer :: nee(:)                ! (gC/m2/s) net ecosystem exchange of carbon, includes fire, land-use, harvest, and hrv_xsmrpool flux, positive for source
   real(r8), pointer :: nep(:)                ! (gC/m2/s) net ecosystem production, excludes fire, land-use, and harvest flux, positive for sink
   real(r8), pointer :: nbp(:)                ! (gC/m2/s) net biome production, includes fire, land-use, and harvest flux, positive for sink
   real(r8), pointer :: col_ar(:)             ! (gC/m2/s) autotrophic respiration (MR + GR)
   real(r8), pointer :: col_gpp(:)            ! GPP flux before downregulation (gC/m2/s)
   real(r8), pointer :: col_npp(:)            ! (gC/m2/s) net primary production
   real(r8), pointer :: col_pft_fire_closs(:) ! (gC/m2/s) total pft-level fire C loss 
   real(r8), pointer :: col_litfall(:)        ! (gC/m2/s) total pft-level litterfall C loss 
   real(r8), pointer :: col_rr(:)             ! (gC/m2/s) root respiration (fine root MR + total root GR)
   real(r8), pointer :: col_vegfire(:)        ! (gC/m2/s) pft-level fire loss (obsolete, mark for removal)
   real(r8), pointer :: col_wood_harvestc(:)
   real(r8), pointer :: soil1_hr(:)        
   real(r8), pointer :: soil2_hr(:)        
   real(r8), pointer :: soil3_hr(:) 
   real(r8), pointer :: soil4_hr(:) 
   real(r8), pointer :: somfire(:)            ! (gC/m2/s) soil organic matter fire losses
   real(r8), pointer :: somhr(:)              ! (gC/m2/s) soil organic matter heterotrophic respiration
   real(r8), pointer :: sr(:)                 ! (gC/m2/s) total soil respiration (HR + root resp)
   real(r8), pointer :: totfire(:)            ! (gC/m2/s) total ecosystem fire losses
   real(r8), pointer :: cwdc(:)               ! (gC/m2) coarse woody debris C
   real(r8), pointer :: litr1c(:)             ! (gC/m2) litter labile C
   real(r8), pointer :: litr2c(:)             ! (gC/m2) litter cellulose C
   real(r8), pointer :: litr3c(:)             ! (gC/m2) litter lignin C
   real(r8), pointer :: col_totpftc(:)        ! (gC/m2) total pft-level carbon, including cpool
   real(r8), pointer :: col_totvegc(:)        ! (gC/m2) total vegetation carbon, excluding cpool
   real(r8), pointer :: soil1c(:)             ! (gC/m2) soil organic matter C (fast pool)
   real(r8), pointer :: soil2c(:)             ! (gC/m2) soil organic matter C (medium pool)
   real(r8), pointer :: soil3c(:)             ! (gC/m2) soil organic matter C (slow pool)
   real(r8), pointer :: soil4c(:)             ! (gC/m2) soil organic matter C (slowest pool)
   real(r8), pointer :: col_ctrunc(:)         ! (gC/m2) column-level sink for C truncation
   real(r8), pointer :: totcolc(:)            ! (gC/m2) total column carbon, incl veg and cpool
   real(r8), pointer :: totecosysc(:)         ! (gC/m2) total ecosystem carbon, incl veg but excl cpool
   real(r8), pointer :: totlitc(:)            ! (gC/m2) total litter carbon
   real(r8), pointer :: totsomc(:)            ! (gC/m2) total soil organic matter carbon
   real(r8), pointer :: agnpp(:)              ! (gC/m2/s) aboveground NPP
   real(r8), pointer :: ar(:)                 ! (gC/m2/s) autotrophic respiration (MR + GR)
   real(r8), pointer :: bgnpp(:)              ! (gC/m2/s) belowground NPP
#if (defined CROP)
   real(r8), pointer :: xsmrpool_to_atm(:)         
   real(r8), pointer :: cpool_grain_gr(:)         
   real(r8), pointer :: cpool_grain_storage_gr(:) 
   real(r8), pointer :: cpool_to_grainc(:)         
   real(r8), pointer :: grainc_xfer_to_grainc(:) 
   real(r8), pointer :: transfer_grain_gr(:)      
   real(r8), pointer :: grainc_to_food(:)      
   real(r8), pointer :: livestemc_to_litter(:)      
   real(r8), pointer :: grainc(:)             ! (gC/m2) grain C
   real(r8), pointer :: grainc_storage(:)     ! (gC/m2) grain C storage
   real(r8), pointer :: grainc_xfer(:)        ! (gC/m2) grain C transfer
#endif
   real(r8), pointer :: cpool_deadcroot_gr(:)        
   real(r8), pointer :: cpool_deadcroot_storage_gr(:)
   real(r8), pointer :: cpool_deadstem_gr(:)         
   real(r8), pointer :: cpool_deadstem_storage_gr(:) 
   real(r8), pointer :: cpool_froot_gr(:)            
   real(r8), pointer :: cpool_froot_storage_gr(:)    
   real(r8), pointer :: cpool_leaf_gr(:)             
   real(r8), pointer :: cpool_leaf_storage_gr(:)     
   real(r8), pointer :: cpool_livecroot_gr(:)        
   real(r8), pointer :: cpool_livecroot_storage_gr(:)
   real(r8), pointer :: cpool_livestem_gr(:)         
   real(r8), pointer :: cpool_livestem_storage_gr(:) 
   real(r8), pointer :: cpool_to_deadcrootc(:)        
   real(r8), pointer :: cpool_to_deadstemc(:)         
   real(r8), pointer :: cpool_to_frootc(:)            
   real(r8), pointer :: cpool_to_leafc(:)             
   real(r8), pointer :: cpool_to_livecrootc(:)        
   real(r8), pointer :: cpool_to_livestemc(:)         
   real(r8), pointer :: current_gr(:)         ! (gC/m2/s) growth resp for new growth displayed in this timestep
   real(r8), pointer :: deadcrootc_xfer_to_deadcrootc(:)
   real(r8), pointer :: deadstemc_xfer_to_deadstemc(:) 
   real(r8), pointer :: frootc_to_litter(:)
   real(r8), pointer :: frootc_xfer_to_frootc(:)       
   real(r8), pointer :: froot_mr(:)     
   real(r8), pointer :: gpp(:)                !GPP flux before downregulation (gC/m2/s)
   real(r8), pointer :: gr(:)                 ! (gC/m2/s) total growth respiration
   real(r8), pointer :: leafc_to_litter(:)
   real(r8), pointer :: leafc_xfer_to_leafc(:)         
   real(r8), pointer :: leaf_mr(:)
   real(r8), pointer :: litfall(:)            ! (gC/m2/s) litterfall (leaves and fine roots)
   real(r8), pointer :: livecrootc_xfer_to_livecrootc(:)
   real(r8), pointer :: livecroot_mr(:)
   real(r8), pointer :: livestemc_xfer_to_livestemc(:) 
   real(r8), pointer :: livestem_mr(:)  
   real(r8), pointer :: m_deadcrootc_storage_to_fire(:) 
   real(r8), pointer :: m_deadcrootc_storage_to_litter(:) 
   real(r8), pointer :: m_deadcrootc_to_fire(:)         
   real(r8), pointer :: m_deadcrootc_to_litter(:)           
   real(r8), pointer :: m_deadcrootc_to_litter_fire(:)         
   real(r8), pointer :: m_deadcrootc_xfer_to_fire(:)
   real(r8), pointer :: m_deadcrootc_xfer_to_litter(:)
   real(r8), pointer :: m_deadstemc_storage_to_fire(:)  
   real(r8), pointer :: m_deadstemc_storage_to_litter(:)  
   real(r8), pointer :: m_deadstemc_to_fire(:)
   real(r8), pointer :: m_deadstemc_to_litter(:)            
   real(r8), pointer :: m_deadstemc_to_litter_fire(:)
   real(r8), pointer :: m_deadstemc_xfer_to_fire(:) 
   real(r8), pointer :: m_deadstemc_xfer_to_litter(:) 
   real(r8), pointer :: m_frootc_storage_to_fire(:)     
   real(r8), pointer :: m_frootc_storage_to_litter(:)     
   real(r8), pointer :: m_frootc_to_fire(:)             
   real(r8), pointer :: m_frootc_to_litter(:)             
   real(r8), pointer :: m_frootc_xfer_to_fire(:)    
   real(r8), pointer :: m_frootc_xfer_to_litter(:)    
   real(r8), pointer :: m_gresp_storage_to_fire(:)      
   real(r8), pointer :: m_gresp_storage_to_litter(:)      
   real(r8), pointer :: m_gresp_xfer_to_fire(:)    
   real(r8), pointer :: m_gresp_xfer_to_litter(:)
   real(r8), pointer :: m_leafc_storage_to_fire(:)      
   real(r8), pointer :: m_leafc_storage_to_litter(:)      
   real(r8), pointer :: m_leafc_to_fire(:)             
   real(r8), pointer :: m_leafc_to_litter(:)
   real(r8), pointer :: m_leafc_xfer_to_fire(:)     
   real(r8), pointer :: m_leafc_xfer_to_litter(:)    
   real(r8), pointer :: m_livecrootc_storage_to_fire(:) 
   real(r8), pointer :: m_livecrootc_storage_to_litter(:) 
   real(r8), pointer :: m_livecrootc_to_fire(:)         
   real(r8), pointer :: m_livecrootc_to_litter(:)           
   real(r8), pointer :: m_livecrootc_xfer_to_fire(:)
   real(r8), pointer :: m_livecrootc_xfer_to_litter(:)
   real(r8), pointer :: m_livestemc_storage_to_fire(:)  
   real(r8), pointer :: m_livestemc_storage_to_litter(:)  
   real(r8), pointer :: m_livestemc_to_fire(:)          
   real(r8), pointer :: m_livestemc_to_litter(:)            
   real(r8), pointer :: m_livestemc_xfer_to_fire(:) 
   real(r8), pointer :: m_livestemc_xfer_to_litter(:) 
   real(r8), pointer :: hrv_leafc_to_litter(:)              
   real(r8), pointer :: hrv_leafc_storage_to_litter(:)      
   real(r8), pointer :: hrv_leafc_xfer_to_litter(:)         
   real(r8), pointer :: hrv_frootc_to_litter(:)             
   real(r8), pointer :: hrv_frootc_storage_to_litter(:)     
   real(r8), pointer :: hrv_frootc_xfer_to_litter(:)        
   real(r8), pointer :: hrv_livestemc_to_litter(:)          
   real(r8), pointer :: hrv_livestemc_storage_to_litter(:)  
   real(r8), pointer :: hrv_livestemc_xfer_to_litter(:)     
   real(r8), pointer :: hrv_deadstemc_to_prod10c(:)         
   real(r8), pointer :: hrv_deadstemc_to_prod100c(:)        
   real(r8), pointer :: hrv_deadstemc_storage_to_litter(:)  
   real(r8), pointer :: hrv_deadstemc_xfer_to_litter(:)     
   real(r8), pointer :: hrv_livecrootc_to_litter(:)         
   real(r8), pointer :: hrv_livecrootc_storage_to_litter(:) 
   real(r8), pointer :: hrv_livecrootc_xfer_to_litter(:)    
   real(r8), pointer :: hrv_deadcrootc_to_litter(:)         
   real(r8), pointer :: hrv_deadcrootc_storage_to_litter(:) 
   real(r8), pointer :: hrv_deadcrootc_xfer_to_litter(:)    
   real(r8), pointer :: hrv_gresp_storage_to_litter(:)      
   real(r8), pointer :: hrv_gresp_xfer_to_litter(:)         
   real(r8), pointer :: hrv_xsmrpool_to_atm(:)              
   real(r8), pointer :: col_hrv_xsmrpool_to_atm(:)              
   real(r8), pointer :: mr(:)                 ! (gC/m2/s) maintenance respiration
   real(r8), pointer :: npp(:)                ! (gC/m2/s) net primary production
   real(r8), pointer :: pft_fire_closs(:)     ! (gC/m2/s) total pft-level fire C loss 
   real(r8), pointer :: psnshade_to_cpool(:)
   real(r8), pointer :: psnsun_to_cpool(:) 
   real(r8), pointer :: rr(:)                 ! (gC/m2/s) root respiration (fine root MR + total root GR)
   real(r8), pointer :: storage_gr(:)         ! (gC/m2/s) growth resp for growth sent to storage for later display
   real(r8), pointer :: transfer_deadcroot_gr(:)
   real(r8), pointer :: transfer_deadstem_gr(:)      
   real(r8), pointer :: transfer_froot_gr(:)         
   real(r8), pointer :: transfer_gr(:)        ! (gC/m2/s) growth resp for transfer growth displayed in this timestep
   real(r8), pointer :: transfer_leaf_gr(:)          
   real(r8), pointer :: transfer_livecroot_gr(:)     
   real(r8), pointer :: transfer_livestem_gr(:)      
   real(r8), pointer :: wood_harvestc(:)      ! (gC/m2/s) pft-level wood harvest (to product pools)
   real(r8), pointer :: vegfire(:)            ! (gC/m2/s) pft-level fire loss (obsolete, mark for removal)
   real(r8), pointer :: cpool(:)              ! (gC/m2) temporary photosynthate C pool
   real(r8), pointer :: xsmrpool(:)           ! (gC/m2) temporary photosynthate C pool
   real(r8), pointer :: pft_ctrunc(:)         ! (gC/m2) pft-level sink for C truncation
   real(r8), pointer :: deadcrootc(:)         ! (gC/m2) dead coarse root C
   real(r8), pointer :: deadcrootc_storage(:) ! (gC/m2) dead coarse root C storage
   real(r8), pointer :: deadcrootc_xfer(:)    ! (gC/m2) dead coarse root C transfer
   real(r8), pointer :: deadstemc(:)          ! (gC/m2) dead stem C
   real(r8), pointer :: deadstemc_storage(:)  ! (gC/m2) dead stem C storage
   real(r8), pointer :: deadstemc_xfer(:)     ! (gC/m2) dead stem C transfer
   real(r8), pointer :: dispvegc(:)           ! (gC/m2) displayed veg carbon, excluding storage and cpool
   real(r8), pointer :: frootc(:)             ! (gC/m2) fine root C
   real(r8), pointer :: frootc_storage(:)     ! (gC/m2) fine root C storage
   real(r8), pointer :: frootc_xfer(:)        ! (gC/m2) fine root C transfer
   real(r8), pointer :: gresp_storage(:)      ! (gC/m2) growth respiration storage
   real(r8), pointer :: gresp_xfer(:)         ! (gC/m2) growth respiration transfer
   real(r8), pointer :: leafc(:)              ! (gC/m2) leaf C
   real(r8), pointer :: leafc_storage(:)      ! (gC/m2) leaf C storage
   real(r8), pointer :: leafc_xfer(:)         ! (gC/m2) leaf C transfer
   real(r8), pointer :: livecrootc(:)         ! (gC/m2) live coarse root C
   real(r8), pointer :: livecrootc_storage(:) ! (gC/m2) live coarse root C storage
   real(r8), pointer :: livecrootc_xfer(:)    ! (gC/m2) live coarse root C transfer
   real(r8), pointer :: livestemc(:)          ! (gC/m2) live stem C
   real(r8), pointer :: livestemc_storage(:)  ! (gC/m2) live stem C storage
   real(r8), pointer :: livestemc_xfer(:)     ! (gC/m2) live stem C transfer
   real(r8), pointer :: storvegc(:)           ! (gC/m2) stored vegetation carbon, excluding cpool
   real(r8), pointer :: totpftc(:)            ! (gC/m2) total pft-level carbon, including cpool
   real(r8), pointer :: totvegc(:)            ! (gC/m2) total vegetation carbon, excluding cpool
   real(r8), pointer :: tempsum_npp(:)        ! temporary annual sum of NPP (gC/m2/yr)
#if (defined CNDV)
   real(r8), pointer :: tempsum_litfall(:)      !temporary annual sum of litfall (gC/m2/yr)
#endif
   ! for landcover change
   real(r8), pointer :: landuseflux(:)        ! (gC/m2/s) dwt_closs+product_closs
   real(r8), pointer :: landuptake(:)         ! (gC/m2/s) nee-landuseflux
   real(r8), pointer :: dwt_closs(:)          ! (gC/m2/s) total carbon loss from land cover conversion
   real(r8), pointer :: dwt_conv_cflux(:)     ! (gC/m2/s) conversion C flux (immediate loss to atm)
   real(r8), pointer :: prod10c_loss(:)       ! (gC/m2/s) loss from 10-yr wood product pool
   real(r8), pointer :: prod100c_loss(:)      ! (gC/m2/s) loss from 100-yr wood product pool
   real(r8), pointer :: product_closs(:)      ! (gC/m2/s) total wood product carbon loss
   real(r8), pointer :: seedc(:)              ! (gC/m2) column-level pool for seeding new PFTs
   real(r8), pointer :: prod10c(:)            ! (gC/m2) wood product C pool, 10-year lifespan
   real(r8), pointer :: prod100c(:)           ! (gC/m2) wood product C pool, 100-year lifespan
   real(r8), pointer :: totprodc(:)           ! (gC/m2) total wood product C


#if (defined CLAMP)
   ! CLAMP
   real(r8), pointer :: frootc_alloc(:)       ! fine root C allocation (gC/m2/s)
   real(r8), pointer :: frootc_loss(:)        ! fine root C loss (gC/m2/s)
   real(r8), pointer :: leafc_alloc(:)        ! leaf C allocation (gC/m2/s)
   real(r8), pointer :: leafc_loss(:)         ! leaf C loss (gC/m2/s)
   real(r8), pointer :: woodc(:)              ! wood C (gC/m2)
   real(r8), pointer :: woodc_alloc(:)        ! wood C allocation (gC/m2/s)
   real(r8), pointer :: woodc_loss(:)         ! wood C loss (gC/m2/s)
   real(r8), pointer :: cwdc_hr(:)            ! coarse woody debris C heterotrophic respiration (gC/m2/s)
   real(r8), pointer :: cwdc_loss(:)          ! coarse woody debris C loss (gC/m2/s)
   real(r8), pointer :: litterc_loss(:)       ! litter C loss (gC/m2/s)
   real(r8), pointer :: litr1c_to_soil1c(:)   ! litter1 C loss to soil1 (gC/m2/s)
   real(r8), pointer :: litr2c_to_soil2c(:)   ! litter2 C loss to soil2 (gC/m2/s)
   real(r8), pointer :: litr3c_to_soil3c(:)   ! litter3 C loss to soil3 (gC/m2/s)
   !  Added for CLAMP
   real(r8), pointer :: cwdc_to_litr2c(:)     ! cwdc C to soil2 (gC/m2/s)
   real(r8), pointer :: cwdc_to_litr3c(:)     ! cwdc C to soil3 (gC/m2/s)
#endif
!
!
! local pointers to implicit in/out scalars
!
!
! local pointers to implicit out scalars
!
!
! !OTHER LOCAL VARIABLES:
   integer :: c,p          ! indices
   integer :: fp,fc        ! lake filter indices

!EOP
!-----------------------------------------------------------------------
   ! assign local pointers
    col_fire_closs                 => clm3%g%l%c%ccf%col_fire_closs
    er                             => clm3%g%l%c%ccf%er
    hr                             => clm3%g%l%c%ccf%hr
    litfire                        => clm3%g%l%c%ccf%litfire
    lithr                          => clm3%g%l%c%ccf%lithr
    litr1_hr                       => clm3%g%l%c%ccf%litr1_hr
    litr2_hr                       => clm3%g%l%c%ccf%litr2_hr
    litr3_hr                       => clm3%g%l%c%ccf%litr3_hr
    m_cwdc_to_fire                 => clm3%g%l%c%ccf%m_cwdc_to_fire
    m_litr1c_to_fire               => clm3%g%l%c%ccf%m_litr1c_to_fire
    m_litr2c_to_fire               => clm3%g%l%c%ccf%m_litr2c_to_fire
    m_litr3c_to_fire               => clm3%g%l%c%ccf%m_litr3c_to_fire
#if (defined CLAMP)
    !  Added for CLAMP
    cwdc_to_litr2c                 => clm3%g%l%c%ccf%cwdc_to_litr2c
    cwdc_to_litr3c                 => clm3%g%l%c%ccf%cwdc_to_litr3c
    ! CLAMP
    litr1c_to_soil1c               => clm3%g%l%c%ccf%litr1c_to_soil1c
    litr2c_to_soil2c               => clm3%g%l%c%ccf%litr2c_to_soil2c
    litr3c_to_soil3c               => clm3%g%l%c%ccf%litr3c_to_soil3c
#endif
    nee                            => clm3%g%l%c%ccf%nee
    nep                            => clm3%g%l%c%ccf%nep
    nbp                            => clm3%g%l%c%ccf%nbp
    col_ar                         => clm3%g%l%c%ccf%pcf_a%ar
    col_gpp                        => clm3%g%l%c%ccf%pcf_a%gpp
    col_npp                        => clm3%g%l%c%ccf%pcf_a%npp
    col_pft_fire_closs             => clm3%g%l%c%ccf%pcf_a%pft_fire_closs
    col_litfall                    => clm3%g%l%c%ccf%pcf_a%litfall
    col_rr                         => clm3%g%l%c%ccf%pcf_a%rr
    col_vegfire                    => clm3%g%l%c%ccf%pcf_a%vegfire
    col_wood_harvestc              => clm3%g%l%c%ccf%pcf_a%wood_harvestc
    soil1_hr                       => clm3%g%l%c%ccf%soil1_hr
    soil2_hr                       => clm3%g%l%c%ccf%soil2_hr
    soil3_hr                       => clm3%g%l%c%ccf%soil3_hr
    soil4_hr                       => clm3%g%l%c%ccf%soil4_hr
    somfire                        => clm3%g%l%c%ccf%somfire
    somhr                          => clm3%g%l%c%ccf%somhr
    sr                             => clm3%g%l%c%ccf%sr
    totfire                        => clm3%g%l%c%ccf%totfire
#if (defined CLAMP)
    cwdc_hr                        => clm3%g%l%c%ccf%cwdc_hr
    cwdc_loss                      => clm3%g%l%c%ccf%cwdc_loss
    litterc_loss                   => clm3%g%l%c%ccf%litterc_loss
#endif
    ! dynamic landcover pointers
    dwt_closs                      => clm3%g%l%c%ccf%dwt_closs
    landuseflux                    => clm3%g%l%c%ccf%landuseflux
    landuptake                     => clm3%g%l%c%ccf%landuptake
    dwt_conv_cflux                 => clm3%g%l%c%ccf%dwt_conv_cflux
    seedc                          => clm3%g%l%c%ccs%seedc
    
    ! wood product pointers
    prod10c_loss                   => clm3%g%l%c%ccf%prod10c_loss
    prod100c_loss                  => clm3%g%l%c%ccf%prod100c_loss
    product_closs                  => clm3%g%l%c%ccf%product_closs
    prod10c                        => clm3%g%l%c%ccs%prod10c
    prod100c                       => clm3%g%l%c%ccs%prod100c
    totprodc                       => clm3%g%l%c%ccs%totprodc
    
    cwdc                           => clm3%g%l%c%ccs%cwdc
    litr1c                         => clm3%g%l%c%ccs%litr1c
    litr2c                         => clm3%g%l%c%ccs%litr2c
    litr3c                         => clm3%g%l%c%ccs%litr3c
    col_totpftc                    => clm3%g%l%c%ccs%pcs_a%totpftc
    col_totvegc                    => clm3%g%l%c%ccs%pcs_a%totvegc
    soil1c                         => clm3%g%l%c%ccs%soil1c
    soil2c                         => clm3%g%l%c%ccs%soil2c
    soil3c                         => clm3%g%l%c%ccs%soil3c
    soil4c                         => clm3%g%l%c%ccs%soil4c
    col_ctrunc                     => clm3%g%l%c%ccs%col_ctrunc
    totcolc                        => clm3%g%l%c%ccs%totcolc
    totecosysc                     => clm3%g%l%c%ccs%totecosysc
    totlitc                        => clm3%g%l%c%ccs%totlitc
    totsomc                        => clm3%g%l%c%ccs%totsomc
    agnpp                          => clm3%g%l%c%p%pcf%agnpp
    ar                             => clm3%g%l%c%p%pcf%ar
    bgnpp                          => clm3%g%l%c%p%pcf%bgnpp
#if (defined CROP)
    xsmrpool_to_atm                => clm3%g%l%c%p%pcf%xsmrpool_to_atm
    cpool_grain_gr                 => clm3%g%l%c%p%pcf%cpool_grain_gr
    cpool_grain_storage_gr         => clm3%g%l%c%p%pcf%cpool_grain_storage_gr
    cpool_to_grainc                => clm3%g%l%c%p%pcf%cpool_to_grainc
    grainc_xfer_to_grainc          => clm3%g%l%c%p%pcf%grainc_xfer_to_grainc
    transfer_grain_gr              => clm3%g%l%c%p%pcf%transfer_grain_gr
    grainc_to_food                 => clm3%g%l%c%p%pcf%grainc_to_food
    livestemc_to_litter            => clm3%g%l%c%p%pcf%livestemc_to_litter
    grainc                         => clm3%g%l%c%p%pcs%grainc
    grainc_storage                 => clm3%g%l%c%p%pcs%grainc_storage
    grainc_xfer                    => clm3%g%l%c%p%pcs%grainc_xfer
#endif
    cpool_deadcroot_gr             => clm3%g%l%c%p%pcf%cpool_deadcroot_gr
    cpool_deadcroot_storage_gr     => clm3%g%l%c%p%pcf%cpool_deadcroot_storage_gr
    cpool_deadstem_gr              => clm3%g%l%c%p%pcf%cpool_deadstem_gr
    cpool_deadstem_storage_gr      => clm3%g%l%c%p%pcf%cpool_deadstem_storage_gr
    cpool_froot_gr                 => clm3%g%l%c%p%pcf%cpool_froot_gr
    cpool_froot_storage_gr         => clm3%g%l%c%p%pcf%cpool_froot_storage_gr
    cpool_leaf_gr                  => clm3%g%l%c%p%pcf%cpool_leaf_gr
    cpool_leaf_storage_gr          => clm3%g%l%c%p%pcf%cpool_leaf_storage_gr
    cpool_livecroot_gr             => clm3%g%l%c%p%pcf%cpool_livecroot_gr
    cpool_livecroot_storage_gr     => clm3%g%l%c%p%pcf%cpool_livecroot_storage_gr
    cpool_livestem_gr              => clm3%g%l%c%p%pcf%cpool_livestem_gr
    cpool_livestem_storage_gr      => clm3%g%l%c%p%pcf%cpool_livestem_storage_gr
    cpool_to_deadcrootc            => clm3%g%l%c%p%pcf%cpool_to_deadcrootc
    cpool_to_deadstemc             => clm3%g%l%c%p%pcf%cpool_to_deadstemc
    cpool_to_frootc                => clm3%g%l%c%p%pcf%cpool_to_frootc
    cpool_to_leafc                 => clm3%g%l%c%p%pcf%cpool_to_leafc
    cpool_to_livecrootc            => clm3%g%l%c%p%pcf%cpool_to_livecrootc
    cpool_to_livestemc             => clm3%g%l%c%p%pcf%cpool_to_livestemc
    current_gr                     => clm3%g%l%c%p%pcf%current_gr
    deadcrootc_xfer_to_deadcrootc  => clm3%g%l%c%p%pcf%deadcrootc_xfer_to_deadcrootc
    deadstemc_xfer_to_deadstemc    => clm3%g%l%c%p%pcf%deadstemc_xfer_to_deadstemc
    frootc_to_litter               => clm3%g%l%c%p%pcf%frootc_to_litter
    frootc_xfer_to_frootc          => clm3%g%l%c%p%pcf%frootc_xfer_to_frootc
    froot_mr                       => clm3%g%l%c%p%pcf%froot_mr
    gpp                            => clm3%g%l%c%p%pcf%gpp
    gr                             => clm3%g%l%c%p%pcf%gr
    leafc_to_litter                => clm3%g%l%c%p%pcf%leafc_to_litter
    leafc_xfer_to_leafc            => clm3%g%l%c%p%pcf%leafc_xfer_to_leafc
    leaf_mr                        => clm3%g%l%c%p%pcf%leaf_mr
    litfall                        => clm3%g%l%c%p%pcf%litfall
    livecrootc_xfer_to_livecrootc  => clm3%g%l%c%p%pcf%livecrootc_xfer_to_livecrootc
    livecroot_mr                   => clm3%g%l%c%p%pcf%livecroot_mr
    livestemc_xfer_to_livestemc    => clm3%g%l%c%p%pcf%livestemc_xfer_to_livestemc
    livestem_mr                    => clm3%g%l%c%p%pcf%livestem_mr
    m_deadcrootc_storage_to_fire   => clm3%g%l%c%p%pcf%m_deadcrootc_storage_to_fire
    m_deadcrootc_storage_to_litter => clm3%g%l%c%p%pcf%m_deadcrootc_storage_to_litter
    m_deadcrootc_to_fire           => clm3%g%l%c%p%pcf%m_deadcrootc_to_fire
    m_deadcrootc_to_litter         => clm3%g%l%c%p%pcf%m_deadcrootc_to_litter
    m_deadcrootc_to_litter_fire    => clm3%g%l%c%p%pcf%m_deadcrootc_to_litter_fire
    m_deadcrootc_xfer_to_fire      => clm3%g%l%c%p%pcf%m_deadcrootc_xfer_to_fire
    m_deadcrootc_xfer_to_litter    => clm3%g%l%c%p%pcf%m_deadcrootc_xfer_to_litter
    m_deadstemc_storage_to_fire    => clm3%g%l%c%p%pcf%m_deadstemc_storage_to_fire
    m_deadstemc_storage_to_litter  => clm3%g%l%c%p%pcf%m_deadstemc_storage_to_litter
    m_deadstemc_to_fire            => clm3%g%l%c%p%pcf%m_deadstemc_to_fire
    m_deadstemc_to_litter          => clm3%g%l%c%p%pcf%m_deadstemc_to_litter
    m_deadstemc_to_litter_fire     => clm3%g%l%c%p%pcf%m_deadstemc_to_litter_fire
    m_deadstemc_xfer_to_fire       => clm3%g%l%c%p%pcf%m_deadstemc_xfer_to_fire
    m_deadstemc_xfer_to_litter     => clm3%g%l%c%p%pcf%m_deadstemc_xfer_to_litter
    m_frootc_storage_to_fire       => clm3%g%l%c%p%pcf%m_frootc_storage_to_fire
    m_frootc_storage_to_litter     => clm3%g%l%c%p%pcf%m_frootc_storage_to_litter
    m_frootc_to_fire               => clm3%g%l%c%p%pcf%m_frootc_to_fire
    m_frootc_to_litter             => clm3%g%l%c%p%pcf%m_frootc_to_litter
    m_frootc_xfer_to_fire          => clm3%g%l%c%p%pcf%m_frootc_xfer_to_fire
    m_frootc_xfer_to_litter        => clm3%g%l%c%p%pcf%m_frootc_xfer_to_litter
    m_gresp_storage_to_fire        => clm3%g%l%c%p%pcf%m_gresp_storage_to_fire
    m_gresp_storage_to_litter      => clm3%g%l%c%p%pcf%m_gresp_storage_to_litter
    m_gresp_xfer_to_fire           => clm3%g%l%c%p%pcf%m_gresp_xfer_to_fire
    m_gresp_xfer_to_litter         => clm3%g%l%c%p%pcf%m_gresp_xfer_to_litter
    m_leafc_storage_to_fire        => clm3%g%l%c%p%pcf%m_leafc_storage_to_fire
    m_leafc_storage_to_litter      => clm3%g%l%c%p%pcf%m_leafc_storage_to_litter
    m_leafc_to_fire                => clm3%g%l%c%p%pcf%m_leafc_to_fire
    m_leafc_to_litter              => clm3%g%l%c%p%pcf%m_leafc_to_litter
    m_leafc_xfer_to_fire           => clm3%g%l%c%p%pcf%m_leafc_xfer_to_fire
    m_leafc_xfer_to_litter         => clm3%g%l%c%p%pcf%m_leafc_xfer_to_litter
    m_livecrootc_storage_to_fire   => clm3%g%l%c%p%pcf%m_livecrootc_storage_to_fire
    m_livecrootc_storage_to_litter => clm3%g%l%c%p%pcf%m_livecrootc_storage_to_litter
    m_livecrootc_to_fire           => clm3%g%l%c%p%pcf%m_livecrootc_to_fire
    m_livecrootc_to_litter         => clm3%g%l%c%p%pcf%m_livecrootc_to_litter
    m_livecrootc_xfer_to_fire      => clm3%g%l%c%p%pcf%m_livecrootc_xfer_to_fire
    m_livecrootc_xfer_to_litter    => clm3%g%l%c%p%pcf%m_livecrootc_xfer_to_litter
    m_livestemc_storage_to_fire    => clm3%g%l%c%p%pcf%m_livestemc_storage_to_fire
    m_livestemc_storage_to_litter  => clm3%g%l%c%p%pcf%m_livestemc_storage_to_litter
    m_livestemc_to_fire            => clm3%g%l%c%p%pcf%m_livestemc_to_fire
    m_livestemc_to_litter          => clm3%g%l%c%p%pcf%m_livestemc_to_litter
    m_livestemc_xfer_to_fire       => clm3%g%l%c%p%pcf%m_livestemc_xfer_to_fire
    m_livestemc_xfer_to_litter     => clm3%g%l%c%p%pcf%m_livestemc_xfer_to_litter
    hrv_leafc_to_litter               => clm3%g%l%c%p%pcf%hrv_leafc_to_litter               
    hrv_leafc_storage_to_litter       => clm3%g%l%c%p%pcf%hrv_leafc_storage_to_litter     
    hrv_leafc_xfer_to_litter          => clm3%g%l%c%p%pcf%hrv_leafc_xfer_to_litter        
    hrv_frootc_to_litter              => clm3%g%l%c%p%pcf%hrv_frootc_to_litter            
    hrv_frootc_storage_to_litter      => clm3%g%l%c%p%pcf%hrv_frootc_storage_to_litter    
    hrv_frootc_xfer_to_litter         => clm3%g%l%c%p%pcf%hrv_frootc_xfer_to_litter       
    hrv_livestemc_to_litter           => clm3%g%l%c%p%pcf%hrv_livestemc_to_litter         
    hrv_livestemc_storage_to_litter   => clm3%g%l%c%p%pcf%hrv_livestemc_storage_to_litter 
    hrv_livestemc_xfer_to_litter      => clm3%g%l%c%p%pcf%hrv_livestemc_xfer_to_litter    
    hrv_deadstemc_to_prod10c          => clm3%g%l%c%p%pcf%hrv_deadstemc_to_prod10c        
    hrv_deadstemc_to_prod100c         => clm3%g%l%c%p%pcf%hrv_deadstemc_to_prod100c       
    hrv_deadstemc_storage_to_litter   => clm3%g%l%c%p%pcf%hrv_deadstemc_storage_to_litter 
    hrv_deadstemc_xfer_to_litter      => clm3%g%l%c%p%pcf%hrv_deadstemc_xfer_to_litter    
    hrv_livecrootc_to_litter          => clm3%g%l%c%p%pcf%hrv_livecrootc_to_litter        
    hrv_livecrootc_storage_to_litter  => clm3%g%l%c%p%pcf%hrv_livecrootc_storage_to_litter
    hrv_livecrootc_xfer_to_litter     => clm3%g%l%c%p%pcf%hrv_livecrootc_xfer_to_litter   
    hrv_deadcrootc_to_litter          => clm3%g%l%c%p%pcf%hrv_deadcrootc_to_litter        
    hrv_deadcrootc_storage_to_litter  => clm3%g%l%c%p%pcf%hrv_deadcrootc_storage_to_litter
    hrv_deadcrootc_xfer_to_litter     => clm3%g%l%c%p%pcf%hrv_deadcrootc_xfer_to_litter   
    hrv_gresp_storage_to_litter       => clm3%g%l%c%p%pcf%hrv_gresp_storage_to_litter     
    hrv_gresp_xfer_to_litter          => clm3%g%l%c%p%pcf%hrv_gresp_xfer_to_litter        
    hrv_xsmrpool_to_atm               => clm3%g%l%c%p%pcf%hrv_xsmrpool_to_atm             
    col_hrv_xsmrpool_to_atm           => clm3%g%l%c%ccf%pcf_a%hrv_xsmrpool_to_atm             
    mr                             => clm3%g%l%c%p%pcf%mr
    npp                            => clm3%g%l%c%p%pcf%npp
    pft_fire_closs                 => clm3%g%l%c%p%pcf%pft_fire_closs
    psnshade_to_cpool              => clm3%g%l%c%p%pcf%psnshade_to_cpool
    psnsun_to_cpool                => clm3%g%l%c%p%pcf%psnsun_to_cpool
    rr                             => clm3%g%l%c%p%pcf%rr
    storage_gr                     => clm3%g%l%c%p%pcf%storage_gr
    transfer_deadcroot_gr          => clm3%g%l%c%p%pcf%transfer_deadcroot_gr
    transfer_deadstem_gr           => clm3%g%l%c%p%pcf%transfer_deadstem_gr
    transfer_froot_gr              => clm3%g%l%c%p%pcf%transfer_froot_gr
    transfer_gr                    => clm3%g%l%c%p%pcf%transfer_gr
    transfer_leaf_gr               => clm3%g%l%c%p%pcf%transfer_leaf_gr
    transfer_livecroot_gr          => clm3%g%l%c%p%pcf%transfer_livecroot_gr
    transfer_livestem_gr           => clm3%g%l%c%p%pcf%transfer_livestem_gr
    vegfire                        => clm3%g%l%c%p%pcf%vegfire
    wood_harvestc                  => clm3%g%l%c%p%pcf%wood_harvestc
#if (defined CLAMP)
    !CLAMP
    frootc_alloc                   => clm3%g%l%c%p%pcf%frootc_alloc
    frootc_loss                    => clm3%g%l%c%p%pcf%frootc_loss
    leafc_alloc                    => clm3%g%l%c%p%pcf%leafc_alloc
    leafc_loss                     => clm3%g%l%c%p%pcf%leafc_loss
    woodc_alloc                    => clm3%g%l%c%p%pcf%woodc_alloc
    woodc_loss                     => clm3%g%l%c%p%pcf%woodc_loss
#endif
    cpool                          => clm3%g%l%c%p%pcs%cpool
    xsmrpool                       => clm3%g%l%c%p%pcs%xsmrpool
	pft_ctrunc                     => clm3%g%l%c%p%pcs%pft_ctrunc
    deadcrootc                     => clm3%g%l%c%p%pcs%deadcrootc
    deadcrootc_storage             => clm3%g%l%c%p%pcs%deadcrootc_storage
    deadcrootc_xfer                => clm3%g%l%c%p%pcs%deadcrootc_xfer
    deadstemc                      => clm3%g%l%c%p%pcs%deadstemc
    deadstemc_storage              => clm3%g%l%c%p%pcs%deadstemc_storage
    deadstemc_xfer                 => clm3%g%l%c%p%pcs%deadstemc_xfer
    dispvegc                       => clm3%g%l%c%p%pcs%dispvegc
    frootc                         => clm3%g%l%c%p%pcs%frootc
    frootc_storage                 => clm3%g%l%c%p%pcs%frootc_storage
    frootc_xfer                    => clm3%g%l%c%p%pcs%frootc_xfer
    gresp_storage                  => clm3%g%l%c%p%pcs%gresp_storage
    gresp_xfer                     => clm3%g%l%c%p%pcs%gresp_xfer
    leafc                          => clm3%g%l%c%p%pcs%leafc
    leafc_storage                  => clm3%g%l%c%p%pcs%leafc_storage
    leafc_xfer                     => clm3%g%l%c%p%pcs%leafc_xfer
    livecrootc                     => clm3%g%l%c%p%pcs%livecrootc
    livecrootc_storage             => clm3%g%l%c%p%pcs%livecrootc_storage
    livecrootc_xfer                => clm3%g%l%c%p%pcs%livecrootc_xfer
    livestemc                      => clm3%g%l%c%p%pcs%livestemc
    livestemc_storage              => clm3%g%l%c%p%pcs%livestemc_storage
    livestemc_xfer                 => clm3%g%l%c%p%pcs%livestemc_xfer
    storvegc                       => clm3%g%l%c%p%pcs%storvegc
    totpftc                        => clm3%g%l%c%p%pcs%totpftc
    totvegc                        => clm3%g%l%c%p%pcs%totvegc
#if (defined CLAMP)
    woodc                          => clm3%g%l%c%p%pcs%woodc
#endif
    tempsum_npp                    => clm3%g%l%c%p%pepv%tempsum_npp
#if (defined CNDV)
    tempsum_litfall                => clm3%g%l%c%p%pepv%tempsum_litfall
#endif

   ! pft loop
   do fp = 1,num_soilp
      p = filter_soilp(fp)

      ! calculate pft-level summary carbon fluxes and states

      ! gross primary production (GPP)
      gpp(p) = &
         psnsun_to_cpool(p) + &
         psnshade_to_cpool(p)
      write(6,*) 'check gpp'
      write(6,*) 'gpp(',p,')=',gpp(p)
      write(6,*) 'psnsun_to_cpool(',p,')=',psnsun_to_cpool(p)
      write(6,*) 'psnshade_to_cpool(',p,')=',psnshade_to_cpool(p)

      ! maintenance respiration (MR)
      mr(p)  = &
         leaf_mr(p)     + &
         froot_mr(p)    + &
         livestem_mr(p) + &
         livecroot_mr(p)
       write(6,*) 'check mr'
       write(6,*) 'mr(',p,')=',mr(p)
       write(6,*) 'leaf_mr(',p,')=',leaf_mr(p)
       write(6,*) 'froot_mr(',p,')=',froot_mr(p)
       write(6,*) 'livecroot_mr(',p,')=',livecroot_mr(p)
      ! growth respiration (GR)
      ! current GR is respired this time step for new growth displayed in this timestep
      current_gr(p) = &
         cpool_leaf_gr(p)      + &
         cpool_froot_gr(p)     + &
         cpool_livestem_gr(p)  + &
#if (defined CROP)
         cpool_grain_gr(p)  + &
#endif
         cpool_deadstem_gr(p)  + &
         cpool_livecroot_gr(p) + &
         cpool_deadcroot_gr(p)

      ! transfer GR is respired this time step for transfer growth displayed in this timestep
      transfer_gr(p) = &
         transfer_leaf_gr(p)      + &
         transfer_froot_gr(p)     + &
         transfer_livestem_gr(p)  + &
#if (defined CROP)
         transfer_grain_gr(p)  + &
#endif
         transfer_deadstem_gr(p)  + &
         transfer_livecroot_gr(p) + &
         transfer_deadcroot_gr(p)

      ! storage GR is respired this time step for growth sent to storage for later display
      storage_gr(p) = &
         cpool_leaf_storage_gr(p)      + &
         cpool_froot_storage_gr(p)     + &
         cpool_livestem_storage_gr(p)  + &
#if (defined CROP)
         cpool_grain_storage_gr(p)  + &
#endif
         cpool_deadstem_storage_gr(p)  + &
         cpool_livecroot_storage_gr(p) + &
         cpool_deadcroot_storage_gr(p)

      ! GR is the sum of current + transfer + storage GR
      gr(p) = &
         current_gr(p)  + &
         transfer_gr(p) + &
         storage_gr(p)

      ! autotrophic respiration (AR)
#if (defined CROP)
      ar(p) = mr(p) + gr(p) + xsmrpool_to_atm(p) ! xsmr... is -ve (slevis)
      write(6,*) 'to check ar'
      write(6,*) 'ar(',p,')=',ar(p)
      write(6,*) 'CSummary,mr(',p,')=',mr(p)
      write(6,*) 'CSummary,gr(',p,')=',gr(p)
      write(6,*) 'CSummary,xsmrpool_to_atm(',p,')=', xsmrpool_to_atm(p)
#else
      ar(p) = mr(p) + gr(p)
#endif

      ! root respiration (RR)
      rr(p) = &
         froot_mr(p) + &
         cpool_froot_gr(p) + &
         cpool_livecroot_gr(p) + &
         cpool_deadcroot_gr(p) + &
         transfer_froot_gr(p) + &
         transfer_livecroot_gr(p) + &
         transfer_deadcroot_gr(p) + &
         cpool_froot_storage_gr(p) + &
         cpool_livecroot_storage_gr(p) + &
         cpool_deadcroot_storage_gr(p)

      ! net primary production (NPP)
      npp(p) = gpp(p) - ar(p)

      ! update the annual NPP accumulator, for use in allocation code
      tempsum_npp(p) = tempsum_npp(p) + npp(p)

      ! aboveground NPP: leaf, live stem, dead stem (AGNPP)
      ! This is supposed to correspond as closely as possible to
      ! field measurements of AGNPP, so it ignores the storage pools
      ! and only treats the fluxes into displayed pools.
      agnpp(p) = &
         cpool_to_leafc(p)                  + &
         leafc_xfer_to_leafc(p)             + &
         cpool_to_livestemc(p)              + &
         livestemc_xfer_to_livestemc(p)     + &
#if (defined CROP)
         cpool_to_grainc(p)           + &
         grainc_xfer_to_grainc(p)     + &
#endif
         cpool_to_deadstemc(p)              + &
         deadstemc_xfer_to_deadstemc(p)

     ! belowground NPP: fine root, live coarse root, dead coarse root (BGNPP)
      ! This is supposed to correspond as closely as possible to
      ! field measurements of BGNPP, so it ignores the storage pools
      ! and only treats the fluxes into displayed pools.
      bgnpp(p) = &
         cpool_to_frootc(p)                   + &
         frootc_xfer_to_frootc(p)             + &
         cpool_to_livecrootc(p)               + &
         livecrootc_xfer_to_livecrootc(p)     + &
         cpool_to_deadcrootc(p)               + &
         deadcrootc_xfer_to_deadcrootc(p)

      ! litterfall (LITFALL)
      litfall(p) = &
         leafc_to_litter(p)                 + &
         frootc_to_litter(p)                + &
#if (defined CROP)
         livestemc_to_litter(p)           + &
         grainc_to_food(p)                + &
#endif
         m_leafc_to_litter(p)               + &
         m_leafc_storage_to_litter(p)       + &
         m_leafc_xfer_to_litter(p)          + &
         m_frootc_to_litter(p)              + &
         m_frootc_storage_to_litter(p)      + &
         m_frootc_xfer_to_litter(p)         + &
         m_livestemc_to_litter(p)           + &
         m_livestemc_storage_to_litter(p)   + &
         m_livestemc_xfer_to_litter(p)      + &
         m_deadstemc_to_litter(p)           + &
         m_deadstemc_storage_to_litter(p)   + &
         m_deadstemc_xfer_to_litter(p)      + &
         m_livecrootc_to_litter(p)          + &
         m_livecrootc_storage_to_litter(p)  + &
         m_livecrootc_xfer_to_litter(p)     + &
         m_deadcrootc_to_litter(p)          + &
         m_deadcrootc_storage_to_litter(p)  + &
         m_deadcrootc_xfer_to_litter(p)     + &
         m_gresp_storage_to_litter(p)       + &
         m_gresp_xfer_to_litter(p)          + &
         m_deadstemc_to_litter_fire(p)      + &
         m_deadcrootc_to_litter_fire(p)     + &
         hrv_leafc_to_litter(p)             + &
         hrv_leafc_storage_to_litter(p)     + &
         hrv_leafc_xfer_to_litter(p)        + &
         hrv_frootc_to_litter(p)            + &
         hrv_frootc_storage_to_litter(p)    + &
         hrv_frootc_xfer_to_litter(p)       + &
         hrv_livestemc_to_litter(p)         + &
         hrv_livestemc_storage_to_litter(p) + &
         hrv_livestemc_xfer_to_litter(p)    + &
         hrv_deadstemc_storage_to_litter(p) + &
         hrv_deadstemc_xfer_to_litter(p)    + &
         hrv_livecrootc_to_litter(p)        + &
         hrv_livecrootc_storage_to_litter(p)+ &
         hrv_livecrootc_xfer_to_litter(p)   + &
         hrv_deadcrootc_to_litter(p)        + &
         hrv_deadcrootc_storage_to_litter(p)+ &
         hrv_deadcrootc_xfer_to_litter(p)   + &
         hrv_gresp_storage_to_litter(p)     + &
         hrv_gresp_xfer_to_litter(p)
                 
#if (defined CNDV)
      ! update the annual litfall accumulator, for use in mortality code
      tempsum_litfall(p) = tempsum_litfall(p) + leafc_to_litter(p) + frootc_to_litter(p)
#endif

      ! pft-level fire losses (VEGFIRE)
      vegfire(p) = 0._r8
      
      ! pft-level wood harvest
      wood_harvestc(p) = &
         hrv_deadstemc_to_prod10c(p) + &
         hrv_deadstemc_to_prod100c(p)

      ! pft-level carbon losses to fire
      pft_fire_closs(p) = &
         m_leafc_to_fire(p)                + &
         m_leafc_storage_to_fire(p)        + &
         m_leafc_xfer_to_fire(p)           + &
         m_frootc_to_fire(p)               + &
         m_frootc_storage_to_fire(p)       + &
         m_frootc_xfer_to_fire(p)          + &
         m_livestemc_to_fire(p)            + &
         m_livestemc_storage_to_fire(p)    + &
         m_livestemc_xfer_to_fire(p)       + &
         m_deadstemc_to_fire(p)            + &
         m_deadstemc_storage_to_fire(p)    + &
         m_deadstemc_xfer_to_fire(p)       + &
         m_livecrootc_to_fire(p)           + &
         m_livecrootc_storage_to_fire(p)   + &
         m_livecrootc_xfer_to_fire(p)      + &
         m_deadcrootc_to_fire(p)           + &
         m_deadcrootc_storage_to_fire(p)   + &
         m_deadcrootc_xfer_to_fire(p)      + &
         m_gresp_storage_to_fire(p)        + &
         m_gresp_xfer_to_fire(p)

      ! displayed vegetation carbon, excluding storage and cpool (DISPVEGC)
      dispvegc(p) = &
         leafc(p)      + &
         frootc(p)     + &
         livestemc(p)  + &
#if (defined CROP)
         grainc(p)  + &
#endif
         deadstemc(p)  + &
         livecrootc(p) + &
         deadcrootc(p)

      ! stored vegetation carbon, excluding cpool (STORVEGC)
      storvegc(p) = &
      	cpool(p)              + &
         leafc_storage(p)      + &
         frootc_storage(p)     + &
         livestemc_storage(p)  + &
         deadstemc_storage(p)  + &
         livecrootc_storage(p) + &
         deadcrootc_storage(p) + &
#if (defined CROP)
         grainc_storage(p)  + &
         grainc_xfer(p)     + &
#endif
         leafc_xfer(p)         + &
         frootc_xfer(p)        + &
         livestemc_xfer(p)     + &
         deadstemc_xfer(p)     + &
         livecrootc_xfer(p)    + &
         deadcrootc_xfer(p)    + &
         gresp_storage(p)      + &
         gresp_xfer(p)

      ! total vegetation carbon, excluding cpool (TOTVEGC)
      totvegc(p) = dispvegc(p) + storvegc(p)

      ! total pft-level carbon, including xsmrpool, ctrunc
      totpftc(p) = totvegc(p) + xsmrpool(p) + pft_ctrunc(p)
       write(6,*) 'check totpftc'
      write(6,*) 'CSummary,totvegc(',p,')=',totvegc(p)
      write(6,*) 'CSummary,xsmrpool(',p,')=',xsmrpool(p) 
      write(6,*) 'CSummary,pft_ctrunc(',p,')=',pft_ctrunc(p)
      
#if (defined CLAMP)
      ! new summary variables for CLAMP
      
      ! (FROOTC_ALLOC) - fine root C allocation
      frootc_alloc(p) = &
        frootc_xfer_to_frootc(p)    + &
        cpool_to_frootc(p)     
              
      ! (FROOTC_LOSS) - fine root C loss
      frootc_loss(p) = &
        m_frootc_to_litter(p)   + &
        m_frootc_to_fire(p)     + &
        hrv_frootc_to_litter(p) + &
        frootc_to_litter(p)
      
      ! (LEAFC_ALLOC) - leaf C allocation
      leafc_alloc(p) = &
        leafc_xfer_to_leafc(p)    + &
        cpool_to_leafc(p)     

      ! (LEAFC_LOSS) - leaf C loss
      leafc_loss(p) = &
        m_leafc_to_litter(p)   + &
        m_leafc_to_fire(p)     + &
        hrv_leafc_to_litter(p) + &
        leafc_to_litter(p)
      
      ! (WOODC) - wood C
      woodc(p) = &
        deadstemc(p)    + &
        livestemc(p)    + &
        deadcrootc(p)   + &
        livecrootc(p)
      
      ! (WOODC_ALLOC) - wood C allocation
      woodc_alloc(p) = &
        livestemc_xfer_to_livestemc(p)  + &
        deadstemc_xfer_to_deadstemc(p)  + &
        livecrootc_xfer_to_livecrootc(p)    + &
        deadcrootc_xfer_to_deadcrootc(p)    + &
        cpool_to_livestemc(p)   + &
        cpool_to_deadstemc(p)   + &
        cpool_to_livecrootc(p)  + &
        cpool_to_deadcrootc(p)
      
      ! (WOODC_LOSS) - wood C loss
      woodc_loss(p) = &
        m_livestemc_to_litter(p)    + &
        m_deadstemc_to_litter(p)    + &
        m_livecrootc_to_litter(p)   + &
        m_deadcrootc_to_litter(p)   + &
        m_livestemc_to_fire(p)      + &
        m_deadstemc_to_fire(p)      + &
        m_livecrootc_to_fire(p)     + &
        m_deadcrootc_to_fire(p)     + &
        hrv_livestemc_to_litter(p)  + &
        hrv_livestemc_storage_to_litter(p) + &
        hrv_livestemc_xfer_to_litter(p)    + &
        hrv_deadstemc_to_prod10c(p)        + &
        hrv_deadstemc_to_prod100c(p)       + &
        hrv_deadstemc_storage_to_litter(p) + &
        hrv_deadstemc_xfer_to_litter(p)    + &
        hrv_livecrootc_to_litter(p)        + &
        hrv_livecrootc_storage_to_litter(p)+ &
        hrv_livecrootc_xfer_to_litter(p)   + &
        hrv_deadcrootc_to_litter(p)        + &
        hrv_deadcrootc_storage_to_litter(p)+ &
        hrv_deadcrootc_xfer_to_litter(p)   
#endif

  write(6,*) 'CSummary, gpp(',p,')=',gpp(p)
  write(6,*) 'CSummary, ar(',p,')=',ar(p)
  write(6,*) 'CSummary, rr(',p,')=',rr(p)
  write(6,*) 'CSummary, npp(',p,')=',npp(p)
  write(6,*) 'CSummary,  vegfire(',p,')=',vegfire(p)
  write(6,*) 'CSummary,  wood_harvestc(',p,')=',wood_harvestc(p)
  write(6,*) 'CSummary,  totvegc(',p,')=',totvegc(p)
  write(6,*) 'CSummary,  totpftc(',p,')=',totpftc(p)
  write(6,*) 'CSummary,  pft_fire_closs(',p,')=',pft_fire_closs(p) 
  write(6,*) 'CSummary,  litfall(',p,')=',litfall(p)
  write(6,*) 'CSummary,  hrv_xsmrpool_to_atm(',p,')=',hrv_xsmrpool_to_atm(p)
   end do  ! end of pfts loop

   ! use p2c routine to get selected column-average pft-level fluxes and states
   call p2c(num_soilc, filter_soilc, gpp, col_gpp)
   call p2c(num_soilc, filter_soilc, ar, col_ar)
   call p2c(num_soilc, filter_soilc, rr, col_rr)
   call p2c(num_soilc, filter_soilc, npp, col_npp)
   call p2c(num_soilc, filter_soilc, vegfire, col_vegfire)
   call p2c(num_soilc, filter_soilc, wood_harvestc, col_wood_harvestc)
   call p2c(num_soilc, filter_soilc, totvegc, col_totvegc)
   call p2c(num_soilc, filter_soilc, totpftc, col_totpftc)
   call p2c(num_soilc, filter_soilc, pft_fire_closs, col_pft_fire_closs)
   call p2c(num_soilc, filter_soilc, litfall, col_litfall)
   call p2c(num_soilc, filter_soilc, hrv_xsmrpool_to_atm, col_hrv_xsmrpool_to_atm)
   ! column loop
   do fc = 1,num_soilc
      c = filter_soilc(fc)

      ! litter heterotrophic respiration (LITHR)
      lithr(c) = &
         litr1_hr(c) + &
         litr2_hr(c) + &
         litr3_hr(c)

      ! soil organic matter heterotrophic respiration (SOMHR)
      somhr(c) = &
         soil1_hr(c) + &
         soil2_hr(c) + &
         soil3_hr(c) + &
         soil4_hr(c)

      ! total heterotrophic respiration (HR)
      hr(c) = lithr(c) + somhr(c)

      ! total soil respiration, heterotrophic + root respiration (SR)
      sr(c) = col_rr(c) + hr(c)

      ! total ecosystem respiration, autotrophic + heterotrophic (ER)
      er(c) = col_ar(c) + hr(c)

      ! litter fire losses (LITFIRE)
      litfire(c) = 0._r8
      
      ! total wood product loss
      product_closs(c) = &
         prod10c_loss(c) + &
         prod100c_loss(c) 

      ! soil organic matter fire losses (SOMFIRE)
      somfire(c) = 0._r8

      ! total ecosystem fire losses (TOTFIRE)
      totfire(c) = &
         litfire(c) + &
         somfire(c) + &
         col_vegfire(c)

      ! column-level carbon losses to fire, including pft losses
      col_fire_closs(c) = &
         m_litr1c_to_fire(c)  + &
         m_litr2c_to_fire(c)  + &
         m_litr3c_to_fire(c)  + &
         m_cwdc_to_fire(c)    + &
         col_pft_fire_closs(c)
      
      ! column-level carbon losses due to landcover change
      dwt_closs(c) = &
         dwt_conv_cflux(c)

      ! net ecosystem production, excludes fire flux, landcover change, and loss from wood products, positive for sink (NEP)
      nep(c) = col_gpp(c) - er(c)

      ! net biome production of carbon, includes depletion from: fire flux, landcover change flux, and loss
      ! from wood products pools, positive for sink (NBP)
      nbp(c) = nep(c) - col_fire_closs(c) - dwt_closs(c) - product_closs(c)

      ! net ecosystem exchange of carbon, includes fire flux, landcover change flux, loss
      ! from wood products pools, and hrv_xsmrpool flux, positive for source (NEE)
      nee(c) = -nep(c) + col_fire_closs(c) + dwt_closs(c) + product_closs(c) + col_hrv_xsmrpool_to_atm(c)
      ! land use flux and land uptake
      landuseflux(c) = dwt_closs(c) + product_closs(c)
      landuptake(c) = nee(c) - landuseflux(c)

      ! total litter carbon (TOTLITC)
      totlitc(c) = &
         litr1c(c) + &
         litr2c(c) + &
         litr3c(c)

      ! total soil organic matter carbon (TOTSOMC)
      totsomc(c) = &
         soil1c(c) + &
         soil2c(c) + &
         soil3c(c) + &
         soil4c(c)
      
      ! total wood product carbon
      totprodc(c) = &
         prod10c(c) + &
	      prod100c(c)	 

      ! total ecosystem carbon, including veg but excluding cpool (TOTECOSYSC)
      totecosysc(c) = &
         cwdc(c) + &
         totlitc(c) + &
         totsomc(c) + &
	      totprodc(c) + &
         col_totvegc(c)

      ! total column carbon, including veg and cpool (TOTCOLC)
	  ! adding col_ctrunc, seedc
      totcolc(c) = &
         col_totpftc(c) + &
         cwdc(c) + &
         totlitc(c) + &
         totsomc(c) + &
	      totprodc(c) + &
		   seedc(c) + &
		   col_ctrunc(c)

#if (defined CLAMP)
      ! new summary variables for CLAMP
      
      ! (CWDC_HR) - coarse woody debris heterotrophic respiration
      cwdc_hr(c) = 0._r8
      
      ! (CWDC_LOSS) - coarse woody debris C loss
      cwdc_loss(c) = & 
        m_cwdc_to_fire(c) + &
        cwdc_to_litr2c(c) + &
        cwdc_to_litr3c(c)
      
      ! (LITTERC_LOSS) - litter C loss
      litterc_loss(c) = &
        lithr(c)            + &
        m_litr1c_to_fire(c) + &
        m_litr2c_to_fire(c) + &
        m_litr3c_to_fire(c) + &
        litr1c_to_soil1c(c) + &
        litr2c_to_soil2c(c) + &
        litr3c_to_soil3c(c)
#endif
      
   end do ! end of columns loop


end subroutine CSummary
!-----------------------------------------------------------------------

!-----------------------------------------------------------------------
!BOP
!
! !IROUTINE: NSummary
!
! !INTERFACE:
subroutine NSummary(num_soilc, filter_soilc, num_soilp, filter_soilp)
!
! !DESCRIPTION:
! On the radiation time step, perform pft and column-level nitrogen
! summary calculations
!
! !USES:
   use clmtype
!ylu changed
!   use pft2colMod, only: p2c
  use subgridAveMod, only : p2c

!
! !ARGUMENTS:
   implicit none
   integer, intent(in) :: num_soilc       ! number of soil columns in filter
   integer, intent(in) :: filter_soilc(:) ! filter for soil columns
   integer, intent(in) :: num_soilp       ! number of soil pfts in filter
   integer, intent(in) :: filter_soilp(:) ! filter for soil pfts
!
! !CALLED FROM:
! subroutine CNEcosystemDyn
!
! !REVISION HISTORY:
! 6/28/04: Created by Peter Thornton
!
! !LOCAL VARIABLES:
! local pointers to implicit in scalars
   real(r8), pointer :: col_fire_nloss(:) ! (gN/m2/s) total column-level fire N loss
   real(r8), pointer :: col_wood_harvestn(:)
   real(r8), pointer :: denit(:)
   real(r8), pointer :: m_cwdn_to_fire(:)              
   real(r8), pointer :: m_litr1n_to_fire(:)             
   real(r8), pointer :: m_litr2n_to_fire(:)             
   real(r8), pointer :: m_litr3n_to_fire(:)             
   real(r8), pointer :: col_pft_fire_nloss(:) ! (gN/m2/s) total pft-level fire C loss 
   real(r8), pointer :: sminn_to_denit_excess(:)
   real(r8), pointer :: sminn_to_denit_l1s1(:)
   real(r8), pointer :: sminn_to_denit_l2s2(:)
   real(r8), pointer :: sminn_to_denit_l3s3(:)
   real(r8), pointer :: sminn_to_denit_s1s2(:)
   real(r8), pointer :: sminn_to_denit_s2s3(:)
   real(r8), pointer :: sminn_to_denit_s3s4(:)
   real(r8), pointer :: sminn_to_denit_s4(:)  
   real(r8), pointer :: cwdn(:)               ! (gN/m2) coarse woody debris N
   real(r8), pointer :: litr1n(:)             ! (gN/m2) litter labile N
   real(r8), pointer :: litr2n(:)             ! (gN/m2) litter cellulose N
   real(r8), pointer :: litr3n(:)             ! (gN/m2) litter lignin N
   real(r8), pointer :: col_totpftn(:)        ! (gN/m2) total pft-level nitrogen
   real(r8), pointer :: col_totvegn(:)            ! (gN/m2) total vegetation nitrogen
   real(r8), pointer :: sminn(:)              ! (gN/m2) soil mineral N
   real(r8), pointer :: soil1n(:)             ! (gN/m2) soil organic matter N (fast pool)
   real(r8), pointer :: soil2n(:)             ! (gN/m2) soil organic matter N (medium pool)
   real(r8), pointer :: soil3n(:)             ! (gN/m2) soil orgainc matter N (slow pool)
   real(r8), pointer :: soil4n(:)             ! (gN/m2) soil orgainc matter N (slowest pool)
   real(r8), pointer :: col_ntrunc(:)         ! (gN/m2) column-level sink for N truncation
   real(r8), pointer :: totcoln(:)            ! (gN/m2) total column nitrogen, incl veg
   real(r8), pointer :: totecosysn(:)         ! (gN/m2) total ecosystem nitrogen, incl veg 
   real(r8), pointer :: totlitn(:)            ! (gN/m2) total litter nitrogen
   real(r8), pointer :: totsomn(:)            ! (gN/m2) total soil organic matter nitrogen
   real(r8), pointer :: m_deadcrootn_storage_to_fire(:) 
   real(r8), pointer :: m_deadcrootn_to_fire(:)         
   real(r8), pointer :: m_deadcrootn_xfer_to_fire(:)
   real(r8), pointer :: m_deadstemn_storage_to_fire(:)  
   real(r8), pointer :: m_deadstemn_to_fire(:)          
   real(r8), pointer :: m_deadstemn_xfer_to_fire(:) 
   real(r8), pointer :: m_frootn_storage_to_fire(:)     
   real(r8), pointer :: m_frootn_to_fire(:)             
   real(r8), pointer :: m_frootn_xfer_to_fire(:)    
   real(r8), pointer :: m_leafn_storage_to_fire(:)      
   real(r8), pointer :: m_leafn_to_fire(:)              
   real(r8), pointer :: m_leafn_xfer_to_fire(:)     
   real(r8), pointer :: m_livecrootn_storage_to_fire(:) 
   real(r8), pointer :: m_livecrootn_to_fire(:)         
   real(r8), pointer :: m_livecrootn_xfer_to_fire(:)
   real(r8), pointer :: m_livestemn_storage_to_fire(:)  
   real(r8), pointer :: m_livestemn_to_fire(:)          
   real(r8), pointer :: m_livestemn_xfer_to_fire(:) 
   real(r8), pointer :: m_retransn_to_fire(:)           
   real(r8), pointer :: hrv_deadstemn_to_prod10n(:)        
   real(r8), pointer :: hrv_deadstemn_to_prod100n(:)       
   real(r8), pointer :: ndeploy(:)
   real(r8), pointer :: pft_fire_nloss(:) ! (gN/m2/s) total pft-level fire C loss 
   real(r8), pointer :: retransn_to_npool(:)          
   real(r8), pointer :: sminn_to_npool(:)             
   real(r8), pointer :: deadcrootn(:)         ! (gN/m2) dead coarse root N
   real(r8), pointer :: deadcrootn_storage(:) ! (gN/m2) dead coarse root N storage
   real(r8), pointer :: deadcrootn_xfer(:)    ! (gN/m2) dead coarse root N transfer
   real(r8), pointer :: deadstemn(:)          ! (gN/m2) dead stem N
   real(r8), pointer :: deadstemn_storage(:)  ! (gN/m2) dead stem N storage
   real(r8), pointer :: deadstemn_xfer(:)     ! (gN/m2) dead stem N transfer
   real(r8), pointer :: dispvegn(:)           ! (gN/m2) displayed veg nitrogen, excluding storage
   real(r8), pointer :: frootn(:)             ! (gN/m2) fine root N
   real(r8), pointer :: frootn_storage(:)     ! (gN/m2) fine root N storage
   real(r8), pointer :: frootn_xfer(:)        ! (gN/m2) fine root N transfer
   real(r8), pointer :: leafn(:)              ! (gN/m2) leaf N 
   real(r8), pointer :: leafn_storage(:)      ! (gN/m2) leaf N storage
   real(r8), pointer :: leafn_xfer(:)         ! (gN/m2) leaf N transfer
   real(r8), pointer :: livecrootn(:)         ! (gN/m2) live coarse root N
   real(r8), pointer :: livecrootn_storage(:) ! (gN/m2) live coarse root N storage
   real(r8), pointer :: livecrootn_xfer(:)    ! (gN/m2) live coarse root N transfer
#if (defined CROP)
   real(r8), pointer :: grainn(:)             ! (gN/m2) grain N
   real(r8), pointer :: grainn_storage(:)     ! (gN/m2) grain N storage
   real(r8), pointer :: grainn_xfer(:)        ! (gN/m2) grain N transfer
#endif
   real(r8), pointer :: livestemn(:)          ! (gN/m2) live stem N
   real(r8), pointer :: livestemn_storage(:)  ! (gN/m2) live stem N storage
   real(r8), pointer :: livestemn_xfer(:)     ! (gN/m2) live stem N transfer
   real(r8), pointer :: retransn(:)           ! (gN/m2) plant pool of retranslocated N
   real(r8), pointer :: npool(:)              ! (gN/m2) temporary plant N pool
   real(r8), pointer :: pft_ntrunc(:)         ! (gN/m2) pft-level sink for N truncation
   real(r8), pointer :: storvegn(:)           ! (gN/m2) stored vegetation nitrogen
   real(r8), pointer :: totpftn(:)            ! (gN/m2) total pft-level nitrogen
   real(r8), pointer :: totvegn(:)            ! (gN/m2) total vegetation nitrogen
   ! for landcover change
   real(r8), pointer :: wood_harvestn(:)                    ! total N losses to wood product pools (gN/m2/s)
   real(r8), pointer :: dwt_nloss(:)          ! (gN/m2/s) total nitrogen loss from product pools and conversion
   real(r8), pointer :: dwt_conv_nflux(:)     ! (gN/m2/s) conversion N flux (immediate loss to atm)
   real(r8), pointer :: seedn(:)              ! (gN/m2) column-level pool for seeding new PFTs
   real(r8), pointer :: prod10n_loss(:)       ! (gN/m2/s) loss from 10-yr wood product pool
   real(r8), pointer :: prod100n_loss(:)      ! (gN/m2/s) loss from 100-yr wood product pool
   real(r8), pointer :: product_nloss(:)      ! (gN/m2/s) total wood product nitrogen loss
   real(r8), pointer :: prod10n(:)            ! (gN/m2) wood product N pool, 10-year lifespan
   real(r8), pointer :: prod100n(:)           ! (gN/m2) wood product N pool, 100-year lifespan
   real(r8), pointer :: totprodn(:)           ! (gN/m2) total wood product N
!
! local pointers to implicit in/out scalars
!
! local pointers to implicit out scalars
!
! !OTHER LOCAL VARIABLES:
   integer :: c,p         ! indices
   integer :: fp,fc       ! lake filter indices

!EOP
!-----------------------------------------------------------------------
    ! assign local pointers
    col_fire_nloss                 => clm3%g%l%c%cnf%col_fire_nloss
    denit                          => clm3%g%l%c%cnf%denit
    m_cwdn_to_fire                 => clm3%g%l%c%cnf%m_cwdn_to_fire
    m_litr1n_to_fire               => clm3%g%l%c%cnf%m_litr1n_to_fire
    m_litr2n_to_fire               => clm3%g%l%c%cnf%m_litr2n_to_fire
    m_litr3n_to_fire               => clm3%g%l%c%cnf%m_litr3n_to_fire
    col_pft_fire_nloss             => clm3%g%l%c%cnf%pnf_a%pft_fire_nloss
    sminn_to_denit_excess          => clm3%g%l%c%cnf%sminn_to_denit_excess
    sminn_to_denit_l1s1            => clm3%g%l%c%cnf%sminn_to_denit_l1s1
    sminn_to_denit_l2s2            => clm3%g%l%c%cnf%sminn_to_denit_l2s2
    sminn_to_denit_l3s3            => clm3%g%l%c%cnf%sminn_to_denit_l3s3
    sminn_to_denit_s1s2            => clm3%g%l%c%cnf%sminn_to_denit_s1s2
    sminn_to_denit_s2s3            => clm3%g%l%c%cnf%sminn_to_denit_s2s3
    sminn_to_denit_s3s4            => clm3%g%l%c%cnf%sminn_to_denit_s3s4
    sminn_to_denit_s4              => clm3%g%l%c%cnf%sminn_to_denit_s4
    cwdn                           => clm3%g%l%c%cns%cwdn
    litr1n                         => clm3%g%l%c%cns%litr1n
    litr2n                         => clm3%g%l%c%cns%litr2n
    litr3n                         => clm3%g%l%c%cns%litr3n
    col_totpftn                    => clm3%g%l%c%cns%pns_a%totpftn
    col_totvegn                    => clm3%g%l%c%cns%pns_a%totvegn
    sminn                          => clm3%g%l%c%cns%sminn
    col_ntrunc                     => clm3%g%l%c%cns%col_ntrunc
    soil1n                         => clm3%g%l%c%cns%soil1n
    soil2n                         => clm3%g%l%c%cns%soil2n
    soil3n                         => clm3%g%l%c%cns%soil3n
    soil4n                         => clm3%g%l%c%cns%soil4n
    totcoln                        => clm3%g%l%c%cns%totcoln
    totecosysn                     => clm3%g%l%c%cns%totecosysn
    totlitn                        => clm3%g%l%c%cns%totlitn
    totsomn                        => clm3%g%l%c%cns%totsomn
    m_deadcrootn_storage_to_fire   => clm3%g%l%c%p%pnf%m_deadcrootn_storage_to_fire
    m_deadcrootn_to_fire           => clm3%g%l%c%p%pnf%m_deadcrootn_to_fire
    m_deadcrootn_xfer_to_fire      => clm3%g%l%c%p%pnf%m_deadcrootn_xfer_to_fire
    m_deadstemn_storage_to_fire    => clm3%g%l%c%p%pnf%m_deadstemn_storage_to_fire
    m_deadstemn_to_fire            => clm3%g%l%c%p%pnf%m_deadstemn_to_fire
    m_deadstemn_xfer_to_fire       => clm3%g%l%c%p%pnf%m_deadstemn_xfer_to_fire
    m_frootn_storage_to_fire       => clm3%g%l%c%p%pnf%m_frootn_storage_to_fire
    m_frootn_to_fire               => clm3%g%l%c%p%pnf%m_frootn_to_fire
    m_frootn_xfer_to_fire          => clm3%g%l%c%p%pnf%m_frootn_xfer_to_fire
    m_leafn_storage_to_fire        => clm3%g%l%c%p%pnf%m_leafn_storage_to_fire
    m_leafn_to_fire                => clm3%g%l%c%p%pnf%m_leafn_to_fire
    m_leafn_xfer_to_fire           => clm3%g%l%c%p%pnf%m_leafn_xfer_to_fire
    m_livecrootn_storage_to_fire   => clm3%g%l%c%p%pnf%m_livecrootn_storage_to_fire
    m_livecrootn_to_fire           => clm3%g%l%c%p%pnf%m_livecrootn_to_fire
    m_livecrootn_xfer_to_fire      => clm3%g%l%c%p%pnf%m_livecrootn_xfer_to_fire
    m_livestemn_storage_to_fire    => clm3%g%l%c%p%pnf%m_livestemn_storage_to_fire
    m_livestemn_to_fire            => clm3%g%l%c%p%pnf%m_livestemn_to_fire
    m_livestemn_xfer_to_fire       => clm3%g%l%c%p%pnf%m_livestemn_xfer_to_fire
    m_retransn_to_fire             => clm3%g%l%c%p%pnf%m_retransn_to_fire
    hrv_deadstemn_to_prod10n         => clm3%g%l%c%p%pnf%hrv_deadstemn_to_prod10n        
    hrv_deadstemn_to_prod100n        => clm3%g%l%c%p%pnf%hrv_deadstemn_to_prod100n       
    ndeploy                        => clm3%g%l%c%p%pnf%ndeploy
    pft_fire_nloss                 => clm3%g%l%c%p%pnf%pft_fire_nloss
    retransn_to_npool              => clm3%g%l%c%p%pnf%retransn_to_npool
    sminn_to_npool                 => clm3%g%l%c%p%pnf%sminn_to_npool
    deadcrootn                     => clm3%g%l%c%p%pns%deadcrootn
    deadcrootn_storage             => clm3%g%l%c%p%pns%deadcrootn_storage
    deadcrootn_xfer                => clm3%g%l%c%p%pns%deadcrootn_xfer
    deadstemn                      => clm3%g%l%c%p%pns%deadstemn
    deadstemn_storage              => clm3%g%l%c%p%pns%deadstemn_storage
    deadstemn_xfer                 => clm3%g%l%c%p%pns%deadstemn_xfer
    dispvegn                       => clm3%g%l%c%p%pns%dispvegn
    frootn                         => clm3%g%l%c%p%pns%frootn
    frootn_storage                 => clm3%g%l%c%p%pns%frootn_storage
    frootn_xfer                    => clm3%g%l%c%p%pns%frootn_xfer
    leafn                          => clm3%g%l%c%p%pns%leafn
    leafn_storage                  => clm3%g%l%c%p%pns%leafn_storage
    leafn_xfer                     => clm3%g%l%c%p%pns%leafn_xfer
    livecrootn                     => clm3%g%l%c%p%pns%livecrootn
    livecrootn_storage             => clm3%g%l%c%p%pns%livecrootn_storage
    livecrootn_xfer                => clm3%g%l%c%p%pns%livecrootn_xfer
#if (defined CROP)
    grainn                         => clm3%g%l%c%p%pns%grainn
    grainn_storage                 => clm3%g%l%c%p%pns%grainn_storage
    grainn_xfer                    => clm3%g%l%c%p%pns%grainn_xfer
#endif
    livestemn                      => clm3%g%l%c%p%pns%livestemn
    livestemn_storage              => clm3%g%l%c%p%pns%livestemn_storage
    livestemn_xfer                 => clm3%g%l%c%p%pns%livestemn_xfer
    retransn                       => clm3%g%l%c%p%pns%retransn
    npool                          => clm3%g%l%c%p%pns%npool
    pft_ntrunc                     => clm3%g%l%c%p%pns%pft_ntrunc
    storvegn                       => clm3%g%l%c%p%pns%storvegn
    totpftn                        => clm3%g%l%c%p%pns%totpftn
    totvegn                        => clm3%g%l%c%p%pns%totvegn
    ! dynamic landcover pointers
    wood_harvestn                  => clm3%g%l%c%p%pnf%wood_harvestn
    col_wood_harvestn              => clm3%g%l%c%cnf%pnf_a%wood_harvestn 
    dwt_nloss                      => clm3%g%l%c%cnf%dwt_nloss
    dwt_conv_nflux                 => clm3%g%l%c%cnf%dwt_conv_nflux
    prod10n_loss                   => clm3%g%l%c%cnf%prod10n_loss
    prod100n_loss                  => clm3%g%l%c%cnf%prod100n_loss
    product_nloss                  => clm3%g%l%c%cnf%product_nloss
    seedn                          => clm3%g%l%c%cns%seedn
    prod10n                        => clm3%g%l%c%cns%prod10n
    prod100n                       => clm3%g%l%c%cns%prod100n
    totprodn                       => clm3%g%l%c%cns%totprodn

   ! pft loop
   do fp = 1,num_soilp
      p = filter_soilp(fp)

      ! calculate pft-level summary nitrogen fluxes and states

      ! total N deployment (from sminn and retranslocated N pool) (NDEPLOY)
      ndeploy(p) = &
         sminn_to_npool(p) + &
         retransn_to_npool(p)

      ! pft-level wood harvest
      wood_harvestn(p) = &
         hrv_deadstemn_to_prod10n(p) + &
         hrv_deadstemn_to_prod100n(p)

      ! total pft-level fire N losses
      pft_fire_nloss(p) = &
         m_leafn_to_fire(p)               + &
         m_leafn_storage_to_fire(p)       + &
         m_leafn_xfer_to_fire(p)          + &
         m_frootn_to_fire(p)              + &
         m_frootn_storage_to_fire(p)      + &
         m_frootn_xfer_to_fire(p)         + &
         m_livestemn_to_fire(p)           + &
         m_livestemn_storage_to_fire(p)   + &
         m_livestemn_xfer_to_fire(p)      + &
         m_deadstemn_to_fire(p)           + &
         m_deadstemn_storage_to_fire(p)   + &
         m_deadstemn_xfer_to_fire(p)      + &
         m_livecrootn_to_fire(p)          + &
         m_livecrootn_storage_to_fire(p)  + &
         m_livecrootn_xfer_to_fire(p)     + &
         m_deadcrootn_to_fire(p)          + &
         m_deadcrootn_storage_to_fire(p)  + &
         m_deadcrootn_xfer_to_fire(p)     + &
         m_retransn_to_fire(p)

      ! displayed vegetation nitrogen, excluding storage (DISPVEGN)
      dispvegn(p) = &
         leafn(p)      + &
         frootn(p)     + &
#if (defined CROP)
         grainn(p)     + &
#endif
         livestemn(p)  + &
         deadstemn(p)  + &
         livecrootn(p) + &
         deadcrootn(p)

      ! stored vegetation nitrogen, including retranslocated N pool (STORVEGN)
      storvegn(p) = &
         leafn_storage(p)      + &
         frootn_storage(p)     + &
         livestemn_storage(p)  + &
         deadstemn_storage(p)  + &
         livecrootn_storage(p) + &
         deadcrootn_storage(p) + &
#if (defined CROP)
         grainn_storage(p)     + &
         grainn_xfer(p)        + &
#endif
         leafn_xfer(p)         + &
         frootn_xfer(p)        + &
         livestemn_xfer(p)     + &
         deadstemn_xfer(p)     + &
         livecrootn_xfer(p)    + &
         deadcrootn_xfer(p)    + &
		 npool(p)              + &
         retransn(p)

      ! total vegetation nitrogen (TOTVEGN)
      totvegn(p) = dispvegn(p) + storvegn(p)

      ! total pft-level carbon (add pft_ntrunc)
      totpftn(p) = totvegn(p) + pft_ntrunc(p)
   
   write(6,*) 'NSummary, pft_fire_nloss(',p,')=',pft_fire_nloss(p)
   write(6,*) 'NSummary, wood_harvestn(',p,')=',wood_harvestn(p)
   write(6,*) 'NSummary, totvegn(',p,')=',totvegn(p)
   write(6,*) 'NSummary, totpftn(',p,')=',totpftn(p)

   end do  ! end of pfts loop

   ! use p2c routine to get selected column-average pft-level fluxes and states
   call p2c(num_soilc, filter_soilc, pft_fire_nloss, col_pft_fire_nloss)
   call p2c(num_soilc, filter_soilc, wood_harvestn, col_wood_harvestn)
   call p2c(num_soilc, filter_soilc, totvegn, col_totvegn)
   call p2c(num_soilc, filter_soilc, totpftn, col_totpftn)

   ! column loop
   do fc = 1,num_soilc
      c = filter_soilc(fc)

      ! total N denitrification (DENIT)
      denit(c) = &
         sminn_to_denit_l1s1(c) + &
         sminn_to_denit_l2s2(c) + &
         sminn_to_denit_l3s3(c) + &
         sminn_to_denit_s1s2(c) + &
         sminn_to_denit_s2s3(c) + &
         sminn_to_denit_s3s4(c) + &
         sminn_to_denit_s4(c) + &
         sminn_to_denit_excess(c)

      ! total column-level fire N losses
      col_fire_nloss(c) = &
         m_litr1n_to_fire(c) + &
         m_litr2n_to_fire(c) + &
         m_litr3n_to_fire(c) + &
         m_cwdn_to_fire(c)   + &
         col_pft_fire_nloss(c)

      ! column-level N losses due to landcover change
      dwt_nloss(c) = &
         dwt_conv_nflux(c)
         
      ! total wood product N loss
      product_nloss(c) = &
         prod10n_loss(c) + &
         prod100n_loss(c) 

      ! total litter nitrogen (TOTLITN)
      totlitn(c) = &
         litr1n(c) + &
         litr2n(c) + &
         litr3n(c)

      ! total soil organic matter nitrogen (TOTSOMN)
      totsomn(c) = &
         soil1n(c) + &
         soil2n(c) + &
         soil3n(c) + &
         soil4n(c)

      ! total wood product nitrogen
      totprodn(c) = &
         prod10n(c) + &
	     prod100n(c)	 

      ! total ecosystem nitrogen, including veg (TOTECOSYSN)
      totecosysn(c) = &
         cwdn(c) + &
         totlitn(c) + &
         totsomn(c) + &
         sminn(c) + &
	     totprodn(c) + &
         col_totvegn(c)

      ! total column nitrogen, including pft (TOTCOLN)
      totcoln(c) = &
         col_totpftn(c) + &
         cwdn(c) + &
         totlitn(c) + &
         totsomn(c) + &
         sminn(c) + &
	     totprodn(c) + &
		 seedn(c) + &
		 col_ntrunc(c)

   end do ! end of columns loop


end subroutine NSummary
!-----------------------------------------------------------------------

#endif

end module CNSummaryMod
module CNVegStructUpdateMod

#ifdef CN
!-----------------------------------------------------------------------
!BOP
!
! !MODULE: CNVegStructUpdateMod
!
! !DESCRIPTION:
! Module for vegetation structure updates (LAI, SAI, htop, hbot)
!
! !USES:
    use shr_kind_mod, only: r8 => shr_kind_r8
    implicit none
    save
    private
! !PUBLIC MEMBER FUNCTIONS:
    public :: CNVegStructUpdate
!
! !REVISION HISTORY:
! 4/23/2004: Created by Peter Thornton
!
!EOP
!-----------------------------------------------------------------------

contains

!-----------------------------------------------------------------------
!BOP
!
! !IROUTINE: CNVegStructUpdate
!
! !INTERFACE:
subroutine CNVegStructUpdate(num_soilp, filter_soilp)
!
! !DESCRIPTION:
! On the radiation time step, use C state variables and epc to diagnose
! vegetation structure (LAI, SAI, height)
!
! !USES:
   use clmtype
!ylu remove   use clm_atmlnd   , only: clm_a2l
   use pftvarcon    , only: noveg, nc3crop, nc4crop, nbrdlf_evr_shrub, nbrdlf_dcd_brl_shrub
#if (defined CROP)
   use pftvarcon    , only: ncorn, npcropmin, ztopmx, laimx
!   use clm_varctl   , only: iulog
!ylu remove   use shr_sys_mod  , only: shr_sys_flush
#endif
   use shr_const_mod, only: SHR_CONST_PI
!   use clm_time_manager , only : get_rad_step_size
   use globals , only: dt
!
! !ARGUMENTS:
   implicit none
   integer, intent(in) :: num_soilp                 ! number of column soil points in pft filter
   integer, intent(in) :: filter_soilp(:)   ! pft filter for soil points
!
! !CALLED FROM:
! subroutine CNEcosystemDyn
!
! !REVISION HISTORY:
! 10/28/03: Created by Peter Thornton
! 2/29/08, David Lawrence: revised snow burial fraction for short vegetation
!
! !LOCAL VARIABLES:
! local pointers to implicit in scalars
!
#if (defined CNDV)
   real(r8), pointer :: allom2(:)     ! ecophys const
   real(r8), pointer :: allom3(:)     ! ecophys const
   real(r8), pointer :: nind(:)       ! number of individuals (#/m**2)
   real(r8), pointer :: fpcgrid(:)    ! fractional area of pft (pft area/nat veg area)
#endif
   integer , pointer :: ivt(:)        ! pft vegetation type
   integer , pointer :: pcolumn(:)    ! column index associated with each pft
   integer , pointer :: pgridcell(:)  ! pft's gridcell index
   real(r8), pointer :: snowdp(:)     ! snow height (m)
   real(r8), pointer :: leafc(:)      ! (kgC/m2) leaf C
   real(r8), pointer :: deadstemc(:)  ! (kgC/m2) dead stem C
   real(r8), pointer :: woody(:)      !binary flag for woody lifeform (1=woody, 0=not woody)
   real(r8), pointer :: slatop(:)     !specific leaf area at top of canopy, projected area basis [m^2/gC]
   real(r8), pointer :: dsladlai(:)   !dSLA/dLAI, projected area basis [m^2/gC]
   real(r8), pointer :: z0mr(:)       !ratio of momentum roughness length to canopy top height (-)
   real(r8), pointer :: displar(:)    !ratio of displacement height to canopy top height (-)
   real(r8), pointer :: forc_hgt_u_pft(:) ! observational height of wind at pft-level [m]
   real(r8), pointer :: dwood(:)      ! density of wood (kgC/m^3)
!
! local pointers to implicit in/out scalars
!
   integer , pointer :: frac_veg_nosno_alb(:) ! frac of vegetation not covered by snow [-]
   real(r8), pointer :: tlai(:) !one-sided leaf area index, no burying by snow
   real(r8), pointer :: tsai(:) !one-sided stem area index, no burying by snow
   real(r8), pointer :: htop(:) !canopy top (m)
   real(r8), pointer :: hbot(:) !canopy bottom (m)
   real(r8), pointer :: elai(:)     ! one-sided leaf area index with burying by snow
   real(r8), pointer :: esai(:)     ! one-sided stem area index with burying by snow
#if (defined CROP)
   real(r8), pointer :: htmx(:)     ! max hgt attained by a crop during yr
   integer , pointer :: peaklai(:)  ! 1: max allowed lai; 0: not at max
   integer , pointer :: harvdate(:) ! harvest date

#endif
!
! local pointers to implicit out scalars
!
!
! !OTHER LOCAL VARIABLES:
   integer :: p,c,g        !indices
   integer :: fp           !lake filter indices
   real(r8):: taper        ! ratio of height:radius_breast_height (tree allometry)
   real(r8):: stocking     ! #stems / ha (stocking density)
   real(r8):: ol           ! thickness of canopy layer covered by snow (m)
   real(r8):: fb           ! fraction of canopy layer covered by snow
   real(r8) :: tlai_old    ! for use in Zeng tsai formula
   real(r8) :: tsai_old    ! for use in Zeng tsai formula
   real(r8) :: tsai_min    ! PFT derived minimum tsai
   real(r8) :: tsai_alpha  ! monthly decay rate of tsai
!   real(r8) dt             ! radiation time step (sec)

   real(r8), parameter :: dtsmonth = 2592000._r8 ! number of seconds in a 30 day month (60x60x24x30)
!EOP
!-----------------------------------------------------------------------
! tsai formula from Zeng et. al. 2002, Journal of Climate, p1835
!
! tsai(p) = max( tsai_alpha(ivt(p))*tsai_old + max(tlai_old-tlai(p),0_r8), tsai_min(ivt(p)) )
! notes:
! * RHS tsai & tlai are from previous timestep
! * should create tsai_alpha(ivt(p)) & tsai_min(ivt(p)) in pftvarcon.F90 - slevis
! * all non-crop pfts use same values:
!   crop    tsai_alpha,tsai_min = 0.0,0.1
!   noncrop tsai_alpha,tsai_min = 0.5,1.0  (includes bare soil and urban)
!-------------------------------------------------------------------------------

   ! assign local pointers to derived type arrays (in)
#if (defined CNDV)
    allom2                         => dgv_pftcon%allom2
    allom3                         => dgv_pftcon%allom3
    nind                           => clm3%g%l%c%p%pdgvs%nind
    fpcgrid                        => clm3%g%l%c%p%pdgvs%fpcgrid
#endif
    ivt                            => clm3%g%l%c%p%itype
    pcolumn                        => clm3%g%l%c%p%column
    pgridcell                      => clm3%g%l%c%p%gridcell
    leafc                          => clm3%g%l%c%p%pcs%leafc
    deadstemc                      => clm3%g%l%c%p%pcs%deadstemc
    snowdp                         => clm3%g%l%c%cps%snowdp
    woody                          => pftcon%woody
    slatop                         => pftcon%slatop
    dsladlai                       => pftcon%dsladlai
    z0mr                           => pftcon%z0mr
    displar                        => pftcon%displar
    dwood                          => pftcon%dwood

   ! assign local pointers to derived type arrays (out)
    tlai                           => clm3%g%l%c%p%pps%tlai
    tsai                           => clm3%g%l%c%p%pps%tsai
    htop                           => clm3%g%l%c%p%pps%htop
    hbot                           => clm3%g%l%c%p%pps%hbot
    elai                           => clm3%g%l%c%p%pps%elai
    esai                           => clm3%g%l%c%p%pps%esai
    frac_veg_nosno_alb             => clm3%g%l%c%p%pps%frac_veg_nosno_alb
#if (defined CROP)
    htmx                           => clm3%g%l%c%p%pps%htmx
    peaklai                        => clm3%g%l%c%p%pps%peaklai
    harvdate                       => clm3%g%l%c%p%pps%harvdate
#endif
    forc_hgt_u_pft                 => clm3%g%l%c%p%pps%forc_hgt_u_pft

!   dt = real( get_rad_step_size(), r8 )

   ! constant allometric parameters
   taper = 200._r8
   stocking = 1000._r8

   ! convert from stems/ha -> stems/m^2
   stocking = stocking / 10000._r8

   ! pft loop
   do fp = 1,num_soilp
      p = filter_soilp(fp)
      c = pcolumn(p)
      g = pgridcell(p)

      if (ivt(p) /= noveg) then

          tlai_old = tlai(p) ! n-1 value
          tsai_old = tsai(p) ! n-1 value

          ! update the leaf area index based on leafC and SLA
          ! Eq 3 from Thornton and Zimmerman, 2007, J Clim, 20, 3902-3923. 
          if (dsladlai(ivt(p)) > 0._r8) then
             tlai(p) = (slatop(ivt(p))*(exp(leafc(p)*dsladlai(ivt(p))) - 1._r8))/dsladlai(ivt(p))
          else
             tlai(p) = slatop(ivt(p)) * leafc(p)
          end if
          tlai(p) = max(0._r8, tlai(p))

          ! update the stem area index and height based on LAI, stem mass, and veg type.
          ! With the exception of htop for woody vegetation, this follows the DGVM logic.

          ! tsai formula from Zeng et. al. 2002, Journal of Climate, p1835 (see notes)
          ! Assumes doalb time step .eq. CLM time step, SAI min and monthly decay factor
          ! alpha are set by PFT, and alpha is scaled to CLM time step by multiplying by
          ! dt and dividing by dtsmonth (seconds in average 30 day month)
          ! tsai_min scaled by 0.5 to match MODIS satellite derived values
          if (ivt(p) == nc3crop .or. ivt(p) == nc4crop) then    ! crops

             tsai_alpha = 1.0_r8-1.0_r8*dt/dtsmonth
             tsai_min = 0.1_r8
          else
             tsai_alpha = 1.0_r8-0.5_r8*dt/dtsmonth
             tsai_min = 1.0_r8
          end if
          tsai_min = tsai_min * 0.5_r8
          tsai(p) = max(tsai_alpha*tsai_old+max(tlai_old-tlai(p),0._r8),tsai_min)

          if (woody(ivt(p)) == 1._r8) then

             ! trees and shrubs

             ! if shrubs have a squat taper 
             if (ivt(p) >= nbrdlf_evr_shrub .and. ivt(p) <= nbrdlf_dcd_brl_shrub) then
                taper = 10._r8
             ! otherwise have a tall taper
             else
                taper = 200._r8
             end if

             ! trees and shrubs for now have a very simple allometry, with hard-wired
             ! stem taper (height:radius) and hard-wired stocking density (#individuals/area)
#if (defined CNDV)
             if (fpcgrid(p) > 0._r8 .and. nind(p) > 0._r8) then
                stocking = nind(p)/fpcgrid(p) !#ind/m2 nat veg area -> #ind/m2 pft area
                htop(p) = allom2(ivt(p)) * ( (24._r8 * deadstemc(p) / &
                  (SHR_CONST_PI * stocking * dwood(ivt(p)) * taper))**(1._r8/3._r8) )**allom3(ivt(p)) ! lpj's htop w/ cn's stemdiam
             else
                htop(p) = 0._r8
             end if
#else
                htop(p) = ((3._r8 * deadstemc(p) * taper * taper)/ &
                  (SHR_CONST_PI * stocking * dwood(ivt(p))))**(1._r8/3._r8)
#endif

             ! Peter Thornton, 5/3/2004
             ! Adding test to keep htop from getting too close to forcing height for windspeed
             ! Also added for grass, below, although it is not likely to ever be an issue.
             htop(p) = min(htop(p),(forc_hgt_u_pft(p)/(displar(ivt(p))+z0mr(ivt(p))))-3._r8)

             ! Peter Thornton, 8/11/2004
             ! Adding constraint to keep htop from going to 0.0.
             ! This becomes an issue when fire mortality is pushing deadstemc
             ! to 0.0.
             htop(p) = max(htop(p), 0.01_r8)

             hbot(p) = max(0._r8, min(3._r8, htop(p)-1._r8))

#if (defined CROP)
          else if (ivt(p) >= npcropmin) then ! prognostic crops

             if (tlai(p) >= laimx(ivt(p))) peaklai(p) = 1 ! used in CNAllocation

             if (ivt(p) == ncorn) then
                tsai(p) = 0.1_r8 * tlai(p)
             else
                tsai(p) = 0.2_r8 * tlai(p)
             end if

             ! "stubble" after harvest
             if (harvdate(p) < 999 .and. tlai(p) == 0._r8) then
                tsai(p) = 0.25_r8
                htmx(p) = 0._r8
                peaklai(p) = 0
             end if
             if (harvdate(p) < 999 .and. tlai(p) > 0._r8) write(6,*) 'CNVegStructUpdate: tlai>0 after harvest!' ! remove after initial debugging?

             ! canopy top and bottom heights
             htop(p) = ztopmx(ivt(p)) * (min(tlai(p)/(laimx(ivt(p))-1._r8),1._r8))**2
             htmx(p) = max(htmx(p), htop(p))
             htop(p) = max(0.05_r8, max(htmx(p),htop(p)))
             hbot(p) = 0.02_r8
#endif
          else ! generic crops and ...
             ! grasses

             ! height for grasses depends only on LAI
             htop(p) = max(0.25_r8, tlai(p) * 0.25_r8)

             htop(p) = min(htop(p),(forc_hgt_u_pft(p)/(displar(ivt(p))+z0mr(ivt(p))))-3._r8)

             ! Peter Thornton, 8/11/2004
             ! Adding constraint to keep htop from going to 0.0.
             htop(p) = max(htop(p), 0.01_r8)

             hbot(p) = max(0.0_r8, min(0.05_r8, htop(p)-0.20_r8))
          end if

      else
          tlai(p) = 0._r8
          tsai(p) = 0._r8
          htop(p) = 0._r8
          hbot(p) = 0._r8
      end if
      
      ! adjust lai and sai for burying by snow. 

      ! snow burial fraction for short vegetation (e.g. grasses) as in
      ! Wang and Zeng, 2007.
      if (ivt(p) > noveg .and. ivt(p) <= nbrdlf_dcd_brl_shrub ) then
         ol = min( max(snowdp(c)-hbot(p), 0._r8), htop(p)-hbot(p))
         fb = 1._r8 - ol / max(1.e-06_r8, htop(p)-hbot(p))
      else
         fb = 1._r8 - max(min(snowdp(c),0.2_r8),0._r8)/0.2_r8   ! 0.2m is assumed
              !depth of snow required for complete burial of grasses
      endif

      elai(p) = max(tlai(p)*fb, 0.0_r8)
      esai(p) = max(tsai(p)*fb, 0.0_r8)

      ! Fraction of vegetation free of snow
      if ((elai(p) + esai(p)) > 0._r8) then
         frac_veg_nosno_alb(p) = 1
      else
         frac_veg_nosno_alb(p) = 0
      end if

   end do

end subroutine CNVegStructUpdate
!-----------------------------------------------------------------------
#endif

end module CNVegStructUpdateMod
module CNWoodProductsMod
#ifdef CN

!-----------------------------------------------------------------------
!BOP
!
! !MODULE: CNWoodProductsMod
!
! !DESCRIPTION:
! Calculate loss fluxes from wood products pools, and update product pool state variables
!
! !USES:
! ylu remove
!   use decompMod   , only : get_proc_bounds
    use shr_kind_mod, only: r8 => shr_kind_r8
    use clm_varcon  , only: istsoil
! ylu remove
!    use spmdMod     , only: masterproc
    implicit none
    save
    private
! !PUBLIC MEMBER FUNCTIONS:
    public:: CNWoodProducts
!
! !REVISION HISTORY:
! 5/20/2009: Created by Peter Thornton
!
!EOP
!-----------------------------------------------------------------------

contains

!-----------------------------------------------------------------------
!BOP
!
! !IROUTINE: CNWoodProducts
!
! !INTERFACE:
subroutine CNWoodProducts(num_soilc, filter_soilc)
!
! !DESCRIPTION:
! Update all loss fluxes from wood product pools, and update product pool state variables
! for both loss and gain terms.  Gain terms are calculated in pftdyn_cnbal() for gains associated
! with changes in landcover, and in CNHarvest(), for gains associated with wood harvest.
!
! !USES:
   use clmtype
!ylu removed
!   use clm_time_manager, only: get_step_size
  use globals , only: dt
!
! !ARGUMENTS:
   implicit none
   integer, intent(in) :: num_soilc       ! number of soil columns in filter
   integer, intent(in) :: filter_soilc(:) ! filter for soil columns
!
! !CALLED FROM:
! subroutine CNEcosystemDyn
!
! !REVISION HISTORY:
! 5/21/09: Created by Peter Thornton
!
! !LOCAL VARIABLES:

   integer :: fc        ! lake filter indices
   integer :: c         ! indices
!   real(r8):: dt        ! time step (seconds)
   type(column_type),   pointer :: cptr         ! pointer to column derived subtype
   real(r8) :: kprod10       ! decay constant for 10-year product pool
   real(r8) :: kprod100      ! decay constant for 100-year product pool

!EOP
!-----------------------------------------------------------------------

   cptr => clm3%g%l%c
	
   ! calculate column-level losses from product pools
	! the following (1/s) rate constants result in ~90% loss of initial state over 10 and 100 years,
	! respectively, using a discrete-time fractional decay algorithm.
	kprod10 = 7.2e-9
	kprod100 = 7.2e-10

!dir$ concurrent
!cdir nodep
   do fc = 1,num_soilc
      c = filter_soilc(fc)

		! calculate fluxes (1/sec)
		cptr%ccf%prod10c_loss(c)    = cptr%ccs%prod10c(c)    * kprod10
		cptr%ccf%prod100c_loss(c)   = cptr%ccs%prod100c(c)   * kprod100
#if (defined C13)
		cptr%cc13f%prod10c_loss(c)  = cptr%cc13s%prod10c(c)  * kprod10
		cptr%cc13f%prod100c_loss(c) = cptr%cc13s%prod100c(c) * kprod100
#endif
		cptr%cnf%prod10n_loss(c)    = cptr%cns%prod10n(c)    * kprod10
		cptr%cnf%prod100n_loss(c)   = cptr%cns%prod100n(c)   * kprod100
	end do

   ! set time steps
!   dt = real( get_step_size(), r8 )

   ! update wood product state variables
   ! column loop
!dir$ concurrent
!cdir nodep
   do fc = 1,num_soilc
      c = filter_soilc(fc)

      ! column-level fluxes

      ! fluxes into wood product pools, from landcover change
      cptr%ccs%prod10c(c)    = cptr%ccs%prod10c(c)    + cptr%ccf%dwt_prod10c_gain(c)*dt
      cptr%ccs%prod100c(c)   = cptr%ccs%prod100c(c)   + cptr%ccf%dwt_prod100c_gain(c)*dt
#if (defined C13)
      cptr%cc13s%prod10c(c)  = cptr%cc13s%prod10c(c)  + cptr%cc13f%dwt_prod10c_gain(c)*dt
      cptr%cc13s%prod100c(c) = cptr%cc13s%prod100c(c) + cptr%cc13f%dwt_prod100c_gain(c)*dt
#endif
      cptr%cns%prod10n(c)    = cptr%cns%prod10n(c)    + cptr%cnf%dwt_prod10n_gain(c)*dt
      cptr%cns%prod100n(c)   = cptr%cns%prod100n(c)   + cptr%cnf%dwt_prod100n_gain(c)*dt

      ! fluxes into wood product pools, from harvest
      cptr%ccs%prod10c(c)    = cptr%ccs%prod10c(c)    + cptr%ccf%hrv_deadstemc_to_prod10c(c)*dt
      cptr%ccs%prod100c(c)   = cptr%ccs%prod100c(c)   + cptr%ccf%hrv_deadstemc_to_prod100c(c)*dt
#if (defined C13)
      cptr%cc13s%prod10c(c)  = cptr%cc13s%prod10c(c)  + cptr%cc13f%hrv_deadstemc_to_prod10c(c)*dt
      cptr%cc13s%prod100c(c) = cptr%cc13s%prod100c(c) + cptr%cc13f%hrv_deadstemc_to_prod100c(c)*dt
#endif
      cptr%cns%prod10n(c)    = cptr%cns%prod10n(c)    + cptr%cnf%hrv_deadstemn_to_prod10n(c)*dt
      cptr%cns%prod100n(c)   = cptr%cns%prod100n(c)   + cptr%cnf%hrv_deadstemn_to_prod100n(c)*dt
     
      ! fluxes out of wood product pools, from decomposition
      cptr%ccs%prod10c(c)    = cptr%ccs%prod10c(c)    - cptr%ccf%prod10c_loss(c)*dt
      cptr%ccs%prod100c(c)   = cptr%ccs%prod100c(c)   - cptr%ccf%prod100c_loss(c)*dt
#if (defined C13)
      cptr%cc13s%prod10c(c)  = cptr%cc13s%prod10c(c)  - cptr%cc13f%prod10c_loss(c)*dt
      cptr%cc13s%prod100c(c) = cptr%cc13s%prod100c(c) - cptr%cc13f%prod100c_loss(c)*dt
#endif
      cptr%cns%prod10n(c)    = cptr%cns%prod10n(c)    - cptr%cnf%prod10n_loss(c)*dt
      cptr%cns%prod100n(c)   = cptr%cns%prod100n(c)   - cptr%cnf%prod100n_loss(c)*dt
 
   end do ! end of column loop

end subroutine CNWoodProducts
!-----------------------------------------------------------------------

#endif

end module CNWoodProductsMod
!#include <misc.h>
!#include <preproc.h>

!-----------------------------------------------------------------------
!BOP
!
! !IROUTINE: CNiniSpecial
!
! !INTERFACE:
subroutine CNiniSpecial ()

#ifdef CN
!
! !DESCRIPTION:
! One-time initialization of CN variables for special landunits
!
! !USES:
   use shr_kind_mod, only: r8 => shr_kind_r8
   use pftvarcon   , only: noveg
   use decompMod   , only: get_proc_bounds
   use clm_varcon  , only: spval
!   use clm_varctl  , only: iulog
   use clmtype
   use CNSetValueMod
!
! !ARGUMENTS:
   implicit none
!
! !CALLED FROM:
! subroutine iniTimeConst in file iniTimeConst.F90
!
! !REVISION HISTORY:
! 11/13/03: Created by Peter Thornton
!
!
! local pointers to implicit in arguments
!
  integer , pointer :: clandunit(:)    ! landunit index of corresponding column
  integer , pointer :: plandunit(:)    ! landunit index of corresponding pft
  logical , pointer :: ifspecial(:)    ! BOOL: true=>landunit is wetland,ice,lake, or urban
!
! local pointers to implicit out arguments
!
! !LOCAL VARIABLES:
!EOP
   integer :: fc,fp,l,c,p  ! indices
   integer :: begp, endp   ! per-clump/proc beginning and ending pft indices
   integer :: begc, endc   ! per-clump/proc beginning and ending column indices
   integer :: begl, endl   ! per-clump/proc beginning and ending landunit indices
   integer :: begg, endg   ! per-clump/proc gridcell ending gridcell indices
   integer :: num_specialc ! number of good values in specialc filter
   integer :: num_specialp ! number of good values in specialp filter
   integer, allocatable :: specialc(:) ! special landunit filter - columns
   integer, allocatable :: specialp(:) ! special landunit filter - pfts
!-----------------------------------------------------------------------

    call CLMDebug('Enter CNiniSpecial()')

   ! assign local pointers at the landunit level
   ifspecial => clm3%g%l%ifspecial

   ! assign local pointers at the column level
   clandunit => clm3%g%l%c%landunit

   ! assign local pointers at the pft level
   plandunit => clm3%g%l%c%p%landunit

   ! Determine subgrid bounds on this processor
   call get_proc_bounds(begg, endg, begl, endl, begc, endc, begp, endp)

   ! allocate special landunit filters
   allocate(specialc(endc-begc+1))
   allocate(specialp(endp-begp+1))

   ! fill special landunit filters
   num_specialc = 0
   do c = begc, endc
      l = clandunit(c)
      if (ifspecial(l)) then
         num_specialc = num_specialc + 1
         specialc(num_specialc) = c
      end if
   end do

   num_specialp = 0
   do p = begp, endp
      l = plandunit(p)
      if (ifspecial(l)) then
         num_specialp = num_specialp + 1
         specialp(num_specialp) = p
      end if
   end do

   ! initialize column-level fields
   call CLMDebug('start call CNSetCps()')
   call CNSetCps(num_specialc, specialc, spval, clm3%g%l%c%cps)
   call CNSetCcs(num_specialc, specialc, 0._r8, clm3%g%l%c%ccs)
   call CNSetCns(num_specialc, specialc, 0._r8, clm3%g%l%c%cns)
   call CNSetCcf(num_specialc, specialc, 0._r8, clm3%g%l%c%ccf)
   call CNSetCnf(num_specialc, specialc, 0._r8, clm3%g%l%c%cnf)
#if (defined C13)
   ! 4/14/05: PET
   ! adding isotope code
   call CNSetCcs(num_specialc, specialc, 0._r8, clm3%g%l%c%cc13s)
   call CNSetCcf(num_specialc, specialc, 0._r8, clm3%g%l%c%cc13f)
#endif

   ! initialize column-average pft fields
   call CNSetPps(num_specialc, specialc, spval, clm3%g%l%c%cps%pps_a)
   call CNSetPcs(num_specialc, specialc, 0._r8, clm3%g%l%c%ccs%pcs_a)
   call CNSetPns(num_specialc, specialc, 0._r8, clm3%g%l%c%cns%pns_a)
   call CNSetPcf(num_specialc, specialc, 0._r8, clm3%g%l%c%ccf%pcf_a)
   call CNSetPnf(num_specialc, specialc, 0._r8, clm3%g%l%c%cnf%pnf_a)

   ! initialize pft-level fields
   call CNSetPepv(num_specialp, specialp, spval, clm3%g%l%c%p%pepv)
   call CNSetPps(num_specialp, specialp, spval, clm3%g%l%c%p%pps)
   call CNSetPcs(num_specialp, specialp, 0._r8, clm3%g%l%c%p%pcs)
   call CNSetPns(num_specialp, specialp, 0._r8, clm3%g%l%c%p%pns)
   call CNSetPcf(num_specialp, specialp, 0._r8, clm3%g%l%c%p%pcf)
   call CNSetPnf(num_specialp, specialp, 0._r8, clm3%g%l%c%p%pnf)
#if (defined C13)
   ! 4/14/05: PET
   ! adding isotope code
   call CNSetPcs(num_specialp, specialp, 0._r8, clm3%g%l%c%p%pc13s)
   call CNSetPcf(num_specialp, specialp, 0._r8, clm3%g%l%c%p%pc13f)
#endif
   call CLMDebug('All CNSet call are right')
   ! now loop through special filters and explicitly set the variables that
   ! have to be in place for SurfaceAlbedo and biogeophysics
   ! also set pcf%psnsun and pcf%psnsha to 0 (not included in CNSetPcf())

!dir$ concurrent
!cdir nodep
   do fp = 1,num_specialp
      p = specialp(fp)
      clm3%g%l%c%p%pps%tlai(p) = 0._r8
      clm3%g%l%c%p%pps%tsai(p) = 0._r8
      clm3%g%l%c%p%pps%elai(p) = 0._r8
      clm3%g%l%c%p%pps%esai(p) = 0._r8
      clm3%g%l%c%p%pps%htop(p) = 0._r8
      clm3%g%l%c%p%pps%hbot(p) = 0._r8
      clm3%g%l%c%p%pps%fwet(p) = 0._r8
      clm3%g%l%c%p%pps%fdry(p) = 0._r8
      clm3%g%l%c%p%pps%frac_veg_nosno_alb(p) = 0._r8
      clm3%g%l%c%p%pps%frac_veg_nosno(p) = 0._r8
      clm3%g%l%c%p%pcf%psnsun(p) = 0._r8
      clm3%g%l%c%p%pcf%psnsha(p) = 0._r8
#if (defined C13)
      ! 4/14/05: PET
      ! Adding isotope code
      clm3%g%l%c%p%pc13f%psnsun(p) = 0._r8
      clm3%g%l%c%p%pc13f%psnsha(p) = 0._r8
#endif
      
   end do

!dir$ concurrent
!cdir nodep
   do fc = 1,num_specialc
      c = specialc(fc)
      clm3%g%l%c%ccf%pcf_a%psnsun(c) = 0._r8
      clm3%g%l%c%ccf%pcf_a%psnsha(c) = 0._r8
#if (defined C13)
      ! 8/17/05: PET
      ! Adding isotope code
      clm3%g%l%c%cc13f%pcf_a%psnsun(c) = 0._r8
      clm3%g%l%c%cc13f%pcf_a%psnsha(c) = 0._r8
#endif
      
	  ! adding dynpft code
	  clm3%g%l%c%ccs%seedc(c) = 0._r8
	  clm3%g%l%c%ccs%prod10c(c) = 0._r8	  
	  clm3%g%l%c%ccs%prod100c(c) = 0._r8	  
	  clm3%g%l%c%ccs%totprodc(c) = 0._r8	  
#if (defined C13)
	  clm3%g%l%c%cc13s%seedc(c) = 0._r8
	  clm3%g%l%c%cc13s%prod10c(c) = 0._r8	  
	  clm3%g%l%c%cc13s%prod100c(c) = 0._r8	  
	  clm3%g%l%c%cc13s%totprodc(c) = 0._r8	  
#endif
	  clm3%g%l%c%cns%seedn(c) = 0._r8
	  clm3%g%l%c%cns%prod10n(c) = 0._r8	  
	  clm3%g%l%c%cns%prod100n(c) = 0._r8	  
	  clm3%g%l%c%cns%totprodn(c) = 0._r8	  
	  clm3%g%l%c%ccf%dwt_seedc_to_leaf(c) = 0._r8
	  clm3%g%l%c%ccf%dwt_seedc_to_deadstem(c) = 0._r8
	  clm3%g%l%c%ccf%dwt_conv_cflux(c) = 0._r8
	  clm3%g%l%c%ccf%dwt_prod10c_gain(c) = 0._r8
	  clm3%g%l%c%ccf%prod10c_loss(c) = 0._r8
	  clm3%g%l%c%ccf%dwt_prod100c_gain(c) = 0._r8
	  clm3%g%l%c%ccf%prod100c_loss(c) = 0._r8
	  clm3%g%l%c%ccf%dwt_frootc_to_litr1c(c) = 0._r8
	  clm3%g%l%c%ccf%dwt_frootc_to_litr2c(c) = 0._r8
	  clm3%g%l%c%ccf%dwt_frootc_to_litr3c(c) = 0._r8
	  clm3%g%l%c%ccf%dwt_livecrootc_to_cwdc(c) = 0._r8
	  clm3%g%l%c%ccf%dwt_deadcrootc_to_cwdc(c) = 0._r8
	  clm3%g%l%c%ccf%dwt_closs(c) = 0._r8
	  clm3%g%l%c%ccf%landuseflux(c) = 0._r8
	  clm3%g%l%c%ccf%landuptake(c) = 0._r8
#if (defined C13)
	  clm3%g%l%c%cc13f%dwt_seedc_to_leaf(c) = 0._r8
	  clm3%g%l%c%cc13f%dwt_seedc_to_deadstem(c) = 0._r8
	  clm3%g%l%c%cc13f%dwt_conv_cflux(c) = 0._r8
	  clm3%g%l%c%cc13f%dwt_prod10c_gain(c) = 0._r8
	  clm3%g%l%c%cc13f%prod10c_loss(c) = 0._r8
	  clm3%g%l%c%cc13f%dwt_prod100c_gain(c) = 0._r8
	  clm3%g%l%c%cc13f%prod100c_loss(c) = 0._r8
	  clm3%g%l%c%cc13f%dwt_frootc_to_litr1c(c) = 0._r8
	  clm3%g%l%c%cc13f%dwt_frootc_to_litr2c(c) = 0._r8
	  clm3%g%l%c%cc13f%dwt_frootc_to_litr3c(c) = 0._r8
	  clm3%g%l%c%cc13f%dwt_livecrootc_to_cwdc(c) = 0._r8
	  clm3%g%l%c%cc13f%dwt_deadcrootc_to_cwdc(c) = 0._r8
	  clm3%g%l%c%cc13f%dwt_closs(c) = 0._r8
#endif
	  clm3%g%l%c%cnf%dwt_seedn_to_leaf(c) = 0._r8
	  clm3%g%l%c%cnf%dwt_seedn_to_deadstem(c) = 0._r8
	  clm3%g%l%c%cnf%dwt_conv_nflux(c) = 0._r8
	  clm3%g%l%c%cnf%dwt_prod10n_gain(c) = 0._r8
	  clm3%g%l%c%cnf%prod10n_loss(c) = 0._r8
	  clm3%g%l%c%cnf%dwt_prod100n_gain(c) = 0._r8
	  clm3%g%l%c%cnf%prod100n_loss(c) = 0._r8
	  clm3%g%l%c%cnf%dwt_frootn_to_litr1n(c) = 0._r8
	  clm3%g%l%c%cnf%dwt_frootn_to_litr2n(c) = 0._r8
	  clm3%g%l%c%cnf%dwt_frootn_to_litr3n(c) = 0._r8
	  clm3%g%l%c%cnf%dwt_livecrootn_to_cwdn(c) = 0._r8
	  clm3%g%l%c%cnf%dwt_deadcrootn_to_cwdn(c) = 0._r8
	  clm3%g%l%c%cnf%dwt_nloss(c) = 0._r8
      
   end do

   ! deallocate special landunit filters
   deallocate(specialc)
   deallocate(specialp)

#endif

end subroutine CNiniSpecial
!-----------------------------------------------------------------------
!BOP
!
! !IROUTINE: CNiniTimeVar
!
! !INTERFACE:
subroutine CNiniTimeVar(htmx_buf,croplive_buf,gdd1020_buf,gdd820_buf,gdd020_buf,grainc_buf,grainc_storage_buf  &
                ,grainc_xfer_buf,grainn_buf,grainn_storage_buf,grainn_xfer_buf,days_active_buf  &
                ,onset_flag_buf,onset_counter_buf,onset_gddflag_buf,onset_fdd_buf,onset_gdd_buf &
                ,onset_swi_buf,offset_flag_buf,offset_counter_buf,offset_fdd_buf,offset_swi_buf &
                ,dayl_buf,annavg_t2m_buf,tempavg_t2m_buf,tempsum_potential_gpp_buf          &
                ,annsum_potential_gpp_buf,tempmax_retransn_buf,annmax_retransn_buf      &
                ,prev_leafc_to_litter_buf,prev_frootc_to_litter_buf,tempsum_npp_buf     &
                ,annsum_npp_buf,leafc_buf,leafc_storage_buf,leafc_xfer_buf,frootc_buf           &
                ,frootc_storage_buf,frootc_xfer_buf,livestemc_buf,livestemc_storage_buf     &
                ,livestemc_xfer_buf,deadstemc_buf,deadstemc_storage_buf,deadstemc_xfer_buf  &
                ,livecrootc_buf,livecrootc_storage_buf,livecrootc_xfer_buf,deadcrootc_buf   &
                ,deadcrootc_storage_buf,deadcrootc_xfer_buf,cpool_buf,pft_ctrunc_buf        &
                ,leafn_buf,leafn_storage_buf,leafn_xfer_buf,frootn_buf,frootn_storage_buf       &
                ,frootn_xfer_buf,livestemn_buf,livestemn_storage_buf,livestemn_xfer_buf     &
                ,deadstemn_buf,deadstemn_storage_buf,deadstemn_xfer_buf,livecrootn_buf      &
                ,livecrootn_storage_buf,livecrootn_xfer_buf,deadcrootn_buf              &
                ,deadcrootn_storage_buf,deadcrootn_xfer_buf,npool_buf,pft_ntrunc_buf        &
                ,gresp_storage_buf,gresp_xfer_buf,xsmrpool_buf,annsum_counter_buf           &
                ,cannsum_npp_buf,cannavg_t2m_buf,wf_buf,me_buf,mean_fire_prob_buf,cwdc_buf,litr1c_buf   &
                ,litr2c_buf,litr3c_buf,soil1c_buf,soil2c_buf,soil3c_buf,soil4c_buf,seedc_buf,col_ctrunc_buf &
                ,prod10c_buf,prod100c_buf,cwdn_buf,litr1n_buf,litr2n_buf,litr3n_buf,soil1n_buf,soil2n_buf   &
                ,soil3n_buf,soil4n_buf,seedn_buf,col_ntrunc_buf,prod10n_buf,prod100n_buf,sminn_buf &
                ,totlitc_buf,dwt_seedc_to_leaf_buf,dwt_seedc_to_deadstem_buf,dwt_conv_cflux_buf &
                ,dwt_prod10c_gain_buf,dwt_prod100c_gain_buf,prod100c_loss_buf,dwt_frootc_to_litr1c_buf &
                ,dwt_frootc_to_litr2c_buf,dwt_frootc_to_litr3c_buf,dwt_livecrootc_to_cwdc_buf &
                ,dwt_deadcrootc_to_cwdc_buf,dwt_seedn_to_leaf_buf,dwt_seedn_to_deadstem_buf &
                ,dwt_conv_nflux_buf,dwt_prod10n_gain_buf,dwt_prod100n_gain_buf,prod100n_loss_buf &
                ,dwt_frootn_to_litr1n_buf,dwt_frootn_to_litr2n_buf, dwt_frootn_to_litr3n_buf &
                , dwt_livecrootn_to_cwdn_buf,dwt_deadcrootn_to_cwdn_buf,retransn_buf &
                        )

#ifdef CN
!
! !DESCRIPTION:
! Initializes time varying variables used only in
! coupled carbon-nitrogen mode (CN):
!
! !USES:
   use clmtype
!   use clm_atmlnd  , only: clm_a2l  !removed for coupling purpose Yaqiong Lu 01/25/11
   use shr_kind_mod, only: r8 => shr_kind_r8
   use clm_varcon  , only: istsoil
#ifdef CROP
   use clm_varcon  , only: istcrop
#endif
#if (defined C13)
   use clm_varcon  , only: c13ratio
#endif
   use pftvarcon   , only: noveg
#if (defined CROP)
   use pftvarcon   , only: npcropmin
#endif
   use decompMod   , only: get_proc_bounds
   use globals     , only: nstep
   use clm_varpar  , only: maxpatch
!
! !ARGUMENTS:
   implicit none
!
! !CALLED FROM:
! subroutine iniTimeVar in file iniTimeVar.F90
!
! !REVISION HISTORY:
! 10/21/03: Created by Peter Thornton
!
!
! local pointers to implicit in arguments
!
   real(r8), pointer :: evergreen(:) ! binary flag for evergreen leaf habit (0 or 1)
   real(r8), pointer :: woody(:)     ! binary flag for woody lifeform (1=woody, 0=not woody)
   real(r8), pointer :: leafcn(:)    ! leaf C:N (gC/gN)
   real(r8), pointer :: deadwdcn(:)  ! dead wood (xylem and heartwood) C:N (gC/gN)
   integer , pointer :: ivt(:)       ! pft vegetation type
   logical , pointer :: lakpoi(:)    ! true => landunit is a lake point
   integer , pointer :: plandunit(:) ! landunit index associated with each pft
   integer , pointer :: clandunit(:) ! landunit index associated with each column
   integer , pointer :: itypelun(:)  ! landunit type
!
! local pointers to implicit out arguments
!
   real(r8), pointer :: forc_hgt_u_pft(:)    !observational height of wind at pft-level [m]
   real(r8), pointer :: annsum_counter(:) ! seconds since last annual accumulator turnover
   real(r8), pointer :: cannsum_npp(:)    ! annual sum of NPP, averaged from pft-level (gC/m2/yr)
   real(r8), pointer :: cannavg_t2m(:)    !annual average of 2m air temperature, averaged from pft-level (K)
   real(r8), pointer :: cwdc(:)               ! (gC/m2) coarse woody debris C
   real(r8), pointer :: litr1c(:)             ! (gC/m2) litter labile C
   real(r8), pointer :: litr2c(:)             ! (gC/m2) litter cellulose C
   real(r8), pointer :: litr3c(:)             ! (gC/m2) litter lignin C
   real(r8), pointer :: soil1c(:)             ! (gC/m2) soil organic matter C (fast pool)
   real(r8), pointer :: soil2c(:)             ! (gC/m2) soil organic matter C (medium pool)
   real(r8), pointer :: soil3c(:)             ! (gC/m2) soil organic matter C (slow pool)
   real(r8), pointer :: soil4c(:)             ! (gC/m2) soil organic matter C (slowest pool)
   real(r8), pointer :: cwdn(:)               ! (gN/m2) coarse woody debris N
   real(r8), pointer :: litr1n(:)             ! (gN/m2) litter labile N
   real(r8), pointer :: litr2n(:)             ! (gN/m2) litter cellulose N
   real(r8), pointer :: litr3n(:)             ! (gN/m2) litter lignin N
   real(r8), pointer :: soil1n(:)             ! (gN/m2) soil organic matter N (fast pool)
   real(r8), pointer :: soil2n(:)             ! (gN/m2) soil organic matter N (medium pool)
   real(r8), pointer :: soil3n(:)             ! (gN/m2) soil orgainc matter N (slow pool)
   real(r8), pointer :: soil4n(:)             ! (gN/m2) soil orgainc matter N (slowest pool)
   real(r8), pointer :: sminn(:)              ! (gN/m2) soil mineral N
   real(r8), pointer :: leafc(:)              ! (gC/m2) leaf C
   real(r8), pointer :: leafc_storage(:)      ! (gC/m2) leaf C storage
   real(r8), pointer :: leafc_xfer(:)         ! (gC/m2) leaf C transfer
#if (defined CROP)
   real(r8), pointer :: grainc(:)             ! (gC/m2) grain C
   real(r8), pointer :: grainc_storage(:)     ! (gC/m2) grain C storage
   real(r8), pointer :: grainc_xfer(:)        ! (gC/m2) grain C transfer
   integer , pointer :: croplive(:)  ! post planting+pre harvest+live=1; else 0
   real(r8), pointer :: htmx(:)      ! max hgt attained by a crop during yr
   real(r8), pointer :: gdd020(:)          ! 20-yr means of same variables
   real(r8), pointer :: gdd820(:)
   real(r8), pointer :: gdd1020(:)
   integer , pointer :: harvdate(:)
   integer , pointer :: peaklai(:)   ! 1: max allowed lai; 0: not at max
   integer , pointer :: cropplant(:) ! field can be planted = 0; else 1
   real(r8), pointer :: vf(:)        ! vernalization factor for wheat
#endif
   real(r8), pointer :: frootc(:)             ! (gC/m2) fine root C
   real(r8), pointer :: frootc_storage(:)     ! (gC/m2) fine root C storage
   real(r8), pointer :: frootc_xfer(:)        ! (gC/m2) fine root C transfer
   real(r8), pointer :: livestemc(:)          ! (gC/m2) live stem C
   real(r8), pointer :: livestemc_storage(:)  ! (gC/m2) live stem C storage
   real(r8), pointer :: livestemc_xfer(:)     ! (gC/m2) live stem C transfer
   real(r8), pointer :: deadstemc(:)          ! (gC/m2) dead stem C
   real(r8), pointer :: deadstemc_storage(:)  ! (gC/m2) dead stem C storage
   real(r8), pointer :: deadstemc_xfer(:)     ! (gC/m2) dead stem C transfer
   real(r8), pointer :: livecrootc(:)         ! (gC/m2) live coarse root C
   real(r8), pointer :: livecrootc_storage(:) ! (gC/m2) live coarse root C storage
   real(r8), pointer :: livecrootc_xfer(:)    ! (gC/m2) live coarse root C transfer
   real(r8), pointer :: deadcrootc(:)         ! (gC/m2) dead coarse root C
   real(r8), pointer :: deadcrootc_storage(:) ! (gC/m2) dead coarse root C storage
   real(r8), pointer :: deadcrootc_xfer(:)    ! (gC/m2) dead coarse root C transfer
   real(r8), pointer :: gresp_storage(:)      ! (gC/m2) growth respiration storage
   real(r8), pointer :: gresp_xfer(:)         ! (gC/m2) growth respiration transfer
   real(r8), pointer :: cpool(:)              ! (gC/m2) temporary photosynthate C pool
   real(r8), pointer :: xsmrpool(:)           ! (gC/m2) abstract C pool to meet excess MR demand
   real(r8), pointer :: leafn(:)              ! (gN/m2) leaf N
   real(r8), pointer :: leafn_storage(:)      ! (gN/m2) leaf N storage
   real(r8), pointer :: leafn_xfer(:)         ! (gN/m2) leaf N transfer
#if (defined CROP)
   real(r8), pointer :: grainn(:)             ! (gN/m2) grain N
   real(r8), pointer :: grainn_storage(:)     ! (gN/m2) grain N storage
   real(r8), pointer :: grainn_xfer(:)        ! (gN/m2) grain N transfer
#endif
   real(r8), pointer :: frootn(:)             ! (gN/m2) fine root N
   real(r8), pointer :: frootn_storage(:)     ! (gN/m2) fine root N storage
   real(r8), pointer :: frootn_xfer(:)        ! (gN/m2) fine root N transfer
   real(r8), pointer :: livestemn(:)          ! (gN/m2) live stem N
   real(r8), pointer :: livestemn_storage(:)  ! (gN/m2) live stem N storage
   real(r8), pointer :: livestemn_xfer(:)     ! (gN/m2) live stem N transfer
   real(r8), pointer :: deadstemn(:)          ! (gN/m2) dead stem N
   real(r8), pointer :: deadstemn_storage(:)  ! (gN/m2) dead stem N storage
   real(r8), pointer :: deadstemn_xfer(:)     ! (gN/m2) dead stem N transfer
   real(r8), pointer :: livecrootn(:)         ! (gN/m2) live coarse root N
   real(r8), pointer :: livecrootn_storage(:) ! (gN/m2) live coarse root N storage
   real(r8), pointer :: livecrootn_xfer(:)    ! (gN/m2) live coarse root N transfer
   real(r8), pointer :: deadcrootn(:)         ! (gN/m2) dead coarse root N
   real(r8), pointer :: deadcrootn_storage(:) ! (gN/m2) dead coarse root N storage
   real(r8), pointer :: deadcrootn_xfer(:)    ! (gN/m2) dead coarse root N transfer
   real(r8), pointer :: retransn(:)           ! (gN/m2) plant pool of retranslocated N
   real(r8), pointer :: npool(:)              ! (gN/m2) temporary plant N pool
   real(r8), pointer :: psnsun(:)             ! sunlit leaf photosynthesis (umol CO2 /m**2/ s)
   real(r8), pointer :: psnsha(:)             ! shaded leaf photosynthesis (umol CO2 /m**2/ s)
#if (defined C13)
   real(r8), pointer :: c13_psnsun(:)             ! sunlit leaf photosynthesis (umol CO2 /m**2/ s)
   real(r8), pointer :: c13_psnsha(:)             ! shaded leaf photosynthesis (umol CO2 /m**2/ s)
#endif
   real(r8), pointer :: laisun(:)             ! sunlit projected leaf area index
   real(r8), pointer :: laisha(:)             ! shaded projected leaf area index
   real(r8), pointer :: dormant_flag(:)       ! dormancy flag
   real(r8), pointer :: days_active(:)        ! number of days since last dormancy
   real(r8), pointer :: onset_flag(:)         ! onset flag
   real(r8), pointer :: onset_counter(:)      ! onset days counter
   real(r8), pointer :: onset_gddflag(:)      ! onset flag for growing degree day sum
   real(r8), pointer :: onset_fdd(:)          ! onset freezing degree days counter
   real(r8), pointer :: onset_gdd(:)          ! onset growing degree days
   real(r8), pointer :: onset_swi(:)          ! onset soil water index
   real(r8), pointer :: offset_flag(:)        ! offset flag
   real(r8), pointer :: offset_counter(:)     ! offset days counter
   real(r8), pointer :: offset_fdd(:)         ! offset freezing degree days counter
   real(r8), pointer :: offset_swi(:)         ! offset soil water index
   real(r8), pointer :: lgsf(:)               ! long growing season factor [0-1]
   real(r8), pointer :: bglfr(:)              ! background litterfall rate (1/s)
   real(r8), pointer :: bgtr(:)               ! background transfer rate (1/s)
   real(r8), pointer :: dayl(:)               ! daylength (seconds)
   real(r8), pointer :: prev_dayl(:)          ! daylength from previous timestep (seconds)
   real(r8), pointer :: annavg_t2m(:)         ! annual average 2m air temperature (K)
   real(r8), pointer :: tempavg_t2m(:)        ! temporary average 2m air temperature (K)
   real(r8), pointer :: gpp(:)                ! GPP flux before downregulation (gC/m2/s)
   real(r8), pointer :: availc(:)             ! C flux available for allocation (gC/m2/s)
   real(r8), pointer :: xsmrpool_recover(:)   ! C flux assigned to recovery of negative cpool (gC/m2/s)
#if (defined C13)
   real(r8), pointer :: xsmrpool_c13ratio(:)  ! C flux assigned to recovery of negative cpool (gC/m2/s)
#endif
   real(r8), pointer :: alloc_pnow(:)         ! fraction of current allocation to display as new growth (DIM)
   real(r8), pointer :: c_allometry(:)        ! C allocation index (DIM)
   real(r8), pointer :: n_allometry(:)        ! N allocation index (DIM)
   real(r8), pointer :: plant_ndemand(:)      ! N flux required to support initial GPP (gN/m2/s)
   real(r8), pointer :: tempsum_potential_gpp(:) ! temporary annual sum of plant_ndemand
   real(r8), pointer :: annsum_potential_gpp(:)  ! annual sum of plant_ndemand
   real(r8), pointer :: tempmax_retransn(:)   ! temporary max of retranslocated N pool (gN/m2)
   real(r8), pointer :: annmax_retransn(:)    ! annual max of retranslocated N pool (gN/m2)
   real(r8), pointer :: avail_retransn(:)     ! N flux available from retranslocation pool (gN/m2/s)
   real(r8), pointer :: plant_nalloc(:)       ! total allocated N flux (gN/m2/s)
   real(r8), pointer :: plant_calloc(:)       ! total allocated C flux (gC/m2/s)
   real(r8), pointer :: excess_cflux(:)       ! C flux not allocated due to downregulation (gC/m2/s)
   real(r8), pointer :: downreg(:)            ! fractional reduction in GPP due to N limitation (DIM)
   real(r8), pointer :: tempsum_npp(:)        ! temporary annual sum of NPP
   real(r8), pointer :: annsum_npp(:)         ! annual sum of NPP
#if (defined CNDV)
   real(r8), pointer :: tempsum_litfall(:)    ! temporary annual sum of litfall
   real(r8), pointer :: annsum_litfall(:)     ! annual sum of litfall
#endif
#if (defined C13)
   real(r8), pointer :: rc13_canair(:)        !C13O2/C12O2 in canopy air
   real(r8), pointer :: rc13_psnsun(:)        !C13O2/C12O2 in sunlit canopy psn flux
   real(r8), pointer :: rc13_psnsha(:)        !C13O2/C12O2 in shaded canopy psn flux
   real(r8), pointer :: alphapsnsun(:)        !sunlit 13c fractionation ([])
   real(r8), pointer :: alphapsnsha(:)        !shaded 13c fractionation ([])
#endif
   real(r8), pointer :: qflx_drain(:)         ! sub-surface runoff (mm H2O /s)
   ! new variables for fire
   real(r8), pointer :: wf(:)                 ! soil moisture in top 0.5 m
   real(r8), pointer :: me(:)                 ! moisture of extinction (proportion)
   real(r8), pointer :: fire_prob(:)          ! daily fire probability (0-1)
   real(r8), pointer :: mean_fire_prob(:)     ! e-folding mean of daily fire probability (0-1)
   real(r8), pointer :: fireseasonl(:)        ! annual fire season length (days, <= 365)
   real(r8), pointer :: farea_burned(:)       ! timestep fractional area burned (proportion)
   real(r8), pointer :: ann_farea_burned(:)   ! annual total fractional area burned (proportion)
   real(r8), pointer :: col_ctrunc(:)         ! (gC/m2) column-level sink for C truncation
   real(r8), pointer :: totcolc(:)            ! (gC/m2) total column carbon, incl veg and cpool
   real(r8), pointer :: totecosysc(:)         ! (gC/m2) total ecosystem carbon, incl veg but excl cpool
   real(r8), pointer :: totlitc(:)            ! (gC/m2) total litter carbon
   real(r8), pointer :: totsomc(:)            ! (gC/m2) total soil organic matter carbon

#if (defined CLAMP)
   ! new CLAMP state variables
   real(r8), pointer :: woodc(:)              ! (gC/m2) pft-level wood C
#endif

   real(r8), pointer :: col_ntrunc(:)         ! (gN/m2) column-level sink for N truncation
   real(r8), pointer :: totcoln(:)            ! (gN/m2) total column nitrogen, incl veg
   real(r8), pointer :: totecosysn(:)         ! (gN/m2) total ecosystem nitrogen, incl veg
   real(r8), pointer :: totlitn(:)            ! (gN/m2) total litter nitrogen
   real(r8), pointer :: totsomn(:)            ! (gN/m2) total soil organic matter nitrogen
   real(r8), pointer :: dispvegc(:)           ! (gC/m2) displayed veg carbon, excluding storage and cpool
   real(r8), pointer :: pft_ctrunc(:)         ! (gC/m2) pft-level sink for C truncation
   real(r8), pointer :: storvegc(:)           ! (gC/m2) stored vegetation carbon, excluding cpool
   real(r8), pointer :: totpftc(:)            ! (gC/m2) total pft-level carbon, including cpool
   real(r8), pointer :: totvegc(:)            ! (gC/m2) total vegetation carbon, excluding cpool
   real(r8), pointer :: prev_frootc_to_litter(:)!previous timestep froot C litterfall flux (gC/m2/s)
   real(r8), pointer :: prev_leafc_to_litter(:) !previous timestep leaf C litterfall flux (gC/m2/s)
   real(r8), pointer :: dispvegn(:)           ! (gN/m2) displayed veg nitrogen, excluding storage
   real(r8), pointer :: pft_ntrunc(:)         ! (gN/m2) pft-level sink for N truncation
   real(r8), pointer :: storvegn(:)           ! (gN/m2) stored vegetation nitrogen
   real(r8), pointer :: totpftn(:)            ! (gN/m2) total pft-level nitrogen
   real(r8), pointer :: totvegn(:)            ! (gN/m2) total vegetation nitrogen
   real(r8), pointer :: lncsha(:)             ! leaf N concentration per unit projected LAI (gN leaf/m^2)
   real(r8), pointer :: lncsun(:)             ! leaf N concentration per unit projected LAI (gN leaf/m^2)
   real(r8), pointer :: vcmxsha(:)            ! shaded leaf Vcmax (umolCO2/m^2/s)
   real(r8), pointer :: vcmxsun(:)            ! sunlit leaf Vcmax (umolCO2/m^2/s)
#if (defined C13)
   ! 4/14/05: PET
   ! Adding isotope code
   real(r8), pointer :: cwdc13(:)               ! (gC/m2) coarse woody debris C
   real(r8), pointer :: litr1c13(:)             ! (gC/m2) litter labile C
   real(r8), pointer :: litr2c13(:)             ! (gC/m2) litter cellulose C
   real(r8), pointer :: litr3c13(:)             ! (gC/m2) litter lignin C
   real(r8), pointer :: soil1c13(:)             ! (gC/m2) soil organic matter C (fast pool)
   real(r8), pointer :: soil2c13(:)             ! (gC/m2) soil organic matter C (medium pool)
   real(r8), pointer :: soil3c13(:)             ! (gC/m2) soil organic matter C (slow pool)
   real(r8), pointer :: soil4c13(:)             ! (gC/m2) soil organic matter C (slowest pool)
   real(r8), pointer :: c13_col_ctrunc(:)       ! (gC/m2) C truncation term
   real(r8), pointer :: leafc13(:)              ! (gC/m2) leaf C
   real(r8), pointer :: leafc13_storage(:)      ! (gC/m2) leaf C storage
   real(r8), pointer :: leafc13_xfer(:)         ! (gC/m2) leaf C transfer
#if (defined CROP)
   real(r8), pointer :: grainc13(:)             ! (gC/m2) grain C
   real(r8), pointer :: grainc13_storage(:)     ! (gC/m2) grain C storage
   real(r8), pointer :: grainc13_xfer(:)        ! (gC/m2) grain C transfer
#endif
   real(r8), pointer :: frootc13(:)             ! (gC/m2) fine root C
   real(r8), pointer :: frootc13_storage(:)     ! (gC/m2) fine root C storage
   real(r8), pointer :: frootc13_xfer(:)        ! (gC/m2) fine root C transfer
   real(r8), pointer :: livestemc13(:)          ! (gC/m2) live stem C
   real(r8), pointer :: livestemc13_storage(:)  ! (gC/m2) live stem C storage
   real(r8), pointer :: livestemc13_xfer(:)     ! (gC/m2) live stem C transfer
   real(r8), pointer :: deadstemc13(:)          ! (gC/m2) dead stem C
   real(r8), pointer :: deadstemc13_storage(:)  ! (gC/m2) dead stem C storage
   real(r8), pointer :: deadstemc13_xfer(:)     ! (gC/m2) dead stem C transfer
   real(r8), pointer :: livecrootc13(:)         ! (gC/m2) live coarse root C
   real(r8), pointer :: livecrootc13_storage(:) ! (gC/m2) live coarse root C storage
   real(r8), pointer :: livecrootc13_xfer(:)    ! (gC/m2) live coarse root C transfer
   real(r8), pointer :: deadcrootc13(:)         ! (gC/m2) dead coarse root C
   real(r8), pointer :: deadcrootc13_storage(:) ! (gC/m2) dead coarse root C storage
   real(r8), pointer :: deadcrootc13_xfer(:)    ! (gC/m2) dead coarse root C transfer
   real(r8), pointer :: c13_gresp_storage(:)    ! (gC/m2) growth respiration storage
   real(r8), pointer :: c13_gresp_xfer(:)       ! (gC/m2) growth respiration transfer
   real(r8), pointer :: c13pool(:)              ! (gC/m2) temporary photosynthate C pool
   real(r8), pointer :: c13xsmrpool(:)          ! (gC/m2) temporary photosynthate C pool
   real(r8), pointer :: c13_pft_ctrunc(:)       ! (gC/m2) C truncation term
   real(r8), pointer :: totvegc13(:)            ! (gC/m2) total vegetation carbon, excluding cpool
#endif
   ! dynamic landuse variables
   real(r8), pointer :: seedc(:)              ! (gC/m2) column-level pool for seeding new PFTs
   real(r8), pointer :: prod10c(:)            ! (gC/m2) wood product C pool, 10-year lifespan
   real(r8), pointer :: prod100c(:)           ! (gC/m2) wood product C pool, 100-year lifespan
   real(r8), pointer :: totprodc(:)           ! (gC/m2) total wood product C
#if (defined C13)
   real(r8), pointer :: seedc13(:)              ! (gC/m2) column-level pool for seeding new PFTs
   real(r8), pointer :: prod10c13(:)          ! (gC/m2) wood product C13 pool, 10-year lifespan
   real(r8), pointer :: prod100c13(:)         ! (gC/m2) wood product C13 pool, 100-year lifespan
   real(r8), pointer :: totprodc13(:)         ! (gC/m2) total wood product C13
#endif
   real(r8), pointer :: seedn(:)              ! (gN/m2) column-level pool for seeding new PFTs
   real(r8), pointer :: prod10n(:)            ! (gN/m2) wood product N pool, 10-year lifespan
   real(r8), pointer :: prod100n(:)           ! (gN/m2) wood product N pool, 100-year lifespan
   real(r8), pointer :: totprodn(:)           ! (gN/m2) total wood product N



!CN CROP vars
!CROP&CN buf variables
  integer,dimension(maxpatch) :: croplive_buf
   real(r8), dimension(maxpatch)  ::  &
                 htmx_buf,gdd1020_buf,gdd820_buf,gdd020_buf,grainc_buf,grainc_storage_buf  &
                ,grainc_xfer_buf,grainn_buf,grainn_storage_buf,grainn_xfer_buf,days_active_buf  &
                ,onset_flag_buf,onset_counter_buf,onset_gddflag_buf,onset_fdd_buf,onset_gdd_buf &
                ,onset_swi_buf,offset_flag_buf,offset_counter_buf,offset_fdd_buf,offset_swi_buf &
                ,dayl_buf,annavg_t2m_buf,tempavg_t2m_buf,tempsum_potential_gpp_buf          &
                ,annsum_potential_gpp_buf,tempmax_retransn_buf,annmax_retransn_buf      &
                ,prev_leafc_to_litter_buf,prev_frootc_to_litter_buf,tempsum_npp_buf     &
                ,annsum_npp_buf,leafc_buf,leafc_storage_buf,leafc_xfer_buf,frootc_buf           &
                ,frootc_storage_buf,frootc_xfer_buf,livestemc_buf,livestemc_storage_buf     &
                ,livestemc_xfer_buf,deadstemc_buf,deadstemc_storage_buf,deadstemc_xfer_buf  &
                ,livecrootc_buf,livecrootc_storage_buf,livecrootc_xfer_buf,deadcrootc_buf   &
                ,deadcrootc_storage_buf,deadcrootc_xfer_buf,cpool_buf,pft_ctrunc_buf        &
                ,leafn_buf,leafn_storage_buf,leafn_xfer_buf,frootn_buf,frootn_storage_buf       &
                ,frootn_xfer_buf,livestemn_buf,livestemn_storage_buf,livestemn_xfer_buf     &
                ,deadstemn_buf,deadstemn_storage_buf,deadstemn_xfer_buf,livecrootn_buf      &
                ,livecrootn_storage_buf,livecrootn_xfer_buf,deadcrootn_buf              &
                ,deadcrootn_storage_buf,deadcrootn_xfer_buf,npool_buf,pft_ntrunc_buf        &
                ,gresp_storage_buf,gresp_xfer_buf,xsmrpool_buf,annsum_counter_buf           &
                ,cannsum_npp_buf,cannavg_t2m_buf,wf_buf,me_buf,mean_fire_prob_buf,cwdc_buf,litr1c_buf   &
                ,litr2c_buf,litr3c_buf,soil1c_buf,soil2c_buf,soil3c_buf,soil4c_buf,seedc_buf,col_ctrunc_buf &
                ,prod10c_buf,prod100c_buf,cwdn_buf,litr1n_buf,litr2n_buf,litr3n_buf,soil1n_buf,soil2n_buf   &
                ,soil3n_buf,soil4n_buf,seedn_buf,col_ntrunc_buf,prod10n_buf,prod100n_buf,sminn_buf &
                ,totlitc_buf,dwt_seedc_to_leaf_buf,dwt_seedc_to_deadstem_buf,dwt_conv_cflux_buf &
                ,dwt_prod10c_gain_buf,dwt_prod100c_gain_buf,prod100c_loss_buf,dwt_frootc_to_litr1c_buf &
                ,dwt_frootc_to_litr2c_buf,dwt_frootc_to_litr3c_buf,dwt_livecrootc_to_cwdc_buf &
                ,dwt_deadcrootc_to_cwdc_buf,dwt_seedn_to_leaf_buf,dwt_seedn_to_deadstem_buf &
                ,dwt_conv_nflux_buf,dwt_prod10n_gain_buf,dwt_prod100n_gain_buf,prod100n_loss_buf &
                ,dwt_frootn_to_litr1n_buf,dwt_frootn_to_litr2n_buf, dwt_frootn_to_litr3n_buf &
                , dwt_livecrootn_to_cwdn_buf,dwt_deadcrootn_to_cwdn_buf,retransn_buf



!
! !LOCAL VARIABLES:
   integer :: g,l,c,p      ! indices
   integer :: begp, endp   ! per-clump/proc beginning and ending pft indices
   integer :: begc, endc   ! per-clump/proc beginning and ending column indices
   integer :: begl, endl   ! per-clump/proc beginning and ending landunit indices
   integer :: begg, endg   ! per-clump/proc gridcell ending gridcell indices
!EOP
!-----------------------------------------------------------------------

    ! assign local pointers at the gridcell level

    ! assign local pointers at the landunit level
    lakpoi                         => clm3%g%l%lakpoi
    itypelun                       => clm3%g%l%itype

    ! assign local pointers at the column level
    clandunit                      => clm3%g%l%c%landunit
    annsum_counter                 => clm3%g%l%c%cps%annsum_counter
    cannsum_npp                    => clm3%g%l%c%cps%cannsum_npp
    cannavg_t2m                    => clm3%g%l%c%cps%cannavg_t2m
    wf                             => clm3%g%l%c%cps%wf
    me                             => clm3%g%l%c%cps%me
    fire_prob                      => clm3%g%l%c%cps%fire_prob
    mean_fire_prob                 => clm3%g%l%c%cps%mean_fire_prob
    fireseasonl                    => clm3%g%l%c%cps%fireseasonl
    farea_burned                   => clm3%g%l%c%cps%farea_burned
    ann_farea_burned               => clm3%g%l%c%cps%ann_farea_burned
    qflx_drain                     => clm3%g%l%c%cwf%qflx_drain
    cwdc                           => clm3%g%l%c%ccs%cwdc
    litr1c                         => clm3%g%l%c%ccs%litr1c
    litr2c                         => clm3%g%l%c%ccs%litr2c
    litr3c                         => clm3%g%l%c%ccs%litr3c
    soil1c                         => clm3%g%l%c%ccs%soil1c
    soil2c                         => clm3%g%l%c%ccs%soil2c
    soil3c                         => clm3%g%l%c%ccs%soil3c
    soil4c                         => clm3%g%l%c%ccs%soil4c
    
    ! dynamic landuse variables
    seedc                          => clm3%g%l%c%ccs%seedc
    prod10c                        => clm3%g%l%c%ccs%prod10c
    prod100c                       => clm3%g%l%c%ccs%prod100c
    totprodc                       => clm3%g%l%c%ccs%totprodc
#if (defined C13)
    seedc13                        => clm3%g%l%c%cc13s%seedc
    prod10c13                      => clm3%g%l%c%cc13s%prod10c
    prod100c13                     => clm3%g%l%c%cc13s%prod100c
    totprodc13                     => clm3%g%l%c%cc13s%totprodc
#endif
    seedn                          => clm3%g%l%c%cns%seedn
    prod10n                        => clm3%g%l%c%cns%prod10n
    prod100n                       => clm3%g%l%c%cns%prod100n
    totprodn                       => clm3%g%l%c%cns%totprodn
    
    cwdn                           => clm3%g%l%c%cns%cwdn
    litr1n                         => clm3%g%l%c%cns%litr1n
    litr2n                         => clm3%g%l%c%cns%litr2n
    litr3n                         => clm3%g%l%c%cns%litr3n
    soil1n                         => clm3%g%l%c%cns%soil1n
    soil2n                         => clm3%g%l%c%cns%soil2n
    soil3n                         => clm3%g%l%c%cns%soil3n
    soil4n                         => clm3%g%l%c%cns%soil4n
    sminn                          => clm3%g%l%c%cns%sminn
    col_ctrunc                     => clm3%g%l%c%ccs%col_ctrunc
    totcolc                        => clm3%g%l%c%ccs%totcolc
    totecosysc                     => clm3%g%l%c%ccs%totecosysc
    totlitc                        => clm3%g%l%c%ccs%totlitc
    totsomc                        => clm3%g%l%c%ccs%totsomc

    col_ntrunc                     => clm3%g%l%c%cns%col_ntrunc
    totcoln                        => clm3%g%l%c%cns%totcoln
    totecosysn                     => clm3%g%l%c%cns%totecosysn
    totlitn                        => clm3%g%l%c%cns%totlitn
    totsomn                        => clm3%g%l%c%cns%totsomn
#if (defined C13)
   ! 4/14/05: PET
   ! Adding isotope code
    cwdc13                           => clm3%g%l%c%cc13s%cwdc
    litr1c13                         => clm3%g%l%c%cc13s%litr1c
    litr2c13                         => clm3%g%l%c%cc13s%litr2c
    litr3c13                         => clm3%g%l%c%cc13s%litr3c
    soil1c13                         => clm3%g%l%c%cc13s%soil1c
    soil2c13                         => clm3%g%l%c%cc13s%soil2c
    soil3c13                         => clm3%g%l%c%cc13s%soil3c
    soil4c13                         => clm3%g%l%c%cc13s%soil4c
    c13_col_ctrunc                   => clm3%g%l%c%cc13s%col_ctrunc
#endif

    ! assign local pointers at the pft level
    ivt                            => clm3%g%l%c%p%itype
    plandunit                      => clm3%g%l%c%p%landunit
    leafc                          => clm3%g%l%c%p%pcs%leafc
    leafc_storage                  => clm3%g%l%c%p%pcs%leafc_storage
    leafc_xfer                     => clm3%g%l%c%p%pcs%leafc_xfer
#if (defined CROP)
    grainc                         => clm3%g%l%c%p%pcs%grainc
    grainc_storage                 => clm3%g%l%c%p%pcs%grainc_storage
    grainc_xfer                    => clm3%g%l%c%p%pcs%grainc_xfer
    gdd020                        => clm3%g%l%c%p%pps%gdd020
    gdd820                        => clm3%g%l%c%p%pps%gdd820
    gdd1020                       => clm3%g%l%c%p%pps%gdd1020
    croplive   => clm3%g%l%c%p%pps%croplive
    htmx       => clm3%g%l%c%p%pps%htmx
    harvdate   => clm3%g%l%c%p%pps%harvdate
    peaklai    => clm3%g%l%c%p%pps%peaklai
    cropplant  => clm3%g%l%c%p%pps%cropplant
    vf         => clm3%g%l%c%p%pps%vf
#endif
    frootc                         => clm3%g%l%c%p%pcs%frootc
    frootc_storage                 => clm3%g%l%c%p%pcs%frootc_storage
    frootc_xfer                    => clm3%g%l%c%p%pcs%frootc_xfer
    livestemc                      => clm3%g%l%c%p%pcs%livestemc
    livestemc_storage              => clm3%g%l%c%p%pcs%livestemc_storage
    livestemc_xfer                 => clm3%g%l%c%p%pcs%livestemc_xfer
    deadstemc                      => clm3%g%l%c%p%pcs%deadstemc
    deadstemc_storage              => clm3%g%l%c%p%pcs%deadstemc_storage
    deadstemc_xfer                 => clm3%g%l%c%p%pcs%deadstemc_xfer
    livecrootc                     => clm3%g%l%c%p%pcs%livecrootc
    livecrootc_storage             => clm3%g%l%c%p%pcs%livecrootc_storage
    livecrootc_xfer                => clm3%g%l%c%p%pcs%livecrootc_xfer
    deadcrootc                     => clm3%g%l%c%p%pcs%deadcrootc
    deadcrootc_storage             => clm3%g%l%c%p%pcs%deadcrootc_storage
    deadcrootc_xfer                => clm3%g%l%c%p%pcs%deadcrootc_xfer
    gresp_storage                  => clm3%g%l%c%p%pcs%gresp_storage
    gresp_xfer                     => clm3%g%l%c%p%pcs%gresp_xfer
    cpool                          => clm3%g%l%c%p%pcs%cpool
    xsmrpool                       => clm3%g%l%c%p%pcs%xsmrpool
    forc_hgt_u_pft                 => clm3%g%l%c%p%pps%forc_hgt_u_pft

#if (defined CLAMP)
    ! CLAMP variable
    woodc                          => clm3%g%l%c%p%pcs%woodc
#endif

    leafn                          => clm3%g%l%c%p%pns%leafn
    leafn_storage                  => clm3%g%l%c%p%pns%leafn_storage
    leafn_xfer                     => clm3%g%l%c%p%pns%leafn_xfer
#if (defined CROP)
    grainn                         => clm3%g%l%c%p%pns%grainn
    grainn_storage                 => clm3%g%l%c%p%pns%grainn_storage
    grainn_xfer                    => clm3%g%l%c%p%pns%grainn_xfer
#endif
    frootn                         => clm3%g%l%c%p%pns%frootn
    frootn_storage                 => clm3%g%l%c%p%pns%frootn_storage
    frootn_xfer                    => clm3%g%l%c%p%pns%frootn_xfer
    livestemn                      => clm3%g%l%c%p%pns%livestemn
    livestemn_storage              => clm3%g%l%c%p%pns%livestemn_storage
    livestemn_xfer                 => clm3%g%l%c%p%pns%livestemn_xfer
    deadstemn                      => clm3%g%l%c%p%pns%deadstemn
    deadstemn_storage              => clm3%g%l%c%p%pns%deadstemn_storage
    deadstemn_xfer                 => clm3%g%l%c%p%pns%deadstemn_xfer
    livecrootn                     => clm3%g%l%c%p%pns%livecrootn
    livecrootn_storage             => clm3%g%l%c%p%pns%livecrootn_storage
    livecrootn_xfer                => clm3%g%l%c%p%pns%livecrootn_xfer
    deadcrootn                     => clm3%g%l%c%p%pns%deadcrootn
    deadcrootn_storage             => clm3%g%l%c%p%pns%deadcrootn_storage
    deadcrootn_xfer                => clm3%g%l%c%p%pns%deadcrootn_xfer
    retransn                       => clm3%g%l%c%p%pns%retransn
    npool                          => clm3%g%l%c%p%pns%npool
    psnsun                         => clm3%g%l%c%p%pcf%psnsun
    psnsha                         => clm3%g%l%c%p%pcf%psnsha
#if (defined C13)
    c13_psnsun                     => clm3%g%l%c%p%pc13f%psnsun
    c13_psnsha                     => clm3%g%l%c%p%pc13f%psnsha
#endif
    laisun                         => clm3%g%l%c%p%pps%laisun
    laisha                         => clm3%g%l%c%p%pps%laisha
    dormant_flag                   => clm3%g%l%c%p%pepv%dormant_flag
    days_active                    => clm3%g%l%c%p%pepv%days_active
    onset_flag                     => clm3%g%l%c%p%pepv%onset_flag
    onset_counter                  => clm3%g%l%c%p%pepv%onset_counter
    onset_gddflag                  => clm3%g%l%c%p%pepv%onset_gddflag
    onset_fdd                      => clm3%g%l%c%p%pepv%onset_fdd
    onset_gdd                      => clm3%g%l%c%p%pepv%onset_gdd
    onset_swi                      => clm3%g%l%c%p%pepv%onset_swi
    offset_flag                    => clm3%g%l%c%p%pepv%offset_flag
    offset_counter                 => clm3%g%l%c%p%pepv%offset_counter
    offset_fdd                     => clm3%g%l%c%p%pepv%offset_fdd
    offset_swi                     => clm3%g%l%c%p%pepv%offset_swi
    lgsf                           => clm3%g%l%c%p%pepv%lgsf
    bglfr                          => clm3%g%l%c%p%pepv%bglfr
    bgtr                           => clm3%g%l%c%p%pepv%bgtr
    dayl                           => clm3%g%l%c%p%pepv%dayl
    prev_dayl                      => clm3%g%l%c%p%pepv%prev_dayl
    annavg_t2m                     => clm3%g%l%c%p%pepv%annavg_t2m
    tempavg_t2m                    => clm3%g%l%c%p%pepv%tempavg_t2m
    gpp                            => clm3%g%l%c%p%pepv%gpp
    availc                         => clm3%g%l%c%p%pepv%availc
    xsmrpool_recover                  => clm3%g%l%c%p%pepv%xsmrpool_recover
#if (defined C13)
    xsmrpool_c13ratio                  => clm3%g%l%c%p%pepv%xsmrpool_c13ratio
#endif
    alloc_pnow                     => clm3%g%l%c%p%pepv%alloc_pnow
    c_allometry                    => clm3%g%l%c%p%pepv%c_allometry
    n_allometry                    => clm3%g%l%c%p%pepv%n_allometry
    plant_ndemand                  => clm3%g%l%c%p%pepv%plant_ndemand
    tempsum_potential_gpp          => clm3%g%l%c%p%pepv%tempsum_potential_gpp
    annsum_potential_gpp           => clm3%g%l%c%p%pepv%annsum_potential_gpp
    tempmax_retransn               => clm3%g%l%c%p%pepv%tempmax_retransn
    annmax_retransn                => clm3%g%l%c%p%pepv%annmax_retransn
    avail_retransn                 => clm3%g%l%c%p%pepv%avail_retransn
    plant_nalloc                   => clm3%g%l%c%p%pepv%plant_nalloc
    plant_calloc                   => clm3%g%l%c%p%pepv%plant_calloc
    excess_cflux                   => clm3%g%l%c%p%pepv%excess_cflux
    downreg                        => clm3%g%l%c%p%pepv%downreg
    tempsum_npp                    => clm3%g%l%c%p%pepv%tempsum_npp
    annsum_npp                     => clm3%g%l%c%p%pepv%annsum_npp
#if (defined CNDV)
    tempsum_litfall                => clm3%g%l%c%p%pepv%tempsum_litfall
    annsum_litfall                 => clm3%g%l%c%p%pepv%annsum_litfall
#endif
    dispvegc                       => clm3%g%l%c%p%pcs%dispvegc
    pft_ctrunc                     => clm3%g%l%c%p%pcs%pft_ctrunc
    storvegc                       => clm3%g%l%c%p%pcs%storvegc
    totpftc                        => clm3%g%l%c%p%pcs%totpftc
    totvegc                        => clm3%g%l%c%p%pcs%totvegc
    prev_frootc_to_litter          => clm3%g%l%c%p%pepv%prev_frootc_to_litter
    prev_leafc_to_litter           => clm3%g%l%c%p%pepv%prev_leafc_to_litter
    dispvegn                       => clm3%g%l%c%p%pns%dispvegn
    pft_ntrunc                     => clm3%g%l%c%p%pns%pft_ntrunc
    storvegn                       => clm3%g%l%c%p%pns%storvegn
    totpftn                        => clm3%g%l%c%p%pns%totpftn
    totvegn                        => clm3%g%l%c%p%pns%totvegn
    lncsha                         => clm3%g%l%c%p%pps%lncsha
    lncsun                         => clm3%g%l%c%p%pps%lncsun
    vcmxsha                        => clm3%g%l%c%p%pps%vcmxsha
    vcmxsun                        => clm3%g%l%c%p%pps%vcmxsun
#if (defined C13)
    ! 4/14/05: PET
    ! Adding isotope code
    alphapsnsun                      => clm3%g%l%c%p%pps%alphapsnsun
    alphapsnsha                      => clm3%g%l%c%p%pps%alphapsnsha
    leafc13                          => clm3%g%l%c%p%pc13s%leafc
    leafc13_storage                  => clm3%g%l%c%p%pc13s%leafc_storage
    leafc13_xfer                     => clm3%g%l%c%p%pc13s%leafc_xfer
#if (defined CROP)
    grainc13                         => clm3%g%l%c%p%pc13s%grainc
    grainc13_storage                 => clm3%g%l%c%p%pc13s%grainc_storage
    grainc13_xfer                    => clm3%g%l%c%p%pc13s%grainc_xfer
#endif
    frootc13                         => clm3%g%l%c%p%pc13s%frootc
    frootc13_storage                 => clm3%g%l%c%p%pc13s%frootc_storage
    frootc13_xfer                    => clm3%g%l%c%p%pc13s%frootc_xfer
    livestemc13                      => clm3%g%l%c%p%pc13s%livestemc
    livestemc13_storage              => clm3%g%l%c%p%pc13s%livestemc_storage
    livestemc13_xfer                 => clm3%g%l%c%p%pc13s%livestemc_xfer
    deadstemc13                      => clm3%g%l%c%p%pc13s%deadstemc
    deadstemc13_storage              => clm3%g%l%c%p%pc13s%deadstemc_storage
    deadstemc13_xfer                 => clm3%g%l%c%p%pc13s%deadstemc_xfer
    livecrootc13                     => clm3%g%l%c%p%pc13s%livecrootc
    livecrootc13_storage             => clm3%g%l%c%p%pc13s%livecrootc_storage
    livecrootc13_xfer                => clm3%g%l%c%p%pc13s%livecrootc_xfer
    deadcrootc13                     => clm3%g%l%c%p%pc13s%deadcrootc
    deadcrootc13_storage             => clm3%g%l%c%p%pc13s%deadcrootc_storage
    deadcrootc13_xfer                => clm3%g%l%c%p%pc13s%deadcrootc_xfer
    c13_gresp_storage                => clm3%g%l%c%p%pc13s%gresp_storage
    c13_gresp_xfer                   => clm3%g%l%c%p%pc13s%gresp_xfer
    c13pool                          => clm3%g%l%c%p%pc13s%cpool
    c13xsmrpool                      => clm3%g%l%c%p%pc13s%xsmrpool
    c13_pft_ctrunc                   => clm3%g%l%c%p%pc13s%pft_ctrunc
    totvegc13                        => clm3%g%l%c%p%pc13s%totvegc
    rc13_canair                      => clm3%g%l%c%p%pepv%rc13_canair
    rc13_psnsun                      => clm3%g%l%c%p%pepv%rc13_psnsun
    rc13_psnsha                      => clm3%g%l%c%p%pepv%rc13_psnsha
#endif
    
    ! assign local pointers for ecophysiological constants
    evergreen                      => pftcon%evergreen
    woody                          => pftcon%woody
    leafcn                         => pftcon%leafcn
    deadwdcn                       => pftcon%deadwdcn

   ! Determine subgrid bounds on this processor
   call get_proc_bounds(begg, endg, begl, endl, begc, endc, begp, endp)

   ! Added 5/4/04, PET: initialize forc_hgt_u (gridcell-level),
   ! since this is not initialized before first call to CNVegStructUpdate,
   ! and it is required to set the upper bound for canopy top height.
   ! Changed 3/21/08, KO: still needed but don't have sufficient information 
   ! to set this properly (e.g., pft-level displacement height and roughness 
   ! length). So leave at 30m.
!dir$ concurrent
!cdir nodep


!if this is the first time step, then initiate all variable to the start up value
write(6,*) 'in CNiniTimeVar,nstep=',nstep

IF(nstep == 1) THEN

   do p = begp, endp
      forc_hgt_u_pft(p) = 30._r8
   end do

   ! initialize column-level variables
!dir$ concurrent
!cdir nodep
   do c = begc, endc
      l = clandunit(c)
#ifndef CROP
      if (itypelun(l) == istsoil) then
#else
      if (itypelun(l) == istsoil .or. itypelun(l) == istcrop) then
#endif

         ! column physical state variables
         annsum_counter(c) = 0._r8
         cannsum_npp(c)    = 0._r8
         cannavg_t2m(c)    = 280._r8
         wf(c) = 1.0_r8  ! it needs to be non zero so the first time step has no fires
         me(c) = 0._r8
         fire_prob(c) = 0._r8
         mean_fire_prob(c) = 0._r8
         fireseasonl(c) = 0._r8
         farea_burned(c) = 0._r8
         ann_farea_burned(c) = 0._r8
         
         ! needed for CNNLeaching
         qflx_drain(c) = 0._r8

         ! column carbon state variable initialization
         cwdc(c)   = 0._r8
         litr1c(c) = 0._r8
         litr2c(c) = 0._r8
         litr3c(c) = 0._r8
         soil1c(c) = 0._r8
         soil2c(c) = 0._r8
         soil3c(c) = 0._r8
         soil4c(c) = 10._r8
         col_ctrunc(c) = 0._r8
         totlitc(c)    = 0._r8
         totsomc(c)    = 0._r8
         totecosysc(c) = 0._r8
         totcolc(c)    = 0._r8

#if (defined C13)
         ! 4/14/05: PET
         ! Adding isotope code
         cwdc13(c)   = cwdc(c)   * c13ratio
         litr1c13(c) = litr1c(c) * c13ratio
         litr2c13(c) = litr2c(c) * c13ratio
         litr3c13(c) = litr3c(c) * c13ratio
         soil1c13(c) = soil1c(c) * c13ratio
         soil2c13(c) = soil2c(c) * c13ratio
         soil3c13(c) = soil3c(c) * c13ratio
         soil4c13(c) = soil4c(c) * c13ratio
         c13_col_ctrunc(c) = col_ctrunc(c) * c13ratio
#endif

         ! column nitrogen state variables
         cwdn(c)   = cwdc(c) / 500._r8
         litr1n(c) = litr1c(c) / 90._r8
         litr2n(c) = litr2c(c) / 90._r8
         litr3n(c) = litr3c(c) / 90._r8
         soil1n(c) = soil1c(c) / 12._r8
         soil2n(c) = soil2c(c) / 12._r8
         soil3n(c) = soil3c(c) / 10._r8
         soil4n(c) = soil4c(c) / 10._r8
         sminn(c) = 0._r8
         col_ntrunc(c) = 0._r8
         totlitn(c)    = 0._r8
         totsomn(c)    = 0._r8
         totecosysn(c) = 0._r8
         totcoln(c)    = 0._r8

	 ! dynamic landcover state variables
     seedc(c)  = 0._r8
	 prod10c(c)    = 0._r8
	 prod100c(c)   = 0._r8
	 totprodc(c)   = 0._r8
#if (defined C13)
     seedc13(c)    = 0._r8
	 prod10c13(c)  = 0._r8
	 prod100c13(c) = 0._r8
	 totprodc13(c) = 0._r8
#endif
	 seedn(c)      = 0._r8
	 prod10n(c)    = 0._r8
	 prod100n(c)   = 0._r8
	 totprodn(c)   = 0._r8
	 
	 ! also initialize dynamic landcover fluxes so that they have
	 ! real values on first timestep, prior to calling pftdyn_cnbal
	 clm3%g%l%c%ccf%dwt_seedc_to_leaf(c) = 0._r8
	 clm3%g%l%c%ccf%dwt_seedc_to_deadstem(c) = 0._r8
	 clm3%g%l%c%ccf%dwt_conv_cflux(c) = 0._r8
	 clm3%g%l%c%ccf%dwt_prod10c_gain(c) = 0._r8
	 clm3%g%l%c%ccf%prod10c_loss(c) = 0._r8
	 clm3%g%l%c%ccf%dwt_prod100c_gain(c) = 0._r8
	 clm3%g%l%c%ccf%prod100c_loss(c) = 0._r8
	 clm3%g%l%c%ccf%dwt_frootc_to_litr1c(c) = 0._r8
	 clm3%g%l%c%ccf%dwt_frootc_to_litr2c(c) = 0._r8
	 clm3%g%l%c%ccf%dwt_frootc_to_litr3c(c) = 0._r8
	 clm3%g%l%c%ccf%dwt_livecrootc_to_cwdc(c) = 0._r8
	 clm3%g%l%c%ccf%dwt_deadcrootc_to_cwdc(c) = 0._r8
	 clm3%g%l%c%ccf%dwt_closs(c) = 0._r8
#if (defined C13)
	 clm3%g%l%c%cc13f%dwt_seedc_to_leaf(c) = 0._r8
	 clm3%g%l%c%cc13f%dwt_seedc_to_deadstem(c) = 0._r8
	 clm3%g%l%c%cc13f%dwt_conv_cflux(c) = 0._r8
	 clm3%g%l%c%cc13f%dwt_prod10c_gain(c) = 0._r8
	 clm3%g%l%c%cc13f%prod10c_loss(c) = 0._r8
	 clm3%g%l%c%cc13f%dwt_prod100c_gain(c) = 0._r8
	 clm3%g%l%c%cc13f%prod100c_loss(c) = 0._r8
	 clm3%g%l%c%cc13f%dwt_frootc_to_litr1c(c) = 0._r8
	 clm3%g%l%c%cc13f%dwt_frootc_to_litr2c(c) = 0._r8
	 clm3%g%l%c%cc13f%dwt_frootc_to_litr3c(c) = 0._r8
	 clm3%g%l%c%cc13f%dwt_livecrootc_to_cwdc(c) = 0._r8
	 clm3%g%l%c%cc13f%dwt_deadcrootc_to_cwdc(c) = 0._r8
	 clm3%g%l%c%cc13f%dwt_closs(c) = 0._r8
#endif
	 clm3%g%l%c%cnf%dwt_seedn_to_leaf(c) = 0._r8
	 clm3%g%l%c%cnf%dwt_seedn_to_deadstem(c) = 0._r8
	 clm3%g%l%c%cnf%dwt_conv_nflux(c) = 0._r8
	 clm3%g%l%c%cnf%dwt_prod10n_gain(c) = 0._r8
	 clm3%g%l%c%cnf%prod10n_loss(c) = 0._r8
	 clm3%g%l%c%cnf%dwt_prod100n_gain(c) = 0._r8
	 clm3%g%l%c%cnf%prod100n_loss(c) = 0._r8
	 clm3%g%l%c%cnf%dwt_frootn_to_litr1n(c) = 0._r8
	 clm3%g%l%c%cnf%dwt_frootn_to_litr2n(c) = 0._r8
	 clm3%g%l%c%cnf%dwt_frootn_to_litr3n(c) = 0._r8
	 clm3%g%l%c%cnf%dwt_livecrootn_to_cwdn(c) = 0._r8
	 clm3%g%l%c%cnf%dwt_deadcrootn_to_cwdn(c) = 0._r8
	 clm3%g%l%c%cnf%dwt_nloss(c) = 0._r8
      end if
   end do

   ! initialize pft-level variables
!dir$ concurrent
!cdir nodep
   do p = begp, endp
      l = plandunit(p)
#ifndef CROP
      if (itypelun(l) == istsoil) then
#else
      if (itypelun(l) == istsoil .or. itypelun(l) == istcrop) then
#endif
         
         ! carbon state variables
         if (ivt(p) == noveg) then
            leafc(p) = 0._r8
            leafc_storage(p) = 0._r8
         else
            if (evergreen(ivt(p)) == 1._r8) then
               leafc(p) = 1._r8
               leafc_storage(p) = 0._r8
#if (defined CROP)
            else if (ivt(p) >= npcropmin) then ! prognostic crop types
               leafc(p) = 0._r8
               leafc_storage(p) = 0._r8
#endif
            else
               leafc(p) = 0._r8
               leafc_storage(p) = 1._r8
            end if
         end if
         
         leafc_xfer(p) = 0._r8
#if (defined CROP)
         grainc(p) = 0._r8
         grainc_storage(p) = 0._r8
         grainc_xfer(p) = 0._r8
         htmx(p)      = 0._r8! max hgt attained by a crop during yr
         vf(p)        = 0._r8! vernalization factor for wheat
         croplive(p)  = 0._r8! added the rest here to avoid nans in non-crop
         cropplant(p) = 0._r8! pfts in output files (slevis)
         harvdate(p)  = 999  
         peaklai(p)   = 0    ! 1: max allowed lai; 0: not at max
#endif
         frootc(p) = 0._r8
         frootc_storage(p) = 0._r8
         frootc_xfer(p) = 0._r8
         livestemc(p) = 0._r8
         livestemc_storage(p) = 0._r8
         livestemc_xfer(p) = 0._r8

         ! tree types need to be initialized with some stem mass so that
         ! roughness length is not zero in canopy flux calculation

         if (woody(ivt(p)) == 1._r8) then
            deadstemc(p) = 0.1_r8
         else
            deadstemc(p) = 0._r8
         end if

         write(6,*) 'in CNiniTimeVar, deadstemc(',p,')=',deadstemc(p)

         deadstemc_storage(p) = 0._r8
         deadstemc_xfer(p) = 0._r8
         livecrootc(p) = 0._r8
         livecrootc_storage(p) = 0._r8
         livecrootc_xfer(p) = 0._r8
         deadcrootc(p) = 0._r8
         deadcrootc_storage(p) = 0._r8
         deadcrootc_xfer(p) = 0._r8
         gresp_storage(p) = 0._r8
         gresp_xfer(p) = 0._r8
         cpool(p) = 0._r8
         xsmrpool(p) = 0._r8
         pft_ctrunc(p) = 0._r8
         dispvegc(p) = 0._r8
         storvegc(p) = 0._r8
         totpftc(p)  = 0._r8
         ! calculate totvegc explicitly so that it is available for the isotope 
         ! code on the first time step.
         totvegc(p)  = leafc(p) + leafc_storage(p) + leafc_xfer(p) + frootc(p) +  &
            frootc_storage(p) + frootc_xfer(p) + livestemc(p) + livestemc_storage(p) +  &
            livestemc_xfer(p) + deadstemc(p) + deadstemc_storage(p) + deadstemc_xfer(p) +  &
            livecrootc(p) + livecrootc_storage(p) + livecrootc_xfer(p) + deadcrootc(p) +  &
            deadcrootc_storage(p) + deadcrootc_xfer(p) + gresp_storage(p) +  &
            gresp_xfer(p) + cpool(p)

#if (defined CLAMP)
         ! CLAMP variables
         woodc(p)    = 0._r8
#endif

#if (defined C13)
         ! 4/14/05: PET
         ! Adding isotope code
         leafc13(p)               = leafc(p)               * c13ratio
         leafc13_storage(p)       = leafc_storage(p)       * c13ratio
         leafc13_xfer(p)          = leafc_xfer(p)          * c13ratio
#if (defined CROP)
         grainc13(p)              = grainc(p)              * c13ratio
         grainc13_storage(p)      = grainc_storage(p)      * c13ratio
         grainc13_xfer(p)         = grainc_xfer(p)         * c13ratio
#endif
         frootc13(p)              = frootc(p)              * c13ratio
         frootc13_storage(p)      = frootc_storage(p)      * c13ratio
         frootc13_xfer(p)         = frootc_xfer(p)         * c13ratio
         livestemc13(p)           = livestemc(p)           * c13ratio
         livestemc13_storage(p)   = livestemc_storage(p)   * c13ratio
         livestemc13_xfer(p)      = livestemc_xfer(p)      * c13ratio
         deadstemc13(p)           = deadstemc(p)           * c13ratio
         deadstemc13_storage(p)   = deadstemc_storage(p)   * c13ratio
         deadstemc13_xfer(p)      = deadstemc_xfer(p)      * c13ratio
         livecrootc13(p)          = livecrootc(p)          * c13ratio
         livecrootc13_storage(p)  = livecrootc_storage(p)  * c13ratio
         livecrootc13_xfer(p)     = livecrootc_xfer(p)     * c13ratio
         deadcrootc13(p)          = deadcrootc(p)          * c13ratio
         deadcrootc13_storage(p)  = deadcrootc_storage(p)  * c13ratio
         deadcrootc13_xfer(p)     = deadcrootc_xfer(p)     * c13ratio
         c13_gresp_storage(p)     = gresp_storage(p)       * c13ratio
         c13_gresp_xfer(p)        = gresp_xfer(p)          * c13ratio
         c13pool(p)               = cpool(p)               * c13ratio
         c13xsmrpool(p)           = xsmrpool(p)            * c13ratio
         c13_pft_ctrunc(p)        = pft_ctrunc(p)          * c13ratio

         ! calculate totvegc explicitly so that it is available for the isotope 
         ! code on the first time step.
         totvegc13(p)  = leafc13(p) + leafc13_storage(p) + leafc13_xfer(p) + frootc13(p) +  &
            frootc13_storage(p) + frootc13_xfer(p) + livestemc13(p) + livestemc13_storage(p) +  &
            livestemc13_xfer(p) + deadstemc13(p) + deadstemc13_storage(p) + deadstemc13_xfer(p) +  &
            livecrootc13(p) + livecrootc13_storage(p) + livecrootc13_xfer(p) + deadcrootc13(p) +  &
            deadcrootc13_storage(p) + deadcrootc13_xfer(p) + c13_gresp_storage(p) +  &
            c13_gresp_xfer(p) + c13pool(p)
#endif
                                
         ! nitrogen state variables
         if (ivt(p) == noveg) then
            leafn(p) = 0._r8
            leafn_storage(p) = 0._r8
         else
            leafn(p) = leafc(p) / leafcn(ivt(p))
            leafn_storage(p) = leafc_storage(p) / leafcn(ivt(p))
         end if

         leafn_xfer(p) = 0._r8
#if (defined CROP)
         grainn(p) = 0._r8
         grainn_storage(p) = 0._r8
         grainn_xfer(p) = 0._r8
#endif
         frootn(p) = 0._r8
         frootn_storage(p) = 0._r8
         frootn_xfer(p) = 0._r8
         livestemn(p) = 0._r8
         livestemn_storage(p) = 0._r8
         livestemn_xfer(p) = 0._r8

         ! tree types need to be initialized with some stem mass so that
         ! roughness length is not zero in canopy flux calculation

         if (woody(ivt(p)) == 1._r8) then
            deadstemn(p) = deadstemc(p) / deadwdcn(ivt(p))
            write(6,*) 'in CNiniTimeVar,deadwdcn(',ivt(p),')=', deadwdcn(ivt(p))
         else
            deadstemn(p) = 0._r8
         end if

         write(6,*) 'in CNiniTimeVar, deadstemn(',p,')=',deadstemn(p)

         deadstemn_storage(p) = 0._r8
         deadstemn_xfer(p) = 0._r8
         livecrootn(p) = 0._r8
         livecrootn_storage(p) = 0._r8
         livecrootn_xfer(p) = 0._r8
         deadcrootn(p) = 0._r8
         deadcrootn_storage(p) = 0._r8
         deadcrootn_xfer(p) = 0._r8
         retransn(p) = 0._r8
         npool(p) = 0._r8
         pft_ntrunc(p) = 0._r8
         dispvegn(p) = 0._r8
         storvegn(p) = 0._r8
         totvegn(p)  = 0._r8
         totpftn(p)  = 0._r8

         ! initialization for psnsun and psnsha required for
         ! proper arbitrary initialization of allocation routine
         ! in initial ecosysdyn call

         psnsun(p) = 0._r8
         psnsha(p) = 0._r8
#if (defined C13)
         c13_psnsun(p) = 0._r8
         c13_psnsha(p) = 0._r8
#endif
         laisun(p) = 0._r8
         laisha(p) = 0._r8
         lncsun(p) = 0._r8
         lncsha(p) = 0._r8
         vcmxsun(p) = 0._r8
         vcmxsha(p) = 0._r8

         ! ecophysiological variables
         ! phenology variables
         dormant_flag(p) = 1._r8
         days_active(p) = 0._r8
         onset_flag(p) = 0._r8
         onset_counter(p) = 0._r8
         onset_gddflag(p) = 0._r8
         onset_fdd(p) = 0._r8
         onset_gdd(p) = 0._r8
         onset_swi(p) = 0.0_r8
         offset_flag(p) = 0._r8
         offset_counter(p) = 0._r8
         offset_fdd(p) = 0._r8
         offset_swi(p) = 0._r8
         lgsf(p) = 0._r8
         bglfr(p) = 0._r8
         bgtr(p) = 0._r8
         annavg_t2m(p) = 280._r8
         tempavg_t2m(p) = 0._r8

         ! non-phenology variables
         gpp(p) = 0._r8
         availc(p) = 0._r8
         xsmrpool_recover(p) = 0._r8
#if (defined C13)
         xsmrpool_c13ratio(p) = c13ratio
#endif
         alloc_pnow(p) = 1._r8
         c_allometry(p) = 0._r8
         n_allometry(p) = 0._r8
         plant_ndemand(p) = 0._r8
         tempsum_potential_gpp(p) = 0._r8
         annsum_potential_gpp(p) = 0._r8
         tempmax_retransn(p) = 0._r8
         annmax_retransn(p) = 0._r8
         avail_retransn(p) = 0._r8
         plant_nalloc(p) = 0._r8
         plant_calloc(p) = 0._r8
         excess_cflux(p) = 0._r8
         downreg(p) = 0._r8
         prev_leafc_to_litter(p) = 0._r8
         prev_frootc_to_litter(p) = 0._r8
         tempsum_npp(p) = 0._r8
         annsum_npp(p) = 0._r8
#if (defined CNDV)
         tempsum_litfall(p) = 0._r8
         annsum_litfall(p) = 0._r8
#endif
#if (defined C13)
         rc13_canair(p) = 0._r8
         rc13_psnsun(p) = 0._r8
         rc13_psnsha(p) = 0._r8
         alphapsnsun(p) = 0._r8
         alphapsnsha(p) = 0._r8
#endif
		 
		 

      end if   ! end of if-istsoil block
   end do   ! end of loop over pfts  

   END IF


!for other time step, assinge current value to the previous step value 
   IF(nstep .ne. 1) THEN
   do c = begc, endc
      l = clandunit(c) 
#ifndef CROP
      if (itypelun(l) == istsoil) then
#else
      if (itypelun(l) == istsoil .or. itypelun(l) == istcrop) then
#endif

                    annsum_counter(c)              = annsum_counter_buf(c)
                    cannsum_npp(c)                 = cannsum_npp_buf(c)
                    cannavg_t2m(c)                 = cannavg_t2m_buf(c)
                    wf(c)                          = wf_buf(c)
                    me(c)                          = me_buf(c)
                    mean_fire_prob(c)              = mean_fire_prob_buf(c)
                    cwdc(c)                        = cwdc_buf(c)
                    litr1c(c)                      = litr1c_buf(c)
                    litr2c(c)                      = litr2c_buf(c)
                    litr3c(c)                      = litr3c_buf(c)
                    soil1c(c)                      = soil1c_buf(c)
                    soil2c(c)                      = soil2c_buf(c)
                    soil3c(c)                      = soil3c_buf(c)
                    soil4c(c)                      = soil4c_buf(c)
                    col_ctrunc(c)                  = col_ctrunc_buf(c)
                    cwdn(c)                        = cwdn_buf(c)
                    litr1n(c)                      = litr1n_buf(c)
                    litr2n(c)                      = litr2n_buf(c)
                    litr3n(c)                      = litr3n_buf(c)
                    soil1n(c)                      = soil1n_buf(c)
                    soil2n(c)                      = soil2n_buf(c)
                    soil3n(c)                      = soil3n_buf(c)
                    soil4n(c)                      = soil4n_buf(c)
                    sminn(c)                       = sminn_buf(c)
                    col_ntrunc(c)                  = col_ntrunc_buf(c)
                    seedc(c)                       = seedc_buf(c)
                    prod10c(c)                     = prod10c_buf(c)
                    prod100c(c)                    = prod100c_buf(c)
                    seedn(c)                       = seedn_buf(c)
                    prod10n(c)                     = prod10n_buf(c)
                    prod100n(c)                    = prod100n_buf(c)

                    totlitc(c)                     = totlitc_buf(c)
         clm3%g%l%c%ccf%dwt_seedc_to_leaf(c) = dwt_seedc_to_leaf_buf(c)
         clm3%g%l%c%ccf%dwt_seedc_to_deadstem(c) = dwt_seedc_to_deadstem_buf(c)
         clm3%g%l%c%ccf%dwt_conv_cflux(c) = dwt_conv_cflux_buf(c)
         clm3%g%l%c%ccf%dwt_prod10c_gain(c) = dwt_prod10c_gain_buf(c)
         clm3%g%l%c%ccf%prod10c_loss(c) = 0._r8
         clm3%g%l%c%ccf%dwt_prod100c_gain(c) = dwt_prod100c_gain_buf(c)
         clm3%g%l%c%ccf%prod100c_loss(c) = prod100c_loss_buf(c)
         clm3%g%l%c%ccf%dwt_frootc_to_litr1c(c) = dwt_frootc_to_litr1c_buf(c)
         clm3%g%l%c%ccf%dwt_frootc_to_litr2c(c) = dwt_frootc_to_litr2c_buf(c)
         clm3%g%l%c%ccf%dwt_frootc_to_litr3c(c) = dwt_frootc_to_litr3c_buf(c)
         clm3%g%l%c%ccf%dwt_livecrootc_to_cwdc(c) = dwt_livecrootc_to_cwdc_buf(c)
         clm3%g%l%c%ccf%dwt_deadcrootc_to_cwdc(c) = dwt_deadcrootc_to_cwdc_buf(c)
         clm3%g%l%c%ccf%dwt_closs(c) = 0._r8
         clm3%g%l%c%cnf%dwt_seedn_to_leaf(c) = dwt_seedn_to_leaf_buf(c)
         clm3%g%l%c%cnf%dwt_seedn_to_deadstem(c) = dwt_seedn_to_deadstem_buf(c)
         clm3%g%l%c%cnf%dwt_conv_nflux(c) = dwt_conv_nflux_buf(c)
         clm3%g%l%c%cnf%dwt_prod10n_gain(c) = dwt_prod10n_gain_buf(c)
         clm3%g%l%c%cnf%prod10n_loss(c) = 0._r8
         clm3%g%l%c%cnf%dwt_prod100n_gain(c) = dwt_prod100n_gain_buf(c)
         clm3%g%l%c%cnf%prod100n_loss(c) = prod100n_loss_buf(c)
         clm3%g%l%c%cnf%dwt_frootn_to_litr1n(c) = dwt_frootn_to_litr1n_buf(c)
         clm3%g%l%c%cnf%dwt_frootn_to_litr2n(c) = dwt_frootn_to_litr2n_buf(c)
         clm3%g%l%c%cnf%dwt_frootn_to_litr3n(c) = dwt_frootn_to_litr3n_buf(c)
         clm3%g%l%c%cnf%dwt_livecrootn_to_cwdn(c) = dwt_livecrootn_to_cwdn_buf(c)
         clm3%g%l%c%cnf%dwt_deadcrootn_to_cwdn(c) = dwt_deadcrootn_to_cwdn_buf(c)
         clm3%g%l%c%cnf%dwt_nloss(c) = 0._r8
  

         fire_prob(c) = 0._r8
         fireseasonl(c) = 0._r8
         farea_burned(c) = 0._r8
         ann_farea_burned(c) = 0._r8

         ! needed for CNNLeaching
         qflx_drain(c) = 0._r8
         totsomc(c)    = 0._r8
         totecosysc(c) = 0._r8
         totcolc(c)    = 0._r8

         totlitn(c)    = 0._r8
         totsomn(c)    = 0._r8
         totecosysn(c) = 0._r8
         totcoln(c)    = 0._r8
         totprodc(c)   = 0._r8
         totprodn(c)   = 0._r8



      end if
   end do
 
 

   do p = begp, endp   
      l = plandunit(p) 
#ifndef CROP
      if (itypelun(l) == istsoil) then
#else
      if (itypelun(l) == istsoil .or. itypelun(l) == istcrop) then
#endif

                    leafc(p)                       = annsum_npp_buf(p)
                    leafc_storage(p)               = leafc_storage_buf(p)
                    leafc_xfer(p)                  = leafc_xfer_buf(p)

#if (defined CROP)
                    htmx(p)                        = htmx_buf(p)
                    croplive(p)                    = croplive_buf(p)
                    gdd1020(p)                     = gdd1020_buf(p)
                    gdd820(p)                      = gdd820_buf(p)
                    gdd020(p)                      = gdd020_buf(p)
                    grainc(p)                      = grainc_buf(p)
                    grainc_storage(p)              = grainc_storage_buf(p)
                    grainc_xfer(p)                 = grainc_xfer_buf(p)
#endif

                    frootc(p)                      = frootc_buf(p)
                    frootc_storage(p)              = frootc_storage_buf(p)
                    frootc_xfer(p)                 = frootc_xfer_buf(p)
                    livestemc(p)                   = livestemc_buf(p)
                    livestemc_storage(p)           = livestemc_storage_buf(p)
                    livestemc_xfer(p)              = livestemc_xfer_buf(p)
                    deadstemc(p)                   = deadstemc_buf(p)
                    
              write(6,*) 'CNiniTimeVar, nstep>1,deadstemc(',p,')=',deadstemc(p)

                    deadstemc_storage(p)           = deadstemc_storage_buf(p)
                    deadstemc_xfer(p)              = deadstemc_xfer_buf(p)
                    livecrootc(p)                  = livecrootc_buf(p)
                    livecrootc_storage(p)          = livecrootc_storage_buf(p)
                    livecrootc_xfer(p)             = livecrootc_xfer_buf(p)
                    deadcrootc(p)                  = deadcrootc_buf(p)
                    deadcrootc_storage(p)          = deadcrootc_storage_buf(p)
                    deadcrootc_xfer(p)             = deadcrootc_xfer_buf(p)
                     gresp_storage(p)               = gresp_storage_buf(p)
                    gresp_xfer(p)                  = gresp_xfer_buf(p)
                     cpool(p)                       = cpool_buf(p)
                    xsmrpool(p)                    = xsmrpool_buf(p)
                    pft_ctrunc(p)                  = pft_ctrunc_buf(p)
                    leafn(p)                       = leafn_buf(p)
                    leafn_storage(p)               = leafn_storage_buf(p)
                    leafn_xfer(p)                  = leafn_xfer_buf(p)
                    frootn(p)                      = frootn_buf(p)
                    frootn_storage(p)              = frootn_storage_buf(p)
                    frootn_xfer(p)                 = frootn_xfer_buf(p)
                    livestemn(p)                   = livestemn_buf(p)
                    livestemn_storage(p)           = livestemn_storage_buf(p)
                    livestemn_xfer(p)              = livestemn_xfer_buf(p)
                    deadstemn(p)                   = deadstemn_buf(p)
                    deadstemn_storage(p)           = deadstemn_storage_buf(p)
                    deadstemn_xfer(p)              = deadstemn_xfer_buf(p)
                    livecrootn(p)                  = livecrootn_buf(p)
                    livecrootn_storage(p)          = livecrootn_storage_buf(p)
                    livecrootn_xfer(p)             = livecrootn_xfer_buf(p)
                    deadcrootn(p)                  = deadcrootn_buf(p)
                    deadcrootn_storage(p)          = deadcrootn_storage_buf(p)
                    deadcrootn_xfer(p)             = deadcrootn_xfer_buf(p)
                    npool(p)                       = npool_buf(p)
                    pft_ntrunc(p)                  = pft_ntrunc_buf(p)
#if (defined CROP)
                   grainn(p)                      = grainn_buf(p)
                    grainn_storage(p)              = grainn_storage_buf(p)
                    grainn_xfer(p)                 = grainn_xfer_buf(p)
#endif 
                    days_active(p)                 = days_active_buf(p)
                    onset_flag(p)                  = onset_flag_buf(p)
                    onset_counter(p)               = onset_counter_buf(p)
                    onset_gddflag(p)               = onset_gddflag_buf(p)
                    onset_fdd(p)                   = onset_fdd_buf(p)
                    onset_gdd(p)                   = onset_gdd_buf(p)
                    onset_swi(p)                   = onset_swi_buf(p)
                    offset_flag(p)                 = offset_flag_buf(p)
                    offset_counter(p)              = offset_counter_buf(p)
                    offset_fdd(p)                  = offset_fdd_buf(p)
                    offset_swi(p)                  = offset_swi_buf(p)
                    dayl(p)                        = dayl_buf(p)
                    annavg_t2m(p)                  = annavg_t2m_buf(p)
                    tempavg_t2m(p)                 = tempavg_t2m_buf(p)
                    tempsum_potential_gpp(p)       = tempsum_potential_gpp_buf(p)
                    annsum_potential_gpp(p)        = annsum_potential_gpp_buf(p)
                    tempmax_retransn(p)            = tempmax_retransn_buf(p)
                    annmax_retransn(p)             = annmax_retransn_buf(p)
                    prev_leafc_to_litter(p)        = prev_leafc_to_litter_buf(p)
                    prev_frootc_to_litter(p)       = prev_frootc_to_litter_buf(p)
                    tempsum_npp(p)                 = tempsum_npp_buf(p)
                    annsum_npp(p)                  = annsum_npp_buf(p)
                    retransn(p)                    = retransn_buf(p)


         dispvegc(p) = 0._r8
         storvegc(p) = 0._r8
         totpftc(p)  = 0._r8
         totvegc(p)  = leafc(p) + leafc_storage(p) + leafc_xfer(p) + frootc(p) +  &
            frootc_storage(p) + frootc_xfer(p) + livestemc(p) + livestemc_storage(p) +  &
            livestemc_xfer(p) + deadstemc(p) + deadstemc_storage(p) + deadstemc_xfer(p) +  &
            livecrootc(p) + livecrootc_storage(p) + livecrootc_xfer(p) + deadcrootc(p) +  &
            deadcrootc_storage(p) + deadcrootc_xfer(p) + gresp_storage(p) +  &
            gresp_xfer(p) + cpool(p)
         dispvegn(p) = 0._r8
         storvegn(p) = 0._r8
         totvegn(p)  = 0._r8
         totpftn(p)  = 0._r8

         ! initialization for psnsun and psnsha required for 
         ! proper arbitrary initialization of allocation routine
         ! in initial ecosysdyn call

         psnsun(p) = 0._r8
         psnsha(p) = 0._r8
         laisun(p) = 0._r8
         laisha(p) = 0._r8
         lncsun(p) = 0._r8
         lncsha(p) = 0._r8
         vcmxsun(p) = 0._r8
         vcmxsha(p) = 0._r8

         ! ecophysiological variables
         ! phenology variables 
         dormant_flag(p) = 1._r8
         lgsf(p) = 0._r8
         bglfr(p) = 0._r8 
         bgtr(p) = 0._r8
         gpp(p) = 0._r8
         availc(p) = 0._r8
         xsmrpool_recover(p) = 0._r8 
         alloc_pnow(p) = 1._r8
         c_allometry(p) = 0._r8
         n_allometry(p) = 0._r8 
         plant_ndemand(p) = 0._r8
         avail_retransn(p) = 0._r8
         plant_nalloc(p) = 0._r8
         plant_calloc(p) = 0._r8
         excess_cflux(p) = 0._r8
         downreg(p) = 0._r8



       end if   ! end of if-istsoil block
   end do   ! end of loop over pfts  








    END IF



#endif

end subroutine CNiniTimeVar
module CNEcosystemDynMod
#ifdef CN

!-----------------------------------------------------------------------
!BOP
!
! !MODULE: CNEcosystemDynMod
!
! !DESCRIPTION:
! Ecosystem dynamics: phenology, vegetation
!
! !USES:
  use shr_kind_mod, only: r8 => shr_kind_r8
  use clm_varcon  , only: fpftdyn   !Yaqiong Lu removed
!
! !PUBLIC TYPES:
  implicit none
  save
!
! !PUBLIC MEMBER FUNCTIONS:
  public :: CNEcosystemDyn   ! Ecosystem dynamics: phenology, vegetation
!
! !REVISION HISTORY:
! Created by Peter Thornton
! 19 May 2009: PET - modified to include call to harvest routine
!
!
! !PRIVATE MEMBER FUNCTIONS:
!
! !PRIVATE TYPES:
!EOP
!-----------------------------------------------------------------------

contains

!-----------------------------------------------------------------------
!BOP
!
! !IROUTINE: CNEcosystemDyn
!
! !INTERFACE:
#if (defined CROP)
  subroutine CNEcosystemDyn(lbc, ubc, lbp, ubp, num_soilc, filter_soilc, &
                     num_soilp, filter_soilp, num_pcropp, filter_pcropp, doalb)
#else
  subroutine CNEcosystemDyn(lbc, ubc, lbp, ubp, num_soilc, filter_soilc, &
                     num_soilp, filter_soilp, doalb)
#endif
!
! !DESCRIPTION:
! The core CN code is executed here. Calculates fluxes for maintenance
! respiration, decomposition, allocation, phenology, and growth respiration.
! These routines happen on the radiation time step so that canopy structure
! stays synchronized with albedo calculations.
!
! !USES:
    use clmtype
!ylu remove    use spmdMod              , only: masterproc
    use CNSetValueMod        , only: CNZeroFluxes
    use CNNDynamicsMod       , only: CNNDeposition,CNNFixation, CNNLeaching
    use CNMRespMod           , only: CNMResp
    use CNDecompMod          , only: CNDecompAlloc
    use CNPhenologyMod       , only: CNPhenology
    use CNGRespMod           , only: CNGResp
    use CNCStateUpdate1Mod   , only: CStateUpdate1,CStateUpdate0
    use CNNStateUpdate1Mod   , only: NStateUpdate1
    use CNGapMortalityMod    , only: CNGapMortality
    use CNCStateUpdate2Mod   , only: CStateUpdate2, CStateUpdate2h
    use CNNStateUpdate2Mod   , only: NStateUpdate2, NStateUpdate2h
    use CNFireMod            , only: CNFireArea, CNFireFluxes
    use CNCStateUpdate3Mod   , only: CStateUpdate3
    use CNNStateUpdate3Mod   , only: NStateUpdate3
    use CNBalanceCheckMod    , only: CBalanceCheck, NBalanceCheck
    use CNPrecisionControlMod, only: CNPrecisionControl
    use CNVegStructUpdateMod , only: CNVegStructUpdate
    use CNAnnualUpdateMod    , only: CNAnnualUpdate
    use CNSummaryMod         , only: CSummary, NSummary
#if (defined C13)
    use CNC13StateUpdate1Mod , only: C13StateUpdate1,C13StateUpdate0
    use CNC13StateUpdate2Mod , only: C13StateUpdate2, C13StateUpdate2h
    use CNC13StateUpdate3Mod , only: C13StateUpdate3
    use CNC13FluxMod         , only: C13Flux1, C13Flux2, C13Flux2h, C13Flux3
    use C13SummaryMod        , only: C13Summary
#endif
    use pftdynMod               , only: CNHarvest
    use CNWoodProductsMod    , only: CNWoodProducts
!
! !ARGUMENTS:
    implicit none
    integer, intent(in) :: lbc, ubc        ! column bounds
    integer, intent(in) :: lbp, ubp        ! pft bounds
    integer, intent(in) :: num_soilc       ! number of soil columns in filter
    integer, intent(in) :: filter_soilc(ubc-lbc+1) ! filter for soil columns
    integer, intent(in) :: num_soilp       ! number of soil pfts in filter
    integer, intent(in) :: filter_soilp(ubp-lbp+1) ! filter for soil pfts
#if (defined CROP)
    integer, intent(in) :: num_pcropp      ! number of prog. crop pfts in filter
    integer, intent(in) :: filter_pcropp(:)! filter for prognostic crop pfts
#endif
    logical, intent(in) :: doalb           ! true = surface albedo calculation time step
!
! !CALLED FROM:
!
! !REVISION HISTORY:
! 10/22/03, Peter Thornton: created from EcosystemDyn during migration to
!                           new vector code.
! 11/3/03, Peter Thornton: removed update of elai, esai, frac_veg_nosno_alb.
!     These are now done in CNVegStructUpdate(), which is called
!     prior to SurfaceAlbedo().
! 11/13/03, Peter Thornton: switched from nolake to soil filtering.
!
! !LOCAL VARIABLES:
!
! local pointers to implicit in arguments
!
! local pointers to implicit out arguments
!
! !OTHER LOCAL VARIABLES:
!
!EOP
!-----------------------------------------------------------------------

 !   if (doalb) then

       ! Call the main CN routines
!       call CLMDebug('Begin CNZeroFluxes')
!       call CNZeroFluxes(num_soilc, filter_soilc, num_soilp, filter_soilp)  ! CNSetValueMod.F

       call CLMDebug('Begin CNNDeposition')
       call CNNDeposition(lbc, ubc)  !CNNDynamicsMod.F

       call CLMDebug('Begin CNFixation')
       call CNNFixation(num_soilc,filter_soilc)  !CNNDynamicsMod.F

       call CLMDebug('Begin CNMResp')
       call CNMResp(lbc, ubc, num_soilc, filter_soilc, num_soilp, filter_soilp)  !CNMRespMod.F

       call CLMDebug('Begin CNNDecompAlloc')
       call CNDecompAlloc(lbp, ubp, lbc, ubc, num_soilc, filter_soilc, num_soilp, filter_soilp) !CNDecompMod.F

       ! CNphenology needs to be called after CNdecompAlloc, becuase it
       ! depends on current time-step fluxes to new growth on the last
       ! litterfall timestep in deciduous systems

#if (defined CROP)
       call CLMDebug('Begin CNPhenology')
       call CNPhenology(num_soilc, filter_soilc, num_soilp, filter_soilp, num_pcropp, filter_pcropp) !CNPhenologyMod.F
#else
       call CNPhenology(num_soilc, filter_soilc, num_soilp, filter_soilp)
#endif

       call CLMDebug('Begin CNGResp')
       call CNGResp(num_soilp, filter_soilp) !CNGRespMod.F
       
       call CLMDebug('Begin CStateUpdate')
       call CStateUpdate0(num_soilp, filter_soilp) !CNCStateUpdate1Mod.F

#if (defined C13)
       call C13StateUpdate0(num_soilp, filter_soilp)

       call C13Flux1(num_soilc, filter_soilc, num_soilp, filter_soilp)
#endif
       call CLMDebug('Begin CStateUpdate1')
       call CStateUpdate1(num_soilc, filter_soilc, num_soilp, filter_soilp)  !CNCStateUpdate1Mod.F

#if (defined C13)
       call C13StateUpdate1(num_soilc, filter_soilc, num_soilp, filter_soilp)
#endif
       
       call CLMDebug('Begin NStateUpdate1')
       call NStateUpdate1(num_soilc, filter_soilc, num_soilp, filter_soilp)  ! CNNStateUpdate1Mod.F

       call CLMDebug('Begin CNGapMortality')
       call CNGapMortality(num_soilc, filter_soilc, num_soilp, filter_soilp) ! CNGapMortalityMod.F

#if (defined C13)
       call C13Flux2(num_soilc, filter_soilc, num_soilp, filter_soilp) 
#endif

       call CLMDebug('Begin CStateUpdate2')
       call CStateUpdate2(num_soilc, filter_soilc, num_soilp, filter_soilp) ! CNCStateUpdate2Mod.F 

#if (defined C13)
       call C13StateUpdate2(num_soilc, filter_soilc, num_soilp, filter_soilp)
#endif

       call CLMDebug('Begin NStateUpdate2')
       call NStateUpdate2(num_soilc, filter_soilc, num_soilp, filter_soilp) !CNNStateUpdate2Mod
       
       if (fpftdyn /= ' ') then  !Yaqiong Lu removed 
!fpftdyn /= ' ' means there is dynamic land use data sets used
       call CLMDebug('Begin CNHarvest')
          call CNHarvest(num_soilc, filter_soilc, num_soilp, filter_soilp)  !pftdynMod.F
       end if 

#if (defined C13)
       call C13Flux2h(num_soilc, filter_soilc, num_soilp, filter_soilp)
#endif

       call CLMDebug('Begin CStateUpdate2h')
       call CStateUpdate2h(num_soilc, filter_soilc, num_soilp, filter_soilp)  !CNCStateUpdate2Mod.F

#if (defined C13)
       call C13StateUpdate2h(num_soilc, filter_soilc, num_soilp, filter_soilp)
#endif

       call CLMDebug('Begin NStateUpdate2h')
       call NStateUpdate2h(num_soilc, filter_soilc, num_soilp, filter_soilp)  ! CNNStateUpdate2Mod.F
       
       call CLMDebug('Begin CNWoodProducts')
       call CNWoodProducts(num_soilc, filter_soilc) ! CNWoodProductsMod.F 
       
       call CLMDebug('Begin CNFireArea')
       call CNFireArea(num_soilc, filter_soilc) !CNFireMod.F

       call CLMDebug('Begin CNFireFluxes')
       call CNFireFluxes(num_soilc, filter_soilc, num_soilp, filter_soilp)   !CNFireMod.F

       call CLMDebug('Begin CNNLeaching')
       call CNNLeaching(lbc, ubc, num_soilc, filter_soilc)  !CNNDynamicsMod.F

#if (defined C13)
       call C13Flux3(num_soilc, filter_soilc, num_soilp, filter_soilp)
#endif

       call CLMDebug('Begin CStateUpdate3')
       call CStateUpdate3(num_soilc, filter_soilc, num_soilp, filter_soilp) ! CNCStateUpdate3Mod.F

#if (defined C13)
       call C13StateUpdate3(num_soilc, filter_soilc, num_soilp, filter_soilp)
#endif

       call CLMDebug('Begin NStateUpdate3')
       call NStateUpdate3(num_soilc, filter_soilc, num_soilp, filter_soilp) !CNNStateUpdate3Mod.F

       call CLMDebug('Begin CNPrecisionControl')
       call CNPrecisionControl(num_soilc, filter_soilc, num_soilp, filter_soilp)  !CNPrecisionControlMod.F

    if (doalb) then   
       call CLMDebug('Begin CNVegStructUpdate')
       call CNVegStructUpdate(num_soilp, filter_soilp)  ! CNVegStructUpdateMod.F
    end if

!       call CNAnnualUpdate(num_soilc, filter_soilc, num_soilp, filter_soilp)
       
       call CLMDebug('Begin CSummary')
       call CSummary(num_soilc, filter_soilc, num_soilp, filter_soilp)  !CNSummaryMod.F
       
#if (defined C13)
       call C13Summary(num_soilc, filter_soilc, num_soilp, filter_soilp)  
#endif
       
       call CLMDebug('Begin NSummary')
       call NSummary(num_soilc, filter_soilc, num_soilp, filter_soilp)  !CNSummaryMod.F

!    end if  !end of if-doalb block

  end subroutine CNEcosystemDyn
#endif
!-----------------------------------------------------------------------
end  module CNEcosystemDynMod
!-----------------------------------------------------------------------
!BOP
!
! !ROUTINE: iniTimeVar  !This subroutine was used in CLM3.0, but not in CLM3.5&CLM4.0
!
! !INTERFACE:
subroutine iniTimeVar(snlx     ,snowdpx ,dzclmx  ,zclmx      ,&
                     ziclmx    ,h2osnox ,h2osoi_liqx,h2osoi_icex,t_grndx,&
                     t_soisnox ,t_lakex ,t_vegx    ,h2ocanx ,h2ocan_colx,&
                     h2osoi_volx,declin,t_ref2mx,xlat,xlon)
!
! !DESCRIPTION:
! Initializes the following time varying variables:
! water : h2osno, h2ocan, h2osoi_liq, h2osoi_ice, h2osoi_vol
! snow : snowdp, snowage, snl, dz, z, zi
! temperature: t_soisno, t_veg, t_grnd
! The variable, h2osoi_vol, is needed by the soil albedo routine - this is not needed
! on restart since it is computed before the soil albedo computation is called.
! The remaining variables are initialized by calls to ecosystem dynamics and
! albedo subroutines.
!
! !USES:
  use shr_kind_mod         , only : r8 => shr_kind_r8
  use clmtype
  use decompMod            , only : get_proc_bounds
  use filterMod            , only : filter
  use clm_varpar           , only : nlevsoi,nlevgrnd, nlevsno, nlevlak,maxpatch
  use clm_varcon           , only : denice, denh2o, zlnd,istsoil,isturb
  use FracWetMod           , only : FracWet
  use SurfaceAlbedoMod     , only : SurfaceAlbedo
  use globals              , only : month, day, calday
#if (defined CN)
  use CNEcosystemDynMod    , only : CNEcosystemDyn
#endif

#if (!defined CN)
  use STATICEcosysDynMod, only : EcosystemDyn, interpMonthlyVeg
#endif
  use shr_const_mod, only : SHR_CONST_PI

!
! !ARGUMENTS:
  implicit none
!
! !CALLED FROM:
! subroutine initialize in module initializeMod
!
! !REVISION HISTORY:
! Created by Mariana Vertenstein

! The following vraiables for MM5 and restart run

    real(r8)  :: xlon
    real(r8)  :: xlat

    integer   :: snlx(maxpatch)
    real(r8)  :: snowdpx(maxpatch)
!    real(r8)  :: snowagex(maxpatch)
    real(r8)  :: h2osnox(maxpatch)
    real(r8)  :: t_grndx(maxpatch)
    real(r8)  :: t_vegx(maxpatch)
    real(r8)  :: h2ocanx(maxpatch)
    real(r8)  :: h2ocan_colx(maxpatch)
    real(r8)  :: t_ref2mx(maxpatch)
    real(r8)  :: t_lakex(maxpatch,nlevlak)
    real(r8)  :: t_soisnox(maxpatch,-nlevsno+1:nlevgrnd)
    real(r8)  :: h2osoi_liqx(maxpatch,-nlevsno+1:nlevgrnd)
    real(r8)  :: h2osoi_icex(maxpatch,-nlevsno+1:nlevgrnd)
    real(r8)  :: dzclmx(maxpatch,-nlevsno+1:nlevgrnd)
    real(r8)  :: zclmx(maxpatch,-nlevsno+1:nlevgrnd)
    real(r8)  :: ziclmx(maxpatch,-nlevsno:nlevgrnd)
    real(r8)  :: h2osoi_volx(maxpatch,nlevgrnd)

!
! !LOCAL VARIABLES:
!
! local pointers to implicit in arguments
!
  integer , pointer :: plandunit(:)      ! landunit index associated with each pft
  logical , pointer :: lakpoi(:)         ! true => landunit is a lake point
  real(r8), pointer :: dz(:,:)           ! layer thickness depth (m)
  real(r8), pointer :: h2osoi_ice(:,:)   ! ice lens (kg/m2)
  real(r8), pointer :: h2osoi_liq(:,:)   ! liquid water (kg/m2)
  integer , pointer :: frac_veg_nosno_alb(:) ! fraction of vegetation not covered by snow (0 OR 1) [-]
!
! local pointers to implicit out arguments
!
  real(r8), pointer :: h2osoi_vol(:,:)   ! volumetric soil water (0<=h2osoi_vol<=watsat) [m3/m3]
  real(r8), pointer :: snowdp(:)         ! snow height (m)
  real(r8), pointer :: frac_sno(:)       ! fraction of ground covered by snow (0 to 1)
  integer , pointer :: frac_veg_nosno(:) ! fraction of vegetation not covered by snow (0 OR 1) [-]
  real(r8), pointer :: fwet(:)           ! fraction of canopy that is wet (0 to 1) (pft-level)
!
! local pointers to implicit out arguments (lake points only)
!
  real(r8), pointer :: fdry(:)     ! fraction of foliage that is green and dry [-] (new)
  real(r8), pointer :: tlai(:)     ! one-sided leaf area index, no burying by snow
  real(r8), pointer :: tsai(:)     ! one-sided stem area index, no burying by snow
  real(r8), pointer :: htop(:)     ! canopy top (m)
  real(r8), pointer :: hbot(:)     ! canopy bottom (m)
  real(r8), pointer :: elai(:)     ! one-sided leaf area index with burying by snow
  real(r8), pointer :: esai(:)     ! one-sided stem area index with burying by snow


  real(r8) :: declin      ! solar declination angle in radians for nstep

!
!EOP
!
    real(r8):: snowbd        ! temporary calculation of snow bulk density (kg/m3)
    real(r8):: fmelt         ! snowbd/100
   integer , pointer :: clandunit(:)      ! landunit index associated with each column
    integer , pointer :: itypelun(:)       ! landunit type


! !OTHER LOCAL VARIABLES:
  integer :: g,nc,j,l,c,p,fp,fc  ! indices
  integer :: begp, endp   ! per-clump beginning and ending pft indices
  integer :: begc, endc   ! per-clump beginning and ending column indices
  integer :: begl, endl   ! per-clump beginning and ending landunit indices
  integer :: begg, endg   ! per-clump gridcell ending gridcell indices

#if (defined DGVM)
  integer , pointer :: clandunit(:)     ! column's landunit
  integer , pointer :: pcolumn(:)        ! column index of corresponding pft
  integer , pointer :: ityplun(:)       ! landunit type
  
  real(r8), pointer :: z(:,:)            ! (m)
  real(r8), pointer :: tsoi25(:)         ! soil temperature to 0.25 m (Kelvin)
  real(r8), pointer :: t_soisno(:,:)     ! soil temperature (Kelvin)  (-nlevsno+1:nlevsoi)
  real(r8), pointer :: watsat(:,:)      ! volumetric soil water at saturation (porosity)
  real(r8), pointer :: sucsat(:,:)      ! minimum soil suction (mm)
  real(r8), pointer :: bsw(:,:)         ! Clapp and Hornberger "b"
  real(r8), pointer :: wf(:)            ! soil water as frac. of whc for top 0.5 m

  real(r8) ,allocatable :: tsoi(:) ! temporary
  real(r8) ,allocatable :: dep(:)  ! temporary
  real(r8) ,allocatable :: rwat(:) ! soil water wgted by depth to maximum depth of 0.5 m
  real(r8) ,allocatable :: swat(:) ! same as rwat but at saturation
  real(r8) ,allocatable :: rz(:)   ! thickness of soil layers contributing to rwat (m)
  
  real(r8) :: watdry                     ! temporary
  real(r8) :: tsw                        ! volumetric soil water to 0.5 m
  real(r8) :: stsw                       ! volumetric soil water to 0.5 m at saturation
#endif
!-----------------------------------------------------------------------

  ! Assign local pointers to derived subtypes components (landunit-level)

  lakpoi              => clm3%g%l%lakpoi
  itypelun            => clm3%g%l%itype


  ! Assign local pointers to derived subtypes components (column-level)

  dz                  => clm3%g%l%c%cps%dz
  h2osoi_ice          => clm3%g%l%c%cws%h2osoi_ice
  h2osoi_liq          => clm3%g%l%c%cws%h2osoi_liq
  h2osoi_vol          => clm3%g%l%c%cws%h2osoi_vol
  snowdp              => clm3%g%l%c%cps%snowdp
  frac_sno            => clm3%g%l%c%cps%frac_sno

    clandunit           => clm3%g%l%c%landunit


  ! Assign local pointers to derived subtypes components (pft-level)

  plandunit          => clm3%g%l%c%p%landunit
  frac_veg_nosno_alb => clm3%g%l%c%p%pps%frac_veg_nosno_alb
  frac_veg_nosno     => clm3%g%l%c%p%pps%frac_veg_nosno
  fwet               => clm3%g%l%c%p%pps%fwet

  ! Assign local pointers to derived subtypes components (pft-level)
  ! The folowing pointers will only be used for lake points in this routine
  htop               => clm3%g%l%c%p%pps%htop
  hbot               => clm3%g%l%c%p%pps%hbot
  tlai               => clm3%g%l%c%p%pps%tlai
  tsai               => clm3%g%l%c%p%pps%tsai
  elai               => clm3%g%l%c%p%pps%elai
  esai               => clm3%g%l%c%p%pps%esai
  fdry               => clm3%g%l%c%p%pps%fdry
!#endif

  ! ========================================================================
  ! Initialize water and temperature based on:
  ! readini = true : read initial data set -- requires netCDF codes
  ! readini = false: arbitrary initialization
  ! ========================================================================
!moved to initialize.F
!    call mkarbinit(snlx     ,snowdpx, snowagex ,dzclmx  ,zclmx      ,&
!                  ziclmx    ,h2osnox ,h2osoi_liqx,h2osoi_icex,t_grndx,&
!                  t_soisnox ,t_lakex ,t_vegx    ,h2ocanx ,h2ocan_colx,&
!                  h2osoi_volx,t_ref2mx)

  ! after this subroutine, t_soisno has values -- Jiming Jin
  ! ========================================================================
  ! Remaining variables are initialized by calls to ecosystem dynamics and
  ! albedo subroutines.
  ! Note: elai, esai, frac_veg_nosno_alb are computed in
  ! Ecosysdyn and needed by routines FracWet and SurfaceAlbedo
  ! frac_veg_nosno is needed by FracWet
  ! fwet is needed in routine TwoStream (called by SurfaceAlbedo)
  ! frac_sno is needed by SoilAlbedo (called by SurfaceAlbedo)
  ! ========================================================================
  call CLMDebug('iniTimeVar mark0')


#if (!defined CN)
  ! Read monthly vegetation data for interpolation to daily values
  call CLMDebug('call interpMonthlyVeg')
  call interpMonthlyVeg(month, day)
#endif


     call get_proc_bounds(begg, endg, begl, endl, begc, endc, begp, endp)

    do g = begg, endg
       clm3%g%lat_a(g)               = xlat*(SHR_CONST_PI/180._r8)  ! redians "atm" latitude (radians) for albedo
       clm3%g%lon_a(g)               = xlon*(SHR_CONST_PI/180._r8)
    end do



     ! Determine variables needed by SurfaceAlbedo for lake points

!dir$ concurrent
!cdir nodep
!For lake point, set all the following value=0     
   do p = begp,endp
        l = plandunit(p)
        if (lakpoi(l)) then
           fwet(p) = 0.
           fdry(p) = 0.
           elai(p) = 0.
           esai(p) = 0.
           htop(p) = 0.
           hbot(p) = 0.
           tlai(p) = 0.
           tsai(p) = 0.
           frac_veg_nosno_alb(p) = 0.
           frac_veg_nosno(p) = 0.
        end if
     end do
    call CLMDebug('iniTimeVar mark1')

#if (defined CN)

#if (defined CROP)
       call CNEcosystemDyn(begc, endc, begp, endp, filter%num_soilc, filter%soilc, &
            filter%num_soilp, filter%soilp, &
            filter%num_pcropp, filter%pcropp, doalb=.true.)
#else 
       call CNEcosystemDyn(begc, endc, begp, endp, filter%num_soilc, filter%soilc, &
            filter%num_soilp, filter%soilp, doalb=.true.)
#endif

#else 
     call EcosystemDyn(begp, endp, filter%num_nolakep, filter%nolakep, &
                       doalb=.true.)
#endif

!dir$ concurrent
!cdir nodep
     do p = begp, endp
        l = plandunit(p)
        if (.not. lakpoi(l)) then
           frac_veg_nosno(p) = frac_veg_nosno_alb(p)
           fwet(p) = 0.
        end if
     end do

     call CLMDebug('call FracWet')
     call FracWet(filter%num_nolakep, filter%nolakep)
  

     ! Compute Surface Albedo - all land points (including lake)
     ! Needs as input fracion of soil covered by snow (Z.-L. Yang U. Texas)

!dir$ concurrent
!cdir nodep
!     do c = begc, endc
!        snowdp(c)  = snowdpx(c)
!        frac_sno(c) = snowdp(c)/(10.*zlnd + snowdp(c))
!     end do

      ! Compute Surface Albedo - all land points (including lake) other than urban
       ! Needs as input fracion of soil covered by snow (Z.-L. Yang U. Texas)

       do c = begc, endc
           snowdp(c)  = snowdpx(c)
          l = clandunit(c)
          if (itypelun(l) == isturb) then
             ! From Bonan 1996 (LSM technical note)
             frac_sno(c) = min( snowdp(c)/0.05_r8, 1._r8)
          else
             frac_sno(c) = 0._r8
                 ! snow cover fraction as in Niu and Yang 2007
             if(snowdp(c) .gt. 0.0 .and. h2osnox(c) .gt. 0.0)  then
                snowbd   = min(800._r8,h2osnox(c)/snowdp(c)) !bulk density of snow (kg/m3)
                fmelt    = (snowbd/100.)**1.
                ! 100 is the assumed fresh snow density; 1 is a melting factor that could be
                ! reconsidered, optimal value of 1.5 in Niu et al., 2007
                frac_sno(c) = tanh( snowdp(c) /(2.5 * zlnd * fmelt) )
             endif
          end if
       end do

     call SurfaceAlbedo(begg, endg, begc, endc, begp, endp,filter%num_nourbanc, filter%nourbanc, &
                           filter%num_nourbanp, filter%nourbanp, calday,declin)



end subroutine iniTimeVar

module initializeMod

!-----------------------------------------------------------------------
!BOP
!
! !MODULE: initializeMod
!
! !DESCRIPTION:
! Performs land model initialization
!
! !PUBLIC TYPES:
  implicit none
  save
!
! !PUBLIC MEMBER FUNCTIONS:
  public :: initialize
!
! !REVISION HISTORY:
! Created by Gordon Bonan, Sam Levis and Mariana Vertenstein
! In CLM4.0, DGVM option changed to CNDV--ylu 01/21/2011
!
!EOP
!
! !PRIVATE MEMBER FUNCTIONS:
!-----------------------------------------------------------------------

contains

!-----------------------------------------------------------------------
!BOP
!
! !IROUTINE: initialize
!
! !INTERFACE:
  subroutine initialize(snl    ,snowdp  ,dzclm     ,zclm        &
                  ,ziclm       ,h2osno  ,h2osoi_liq,h2osoi_ice,t_grnd      &
                  ,t_soisno    ,t_lake  ,t_veg     ,h2ocan    ,h2ocan_col  &
                  ,h2osoi_vol  ,xlat    ,xlon      ,areaxy    ,iveg        &
                  ,isl         ,lndmsk     &
                  ,t_ref2m ,ilx    ,jlx,calday,declin,declinp1 &
                  ,  organicxy, efisopxy,gtixy ,snw_rdsx    &
#ifdef CN
                ,tlai        ,tsai    ,htop      ,hbot                &
                ,htmx_buf,croplive_buf,gdd1020_buf,gdd820_buf,gdd020_buf,grainc_buf,grainc_storage_buf  &
                ,grainc_xfer_buf,grainn_buf,grainn_storage_buf,grainn_xfer_buf,days_active_buf  &
                ,onset_flag_buf,onset_counter_buf,onset_gddflag_buf,onset_fdd_buf,onset_gdd_buf &
                ,onset_swi_buf,offset_flag_buf,offset_counter_buf,offset_fdd_buf,offset_swi_buf &
                ,dayl_buf,annavg_t2m_buf,tempavg_t2m_buf,tempsum_potential_gpp_buf          &
                ,annsum_potential_gpp_buf,tempmax_retransn_buf,annmax_retransn_buf      &
                ,prev_leafc_to_litter_buf,prev_frootc_to_litter_buf,tempsum_npp_buf     &
                ,annsum_npp_buf,leafc_buf,leafc_storage_buf,leafc_xfer_buf,frootc_buf           &
                ,frootc_storage_buf,frootc_xfer_buf,livestemc_buf,livestemc_storage_buf     &
                ,livestemc_xfer_buf,deadstemc_buf,deadstemc_storage_buf,deadstemc_xfer_buf  &
                ,livecrootc_buf,livecrootc_storage_buf,livecrootc_xfer_buf,deadcrootc_buf   &
                ,deadcrootc_storage_buf,deadcrootc_xfer_buf,cpool_buf,pft_ctrunc_buf        &
                ,leafn_buf,leafn_storage_buf,leafn_xfer_buf,frootn_buf,frootn_storage_buf       &
                ,frootn_xfer_buf,livestemn_buf,livestemn_storage_buf,livestemn_xfer_buf     &
                ,deadstemn_buf,deadstemn_storage_buf,deadstemn_xfer_buf,livecrootn_buf      &
                ,livecrootn_storage_buf,livecrootn_xfer_buf,deadcrootn_buf              &
                ,deadcrootn_storage_buf,deadcrootn_xfer_buf,npool_buf,pft_ntrunc_buf        &
                ,gresp_storage_buf,gresp_xfer_buf,xsmrpool_buf,annsum_counter_buf           &
                ,cannsum_npp_buf,cannavg_t2m_buf,wf_buf,me_buf,mean_fire_prob_buf,cwdc_buf,litr1c_buf   &
                ,litr2c_buf,litr3c_buf,soil1c_buf,soil2c_buf,soil3c_buf,soil4c_buf,seedc_buf,col_ctrunc_buf &
                ,prod10c_buf,prod100c_buf,cwdn_buf,litr1n_buf,litr2n_buf,litr3n_buf,soil1n_buf,soil2n_buf   &
                ,soil3n_buf,soil4n_buf,seedn_buf,col_ntrunc_buf,prod10n_buf,prod100n_buf,sminn_buf &
                ,totlitc_buf,dwt_seedc_to_leaf_buf,dwt_seedc_to_deadstem_buf,dwt_conv_cflux_buf &
                ,dwt_prod10c_gain_buf,dwt_prod100c_gain_buf,prod100c_loss_buf,dwt_frootc_to_litr1c_buf &
                ,dwt_frootc_to_litr2c_buf,dwt_frootc_to_litr3c_buf,dwt_livecrootc_to_cwdc_buf &
                ,dwt_deadcrootc_to_cwdc_buf,dwt_seedn_to_leaf_buf,dwt_seedn_to_deadstem_buf &
                ,dwt_conv_nflux_buf,dwt_prod10n_gain_buf,dwt_prod100n_gain_buf,prod100n_loss_buf &
                ,dwt_frootn_to_litr1n_buf,dwt_frootn_to_litr2n_buf, dwt_frootn_to_litr3n_buf &
                , dwt_livecrootn_to_cwdn_buf,dwt_deadcrootn_to_cwdn_buf,retransn_buf &
#endif                  
                                                         )
!
! !DESCRIPTION:
! Land model initialization.
! o Initializes run control variables via the [clmexp] namelist.
! o Reads surface data on model grid.
! o Defines the multiple plant types and fraction areas for each surface type.
! o Builds the appropriate subgrid <-> grid mapping indices and weights.
! o Set up parallel processing.
! o Initializes time constant variables.
! o Reads restart data for a restart or branch run.
! o Reads initial data and initializes the time variant variables for an initial run.
! o Initializes history file output.
! o Initializes river routing model.
! o Initializes accumulation variables.
!
! !USES:
    use shr_kind_mod    , only : r8 => shr_kind_r8
    use clmtypeInitMod  , only : initClmtype
    use initGridCellsMod, only : initGridCells
    use clm_varpar      , only : lsmlon, lsmlat, maxpatch,nlevgrnd,nlevsno,&
                                 nlevlak
    use clm_varsur      , only : varsur_alloc, longxy,latixy,&
                                 area
    use filterMod       , only : filter,allocFilters,setFilters
    use decompMod       , only : initDecomp
!    use accFldsMod      , only : initAccFlds, initAccClmtype
    use surfFileMod     , only : surfrd
    use pftvarcon       , only : pftconrd
#ifdef CN
    use CNSetValueMod       , only : CNZeroFluxes_dwt,CNZeroFluxes
#endif
    use decompMod        , only: get_proc_bounds
!CLM4 
!    use ndepFileMod     , only : ndepdyn_init, ndepdyn_interp
!Yaqiong Lu changed add new from CLM4--01/21/11
!#if (defined DGVM)
!    use DGVMEcosystemDynMod, only : DGVMEcosystemDynini
!#else
!    use STATICEcosysDynMod , only : EcosystemDynini
!#endif

!#if (defined DGVM)
!    use DGVMMod            , only : resetTimeConstDGVM
!#endif
!
#if (defined CNDV)
    use pftdynMod             , only : pftwt_init, pftwt_interp
    use CNDVEcosystemDyniniMod, only : CNDVEcosystemDynini
#elif (!defined CN)
    use STATICEcosysDynMod , only : EcosystemDynini
#endif
#if (defined DUST) 
    use DustMod         , only : Dustini
#endif
#if (defined CASA)
    use CASAMod         , only : initCASA
    use CASAPhenologyMod, only : initCASAPhenology 
#if (defined CLAMP)
    use CASAiniTimeVarMod,only : CASAiniTimeVar
#endif
#endif
#if (defined RTM) 
    use RtmMod          , only : Rtmini
#endif
! use globals           , only: nstep
 use clm_varcon      , only : var_par
 use aerdepMOD          , only : aerdepini

!!!




! !ARGUMENTS:
    implicit none
!
! !REVISION HISTORY:
! Created by Gordon Bonan, Sam Levis and Mariana Vertenstein
!
!EOP
!
    
! !LOCAL VARIABLES:
    integer  :: i,j,k                 !indices
    integer  :: yr                    !current year (0, ...)
    integer  :: mon                   !current month (1 -> 12)
    integer  :: day                   !current day (1 -> 31)
    integer  :: ncsec                 !current time of day [seconds]
    logical  :: readini               !true if read in initial data set
    integer  :: ier
!ylu add new 01/13/2009
    real(r8),intent(in) :: gtixy
    real(r8), intent(in) :: calday               ! calendar day for declin
    real(r8), intent(in) :: declin               ! declination angle (radians) for calday
    real(r8), intent(in), optional :: declinp1   ! declination angle (radians) for caldaym1

    real(r8) :: organicxy(maxpatch)
    real(r8) :: efisopxy(6)
!add ilx,jlx
    integer  :: ilx,jlx
    integer  :: begc,endc
    integer   :: snl(maxpatch)
    real(r8)  :: snowdp(maxpatch)
!    real(r8)  :: snowage(maxpatch)
    real(r8)  :: h2osno(maxpatch)
    real(r8)  :: t_grnd(maxpatch)
    real(r8)  :: t_veg(maxpatch)
    real(r8)  :: h2ocan(maxpatch)
    real(r8)  :: h2ocan_col(maxpatch)

#ifdef CN
    real(r8)  :: tlai(maxpatch)
    real(r8)  :: tsai(maxpatch)
    real(r8)  :: htop(maxpatch)
    real(r8)  :: hbot(maxpatch)
#endif


    real(r8)  :: t_lake(maxpatch,nlevlak)
    real(r8)  :: t_soisno(maxpatch,-nlevsno+1:nlevgrnd)
    real(r8)  :: h2osoi_liq(maxpatch,-nlevsno+1:nlevgrnd)
    real(r8)  :: h2osoi_ice(maxpatch,-nlevsno+1:nlevgrnd)
    real(r8)  :: dzclm(maxpatch,-nlevsno+1:nlevgrnd)
    real(r8)  :: zclm(maxpatch,-nlevsno+1:nlevgrnd)
    real(r8)  :: ziclm(maxpatch,-nlevsno:nlevgrnd)
    real(r8)  :: h2osoi_vol(maxpatch,nlevgrnd)
    real(r8)  :: snw_rdsx(maxpatch,-nlevsno+1:0)

    real(r8)  :: xlon
    real(r8)  :: xlat
    real(r8)  :: areaxy

    integer   :: iveg
    integer   :: isl
    integer   :: lndmsk



    real(r8) :: t_ref2m(maxpatch)

#ifdef CN
!CN CROP vars
!CROP&CN buf variables
  integer,dimension(maxpatch) :: croplive_buf
   real(r8), dimension(maxpatch)  ::  &
                 htmx_buf,gdd1020_buf,gdd820_buf,gdd020_buf,grainc_buf,grainc_storage_buf  &
                ,grainc_xfer_buf,grainn_buf,grainn_storage_buf,grainn_xfer_buf,days_active_buf  &
                ,onset_flag_buf,onset_counter_buf,onset_gddflag_buf,onset_fdd_buf,onset_gdd_buf &
                ,onset_swi_buf,offset_flag_buf,offset_counter_buf,offset_fdd_buf,offset_swi_buf &
                ,dayl_buf,annavg_t2m_buf,tempavg_t2m_buf,tempsum_potential_gpp_buf          &
                ,annsum_potential_gpp_buf,tempmax_retransn_buf,annmax_retransn_buf      &
                ,prev_leafc_to_litter_buf,prev_frootc_to_litter_buf,tempsum_npp_buf     &
                ,annsum_npp_buf,leafc_buf,leafc_storage_buf,leafc_xfer_buf,frootc_buf           &
                ,frootc_storage_buf,frootc_xfer_buf,livestemc_buf,livestemc_storage_buf     &
                ,livestemc_xfer_buf,deadstemc_buf,deadstemc_storage_buf,deadstemc_xfer_buf  &
                ,livecrootc_buf,livecrootc_storage_buf,livecrootc_xfer_buf,deadcrootc_buf   &
                ,deadcrootc_storage_buf,deadcrootc_xfer_buf,cpool_buf,pft_ctrunc_buf        &
                ,leafn_buf,leafn_storage_buf,leafn_xfer_buf,frootn_buf,frootn_storage_buf       &
                ,frootn_xfer_buf,livestemn_buf,livestemn_storage_buf,livestemn_xfer_buf     &
                ,deadstemn_buf,deadstemn_storage_buf,deadstemn_xfer_buf,livecrootn_buf      &
                ,livecrootn_storage_buf,livecrootn_xfer_buf,deadcrootn_buf              &
                ,deadcrootn_storage_buf,deadcrootn_xfer_buf,npool_buf,pft_ntrunc_buf        &
                ,gresp_storage_buf,gresp_xfer_buf,xsmrpool_buf,annsum_counter_buf           &
                ,cannsum_npp_buf,cannavg_t2m_buf,wf_buf,me_buf,mean_fire_prob_buf,cwdc_buf,litr1c_buf   &
                ,litr2c_buf,litr3c_buf,soil1c_buf,soil2c_buf,soil3c_buf,soil4c_buf,seedc_buf,col_ctrunc_buf &
                ,prod10c_buf,prod100c_buf,cwdn_buf,litr1n_buf,litr2n_buf,litr3n_buf,soil1n_buf,soil2n_buf   &
                ,soil3n_buf,soil4n_buf,seedn_buf,col_ntrunc_buf,prod10n_buf,prod100n_buf,sminn_buf &
                ,totlitc_buf,dwt_seedc_to_leaf_buf,dwt_seedc_to_deadstem_buf,dwt_conv_cflux_buf &
                ,dwt_prod10c_gain_buf,dwt_prod100c_gain_buf,prod100c_loss_buf,dwt_frootc_to_litr1c_buf &
                ,dwt_frootc_to_litr2c_buf,dwt_frootc_to_litr3c_buf,dwt_livecrootc_to_cwdc_buf &
                ,dwt_deadcrootc_to_cwdc_buf,dwt_seedn_to_leaf_buf,dwt_seedn_to_deadstem_buf &
                ,dwt_conv_nflux_buf,dwt_prod10n_gain_buf,dwt_prod100n_gain_buf,prod100n_loss_buf &
                ,dwt_frootn_to_litr1n_buf,dwt_frootn_to_litr2n_buf, dwt_frootn_to_litr3n_buf &
                , dwt_livecrootn_to_cwdn_buf,dwt_deadcrootn_to_cwdn_buf,retransn_buf
#endif



    call CLMDebug('Now in Initialize. Next call varsur_alloc.')

        call get_proc_bounds(begc,endc)

!-----------------------------------------------------------------------
           longxy(1) = xlon
           latixy(1) = xlat
           area(1)   = areaxy
!-----------------------------------------------------------------------

    ! Allocate surface grid dynamic memory

     call varsur_alloc ()   !subroution in CLM3.0, but not in CLM3.5&CLM4.0--Yaqiong Lu

     ! Read list of PFTs and their corresponding parameter values
     ! This is independent of the model resolution

     call CLMDebug('call pftconrd')
     call pftconrd ()    

     ! If no surface dataset name is specified then make surface dataset
     ! from original data sources. Always read surface boundary data in.
     ! This insures that bit for bit results are obtained for a run where a
     ! surface dataset file is generated and a run where a surface dataset
     ! is specified and read in. Set up vegetation type [veg] and weight [wt]
     ! arrays for [maxpatch] subgrid patches.
 
     call var_par()


     call CLMDebug('call surfrd')
     call surfrd (organicxy,efisopxy,gtixy,ilx,jlx, iveg, isl, lndmsk)
    ! Initialize clump and processor decomposition
    call CLMDebug('call initDecomp')
    call initDecomp()
! Is this is actually necessary?  Probably only for multiple gridcells. Or maybenot...

    ! Allocate memory and initialize values of clmtype data structures
    call CLMDebug('initClmtype')
    call initClmtype()

    ! Build hierarchy and topological info for derived typees

    call CLMDebug('call initGridCells')
    call initGridCells()

    call CLMDebug('call allocFilters')
    ! Initialize filters
    call allocFilters()
    call CLMDebug('call setFilters')
    call setFilters()

#if (defined CN)
   call CNZeroFluxes_dwt()               !CNSetValueMod.F
   call CNZeroFluxes(filter%num_soilc, filter%soilc, filter%num_soilp, filter%soilp)
#endif


    ! Initialize time constant variables

    call CLMDebug('call iniTimeConst')
    call iniTimeConst()


    call mkarbinit(snl     ,snowdp, dzclm  ,zclm      ,&
                  ziclm    ,h2osno ,h2osoi_liq,h2osoi_ice,t_grnd,&
                  t_soisno ,t_lake ,t_veg    ,h2ocan ,h2ocan_col,&
                  h2osoi_vol,t_ref2m ,snw_rdsx &
#ifdef CN
                 ,tlai,tsai,htop,hbot &
#endif                 
                 )

!    call iniTimeVar(snl      ,snowdp  ,dzclm     ,zclm      ,&
!                   ziclm     ,h2osno  ,h2osoi_liq,h2osoi_ice,t_grnd    ,&
!                   t_soisno  ,t_lake  ,t_veg     ,h2ocan    ,h2ocan_col,&
!                   h2osoi_vol,declin,t_ref2m)


     ! Initialize Ecosystem Dynamics
!In CLM4, DGVM option changed to CNDV option--Yaqiong Lu
!#if (defined DGVM)
#if (defined CNDV)
 call CNDVEcosystemDynini(t_mo_min   ,annpsn     ,annpsnpot  ,fmicr     ,&
                          bm_inc     ,afmicr     ,t10min     ,tmomin20  ,&
                          agdd20     ,fpcgrid    ,lai_ind    ,crownarea ,&
                          dphen      ,leafon     ,leafof     ,firelength,&
                          litterag   ,litterbg   ,cpool_fast ,cpool_slow,&
                          k_fast_ave ,k_slow_ave ,nind       ,lm_ind    ,&
                          sm_ind     ,hm_ind     ,rm_ind     ,present   ,&
                          htop       ,tsai       ,litter_decom_ave)
!New in CLM4 --ylu 01/21/2011
#elif (!defined CN)
    call CLMDebug('init_ecosys') !in CLM4,CLMDebug() subroution changed to t_startf()&t_stopf()
    call EcosystemDynini()       !but for coupled version, we still use CLMDebug()
#endif


#if (defined CN)
    call CLMDebug('init_cninitim')
!    if (nsrest == 0) then  !only call for if not restart run.
       call CNiniTimeVar(htmx_buf,croplive_buf,gdd1020_buf,gdd820_buf,gdd020_buf,grainc_buf,grainc_storage_buf  &
                ,grainc_xfer_buf,grainn_buf,grainn_storage_buf,grainn_xfer_buf,days_active_buf  &
                ,onset_flag_buf,onset_counter_buf,onset_gddflag_buf,onset_fdd_buf,onset_gdd_buf &
                ,onset_swi_buf,offset_flag_buf,offset_counter_buf,offset_fdd_buf,offset_swi_buf &
                ,dayl_buf,annavg_t2m_buf,tempavg_t2m_buf,tempsum_potential_gpp_buf          &
                ,annsum_potential_gpp_buf,tempmax_retransn_buf,annmax_retransn_buf      &
                ,prev_leafc_to_litter_buf,prev_frootc_to_litter_buf,tempsum_npp_buf     &
                ,annsum_npp_buf,leafc_buf,leafc_storage_buf,leafc_xfer_buf,frootc_buf           &
                ,frootc_storage_buf,frootc_xfer_buf,livestemc_buf,livestemc_storage_buf     &
                ,livestemc_xfer_buf,deadstemc_buf,deadstemc_storage_buf,deadstemc_xfer_buf  &
                ,livecrootc_buf,livecrootc_storage_buf,livecrootc_xfer_buf,deadcrootc_buf   &
                ,deadcrootc_storage_buf,deadcrootc_xfer_buf,cpool_buf,pft_ctrunc_buf        &
                ,leafn_buf,leafn_storage_buf,leafn_xfer_buf,frootn_buf,frootn_storage_buf       &
                ,frootn_xfer_buf,livestemn_buf,livestemn_storage_buf,livestemn_xfer_buf     &
                ,deadstemn_buf,deadstemn_storage_buf,deadstemn_xfer_buf,livecrootn_buf      &
                ,livecrootn_storage_buf,livecrootn_xfer_buf,deadcrootn_buf              &
                ,deadcrootn_storage_buf,deadcrootn_xfer_buf,npool_buf,pft_ntrunc_buf        &
                ,gresp_storage_buf,gresp_xfer_buf,xsmrpool_buf,annsum_counter_buf           &
                ,cannsum_npp_buf,cannavg_t2m_buf,wf_buf,me_buf,mean_fire_prob_buf,cwdc_buf,litr1c_buf   &
                ,litr2c_buf,litr3c_buf,soil1c_buf,soil2c_buf,soil3c_buf,soil4c_buf,seedc_buf,col_ctrunc_buf &
                ,prod10c_buf,prod100c_buf,cwdn_buf,litr1n_buf,litr2n_buf,litr3n_buf,soil1n_buf,soil2n_buf   &
                ,soil3n_buf,soil4n_buf,seedn_buf,col_ntrunc_buf,prod10n_buf,prod100n_buf,sminn_buf &
                ,totlitc_buf,dwt_seedc_to_leaf_buf,dwt_seedc_to_deadstem_buf,dwt_conv_cflux_buf &
                ,dwt_prod10c_gain_buf,dwt_prod100c_gain_buf,prod100c_loss_buf,dwt_frootc_to_litr1c_buf &
                ,dwt_frootc_to_litr2c_buf,dwt_frootc_to_litr3c_buf,dwt_livecrootc_to_cwdc_buf &
                ,dwt_deadcrootc_to_cwdc_buf,dwt_seedn_to_leaf_buf,dwt_seedn_to_deadstem_buf &
                ,dwt_conv_nflux_buf,dwt_prod10n_gain_buf,dwt_prod100n_gain_buf,prod100n_loss_buf &
                ,dwt_frootn_to_litr1n_buf,dwt_frootn_to_litr2n_buf, dwt_frootn_to_litr3n_buf &
                , dwt_livecrootn_to_cwdn_buf,dwt_deadcrootn_to_cwdn_buf,retransn_buf &
           )
!    end if
#endif

!#if (defined CROP)
!    call initialcrop()  !removed,already added to CNiniTimeVar.F
!#endif

    ! Initialize dust emissions model  
    
#if (defined DUST) 
    call CLMDebug('init_dust')
    call Dustini()
!    call t_stopf('init_dust')
#endif


     call aerdepini()


!#else
! call CLMDebug('EcosystemDynini')
! call EcosystemDynini()
!#endif


    ! Initialize accumulator fields to be time accumulated for various purposes.
!    call CLMDebug('call  initAccFlds')
!    call  initAccFlds() 

    
    ! ------------------------------------------------------------------------
    ! Initialization of dynamic pft weights
    ! ------------------------------------------------------------------------

    ! Determine correct pft weights (interpolate pftdyn dataset if initial run)
    ! Otherwise these are read in for a restart run
    
!#if (defined CNDV)
!    call pftwt_init()
!#else
!    if (fpftdyn /= ' ') then
!       call CLMDebug('init_pftdyn')
!       call pftdyn_init()
!       call pftdyn_interp( )
!    end if
!#endif
!!!

!CLM4 -ylu 09 Feb 2011 The coupling model will read the NDEP_year at same level as LAI,SAI
!therefor remove this part and even ndepFileMod.F
   ! ------------------------------------------------------------------------
    ! Initialize dynamic nitrogen deposition
    ! ------------------------------------------------------------------------

!    if (fndepdyn /= ' ') then
!       call CLMDebug('init_ndepdyn')
!       call ndepdyn_init()
!       call ndepdyn_interp()
!    end if
!!!!!

   ! ------------------------------------------------------------------------
    ! Initialization for Urban or CASA options--add here is needed.
    ! ------------------------------------------------------------------------

    call CLMDebug('call iniTimeVar')
    call iniTimeVar(snl      ,snowdp  ,dzclm     ,zclm      ,&
                   ziclm     ,h2osno  ,h2osoi_liq,h2osoi_ice,t_grnd    ,&
                   t_soisno  ,t_lake  ,t_veg     ,h2ocan    ,h2ocan_col,&
                   h2osoi_vol,declin,t_ref2m,xlat,xlon)

  

    ! Initialize clmtype variables that are obtained from accumulated fields.
    ! This routine is called in an initial run at nstep=0 for cam and csm mode
    ! and at nstep=1 for offline mode. This routine is also always called for a
    ! restart run and must therefore be called after the restart file is read in
!    call CLMDebug('call initAccClmtype')
!    call initAccClmtype()



    ! Deallocate surface grid dynamic memory

!    call CLMDebug('entering varsurdealloc')
!    call varsur_dealloc()
!    call CLMDebug('done varsurdealloc')
    ! End initialization

!    call CLMDebug('call initSurfalb')
!    call initSurfalb( calday, declin, declinp1)

  end subroutine initialize

end module initializeMod
    subroutine clm(forc_txy        ,forc_uxy           ,forc_vxy      &
                  ,forc_qxy        ,zgcmxy             ,precxy        &
                  ,flwdsxy         ,forc_solsxy        ,forc_sollxy   &
                  ,forc_solsdxy    ,forc_solldxy       ,forc_pbotxy   &
                  ,forc_psrfxy     ,iveg               ,isl           &
                  ,lndmsk          ,xlat               ,xlon          &
                  ,areaxy          ,dt1                ,yr            &
                  ,mnth            ,dy                 ,nsec          &
                  ,cxday           ,yr1                ,mnp1          &
                  ,dyp1            ,nsec1              ,cxday1        &
                  ,mbdate          ,qsfxy              ,qdnxy         &
                  ,snl             ,snowdp             ,snw_rdsxy     &
                  ,dzclm           ,zclm               ,ziclm         &
                  ,h2osno          ,h2osoi_liq         ,h2osoi_ice    &
                  ,t_grnd          ,t_soisno           ,t_lake        &
                  ,t_veg           ,h2ocan             ,h2ocan_col    &
                  ,h2osoi_vol      ,wtc                ,wtp           &
                  ,numc            ,nump                    &
                  ,t_ref2m         ,albxy        , tsxy,  trefxy        &
                  ,shxy            ,lhxy               ,nstp          &
                  ,inest           ,ilx                ,jlx           &
                  ,soiflx          ,sabv               ,sabg          &
                  ,lwupxy          ,znt0               ,q_ref2m       &
                  ,rhoxy                                              &
                  ,ALBEDOsubgrid,LHsubgrid,HFXsubgrid,LWUPsubgrid     &
                  ,Q2subgrid,SABVsubgrid,SABGsubgrid,NRAsubgrid     &
                  ,SWUPsubgrid ,LHsoi,LHveg,LHtran,organicxy,efisopxy,gtixy &
                  ,alswnirdir  ,alswnirdif, alswvisdir,alswvisdif &
#ifdef CN
!CROP and CN restart and outputs
                ,forc_ndepxy,tlaixy,tsaixy,htopxy,hbotxy  &  
                ,htmx_buf,croplive_buf,gdd1020_buf,gdd820_buf,gdd020_buf,grainc_buf,grainc_storage_buf  &
                ,grainc_xfer_buf,grainn_buf,grainn_storage_buf,grainn_xfer_buf,days_active_buf  &
                ,onset_flag_buf,onset_counter_buf,onset_gddflag_buf,onset_fdd_buf,onset_gdd_buf &
                ,onset_swi_buf,offset_flag_buf,offset_counter_buf,offset_fdd_buf,offset_swi_buf &
                ,dayl_buf,annavg_t2m_buf,tempavg_t2m_buf,tempsum_potential_gpp_buf          &
                ,annsum_potential_gpp_buf,tempmax_retransn_buf,annmax_retransn_buf      &
                ,prev_leafc_to_litter_buf,prev_frootc_to_litter_buf,tempsum_npp_buf     &
                ,annsum_npp_buf,leafc_buf,leafc_storage_buf,leafc_xfer_buf,frootc_buf           &
                ,frootc_storage_buf,frootc_xfer_buf,livestemc_buf,livestemc_storage_buf     &
                ,livestemc_xfer_buf,deadstemc_buf,deadstemc_storage_buf,deadstemc_xfer_buf  &
                ,livecrootc_buf,livecrootc_storage_buf,livecrootc_xfer_buf,deadcrootc_buf   &
                ,deadcrootc_storage_buf,deadcrootc_xfer_buf,cpool_buf,pft_ctrunc_buf        &
                ,leafn_buf,leafn_storage_buf,leafn_xfer_buf,frootn_buf,frootn_storage_buf       &
                ,frootn_xfer_buf,livestemn_buf,livestemn_storage_buf,livestemn_xfer_buf     &
                ,deadstemn_buf,deadstemn_storage_buf,deadstemn_xfer_buf,livecrootn_buf      &
                ,livecrootn_storage_buf,livecrootn_xfer_buf,deadcrootn_buf              &
                ,deadcrootn_storage_buf,deadcrootn_xfer_buf,npool_buf,pft_ntrunc_buf        &
                ,gresp_storage_buf,gresp_xfer_buf,xsmrpool_buf,annsum_counter_buf           &
                ,cannsum_npp_buf,cannavg_t2m_buf,wf_buf,me_buf,mean_fire_prob_buf,cwdc_buf,litr1c_buf   &
                ,litr2c_buf,litr3c_buf,soil1c_buf,soil2c_buf,soil3c_buf,soil4c_buf,seedc_buf,col_ctrunc_buf &
                ,prod10c_buf,prod100c_buf,cwdn_buf,litr1n_buf,litr2n_buf,litr3n_buf,soil1n_buf,soil2n_buf   &
                ,soil3n_buf,soil4n_buf,seedn_buf,col_ntrunc_buf,prod10n_buf,prod100n_buf,sminn_buf &
                ,totlitc_buf,dwt_seedc_to_leaf_buf,dwt_seedc_to_deadstem_buf,dwt_conv_cflux_buf &
                ,dwt_prod10c_gain_buf,dwt_prod100c_gain_buf,prod100c_loss_buf,dwt_frootc_to_litr1c_buf &
                ,dwt_frootc_to_litr2c_buf,dwt_frootc_to_litr3c_buf,dwt_livecrootc_to_cwdc_buf &
                ,dwt_deadcrootc_to_cwdc_buf,dwt_seedn_to_leaf_buf,dwt_seedn_to_deadstem_buf &
                ,dwt_conv_nflux_buf,dwt_prod10n_gain_buf,dwt_prod100n_gain_buf,prod100n_loss_buf &
                ,dwt_frootn_to_litr1n_buf,dwt_frootn_to_litr2n_buf, dwt_frootn_to_litr3n_buf &
                , dwt_livecrootn_to_cwdn_buf,dwt_deadcrootn_to_cwdn_buf,retransn_buf &
#endif         
                                                            )
!-----------------------------------------------------------------------
!
! !USES:
  use shr_kind_mod , only : r8 => shr_kind_r8
  use clm_varpar, only : nlevgrnd,nlevsoi,numrad,maxpatch,&
                         nlevsno,nlevlak,lsmlon,lsmlat
  use initializeMod
  use nanMod
  use clmtype
  use clm_varcon  , only : rair, cpair, po2, pco2, tcrit,tfrz,pstd,sb
  use globals
  use decompMod   , only : get_proc_bounds
  use clmtypeInitMod
  use shr_orb_mod
  use shr_const_mod, only : SHR_CONST_PI
  use filterMod, only : filters_dealloc
  use clm_varsur      , only :varsur_dealloc


!
! !PUBLIC TYPES:
  implicit none
  save
!
! !REVISION HISTORY:
! Created by Gordon Bonan, Sam Levis and Mariana Vertenstein
!
!EOP
! atmospheric forcing variables on land model grid
!
  real(r8) :: gtixy
  real(r8) :: forc_txy          !atm bottom level temperature (Kelvin)
  real(r8) :: forc_uxy          !atm bottom level zonal wind (m/s)
  real(r8) :: forc_vxy          !atm bottom level meridional wind (m/s)
  real(r8) :: forc_qxy          !atm bottom level specific humidity (kg/kg)
  real(r8) :: zgcmxy            !atm bottom level height above surface (m)
  real(r8) :: precxy            !precipitation rate (mm H2O/s)
  real(r8) :: flwdsxy           !downward longwave rad onto surface (W/m**2)
  real(r8) :: forc_solsxy       !vis direct beam solar rad onto srf (W/m**2)
  real(r8) :: forc_sollxy       !nir direct beam solar rad onto srf (W/m**2)
  real(r8) :: forc_solsdxy      !vis diffuse solar rad onto srf (W/m**2)
  real(r8) :: forc_solldxy      !nir diffuse solar rad onto srf(W/m**2)
  real(r8) :: forc_pbotxy       !atm bottom level pressure (Pa)
  real(r8) :: forc_psrfxy       !atm surface pressure (Pa)
!ADD_NEW_VAR
  real(r8) :: forc_ndepxy       !nitrogen deposition rate (gN/m2/s)
!!!
 real(r8) :: alswnirdir  ,alswnirdif, alswvisdir,alswvisdif
 real(r8) :: swdall

! atmosphere grid to land model surface grid mapping for each land grid cell:
!=======================================================================

! !DESCRIPTION:
! This code reads in atmospheric fields from an input file and generates
! the required atmospheric forcing. These data files have [atmmin] minute
! average data for each month. Input data files are named in month-year
! format (e.g., 09-0001 contains 240 3-hour time slices of data, 30*8, for
! September of year one). The model will cycle through however many full
! years of data are available [pyr]. At least one full year of data is
! necessary for cycling. The model may start on any base date, as long as
! this date corresponds to an existing data file. A run need not be an
! exact multiple of a year.
!
! ============================
! Possible atmospheric fields:
! ============================
! Name     Description                              Required/Optional
! -----------------------------------------------------------------------------
! TBOT     temperature (K)                          Required
! WIND     wind:sqrt(u**2+v**2) (m/s)               Required
! QBOT     specific humidity (kg/kg)                Required
! Tdew     dewpoint temperature (K)                 Alternative to Q
! RH       relative humidity (percent)              Alternative to Q
! ZBOT     reference height (m)                     optional
! PSRF     surface pressure (Pa)                    optional
! FSDS     total incident solar radiation (W/m**2)  Required
! FSDSdir  direct incident solar radiation (W/m**2) optional (replaces FSDS)
! FSDSdif  diffuse incident solar rad (W/m**2)      optional (replaces FSDS)
! FLDS     incident longwave radiation (W/m**2)     optional
! PRECTmms total precipitation (mm H2O / sec)       Required
! PRECCmms convective precipitation (mm H2O / sec)  optional (replaces PRECT)
! PRECLmms large-scale precipitation (mm H2O / sec) optional (replaces PRECT)
!
! LOCAL VARIABLES:
    integer :: i,j,k,g,p,c  !indices
    integer :: begp, endp   ! per-proc beginning and ending pft indices
    integer :: begc, endc   ! per-proc beginning and ending column indices
    integer :: begl, endl   ! per-proc beginning and ending landunit indices
    integer :: begg, endg   ! per-proc gridcell ending gridcell indices
    type(gridcell_type), pointer :: gptr  ! pointer to gridcell derived subtype
!------------------------------------------------------------------------
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
#if (defined DGVM)
! The following vraiables for MM5 and restart run
    real(r8):: t_mo_min(maxpatch)            !annual min of t_mo (Kelvin)
    real(r8):: annpsn(maxpatch)              !annual photosynthesis (umol CO2 /m**2)
    real(r8):: annpsnpot(maxpatch)           !annual potential photosynthesis (same units)
    real(r8):: fmicr(maxpatch)               !microbial respiration (umol CO2 /m**2 /s)
    real(r8):: bm_inc(maxpatch)              !biomass increment
    real(r8):: afmicr(maxpatch)              !microbial respiration (Rh) for each naturally-vegetated pft
    real(r8):: t10min(maxpatch)              !annual minimum of 10-day running mean (K)
    real(r8):: tmomin20(maxpatch)            !20-yr running mean of tmomin
    real(r8):: agdd20(maxpatch)              !20-yr running mean of agdd
    real(r8):: fpcgrid(maxpatch)             !foliar projective cover on gridcell (fraction)
    real(r8):: lai_ind(maxpatch)             !LAI per individual
    real(r8):: crownarea(maxpatch)           !area that each individual tree takes up (m^2)
    real(r8):: dphen(maxpatch)               !phenology [0 to 1]
    real(r8):: leafon(maxpatch)              !leafon days
    real(r8):: leafof(maxpatch)              !leafoff days
    real(r8):: firelength(maxpatch)          !fire season in days
    real(r8):: litterag(maxpatch)            !above ground litter
    real(r8):: litterbg(maxpatch)            !below ground litter
    real(r8):: cpool_fast(maxpatch)          !fast carbon pool
    real(r8):: cpool_slow(maxpatch)          !slow carbon pool
    real(r8):: k_fast_ave(maxpatch)          !decomposition rate
    real(r8):: k_slow_ave(maxpatch)          !decomposition rate
    real(r8):: litter_decom_ave(maxpatch)    !decomposition rate
    real(r8):: nind(maxpatch)                !number of individuals (#/m**2)
    real(r8):: lm_ind(maxpatch)              !individual leaf mass
    real(r8):: sm_ind(maxpatch)              !individual sapwood mass
    real(r8):: hm_ind(maxpatch)              !individual heartwood mass
    real(r8):: rm_ind(maxpatch)              !individual root mass
    logical :: present(maxpatch)             !whether PFT present in patch

    real(r8) :: tda(maxpatch)
    real(r8) :: t10(maxpatch)
    real(r8) :: fnpsn10(maxpatch)
    real(r8) :: prec365(maxpatch)
    real(r8) :: agdd0(maxpatch)
    real(r8) :: agdd5(maxpatch)
    real(r8) :: agddtw(maxpatch)
    real(r8) :: agdd(maxpatch)
#endif

  integer   :: snl(maxpatch)
  real(r8)  :: snowdp(maxpatch)
!  real(r8)  :: snowage(maxpatch)
  real(r8)  :: h2osno(maxpatch)
  real(r8)  :: t_grnd(maxpatch)
  real(r8)  :: t_veg(maxpatch)
  real(r8)  :: h2ocan(maxpatch)
  real(r8)  :: h2ocan_col(maxpatch)
  real(r8)  :: wtc(maxpatch)
  real(r8)  :: wtp(maxpatch)
  integer   :: numc,nump
  real(r8)  :: htop(maxpatch)
  real(r8)  :: tsai(maxpatch)

    real(r8) :: efisopxy(6)


  real(r8)  :: t_lake(maxpatch,nlevlak)
  real(r8),dimension(maxpatch,-nlevsno+1:nlevgrnd) :: t_soisno
  real(r8)  :: h2osoi_liq(maxpatch,-nlevsno+1:nlevgrnd)
  real(r8)  :: h2osoi_ice(maxpatch,-nlevsno+1:nlevgrnd)
  real(r8)  :: dzclm(maxpatch,-nlevsno+1:nlevgrnd)
  real(r8)  :: zclm(maxpatch,-nlevsno+1:nlevgrnd)
  real(r8)  :: ziclm(maxpatch,-nlevsno:nlevgrnd)
  real(r8)  :: h2osoi_vol(maxpatch,nlevgrnd)
  real(r8)  :: snw_rdsxy(maxpatch,-nlevsno+1:0)
  real(r8)  :: t_ref2m(maxpatch)
!New PFT-level output variables
  real(r8), dimension(1:maxpatch), intent(out) ::  ALBEDOsubgrid,LHsubgrid,HFXsubgrid,LWUPsubgrid,     &
                Q2subgrid,SABVsubgrid,SABGsubgrid,NRAsubgrid,SWUPsubgrid,LHsoi,LHveg,LHtran
  real(r8)  :: znt(maxpatch),organicxy(maxpatch)
  real(r8)  :: q_ref2m(maxpatch)

#ifdef CN
   real(r8),dimension(maxpatch) :: tlaixy,tsaixy,htopxy,hbotxy

!CROP&CN buf variables
  integer,dimension(maxpatch) :: croplive_buf
   real(r8), dimension(maxpatch)  ::  &
                 htmx_buf,gdd1020_buf,gdd820_buf,gdd020_buf,grainc_buf,grainc_storage_buf  &
                ,grainc_xfer_buf,grainn_buf,grainn_storage_buf,grainn_xfer_buf,days_active_buf  &
                ,onset_flag_buf,onset_counter_buf,onset_gddflag_buf,onset_fdd_buf,onset_gdd_buf &
                ,onset_swi_buf,offset_flag_buf,offset_counter_buf,offset_fdd_buf,offset_swi_buf &
                ,dayl_buf,annavg_t2m_buf,tempavg_t2m_buf,tempsum_potential_gpp_buf          &
                ,annsum_potential_gpp_buf,tempmax_retransn_buf,annmax_retransn_buf      &
                ,prev_leafc_to_litter_buf,prev_frootc_to_litter_buf,tempsum_npp_buf     &
                ,annsum_npp_buf,leafc_buf,leafc_storage_buf,leafc_xfer_buf,frootc_buf           &
                ,frootc_storage_buf,frootc_xfer_buf,livestemc_buf,livestemc_storage_buf     &
                ,livestemc_xfer_buf,deadstemc_buf,deadstemc_storage_buf,deadstemc_xfer_buf  &
                ,livecrootc_buf,livecrootc_storage_buf,livecrootc_xfer_buf,deadcrootc_buf   &
                ,deadcrootc_storage_buf,deadcrootc_xfer_buf,cpool_buf,pft_ctrunc_buf        &
                ,leafn_buf,leafn_storage_buf,leafn_xfer_buf,frootn_buf,frootn_storage_buf       &
                ,frootn_xfer_buf,livestemn_buf,livestemn_storage_buf,livestemn_xfer_buf     &
                ,deadstemn_buf,deadstemn_storage_buf,deadstemn_xfer_buf,livecrootn_buf      &
                ,livecrootn_storage_buf,livecrootn_xfer_buf,deadcrootn_buf              &
                ,deadcrootn_storage_buf,deadcrootn_xfer_buf,npool_buf,pft_ntrunc_buf        &
                ,gresp_storage_buf,gresp_xfer_buf,xsmrpool_buf,annsum_counter_buf           &
                ,cannsum_npp_buf,cannavg_t2m_buf,wf_buf,me_buf,mean_fire_prob_buf,cwdc_buf,litr1c_buf   &
                ,litr2c_buf,litr3c_buf,soil1c_buf,soil2c_buf,soil3c_buf,soil4c_buf,seedc_buf,col_ctrunc_buf &
                ,prod10c_buf,prod100c_buf,cwdn_buf,litr1n_buf,litr2n_buf,litr3n_buf,soil1n_buf,soil2n_buf   &
                ,soil3n_buf,soil4n_buf,seedn_buf,col_ntrunc_buf,prod10n_buf,prod100n_buf,sminn_buf &
                ,totlitc_buf,dwt_seedc_to_leaf_buf,dwt_seedc_to_deadstem_buf,dwt_conv_cflux_buf &
                ,dwt_prod10c_gain_buf,dwt_prod100c_gain_buf,prod100c_loss_buf,dwt_frootc_to_litr1c_buf &
                ,dwt_frootc_to_litr2c_buf,dwt_frootc_to_litr3c_buf,dwt_livecrootc_to_cwdc_buf &
                ,dwt_deadcrootc_to_cwdc_buf,dwt_seedn_to_leaf_buf,dwt_seedn_to_deadstem_buf &
                ,dwt_conv_nflux_buf,dwt_prod10n_gain_buf,dwt_prod100n_gain_buf,prod100n_loss_buf &
                ,dwt_frootn_to_litr1n_buf,dwt_frootn_to_litr2n_buf, dwt_frootn_to_litr3n_buf &
                , dwt_livecrootn_to_cwdn_buf,dwt_deadcrootn_to_cwdn_buf,retransn_buf 
              
#endif 

  logical doalb     !true if surface albedo calculation time step

  real(r8)  :: albxy,albixy(numrad),albdxy(numrad) &
!For new output variables
              ,albedotemp(maxpatch, numrad)
  real(r8)  :: trefxy,tsxy
  real(r8)  :: shxy
  real(r8)  :: lhxy
  real(r8)  :: lwupxy
  real(r8)  :: qsfxy
  real(r8)  :: qdnxy
  real(r8)  :: soiflx
  real(r8)  :: sabv
  real(r8)  :: sabg
  real(r8)  :: znt0
  real(r8),intent(out)  :: rhoxy

  integer   :: nstp
!ylu add albedo coefficients
 real(r8),dimension(1:numrad) :: cof_dir,cof_dif  !1=visible, 2=nir


  real(r8) :: areaxy           !gridcell area (km^2)
  real(r8) :: dt1
  real(r8) :: cxday
  real(r8) :: cxday1
  real(r8) :: xlat
  real(r8) :: xlon

  integer  :: iveg
  integer  :: isl
  integer  :: lndmsk
  integer  :: yr
  integer  :: mnth
  integer  :: dy
  integer  :: nsec
  integer  :: yr1
  integer  :: mnp1
  integer  :: dyp1
  integer  :: nsec1
  integer  :: mbdate
  integer  :: inest
  integer  :: ilx,jlx

  real(r8)  :: t2m,dsq,dsqmin
  character*256 :: msg
!ylu add for calculate orbit parameters and decline
   real(r8) :: eccen     ! orbital eccentricity
   real(r8) :: obliq     ! obliquity in degrees
   real(r8) :: mvelp     ! moving vernal equinox long
   integer  :: orb_iyear_AD  ! Year to calculate orbit for
   real(r8) :: obliqr    ! Earths obliquity in rad
   real(r8) :: lambm0    ! Mean long of perihelion at
                                                   ! vernal equinox (radians)
   real(r8) :: mvelpp    ! moving vernal equinox long
                                                   ! of perihelion plus pi (rad)
   real(r8) :: declinp1              ! solar declination angle in radians for nstep+1
   real(r8) :: declin      ! solar declination angle in radians for nstep
   real(r8) :: eccf        ! earth orbit eccentricity factor



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

       call CLMDebug('Starting clm3.F')
       msg= ''
       write(msg, *) 'At i,j = ', ilx, ', ', jlx, '.'
       call CLMDebug(msg)
       msg = ''
       write(msg, *) 't_grnd(1) = ', t_grnd(1), '.' 
       call CLMDebug(msg)

! setup the  step, monthn and day
       call clmtype_mod
       call globals_mod
       dtime    = dt1
       dt       = dt1
       year     = yr
       month    = mnth
       day      = dy
       secs     = nsec
       calday   = cxday

       yrp1     = yr1
       monp1    = mnp1
       dayp1    = dyp1
       secp1    = nsec1
       caldayp1 = cxday1

       nbdate   = mbdate
       nstep    = nstp

       if(mod(year,4)==0) then
          day_per_year = 366
       else
          day_per_year = 365
       end if     

       orb_iyear_AD = 1990    !according to buildnml of CCSM_crop
!------------------------------------------------------------------------
!set albedo coefficients -- ylu
!------------------------------------------------------------------------ 

     swdall = forc_sollxy+forc_solsxy+forc_solsdxy+forc_solldxy
    if(swdall.ne. 0) then   ! if daytime
      cof_dir(2) = forc_sollxy/swdall
      cof_dif(2) = forc_solldxy/swdall
      cof_dir(1) = forc_solsxy/swdall
      cof_dif(1) = forc_solsdxy/swdall
    else    !if night
      cof_dir(2) = 0.35    !it doesn't matter what values for night, albedo equal to 1 anyway in CLM.
      cof_dif(2) = 0.15    !here I use the value from old version of WRF-CLM  --ylu
      cof_dir(1) = 0.35
      cof_dif(1) = 0.15
   end if
!-------------------------------------------------
!Yaqiong Lu 03/07/2011
    call CLMDebug('Start shr_orb_params')   
     call shr_orb_params(orb_iyear_AD, eccen, obliq, mvelp, &             !get orbit parameres
                           obliqr, lambm0, mvelpp) 
     call shr_orb_decl(calday, eccen, mvelpp, lambm0, obliqr, declin, eccf ) !get decline for current step
     call shr_orb_decl(caldayp1, eccen, mvelpp, lambm0, obliqr, declinp1, eccf )  !get decline for next step
    call CLMDebug('End shr_orb_params & decl')    
    call CLMDebug('Start initialize()') 

   !  write(6,*) 'in clm3, t_soisno=',t_soisno
    call  initialize(snl    ,snowdp  ,dzclm     ,zclm         &
                  ,ziclm       ,h2osno  ,h2osoi_liq,h2osoi_ice,t_grnd      &
                  ,t_soisno    ,t_lake  ,t_veg     ,h2ocan    ,h2ocan_col  &
                  ,h2osoi_vol  ,xlat    ,xlon      ,areaxy    ,iveg        &
                  ,isl         ,lndmsk     &
                  ,t_ref2m ,ilx,jlx,calday,declin,declinp1&
                  ,organicxy, efisopxy,gtixy, snw_rdsxy   &
#ifdef CN
                ,tlaixy   ,tsaixy  ,htopxy    ,hbotxy                & 
                ,htmx_buf,croplive_buf,gdd1020_buf,gdd820_buf,gdd020_buf,grainc_buf,grainc_storage_buf  &
                ,grainc_xfer_buf,grainn_buf,grainn_storage_buf,grainn_xfer_buf,days_active_buf  &
                ,onset_flag_buf,onset_counter_buf,onset_gddflag_buf,onset_fdd_buf,onset_gdd_buf &
                ,onset_swi_buf,offset_flag_buf,offset_counter_buf,offset_fdd_buf,offset_swi_buf &
                ,dayl_buf,annavg_t2m_buf,tempavg_t2m_buf,tempsum_potential_gpp_buf          &
                ,annsum_potential_gpp_buf,tempmax_retransn_buf,annmax_retransn_buf      &
                ,prev_leafc_to_litter_buf,prev_frootc_to_litter_buf,tempsum_npp_buf     &
                ,annsum_npp_buf,leafc_buf,leafc_storage_buf,leafc_xfer_buf,frootc_buf           &
                ,frootc_storage_buf,frootc_xfer_buf,livestemc_buf,livestemc_storage_buf     &
                ,livestemc_xfer_buf,deadstemc_buf,deadstemc_storage_buf,deadstemc_xfer_buf  &
                ,livecrootc_buf,livecrootc_storage_buf,livecrootc_xfer_buf,deadcrootc_buf   &
                ,deadcrootc_storage_buf,deadcrootc_xfer_buf,cpool_buf,pft_ctrunc_buf        &
                ,leafn_buf,leafn_storage_buf,leafn_xfer_buf,frootn_buf,frootn_storage_buf       &
                ,frootn_xfer_buf,livestemn_buf,livestemn_storage_buf,livestemn_xfer_buf     &
                ,deadstemn_buf,deadstemn_storage_buf,deadstemn_xfer_buf,livecrootn_buf      &
                ,livecrootn_storage_buf,livecrootn_xfer_buf,deadcrootn_buf              &
                ,deadcrootn_storage_buf,deadcrootn_xfer_buf,npool_buf,pft_ntrunc_buf        &
                ,gresp_storage_buf,gresp_xfer_buf,xsmrpool_buf,annsum_counter_buf           &
                ,cannsum_npp_buf,cannavg_t2m_buf,wf_buf,me_buf,mean_fire_prob_buf,cwdc_buf,litr1c_buf   &
                ,litr2c_buf,litr3c_buf,soil1c_buf,soil2c_buf,soil3c_buf,soil4c_buf,seedc_buf,col_ctrunc_buf &
                ,prod10c_buf,prod100c_buf,cwdn_buf,litr1n_buf,litr2n_buf,litr3n_buf,soil1n_buf,soil2n_buf   &
                ,soil3n_buf,soil4n_buf,seedn_buf,col_ntrunc_buf,prod10n_buf,prod100n_buf,sminn_buf &
                ,totlitc_buf,dwt_seedc_to_leaf_buf,dwt_seedc_to_deadstem_buf,dwt_conv_cflux_buf &
                ,dwt_prod10c_gain_buf,dwt_prod100c_gain_buf,prod100c_loss_buf,dwt_frootc_to_litr1c_buf &
                ,dwt_frootc_to_litr2c_buf,dwt_frootc_to_litr3c_buf,dwt_livecrootc_to_cwdc_buf &
                ,dwt_deadcrootc_to_cwdc_buf,dwt_seedn_to_leaf_buf,dwt_seedn_to_deadstem_buf &
                ,dwt_conv_nflux_buf,dwt_prod10n_gain_buf,dwt_prod100n_gain_buf,prod100n_loss_buf &
                ,dwt_frootn_to_litr1n_buf,dwt_frootn_to_litr2n_buf, dwt_frootn_to_litr3n_buf &
                , dwt_livecrootn_to_cwdn_buf,dwt_deadcrootn_to_cwdn_buf,retransn_buf &
#endif    
                                                                      )
    call CLMDebug('initialize done. Back in clm3')

    ! Determine necessary indices

    call get_proc_bounds(begg, endg, begl, endl, begc, endc, begp, endp)

    ! Set pointers into derived type

       gptr => clm3%g

       do g = begg, endg
          !i = gptr%ixy(g)
          !j = gptr%jxy(g)
          !lat and lon
       clm3%g%latdeg(g)            = xlat  !degree
       clm3%g%londeg(g)            = xlon 

       clm3%g%lat(g)               = xlat*(SHR_CONST_PI/180._r8)  ! redians
       clm3%g%lon(g)               = xlon*(SHR_CONST_PI/180._r8)

       clm3%g%latdeg_a(g)            = xlat  !degree "atm" latitude (degrees) for albedo
       clm3%g%londeg_a(g)            = xlon

       clm3%g%lat_a(g)               = xlat*(SHR_CONST_PI/180._r8)  ! redians "atm" latitude (radians) for albedo
       clm3%g%lon_a(g)               = xlon*(SHR_CONST_PI/180._r8)

          !States

          clm_a2l%forc_t(g) = forc_txy
          clm_a2l%forc_u(g) = forc_uxy
          clm_a2l%forc_v(g) = forc_vxy
          clm_a2l%forc_wind(g) = sqrt(forc_uxy**2 + forc_vxy**2)
          clm_a2l%forc_q(g) = forc_qxy
          clm_a2l%forc_hgt(g) = zgcmxy
          clm_a2l%forc_hgt_u(g) = zgcmxy !observational height of wind [m]
          clm_a2l%forc_hgt_t(g) = zgcmxy !observational height of temp [m]
          clm_a2l%forc_hgt_q(g) = zgcmxy !observational height of humidity [m]

          clm_a2l%forc_pbot(g) = forc_pbotxy
          clm_a2l%forc_psrf(g) = forc_psrfxy
          clm_a2l%forc_th(g)  = clm_a2l%forc_t(g) * (clm_a2l%forc_psrf(g) &
               / clm_a2l%forc_pbot(g))**(rair/cpair)
          clm_a2l%forc_vp(g)  = clm_a2l%forc_q(g) * clm_a2l%forc_pbot(g) &
               / (0.622 + 0.378 * clm_a2l%forc_q(g))
          clm_a2l%forc_rho(g) = (clm_a2l%forc_pbot(g) - 0.378 * clm_a2l%forc_vp(g)) &
               / (rair * clm_a2l%forc_t(g))

          clm_a2l%forc_pco2(g) = pco2 * clm_a2l%forc_pbot(g)
          clm_a2l%forc_po2(g)  = po2 * clm_a2l%forc_pbot(g)
#ifdef CN
!ADD_NEW_VAR
          clm_a2l%forc_ndep(g) =forc_ndepxy
!!!
#endif
          !Fluxes

          clm_a2l%forc_lwrad(g) = flwdsxy
          clm_a2l%forc_solad(g,1) = forc_solsxy
          clm_a2l%forc_solad(g,2) = forc_sollxy
          clm_a2l%forc_solai(g,1) = forc_solsdxy
          clm_a2l%forc_solai(g,2) = forc_solldxy
          clm_a2l%forc_solar(g) = forc_solsxy + forc_sollxy &
               + forc_solsdxy + forc_solldxy

          ! Snow and Rain
          ! Set upper limit of air temperature for snowfall at 275.65K.
          ! This cut-off was selected based on Fig. 1, Plate 3-1, of Snow
          ! Hydrology (1956).

          if (precxy > 0.) then
             if (clm_a2l%forc_t(g) > (tfrz + tcrit)) then
                clm_a2l%forc_rain(g) = precxy
                clm_a2l%forc_snow(g) = 0.
             !   clm_a2l%flfall(g) = 1.
             else
                clm_a2l%forc_rain(g) = 0.
                clm_a2l%forc_snow(g) = precxy

                if (clm_a2l%forc_t(g) <= tfrz) then
             !      clm_a2l%flfall(g) = 0.
                else if (clm_a2l%forc_t(g) <= tfrz+2.) then
             !      clm_a2l%flfall(g) = -54.632 + 0.2 * clm_a2l%forc_t(g)
                else
             !      clm_a2l%flfall(g) = 0.4
                endif
             endif
          else
             clm_a2l%forc_rain(g) = 0.
             clm_a2l%forc_snow(g) = 0.
            ! clm_a2l%flfall(g) = 1.
          endif
          rhoxy = clm_a2l%forc_rho(g) ! here assume that g is always 1
         
          clm_a2l%rainf(g) = clm_a2l%forc_rain(g)+clm_a2l%forc_snow(g)
       end do


     ! doalb is true when the next time step is a radiation time step
     ! this allows for the fact that an atmospheric model may not do
     ! the radiative calculations every time step. for example:
     !      nstep dorad doalb
     !        1     F     F
     !        2     F     T
     !        3     T     F
!Yaqiong Lu 03/07/2011
!    call CLMDebug('Start shr_orb_params')   
!     call shr_orb_params(orb_iyear_AD, eccen, obliq, mvelp, &             !get orbit parameres
!                           obliqr, lambm0, mvelpp) 
!     call shr_orb_decl(calday, eccen, mvelpp, lambm0, obliqr, declin, eccf ) !get decline for current step
!     call shr_orb_decl(caldayp1, eccen, mvelpp, lambm0, obliqr, declinp1, eccf )  !get decline for next step
!    call CLMDebug('End shr_orb_params & decl')    
!!
     doalb = .true.

     ! Call land surface model driver
     ! Note that surface fields used by the atmospheric model are zero for
     ! non-land points and must be set by the appropriate surface model

     call CLMDebug('Calling Driver')
     call driver (doalb,ilx,jlx,caldayp1, declinp1, declin)
     call CLMDebug('Driver done, back to clm3.F')

!-------------------------------------------------------------------------
     call CLMDebug('biophy_to_wrf')
     call biophy_to_wrf(snl      ,snowdp  ,dzclm      ,zclm        ,&
                     ziclm       ,h2osno  ,h2osoi_liq   ,h2osoi_ice ,t_grnd      ,&
                     t_soisno    ,t_lake  ,t_veg        ,h2ocan     ,h2ocan_col  ,&
                     h2osoi_vol  ,wtc     ,wtp          ,numc       ,nump        ,&
                     htop        ,tsai        &
                     ,t_ref2m ,znt          ,q_ref2m, snw_rdsxy)
 

#if (defined CN)
     call biochem_to_wrf(htmx_buf,croplive_buf,gdd1020_buf,gdd820_buf,gdd020_buf,grainc_buf,grainc_storage_buf  &
                ,grainc_xfer_buf,grainn_buf,grainn_storage_buf,grainn_xfer_buf,days_active_buf  &
                ,onset_flag_buf,onset_counter_buf,onset_gddflag_buf,onset_fdd_buf,onset_gdd_buf &
                ,onset_swi_buf,offset_flag_buf,offset_counter_buf,offset_fdd_buf,offset_swi_buf &
                ,dayl_buf,annavg_t2m_buf,tempavg_t2m_buf,tempsum_potential_gpp_buf          &
                ,annsum_potential_gpp_buf,tempmax_retransn_buf,annmax_retransn_buf      &
                ,prev_leafc_to_litter_buf,prev_frootc_to_litter_buf,tempsum_npp_buf     &
                ,annsum_npp_buf,leafc_buf,leafc_storage_buf,leafc_xfer_buf,frootc_buf           &
                ,frootc_storage_buf,frootc_xfer_buf,livestemc_buf,livestemc_storage_buf     &
                ,livestemc_xfer_buf,deadstemc_buf,deadstemc_storage_buf,deadstemc_xfer_buf  &
                ,livecrootc_buf,livecrootc_storage_buf,livecrootc_xfer_buf,deadcrootc_buf   &
                ,deadcrootc_storage_buf,deadcrootc_xfer_buf,cpool_buf,pft_ctrunc_buf        &
                ,leafn_buf,leafn_storage_buf,leafn_xfer_buf,frootn_buf,frootn_storage_buf       &
                ,frootn_xfer_buf,livestemn_buf,livestemn_storage_buf,livestemn_xfer_buf     &
                ,deadstemn_buf,deadstemn_storage_buf,deadstemn_xfer_buf,livecrootn_buf      &
                ,livecrootn_storage_buf,livecrootn_xfer_buf,deadcrootn_buf              &
                ,deadcrootn_storage_buf,deadcrootn_xfer_buf,npool_buf,pft_ntrunc_buf        &
                ,gresp_storage_buf,gresp_xfer_buf,xsmrpool_buf,annsum_counter_buf           &
                ,cannsum_npp_buf,cannavg_t2m_buf,wf_buf,me_buf,mean_fire_prob_buf,cwdc_buf,litr1c_buf   &
                ,litr2c_buf,litr3c_buf,soil1c_buf,soil2c_buf,soil3c_buf,soil4c_buf,seedc_buf,col_ctrunc_buf &
                ,prod10c_buf,prod100c_buf,cwdn_buf,litr1n_buf,litr2n_buf,litr3n_buf,soil1n_buf,soil2n_buf   &
                ,soil3n_buf,soil4n_buf,seedn_buf,col_ntrunc_buf,prod10n_buf,prod100n_buf,sminn_buf &
               ,totlitc_buf,dwt_seedc_to_leaf_buf,dwt_seedc_to_deadstem_buf,dwt_conv_cflux_buf &
                ,dwt_prod10c_gain_buf,dwt_prod100c_gain_buf,prod100c_loss_buf,dwt_frootc_to_litr1c_buf &
                ,dwt_frootc_to_litr2c_buf,dwt_frootc_to_litr3c_buf,dwt_livecrootc_to_cwdc_buf &
                ,dwt_deadcrootc_to_cwdc_buf,dwt_seedn_to_leaf_buf,dwt_seedn_to_deadstem_buf &
                ,dwt_conv_nflux_buf,dwt_prod10n_gain_buf,dwt_prod100n_gain_buf,prod100n_loss_buf &
                ,dwt_frootn_to_litr1n_buf,dwt_frootn_to_litr2n_buf, dwt_frootn_to_litr3n_buf &
                , dwt_livecrootn_to_cwdn_buf,dwt_deadcrootn_to_cwdn_buf,retransn_buf &
                  )
#endif

      call CLMDebug('start accumulate in clm3.F')

    albxy = 0._r8

    do j = 1,numrad
       do p = begp,endp
         
          albxy =albxy +  clm3%g%l%c%p%pps%albd(p,j)*wtp(p)*cof_dir(j) + clm3%g%l%c%p%pps%albi(p,j)*wtp(p)*cof_dif(j)
          albedosubgrid(p) = clm3%g%l%c%p%pps%albd(p,j)*cof_dir(j)+clm3%g%l%c%p%pps%albi(p,j)*cof_dif(j)
     
       end do
    end do

    msg = ''
    write(msg,*) 'Calculated albedo is ', albxy, '.'
    call CLMDebug(msg)

    lwupxy= 0._r8
    shxy  = 0._r8
    lhxy  = 0._r8
    soiflx= 0._r8
    sabv  = 0._r8
    sabg  = 0._r8
    trefxy  = 0._r8
    tsxy = 0._r8
    znt0  = 0._r8
    alswvisdir = 0._r8
    alswvisdif = 0._r8
    alswnirdir = 0._r8
    alswnirdif = 0._r8
!!
  
    do p = begp,endp 
       lwupxy= lwupxy+ clm3%g%l%c%p%pef%eflx_lwrad_out(p)*wtp(p)
       shxy  = shxy  + clm3%g%l%c%p%pef%eflx_sh_tot(p)*wtp(p)
       lhxy  = lhxy  + clm3%g%l%c%p%pef%eflx_lh_tot(p)*wtp(p)
       soiflx= soiflx+ clm3%g%l%c%p%pef%eflx_soil_grnd(p)*wtp(p) ! [+ into soil]
       sabv  = sabv  + clm3%g%l%c%p%pef%sabv(p)*wtp(p)
       sabg  = sabg  + clm3%g%l%c%p%pef%sabg(p)*wtp(p)
       tsxy  = tsxy  + clm3%g%l%c%p%pes%t_veg(p)*wtp(p) 
       trefxy  = trefxy  + clm3%g%l%c%p%pes%t_ref2m(p)*wtp(p) 
       !over lakes and bare soils, t_veg = t_grnd
       znt0  = znt0 + znt(p)*wtp(p)

        
       alswvisdir = alswvisdir + clm3%g%l%c%p%pps%albd(p,1)*wtp(p)
       alswnirdif = alswnirdif + clm3%g%l%c%p%pps%albi(p,1)*wtp(p)
       alswnirdir = alswnirdir + clm3%g%l%c%p%pps%albd(p,2)*wtp(p)  !1=visible, 2=nir
       alswnirdif = alswnirdif + clm3%g%l%c%p%pps%albi(p,2)*wtp(p) 

!!PFT-level outputs
       if ( wtp(p) > 0.001 ) then
          lhsubgrid(p)   = clm3%g%l%c%p%pef%eflx_lh_tot(p)
          hfxsubgrid(p)  = clm3%g%l%c%p%pef%eflx_sh_tot(p)
          lwupsubgrid(p) = clm3%g%l%c%p%pef%eflx_lwrad_out(p)
          q2subgrid(p)   = q_ref2m(p)
          sabvsubgrid(p) = clm3%g%l%c%p%pef%sabv(p)   !solar radiation absorbed by vegetation
          sabgsubgrid(p) = clm3%g%l%c%p%pef%sabg(p)   !solar radiation absorbed by ground
          nrasubgrid(p)  = clm3%g%l%c%p%pef%fsa(p)    !solar radiation absorbed total=net radiation
          swupsubgrid(p)  = clm3%g%l%c%p%pef%fsr(p)    !solar radiation reflected      
          lhsoi(p)      = clm3%g%l%c%p%pef%eflx_lh_grnd(p)
          lhveg(p)      = clm3%g%l%c%p%pef%eflx_lh_vege(p)
          lhtran(p)     = clm3%g%l%c%p%pef%eflx_lh_vegt(p)
#ifdef CN       
          tlaixy(p)     = clm3%g%l%c%p%pps%tlai(p)
          tsaixy(p)     = clm3%g%l%c%p%pps%tsai(p)
          htopxy(p)     = clm3%g%l%c%p%pps%htop(p)
          hbotxy(p)     = clm3%g%l%c%p%pps%hbot(p) 
#endif
       endif
!!
    end do

!Debug
    msg = ''
    write(msg,*) 'LWUP is', lwupxy, '.'
    call CLMDebug(msg)

    qsfxy  = 0._r8
    qdnxy  = 0._r8
    do c = begc,endc
       qsfxy = qsfxy + clm3%g%l%c%cwf%qflx_surf(c)*wtc(c)*dtime
       qdnxy = qdnxy + clm3%g%l%c%cwf%qflx_drain(c)*wtc(c)*dtime
    end do
!-------------------------------------------------------------------------
    call CLMDebug('call clmtype_dealloc')
    call clmtype_dealloc()
    call CLMDebug('call filters_dealloc')
    call filters_dealloc()
    call CLMDebug('entering varsurdealloc')
    call varsur_dealloc()

!-------------------------------------------------------------------------
 call CLMDebug('done clm()')


     return

  end subroutine clm
!-----------------------------------------------------------------------
!BOP
!
! !ROUTINE: driver
!
! !INTERFACE:
subroutine driver (doalb,ilx,jlx,nextsw_cday, declinp1, declin)
!
! !DESCRIPTION:
! This subroutine provides the main CLM driver calling sequence.  Most
! computations occurs over ``clumps'' of gridcells (and associated subgrid
! scale entities) assigned to each MPI process.  Computation is further
! parallelized by looping over clumps on each process using shared memory
! OpenMP or Cray Streaming Directives.
!
! The main CLM driver calling sequence is as follows:
! \begin{verbatim}
! * Communicate with flux coupler [COUP_CSM]
! + interpMonthlyVeg      interpolate monthly vegetation data [!DGVM]
!   + readMonthlyVegetation read vegetation data for two months [!DGVM]
! ==== Begin Loop 1 over clumps ====
!  -> DriverInit          save of variables from previous time step
!  -> Hydrology1          canopy interception and precip on ground
!     -> FracWet          fraction of wet vegetated surface and dry elai
!  -> SurfaceRadiation    surface solar radiation
!  -> Biogeophysics1      leaf temperature and surface fluxes
!  -> BareGroundFluxes    surface fluxes for bare soil or snow-covered
!                         vegetation patches
!     -> MoninObukIni     first-guess Monin-Obukhov length and wind speed
!     -> FrictionVelocity friction velocity and potential temperature and
!                         humidity profiles
!  -> CanopyFluxes        leaf temperature and surface fluxes for vegetated
!                         patches
!     -> QSat             saturated vapor pressure, specific humidity, &
!                         derivatives at leaf surface
!     -> MoninObukIni     first-guess Monin-Obukhov length and wind speed
!     -> FrictionVelocity friction velocity and potential temperature and
!                         humidity profiles
!     -> Stomata          stomatal resistance and photosynthesis for
!                         sunlit leaves
!     -> Stomata          stomatal resistance and photosynthesis for
!                         shaded leaves
!     -> QSat             recalculation of saturated vapor pressure,
!                         specific humidity, & derivatives at leaf surface
!  -> Biogeophysics_Lake  lake temperature and surface fluxes
!   + VOCEmission         compute VOC emission [VOC]
!   + DGVMRespiration     CO2 respriation and plant production [DGVM]
!   + DGVMEcosystemDyn    DGVM ecosystem dynamics: vegetation phenology [!DGVM]
!  -> EcosystemDyn        "static" ecosystem dynamics: vegetation phenology
!                         and soil carbon [!DGVM]
!  -> SurfaceAlbedo       albedos for next time step
!  -> Biogeophysics2      soil/snow & ground temp and update surface fluxes
!  -> pft2col             Average from PFT level to column level
!  ====  End Loop 1 over clumps  ====
! * Average fluxes over time interval and send to flux coupler [COUP_CSM]
!  ==== Begin Loop 2 over clumps ====
!  -> Hydrology2          surface and soil hydrology
!  -> Hydrology_Lake      lake hydrology
!  -> SnowAge             update snow age for surface albedo calcualtion
!  -> BalanceCheck        check for errors in energy and water balances
!  ====  End Loop 2 over clumps  ====
!  -> write_diagnostic    output diagnostic if appropriate
!   + Rtmriverflux        calls RTM river routing model [RTM]
!  -> updateAccFlds       update accumulated fields
!  -> update_hbuf         accumulate history fields for time interval
!  Begin DGVM calculations at end of model year [DGVM]
!    ==== Begin Loop over clumps ====
!     + lpj                 LPJ ecosystem dynamics: reproduction, turnover,
!                           kill, allocation, light, mortality, fire
!     + lpjreset1           reset variables & initialize for next year
!    ====  End Loop over clumps  ====
!  End DGVM calculations at end of model year [DGVM]
!  -> htapes_wrapup       write history tapes if appropriate
!  Begin DGVM calculations at end of model year [DGVM]
!    ==== Begin Loop over clumps ====
!     + lpjreset2           reset variables and patch weights
!    ====  End Loop over clumps  ====
!  End DGVM calculations at end of model year [DGVM]
!  -> restart             write restart file if appropriate
!  -> inicfile            write initial file if appropriate
! \end{verbatim}
! Optional subroutines are denoted by an plus (+) with the associated
! CPP variable in brackets at the end of the line.  Coupler communication
! when coupled with CCSM components is denoted by an asterisk (*).
!
! !USES:
  use shr_kind_mod, only: r8 => shr_kind_r8
  use globals  
  use clmtype
!ylu add new from CLM4
!  use clm_varctl          , only : fpftdyn, fndepdyn !ylu removed wrtdia
  use decompMod           , only : get_proc_bounds
  use filterMod           , only : filter
#if (defined CNDV)
  use CNDVMod             , only : dv, histCNDV
  use pftdynMod           , only : pftwt_interp
#endif
  use pftdynMod           , only : pftdyn_interp, pftdyn_wbal_init, pftdyn_wbal
#ifdef CN
  use pftdynMod           , only : pftdyn_cnbal
#endif
  use dynlandMod          , only : dynland_hwcontent
  use clm_varcon          , only : set_caerdep_from_file,set_dustdep_from_file,zlnd, isturb, fpftdyn, fndepdyn !move  fpftdyn, fndepdyn to clm_varcon.F
  use DriverInitMod       , only : DriverInit
  use BalanceCheckMod     , only : BalanceCheck, BeginWaterBalance
  use SurfaceRadiationMod , only : SurfaceRadiation
  use Hydrology1Mod       , only : Hydrology1
  use Hydrology2Mod       , only : Hydrology2
  use HydrologyLakeMod    , only : HydrologyLake
  use Biogeophysics1Mod   , only : Biogeophysics1
  use BareGroundFluxesMod , only : BareGroundFluxes
  use CanopyFluxesMod     , only : CanopyFluxes
  use Biogeophysics2Mod   , only : Biogeophysics2
  use BiogeophysicsLakeMod, only : BiogeophysicsLake
  use SurfaceAlbedoMod    , only : SurfaceAlbedo
  use pft2colMod          , only : pft2col
!  use accFldsMod          , only : updateAccFlds
!  use accumulMod          , only : accum_dealloc

#if (defined CN)
!ylu begin 1
  use pftdynMod           , only : pftdyn_cnbal
  use CNSetValueMod       , only : CNZeroFluxes_dwt
  use CNEcosystemDynMod   , only : CNEcosystemDyn
  use CNAnnualUpdateMod   , only : CNAnnualUpdate
  use CNBalanceCheckMod   , only : BeginCBalance, BeginNBalance, &
                                   CBalanceCheck, NBalanceCheck
! use ndepFileMod         , only : ndepdyn_interp !ndep data will be passed from module_surface_driver.F
#else
  use STATICEcosysDynMod  , only : EcosystemDyn, interpMonthlyVeg, EcosystemDyn_dealloc
!ylu end 1
#endif

#if (defined DUST)
  use DUSTMod             , only : DustDryDep, DustEmission
#endif
  use VOCEmissionMod      , only : VOCEmission
!  use DryDepVelocity      , only : depvel_compute   !may need add later ylu
#if (defined CASA)
  use CASAMod             , only : Casa_ecosystemDyn
#endif
#if (defined RTM)
  use RtmMod              , only : Rtmriverflux
#endif
!  use UrbanMod            , only : UrbanAlbedo, UrbanRadiation, UrbanFluxes
  use SNICARMod           , only : SnowAge_grain
  use aerdepMod           , only : interpMonthlyAerdep
  


!
! !ARGUMENTS:
  implicit none
  logical , intent(in) :: doalb  !true if time for surface albedo
                                 !calculation
!
! !REVISION HISTORY:
! 2002.10.01  Mariana Vertenstein latest update to new data structures
!
!EOP
!
! !LOCAL VARIABLES:
! local pointers to implicit in arguments
!
  integer , pointer :: clandunit(:) ! landunit index associated with each column
  integer , pointer :: itypelun(:)  ! landunit type
!
! !OTHER LOCAL VARIABLES:


  integer  :: ilx,jlx
  integer  :: c,g,l         ! indices
  integer  :: ncdate        ! current date
  integer  :: kyr           ! thousand years, equals 2 at end of first year
  integer  :: begp, endp    ! clump beginning and ending pft indices
  integer  :: begc, endc    ! clump beginning and ending column indices
  integer  :: begl, endl    ! clump beginning and ending landunit indices
  integer  :: begg, endg    ! clump beginning and ending gridcell indices
  type(column_type)  , pointer :: cptr    ! pointer to column derived subtype
! logical, external :: do_restwrite ! determine if time to write restart
  real(r8), intent(in) :: nextsw_cday                   ! calendar day at Greenwich (1.00, ..., 365.99)
  real(r8), intent(in) :: declinp1                   ! declination angle (radians) for next time step
  real(r8), intent(in) :: declin      ! declination angle for current time step

!temp value
  real(r8), pointer :: t_soisno(:,:)

      t_soisno      => clm3%g%l%c%ces%t_soisno


!-----------------------------------------------------------------------
  ! Assign local pointers to derived subtypes components (landunit-level)

  itypelun            => clm3%g%l%itype

  ! Assign local pointers to derived subtypes components (column-level)

  clandunit           => clm3%g%l%c%landunit

  ! Set pointers into derived type

  cptr => clm3%g%l%c

  ! ============================================================================
  ! Calendar information for next time step
  ! o caldayp1 = calendar day (1.00 -> 365.99) for cosine solar zenith angle
  !   calday is based on Greenwich time
  ! o get_curr_calday in the cam time manager know about perpetual mode
  !   and perpetual model is only used within cam
  ! ============================================================================

#if (!defined CN)
  ! ============================================================================
  ! Determine weights for time interpolation of monthly vegetation data.
  ! This also determines whether it is time to read new monthly vegetation and
  ! obtain updated leaf area index [mlai1,mlai2], stem area index [msai1,msai2],
  ! vegetation top [mhvt1,mhvt2] and vegetation bottom [mhvb1,mhvb2]. The
  ! weights obtained here are used in subroutine ecosystemdyn to obtain time
  ! interpolated values.
  ! ============================================================================

  if (doalb) call interpMonthlyVeg (monp1,dayp1)  !STATICEcosysDynMod.F
#endif

  ! ============================================================================
  ! interpolate aerosol deposition data, and read in new monthly data if need be.
  ! ============================================================================
  if ( (set_caerdep_from_file) .or. (set_dustdep_from_file) ) then
     call interpMonthlyAerdep(monp1,dayp1)
  endif



  ! ============================================================================
  ! Loop1
  ! ============================================================================

     ! ============================================================================
     ! Determine clump boundaries
     ! ============================================================================

     call get_proc_bounds(begg, endg, begl, endl, begc, endc, begp, endp)  !decompMod.F


     ! ============================================================================
     ! change pft weights and compute associated heat & water fluxes
     ! ============================================================================


!ylu add new in clm_driver.F for CLM4 10-22-2010
     do g = begg,endg
        clm3%g%gwf%qflx_liq_dynbal(g) = 0._r8
        clm3%g%gws%gc_liq2(g)         = 0._r8
        clm3%g%gws%gc_liq1(g)         = 0._r8
        clm3%g%gwf%qflx_ice_dynbal(g) = 0._r8
        clm3%g%gws%gc_ice2(g)         = 0._r8
        clm3%g%gws%gc_ice1(g)         = 0._r8
        clm3%g%gef%eflx_dynbal(g)     = 0._r8
        clm3%g%ges%gc_heat2(g)        = 0._r8
        clm3%g%ges%gc_heat1(g)        = 0._r8
     enddo

     !--- get initial heat,water content ---
      call dynland_hwcontent( begg, endg, clm3%g%gws%gc_liq1(begg:endg), &   !dynlandMod.F
                              clm3%g%gws%gc_ice1(begg:endg), clm3%g%ges%gc_heat1(begg:endg) )

!#if (!defined CNDV)
!   if (fpftdyn /= ' ') then
!      call pftdyn_interp  ! change the pft weights
! 
! !DESCRIPTION:
! Time interpolate dynamic landuse data to get pft weights for model time
! Note that harvest data are stored as rates (not weights) and so time interpolation is 
! not necessary - the harvest rate is held constant through the year.  This is consistent with
! the treatment of changing PFT weights, where interpolation of the annual endpoint weights leads to 
! a constant rate of change in PFT weight through the year, with abrupt changes in the rate at
! annual boundaries. This routine is still used to get the next harvest time slice, when needed.
! This routine is also used to turn off the harvest switch when the model year runs past the end of
! the dynpft time series.
!





     call CLMDebug('BeginWaterBalance')
     call BeginWaterBalance(begc, endc, begp, endp, &
          filter%num_nolakec, filter%nolakec, filter%num_lakec, filter%lakec, &
          filter%num_hydrologyc, filter%hydrologyc)

!ylu begin 2
#if (defined CN)
!call t_startf('begcnbal')
     call CLMDebug('BeginCBalance') 
     call BeginCBalance(begc, endc, filter%num_soilc, filter%soilc)  !CNBalanceCheckMod.F
     call CLMDebug('BeginNBalance')
     call BeginNBalance(begc, endc, filter%num_soilc, filter%soilc)  !CNBalanceCheckMod.F
!     call t_stopf('begcnbal')
#endif

!Leaving out pftdyn_wbal_init and canopy water loss

!!!!!!!!
  call CLMDebug('pftdyn_wbal_init')
  call pftdyn_wbal_init()                                            !pftdynMod.F

#if (defined CNDV)
! if (doalb) then ! Currently CNDV and fpftdyn /= ' ' are incompatible
     call CLMDebug('Begin CNZeroFluxes')
     call CNZeroFluxes_dwt()                                         !CNSetValueMod.F
     call CLMDebug('Begin pftwt_interp')
     call pftwt_interp()                                             !pftdynMod.F 
     call CLMDebug('Begin pftdyn_wbal')
     call pftdyn_wbal( begg, endg, begc, endc, begp, endp )          !pftdynMod.F
     call CLMDebug('Begin pftdyn_cnbal')
     call pftdyn_cnbal()                                             !pftdynMod.F
     call CLMDebug('Begin setFilters')
     call setFilters()
! end if
#else
  ! ============================================================================
  ! Update weights and reset filters if dynamic land use
  ! This needs to be done outside the clumps loop, but after BeginWaterBalance()
  ! The call to CNZeroFluxes_dwt() is needed regardless of fpftdyn
  ! ============================================================================

!#if (defined CN)
!   call CLMDebug('Begin CNZeroFluxes')
!   call CNZeroFluxes_dwt()               !CNSetValueMod.F
!#endif

   if (fpftdyn /= ' ') then
#if (defined CN)
     call CLMDebug('Begin pftdyn_cnbal')
     call pftdyn_cnbal()                 !pftdynMod.F
#endif
                   
   end if
#endif


!#if (defined CN)
  ! ============================================================================
  ! Update dynamic N deposition field, on albedo timestep 
  ! currently being done outside clumps loop, but no reason why it couldn't be
  ! re-written to go inside.
  ! ============================================================================
! PET: switching CN timestep
!  if (fndepdyn /= ' ') then
!     call ndepdyn_interp()   !ndepFileMod.F not finish, need to modify the part read nitrogen deposition data.
!  end if
!#endif       

!ylu end

     ! ============================================================================
     ! Initialize variables from previous time step and
     ! Determine canopy interception and precipitation onto ground surface.
     ! Determine the fraction of foliage covered by water and the fraction
     ! of foliage that is dry and transpiring. Initialize snow layer if the
     ! snow accumulation exceeds 10 mm.
     ! ============================================================================
!ylu add from CLM4
!       call get_clump_bounds(nc, begg, endg, begl, endl, begc, endc, begp, endp)
 

!      do c = begc,endc
!        clm3%g%l%c%cps%decl(c) = declin
!      end do
!ylu end

!ylu add
     ! initialize declination for current timestep
     do c = begc,endc
        clm3%g%l%c%cps%decl(c) = declin
     end do
!!

     call CLMDebug('DriverInit')  !This module was not changed in CLM4
     call DriverInit(begc, endc, begp, endp, &
          filter%num_nolakec, filter%nolakec, &
          filter%num_lakec, filter%lakec)

     ! ============================================================================
     ! Hydrology1
     ! ============================================================================

     call CLMDebug('Hydrology1')  !checked and modified according to CLM4
     call Hydrology1(begc, endc, begp, endp, &
                     filter%num_nolakec, filter%nolakec, &
                     filter%num_nolakep, filter%nolakep)

     ! ============================================================================
     ! Surface Radiation
     ! ============================================================================

     call CLMDebug('SurfaceRadiation') !checked and modified according to CLM4
     call SurfaceRadiation(begp, endp, filter%num_nourbanp, filter%nourbanp)


!ylu add  urban module from CLM4
!     call CLMDebug('UrbanRadiation')  ! added the new module from CLM4
!     call UrbanRadiation(begl, endl, begc, endc, begp, endp, &
!                         filter%num_nourbanl, filter%nourbanl, &
!                         filter%num_urbanl, filter%urbanl, &
!                         filter%num_urbanc, filter%urbanc, &
!                         filter%num_urbanp, filter%urbanp)

     ! ============================================================================
     ! Determine leaf temperature and surface fluxes based on ground
     ! temperature from previous time step.
     ! ============================================================================

     call CLMDebug('Biogeophysics1') !checked and modified according to CLM4
     call Biogeophysics1(begg, endg, begc, endc, begp, endp, &
                         filter%num_nolakec, filter%nolakec, &
                         filter%num_nolakep, filter%nolakep)

     ! ============================================================================
     ! Determine bare soil or snow-covered vegetation surface temperature and fluxes
     ! Calculate Ground fluxes (frac_veg_nosno is either 1 or 0)
     ! ============================================================================

     call CLMDebug('BareGroundFluxes')  !checked and modified according to CLM4
     call BareGroundFluxes(begp, endp, &
                           filter%num_nolakeurbanp, filter%nolakeurbanp)
     ! ============================================================================
     ! Determine non snow-covered vegetation surface temperature and fluxes
     ! Calculate canopy temperature, latent and sensible fluxes from the canopy,
     ! and leaf water change by evapotranspiration
     ! ============================================================================

!ylu add from CLM4
!     call CLMDebug('UrbanFluxes')  ! added the new module from CLM4
!        call UrbanFluxes(begp, endp, begl, endl, begc, endc, &
!                      filter%num_nourbanl, filter%nourbanl, &
!                      filter%num_urbanl, filter%urbanl, &
!                      filter%num_urbanc, filter%urbanc, &
!                      filter%num_urbanp, filter%urbanp)
!end




     call CLMDebug('CanopyFluxes')  !checked and modified according to CLM4
     call CanopyFluxes(begg, endg, begc, endc, begp, endp, &
                       filter%num_nolakep, filter%nolakep)
     ! ============================================================================
     ! Determine lake temperature and surface fluxes
     ! ============================================================================

     call CLMDebug('BiogeophysicsLake')   !checked and modified according to CLM4
     call BiogeophysicsLake(begc, endc, begp, endp, &
                            filter%num_lakec, filter%lakec, &
                            filter%num_lakep, filter%lakep)

#if (defined DUST)
     ! Dust mobilization (C. Zender's modified codes)
     call DustEmission(begp, endp, begc, endc, begl, endl, & ! added the new module from CLM4
                       filter%num_nolakep, filter%nolakep)

     ! Dust dry deposition (C. Zender's modified codes)
     call DustDryDep(begp, endp)    ! added the new module from CLM4
#endif
!!!!!!!!!!!!!!

     ! ============================================================================
     ! Determine VOC and DGVM Respiration if appropriate
     ! ============================================================================
!ylu add: VOC used in CLM4 as a defaul
!#if (defined VOC)
     ! VOC emission (A. Guenther's model)
!     call VOCEmission(begp, endp, &
!                      filter%num_nolakep, filter%nolakep)      !CLM3.5
     call CLMDebug('Begin VOCEmission')
   call VOCEmission(begp, endp, &  
                      filter%num_soilp, filter%soilp)   !CLM4  !checked and modified according to CLM4
!#endif

     ! ============================================================================
     ! Ecosystem dynamics: phenology, vegetation, soil carbon, snow fraction
     ! ============================================================================

!#if (defined DGVM)
     ! Surface biogeochemical fluxes: co2 respiration and plant production
!     call DGVMRespiration(begc, endc, begp, endp, &
!                          filter%num_nolakec, filter%nolakec, &
!                          filter%num_nolakep, filter%nolakep)

!     call DGVMEcosystemDyn(begp, endp, &
!                       filter%num_nolakep, filter%nolakep, &
!                       doalb, endofyr=.false.)
!#elif call CNEcosystemDyn
!#else
!     call CLMDebug('EcosystemDyn')
!     call EcosystemDyn(begp, endp, &
!                       filter%num_nolakep, filter%nolakep, &
!                       doalb)
!#endif

     ! ============================================================================
     ! Determine albedos for next time step
     ! ============================================================================

!     if (doalb) then
!        call CLMDebug('SurfaceAlbedo')
!        call SurfaceAlbedo(begg, endg, begc, endc, begp, endp, caldayp1)
!     end if

     ! ============================================================================
     ! Determine soil/snow temperatures including ground temperature and
     ! update surface fluxes for new ground temperature.
     ! ============================================================================

     call CLMDebug('Biogeophysics2')
!     call Biogeophysics2(begc, endc, begp, endp, &
!                         filter%num_nolakec, filter%nolakec, &
!                         filter%num_nolakep, filter%nolakep)      !CLM3.5
   call Biogeophysics2(begl, endl, begc, endc, begp, endp, &
                         filter%num_urbanl,  filter%urbanl, &
                         filter%num_nolakec, filter%nolakec, &
                         filter%num_nolakep, filter%nolakep)   !changed according to CLM4


     ! ============================================================================
     ! Perform averaging from PFT level to column level
     ! ============================================================================

     call CLMDebug('pft2col')     !changed according to CLM4
     call pft2col(begc, endc, filter%num_nolakec, filter%nolakec)




     ! ============================================================================
     ! Vertical (column) soil and surface hydrology
     ! ============================================================================

     call CLMDebug('Hydrology2')
!CLM4 -- ylu changed
     call Hydrology2(begc, endc, begp, endp, &
                     filter%num_nolakec, filter%nolakec, &
                     filter%num_hydrologyc, filter%hydrologyc, &
                     filter%num_urbanc, filter%urbanc, &
                     filter%num_snowc, filter%snowc, &
                     filter%num_nosnowc, filter%nosnowc)

!     call Hydrology2(begc, endc, ilx ,jlx, &
!New in 3.5

!                     begp, endp, &
!                     filter%num_nolakec, filter%nolakec, &
!                     filter%num_soilc, filter%soilc, &
!                     filter%num_snowc, filter%snowc, &
!                     filter%num_nosnowc, filter%nosnowc)

     ! ============================================================================
     ! Lake hydrology
     ! ============================================================================

     call CLMDebug('HydrologyLake')  !ylu modified according to CLM4
     call HydrologyLake(begp, endp, &
                        filter%num_lakep, filter%lakep)

     ! ============================================================================
     ! Update Snow Age (needed for surface albedo calculation
     ! ============================================================================
!ylu add new from CLM4
     ! ============================================================================
     ! ! Fraction of soil covered by snow (Z.-L. Yang U. Texas)
     ! ============================================================================

     do c = begc,endc
        l = clandunit(c)
        if (itypelun(l) == isturb) then
           ! Urban landunit use Bonan 1996 (LSM Technical Note)
           cptr%cps%frac_sno(c) = min( cptr%cps%snowdp(c)/0.05_r8, 1._r8)
        else
           ! snow cover fraction in Niu et al. 2007
           cptr%cps%frac_sno(c) = 0.0_r8
           if(cptr%cps%snowdp(c) .gt. 0.0_r8)  then
             cptr%cps%frac_sno(c) = tanh(cptr%cps%snowdp(c)/(2.5_r8*zlnd* &
               (min(800._r8,cptr%cws%h2osno(c)/cptr%cps%snowdp(c))/100._r8)**1._r8) )
           endif
        end if
     end do

     ! ============================================================================
     ! Snow aging routine based on Flanner and Zender (2006), Linking snowpack 
     ! microphysics and albedo evolution, JGR, and Brun (1989), Investigation of 
     ! wet-snow metamorphism in respect of liquid-water content, Ann. Glaciol.
     ! ============================================================================
!     call CLMDebug('Begin SnowAge_grain')
!    call SnowAge_grain(begc, endc, &         !SNICARMod.F new module in CLM4 -- ylu
!          filter%num_snowc, filter%snowc, &
!          filter%num_nosnowc, filter%nosnowc)

     call CLMDebug('SnowAge_grain')
     call SnowAge_grain(begc, endc, &
          filter%num_snowc, filter%snowc, &
          filter%num_nosnowc, filter%nosnowc)

!     call SnowAge(begc, endc)

     ! ============================================================================
     ! ! Fraction of soil covered by snow (Z.-L. Yang U. Texas)
     ! ============================================================================

!     do c = begc,endc
!        cptr%cps%frac_sno(c) = cptr%cps%snowdp(c) / (10.*zlnd + cptr%cps%snowdp(c))
!     end do

!Added for CLM3.5
     ! ============================================================================
     ! Ecosystem dynamics: Uses CN, DGVM, or static parameterizations
     ! ============================================================================
!ylu begin 3
#if (defined CN)
     ! fully prognostic canopy structure and C-N biogeochemistry
     ! - CNDV defined: prognostic biogeography; else prescribed
     ! - CROP defined: crop algorithms called from within CNEcosystemDyn
#if (defined CROP)
!ylu change filter(nc) to filter
     call CLMDebug('Begin CNEcosystemDyn')  
    call CNEcosystemDyn(begc,endc,begp,endp,filter%num_soilc,&  !Checked and looks right so far --Yaqiong Lu 11/09/10
                  filter%soilc, filter%num_soilp, &
                  filter%soilp, filter%num_pcropp, &
                  filter%pcropp, doalb)
#else
     call CNEcosystemDyn(begc,endc,begp,endp,filter%num_soilc,&
                  filter%soilc, filter%num_soilp, &
                  filter%soilp, doalb)
#endif
     call CLMDebug('Begin CNAnnualUpdate')
     call CNAnnualUpdate(begc,endc,begp,endp,filter%num_soilc,&  !Add the new code from CLM4 --Yaqiong Lu 11/04/2010
                  filter%soilc, filter%num_soilp, &
                  filter%soilp)
!the CASA option is not currently used in the coupled model
#elif (defined CASA)  
     ! Prescribed biogeography,  
     ! prescribed canopy structure, some prognostic carbon fluxes
     call casa_ecosystemDyn(begc, endc, begp, endp, &
               filter%num_soilc, filter%soilc, &
               filter%num_soilp, filter%soilp, doalb)
     call EcosystemDyn(begp, endp, &
                       filter%num_nolakep, filter%nolakep, &
                       doalb)
#else
     ! Prescribed biogeography,
     ! prescribed canopy structure, some prognostic carbon fluxes
     ! The coupled model will use CN option, so this code is not add into our coupled model
     call CLMDebug('Begin EcosystemDyn')
     call EcosystemDyn(begp, endp, &                         
                       filter%num_nolakep, filter%nolakep, &
                       doalb)
#endif


     ! Dry Deposition of chemical tracers (Wesely (1998) parameterizaion)
!     call depvel_compute(begp,endp)


!ylu end 3



     ! ============================================================================
     ! Check the energy and water balance
     ! ============================================================================

     call CLMDebug('BalanceCheck')   !Yaqiong Lu add this new code from CLM4
     call BalanceCheck(begp, endp, begc, endc, begl, endl, begg, endg)


!ylu add
#if (defined CN)
!     nstep = get_nstep()
     if (nstep > 2) then
!        call t_startf('cnbalchk')
       call CLMDebug('CBalanceCheck')
        call CBalanceCheck(begc, endc, filter%num_soilc, filter%soilc)
       call CLMDebug('NBalanceCheck')
        call NBalanceCheck(begc, endc, filter%num_soilc, filter%soilc)
!        call t_stopf('cnbalchk')
     end if
#endif
!end add

     ! ============================================================================
     ! Update accumulators
     ! ============================================================================



    if (doalb) then

        ! Albedos for non-urban columns
        call CLMDebug('SurfaceAlbedo')  !checed and modified accoring to CLM4 --ylu
        call SurfaceAlbedo(begg, endg, begc, endc, begp, endp, &
                           filter%num_nourbanc, filter%nourbanc, &
                           filter%num_nourbanp, filter%nourbanp,nextsw_cday ,declinp1)


        ! Albedos for urban columns

!        if (filter%num_urbanl > 0) then
!           call CLMDebug('UrbanAlbedo')  !Yaqiong Lu add this new code from CLM4
!           call UrbanAlbedo(begl, endl, begc, endc, begp, endp,   &
!                            filter%num_urbanl, filter%urbanl, &
!                            filter%num_urbanc, filter%urbanc, &
!                            filter%num_urbanp, filter%urbanp)
!        end if

     end if

!     call CLMDebug('updateAccFlds')
!    call updateAccFlds()


!  call accum_dealloc
!  call filters_dealloc
#if (!defined CN)
  call EcosystemDyn_dealloc
#endif



end subroutine driver
