module VOCEmissionMod

!-----------------------------------------------------------------------
!BOP
!
! !MODULE: VOCEmissionMod
!
! !DESCRIPTION:
! Volatile organic compound emission
!
! !USES:
  use shr_kind_mod, only : r8 => shr_kind_r8
  use clm_varctl,   only : iulog
  use abortutils,   only : endrun
  use clm_varpar,   only : numpft
  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,    nc3crop,               &
                           nc4_grass,           noveg

  use shr_megan_mod,  only : shr_megan_megcomps_n, shr_megan_megcomp_t, shr_megan_linkedlist
  use shr_megan_mod,  only : shr_megan_mechcomps_n, shr_megan_mechcomps, shr_megan_mapped_emisfctrs
  use MEGANFactorsMod,only : Agro, Amat, Anew, Aold, betaT, ct1, ct2, LDF, Ceo

!
! !PUBLIC TYPES:
  implicit none
  save

  logical, parameter :: debug = .false.

!
!
! !PUBLIC MEMBER FUNCTIONS:
  public :: VOCEmission
  public :: VOCEmission_init
!
! !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
! MEGAN (Model of Emissions of Gases and Aerosols from Nature) v2.1 
! for 20 compound classes. The original description of this
! algorithm (for isoprene only) can be found in Guenther et al., 2006
! (we follow equations 2-9, 16-17, 20 for explicit canopy).
! The model scheme came be described as:
!    E= epsilon * gamma * rho
! VOC flux (E) [ug m-2 h-1] is calculated from baseline emission
! factors (epsilon) [ug m-2 h-1] which are specified for each of the 16
! CLM PFTs (in input file) OR in the case of isoprene, from
! mapped EFs for each PFT which reflect species divergence of emissions,
! particularly in North America. 
! The emission activity factor (gamma) [unitless] for includes 
! dependence on PPFT, temperature, LAI, leaf age and soil moisture.
! For isoprene only we also include the effect of CO2 inhibition as
! described by Heald et al., 2009. 
! The canopy environment constant was calculated offline for CLM+CAM at 
! standard conditions.
! We assume that the escape efficiency (rho) here is unity following
! Guenther et al., 2006.
! A manuscript describing MEGAN 2.1 and the implementation in CLM is
! in preparation: Guenther, Heald et al., 2012
! Subroutine written to operate at the patch level.
!
! Input: <filename> to be read in with EFs and some parameters.  
!        Currently these are set in procedure init_EF_params
! Output: vocflx(shr_megan_mechcomps_n) !VOC flux [moles/m2/sec]
!
!
! !USES:
    use shr_kind_mod , only : r8 => shr_kind_r8
    use clm_atmlnd   , only : clm_a2l
    use clmtype,       only : clm3, megan_out_type
    use domainMod,     only : ldomain 
    use clm_varcon   , only : spval
!
! !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)
! 4/29/11: Colette L. Heald: expand MEGAN to 20 compound classes
! 7 Feb 2012: Francis Vitt: Implemented capability to specify MEGAN emissions in namelist
!                           and read in MEGAN factors from file.
!
! !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 :: landfrac(:)      ! fraction of gridbox that is land
    real(r8), pointer :: forc_solad(:,:)  ! direct beam radiation (visible only)
    real(r8), pointer :: forc_solai(:,:)  ! diffuse radiation     (visible only)
    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 :: 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 :: 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), pointer :: cisun(:)         ! sunlit intracellular CO2 (Pa)
    real(r8), pointer :: cisha(:)         ! shaded intracellular CO2 (Pa)
    real(r8), pointer :: forc_pbot(:)     ! atmospheric pressure (Pa)
!
! local pointers to original implicit out arrays
!
    real(r8), pointer :: vocflx(:,:)      ! VOC flux [moles/m2/sec]
    real(r8), pointer :: vocflx_tot(:)    ! VOC flux [moles/m2/sec]

    type(megan_out_type), pointer :: meg_out(:) ! fluxes for CLM history 

    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(:)
    real(r8), pointer :: gammaC_out(:)

    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(:)

!
!
! !OTHER LOCAL VARIABLES:
!
    integer  :: fp,p,g,c                ! indices
    real(r8) :: epsilon                 ! emission factor [ug m-2 h-1]
    real(r8) :: par_sun                 ! temporary
    real(r8) :: par24_sun               ! temporary
    real(r8) :: par240_sun              ! temporary
    real(r8) :: par_sha                 ! temporary
    real(r8) :: par24_sha               ! temporary
    real(r8) :: par240_sha              ! temporary
    real(r8) :: gamma                   ! 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) :: gamma_c                 ! activity factor for CO2 (only isoprene)
    
    integer :: class_num, n_meg_comps, imech, imeg, ii
    character(len=16) :: mech_name

    real(r8) :: vocflx_meg(shr_megan_megcomps_n)
    type(shr_megan_megcomp_t), pointer :: meg_cmp

    real(r8) :: cp, alpha,  Eopt, topt  ! for history output

    ! factor used convert MEGAN units [micro-grams/m2/hr] to CAM srf emis units [g/m2/sec]
    real(r8), parameter :: megemis_units_factor = 1._r8/3600._r8/1.e6_r8

!    real(r8) :: root_depth(0:numpft)    ! Root depth [m]
!
!!-----------------------------------------------------------------------
!
!    ! root depth (m) (defined based on Zeng et al., 2001, cf Guenther 2006)
!    root_depth(noveg)                                     = 0._r8   ! bare-soil
!    root_depth(ndllf_evr_tmp_tree:ndllf_evr_brl_tree)     = 1.8_r8  ! evergreen tree
!    root_depth(ndllf_dcd_brl_tree)                        = 2.0_r8  ! needleleaf deciduous boreal tree
!    root_depth(nbrdlf_evr_trp_tree:nbrdlf_evr_tmp_tree)   = 3.0_r8  ! broadleaf evergreen tree
!    root_depth(nbrdlf_dcd_trp_tree:nbrdlf_dcd_brl_tree)   = 2.0_r8  ! broadleaf deciduous tree
!    root_depth(nbrdlf_evr_shrub:nbrdlf_dcd_brl_shrub)     = 2.5_r8  ! shrub
!    root_depth(nc3_arctic_grass:numpft)                   = 1.5_r8  ! grass/crop
!
!-----------------------------------------------------------------------
    if ( shr_megan_mechcomps_n < 1) return

    ! Assign local pointers to derived type members (gridcell-level)
    forc_solad => clm_a2l%forc_solad
    forc_solai => clm_a2l%forc_solai
    forc_pbot  => clm_a2l%forc_pbot

    ! 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
    landfrac         => ldomain%frac 

    cisun            => clm3%g%l%c%p%pps%cisun
    cisha            => clm3%g%l%c%p%pps%cisha

    vocflx           => clm3%g%l%c%p%pvf%vocflx
    vocflx_tot       => clm3%g%l%c%p%pvf%vocflx_tot
    meg_out          => clm3%g%l%c%p%pvf%meg

    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
    gammaC_out       => clm3%g%l%c%p%pvf%gammaC_out
    gamma_out        => clm3%g%l%c%p%pvf%gamma_out

    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

    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

    ! initialize variables which get passed to the atmosphere
    vocflx(lbp:ubp,:) = 0._r8
    vocflx_tot(lbp:ubp) = 0._r8

    do imeg=1,shr_megan_megcomps_n
      meg_out(imeg)%flux_out(lbp:ubp) = 0._r8
    enddo
    
    gamma_out(lbp:ubp) = spval
    gammaP_out(lbp:ubp) = spval
    gammaT_out(lbp:ubp) = spval
    gammaA_out(lbp:ubp) = spval
    gammaS_out(lbp:ubp) = spval
    gammaL_out(lbp:ubp) = spval
    gammaC_out(lbp:ubp) = spval

    paru_out(lbp:ubp) = spval
    par24u_out(lbp:ubp) = spval
    par240u_out(lbp:ubp) = spval

    para_out(lbp:ubp) = spval
    par24a_out(lbp:ubp) = spval
    par240a_out(lbp:ubp) = spval

    alpha_out(lbp:ubp) = spval
    cp_out(lbp:ubp) = spval

    topt_out(lbp:ubp) = spval
    Eopt_out(lbp:ubp) = spval

    ! Begin loop over points
    !_______________________________________________________________________________
    do fp = 1,num_soilp
       p = filter_soilp(fp)
       g = pgridcell(p)
       c = pcolumn(p)

       ! initialize EF
       epsilon=0._r8

       ! calculate VOC emissions for non-bare ground PFTs
       if (ivt(p) > 0) then 
          gamma=0._r8

          ! Calculate PAR: multiply w/m2 by 4.6 to get umol/m2/s for par (added 8/14/02)
          !------------------------
          ! SUN:
          par_sun = (forc_solad(g,1) + fsun(p) * forc_solai(g,1)) * 4.6_r8
          par24_sun = (forc_solad24(p) + fsun24(p) * forc_solai24(p)) * 4.6_r8
          par240_sun = (forc_solad240(p) + fsun240(p) * forc_solai240(p)) * 4.6_r8
          ! SHADE:
          par_sha = ((1._r8 - fsun(p)) * forc_solai(g,1)) * 4.6_r8
          par24_sha = ((1._r8 - fsun24(p)) * forc_solai24(p)) * 4.6_r8
          par240_sha = ((1._r8 - fsun240(p)) * forc_solai240(p)) * 4.6_r8

          ! Activity factor for LAI (Guenther et al., 2006): all species
          gamma_l = get_gamma_L(fsun240(p), elai(p))

          ! Activity factor for soil moisture: all species (commented out for now)
!          gamma_sm = get_gamma_SM(clayfrac(p), sandfrac(p), h2osoi_vol(c,:), h2osoi_ice(c,:), &
!               dz(c,:), bsw(c,:), watsat(c,:), sucsat(c,:), root_depth(ivt(p)))
          gamma_sm = 1.0_r8

          ! Loop through VOCs for light, temperature and leaf age activity factor & apply
          ! all final activity factors to baseline emission factors
          !_______________________________________________________________________________

          ! loop over megan compounds
          meg_cmp => shr_megan_linkedlist
          meg_cmp_loop: do while(associated(meg_cmp))
             imeg = meg_cmp%index

             ! set emis factor
             ! if specified, set EF for isoprene with mapped values
             if ( trim(meg_cmp%name) == 'isoprene' .and. shr_megan_mapped_emisfctrs) then
                epsilon = get_map_EF(ivt(p),g)
             else
                epsilon = meg_cmp%emis_factors(ivt(p))
             end if

             class_num = meg_cmp%class_number

             ! Activity factor for PPFD
             gamma_p = get_gamma_P(par_sun, par24_sun, par240_sun, par_sha, par24_sha, par240_sha, &
                  fsun(p), fsun240(p), forc_solad240(p),forc_solai240(p), LDF(class_num), cp, alpha)

             ! Activity factor for T
             gamma_t = get_gamma_T(t_veg240(p), t_veg24(p),t_veg(p), ct1(class_num), ct2(class_num),&
                                   betaT(class_num),LDF(class_num), Ceo(class_num), Eopt, topt)

             ! Activity factor for Leaf Age
             gamma_a = get_gamma_A(ivt(p), elai_p(p),elai(p),class_num)

             ! Activity factor for CO2 (only for isoprene)
             if (trim(meg_cmp%name) == 'isoprene') then 
                gamma_c = get_gamma_C(cisun(p),cisha(p),forc_pbot(g),fsun(p))
             else
                gamma_c = 1._r8
             end if

             ! Calculate total scaling factor
             gamma = gamma_l * gamma_sm * gamma_a * gamma_p * gamma_T * gamma_c

             if ( (gamma >=0.0_r8) .and. (gamma< 100._r8) ) then

                vocflx_meg(imeg) = epsilon * gamma * megemis_units_factor / meg_cmp%molec_weight ! moles/m2/sec

                ! assign to arrays for history file output (normalize to landfrac area 
                ! so that get emissions right at the coast)
                meg_out(imeg)%flux_out(p) = meg_out(imeg)%flux_out(p) &
                                          + epsilon * gamma * megemis_units_factor*landfrac(g)*1.e-3_r8 ! Kg/m2/sec

                if (imeg==1) then 
                   ! should these be weighted by landfrac also ??
                   gamma_out(p)=gamma
                   gammaP_out(p)=gamma_p
                   gammaT_out(p)=gamma_t
                   gammaA_out(p)=gamma_a
                   gammaS_out(p)=gamma_sm
                   gammaL_out(p)=gamma_l
                   gammaC_out(p)=gamma_c

                   paru_out(p)=par_sun
                   par24u_out(p)=par24_sun
                   par240u_out(p)=par240_sun

                   para_out(p)=par_sha
                   par24a_out(p)=par24_sha
                   par240a_out(p)=par240_sha

                   alpha_out(p)=alpha
                   cp_out(p)=cp

                   topt_out(p)=topt
                   Eopt_out(p)=Eopt

                end if
             endif

             if (debug .and. gamma > 0.0_r8) then
                write(iulog,*) 'MEGAN: n, megan name, epsilon, gamma, vocflx: ', &
                     imeg, meg_cmp%name, epsilon, gamma, vocflx_meg(imeg), gamma_p,gamma_t,gamma_a,gamma_sm,gamma_l
             endif

             meg_cmp => meg_cmp%next_megcomp
          enddo meg_cmp_loop

          ! sum up the megan compound fluxes for the fluxes of chem mechanism compounds 
          do imech = 1,shr_megan_mechcomps_n
             n_meg_comps = shr_megan_mechcomps(imech)%n_megan_comps
             do imeg = 1,n_meg_comps ! loop over number of megan compounds that make up the nth mechanism compoud
                ii = shr_megan_mechcomps(imech)%megan_comps(imeg)%ptr%index
                vocflx(p,imech) = vocflx(p,imech) + vocflx_meg(ii)
             enddo
             vocflx_tot(p) = vocflx_tot(p) + vocflx(p,imech) ! moles/m2/sec
          enddo

       end if ! ivt(1:15 only)

       ! weight with land fraction...
       vocflx_tot(p) = vocflx_tot(p)*landfrac(g)

    enddo ! fp 

  end subroutine VOCEmission
!-----------------------------------------------------------------------

!-----------------------------------------------------------------------
! !IROUTINE: init_EF_params
!
! !INTERFACE:
  subroutine VOCEmission_init(  )
    ! Interface to set all input parameters for 20 VOC compound classes.
    ! including EFs for 16(+1 bare ground) PFTs.
    ! For now set all specified values, in future to be replaced with values read in from file.
    ! (heald, 04/27/11)

    use shr_megan_mod,   only : shr_megan_factors_file
    use MEGANFactorsMod, only : megan_factors_init, megan_factors_get
    
! !CALLED FROM: VOCEmission
!
! !REVISION HISTORY:
! Author: Colette L. Heald (4/27/11)
!
! !USES
!
! !ARGUMENTS:
    implicit none

!    character(len=*),intent(in) :: filename
!
! !LOCAL VARIABLES:
!-----------------------------------------------------------------------

    integer :: nmech, nmeg
    type(shr_megan_megcomp_t), pointer :: meg_cmp

    integer  :: class_num
    real(r8) :: factors(numpft)
    real(r8) :: molec_wght

    if ( shr_megan_mechcomps_n < 1) return

    call megan_factors_init( shr_megan_factors_file )
    
    meg_cmp => shr_megan_linkedlist
    do while(associated(meg_cmp))
       allocate(meg_cmp%emis_factors(numpft))
       call megan_factors_get( trim(meg_cmp%name), factors, class_num, molec_wght )
       meg_cmp%emis_factors = factors
       meg_cmp%class_number = class_num
       meg_cmp%molec_weight = molec_wght
       meg_cmp => meg_cmp%next_megcomp
    enddo

  end subroutine VOCEmission_init
!-----------------------------------------------------------------------

!-----------------------------------------------------------------------
! FUNCTION: get_map_EF
!
! !INTERFACE:
function get_map_EF(ivt_in,g_in)
!
! Get mapped EF for isoprene
! Use gridded values for 6 PFTs specified by MEGAN following
! Guenther et al. (2006).  Map the numpft CLM PFTs to these 6.
! Units: [ug m-2 h-1] 
!
! !CALLED FROM: VOCEmission
!
! !REVISION HISTORY:
! Author: Colette L. Heald (4/27/11)
!

! !USES:
  use clmtype
!
! !ARGUMENTS:
    implicit none
!
! !LOCAL VARIABLES:

    ! varibles in
    integer, intent(in) :: ivt_in
    integer, intent(in) :: g_in
    real(r8)            :: get_map_EF

    real(r8), pointer :: efisop(:,:)      ! emission factors for isoprene for each pft [ug m-2 h-1]

    ! assign local pointer
    efisop     => clm3%g%gve%efisop
!-----------------------------------------------------------------------
    get_map_EF = 0._r8
    
    if (     ivt_in == ndllf_evr_tmp_tree  &
         .or.     ivt_in == ndllf_evr_brl_tree) then     !fineleaf evergreen
       get_map_EF = efisop(2,g_in)
    else if (ivt_in == ndllf_dcd_brl_tree) then     !fineleaf deciduous
       get_map_EF = efisop(3,g_in)
    else if (ivt_in >= nbrdlf_evr_trp_tree &
         .and.    ivt_in <= nbrdlf_dcd_brl_tree) then    !broadleaf trees
       get_map_EF = efisop(1,g_in)
    else if (ivt_in >= nbrdlf_evr_shrub &
         .and.    ivt_in <= nbrdlf_dcd_brl_shrub) then   !shrubs
       get_map_EF = efisop(4,g_in)
    else if (ivt_in >= nc3_arctic_grass &
         .and.    ivt_in <= nc4_grass) then              !grass
       get_map_EF = efisop(5,g_in)
    else if (ivt_in >= nc3crop) then                !crops
       get_map_EF =efisop(6,g_in)
    end if

end function get_map_EF
!-----------------------------------------------------------------------

!-----------------------------------------------------------------------
! FUNCTION: get_gamma_P
!
! !INTERFACE:
  function get_gamma_P(par_sun_in, par24_sun_in, par240_sun_in, par_sha_in, par24_sha_in, par240_sha_in, &
       fsun_in, fsun240_in, forc_solad240_in,forc_solai240_in, LDF_in, cp, alpha) 
  
! Activity factor for PPFD (Guenther et al., 2006): all light dependent species
!-------------------------
! 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)
    
! 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
!
! !CALLED FROM: VOCEmission
!
! !REVISION HISTORY:
! Author: Colette L. Heald (4/27/11)
!
!
! !ARGUMENTS:
    implicit none
!
! !LOCAL VARIABLES:

    ! varibles in
    real(r8),intent(in) :: par_sun_in
    real(r8),intent(in) :: par24_sun_in
    real(r8),intent(in) :: par240_sun_in
    real(r8),intent(in) :: par_sha_in
    real(r8),intent(in) :: par24_sha_in
    real(r8),intent(in) :: par240_sha_in
    real(r8),intent(in) :: fsun_in
    real(r8),intent(in) :: fsun240_in
    real(r8),intent(in) :: forc_solad240_in
    real(r8),intent(in) :: forc_solai240_in
    real(r8),intent(in) :: LDF_in

    real(r8),intent(out) :: cp                      ! temporary
    real(r8),intent(out) :: alpha                   ! temporary
    real(r8) :: gamma_p_LDF             ! activity factor for PPFD
    real(r8) :: get_gamma_P             ! return value

    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 :: alpha_fix = 0.001_r8            ! empirical coefficient
    real(r8), parameter :: cp_fix = 1.21_r8                ! empirical coefficient
!
! local pointers to implicit in arguments
!
!-----------------------------------------------------------------------

  if ( (fsun240_in > 0._r8) .and. (fsun240_in < 1._r8) .and.  (forc_solad240_in > 0._r8) &
       .and. (forc_solai240_in > 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:
     alpha = ca1 - ca2 * log(par240_sun_in)
     cp = ca3 * exp(ca2 * (par24_sun_in-par0_sun))*par240_sun_in**(0.6_r8)
     gamma_p_LDF = fsun_in * ( cp * alpha * par_sun_in * (1._r8 + alpha*alpha*par_sun_in*par_sun_in)**(-0.5_r8) )
     ! SHADE:
     alpha = ca1 - ca2 * log(par240_sha_in)
     cp = ca3 * exp(ca2 * (par_sha_in-par0_shade))*par240_sha_in**(0.6_r8)
     gamma_p_LDF = gamma_p_LDF + (1._r8-fsun_in) * (cp*alpha*par_sha_in*(1._r8 + alpha*alpha*par_sha_in*par_sha_in)**(-0.5_r8))
  else
     ! With fixed alpha and cp (from MEGAN User's Guide):
     ! SUN: direct + diffuse  
     alpha = alpha_fix
     cp = cp_fix
     gamma_p_LDF = fsun_in * ( cp * alpha*par_sun_in * (1._r8 + alpha*alpha*par_sun_in*par_sun_in)**(-0.5_r8) )
     ! SHADE: diffuse 
     gamma_p_LDF = gamma_p_LDF + (1._r8-fsun_in) * (cp*alpha*par_sha_in*(1._r8 + alpha*alpha*par_sha_in*par_sha_in)**(-0.5_r8))
  end if
  
  ! Calculate total activity factor for PPFD accounting for light-dependent fraction
  get_gamma_P = (1._r8 - LDF_in) + LDF_in * gamma_p_LDF

end function get_gamma_P
!-----------------------------------------------------------------------

!-----------------------------------------------------------------------
! FUNCTION: get_gamma_L
!
! !INTERFACE:
function get_gamma_L(fsun240_in,elai_in)
!
! Activity factor for LAI (Guenther et al., 2006): all species
! Guenther et al., 2006 eq 3
!
! !CALLED FROM: VOCEmission
!
! !REVISION HISTORY:
! Author: Colette L. Heald (4/27/11)
!

! !USES:
    use clm_varcon   , only : denice
    use clm_varpar   , only : nlevsoi
!
! !ARGUMENTS:
    implicit none
!
! !LOCAL VARIABLES:

    ! varibles in
    real(r8),intent(in) :: fsun240_in
    real(r8),intent(in) :: elai_in
    real(r8)            :: get_gamma_L             ! return value
 

    ! parameters
    real(r8), parameter :: cce = 0.30_r8                   ! factor to set emissions to unity @ std
    real(r8), parameter :: cce1 = 0.24_r8                  ! same as Cce but for non-accumulated vars
!-----------------------------------------------------------------------
    if ( (fsun240_in > 0.0_r8) .and. (fsun240_in < 1.e30_r8) ) then 
       get_gamma_L = cce * elai_in
    else
       get_gamma_L = cce1 * elai_in
    end if

end function get_gamma_L
!-----------------------------------------------------------------------

!-----------------------------------------------------------------------
! FUNCTION: get_gamma_SM
!
! !INTERFACE:
function get_gamma_SM(clayfrac_in, sandfrac_in, h2osoi_vol_in, h2osoi_ice_in, dz_in, &
     bsw_in, watsat_in, sucsat_in, root_depth_in)
!
! Activity factor for soil moisture (Guenther et al., 2006): all species
!----------------------------------
! 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
!
! !CALLED FROM: VOCEmission
!
! !REVISION HISTORY:
! Author: Colette L. Heald (4/27/11)
!

! !USES:
    use clm_varcon   , only : denice
    use clm_varpar   , only : nlevsoi
!
! !ARGUMENTS:
    implicit none
!
! !LOCAL VARIABLES:

    ! varibles in
    real(r8),intent(in) :: clayfrac_in
    real(r8),intent(in) :: sandfrac_in
    real(r8),intent(in) :: h2osoi_vol_in(nlevsoi)
    real(r8),intent(in) :: h2osoi_ice_in(nlevsoi)
    real(r8),intent(in) :: dz_in(nlevsoi)
    real(r8),intent(in) :: bsw_in(nlevsoi)
    real(r8),intent(in) :: watsat_in(nlevsoi)
    real(r8),intent(in) :: sucsat_in(nlevsoi)
    real(r8),intent(in) :: root_depth_in
 
    real(r8)            :: get_gamma_SM

    ! local variables
    integer  :: j
    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

    ! parameters
    real(r8), parameter :: deltheta1=0.06_r8               ! empirical coefficient
    real(r8), parameter :: smpmax = 2.57e5_r8              ! maximum soil matrix potential

    if ((clayfrac_in > 0) .and. (sandfrac_in > 0)) then 
       get_gamma_SM = 0._r8
       nl=0._r8
       
       do j = 1,nlevsoi
          if  (sum(dz_in(1:j)) < root_depth_in)  then
             theta_ice = h2osoi_ice_in(j)/(dz_in(j)*denice)
             wilt = ((smpmax/sucsat_in(j))**(-1._r8/bsw_in(j))) * (watsat_in(j) - theta_ice)
             theta1 = wilt + deltheta1
             if (h2osoi_vol_in(j) >= theta1) then 
                get_gamma_SM = get_gamma_SM + 1._r8
             else if ( (h2osoi_vol_in(j) > wilt) .and. (h2osoi_vol_in(j) < theta1) ) then
                get_gamma_SM = get_gamma_SM + ( h2osoi_vol_in(j) - wilt ) / deltheta1
             else
                get_gamma_SM = get_gamma_SM + 0._r8
             end if
             nl=nl+1._r8
          end if
       end do
       
       if (nl > 0._r8) then
          get_gamma_SM = get_gamma_SM/nl
       endif

       if (get_gamma_SM > 1.0_r8) then 
          write(iulog,*) 'healdSM > 1: gamma_SM, nl', get_gamma_SM, nl
          get_gamma_SM=1.0_r8
       endif

    else
       get_gamma_SM = 1.0_r8
    end if


end function get_gamma_SM
!-----------------------------------------------------------------------
  
!-----------------------------------------------------------------------
! FUNCTION: get_gamma_T
!
! !INTERFACE:
function get_gamma_T(t_veg240_in, t_veg24_in,t_veg_in, ct1_in, ct2_in, betaT_in, LDF_in, Ceo_in, Eopt, topt)

! Activity factor for temperature 
!--------------------------------
! Calculate both a light-dependent fraction as in Guenther et al., 2006 for isoprene
! of a max saturation type form. Also caculate a light-independent fraction of the
! form of an exponential. Final activity factor depends on light dependent fraction
! of compound type.
!
! !CALLED FROM: VOCEmission
!
! !REVISION HISTORY:
! Author: Colette L. Heald (4/27/11)
!
! !ARGUMENTS:
    implicit none
!
! !LOCAL VARIABLES:

    ! varibles in
    real(r8),intent(in) :: t_veg240_in
    real(r8),intent(in) :: t_veg24_in
    real(r8),intent(in) :: t_veg_in
    real(r8),intent(in) :: ct1_in
    real(r8),intent(in) :: ct2_in
    real(r8),intent(in) :: betaT_in
    real(r8),intent(in) :: LDF_in
    real(r8),intent(in) :: Ceo_in
    real(r8),intent(out) :: Eopt                    ! temporary 
    real(r8),intent(out) :: topt                    ! temporary 

    ! local variables
    real(r8) :: get_gamma_T
    real(r8) :: gamma_t_LDF             ! activity factor for temperature
    real(r8) :: gamma_t_LIF             ! activity factor for temperature
    real(r8) :: x                       ! temporary 

    ! parameters
    real(r8), parameter :: co1 = 313._r8                   ! empirical coefficient
    real(r8), parameter :: co2 = 0.6_r8                    ! empirical coefficient
    real(r8), parameter :: co4 = 0.05_r8                   ! empirical coefficient
    real(r8), parameter :: tstd0 = 297_r8                  ! std temperature [K]
    real(r8), parameter :: topt_fix = 317._r8              ! std temperature [K]
    real(r8), parameter :: Eopt_fix = 2.26_r8              ! empirical coefficient
    real(r8), parameter :: ct3 = 0.00831_r8                ! empirical coefficient (0.0083 in User's Guide)
    real(r8), parameter :: tstd = 303.15_r8                ! std temperature [K]
    real(r8), parameter :: bet = 0.09_r8                   ! beta empirical coefficient [K-1]
!-----------------------------------------------------------------------

    ! Light dependent fraction (Guenther et al., 2006)
    if ( (t_veg240_in > 0.0_r8) .and. (t_veg240_in < 1.e30_r8) ) then 
       ! topt and Eopt from eq 8 and 9:
       topt = co1 + (co2 * (t_veg240_in-tstd0))
       Eopt = Ceo_in * exp (co4 * (t_veg24_in-tstd0)) * exp(co4 * (t_veg240_in -tstd0))
    else
       topt = topt_fix
       Eopt = Eopt_fix
    endif
    x = ( (1._r8/topt) - (1._r8/(t_veg_in)) ) / ct3
    gamma_t_LDF = Eopt * ( ct2_in * exp(ct1_in * x)/(ct2_in - ct1_in * (1._r8 - exp(ct2_in * x))) )
    
    
    ! Light independent fraction (of exp(beta T) form)
    gamma_t_LIF = exp(betaT_in * (t_veg_in - tstd))
    
    ! Calculate total activity factor for light as a function of light-dependent fraction
    !--------------------------------
    get_gamma_T = (1-LDF_in)*gamma_T_LIF + LDF_in*gamma_T_LDF 

end function get_gamma_T
!-----------------------------------------------------------------------

!-----------------------------------------------------------------------
! FUNCTION: get_gamma_A
!
! !INTERFACE:
function get_gamma_A(ivt_in, elai_p_in,elai_in,nclass_in)

! 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)
!
! !CALLED FROM: VOCEmission
!
! !REVISION HISTORY:
! Author: Colette L. Heald (4/27/11)
!
! !ARGUMENTS:
    implicit none
! !LOCAL VARIABLES:

    ! varibles in
    integer,intent(in)  :: ivt_in
    integer,intent(in)  :: nclass_in
    real(r8),intent(in) :: elai_p_in
    real(r8),intent(in) :: elai_in

    real(r8)            :: get_gamma_A

    ! local variables
    real(r8) :: elai_prev               ! lai for previous timestep
    real(r8) :: fnew, fgro, fmat, fold  ! fractions of leaves at different phenological stages
    !-----------------------------------------------------------------------
    if ( (ivt_in == ndllf_dcd_brl_tree) .or. (ivt_in >= nbrdlf_dcd_trp_tree) ) then  ! non-evergreen
       
       if ( (elai_p_in > 0.0_r8) .and. (elai_p_in < 1.e30_r8) )then 
          elai_prev = 2._r8*elai_p_in-elai_in  ! have accumulated average lai over last timestep
          if (elai_prev == elai_in) then
             fnew = 0.0_r8
             fgro = 0.0_r8
             fmat = 1.0_r8
             fold = 0.0_r8
          else if (elai_prev > elai_in) then
             fnew = 0.0_r8
             fgro = 0.0_r8
             fmat = 1.0_r8 - (elai_prev - elai_in)/elai_prev
             fold = (elai_prev - elai_in)/elai_prev
          else if (elai_prev < elai_in) then
             fnew = 1 - (elai_prev / elai_in)
             fgro = 0.0_r8
             fmat = (elai_prev / elai_in)
             fold = 0.0_r8
          end if
          
          get_gamma_A = fnew*Anew(nclass_in) + fgro*Agro(nclass_in) + fmat*Amat(nclass_in) + fold*Aold(nclass_in)

       else
          get_gamma_A = 1.0_r8
       end if
       
    else
       get_gamma_A = 1.0_r8
    end if
    

  end function get_gamma_A
!-----------------------------------------------------------------------

!-----------------------------------------------------------------------
! FUNCTION: get_gamma_C
!
! !INTERFACE:
function get_gamma_C(cisun_in,cisha_in,forc_pbot_in,fsun_in)

! Activity factor for instantaneous CO2 changes (Heald et al., 2009)
!-------------------------
! With distinction between sunlit and shaded leafs, weight scalings by
! fsun and fshade 
!
! !CALLED FROM: VOCEmission
!
! !REVISION HISTORY:
! Author: Colette L. Heald (11/30/11)
!
! !USES:
    use clm_varctl,    only : co2_ppmv      ! corresponds to CCSM_CO2_PPMV set in env_conf.xml
!
! !ARGUMENTS:
    implicit none
! !LOCAL VARIABLES:

    ! varibles in
    real(r8),intent(in) :: cisun_in
    real(r8),intent(in) :: cisha_in
    real(r8),intent(in) :: forc_pbot_in
    real(r8),intent(in) :: fsun_in

    real(r8)            :: get_gamma_C

    ! local variables
    real(r8)            :: IEmin            ! empirical coeff for CO2 
    real(r8)            :: IEmax            ! empirical coeff for CO2 
    real(r8)            :: ECi50            ! empirical coeff for CO2 
    real(r8)            :: Cislope          ! empirical coeff for CO2 
    real(r8)            :: fint             ! interpolation fraction for CO2
    real(r8)            :: ci               ! temporary sunlight/shade weighted cisun & cisha (umolCO2/mol)

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

    ! Determine long-term CO2 growth environment (ie. ambient CO2) and interpolate
    ! parameters
    if ( co2_ppmv < 400._r8 ) then
       IEmin   = 0.7301_r8
       IEmax   = 1.0542_r8
       ECi50   = 457._r8
       Cislope = 3.1665_r8
    else if ( (co2_ppmv > 400._r8) .and. (co2_ppmv < 500._r8) ) then
       fint    = (co2_ppmv - 400._r8)/100._r8
       IEmin   = fint*0.7301_r8 + (1._r8 - fint)*0.7034_r8
       IEmax   = fint*1.0542_r8 + (1._r8 - fint)*0.9897_r8
       ECi50   = fint*457._r8 + (1._r8 - fint)*472._r8
       Cislope = fint*3.1665_r8 + (1._r8 - fint)*3.0652_r8
    else if ( (co2_ppmv > 500._r8) .and. (co2_ppmv < 600._r8) ) then
       fint = (co2_ppmv - 500._r8)/100._r8
       IEmin   = fint*0.7034_r8 + (1._r8 - fint)*0.6768_r8
       IEmax   = fint*0.9897_r8 + (1._r8 - fint)*0.9253_r8
       ECi50   = fint*472._r8 + (1._r8 - fint)*488._r8
       Cislope = fint*3.0652_r8 + (1._r8 - fint)*2.9321_r8
    else if ( (co2_ppmv > 600._r8) .and. (co2_ppmv < 700._r8) ) then
       fint = (co2_ppmv - 600._r8)/100._r8
       IEmin   = fint*0.6768_r8 + (1._r8 - fint)*0.6500_r8
       IEmax   = fint*0.9253_r8 + (1._r8 - fint)*0.8611_r8
       ECi50   = fint*488._r8 + (1._r8 - fint)*508._r8
       Cislope = fint*2.9321_r8 + (1._r8 - fint)*2.7497_r8
    else if ( (co2_ppmv > 700._r8) .and. (co2_ppmv < 800._r8) ) then
       fint = (co2_ppmv - 700._r8)/100._r8
       IEmin   = fint*0.6500_r8 + (1._r8 - fint)*0.6063_r8
       IEmax   = fint*0.8611_r8 + (1._r8 - fint)*0.7976_r8
       ECi50   = fint*508._r8 + (1._r8 - fint)*575._r8
       Cislope = fint*2.7497_r8 + (1._r8 - fint)*2.3643_r8
    else if ( co2_ppmv > 800._r8 ) then
       IEmin   = 0.6063_r8
       IEmax   = 0.7976_r8
       ECi50   = 575._r8
       Cislope = 2.3643_r8
    end if

    ! Intracellular CO2 concentrations (ci) given in Pa, divide by atmos
    ! pressure to get mixing ratio (umolCO2/mol)
    if ( (cisun_in > 0._r8) .and. (cisha_in > 0._r8) .and. (forc_pbot_in > 0._r8) .and. (fsun_in > 0._r8) ) then
       ci = ( fsun_in*cisun_in + (1._r8-fsun_in)*cisha_in )/forc_pbot_in * 1.e6_r8
       get_gamma_C = IEmin + ( (IEmax-IEmin)/(1._r8+(ci/ECi50)**Cislope) )
    else if ( (cisha_in > 0._r8) .and. (forc_pbot_in > 0._r8) ) then
       ci = cisha_in/forc_pbot_in * 1.e6_r8
       get_gamma_C = IEmin + ( (IEmax-IEmin)/(1._r8+(ci/ECi50)**Cislope) )
    else if ( (cisun_in > 0._r8) .and. (forc_pbot_in > 0._r8) ) then
       ci = cisun_in/forc_pbot_in * 1.e6_r8
       get_gamma_C = IEmin + ( (IEmax-IEmin)/(1._r8+(ci/ECi50)**Cislope) )
    else
       get_gamma_C = 1._r8
    end if

  end function get_gamma_C
!-----------------------------------------------------------------------

end module VOCEmissionMod


