diff --git a/src/biogeochem/VOCEmissionMod.F90 b/src/biogeochem/VOCEmissionMod.F90 index 74afda8980..89c1ce49b0 100644 --- a/src/biogeochem/VOCEmissionMod.F90 +++ b/src/biogeochem/VOCEmissionMod.F90 @@ -452,7 +452,9 @@ subroutine VOCEmission (bounds, num_soilp, filter_soilp, & real(r8) :: par240_sha ! temporary integer :: class_num, n_meg_comps, imech, imeg, ii - integer :: patchpft ! to transfer FATES PFT space into CLM PFT space. + integer :: l_pft_itype(bounds%begp:bounds%endp) ! local index of pft type + ! that corresponds to pfts on megan factors + ! for BGC it will be 1 to 1 with pftcon%itype(p) character(len=16) :: mech_name type(shr_megan_megcomp_t), pointer :: meg_cmp real(r8) :: cp, alpha, Eopt, topt ! for history output @@ -499,7 +501,6 @@ subroutine VOCEmission (bounds, num_soilp, filter_soilp, & fsun240 => canopystate_inst%fsun240_patch , & ! Input: [real(r8) (:) ] sunlit fraction of canopy last 240 hrs elai => canopystate_inst%elai_patch , & ! Input: [real(r8) (:) ] one-sided leaf area index with burying by snow elai240 => canopystate_inst%elai240_patch , & ! Input: [real(r8) (:) ] one-sided leaf area index with burying by snow last 240 hrs - ci_fates => canopystate_inst%ci_patch , & !Input: [real(r8) (:) ] FATES-calculated internalleaf ci cisun_z => photosyns_inst%cisun_z_patch , & ! Input: [real(r8) (:,:) ] sunlit intracellular CO2 (Pa) cisha_z => photosyns_inst%cisha_z_patch , & ! Input: [real(r8) (:,:) ] shaded intracellular CO2 (Pa) @@ -531,11 +532,27 @@ subroutine VOCEmission (bounds, num_soilp, filter_soilp, & ! initialize variables which get passed to the atmosphere vocflx(bounds%begp:bounds%endp,:) = 0._r8 vocflx_tot(bounds%begp:bounds%endp) = 0._r8 - + do imeg=1,shr_megan_megcomps_n meg_out(imeg)%flux_out(bounds%begp:bounds%endp) = 0._r8 enddo - + + ! Get local pft types: + ! this has to be done earlier, so if use_fates, we locally know what is not bare ground + ! voc_pft_index comes from fates-internal mapping between pft's in megan_factors_file and fates pfts + l_pft_itype(bounds%begp:bounds%endp) = 0 + if (use_fates) then + do fp = 1,num_soilp + p = filter_soilp(fp) + l_pft_itype(p) = canopystate_inst%voc_pftindex_patch(p) + end do + else + do fp = 1,num_soilp + p = filter_soilp(fp) + l_pft_itype(p) = patch%itype(p) + end do + end if + ! Begin loop over points !_______________________________________________________________________________ do fp = 1,num_soilp @@ -551,7 +568,7 @@ subroutine VOCEmission (bounds, num_soilp, filter_soilp, & vocflx_meg(:) = 0._r8 ! calculate VOC emissions for non-bare ground Patches - if (patch%itype(p) > 0) then + if (l_pft_itype(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) @@ -583,16 +600,10 @@ subroutine VOCEmission (bounds, num_soilp, filter_soilp, & ! set emis factor ! if specified, set EF for isoprene with mapped values - if(use_fates)then - patchpft = canopystate_inst%voc_pftindex_patch(p) - else - patchpft = patch%itype(p) - endif - if ( trim(meg_cmp%name) == 'isoprene' .and. shr_megan_mapped_emisfctrs) then - epsilon = get_map_EF(patchpft,g, vocemis_inst) + epsilon = get_map_EF(l_pft_itype(p),g, vocemis_inst) else - epsilon = meg_cmp%emis_factors(patchpft) + epsilon = meg_cmp%emis_factors(l_pft_itype(p)) end if @@ -612,11 +623,7 @@ subroutine VOCEmission (bounds, num_soilp, filter_soilp, & ! Activity factor for CO2 (only for isoprene) if (trim(meg_cmp%name) == 'isoprene') then co2_ppmv = 1.e6_r8*forc_pco2(g)/forc_pbot(c) - if(use_fates)then - gamma_c = get_gamma_C(ci_fates(p),ci_fates(p),forc_pbot(c),fsun(p), co2_ppmv) - else - gamma_c = get_gamma_C(cisun_z(p,1),cisha_z(p,1),forc_pbot(c),fsun(p), co2_ppmv) - endif + gamma_c = get_gamma_C(cisun_z(p),cisha_z(p),forc_pbot(c),fsun(p), co2_ppmv) else gamma_c = 1._r8 diff --git a/src/biogeophys/CanopyStateType.F90 b/src/biogeophys/CanopyStateType.F90 index f4cf3f17d2..3bcd6b3a6e 100644 --- a/src/biogeophys/CanopyStateType.F90 +++ b/src/biogeophys/CanopyStateType.F90 @@ -46,7 +46,6 @@ module CanopyStateType real(r8) , pointer :: hbot_patch (:) ! patch canopy bottom (m) real(r8) , pointer :: z0m_patch (:) ! patch momentum roughness length (m) real(r8) , pointer :: displa_patch (:) ! patch displacement height (m) - real(r8) , pointer :: ci_patch (:) ! Internal leaf CO2 concentration for MEGAN real(r8) , pointer :: fsun_patch (:) ! patch sunlit fraction of canopy real(r8) , pointer :: fsun24_patch (:) ! patch 24hr average of sunlit fraction of canopy real(r8) , pointer :: fsun240_patch (:) ! patch 240hr average of sunlit fraction of canopy @@ -141,7 +140,6 @@ subroutine InitAllocate(this, bounds) allocate(this%hbot_patch (begp:endp)) ; this%hbot_patch (:) = nan allocate(this%z0m_patch (begp:endp)) ; this%z0m_patch (:) = nan allocate(this%displa_patch (begp:endp)) ; this%displa_patch (:) = nan - allocate(this%ci_patch (begp:endp)) ; this%ci_patch (:) = nan allocate(this%fsun_patch (begp:endp)) ; this%fsun_patch (:) = nan allocate(this%fsun24_patch (begp:endp)) ; this%fsun24_patch (:) = nan allocate(this%fsun240_patch (begp:endp)) ; this%fsun240_patch (:) = nan diff --git a/src/utils/clmfates_interfaceMod.F90 b/src/utils/clmfates_interfaceMod.F90 index 1f83d29603..21d3813a38 100644 --- a/src/utils/clmfates_interfaceMod.F90 +++ b/src/utils/clmfates_interfaceMod.F90 @@ -2578,7 +2578,9 @@ subroutine wrap_photosynthesis(this, nc, bounds, fn, filterp, & rssha => photosyns_inst%rssha_patch, & psnsun => photosyns_inst%psnsun_patch, & psnsha => photosyns_inst%psnsha_patch, & - ci => canopystate_inst%ci_patch) + cisun_z => photosyns_inst%cisun_z_patch, & + cisha_z => photosyns_inst%cisha_z_patch, & + ) do s = 1, this%fates(nc)%nsites c = this%f2hmap(nc)%fcolumn(s) @@ -2645,7 +2647,9 @@ subroutine wrap_photosynthesis(this, nc, bounds, fn, filterp, & this%fates(nc)%bc_in(s)%filter_photo_pa(ifp) = 3 rssun(p) = this%fates(nc)%bc_out(s)%rssun_pa(ifp) rssha(p) = this%fates(nc)%bc_out(s)%rssha_pa(ifp) - ci(p) = this%fates(nc)%bc_out(s)%ci_pa(ifp) + ! this is needed for MEGAN to work with FATES + cisun_z = this%fates(nc)%bc_out(s)%ci_pa(ifp) + cisha_z = this%fates(nc)%bc_out(s)%ci_pa(ifp) ! These fields are marked with a bad-value flag photosyns_inst%psnsun_patch(p) = spval photosyns_inst%psnsha_patch(p) = spval