diff --git a/biogeochem/EDCanopyStructureMod.F90 b/biogeochem/EDCanopyStructureMod.F90 index bd34ef9bfc..6aee6de8de 100644 --- a/biogeochem/EDCanopyStructureMod.F90 +++ b/biogeochem/EDCanopyStructureMod.F90 @@ -29,9 +29,9 @@ module EDCanopyStructureMod use FatesInterfaceTypesMod , only : hlm_use_planthydro use FatesInterfaceTypesMod , only : hlm_use_cohort_age_tracking use FatesInterfaceTypesMod , only : numpft + use FatesInterfaceTypesMod, only : bc_in_type use FatesPlantHydraulicsMod, only : UpdateH2OVeg,InitHydrCohort, RecruitWaterStorage use EDTypesMod , only : maxCohortsPerPatch - use PRTGenericMod, only : leaf_organ use PRTGenericMod, only : all_carbon_elements use PRTGenericMod, only : leaf_organ @@ -54,7 +54,8 @@ module EDCanopyStructureMod public :: calc_areaindex public :: canopy_summarization public :: update_hlm_dynamics - + public :: UpdateFatesAvgSnowDepth + logical, parameter :: debug=.false. character(len=*), parameter, private :: sourcefile = & @@ -122,7 +123,7 @@ subroutine canopy_structure( currentSite , bc_in ) use EDParamsMod, only : ED_val_comp_excln use EDTypesMod , only : min_patch_area - use FatesInterfaceTypesMod, only : bc_in_type + ! ! !ARGUMENTS type(ed_site_type) , intent(inout), target :: currentSite @@ -195,7 +196,7 @@ subroutine canopy_structure( currentSite , bc_in ) ! Its possible that before we even enter this scheme ! some cohort numbers are very low. Terminate them. - call terminate_cohorts(currentSite, currentPatch, 1, 12) + call terminate_cohorts(currentSite, currentPatch, 1, 12, bc_in) ! Calculate how many layers we have in this canopy ! This also checks the understory to see if its crown @@ -203,17 +204,17 @@ subroutine canopy_structure( currentSite , bc_in ) z = NumPotentialCanopyLayers(currentPatch,currentSite%spread,include_substory=.false.) do i_lyr = 1,z ! Loop around the currently occupied canopy layers. - call DemoteFromLayer(currentSite, currentPatch, i_lyr) + call DemoteFromLayer(currentSite, currentPatch, i_lyr, bc_in) end do ! After demotions, we may then again have cohorts that are very very ! very sparse, remove them - call terminate_cohorts(currentSite, currentPatch, 1,13) + call terminate_cohorts(currentSite, currentPatch, 1,13,bc_in) call fuse_cohorts(currentSite, currentPatch, bc_in) ! Remove cohorts for various other reasons - call terminate_cohorts(currentSite, currentPatch, 2,13) + call terminate_cohorts(currentSite, currentPatch, 2,13,bc_in) ! --------------------------------------------------------------------------------------- @@ -232,12 +233,12 @@ subroutine canopy_structure( currentSite , bc_in ) end do ! Remove cohorts that are incredibly sparse - call terminate_cohorts(currentSite, currentPatch, 1,14) + call terminate_cohorts(currentSite, currentPatch, 1,14,bc_in) call fuse_cohorts(currentSite, currentPatch, bc_in) ! Remove cohorts for various other reasons - call terminate_cohorts(currentSite, currentPatch, 2,14) + call terminate_cohorts(currentSite, currentPatch, 2,14,bc_in) end if @@ -272,7 +273,7 @@ subroutine canopy_structure( currentSite , bc_in ) enddo write(fates_log(),*) 'lat:',currentSite%lat write(fates_log(),*) 'lon:',currentSite%lon - write(fates_log(),*) 'spread:',currentSite%spread + write(fates_log(),*) 'spread:',currentSite%spread currentCohort => currentPatch%tallest do while (associated(currentCohort)) write(fates_log(),*) 'coh ilayer:',currentCohort%canopy_layer @@ -280,18 +281,18 @@ subroutine canopy_structure( currentSite , bc_in ) write(fates_log(),*) 'coh pft:',currentCohort%pft write(fates_log(),*) 'coh n:',currentCohort%n write(fates_log(),*) 'coh carea:',currentCohort%c_area - ipft=currentCohort%pft - write(fates_log(),*) 'maxh:',prt_params%allom_dbh_maxheight(ipft) + ipft=currentCohort%pft + write(fates_log(),*) 'maxh:',prt_params%allom_dbh_maxheight(ipft) write(fates_log(),*) 'lmode: ',prt_params%allom_lmode(ipft) - write(fates_log(),*) 'd2bl2: ',prt_params%allom_d2bl2(ipft) - write(fates_log(),*) 'd2bl_ediff: ',prt_params%allom_blca_expnt_diff(ipft) - write(fates_log(),*) 'd2ca_min: ',prt_params%allom_d2ca_coefficient_min(ipft) - write(fates_log(),*) 'd2ca_max: ',prt_params%allom_d2ca_coefficient_max(ipft) + write(fates_log(),*) 'd2bl2: ',prt_params%allom_d2bl2(ipft) + write(fates_log(),*) 'd2bl_ediff: ',prt_params%allom_blca_expnt_diff(ipft) + write(fates_log(),*) 'd2ca_min: ',prt_params%allom_d2ca_coefficient_min(ipft) + write(fates_log(),*) 'd2ca_max: ',prt_params%allom_d2ca_coefficient_max(ipft) currentCohort => currentCohort%shorter enddo call endrun(msg=errMsg(sourcefile, __LINE__)) end if - + enddo ! do while(area_not_balanced) @@ -330,7 +331,7 @@ end subroutine canopy_structure ! ============================================================================================== - subroutine DemoteFromLayer(currentSite,currentPatch,i_lyr) + subroutine DemoteFromLayer(currentSite,currentPatch,i_lyr,bc_in) use EDParamsMod, only : ED_val_comp_excln use SFParamsMod, only : SF_val_CWD_frac @@ -339,7 +340,8 @@ subroutine DemoteFromLayer(currentSite,currentPatch,i_lyr) type(ed_site_type), intent(inout), target :: currentSite type(ed_patch_type), intent(inout), target :: currentPatch integer, intent(in) :: i_lyr ! Current canopy layer of interest - + type(bc_in_type), intent(in) :: bc_in + ! !LOCAL VARIABLES: type(ed_cohort_type), pointer :: currentCohort type(ed_cohort_type), pointer :: copyc @@ -718,7 +720,7 @@ subroutine DemoteFromLayer(currentSite,currentPatch,i_lyr) ! put the litter from the terminated cohorts ! straight into the fragmenting pools call SendCohortToLitter(currentSite,currentPatch, & - currentCohort,currentCohort%n) + currentCohort,currentCohort%n,bc_in) currentCohort%n = 0.0_r8 currentCohort%c_area = 0.0_r8 @@ -1257,7 +1259,6 @@ subroutine canopy_summarization( nsites, sites, bc_in ) ! Much of this routine was once ed_clm_link minus all the IO and history stuff ! --------------------------------------------------------------------------------- - use FatesInterfaceTypesMod , only : bc_in_type use FatesInterfaceTypesMod , only : hlm_use_cohort_age_tracking use EDPatchDynamicsMod , only : set_patchno use FatesSizeAgeTypeIndicesMod, only : sizetype_class_index @@ -1380,16 +1381,37 @@ subroutine canopy_summarization( nsites, sites, bc_in ) currentPatch => currentPatch%younger end do !patch loop - call leaf_area_profile(sites(s),bc_in(s)%snow_depth_si,bc_in(s)%frac_sno_eff_si) + call leaf_area_profile(sites(s)) end do ! site loop return end subroutine canopy_summarization - - ! ===================================================================================== - subroutine leaf_area_profile( currentSite , snow_depth_si, frac_sno_eff_si) + ! ==================================================================================== + + subroutine UpdateFatesAvgSnowDepth(sites,bc_in) + + ! This routine updates the snow depth used in FATES to occlude vegetation + ! Currently this average takes into account the depth of snow and the + ! areal coverage fraction + + type(ed_site_type) , intent(inout), target :: sites(:) + type(bc_in_type) , intent(in) :: bc_in(:) + + integer :: s + + do s = 1, size(sites,dim=1) + sites(s)%snow_depth = bc_in(s)%snow_depth_si * bc_in(s)%frac_sno_eff_si + end do + + return + end subroutine UpdateFatesAvgSnowDepth + + + ! ===================================================================================== + + subroutine leaf_area_profile( currentSite ) ! ----------------------------------------------------------------------------------- ! This subroutine calculates how leaf and stem areas are distributed @@ -1431,8 +1453,7 @@ subroutine leaf_area_profile( currentSite , snow_depth_si, frac_sno_eff_si) ! ! !ARGUMENTS type(ed_site_type) , intent(inout) :: currentSite - real(r8) , intent(in) :: snow_depth_si - real(r8) , intent(in) :: frac_sno_eff_si + ! ! !LOCAL VARIABLES: @@ -1455,7 +1476,6 @@ subroutine leaf_area_profile( currentSite , snow_depth_si, frac_sno_eff_si) real(r8) :: min_chite ! bottom of cohort canopy (m) real(r8) :: max_chite ! top of cohort canopy (m) real(r8) :: lai ! summed lai for checking m2 m-2 - real(r8) :: snow_depth_avg ! avg snow over whole site real(r8) :: leaf_c ! leaf carbon [kg] !---------------------------------------------------------------------- @@ -1581,20 +1601,15 @@ subroutine leaf_area_profile( currentSite , snow_depth_si, frac_sno_eff_si) currentCohort%sai !snow burial - !write(fates_log(), *) 'calc snow' - snow_depth_avg = snow_depth_si * frac_sno_eff_si - if(snow_depth_avg > maxh(iv))then + if(currentSite%snow_depth > maxh(iv))then fraction_exposed = 0._r8 endif - if(snow_depth_avg < minh(iv))then + if(currentSite%snow_depth < minh(iv))then fraction_exposed = 1._r8 endif - if(snow_depth_avg>= minh(iv).and.snow_depth_avg <= maxh(iv))then !only partly hidden... - fraction_exposed = max(0._r8,(min(1.0_r8,(snow_depth_avg-minh(iv))/dh))) + if(currentSite%snow_depth >= minh(iv) .and. currentSite%snow_depth <= maxh(iv)) then !only partly hidden... + fraction_exposed = 1._r8 - max(0._r8,(min(1.0_r8,(currentSite%snow_depth-minh(iv))/dh))) endif - fraction_exposed = 1.0_r8 - ! no m2 of leaf per m2 of ground in each height class - ! FIX(SPM,032414) these should be uncommented this and double check if ( debug ) write(fates_log(), *) 'leaf_area_profile()', currentPatch%elai_profile(1,ft,iv) @@ -1648,12 +1663,6 @@ subroutine leaf_area_profile( currentSite , snow_depth_si, frac_sno_eff_si) fleaf = 0._r8 endif - ! XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX - ! SNOW BURIAL IS CURRENTLY TURNED OFF - ! WHEN IT IS TURNED ON, IT WILL HAVE TO BE COMPARED - ! WITH SNOW HEIGHTS CALCULATED BELOW. - ! XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX - currentPatch%nrad(cl,ft) = currentPatch%ncan(cl,ft) if (currentPatch%nrad(cl,ft) > nlevleaf ) then @@ -1688,23 +1697,18 @@ subroutine leaf_area_profile( currentSite , snow_depth_si, frac_sno_eff_si) EDPftvarcon_inst%crown(currentCohort%pft) ) fraction_exposed = 1.0_r8 - snow_depth_avg = snow_depth_si * frac_sno_eff_si - if(snow_depth_avg > layer_top_hite)then + if(currentSite%snow_depth > layer_top_hite)then fraction_exposed = 0._r8 endif - if(snow_depth_avg < layer_bottom_hite)then + if(currentSite%snow_depth < layer_bottom_hite)then fraction_exposed = 1._r8 endif - if( snow_depth_avg>= layer_bottom_hite .and. & - snow_depth_avg <= layer_top_hite) then !only partly hidden... - fraction_exposed = max(0._r8,(min(1.0_r8,(snow_depth_avg-layer_bottom_hite)/ & + if(currentSite%snow_depth >= layer_bottom_hite .and. & + currentSite%snow_depth <= layer_top_hite) then !only partly hidden... + fraction_exposed = 1._r8 - max(0._r8,(min(1.0_r8,(currentSite%snow_depth -layer_bottom_hite)/ & (layer_top_hite-layer_bottom_hite )))) endif - ! =========== OVER-WRITE ================= - fraction_exposed= 1.0_r8 - ! =========== OVER-WRITE ================= - if(iv==currentCohort%NV) then remainder = (currentCohort%treelai + currentCohort%treesai) - & (dinc_ed*real(currentCohort%nv-1,r8)) @@ -1891,8 +1895,7 @@ subroutine update_hlm_dynamics(nsites,sites,fcolumn,bc_out) real(r8) :: total_patch_area real(r8) :: total_canopy_area real(r8) :: weight ! Weighting for cohort variables in patch - - + do s = 1,nsites ifp = 0 @@ -1981,11 +1984,10 @@ subroutine update_hlm_dynamics(nsites,sites,fcolumn,bc_out) else bc_out(s)%frac_veg_nosno_alb_pa(ifp) = 0.0_r8 end if - + currentPatch => currentPatch%younger end do - - + ! Apply patch and canopy area corrections ! If the difference is above reasonable math precision, apply a fix ! If the difference is way above reasonable math precision, gracefully exit @@ -2010,15 +2012,32 @@ subroutine update_hlm_dynamics(nsites,sites,fcolumn,bc_out) end do endif + + ! If running hydro, perform a final check to make sure that we + ! have conserved water. Since this is the very end of the dynamics + ! cycle. No water should had been added or lost to the site during dynamics. + ! With growth and death, we may have shuffled it around. + ! For recruitment, we initialized their water, but flagged them + ! to not be included in the site level balance yet, for they + ! will demand the water for their initialization on the first hydraulics time-step + + if (hlm_use_planthydro.eq.itrue) then + call UpdateH2OVeg(sites(s),bc_out(s),bc_out(s)%plant_stored_h2o_si,1) + end if end do - ! If hydraulics is turned on, update the amount of water bound in vegetation + ! This call to RecruitWaterStorage() makes an accounting of + ! how much water is used to intialize newly recruited plants. + ! However, it does not actually move water from the soil or create + ! a flux, it is just accounting for diagnostics purposes. The water + ! will not actually be moved until the beginning of the first hydraulics + ! call during the fast timestep sequence + if (hlm_use_planthydro.eq.itrue) then call RecruitWaterStorage(nsites,sites,bc_out) - call UpdateH2OVeg(nsites,sites,bc_out) end if - + end subroutine update_hlm_dynamics @@ -2043,11 +2062,12 @@ function calc_areaindex(cpatch,ai_type) result(ai) ! TODO: THIS MIN LAI IS AN ARTIFACT FROM TESTING LONG-AGO AND SHOULD BE REMOVED ! THIS HAS BEEN KEPT THUS FAR TO MAINTAIN B4B IN TESTING OTHER COMMITS real(r8),parameter :: ai_min = 0.1_r8 + real(r8),pointer :: ai_profile ai = 0._r8 if (trim(ai_type) == 'elai') then - do cl = 1,cpatch%NCL_p + do cl = 1,cpatch%NCL_p do ft = 1,numpft ai = ai + sum(cpatch%canopy_area_profile(cl,ft,1:cpatch%nrad(cl,ft)) * & cpatch%elai_profile(cl,ft,1:cpatch%nrad(cl,ft))) @@ -2079,9 +2099,9 @@ function calc_areaindex(cpatch,ai_type) result(ai) write(fates_log(),*) 'Unsupported area index sent to calc_areaindex' call endrun(msg=errMsg(sourcefile, __LINE__)) end if - + ai = max(ai_min,ai) - + return end function calc_areaindex diff --git a/biogeochem/EDCohortDynamicsMod.F90 b/biogeochem/EDCohortDynamicsMod.F90 index f29fd27fc4..b6714ee3e9 100644 --- a/biogeochem/EDCohortDynamicsMod.F90 +++ b/biogeochem/EDCohortDynamicsMod.F90 @@ -91,11 +91,11 @@ module EDCohortDynamicsMod use PRTAllometricCNPMod, only : acnp_bc_in_id_pft, acnp_bc_in_id_ctrim use PRTAllometricCNPMod, only : acnp_bc_in_id_lstat, acnp_bc_inout_id_dbh use PRTAllometricCNPMod, only : acnp_bc_inout_id_rmaint_def, acnp_bc_in_id_netdc - use PRTAllometricCNPMod, only : acnp_bc_in_id_netdn, acnp_bc_in_id_netdp + use PRTAllometricCNPMod, only : acnp_bc_in_id_netdnh4, acnp_bc_in_id_netdno3, acnp_bc_in_id_netdp use PRTAllometricCNPMod, only : acnp_bc_out_id_cefflux, acnp_bc_out_id_nefflux use PRTAllometricCNPMod, only : acnp_bc_out_id_pefflux - use PRTAllometricCNPMod, only : acnp_bc_out_id_ngrow,acnp_bc_out_id_nmax - use PRTAllometricCNPMod, only : acnp_bc_out_id_pgrow,acnp_bc_out_id_pmax + use PRTAllometricCNPMod, only : acnp_bc_out_id_nneed + use PRTAllometricCNPMod, only : acnp_bc_out_id_pneed use shr_infnan_mod, only : nan => shr_infnan_nan, assignment(=) @@ -400,7 +400,8 @@ subroutine InitPRTBoundaryConditions(new_cohort) call new_cohort%prt%RegisterBCIn(acnp_bc_in_id_ctrim,bc_rval = new_cohort%canopy_trim) call new_cohort%prt%RegisterBCIn(acnp_bc_in_id_lstat,bc_ival = new_cohort%status_coh) call new_cohort%prt%RegisterBCIn(acnp_bc_in_id_netdc, bc_rval = new_cohort%npp_acc) - call new_cohort%prt%RegisterBCIn(acnp_bc_in_id_netdn, bc_rval = new_cohort%daily_n_uptake) + call new_cohort%prt%RegisterBCIn(acnp_bc_in_id_netdnh4, bc_rval = new_cohort%daily_nh4_uptake) + call new_cohort%prt%RegisterBCIn(acnp_bc_in_id_netdno3, bc_rval = new_cohort%daily_no3_uptake) call new_cohort%prt%RegisterBCIn(acnp_bc_in_id_netdp, bc_rval = new_cohort%daily_p_uptake) call new_cohort%prt%RegisterBCInOut(acnp_bc_inout_id_dbh,bc_rval = new_cohort%dbh) @@ -409,10 +410,8 @@ subroutine InitPRTBoundaryConditions(new_cohort) call new_cohort%prt%RegisterBCOut(acnp_bc_out_id_cefflux, bc_rval = new_cohort%daily_c_efflux) call new_cohort%prt%RegisterBCOut(acnp_bc_out_id_nefflux, bc_rval = new_cohort%daily_n_efflux) call new_cohort%prt%RegisterBCOut(acnp_bc_out_id_pefflux, bc_rval = new_cohort%daily_p_efflux) - call new_cohort%prt%RegisterBCOut(acnp_bc_out_id_ngrow, bc_rval = new_cohort%daily_n_need1) - call new_cohort%prt%RegisterBCOut(acnp_bc_out_id_nmax, bc_rval = new_cohort%daily_n_need2) - call new_cohort%prt%RegisterBCOut(acnp_bc_out_id_pgrow, bc_rval = new_cohort%daily_p_need1) - call new_cohort%prt%RegisterBCOut(acnp_bc_out_id_pmax, bc_rval = new_cohort%daily_p_need2) + call new_cohort%prt%RegisterBCOut(acnp_bc_out_id_nneed, bc_rval = new_cohort%daily_n_need) + call new_cohort%prt%RegisterBCOut(acnp_bc_out_id_pneed, bc_rval = new_cohort%daily_p_need) case DEFAULT @@ -559,15 +558,14 @@ subroutine nan_cohort(cc_p) currentCohort%resp_acc = nan ! RESP: kGC/cohort/day ! Fluxes from nutrient allocation - currentCohort%daily_n_uptake = nan + currentCohort%daily_nh4_uptake = nan + currentCohort%daily_no3_uptake = nan currentCohort%daily_p_uptake = nan currentCohort%daily_c_efflux = nan currentCohort%daily_n_efflux = nan currentCohort%daily_p_efflux = nan - currentCohort%daily_n_need1 = nan - currentCohort%daily_n_need2 = nan - currentCohort%daily_p_need1 = nan - currentCohort%daily_p_need2 = nan + currentCohort%daily_n_need = nan + currentCohort%daily_p_need = nan currentCohort%daily_n_demand = nan currentCohort%daily_p_demand = nan @@ -678,17 +676,16 @@ subroutine zero_cohort(cc_p) ! after allocation. These variables exist in ! carbon-only mode but are not used. - currentCohort%daily_n_uptake = 0._r8 + currentCohort%daily_nh4_uptake = 0._r8 + currentCohort%daily_no3_uptake = 0._r8 currentCohort%daily_p_uptake = 0._r8 currentCohort%daily_c_efflux = 0._r8 currentCohort%daily_n_efflux = 0._r8 currentCohort%daily_p_efflux = 0._r8 - currentCohort%daily_n_need1 = 0._r8 - currentCohort%daily_n_need2 = 0._r8 - currentCohort%daily_p_need1 = 0._r8 - currentCohort%daily_p_need2 = 0._r8 + currentCohort%daily_n_need = 0._r8 + currentCohort%daily_p_need = 0._r8 ! Initialize these as negative currentCohort%daily_p_demand = -9._r8 @@ -698,7 +695,7 @@ subroutine zero_cohort(cc_p) end subroutine zero_cohort !-------------------------------------------------------------------------------------! - subroutine terminate_cohorts( currentSite, currentPatch, level , call_index) + subroutine terminate_cohorts( currentSite, currentPatch, level , call_index, bc_in) ! ! !DESCRIPTION: ! terminates cohorts when they get too small @@ -711,7 +708,8 @@ subroutine terminate_cohorts( currentSite, currentPatch, level , call_index) type (ed_patch_type), intent(inout), target :: currentPatch integer , intent(in) :: level integer :: call_index - + type(bc_in_type), intent(in) :: bc_in + ! Important point regarding termination levels. Termination is typically ! called after fusion. We do this so that we can re-capture the biomass that would ! otherwise be lost from termination. The biomass of a fused plant remains in the @@ -827,7 +825,7 @@ subroutine terminate_cohorts( currentSite, currentPatch, level , call_index) if (currentCohort%n.gt.0.0_r8) then call SendCohortToLitter(currentSite,currentPatch, & - currentCohort,currentCohort%n) + currentCohort,currentCohort%n,bc_in) end if ! Set pointers and remove the current cohort from the list @@ -861,7 +859,7 @@ end subroutine terminate_cohorts ! ===================================================================================== - subroutine SendCohortToLitter(csite,cpatch,ccohort,nplant) + subroutine SendCohortToLitter(csite,cpatch,ccohort,nplant,bc_in) ! ----------------------------------------------------------------------------------- ! This routine transfers the existing mass in all pools and all elements @@ -884,9 +882,9 @@ subroutine SendCohortToLitter(csite,cpatch,ccohort,nplant) type (ed_patch_type) , target :: cpatch type (ed_cohort_type) , target :: ccohort real(r8) :: nplant ! Number (absolute) - ! of plants to transfer + ! of plants to transfer + type(bc_in_type), intent(in) :: bc_in - ! type(litter_type), pointer :: litt ! Litter object for each element type(site_fluxdiags_type),pointer :: flux_diags @@ -910,7 +908,8 @@ subroutine SendCohortToLitter(csite,cpatch,ccohort,nplant) plant_dens = nplant/cpatch%area - call set_root_fraction(csite%rootfrac_scr, pft, csite%zi_soil) + call set_root_fraction(csite%rootfrac_scr, pft, csite%zi_soil, & + bc_in%max_rooting_depth_index_col) do el=1,num_elements @@ -1396,8 +1395,10 @@ subroutine fuse_cohorts(currentSite, currentPatch, bc_in) currentCohort%frmort = (currentCohort%n*currentCohort%frmort + nextc%n*nextc%frmort)/newn ! Nutrient fluxes - currentCohort%daily_n_uptake = (currentCohort%n*currentCohort%daily_n_uptake + & - nextc%n*nextc%daily_n_uptake)/newn + currentCohort%daily_nh4_uptake = (currentCohort%n*currentCohort%daily_nh4_uptake + & + nextc%n*nextc%daily_nh4_uptake)/newn + currentCohort%daily_no3_uptake = (currentCohort%n*currentCohort%daily_no3_uptake + & + nextc%n*nextc%daily_no3_uptake)/newn currentCohort%daily_p_uptake = (currentCohort%n*currentCohort%daily_p_uptake + & nextc%n*nextc%daily_p_uptake)/newn @@ -1413,15 +1414,10 @@ subroutine fuse_cohorts(currentSite, currentPatch, bc_in) currentCohort%daily_p_efflux = (currentCohort%n*currentCohort%daily_p_efflux + & nextc%n*nextc%daily_p_efflux)/newn - currentCohort%daily_n_need1 = (currentCohort%n*currentCohort%daily_n_need1 + & - nextc%n*nextc%daily_n_need1)/newn - currentCohort%daily_n_need2 = (currentCohort%n*currentCohort%daily_n_need2 + & - nextc%n*nextc%daily_n_need2)/newn - currentCohort%daily_p_need1 = (currentCohort%n*currentCohort%daily_p_need1 + & - nextc%n*nextc%daily_p_need1)/newn - currentCohort%daily_p_need2 = (currentCohort%n*currentCohort%daily_p_need2 + & - nextc%n*nextc%daily_p_need2)/newn - + currentCohort%daily_n_need = (currentCohort%n*currentCohort%daily_n_need + & + nextc%n*nextc%daily_n_need)/newn + currentCohort%daily_p_need = (currentCohort%n*currentCohort%daily_p_need + & + nextc%n*nextc%daily_p_need)/newn ! logging mortality, Yi Xu @@ -1817,15 +1813,14 @@ subroutine copy_cohort( currentCohort,copyc ) n%year_net_uptake = o%year_net_uptake n%ts_net_uptake = o%ts_net_uptake - n%daily_n_uptake = o%daily_n_uptake + n%daily_nh4_uptake = o%daily_nh4_uptake + n%daily_no3_uptake = o%daily_no3_uptake n%daily_p_uptake = o%daily_p_uptake n%daily_c_efflux = o%daily_c_efflux n%daily_n_efflux = o%daily_n_efflux n%daily_p_efflux = o%daily_p_efflux - n%daily_n_need1 = o%daily_n_need1 - n%daily_n_need2 = o%daily_n_need2 - n%daily_p_need1 = o%daily_p_need1 - n%daily_p_need2 = o%daily_p_need2 + n%daily_n_need = o%daily_n_need + n%daily_p_need = o%daily_p_need n%daily_n_demand = o%daily_n_demand n%daily_p_demand = o%daily_p_demand diff --git a/biogeochem/EDLoggingMortalityMod.F90 b/biogeochem/EDLoggingMortalityMod.F90 index a6228e7b20..f1f23d9f33 100644 --- a/biogeochem/EDLoggingMortalityMod.F90 +++ b/biogeochem/EDLoggingMortalityMod.F90 @@ -40,6 +40,7 @@ module EDLoggingMortalityMod use EDParamsMod , only : logging_mechanical_frac use EDParamsMod , only : logging_coll_under_frac use EDParamsMod , only : logging_dbhmax_infra + use FatesInterfaceTypesMod , only : bc_in_type use FatesInterfaceTypesMod , only : hlm_current_year use FatesInterfaceTypesMod , only : hlm_current_month use FatesInterfaceTypesMod , only : hlm_current_day @@ -394,7 +395,7 @@ end subroutine get_harvest_rate_area ! ============================================================================ - subroutine logging_litter_fluxes(currentSite, currentPatch, newPatch, patch_site_areadis) + subroutine logging_litter_fluxes(currentSite, currentPatch, newPatch, patch_site_areadis, bc_in) ! ------------------------------------------------------------------------------------------- ! @@ -440,6 +441,8 @@ subroutine logging_litter_fluxes(currentSite, currentPatch, newPatch, patch_site type(ed_patch_type) , intent(inout), target :: currentPatch type(ed_patch_type) , intent(inout), target :: newPatch real(r8) , intent(in) :: patch_site_areadis + type(bc_in_type) , intent(in) :: bc_in + !LOCAL VARIABLES: type(ed_cohort_type), pointer :: currentCohort @@ -567,7 +570,9 @@ subroutine logging_litter_fluxes(currentSite, currentPatch, newPatch, patch_site ! derived from the current patch, so we need to multiply by patch_areadis/np%area ! ---------------------------------------------------------------------------------------- - call set_root_fraction(currentSite%rootfrac_scr, pft, currentSite%zi_soil) + call set_root_fraction(currentSite%rootfrac_scr, pft, & + currentSite%zi_soil, & + bc_in%max_rooting_depth_index_col) ag_wood = (direct_dead+indirect_dead) * (struct_m + sapw_m ) * & prt_params%allom_agb_frac(currentCohort%pft) diff --git a/biogeochem/EDMortalityFunctionsMod.F90 b/biogeochem/EDMortalityFunctionsMod.F90 index fa0b933fc5..6eb5ec3097 100644 --- a/biogeochem/EDMortalityFunctionsMod.F90 +++ b/biogeochem/EDMortalityFunctionsMod.F90 @@ -19,7 +19,6 @@ module EDMortalityFunctionsMod use FatesInterfaceTypesMod , only : hlm_use_planthydro use EDLoggingMortalityMod , only : LoggingMortality_frac use EDParamsMod , only : fates_mortality_disturbance_fraction - use FatesInterfaceTypesMod , only : bc_in_type use PRTGenericMod, only : all_carbon_elements use PRTGenericMod, only : store_organ diff --git a/biogeochem/EDPatchDynamicsMod.F90 b/biogeochem/EDPatchDynamicsMod.F90 index ea0b2918db..61de6d6ddd 100644 --- a/biogeochem/EDPatchDynamicsMod.F90 +++ b/biogeochem/EDPatchDynamicsMod.F90 @@ -447,7 +447,8 @@ subroutine spawn_patches( currentSite, bc_in) ! !USES: use EDParamsMod , only : ED_val_understorey_death, logging_coll_under_frac - use EDCohortDynamicsMod , only : zero_cohort, copy_cohort, terminate_cohorts + use EDCohortDynamicsMod , only : zero_cohort, copy_cohort, terminate_cohorts + use FatesConstantsMod , only : rsnbl_math_prec ! ! !ARGUMENTS: @@ -500,7 +501,7 @@ subroutine spawn_patches( currentSite, bc_in) do while(associated(currentPatch)) - if(currentPatch%disturbance_rate>1.0_r8) then + if(currentPatch%disturbance_rate > (1.0_r8 + rsnbl_math_prec)) then write(fates_log(),*) 'patch disturbance rate > 1 ?',currentPatch%disturbance_rate call dump_patch(currentPatch) call endrun(msg=errMsg(sourcefile, __LINE__)) @@ -659,11 +660,14 @@ subroutine spawn_patches( currentSite, bc_in) ! Transfer in litter fluxes from plants in various contexts of death and destruction if(currentPatch%disturbance_mode .eq. dtype_ilog) then - call logging_litter_fluxes(currentSite, currentPatch, new_patch, patch_site_areadis) + call logging_litter_fluxes(currentSite, currentPatch, & + new_patch, patch_site_areadis,bc_in) elseif(currentPatch%disturbance_mode .eq. dtype_ifire) then - call fire_litter_fluxes(currentSite, currentPatch, new_patch, patch_site_areadis) + call fire_litter_fluxes(currentSite, currentPatch, & + new_patch, patch_site_areadis,bc_in) else - call mortality_litter_fluxes(currentSite, currentPatch, new_patch, patch_site_areadis) + call mortality_litter_fluxes(currentSite, currentPatch, & + new_patch, patch_site_areadis,bc_in) endif ! -------------------------------------------------------------------------- @@ -1079,9 +1083,9 @@ subroutine spawn_patches( currentSite, bc_in) ! the first call to terminate cohorts removes sparse number densities, ! the second call removes for all other reasons (sparse culling must happen ! before fusion) - call terminate_cohorts(currentSite, currentPatch, 1,16) + call terminate_cohorts(currentSite, currentPatch, 1,16,bc_in) call fuse_cohorts(currentSite,currentPatch, bc_in) - call terminate_cohorts(currentSite, currentPatch, 2,16) + call terminate_cohorts(currentSite, currentPatch, 2,16,bc_in) call sort_cohorts(currentPatch) end if ! if ( new_patch%area > nearzero ) then @@ -1153,16 +1157,16 @@ subroutine spawn_patches( currentSite, bc_in) ! before fusion) if ( site_areadis_primary .gt. nearzero) then - call terminate_cohorts(currentSite, new_patch_primary, 1,17) + call terminate_cohorts(currentSite, new_patch_primary, 1,17, bc_in) call fuse_cohorts(currentSite,new_patch_primary, bc_in) - call terminate_cohorts(currentSite, new_patch_primary, 2,17) + call terminate_cohorts(currentSite, new_patch_primary, 2,17, bc_in) call sort_cohorts(new_patch_primary) endif if ( site_areadis_secondary .gt. nearzero) then - call terminate_cohorts(currentSite, new_patch_secondary, 1,18) + call terminate_cohorts(currentSite, new_patch_secondary, 1,18,bc_in) call fuse_cohorts(currentSite,new_patch_secondary, bc_in) - call terminate_cohorts(currentSite, new_patch_secondary, 2,18) + call terminate_cohorts(currentSite, new_patch_secondary, 2,18,bc_in) call sort_cohorts(new_patch_secondary) endif @@ -1383,6 +1387,16 @@ subroutine TransLitterNewPatch(currentSite, & enddo + do pft = 1,numpft + + new_litt%seed_decay(pft) = new_litt%seed_decay(pft) + & + curr_litt%seed_decay(pft)*patch_site_areadis/newPatch%area + + new_litt%seed_germ_decay(pft) = new_litt%seed_germ_decay(pft) + & + curr_litt%seed_germ_decay(pft)*patch_site_areadis/newPatch%area + + end do + ! ----------------------------------------------------------------------------- ! Distribute the existing litter that was already in place on the donor ! patch. Some of this burns and is sent to the atmosphere, and some goes to the @@ -1510,7 +1524,8 @@ end subroutine TransLitterNewPatch ! ============================================================================ - subroutine fire_litter_fluxes(currentSite, currentPatch, newPatch, patch_site_areadis) + subroutine fire_litter_fluxes(currentSite, currentPatch, & + newPatch, patch_site_areadis, bc_in) ! ! !DESCRIPTION: ! CWD pool burned by a fire. @@ -1529,7 +1544,8 @@ subroutine fire_litter_fluxes(currentSite, currentPatch, newPatch, patch_site_ar type(ed_patch_type) , intent(inout), target :: currentPatch ! Donor Patch type(ed_patch_type) , intent(inout), target :: newPatch ! New Patch real(r8) , intent(in) :: patch_site_areadis ! Area being donated - ! by current patch + type(bc_in_type) , intent(in) :: bc_in + ! ! !LOCAL VARIABLES: @@ -1658,7 +1674,8 @@ subroutine fire_litter_fluxes(currentSite, currentPatch, newPatch, patch_site_ar site_mass%burn_flux_to_atm = site_mass%burn_flux_to_atm + burned_mass - call set_root_fraction(currentSite%rootfrac_scr, pft, currentSite%zi_soil) + call set_root_fraction(currentSite%rootfrac_scr, pft, currentSite%zi_soil, & + bc_in%max_rooting_depth_index_col) ! Contribution of dead trees to root litter (no root burn flux to atm) do dcmpy=1,ndcmpy @@ -1730,7 +1747,8 @@ end subroutine fire_litter_fluxes ! ============================================================================ - subroutine mortality_litter_fluxes(currentSite, currentPatch, newPatch, patch_site_areadis) + subroutine mortality_litter_fluxes(currentSite, currentPatch, & + newPatch, patch_site_areadis,bc_in) ! ! !DESCRIPTION: ! Carbon going from mortality associated with disturbance into CWD pools. @@ -1752,7 +1770,7 @@ subroutine mortality_litter_fluxes(currentSite, currentPatch, newPatch, patch_si type(ed_patch_type) , intent(inout), target :: currentPatch type(ed_patch_type) , intent(inout), target :: newPatch real(r8) , intent(in) :: patch_site_areadis - + type(bc_in_type) , intent(in) :: bc_in ! ! !LOCAL VARIABLES: type(ed_cohort_type), pointer :: currentCohort @@ -1867,7 +1885,8 @@ subroutine mortality_litter_fluxes(currentSite, currentPatch, newPatch, patch_si ag_wood = num_dead * (struct_m + sapw_m) * prt_params%allom_agb_frac(pft) bg_wood = num_dead * (struct_m + sapw_m) * (1.0_r8-prt_params%allom_agb_frac(pft)) - call set_root_fraction(currentSite%rootfrac_scr, pft, currentSite%zi_soil) + call set_root_fraction(currentSite%rootfrac_scr, pft, currentSite%zi_soil, & + bc_in%max_rooting_depth_index_col) do c=1,ncwd @@ -2034,6 +2053,23 @@ subroutine create_patch(currentSite, new_patch, age, areap, label) new_patch%fabi_sha_z(:,:,:) = 0._r8 new_patch%scorch_ht(:) = 0._r8 new_patch%frac_burnt = 0._r8 + new_patch%litter_moisture(:) = 0._r8 + new_patch%fuel_eff_moist = 0._r8 + new_patch%livegrass = 0._r8 + new_patch%sum_fuel = 0._r8 + new_patch%fuel_bulkd = 0._r8 + new_patch%fuel_sav = 0._r8 + new_patch%fuel_mef = 0._r8 + new_patch%ros_front = 0._r8 + new_patch%effect_wspeed = 0._r8 + new_patch%tau_l = 0._r8 + new_patch%fuel_frac(:) = 0._r8 + new_patch%tfc_ros = 0._r8 + new_patch%fi = 0._r8 + new_patch%fd = 0._r8 + new_patch%ros_back = 0._r8 + new_patch%scorch_ht(:) = 0._r8 + new_patch%burnt_frac_litter(:) = 0._r8 new_patch%total_tree_area = 0.0_r8 new_patch%NCL_p = 1 @@ -2108,31 +2144,31 @@ subroutine zero_patch(cp_p) ! FIRE - currentPatch%litter_moisture(:) = 0.0_r8 ! litter moisture - currentPatch%fuel_eff_moist = 0.0_r8 ! average fuel moisture content of the ground fuel + currentPatch%litter_moisture(:) = nan ! litter moisture + currentPatch%fuel_eff_moist = nan ! average fuel moisture content of the ground fuel ! (incl. live grasses. omits 1000hr fuels) - currentPatch%livegrass = 0.0_r8 ! total ag grass biomass in patch. 1=c3 grass, 2=c4 grass. gc/m2 - currentPatch%sum_fuel = 0.0_r8 ! total ground fuel related to ros (omits 1000hr fuels). gc/m2 - currentPatch%fuel_bulkd = 0.0_r8 ! average fuel bulk density of the ground fuel + currentPatch%livegrass = nan ! total ag grass biomass in patch. 1=c3 grass, 2=c4 grass. gc/m2 + currentPatch%sum_fuel = nan ! total ground fuel related to ros (omits 1000hr fuels). gc/m2 + currentPatch%fuel_bulkd = nan ! average fuel bulk density of the ground fuel ! (incl. live grasses. omits 1000hr fuels). kgc/m3 - currentPatch%fuel_sav = 0.0_r8 ! average surface area to volume ratio of the ground fuel + currentPatch%fuel_sav = nan ! average surface area to volume ratio of the ground fuel ! (incl. live grasses. omits 1000hr fuels). - currentPatch%fuel_mef = 0.0_r8 ! average moisture of extinction factor of the ground fuel + currentPatch%fuel_mef = nan ! average moisture of extinction factor of the ground fuel ! (incl. live grasses. omits 1000hr fuels). - currentPatch%ros_front = 0.0_r8 ! average rate of forward spread of each fire in the patch. m/min. - currentPatch%effect_wspeed = 0.0_r8 ! dailywind modified by fraction of relative grass and tree cover. m/min. - currentPatch%tau_l = 0.0_r8 ! mins p&r(1986) - currentPatch%fuel_frac(:) = 0.0_r8 ! fraction of each litter class in the sum_fuel + currentPatch%ros_front = nan ! average rate of forward spread of each fire in the patch. m/min. + currentPatch%effect_wspeed = nan ! dailywind modified by fraction of relative grass and tree cover. m/min. + currentPatch%tau_l = nan ! mins p&r(1986) + currentPatch%fuel_frac(:) = nan ! fraction of each litter class in the sum_fuel !- for purposes of calculating weighted averages. - currentPatch%tfc_ros = 0.0_r8 ! used in fi calc - currentPatch%fi = 0._r8 ! average fire intensity of flaming front during day. + currentPatch%tfc_ros = nan ! used in fi calc + currentPatch%fi = nan ! average fire intensity of flaming front during day. ! backward ros plays no role. kj/m/s or kw/m. currentPatch%fire = 999 ! sr decide_fire.1=fire hot enough to proceed. 0=stop everything- no fires today - currentPatch%fd = 0.0_r8 ! fire duration (mins) - currentPatch%ros_back = 0.0_r8 ! backward ros (m/min) - currentPatch%scorch_ht(:) = 0.0_r8 ! scorch height of flames on a given PFT - currentPatch%frac_burnt = 0.0_r8 ! fraction burnt daily - currentPatch%burnt_frac_litter(:) = 0.0_r8 + currentPatch%fd = nan ! fire duration (mins) + currentPatch%ros_back = nan ! backward ros (m/min) + currentPatch%scorch_ht(:) = nan ! scorch height of flames on a given PFT + currentPatch%frac_burnt = nan ! fraction burnt daily + currentPatch%burnt_frac_litter(:) = nan currentPatch%btran_ft(:) = 0.0_r8 currentPatch%canopy_layer_tlai(:) = 0.0_r8 diff --git a/biogeochem/EDPhysiologyMod.F90 b/biogeochem/EDPhysiologyMod.F90 index 26073ecd35..fe184dd343 100644 --- a/biogeochem/EDPhysiologyMod.F90 +++ b/biogeochem/EDPhysiologyMod.F90 @@ -59,6 +59,7 @@ module EDPhysiologyMod use EDTypesMod , only : phen_dstat_moistoff use EDTypesMod , only : phen_dstat_moiston use EDTypesMod , only : phen_dstat_timeon + use EDTypesMod , only : init_recruit_trim use shr_log_mod , only : errMsg => shr_log_errMsg use FatesGlobals , only : fates_log use FatesGlobals , only : endrun => fates_endrun @@ -101,8 +102,10 @@ module EDPhysiologyMod use PRTLossFluxesMod, only : PRTPhenologyFlush use PRTLossFluxesMod, only : PRTDeciduousTurnover use PRTLossFluxesMod, only : PRTReproRelease + use PRTGenericMod, only : StorageNutrientTarget - + implicit none + private public :: trim_canopy public :: phenology @@ -120,8 +123,6 @@ module EDPhysiologyMod integer, parameter :: dleafon_drycheck = 100 ! Drought deciduous leaves max days on check parameter - - ! ============================================================================ @@ -227,10 +228,6 @@ subroutine PreDisturbanceLitterFluxes( currentSite, currentPatch, bc_in ) ! Calculate loss rate of viable seeds to litter call SeedDecay(litt) - ! Send those decaying seeds in the previous call - ! to the litter input flux - call SeedDecayToFines(litt) - ! Calculate seed germination rate, the status flags prevent ! germination from occuring when the site is in a drought ! (for drought deciduous) or too cold (for cold deciduous) @@ -239,7 +236,7 @@ subroutine PreDisturbanceLitterFluxes( currentSite, currentPatch, bc_in ) ! Send fluxes from newly created litter into the litter pools ! This litter flux is from non-disturbance inducing mortality, as well ! as litter fluxes from live trees - call CWDInput(currentSite, currentPatch, litt) + call CWDInput(currentSite, currentPatch, litt,bc_in) ! Only calculate fragmentation flux over layers that are active @@ -254,7 +251,8 @@ subroutine PreDisturbanceLitterFluxes( currentSite, currentPatch, bc_in ) ! Fragmentation flux to soil decomposition model [kg/site/day] site_mass%frag_out = site_mass%frag_out + currentPatch%area * & ( sum(litt%ag_cwd_frag) + sum(litt%bg_cwd_frag) + & - sum(litt%leaf_fines_frag) + sum(litt%root_fines_frag)) + sum(litt%leaf_fines_frag) + sum(litt%root_fines_frag) + & + sum(litt%seed_decay) + sum(litt%seed_germ_decay)) end do @@ -1450,9 +1448,9 @@ subroutine SeedIn( currentSite, bc_in ) case(carbon12_element) seed_stoich = 1._r8 case(nitrogen_element) - seed_stoich = prt_params%nitr_stoich_p2(pft,repro_organ) + seed_stoich = prt_params%nitr_recr_stoich(pft) case(phosphorus_element) - seed_stoich = prt_params%phos_stoich_p2(pft,repro_organ) + seed_stoich = prt_params%phos_recr_stoich(pft) case default write(fates_log(), *) 'undefined element specified' write(fates_log(), *) 'while defining forced external seed mass flux' @@ -1566,7 +1564,7 @@ end subroutine SeedGermination - + ! ===================================================================================== @@ -1623,7 +1621,7 @@ subroutine recruitment( currentSite, currentPatch, bc_in ) do ft = 1,numpft if(currentSite%use_this_pft(ft).eq.itrue)then - temp_cohort%canopy_trim = 0.8_r8 !starting with the canopy not fully expanded + temp_cohort%canopy_trim = init_recruit_trim temp_cohort%pft = ft temp_cohort%hite = EDPftvarcon_inst%hgt_min(ft) temp_cohort%coage = 0.0_r8 @@ -1689,7 +1687,7 @@ subroutine recruitment( currentSite, currentPatch, bc_in ) if ( (hlm_use_ed_prescribed_phys .eq. ifalse) .or. & (EDPftvarcon_inst%prescribed_recruitment(ft) .lt. 0._r8) ) then - temp_cohort%n = 1.e10_r8 + temp_cohort%n = 1.e20_r8 do el = 1,num_elements @@ -1697,24 +1695,34 @@ subroutine recruitment( currentSite, currentPatch, bc_in ) select case(element_id) case(carbon12_element) - mass_demand = (c_struct+c_leaf+c_fnrt+c_sapw+c_store) + mass_demand = c_struct+c_leaf+c_fnrt+c_sapw+c_store case(nitrogen_element) - - mass_demand = c_struct*prt_params%nitr_stoich_p1(ft,struct_organ) + & - c_leaf*prt_params%nitr_stoich_p1(ft,leaf_organ) + & - c_fnrt*prt_params%nitr_stoich_p1(ft,fnrt_organ) + & - c_sapw*prt_params%nitr_stoich_p1(ft,sapw_organ) + & - c_store*prt_params%nitr_stoich_p1(ft,store_organ) - + + mass_demand = & + c_struct*prt_params%nitr_stoich_p2(ft,prt_params%organ_param_id(struct_organ)) + & + c_leaf*prt_params%nitr_stoich_p2(ft,prt_params%organ_param_id(leaf_organ)) + & + c_fnrt*prt_params%nitr_stoich_p2(ft,prt_params%organ_param_id(fnrt_organ)) + & + c_sapw*prt_params%nitr_stoich_p2(ft,prt_params%organ_param_id(sapw_organ)) + & + StorageNutrientTarget(ft, element_id, & + c_leaf*prt_params%nitr_stoich_p2(ft,prt_params%organ_param_id(leaf_organ)), & + c_fnrt*prt_params%nitr_stoich_p2(ft,prt_params%organ_param_id(fnrt_organ)), & + c_sapw*prt_params%nitr_stoich_p2(ft,prt_params%organ_param_id(sapw_organ)), & + c_struct*prt_params%nitr_stoich_p2(ft,prt_params%organ_param_id(struct_organ))) + case(phosphorus_element) - - mass_demand = c_struct*prt_params%phos_stoich_p1(ft,struct_organ) + & - c_leaf*prt_params%phos_stoich_p1(ft,leaf_organ) + & - c_fnrt*prt_params%phos_stoich_p1(ft,fnrt_organ) + & - c_sapw*prt_params%phos_stoich_p1(ft,sapw_organ) + & - c_store*prt_params%phos_stoich_p1(ft,store_organ) - + + mass_demand = & + c_struct*prt_params%phos_stoich_p2(ft,prt_params%organ_param_id(struct_organ)) + & + c_leaf*prt_params%phos_stoich_p2(ft,prt_params%organ_param_id(leaf_organ)) + & + c_fnrt*prt_params%phos_stoich_p2(ft,prt_params%organ_param_id(fnrt_organ)) + & + c_sapw*prt_params%phos_stoich_p2(ft,prt_params%organ_param_id(sapw_organ)) + & + StorageNutrientTarget(ft, element_id, & + c_leaf*prt_params%phos_stoich_p2(ft,prt_params%organ_param_id(leaf_organ)), & + c_fnrt*prt_params%phos_stoich_p2(ft,prt_params%organ_param_id(fnrt_organ)), & + c_sapw*prt_params%phos_stoich_p2(ft,prt_params%organ_param_id(sapw_organ)), & + c_struct*prt_params%phos_stoich_p2(ft,prt_params%organ_param_id(struct_organ))) + case default write(fates_log(),*) 'Undefined element type in recruitment' call endrun(msg=errMsg(sourcefile, __LINE__)) @@ -1739,7 +1747,7 @@ subroutine recruitment( currentSite, currentPatch, bc_in ) endif ! Only bother allocating a new cohort if there is a reasonable amount of it - if (temp_cohort%n > min_n_safemath )then + any_recruits: if (temp_cohort%n > min_n_safemath )then ! ----------------------------------------------------------------------------- ! PART II. @@ -1767,20 +1775,20 @@ subroutine recruitment( currentSite, currentPatch, bc_in ) case(nitrogen_element) - m_struct = c_struct*prt_params%nitr_stoich_p1(ft,struct_organ) - m_leaf = c_leaf*prt_params%nitr_stoich_p1(ft,leaf_organ) - m_fnrt = c_fnrt*prt_params%nitr_stoich_p1(ft,fnrt_organ) - m_sapw = c_sapw*prt_params%nitr_stoich_p1(ft,sapw_organ) - m_store = c_store*prt_params%nitr_stoich_p1(ft,store_organ) + m_struct = c_struct*prt_params%nitr_stoich_p2(ft,prt_params%organ_param_id(struct_organ)) + m_leaf = c_leaf*prt_params%nitr_stoich_p2(ft,prt_params%organ_param_id(leaf_organ)) + m_fnrt = c_fnrt*prt_params%nitr_stoich_p2(ft,prt_params%organ_param_id(fnrt_organ)) + m_sapw = c_sapw*prt_params%nitr_stoich_p2(ft,prt_params%organ_param_id(sapw_organ)) + m_store = StorageNutrientTarget(ft, element_id, m_leaf, m_fnrt, m_sapw, m_struct ) m_repro = 0._r8 case(phosphorus_element) - m_struct = c_struct*prt_params%phos_stoich_p1(ft,struct_organ) - m_leaf = c_leaf*prt_params%phos_stoich_p1(ft,leaf_organ) - m_fnrt = c_fnrt*prt_params%phos_stoich_p1(ft,fnrt_organ) - m_sapw = c_sapw*prt_params%phos_stoich_p1(ft,sapw_organ) - m_store = c_store*prt_params%phos_stoich_p1(ft,store_organ) + m_struct = c_struct*prt_params%phos_stoich_p2(ft,prt_params%organ_param_id(struct_organ)) + m_leaf = c_leaf*prt_params%phos_stoich_p2(ft,prt_params%organ_param_id(leaf_organ)) + m_fnrt = c_fnrt*prt_params%phos_stoich_p2(ft,prt_params%organ_param_id(fnrt_organ)) + m_sapw = c_sapw*prt_params%phos_stoich_p2(ft,prt_params%organ_param_id(sapw_organ)) + m_store = StorageNutrientTarget(ft, element_id, m_leaf, m_fnrt, m_sapw, m_struct ) m_repro = 0._r8 end select @@ -1858,7 +1866,7 @@ subroutine recruitment( currentSite, currentPatch, bc_in ) currentSite%recruitment_rate(ft) = currentSite%recruitment_rate(ft) + temp_cohort%n - endif + endif any_recruits endif !use_this_pft enddo !pft loop @@ -1868,7 +1876,7 @@ end subroutine recruitment ! ============================================================================ - subroutine CWDInput( currentSite, currentPatch, litt) + subroutine CWDInput( currentSite, currentPatch, litt, bc_in) ! ! !DESCRIPTION: @@ -1886,7 +1894,7 @@ subroutine CWDInput( currentSite, currentPatch, litt) type(ed_site_type), intent(inout), target :: currentSite type(ed_patch_type),intent(inout), target :: currentPatch type(litter_type),intent(inout),target :: litt - + type(bc_in_type),intent(in) :: bc_in ! ! !LOCAL VARIABLES: @@ -1945,7 +1953,8 @@ subroutine CWDInput( currentSite, currentPatch, litt) do while(associated(currentCohort)) pft = currentCohort%pft - call set_root_fraction(currentSite%rootfrac_scr, pft, currentSite%zi_soil) + call set_root_fraction(currentSite%rootfrac_scr, pft, currentSite%zi_soil, & + bc_in%max_rooting_depth_index_col) leaf_m_turnover = currentCohort%prt%GetTurnover(leaf_organ,element_id) store_m_turnover = currentCohort%prt%GetTurnover(store_organ,element_id) @@ -2195,38 +2204,6 @@ end subroutine CWDInput ! ===================================================================================== - subroutine SeedDecayToFines(litt) - - type(litter_type) :: litt - ! - ! !LOCAL VARIABLES: - integer :: pft - - ! Add decaying seeds to the leaf litter - ! ----------------------------------------------------------------------------------- - - do pft = 1,numpft - - litt%leaf_fines_in(ilabile) = litt%leaf_fines_in(ilabile) + & - (litt%seed_decay(pft) + litt%seed_germ_decay(pft)) * EDPftvarcon_inst%lf_flab(pft) - - litt%leaf_fines_in(icellulose) = litt%leaf_fines_in(icellulose) + & - (litt%seed_decay(pft) + litt%seed_germ_decay(pft)) * EDPftvarcon_inst%lf_fcel(pft) - - litt%leaf_fines_in(ilignin) = litt%leaf_fines_in(ilignin) + & - (litt%seed_decay(pft) + litt%seed_germ_decay(pft)) * EDPftvarcon_inst%lf_flig(pft) - - enddo - - - return - end subroutine SeedDecayToFines - - - - - - ! ===================================================================================== subroutine fragmentation_scaler( currentPatch, bc_in) ! diff --git a/biogeochem/FatesAllometryMod.F90 b/biogeochem/FatesAllometryMod.F90 index a24653e652..8e27faae22 100644 --- a/biogeochem/FatesAllometryMod.F90 +++ b/biogeochem/FatesAllometryMod.F90 @@ -127,6 +127,8 @@ module FatesAllometryMod logical , parameter :: verbose_logging = .false. character(len=*), parameter :: sourcefile = __FILE__ + + logical, parameter :: debug = .false. ! If testing b4b with older versions, do not remove sapwood ! Our old methods with saldarriaga did not remove sapwood from the @@ -1968,7 +1970,7 @@ end subroutine carea_2pwr ! ========================================================================= - subroutine set_root_fraction(root_fraction, ft, zi) + subroutine set_root_fraction(root_fraction, ft, zi, max_nlevroot) ! ! !DESCRIPTION: @@ -1983,8 +1985,13 @@ subroutine set_root_fraction(root_fraction, ft, zi) ! !ARGUMENTS real(r8),intent(inout) :: root_fraction(:) ! Normalized profile integer, intent(in) :: ft ! functional typpe - real(r8),intent(in) :: zi(0:) ! Center of depth [m] + real(r8),intent(in) :: zi(0:) ! Center of depth [m] + + ! The soil may not be active over the soil whole column due to things + ! like permafrost. If so, compress profile over the maximum depth + integer,optional, intent(in) :: max_nlevroot + ! locals real(r8) :: a_par ! local temporary for "a" parameter real(r8) :: b_par ! "" "b" parameter @@ -2010,7 +2017,8 @@ subroutine set_root_fraction(root_fraction, ft, zi) integer :: root_profile_type integer :: corr_id(1) ! This is the bin with largest fraction - ! add/subtract any corrections there + ! add/subtract any corrections there + integer :: nlevroot real(r8) :: correction ! This correction ensures that root fractions ! sum to 1.0 @@ -2022,13 +2030,27 @@ subroutine set_root_fraction(root_fraction, ft, zi) call endrun(msg=errMsg(sourcefile, __LINE__)) end if + nlevroot = ubound(zi,1) + + ! Set root fraction to zero in all layers, as some may be inactive + ! and we will only calculate the profiles over those + root_fraction(:) = 0._r8 + + if(present(max_nlevroot))then + if(debug .and. max_nlevroot<0)then + write(fates_log(),*) 'A maximum rooting layer depth <0 was specified' + call endrun(msg=errMsg(sourcefile, __LINE__)) + end if + nlevroot = min(max_nlevroot,nlevroot) + end if + select case(nint(prt_params%fnrt_prof_mode(ft))) case ( exponential_1p_profile_type ) - call exponential_1p_root_profile(root_fraction, zi, prt_params%fnrt_prof_a(ft)) + call exponential_1p_root_profile(root_fraction(1:nlevroot), zi(0:nlevroot), prt_params%fnrt_prof_a(ft)) case ( jackson_beta_profile_type ) - call jackson_beta_root_profile(root_fraction, zi, prt_params%fnrt_prof_a(ft)) + call jackson_beta_root_profile(root_fraction(1:nlevroot), zi(0:nlevroot), prt_params%fnrt_prof_a(ft)) case ( exponential_2p_profile_type ) - call exponential_2p_root_profile(root_fraction, zi, & + call exponential_2p_root_profile(root_fraction(1:nlevroot), zi(0:nlevroot), & prt_params%fnrt_prof_a(ft),prt_params%fnrt_prof_b(ft)) case default diff --git a/biogeochem/FatesSoilBGCFluxMod.F90 b/biogeochem/FatesSoilBGCFluxMod.F90 index 258c37e847..9f210e8404 100644 --- a/biogeochem/FatesSoilBGCFluxMod.F90 +++ b/biogeochem/FatesSoilBGCFluxMod.F90 @@ -31,6 +31,7 @@ module FatesSoilBGCFluxMod use PRTGenericMod , only : repro_organ use PRTGenericMod , only : struct_organ use PRTGenericMod , only : SetState + use PRTAllometricCNPMod,only : stoich_max use FatesAllometryMod, only : set_root_fraction use FatesAllometryMod , only : h_allom use FatesAllometryMod , only : h2d_allom @@ -53,6 +54,7 @@ module FatesSoilBGCFluxMod use FatesInterfaceTypesMod, only : numpft use FatesInterfaceTypesMod, only : hlm_nu_com use FatesInterfaceTypesMod, only : hlm_parteh_mode + use FatesInterfaceTypesMod, only : hlm_use_ch4 use FatesConstantsMod , only : prescribed_p_uptake use FatesConstantsMod , only : prescribed_n_uptake use FatesConstantsMod , only : coupled_p_uptake @@ -63,7 +65,12 @@ module FatesSoilBGCFluxMod use FatesConstantsMod, only : fates_np_comp_scaling use FatesConstantsMod, only : cohort_np_comp_scaling use FatesConstantsMod, only : pft_np_comp_scaling + use FatesConstantsMod, only : trivial_np_comp_scaling use FatesConstantsMod, only : rsnbl_math_prec + use FatesConstantsMod, only : days_per_year + use FatesConstantsMod, only : sec_per_day + use FatesConstantsMod, only : years_per_day + use FatesConstantsMod, only : itrue use FatesLitterMod, only : litter_type use FatesLitterMod , only : ncwd use FatesLitterMod , only : ndcmpy @@ -72,10 +79,12 @@ module FatesSoilBGCFluxMod use FatesLitterMod , only : icellulose use PRTParametersMod , only : prt_params use EDPftvarcon , only : EDPftvarcon_inst + use FatesUtilsMod, only : check_var_real implicit none private - + + public :: PrepCH4Bcs public :: PrepNutrientAquisitionBCs public :: UnPackNutrientAquisitionBCs public :: FluxIntoLitterPools @@ -114,8 +123,9 @@ function GetPlantDemand(ccohort,element_id) result(plant_demand) real(r8) :: plant_max_x ! Maximum mass for element of interest [kg] integer :: pft real(r8) :: dbh + real(r8) :: leafm,fnrtm,sapwm,structm,storem - real(r8), parameter :: smth_fac = 0.8_r8 ! Smoothing factor for updating + real(r8), parameter :: smth_fac = 0.1_r8 ! Smoothing factor for updating ! demand. real(r8), parameter :: init_demand_frac = 0.1_r8 ! Newly recruited plants ! will specify a demand @@ -130,31 +140,10 @@ function GetPlantDemand(ccohort,element_id) result(plant_demand) ! If the cohort has not experienced a day of integration - ! (and thus any allocation yet), we specify demand - ! based purely on a fraction of its starting nutrient content + ! (and thus any allocation yet), it has no deficit + ! in its storage to drive any need, so it thus has no demand if(ccohort%isnew) then - - if(element_id.eq.nitrogen_element) then - plant_max_x = & - ccohort%prt%GetState(leaf_organ, carbon12_element)*prt_params%nitr_stoich_p2(pft,leaf_organ) + & - ccohort%prt%GetState(fnrt_organ, carbon12_element)*prt_params%nitr_stoich_p2(pft,fnrt_organ) + & - ccohort%prt%GetState(store_organ, carbon12_element)*prt_params%nitr_stoich_p2(pft,store_organ) + & - ccohort%prt%GetState(sapw_organ, carbon12_element)*prt_params%nitr_stoich_p2(pft,sapw_organ) + & - ccohort%prt%GetState(struct_organ, carbon12_element)*prt_params%nitr_stoich_p2(pft,struct_organ) + & - ccohort%prt%GetState(repro_organ, carbon12_element)*prt_params%nitr_stoich_p2(pft,repro_organ) - - elseif(element_id.eq.phosphorus_element) then - plant_max_x = & - ccohort%prt%GetState(leaf_organ, carbon12_element)*prt_params%phos_stoich_p2(pft,leaf_organ) + & - ccohort%prt%GetState(fnrt_organ, carbon12_element)*prt_params%phos_stoich_p2(pft,fnrt_organ) + & - ccohort%prt%GetState(store_organ, carbon12_element)*prt_params%phos_stoich_p2(pft,store_organ) + & - ccohort%prt%GetState(sapw_organ, carbon12_element)*prt_params%phos_stoich_p2(pft,sapw_organ) + & - ccohort%prt%GetState(struct_organ, carbon12_element)*prt_params%phos_stoich_p2(pft,struct_organ) + & - ccohort%prt%GetState(repro_organ, carbon12_element)*prt_params%phos_stoich_p2(pft,repro_organ) - - end if - - plant_demand = init_demand_frac*plant_max_x + plant_demand = 0._r8 return end if @@ -165,11 +154,11 @@ function GetPlantDemand(ccohort,element_id) result(plant_demand) if(element_id.eq.nitrogen_element) then - plant_demand = smth_fac*ccohort%daily_n_demand + (1._r8-smth_fac)*ccohort%daily_n_need2 + plant_demand = smth_fac*ccohort%daily_n_demand + (1._r8-smth_fac)*max(0._r8,ccohort%daily_n_need) elseif(element_id.eq.phosphorus_element) then - plant_demand = smth_fac*ccohort%daily_p_demand + (1._r8-smth_fac)*ccohort%daily_p_need2 + plant_demand = smth_fac*ccohort%daily_p_demand + (1._r8-smth_fac)*max(0._r8,ccohort%daily_p_need) end if @@ -210,7 +199,6 @@ subroutine UnPackNutrientAquisitionBCs(sites, bc_in) real(r8) :: fnrt_c ! fine-root carbon [kg] real(r8) :: fnrt_c_pft(numpft) ! total mass of root for each PFT [kgC] - nsites = size(sites,dim=1) @@ -220,7 +208,8 @@ subroutine UnPackNutrientAquisitionBCs(sites, bc_in) do while (associated(cpatch)) ccohort => cpatch%tallest do while (associated(ccohort)) - ccohort%daily_n_uptake = 0._r8 + ccohort%daily_nh4_uptake = 0._r8 + ccohort%daily_no3_uptake = 0._r8 ccohort%daily_p_uptake = 0._r8 ccohort => ccohort%shorter end do @@ -233,13 +222,13 @@ subroutine UnPackNutrientAquisitionBCs(sites, bc_in) if(hlm_parteh_mode.eq.prt_carbon_allom_hyp) then ! These can now be zero'd do s = 1, nsites - bc_in(s)%plant_n_uptake_flux(:,:) = 0._r8 + bc_in(s)%plant_nh4_uptake_flux(:,:) = 0._r8 + bc_in(s)%plant_no3_uptake_flux(:,:) = 0._r8 bc_in(s)%plant_p_uptake_flux(:,:) = 0._r8 end do return end if - do s = 1, nsites ! If the plant is in "prescribed uptake mode" @@ -257,8 +246,9 @@ subroutine UnPackNutrientAquisitionBCs(sites, bc_in) pft = ccohort%pft ccohort%daily_n_demand = GetPlantDemand(ccohort,nitrogen_element) - ccohort%daily_n_uptake = EDPftvarcon_inst%prescribed_nuptake(pft) * ccohort%daily_n_demand - + ccohort%daily_nh4_uptake = EDPftvarcon_inst%prescribed_nuptake(pft) * ccohort%daily_n_demand + ccohort%daily_no3_uptake = 0._r8 + ccohort => ccohort%shorter end do cpatch => cpatch%younger @@ -331,9 +321,12 @@ subroutine UnPackNutrientAquisitionBCs(sites, bc_in) ccohort => cpatch%tallest do while (associated(ccohort)) icomp = icomp+1 + ! N Uptake: Convert g/m2/day -> kg/plant/day - ccohort%daily_n_uptake = ccohort%daily_n_uptake + & - sum(bc_in(s)%plant_n_uptake_flux(icomp,:))*kg_per_g*AREA/ccohort%n + + ccohort%daily_nh4_uptake = sum(bc_in(s)%plant_nh4_uptake_flux(icomp,:))*kg_per_g*AREA/ccohort%n + ccohort%daily_no3_uptake = sum(bc_in(s)%plant_no3_uptake_flux(icomp,:))*kg_per_g*AREA/ccohort%n + ccohort => ccohort%shorter end do cpatch => cpatch%younger @@ -352,8 +345,11 @@ subroutine UnPackNutrientAquisitionBCs(sites, bc_in) ! Loop through soil layers, add up the uptake this cohort gets from each layer do id = 1,bc_in(s)%nlevdecomp - ccohort%daily_n_uptake = ccohort%daily_n_uptake + & - bc_in(s)%plant_n_uptake_flux(pft,id) * & + ccohort%daily_nh4_uptake = ccohort%daily_nh4_uptake + & + bc_in(s)%plant_nh4_uptake_flux(pft,id) * & + (fnrt_c/fnrt_c_pft(pft))*kg_per_g*AREA/ccohort%n + ccohort%daily_no3_uptake = ccohort%daily_no3_uptake + & + bc_in(s)%plant_no3_uptake_flux(pft,id) * & (fnrt_c/fnrt_c_pft(pft))*kg_per_g*AREA/ccohort%n end do @@ -411,7 +407,8 @@ subroutine UnPackNutrientAquisitionBCs(sites, bc_in) end if n_or_p_coupled_if ! These can now be zero'd - bc_in(s)%plant_n_uptake_flux(:,:) = 0._r8 + bc_in(s)%plant_nh4_uptake_flux(:,:) = 0._r8 + bc_in(s)%plant_no3_uptake_flux(:,:) = 0._r8 bc_in(s)%plant_p_uptake_flux(:,:) = 0._r8 end do @@ -420,6 +417,153 @@ end subroutine UnPackNutrientAquisitionBCs ! ===================================================================================== + subroutine PrepCH4BCs(csite,bc_in,bc_out) + + ! + ! This routine prepares the output boundary conditions for methane calculations + ! in ELM/CLM. + ! ----------------------------------------------------------------------------------- + + + ! !ARGUMENTS + type(ed_site_type), intent(inout) :: csite + + type(bc_out_type), intent(inout) :: bc_out + type(bc_in_type), intent(in) :: bc_in + type(ed_patch_type), pointer :: cpatch ! current patch pointer + type(ed_cohort_type), pointer :: ccohort ! current cohort pointer + integer :: pft ! plant functional type + integer :: fp ! patch index of the site + real(r8) :: agnpp ! Above ground daily npp + real(r8) :: bgnpp ! Below ground daily npp + real(r8) :: plant_area ! crown area (m2) of all plants in patch + real(r8) :: woody_area ! corwn area (m2) of woody plants in patch + real(r8) :: fnrt_c ! Fine root carbon [kg/plant] + real(r8) :: sapw_net_alloc + real(r8) :: store_net_alloc + real(r8) :: fnrt_net_alloc + real(r8) :: leaf_net_alloc + real(r8) :: struct_net_alloc + real(r8) :: repro_net_alloc + + ! Exit if we need not communicate with the hlm's ch4 module + if(.not.(hlm_use_ch4==itrue)) return + + ! Initialize to zero + bc_out%annavg_agnpp_pa(:) = 0._r8 + bc_out%annavg_bgnpp_pa(:) = 0._r8 + bc_out%annsum_npp_pa(:) = 0._r8 + bc_out%rootfr_pa(:,:) = 0._r8 + bc_out%frootc_pa(:) = 0._r8 + bc_out%root_resp(:) = 0._r8 + bc_out%woody_frac_aere_pa(:) = 0._r8 + + fp = 0 + cpatch => csite%oldest_patch + do while (associated(cpatch)) + + ! Patch ordering when passing boundary conditions + ! always goes from oldest to youngest, following + ! the convention of EDPatchDynamics::set_patchno() + + fp = fp + 1 + + agnpp = 0._r8 + bgnpp = 0._r8 + woody_area = 0._r8 + plant_area = 0._r8 + + ccohort => cpatch%tallest + do while (associated(ccohort)) + + ! For consistency, only apply calculations to non-new + ! cohorts. New cohorts will not have respiration rates + ! at this point in the call sequence. + + if(.not.ccohort%isnew) then + + pft = ccohort%pft + + call set_root_fraction(csite%rootfrac_scr, pft, csite%zi_soil, & + bc_in%max_rooting_depth_index_col ) + + fnrt_c = ccohort%prt%GetState(fnrt_organ, carbon12_element) + + ! Fine root fraction over depth + + bc_out%rootfr_pa(fp,1:bc_in%nlevsoil) = & + bc_out%rootfr_pa(fp,1:bc_in%nlevsoil) + & + csite%rootfrac_scr(1:bc_in%nlevsoil) + + ! Fine root carbon, convert [kg/plant] -> [g/m2] + bc_out%frootc_pa(fp) = & + bc_out%frootc_pa(fp) + & + fnrt_c*ccohort%n/cpatch%area * g_per_kg + + ! [kgC/day] + sapw_net_alloc = ccohort%prt%GetNetAlloc(sapw_organ, carbon12_element) * days_per_sec + store_net_alloc = ccohort%prt%GetNetAlloc(store_organ, carbon12_element) * days_per_sec + leaf_net_alloc = ccohort%prt%GetNetAlloc(leaf_organ, carbon12_element) * days_per_sec + fnrt_net_alloc = ccohort%prt%GetNetAlloc(fnrt_organ, carbon12_element) * days_per_sec + struct_net_alloc = ccohort%prt%GetNetAlloc(struct_organ, carbon12_element) * days_per_sec + repro_net_alloc = ccohort%prt%GetNetAlloc(repro_organ, carbon12_element) * days_per_sec + + ! [kgC/plant/day] -> [gC/m2/s] + agnpp = agnpp + ccohort%n/cpatch%area * (leaf_net_alloc + repro_net_alloc + & + prt_params%allom_agb_frac(pft)*(sapw_net_alloc+store_net_alloc+struct_net_alloc)) * g_per_kg + + ! [kgC/plant/day] -> [gC/m2/s] + bgnpp = bgnpp + ccohort%n/cpatch%area * (fnrt_net_alloc + & + (1._r8-prt_params%allom_agb_frac(pft))*(sapw_net_alloc+store_net_alloc+struct_net_alloc)) * g_per_kg + + ! (gC/m2/s) root respiration (fine root MR + total root GR) + ! RGK: We do not save root respiration and average over the day. Until we do + ! this is a best (bad) guess at fine root MR + total root GR + ! (kgC/indiv/yr) -> gC/m2/s + bc_out%root_resp(1:bc_in%nlevsoil) = bc_out%root_resp(1:bc_in%nlevsoil) + & + ccohort%resp_acc_hold*years_per_day*g_per_kg*days_per_sec* & + ccohort%n*area_inv*(1._r8-prt_params%allom_agb_frac(pft)) * csite%rootfrac_scr(1:bc_in%nlevsoil) + + if( prt_params%woody(pft)==itrue ) then + woody_area = woody_area + ccohort%c_area + end if + plant_area = plant_area + ccohort%c_area + + + end if + + ccohort => ccohort%shorter + end do + + if( sum(bc_out%rootfr_pa(fp,1:bc_in%nlevsoil)) > nearzero) then + bc_out%rootfr_pa(fp,1:bc_in%nlevsoil) = & + bc_out%rootfr_pa(fp,1:bc_in%nlevsoil) / & + sum(bc_out%rootfr_pa(fp,1:bc_in%nlevsoil)) + end if + + ! RGK: These averages should switch to the new patch averaging methods + ! when available. Right now we are not doing any time averaging + ! because it would be mixing the memory of patches, which + ! would be arguably worse than just using the instantaneous value + + ! gC/m2/s + bc_out%annavg_agnpp_pa(fp) = agnpp + bc_out%annavg_bgnpp_pa(fp) = bgnpp + ! gc/m2/yr + bc_out%annsum_npp_pa(fp) = (bgnpp+agnpp)*days_per_year*sec_per_day + + if(plant_area>nearzero) then + bc_out%woody_frac_aere_pa(fp) = woody_area/plant_area + end if + + cpatch => cpatch%younger + end do + + return + end subroutine PrepCH4BCs + + ! ===================================================================================== + subroutine PrepNutrientAquisitionBCs(csite, bc_in, bc_out) ! ----------------------------------------------------------------------------------- @@ -440,7 +584,6 @@ subroutine PrepNutrientAquisitionBCs(csite, bc_in, bc_out) integer :: j ! soil layer index integer :: id ! decomp index (might == j) integer :: pft ! plant functional type - integer :: nlev_eff_soil ! number of active soil layers type(ed_patch_type), pointer :: cpatch ! current patch pointer type(ed_cohort_type), pointer :: ccohort ! current cohort pointer real(r8) :: fnrt_c ! fine-root carbon [kg] @@ -453,43 +596,50 @@ subroutine PrepNutrientAquisitionBCs(csite, bc_in, bc_out) real(r8) :: deficit_p_demand ! Phosphorus needed to get stoich back to ! optimal [kgP] real(r8) :: comp_per_pft(numpft) ! Competitors per PFT, used for averaging - - - ! Run the trivial case where we do not have a nutrient model - ! running in fates, send zero demands to the BGC model - if((hlm_parteh_mode.ne.prt_cnp_flex_allom_hyp)) then - bc_out%num_plant_comps = 1 - if(trim(hlm_nu_com).eq.'ECA')then - bc_out%ft_index(1) = 1 - bc_out%veg_rootc(1,:) = 0._r8 - bc_out%cn_scalar(1) = 0._r8 - bc_out%cp_scalar(1) = 0._r8 - bc_out%decompmicc(1) = 0._r8 - elseif(trim(hlm_nu_com).eq.'RD') then + real(r8) :: decompmicc_layer ! Microbial dedcomposer biomass for current layer + integer :: comp_scaling ! Flag that defines the boundary condition scaling method (includes trivial) + + real(r8), parameter :: decompmicc_lambda = 2.5_r8 ! Depth attenuation exponent for decomposer biomass + real(r8), parameter :: decompmicc_zmax = 7.0e-2_r8 ! Depth of maximum decomposer biomass + + ! Determine the scaling approach + if((hlm_parteh_mode.eq.prt_cnp_flex_allom_hyp) .and. & + ((n_uptake_mode.eq.coupled_n_uptake) .or. & + (p_uptake_mode.eq.coupled_p_uptake))) then + comp_scaling = fates_np_comp_scaling + + else + + comp_scaling = trivial_np_comp_scaling + + ! Note: With ECA, we still need to update the + ! decomp microbe density even if we are not + ! fully coupled, so can't exit yet + + if(trim(hlm_nu_com).eq.'RD') then + bc_out%num_plant_comps = 1 bc_out%n_demand(1) = 0._r8 bc_out%p_demand(1) = 0._r8 + return end if - return + end if - ! This is the number of effective soil layers to transfer from - nlev_eff_soil = max(bc_in%max_rooting_depth_index_col, 1) - ! ECA Specific Parameters ! -------------------------------------------------------------------------------- if(trim(hlm_nu_com).eq.'ECA')then bc_out%veg_rootc(:,:) = 0._r8 ! Zero this, it will be incremented + bc_out%decompmicc(:) = 0._r8 bc_out%cn_scalar(:) = 0._r8 bc_out%cp_scalar(:) = 0._r8 - bc_out%decompmicc(:) = 0._r8 bc_out%ft_index(:) = -1 ! Loop over all patches and sum up the seed input for each PFT icomp = 0 comp_per_pft(:) = 0 ! This counts how many competitors per + ! pft, used for averaging - ! pft, used for averaging cpatch => csite%oldest_patch do while (associated(cpatch)) @@ -497,43 +647,50 @@ subroutine PrepNutrientAquisitionBCs(csite, bc_in, bc_out) do while (associated(ccohort)) pft = ccohort%pft - - if(fates_np_comp_scaling.eq.cohort_np_comp_scaling) then + + ! If we are not coupling plant uptake + ! with ECA, then we send 1 token + ! competitor with plant root biomass, but no + ! uptake affinity + + if(comp_scaling.eq.cohort_np_comp_scaling) then icomp = icomp+1 + bc_out%ft_index(icomp) = pft else icomp = pft comp_per_pft(pft) = comp_per_pft(pft) + 1 + bc_out%ft_index(icomp) = pft end if - call set_root_fraction(csite%rootfrac_scr, pft, csite%zi_soil) + call set_root_fraction(csite%rootfrac_scr, pft, csite%zi_soil, & + bc_in%max_rooting_depth_index_col ) - fnrt_c = ccohort%prt%GetState(fnrt_organ, all_carbon_elements) + fnrt_c = ccohort%prt%GetState(fnrt_organ, carbon12_element) ! Map the soil layers to the decomposition layers ! (which may be synonomous) ! veg_rootc in units: [g/m3] = [kgC/plant] * [plant/ha] * [ha/ 10k m2] * [1000 g / kg] * [1/m] - - do j = 1, nlev_eff_soil + + do j = 1, bc_in%nlevdecomp id = bc_in%decomp_id(j) ! Map from soil layer to decomp layer veg_rootc = fnrt_c * ccohort%n * csite%rootfrac_scr(j) * AREA_INV * g_per_kg / csite%dz_soil(j) + bc_out%veg_rootc(icomp,id) = bc_out%veg_rootc(icomp,id) + veg_rootc - bc_out%decompmicc(id) = bc_out%decompmicc(id) + & - EDPftvarcon_inst%decompmicc(pft) * veg_rootc - end do - - bc_out%ft_index(icomp) = pft + ! We use a 3 parameter exponential attenuation function to estimate decomposer biomass + ! The parameter EDPftvarcon_inst%decompmicc(pft) is the maximum amount found at depth + ! decompmicc_zmax, and the profile attenuates with strength lambda + + decompmicc_layer = EDPftvarcon_inst%decompmicc(pft) * & + exp(-decompmicc_lambda*abs(csite%z_soil(j)-decompmicc_zmax)) + + bc_out%decompmicc(id) = bc_out%decompmicc(id) + decompmicc_layer * veg_rootc + end do ccohort => ccohort%shorter end do cpatch => cpatch%younger end do - - if(fates_np_comp_scaling.eq.cohort_np_comp_scaling) then - bc_out%num_plant_comps = icomp - else - bc_out%num_plant_comps = numpft - end if ! We calculate the decomposer microbial biomass by weighting with the ! root biomass. This is just the normalization step @@ -542,6 +699,17 @@ subroutine PrepNutrientAquisitionBCs(csite, bc_in, bc_out) max(nearzero,sum(bc_out%veg_rootc(:,id),dim=1)) end do + if(comp_scaling.eq.cohort_np_comp_scaling) then + bc_out%num_plant_comps = icomp + elseif(comp_scaling.eq.pft_np_comp_scaling) then + bc_out%num_plant_comps = numpft + elseif(comp_scaling.eq.trivial_np_comp_scaling) then + bc_out%num_plant_comps = 1 + ! Now that the microbial density is calculated + ! we can exit the trivial case + return + end if + coupled_n_if: if(n_uptake_mode.eq.coupled_n_uptake) then icomp = 0 cpatch => csite%oldest_patch @@ -571,9 +739,14 @@ subroutine PrepNutrientAquisitionBCs(csite, bc_in, bc_out) bc_out%cn_scalar(icomp) = bc_out%cn_scalar(icomp)/real(comp_per_pft(icomp),r8) end do end if + + else + + ! If we are not coupling N, then make sure to set affinity of plants to 0 + ! (it is possible to be here if P is coupled but N is not) + bc_out%cn_scalar(:) = 0._r8 end if coupled_n_if - coupled_p_if: if(p_uptake_mode.eq.coupled_p_uptake) then @@ -603,6 +776,11 @@ subroutine PrepNutrientAquisitionBCs(csite, bc_in, bc_out) bc_out%cp_scalar(icomp) = bc_out%cp_scalar(icomp)/real(comp_per_pft(icomp),r8) end do end if + else + + ! If we are not coupling P, then make sure to set affinity of plants to 0 + ! (it is possible to be here if N is coupled but P is not) + bc_out%cp_scalar(:) = 0._r8 end if coupled_p_if @@ -624,6 +802,7 @@ subroutine PrepNutrientAquisitionBCs(csite, bc_in, bc_out) end do cpatch => cpatch%younger end do + end if if(p_uptake_mode .eq. coupled_p_uptake ) then @@ -654,7 +833,6 @@ subroutine PrepNutrientAquisitionBCs(csite, bc_in, bc_out) ccohort => cpatch%tallest do while (associated(ccohort)) pft = ccohort%pft - dbh = ccohort%dbh if(fates_np_comp_scaling.eq.cohort_np_comp_scaling) then icomp = icomp+1 else @@ -676,7 +854,6 @@ subroutine PrepNutrientAquisitionBCs(csite, bc_in, bc_out) ccohort => cpatch%tallest do while (associated(ccohort)) pft = ccohort%pft - dbh = ccohort%dbh if(fates_np_comp_scaling.eq.cohort_np_comp_scaling) then icomp = icomp+1 else @@ -690,17 +867,12 @@ subroutine PrepNutrientAquisitionBCs(csite, bc_in, bc_out) end do end if - if( (n_uptake_mode.eq.coupled_n_uptake) .or. & - (p_uptake_mode.eq.coupled_p_uptake)) then - if(fates_np_comp_scaling.eq.cohort_np_comp_scaling) then - bc_out%num_plant_comps = icomp - else - bc_out%num_plant_comps = numpft - end if - + if(comp_scaling.eq.cohort_np_comp_scaling) then + bc_out%num_plant_comps = icomp + elseif(comp_scaling.eq.pft_np_comp_scaling) then + bc_out%num_plant_comps = numpft else bc_out%num_plant_comps = 1 - end if end if @@ -772,7 +944,6 @@ subroutine FluxIntoLitterPools(csite, bc_in, bc_out) ! into the soil/decomposition ! layers. It exponentially decays real(r8) :: surface_prof_tot ! normalizes the surface_prof array - integer :: ft ! PFT number integer :: nlev_eff_soil ! number of effective soil layers integer :: nlev_eff_decomp ! number of effective decomp layers real(r8) :: area_frac ! fraction of site's area of current patch @@ -782,12 +953,12 @@ subroutine FluxIntoLitterPools(csite, bc_in, bc_out) integer :: j ! Soil layer index integer :: id ! Decomposition layer index integer :: ic ! CWD type index + integer :: ipft ! PFT index ! NOTE(rgk, 201705) this parameter was brought over from SoilBiogeochemVerticalProfile ! how steep profile is for surface components (1/ e_folding depth) (1/m) real(r8), parameter :: surfprof_exp = 10. - ! This is the number of effective soil layers to transfer from nlev_eff_soil = max(bc_in%max_rooting_depth_index_col, 1) @@ -816,7 +987,7 @@ subroutine FluxIntoLitterPools(csite, bc_in, bc_out) do id = 1,nlev_eff_decomp surface_prof(id) = surface_prof(id)/surface_prof_tot end do - + ! Loop over the different elements. do el = 1, num_elements @@ -826,9 +997,9 @@ subroutine FluxIntoLitterPools(csite, bc_in, bc_out) select case (element_list(el)) case (carbon12_element) - bc_out%litt_flux_cel_c_si(:) = 0._r8 - bc_out%litt_flux_lig_c_si(:) = 0._r8 - bc_out%litt_flux_lab_c_si(:) = 0._r8 + bc_out%litt_flux_cel_c_si(:) = 0.0_r8 + bc_out%litt_flux_lig_c_si(:) = 0.0_r8 + bc_out%litt_flux_lab_c_si(:) = 0.0_r8 flux_cel_si => bc_out%litt_flux_cel_c_si(:) flux_lab_si => bc_out%litt_flux_lab_c_si(:) flux_lig_si => bc_out%litt_flux_lig_c_si(:) @@ -840,11 +1011,6 @@ subroutine FluxIntoLitterPools(csite, bc_in, bc_out) flux_cel_si => bc_out%litt_flux_cel_n_si(:) flux_lab_si => bc_out%litt_flux_lab_n_si(:) flux_lig_si => bc_out%litt_flux_lig_n_si(:) - - ! If we have prescribed boundary conditions - ! we do not take N out of the BGC model's - ! stores, so nor do we send any back - if(n_uptake_mode.eq.prescribed_n_uptake) cycle case (phosphorus_element) bc_out%litt_flux_cel_p_si(:) = 0._r8 @@ -853,21 +1019,15 @@ subroutine FluxIntoLitterPools(csite, bc_in, bc_out) flux_cel_si => bc_out%litt_flux_cel_p_si(:) flux_lab_si => bc_out%litt_flux_lab_p_si(:) flux_lig_si => bc_out%litt_flux_lig_p_si(:) - - ! If we have prescribed boundary conditions - ! we do not take N out of the BGC model's - ! stores, so nor do we send any back - if(p_uptake_mode.eq.prescribed_p_uptake) cycle end select - currentPatch => csite%oldest_patch do while (associated(currentPatch)) ! If there is any efflux (from stores overflowing) ! than pass that to the labile litter pool - + currentCohort => currentPatch%tallest do while(associated(currentCohort)) if(.not.currentCohort%isnew)then @@ -878,20 +1038,25 @@ subroutine FluxIntoLitterPools(csite, bc_in, bc_out) elseif(element_list(el).eq.phosphorus_element) then efflux_ptr => currentCohort%daily_p_efflux end if + + ! Unit conversion + ! kg/plant/day * plant/ha * ha/m2 -> kg/m2/day + do id = 1,nlev_eff_decomp flux_lab_si(id) = flux_lab_si(id) + & - efflux_ptr*currentCohort%n* AREA_INV * surface_prof(id) + efflux_ptr * currentCohort%n* AREA_INV * surface_prof(id) end do end if currentCohort => currentCohort%shorter end do - + + ! Set a pointer to the litter object ! for the current element on the current ! patch litt => currentPatch%litter(el) area_frac = currentPatch%area/area - + do ic = 1, ncwd do id = 1,nlev_eff_decomp @@ -930,10 +1095,29 @@ subroutine FluxIntoLitterPools(csite, bc_in, bc_out) end do + + ! decaying seeds from the litter pool + do ipft = 1,numpft + do id = 1,nlev_eff_decomp + + flux_lab_si(id) = flux_lab_si(id) + & + (litt%seed_decay(ipft) + litt%seed_germ_decay(ipft)) * & + EDPftvarcon_inst%lf_flab(ipft) * area_frac* surface_prof(id) + + flux_cel_si(id) = flux_cel_si(id) + & + (litt%seed_decay(ipft) + litt%seed_germ_decay(ipft)) * & + EDPftvarcon_inst%lf_fcel(ipft) * area_frac* surface_prof(id) + + flux_lig_si(id) = flux_lig_si(id) + & + (litt%seed_decay(ipft) + litt%seed_germ_decay(ipft)) * & + EDPftvarcon_inst%lf_flig(ipft) * area_frac* surface_prof(id) + end do + end do + + do j = 1, nlev_eff_soil id = bc_in%decomp_id(j) - flux_lab_si(id) = flux_lab_si(id) + & litt%root_fines_frag(ilabile,j) * area_frac flux_cel_si(id) = flux_cel_si(id) + & @@ -957,10 +1141,8 @@ subroutine FluxIntoLitterPools(csite, bc_in, bc_out) flux_lab_si(id) / bc_in%dz_decomp_sisl(id) end do - end do ! do elements - return end subroutine FluxIntoLitterPools @@ -990,105 +1172,76 @@ function ECACScalar(ccohort, element_id) result(c_scalar) real(r8) :: c_scalar ! Locals + real(r8) :: store_frac ! Current nutrient storage relative to max + real(r8) :: store_max ! Maximum nutrient storable by plant + real(r8) :: store_c ! Current storage carbon + real(r8) :: store_c_max ! Current maximum storage carbon + integer :: icode ! real variable checking code + + integer, parameter :: downreg_linear = 1 + integer, parameter :: downreg_logi = 2 + integer, parameter :: downreg_CN_logi = 3 + + integer, parameter :: downreg_type = downreg_linear - real(r8) :: target_leaf_c ! maximum leaf C for this dbh [kg] - real(r8) :: target_store_c ! maximum store C for this dbh [kg] - ! - ! Where X is the element of interest: - real(r8) :: leaf_store_x ! Mass of current element in leaf and storage - real(r8) :: xc_actual ! Actual X:C ratio of plant - real(r8) :: xc_min ! Minimum allowable X:C ratio to build tissue - real(r8) :: xc_ideal ! Plant's ideal X:C ratio - real(r8) :: cx_actual ! Actual C:X ratio of plant - real(r8) :: cx_ideal ! Ideal C:X ratio of plant - real(r8) :: c_stoich_var ! effective variance of the CN or CP ratio - - ! We are still testing different functional relationships for c_scalar, thus - ! three methods. Methods 1 and 2 are subtly different, but both increase neediness - ! as a plants NC or PC ratio decreases, and vice versa. The variance - ! parameter acts as a buffer on the steepness of the relationship. - ! Method 3 turns off neediness and sets it to 1 (always fully needy) - ! - ! method 1: cn_scalar = (nc_ideal - nc_actual + variance*nc_min)/(nc_ideal - nc_min + variance*nc_min) - ! - ! method 2: cn_scalar = (1/nc_actual - (1-variance)/nc_ideal)/(variance/nc_ideal) - - integer, parameter :: cnp_scalar_method1 = 1 - integer, parameter :: cnp_scalar_method2 = 2 - integer, parameter :: cnp_scalar_method3 = 3 - integer, parameter :: cnp_scalar_method = cnp_scalar_method3 - - real(r8), parameter :: cn_stoich_var=0.2 ! variability of CN ratio - real(r8), parameter :: cp_stoich_var=0.4 ! variability of CP ratio - - - ! Target leaf biomass according to allometry and trimming - call bleaf(ccohort%dbh,ccohort%pft,ccohort%canopy_trim,target_leaf_c) - call bstore_allom(ccohort%dbh,ccohort%pft,ccohort%canopy_trim,target_store_c) - - leaf_store_x = max(rsnbl_math_prec,ccohort%prt%GetState(leaf_organ, element_id) + & - ccohort%prt%GetState(store_organ, element_id)) - - ! Calculate the ideal CN or CP ratio for leaves and storage organs - - if(element_id==nitrogen_element)then - - xc_ideal = ((target_leaf_c*prt_params%nitr_stoich_p2(ccohort%pft,leaf_organ)) + & - (target_store_c*prt_params%nitr_stoich_p2(ccohort%pft,store_organ))) / & - (target_leaf_c+target_store_c) - xc_min = ((target_leaf_c*prt_params%nitr_stoich_p1(ccohort%pft,leaf_organ)) + & - (target_store_c*prt_params%nitr_stoich_p1(ccohort%pft,store_organ))) / & - (target_leaf_c+target_store_c) - - xc_actual = max(leaf_store_x/(target_leaf_c+target_store_c),rsnbl_math_prec) + + real(r8), parameter :: logi_k = 25.0_r8 ! logistic function k + real(r8), parameter :: store_x0 = 1.0_r8 ! storage fraction inflection point + real(r8), parameter :: logi_min = 0.0_r8 ! minimum cn_scalar for logistic - c_stoich_var = cn_stoich_var + ! This is the storage fraction where downregulation starts if using + ! a linear function + real(r8), parameter :: store_frac0 = 0.5_r8 - elseif(element_id==phosphorus_element) then + real(r8), parameter :: c_max = 1.0_r8 + real(r8), parameter :: c_min = 1.e-3_r8 + + + store_max = ccohort%prt%GetNutrientTarget(element_id,store_organ,stoich_max) + store_frac = min(2.0_r8,ccohort%prt%GetState(store_organ, element_id)/store_max) + + if(downreg_type == downreg_linear) then - xc_ideal = ((target_leaf_c*prt_params%phos_stoich_p2(ccohort%pft,leaf_organ)) + & - (target_store_c*prt_params%phos_stoich_p2(ccohort%pft,store_organ))) / & - (target_leaf_c+target_store_c) - xc_min = ((target_leaf_c*prt_params%phos_stoich_p1(ccohort%pft,leaf_organ)) + & - (target_store_c*prt_params%phos_stoich_p1(ccohort%pft,store_organ))) / & - (target_leaf_c+target_store_c) + c_scalar = min(c_max,max(c_min,1.0 - (store_frac - store_frac0)/(1.0_r8-store_frac0))) + + elseif(downreg_type == downreg_logi) then + + ! In this method, we define the c_scalar term + ! with a logistic function that goes to 1 (full need) + ! as the plant's nutrien storage hits a low threshold + ! and goes to 0, no demand, as the plant's nutrient + ! storage approaches it's maximum holding capacity - xc_actual = max(leaf_store_x/(target_leaf_c+target_store_c),rsnbl_math_prec) + + + c_scalar = max(c_min,min(c_max,logi_min + (1.0_r8-logi_min)/(1.0_r8 + exp(logi_k*(store_frac-store_x0))))) - c_stoich_var = cp_stoich_var + call check_var_real(c_scalar,'c_scalar',icode) + if (icode .ne. 0) then + write(fates_log(),*) 'c_scalar is invalid, element: ',element_id + write(fates_log(),*) 'ending' + call endrun(msg=errMsg(sourcefile, __LINE__)) + endif else - write(fates_log(), *) 'attempted to call ECACScalar() for unknown element',element_id - call endrun(msg=errMsg(sourcefile, __LINE__)) - end if + store_c = ccohort%prt%GetState(store_organ, carbon12_element) + call bstore_allom(ccohort%dbh,ccohort%pft,ccohort%canopy_trim,store_c_max) - select case(cnp_scalar_method) - case(cnp_scalar_method1) - - ! To-do: Add a logistic function here, with a - ! shape parameter so that 95%tile of - ! nutrient concentration matches 95%tile of scalar - ! 0.95 = 1._r8/(1._r8 + exp(-logi_k*( 0.95*(nc_ideal-x0) ))) - ! logi_k = -log(1._r8-0.95/0.95)/ ( 0.95*(nc_ideal-x0) ) - ! bc_out%cn_scalar(icomp) = 1._r8/(1._r8 + exp(-logi_k*(nc_actual-x0))) - - c_scalar = min(1._r8,max(0._r8, & - (xc_ideal - xc_actual + c_stoich_var*xc_min) / & - (xc_ideal - xc_min + c_stoich_var*xc_min))) - - case(cnp_scalar_method2) - - cx_ideal = 1._r8/xc_ideal - cx_actual = 1._r8/xc_actual - c_scalar = min(1._r8,max(0._r8, & - (cx_actual - cx_ideal*(1._r8-c_stoich_var))/(cx_ideal*c_stoich_var))) - - case(cnp_scalar_method3) + ! Fraction of N per fraction of C + ! If this is greater than 1, then we have more N in storage than + ! we have C, so we downregulate. If this is less than 1, then + ! we have less N in storage than we have C, so up-regulate + + store_frac = store_frac / (store_c/store_c_max) - c_scalar = 1 + c_scalar = max(c_min,min(c_max,logi_min + (1.0_r8-logi_min)/(1.0_r8 + exp(logi_k*(store_frac-store_x0))))) - end select + + + + end if + end function ECACScalar diff --git a/biogeophys/EDBtranMod.F90 b/biogeophys/EDBtranMod.F90 index e7faac9cc3..5d949ea9ef 100644 --- a/biogeophys/EDBtranMod.F90 +++ b/biogeophys/EDBtranMod.F90 @@ -139,7 +139,8 @@ subroutine btran_ed( nsites, sites, bc_in, bc_out) do ft = 1,numpft - call set_root_fraction(sites(s)%rootfrac_scr, ft, sites(s)%zi_soil ) + call set_root_fraction(sites(s)%rootfrac_scr, ft, sites(s)%zi_soil, & + bc_in(s)%max_rooting_depth_index_col ) cpatch%btran_ft(ft) = 0.0_r8 do j = 1,bc_in(s)%nlevsoil diff --git a/biogeophys/FatesBstressMod.F90 b/biogeophys/FatesBstressMod.F90 index 46f30f434b..c56b4930f5 100644 --- a/biogeophys/FatesBstressMod.F90 +++ b/biogeophys/FatesBstressMod.F90 @@ -63,12 +63,12 @@ subroutine btran_sal_stress_fates( nsites, sites, bc_in) cpatch => sites(s)%oldest_patch do while (associated(cpatch)) - ! THIS SHOULD REALLY BE A COHORT LOOP ONCE WE HAVE rootfr_ft FOR COHORTS (RGK) - do ft = 1,numpft cpatch%bstress_sal_ft(ft) = 0.0_r8 - call set_root_fraction(sites(s)%rootfrac_scr, ft, sites(s)%zi_soil ) + call set_root_fraction(sites(s)%rootfrac_scr, ft, & + sites(s)%zi_soil, & + bc_in(s)%max_rooting_depth_index_col ) do j = 1,bc_in(s)%nlevsoil diff --git a/biogeophys/FatesHydroWTFMod.F90 b/biogeophys/FatesHydroWTFMod.F90 index 85b4965a0a..cda65a12ae 100644 --- a/biogeophys/FatesHydroWTFMod.F90 +++ b/biogeophys/FatesHydroWTFMod.F90 @@ -304,6 +304,7 @@ end subroutine set_wrf_param_base function get_thsat_base(this) result(th_sat) class(wrf_type) :: this real(r8) :: th_sat + th_sat = 0._r8 write(fates_log(),*) 'The base thsat call' write(fates_log(),*) 'should never be actualized' write(fates_log(),*) 'check how the class pointer was setup' diff --git a/biogeophys/FatesPlantHydraulicsMod.F90 b/biogeophys/FatesPlantHydraulicsMod.F90 index d5dab90441..0fce8b36cd 100644 --- a/biogeophys/FatesPlantHydraulicsMod.F90 +++ b/biogeophys/FatesPlantHydraulicsMod.F90 @@ -47,6 +47,7 @@ module FatesPlantHydraulicsMod use EDParamsMod , only : hydr_kmax_rsurf2 use EDParamsMod , only : hydr_psi0 use EDParamsMod , only : hydr_psicap + use EDParamsMod , only : hydr_htftype_node use EDTypesMod , only : ed_site_type use EDTypesMod , only : ed_patch_type @@ -65,7 +66,6 @@ module FatesPlantHydraulicsMod use FatesAllometryMod, only : bleaf use FatesAllometryMod, only : bsap_allom use FatesAllometryMod, only : CrownDepth - use FatesAllometryMod , only : set_root_fraction use FatesHydraulicsMemMod, only: use_2d_hydrosolve use FatesHydraulicsMemMod, only: ed_site_hydr_type use FatesHydraulicsMemMod, only: ed_cohort_hydr_type @@ -90,10 +90,12 @@ module FatesPlantHydraulicsMod use FatesHydraulicsMemMod, only: rwccap, rwcft use FatesHydraulicsMemMod, only: ignore_layer1 - use PRTGenericMod, only : all_carbon_elements + use PRTGenericMod, only : carbon12_element use PRTGenericMod, only : leaf_organ, fnrt_organ, sapw_organ use PRTGenericMod, only : store_organ, repro_organ, struct_organ - + use PRTGenericMod, only : num_elements + use PRTGenericMod, only : element_list + use clm_time_manager , only : get_step_size, get_nstep use EDPftvarcon, only : EDPftvarcon_inst @@ -173,23 +175,38 @@ module FatesPlantHydraulicsMod logical, parameter :: trap_neg_wc = .false. logical, parameter :: trap_supersat_psi = .false. + real(r8), parameter :: error_thresh = 1.e-5_r8 ! site level conservation error threshold in CLM + ! (mm = kg/m2) + + real(r8), parameter :: thsat_buff = 0.001_r8 ! Ensure that this amount of buffer ! is left between soil moisture and saturation [m3/m3] ! (if we are going to help purge super-saturation) logical,parameter :: debug = .false. ! flag to report warning in hydro - logical,public, parameter :: JD_debug = .false. ! Junyan added to debug my modifications character(len=*), parameter, private :: sourcefile = & __FILE__ - integer, public, parameter :: van_genuchten_type = 1 - integer, public, parameter :: campbell_type = 2 - integer, public, parameter :: tfs_type = 3 + ! These index flags specify which pressure-volumen and pressure + ! conductivity relationship are available. + ! For plants: Users can option between useing tfs and van_genuchten + ! by specifying their choice in the parameter file, + ! with the model parameter hydr_htftype_node, + ! the value should be 1 for TFS or 2 for VG (as shown below). + ! Campbell, could technically be used, but the parameters for + ! that hypothesis are not in the parameter file, so it not currently available. + ! For soil: The soil hypothesis should follow the hypothesis for water transfer + ! in the Host Land Model. At this time campbell is the default for both + ! ELM and ALM. However, if alternatives arise (like VG), we still need to write + ! interface routines to transfer over parameters. Right now we just hard-code + ! the use of campbell_type for the soil (see a few lines below). + + integer, public, parameter :: van_genuchten_type = 2 + integer, public, parameter :: campbell_type = 3 + integer, public, parameter :: tfs_type = 1 - integer, parameter :: plant_wrf_type = tfs_type - integer, parameter :: plant_wkf_type = tfs_type integer, parameter :: soil_wrf_type = campbell_type integer, parameter :: soil_wkf_type = campbell_type @@ -428,9 +445,11 @@ subroutine RestartHydrStates(sites,nsites,bc_in,bc_out) ! are not perturbed call SavePreviousRhizVolumes(sites(s)) - end do - call UpdateH2OVeg(nsites,sites,bc_out) + call UpdateH2OVeg(sites(s),bc_out(s)) + + end do + return end subroutine RestartHydrStates @@ -557,13 +576,6 @@ subroutine InitPlantHydStates(site, cohort) cohort_hydr%ftc_ag(k) = wkf_plant(site_hydr%pm_node(k),ft)%p%ftc_from_psi(cohort_hydr%psi_ag(k)) end do - cohort_hydr%errh2o_growturn_ag(:) = 0.0_r8 - cohort_hydr%errh2o_growturn_troot = 0.0_r8 - cohort_hydr%errh2o_growturn_aroot = 0.0_r8 - cohort_hydr%errh2o_pheno_ag(:) = 0.0_r8 - cohort_hydr%errh2o_pheno_troot = 0.0_r8 - cohort_hydr%errh2o_pheno_aroot = 0.0_r8 - !initialize cohort-level btran cohort_hydr%btran = wkf_plant(stomata_p_media,ft)%p%ftc_from_psi(cohort_hydr%psi_ag(1)) @@ -853,20 +865,21 @@ subroutine UpdatePlantHydrLenVol(ccohort,site_hydr) ccohort_hydr => ccohort%co_hydr ft = ccohort%pft nlevrhiz = site_hydr%nlevrhiz - leaf_c = ccohort%prt%GetState(leaf_organ, all_carbon_elements) - sapw_c = ccohort%prt%GetState(sapw_organ, all_carbon_elements) - fnrt_c = ccohort%prt%GetState(fnrt_organ, all_carbon_elements) - struct_c = ccohort%prt%GetState(struct_organ, all_carbon_elements) + leaf_c = ccohort%prt%GetState(leaf_organ, carbon12_element) + sapw_c = ccohort%prt%GetState(sapw_organ, carbon12_element) + fnrt_c = ccohort%prt%GetState(fnrt_organ, carbon12_element) + struct_c = ccohort%prt%GetState(struct_organ, carbon12_element) + ! Rooting parameters roota = prt_params%fnrt_prof_a(ft) rootb = prt_params%fnrt_prof_b(ft) + dbh_max = prt_params%allom_zroot_max_dbh(ft) + dbh_0 = prt_params%allom_zroot_min_dbh(ft) + z_fr_max = prt_params%allom_zroot_max_z(ft) + z_fr_0 = prt_params%allom_zroot_min_z(ft) + frk = prt_params%allom_zroot_k(ft) - dbh_max = EDPftvarcon_inst%allom_dbh_max(ft) - dbh_0 = EDPftvarcon_inst%allom_dbh_0(ft) - z_fr_max = EDPftvarcon_inst%allom_zfr_max(ft) - - z_fr_0 = EDPftvarcon_inst%allom_zfr_0(ft) - frk = EDPftvarcon_inst%allom_frk(ft) + dbh = ccohort%dbh dbh_rev = (dbh - dbh_0)/(dbh_max - dbh_0) @@ -981,7 +994,7 @@ subroutine UpdatePlantHydrLenVol(ccohort,site_hydr) rootfr = norm * (zeng2001_crootfr(roota, rootb, site_hydr%zi_rhiz(j),z_fr) - & zeng2001_crootfr(roota, rootb, site_hydr%zi_rhiz(j)-site_hydr%dz_rhiz(j),z_fr)) - if(JD_debug)then + if(debug)then write(fates_log(),*) 'check rooting depth of cohort - Junyan, line 987' write(fates_log(),*) 'dbh: ',ccohort%dbh,' sice class: ',ccohort%size_class write(fates_log(),*) 'site_hydr%dz_rhiz(j) is: ', site_hydr%dz_rhiz(j) @@ -1018,9 +1031,7 @@ subroutine UpdateSizeDepPlantHydStates(currentSite,ccohort) type(ed_site_hydr_type),pointer :: csite_hydr integer :: j,k,FT ! indices integer :: err_code = 0 - real(r8) :: th_ag_uncorr( n_hypool_ag) ! uncorrected aboveground water content[m3 m-3] - real(r8) :: th_troot_uncorr ! uncorrected transporting root water content[m3 m-3] - real(r8) :: th_aroot_uncorr(currentSite%si_hydr%nlevrhiz) ! uncorrected absorbing root water content[m3 m-3] + real(r8) :: th_uncorr ! Uncorrected water content real(r8), parameter :: small_theta_num = 1.e-7_r8 ! avoids theta values equalling thr or ths [m3 m-3] integer :: nstep !number of time steps @@ -1028,6 +1039,7 @@ subroutine UpdateSizeDepPlantHydStates(currentSite,ccohort) ccohort_hydr => ccohort%co_hydr FT = cCohort%pft + csite_hydr =>currentSite%si_hydr associate(pm_node => currentSite%si_hydr%pm_node) @@ -1040,53 +1052,45 @@ subroutine UpdateSizeDepPlantHydStates(currentSite,ccohort) do k=1,n_hypool_leaf if( ccohort_hydr%v_ag(k) > nearzero ) then - th_ag_uncorr(k) = ccohort_hydr%th_ag(k) * & + th_uncorr = ccohort_hydr%th_ag(k) * & ccohort_hydr%v_ag_init(k) /ccohort_hydr%v_ag(k) - ccohort_hydr%th_ag(k) = constrain_water_contents(th_ag_uncorr(k), small_theta_num, ft, pm_node(k)) + ccohort_hydr%th_ag(k) = constrain_water_contents(th_uncorr, small_theta_num, ft, leaf_p_media) else - th_ag_uncorr(k) = ccohort_hydr%th_ag(k) + th_uncorr = ccohort_hydr%th_ag(k) end if + + csite_hydr%h2oveg_growturn_err = csite_hydr%h2oveg_growturn_err + & + denh2o*cCohort%n*AREA_INV*(ccohort_hydr%th_ag(k)-th_uncorr)*ccohort_hydr%v_ag(k) end do do k=n_hypool_leaf+1,n_hypool_ag - th_ag_uncorr(k) = ccohort_hydr%th_ag(k) * & + th_uncorr = ccohort_hydr%th_ag(k) * & ccohort_hydr%v_ag_init(k) /ccohort_hydr%v_ag(k) - ccohort_hydr%th_ag(k) = constrain_water_contents(th_ag_uncorr(k), small_theta_num, ft, pm_node(k)) + ccohort_hydr%th_ag(k) = constrain_water_contents(th_uncorr, small_theta_num, ft, stem_p_media) + + csite_hydr%h2oveg_growturn_err = csite_hydr%h2oveg_growturn_err + & + denh2o*cCohort%n*AREA_INV*(ccohort_hydr%th_ag(k)-th_uncorr)*ccohort_hydr%v_ag(k) enddo - th_troot_uncorr = ccohort_hydr%th_troot * ccohort_hydr%v_troot_init /ccohort_hydr%v_troot - ccohort_hydr%th_troot = constrain_water_contents(th_troot_uncorr, small_theta_num, ft, pm_node(3)) + th_uncorr = ccohort_hydr%th_troot * ccohort_hydr%v_troot_init /ccohort_hydr%v_troot + ccohort_hydr%th_troot = constrain_water_contents(th_uncorr, small_theta_num, ft, troot_p_media ) + csite_hydr%h2oveg_growturn_err = csite_hydr%h2oveg_growturn_err + & + denh2o*cCohort%n*AREA_INV*(ccohort_hydr%th_troot-th_uncorr)*ccohort_hydr%v_troot + - ccohort_hydr%errh2o_growturn_aroot = 0._r8 do j=1,currentSite%si_hydr%nlevrhiz - ! check v_aroot >0 - if (ccohort_hydr%v_aroot_layer(j) > 0) then - th_aroot_uncorr(j) = ccohort_hydr%th_aroot(j) * & - ccohort_hydr%v_aroot_layer_init(j)/ccohort_hydr%v_aroot_layer(j) - ccohort_hydr%th_aroot(j) = constrain_water_contents(th_aroot_uncorr(j), small_theta_num, ft, pm_node(4)) - ccohort_hydr%errh2o_growturn_aroot = ccohort_hydr%errh2o_growturn_aroot + & - denh2o*cCohort%n*AREA_INV*(ccohort_hydr%th_aroot(j)-th_aroot_uncorr(j))*ccohort_hydr%v_aroot_layer(j) - else - - endif ! end checking v_arrot + if (ccohort_hydr%v_aroot_layer(j) > nearzero) then + th_uncorr = ccohort_hydr%th_aroot(j) * & + ccohort_hydr%v_aroot_layer_init(j)/ccohort_hydr%v_aroot_layer(j) + ccohort_hydr%th_aroot(j) = constrain_water_contents(th_uncorr, small_theta_num, ft, aroot_p_media) + + csite_hydr%h2oveg_growturn_err = csite_hydr%h2oveg_growturn_err + & + denh2o*cCohort%n*AREA_INV*(ccohort_hydr%th_aroot(j)-th_uncorr)*ccohort_hydr%v_aroot_layer(j) + end if enddo - ! Storing mass balance error - ! + means water created; - means water destroyed - ccohort_hydr%errh2o_growturn_ag(:) = denh2o*cCohort%n*AREA_INV*ccohort_hydr%v_ag(:) * & - (ccohort_hydr%th_ag(:)-th_ag_uncorr(:)) - ccohort_hydr%errh2o_growturn_troot = denh2o*cCohort%n*AREA_INV*ccohort_hydr%v_troot * & - (ccohort_hydr%th_troot-th_troot_uncorr) - csite_hydr =>currentSite%si_hydr - csite_hydr%h2oveg_growturn_err = csite_hydr%h2oveg_growturn_err + & - sum(ccohort_hydr%errh2o_growturn_ag(:)) + & - ccohort_hydr%errh2o_growturn_troot + & - ccohort_hydr%errh2o_growturn_aroot - - - ! UPDATES OF WATER POTENTIALS ARE DONE PRIOR TO RICHARDS' SOLUTION WITHIN FATESPLANTHYDRAULICSMOD.F90 end associate end subroutine UpdateSizeDepPlantHydStates @@ -1177,12 +1181,7 @@ subroutine CopyCohortHydraulics(newCohort, oldCohort) ncohort_hydr%iterh2 = ocohort_hydr%iterh2 ncohort_hydr%iterlayer = ocohort_hydr%iterlayer ncohort_hydr%errh2o = ocohort_hydr%errh2o - ncohort_hydr%errh2o_growturn_ag = ocohort_hydr%errh2o_growturn_ag - ncohort_hydr%errh2o_pheno_ag = ocohort_hydr%errh2o_pheno_ag - ncohort_hydr%errh2o_growturn_troot = ocohort_hydr%errh2o_growturn_troot - ncohort_hydr%errh2o_pheno_troot = ocohort_hydr%errh2o_pheno_troot - ncohort_hydr%errh2o_growturn_aroot = ocohort_hydr%errh2o_growturn_aroot - ncohort_hydr%errh2o_pheno_aroot = ocohort_hydr%errh2o_pheno_aroot + ! BC PLANT HYDRAULICS - flux terms ncohort_hydr%qtop = ocohort_hydr%qtop @@ -1206,6 +1205,7 @@ subroutine FuseCohortHydraulics(currentSite,currentCohort, nextCohort, bc_in, ne type(ed_site_hydr_type), pointer :: site_hydr type(ed_cohort_hydr_type), pointer :: ccohort_hydr ! current cohort hydraulics derived type type(ed_cohort_hydr_type), pointer :: ncohort_hydr ! donor (next) cohort hydraulics d type + real(r8) :: vol_c1,vol_c2 ! Total water volume in the each cohort integer :: j,k ! indices integer :: ft @@ -1214,12 +1214,44 @@ subroutine FuseCohortHydraulics(currentSite,currentCohort, nextCohort, bc_in, ne ccohort_hydr => currentCohort%co_hydr ncohort_hydr => nextCohort%co_hydr - ccohort_hydr%th_ag(:) = (currentCohort%n*ccohort_hydr%th_ag(:) + & - nextCohort%n*ncohort_hydr%th_ag(:))/newn - ccohort_hydr%th_troot = (currentCohort%n*ccohort_hydr%th_troot + & - nextCohort%n*ncohort_hydr%th_troot)/newn - ccohort_hydr%th_aroot(:) = (currentCohort%n*ccohort_hydr%th_aroot(:) + & - nextCohort%n*ncohort_hydr%th_aroot(:))/newn + ft = currentCohort%pft + + ! At this point in the call sequence, we can assume the fused cohort (currentCohort) has + ! and updated size, shape and biomass, make sure this is called after parteh, and the + ! dbh and height are uppdated + + ! Save the old volumes because we need the old volume to calculate the pre-fusion water + ! volume of each cohort + call SavePreviousCompartmentVolumes(ccohort_hydr) + + ! This updates all of the z_node positions + call UpdatePlantHydrNodes(ccohort_hydr,ft,currentCohort%hite,site_hydr) + + ! This updates plant compartment volumes, lengths and + ! maximum conductances. Make sure for already + ! initialized vegetation, that SavePreviousCompartment + ! volumes, and UpdatePlantHydrNodes is called prior to this. + call UpdatePlantHydrLenVol(currentCohort,site_hydr) + + + ! Conserve the total water volume + + do k=1,n_hypool_ag + vol_c1 = currentCohort%n*ccohort_hydr%th_ag(k)*ccohort_hydr%v_ag_init(k) + vol_c2 = nextCohort%n*ncohort_hydr%th_ag(k)*ncohort_hydr%v_ag(k) + ccohort_hydr%th_ag(k) = (vol_c1+vol_c2)/(ccohort_hydr%v_ag(k)*newn) + end do + + vol_c1 = currentCohort%n*ccohort_hydr%th_troot*ccohort_hydr%v_troot_init + vol_c2 = nextCohort%n*ncohort_hydr%th_troot*ncohort_hydr%v_troot + ccohort_hydr%th_troot = (vol_c1+vol_c2)/(ccohort_hydr%v_troot*newn) + + do j=1,site_hydr%nlevrhiz + vol_c1 = currentCohort%n*ccohort_hydr%th_aroot(j)*ccohort_hydr%v_aroot_layer_init(j) + vol_c2 = nextCohort%n*ncohort_hydr%th_aroot(j)*ncohort_hydr%v_aroot_layer(j) + ccohort_hydr%th_aroot(j) = (vol_c1+vol_c2)/(ccohort_hydr%v_aroot_layer(j)*newn) + end do + ccohort_hydr%supsub_flag = 0 ! Only save the iteration counters for the worse of the two cohorts @@ -1229,7 +1261,7 @@ subroutine FuseCohortHydraulics(currentSite,currentCohort, nextCohort, bc_in, ne ccohort_hydr%iterlayer = ncohort_hydr%iterlayer end if - ft = currentCohort%pft + do k=1,n_hypool_leaf ccohort_hydr%psi_ag(k) = wrf_plant(leaf_p_media,ft)%p%psi_from_th(ccohort_hydr%th_ag(k)) ccohort_hydr%ftc_ag(k) = wkf_plant(leaf_p_media,ft)%p%ftc_from_psi(ccohort_hydr%psi_ag(k)) @@ -1256,21 +1288,8 @@ subroutine FuseCohortHydraulics(currentSite,currentCohort, nextCohort, bc_in, ne ccohort_hydr%errh2o = (currentCohort%n*ccohort_hydr%errh2o + & nextCohort%n*ncohort_hydr%errh2o)/newn - ccohort_hydr%errh2o_growturn_ag(:) = (currentCohort%n*ccohort_hydr%errh2o_growturn_ag(:) + & - nextCohort%n*ncohort_hydr%errh2o_growturn_ag(:))/newn - ccohort_hydr%errh2o_pheno_ag(:) = (currentCohort%n*ccohort_hydr%errh2o_pheno_ag(:) + & - nextCohort%n*ncohort_hydr%errh2o_pheno_ag(:))/newn - ccohort_hydr%errh2o_growturn_troot = (currentCohort%n*ccohort_hydr%errh2o_growturn_troot + & - nextCohort%n*ncohort_hydr%errh2o_growturn_troot)/newn - ccohort_hydr%errh2o_pheno_troot = (currentCohort%n*ccohort_hydr%errh2o_pheno_troot + & - nextCohort%n*ncohort_hydr%errh2o_pheno_troot)/newn - ccohort_hydr%errh2o_growturn_aroot = (currentCohort%n*ccohort_hydr%errh2o_growturn_aroot + & - nextCohort%n*ncohort_hydr%errh2o_growturn_aroot)/newn - ccohort_hydr%errh2o_pheno_aroot = (currentCohort%n*ccohort_hydr%errh2o_pheno_aroot + & - nextCohort%n*ncohort_hydr%errh2o_pheno_aroot)/newn - - ccohort_hydr%is_newly_recruited = .false. + return end subroutine FuseCohortHydraulics ! ===================================================================================== @@ -1404,13 +1423,7 @@ subroutine HydrSiteColdStart(sites, bc_in ) ! , bc_out) site_hydr%h2osoi_liqvol_shell(j,1:nshell) = h2osoi_liqvol site_hydr%h2osoi_liq_prev(j) = bc_in(s)%h2o_liq_sisl(j_bc) - if (JD_debug) then - write(fates_log(),*) 'line 1410, initial shell water content' - write(fates_log(),*) 'water content:', h2osoi_liqvol - - endif end do - site_hydr%l_aroot_layer(1:site_hydr%nlevrhiz) = 0.0_r8 @@ -1473,9 +1486,6 @@ subroutine HydrSiteColdStart(sites, bc_in ) ! , bc_out) end do - ! - !! call UpdateH2OVeg(nsites,sites,bc_out) - ! -------------------------------------------------------------------------------- ! All other ed_Hydr_site_type variables are initialized elsewhere: ! @@ -1504,7 +1514,7 @@ end subroutine HydrSiteColdStart ! ===================================================================================== - subroutine UpdateH2OVeg(nsites,sites,bc_out) + subroutine UpdateH2OVeg(csite,bc_out,prev_site_h2o,icall) ! ---------------------------------------------------------------------------------- ! This subroutine is called following dynamics. After growth has been updated @@ -1513,10 +1523,17 @@ subroutine UpdateH2OVeg(nsites,sites,bc_out) ! ---------------------------------------------------------------------------------- ! Arguments - integer, intent(in) :: nsites - type(ed_site_type), intent(inout), target :: sites(nsites) - type(bc_out_type), intent(inout) :: bc_out(nsites) + type(ed_site_type), intent(inout), target :: csite + type(bc_out_type), intent(inout) :: bc_out + + ! The total site water balance at a previous point in time. + ! In some cases, like during dynamics + ! we want to conserve total site water, so we check + + real(r8), intent(in),optional :: prev_site_h2o + integer, intent(in), optional :: icall + ! Locals type(ed_cohort_type), pointer :: currentCohort type(ed_patch_type), pointer :: currentPatch @@ -1529,69 +1546,56 @@ subroutine UpdateH2OVeg(nsites,sites,bc_out) !for debug only nstep = get_nstep() - do s = 1,nsites - bc_out(s)%plant_stored_h2o_si = 0.0_r8 - end do + bc_out%plant_stored_h2o_si = 0.0_r8 if( hlm_use_planthydro.eq.ifalse ) return - do s = 1,nsites - - csite_hydr => sites(s)%si_hydr - csite_hydr%h2oveg = 0.0_r8 - currentPatch => sites(s)%oldest_patch - do while(associated(currentPatch)) - currentCohort=>currentPatch%tallest - do while(associated(currentCohort)) - ccohort_hydr => currentCohort%co_hydr - !only account for the water for not newly recruit for mass balance - if(.not.ccohort_hydr%is_newly_recruited) then - ! check for nan value , Junyan - do ily = 1,csite_hydr%nlevrhiz - if(ccohort_hydr%th_aroot(ily)/=ccohort_hydr%th_aroot(ily)) then - ccohort_hydr%th_aroot(ily) = 0 - endif - end do ! end checking nan - - - csite_hydr%h2oveg = csite_hydr%h2oveg + & - (sum(ccohort_hydr%th_ag(:)*ccohort_hydr%v_ag(:)) + & - ccohort_hydr%th_troot*ccohort_hydr%v_troot + & - sum(ccohort_hydr%th_aroot(:)*ccohort_hydr%v_aroot_layer(:)))* & - denh2o*currentCohort%n - if (JD_debug) then - write(fates_log(),*) 'Junyan added log info, line 1565' - write(fates_log(),*) 'ccohort_hydr%th_aroot(:):', ccohort_hydr%th_aroot(:) - write(fates_log(),*) 'ccohort_hydr%v_aroot_layer(:):', ccohort_hydr%v_aroot_layer(:) - write(fates_log(),*) - endif - endif - - currentCohort => currentCohort%shorter - enddo !cohort - currentPatch => currentPatch%younger - enddo !end patch loop - - csite_hydr%h2oveg = csite_hydr%h2oveg*AREA_INV - - ! Note that h2oveg_dead is incremented wherever we have litter fluxes - ! and it will be reduced via an evaporation term - ! growturn_err is a term to accomodate error in growth or turnover. need to be improved for future(CX) - if (JD_debug) then - write(fates_log(),*) 'check NaN in , line 1561' - write(fates_log(),*) 'csite_hydr%h2oveg:',csite_hydr%h2oveg - write(fates_log(),*) 'csite_hydr%h2oveg_dead:',csite_hydr%h2oveg_dead - write(fates_log(),*) 'csite_hydr%h2oveg_growturn_err:', csite_hydr%h2oveg_growturn_err - write(fates_log(),*) 'csite_hydr%h2oveg_hydro_err:', csite_hydr%h2oveg_hydro_err - write(fates_log(),*) 'csite_hydr%h2oveg_pheno_err:', csite_hydr%h2oveg_pheno_err - endif - bc_out(s)%plant_stored_h2o_si = csite_hydr%h2oveg + csite_hydr%h2oveg_dead - & - csite_hydr%h2oveg_growturn_err - & - csite_hydr%h2oveg_pheno_err-& - csite_hydr%h2oveg_hydro_err - - end do - + csite_hydr => csite%si_hydr + csite_hydr%h2oveg = 0.0_r8 + currentPatch => csite%oldest_patch + do while(associated(currentPatch)) + currentCohort=>currentPatch%tallest + do while(associated(currentCohort)) + ccohort_hydr => currentCohort%co_hydr + !only account for the water for not newly recruit for mass balance + if(.not.ccohort_hydr%is_newly_recruited) then + csite_hydr%h2oveg = csite_hydr%h2oveg + & + (sum(ccohort_hydr%th_ag(:)*ccohort_hydr%v_ag(:)) + & + ccohort_hydr%th_troot*ccohort_hydr%v_troot + & + sum(ccohort_hydr%th_aroot(:)*ccohort_hydr%v_aroot_layer(:)))* & + denh2o*currentCohort%n + endif + + currentCohort => currentCohort%shorter + enddo !cohort + currentPatch => currentPatch%younger + enddo !end patch loop + + csite_hydr%h2oveg = csite_hydr%h2oveg*AREA_INV + + ! Note that h2oveg_dead is incremented wherever we have litter fluxes + ! and it will be reduced via an evaporation term + ! growturn_err is a term to accomodate error in growth or + ! turnover. need to be improved for future(CX) + bc_out%plant_stored_h2o_si = csite_hydr%h2oveg + csite_hydr%h2oveg_dead - & + csite_hydr%h2oveg_growturn_err - & + csite_hydr%h2oveg_hydro_err + + ! Perform a conservation check if desired + if(present(prev_site_h2o)) then + + if(abs(bc_out%plant_stored_h2o_si-prev_site_h2o)>error_thresh ) then + write(fates_log(),*) 'Total FATES site level water was not conserved during' + write(fates_log(),*) 'a check where it was supposed to be conserved.' + write(fates_log(),*) 'Most likely during daily dynamics.' + write(fates_log(),*) 'Call index: ',icall + write(fates_log(),*) 'Old mass: ',prev_site_h2o,' [mm/m2]' + write(fates_log(),*) 'New mass: ',bc_out%plant_stored_h2o_si,' [mm/m2]' + write(fates_log(),*) 'diff: ',bc_out%plant_stored_h2o_si-prev_site_h2o + call endrun(msg=errMsg(sourcefile, __LINE__)) + end if + + end if return end subroutine UpdateH2OVeg @@ -1681,11 +1685,11 @@ subroutine RecruitWUptake(nsites,sites,bc_in,dtime,recruitflag) endif end do ! site loop - if (JD_debug) then - write(fates_log(),*) 'Calculating recruit uptake' - write(fates_log(),*) csite_hydr%recruit_w_uptake(:) - endif - + if (debug) then + write(fates_log(),*) 'Calculating recruit uptake' + write(fates_log(),*) sum(csite_hydr%recruit_w_uptake(:)) + endif + end subroutine RecruitWUptake !===================================================================================== @@ -1707,22 +1711,24 @@ subroutine ConstrainRecruitNumber(csite,ccohort, bc_in) ! Locals type(ed_cohort_hydr_type), pointer :: ccohort_hydr type(ed_site_hydr_type), pointer :: csite_hydr + type(ed_patch_type), pointer :: cpatch real(r8) :: tmp1 - real(r8) :: watres_local !minum water content [m3/m3] - real(r8) :: total_water !total water in rhizosphere at a specific layer (m^3 ha-1) - real(r8) :: total_water_min !total minimum water in rhizosphere at a specific layer (m^3) - real(r8) :: roota !root distriubiton parameter a - real(r8) :: rootb !root distriubiton parameter b - real(r8) :: rootfr !fraction of root in different soil layer - real(r8) :: recruitw !water for newly recruited cohorts (kg water/m2/individual) - real(r8) :: n, nmin !number of individuals in cohorts + real(r8) :: watres_local ! minum water content [m3/m3] + real(r8) :: total_water ! total water in rhizosphere at a specific layer (m^3 ha-1) + real(r8) :: total_water_min ! total minimum water in rhizosphere at a specific layer (m^3) + real(r8) :: rootfr ! fraction of root in different soil layer + real(r8) :: recruitw ! water for newly recruited cohorts (kg water/m2/individual) + real(r8) :: n, nmin ! number of individuals in cohorts real(r8) :: sum_l_aroot integer :: s, j, ft - roota = prt_params%fnrt_prof_a(ccohort%pft) - rootb = prt_params%fnrt_prof_b(ccohort%pft) - ! roota = EDPftvarcon_inst%roota_par(ccohort%pft) - ! rootb = EDPftvarcon_inst%rootb_par(ccohort%pft) + integer :: el ! element loop index + integer :: element_id ! global element identifier index + real(r8) :: leaf_m, store_m, sapw_m ! Element mass in organ tissues + real(r8) :: fnrt_m, struct_m, repro_m ! Element mass in organ tissues + + + cpatch => ccohort%patchptr csite_hydr => csite%si_hydr ccohort_hydr =>ccohort%co_hydr recruitw = (sum(ccohort_hydr%th_ag(:)*ccohort_hydr%v_ag(:)) + & @@ -1736,7 +1742,7 @@ subroutine ConstrainRecruitNumber(csite,ccohort, bc_in) do j=1,csite_hydr%nlevrhiz ! check there is roots in the layer, only proceed when there is roots - if (ccohort_hydr%l_aroot_layer(j)>0.0_r8) then + if (ccohort_hydr%l_aroot_layer(j)>nearzero) then watres_local = csite_hydr%wrf_soil(j)%p%th_from_psi(bc_in%smpmin_si*denh2o*grav_earth*m_per_mm*mpa_per_pa) total_water = sum(csite_hydr%v_shell(j,:)*csite_hydr%h2osoi_liqvol_shell(j,:)) @@ -1754,8 +1760,34 @@ subroutine ConstrainRecruitNumber(csite,ccohort, bc_in) nmin = min(n, nmin) endif end do - ccohort%n = min (ccohort%n, nmin) + ! If the minimum number of plants that are recruitable due to water + ! limitations, is less than what is currently recruitable (due to + ! carbon-nitrogen-phosphorus availability), then we apply a reduction. + ! We also have to add back in what had been taken, to the germination + ! seed pool + if(nmin < ccohort%n) then + + do el = 1,num_elements + + element_id = element_list(el) + + leaf_m = ccohort%prt%GetState(leaf_organ, element_id) + store_m = ccohort%prt%GetState(store_organ, element_id) + sapw_m = ccohort%prt%GetState(sapw_organ, element_id) + fnrt_m = ccohort%prt%GetState(fnrt_organ, element_id) + struct_m = ccohort%prt%GetState(struct_organ, element_id) + repro_m = ccohort%prt%GetState(repro_organ, element_id) + + cpatch%litter(el)%seed_germ(ccohort%pft) = cpatch%litter(el)%seed_germ(ccohort%pft) + & + (ccohort%n-nmin)/cpatch%area * & + (leaf_m+store_m+sapw_m+fnrt_m+struct_m+repro_m) + + end do + ccohort%n = nmin + end if + + return end subroutine ConstrainRecruitNumber @@ -1846,17 +1878,6 @@ subroutine UpdateSizeDepRhizVolLenCon(currentSite, bc_in) do j = 1,nlevrhiz - if (JD_debug) then - write(fates_log(),*) 'code line 1851, check shellGeom ' - write(fates_log(),*) ' uncommented line 1786 and 1789 to only get' - write(fates_log(),*) ' shell geometry if there is root in the layer' - write(fates_log(),*) 'j:', j - write(fates_log(),*) 'csite_hydr%r_out_shell(j,:)', csite_hydr%r_out_shell(j,:) - write(fates_log(),*) 'csite_hydr%v_shell(j,:): ' , csite_hydr%v_shell(j,:) - write(fates_log(),*) 'csite_hydr%r_node_shell(j,:)' , csite_hydr%r_node_shell(j,:) - write(fates_log(),*) - write(fates_log(),*) - endif j_bc = j+csite_hydr%i_rhiz_t-1 @@ -2152,9 +2173,9 @@ subroutine BTranForHLMDiagnosticsFromCohortHydr(nsites,sites,bc_out) ccohort=>cpatch%tallest do while(associated(ccohort)) balive_patch = balive_patch + & - (cCohort%prt%GetState(fnrt_organ, all_carbon_elements) + & - cCohort%prt%GetState(sapw_organ, all_carbon_elements) + & - cCohort%prt%GetState(leaf_organ, all_carbon_elements))* ccohort%n + (cCohort%prt%GetState(fnrt_organ, carbon12_element) + & + cCohort%prt%GetState(sapw_organ, carbon12_element) + & + cCohort%prt%GetState(leaf_organ, carbon12_element))* ccohort%n ccohort => ccohort%shorter enddo !cohort @@ -2163,9 +2184,9 @@ subroutine BTranForHLMDiagnosticsFromCohortHydr(nsites,sites,bc_out) do while(associated(ccohort)) bc_out(s)%btran_pa(ifp) = bc_out(s)%btran_pa(ifp) + & ccohort%co_hydr%btran * & - (cCohort%prt%GetState(fnrt_organ, all_carbon_elements) + & - cCohort%prt%GetState(sapw_organ, all_carbon_elements) + & - cCohort%prt%GetState(leaf_organ, all_carbon_elements)) * & + (cCohort%prt%GetState(fnrt_organ, carbon12_element) + & + cCohort%prt%GetState(sapw_organ, carbon12_element) + & + cCohort%prt%GetState(leaf_organ, carbon12_element)) * & ccohort%n / balive_patch ccohort => ccohort%shorter enddo !cohort @@ -2402,6 +2423,8 @@ subroutine hydraulics_bc ( nsites, sites, bc_in, bc_out, dtime) real(r8) :: sumcheck ! used to debug mass balance in soil horizon diagnostics integer :: nlevrhiz ! local for number of rhizosphere levels integer :: sc ! size class index + + ! ---------------------------------------------------------------------------------- ! Important note: We are interested in calculating the total fluxes in and out of the @@ -2415,8 +2438,12 @@ subroutine hydraulics_bc ( nsites, sites, bc_in, bc_out, dtime) call RecruitWUptake(nsites,sites,bc_in,dtime,recruitflag) !update water storage in veg after incorporating newly recuited cohorts - if(recruitflag) call UpdateH2OVeg(nsites,sites,bc_out) - + if(recruitflag)then + do s = 1, nsites + call UpdateH2OVeg(sites(s),bc_out(s)) + end do + end if + do s = 1, nsites site_hydr => sites(s)%si_hydr @@ -2431,15 +2458,6 @@ subroutine hydraulics_bc ( nsites, sites, bc_in, bc_out, dtime) prev_h2osoil = sum(site_hydr%h2osoi_liqvol_shell(:,:) * & site_hydr%v_shell(:,:)) * denh2o * AREA_INV - ! 2433 - if (JD_debug) then - write(fates_log(),*) ' line 2434' - write(fates_log(),*) 'prev_h2oveg', prev_h2oveg - write(fates_log(),*) 'prev_h2osoil',prev_h2osoil - write(fates_log(),*) 'site_hydr%h2osoi_liqvol_shell(:,:)',site_hydr%h2osoi_liqvol_shell(:,:) - write(fates_log(),*) 'site_hydr%v_shell(:,:)',site_hydr%v_shell(:,:) - endif - bc_out(s)%qflx_ro_sisl(:) = 0._r8 ! Zero out diagnotsics that rely on accumulation @@ -2594,13 +2612,6 @@ subroutine hydraulics_bc ( nsites, sites, bc_in, bc_out, dtime) ! Update total site-level stored plant water [kg/m2] ! (this is not zerod, but incremented) - ! check which one is NaN - if (JD_debug) then - write(fates_log(),*) ' line 2535' - write(fates_log(),*) 'dwat_plant', dwat_plant - write(fates_log(),*) 'site_hydr%h2oveg',site_hydr%h2oveg - endif - site_hydr%h2oveg = site_hydr%h2oveg + dwat_plant*ccohort%n*AREA_INV sc = ccohort%size_class @@ -2669,8 +2680,9 @@ subroutine hydraulics_bc ( nsites, sites, bc_in, bc_out, dtime) ! Update the site-level state variable ! rhizosphere shell water content [m3/m3] - ! Junyan added loginfo - if (JD_debug) then + + ! loginfo + if (debug) then write(fates_log(),*) 'code line 2619' write(fates_log(),*) 'layer: ', j write(fates_log(),*) 'dth_layershell_col(j,:):', dth_layershell_col(j,:) @@ -2741,7 +2753,8 @@ subroutine hydraulics_bc ( nsites, sites, bc_in, bc_out, dtime) delta_soil_storage = sum(site_hydr%h2osoi_liqvol_shell(:,:) * & site_hydr%v_shell(:,:)) * denh2o * AREA_INV - prev_h2osoil - if(abs(delta_plant_storage - (root_flux - transp_flux)) > 1.e-3_r8 ) then + if(abs(delta_plant_storage - (root_flux - transp_flux)) > error_thresh ) then + write(fates_log(),*) 'Site plant water balance does not close' write(fates_log(),*) 'delta plant storage: ',delta_plant_storage,' [kg/m2]' write(fates_log(),*) 'integrated root flux: ',root_flux,' [kg/m2]' @@ -2775,17 +2788,6 @@ subroutine hydraulics_bc ( nsites, sites, bc_in, bc_out, dtime) wb_check_site = delta_plant_storage+delta_soil_storage+site_runoff+transp_flux -! if( abs(wb_check_site - site_hydr%errh2o_hyd) > 1.e-5_r8 ) then -! write(fates_log(),*) 'FATES hydro water ERROR balance does not add up [kg/m2]:',wb_check_site - site_hydr%errh2o_hyd -! write(fates_log(),*) 'wb_error_site: ',site_hydr%errh2o_hyd -! write(fates_log(),*) 'wb_check_site: ',wb_check_site -! write(fates_log(),*) 'delta_plant_storage: ',delta_plant_storage -! write(fates_log(),*) 'delta_soil_storage: ',delta_soil_storage -! write(fates_log(),*) 'site_runoff: ',site_runoff -! write(fates_log(),*) 'transp_flux: ',transp_flux -! call endrun(msg=errMsg(sourcefile, __LINE__)) -! end if - ! Now check on total error if( abs(wb_check_site) > 1.e-4_r8 ) then write(fates_log(),*) 'FATES hydro water balance does not add up [kg/m2]' @@ -2799,24 +2801,10 @@ subroutine hydraulics_bc ( nsites, sites, bc_in, bc_out, dtime) site_hydr%h2oveg_hydro_err = site_hydr%h2oveg_hydro_err + site_hydr%errh2o_hyd - bc_out(s)%plant_stored_h2o_si = site_hydr%h2oveg + site_hydr%h2oveg_dead - & - site_hydr%h2oveg_growturn_err - & - site_hydr%h2oveg_pheno_err-& - site_hydr%h2oveg_hydro_err - if (JD_debug) then - write(fates_log(),*) 'line 2797, check bc_out' - write(fates_log(),*) 'wb_check_site:', wb_check_site + call UpdateH2OVeg(sites(s),bc_out(s)) - write(fates_log(),*) 'bc_out(s)%site plant_stored_h2o:', bc_out(s)%plant_stored_h2o_si - write(fates_log(),*) 'check each term of plant_stored_h2o' - write(fates_log(),*) 'site_hydr%h2oveg',site_hydr%h2oveg - write(fates_log(),*) 'site_hydr%h2oveg_dead',site_hydr%h2oveg_dead - write(fates_log(),*) 'site_hydr%h2oveg_growturn_err',site_hydr%h2oveg_growturn_err - write(fates_log(),*) 'site_hydr%h2oveg_pheno_err',site_hydr%h2oveg_pheno_err - write(fates_log(),*) 'site_hydr%errh2o_hyd',site_hydr%errh2o_hyd, 'this term is correct' - endif enddo !site - + return end subroutine Hydraulics_BC @@ -3629,7 +3617,7 @@ subroutine ImTaylorSolve1D(site_hydr,cohort,cohort_hydr,dtime,q_top, & kmax_up = site_hydr%kmax_upper_shell(ilayer,1)*aroot_frac_plant ! Junyan added the log content for debugging, JD1 - if (JD_debug) then + if (debug) then write(fates_log(),*) 'line 3535, debug 1Dsolve' write(fates_log(),*) 'iteration:', iter, 'step:', istep write(fates_log(),*) 'layer: ',jj, 'order',ilayer, 'shell:', 1 @@ -4263,11 +4251,10 @@ subroutine RecruitWaterStorage(nsites,sites,bc_out) ! This subroutine accounts for the water bound in plants that have ! just recruited. This water is accumulated at the site level for all plants ! that recruit. - ! Because this water is taken from the soil in hydraulics_bc, which will not - ! be called until the next timestep, this water is subtracted out of - ! plant_stored_h2o_si to ensure HLM water balance at the beg_curr_day timestep. - ! plant_stored_h2o_si will include this water when calculated in hydraulics_bc - ! at the next timestep, when it gets pulled from the soil water. + ! *Note that no mass is moved in this call, this routine is only for + ! generating diagnostics. Water fluxes will be calculated during + ! again during RecruitWUptake() the next time the hydraulics routine is run, + ! and water will be removed from the soil to accomodate. ! --------------------------------------------------------------------------- ! Arguments @@ -4437,10 +4424,6 @@ subroutine shellGeom(l_aroot, rs1, area_site, dz, r_out_shell, r_node_shell, v_s integer :: k ! rhizosphere shell indicies integer :: nshells ! We don't use the global because of unit testing !----------------------------------------------------------------------- - if (JD_debug) then - write(fates_log(),*) 'code line 4379, check shellGeom ' - write(fates_log(),*) 'rs1 of a given layer:', rs1 - endif nshells = size(r_out_shell,dim=1) @@ -5517,81 +5500,67 @@ subroutine InitHydroGlobals() ! Initialize the Water Retention Functions ! ----------------------------------------------------------------------------------- - select case(plant_wrf_type) - case(van_genuchten_type) - do ft = 1,numpft - do pm = 1, n_plant_media - allocate(wrf_vg) - wrf_plant(pm,ft)%p => wrf_vg - call wrf_vg%set_wrf_param([alpha_vg, psd_vg, th_sat_vg, th_res_vg]) - end do - end do - case(campbell_type) - do ft = 1,numpft - do pm = 1,n_plant_media - allocate(wrf_cch) - wrf_plant(pm,ft)%p => wrf_cch - call wrf_cch%set_wrf_param([EDPftvarcon_inst%hydr_thetas_node(ft,pm), & - EDPftvarcon_inst%hydr_pinot_node(ft,pm), & - 9._r8]) - end do - end do - case(tfs_type) - do ft = 1,numpft - do pm = 1,n_plant_media - allocate(wrf_tfs) - wrf_plant(pm,ft)%p => wrf_tfs - - if (pm.eq.leaf_p_media) then ! Leaf tissue - cap_slp = 0.0_r8 - cap_int = 0.0_r8 - cap_corr = 1.0_r8 - else ! Non leaf tissues - cap_slp = (hydr_psi0 - hydr_psicap )/(1.0_r8 - rwccap(pm)) - cap_int = -cap_slp + hydr_psi0 - cap_corr = -cap_int/cap_slp - end if - - call wrf_tfs%set_wrf_param([EDPftvarcon_inst%hydr_thetas_node(ft,pm), & - EDPftvarcon_inst%hydr_resid_node(ft,pm), & - EDPftvarcon_inst%hydr_pinot_node(ft,pm), & - EDPftvarcon_inst%hydr_epsil_node(ft,pm), & - rwcft(pm), & - cap_corr, & - cap_int, & - cap_slp,real(pm,r8)]) + do pm = 1, n_plant_media + select case(hydr_htftype_node(pm)) + case(van_genuchten_type) + do ft = 1,numpft + allocate(wrf_vg) + wrf_plant(pm,ft)%p => wrf_vg + call wrf_vg%set_wrf_param([EDPftvarcon_inst%hydr_vg_alpha_node(ft,pm), & + EDPftvarcon_inst%hydr_vg_m_node(ft,pm), & + EDPftvarcon_inst%hydr_thetas_node(ft,pm), & + EDPftvarcon_inst%hydr_resid_node(ft,pm)]) + end do + case(tfs_type) + do ft = 1,numpft + allocate(wrf_tfs) + wrf_plant(pm,ft)%p => wrf_tfs + if (pm.eq.leaf_p_media) then ! Leaf tissue + cap_slp = 0.0_r8 + cap_int = 0.0_r8 + cap_corr = 1.0_r8 + else ! Non leaf tissues + cap_slp = (hydr_psi0 - hydr_psicap )/(1.0_r8 - rwccap(pm)) + cap_int = -cap_slp + hydr_psi0 + cap_corr = -cap_int/cap_slp + end if + call wrf_tfs%set_wrf_param([EDPftvarcon_inst%hydr_thetas_node(ft,pm), & + EDPftvarcon_inst%hydr_resid_node(ft,pm), & + EDPftvarcon_inst%hydr_pinot_node(ft,pm), & + EDPftvarcon_inst%hydr_epsil_node(ft,pm), & + rwcft(pm), & + cap_corr, & + cap_int, & + cap_slp,real(pm,r8)]) end do - end do - - end select + end select + end do ! ----------------------------------------------------------------------------------- ! Initialize the Water Conductance (K) Functions ! ----------------------------------------------------------------------------------- - - select case(plant_wkf_type) - case(van_genuchten_type) - do ft = 1,numpft - do pm = 1, n_plant_media - allocate(wkf_vg) - wkf_plant(pm,ft)%p => wkf_vg - call wkf_vg%set_wkf_param([alpha_vg, psd_vg, th_sat_vg, th_res_vg, tort_vg]) - end do - - end do - case(campbell_type) - write(fates_log(),*) 'campbell/clapp-hornberger conductance not used in plants' - call endrun(msg=errMsg(sourcefile, __LINE__)) - case(tfs_type) - do ft = 1,numpft - do pm = 1, n_plant_media - allocate(wkf_tfs) - wkf_plant(pm,ft)%p => wkf_tfs - call wkf_tfs%set_wkf_param([EDPftvarcon_inst%hydr_p50_node(ft,pm), & - EDPftvarcon_inst%hydr_avuln_node(ft,pm)]) - end do - end do - end select + do pm = 1, n_plant_media + select case(hydr_htftype_node(pm)) + + case(van_genuchten_type) + do ft = 1,numpft + allocate(wkf_vg) + wkf_plant(pm,ft)%p => wkf_vg + call wkf_vg%set_wkf_param([EDPftvarcon_inst%hydr_vg_alpha_node(ft,pm), & + EDPftvarcon_inst%hydr_vg_m_node(ft,pm), & + EDPftvarcon_inst%hydr_thetas_node(ft,pm), & + EDPftvarcon_inst%hydr_resid_node(ft,pm), & + tort_vg]) + end do + case(tfs_type) + do ft = 1,numpft + allocate(wkf_tfs) + wkf_plant(pm,ft)%p => wkf_tfs + call wkf_tfs%set_wkf_param([EDPftvarcon_inst%hydr_p50_node(ft,pm), & + EDPftvarcon_inst%hydr_avuln_node(ft,pm)]) + end do + end select + end do ! There is only 1 stomata conductance hypothesis which uses the p50 and ! vulnerability parameters diff --git a/biogeophys/FatesPlantRespPhotosynthMod.F90 b/biogeophys/FatesPlantRespPhotosynthMod.F90 index bfe01d25be..349f6473bf 100644 --- a/biogeophys/FatesPlantRespPhotosynthMod.F90 +++ b/biogeophys/FatesPlantRespPhotosynthMod.F90 @@ -159,8 +159,6 @@ subroutine FatesPlantRespPhotosynthDrive (nsites, sites,bc_in,bc_out,dtime) ! (umol co2/m**2/s) real(r8) :: jmax_z ! leaf layer maximum electron transport rate ! (umol electrons/m**2/s) - real(r8) :: tpu_z ! leaf layer triose phosphate utilization rate - ! (umol CO2/m**2/s) real(r8) :: kp_z ! leaf layer initial slope of CO2 response ! curve (C4 plants) real(r8) :: c13disc_z(nclmax,maxpft,nlevleaf) ! carbon 13 in newly assimilated carbon at leaf level @@ -272,7 +270,8 @@ subroutine FatesPlantRespPhotosynthDrive (nsites, sites,bc_in,bc_out,dtime) do ft = 1,numpft call set_root_fraction(rootfr_ft(ft,:), ft, & - bc_in(s)%zi_sisl) + bc_in(s)%zi_sisl, & + bc_in(s)%max_rooting_depth_index_col) end do @@ -456,7 +455,7 @@ subroutine FatesPlantRespPhotosynthDrive (nsites, sites,bc_in,bc_out,dtime) select case(hlm_parteh_mode) case (prt_carbon_allom_hyp) - lnc_top = prt_params%nitr_stoich_p1(ft,leaf_organ)/slatop(ft) + lnc_top = prt_params%nitr_stoich_p1(ft,prt_params%organ_param_id(leaf_organ))/slatop(ft) case (prt_cnp_flex_allom_hyp) @@ -465,12 +464,12 @@ subroutine FatesPlantRespPhotosynthDrive (nsites, sites,bc_in,bc_out,dtime) leaf_n = currentCohort%prt%GetState(leaf_organ, nitrogen_element) lnc_top = leaf_n / (slatop(ft) * leaf_c ) else - lnc_top = prt_params%nitr_stoich_p1(ft,leaf_organ)/slatop(ft) + lnc_top = prt_params%nitr_stoich_p1(ft,prt_params%organ_param_id(leaf_organ))/slatop(ft) end if ! If one wants to break coupling with dynamic N conentrations, ! use the stoichiometry parameter - ! lnc_top = prt_params%nitr_stoich_p1(ft,leaf_organ)/slatop(ft) + ! lnc_top = prt_params%nitr_stoich_p1(ft,prt_params%organ_param_id(leaf_organ))/slatop(ft) end select @@ -501,14 +500,12 @@ subroutine FatesPlantRespPhotosynthDrive (nsites, sites,bc_in,bc_out,dtime) ft, & ! in currentCohort%vcmax25top, & ! in currentCohort%jmax25top, & ! in - currentCohort%tpu25top, & ! in currentCohort%kp25top, & ! in nscaler, & ! in bc_in(s)%t_veg_pa(ifp), & ! in btran_eff, & ! in vcmax_z, & ! out jmax_z, & ! out - tpu_z, & ! out kp_z ) ! out ! Part IX: This call calculates the actual photosynthesis for the @@ -523,7 +520,6 @@ subroutine FatesPlantRespPhotosynthDrive (nsites, sites,bc_in,bc_out,dtime) ft, & ! in vcmax_z, & ! in jmax_z, & ! in - tpu_z, & ! in kp_z, & ! in bc_in(s)%t_veg_pa(ifp), & ! in bc_in(s)%esat_tv_pa(ifp), & ! in @@ -617,12 +613,12 @@ subroutine FatesPlantRespPhotosynthDrive (nsites, sites,bc_in,bc_out,dtime) case (prt_carbon_allom_hyp) live_stem_n = prt_params%allom_agb_frac(currentCohort%pft) * & - sapw_c * prt_params%nitr_stoich_p1(ft,sapw_organ) + sapw_c * prt_params%nitr_stoich_p1(ft,prt_params%organ_param_id(sapw_organ)) live_croot_n = (1.0_r8-prt_params%allom_agb_frac(currentCohort%pft)) * & - sapw_c * prt_params%nitr_stoich_p1(ft,sapw_organ) + sapw_c * prt_params%nitr_stoich_p1(ft,prt_params%organ_param_id(sapw_organ)) - fnrt_n = fnrt_c * prt_params%nitr_stoich_p1(ft,fnrt_organ) + fnrt_n = fnrt_c * prt_params%nitr_stoich_p1(ft,prt_params%organ_param_id(fnrt_organ)) case(prt_cnp_flex_allom_hyp) @@ -638,10 +634,10 @@ subroutine FatesPlantRespPhotosynthDrive (nsites, sites,bc_in,bc_out,dtime) ! use the stoichiometry parameter ! ! live_stem_n = prt_params%allom_agb_frac(currentCohort%pft) * & - ! sapw_c * prt_params%nitr_stoich_p1(ft,sapw_organ) + ! sapw_c * prt_params%nitr_stoich_p1(ft,prt_params%organ_param_id(sapw_organ)) ! live_croot_n = (1.0_r8-prt_params%allom_agb_frac(currentCohort%pft)) * & - ! sapw_c * prt_params%nitr_stoich_p1(ft,sapw_organ) - ! fnrt_n = fnrt_c * prt_params%nitr_stoich_p1(ft,fnrt_organ) + ! sapw_c * prt_params%nitr_stoich_p1(ft,prt_params%organ_param_id(sapw_organ)) + ! fnrt_n = fnrt_c * prt_params%nitr_stoich_p1(ft,prt_params%organ_param_id(fnrt_organ)) case default @@ -839,7 +835,6 @@ subroutine LeafLayerPhotosynthesis(f_sun_lsl, & ! in ft, & ! in vcmax, & ! in jmax, & ! in - tpu, & ! in co2_rcurve_islope, & ! in veg_tempk, & ! in veg_esat, & ! in @@ -870,6 +865,7 @@ subroutine LeafLayerPhotosynthesis(f_sun_lsl, & ! in ! ------------------------------------------------------------------------------------ use EDPftvarcon , only : EDPftvarcon_inst + use EDParamsMod , only : theta_cj_c3, theta_cj_c4 ! Arguments @@ -883,7 +879,6 @@ subroutine LeafLayerPhotosynthesis(f_sun_lsl, & ! in integer, intent(in) :: ft ! (plant) Functional Type Index real(r8), intent(in) :: vcmax ! maximum rate of carboxylation (umol co2/m**2/s) real(r8), intent(in) :: jmax ! maximum electron transport rate (umol electrons/m**2/s) - real(r8), intent(in) :: tpu ! triose phosphate utilization rate (umol CO2/m**2/s) real(r8), intent(in) :: co2_rcurve_islope ! initial slope of CO2 response curve (C4 plants) real(r8), intent(in) :: veg_tempk ! vegetation temperature real(r8), intent(in) :: veg_esat ! saturation vapor pressure at veg_tempk (Pa) @@ -968,11 +963,6 @@ subroutine LeafLayerPhotosynthesis(f_sun_lsl, & ! in ! quantum efficiency, used only for C4 (mol CO2 / mol photons) (index 0) real(r8),parameter,dimension(0:1) :: quant_eff = [0.05_r8,0.0_r8] - ! empirical curvature parameter for ac, aj photosynthesis co-limitation. - ! Changed theta_cj and theta_ip to 0.999 to effectively remove smoothing logic - ! following Anthony Walker's findings from MAAT. - real(r8),parameter,dimension(0:1) :: theta_cj = [0.999_r8,0.999_r8] - ! empirical curvature parameter for ap photosynthesis co-limitation real(r8),parameter :: theta_ip = 0.999_r8 @@ -1067,10 +1057,14 @@ subroutine LeafLayerPhotosynthesis(f_sun_lsl, & ! in ! C3: RuBP-limited photosynthesis aj = je * max(co2_inter_c-co2_cpoint, 0._r8) / & (4._r8*co2_inter_c+8._r8*co2_cpoint) - - ! C3: Product-limited photosynthesis - ap = 3._r8 * tpu - + + ! Gross photosynthesis smoothing calculations. Co-limit ac and aj. + aquad = theta_cj_c3 + bquad = -(ac + aj) + cquad = ac * aj + call quadratic_f (aquad, bquad, cquad, r1, r2) + agross = min(r1,r2) + else ! C4: Rubisco-limited photosynthesis @@ -1091,23 +1085,24 @@ subroutine LeafLayerPhotosynthesis(f_sun_lsl, & ! in aj = aj / (laisha_lsl * canopy_area_lsl) end if - ! C4: PEP carboxylase-limited (CO2-limited) - ap = co2_rcurve_islope * max(co2_inter_c, 0._r8) / can_press - - end if + ! C4: PEP carboxylase-limited (CO2-limited) + ap = co2_rcurve_islope * max(co2_inter_c, 0._r8) / can_press - ! Gross photosynthesis smoothing calculations. First co-limit ac and aj. Then co-limit ap - aquad = theta_cj(c3c4_path_index) - bquad = -(ac + aj) - cquad = ac * aj - call quadratic_f (aquad, bquad, cquad, r1, r2) - ai = min(r1,r2) + ! Gross photosynthesis smoothing calculations. First co-limit ac and aj. Then co-limit ap - aquad = theta_ip - bquad = -(ai + ap) - cquad = ai * ap - call quadratic_f (aquad, bquad, cquad, r1, r2) - agross = min(r1,r2) + aquad = theta_cj_c4 + bquad = -(ac + aj) + cquad = ac * aj + call quadratic_f (aquad, bquad, cquad, r1, r2) + ai = min(r1,r2) + + aquad = theta_ip + bquad = -(ai + ap) + cquad = ai * ap + call quadratic_f (aquad, bquad, cquad, r1, r2) + agross = min(r1,r2) + + end if ! Net carbon assimilation. Exit iteration if an < 0 anet = agross - lmr @@ -1693,7 +1688,6 @@ subroutine GetCanopyGasParameters(can_press, & ! Activation energy, from: ! Bernacchi et al (2001) Plant, Cell and Environment 24:253-259 ! Bernacchi et al (2003) Plant, Cell and Environment 26:1419-1430 - ! except TPU from: Harley et al (1992) Plant, Cell and Environment 15:271-282 real(r8), parameter :: kcha = 79430._r8 ! activation energy for kc (J/mol) real(r8), parameter :: koha = 36380._r8 ! activation energy for ko (J/mol) @@ -1814,14 +1808,12 @@ subroutine LeafLayerBiophysicalRates( parsun_lsl, & ft, & vcmax25top_ft, & jmax25top_ft, & - tpu25top_ft, & co2_rcurve_islope25top_ft, & nscaler, & veg_tempk, & btran, & vcmax, & jmax, & - tpu, & co2_rcurve_islope ) ! --------------------------------------------------------------------------------- @@ -1834,7 +1826,6 @@ subroutine LeafLayerBiophysicalRates( parsun_lsl, & ! The output biophysical rates are: ! vcmax: maximum rate of carboxilation, ! jmax: maximum electron transport rate, - ! tpu: triose phosphate utilization rate and ! co2_rcurve_islope: initial slope of CO2 response curve (C4 plants) ! --------------------------------------------------------------------------------- @@ -1851,8 +1842,6 @@ subroutine LeafLayerBiophysicalRates( parsun_lsl, & ! for this pft (umol CO2/m**2/s) real(r8), intent(in) :: jmax25top_ft ! canopy top maximum electron transport rate at 25C ! for this pft (umol electrons/m**2/s) - real(r8), intent(in) :: tpu25top_ft ! canopy top triose phosphate utilization rate at 25C - ! for this pft (umol CO2/m**2/s) real(r8), intent(in) :: co2_rcurve_islope25top_ft ! initial slope of CO2 response curve ! (C4 plants) at 25C, canopy top, this pft real(r8), intent(in) :: veg_tempk ! vegetation temperature @@ -1861,8 +1850,6 @@ subroutine LeafLayerBiophysicalRates( parsun_lsl, & real(r8), intent(out) :: vcmax ! maximum rate of carboxylation (umol co2/m**2/s) real(r8), intent(out) :: jmax ! maximum electron transport rate ! (umol electrons/m**2/s) - real(r8), intent(out) :: tpu ! triose phosphate utilization rate - ! (umol CO2/m**2/s) real(r8), intent(out) :: co2_rcurve_islope ! initial slope of CO2 response curve (C4 plants) ! Locals @@ -1871,8 +1858,6 @@ subroutine LeafLayerBiophysicalRates( parsun_lsl, & ! (umol CO2/m**2/s) real(r8) :: jmax25 ! leaf layer: maximum electron transport rate at 25C ! (umol electrons/m**2/s) - real(r8) :: tpu25 ! leaf layer: triose phosphate utilization rate at 25C - ! (umol CO2/m**2/s) real(r8) :: co2_rcurve_islope25 ! leaf layer: Initial slope of CO2 response curve ! (C4 plants) at 25C @@ -1881,50 +1866,39 @@ subroutine LeafLayerBiophysicalRates( parsun_lsl, & ! --------------------------------------------------------------------------------- real(r8) :: vcmaxha ! activation energy for vcmax (J/mol) real(r8) :: jmaxha ! activation energy for jmax (J/mol) - real(r8) :: tpuha ! activation energy for tpu (J/mol) real(r8) :: vcmaxhd ! deactivation energy for vcmax (J/mol) real(r8) :: jmaxhd ! deactivation energy for jmax (J/mol) - real(r8) :: tpuhd ! deactivation energy for tpu (J/mol) real(r8) :: vcmaxse ! entropy term for vcmax (J/mol/K) real(r8) :: jmaxse ! entropy term for jmax (J/mol/K) - real(r8) :: tpuse ! entropy term for tpu (J/mol/K) real(r8) :: vcmaxc ! scaling factor for high temperature inhibition (25 C = 1.0) real(r8) :: jmaxc ! scaling factor for high temperature inhibition (25 C = 1.0) - real(r8) :: tpuc ! scaling factor for high temperature inhibition (25 C = 1.0) vcmaxha = EDPftvarcon_inst%vcmaxha(FT) jmaxha = EDPftvarcon_inst%jmaxha(FT) - tpuha = EDPftvarcon_inst%tpuha(FT) vcmaxhd = EDPftvarcon_inst%vcmaxhd(FT) jmaxhd = EDPftvarcon_inst%jmaxhd(FT) - tpuhd = EDPftvarcon_inst%tpuhd(FT) vcmaxse = EDPftvarcon_inst%vcmaxse(FT) jmaxse = EDPftvarcon_inst%jmaxse(FT) - tpuse = EDPftvarcon_inst%tpuse(FT) vcmaxc = fth25_f(vcmaxhd, vcmaxse) jmaxc = fth25_f(jmaxhd, jmaxse) - tpuc = fth25_f(tpuhd, tpuse) if ( parsun_lsl <= 0._r8) then ! night time vcmax = 0._r8 jmax = 0._r8 - tpu = 0._r8 co2_rcurve_islope = 0._r8 else ! day time ! Vcmax25top was already calculated to derive the nscaler function vcmax25 = vcmax25top_ft * nscaler jmax25 = jmax25top_ft * nscaler - tpu25 = tpu25top_ft * nscaler co2_rcurve_islope25 = co2_rcurve_islope25top_ft * nscaler ! Adjust for temperature vcmax = vcmax25 * ft1_f(veg_tempk, vcmaxha) * fth_f(veg_tempk, vcmaxhd, vcmaxse, vcmaxc) jmax = jmax25 * ft1_f(veg_tempk, jmaxha) * fth_f(veg_tempk, jmaxhd, jmaxse, jmaxc) - tpu = tpu25 * ft1_f(veg_tempk, tpuha) * fth_f(veg_tempk, tpuhd, tpuse, tpuc) if (nint(EDPftvarcon_inst%c3psn(ft)) /= 1) then vcmax = vcmax25 * 2._r8**((veg_tempk-(tfrz+25._r8))/10._r8) diff --git a/fire/SFMainMod.F90 b/fire/SFMainMod.F90 index dd417c9974..127dfa43f9 100644 --- a/fire/SFMainMod.F90 +++ b/fire/SFMainMod.F90 @@ -7,6 +7,7 @@ module SFMainMod use FatesConstantsMod , only : r8 => fates_r8 use FatesConstantsMod , only : itrue, ifalse + use FatesConstantsMod , only : pi_const use FatesInterfaceTypesMod , only : hlm_masterproc ! 1= master process, 0=not master process use EDTypesMod , only : numWaterMem use FatesGlobals , only : fates_log @@ -205,20 +206,11 @@ subroutine charecteristics_of_fuel ( currentSite ) ! NCWD =4 NFSC = 6 ! tw_sf = 1, lb_sf = 3, tr_sf = 4, dl_sf = 5, lg_sf = 6, - ! zero fire arrays. - currentPatch%fuel_eff_moist = 0.0_r8 - currentPatch%fuel_bulkd = 0.0_r8 !this is kgBiomass/m3 for use in rate of spread equations - currentPatch%fuel_sav = 0.0_r8 - currentPatch%fuel_frac(:) = 0.0_r8 - currentPatch%fuel_mef = 0.0_r8 - currentPatch%sum_fuel = 0.0_r8 - currentPatch%fuel_frac = 0.0_r8 if(write_sf == itrue)then if ( hlm_masterproc == itrue ) write(fates_log(),*) ' leaf_litter1 ',sum(litt_c%leaf_fines(:)) if ( hlm_masterproc == itrue ) write(fates_log(),*) ' leaf_litter2 ',sum(litt_c%ag_cwd(:)) if ( hlm_masterproc == itrue ) write(fates_log(),*) ' leaf_litter3 ',currentPatch%livegrass - if ( hlm_masterproc == itrue ) write(fates_log(),*) ' sum fuel', currentPatch%sum_fuel endif currentPatch%sum_fuel = sum(litt_c%leaf_fines(:)) + & @@ -237,14 +229,21 @@ subroutine charecteristics_of_fuel ( currentSite ) currentPatch%fuel_frac(tw_sf:tr_sf) = litt_c%ag_cwd(:) / currentPatch%sum_fuel if(write_sf == itrue)then - if ( hlm_masterproc == itrue ) write(fates_log(),*) 'ff1 ',currentPatch%fuel_frac - if ( hlm_masterproc == itrue ) write(fates_log(),*) 'ff2 ',currentPatch%fuel_frac if ( hlm_masterproc == itrue ) write(fates_log(),*) 'ff2a ', & lg_sf,currentPatch%livegrass,currentPatch%sum_fuel endif - currentPatch%fuel_frac(lg_sf) = currentPatch%livegrass / currentPatch%sum_fuel - MEF(1:nfsc) = 0.524_r8 - 0.066_r8 * log10(SF_val_SAV(1:nfsc)) + currentPatch%fuel_frac(lg_sf) = currentPatch%livegrass / currentPatch%sum_fuel + + ! MEF (moisure of extinction) depends on compactness of fuel, depth, particle size, wind, slope + ! Eqn here is eqn 27 from Peterson and Ryan (1986) "Modeling Postfire Conifer Mortality for Long-Range Planning" + ! but lots of other approaches in use out there... + ! MEF: pine needles=0.30 (text near EQ 28 Rothermal 1972) + ! Table II-1 NFFL mixed fuels models from Rothermal 1983 Gen. Tech. Rep. INT-143 + ! MEF: short grass=0.12,tall grass=0.25,chaparral=0.20,closed timber litter=0.30,hardwood litter=0.25 + ! Thonicke 2010 SAV values propagated thru P&R86 eqn below gives MEF:tw=0.355, sb=0.44, lb=0.525, tr=0.63, dg=0.248, lg=0.248 + ! Lasslop 2014 Table 1 MEF PFT level:grass=0.2,shrubs=0.3,TropEverGrnTree=0.2,TropDecid Tree=0.3, Extra-trop Tree=0.3 + MEF(1:nfsc) = 0.524_r8 - 0.066_r8 * log(SF_val_SAV(1:nfsc)) !--- weighted average of relative moisture content--- ! Equation 6 in Thonicke et al. 2010. across twig, small branch, large branch, and dead leaves @@ -313,7 +312,6 @@ subroutine charecteristics_of_fuel ( currentSite ) currentPatch%fuel_frac(:) = 0.0000000001_r8 currentPatch%fuel_mef = 0.0000000001_r8 currentPatch%sum_fuel = 0.0000000001_r8 - currentPatch%fuel_frac = 0.0000000001_r8 endif ! check values. @@ -450,12 +448,6 @@ subroutine rate_of_spread ( currentSite ) do while(associated(currentPatch)) - ! ---initialise parameters to zero.--- - beta_ratio = 0.0_r8; q_ig = 0.0_r8; eps = 0.0_r8; a = 0.0_r8; b = 0.0_r8; c = 0.0_r8; e = 0.0_r8 - phi_wind = 0.0_r8; xi = 0.0_r8; reaction_v_max = 0.0_r8; reaction_v_opt = 0.0_r8; mw_weight = 0.0_r8 - moist_damp = 0.0_r8; ir = 0.0_r8; a_beta = 0.0_r8; - currentPatch%ROS_front = 0.0_r8 - ! remove mineral content from net fuel load per Thonicke 2010 for ir calculation currentPatch%sum_fuel = currentPatch%sum_fuel * (1.0_r8 - SF_val_miner_total) !net of minerals @@ -492,11 +484,11 @@ subroutine rate_of_spread ( currentSite ) ! ---effective heating number--- ! Equation A3 in Thonicke et al. 2010. eps = exp(-4.528_r8 / currentPatch%fuel_sav) - ! Equation A7 in Thonicke et al. 2010 + ! Equation A7 in Thonicke et al. 2010 per eqn 49 from Rothermel 1972 b = 0.15988_r8 * (currentPatch%fuel_sav**0.54_r8) - ! Equation A8 in Thonicke et al. 2010 + ! Equation A8 in Thonicke et al. 2010 per eqn 48 from Rothermel 1972 c = 7.47_r8 * (exp(-0.8711_r8 * (currentPatch%fuel_sav**0.55_r8))) - ! Equation A9 in Thonicke et al. 2010. + ! Equation A9 in Thonicke et al. 2010. (appears to have typo, using coefficient eqn.50 Rothermel 1972) e = 0.715_r8 * (exp(-0.01094_r8 * currentPatch%fuel_sav)) if (debug) then @@ -541,11 +533,6 @@ subroutine rate_of_spread ( currentSite ) moist_damp = max(0.0_r8,(1.0_r8 - (2.59_r8 * mw_weight) + (5.11_r8 * (mw_weight**2.0_r8)) - & (3.52_r8*(mw_weight**3.0_r8)))) - ! FIX(SPM, 040114) ask RF if this should be an endrun - ! if(write_SF == itrue)then - ! write(fates_log(),*) 'moist_damp' ,moist_damp,mw_weight,currentPatch%fuel_eff_moist,currentPatch%fuel_mef - ! endif - ! ir = reaction intenisty in kJ/m2/min ! currentPatch%sum_fuel converted from kgC/m2 to kgBiomass/m2 for ir calculation ir = reaction_v_opt*(currentPatch%sum_fuel/0.45_r8)*SF_val_fuel_energy*moist_damp*SF_val_miner_damp @@ -586,14 +573,14 @@ subroutine ground_fuel_consumption ( currentSite ) real(r8) :: moist !effective fuel moisture real(r8) :: tau_b(nfsc) !lethal heating rates for each fuel class (min) - real(r8) :: fc_ground(nfsc) !proportion of fuel consumed + real(r8) :: fc_ground(nfsc) !total amount of fuel consumed per area of burned ground (kg C / m2 of burned area) integer :: c currentPatch => currentSite%oldest_patch; do while(associated(currentPatch)) - currentPatch%burnt_frac_litter = 1.0_r8 + currentPatch%burnt_frac_litter(:) = 1.0_r8 ! Calculate fraction of litter is burnt for all classes. ! Equation B1 in Thonicke et al. 2010--- do c = 1, nfsc !work out the burnt fraction for all pools, even if those pools dont exist. @@ -622,8 +609,9 @@ subroutine ground_fuel_consumption ( currentSite ) ! we can't ever kill -all- of the grass. currentPatch%burnt_frac_litter(lg_sf) = min(0.8_r8,currentPatch%burnt_frac_litter(lg_sf )) + ! reduce burnt amount for mineral content. - currentPatch%burnt_frac_litter = currentPatch%burnt_frac_litter * (1.0_r8-SF_val_miner_total) + currentPatch%burnt_frac_litter(:) = currentPatch%burnt_frac_litter(:) * (1.0_r8-SF_val_miner_total) !---Calculate amount of fuel burnt.--- @@ -667,7 +655,7 @@ subroutine area_burnt_intensity ( currentSite, bc_in ) !currentSite%FDI probability that an ignition will start a fire !currentSite%NF number of lighting strikes per day per km2 !currentPatch%ROS_front forward ROS (m/min) - !currentPatch%TFC_ROS total fuel consumed by flaming front (kgC/m2) + !currentPatch%TFC_ROS total fuel consumed by flaming front (kgC/m2 of burned area) use FatesInterfaceTypesMod, only : hlm_spitfire_mode use EDParamsMod, only : ED_val_nignitions @@ -682,6 +670,7 @@ subroutine area_burnt_intensity ( currentSite, bc_in ) real(r8) ROS !m/s real(r8) W !kgBiomass/m2 + real(r8) :: tree_fraction_patch ! patch level. no units real(r8) lb !length to breadth ratio of fire ellipse (unitless) real(r8) df !distance fire has travelled forward in m real(r8) db !distance fire has travelled backward in m @@ -692,11 +681,12 @@ subroutine area_burnt_intensity ( currentSite, bc_in ) real(r8) anthro_ign_count ! anthropogenic ignition count/km2/day integer :: iofp ! index of oldest fates patch real(r8), parameter :: pot_hmn_ign_counts_alpha = 0.0035_r8 ! Potential human ignition counts (alpha in Li et al. 2012) (#/person/month) - real(r8),parameter :: km2_to_m2 = 1000000.0_r8 !area conversion for square km to square m + real(r8), parameter :: km2_to_m2 = 1000000.0_r8 !area conversion for square km to square m + real(r8), parameter :: m_per_min__to__km_per_hour = 0.06_r8 ! convert wind speed from m/min to km/hr + real(r8), parameter :: forest_grassland_lengthtobreadth_threshold = 0.55_r8 ! tree canopy cover below which to use grassland length-to-breadth eqn ! ---initialize site parameters to zero--- - currentSite%frac_burnt = 0.0_r8 - + currentSite%NF_successful = 0._r8 ! Equation 7 from Venevsky et al GCB 2002 (modification of equation 8 in Thonicke et al. 2010) ! FDI 0.1 = low, 0.3 moderate, 0.75 high, and 1 = extreme ignition potential for alpha 0.000337 @@ -734,11 +724,11 @@ subroutine area_burnt_intensity ( currentSite, bc_in ) currentPatch => currentSite%oldest_patch; do while(associated(currentPatch)) ! ---initialize patch parameters to zero--- + currentPatch%FI = 0._r8 currentPatch%fire = 0 currentPatch%FD = 0.0_r8 currentPatch%frac_burnt = 0.0_r8 - if (currentSite%NF > 0.0_r8) then ! Equation 14 in Thonicke et al. 2010 @@ -751,19 +741,28 @@ subroutine area_burnt_intensity ( currentSite, bc_in ) !equation 15 in Arora and Boer CTEM model.Average fire is 1 day long. !currentPatch%FD = 60.0_r8 * 24.0_r8 !no minutes in a day - - ! The feedback between vegetation structure and ellipse size if turned off for now, - ! to reduce the positive feedback in the syste, - ! This will also be investigated by William Hoffmans proposal. - ! if (currentPatch%effect_wspeed < 16.67_r8) then !16.67m/min = 1km/hr - lb = 1.0_r8 - ! else - !FIX(RF,032414) FOR NO GRASS - ! lb = currentPatch%total_canopy_area/currentPatch%area*(1.0_r8)+(8.729_r8 * & - ! ((1.0_r8 -(exp(-0.03_r8 * 0.06_r8 * currentPatch%effect_wspeed)))**2.155_r8)) !& - !& +currentPatch%fpc_grass*(1.1_r8+((0.06_r8*currentPatch%effect_wspeed)**0.0464)) - - ! endif + tree_fraction_patch = 0.0_r8 + tree_fraction_patch = currentPatch%total_tree_area/currentPatch%area + + if(debug)then + write(fates_log(),*) 'SF currentPatch%area ',currentPatch%area + write(fates_log(),*) 'SF currentPatch%total_area ',currentPatch%total_tree_area + write(fates_log(),*) 'SF patch tree fraction ',tree_fraction_patch + write(fates_log(),*) 'SF AREA ',AREA + endif + + if ((currentPatch%effect_wspeed*m_per_min__to__km_per_hour) < 1._r8) then !16.67m/min = 1km/hr + lb = 1.0_r8 + else + if (tree_fraction_patch > forest_grassland_lengthtobreadth_threshold) then !benchmark forest cover, Staver 2010 + ! EQ 79 forest fuels (Canadian Forest Fire Behavior Prediction System Ont.Inf.Rep. ST-X-3, 1992) + lb = (1.0_r8 + (8.729_r8 * & + ((1.0_r8 -(exp(-0.03_r8 * m_per_min__to__km_per_hour * currentPatch%effect_wspeed)))**2.155_r8))) + else ! EQ 80 grass fuels (CFFBPS Ont.Inf.Rep. ST-X-3, 1992, but with a correction from an errata published within + ! Information Report GLC-X-10 by Bottom et al., 2009 because there is a typo in CFFBPS Ont.Inf.Rep. ST-X-3, 1992) + lb = (1.1_r8*((m_per_min__to__km_per_hour * currentPatch%effect_wspeed)**0.464_r8)) + endif + endif ! if (lb > 8.0_r8)then ! lb = 8.0_r8 !Constraint Canadian Fire Behaviour System @@ -780,28 +779,35 @@ subroutine area_burnt_intensity ( currentSite, bc_in ) ! Equation 16 in arora and boer model JGR 2005 ! AB = AB *3.0_r8 - !size of fire = equation 14 Arora and Boer JGR 2005 - size_of_fire = ((3.1416_r8/(4.0_r8*lb))*((df+db)**2.0_r8)) + !size of fire = equation 14 Arora and Boer JGR 2005 (area of an ellipse) + size_of_fire = ((pi_const/(4.0_r8*lb))*((df+db)**2.0_r8)) - !AB = daily area burnt = size fires in m2 * num ignitions per day per km2 * prob ignition starts fire - !AB = m2 per km2 per day + ! AB = daily area burnt = size fires in m2 * num ignitions per day per km2 * prob ignition starts fire + ! AB = m2 per km2 per day + ! the denominator in the units of currentSite%NF is total gridcell area, but since we assume that ignitions + ! are equally probable across patches, currentSite%NF is equivalently per area of a given patch + ! thus AB has units of m2 burned area per km2 patch area per day AB = size_of_fire * currentSite%NF * currentSite%FDI - !frac_burnt - currentPatch%frac_burnt = (min(0.99_r8, AB / km2_to_m2)) * currentPatch%area/area + ! frac_burnt + ! just a unit conversion from AB, to become area burned per area patch per day, + ! or just the fraction of the patch burned on that day + currentPatch%frac_burnt = (min(0.99_r8, AB / km2_to_m2)) if(write_SF == itrue)then if ( hlm_masterproc == itrue ) write(fates_log(),*) 'frac_burnt',currentPatch%frac_burnt endif + else + currentPatch%frac_burnt = 0._r8 endif ! lb ROS = currentPatch%ROS_front / 60.0_r8 !m/min to m/sec - W = currentPatch%TFC_ROS / 0.45_r8 !kgC/m2 to kgbiomass/m2 + W = currentPatch%TFC_ROS / 0.45_r8 !kgC/m2 of burned area to kgbiomass/m2 of burned area ! EQ 15 Thonicke et al 2010 - !units of fire intensity = (kJ/kg)*(kgBiomass/m2)*(m/min)*unitless_fraction - currentPatch%FI = SF_val_fuel_energy * W * ROS * currentPatch%frac_burnt !kj/m/s, or kW/m + !units of fire intensity = (kJ/kg)*(kgBiomass/m2)*(m/min) + currentPatch%FI = SF_val_fuel_energy * W * ROS !kj/m/s, or kW/m if(write_sf == itrue)then if( hlm_masterproc == itrue ) write(fates_log(),*) 'fire_intensity',currentPatch%fi,W,currentPatch%ROS_front @@ -810,7 +816,10 @@ subroutine area_burnt_intensity ( currentSite, bc_in ) !'decide_fire' subroutine if (currentPatch%FI > SF_val_fire_threshold) then !track fires greater than kW/m energy threshold currentPatch%fire = 1 ! Fire... :D - + ! + currentSite%NF_successful = currentSite%NF_successful + & + currentSite%NF * currentSite%FDI * currentPatch%area / area + ! else currentPatch%fire = 0 ! No fire... :-/ currentPatch%FD = 0.0_r8 @@ -818,11 +827,7 @@ subroutine area_burnt_intensity ( currentSite, bc_in ) endif endif! NF ignitions check - - ! accumulate frac_burnt % at site level - currentSite%frac_burnt = currentSite%frac_burnt + currentPatch%frac_burnt - currentPatch => currentPatch%younger enddo !end patch loop diff --git a/main/EDInitMod.F90 b/main/EDInitMod.F90 index bec7a99537..9c3059312d 100644 --- a/main/EDInitMod.F90 +++ b/main/EDInitMod.F90 @@ -36,7 +36,7 @@ module EDInitMod use EDTypesMod , only : phen_dstat_moistoff use EDTypesMod , only : phen_cstat_notcold use EDTypesMod , only : phen_dstat_moiston - use FatesInterfaceTypesMod , only : bc_in_type + use FatesInterfaceTypesMod , only : bc_in_type,bc_out_type use FatesInterfaceTypesMod , only : hlm_use_planthydro use FatesInterfaceTypesMod , only : hlm_use_inventory_init use FatesInterfaceTypesMod , only : hlm_use_fixed_biogeog @@ -44,6 +44,7 @@ module EDInitMod use FatesInterfaceTypesMod , only : nleafage use FatesInterfaceTypesMod , only : nlevsclass use FatesInterfaceTypesMod , only : nlevcoage + use FatesInterfaceTypesMod , only : nlevage use FatesAllometryMod , only : h2d_allom use FatesAllometryMod , only : bagw_allom use FatesAllometryMod , only : bbgw_allom @@ -52,7 +53,7 @@ module EDInitMod use FatesAllometryMod , only : bsap_allom use FatesAllometryMod , only : bdead_allom use FatesAllometryMod , only : bstore_allom - + use PRTGenericMod , only : StorageNutrientTarget use FatesInterfaceTypesMod, only : hlm_parteh_mode use PRTGenericMod, only : prt_carbon_allom_hyp use PRTGenericMod, only : prt_cnp_flex_allom_hyp @@ -92,14 +93,15 @@ module EDInitMod ! ============================================================================ - subroutine init_site_vars( site_in, bc_in ) + subroutine init_site_vars( site_in, bc_in, bc_out ) ! ! !DESCRIPTION: ! ! ! !ARGUMENTS - type(ed_site_type), intent(inout) :: site_in - type(bc_in_type),intent(in) :: bc_in + type(ed_site_type), intent(inout) :: site_in + type(bc_in_type),intent(in),target :: bc_in + type(bc_out_type),intent(in),target :: bc_out ! ! !LOCAL VARIABLES: !---------------------------------------------------------------------- @@ -133,19 +135,16 @@ subroutine init_site_vars( site_in, bc_in ) allocate(site_in%flux_diags(el)%root_litter_input(1:numpft)) allocate(site_in%flux_diags(el)%nutrient_efflux_scpf(nlevsclass*numpft)) allocate(site_in%flux_diags(el)%nutrient_uptake_scpf(nlevsclass*numpft)) - allocate(site_in%flux_diags(el)%nutrient_needgrow_scpf(nlevsclass*numpft)) - allocate(site_in%flux_diags(el)%nutrient_needmax_scpf(nlevsclass*numpft)) + allocate(site_in%flux_diags(el)%nutrient_need_scpf(nlevsclass*numpft)) end do ! Initialize the static soil ! arrays from the boundary (initial) condition - - + site_in%zi_soil(:) = bc_in%zi_sisl(:) site_in%dz_soil(:) = bc_in%dz_sisl(:) site_in%z_soil(:) = bc_in%z_sisl(:) - ! end subroutine init_site_vars @@ -173,6 +172,7 @@ subroutine zero_site( site_in ) site_in%cstatus = fates_unset_int ! are leaves in this pixel on or off? site_in%dstatus = fates_unset_int site_in%grow_deg_days = nan ! growing degree days + site_in%snow_depth = nan site_in%nchilldays = fates_unset_int site_in%ncolddays = fates_unset_int site_in%cleafondate = fates_unset_int ! doy of leaf on @@ -186,7 +186,7 @@ subroutine zero_site( site_in ) ! FIRE site_in%acc_ni = 0.0_r8 ! daily nesterov index accumulating over time. time unlimited theoretically. site_in%NF = 0.0_r8 ! daily lightning strikes per km2 - site_in%frac_burnt = 0.0_r8 ! burn area read in from external file + site_in%NF_successful = 0.0_r8 ! daily successful iginitions per km2 do el=1,num_elements ! Zero the state variables used for checking mass conservation @@ -296,7 +296,7 @@ subroutine set_site_properties( nsites, sites,bc_in ) sites(s)%acc_NI = acc_NI sites(s)%NF = 0.0_r8 - sites(s)%frac_burnt = 0.0_r8 + sites(s)%NF_successful = 0.0_r8 ! PLACEHOLDER FOR PFT AREA DATA MOVED ACROSS INTERFACE if(hlm_use_fixed_biogeog.eq.itrue)then @@ -356,6 +356,7 @@ subroutine init_patches( nsites, sites, bc_in) type(ed_site_type), pointer :: sitep type(ed_patch_type), pointer :: newp + type(ed_patch_type), pointer :: currentPatch ! List out some nominal patch values that are used for Near Bear Ground initializations ! as well as initializing inventory @@ -436,6 +437,35 @@ subroutine init_patches( nsites, sites, bc_in) end if + ! zero all the patch fire variables for the first timestep + do s = 1, nsites + currentPatch => sites(s)%youngest_patch + do while(associated(currentPatch)) + + currentPatch%litter_moisture(:) = 0._r8 + currentPatch%fuel_eff_moist = 0._r8 + currentPatch%livegrass = 0._r8 + currentPatch%sum_fuel = 0._r8 + currentPatch%fuel_bulkd = 0._r8 + currentPatch%fuel_sav = 0._r8 + currentPatch%fuel_mef = 0._r8 + currentPatch%ros_front = 0._r8 + currentPatch%effect_wspeed = 0._r8 + currentPatch%tau_l = 0._r8 + currentPatch%fuel_frac(:) = 0._r8 + currentPatch%tfc_ros = 0._r8 + currentPatch%fi = 0._r8 + currentPatch%fire = 0 + currentPatch%fd = 0._r8 + currentPatch%ros_back = 0._r8 + currentPatch%scorch_ht(:) = 0._r8 + currentPatch%frac_burnt = 0._r8 + currentPatch%burnt_frac_litter(:) = 0._r8 + + currentPatch => currentPatch%older + enddo + enddo + ! This sets the rhizosphere shells based on the plant initialization ! The initialization of the plant-relevant hydraulics variables ! were set from a call inside of the init_cohorts()->create_cohort() subroutine @@ -590,21 +620,22 @@ subroutine init_cohorts( site_in, patch_in, bc_in) case(nitrogen_element) - m_struct = c_struct*prt_params%nitr_stoich_p2(pft,struct_organ) - m_leaf = c_leaf*prt_params%nitr_stoich_p2(pft,leaf_organ) - m_fnrt = c_fnrt*prt_params%nitr_stoich_p2(pft,fnrt_organ) - m_sapw = c_sapw*prt_params%nitr_stoich_p2(pft,sapw_organ) - m_store = c_store*prt_params%nitr_stoich_p2(pft,store_organ) + m_struct = c_struct*prt_params%nitr_stoich_p2(pft,prt_params%organ_param_id(struct_organ)) + m_leaf = c_leaf*prt_params%nitr_stoich_p2(pft,prt_params%organ_param_id(leaf_organ)) + m_fnrt = c_fnrt*prt_params%nitr_stoich_p2(pft,prt_params%organ_param_id(fnrt_organ)) + m_sapw = c_sapw*prt_params%nitr_stoich_p2(pft,prt_params%organ_param_id(sapw_organ)) m_repro = 0._r8 + m_store = StorageNutrientTarget(pft,element_id,m_leaf,m_fnrt,m_sapw,m_struct) case(phosphorus_element) - m_struct = c_struct*prt_params%phos_stoich_p2(pft,struct_organ) - m_leaf = c_leaf*prt_params%phos_stoich_p2(pft,leaf_organ) - m_fnrt = c_fnrt*prt_params%phos_stoich_p2(pft,fnrt_organ) - m_sapw = c_sapw*prt_params%phos_stoich_p2(pft,sapw_organ) - m_store = c_store*prt_params%phos_stoich_p2(pft,store_organ) + m_struct = c_struct*prt_params%phos_stoich_p2(pft,prt_params%organ_param_id(struct_organ)) + m_leaf = c_leaf*prt_params%phos_stoich_p2(pft,prt_params%organ_param_id(leaf_organ)) + m_fnrt = c_fnrt*prt_params%phos_stoich_p2(pft,prt_params%organ_param_id(fnrt_organ)) + m_sapw = c_sapw*prt_params%phos_stoich_p2(pft,prt_params%organ_param_id(sapw_organ)) m_repro = 0._r8 + m_store = StorageNutrientTarget(pft,element_id,m_leaf,m_fnrt,m_sapw,m_struct) + end select select case(hlm_parteh_mode) diff --git a/main/EDMainMod.F90 b/main/EDMainMod.F90 index 1188802e03..5deb2c5084 100644 --- a/main/EDMainMod.F90 +++ b/main/EDMainMod.F90 @@ -48,6 +48,7 @@ module EDMainMod use FatesSoilBGCFluxMod , only : FluxIntoLitterPools use EDCohortDynamicsMod , only : UpdateCohortBioPhysRates use FatesSoilBGCFluxMod , only : PrepNutrientAquisitionBCs + use FatesSoilBGCFluxMod , only : PrepCH4BCs use SFMainMod , only : fire_model use FatesSizeAgeTypeIndicesMod, only : get_age_class_index use FatesSizeAgeTypeIndicesMod, only : coagetype_class_index @@ -88,12 +89,13 @@ module EDMainMod use PRTGenericMod, only : store_organ use PRTGenericMod, only : repro_organ use PRTGenericMod, only : struct_organ - use PRTLossFluxesMod, only : PRTMaintTurnover use PRTLossFluxesMod, only : PRTReproRelease - use EDPftvarcon, only : EDPftvarcon_inst - + use FatesHistoryInterfaceMod, only : ih_nh4uptake_si, ih_no3uptake_si, ih_puptake_si + use FatesHistoryInterfaceMod, only : ih_nh4uptake_scpf, ih_no3uptake_scpf, ih_puptake_scpf + use FatesHistoryInterfaceMod, only : fates_hist + ! CIME Globals use shr_log_mod , only : errMsg => shr_log_errMsg use shr_infnan_mod , only : nan => shr_infnan_nan, assignment(=) @@ -157,13 +159,6 @@ subroutine ed_ecosystem_dynamics(currentSite, bc_in, bc_out) ! This is limited to a global event until more structured event handling is enabled call IsItLoggingTime(hlm_masterproc,currentSite) - ! ----------------------------------------------------------------------------------- - ! Parse nutrient flux rates - ! The input boundary conditions from the HLM should now have a daily integrated - ! flux. But, that flux still needs to be parsed out to the existing cohorts. - ! ----------------------------------------------------------------------------------- - - !************************************************************************** ! Fire, growth, biogeochemistry. !************************************************************************** @@ -236,13 +231,13 @@ subroutine ed_ecosystem_dynamics(currentSite, bc_in, bc_out) call sort_cohorts(currentPatch) ! kills cohorts that are too few - call terminate_cohorts(currentSite, currentPatch, 1, 10 ) + call terminate_cohorts(currentSite, currentPatch, 1, 10, bc_in ) ! fuses similar cohorts call fuse_cohorts(currentSite,currentPatch, bc_in ) ! kills cohorts for various other reasons - call terminate_cohorts(currentSite, currentPatch, 2, 10 ) + call terminate_cohorts(currentSite, currentPatch, 2, 10, bc_in ) currentPatch => currentPatch%younger @@ -311,6 +306,7 @@ subroutine ed_integrate_state_variables(currentSite, bc_in, bc_out ) integer :: c ! Counter for litter size class integer :: ft ! Counter for PFT + integer :: io_si ! global site index for history writing integer :: iscpf ! index for the size-class x pft multiplexed bins integer :: el ! Counter for element type (c,n,p,etc) real(r8) :: cohort_biomass_store ! remembers the biomass in the cohort for balance checking @@ -438,7 +434,8 @@ subroutine ed_integrate_state_variables(currentSite, bc_in, bc_out ) ! Mass balance for N uptake currentSite%mass_balance(element_pos(nitrogen_element))%net_root_uptake = & currentSite%mass_balance(element_pos(nitrogen_element))%net_root_uptake + & - (currentCohort%daily_n_uptake-currentCohort%daily_n_efflux)*currentCohort%n + (currentCohort%daily_nh4_uptake+currentCohort%daily_no3_uptake- & + currentCohort%daily_n_efflux)*currentCohort%n ! Mass balance for P uptake currentSite%mass_balance(element_pos(phosphorus_element))%net_root_uptake = & @@ -454,13 +451,33 @@ subroutine ed_integrate_state_variables(currentSite, bc_in, bc_out ) iscpf = currentCohort%size_by_pft_class ! Diagnostics for uptake, by size and pft, [kgX/ha/day] - currentSite%flux_diags(element_pos(nitrogen_element))%nutrient_uptake_scpf(iscpf) = & - currentSite%flux_diags(element_pos(nitrogen_element))%nutrient_uptake_scpf(iscpf) + & - currentCohort%daily_n_uptake*currentCohort%n + + io_si = currentSite%h_gid + + fates_hist%hvars(ih_nh4uptake_scpf)%r82d(io_si,iscpf) = & + fates_hist%hvars(ih_nh4uptake_scpf)%r82d(io_si,iscpf) + & + currentCohort%daily_nh4_uptake*currentCohort%n + + fates_hist%hvars(ih_no3uptake_scpf)%r82d(io_si,iscpf) = & + fates_hist%hvars(ih_no3uptake_scpf)%r82d(io_si,iscpf) + & + currentCohort%daily_no3_uptake*currentCohort%n + + fates_hist%hvars(ih_puptake_scpf)%r82d(io_si,iscpf) = & + fates_hist%hvars(ih_puptake_scpf)%r82d(io_si,iscpf) + & + currentCohort%daily_p_uptake*currentCohort%n - currentSite%flux_diags(element_pos(phosphorus_element))%nutrient_uptake_scpf(iscpf) = & - currentSite%flux_diags(element_pos(phosphorus_element))%nutrient_uptake_scpf(iscpf) + & + fates_hist%hvars(ih_nh4uptake_si)%r81d(io_si) = & + fates_hist%hvars(ih_nh4uptake_si)%r81d(io_si) + & + currentCohort%daily_nh4_uptake*currentCohort%n + + fates_hist%hvars(ih_no3uptake_si)%r81d(io_si) = & + fates_hist%hvars(ih_no3uptake_si)%r81d(io_si) + & + currentCohort%daily_no3_uptake*currentCohort%n + + fates_hist%hvars(ih_puptake_si)%r81d(io_si) = & + fates_hist%hvars(ih_puptake_si)%r81d(io_si) + & currentCohort%daily_p_uptake*currentCohort%n + ! Diagnostics on efflux, size and pft [kgX/ha/day] currentSite%flux_diags(element_pos(nitrogen_element))%nutrient_efflux_scpf(iscpf) = & @@ -476,21 +493,13 @@ subroutine ed_integrate_state_variables(currentSite, bc_in, bc_out ) currentCohort%daily_c_efflux*currentCohort%n ! Diagnostics on plant nutrient need - currentSite%flux_diags(element_pos(nitrogen_element))%nutrient_needgrow_scpf(iscpf) = & - currentSite%flux_diags(element_pos(nitrogen_element))%nutrient_needgrow_scpf(iscpf) + & - currentCohort%daily_n_need1*currentCohort%n - - currentSite%flux_diags(element_pos(nitrogen_element))%nutrient_needmax_scpf(iscpf) = & - currentSite%flux_diags(element_pos(nitrogen_element))%nutrient_needmax_scpf(iscpf) + & - currentCohort%daily_n_need2*currentCohort%n - - currentSite%flux_diags(element_pos(phosphorus_element))%nutrient_needgrow_scpf(iscpf) = & - currentSite%flux_diags(element_pos(phosphorus_element))%nutrient_needgrow_scpf(iscpf) + & - currentCohort%daily_p_need1*currentCohort%n + currentSite%flux_diags(element_pos(nitrogen_element))%nutrient_need_scpf(iscpf) = & + currentSite%flux_diags(element_pos(nitrogen_element))%nutrient_need_scpf(iscpf) + & + currentCohort%daily_n_need*currentCohort%n - currentSite%flux_diags(element_pos(phosphorus_element))%nutrient_needmax_scpf(iscpf) = & - currentSite%flux_diags(element_pos(phosphorus_element))%nutrient_needmax_scpf(iscpf) + & - currentCohort%daily_p_need2*currentCohort%n + currentSite%flux_diags(element_pos(phosphorus_element))%nutrient_need_scpf(iscpf) = & + currentSite%flux_diags(element_pos(phosphorus_element))%nutrient_need_scpf(iscpf) + & + currentCohort%daily_p_need*currentCohort%n end if @@ -651,8 +660,8 @@ subroutine ed_update_site( currentSite, bc_in, bc_out ) ! Is termination really needed here? ! Canopy_structure just called it several times! (rgk) - call terminate_cohorts(currentSite, currentPatch, 1, 11) - call terminate_cohorts(currentSite, currentPatch, 2, 11) + call terminate_cohorts(currentSite, currentPatch, 1, 11, bc_in) + call terminate_cohorts(currentSite, currentPatch, 2, 11, bc_in) ! This cohort count is used in the photosynthesis loop call count_cohorts(currentPatch) @@ -661,16 +670,14 @@ subroutine ed_update_site( currentSite, bc_in, bc_out ) currentPatch => currentPatch%younger enddo - ! Aggregate FATES litter output fluxes and - ! package them into boundary conditions - ! Note: The FATES state variables that generate these - ! boundary conditions are read in on the restart, - ! and, they are zero'd only at the start of ecosystem - ! dynamics - - ! Based on current status of the + ! The HLMs need to know about nutrient demand, and/or + ! root mass and affinities call PrepNutrientAquisitionBCs(currentSite,bc_in,bc_out) + ! The HLM methane module needs information about + ! rooting mass, distributions, respiration rates and NPP + call PrepCH4BCs(currentSite,bc_in,bc_out) + ! FIX(RF,032414). This needs to be monthly, not annual ! If this is the second to last day of the year, then perform trimming @@ -828,7 +835,8 @@ subroutine TotalBalanceCheck (currentSite, call_index ) write(fates_log(),*) 'resp m def: ',currentCohort%resp_m_def*currentCohort%n if(element_list(el).eq.nitrogen_element) then - write(fates_log(),*) 'N uptake: ',currentCohort%daily_n_uptake*currentCohort%n + write(fates_log(),*) 'NH4 uptake: ',currentCohort%daily_nh4_uptake*currentCohort%n + write(fates_log(),*) 'NO3 uptake: ',currentCohort%daily_no3_uptake*currentCohort%n write(fates_log(),*) 'N efflux: ',currentCohort%daily_n_efflux*currentCohort%n elseif(element_list(el).eq.phosphorus_element) then write(fates_log(),*) 'P uptake: ',currentCohort%daily_p_uptake*currentCohort%n diff --git a/main/EDParamsMod.F90 b/main/EDParamsMod.F90 index 8162939bc3..1f10aa2c7f 100644 --- a/main/EDParamsMod.F90 +++ b/main/EDParamsMod.F90 @@ -20,6 +20,22 @@ module EDParamsMod ! ! this is what the user can use for the actual values ! + + real(r8),protected, public :: vai_top_bin_width ! width in VAI units of uppermost leaf+stem + ! layer scattering element in each canopy layer [m2/m2] + ! (NOT YET IMPLEMENTED) + real(r8),protected, public :: vai_width_increase_factor ! factor by which each leaf+stem scattering element + ! increases in VAI width (1 = uniform spacing) + ! (NOT YET IMPLEMENTED) + real(r8),protected, public :: photo_temp_acclim_timescale ! Length of the window for the exponential moving average (ema) + ! of vegetation temperature used in photosynthesis + ! temperature acclimation (NOT YET IMPLEMENTED) + + integer,protected, public :: maintresp_model ! switch for choosing between leaf maintenance + ! respiration model. 1=Ryan (1991) (NOT YET IMPLEMENTED) + integer,protected, public :: photo_tempsens_model ! switch for choosing the model that defines the temperature + ! sensitivity of photosynthetic parameters (vcmax, jmax). + ! 1=non-acclimating (NOT YET IMPLEMENTED) real(r8),protected, public :: fates_mortality_disturbance_fraction ! the fraction of canopy mortality that results in disturbance real(r8),protected, public :: ED_val_comp_excln @@ -50,16 +66,37 @@ module EDParamsMod real(r8), protected, public :: cg_strikes ! fraction of cloud to ground lightning strikes (0-1) character(len=param_string_length),parameter :: fates_name_cg_strikes="fates_fire_cg_strikes" + + ! empirical curvature parameters for ac, aj photosynthesis co-limitation, c3 and c4 plants respectively + real(r8),protected,public :: theta_cj_c3 + real(r8),protected,public :: theta_cj_c4 real(r8),protected,public :: q10_mr ! Q10 for respiration rate (for soil fragmenation and plant respiration) (unitless) real(r8),protected,public :: q10_froz ! Q10 for frozen-soil respiration rates (for soil fragmentation) (unitless) - ! two special parameters whose size is defined in the parameter file + ! Unassociated pft dimensioned free parameter that developers can use for testing arbitrary new hypotheses + ! (THIS PARAMETER IS UNUSED, FEEL FREE TO USE IT FOR WHATEVER PURPOSE YOU LIKE. WE CAN + ! HELP MIGRATE YOUR USAGE OF THE PARMETER TO A PERMANENT HOME LATER) + real(r8),protected,public :: dev_arbitrary + character(len=param_string_length),parameter,public :: name_dev_arbitrary = "fates_dev_arbitrary" + + ! parameters whose size is defined in the parameter file real(r8),protected,allocatable,public :: ED_val_history_sizeclass_bin_edges(:) real(r8),protected,allocatable,public :: ED_val_history_ageclass_bin_edges(:) real(r8),protected,allocatable,public :: ED_val_history_height_bin_edges(:) real(r8),protected,allocatable,public :: ED_val_history_coageclass_bin_edges(:) + + ! Switch that defines the current pressure-volume and pressure-conductivity model + ! to be used at each node (compartment/organ) + ! 1 = Christofferson et al. 2016 (TFS), 2 = Van Genuchten 1980 + integer, protected,allocatable,public :: hydr_htftype_node(:) + character(len=param_string_length),parameter,public :: ED_name_vai_top_bin_width = "fates_vai_top_bin_width" + character(len=param_string_length),parameter,public :: ED_name_vai_width_increase_factor = "fates_vai_width_increase_factor" + character(len=param_string_length),parameter,public :: ED_name_photo_temp_acclim_timescale = "fates_photo_temp_acclim_timescale" + character(len=param_string_length),parameter,public :: name_photo_tempsens_model = "fates_photo_tempsens_model" + character(len=param_string_length),parameter,public :: name_maintresp_model = "fates_maintresp_model" + character(len=param_string_length),parameter,public :: ED_name_hydr_htftype_node = "fates_hydr_htftype_node" character(len=param_string_length),parameter,public :: ED_name_mort_disturb_frac = "fates_mort_disturb_frac" character(len=param_string_length),parameter,public :: ED_name_comp_excln = "fates_comp_excln" character(len=param_string_length),parameter,public :: ED_name_init_litter = "fates_init_litter" @@ -83,13 +120,12 @@ module EDParamsMod character(len=param_string_length),parameter,public :: ED_name_canopy_closure_thresh= "fates_canopy_closure_thresh" character(len=param_string_length),parameter,public :: ED_name_stomatal_model= "fates_leaf_stomatal_model" - ! Resistance to active crown fire - - + character(len=param_string_length),parameter,public :: name_theta_cj_c3 = "fates_theta_cj_c3" + character(len=param_string_length),parameter,public :: name_theta_cj_c4 = "fates_theta_cj_c4" + character(len=param_string_length),parameter :: fates_name_q10_mr="fates_q10_mr" character(len=param_string_length),parameter :: fates_name_q10_froz="fates_q10_froz" - ! non-scalar parameter names character(len=param_string_length),parameter,public :: ED_name_history_sizeclass_bin_edges= "fates_history_sizeclass_bin_edges" character(len=param_string_length),parameter,public :: ED_name_history_ageclass_bin_edges= "fates_history_ageclass_bin_edges" @@ -173,6 +209,11 @@ subroutine FatesParamsInit() implicit none + vai_top_bin_width = nan + vai_width_increase_factor = nan + photo_temp_acclim_timescale = nan + photo_tempsens_model = -9 + maintresp_model = -9 fates_mortality_disturbance_fraction = nan ED_val_comp_excln = nan ED_val_init_litter = nan @@ -211,7 +252,9 @@ subroutine FatesParamsInit() eca_plant_escalar = nan q10_mr = nan q10_froz = nan - + theta_cj_c3 = nan + theta_cj_c4 = nan + dev_arbitrary = nan end subroutine FatesParamsInit !----------------------------------------------------------------------- @@ -222,7 +265,7 @@ subroutine FatesRegisterParams(fates_params) use FatesParametersInterface, only : fates_parameters_type, dimension_name_scalar, dimension_shape_1d use FatesParametersInterface, only : dimension_name_history_size_bins, dimension_name_history_age_bins - use FatesParametersInterface, only : dimension_name_history_height_bins + use FatesParametersInterface, only : dimension_name_history_height_bins, dimension_name_hydr_organs use FatesParametersInterface, only : dimension_name_history_coage_bins use FatesParametersInterface, only : dimension_shape_scalar @@ -236,10 +279,31 @@ subroutine FatesRegisterParams(fates_params) character(len=param_string_length), parameter :: dim_names_ageclass(1) = (/dimension_name_history_age_bins/) character(len=param_string_length), parameter :: dim_names_height(1) = (/dimension_name_history_height_bins/) character(len=param_string_length), parameter :: dim_names_coageclass(1) = (/dimension_name_history_coage_bins/) - + character(len=param_string_length), parameter :: dim_names_hydro_organs(1) = (/dimension_name_hydr_organs/) call FatesParamsInit() + call fates_params%RegisterParameter(name=ED_name_vai_top_bin_width, dimension_shape=dimension_shape_scalar, & + dimension_names=dim_names_scalar) + + call fates_params%RegisterParameter(name=ED_name_vai_width_increase_factor, dimension_shape=dimension_shape_scalar, & + dimension_names=dim_names_scalar) + + call fates_params%RegisterParameter(name=ED_name_photo_temp_acclim_timescale, dimension_shape=dimension_shape_scalar, & + dimension_names=dim_names_scalar) + + call fates_params%RegisterParameter(name=name_photo_tempsens_model,dimension_shape=dimension_shape_scalar, & + dimension_names=dim_names_scalar) + + call fates_params%RegisterParameter(name=name_maintresp_model,dimension_shape=dimension_shape_scalar, & + dimension_names=dim_names_scalar) + + call fates_params%RegisterParameter(name=name_theta_cj_c3, dimension_shape=dimension_shape_scalar, & + dimension_names=dim_names_scalar) + + call fates_params%RegisterParameter(name=name_theta_cj_c4, dimension_shape=dimension_shape_scalar, & + dimension_names=dim_names_scalar) + call fates_params%RegisterParameter(name=ED_name_mort_disturb_frac, dimension_shape=dimension_shape_scalar, & dimension_names=dim_names_scalar) @@ -357,7 +421,14 @@ subroutine FatesRegisterParams(fates_params) call fates_params%RegisterParameter(name=fates_name_q10_froz, dimension_shape=dimension_shape_scalar, & dimension_names=dim_names_scalar) + call fates_params%RegisterParameter(name=name_dev_arbitrary, dimension_shape=dimension_shape_scalar, & + dimension_names=dim_names_scalar) + ! non-scalar parameters + + call fates_params%RegisterParameter(name=ED_name_hydr_htftype_node, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names_hydro_organs) + call fates_params%RegisterParameter(name=ED_name_history_sizeclass_bin_edges, dimension_shape=dimension_shape_1d, & dimension_names=dim_names_sizeclass) @@ -390,6 +461,24 @@ subroutine FatesReceiveParams(fates_params) class(fates_parameters_type), intent(inout) :: fates_params real(r8) :: tmpreal ! local real variable for changing type on read + real(r8), allocatable :: hydr_htftype_real(:) + + call fates_params%RetreiveParameter(name=ED_name_vai_top_bin_width, & + data=vai_top_bin_width) + + call fates_params%RetreiveParameter(name=ED_name_vai_width_increase_factor, & + data=vai_width_increase_factor) + + call fates_params%RetreiveParameter(name=ED_name_photo_temp_acclim_timescale, & + data=photo_temp_acclim_timescale) + + call fates_params%RetreiveParameter(name=name_photo_tempsens_model, & + data=tmpreal) + photo_tempsens_model = nint(tmpreal) + + call fates_params%RetreiveParameter(name=name_maintresp_model, & + data=tmpreal) + maintresp_model = nint(tmpreal) call fates_params%RetreiveParameter(name=ED_name_mort_disturb_frac, & data=fates_mortality_disturbance_fraction) @@ -503,11 +592,20 @@ subroutine FatesReceiveParams(fates_params) call fates_params%RetreiveParameter(name=eca_name_plant_escalar, & data=eca_plant_escalar) + call fates_params%RetreiveParameter(name=name_theta_cj_c3, & + data=theta_cj_c3) + + call fates_params%RetreiveParameter(name=name_theta_cj_c4, & + data=theta_cj_c4) + call fates_params%RetreiveParameter(name=fates_name_q10_mr, & data=q10_mr) call fates_params%RetreiveParameter(name=fates_name_q10_froz, & - data=q10_froz) + data=q10_froz) + + call fates_params%RetreiveParameter(name=name_dev_arbitrary, & + data=dev_arbitrary) call fates_params%RetreiveParameter(name=fates_name_active_crown_fire, & data=tmpreal) @@ -529,6 +627,11 @@ subroutine FatesReceiveParams(fates_params) call fates_params%RetreiveParameterAllocate(name=ED_name_history_coageclass_bin_edges, & data=ED_val_history_coageclass_bin_edges) + call fates_params%RetreiveParameterAllocate(name=ED_name_hydr_htftype_node, & + data=hydr_htftype_real) + allocate(hydr_htftype_node(size(hydr_htftype_real))) + hydr_htftype_node(:) = nint(hydr_htftype_real(:)) + deallocate(hydr_htftype_real) end subroutine FatesReceiveParams @@ -539,11 +642,16 @@ subroutine FatesReportParams(is_master) logical,intent(in) :: is_master character(len=32),parameter :: fmt0 = '(a,(F12.4))' + character(len=32),parameter :: fmti = '(a,(I4))' logical, parameter :: debug_report = .false. if(debug_report .and. is_master) then write(fates_log(),*) '----------- FATES Scalar Parameters -----------------' + write(fates_log(),fmt0) 'vai_top_bin_width = ',vai_top_bin_width + write(fates_log(),fmt0) 'vai_width_increase_factor = ',vai_width_increase_factor + write(fates_log(),fmt0) 'photo_temp_acclim_timescale = ',photo_temp_acclim_timescale + write(fates_log(),fmti) 'hydr_htftype_node = ',hydr_htftype_node write(fates_log(),fmt0) 'fates_mortality_disturbance_fraction = ',fates_mortality_disturbance_fraction write(fates_log(),fmt0) 'ED_val_comp_excln = ',ED_val_comp_excln write(fates_log(),fmt0) 'ED_val_init_litter = ',ED_val_init_litter diff --git a/main/EDPftvarcon.F90 b/main/EDPftvarcon.F90 index 058ebc9173..3975c9667c 100644 --- a/main/EDPftvarcon.F90 +++ b/main/EDPftvarcon.F90 @@ -15,7 +15,6 @@ module EDPftvarcon use FatesGlobals, only : fates_log use FatesGlobals, only : endrun => fates_endrun use FatesLitterMod, only : ilabile,icellulose,ilignin - use PRTGenericMod, only : num_organ_types use PRTGenericMod, only : leaf_organ, fnrt_organ, store_organ use PRTGenericMod, only : sapw_organ, struct_organ, repro_organ use PRTGenericMod, only : prt_cnp_flex_allom_hyp,prt_carbon_allom_hyp @@ -42,7 +41,7 @@ module EDPftvarcon !ED specific variables. type, public :: EDPftvarcon_type - + real(r8), allocatable :: freezetol(:) ! minimum temperature tolerance real(r8), allocatable :: hgt_min(:) ! sapling height m real(r8), allocatable :: dleaf(:) ! leaf characteristic dimension length (m) @@ -95,13 +94,10 @@ module EDPftvarcon real(r8), allocatable :: hf_flc_threshold(:) real(r8), allocatable :: vcmaxha(:) real(r8), allocatable :: jmaxha(:) - real(r8), allocatable :: tpuha(:) real(r8), allocatable :: vcmaxhd(:) real(r8), allocatable :: jmaxhd(:) - real(r8), allocatable :: tpuhd(:) real(r8), allocatable :: vcmaxse(:) real(r8), allocatable :: jmaxse(:) - real(r8), allocatable :: tpuse(:) real(r8), allocatable :: germination_rate(:) ! Fraction of seed mass germinating per year (yr-1) real(r8), allocatable :: seed_decay_rate(:) ! Fraction of seed mass (both germinated and ! ungerminated), decaying per year (yr-1) @@ -183,6 +179,11 @@ module EDPftvarcon real(r8), allocatable :: prescribed_puptake(:) ! If there is no soil BGC model active, ! prescribe an uptake rate for phosphorus ! This is the fraction of plant demand + + + ! Unassociated pft dimensioned free parameter that + ! developers can use for testing arbitrary new hypothese + real(r8), allocatable :: dev_arbitrary_pft(:) ! Parameters dimensioned by PFT and leaf age real(r8), allocatable :: vcmax25top(:,:) ! maximum carboxylation rate of Rub. at 25C, @@ -192,33 +193,41 @@ module EDPftvarcon ! --------------------------------------------------------------------------------------------- ! PFT Dimension - real(r8), allocatable :: hydr_p_taper(:) ! xylem taper exponent - real(r8), allocatable :: hydr_rs2(:) ! absorbing root radius (m) - real(r8), allocatable :: hydr_srl(:) ! specific root length (m g-1) - real(r8), allocatable :: hydr_rfrac_stem(:) ! fraction of total tree resistance from troot to canopy - real(r8), allocatable :: hydr_avuln_gs(:) ! shape parameter for stomatal control of water vapor exiting leaf - real(r8), allocatable :: hydr_p50_gs(:) ! water potential at 50% loss of stomatal conductance - - ! PFT specific parameters for hydro dynamic roots - real(r8), allocatable :: allom_dbh_max(:) - real(r8), allocatable :: allom_dbh_0(:) - real(r8), allocatable :: allom_zfr_max(:) - real(r8), allocatable :: allom_zfr_0(:) - real(r8), allocatable :: allom_frk(:) - - + real(r8), allocatable :: hydr_p_taper(:) ! xylem taper exponent + real(r8), allocatable :: hydr_rs2(:) ! absorbing root radius (m) + real(r8), allocatable :: hydr_srl(:) ! specific root length (m g-1) + real(r8), allocatable :: hydr_rfrac_stem(:) ! fraction of total tree resistance from troot to canopy + real(r8), allocatable :: hydr_avuln_gs(:) ! shape parameter for stomatal control of water vapor exiting leaf + real(r8), allocatable :: hydr_p50_gs(:) ! water potential at 50% loss of stomatal conductance + real(r8), allocatable :: hydr_k_lwp(:) ! inner leaf humidity scaling coefficient - ! PFT x Organ Dimension (organs are: 1=leaf, 2=stem, 3=transporting root, 4=absorbing root) + ! ---------------------------------------------------------------------------------- + + ! Van Genuchten PV PK curves (NOT IMPLEMENTED) + real(r8), allocatable :: hydr_vg_alpha_node(:,:) ! capilary length parameter in van Genuchten model + real(r8), allocatable :: hydr_vg_m_node(:,:) ! pore size distribution, m in van Genuchten 1980 model, range (0,1) + real(r8), allocatable :: hydr_vg_n_node(:,:) ! pore size distribution, n in van Genuchten 1980 model, range >2 + + ! TFS PV-PK curves real(r8), allocatable :: hydr_avuln_node(:,:) ! xylem vulernability curve shape parameter real(r8), allocatable :: hydr_p50_node(:,:) ! xylem water potential at 50% conductivity loss (MPa) - real(r8), allocatable :: hydr_thetas_node(:,:) ! saturated water content (cm3/cm3) real(r8), allocatable :: hydr_epsil_node(:,:) ! bulk elastic modulus (MPa) real(r8), allocatable :: hydr_pitlp_node(:,:) ! turgor loss point (MPa) - real(r8), allocatable :: hydr_resid_node(:,:) ! residual fraction (fraction) real(r8), allocatable :: hydr_fcap_node(:,:) ! fraction of (1-resid_node) that is capillary in source real(r8), allocatable :: hydr_pinot_node(:,:) ! osmotic potential at full turgor real(r8), allocatable :: hydr_kmax_node(:,:) ! maximum xylem conductivity per unit conducting xylem area + + ! Parameters for both VG and TFS PV-PK curves + real(r8), allocatable :: hydr_resid_node(:,:) ! residual fraction (fraction) + real(r8), allocatable :: hydr_thetas_node(:,:) ! saturated water content (cm3/cm3) + + + ! Table that maps HLM pfts to FATES pfts for fixed biogeography mode + ! The values are area fractions (NOT IMPLEMENTED) + real(r8), allocatable :: hlm_pft_map(:,:) + + contains procedure, public :: Init => EDpftconInit @@ -297,16 +306,19 @@ subroutine Register_PFT(this, fates_params) use FatesParametersInterface, only : fates_parameters_type, param_string_length use FatesParametersInterface, only : dimension_name_pft, dimension_shape_1d - + use FatesParametersInterface, only : dimension_name_hlm_pftno, dimension_shape_2d + implicit none class(EDPftvarcon_type), intent(inout) :: this class(fates_parameters_type), intent(inout) :: fates_params character(len=param_string_length), parameter :: dim_names(1) = (/dimension_name_pft/) - + character(len=param_string_length) :: pftmap_dim_names(2) + integer, parameter :: dim_lower_bound(1) = (/ lower_bound_pft /) - + + character(len=param_string_length) :: name !X! name = '' @@ -434,33 +446,6 @@ subroutine Register_PFT(this, fates_params) call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & dimension_names=dim_names, lower_bounds=dim_lower_bound) -! Register following parameters, May 29, 2020 -! real(r8), allocatable :: allom_dbh_max(:) -! real(r8), allocatable :: allom_dbh_0(:) -! real(r8), allocatable :: allom_zfr_max(:) -! real(r8), allocatable :: allom_zfr_0(:) -! real(r8), allocatable :: allom_frk(:) - - name = 'fates_allom_dbh_max' - call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & - dimension_names=dim_names, lower_bounds=dim_lower_bound) - - name = 'fates_allom_dbh_0' - call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & - dimension_names=dim_names, lower_bounds=dim_lower_bound) - - name = 'fates_allom_zfr_max' - call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & - dimension_names=dim_names, lower_bounds=dim_lower_bound) - - name = 'fates_allom_zfr_0' - call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & - dimension_names=dim_names, lower_bounds=dim_lower_bound) - - name = 'fates_allom_frk' - call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & - dimension_names=dim_names, lower_bounds=dim_lower_bound) - name = 'fates_hydr_p_taper' call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & dimension_names=dim_names, lower_bounds=dim_lower_bound) @@ -484,6 +469,10 @@ subroutine Register_PFT(this, fates_params) name = 'fates_hydr_p50_gs' call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & dimension_names=dim_names, lower_bounds=dim_lower_bound) + + name = 'fates_hydr_k_lwp' + call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names, lower_bounds=dim_lower_bound) name = 'fates_mort_bmort' call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & @@ -533,10 +522,6 @@ subroutine Register_PFT(this, fates_params) call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & dimension_names=dim_names, lower_bounds=dim_lower_bound) - name = 'fates_leaf_tpuha' - call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & - dimension_names=dim_names, lower_bounds=dim_lower_bound) - name = 'fates_leaf_vcmaxhd' call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & dimension_names=dim_names, lower_bounds=dim_lower_bound) @@ -545,10 +530,6 @@ subroutine Register_PFT(this, fates_params) call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & dimension_names=dim_names, lower_bounds=dim_lower_bound) - name = 'fates_leaf_tpuhd' - call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & - dimension_names=dim_names, lower_bounds=dim_lower_bound) - name = 'fates_leaf_vcmaxse' call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & dimension_names=dim_names, lower_bounds=dim_lower_bound) @@ -557,10 +538,6 @@ subroutine Register_PFT(this, fates_params) call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & dimension_names=dim_names, lower_bounds=dim_lower_bound) - name = 'fates_leaf_tpuse' - call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & - dimension_names=dim_names, lower_bounds=dim_lower_bound) - name = 'fates_seed_germination_rate' call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & dimension_names=dim_names, lower_bounds=dim_lower_bound) @@ -655,7 +632,19 @@ subroutine Register_PFT(this, fates_params) name = 'fates_prescribed_puptake' call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & dimension_names=dim_names, lower_bounds=dim_lower_bound) - + + name = 'fates_dev_arbitrary_pft' + call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names, lower_bounds=dim_lower_bound) + + ! adding the hlm_pft_map variable with two dimensions - FATES PFTno and HLM PFTno + pftmap_dim_names(1) = dimension_name_pft + pftmap_dim_names(2) = dimension_name_hlm_pftno + + name = 'fates_hlm_pft_map' + call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_2d, & + dimension_names=pftmap_dim_names, lower_bounds=dim_lower_bound) + end subroutine Register_PFT !----------------------------------------------------------------------- @@ -794,26 +783,6 @@ subroutine Receive_PFT(this, fates_params) call fates_params%RetreiveParameterAllocate(name=name, & data=this%allom_frbstor_repro) - name = 'fates_allom_dbh_max' - call fates_params%RetreiveParameterAllocate(name=name, & - data=this%allom_dbh_max) - - name = 'fates_allom_dbh_0' - call fates_params%RetreiveParameterAllocate(name=name, & - data=this%allom_dbh_0) - - name = 'fates_allom_zfr_max' - call fates_params%RetreiveParameterAllocate(name=name, & - data=this%allom_zfr_max) - - name = 'fates_allom_zfr_0' - call fates_params%RetreiveParameterAllocate(name=name, & - data=this%allom_zfr_0) - - name = 'fates_allom_frk' - call fates_params%RetreiveParameterAllocate(name=name, & - data=this%allom_frk) - name = 'fates_hydr_p_taper' call fates_params%RetreiveParameterAllocate(name=name, & data=this%hydr_p_taper) @@ -838,6 +807,10 @@ subroutine Receive_PFT(this, fates_params) call fates_params%RetreiveParameterAllocate(name=name, & data=this%hydr_p50_gs) + name = 'fates_hydr_k_lwp' + call fates_params%RetreiveParameterAllocate(name=name, & + data=this%hydr_k_lwp) + name = 'fates_mort_bmort' call fates_params%RetreiveParameterAllocate(name=name, & data=this%bmort) @@ -896,10 +869,6 @@ subroutine Receive_PFT(this, fates_params) call fates_params%RetreiveParameterAllocate(name=name, & data=this%jmaxha) - name = 'fates_leaf_tpuha' - call fates_params%RetreiveParameterAllocate(name=name, & - data=this%tpuha) - name = 'fates_leaf_vcmaxhd' call fates_params%RetreiveParameterAllocate(name=name, & data=this%vcmaxhd) @@ -908,10 +877,6 @@ subroutine Receive_PFT(this, fates_params) call fates_params%RetreiveParameterAllocate(name=name, & data=this%jmaxhd) - name = 'fates_leaf_tpuhd' - call fates_params%RetreiveParameterAllocate(name=name, & - data=this%tpuhd) - name = 'fates_leaf_vcmaxse' call fates_params%RetreiveParameterAllocate(name=name, & data=this%vcmaxse) @@ -920,10 +885,6 @@ subroutine Receive_PFT(this, fates_params) call fates_params%RetreiveParameterAllocate(name=name, & data=this%jmaxse) - name = 'fates_leaf_tpuse' - call fates_params%RetreiveParameterAllocate(name=name, & - data=this%tpuse) - name = 'fates_seed_germination_rate' call fates_params%RetreiveParameterAllocate(name=name, & data=this%germination_rate) @@ -971,6 +932,10 @@ subroutine Receive_PFT(this, fates_params) name = 'fates_prescribed_puptake' call fates_params%RetreiveParameterAllocate(name=name, & data=this%prescribed_puptake) + + name = 'fates_dev_arbitrary_pft' + call fates_params%RetreiveParameterAllocate(name=name, & + data=this%dev_arbitrary_pft) name = 'fates_eca_decompmicc' call fates_params%RetreiveParameterAllocate(name=name, & @@ -1016,6 +981,10 @@ subroutine Receive_PFT(this, fates_params) call fates_params%RetreiveParameterAllocate(name=name, & data=this%eca_lambda_ptase) + name = 'fates_hlm_pft_map' + call fates_params%RetreiveParameterAllocate(name=name, & + data=this%hlm_pft_map) + end subroutine Receive_PFT !----------------------------------------------------------------------- @@ -1256,6 +1225,18 @@ subroutine Register_PFT_hydr_organs(this, fates_params) dim_names(1) = dimension_name_pft dim_names(2) = dimension_name_hydr_organs + name = 'fates_hydr_vg_alpha_node' + call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_2d, & + dimension_names=dim_names, lower_bounds=dim_lower_bound) + + name = 'fates_hydr_vg_m_node' + call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_2d, & + dimension_names=dim_names, lower_bounds=dim_lower_bound) + + name = 'fates_hydr_vg_n_node' + call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_2d, & + dimension_names=dim_names, lower_bounds=dim_lower_bound) + name = 'fates_hydr_avuln_node' call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_2d, & dimension_names=dim_names, lower_bounds=dim_lower_bound) @@ -1291,8 +1272,19 @@ subroutine Register_PFT_hydr_organs(this, fates_params) name = 'fates_hydr_kmax_node' call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_2d, & dimension_names=dim_names, lower_bounds=dim_lower_bound) - + name = 'fates_hydr_vg_alpha_node' + call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_2d, & + dimension_names=dim_names, lower_bounds=dim_lower_bound) + + name = 'fates_hydr_vg_m_node' + call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_2d, & + dimension_names=dim_names, lower_bounds=dim_lower_bound) + + name = 'fates_hydr_vg_n_node' + call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_2d, & + dimension_names=dim_names, lower_bounds=dim_lower_bound) + end subroutine Register_PFT_hydr_organs !----------------------------------------------------------------------- @@ -1308,6 +1300,19 @@ subroutine Receive_PFT_hydr_organs(this, fates_params) class(fates_parameters_type), intent(inout) :: fates_params character(len=param_string_length) :: name + + + name = 'fates_hydr_vg_alpha_node' + call fates_params%RetreiveParameterAllocate(name=name, & + data=this%hydr_vg_alpha_node) + + name = 'fates_hydr_vg_m_node' + call fates_params%RetreiveParameterAllocate(name=name, & + data=this%hydr_vg_m_node) + + name = 'fates_hydr_vg_n_node' + call fates_params%RetreiveParameterAllocate(name=name, & + data=this%hydr_vg_n_node) name = 'fates_hydr_avuln_node' call fates_params%RetreiveParameterAllocate(name=name, & @@ -1345,6 +1350,18 @@ subroutine Receive_PFT_hydr_organs(this, fates_params) call fates_params%RetreiveParameterAllocate(name=name, & data=this%hydr_kmax_node) + name = 'fates_hydr_vg_alpha_node' + call fates_params%RetreiveParameterAllocate(name=name, & + data=this%hydr_vg_alpha_node) + + name = 'fates_hydr_vg_m_node' + call fates_params%RetreiveParameterAllocate(name=name, & + data=this%hydr_vg_m_node) + + name = 'fates_hydr_vg_n_node' + call fates_params%RetreiveParameterAllocate(name=name, & + data=this%hydr_vg_n_node) + end subroutine Receive_PFT_hydr_organs ! =============================================================================================== @@ -1408,13 +1425,10 @@ subroutine FatesReportPFTParams(is_master) write(fates_log(),fmt0) 'hf_flc_threshold = ',EDPftvarcon_inst%hf_flc_threshold write(fates_log(),fmt0) 'vcmaxha = ',EDPftvarcon_inst%vcmaxha write(fates_log(),fmt0) 'jmaxha = ',EDPftvarcon_inst%jmaxha - write(fates_log(),fmt0) 'tpuha = ',EDPftvarcon_inst%tpuha write(fates_log(),fmt0) 'vcmaxhd = ',EDPftvarcon_inst%vcmaxhd write(fates_log(),fmt0) 'jmaxhd = ',EDPftvarcon_inst%jmaxhd - write(fates_log(),fmt0) 'tpuhd = ',EDPftvarcon_inst%tpuhd write(fates_log(),fmt0) 'vcmaxse = ',EDPftvarcon_inst%vcmaxse write(fates_log(),fmt0) 'jmaxse = ',EDPftvarcon_inst%jmaxse - write(fates_log(),fmt0) 'tpuse = ',EDPftvarcon_inst%tpuse write(fates_log(),fmt0) 'germination_timescale = ',EDPftvarcon_inst%germination_rate write(fates_log(),fmt0) 'seed_decay_turnover = ',EDPftvarcon_inst%seed_decay_rate write(fates_log(),fmt0) 'trim_limit = ',EDPftvarcon_inst%trim_limit @@ -1434,6 +1448,7 @@ subroutine FatesReportPFTParams(is_master) write(fates_log(),fmt0) 'hydr_rfrac_stem = ',EDPftvarcon_inst%hydr_rfrac_stem write(fates_log(),fmt0) 'hydr_avuln_gs = ',EDPftvarcon_inst%hydr_avuln_gs write(fates_log(),fmt0) 'hydr_p50_gs = ',EDPftvarcon_inst%hydr_p50_gs + write(fates_log(),fmt0) 'hydr_k_lwp = ',EDPftvarcon_inst%hydr_k_lwp write(fates_log(),fmt0) 'hydr_avuln_node = ',EDPftvarcon_inst%hydr_avuln_node write(fates_log(),fmt0) 'hydr_p50_node = ',EDPftvarcon_inst%hydr_p50_node write(fates_log(),fmt0) 'hydr_thetas_node = ',EDPftvarcon_inst%hydr_thetas_node @@ -1443,6 +1458,9 @@ subroutine FatesReportPFTParams(is_master) write(fates_log(),fmt0) 'hydr_fcap_node = ',EDPftvarcon_inst%hydr_fcap_node write(fates_log(),fmt0) 'hydr_pinot_node = ',EDPftvarcon_inst%hydr_pinot_node write(fates_log(),fmt0) 'hydr_kmax_node = ',EDPftvarcon_inst%hydr_kmax_node + write(fates_log(),fmt0) 'hydr_vg_alpha_node = ',EDPftvarcon_inst%hydr_vg_alpha_node + write(fates_log(),fmt0) 'hydr_vg_m_node = ',EDPftvarcon_inst%hydr_vg_m_node + write(fates_log(),fmt0) 'hydr_vg_n_node = ',EDPftvarcon_inst%hydr_vg_n_node write(fates_log(),*) '-------------------------------------------------' end if diff --git a/main/EDTypesMod.F90 b/main/EDTypesMod.F90 index 7288a4ef99..5da7babc54 100644 --- a/main/EDTypesMod.F90 +++ b/main/EDTypesMod.F90 @@ -18,6 +18,8 @@ module EDTypesMod use FatesLitterMod, only : ncwd use FatesConstantsMod, only : n_anthro_disturbance_categories use FatesConstantsMod, only : days_per_year + use FatesInterfaceTypesMod,only : bc_in_type + use FatesInterfaceTypesMod,only : bc_out_type implicit none private ! By default everything is private @@ -41,7 +43,8 @@ module EDTypesMod ! space and output arrays. - + real(r8), parameter, public :: init_recruit_trim = 0.8_r8 ! This is the initial trimming value that + ! new recruits start with ! ------------------------------------------------------------------------------------- ! Radiation parameters @@ -282,21 +285,19 @@ module EDTypesMod ! Nutrient Fluxes (if N, P, etc. are turned on) - real(r8) :: daily_n_uptake ! integrated daily uptake of mineralized N through competitive acquisition in soil [kg N / plant/ day] + real(r8) :: daily_nh4_uptake ! integrated daily uptake of mineralized ammonium through competitive acquisition in soil [kg N / plant/ day] + real(r8) :: daily_no3_uptake ! integrated daily uptake of mineralized nitrate through competitive acquisition in soil [kg N / plant/ day] real(r8) :: daily_p_uptake ! integrated daily uptake of mineralized P through competitive acquisition in soil [kg P / plant/ day] real(r8) :: daily_c_efflux ! daily mean efflux of excess carbon from roots into labile pool [kg C/plant/day] real(r8) :: daily_n_efflux ! daily mean efflux of excess nitrogen from roots into labile pool [kg N/plant/day] real(r8) :: daily_p_efflux ! daily mean efflux of excess phophorus from roots into labile pool [kg P/plant/day] - real(r8) :: daily_n_need1 ! Nitrogen needed to enable non-limited C growth (AllometricCNP hypothesis) - real(r8) :: daily_n_need2 ! Nitrogen needed to bring N concentrations up to optimal - real(r8) :: daily_p_need1 ! Phosphorus needed to enable non-limited C growth (AllometricCNP hypothesis) - real(r8) :: daily_p_need2 ! Phosphorus needed to bring P concentrations up to optimal + real(r8) :: daily_n_need ! Generic Nitrogen need of the plant, (hypothesis dependent) [kgN/plant/day] + real(r8) :: daily_p_need ! Generic Phosphorus need of the plant, (hypothesis dependent) [kgN/plant/day] + ! These two variables may use the previous "need" variables, by applying a smoothing function. - ! Or, its possible that the plant will use another method to calculate this, perhaps based - ! on storage. ! These variables are used in two scenarios. 1) They work with the prescribed uptake fraction ! in un-coupled mode, and 2) They are the plant's demand subbmitted to the Relative-Demand ! type soil BGC scheme. @@ -534,9 +535,9 @@ module EDTypesMod real(r8) :: sum_fuel ! total ground fuel related to ros (omits 1000hr fuels): KgC/m2 real(r8) :: fuel_frac(nfsc) ! fraction of each litter class in the ros_fuel:-. real(r8) :: livegrass ! total aboveground grass biomass in patch. KgC/m2 - real(r8) :: fuel_bulkd ! average fuel bulk density of the ground fuel + real(r8) :: fuel_bulkd ! average fuel bulk density of the ground fuel. kgBiomass/m3 ! (incl. live grasses. omits 1000hr fuels). KgC/m3 - real(r8) :: fuel_sav ! average surface area to volume ratio of the ground fuel + real(r8) :: fuel_sav ! average surface area to volume ratio of the ground fuel. cm-1 ! (incl. live grasses. omits 1000hr fuels). real(r8) :: fuel_mef ! average moisture of extinction factor ! of the ground fuel (incl. live grasses. omits 1000hr fuels). @@ -555,9 +556,9 @@ module EDTypesMod ! FIRE EFFECTS real(r8) :: scorch_ht(maxpft) ! scorch height: m - real(r8) :: frac_burnt ! fraction burnt: frac gridcell/day - real(r8) :: tfc_ros ! total fuel consumed - no trunks. KgC/m2/day - real(r8) :: burnt_frac_litter(nfsc) ! fraction of each litter pool burned:- + real(r8) :: frac_burnt ! fraction burnt: frac patch/day + real(r8) :: tfc_ros ! total intensity-relevant fuel consumed - no trunks. KgC/m2 of burned ground/day + real(r8) :: burnt_frac_litter(nfsc) ! fraction of each litter pool burned, conditional on it being burned ! PLANT HYDRAULICS (not currently used in hydraulics RGK 03-2018) @@ -602,8 +603,7 @@ module EDTypesMod real(r8),allocatable :: nutrient_uptake_scpf(:) real(r8),allocatable :: nutrient_efflux_scpf(:) - real(r8),allocatable :: nutrient_needgrow_scpf(:) - real(r8),allocatable :: nutrient_needmax_scpf(:) + real(r8),allocatable :: nutrient_need_scpf(:) contains @@ -663,11 +663,6 @@ module EDTypesMod procedure :: ZeroMassBalFlux end type site_massbal_type - - - - - !************************************ @@ -684,7 +679,15 @@ module EDTypesMod type (ed_resources_management_type) :: resources_management ! resources_management at the site + ! If this simulation uses shared memory then the sites need to know what machine + ! index they are on. This index is (currently) only used to identify the sites + ! position in history output fields + !integer :: clump_id + ! Global index of this site in the history output file + integer :: h_gid + + ! INDICES real(r8) :: lat ! latitude: degrees real(r8) :: lon ! longitude: degrees @@ -703,6 +706,7 @@ module EDTypesMod ! PHENOLOGY real(r8) :: grow_deg_days ! Phenology growing degree days + real(r8) :: snow_depth ! site-level snow depth (used for ELAI/TLAI calcs) integer :: cstatus ! are leaves in this pixel on or off for cold decid ! 0 = this site has not experienced a cold period over at least @@ -730,7 +734,7 @@ module EDTypesMod real(r8) :: acc_ni ! daily nesterov index accumulating over time. real(r8) :: fdi ! daily probability an ignition event will start a fire real(r8) :: NF ! daily ignitions in km2 - real(r8) :: frac_burnt ! fraction of area burnt in this day. + real(r8) :: NF_successful ! daily ignitions in km2 that actually lead to fire ! PLANT HYDRAULICS type(ed_site_hydr_type), pointer :: si_hydr @@ -743,7 +747,7 @@ module EDTypesMod real(r8), allocatable :: dz_soil(:) ! layer thickness (m) real(r8), allocatable :: z_soil(:) ! layer depth (m) real(r8), allocatable :: rootfrac_scr(:) ! This is just allocated scratch space to hold - ! root fractions. Since root fractions may be dependant + ! root fractions. Since root fractions may be dependent ! on cohort properties, and we do not want to store this infromation ! on each cohort, we do not keep root fractions in ! memory, and instead calculate them on demand. @@ -835,8 +839,7 @@ subroutine ZeroFluxDiags(this) this%root_litter_input(:) = 0._r8 this%nutrient_uptake_scpf(:) = 0._r8 this%nutrient_efflux_scpf(:) = 0._r8 - this%nutrient_needgrow_scpf(:) = 0._r8 - this%nutrient_needmax_scpf(:) = 0._r8 + this%nutrient_need_scpf(:) = 0._r8 return end subroutine ZeroFluxDiags diff --git a/main/FatesConstantsMod.F90 b/main/FatesConstantsMod.F90 index 66d089a895..7e19856aa2 100644 --- a/main/FatesConstantsMod.F90 +++ b/main/FatesConstantsMod.F90 @@ -48,13 +48,19 @@ module FatesConstantsMod integer, public, parameter :: cohort_np_comp_scaling = 1 ! This flag definition indicates that EVERY cohort on - ! the column should compete independently in the soil - ! BGC nitrogen and phosphorus acquisition scheme. + ! the column should compete independently in the soil + ! BGC nitrogen and phosphorus acquisition scheme. integer, public, parameter :: pft_np_comp_scaling = 2 ! This flag definition indicates that cohorts should - ! be grouped into PFTs, and each PFT will be represented - ! as the competitor, in the BGC N and P acquisition scheme + ! be grouped into PFTs, and each PFT will be represented + ! as the competitor, in the BGC N and P acquisition scheme + integer, public, parameter :: trivial_np_comp_scaling = 3 ! This flag definition indicates that either + ! nutrients are turned off in FATES, or, that the + ! plants are not coupled with below ground chemistry. In + ! this situation, we send token boundary condition information. + + ! This flag specifies the scaling of how we present ! nutrient competitors to the HLM's soil BGC model diff --git a/main/FatesHistoryInterfaceMod.F90 b/main/FatesHistoryInterfaceMod.F90 index aa5e7db161..97f3342b43 100644 --- a/main/FatesHistoryInterfaceMod.F90 +++ b/main/FatesHistoryInterfaceMod.F90 @@ -8,6 +8,7 @@ module FatesHistoryInterfaceMod use FatesConstantsMod , only : calloc_abs_error use FatesConstantsMod , only : mg_per_kg use FatesConstantsMod , only : pi_const + use FatesConstantsMod , only : nearzero use FatesGlobals , only : fates_log use FatesGlobals , only : endrun => fates_endrun use EDTypesMod , only : nclmax @@ -154,6 +155,7 @@ module FatesHistoryInterfaceMod integer :: ih_totvegc_si integer :: ih_storen_si + integer :: ih_storentfrac_si integer :: ih_leafn_si integer :: ih_sapwn_si integer :: ih_fnrtn_si @@ -161,21 +163,21 @@ module FatesHistoryInterfaceMod integer :: ih_totvegn_si integer :: ih_storep_si + integer :: ih_storeptfrac_si integer :: ih_leafp_si integer :: ih_sapwp_si integer :: ih_fnrtp_si integer :: ih_reprop_si integer :: ih_totvegp_si - integer :: ih_nuptake_si - integer :: ih_puptake_si + integer,public :: ih_nh4uptake_si + integer,public :: ih_no3uptake_si + integer,public :: ih_puptake_si integer :: ih_cefflux_si integer :: ih_nefflux_si integer :: ih_pefflux_si - integer :: ih_nneedgrow_si - integer :: ih_nneedmax_si - integer :: ih_pneedgrow_si - integer :: ih_pneedmax_si + integer :: ih_nneed_si + integer :: ih_pneed_si integer :: ih_trimming_si integer :: ih_area_plant_si @@ -215,12 +217,14 @@ module FatesHistoryInterfaceMod integer :: ih_leafn_scpf integer :: ih_fnrtn_scpf integer :: ih_storen_scpf + integer :: ih_storentfrac_canopy_scpf + integer :: ih_storentfrac_understory_scpf integer :: ih_sapwn_scpf integer :: ih_repron_scpf - integer :: ih_nuptake_scpf + integer,public :: ih_nh4uptake_scpf + integer,public :: ih_no3uptake_scpf integer :: ih_nefflux_scpf - integer :: ih_nneedgrow_scpf - integer :: ih_nneedmax_scpf + integer :: ih_nneed_scpf integer :: ih_totvegc_scpf integer :: ih_leafc_scpf @@ -235,11 +239,12 @@ module FatesHistoryInterfaceMod integer :: ih_fnrtp_scpf integer :: ih_reprop_scpf integer :: ih_storep_scpf + integer :: ih_storeptfrac_canopy_scpf + integer :: ih_storeptfrac_understory_scpf integer :: ih_sapwp_scpf - integer :: ih_puptake_scpf + integer,public :: ih_puptake_scpf integer :: ih_pefflux_scpf - integer :: ih_pneedgrow_scpf - integer :: ih_pneedmax_scpf + integer :: ih_pneed_scpf integer :: ih_daily_temp integer :: ih_daily_rh @@ -295,7 +300,8 @@ module FatesHistoryInterfaceMod ! Indices to (site) variables integer :: ih_nep_si - + integer :: ih_hr_si + integer :: ih_c_stomata_si integer :: ih_c_lblayer_si @@ -329,7 +335,6 @@ module FatesHistoryInterfaceMod integer :: ih_h2oveg_dead_si integer :: ih_h2oveg_recruit_si integer :: ih_h2oveg_growturn_err_si - integer :: ih_h2oveg_pheno_err_si integer :: ih_h2oveg_hydro_err_si integer :: ih_site_cstatus_si @@ -506,6 +511,8 @@ module FatesHistoryInterfaceMod integer :: ih_mortality_si_pft integer :: ih_crownarea_si_pft integer :: ih_canopycrownarea_si_pft + integer :: ih_gpp_si_pft + integer :: ih_npp_si_pft ! indices to (site x patch-age) variables integer :: ih_area_si_age @@ -632,17 +639,6 @@ module FatesHistoryInterfaceMod integer, parameter, public :: fates_history_num_dimensions = 50 integer, parameter, public :: fates_history_num_dim_kinds = 50 - ! This structure is allocated by thread, and must be calculated after the FATES - ! sites are allocated, and their mapping to the HLM is identified. This structure - ! is not combined with iovar_bounds, because that one is multi-instanced. This - ! structure is used more during the update phase, wherease _bounds is used - ! more for things like flushing - type, public :: iovar_map_type - integer, allocatable :: site_index(:) ! maps site indexes to the HIO site position - integer, allocatable :: patch1_index(:) ! maps site index to the HIO patch 1st position - end type iovar_map_type - - type, public :: fates_history_interface_type ! Instance of the list of history output varialbes @@ -659,9 +655,6 @@ module FatesHistoryInterfaceMod ! allocated, but is unlikely to change...? type(fates_io_dimension_type) :: dim_bounds(fates_history_num_dimensions) - type(iovar_map_type), pointer :: iovar_map(:) - - !! THESE WERE EXPLICITLY PRIVATE WHEN TYPE WAS PUBLIC integer, private :: patch_index_, column_index_, levgrnd_index_, levscpf_index_ integer, private :: levscls_index_, levpft_index_, levage_index_ @@ -717,8 +710,6 @@ module FatesHistoryInterfaceMod procedure, private :: set_history_var procedure, private :: init_dim_kinds_maps procedure, private :: set_dim_indices - procedure, private :: flush_hvars - procedure, private :: set_patch_index procedure, private :: set_column_index procedure, private :: set_levgrnd_index @@ -744,12 +735,19 @@ module FatesHistoryInterfaceMod procedure, private :: set_levelcwd_index procedure, private :: set_levelage_index - + procedure, public :: flush_hvars + end type fates_history_interface_type character(len=*), parameter :: sourcefile = & __FILE__ + + ! The instance of the type + + type(fates_history_interface_type), public :: fates_hist + + contains ! ====================================================================== @@ -890,12 +888,6 @@ subroutine Init(this, num_threads, fates_bounds) call this%dim_bounds(dim_count)%Init(levagefuel, num_threads, & fates_bounds%agefuel_begin, fates_bounds%agefuel_end) - - ! FIXME(bja, 2016-10) assert(dim_count == FatesHistorydimensionmod::num_dimension_types) - - ! Allocate the mapping between FATES indices and the IO indices - allocate(this%iovar_map(num_threads)) - end subroutine Init ! ====================================================================== @@ -1731,9 +1723,6 @@ subroutine update_history_dyn(this,nc,nsites,sites) integer :: io_si ! The site index of the IO array integer :: ilyr ! Soil index for nlevsoil integer :: ipa, ipa2 ! The local "I"ndex of "PA"tches - integer :: io_pa ! The patch index of the IO array - integer :: io_pa1 ! The first patch index in the IO array for each site - integer :: io_soipa integer :: lb1,ub1,lb2,ub2 ! IO array bounds for the calling thread integer :: ivar ! index of IO variable object vector integer :: ft ! functional type index @@ -1754,7 +1743,7 @@ subroutine update_history_dyn(this,nc,nsites,sites) integer :: ageclass_since_anthrodist ! what is the equivalent age class for ! time-since-anthropogenic-disturbance of secondary forest - + real(r8) :: store_max ! The target nutrient mass for storage element of interest [kg] real(r8) :: n_perm2 ! individuals per m2 for the whole column real(r8) :: dbh ! diameter ("at breast height") real(r8) :: coage ! cohort age @@ -1809,6 +1798,8 @@ subroutine update_history_dyn(this,nc,nsites,sites) hio_mortality_si_pft => this%hvars(ih_mortality_si_pft)%r82d, & hio_crownarea_si_pft => this%hvars(ih_crownarea_si_pft)%r82d, & hio_canopycrownarea_si_pft => this%hvars(ih_canopycrownarea_si_pft)%r82d, & + hio_gpp_si_pft => this%hvars(ih_gpp_si_pft)%r82d, & + hio_npp_si_pft => this%hvars(ih_npp_si_pft)%r82d, & hio_nesterov_fire_danger_si => this%hvars(ih_nesterov_fire_danger_si)%r81d, & hio_fire_nignitions_si => this%hvars(ih_fire_nignitions_si)%r81d, & hio_fire_fdi_si => this%hvars(ih_fire_fdi_si)%r81d, & @@ -1926,7 +1917,7 @@ subroutine update_history_dyn(this,nc,nsites,sites) hio_m10_si_scls => this%hvars(ih_m10_si_scls)%r82d, & hio_m10_si_cacls => this%hvars(ih_m10_si_cacls)%r82d, & - hio_c13disc_si_scpf => this%hvars(ih_c13disc_si_scpf)%r82d, & + hio_c13disc_si_scpf => this%hvars(ih_c13disc_si_scpf)%r82d, & hio_cwd_elcwd => this%hvars(ih_cwd_elcwd)%r82d, & hio_cwd_ag_elem => this%hvars(ih_cwd_ag_elem)%r82d, & @@ -2039,11 +2030,7 @@ subroutine update_history_dyn(this,nc,nsites,sites) hio_err_fates_si => this%hvars(ih_err_fates_si)%r82d ) - ! --------------------------------------------------------------------------------- - ! Flush arrays to values defined by %flushval (see registry entry in - ! subroutine define_history_vars() - ! --------------------------------------------------------------------------------- - call this%flush_hvars(nc,upfreq_in=1) + ! If we don't have dynamics turned on, we just abort these diagnostics @@ -2056,11 +2043,9 @@ subroutine update_history_dyn(this,nc,nsites,sites) ! --------------------------------------------------------------------------------- do s = 1,nsites - - io_si = this%iovar_map(nc)%site_index(s) - io_pa1 = this%iovar_map(nc)%patch1_index(s) - io_soipa = io_pa1-1 + io_si = sites(s)%h_gid + ! Total carbon model error [kgC/day -> mgC/day] hio_cbal_err_fates_si(io_si) = & sites(s)%mass_balance(element_pos(carbon12_element))%err_fates * mg_per_kg @@ -2110,7 +2095,7 @@ subroutine update_history_dyn(this,nc,nsites,sites) ! site-level fire variables hio_nesterov_fire_danger_si(io_si) = sites(s)%acc_NI - hio_fire_nignitions_si(io_si) = sites(s)%NF + hio_fire_nignitions_si(io_si) = sites(s)%NF_successful hio_fire_fdi_si(io_si) = sites(s)%FDI ! If hydraulics are turned on, track the error terms @@ -2120,7 +2105,6 @@ subroutine update_history_dyn(this,nc,nsites,sites) this%hvars(ih_h2oveg_dead_si)%r81d(io_si) = sites(s)%si_hydr%h2oveg_dead this%hvars(ih_h2oveg_recruit_si)%r81d(io_si) = sites(s)%si_hydr%h2oveg_recruit this%hvars(ih_h2oveg_growturn_err_si)%r81d(io_si) = sites(s)%si_hydr%h2oveg_growturn_err - this%hvars(ih_h2oveg_pheno_err_si)%r81d(io_si) = sites(s)%si_hydr%h2oveg_pheno_err end if ! error in primary lands from patch fusion @@ -2151,8 +2135,6 @@ subroutine update_history_dyn(this,nc,nsites,sites) cpatch => sites(s)%oldest_patch do while(associated(cpatch)) - io_pa = io_pa1 + ipa - ! Increment the number of patches per site hio_npatches_si(io_si) = hio_npatches_si(io_si) + 1._r8 @@ -2278,6 +2260,7 @@ subroutine update_history_dyn(this,nc,nsites,sites) store_m = ccohort%prt%GetState(store_organ, element_list(el)) repro_m = ccohort%prt%GetState(repro_organ, element_list(el)) + alive_m = leaf_m + fnrt_m + sapw_m total_m = alive_m + store_m + struct_m @@ -2336,8 +2319,12 @@ subroutine update_history_dyn(this,nc,nsites,sites) elseif(element_list(el).eq.nitrogen_element)then + store_max = ccohort%prt%GetNutrientTarget(element_list(el),store_organ) + this%hvars(ih_storen_si)%r81d(io_si) = & this%hvars(ih_storen_si)%r81d(io_si) + ccohort%n * store_m + this%hvars(ih_storentfrac_si)%r81d(io_si) = & + this%hvars(ih_storentfrac_si)%r81d(io_si) + ccohort%n * store_max this%hvars(ih_leafn_si)%r81d(io_si) = & this%hvars(ih_leafn_si)%r81d(io_si) + ccohort%n * leaf_m this%hvars(ih_fnrtn_si)%r81d(io_si) = & @@ -2351,9 +2338,13 @@ subroutine update_history_dyn(this,nc,nsites,sites) elseif(element_list(el).eq.phosphorus_element) then + + store_max = ccohort%prt%GetNutrientTarget(element_list(el),store_organ) this%hvars(ih_storep_si)%r81d(io_si) = & this%hvars(ih_storep_si)%r81d(io_si) + ccohort%n * store_m + this%hvars(ih_storeptfrac_si)%r81d(io_si) = & + this%hvars(ih_storeptfrac_si)%r81d(io_si) + ccohort%n * store_max this%hvars(ih_leafp_si)%r81d(io_si) = & this%hvars(ih_leafp_si)%r81d(io_si) + ccohort%n * leaf_m this%hvars(ih_fnrtp_si)%r81d(io_si) = & @@ -2368,19 +2359,25 @@ subroutine update_history_dyn(this,nc,nsites,sites) end if end do - + ! Update PFT crown area hio_crownarea_si_pft(io_si, ft) = hio_crownarea_si_pft(io_si, ft) + & - ccohort%c_area + ccohort%c_area * AREA_INV if (ccohort%canopy_layer .eq. 1) then ! Update PFT canopy crown area hio_canopycrownarea_si_pft(io_si, ft) = hio_canopycrownarea_si_pft(io_si, ft) + & - ccohort%c_area + ccohort%c_area * AREA_INV end if + ! update pft-resolved NPP and GPP fluxes + hio_gpp_si_pft(io_si, ft) = hio_gpp_si_pft(io_si, ft) + & + ccohort%gpp_acc_hold * n_perm2 + + hio_npp_si_pft(io_si, ft) = hio_npp_si_pft(io_si, ft) + & + ccohort%npp_acc_hold * n_perm2 ! Site by Size-Class x PFT (SCPF) @@ -2873,6 +2870,7 @@ subroutine update_history_dyn(this,nc,nsites,sites) hio_lai_si_age(io_si, ipa2) = 0._r8 hio_ncl_si_age(io_si, ipa2) = 0._r8 endif + end do ! pass the cohort termination mortality as a flux to the history, and then reset the termination mortality buffer @@ -2963,6 +2961,11 @@ subroutine update_history_dyn(this,nc,nsites,sites) ! while in this loop, pass the fusion-induced growth rate flux to history hio_growthflux_fusion_si_scpf(io_si,i_scpf) = hio_growthflux_fusion_si_scpf(io_si,i_scpf) + & sites(s)%growthflux_fusion(i_scls, i_pft) * days_per_year + + + + + end do end do ! @@ -3106,28 +3109,18 @@ subroutine update_history_dyn(this,nc,nsites,sites) this%hvars(ih_fnrtn_scpf)%r82d(io_si,:) = 0._r8 this%hvars(ih_sapwn_scpf)%r82d(io_si,:) = 0._r8 this%hvars(ih_storen_scpf)%r82d(io_si,:) = 0._r8 + this%hvars(ih_storentfrac_canopy_scpf)%r82d(io_si,:) = 0._r8 + this%hvars(ih_storentfrac_understory_scpf)%r82d(io_si,:) = 0._r8 this%hvars(ih_repron_scpf)%r82d(io_si,:) = 0._r8 - this%hvars(ih_nuptake_scpf)%r82d(io_si,:) = & - sites(s)%flux_diags(el)%nutrient_uptake_scpf(:) - this%hvars(ih_nefflux_scpf)%r82d(io_si,:) = & sites(s)%flux_diags(el)%nutrient_efflux_scpf(:) - this%hvars(ih_nneedgrow_scpf)%r82d(io_si,:) = & - sites(s)%flux_diags(el)%nutrient_needgrow_scpf(:) - - this%hvars(ih_nneedmax_scpf)%r82d(io_si,:) = & - sites(s)%flux_diags(el)%nutrient_needmax_scpf(:) + this%hvars(ih_nneed_scpf)%r82d(io_si,:) = & + sites(s)%flux_diags(el)%nutrient_need_scpf(:) - this%hvars(ih_nneedgrow_si)%r81d(io_si) = & - sum(sites(s)%flux_diags(el)%nutrient_needgrow_scpf(:),dim=1) - - this%hvars(ih_nneedmax_si)%r81d(io_si) = & - sum(sites(s)%flux_diags(el)%nutrient_needmax_scpf(:),dim=1) - - this%hvars(ih_nuptake_si)%r81d(io_si) = & - sum(sites(s)%flux_diags(el)%nutrient_uptake_scpf(:),dim=1) + this%hvars(ih_nneed_si)%r81d(io_si) = & + sum(sites(s)%flux_diags(el)%nutrient_need_scpf(:),dim=1) this%hvars(ih_nefflux_si)%r81d(io_si) = & sum(sites(s)%flux_diags(el)%nutrient_efflux_scpf(:),dim=1) @@ -3139,28 +3132,17 @@ subroutine update_history_dyn(this,nc,nsites,sites) this%hvars(ih_fnrtp_scpf)%r82d(io_si,:) = 0._r8 this%hvars(ih_sapwp_scpf)%r82d(io_si,:) = 0._r8 this%hvars(ih_storep_scpf)%r82d(io_si,:) = 0._r8 + this%hvars(ih_storeptfrac_canopy_scpf)%r82d(io_si,:) = 0._r8 + this%hvars(ih_storeptfrac_understory_scpf)%r82d(io_si,:) = 0._r8 this%hvars(ih_reprop_scpf)%r82d(io_si,:) = 0._r8 - - this%hvars(ih_puptake_scpf)%r82d(io_si,:) = & - sites(s)%flux_diags(el)%nutrient_uptake_scpf(:) - this%hvars(ih_pefflux_scpf)%r82d(io_si,:) = & sites(s)%flux_diags(el)%nutrient_efflux_scpf(:) - this%hvars(ih_pneedgrow_scpf)%r82d(io_si,:) = & - sites(s)%flux_diags(el)%nutrient_needgrow_scpf(:) + this%hvars(ih_pneed_scpf)%r82d(io_si,:) = & + sites(s)%flux_diags(el)%nutrient_need_scpf(:) - this%hvars(ih_pneedmax_scpf)%r82d(io_si,:) = & - sites(s)%flux_diags(el)%nutrient_needmax_scpf(:) - - this%hvars(ih_pneedgrow_si)%r81d(io_si) = & - sum(sites(s)%flux_diags(el)%nutrient_needgrow_scpf(:),dim=1) - - this%hvars(ih_pneedmax_si)%r81d(io_si) = & - sum(sites(s)%flux_diags(el)%nutrient_needmax_scpf(:),dim=1) - - this%hvars(ih_puptake_si)%r81d(io_si) = & - sum(sites(s)%flux_diags(el)%nutrient_uptake_scpf(:),dim=1) + this%hvars(ih_pneed_si)%r81d(io_si) = & + sum(sites(s)%flux_diags(el)%nutrient_need_scpf(:),dim=1) this%hvars(ih_pefflux_si)%r81d(io_si) = & sum(sites(s)%flux_diags(el)%nutrient_efflux_scpf(:),dim=1) @@ -3175,12 +3157,16 @@ subroutine update_history_dyn(this,nc,nsites,sites) area_frac = cpatch%area * AREA_INV + + ! Sum up all output fluxes (fragmentation) hio_litter_out_elem(io_si,el) = hio_litter_out_elem(io_si,el) + & (sum(litt%leaf_fines_frag(:)) + & sum(litt%root_fines_frag(:,:)) + & sum(litt%ag_cwd_frag(:)) + & - sum(litt%bg_cwd_frag(:,:))) * cpatch%area + sum(litt%bg_cwd_frag(:,:)) + & + sum(litt%seed_decay(:)) + & + sum(litt%seed_germ_decay(:))) * cpatch%area hio_seed_bank_elem(io_si,el) = hio_seed_bank_elem(io_si,el) + & sum(litt%seed(:)) * cpatch%area @@ -3189,7 +3175,7 @@ subroutine update_history_dyn(this,nc,nsites,sites) sum(litt%seed_germ(:)) * cpatch%area hio_seed_decay_elem(io_si,el) = hio_seed_decay_elem(io_si,el) + & - sum(litt%seed_decay(:)) * cpatch%area + sum(litt%seed_decay(:) + litt%seed_germ_decay(:) ) * cpatch%area hio_seeds_in_local_elem(io_si,el) = hio_seeds_in_local_elem(io_si,el) + & sum(litt%seed_in_local(:)) * cpatch%area @@ -3229,6 +3215,7 @@ subroutine update_history_dyn(this,nc,nsites,sites) repro_m = ccohort%prt%GetState(repro_organ, element_list(el)) total_m = sapw_m+struct_m+leaf_m+fnrt_m+store_m+repro_m + i_scpf = ccohort%size_by_pft_class if(element_list(el).eq.carbon12_element)then @@ -3245,6 +3232,9 @@ subroutine update_history_dyn(this,nc,nsites,sites) this%hvars(ih_reproc_scpf)%r82d(io_si,i_scpf) = & this%hvars(ih_reproc_scpf)%r82d(io_si,i_scpf) + repro_m * ccohort%n elseif(element_list(el).eq.nitrogen_element)then + + store_max = ccohort%prt%GetNutrientTarget(element_list(el),store_organ) + this%hvars(ih_totvegn_scpf)%r82d(io_si,i_scpf) = & this%hvars(ih_totvegn_scpf)%r82d(io_si,i_scpf) + total_m * ccohort%n this%hvars(ih_leafn_scpf)%r82d(io_si,i_scpf) = & @@ -3257,7 +3247,19 @@ subroutine update_history_dyn(this,nc,nsites,sites) this%hvars(ih_storen_scpf)%r82d(io_si,i_scpf) + store_m * ccohort%n this%hvars(ih_repron_scpf)%r82d(io_si,i_scpf) = & this%hvars(ih_repron_scpf)%r82d(io_si,i_scpf) + repro_m * ccohort%n + + if (ccohort%canopy_layer .eq. 1) then + this%hvars(ih_storentfrac_canopy_scpf)%r82d(io_si,i_scpf) = & + this%hvars(ih_storentfrac_canopy_scpf)%r82d(io_si,i_scpf) + store_m/store_max * ccohort%n + else + this%hvars(ih_storentfrac_understory_scpf)%r82d(io_si,i_scpf) = & + this%hvars(ih_storentfrac_understory_scpf)%r82d(io_si,i_scpf) + store_m/store_max * ccohort%n + end if + elseif(element_list(el).eq.phosphorus_element)then + + store_max = ccohort%prt%GetNutrientTarget(element_list(el),store_organ) + this%hvars(ih_totvegp_scpf)%r82d(io_si,i_scpf) = & this%hvars(ih_totvegp_scpf)%r82d(io_si,i_scpf) + total_m * ccohort%n this%hvars(ih_leafp_scpf)%r82d(io_si,i_scpf) = & @@ -3270,6 +3272,15 @@ subroutine update_history_dyn(this,nc,nsites,sites) this%hvars(ih_storep_scpf)%r82d(io_si,i_scpf) + store_m * ccohort%n this%hvars(ih_reprop_scpf)%r82d(io_si,i_scpf) = & this%hvars(ih_reprop_scpf)%r82d(io_si,i_scpf) + repro_m * ccohort%n + + if (ccohort%canopy_layer .eq. 1) then + this%hvars(ih_storeptfrac_canopy_scpf)%r82d(io_si,i_scpf) = & + this%hvars(ih_storeptfrac_canopy_scpf)%r82d(io_si,i_scpf) + store_m/store_max * ccohort%n + else + this%hvars(ih_storeptfrac_understory_scpf)%r82d(io_si,i_scpf) = & + this%hvars(ih_storeptfrac_understory_scpf)%r82d(io_si,i_scpf) + store_m/store_max * ccohort%n + end if + end if ccohort => ccohort%shorter @@ -3279,10 +3290,58 @@ subroutine update_history_dyn(this,nc,nsites,sites) end do end do - + ! Normalize nutrient storage fractions + do el = 1, num_elements + if(element_list(el).eq.nitrogen_element)then + if( this%hvars(ih_storentfrac_si)%r81d(io_si)>nearzero ) then + this%hvars(ih_storentfrac_si)%r81d(io_si) = this%hvars(ih_storen_si)%r81d(io_si) / & + this%hvars(ih_storentfrac_si)%r81d(io_si) + end if + do i_pft = 1, numpft + do i_scls = 1,nlevsclass + i_scpf = (i_pft-1)*nlevsclass + i_scls + + if( hio_nplant_canopy_si_scpf(io_si,i_scpf)>nearzero ) then + this%hvars(ih_storentfrac_canopy_scpf)%r82d(io_si,i_scpf) = & + this%hvars(ih_storentfrac_canopy_scpf)%r82d(io_si,i_scpf) / & + hio_nplant_canopy_si_scpf(io_si,i_scpf) + end if + + if( hio_nplant_understory_si_scpf(io_si,i_scpf)>nearzero ) then + this%hvars(ih_storentfrac_understory_scpf)%r82d(io_si,i_scpf) = & + this%hvars(ih_storentfrac_understory_scpf)%r82d(io_si,i_scpf) / & + hio_nplant_understory_si_scpf(io_si,i_scpf) + end if + + end do + end do + elseif(element_list(el).eq.phosphorus_element)then + if( this%hvars(ih_storeptfrac_si)%r81d(io_si)>nearzero ) then + this%hvars(ih_storeptfrac_si)%r81d(io_si) = this%hvars(ih_storep_si)%r81d(io_si) / & + this%hvars(ih_storeptfrac_si)%r81d(io_si) + end if + do i_pft = 1, numpft + do i_scls = 1,nlevsclass + i_scpf = (i_pft-1)*nlevsclass + i_scls + if( hio_nplant_canopy_si_scpf(io_si,i_scpf)>nearzero ) then + this%hvars(ih_storeptfrac_canopy_scpf)%r82d(io_si,i_scpf) = & + this%hvars(ih_storeptfrac_canopy_scpf)%r82d(io_si,i_scpf) /& + hio_nplant_canopy_si_scpf(io_si,i_scpf) + + end if + if( hio_nplant_understory_si_scpf(io_si,i_scpf)>nearzero ) then + this%hvars(ih_storeptfrac_understory_scpf)%r82d(io_si,i_scpf) = & + this%hvars(ih_storeptfrac_understory_scpf)%r82d(io_si,i_scpf) /& + hio_nplant_understory_si_scpf(io_si,i_scpf) + end if + + end do + end do + end if + end do ! pass demotion rates and associated carbon fluxes to history do i_scls = 1,nlevsclass @@ -3352,9 +3411,6 @@ subroutine update_history_hifrq(this,nc,nsites,sites,bc_in,dt_tstep) integer :: s ! The local site index integer :: io_si ! The site index of the IO array integer :: ipa ! The local "I"ndex of "PA"tches - integer :: io_pa ! The patch index of the IO array - integer :: io_pa1 ! The first patch index in the IO array for each site - integer :: io_soipa integer :: lb1,ub1,lb2,ub2 ! IO array bounds for the calling thread integer :: ivar ! index of IO variable object vector integer :: ft ! functional type index @@ -3379,7 +3435,8 @@ subroutine update_history_hifrq(this,nc,nsites,sites,bc_in,dt_tstep) hio_growth_resp_si => this%hvars(ih_growth_resp_si)%r81d, & hio_c_stomata_si => this%hvars(ih_c_stomata_si)%r81d, & hio_c_lblayer_si => this%hvars(ih_c_lblayer_si)%r81d, & - hio_nep_si => this%hvars(ih_nep_si)%r81d, & + hio_nep_si => this%hvars(ih_nep_si)%r81d, & + hio_hr_si => this%hvars(ih_hr_si)%r81d, & hio_ar_si_scpf => this%hvars(ih_ar_si_scpf)%r82d, & hio_ar_grow_si_scpf => this%hvars(ih_ar_grow_si_scpf)%r82d, & hio_ar_maint_si_scpf => this%hvars(ih_ar_maint_si_scpf)%r82d, & @@ -3450,11 +3507,10 @@ subroutine update_history_hifrq(this,nc,nsites,sites,bc_in,dt_tstep) do s = 1,nsites - io_si = this%iovar_map(nc)%site_index(s) - io_pa1 = this%iovar_map(nc)%patch1_index(s) - io_soipa = io_pa1-1 + io_si = sites(s)%h_gid hio_nep_si(io_si) = -bc_in(s)%tot_het_resp ! (gC/m2/s) + hio_hr_si(io_si) = bc_in(s)%tot_het_resp ipa = 0 cpatch => sites(s)%oldest_patch @@ -3464,8 +3520,6 @@ subroutine update_history_hifrq(this,nc,nsites,sites,bc_in,dt_tstep) do while(associated(cpatch)) - io_pa = io_pa1 + ipa - patch_area_by_age(cpatch%age_class) = & patch_area_by_age(cpatch%age_class) + cpatch%area @@ -3883,7 +3937,7 @@ subroutine update_history_hydraulics(this,nc,nsites,sites,bc_in,dt_tstep) jr1 = site_hydr%i_rhiz_t jr2 = site_hydr%i_rhiz_b - io_si = this%iovar_map(nc)%site_index(s) + io_si = sites(s)%h_gid hio_h2oveg_si(io_si) = site_hydr%h2oveg hio_h2oveg_hydro_err_si(io_si) = site_hydr%h2oveg_hydro_err @@ -4197,12 +4251,12 @@ subroutine define_history_vars(this, initialize_variables) avgflag='A', vtype=site_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=1, & ivar=ivar, initialize=initialize_variables, index = ih_trimming_si) - call this%set_history_var(vname='AREA_PLANT', units='m2', & + call this%set_history_var(vname='AREA_PLANT', units='m2/m2', & long='area occupied by all plants', use_default='active', & avgflag='A', vtype=site_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=1, & ivar=ivar, initialize=initialize_variables, index = ih_area_plant_si) - call this%set_history_var(vname='AREA_TREES', units='m2', & + call this%set_history_var(vname='AREA_TREES', units='m2/m2', & long='area occupied by woody plants', use_default='active', & avgflag='A', vtype=site_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=1, & ivar=ivar, initialize=initialize_variables, index = ih_area_trees_si) @@ -4288,16 +4342,26 @@ subroutine define_history_vars(this, initialize_variables) avgflag='A', vtype=site_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=1, & ivar=ivar, initialize=initialize_variables, index = ih_storebiomass_si_pft ) - call this%set_history_var(vname='PFTcrownarea', units='m2/ha', & + call this%set_history_var(vname='PFTcrownarea', units='m2/m2', & long='total PFT level crown area', use_default='inactive', & avgflag='A', vtype=site_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=1, & ivar=ivar, initialize=initialize_variables, index = ih_crownarea_si_pft ) - call this%set_history_var(vname='PFTcanopycrownarea', units='m2/ha', & + call this%set_history_var(vname='PFTcanopycrownarea', units='m2/m2', & long='total PFT-level canopy-layer crown area', use_default='inactive', & avgflag='A', vtype=site_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=1, & ivar=ivar, initialize=initialize_variables, index = ih_canopycrownarea_si_pft ) + call this%set_history_var(vname='PFTgpp', units='kg C m-2 y-1', & + long='total PFT-level GPP', use_default='active', & + avgflag='A', vtype=site_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=1, & + ivar=ivar, initialize=initialize_variables, index = ih_gpp_si_pft ) + + call this%set_history_var(vname='PFTnpp', units='kg C m-2 y-1', & + long='total PFT-level NPP', use_default='active', & + avgflag='A', vtype=site_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=1, & + ivar=ivar, initialize=initialize_variables, index = ih_npp_si_pft ) + call this%set_history_var(vname='PFTnindivs', units='indiv / m2', & long='total PFT level number of individuals', use_default='active', & avgflag='A', vtype=site_pft_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=1, & @@ -4406,7 +4470,7 @@ subroutine define_history_vars(this, initialize_variables) ivar=ivar, initialize=initialize_variables, index = ih_nesterov_fire_danger_si) call this%set_history_var(vname='FIRE_IGNITIONS', units='number/km2/day', & - long='number of ignitions', use_default='active', & + long='number of successful ignitions', use_default='active', & avgflag='A', vtype=site_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=1, & ivar=ivar, initialize=initialize_variables, index = ih_fire_nignitions_si) @@ -4451,7 +4515,7 @@ subroutine define_history_vars(this, initialize_variables) avgflag='A', vtype=site_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=1, & ivar=ivar, initialize=initialize_variables, index = ih_fire_intensity_area_product_si ) - call this%set_history_var(vname='FIRE_AREA', units='fraction', & + call this%set_history_var(vname='FIRE_AREA', units='fraction/day', & long='spitfire fire area burn fraction', use_default='active', & avgflag='A', vtype=site_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=1, & ivar=ivar, initialize=initialize_variables, index = ih_fire_area_si ) @@ -4503,7 +4567,7 @@ subroutine define_history_vars(this, initialize_variables) avgflag='A', vtype=site_agefuel_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=1, & ivar=ivar, initialize=initialize_variables, index = ih_fuel_amount_age_fuel ) - call this%set_history_var(vname='AREA_BURNT_BY_PATCH_AGE', units='m2/m2', & + call this%set_history_var(vname='AREA_BURNT_BY_PATCH_AGE', units='m2/m2/day', & long='spitfire area burnt by patch age (divide by patch_area_by_age to get burnt fraction by age)', & use_default='active', & avgflag='A', vtype=site_age_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=1, & @@ -4581,7 +4645,7 @@ subroutine define_history_vars(this, initialize_variables) ivar=ivar, initialize=initialize_variables, index = ih_seed_germ_elem ) call this%set_history_var(vname='SEED_DECAY_ELEM', units='kg ha-1 d-1', & - long='Seed mass decay', use_default='active', & + long='Seed mass decay (germinated and un-germinated)', use_default='active', & avgflag='A', vtype=site_elem_r8, hlms='CLM:ALM', flushval=hlm_hio_ignore_val, upfreq=1, & ivar=ivar, initialize=initialize_variables, index = ih_seed_decay_elem ) @@ -4628,6 +4692,11 @@ subroutine define_history_vars(this, initialize_variables) long='Total nitrogen in live plant storage', use_default='active', & avgflag='A', vtype=site_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=1, & ivar=ivar, initialize=initialize_variables, index = ih_storen_si ) + + call this%set_history_var(vname='STOREN_TFRAC', units='-', & + long='Storage N fraction of target', use_default='active', & + avgflag='A', vtype=site_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=1, & + ivar=ivar, initialize=initialize_variables, index = ih_storentfrac_si ) call this%set_history_var(vname='TOTVEGN', units='kgN ha-1', & long='Total nitrogen in live plants', use_default='active', & @@ -4654,25 +4723,25 @@ subroutine define_history_vars(this, initialize_variables) avgflag='A', vtype=site_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=1, & ivar=ivar, initialize=initialize_variables, index = ih_repron_si ) - call this%set_history_var(vname='NUPTAKE', units='kgN d-1 ha-1', & - long='Total nitrogen uptake by plants per sq meter per day', use_default='active', & + call this%set_history_var(vname='NH4UPTAKE', units='kgN d-1 ha-1', & + long='Ammonium uptake rate by plants', use_default='active', & avgflag='A', vtype=site_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=1, & - ivar=ivar, initialize=initialize_variables, index = ih_nuptake_si ) + ivar=ivar, initialize=initialize_variables, index = ih_nh4uptake_si ) + call this%set_history_var(vname='NO3UPTAKE', units='kgN d-1 ha-1', & + long='Nitrate uptake rate by plants', use_default='active', & + avgflag='A', vtype=site_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=1, & + ivar=ivar, initialize=initialize_variables, index = ih_no3uptake_si ) + call this%set_history_var(vname='NEFFLUX', units='kgN d-1 ha-1', & long='Nitrogen effluxed from plant (unused)', use_default='active', & avgflag='A', vtype=site_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=1, & ivar=ivar, initialize=initialize_variables, index = ih_nefflux_si ) - call this%set_history_var(vname='NNEED_GROW', units='kgN d-1 ha-1', & - long='(Approx) plant nitrogen needed to satisfy growth', use_default='active', & - avgflag='A', vtype=site_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=1, & - ivar=ivar, initialize=initialize_variables, index = ih_nneedgrow_si ) - - call this%set_history_var(vname='NNEED_MAX', units='kgN d-1 ha-1', & - long='(Approx) plant nitrogen needed to reach maximum capacity', use_default='active', & + call this%set_history_var(vname='NNEED', units='kgN d-1 ha-1', & + long='Plant nitrogen need (algorithm dependent)', use_default='active', & avgflag='A', vtype=site_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=1, & - ivar=ivar, initialize=initialize_variables, index = ih_nneedmax_si ) + ivar=ivar, initialize=initialize_variables, index = ih_nneed_si ) end if nitrogen_active_if @@ -4682,6 +4751,11 @@ subroutine define_history_vars(this, initialize_variables) long='Total phosphorus in live plant storage', use_default='active', & avgflag='A', vtype=site_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=1, & ivar=ivar, initialize=initialize_variables, index = ih_storep_si ) + + call this%set_history_var(vname='STOREP_TFRAC', units='fraction', & + long='Storage P fraction of target', use_default='active', & + avgflag='A', vtype=site_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=1, & + ivar=ivar, initialize=initialize_variables, index = ih_storeptfrac_si ) call this%set_history_var(vname='TOTVEGP', units='kgP ha-1', & long='Total phosphorus in live plants', use_default='active', & @@ -4709,7 +4783,7 @@ subroutine define_history_vars(this, initialize_variables) ivar=ivar, initialize=initialize_variables, index = ih_reprop_si ) call this%set_history_var(vname='PUPTAKE', units='kgP ha-1 d-1', & - long='Total phosphorus uptake by plants per sq meter per day', use_default='active', & + long='Mineralized phosphorus uptake rate of plants', use_default='active', & avgflag='A', vtype=site_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=1, & ivar=ivar, initialize=initialize_variables, index = ih_puptake_si ) @@ -4718,17 +4792,11 @@ subroutine define_history_vars(this, initialize_variables) avgflag='A', vtype=site_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=1, & ivar=ivar, initialize=initialize_variables, index = ih_pefflux_si ) - call this%set_history_var(vname='PNEED_GROW', units='kgP ha-1 d-1', & - long='Plant phosphorus needed to satisfy growth', use_default='active', & + call this%set_history_var(vname='PNEED', units='kgP ha-1 d-1', & + long='Plant phosphorus need (algorithm dependent)', use_default='active', & avgflag='A', vtype=site_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=1, & - ivar=ivar, initialize=initialize_variables, index = ih_pneedgrow_si ) + ivar=ivar, initialize=initialize_variables, index = ih_pneed_si ) - call this%set_history_var(vname='PNEED_MAX', units='kgP ha-1 d-1', & - long='Plant phosphorus needed to reach maximum capacity', use_default='active', & - avgflag='A', vtype=site_r8, hlms='CLM:ALM', flushval=0.0_r8, upfreq=1, & - ivar=ivar, initialize=initialize_variables, index = ih_pneedmax_si ) - - end if phosphorus_active_if @@ -5873,6 +5941,11 @@ subroutine define_history_vars(this, initialize_variables) avgflag='A', vtype=site_r8, hlms='CLM:ALM', flushval=hlm_hio_ignore_val, & upfreq=2, ivar=ivar, initialize=initialize_variables, index = ih_nep_si ) + call this%set_history_var(vname='FATES_HR', units='gC/m^2/s', & + long='heterotrophic respiration', use_default='active', & + avgflag='A', vtype=site_r8, hlms='CLM:ALM', flushval=hlm_hio_ignore_val, & + upfreq=2, ivar=ivar, initialize=initialize_variables, index = ih_hr_si ) + call this%set_history_var(vname='Fire_Closs', units='gC/m^2/s', & long='ED/SPitfire Carbon loss to atmosphere', use_default='active', & avgflag='A', vtype=site_r8, hlms='CLM:ALM', flushval=hlm_hio_ignore_val, & @@ -5982,31 +6055,40 @@ subroutine define_history_vars(this, initialize_variables) avgflag='A', vtype=site_size_pft_r8, hlms='CLM:ALM', flushval=hlm_hio_ignore_val, & upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_storen_scpf ) + call this%set_history_var(vname='STOREN_TFRAC_CANOPY_SCPF', units='kgN/ha', & + long='storage nitrogen fraction of target,in canopy, by size-class x pft', use_default='inactive', & + avgflag='A', vtype=site_size_pft_r8, hlms='CLM:ALM', flushval=hlm_hio_ignore_val, & + upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_storentfrac_canopy_scpf ) + + call this%set_history_var(vname='STOREN_TFRAC_UNDERSTORY_SCPF', units='kgN/ha', & + long='storage nitrogen fraction of target,in understory, by size-class x pft', use_default='inactive', & + avgflag='A', vtype=site_size_pft_r8, hlms='CLM:ALM', flushval=hlm_hio_ignore_val, & + upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_storentfrac_understory_scpf ) + call this%set_history_var(vname='REPRON_SCPF', units='kgN/ha', & long='reproductive nitrogen mass (on plant) by size-class x pft', use_default='inactive', & avgflag='A', vtype=site_size_pft_r8, hlms='CLM:ALM', flushval=hlm_hio_ignore_val, & upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_repron_scpf ) - call this%set_history_var(vname='NUPTAKE_SCPF', units='kgN d-1 ha-1', & - long='nitrogen uptake, soil to root, by size-class x pft', use_default='inactive', & + call this%set_history_var(vname='NH4UPTAKE_SCPF', units='kgN d-1 ha-1', & + long='Ammonium uptake rate by plants, size-class x pft', use_default='inactive', & avgflag='A', vtype=site_size_pft_r8, hlms='CLM:ALM', flushval=hlm_hio_ignore_val, & - upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_nuptake_scpf ) + upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_nh4uptake_scpf ) + + call this%set_history_var(vname='NO3UPTAKE_SCPF', units='kgN d-1 ha-1', & + long='Nitrate uptake rate by plants, size-class x pft', use_default='inactive', & + avgflag='A', vtype=site_size_pft_r8, hlms='CLM:ALM', flushval=hlm_hio_ignore_val, & + upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_no3uptake_scpf ) call this%set_history_var(vname='NEFFLUX_SCPF', units='kgN d-1 ha-1', & long='nitrogen efflux, root to soil, by size-class x pft', use_default='inactive', & avgflag='A', vtype=site_size_pft_r8, hlms='CLM:ALM', flushval=hlm_hio_ignore_val, & upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_nefflux_scpf ) - call this%set_history_var(vname='NNEEDGROW_SCPF', units='kgN d-1 ha-1', & - long='nitrogen needed to match growth, by size-class x pft', use_default='inactive', & - avgflag='A', vtype=site_size_pft_r8, hlms='CLM:ALM', flushval=hlm_hio_ignore_val, & - upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_nneedgrow_scpf ) - - call this%set_history_var(vname='NNEEDMAX_SCPF', units='kgN d-1 ha-1', & - long='nitrogen needed to reach max concentrations, by size-class x pft', use_default='inactive', & + call this%set_history_var(vname='NNEED_SCPF', units='kgN d-1 ha-1', & + long='plant N need (algorithm dependent), by size-class x pft', use_default='inactive', & avgflag='A', vtype=site_size_pft_r8, hlms='CLM:ALM', flushval=hlm_hio_ignore_val, & - upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_nneedmax_scpf ) - + upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_nneed_scpf ) end if nitrogen_active_if2 @@ -6037,13 +6119,23 @@ subroutine define_history_vars(this, initialize_variables) avgflag='A', vtype=site_size_pft_r8, hlms='CLM:ALM', flushval=hlm_hio_ignore_val, & upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_storep_scpf ) + call this%set_history_var(vname='STOREP_TFRAC_CANOPY_SCPF', units='kgN/ha', & + long='storage phosphorus fraction of target,in canopy, by size-class x pft', use_default='inactive', & + avgflag='A', vtype=site_size_pft_r8, hlms='CLM:ALM', flushval=hlm_hio_ignore_val, & + upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_storeptfrac_canopy_scpf ) + + call this%set_history_var(vname='STOREP_TFRAC_UNDERSTORY_SCPF', units='kgN/ha', & + long='storage phosphorus fraction of target,in understory, by size-class x pft', use_default='inactive', & + avgflag='A', vtype=site_size_pft_r8, hlms='CLM:ALM', flushval=hlm_hio_ignore_val, & + upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_storeptfrac_understory_scpf ) + call this%set_history_var(vname='REPROP_SCPF', units='kgP/ha', & long='reproductive phosphorus mass (on plant) by size-class x pft', use_default='inactive', & avgflag='A', vtype=site_size_pft_r8, hlms='CLM:ALM', flushval=hlm_hio_ignore_val, & upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_reprop_scpf ) call this%set_history_var(vname='PUPTAKE_SCPF', units='kg/ha/day', & - long='phosphorus uptake, soil to root, by size-class x pft', use_default='inactive', & + long='phosphorus uptake rate by plants, by size-class x pft', use_default='inactive', & avgflag='A', vtype=site_size_pft_r8, hlms='CLM:ALM', flushval=hlm_hio_ignore_val, & upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_puptake_scpf ) @@ -6052,15 +6144,10 @@ subroutine define_history_vars(this, initialize_variables) avgflag='A', vtype=site_size_pft_r8, hlms='CLM:ALM', flushval=hlm_hio_ignore_val, & upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_pefflux_scpf ) - call this%set_history_var(vname='PNEEDGROW_SCPF', units='kg/ha/day', & - long='phosphorus needed to match growth, by size-class x pft', use_default='inactive', & - avgflag='A', vtype=site_size_pft_r8, hlms='CLM:ALM', flushval=hlm_hio_ignore_val, & - upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_pneedgrow_scpf ) - - call this%set_history_var(vname='PNEEDMAX_SCPF', units='kg/ha/day', & - long='phosphorus needed to reach max concentrations, by size-class x pft', use_default='inactive', & + call this%set_history_var(vname='PNEED_SCPF', units='kg/ha/day', & + long='plant P need (algorithm dependent), by size-class x pft', use_default='inactive', & avgflag='A', vtype=site_size_pft_r8, hlms='CLM:ALM', flushval=hlm_hio_ignore_val, & - upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_pneedmax_scpf ) + upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_pneed_scpf ) end if phosphorus_active_if2 @@ -6277,11 +6364,6 @@ subroutine define_history_vars(this, initialize_variables) long='cumulative net borrowed (+) or lost (-) from plant_stored_h2o due to combined growth & turnover', use_default='inactive', & avgflag='A', vtype=site_r8, hlms='CLM:ALM', flushval=0.0_r8, & upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_h2oveg_growturn_err_si ) - - call this%set_history_var(vname='H2OVEG_PHENO_ERR', units = 'kg/m2', & - long='cumulative net borrowed (+) from plant_stored_h2o due to leaf emergence', use_default='inactive', & - avgflag='A', vtype=site_r8, hlms='CLM:ALM', flushval=0.0_r8, & - upfreq=1, ivar=ivar, initialize=initialize_variables, index = ih_h2oveg_pheno_err_si ) call this%set_history_var(vname='H2OVEG_HYDRO_ERR', units = 'kg/m2', & long='cumulative net borrowed (+) from plant_stored_h2o due to plant hydrodynamics', use_default='inactive', & diff --git a/main/FatesHydraulicsMemMod.F90 b/main/FatesHydraulicsMemMod.F90 index d3b71c2847..5de1165a16 100644 --- a/main/FatesHydraulicsMemMod.F90 +++ b/main/FatesHydraulicsMemMod.F90 @@ -131,10 +131,6 @@ module FatesHydraulicsMemMod ! tissue volume or too much water is ! available when tissue volume decreases, ! respectively. - real(r8) :: h2oveg_pheno_err ! error water pool (kg/m2) for leaf-on - ! Draw from or add to this pool when - ! insufficient plant water available to - ! support production of new leaves. real(r8) :: h2oveg_hydro_err ! error water pool (kg/m2) for hydrodynamics ! Draw from or add to this pool when ! insufficient plant water available to @@ -294,24 +290,6 @@ module FatesHydraulicsMemMod real(r8) :: iterlayer ! layer index associated with the highest iterations real(r8) :: errh2o ! total water balance error per unit crown area [kgh2o/m2] - real(r8) :: errh2o_growturn_ag(n_hypool_ag) ! error water pool for increase (growth) or - ! contraction (turnover) of tissue volumes. - ! Draw from or add to this pool when - ! insufficient water available to increase - ! tissue volume or too much water is - ! available when tissue volume decreases, - ! respectively. - real(r8) :: errh2o_pheno_ag(n_hypool_ag) ! error water pool for for leaf-on - ! Draw from or add to this pool when - ! insufficient plant water available to - ! support production of new leaves. - real(r8) :: errh2o_growturn_troot ! same as errh2o_growturn_ag but for troot pool - real(r8) :: errh2o_pheno_troot ! same as errh2o_pheno_ag but for troot pool - real(r8) :: errh2o_growturn_aroot ! same as errh2o_growturn_ag but for aroot pools - real(r8) :: errh2o_pheno_aroot ! same as errh2o_pheno_ag but for aroot pools - - - ! Other @@ -426,8 +404,8 @@ subroutine InitHydrSite(this,numpft,numlevsclass) this%h2oveg = 0.0_r8 this%h2oveg_recruit = 0.0_r8 this%h2oveg_dead = 0.0_r8 + this%h2oveg_growturn_err = 0.0_r8 - this%h2oveg_pheno_err = 0.0_r8 this%h2oveg_hydro_err = 0.0_r8 ! We have separate water transfer functions and parameters diff --git a/main/FatesInterfaceMod.F90 b/main/FatesInterfaceMod.F90 index 48aef9deed..0156beb2dc 100644 --- a/main/FatesInterfaceMod.F90 +++ b/main/FatesInterfaceMod.F90 @@ -43,6 +43,7 @@ module FatesInterfaceMod use CLMFatesParamInterfaceMod , only : FatesReadParameters use EDTypesMod , only : p_uptake_mode use EDTypesMod , only : n_uptake_mode + use EDTypesMod , only : ed_site_type use FatesConstantsMod , only : prescribed_p_uptake use FatesConstantsMod , only : prescribed_n_uptake use FatesConstantsMod , only : coupled_p_uptake @@ -63,7 +64,7 @@ module FatesInterfaceMod use PRTGenericMod , only : leaf_organ, fnrt_organ, store_organ use PRTGenericMod , only : sapw_organ, struct_organ, repro_organ use PRTParametersMod , only : prt_params - use PRTInitParamsFatesMod , only : PRTCheckParams + use PRTInitParamsFatesMod , only : PRTCheckParams, PRTDerivedParams use PRTAllometricCarbonMod , only : InitPRTGlobalAllometricCarbon use PRTAllometricCNPMod , only : InitPRTGlobalAllometricCNP @@ -76,11 +77,48 @@ module FatesInterfaceMod ! its sister code use FatesInterfaceTypesMod - implicit none private + type, public :: fates_interface_type + + ! This is the root of the ED/FATES hierarchy of instantaneous state variables + ! ie the root of the linked lists. Each path list is currently associated with a + ! grid-cell, this is intended to be migrated to columns + + integer :: nsites + + type(ed_site_type), pointer :: sites(:) + + ! These are boundary conditions that the FATES models are required to be filled. + ! These values are filled by the driver or HLM. Once filled, these have an + ! intent(in) status. Each site has a derived type structure, which may include + ! a scalar for site level data, a patch vector, potentially cohort vectors (but + ! not yet atm) and other dimensions such as soil-depth or pft. These vectors + ! are initialized by maximums, and the allocations are static in time to avoid + ! having to allocate/de-allocate memory + + type(bc_in_type), allocatable :: bc_in(:) + + ! These are the boundary conditions that the FATES model returns to its HLM or + ! driver. It has the same allocation strategy and similar vector types. + + type(bc_out_type), allocatable :: bc_out(:) + + + ! These are parameter constants that FATES may need to provide a host model + ! We have other methods of reading in input parameters. Since these + ! are parameter constants, we don't need them allocated over every site,one + ! instance is fine. + + type(bc_pconst_type) :: bc_pconst + + + end type fates_interface_type + + + character(len=*), parameter :: sourcefile = & __FILE__ @@ -256,7 +294,8 @@ subroutine zero_bcs(fates,s) fates%bc_out(s)%litt_flux_lab_c_si(:) = 0._r8 case(prt_cnp_flex_allom_hyp) - fates%bc_in(s)%plant_n_uptake_flux(:,:) = 0._r8 + fates%bc_in(s)%plant_nh4_uptake_flux(:,:) = 0._r8 + fates%bc_in(s)%plant_no3_uptake_flux(:,:) = 0._r8 fates%bc_in(s)%plant_p_uptake_flux(:,:) = 0._r8 fates%bc_out(s)%source_p(:) = 0._r8 fates%bc_out(s)%source_nh4(:) = 0._r8 @@ -306,7 +345,7 @@ subroutine zero_bcs(fates,s) fates%bc_out(s)%qflx_ro_sisl(:) = 0.0_r8 end if fates%bc_out(s)%plant_stored_h2o_si = 0.0_r8 - + return end subroutine zero_bcs @@ -383,14 +422,17 @@ subroutine allocate_bcin(bc_in, nlevsoil_in, nlevdecomp_in, num_lu_harvest_cats) if (hlm_parteh_mode .eq. prt_cnp_flex_allom_hyp) then if(fates_np_comp_scaling.eq.cohort_np_comp_scaling) then - allocate(bc_in%plant_n_uptake_flux(max_comp_per_site,1)) + allocate(bc_in%plant_nh4_uptake_flux(max_comp_per_site,1)) + allocate(bc_in%plant_no3_uptake_flux(max_comp_per_site,1)) allocate(bc_in%plant_p_uptake_flux(max_comp_per_site,1)) else - allocate(bc_in%plant_n_uptake_flux(max_comp_per_site,bc_in%nlevdecomp)) + allocate(bc_in%plant_nh4_uptake_flux(max_comp_per_site,bc_in%nlevdecomp)) + allocate(bc_in%plant_no3_uptake_flux(max_comp_per_site,bc_in%nlevdecomp)) allocate(bc_in%plant_p_uptake_flux(max_comp_per_site,bc_in%nlevdecomp)) end if else - allocate(bc_in%plant_n_uptake_flux(1,1)) + allocate(bc_in%plant_nh4_uptake_flux(1,1)) + allocate(bc_in%plant_no3_uptake_flux(1,1)) allocate(bc_in%plant_p_uptake_flux(1,1)) end if @@ -540,7 +582,23 @@ subroutine allocate_bcout(bc_out, nlevsoil_in, nlevdecomp_in) allocate(bc_out%cp_scalar(max_comp_per_site)) end if - + ! Include the bare-ground patch for these patch-level boundary conditions + ! (it will always be zero for all of these) + if(hlm_use_ch4.eq.itrue) then + allocate(bc_out%annavg_agnpp_pa(0:maxPatchesPerSite));bc_out%annavg_agnpp_pa(:)=nan + allocate(bc_out%annavg_bgnpp_pa(0:maxPatchesPerSite));bc_out%annavg_bgnpp_pa(:)=nan + allocate(bc_out%annsum_npp_pa(0:maxPatchesPerSite));bc_out%annsum_npp_pa(:)=nan + allocate(bc_out%frootc_pa(0:maxPatchesPerSite));bc_out%frootc_pa(:)=nan + allocate(bc_out%root_resp(nlevsoil_in));bc_out%root_resp(:)=nan + allocate(bc_out%woody_frac_aere_pa(0:maxPatchesPerSite));bc_out%woody_frac_aere_pa(:)=nan + allocate(bc_out%rootfr_pa(0:maxPatchesPerSite,nlevsoil_in)) + bc_out%rootfr_pa(:,:)=nan + + ! Give the bare-ground root fractions a nominal fraction of unity over depth + bc_out%rootfr_pa(0,1:nlevsoil_in)=1._r8/real(nlevsoil_in,r8) + end if + + ! Fates -> BGC fragmentation mass fluxes select case(hlm_parteh_mode) case(prt_carbon_allom_hyp) @@ -1159,6 +1217,7 @@ subroutine set_fates_ctrlparms(tag,ival,rval,cval) hlm_nitrogen_spec = unset_int hlm_phosphorus_spec = unset_int hlm_max_patch_per_site = unset_int + hlm_use_ch4 = unset_int hlm_use_vertsoilc = unset_int hlm_parteh_mode = unset_int hlm_spitfire_mode = unset_int @@ -1397,6 +1456,13 @@ subroutine set_fates_ctrlparms(tag,ival,rval,cval) call endrun(msg=errMsg(sourcefile, __LINE__)) end if + if(hlm_use_ch4 .eq. unset_int) then + if (fates_global_verbose()) then + write(fates_log(), *) 'switch for the HLMs CH4 module unset: hlm_use_ch4, exiting' + end if + call endrun(msg=errMsg(sourcefile, __LINE__)) + end if + if(hlm_use_vertsoilc .eq. unset_int) then if (fates_global_verbose()) then write(fates_log(), *) 'switch for the HLMs soil carbon discretization unset: hlm_use_vertsoilc, exiting' @@ -1539,6 +1605,12 @@ subroutine set_fates_ctrlparms(tag,ival,rval,cval) write(fates_log(),*) 'Transfering hlm_max_patch_per_site = ',ival,' to FATES' end if + case('use_ch4') + hlm_use_ch4 = ival + if (fates_global_verbose()) then + write(fates_log(),*) 'Transfering hlm_use_ch4 = ',ival,' to FATES' + end if + case('use_vertsoilc') hlm_use_vertsoilc = ival if (fates_global_verbose()) then @@ -1717,9 +1789,12 @@ subroutine FatesReportParameters(masterproc) call FatesReportPFTParams(masterproc) call FatesReportParams(masterproc) call FatesCheckParams(masterproc) ! Check general fates parameters + call PRTDerivedParams() ! Update PARTEH derived constants call PRTCheckParams(masterproc) ! Check PARTEH parameters call SpitFireCheckParams(masterproc) + + return end subroutine FatesReportParameters diff --git a/main/FatesInterfaceTypesMod.F90 b/main/FatesInterfaceTypesMod.F90 index 5b069709cc..1052ef251e 100644 --- a/main/FatesInterfaceTypesMod.F90 +++ b/main/FatesInterfaceTypesMod.F90 @@ -7,7 +7,6 @@ module FatesInterfaceTypesMod use FatesGlobals , only : endrun => fates_endrun use shr_log_mod , only : errMsg => shr_log_errMsg use shr_infnan_mod , only : nan => shr_infnan_nan, assignment(=) - use EDTypesMod , only : ed_site_type implicit none @@ -101,6 +100,10 @@ module FatesInterfaceTypesMod ! Transport (exensible) Hypothesis (PARTEH) to use + integer, public :: hlm_use_ch4 ! This flag signals whether the methane model in ELM/CLM is + ! active, and therefore whether or not boundary conditions + ! need to be prepped + integer, public :: hlm_use_vertsoilc ! This flag signals whether or not the ! host model is using vertically discretized ! soil carbon @@ -377,8 +380,12 @@ module FatesInterfaceTypesMod ! Note 1: If these are indexed by COHORT, they don't also need to be indexed ! by decomposition layer. So it is allocated with 2nd dim=1. ! Note 2: Has it's own zero'ing call - real(r8), pointer :: plant_n_uptake_flux(:,:) ! Nitrogen input flux for + real(r8), pointer :: plant_nh4_uptake_flux(:,:) ! Ammonium uptake flux for + ! each competitor [gN/m2/day] + + real(r8), pointer :: plant_no3_uptake_flux(:,:) ! Nitrate uptake flux for ! each competitor [gN/m2/day] + real(r8), pointer :: plant_p_uptake_flux(:,:) ! Phosphorus input flux for ! each competitor [gP/m2/day] @@ -618,7 +625,7 @@ module FatesInterfaceTypesMod - ! CTC/RD Nutrient Boundary Conditions + ! RD Nutrient Boundary Conditions ! --------------------------------------------------------------------------------- real(r8), pointer :: n_demand(:) ! Nitrogen demand from each competitor @@ -627,8 +634,16 @@ module FatesInterfaceTypesMod ! for use in ELMs CTC/RD [g/m2/s] - - + ! CH4 Boundary Conditions + ! ----------------------------------------------------------------------------------- + real(r8), pointer :: annavg_agnpp_pa(:) ! annual average patch npp above ground (gC/m2/s) + real(r8), pointer :: annavg_bgnpp_pa(:) ! annual average patch npp below ground (gC/m2/s) + real(r8), pointer :: annsum_npp_pa(:) ! annual sum patch npp (gC/m2/yr) + real(r8), pointer :: frootc_pa(:) ! Carbon in fine roots (gC/m2) + real(r8), pointer :: root_resp(:) ! (gC/m2/s) root respiration (fine root MR + total root GR) + real(r8), pointer :: rootfr_pa(:,:) ! Rooting fraction with depth + real(r8), pointer :: woody_frac_aere_pa(:) ! Woody plant fraction (by crown area) of all plants + ! used for calculating patch-level aerenchyma porosity ! Canopy Structure @@ -707,43 +722,7 @@ module FatesInterfaceTypesMod ! increasing, or all 1s) end type bc_pconst_type - - - type, public :: fates_interface_type - - ! This is the root of the ED/FATES hierarchy of instantaneous state variables - ! ie the root of the linked lists. Each path list is currently associated with a - ! grid-cell, this is intended to be migrated to columns - - integer :: nsites - - type(ed_site_type), pointer :: sites(:) - - ! These are boundary conditions that the FATES models are required to be filled. - ! These values are filled by the driver or HLM. Once filled, these have an - ! intent(in) status. Each site has a derived type structure, which may include - ! a scalar for site level data, a patch vector, potentially cohort vectors (but - ! not yet atm) and other dimensions such as soil-depth or pft. These vectors - ! are initialized by maximums, and the allocations are static in time to avoid - ! having to allocate/de-allocate memory - - type(bc_in_type), allocatable :: bc_in(:) - - ! These are the boundary conditions that the FATES model returns to its HLM or - ! driver. It has the same allocation strategy and similar vector types. - - type(bc_out_type), allocatable :: bc_out(:) - - - ! These are parameter constants that FATES may need to provide a host model - ! We have other methods of reading in input parameters. Since these - ! are parameter constants, we don't need them allocated over every site,one - ! instance is fine. - - type(bc_pconst_type) :: bc_pconst - - - end type fates_interface_type + contains diff --git a/main/FatesInventoryInitMod.F90 b/main/FatesInventoryInitMod.F90 index 74d88d7e9b..efdebb8708 100644 --- a/main/FatesInventoryInitMod.F90 +++ b/main/FatesInventoryInitMod.F90 @@ -62,7 +62,8 @@ module FatesInventoryInitMod use PRTGenericMod, only : phosphorus_element use PRTGenericMod, only : SetState use FatesConstantsMod, only : primaryforest - + use PRTGenericMod, only : StorageNutrientTarget + implicit none private @@ -1086,21 +1087,49 @@ subroutine set_inventory_edcohort_type1(csite,bc_in,css_file_unit,npatches, & case(nitrogen_element) - m_struct = c_struct*prt_params%nitr_stoich_p1(temp_cohort%pft,struct_organ) - m_leaf = c_leaf*prt_params%nitr_stoich_p1(temp_cohort%pft,leaf_organ) - m_fnrt = c_fnrt*prt_params%nitr_stoich_p1(temp_cohort%pft,fnrt_organ) - m_sapw = c_sapw*prt_params%nitr_stoich_p1(temp_cohort%pft,sapw_organ) - m_store = c_store*prt_params%nitr_stoich_p1(temp_cohort%pft,store_organ) + ! For inventory runs, initialize nutrient contents half way between max and min stoichiometries + m_struct = c_struct * 0.5_r8 * & + (prt_params%nitr_stoich_p1(temp_cohort%pft,prt_params%organ_param_id(struct_organ)) + & + prt_params%nitr_stoich_p2(temp_cohort%pft,prt_params%organ_param_id(struct_organ))) + + m_leaf = c_leaf * 0.5_r8 * & + (prt_params%nitr_stoich_p1(temp_cohort%pft,prt_params%organ_param_id(leaf_organ)) + & + prt_params%nitr_stoich_p2(temp_cohort%pft,prt_params%organ_param_id(leaf_organ))) + + m_fnrt = c_fnrt * 0.5_r8 * & + (prt_params%nitr_stoich_p1(temp_cohort%pft,prt_params%organ_param_id(fnrt_organ)) + & + prt_params%nitr_stoich_p2(temp_cohort%pft,prt_params%organ_param_id(fnrt_organ))) + + m_sapw = c_sapw * 0.5_r8 * & + (prt_params%nitr_stoich_p1(temp_cohort%pft,prt_params%organ_param_id(sapw_organ)) + & + prt_params%nitr_stoich_p2(temp_cohort%pft,prt_params%organ_param_id(sapw_organ))) + m_repro = 0._r8 + m_store = StorageNutrientTarget(temp_cohort%pft, element_id, m_leaf, m_fnrt, m_sapw, m_struct) + case(phosphorus_element) + + m_struct = c_struct * 0.5_r8 * & + (prt_params%phos_stoich_p1(temp_cohort%pft,prt_params%organ_param_id(struct_organ)) + & + prt_params%phos_stoich_p2(temp_cohort%pft,prt_params%organ_param_id(struct_organ))) + + m_leaf = c_leaf * 0.5_r8 * & + (prt_params%phos_stoich_p1(temp_cohort%pft,prt_params%organ_param_id(leaf_organ)) + & + prt_params%phos_stoich_p2(temp_cohort%pft,prt_params%organ_param_id(leaf_organ))) + + m_fnrt = c_fnrt * 0.5_r8 * & + (prt_params%phos_stoich_p1(temp_cohort%pft,prt_params%organ_param_id(fnrt_organ)) + & + prt_params%phos_stoich_p2(temp_cohort%pft,prt_params%organ_param_id(fnrt_organ))) + + m_sapw = c_sapw * 0.5_r8 * & + (prt_params%phos_stoich_p1(temp_cohort%pft,prt_params%organ_param_id(sapw_organ)) + & + prt_params%phos_stoich_p2(temp_cohort%pft,prt_params%organ_param_id(sapw_organ))) - m_struct = c_struct*prt_params%phos_stoich_p1(temp_cohort%pft,struct_organ) - m_leaf = c_leaf*prt_params%phos_stoich_p1(temp_cohort%pft,leaf_organ) - m_fnrt = c_fnrt*prt_params%phos_stoich_p1(temp_cohort%pft,fnrt_organ) - m_sapw = c_sapw*prt_params%phos_stoich_p1(temp_cohort%pft,sapw_organ) - m_store = c_store*prt_params%phos_stoich_p1(temp_cohort%pft,store_organ) m_repro = 0._r8 + + m_store = StorageNutrientTarget(temp_cohort%pft, element_id, m_leaf, m_fnrt, m_sapw, m_struct) + end select select case(hlm_parteh_mode) diff --git a/main/FatesParametersInterface.F90 b/main/FatesParametersInterface.F90 index ebaad3fa7c..f69d4ef5bf 100644 --- a/main/FatesParametersInterface.F90 +++ b/main/FatesParametersInterface.F90 @@ -35,6 +35,7 @@ module FatesParametersInterface character(len=*), parameter, public :: dimension_name_history_age_bins = 'fates_history_age_bins' character(len=*), parameter, public :: dimension_name_history_height_bins = 'fates_history_height_bins' character(len=*), parameter, public :: dimension_name_history_coage_bins = 'fates_history_coage_bins' + character(len=*), parameter, public :: dimension_name_hlm_pftno = 'fates_hlm_pftno' ! Dimensions in the host namespace: character(len=*), parameter, public :: dimension_name_host_allpfts = 'allpfts' diff --git a/main/FatesRestartInterfaceMod.F90 b/main/FatesRestartInterfaceMod.F90 index 0b621dec0a..7ae00ed0b2 100644 --- a/main/FatesRestartInterfaceMod.F90 +++ b/main/FatesRestartInterfaceMod.F90 @@ -86,6 +86,7 @@ module FatesRestartInterfaceMod integer :: ir_dleafoffdate_si integer :: ir_acc_ni_si integer :: ir_gdd_si + integer :: ir_snow_depth_si integer :: ir_trunk_product_si integer :: ir_ncohort_pa integer :: ir_canopy_layer_co @@ -114,7 +115,8 @@ module FatesRestartInterfaceMod integer :: ir_smort_co integer :: ir_asmort_co - integer :: ir_daily_n_uptake_co + integer :: ir_daily_nh4_uptake_co + integer :: ir_daily_no3_uptake_co integer :: ir_daily_p_uptake_co integer :: ir_daily_c_efflux_co integer :: ir_daily_n_efflux_co @@ -149,6 +151,8 @@ module FatesRestartInterfaceMod integer :: ir_fnrt_litt integer :: ir_seed_litt integer :: ir_seedgerm_litt + integer :: ir_seed_decay_litt + integer :: ir_seedgerm_decay_litt integer :: ir_seed_prod_co integer :: ir_livegrass_pa integer :: ir_age_pa @@ -205,14 +209,11 @@ module FatesRestartInterfaceMod integer :: ir_hydro_th_troot integer :: ir_hydro_th_aroot_covec integer :: ir_hydro_liqvol_shell_si - integer :: ir_hydro_err_growturn_aroot - integer :: ir_hydro_err_growturn_ag_covec - integer :: ir_hydro_err_growturn_troot integer :: ir_hydro_recruit_si integer :: ir_hydro_dead_si integer :: ir_hydro_growturn_err_si - integer :: ir_hydro_pheno_err_si integer :: ir_hydro_hydro_err_si + integer :: ir_hydro_errh2o ! The number of variable dim/kind types we have defined (static) integer, parameter, public :: fates_restart_num_dimensions = 2 !(cohort,column) @@ -622,6 +623,10 @@ subroutine define_restart_vars(this, initialize_variables) long_name='growing degree days at each site', units='degC days', flushval = flushzero, & hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_gdd_si ) + call this%set_restart_var(vname='fates_snow_depth_site', vtype=site_r8, & + long_name='average snow depth', units='m', flushval = flushzero, & + hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_snow_depth_si ) + call this%set_restart_var(vname='fates_trunk_product_site', vtype=site_r8, & long_name='Accumulate trunk product flux at site', & units='kgC/m2', flushval = flushzero, & @@ -756,10 +761,15 @@ subroutine define_restart_vars(this, initialize_variables) units='/year', flushval = flushzero, & hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_cmort_co ) - call this%set_restart_var(vname='fates_daily_n_uptake', vtype=cohort_r8, & - long_name='fates cohort- daily nitrogen uptake', & + call this%set_restart_var(vname='fates_daily_nh4_uptake', vtype=cohort_r8, & + long_name='fates cohort- daily ammonium [NH4] uptake', & + units='kg/plant/day', flushval = flushzero, & + hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_daily_nh4_uptake_co ) + + call this%set_restart_var(vname='fates_daily_no3_uptake', vtype=cohort_r8, & + long_name='fates cohort- daily ammonium [NO3] uptake', & units='kg/plant/day', flushval = flushzero, & - hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_daily_n_uptake_co ) + hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_daily_no3_uptake_co ) call this%set_restart_var(vname='fates_daily_p_uptake', vtype=cohort_r8, & long_name='fates cohort- daily phosphorus uptake', & @@ -936,6 +946,17 @@ subroutine define_restart_vars(this, initialize_variables) units='kg/m2', veclength=num_elements, flushval = flushzero, & hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_seedgerm_litt) + + call this%RegisterCohortVector(symbol_base='fates_seed_frag', vtype=cohort_r8, & + long_name_base='seed bank fragmentation flux (non-germinated)', & + units='kg/m2', veclength=num_elements, flushval = flushzero, & + hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_seed_decay_litt) + + call this%RegisterCohortVector(symbol_base='fates_seedgerm_frag', vtype=cohort_r8, & + long_name_base='seed bank fragmentation flux (germinated)', & + units='kg/m2', veclength=num_elements, flushval = flushzero, & + hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_seedgerm_decay_litt) + call this%RegisterCohortVector(symbol_base='fates_ag_cwd_frag', vtype=cohort_r8, & long_name_base='above ground CWD frag flux', & units='kg/m2/day', veclength=num_elements, flushval = flushzero, & @@ -1035,21 +1056,6 @@ subroutine define_restart_vars(this, initialize_variables) units='kg/plant', veclength=nlevsoi_hyd_max, flushval = flushzero, & hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_hydro_th_aroot_covec) - call this%RegisterCohortVector(symbol_base='fates_hydro_err_aroot', vtype=cohort_r8, & - long_name_base='error in plant-hydro balance in absorbing roots', & - units='kg/plant', veclength=nlevsoi_hyd_max, flushval = flushzero, & - hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_hydro_err_growturn_aroot) - - call this%RegisterCohortVector(symbol_base='fates_hydro_err_ag', vtype=cohort_r8, & - long_name_base='error in plant-hydro balance above ground', & - units='kg/plant', veclength=n_hypool_ag, flushval = flushzero, & - hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_hydro_err_growturn_ag_covec) - - call this%RegisterCohortVector(symbol_base='fates_hydro_err_troot', vtype=cohort_r8, & - long_name_base='error in plant-hydro balance above ground', & - units='kg/plant', veclength=n_hypool_troot, flushval = flushzero, & - hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_hydro_err_growturn_troot) - ! Site-level volumentric liquid water content (shell x layer) call this%set_restart_var(vname='fates_hydro_liqvol_shell', vtype=cohort_r8, & long_name='Volumetric water content of rhizosphere compartments (layerxshell)', & @@ -1074,17 +1080,17 @@ subroutine define_restart_vars(this, initialize_variables) units='kg', flushval = flushzero, & hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_hydro_growturn_err_si ) - ! Site-level water balance error due to phenology? - call this%set_restart_var(vname='fates_hydro_pheno_err', vtype=site_r8, & - long_name='Site level error for hydraulics due to phenology', & - units='kg', flushval = flushzero, & - hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_hydro_pheno_err_si ) - ! Site-level water balance error in vegetation call this%set_restart_var(vname='fates_hydro_hydro_err', vtype=site_r8, & long_name='Site level error for hydrodynamics', & units='kg', flushval = flushzero, & hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_hydro_hydro_err_si ) + + call this%set_restart_var(vname='fates_errh2o', vtype=cohort_r8, & + long_name='ed cohort - running plant h2o error for hydro', & + units='kg/indiv', flushval = flushzero, & + hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_hydro_errh2o ) + end if @@ -1600,6 +1606,7 @@ subroutine set_restart_vectors(this,nc,nsites,sites) rio_dleafoffdate_si => this%rvars(ir_dleafoffdate_si)%int1d, & rio_acc_ni_si => this%rvars(ir_acc_ni_si)%r81d, & rio_gdd_si => this%rvars(ir_gdd_si)%r81d, & + rio_snow_depth_si => this%rvars(ir_snow_depth_si)%r81d, & rio_trunk_product_si => this%rvars(ir_trunk_product_si)%r81d, & rio_ncohort_pa => this%rvars(ir_ncohort_pa)%int1d, & rio_solar_zenith_flag_pa => this%rvars(ir_solar_zenith_flag_pa)%int1d, & @@ -1627,7 +1634,8 @@ subroutine set_restart_vectors(this,nc,nsites,sites) rio_bmort_co => this%rvars(ir_bmort_co)%r81d, & rio_hmort_co => this%rvars(ir_hmort_co)%r81d, & rio_cmort_co => this%rvars(ir_cmort_co)%r81d, & - rio_daily_n_uptake_co => this%rvars(ir_daily_n_uptake_co)%r81d, & + rio_daily_nh4_uptake_co => this%rvars(ir_daily_nh4_uptake_co)%r81d, & + rio_daily_no3_uptake_co => this%rvars(ir_daily_no3_uptake_co)%r81d, & rio_daily_p_uptake_co => this%rvars(ir_daily_p_uptake_co)%r81d, & rio_daily_c_efflux_co => this%rvars(ir_daily_c_efflux_co)%r81d, & rio_daily_n_efflux_co => this%rvars(ir_daily_n_efflux_co)%r81d, & @@ -1827,17 +1835,7 @@ subroutine set_restart_vectors(this,nc,nsites,sites) this%rvars(ir_hydro_th_troot)%r81d(io_idx_co) = ccohort%co_hydr%th_troot - ! Load the error terms - call this%setCohortRealVector(ccohort%co_hydr%errh2o_growturn_ag, & - n_hypool_ag, & - ir_hydro_err_growturn_ag_covec,io_idx_co) - - this%rvars(ir_hydro_err_growturn_aroot)%r81d(io_idx_co) = & - ccohort%co_hydr%errh2o_growturn_aroot - - this%rvars(ir_hydro_err_growturn_troot)%r81d(io_idx_co) = & - ccohort%co_hydr%errh2o_growturn_troot - + this%rvars(ir_hydro_errh2o)%r81d(io_idx_co) = ccohort%co_hydr%errh2o end if @@ -1872,7 +1870,8 @@ subroutine set_restart_vectors(this,nc,nsites,sites) rio_frmort_co(io_idx_co) = ccohort%frmort ! Nutrient uptake/efflux - rio_daily_n_uptake_co(io_idx_co) = ccohort%daily_n_uptake + rio_daily_no3_uptake_co(io_idx_co) = ccohort%daily_no3_uptake + rio_daily_nh4_uptake_co(io_idx_co) = ccohort%daily_nh4_uptake rio_daily_p_uptake_co(io_idx_co) = ccohort%daily_p_uptake rio_daily_c_efflux_co(io_idx_co) = ccohort%daily_c_efflux @@ -1881,8 +1880,8 @@ subroutine set_restart_vectors(this,nc,nsites,sites) rio_daily_n_demand_co(io_idx_co) = ccohort%daily_n_demand rio_daily_p_demand_co(io_idx_co) = ccohort%daily_p_demand - rio_daily_n_need_co(io_idx_co) = ccohort%daily_n_need2 - rio_daily_p_need_co(io_idx_co) = ccohort%daily_p_need2 + rio_daily_n_need_co(io_idx_co) = ccohort%daily_n_need + rio_daily_p_need_co(io_idx_co) = ccohort%daily_p_need !Logging rio_lmort_direct_co(io_idx_co) = ccohort%lmort_direct @@ -1954,6 +1953,8 @@ subroutine set_restart_vectors(this,nc,nsites,sites) do i = 1,numpft this%rvars(ir_seed_litt+el)%r81d(io_idx_pa_pft) = litt%seed(i) this%rvars(ir_seedgerm_litt+el)%r81d(io_idx_pa_pft) = litt%seed_germ(i) + this%rvars(ir_seed_decay_litt+el)%r81d(io_idx_pa_pft) = litt%seed_decay(i) + this%rvars(ir_seedgerm_decay_litt+el)%r81d(io_idx_pa_pft) = litt%seed_germ_decay(i) io_idx_pa_pft = io_idx_pa_pft + 1 end do @@ -2052,6 +2053,7 @@ subroutine set_restart_vectors(this,nc,nsites,sites) rio_dleafoffdate_si(io_idx_si) = sites(s)%dleafoffdate rio_acc_ni_si(io_idx_si) = sites(s)%acc_NI rio_gdd_si(io_idx_si) = sites(s)%grow_deg_days + rio_snow_depth_si(io_idx_si) = sites(s)%snow_depth ! Accumulated trunk product rio_trunk_product_si(io_idx_si) = sites(s)%resources_management%trunk_product_site @@ -2081,7 +2083,6 @@ subroutine set_restart_vectors(this,nc,nsites,sites) this%rvars(ir_hydro_recruit_si)%r81d(io_idx_si) = sites(s)%si_hydr%h2oveg_recruit this%rvars(ir_hydro_dead_si)%r81d(io_idx_si) = sites(s)%si_hydr%h2oveg_dead this%rvars(ir_hydro_growturn_err_si)%r81d(io_idx_si) = sites(s)%si_hydr%h2oveg_growturn_err - this%rvars(ir_hydro_pheno_err_si)%r81d(io_idx_si) = sites(s)%si_hydr%h2oveg_pheno_err this%rvars(ir_hydro_hydro_err_si)%r81d(io_idx_si) = sites(s)%si_hydr%h2oveg_hydro_err ! Hydraulics counters lyr = hydraulic layer, shell = rhizosphere shell @@ -2107,7 +2108,7 @@ end subroutine set_restart_vectors ! ==================================================================================== - subroutine create_patchcohort_structure(this, nc, nsites, sites, bc_in) + subroutine create_patchcohort_structure(this, nc, nsites, sites, bc_in, bc_out) ! ---------------------------------------------------------------------------------- ! This subroutine takes a peak at the restart file to determine how to allocate @@ -2137,7 +2138,8 @@ subroutine create_patchcohort_structure(this, nc, nsites, sites, bc_in) integer , intent(in) :: nc integer , intent(in) :: nsites type(ed_site_type) , intent(inout), target :: sites(nsites) - type(bc_in_type) , intent(in) :: bc_in(nsites) + type(bc_in_type) :: bc_in(nsites) + type(bc_out_type) :: bc_out(nsites) ! local variables @@ -2169,7 +2171,7 @@ subroutine create_patchcohort_structure(this, nc, nsites, sites, bc_in) io_idx_si = this%restart_map(nc)%site_index(s) io_idx_co_1st = this%restart_map(nc)%cohort1_index(s) - call init_site_vars( sites(s), bc_in(s) ) + call init_site_vars( sites(s), bc_in(s), bc_out(s) ) call zero_site( sites(s) ) if ( rio_npatch_si(io_idx_si)<0 .or. rio_npatch_si(io_idx_si) > 10000 ) then @@ -2388,6 +2390,7 @@ subroutine get_restart_vectors(this, nc, nsites, sites) rio_dleafoffdate_si => this%rvars(ir_dleafoffdate_si)%int1d, & rio_acc_ni_si => this%rvars(ir_acc_ni_si)%r81d, & rio_gdd_si => this%rvars(ir_gdd_si)%r81d, & + rio_snow_depth_si => this%rvars(ir_snow_depth_si)%r81d, & rio_trunk_product_si => this%rvars(ir_trunk_product_si)%r81d, & rio_ncohort_pa => this%rvars(ir_ncohort_pa)%int1d, & rio_solar_zenith_flag_pa => this%rvars(ir_solar_zenith_flag_pa)%int1d, & @@ -2415,7 +2418,8 @@ subroutine get_restart_vectors(this, nc, nsites, sites) rio_bmort_co => this%rvars(ir_bmort_co)%r81d, & rio_hmort_co => this%rvars(ir_hmort_co)%r81d, & rio_cmort_co => this%rvars(ir_cmort_co)%r81d, & - rio_daily_n_uptake_co => this%rvars(ir_daily_n_uptake_co)%r81d, & + rio_daily_nh4_uptake_co => this%rvars(ir_daily_nh4_uptake_co)%r81d, & + rio_daily_no3_uptake_co => this%rvars(ir_daily_no3_uptake_co)%r81d, & rio_daily_p_uptake_co => this%rvars(ir_daily_p_uptake_co)%r81d, & rio_daily_c_efflux_co => this%rvars(ir_daily_c_efflux_co)%r81d, & rio_daily_n_efflux_co => this%rvars(ir_daily_n_efflux_co)%r81d, & @@ -2620,7 +2624,8 @@ subroutine get_restart_vectors(this, nc, nsites, sites) ccohort%frmort = rio_frmort_co(io_idx_co) ! Nutrient uptake / efflux - ccohort%daily_n_uptake = rio_daily_n_uptake_co(io_idx_co) + ccohort%daily_nh4_uptake = rio_daily_nh4_uptake_co(io_idx_co) + ccohort%daily_no3_uptake = rio_daily_no3_uptake_co(io_idx_co) ccohort%daily_p_uptake = rio_daily_p_uptake_co(io_idx_co) ccohort%daily_c_efflux = rio_daily_c_efflux_co(io_idx_co) ccohort%daily_n_efflux = rio_daily_n_efflux_co(io_idx_co) @@ -2628,8 +2633,8 @@ subroutine get_restart_vectors(this, nc, nsites, sites) ccohort%daily_n_demand = rio_daily_n_demand_co(io_idx_co) ccohort%daily_p_demand = rio_daily_p_demand_co(io_idx_co) - ccohort%daily_n_need2 = rio_daily_n_need_co(io_idx_co) - ccohort%daily_p_need2 = rio_daily_p_need_co(io_idx_co) + ccohort%daily_n_need = rio_daily_n_need_co(io_idx_co) + ccohort%daily_p_need = rio_daily_p_need_co(io_idx_co) !Logging ccohort%lmort_direct = rio_lmort_direct_co(io_idx_co) @@ -2656,18 +2661,10 @@ subroutine get_restart_vectors(this, nc, nsites, sites) ir_hydro_th_aroot_covec,io_idx_co) ccohort%co_hydr%th_troot = this%rvars(ir_hydro_th_troot)%r81d(io_idx_co) - + ccohort%co_hydr%errh2o = this%rvars(ir_hydro_errh2o)%r81d(io_idx_co) + call UpdatePlantPsiFTCFromTheta(ccohort,sites(s)%si_hydr) - - ccohort%co_hydr%errh2o_growturn_aroot = & - this%rvars(ir_hydro_err_growturn_aroot)%r81d(io_idx_co) - ccohort%co_hydr%errh2o_growturn_troot = & - this%rvars(ir_hydro_err_growturn_troot)%r81d(io_idx_co) - - call this%GetCohortRealVector(ccohort%co_hydr%errh2o_growturn_ag, & - n_hypool_ag, & - ir_hydro_err_growturn_ag_covec,io_idx_co) end if io_idx_co = io_idx_co + 1 @@ -2723,6 +2720,8 @@ subroutine get_restart_vectors(this, nc, nsites, sites) do i = 1,numpft litt%seed(i) = this%rvars(ir_seed_litt+el)%r81d(io_idx_pa_pft) litt%seed_germ(i) = this%rvars(ir_seedgerm_litt+el)%r81d(io_idx_pa_pft) + litt%seed_decay(i) = this%rvars(ir_seed_decay_litt+el)%r81d(io_idx_pa_pft) + litt%seed_germ_decay(i) = this%rvars(ir_seedgerm_decay_litt+el)%r81d(io_idx_pa_pft) io_idx_pa_pft = io_idx_pa_pft + 1 end do @@ -2807,7 +2806,6 @@ subroutine get_restart_vectors(this, nc, nsites, sites) sites(s)%si_hydr%h2oveg_recruit = this%rvars(ir_hydro_recruit_si)%r81d(io_idx_si) sites(s)%si_hydr%h2oveg_dead = this%rvars(ir_hydro_dead_si)%r81d(io_idx_si) sites(s)%si_hydr%h2oveg_growturn_err = this%rvars(ir_hydro_growturn_err_si)%r81d(io_idx_si) - sites(s)%si_hydr%h2oveg_pheno_err = this%rvars(ir_hydro_pheno_err_si)%r81d(io_idx_si) sites(s)%si_hydr%h2oveg_hydro_err = this%rvars(ir_hydro_hydro_err_si)%r81d(io_idx_si) ! Hydraulics counters lyr = hydraulic layer, shell = rhizosphere shell @@ -2868,6 +2866,7 @@ subroutine get_restart_vectors(this, nc, nsites, sites) sites(s)%dleafoffdate = rio_dleafoffdate_si(io_idx_si) sites(s)%acc_NI = rio_acc_ni_si(io_idx_si) sites(s)%grow_deg_days = rio_gdd_si(io_idx_si) + sites(s)%snow_depth = rio_snow_depth_si(io_idx_si) sites(s)%resources_management%trunk_product_site = rio_trunk_product_si(io_idx_si) diff --git a/parameter_files/fates_params_default.cdl b/parameter_files/fates_params_default.cdl index b1ca374fa0..b92a63f35d 100644 --- a/parameter_files/fates_params_default.cdl +++ b/parameter_files/fates_params_default.cdl @@ -1,4 +1,4 @@ -netcdf fates_params_default { +netcdf fates_params_default.c210629_sorted { dimensions: fates_NCWD = 4 ; fates_history_age_bins = 7 ; @@ -9,8 +9,9 @@ dimensions: fates_leafage_class = 1 ; fates_litterclass = 6 ; fates_pft = 12 ; - fates_prt_organs = 6 ; + fates_prt_organs = 4 ; fates_string_length = 60 ; + fates_hlm_pftno = 14 ; variables: double fates_history_ageclass_bin_edges(fates_history_age_bins) ; fates_history_ageclass_bin_edges:units = "yr" ; @@ -24,12 +25,25 @@ variables: double fates_history_sizeclass_bin_edges(fates_history_size_bins) ; fates_history_sizeclass_bin_edges:units = "cm" ; fates_history_sizeclass_bin_edges:long_name = "Lower edges for DBH size class bins used in size-resolved cohort history output" ; + double fates_hydr_htftype_node(fates_hydr_organs) ; + fates_hydr_htftype_node:units = "unitless" ; + fates_hydr_htftype_node:long_name = "Switch that defines the hydraulic transfer functions for each organ." ; + fates_hydr_htftype_node:possible_values = "1: Christofferson et al. 2016 (TFS); 2: Van Genuchten 1980" ; + double fates_prt_organ_id(fates_prt_organs) ; + fates_prt_organ_id:units = "index, unitless" ; + fates_prt_organ_id:long_name = "This is the global index the organ in this file is associated with in PRTGenericMod.F90" ; char fates_pftname(fates_pft, fates_string_length) ; fates_pftname:units = "unitless - string" ; fates_pftname:long_name = "Description of plant type" ; + char fates_hydr_organname_node(fates_hydr_organs, fates_string_length) ; + fates_hydr_organname_node:units = "unitless - string" ; + fates_hydr_organname_node:long_name = "Name of plant hydraulics organs (DONT CHANGE, order matches media list in FatesHydraulicsMemMod.F90)" ; + char fates_litterclass_name(fates_litterclass, fates_string_length) ; + fates_litterclass_name:units = "unitless - string" ; + fates_litterclass_name:long_name = "Name of the litter classes, for variables associated with dimension fates_litterclass" ; char fates_prt_organ_name(fates_prt_organs, fates_string_length) ; fates_prt_organ_name:units = "unitless - string" ; - fates_prt_organ_name:long_name = "Plant organ name (order must match PRTGenericMod.F90)" ; + fates_prt_organ_name:long_name = "Name of plant organs (order must match PRTGenericMod.F90)" ; double fates_alloc_storage_cushion(fates_pft) ; fates_alloc_storage_cushion:units = "fraction" ; fates_alloc_storage_cushion:long_name = "maximum size of storage C pool, relative to maximum size of leaf C pool" ; @@ -121,27 +135,30 @@ variables: fates_allom_stmode:units = "index" ; fates_allom_stmode:long_name = "storage allometry function index." ; fates_allom_stmode:possible_values = "1: target storage proportional to trimmed maximum leaf biomass." ; - double fates_allom_dbh_max(fates_pft) ; - fates_allom_dbh_max:units = "cm" ; - fates_allom_dbh_max:long_name = "maximum possible dbh of a PFT" ; - double fates_allom_dbh_0(fates_pft) ; - fates_allom_dbh_0:units = "cm" ; - fates_allom_dbh_0:long_name = "dbh of the smallest cohort of a PFT " ; - double fates_allom_zfr_max(fates_pft) ; - fates_allom_zfr_max:units = "m" ; - fates_allom_zfr_max:long_name = "maximum rooting depth of a PFT" ; - double fates_allom_zfr_0(fates_pft) ; - fates_allom_zfr_0:units = "m" ; - fates_allom_zfr_0:long_name = "rooting depth of sappling of recuitment" ; - double fates_allom_frk(fates_pft) ; - fates_allom_frk:units = "unitless" ; - fates_allom_frk:long_name = "scale coefficient of logistic cohort rooting depth model" ; + double fates_allom_zroot_k(fates_pft) ; + fates_allom_zroot_k:units = "unitless" ; + fates_allom_zroot_k:long_name = "scale coefficient of logistic rooting depth model" ; + double fates_allom_zroot_max_dbh(fates_pft) ; + fates_allom_zroot_max_dbh:units = "cm" ; + fates_allom_zroot_max_dbh:long_name = "dbh at which a plant reaches the maximum value for its maximum rooting depth" ; + double fates_allom_zroot_max_z(fates_pft) ; + fates_allom_zroot_max_z:units = "m" ; + fates_allom_zroot_max_z:long_name = "the maximum rooting depth defined at dbh = fates_allom_zroot_max_dbh. note: max_z=min_z=large, sets rooting depth to soil depth" ; + double fates_allom_zroot_min_dbh(fates_pft) ; + fates_allom_zroot_min_dbh:units = "cm" ; + fates_allom_zroot_min_dbh:long_name = "dbh at which the maximum rooting depth for a recruit is defined" ; + double fates_allom_zroot_min_z(fates_pft) ; + fates_allom_zroot_min_z:units = "m" ; + fates_allom_zroot_min_z:long_name = "the maximum rooting depth defined at dbh = fates_allom_zroot_min_dbh. note: max_z=min_z=large, sets rooting depth to soil depth" ; double fates_branch_turnover(fates_pft) ; fates_branch_turnover:units = "yr" ; fates_branch_turnover:long_name = "turnover time of branches" ; double fates_c2b(fates_pft) ; fates_c2b:units = "ratio" ; fates_c2b:long_name = "Carbon to biomass multiplier of bulk structural tissues" ; + double fates_dev_arbitrary_pft(fates_pft) ; + fates_dev_arbitrary_pft:units = "unknown" ; + fates_dev_arbitrary_pft:long_name = "Unassociated pft dimensioned free parameter that developers can use for testing arbitrary new hypotheses" ; double fates_displar(fates_pft) ; fates_displar:units = "unitless" ; fates_displar:long_name = "Ratio of displacement height to canopy top height" ; @@ -179,7 +196,7 @@ variables: fates_eca_vmax_ptase:units = "gP/m2/s" ; fates_eca_vmax_ptase:long_name = "maximum production rate for biochemical P (per m2) (ECA)" ; double fates_fire_alpha_SH(fates_pft) ; - fates_fire_alpha_SH:units = "NA" ; + fates_fire_alpha_SH:units = "m / (kw/m)**(2/3)" ; fates_fire_alpha_SH:long_name = "spitfire parameter, alpha scorch height, Equation 16 Thonicke et al 2010" ; double fates_fire_bark_scaler(fates_pft) ; fates_fire_bark_scaler:units = "fraction" ; @@ -223,6 +240,10 @@ variables: double fates_hydr_fcap_node(fates_hydr_organs, fates_pft) ; fates_hydr_fcap_node:units = "unitless" ; fates_hydr_fcap_node:long_name = "fraction of non-residual water that is capillary in source" ; + double fates_hydr_k_lwp(fates_pft) ; + fates_hydr_k_lwp:units = "unitless" ; + fates_hydr_k_lwp:long_name = "inner leaf humidity scaling coefficient" ; + fates_hydr_k_lwp:possible_values = "0: turns off leaf humidity effects on conductance. 1-10 activates humidity effects" ; double fates_hydr_kmax_node(fates_hydr_organs, fates_pft) ; fates_hydr_kmax_node:units = "kg/MPa/m/s" ; fates_hydr_kmax_node:long_name = "maximum xylem conductivity per unit conducting xylem area" ; @@ -256,6 +277,15 @@ variables: double fates_hydr_thetas_node(fates_hydr_organs, fates_pft) ; fates_hydr_thetas_node:units = "cm3/cm3" ; fates_hydr_thetas_node:long_name = "saturated water content" ; + double fates_hydr_vg_alpha_node(fates_hydr_organs, fates_pft) ; + fates_hydr_vg_alpha_node:units = "MPa-1" ; + fates_hydr_vg_alpha_node:long_name = "(used if hydr_htftype_node = 2), capillary length parameter in van Genuchten model" ; + double fates_hydr_vg_m_node(fates_hydr_organs, fates_pft) ; + fates_hydr_vg_m_node:units = "unitless" ; + fates_hydr_vg_m_node:long_name = "(used if hydr_htftype_node = 2),m in van Genuchten 1980 model, 2nd pore size distribution parameter" ; + double fates_hydr_vg_n_node(fates_hydr_organs, fates_pft) ; + fates_hydr_vg_n_node:units = "unitless" ; + fates_hydr_vg_n_node:long_name = "(used if hydr_htftype_node = 2),n in van Genuchten 1980 model, pore size distribution parameter" ; double fates_leaf_c3psn(fates_pft) ; fates_leaf_c3psn:units = "flag" ; fates_leaf_c3psn:long_name = "Photosynthetic pathway (1=c3, 0=c4)" ; @@ -295,15 +325,6 @@ variables: double fates_leaf_stor_priority(fates_pft) ; fates_leaf_stor_priority:units = "unitless" ; fates_leaf_stor_priority:long_name = "factor governing priority of replacing storage with NPP" ; - double fates_leaf_tpuha(fates_pft) ; - fates_leaf_tpuha:units = "J/mol" ; - fates_leaf_tpuha:long_name = "activation energy for tpu" ; - double fates_leaf_tpuhd(fates_pft) ; - fates_leaf_tpuhd:units = "J/mol" ; - fates_leaf_tpuhd:long_name = "deactivation energy for tpu" ; - double fates_leaf_tpuse(fates_pft) ; - fates_leaf_tpuse:units = "J/mol/K" ; - fates_leaf_tpuse:long_name = "entropy term for tpu" ; double fates_leaf_vcmax25top(fates_leafage_class, fates_pft) ; fates_leaf_vcmax25top:units = "umol CO2/m^2/s" ; fates_leaf_vcmax25top:long_name = "maximum carboxylation rate of Rub. at 25C, canopy top" ; @@ -373,6 +394,9 @@ variables: double fates_nfix2(fates_pft) ; fates_nfix2:units = "NA" ; fates_nfix2:long_name = "place-holder for future n-fixation parameter (NOT IMPLEMENTED)" ; + double fates_nitr_store_ratio(fates_pft) ; + fates_nitr_store_ratio:units = "(gN/gN)" ; + fates_nitr_store_ratio:long_name = "ratio of storeable N, to functional N bound in cell structures of leaf,root,sap" ; double fates_phen_cold_size_threshold(fates_pft) ; fates_phen_cold_size_threshold:units = "cm" ; fates_phen_cold_size_threshold:long_name = "the dbh size above which will lead to phenology-related stem and leaf drop" ; @@ -391,6 +415,9 @@ variables: double fates_phenflush_fraction(fates_pft) ; fates_phenflush_fraction:units = "fraction" ; fates_phenflush_fraction:long_name = "Upon bud-burst, the maximum fraction of storage carbon used for flushing leaves" ; + double fates_phos_store_ratio(fates_pft) ; + fates_phos_store_ratio:units = "(gP/gP)" ; + fates_phos_store_ratio:long_name = "ratio of storeable P, to functional P bound in cell structures of leaf,root,sap" ; double fates_prescribed_mortality_canopy(fates_pft) ; fates_prescribed_mortality_canopy:units = "1/yr" ; fates_prescribed_mortality_canopy:long_name = "mortality rate of canopy trees for prescribed physiology mode" ; @@ -404,17 +431,17 @@ variables: fates_prescribed_npp_understory:units = "kgC / m^2 / yr" ; fates_prescribed_npp_understory:long_name = "NPP per unit crown area of understory trees for prescribed physiology mode" ; double fates_prescribed_nuptake(fates_pft) ; - fates_prescribed_nuptake:units = "fraction" ; - fates_prescribed_nuptake:long_name = "Nitrogen uptake flux as fraction of NPP demand. 0=fully coupled simulation" ; + fates_prescribed_nuptake:units = "fraction" ; + fates_prescribed_nuptake:long_name = "Prescribed N uptake flux. 0=fully coupled simulation >0=prescribed (experimental)" ; double fates_prescribed_puptake(fates_pft) ; - fates_prescribed_puptake:units = "fraction" ; - fates_prescribed_puptake:long_name = "Phosphorus uptake flux as fraction of NPP demand. 0=fully coupled simulation" ; + fates_prescribed_puptake:units = "fraction" ; + fates_prescribed_puptake:long_name = "Prescribed P uptake flux. 0=fully coupled simulation, >0=prescribed (experimental)" ; double fates_prescribed_recruitment(fates_pft) ; fates_prescribed_recruitment:units = "n/yr" ; fates_prescribed_recruitment:long_name = "recruitment rate for prescribed physiology mode" ; double fates_prt_alloc_priority(fates_prt_organs, fates_pft) ; fates_prt_alloc_priority:units = "index (0-fates_prt_organs)" ; - fates_prt_alloc_priority:long_name = "Priority order for allocation" ; + fates_prt_alloc_priority:long_name = "Priority order for allocation (C storage=2)" ; double fates_prt_nitr_stoich_p1(fates_prt_organs, fates_pft) ; fates_prt_nitr_stoich_p1:units = "(gN/gC)" ; fates_prt_nitr_stoich_p1:long_name = "nitrogen stoichiometry, parameter 1" ; @@ -515,9 +542,12 @@ variables: double fates_z0mr(fates_pft) ; fates_z0mr:units = "unitless" ; fates_z0mr:long_name = "Ratio of momentum roughness length to canopy top height" ; + double fates_hlm_pft_map(fates_hlm_pftno, fates_pft) ; + fates_hlm_pft_map:units = "area fraction" ; + fates_hlm_pft_map:long_name = "In fixed biogeog mode, fraction of HLM area associated with each FATES PFT" ; double fates_fire_FBD(fates_litterclass) ; - fates_fire_FBD:units = "NA" ; - fates_fire_FBD:long_name = "spitfire parameter related to fuel bulk density, see SFMain.F90" ; + fates_fire_FBD:units = "kg Biomass/m3" ; + fates_fire_FBD:long_name = "fuel bulk density" ; double fates_fire_low_moisture_Coeff(fates_litterclass) ; fates_fire_low_moisture_Coeff:units = "NA" ; fates_fire_low_moisture_Coeff:long_name = "spitfire parameter, equation B1 Thonicke et al 2010" ; @@ -537,8 +567,8 @@ variables: fates_fire_min_moisture:units = "NA" ; fates_fire_min_moisture:long_name = "spitfire litter moisture threshold to be considered very dry" ; double fates_fire_SAV(fates_litterclass) ; - fates_fire_SAV:units = "NA" ; - fates_fire_SAV:long_name = "spitfire parameter related to surface area to volume ratio, see SFMain.F90" ; + fates_fire_SAV:units = "cm-1" ; + fates_fire_SAV:long_name = "fuel surface area to volume ratio" ; double fates_max_decomp(fates_litterclass) ; fates_max_decomp:units = "yr-1" ; fates_max_decomp:long_name = "maximum rate of litter & CWD transfer from non-decomposing class into decomposing class" ; @@ -566,6 +596,9 @@ variables: double fates_cwd_flig ; fates_cwd_flig:units = "unitless" ; fates_cwd_flig:long_name = "Lignin fraction of coarse woody debris" ; + double fates_dev_arbitrary ; + fates_dev_arbitrary:units = "unknown" ; + fates_dev_arbitrary:long_name = "Unassociated free parameter that developers can use for testing arbitrary new hypotheses" ; double fates_eca_plant_escalar ; fates_eca_plant_escalar:units = "" ; fates_eca_plant_escalar:long_name = "scaling factor for plant fine root biomass to calculate nutrient carrier enzyme abundance (ECA)" ; @@ -656,6 +689,9 @@ variables: double fates_logging_mechanical_frac ; fates_logging_mechanical_frac:units = "fraction" ; fates_logging_mechanical_frac:long_name = "Fraction of stems killed due infrastructure an other mechanical means" ; + double fates_maintresp_model ; + fates_maintresp_model:units = "unitless" ; + fates_maintresp_model:long_name = "switch for choosing between maintenance respiration models. 1=Ryan (1991) (NOT USED)" ; double fates_mort_disturb_frac ; fates_mort_disturb_frac:units = "fraction" ; fates_mort_disturb_frac:long_name = "fraction of canopy mortality that results in disturbance (i.e. transfer of area from new to old patch)" ; @@ -692,6 +728,12 @@ variables: double fates_phen_ncolddayslim ; fates_phen_ncolddayslim:units = "days" ; fates_phen_ncolddayslim:long_name = "day threshold exceedance for temperature leaf-drop" ; + double fates_photo_temp_acclim_timescale ; + fates_photo_temp_acclim_timescale:units = "days" ; + fates_photo_temp_acclim_timescale:long_name = "Length of the window for the exponential moving average (ema) of vegetation temperature used in photosynthesis temperature acclimation (NOT USED)" ; + double fates_photo_tempsens_model ; + fates_photo_tempsens_model:units = "unitless" ; + fates_photo_tempsens_model:long_name = "switch for choosing the model that defines the temperature sensitivity of photosynthetic parameters (vcmax, jmax). 1=non-acclimating (NOT USED)" ; double fates_q10_froz ; fates_q10_froz:units = "unitless" ; fates_q10_froz:long_name = "Q10 for frozen-soil respiration rates" ; @@ -701,6 +743,18 @@ variables: double fates_soil_salinity ; fates_soil_salinity:units = "ppt" ; fates_soil_salinity:long_name = "soil salinity used for model when not coupled to dynamic soil salinity" ; + double fates_theta_cj_c3 ; + fates_theta_cj_c3:units = "unitless" ; + fates_theta_cj_c3:long_name = "Empirical curvature parameter for ac, aj photosynthesis co-limitation in c3 plants" ; + double fates_theta_cj_c4 ; + fates_theta_cj_c4:units = "unitless" ; + fates_theta_cj_c4:long_name = "Empirical curvature parameter for ac, aj photosynthesis co-limitation in c4 plants" ; + double fates_vai_top_bin_width ; + fates_vai_top_bin_width:units = "m2/m2" ; + fates_vai_top_bin_width:long_name = "width in VAI units of uppermost leaf+stem layer scattering element in each canopy layer (NOT USED)" ; + double fates_vai_width_increase_factor ; + fates_vai_width_increase_factor:units = "unitless" ; + fates_vai_width_increase_factor:long_name = "factor by which each leaf+stem scattering element increases in VAI width (1 = uniform spacing) (NOT USED)" ; // global attributes: :history = "This parameter file is maintained in version control\nSee https://github.com/NGEET/fates/blob/master/parameter_files/fates_params_default.cdl \nFor changes, use git blame \n" ; @@ -715,6 +769,10 @@ data: fates_history_sizeclass_bin_edges = 0, 5, 10, 15, 20, 30, 40, 50, 60, 70, 80, 90, 100 ; + fates_hydr_htftype_node = 1, 1, 1, 1 ; + + fates_prt_organ_id = 1, 2, 3, 6 ; + fates_pftname = "broadleaf_evergreen_tropical_tree ", "needleleaf_evergreen_extratrop_tree ", @@ -729,12 +787,24 @@ data: "cool_c3_grass ", "c4_grass " ; + fates_hydr_organname_node = + "leaf ", + "stem ", + "transporting root ", + "absorbing root " ; + + fates_litterclass_name = + "twig ", + "small branch ", + "large branch ", + "trunk ", + "dead leaves ", + "live grass " ; + fates_prt_organ_name = "leaf ", "fine root ", "sapwood ", - "storage ", - "reproduction ", "structure " ; fates_alloc_storage_cushion = 1.2, 1.2, 1.2, 1.2, 1.2, 1.2, 1.2, 1.2, 1.2, @@ -811,20 +881,25 @@ data: fates_allom_stmode = 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1 ; - fates_allom_dbh_max = 100, 100, 100, 100, 100, 100, 2, 2, 2, 2, 2, 2 ; + fates_allom_zroot_k = 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10 ; - fates_allom_dbh_0 = 1, 1, 1, 2.5, 2.5, 2.5, 0.1, 0.1, 0.1, 0.1, 0.1, 0.1 ; + fates_allom_zroot_max_dbh = 100, 100, 100, 100, 100, 100, 2, 2, 2, 2, 2, 2 ; - fates_allom_zfr_max = 9, 9, 9, 9, 8, 8, 2, 2, 2, 2, 2, 2 ; + fates_allom_zroot_max_z = 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, + 100, 100 ; - fates_allom_zfr_0 = 1, 1, 1, 1, 1, 1, 0.1, 0.1, 0.1, 0.1, 0.1, 0.1 ; + fates_allom_zroot_min_dbh = 1, 1, 1, 2.5, 2.5, 2.5, 0.1, 0.1, 0.1, 0.1, 0.1, + 0.1 ; - fates_allom_frk = 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10 ; + fates_allom_zroot_min_z = 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, + 100, 100 ; fates_branch_turnover = 150, 150, 150, 150, 150, 150, 150, 150, 150, 0, 0, 0 ; fates_c2b = 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2 ; + fates_dev_arbitrary_pft = _, _, _, _, _, _, _, _, _, _, _, _ ; + fates_displar = 0.67, 0.67, 0.67, 0.67, 0.67, 0.67, 0.67, 0.67, 0.67, 0.67, 0.67, 0.67 ; @@ -908,6 +983,8 @@ data: 0.08, 0.08, 0.08, 0.08, 0.08, 0.08, 0.08, 0.08, 0.08, 0.08, 0.08, 0.08, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 ; + fates_hydr_k_lwp = 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 ; + fates_hydr_kmax_node = -999, -999, -999, -999, -999, -999, -999, -999, -999, -999, -999, -999, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, @@ -967,6 +1044,28 @@ data: 0.65, 0.65, 0.65, 0.65, 0.65, 0.65, 0.65, 0.65, 0.65, 0.65, 0.65, 0.65, 0.75, 0.75, 0.75, 0.75, 0.75, 0.75, 0.75, 0.75, 0.75, 0.75, 0.75, 0.75 ; + fates_hydr_vg_alpha_node = + 0.0005, 0.0005, 0.0005, 0.0005, 0.0005, 0.005, 0.005, 0.005, 0.005, 0.005, + 0.005, 0.005, + 0.0005, 0.0005, 0.0005, 0.0005, 0.0005, 0.005, 0.005, 0.005, 0.005, 0.005, + 0.005, 0.005, + 0.0005, 0.0005, 0.0005, 0.0005, 0.0005, 0.005, 0.005, 0.005, 0.005, 0.005, + 0.005, 0.005, + 0.0005, 0.0005, 0.0005, 0.0005, 0.0005, 0.005, 0.005, 0.005, 0.005, 0.005, + 0.005, 0.005 ; + + fates_hydr_vg_m_node = + 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, 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, 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 ; + + fates_hydr_vg_n_node = + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2 ; + fates_leaf_c3psn = 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 0 ; fates_leaf_clumping_index = 0.85, 0.85, 0.8, 0.85, 0.85, 0.9, 0.85, 0.9, @@ -1004,14 +1103,6 @@ data: fates_leaf_stor_priority = 0.8, 0.8, 0.8, 0.8, 0.8, 0.8, 0.8, 0.8, 0.8, 0.8, 0.8, 0.8 ; - fates_leaf_tpuha = 53100, 53100, 53100, 53100, 53100, 53100, 53100, 53100, - 53100, 53100, 53100, 53100 ; - - fates_leaf_tpuhd = 150650, 150650, 150650, 150650, 150650, 150650, 150650, - 150650, 150650, 150650, 150650, 150650 ; - - fates_leaf_tpuse = 490, 490, 490, 490, 490, 490, 490, 490, 490, 490, 490, 490 ; - fates_leaf_vcmax25top = 50, 65, 39, 62, 41, 58, 62, 54, 54, 78, 78, 78 ; @@ -1038,7 +1129,7 @@ data: fates_maintresp_reduction_curvature = 0.01, 0.01, 0.01, 0.01, 0.01, 0.01, 0.01, 0.01, 0.01, 0.01, 0.01, 0.01 ; - fates_maintresp_reduction_intercept = 1, 1, 1, 1, 1, 1, 1, 1, 1, 2, 1, 1 ; + fates_maintresp_reduction_intercept = 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1 ; fates_mort_bmort = 0.014, 0.014, 0.014, 0.014, 0.014, 0.014, 0.014, 0.014, 0.014, 0.014, 0.014, 0.014 ; @@ -1072,6 +1163,9 @@ data: fates_nfix2 = _, _, _, _, _, _, _, _, _, _, _, _ ; + fates_nitr_store_ratio = 1.5, 1.5, 1.5, 1.5, 1.5, 1.5, 1.5, 1.5, 1.5, 1.5, + 1.5, 1.5 ; + fates_phen_cold_size_threshold = 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 ; fates_phen_evergreen = 1, 1, 0, 1, 0, 0, 1, 0, 0, 0, 0, 0 ; @@ -1084,6 +1178,9 @@ data: fates_phenflush_fraction = _, _, 0.5, _, 0.5, 0.5, _, 0.5, 0.5, 0.5, 0.5, 0.5 ; + fates_phos_store_ratio = 1.5, 1.5, 1.5, 1.5, 1.5, 1.5, 1.5, 1.5, 1.5, 1.5, + 1.5, 1.5 ; + fates_prescribed_mortality_canopy = 0.0194, 0.0194, 0.0194, 0.0194, 0.0194, 0.0194, 0.0194, 0.0194, 0.0194, 0.0194, 0.0194, 0.0194 ; @@ -1096,9 +1193,9 @@ data: fates_prescribed_npp_understory = 0.03125, 0.03125, 0.03125, 0.03125, 0.03125, 0.03125, 0.03125, 0.03125, 0.03125, 0.03125, 0.03125, 0.03125 ; - fates_prescribed_nuptake = 5.0, 5.0, 5.0, 5.0, 5.0, 5.0, 5.0, 5.0, 5.0, 5.0, 5.0, 5.0 ; + fates_prescribed_nuptake = 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1 ; - fates_prescribed_puptake = 5.0, 5.0, 5.0, 5.0, 5.0, 5.0, 5.0, 5.0, 5.0, 5.0, 5.0, 5.0 ; + fates_prescribed_puptake = 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1 ; fates_prescribed_recruitment = 0.02, 0.02, 0.02, 0.02, 0.02, 0.02, 0.02, 0.02, 0.02, 0.02, 0.02, 0.02 ; @@ -1107,8 +1204,6 @@ data: 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, - 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4 ; fates_prt_nitr_stoich_p1 = @@ -1117,9 +1212,6 @@ data: 0.024, 0.024, 1e-08, 1e-08, 1e-08, 1e-08, 1e-08, 1e-08, 1e-08, 1e-08, 1e-08, 1e-08, 1e-08, 1e-08, - 1e-08, 1e-08, 1e-08, 1e-08, 1e-08, 1e-08, 1e-08, 1e-08, 1e-08, 1e-08, - 1e-08, 1e-08, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0.0047, 0.0047, 0.0047, 0.0047, 0.0047, 0.0047, 0.0047, 0.0047, 0.0047, 0.0047, 0.0047, 0.0047 ; @@ -1129,9 +1221,6 @@ data: 0.024, 0.024, 1e-08, 1e-08, 1e-08, 1e-08, 1e-08, 1e-08, 1e-08, 1e-08, 1e-08, 1e-08, 1e-08, 1e-08, - 1e-08, 1e-08, 1e-08, 1e-08, 1e-08, 1e-08, 1e-08, 1e-08, 1e-08, 1e-08, - 1e-08, 1e-08, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0.0047, 0.0047, 0.0047, 0.0047, 0.0047, 0.0047, 0.0047, 0.0047, 0.0047, 0.0047, 0.0047, 0.0047 ; @@ -1142,9 +1231,6 @@ data: 0.0024, 0.0024, 0.0024, 1e-09, 1e-09, 1e-09, 1e-09, 1e-09, 1e-09, 1e-09, 1e-09, 1e-09, 1e-09, 1e-09, 1e-09, - 1e-09, 1e-09, 1e-09, 1e-09, 1e-09, 1e-09, 1e-09, 1e-09, 1e-09, 1e-09, - 1e-09, 1e-09, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0.00047, 0.00047, 0.00047, 0.00047, 0.00047, 0.00047, 0.00047, 0.00047, 0.00047, 0.00047, 0.00047, 0.00047 ; @@ -1155,9 +1241,6 @@ data: 0.0024, 0.0024, 0.0024, 1e-09, 1e-09, 1e-09, 1e-09, 1e-09, 1e-09, 1e-09, 1e-09, 1e-09, 1e-09, 1e-09, 1e-09, - 1e-09, 1e-09, 1e-09, 1e-09, 1e-09, 1e-09, 1e-09, 1e-09, 1e-09, 1e-09, - 1e-09, 1e-09, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0.00047, 0.00047, 0.00047, 0.00047, 0.00047, 0.00047, 0.00047, 0.00047, 0.00047, 0.00047, 0.00047, 0.00047 ; @@ -1221,8 +1304,6 @@ data: fates_trim_limit = 0.3, 0.3, 0.3, 0.3, 0.3, 0.3, 0.3, 0.3, 0.3, 0.3, 0.3, 0.3 ; fates_turnover_carb_retrans = - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, @@ -1232,16 +1313,12 @@ data: 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, 0.25, 0.25, 0.25, 0.25, 0.25, 0.25, 0.25, 0.25, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 ; fates_turnover_phos_retrans = 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, 0.25, 0.25, 0.25, 0.25, 0.25, 0.25, 0.25, 0.25, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 ; fates_turnover_retrans_mode = 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1 ; @@ -1254,6 +1331,22 @@ data: fates_z0mr = 0.055, 0.055, 0.055, 0.055, 0.055, 0.055, 0.055, 0.055, 0.055, 0.055, 0.055, 0.055 ; + fates_hlm_pft_map = + 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1 ; + fates_fire_FBD = 15.4, 16.8, 19.6, 999, 4, 4 ; fates_fire_low_moisture_Coeff = 1.12, 1.09, 0.98, 0.8, 1.15, 1.15 ; @@ -1288,6 +1381,8 @@ data: fates_cwd_flig = 0.24 ; + fates_dev_arbitrary = _ ; + fates_eca_plant_escalar = 1.25e-05 ; fates_fire_active_crown_fire = 0 ; @@ -1348,6 +1443,8 @@ data: fates_logging_mechanical_frac = 0.05 ; + fates_maintresp_model = 1 ; + fates_mort_disturb_frac = 1 ; fates_mort_understorey_death = 0.55983 ; @@ -1372,9 +1469,21 @@ data: fates_phen_ncolddayslim = 5 ; + fates_photo_temp_acclim_timescale = 30 ; + + fates_photo_tempsens_model = 1 ; + fates_q10_froz = 1.5 ; fates_q10_mr = 1.5 ; fates_soil_salinity = 0.4 ; + + fates_theta_cj_c3 = 0.999 ; + + fates_theta_cj_c4 = 0.999 ; + + fates_vai_top_bin_width = 1 ; + + fates_vai_width_increase_factor = 1 ; } diff --git a/parteh/PRTAllometricCNPMod.F90 b/parteh/PRTAllometricCNPMod.F90 index ccefa67924..5617d71e5d 100644 --- a/parteh/PRTAllometricCNPMod.F90 +++ b/parteh/PRTAllometricCNPMod.F90 @@ -27,7 +27,8 @@ module PRTAllometricCNPMod use PRTGenericMod , only : struct_organ use PRTGenericMod , only : all_organs use PRTGenericMod , only : prt_cnp_flex_allom_hyp - + use PRTGenericMod , only : StorageNutrientTarget + use FatesAllometryMod , only : bleaf use FatesAllometryMod , only : bsap_allom use FatesAllometryMod , only : bfineroot @@ -94,9 +95,9 @@ module PRTAllometricCNPMod ! Global identifiers for the two stoichiometry values - integer, parameter :: stoich_growth_min = 1 ! Flag for stoichiometry associated with + integer,public, parameter :: stoich_growth_min = 1 ! Flag for stoichiometry associated with ! minimum needed for growth - integer, parameter :: stoich_max = 2 ! Flag for stoichiometry associated with + integer,public, parameter :: stoich_max = 2 ! Flag for stoichiometry associated with ! maximum for that organ @@ -146,11 +147,12 @@ module PRTAllometricCNPMod integer, public, parameter :: acnp_bc_in_id_ctrim = 2 ! Index for the canopy trim function integer, public, parameter :: acnp_bc_in_id_lstat = 3 ! phenology status logical integer, public, parameter :: acnp_bc_in_id_netdc = 4 ! Index for the net daily C input BC - integer, public, parameter :: acnp_bc_in_id_netdn = 5 ! Index for the net daily N input BC - integer, public, parameter :: acnp_bc_in_id_netdp = 6 ! Index for the net daily P input BC + integer, public, parameter :: acnp_bc_in_id_netdnh4 = 5 ! Index for the net daily NH4 input BC + integer, public, parameter :: acnp_bc_in_id_netdno3 = 6 ! Index for the net daily NO3 input BC + integer, public, parameter :: acnp_bc_in_id_netdp = 7 ! Index for the net daily P input BC ! 0=leaf off, 1=leaf on - integer, parameter :: num_bc_in = 6 + integer, parameter :: num_bc_in = 7 ! ------------------------------------------------------------------------------------- ! Output Boundary Indices (These are public) @@ -159,14 +161,14 @@ module PRTAllometricCNPMod integer, public, parameter :: acnp_bc_out_id_cefflux = 1 ! Daily exudation of C [kg] integer, public, parameter :: acnp_bc_out_id_nefflux = 2 ! Daily exudation of N [kg] integer, public, parameter :: acnp_bc_out_id_pefflux = 3 ! Daily exudation of P [kg] - integer, public, parameter :: acnp_bc_out_id_ngrow = 4 ! N needed to match C growth at low N/C - integer, public, parameter :: acnp_bc_out_id_nmax = 5 ! N needed to match C growth at max N/C - integer, public, parameter :: acnp_bc_out_id_pgrow = 6 ! P needed to match C growth at low P/C - integer, public, parameter :: acnp_bc_out_id_pmax = 7 ! P needed to match C growth at max P/C + integer, public, parameter :: acnp_bc_out_id_nneed = 4 ! N need [kgN] + integer, public, parameter :: acnp_bc_out_id_pneed = 5 ! P need [kgP] - integer, parameter :: num_bc_out = 7 ! Total number of + integer, parameter :: num_bc_out = 5 ! Total number of + + ! ------------------------------------------------------------------------------------- ! Define the size of the coorindate vector. For this hypothesis, there is only ! one pool per each species x organ combination, except for leaves (WHICH HAVE AGE) @@ -207,13 +209,13 @@ module PRTAllometricCNPMod procedure :: DailyPRT => DailyPRTAllometricCNP procedure :: FastPRT => FastPRTAllometricCNP - + procedure :: GetNutrientTarget => GetNutrientTargetCNP + ! Extended functions specific to Allometric CNP procedure :: CNPPrioritizedReplacement procedure :: CNPStatureGrowth procedure :: CNPAllocateRemainder procedure :: GetDeficit - procedure :: GetNutrientTarget procedure :: GrowEquivC procedure :: NAndPToMatchC end type cnp_allom_prt_vartypes @@ -234,7 +236,7 @@ module PRTAllometricCNPMod logical, parameter :: debug = .false. public :: InitPRTGlobalAllometricCNP - + contains @@ -337,10 +339,8 @@ subroutine DailyPRTAllometricCNP(this) real(r8),pointer :: c_efflux ! Total plant efflux of carbon (kgC) real(r8),pointer :: n_efflux ! Total plant efflux of nitrogen (kgN) real(r8),pointer :: p_efflux ! Total plant efflux of phosphorus (kgP) - real(r8),pointer :: n_grow ! N needed to match C stature growth (kgN) - real(r8),pointer :: n_max ! N needed to reach max stoich at final C (kgN) - real(r8),pointer :: p_grow ! P needed to match C stature growth (kgP) - real(r8),pointer :: p_max ! P needed to reach max stoich at final C (kgP) + real(r8),pointer :: n_need ! N need (algorithm dependant) (kgN) + real(r8),pointer :: p_need ! P need (algorithm dependant) (kgP) real(r8),pointer :: growth_r ! Total plant growth respiration this step (kgC) ! These are pointers to the state variables, rearranged in organ dimensioned @@ -357,7 +357,7 @@ subroutine DailyPRTAllometricCNP(this) real(r8) :: bgw_c_target,bgw_dcdd_target real(r8) :: sapw_area integer :: cnp_limiter - + real(r8) :: max_store_n ! These arrays hold various support variables dimensioned by organ ! Zero suffix indicates the initial state values at the beginning of the routine ! _unl suffix indicates values used for tracking nutrient need (ie unlimited) @@ -374,21 +374,14 @@ subroutine DailyPRTAllometricCNP(this) real(r8) :: p_gain0 real(r8) :: maint_r_def0 - ! These are mass gains and fluxes used for the N&P non-limiting case - real(r8) :: c_gain_unl - real(r8) :: n_gain_unl,n_gain_unl0 - real(r8) :: p_gain_unl,p_gain_unl0 - ! Used for mass checking, total mass allocated based ! on change in the states, should match gain0's real(r8) :: allocated_c real(r8) :: allocated_n real(r8) :: allocated_p - + real(r8) :: target_n,target_p real(r8) :: sum_c ! error checking sum - logical, parameter :: prt_assess_nutr_need = .true. - ! integrator variables ! Copy the input only boundary conditions into readable local variables @@ -397,7 +390,9 @@ subroutine DailyPRTAllometricCNP(this) ! for checking and resetting if needed ! ----------------------------------------------------------------------------------- c_gain = this%bc_in(acnp_bc_in_id_netdc)%rval; c_gain0 = c_gain - n_gain = this%bc_in(acnp_bc_in_id_netdn)%rval; n_gain0 = n_gain + n_gain = this%bc_in(acnp_bc_in_id_netdnh4)%rval + & + this%bc_in(acnp_bc_in_id_netdno3)%rval + n_gain0 = n_gain p_gain = this%bc_in(acnp_bc_in_id_netdp)%rval; p_gain0 = p_gain canopy_trim = this%bc_in(acnp_bc_in_id_ctrim)%rval ipft = this%bc_in(acnp_bc_in_id_pft)%ival @@ -406,27 +401,15 @@ subroutine DailyPRTAllometricCNP(this) c_efflux => this%bc_out(acnp_bc_out_id_cefflux)%rval; c_efflux = 0._r8 n_efflux => this%bc_out(acnp_bc_out_id_nefflux)%rval; n_efflux = 0._r8 p_efflux => this%bc_out(acnp_bc_out_id_pefflux)%rval; p_efflux = 0._r8 - n_grow => this%bc_out(acnp_bc_out_id_ngrow)%rval; n_grow = fates_unset_r8 - n_max => this%bc_out(acnp_bc_out_id_nmax)%rval; n_max = fates_unset_r8 - p_grow => this%bc_out(acnp_bc_out_id_pgrow)%rval; p_grow = fates_unset_r8 - p_max => this%bc_out(acnp_bc_out_id_pmax)%rval; p_max = fates_unset_r8 + n_need => this%bc_out(acnp_bc_out_id_nneed)%rval; n_need = fates_unset_r8 + p_need => this%bc_out(acnp_bc_out_id_pneed)%rval; p_need = fates_unset_r8 + ! In/out boundary conditions maint_r_def => this%bc_inout(acnp_bc_inout_id_rmaint_def)%rval; maint_r_def0 = maint_r_def dbh => this%bc_inout(acnp_bc_inout_id_dbh)%rval; dbh0 = dbh - ! Initialize fields used for assessing N/P needs - ! (these run the allocation scheme with ample - ! N+P, to determine how much - ! availability was needed (in hindsight) drive - ! non-limited C allocaiton. - - c_gain_unl = c_gain - n_gain_unl = abs(10._r8*c_gain) - n_gain_unl0 = n_gain_unl - p_gain_unl = abs(10._r8*c_gain) - p_gain_unl0 = p_gain_unl ! If more than 1 leaf age bin is present, this ! call advances leaves in their age, but does @@ -478,73 +461,6 @@ subroutine DailyPRTAllometricCNP(this) end do - assess_need_if: if(prt_assess_nutr_need) then - - ! =================================================================================== - ! Step 1. Prioritized allocation to replace tissues from turnover, and/or pay - ! any un-paid maintenance respiration from storage. - ! =================================================================================== - - call this%CNPPrioritizedReplacement(maint_r_def, c_gain_unl, n_gain_unl, p_gain_unl, & - state_c, state_n, state_p, target_c) - - ! Uncomment to see intermediate n and p needs - !n_grow = n_gain_unl0 - n_gain_unl - !p_grow = p_gain_unl0 - p_gain_unl - - ! =================================================================================== - ! Step 2. Grow out the stature of the plant by allocating to tissues beyond - ! current targets. - ! Attempts have been made to get all pools and species closest to allometric - ! targets based on prioritized relative demand and allometry functions. - ! =================================================================================== - - call this%CNPStatureGrowth(c_gain_unl, n_gain_unl, p_gain_unl, & - state_c, state_n, state_p, target_c, target_dcdd, cnp_limiter) - - n_grow = max(0._r8,(n_gain_unl0 - n_gain_unl)) - p_grow = max(0._r8,(p_gain_unl0 - p_gain_unl)) - - ! =================================================================================== - ! Step 3. - ! At this point, 1 of the 3 resources (C,N,P) has been used up for stature growth. - ! Allocate the remaining resources, or as a last resort, efflux them. - ! =================================================================================== - - call this%CNPAllocateRemainder(c_gain_unl, n_gain_unl, p_gain_unl, & - state_c, state_n, state_p, c_efflux, n_efflux, p_efflux) - - - n_max = max(n_gain_unl0 - n_efflux,0._r8) - p_max = max(p_gain_unl0 - p_efflux,0._r8) - - - ! We must now reset the state so that we can perform nutrient limited allocation - ! Note: Even if there is more than 1 leaf pool, allocation only modifies - ! the first pool, so no need to reset the others - do i_org = 1,num_organs - - i_var = prt_global%sp_organ_map(organ_list(i_org),carbon12_element) - this%variables(i_var)%val(1) = state_c0(i_org) - state_c(i_org)%ptr => this%variables(i_var)%val(1) - - i_var = prt_global%sp_organ_map(organ_list(i_org),nitrogen_element) - this%variables(i_var)%val(1) = state_n0(i_org) - state_n(i_org)%ptr => this%variables(i_var)%val(1) - - i_var = prt_global%sp_organ_map(organ_list(i_org),phosphorus_element) - this%variables(i_var)%val(1) = state_p0(i_org) - state_p(i_org)%ptr => this%variables(i_var)%val(1) - - end do - - ! Reset the maintenance respiration deficit and the growth - ! respiration - maint_r_def = maint_r_def0 - dbh = dbh0 - - end if assess_need_if - ! =================================================================================== ! Step 0. Transfer all stored nutrient into the daily uptake pool. ! Storage in nutrients does not need to have a buffer like @@ -560,7 +476,6 @@ subroutine DailyPRTAllometricCNP(this) p_gain = p_gain + sum(this%variables(i_var)%val(:)) this%variables(i_var)%val(:) = 0._r8 - ! =================================================================================== ! Step 1. Prioritized allocation to replace tissues from turnover, and/or pay ! any un-paid maintenance respiration from storage. @@ -660,8 +575,7 @@ subroutine DailyPRTAllometricCNP(this) allocated_p = allocated_p + (state_p(i_org)%ptr - state_p0(i_org)) end do - - + if(debug) then ! Error Check: Do a final balance between how much mass @@ -683,6 +597,11 @@ subroutine DailyPRTAllometricCNP(this) end if end if + target_n = this%GetNutrientTarget(nitrogen_element,store_organ) + target_p = this%GetNutrientTarget(phosphorus_element,store_organ) + + n_need = target_n - state_n(store_id)%ptr + p_need = target_p - state_p(store_id)%ptr deallocate(state_c) deallocate(state_n) @@ -765,17 +684,19 @@ subroutine CNPPrioritizedReplacement(this, & ! If it is, then we track the variable ids associated with that pool for each CNP ! species. It "should" work fine if there are NO priority=1 pools... ! ----------------------------------------------------------------------------------- - curpri_org(:) = fates_unset_int ! reset "current-priority" organ ids i = 0 do ii = 1, num_organs - - deficit_c(ii) = max(0._r8,this%GetDeficit(carbon12_element,organ_list(ii),target_c(ii))) + deficit_c(ii) = max(0._r8,this%GetDeficit(carbon12_element,organ_list(ii),target_c(ii))) + + ! The following logic bars any organs that were not given allocation priority + if( prt_params%organ_param_id(organ_list(ii)) < 1 ) cycle + ! The priority code associated with this organ - priority_code = int(prt_params%alloc_priority(ipft, organ_list(ii))) - + priority_code = int(prt_params%alloc_priority(ipft, prt_params%organ_param_id(organ_list(ii)))) + ! Don't allow allocation to leaves if they are in an "off" status. ! Also, dont allocate to replace turnover if this is not evergreen ! (this prevents accidental re-flushing on the day they drop) @@ -920,7 +841,7 @@ subroutine CNPPrioritizedReplacement(this, & ! Bring all pools, in priority order, up to allometric targets if possible ! ----------------------------------------------------------------------------------- - do i_pri = 1, n_max_priority + priority_loop: do i_pri = 1, n_max_priority curpri_org(:) = fates_unset_int ! "current-priority" organ indices @@ -928,7 +849,19 @@ subroutine CNPPrioritizedReplacement(this, & do ii = 1, num_organs ! The priority code associated with this organ - priority_code = int(prt_params%alloc_priority(ipft, organ_list(ii))) + ! Storage has a special hard-coded priority level of 2 + ! Note that it is also implicitly part of step 1 + + if( organ_list(ii).eq.store_organ ) then + priority_code = 2 + else + if( prt_params%organ_param_id(organ_list(ii)) <1 ) then + priority_code = -1 + else + priority_code = int(prt_params%alloc_priority(ipft,prt_params%organ_param_id(organ_list(ii)))) + end if + end if + ! Don't allow allocation to leaves if they are in an "off" status. ! (this prevents accidental re-flushing on the day they drop) @@ -1048,7 +981,7 @@ subroutine CNPPrioritizedReplacement(this, & p_gain, phosphorus_element, curpri_org(1:n_curpri_org)) - end do + end do priority_loop return end subroutine CNPPrioritizedReplacement @@ -1364,7 +1297,11 @@ subroutine CNPStatureGrowth(this,c_gain, n_gain, p_gain, & case(3) - ! HACK, ALLOW FULL C ALLOCATION AND LET REST OF ALGORITHM LIMIT + ! No mathematical co-limitation of growth + ! This assumes that limitations will prevent + ! organs from allowing the growth step to even occur + ! and thus from an algorithmic level limit growth + c_gstature = c_gain @@ -1532,36 +1469,54 @@ subroutine CNPStatureGrowth(this,c_gain, n_gain, p_gain, & end if if_completed_solve end do do_solve_check - + ! Prioritize nutrient transfer to the reproductive pool + ! Note, that if we do not keep reproductive tissues on stoichiometry, the seed + ! pool for that pft will be off stoichiometry, and one of C,N or P will limit + ! recruitment. Per the current model formulation, new recruits are forced to + ! have their maximum stoichiometry in each organ. The total stoichiometry + ! of the recruits should match the stoichiometry of the seeds + + !!target_n = this%GetNutrientTarget(nitrogen_element,repro_organ,stoich_growth_min) + !!deficit_n(repro_id) = this%GetDeficit(nitrogen_element,repro_organ,target_n) + + !!target_p = this%GetNutrientTarget(phosphorus_element,repro_organ,stoich_growth_min) + !!deficit_p(repro_id) = this%GetDeficit(phosphorus_element,repro_organ,target_p) + + ! Nitrogen for + !!call ProportionalNutrAllocation(state_n, deficit_n, n_gain, nitrogen_element,[repro_id]) + + ! Phosphorus + !!call ProportionalNutrAllocation(state_p, deficit_p, p_gain, phosphorus_element,[repro_id]) + + ! ----------------------------------------------------------------------------------- ! Nutrient Fluxes proportionally to each pool (these should be fully actualized) ! (this also removes from the gain pools) ! ----------------------------------------------------------------------------------- - sum_n_demand = 0._r8 ! For error checking - sum_p_demand = 0._r8 ! For error checking - do ii = 1, n_mask_organs - i = mask_organs(ii) - if(organ_list(i).ne.store_organ)then - ! Update the nitrogen deficits (which are based off of carbon actual..) - ! Note that the nitrogen target is tied to the stoichiometry of thegrowing pool only - target_n = this%GetNutrientTarget(nitrogen_element,organ_list(i),stoich_growth_min) - deficit_n(i) = this%GetDeficit(nitrogen_element,organ_list(i),target_n) - sum_n_demand = sum_n_demand+max(0._r8,deficit_n(i)) - - ! Update the nitrogen deficits (which are based off of carbon actual..) - ! Note that the nitrogen target is tied to the stoichiometry of thegrowing pool only - target_p = this%GetNutrientTarget(phosphorus_element,organ_list(i),stoich_growth_min) - deficit_p(i) = this%GetDeficit(phosphorus_element,organ_list(i),target_p) - sum_p_demand = sum_p_demand+max(0._r8,deficit_p(i)) - else - deficit_n(i) = 0._r8 - deficit_p(i) = 0._r8 - end if - - end do - + sum_n_demand = 0._r8 ! For error checking + sum_p_demand = 0._r8 ! For error checking + do ii = 1, n_mask_organs + i = mask_organs(ii) + if(organ_list(i).ne.store_organ)then + ! Update the nitrogen deficits (which are based off of carbon actual..) + ! Note that the nitrogen target is tied to the stoichiometry of thegrowing pool only + target_n = this%GetNutrientTarget(nitrogen_element,organ_list(i),stoich_growth_min) + deficit_n(i) = this%GetDeficit(nitrogen_element,organ_list(i),target_n) + sum_n_demand = sum_n_demand+max(0._r8,deficit_n(i)) + + ! Update the nitrogen deficits (which are based off of carbon actual..) + ! Note that the nitrogen target is tied to the stoichiometry of thegrowing pool only + target_p = this%GetNutrientTarget(phosphorus_element,organ_list(i),stoich_growth_min) + deficit_p(i) = this%GetDeficit(phosphorus_element,organ_list(i),target_p) + sum_p_demand = sum_p_demand+max(0._r8,deficit_p(i)) + else + deficit_n(i) = 0._r8 + deficit_p(i) = 0._r8 + end if + + end do ! Nitrogen call ProportionalNutrAllocation(state_n,deficit_n, & @@ -1618,18 +1573,14 @@ subroutine CNPAllocateRemainder(this,c_gain, n_gain, p_gain, & ! ----------------------------------------------------------------------------------- do i = 1, num_organs - - ! Update the nitrogen deficits (which are based off of carbon actual..) - ! Note that the nitrogen target is tied to the stoichiometry of thegrowing pool only + + ! Update the nitrogen and phosphorus deficits target_n = this%GetNutrientTarget(nitrogen_element,organ_list(i),stoich_max) deficit_n(i) = max(0._r8,this%GetDeficit(nitrogen_element,organ_list(i),target_n)) - - ! Update the nitrogen deficits (which are based off of carbon actual..) - ! Note that the nitrogen target is tied to the stoichiometry of thegrowing pool only target_p = this%GetNutrientTarget(phosphorus_element,organ_list(i),stoich_max) deficit_p(i) = max(0._r8,this%GetDeficit(phosphorus_element,organ_list(i),target_p)) - + end do ! ----------------------------------------------------------------------------------- @@ -1648,6 +1599,15 @@ subroutine CNPAllocateRemainder(this,c_gain, n_gain, p_gain, & p_gain, phosphorus_element, all_organs) + ! If any N or P is still hanging around, put it in storage + + state_n(store_id)%ptr = state_n(store_id)%ptr + n_gain + state_p(store_id)%ptr = state_p(store_id)%ptr + p_gain + + n_gain = 0._r8 + p_gain = 0._r8 + + ! ----------------------------------------------------------------------------------- ! If carbon is still available, lets cram some into storage overflow ! We will do this last, because we wanted the non-overflow storage @@ -1678,13 +1638,13 @@ subroutine CNPAllocateRemainder(this,c_gain, n_gain, p_gain, & ! ----------------------------------------------------------------------------------- c_efflux = max(0.0_r8,c_gain) - n_efflux = max(0.0_r8,n_gain) - p_efflux = max(0.0_r8,p_gain) +! n_efflux = max(0.0_r8,n_gain) +! p_efflux = max(0.0_r8,p_gain) c_gain = 0.0_r8 - n_gain = 0.0_r8 - p_gain = 0.0_r8 +! n_gain = 0.0_r8 +! p_gain = 0.0_r8 return end subroutine CNPAllocateRemainder @@ -1733,12 +1693,12 @@ end function GetDeficit ! ===================================================================================== - function GetNutrientTarget(this,element_id,organ_id,stoich_mode) result(target_m) + function GetNutrientTargetCNP(this,element_id,organ_id,stoich_mode) result(target_m) class(cnp_allom_prt_vartypes) :: this integer, intent(in) :: element_id integer, intent(in) :: organ_id - integer, intent(in) :: stoich_mode + integer, intent(in),optional :: stoich_mode real(r8) :: target_m ! Target amount of nutrient for this organ [kg] real(r8) :: target_c @@ -1746,6 +1706,13 @@ function GetNutrientTarget(this,element_id,organ_id,stoich_mode) result(target_m real(r8) :: canopy_trim integer :: ipft integer :: i_cvar + real(r8) :: sapw_area + real(r8) :: leaf_c_target,fnrt_c_target + real(r8) :: sapw_c_target,agw_c_target + real(r8) :: bgw_c_target,struct_c_target + + + dbh => this%bc_inout(acnp_bc_inout_id_dbh)%rval canopy_trim = this%bc_in(acnp_bc_in_id_ctrim)%rval @@ -1753,40 +1720,87 @@ function GetNutrientTarget(this,element_id,organ_id,stoich_mode) result(target_m i_cvar = prt_global%sp_organ_map(organ_id,carbon12_element) ! Storage of nutrients are assumed to have different compartments than - ! for carbon, and thus their targets are not associated with the current amount of carbon - ! but the plant's carrying capacity + ! for carbon, and thus their targets are not associated with a tissue + ! but is more represented as a fraction of the maximum amount of nutrient + ! that can be bound in non-reproductive tissues if(organ_id == store_organ) then - call bstore_allom(dbh,ipft,canopy_trim, target_c) + + call bleaf(dbh,ipft,canopy_trim,leaf_c_target) + call bfineroot(dbh,ipft,canopy_trim,fnrt_c_target) + call bsap_allom(dbh,ipft,canopy_trim,sapw_area,sapw_c_target) + call bagw_allom(dbh,ipft,agw_c_target) + call bbgw_allom(dbh,ipft,bgw_c_target) + call bdead_allom(agw_c_target,bgw_c_target, sapw_c_target, ipft, struct_c_target) + + ! Target for storage is a fraction of the sum target of all + ! non-reproductive organs + + if( element_id == nitrogen_element) then + + target_m = StorageNutrientTarget(ipft, element_id, & + leaf_c_target*prt_params%nitr_stoich_p2(ipft,prt_params%organ_param_id(leaf_organ)), & + fnrt_c_target*prt_params%nitr_stoich_p2(ipft,prt_params%organ_param_id(fnrt_organ)), & + sapw_c_target*prt_params%nitr_stoich_p2(ipft,prt_params%organ_param_id(sapw_organ)), & + struct_c_target*prt_params%nitr_stoich_p2(ipft,prt_params%organ_param_id(struct_organ))) + else + + target_m = StorageNutrientTarget(ipft, element_id, & + leaf_c_target*prt_params%phos_stoich_p2(ipft,prt_params%organ_param_id(leaf_organ)), & + fnrt_c_target*prt_params%phos_stoich_p2(ipft,prt_params%organ_param_id(fnrt_organ)), & + sapw_c_target*prt_params%phos_stoich_p2(ipft,prt_params%organ_param_id(sapw_organ)), & + struct_c_target*prt_params%phos_stoich_p2(ipft,prt_params%organ_param_id(struct_organ))) + + end if + + elseif(organ_id == repro_organ) then + + target_c = this%variables(i_cvar)%val(1) + if( element_id == nitrogen_element) then + target_m = target_c * prt_params%nitr_recr_stoich(ipft) + else + target_m = target_c * prt_params%phos_recr_stoich(ipft) + end if + else + + + if(.not.present(stoich_mode))then + write(fates_log(),*) 'Must specify if nutrient target is growthmin or max' + write(fates_log(),*) 'for non-reproductive and non-storage organs' + call endrun(msg=errMsg(sourcefile, __LINE__)) + end if + ! In all cases, we want the first index because for non-leaves ! that is the only index, and for leaves, that is the newly ! growing index. target_c = this%variables(i_cvar)%val(1) - end if - if( stoich_mode == stoich_growth_min ) then - if( element_id == nitrogen_element) then - target_m = target_c * prt_params%nitr_stoich_p1(ipft,organ_id) - else - target_m = target_c * prt_params%phos_stoich_p1(ipft,organ_id) - end if - elseif( stoich_mode == stoich_max ) then - if( element_id == nitrogen_element) then - target_m = target_c * prt_params%nitr_stoich_p2(ipft,organ_id) + if( stoich_mode == stoich_growth_min ) then + if( element_id == nitrogen_element) then + target_m = target_c * prt_params%nitr_stoich_p1(ipft,prt_params%organ_param_id(organ_id)) + else + target_m = target_c * prt_params%phos_stoich_p1(ipft,prt_params%organ_param_id(organ_id)) + end if + elseif( stoich_mode == stoich_max ) then + if( element_id == nitrogen_element) then + target_m = target_c * prt_params%nitr_stoich_p2(ipft,prt_params%organ_param_id(organ_id)) + else + target_m = target_c * prt_params%phos_stoich_p2(ipft,prt_params%organ_param_id(organ_id)) + end if else - target_m = target_c * prt_params%phos_stoich_p2(ipft,organ_id) + write(fates_log(),*) 'invalid stoichiometry mode specified while getting' + write(fates_log(),*) 'nutrient targets' + write(fates_log(),*) 'stoich_mode: ',stoich_mode + call endrun(msg=errMsg(sourcefile, __LINE__)) end if - else - write(fates_log(),*) 'invalid stoichiometry mode specified while getting' - write(fates_log(),*) 'nutrient targets' - write(fates_log(),*) 'stoich_mode: ',stoich_mode - call endrun(msg=errMsg(sourcefile, __LINE__)) end if - + return - end function GetNutrientTarget + end function GetNutrientTargetCNP + + ! ===================================================================================== subroutine ProportionalNutrAllocation(state_m, deficit_m, gain_m, element_id, list) @@ -1803,7 +1817,7 @@ subroutine ProportionalNutrAllocation(state_m, deficit_m, gain_m, element_id, li ! over some arbitrary set of organs real(r8),intent(inout) :: deficit_m(:) ! Nutrient mass deficit of species ! over set of organs - integer, intent(in) :: list(:)! List of indices if sparse + integer, intent(in) :: list(:) ! List of indices if sparse real(r8),intent(inout) :: gain_m ! Total nutrient mass gain to ! work with integer,intent(in) :: element_id ! Element global index (for debugging) @@ -1980,10 +1994,10 @@ subroutine GrowEquivC(this,carbon_gain,nitrogen_gain,phosphorus_gain, & ! Calculate gains from Nitrogen ! ----------------------------------------------------------------------------------- - if(prt_params%nitr_stoich_p1(ipft,organ_id)>nearzero)then + if(prt_params%nitr_stoich_p1(ipft,prt_params%organ_param_id(organ_id))>nearzero)then ! The amount of C we could match with N in the aquisition pool - c_from_n_gain = nitrogen_gain * alloc_frac / prt_params%nitr_stoich_p1(ipft,organ_id) + c_from_n_gain = nitrogen_gain * alloc_frac / prt_params%nitr_stoich_p1(ipft,prt_params%organ_param_id(organ_id)) ! It is possible that the nutrient pool of interest is already above the minimum ! requirement. In this case, we add that into the amount that the equivalent @@ -1993,7 +2007,7 @@ subroutine GrowEquivC(this,carbon_gain,nitrogen_gain,phosphorus_gain, & n_target = this%GetNutrientTarget(nitrogen_element,organ_id,stoich_growth_min) c_from_n_headstart = max(0.0_r8, sum(this%variables(n_var_id)%val(:),dim=1) - n_target ) / & - prt_params%nitr_stoich_p1(ipft,organ_id) + prt_params%nitr_stoich_p1(ipft,prt_params%organ_param_id(organ_id)) ! Increment the amount of C that we could match with N, as the minimum @@ -2009,10 +2023,10 @@ subroutine GrowEquivC(this,carbon_gain,nitrogen_gain,phosphorus_gain, & ! Calculate gains from phosphorus ! ----------------------------------------------------------------------------------- - if(prt_params%phos_stoich_p1(ipft,organ_id)>nearzero) then + if(prt_params%phos_stoich_p1(ipft,prt_params%organ_param_id(organ_id))>nearzero) then - c_from_p_gain = phosphorus_gain * alloc_frac / prt_params%phos_stoich_p1(ipft,organ_id) + c_from_p_gain = phosphorus_gain * alloc_frac / prt_params%phos_stoich_p1(ipft,prt_params%organ_param_id(organ_id)) ! It is possible that the nutrient pool of interest is already above the minimum ! requirement. In this case, we add that into the amount that the equivalent @@ -2022,7 +2036,7 @@ subroutine GrowEquivC(this,carbon_gain,nitrogen_gain,phosphorus_gain, & p_target = this%GetNutrientTarget(phosphorus_element,organ_id,stoich_growth_min) c_from_p_headstart = max(0.0_r8,sum(this%variables(p_var_id)%val(:),dim=1) - p_target ) / & - prt_params%phos_stoich_p1(ipft,organ_id) + prt_params%phos_stoich_p1(ipft,prt_params%organ_param_id(organ_id)) ! Increment the amount of C that we could match with P, as the minimum ! of what C could do itself, and what P could do. We need this minimum @@ -2276,5 +2290,8 @@ subroutine TargetAllometryCheck(bleaf,bfroot,bsap,bstore,bdead, & end if end subroutine TargetAllometryCheck + + + end module PRTAllometricCNPMod diff --git a/parteh/PRTGenericMod.F90 b/parteh/PRTGenericMod.F90 index 9c6f9db2e2..76d0e01eda 100644 --- a/parteh/PRTGenericMod.F90 +++ b/parteh/PRTGenericMod.F90 @@ -241,7 +241,8 @@ module PRTGenericMod procedure :: DailyPRT => DailyPRTBase procedure :: FastPRT => FastPRTBase - + procedure :: GetNutrientTarget => GetNutrientTargetBase + ! These are generic functions that should work on all hypotheses procedure, non_overridable :: InitAllocate @@ -385,12 +386,13 @@ module PRTGenericMod end type prt_global_type - type(prt_global_type),pointer,public :: prt_global + class(prt_global_type),pointer,public :: prt_global ! Make necessary procedures public public :: GetCoordVal public :: SetState - + public :: StorageNutrientTarget + contains ! ===================================================================================== @@ -1384,6 +1386,92 @@ subroutine AgeLeaves(this,ipft,period_sec) end do end subroutine AgeLeaves + + + function GetNutrientTargetBase(this,element_id,organ_id,stoich_mode) result(target_m) + + class(prt_vartypes) :: this + integer, intent(in) :: element_id + integer, intent(in) :: organ_id + integer, intent(in),optional :: stoich_mode + real(r8) :: target_m ! Target amount of nutrient for this organ [kg] + + write(fates_log(),*)'GetNutrientTargetBase must be extended by a child class.' + call endrun(msg=errMsg(sourcefile, __LINE__)) + + return + end function GetNutrientTargetBase + + + ! ==================================================================================== + function StorageNutrientTarget(pft, element_id, leaf_target, fnrt_target, sapw_target, struct_target) result(store_target) + + integer :: pft + integer :: element_id + real(r8) :: leaf_target ! Target leaf nutrient mass [kg] + real(r8) :: fnrt_target ! Target fineroot nutrient mass [kg] + real(r8) :: sapw_target ! Target sapwood nutrient mass [kg] + real(r8) :: struct_target ! Target structural nutrient mass [kg] + + real(r8) :: store_target ! Output: Target storage nutrient mass [kg] + + + ! ------------------------------------------------------------------------------------- + ! Choice of how nutrient storage target is proportioned to + ! Each choice makes the nutrient storage proportional the the "in-tissue" + ! total nitrogen content of 1 or more sets of organs + ! ------------------------------------------------------------------------------------- + + integer, parameter :: lfs_store_prop = 1 ! leaf-fnrt-sapw proportional storage + integer, parameter :: lfss_store_prop = 2 ! leaf-fnrt-sapw-struct proportional storage + integer, parameter :: fnrt_store_prop = 3 ! fineroot proportional storage + integer, parameter :: store_prop = fnrt_store_prop + + + select case(element_id) + case(carbon12_element) + write(fates_log(),*) 'Cannot call StorageNutrientTarget() for carbon' + write(fates_log(),*) 'exiting' + call endrun(msg=errMsg(sourcefile, __LINE__)) + + case(nitrogen_element) + + if (store_prop == lfs_store_prop) then + + store_target = prt_params%nitr_store_ratio(pft) * (leaf_target + fnrt_target + sapw_target) + + elseif(store_prop==lfss_store_prop) then + + store_target = prt_params%nitr_store_ratio(pft) * (leaf_target + fnrt_target + sapw_target + struct_target) + + elseif(store_prop==fnrt_store_prop) then + + store_target = prt_params%nitr_store_ratio(pft) * fnrt_target + + end if + + + case(phosphorus_element) + + if (store_prop == lfs_store_prop) then + + store_target = prt_params%phos_store_ratio(pft) * (leaf_target + fnrt_target + sapw_target) + + elseif(store_prop==lfss_store_prop) then + + store_target = prt_params%nitr_store_ratio(pft) * (leaf_target + fnrt_target + sapw_target + struct_target) + + elseif(store_prop==fnrt_store_prop) then + + store_target = prt_params%phos_store_ratio(pft) * fnrt_target + + end if + end select + + + end function StorageNutrientTarget + + end module PRTGenericMod diff --git a/parteh/PRTLossFluxesMod.F90 b/parteh/PRTLossFluxesMod.F90 index 526613b37d..13b09b2e37 100644 --- a/parteh/PRTLossFluxesMod.F90 +++ b/parteh/PRTLossFluxesMod.F90 @@ -117,6 +117,14 @@ subroutine PRTPhenologyFlush(prt, ipft, organ_id, c_store_transfer_frac) call endrun(msg=errMsg(__FILE__, __LINE__)) end if + if(prt_params%organ_param_id(organ_id)<1) then + write(fates_log(),*) 'Attempting to flush an organ that does not have a stoichiometry defined' + write(fates_log(),*) 'global organ id (fyi, leaf=1):',organ_id + write(fates_log(),*) 'prt_params%organ_param_id(:):',prt_params%organ_param_id(:) + write(fates_log(),*) 'Exiting' + call endrun(msg=errMsg(__FILE__, __LINE__)) + end if + if(prt_global%hyp_id .le. 2) then i_leaf_pos = 1 ! also used for sapwood and structural for grass i_store_pos = 1 ! hypothesis 1/2 only have @@ -222,9 +230,9 @@ subroutine PRTPhenologyFlush(prt, ipft, organ_id, c_store_transfer_frac) ! Calculate the stoichiometry with C for this element if( element_id == nitrogen_element ) then - target_stoich = prt_params%nitr_stoich_p1(ipft,organ_id) + target_stoich = prt_params%nitr_stoich_p1(ipft,prt_params%organ_param_id(organ_id)) else if( element_id == phosphorus_element ) then - target_stoich = prt_params%phos_stoich_p1(ipft,organ_id) + target_stoich = prt_params%phos_stoich_p1(ipft,prt_params%organ_param_id(organ_id)) else write(fates_log(),*) ' Trying to calculate nutrient flushing target' write(fates_log(),*) ' for element that DNE' @@ -505,21 +513,25 @@ subroutine DeciduousTurnoverSimpleRetranslocation(prt,ipft,organ_id,mass_fractio i_var = organ_map(organ_id)%var_id(i_var_of_organ) element_id = prt_global%state_descriptor(i_var)%element_id - - if ( any(element_id == carbon_elements_list) ) then - retrans = prt_params%turnover_carb_retrans(ipft,organ_id) - else if( element_id == nitrogen_element ) then - retrans = prt_params%turnover_nitr_retrans(ipft,organ_id) - else if( element_id == phosphorus_element ) then - retrans = prt_params%turnover_phos_retrans(ipft,organ_id) + + if( prt_params%organ_param_id(organ_id) < 1 ) then + retrans = 0._r8 else - write(fates_log(),*) 'Please add a new re-translocation clause to your ' - write(fates_log(),*) ' organ x element combination' - write(fates_log(),*) ' organ: ',leaf_organ,' element: ',element_id - write(fates_log(),*) 'Exiting' - call endrun(msg=errMsg(__FILE__, __LINE__)) + if ( any(element_id == carbon_elements_list) ) then + retrans = prt_params%turnover_carb_retrans(ipft,prt_params%organ_param_id(organ_id)) + else if( element_id == nitrogen_element ) then + retrans = prt_params%turnover_nitr_retrans(ipft,prt_params%organ_param_id(organ_id)) + else if( element_id == phosphorus_element ) then + retrans = prt_params%turnover_phos_retrans(ipft,prt_params%organ_param_id(organ_id)) + else + write(fates_log(),*) 'Please add a new re-translocation clause to your ' + write(fates_log(),*) ' organ x element combination' + write(fates_log(),*) ' organ: ',leaf_organ,' element: ',element_id + write(fates_log(),*) 'Exiting' + call endrun(msg=errMsg(__FILE__, __LINE__)) + end if end if - + ! Get the variable id of the storage pool for this element store_var_id = prt_global%sp_organ_map(store_organ,element_id) @@ -707,22 +719,28 @@ subroutine MaintTurnoverSimpleRetranslocation(prt,ipft,is_drought) base_turnover(repro_organ) = 0.0_r8 do i_var = 1, prt_global%num_vars - + organ_id = prt_global%state_descriptor(i_var)%organ_id element_id = prt_global%state_descriptor(i_var)%element_id - if ( any(element_id == carbon_elements_list) ) then - retrans_frac = prt_params%turnover_carb_retrans(ipft,organ_id) - else if( element_id == nitrogen_element ) then - retrans_frac = prt_params%turnover_nitr_retrans(ipft,organ_id) - else if( element_id == phosphorus_element ) then - retrans_frac = prt_params%turnover_phos_retrans(ipft,organ_id) + ! If this organ does not have a retranslocation rate + ! then it is not valid for turnover + if( prt_params%organ_param_id(organ_id) < 1 ) then + retrans_frac = 0._r8 else - write(fates_log(),*) 'Please add a new re-translocation clause to your ' - write(fates_log(),*) ' organ x element combination' - write(fates_log(),*) ' organ: ',organ_id,' element: ',element_id - write(fates_log(),*) 'Exiting' - call endrun(msg=errMsg(__FILE__, __LINE__)) + if ( any(element_id == carbon_elements_list) ) then + retrans_frac = prt_params%turnover_carb_retrans(ipft,prt_params%organ_param_id(organ_id)) + else if( element_id == nitrogen_element ) then + retrans_frac = prt_params%turnover_nitr_retrans(ipft,prt_params%organ_param_id(organ_id)) + else if( element_id == phosphorus_element ) then + retrans_frac = prt_params%turnover_phos_retrans(ipft,prt_params%organ_param_id(organ_id)) + else + write(fates_log(),*) 'Please add a new re-translocation clause to your ' + write(fates_log(),*) ' organ x element combination' + write(fates_log(),*) ' organ: ',organ_id,' element: ',element_id + write(fates_log(),*) 'Exiting' + call endrun(msg=errMsg(__FILE__, __LINE__)) + end if end if if(base_turnover(organ_id) < check_initialized) then @@ -790,7 +808,6 @@ subroutine MaintTurnoverSimpleRetranslocation(prt,ipft,is_drought) end do end do - return end subroutine MaintTurnoverSimpleRetranslocation diff --git a/parteh/PRTParametersMod.F90 b/parteh/PRTParametersMod.F90 index 2acb706f8d..dfa7358f51 100644 --- a/parteh/PRTParametersMod.F90 +++ b/parteh/PRTParametersMod.F90 @@ -13,9 +13,9 @@ module PRTParametersMod ! The following three PFT classes ! are mutually exclusive - real(r8), allocatable :: stress_decid(:) ! Is the plant stress deciduous? (1=yes, 0=no) - real(r8), allocatable :: season_decid(:) ! Is the plant seasonally deciduous (1=yes, 0=no) - real(r8), allocatable :: evergreen(:) ! Is the plant an evergreen (1=yes, 0=no) + integer, allocatable :: stress_decid(:) ! Is the plant stress deciduous? (1=yes, 0=no) + integer, allocatable :: season_decid(:) ! Is the plant seasonally deciduous (1=yes, 0=no) + integer, allocatable :: evergreen(:) ! Is the plant an evergreen (1=yes, 0=no) ! Growth and Turnover Parameters @@ -48,7 +48,23 @@ module PRTParametersMod real(r8), allocatable :: nitr_stoich_p1(:,:) ! Parameter 1 for nitrogen stoichiometry (pft x organ) real(r8), allocatable :: nitr_stoich_p2(:,:) ! Parameter 2 for nitrogen stoichiometry (pft x organ) real(r8), allocatable :: phos_stoich_p1(:,:) ! Parameter 1 for phosphorus stoichiometry (pft x organ) - real(r8), allocatable :: phos_stoich_p2(:,:) ! Parameter 2 for phosphorus stoichiometry (pft x organ) + real(r8), allocatable :: phos_stoich_p2(:,:) ! Parameter 2 for phosphorus stoichiometry (pft x organ) + + real(r8), allocatable :: nitr_store_ratio(:) ! This is the ratio of the target nitrogen stored per + ! target nitrogen that is bound into the tissues + ! of leaves, fine-roots and sapwood + + + real(r8), allocatable :: phos_store_ratio(:) ! This is the ratio of the target phosphorus stored per + ! target phosphorus is bound into the tissues + ! of leaves, fine-roots and sapwood + + integer, allocatable :: organ_id(:) ! Mapping of the organ index in the parameter file, to the + ! global list of organs found in PRTGenericMod.F90 + + + + real(r8), allocatable :: alloc_priority(:,:) ! Allocation priority for each organ (pft x organ) [integer 0-6] real(r8), allocatable :: cushion(:) ! labile carbon storage target as multiple of leaf pool. real(r8), allocatable :: leaf_stor_priority(:) ! leaf turnover vs labile carbon use prioritisation @@ -59,6 +75,19 @@ module PRTParametersMod real(r8), allocatable :: seed_alloc(:) ! fraction of carbon balance allocated to seeds. + ! Derived parameters + + integer, allocatable :: organ_param_id(:) ! This is the sparse reverse lookup index map. This is dimensioned + ! by all the possible organs in parteh, and each index + ! may point to the index in the parameter file, or will be -1 + + real(r8), allocatable :: nitr_recr_stoich(:) ! This is the N:C ratio of newly recruited plants that are + ! on allometry at their recruitment diameter + + real(r8), allocatable :: phos_recr_stoich(:) ! This is the P:C ratio of newly recruited plants that are + ! on allometry at their recruitment diameter + + ! Allometry Parameters ! -------------------------------------------------------------------------------------------- @@ -108,6 +137,12 @@ module PRTParametersMod real(r8), allocatable :: allom_agb3(:) ! Parameter 3 for agb allometry real(r8), allocatable :: allom_agb4(:) ! Parameter 3 for agb allometry + real(r8), allocatable :: allom_zroot_max_dbh(:) ! dbh at which maximum rooting depth saturates (largest possible) [cm] + real(r8), allocatable :: allom_zroot_max_z(:) ! the maximum rooting depth defined at dbh = fates_allom_zroot_max_dbh [m] + real(r8), allocatable :: allom_zroot_min_dbh(:) ! dbh at which the maximum rooting depth for a recruit is defined [cm] + real(r8), allocatable :: allom_zroot_min_z(:) ! the maximum rooting depth defined at dbh = fates_allom_zroot_min_dbh [m] + real(r8), allocatable :: allom_zroot_k(:) ! scale coefficient of logistic rooting depth model + end type prt_param_type diff --git a/parteh/PRTParamsFATESMod.F90 b/parteh/PRTParamsFATESMod.F90 index 3b56c571ff..dce172d47d 100644 --- a/parteh/PRTParamsFATESMod.F90 +++ b/parteh/PRTParamsFATESMod.F90 @@ -12,10 +12,26 @@ module PRTInitParamsFatesMod use PRTGenericMod, only : num_organ_types use PRTGenericMod, only : leaf_organ, fnrt_organ, store_organ use PRTGenericMod, only : sapw_organ, struct_organ, repro_organ + use PRTGenericMod, only : nitrogen_element, phosphorus_element use FatesGlobals, only : endrun => fates_endrun use FatesGlobals, only : fates_log use shr_log_mod, only : errMsg => shr_log_errMsg + use EDPftvarcon, only : EDPftvarcon_inst use PRTGenericMod, only : prt_cnp_flex_allom_hyp,prt_carbon_allom_hyp + use FatesAllometryMod , only : h_allom + use FatesAllometryMod , only : h2d_allom + use FatesAllometryMod , only : bagw_allom + use FatesAllometryMod , only : bsap_allom + use FatesAllometryMod , only : bleaf + use FatesAllometryMod , only : bfineroot + use FatesAllometryMod , only : bdead_allom + use FatesAllometryMod , only : bstore_allom + use FatesAllometryMod , only : bbgw_allom + use FatesAllometryMod , only : carea_allom + use FatesAllometryMod , only : CheckIntegratedAllometries + use FatesAllometryMod, only : set_root_fraction + use PRTGenericMod, only : StorageNutrientTarget + use EDTypesMod, only : init_recruit_trim ! ! !PUBLIC TYPES: @@ -33,6 +49,7 @@ module PRTInitParamsFatesMod public :: PRTRegisterParams public :: PRTReceiveParams public :: PRTCheckParams + public :: PRTDerivedParams !----------------------------------------------------------------------- contains @@ -51,7 +68,8 @@ subroutine PRTRegisterParams(fates_params) call PRTRegisterPFTOrgans(fates_params) call PRTRegisterPFTLeafAge(fates_params) call Register_PFT_nvariants(fates_params) - + call PRTRegisterOrgan(fates_params) + end subroutine PRTRegisterParams !----------------------------------------------------------------------- @@ -67,10 +85,58 @@ subroutine PRTReceiveParams(fates_params) call PRTReceivePFTOrgans(fates_params) call PRTReceivePFTLeafAge(fates_params) call Receive_PFT_nvariants(fates_params) + call PRTReceiveOrgan(fates_params) end subroutine PRTReceiveParams - !----------------------------------------------------------------------- + ! ===================================================================================== + + subroutine PRTRegisterOrgan(fates_params) + + use FatesParametersInterface, only : fates_parameters_type, param_string_length + use FatesParametersInterface, only : dimension_name_prt_organs, dimension_shape_1d + + implicit none + + class(fates_parameters_type), intent(inout) :: fates_params + + character(len=param_string_length), parameter :: dim_names(1) = (/dimension_name_prt_organs/) + integer, parameter :: dim_lower_bound(1) = (/ lower_bound_general /) + character(len=param_string_length) :: name + + name = 'fates_prt_organ_id' + call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names, lower_bounds=dim_lower_bound) + + end subroutine PRTRegisterOrgan + + ! ===================================================================================== + + subroutine PRTReceiveOrgan(fates_params) + + ! Make sure to call this after PRTRegisterPFTOrgans + + use FatesParametersInterface, only : fates_parameters_type, param_string_length + + implicit none + + class(fates_parameters_type), intent(inout) :: fates_params + + character(len=param_string_length) :: name + + real(r8), allocatable :: tmpreal(:) ! Temporary variable to hold floats + + name = 'fates_prt_organ_id' + call fates_params%RetreiveParameterAllocate(name=name, & + data=tmpreal) + allocate(prt_params%organ_id(size(tmpreal,dim=1))) + call ArrayNint(tmpreal,prt_params%organ_id) + deallocate(tmpreal) + + end subroutine PRTReceiveOrgan + + ! ===================================================================================== + subroutine PRTRegisterPFT(fates_params) use FatesParametersInterface, only : fates_parameters_type, param_string_length @@ -97,11 +163,6 @@ subroutine PRTRegisterPFT(fates_params) call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & dimension_names=dim_names, lower_bounds=dim_lower_bound) - - !X! name = '' - !X! call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & - !X! dimension_names=dim_names, lower_bounds=dim_lower_bound) - name = 'fates_fnrt_prof_a' call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & dimension_names=dim_names, lower_bounds=dim_lower_bound) @@ -270,6 +331,26 @@ subroutine PRTRegisterPFT(fates_params) call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & dimension_names=dim_names, lower_bounds=dim_lower_bound) + name = 'fates_allom_zroot_max_dbh' + call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names, lower_bounds=dim_lower_bound) + + name = 'fates_allom_zroot_max_z' + call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names, lower_bounds=dim_lower_bound) + + name = 'fates_allom_zroot_min_dbh' + call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names, lower_bounds=dim_lower_bound) + + name = 'fates_allom_zroot_min_z' + call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names, lower_bounds=dim_lower_bound) + + name = 'fates_allom_zroot_k' + call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names, lower_bounds=dim_lower_bound) + name = 'fates_turnover_retrans_mode' call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & dimension_names=dim_names, lower_bounds=dim_lower_bound) @@ -277,6 +358,16 @@ subroutine PRTRegisterPFT(fates_params) name = 'fates_branch_turnover' call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & dimension_names=dim_names, lower_bounds=dim_lower_bound) + + + + name = 'fates_nitr_store_ratio' + call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names, lower_bounds=dim_lower_bound) + + name = 'fates_phos_store_ratio' + call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names, lower_bounds=dim_lower_bound) end subroutine PRTRegisterPFT @@ -292,22 +383,30 @@ subroutine PRTReceivePFT(fates_params) character(len=param_string_length) :: name - !X! name = '' - !X! call fates_params%RetreiveParameter(name=name, & - !X! data=prt_params%) + real(r8), allocatable :: tmpreal(:) ! Temporary variable to hold floats + ! that are converted to ints name = 'fates_phen_stress_decid' call fates_params%RetreiveParameterAllocate(name=name, & - data=prt_params%stress_decid) - + data=tmpreal) + allocate(prt_params%stress_decid(size(tmpreal,dim=1))) + call ArrayNint(tmpreal,prt_params%stress_decid) + deallocate(tmpreal) + name = 'fates_phen_season_decid' call fates_params%RetreiveParameterAllocate(name=name, & - data=prt_params%season_decid) - + data=tmpreal) + allocate(prt_params%season_decid(size(tmpreal,dim=1))) + call ArrayNint(tmpreal,prt_params%season_decid) + deallocate(tmpreal) + name = 'fates_phen_evergreen' call fates_params%RetreiveParameterAllocate(name=name, & - data=prt_params%evergreen) - + data=tmpreal) + allocate(prt_params%evergreen(size(tmpreal,dim=1))) + call ArrayNint(tmpreal,prt_params%evergreen) + deallocate(tmpreal) + name = 'fates_leaf_slamax' call fates_params%RetreiveParameterAllocate(name=name, & data=prt_params%slamax) @@ -475,7 +574,27 @@ subroutine PRTReceivePFT(fates_params) name = 'fates_allom_agb4' call fates_params%RetreiveParameterAllocate(name=name, & data=prt_params%allom_agb4) - + + name = 'fates_allom_zroot_max_dbh' + call fates_params%RetreiveParameterAllocate(name=name, & + data=prt_params%allom_zroot_max_dbh) + + name = 'fates_allom_zroot_max_z' + call fates_params%RetreiveParameterAllocate(name=name, & + data=prt_params%allom_zroot_max_z) + + name = 'fates_allom_zroot_min_dbh' + call fates_params%RetreiveParameterAllocate(name=name, & + data=prt_params%allom_zroot_min_dbh) + + name = 'fates_allom_zroot_min_z' + call fates_params%RetreiveParameterAllocate(name=name, & + data=prt_params%allom_zroot_min_z) + + name = 'fates_allom_zroot_k' + call fates_params%RetreiveParameterAllocate(name=name, & + data=prt_params%allom_zroot_k) + name = 'fates_branch_turnover' call fates_params%RetreiveParameterAllocate(name=name, & data=prt_params%branch_long) @@ -484,7 +603,15 @@ subroutine PRTReceivePFT(fates_params) call fates_params%RetreiveParameterAllocate(name=name, & data=prt_params%turnover_retrans_mode) - + name = 'fates_nitr_store_ratio' + call fates_params%RetreiveParameterAllocate(name=name, & + data=prt_params%nitr_store_ratio) + + name = 'fates_phos_store_ratio' + call fates_params%RetreiveParameterAllocate(name=name, & + data=prt_params%phos_store_ratio) + + end subroutine PRTReceivePFT !----------------------------------------------------------------------- @@ -513,6 +640,21 @@ subroutine PRTRegisterPFTLeafAge(fates_params) return end subroutine PRTRegisterPFTLeafAge + ! ===================================================================================== + + subroutine ArrayNint(realarr,intarr) + + real(r8),intent(in) :: realarr(:) + integer,intent(out) :: intarr(:) + integer :: i + + do i = 1,size(realarr,dim=1) + intarr(i) = nint(realarr(i)) + end do + + return + end subroutine ArrayNint + ! ===================================================================================== subroutine Register_PFT_nvariants(fates_params) @@ -748,6 +890,13 @@ subroutine FatesReportPFTParams(is_master) write(fates_log(),fmt0) 'allom_agb2 = ',prt_params%allom_agb2 write(fates_log(),fmt0) 'allom_agb3 = ',prt_params%allom_agb3 write(fates_log(),fmt0) 'allom_agb4 = ',prt_params%allom_agb4 + + write(fates_log(),fmt0) 'allom_zroot_max_dbh = ',prt_params%allom_zroot_max_dbh + write(fates_log(),fmt0) 'allom_zroot_max_z = ',prt_params%allom_zroot_max_z + write(fates_log(),fmt0) 'allom_zroot_min_dbh = ',prt_params%allom_zroot_min_dbh + write(fates_log(),fmt0) 'allom_zroot_min_z = ',prt_params%allom_zroot_min_z + write(fates_log(),fmt0) 'allom_zroot_k = ',prt_params%allom_zroot_k + write(fates_log(),fmt0) 'prt_nitr_stoich_p1 = ',prt_params%nitr_stoich_p1 write(fates_log(),fmt0) 'prt_nitr_stoich_p2 = ',prt_params%nitr_stoich_p2 write(fates_log(),fmt0) 'prt_phos_stoich_p1 = ',prt_params%phos_stoich_p1 @@ -760,12 +909,54 @@ subroutine FatesReportPFTParams(is_master) write(fates_log(),fmt0) 'turnover_carb_retrans = ',prt_params%turnover_carb_retrans write(fates_log(),fmt0) 'turnover_nitr_retrans = ',prt_params%turnover_nitr_retrans write(fates_log(),fmt0) 'turnover_phos_retrans = ',prt_params%turnover_phos_retrans + write(fates_log(),fmt0) 'organ_id = ',prt_params%organ_id + write(fates_log(),fmt0) 'nitr_store_ratio = ',prt_params%nitr_store_ratio + write(fates_log(),fmt0) 'phos_store_ratio = ',prt_params%phos_store_ratio write(fates_log(),*) '-------------------------------------------------' end if end subroutine FatesReportPFTParams + ! ===================================================================================== + + subroutine PRTDerivedParams() + + integer :: npft ! number of PFTs + integer :: ft ! pft index + integer :: norgans ! number of organs in the parameter file + integer :: i, io ! generic loop index and organ loop index + + norgans = size(prt_params%organ_id,1) + npft = size(prt_params%evergreen,1) + + ! Set the reverse lookup map for organs to the parameter file index + allocate(prt_params%organ_param_id(num_organ_types)) + allocate(prt_params%nitr_recr_stoich(npft)) + allocate(prt_params%phos_recr_stoich(npft)) + + ! Initialize them as invalid + prt_params%organ_param_id(:) = -1 + + do i = 1,norgans + prt_params%organ_param_id(prt_params%organ_id(i)) = i + end do + + + ! Calculate the stoichiometry of a new recruit, and use this for defining + ! seed stoichiometry and + + do ft = 1,npft + + prt_params%nitr_recr_stoich(ft) = NewRecruitTotalStoichiometry(ft,nitrogen_element) + prt_params%phos_recr_stoich(ft) = NewRecruitTotalStoichiometry(ft,phosphorus_element) + + end do + + + return + end subroutine PRTDerivedParams + ! ===================================================================================== subroutine PRTCheckParams(is_master) @@ -793,37 +984,53 @@ subroutine PRTCheckParams(is_master) integer :: norgans ! size of the plant organ dimension integer :: i, io ! generic loop index and organ loop index - - integer, parameter,dimension(6) :: cnpflex_organs = & - [leaf_organ, fnrt_organ, sapw_organ, store_organ, repro_organ, struct_organ] - - npft = size(prt_params%evergreen,1) ! Prior to performing checks copy grperc to the ! organ dimensioned version - norgans = size(prt_params%nitr_stoich_p1,2) + norgans = size(prt_params%organ_id,1) if(.not.is_master) return - - - if (norgans .ne. num_organ_types) then - write(fates_log(),*) 'The size of the organ dimension for PRT parameters' - write(fates_log(),*) 'as specified in the parameter file is incompatible.' - write(fates_log(),*) 'All currently acceptable hypothesese are using' - write(fates_log(),*) 'the full set of num_organ_types = ',num_organ_types - write(fates_log(),*) 'The parameter file listed ',norgans - write(fates_log(),*) 'Exiting' + if( any(prt_params%organ_id(:)<1) .or. & + any(prt_params%organ_id(:)>num_organ_types) ) then + write(fates_log(),*) 'prt_organ_ids should match the global ids' + write(fates_log(),*) 'of organ types found in PRTGenericMod.F90' + write(fates_log(),*) 'organ_ids: ',prt_params%organ_id(:) + write(fates_log(),*) 'Aborting' call endrun(msg=errMsg(sourcefile, __LINE__)) end if - + ! Check to make sure the organ ids are valid if this is the + ! cnp_flex_allom_hypothesis + if ((hlm_parteh_mode .eq. prt_cnp_flex_allom_hyp) .or. & + (hlm_parteh_mode .eq. prt_carbon_allom_hyp) ) then + + do io = 1,norgans + if(prt_params%organ_id(io) == repro_organ) then + write(fates_log(),*) 'with flexible cnp or c-only alloc hypothesese' + write(fates_log(),*) 'reproductive tissues are a special case' + write(fates_log(),*) 'and therefore should not be included in' + write(fates_log(),*) 'the parameter file organ list' + write(fates_log(),*) 'fates_prt_organ_id: ',prt_params%organ_id(:) + write(fates_log(),*) 'Aborting' + end if + if(prt_params%organ_id(io) == store_organ) then + write(fates_log(),*) 'with flexible cnp or c-only alloc hypothesese' + write(fates_log(),*) 'storage is a special case' + write(fates_log(),*) 'and therefore should not be included in' + write(fates_log(),*) 'the parameter file organ list' + write(fates_log(),*) 'fates_prt_organ_id: ',prt_params%organ_id(:) + write(fates_log(),*) 'Aborting' + end if + + end do + end if - do ipft = 1,npft - + pftloop: do ipft = 1,npft + ! Check to see if evergreen, deciduous flags are mutually exclusive ! ---------------------------------------------------------------------------------- @@ -912,134 +1119,116 @@ subroutine PRTCheckParams(is_master) ! should not be re-translocating mass upon turnover. ! Note to advanced users. Feel free to remove these checks... ! ------------------------------------------------------------------- - - if ( (prt_params%turnover_carb_retrans(ipft,repro_organ) > nearzero) ) then - write(fates_log(),*) ' Retranslocation of reproductive tissues should be zero.' - write(fates_log(),*) ' PFT#: ',ipft - write(fates_log(),*) ' carbon: ',prt_params%turnover_carb_retrans(ipft,repro_organ) - write(fates_log(),*) ' Aborting' - call endrun(msg=errMsg(sourcefile, __LINE__)) - end if - if (hlm_parteh_mode .eq. prt_cnp_flex_allom_hyp) then - if ((prt_params%turnover_nitr_retrans(ipft,repro_organ) > nearzero) .or. & - (prt_params%turnover_phos_retrans(ipft,repro_organ) > nearzero) ) then - write(fates_log(),*) ' Retranslocation of reproductive tissues should be zero.' - write(fates_log(),*) ' PFT#: ',ipft - write(fates_log(),*) ' carbon: ',prt_params%turnover_carb_retrans(ipft,repro_organ) - write(fates_log(),*) ' nitr: ',prt_params%turnover_nitr_retrans(ipft,repro_organ) - write(fates_log(),*) ' phos: ',prt_params%turnover_phos_retrans(ipft,repro_organ) - write(fates_log(),*) ' Aborting' - call endrun(msg=errMsg(sourcefile, __LINE__)) - end if - end if - - if ((prt_params%turnover_carb_retrans(ipft,sapw_organ) > nearzero)) then - write(fates_log(),*) ' Retranslocation of sapwood tissues should be zero.' - write(fates_log(),*) ' PFT#: ',ipft - write(fates_log(),*) ' carbon: ',prt_params%turnover_carb_retrans(ipft,sapw_organ) - write(fates_log(),*) ' Aborting' - call endrun(msg=errMsg(sourcefile, __LINE__)) - end if - if (hlm_parteh_mode .eq. prt_cnp_flex_allom_hyp) then - if ((prt_params%turnover_nitr_retrans(ipft,sapw_organ) > nearzero) .or. & - (prt_params%turnover_phos_retrans(ipft,sapw_organ) > nearzero) ) then - write(fates_log(),*) ' Retranslocation of sapwood tissues should be zero.' - write(fates_log(),*) ' PFT#: ',ipft - write(fates_log(),*) ' carbon: ',prt_params%turnover_carb_retrans(ipft,sapw_organ) - write(fates_log(),*) ' nitr: ',prt_params%turnover_nitr_retrans(ipft,sapw_organ) - write(fates_log(),*) ' phos: ',prt_params%turnover_phos_retrans(ipft,sapw_organ) - write(fates_log(),*) ' Aborting' - call endrun(msg=errMsg(sourcefile, __LINE__)) - end if - end if - if ((prt_params%turnover_carb_retrans(ipft,struct_organ) > nearzero)) then - write(fates_log(),*) ' Retranslocation of structural(dead) tissues should be zero.' - write(fates_log(),*) ' PFT#: ',ipft - write(fates_log(),*) ' carbon: ',prt_params%turnover_carb_retrans(ipft,struct_organ) - write(fates_log(),*) ' Aborting' - call endrun(msg=errMsg(sourcefile, __LINE__)) - end if - if (hlm_parteh_mode .eq. prt_cnp_flex_allom_hyp) then - if ((prt_params%turnover_nitr_retrans(ipft,struct_organ) > nearzero) .or. & - (prt_params%turnover_phos_retrans(ipft,struct_organ) > nearzero) ) then - write(fates_log(),*) ' Retranslocation of structural(dead) tissues should be zero.' - write(fates_log(),*) ' PFT#: ',ipft - write(fates_log(),*) ' nitr: ',prt_params%turnover_nitr_retrans(ipft,struct_organ) - write(fates_log(),*) ' phos: ',prt_params%turnover_phos_retrans(ipft,struct_organ) - write(fates_log(),*) ' Aborting' - call endrun(msg=errMsg(sourcefile, __LINE__)) - end if + if ((hlm_parteh_mode .eq. prt_cnp_flex_allom_hyp) .or. & + (hlm_parteh_mode .eq. prt_carbon_allom_hyp) ) then + + do i = 1,norgans + io = prt_params%organ_id(i) + + if(io == sapw_organ) then + if ((prt_params%turnover_carb_retrans(ipft,i) > nearzero)) then + write(fates_log(),*) ' Retranslocation of sapwood tissues should be zero.' + write(fates_log(),*) ' PFT#: ',ipft + write(fates_log(),*) ' carbon retrans: ',prt_params%turnover_carb_retrans(ipft,i) + write(fates_log(),*) ' Aborting' + call endrun(msg=errMsg(sourcefile, __LINE__)) + end if + elseif(io == struct_organ) then + if ((prt_params%turnover_carb_retrans(ipft,i) > nearzero)) then + write(fates_log(),*) ' Retranslocation of structural tissues should be zero.' + write(fates_log(),*) ' PFT#: ',ipft + write(fates_log(),*) ' carbon retrans: ',prt_params%turnover_carb_retrans(ipft,i) + write(fates_log(),*) ' Aborting' + call endrun(msg=errMsg(sourcefile, __LINE__)) + end if + end if + + ! Otherwise, all other retranslocations should be between 0 and 1 + if ( (prt_params%turnover_carb_retrans(ipft,i) > 1.0_r8) .or. & + (prt_params%turnover_carb_retrans(ipft,i) < 0.0_r8) ) then + write(fates_log(),*) ' Retranslocation rates should be between 0 and 1.' + write(fates_log(),*) ' PFT#: ',ipft + write(fates_log(),*) ' parameter file index: ',i,' global index: ',io + write(fates_log(),*) ' retranslocation rate: ',prt_params%turnover_carb_retrans(ipft,i) + write(fates_log(),*) ' Aborting' + call endrun(msg=errMsg(sourcefile, __LINE__)) + end if + + end do end if - ! Leaf retranslocation should be between 0 and 1 - if ( (prt_params%turnover_carb_retrans(ipft,leaf_organ) > 1.0_r8) .or. & - (prt_params%turnover_carb_retrans(ipft,leaf_organ) < 0.0_r8) ) then - write(fates_log(),*) ' Retranslocation of leaf tissues should be between 0 and 1.' - write(fates_log(),*) ' PFT#: ',ipft - write(fates_log(),*) ' carbon: ',prt_params%turnover_carb_retrans(ipft,leaf_organ) - write(fates_log(),*) ' Aborting' - call endrun(msg=errMsg(sourcefile, __LINE__)) - end if if (hlm_parteh_mode .eq. prt_cnp_flex_allom_hyp) then - if ((prt_params%turnover_nitr_retrans(ipft,leaf_organ) > 1.0_r8) .or. & - (prt_params%turnover_phos_retrans(ipft,leaf_organ) > 1.0_r8) .or. & - (prt_params%turnover_nitr_retrans(ipft,leaf_organ) < 0.0_r8) .or. & - (prt_params%turnover_phos_retrans(ipft,leaf_organ) < 0.0_r8)) then - write(fates_log(),*) ' Retranslocation of leaf tissues should be between 0 and 1.' - write(fates_log(),*) ' PFT#: ',ipft - write(fates_log(),*) ' nitr: ',prt_params%turnover_nitr_retrans(ipft,leaf_organ) - write(fates_log(),*) ' phos: ',prt_params%turnover_phos_retrans(ipft,leaf_organ) - write(fates_log(),*) ' Aborting' + + ! Make sure nutrient storage fractions are positive + if( prt_params%nitr_store_ratio(ipft) < 0._r8 ) then + write(fates_log(),*) 'With parteh allometric CNP hypothesis' + write(fates_log(),*) 'nitr_store_ratio must be > 0' + write(fates_log(),*) 'PFT#: ',ipft + write(fates_log(),*) 'nitr_store_ratio = ',prt_params%nitr_store_ratio(ipft) call endrun(msg=errMsg(sourcefile, __LINE__)) end if - end if - - ! Fineroot retranslocation should be between 0-1 - if ((prt_params%turnover_carb_retrans(ipft,fnrt_organ) > 1.0_r8) .or. & - (prt_params%turnover_carb_retrans(ipft,fnrt_organ) < 0.0_r8)) then - write(fates_log(),*) ' Retranslocation of leaf tissues should be between 0 and 1.' - write(fates_log(),*) ' PFT#: ',ipft - write(fates_log(),*) ' carbon: ',prt_params%turnover_carb_retrans(ipft,fnrt_organ) - write(fates_log(),*) ' Aborting' - call endrun(msg=errMsg(sourcefile, __LINE__)) - end if - if (hlm_parteh_mode .eq. prt_cnp_flex_allom_hyp) then - if ((prt_params%turnover_nitr_retrans(ipft,fnrt_organ) > 1.0_r8) .or. & - (prt_params%turnover_phos_retrans(ipft,fnrt_organ) > 1.0_r8) .or. & - (prt_params%turnover_nitr_retrans(ipft,fnrt_organ) < 0.0_r8) .or. & - (prt_params%turnover_phos_retrans(ipft,fnrt_organ) < 0.0_r8)) then - write(fates_log(),*) ' Retranslocation of leaf tissues should be between 0 and 1.' - write(fates_log(),*) ' PFT#: ',ipft - write(fates_log(),*) ' nitr: ',prt_params%turnover_nitr_retrans(ipft,fnrt_organ) - write(fates_log(),*) ' phos: ',prt_params%turnover_phos_retrans(ipft,fnrt_organ) - write(fates_log(),*) ' Aborting' + if( prt_params%phos_store_ratio(ipft) < 0._r8 ) then + write(fates_log(),*) 'With parteh allometric CNP hypothesis' + write(fates_log(),*) 'phos_store_ratio must be > 0' + write(fates_log(),*) 'PFT#: ',ipft + write(fates_log(),*) 'nitr_store_ratio = ',prt_params%phos_store_ratio(ipft) call endrun(msg=errMsg(sourcefile, __LINE__)) end if - end if - ! Storage retranslocation should be between 0-1 (storage retrans seems weird, but who knows) - if ((prt_params%turnover_carb_retrans(ipft,store_organ) > 1.0_r8) .or. & - (prt_params%turnover_carb_retrans(ipft,store_organ) < 0.0_r8)) then - write(fates_log(),*) ' Retranslocation of leaf tissues should be between 0 and 1.' - write(fates_log(),*) ' PFT#: ',ipft - write(fates_log(),*) ' carbon: ',prt_params%turnover_carb_retrans(ipft,store_organ) - write(fates_log(),*) ' Aborting' - call endrun(msg=errMsg(sourcefile, __LINE__)) - end if - if (hlm_parteh_mode .eq. prt_cnp_flex_allom_hyp) then - if ((prt_params%turnover_nitr_retrans(ipft,store_organ) > 1.0_r8) .or. & - (prt_params%turnover_phos_retrans(ipft,store_organ) > 1.0_r8) .or. & - (prt_params%turnover_nitr_retrans(ipft,store_organ) < 0.0_r8) .or. & - (prt_params%turnover_phos_retrans(ipft,store_organ) < 0.0_r8)) then - write(fates_log(),*) ' Retranslocation of leaf tissues should be between 0 and 1.' - write(fates_log(),*) ' PFT#: ',ipft - write(fates_log(),*) ' nitr: ',prt_params%turnover_nitr_retrans(ipft,store_organ) - write(fates_log(),*) ' phos: ',prt_params%turnover_phos_retrans(ipft,store_organ) - write(fates_log(),*) ' Aborting' - call endrun(msg=errMsg(sourcefile, __LINE__)) - end if + do i = 1,norgans + io = prt_params%organ_id(i) + + if(io == sapw_organ) then + if ((prt_params%turnover_nitr_retrans(ipft,i) > nearzero)) then + write(fates_log(),*) ' Retranslocation of sapwood tissues should be zero.' + write(fates_log(),*) ' PFT#: ',ipft + write(fates_log(),*) ' nitrogen retrans: ',prt_params%turnover_nitr_retrans(ipft,i) + write(fates_log(),*) ' Aborting' + call endrun(msg=errMsg(sourcefile, __LINE__)) + end if + if ((prt_params%turnover_phos_retrans(ipft,i) > nearzero)) then + write(fates_log(),*) ' Retranslocation of sapwood tissues should be zero.' + write(fates_log(),*) ' PFT#: ',ipft + write(fates_log(),*) ' phosphorus retrans: ',prt_params%turnover_nitr_retrans(ipft,i) + write(fates_log(),*) ' Aborting' + call endrun(msg=errMsg(sourcefile, __LINE__)) + end if + elseif(io == struct_organ) then + if ((prt_params%turnover_nitr_retrans(ipft,i) > nearzero)) then + write(fates_log(),*) ' Retranslocation of structural tissues should be zero.' + write(fates_log(),*) ' PFT#: ',ipft + write(fates_log(),*) ' carbon retrans: ',prt_params%turnover_nitr_retrans(ipft,i) + write(fates_log(),*) ' Aborting' + call endrun(msg=errMsg(sourcefile, __LINE__)) + end if + if ((prt_params%turnover_phos_retrans(ipft,i) > nearzero)) then + write(fates_log(),*) ' Retranslocation of structural tissues should be zero.' + write(fates_log(),*) ' PFT#: ',ipft + write(fates_log(),*) ' phosphorus retrans: ',prt_params%turnover_nitr_retrans(ipft,i) + write(fates_log(),*) ' Aborting' + call endrun(msg=errMsg(sourcefile, __LINE__)) + end if + end if + + ! Otherwise, all other retranslocations should be between 0 and 1 + if ((prt_params%turnover_nitr_retrans(ipft,i) > 1.0_r8) .or. & + (prt_params%turnover_phos_retrans(ipft,i) > 1.0_r8) .or. & + (prt_params%turnover_nitr_retrans(ipft,i) < 0.0_r8) .or. & + (prt_params%turnover_phos_retrans(ipft,i) < 0.0_r8)) then + write(fates_log(),*) ' Retranslocation should range from 0 to 1.' + write(fates_log(),*) ' PFT#: ',ipft + write(fates_log(),*) ' parameter file organ index: ',i,' global index: ',io + write(fates_log(),*) ' nitr: ',prt_params%turnover_nitr_retrans(ipft,i) + write(fates_log(),*) ' phos: ',prt_params%turnover_phos_retrans(ipft,i) + write(fates_log(),*) ' Aborting' + call endrun(msg=errMsg(sourcefile, __LINE__)) + end if + + end do + end if + ! Growth respiration ! if (parteh_mode .eq. prt_carbon_allom_hyp) then @@ -1060,30 +1249,30 @@ subroutine PRTCheckParams(is_master) ! end if ! end if - - ! The first nitrogen stoichiometry is used in all cases - if ( (any(prt_params%nitr_stoich_p1(ipft,:) < 0.0_r8)) .or. & - (any(prt_params%nitr_stoich_p1(ipft,:) >= 1.0_r8))) then - write(fates_log(),*) ' PFT#: ',ipft - write(fates_log(),*) ' N per C stoichiometry must bet between 0-1' - write(fates_log(),*) prt_params%nitr_stoich_p1(ipft,:) - write(fates_log(),*) ' Aborting' - call endrun(msg=errMsg(sourcefile, __LINE__)) + if ((hlm_parteh_mode .eq. prt_cnp_flex_allom_hyp) .or. & + (hlm_parteh_mode .eq. prt_carbon_allom_hyp) ) then + ! The first nitrogen stoichiometry is used in all cases + if ( (any(prt_params%nitr_stoich_p1(ipft,:) < 0.0_r8)) .or. & + (any(prt_params%nitr_stoich_p1(ipft,:) >= 1.0_r8))) then + write(fates_log(),*) ' PFT#: ',ipft + write(fates_log(),*) ' N per C stoichiometry must bet between 0-1' + write(fates_log(),*) prt_params%nitr_stoich_p1(ipft,:) + write(fates_log(),*) ' Aborting' + call endrun(msg=errMsg(sourcefile, __LINE__)) + end if end if - if(hlm_parteh_mode .eq. prt_cnp_flex_allom_hyp) then - do i = 1,size(cnpflex_organs,dim=1) - io = cnpflex_organs(i) - if ( (prt_params%nitr_stoich_p1(ipft,io) < 0._r8) .or. & - (prt_params%nitr_stoich_p2(ipft,io) < 0._r8) .or. & - (prt_params%phos_stoich_p1(ipft,io) < 0._r8) .or. & - (prt_params%phos_stoich_p2(ipft,io) < 0._r8) .or. & - (prt_params%nitr_stoich_p1(ipft,io) > 1._r8) .or. & - (prt_params%nitr_stoich_p2(ipft,io) > 1._r8) .or. & - (prt_params%phos_stoich_p1(ipft,io) > 1._r8) .or. & - (prt_params%phos_stoich_p2(ipft,io) > 1._r8) ) then + do i = 1,norgans + if ( (prt_params%nitr_stoich_p1(ipft,i) < 0._r8) .or. & + (prt_params%nitr_stoich_p2(ipft,i) < 0._r8) .or. & + (prt_params%phos_stoich_p1(ipft,i) < 0._r8) .or. & + (prt_params%phos_stoich_p2(ipft,i) < 0._r8) .or. & + (prt_params%nitr_stoich_p1(ipft,i) > 1._r8) .or. & + (prt_params%nitr_stoich_p2(ipft,i) > 1._r8) .or. & + (prt_params%phos_stoich_p1(ipft,i) > 1._r8) .or. & + (prt_params%phos_stoich_p2(ipft,i) > 1._r8) ) then write(fates_log(),*) 'When the C,N,P allocation hypothesis with flexible' write(fates_log(),*) 'stoichiometry is turned on (prt_cnp_flex_allom_hyp),' write(fates_log(),*) 'all stoichiometries must be greater than or equal to zero,' @@ -1093,10 +1282,10 @@ subroutine PRTCheckParams(is_master) write(fates_log(),*) 'You specified an organ/pft less than zero.' write(fates_log(),*) 'PFT: ',ipft write(fates_log(),*) 'organ index (see head of PRTGenericMod): ',io - write(fates_log(),*) 'nitr_stoich_p1: ',prt_params%nitr_stoich_p1(ipft,io) - write(fates_log(),*) 'nitr_stoich_p2: ',prt_params%phos_stoich_p1(ipft,io) - write(fates_log(),*) 'phos_stoich_p1: ',prt_params%nitr_stoich_p2(ipft,io) - write(fates_log(),*) 'phos_stoich_p2: ',prt_params%phos_stoich_p2(ipft,io) + write(fates_log(),*) 'nitr_stoich_p1: ',prt_params%nitr_stoich_p1(ipft,i) + write(fates_log(),*) 'nitr_stoich_p2: ',prt_params%phos_stoich_p1(ipft,i) + write(fates_log(),*) 'phos_stoich_p1: ',prt_params%nitr_stoich_p2(ipft,i) + write(fates_log(),*) 'phos_stoich_p2: ',prt_params%phos_stoich_p2(ipft,i) write(fates_log(),*) 'Aborting' call endrun(msg=errMsg(sourcefile, __LINE__)) end if @@ -1114,8 +1303,6 @@ subroutine PRTCheckParams(is_master) end if - - ! Check turnover time-scales nleafage = size(prt_params%leaf_long,dim=2) @@ -1224,11 +1411,92 @@ subroutine PRTCheckParams(is_master) end if - end do + end do pftloop return end subroutine PRTCheckParams + ! ==================================================================================== + + function NewRecruitTotalStoichiometry(ft,element_id) result(recruit_stoich) + + ! ---------------------------------------------------------------------------------- + ! This function calculates the total N:C or P:C ratio for a newly recruited plant + ! It does this by first identifying the dbh of a new plant, then uses + ! allometry to calculate the starting amount of carbon, and then uses + ! the stoichiometry parameters to determine the proportional mass of N or P + ! + ! This process only has to be called once, and is then stored in parameter + ! constants for each PFT. These values are used for determining nutrient + ! fluxes into seed pools (on plant), and also from germinated seed polls (on ground) + ! into new recruits. + ! ---------------------------------------------------------------------------------- + + + integer,intent(in) :: ft + integer,intent(in) :: element_id + real(r8) :: recruit_stoich ! nutrient to carbon ratio of recruit + + real(r8) :: dbh ! dbh of the new recruit [cm] + real(r8) :: c_leaf ! target leaf biomass [kgC] + real(r8) :: c_fnrt ! target fine root biomass [kgC] + real(r8) :: c_sapw ! target sapwood biomass [kgC] + real(r8) :: a_sapw ! target sapwood cross section are [m2] (dummy) + real(r8) :: c_agw ! target Above ground biomass [kgC] + real(r8) :: c_bgw ! target Below ground biomass [kgC] + real(r8) :: c_struct ! target Structural biomass [kgc] + real(r8) :: c_store ! target Storage biomass [kgC] + real(r8) :: c_total ! total target carbon + real(r8) :: nutr_total ! total target nutrient + + call h2d_allom(EDPftvarcon_inst%hgt_min(ft),ft,dbh) + call bleaf(dbh,ft,init_recruit_trim,c_leaf) + call bfineroot(dbh,ft,init_recruit_trim,c_fnrt) + call bsap_allom(dbh,ft,init_recruit_trim,a_sapw, c_sapw) + call bagw_allom(dbh,ft,c_agw) + call bbgw_allom(dbh,ft,c_bgw) + call bdead_allom(c_agw,c_bgw,c_sapw,ft,c_struct) + call bstore_allom(dbh,ft,init_recruit_trim,c_store) + + ! Total carbon in a newly recruited plant + c_total = c_leaf + c_fnrt + c_sapw + c_struct + c_store + + ! Total nutrient in a newly recruited plant + select case(element_id) + case(nitrogen_element) + + nutr_total = & + c_struct*prt_params%nitr_stoich_p2(ft,prt_params%organ_param_id(struct_organ)) + & + c_leaf*prt_params%nitr_stoich_p2(ft,prt_params%organ_param_id(leaf_organ)) + & + c_fnrt*prt_params%nitr_stoich_p2(ft,prt_params%organ_param_id(fnrt_organ)) + & + c_sapw*prt_params%nitr_stoich_p2(ft,prt_params%organ_param_id(sapw_organ)) + & + StorageNutrientTarget(ft, element_id, & + c_leaf*prt_params%nitr_stoich_p2(ft,prt_params%organ_param_id(leaf_organ)), & + c_fnrt*prt_params%nitr_stoich_p2(ft,prt_params%organ_param_id(fnrt_organ)), & + c_sapw*prt_params%nitr_stoich_p2(ft,prt_params%organ_param_id(sapw_organ)), & + c_struct*prt_params%nitr_stoich_p2(ft,prt_params%organ_param_id(struct_organ))) + + case(phosphorus_element) + + nutr_total = & + c_struct*prt_params%phos_stoich_p2(ft,prt_params%organ_param_id(struct_organ)) + & + c_leaf*prt_params%phos_stoich_p2(ft,prt_params%organ_param_id(leaf_organ)) + & + c_fnrt*prt_params%phos_stoich_p2(ft,prt_params%organ_param_id(fnrt_organ)) + & + c_sapw*prt_params%phos_stoich_p2(ft,prt_params%organ_param_id(sapw_organ)) + & + StorageNutrientTarget(ft, element_id, & + c_leaf*prt_params%phos_stoich_p2(ft,prt_params%organ_param_id(leaf_organ)), & + c_fnrt*prt_params%phos_stoich_p2(ft,prt_params%organ_param_id(fnrt_organ)), & + c_sapw*prt_params%phos_stoich_p2(ft,prt_params%organ_param_id(sapw_organ)), & + c_struct*prt_params%phos_stoich_p2(ft,prt_params%organ_param_id(struct_organ))) + + + end select + + recruit_stoich = nutr_total/c_total + + + return + end function NewRecruitTotalStoichiometry end module PRTInitParamsFatesMod diff --git a/tools/FatesPFTIndexSwapper.py b/tools/FatesPFTIndexSwapper.py index a42d95da10..9e0830d626 100755 --- a/tools/FatesPFTIndexSwapper.py +++ b/tools/FatesPFTIndexSwapper.py @@ -207,13 +207,15 @@ def main(argv): out_var[:] = np.empty([num_pft_out,dim2_len], dtype="S{}".format(dim2_len)) for id,ipft in enumerate(donor_pft_indices): out_var[id] = fp_in.variables.get(key).data[ipft-1] - - + elif( (prt_dim_found==0) & (pft_dim_len==2) ): # fates_prt_organs - string_length out_var = fp_out.createVariable(key,'c',(fp_in.variables.get(key).dimensions)) out_var[:] = in_var[:] - + elif( prt_dim_found==0 ): + out_var = fp_out.createVariable(key,'d',(fp_in.variables.get(key).dimensions)) + out_var[:] = in_var[:] + else: print('This variable has a dimensioning that we have not considered yet.') print('Please add this condition to the logic above this statement.') diff --git a/tools/ncdiff b/tools/ncdiff new file mode 100755 index 0000000000..37709b4ad1 --- /dev/null +++ b/tools/ncdiff @@ -0,0 +1,21 @@ +#!/usr/bin/env bash + +while getopts ":h" option; do + case $option in + h) # display Help + echo "script that compares the differences between two netcdf files." + echo "two arguments are the paths to two files to compare" + exit;; + esac +done + +tempfile1=$(mktemp) +tempfile2=$(mktemp) + +ncdump $1 >> ${tempfile1} +ncdump $2 >> ${tempfile2} + +diff ${tempfile1} ${tempfile2} + +rm ${tempfile1} +rm ${tempfile2} diff --git a/tools/ncvarsort.py b/tools/ncvarsort.py index bd6587378d..75d80c3799 100755 --- a/tools/ncvarsort.py +++ b/tools/ncvarsort.py @@ -29,7 +29,7 @@ def main(): # make empty lists to hold the variable names in. the first of these is a list of sub-lists, # one for each type of variable (based on dimensionality). # the second is the master list that will contain all variables. - varnames_list = [[],[],[],[],[],[],[],[],[],[]] + varnames_list = [[],[],[],[],[],[],[],[],[],[],[],[],[]] varnames_list_sorted = [] # # sort the variables by dimensionality, but mix the PFT x other dimension in with the regular PFT-indexed variables @@ -38,15 +38,20 @@ def main(): (u'fates_history_coage_bins',):1, (u'fates_history_height_bins',):2, (u'fates_history_size_bins',):3, - (u'fates_pft', u'fates_string_length'):4, - (u'fates_prt_organs', u'fates_string_length'):5, - (u'fates_pft',):6, - (u'fates_hydr_organs', u'fates_pft'):6, - (u'fates_leafage_class', u'fates_pft'):6, - (u'fates_prt_organs', u'fates_pft'):6, - (u'fates_litterclass',):7, - (u'fates_NCWD',):8, - ():9} + (u'fates_hydr_organs',):4, + (u'fates_prt_organs',):4, + (u'fates_pft', u'fates_string_length'):5, + (u'fates_hydr_organs', u'fates_string_length'):6, + (u'fates_prt_organs', u'fates_string_length'):7, + (u'fates_litterclass', u'fates_string_length'):7, + (u'fates_pft',):8, + (u'fates_hydr_organs', u'fates_pft'):8, + (u'fates_leafage_class', u'fates_pft'):8, + (u'fates_prt_organs', u'fates_pft'):8, + (u'fates_hlm_pftno', u'fates_pft'):9, + (u'fates_litterclass',):10, + (u'fates_NCWD',):11, + ():12} # # go through each of the variables and assign it to one of the sub-lists based on its dimensionality for v_name, varin in dsin.variables.items(): diff --git a/tools/pftdiff b/tools/pftdiff new file mode 100755 index 0000000000..a2d7305bb2 --- /dev/null +++ b/tools/pftdiff @@ -0,0 +1,33 @@ +#!/usr/bin/env bash + +while getopts ":h" option; do + case $option in + h) # display Help + echo "script to compare two PFTs in a FATES parameter file. takes three arguments: " + echo "first argument is the parameter file name" + echo "second argument is the first pft number (PFT numbering starts with 1)" + echo "third argument is the second pft number (PFT numbering starts with 1)" + exit;; + esac +done + + +tempfile1=$(mktemp) +tempfile2=$(mktemp) +tempfile3=$(mktemp) +tempfile4=$(mktemp) + +toolsdir=$(dirname "$0") + +$toolsdir/FatesPFTIndexSwapper.py --pft-indices=$2 --fin=$1 --fout=${tempfile1} 1>/dev/null +$toolsdir/FatesPFTIndexSwapper.py --pft-indices=$3 --fin=$1 --fout=${tempfile2} 1>/dev/null + +ncdump ${tempfile1} >> ${tempfile3} +ncdump ${tempfile2} >> ${tempfile4} + +diff ${tempfile3} ${tempfile4} + +rm ${tempfile1} +rm ${tempfile2} +rm ${tempfile3} +rm ${tempfile4}