From 0c35e38134fe24734d048d02d937b5a9e6b6b686 Mon Sep 17 00:00:00 2001 From: Charlie Koven Date: Fri, 14 Jul 2023 13:37:51 -0700 Subject: [PATCH 001/112] first attempt to reconcile patch initialization logic with land-use + nocomp --- main/EDInitMod.F90 | 230 ++++++++++++++++-------------- main/EDTypesMod.F90 | 4 +- main/FatesConstantsMod.F90 | 5 +- main/FatesHistoryInterfaceMod.F90 | 2 +- main/FatesInterfaceMod.F90 | 25 +++- main/FatesInterfaceTypesMod.F90 | 10 +- 6 files changed, 158 insertions(+), 118 deletions(-) diff --git a/main/EDInitMod.F90 b/main/EDInitMod.F90 index 5f27e1f04f..0c6098a605 100644 --- a/main/EDInitMod.F90 +++ b/main/EDInitMod.F90 @@ -178,11 +178,8 @@ subroutine init_site_vars( site_in, bc_in, bc_out ) allocate(site_in%dz_soil(site_in%nlevsoil)) allocate(site_in%z_soil(site_in%nlevsoil)) - if (hlm_use_nocomp .eq. itrue .and. hlm_use_fixed_biogeog .eq. itrue) then - allocate(site_in%area_pft(0:numpft)) - else ! SP and nocomp require a bare-ground patch. - allocate(site_in%area_pft(1:numpft)) - endif + allocate(site_in%area_pft(1:numpft,1:n_landuse_cats)) + allocate(site_in%use_this_pft(1:numpft)) allocate(site_in%area_by_age(1:nlevage)) @@ -321,7 +318,8 @@ subroutine zero_site( site_in ) ! canopy spread site_in%spread = 0._r8 - site_in%area_pft(:) = 0._r8 + site_in%area_pft(:,:) = 0._r8 + site_in%area_bareground = 0._r8 site_in%use_this_pft(:) = fates_unset_int site_in%area_by_age(:) = 0._r8 @@ -355,6 +353,7 @@ subroutine set_site_properties( nsites, sites,bc_in ) real(r8) :: sumarea ! area of PFTs in nocomp mode. integer :: hlm_pft ! used in fixed biogeog mode integer :: fates_pft ! used in fixed biogeog mode + integer :: i_landusetype !---------------------------------------------------------------------- @@ -397,7 +396,7 @@ subroutine set_site_properties( nsites, sites,bc_in ) sites(s)%acc_NI = acc_NI sites(s)%NF = 0.0_r8 sites(s)%NF_successful = 0.0_r8 - sites(s)%area_pft(:) = 0.0_r8 + sites(s)%area_pft(:,:) = 0.0_r8 do ft = 1,numpft sites(s)%rec_l2fr(ft,:) = prt_params%allom_l2fr(ft) @@ -408,66 +407,71 @@ subroutine set_site_properties( nsites, sites,bc_in ) sites(s)%ema_npp = -9999._r8 if(hlm_use_fixed_biogeog.eq.itrue)then - ! MAPPING OF FATES PFTs on to HLM_PFTs - ! add up the area associated with each FATES PFT - ! where pft_areafrac is the area of land in each HLM PFT and (from surface dataset) - ! hlm_pft_map is the area of that land in each FATES PFT (from param file) - - do hlm_pft = 1,size( EDPftvarcon_inst%hlm_pft_map,2) - do fates_pft = 1,numpft ! loop round all fates pfts for all hlm pfts - sites(s)%area_pft(fates_pft) = sites(s)%area_pft(fates_pft) + & - EDPftvarcon_inst%hlm_pft_map(fates_pft,hlm_pft) * bc_in(s)%pft_areafrac(hlm_pft) + + use_fates_luh_if: if (use_fates_luh .eq. itrue.) then + ! MAPPING OF FATES PFTs on to HLM_PFTs with land use + ! add up the area associated with each FATES PFT + ! where pft_areafrac_lu is the area of land in each HLM PFT and land use type (from surface dataset) + ! hlm_pft_map is the area of that land in each FATES PFT (from param file) + do i_landusetype = 1, n_landuse_cats + do hlm_pft = 1,fates_hlm_num_natpfts + do fates_pft = 1,numpft ! loop round all fates pfts for all hlm pfts + sites(s)%area_pft(fates_pft,i_landusetype) = sites(s)%area_pft_luh(fates_pft,i_landusetype) + & + EDPftvarcon_inst%hlm_pft_map(fates_pft,hlm_pft) * bc_in(s)%pft_areafrac(hlm_pft) + end do + end do !hlm_pft end do - end do !hlm_pft - do ft = 1,numpft - if(sites(s)%area_pft(ft).lt.0.01_r8.and.sites(s)%area_pft(ft).gt.0.0_r8)then - if(debug) write(fates_log(),*) 'removing small pft patches',s,ft,sites(s)%area_pft(ft) - sites(s)%area_pft(ft)=0.0_r8 - ! remove tiny patches to prevent numerical errors in terminate patches - endif - if(sites(s)%area_pft(ft).lt.0._r8)then - write(fates_log(),*) 'negative area',s,ft,sites(s)%area_pft(ft) - call endrun(msg=errMsg(sourcefile, __LINE__)) - end if - sites(s)%area_pft(ft)= sites(s)%area_pft(ft) * AREA ! rescale units to m2. - end do + sites(s)%area_bareground = bc_in(s)%baregroundfrac * area + + else use_fates_luh_if + ! MAPPING OF FATES PFTs on to HLM_PFTs + ! add up the area associated with each FATES PFT + ! where pft_areafrac is the area of land in each HLM PFT and (from surface dataset) + ! hlm_pft_map is the area of that land in each FATES PFT (from param file) + + do hlm_pft = 1,size( EDPftvarcon_inst%hlm_pft_map,2) + do fates_pft = 1,numpft ! loop round all fates pfts for all hlm pfts + sites(s)%area_pft(fates_pft,primarylands) = sites(s)%area_pft(fates_pft,primarylands) + & + EDPftvarcon_inst%hlm_pft_map(fates_pft,hlm_pft) * bc_in(s)%pft_areafrac(hlm_pft) + end do + sites(s)%area_bareground = bc_in(s)%pft_areafrac(0) + end do !hlm_pft - ! re-normalize PFT area to ensure it sums to one. - ! note that in areas of 'bare ground' (PFT 0 in CLM/ELM) - ! the bare ground will no longer be proscribed and should emerge from FATES - ! this may or may not be the right way to deal with this? + endif use_fates_luh_if - if(hlm_use_nocomp.eq.ifalse)then ! when not in nocomp (i.e. or SP) mode, - ! subsume bare ground evenly into the existing patches. + do i_landusetype = 1, n_landuse_cats + do ft = 1,numpft + if(sites(s)%area_pft(ft).lt.0.01_r8.and.sites(s)%area_pft(ft).gt.0.0_r8)then + if(debug) write(fates_log(),*) 'removing small pft patches',s,ft,sites(s)%area_pft(ft) + sites(s)%area_pft(ft)=0.0_r8 + ! remove tiny patches to prevent numerical errors in terminate patches + endif + if(sites(s)%area_pft(ft).lt.0._r8)then + write(fates_log(),*) 'negative area',s,ft,sites(s)%area_pft(ft) + call endrun(msg=errMsg(sourcefile, __LINE__)) + end if + sites(s)%area_pft(ft)= sites(s)%area_pft(ft) * AREA ! rescale units to m2. + end do + end do - sumarea = sum(sites(s)%area_pft(1:numpft)) + ! re-normalize PFT area to ensure it sums to one for each (active) land use type + ! for nocomp cases, track bare ground area as a separate quantity + + do i_landusetype = 1, n_landuse_cats + sumarea = sum(sites(s)%area_pft(1:numpft,i_landusetype)) do ft = 1,numpft if(sumarea.gt.0._r8)then - sites(s)%area_pft(ft) = area * sites(s)%area_pft(ft)/sumarea + sites(s)%area_pft(ft, i_landusetype) = sites(s)%area_pft(ft, i_landusetype)/sumarea else - sites(s)%area_pft(ft) = area/numpft - ! in nocomp mode where there is only bare ground, we assign equal area to - ! all pfts and let the model figure out whether land should be bare or not. + ! if no PFT area in primary lands, set bare ground fraction to one. + if ( i_landusetype .eq. primarylands) then + sites(s)%area_bareground = 1._r8 + endif end if end do !ft - else ! for sp and nocomp mode, assert a bare ground patch if needed - sumarea = sum(sites(s)%area_pft(1:numpft)) - - ! In all the other FATES modes, bareground is the area in which plants - ! do not grow of their own accord. In SP mode we assert that the canopy is full for - ! each PFT patch. Thus, we also need to assert a bare ground area in - ! order to not have all of the ground filled by leaves. - - ! Further to that, one could calculate bare ground as the remaining area when - ! all fhe canopies are accounted for, but this means we don't pass balance checks - ! on canopy are inside FATES, and so in SP mode, we define the bare groud - ! patch as having a PFT identifier as zero. - - if(sumarea.lt.area)then !make some bare ground - sites(s)%area_pft(0) = area - sumarea - end if - end if !sp mode + end do + end if !fixed biogeog do ft = 1,numpft @@ -475,7 +479,7 @@ subroutine set_site_properties( nsites, sites,bc_in ) ! are used for nocomp with no biogeog sites(s)%use_this_pft(ft) = itrue if(hlm_use_fixed_biogeog.eq.itrue)then - if(sites(s)%area_pft(ft).gt.0.0_r8)then + if(any(sites(s)%area_pft(ft,:).gt.0.0_r8))then sites(s)%use_this_pft(ft) = itrue else sites(s)%use_this_pft(ft) = ifalse @@ -580,13 +584,8 @@ subroutine init_patches( nsites, sites, bc_in) ! have smaller spread factors than bare ground (they are crowded) sites(s)%spread = init_spread_near_bare_ground - start_patch = 1 ! start at the first vegetated patch if(hlm_use_nocomp.eq.itrue)then num_new_patches = numpft - if( hlm_use_fixed_biogeog .eq.itrue )then - start_patch = 0 ! start at the bare ground patch - endif - ! allocate(newppft(numpft)) else !default num_new_patches = 1 end if !nocomp @@ -599,17 +598,7 @@ subroutine init_patches( nsites, sites, bc_in) ! categories based on which states are zero n_active_landuse_cats = n_landuse_cats call get_luh_statedata(bc_in(s), state_vector) - ! n_luh_states = 0 - ! do i_lu = 1, hlm_num_luh2_transitions - ! if ( state_vector(i_lu) .gt. nearzero ) then - ! n_luh_states = n_luh_states +1 - ! end if - ! end do - - ! if (n_luh_states .eq. 0) then - ! write(fates_log(),*) 'error. n_luh_states .eq. 0.' - ! call endrun(msg=errMsg(sourcefile, __LINE__)) - ! endif + else ! If LUH2 data is not being used, we initialize with primarylands, ! i.e. array index equals '1' @@ -619,42 +608,74 @@ subroutine init_patches( nsites, sites, bc_in) endif is_first_patch = itrue - ! luh_state_counter = 0 - new_patch_nocomp_loop: do n = start_patch, num_new_patches - ! set the PFT index for patches if in nocomp mode. - if(hlm_use_nocomp.eq.itrue)then - nocomp_pft = n - else - nocomp_pft = fates_unset_int - end if + ! first make a bare-ground patch if one is needed. + make_bareground_patch_if: if (hlm_use_nocomp.eq.itrue .and. hlm_use_fixed_biogeog .eq.itrue .and. sites(s)%area_bareground .gt. 0._r8) then + newparea = area * sites(s)%area_bareground - if(hlm_use_nocomp.eq.itrue)then - ! In no competition mode, if we are using the fixed_biogeog filter - ! then each PFT has the area dictated by the surface dataset. + allocate(newp) + + call create_patch(sites(s), newp, age, newparea, nocomp_bareground_land, nocomp_bareground) + + ! set poointers for first patch (or only patch, if nocomp is false) + newp%patchno = 1 + newp%younger => null() + newp%older => null() + sites(s)%youngest_patch => newp + sites(s)%oldest_patch => newp + is_first_patch = ifalse + + ! Initialize the litter pools to zero, these + ! pools will be populated by looping over the existing patches + ! and transfering in mass + do el=1,num_elements + call newp%litter(el)%InitConditions(init_leaf_fines=0._r8, & + init_root_fines=0._r8, & + init_ag_cwd=0._r8, & + init_bg_cwd=0._r8, & + init_seed=0._r8, & + init_seed_germ=0._r8) + end do + endif make_bareground_patch_if - ! If we are not using fixed biogeog model, each PFT gets the same area. - ! i.e. each grid cell is divided exactly into the number of FATES PFTs. + if (use_fates_luh2 .eq. itrue) then + end_landuse_idx = n_landuse_cats + else + end_landuse_idx = 1 + endif - if(hlm_use_fixed_biogeog.eq.itrue)then - newparea = sites(s)%area_pft(nocomp_pft) - else - newparea = area / numpft - end if - else ! The default case is initialized w/ one patch with the area of the whole site. - newparea = area - end if !nocomp mode + ! now make one or more vegetated patches based on nocomp and land use logic + new_patch_nocomp_loop: do n = 1, num_new_patches + luh_state_loop: do i_lu_state = 1, end_landuse_idx + lu_state_present_if: if (state_vector(i_lu_state) .gt. nearzero) then + ! set the PFT index for patches if in nocomp mode. + if(hlm_use_nocomp.eq.itrue)then + nocomp_pft = n + else + nocomp_pft = fates_unset_int + end if - luh_state_loop: do i_lu_state = 1, n_active_landuse_cats - lu_state_present_if: if ( state_vector(i_lu_state) .gt. nearzero ) then + if(hlm_use_nocomp.eq.itrue)then + ! In no competition mode, if we are using the fixed_biogeog filter + ! then each PFT has the area dictated by the surface dataset. - newparea_withlanduse = newparea * state_vector(i_lu_state) + ! If we are not using fixed biogeog model, each PFT gets the same area. + ! i.e. each grid cell is divided exactly into the number of FATES PFTs. + + if(hlm_use_fixed_biogeog.eq.itrue)then + newparea = sites(s)%area_pft(nocomp_pft) * area / state_vector(i_lu_state) + else + newparea = area / ( numpft * vector(i_lu_state)) + end if + else ! The default case is initialized w/ one patch with the area of the whole site. + newparea = area / state_vector(i_lu_state) + end if !nocomp mode ! for now, spread nocomp PFTs evenly across land use types - new_patch_area_gt_zero: if(newparea_withlanduse.gt.0._r8)then ! Stop patches being initilialized when PFT not present in nocomop mode + new_patch_area_gt_zero: if(newparea.gt.0._r8)then ! Stop patches being initilialized when PFT not present in nocomop mode allocate(newp) - call create_patch(sites(s), newp, age, newparea_withlanduse, i_lu_state, nocomp_pft) + call create_patch(sites(s), newp, age, newparea, i_lu_state, nocomp_pft) if(is_first_patch.eq.itrue)then !is this the first patch? ! set poointers for first patch (or only patch, if nocomp is false) @@ -687,13 +708,8 @@ subroutine init_patches( nsites, sites, bc_in) end do sitep => sites(s) - if(hlm_use_sp.eq.itrue)then - if(nocomp_pft.ne.0)then !don't initialize cohorts for SP bare ground patch - call init_cohorts(sitep, newp, bc_in(s)) - end if - else ! normal non SP case always call init cohorts - call init_cohorts(sitep, newp, bc_in(s)) - end if + call init_cohorts(sitep, newp, bc_in(s)) + end if new_patch_area_gt_zero end if lu_state_present_if end do luh_state_loop diff --git a/main/EDTypesMod.F90 b/main/EDTypesMod.F90 index 84c1fb7a4b..79c230316b 100644 --- a/main/EDTypesMod.F90 +++ b/main/EDTypesMod.F90 @@ -736,7 +736,9 @@ module EDTypesMod real(r8) :: lon ! longitude: degrees ! Fixed Biogeography mode inputs - real(r8), allocatable :: area_PFT(:) ! Area allocated to individual PFTs + real(r8), allocatable :: area_PFT(:,:) ! Area allocated to individual PFTs, indexed by land use class [ha/ha of non-bareground area] + real(r8) :: area_bareground ! Area allocated to bare ground in nocomp configurations (corresponds to HLM PFT 0) [ha/ha] + integer, allocatable :: use_this_pft(:) ! Is area_PFT > 0 ? (1=yes, 0=no) ! Total area of patches in each age bin [m2] diff --git a/main/FatesConstantsMod.F90 b/main/FatesConstantsMod.F90 index 03142b99bf..35b2ee42b2 100644 --- a/main/FatesConstantsMod.F90 +++ b/main/FatesConstantsMod.F90 @@ -38,7 +38,10 @@ module FatesConstantsMod integer, parameter, public :: pastureland = 4 integer, parameter, public :: cropland = 5 - ! Bareground label for no competition mode + ! Bareground nocomp land use label + integer, parameter, public :: nocomp_bareground_land = 0 ! not a real land use type, only for labeling any bare-ground nocomp patches + + ! Bareground nocomp PFT label for no competition mode integer, parameter, public :: nocomp_bareground = 0 ! Flags specifying how phosphorous uptake and turnover interacts diff --git a/main/FatesHistoryInterfaceMod.F90 b/main/FatesHistoryInterfaceMod.F90 index 6964ee259b..4cbbda5b5d 100644 --- a/main/FatesHistoryInterfaceMod.F90 +++ b/main/FatesHistoryInterfaceMod.F90 @@ -4537,7 +4537,7 @@ subroutine update_history_hifrq(this,nc,nsites,sites,bc_in,dt_tstep) ! Calculate the site-level total vegetated area (i.e. non-bareground) site_area_veg = area if (hlm_use_nocomp .eq. itrue .and. hlm_use_fixed_biogeog .eq. itrue) then - site_area_veg = area - sites(s)%area_pft(0) + site_area_veg = area - sites(s)%area_bareground * area end if cpatch => sites(s)%oldest_patch diff --git a/main/FatesInterfaceMod.F90 b/main/FatesInterfaceMod.F90 index 3a86beff4f..431dda71ab 100644 --- a/main/FatesInterfaceMod.F90 +++ b/main/FatesInterfaceMod.F90 @@ -386,7 +386,7 @@ end subroutine zero_bcs ! =========================================================================== subroutine allocate_bcin(bc_in, nlevsoil_in, nlevdecomp_in, num_lu_harvest_cats, num_luh2_states, & - num_luh2_transitions, natpft_lb,natpft_ub) + num_luh2_transitions, surfpft_lb,surfpft_ub) ! --------------------------------------------------------------------------------- ! Allocate and Initialze the FATES boundary condition vectors @@ -399,7 +399,7 @@ subroutine allocate_bcin(bc_in, nlevsoil_in, nlevdecomp_in, num_lu_harvest_cats, integer,intent(in) :: num_lu_harvest_cats integer,intent(in) :: num_luh2_states integer,intent(in) :: num_luh2_transitions - integer,intent(in) :: natpft_lb,natpft_ub ! dimension bounds of the array holding surface file pft data + integer,intent(in) :: surfpft_lb,surfpft_ub ! dimension bounds of the array holding surface file pft data ! Allocate input boundaries @@ -533,7 +533,13 @@ subroutine allocate_bcin(bc_in, nlevsoil_in, nlevdecomp_in, num_lu_harvest_cats, allocate(bc_in%hlm_harvest_catnames(0)) end if - allocate(bc_in%pft_areafrac(natpft_lb:natpft_ub)) + if ( hlm_use_fixed_biogeog .eq. itrue) then + if (hlm_use_luh .gt. 0 ) then + allocate(bc_in%pft_areafrac_lu(fates_hlm_num_natpfts,num_luh2_states)) + else + allocate(bc_in%pft_areafrac(surfpft_lb:surfpft_ub)) + endif + endif ! LUH2 state and transition data if (hlm_use_luh .gt. 0) then @@ -545,10 +551,11 @@ subroutine allocate_bcin(bc_in, nlevsoil_in, nlevdecomp_in, num_lu_harvest_cats, ! Variables for SP mode. if(hlm_use_sp.eq.itrue) then - allocate(bc_in%hlm_sp_tlai(natpft_lb:natpft_ub)) - allocate(bc_in%hlm_sp_tsai(natpft_lb:natpft_ub)) - allocate(bc_in%hlm_sp_htop(natpft_lb:natpft_ub)) - end if + allocate(bc_in%hlm_sp_tlai(surfpft_lb:surfpft_ub)) + allocate(bc_in%hlm_sp_tsai(surfpft_lb:surfpft_ub)) + allocate(bc_in%hlm_sp_htop(surfpft_lb:surfpft_ub)) + end if + return end subroutine allocate_bcin @@ -768,6 +775,10 @@ subroutine SetFatesGlobalElements1(use_fates,surf_numpft,surf_numcft) fates_maxPatchesPerSite = max(surf_numpft+surf_numcft,maxpatch_total+1) + ! if this is nocomp with land use, track things differently. + ! we want the number of natpfts minus the bare ground PFT. + fates_hlm_num_natpfts = surf_numpft -1 + else ! If we are using fixed biogeography or no-comp then we diff --git a/main/FatesInterfaceTypesMod.F90 b/main/FatesInterfaceTypesMod.F90 index 4c6ba46043..47a382a22f 100644 --- a/main/FatesInterfaceTypesMod.F90 +++ b/main/FatesInterfaceTypesMod.F90 @@ -225,6 +225,9 @@ module FatesInterfaceTypesMod ! dataset than the number of PFTs in FATES, we have to allocate with ! the prior so that we can hold the LAI data integer, public :: fates_maxPatchesPerSite + + ! the number of natural PFTs tracked by the host model; NOT INCLUDING EITHER CROPS OR BARE GROUND + integer, public :: fates_hlm_num_natpfts integer, public :: max_comp_per_site ! This is the maximum number of nutrient aquisition ! competitors that will be generated on each site @@ -545,7 +548,12 @@ module FatesInterfaceTypesMod real(r8) :: site_area ! Actual area of current site [m2], only used in carbon-based harvest ! Fixed biogeography mode - real(r8), allocatable :: pft_areafrac(:) ! Fractional area of the FATES column occupied by each PFT + real(r8), allocatable :: pft_areafrac(:) ! Fractional area of the FATES column occupied by each PFT + + ! Fixed biogeography mode with land use active + real(r8), allocatable :: pft_areafrac_lu(:,:) ! Fractional area occupied by each PFT on each land use type + real(r8) :: baregroundfrac ! fractional area held as bare-ground + ! Satellite Phenology (SP) input variables. (where each patch only has one PFT) ! --------------------------------------------------------------------------------- From 2d9dd68b73b117387590395c71230d10949ceab9 Mon Sep 17 00:00:00 2001 From: Charlie Koven Date: Fri, 14 Jul 2023 15:09:17 -0700 Subject: [PATCH 002/112] starting to put in logic to handle nocomp PFT transitions during LU change --- biogeochem/EDPatchDynamicsMod.F90 | 89 ++++++++++++++++++++++++++++++- main/EDTypesMod.F90 | 1 + 2 files changed, 88 insertions(+), 2 deletions(-) diff --git a/biogeochem/EDPatchDynamicsMod.F90 b/biogeochem/EDPatchDynamicsMod.F90 index 6dfa501d83..a969e1a4bb 100644 --- a/biogeochem/EDPatchDynamicsMod.F90 +++ b/biogeochem/EDPatchDynamicsMod.F90 @@ -473,6 +473,7 @@ subroutine spawn_patches( currentSite, bc_in) real(r8) :: disturbance_rate ! rate of disturbance being resolved [fraction of patch area / day] real(r8) :: oldarea ! old patch area prior to disturbance logical :: clearing_matrix(n_landuse_cats,n_landuse_cats) ! do we clear vegetation when transferring from one LU type to another? + type (ed_patch_type) , pointer :: buffer_patch !--------------------------------------------------------------------- @@ -644,8 +645,6 @@ subroutine spawn_patches( currentSite, bc_in) ! Transfer in litter fluxes from plants in various contexts of death and destruction - ! CDK what do we do here for land use transitions? - select case(i_disturbance_type) case (dtype_ilog) call logging_litter_fluxes(currentSite, currentPatch, & @@ -660,6 +659,8 @@ subroutine spawn_patches( currentSite, bc_in) call landusechange_litter_fluxes(currentSite, currentPatch, & new_patch, patch_site_areadis,bc_in, & clearing_matrix(i_donorpatch_landuse_type,i_landusechange_receiverpatchlabel)) + + new_patch%changed_landuse_this_ts = .true. case default write(fates_log(),*) 'unknown disturbance mode?' write(fates_log(),*) 'i_disturbance_type: ',i_disturbance_type @@ -1256,6 +1257,89 @@ subroutine spawn_patches( currentSite, bc_in) end do nocomp_pft_loop + nocomp_and_luh_if: if ( use_fates_nocomp .eq. itrue .and. use_fates_luh .eq. itrue ) then + + ! disturbance has just hapopened, and now the nocomp PFT identities of the newly-disturbed patches + ! need to be remapped to those associated with the new land use type. + + ! logic: loop over land use types. figure out the nocomp PFT fractions for all newly-disturbed patches that have ebcome that land use type. + ! if the + + lu_loop: do i_land_use_label = 1, n_landuse_cats + + nocomp_pft_area_vector(:) = 0._r8 + nocomp_pft_area_vector_allocated(:) = 0._r8 + + currentPatch => currentSite%oldest_patch + do while(associated(currentPatch)) + if (currentPatch%changed_landuse_this_ts) then + nocomp_pft_area_vector(currentPatch%nocomp_pft_label) = nocomp_pft_area_vector(currentPatch%nocomp_pft_label) + currentPatch%area + end if + currentPatch => currentPatch%younger + end do + + ! create buffer patch to put all of the pieces carved off of other patches + call create_patch(currentSite, buffer_patch, 0._r8, & + 0._r8, i_land_use_label, 0) + + ! Initialize the litter pools to zero + do el=1,num_elements + call buffer_patch%litter(el)%InitConditions(init_leaf_fines=0._r8, & + init_root_fines=0._r8, & + init_ag_cwd=0._r8, & + init_bg_cwd=0._r8, & + init_seed=0._r8, & + init_seed_germ=0._r8) + end do + buffer_patch%tallest => null() + buffer_patch%shortest => null() + + currentPatch => currentSite%oldest_patch + do while(associated(currentPatch)) + if (currentPatch%changed_landuse_this_ts) then + fraction_to_keep = currentSite%area_pft(currentPatch%nocomp_pft_label,i_land_use_label) * area / nocomp_pft_area_vector(currentPatch%nocomp_pft_label) + if (fraction_to_keep .lt. nearzero) then + ! we don't want any patch area with this PFT idendity at all anymore. Fuse it into the buffer patch. + currentPatch%nocomp_pft_label = 0 + call fuse_2_patches(currentSite, currentPatch, buffer_patch) + elseif (fraction_to_keep .lt. (1._r8 - nearzero)) then + ! we want to split the patch into two here. leave one patch as-is, and put the rest into the buffer patch. + !cdkcdk TODO + else + ! we want to keep all of this patch (and possibly more) + nocomp_pft_area_vector_allocated(currentPatch%nocomp_pft_label) = & + nocomp_pft_area_vector_allocated(currentPatch%nocomp_pft_label) + currentPatch%area + currentPatch%changed_landuse_this_ts = .false. + endif + end if + currentPatch => currentPatch%younger + end do + + ! now we need to loop through the nocomp PFTs, and split the buffer patch into a set of patches to put back in the linked list + nocomp_pft_loop: do i_pft = 1, numpft + + if (nocomp_pft_area_vector_allocated(i_pft) .lt. currentSite%area_pft(i_pft,i_land_use_label) * area) then + + newp_area = currentSite%area_pft(i_pft,i_land_use_label) * area - nocomp_pft_area_vector_allocated(i_pft) + + if (newp_area .lt. buffer_patch%area) then + + ! split patch in two, and put one of them into the linked list cdkcdk TODO + + else + + ! put the buffer patch directly into the linked list cdkcdk TODO + + end if + + end if + + end do nocomp_pft_loop + + + end do lu_loop + endif nocomp_and_luh_if + !zero disturbance rate trackers on all patches currentPatch => currentSite%oldest_patch do while(associated(currentPatch)) @@ -2476,6 +2560,7 @@ subroutine create_patch(currentSite, new_patch, age, areap, label,nocomp_pft) new_patch%burnt_frac_litter(:) = 0._r8 new_patch%total_tree_area = 0.0_r8 new_patch%NCL_p = 1 + new_patch%changed_landuse_this_ts = .false. return diff --git a/main/EDTypesMod.F90 b/main/EDTypesMod.F90 index 79c230316b..037c46fe58 100644 --- a/main/EDTypesMod.F90 +++ b/main/EDTypesMod.F90 @@ -435,6 +435,7 @@ module EDTypesMod integer :: ncl_p ! Number of occupied canopy layers integer :: land_use_label ! patch label for land use classification (primaryland, secondaryland, etc) real(r8) :: age_since_anthro_disturbance ! average age for secondary forest since last anthropogenic disturbance + logical :: changed_landuse_this_ts ! logical flag to track patches that have just undergone land use change ! Running means From 9a0843001759daaf9d84a139698e920ac5975d67 Mon Sep 17 00:00:00 2001 From: Charlie Koven Date: Fri, 28 Jul 2023 16:05:40 -0700 Subject: [PATCH 003/112] fixing some bugs I see while reading through code --- main/EDInitMod.F90 | 19 +++++++++---------- 1 file changed, 9 insertions(+), 10 deletions(-) diff --git a/main/EDInitMod.F90 b/main/EDInitMod.F90 index 0c6098a605..5e0d1c5939 100644 --- a/main/EDInitMod.F90 +++ b/main/EDInitMod.F90 @@ -416,8 +416,8 @@ subroutine set_site_properties( nsites, sites,bc_in ) do i_landusetype = 1, n_landuse_cats do hlm_pft = 1,fates_hlm_num_natpfts do fates_pft = 1,numpft ! loop round all fates pfts for all hlm pfts - sites(s)%area_pft(fates_pft,i_landusetype) = sites(s)%area_pft_luh(fates_pft,i_landusetype) + & - EDPftvarcon_inst%hlm_pft_map(fates_pft,hlm_pft) * bc_in(s)%pft_areafrac(hlm_pft) + sites(s)%area_pft(fates_pft,i_landusetype) = sites(s)%area_pft(fates_pft,i_landusetype) + & + EDPftvarcon_inst%hlm_pft_map(fates_pft,hlm_pft) * bc_in(s)%pft_areafrac_luh(hlm_pft,i_landusetype) end do end do !hlm_pft end do @@ -442,16 +442,15 @@ subroutine set_site_properties( nsites, sites,bc_in ) do i_landusetype = 1, n_landuse_cats do ft = 1,numpft - if(sites(s)%area_pft(ft).lt.0.01_r8.and.sites(s)%area_pft(ft).gt.0.0_r8)then - if(debug) write(fates_log(),*) 'removing small pft patches',s,ft,sites(s)%area_pft(ft) - sites(s)%area_pft(ft)=0.0_r8 + if(sites(s)%area_pft(ft, i_landusetype).lt.0.01_r8.and.sites(s)%area_pft(ft, i_landusetype).gt.0.0_r8)then + if(debug) write(fates_log(),*) 'removing small pft patches',s,ft,i_landusetype,sites(s)%area_pft(ft, i_landusetype) + sites(s)%area_pft(ft, i_landusetype)=0.0_r8 ! remove tiny patches to prevent numerical errors in terminate patches endif - if(sites(s)%area_pft(ft).lt.0._r8)then - write(fates_log(),*) 'negative area',s,ft,sites(s)%area_pft(ft) + if(sites(s)%area_pft(ft, i_landusetype).lt.0._r8)then + write(fates_log(),*) 'negative area',s,ft,i_landusetype,sites(s)%area_pft(ft, i_landusetype) call endrun(msg=errMsg(sourcefile, __LINE__)) end if - sites(s)%area_pft(ft)= sites(s)%area_pft(ft) * AREA ! rescale units to m2. end do end do @@ -477,7 +476,7 @@ subroutine set_site_properties( nsites, sites,bc_in ) do ft = 1,numpft ! Setting this to true ensures that all pfts ! are used for nocomp with no biogeog - sites(s)%use_this_pft(ft) = itrue + sites(s)%use_this_pft(ft) = itrues if(hlm_use_fixed_biogeog.eq.itrue)then if(any(sites(s)%area_pft(ft,:).gt.0.0_r8))then sites(s)%use_this_pft(ft) = itrue @@ -663,7 +662,7 @@ subroutine init_patches( nsites, sites, bc_in) ! i.e. each grid cell is divided exactly into the number of FATES PFTs. if(hlm_use_fixed_biogeog.eq.itrue)then - newparea = sites(s)%area_pft(nocomp_pft) * area / state_vector(i_lu_state) + newparea = sites(s)%area_pft(nocomp_pft,i_lu_state) * area / state_vector(i_lu_state) else newparea = area / ( numpft * vector(i_lu_state)) end if From a93efe4938cc4d33a884602c3d38e2b08ee01e76 Mon Sep 17 00:00:00 2001 From: Charlie Koven Date: Mon, 31 Jul 2023 09:45:28 -0700 Subject: [PATCH 004/112] added new generalized split_patch function --- biogeochem/EDPatchDynamicsMod.F90 | 125 +++++++++++++++++++++++++++++- 1 file changed, 121 insertions(+), 4 deletions(-) diff --git a/biogeochem/EDPatchDynamicsMod.F90 b/biogeochem/EDPatchDynamicsMod.F90 index a969e1a4bb..ab7cc37d76 100644 --- a/biogeochem/EDPatchDynamicsMod.F90 +++ b/biogeochem/EDPatchDynamicsMod.F90 @@ -473,7 +473,7 @@ subroutine spawn_patches( currentSite, bc_in) real(r8) :: disturbance_rate ! rate of disturbance being resolved [fraction of patch area / day] real(r8) :: oldarea ! old patch area prior to disturbance logical :: clearing_matrix(n_landuse_cats,n_landuse_cats) ! do we clear vegetation when transferring from one LU type to another? - type (ed_patch_type) , pointer :: buffer_patch + type (ed_patch_type) , pointer :: buffer_patch, temp_patch !--------------------------------------------------------------------- @@ -1262,7 +1262,7 @@ subroutine spawn_patches( currentSite, bc_in) ! disturbance has just hapopened, and now the nocomp PFT identities of the newly-disturbed patches ! need to be remapped to those associated with the new land use type. - ! logic: loop over land use types. figure out the nocomp PFT fractions for all newly-disturbed patches that have ebcome that land use type. + ! logic: loop over land use types. figure out the nocomp PFT fractions for all newly-disturbed patches that have become that land use type. ! if the lu_loop: do i_land_use_label = 1, n_landuse_cats @@ -1303,8 +1303,12 @@ subroutine spawn_patches( currentSite, bc_in) currentPatch%nocomp_pft_label = 0 call fuse_2_patches(currentSite, currentPatch, buffer_patch) elseif (fraction_to_keep .lt. (1._r8 - nearzero)) then + ! we have more patch are of this PFT than we want, but we do want to keep some of it. ! we want to split the patch into two here. leave one patch as-is, and put the rest into the buffer patch. - !cdkcdk TODO + call split_patch(currentSite, currentPatch, temp_patch, fraction_to_keep) + ! + temp_patch%nocomp_pft_label = 0 + call fuse_2_patches(currentSite, temp_patch, buffer_patch) else ! we want to keep all of this patch (and possibly more) nocomp_pft_area_vector_allocated(currentPatch%nocomp_pft_label) = & @@ -1324,7 +1328,10 @@ subroutine spawn_patches( currentSite, bc_in) if (newp_area .lt. buffer_patch%area) then - ! split patch in two, and put one of them into the linked list cdkcdk TODO + ! split buffer patch in two, keeping the smaller buffer patch to put into new patches + call split_patch(currentSite, buffer_patch, temp_patch, newp_area/buffer_patch%area) + + ! put the new patch into the linked list cdkcdk TODO else @@ -1353,6 +1360,116 @@ end subroutine spawn_patches ! ============================================================================ + subroutine split_patch(currentSite, currentPatch, new_patch, fraction_to_keep) + ! + ! !DESCRIPTION: + ! Split a patch into two patches that are identical except in their areas + ! + ! !USES: + ! + ! !ARGUMENTS: + type(ed_site_type),intent(in) :: currentSite + type(ed_patch_type) , intent(inout), target :: currentPatch ! Donor Patch + type(ed_patch_type) , intent(inout), target :: new_patch ! New Patch + real(r8), intent(in) :: fraction_to_keep ! fraction of currentPatch to keep, the rest goes to newpatch + + ! first we need to make the new patch + call create_patch(currentSite, new_patch, 0._r8, & + currentPatch%area * (1._r8 - fraction_to_keep), currentPatch%land_use_label, currentPatch%nocomp_pft_label) + + ! Initialize the litter pools to zero, these + ! pools will be populated shortly + do el=1,num_elements + call new_patch%litter(el)%InitConditions(init_leaf_fines=0._r8, & + init_root_fines=0._r8, & + init_ag_cwd=0._r8, & + init_bg_cwd=0._r8, & + init_seed=0._r8, & + init_seed_germ=0._r8) + end do + + new_patch%tallest => null() + new_patch%shortest => null() + + ! Copy any means or timers from the original patch to the new patch + ! These values will inherit all info from the original patch + ! -------------------------------------------------------------------------- + call new_patch%tveg24%CopyFromDonor(currentPatch%tveg24) + call new_patch%tveg_lpa%CopyFromDonor(currentPatch%tveg_lpa) + call new_patch%tveg_longterm%CopyFromDonor(currentPatch%tveg_longterm) + + currentPatch%burnt_frac_litter(:) = 0._r8 + call TransLitterNewPatch( currentSite, currentPatch, new_patch, currentPatch%area * fraction_to_keep) + + ! Next, we loop through the cohorts in the donor patch, copy them with + ! area modified number density into the new-patch, and apply survivorship. + ! ------------------------------------------------------------------------- + + currentCohort => currentPatch%shortest + do while(associated(currentCohort)) + + allocate(nc) + if(hlm_use_planthydro.eq.itrue) call InitHydrCohort(CurrentSite,nc) + + ! Initialize the PARTEH object and point to the + ! correct boundary condition fields + nc%prt => null() + call InitPRTObject(nc%prt) + call InitPRTBoundaryConditions(nc) + + ! (Keeping as an example) + ! Allocate running mean functions + !allocate(nc%tveg_lpa) + !call nc%tveg_lpa%InitRMean(ema_lpa,init_value=new_patch%tveg_lpa%GetMean()) + + call zero_cohort(nc) + + ! nc is the new cohort that goes in the disturbed patch (new_patch)... currentCohort + ! is the curent cohort that stays in the donor patch (currentPatch) + call copy_cohort(currentCohort, nc) + + ! Number of members in the new patch + nc%n = currentCohort%n * fraction_to_keep + + ! loss of individuals from source patch due to area shrinking + currentCohort%n = currentCohort%n * (1._r8 - fraction_to_keep) + + storebigcohort => new_patch%tallest + storesmallcohort => new_patch%shortest + if(associated(new_patch%tallest))then + tnull = 0 + else + tnull = 1 + new_patch%tallest => nc + nc%taller => null() + endif + + if(associated(new_patch%shortest))then + snull = 0 + else + snull = 1 + new_patch%shortest => nc + nc%shorter => null() + endif + nc%patchptr => new_patch + call insert_cohort(nc, new_patch%tallest, new_patch%shortest, & + tnull, snull, storebigcohort, storesmallcohort) + + new_patch%tallest => storebigcohort + new_patch%shortest => storesmallcohort + + currentCohort => currentCohort%taller + enddo ! currentCohort + + call sort_cohorts(currentPatch) + + !update area of donor patch + currentPatch%area = currentPatch%area * (1._r8 - fraction_to_keep) + + end subroutine split_patch + + ! ============================================================================ + subroutine check_patch_area( currentSite ) ! ! !DESCRIPTION: From 255e7094efe382df29dab9783187c601624ca4a4 Mon Sep 17 00:00:00 2001 From: Charlie Koven Date: Mon, 31 Jul 2023 11:47:47 -0700 Subject: [PATCH 005/112] refactored and reused logic to put new patches into linked list --- biogeochem/EDPatchDynamicsMod.F90 | 119 ++++++++++++++++++++---------- 1 file changed, 78 insertions(+), 41 deletions(-) diff --git a/biogeochem/EDPatchDynamicsMod.F90 b/biogeochem/EDPatchDynamicsMod.F90 index ab7cc37d76..af2b7e8799 100644 --- a/biogeochem/EDPatchDynamicsMod.F90 +++ b/biogeochem/EDPatchDynamicsMod.F90 @@ -463,7 +463,6 @@ subroutine spawn_patches( currentSite, bc_in) real(r8) :: leaf_burn_frac ! fraction of leaves burned in fire ! for both woody and grass species real(r8) :: leaf_m ! leaf mass during partial burn calculations - logical :: found_youngest_landuselabel ! logical for finding the first primary forest patch integer :: min_nocomp_pft, max_nocomp_pft, i_nocomp_pft integer :: i_disturbance_type, i_dist2 ! iterators for looping over disturbance types integer :: i_landusechange_receiverpatchlabel ! iterator for the land use change types @@ -1197,44 +1196,8 @@ subroutine spawn_patches( currentSite, bc_in) !*************************/ if ( site_areadis .gt. nearzero) then - currentPatch => currentSite%youngest_patch - - ! Insert new patch as the youngest patch in the group of patches with the same land use type. - ! On a given site, the patches are grouped together by land use type. The order of the - ! groups within the site doesn't matter, except that the older patch group are primarylands. - - if (currentPatch%land_use_label .eq. new_patch%land_use_label ) then - found_youngest_landuselabel = .false. - do while(associated(currentPatch) .and. .not. found_youngest_landuselabel) - currentPatch => currentPatch%older - if (associated(currentPatch)) then - if (currentPatch%land_use_label .eq. new_patch%land_use_label) then - found_youngest_landuselabel = .true. - endif - endif - end do - if (associated(currentPatch)) then - ! the case where we've found a youngest patch type matching the new patch type - new_patch%older => currentPatch - new_patch%younger => currentPatch%younger - currentPatch%younger%older => new_patch - currentPatch%younger => new_patch - else - ! the case where we haven't, because the patches are all non-primaryland, - ! and are putting a primaryland patch at the oldest end of the - ! linked list (not sure how this could happen, but who knows...) - new_patch%older => null() - new_patch%younger => currentSite%oldest_patch - currentSite%oldest_patch%older => new_patch - currentSite%oldest_patch => new_patch - endif - else - ! the case where the youngest patch on the site matches the new patch type - new_patch%older => currentPatch - new_patch%younger => null() - currentPatch%younger => new_patch - currentSite%youngest_patch => new_patch - endif + + call insert_patch_into_sitelist(currentSite, new_patch) ! sort out the cohorts, since some of them may be so small as to need removing. ! the first call to terminate cohorts removes sparse number densities, @@ -1331,11 +1294,20 @@ subroutine spawn_patches( currentSite, bc_in) ! split buffer patch in two, keeping the smaller buffer patch to put into new patches call split_patch(currentSite, buffer_patch, temp_patch, newp_area/buffer_patch%area) - ! put the new patch into the linked list cdkcdk TODO + ! give the new patch the intended nocomp PFT label + temp_patch%nocomp_pft_label = i_pft + + ! put the new patch into the linked list + call insert_patch_into_sitelist(currentSite, temp_patch) + + ! CDK QUESTION: HOW DO WE ERASE OUT THE TEMP_PATCH INFO SO THAT IT CAN HOLD A NEW PATCH WHEN IT GOES BACK THROUGH THE LOOP? else + ! give the buffer patch the intended nocomp PFT label + buffer_patch%nocomp_pft_label = i_pft - ! put the buffer patch directly into the linked list cdkcdk TODO + ! put the buffer patch directly into the linked list + call insert_patch_into_sitelist(currentSite, buffer_patch) end if @@ -1358,6 +1330,63 @@ subroutine spawn_patches( currentSite, bc_in) return end subroutine spawn_patches + ! ----------------------------------------------------------------------------------------- + + subroutine insert_patch_into_sitelist(currentSite, new_patch) + ! + ! !DESCRIPTION: + ! Insert a new patch into the site linked list structure. + ! + ! !USES: + ! + ! !ARGUMENTS: + type(ed_site_type),intent(in) :: currentSite + type(ed_patch_type) , intent(inout), target :: new_patch ! New Patch + ! + ! !LOCAL VARIABLES: + type (ed_patch_type) , pointer :: currentPatch + logical :: found_youngest_landuselabel ! logical for finding the first primary forest patch + + currentPatch => currentSite%youngest_patch + + ! Insert new patch as the youngest patch in the group of patches with the same land use type. + ! On a given site, the patches are grouped together by land use type. The order of the + ! groups within the site doesn't matter, except that the older patch group are primarylands. + + if (currentPatch%land_use_label .eq. new_patch%land_use_label ) then + found_youngest_landuselabel = .false. + do while(associated(currentPatch) .and. .not. found_youngest_landuselabel) + currentPatch => currentPatch%older + if (associated(currentPatch)) then + if (currentPatch%land_use_label .eq. new_patch%land_use_label) then + found_youngest_landuselabel = .true. + endif + endif + end do + if (associated(currentPatch)) then + ! the case where we've found a youngest patch type matching the new patch type + new_patch%older => currentPatch + new_patch%younger => currentPatch%younger + currentPatch%younger%older => new_patch + currentPatch%younger => new_patch + else + ! the case where we haven't, because the patches are all non-primaryland, + ! and are putting a primaryland patch at the oldest end of the + ! linked list (not sure how this could happen, but who knows...) + new_patch%older => null() + new_patch%younger => currentSite%oldest_patch + currentSite%oldest_patch%older => new_patch + currentSite%oldest_patch => new_patch + endif + else + ! the case where the youngest patch on the site matches the new patch type + new_patch%older => currentPatch + new_patch%younger => null() + currentPatch%younger => new_patch + currentSite%youngest_patch => new_patch + endif + + end subroutine insert_patch_into_sitelist ! ============================================================================ subroutine split_patch(currentSite, currentPatch, new_patch, fraction_to_keep) @@ -1372,6 +1401,14 @@ subroutine split_patch(currentSite, currentPatch, new_patch, fraction_to_keep) type(ed_patch_type) , intent(inout), target :: currentPatch ! Donor Patch type(ed_patch_type) , intent(inout), target :: new_patch ! New Patch real(r8), intent(in) :: fraction_to_keep ! fraction of currentPatch to keep, the rest goes to newpatch + ! + ! !LOCAL VARIABLES: + integer :: el ! element loop index + type (ed_cohort_type), pointer :: nc + type (ed_cohort_type), pointer :: storesmallcohort + type (ed_cohort_type), pointer :: storebigcohort + integer :: tnull ! is there a tallest cohort? + integer :: snull ! is there a shortest cohort? ! first we need to make the new patch call create_patch(currentSite, new_patch, 0._r8, & From b4159dc214dccb08a3a5efe5d9deb0c92009be2c Mon Sep 17 00:00:00 2001 From: Charles D Koven Date: Tue, 8 Aug 2023 18:03:34 -0700 Subject: [PATCH 006/112] some compile-time bugfixes --- biogeochem/EDPatchDynamicsMod.F90 | 18 +++++++++++++----- main/EDInitMod.F90 | 19 ++++++++++--------- 2 files changed, 23 insertions(+), 14 deletions(-) diff --git a/biogeochem/EDPatchDynamicsMod.F90 b/biogeochem/EDPatchDynamicsMod.F90 index af2b7e8799..1368468fae 100644 --- a/biogeochem/EDPatchDynamicsMod.F90 +++ b/biogeochem/EDPatchDynamicsMod.F90 @@ -473,6 +473,12 @@ subroutine spawn_patches( currentSite, bc_in) real(r8) :: oldarea ! old patch area prior to disturbance logical :: clearing_matrix(n_landuse_cats,n_landuse_cats) ! do we clear vegetation when transferring from one LU type to another? type (ed_patch_type) , pointer :: buffer_patch, temp_patch + real(r8) :: nocomp_pft_area_vector(numpft) + real(r8) :: nocomp_pft_area_vector_allocated(numpft) + real(r8) :: fraction_to_keep + integer :: i_land_use_label + integer :: i_pft + real(r8) :: newp_area !--------------------------------------------------------------------- @@ -1220,7 +1226,7 @@ subroutine spawn_patches( currentSite, bc_in) end do nocomp_pft_loop - nocomp_and_luh_if: if ( use_fates_nocomp .eq. itrue .and. use_fates_luh .eq. itrue ) then + nocomp_and_luh_if: if ( hlm_use_nocomp .eq. itrue .and. hlm_use_luh .eq. itrue ) then ! disturbance has just hapopened, and now the nocomp PFT identities of the newly-disturbed patches ! need to be remapped to those associated with the new land use type. @@ -1283,7 +1289,7 @@ subroutine spawn_patches( currentSite, bc_in) end do ! now we need to loop through the nocomp PFTs, and split the buffer patch into a set of patches to put back in the linked list - nocomp_pft_loop: do i_pft = 1, numpft + nocomp_pft_loop_2: do i_pft = 1, numpft if (nocomp_pft_area_vector_allocated(i_pft) .lt. currentSite%area_pft(i_pft,i_land_use_label) * area) then @@ -1313,7 +1319,7 @@ subroutine spawn_patches( currentSite, bc_in) end if - end do nocomp_pft_loop + end do nocomp_pft_loop_2 end do lu_loop @@ -1340,7 +1346,7 @@ subroutine insert_patch_into_sitelist(currentSite, new_patch) ! !USES: ! ! !ARGUMENTS: - type(ed_site_type),intent(in) :: currentSite + type(ed_site_type),intent(inout) :: currentSite type(ed_patch_type) , intent(inout), target :: new_patch ! New Patch ! ! !LOCAL VARIABLES: @@ -1397,7 +1403,7 @@ subroutine split_patch(currentSite, currentPatch, new_patch, fraction_to_keep) ! !USES: ! ! !ARGUMENTS: - type(ed_site_type),intent(in) :: currentSite + type(ed_site_type),intent(inout) :: currentSite type(ed_patch_type) , intent(inout), target :: currentPatch ! Donor Patch type(ed_patch_type) , intent(inout), target :: new_patch ! New Patch real(r8), intent(in) :: fraction_to_keep ! fraction of currentPatch to keep, the rest goes to newpatch @@ -1407,9 +1413,11 @@ subroutine split_patch(currentSite, currentPatch, new_patch, fraction_to_keep) type (ed_cohort_type), pointer :: nc type (ed_cohort_type), pointer :: storesmallcohort type (ed_cohort_type), pointer :: storebigcohort + type (ed_cohort_type), pointer :: currentCohort integer :: tnull ! is there a tallest cohort? integer :: snull ! is there a shortest cohort? + ! first we need to make the new patch call create_patch(currentSite, new_patch, 0._r8, & currentPatch%area * (1._r8 - fraction_to_keep), currentPatch%land_use_label, currentPatch%nocomp_pft_label) diff --git a/main/EDInitMod.F90 b/main/EDInitMod.F90 index 5e0d1c5939..ee9ca85017 100644 --- a/main/EDInitMod.F90 +++ b/main/EDInitMod.F90 @@ -83,6 +83,7 @@ module EDInitMod use FatesSizeAgeTypeIndicesMod,only : get_age_class_index use DamageMainMod, only : undamaged_class use FatesInterfaceTypesMod , only : hlm_num_luh2_transitions + use FatesConstantsMod, only : nocomp_bareground_land, nocomp_bareground ! CIME GLOBALS use shr_log_mod , only : errMsg => shr_log_errMsg @@ -408,7 +409,7 @@ subroutine set_site_properties( nsites, sites,bc_in ) if(hlm_use_fixed_biogeog.eq.itrue)then - use_fates_luh_if: if (use_fates_luh .eq. itrue.) then + use_fates_luh_if: if (hlm_use_luh .eq. itrue) then ! MAPPING OF FATES PFTs on to HLM_PFTs with land use ! add up the area associated with each FATES PFT ! where pft_areafrac_lu is the area of land in each HLM PFT and land use type (from surface dataset) @@ -417,14 +418,14 @@ subroutine set_site_properties( nsites, sites,bc_in ) do hlm_pft = 1,fates_hlm_num_natpfts do fates_pft = 1,numpft ! loop round all fates pfts for all hlm pfts sites(s)%area_pft(fates_pft,i_landusetype) = sites(s)%area_pft(fates_pft,i_landusetype) + & - EDPftvarcon_inst%hlm_pft_map(fates_pft,hlm_pft) * bc_in(s)%pft_areafrac_luh(hlm_pft,i_landusetype) + EDPftvarcon_inst%hlm_pft_map(fates_pft,hlm_pft) * bc_in(s)%pft_areafrac_lu(hlm_pft,i_landusetype) end do end do !hlm_pft end do sites(s)%area_bareground = bc_in(s)%baregroundfrac * area - else use_fates_luh_if + else ! MAPPING OF FATES PFTs on to HLM_PFTs ! add up the area associated with each FATES PFT ! where pft_areafrac is the area of land in each HLM PFT and (from surface dataset) @@ -432,7 +433,7 @@ subroutine set_site_properties( nsites, sites,bc_in ) do hlm_pft = 1,size( EDPftvarcon_inst%hlm_pft_map,2) do fates_pft = 1,numpft ! loop round all fates pfts for all hlm pfts - sites(s)%area_pft(fates_pft,primarylands) = sites(s)%area_pft(fates_pft,primarylands) + & + sites(s)%area_pft(fates_pft,primaryland) = sites(s)%area_pft(fates_pft,primaryland) + & EDPftvarcon_inst%hlm_pft_map(fates_pft,hlm_pft) * bc_in(s)%pft_areafrac(hlm_pft) end do sites(s)%area_bareground = bc_in(s)%pft_areafrac(0) @@ -464,7 +465,7 @@ subroutine set_site_properties( nsites, sites,bc_in ) sites(s)%area_pft(ft, i_landusetype) = sites(s)%area_pft(ft, i_landusetype)/sumarea else ! if no PFT area in primary lands, set bare ground fraction to one. - if ( i_landusetype .eq. primarylands) then + if ( i_landusetype .eq. primaryland) then sites(s)%area_bareground = 1._r8 endif end if @@ -476,7 +477,7 @@ subroutine set_site_properties( nsites, sites,bc_in ) do ft = 1,numpft ! Setting this to true ensures that all pfts ! are used for nocomp with no biogeog - sites(s)%use_this_pft(ft) = itrues + sites(s)%use_this_pft(ft) = itrue if(hlm_use_fixed_biogeog.eq.itrue)then if(any(sites(s)%area_pft(ft,:).gt.0.0_r8))then sites(s)%use_this_pft(ft) = itrue @@ -532,7 +533,7 @@ subroutine init_patches( nsites, sites, bc_in) real(r8) :: state_vector(n_landuse_cats) ! [m2/m2] integer :: i_lu, i_lu_state integer :: n_active_landuse_cats - + integer :: end_landuse_idx type(ed_site_type), pointer :: sitep type(ed_patch_type), pointer :: newppft(:) @@ -637,7 +638,7 @@ subroutine init_patches( nsites, sites, bc_in) end do endif make_bareground_patch_if - if (use_fates_luh2 .eq. itrue) then + if (hlm_use_luh .eq. itrue) then end_landuse_idx = n_landuse_cats else end_landuse_idx = 1 @@ -664,7 +665,7 @@ subroutine init_patches( nsites, sites, bc_in) if(hlm_use_fixed_biogeog.eq.itrue)then newparea = sites(s)%area_pft(nocomp_pft,i_lu_state) * area / state_vector(i_lu_state) else - newparea = area / ( numpft * vector(i_lu_state)) + newparea = area / ( numpft * state_vector(i_lu_state)) end if else ! The default case is initialized w/ one patch with the area of the whole site. newparea = area / state_vector(i_lu_state) From 148eaf47ba6db1bb56c96f527ab779465fdddb80 Mon Sep 17 00:00:00 2001 From: Charles D Koven Date: Tue, 8 Aug 2023 19:51:56 -0700 Subject: [PATCH 007/112] more compile-time bugfixes --- biogeochem/EDPatchDynamicsMod.F90 | 1 + main/EDInitMod.F90 | 2 +- main/FatesRestartInterfaceMod.F90 | 29 ++++++++++++++++------------- 3 files changed, 18 insertions(+), 14 deletions(-) diff --git a/biogeochem/EDPatchDynamicsMod.F90 b/biogeochem/EDPatchDynamicsMod.F90 index 1368468fae..0b19c8ea23 100644 --- a/biogeochem/EDPatchDynamicsMod.F90 +++ b/biogeochem/EDPatchDynamicsMod.F90 @@ -1401,6 +1401,7 @@ subroutine split_patch(currentSite, currentPatch, new_patch, fraction_to_keep) ! Split a patch into two patches that are identical except in their areas ! ! !USES: + use EDCohortDynamicsMod , only : zero_cohort, copy_cohort ! ! !ARGUMENTS: type(ed_site_type),intent(inout) :: currentSite diff --git a/main/EDInitMod.F90 b/main/EDInitMod.F90 index ee9ca85017..98ae998b4a 100644 --- a/main/EDInitMod.F90 +++ b/main/EDInitMod.F90 @@ -55,7 +55,7 @@ module EDInitMod use FatesInterfaceTypesMod , only : nlevdamage use FatesInterfaceTypesMod , only : hlm_use_nocomp use FatesInterfaceTypesMod , only : nlevage - + use FatesInterfaceTypesMod , only : fates_hlm_num_natpfts use FatesAllometryMod , only : h2d_allom use FatesAllometryMod , only : bagw_allom use FatesAllometryMod , only : bbgw_allom diff --git a/main/FatesRestartInterfaceMod.F90 b/main/FatesRestartInterfaceMod.F90 index aaf4d51729..85c7a2c262 100644 --- a/main/FatesRestartInterfaceMod.F90 +++ b/main/FatesRestartInterfaceMod.F90 @@ -10,6 +10,7 @@ module FatesRestartInterfaceMod use FatesConstantsMod, only : fates_unset_r8, fates_unset_int use FatesConstantsMod, only : primaryland use FatesConstantsMod, only : nearzero + use FatesConstantsMod, only : n_landuse_cats use FatesGlobals, only : fates_log use FatesGlobals, only : endrun => fates_endrun use FatesIODimensionsMod, only : fates_io_dimension_type @@ -1886,7 +1887,8 @@ subroutine set_restart_vectors(this,nc,nsites,sites) integer :: i_cdam ! loop counter for damage integer :: icdi ! loop counter for damage integer :: icdj ! loop counter for damage - + integer :: i_landuse,i_pflu ! loop counter for land use class + type(fates_restart_variable_type) :: rvar type(ed_patch_type),pointer :: cpatch type(ed_cohort_type),pointer :: ccohort @@ -2042,9 +2044,13 @@ subroutine set_restart_vectors(this,nc,nsites,sites) end do do i_pft = 1,numpft - rio_area_pft_sift(io_idx_co_1st+i_pft-1) = sites(s)%area_pft(i_pft) + do i_landuse = 1, n_landuse_cats + i_pflu = i_landuse + (i_pft - 1) * n_landuse_cats + rio_area_pft_sift(io_idx_co_1st+i_pflu-1) = sites(s)%area_pft(i_pft, i_landuse) + end do end do + !! need to restart area_bareground if(hlm_use_sp.eq.ifalse)then do el = 1, num_elements @@ -2792,7 +2798,8 @@ subroutine get_restart_vectors(this, nc, nsites, sites) integer :: i_cacls ! loop counter for cohort age class integer :: i_cdam ! loop counter for damage class integer :: icdj ! loop counter for damage class - integer :: icdi ! loop counter for damage class + integer :: icdi ! loop counter for damage class + integer :: i_landuse,i_pflu ! loop counter for land use class associate( rio_npatch_si => this%rvars(ir_npatch_si)%int1d, & rio_cd_status_si => this%rvars(ir_cd_status_si)%int1d, & @@ -2932,18 +2939,14 @@ subroutine get_restart_vectors(this, nc, nsites, sites) ! variables for fixed biogeography mode. These are currently used in restart even when this is off. do i_pft = 1,numpft sites(s)%use_this_pft(i_pft) = rio_use_this_pft_sift(io_idx_co_1st+i_pft-1) - sites(s)%area_pft(i_pft) = rio_area_pft_sift(io_idx_co_1st+i_pft-1) + do i_landuse = 1, n_landuse_cats + i_pflu = i_landuse + (i_pft - 1) * n_landuse_cats + sites(s)%area_pft(i_pft, i_landuse) = rio_area_pft_sift(io_idx_co_1st+i_pflu-1) + end do enddo - ! calculate the bareground area for the pft in no competition + fixed biogeo modes - if (hlm_use_nocomp .eq. itrue .and. hlm_use_fixed_biogeog .eq. itrue) then - if (area-sum(sites(s)%area_pft(1:numpft)) .gt. nearzero) then - sites(s)%area_pft(0) = area - sum(sites(s)%area_pft(1:numpft)) - else - sites(s)%area_pft(0) = 0.0_r8 - endif - endif - + !! need to restart area_bareground + ! Mass balance and diagnostics across elements at the site level if(hlm_use_sp.eq.ifalse)then do el = 1, num_elements From c594f807872769ae0b94a6033830786b316c9848 Mon Sep 17 00:00:00 2001 From: Charlie Koven Date: Wed, 9 Aug 2023 10:56:02 -0700 Subject: [PATCH 008/112] adding logic to clean up temporary patches --- biogeochem/EDPatchDynamicsMod.F90 | 30 ++++++++++++++++++++++++++++-- 1 file changed, 28 insertions(+), 2 deletions(-) diff --git a/biogeochem/EDPatchDynamicsMod.F90 b/biogeochem/EDPatchDynamicsMod.F90 index 0b19c8ea23..34debf93e8 100644 --- a/biogeochem/EDPatchDynamicsMod.F90 +++ b/biogeochem/EDPatchDynamicsMod.F90 @@ -479,6 +479,7 @@ subroutine spawn_patches( currentSite, bc_in) integer :: i_land_use_label integer :: i_pft real(r8) :: newp_area + logical :: buffer_patch_in_linked_list !--------------------------------------------------------------------- @@ -1249,7 +1250,10 @@ subroutine spawn_patches( currentSite, bc_in) ! create buffer patch to put all of the pieces carved off of other patches call create_patch(currentSite, buffer_patch, 0._r8, & - 0._r8, i_land_use_label, 0) + 0._r8, i_land_use_label, 0) + + ! make a note that this buffer patch has not been put into the linked list + buffer_patch_in_linked_list = .false. ! Initialize the litter pools to zero do el=1,num_elements @@ -1306,7 +1310,9 @@ subroutine spawn_patches( currentSite, bc_in) ! put the new patch into the linked list call insert_patch_into_sitelist(currentSite, temp_patch) - ! CDK QUESTION: HOW DO WE ERASE OUT THE TEMP_PATCH INFO SO THAT IT CAN HOLD A NEW PATCH WHEN IT GOES BACK THROUGH THE LOOP? + ! now that the patch that temp_patch points to is in the site linked list, we want to null temp_patch so that it can be + ! refilled the next time through the loop. + temp_patch => null() else ! give the buffer patch the intended nocomp PFT label @@ -1314,6 +1320,8 @@ subroutine spawn_patches( currentSite, bc_in) ! put the buffer patch directly into the linked list call insert_patch_into_sitelist(currentSite, buffer_patch) + + buffer_patch_in_linked_list = .true. end if @@ -1321,6 +1329,24 @@ subroutine spawn_patches( currentSite, bc_in) end do nocomp_pft_loop_2 + ! now we want to make sure that either the buffer_patch either has zero area (presumably it was never used), in which case it should be deallocated, + ! or else it does have area but it has been put into the site linked list, and so buffer patch should be nulled before next pass through outer loop. + ! if either of those, that means everything worked properly, if not, then something has gone wrong. + if (buffer_patch_in_linked_list) then + buffer_patch => null() + else if (buffer_patch%area .lt. fates_tiny) then + ! here we need to deallocate the buffer patch so that we don't get a memory leak/ + call dealloc_patch(buffer_patch) + deallocate(buffer_patch, stat=istat, errmsg=smsg) + if (istat/=0) then + write(fates_log(),*) 'dealloc: fail on deallocate(dp):'//trim(smsg) + call endrun(msg=errMsg(sourcefile, __LINE__)) + endif + else + write(fates_log(),*) 'Buffer patch still has area and it wasnt put into the linked list' + write(fates_log(),*) 'buffer_patch%area', buffer_patch%area + call endrun(msg=errMsg(sourcefile, __LINE__)) + end if end do lu_loop endif nocomp_and_luh_if From e842bddf25a4874818d70182760de06d01f8ac23 Mon Sep 17 00:00:00 2001 From: Charles D Koven Date: Wed, 9 Aug 2023 17:05:03 -0700 Subject: [PATCH 009/112] adding logic to handle crop PFTs on crop land use types --- main/EDInitMod.F90 | 17 +++++++++++------ main/FatesConstantsMod.F90 | 3 ++- 2 files changed, 13 insertions(+), 7 deletions(-) diff --git a/main/EDInitMod.F90 b/main/EDInitMod.F90 index 98ae998b4a..f62956b50b 100644 --- a/main/EDInitMod.F90 +++ b/main/EDInitMod.F90 @@ -415,12 +415,17 @@ subroutine set_site_properties( nsites, sites,bc_in ) ! where pft_areafrac_lu is the area of land in each HLM PFT and land use type (from surface dataset) ! hlm_pft_map is the area of that land in each FATES PFT (from param file) do i_landusetype = 1, n_landuse_cats - do hlm_pft = 1,fates_hlm_num_natpfts - do fates_pft = 1,numpft ! loop round all fates pfts for all hlm pfts - sites(s)%area_pft(fates_pft,i_landusetype) = sites(s)%area_pft(fates_pft,i_landusetype) + & - EDPftvarcon_inst%hlm_pft_map(fates_pft,hlm_pft) * bc_in(s)%pft_areafrac_lu(hlm_pft,i_landusetype) - end do - end do !hlm_pft + if (.not. is_crop(i_landusetype)) then + do hlm_pft = 1,fates_hlm_num_natpfts + do fates_pft = 1,numpft ! loop round all fates pfts for all hlm pfts + sites(s)%area_pft(fates_pft,i_landusetype) = sites(s)%area_pft(fates_pft,i_landusetype) + & + EDPftvarcon_inst%hlm_pft_map(fates_pft,hlm_pft) * bc_in(s)%pft_areafrac_lu(hlm_pft,i_landusetype) + end do + end do !hlm_pft + else + ! for crops, we need to use different logic because the bc_in(s)%pft_areafrac_lu() information only exists for natural PFTs + sites(s)%area_pft(EDPftvarcon_inst%crop_lu_pft_vector(i_landusetype),i_landusetype) = 1._r8 + endif end do sites(s)%area_bareground = bc_in(s)%baregroundfrac * area diff --git a/main/FatesConstantsMod.F90 b/main/FatesConstantsMod.F90 index 35b2ee42b2..44fb45eb0f 100644 --- a/main/FatesConstantsMod.F90 +++ b/main/FatesConstantsMod.F90 @@ -30,13 +30,14 @@ module FatesConstantsMod ! Integer equivalent of false (in case come compilers dont auto convert) integer, parameter, public :: ifalse = 0 - ! Labels for patch disturbance history + ! Labels for patch land use type information integer, parameter, public :: n_landuse_cats = 5 integer, parameter, public :: primaryland = 1 integer, parameter, public :: secondaryland = 2 integer, parameter, public :: rangeland = 3 integer, parameter, public :: pastureland = 4 integer, parameter, public :: cropland = 5 + logical, parameter, dimension(n_landuse_cats), public :: is_crop = [.false.,.false.,.false.,.false.,.true.] ! Bareground nocomp land use label integer, parameter, public :: nocomp_bareground_land = 0 ! not a real land use type, only for labeling any bare-ground nocomp patches From 74fefd3628a034bd24eaab9772453b04fab89e90 Mon Sep 17 00:00:00 2001 From: Charles D Koven Date: Thu, 10 Aug 2023 16:15:56 -0700 Subject: [PATCH 010/112] adding logic for crops at recruitmetn step --- biogeochem/EDPhysiologyMod.F90 | 23 ++++++++++++++++++++--- main/FatesConstantsMod.F90 | 2 +- 2 files changed, 21 insertions(+), 4 deletions(-) diff --git a/biogeochem/EDPhysiologyMod.F90 b/biogeochem/EDPhysiologyMod.F90 index 5c63524ef0..a129e8f771 100644 --- a/biogeochem/EDPhysiologyMod.F90 +++ b/biogeochem/EDPhysiologyMod.F90 @@ -24,6 +24,7 @@ module EDPhysiologyMod use FatesConstantsMod, only : r8 => fates_r8 use FatesConstantsMod, only : nearzero use FatesConstantsMod, only : nocomp_bareground + use FatesConstantsMod, only : is_crop use EDPftvarcon , only : EDPftvarcon_inst use PRTParametersMod , only : prt_params use EDPftvarcon , only : GetDecompyFrac @@ -120,7 +121,8 @@ module EDPhysiologyMod use FatesParameterDerivedMod, only : param_derived use FatesPlantHydraulicsMod, only : InitHydrCohort use PRTInitParamsFatesMod, only : NewRecruitTotalStoichiometry - + use FatesInterfaceTypesMod , only : hlm_use_luh + implicit none private @@ -2022,6 +2024,7 @@ subroutine recruitment( currentSite, currentPatch, bc_in ) real(r8) :: mass_demand ! Total mass demanded by the plant to achieve the stoichiometric targets ! of all the organs in the recruits. Used for both [kg per plant] and [kg per cohort] real(r8) :: stem_drop_fraction + logical :: use_this_pft !---------------------------------------------------------------------- @@ -2031,13 +2034,27 @@ subroutine recruitment( currentSite, currentPatch, bc_in ) do ft = 1,numpft - ! The following if block is for the prescribed biogeography and/or nocomp modes. + ! The following if block is for the prescribed biogeography and/or nocomp modes and/or crop land use types ! Since currentSite%use_this_pft is a site-level quantity and thus only limits whether a given PFT ! is permitted on a given gridcell or not, it applies to the prescribed biogeography case only. ! If nocomp is enabled, then we must determine whether a given PFT is allowed on a given patch or not. + ! Whether or not nocomp or prescribed biogeography is enabled, if land use change is enabled, then we only want to + ! allow crop PFTs on patches with crop land use types + use_this_pft = .false. if(currentSite%use_this_pft(ft).eq.itrue & .and. ((hlm_use_nocomp .eq. ifalse) .or. (ft .eq. currentPatch%nocomp_pft_label)))then + use_this_pft = .true. + end if + + if ((hlm_use_luh .eq. itrue) .and. (is_crop(currentPatch%land_use_label))) then + if ( EDPftvarcon_inst%crop_lu_pft_vector(currentPatch%land_use_label) .eq. ft ) then + use_this_pft = .true. + else + use_this_pft = .false. + end if + + use_this_pft_if: if(use_this_pft) then temp_cohort%canopy_trim = init_recruit_trim temp_cohort%pft = ft @@ -2284,7 +2301,7 @@ subroutine recruitment( currentSite, currentPatch, bc_in ) endif any_recruits - endif !use_this_pft + endif use_this_pft_if enddo !pft loop deallocate(temp_cohort, stat=istat, errmsg=smsg) diff --git a/main/FatesConstantsMod.F90 b/main/FatesConstantsMod.F90 index 44fb45eb0f..a4934321c6 100644 --- a/main/FatesConstantsMod.F90 +++ b/main/FatesConstantsMod.F90 @@ -37,7 +37,7 @@ module FatesConstantsMod integer, parameter, public :: rangeland = 3 integer, parameter, public :: pastureland = 4 integer, parameter, public :: cropland = 5 - logical, parameter, dimension(n_landuse_cats), public :: is_crop = [.false.,.false.,.false.,.false.,.true.] + logical, parameter, dimension(0:n_landuse_cats), public :: is_crop = [.false., .false.,.false.,.false.,.false.,.true.] ! Bareground nocomp land use label integer, parameter, public :: nocomp_bareground_land = 0 ! not a real land use type, only for labeling any bare-ground nocomp patches From 66a5b2dbd33cbb06a68b14e117c319b924b446bc Mon Sep 17 00:00:00 2001 From: Charles D Koven Date: Thu, 10 Aug 2023 16:24:51 -0700 Subject: [PATCH 011/112] pasted code from grazing branch for adding land use dimension to paramter file --- main/FatesParametersInterface.F90 | 1 + parameter_files/fates_params_default.cdl | 11 +++++++++++ tools/modify_fates_paramfile.py | 2 +- tools/ncvarsort.py | 7 +++++-- 4 files changed, 18 insertions(+), 3 deletions(-) diff --git a/main/FatesParametersInterface.F90 b/main/FatesParametersInterface.F90 index aa13150c4a..3bb0f9a30b 100644 --- a/main/FatesParametersInterface.F90 +++ b/main/FatesParametersInterface.F90 @@ -38,6 +38,7 @@ module FatesParametersInterface character(len=*), parameter, public :: dimension_name_hlm_pftno = 'fates_hlm_pftno' character(len=*), parameter, public :: dimension_name_history_damage_bins = 'fates_history_damage_bins' character(len=*), parameter, public :: dimension_name_damage = 'fates_damage_class' + character(len=*), parameter, public :: dimension_name_landuse = 'fates_landuseclass' ! Dimensions in the host namespace: character(len=*), parameter, public :: dimension_name_host_allpfts = 'allpfts' diff --git a/parameter_files/fates_params_default.cdl b/parameter_files/fates_params_default.cdl index 408ca1e9ab..0a89e8edd6 100644 --- a/parameter_files/fates_params_default.cdl +++ b/parameter_files/fates_params_default.cdl @@ -8,6 +8,7 @@ dimensions: fates_history_size_bins = 13 ; fates_hlm_pftno = 14 ; fates_hydr_organs = 4 ; + fates_landuseclass = 5 ; fates_leafage_class = 1 ; fates_litterclass = 6 ; fates_pft = 12 ; @@ -47,6 +48,9 @@ variables: 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_landuseclass_name(fates_landuseclass, fates_string_length) ; + fates_landuseclass_name:units = "unitless - string" ; + fates_landuseclass_name:long_name = "Name of the land use classes, for variables associated with dimension fates_landuseclass" ; double fates_alloc_organ_priority(fates_plant_organs, fates_pft) ; fates_alloc_organ_priority:units = "index" ; fates_alloc_organ_priority:long_name = "Priority level for allocation, 1: replaces turnover from storage, 2: same priority as storage use/replacement, 3: ascending in order of least importance" ; @@ -860,6 +864,13 @@ data: "dead leaves ", "live grass " ; + fates_landuseclass_name = + "primaryland ", + "secondaryland ", + "rangeland ", + "pastureland ", + "cropland " ; + fates_alloc_organ_priority = 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, diff --git a/tools/modify_fates_paramfile.py b/tools/modify_fates_paramfile.py index adacb2457b..85f7c449ea 100755 --- a/tools/modify_fates_paramfile.py +++ b/tools/modify_fates_paramfile.py @@ -141,7 +141,7 @@ def main(): 'fates_history_damage_bins', 'fates_NCWD','fates_litterclass','fates_leafage_class', \ 'fates_plant_organs','fates_hydr_organs','fates_hlm_pftno', \ - 'fates_leafage_class']: + 'fates_leafage_class','fates_landuse_class']: otherdimpresent = True otherdimname = var.dimensions[i] otherdimlength = var.shape[i] diff --git a/tools/ncvarsort.py b/tools/ncvarsort.py index 327dd84a96..6583700ae3 100755 --- a/tools/ncvarsort.py +++ b/tools/ncvarsort.py @@ -30,7 +30,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 @@ -48,6 +48,7 @@ def main(): (u'fates_prt_organs', u'fates_string_length'):7, (u'fates_plant_organs', u'fates_string_length'):7, (u'fates_litterclass', u'fates_string_length'):7, + (u'fates_landuseclass', 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, @@ -56,7 +57,9 @@ def main(): (u'fates_hlm_pftno', u'fates_pft'):9, (u'fates_litterclass',):10, (u'fates_NCWD',):11, - ():12} + (u'fates_landuseclass',):12, + (u'fates_landuseclass', u'fates_pft'):12, + ():13} # # 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(): From 6c43b6175bbf6d39fe25ed396d2321fc82ba7ba5 Mon Sep 17 00:00:00 2001 From: Charles D Koven Date: Thu, 10 Aug 2023 17:32:40 -0700 Subject: [PATCH 012/112] passing crop landuse/PFT info through parameter interface --- biogeochem/EDPhysiologyMod.F90 | 5 +++-- main/EDInitMod.F90 | 4 +++- main/EDParamsMod.F90 | 11 ++++++++++- parameter_files/fates_params_default.cdl | 5 +++++ 4 files changed, 21 insertions(+), 4 deletions(-) diff --git a/biogeochem/EDPhysiologyMod.F90 b/biogeochem/EDPhysiologyMod.F90 index a129e8f771..05e0df320a 100644 --- a/biogeochem/EDPhysiologyMod.F90 +++ b/biogeochem/EDPhysiologyMod.F90 @@ -1984,7 +1984,7 @@ subroutine recruitment( currentSite, currentPatch, bc_in ) ! !USES: use FatesInterfaceTypesMod, only : hlm_use_ed_prescribed_phys use FatesLitterMod , only : ncwd - + use EDParamsMod , only : crop_lu_pft_vector ! ! !ARGUMENTS type(ed_site_type), intent(inout) :: currentSite @@ -2048,10 +2048,11 @@ subroutine recruitment( currentSite, currentPatch, bc_in ) end if if ((hlm_use_luh .eq. itrue) .and. (is_crop(currentPatch%land_use_label))) then - if ( EDPftvarcon_inst%crop_lu_pft_vector(currentPatch%land_use_label) .eq. ft ) then + if ( crop_lu_pft_vector(currentPatch%land_use_label) .eq. ft ) then use_this_pft = .true. else use_this_pft = .false. + end if end if use_this_pft_if: if(use_this_pft) then diff --git a/main/EDInitMod.F90 b/main/EDInitMod.F90 index f62956b50b..1651c727c2 100644 --- a/main/EDInitMod.F90 +++ b/main/EDInitMod.F90 @@ -11,6 +11,7 @@ module EDInitMod use FatesConstantsMod , only : primaryland use FatesConstantsMod , only : nearzero use FatesConstantsMod , only : n_landuse_cats + use FatesConstantsMod , only : is_crop use FatesGlobals , only : endrun => fates_endrun use EDTypesMod , only : nclmax use FatesGlobals , only : fates_log @@ -332,6 +333,7 @@ subroutine set_site_properties( nsites, sites,bc_in ) ! !DESCRIPTION: ! ! !USES: + use EDParamsMod, only : crop_lu_pft_vector ! ! !ARGUMENTS @@ -424,7 +426,7 @@ subroutine set_site_properties( nsites, sites,bc_in ) end do !hlm_pft else ! for crops, we need to use different logic because the bc_in(s)%pft_areafrac_lu() information only exists for natural PFTs - sites(s)%area_pft(EDPftvarcon_inst%crop_lu_pft_vector(i_landusetype),i_landusetype) = 1._r8 + sites(s)%area_pft(crop_lu_pft_vector(i_landusetype),i_landusetype) = 1._r8 endif end do diff --git a/main/EDParamsMod.F90 b/main/EDParamsMod.F90 index 9a54a45db5..57ddc9a20e 100644 --- a/main/EDParamsMod.F90 +++ b/main/EDParamsMod.F90 @@ -86,6 +86,7 @@ module EDParamsMod real(r8),protected,allocatable,public :: ED_val_history_height_bin_edges(:) real(r8),protected,allocatable,public :: ED_val_history_coageclass_bin_edges(:) real(r8),protected,allocatable,public :: ED_val_history_damage_bin_edges(:) + real(r8),protected,allocatable,public :: crop_lu_pft_vector(:) ! Switch that defines the current pressure-volume and pressure-conductivity model ! to be used at each node (compartment/organ) @@ -133,6 +134,7 @@ module EDParamsMod character(len=param_string_length),parameter,public :: ED_name_history_height_bin_edges= "fates_history_height_bin_edges" character(len=param_string_length),parameter,public :: ED_name_history_coageclass_bin_edges = "fates_history_coageclass_bin_edges" character(len=param_string_length),parameter,public :: ED_name_history_damage_bin_edges = "fates_history_damage_bin_edges" + character(len=param_string_length),parameter,public :: ED_name_crop_lu_pft_vector = "fates_landuse_crop_lu_pft_vector" ! Hydraulics Control Parameters (ONLY RELEVANT WHEN USE_FATES_HYDR = TRUE) ! ---------------------------------------------------------------------------------------------- @@ -341,7 +343,7 @@ subroutine FatesRegisterParams(fates_params) use FatesParametersInterface, only : dimension_name_history_size_bins, dimension_name_history_age_bins use FatesParametersInterface, only : dimension_name_history_height_bins, dimension_name_hydr_organs use FatesParametersInterface, only : dimension_name_history_coage_bins, dimension_name_history_damage_bins - use FatesParametersInterface, only : dimension_shape_scalar + use FatesParametersInterface, only : dimension_shape_scalar, dimension_name_landuse implicit none @@ -355,6 +357,7 @@ subroutine FatesRegisterParams(fates_params) 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/) character(len=param_string_length), parameter :: dim_names_damageclass(1)= (/dimension_name_history_damage_bins/) + character(len=param_string_length), parameter :: dim_names_landuse(1)= (/dimension_name_landuse/) call FatesParamsInit() @@ -558,6 +561,9 @@ subroutine FatesRegisterParams(fates_params) call fates_params%RegisterParameter(name=ED_name_history_damage_bin_edges, dimension_shape=dimension_shape_1d, & dimension_names=dim_names_damageclass) + call fates_params%RegisterParameter(name=ED_name_crop_lu_pft_vector, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names_landuse) + end subroutine FatesRegisterParams @@ -787,6 +793,9 @@ subroutine FatesReceiveParams(fates_params) call fates_params%RetrieveParameterAllocate(name=ED_name_history_damage_bin_edges, & data=ED_val_history_damage_bin_edges) + call fates_params%RetrieveParameterAllocate(name=ED_name_crop_lu_pft_vector, & + data=crop_lu_pft_vector) + call fates_params%RetrieveParameterAllocate(name=ED_name_hydr_htftype_node, & data=hydr_htftype_real) allocate(hydr_htftype_node(size(hydr_htftype_real))) diff --git a/parameter_files/fates_params_default.cdl b/parameter_files/fates_params_default.cdl index 0a89e8edd6..30ad56fe84 100644 --- a/parameter_files/fates_params_default.cdl +++ b/parameter_files/fates_params_default.cdl @@ -591,6 +591,9 @@ variables: double fates_frag_cwd_frac(fates_NCWD) ; fates_frag_cwd_frac:units = "fraction" ; fates_frag_cwd_frac:long_name = "fraction of woody (bdead+bsw) biomass destined for CWD pool" ; + double fates_landuse_crop_lu_pft_vector(fates_landuseclass) ; + fates_landuse_crop_lu_pft_vector:units = "NA" ; + fates_landuse_crop_lu_pft_vector:long_name = "What FATES PFT index to use on a given crop land-use type? (dummy value of -999 for non-crop types)" ; double fates_canopy_closure_thresh ; fates_canopy_closure_thresh:units = "unitless" ; fates_canopy_closure_thresh:long_name = "tree canopy coverage at which crown area allometry changes from savanna to forest value" ; @@ -1437,6 +1440,8 @@ data: fates_frag_cwd_frac = 0.045, 0.075, 0.21, 0.67 ; + fates_landuse_crop_lu_pft_vector = -999, -999, -999, -999, 11 ; + fates_canopy_closure_thresh = 0.8 ; fates_cnp_eca_plant_escalar = 1.25e-05 ; From 6b462cc4611bbfddc93e76a43906c91e3e40c398 Mon Sep 17 00:00:00 2001 From: Charles D Koven Date: Tue, 5 Sep 2023 21:45:04 -0700 Subject: [PATCH 013/112] added logic to handle transitioning from a restart with no-land-use to land-use --- biogeochem/EDLoggingMortalityMod.F90 | 177 +++++++++++++------------ biogeochem/EDMortalityFunctionsMod.F90 | 2 +- biogeochem/EDPatchDynamicsMod.F90 | 38 ++++-- biogeochem/FatesLandUseChangeMod.F90 | 45 +++++++ main/EDInitMod.F90 | 2 + main/EDMainMod.F90 | 5 + main/EDTypesMod.F90 | 2 + main/FatesRestartInterfaceMod.F90 | 18 +++ 8 files changed, 193 insertions(+), 96 deletions(-) diff --git a/biogeochem/EDLoggingMortalityMod.F90 b/biogeochem/EDLoggingMortalityMod.F90 index bf6ab7443c..9c843cbf71 100644 --- a/biogeochem/EDLoggingMortalityMod.F90 +++ b/biogeochem/EDLoggingMortalityMod.F90 @@ -195,7 +195,7 @@ end subroutine IsItLoggingTime ! ====================================================================================== - subroutine LoggingMortality_frac( pft_i, dbh, canopy_layer, lmort_direct, & + subroutine LoggingMortality_frac( currentSite, bc_in, pft_i, dbh, canopy_layer, lmort_direct, & lmort_collateral,lmort_infra, l_degrad, & hlm_harvest_rates, hlm_harvest_catnames, & hlm_harvest_units, & @@ -203,7 +203,8 @@ subroutine LoggingMortality_frac( pft_i, dbh, canopy_layer, lmort_direct, & frac_site_primary, harvestable_forest_c, & harvest_tag) - ! Arguments + ! Arguments + type(ed_site_type), intent(in), target :: currentSite ! site structure integer, intent(in) :: pft_i ! pft index real(r8), intent(in) :: dbh ! diameter at breast height (cm) integer, intent(in) :: canopy_layer ! canopy layer of this cohort @@ -239,109 +240,117 @@ subroutine LoggingMortality_frac( pft_i, dbh, canopy_layer, lmort_direct, & ! todo: check outputs against the LUH2 carbon data ! todo: eventually set up distinct harvest practices, each with a set of input paramaeters ! todo: implement harvested carbon inputs - - if (logging_time) then - ! Pass logging rates to cohort level - - if (hlm_use_lu_harvest == ifalse) then - ! 0=use fates logging parameters directly when logging_time == .true. - ! this means harvest the whole cohort area - harvest_rate = 1._r8 - - else if (hlm_use_lu_harvest == itrue .and. hlm_harvest_units == hlm_harvest_area_fraction) then - ! We are harvesting based on areal fraction, not carbon/biomass terms. - ! 1=use area fraction from hlm - ! combine forest and non-forest fracs and then apply: - ! primary and secondary area fractions to the logging rates, which are fates parameters - - ! Definitions of the underlying harvest land category variables - ! these are hardcoded to match the LUH input data via landuse.timseries file (see dynHarvestMod) - ! these are fractions of vegetated area harvested, split into five land category variables - ! HARVEST_VH1 = harvest from primary forest - ! HARVEST_VH2 = harvest from primary non-forest - ! HARVEST_SH1 = harvest from secondary mature forest - ! HARVEST_SH2 = harvest from secondary young forest - ! HARVEST_SH3 = harvest from secondary non-forest (assume this is young for biomass) - - ! Get the area-based harvest rates based on info passed to FATES from the boundary condition - call get_harvest_rate_area (patch_land_use_label, hlm_harvest_catnames, & - hlm_harvest_rates, frac_site_primary, secondary_age, harvest_rate) - - ! For area-based harvest, harvest_tag shall always be 2 (not applicable). - harvest_tag = 2 - cur_harvest_tag = 2 - - if (fates_global_verbose()) then - write(fates_log(), *) 'Successfully Read Harvest Rate from HLM.', hlm_harvest_rates(:), harvest_rate - end if + if (.not. currentSite%transition_landuse_from_off_to_on) then + if (logging_time) then + + ! Pass logging rates to cohort level + + if (hlm_use_lu_harvest == ifalse) then + ! 0=use fates logging parameters directly when logging_time == .true. + ! this means harvest the whole cohort area + harvest_rate = 1._r8 + + else if (hlm_use_lu_harvest == itrue .and. hlm_harvest_units == hlm_harvest_area_fraction) then + ! We are harvesting based on areal fraction, not carbon/biomass terms. + ! 1=use area fraction from hlm + ! combine forest and non-forest fracs and then apply: + ! primary and secondary area fractions to the logging rates, which are fates parameters + + ! Definitions of the underlying harvest land category variables + ! these are hardcoded to match the LUH input data via landuse.timseries file (see dynHarvestMod) + ! these are fractions of vegetated area harvested, split into five land category variables + ! HARVEST_VH1 = harvest from primary forest + ! HARVEST_VH2 = harvest from primary non-forest + ! HARVEST_SH1 = harvest from secondary mature forest + ! HARVEST_SH2 = harvest from secondary young forest + ! HARVEST_SH3 = harvest from secondary non-forest (assume this is young for biomass) + + ! Get the area-based harvest rates based on info passed to FATES from the boundary condition + call get_harvest_rate_area (patch_land_use_label, hlm_harvest_catnames, & + hlm_harvest_rates, frac_site_primary, secondary_age, harvest_rate) + + ! For area-based harvest, harvest_tag shall always be 2 (not applicable). + harvest_tag = 2 + cur_harvest_tag = 2 + + if (fates_global_verbose()) then + write(fates_log(), *) 'Successfully Read Harvest Rate from HLM.', hlm_harvest_rates(:), harvest_rate + end if - else if (hlm_use_lu_harvest == itrue .and. hlm_harvest_units == hlm_harvest_carbon) then - ! 2=use carbon from hlm - ! shall call another subroutine, which transfers biomass/carbon into fraction + else if (hlm_use_lu_harvest == itrue .and. hlm_harvest_units == hlm_harvest_carbon) then + ! 2=use carbon from hlm + ! shall call another subroutine, which transfers biomass/carbon into fraction - call get_harvest_rate_carbon (patch_land_use_label, hlm_harvest_catnames, & - hlm_harvest_rates, secondary_age, harvestable_forest_c, & - harvest_rate, harvest_tag, cur_harvest_tag) + call get_harvest_rate_carbon (patch_land_use_label, hlm_harvest_catnames, & + hlm_harvest_rates, secondary_age, harvestable_forest_c, & + harvest_rate, harvest_tag, cur_harvest_tag) - if (fates_global_verbose()) then - write(fates_log(), *) 'Successfully Read Harvest Rate from HLM.', hlm_harvest_rates(:), harvest_rate, harvestable_forest_c - end if - - endif - - ! transfer of area to secondary land is based on overall area affected, not just logged crown area - ! l_degrad accounts for the affected area between logged crowns - if(prt_params%woody(pft_i) == itrue)then ! only set logging rates for trees - if (cur_harvest_tag == 0) then - ! direct logging rates, based on dbh min and max criteria - if (dbh >= logging_dbhmin .and. .not. & - ((logging_dbhmax < fates_check_param_set) .and. (dbh >= logging_dbhmax )) ) then - ! the logic of the above line is a bit unintuitive but allows turning off the dbhmax comparison entirely. - ! since there is an .and. .not. after the first conditional, the dbh:dbhmax comparison needs to be - ! the opposite of what would otherwise be expected... - lmort_direct = harvest_rate * logging_direct_frac + if (fates_global_verbose()) then + write(fates_log(), *) 'Successfully Read Harvest Rate from HLM.', hlm_harvest_rates(:), harvest_rate, harvestable_forest_c + end if + + endif + + ! transfer of area to secondary land is based on overall area affected, not just logged crown area + ! l_degrad accounts for the affected area between logged crowns + if(prt_params%woody(pft_i) == itrue)then ! only set logging rates for trees + if (cur_harvest_tag == 0) then + ! direct logging rates, based on dbh min and max criteria + if (dbh >= logging_dbhmin .and. .not. & + ((logging_dbhmax < fates_check_param_set) .and. (dbh >= logging_dbhmax )) ) then + ! the logic of the above line is a bit unintuitive but allows turning off the dbhmax comparison entirely. + ! since there is an .and. .not. after the first conditional, the dbh:dbhmax comparison needs to be + ! the opposite of what would otherwise be expected... + lmort_direct = harvest_rate * logging_direct_frac + else + lmort_direct = 0.0_r8 + end if else lmort_direct = 0.0_r8 end if - else - lmort_direct = 0.0_r8 - end if - ! infrastructure (roads, skid trails, etc) mortality rates - if (dbh >= logging_dbhmax_infra) then - lmort_infra = 0.0_r8 - else + ! infrastructure (roads, skid trails, etc) mortality rates + if (dbh >= logging_dbhmax_infra) then + lmort_infra = 0.0_r8 + else + lmort_infra = harvest_rate * logging_mechanical_frac + end if + + ! Collateral damage to smaller plants below the direct logging size threshold + ! will be applied via "understory_death" via the disturbance algorithm + if (canopy_layer .eq. 1) then + lmort_collateral = harvest_rate * logging_collateral_frac + else + lmort_collateral = 0._r8 + endif + + else ! non-woody plants still killed by infrastructure + lmort_direct = 0.0_r8 + lmort_collateral = 0.0_r8 lmort_infra = harvest_rate * logging_mechanical_frac end if - ! Collateral damage to smaller plants below the direct logging size threshold - ! will be applied via "understory_death" via the disturbance algorithm + ! the area occupied by all plants in the canopy that aren't killed is still disturbed at the harvest rate if (canopy_layer .eq. 1) then - lmort_collateral = harvest_rate * logging_collateral_frac + l_degrad = harvest_rate - (lmort_direct + lmort_infra + lmort_collateral) ! fraction passed to 'degraded' forest. else - lmort_collateral = 0._r8 + l_degrad = 0._r8 endif - else ! non-woody plants still killed by infrastructure + else lmort_direct = 0.0_r8 lmort_collateral = 0.0_r8 - lmort_infra = harvest_rate * logging_mechanical_frac + lmort_infra = 0.0_r8 + l_degrad = 0.0_r8 end if - - ! the area occupied by all plants in the canopy that aren't killed is still disturbed at the harvest rate - if (canopy_layer .eq. 1) then - l_degrad = harvest_rate - (lmort_direct + lmort_infra + lmort_collateral) ! fraction passed to 'degraded' forest. - else - l_degrad = 0._r8 - endif - - else - lmort_direct = 0.0_r8 + else + call get_init_landuse_harvest_rate(bc_in, harvest_rate) + lmort_direct = harvest_rate lmort_collateral = 0.0_r8 lmort_infra = 0.0_r8 l_degrad = 0.0_r8 - end if + endif end subroutine LoggingMortality_frac diff --git a/biogeochem/EDMortalityFunctionsMod.F90 b/biogeochem/EDMortalityFunctionsMod.F90 index b979be5eab..5136af67f0 100644 --- a/biogeochem/EDMortalityFunctionsMod.F90 +++ b/biogeochem/EDMortalityFunctionsMod.F90 @@ -281,7 +281,7 @@ subroutine Mortality_Derivative( currentSite, currentCohort, bc_in, btran_ft, & !if trees are in the canopy, then their death is 'disturbance'. This probably needs a different terminology call mortality_rates(currentCohort,bc_in,btran_ft, mean_temp, & cmort,hmort,bmort,frmort, smort, asmort, dgmort) - call LoggingMortality_frac(ipft, currentCohort%dbh, currentCohort%canopy_layer, & + call LoggingMortality_frac(currentSite, bc_in, ipft, currentCohort%dbh, currentCohort%canopy_layer, & currentCohort%lmort_direct, & currentCohort%lmort_collateral, & currentCohort%lmort_infra, & diff --git a/biogeochem/EDPatchDynamicsMod.F90 b/biogeochem/EDPatchDynamicsMod.F90 index 3243857f4c..12747d9ed8 100644 --- a/biogeochem/EDPatchDynamicsMod.F90 +++ b/biogeochem/EDPatchDynamicsMod.F90 @@ -222,6 +222,14 @@ subroutine disturbance_rates( site_in, bc_in) ! first calculate the fraction of the site that is primary land call get_frac_site_primary(site_in, frac_site_primary) + ! check status of transition_landuse_from_off_to_on flag, and do some error checking on it + if(site_in%transition_landuse_from_off_to_on) then + if (abs(frac_site_primary - 1._r8) .gt. fates_tiny) then + write(fates_log(),*) 'flag for transition_landuse_from_off_to_on is set to true but site is not entirely primaryland' + call endrun(msg=errMsg(sourcefile, __LINE__)) + endif + endif + ! get available biomass for harvest for all patches call get_harvestable_carbon(site_in, bc_in%site_area, bc_in%hlm_harvest_catnames, harvestable_forest_c) @@ -248,7 +256,8 @@ subroutine disturbance_rates( site_in, bc_in) currentCohort%asmort = asmort currentCohort%dgmort = dgmort - call LoggingMortality_frac(currentCohort%pft, currentCohort%dbh, currentCohort%canopy_layer, & + call LoggingMortality_frac(site_in, bc_in, currentCohort%pft, & + currentCohort%dbh, currentCohort%canopy_layer, & lmort_direct,lmort_collateral,lmort_infra,l_degrad,& bc_in%hlm_harvest_rates, & bc_in%hlm_harvest_catnames, & @@ -272,8 +281,12 @@ subroutine disturbance_rates( site_in, bc_in) call get_harvest_debt(site_in, bc_in, harvest_tag) - call get_landuse_transition_rates(bc_in, landuse_transition_matrix) - + if(.not. site_in%transition_landuse_from_off_to_on) then + call get_landuse_transition_rates(bc_in, landuse_transition_matrix) + else + call get_init_landuse_transition_rates(bc_in, landuse_transition_matrix) + endif + ! calculate total area in each landuse category current_fates_landuse_state_vector(:) = 0._r8 currentPatch => site_in%oldest_patch @@ -359,14 +372,18 @@ subroutine disturbance_rates( site_in, bc_in) (currentPatch%area - currentPatch%total_canopy_area) .gt. fates_tiny ) then ! The canopy is NOT closed. - if(bc_in%hlm_harvest_units == hlm_harvest_carbon) then - call get_harvest_rate_carbon (currentPatch%land_use_label, bc_in%hlm_harvest_catnames, & - bc_in%hlm_harvest_rates, currentPatch%age_since_anthro_disturbance, harvestable_forest_c, & - harvest_rate, harvest_tag) + if (.not. site_in%transition_landuse_from_off_to_on) then + if(bc_in%hlm_harvest_units == hlm_harvest_carbon) then + call get_harvest_rate_carbon (currentPatch%land_use_label, bc_in%hlm_harvest_catnames, & + bc_in%hlm_harvest_rates, currentPatch%age_since_anthro_disturbance, harvestable_forest_c, & + harvest_rate, harvest_tag) + else + call get_harvest_rate_area (currentPatch%land_use_label, bc_in%hlm_harvest_catnames, & + bc_in%hlm_harvest_rates, frac_site_primary, currentPatch%age_since_anthro_disturbance, harvest_rate) + end if else - call get_harvest_rate_area (currentPatch%land_use_label, bc_in%hlm_harvest_catnames, & - bc_in%hlm_harvest_rates, frac_site_primary, currentPatch%age_since_anthro_disturbance, harvest_rate) - end if + call get_init_landuse_harvest_rate(bc_in, harvest_rate) + endif currentPatch%disturbance_rates(dtype_ilog) = currentPatch%disturbance_rates(dtype_ilog) + & (currentPatch%area - currentPatch%total_canopy_area) * harvest_rate / currentPatch%area @@ -436,7 +453,6 @@ subroutine spawn_patches( currentSite, bc_in) use EDParamsMod , only : ED_val_understorey_death, logging_coll_under_frac use EDCohortDynamicsMod , only : terminate_cohorts use FatesConstantsMod , only : rsnbl_math_prec - use FatesLandUseChangeMod, only : get_landuse_transition_rates use FatesLandUseChangeMod, only : get_landusechange_rules ! ! !ARGUMENTS: diff --git a/biogeochem/FatesLandUseChangeMod.F90 b/biogeochem/FatesLandUseChangeMod.F90 index 6adf6d4852..d3d7bd5d2c 100644 --- a/biogeochem/FatesLandUseChangeMod.F90 +++ b/biogeochem/FatesLandUseChangeMod.F90 @@ -298,4 +298,49 @@ subroutine CheckLUHData(luh_vector,modified_flag) end subroutine CheckLUHData + + subroutine get_init_landuse_harvest_rate(bc_in, harvest_rate) + + ! the purpose of this subroutine is, only under the case where we are transitioning from a spinup run that did not have land use + ! to a run that does, to apply the land-use changes needed to get to the state vector in a single daily instance. this is for + ! the hrvest rate from primary lands, i.e. the transition from primary to secondary lands. thus instead of using the harvest + ! dataset tself, it only uses the state vector for what land use compositoin we want to achieve, and log the forests accordingly. + + ! !ARGUMENTS: + type(bc_in_type) , intent(in) :: bc_in + real(r8), intent(out) :: harvest_rate ! [m2/ m2 / day] + + ! LOCALS + real(r8) :: state_vector(n_landuse_cats) ! [m2/m2] + + call get_luh_statedata(bc_in, state_vector) + + harvest_rate = state_vector(secondaryland) + + end subroutine get_init_landuse_harvest_rate + + subroutine get_landuse_transition_rates(bc_in, landuse_transition_matrix) + + ! The purose of this subroutine is, only under the case where we are transitioning from a spinup run that did not have land use + ! to a run that does, to apply the land-use changes needed to get to the state vector in a single daily instance. this is for + ! the transitions other than harvest, i.e. from primary lands to all other categories aside from secondary lands. + + ! !ARGUMENTS: + type(bc_in_type) , intent(in) :: bc_in + real(r8), intent(inout) :: landuse_transition_matrix(n_landuse_cats, n_landuse_cats) ! [m2/m2/day] + + ! LOCALS + real(r8) :: state_vector(n_landuse_cats) ! [m2/m2] + integer :: i + + landuse_transition_matrix(:,:) = 0._r8 + + call get_luh_statedata(bc_in, state_vector) + + do i = secondaryland+1,n_landuse_cats + landuse_transition_matrix(1,i) = state_vector(i) + end do + + end subroutine get_landuse_transition_rates + end module FatesLandUseChangeMod diff --git a/main/EDInitMod.F90 b/main/EDInitMod.F90 index 24bb860788..961404bc1e 100644 --- a/main/EDInitMod.F90 +++ b/main/EDInitMod.F90 @@ -343,6 +343,8 @@ subroutine zero_site( site_in ) site_in%use_this_pft(:) = fates_unset_int site_in%area_by_age(:) = 0._r8 + site_in%transition_landuse_from_off_to_on = .false. + end subroutine zero_site ! ============================================================================ diff --git a/main/EDMainMod.F90 b/main/EDMainMod.F90 index 39b425a9ee..eca4bb3f1a 100644 --- a/main/EDMainMod.F90 +++ b/main/EDMainMod.F90 @@ -225,6 +225,11 @@ subroutine ed_ecosystem_dynamics(currentSite, bc_in, bc_out) ! Integrate state variables from annual rates to daily timestep call ed_integrate_state_variables(currentSite, bc_in, bc_out ) + ! at this point in the call sequence, if flag to transition_landuse_from_off_to_on was set, unset it as it is no longer needed + if(currentSite%transition_landuse_from_off_to_on) then + currentSite%transition_landuse_from_off_to_on = .false + endif + else ! ed_intergrate_state_variables is where the new cohort flag ! is set. This flag designates wether a cohort has diff --git a/main/EDTypesMod.F90 b/main/EDTypesMod.F90 index b1ba28b8b4..bb02cf89d9 100644 --- a/main/EDTypesMod.F90 +++ b/main/EDTypesMod.F90 @@ -426,6 +426,8 @@ module EDTypesMod real(r8) :: primary_land_patchfusion_error ! error term in total area of primary patches associated with patch fusion [m2/m2/day] real(r8) :: landuse_transition_matrix(n_landuse_cats, n_landuse_cats) ! land use transition matrix as read in from HLM and aggregated to FATES land use types [m2/m2/year] + logical :: transition_landuse_from_off_to_on ! special flag to use only when reading restarts, which triggers procedure to initialize land use + end type ed_site_type ! Make public necessary subroutines and functions diff --git a/main/FatesRestartInterfaceMod.F90 b/main/FatesRestartInterfaceMod.F90 index be9ef01815..cfce367952 100644 --- a/main/FatesRestartInterfaceMod.F90 +++ b/main/FatesRestartInterfaceMod.F90 @@ -25,6 +25,7 @@ module FatesRestartInterfaceMod use FatesInterfaceTypesMod, only : hlm_parteh_mode use FatesInterfaceTypesMod, only : hlm_use_sp use FatesInterfaceTypesMod, only : hlm_use_nocomp, hlm_use_fixed_biogeog + use FatesInterfaceTypesMod, only : hlm_use_luh use FatesInterfaceTypesMod, only : fates_maxElementsPerSite use FatesInterfaceTypesMod, only : hlm_use_tree_damage use FatesHydraulicsMemMod, only : nshell @@ -98,6 +99,7 @@ module FatesRestartInterfaceMod integer :: ir_gdd_si integer :: ir_snow_depth_si integer :: ir_trunk_product_si + integer :: ir_landuse_config_si integer :: ir_ncohort_pa integer :: ir_canopy_layer_co integer :: ir_canopy_layer_yesterday_co @@ -704,6 +706,10 @@ subroutine define_restart_vars(this, initialize_variables) units='kgC/m2', flushval = flushzero, & hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_trunk_product_si ) + call this%set_restart_var(vname='fates_landuse_config_site', vtype=site_r8, & + long_name='hlm_use_luh status of run that created this restart file', & + units='kgC/m2', flushval = flushzero, & + hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_landuse_config_si ) ! ----------------------------------------------------------------------------------- ! Variables stored within cohort vectors @@ -1991,6 +1997,7 @@ subroutine set_restart_vectors(this,nc,nsites,sites) 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_landuse_config_s => this%rvars(ir_landuse_config_si)%int1d, & rio_ncohort_pa => this%rvars(ir_ncohort_pa)%int1d, & rio_fcansno_pa => this%rvars(ir_fcansno_pa)%r81d, & rio_solar_zenith_flag_pa => this%rvars(ir_solar_zenith_flag_pa)%int1d, & @@ -2575,6 +2582,10 @@ subroutine set_restart_vectors(this,nc,nsites,sites) ! Accumulated trunk product rio_trunk_product_si(io_idx_si) = sites(s)%resources_management%trunk_product_site + + ! land use flag + rio_landuse_config_si(io_idx_si) = hlm_use_luh + ! set numpatches for this column rio_npatch_si(io_idx_si) = patchespersite @@ -2935,6 +2946,7 @@ subroutine get_restart_vectors(this, nc, nsites, sites) 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_landuse_config_si => this%rvars(ir_landuse_config_si)%int1d, & rio_ncohort_pa => this%rvars(ir_ncohort_pa)%int1d, & rio_fcansno_pa => this%rvars(ir_fcansno_pa)%r81d, & rio_solar_zenith_flag_pa => this%rvars(ir_solar_zenith_flag_pa)%int1d, & @@ -3546,6 +3558,12 @@ subroutine get_restart_vectors(this, nc, nsites, sites) 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) + ! if needed, trigger the special procedure to initialize land use structure from a + ! restart run that did not include land use. + if (rio_landuse_config_si(io_idx_si) .eq. ifalse .and. hlm_use_luh .eq. itrue) then + sites(s)%transition_landuse_from_off_to_on = .true. + endif + end do if ( debug ) then From a441e93e0122ecd1e20573e4fc0098913fc13d0b Mon Sep 17 00:00:00 2001 From: Charlie Koven Date: Mon, 18 Sep 2023 16:48:14 -0700 Subject: [PATCH 014/112] added edparamsmod changed to merge --- main/EDParamsMod.F90 | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/main/EDParamsMod.F90 b/main/EDParamsMod.F90 index bb987b947f..9d3391ada3 100644 --- a/main/EDParamsMod.F90 +++ b/main/EDParamsMod.F90 @@ -838,7 +838,9 @@ subroutine FatesReceiveParams(fates_params) data=ED_val_history_damage_bin_edges) call fates_params%RetrieveParameterAllocate(name=ED_name_crop_lu_pft_vector, & - data=crop_lu_pft_vector) + data=tmp_vector_by_landuse) + + crop_lu_pft_vector(:) = nint(tmp_vector_by_landuse(:)) call fates_params%RetrieveParameter(name=ED_name_maxpatches_by_landuse, & data=tmp_vector_by_landuse) From b94fefa9f8864c5b4a204a541a75a82348f748f7 Mon Sep 17 00:00:00 2001 From: Charlie Koven Date: Mon, 18 Sep 2023 16:58:47 -0700 Subject: [PATCH 015/112] fixed merged conflict --- parameter_files/fates_params_default.cdl | 10 ---------- 1 file changed, 10 deletions(-) diff --git a/parameter_files/fates_params_default.cdl b/parameter_files/fates_params_default.cdl index 8e4b829389..155c087ecb 100644 --- a/parameter_files/fates_params_default.cdl +++ b/parameter_files/fates_params_default.cdl @@ -52,9 +52,6 @@ variables: 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_landuseclass_name(fates_landuseclass, fates_string_length) ; - fates_landuseclass_name:units = "unitless - string" ; - fates_landuseclass_name:long_name = "Name of the land use classes, for variables associated with dimension fates_landuseclass" ; double fates_alloc_organ_priority(fates_plant_organs, fates_pft) ; fates_alloc_organ_priority:units = "index" ; fates_alloc_organ_priority:long_name = "Priority level for allocation, 1: replaces turnover from storage, 2: same priority as storage use/replacement, 3: ascending in order of least importance" ; @@ -953,13 +950,6 @@ data: "dead leaves ", "live grass " ; - fates_landuseclass_name = - "primaryland ", - "secondaryland ", - "rangeland ", - "pastureland ", - "cropland " ; - fates_alloc_organ_priority = 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, From 71deea8343f1abe2c9b5121ff0159cd032aa2bc5 Mon Sep 17 00:00:00 2001 From: Charlie Koven Date: Thu, 12 Oct 2023 15:33:28 -0700 Subject: [PATCH 016/112] added logic to handle case where nocomp and land use are on but not enough patches for a given land use type to acomodate all PFTs prescribed --- main/EDInitMod.F90 | 35 +++++++++++++++++++++++++++++++++-- 1 file changed, 33 insertions(+), 2 deletions(-) diff --git a/main/EDInitMod.F90 b/main/EDInitMod.F90 index d68a7652fd..96ee34dbff 100644 --- a/main/EDInitMod.F90 +++ b/main/EDInitMod.F90 @@ -354,6 +354,7 @@ subroutine set_site_properties( nsites, sites,bc_in ) ! ! !USES: use EDParamsMod, only : crop_lu_pft_vector + use EDParamsMod, only : maxpatches_by_landuse ! ! !ARGUMENTS @@ -383,6 +384,7 @@ subroutine set_site_properties( nsites, sites,bc_in ) integer :: hlm_pft ! used in fixed biogeog mode integer :: fates_pft ! used in fixed biogeog mode integer :: i_landusetype + real(r8) :: temp_vec(numpft) ! temporary vector !---------------------------------------------------------------------- @@ -486,13 +488,17 @@ subroutine set_site_properties( nsites, sites,bc_in ) endif use_fates_luh_if + ! handle some edge cases do i_landusetype = 1, n_landuse_cats do ft = 1,numpft + + ! remove tiny patches to prevent numerical errors in terminate patches if(sites(s)%area_pft(ft, i_landusetype).lt.0.01_r8.and.sites(s)%area_pft(ft, i_landusetype).gt.0.0_r8)then if(debug) write(fates_log(),*) 'removing small pft patches',s,ft,i_landusetype,sites(s)%area_pft(ft, i_landusetype) sites(s)%area_pft(ft, i_landusetype)=0.0_r8 - ! remove tiny patches to prevent numerical errors in terminate patches endif + + ! if any areas are negative, then end run if(sites(s)%area_pft(ft, i_landusetype).lt.0._r8)then write(fates_log(),*) 'negative area',s,ft,i_landusetype,sites(s)%area_pft(ft, i_landusetype) call endrun(msg=errMsg(sourcefile, __LINE__)) @@ -500,9 +506,34 @@ subroutine set_site_properties( nsites, sites,bc_in ) end do end do + ! if in nocomp mode, and the number of nocomp PFTs of a given land use type is greater than the maximum number of patches + ! allowed to be allocated for that land use type, then only keep the number of PFTs correspondign to the number of patches + ! allowed on that land use type, starting with the PFTs with greatest area coverage and working down + if (hlm_use_nocomp .eq. itrue) then + do i_landusetype = 1, n_landuse_cats + ! count how many PFTs have areas greater than zero and compare to the number of patches allowed + if (COUNT(sites(s)%area_pft(ft, i_landusetype) .gt. 0._r8) > maxpatches_by_landuse(i_landusetype)) then + ! write current vector to log file + if(debug) write(fates_log(),*) 'too many PFTs for LU type ', i_landusetype, i_landusetype,sites(s)%area_pft(:, i_landusetype) + + ! start from largest area, put that PFT's area into a temp vector, and then work down to successively smaller-area PFTs, + ! at the end replace the original vector with the temp vector + temp_vec(:) = 0._r8 + do i_pftcount = 1, maxpatches_by_landuse(i_landusetype) + temp_vec(MAXLOC(sites(s)%area_pft(:, i_landusetype))) = & + sites(s)%area_pft(MAXLOC(sites(s)%area_pft(:, i_landusetype)), i_landusetype) + sites(s)%area_pft(MAXLOC(sites(s)%area_pft(:, i_landusetype)), i_landusetype) = 0._r8 + end do + sites(s)%area_pft(:, i_landusetype) = temp_vec(:) + + ! write adjusted vector to log file + if(debug) write(fates_log(),*) 'new PFT vector for LU type', i_landusetype, i_landusetype,sites(s)%area_pft(:, i_landusetype) + endif + end do + end if + ! re-normalize PFT area to ensure it sums to one for each (active) land use type ! for nocomp cases, track bare ground area as a separate quantity - do i_landusetype = 1, n_landuse_cats sumarea = sum(sites(s)%area_pft(1:numpft,i_landusetype)) do ft = 1,numpft From 01212d112edddf471a1b063fae4ed9809dfc7328 Mon Sep 17 00:00:00 2001 From: Charlie Koven Date: Thu, 12 Oct 2023 15:50:21 -0700 Subject: [PATCH 017/112] error/edge-case handling for if the LU x PFT area dataset has NaNs --- main/EDInitMod.F90 | 42 +++++++++++++++++++++++++++++------------- 1 file changed, 29 insertions(+), 13 deletions(-) diff --git a/main/EDInitMod.F90 b/main/EDInitMod.F90 index 96ee34dbff..78bfcd8875 100644 --- a/main/EDInitMod.F90 +++ b/main/EDInitMod.F90 @@ -95,6 +95,7 @@ module EDInitMod ! CIME GLOBALS use shr_log_mod , only : errMsg => shr_log_errMsg + use shr_infnan_mod , only : isnan => shr_infnan_isnan implicit none private @@ -456,21 +457,36 @@ subroutine set_site_properties( nsites, sites,bc_in ) ! add up the area associated with each FATES PFT ! where pft_areafrac_lu is the area of land in each HLM PFT and land use type (from surface dataset) ! hlm_pft_map is the area of that land in each FATES PFT (from param file) - do i_landusetype = 1, n_landuse_cats - if (.not. is_crop(i_landusetype)) then - do hlm_pft = 1,fates_hlm_num_natpfts - do fates_pft = 1,numpft ! loop round all fates pfts for all hlm pfts - sites(s)%area_pft(fates_pft,i_landusetype) = sites(s)%area_pft(fates_pft,i_landusetype) + & - EDPftvarcon_inst%hlm_pft_map(fates_pft,hlm_pft) * bc_in(s)%pft_areafrac_lu(hlm_pft,i_landusetype) - end do - end do !hlm_pft + + ! first check for NaNs in bc_in(s)%pft_areafrac_lu. if so, make everything bare ground. + if ( .not. any( isnan( bc_in(s)%pft_areafrac_lu (:,:) ))) then + do i_landusetype = 1, n_landuse_cats + if (.not. is_crop(i_landusetype)) then + do hlm_pft = 1,fates_hlm_num_natpfts + do fates_pft = 1,numpft ! loop round all fates pfts for all hlm pfts + sites(s)%area_pft(fates_pft,i_landusetype) = sites(s)%area_pft(fates_pft,i_landusetype) + & + EDPftvarcon_inst%hlm_pft_map(fates_pft,hlm_pft) * bc_in(s)%pft_areafrac_lu(hlm_pft,i_landusetype) + end do + end do !hlm_pft + else + ! for crops, we need to use different logic because the bc_in(s)%pft_areafrac_lu() information only exists for natural PFTs + sites(s)%area_pft(crop_lu_pft_vector(i_landusetype),i_landusetype) = 1._r8 + endif + end do + + sites(s)%area_bareground = bc_in(s)%baregroundfrac * area + else + if ( all( isnan( bc_in(s)%pft_areafrac_lu (:,:) ))) then + ! if given all NaNs, then make everything bare ground + sites(s)%area_bareground = 1._r8 + sites(s)%area_pft(:,:) = 0._r8 else - ! for crops, we need to use different logic because the bc_in(s)%pft_areafrac_lu() information only exists for natural PFTs - sites(s)%area_pft(crop_lu_pft_vector(i_landusetype),i_landusetype) = 1._r8 + ! if only some things are NaN but not all, then something terrible has probably happened. crash. + write(fates_log(),*) 'some but, not all, of the data in the PFT by LU matrix at this site is NaN.' + write(fates_log(),*) 'recommend checking the dataset to see what has happened.' + call endrun(msg=errMsg(sourcefile, __LINE__)) endif - end do - - sites(s)%area_bareground = bc_in(s)%baregroundfrac * area + endif else ! MAPPING OF FATES PFTs on to HLM_PFTs From 110ef78c8c4c17ded8b065ec903d8ab7998074dc Mon Sep 17 00:00:00 2001 From: Charlie Koven Date: Thu, 12 Oct 2023 16:54:20 -0700 Subject: [PATCH 018/112] startign to add logic to handle PFT_level harvest parameters for both logging and land use change --- biogeochem/EDLoggingMortalityMod.F90 | 31 ++++++++++++++++++------ biogeochem/EDPatchDynamicsMod.F90 | 2 +- biogeochem/EDPhysiologyMod.F90 | 2 +- main/EDMainMod.F90 | 6 +++-- main/EDTypesMod.F90 | 8 ++++-- main/FatesHistoryInterfaceMod.F90 | 25 +++++++++++++------ main/FatesRestartInterfaceMod.F90 | 20 ++++++++++----- parameter_files/fates_params_default.cdl | 11 +++++---- 8 files changed, 73 insertions(+), 32 deletions(-) diff --git a/biogeochem/EDLoggingMortalityMod.F90 b/biogeochem/EDLoggingMortalityMod.F90 index 9c843cbf71..79a4085000 100644 --- a/biogeochem/EDLoggingMortalityMod.F90 +++ b/biogeochem/EDLoggingMortalityMod.F90 @@ -69,6 +69,7 @@ module EDLoggingMortalityMod use FatesConstantsMod , only : hlm_harvest_area_fraction use FatesConstantsMod , only : hlm_harvest_carbon use FatesConstantsMod, only : fates_check_param_set + use FatesInterfaceTypesMod , only : numpft implicit none private @@ -992,7 +993,7 @@ subroutine logging_litter_fluxes(currentSite, currentPatch, newPatch, patch_site ag_wood * logging_export_frac ! This is for checking the total mass balance [kg/site/day] - site_mass%wood_product = site_mass%wood_product + & + site_mass%wood_product_harvest(pft) = site_mass%wood_product_harvest(pft) + & ag_wood * logging_export_frac new_litt%ag_cwd(ncwd) = new_litt%ag_cwd(ncwd) + ag_wood * & @@ -1122,6 +1123,7 @@ subroutine UpdateHarvestC(currentSite,bc_out) type(bc_out_type), intent(inout) :: bc_out integer :: icode + integer :: i_pft real(r8) :: unit_trans_factor @@ -1132,13 +1134,26 @@ subroutine UpdateHarvestC(currentSite,bc_out) ! Calculate the unit transfer factor (from kgC m-2 day-1 to gC m-2 s-1) unit_trans_factor = g_per_kg * days_per_sec - bc_out%hrv_deadstemc_to_prod10c = bc_out%hrv_deadstemc_to_prod10c + & - currentSite%mass_balance(element_pos(carbon12_element))%wood_product * & - AREA_INV * pprodharv10_forest_mean * unit_trans_factor - bc_out%hrv_deadstemc_to_prod100c = bc_out%hrv_deadstemc_to_prod100c + & - currentSite%mass_balance(element_pos(carbon12_element))%wood_product * & - AREA_INV * (1._r8 - pprodharv10_forest_mean) * unit_trans_factor - + ! harvest-associated wood product pools + do i_pft = 1,numpft + bc_out%hrv_deadstemc_to_prod10c = bc_out%hrv_deadstemc_to_prod10c + & + currentSite%mass_balance(element_pos(carbon12_element))%wood_product_harvest(i_pft) * & + AREA_INV * harvest_pprod10(i_pft) * unit_trans_factor + bc_out%hrv_deadstemc_to_prod100c = bc_out%hrv_deadstemc_to_prod100c + & + currentSite%mass_balance(element_pos(carbon12_element))%wood_product_harvest(i_pft) * & + AREA_INV * (1._r8 - harvest_pprod10(i_pft)) * unit_trans_factor + end do + + ! land-use-change-associated wood product pools + do i_pft = 1,numpft + bc_out%hrv_deadstemc_to_prod10c = bc_out%hrv_deadstemc_to_prod10c + & + currentSite%mass_balance(element_pos(carbon12_element))%wood_product_landusechange(i_pft) * & + AREA_INV * landusechange_pprod10(i_pft) * unit_trans_factor + bc_out%hrv_deadstemc_to_prod100c = bc_out%hrv_deadstemc_to_prod100c + & + currentSite%mass_balance(element_pos(carbon12_element))%wood_product_landusechange(i_pft) * & + AREA_INV * (1._r8 - landusechange_pprod10(i_pft)) * unit_trans_factor + end do + return end subroutine UpdateHarvestC diff --git a/biogeochem/EDPatchDynamicsMod.F90 b/biogeochem/EDPatchDynamicsMod.F90 index 92d7853c97..75a95c9ceb 100644 --- a/biogeochem/EDPatchDynamicsMod.F90 +++ b/biogeochem/EDPatchDynamicsMod.F90 @@ -2633,7 +2633,7 @@ subroutine landusechange_litter_fluxes(currentSite, currentPatch, & trunk_product_site = trunk_product_site + & woodproduct_mass - site_mass%wood_product = site_mass%wood_product + & + site_mass%wood_product_landusechange(pft) = site_mass%wood_product_landusechange(pft) + & woodproduct_mass endif new_litt%ag_cwd(c) = new_litt%ag_cwd(c) + donatable_mass * donate_m2 diff --git a/biogeochem/EDPhysiologyMod.F90 b/biogeochem/EDPhysiologyMod.F90 index 7fe9c3bccd..8dc9510ee3 100644 --- a/biogeochem/EDPhysiologyMod.F90 +++ b/biogeochem/EDPhysiologyMod.F90 @@ -3022,7 +3022,7 @@ subroutine CWDInput( currentSite, currentPatch, litt, bc_in) SF_val_CWD_frac_adj(c) * dead_n_dlogging * & prt_params%allom_agb_frac(pft) - site_mass%wood_product = site_mass%wood_product + & + site_mass%wood_product_harvest(pft) = site_mass%wood_product_harvest(pft) + & trunk_wood * currentPatch%area * logging_export_frac ! Add AG wood to litter from the non-exported fraction of wood diff --git a/main/EDMainMod.F90 b/main/EDMainMod.F90 index fd2b7da13a..97b54c5dba 100644 --- a/main/EDMainMod.F90 +++ b/main/EDMainMod.F90 @@ -914,7 +914,8 @@ subroutine TotalBalanceCheck (currentSite, call_index ) site_mass%flux_generic_in + & site_mass%patch_resize_err - flux_out = site_mass%wood_product + & + flux_out = sum(site_mass%wood_product_harvest(:)) + & + sum(site_mass%wood_product_landusechange(:)) + & site_mass%burn_flux_to_atm + & site_mass%seed_out + & site_mass%flux_generic_out + & @@ -944,7 +945,8 @@ subroutine TotalBalanceCheck (currentSite, call_index ) write(fates_log(),*) 'net_root_uptake: ',site_mass%net_root_uptake write(fates_log(),*) 'gpp_acc: ',site_mass%gpp_acc write(fates_log(),*) 'flux_generic_in: ',site_mass%flux_generic_in - write(fates_log(),*) 'wood_product: ',site_mass%wood_product + write(fates_log(),*) 'wood_product_harvest: ',site_mass%wood_product_harvest(:) + write(fates_log(),*) 'wood_product_landusechange: ',site_mass%wood_product_landusechange(:) write(fates_log(),*) 'error from patch resizing: ',site_mass%patch_resize_err write(fates_log(),*) 'burn_flux_to_atm: ',site_mass%burn_flux_to_atm write(fates_log(),*) 'seed_out: ',site_mass%seed_out diff --git a/main/EDTypesMod.F90 b/main/EDTypesMod.F90 index bb02cf89d9..1617ee3b41 100644 --- a/main/EDTypesMod.F90 +++ b/main/EDTypesMod.F90 @@ -204,7 +204,10 @@ module EDTypesMod real(r8) :: frag_out ! Litter and coarse woody debris fragmentation flux [kg/site/day] - real(r8) :: wood_product ! Total mass exported as wood product [kg/site/day] + real(r8) :: wood_product_harvest(maxpft) ! Total mass exported as wood product from wood harvest [kg/site/day] + + real(r8) :: wood_product_landusechange(maxpft) ! Total mass exported as wood product from land use change [kg/site/day] + real(r8) :: burn_flux_to_atm ! Total mass burned and exported to the atmosphere [kg/site/day] real(r8) :: flux_generic_in ! Used for prescribed or artificial input fluxes @@ -471,7 +474,8 @@ subroutine ZeroMassBalFlux(this) this%seed_in = 0._r8 this%seed_out = 0._r8 this%frag_out = 0._r8 - this%wood_product = 0._r8 + this%wood_product_harvest(:) = 0._r8 + this%wood_product_landusechange(:) = 0._r8 this%burn_flux_to_atm = 0._r8 this%flux_generic_in = 0._r8 this%flux_generic_out = 0._r8 diff --git a/main/FatesHistoryInterfaceMod.F90 b/main/FatesHistoryInterfaceMod.F90 index 01566c9b4b..64982e3561 100644 --- a/main/FatesHistoryInterfaceMod.F90 +++ b/main/FatesHistoryInterfaceMod.F90 @@ -312,7 +312,8 @@ module FatesHistoryInterfaceMod integer :: ih_fire_disturbance_rate_si integer :: ih_logging_disturbance_rate_si integer :: ih_fall_disturbance_rate_si - integer :: ih_harvest_carbonflux_si + integer :: ih_harvest_woodproduct_carbonflux_si + integer :: ih_landusechange_woodproduct_carbonflux_si integer :: ih_harvest_debt_si integer :: ih_harvest_debt_sec_si @@ -2389,7 +2390,8 @@ subroutine update_history_dyn(this,nc,nsites,sites,bc_in) hio_fire_disturbance_rate_si => this%hvars(ih_fire_disturbance_rate_si)%r81d, & hio_logging_disturbance_rate_si => this%hvars(ih_logging_disturbance_rate_si)%r81d, & hio_fall_disturbance_rate_si => this%hvars(ih_fall_disturbance_rate_si)%r81d, & - hio_harvest_carbonflux_si => this%hvars(ih_harvest_carbonflux_si)%r81d, & + hio_harvest_woodproduct_carbonflux_si => this%hvars(ih_harvest_woodproduct_carbonflux_si)%r81d, & + hio_landusechange_woodproduct_carbonflux_si => this%hvars(ih_woodproduct_carbonflux_si)%r81d, & hio_harvest_debt_si => this%hvars(ih_harvest_debt_si)%r81d, & hio_harvest_debt_sec_si => this%hvars(ih_harvest_debt_sec_si)%r81d, & hio_gpp_si_scpf => this%hvars(ih_gpp_si_scpf)%r82d, & @@ -2759,8 +2761,10 @@ subroutine update_history_dyn(this,nc,nsites,sites,bc_in) hio_fall_disturbance_rate_si(io_si) = sum(sites(s)%disturbance_rates(dtype_ifall,1:n_landuse_cats,1:n_landuse_cats)) * & days_per_year - hio_harvest_carbonflux_si(io_si) = sites(s)%mass_balance(element_pos(carbon12_element))%wood_product * AREA_INV - + hio_harvest_woodproduct_carbonflux_si(io_si) = sum(sites(s)%mass_balance(element_pos(carbon12_element))%wood_product_harvest(1:numpft)) * AREA_INV + + hio_landusechange_woodproduct_carbonflux_si(io_si) = sum(sites(s)%mass_balance(element_pos(carbon12_element))%wood_product_landusechange(1:numpft)) * AREA_INV + ! Loop through patches to sum up diagonistics ipa = 0 cpatch => sites(s)%oldest_patch @@ -6444,12 +6448,19 @@ subroutine define_history_vars(this, initialize_variables) upfreq=1, ivar=ivar, initialize=initialize_variables, & index = ih_fall_disturbance_rate_si) - call this%set_history_var(vname='FATES_HARVEST_CARBON_FLUX', & + call this%set_history_var(vname='FATES_HARVEST_WOODPROD_C_FLUX', & + units='kg m-2 yr-1', & + long='harvest-associated wood product carbon flux in kg carbon per m2 per year', & + use_default='active', avgflag='A', vtype=site_r8, hlms='CLM:ALM', & + upfreq=1, ivar=ivar, initialize=initialize_variables, & + index = ih_harvest_woodproduct_carbonflux_si) + + call this%set_history_var(vname='FATES_LANDUSECHANGE_WOODPROD_C_FLUX', & units='kg m-2 yr-1', & - long='harvest carbon flux in kg carbon per m2 per year', & + long='land-use-change-associated wood product carbon flux in kg carbon per m2 per year', & use_default='active', avgflag='A', vtype=site_r8, hlms='CLM:ALM', & upfreq=1, ivar=ivar, initialize=initialize_variables, & - index = ih_harvest_carbonflux_si) + index = ih_landusechange_woodproduct_carbonflux_si) ! Canopy Resistance diff --git a/main/FatesRestartInterfaceMod.F90 b/main/FatesRestartInterfaceMod.F90 index 83d5ad114f..089534d347 100644 --- a/main/FatesRestartInterfaceMod.F90 +++ b/main/FatesRestartInterfaceMod.F90 @@ -262,7 +262,8 @@ module FatesRestartInterfaceMod integer :: ir_rootlittin_flxdg integer :: ir_oldstock_mbal integer :: ir_errfates_mbal - integer :: ir_woodprod_mbal + integer :: ir_woodprod_harvest_mbal + integer :: ir_woodprod_landusechange_mbal integer :: ir_prt_base ! Base index for all PRT variables ! Damage x damage or damage x size @@ -1124,10 +1125,15 @@ subroutine define_restart_vars(this, initialize_variables) end if - call this%RegisterCohortVector(symbol_base='fates_woodproduct', vtype=site_r8, & - long_name_base='Current wood product flux', & + call this%RegisterCohortVector(symbol_base='fates_woodproduct_harvest', vtype=cohort_r8, & + long_name_base='Current wood product flux from harvest', & units='kg/m2/day', veclength=num_elements, flushval = flushzero, & - hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_woodprod_mbal) + hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_woodprod_harvest_mbal) + + call this%RegisterCohortVector(symbol_base='fates_woodproduct_landusechange', vtype=cohort_r8, & + long_name_base='Current wood product flux from land use change', & + units='kg/m2/day', veclength=num_elements, flushval = flushzero, & + hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_woodprod_landusechange_mbal) ! Only register satellite phenology related restart variables if it is turned on! @@ -2225,12 +2231,13 @@ subroutine set_restart_vectors(this,nc,nsites,sites) do i_pft=1,numpft this%rvars(ir_leaflittin_flxdg+el-1)%r81d(io_idx_si_pft) = sites(s)%flux_diags(el)%leaf_litter_input(i_pft) this%rvars(ir_rootlittin_flxdg+el-1)%r81d(io_idx_si_pft) = sites(s)%flux_diags(el)%root_litter_input(i_pft) + this%rvars(ir_woodprod_harvest_mbal+el-1)%r81d(io_idx_si_pft) = sites(s)%mass_balance(el)%wood_product_harvest(i_pft) + this%rvars(ir_woodprod_landusechange_mbal+el-1)%r81d(io_idx_si_pft) = sites(s)%mass_balance(el)%wood_product_landusechange(i_pft) io_idx_si_pft = io_idx_si_pft + 1 end do this%rvars(ir_oldstock_mbal+el-1)%r81d(io_idx_si) = sites(s)%mass_balance(el)%old_stock this%rvars(ir_errfates_mbal+el-1)%r81d(io_idx_si) = sites(s)%mass_balance(el)%err_fates - this%rvars(ir_woodprod_mbal+el-1)%r81d(io_idx_si) = sites(s)%mass_balance(el)%wood_product end do end if @@ -3177,12 +3184,13 @@ subroutine get_restart_vectors(this, nc, nsites, sites) do i_pft=1,numpft sites(s)%flux_diags(el)%leaf_litter_input(i_pft) = this%rvars(ir_leaflittin_flxdg+el-1)%r81d(io_idx_si_pft) sites(s)%flux_diags(el)%root_litter_input(i_pft) = this%rvars(ir_rootlittin_flxdg+el-1)%r81d(io_idx_si_pft) + sites(s)%mass_balance(el)%wood_product_harvest(i_pft) = this%rvars(ir_woodprod_harvest_mbal+el-1)%r81d(io_idx_si_pft) + sites(s)%mass_balance(el)%wood_product_landusechange(i_pft) = this%rvars(ir_woodprod_landusechange_mbal+el-1)%r81d(io_idx_si_pft) io_idx_si_pft = io_idx_si_pft + 1 end do sites(s)%mass_balance(el)%old_stock = this%rvars(ir_oldstock_mbal+el-1)%r81d(io_idx_si) sites(s)%mass_balance(el)%err_fates = this%rvars(ir_errfates_mbal+el-1)%r81d(io_idx_si) - sites(s)%mass_balance(el)%wood_product = this%rvars(ir_woodprod_mbal+el-1)%r81d(io_idx_si) end do end if diff --git a/parameter_files/fates_params_default.cdl b/parameter_files/fates_params_default.cdl index 6742ffb9a3..1ad7488bf5 100644 --- a/parameter_files/fates_params_default.cdl +++ b/parameter_files/fates_params_default.cdl @@ -342,6 +342,12 @@ variables: double fates_hydro_vg_n_node(fates_hydr_organs, fates_pft) ; fates_hydro_vg_n_node:units = "unitless" ; fates_hydro_vg_n_node:long_name = "(used if hydr_htftype_node = 2),n in van Genuchten 1980 model, pore size distribution parameter" ; + double fates_landuse_harvest_pprod10(fates_pft) ; + fates_landuse_harvest_pprod10:units = "fraction" ; + fates_landuse_harvest_pprod10:long_name = "fraction of harvest wood product that goes to 10-year product pool (remainder goes to 100-year pool)" ; + double fates_landuse_landusechange_pprod10(fates_pft) ; + fates_landuse_landusechange_pprod10:units = "fraction" ; + fates_landuse_landusechange_pprod10:long_name = "fraction of land use change wood product that goes to 10-year product pool (remainder goes to 100-year pool)" ; double fates_leaf_c3psn(fates_pft) ; fates_leaf_c3psn:units = "flag" ; fates_leaf_c3psn:long_name = "Photosynthetic pathway (1=c3, 0=c4)" ; @@ -792,9 +798,6 @@ variables: double fates_landuse_logging_mechanical_frac ; fates_landuse_logging_mechanical_frac:units = "fraction" ; fates_landuse_logging_mechanical_frac:long_name = "Fraction of stems killed due infrastructure an other mechanical means" ; - double fates_landuse_pprodharv10_forest_mean ; - fates_landuse_pprodharv10_forest_mean:units = "fraction" ; - fates_landuse_pprodharv10_forest_mean:long_name = "mean harvest mortality proportion of deadstem to 10-yr product (pprodharv10) of all woody PFT types" ; double fates_leaf_photo_temp_acclim_thome_time ; fates_leaf_photo_temp_acclim_thome_time:units = "years" ; fates_leaf_photo_temp_acclim_thome_time:long_name = "Length of the window for the long-term (i.e. T_home in Kumarathunge et al 2019) exponential moving average (ema) of vegetation temperature used in photosynthesis temperature acclimation (used if fates_leaf_photo_tempsens_model = 2)" ; @@ -1680,8 +1683,6 @@ data: fates_landuse_logging_mechanical_frac = 0.05 ; - fates_landuse_pprodharv10_forest_mean = 0.8125 ; - fates_leaf_photo_temp_acclim_thome_time = 30 ; fates_leaf_photo_temp_acclim_timescale = 30 ; From 94ed7762e4f6fa4fed650c46a3e54f3e30d13b5f Mon Sep 17 00:00:00 2001 From: Charlie Koven Date: Fri, 13 Oct 2023 10:59:41 -0700 Subject: [PATCH 019/112] adding parameter values and passing to land use change and logging subroutines --- biogeochem/EDLoggingMortalityMod.F90 | 9 +++--- biogeochem/EDPatchDynamicsMod.F90 | 27 ++++++++-------- main/EDPftvarcon.F90 | 39 +++++++++++++++++++++++- parameter_files/fates_params_default.cdl | 17 +++++++++++ 4 files changed, 74 insertions(+), 18 deletions(-) diff --git a/biogeochem/EDLoggingMortalityMod.F90 b/biogeochem/EDLoggingMortalityMod.F90 index 79a4085000..c6e8ea92fb 100644 --- a/biogeochem/EDLoggingMortalityMod.F90 +++ b/biogeochem/EDLoggingMortalityMod.F90 @@ -1116,7 +1116,6 @@ subroutine UpdateHarvestC(currentSite,bc_out) use PRTGenericMod , only : element_pos use PRTGenericMod , only : carbon12_element use FatesInterfaceTypesMod , only : bc_out_type - use EDParamsMod , only : pprodharv10_forest_mean ! Arguments type(ed_site_type), intent(inout), target :: currentSite ! site structure @@ -1138,20 +1137,20 @@ subroutine UpdateHarvestC(currentSite,bc_out) do i_pft = 1,numpft bc_out%hrv_deadstemc_to_prod10c = bc_out%hrv_deadstemc_to_prod10c + & currentSite%mass_balance(element_pos(carbon12_element))%wood_product_harvest(i_pft) * & - AREA_INV * harvest_pprod10(i_pft) * unit_trans_factor + AREA_INV * EDPftvarcon_inst%harvest_pprod10(i_pft) * unit_trans_factor bc_out%hrv_deadstemc_to_prod100c = bc_out%hrv_deadstemc_to_prod100c + & currentSite%mass_balance(element_pos(carbon12_element))%wood_product_harvest(i_pft) * & - AREA_INV * (1._r8 - harvest_pprod10(i_pft)) * unit_trans_factor + AREA_INV * (1._r8 - EDPftvarcon_inst%harvest_pprod10(i_pft)) * unit_trans_factor end do ! land-use-change-associated wood product pools do i_pft = 1,numpft bc_out%hrv_deadstemc_to_prod10c = bc_out%hrv_deadstemc_to_prod10c + & currentSite%mass_balance(element_pos(carbon12_element))%wood_product_landusechange(i_pft) * & - AREA_INV * landusechange_pprod10(i_pft) * unit_trans_factor + AREA_INV * EDPftvarcon_inst%landusechange_pprod10(i_pft) * unit_trans_factor bc_out%hrv_deadstemc_to_prod100c = bc_out%hrv_deadstemc_to_prod100c + & currentSite%mass_balance(element_pos(carbon12_element))%wood_product_landusechange(i_pft) * & - AREA_INV * (1._r8 - landusechange_pprod10(i_pft)) * unit_trans_factor + AREA_INV * (1._r8 - EDPftvarcon_inst%landusechange_pprod10(i_pft)) * unit_trans_factor end do return diff --git a/biogeochem/EDPatchDynamicsMod.F90 b/biogeochem/EDPatchDynamicsMod.F90 index 75a95c9ceb..21770fb234 100644 --- a/biogeochem/EDPatchDynamicsMod.F90 +++ b/biogeochem/EDPatchDynamicsMod.F90 @@ -2458,10 +2458,6 @@ subroutine landusechange_litter_fluxes(currentSite, currentPatch, & ! (note we are accumulating over the patch, but scale is site level) real(r8) :: woodproduct_mass ! mass that ends up in wood products [kg] - ! the following two parameters are new to this logic. - real(r8), parameter :: burn_frac_landusetransition = 0.5_r8 ! what fraction of plant fines are burned during a land use transition? - real(r8), parameter :: woodproduct_frac_landusetransition = 0.5_r8 ! what fraction of trunk carbon is turned into wood products during a land use transition? - !--------------------------------------------------------------------- clear_veg_if: if (clearing_matrix_element) then @@ -2550,10 +2546,10 @@ subroutine landusechange_litter_fluxes(currentSite, currentPatch, & ! Contribution of dead trees to leaf litter donatable_mass = num_dead_trees * (leaf_m+repro_m) * & - (1.0_r8-burn_frac_landusetransition) + (1.0_r8-EDPftvarcon_inst%landusechange_frac_burned(pft)) ! Contribution of dead trees to leaf burn-flux - burned_mass = num_dead_trees * (leaf_m+repro_m) * burn_frac_landusetransition + burned_mass = num_dead_trees * (leaf_m+repro_m) * EDPftvarcon_inst%landusechange_frac_burned(pft) do dcmpy=1,ndcmpy dcmpy_frac = GetDecompyFrac(pft,leaf_organ,dcmpy) @@ -2583,7 +2579,7 @@ subroutine landusechange_litter_fluxes(currentSite, currentPatch, & ! Track as diagnostic fluxes flux_diags%leaf_litter_input(pft) = & flux_diags%leaf_litter_input(pft) + & - num_dead_trees * (leaf_m+repro_m) * (1.0_r8-burn_frac_landusetransition) + num_dead_trees * (leaf_m+repro_m) * (1.0_r8-EDPftvarcon_inst%landusechange_frac_burned(pft)) flux_diags%root_litter_input(pft) = & flux_diags%root_litter_input(pft) + & @@ -2619,16 +2615,23 @@ subroutine landusechange_litter_fluxes(currentSite, currentPatch, & do c = 1,ncwd donatable_mass = num_dead_trees * SF_val_CWD_frac(c) * bstem if (c == 1 .or. c == 2) then ! these pools can burn - donatable_mass = donatable_mass * (1.0_r8-burn_frac_landusetransition) + donatable_mass = donatable_mass * (1.0_r8-EDPftvarcon_inst%landusechange_frac_burned(pft)) burned_mass = num_dead_trees * SF_val_CWD_frac(c) * bstem * & - burn_frac_landusetransition + EDPftvarcon_inst%landusechange_frac_burned(pft) site_mass%burn_flux_to_atm = site_mass%burn_flux_to_atm + burned_mass - else ! all other pools can end up as timber products but not burn - donatable_mass = donatable_mass * (1.0_r8-woodproduct_frac_landusetransition) + else ! all other pools can end up as timber products or burn or go to litter + donatable_mass = donatable_mass * (1.0_r8-EDPftvarcon_inst%landusechange_frac_exported(pft)) * & + (1.0_r8-EDPftvarcon_inst%landusechange_frac_burned(pft)) + + burned_mass = num_dead_trees * SF_val_CWD_frac(c) * bstem * & + (1.0_r8-EDPftvarcon_inst%landusechange_frac_exported(pft)) * & + EDPftvarcon_inst%landusechange_frac_burned(pft) woodproduct_mass = num_dead_trees * SF_val_CWD_frac(c) * bstem * & - woodproduct_frac_landusetransition + EDPftvarcon_inst%landusechange_frac_exported(pft) + + site_mass%burn_flux_to_atm = site_mass%burn_flux_to_atm + burned_mass trunk_product_site = trunk_product_site + & woodproduct_mass diff --git a/main/EDPftvarcon.F90 b/main/EDPftvarcon.F90 index bdd670b671..3fb833060c 100644 --- a/main/EDPftvarcon.F90 +++ b/main/EDPftvarcon.F90 @@ -265,9 +265,14 @@ module EDPftvarcon 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) + ! The values are area fractions real(r8), allocatable :: hlm_pft_map(:,:) + ! Land-use and land-use change related PFT parameters + real(r8), allocatable :: harvest_pprod10(:) ! fraction of harvest wood product that goes to 10-year product pool (remainder goes to 100-year pool) + real(r8), allocatable :: landusechange_frac_burned(:) ! fraction of land use change-generated and not-exported material that is burned (the remainder goes to litter) + real(r8), allocatable :: landusechange_frac_exported(:) ! fraction of land use change-generated wood material that is exported to wood product (the remainder is either burned or goes to litter) + real(r8), allocatable :: landusechange_pprod10(:) ! fraction of land use change wood product that goes to 10-year product pool (remainder goes to 100-year pool) contains procedure, public :: Init => EDpftconInit @@ -760,6 +765,22 @@ 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_landuse_harvest_pprod10' + call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names, lower_bounds=dim_lower_bound) + + name = 'fates_landuse_landusechange_frac_burned' + call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names, lower_bounds=dim_lower_bound) + + name = 'fates_landuse_landusechange_frac_exported' + call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names, lower_bounds=dim_lower_bound) + + name = 'fates_landuse_landusechange_pprod10' + 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) @@ -1204,6 +1225,22 @@ subroutine Receive_PFT(this, fates_params) call fates_params%RetrieveParameterAllocate(name=name, & data=this%hlm_pft_map) + name = 'fates_landuse_harvest_pprod10' + call fates_params%RetrieveParameterAllocate(name=name, & + data=this%harvest_pprod10) + + name = 'fates_landuse_landusechange_frac_burned' + call fates_params%RetrieveParameterAllocate(name=name, & + data=this%landusechange_frac_burned) + + name = 'fates_landuse_landusechange_frac_exported' + call fates_params%RetrieveParameterAllocate(name=name, & + data=this%landusechange_frac_exported) + + name = 'fates_landuse_landusechange_pprod10' + call fates_params%RetrieveParameterAllocate(name=name, & + data=this%landusechange_pprod10) + end subroutine Receive_PFT !----------------------------------------------------------------------- diff --git a/parameter_files/fates_params_default.cdl b/parameter_files/fates_params_default.cdl index 1ad7488bf5..cc145f31c6 100644 --- a/parameter_files/fates_params_default.cdl +++ b/parameter_files/fates_params_default.cdl @@ -345,6 +345,12 @@ variables: double fates_landuse_harvest_pprod10(fates_pft) ; fates_landuse_harvest_pprod10:units = "fraction" ; fates_landuse_harvest_pprod10:long_name = "fraction of harvest wood product that goes to 10-year product pool (remainder goes to 100-year pool)" ; + double fates_landuse_landusechange_frac_burned(fates_pft) ; + fates_landuse_landusechange_frac_burned:units = "fraction" ; + fates_landuse_landusechange_frac_burned:long_name = "fraction of land use change-generated and not-exported material that is burned (the remainder goes to litter)" ; + double fates_landuse_landusechange_frac_exported(fates_pft) ; + fates_landuse_landusechange_frac_exported:units = "fraction" ; + fates_landuse_landusechange_frac_exported:long_name = "fraction of land use change-generated wood material that is exported to wood product (the remainder is either burned or goes to litter)" ; double fates_landuse_landusechange_pprod10(fates_pft) ; fates_landuse_landusechange_pprod10:units = "fraction" ; fates_landuse_landusechange_pprod10:long_name = "fraction of land use change wood product that goes to 10-year product pool (remainder goes to 100-year pool)" ; @@ -1272,6 +1278,17 @@ data: 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_landuse_harvest_pprod10 = 1, 0.75, 0.75, 0.75, 1, 0.75, 1, 1, 1, 1, 1, 1 ; + + fates_landuse_landusechange_frac_burned = 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_landuse_landusechange_frac_exported = 0.4, 0.4, 0.4, 0.4, 0.4, 0.4, + 0.2, 0.2, 0.2, 0, 0, 0 ; + + fates_landuse_landusechange_pprod10 = 1, 0.75, 0.75, 0.75, 1, 0.75, 1, 1, 1, + 1, 1, 1 ; + fates_leaf_c3psn = 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 0 ; fates_leaf_jmaxha = 43540, 43540, 43540, 43540, 43540, 43540, 43540, 43540, From c823fb6ad13c51da6c7b2dd5427a03a8088ff710 Mon Sep 17 00:00:00 2001 From: Charlie Koven Date: Fri, 13 Oct 2023 13:04:21 -0700 Subject: [PATCH 020/112] do nocomp PFT shuffle for newly secondary lands as well in case primary and secondary PFT maps differ --- biogeochem/EDPatchDynamicsMod.F90 | 13 +++++++++++++ 1 file changed, 13 insertions(+) diff --git a/biogeochem/EDPatchDynamicsMod.F90 b/biogeochem/EDPatchDynamicsMod.F90 index 21770fb234..0908b1944c 100644 --- a/biogeochem/EDPatchDynamicsMod.F90 +++ b/biogeochem/EDPatchDynamicsMod.F90 @@ -710,6 +710,11 @@ subroutine spawn_patches( currentSite, bc_in) case (dtype_ilog) call logging_litter_fluxes(currentSite, currentPatch, & newPatch, patch_site_areadis,bc_in) + + ! if transitioning from primary to secondary, then may need to change nocomp pft, so tag as having transitioned LU + if ( i_disturbance_type .eq. ilog .and. i_donorpatch_landuse_type .eq. primarylands) then + newPatch%changed_landuse_this_ts = .true. + end if case (dtype_ifire) call fire_litter_fluxes(currentSite, currentPatch, & newPatch, patch_site_areadis,bc_in) @@ -721,6 +726,7 @@ subroutine spawn_patches( currentSite, bc_in) newPatch, patch_site_areadis,bc_in, & clearing_matrix(i_donorpatch_landuse_type,i_landusechange_receiverpatchlabel)) + ! if land use change, then may need to change nocomp pft, so tag as having transitioned LU new_patch%changed_landuse_this_ts = .true. case default write(fates_log(),*) 'unknown disturbance mode?' @@ -1430,6 +1436,13 @@ subroutine spawn_patches( currentSite, bc_in) end if end do lu_loop + else + ! if not using a configuration where the changed_landuse_this_ts is relevant, loop through all patches and reset it + currentPatch => currentSite%oldest_patch + do while(associated(currentPatch)) + currentPatch%changed_landuse_this_ts = .false. + currentPatch => currentPatch%younger + end do endif nocomp_and_luh_if !zero disturbance rate trackers on all patches From 75df884de9bb96b7b1db5a77af61c7b7771064e1 Mon Sep 17 00:00:00 2001 From: Charles D Koven Date: Wed, 18 Oct 2023 12:42:05 -0700 Subject: [PATCH 021/112] various compile-time bugfixes --- biogeochem/EDLoggingMortalityMod.F90 | 6 +++-- biogeochem/EDPatchDynamicsMod.F90 | 39 ++++++++++++++-------------- biogeochem/FatesLandUseChangeMod.F90 | 7 ++--- main/EDInitMod.F90 | 3 ++- main/EDMainMod.F90 | 2 +- main/EDParamsMod.F90 | 7 +++-- main/FatesHistoryInterfaceMod.F90 | 2 +- main/FatesRestartInterfaceMod.F90 | 1 + 8 files changed, 37 insertions(+), 30 deletions(-) diff --git a/biogeochem/EDLoggingMortalityMod.F90 b/biogeochem/EDLoggingMortalityMod.F90 index c6e8ea92fb..9eb7fa615f 100644 --- a/biogeochem/EDLoggingMortalityMod.F90 +++ b/biogeochem/EDLoggingMortalityMod.F90 @@ -70,7 +70,8 @@ module EDLoggingMortalityMod use FatesConstantsMod , only : hlm_harvest_carbon use FatesConstantsMod, only : fates_check_param_set use FatesInterfaceTypesMod , only : numpft - + use FatesLandUseChangeMod, only : get_init_landuse_harvest_rate + implicit none private @@ -205,7 +206,8 @@ subroutine LoggingMortality_frac( currentSite, bc_in, pft_i, dbh, canopy_layer, harvest_tag) ! Arguments - type(ed_site_type), intent(in), target :: currentSite ! site structure + type(ed_site_type), intent(in), target :: currentSite ! site structure + type(bc_in_type), intent(in) :: bc_in integer, intent(in) :: pft_i ! pft index real(r8), intent(in) :: dbh ! diameter at breast height (cm) integer, intent(in) :: canopy_layer ! canopy layer of this cohort diff --git a/biogeochem/EDPatchDynamicsMod.F90 b/biogeochem/EDPatchDynamicsMod.F90 index 93efa77793..cf6713009c 100644 --- a/biogeochem/EDPatchDynamicsMod.F90 +++ b/biogeochem/EDPatchDynamicsMod.F90 @@ -72,6 +72,7 @@ module EDPatchDynamicsMod use EDLoggingMortalityMod, only : get_harvest_rate_carbon use EDLoggingMortalityMod, only : get_harvestable_carbon use EDLoggingMortalityMod, only : get_harvest_debt + use FatesLandUseChangeMod, only : get_init_landuse_harvest_rate use EDParamsMod , only : fates_mortality_disturbance_fraction use FatesAllometryMod , only : carea_allom use FatesAllometryMod , only : set_root_fraction @@ -83,6 +84,7 @@ module EDPatchDynamicsMod use FatesConstantsMod , only : primaryland, secondaryland, pastureland, rangeland, cropland use FatesConstantsMod , only : n_landuse_cats use FatesLandUseChangeMod, only : get_landuse_transition_rates + use FatesLandUseChangeMod, only : get_init_landuse_transition_rates use FatesConstantsMod , only : fates_unset_r8 use FatesConstantsMod , only : fates_unset_int use FatesConstantsMod , only : hlm_harvest_carbon @@ -498,7 +500,7 @@ subroutine spawn_patches( currentSite, bc_in) real(r8) :: disturbance_rate ! rate of disturbance being resolved [fraction of patch area / day] real(r8) :: oldarea ! old patch area prior to disturbance logical :: clearing_matrix(n_landuse_cats,n_landuse_cats) ! do we clear vegetation when transferring from one LU type to another? - type (ed_patch_type) , pointer :: buffer_patch, temp_patch + type (fates_patch_type) , pointer :: buffer_patch, temp_patch real(r8) :: nocomp_pft_area_vector(numpft) real(r8) :: nocomp_pft_area_vector_allocated(numpft) real(r8) :: fraction_to_keep @@ -712,7 +714,7 @@ subroutine spawn_patches( currentSite, bc_in) newPatch, patch_site_areadis,bc_in) ! if transitioning from primary to secondary, then may need to change nocomp pft, so tag as having transitioned LU - if ( i_disturbance_type .eq. ilog .and. i_donorpatch_landuse_type .eq. primarylands) then + if ( i_disturbance_type .eq. dtype_ilog .and. i_donorpatch_landuse_type .eq. primaryland) then newPatch%changed_landuse_this_ts = .true. end if case (dtype_ifire) @@ -727,7 +729,7 @@ subroutine spawn_patches( currentSite, bc_in) clearing_matrix(i_donorpatch_landuse_type,i_landusechange_receiverpatchlabel)) ! if land use change, then may need to change nocomp pft, so tag as having transitioned LU - new_patch%changed_landuse_this_ts = .true. + newPatch%changed_landuse_this_ts = .true. case default write(fates_log(),*) 'unknown disturbance mode?' write(fates_log(),*) 'i_disturbance_type: ',i_disturbance_type @@ -1222,7 +1224,7 @@ subroutine spawn_patches( currentSite, bc_in) newPatch%shortest => nc nc%shorter => null() endif - !nc%patchptr => new_patch + call insert_cohort(newPatch, nc, newPatch%tallest, newPatch%shortest, & tnull, snull, storebigcohort, storesmallcohort) @@ -1335,7 +1337,7 @@ subroutine spawn_patches( currentSite, bc_in) end do ! create buffer patch to put all of the pieces carved off of other patches - buffer_patch%Create(0._r8, 0._r8, i_land_use_label, 0, & + call buffer_patch%Create(0._r8, 0._r8, i_land_use_label, 0, & hlm_numSWb, numpft, currentSite%nlevsoil, hlm_current_tod, & regeneration_model) @@ -1463,27 +1465,24 @@ subroutine split_patch(currentSite, currentPatch, new_patch, fraction_to_keep) ! !DESCRIPTION: ! Split a patch into two patches that are identical except in their areas ! - ! !USES: - use EDCohortDynamicsMod , only : zero_cohort, copy_cohort - ! ! !ARGUMENTS: type(ed_site_type),intent(inout) :: currentSite - type(ed_patch_type) , intent(inout), target :: currentPatch ! Donor Patch - type(ed_patch_type) , intent(inout), target :: new_patch ! New Patch + type(fates_patch_type) , intent(inout), target :: currentPatch ! Donor Patch + type(fates_patch_type) , intent(inout), target :: new_patch ! New Patch real(r8), intent(in) :: fraction_to_keep ! fraction of currentPatch to keep, the rest goes to newpatch ! ! !LOCAL VARIABLES: integer :: el ! element loop index - type (ed_cohort_type), pointer :: nc - type (ed_cohort_type), pointer :: storesmallcohort - type (ed_cohort_type), pointer :: storebigcohort - type (ed_cohort_type), pointer :: currentCohort + type (fates_cohort_type), pointer :: nc + type (fates_cohort_type), pointer :: storesmallcohort + type (fates_cohort_type), pointer :: storebigcohort + type (fates_cohort_type), pointer :: currentCohort integer :: tnull ! is there a tallest cohort? integer :: snull ! is there a shortest cohort? ! first we need to make the new patch - new_patch%Create(0._r8, & + call new_patch%Create(0._r8, & currentPatch%area * (1._r8 - fraction_to_keep), currentPatch%land_use_label, currentPatch%nocomp_pft_label, & hlm_numSWb, numpft, currentSite%nlevsoil, hlm_current_tod, & regeneration_model) @@ -1533,11 +1532,11 @@ subroutine split_patch(currentSite, currentPatch, new_patch, fraction_to_keep) !allocate(nc%tveg_lpa) !call nc%tveg_lpa%InitRMean(ema_lpa,init_value=new_patch%tveg_lpa%GetMean()) - call zero_cohort(nc) + call nc%ZeroValues() ! nc is the new cohort that goes in the disturbed patch (new_patch)... currentCohort ! is the curent cohort that stays in the donor patch (currentPatch) - call copy_cohort(currentCohort, nc) + call currentCohort%Copy(nc) ! Number of members in the new patch nc%n = currentCohort%n * fraction_to_keep @@ -1562,8 +1561,8 @@ subroutine split_patch(currentSite, currentPatch, new_patch, fraction_to_keep) new_patch%shortest => nc nc%shorter => null() endif - nc%patchptr => new_patch - call insert_cohort(nc, new_patch%tallest, new_patch%shortest, & + + call insert_cohort(new_patch, nc, new_patch%tallest, new_patch%shortest, & tnull, snull, storebigcohort, storesmallcohort) new_patch%tallest => storebigcohort @@ -3595,7 +3594,7 @@ subroutine InsertPatch(currentSite, newPatch) ! In the case in which we get to the end of the list and haven't found ! a landuse label match. - ! If the new patch is primarylands add it to the oldest end of the list + ! If the new patch is primaryland add it to the oldest end of the list if (newPatch%land_use_label .eq. primaryland) then newPatch%older => null() newPatch%younger => currentSite%oldest_patch diff --git a/biogeochem/FatesLandUseChangeMod.F90 b/biogeochem/FatesLandUseChangeMod.F90 index 65451f8b6c..3331410b24 100644 --- a/biogeochem/FatesLandUseChangeMod.F90 +++ b/biogeochem/FatesLandUseChangeMod.F90 @@ -29,7 +29,8 @@ module FatesLandUseChangeMod public :: get_landuse_transition_rates public :: get_landusechange_rules public :: get_luh_statedata - + public :: get_init_landuse_transition_rates + public :: get_init_landuse_harvest_rate ! module data integer, parameter :: max_luh2_types_per_fates_lu_type = 5 @@ -323,7 +324,7 @@ subroutine get_init_landuse_harvest_rate(bc_in, harvest_rate) end subroutine get_init_landuse_harvest_rate - subroutine get_landuse_transition_rates(bc_in, landuse_transition_matrix) + subroutine get_init_landuse_transition_rates(bc_in, landuse_transition_matrix) ! The purose of this subroutine is, only under the case where we are transitioning from a spinup run that did not have land use ! to a run that does, to apply the land-use changes needed to get to the state vector in a single daily instance. this is for @@ -345,6 +346,6 @@ subroutine get_landuse_transition_rates(bc_in, landuse_transition_matrix) landuse_transition_matrix(1,i) = state_vector(i) end do - end subroutine get_landuse_transition_rates + end subroutine get_init_landuse_transition_rates end module FatesLandUseChangeMod diff --git a/main/EDInitMod.F90 b/main/EDInitMod.F90 index 78bfcd8875..7f49e1aa27 100644 --- a/main/EDInitMod.F90 +++ b/main/EDInitMod.F90 @@ -386,6 +386,7 @@ subroutine set_site_properties( nsites, sites,bc_in ) integer :: fates_pft ! used in fixed biogeog mode integer :: i_landusetype real(r8) :: temp_vec(numpft) ! temporary vector + integer :: i_pftcount !---------------------------------------------------------------------- @@ -528,7 +529,7 @@ subroutine set_site_properties( nsites, sites,bc_in ) if (hlm_use_nocomp .eq. itrue) then do i_landusetype = 1, n_landuse_cats ! count how many PFTs have areas greater than zero and compare to the number of patches allowed - if (COUNT(sites(s)%area_pft(ft, i_landusetype) .gt. 0._r8) > maxpatches_by_landuse(i_landusetype)) then + if (COUNT(sites(s)%area_pft(:, i_landusetype) .gt. 0._r8) > maxpatches_by_landuse(i_landusetype)) then ! write current vector to log file if(debug) write(fates_log(),*) 'too many PFTs for LU type ', i_landusetype, i_landusetype,sites(s)%area_pft(:, i_landusetype) diff --git a/main/EDMainMod.F90 b/main/EDMainMod.F90 index 97b54c5dba..745110ff9a 100644 --- a/main/EDMainMod.F90 +++ b/main/EDMainMod.F90 @@ -227,7 +227,7 @@ subroutine ed_ecosystem_dynamics(currentSite, bc_in, bc_out) ! at this point in the call sequence, if flag to transition_landuse_from_off_to_on was set, unset it as it is no longer needed if(currentSite%transition_landuse_from_off_to_on) then - currentSite%transition_landuse_from_off_to_on = .false + currentSite%transition_landuse_from_off_to_on = .false. endif else diff --git a/main/EDParamsMod.F90 b/main/EDParamsMod.F90 index 9d3391ada3..dbdf75dcbe 100644 --- a/main/EDParamsMod.F90 +++ b/main/EDParamsMod.F90 @@ -147,7 +147,6 @@ module EDParamsMod real(r8),protected,allocatable,public :: ED_val_history_height_bin_edges(:) real(r8),protected,allocatable,public :: ED_val_history_coageclass_bin_edges(:) real(r8),protected,allocatable,public :: ED_val_history_damage_bin_edges(:) - real(r8),protected,allocatable,public :: crop_lu_pft_vector(:) ! Switch that defines the current pressure-volume and pressure-conductivity model ! to be used at each node (compartment/organ) @@ -256,6 +255,9 @@ module EDParamsMod integer, public :: maxpatches_by_landuse(n_landuse_cats) integer, public :: maxpatch_total + ! which crops can be grown on a given crop land use type + real(r8),protected,public :: crop_lu_pft_vector(n_landuse_cats) + ! Maximum allowable cohorts per patch integer, protected, public :: max_cohort_per_patch character(len=param_string_length), parameter, public :: maxcohort_name = "fates_maxcohort" @@ -631,7 +633,7 @@ subroutine FatesReceiveParams(fates_params) real(r8) :: tmpreal ! local real variable for changing type on read real(r8), allocatable :: hydr_htftype_real(:) - real(r8) :: tmp_vector_by_landuse(n_landuse_cats) ! local real vector for changing type on read + real(r8), allocatable :: tmp_vector_by_landuse(:) ! local real vector for changing type on read call fates_params%RetrieveParameter(name=ED_name_photo_temp_acclim_timescale, & data=photo_temp_acclim_timescale) @@ -841,6 +843,7 @@ subroutine FatesReceiveParams(fates_params) data=tmp_vector_by_landuse) crop_lu_pft_vector(:) = nint(tmp_vector_by_landuse(:)) + deallocate(tmp_vector_by_landuse) call fates_params%RetrieveParameter(name=ED_name_maxpatches_by_landuse, & data=tmp_vector_by_landuse) diff --git a/main/FatesHistoryInterfaceMod.F90 b/main/FatesHistoryInterfaceMod.F90 index 60bcabc7be..f600a6f977 100644 --- a/main/FatesHistoryInterfaceMod.F90 +++ b/main/FatesHistoryInterfaceMod.F90 @@ -2391,7 +2391,7 @@ subroutine update_history_dyn(this,nc,nsites,sites,bc_in) hio_logging_disturbance_rate_si => this%hvars(ih_logging_disturbance_rate_si)%r81d, & hio_fall_disturbance_rate_si => this%hvars(ih_fall_disturbance_rate_si)%r81d, & hio_harvest_woodproduct_carbonflux_si => this%hvars(ih_harvest_woodproduct_carbonflux_si)%r81d, & - hio_landusechange_woodproduct_carbonflux_si => this%hvars(ih_woodproduct_carbonflux_si)%r81d, & + hio_landusechange_woodproduct_carbonflux_si => this%hvars(ih_landusechange_woodproduct_carbonflux_si)%r81d, & hio_harvest_debt_si => this%hvars(ih_harvest_debt_si)%r81d, & hio_harvest_debt_sec_si => this%hvars(ih_harvest_debt_sec_si)%r81d, & hio_gpp_si_scpf => this%hvars(ih_gpp_si_scpf)%r82d, & diff --git a/main/FatesRestartInterfaceMod.F90 b/main/FatesRestartInterfaceMod.F90 index 089534d347..741425caf6 100644 --- a/main/FatesRestartInterfaceMod.F90 +++ b/main/FatesRestartInterfaceMod.F90 @@ -2104,6 +2104,7 @@ subroutine set_restart_vectors(this,nc,nsites,sites) rio_abg_fmort_flux_siscpf => this%rvars(ir_abg_fmort_flux_siscpf)%r81d, & rio_abg_term_flux_siscpf => this%rvars(ir_abg_term_flux_siscpf)%r81d, & rio_disturbance_rates_siluludi => this%rvars(ir_disturbance_rates_siluludi)%r81d, & + rio_landuse_config_si => this%rvars(ir_landuse_config_si)%int1d, & rio_imortrate_sicdpf => this%rvars(ir_imortrate_sicdpf)%r81d, & rio_imortcflux_sicdsc => this%rvars(ir_imortcflux_sicdsc)%r81d, & From b2e427d63c6795b739e4765a2b46fc34195a7a6a Mon Sep 17 00:00:00 2001 From: Charles D Koven Date: Wed, 18 Oct 2023 16:50:32 -0700 Subject: [PATCH 022/112] more compile-time bugfixes --- biogeochem/EDPatchDynamicsMod.F90 | 4 ++-- main/EDInitMod.F90 | 4 +++- 2 files changed, 5 insertions(+), 3 deletions(-) diff --git a/biogeochem/EDPatchDynamicsMod.F90 b/biogeochem/EDPatchDynamicsMod.F90 index cf6713009c..79620c170f 100644 --- a/biogeochem/EDPatchDynamicsMod.F90 +++ b/biogeochem/EDPatchDynamicsMod.F90 @@ -1425,7 +1425,7 @@ subroutine spawn_patches( currentSite, bc_in) buffer_patch => null() else if (buffer_patch%area .lt. fates_tiny) then ! here we need to deallocate the buffer patch so that we don't get a memory leak/ - call dealloc_patch(buffer_patch) + call buffer_patch%FreeMemory(regeneration_model, numpft) deallocate(buffer_patch, stat=istat, errmsg=smsg) if (istat/=0) then write(fates_log(),*) 'dealloc: fail on deallocate(dp):'//trim(smsg) @@ -1525,7 +1525,7 @@ subroutine split_patch(currentSite, currentPatch, new_patch, fraction_to_keep) ! correct boundary condition fields nc%prt => null() call InitPRTObject(nc%prt) - call InitPRTBoundaryConditions(nc) + call nc%InitPRTBoundaryConditions() ! (Keeping as an example) ! Allocate running mean functions diff --git a/main/EDInitMod.F90 b/main/EDInitMod.F90 index 7f49e1aa27..2cb6b77d12 100644 --- a/main/EDInitMod.F90 +++ b/main/EDInitMod.F90 @@ -712,7 +712,9 @@ subroutine init_patches( nsites, sites, bc_in) allocate(newp) - call create_patch(sites(s), newp, age, newparea, nocomp_bareground_land, nocomp_bareground) + call newp%Create(age, newparea, nocomp_bareground_land, nocomp_bareground, & + hlm_numSWb, numpft, sites(s)%nlevsoil, hlm_current_tod, & + regeneration_model) ! set poointers for first patch (or only patch, if nocomp is false) newp%patchno = 1 From a967b7f83217d64c628b54e1e64e23c58ec2b5a7 Mon Sep 17 00:00:00 2001 From: Charles D Koven Date: Thu, 19 Oct 2023 20:31:53 -0700 Subject: [PATCH 023/112] various runtime-failure fixes and attempted fixes --- biogeochem/EDLoggingMortalityMod.F90 | 18 +++--- biogeochem/EDMortalityFunctionsMod.F90 | 5 +- biogeochem/EDPatchDynamicsMod.F90 | 39 ++++++++++-- biogeochem/FatesLandUseChangeMod.F90 | 2 +- main/EDInitMod.F90 | 78 ++++++++++++++---------- main/EDMainMod.F90 | 5 +- main/EDParamsMod.F90 | 29 +++------ main/EDPftvarcon.F90 | 12 ++-- main/FatesConstantsMod.F90 | 3 + parameter_files/fates_params_default.cdl | 33 +++++----- 10 files changed, 132 insertions(+), 92 deletions(-) diff --git a/biogeochem/EDLoggingMortalityMod.F90 b/biogeochem/EDLoggingMortalityMod.F90 index 9eb7fa615f..8f7359a7cb 100644 --- a/biogeochem/EDLoggingMortalityMod.F90 +++ b/biogeochem/EDLoggingMortalityMod.F90 @@ -202,7 +202,7 @@ subroutine LoggingMortality_frac( currentSite, bc_in, pft_i, dbh, canopy_layer, hlm_harvest_rates, hlm_harvest_catnames, & hlm_harvest_units, & patch_land_use_label, secondary_age, & - frac_site_primary, harvestable_forest_c, & + frac_site_primary, frac_site_secondary, harvestable_forest_c, & harvest_tag) ! Arguments @@ -219,6 +219,7 @@ subroutine LoggingMortality_frac( currentSite, bc_in, pft_i, dbh, canopy_layer, real(r8), intent(in) :: harvestable_forest_c(:) ! total harvestable forest carbon ! of all hlm harvest categories real(r8), intent(in) :: frac_site_primary + real(r8), intent(in) :: frac_site_secondary real(r8), intent(out) :: lmort_direct ! direct (harvestable) mortality fraction real(r8), intent(out) :: lmort_collateral ! collateral damage mortality fraction real(r8), intent(out) :: lmort_infra ! infrastructure mortality fraction @@ -271,7 +272,7 @@ subroutine LoggingMortality_frac( currentSite, bc_in, pft_i, dbh, canopy_layer, ! Get the area-based harvest rates based on info passed to FATES from the boundary condition call get_harvest_rate_area (patch_land_use_label, hlm_harvest_catnames, & - hlm_harvest_rates, frac_site_primary, secondary_age, harvest_rate) + hlm_harvest_rates, frac_site_primary, frac_site_secondary, secondary_age, harvest_rate) ! For area-based harvest, harvest_tag shall always be 2 (not applicable). harvest_tag = 2 @@ -361,7 +362,7 @@ end subroutine LoggingMortality_frac ! ============================================================================ subroutine get_harvest_rate_area (patch_land_use_label, hlm_harvest_catnames, hlm_harvest_rates, & - frac_site_primary, secondary_age, harvest_rate) + frac_site_primary, frac_site_secondary, secondary_age, harvest_rate) ! ------------------------------------------------------------------------------------------- @@ -376,6 +377,7 @@ subroutine get_harvest_rate_area (patch_land_use_label, hlm_harvest_catnames, hl integer, intent(in) :: patch_land_use_label ! patch level land_use_label real(r8), intent(in) :: secondary_age ! patch level age_since_anthro_disturbance real(r8), intent(in) :: frac_site_primary + real(r8), intent(in) :: frac_site_secondary real(r8), intent(out) :: harvest_rate ! Local Variables @@ -414,13 +416,15 @@ subroutine get_harvest_rate_area (patch_land_use_label, hlm_harvest_catnames, hl else harvest_rate = 0._r8 endif - else - if ((1._r8-frac_site_primary) .gt. fates_tiny) then - harvest_rate = min((harvest_rate / (1._r8-frac_site_primary)),& - (1._r8-frac_site_primary)) + else if (patch_land_use_label .eq. secondaryland) then + if (frac_site_secondary .gt. fates_tiny) then + harvest_rate = min((harvest_rate / frac_site_secondary), frac_site_secondary) else harvest_rate = 0._r8 endif + else + write(fates_log(),*) 'errror - trying to log from patches that are neither primary nor secondary' + call endrun(msg=errMsg(sourcefile, __LINE__)) endif ! calculate today's harvest rate diff --git a/biogeochem/EDMortalityFunctionsMod.F90 b/biogeochem/EDMortalityFunctionsMod.F90 index 5136af67f0..71cccb03ad 100644 --- a/biogeochem/EDMortalityFunctionsMod.F90 +++ b/biogeochem/EDMortalityFunctionsMod.F90 @@ -233,7 +233,7 @@ end subroutine mortality_rates subroutine Mortality_Derivative( currentSite, currentCohort, bc_in, btran_ft, & mean_temp, land_use_label, age_since_anthro_disturbance, & - frac_site_primary, harvestable_forest_c, harvest_tag) + frac_site_primary, frac_site_secondary, harvestable_forest_c, harvest_tag) ! ! !DESCRIPTION: @@ -253,6 +253,7 @@ subroutine Mortality_Derivative( currentSite, currentCohort, bc_in, btran_ft, & integer, intent(in) :: land_use_label real(r8), intent(in) :: age_since_anthro_disturbance real(r8), intent(in) :: frac_site_primary + real(r8), intent(in) :: frac_site_secondary real(r8), intent(in) :: harvestable_forest_c(:) ! total carbon available for logging, kgC site-1 integer, intent(out) :: harvest_tag(:) ! tag to record the harvest status @@ -291,7 +292,7 @@ subroutine Mortality_Derivative( currentSite, currentCohort, bc_in, btran_ft, & bc_in%hlm_harvest_units, & land_use_label, & age_since_anthro_disturbance, & - frac_site_primary, harvestable_forest_c, harvest_tag) + frac_site_primary, frac_site_secondary, harvestable_forest_c, harvest_tag) if (currentCohort%canopy_layer > 1)then ! Include understory logging mortality rates not associated with disturbance diff --git a/biogeochem/EDPatchDynamicsMod.F90 b/biogeochem/EDPatchDynamicsMod.F90 index 79620c170f..3a9aa44aad 100644 --- a/biogeochem/EDPatchDynamicsMod.F90 +++ b/biogeochem/EDPatchDynamicsMod.F90 @@ -43,6 +43,7 @@ module EDPatchDynamicsMod use FatesLitterMod , only : dl_sf use FatesConstantsMod , only : N_DIST_TYPES use EDTypesMod , only : AREA_INV + use EDTypesMod , only : dump_site use FatesConstantsMod , only : rsnbl_math_prec use FatesConstantsMod , only : fates_tiny use FatesConstantsMod , only : nocomp_bareground @@ -207,6 +208,7 @@ subroutine disturbance_rates( site_in, bc_in) integer :: i_dist integer :: h_index real(r8) :: frac_site_primary + real(r8) :: frac_site_secondary real(r8) :: harvest_rate real(r8) :: tempsum real(r8) :: mean_temp @@ -220,7 +222,7 @@ subroutine disturbance_rates( site_in, bc_in) !---------------------------------------------------------------------------------------------- ! first calculate the fraction of the site that is primary land - call get_frac_site_primary(site_in, frac_site_primary) + call get_frac_site_primary(site_in, frac_site_primary, frac_site_secondary) ! check status of transition_landuse_from_off_to_on flag, and do some error checking on it if(site_in%transition_landuse_from_off_to_on) then @@ -265,6 +267,7 @@ subroutine disturbance_rates( site_in, bc_in) currentPatch%land_use_label, & currentPatch%age_since_anthro_disturbance, & frac_site_primary, & + frac_site_secondary, & harvestable_forest_c, & harvest_tag) @@ -383,7 +386,8 @@ subroutine disturbance_rates( site_in, bc_in) harvest_rate, harvest_tag) else call get_harvest_rate_area (currentPatch%land_use_label, bc_in%hlm_harvest_catnames, & - bc_in%hlm_harvest_rates, frac_site_primary, currentPatch%age_since_anthro_disturbance, harvest_rate) + bc_in%hlm_harvest_rates, frac_site_primary, frac_site_secondary, & + currentPatch%age_since_anthro_disturbance, harvest_rate) end if else call get_init_landuse_harvest_rate(bc_in, harvest_rate) @@ -1337,6 +1341,8 @@ subroutine spawn_patches( currentSite, bc_in) end do ! create buffer patch to put all of the pieces carved off of other patches + allocate(buffer_patch) + call buffer_patch%Create(0._r8, 0._r8, i_land_use_label, 0, & hlm_numSWb, numpft, currentSite%nlevsoil, hlm_current_tod, & regeneration_model) @@ -1367,6 +1373,8 @@ subroutine spawn_patches( currentSite, bc_in) elseif (fraction_to_keep .lt. (1._r8 - nearzero)) then ! we have more patch are of this PFT than we want, but we do want to keep some of it. ! we want to split the patch into two here. leave one patch as-is, and put the rest into the buffer patch. + + allocate(temp_patch) call split_patch(currentSite, currentPatch, temp_patch, fraction_to_keep) ! temp_patch%nocomp_pft_label = 0 @@ -1391,6 +1399,7 @@ subroutine spawn_patches( currentSite, bc_in) if (newp_area .lt. buffer_patch%area) then ! split buffer patch in two, keeping the smaller buffer patch to put into new patches + allocate(temp_patch) call split_patch(currentSite, buffer_patch, temp_patch, newp_area/buffer_patch%area) ! give the new patch the intended nocomp PFT label @@ -3217,7 +3226,7 @@ subroutine terminate_patches(currentSite) if ( .not. gotfused ) then !! somehow didn't find a patch to fuse with. write(fates_log(),*) 'Warning. small nocomp patch wasnt able to find another patch to fuse with.', & - currentPatch%nocomp_pft_label, currentPatch%land_use_label + currentPatch%nocomp_pft_label, currentPatch%land_use_label, currentPatch%area endif else nocomp_if @@ -3326,7 +3335,15 @@ subroutine terminate_patches(currentSite) write(fates_log(),*) 'is very very small. You can test your luck by' write(fates_log(),*) 'disabling the endrun statement following this message.' write(fates_log(),*) 'FATES may or may not continue to operate within error' - write(fates_log(),*) 'tolerances, but will generate another fail if it does not.' + write(fates_log(),*) 'tolerances, but will generate another fail if it does not.' + write(fates_log(),*) 'otherwise, dumping some diagnostics.' + write(fates_log(),*) currentPatch%area, currentPatch%nocomp_pft_label, currentPatch%land_use_label + call dump_site(currentSite) + patchpointer => currentSite%youngest_patch + do while(associated(patchpointer)) + write(fates_log(),*) patchpointer%area, patchpointer%nocomp_pft_label, patchpointer%land_use_label + patchpointer => patchpointer%older + end do call endrun(msg=errMsg(sourcefile, __LINE__)) ! Note to user. If you DO decide to remove the end-run above this line @@ -3464,11 +3481,11 @@ end function countPatches ! ===================================================================================== - subroutine get_frac_site_primary(site_in, frac_site_primary) + subroutine get_frac_site_primary(site_in, frac_site_primary, frac_site_secondary) ! ! !DESCRIPTION: - ! Calculate how much of a site is primary land + ! Calculate how much of a site is primary land and secondary land ! ! !USES: use EDTypesMod , only : ed_site_type @@ -3476,6 +3493,7 @@ subroutine get_frac_site_primary(site_in, frac_site_primary) ! !ARGUMENTS: type(ed_site_type) , intent(in), target :: site_in real(r8) , intent(out) :: frac_site_primary + real(r8) , intent(out) :: frac_site_secondary ! !LOCAL VARIABLES: type (fates_patch_type), pointer :: currentPatch @@ -3489,6 +3507,15 @@ subroutine get_frac_site_primary(site_in, frac_site_primary) currentPatch => currentPatch%younger end do + frac_site_secondary = 0._r8 + currentPatch => site_in%oldest_patch + do while (associated(currentPatch)) + if (currentPatch%land_use_label .eq. secondaryland) then + frac_site_secondary = frac_site_secondary + currentPatch%area * AREA_INV + endif + currentPatch => currentPatch%younger + end do + end subroutine get_frac_site_primary ! ===================================================================================== diff --git a/biogeochem/FatesLandUseChangeMod.F90 b/biogeochem/FatesLandUseChangeMod.F90 index 3331410b24..b3d6522940 100644 --- a/biogeochem/FatesLandUseChangeMod.F90 +++ b/biogeochem/FatesLandUseChangeMod.F90 @@ -263,7 +263,7 @@ subroutine get_luh_statedata(bc_in, state_vector) ! check to ensure total area == 1, and correct if not if ( abs(sum(state_vector(:)) - 1._r8) .gt. nearzero ) then write(fates_log(),*) 'warning: sum(state_vector) = ', sum(state_vector(:)) - state_vector = state_vector / sum(state_vector) + state_vector = state_vector(:) / sum(state_vector(:)) end if end subroutine get_luh_statedata diff --git a/main/EDInitMod.F90 b/main/EDInitMod.F90 index 2cb6b77d12..567a6c1bfe 100644 --- a/main/EDInitMod.F90 +++ b/main/EDInitMod.F90 @@ -10,6 +10,8 @@ module EDInitMod use FatesConstantsMod , only : fates_unset_int use FatesConstantsMod , only : primaryland use FatesConstantsMod , only : nearzero + use FatesConstantsMod , only : rsnbl_math_prec + use FatesConstantsMod , only : min_init_patch_size use FatesConstantsMod , only : n_landuse_cats use FatesConstantsMod , only : is_crop use FatesConstantsMod , only : fates_unset_r8 @@ -100,7 +102,7 @@ module EDInitMod implicit none private - logical :: debug = .false. + logical :: debug = .true. integer :: istat ! return status code character(len=255) :: smsg ! Message string for deallocation errors @@ -475,12 +477,13 @@ subroutine set_site_properties( nsites, sites,bc_in ) endif end do - sites(s)%area_bareground = bc_in(s)%baregroundfrac * area + sites(s)%area_bareground = bc_in(s)%baregroundfrac else if ( all( isnan( bc_in(s)%pft_areafrac_lu (:,:) ))) then ! if given all NaNs, then make everything bare ground sites(s)%area_bareground = 1._r8 sites(s)%area_pft(:,:) = 0._r8 + sites(s)%area_pft(1,:) = 1._r8 else ! if only some things are NaN but not all, then something terrible has probably happened. crash. write(fates_log(),*) 'some but, not all, of the data in the PFT by LU matrix at this site is NaN.' @@ -617,13 +620,13 @@ subroutine init_patches( nsites, sites, bc_in) real(r8) :: seed_stock integer :: n integer :: start_patch - integer :: num_new_patches + integer :: num_nocomp_pfts integer :: nocomp_pft real(r8) :: newparea, newparea_withlanduse real(r8) :: total !check on area real(r8) :: litt_init !invalid for satphen, 0 otherwise real(r8) :: old_carea - integer :: is_first_patch + logical :: is_first_patch ! integer :: n_luh_states ! integer :: luh_state_counter real(r8) :: state_vector(n_landuse_cats) ! [m2/m2] @@ -682,9 +685,9 @@ subroutine init_patches( nsites, sites, bc_in) sites(s)%spread = init_spread_near_bare_ground if(hlm_use_nocomp.eq.itrue)then - num_new_patches = numpft + num_nocomp_pfts = numpft else !default - num_new_patches = 1 + num_nocomp_pfts = 1 end if !nocomp ! read in luh state data to determine initial land use types @@ -704,10 +707,20 @@ subroutine init_patches( nsites, sites, bc_in) state_vector(primaryland) = 1._r8 endif - is_first_patch = itrue + ! confirm that state vector sums to 1. + if (abs(sum(state_vector(:))-1._r8) .gt. rsnbl_math_prec) then + write(fates_log(),*) 'error that the state vector must sum to 1, but doesnt' + write(fates_log(),*) 'sum(state_vector)', sum(state_vector) + write(fates_log(),*) state_vector + call endrun(msg=errMsg(sourcefile, __LINE__)) + endif + + is_first_patch = .true. ! first make a bare-ground patch if one is needed. - make_bareground_patch_if: if (hlm_use_nocomp.eq.itrue .and. hlm_use_fixed_biogeog .eq.itrue .and. sites(s)%area_bareground .gt. 0._r8) then + make_bareground_patch_if: if (hlm_use_nocomp.eq.itrue .and. hlm_use_fixed_biogeog .eq.itrue .and. & + (area*sites(s)%area_bareground) .gt. min_init_patch_size) then + newparea = area * sites(s)%area_bareground allocate(newp) @@ -722,7 +735,7 @@ subroutine init_patches( nsites, sites, bc_in) newp%older => null() sites(s)%youngest_patch => newp sites(s)%oldest_patch => newp - is_first_patch = ifalse + is_first_patch = .false. ! Initialize the litter pools to zero, these ! pools will be populated by looping over the existing patches @@ -744,9 +757,9 @@ subroutine init_patches( nsites, sites, bc_in) endif ! now make one or more vegetated patches based on nocomp and land use logic - new_patch_nocomp_loop: do n = 1, num_new_patches - luh_state_loop: do i_lu_state = 1, end_landuse_idx - lu_state_present_if: if (state_vector(i_lu_state) .gt. nearzero) then + luh_state_loop: do i_lu_state = 1, end_landuse_idx + lu_state_present_if: if (state_vector(i_lu_state) .gt. rsnbl_math_prec) then + new_patch_nocomp_loop: do n = 1, num_nocomp_pfts ! set the PFT index for patches if in nocomp mode. if(hlm_use_nocomp.eq.itrue)then nocomp_pft = n @@ -762,32 +775,32 @@ subroutine init_patches( nsites, sites, bc_in) ! i.e. each grid cell is divided exactly into the number of FATES PFTs. if(hlm_use_fixed_biogeog.eq.itrue)then - newparea = sites(s)%area_pft(nocomp_pft,i_lu_state) * area / state_vector(i_lu_state) + newparea = sites(s)%area_pft(nocomp_pft,i_lu_state) * area * state_vector(i_lu_state) & + * (1._r8 - sites(s)%area_bareground) else - newparea = area / ( numpft * state_vector(i_lu_state)) + newparea = area * state_vector(i_lu_state) / numpft end if else ! The default case is initialized w/ one patch with the area of the whole site. - newparea = area / state_vector(i_lu_state) + newparea = area * state_vector(i_lu_state) end if !nocomp mode - ! for now, spread nocomp PFTs evenly across land use types - new_patch_area_gt_zero: if(newparea.gt.0._r8)then ! Stop patches being initilialized when PFT not present in nocomop mode + new_patch_area_gt_zero: if(newparea .gt. min_init_patch_size) then ! Stop patches being initilialized when PFT not present in nocomop mode allocate(newp) call newp%Create(age, newparea, i_lu_state, nocomp_pft, & hlm_numSWb, numpft, sites(s)%nlevsoil, hlm_current_tod, & regeneration_model) - if(is_first_patch.eq.itrue)then !is this the first patch? + if (is_first_patch) then !is this the first patch? ! set poointers for first patch (or only patch, if nocomp is false) newp%patchno = 1 newp%younger => null() newp%older => null() sites(s)%youngest_patch => newp sites(s)%oldest_patch => newp - is_first_patch = ifalse + is_first_patch = .false. else - ! Set pointers for N>1 patches. Note this only happens when nocomp mode s on. + ! Set pointers for N>1 patches. Note this only happens when nocomp mode is on, or land use is on. ! The new patch is the 'youngest' one, arbitrarily. newp%patchno = nocomp_pft + (i_lu_state-1) * numpft newp%older => sites(s)%youngest_patch @@ -817,9 +830,9 @@ subroutine init_patches( nsites, sites, bc_in) call init_cohorts(sitep, newp, bc_in(s)) end if new_patch_area_gt_zero - end if lu_state_present_if - end do luh_state_loop - end do new_patch_nocomp_loop !no new patches + end do new_patch_nocomp_loop + end if lu_state_present_if + end do luh_state_loop !check if the total area adds to the same as site area total = 0.0_r8 @@ -832,22 +845,21 @@ subroutine init_patches( nsites, sites, bc_in) area_diff = total - area if (abs(area_diff) > nearzero) then if (abs(area_diff) < area_error_4) then ! this is a precision error - if (sites(s)%oldest_patch%area > area_diff + nearzero) then - ! remove or add extra area - ! if the oldest patch has enough area, use that - sites(s)%oldest_patch%area = sites(s)%oldest_patch%area - area_diff - if (debug) write(fates_log(),*) 'fixing patch precision - oldest', s, area_diff - else ! or otherwise take the area from the youngest patch. - sites(s)%youngest_patch%area = sites(s)%youngest_patch%area - area_diff - if (debug) write(fates_log(),*) 'fixing patch precision -youngest ', s, area_diff - end if + + ! adjust areas of all patches so that they add up to total area + newp => sites(s)%oldest_patch + do while (associated(newp)) + newp%area = newp%area * (area / total) + newp => newp%younger + end do + else !this is a big error not just a precision error. write(fates_log(),*) 'issue with patch area in EDinit', area_diff, total call endrun(msg=errMsg(sourcefile, __LINE__)) end if ! big error end if ! too much patch area - ! we might have messed up patch area now - need to correct if SP mode + ! we might have messed up crown areas now - need to correct if SP mode if (hlm_use_sp .eq. itrue) then newp => sites(s)%oldest_patch do while (associated(newp)) diff --git a/main/EDMainMod.F90 b/main/EDMainMod.F90 index 745110ff9a..324cac5bd5 100644 --- a/main/EDMainMod.F90 +++ b/main/EDMainMod.F90 @@ -376,6 +376,7 @@ subroutine ed_integrate_state_variables(currentSite, bc_in, bc_out ) ! because it inherited them (such as daily carbon balance) real(r8) :: target_leaf_c real(r8) :: frac_site_primary + real(r8) :: frac_site_secondary real(r8) :: harvestable_forest_c(hlm_num_lu_harvest_cats) integer :: harvest_tag(hlm_num_lu_harvest_cats) @@ -411,7 +412,7 @@ subroutine ed_integrate_state_variables(currentSite, bc_in, bc_out ) !----------------------------------------------------------------------- - call get_frac_site_primary(currentSite, frac_site_primary) + call get_frac_site_primary(currentSite, frac_site_primary, frac_site_secondary) ! Clear site GPP and AR passing to HLM bc_out%gpp_site = 0._r8 @@ -477,7 +478,7 @@ subroutine ed_integrate_state_variables(currentSite, bc_in, bc_out ) currentPatch%btran_ft, mean_temp, & currentPatch%land_use_label, & currentPatch%age_since_anthro_disturbance, frac_site_primary, & - harvestable_forest_c, harvest_tag) + frac_site_secondary, harvestable_forest_c, harvest_tag) ! ----------------------------------------------------------------------------- ! Apply Plant Allocation and Reactive Transport diff --git a/main/EDParamsMod.F90 b/main/EDParamsMod.F90 index dbdf75dcbe..415059681e 100644 --- a/main/EDParamsMod.F90 +++ b/main/EDParamsMod.F90 @@ -299,10 +299,6 @@ module EDParamsMod ! leftovers will be left onsite as large CWD character(len=param_string_length),parameter,public :: logging_name_export_frac ="fates_landuse_logging_export_frac" - real(r8),protected,public :: pprodharv10_forest_mean ! "mean harvest mortality proportion of deadstem to 10-yr - ! product pool (pprodharv10) of all woody PFT types - character(len=param_string_length),parameter,public :: logging_name_pprodharv10="fates_landuse_pprodharv10_forest_mean" - real(r8),protected,public :: eca_plant_escalar ! scaling factor for plant fine root biomass to ! calculate nutrient carrier enzyme abundance (ECA) @@ -376,7 +372,6 @@ subroutine FatesParamsInit() logging_event_code = nan logging_dbhmax_infra = nan logging_export_frac = nan - pprodharv10_forest_mean = nan eca_plant_escalar = nan q10_mr = nan q10_froz = nan @@ -565,9 +560,6 @@ subroutine FatesRegisterParams(fates_params) call fates_params%RegisterParameter(name=logging_name_export_frac, dimension_shape=dimension_shape_scalar, & dimension_names=dim_names_scalar) - call fates_params%RegisterParameter(name=logging_name_pprodharv10, dimension_shape=dimension_shape_scalar, & - dimension_names=dim_names_scalar) - call fates_params%RegisterParameter(name=eca_name_plant_escalar, dimension_shape=dimension_shape_scalar, & dimension_names=dim_names_scalar) @@ -633,8 +625,9 @@ subroutine FatesReceiveParams(fates_params) real(r8) :: tmpreal ! local real variable for changing type on read real(r8), allocatable :: hydr_htftype_real(:) - real(r8), allocatable :: tmp_vector_by_landuse(:) ! local real vector for changing type on read - + real(r8), allocatable :: tmp_vector_by_landuse1(:) ! local real vector for changing type on read + real(r8), allocatable :: tmp_vector_by_landuse2(:) ! local real vector for changing type on read + call fates_params%RetrieveParameter(name=ED_name_photo_temp_acclim_timescale, & data=photo_temp_acclim_timescale) @@ -787,9 +780,6 @@ subroutine FatesReceiveParams(fates_params) call fates_params%RetrieveParameter(name=logging_name_export_frac, & data=logging_export_frac) - call fates_params%RetrieveParameter(name=logging_name_pprodharv10, & - data=pprodharv10_forest_mean) - call fates_params%RetrieveParameter(name=eca_name_plant_escalar, & data=eca_plant_escalar) @@ -840,16 +830,17 @@ subroutine FatesReceiveParams(fates_params) data=ED_val_history_damage_bin_edges) call fates_params%RetrieveParameterAllocate(name=ED_name_crop_lu_pft_vector, & - data=tmp_vector_by_landuse) + data=tmp_vector_by_landuse1) - crop_lu_pft_vector(:) = nint(tmp_vector_by_landuse(:)) - deallocate(tmp_vector_by_landuse) + crop_lu_pft_vector(:) = nint(tmp_vector_by_landuse1(:)) + deallocate(tmp_vector_by_landuse1) - call fates_params%RetrieveParameter(name=ED_name_maxpatches_by_landuse, & - data=tmp_vector_by_landuse) + call fates_params%RetrieveParameterAllocate(name=ED_name_maxpatches_by_landuse, & + data=tmp_vector_by_landuse2) - maxpatches_by_landuse(:) = nint(tmp_vector_by_landuse(:)) + maxpatches_by_landuse(:) = nint(tmp_vector_by_landuse2(:)) maxpatch_total = sum(maxpatches_by_landuse(:)) + deallocate(tmp_vector_by_landuse2) call fates_params%RetrieveParameterAllocate(name=ED_name_hydr_htftype_node, & data=hydr_htftype_real) diff --git a/main/EDPftvarcon.F90 b/main/EDPftvarcon.F90 index 3fb833060c..26d1e03d6b 100644 --- a/main/EDPftvarcon.F90 +++ b/main/EDPftvarcon.F90 @@ -769,15 +769,15 @@ 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_landuse_landusechange_frac_burned' + name = 'fates_landuse_luc_frac_burned' call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & dimension_names=dim_names, lower_bounds=dim_lower_bound) - name = 'fates_landuse_landusechange_frac_exported' + name = 'fates_landuse_luc_frac_exported' call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & dimension_names=dim_names, lower_bounds=dim_lower_bound) - name = 'fates_landuse_landusechange_pprod10' + name = 'fates_landuse_luc_pprod10' call fates_params%RegisterParameter(name=name, dimension_shape=dimension_shape_1d, & dimension_names=dim_names, lower_bounds=dim_lower_bound) @@ -1229,15 +1229,15 @@ subroutine Receive_PFT(this, fates_params) call fates_params%RetrieveParameterAllocate(name=name, & data=this%harvest_pprod10) - name = 'fates_landuse_landusechange_frac_burned' + name = 'fates_landuse_luc_frac_burned' call fates_params%RetrieveParameterAllocate(name=name, & data=this%landusechange_frac_burned) - name = 'fates_landuse_landusechange_frac_exported' + name = 'fates_landuse_luc_frac_exported' call fates_params%RetrieveParameterAllocate(name=name, & data=this%landusechange_frac_exported) - name = 'fates_landuse_landusechange_pprod10' + name = 'fates_landuse_luc_pprod10' call fates_params%RetrieveParameterAllocate(name=name, & data=this%landusechange_pprod10) diff --git a/main/FatesConstantsMod.F90 b/main/FatesConstantsMod.F90 index 8aeb51ffb9..c0790da103 100644 --- a/main/FatesConstantsMod.F90 +++ b/main/FatesConstantsMod.F90 @@ -178,6 +178,9 @@ module FatesConstantsMod ! precisions are preventing perfect zero in comparison real(fates_r8), parameter, public :: nearzero = 1.0e-30_fates_r8 + ! minimum init patch size for initialization in nocomp and/or land-use cases + real(fates_r8), parameter, public :: min_init_patch_size = 1.0e-2_fates_r8 + ! Unit conversion constants: ! Conversion factor umols of Carbon -> kg of Carbon (1 mol = 12g) diff --git a/parameter_files/fates_params_default.cdl b/parameter_files/fates_params_default.cdl index cc145f31c6..48b46660c5 100644 --- a/parameter_files/fates_params_default.cdl +++ b/parameter_files/fates_params_default.cdl @@ -345,15 +345,15 @@ variables: double fates_landuse_harvest_pprod10(fates_pft) ; fates_landuse_harvest_pprod10:units = "fraction" ; fates_landuse_harvest_pprod10:long_name = "fraction of harvest wood product that goes to 10-year product pool (remainder goes to 100-year pool)" ; - double fates_landuse_landusechange_frac_burned(fates_pft) ; - fates_landuse_landusechange_frac_burned:units = "fraction" ; - fates_landuse_landusechange_frac_burned:long_name = "fraction of land use change-generated and not-exported material that is burned (the remainder goes to litter)" ; - double fates_landuse_landusechange_frac_exported(fates_pft) ; - fates_landuse_landusechange_frac_exported:units = "fraction" ; - fates_landuse_landusechange_frac_exported:long_name = "fraction of land use change-generated wood material that is exported to wood product (the remainder is either burned or goes to litter)" ; - double fates_landuse_landusechange_pprod10(fates_pft) ; - fates_landuse_landusechange_pprod10:units = "fraction" ; - fates_landuse_landusechange_pprod10:long_name = "fraction of land use change wood product that goes to 10-year product pool (remainder goes to 100-year pool)" ; + double fates_landuse_luc_frac_burned(fates_pft) ; + fates_landuse_luc_frac_burned:units = "fraction" ; + fates_landuse_luc_frac_burned:long_name = "fraction of land use change-generated and not-exported material that is burned (the remainder goes to litter)" ; + double fates_landuse_luc_frac_exported(fates_pft) ; + fates_landuse_luc_frac_exported:units = "fraction" ; + fates_landuse_luc_frac_exported:long_name = "fraction of land use change-generated wood material that is exported to wood product (the remainder is either burned or goes to litter)" ; + double fates_landuse_luc_pprod10(fates_pft) ; + fates_landuse_luc_pprod10:units = "fraction" ; + fates_landuse_luc_pprod10:long_name = "fraction of land use change wood product that goes to 10-year product pool (remainder goes to 100-year pool)" ; double fates_leaf_c3psn(fates_pft) ; fates_leaf_c3psn:units = "flag" ; fates_leaf_c3psn:long_name = "Photosynthetic pathway (1=c3, 0=c4)" ; @@ -899,7 +899,9 @@ variables: fates_vai_width_increase_factor:long_name = "factor by which each leaf+stem scattering element increases in VAI width (1 = uniform spacing)" ; // global attributes: - :history = "This file was generated by BatchPatchParams.py:\nCDL Base File = archive/api24.1.0_101722_fates_params_default.cdl\nXML patch file = archive/api24.1.0_101722_patch_params.xml" ; + :history = "This file was generated by BatchPatchParams.py:\n", + "CDL Base File = archive/api24.1.0_101722_fates_params_default.cdl\n", + "XML patch file = archive/api24.1.0_101722_patch_params.xml" ; data: fates_history_ageclass_bin_edges = 0, 1, 2, 5, 10, 20, 50 ; @@ -1280,14 +1282,13 @@ data: fates_landuse_harvest_pprod10 = 1, 0.75, 0.75, 0.75, 1, 0.75, 1, 1, 1, 1, 1, 1 ; - fates_landuse_landusechange_frac_burned = 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_landuse_luc_frac_burned = 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_landuse_landusechange_frac_exported = 0.4, 0.4, 0.4, 0.4, 0.4, 0.4, - 0.2, 0.2, 0.2, 0, 0, 0 ; + fates_landuse_luc_frac_exported = 0.4, 0.4, 0.4, 0.4, 0.4, 0.4, 0.2, 0.2, + 0.2, 0, 0, 0 ; - fates_landuse_landusechange_pprod10 = 1, 0.75, 0.75, 0.75, 1, 0.75, 1, 1, 1, - 1, 1, 1 ; + fates_landuse_luc_pprod10 = 1, 0.75, 0.75, 0.75, 1, 0.75, 1, 1, 1, 1, 1, 1 ; fates_leaf_c3psn = 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 0 ; From e1813e89c6f4b113052698346f3133e2cdca70aa Mon Sep 17 00:00:00 2001 From: Charles D Koven Date: Fri, 20 Oct 2023 12:35:01 -0700 Subject: [PATCH 024/112] more runtime bugfixes --- biogeochem/EDPatchDynamicsMod.F90 | 37 +++++++++++++++++++++---------- biogeochem/EDPhysiologyMod.F90 | 15 ++++++++----- main/EDInitMod.F90 | 3 +++ main/FatesConstantsMod.F90 | 3 ++- main/FatesHistoryInterfaceMod.F90 | 8 ++++--- main/FatesInterfaceMod.F90 | 3 ++- 6 files changed, 46 insertions(+), 23 deletions(-) diff --git a/biogeochem/EDPatchDynamicsMod.F90 b/biogeochem/EDPatchDynamicsMod.F90 index 3a9aa44aad..906c4c08e0 100644 --- a/biogeochem/EDPatchDynamicsMod.F90 +++ b/biogeochem/EDPatchDynamicsMod.F90 @@ -83,6 +83,7 @@ module EDPatchDynamicsMod use FatesConstantsMod , only : years_per_day use FatesConstantsMod , only : nearzero use FatesConstantsMod , only : primaryland, secondaryland, pastureland, rangeland, cropland + use FatesConstantsMod , only : nocomp_bareground_land use FatesConstantsMod , only : n_landuse_cats use FatesLandUseChangeMod, only : get_landuse_transition_rates use FatesLandUseChangeMod, only : get_init_landuse_transition_rates @@ -298,9 +299,11 @@ subroutine disturbance_rates( site_in, bc_in) current_fates_landuse_state_vector(:) = 0._r8 currentPatch => site_in%oldest_patch do while (associated(currentPatch)) - current_fates_landuse_state_vector(currentPatch%land_use_label) = & - current_fates_landuse_state_vector(currentPatch%land_use_label) + & - currentPatch%area/AREA + if (currentPatch%land_use_label .gt. nocomp_bareground_land) then + current_fates_landuse_state_vector(currentPatch%land_use_label) = & + current_fates_landuse_state_vector(currentPatch%land_use_label) + & + currentPatch%area/AREA + end if currentPatch => currentPatch%younger end do @@ -331,8 +334,8 @@ subroutine disturbance_rates( site_in, bc_in) dist_rate_ldist_notharvested = 0.0_r8 - ! Avoid this calculation to avoid NaN due to division by zero result if luh is not used - if (hlm_use_luh .eq. itrue) then + ! Avoid this calculation to avoid NaN due to division by zero result if luh is not used or applying to bare ground + if (hlm_use_luh .eq. itrue .and. currentPatch%land_use_label .gt. nocomp_bareground_land) then currentPatch%landuse_transition_rates(1:n_landuse_cats) = min(1._r8, & landuse_transition_matrix(currentPatch%land_use_label,1:n_landuse_cats) / & current_fates_landuse_state_vector(currentPatch%land_use_label)) @@ -2712,6 +2715,7 @@ subroutine fuse_patches( csite, bc_in ) integer :: i_pftlabel !nocomp pft iterator real(r8) :: primary_land_fraction_beforefusion,primary_land_fraction_afterfusion integer :: pftlabelmin, pftlabelmax + integer :: num_bareground_patches ! !--------------------------------------------------------------------- @@ -2723,20 +2727,29 @@ subroutine fuse_patches( csite, bc_in ) primary_land_fraction_afterfusion = 0._r8 nopatches(1:n_landuse_cats) = 0 - + num_bareground_patches = 0 + currentPatch => currentSite%youngest_patch do while(associated(currentPatch)) - nopatches(currentPatch%land_use_label) = & - nopatches(currentPatch%land_use_label) + 1 + if ( currentPatch%land_use_label .gt. nocomp_bareground_land) then + nopatches(currentPatch%land_use_label) = & + nopatches(currentPatch%land_use_label) + 1 - if (currentPatch%land_use_label .eq. primaryland) then - primary_land_fraction_beforefusion = primary_land_fraction_beforefusion + & - currentPatch%area * AREA_INV + if (currentPatch%land_use_label .eq. primaryland) then + primary_land_fraction_beforefusion = primary_land_fraction_beforefusion + & + currentPatch%area * AREA_INV + endif + else + num_bareground_patches = num_bareground_patches + 1 endif - currentPatch => currentPatch%older enddo + if (num_bareground_patches .gt. 1 ) then + write(fates_log(),*) 'somehow there is more than one bare ground patch. this shouldnt have happened.' + call endrun(msg=errMsg(sourcefile, __LINE__)) + endif + pftlabelmin = 0 if ( hlm_use_nocomp .eq. itrue ) then pftlabelmax = numpft diff --git a/biogeochem/EDPhysiologyMod.F90 b/biogeochem/EDPhysiologyMod.F90 index 8dc9510ee3..26d6687f67 100644 --- a/biogeochem/EDPhysiologyMod.F90 +++ b/biogeochem/EDPhysiologyMod.F90 @@ -35,6 +35,7 @@ module EDPhysiologyMod use FatesConstantsMod, only : g_per_kg use FatesConstantsMod, only : ndays_per_year use FatesConstantsMod, only : nocomp_bareground + use FatesConstantsMod, only : nocomp_bareground_land use FatesConstantsMod, only : is_crop use FatesConstantsMod, only : area_error_2 use EDPftvarcon , only : EDPftvarcon_inst @@ -2497,13 +2498,15 @@ subroutine recruitment(currentSite, currentPatch, bc_in) use_this_pft = .true. end if - if ((hlm_use_luh .eq. itrue) .and. (is_crop(currentPatch%land_use_label))) then - if ( crop_lu_pft_vector(currentPatch%land_use_label) .eq. ft ) then - use_this_pft = .true. - else - use_this_pft = .false. + if ( currentPatch%land_use_label .ne. nocomp_bareground_land ) then ! cdk + if ((hlm_use_luh .eq. itrue) .and. (is_crop(currentPatch%land_use_label))) then + if ( crop_lu_pft_vector(currentPatch%land_use_label) .eq. ft ) then + use_this_pft = .true. + else + use_this_pft = .false. + end if end if - end if + endif use_this_pft_if: if(use_this_pft) then hite = EDPftvarcon_inst%hgt_min(ft) diff --git a/main/EDInitMod.F90 b/main/EDInitMod.F90 index 567a6c1bfe..8f0978e1f7 100644 --- a/main/EDInitMod.F90 +++ b/main/EDInitMod.F90 @@ -94,6 +94,7 @@ module EDInitMod use DamageMainMod, only : undamaged_class use FatesInterfaceTypesMod , only : hlm_num_luh2_transitions use FatesConstantsMod, only : nocomp_bareground_land, nocomp_bareground + use EdtTypesMod, only : dump_site ! CIME GLOBALS use shr_log_mod , only : errMsg => shr_log_errMsg @@ -484,6 +485,8 @@ subroutine set_site_properties( nsites, sites,bc_in ) sites(s)%area_bareground = 1._r8 sites(s)%area_pft(:,:) = 0._r8 sites(s)%area_pft(1,:) = 1._r8 + write(fates_log(),*) 'Nan values for pftareafrac. dumping site info.' + call dump_site(currentSite) else ! if only some things are NaN but not all, then something terrible has probably happened. crash. write(fates_log(),*) 'some but, not all, of the data in the PFT by LU matrix at this site is NaN.' diff --git a/main/FatesConstantsMod.F90 b/main/FatesConstantsMod.F90 index c0790da103..3fa91d8847 100644 --- a/main/FatesConstantsMod.F90 +++ b/main/FatesConstantsMod.F90 @@ -54,7 +54,8 @@ module FatesConstantsMod integer, parameter, public :: rangeland = 3 integer, parameter, public :: pastureland = 4 integer, parameter, public :: cropland = 5 - logical, parameter, dimension(0:n_landuse_cats), public :: is_crop = [.false., .false.,.false.,.false.,.false.,.true.] + logical, parameter, dimension(n_landuse_cats), public :: is_crop = [.false., .false.,.false.,.false.,.true.] + integer, parameter, public :: n_crop_lu_types = 1 ! Bareground nocomp land use label integer, parameter, public :: nocomp_bareground_land = 0 ! not a real land use type, only for labeling any bare-ground nocomp patches diff --git a/main/FatesHistoryInterfaceMod.F90 b/main/FatesHistoryInterfaceMod.F90 index f600a6f977..0679e216e2 100644 --- a/main/FatesHistoryInterfaceMod.F90 +++ b/main/FatesHistoryInterfaceMod.F90 @@ -84,7 +84,7 @@ module FatesHistoryInterfaceMod use FatesConstantsMod , only : grav_earth use FatesLitterMod , only : litter_type use FatesConstantsMod , only : secondaryland - + use FatesConstantsMod , only : nocomp_bareground_land use PRTGenericMod , only : leaf_organ, fnrt_organ, sapw_organ use PRTGenericMod , only : struct_organ, store_organ, repro_organ use PRTGenericMod , only : carbon12_element @@ -2782,8 +2782,10 @@ subroutine update_history_dyn(this,nc,nsites,sites,bc_in) hio_area_si_age(io_si,cpatch%age_class) = hio_area_si_age(io_si,cpatch%age_class) & + cpatch%area * AREA_INV - hio_area_si_landuse(io_si, cpatch%land_use_label) = hio_area_si_landuse(io_si, cpatch%land_use_label)& - + cpatch%area * AREA_INV + if (cpatch%land_use_label .gt. nocomp_bareground_land) then ! ignore land use info on nocomp bareground (where landuse label = 0) + hio_area_si_landuse(io_si, cpatch%land_use_label) = hio_area_si_landuse(io_si, cpatch%land_use_label)& + + cpatch%area * AREA_INV + end if ! 24hr veg temperature hio_tveg24(io_si) = hio_tveg24(io_si) + & diff --git a/main/FatesInterfaceMod.F90 b/main/FatesInterfaceMod.F90 index be57bcbf41..6959ccde23 100644 --- a/main/FatesInterfaceMod.F90 +++ b/main/FatesInterfaceMod.F90 @@ -43,6 +43,7 @@ module FatesInterfaceMod use FatesConstantsMod , only : n_landuse_cats use FatesConstantsMod , only : primaryland use FatesConstantsMod , only : secondaryland + use FatesConstantsMod , only : n_crop_lu_types use FatesGlobals , only : fates_global_verbose use FatesGlobals , only : fates_log use FatesGlobals , only : endrun => fates_endrun @@ -557,7 +558,7 @@ subroutine allocate_bcin(bc_in, nlevsoil_in, nlevdecomp_in, num_lu_harvest_cats, if ( hlm_use_fixed_biogeog .eq. itrue) then if (hlm_use_luh .gt. 0 ) then - allocate(bc_in%pft_areafrac_lu(fates_hlm_num_natpfts,num_luh2_states)) + allocate(bc_in%pft_areafrac_lu(fates_hlm_num_natpfts,num_luh2_states-n_crop_lu_types)) else allocate(bc_in%pft_areafrac(surfpft_lb:surfpft_ub)) endif From 7d5ce7ee559686ed7576d63a48ed189de274138c Mon Sep 17 00:00:00 2001 From: Charles D Koven Date: Fri, 20 Oct 2023 18:42:03 -0700 Subject: [PATCH 025/112] tiny bugfixes --- main/EDInitMod.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/main/EDInitMod.F90 b/main/EDInitMod.F90 index 8f0978e1f7..1ea223f9b4 100644 --- a/main/EDInitMod.F90 +++ b/main/EDInitMod.F90 @@ -94,7 +94,7 @@ module EDInitMod use DamageMainMod, only : undamaged_class use FatesInterfaceTypesMod , only : hlm_num_luh2_transitions use FatesConstantsMod, only : nocomp_bareground_land, nocomp_bareground - use EdtTypesMod, only : dump_site + use EdTypesMod, only : dump_site ! CIME GLOBALS use shr_log_mod , only : errMsg => shr_log_errMsg @@ -486,7 +486,7 @@ subroutine set_site_properties( nsites, sites,bc_in ) sites(s)%area_pft(:,:) = 0._r8 sites(s)%area_pft(1,:) = 1._r8 write(fates_log(),*) 'Nan values for pftareafrac. dumping site info.' - call dump_site(currentSite) + call dump_site(sites(s)) else ! if only some things are NaN but not all, then something terrible has probably happened. crash. write(fates_log(),*) 'some but, not all, of the data in the PFT by LU matrix at this site is NaN.' From 7d632a09f37a9941d0c8c5a0e4446ad572307668 Mon Sep 17 00:00:00 2001 From: Charles D Koven Date: Fri, 27 Oct 2023 16:19:00 -0700 Subject: [PATCH 026/112] various bugfixes and the diagnostics used to identify them --- biogeochem/EDLoggingMortalityMod.F90 | 10 + biogeochem/EDPatchDynamicsMod.F90 | 191 ++++++++++--------- biogeochem/FatesLandUseChangeMod.F90 | 6 + main/EDInitMod.F90 | 270 +++++++++++++++------------ main/EDMainMod.F90 | 1 + main/FatesConstantsMod.F90 | 2 +- main/FatesInterfaceMod.F90 | 8 +- main/FatesInterfaceTypesMod.F90 | 3 - 8 files changed, 267 insertions(+), 224 deletions(-) diff --git a/biogeochem/EDLoggingMortalityMod.F90 b/biogeochem/EDLoggingMortalityMod.F90 index 8f7359a7cb..d956a9b141 100644 --- a/biogeochem/EDLoggingMortalityMod.F90 +++ b/biogeochem/EDLoggingMortalityMod.F90 @@ -445,6 +445,11 @@ subroutine get_harvest_rate_area (patch_land_use_label, hlm_harvest_catnames, hl end if end if + ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + ! !!CDKCDK WARNING WARNING WARNING THIS NEEDS TO BE REVERTED. IT TURNS OFF LOGGING ENTIRELY. + harvest_rate = 0._r8 + ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + end subroutine get_harvest_rate_area @@ -693,6 +698,11 @@ subroutine get_harvest_rate_carbon (patch_land_use_label, hlm_harvest_catnames, end if end if + ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + ! !!CDKCDK WARNING WARNING WARNING THIS NEEDS TO BE REVERTED. IT TURNS OFF LOGGING ENTIRELY. + harvest_rate = 0._r8 + ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + end subroutine get_harvest_rate_carbon ! ============================================================================ diff --git a/biogeochem/EDPatchDynamicsMod.F90 b/biogeochem/EDPatchDynamicsMod.F90 index 906c4c08e0..1b387b0af4 100644 --- a/biogeochem/EDPatchDynamicsMod.F90 +++ b/biogeochem/EDPatchDynamicsMod.F90 @@ -1324,7 +1324,7 @@ subroutine spawn_patches( currentSite, bc_in) nocomp_and_luh_if: if ( hlm_use_nocomp .eq. itrue .and. hlm_use_luh .eq. itrue ) then - ! disturbance has just hapopened, and now the nocomp PFT identities of the newly-disturbed patches + ! disturbance has just happened, and now the nocomp PFT identities of the newly-disturbed patches ! need to be remapped to those associated with the new land use type. ! logic: loop over land use types. figure out the nocomp PFT fractions for all newly-disturbed patches that have become that land use type. @@ -1337,118 +1337,119 @@ subroutine spawn_patches( currentSite, bc_in) currentPatch => currentSite%oldest_patch do while(associated(currentPatch)) - if (currentPatch%changed_landuse_this_ts) then + if (currentPatch%changed_landuse_this_ts .and. currentPatch%land_use_label .eq. i_land_use_label) then nocomp_pft_area_vector(currentPatch%nocomp_pft_label) = nocomp_pft_area_vector(currentPatch%nocomp_pft_label) + currentPatch%area end if currentPatch => currentPatch%younger end do - ! create buffer patch to put all of the pieces carved off of other patches - allocate(buffer_patch) - - call buffer_patch%Create(0._r8, 0._r8, i_land_use_label, 0, & - hlm_numSWb, numpft, currentSite%nlevsoil, hlm_current_tod, & - regeneration_model) - - ! make a note that this buffer patch has not been put into the linked list - buffer_patch_in_linked_list = .false. - - ! Initialize the litter pools to zero - do el=1,num_elements - call buffer_patch%litter(el)%InitConditions(init_leaf_fines=0._r8, & - init_root_fines=0._r8, & - init_ag_cwd=0._r8, & - init_bg_cwd=0._r8, & - init_seed=0._r8, & - init_seed_germ=0._r8) - end do - buffer_patch%tallest => null() - buffer_patch%shortest => null() + patch_area_to_reallocate_if: if ( sum(nocomp_pft_area_vector(:)) .gt. nearzero ) then + ! create buffer patch to put all of the pieces carved off of other patches + allocate(buffer_patch) + + call buffer_patch%Create(0._r8, 0._r8, i_land_use_label, 0, & + hlm_numSWb, numpft, currentSite%nlevsoil, hlm_current_tod, & + regeneration_model) + + ! make a note that this buffer patch has not been put into the linked list + buffer_patch_in_linked_list = .false. + + ! Initialize the litter pools to zero + do el=1,num_elements + call buffer_patch%litter(el)%InitConditions(init_leaf_fines=0._r8, & + init_root_fines=0._r8, & + init_ag_cwd=0._r8, & + init_bg_cwd=0._r8, & + init_seed=0._r8, & + init_seed_germ=0._r8) + end do + buffer_patch%tallest => null() + buffer_patch%shortest => null() - currentPatch => currentSite%oldest_patch - do while(associated(currentPatch)) - if (currentPatch%changed_landuse_this_ts) then - fraction_to_keep = currentSite%area_pft(currentPatch%nocomp_pft_label,i_land_use_label) * area / nocomp_pft_area_vector(currentPatch%nocomp_pft_label) - if (fraction_to_keep .lt. nearzero) then - ! we don't want any patch area with this PFT idendity at all anymore. Fuse it into the buffer patch. - currentPatch%nocomp_pft_label = 0 - call fuse_2_patches(currentSite, currentPatch, buffer_patch) - elseif (fraction_to_keep .lt. (1._r8 - nearzero)) then - ! we have more patch are of this PFT than we want, but we do want to keep some of it. - ! we want to split the patch into two here. leave one patch as-is, and put the rest into the buffer patch. - - allocate(temp_patch) - call split_patch(currentSite, currentPatch, temp_patch, fraction_to_keep) - ! - temp_patch%nocomp_pft_label = 0 - call fuse_2_patches(currentSite, temp_patch, buffer_patch) - else - ! we want to keep all of this patch (and possibly more) - nocomp_pft_area_vector_allocated(currentPatch%nocomp_pft_label) = & - nocomp_pft_area_vector_allocated(currentPatch%nocomp_pft_label) + currentPatch%area - currentPatch%changed_landuse_this_ts = .false. - endif - end if - currentPatch => currentPatch%younger - end do - - ! now we need to loop through the nocomp PFTs, and split the buffer patch into a set of patches to put back in the linked list - nocomp_pft_loop_2: do i_pft = 1, numpft + currentPatch => currentSite%oldest_patch + do while(associated(currentPatch)) + if (currentPatch%changed_landuse_this_ts) then + fraction_to_keep = currentSite%area_pft(currentPatch%nocomp_pft_label,i_land_use_label) * area / nocomp_pft_area_vector(currentPatch%nocomp_pft_label) + if (fraction_to_keep .lt. nearzero) then + ! we don't want any patch area with this PFT idendity at all anymore. Fuse it into the buffer patch. + currentPatch%nocomp_pft_label = 0 + call fuse_2_patches(currentSite, currentPatch, buffer_patch) + elseif (fraction_to_keep .lt. (1._r8 - nearzero)) then + ! we have more patch are of this PFT than we want, but we do want to keep some of it. + ! we want to split the patch into two here. leave one patch as-is, and put the rest into the buffer patch. + + allocate(temp_patch) + call split_patch(currentSite, currentPatch, temp_patch, fraction_to_keep) + ! + temp_patch%nocomp_pft_label = 0 + call fuse_2_patches(currentSite, temp_patch, buffer_patch) + else + ! we want to keep all of this patch (and possibly more) + nocomp_pft_area_vector_allocated(currentPatch%nocomp_pft_label) = & + nocomp_pft_area_vector_allocated(currentPatch%nocomp_pft_label) + currentPatch%area + currentPatch%changed_landuse_this_ts = .false. + endif + end if + currentPatch => currentPatch%younger + end do - if (nocomp_pft_area_vector_allocated(i_pft) .lt. currentSite%area_pft(i_pft,i_land_use_label) * area) then + ! now we need to loop through the nocomp PFTs, and split the buffer patch into a set of patches to put back in the linked list + nocomp_pft_loop_2: do i_pft = 1, numpft + ! + if (nocomp_pft_area_vector_allocated(i_pft) .lt. currentSite%area_pft(i_pft,i_land_use_label) * sum(nocomp_pft_area_vector(:))) then - newp_area = currentSite%area_pft(i_pft,i_land_use_label) * area - nocomp_pft_area_vector_allocated(i_pft) + newp_area = currentSite%area_pft(i_pft,i_land_use_label) * sum(nocomp_pft_area_vector(:)) - nocomp_pft_area_vector_allocated(i_pft) - if (newp_area .lt. buffer_patch%area) then + if (newp_area .lt. buffer_patch%area) then - ! split buffer patch in two, keeping the smaller buffer patch to put into new patches - allocate(temp_patch) - call split_patch(currentSite, buffer_patch, temp_patch, newp_area/buffer_patch%area) + ! split buffer patch in two, keeping the smaller buffer patch to put into new patches + allocate(temp_patch) + call split_patch(currentSite, buffer_patch, temp_patch, newp_area/buffer_patch%area) - ! give the new patch the intended nocomp PFT label - temp_patch%nocomp_pft_label = i_pft + ! give the new patch the intended nocomp PFT label + temp_patch%nocomp_pft_label = i_pft - ! put the new patch into the linked list - call InsertPatch(currentSite, temp_patch) + ! put the new patch into the linked list + call InsertPatch(currentSite, temp_patch) - ! now that the patch that temp_patch points to is in the site linked list, we want to null temp_patch so that it can be - ! refilled the next time through the loop. - temp_patch => null() + ! now that the patch that temp_patch points to is in the site linked list, we want to null temp_patch so that it can be + ! refilled the next time through the loop. + temp_patch => null() - else - ! give the buffer patch the intended nocomp PFT label - buffer_patch%nocomp_pft_label = i_pft + else + ! give the buffer patch the intended nocomp PFT label + buffer_patch%nocomp_pft_label = i_pft - ! put the buffer patch directly into the linked list - call InsertPatch(currentSite, buffer_patch) + ! put the buffer patch directly into the linked list + call InsertPatch(currentSite, buffer_patch) - buffer_patch_in_linked_list = .true. + buffer_patch_in_linked_list = .true. - end if + end if - end if + end if - end do nocomp_pft_loop_2 - - ! now we want to make sure that either the buffer_patch either has zero area (presumably it was never used), in which case it should be deallocated, - ! or else it does have area but it has been put into the site linked list, and so buffer patch should be nulled before next pass through outer loop. - ! if either of those, that means everything worked properly, if not, then something has gone wrong. - if (buffer_patch_in_linked_list) then - buffer_patch => null() - else if (buffer_patch%area .lt. fates_tiny) then - ! here we need to deallocate the buffer patch so that we don't get a memory leak/ - call buffer_patch%FreeMemory(regeneration_model, numpft) - deallocate(buffer_patch, stat=istat, errmsg=smsg) - if (istat/=0) then - write(fates_log(),*) 'dealloc: fail on deallocate(dp):'//trim(smsg) + end do nocomp_pft_loop_2 + + ! now we want to make sure that either the buffer_patch either has zero area (presumably it was never used), in which case it should be deallocated, + ! or else it does have area but it has been put into the site linked list, and so buffer patch should be nulled before next pass through outer loop. + ! if either of those, that means everything worked properly, if not, then something has gone wrong. + if (buffer_patch_in_linked_list) then + buffer_patch => null() + else if (buffer_patch%area .lt. fates_tiny) then + ! here we need to deallocate the buffer patch so that we don't get a memory leak/ + call buffer_patch%FreeMemory(regeneration_model, numpft) + deallocate(buffer_patch, stat=istat, errmsg=smsg) + if (istat/=0) then + write(fates_log(),*) 'dealloc: fail on deallocate(dp):'//trim(smsg) + call endrun(msg=errMsg(sourcefile, __LINE__)) + endif + else + write(fates_log(),*) 'Buffer patch still has area and it wasnt put into the linked list' + write(fates_log(),*) 'buffer_patch%area', buffer_patch%area call endrun(msg=errMsg(sourcefile, __LINE__)) - endif - else - write(fates_log(),*) 'Buffer patch still has area and it wasnt put into the linked list' - write(fates_log(),*) 'buffer_patch%area', buffer_patch%area - call endrun(msg=errMsg(sourcefile, __LINE__)) - end if - + end if + end if patch_area_to_reallocate_if end do lu_loop else ! if not using a configuration where the changed_landuse_this_ts is relevant, loop through all patches and reset it @@ -3206,6 +3207,7 @@ subroutine terminate_patches(currentSite) integer :: count_cycles logical :: gotfused logical :: current_patch_is_youngest_lutype + integer :: i_landuse, i_pft real(r8) areatot ! variable for checking whether the total patch area is wrong. !--------------------------------------------------------------------- @@ -3352,6 +3354,9 @@ subroutine terminate_patches(currentSite) write(fates_log(),*) 'otherwise, dumping some diagnostics.' write(fates_log(),*) currentPatch%area, currentPatch%nocomp_pft_label, currentPatch%land_use_label call dump_site(currentSite) + + write(fates_log(),*) 'currentSite%area_bareground', currentSite%area_bareground + write(fates_log(),*) 'currentSite%%area_pft(:,:)', currentSite%area_pft(:,:) patchpointer => currentSite%youngest_patch do while(associated(patchpointer)) write(fates_log(),*) patchpointer%area, patchpointer%nocomp_pft_label, patchpointer%land_use_label diff --git a/biogeochem/FatesLandUseChangeMod.F90 b/biogeochem/FatesLandUseChangeMod.F90 index b3d6522940..785992e5a2 100644 --- a/biogeochem/FatesLandUseChangeMod.F90 +++ b/biogeochem/FatesLandUseChangeMod.F90 @@ -114,6 +114,12 @@ subroutine get_landuse_transition_rates(bc_in, landuse_transition_matrix) end if end do transitions_loop + + ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + ! CDKCDK WARNING WARNING WARNING REVERT. THIS TURNS OFF ALL TRANSITIONS + landuse_transition_matrix(:,:) = 0._r8 + ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + end subroutine get_landuse_transition_rates !---------------------------------------------------------------------------------------------------- diff --git a/main/EDInitMod.F90 b/main/EDInitMod.F90 index 1ea223f9b4..26507bfda0 100644 --- a/main/EDInitMod.F90 +++ b/main/EDInitMod.F90 @@ -65,7 +65,6 @@ module EDInitMod use FatesInterfaceTypesMod , only : nlevdamage use FatesInterfaceTypesMod , only : hlm_use_nocomp use FatesInterfaceTypesMod , only : nlevage - use FatesInterfaceTypesMod , only : fates_hlm_num_natpfts use FatesAllometryMod , only : h2d_allom use FatesAllometryMod , only : bagw_allom use FatesAllometryMod , only : bbgw_allom @@ -463,10 +462,10 @@ subroutine set_site_properties( nsites, sites,bc_in ) ! hlm_pft_map is the area of that land in each FATES PFT (from param file) ! first check for NaNs in bc_in(s)%pft_areafrac_lu. if so, make everything bare ground. - if ( .not. any( isnan( bc_in(s)%pft_areafrac_lu (:,:) ))) then + if ( .not. (any( isnan( bc_in(s)%pft_areafrac_lu (:,:) )) .or. isnan( bc_in(s)%baregroundfrac))) then do i_landusetype = 1, n_landuse_cats if (.not. is_crop(i_landusetype)) then - do hlm_pft = 1,fates_hlm_num_natpfts + do hlm_pft = 1,size( EDPftvarcon_inst%hlm_pft_map,2) do fates_pft = 1,numpft ! loop round all fates pfts for all hlm pfts sites(s)%area_pft(fates_pft,i_landusetype) = sites(s)%area_pft(fates_pft,i_landusetype) + & EDPftvarcon_inst%hlm_pft_map(fates_pft,hlm_pft) * bc_in(s)%pft_areafrac_lu(hlm_pft,i_landusetype) @@ -480,19 +479,18 @@ subroutine set_site_properties( nsites, sites,bc_in ) sites(s)%area_bareground = bc_in(s)%baregroundfrac else - if ( all( isnan( bc_in(s)%pft_areafrac_lu (:,:) ))) then + !if ( all( isnan( bc_in(s)%pft_areafrac_lu (:,:))) .and. isnan(bc_in(s)%baregroundfrac)) then ! if given all NaNs, then make everything bare ground sites(s)%area_bareground = 1._r8 sites(s)%area_pft(:,:) = 0._r8 - sites(s)%area_pft(1,:) = 1._r8 write(fates_log(),*) 'Nan values for pftareafrac. dumping site info.' call dump_site(sites(s)) - else - ! if only some things are NaN but not all, then something terrible has probably happened. crash. - write(fates_log(),*) 'some but, not all, of the data in the PFT by LU matrix at this site is NaN.' - write(fates_log(),*) 'recommend checking the dataset to see what has happened.' - call endrun(msg=errMsg(sourcefile, __LINE__)) - endif + !else + ! ! if only some things are NaN but not all, then something terrible has probably happened. crash. + ! write(fates_log(),*) 'some but, not all, of the data in the PFT by LU matrix at this site is NaN.' + ! write(fates_log(),*) 'recommend checking the dataset to see what has happened.' + ! call endrun(msg=errMsg(sourcefile, __LINE__)) + !endif endif else @@ -516,7 +514,7 @@ subroutine set_site_properties( nsites, sites,bc_in ) do ft = 1,numpft ! remove tiny patches to prevent numerical errors in terminate patches - if(sites(s)%area_pft(ft, i_landusetype).lt.0.01_r8.and.sites(s)%area_pft(ft, i_landusetype).gt.0.0_r8)then + if(sites(s)%area_pft(ft, i_landusetype).lt.0.01_r8.and.sites(s)%area_pft(ft, i_landusetype).gt.nearzero)then if(debug) write(fates_log(),*) 'removing small pft patches',s,ft,i_landusetype,sites(s)%area_pft(ft, i_landusetype) sites(s)%area_pft(ft, i_landusetype)=0.0_r8 endif @@ -537,7 +535,7 @@ subroutine set_site_properties( nsites, sites,bc_in ) ! count how many PFTs have areas greater than zero and compare to the number of patches allowed if (COUNT(sites(s)%area_pft(:, i_landusetype) .gt. 0._r8) > maxpatches_by_landuse(i_landusetype)) then ! write current vector to log file - if(debug) write(fates_log(),*) 'too many PFTs for LU type ', i_landusetype, i_landusetype,sites(s)%area_pft(:, i_landusetype) + if(debug) write(fates_log(),*) 'too many PFTs for LU type ', i_landusetype, sites(s)%area_pft(:, i_landusetype) ! start from largest area, put that PFT's area into a temp vector, and then work down to successively smaller-area PFTs, ! at the end replace the original vector with the temp vector @@ -560,7 +558,7 @@ subroutine set_site_properties( nsites, sites,bc_in ) do i_landusetype = 1, n_landuse_cats sumarea = sum(sites(s)%area_pft(1:numpft,i_landusetype)) do ft = 1,numpft - if(sumarea.gt.0._r8)then + if(sumarea.gt.nearzero)then sites(s)%area_pft(ft, i_landusetype) = sites(s)%area_pft(ft, i_landusetype)/sumarea else ! if no PFT area in primary lands, set bare ground fraction to one. @@ -616,6 +614,7 @@ subroutine init_patches( nsites, sites, bc_in) real(r8) :: age !notional age of this patch integer :: ageclass real(r8) :: area_diff + real(r8) :: area_error ! dummy locals real(r8) :: biomass_stock @@ -677,6 +676,12 @@ subroutine init_patches( nsites, sites, bc_in) ! state_vector(:) = 0._r8 + if(hlm_use_nocomp.eq.itrue)then + num_nocomp_pfts = numpft + else !default + num_nocomp_pfts = 1 + end if !nocomp + sites_loop: do s = 1, nsites sites(s)%sp_tlai(:) = 0._r8 sites(s)%sp_tsai(:) = 0._r8 @@ -687,12 +692,6 @@ subroutine init_patches( nsites, sites, bc_in) ! have smaller spread factors than bare ground (they are crowded) sites(s)%spread = init_spread_near_bare_ground - if(hlm_use_nocomp.eq.itrue)then - num_nocomp_pfts = numpft - else !default - num_nocomp_pfts = 1 - end if !nocomp - ! read in luh state data to determine initial land use types if (hlm_use_luh .eq. itrue) then @@ -720,37 +719,41 @@ subroutine init_patches( nsites, sites, bc_in) is_first_patch = .true. + area_error = 0._r8 ! first make a bare-ground patch if one is needed. - make_bareground_patch_if: if (hlm_use_nocomp.eq.itrue .and. hlm_use_fixed_biogeog .eq.itrue .and. & - (area*sites(s)%area_bareground) .gt. min_init_patch_size) then + make_bareground_patch_if: if (hlm_use_nocomp.eq.itrue .and. hlm_use_fixed_biogeog .eq.itrue) then newparea = area * sites(s)%area_bareground - - allocate(newp) + if (newparea .gt. min_init_patch_size) then + + allocate(newp) - call newp%Create(age, newparea, nocomp_bareground_land, nocomp_bareground, & - hlm_numSWb, numpft, sites(s)%nlevsoil, hlm_current_tod, & - regeneration_model) - - ! set poointers for first patch (or only patch, if nocomp is false) - newp%patchno = 1 - newp%younger => null() - newp%older => null() - sites(s)%youngest_patch => newp - sites(s)%oldest_patch => newp - is_first_patch = .false. - - ! Initialize the litter pools to zero, these - ! pools will be populated by looping over the existing patches - ! and transfering in mass - do el=1,num_elements - call newp%litter(el)%InitConditions(init_leaf_fines=0._r8, & - init_root_fines=0._r8, & - init_ag_cwd=0._r8, & - init_bg_cwd=0._r8, & - init_seed=0._r8, & - init_seed_germ=0._r8) - end do + call newp%Create(age, newparea, nocomp_bareground_land, nocomp_bareground, & + hlm_numSWb, numpft, sites(s)%nlevsoil, hlm_current_tod, & + regeneration_model) + + ! set poointers for first patch (or only patch, if nocomp is false) + newp%patchno = 1 + newp%younger => null() + newp%older => null() + sites(s)%youngest_patch => newp + sites(s)%oldest_patch => newp + is_first_patch = .false. + + ! Initialize the litter pools to zero, these + ! pools will be populated by looping over the existing patches + ! and transfering in mass + do el=1,num_elements + call newp%litter(el)%InitConditions(init_leaf_fines=0._r8, & + init_root_fines=0._r8, & + init_ag_cwd=0._r8, & + init_bg_cwd=0._r8, & + init_seed=0._r8, & + init_seed_germ=0._r8) + end do + else + area_error = area_error + newparea + endif endif make_bareground_patch_if if (hlm_use_luh .eq. itrue) then @@ -759,84 +762,97 @@ subroutine init_patches( nsites, sites, bc_in) end_landuse_idx = 1 endif - ! now make one or more vegetated patches based on nocomp and land use logic - luh_state_loop: do i_lu_state = 1, end_landuse_idx - lu_state_present_if: if (state_vector(i_lu_state) .gt. rsnbl_math_prec) then - new_patch_nocomp_loop: do n = 1, num_nocomp_pfts - ! set the PFT index for patches if in nocomp mode. - if(hlm_use_nocomp.eq.itrue)then - nocomp_pft = n - else - nocomp_pft = fates_unset_int - end if - - if(hlm_use_nocomp.eq.itrue)then - ! In no competition mode, if we are using the fixed_biogeog filter - ! then each PFT has the area dictated by the surface dataset. - - ! If we are not using fixed biogeog model, each PFT gets the same area. - ! i.e. each grid cell is divided exactly into the number of FATES PFTs. - - if(hlm_use_fixed_biogeog.eq.itrue)then - newparea = sites(s)%area_pft(nocomp_pft,i_lu_state) * area * state_vector(i_lu_state) & - * (1._r8 - sites(s)%area_bareground) - else - newparea = area * state_vector(i_lu_state) / numpft - end if - else ! The default case is initialized w/ one patch with the area of the whole site. - newparea = area * state_vector(i_lu_state) - end if !nocomp mode - - new_patch_area_gt_zero: if(newparea .gt. min_init_patch_size) then ! Stop patches being initilialized when PFT not present in nocomop mode - allocate(newp) - - call newp%Create(age, newparea, i_lu_state, nocomp_pft, & - hlm_numSWb, numpft, sites(s)%nlevsoil, hlm_current_tod, & - regeneration_model) - - if (is_first_patch) then !is this the first patch? - ! set poointers for first patch (or only patch, if nocomp is false) - newp%patchno = 1 - newp%younger => null() - newp%older => null() - sites(s)%youngest_patch => newp - sites(s)%oldest_patch => newp - is_first_patch = .false. + not_all_baregground_if: if ((1._r8 - sites(s)%area_bareground) .gt. nearzero) then + ! now make one or more vegetated patches based on nocomp and land use logic + luh_state_loop: do i_lu_state = 1, end_landuse_idx + lu_state_present_if: if (state_vector(i_lu_state) .gt. rsnbl_math_prec) then + new_patch_nocomp_loop: do n = 1, num_nocomp_pfts + ! set the PFT index for patches if in nocomp mode. + if(hlm_use_nocomp.eq.itrue)then + nocomp_pft = n else - ! Set pointers for N>1 patches. Note this only happens when nocomp mode is on, or land use is on. - ! The new patch is the 'youngest' one, arbitrarily. - newp%patchno = nocomp_pft + (i_lu_state-1) * numpft - newp%older => sites(s)%youngest_patch - newp%younger => null() - sites(s)%youngest_patch%younger => newp - sites(s)%youngest_patch => newp + nocomp_pft = fates_unset_int end if - ! Initialize the litter pools to zero, these - ! pools will be populated by looping over the existing patches - ! and transfering in mass - if(hlm_use_sp.eq.itrue)then - litt_init = fates_unset_r8 - else - litt_init = 0._r8 - end if - do el=1,num_elements - call newp%litter(el)%InitConditions(init_leaf_fines=litt_init, & - init_root_fines=litt_init, & - init_ag_cwd=litt_init, & - init_bg_cwd=litt_init, & - init_seed=litt_init, & - init_seed_germ=litt_init) - end do - - sitep => sites(s) - call init_cohorts(sitep, newp, bc_in(s)) - - end if new_patch_area_gt_zero - end do new_patch_nocomp_loop - end if lu_state_present_if - end do luh_state_loop + if(hlm_use_nocomp.eq.itrue)then + ! In no competition mode, if we are using the fixed_biogeog filter + ! then each PFT has the area dictated by the surface dataset. + + ! If we are not using fixed biogeog model, each PFT gets the same area. + ! i.e. each grid cell is divided exactly into the number of FATES PFTs. + + if(hlm_use_fixed_biogeog.eq.itrue)then + newparea = sites(s)%area_pft(nocomp_pft,i_lu_state) * area * state_vector(i_lu_state) & + * (1._r8 - sites(s)%area_bareground) + else + newparea = area * state_vector(i_lu_state) / numpft + end if + else ! The default case is initialized w/ one patch with the area of the whole site. + newparea = area * state_vector(i_lu_state) + end if !nocomp mode + + new_patch_area_gt_zero: if(newparea .gt. min_init_patch_size) then ! Stop patches being initilialized when PFT not present in nocomop mode + allocate(newp) + + call newp%Create(age, newparea, i_lu_state, nocomp_pft, & + hlm_numSWb, numpft, sites(s)%nlevsoil, hlm_current_tod, & + regeneration_model) + + if (is_first_patch) then !is this the first patch? + ! set poointers for first patch (or only patch, if nocomp is false) + newp%patchno = 1 + newp%younger => null() + newp%older => null() + sites(s)%youngest_patch => newp + sites(s)%oldest_patch => newp + is_first_patch = .false. + else + ! Set pointers for N>1 patches. Note this only happens when nocomp mode is on, or land use is on. + ! The new patch is the 'youngest' one, arbitrarily. + newp%patchno = nocomp_pft + (i_lu_state-1) * numpft + newp%older => sites(s)%youngest_patch + newp%younger => null() + sites(s)%youngest_patch%younger => newp + sites(s)%youngest_patch => newp + end if + + ! Initialize the litter pools to zero, these + ! pools will be populated by looping over the existing patches + ! and transfering in mass + if(hlm_use_sp.eq.itrue)then + litt_init = fates_unset_r8 + else + litt_init = 0._r8 + end if + do el=1,num_elements + call newp%litter(el)%InitConditions(init_leaf_fines=litt_init, & + init_root_fines=litt_init, & + init_ag_cwd=litt_init, & + init_bg_cwd=litt_init, & + init_seed=litt_init, & + init_seed_germ=litt_init) + end do + + sitep => sites(s) + call init_cohorts(sitep, newp, bc_in(s)) + else + area_error = area_error+ newparea + end if new_patch_area_gt_zero + end do new_patch_nocomp_loop + end if lu_state_present_if + end do luh_state_loop + end if not_all_baregground_if + + ! if we had to skip small patches above, resize things accordingly + if ( area_error .gt. nearzero) then + newp => sites(s)%oldest_patch + do while (associated(newp)) + newp%area = newp%area * area/ (area - area_error) + newp => newp%younger + end do + endif + !check if the total area adds to the same as site area total = 0.0_r8 newp => sites(s)%oldest_patch @@ -930,6 +946,18 @@ subroutine init_patches( nsites, sites, bc_in) end do end if + ! check to make sure there are no very tiny patches + do s = 1, nsites + currentPatch => sites(s)%youngest_patch + do while(associated(currentPatch)) + if (currentPatch%area .lt. min_init_patch_size) then + write(fates_log(),*) 'edinit somehow making tiny patches',currentPatch%land_use_label, currentPatch%nocomp_pft_label, currentPatch%area + call endrun(msg=errMsg(sourcefile, __LINE__)) + end if + currentPatch => currentPatch%older + end do + end do + return end subroutine init_patches diff --git a/main/EDMainMod.F90 b/main/EDMainMod.F90 index 324cac5bd5..e9c984f200 100644 --- a/main/EDMainMod.F90 +++ b/main/EDMainMod.F90 @@ -292,6 +292,7 @@ subroutine ed_ecosystem_dynamics(currentSite, bc_in, bc_out) ! make new patches from disturbed land if (do_patch_dynamics.eq.itrue ) then + call spawn_patches(currentSite, bc_in) call TotalBalanceCheck(currentSite,3) diff --git a/main/FatesConstantsMod.F90 b/main/FatesConstantsMod.F90 index 3fa91d8847..e98f2cb63f 100644 --- a/main/FatesConstantsMod.F90 +++ b/main/FatesConstantsMod.F90 @@ -180,7 +180,7 @@ module FatesConstantsMod real(fates_r8), parameter, public :: nearzero = 1.0e-30_fates_r8 ! minimum init patch size for initialization in nocomp and/or land-use cases - real(fates_r8), parameter, public :: min_init_patch_size = 1.0e-2_fates_r8 + real(fates_r8), parameter, public :: min_init_patch_size = 1.0e-4_fates_r8 ! Unit conversion constants: diff --git a/main/FatesInterfaceMod.F90 b/main/FatesInterfaceMod.F90 index 6959ccde23..b4d900de02 100644 --- a/main/FatesInterfaceMod.F90 +++ b/main/FatesInterfaceMod.F90 @@ -557,8 +557,8 @@ subroutine allocate_bcin(bc_in, nlevsoil_in, nlevdecomp_in, num_lu_harvest_cats, end if if ( hlm_use_fixed_biogeog .eq. itrue) then - if (hlm_use_luh .gt. 0 ) then - allocate(bc_in%pft_areafrac_lu(fates_hlm_num_natpfts,num_luh2_states-n_crop_lu_types)) + if (hlm_use_luh .eq. itrue ) then + allocate(bc_in%pft_areafrac_lu(size( EDPftvarcon_inst%hlm_pft_map,2),num_luh2_states-n_crop_lu_types)) else allocate(bc_in%pft_areafrac(surfpft_lb:surfpft_ub)) endif @@ -796,10 +796,6 @@ subroutine SetFatesGlobalElements1(use_fates,surf_numpft,surf_numcft) fates_maxPatchesPerSite = max(surf_numpft+surf_numcft,maxpatch_total+1) - ! if this is nocomp with land use, track things differently. - ! we want the number of natpfts minus the bare ground PFT. - fates_hlm_num_natpfts = surf_numpft -1 - else ! If we are using fixed biogeography or no-comp then we diff --git a/main/FatesInterfaceTypesMod.F90 b/main/FatesInterfaceTypesMod.F90 index 47a382a22f..30cd52270f 100644 --- a/main/FatesInterfaceTypesMod.F90 +++ b/main/FatesInterfaceTypesMod.F90 @@ -226,9 +226,6 @@ module FatesInterfaceTypesMod ! the prior so that we can hold the LAI data integer, public :: fates_maxPatchesPerSite - ! the number of natural PFTs tracked by the host model; NOT INCLUDING EITHER CROPS OR BARE GROUND - integer, public :: fates_hlm_num_natpfts - integer, public :: max_comp_per_site ! This is the maximum number of nutrient aquisition ! competitors that will be generated on each site From fbcaa3326d1e385105e964c0ed657e78822e167b Mon Sep 17 00:00:00 2001 From: Charles D Koven Date: Fri, 27 Oct 2023 16:54:28 -0700 Subject: [PATCH 027/112] moar bugfix --- main/FatesRestartInterfaceMod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/main/FatesRestartInterfaceMod.F90 b/main/FatesRestartInterfaceMod.F90 index 741425caf6..ecf6acaf4b 100644 --- a/main/FatesRestartInterfaceMod.F90 +++ b/main/FatesRestartInterfaceMod.F90 @@ -711,7 +711,7 @@ subroutine define_restart_vars(this, initialize_variables) units='kgC/m2', flushval = flushzero, & hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_trunk_product_si ) - call this%set_restart_var(vname='fates_landuse_config_site', vtype=site_r8, & + call this%set_restart_var(vname='fates_landuse_config_site', vtype=site_int, & long_name='hlm_use_luh status of run that created this restart file', & units='kgC/m2', flushval = flushzero, & hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_landuse_config_si ) From f698158bcf6908f8b12736d3b62ae52f184b4d62 Mon Sep 17 00:00:00 2001 From: Charles D Koven Date: Mon, 30 Oct 2023 16:19:14 -0700 Subject: [PATCH 028/112] fixed anothe rbug and turning disturbance back on --- biogeochem/EDLoggingMortalityMod.F90 | 10 ---------- biogeochem/FatesLandUseChangeMod.F90 | 5 ----- main/EDInitMod.F90 | 23 +++++++++++++++++------ main/FatesConstantsMod.F90 | 3 --- 4 files changed, 17 insertions(+), 24 deletions(-) diff --git a/biogeochem/EDLoggingMortalityMod.F90 b/biogeochem/EDLoggingMortalityMod.F90 index d956a9b141..8f7359a7cb 100644 --- a/biogeochem/EDLoggingMortalityMod.F90 +++ b/biogeochem/EDLoggingMortalityMod.F90 @@ -445,11 +445,6 @@ subroutine get_harvest_rate_area (patch_land_use_label, hlm_harvest_catnames, hl end if end if - ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - ! !!CDKCDK WARNING WARNING WARNING THIS NEEDS TO BE REVERTED. IT TURNS OFF LOGGING ENTIRELY. - harvest_rate = 0._r8 - ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - end subroutine get_harvest_rate_area @@ -698,11 +693,6 @@ subroutine get_harvest_rate_carbon (patch_land_use_label, hlm_harvest_catnames, end if end if - ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - ! !!CDKCDK WARNING WARNING WARNING THIS NEEDS TO BE REVERTED. IT TURNS OFF LOGGING ENTIRELY. - harvest_rate = 0._r8 - ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - end subroutine get_harvest_rate_carbon ! ============================================================================ diff --git a/biogeochem/FatesLandUseChangeMod.F90 b/biogeochem/FatesLandUseChangeMod.F90 index 785992e5a2..d8f5cdf2e1 100644 --- a/biogeochem/FatesLandUseChangeMod.F90 +++ b/biogeochem/FatesLandUseChangeMod.F90 @@ -115,11 +115,6 @@ subroutine get_landuse_transition_rates(bc_in, landuse_transition_matrix) end do transitions_loop - ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - ! CDKCDK WARNING WARNING WARNING REVERT. THIS TURNS OFF ALL TRANSITIONS - landuse_transition_matrix(:,:) = 0._r8 - ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - end subroutine get_landuse_transition_rates !---------------------------------------------------------------------------------------------------- diff --git a/main/EDInitMod.F90 b/main/EDInitMod.F90 index 26507bfda0..34a73ffbc7 100644 --- a/main/EDInitMod.F90 +++ b/main/EDInitMod.F90 @@ -11,7 +11,7 @@ module EDInitMod use FatesConstantsMod , only : primaryland use FatesConstantsMod , only : nearzero use FatesConstantsMod , only : rsnbl_math_prec - use FatesConstantsMod , only : min_init_patch_size + use EDTypesMod , only : min_patch_area_forced use FatesConstantsMod , only : n_landuse_cats use FatesConstantsMod , only : is_crop use FatesConstantsMod , only : fates_unset_r8 @@ -102,7 +102,7 @@ module EDInitMod implicit none private - logical :: debug = .true. + logical :: debug = .false. integer :: istat ! return status code character(len=255) :: smsg ! Message string for deallocation errors @@ -724,7 +724,7 @@ subroutine init_patches( nsites, sites, bc_in) make_bareground_patch_if: if (hlm_use_nocomp.eq.itrue .and. hlm_use_fixed_biogeog .eq.itrue) then newparea = area * sites(s)%area_bareground - if (newparea .gt. min_init_patch_size) then + if (newparea .gt. min_patch_area_forced) then allocate(newp) @@ -765,7 +765,7 @@ subroutine init_patches( nsites, sites, bc_in) not_all_baregground_if: if ((1._r8 - sites(s)%area_bareground) .gt. nearzero) then ! now make one or more vegetated patches based on nocomp and land use logic luh_state_loop: do i_lu_state = 1, end_landuse_idx - lu_state_present_if: if (state_vector(i_lu_state) .gt. rsnbl_math_prec) then + lu_state_present_if: if (state_vector(i_lu_state) .gt. nearzero) then new_patch_nocomp_loop: do n = 1, num_nocomp_pfts ! set the PFT index for patches if in nocomp mode. if(hlm_use_nocomp.eq.itrue)then @@ -791,7 +791,7 @@ subroutine init_patches( nsites, sites, bc_in) newparea = area * state_vector(i_lu_state) end if !nocomp mode - new_patch_area_gt_zero: if(newparea .gt. min_init_patch_size) then ! Stop patches being initilialized when PFT not present in nocomop mode + new_patch_area_gt_zero: if(newparea .gt. min_patch_area_forced) then ! Stop patches being initilialized when PFT not present in nocomop mode allocate(newp) call newp%Create(age, newparea, i_lu_state, nocomp_pft, & @@ -874,6 +874,17 @@ subroutine init_patches( nsites, sites, bc_in) else !this is a big error not just a precision error. write(fates_log(),*) 'issue with patch area in EDinit', area_diff, total + newp => sites(s)%oldest_patch + do while (associated(newp)) + write(fates_log(),*) newp%area, newp%nocomp_pft_label, newp%land_use_label + newp => newp%younger + end do + write(fates_log(),*) 'state_vector', state_vector + write(fates_log(),*) 'area_error', area_error + write(fates_log(),*) 'area_bareground', sites(s)%area_bareground + do i_lu_state = 1, end_landuse_idx + write(fates_log(),*) 'sites(s)%area_pft(:,i_lu_state)',i_lu_state, sites(s)%area_pft(:,i_lu_state) + end do call endrun(msg=errMsg(sourcefile, __LINE__)) end if ! big error end if ! too much patch area @@ -950,7 +961,7 @@ subroutine init_patches( nsites, sites, bc_in) do s = 1, nsites currentPatch => sites(s)%youngest_patch do while(associated(currentPatch)) - if (currentPatch%area .lt. min_init_patch_size) then + if (currentPatch%area .lt. min_patch_area_forced) then write(fates_log(),*) 'edinit somehow making tiny patches',currentPatch%land_use_label, currentPatch%nocomp_pft_label, currentPatch%area call endrun(msg=errMsg(sourcefile, __LINE__)) end if diff --git a/main/FatesConstantsMod.F90 b/main/FatesConstantsMod.F90 index e98f2cb63f..cb778e4ba5 100644 --- a/main/FatesConstantsMod.F90 +++ b/main/FatesConstantsMod.F90 @@ -179,9 +179,6 @@ module FatesConstantsMod ! precisions are preventing perfect zero in comparison real(fates_r8), parameter, public :: nearzero = 1.0e-30_fates_r8 - ! minimum init patch size for initialization in nocomp and/or land-use cases - real(fates_r8), parameter, public :: min_init_patch_size = 1.0e-4_fates_r8 - ! Unit conversion constants: ! Conversion factor umols of Carbon -> kg of Carbon (1 mol = 12g) From ac4b61d3cfc03b428d71300d4846659dd35e707e Mon Sep 17 00:00:00 2001 From: Charles D Koven Date: Tue, 31 Oct 2023 08:45:06 -0700 Subject: [PATCH 029/112] more bugfixes; add diagnostic for transition matrix; zeroed diags on matrix --- biogeochem/EDLoggingMortalityMod.F90 | 3 +-- biogeochem/EDPatchDynamicsMod.F90 | 31 ++++++++++++++++++++++++++-- biogeochem/FatesLandUseChangeMod.F90 | 3 ++- main/FatesHistoryInterfaceMod.F90 | 27 ++++++++++++++++++++++++ 4 files changed, 59 insertions(+), 5 deletions(-) diff --git a/biogeochem/EDLoggingMortalityMod.F90 b/biogeochem/EDLoggingMortalityMod.F90 index 8f7359a7cb..6117dc49bf 100644 --- a/biogeochem/EDLoggingMortalityMod.F90 +++ b/biogeochem/EDLoggingMortalityMod.F90 @@ -423,8 +423,7 @@ subroutine get_harvest_rate_area (patch_land_use_label, hlm_harvest_catnames, hl harvest_rate = 0._r8 endif else - write(fates_log(),*) 'errror - trying to log from patches that are neither primary nor secondary' - call endrun(msg=errMsg(sourcefile, __LINE__)) + harvest_rate = 0._r8 endif ! calculate today's harvest rate diff --git a/biogeochem/EDPatchDynamicsMod.F90 b/biogeochem/EDPatchDynamicsMod.F90 index 1b387b0af4..0e2e625cac 100644 --- a/biogeochem/EDPatchDynamicsMod.F90 +++ b/biogeochem/EDPatchDynamicsMod.F90 @@ -1365,7 +1365,24 @@ subroutine spawn_patches( currentSite, bc_in) end do buffer_patch%tallest => null() buffer_patch%shortest => null() - + + ! Copy any means or timers from the original patch to the new patch + ! These values will inherit all info from the original patch + ! -------------------------------------------------------------------------- + call buffer_patch%tveg24%CopyFromDonor(currentPatch%tveg24) + call buffer_patch%tveg_lpa%CopyFromDonor(currentPatch%tveg_lpa) + call buffer_patch%tveg_longterm%CopyFromDonor(currentPatch%tveg_longterm) + + if ( regeneration_model == TRS_regeneration ) then + call buffer_patch%seedling_layer_par24%CopyFromDonor(currentPatch%seedling_layer_par24) + call buffer_patch%sdlng_mort_par%CopyFromDonor(currentPatch%sdlng_mort_par) + call buffer_patch%sdlng2sap_par%CopyFromDonor(currentPatch%sdlng2sap_par) + do pft = 1,numpft + call buffer_patch%sdlng_emerg_smp(pft)%p%CopyFromDonor(currentPatch%sdlng_emerg_smp(pft)%p) + call buffer_patch%sdlng_mdd(pft)%p%CopyFromDonor(currentPatch%sdlng_mdd(pft)%p) + enddo + end if + currentPatch => currentSite%oldest_patch do while(associated(currentPatch)) if (currentPatch%changed_landuse_this_ts) then @@ -1492,7 +1509,7 @@ subroutine split_patch(currentSite, currentPatch, new_patch, fraction_to_keep) type (fates_cohort_type), pointer :: currentCohort integer :: tnull ! is there a tallest cohort? integer :: snull ! is there a shortest cohort? - + integer :: pft ! first we need to make the new patch call new_patch%Create(0._r8, & @@ -1521,6 +1538,16 @@ subroutine split_patch(currentSite, currentPatch, new_patch, fraction_to_keep) call new_patch%tveg_lpa%CopyFromDonor(currentPatch%tveg_lpa) call new_patch%tveg_longterm%CopyFromDonor(currentPatch%tveg_longterm) + if ( regeneration_model == TRS_regeneration ) then + call new_patch%seedling_layer_par24%CopyFromDonor(currentPatch%seedling_layer_par24) + call new_patch%sdlng_mort_par%CopyFromDonor(currentPatch%sdlng_mort_par) + call new_patch%sdlng2sap_par%CopyFromDonor(currentPatch%sdlng2sap_par) + do pft = 1,numpft + call new_patch%sdlng_emerg_smp(pft)%p%CopyFromDonor(currentPatch%sdlng_emerg_smp(pft)%p) + call new_patch%sdlng_mdd(pft)%p%CopyFromDonor(currentPatch%sdlng_mdd(pft)%p) + enddo + end if + currentPatch%burnt_frac_litter(:) = 0._r8 call TransLitterNewPatch( currentSite, currentPatch, new_patch, currentPatch%area * fraction_to_keep) diff --git a/biogeochem/FatesLandUseChangeMod.F90 b/biogeochem/FatesLandUseChangeMod.F90 index d8f5cdf2e1..3cf6d19528 100644 --- a/biogeochem/FatesLandUseChangeMod.F90 +++ b/biogeochem/FatesLandUseChangeMod.F90 @@ -107,7 +107,8 @@ subroutine get_landuse_transition_rates(bc_in, landuse_transition_matrix) i_receiver = lumap%GetIndex(receiver_name) ! Avoid transitions with 'urban' as those are handled seperately - if (.not.(i_donor .eq. fates_unset_int .or. i_receiver .eq. fates_unset_int)) then + ! Also ignore diagonal elements of transition matrix. + if (.not.(i_donor .eq. fates_unset_int .or. i_receiver .eq. fates_unset_int .or. i_donor .eq. i_receiver)) then landuse_transition_matrix(i_donor,i_receiver) = & landuse_transition_matrix(i_donor,i_receiver) + temp_vector(i_luh2_transitions) * years_per_day / (1._r8 - urban_fraction) diff --git a/main/FatesHistoryInterfaceMod.F90 b/main/FatesHistoryInterfaceMod.F90 index 0679e216e2..4af0b7806f 100644 --- a/main/FatesHistoryInterfaceMod.F90 +++ b/main/FatesHistoryInterfaceMod.F90 @@ -53,6 +53,8 @@ module FatesHistoryInterfaceMod use FatesInterfaceTypesMod , only : nlevcoage use FatesInterfaceTypesMod , only : hlm_use_nocomp use FatesInterfaceTypesMod , only : hlm_use_fixed_biogeog + use FatesInterfaceTypesMod , only : hlm_use_luh + use FatesLandUseChangeMod, only : get_landuse_transition_rates, get_init_landuse_transition_rates use FatesAllometryMod , only : CrownDepth use FatesAllometryMod , only : bstore_allom use FatesAllometryMod , only : set_root_fraction @@ -309,6 +311,7 @@ module FatesHistoryInterfaceMod integer :: ih_primaryland_fusion_error_si integer :: ih_area_si_landuse integer :: ih_disturbance_rate_si_lulu + integer :: ih_transition_matrix_si_lulu integer :: ih_fire_disturbance_rate_si integer :: ih_logging_disturbance_rate_si integer :: ih_fall_disturbance_rate_si @@ -2322,6 +2325,8 @@ subroutine update_history_dyn(this,nc,nsites,sites,bc_in) integer :: tmp + real(r8) :: landuse_transition_matrix(n_landuse_cats,n_landuse_cats) + associate( hio_npatches_si => this%hvars(ih_npatches_si)%r81d, & hio_npatches_sec_si => this%hvars(ih_npatches_sec_si)%r81d, & hio_ncohorts_si => this%hvars(ih_ncohorts_si)%r81d, & @@ -2387,6 +2392,7 @@ subroutine update_history_dyn(this,nc,nsites,sites,bc_in) hio_understory_biomass_si => this%hvars(ih_understory_biomass_si)%r81d, & hio_primaryland_fusion_error_si => this%hvars(ih_primaryland_fusion_error_si)%r81d, & hio_disturbance_rate_si_lulu => this%hvars(ih_disturbance_rate_si_lulu)%r82d, & + hio_transition_matrix_si_lulu => this%hvars(ih_transition_matrix_si_lulu)%r82d, & hio_fire_disturbance_rate_si => this%hvars(ih_fire_disturbance_rate_si)%r81d, & hio_logging_disturbance_rate_si => this%hvars(ih_logging_disturbance_rate_si)%r81d, & hio_fall_disturbance_rate_si => this%hvars(ih_fall_disturbance_rate_si)%r81d, & @@ -2750,6 +2756,22 @@ subroutine update_history_dyn(this,nc,nsites,sites,bc_in) end do end do + ! get the land sue transition matrix and output that to history. (mainly a sanity check, can maybe remove before integration) + if ( hlm_use_luh .eq. itrue ) then + if(.not. sites(s)%transition_landuse_from_off_to_on) then + call get_landuse_transition_rates(bc_in(s), landuse_transition_matrix) + else + call get_init_landuse_transition_rates(bc_in(s), landuse_transition_matrix) + endif + else + landuse_transition_matrix(:,:) = 0._r8 + endif + do i_dist = 1, n_landuse_cats + do j_dist = 1, n_landuse_cats + hio_transition_matrix_si_lulu(io_si, i_dist+n_landuse_cats*(j_dist-1)) = landuse_transition_matrix(i_dist, j_dist) + end do + end do + ! output site-level disturbance rates [m2 m-2 day-1] -> [m2 m-2 yr-1] - TO DO rework this hio_fire_disturbance_rate_si(io_si) = sum(sites(s)%disturbance_rates(dtype_ifire,1:n_landuse_cats,1:n_landuse_cats)) * & @@ -5753,6 +5775,11 @@ subroutine define_history_vars(this, initialize_variables) avgflag='A', vtype=site_lulu_r8, hlms='CLM:ALM', upfreq=1, ivar=ivar, & initialize=initialize_variables, index=ih_disturbance_rate_si_lulu) + call this%set_history_var(vname='FATES_TRANSITION_MATRIX_LULU', units='m2 m-2 yr-1', & + long='land use transition matrix', use_default='active', & + avgflag='A', vtype=site_lulu_r8, hlms='CLM:ALM', upfreq=1, ivar=ivar, & + initialize=initialize_variables, index=ih_transition_matrix_si_lulu) + ! Secondary forest area and age diagnostics call this%set_history_var(vname='FATES_SECONDARY_FOREST_FRACTION', & From 46717980a2a01824ce0993fc84890790c73730e7 Mon Sep 17 00:00:00 2001 From: Charles D Koven Date: Tue, 31 Oct 2023 13:46:05 -0700 Subject: [PATCH 030/112] moving storage of transition matrix to site variable to simplify history output --- biogeochem/EDPatchDynamicsMod.F90 | 9 ++++----- main/FatesHistoryInterfaceMod.F90 | 16 ++-------------- 2 files changed, 6 insertions(+), 19 deletions(-) diff --git a/biogeochem/EDPatchDynamicsMod.F90 b/biogeochem/EDPatchDynamicsMod.F90 index 0e2e625cac..352799c091 100644 --- a/biogeochem/EDPatchDynamicsMod.F90 +++ b/biogeochem/EDPatchDynamicsMod.F90 @@ -215,7 +215,6 @@ subroutine disturbance_rates( site_in, bc_in) real(r8) :: mean_temp real(r8) :: harvestable_forest_c(hlm_num_lu_harvest_cats) integer :: harvest_tag(hlm_num_lu_harvest_cats) - real(r8) :: landuse_transition_matrix(n_landuse_cats, n_landuse_cats) ! [m2/m2/day] real(r8) :: current_fates_landuse_state_vector(n_landuse_cats) ! [m2/m2] !---------------------------------------------------------------------------------------------- ! Calculate Mortality Rates (these were previously calculated during growth derivatives) @@ -287,12 +286,12 @@ subroutine disturbance_rates( site_in, bc_in) if ( hlm_use_luh .eq. itrue ) then if(.not. site_in%transition_landuse_from_off_to_on) then - call get_landuse_transition_rates(bc_in, landuse_transition_matrix) + call get_landuse_transition_rates(bc_in, site_in%landuse_transition_matrix) else - call get_init_landuse_transition_rates(bc_in, landuse_transition_matrix) + call get_init_landuse_transition_rates(bc_in, site_in%landuse_transition_matrix) endif else - landuse_transition_matrix(:,:) = 0._r8 + site_in%landuse_transition_matrix(:,:) = 0._r8 endif ! calculate total area in each landuse category @@ -337,7 +336,7 @@ subroutine disturbance_rates( site_in, bc_in) ! Avoid this calculation to avoid NaN due to division by zero result if luh is not used or applying to bare ground if (hlm_use_luh .eq. itrue .and. currentPatch%land_use_label .gt. nocomp_bareground_land) then currentPatch%landuse_transition_rates(1:n_landuse_cats) = min(1._r8, & - landuse_transition_matrix(currentPatch%land_use_label,1:n_landuse_cats) / & + site_in%landuse_transition_matrix(currentPatch%land_use_label,1:n_landuse_cats) / & current_fates_landuse_state_vector(currentPatch%land_use_label)) else currentPatch%landuse_transition_rates = 0.0_r8 diff --git a/main/FatesHistoryInterfaceMod.F90 b/main/FatesHistoryInterfaceMod.F90 index 4af0b7806f..85651d778b 100644 --- a/main/FatesHistoryInterfaceMod.F90 +++ b/main/FatesHistoryInterfaceMod.F90 @@ -54,7 +54,6 @@ module FatesHistoryInterfaceMod use FatesInterfaceTypesMod , only : hlm_use_nocomp use FatesInterfaceTypesMod , only : hlm_use_fixed_biogeog use FatesInterfaceTypesMod , only : hlm_use_luh - use FatesLandUseChangeMod, only : get_landuse_transition_rates, get_init_landuse_transition_rates use FatesAllometryMod , only : CrownDepth use FatesAllometryMod , only : bstore_allom use FatesAllometryMod , only : set_root_fraction @@ -2325,8 +2324,6 @@ subroutine update_history_dyn(this,nc,nsites,sites,bc_in) integer :: tmp - real(r8) :: landuse_transition_matrix(n_landuse_cats,n_landuse_cats) - associate( hio_npatches_si => this%hvars(ih_npatches_si)%r81d, & hio_npatches_sec_si => this%hvars(ih_npatches_sec_si)%r81d, & hio_ncohorts_si => this%hvars(ih_ncohorts_si)%r81d, & @@ -2756,19 +2753,10 @@ subroutine update_history_dyn(this,nc,nsites,sites,bc_in) end do end do - ! get the land sue transition matrix and output that to history. (mainly a sanity check, can maybe remove before integration) - if ( hlm_use_luh .eq. itrue ) then - if(.not. sites(s)%transition_landuse_from_off_to_on) then - call get_landuse_transition_rates(bc_in(s), landuse_transition_matrix) - else - call get_init_landuse_transition_rates(bc_in(s), landuse_transition_matrix) - endif - else - landuse_transition_matrix(:,:) = 0._r8 - endif + ! get the land use transition matrix and output that to history. (mainly a sanity check, can maybe remove before integration) do i_dist = 1, n_landuse_cats do j_dist = 1, n_landuse_cats - hio_transition_matrix_si_lulu(io_si, i_dist+n_landuse_cats*(j_dist-1)) = landuse_transition_matrix(i_dist, j_dist) + hio_transition_matrix_si_lulu(io_si, i_dist+n_landuse_cats*(j_dist-1)) = sites(s)%landuse_transition_matrix(i_dist, j_dist) end do end do From 3af29362d058082b40043475e4f941d028f55c56 Mon Sep 17 00:00:00 2001 From: Charles D Koven Date: Wed, 1 Nov 2023 13:10:46 -0700 Subject: [PATCH 031/112] added use_fates_potentialveg flag and logic based on it --- biogeochem/FatesLandUseChangeMod.F90 | 107 +++++++++++++++------------ main/FatesInterfaceMod.F90 | 6 ++ main/FatesInterfaceTypesMod.F90 | 1 + main/FatesRestartInterfaceMod.F90 | 8 +- 4 files changed, 69 insertions(+), 53 deletions(-) diff --git a/biogeochem/FatesLandUseChangeMod.F90 b/biogeochem/FatesLandUseChangeMod.F90 index 3cf6d19528..9a8fc57eda 100644 --- a/biogeochem/FatesLandUseChangeMod.F90 +++ b/biogeochem/FatesLandUseChangeMod.F90 @@ -16,6 +16,7 @@ module FatesLandUseChangeMod use FatesInterfaceTypesMod , only : hlm_num_luh2_states use FatesInterfaceTypesMod , only : hlm_num_luh2_transitions use EDTypesMod , only : area_site => area + use FatesInterfaceTypesMod , only : hlm_use_potentialveg ! CIME globals use shr_log_mod , only : errMsg => shr_log_errMsg @@ -84,37 +85,41 @@ subroutine get_landuse_transition_rates(bc_in, landuse_transition_matrix) landuse_transition_matrix(:,:) = 0._r8 urban_fraction = 0._r8 - ! Check the LUH data incoming to see if any of the transitions are NaN - temp_vector = bc_in%hlm_luh_transitions - call CheckLUHData(temp_vector,modified_flag) - if (.not. modified_flag) then - ! identify urban fraction so that it can be factored into the land use state output - urban_fraction = bc_in%hlm_luh_states(findloc(bc_in%hlm_luh_state_names,'urban',dim=1)) - end if + ! if we are using potential veg only, then keep all transitions equal to zero. + if ( .not. hlm_use_potentialveg ) then - !!TODO: may need some logic here to ask whether or not ot perform land use change on this timestep. current code occurs every day. - !!If not doing transition every day, need to update units. + ! Check the LUH data incoming to see if any of the transitions are NaN + temp_vector = bc_in%hlm_luh_transitions + call CheckLUHData(temp_vector,modified_flag) + if (.not. modified_flag) then + ! identify urban fraction so that it can be factored into the land use state output + urban_fraction = bc_in%hlm_luh_states(findloc(bc_in%hlm_luh_state_names,'urban',dim=1)) + end if - transitions_loop: do i_luh2_transitions = 1, hlm_num_luh2_transitions + !!TODO: may need some logic here to ask whether or not ot perform land use change on this timestep. current code occurs every day. + !!If not doing transition every day, need to update units. - ! transition names are written in form xxxxx_to_yyyyy where x and y are donor and receiver state names - transition_name = bc_in%hlm_luh_transition_names(i_luh2_transitions) - donor_name = transition_name(1:5) - receiver_name = transition_name(10:14) + transitions_loop: do i_luh2_transitions = 1, hlm_num_luh2_transitions - ! Get the fates land use type index associated with the luh2 state types - i_donor= lumap%GetIndex(donor_name) - i_receiver = lumap%GetIndex(receiver_name) + ! transition names are written in form xxxxx_to_yyyyy where x and y are donor and receiver state names + transition_name = bc_in%hlm_luh_transition_names(i_luh2_transitions) + donor_name = transition_name(1:5) + receiver_name = transition_name(10:14) - ! Avoid transitions with 'urban' as those are handled seperately - ! Also ignore diagonal elements of transition matrix. - if (.not.(i_donor .eq. fates_unset_int .or. i_receiver .eq. fates_unset_int .or. i_donor .eq. i_receiver)) then - landuse_transition_matrix(i_donor,i_receiver) = & - landuse_transition_matrix(i_donor,i_receiver) + temp_vector(i_luh2_transitions) * years_per_day / (1._r8 - urban_fraction) + ! Get the fates land use type index associated with the luh2 state types + i_donor= lumap%GetIndex(donor_name) + i_receiver = lumap%GetIndex(receiver_name) - end if - end do transitions_loop + ! Avoid transitions with 'urban' as those are handled seperately + ! Also ignore diagonal elements of transition matrix. + if (.not.(i_donor .eq. fates_unset_int .or. i_receiver .eq. fates_unset_int .or. i_donor .eq. i_receiver)) then + landuse_transition_matrix(i_donor,i_receiver) = & + landuse_transition_matrix(i_donor,i_receiver) + temp_vector(i_luh2_transitions) * years_per_day / (1._r8 - urban_fraction) + end if + end do transitions_loop + + end if end subroutine get_landuse_transition_rates @@ -239,33 +244,37 @@ subroutine get_luh_statedata(bc_in, state_vector) state_vector(:) = 0._r8 urban_fraction = 0._r8 - ! Check to see if the incoming state vector is NaN. - temp_vector = bc_in%hlm_luh_states - call CheckLUHData(temp_vector,modified_flag) - if (.not. modified_flag) then - ! identify urban fraction so that it can be factored into the land use state output - urban_fraction = bc_in%hlm_luh_states(findloc(bc_in%hlm_luh_state_names,'urban',dim=1)) - end if - - ! loop over all states and add up the ones that correspond to a given fates land use type - do i_luh2_states = 1, hlm_num_luh2_states - - ! Get the luh2 state name and determine fates aggregated land use - ! type index from the state to lutype map - state_name = bc_in%hlm_luh_state_names(i_luh2_states) - ii = lumap%GetIndex(state_name) - - ! Avoid 'urban' states whose indices have been given unset values - if (ii .ne. fates_unset_int) then - state_vector(ii) = state_vector(ii) + & - temp_vector(i_luh2_states) / (1._r8 - urban_fraction) + if ( .not. hlm_use_potentialveg ) then + ! Check to see if the incoming state vector is NaN. + temp_vector = bc_in%hlm_luh_states + call CheckLUHData(temp_vector,modified_flag) + if (.not. modified_flag) then + ! identify urban fraction so that it can be factored into the land use state output + urban_fraction = bc_in%hlm_luh_states(findloc(bc_in%hlm_luh_state_names,'urban',dim=1)) end if - end do - ! check to ensure total area == 1, and correct if not - if ( abs(sum(state_vector(:)) - 1._r8) .gt. nearzero ) then - write(fates_log(),*) 'warning: sum(state_vector) = ', sum(state_vector(:)) - state_vector = state_vector(:) / sum(state_vector(:)) + ! loop over all states and add up the ones that correspond to a given fates land use type + do i_luh2_states = 1, hlm_num_luh2_states + + ! Get the luh2 state name and determine fates aggregated land use + ! type index from the state to lutype map + state_name = bc_in%hlm_luh_state_names(i_luh2_states) + ii = lumap%GetIndex(state_name) + + ! Avoid 'urban' states whose indices have been given unset values + if (ii .ne. fates_unset_int) then + state_vector(ii) = state_vector(ii) + & + temp_vector(i_luh2_states) / (1._r8 - urban_fraction) + end if + end do + + ! check to ensure total area == 1, and correct if not + if ( abs(sum(state_vector(:)) - 1._r8) .gt. nearzero ) then + write(fates_log(),*) 'warning: sum(state_vector) = ', sum(state_vector(:)) + state_vector = state_vector(:) / sum(state_vector(:)) + end if + else + state_vector(primaryland) = 1._r8 end if end subroutine get_luh_statedata diff --git a/main/FatesInterfaceMod.F90 b/main/FatesInterfaceMod.F90 index b4d900de02..ca32a10217 100644 --- a/main/FatesInterfaceMod.F90 +++ b/main/FatesInterfaceMod.F90 @@ -1891,6 +1891,12 @@ subroutine set_fates_ctrlparms(tag,ival,rval,cval) write(fates_log(),*) 'Transfering hlm_use_luh = ',ival,' to FATES' end if + case('use_potentialveg') + hlm_use_potentialveg = ival + if (fates_global_verbose()) then + write(fates_log(),*) 'Transfering hlm_use_potentialveg = ',ival,' to FATES' + end if + case('num_luh2_states') hlm_num_luh2_states = ival if (fates_global_verbose()) then diff --git a/main/FatesInterfaceTypesMod.F90 b/main/FatesInterfaceTypesMod.F90 index 30cd52270f..31861c262e 100644 --- a/main/FatesInterfaceTypesMod.F90 +++ b/main/FatesInterfaceTypesMod.F90 @@ -121,6 +121,7 @@ module FatesInterfaceTypesMod ! bc_in%hlm_harvest_rates and bc_in%hlm_harvest_catnames integer, public :: hlm_use_luh ! flag to signal whether or not to use luh2 drivers + integer, public :: hlm_use_potentialveg ! flag to signal whether or not to use potential vegetation only integer, public :: hlm_num_luh2_states ! number of land use state types provided in LUH2 forcing dataset integer, public :: hlm_num_luh2_transitions ! number of land use transition types provided in LUH2 forcing dataset diff --git a/main/FatesRestartInterfaceMod.F90 b/main/FatesRestartInterfaceMod.F90 index ecf6acaf4b..157c7261ae 100644 --- a/main/FatesRestartInterfaceMod.F90 +++ b/main/FatesRestartInterfaceMod.F90 @@ -25,7 +25,7 @@ module FatesRestartInterfaceMod use FatesInterfaceTypesMod, only : hlm_parteh_mode use FatesInterfaceTypesMod, only : hlm_use_sp use FatesInterfaceTypesMod, only : hlm_use_nocomp, hlm_use_fixed_biogeog - use FatesInterfaceTypesMod, only : hlm_use_luh + use FatesInterfaceTypesMod, only : hlm_use_potentialveg use FatesInterfaceTypesMod, only : fates_maxElementsPerSite use FatesInterfaceTypesMod, only : hlm_use_tree_damage use FatesHydraulicsMemMod, only : nshell @@ -712,7 +712,7 @@ subroutine define_restart_vars(this, initialize_variables) hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_trunk_product_si ) call this%set_restart_var(vname='fates_landuse_config_site', vtype=site_int, & - long_name='hlm_use_luh status of run that created this restart file', & + long_name='hlm_use_potentialveg status of run that created this restart file', & units='kgC/m2', flushval = flushzero, & hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_landuse_config_si ) @@ -2614,7 +2614,7 @@ subroutine set_restart_vectors(this,nc,nsites,sites) rio_trunk_product_si(io_idx_si) = sites(s)%resources_management%trunk_product_site ! land use flag - rio_landuse_config_si(io_idx_si) = hlm_use_luh + rio_landuse_config_si(io_idx_si) = hlm_use_potentialveg ! set numpatches for this column @@ -3605,7 +3605,7 @@ subroutine get_restart_vectors(this, nc, nsites, sites) ! if needed, trigger the special procedure to initialize land use structure from a ! restart run that did not include land use. - if (rio_landuse_config_si(io_idx_si) .eq. ifalse .and. hlm_use_luh .eq. itrue) then + if (rio_landuse_config_si(io_idx_si) .eq. itrue .and. hlm_use_potentialveg .eq. ifalse) then sites(s)%transition_landuse_from_off_to_on = .true. endif From 0269b2249febf3ce161e1d62e08af8504b3d2014 Mon Sep 17 00:00:00 2001 From: Charles D Koven Date: Wed, 1 Nov 2023 16:59:51 -0700 Subject: [PATCH 032/112] buggfix and added a print statement --- biogeochem/EDPatchDynamicsMod.F90 | 3 ++- main/FatesInterfaceMod.F90 | 2 +- 2 files changed, 3 insertions(+), 2 deletions(-) diff --git a/biogeochem/EDPatchDynamicsMod.F90 b/biogeochem/EDPatchDynamicsMod.F90 index 352799c091..0747d09be5 100644 --- a/biogeochem/EDPatchDynamicsMod.F90 +++ b/biogeochem/EDPatchDynamicsMod.F90 @@ -110,7 +110,7 @@ module EDPatchDynamicsMod use FatesRunningMeanMod, only : ema_sdlng_mdd use FatesRunningMeanMod, only : ema_sdlng_emerg_h2o, ema_sdlng_mort_par, ema_sdlng2sap_par use FatesRunningMeanMod, only : ema_24hr, fixed_24hr, ema_lpa, ema_longterm - + ! CIME globals use shr_infnan_mod , only : nan => shr_infnan_nan, assignment(=) use shr_log_mod , only : errMsg => shr_log_errMsg @@ -288,6 +288,7 @@ subroutine disturbance_rates( site_in, bc_in) if(.not. site_in%transition_landuse_from_off_to_on) then call get_landuse_transition_rates(bc_in, site_in%landuse_transition_matrix) else + write(fates_log(),*) 'transitioning from potential vegetation to actual land use' call get_init_landuse_transition_rates(bc_in, site_in%landuse_transition_matrix) endif else diff --git a/main/FatesInterfaceMod.F90 b/main/FatesInterfaceMod.F90 index ca32a10217..99d7ef56d3 100644 --- a/main/FatesInterfaceMod.F90 +++ b/main/FatesInterfaceMod.F90 @@ -1891,7 +1891,7 @@ subroutine set_fates_ctrlparms(tag,ival,rval,cval) write(fates_log(),*) 'Transfering hlm_use_luh = ',ival,' to FATES' end if - case('use_potentialveg') + case('use_fates_potentialveg') hlm_use_potentialveg = ival if (fates_global_verbose()) then write(fates_log(),*) 'Transfering hlm_use_potentialveg = ',ival,' to FATES' From c9414d23fdc70957531a146ffc23e1ab64651d94 Mon Sep 17 00:00:00 2001 From: Charles D Koven Date: Wed, 1 Nov 2023 21:39:04 -0700 Subject: [PATCH 033/112] moar bugs --- biogeochem/EDPatchDynamicsMod.F90 | 121 ++++++++++++++---------------- main/EDMainMod.F90 | 12 +-- main/FatesRestartInterfaceMod.F90 | 1 + 3 files changed, 65 insertions(+), 69 deletions(-) diff --git a/biogeochem/EDPatchDynamicsMod.F90 b/biogeochem/EDPatchDynamicsMod.F90 index 0747d09be5..f8fbc45ac2 100644 --- a/biogeochem/EDPatchDynamicsMod.F90 +++ b/biogeochem/EDPatchDynamicsMod.F90 @@ -127,7 +127,7 @@ module EDPatchDynamicsMod public :: check_patch_area public :: set_patchno private:: fuse_2_patches - public :: get_frac_site_primary + public :: get_current_landuse_statevector character(len=*), parameter, private :: sourcefile = & __FILE__ @@ -208,8 +208,6 @@ subroutine disturbance_rates( site_in, bc_in) integer :: threshold_sizeclass integer :: i_dist integer :: h_index - real(r8) :: frac_site_primary - real(r8) :: frac_site_secondary real(r8) :: harvest_rate real(r8) :: tempsum real(r8) :: mean_temp @@ -222,12 +220,13 @@ subroutine disturbance_rates( site_in, bc_in) !---------------------------------------------------------------------------------------------- ! first calculate the fraction of the site that is primary land - call get_frac_site_primary(site_in, frac_site_primary, frac_site_secondary) + call get_current_landuse_statevector(site_in, current_fates_landuse_state_vector) ! check status of transition_landuse_from_off_to_on flag, and do some error checking on it if(site_in%transition_landuse_from_off_to_on) then - if (abs(frac_site_primary - 1._r8) .gt. fates_tiny) then + if (sum(current_fates_landuse_state_vector(secondaryland:cropland)) .gt. nearzero) then write(fates_log(),*) 'flag for transition_landuse_from_off_to_on is set to true but site is not entirely primaryland' + write(fates_log(), *) current_fates_landuse_state_vector call endrun(msg=errMsg(sourcefile, __LINE__)) endif endif @@ -266,8 +265,8 @@ subroutine disturbance_rates( site_in, bc_in) bc_in%hlm_harvest_units, & currentPatch%land_use_label, & currentPatch%age_since_anthro_disturbance, & - frac_site_primary, & - frac_site_secondary, & + current_fates_landuse_state_vector(primaryland), & + current_fates_landuse_state_vector(secondaryland), & harvestable_forest_c, & harvest_tag) @@ -295,18 +294,6 @@ subroutine disturbance_rates( site_in, bc_in) site_in%landuse_transition_matrix(:,:) = 0._r8 endif - ! calculate total area in each landuse category - current_fates_landuse_state_vector(:) = 0._r8 - currentPatch => site_in%oldest_patch - do while (associated(currentPatch)) - if (currentPatch%land_use_label .gt. nocomp_bareground_land) then - current_fates_landuse_state_vector(currentPatch%land_use_label) = & - current_fates_landuse_state_vector(currentPatch%land_use_label) + & - currentPatch%area/AREA - end if - currentPatch => currentPatch%younger - end do - ! --------------------------------------------------------------------------------------------- ! Calculate Disturbance Rates based on the mortality rates just calculated ! --------------------------------------------------------------------------------------------- @@ -389,7 +376,8 @@ subroutine disturbance_rates( site_in, bc_in) harvest_rate, harvest_tag) else call get_harvest_rate_area (currentPatch%land_use_label, bc_in%hlm_harvest_catnames, & - bc_in%hlm_harvest_rates, frac_site_primary, frac_site_secondary, & + bc_in%hlm_harvest_rates, current_fates_landuse_state_vector(primaryland), & + current_fates_landuse_state_vector(secondaryland), & currentPatch%age_since_anthro_disturbance, harvest_rate) end if else @@ -1369,17 +1357,17 @@ subroutine spawn_patches( currentSite, bc_in) ! Copy any means or timers from the original patch to the new patch ! These values will inherit all info from the original patch ! -------------------------------------------------------------------------- - call buffer_patch%tveg24%CopyFromDonor(currentPatch%tveg24) - call buffer_patch%tveg_lpa%CopyFromDonor(currentPatch%tveg_lpa) - call buffer_patch%tveg_longterm%CopyFromDonor(currentPatch%tveg_longterm) + call buffer_patch%tveg24%CopyFromDonor(currentSite%oldest_patch%tveg24) + call buffer_patch%tveg_lpa%CopyFromDonor(currentSite%oldest_patch%tveg_lpa) + call buffer_patch%tveg_longterm%CopyFromDonor(currentSite%oldest_patch%tveg_longterm) if ( regeneration_model == TRS_regeneration ) then - call buffer_patch%seedling_layer_par24%CopyFromDonor(currentPatch%seedling_layer_par24) - call buffer_patch%sdlng_mort_par%CopyFromDonor(currentPatch%sdlng_mort_par) - call buffer_patch%sdlng2sap_par%CopyFromDonor(currentPatch%sdlng2sap_par) + call buffer_patch%seedling_layer_par24%CopyFromDonor(currentSite%oldest_patch%seedling_layer_par24) + call buffer_patch%sdlng_mort_par%CopyFromDonor(currentSite%oldest_patch%sdlng_mort_par) + call buffer_patch%sdlng2sap_par%CopyFromDonor(currentSite%oldest_patch%sdlng2sap_par) do pft = 1,numpft - call buffer_patch%sdlng_emerg_smp(pft)%p%CopyFromDonor(currentPatch%sdlng_emerg_smp(pft)%p) - call buffer_patch%sdlng_mdd(pft)%p%CopyFromDonor(currentPatch%sdlng_mdd(pft)%p) + call buffer_patch%sdlng_emerg_smp(pft)%p%CopyFromDonor(currentSite%oldest_patch%sdlng_emerg_smp(pft)%p) + call buffer_patch%sdlng_mdd(pft)%p%CopyFromDonor(currentSite%oldest_patch%sdlng_mdd(pft)%p) enddo end if @@ -2744,6 +2732,7 @@ subroutine fuse_patches( csite, bc_in ) real(r8) :: primary_land_fraction_beforefusion,primary_land_fraction_afterfusion integer :: pftlabelmin, pftlabelmax integer :: num_bareground_patches + integer :: i ! !--------------------------------------------------------------------- @@ -2991,6 +2980,17 @@ subroutine fuse_patches( csite, bc_in ) write(fates_log(),*) 'profile tolerance is too big, this shouldnt happen.' write(fates_log(),*) 'probably this means there are too many distinct categorical ' write(fates_log(),*) 'patch types for the maximum number of patches' + call dump_site(currentSite) + write(fates_log(),*) 'currentSite%area_bareground', currentSite%area_bareground + do i = 1, n_landuse_cats + write(fates_log(),*) 'i, currentSite%area_pft(:,i)',i, currentSite%area_pft(:,i) + end do + tmpptr => currentSite%youngest_patch + do while(associated(tmpptr)) + write(fates_log(),*) tmpptr%area, tmpptr%nocomp_pft_label, tmpptr%land_use_label + tmpptr => tmpptr%older + end do + call endrun(msg=errMsg(sourcefile, __LINE__)) endif else @@ -3526,42 +3526,37 @@ end function countPatches ! ===================================================================================== - subroutine get_frac_site_primary(site_in, frac_site_primary, frac_site_secondary) - - ! - ! !DESCRIPTION: - ! Calculate how much of a site is primary land and secondary land - ! - ! !USES: - use EDTypesMod , only : ed_site_type - ! - ! !ARGUMENTS: - type(ed_site_type) , intent(in), target :: site_in - real(r8) , intent(out) :: frac_site_primary - real(r8) , intent(out) :: frac_site_secondary - - ! !LOCAL VARIABLES: - type (fates_patch_type), pointer :: currentPatch + subroutine get_current_landuse_statevector(site_in, current_state_vector) + + ! + ! !DESCRIPTION: + ! Calculate how much of a site is each land use category. + ! this does not include bare ground when nocomp + fixed biogeography is on, + ! so will not sum to one in that case. otherwise it will sum to one. + ! + ! !USES: + use EDTypesMod , only : ed_site_type + ! + ! !ARGUMENTS: + type(ed_site_type) , intent(in), target :: site_in + real(r8) , intent(out) :: current_state_vector(n_landuse_cats) + + ! !LOCAL VARIABLES: + type (fates_patch_type), pointer :: currentPatch + + current_state_vector(:) = 0._r8 + + currentPatch => site_in%oldest_patch + do while (associated(currentPatch)) + if (currentPatch%land_use_label .gt. nocomp_bareground_land) then + current_state_vector(currentPatch%land_use_label) = & + current_state_vector(currentPatch%land_use_label) + & + currentPatch%area/AREA + end if + currentPatch => currentPatch%younger + end do - frac_site_primary = 0._r8 - currentPatch => site_in%oldest_patch - do while (associated(currentPatch)) - if (currentPatch%land_use_label .eq. primaryland) then - frac_site_primary = frac_site_primary + currentPatch%area * AREA_INV - endif - currentPatch => currentPatch%younger - end do - - frac_site_secondary = 0._r8 - currentPatch => site_in%oldest_patch - do while (associated(currentPatch)) - if (currentPatch%land_use_label .eq. secondaryland) then - frac_site_secondary = frac_site_secondary + currentPatch%area * AREA_INV - endif - currentPatch => currentPatch%younger - end do - - end subroutine get_frac_site_primary + end subroutine get_current_landuse_statevector ! ===================================================================================== diff --git a/main/EDMainMod.F90 b/main/EDMainMod.F90 index e9c984f200..edb9241dd1 100644 --- a/main/EDMainMod.F90 +++ b/main/EDMainMod.F90 @@ -75,6 +75,7 @@ module EDMainMod use EDTypesMod , only : phen_dstat_timeon use FatesConstantsMod , only : itrue,ifalse use FatesConstantsMod , only : primaryland, secondaryland + use FatesConstantsMod , only : n_landuse_cats use FatesConstantsMod , only : nearzero use FatesConstantsMod , only : m2_per_ha use FatesConstantsMod , only : sec_per_day @@ -88,7 +89,7 @@ module EDMainMod use EDLoggingMortalityMod , only : IsItLoggingTime use EDLoggingMortalityMod , only : get_harvestable_carbon use DamageMainMod , only : IsItDamageTime - use EDPatchDynamicsMod , only : get_frac_site_primary + use EDPatchDynamicsMod , only : get_current_landuse_statevector use FatesGlobals , only : endrun => fates_endrun use ChecksBalancesMod , only : SiteMassStock use EDMortalityFunctionsMod , only : Mortality_Derivative @@ -376,8 +377,7 @@ subroutine ed_integrate_state_variables(currentSite, bc_in, bc_out ) ! a lowered damage state. This cohort should bypass several calculations ! because it inherited them (such as daily carbon balance) real(r8) :: target_leaf_c - real(r8) :: frac_site_primary - real(r8) :: frac_site_secondary + real(r8) :: current_fates_landuse_state_vector(n_landuse_cats) real(r8) :: harvestable_forest_c(hlm_num_lu_harvest_cats) integer :: harvest_tag(hlm_num_lu_harvest_cats) @@ -413,7 +413,7 @@ subroutine ed_integrate_state_variables(currentSite, bc_in, bc_out ) !----------------------------------------------------------------------- - call get_frac_site_primary(currentSite, frac_site_primary, frac_site_secondary) + call get_current_landuse_statevector(currentSite, current_fates_landuse_state_vector) ! Clear site GPP and AR passing to HLM bc_out%gpp_site = 0._r8 @@ -478,8 +478,8 @@ subroutine ed_integrate_state_variables(currentSite, bc_in, bc_out ) call Mortality_Derivative(currentSite, currentCohort, bc_in, & currentPatch%btran_ft, mean_temp, & currentPatch%land_use_label, & - currentPatch%age_since_anthro_disturbance, frac_site_primary, & - frac_site_secondary, harvestable_forest_c, harvest_tag) + currentPatch%age_since_anthro_disturbance, current_fates_landuse_state_vector(primaryland), & + current_fates_landuse_state_vector(secondaryland), harvestable_forest_c, harvest_tag) ! ----------------------------------------------------------------------------- ! Apply Plant Allocation and Reactive Transport diff --git a/main/FatesRestartInterfaceMod.F90 b/main/FatesRestartInterfaceMod.F90 index 157c7261ae..259ed8c201 100644 --- a/main/FatesRestartInterfaceMod.F90 +++ b/main/FatesRestartInterfaceMod.F90 @@ -3606,6 +3606,7 @@ subroutine get_restart_vectors(this, nc, nsites, sites) ! if needed, trigger the special procedure to initialize land use structure from a ! restart run that did not include land use. if (rio_landuse_config_si(io_idx_si) .eq. itrue .and. hlm_use_potentialveg .eq. ifalse) then + write(fates_log(),*), 'setting transition_landuse_from_off_to_on flag based on restart potentialveg value.' sites(s)%transition_landuse_from_off_to_on = .true. endif From 39ecc274d5784cb45f2e35006724d5187b6a8e3a Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Wed, 1 Nov 2023 22:16:09 -0700 Subject: [PATCH 034/112] fix true/false check for the potential veg --- biogeochem/FatesLandUseChangeMod.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/biogeochem/FatesLandUseChangeMod.F90 b/biogeochem/FatesLandUseChangeMod.F90 index 9a8fc57eda..99f1b8a611 100644 --- a/biogeochem/FatesLandUseChangeMod.F90 +++ b/biogeochem/FatesLandUseChangeMod.F90 @@ -86,7 +86,7 @@ subroutine get_landuse_transition_rates(bc_in, landuse_transition_matrix) urban_fraction = 0._r8 ! if we are using potential veg only, then keep all transitions equal to zero. - if ( .not. hlm_use_potentialveg ) then + if (hlm_use_potentialveg .eq. ifalse) then ! Check the LUH data incoming to see if any of the transitions are NaN temp_vector = bc_in%hlm_luh_transitions @@ -244,7 +244,7 @@ subroutine get_luh_statedata(bc_in, state_vector) state_vector(:) = 0._r8 urban_fraction = 0._r8 - if ( .not. hlm_use_potentialveg ) then + if (hlm_use_potentialveg .eq. ifalse) then ! Check to see if the incoming state vector is NaN. temp_vector = bc_in%hlm_luh_states call CheckLUHData(temp_vector,modified_flag) From 1b42aeba5d267877fa2613b76814201add22283b Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Wed, 1 Nov 2023 23:10:19 -0700 Subject: [PATCH 035/112] identify patch with matching land use to copy from for the buffer patch This also fixes an issue in which the current patch is fused and then deallocated causing the next iteration of the do loop to fail when trying to find current patch. --- biogeochem/EDPatchDynamicsMod.F90 | 21 ++++++++++++--------- 1 file changed, 12 insertions(+), 9 deletions(-) diff --git a/biogeochem/EDPatchDynamicsMod.F90 b/biogeochem/EDPatchDynamicsMod.F90 index 0747d09be5..87c03c8190 100644 --- a/biogeochem/EDPatchDynamicsMod.F90 +++ b/biogeochem/EDPatchDynamicsMod.F90 @@ -507,7 +507,7 @@ subroutine spawn_patches( currentSite, bc_in) real(r8) :: disturbance_rate ! rate of disturbance being resolved [fraction of patch area / day] real(r8) :: oldarea ! old patch area prior to disturbance logical :: clearing_matrix(n_landuse_cats,n_landuse_cats) ! do we clear vegetation when transferring from one LU type to another? - type (fates_patch_type) , pointer :: buffer_patch, temp_patch + type (fates_patch_type) , pointer :: buffer_patch, temp_patch, copyPatch, previousPatch real(r8) :: nocomp_pft_area_vector(numpft) real(r8) :: nocomp_pft_area_vector_allocated(numpft) real(r8) :: fraction_to_keep @@ -1339,6 +1339,7 @@ subroutine spawn_patches( currentSite, bc_in) do while(associated(currentPatch)) if (currentPatch%changed_landuse_this_ts .and. currentPatch%land_use_label .eq. i_land_use_label) then nocomp_pft_area_vector(currentPatch%nocomp_pft_label) = nocomp_pft_area_vector(currentPatch%nocomp_pft_label) + currentPatch%area + copyPatch => currentPatch end if currentPatch => currentPatch%younger end do @@ -1369,17 +1370,17 @@ subroutine spawn_patches( currentSite, bc_in) ! Copy any means or timers from the original patch to the new patch ! These values will inherit all info from the original patch ! -------------------------------------------------------------------------- - call buffer_patch%tveg24%CopyFromDonor(currentPatch%tveg24) - call buffer_patch%tveg_lpa%CopyFromDonor(currentPatch%tveg_lpa) - call buffer_patch%tveg_longterm%CopyFromDonor(currentPatch%tveg_longterm) + call buffer_patch%tveg24%CopyFromDonor(copyPatch%tveg24) + call buffer_patch%tveg_lpa%CopyFromDonor(copyPatch%tveg_lpa) + call buffer_patch%tveg_longterm%CopyFromDonor(copyPatch%tveg_longterm) if ( regeneration_model == TRS_regeneration ) then - call buffer_patch%seedling_layer_par24%CopyFromDonor(currentPatch%seedling_layer_par24) - call buffer_patch%sdlng_mort_par%CopyFromDonor(currentPatch%sdlng_mort_par) - call buffer_patch%sdlng2sap_par%CopyFromDonor(currentPatch%sdlng2sap_par) + call buffer_patch%seedling_layer_par24%CopyFromDonor(copyPatch%seedling_layer_par24) + call buffer_patch%sdlng_mort_par%CopyFromDonor(copyPatch%sdlng_mort_par) + call buffer_patch%sdlng2sap_par%CopyFromDonor(copyPatch%sdlng2sap_par) do pft = 1,numpft - call buffer_patch%sdlng_emerg_smp(pft)%p%CopyFromDonor(currentPatch%sdlng_emerg_smp(pft)%p) - call buffer_patch%sdlng_mdd(pft)%p%CopyFromDonor(currentPatch%sdlng_mdd(pft)%p) + call buffer_patch%sdlng_emerg_smp(pft)%p%CopyFromDonor(copyPatch%sdlng_emerg_smp(pft)%p) + call buffer_patch%sdlng_mdd(pft)%p%CopyFromDonor(copyPatch%sdlng_mdd(pft)%p) enddo end if @@ -1390,7 +1391,9 @@ subroutine spawn_patches( currentSite, bc_in) if (fraction_to_keep .lt. nearzero) then ! we don't want any patch area with this PFT idendity at all anymore. Fuse it into the buffer patch. currentPatch%nocomp_pft_label = 0 + previousPatch => currentPatch%older call fuse_2_patches(currentSite, currentPatch, buffer_patch) + currentPatch => previousPatch elseif (fraction_to_keep .lt. (1._r8 - nearzero)) then ! we have more patch are of this PFT than we want, but we do want to keep some of it. ! we want to split the patch into two here. leave one patch as-is, and put the rest into the buffer patch. From 321616bba099e54b6d2cd25f2273cb1adc1e4fc4 Mon Sep 17 00:00:00 2001 From: Charles D Koven Date: Thu, 2 Nov 2023 09:15:26 -0700 Subject: [PATCH 036/112] some cleanup but still not working --- biogeochem/EDPatchDynamicsMod.F90 | 25 ++++++++++++++++--------- 1 file changed, 16 insertions(+), 9 deletions(-) diff --git a/biogeochem/EDPatchDynamicsMod.F90 b/biogeochem/EDPatchDynamicsMod.F90 index 2ac7320b8a..9f251c0667 100644 --- a/biogeochem/EDPatchDynamicsMod.F90 +++ b/biogeochem/EDPatchDynamicsMod.F90 @@ -497,7 +497,7 @@ subroutine spawn_patches( currentSite, bc_in) logical :: clearing_matrix(n_landuse_cats,n_landuse_cats) ! do we clear vegetation when transferring from one LU type to another? type (fates_patch_type) , pointer :: buffer_patch, temp_patch, copyPatch, previousPatch real(r8) :: nocomp_pft_area_vector(numpft) - real(r8) :: nocomp_pft_area_vector_allocated(numpft) + real(r8) :: nocomp_pft_area_vector_filled(numpft) real(r8) :: fraction_to_keep integer :: i_land_use_label integer :: i_pft @@ -1321,7 +1321,7 @@ subroutine spawn_patches( currentSite, bc_in) lu_loop: do i_land_use_label = 1, n_landuse_cats nocomp_pft_area_vector(:) = 0._r8 - nocomp_pft_area_vector_allocated(:) = 0._r8 + nocomp_pft_area_vector_filled(:) = 0._r8 currentPatch => currentSite%oldest_patch do while(associated(currentPatch)) @@ -1375,14 +1375,17 @@ subroutine spawn_patches( currentSite, bc_in) currentPatch => currentSite%oldest_patch do while(associated(currentPatch)) if (currentPatch%changed_landuse_this_ts) then + + ! !!! CDKCDK I think this next line is wrong. Need to fix it. !!!!!!!!!!!!!!!!!!!!!!! + fraction_to_keep = currentSite%area_pft(currentPatch%nocomp_pft_label,i_land_use_label) * area / nocomp_pft_area_vector(currentPatch%nocomp_pft_label) - if (fraction_to_keep .lt. nearzero) then - ! we don't want any patch area with this PFT idendity at all anymore. Fuse it into the buffer patch. + if (fraction_to_keep .le. nearzero) then + ! we don't want any patch area with this PFT identity at all anymore. Fuse it into the buffer patch. currentPatch%nocomp_pft_label = 0 previousPatch => currentPatch%older call fuse_2_patches(currentSite, currentPatch, buffer_patch) currentPatch => previousPatch - elseif (fraction_to_keep .lt. (1._r8 - nearzero)) then + elseif (fraction_to_keep .le. (1._r8 - nearzero)) then ! we have more patch are of this PFT than we want, but we do want to keep some of it. ! we want to split the patch into two here. leave one patch as-is, and put the rest into the buffer patch. @@ -1391,10 +1394,14 @@ subroutine spawn_patches( currentSite, bc_in) ! temp_patch%nocomp_pft_label = 0 call fuse_2_patches(currentSite, temp_patch, buffer_patch) + ! + nocomp_pft_area_vector_filled(currentPatch%nocomp_pft_label) = & + nocomp_pft_area_vector_filled(currentPatch%nocomp_pft_label) + currentPatch%area + currentPatch%changed_landuse_this_ts = .false. else ! we want to keep all of this patch (and possibly more) - nocomp_pft_area_vector_allocated(currentPatch%nocomp_pft_label) = & - nocomp_pft_area_vector_allocated(currentPatch%nocomp_pft_label) + currentPatch%area + nocomp_pft_area_vector_filled(currentPatch%nocomp_pft_label) = & + nocomp_pft_area_vector_filled(currentPatch%nocomp_pft_label) + currentPatch%area currentPatch%changed_landuse_this_ts = .false. endif end if @@ -1404,9 +1411,9 @@ subroutine spawn_patches( currentSite, bc_in) ! now we need to loop through the nocomp PFTs, and split the buffer patch into a set of patches to put back in the linked list nocomp_pft_loop_2: do i_pft = 1, numpft ! - if (nocomp_pft_area_vector_allocated(i_pft) .lt. currentSite%area_pft(i_pft,i_land_use_label) * sum(nocomp_pft_area_vector(:))) then + if (nocomp_pft_area_vector_filled(i_pft) .lt. currentSite%area_pft(i_pft,i_land_use_label) * sum(nocomp_pft_area_vector(:))) then - newp_area = currentSite%area_pft(i_pft,i_land_use_label) * sum(nocomp_pft_area_vector(:)) - nocomp_pft_area_vector_allocated(i_pft) + newp_area = currentSite%area_pft(i_pft,i_land_use_label) * sum(nocomp_pft_area_vector(:)) - nocomp_pft_area_vector_filled(i_pft) if (newp_area .lt. buffer_patch%area) then From 8493d5b848782a303955fdfc38c7e455b0c81e0b Mon Sep 17 00:00:00 2001 From: Charles D Koven Date: Thu, 2 Nov 2023 09:59:23 -0700 Subject: [PATCH 037/112] possible fix to raction_to_keep logic --- biogeochem/EDPatchDynamicsMod.F90 | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/biogeochem/EDPatchDynamicsMod.F90 b/biogeochem/EDPatchDynamicsMod.F90 index 9f251c0667..2ebb0efaea 100644 --- a/biogeochem/EDPatchDynamicsMod.F90 +++ b/biogeochem/EDPatchDynamicsMod.F90 @@ -1376,9 +1376,9 @@ subroutine spawn_patches( currentSite, bc_in) do while(associated(currentPatch)) if (currentPatch%changed_landuse_this_ts) then - ! !!! CDKCDK I think this next line is wrong. Need to fix it. !!!!!!!!!!!!!!!!!!!!!!! - - fraction_to_keep = currentSite%area_pft(currentPatch%nocomp_pft_label,i_land_use_label) * area / nocomp_pft_area_vector(currentPatch%nocomp_pft_label) + fraction_to_keep = (currentSite%area_pft(currentPatch%nocomp_pft_label,i_land_use_label) * sum(nocomp_pft_area_vector(:)) & + - nocomp_pft_area_vector_filled(currentPatch%nocomp_pft_label)) / currentPatch%area + if (fraction_to_keep .le. nearzero) then ! we don't want any patch area with this PFT identity at all anymore. Fuse it into the buffer patch. currentPatch%nocomp_pft_label = 0 From b01960debe123b66e8aadb05bf0e8585df3cc0e2 Mon Sep 17 00:00:00 2001 From: Charles D Koven Date: Thu, 2 Nov 2023 10:35:17 -0700 Subject: [PATCH 038/112] fix for fusing a patch that isn't part of the linked list structure into one that is --- biogeochem/EDPatchDynamicsMod.F90 | 46 +++++++++++++++++-------------- 1 file changed, 25 insertions(+), 21 deletions(-) diff --git a/biogeochem/EDPatchDynamicsMod.F90 b/biogeochem/EDPatchDynamicsMod.F90 index 2ebb0efaea..917f4c1137 100644 --- a/biogeochem/EDPatchDynamicsMod.F90 +++ b/biogeochem/EDPatchDynamicsMod.F90 @@ -3197,29 +3197,33 @@ subroutine fuse_2_patches(csite, dp, rp) call endrun(msg=errMsg(sourcefile, __LINE__)) endif - if(associated(youngerp))then - ! Update the younger patch's new older patch (because it isn't dp anymore) - youngerp%older => olderp - else - ! There was no younger patch than dp, so the head of the young order needs - ! to be set, and it is set as the patch older than dp. That patch - ! already knows it's older patch (so no need to set or change it) - csite%youngest_patch => olderp - olderp%younger => null() - end if + ! if neither youngerp nor olderp are associated, that means that the patch we are no longer tracking + ! is not part of the linked-list structure, and so no further action needs to be taken. + if(associated(youngerp) .or. associated(olderp))then + + if(associated(youngerp))then + ! Update the younger patch's new older patch (because it isn't dp anymore) + youngerp%older => olderp + else + ! There was no younger patch than dp, so the head of the young order needs + ! to be set, and it is set as the patch older than dp. That patch + ! already knows it's older patch (so no need to set or change it) + csite%youngest_patch => olderp + olderp%younger => null() + end if - - if(associated(olderp))then - ! Update the older patch's new younger patch (becuase it isn't dp anymore) - olderp%younger => youngerp - else - ! There was no patch older than dp, so the head of the old patch order needs - ! to be set, and it is set as the patch younger than dp. That patch already - ! knows it's younger patch, no need to set - csite%oldest_patch => youngerp - youngerp%older => null() - end if + if(associated(olderp))then + ! Update the older patch's new younger patch (becuase it isn't dp anymore) + olderp%younger => youngerp + else + ! There was no patch older than dp, so the head of the old patch order needs + ! to be set, and it is set as the patch younger than dp. That patch already + ! knows it's younger patch, no need to set + csite%oldest_patch => youngerp + youngerp%older => null() + end if + end if end subroutine fuse_2_patches From fe43f5c7b85f90c3db90d90d98980c301e7cc189 Mon Sep 17 00:00:00 2001 From: Charles D Koven Date: Thu, 2 Nov 2023 10:44:44 -0700 Subject: [PATCH 039/112] another fix in the patch nocomp-pft reweighting after land use change section --- biogeochem/EDPatchDynamicsMod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/biogeochem/EDPatchDynamicsMod.F90 b/biogeochem/EDPatchDynamicsMod.F90 index 917f4c1137..96c65779ab 100644 --- a/biogeochem/EDPatchDynamicsMod.F90 +++ b/biogeochem/EDPatchDynamicsMod.F90 @@ -1374,7 +1374,7 @@ subroutine spawn_patches( currentSite, bc_in) currentPatch => currentSite%oldest_patch do while(associated(currentPatch)) - if (currentPatch%changed_landuse_this_ts) then + if (currentPatch%changed_landuse_this_ts .and. currentPatch%land_use_label .eq. i_land_use_label) then fraction_to_keep = (currentSite%area_pft(currentPatch%nocomp_pft_label,i_land_use_label) * sum(nocomp_pft_area_vector(:)) & - nocomp_pft_area_vector_filled(currentPatch%nocomp_pft_label)) / currentPatch%area From a7b8d888508ffeaf0a2141f7904d64788b6809a8 Mon Sep 17 00:00:00 2001 From: Charles D Koven Date: Thu, 2 Nov 2023 12:00:14 -0700 Subject: [PATCH 040/112] fixed another thing that was wrong --- biogeochem/EDPatchDynamicsMod.F90 | 56 ++++++++++++++++++------------- 1 file changed, 32 insertions(+), 24 deletions(-) diff --git a/biogeochem/EDPatchDynamicsMod.F90 b/biogeochem/EDPatchDynamicsMod.F90 index 96c65779ab..d200df2994 100644 --- a/biogeochem/EDPatchDynamicsMod.F90 +++ b/biogeochem/EDPatchDynamicsMod.F90 @@ -1411,39 +1411,47 @@ subroutine spawn_patches( currentSite, bc_in) ! now we need to loop through the nocomp PFTs, and split the buffer patch into a set of patches to put back in the linked list nocomp_pft_loop_2: do i_pft = 1, numpft ! - if (nocomp_pft_area_vector_filled(i_pft) .lt. currentSite%area_pft(i_pft,i_land_use_label) * sum(nocomp_pft_area_vector(:))) then + if ( currentSite%area_pft(i_pft,i_land_use_label) .gt. nearzero) then + ! + if (nocomp_pft_area_vector_filled(i_pft) .lt. currentSite%area_pft(i_pft,i_land_use_label) * sum(nocomp_pft_area_vector(:))) then + ! + newp_area = currentSite%area_pft(i_pft,i_land_use_label) * sum(nocomp_pft_area_vector(:)) - nocomp_pft_area_vector_filled(i_pft) + ! + if (newp_area .lt. buffer_patch%area) then - newp_area = currentSite%area_pft(i_pft,i_land_use_label) * sum(nocomp_pft_area_vector(:)) - nocomp_pft_area_vector_filled(i_pft) + ! split buffer patch in two, keeping the smaller buffer patch to put into new patches + allocate(temp_patch) + call split_patch(currentSite, buffer_patch, temp_patch, newp_area/buffer_patch%area) - if (newp_area .lt. buffer_patch%area) then + ! give the new patch the intended nocomp PFT label + temp_patch%nocomp_pft_label = i_pft - ! split buffer patch in two, keeping the smaller buffer patch to put into new patches - allocate(temp_patch) - call split_patch(currentSite, buffer_patch, temp_patch, newp_area/buffer_patch%area) + ! track that we have added this patch area + nocomp_pft_area_vector_filled(i_pft) = nocomp_pft_area_vector_filled(i_pft) + temp_patch%area - ! give the new patch the intended nocomp PFT label - temp_patch%nocomp_pft_label = i_pft + ! put the new patch into the linked list + call InsertPatch(currentSite, temp_patch) - ! put the new patch into the linked list - call InsertPatch(currentSite, temp_patch) + ! now that the patch that temp_patch points to is in the site linked list, we want to null temp_patch so that it can be + ! refilled the next time through the loop. + temp_patch => null() - ! now that the patch that temp_patch points to is in the site linked list, we want to null temp_patch so that it can be - ! refilled the next time through the loop. - temp_patch => null() - - else - ! give the buffer patch the intended nocomp PFT label - buffer_patch%nocomp_pft_label = i_pft + else + ! give the buffer patch the intended nocomp PFT label + buffer_patch%nocomp_pft_label = i_pft - ! put the buffer patch directly into the linked list - call InsertPatch(currentSite, buffer_patch) + ! track that we have added this patch area + nocomp_pft_area_vector_filled(i_pft) = nocomp_pft_area_vector_filled(i_pft) + buffer_patch%area - buffer_patch_in_linked_list = .true. - - end if + ! put the buffer patch directly into the linked list + call InsertPatch(currentSite, buffer_patch) - end if + buffer_patch_in_linked_list = .true. + + end if + end if + end if end do nocomp_pft_loop_2 ! now we want to make sure that either the buffer_patch either has zero area (presumably it was never used), in which case it should be deallocated, @@ -1451,7 +1459,7 @@ subroutine spawn_patches( currentSite, bc_in) ! if either of those, that means everything worked properly, if not, then something has gone wrong. if (buffer_patch_in_linked_list) then buffer_patch => null() - else if (buffer_patch%area .lt. fates_tiny) then + else if (buffer_patch%area .lt. rsnbl_math_prec) then ! here we need to deallocate the buffer patch so that we don't get a memory leak/ call buffer_patch%FreeMemory(regeneration_model, numpft) deallocate(buffer_patch, stat=istat, errmsg=smsg) From 998aa48efc875a163cc42d397e83cb3bfdbf5a40 Mon Sep 17 00:00:00 2001 From: Charles D Koven Date: Mon, 6 Nov 2023 10:47:37 -0800 Subject: [PATCH 041/112] more bugfixes, attempted bugfixes, and diagnostics --- biogeochem/EDPatchDynamicsMod.F90 | 349 +++++++++++++++++---------- biogeochem/FatesLandUseChangeMod.F90 | 12 +- main/EDInitMod.F90 | 6 +- main/FatesConstantsMod.F90 | 3 + main/FatesRestartInterfaceMod.F90 | 1 - 5 files changed, 233 insertions(+), 138 deletions(-) diff --git a/biogeochem/EDPatchDynamicsMod.F90 b/biogeochem/EDPatchDynamicsMod.F90 index d200df2994..88a5e9b6f6 100644 --- a/biogeochem/EDPatchDynamicsMod.F90 +++ b/biogeochem/EDPatchDynamicsMod.F90 @@ -1,4 +1,3 @@ - module EDPatchDynamicsMod ! ============================================================================ ! Controls formation, creation, fusing and termination of patch level processes. @@ -214,6 +213,7 @@ subroutine disturbance_rates( site_in, bc_in) real(r8) :: harvestable_forest_c(hlm_num_lu_harvest_cats) integer :: harvest_tag(hlm_num_lu_harvest_cats) real(r8) :: current_fates_landuse_state_vector(n_landuse_cats) ! [m2/m2] + real(r8), parameter :: max_daily_disturbance_rate = 0.999_r8 !---------------------------------------------------------------------------------------------- ! Calculate Mortality Rates (these were previously calculated during growth derivatives) ! And the same rates in understory plants have already been applied to %dndt @@ -287,7 +287,6 @@ subroutine disturbance_rates( site_in, bc_in) if(.not. site_in%transition_landuse_from_off_to_on) then call get_landuse_transition_rates(bc_in, site_in%landuse_transition_matrix) else - write(fates_log(),*) 'transitioning from potential vegetation to actual land use' call get_init_landuse_transition_rates(bc_in, site_in%landuse_transition_matrix) endif else @@ -414,13 +413,14 @@ subroutine disturbance_rates( site_in, bc_in) endif ! if the sum of all disturbance rates is such that they will exceed total patch area on this day, then reduce them all proportionally. - if ( (sum(currentPatch%disturbance_rates(:)) + sum(currentPatch%landuse_transition_rates(1:n_landuse_cats))) .gt. 1.0_r8 ) then + if ( (sum(currentPatch%disturbance_rates(:)) + sum(currentPatch%landuse_transition_rates(1:n_landuse_cats))) .gt. & + max_daily_disturbance_rate ) then tempsum = sum(currentPatch%disturbance_rates(:)) + sum(currentPatch%landuse_transition_rates(1:n_landuse_cats)) do i_dist = 1,N_DIST_TYPES - currentPatch%disturbance_rates(i_dist) = currentPatch%disturbance_rates(i_dist) / tempsum + currentPatch%disturbance_rates(i_dist) = max_daily_disturbance_rate * currentPatch%disturbance_rates(i_dist) / tempsum end do do i_dist = 1,n_landuse_cats - currentPatch%landuse_transition_rates(i_dist) = currentPatch%landuse_transition_rates(i_dist) / tempsum + currentPatch%landuse_transition_rates(i_dist) = max_daily_disturbance_rate * currentPatch%landuse_transition_rates(i_dist) / tempsum end do endif @@ -503,6 +503,9 @@ subroutine spawn_patches( currentSite, bc_in) integer :: i_pft real(r8) :: newp_area logical :: buffer_patch_in_linked_list + real(r8) :: tmp, tmp2 + integer :: n_pfts_by_landuse + integer :: which_pft_allowed !--------------------------------------------------------------------- @@ -522,7 +525,7 @@ subroutine spawn_patches( currentSite, bc_in) ! get rules for vegetation clearing during land use change call get_landusechange_rules(clearing_matrix) - + ! in the nocomp cases, since every patch has a PFT identity, it can only receive patch area from patches ! that have the same identity. In order to allow this, we have this very high level loop over nocomp PFTs ! and only do the disturbance for any patches that have that nocomp PFT identity. @@ -1311,6 +1314,7 @@ subroutine spawn_patches( currentSite, bc_in) end do nocomp_pft_loop nocomp_and_luh_if: if ( hlm_use_nocomp .eq. itrue .and. hlm_use_luh .eq. itrue ) then + ! CDK test nocomp_and_luh_if: if ( .false. ) then ! disturbance has just happened, and now the nocomp PFT identities of the newly-disturbed patches ! need to be remapped to those associated with the new land use type. @@ -1318,7 +1322,7 @@ subroutine spawn_patches( currentSite, bc_in) ! logic: loop over land use types. figure out the nocomp PFT fractions for all newly-disturbed patches that have become that land use type. ! if the - lu_loop: do i_land_use_label = 1, n_landuse_cats + lu_loop: do i_land_use_label = n_landuse_cats, 1, -1 nocomp_pft_area_vector(:) = 0._r8 nocomp_pft_area_vector_filled(:) = 0._r8 @@ -1332,147 +1336,223 @@ subroutine spawn_patches( currentSite, bc_in) currentPatch => currentPatch%younger end do - patch_area_to_reallocate_if: if ( sum(nocomp_pft_area_vector(:)) .gt. nearzero ) then - ! create buffer patch to put all of the pieces carved off of other patches - allocate(buffer_patch) - - call buffer_patch%Create(0._r8, 0._r8, i_land_use_label, 0, & - hlm_numSWb, numpft, currentSite%nlevsoil, hlm_current_tod, & - regeneration_model) - - ! make a note that this buffer patch has not been put into the linked list - buffer_patch_in_linked_list = .false. - - ! Initialize the litter pools to zero - do el=1,num_elements - call buffer_patch%litter(el)%InitConditions(init_leaf_fines=0._r8, & - init_root_fines=0._r8, & - init_ag_cwd=0._r8, & - init_bg_cwd=0._r8, & - init_seed=0._r8, & - init_seed_germ=0._r8) - end do - buffer_patch%tallest => null() - buffer_patch%shortest => null() - - ! Copy any means or timers from the original patch to the new patch - ! These values will inherit all info from the original patch - ! -------------------------------------------------------------------------- - call buffer_patch%tveg24%CopyFromDonor(copyPatch%tveg24) - call buffer_patch%tveg_lpa%CopyFromDonor(copyPatch%tveg_lpa) - call buffer_patch%tveg_longterm%CopyFromDonor(copyPatch%tveg_longterm) - - if ( regeneration_model == TRS_regeneration ) then - call buffer_patch%seedling_layer_par24%CopyFromDonor(copyPatch%seedling_layer_par24) - call buffer_patch%sdlng_mort_par%CopyFromDonor(copyPatch%sdlng_mort_par) - call buffer_patch%sdlng2sap_par%CopyFromDonor(copyPatch%sdlng2sap_par) - do pft = 1,numpft - call buffer_patch%sdlng_emerg_smp(pft)%p%CopyFromDonor(copyPatch%sdlng_emerg_smp(pft)%p) - call buffer_patch%sdlng_mdd(pft)%p%CopyFromDonor(copyPatch%sdlng_mdd(pft)%p) - enddo + ! figure out how may PFTs on each land use type. if only 1, then the next calculation is much simpler: we just need to know which PFT is allowed. + n_pfts_by_landuse = 0 + do i_pft = 1,numpft + if ( currentSite%area_pft(i_pft,i_land_use_label) .gt. nearzero) then + n_pfts_by_landuse = n_pfts_by_landuse + 1 + which_pft_allowed = i_pft end if - - currentPatch => currentSite%oldest_patch - do while(associated(currentPatch)) - if (currentPatch%changed_landuse_this_ts .and. currentPatch%land_use_label .eq. i_land_use_label) then + end do + if ( n_pfts_by_landuse .ne. 1) then + which_pft_allowed = fates_unset_int + endif - fraction_to_keep = (currentSite%area_pft(currentPatch%nocomp_pft_label,i_land_use_label) * sum(nocomp_pft_area_vector(:)) & - - nocomp_pft_area_vector_filled(currentPatch%nocomp_pft_label)) / currentPatch%area - - if (fraction_to_keep .le. nearzero) then - ! we don't want any patch area with this PFT identity at all anymore. Fuse it into the buffer patch. - currentPatch%nocomp_pft_label = 0 - previousPatch => currentPatch%older - call fuse_2_patches(currentSite, currentPatch, buffer_patch) - currentPatch => previousPatch - elseif (fraction_to_keep .le. (1._r8 - nearzero)) then - ! we have more patch are of this PFT than we want, but we do want to keep some of it. - ! we want to split the patch into two here. leave one patch as-is, and put the rest into the buffer patch. - - allocate(temp_patch) - call split_patch(currentSite, currentPatch, temp_patch, fraction_to_keep) - ! - temp_patch%nocomp_pft_label = 0 - call fuse_2_patches(currentSite, temp_patch, buffer_patch) - ! - nocomp_pft_area_vector_filled(currentPatch%nocomp_pft_label) = & - nocomp_pft_area_vector_filled(currentPatch%nocomp_pft_label) + currentPatch%area - currentPatch%changed_landuse_this_ts = .false. - else - ! we want to keep all of this patch (and possibly more) - nocomp_pft_area_vector_filled(currentPatch%nocomp_pft_label) = & - nocomp_pft_area_vector_filled(currentPatch%nocomp_pft_label) + currentPatch%area - currentPatch%changed_landuse_this_ts = .false. - endif + patch_area_to_reallocate_if: if ( sum(nocomp_pft_area_vector(:)) .gt. nearzero ) then + more_than_1_pft_to_handle_if: if ( n_pfts_by_landuse .ne. 1 ) then + ! create buffer patch to put all of the pieces carved off of other patches + allocate(buffer_patch) + + call buffer_patch%Create(0._r8, 0._r8, i_land_use_label, 0, & + hlm_numSWb, numpft, currentSite%nlevsoil, hlm_current_tod, & + regeneration_model) + + ! make a note that this buffer patch has not been put into the linked list + buffer_patch_in_linked_list = .false. + + ! Initialize the litter pools to zero + do el=1,num_elements + call buffer_patch%litter(el)%InitConditions(init_leaf_fines=0._r8, & + init_root_fines=0._r8, & + init_ag_cwd=0._r8, & + init_bg_cwd=0._r8, & + init_seed=0._r8, & + init_seed_germ=0._r8) + end do + buffer_patch%tallest => null() + buffer_patch%shortest => null() + + ! Copy any means or timers from the original patch to the new patch + ! These values will inherit all info from the original patch + ! -------------------------------------------------------------------------- + call buffer_patch%tveg24%CopyFromDonor(copyPatch%tveg24) + call buffer_patch%tveg_lpa%CopyFromDonor(copyPatch%tveg_lpa) + call buffer_patch%tveg_longterm%CopyFromDonor(copyPatch%tveg_longterm) + + if ( regeneration_model == TRS_regeneration ) then + call buffer_patch%seedling_layer_par24%CopyFromDonor(copyPatch%seedling_layer_par24) + call buffer_patch%sdlng_mort_par%CopyFromDonor(copyPatch%sdlng_mort_par) + call buffer_patch%sdlng2sap_par%CopyFromDonor(copyPatch%sdlng2sap_par) + do pft = 1,numpft + call buffer_patch%sdlng_emerg_smp(pft)%p%CopyFromDonor(copyPatch%sdlng_emerg_smp(pft)%p) + call buffer_patch%sdlng_mdd(pft)%p%CopyFromDonor(copyPatch%sdlng_mdd(pft)%p) + enddo + end if + + currentPatch => currentSite%oldest_patch + do while(associated(currentPatch)) + if (currentPatch%changed_landuse_this_ts .and. currentPatch%land_use_label .eq. i_land_use_label) then + + fraction_to_keep = (currentSite%area_pft(currentPatch%nocomp_pft_label,i_land_use_label) * sum(nocomp_pft_area_vector(:)) & + - nocomp_pft_area_vector_filled(currentPatch%nocomp_pft_label)) / currentPatch%area + + if (fraction_to_keep .lt. (-1._r8 * nearzero)) then + write(fates_log(),*) 'negative fraction_to_keep', fraction_to_keep + call endrun(msg=errMsg(sourcefile, __LINE__)) + endif + + if (fraction_to_keep .le. nearzero) then + ! we don't want any patch area with this PFT identity at all anymore. Fuse it into the buffer patch. + currentPatch%nocomp_pft_label = 0 + previousPatch => currentPatch%older + call fuse_2_patches(currentSite, currentPatch, buffer_patch) + currentPatch => previousPatch + elseif (fraction_to_keep .lt. 1._r8) then + ! we have more patch are of this PFT than we want, but we do want to keep some of it. + ! we want to split the patch into two here. leave one patch as-is, and put the rest into the buffer patch. + + allocate(temp_patch) + call split_patch(currentSite, currentPatch, temp_patch, fraction_to_keep) + ! + temp_patch%nocomp_pft_label = 0 + call fuse_2_patches(currentSite, temp_patch, buffer_patch) + ! + nocomp_pft_area_vector_filled(currentPatch%nocomp_pft_label) = & + nocomp_pft_area_vector_filled(currentPatch%nocomp_pft_label) + currentPatch%area + currentPatch%changed_landuse_this_ts = .false. + else + ! we want to keep all of this patch (and possibly more) + nocomp_pft_area_vector_filled(currentPatch%nocomp_pft_label) = & + nocomp_pft_area_vector_filled(currentPatch%nocomp_pft_label) + currentPatch%area + currentPatch%changed_landuse_this_ts = .false. + endif + end if + currentPatch => currentPatch%younger + end do + + ! at this point, lets check that the total patch area remaining to be relabelled equals what we think that it is. + tmp = 0._r8 + tmp2 = 0._r8 + currentPatch => currentSite%oldest_patch + do while(associated(currentPatch)) + tmp2 = tmp + currentPatch%area + if (currentPatch%changed_landuse_this_ts .and. currentPatch%land_use_label .eq. i_land_use_label) then + tmp = tmp + currentPatch%area + end if + currentPatch => currentPatch%younger + end do + if (abs(sum(nocomp_pft_area_vector(:)) - sum(nocomp_pft_area_vector_filled(:)) - tmp) .gt. rsnbl_math_prec) then + write(fates_log(),*) 'midway through patch reallocation and things are already not adding up.' + write(fates_log(),*) currentSite%area_pft(:,i_land_use_label) + write(fates_log(),*) '-----' + write(fates_log(),*) nocomp_pft_area_vector_filled + write(fates_log(),*) '-----' + write(fates_log(),*) nocomp_pft_area_vector + write(fates_log(),*) '-----' + write(fates_log(),*) tmp2, tmp2 + buffer_patch%area + write(fates_log(),*) buffer_patch%area, buffer_patch%land_use_label, buffer_patch%nocomp_pft_label + write(fates_log(),*) tmp, sum(nocomp_pft_area_vector(:)) - sum(nocomp_pft_area_vector_filled(:)) - tmp + currentPatch => currentSite%oldest_patch + do while(associated(currentPatch)) + write(fates_log(),*) currentPatch%area, currentPatch%land_use_label, currentPatch%nocomp_pft_label + currentPatch => currentPatch%younger + end do + call endrun(msg=errMsg(sourcefile, __LINE__)) end if - currentPatch => currentPatch%younger - end do - ! now we need to loop through the nocomp PFTs, and split the buffer patch into a set of patches to put back in the linked list - nocomp_pft_loop_2: do i_pft = 1, numpft - ! - if ( currentSite%area_pft(i_pft,i_land_use_label) .gt. nearzero) then + + ! now we need to loop through the nocomp PFTs, and split the buffer patch into a set of patches to put back in the linked list + nocomp_pft_loop_2: do i_pft = 1, numpft ! - if (nocomp_pft_area_vector_filled(i_pft) .lt. currentSite%area_pft(i_pft,i_land_use_label) * sum(nocomp_pft_area_vector(:))) then + if ( currentSite%area_pft(i_pft,i_land_use_label) .gt. nearzero) then ! - newp_area = currentSite%area_pft(i_pft,i_land_use_label) * sum(nocomp_pft_area_vector(:)) - nocomp_pft_area_vector_filled(i_pft) - ! - if (newp_area .lt. buffer_patch%area) then + if (nocomp_pft_area_vector_filled(i_pft) .lt. currentSite%area_pft(i_pft,i_land_use_label) * sum(nocomp_pft_area_vector(:))) then + ! + newp_area = currentSite%area_pft(i_pft,i_land_use_label) * sum(nocomp_pft_area_vector(:)) - nocomp_pft_area_vector_filled(i_pft) + ! + if (newp_area .lt. buffer_patch%area) then - ! split buffer patch in two, keeping the smaller buffer patch to put into new patches - allocate(temp_patch) - call split_patch(currentSite, buffer_patch, temp_patch, newp_area/buffer_patch%area) + ! split buffer patch in two, keeping the smaller buffer patch to put into new patches + allocate(temp_patch) + call split_patch(currentSite, buffer_patch, temp_patch, newp_area/buffer_patch%area) - ! give the new patch the intended nocomp PFT label - temp_patch%nocomp_pft_label = i_pft + ! give the new patch the intended nocomp PFT label + temp_patch%nocomp_pft_label = i_pft - ! track that we have added this patch area - nocomp_pft_area_vector_filled(i_pft) = nocomp_pft_area_vector_filled(i_pft) + temp_patch%area + ! track that we have added this patch area + nocomp_pft_area_vector_filled(i_pft) = nocomp_pft_area_vector_filled(i_pft) + temp_patch%area - ! put the new patch into the linked list - call InsertPatch(currentSite, temp_patch) + ! put the new patch into the linked list + call InsertPatch(currentSite, temp_patch) - ! now that the patch that temp_patch points to is in the site linked list, we want to null temp_patch so that it can be - ! refilled the next time through the loop. - temp_patch => null() + ! now that the patch that temp_patch points to is in the site linked list, we want to null temp_patch so that it can be + ! refilled the next time through the loop. + temp_patch => null() - else - ! give the buffer patch the intended nocomp PFT label - buffer_patch%nocomp_pft_label = i_pft + else + ! give the buffer patch the intended nocomp PFT label + buffer_patch%nocomp_pft_label = i_pft - ! track that we have added this patch area - nocomp_pft_area_vector_filled(i_pft) = nocomp_pft_area_vector_filled(i_pft) + buffer_patch%area + ! track that we have added this patch area + nocomp_pft_area_vector_filled(i_pft) = nocomp_pft_area_vector_filled(i_pft) + buffer_patch%area - ! put the buffer patch directly into the linked list - call InsertPatch(currentSite, buffer_patch) + ! put the buffer patch directly into the linked list + call InsertPatch(currentSite, buffer_patch) - buffer_patch_in_linked_list = .true. + buffer_patch_in_linked_list = .true. - end if + end if + end if end if + end do nocomp_pft_loop_2 + + ! now we want to make sure that either the buffer_patch either has zero area (presumably it was never used), in which case it should be deallocated, + ! or else it does have area but it has been put into the site linked list, and so buffer patch should be nulled before next pass through outer loop. + ! if either of those, that means everything worked properly, if not, then something has gone wrong. + if (buffer_patch_in_linked_list) then + buffer_patch => null() + else if (buffer_patch%area .lt. rsnbl_math_prec) then + ! here we need to deallocate the buffer patch so that we don't get a memory leak/ + call buffer_patch%FreeMemory(regeneration_model, numpft) + deallocate(buffer_patch, stat=istat, errmsg=smsg) + if (istat/=0) then + write(fates_log(),*) 'dealloc: fail on deallocate(dp):'//trim(smsg) + call endrun(msg=errMsg(sourcefile, __LINE__)) + endif + else + write(fates_log(),*) 'Buffer patch still has area and it wasnt put into the linked list' + write(fates_log(),*) 'buffer_patch%area', buffer_patch%area + call endrun(msg=errMsg(sourcefile, __LINE__)) end if - end do nocomp_pft_loop_2 - - ! now we want to make sure that either the buffer_patch either has zero area (presumably it was never used), in which case it should be deallocated, - ! or else it does have area but it has been put into the site linked list, and so buffer patch should be nulled before next pass through outer loop. - ! if either of those, that means everything worked properly, if not, then something has gone wrong. - if (buffer_patch_in_linked_list) then - buffer_patch => null() - else if (buffer_patch%area .lt. rsnbl_math_prec) then - ! here we need to deallocate the buffer patch so that we don't get a memory leak/ - call buffer_patch%FreeMemory(regeneration_model, numpft) - deallocate(buffer_patch, stat=istat, errmsg=smsg) - if (istat/=0) then - write(fates_log(),*) 'dealloc: fail on deallocate(dp):'//trim(smsg) + + ! check that the area we have added is the same as the area we have taken away. if not, crash. + if ( abs(sum(nocomp_pft_area_vector_filled(:)) - sum(nocomp_pft_area_vector(:))) .gt. rsnbl_math_prec) then + write(fates_log(),*) 'patch reallocation logic doesnt add up. difference is: ', sum(nocomp_pft_area_vector_filled(:)) - sum(nocomp_pft_area_vector(:)) + write(fates_log(),*) nocomp_pft_area_vector_filled + write(fates_log(),*) nocomp_pft_area_vector + write(fates_log(),*) i_land_use_label + currentPatch => currentSite%oldest_patch + do while(associated(currentPatch)) + write(fates_log(),*) currentPatch%area, currentPatch%land_use_label, currentPatch%nocomp_pft_label + currentPatch => currentPatch%younger + end do call endrun(msg=errMsg(sourcefile, __LINE__)) - endif + end if else - write(fates_log(),*) 'Buffer patch still has area and it wasnt put into the linked list' - write(fates_log(),*) 'buffer_patch%area', buffer_patch%area - call endrun(msg=errMsg(sourcefile, __LINE__)) - end if + ! if there is only one PFT allowed on this land use type, then all we need to do is relabel all of the patches that just changed + ! land use type and let patch fusion take care of the rest. + currentPatch => currentSite%oldest_patch + do while(associated(currentPatch)) + if (currentPatch%changed_landuse_this_ts .and. currentPatch%land_use_label .eq. i_land_use_label) then + currentPatch%nocomp_pft_label = which_pft_allowed + currentPatch%changed_landuse_this_ts = .false. + end if + currentPatch => currentPatch%younger + end do + endif more_than_1_pft_to_handle_if end if patch_area_to_reallocate_if + call check_patch_area(currentSite) end do lu_loop else ! if not using a configuration where the changed_landuse_this_ts is relevant, loop through all patches and reset it @@ -1555,7 +1635,7 @@ subroutine split_patch(currentSite, currentPatch, new_patch, fraction_to_keep) end if currentPatch%burnt_frac_litter(:) = 0._r8 - call TransLitterNewPatch( currentSite, currentPatch, new_patch, currentPatch%area * fraction_to_keep) + call TransLitterNewPatch( currentSite, currentPatch, new_patch, currentPatch%area * (1.-fraction_to_keep)) ! Next, we loop through the cohorts in the donor patch, copy them with ! area modified number density into the new-patch, and apply survivorship. @@ -1585,10 +1665,10 @@ subroutine split_patch(currentSite, currentPatch, new_patch, fraction_to_keep) call currentCohort%Copy(nc) ! Number of members in the new patch - nc%n = currentCohort%n * fraction_to_keep + nc%n = currentCohort%n * (1._r8 - fraction_to_keep) ! loss of individuals from source patch due to area shrinking - currentCohort%n = currentCohort%n * (1._r8 - fraction_to_keep) + currentCohort%n = currentCohort%n * fraction_to_keep storebigcohort => new_patch%tallest storesmallcohort => new_patch%shortest @@ -1620,7 +1700,7 @@ subroutine split_patch(currentSite, currentPatch, new_patch, fraction_to_keep) call sort_cohorts(currentPatch) !update area of donor patch - currentPatch%area = currentPatch%area * (1._r8 - fraction_to_keep) + currentPatch%area = currentPatch%area * fraction_to_keep end subroutine split_patch @@ -1669,6 +1749,13 @@ subroutine check_patch_area( currentSite ) if ( abs(areatot-area_site) > area_error_fail ) then write(fates_log(),*) 'Patch areas do not sum to 10000 within tolerance' write(fates_log(),*) 'Total area: ',areatot,'absolute error: ',areatot-area_site + + currentPatch => currentSite%oldest_patch + do while(associated(currentPatch)) + write(fates_log(),*) 'area, LU, PFT', currentPatch%area, currentPatch%land_use_label, currentPatch%nocomp_pft_label + currentPatch => currentPatch%younger + end do + call endrun(msg=errMsg(sourcefile, __LINE__)) end if @@ -3205,7 +3292,7 @@ subroutine fuse_2_patches(csite, dp, rp) call endrun(msg=errMsg(sourcefile, __LINE__)) endif - ! if neither youngerp nor olderp are associated, that means that the patch we are no longer tracking + ! if neither youngerp nor olderp are associated, that means that the patch we are fusing into ! is not part of the linked-list structure, and so no further action needs to be taken. if(associated(youngerp) .or. associated(olderp))then diff --git a/biogeochem/FatesLandUseChangeMod.F90 b/biogeochem/FatesLandUseChangeMod.F90 index 99f1b8a611..57c361e2e8 100644 --- a/biogeochem/FatesLandUseChangeMod.F90 +++ b/biogeochem/FatesLandUseChangeMod.F90 @@ -270,8 +270,8 @@ subroutine get_luh_statedata(bc_in, state_vector) ! check to ensure total area == 1, and correct if not if ( abs(sum(state_vector(:)) - 1._r8) .gt. nearzero ) then - write(fates_log(),*) 'warning: sum(state_vector) = ', sum(state_vector(:)) - state_vector = state_vector(:) / sum(state_vector(:)) + !write(fates_log(),*) 'warning: sum(state_vector) = ', sum(state_vector(:)) + state_vector(:) = state_vector(:) / sum(state_vector(:)) end if else state_vector(primaryland) = 1._r8 @@ -331,7 +331,9 @@ subroutine get_init_landuse_harvest_rate(bc_in, harvest_rate) call get_luh_statedata(bc_in, state_vector) - harvest_rate = state_vector(secondaryland) + if ( state_vector(secondaryland) .gt. 0.01) then + harvest_rate = state_vector(secondaryland) + endif end subroutine get_init_landuse_harvest_rate @@ -354,7 +356,9 @@ subroutine get_init_landuse_transition_rates(bc_in, landuse_transition_matrix) call get_luh_statedata(bc_in, state_vector) do i = secondaryland+1,n_landuse_cats - landuse_transition_matrix(1,i) = state_vector(i) + if ( state_vector(i) .gt. 0.01) then + landuse_transition_matrix(1,i) = state_vector(i) + end if end do end subroutine get_init_landuse_transition_rates diff --git a/main/EDInitMod.F90 b/main/EDInitMod.F90 index 34a73ffbc7..97d66dbe3a 100644 --- a/main/EDInitMod.F90 +++ b/main/EDInitMod.F90 @@ -93,6 +93,7 @@ module EDInitMod use DamageMainMod, only : undamaged_class use FatesInterfaceTypesMod , only : hlm_num_luh2_transitions use FatesConstantsMod, only : nocomp_bareground_land, nocomp_bareground + use FatesConstantsMod, only : min_nocomp_pftfrac_perlanduse use EdTypesMod, only : dump_site ! CIME GLOBALS @@ -514,8 +515,9 @@ subroutine set_site_properties( nsites, sites,bc_in ) do ft = 1,numpft ! remove tiny patches to prevent numerical errors in terminate patches - if(sites(s)%area_pft(ft, i_landusetype).lt.0.01_r8.and.sites(s)%area_pft(ft, i_landusetype).gt.nearzero)then - if(debug) write(fates_log(),*) 'removing small pft patches',s,ft,i_landusetype,sites(s)%area_pft(ft, i_landusetype) + if (sites(s)%area_pft(ft, i_landusetype) .lt. min_nocomp_pftfrac_perlanduse & + .and. sites(s)%area_pft(ft, i_landusetype) .gt. nearzero) then + if(debug) write(fates_log(),*) 'removing small numbers in site%area_pft',s,ft,i_landusetype,sites(s)%area_pft(ft, i_landusetype) sites(s)%area_pft(ft, i_landusetype)=0.0_r8 endif diff --git a/main/FatesConstantsMod.F90 b/main/FatesConstantsMod.F90 index cb778e4ba5..c33026630e 100644 --- a/main/FatesConstantsMod.F90 +++ b/main/FatesConstantsMod.F90 @@ -171,6 +171,9 @@ module FatesConstantsMod ! of magnitude of buffer error (ie instead of 1e-15) real(fates_r8), parameter, public :: rsnbl_math_prec = 1.0e-12_fates_r8 + ! in nocomp simulations, what is the minimum PFT fraction for any given land use type? + real(fates_r8), parameter, public :: min_nocomp_pftfrac_perlanduse = 0.01_fates_r8 + ! This is the precision of 8byte reals (~1e-308) real(fates_r8), parameter, public :: tinyr8 = tiny(1.0_fates_r8) diff --git a/main/FatesRestartInterfaceMod.F90 b/main/FatesRestartInterfaceMod.F90 index 259ed8c201..157c7261ae 100644 --- a/main/FatesRestartInterfaceMod.F90 +++ b/main/FatesRestartInterfaceMod.F90 @@ -3606,7 +3606,6 @@ subroutine get_restart_vectors(this, nc, nsites, sites) ! if needed, trigger the special procedure to initialize land use structure from a ! restart run that did not include land use. if (rio_landuse_config_si(io_idx_si) .eq. itrue .and. hlm_use_potentialveg .eq. ifalse) then - write(fates_log(),*), 'setting transition_landuse_from_off_to_on flag based on restart potentialveg value.' sites(s)%transition_landuse_from_off_to_on = .true. endif From cce0963e0702ad01bd986935a82fe2ea86682e0c Mon Sep 17 00:00:00 2001 From: Charles D Koven Date: Mon, 6 Nov 2023 16:24:59 -0800 Subject: [PATCH 042/112] i think maybe it works now? --- biogeochem/EDPatchDynamicsMod.F90 | 77 ++++++++++++++----------------- 1 file changed, 35 insertions(+), 42 deletions(-) diff --git a/biogeochem/EDPatchDynamicsMod.F90 b/biogeochem/EDPatchDynamicsMod.F90 index 88a5e9b6f6..033246aa11 100644 --- a/biogeochem/EDPatchDynamicsMod.F90 +++ b/biogeochem/EDPatchDynamicsMod.F90 @@ -503,7 +503,6 @@ subroutine spawn_patches( currentSite, bc_in) integer :: i_pft real(r8) :: newp_area logical :: buffer_patch_in_linked_list - real(r8) :: tmp, tmp2 integer :: n_pfts_by_landuse integer :: which_pft_allowed @@ -1314,8 +1313,6 @@ subroutine spawn_patches( currentSite, bc_in) end do nocomp_pft_loop nocomp_and_luh_if: if ( hlm_use_nocomp .eq. itrue .and. hlm_use_luh .eq. itrue ) then - ! CDK test nocomp_and_luh_if: if ( .false. ) then - ! disturbance has just happened, and now the nocomp PFT identities of the newly-disturbed patches ! need to be remapped to those associated with the new land use type. @@ -1404,21 +1401,26 @@ subroutine spawn_patches( currentSite, bc_in) if (fraction_to_keep .le. nearzero) then ! we don't want any patch area with this PFT identity at all anymore. Fuse it into the buffer patch. currentPatch%nocomp_pft_label = 0 - previousPatch => currentPatch%older + previousPatch => currentPatch%older + call fuse_2_patches(currentSite, currentPatch, buffer_patch) currentPatch => previousPatch + elseif (fraction_to_keep .lt. 1._r8) then ! we have more patch are of this PFT than we want, but we do want to keep some of it. ! we want to split the patch into two here. leave one patch as-is, and put the rest into the buffer patch. allocate(temp_patch) + call split_patch(currentSite, currentPatch, temp_patch, fraction_to_keep) ! temp_patch%nocomp_pft_label = 0 + call fuse_2_patches(currentSite, temp_patch, buffer_patch) ! nocomp_pft_area_vector_filled(currentPatch%nocomp_pft_label) = & nocomp_pft_area_vector_filled(currentPatch%nocomp_pft_label) + currentPatch%area + currentPatch%changed_landuse_this_ts = .false. else ! we want to keep all of this patch (and possibly more) @@ -1431,36 +1433,24 @@ subroutine spawn_patches( currentSite, bc_in) end do ! at this point, lets check that the total patch area remaining to be relabelled equals what we think that it is. - tmp = 0._r8 - tmp2 = 0._r8 - currentPatch => currentSite%oldest_patch - do while(associated(currentPatch)) - tmp2 = tmp + currentPatch%area - if (currentPatch%changed_landuse_this_ts .and. currentPatch%land_use_label .eq. i_land_use_label) then - tmp = tmp + currentPatch%area - end if - currentPatch => currentPatch%younger - end do - if (abs(sum(nocomp_pft_area_vector(:)) - sum(nocomp_pft_area_vector_filled(:)) - tmp) .gt. rsnbl_math_prec) then - write(fates_log(),*) 'midway through patch reallocation and things are already not adding up.' + if (abs(sum(nocomp_pft_area_vector(:)) - sum(nocomp_pft_area_vector_filled(:)) - buffer_patch%area) .gt. rsnbl_math_prec) then + write(fates_log(),*) 'midway through patch reallocation and things are already not adding up.', i_land_use_label write(fates_log(),*) currentSite%area_pft(:,i_land_use_label) write(fates_log(),*) '-----' write(fates_log(),*) nocomp_pft_area_vector_filled write(fates_log(),*) '-----' write(fates_log(),*) nocomp_pft_area_vector write(fates_log(),*) '-----' - write(fates_log(),*) tmp2, tmp2 + buffer_patch%area write(fates_log(),*) buffer_patch%area, buffer_patch%land_use_label, buffer_patch%nocomp_pft_label - write(fates_log(),*) tmp, sum(nocomp_pft_area_vector(:)) - sum(nocomp_pft_area_vector_filled(:)) - tmp currentPatch => currentSite%oldest_patch do while(associated(currentPatch)) write(fates_log(),*) currentPatch%area, currentPatch%land_use_label, currentPatch%nocomp_pft_label currentPatch => currentPatch%younger end do + call dump_site(currentSite) call endrun(msg=errMsg(sourcefile, __LINE__)) end if - ! now we need to loop through the nocomp PFTs, and split the buffer patch into a set of patches to put back in the linked list nocomp_pft_loop_2: do i_pft = 1, numpft ! @@ -1469,40 +1459,42 @@ subroutine spawn_patches( currentSite, bc_in) if (nocomp_pft_area_vector_filled(i_pft) .lt. currentSite%area_pft(i_pft,i_land_use_label) * sum(nocomp_pft_area_vector(:))) then ! newp_area = currentSite%area_pft(i_pft,i_land_use_label) * sum(nocomp_pft_area_vector(:)) - nocomp_pft_area_vector_filled(i_pft) - ! - if (newp_area .lt. buffer_patch%area) then + ! only bother doing this if the new new patch area needed is greater than some tiny amount + if ( newp_area .gt. rsnbl_math_prec) then + ! + if (buffer_patch%area - newp_area .gt. rsnbl_math_prec) then - ! split buffer patch in two, keeping the smaller buffer patch to put into new patches - allocate(temp_patch) - call split_patch(currentSite, buffer_patch, temp_patch, newp_area/buffer_patch%area) + ! split buffer patch in two, keeping the smaller buffer patch to put into new patches + allocate(temp_patch) - ! give the new patch the intended nocomp PFT label - temp_patch%nocomp_pft_label = i_pft + call split_patch(currentSite, buffer_patch, temp_patch, (1._r8 - newp_area/buffer_patch%area)) - ! track that we have added this patch area - nocomp_pft_area_vector_filled(i_pft) = nocomp_pft_area_vector_filled(i_pft) + temp_patch%area + ! give the new patch the intended nocomp PFT label + temp_patch%nocomp_pft_label = i_pft - ! put the new patch into the linked list - call InsertPatch(currentSite, temp_patch) + ! track that we have added this patch area + nocomp_pft_area_vector_filled(i_pft) = nocomp_pft_area_vector_filled(i_pft) + temp_patch%area - ! now that the patch that temp_patch points to is in the site linked list, we want to null temp_patch so that it can be - ! refilled the next time through the loop. - temp_patch => null() + ! put the new patch into the linked list + call InsertPatch(currentSite, temp_patch) - else - ! give the buffer patch the intended nocomp PFT label - buffer_patch%nocomp_pft_label = i_pft + ! now that the patch that temp_patch points to is in the site linked list, we want to null temp_patch so that it can be + ! refilled the next time through the loop. - ! track that we have added this patch area - nocomp_pft_area_vector_filled(i_pft) = nocomp_pft_area_vector_filled(i_pft) + buffer_patch%area + else + ! give the buffer patch the intended nocomp PFT label + buffer_patch%nocomp_pft_label = i_pft - ! put the buffer patch directly into the linked list - call InsertPatch(currentSite, buffer_patch) + ! track that we have added this patch area + nocomp_pft_area_vector_filled(i_pft) = nocomp_pft_area_vector_filled(i_pft) + buffer_patch%area - buffer_patch_in_linked_list = .true. + ! put the buffer patch directly into the linked list + call InsertPatch(currentSite, buffer_patch) - end if + buffer_patch_in_linked_list = .true. + end if + end if end if end if end do nocomp_pft_loop_2 @@ -1523,6 +1515,7 @@ subroutine spawn_patches( currentSite, bc_in) else write(fates_log(),*) 'Buffer patch still has area and it wasnt put into the linked list' write(fates_log(),*) 'buffer_patch%area', buffer_patch%area + write(fates_log(),*) sum(nocomp_pft_area_vector_filled(:)), sum(nocomp_pft_area_vector(:)) call endrun(msg=errMsg(sourcefile, __LINE__)) end if From 6e608d46cd007b7ae384a360527947ecf0644cca Mon Sep 17 00:00:00 2001 From: Charles D Koven Date: Wed, 8 Nov 2023 14:47:49 -0800 Subject: [PATCH 043/112] made the minimum land use fraction a named variable that depends on site-elvel baer ground fraction --- biogeochem/EDLoggingMortalityMod.F90 | 2 +- biogeochem/EDPatchDynamicsMod.F90 | 6 +++--- biogeochem/FatesLandUseChangeMod.F90 | 28 ++++++++++++++++++++-------- main/EDInitMod.F90 | 12 ++++++++++++ main/EDTypesMod.F90 | 1 + 5 files changed, 37 insertions(+), 12 deletions(-) diff --git a/biogeochem/EDLoggingMortalityMod.F90 b/biogeochem/EDLoggingMortalityMod.F90 index 6117dc49bf..63303b8bf7 100644 --- a/biogeochem/EDLoggingMortalityMod.F90 +++ b/biogeochem/EDLoggingMortalityMod.F90 @@ -349,7 +349,7 @@ subroutine LoggingMortality_frac( currentSite, bc_in, pft_i, dbh, canopy_layer, l_degrad = 0.0_r8 end if else - call get_init_landuse_harvest_rate(bc_in, harvest_rate) + call get_init_landuse_harvest_rate(bc_in, currentSite%min_allowed_landuse_fraction, harvest_rate) lmort_direct = harvest_rate lmort_collateral = 0.0_r8 lmort_infra = 0.0_r8 diff --git a/biogeochem/EDPatchDynamicsMod.F90 b/biogeochem/EDPatchDynamicsMod.F90 index 033246aa11..056523b46e 100644 --- a/biogeochem/EDPatchDynamicsMod.F90 +++ b/biogeochem/EDPatchDynamicsMod.F90 @@ -285,9 +285,9 @@ subroutine disturbance_rates( site_in, bc_in) if ( hlm_use_luh .eq. itrue ) then if(.not. site_in%transition_landuse_from_off_to_on) then - call get_landuse_transition_rates(bc_in, site_in%landuse_transition_matrix) + call get_landuse_transition_rates(bc_in, site_in%min_allowed_landuse_fraction, site_in%landuse_transition_matrix) else - call get_init_landuse_transition_rates(bc_in, site_in%landuse_transition_matrix) + call get_init_landuse_transition_rates(bc_in, site_in%min_allowed_landuse_fraction, site_in%landuse_transition_matrix) endif else site_in%landuse_transition_matrix(:,:) = 0._r8 @@ -380,7 +380,7 @@ subroutine disturbance_rates( site_in, bc_in) currentPatch%age_since_anthro_disturbance, harvest_rate) end if else - call get_init_landuse_harvest_rate(bc_in, harvest_rate) + call get_init_landuse_harvest_rate(bc_in, site_in%min_allowed_landuse_fraction, harvest_rate) endif currentPatch%disturbance_rates(dtype_ilog) = currentPatch%disturbance_rates(dtype_ilog) + & diff --git a/biogeochem/FatesLandUseChangeMod.F90 b/biogeochem/FatesLandUseChangeMod.F90 index 57c361e2e8..482367e92c 100644 --- a/biogeochem/FatesLandUseChangeMod.F90 +++ b/biogeochem/FatesLandUseChangeMod.F90 @@ -61,7 +61,7 @@ module FatesLandUseChangeMod contains ! ============================================================================ - subroutine get_landuse_transition_rates(bc_in, landuse_transition_matrix) + subroutine get_landuse_transition_rates(bc_in, min_allowed_landuse_fraction, landuse_transition_matrix) ! The purpose of this routine is to ingest the land use transition rate information that the host model has read in from a dataset, @@ -70,7 +70,8 @@ subroutine get_landuse_transition_rates(bc_in, landuse_transition_matrix) ! !ARGUMENTS: type(bc_in_type) , intent(in) :: bc_in - real(r8), intent(inout) :: landuse_transition_matrix(n_landuse_cats, n_landuse_cats) ! [m2/m2/day] + real(r8), intent(in) :: min_allowed_landuse_fraction + real(r8), intent(inout) :: landuse_transition_matrix(n_landuse_cats, n_landuse_cats) ! [m2/m2/day] ! !LOCAL VARIABLES: type(luh2_fates_lutype_map) :: lumap @@ -80,6 +81,8 @@ subroutine get_landuse_transition_rates(bc_in, landuse_transition_matrix) real(r8) :: urban_fraction real(r8) :: temp_vector(hlm_num_luh2_transitions) logical :: modified_flag + real(r8) :: state_vector(n_landuse_cats) ! [m2/m2] + integer :: i_lu ! zero the transition matrix and the urban fraction landuse_transition_matrix(:,:) = 0._r8 @@ -119,6 +122,13 @@ subroutine get_landuse_transition_rates(bc_in, landuse_transition_matrix) end if end do transitions_loop + ! zero all transitions where the state vector is less than the minimum allowed + call get_luh_statedata(bc_in, state_vector) + do i_lu = 1, n_landuse_cats + if ( state_vector(i_lu) .le. min_allowed_landuse_fraction) then + landuse_transition_matrix(:,i_lu) = 0._r8 + end if + end do end if end subroutine get_landuse_transition_rates @@ -315,7 +325,7 @@ subroutine CheckLUHData(luh_vector,modified_flag) end subroutine CheckLUHData - subroutine get_init_landuse_harvest_rate(bc_in, harvest_rate) + subroutine get_init_landuse_harvest_rate(bc_in, min_allowed_landuse_fraction, harvest_rate) ! the purpose of this subroutine is, only under the case where we are transitioning from a spinup run that did not have land use ! to a run that does, to apply the land-use changes needed to get to the state vector in a single daily instance. this is for @@ -324,20 +334,21 @@ subroutine get_init_landuse_harvest_rate(bc_in, harvest_rate) ! !ARGUMENTS: type(bc_in_type) , intent(in) :: bc_in - real(r8), intent(out) :: harvest_rate ! [m2/ m2 / day] + real(r8), intent(in) :: min_allowed_landuse_fraction + real(r8), intent(out) :: harvest_rate ! [m2/ m2 / day] ! LOCALS real(r8) :: state_vector(n_landuse_cats) ! [m2/m2] call get_luh_statedata(bc_in, state_vector) - if ( state_vector(secondaryland) .gt. 0.01) then + if ( state_vector(secondaryland) .gt. min_allowed_landuse_fraction) then harvest_rate = state_vector(secondaryland) endif end subroutine get_init_landuse_harvest_rate - subroutine get_init_landuse_transition_rates(bc_in, landuse_transition_matrix) + subroutine get_init_landuse_transition_rates(bc_in, min_allowed_landuse_fraction, landuse_transition_matrix) ! The purose of this subroutine is, only under the case where we are transitioning from a spinup run that did not have land use ! to a run that does, to apply the land-use changes needed to get to the state vector in a single daily instance. this is for @@ -345,7 +356,8 @@ subroutine get_init_landuse_transition_rates(bc_in, landuse_transition_matrix) ! !ARGUMENTS: type(bc_in_type) , intent(in) :: bc_in - real(r8), intent(inout) :: landuse_transition_matrix(n_landuse_cats, n_landuse_cats) ! [m2/m2/day] + real(r8), intent(in) :: min_allowed_landuse_fraction + real(r8), intent(inout) :: landuse_transition_matrix(n_landuse_cats, n_landuse_cats) ! [m2/m2/day] ! LOCALS real(r8) :: state_vector(n_landuse_cats) ! [m2/m2] @@ -356,7 +368,7 @@ subroutine get_init_landuse_transition_rates(bc_in, landuse_transition_matrix) call get_luh_statedata(bc_in, state_vector) do i = secondaryland+1,n_landuse_cats - if ( state_vector(i) .gt. 0.01) then + if ( state_vector(i) .gt. min_allowed_landuse_fraction) then landuse_transition_matrix(1,i) = state_vector(i) end if end do diff --git a/main/EDInitMod.F90 b/main/EDInitMod.F90 index 97d66dbe3a..c6ee791dc5 100644 --- a/main/EDInitMod.F90 +++ b/main/EDInitMod.F90 @@ -588,6 +588,18 @@ subroutine set_site_properties( nsites, sites,bc_in ) end do !site loop end if !restart + ! need to set the minimum amount of allowable land-use fraction on a given site. this is a function of the minimum allowable patch size, + ! and for nocomp simulations also the bare ground fraction and the minimum pft fraction for a given land-use type. + if (hlm_use_nocomp .eq. itrue ) then + if ( sites(s)%area_bareground .gt. nearzero) then + sites(s)%min_allowed_landuse_fraction = min_patch_area_forced / (AREA * min_nocomp_pftfrac_perlanduse * (1._r8 - sites(s)%area_bareground)) + else + ! if all bare ground, shouldn't matter. but make it one anyway to really ignore land use (which should all be NaNs anyway) + sites(s)%min_allowed_landuse_fraction = 1._r8 + endif + else + sites(s)%min_allowed_landuse_fraction = min_patch_area_forced / AREA + endif return end subroutine set_site_properties diff --git a/main/EDTypesMod.F90 b/main/EDTypesMod.F90 index 1617ee3b41..c0c49d1619 100644 --- a/main/EDTypesMod.F90 +++ b/main/EDTypesMod.F90 @@ -429,6 +429,7 @@ module EDTypesMod real(r8) :: primary_land_patchfusion_error ! error term in total area of primary patches associated with patch fusion [m2/m2/day] real(r8) :: landuse_transition_matrix(n_landuse_cats, n_landuse_cats) ! land use transition matrix as read in from HLM and aggregated to FATES land use types [m2/m2/year] + real(r8) :: min_allowed_landuse_fraction ! minimum amount of land-use type below which the resulting patches would be too small [m2/m2] logical :: transition_landuse_from_off_to_on ! special flag to use only when reading restarts, which triggers procedure to initialize land use end type ed_site_type From 9574a1c6ed89b199d5f09b64abcf6c17c708cbc3 Mon Sep 17 00:00:00 2001 From: Charles D Koven Date: Wed, 8 Nov 2023 16:46:04 -0800 Subject: [PATCH 044/112] added new parameter fates_max_nocomp_pfts_by_landuse and using instead of just fates_maxpatches_by_landuse --- main/EDInitMod.F90 | 6 +++--- main/EDParamsMod.F90 | 12 ++++++++++++ main/EDPftvarcon.F90 | 19 +++++++++++++++++++ parameter_files/fates_params_default.cdl | 7 ++++++- 4 files changed, 40 insertions(+), 4 deletions(-) diff --git a/main/EDInitMod.F90 b/main/EDInitMod.F90 index c6ee791dc5..48d2f84ac5 100644 --- a/main/EDInitMod.F90 +++ b/main/EDInitMod.F90 @@ -358,7 +358,7 @@ subroutine set_site_properties( nsites, sites,bc_in ) ! ! !USES: use EDParamsMod, only : crop_lu_pft_vector - use EDParamsMod, only : maxpatches_by_landuse + use EDParamsMod, only : max_nocomp_pfts_by_landuse ! ! !ARGUMENTS @@ -535,14 +535,14 @@ subroutine set_site_properties( nsites, sites,bc_in ) if (hlm_use_nocomp .eq. itrue) then do i_landusetype = 1, n_landuse_cats ! count how many PFTs have areas greater than zero and compare to the number of patches allowed - if (COUNT(sites(s)%area_pft(:, i_landusetype) .gt. 0._r8) > maxpatches_by_landuse(i_landusetype)) then + if (COUNT(sites(s)%area_pft(:, i_landusetype) .gt. 0._r8) > max_nocomp_pfts_by_landuse(i_landusetype)) then ! write current vector to log file if(debug) write(fates_log(),*) 'too many PFTs for LU type ', i_landusetype, sites(s)%area_pft(:, i_landusetype) ! start from largest area, put that PFT's area into a temp vector, and then work down to successively smaller-area PFTs, ! at the end replace the original vector with the temp vector temp_vec(:) = 0._r8 - do i_pftcount = 1, maxpatches_by_landuse(i_landusetype) + do i_pftcount = 1, max_nocomp_pfts_by_landuse(i_landusetype) temp_vec(MAXLOC(sites(s)%area_pft(:, i_landusetype))) = & sites(s)%area_pft(MAXLOC(sites(s)%area_pft(:, i_landusetype)), i_landusetype) sites(s)%area_pft(MAXLOC(sites(s)%area_pft(:, i_landusetype)), i_landusetype) = 0._r8 diff --git a/main/EDParamsMod.F90 b/main/EDParamsMod.F90 index 415059681e..7732327a1d 100644 --- a/main/EDParamsMod.F90 +++ b/main/EDParamsMod.F90 @@ -200,6 +200,7 @@ module EDParamsMod character(len=param_string_length),parameter,public :: ED_name_history_damage_bin_edges = "fates_history_damage_bin_edges" character(len=param_string_length),parameter,public :: ED_name_crop_lu_pft_vector = "fates_landuse_crop_lu_pft_vector" character(len=param_string_length),parameter,public :: ED_name_maxpatches_by_landuse = "fates_maxpatches_by_landuse" + character(len=param_string_length),parameter,public :: ED_name_max_nocomp_pfts_by_landuse = "fates_max_nocomp_pfts_by_landuse" ! Hydraulics Control Parameters (ONLY RELEVANT WHEN USE_FATES_HYDR = TRUE) ! ---------------------------------------------------------------------------------------------- @@ -253,6 +254,7 @@ module EDParamsMod ! thus they are not protected here. integer, public :: maxpatches_by_landuse(n_landuse_cats) + integer, public :: max_nocomp_pfts_by_landuse(n_landuse_cats) integer, public :: maxpatch_total ! which crops can be grown on a given crop land use type @@ -610,6 +612,9 @@ subroutine FatesRegisterParams(fates_params) call fates_params%RegisterParameter(name=ED_name_maxpatches_by_landuse, dimension_shape=dimension_shape_1d, & dimension_names=dim_names_landuse) + call fates_params%RegisterParameter(name=ED_name_max_nocomp_pfts_by_landuse, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names_landuse) + end subroutine FatesRegisterParams @@ -627,6 +632,7 @@ subroutine FatesReceiveParams(fates_params) real(r8), allocatable :: hydr_htftype_real(:) real(r8), allocatable :: tmp_vector_by_landuse1(:) ! local real vector for changing type on read real(r8), allocatable :: tmp_vector_by_landuse2(:) ! local real vector for changing type on read + real(r8), allocatable :: tmp_vector_by_landuse3(:) ! local real vector for changing type on read call fates_params%RetrieveParameter(name=ED_name_photo_temp_acclim_timescale, & data=photo_temp_acclim_timescale) @@ -842,6 +848,12 @@ subroutine FatesReceiveParams(fates_params) maxpatch_total = sum(maxpatches_by_landuse(:)) deallocate(tmp_vector_by_landuse2) + call fates_params%RetrieveParameterAllocate(name=ED_name_max_nocomp_pfts_by_landuse, & + data=tmp_vector_by_landuse3) + + max_nocomp_pfts_by_landuse(:) = nint(tmp_vector_by_landuse3(:)) + deallocate(tmp_vector_by_landuse3) + call fates_params%RetrieveParameterAllocate(name=ED_name_hydr_htftype_node, & data=hydr_htftype_real) allocate(hydr_htftype_node(size(hydr_htftype_real))) diff --git a/main/EDPftvarcon.F90 b/main/EDPftvarcon.F90 index 26d1e03d6b..72e0975a21 100644 --- a/main/EDPftvarcon.F90 +++ b/main/EDPftvarcon.F90 @@ -1759,6 +1759,9 @@ subroutine FatesCheckParams(is_master) use EDParamsMod , only : radiation_model use FatesInterfaceTypesMod, only : hlm_use_fixed_biogeog,hlm_use_sp, hlm_name use FatesInterfaceTypesMod, only : hlm_use_inventory_init + use FatesInterfaceTypesMod, only : hlm_use_nocomp + use EDParamsMod , only : max_nocomp_pfts_by_landuse, maxpatches_by_landuse + use FatesConstantsMod , only : n_landuse_cats ! Argument logical, intent(in) :: is_master ! Only log if this is the master proc @@ -1772,6 +1775,7 @@ subroutine FatesCheckParams(is_master) integer :: norgans ! size of the plant organ dimension integer :: hlm_pft ! used in fixed biogeog mode integer :: fates_pft ! used in fixed biogeog mode + integer :: i_lu ! land use index real(r8) :: sumarea ! area of PFTs in nocomp mode. @@ -2068,6 +2072,21 @@ subroutine FatesCheckParams(is_master) end do !ipft + ! if nocomp is enabled, check to make sure the max number of nocomp PFTs per land use is + ! less than or equal to the max number of patches per land use. + if ( hlm_use_nocomp .eq. itrue ) then + do i_lu = 1, n_landuse_cats + if (max_nocomp_pfts_by_landuse(i_lu) .gt. maxpatches_by_landuse(i_lu)) then + write(fates_log(),*) 'The max number of nocomp PFTs must all be less than or equal to the number of patches, for a given land use type' + write(fates_log(),*) 'land use index:',i_lu + write(fates_log(),*) 'max_nocomp_pfts_by_landuse(i_lu):', max_nocomp_pfts_by_landuse(i_lu) + write(fates_log(),*) 'maxpatches_by_landuse(i_lu):', maxpatches_by_landuse(i_lu) + write(fates_log(),*) 'Aborting' + call endrun(msg=errMsg(sourcefile, __LINE__)) + end if + end do + endif + !! ! Checks for HYDRO !! if( hlm_use_planthydro == itrue ) then !! diff --git a/parameter_files/fates_params_default.cdl b/parameter_files/fates_params_default.cdl index 48b46660c5..68d22bd0c6 100644 --- a/parameter_files/fates_params_default.cdl +++ b/parameter_files/fates_params_default.cdl @@ -687,6 +687,9 @@ variables: double fates_landuse_crop_lu_pft_vector(fates_landuseclass) ; fates_landuse_crop_lu_pft_vector:units = "NA" ; fates_landuse_crop_lu_pft_vector:long_name = "What FATES PFT index to use on a given crop land-use type? (dummy value of -999 for non-crop types)" ; + double fates_max_nocomp_pfts_by_landuse(fates_landuseclass) ; + fates_max_nocomp_pfts_by_landuse:units = "count" ; + fates_max_nocomp_pfts_by_landuse:long_name = "maximum number of nocomp PFTs on each land use type (only used in nocomp mode)" ; double fates_maxpatches_by_landuse(fates_landuseclass) ; fates_maxpatches_by_landuse:units = "count" ; fates_maxpatches_by_landuse:long_name = "maximum number of patches per site on each land use type" ; @@ -1623,7 +1626,9 @@ data: fates_landuse_crop_lu_pft_vector = -999, -999, -999, -999, 11 ; - fates_maxpatches_by_landuse = 10, 4, 1, 1, 1 ; + fates_max_nocomp_pfts_by_landuse = 4, 4, 2, 2, 1 ; + + fates_maxpatches_by_landuse = 10, 6, 2, 2, 1 ; fates_canopy_closure_thresh = 0.8 ; From 5a6c0bd43e1c236cb75d3b0509a37ebca584e95b Mon Sep 17 00:00:00 2001 From: Charles D Koven Date: Wed, 8 Nov 2023 21:47:37 -0800 Subject: [PATCH 045/112] bugfix --- main/EDInitMod.F90 | 26 ++++++++++++++------------ 1 file changed, 14 insertions(+), 12 deletions(-) diff --git a/main/EDInitMod.F90 b/main/EDInitMod.F90 index 48d2f84ac5..3efd6fe68e 100644 --- a/main/EDInitMod.F90 +++ b/main/EDInitMod.F90 @@ -585,21 +585,23 @@ subroutine set_site_properties( nsites, sites,bc_in ) end if !area end if !SBG end do !ft + + ! need to set the minimum amount of allowable land-use fraction on a given site. this is a function of the minimum allowable patch size, + ! and for nocomp simulations also the bare ground fraction and the minimum pft fraction for a given land-use type. + if (hlm_use_nocomp .eq. itrue ) then + if ( (1._r8 - sites(s)%area_bareground) .gt. nearzero) then + sites(s)%min_allowed_landuse_fraction = min_patch_area_forced / (AREA * min_nocomp_pftfrac_perlanduse * (1._r8 - sites(s)%area_bareground)) + else + ! if all bare ground, shouldn't matter. but make it one anyway to really ignore land use (which should all be NaNs anyway) + sites(s)%min_allowed_landuse_fraction = 1._r8 + endif + else + sites(s)%min_allowed_landuse_fraction = min_patch_area_forced / AREA + endif + end do !site loop end if !restart - ! need to set the minimum amount of allowable land-use fraction on a given site. this is a function of the minimum allowable patch size, - ! and for nocomp simulations also the bare ground fraction and the minimum pft fraction for a given land-use type. - if (hlm_use_nocomp .eq. itrue ) then - if ( sites(s)%area_bareground .gt. nearzero) then - sites(s)%min_allowed_landuse_fraction = min_patch_area_forced / (AREA * min_nocomp_pftfrac_perlanduse * (1._r8 - sites(s)%area_bareground)) - else - ! if all bare ground, shouldn't matter. but make it one anyway to really ignore land use (which should all be NaNs anyway) - sites(s)%min_allowed_landuse_fraction = 1._r8 - endif - else - sites(s)%min_allowed_landuse_fraction = min_patch_area_forced / AREA - endif return end subroutine set_site_properties From d7d989e182dca4dfcf5812438c19a7e672a21300 Mon Sep 17 00:00:00 2001 From: Charles D Koven Date: Thu, 9 Nov 2023 09:44:20 -0800 Subject: [PATCH 046/112] adding min_allowed_landuse_fraction to restart files, and other error diagnostics --- biogeochem/EDPatchDynamicsMod.F90 | 12 ++++++++++-- biogeochem/FatesLandUseChangeMod.F90 | 16 +++++++++++----- main/EDMainMod.F90 | 2 +- main/FatesRestartInterfaceMod.F90 | 9 +++++++++ 4 files changed, 31 insertions(+), 8 deletions(-) diff --git a/biogeochem/EDPatchDynamicsMod.F90 b/biogeochem/EDPatchDynamicsMod.F90 index 056523b46e..c45501dcff 100644 --- a/biogeochem/EDPatchDynamicsMod.F90 +++ b/biogeochem/EDPatchDynamicsMod.F90 @@ -86,6 +86,7 @@ module EDPatchDynamicsMod use FatesConstantsMod , only : n_landuse_cats use FatesLandUseChangeMod, only : get_landuse_transition_rates use FatesLandUseChangeMod, only : get_init_landuse_transition_rates + use FatesLandUseChangeMod, only : get_luh_statedata use FatesConstantsMod , only : fates_unset_r8 use FatesConstantsMod , only : fates_unset_int use FatesConstantsMod , only : hlm_harvest_carbon @@ -3317,7 +3318,7 @@ end subroutine fuse_2_patches ! ============================================================================ - subroutine terminate_patches(currentSite) + subroutine terminate_patches(currentSite, bc_in) ! ! !DESCRIPTION: ! Terminate Patches if they are too small @@ -3325,6 +3326,7 @@ subroutine terminate_patches(currentSite) ! ! !ARGUMENTS: type(ed_site_type), target, intent(inout) :: currentSite + type(bc_in_type), intent(in) :: bc_in ! ! !LOCAL VARIABLES: type(fates_patch_type), pointer :: currentPatch @@ -3338,7 +3340,8 @@ subroutine terminate_patches(currentSite) logical :: current_patch_is_youngest_lutype integer :: i_landuse, i_pft - real(r8) areatot ! variable for checking whether the total patch area is wrong. + real(r8) areatot ! variable for checking whether the total patch area is wrong. + real(r8) :: state_vector(n_landuse_cats) ! [m2/m2] !--------------------------------------------------------------------- ! Initialize the count cycles @@ -3491,6 +3494,11 @@ subroutine terminate_patches(currentSite) write(fates_log(),*) patchpointer%area, patchpointer%nocomp_pft_label, patchpointer%land_use_label patchpointer => patchpointer%older end do + call get_current_landuse_statevector(currentSite, state_vector) + write(fates_log(),*) 'current landuse state vector: ', state_vector + call get_luh_statedata(bc_in, state_vector) + write(fates_log(),*) 'driver data landuse state vector: ', state_vector + write(fates_log(),*) 'min_allowed_landuse_fraction: ', currentSite%min_allowed_landuse_fraction call endrun(msg=errMsg(sourcefile, __LINE__)) ! Note to user. If you DO decide to remove the end-run above this line diff --git a/biogeochem/FatesLandUseChangeMod.F90 b/biogeochem/FatesLandUseChangeMod.F90 index 482367e92c..04df7ebf8d 100644 --- a/biogeochem/FatesLandUseChangeMod.F90 +++ b/biogeochem/FatesLandUseChangeMod.F90 @@ -278,11 +278,17 @@ subroutine get_luh_statedata(bc_in, state_vector) end if end do - ! check to ensure total area == 1, and correct if not - if ( abs(sum(state_vector(:)) - 1._r8) .gt. nearzero ) then - !write(fates_log(),*) 'warning: sum(state_vector) = ', sum(state_vector(:)) - state_vector(:) = state_vector(:) / sum(state_vector(:)) - end if + ! if all zeros, make all primary lands + if ( sum(state_vector(:)) .gt. nearzero ) then + + ! check to ensure total area == 1, and correct if not + if ( abs(sum(state_vector(:)) - 1._r8) .gt. nearzero ) then + !write(fates_log(),*) 'warning: sum(state_vector) = ', sum(state_vector(:)) + state_vector(:) = state_vector(:) / sum(state_vector(:)) + end if + else + state_vector(primaryland) = 1._r8 + endif else state_vector(primaryland) = 1._r8 end if diff --git a/main/EDMainMod.F90 b/main/EDMainMod.F90 index edb9241dd1..f37f764da9 100644 --- a/main/EDMainMod.F90 +++ b/main/EDMainMod.F90 @@ -314,7 +314,7 @@ subroutine ed_ecosystem_dynamics(currentSite, bc_in, bc_out) call TotalBalanceCheck(currentSite,4) ! kill patches that are too small - call terminate_patches(currentSite) + call terminate_patches(currentSite, bc_in) end if call TotalBalanceCheck(currentSite,5) diff --git a/main/FatesRestartInterfaceMod.F90 b/main/FatesRestartInterfaceMod.F90 index 157c7261ae..08bf3e07f5 100644 --- a/main/FatesRestartInterfaceMod.F90 +++ b/main/FatesRestartInterfaceMod.F90 @@ -99,6 +99,7 @@ module FatesRestartInterfaceMod integer :: ir_phenmodeldate_si integer :: ir_acc_ni_si integer :: ir_gdd_si + integer :: ir_min_allowed_landuse_fraction_si integer :: ir_snow_depth_si integer :: ir_trunk_product_si integer :: ir_landuse_config_si @@ -702,6 +703,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_min_allowed_landuse_fraction_site', vtype=site_r8, & + long_name='minimum allowed land use fraction at each site', units='degC days', flushval = flushzero, & + hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_min_allowed_landuse_fraction_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 ) @@ -2011,6 +2016,7 @@ subroutine set_restart_vectors(this,nc,nsites,sites) rio_phenmodeldate_si => this%rvars(ir_phenmodeldate_si)%int1d, & rio_acc_ni_si => this%rvars(ir_acc_ni_si)%r81d, & rio_gdd_si => this%rvars(ir_gdd_si)%r81d, & + rio_min_allowed_landuse_fraction_si => this%rvars(ir_min_allowed_landuse_fraction_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_landuse_config_s => this%rvars(ir_landuse_config_si)%int1d, & @@ -2602,6 +2608,7 @@ subroutine set_restart_vectors(this,nc,nsites,sites) rio_cndaysleafon_si(io_idx_si) = sites(s)%cndaysleafon rio_cndaysleafoff_si(io_idx_si) = sites(s)%cndaysleafoff rio_gdd_si(io_idx_si) = sites(s)%grow_deg_days + rio_min_allowed_landuse_fraction_si(io_idx_si) = sites(s)%min_allowed_landuse_fraction rio_phenmodeldate_si(io_idx_si) = sites(s)%phen_model_date @@ -2976,6 +2983,7 @@ subroutine get_restart_vectors(this, nc, nsites, sites) rio_phenmodeldate_si => this%rvars(ir_phenmodeldate_si)%int1d, & rio_acc_ni_si => this%rvars(ir_acc_ni_si)%r81d, & rio_gdd_si => this%rvars(ir_gdd_si)%r81d, & + rio_min_allowed_landuse_fraction_si => this%rvars(ir_min_allowed_landuse_fraction_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_landuse_config_si => this%rvars(ir_landuse_config_si)%int1d, & @@ -3595,6 +3603,7 @@ subroutine get_restart_vectors(this, nc, nsites, sites) sites(s)%cndaysleafon = rio_cndaysleafon_si(io_idx_si) sites(s)%cndaysleafoff = rio_cndaysleafoff_si(io_idx_si) sites(s)%grow_deg_days = rio_gdd_si(io_idx_si) + sites(s)%min_allowed_landuse_fraction = rio_min_allowed_landuse_fraction_si(io_idx_si) sites(s)%phen_model_date= rio_phenmodeldate_si(io_idx_si) From 7d79def33b9dea056d62fd99afa8a6e00ff2f6ba Mon Sep 17 00:00:00 2001 From: Charles D Koven Date: Thu, 9 Nov 2023 12:03:31 -0800 Subject: [PATCH 047/112] one bugfix and one temporary change to turn off all disturbance to secodnary lands --- biogeochem/EDPatchDynamicsMod.F90 | 3 ++- biogeochem/FatesLandUseChangeMod.F90 | 6 ++++-- 2 files changed, 6 insertions(+), 3 deletions(-) diff --git a/biogeochem/EDPatchDynamicsMod.F90 b/biogeochem/EDPatchDynamicsMod.F90 index c45501dcff..dcccbbe94e 100644 --- a/biogeochem/EDPatchDynamicsMod.F90 +++ b/biogeochem/EDPatchDynamicsMod.F90 @@ -365,6 +365,7 @@ subroutine disturbance_rates( site_in, bc_in) ! for non-closed-canopy areas subject to logging, add an additional increment of area disturbed ! equivalent to the fraction logged to account for transfer of interstitial ground area to new secondary lands + ! if ( (logging_time .or. site_in%transition_landuse_from_off_to_on) .and. & if ( logging_time .and. & (currentPatch%area - currentPatch%total_canopy_area) .gt. fates_tiny ) then ! The canopy is NOT closed. @@ -1394,7 +1395,7 @@ subroutine spawn_patches( currentSite, bc_in) fraction_to_keep = (currentSite%area_pft(currentPatch%nocomp_pft_label,i_land_use_label) * sum(nocomp_pft_area_vector(:)) & - nocomp_pft_area_vector_filled(currentPatch%nocomp_pft_label)) / currentPatch%area - if (fraction_to_keep .lt. (-1._r8 * nearzero)) then + if (fraction_to_keep .lt. (-1._r8 * rsnbl_math_prec)) then write(fates_log(),*) 'negative fraction_to_keep', fraction_to_keep call endrun(msg=errMsg(sourcefile, __LINE__)) endif diff --git a/biogeochem/FatesLandUseChangeMod.F90 b/biogeochem/FatesLandUseChangeMod.F90 index 04df7ebf8d..cc91ca11da 100644 --- a/biogeochem/FatesLandUseChangeMod.F90 +++ b/biogeochem/FatesLandUseChangeMod.F90 @@ -125,7 +125,7 @@ subroutine get_landuse_transition_rates(bc_in, min_allowed_landuse_fraction, lan ! zero all transitions where the state vector is less than the minimum allowed call get_luh_statedata(bc_in, state_vector) do i_lu = 1, n_landuse_cats - if ( state_vector(i_lu) .le. min_allowed_landuse_fraction) then + if ( state_vector(i_lu) .le. min_allowed_landuse_fraction .or. i_lu .eq. secondaryland) then !!!!!!!!!!!!!!!!!!!!!!!!!!!!!! CDK DEBUG landuse_transition_matrix(:,i_lu) = 0._r8 end if end do @@ -351,7 +351,9 @@ subroutine get_init_landuse_harvest_rate(bc_in, min_allowed_landuse_fraction, ha if ( state_vector(secondaryland) .gt. min_allowed_landuse_fraction) then harvest_rate = state_vector(secondaryland) endif - + +!!!!!!!!!!!!!!!!!!!! CDKCDK + harvest_rate = 0._r8 end subroutine get_init_landuse_harvest_rate subroutine get_init_landuse_transition_rates(bc_in, min_allowed_landuse_fraction, landuse_transition_matrix) From 8afbe4856be9cde34150d463fb7efee2568cc98b Mon Sep 17 00:00:00 2001 From: Charles D Koven Date: Thu, 9 Nov 2023 12:16:53 -0800 Subject: [PATCH 048/112] better bugfix --- biogeochem/EDPatchDynamicsMod.F90 | 5 ----- 1 file changed, 5 deletions(-) diff --git a/biogeochem/EDPatchDynamicsMod.F90 b/biogeochem/EDPatchDynamicsMod.F90 index dcccbbe94e..24c7fdb9af 100644 --- a/biogeochem/EDPatchDynamicsMod.F90 +++ b/biogeochem/EDPatchDynamicsMod.F90 @@ -1395,11 +1395,6 @@ subroutine spawn_patches( currentSite, bc_in) fraction_to_keep = (currentSite%area_pft(currentPatch%nocomp_pft_label,i_land_use_label) * sum(nocomp_pft_area_vector(:)) & - nocomp_pft_area_vector_filled(currentPatch%nocomp_pft_label)) / currentPatch%area - if (fraction_to_keep .lt. (-1._r8 * rsnbl_math_prec)) then - write(fates_log(),*) 'negative fraction_to_keep', fraction_to_keep - call endrun(msg=errMsg(sourcefile, __LINE__)) - endif - if (fraction_to_keep .le. nearzero) then ! we don't want any patch area with this PFT identity at all anymore. Fuse it into the buffer patch. currentPatch%nocomp_pft_label = 0 From f8fe5ff062f54dad37c2d690176c5ab0214ce408 Mon Sep 17 00:00:00 2001 From: Charles D Koven Date: Thu, 9 Nov 2023 14:35:48 -0800 Subject: [PATCH 049/112] added restart for site%bareground --- main/FatesRestartInterfaceMod.F90 | 17 ++++++++++++----- 1 file changed, 12 insertions(+), 5 deletions(-) diff --git a/main/FatesRestartInterfaceMod.F90 b/main/FatesRestartInterfaceMod.F90 index 08bf3e07f5..28eaa652fe 100644 --- a/main/FatesRestartInterfaceMod.F90 +++ b/main/FatesRestartInterfaceMod.F90 @@ -100,6 +100,7 @@ module FatesRestartInterfaceMod integer :: ir_acc_ni_si integer :: ir_gdd_si integer :: ir_min_allowed_landuse_fraction_si + integer :: ir_area_bareground_si integer :: ir_snow_depth_si integer :: ir_trunk_product_si integer :: ir_landuse_config_si @@ -707,6 +708,10 @@ subroutine define_restart_vars(this, initialize_variables) long_name='minimum allowed land use fraction at each site', units='degC days', flushval = flushzero, & hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_min_allowed_landuse_fraction_si ) + call this%set_restart_var(vname='fates_area_bareground_site', vtype=site_r8, & + long_name='minimum allowed land use fraction at each site', units='degC days', flushval = flushzero, & + hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_area_bareground_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 ) @@ -2016,7 +2021,8 @@ subroutine set_restart_vectors(this,nc,nsites,sites) rio_phenmodeldate_si => this%rvars(ir_phenmodeldate_si)%int1d, & rio_acc_ni_si => this%rvars(ir_acc_ni_si)%r81d, & rio_gdd_si => this%rvars(ir_gdd_si)%r81d, & - rio_min_allowed_landuse_fraction_si => this%rvars(ir_min_allowed_landuse_fraction_si)%r81d, & + rio_min_allowed_landuse_fraction_si => this%rvars(ir_min_allowed_landuse_fraction_si)%r81d, & + rio_area_bareground_si => this%rvars(ir_area_bareground_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_landuse_config_s => this%rvars(ir_landuse_config_si)%int1d, & @@ -2178,7 +2184,8 @@ subroutine set_restart_vectors(this,nc,nsites,sites) end do end do - !! need to restart area_bareground + rio_min_allowed_landuse_fraction_si(io_idx_si) = sites(s)%min_allowed_landuse_fraction + rio_area_bareground_si(io_idx_si) = sites(s)%area_bareground do i_scls = 1, nlevsclass do i_pft = 1, numpft @@ -2608,7 +2615,6 @@ subroutine set_restart_vectors(this,nc,nsites,sites) rio_cndaysleafon_si(io_idx_si) = sites(s)%cndaysleafon rio_cndaysleafoff_si(io_idx_si) = sites(s)%cndaysleafoff rio_gdd_si(io_idx_si) = sites(s)%grow_deg_days - rio_min_allowed_landuse_fraction_si(io_idx_si) = sites(s)%min_allowed_landuse_fraction rio_phenmodeldate_si(io_idx_si) = sites(s)%phen_model_date @@ -2984,6 +2990,7 @@ subroutine get_restart_vectors(this, nc, nsites, sites) rio_acc_ni_si => this%rvars(ir_acc_ni_si)%r81d, & rio_gdd_si => this%rvars(ir_gdd_si)%r81d, & rio_min_allowed_landuse_fraction_si => this%rvars(ir_min_allowed_landuse_fraction_si)%r81d, & + rio_area_bareground_si => this%rvars(ir_area_bareground_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_landuse_config_si => this%rvars(ir_landuse_config_si)%int1d, & @@ -3132,7 +3139,8 @@ subroutine get_restart_vectors(this, nc, nsites, sites) end do enddo - !! need to restart area_bareground + sites(s)%min_allowed_landuse_fraction = rio_min_allowed_landuse_fraction_si(io_idx_si) + sites(s)%area_bareground = rio_area_bareground_si(io_idx_si) do i_scls = 1,nlevsclass do i_pft = 1, numpft @@ -3603,7 +3611,6 @@ subroutine get_restart_vectors(this, nc, nsites, sites) sites(s)%cndaysleafon = rio_cndaysleafon_si(io_idx_si) sites(s)%cndaysleafoff = rio_cndaysleafoff_si(io_idx_si) sites(s)%grow_deg_days = rio_gdd_si(io_idx_si) - sites(s)%min_allowed_landuse_fraction = rio_min_allowed_landuse_fraction_si(io_idx_si) sites(s)%phen_model_date= rio_phenmodeldate_si(io_idx_si) From c07fc03ab7206573f45155b272ed05d6fcb613ce Mon Sep 17 00:00:00 2001 From: Charles D Koven Date: Thu, 9 Nov 2023 16:20:06 -0800 Subject: [PATCH 050/112] fix bug related to bareground area in the application of the transition matrix --- biogeochem/EDPatchDynamicsMod.F90 | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) diff --git a/biogeochem/EDPatchDynamicsMod.F90 b/biogeochem/EDPatchDynamicsMod.F90 index 24c7fdb9af..cd5114a81a 100644 --- a/biogeochem/EDPatchDynamicsMod.F90 +++ b/biogeochem/EDPatchDynamicsMod.F90 @@ -321,10 +321,15 @@ subroutine disturbance_rates( site_in, bc_in) dist_rate_ldist_notharvested = 0.0_r8 + ! transitin matrix has units of area transitioned per unit area of the whole gridcell per time; + ! need to change to area transitioned per unit area of that land-use type per time; + ! because the land use state vector sums to one minus area bareground, need to also divide by that + ! (or rather, multiply since it is in the denominator of the denominator) ! Avoid this calculation to avoid NaN due to division by zero result if luh is not used or applying to bare ground if (hlm_use_luh .eq. itrue .and. currentPatch%land_use_label .gt. nocomp_bareground_land) then currentPatch%landuse_transition_rates(1:n_landuse_cats) = min(1._r8, & - site_in%landuse_transition_matrix(currentPatch%land_use_label,1:n_landuse_cats) / & + site_in%landuse_transition_matrix(currentPatch%land_use_label,1:n_landuse_cats) & + * (1._r8 - site_in%area_bareground) / & current_fates_landuse_state_vector(currentPatch%land_use_label)) else currentPatch%landuse_transition_rates = 0.0_r8 From eb0671b7caf70f5967b4fd6ca6499c85710488d5 Mon Sep 17 00:00:00 2001 From: Charles D Koven Date: Thu, 9 Nov 2023 16:33:42 -0800 Subject: [PATCH 051/112] adding some documentation --- biogeochem/EDPatchDynamicsMod.F90 | 2 ++ 1 file changed, 2 insertions(+) diff --git a/biogeochem/EDPatchDynamicsMod.F90 b/biogeochem/EDPatchDynamicsMod.F90 index cd5114a81a..a9c6891f2c 100644 --- a/biogeochem/EDPatchDynamicsMod.F90 +++ b/biogeochem/EDPatchDynamicsMod.F90 @@ -326,6 +326,8 @@ subroutine disturbance_rates( site_in, bc_in) ! because the land use state vector sums to one minus area bareground, need to also divide by that ! (or rather, multiply since it is in the denominator of the denominator) ! Avoid this calculation to avoid NaN due to division by zero result if luh is not used or applying to bare ground + ! note that an alternative here might be to use what LUH thinks the state vector should be instead of what the FATES state vector is, + ! in order to not amplify small deviations between the two... if (hlm_use_luh .eq. itrue .and. currentPatch%land_use_label .gt. nocomp_bareground_land) then currentPatch%landuse_transition_rates(1:n_landuse_cats) = min(1._r8, & site_in%landuse_transition_matrix(currentPatch%land_use_label,1:n_landuse_cats) & From 32ee1bf551d08a5b91729217933dff03aaa97a07 Mon Sep 17 00:00:00 2001 From: Charles D Koven Date: Thu, 9 Nov 2023 20:46:39 -0800 Subject: [PATCH 052/112] bugfixes: init logging rates, and handling when pft compositn doesnt change. --- biogeochem/EDLoggingMortalityMod.F90 | 19 +++- biogeochem/EDPatchDynamicsMod.F90 | 143 +++++++++++++++------------ biogeochem/FatesLandUseChangeMod.F90 | 4 +- 3 files changed, 95 insertions(+), 71 deletions(-) diff --git a/biogeochem/EDLoggingMortalityMod.F90 b/biogeochem/EDLoggingMortalityMod.F90 index 63303b8bf7..e6494afb1c 100644 --- a/biogeochem/EDLoggingMortalityMod.F90 +++ b/biogeochem/EDLoggingMortalityMod.F90 @@ -350,10 +350,21 @@ subroutine LoggingMortality_frac( currentSite, bc_in, pft_i, dbh, canopy_layer, end if else call get_init_landuse_harvest_rate(bc_in, currentSite%min_allowed_landuse_fraction, harvest_rate) - lmort_direct = harvest_rate - lmort_collateral = 0.0_r8 - lmort_infra = 0.0_r8 - l_degrad = 0.0_r8 + if(prt_params%woody(pft_i) == itrue)then + lmort_direct = harvest_rate + lmort_collateral = 0.0_r8 + lmort_infra = 0.0_r8 + l_degrad = 0.0_r8 + else + lmort_direct = 0.0_r8 + lmort_collateral = 0.0_r8 + lmort_infra = 0.0_r8 + if (canopy_layer .eq. 1) then + l_degrad = harvest_rate + else + l_degrad = 0.0_r8 + endif + endif endif end subroutine LoggingMortality_frac diff --git a/biogeochem/EDPatchDynamicsMod.F90 b/biogeochem/EDPatchDynamicsMod.F90 index a9c6891f2c..833b3497e9 100644 --- a/biogeochem/EDPatchDynamicsMod.F90 +++ b/biogeochem/EDPatchDynamicsMod.F90 @@ -372,8 +372,7 @@ subroutine disturbance_rates( site_in, bc_in) ! for non-closed-canopy areas subject to logging, add an additional increment of area disturbed ! equivalent to the fraction logged to account for transfer of interstitial ground area to new secondary lands - ! if ( (logging_time .or. site_in%transition_landuse_from_off_to_on) .and. & - if ( logging_time .and. & + if ( (logging_time .or. site_in%transition_landuse_from_off_to_on) .and. & (currentPatch%area - currentPatch%total_canopy_area) .gt. fates_tiny ) then ! The canopy is NOT closed. @@ -514,7 +513,7 @@ subroutine spawn_patches( currentSite, bc_in) logical :: buffer_patch_in_linked_list integer :: n_pfts_by_landuse integer :: which_pft_allowed - + logical :: buffer_patch_used !--------------------------------------------------------------------- storesmallcohort => null() ! storage of the smallest cohort for insertion routine @@ -1394,6 +1393,7 @@ subroutine spawn_patches( currentSite, bc_in) call buffer_patch%sdlng_mdd(pft)%p%CopyFromDonor(copyPatch%sdlng_mdd(pft)%p) enddo end if + buffer_patch_used = .false. currentPatch => currentSite%oldest_patch do while(associated(currentPatch)) @@ -1410,7 +1410,9 @@ subroutine spawn_patches( currentSite, bc_in) call fuse_2_patches(currentSite, currentPatch, buffer_patch) currentPatch => previousPatch - elseif (fraction_to_keep .lt. 1._r8) then + buffer_patch_used = .true. + + elseif ( (1._r8 - fraction_to_keep) .gt. rsnbl_math_prec) then ! we have more patch are of this PFT than we want, but we do want to keep some of it. ! we want to split the patch into two here. leave one patch as-is, and put the rest into the buffer patch. @@ -1426,6 +1428,8 @@ subroutine spawn_patches( currentSite, bc_in) nocomp_pft_area_vector_filled(currentPatch%nocomp_pft_label) + currentPatch%area currentPatch%changed_landuse_this_ts = .false. + + buffer_patch_used = .true. else ! we want to keep all of this patch (and possibly more) nocomp_pft_area_vector_filled(currentPatch%nocomp_pft_label) = & @@ -1436,91 +1440,102 @@ subroutine spawn_patches( currentSite, bc_in) currentPatch => currentPatch%younger end do - ! at this point, lets check that the total patch area remaining to be relabelled equals what we think that it is. - if (abs(sum(nocomp_pft_area_vector(:)) - sum(nocomp_pft_area_vector_filled(:)) - buffer_patch%area) .gt. rsnbl_math_prec) then - write(fates_log(),*) 'midway through patch reallocation and things are already not adding up.', i_land_use_label - write(fates_log(),*) currentSite%area_pft(:,i_land_use_label) - write(fates_log(),*) '-----' - write(fates_log(),*) nocomp_pft_area_vector_filled - write(fates_log(),*) '-----' - write(fates_log(),*) nocomp_pft_area_vector - write(fates_log(),*) '-----' - write(fates_log(),*) buffer_patch%area, buffer_patch%land_use_label, buffer_patch%nocomp_pft_label - currentPatch => currentSite%oldest_patch - do while(associated(currentPatch)) - write(fates_log(),*) currentPatch%area, currentPatch%land_use_label, currentPatch%nocomp_pft_label - currentPatch => currentPatch%younger - end do - call dump_site(currentSite) - call endrun(msg=errMsg(sourcefile, __LINE__)) - end if + if ( buffer_patch_used ) then + ! at this point, lets check that the total patch area remaining to be relabelled equals what we think that it is. + if (abs(sum(nocomp_pft_area_vector(:)) - sum(nocomp_pft_area_vector_filled(:)) - buffer_patch%area) .gt. rsnbl_math_prec) then + write(fates_log(),*) 'midway through patch reallocation and things are already not adding up.', i_land_use_label + write(fates_log(),*) currentSite%area_pft(:,i_land_use_label) + write(fates_log(),*) '-----' + write(fates_log(),*) nocomp_pft_area_vector_filled + write(fates_log(),*) '-----' + write(fates_log(),*) nocomp_pft_area_vector + write(fates_log(),*) '-----' + write(fates_log(),*) buffer_patch%area, buffer_patch%land_use_label, buffer_patch%nocomp_pft_label + write(fates_log(),*) sum(nocomp_pft_area_vector(:)), sum(nocomp_pft_area_vector_filled(:)), buffer_patch%area + currentPatch => currentSite%oldest_patch + do while(associated(currentPatch)) + write(fates_log(),*) currentPatch%area, currentPatch%land_use_label, currentPatch%nocomp_pft_label + currentPatch => currentPatch%younger + end do + call dump_site(currentSite) + call endrun(msg=errMsg(sourcefile, __LINE__)) + end if - ! now we need to loop through the nocomp PFTs, and split the buffer patch into a set of patches to put back in the linked list - nocomp_pft_loop_2: do i_pft = 1, numpft - ! - if ( currentSite%area_pft(i_pft,i_land_use_label) .gt. nearzero) then + ! now we need to loop through the nocomp PFTs, and split the buffer patch into a set of patches to put back in the linked list + nocomp_pft_loop_2: do i_pft = 1, numpft ! - if (nocomp_pft_area_vector_filled(i_pft) .lt. currentSite%area_pft(i_pft,i_land_use_label) * sum(nocomp_pft_area_vector(:))) then + if ( currentSite%area_pft(i_pft,i_land_use_label) .gt. nearzero) then ! - newp_area = currentSite%area_pft(i_pft,i_land_use_label) * sum(nocomp_pft_area_vector(:)) - nocomp_pft_area_vector_filled(i_pft) - ! only bother doing this if the new new patch area needed is greater than some tiny amount - if ( newp_area .gt. rsnbl_math_prec) then + if (nocomp_pft_area_vector_filled(i_pft) .lt. currentSite%area_pft(i_pft,i_land_use_label) * sum(nocomp_pft_area_vector(:))) then ! - if (buffer_patch%area - newp_area .gt. rsnbl_math_prec) then + newp_area = currentSite%area_pft(i_pft,i_land_use_label) * sum(nocomp_pft_area_vector(:)) - nocomp_pft_area_vector_filled(i_pft) + ! only bother doing this if the new new patch area needed is greater than some tiny amount + if ( newp_area .gt. rsnbl_math_prec) then + ! + if (buffer_patch%area - newp_area .gt. rsnbl_math_prec) then - ! split buffer patch in two, keeping the smaller buffer patch to put into new patches - allocate(temp_patch) + ! split buffer patch in two, keeping the smaller buffer patch to put into new patches + allocate(temp_patch) - call split_patch(currentSite, buffer_patch, temp_patch, (1._r8 - newp_area/buffer_patch%area)) + call split_patch(currentSite, buffer_patch, temp_patch, (1._r8 - newp_area/buffer_patch%area)) - ! give the new patch the intended nocomp PFT label - temp_patch%nocomp_pft_label = i_pft + ! give the new patch the intended nocomp PFT label + temp_patch%nocomp_pft_label = i_pft - ! track that we have added this patch area - nocomp_pft_area_vector_filled(i_pft) = nocomp_pft_area_vector_filled(i_pft) + temp_patch%area + ! track that we have added this patch area + nocomp_pft_area_vector_filled(i_pft) = nocomp_pft_area_vector_filled(i_pft) + temp_patch%area - ! put the new patch into the linked list - call InsertPatch(currentSite, temp_patch) + ! put the new patch into the linked list + call InsertPatch(currentSite, temp_patch) - ! now that the patch that temp_patch points to is in the site linked list, we want to null temp_patch so that it can be - ! refilled the next time through the loop. + ! now that the patch that temp_patch points to is in the site linked list, we want to null temp_patch so that it can be + ! refilled the next time through the loop. - else - ! give the buffer patch the intended nocomp PFT label - buffer_patch%nocomp_pft_label = i_pft + else + ! give the buffer patch the intended nocomp PFT label + buffer_patch%nocomp_pft_label = i_pft - ! track that we have added this patch area - nocomp_pft_area_vector_filled(i_pft) = nocomp_pft_area_vector_filled(i_pft) + buffer_patch%area + ! track that we have added this patch area + nocomp_pft_area_vector_filled(i_pft) = nocomp_pft_area_vector_filled(i_pft) + buffer_patch%area - ! put the buffer patch directly into the linked list - call InsertPatch(currentSite, buffer_patch) + ! put the buffer patch directly into the linked list + call InsertPatch(currentSite, buffer_patch) - buffer_patch_in_linked_list = .true. + buffer_patch_in_linked_list = .true. + end if end if end if end if + end do nocomp_pft_loop_2 + + ! now we want to make sure that either the buffer_patch either has zero area (presumably it was never used), in which case it should be deallocated, + ! or else it does have area but it has been put into the site linked list, and so buffer patch should be nulled before next pass through outer loop. + ! if either of those, that means everything worked properly, if not, then something has gone wrong. + if (buffer_patch_in_linked_list) then + buffer_patch => null() + else if (buffer_patch%area .lt. rsnbl_math_prec) then + ! here we need to deallocate the buffer patch so that we don't get a memory leak/ + call buffer_patch%FreeMemory(regeneration_model, numpft) + deallocate(buffer_patch, stat=istat, errmsg=smsg) + if (istat/=0) then + write(fates_log(),*) 'dealloc: fail on deallocate(dp):'//trim(smsg) + call endrun(msg=errMsg(sourcefile, __LINE__)) + endif + else + write(fates_log(),*) 'Buffer patch still has area and it wasnt put into the linked list' + write(fates_log(),*) 'buffer_patch%area', buffer_patch%area + write(fates_log(),*) sum(nocomp_pft_area_vector_filled(:)), sum(nocomp_pft_area_vector(:)) + call endrun(msg=errMsg(sourcefile, __LINE__)) end if - end do nocomp_pft_loop_2 - - ! now we want to make sure that either the buffer_patch either has zero area (presumably it was never used), in which case it should be deallocated, - ! or else it does have area but it has been put into the site linked list, and so buffer patch should be nulled before next pass through outer loop. - ! if either of those, that means everything worked properly, if not, then something has gone wrong. - if (buffer_patch_in_linked_list) then - buffer_patch => null() - else if (buffer_patch%area .lt. rsnbl_math_prec) then - ! here we need to deallocate the buffer patch so that we don't get a memory leak/ + else + ! buffer patch was never even used. deallocate. call buffer_patch%FreeMemory(regeneration_model, numpft) deallocate(buffer_patch, stat=istat, errmsg=smsg) if (istat/=0) then write(fates_log(),*) 'dealloc: fail on deallocate(dp):'//trim(smsg) call endrun(msg=errMsg(sourcefile, __LINE__)) endif - else - write(fates_log(),*) 'Buffer patch still has area and it wasnt put into the linked list' - write(fates_log(),*) 'buffer_patch%area', buffer_patch%area - write(fates_log(),*) sum(nocomp_pft_area_vector_filled(:)), sum(nocomp_pft_area_vector(:)) - call endrun(msg=errMsg(sourcefile, __LINE__)) end if ! check that the area we have added is the same as the area we have taken away. if not, crash. diff --git a/biogeochem/FatesLandUseChangeMod.F90 b/biogeochem/FatesLandUseChangeMod.F90 index cc91ca11da..2ce8a28968 100644 --- a/biogeochem/FatesLandUseChangeMod.F90 +++ b/biogeochem/FatesLandUseChangeMod.F90 @@ -125,7 +125,7 @@ subroutine get_landuse_transition_rates(bc_in, min_allowed_landuse_fraction, lan ! zero all transitions where the state vector is less than the minimum allowed call get_luh_statedata(bc_in, state_vector) do i_lu = 1, n_landuse_cats - if ( state_vector(i_lu) .le. min_allowed_landuse_fraction .or. i_lu .eq. secondaryland) then !!!!!!!!!!!!!!!!!!!!!!!!!!!!!! CDK DEBUG + if ( state_vector(i_lu) .le. min_allowed_landuse_fraction ) then landuse_transition_matrix(:,i_lu) = 0._r8 end if end do @@ -352,8 +352,6 @@ subroutine get_init_landuse_harvest_rate(bc_in, min_allowed_landuse_fraction, ha harvest_rate = state_vector(secondaryland) endif -!!!!!!!!!!!!!!!!!!!! CDKCDK - harvest_rate = 0._r8 end subroutine get_init_landuse_harvest_rate subroutine get_init_landuse_transition_rates(bc_in, min_allowed_landuse_fraction, landuse_transition_matrix) From 401bdd8a4646a3af7ad00d95e969bca2f30e2faa Mon Sep 17 00:00:00 2001 From: Charles D Koven Date: Fri, 10 Nov 2023 09:54:10 -0800 Subject: [PATCH 053/112] changing shape of albedo arrays to avoid crash on restart reads --- main/FatesInterfaceMod.F90 | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/main/FatesInterfaceMod.F90 b/main/FatesInterfaceMod.F90 index 99d7ef56d3..9cc564a8f5 100644 --- a/main/FatesInterfaceMod.F90 +++ b/main/FatesInterfaceMod.F90 @@ -611,13 +611,13 @@ subroutine allocate_bcout(bc_out, nlevsoil_in, nlevdecomp_in) allocate(bc_out%rssha_pa(maxpatch_total)) ! Canopy Radiation - allocate(bc_out%albd_parb(maxpatch_total,hlm_numSWb)) - allocate(bc_out%albi_parb(maxpatch_total,hlm_numSWb)) - allocate(bc_out%fabd_parb(maxpatch_total,hlm_numSWb)) - allocate(bc_out%fabi_parb(maxpatch_total,hlm_numSWb)) - allocate(bc_out%ftdd_parb(maxpatch_total,hlm_numSWb)) - allocate(bc_out%ftid_parb(maxpatch_total,hlm_numSWb)) - allocate(bc_out%ftii_parb(maxpatch_total,hlm_numSWb)) + allocate(bc_out%albd_parb(fates_maxPatchesPerSite,hlm_numSWb)) + allocate(bc_out%albi_parb(fates_maxPatchesPerSite,hlm_numSWb)) + allocate(bc_out%fabd_parb(fates_maxPatchesPerSite,hlm_numSWb)) + allocate(bc_out%fabi_parb(fates_maxPatchesPerSite,hlm_numSWb)) + allocate(bc_out%ftdd_parb(fates_maxPatchesPerSite,hlm_numSWb)) + allocate(bc_out%ftid_parb(fates_maxPatchesPerSite,hlm_numSWb)) + allocate(bc_out%ftii_parb(fates_maxPatchesPerSite,hlm_numSWb)) ! We allocate the boundary conditions to the BGC From 3f091666e6ac8c596766b70f9415953e10bd3d1d Mon Sep 17 00:00:00 2001 From: Charles D Koven Date: Wed, 22 Nov 2023 10:17:14 -0800 Subject: [PATCH 054/112] added logic to handle case where LU type was below min area and then exceeds it --- biogeochem/EDLoggingMortalityMod.F90 | 17 +++++++++++++++-- biogeochem/EDPatchDynamicsMod.F90 | 27 +++++++++++++++++++++++---- biogeochem/FatesLandUseChangeMod.F90 | 25 ++++++++++++++++++++----- main/EDInitMod.F90 | 12 +++++++++++- main/EDTypesMod.F90 | 1 + main/FatesRestartInterfaceMod.F90 | 28 ++++++++++++++++++++++++++++ 6 files changed, 98 insertions(+), 12 deletions(-) diff --git a/biogeochem/EDLoggingMortalityMod.F90 b/biogeochem/EDLoggingMortalityMod.F90 index e6494afb1c..9124259c59 100644 --- a/biogeochem/EDLoggingMortalityMod.F90 +++ b/biogeochem/EDLoggingMortalityMod.F90 @@ -28,6 +28,7 @@ module EDLoggingMortalityMod use FatesConstantsMod , only : dtype_ilog use FatesConstantsMod , only : dtype_ifall use FatesConstantsMod , only : dtype_ifire + use FatesConstantsMod , only : n_landuse_cats use EDPftvarcon , only : EDPftvarcon_inst use EDPftvarcon , only : GetDecompyFrac use PRTParametersMod , only : prt_params @@ -71,6 +72,7 @@ module EDLoggingMortalityMod use FatesConstantsMod, only : fates_check_param_set use FatesInterfaceTypesMod , only : numpft use FatesLandUseChangeMod, only : get_init_landuse_harvest_rate + use FatesLandUseChangeMod, only : get_luh_statedata implicit none private @@ -206,7 +208,7 @@ subroutine LoggingMortality_frac( currentSite, bc_in, pft_i, dbh, canopy_layer, harvest_tag) ! Arguments - type(ed_site_type), intent(in), target :: currentSite ! site structure + type(ed_site_type), intent(inout), target :: currentSite ! site structure type(bc_in_type), intent(in) :: bc_in integer, intent(in) :: pft_i ! pft index real(r8), intent(in) :: dbh ! diameter at breast height (cm) @@ -237,6 +239,7 @@ subroutine LoggingMortality_frac( currentSite, bc_in, pft_i, dbh, canopy_layer, ! Local variables integer :: cur_harvest_tag ! the harvest tag of the cohort today real(r8) :: harvest_rate ! the final harvest rate to apply to this cohort today + real(r8) :: state_vector(n_landuse_cats) ! todo: probably lower the dbhmin default value to 30 cm ! todo: change the default logging_event_code to 1 september (-244) @@ -296,6 +299,15 @@ subroutine LoggingMortality_frac( currentSite, bc_in, pft_i, dbh, canopy_layer, endif + ! if the total intended area of secondary lands are less than what we can consider without having too-small patches, + ! or if that was the case until just now, then there is special logic + call get_luh_statedata(bc_in, state_vector) + if (state_vector(secondaryland) .le. currentSite%min_allowed_landuse_fraction) then + harvest_rate = 0._r8 + else if (.not. currentSite%landuse_vector_gt_min(secondaryland)) then + harvest_rate = state_vector(secondaryland) + end if + ! transfer of area to secondary land is based on overall area affected, not just logged crown area ! l_degrad accounts for the affected area between logged crowns if(prt_params%woody(pft_i) == itrue)then ! only set logging rates for trees @@ -349,7 +361,8 @@ subroutine LoggingMortality_frac( currentSite, bc_in, pft_i, dbh, canopy_layer, l_degrad = 0.0_r8 end if else - call get_init_landuse_harvest_rate(bc_in, currentSite%min_allowed_landuse_fraction, harvest_rate) + call get_init_landuse_harvest_rate(bc_in, currentSite%min_allowed_landuse_fraction, & + harvest_rate, currentSite%landuse_vector_gt_min) if(prt_params%woody(pft_i) == itrue)then lmort_direct = harvest_rate lmort_collateral = 0.0_r8 diff --git a/biogeochem/EDPatchDynamicsMod.F90 b/biogeochem/EDPatchDynamicsMod.F90 index 833b3497e9..6f592109c1 100644 --- a/biogeochem/EDPatchDynamicsMod.F90 +++ b/biogeochem/EDPatchDynamicsMod.F90 @@ -214,6 +214,7 @@ subroutine disturbance_rates( site_in, bc_in) real(r8) :: harvestable_forest_c(hlm_num_lu_harvest_cats) integer :: harvest_tag(hlm_num_lu_harvest_cats) real(r8) :: current_fates_landuse_state_vector(n_landuse_cats) ! [m2/m2] + real(r8) :: state_vector(n_landuse_cats) real(r8), parameter :: max_daily_disturbance_rate = 0.999_r8 !---------------------------------------------------------------------------------------------- ! Calculate Mortality Rates (these were previously calculated during growth derivatives) @@ -286,9 +287,11 @@ subroutine disturbance_rates( site_in, bc_in) if ( hlm_use_luh .eq. itrue ) then if(.not. site_in%transition_landuse_from_off_to_on) then - call get_landuse_transition_rates(bc_in, site_in%min_allowed_landuse_fraction, site_in%landuse_transition_matrix) + call get_landuse_transition_rates(bc_in, site_in%min_allowed_landuse_fraction, & + site_in%landuse_transition_matrix, site_in%landuse_vector_gt_min) else - call get_init_landuse_transition_rates(bc_in, site_in%min_allowed_landuse_fraction, site_in%landuse_transition_matrix) + call get_init_landuse_transition_rates(bc_in, site_in%min_allowed_landuse_fraction, & + site_in%landuse_transition_matrix, site_in%landuse_vector_gt_min) endif else site_in%landuse_transition_matrix(:,:) = 0._r8 @@ -312,6 +315,8 @@ subroutine disturbance_rates( site_in, bc_in) currentPatch => currentPatch%younger end do + call get_luh_statedata(bc_in, state_vector) + currentPatch => site_in%oldest_patch do while (associated(currentPatch)) @@ -387,8 +392,17 @@ subroutine disturbance_rates( site_in, bc_in) current_fates_landuse_state_vector(secondaryland), & currentPatch%age_since_anthro_disturbance, harvest_rate) end if + + ! if the total intended area of secondary lands are less than what we can consider without having too-small patches, + ! or if that was the case until just now, then there is special logic + if (state_vector(secondaryland) .le. site_in%min_allowed_landuse_fraction) then + harvest_rate = 0._r8 + else if (.not. site_in%landuse_vector_gt_min(secondaryland)) then + harvest_rate = state_vector(secondaryland) + end if else - call get_init_landuse_harvest_rate(bc_in, site_in%min_allowed_landuse_fraction, harvest_rate) + call get_init_landuse_harvest_rate(bc_in, site_in%min_allowed_landuse_fraction, & + harvest_rate, site_in%landuse_vector_gt_min) endif currentPatch%disturbance_rates(dtype_ilog) = currentPatch%disturbance_rates(dtype_ilog) + & @@ -434,7 +448,12 @@ subroutine disturbance_rates( site_in, bc_in) currentPatch => currentPatch%younger - enddo !patch loop + enddo !patch loop + + ! if the area of secondary land has just exceeded the minimum below which we ignore things, set the flag to keep track of that. + if ( (state_vector(secondaryland) .gt. site_in%min_allowed_landuse_fraction) .and. (.not. site_in%landuse_vector_gt_min(secondaryland)) ) then + site_in%landuse_vector_gt_min(secondaryland) = .true. + end if end subroutine disturbance_rates diff --git a/biogeochem/FatesLandUseChangeMod.F90 b/biogeochem/FatesLandUseChangeMod.F90 index 2ce8a28968..200d574464 100644 --- a/biogeochem/FatesLandUseChangeMod.F90 +++ b/biogeochem/FatesLandUseChangeMod.F90 @@ -61,7 +61,7 @@ module FatesLandUseChangeMod contains ! ============================================================================ - subroutine get_landuse_transition_rates(bc_in, min_allowed_landuse_fraction, landuse_transition_matrix) + subroutine get_landuse_transition_rates(bc_in, min_allowed_landuse_fraction, landuse_transition_matrix, landuse_vector_gt_min) ! The purpose of this routine is to ingest the land use transition rate information that the host model has read in from a dataset, @@ -72,6 +72,7 @@ subroutine get_landuse_transition_rates(bc_in, min_allowed_landuse_fraction, lan type(bc_in_type) , intent(in) :: bc_in real(r8), intent(in) :: min_allowed_landuse_fraction real(r8), intent(inout) :: landuse_transition_matrix(n_landuse_cats, n_landuse_cats) ! [m2/m2/day] + logical, intent(inout) :: landuse_vector_gt_min(n_landuse_cats) ! !LOCAL VARIABLES: type(luh2_fates_lutype_map) :: lumap @@ -122,11 +123,17 @@ subroutine get_landuse_transition_rates(bc_in, min_allowed_landuse_fraction, lan end if end do transitions_loop - ! zero all transitions where the state vector is less than the minimum allowed + ! zero all transitions where the state vector is less than the minimum allowed, + ! and otherwise if this is the first timestep where the minimum was exceeded, + ! then apply all transitions from primary to this type and reset the flag call get_luh_statedata(bc_in, state_vector) - do i_lu = 1, n_landuse_cats + do i_lu = secondaryland +1, n_landuse_cats if ( state_vector(i_lu) .le. min_allowed_landuse_fraction ) then landuse_transition_matrix(:,i_lu) = 0._r8 + else if (.not. landuse_vector_gt_min(i_lu) ) then + landuse_transition_matrix(:,i_lu) = 0._r8 + landuse_transition_matrix(primaryland,i_lu) = state_vector(i_lu) + landuse_vector_gt_min(i_lu) = .true. end if end do end if @@ -331,7 +338,7 @@ subroutine CheckLUHData(luh_vector,modified_flag) end subroutine CheckLUHData - subroutine get_init_landuse_harvest_rate(bc_in, min_allowed_landuse_fraction, harvest_rate) + subroutine get_init_landuse_harvest_rate(bc_in, min_allowed_landuse_fraction, harvest_rate, landuse_vector_gt_min) ! the purpose of this subroutine is, only under the case where we are transitioning from a spinup run that did not have land use ! to a run that does, to apply the land-use changes needed to get to the state vector in a single daily instance. this is for @@ -342,19 +349,23 @@ subroutine get_init_landuse_harvest_rate(bc_in, min_allowed_landuse_fraction, ha type(bc_in_type) , intent(in) :: bc_in real(r8), intent(in) :: min_allowed_landuse_fraction real(r8), intent(out) :: harvest_rate ! [m2/ m2 / day] + logical, intent(inout) :: landuse_vector_gt_min(n_landuse_cats) ! LOCALS real(r8) :: state_vector(n_landuse_cats) ! [m2/m2] call get_luh_statedata(bc_in, state_vector) + ! only do this if the state vector exceeds the minimum viable patch size, and if so, note that in the + ! landuse_vector_gt_min flag (which will be coming in as .false. because of the use_potentialveg logic). if ( state_vector(secondaryland) .gt. min_allowed_landuse_fraction) then harvest_rate = state_vector(secondaryland) + landuse_vector_gt_min(secondaryland) = .true. endif end subroutine get_init_landuse_harvest_rate - subroutine get_init_landuse_transition_rates(bc_in, min_allowed_landuse_fraction, landuse_transition_matrix) + subroutine get_init_landuse_transition_rates(bc_in, min_allowed_landuse_fraction, landuse_transition_matrix, landuse_vector_gt_min) ! The purose of this subroutine is, only under the case where we are transitioning from a spinup run that did not have land use ! to a run that does, to apply the land-use changes needed to get to the state vector in a single daily instance. this is for @@ -364,6 +375,7 @@ subroutine get_init_landuse_transition_rates(bc_in, min_allowed_landuse_fraction type(bc_in_type) , intent(in) :: bc_in real(r8), intent(in) :: min_allowed_landuse_fraction real(r8), intent(inout) :: landuse_transition_matrix(n_landuse_cats, n_landuse_cats) ! [m2/m2/day] + logical, intent(inout) :: landuse_vector_gt_min(n_landuse_cats) ! LOCALS real(r8) :: state_vector(n_landuse_cats) ! [m2/m2] @@ -373,9 +385,12 @@ subroutine get_init_landuse_transition_rates(bc_in, min_allowed_landuse_fraction call get_luh_statedata(bc_in, state_vector) + ! only do this if the state vector exceeds the minimum viable patch size, and if so, note that in the + ! landuse_vector_gt_min flag (which will be coming in as .false. because of the use_potentialveg logic). do i = secondaryland+1,n_landuse_cats if ( state_vector(i) .gt. min_allowed_landuse_fraction) then landuse_transition_matrix(1,i) = state_vector(i) + landuse_vector_gt_min(i) = .true. end if end do diff --git a/main/EDInitMod.F90 b/main/EDInitMod.F90 index 3efd6fe68e..f960a349b8 100644 --- a/main/EDInitMod.F90 +++ b/main/EDInitMod.F90 @@ -192,7 +192,7 @@ subroutine init_site_vars( site_in, bc_in, bc_out ) allocate(site_in%z_soil(site_in%nlevsoil)) allocate(site_in%area_pft(1:numpft,1:n_landuse_cats)) - + allocate(site_in%landuse_vector_gt_min(1:n_landuse_cats)) allocate(site_in%use_this_pft(1:numpft)) allocate(site_in%area_by_age(1:nlevage)) @@ -717,6 +717,16 @@ subroutine init_patches( nsites, sites, bc_in) n_active_landuse_cats = n_landuse_cats call get_luh_statedata(bc_in(s), state_vector) + ! if the land use state vector is greater than the minimum value, set landuse_vector_gt_min flag to true + ! otherwise set to false. + do i_lu_state = 1, n_landuse_cats + if (state_vector(i_lu_state) .gt. sites(s)%min_allowed_landuse_fraction) then + sites(s)%landuse_vector_gt_min(i_lu_state) = .true. + else + sites(s)%landuse_vector_gt_min(i_lu_state) = .false. + end if + end do + else ! If LUH2 data is not being used, we initialize with primarylands, ! i.e. array index equals '1' diff --git a/main/EDTypesMod.F90 b/main/EDTypesMod.F90 index c0c49d1619..eb747b5121 100644 --- a/main/EDTypesMod.F90 +++ b/main/EDTypesMod.F90 @@ -430,6 +430,7 @@ module EDTypesMod real(r8) :: landuse_transition_matrix(n_landuse_cats, n_landuse_cats) ! land use transition matrix as read in from HLM and aggregated to FATES land use types [m2/m2/year] real(r8) :: min_allowed_landuse_fraction ! minimum amount of land-use type below which the resulting patches would be too small [m2/m2] + logical, allocatable :: landuse_vector_gt_min(:) ! is the land use state vector for each land use type greater than the minimum below which we ignore? logical :: transition_landuse_from_off_to_on ! special flag to use only when reading restarts, which triggers procedure to initialize land use end type ed_site_type diff --git a/main/FatesRestartInterfaceMod.F90 b/main/FatesRestartInterfaceMod.F90 index 28eaa652fe..e3404e5a2e 100644 --- a/main/FatesRestartInterfaceMod.F90 +++ b/main/FatesRestartInterfaceMod.F90 @@ -100,6 +100,7 @@ module FatesRestartInterfaceMod integer :: ir_acc_ni_si integer :: ir_gdd_si integer :: ir_min_allowed_landuse_fraction_si + integer :: ir_landuse_vector_gt_min_si integer :: ir_area_bareground_si integer :: ir_snow_depth_si integer :: ir_trunk_product_si @@ -708,6 +709,10 @@ subroutine define_restart_vars(this, initialize_variables) long_name='minimum allowed land use fraction at each site', units='degC days', flushval = flushzero, & hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_min_allowed_landuse_fraction_si ) + call this%set_restart_var(vname='fates_landuse_vector_gt_min_site', vtype=cohort_int, & + long_name='minimum allowed land use fraction at each site', units='degC days', flushval = flushzero, & + hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_landuse_vector_gt_min_si ) + call this%set_restart_var(vname='fates_area_bareground_site', vtype=site_r8, & long_name='minimum allowed land use fraction at each site', units='degC days', flushval = flushzero, & hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_area_bareground_si ) @@ -1980,6 +1985,7 @@ subroutine set_restart_vectors(this,nc,nsites,sites) integer :: io_idx_si_vtmem ! indices for veg-temp memory at site integer :: io_idx_pa_ncl ! each canopy layer within each patch integer :: io_idx_si_luludi ! site-level lu x lu x ndist index + integer :: io_idx_si_lu ! site-level lu index ! Some counters (for checking mostly) integer :: totalcohorts ! total cohort count on this thread (diagnostic) @@ -2022,6 +2028,7 @@ subroutine set_restart_vectors(this,nc,nsites,sites) rio_acc_ni_si => this%rvars(ir_acc_ni_si)%r81d, & rio_gdd_si => this%rvars(ir_gdd_si)%r81d, & rio_min_allowed_landuse_fraction_si => this%rvars(ir_min_allowed_landuse_fraction_si)%r81d, & + rio_landuse_vector_gt_min_si => this%rvars(ir_landuse_vector_gt_min_si)%int1d, & rio_area_bareground_si => this%rvars(ir_area_bareground_si)%r81d, & rio_snow_depth_si => this%rvars(ir_snow_depth_si)%r81d, & rio_trunk_product_si => this%rvars(ir_trunk_product_si)%r81d, & @@ -2167,6 +2174,7 @@ subroutine set_restart_vectors(this,nc,nsites,sites) io_idx_si_scpf = io_idx_co_1st io_idx_si_pft = io_idx_co_1st io_idx_si_luludi = io_idx_co_1st + io_idx_si_lu = io_idx_co_1st ! recruitment rate do i_pft = 1,numpft @@ -2185,6 +2193,15 @@ subroutine set_restart_vectors(this,nc,nsites,sites) end do rio_min_allowed_landuse_fraction_si(io_idx_si) = sites(s)%min_allowed_landuse_fraction + do i_landuse = 1, n_landuse_cats + if ( sites(s)%landuse_vector_gt_min(i_landuse)) then + rio_landuse_vector_gt_min_si(io_idx_si_lu) = itrue + else + rio_landuse_vector_gt_min_si(io_idx_si_lu) = ifalse + endif + io_idx_si_lu = io_idx_si_lu + 1 + end do + rio_area_bareground_si(io_idx_si) = sites(s)%area_bareground do i_scls = 1, nlevsclass @@ -2956,6 +2973,7 @@ subroutine get_restart_vectors(this, nc, nsites, sites) integer :: io_idx_pa_ncl ! each canopy layer within each patch integer :: io_idx_si_luludi ! site-level lu x lu x ndist index + integer :: io_idx_si_lu ! site-level lu x lu x ndist index ! Some counters (for checking mostly) integer :: totalcohorts ! total cohort count on this thread (diagnostic) @@ -2990,6 +3008,7 @@ subroutine get_restart_vectors(this, nc, nsites, sites) rio_acc_ni_si => this%rvars(ir_acc_ni_si)%r81d, & rio_gdd_si => this%rvars(ir_gdd_si)%r81d, & rio_min_allowed_landuse_fraction_si => this%rvars(ir_min_allowed_landuse_fraction_si)%r81d, & + rio_landuse_vector_gt_min_si => this%rvars(ir_landuse_vector_gt_min_si)%int1d, & rio_area_bareground_si => this%rvars(ir_area_bareground_si)%r81d, & rio_snow_depth_si => this%rvars(ir_snow_depth_si)%r81d, & rio_trunk_product_si => this%rvars(ir_trunk_product_si)%r81d, & @@ -3124,6 +3143,7 @@ subroutine get_restart_vectors(this, nc, nsites, sites) io_idx_si_scpf = io_idx_co_1st io_idx_si_pft = io_idx_co_1st io_idx_si_luludi = io_idx_co_1st + io_idx_si_lu = io_idx_co_1st ! read seed_bank info(site-level, but PFT-resolved) do i_pft = 1,numpft @@ -3140,6 +3160,14 @@ subroutine get_restart_vectors(this, nc, nsites, sites) enddo sites(s)%min_allowed_landuse_fraction = rio_min_allowed_landuse_fraction_si(io_idx_si) + do i_landuse = 1, n_landuse_cats + if ( rio_landuse_vector_gt_min_si(io_idx_si_lu) .eq. itrue ) then + sites(s)%landuse_vector_gt_min(i_landuse) = .true. + else + sites(s)%landuse_vector_gt_min(i_landuse) = .false. + endif + io_idx_si_lu = io_idx_si_lu + 1 + end do sites(s)%area_bareground = rio_area_bareground_si(io_idx_si) do i_scls = 1,nlevsclass From 00241bf3d33ea3f866c9ed4c8d933acb4249c53e Mon Sep 17 00:00:00 2001 From: Charles D Koven Date: Mon, 27 Nov 2023 11:42:35 -0800 Subject: [PATCH 055/112] bugfix to handle case of abandonment to secondary when secondary area is small --- biogeochem/EDPatchDynamicsMod.F90 | 1 + biogeochem/FatesLandUseChangeMod.F90 | 7 ++++--- 2 files changed, 5 insertions(+), 3 deletions(-) diff --git a/biogeochem/EDPatchDynamicsMod.F90 b/biogeochem/EDPatchDynamicsMod.F90 index 6f592109c1..f5d72d9143 100644 --- a/biogeochem/EDPatchDynamicsMod.F90 +++ b/biogeochem/EDPatchDynamicsMod.F90 @@ -3536,6 +3536,7 @@ subroutine terminate_patches(currentSite, bc_in) call get_luh_statedata(bc_in, state_vector) write(fates_log(),*) 'driver data landuse state vector: ', state_vector write(fates_log(),*) 'min_allowed_landuse_fraction: ', currentSite%min_allowed_landuse_fraction + write(fates_log(),*) 'landuse_vector_gt_min: ', currentSite%landuse_vector_gt_min call endrun(msg=errMsg(sourcefile, __LINE__)) ! Note to user. If you DO decide to remove the end-run above this line diff --git a/biogeochem/FatesLandUseChangeMod.F90 b/biogeochem/FatesLandUseChangeMod.F90 index 200d574464..f0d9613361 100644 --- a/biogeochem/FatesLandUseChangeMod.F90 +++ b/biogeochem/FatesLandUseChangeMod.F90 @@ -126,11 +126,12 @@ subroutine get_landuse_transition_rates(bc_in, min_allowed_landuse_fraction, lan ! zero all transitions where the state vector is less than the minimum allowed, ! and otherwise if this is the first timestep where the minimum was exceeded, ! then apply all transitions from primary to this type and reset the flag + ! note that the flag resetting should not happen for secondary lands, as this is handled in the logging logic call get_luh_statedata(bc_in, state_vector) - do i_lu = secondaryland +1, n_landuse_cats + do i_lu = secondaryland, n_landuse_cats if ( state_vector(i_lu) .le. min_allowed_landuse_fraction ) then landuse_transition_matrix(:,i_lu) = 0._r8 - else if (.not. landuse_vector_gt_min(i_lu) ) then + else if ((.not. landuse_vector_gt_min(i_lu)) .and. (i_lu .ne. secondaryland)) then landuse_transition_matrix(:,i_lu) = 0._r8 landuse_transition_matrix(primaryland,i_lu) = state_vector(i_lu) landuse_vector_gt_min(i_lu) = .true. @@ -389,7 +390,7 @@ subroutine get_init_landuse_transition_rates(bc_in, min_allowed_landuse_fraction ! landuse_vector_gt_min flag (which will be coming in as .false. because of the use_potentialveg logic). do i = secondaryland+1,n_landuse_cats if ( state_vector(i) .gt. min_allowed_landuse_fraction) then - landuse_transition_matrix(1,i) = state_vector(i) + landuse_transition_matrix(primaryland,i) = state_vector(i) landuse_vector_gt_min(i) = .true. end if end do From 689e7b2f514a3e381bf12b0fa57deb2b6b4ccca7 Mon Sep 17 00:00:00 2001 From: Charles D Koven Date: Tue, 28 Nov 2023 16:45:49 -0800 Subject: [PATCH 056/112] another bugfix to handle another edge condition --- biogeochem/EDPatchDynamicsMod.F90 | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/biogeochem/EDPatchDynamicsMod.F90 b/biogeochem/EDPatchDynamicsMod.F90 index f5d72d9143..43e0ffb13e 100644 --- a/biogeochem/EDPatchDynamicsMod.F90 +++ b/biogeochem/EDPatchDynamicsMod.F90 @@ -216,6 +216,7 @@ subroutine disturbance_rates( site_in, bc_in) real(r8) :: current_fates_landuse_state_vector(n_landuse_cats) ! [m2/m2] real(r8) :: state_vector(n_landuse_cats) real(r8), parameter :: max_daily_disturbance_rate = 0.999_r8 + logical :: site_secondaryland_first_exceeding_min !---------------------------------------------------------------------------------------------- ! Calculate Mortality Rates (these were previously calculated during growth derivatives) ! And the same rates in understory plants have already been applied to %dndt @@ -315,7 +316,10 @@ subroutine disturbance_rates( site_in, bc_in) currentPatch => currentPatch%younger end do + ! get some info needed to determine whether or not to apply land use change call get_luh_statedata(bc_in, state_vector) + site_secondaryland_first_exceeding_min = (state_vector(secondaryland) .gt. site_in%min_allowed_landuse_fraction) & + .and. (.not. site_in%landuse_vector_gt_min(secondaryland)) currentPatch => site_in%oldest_patch do while (associated(currentPatch)) @@ -377,7 +381,7 @@ subroutine disturbance_rates( site_in, bc_in) ! for non-closed-canopy areas subject to logging, add an additional increment of area disturbed ! equivalent to the fraction logged to account for transfer of interstitial ground area to new secondary lands - if ( (logging_time .or. site_in%transition_landuse_from_off_to_on) .and. & + if ( (logging_time .or. site_in%transition_landuse_from_off_to_on .or. site_secondaryland_first_exceeding_min) .and. & (currentPatch%area - currentPatch%total_canopy_area) .gt. fates_tiny ) then ! The canopy is NOT closed. From 3be45867d9cf663c90acf8847ae92474b18a7adc Mon Sep 17 00:00:00 2001 From: Charles D Koven Date: Wed, 6 Dec 2023 15:00:18 -0800 Subject: [PATCH 057/112] actually solve the edge case of initial harvest once 2ndry area exceeds min --- biogeochem/EDLoggingMortalityMod.F90 | 101 ++++++++++++++------------- biogeochem/EDPatchDynamicsMod.F90 | 18 ++++- 2 files changed, 70 insertions(+), 49 deletions(-) diff --git a/biogeochem/EDLoggingMortalityMod.F90 b/biogeochem/EDLoggingMortalityMod.F90 index 9124259c59..c80244e392 100644 --- a/biogeochem/EDLoggingMortalityMod.F90 +++ b/biogeochem/EDLoggingMortalityMod.F90 @@ -240,6 +240,7 @@ subroutine LoggingMortality_frac( currentSite, bc_in, pft_i, dbh, canopy_layer, integer :: cur_harvest_tag ! the harvest tag of the cohort today real(r8) :: harvest_rate ! the final harvest rate to apply to this cohort today real(r8) :: state_vector(n_landuse_cats) + logical :: site_secondaryland_first_exceeding_min ! todo: probably lower the dbhmin default value to 30 cm ! todo: change the default logging_event_code to 1 september (-244) @@ -248,8 +249,22 @@ subroutine LoggingMortality_frac( currentSite, bc_in, pft_i, dbh, canopy_layer, ! todo: eventually set up distinct harvest practices, each with a set of input paramaeters ! todo: implement harvested carbon inputs + call get_luh_statedata(bc_in, state_vector) + site_secondaryland_first_exceeding_min = (state_vector(secondaryland) .gt. currentSite%min_allowed_landuse_fraction) & + .and. (.not. currentSite%landuse_vector_gt_min(secondaryland)) + if (.not. currentSite%transition_landuse_from_off_to_on) then - if (logging_time) then + if (site_secondaryland_first_exceeding_min) then + + ! if the total intended area of secondary lands are less than what we can consider without having too-small patches, + ! or if that was the case until just now, then there is special logic + harvest_rate = state_vector(secondaryland) / sum(state_vector(:)) + write(fates_log(), *) 'applying state_vector(secondaryland) to plants.', pft_i + + ! For area-based harvest, harvest_tag shall always be 2 (not applicable). + harvest_tag = 2 + cur_harvest_tag = 2 + elseif (logging_time) then ! Pass logging rates to cohort level @@ -299,67 +314,59 @@ subroutine LoggingMortality_frac( currentSite, bc_in, pft_i, dbh, canopy_layer, endif - ! if the total intended area of secondary lands are less than what we can consider without having too-small patches, - ! or if that was the case until just now, then there is special logic - call get_luh_statedata(bc_in, state_vector) - if (state_vector(secondaryland) .le. currentSite%min_allowed_landuse_fraction) then - harvest_rate = 0._r8 - else if (.not. currentSite%landuse_vector_gt_min(secondaryland)) then - harvest_rate = state_vector(secondaryland) - end if + else + harvest_rate = 0._r8 + ! For area-based harvest, harvest_tag shall always be 2 (not applicable). + harvest_tag = 2 + cur_harvest_tag = 2 + endif - ! transfer of area to secondary land is based on overall area affected, not just logged crown area - ! l_degrad accounts for the affected area between logged crowns - if(prt_params%woody(pft_i) == itrue)then ! only set logging rates for trees - if (cur_harvest_tag == 0) then - ! direct logging rates, based on dbh min and max criteria - if (dbh >= logging_dbhmin .and. .not. & - ((logging_dbhmax < fates_check_param_set) .and. (dbh >= logging_dbhmax )) ) then - ! the logic of the above line is a bit unintuitive but allows turning off the dbhmax comparison entirely. - ! since there is an .and. .not. after the first conditional, the dbh:dbhmax comparison needs to be - ! the opposite of what would otherwise be expected... - lmort_direct = harvest_rate * logging_direct_frac - else - lmort_direct = 0.0_r8 - end if + ! transfer of area to secondary land is based on overall area affected, not just logged crown area + ! l_degrad accounts for the affected area between logged crowns + if(prt_params%woody(pft_i) == itrue)then ! only set logging rates for trees + if (cur_harvest_tag == 0) then + ! direct logging rates, based on dbh min and max criteria + if (dbh >= logging_dbhmin .and. .not. & + ((logging_dbhmax < fates_check_param_set) .and. (dbh >= logging_dbhmax )) ) then + ! the logic of the above line is a bit unintuitive but allows turning off the dbhmax comparison entirely. + ! since there is an .and. .not. after the first conditional, the dbh:dbhmax comparison needs to be + ! the opposite of what would otherwise be expected... + lmort_direct = harvest_rate * logging_direct_frac else lmort_direct = 0.0_r8 end if + else + lmort_direct = 0.0_r8 + end if - ! infrastructure (roads, skid trails, etc) mortality rates - if (dbh >= logging_dbhmax_infra) then - lmort_infra = 0.0_r8 - else - lmort_infra = harvest_rate * logging_mechanical_frac - end if - - ! Collateral damage to smaller plants below the direct logging size threshold - ! will be applied via "understory_death" via the disturbance algorithm - if (canopy_layer .eq. 1) then - lmort_collateral = harvest_rate * logging_collateral_frac - else - lmort_collateral = 0._r8 - endif - - else ! non-woody plants still killed by infrastructure - lmort_direct = 0.0_r8 - lmort_collateral = 0.0_r8 + ! infrastructure (roads, skid trails, etc) mortality rates + if (dbh >= logging_dbhmax_infra) then + lmort_infra = 0.0_r8 + else lmort_infra = harvest_rate * logging_mechanical_frac end if - ! the area occupied by all plants in the canopy that aren't killed is still disturbed at the harvest rate + ! Collateral damage to smaller plants below the direct logging size threshold + ! will be applied via "understory_death" via the disturbance algorithm if (canopy_layer .eq. 1) then - l_degrad = harvest_rate - (lmort_direct + lmort_infra + lmort_collateral) ! fraction passed to 'degraded' forest. + lmort_collateral = harvest_rate * logging_collateral_frac else - l_degrad = 0._r8 + lmort_collateral = 0._r8 endif - else + else ! non-woody plants still killed by infrastructure lmort_direct = 0.0_r8 lmort_collateral = 0.0_r8 - lmort_infra = 0.0_r8 - l_degrad = 0.0_r8 + lmort_infra = harvest_rate * logging_mechanical_frac end if + + ! the area occupied by all plants in the canopy that aren't killed is still disturbed at the harvest rate + if (canopy_layer .eq. 1) then + l_degrad = harvest_rate - (lmort_direct + lmort_infra + lmort_collateral) ! fraction passed to 'degraded' forest. + else + l_degrad = 0._r8 + endif + else call get_init_landuse_harvest_rate(bc_in, currentSite%min_allowed_landuse_fraction, & harvest_rate, currentSite%landuse_vector_gt_min) diff --git a/biogeochem/EDPatchDynamicsMod.F90 b/biogeochem/EDPatchDynamicsMod.F90 index 43e0ffb13e..3bd71249c7 100644 --- a/biogeochem/EDPatchDynamicsMod.F90 +++ b/biogeochem/EDPatchDynamicsMod.F90 @@ -401,8 +401,10 @@ subroutine disturbance_rates( site_in, bc_in) ! or if that was the case until just now, then there is special logic if (state_vector(secondaryland) .le. site_in%min_allowed_landuse_fraction) then harvest_rate = 0._r8 - else if (.not. site_in%landuse_vector_gt_min(secondaryland)) then - harvest_rate = state_vector(secondaryland) + else if (currentPatch%land_use_label .eq. primaryland .and. .not. site_in%landuse_vector_gt_min(secondaryland)) then + harvest_rate = state_vector(secondaryland) / sum(state_vector(:)) + else + harvest_rate = 0._r8 end if else call get_init_landuse_harvest_rate(bc_in, site_in%min_allowed_landuse_fraction, & @@ -457,6 +459,14 @@ subroutine disturbance_rates( site_in, bc_in) ! if the area of secondary land has just exceeded the minimum below which we ignore things, set the flag to keep track of that. if ( (state_vector(secondaryland) .gt. site_in%min_allowed_landuse_fraction) .and. (.not. site_in%landuse_vector_gt_min(secondaryland)) ) then site_in%landuse_vector_gt_min(secondaryland) = .true. + write(fates_log(),*) 'setting site_in%landuse_vector_gt_min(secondaryland) = .true.' + + currentPatch => site_in%oldest_patch + do while (associated(currentPatch)) + write(fates_log(),*) 'cpatch area, LU, distrates(ilog): ', currentPatch%area, currentPatch%land_use_label, currentPatch%nocomp_pft_label, currentPatch%disturbance_rates(dtype_ilog), currentPatch%area - currentPatch%total_canopy_area + currentPatch => currentPatch%younger + end do + end if end subroutine disturbance_rates @@ -3537,10 +3547,14 @@ subroutine terminate_patches(currentSite, bc_in) end do call get_current_landuse_statevector(currentSite, state_vector) write(fates_log(),*) 'current landuse state vector: ', state_vector + write(fates_log(),*) 'current landuse state vector (not including bare gruond): ', state_vector/(1._r8-currentSite%area_bareground) call get_luh_statedata(bc_in, state_vector) write(fates_log(),*) 'driver data landuse state vector: ', state_vector write(fates_log(),*) 'min_allowed_landuse_fraction: ', currentSite%min_allowed_landuse_fraction write(fates_log(),*) 'landuse_vector_gt_min: ', currentSite%landuse_vector_gt_min + do i_landuse = 1, n_landuse_cats + write(fates_log(),*) 'trans matrix from: ', i_landuse, currentSite%landuse_transition_matrix(i_landuse,:) + end do call endrun(msg=errMsg(sourcefile, __LINE__)) ! Note to user. If you DO decide to remove the end-run above this line From d3c13f048eda75f139e8172cd2b3d7520976c2d2 Mon Sep 17 00:00:00 2001 From: Charles D Koven Date: Thu, 22 Feb 2024 13:24:17 -0800 Subject: [PATCH 058/112] bugfix to prevent crashes when inserting patch at end of linked list --- biogeochem/EDPatchDynamicsMod.F90 | 8 +++++++- 1 file changed, 7 insertions(+), 1 deletion(-) diff --git a/biogeochem/EDPatchDynamicsMod.F90 b/biogeochem/EDPatchDynamicsMod.F90 index 3bd71249c7..94e04b9ecc 100644 --- a/biogeochem/EDPatchDynamicsMod.F90 +++ b/biogeochem/EDPatchDynamicsMod.F90 @@ -1438,7 +1438,11 @@ subroutine spawn_patches( currentSite, bc_in) if (fraction_to_keep .le. nearzero) then ! we don't want any patch area with this PFT identity at all anymore. Fuse it into the buffer patch. currentPatch%nocomp_pft_label = 0 - previousPatch => currentPatch%older + if (associated(currentPatch%older)) then + previousPatch => currentPatch%older + else + previousPatch => currentPatch + endif call fuse_2_patches(currentSite, currentPatch, buffer_patch) currentPatch => previousPatch @@ -1470,6 +1474,7 @@ subroutine spawn_patches( currentSite, bc_in) currentPatch%changed_landuse_this_ts = .false. endif end if + currentPatch => currentPatch%younger end do @@ -1559,6 +1564,7 @@ subroutine spawn_patches( currentSite, bc_in) write(fates_log(),*) 'Buffer patch still has area and it wasnt put into the linked list' write(fates_log(),*) 'buffer_patch%area', buffer_patch%area write(fates_log(),*) sum(nocomp_pft_area_vector_filled(:)), sum(nocomp_pft_area_vector(:)) + write(fates_log(),*) sum(nocomp_pft_area_vector_filled(:)) - sum(nocomp_pft_area_vector(:)) call endrun(msg=errMsg(sourcefile, __LINE__)) end if else From d37d9733b5970dfe67a0b78f6bd35d6ceb1a623d Mon Sep 17 00:00:00 2001 From: Charles D Koven Date: Sun, 3 Mar 2024 13:38:43 -0800 Subject: [PATCH 059/112] various fixes to edge cases encountered --- biogeochem/EDPatchDynamicsMod.F90 | 89 +++++++++++++++++++++++++------ main/FatesRunningMeanMod.F90 | 3 ++ 2 files changed, 76 insertions(+), 16 deletions(-) diff --git a/biogeochem/EDPatchDynamicsMod.F90 b/biogeochem/EDPatchDynamicsMod.F90 index 94e04b9ecc..e610e7c22a 100644 --- a/biogeochem/EDPatchDynamicsMod.F90 +++ b/biogeochem/EDPatchDynamicsMod.F90 @@ -1508,9 +1508,9 @@ subroutine spawn_patches( currentSite, bc_in) ! newp_area = currentSite%area_pft(i_pft,i_land_use_label) * sum(nocomp_pft_area_vector(:)) - nocomp_pft_area_vector_filled(i_pft) ! only bother doing this if the new new patch area needed is greater than some tiny amount - if ( newp_area .gt. rsnbl_math_prec) then + if ( newp_area .gt. rsnbl_math_prec * 0.01_r8) then ! - if (buffer_patch%area - newp_area .gt. rsnbl_math_prec) then + if (buffer_patch%area - newp_area .gt. rsnbl_math_prec * 0.01_r8) then ! split buffer patch in two, keeping the smaller buffer patch to put into new patches allocate(temp_patch) @@ -1553,7 +1553,7 @@ subroutine spawn_patches( currentSite, bc_in) if (buffer_patch_in_linked_list) then buffer_patch => null() else if (buffer_patch%area .lt. rsnbl_math_prec) then - ! here we need to deallocate the buffer patch so that we don't get a memory leak/ + ! here we need to deallocate the buffer patch so that we don't get a memory leak. call buffer_patch%FreeMemory(regeneration_model, numpft) deallocate(buffer_patch, stat=istat, errmsg=smsg) if (istat/=0) then @@ -1565,6 +1565,7 @@ subroutine spawn_patches( currentSite, bc_in) write(fates_log(),*) 'buffer_patch%area', buffer_patch%area write(fates_log(),*) sum(nocomp_pft_area_vector_filled(:)), sum(nocomp_pft_area_vector(:)) write(fates_log(),*) sum(nocomp_pft_area_vector_filled(:)) - sum(nocomp_pft_area_vector(:)) + call endrun(msg=errMsg(sourcefile, __LINE__)) end if else @@ -3214,7 +3215,7 @@ subroutine fuse_2_patches(csite, dp, rp) + rp%age_since_anthro_disturbance * rp%area) * inv_sum_area rp%age_class = get_age_class_index(rp%age) - + do el = 1,num_elements call rp%litter(el)%FuseLitter(rp%area,dp%area,dp%litter(el)) end do @@ -3390,15 +3391,18 @@ subroutine terminate_patches(currentSite, bc_in) type(fates_patch_type), pointer :: olderPatch type(fates_patch_type), pointer :: youngerPatch type(fates_patch_type), pointer :: patchpointer + type(fates_patch_type), pointer :: largest_patch integer, parameter :: max_cycles = 10 ! After 10 loops through ! You should had fused integer :: count_cycles logical :: gotfused logical :: current_patch_is_youngest_lutype integer :: i_landuse, i_pft + integer :: land_use_type_to_remove real(r8) areatot ! variable for checking whether the total patch area is wrong. - real(r8) :: state_vector(n_landuse_cats) ! [m2/m2] + real(r8) :: state_vector_driver(n_landuse_cats) ! [m2/m2] + real(r8) :: state_vector_internal(n_landuse_cats) ! [m2/m2] !--------------------------------------------------------------------- ! Initialize the count cycles @@ -3551,23 +3555,76 @@ subroutine terminate_patches(currentSite, bc_in) write(fates_log(),*) patchpointer%area, patchpointer%nocomp_pft_label, patchpointer%land_use_label patchpointer => patchpointer%older end do - call get_current_landuse_statevector(currentSite, state_vector) - write(fates_log(),*) 'current landuse state vector: ', state_vector - write(fates_log(),*) 'current landuse state vector (not including bare gruond): ', state_vector/(1._r8-currentSite%area_bareground) - call get_luh_statedata(bc_in, state_vector) - write(fates_log(),*) 'driver data landuse state vector: ', state_vector + call get_current_landuse_statevector(currentSite, state_vector_internal) + write(fates_log(),*) 'current landuse state vector: ', state_vector_internal + write(fates_log(),*) 'current landuse state vector (not including bare gruond): ', state_vector_internal/(1._r8-currentSite%area_bareground) + call get_luh_statedata(bc_in, state_vector_driver) + write(fates_log(),*) 'driver data landuse state vector: ', state_vector_driver write(fates_log(),*) 'min_allowed_landuse_fraction: ', currentSite%min_allowed_landuse_fraction write(fates_log(),*) 'landuse_vector_gt_min: ', currentSite%landuse_vector_gt_min do i_landuse = 1, n_landuse_cats write(fates_log(),*) 'trans matrix from: ', i_landuse, currentSite%landuse_transition_matrix(i_landuse,:) end do - call endrun(msg=errMsg(sourcefile, __LINE__)) + + if ( (state_vector_driver(currentPatch%land_use_label) .lt. currentSite%min_allowed_landuse_fraction ) .or. & + (state_vector_internal(currentPatch%land_use_label) .lt. currentSite%min_allowed_landuse_fraction ) ) then + + ! try fusing all of the patches with this land use label into the largest patch on the site. + land_use_type_to_remove = currentPatch%land_use_label + + write(fates_log(),*) 'removing all patches with land use type ',land_use_type_to_remove + + ! first find the largest patch on the site + patchpointer => currentSite%youngest_patch + largest_patch => currentSite%youngest_patch + do while(associated(patchpointer)) + if (patchpointer%area .gt. largest_patch%area .and. patchpointer%nocomp_pft_label .ne. nocomp_bareground) then + largest_patch => patchpointer + endif + patchpointer => patchpointer%older + end do + + ! now go and fuse all patches that have the land use type we are removing into that patch + patchpointer => currentSite%youngest_patch + do while(associated(patchpointer)) + if ( patchpointer%land_use_label .eq. land_use_type_to_remove ) then + + write(fates_log(),*) 'fusing into patch with types, age, and size of:', largest_patch%land_use_label, & + largest_patch%nocomp_pft_label, largest_patch%age, largest_patch%area + + write(fates_log(),*) 'fusing away patch with types, age, and size of:', patchpointer%land_use_label, & + patchpointer%nocomp_pft_label, patchpointer%age, patchpointer%area + + ! reset the categorical properties of the patch and fuse it into the largest patch + patchpointer%land_use_label = largest_patch%land_use_label + patchpointer%nocomp_pft_label = largest_patch%nocomp_pft_label + patchpointer%age_since_anthro_disturbance = largest_patch%age_since_anthro_disturbance + call fuse_2_patches(currentSite, patchpointer, largest_patch) + + ! start over in the loop to make sure we are removing every patch with the targeted land use type + patchpointer => currentSite%youngest_patch + + else + patchpointer => patchpointer%older + endif + end do + + write(fates_log(),*) 'resetting currentSite%landuse_vector_gt_min(i) to .false.' + ! now reset the allowed land use vector element so that we don't make any more such patches unless they exceed the min area + currentSite%landuse_vector_gt_min(land_use_type_to_remove) = .false. + count_cycles = 0 + currentPatch => currentSite%youngest_patch + else + write(fates_log(),*) 'this isnt because the land use was less than allowed' + + call endrun(msg=errMsg(sourcefile, __LINE__)) - ! Note to user. If you DO decide to remove the end-run above this line - ! Make sure that you keep the pointer below this line, or you will get - ! an infinite loop. - currentPatch => currentPatch%older - count_cycles = 0 + ! Note to user. If you DO decide to remove the end-run above this line + ! Make sure that you keep the pointer below this line, or you will get + ! an infinite loop. + currentPatch => currentPatch%older + count_cycles = 0 + endif end if !count cycles enddo ! current patch loop diff --git a/main/FatesRunningMeanMod.F90 b/main/FatesRunningMeanMod.F90 index 7ef7866d62..721030b974 100644 --- a/main/FatesRunningMeanMod.F90 +++ b/main/FatesRunningMeanMod.F90 @@ -328,6 +328,9 @@ subroutine FuseRMean(this,donor,recip_wgt) if (this%c_index .ne. donor%c_index) then write(fates_log(), *) 'trying to fuse two fixed-window averages' write(fates_log(), *) 'that are at different points in the window?' + write(fates_log(), *) 'c_mean', this%c_mean, donor%c_mean + write(fates_log(), *) 'l_mean', this%l_mean, donor%l_mean + write(fates_log(), *) 'c_index', this%c_index, donor%c_index call endrun(msg=errMsg(sourcefile, __LINE__)) end if end if From 2ade2b15244e3d25a40018df9dd4cc8981a080ae Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Tue, 2 Apr 2024 14:33:24 -0700 Subject: [PATCH 060/112] move get_current_landuse_statevector into ed_site_type --- biogeochem/EDPatchDynamicsMod.F90 | 39 ++---------------------------- main/EDMainMod.F90 | 3 +-- main/EDTypesMod.F90 | 40 ++++++++++++++++++++++++++++++- 3 files changed, 42 insertions(+), 40 deletions(-) diff --git a/biogeochem/EDPatchDynamicsMod.F90 b/biogeochem/EDPatchDynamicsMod.F90 index e610e7c22a..b174ef8b9f 100644 --- a/biogeochem/EDPatchDynamicsMod.F90 +++ b/biogeochem/EDPatchDynamicsMod.F90 @@ -127,7 +127,6 @@ module EDPatchDynamicsMod public :: check_patch_area public :: set_patchno private:: fuse_2_patches - public :: get_current_landuse_statevector character(len=*), parameter, private :: sourcefile = & __FILE__ @@ -223,7 +222,7 @@ subroutine disturbance_rates( site_in, bc_in) !---------------------------------------------------------------------------------------------- ! first calculate the fraction of the site that is primary land - call get_current_landuse_statevector(site_in, current_fates_landuse_state_vector) + call site_in%get_current_landuse_statevector(current_fates_landuse_state_vector) ! check status of transition_landuse_from_off_to_on flag, and do some error checking on it if(site_in%transition_landuse_from_off_to_on) then @@ -3555,7 +3554,7 @@ subroutine terminate_patches(currentSite, bc_in) write(fates_log(),*) patchpointer%area, patchpointer%nocomp_pft_label, patchpointer%land_use_label patchpointer => patchpointer%older end do - call get_current_landuse_statevector(currentSite, state_vector_internal) + call currentSite%get_current_landuse_statevector(state_vector_internal) write(fates_log(),*) 'current landuse state vector: ', state_vector_internal write(fates_log(),*) 'current landuse state vector (not including bare gruond): ', state_vector_internal/(1._r8-currentSite%area_bareground) call get_luh_statedata(bc_in, state_vector_driver) @@ -3755,40 +3754,6 @@ end function countPatches ! ===================================================================================== - subroutine get_current_landuse_statevector(site_in, current_state_vector) - - ! - ! !DESCRIPTION: - ! Calculate how much of a site is each land use category. - ! this does not include bare ground when nocomp + fixed biogeography is on, - ! so will not sum to one in that case. otherwise it will sum to one. - ! - ! !USES: - use EDTypesMod , only : ed_site_type - ! - ! !ARGUMENTS: - type(ed_site_type) , intent(in), target :: site_in - real(r8) , intent(out) :: current_state_vector(n_landuse_cats) - - ! !LOCAL VARIABLES: - type (fates_patch_type), pointer :: currentPatch - - current_state_vector(:) = 0._r8 - - currentPatch => site_in%oldest_patch - do while (associated(currentPatch)) - if (currentPatch%land_use_label .gt. nocomp_bareground_land) then - current_state_vector(currentPatch%land_use_label) = & - current_state_vector(currentPatch%land_use_label) + & - currentPatch%area/AREA - end if - currentPatch => currentPatch%younger - end do - - end subroutine get_current_landuse_statevector - - ! ===================================================================================== - subroutine InsertPatch(currentSite, newPatch) ! !DESCRIPTION: diff --git a/main/EDMainMod.F90 b/main/EDMainMod.F90 index af41670045..3368d1284f 100644 --- a/main/EDMainMod.F90 +++ b/main/EDMainMod.F90 @@ -89,7 +89,6 @@ module EDMainMod use EDLoggingMortalityMod , only : IsItLoggingTime use EDLoggingMortalityMod , only : get_harvestable_carbon use DamageMainMod , only : IsItDamageTime - use EDPatchDynamicsMod , only : get_current_landuse_statevector use FatesGlobals , only : endrun => fates_endrun use ChecksBalancesMod , only : SiteMassStock use EDMortalityFunctionsMod , only : Mortality_Derivative @@ -415,7 +414,7 @@ subroutine ed_integrate_state_variables(currentSite, bc_in, bc_out ) !----------------------------------------------------------------------- - call get_current_landuse_statevector(currentSite, current_fates_landuse_state_vector) + call currentSite%get_current_landuse_statevector(current_fates_landuse_state_vector) ! Clear site GPP and AR passing to HLM bc_out%gpp_site = 0._r8 diff --git a/main/EDTypesMod.F90 b/main/EDTypesMod.F90 index bb62dfba6e..deceac558b 100644 --- a/main/EDTypesMod.F90 +++ b/main/EDTypesMod.F90 @@ -438,6 +438,10 @@ module EDTypesMod logical, allocatable :: landuse_vector_gt_min(:) ! is the land use state vector for each land use type greater than the minimum below which we ignore? logical :: transition_landuse_from_off_to_on ! special flag to use only when reading restarts, which triggers procedure to initialize land use + contains + + public :: get_current_landuse_statevector + end type ed_site_type ! Make public necessary subroutines and functions @@ -508,7 +512,41 @@ subroutine dump_site(csite) write(fates_log(),*) '----------------------------------------' return -end subroutine dump_site + end subroutine dump_site + + ! ===================================================================================== + + subroutine get_current_landuse_statevector(this, current_state_vector) + + ! + ! !DESCRIPTION: + ! Calculate how much of a site is each land use category. + ! this does not include bare ground when nocomp + fixed biogeography is on, + ! so will not sum to one in that case. otherwise it will sum to one. + ! + ! !USES: + ! + ! !ARGUMENTS: + class(ed_site_type) :: this + real(r8), intent(out) :: current_state_vector(n_landuse_cats) + + ! !LOCAL VARIABLES: + type(fates_patch_type), pointer :: currentPatch + + current_state_vector(:) = 0._r8 + + currentPatch => this%oldest_patch + do while (associated(currentPatch)) + if (currentPatch%land_use_label .gt. nocomp_bareground_land) then + current_state_vector(currentPatch%land_use_label) = & + current_state_vector(currentPatch%land_use_label) + & + currentPatch%area/AREA + end if + currentPatch => currentPatch%younger + end do + + end subroutine get_current_landuse_statevector + end module EDTypesMod From 833e39719e5b3b51d24ce298269432f770adbcf5 Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Tue, 2 Apr 2024 14:44:46 -0700 Subject: [PATCH 061/112] covert get_current_landuse_statevector to a function --- biogeochem/EDPatchDynamicsMod.F90 | 4 ++-- main/EDMainMod.F90 | 2 +- main/EDTypesMod.F90 | 6 +++--- 3 files changed, 6 insertions(+), 6 deletions(-) diff --git a/biogeochem/EDPatchDynamicsMod.F90 b/biogeochem/EDPatchDynamicsMod.F90 index b174ef8b9f..4d37ecc6d3 100644 --- a/biogeochem/EDPatchDynamicsMod.F90 +++ b/biogeochem/EDPatchDynamicsMod.F90 @@ -222,7 +222,7 @@ subroutine disturbance_rates( site_in, bc_in) !---------------------------------------------------------------------------------------------- ! first calculate the fraction of the site that is primary land - call site_in%get_current_landuse_statevector(current_fates_landuse_state_vector) + current_fates_landuse_state_vector = site_in%get_current_landuse_statevector() ! check status of transition_landuse_from_off_to_on flag, and do some error checking on it if(site_in%transition_landuse_from_off_to_on) then @@ -3554,7 +3554,7 @@ subroutine terminate_patches(currentSite, bc_in) write(fates_log(),*) patchpointer%area, patchpointer%nocomp_pft_label, patchpointer%land_use_label patchpointer => patchpointer%older end do - call currentSite%get_current_landuse_statevector(state_vector_internal) + state_vector_internal = currentSite%get_current_landuse_statevector() write(fates_log(),*) 'current landuse state vector: ', state_vector_internal write(fates_log(),*) 'current landuse state vector (not including bare gruond): ', state_vector_internal/(1._r8-currentSite%area_bareground) call get_luh_statedata(bc_in, state_vector_driver) diff --git a/main/EDMainMod.F90 b/main/EDMainMod.F90 index 3368d1284f..cd98993a6b 100644 --- a/main/EDMainMod.F90 +++ b/main/EDMainMod.F90 @@ -414,7 +414,7 @@ subroutine ed_integrate_state_variables(currentSite, bc_in, bc_out ) !----------------------------------------------------------------------- - call currentSite%get_current_landuse_statevector(current_fates_landuse_state_vector) + current_fates_landuse_state_vector = currentSite%get_current_landuse_statevector() ! Clear site GPP and AR passing to HLM bc_out%gpp_site = 0._r8 diff --git a/main/EDTypesMod.F90 b/main/EDTypesMod.F90 index deceac558b..18498230f6 100644 --- a/main/EDTypesMod.F90 +++ b/main/EDTypesMod.F90 @@ -516,7 +516,7 @@ end subroutine dump_site ! ===================================================================================== - subroutine get_current_landuse_statevector(this, current_state_vector) + function get_current_landuse_statevector(this) result(current_state_vector) ! ! !DESCRIPTION: @@ -527,8 +527,8 @@ subroutine get_current_landuse_statevector(this, current_state_vector) ! !USES: ! ! !ARGUMENTS: - class(ed_site_type) :: this - real(r8), intent(out) :: current_state_vector(n_landuse_cats) + class(ed_site_type) :: this + real(r8) :: current_state_vector(n_landuse_cats) ! !LOCAL VARIABLES: type(fates_patch_type), pointer :: currentPatch From 157df2b583043b84e0468aad4c0d8d6aadec1148 Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Thu, 4 Apr 2024 15:41:14 -0700 Subject: [PATCH 062/112] condense common code into a new subroutine --- biogeochem/EDPatchDynamicsMod.F90 | 77 +++++++++++-------------------- 1 file changed, 27 insertions(+), 50 deletions(-) diff --git a/biogeochem/EDPatchDynamicsMod.F90 b/biogeochem/EDPatchDynamicsMod.F90 index e610e7c22a..ca997a5c63 100644 --- a/biogeochem/EDPatchDynamicsMod.F90 +++ b/biogeochem/EDPatchDynamicsMod.F90 @@ -774,24 +774,7 @@ subroutine spawn_patches( currentSite, bc_in) call endrun(msg=errMsg(sourcefile, __LINE__)) end select - - ! Copy any means or timers from the original patch to the new patch - ! These values will inherit all info from the original patch - ! -------------------------------------------------------------------------- - call newPatch%tveg24%CopyFromDonor(currentPatch%tveg24) - call newPatch%tveg_lpa%CopyFromDonor(currentPatch%tveg_lpa) - call newPatch%tveg_longterm%CopyFromDonor(currentPatch%tveg_longterm) - - - if ( regeneration_model == TRS_regeneration ) then - call newPatch%seedling_layer_par24%CopyFromDonor(currentPatch%seedling_layer_par24) - call newPatch%sdlng_mort_par%CopyFromDonor(currentPatch%sdlng_mort_par) - call newPatch%sdlng2sap_par%CopyFromDonor(currentPatch%sdlng2sap_par) - do pft = 1,numpft - call newPatch%sdlng_emerg_smp(pft)%p%CopyFromDonor(currentPatch%sdlng_emerg_smp(pft)%p) - call newPatch%sdlng_mdd(pft)%p%CopyFromDonor(currentPatch%sdlng_mdd(pft)%p) - enddo - end if + call CopyPatchMeansTimers(newPatch, currentPatch) call newPatch%tveg_longterm%CopyFromDonor(currentPatch%tveg_longterm) @@ -1410,22 +1393,8 @@ subroutine spawn_patches( currentSite, bc_in) buffer_patch%tallest => null() buffer_patch%shortest => null() - ! Copy any means or timers from the original patch to the new patch - ! These values will inherit all info from the original patch - ! -------------------------------------------------------------------------- - call buffer_patch%tveg24%CopyFromDonor(copyPatch%tveg24) - call buffer_patch%tveg_lpa%CopyFromDonor(copyPatch%tveg_lpa) - call buffer_patch%tveg_longterm%CopyFromDonor(copyPatch%tveg_longterm) - - if ( regeneration_model == TRS_regeneration ) then - call buffer_patch%seedling_layer_par24%CopyFromDonor(copyPatch%seedling_layer_par24) - call buffer_patch%sdlng_mort_par%CopyFromDonor(copyPatch%sdlng_mort_par) - call buffer_patch%sdlng2sap_par%CopyFromDonor(copyPatch%sdlng2sap_par) - do pft = 1,numpft - call buffer_patch%sdlng_emerg_smp(pft)%p%CopyFromDonor(copyPatch%sdlng_emerg_smp(pft)%p) - call buffer_patch%sdlng_mdd(pft)%p%CopyFromDonor(copyPatch%sdlng_mdd(pft)%p) - enddo - end if + call CopyPatchMeansTimers() + buffer_patch_used = .false. currentPatch => currentSite%oldest_patch @@ -1669,23 +1638,8 @@ subroutine split_patch(currentSite, currentPatch, new_patch, fraction_to_keep) new_patch%tallest => null() new_patch%shortest => null() - ! Copy any means or timers from the original patch to the new patch - ! These values will inherit all info from the original patch - ! -------------------------------------------------------------------------- - call new_patch%tveg24%CopyFromDonor(currentPatch%tveg24) - call new_patch%tveg_lpa%CopyFromDonor(currentPatch%tveg_lpa) - call new_patch%tveg_longterm%CopyFromDonor(currentPatch%tveg_longterm) + call CopyPatchMeansTimers(new_patch, currentPatch) - if ( regeneration_model == TRS_regeneration ) then - call new_patch%seedling_layer_par24%CopyFromDonor(currentPatch%seedling_layer_par24) - call new_patch%sdlng_mort_par%CopyFromDonor(currentPatch%sdlng_mort_par) - call new_patch%sdlng2sap_par%CopyFromDonor(currentPatch%sdlng2sap_par) - do pft = 1,numpft - call new_patch%sdlng_emerg_smp(pft)%p%CopyFromDonor(currentPatch%sdlng_emerg_smp(pft)%p) - call new_patch%sdlng_mdd(pft)%p%CopyFromDonor(currentPatch%sdlng_mdd(pft)%p) - enddo - end if - currentPatch%burnt_frac_litter(:) = 0._r8 call TransLitterNewPatch( currentSite, currentPatch, new_patch, currentPatch%area * (1.-fraction_to_keep)) @@ -3953,4 +3907,27 @@ subroutine InsertPatch(currentSite, newPatch) end subroutine InsertPatch + ! ===================================================================================== + + subroutine CopyPatchMeansTimers(bufferPatch, currentPatch) + + type(fates_patch_type), intent(inout) :: bufferPatch, currentPatch + + ! Copy any means or timers from the original patch to the new patch + ! These values will inherit all info from the original patch + ! -------------------------------------------------------------------------- + call bufferPatch%tveg24%CopyFromDonor(currentPatch%tveg24) + call bufferPatch%tveg_lpa%CopyFromDonor(currentPatch%tveg_lpa) + call bufferPatch%tveg_longterm%CopyFromDonor(currentPatch%tveg_longterm) + + if ( regeneration_model == TRS_regeneration ) then + call bufferPatch%seedling_layer_par24%CopyFromDonor(currentPatch%seedling_layer_par24) + call bufferPatch%sdlng_mort_par%CopyFromDonor(currentPatch%sdlng_mort_par) + call bufferPatch%sdlng2sap_par%CopyFromDonor(currentPatch%sdlng2sap_par) + do pft = 1,numpft + call bufferPatch%sdlng_emerg_smp(pft)%p%CopyFromDonor(currentPatch%sdlng_emerg_smp(pft)%p) + call bufferPatch%sdlng_mdd(pft)%p%CopyFromDonor(currentPatch%sdlng_mdd(pft)%p) + enddo + end if + end module EDPatchDynamicsMod From 44fc070aa56a46d7ee33811be0e9254f0adc3edc Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Thu, 4 Apr 2024 16:02:26 -0700 Subject: [PATCH 063/112] move CopyPatchMeansTimers around to find more common patterns --- biogeochem/EDPatchDynamicsMod.F90 | 75 ++++++++++++++++++------------- 1 file changed, 44 insertions(+), 31 deletions(-) diff --git a/biogeochem/EDPatchDynamicsMod.F90 b/biogeochem/EDPatchDynamicsMod.F90 index ca997a5c63..843d520b87 100644 --- a/biogeochem/EDPatchDynamicsMod.F90 +++ b/biogeochem/EDPatchDynamicsMod.F90 @@ -742,10 +742,13 @@ subroutine spawn_patches( currentSite, bc_in) currentPatch%burnt_frac_litter(:) = 0._r8 end if + call CopyPatchMeansTimers(newPatch, currentPatch) + + call newPatch%tveg_longterm%CopyFromDonor(currentPatch%tveg_longterm) + call TransLitterNewPatch( currentSite, currentPatch, newPatch, patch_site_areadis) ! Transfer in litter fluxes from plants in various contexts of death and destruction - select case(i_disturbance_type) case (dtype_ilog) call logging_litter_fluxes(currentSite, currentPatch, & @@ -774,10 +777,6 @@ subroutine spawn_patches( currentSite, bc_in) call endrun(msg=errMsg(sourcefile, __LINE__)) end select - call CopyPatchMeansTimers(newPatch, currentPatch) - - call newPatch%tveg_longterm%CopyFromDonor(currentPatch%tveg_longterm) - ! -------------------------------------------------------------------------- ! The newly formed patch from disturbance (newPatch), has now been given ! some litter from dead plants and pre-existing litter from the donor patches. @@ -1378,9 +1377,6 @@ subroutine spawn_patches( currentSite, bc_in) hlm_numSWb, numpft, currentSite%nlevsoil, hlm_current_tod, & regeneration_model) - ! make a note that this buffer patch has not been put into the linked list - buffer_patch_in_linked_list = .false. - ! Initialize the litter pools to zero do el=1,num_elements call buffer_patch%litter(el)%InitConditions(init_leaf_fines=0._r8, & @@ -1393,8 +1389,10 @@ subroutine spawn_patches( currentSite, bc_in) buffer_patch%tallest => null() buffer_patch%shortest => null() - call CopyPatchMeansTimers() + call CopyPatchMeansTimers(buffer_patch, currentPatch) + ! make a note that this buffer patch has not been put into the linked list + buffer_patch_in_linked_list = .false. buffer_patch_used = .false. currentPatch => currentSite%oldest_patch @@ -1634,15 +1632,15 @@ subroutine split_patch(currentSite, currentPatch, new_patch, fraction_to_keep) init_seed=0._r8, & init_seed_germ=0._r8) end do - new_patch%tallest => null() new_patch%shortest => null() call CopyPatchMeansTimers(new_patch, currentPatch) - currentPatch%burnt_frac_litter(:) = 0._r8 call TransLitterNewPatch( currentSite, currentPatch, new_patch, currentPatch%area * (1.-fraction_to_keep)) + currentPatch%burnt_frac_litter(:) = 0._r8 + ! Next, we loop through the cohorts in the donor patch, copy them with ! area modified number density into the new-patch, and apply survivorship. ! ------------------------------------------------------------------------- @@ -3909,25 +3907,40 @@ end subroutine InsertPatch ! ===================================================================================== - subroutine CopyPatchMeansTimers(bufferPatch, currentPatch) - - type(fates_patch_type), intent(inout) :: bufferPatch, currentPatch - - ! Copy any means or timers from the original patch to the new patch - ! These values will inherit all info from the original patch - ! -------------------------------------------------------------------------- - call bufferPatch%tveg24%CopyFromDonor(currentPatch%tveg24) - call bufferPatch%tveg_lpa%CopyFromDonor(currentPatch%tveg_lpa) - call bufferPatch%tveg_longterm%CopyFromDonor(currentPatch%tveg_longterm) - - if ( regeneration_model == TRS_regeneration ) then - call bufferPatch%seedling_layer_par24%CopyFromDonor(currentPatch%seedling_layer_par24) - call bufferPatch%sdlng_mort_par%CopyFromDonor(currentPatch%sdlng_mort_par) - call bufferPatch%sdlng2sap_par%CopyFromDonor(currentPatch%sdlng2sap_par) - do pft = 1,numpft - call bufferPatch%sdlng_emerg_smp(pft)%p%CopyFromDonor(currentPatch%sdlng_emerg_smp(pft)%p) - call bufferPatch%sdlng_mdd(pft)%p%CopyFromDonor(currentPatch%sdlng_mdd(pft)%p) - enddo - end if + subroutine CopyPatchMeansTimers(dp, rp) + + ! !DESCRIPTION: + ! Copy any means or timers from the original patch to the new patch + ! These values will inherit all info from the original patch + ! -------------------------------------------------------------------------- + ! + ! !ARGUMENTS: + type (fates_patch_type) , pointer :: dp ! Donor Patch + type (fates_patch_type) , target, intent(inout) :: rp ! Recipient Patch + + call rp%tveg24%CopyFromDonor(dp%tveg24) + call rp%tveg_lpa%CopyFromDonor(dp%tveg_lpa) + call rp%tveg_longterm%CopyFromDonor(dp%tveg_longterm) + + if ( regeneration_model == TRS_regeneration ) then + call rp%seedling_layer_par24%CopyFromDonor(dp%seedling_layer_par24) + call rp%sdlng_mort_par%CopyFromDonor(dp%sdlng_mort_par) + call rp%sdlng2sap_par%CopyFromDonor(dp%sdlng2sap_par) + do pft = 1,numpft + call rp%sdlng_emerg_smp(pft)%p%CopyFromDonor(dp%sdlng_emerg_smp(pft)%p) + call rp%sdlng_mdd(pft)%p%CopyFromDonor(dp%sdlng_mdd(pft)%p) + enddo + end if + + ! ===================================================================================== + + subroutine newsub(dp, rp) + + ! !DESCRIPTION: + ! + ! !ARGUMENTS: + type (fates_patch_type) , pointer :: dp ! Donor Patch + type (fates_patch_type) , target, intent(inout) :: rp ! Recipient Patch + end module EDPatchDynamicsMod From 63045a99745b65128a73002c3fed17ae0b1ed60b Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Thu, 4 Apr 2024 16:10:39 -0700 Subject: [PATCH 064/112] remove subroutine stub --- biogeochem/EDPatchDynamicsMod.F90 | 10 ---------- 1 file changed, 10 deletions(-) diff --git a/biogeochem/EDPatchDynamicsMod.F90 b/biogeochem/EDPatchDynamicsMod.F90 index 843d520b87..6e187e2f6e 100644 --- a/biogeochem/EDPatchDynamicsMod.F90 +++ b/biogeochem/EDPatchDynamicsMod.F90 @@ -3932,15 +3932,5 @@ subroutine CopyPatchMeansTimers(dp, rp) enddo end if - ! ===================================================================================== - - subroutine newsub(dp, rp) - - ! !DESCRIPTION: - ! - ! !ARGUMENTS: - type (fates_patch_type) , pointer :: dp ! Donor Patch - type (fates_patch_type) , target, intent(inout) :: rp ! Recipient Patch - end module EDPatchDynamicsMod From c19d973fec104f251da09b248310156427b07470 Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Thu, 4 Apr 2024 16:11:46 -0700 Subject: [PATCH 065/112] remove duplicate tveg_longterm update that has been condensed --- biogeochem/EDPatchDynamicsMod.F90 | 2 -- 1 file changed, 2 deletions(-) diff --git a/biogeochem/EDPatchDynamicsMod.F90 b/biogeochem/EDPatchDynamicsMod.F90 index 6e187e2f6e..085291fdbe 100644 --- a/biogeochem/EDPatchDynamicsMod.F90 +++ b/biogeochem/EDPatchDynamicsMod.F90 @@ -744,8 +744,6 @@ subroutine spawn_patches( currentSite, bc_in) call CopyPatchMeansTimers(newPatch, currentPatch) - call newPatch%tveg_longterm%CopyFromDonor(currentPatch%tveg_longterm) - call TransLitterNewPatch( currentSite, currentPatch, newPatch, patch_site_areadis) ! Transfer in litter fluxes from plants in various contexts of death and destruction From 2a5b19f749412f6824e98f17fe73a873a50de22a Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Thu, 11 Apr 2024 10:16:51 -0700 Subject: [PATCH 066/112] fixing typos and minor formatting --- biogeochem/EDPatchDynamicsMod.F90 | 2 +- biogeochem/EDPhysiologyMod.F90 | 2 +- biogeochem/FatesLandUseChangeMod.F90 | 5 ++--- main/EDInitMod.F90 | 4 ++-- 4 files changed, 6 insertions(+), 7 deletions(-) diff --git a/biogeochem/EDPatchDynamicsMod.F90 b/biogeochem/EDPatchDynamicsMod.F90 index e610e7c22a..9d4da65b53 100644 --- a/biogeochem/EDPatchDynamicsMod.F90 +++ b/biogeochem/EDPatchDynamicsMod.F90 @@ -3549,7 +3549,7 @@ subroutine terminate_patches(currentSite, bc_in) call dump_site(currentSite) write(fates_log(),*) 'currentSite%area_bareground', currentSite%area_bareground - write(fates_log(),*) 'currentSite%%area_pft(:,:)', currentSite%area_pft(:,:) + write(fates_log(),*) 'currentSite%area_pft(:,:)', currentSite%area_pft(:,:) patchpointer => currentSite%youngest_patch do while(associated(patchpointer)) write(fates_log(),*) patchpointer%area, patchpointer%nocomp_pft_label, patchpointer%land_use_label diff --git a/biogeochem/EDPhysiologyMod.F90 b/biogeochem/EDPhysiologyMod.F90 index e02e1f0249..aa42fe8f11 100644 --- a/biogeochem/EDPhysiologyMod.F90 +++ b/biogeochem/EDPhysiologyMod.F90 @@ -2493,7 +2493,7 @@ subroutine recruitment(currentSite, currentPatch, bc_in) real(r8) :: seedling_layer_smp ! soil matric potential at seedling rooting depth [mm H2O suction] integer, parameter :: recruitstatus = 1 ! whether the newly created cohorts are recruited or initialized integer :: ilayer_seedling_root ! the soil layer at seedling rooting depth - logical :: use_this_pft ! logcla flag for whetehr o rnot to allow a given PFT to recruit + logical :: use_this_pft ! logical flag for whether or not to allow a given PFT to recruit !--------------------------------------------------------------------------- do ft = 1, numpft diff --git a/biogeochem/FatesLandUseChangeMod.F90 b/biogeochem/FatesLandUseChangeMod.F90 index eab70708df..c244f7267b 100644 --- a/biogeochem/FatesLandUseChangeMod.F90 +++ b/biogeochem/FatesLandUseChangeMod.F90 @@ -304,7 +304,6 @@ subroutine get_luh_statedata(bc_in, state_vector) ! check to ensure total area == 1, and correct if not if ( abs(sum(state_vector(:)) - 1._r8) .gt. nearzero ) then - !write(fates_log(),*) 'warning: sum(state_vector) = ', sum(state_vector(:)) state_vector(:) = state_vector(:) / sum(state_vector(:)) end if else @@ -381,8 +380,8 @@ end subroutine get_init_landuse_harvest_rate subroutine get_init_landuse_transition_rates(bc_in, min_allowed_landuse_fraction, landuse_transition_matrix, landuse_vector_gt_min) - ! The purose of this subroutine is, only under the case where we are transitioning from a spinup run that did not have land use - ! to a run that does, to apply the land-use changes needed to get to the state vector in a single daily instance. this is for + ! The purpose of this subroutine is, only under the case where we are transitioning from a spinup run that did not have land use + ! to a run that does, to apply the land-use changes needed to get to the state vector in a single daily instance. This is for ! the transitions other than harvest, i.e. from primary lands to all other categories aside from secondary lands. ! !ARGUMENTS: diff --git a/main/EDInitMod.F90 b/main/EDInitMod.F90 index 4c65467b4f..718651c863 100644 --- a/main/EDInitMod.F90 +++ b/main/EDInitMod.F90 @@ -470,7 +470,7 @@ subroutine set_site_properties( nsites, sites,bc_in ) ! where pft_areafrac_lu is the area of land in each HLM PFT and land use type (from surface dataset) ! hlm_pft_map is the area of that land in each FATES PFT (from param file) - ! first check for NaNs in bc_in(s)%pft_areafrac_lu. if so, make everything bare ground. + ! First check for NaNs in bc_in(s)%pft_areafrac_lu. If so, make everything bare ground. if ( .not. (any( isnan( bc_in(s)%pft_areafrac_lu (:,:) )) .or. isnan( bc_in(s)%baregroundfrac))) then do i_landusetype = 1, n_landuse_cats if (.not. is_crop(i_landusetype)) then @@ -558,7 +558,7 @@ subroutine set_site_properties( nsites, sites,bc_in ) sites(s)%area_pft(:, i_landusetype) = temp_vec(:) ! write adjusted vector to log file - if(debug) write(fates_log(),*) 'new PFT vector for LU type', i_landusetype, i_landusetype,sites(s)%area_pft(:, i_landusetype) + if(debug) write(fates_log(),*) 'new PFT vector for LU type', i_landusetype, sites(s)%area_pft(:, i_landusetype) endif end do end if From f90412b30562d20bdada3ec3e46510279ac3a9f0 Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Thu, 11 Apr 2024 10:19:47 -0700 Subject: [PATCH 067/112] refactor pft area normalization to avoid checking sumarea in pft loop --- main/EDInitMod.F90 | 18 +++++++++--------- 1 file changed, 9 insertions(+), 9 deletions(-) diff --git a/main/EDInitMod.F90 b/main/EDInitMod.F90 index 718651c863..aa80e436fc 100644 --- a/main/EDInitMod.F90 +++ b/main/EDInitMod.F90 @@ -567,16 +567,16 @@ subroutine set_site_properties( nsites, sites,bc_in ) ! for nocomp cases, track bare ground area as a separate quantity do i_landusetype = 1, n_landuse_cats sumarea = sum(sites(s)%area_pft(1:numpft,i_landusetype)) - do ft = 1,numpft - if(sumarea.gt.nearzero)then + if(sumarea.gt.nearzero)then + do ft = 1,numpft sites(s)%area_pft(ft, i_landusetype) = sites(s)%area_pft(ft, i_landusetype)/sumarea - else - ! if no PFT area in primary lands, set bare ground fraction to one. - if ( i_landusetype .eq. primaryland) then - sites(s)%area_bareground = 1._r8 - endif - end if - end do !ft + end do !ft + else + ! if no PFT area in primary lands, set bare ground fraction to one. + if ( i_landusetype .eq. primaryland) then + sites(s)%area_bareground = 1._r8 + endif + end if end do end if !fixed biogeog From e77dda4614ba644b0188b74acef5fd056547a1da Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Thu, 11 Apr 2024 10:35:49 -0700 Subject: [PATCH 068/112] convert loop to single line call Also make sure that all primaryland pft areas are exactly zero when bareground area is 1 --- main/EDInitMod.F90 | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) diff --git a/main/EDInitMod.F90 b/main/EDInitMod.F90 index aa80e436fc..658e127506 100644 --- a/main/EDInitMod.F90 +++ b/main/EDInitMod.F90 @@ -568,13 +568,12 @@ subroutine set_site_properties( nsites, sites,bc_in ) do i_landusetype = 1, n_landuse_cats sumarea = sum(sites(s)%area_pft(1:numpft,i_landusetype)) if(sumarea.gt.nearzero)then - do ft = 1,numpft - sites(s)%area_pft(ft, i_landusetype) = sites(s)%area_pft(ft, i_landusetype)/sumarea - end do !ft + sites(s)%area_pft(:, i_landusetype) = sites(s)%area_pft(:, i_landusetype)/sumarea else ! if no PFT area in primary lands, set bare ground fraction to one. if ( i_landusetype .eq. primaryland) then sites(s)%area_bareground = 1._r8 + sites(s)%area_pft(:, i_landusetype) = 0._r8 endif end if end do From b835a84b7fd22f12169727def452ef890e87ba71 Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Thu, 11 Apr 2024 10:41:49 -0700 Subject: [PATCH 069/112] simplify indexing across all pfts for given landuse type now that we don't allocate a zero index for area_pft --- main/EDInitMod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/main/EDInitMod.F90 b/main/EDInitMod.F90 index 658e127506..c416985416 100644 --- a/main/EDInitMod.F90 +++ b/main/EDInitMod.F90 @@ -566,7 +566,7 @@ subroutine set_site_properties( nsites, sites,bc_in ) ! re-normalize PFT area to ensure it sums to one for each (active) land use type ! for nocomp cases, track bare ground area as a separate quantity do i_landusetype = 1, n_landuse_cats - sumarea = sum(sites(s)%area_pft(1:numpft,i_landusetype)) + sumarea = sum(sites(s)%area_pft(:,i_landusetype)) if(sumarea.gt.nearzero)then sites(s)%area_pft(:, i_landusetype) = sites(s)%area_pft(:, i_landusetype)/sumarea else From 1508b7b0e4a9ecb83de0977ef8f38c78b6ff991c Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Thu, 11 Apr 2024 11:49:55 -0700 Subject: [PATCH 070/112] more minor typo fixes --- main/EDInitMod.F90 | 8 +++----- 1 file changed, 3 insertions(+), 5 deletions(-) diff --git a/main/EDInitMod.F90 b/main/EDInitMod.F90 index 718651c863..9185df8197 100644 --- a/main/EDInitMod.F90 +++ b/main/EDInitMod.F90 @@ -698,8 +698,6 @@ subroutine init_patches( nsites, sites, bc_in) else - ! state_vector(:) = 0._r8 - if(hlm_use_nocomp.eq.itrue)then num_nocomp_pfts = numpft else !default @@ -766,7 +764,7 @@ subroutine init_patches( nsites, sites, bc_in) hlm_numSWb, numpft, sites(s)%nlevsoil, hlm_current_tod, & regeneration_model) - ! set poointers for first patch (or only patch, if nocomp is false) + ! set pointers for first patch (or only patch, if nocomp is false) newp%patchno = 1 newp%younger => null() newp%older => null() @@ -796,7 +794,7 @@ subroutine init_patches( nsites, sites, bc_in) end_landuse_idx = 1 endif - not_all_baregground_if: if ((1._r8 - sites(s)%area_bareground) .gt. nearzero) then + not_all_bareground_if: if ((1._r8 - sites(s)%area_bareground) .gt. nearzero) then ! now make one or more vegetated patches based on nocomp and land use logic luh_state_loop: do i_lu_state = 1, end_landuse_idx lu_state_present_if: if (state_vector(i_lu_state) .gt. nearzero) then @@ -876,7 +874,7 @@ subroutine init_patches( nsites, sites, bc_in) end do new_patch_nocomp_loop end if lu_state_present_if end do luh_state_loop - end if not_all_baregground_if + end if not_all_bareground_if ! if we had to skip small patches above, resize things accordingly if ( area_error .gt. nearzero) then From 73cd037372f0f54563340ff5cbe9ddb506d0bff6 Mon Sep 17 00:00:00 2001 From: Sam Rabin Date: Thu, 18 Apr 2024 10:48:12 -0600 Subject: [PATCH 071/112] Convert an array index from real to int, satisfing nag compiler. --- main/EDInitMod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/main/EDInitMod.F90 b/main/EDInitMod.F90 index 9185df8197..10bd6224f6 100644 --- a/main/EDInitMod.F90 +++ b/main/EDInitMod.F90 @@ -482,7 +482,7 @@ subroutine set_site_properties( nsites, sites,bc_in ) end do !hlm_pft else ! for crops, we need to use different logic because the bc_in(s)%pft_areafrac_lu() information only exists for natural PFTs - sites(s)%area_pft(crop_lu_pft_vector(i_landusetype),i_landusetype) = 1._r8 + sites(s)%area_pft(int(crop_lu_pft_vector(i_landusetype)),i_landusetype) = 1._r8 endif end do From c03a4ba64a7e59817658f1c3357ffff681d8b958 Mon Sep 17 00:00:00 2001 From: Sam Rabin Date: Thu, 18 Apr 2024 11:29:48 -0600 Subject: [PATCH 072/112] Change crop_lu_pft_vector from real to int. --- main/EDInitMod.F90 | 2 +- main/EDParamsMod.F90 | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/main/EDInitMod.F90 b/main/EDInitMod.F90 index 10bd6224f6..9185df8197 100644 --- a/main/EDInitMod.F90 +++ b/main/EDInitMod.F90 @@ -482,7 +482,7 @@ subroutine set_site_properties( nsites, sites,bc_in ) end do !hlm_pft else ! for crops, we need to use different logic because the bc_in(s)%pft_areafrac_lu() information only exists for natural PFTs - sites(s)%area_pft(int(crop_lu_pft_vector(i_landusetype)),i_landusetype) = 1._r8 + sites(s)%area_pft(crop_lu_pft_vector(i_landusetype),i_landusetype) = 1._r8 endif end do diff --git a/main/EDParamsMod.F90 b/main/EDParamsMod.F90 index f63698afb8..49271eb890 100644 --- a/main/EDParamsMod.F90 +++ b/main/EDParamsMod.F90 @@ -260,7 +260,7 @@ module EDParamsMod integer, public :: maxpatch_total ! which crops can be grown on a given crop land use type - real(r8),protected,public :: crop_lu_pft_vector(n_landuse_cats) + integer,protected,public :: crop_lu_pft_vector(n_landuse_cats) ! Maximum allowable cohorts per patch integer, protected, public :: max_cohort_per_patch From c611b0d25c2bc610e83ad988bb2cafaad89f62b3 Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Tue, 23 Apr 2024 13:06:18 -0400 Subject: [PATCH 073/112] syntax style updates --- biogeochem/FatesLandUseChangeMod.F90 | 31 +++++++++++++++++++--------- 1 file changed, 21 insertions(+), 10 deletions(-) diff --git a/biogeochem/FatesLandUseChangeMod.F90 b/biogeochem/FatesLandUseChangeMod.F90 index c244f7267b..3ef66cf75c 100644 --- a/biogeochem/FatesLandUseChangeMod.F90 +++ b/biogeochem/FatesLandUseChangeMod.F90 @@ -101,7 +101,8 @@ subroutine get_landuse_transition_rates(bc_in, min_allowed_landuse_fraction, lan urban_fraction = bc_in%hlm_luh_states(FindIndex(bc_in%hlm_luh_state_names,'urban')) end if - !!TODO: may need some logic here to ask whether or not ot perform land use change on this timestep. current code occurs every day. + !!TODO: may need some logic here to ask whether or not ot perform land use change on this + ! timestep. current code occurs every day. !!If not doing transition every day, need to update units. transitions_loop: do i_luh2_transitions = 1, hlm_num_luh2_transitions @@ -170,15 +171,19 @@ end function GetLUCategoryFromStateName subroutine get_landusechange_rules(clearing_matrix) - ! the purpose of this is to define a ruleset for when to clear the vegetation in transitioning from one land use type to another + ! the purpose of this is to define a ruleset for when to clear the + ! vegetation in transitioning from one land use type to another logical, intent(out) :: clearing_matrix(n_landuse_cats,n_landuse_cats) - ! default value of ruleset 4 above means that plants are not cleared during land use change transitions to rangeland, whereas plants are + ! default value of ruleset 4 above means that plants are not cleared during + ! land use change transitions to rangeland, whereas plants are ! cleared in transitions to pasturelands and croplands. - integer, parameter :: ruleset = 4 ! ruleset to apply from table 1 of Ma et al (2020) https://doi.org/10.5194/gmd-13-3203-2020 + integer, parameter :: ruleset = 4 ! ruleset to apply from table 1 of Ma et al + ! (2020) https://doi.org/10.5194/gmd-13-3203-2020 - ! clearing matrix applies from the donor to the receiver land use type of the newly-transferred patch area + ! clearing matrix applies from the donor to the receiver land use + ! type of the newly-transferred patch area ! values of clearing matrix: false => do not clear; true => clear clearing_matrix(:,:) = .false. @@ -187,8 +192,9 @@ subroutine get_landusechange_rules(clearing_matrix) case(1) - ! note that this ruleset isnt exactly what is in Ma et al. rulesets 1 and 2, because FATES does not make the distinction - ! between forested and non-forested lands from a land use/land cover perspective. + ! note that this ruleset isnt exactly what is in Ma et al. rulesets 1 and 2, + ! because FATES does not make the distinction between forested and non-forested + ! lands from a land use/land cover perspective. clearing_matrix(:,cropland) = .true. clearing_matrix(:,pastureland) = .true. clearing_matrix(primaryland,rangeland) = .true. @@ -310,6 +316,10 @@ subroutine get_luh_statedata(bc_in, state_vector) state_vector(primaryland) = 1._r8 endif else + + ! If we are using potential vegetation, that means + ! our only land classification is primary land + state_vector(primaryland) = 1._r8 end if @@ -326,8 +336,8 @@ subroutine CheckLUHData(luh_vector,modified_flag) ! Check to see if the incoming luh2 vector is NaN. ! This suggests that there is a discepency where the HLM and LUH2 states - ! there is vegetated ground. E.g. LUH2 data is missing for glacier-margin regions such as Antarctica. - ! In this case, states should be Nan. If so, + ! there is vegetated ground. E.g. LUH2 data is missing for glacier-margin + ! regions such as Antarctica. In this case, states should be Nan. If so, ! set the current state to be all primary forest, and all transitions to be zero. ! If only a portion of the vector is NaN, there is something amiss with ! the data, so end the run. @@ -340,7 +350,8 @@ subroutine CheckLUHData(luh_vector,modified_flag) luh_vector(primaryland) = 1._r8 end if modified_flag = .true. - !write(fates_log(),*) 'WARNING: land use state is all NaN; setting state as all primary forest.' ! GL DIAG + !write(fates_log(),*) 'WARNING: land use state is all NaN; + !setting state as all primary forest.' ! GL DIAG else if (any(isnan(luh_vector))) then if (any(.not. isnan(luh_vector))) then write(fates_log(),*) 'ERROR: land use vector has NaN' From b105d56f6594efba5740e70ac27d567ad1df4c93 Mon Sep 17 00:00:00 2001 From: Charlie Koven Date: Tue, 23 Apr 2024 15:21:31 -0700 Subject: [PATCH 074/112] PascalCase --- biogeochem/EDLoggingMortalityMod.F90 | 8 +++---- biogeochem/EDPatchDynamicsMod.F90 | 22 ++++++++--------- biogeochem/FatesLandUseChangeMod.F90 | 36 ++++++++++++++-------------- 3 files changed, 33 insertions(+), 33 deletions(-) diff --git a/biogeochem/EDLoggingMortalityMod.F90 b/biogeochem/EDLoggingMortalityMod.F90 index c80244e392..caf55d7f74 100644 --- a/biogeochem/EDLoggingMortalityMod.F90 +++ b/biogeochem/EDLoggingMortalityMod.F90 @@ -71,8 +71,8 @@ module EDLoggingMortalityMod use FatesConstantsMod , only : hlm_harvest_carbon use FatesConstantsMod, only : fates_check_param_set use FatesInterfaceTypesMod , only : numpft - use FatesLandUseChangeMod, only : get_init_landuse_harvest_rate - use FatesLandUseChangeMod, only : get_luh_statedata + use FatesLandUseChangeMod, only : GetInitLanduseHarvestRate + use FatesLandUseChangeMod, only : GetLUHStatedata implicit none private @@ -249,7 +249,7 @@ subroutine LoggingMortality_frac( currentSite, bc_in, pft_i, dbh, canopy_layer, ! todo: eventually set up distinct harvest practices, each with a set of input paramaeters ! todo: implement harvested carbon inputs - call get_luh_statedata(bc_in, state_vector) + call GetLUHStatedata(bc_in, state_vector) site_secondaryland_first_exceeding_min = (state_vector(secondaryland) .gt. currentSite%min_allowed_landuse_fraction) & .and. (.not. currentSite%landuse_vector_gt_min(secondaryland)) @@ -368,7 +368,7 @@ subroutine LoggingMortality_frac( currentSite, bc_in, pft_i, dbh, canopy_layer, endif else - call get_init_landuse_harvest_rate(bc_in, currentSite%min_allowed_landuse_fraction, & + call GetInitLanduseHarvestRate(bc_in, currentSite%min_allowed_landuse_fraction, & harvest_rate, currentSite%landuse_vector_gt_min) if(prt_params%woody(pft_i) == itrue)then lmort_direct = harvest_rate diff --git a/biogeochem/EDPatchDynamicsMod.F90 b/biogeochem/EDPatchDynamicsMod.F90 index 9d4da65b53..86a2e197c4 100644 --- a/biogeochem/EDPatchDynamicsMod.F90 +++ b/biogeochem/EDPatchDynamicsMod.F90 @@ -72,7 +72,7 @@ module EDPatchDynamicsMod use EDLoggingMortalityMod, only : get_harvest_rate_carbon use EDLoggingMortalityMod, only : get_harvestable_carbon use EDLoggingMortalityMod, only : get_harvest_debt - use FatesLandUseChangeMod, only : get_init_landuse_harvest_rate + use FatesLandUseChangeMod, only : GetInitLanduseHarvestRate use EDParamsMod , only : fates_mortality_disturbance_fraction use FatesAllometryMod , only : carea_allom use FatesAllometryMod , only : set_root_fraction @@ -84,9 +84,9 @@ module EDPatchDynamicsMod use FatesConstantsMod , only : primaryland, secondaryland, pastureland, rangeland, cropland use FatesConstantsMod , only : nocomp_bareground_land use FatesConstantsMod , only : n_landuse_cats - use FatesLandUseChangeMod, only : get_landuse_transition_rates - use FatesLandUseChangeMod, only : get_init_landuse_transition_rates - use FatesLandUseChangeMod, only : get_luh_statedata + use FatesLandUseChangeMod, only : GetLanduseTransitionRates + use FatesLandUseChangeMod, only : GetInitLanduseTransitionRates + use FatesLandUseChangeMod, only : GetLUHStatedata use FatesConstantsMod , only : fates_unset_r8 use FatesConstantsMod , only : fates_unset_int use FatesConstantsMod , only : hlm_harvest_carbon @@ -288,10 +288,10 @@ subroutine disturbance_rates( site_in, bc_in) if ( hlm_use_luh .eq. itrue ) then if(.not. site_in%transition_landuse_from_off_to_on) then - call get_landuse_transition_rates(bc_in, site_in%min_allowed_landuse_fraction, & + call GetLanduseTransitionRates(bc_in, site_in%min_allowed_landuse_fraction, & site_in%landuse_transition_matrix, site_in%landuse_vector_gt_min) else - call get_init_landuse_transition_rates(bc_in, site_in%min_allowed_landuse_fraction, & + call GetInitLanduseTransitionRates(bc_in, site_in%min_allowed_landuse_fraction, & site_in%landuse_transition_matrix, site_in%landuse_vector_gt_min) endif else @@ -317,7 +317,7 @@ subroutine disturbance_rates( site_in, bc_in) end do ! get some info needed to determine whether or not to apply land use change - call get_luh_statedata(bc_in, state_vector) + call GetLUHStatedata(bc_in, state_vector) site_secondaryland_first_exceeding_min = (state_vector(secondaryland) .gt. site_in%min_allowed_landuse_fraction) & .and. (.not. site_in%landuse_vector_gt_min(secondaryland)) @@ -407,7 +407,7 @@ subroutine disturbance_rates( site_in, bc_in) harvest_rate = 0._r8 end if else - call get_init_landuse_harvest_rate(bc_in, site_in%min_allowed_landuse_fraction, & + call GetInitLanduseHarvestRate(bc_in, site_in%min_allowed_landuse_fraction, & harvest_rate, site_in%landuse_vector_gt_min) endif @@ -495,7 +495,7 @@ subroutine spawn_patches( currentSite, bc_in) use EDParamsMod , only : ED_val_understorey_death, logging_coll_under_frac use EDCohortDynamicsMod , only : terminate_cohorts use FatesConstantsMod , only : rsnbl_math_prec - use FatesLandUseChangeMod, only : get_landusechange_rules + use FatesLandUseChangeMod, only : GetLanduseChangeRules ! ! !ARGUMENTS: type (ed_site_type), intent(inout) :: currentSite @@ -564,7 +564,7 @@ subroutine spawn_patches( currentSite, bc_in) currentSite%disturbance_rates(:,:,:) = 0._r8 ! get rules for vegetation clearing during land use change - call get_landusechange_rules(clearing_matrix) + call GetLanduseChangeRules(clearing_matrix) ! in the nocomp cases, since every patch has a PFT identity, it can only receive patch area from patches ! that have the same identity. In order to allow this, we have this very high level loop over nocomp PFTs @@ -3558,7 +3558,7 @@ subroutine terminate_patches(currentSite, bc_in) call get_current_landuse_statevector(currentSite, state_vector_internal) write(fates_log(),*) 'current landuse state vector: ', state_vector_internal write(fates_log(),*) 'current landuse state vector (not including bare gruond): ', state_vector_internal/(1._r8-currentSite%area_bareground) - call get_luh_statedata(bc_in, state_vector_driver) + call GetLUHStatedata(bc_in, state_vector_driver) write(fates_log(),*) 'driver data landuse state vector: ', state_vector_driver write(fates_log(),*) 'min_allowed_landuse_fraction: ', currentSite%min_allowed_landuse_fraction write(fates_log(),*) 'landuse_vector_gt_min: ', currentSite%landuse_vector_gt_min diff --git a/biogeochem/FatesLandUseChangeMod.F90 b/biogeochem/FatesLandUseChangeMod.F90 index c244f7267b..b30ee74288 100644 --- a/biogeochem/FatesLandUseChangeMod.F90 +++ b/biogeochem/FatesLandUseChangeMod.F90 @@ -28,11 +28,11 @@ module FatesLandUseChangeMod character(len=*), parameter :: sourcefile = __FILE__ - public :: get_landuse_transition_rates - public :: get_landusechange_rules - public :: get_luh_statedata - public :: get_init_landuse_transition_rates - public :: get_init_landuse_harvest_rate + public :: GetLanduseTransitionRates + public :: GetLanduseChangeRules + public :: GetLUHStatedata + public :: GetInitLanduseTransitionRates + public :: GetInitLanduseHarvestRate ! module data integer, parameter :: max_luh2_types_per_fates_lu_type = 5 @@ -62,7 +62,7 @@ module FatesLandUseChangeMod contains ! ============================================================================ - subroutine get_landuse_transition_rates(bc_in, min_allowed_landuse_fraction, landuse_transition_matrix, landuse_vector_gt_min) + subroutine GetLanduseTransitionRates(bc_in, min_allowed_landuse_fraction, landuse_transition_matrix, landuse_vector_gt_min) ! The purpose of this routine is to ingest the land use transition rate information that the host model has read in from a dataset, @@ -128,7 +128,7 @@ subroutine get_landuse_transition_rates(bc_in, min_allowed_landuse_fraction, lan ! and otherwise if this is the first timestep where the minimum was exceeded, ! then apply all transitions from primary to this type and reset the flag ! note that the flag resetting should not happen for secondary lands, as this is handled in the logging logic - call get_luh_statedata(bc_in, state_vector) + call GetLUHStatedata(bc_in, state_vector) do i_lu = secondaryland, n_landuse_cats if ( state_vector(i_lu) .le. min_allowed_landuse_fraction ) then landuse_transition_matrix(:,i_lu) = 0._r8 @@ -140,7 +140,7 @@ subroutine get_landuse_transition_rates(bc_in, min_allowed_landuse_fraction, lan end do end if - end subroutine get_landuse_transition_rates + end subroutine GetLanduseTransitionRates !---------------------------------------------------------------------------------------------------- @@ -168,7 +168,7 @@ end function GetLUCategoryFromStateName !---------------------------------------------------------------------------------------------------- - subroutine get_landusechange_rules(clearing_matrix) + subroutine GetLanduseChangeRules(clearing_matrix) ! the purpose of this is to define a ruleset for when to clear the vegetation in transitioning from one land use type to another @@ -253,11 +253,11 @@ subroutine get_landusechange_rules(clearing_matrix) end select - end subroutine get_landusechange_rules + end subroutine GetLanduseChangeRules !---------------------------------------------------------------------------------------------------- - subroutine get_luh_statedata(bc_in, state_vector) + subroutine GetLUHStatedata(bc_in, state_vector) type(bc_in_type) , intent(in) :: bc_in real(r8), intent(out) :: state_vector(n_landuse_cats) ! [m2/m2] @@ -313,7 +313,7 @@ subroutine get_luh_statedata(bc_in, state_vector) state_vector(primaryland) = 1._r8 end if - end subroutine get_luh_statedata + end subroutine GetLUHStatedata !---------------------------------------------------------------------------------------------------- @@ -351,7 +351,7 @@ subroutine CheckLUHData(luh_vector,modified_flag) end subroutine CheckLUHData - subroutine get_init_landuse_harvest_rate(bc_in, min_allowed_landuse_fraction, harvest_rate, landuse_vector_gt_min) + subroutine GetInitLanduseHarvestRate(bc_in, min_allowed_landuse_fraction, harvest_rate, landuse_vector_gt_min) ! the purpose of this subroutine is, only under the case where we are transitioning from a spinup run that did not have land use ! to a run that does, to apply the land-use changes needed to get to the state vector in a single daily instance. this is for @@ -367,7 +367,7 @@ subroutine get_init_landuse_harvest_rate(bc_in, min_allowed_landuse_fraction, ha ! LOCALS real(r8) :: state_vector(n_landuse_cats) ! [m2/m2] - call get_luh_statedata(bc_in, state_vector) + call GetLUHStatedata(bc_in, state_vector) ! only do this if the state vector exceeds the minimum viable patch size, and if so, note that in the ! landuse_vector_gt_min flag (which will be coming in as .false. because of the use_potentialveg logic). @@ -376,9 +376,9 @@ subroutine get_init_landuse_harvest_rate(bc_in, min_allowed_landuse_fraction, ha landuse_vector_gt_min(secondaryland) = .true. endif - end subroutine get_init_landuse_harvest_rate + end subroutine GetInitLanduseHarvestRate - subroutine get_init_landuse_transition_rates(bc_in, min_allowed_landuse_fraction, landuse_transition_matrix, landuse_vector_gt_min) + subroutine GetInitLanduseTransitionRates(bc_in, min_allowed_landuse_fraction, landuse_transition_matrix, landuse_vector_gt_min) ! The purpose of this subroutine is, only under the case where we are transitioning from a spinup run that did not have land use ! to a run that does, to apply the land-use changes needed to get to the state vector in a single daily instance. This is for @@ -396,7 +396,7 @@ subroutine get_init_landuse_transition_rates(bc_in, min_allowed_landuse_fraction landuse_transition_matrix(:,:) = 0._r8 - call get_luh_statedata(bc_in, state_vector) + call GetLUHStatedata(bc_in, state_vector) ! only do this if the state vector exceeds the minimum viable patch size, and if so, note that in the ! landuse_vector_gt_min flag (which will be coming in as .false. because of the use_potentialveg logic). @@ -407,6 +407,6 @@ subroutine get_init_landuse_transition_rates(bc_in, min_allowed_landuse_fraction end if end do - end subroutine get_init_landuse_transition_rates + end subroutine GetInitLanduseTransitionRates end module FatesLandUseChangeMod From 34dcc5f79478db4d7c95941dbbc789e784c5304b Mon Sep 17 00:00:00 2001 From: Charlie Koven Date: Tue, 23 Apr 2024 21:54:36 -0700 Subject: [PATCH 075/112] shortening line lengths --- biogeochem/FatesLandUseChangeMod.F90 | 69 +++++++++++++++++----------- 1 file changed, 41 insertions(+), 28 deletions(-) diff --git a/biogeochem/FatesLandUseChangeMod.F90 b/biogeochem/FatesLandUseChangeMod.F90 index b30ee74288..69d06e26f5 100644 --- a/biogeochem/FatesLandUseChangeMod.F90 +++ b/biogeochem/FatesLandUseChangeMod.F90 @@ -62,12 +62,13 @@ module FatesLandUseChangeMod contains ! ============================================================================ - subroutine GetLanduseTransitionRates(bc_in, min_allowed_landuse_fraction, landuse_transition_matrix, landuse_vector_gt_min) + subroutine GetLanduseTransitionRates(bc_in, min_allowed_landuse_fraction, landuse_transition_matrix, & + landuse_vector_gt_min) - ! The purpose of this routine is to ingest the land use transition rate information that the host model has read in from a dataset, - ! aggregate land use types to those being used in the simulation, and output a transition matrix that can be used to drive patch - ! disturbance rates. + ! The purpose of this routine is to ingest the land use transition rate information that the host + ! model has read in from a dataset,aggregate land use types to those being used in the simulation, + ! and output a transition matrix that can be used to drive patch disturbance rates. ! !ARGUMENTS: type(bc_in_type) , intent(in) :: bc_in @@ -101,8 +102,8 @@ subroutine GetLanduseTransitionRates(bc_in, min_allowed_landuse_fraction, landus urban_fraction = bc_in%hlm_luh_states(FindIndex(bc_in%hlm_luh_state_names,'urban')) end if - !!TODO: may need some logic here to ask whether or not ot perform land use change on this timestep. current code occurs every day. - !!If not doing transition every day, need to update units. + !! TODO: may need some logic here to ask whether or not ot perform land use change on this timestep. + !! current code occurs every day. If not doing transition every day, need to update units. transitions_loop: do i_luh2_transitions = 1, hlm_num_luh2_transitions @@ -117,9 +118,11 @@ subroutine GetLanduseTransitionRates(bc_in, min_allowed_landuse_fraction, landus ! Avoid transitions with 'urban' as those are handled seperately ! Also ignore diagonal elements of transition matrix. - if (.not.(i_donor .eq. fates_unset_int .or. i_receiver .eq. fates_unset_int .or. i_donor .eq. i_receiver)) then + if (.not.(i_donor .eq. fates_unset_int .or. i_receiver .eq. fates_unset_int .or. & + i_donor .eq. i_receiver)) then landuse_transition_matrix(i_donor,i_receiver) = & - landuse_transition_matrix(i_donor,i_receiver) + temp_vector(i_luh2_transitions) * years_per_day / (1._r8 - urban_fraction) + landuse_transition_matrix(i_donor,i_receiver) + temp_vector(i_luh2_transitions) & + * years_per_day / (1._r8 - urban_fraction) end if end do transitions_loop @@ -127,7 +130,8 @@ subroutine GetLanduseTransitionRates(bc_in, min_allowed_landuse_fraction, landus ! zero all transitions where the state vector is less than the minimum allowed, ! and otherwise if this is the first timestep where the minimum was exceeded, ! then apply all transitions from primary to this type and reset the flag - ! note that the flag resetting should not happen for secondary lands, as this is handled in the logging logic + ! note that the flag resetting should not happen for secondary lands, as this is handled in the + ! logging logic call GetLUHStatedata(bc_in, state_vector) do i_lu = secondaryland, n_landuse_cats if ( state_vector(i_lu) .le. min_allowed_landuse_fraction ) then @@ -170,16 +174,18 @@ end function GetLUCategoryFromStateName subroutine GetLanduseChangeRules(clearing_matrix) - ! the purpose of this is to define a ruleset for when to clear the vegetation in transitioning from one land use type to another + ! the purpose of this is to define a ruleset for when to clear the vegetation in transitioning + ! from one land use type to another logical, intent(out) :: clearing_matrix(n_landuse_cats,n_landuse_cats) - ! default value of ruleset 4 above means that plants are not cleared during land use change transitions to rangeland, whereas plants are - ! cleared in transitions to pasturelands and croplands. - integer, parameter :: ruleset = 4 ! ruleset to apply from table 1 of Ma et al (2020) https://doi.org/10.5194/gmd-13-3203-2020 + ! default value of ruleset 4 above means that plants are not cleared during land use change + ! transitions to rangeland, whereas plants are cleared in transitions to pasturelands and croplands. + integer, parameter :: ruleset = 4 ! ruleset to apply from table 1 of Ma et al (2020) + ! https://doi.org/10.5194/gmd-13-3203-2020 - ! clearing matrix applies from the donor to the receiver land use type of the newly-transferred patch area - ! values of clearing matrix: false => do not clear; true => clear + ! clearing matrix applies from the donor to the receiver land use type of the newly-transferred + ! patch area values of clearing matrix: false => do not clear; true => clear clearing_matrix(:,:) = .false. @@ -187,8 +193,9 @@ subroutine GetLanduseChangeRules(clearing_matrix) case(1) - ! note that this ruleset isnt exactly what is in Ma et al. rulesets 1 and 2, because FATES does not make the distinction - ! between forested and non-forested lands from a land use/land cover perspective. + ! note that this ruleset isnt exactly what is in Ma et al. rulesets 1 and 2, because FATES + ! does not make the distinction between forested and non-forested lands from a land use/land + ! cover perspective. clearing_matrix(:,cropland) = .true. clearing_matrix(:,pastureland) = .true. clearing_matrix(primaryland,rangeland) = .true. @@ -351,12 +358,15 @@ subroutine CheckLUHData(luh_vector,modified_flag) end subroutine CheckLUHData - subroutine GetInitLanduseHarvestRate(bc_in, min_allowed_landuse_fraction, harvest_rate, landuse_vector_gt_min) + subroutine GetInitLanduseHarvestRate(bc_in, min_allowed_landuse_fraction, harvest_rate, & + landuse_vector_gt_min) - ! the purpose of this subroutine is, only under the case where we are transitioning from a spinup run that did not have land use - ! to a run that does, to apply the land-use changes needed to get to the state vector in a single daily instance. this is for - ! the hrvest rate from primary lands, i.e. the transition from primary to secondary lands. thus instead of using the harvest - ! dataset tself, it only uses the state vector for what land use compositoin we want to achieve, and log the forests accordingly. + ! the purpose of this subroutine is, only under the case where we are transitioning from a spinup + ! run that did not have land use to a run that does, to apply the land-use changes needed to get + ! to the state vector in a single daily instance. this is for the hrvest rate from primary lands, + ! i.e. the transition from primary to secondary lands. thus instead of using the harvest dataset + ! itself, it only uses the state vector for what land use compositoin we want to achieve, and log + ! the forests accordingly. ! !ARGUMENTS: type(bc_in_type) , intent(in) :: bc_in @@ -378,11 +388,13 @@ subroutine GetInitLanduseHarvestRate(bc_in, min_allowed_landuse_fraction, harves end subroutine GetInitLanduseHarvestRate - subroutine GetInitLanduseTransitionRates(bc_in, min_allowed_landuse_fraction, landuse_transition_matrix, landuse_vector_gt_min) + subroutine GetInitLanduseTransitionRates(bc_in, min_allowed_landuse_fraction, & + landuse_transition_matrix, landuse_vector_gt_min) - ! The purpose of this subroutine is, only under the case where we are transitioning from a spinup run that did not have land use - ! to a run that does, to apply the land-use changes needed to get to the state vector in a single daily instance. This is for - ! the transitions other than harvest, i.e. from primary lands to all other categories aside from secondary lands. + ! The purpose of this subroutine is, only under the case where we are transitioning from a spinup + ! run that did not have land use to a run that does, to apply the land-use changes needed to get + ! to the state vector in a single daily instance. This is for the transitions other than harvest, + ! i.e. from primary lands to all other categories aside from secondary lands. ! !ARGUMENTS: type(bc_in_type) , intent(in) :: bc_in @@ -398,8 +410,9 @@ subroutine GetInitLanduseTransitionRates(bc_in, min_allowed_landuse_fraction, la call GetLUHStatedata(bc_in, state_vector) - ! only do this if the state vector exceeds the minimum viable patch size, and if so, note that in the - ! landuse_vector_gt_min flag (which will be coming in as .false. because of the use_potentialveg logic). + ! only do this if the state vector exceeds the minimum viable patch size, and if so, note that + ! in the landuse_vector_gt_min flag (which will be coming in as .false. because of the + ! use_potentialveg logic). do i = secondaryland+1,n_landuse_cats if ( state_vector(i) .gt. min_allowed_landuse_fraction) then landuse_transition_matrix(primaryland,i) = state_vector(i) From 5a5dea1102dd64e6b5a00ee3489ddda2d4f67685 Mon Sep 17 00:00:00 2001 From: Charlie Koven Date: Tue, 30 Apr 2024 11:18:01 -0700 Subject: [PATCH 076/112] vasrious changes in response to review comments --- biogeochem/EDLoggingMortalityMod.F90 | 37 ++++--- biogeochem/EDPatchDynamicsMod.F90 | 128 +++++++++++++---------- biogeochem/FatesLandUseChangeMod.F90 | 6 +- main/FatesInterfaceTypesMod.F90 | 1 + main/FatesRestartInterfaceMod.F90 | 6 +- parameter_files/fates_params_default.cdl | 2 +- 6 files changed, 101 insertions(+), 79 deletions(-) diff --git a/biogeochem/EDLoggingMortalityMod.F90 b/biogeochem/EDLoggingMortalityMod.F90 index caf55d7f74..4708c31c21 100644 --- a/biogeochem/EDLoggingMortalityMod.F90 +++ b/biogeochem/EDLoggingMortalityMod.F90 @@ -253,13 +253,22 @@ subroutine LoggingMortality_frac( currentSite, bc_in, pft_i, dbh, canopy_layer, site_secondaryland_first_exceeding_min = (state_vector(secondaryland) .gt. currentSite%min_allowed_landuse_fraction) & .and. (.not. currentSite%landuse_vector_gt_min(secondaryland)) + ! The transition_landuse_from_off_to_on is for handling the special case of the first timestep after leaving potential + ! vegetation mode. In this case, all prior historical land-use, including harvest, needs to be applied on that first day. + ! So logging rates on that day are what is required to deforest exactly the amount of primary lands that will give the + ! amount of secondary lands dictated by the land use state vector for that year, rather than whatever the continuous + ! logging rate for that year is supposed to be according to the land use transition matrix. if (.not. currentSite%transition_landuse_from_off_to_on) then + + ! if the total intended area of secondary lands are less than what we can consider without having too-small patches, + ! or if that was the case until just now, then there is special logic if (site_secondaryland_first_exceeding_min) then - - ! if the total intended area of secondary lands are less than what we can consider without having too-small patches, - ! or if that was the case until just now, then there is special logic - harvest_rate = state_vector(secondaryland) / sum(state_vector(:)) - write(fates_log(), *) 'applying state_vector(secondaryland) to plants.', pft_i + if ( patch_land_use_label .eq. primaryland) then + harvest_rate = state_vector(secondaryland) / state_vector(primaryland) + write(fates_log(), *) 'applying state_vector(secondaryland) to plants.', pft_i + else + harvest_rate = 0._r8 + endif ! For area-based harvest, harvest_tag shall always be 2 (not applicable). harvest_tag = 2 @@ -370,20 +379,14 @@ subroutine LoggingMortality_frac( currentSite, bc_in, pft_i, dbh, canopy_layer, else call GetInitLanduseHarvestRate(bc_in, currentSite%min_allowed_landuse_fraction, & harvest_rate, currentSite%landuse_vector_gt_min) + lmort_direct = 0.0_r8 + lmort_collateral = 0.0_r8 + lmort_infra = 0.0_r8 + l_degrad = 0.0_r8 if(prt_params%woody(pft_i) == itrue)then lmort_direct = harvest_rate - lmort_collateral = 0.0_r8 - lmort_infra = 0.0_r8 - l_degrad = 0.0_r8 - else - lmort_direct = 0.0_r8 - lmort_collateral = 0.0_r8 - lmort_infra = 0.0_r8 - if (canopy_layer .eq. 1) then - l_degrad = harvest_rate - else - l_degrad = 0.0_r8 - endif + else if (canopy_layer .eq. 1) then + l_degrad = harvest_rate endif endif diff --git a/biogeochem/EDPatchDynamicsMod.F90 b/biogeochem/EDPatchDynamicsMod.F90 index 86a2e197c4..268b443a4f 100644 --- a/biogeochem/EDPatchDynamicsMod.F90 +++ b/biogeochem/EDPatchDynamicsMod.F90 @@ -330,13 +330,14 @@ subroutine disturbance_rates( site_in, bc_in) dist_rate_ldist_notharvested = 0.0_r8 - ! transitin matrix has units of area transitioned per unit area of the whole gridcell per time; + ! transition matrix has units of area transitioned per unit area of the whole gridcell per time; ! need to change to area transitioned per unit area of that land-use type per time; ! because the land use state vector sums to one minus area bareground, need to also divide by that ! (or rather, multiply since it is in the denominator of the denominator) - ! Avoid this calculation to avoid NaN due to division by zero result if luh is not used or applying to bare ground - ! note that an alternative here might be to use what LUH thinks the state vector should be instead of what the FATES state vector is, - ! in order to not amplify small deviations between the two... + ! Avoid this calculation to avoid NaN due to division by zero result if luh is not used or applying + ! to bare ground note that an alternative here might be to use what LUH thinks the state vector + ! should be instead of what the FATES state vector is, in order to not amplify small deviations + ! between the two... if (hlm_use_luh .eq. itrue .and. currentPatch%land_use_label .gt. nocomp_bareground_land) then currentPatch%landuse_transition_rates(1:n_landuse_cats) = min(1._r8, & site_in%landuse_transition_matrix(currentPatch%land_use_label,1:n_landuse_cats) & @@ -397,11 +398,13 @@ subroutine disturbance_rates( site_in, bc_in) currentPatch%age_since_anthro_disturbance, harvest_rate) end if - ! if the total intended area of secondary lands are less than what we can consider without having too-small patches, - ! or if that was the case until just now, then there is special logic + ! if the total intended area of secondary lands are less than what we can consider + ! without having too-small patches, or if that was the case until just now, + ! then there is special logic if (state_vector(secondaryland) .le. site_in%min_allowed_landuse_fraction) then harvest_rate = 0._r8 - else if (currentPatch%land_use_label .eq. primaryland .and. .not. site_in%landuse_vector_gt_min(secondaryland)) then + else if (currentPatch%land_use_label .eq. primaryland .and. .not. & + site_in%landuse_vector_gt_min(secondaryland)) then harvest_rate = state_vector(secondaryland) / sum(state_vector(:)) else harvest_rate = 0._r8 @@ -440,15 +443,19 @@ subroutine disturbance_rates( site_in, bc_in) call FatesWarn(msg,index=2) endif - ! if the sum of all disturbance rates is such that they will exceed total patch area on this day, then reduce them all proportionally. + ! if the sum of all disturbance rates is such that they will exceed total patch area on this day, + ! then reduce them all proportionally. + if ( (sum(currentPatch%disturbance_rates(:)) + sum(currentPatch%landuse_transition_rates(1:n_landuse_cats))) .gt. & max_daily_disturbance_rate ) then tempsum = sum(currentPatch%disturbance_rates(:)) + sum(currentPatch%landuse_transition_rates(1:n_landuse_cats)) do i_dist = 1,N_DIST_TYPES - currentPatch%disturbance_rates(i_dist) = max_daily_disturbance_rate * currentPatch%disturbance_rates(i_dist) / tempsum + currentPatch%disturbance_rates(i_dist) = max_daily_disturbance_rate * currentPatch%disturbance_rates(i_dist) & + / tempsum end do do i_dist = 1,n_landuse_cats - currentPatch%landuse_transition_rates(i_dist) = max_daily_disturbance_rate * currentPatch%landuse_transition_rates(i_dist) / tempsum + currentPatch%landuse_transition_rates(i_dist) = max_daily_disturbance_rate * & + currentPatch%landuse_transition_rates(i_dist) / tempsum end do endif @@ -456,17 +463,21 @@ subroutine disturbance_rates( site_in, bc_in) enddo !patch loop - ! if the area of secondary land has just exceeded the minimum below which we ignore things, set the flag to keep track of that. - if ( (state_vector(secondaryland) .gt. site_in%min_allowed_landuse_fraction) .and. (.not. site_in%landuse_vector_gt_min(secondaryland)) ) then + ! if the area of secondary land has just exceeded the minimum below which we ignore things, + ! set the flag to keep track of that. + if ( (state_vector(secondaryland) .gt. site_in%min_allowed_landuse_fraction) .and. & + (.not. site_in%landuse_vector_gt_min(secondaryland)) ) then site_in%landuse_vector_gt_min(secondaryland) = .true. write(fates_log(),*) 'setting site_in%landuse_vector_gt_min(secondaryland) = .true.' - - currentPatch => site_in%oldest_patch - do while (associated(currentPatch)) - write(fates_log(),*) 'cpatch area, LU, distrates(ilog): ', currentPatch%area, currentPatch%land_use_label, currentPatch%nocomp_pft_label, currentPatch%disturbance_rates(dtype_ilog), currentPatch%area - currentPatch%total_canopy_area - currentPatch => currentPatch%younger - end do - + if (debug) then + currentPatch => site_in%oldest_patch + do while (associated(currentPatch)) + write(fates_log(),*) 'cpatch area, LU, distrates(ilog): ', currentPatch%area, currentPatch%land_use_label, & + currentPatch%nocomp_pft_label, currentPatch%disturbance_rates(dtype_ilog), & + currentPatch%area - currentPatch%total_canopy_area + currentPatch => currentPatch%younger + end do + end if end if end subroutine disturbance_rates @@ -575,7 +586,8 @@ subroutine spawn_patches( currentSite, bc_in) ! we want at the second-outermost loop to go through all disturbance types, because we resolve each of these separately disturbance_type_loop: do i_disturbance_type = 1,N_DIST_TYPES - ! the next loop level is to go through patches that have a specific land-use type. the reason to do this is because the combination of + ! the next loop level is to go through patches that have a specific land-use type. the reason to do this + ! is because the combination of ! disturbance type and donor land-use type uniquly define the land-use type of the receiver patch. landuse_donortype_loop: do i_donorpatch_landuse_type = 1, n_landuse_cats @@ -584,7 +596,8 @@ subroutine spawn_patches( currentSite, bc_in) ! for fire and treefall disturbance, receiver land-use type is whatever the donor land-use type is. ! for logging disturbance, receiver land-use type is always secondary lands - ! for land-use-change disturbance, we need to loop over all possible transition types for land-use-change from the current land-use type. + ! for land-use-change disturbance, we need to loop over all possible transition types for land-use-change from + ! the current land-use type. select case(i_disturbance_type) case(dtype_ifire) @@ -597,7 +610,8 @@ subroutine spawn_patches( currentSite, bc_in) start_receiver_lulabel = secondaryland end_receiver_lulabel = secondaryland case(dtype_ilandusechange) - start_receiver_lulabel = 1 ! this could actually maybe be 2, as primaryland column of matrix should all be zeros, but leave as 1 for now + start_receiver_lulabel = 1 ! this could actually maybe be 2, as primaryland column of matrix should + ! all be zeros, but leave as 1 for now end_receiver_lulabel = n_landuse_cats case default write(fates_log(),*) 'unknown disturbance mode?' @@ -607,19 +621,24 @@ subroutine spawn_patches( currentSite, bc_in) ! next loop level is the set of possible receiver patch land use types. ! for disturbance types other than land use change, this is sort of a dummy loop, per the above logic. - landusechange_receiverpatchlabel_loop: do i_landusechange_receiverpatchlabel = start_receiver_lulabel, end_receiver_lulabel + landusechange_receiverpatchlabel_loop: do i_landusechange_receiverpatchlabel = start_receiver_lulabel, & + end_receiver_lulabel ! now we want to begin resolving all of the disturbance given the above categorical criteria of: - ! nocomp-PFT, disturbance type, donor patch land use label, and receiver patch land use label. All of the disturbed area that meets these - ! criteria (if any) will be put into a new patch whose area and properties are taken from one or more donor patches. + ! nocomp-PFT, disturbance type, donor patch land use label, and receiver patch land use label. + ! All of the disturbed area that meets these criteria (if any) will be put into a new patch whose area and + ! properties are taken from one or more donor patches. - ! calculate area of disturbed land that meets the above criteria, in this timestep, by summing contributions from each existing patch. + ! calculate area of disturbed land that meets the above criteria, in this timestep, by summing contributions + ! from each existing patch. currentPatch => currentSite%youngest_patch - ! this variable site_areadis holds all the newly disturbed area from all patches for all disturbance being resolved now. + ! this variable site_areadis holds all the newly disturbed area from all patches for all disturbance being + ! resolved now. site_areadis = 0.0_r8 - ! loop over all patches to figure out the total patch area generated as a result of all disturbance being resolved now. + ! loop over all patches to figure out the total patch area generated as a result of all disturbance being + ! resolved now. patchloop_areadis: do while(associated(currentPatch)) cp_nocomp_matches_1_if: if ( hlm_use_nocomp .eq. ifalse .or. & @@ -751,7 +770,8 @@ subroutine spawn_patches( currentSite, bc_in) call logging_litter_fluxes(currentSite, currentPatch, & newPatch, patch_site_areadis,bc_in) - ! if transitioning from primary to secondary, then may need to change nocomp pft, so tag as having transitioned LU + ! if transitioning from primary to secondary, then may need to change nocomp pft, + ! so tag as having transitioned LU if ( i_disturbance_type .eq. dtype_ilog .and. i_donorpatch_landuse_type .eq. primaryland) then newPatch%changed_landuse_this_ts = .true. end if @@ -838,7 +858,8 @@ subroutine spawn_patches( currentSite, bc_in) store_c = currentCohort%prt%GetState(store_organ, carbon12_element) total_c = sapw_c + struct_c + leaf_c + fnrt_c + store_c - ! survivorship of plants in both the disturbed and undisturbed cohorts depends on what type of disturbance is happening. + ! survivorship of plants in both the disturbed and undisturbed cohorts depends on what type of + ! disturbance is happening. disttype_case: select case(i_disturbance_type) @@ -1478,7 +1499,7 @@ subroutine spawn_patches( currentSite, bc_in) currentPatch => currentPatch%younger end do - if ( buffer_patch_used ) then + buffer_patch_used_if: if ( buffer_patch_used ) then ! at this point, lets check that the total patch area remaining to be relabelled equals what we think that it is. if (abs(sum(nocomp_pft_area_vector(:)) - sum(nocomp_pft_area_vector_filled(:)) - buffer_patch%area) .gt. rsnbl_math_prec) then write(fates_log(),*) 'midway through patch reallocation and things are already not adding up.', i_land_use_label @@ -1489,7 +1510,7 @@ subroutine spawn_patches( currentSite, bc_in) write(fates_log(),*) nocomp_pft_area_vector write(fates_log(),*) '-----' write(fates_log(),*) buffer_patch%area, buffer_patch%land_use_label, buffer_patch%nocomp_pft_label - write(fates_log(),*) sum(nocomp_pft_area_vector(:)), sum(nocomp_pft_area_vector_filled(:)), buffer_patch%area + write(fates_log(+),*) sum(nocomp_pft_area_vector(:)), sum(nocomp_pft_area_vector_filled(:)), buffer_patch%area currentPatch => currentSite%oldest_patch do while(associated(currentPatch)) write(fates_log(),*) currentPatch%area, currentPatch%land_use_label, currentPatch%nocomp_pft_label @@ -1526,9 +1547,6 @@ subroutine spawn_patches( currentSite, bc_in) ! put the new patch into the linked list call InsertPatch(currentSite, temp_patch) - ! now that the patch that temp_patch points to is in the site linked list, we want to null temp_patch so that it can be - ! refilled the next time through the loop. - else ! give the buffer patch the intended nocomp PFT label buffer_patch%nocomp_pft_label = i_pft @@ -1547,26 +1565,26 @@ subroutine spawn_patches( currentSite, bc_in) end if end do nocomp_pft_loop_2 - ! now we want to make sure that either the buffer_patch either has zero area (presumably it was never used), in which case it should be deallocated, - ! or else it does have area but it has been put into the site linked list, and so buffer patch should be nulled before next pass through outer loop. - ! if either of those, that means everything worked properly, if not, then something has gone wrong. - if (buffer_patch_in_linked_list) then - buffer_patch => null() - else if (buffer_patch%area .lt. rsnbl_math_prec) then - ! here we need to deallocate the buffer patch so that we don't get a memory leak. - call buffer_patch%FreeMemory(regeneration_model, numpft) - deallocate(buffer_patch, stat=istat, errmsg=smsg) - if (istat/=0) then - write(fates_log(),*) 'dealloc: fail on deallocate(dp):'//trim(smsg) - call endrun(msg=errMsg(sourcefile, __LINE__)) - endif - else - write(fates_log(),*) 'Buffer patch still has area and it wasnt put into the linked list' - write(fates_log(),*) 'buffer_patch%area', buffer_patch%area - write(fates_log(),*) sum(nocomp_pft_area_vector_filled(:)), sum(nocomp_pft_area_vector(:)) - write(fates_log(),*) sum(nocomp_pft_area_vector_filled(:)) - sum(nocomp_pft_area_vector(:)) + ! now we want to make sure that either the buffer_patch has zero area (presumably it was never used), + ! in which case it should be deallocated, or else it does have area but it has been put into the site + ! linked list. if either of those, that means everything worked properly, if not, then something has gone wrong. + if ( .not. buffer_patch_in_linked_list) then + if (buffer_patch%area .lt. rsnbl_math_prec) then + ! here we need to deallocate the buffer patch so that we don't get a memory leak. + call buffer_patch%FreeMemory(regeneration_model, numpft) + deallocate(buffer_patch, stat=istat, errmsg=smsg) + if (istat/=0) then + write(fates_log(),*) 'dealloc: fail on deallocate(dp):'//trim(smsg) + call endrun(msg=errMsg(sourcefile, __LINE__)) + endif + else + write(fates_log(),*) 'Buffer patch still has area and it wasnt put into the linked list' + write(fates_log(),*) 'buffer_patch%area', buffer_patch%area + write(fates_log(),*) sum(nocomp_pft_area_vector_filled(:)), sum(nocomp_pft_area_vector(:)) + write(fates_log(),*) sum(nocomp_pft_area_vector_filled(:)) - sum(nocomp_pft_area_vector(:)) - call endrun(msg=errMsg(sourcefile, __LINE__)) + call endrun(msg=errMsg(sourcefile, __LINE__)) + end if end if else ! buffer patch was never even used. deallocate. @@ -1576,7 +1594,7 @@ subroutine spawn_patches( currentSite, bc_in) write(fates_log(),*) 'dealloc: fail on deallocate(dp):'//trim(smsg) call endrun(msg=errMsg(sourcefile, __LINE__)) endif - end if + end if buffer_patch_used_if ! check that the area we have added is the same as the area we have taken away. if not, crash. if ( abs(sum(nocomp_pft_area_vector_filled(:)) - sum(nocomp_pft_area_vector(:))) .gt. rsnbl_math_prec) then diff --git a/biogeochem/FatesLandUseChangeMod.F90 b/biogeochem/FatesLandUseChangeMod.F90 index 69d06e26f5..cb8fcd740c 100644 --- a/biogeochem/FatesLandUseChangeMod.F90 +++ b/biogeochem/FatesLandUseChangeMod.F90 @@ -282,7 +282,9 @@ subroutine GetLUHStatedata(bc_in, state_vector) state_vector(:) = 0._r8 urban_fraction = 0._r8 - if (hlm_use_potentialveg .eq. ifalse) then + if (hlm_use_potentialveg .eq. itrue) then + state_vector(primaryland) = 1._r8 + else ! Check to see if the incoming state vector is NaN. temp_vector = bc_in%hlm_luh_states call CheckLUHData(temp_vector,modified_flag) @@ -316,8 +318,6 @@ subroutine GetLUHStatedata(bc_in, state_vector) else state_vector(primaryland) = 1._r8 endif - else - state_vector(primaryland) = 1._r8 end if end subroutine GetLUHStatedata diff --git a/main/FatesInterfaceTypesMod.F90 b/main/FatesInterfaceTypesMod.F90 index dd672e3bcb..c124499e6b 100644 --- a/main/FatesInterfaceTypesMod.F90 +++ b/main/FatesInterfaceTypesMod.F90 @@ -125,6 +125,7 @@ module FatesInterfaceTypesMod integer, public :: hlm_use_luh ! flag to signal whether or not to use luh2 drivers integer, public :: hlm_use_potentialveg ! flag to signal whether or not to use potential vegetation only + ! (i.e., no land use and instead force all lands to be primary) integer, public :: hlm_num_luh2_states ! number of land use state types provided in LUH2 forcing dataset integer, public :: hlm_num_luh2_transitions ! number of land use transition types provided in LUH2 forcing dataset diff --git a/main/FatesRestartInterfaceMod.F90 b/main/FatesRestartInterfaceMod.F90 index f4225bc259..829ce56b60 100644 --- a/main/FatesRestartInterfaceMod.F90 +++ b/main/FatesRestartInterfaceMod.F90 @@ -713,15 +713,15 @@ subroutine define_restart_vars(this, initialize_variables) hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_gdd_si ) call this%set_restart_var(vname='fates_min_allowed_landuse_fraction_site', vtype=site_r8, & - long_name='minimum allowed land use fraction at each site', units='degC days', flushval = flushzero, & + long_name='minimum allowed land use fraction at each site', units='fraction', flushval = flushzero, & hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_min_allowed_landuse_fraction_si ) call this%set_restart_var(vname='fates_landuse_vector_gt_min_site', vtype=cohort_int, & - long_name='minimum allowed land use fraction at each site', units='degC days', flushval = flushzero, & + long_name='minimum allowed land use fraction at each site', units='logical', flushval = flushzero, & hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_landuse_vector_gt_min_si ) call this%set_restart_var(vname='fates_area_bareground_site', vtype=site_r8, & - long_name='minimum allowed land use fraction at each site', units='degC days', flushval = flushzero, & + long_name='minimum allowed land use fraction at each site', units='fraction', flushval = flushzero, & hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_area_bareground_si ) call this%set_restart_var(vname='fates_snow_depth_site', vtype=site_r8, & diff --git a/parameter_files/fates_params_default.cdl b/parameter_files/fates_params_default.cdl index cbee915175..fe5bfdb086 100644 --- a/parameter_files/fates_params_default.cdl +++ b/parameter_files/fates_params_default.cdl @@ -1626,7 +1626,7 @@ data: fates_landuse_crop_lu_pft_vector = -999, -999, -999, -999, 11 ; - fates_max_nocomp_pfts_by_landuse = 4, 4, 2, 2, 1 ; + fates_max_nocomp_pfts_by_landuse = 4, 4, 1, 1, 1 ; fates_maxpatches_by_landuse = 9, 4, 1, 1, 1 ; From 530c99d37fcf56e16f65546a015be39c03cb5576 Mon Sep 17 00:00:00 2001 From: Charlie Koven Date: Tue, 30 Apr 2024 11:21:12 -0700 Subject: [PATCH 077/112] Update biogeochem/FatesLandUseChangeMod.F90 Co-authored-by: Gregory Lemieux <7565064+glemieux@users.noreply.github.com> --- biogeochem/FatesLandUseChangeMod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/biogeochem/FatesLandUseChangeMod.F90 b/biogeochem/FatesLandUseChangeMod.F90 index cb8fcd740c..c523c8788a 100644 --- a/biogeochem/FatesLandUseChangeMod.F90 +++ b/biogeochem/FatesLandUseChangeMod.F90 @@ -127,7 +127,7 @@ subroutine GetLanduseTransitionRates(bc_in, min_allowed_landuse_fraction, landus end if end do transitions_loop - ! zero all transitions where the state vector is less than the minimum allowed, + ! zero all transitions where the receiving land use type state vector is less than the minimum allowed, ! and otherwise if this is the first timestep where the minimum was exceeded, ! then apply all transitions from primary to this type and reset the flag ! note that the flag resetting should not happen for secondary lands, as this is handled in the From d5b06403bdedd8c072c8725509afa247591ed251 Mon Sep 17 00:00:00 2001 From: Charlie Koven Date: Tue, 30 Apr 2024 17:27:39 -0700 Subject: [PATCH 078/112] Update main/FatesInterfaceMod.F90 Co-authored-by: Gregory Lemieux <7565064+glemieux@users.noreply.github.com> --- main/FatesInterfaceMod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/main/FatesInterfaceMod.F90 b/main/FatesInterfaceMod.F90 index a445bfab51..55298127e3 100644 --- a/main/FatesInterfaceMod.F90 +++ b/main/FatesInterfaceMod.F90 @@ -566,7 +566,7 @@ subroutine allocate_bcin(bc_in, nlevsoil_in, nlevdecomp_in, num_lu_harvest_cats, if ( hlm_use_fixed_biogeog .eq. itrue) then if (hlm_use_luh .eq. itrue ) then - allocate(bc_in%pft_areafrac_lu(size( EDPftvarcon_inst%hlm_pft_map,2),num_luh2_states-n_crop_lu_types)) + allocate(bc_in%pft_areafrac_lu(size( EDPftvarcon_inst%hlm_pft_map,2),n_landuse_cats-n_crop_lu_types)) else allocate(bc_in%pft_areafrac(surfpft_lb:surfpft_ub)) endif From c348a7dafcdba4f62b7cc26a4bee43826a79c2a9 Mon Sep 17 00:00:00 2001 From: Charlie Koven Date: Thu, 2 May 2024 14:53:54 -0700 Subject: [PATCH 079/112] aded error check if trying to go back into potential veg mode --- main/FatesRestartInterfaceMod.F90 | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/main/FatesRestartInterfaceMod.F90 b/main/FatesRestartInterfaceMod.F90 index 829ce56b60..3d1f71a963 100644 --- a/main/FatesRestartInterfaceMod.F90 +++ b/main/FatesRestartInterfaceMod.F90 @@ -3696,6 +3696,12 @@ subroutine get_restart_vectors(this, nc, nsites, sites) ! restart run that did not include land use. if (rio_landuse_config_si(io_idx_si) .eq. itrue .and. hlm_use_potentialveg .eq. ifalse) then sites(s)%transition_landuse_from_off_to_on = .true. + else if ( rio_landuse_config_si(io_idx_si) .ne. hlm_use_potentialveg ) then + ! can't go back into potential vegetation mode, it is a one-way thing. + write(fates_log(),*) 'this combination of rio_landuse_config_si(io_idx_si) and hlm_use_potentialveg is not permitted' + write(fates_log(),*) 'rio_landuse_config_si(io_idx_si)', rio_landuse_config_si(io_idx_si) + write(fates_log(),*) 'hlm_use_potentialveg', hlm_use_potentialveg + call endrun(msg=errMsg(sourcefile, __LINE__)) endif end do From 0b415cfb1d4eceb7a1e19946f6c96eab2ef379e1 Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Tue, 7 May 2024 14:27:37 -0700 Subject: [PATCH 080/112] minor typo and renaming corrections --- biogeochem/EDPatchDynamicsMod.F90 | 2 +- main/EDInitMod.F90 | 4 ++-- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/biogeochem/EDPatchDynamicsMod.F90 b/biogeochem/EDPatchDynamicsMod.F90 index 268b443a4f..b9d60ed926 100644 --- a/biogeochem/EDPatchDynamicsMod.F90 +++ b/biogeochem/EDPatchDynamicsMod.F90 @@ -1510,7 +1510,7 @@ subroutine spawn_patches( currentSite, bc_in) write(fates_log(),*) nocomp_pft_area_vector write(fates_log(),*) '-----' write(fates_log(),*) buffer_patch%area, buffer_patch%land_use_label, buffer_patch%nocomp_pft_label - write(fates_log(+),*) sum(nocomp_pft_area_vector(:)), sum(nocomp_pft_area_vector_filled(:)), buffer_patch%area + write(fates_log(),*) sum(nocomp_pft_area_vector(:)), sum(nocomp_pft_area_vector_filled(:)), buffer_patch%area currentPatch => currentSite%oldest_patch do while(associated(currentPatch)) write(fates_log(),*) currentPatch%area, currentPatch%land_use_label, currentPatch%nocomp_pft_label diff --git a/main/EDInitMod.F90 b/main/EDInitMod.F90 index b8862705a7..1c04deaef8 100644 --- a/main/EDInitMod.F90 +++ b/main/EDInitMod.F90 @@ -623,7 +623,7 @@ subroutine init_patches( nsites, sites, bc_in) use FatesPlantHydraulicsMod, only : updateSizeDepRhizHydProps use FatesInventoryInitMod, only : initialize_sites_by_inventory - use FatesLandUseChangeMod, only : get_luh_statedata + use FatesLandUseChangeMod, only : GetLUHStatedata ! ! !ARGUMENTS @@ -720,7 +720,7 @@ subroutine init_patches( nsites, sites, bc_in) ! This could be updated in the future to allow a variable number of ! categories based on which states are zero n_active_landuse_cats = n_landuse_cats - call get_luh_statedata(bc_in(s), state_vector) + call GetLUHStatedata(bc_in(s), state_vector) ! if the land use state vector is greater than the minimum value, set landuse_vector_gt_min flag to true ! otherwise set to false. From 153b0bda9c96f18e8d2a93887a082bc7a31b574b Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Tue, 7 May 2024 16:08:42 -0700 Subject: [PATCH 081/112] add landuse mode checks for setting site_secondarylands... --- biogeochem/EDLoggingMortalityMod.F90 | 15 ++++++++++----- biogeochem/EDPatchDynamicsMod.F90 | 9 ++++++--- 2 files changed, 16 insertions(+), 8 deletions(-) diff --git a/biogeochem/EDLoggingMortalityMod.F90 b/biogeochem/EDLoggingMortalityMod.F90 index 4708c31c21..1b1200037e 100644 --- a/biogeochem/EDLoggingMortalityMod.F90 +++ b/biogeochem/EDLoggingMortalityMod.F90 @@ -54,6 +54,7 @@ module EDLoggingMortalityMod use FatesInterfaceTypesMod , only : hlm_num_lu_harvest_cats use FatesInterfaceTypesMod , only : hlm_use_logging use FatesInterfaceTypesMod , only : hlm_use_planthydro + use FatesInterfaceTypesMod , only : hlm_use_luh use FatesConstantsMod , only : itrue,ifalse use FatesGlobals , only : endrun => fates_endrun use FatesGlobals , only : fates_log @@ -249,17 +250,21 @@ subroutine LoggingMortality_frac( currentSite, bc_in, pft_i, dbh, canopy_layer, ! todo: eventually set up distinct harvest practices, each with a set of input paramaeters ! todo: implement harvested carbon inputs - call GetLUHStatedata(bc_in, state_vector) - site_secondaryland_first_exceeding_min = (state_vector(secondaryland) .gt. currentSite%min_allowed_landuse_fraction) & - .and. (.not. currentSite%landuse_vector_gt_min(secondaryland)) - ! The transition_landuse_from_off_to_on is for handling the special case of the first timestep after leaving potential ! vegetation mode. In this case, all prior historical land-use, including harvest, needs to be applied on that first day. ! So logging rates on that day are what is required to deforest exactly the amount of primary lands that will give the ! amount of secondary lands dictated by the land use state vector for that year, rather than whatever the continuous ! logging rate for that year is supposed to be according to the land use transition matrix. if (.not. currentSite%transition_landuse_from_off_to_on) then - + + ! Check if the secondaryland exceeds the minimum if in landuse mode + site_secondaryland_first_exceeding_min = .false. + if (hlm_use_luh .eq. itrue) then + call GetLUHStatedata(bc_in, state_vector) + site_secondaryland_first_exceeding_min = (state_vector(secondaryland) .gt. currentSite%min_allowed_landuse_fraction) & + .and. (.not. currentSite%landuse_vector_gt_min(secondaryland)) + end if + ! if the total intended area of secondary lands are less than what we can consider without having too-small patches, ! or if that was the case until just now, then there is special logic if (site_secondaryland_first_exceeding_min) then diff --git a/biogeochem/EDPatchDynamicsMod.F90 b/biogeochem/EDPatchDynamicsMod.F90 index b9d60ed926..60f5927541 100644 --- a/biogeochem/EDPatchDynamicsMod.F90 +++ b/biogeochem/EDPatchDynamicsMod.F90 @@ -317,9 +317,12 @@ subroutine disturbance_rates( site_in, bc_in) end do ! get some info needed to determine whether or not to apply land use change - call GetLUHStatedata(bc_in, state_vector) - site_secondaryland_first_exceeding_min = (state_vector(secondaryland) .gt. site_in%min_allowed_landuse_fraction) & - .and. (.not. site_in%landuse_vector_gt_min(secondaryland)) + site_secondaryland_first_exceeding_min = .false. + if (hlm_use_luh .eq. itrue) then + call GetLUHStatedata(bc_in, state_vector) + site_secondaryland_first_exceeding_min = (state_vector(secondaryland) .gt. site_in%min_allowed_landuse_fraction) & + .and. (.not. site_in%landuse_vector_gt_min(secondaryland)) + end if currentPatch => site_in%oldest_patch do while (associated(currentPatch)) From e36df6621e51b45c5c7a983b782ede14df5ad42b Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Tue, 7 May 2024 22:52:56 -0700 Subject: [PATCH 082/112] fix missing end subroutine --- biogeochem/EDPatchDynamicsMod.F90 | 1 + 1 file changed, 1 insertion(+) diff --git a/biogeochem/EDPatchDynamicsMod.F90 b/biogeochem/EDPatchDynamicsMod.F90 index c46540170f..1b16d30e0c 100644 --- a/biogeochem/EDPatchDynamicsMod.F90 +++ b/biogeochem/EDPatchDynamicsMod.F90 @@ -3951,5 +3951,6 @@ subroutine CopyPatchMeansTimers(dp, rp) enddo end if + end subroutine CopyPatchMeansTimers end module EDPatchDynamicsMod From 19e0b167c78cdef8fe8366fad05962e1fe65fdda Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Wed, 8 May 2024 09:39:39 -0700 Subject: [PATCH 083/112] remove target and fix missing indexing definition --- biogeochem/EDPatchDynamicsMod.F90 | 13 ++++++++----- 1 file changed, 8 insertions(+), 5 deletions(-) diff --git a/biogeochem/EDPatchDynamicsMod.F90 b/biogeochem/EDPatchDynamicsMod.F90 index 1b16d30e0c..54dee697fe 100644 --- a/biogeochem/EDPatchDynamicsMod.F90 +++ b/biogeochem/EDPatchDynamicsMod.F90 @@ -1621,8 +1621,8 @@ subroutine split_patch(currentSite, currentPatch, new_patch, fraction_to_keep) ! ! !ARGUMENTS: type(ed_site_type),intent(inout) :: currentSite - type(fates_patch_type) , intent(inout), target :: currentPatch ! Donor Patch - type(fates_patch_type) , intent(inout), target :: new_patch ! New Patch + type(fates_patch_type) , intent(inout), pointer :: currentPatch ! Donor Patch + type(fates_patch_type) , intent(inout), pointer :: new_patch ! New Patch real(r8), intent(in) :: fraction_to_keep ! fraction of currentPatch to keep, the rest goes to newpatch ! ! !LOCAL VARIABLES: @@ -3937,6 +3937,9 @@ subroutine CopyPatchMeansTimers(dp, rp) type (fates_patch_type) , pointer :: dp ! Donor Patch type (fates_patch_type) , target, intent(inout) :: rp ! Recipient Patch + ! LOCAL: + integer :: ipft ! pft index + call rp%tveg24%CopyFromDonor(dp%tveg24) call rp%tveg_lpa%CopyFromDonor(dp%tveg_lpa) call rp%tveg_longterm%CopyFromDonor(dp%tveg_longterm) @@ -3945,9 +3948,9 @@ subroutine CopyPatchMeansTimers(dp, rp) call rp%seedling_layer_par24%CopyFromDonor(dp%seedling_layer_par24) call rp%sdlng_mort_par%CopyFromDonor(dp%sdlng_mort_par) call rp%sdlng2sap_par%CopyFromDonor(dp%sdlng2sap_par) - do pft = 1,numpft - call rp%sdlng_emerg_smp(pft)%p%CopyFromDonor(dp%sdlng_emerg_smp(pft)%p) - call rp%sdlng_mdd(pft)%p%CopyFromDonor(dp%sdlng_mdd(pft)%p) + do ipft = 1,numpft + call rp%sdlng_emerg_smp(ipft)%p%CopyFromDonor(dp%sdlng_emerg_smp(ipft)%p) + call rp%sdlng_mdd(ipft)%p%CopyFromDonor(dp%sdlng_mdd(ipft)%p) enddo end if From 69558bc5175a70d7261cb080186b3f291c917462 Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Wed, 8 May 2024 10:20:28 -0700 Subject: [PATCH 084/112] fix patch name typo --- biogeochem/EDPatchDynamicsMod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/biogeochem/EDPatchDynamicsMod.F90 b/biogeochem/EDPatchDynamicsMod.F90 index 54dee697fe..028c69cf9a 100644 --- a/biogeochem/EDPatchDynamicsMod.F90 +++ b/biogeochem/EDPatchDynamicsMod.F90 @@ -1411,7 +1411,7 @@ subroutine spawn_patches( currentSite, bc_in) buffer_patch%tallest => null() buffer_patch%shortest => null() - call CopyPatchMeansTimers(buffer_patch, currentPatch) + call CopyPatchMeansTimers(buffer_patch, copyPatch) ! make a note that this buffer patch has not been put into the linked list buffer_patch_in_linked_list = .false. From c090218c60416b9cc2a99fbd91925eeaa1691aaa Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Wed, 8 May 2024 13:48:04 -0700 Subject: [PATCH 085/112] fix incorrect argument order for new subroutine --- biogeochem/EDPatchDynamicsMod.F90 | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/biogeochem/EDPatchDynamicsMod.F90 b/biogeochem/EDPatchDynamicsMod.F90 index 028c69cf9a..f2621a2bba 100644 --- a/biogeochem/EDPatchDynamicsMod.F90 +++ b/biogeochem/EDPatchDynamicsMod.F90 @@ -764,7 +764,7 @@ subroutine spawn_patches( currentSite, bc_in) currentPatch%burnt_frac_litter(:) = 0._r8 end if - call CopyPatchMeansTimers(newPatch, currentPatch) + call CopyPatchMeansTimers(currentPatch, newPatch) call TransLitterNewPatch( currentSite, currentPatch, newPatch, patch_site_areadis) @@ -1411,7 +1411,7 @@ subroutine spawn_patches( currentSite, bc_in) buffer_patch%tallest => null() buffer_patch%shortest => null() - call CopyPatchMeansTimers(buffer_patch, copyPatch) + call CopyPatchMeansTimers(copyPatch, buffer_patch) ! make a note that this buffer patch has not been put into the linked list buffer_patch_in_linked_list = .false. @@ -1654,7 +1654,7 @@ subroutine split_patch(currentSite, currentPatch, new_patch, fraction_to_keep) new_patch%tallest => null() new_patch%shortest => null() - call CopyPatchMeansTimers(new_patch, currentPatch) + call CopyPatchMeansTimers(currentPatch, new_patch) call TransLitterNewPatch( currentSite, currentPatch, new_patch, currentPatch%area * (1.-fraction_to_keep)) @@ -3934,8 +3934,8 @@ subroutine CopyPatchMeansTimers(dp, rp) ! -------------------------------------------------------------------------- ! ! !ARGUMENTS: - type (fates_patch_type) , pointer :: dp ! Donor Patch - type (fates_patch_type) , target, intent(inout) :: rp ! Recipient Patch + type (fates_patch_type), intent(in) :: dp ! Donor Patch + type (fates_patch_type), intent(inout) :: rp ! Recipient Patch ! LOCAL: integer :: ipft ! pft index From 3594045428ada92e68c59a428a8ef3fc288bd284 Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Wed, 8 May 2024 14:46:44 -0700 Subject: [PATCH 086/112] fix procedure declaration --- main/EDTypesMod.F90 | 7 +++---- 1 file changed, 3 insertions(+), 4 deletions(-) diff --git a/main/EDTypesMod.F90 b/main/EDTypesMod.F90 index 18498230f6..5644fb8295 100644 --- a/main/EDTypesMod.F90 +++ b/main/EDTypesMod.F90 @@ -4,6 +4,7 @@ module EDTypesMod use FatesGlobals, only : endrun => fates_endrun use FatesConstantsMod, only : ifalse use FatesConstantsMod, only : itrue + use FatesConstantsMod, only : nocomp_bareground_land use FatesGlobals, only : fates_log use FatesHydraulicsMemMod, only : ed_cohort_hydr_type use FatesHydraulicsMemMod, only : ed_site_hydr_type @@ -440,7 +441,7 @@ module EDTypesMod contains - public :: get_current_landuse_statevector + procedure, public :: get_current_landuse_statevector end type ed_site_type @@ -545,8 +546,6 @@ function get_current_landuse_statevector(this) result(current_state_vector) currentPatch => currentPatch%younger end do - end subroutine get_current_landuse_statevector - - + end function get_current_landuse_statevector end module EDTypesMod From 6080ab6032814c5e70547bcf82cd39a028e5253f Mon Sep 17 00:00:00 2001 From: Charlie Koven Date: Fri, 10 May 2024 16:58:44 -0700 Subject: [PATCH 087/112] fixing error in harvest rate calculations --- biogeochem/EDLoggingMortalityMod.F90 | 22 +++++++++---- biogeochem/EDPatchDynamicsMod.F90 | 6 +++- main/EDTypesMod.F90 | 47 +++++++++++++++++++++++++++- 3 files changed, 67 insertions(+), 8 deletions(-) diff --git a/biogeochem/EDLoggingMortalityMod.F90 b/biogeochem/EDLoggingMortalityMod.F90 index 1b1200037e..6d373e995a 100644 --- a/biogeochem/EDLoggingMortalityMod.F90 +++ b/biogeochem/EDLoggingMortalityMod.F90 @@ -242,6 +242,7 @@ subroutine LoggingMortality_frac( currentSite, bc_in, pft_i, dbh, canopy_layer, real(r8) :: harvest_rate ! the final harvest rate to apply to this cohort today real(r8) :: state_vector(n_landuse_cats) logical :: site_secondaryland_first_exceeding_min + real(r8) :: secondary_young_fraction ! what fraction of secondary land is young secondary land ! todo: probably lower the dbhmin default value to 30 cm ! todo: change the default logging_event_code to 1 september (-244) @@ -302,9 +303,11 @@ subroutine LoggingMortality_frac( currentSite, bc_in, pft_i, dbh, canopy_layer, ! HARVEST_SH2 = harvest from secondary young forest ! HARVEST_SH3 = harvest from secondary non-forest (assume this is young for biomass) + secondary_young_fraction = currentSite%get_secondary_young_fraction() + ! Get the area-based harvest rates based on info passed to FATES from the boundary condition call get_harvest_rate_area (patch_land_use_label, hlm_harvest_catnames, & - hlm_harvest_rates, frac_site_primary, frac_site_secondary, secondary_age, harvest_rate) + hlm_harvest_rates, frac_site_primary, frac_site_secondary, secondary_young_fraction, secondary_age, harvest_rate) ! For area-based harvest, harvest_tag shall always be 2 (not applicable). harvest_tag = 2 @@ -401,13 +404,13 @@ end subroutine LoggingMortality_frac ! ============================================================================ subroutine get_harvest_rate_area (patch_land_use_label, hlm_harvest_catnames, hlm_harvest_rates, & - frac_site_primary, frac_site_secondary, secondary_age, harvest_rate) + frac_site_primary, frac_site_secondary, secondary_young_fraction, secondary_age, harvest_rate) ! ------------------------------------------------------------------------------------------- ! ! DESCRIPTION: - ! get the area-based harvest rates based on info passed to FATES from the bioundary conditions in. + ! get the area-based harvest rates based on info passed to FATES from the boundary conditions in. ! assumes logging_time == true ! Arguments @@ -417,6 +420,7 @@ subroutine get_harvest_rate_area (patch_land_use_label, hlm_harvest_catnames, hl real(r8), intent(in) :: secondary_age ! patch level age_since_anthro_disturbance real(r8), intent(in) :: frac_site_primary real(r8), intent(in) :: frac_site_secondary + real(r8), intent(in) :: secondary_young_fraction ! what fraction of secondary land is young secondary land real(r8), intent(out) :: harvest_rate ! Local Variables @@ -449,15 +453,21 @@ subroutine get_harvest_rate_area (patch_land_use_label, hlm_harvest_catnames, hl ! Normalize by site-level primary or secondary forest fraction ! since harvest_rate is specified as a fraction of the gridcell ! also need to put a cap so as not to harvest more primary or secondary area than there is in a gridcell + ! For secondary, also need to normalize by the young/old fraction. if (patch_land_use_label .eq. primaryland) then if (frac_site_primary .gt. fates_tiny) then - harvest_rate = min((harvest_rate / frac_site_primary),frac_site_primary) + harvest_rate = min((harvest_rate / frac_site_primary),1._r8) else harvest_rate = 0._r8 endif else if (patch_land_use_label .eq. secondaryland) then - if (frac_site_secondary .gt. fates_tiny) then - harvest_rate = min((harvest_rate / frac_site_secondary), frac_site_secondary) + ! the .gt. -0.5 in the next line is because frac_site_secondary returns -1 if no secondary area. + if (frac_site_secondary .gt. fates_tiny .and. frac_site_secondary .gt. -0.5_r8) then + if (secondary_age .lt. secondary_age_threshold) then + harvest_rate = min((harvest_rate / (frac_site_secondary * secondary_young_fraction)), 1._r8) + else + harvest_rate = min((harvest_rate / (frac_site_secondary * (1._r8 - secondary_young_fraction))), 1._r8) + endif else harvest_rate = 0._r8 endif diff --git a/biogeochem/EDPatchDynamicsMod.F90 b/biogeochem/EDPatchDynamicsMod.F90 index 7536cbdf3a..3998569800 100644 --- a/biogeochem/EDPatchDynamicsMod.F90 +++ b/biogeochem/EDPatchDynamicsMod.F90 @@ -216,6 +216,7 @@ subroutine disturbance_rates( site_in, bc_in) real(r8) :: state_vector(n_landuse_cats) real(r8), parameter :: max_daily_disturbance_rate = 0.999_r8 logical :: site_secondaryland_first_exceeding_min + real(r8) :: secondary_young_fraction ! what fraction of secondary land is young secondary land !---------------------------------------------------------------------------------------------- ! Calculate Mortality Rates (these were previously calculated during growth derivatives) ! And the same rates in understory plants have already been applied to %dndt @@ -224,6 +225,9 @@ subroutine disturbance_rates( site_in, bc_in) ! first calculate the fraction of the site that is primary land current_fates_landuse_state_vector = site_in%get_current_landuse_statevector() + ! and get the fraction of secondary land that is young secondary land + secondary_young_fraction = currentSite%get_secondary_young_fraction() + ! check status of transition_landuse_from_off_to_on flag, and do some error checking on it if(site_in%transition_landuse_from_off_to_on) then if (sum(current_fates_landuse_state_vector(secondaryland:cropland)) .gt. nearzero) then @@ -396,7 +400,7 @@ subroutine disturbance_rates( site_in, bc_in) else call get_harvest_rate_area (currentPatch%land_use_label, bc_in%hlm_harvest_catnames, & bc_in%hlm_harvest_rates, current_fates_landuse_state_vector(primaryland), & - current_fates_landuse_state_vector(secondaryland), & + current_fates_landuse_state_vector(secondaryland), secondary_young_fraction, & currentPatch%age_since_anthro_disturbance, harvest_rate) end if diff --git a/main/EDTypesMod.F90 b/main/EDTypesMod.F90 index 5644fb8295..f1790b130f 100644 --- a/main/EDTypesMod.F90 +++ b/main/EDTypesMod.F90 @@ -5,6 +5,8 @@ module EDTypesMod use FatesConstantsMod, only : ifalse use FatesConstantsMod, only : itrue use FatesConstantsMod, only : nocomp_bareground_land + use FatesConstantsMod, only : secondaryland + use FatesConstantsMod, only : secondary_age_threshold use FatesGlobals, only : fates_log use FatesHydraulicsMemMod, only : ed_cohort_hydr_type use FatesHydraulicsMemMod, only : ed_site_hydr_type @@ -547,5 +549,48 @@ function get_current_landuse_statevector(this) result(current_state_vector) end do end function get_current_landuse_statevector - + + ! ===================================================================================== + + function get_secondary_young_fraction(this) result(secondary_young_fraction) + + ! + ! !DESCRIPTION: + ! Calculate how much of the secondary area is "young", i.e. below the age threshold. + ! If no seconday patch area at all, return -1. + ! + ! !USES: + ! + ! !ARGUMENTS: + class(ed_site_type) :: this + real(r8) :: secondary_young_fraction + real(r8) :: secondary_young_area + real(r8) :: secondary_old_area + + ! !LOCAL VARIABLES: + type(fates_patch_type), pointer :: currentPatch + + secondary_young_area = 0._r8 + secondary_old_area = 0._r8 + + currentPatch => this%oldest_patch + do while (associated(currentPatch)) + if (currentPatch%land_use_label .eq. secondaryland) then + if ( currentPatch%age .ge. secondary_age_threshold ) then + secondary_old_area = secondary_old_area + currentPatch%area + else + secondary_young_area = secondary_young_area + currentPatch%area + end if + end if + currentPatch => currentPatch%younger + end do + + if ( (secondary_young_area + secondary_old_area) .gt. fates_tiny) then + secondary_young_fraction = secondary_young_area / (secondary_young_area + secondary_old_area) + else + secondary_young_fraction = -1._r8 + endif + + end function get_secondary_young_fraction + end module EDTypesMod From 827ab3f1d63f710f8819d4329253d0a7d75a4bed Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Tue, 14 May 2024 14:54:03 -0700 Subject: [PATCH 088/112] minor build fixes --- biogeochem/EDPatchDynamicsMod.F90 | 2 +- main/EDTypesMod.F90 | 2 ++ 2 files changed, 3 insertions(+), 1 deletion(-) diff --git a/biogeochem/EDPatchDynamicsMod.F90 b/biogeochem/EDPatchDynamicsMod.F90 index 3998569800..208560975d 100644 --- a/biogeochem/EDPatchDynamicsMod.F90 +++ b/biogeochem/EDPatchDynamicsMod.F90 @@ -226,7 +226,7 @@ subroutine disturbance_rates( site_in, bc_in) current_fates_landuse_state_vector = site_in%get_current_landuse_statevector() ! and get the fraction of secondary land that is young secondary land - secondary_young_fraction = currentSite%get_secondary_young_fraction() + secondary_young_fraction = site_in%get_secondary_young_fraction() ! check status of transition_landuse_from_off_to_on flag, and do some error checking on it if(site_in%transition_landuse_from_off_to_on) then diff --git a/main/EDTypesMod.F90 b/main/EDTypesMod.F90 index f1790b130f..8f2e8ad570 100644 --- a/main/EDTypesMod.F90 +++ b/main/EDTypesMod.F90 @@ -7,6 +7,7 @@ module EDTypesMod use FatesConstantsMod, only : nocomp_bareground_land use FatesConstantsMod, only : secondaryland use FatesConstantsMod, only : secondary_age_threshold + use FatesConstantsMod, only : fates_tiny use FatesGlobals, only : fates_log use FatesHydraulicsMemMod, only : ed_cohort_hydr_type use FatesHydraulicsMemMod, only : ed_site_hydr_type @@ -444,6 +445,7 @@ module EDTypesMod contains procedure, public :: get_current_landuse_statevector + procedure, public :: get_secondary_young_fraction end type ed_site_type From f7318a0f71c0109919f3cab02c6800915a0ea046 Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Fri, 17 May 2024 09:28:45 -0600 Subject: [PATCH 089/112] bug fixes from luhv2 merge --- biogeochem/EDPatchDynamicsMod.F90 | 6 +++--- main/EDInitMod.F90 | 2 +- main/EDTypesMod.F90 | 6 ++++-- main/FatesHistoryInterfaceMod.F90 | 1 - main/FatesRestartInterfaceMod.F90 | 1 - 5 files changed, 8 insertions(+), 8 deletions(-) diff --git a/biogeochem/EDPatchDynamicsMod.F90 b/biogeochem/EDPatchDynamicsMod.F90 index 0a0ac19e3a..a6e05617be 100644 --- a/biogeochem/EDPatchDynamicsMod.F90 +++ b/biogeochem/EDPatchDynamicsMod.F90 @@ -226,7 +226,7 @@ subroutine disturbance_rates( site_in, bc_in) current_fates_landuse_state_vector = site_in%get_current_landuse_statevector() ! and get the fraction of secondary land that is young secondary land - secondary_young_fraction = currentSite%get_secondary_young_fraction() + secondary_young_fraction = site_in%get_secondary_young_fraction() ! check status of transition_landuse_from_off_to_on flag, and do some error checking on it if(site_in%transition_landuse_from_off_to_on) then @@ -1399,7 +1399,7 @@ subroutine spawn_patches( currentSite, bc_in) allocate(buffer_patch) call buffer_patch%Create(0._r8, 0._r8, i_land_use_label, 0, & - hlm_numSWb, numpft, currentSite%nlevsoil, hlm_current_tod, & + num_swb, numpft, currentSite%nlevsoil, hlm_current_tod, & regeneration_model) ! Initialize the litter pools to zero @@ -1641,7 +1641,7 @@ subroutine split_patch(currentSite, currentPatch, new_patch, fraction_to_keep) ! first we need to make the new patch call new_patch%Create(0._r8, & currentPatch%area * (1._r8 - fraction_to_keep), currentPatch%land_use_label, currentPatch%nocomp_pft_label, & - hlm_numSWb, numpft, currentSite%nlevsoil, hlm_current_tod, & + num_swb, numpft, currentSite%nlevsoil, hlm_current_tod, & regeneration_model) ! Initialize the litter pools to zero, these diff --git a/main/EDInitMod.F90 b/main/EDInitMod.F90 index c6cb008bd3..efef68aae4 100644 --- a/main/EDInitMod.F90 +++ b/main/EDInitMod.F90 @@ -762,7 +762,7 @@ subroutine init_patches( nsites, sites, bc_in) allocate(newp) call newp%Create(age, newparea, nocomp_bareground_land, nocomp_bareground, & - hlm_numSWb, numpft, sites(s)%nlevsoil, hlm_current_tod, & + num_swb, numpft, sites(s)%nlevsoil, hlm_current_tod, & regeneration_model) ! set pointers for first patch (or only patch, if nocomp is false) diff --git a/main/EDTypesMod.F90 b/main/EDTypesMod.F90 index 0307cd6518..ec6ed4dc44 100644 --- a/main/EDTypesMod.F90 +++ b/main/EDTypesMod.F90 @@ -7,6 +7,7 @@ module EDTypesMod use FatesConstantsMod, only : nocomp_bareground_land use FatesConstantsMod, only : secondaryland use FatesConstantsMod, only : secondary_age_threshold + use FatesConstantsMod, only : nearzero use FatesGlobals, only : fates_log use FatesHydraulicsMemMod, only : ed_cohort_hydr_type use FatesHydraulicsMemMod, only : ed_site_hydr_type @@ -462,7 +463,8 @@ module EDTypesMod contains procedure, public :: get_current_landuse_statevector - + procedure, public :: get_secondary_young_fraction + end type ed_site_type ! Make public necessary subroutines and functions @@ -603,7 +605,7 @@ function get_secondary_young_fraction(this) result(secondary_young_fraction) currentPatch => currentPatch%younger end do - if ( (secondary_young_area + secondary_old_area) .gt. fates_tiny) then + if ( (secondary_young_area + secondary_old_area) .gt. nearzero ) then secondary_young_fraction = secondary_young_area / (secondary_young_area + secondary_old_area) else secondary_young_fraction = -1._r8 diff --git a/main/FatesHistoryInterfaceMod.F90 b/main/FatesHistoryInterfaceMod.F90 index c2014b75e2..d9f7d7ac4a 100644 --- a/main/FatesHistoryInterfaceMod.F90 +++ b/main/FatesHistoryInterfaceMod.F90 @@ -2390,7 +2390,6 @@ subroutine update_history_dyn1(this,nc,nsites,sites,bc_in) hio_fire_disturbance_rate_si => this%hvars(ih_fire_disturbance_rate_si)%r81d, & hio_logging_disturbance_rate_si => this%hvars(ih_logging_disturbance_rate_si)%r81d, & hio_fall_disturbance_rate_si => this%hvars(ih_fall_disturbance_rate_si)%r81d, & - hio_harvest_carbonflux_si => this%hvars(ih_harvest_carbonflux_si)%r81d, & hio_harvest_debt_si => this%hvars(ih_harvest_debt_si)%r81d, & hio_harvest_debt_sec_si => this%hvars(ih_harvest_debt_sec_si)%r81d, & hio_npp_leaf_si => this%hvars(ih_npp_leaf_si)%r81d, & diff --git a/main/FatesRestartInterfaceMod.F90 b/main/FatesRestartInterfaceMod.F90 index 3d1219a55a..57b0bd6ea9 100644 --- a/main/FatesRestartInterfaceMod.F90 +++ b/main/FatesRestartInterfaceMod.F90 @@ -3049,7 +3049,6 @@ subroutine get_restart_vectors(this, nc, nsites, sites) integer :: i_landuse,i_pflu ! loop counter for land use class integer :: i_lu_donor, i_lu_receiver, i_dist ! loop counters for land use and disturbance integer :: i_term_type ! loop counter for termination type - integer :: i_lu_donor, i_lu_receiver, i_dist ! loop counters for land use and disturbance associate( rio_npatch_si => this%rvars(ir_npatch_si)%int1d, & rio_cd_status_si => this%rvars(ir_cd_status_si)%int1d, & From d00ece6bd6cff548483977f40c0be683a698b2f1 Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Fri, 17 May 2024 15:59:29 -0400 Subject: [PATCH 090/112] added parameter file patch for api 36 --- .../archive/api36.0.0_051724_patch_params.xml | 96 +++++++++++++++++++ 1 file changed, 96 insertions(+) create mode 100644 parameter_files/archive/api36.0.0_051724_patch_params.xml diff --git a/parameter_files/archive/api36.0.0_051724_patch_params.xml b/parameter_files/archive/api36.0.0_051724_patch_params.xml new file mode 100644 index 0000000000..938bd4bd78 --- /dev/null +++ b/parameter_files/archive/api36.0.0_051724_patch_params.xml @@ -0,0 +1,96 @@ + + + + + + + + + + + + + + + archive/api36.0.0_051724_params_default.xml + fates_params_default.cdl + 1,2,3,4,5,6,7,8,9,10,11,12 + + + fates_landuse_harvest_pprod10 + fates_pft + fraction + fraction of harvest wood product that goes to 10-year product pool (remainder goes to 100-year pool) + 1, 0.75, 0.75, 0.75, 1, 0.75, 1, 1, 1, 1, 1, 1 + + + fates_landuse_luc_frac_burned + fates_pft + fraction + fraction of land use change-generated and not-exported material that is burned (the remainder goes to litter) + 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_landuse_luc_frac_exported + fates_pft + fraction + fraction of land use change-generated wood material that is exported to wood product (the remainder is either burned or goes to litter) + 0.4, 0.4, 0.4, 0.4, 0.4, 0.4, 0.2, 0.2, 0.2, 0, 0, 0 + + + fates_landuse_luc_pprod10 + fates_pft + fraction + fraction of land use change wood product that goes to 10-year product pool (remainder goes to 100-year pool) + 1, 0.75, 0.75, 0.75, 1, 0.75, 1, 1, 1, 1, 1, 1 + + + fates_landuse_crop_lu_pft_vector + fates_landuse_class + NA + the FATES PFT index to use on a given crop land-use type (dummy value of -999 for non-crop types) + 999, -999, -999, -999, 11 + + + fates_max_nocomp_pfts_by_landuse + fates_landuse_class + count + maximum number of nocomp PFTs on each land use type (only used in nocomp mode) + 4, 4, 1, 1, 1 + + + fates_landuse_pprodharv10_forest_mean + + + + + fates_landuse_harvest_pprod10:units = "fraction" ; + fates_landuse_harvest_pprod10:long_name = "fraction of harvest wood product that goes to 10-year product pool (remainder goes to 100-year pool)" ; + double fates_landuse_luc_frac_burned(fates_pft) ; + fates_landuse_luc_frac_burned:units = "fraction" ; + fates_landuse_luc_frac_burned:long_name = "fraction of land use change-generated and not-exported material that is burned (the remainder goes to litter)" ; + + double fates_landuse_luc_frac_exported(fates_pft) ; + fates_landuse_luc_frac_exported:units = "fraction" ; + fates_landuse_luc_frac_exported:long_name = "fraction of land use change-generated wood material that is exported to wood product (the remainder is either burned or goes to litter)" ; + + double fates_landuse_luc_pprod10(fates_pft) ; + fates_landuse_luc_pprod10:units = "fraction" ; + fates_landuse_luc_pprod10:long_name = "fraction of land use change wood product that goes to 10-year product pool (remainder goes to 100-year pool)" ; + +double fates_landuse_crop_lu_pft_vector(fates_landuseclass) ; + fates_landuse_crop_lu_pft_vector:units = "NA" ; + fates_landuse_crop_lu_pft_vector:long_name = "What FATES PFT index to use on a given crop land-use type? (dummy value of -999 for non-crop types)" ; + double fates_max_nocomp_pfts_by_landuse(fates_landuseclass) ; + fates_max_nocomp_pfts_by_landuse:units = "count" ; + fates_max_nocomp_pfts_by_landuse:long_name = "maximum number of nocomp PFTs on each land use type (only used in nocomp mode)" ; + + + + From 7084c0d11214f38090e4611ac17e7a817988abae Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Mon, 20 May 2024 10:12:58 -0400 Subject: [PATCH 091/112] updated parameter api update xml --- .../api36.0.0_051724_params_default.cdl | 1776 +++++++++++++++++ .../archive/api36.0.0_051724_patch_params.xml | 31 +- parameter_files/fates_params_default.cdl | 6 +- 3 files changed, 1781 insertions(+), 32 deletions(-) create mode 100644 parameter_files/archive/api36.0.0_051724_params_default.cdl diff --git a/parameter_files/archive/api36.0.0_051724_params_default.cdl b/parameter_files/archive/api36.0.0_051724_params_default.cdl new file mode 100644 index 0000000000..2a909ee340 --- /dev/null +++ b/parameter_files/archive/api36.0.0_051724_params_default.cdl @@ -0,0 +1,1776 @@ +netcdf tmp { +dimensions: + fates_NCWD = 4 ; + fates_history_age_bins = 7 ; + fates_history_coage_bins = 2 ; + fates_history_damage_bins = 2 ; + fates_history_height_bins = 6 ; + fates_history_size_bins = 13 ; + fates_hlm_pftno = 14 ; + fates_hydr_organs = 4 ; + fates_landuseclass = 5 ; + fates_leafage_class = 1 ; + fates_litterclass = 6 ; + fates_pft = 12 ; + fates_plant_organs = 4 ; + fates_string_length = 60 ; +variables: + double fates_history_ageclass_bin_edges(fates_history_age_bins) ; + fates_history_ageclass_bin_edges:units = "yr" ; + fates_history_ageclass_bin_edges:long_name = "Lower edges for age class bins used in age-resolved patch history output" ; + double fates_history_coageclass_bin_edges(fates_history_coage_bins) ; + fates_history_coageclass_bin_edges:units = "years" ; + fates_history_coageclass_bin_edges:long_name = "Lower edges for cohort age class bins used in cohort age resolved history output" ; + double fates_history_height_bin_edges(fates_history_height_bins) ; + fates_history_height_bin_edges:units = "m" ; + fates_history_height_bin_edges:long_name = "Lower edges for height bins used in height-resolved history output" ; + double fates_history_damage_bin_edges(fates_history_damage_bins) ; + fates_history_damage_bin_edges:units = "% crown loss" ; + fates_history_damage_bin_edges:long_name = "Lower edges for damage class bins used in cohort history output" ; + 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_alloc_organ_id(fates_plant_organs) ; + fates_alloc_organ_id:units = "unitless" ; + fates_alloc_organ_id:long_name = "This is the global index that the organ in this file is associated with, values match those in parteh/PRTGenericMod.F90" ; + double fates_hydro_htftype_node(fates_hydr_organs) ; + fates_hydro_htftype_node:units = "unitless" ; + fates_hydro_htftype_node:long_name = "Switch that defines the hydraulic transfer functions for each organ." ; + char fates_pftname(fates_pft, fates_string_length) ; + fates_pftname:units = "unitless - string" ; + fates_pftname:long_name = "Description of plant type" ; + char fates_hydro_organ_name(fates_hydr_organs, fates_string_length) ; + fates_hydro_organ_name:units = "unitless - string" ; + fates_hydro_organ_name:long_name = "Name of plant hydraulics organs (DONT CHANGE, order matches media list in FatesHydraulicsMemMod.F90)" ; + char fates_alloc_organ_name(fates_plant_organs, fates_string_length) ; + fates_alloc_organ_name:units = "unitless - string" ; + fates_alloc_organ_name:long_name = "Name of plant organs (with alloc_organ_id, must match PRTGenericMod.F90)" ; + char fates_landuseclass_name(fates_landuseclass, fates_string_length) ; + fates_landuseclass_name:units = "unitless - string" ; + fates_landuseclass_name:long_name = "Name of the land use classes, for variables associated with dimension fates_landuseclass" ; + 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" ; + double fates_alloc_organ_priority(fates_plant_organs, fates_pft) ; + fates_alloc_organ_priority:units = "index" ; + fates_alloc_organ_priority:long_name = "Priority level for allocation, 1: replaces turnover from storage, 2: same priority as storage use/replacement, 3: ascending in order of least importance" ; + 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" ; + double fates_alloc_store_priority_frac(fates_pft) ; + fates_alloc_store_priority_frac:units = "unitless" ; + fates_alloc_store_priority_frac:long_name = "for high-priority organs, the fraction of their turnover demand that is gauranteed to be replaced, and if need-be by storage" ; + double fates_allom_agb1(fates_pft) ; + fates_allom_agb1:units = "variable" ; + fates_allom_agb1:long_name = "Parameter 1 for agb allometry" ; + double fates_allom_agb2(fates_pft) ; + fates_allom_agb2:units = "variable" ; + fates_allom_agb2:long_name = "Parameter 2 for agb allometry" ; + double fates_allom_agb3(fates_pft) ; + fates_allom_agb3:units = "variable" ; + fates_allom_agb3:long_name = "Parameter 3 for agb allometry" ; + double fates_allom_agb4(fates_pft) ; + fates_allom_agb4:units = "variable" ; + fates_allom_agb4:long_name = "Parameter 4 for agb allometry" ; + double fates_allom_agb_frac(fates_pft) ; + fates_allom_agb_frac:units = "fraction" ; + fates_allom_agb_frac:long_name = "Fraction of woody biomass that is above ground" ; + double fates_allom_amode(fates_pft) ; + fates_allom_amode:units = "index" ; + fates_allom_amode:long_name = "AGB allometry function index." ; + double fates_allom_blca_expnt_diff(fates_pft) ; + fates_allom_blca_expnt_diff:units = "unitless" ; + fates_allom_blca_expnt_diff:long_name = "difference between allometric DBH:bleaf and DBH:crown area exponents" ; + double fates_allom_cmode(fates_pft) ; + fates_allom_cmode:units = "index" ; + fates_allom_cmode:long_name = "coarse root biomass allometry function index." ; + double fates_allom_d2bl1(fates_pft) ; + fates_allom_d2bl1:units = "variable" ; + fates_allom_d2bl1:long_name = "Parameter 1 for d2bl allometry" ; + double fates_allom_d2bl2(fates_pft) ; + fates_allom_d2bl2:units = "variable" ; + fates_allom_d2bl2:long_name = "Parameter 2 for d2bl allometry" ; + double fates_allom_d2bl3(fates_pft) ; + fates_allom_d2bl3:units = "unitless" ; + fates_allom_d2bl3:long_name = "Parameter 3 for d2bl allometry" ; + double fates_allom_d2ca_coefficient_max(fates_pft) ; + fates_allom_d2ca_coefficient_max:units = "m2 cm^(-1/beta)" ; + fates_allom_d2ca_coefficient_max:long_name = "max (savanna) dbh to area multiplier factor where: area = n*d2ca_coeff*dbh^beta" ; + double fates_allom_d2ca_coefficient_min(fates_pft) ; + fates_allom_d2ca_coefficient_min:units = "m2 cm^(-1/beta)" ; + fates_allom_d2ca_coefficient_min:long_name = "min (forest) dbh to area multiplier factor where: area = n*d2ca_coeff*dbh^beta" ; + double fates_allom_d2h1(fates_pft) ; + fates_allom_d2h1:units = "variable" ; + fates_allom_d2h1:long_name = "Parameter 1 for d2h allometry (intercept, or c)" ; + double fates_allom_d2h2(fates_pft) ; + fates_allom_d2h2:units = "variable" ; + fates_allom_d2h2:long_name = "Parameter 2 for d2h allometry (slope, or m)" ; + double fates_allom_d2h3(fates_pft) ; + fates_allom_d2h3:units = "variable" ; + fates_allom_d2h3:long_name = "Parameter 3 for d2h allometry (optional)" ; + double fates_allom_dbh_maxheight(fates_pft) ; + fates_allom_dbh_maxheight:units = "cm" ; + fates_allom_dbh_maxheight:long_name = "the diameter (if any) corresponding to maximum height, diameters may increase beyond this" ; + double fates_allom_dmode(fates_pft) ; + fates_allom_dmode:units = "index" ; + fates_allom_dmode:long_name = "crown depth allometry function index" ; + double fates_allom_fmode(fates_pft) ; + fates_allom_fmode:units = "index" ; + fates_allom_fmode:long_name = "fine root biomass allometry function index." ; + double fates_allom_fnrt_prof_a(fates_pft) ; + fates_allom_fnrt_prof_a:units = "unitless" ; + fates_allom_fnrt_prof_a:long_name = "Fine root profile function, parameter a" ; + double fates_allom_fnrt_prof_b(fates_pft) ; + fates_allom_fnrt_prof_b:units = "unitless" ; + fates_allom_fnrt_prof_b:long_name = "Fine root profile function, parameter b" ; + double fates_allom_fnrt_prof_mode(fates_pft) ; + fates_allom_fnrt_prof_mode:units = "index" ; + fates_allom_fnrt_prof_mode:long_name = "Index to select fine root profile function: 1) Jackson Beta, 2) 1-param exponential 3) 2-param exponential" ; + double fates_allom_frbstor_repro(fates_pft) ; + fates_allom_frbstor_repro:units = "fraction" ; + fates_allom_frbstor_repro:long_name = "fraction of bstore goes to reproduction after plant dies" ; + double fates_allom_h2cd1(fates_pft) ; + fates_allom_h2cd1:units = "variable" ; + fates_allom_h2cd1:long_name = "Parameter 1 for h2cd allometry (exp(log-intercept) or scaling). If allom_dmode=1; this is the same as former crown_depth_frac parameter" ; + double fates_allom_h2cd2(fates_pft) ; + fates_allom_h2cd2:units = "variable" ; + fates_allom_h2cd2:long_name = "Parameter 2 for h2cd allometry (log-slope or exponent). If allom_dmode=1; this is not needed (as exponent is assumed 1)" ; + double fates_allom_hmode(fates_pft) ; + fates_allom_hmode:units = "index" ; + fates_allom_hmode:long_name = "height allometry function index." ; + double fates_allom_l2fr(fates_pft) ; + fates_allom_l2fr:units = "gC/gC" ; + fates_allom_l2fr:long_name = "Allocation parameter: fine root C per leaf C" ; + double fates_allom_la_per_sa_int(fates_pft) ; + fates_allom_la_per_sa_int:units = "m2/cm2" ; + fates_allom_la_per_sa_int:long_name = "Leaf area per sapwood area, intercept" ; + double fates_allom_la_per_sa_slp(fates_pft) ; + fates_allom_la_per_sa_slp:units = "m2/cm2/m" ; + fates_allom_la_per_sa_slp:long_name = "Leaf area per sapwood area rate of change with height, slope (optional)" ; + double fates_allom_lmode(fates_pft) ; + fates_allom_lmode:units = "index" ; + fates_allom_lmode:long_name = "leaf biomass allometry function index." ; + double fates_allom_sai_scaler(fates_pft) ; + fates_allom_sai_scaler:units = "m2/m2" ; + fates_allom_sai_scaler:long_name = "allometric ratio of SAI per LAI" ; + double fates_allom_smode(fates_pft) ; + fates_allom_smode:units = "index" ; + fates_allom_smode:long_name = "sapwood allometry function index." ; + double fates_allom_stmode(fates_pft) ; + fates_allom_stmode:units = "index" ; + fates_allom_stmode:long_name = "storage allometry function index: 1) Storage proportional to leaf biomass (with trimming), 2) Storage proportional to maximum leaf biomass (not trimmed)" ; + 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_c2b(fates_pft) ; + fates_c2b:units = "ratio" ; + fates_c2b:long_name = "Carbon to biomass multiplier of bulk structural tissues" ; + double fates_cnp_eca_alpha_ptase(fates_pft) ; + fates_cnp_eca_alpha_ptase:units = "g/m3" ; + fates_cnp_eca_alpha_ptase:long_name = "(INACTIVE, KEEP AT 0) fraction of P from ptase activity sent directly to plant (ECA)" ; + double fates_cnp_eca_decompmicc(fates_pft) ; + fates_cnp_eca_decompmicc:units = "gC/m3" ; + fates_cnp_eca_decompmicc:long_name = "maximum soil microbial decomposer biomass found over depth (will be applied at a reference depth w/ exponential attenuation) (ECA)" ; + double fates_cnp_eca_km_nh4(fates_pft) ; + fates_cnp_eca_km_nh4:units = "gN/m3" ; + fates_cnp_eca_km_nh4:long_name = "half-saturation constant for plant nh4 uptake (ECA)" ; + double fates_cnp_eca_km_no3(fates_pft) ; + fates_cnp_eca_km_no3:units = "gN/m3" ; + fates_cnp_eca_km_no3:long_name = "half-saturation constant for plant no3 uptake (ECA)" ; + double fates_cnp_eca_km_p(fates_pft) ; + fates_cnp_eca_km_p:units = "gP/m3" ; + fates_cnp_eca_km_p:long_name = "half-saturation constant for plant p uptake (ECA)" ; + double fates_cnp_eca_km_ptase(fates_pft) ; + fates_cnp_eca_km_ptase:units = "gP/m3" ; + fates_cnp_eca_km_ptase:long_name = "half-saturation constant for biochemical P (ECA)" ; + double fates_cnp_eca_lambda_ptase(fates_pft) ; + fates_cnp_eca_lambda_ptase:units = "g/m3" ; + fates_cnp_eca_lambda_ptase:long_name = "(INACTIVE, KEEP AT 0) critical value for biochemical production (ECA)" ; + double fates_cnp_eca_vmax_ptase(fates_pft) ; + fates_cnp_eca_vmax_ptase:units = "gP/m2/s" ; + fates_cnp_eca_vmax_ptase:long_name = "maximum production rate for biochemical P (per m2) (ECA)" ; + double fates_cnp_nfix1(fates_pft) ; + fates_cnp_nfix1:units = "fraction" ; + fates_cnp_nfix1:long_name = "fractional surcharge added to maintenance respiration that drives symbiotic fixation" ; + double fates_cnp_nitr_store_ratio(fates_pft) ; + fates_cnp_nitr_store_ratio:units = "(gN/gN)" ; + fates_cnp_nitr_store_ratio:long_name = "storeable (labile) N, as a ratio compared to the N bound in cell structures of other organs (see code)" ; + double fates_cnp_phos_store_ratio(fates_pft) ; + fates_cnp_phos_store_ratio:units = "(gP/gP)" ; + fates_cnp_phos_store_ratio:long_name = "storeable (labile) P, as a ratio compared to the P bound in cell structures of other organs (see code)" ; + double fates_cnp_pid_kd(fates_pft) ; + fates_cnp_pid_kd:units = "unknown" ; + fates_cnp_pid_kd:long_name = "derivative constant of the PID controller on adaptive fine-root biomass" ; + double fates_cnp_pid_ki(fates_pft) ; + fates_cnp_pid_ki:units = "unknown" ; + fates_cnp_pid_ki:long_name = "integral constant of the PID controller on adaptive fine-root biomass" ; + double fates_cnp_pid_kp(fates_pft) ; + fates_cnp_pid_kp:units = "unknown" ; + fates_cnp_pid_kp:long_name = "proportional constant of the PID controller on adaptive fine-root biomass" ; + double fates_cnp_prescribed_nuptake(fates_pft) ; + fates_cnp_prescribed_nuptake:units = "fraction" ; + fates_cnp_prescribed_nuptake:long_name = "Prescribed N uptake flux. 0=fully coupled simulation >0=prescribed (experimental)" ; + double fates_cnp_prescribed_puptake(fates_pft) ; + fates_cnp_prescribed_puptake:units = "fraction" ; + fates_cnp_prescribed_puptake:long_name = "Prescribed P uptake flux. 0=fully coupled simulation, >0=prescribed (experimental)" ; + double fates_cnp_store_ovrflw_frac(fates_pft) ; + fates_cnp_store_ovrflw_frac:units = "fraction" ; + fates_cnp_store_ovrflw_frac:long_name = "size of overflow storage (for excess C,N or P) as a fraction of storage target" ; + double fates_cnp_turnover_nitr_retrans(fates_plant_organs, fates_pft) ; + fates_cnp_turnover_nitr_retrans:units = "fraction" ; + fates_cnp_turnover_nitr_retrans:long_name = "retranslocation (reabsorbtion) fraction of nitrogen in turnover of scenescing tissues" ; + double fates_cnp_turnover_phos_retrans(fates_plant_organs, fates_pft) ; + fates_cnp_turnover_phos_retrans:units = "fraction" ; + fates_cnp_turnover_phos_retrans:long_name = "retranslocation (reabsorbtion) fraction of phosphorus in turnover of scenescing tissues" ; + double fates_cnp_vmax_nh4(fates_pft) ; + fates_cnp_vmax_nh4:units = "gN/gC/s" ; + fates_cnp_vmax_nh4:long_name = "maximum (potential) uptake rate of NH4 per gC of fineroot biomass (see main/EDPftvarcon.F90 vmax_nh4 for usage)" ; + double fates_cnp_vmax_no3(fates_pft) ; + fates_cnp_vmax_no3:units = "gN/gC/s" ; + fates_cnp_vmax_no3:long_name = "maximum (potential) uptake rate of NO3 per gC of fineroot biomass (see main/EDPftvarcon.F90 vmax_no3 for usage)" ; + double fates_cnp_vmax_p(fates_pft) ; + fates_cnp_vmax_p:units = "gP/gC/s" ; + fates_cnp_vmax_p:long_name = "maximum production rate for phosphorus (ECA and RD)" ; + double fates_damage_frac(fates_pft) ; + fates_damage_frac:units = "fraction" ; + fates_damage_frac:long_name = "fraction of cohort damaged in each damage event (event frequency specified in the is_it_damage_time subroutine)" ; + double fates_damage_mort_p1(fates_pft) ; + fates_damage_mort_p1:units = "fraction" ; + fates_damage_mort_p1:long_name = "inflection point of damage mortality function, a value of 0.8 means 50% mortality with 80% loss of crown, turn off with a large number" ; + double fates_damage_mort_p2(fates_pft) ; + fates_damage_mort_p2:units = "unitless" ; + fates_damage_mort_p2:long_name = "rate of mortality increase with damage" ; + double fates_damage_recovery_scalar(fates_pft) ; + fates_damage_recovery_scalar:units = "unitless" ; + fates_damage_recovery_scalar:long_name = "fraction of the cohort that recovers from damage" ; + 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_fire_alpha_SH(fates_pft) ; + 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" ; + fates_fire_bark_scaler:long_name = "the thickness of a cohorts bark as a fraction of its dbh" ; + double fates_fire_crown_kill(fates_pft) ; + fates_fire_crown_kill:units = "NA" ; + fates_fire_crown_kill:long_name = "fire parameter, see equation 22 in Thonicke et al 2010" ; + double fates_frag_fnrt_fcel(fates_pft) ; + fates_frag_fnrt_fcel:units = "fraction" ; + fates_frag_fnrt_fcel:long_name = "Fine root litter cellulose fraction" ; + double fates_frag_fnrt_flab(fates_pft) ; + fates_frag_fnrt_flab:units = "fraction" ; + fates_frag_fnrt_flab:long_name = "Fine root litter labile fraction" ; + double fates_frag_fnrt_flig(fates_pft) ; + fates_frag_fnrt_flig:units = "fraction" ; + fates_frag_fnrt_flig:long_name = "Fine root litter lignin fraction" ; + double fates_frag_leaf_fcel(fates_pft) ; + fates_frag_leaf_fcel:units = "fraction" ; + fates_frag_leaf_fcel:long_name = "Leaf litter cellulose fraction" ; + double fates_frag_leaf_flab(fates_pft) ; + fates_frag_leaf_flab:units = "fraction" ; + fates_frag_leaf_flab:long_name = "Leaf litter labile fraction" ; + double fates_frag_leaf_flig(fates_pft) ; + fates_frag_leaf_flig:units = "fraction" ; + fates_frag_leaf_flig:long_name = "Leaf litter lignin fraction" ; + double fates_frag_seed_decay_rate(fates_pft) ; + fates_frag_seed_decay_rate:units = "yr-1" ; + fates_frag_seed_decay_rate:long_name = "fraction of seeds that decay per year" ; + double fates_grperc(fates_pft) ; + fates_grperc:units = "unitless" ; + fates_grperc:long_name = "Growth respiration factor" ; + double fates_hydro_avuln_gs(fates_pft) ; + fates_hydro_avuln_gs:units = "unitless" ; + fates_hydro_avuln_gs:long_name = "shape parameter for stomatal control of water vapor exiting leaf" ; + double fates_hydro_avuln_node(fates_hydr_organs, fates_pft) ; + fates_hydro_avuln_node:units = "unitless" ; + fates_hydro_avuln_node:long_name = "xylem vulnerability curve shape parameter" ; + double fates_hydro_epsil_node(fates_hydr_organs, fates_pft) ; + fates_hydro_epsil_node:units = "MPa" ; + fates_hydro_epsil_node:long_name = "bulk elastic modulus" ; + double fates_hydro_fcap_node(fates_hydr_organs, fates_pft) ; + fates_hydro_fcap_node:units = "unitless" ; + fates_hydro_fcap_node:long_name = "fraction of non-residual water that is capillary in source" ; + double fates_hydro_k_lwp(fates_pft) ; + fates_hydro_k_lwp:units = "unitless" ; + fates_hydro_k_lwp:long_name = "inner leaf humidity scaling coefficient" ; + double fates_hydro_kmax_node(fates_hydr_organs, fates_pft) ; + fates_hydro_kmax_node:units = "kg/MPa/m/s" ; + fates_hydro_kmax_node:long_name = "maximum xylem conductivity per unit conducting xylem area" ; + double fates_hydro_p50_gs(fates_pft) ; + fates_hydro_p50_gs:units = "MPa" ; + fates_hydro_p50_gs:long_name = "water potential at 50% loss of stomatal conductance" ; + double fates_hydro_p50_node(fates_hydr_organs, fates_pft) ; + fates_hydro_p50_node:units = "MPa" ; + fates_hydro_p50_node:long_name = "xylem water potential at 50% loss of conductivity" ; + double fates_hydro_p_taper(fates_pft) ; + fates_hydro_p_taper:units = "unitless" ; + fates_hydro_p_taper:long_name = "xylem taper exponent" ; + double fates_hydro_pinot_node(fates_hydr_organs, fates_pft) ; + fates_hydro_pinot_node:units = "MPa" ; + fates_hydro_pinot_node:long_name = "osmotic potential at full turgor" ; + double fates_hydro_pitlp_node(fates_hydr_organs, fates_pft) ; + fates_hydro_pitlp_node:units = "MPa" ; + fates_hydro_pitlp_node:long_name = "turgor loss point" ; + double fates_hydro_resid_node(fates_hydr_organs, fates_pft) ; + fates_hydro_resid_node:units = "cm3/cm3" ; + fates_hydro_resid_node:long_name = "residual water conent" ; + double fates_hydro_rfrac_stem(fates_pft) ; + fates_hydro_rfrac_stem:units = "fraction" ; + fates_hydro_rfrac_stem:long_name = "fraction of total tree resistance from troot to canopy" ; + double fates_hydro_rs2(fates_pft) ; + fates_hydro_rs2:units = "m" ; + fates_hydro_rs2:long_name = "absorbing root radius" ; + double fates_hydro_srl(fates_pft) ; + fates_hydro_srl:units = "m g-1" ; + fates_hydro_srl:long_name = "specific root length" ; + double fates_hydro_thetas_node(fates_hydr_organs, fates_pft) ; + fates_hydro_thetas_node:units = "cm3/cm3" ; + fates_hydro_thetas_node:long_name = "saturated water content" ; + double fates_hydro_vg_alpha_node(fates_hydr_organs, fates_pft) ; + fates_hydro_vg_alpha_node:units = "MPa-1" ; + fates_hydro_vg_alpha_node:long_name = "(used if hydr_htftype_node = 2), capillary length parameter in van Genuchten model" ; + double fates_hydro_vg_m_node(fates_hydr_organs, fates_pft) ; + fates_hydro_vg_m_node:units = "unitless" ; + fates_hydro_vg_m_node:long_name = "(used if hydr_htftype_node = 2),m in van Genuchten 1980 model, 2nd pore size distribution parameter" ; + double fates_hydro_vg_n_node(fates_hydr_organs, fates_pft) ; + fates_hydro_vg_n_node:units = "unitless" ; + fates_hydro_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)" ; + double fates_leaf_jmaxha(fates_pft) ; + fates_leaf_jmaxha:units = "J/mol" ; + fates_leaf_jmaxha:long_name = "activation energy for jmax. NOTE: if fates_leaf_photo_tempsens_model=2 then these values are NOT USED" ; + double fates_leaf_jmaxhd(fates_pft) ; + fates_leaf_jmaxhd:units = "J/mol" ; + fates_leaf_jmaxhd:long_name = "deactivation energy for jmax. NOTE: if fates_leaf_photo_tempsens_model=2 then these values are NOT USED" ; + double fates_leaf_jmaxse(fates_pft) ; + fates_leaf_jmaxse:units = "J/mol/K" ; + fates_leaf_jmaxse:long_name = "entropy term for jmax. NOTE: if fates_leaf_photo_tempsens_model=2 then these values are NOT USED" ; + double fates_leaf_slamax(fates_pft) ; + fates_leaf_slamax:units = "m^2/gC" ; + fates_leaf_slamax:long_name = "Maximum Specific Leaf Area (SLA), even if under a dense canopy" ; + double fates_leaf_slatop(fates_pft) ; + fates_leaf_slatop:units = "m^2/gC" ; + fates_leaf_slatop:long_name = "Specific Leaf Area (SLA) at top of canopy, projected area basis" ; + double fates_leaf_stomatal_intercept(fates_pft) ; + fates_leaf_stomatal_intercept:units = "umol H2O/m**2/s" ; + fates_leaf_stomatal_intercept:long_name = "Minimum unstressed stomatal conductance for Ball-Berry model and Medlyn model" ; + double fates_leaf_stomatal_slope_ballberry(fates_pft) ; + fates_leaf_stomatal_slope_ballberry:units = "unitless" ; + fates_leaf_stomatal_slope_ballberry:long_name = "stomatal slope parameter, as per Ball-Berry" ; + double fates_leaf_stomatal_slope_medlyn(fates_pft) ; + fates_leaf_stomatal_slope_medlyn:units = "KPa**0.5" ; + fates_leaf_stomatal_slope_medlyn:long_name = "stomatal slope parameter, as per Medlyn" ; + 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" ; + double fates_leaf_vcmaxha(fates_pft) ; + fates_leaf_vcmaxha:units = "J/mol" ; + fates_leaf_vcmaxha:long_name = "activation energy for vcmax. NOTE: if fates_leaf_photo_tempsens_model=2 then these values are NOT USED" ; + double fates_leaf_vcmaxhd(fates_pft) ; + fates_leaf_vcmaxhd:units = "J/mol" ; + fates_leaf_vcmaxhd:long_name = "deactivation energy for vcmax. NOTE: if fates_leaf_photo_tempsens_model=2 then these values are NOT USED" ; + double fates_leaf_vcmaxse(fates_pft) ; + fates_leaf_vcmaxse:units = "J/mol/K" ; + fates_leaf_vcmaxse:long_name = "entropy term for vcmax. NOTE: if fates_leaf_photo_tempsens_model=2 then these values are NOT USED" ; + double fates_leafn_vert_scaler_coeff1(fates_pft) ; + fates_leafn_vert_scaler_coeff1:units = "unitless" ; + fates_leafn_vert_scaler_coeff1:long_name = "Coefficient one for decrease in leaf nitrogen through the canopy, from Lloyd et al. 2010." ; + double fates_leafn_vert_scaler_coeff2(fates_pft) ; + fates_leafn_vert_scaler_coeff2:units = "unitless" ; + fates_leafn_vert_scaler_coeff2:long_name = "Coefficient two for decrease in leaf nitrogen through the canopy, from Lloyd et al. 2010." ; + double fates_maintresp_leaf_atkin2017_baserate(fates_pft) ; + fates_maintresp_leaf_atkin2017_baserate:units = "umol CO2/m^2/s" ; + fates_maintresp_leaf_atkin2017_baserate:long_name = "Leaf maintenance respiration base rate parameter (r0) per Atkin et al 2017" ; + double fates_maintresp_leaf_ryan1991_baserate(fates_pft) ; + fates_maintresp_leaf_ryan1991_baserate:units = "gC/gN/s" ; + fates_maintresp_leaf_ryan1991_baserate:long_name = "Leaf maintenance respiration base rate per Ryan et al 1991" ; + double fates_maintresp_leaf_vert_scaler_coeff1(fates_pft) ; + fates_maintresp_leaf_vert_scaler_coeff1:units = "unitless" ; + fates_maintresp_leaf_vert_scaler_coeff1:long_name = "Leaf maintenance respiration decrease through the canopy. Only applies to Atkin et al. 2017. For proportionality between photosynthesis and respiration through the canopy, match with fates_leafn_vert_scaler_coeff1." ; + double fates_maintresp_leaf_vert_scaler_coeff2(fates_pft) ; + fates_maintresp_leaf_vert_scaler_coeff2:units = "unitless" ; + fates_maintresp_leaf_vert_scaler_coeff2:long_name = "Leaf maintenance respiration decrease through the canopy. Only applies to Atkin et al. 2017. For proportionality between photosynthesis and respiration through the canopy, match with fates_leafn_vert_scaler_coeff2." ; + double fates_maintresp_reduction_curvature(fates_pft) ; + fates_maintresp_reduction_curvature:units = "unitless (0-1)" ; + fates_maintresp_reduction_curvature:long_name = "curvature of MR reduction as f(carbon storage), 1=linear, 0=very curved" ; + double fates_maintresp_reduction_intercept(fates_pft) ; + fates_maintresp_reduction_intercept:units = "unitless (0-1)" ; + fates_maintresp_reduction_intercept:long_name = "intercept of MR reduction as f(carbon storage), 0=no throttling, 1=max throttling" ; + double fates_maintresp_reduction_upthresh(fates_pft) ; + fates_maintresp_reduction_upthresh:units = "unitless (0-1)" ; + fates_maintresp_reduction_upthresh:long_name = "upper threshold for storage biomass (relative to leaf biomass) above which MR is not reduced" ; + double fates_mort_bmort(fates_pft) ; + fates_mort_bmort:units = "1/yr" ; + fates_mort_bmort:long_name = "background mortality rate" ; + double fates_mort_freezetol(fates_pft) ; + fates_mort_freezetol:units = "degrees C" ; + fates_mort_freezetol:long_name = "minimum temperature tolerance" ; + double fates_mort_hf_flc_threshold(fates_pft) ; + fates_mort_hf_flc_threshold:units = "fraction" ; + fates_mort_hf_flc_threshold:long_name = "plant fractional loss of conductivity at which drought mortality begins for hydraulic model" ; + double fates_mort_hf_sm_threshold(fates_pft) ; + fates_mort_hf_sm_threshold:units = "unitless" ; + fates_mort_hf_sm_threshold:long_name = "soil moisture (btran units) at which drought mortality begins for non-hydraulic model" ; + double fates_mort_ip_age_senescence(fates_pft) ; + fates_mort_ip_age_senescence:units = "years" ; + fates_mort_ip_age_senescence:long_name = "Mortality cohort age senescence inflection point. If _ this mortality term is off. Setting this value turns on age dependent mortality. " ; + double fates_mort_ip_size_senescence(fates_pft) ; + fates_mort_ip_size_senescence:units = "dbh cm" ; + fates_mort_ip_size_senescence:long_name = "Mortality dbh senescence inflection point. If _ this mortality term is off. Setting this value turns on size dependent mortality" ; + double fates_mort_prescribed_canopy(fates_pft) ; + fates_mort_prescribed_canopy:units = "1/yr" ; + fates_mort_prescribed_canopy:long_name = "mortality rate of canopy trees for prescribed physiology mode" ; + double fates_mort_prescribed_understory(fates_pft) ; + fates_mort_prescribed_understory:units = "1/yr" ; + fates_mort_prescribed_understory:long_name = "mortality rate of understory trees for prescribed physiology mode" ; + double fates_mort_r_age_senescence(fates_pft) ; + fates_mort_r_age_senescence:units = "mortality rate year^-1" ; + fates_mort_r_age_senescence:long_name = "Mortality age senescence rate of change. Sensible range is around 0.03-0.06. Larger values givesteeper mortality curves." ; + double fates_mort_r_size_senescence(fates_pft) ; + fates_mort_r_size_senescence:units = "mortality rate dbh^-1" ; + fates_mort_r_size_senescence:long_name = "Mortality dbh senescence rate of change. Sensible range is around 0.03-0.06. Larger values give steeper mortality curves." ; + double fates_mort_scalar_coldstress(fates_pft) ; + fates_mort_scalar_coldstress:units = "1/yr" ; + fates_mort_scalar_coldstress:long_name = "maximum mortality rate from cold stress" ; + double fates_mort_scalar_cstarvation(fates_pft) ; + fates_mort_scalar_cstarvation:units = "1/yr" ; + fates_mort_scalar_cstarvation:long_name = "maximum mortality rate from carbon starvation" ; + double fates_mort_scalar_hydrfailure(fates_pft) ; + fates_mort_scalar_hydrfailure:units = "1/yr" ; + fates_mort_scalar_hydrfailure:long_name = "maximum mortality rate from hydraulic failure" ; + double fates_mort_upthresh_cstarvation(fates_pft) ; + fates_mort_upthresh_cstarvation:units = "unitless" ; + fates_mort_upthresh_cstarvation:long_name = "threshold for storage biomass (relative to target leaf biomass) above which carbon starvation is zero" ; + double fates_nonhydro_smpsc(fates_pft) ; + fates_nonhydro_smpsc:units = "mm" ; + fates_nonhydro_smpsc:long_name = "Soil water potential at full stomatal closure" ; + double fates_nonhydro_smpso(fates_pft) ; + fates_nonhydro_smpso:units = "mm" ; + fates_nonhydro_smpso:long_name = "Soil water potential at full stomatal opening" ; + 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" ; + double fates_phen_drought_threshold(fates_pft) ; + fates_phen_drought_threshold:units = "m3/m3 or mm" ; + fates_phen_drought_threshold:long_name = "threshold for drought phenology (or lower threshold for semi-deciduous PFTs); the quantity depends on the sign: if positive, the threshold is volumetric soil moisture (m3/m3). If negative, the threshold is soil matric potentical (mm)" ; + double fates_phen_evergreen(fates_pft) ; + fates_phen_evergreen:units = "logical flag" ; + fates_phen_evergreen:long_name = "Binary flag for evergreen leaf habit" ; + double fates_phen_flush_fraction(fates_pft) ; + fates_phen_flush_fraction:units = "fraction" ; + fates_phen_flush_fraction:long_name = "Upon bud-burst, the maximum fraction of storage carbon used for flushing leaves" ; + double fates_phen_fnrt_drop_fraction(fates_pft) ; + fates_phen_fnrt_drop_fraction:units = "fraction" ; + fates_phen_fnrt_drop_fraction:long_name = "fraction of fine roots to drop during drought/cold" ; + double fates_phen_mindaysoff(fates_pft) ; + fates_phen_mindaysoff:units = "days" ; + fates_phen_mindaysoff:long_name = "day threshold compared against days since leaves abscised (shed)" ; + double fates_phen_moist_threshold(fates_pft) ; + fates_phen_moist_threshold:units = "m3/m3 or mm" ; + fates_phen_moist_threshold:long_name = "upper threshold for drought phenology (only for drought semi-deciduous PFTs); the quantity depends on the sign: if positive, the threshold is volumetric soil moisture (m3/m3). If negative, the threshold is soil matric potentical (mm)" ; + double fates_phen_season_decid(fates_pft) ; + fates_phen_season_decid:units = "logical flag" ; + fates_phen_season_decid:long_name = "Binary flag for seasonal-deciduous leaf habit" ; + double fates_phen_stem_drop_fraction(fates_pft) ; + fates_phen_stem_drop_fraction:units = "fraction" ; + fates_phen_stem_drop_fraction:long_name = "fraction of stems to drop for non-woody species during drought/cold" ; + double fates_phen_stress_decid(fates_pft) ; + fates_phen_stress_decid:units = "logical flag" ; + fates_phen_stress_decid:long_name = "Flag for stress/drought-deciduous leaf habit. 0 - not stress deciduous; 1 - default drought deciduous (two target states only, fully flushed or fully abscised); 2 - semi-deciduous" ; + double fates_prescribed_npp_canopy(fates_pft) ; + fates_prescribed_npp_canopy:units = "kgC / m^2 / yr" ; + fates_prescribed_npp_canopy:long_name = "NPP per unit crown area of canopy trees for prescribed physiology mode" ; + double fates_prescribed_npp_understory(fates_pft) ; + 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_rad_leaf_clumping_index(fates_pft) ; + fates_rad_leaf_clumping_index:units = "fraction (0-1)" ; + fates_rad_leaf_clumping_index:long_name = "factor describing how much self-occlusion of leaf scattering elements decreases light interception" ; + double fates_rad_leaf_rhonir(fates_pft) ; + fates_rad_leaf_rhonir:units = "fraction" ; + fates_rad_leaf_rhonir:long_name = "Leaf reflectance: near-IR" ; + double fates_rad_leaf_rhovis(fates_pft) ; + fates_rad_leaf_rhovis:units = "fraction" ; + fates_rad_leaf_rhovis:long_name = "Leaf reflectance: visible" ; + double fates_rad_leaf_taunir(fates_pft) ; + fates_rad_leaf_taunir:units = "fraction" ; + fates_rad_leaf_taunir:long_name = "Leaf transmittance: near-IR" ; + double fates_rad_leaf_tauvis(fates_pft) ; + fates_rad_leaf_tauvis:units = "fraction" ; + fates_rad_leaf_tauvis:long_name = "Leaf transmittance: visible" ; + double fates_rad_leaf_xl(fates_pft) ; + fates_rad_leaf_xl:units = "unitless" ; + fates_rad_leaf_xl:long_name = "Leaf/stem orientation index" ; + double fates_rad_stem_rhonir(fates_pft) ; + fates_rad_stem_rhonir:units = "fraction" ; + fates_rad_stem_rhonir:long_name = "Stem reflectance: near-IR" ; + double fates_rad_stem_rhovis(fates_pft) ; + fates_rad_stem_rhovis:units = "fraction" ; + fates_rad_stem_rhovis:long_name = "Stem reflectance: visible" ; + double fates_rad_stem_taunir(fates_pft) ; + fates_rad_stem_taunir:units = "fraction" ; + fates_rad_stem_taunir:long_name = "Stem transmittance: near-IR" ; + double fates_rad_stem_tauvis(fates_pft) ; + fates_rad_stem_tauvis:units = "fraction" ; + fates_rad_stem_tauvis:long_name = "Stem transmittance: visible" ; + double fates_recruit_height_min(fates_pft) ; + fates_recruit_height_min:units = "m" ; + fates_recruit_height_min:long_name = "the minimum height (ie starting height) of a newly recruited plant" ; + double fates_recruit_init_density(fates_pft) ; + fates_recruit_init_density:units = "stems/m2" ; + fates_recruit_init_density:long_name = "initial seedling density for a cold-start near-bare-ground simulation. If negative sets initial tree dbh - only to be used in nocomp mode" ; + double fates_recruit_prescribed_rate(fates_pft) ; + fates_recruit_prescribed_rate:units = "n/yr" ; + fates_recruit_prescribed_rate:long_name = "recruitment rate for prescribed physiology mode" ; + double fates_recruit_seed_alloc(fates_pft) ; + fates_recruit_seed_alloc:units = "fraction" ; + fates_recruit_seed_alloc:long_name = "fraction of available carbon balance allocated to seeds" ; + double fates_recruit_seed_alloc_mature(fates_pft) ; + fates_recruit_seed_alloc_mature:units = "fraction" ; + fates_recruit_seed_alloc_mature:long_name = "fraction of available carbon balance allocated to seeds in mature plants (adds to fates_seed_alloc)" ; + double fates_recruit_seed_dbh_repro_threshold(fates_pft) ; + fates_recruit_seed_dbh_repro_threshold:units = "cm" ; + fates_recruit_seed_dbh_repro_threshold:long_name = "the diameter where the plant will increase allocation to the seed pool by fraction: fates_recruit_seed_alloc_mature" ; + double fates_recruit_seed_germination_rate(fates_pft) ; + fates_recruit_seed_germination_rate:units = "yr-1" ; + fates_recruit_seed_germination_rate:long_name = "fraction of seeds that germinate per year" ; + double fates_recruit_seed_supplement(fates_pft) ; + fates_recruit_seed_supplement:units = "KgC/m2/yr" ; + fates_recruit_seed_supplement:long_name = "Supplemental external seed rain source term (non-mass conserving)" ; + double fates_seed_dispersal_fraction(fates_pft) ; + fates_seed_dispersal_fraction:units = "fraction" ; + fates_seed_dispersal_fraction:long_name = "fraction of seed rain to be dispersed to other grid cells" ; + double fates_seed_dispersal_max_dist(fates_pft) ; + fates_seed_dispersal_max_dist:units = "m" ; + fates_seed_dispersal_max_dist:long_name = "maximum seed dispersal distance for a given pft" ; + double fates_seed_dispersal_pdf_scale(fates_pft) ; + fates_seed_dispersal_pdf_scale:units = "unitless" ; + fates_seed_dispersal_pdf_scale:long_name = "seed dispersal probability density function scale parameter, A, Table 1 Bullock et al 2016" ; + double fates_seed_dispersal_pdf_shape(fates_pft) ; + fates_seed_dispersal_pdf_shape:units = "unitless" ; + fates_seed_dispersal_pdf_shape:long_name = "seed dispersal probability density function shape parameter, B, Table 1 Bullock et al 2016" ; + double fates_stoich_nitr(fates_plant_organs, fates_pft) ; + fates_stoich_nitr:units = "gN/gC" ; + fates_stoich_nitr:long_name = "target nitrogen concentration (ratio with carbon) of organs" ; + double fates_stoich_phos(fates_plant_organs, fates_pft) ; + fates_stoich_phos:units = "gP/gC" ; + fates_stoich_phos:long_name = "target phosphorus concentration (ratio with carbon) of organs" ; + double fates_trim_inc(fates_pft) ; + fates_trim_inc:units = "m2/m2" ; + fates_trim_inc:long_name = "Arbitrary incremental change in trimming function." ; + double fates_trim_limit(fates_pft) ; + fates_trim_limit:units = "m2/m2" ; + fates_trim_limit:long_name = "Arbitrary limit to reductions in leaf area with stress" ; + double fates_trs_repro_alloc_a(fates_pft) ; + fates_trs_repro_alloc_a:units = "fraction" ; + fates_trs_repro_alloc_a:long_name = "shape parameter for sigmoidal function relating dbh to reproductive allocation" ; + double fates_trs_repro_alloc_b(fates_pft) ; + fates_trs_repro_alloc_b:units = "fraction" ; + fates_trs_repro_alloc_b:long_name = "intercept parameter for sigmoidal function relating dbh to reproductive allocation" ; + double fates_trs_repro_frac_seed(fates_pft) ; + fates_trs_repro_frac_seed:units = "fraction" ; + fates_trs_repro_frac_seed:long_name = "fraction of reproductive mass that is seed" ; + double fates_trs_seedling_a_emerg(fates_pft) ; + fates_trs_seedling_a_emerg:units = "day -1" ; + fates_trs_seedling_a_emerg:long_name = "mean fraction of seed bank emerging" ; + double fates_trs_seedling_b_emerg(fates_pft) ; + fates_trs_seedling_b_emerg:units = "day -1" ; + fates_trs_seedling_b_emerg:long_name = "seedling emergence sensitivity to soil moisture" ; + double fates_trs_seedling_background_mort(fates_pft) ; + fates_trs_seedling_background_mort:units = "yr-1" ; + fates_trs_seedling_background_mort:long_name = "background seedling mortality rate" ; + double fates_trs_seedling_h2o_mort_a(fates_pft) ; + fates_trs_seedling_h2o_mort_a:units = "-" ; + fates_trs_seedling_h2o_mort_a:long_name = "coefficient in moisture-based seedling mortality" ; + double fates_trs_seedling_h2o_mort_b(fates_pft) ; + fates_trs_seedling_h2o_mort_b:units = "-" ; + fates_trs_seedling_h2o_mort_b:long_name = "coefficient in moisture-based seedling mortality" ; + double fates_trs_seedling_h2o_mort_c(fates_pft) ; + fates_trs_seedling_h2o_mort_c:units = "-" ; + fates_trs_seedling_h2o_mort_c:long_name = "coefficient in moisture-based seedling mortality" ; + double fates_trs_seedling_light_mort_a(fates_pft) ; + fates_trs_seedling_light_mort_a:units = "-" ; + fates_trs_seedling_light_mort_a:long_name = "light-based seedling mortality coefficient" ; + double fates_trs_seedling_light_mort_b(fates_pft) ; + fates_trs_seedling_light_mort_b:units = "-" ; + fates_trs_seedling_light_mort_b:long_name = "light-based seedling mortality coefficient" ; + double fates_trs_seedling_light_rec_a(fates_pft) ; + fates_trs_seedling_light_rec_a:units = "-" ; + fates_trs_seedling_light_rec_a:long_name = "coefficient in light-based seedling to sapling transition" ; + double fates_trs_seedling_light_rec_b(fates_pft) ; + fates_trs_seedling_light_rec_b:units = "-" ; + fates_trs_seedling_light_rec_b:long_name = "coefficient in light-based seedling to sapling transition" ; + double fates_trs_seedling_mdd_crit(fates_pft) ; + fates_trs_seedling_mdd_crit:units = "mm H2O day" ; + fates_trs_seedling_mdd_crit:long_name = "critical moisture deficit (suction) day accumulation for seedling moisture-based seedling mortality to begin" ; + double fates_trs_seedling_par_crit_germ(fates_pft) ; + fates_trs_seedling_par_crit_germ:units = "MJ m-2 day-1" ; + fates_trs_seedling_par_crit_germ:long_name = "critical light level for germination" ; + double fates_trs_seedling_psi_crit(fates_pft) ; + fates_trs_seedling_psi_crit:units = "mm H2O" ; + fates_trs_seedling_psi_crit:long_name = "critical soil moisture (suction) for seedling stress" ; + double fates_trs_seedling_psi_emerg(fates_pft) ; + fates_trs_seedling_psi_emerg:units = "mm h20 suction" ; + fates_trs_seedling_psi_emerg:long_name = "critical soil moisture for seedling emergence" ; + double fates_trs_seedling_root_depth(fates_pft) ; + fates_trs_seedling_root_depth:units = "m" ; + fates_trs_seedling_root_depth:long_name = "rooting depth of seedlings" ; + double fates_turb_displar(fates_pft) ; + fates_turb_displar:units = "unitless" ; + fates_turb_displar:long_name = "Ratio of displacement height to canopy top height" ; + double fates_turb_leaf_diameter(fates_pft) ; + fates_turb_leaf_diameter:units = "m" ; + fates_turb_leaf_diameter:long_name = "Characteristic leaf dimension" ; + double fates_turb_z0mr(fates_pft) ; + fates_turb_z0mr:units = "unitless" ; + fates_turb_z0mr:long_name = "Ratio of momentum roughness length to canopy top height" ; + double fates_turnover_branch(fates_pft) ; + fates_turnover_branch:units = "yr" ; + fates_turnover_branch:long_name = "turnover time of branches" ; + double fates_turnover_fnrt(fates_pft) ; + fates_turnover_fnrt:units = "yr" ; + fates_turnover_fnrt:long_name = "root longevity (alternatively, turnover time)" ; + double fates_turnover_leaf(fates_leafage_class, fates_pft) ; + fates_turnover_leaf:units = "yr" ; + fates_turnover_leaf:long_name = "Leaf longevity (ie turnover timescale). For drought-deciduous PFTs, this also indicates the maximum length of the growing (i.e., leaves on) season." ; + double fates_turnover_senleaf_fdrought(fates_pft) ; + fates_turnover_senleaf_fdrought:units = "unitless[0-1]" ; + fates_turnover_senleaf_fdrought:long_name = "multiplication factor for leaf longevity of senescent leaves during drought" ; + double fates_wood_density(fates_pft) ; + fates_wood_density:units = "g/cm3" ; + fates_wood_density:long_name = "mean density of woody tissue in plant" ; + double fates_woody(fates_pft) ; + fates_woody:units = "logical flag" ; + fates_woody:long_name = "Binary woody lifeform flag" ; + 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 = "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" ; + double fates_fire_low_moisture_Slope(fates_litterclass) ; + fates_fire_low_moisture_Slope:units = "NA" ; + fates_fire_low_moisture_Slope:long_name = "spitfire parameter, equation B1 Thonicke et al 2010" ; + double fates_fire_mid_moisture(fates_litterclass) ; + fates_fire_mid_moisture:units = "NA" ; + fates_fire_mid_moisture:long_name = "spitfire litter moisture threshold to be considered medium dry" ; + double fates_fire_mid_moisture_Coeff(fates_litterclass) ; + fates_fire_mid_moisture_Coeff:units = "NA" ; + fates_fire_mid_moisture_Coeff:long_name = "spitfire parameter, equation B1 Thonicke et al 2010" ; + double fates_fire_mid_moisture_Slope(fates_litterclass) ; + fates_fire_mid_moisture_Slope:units = "NA" ; + fates_fire_mid_moisture_Slope:long_name = "spitfire parameter, equation B1 Thonicke et al 2010" ; + double fates_fire_min_moisture(fates_litterclass) ; + 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 = "cm-1" ; + fates_fire_SAV:long_name = "fuel surface area to volume ratio" ; + double fates_frag_maxdecomp(fates_litterclass) ; + fates_frag_maxdecomp:units = "yr-1" ; + fates_frag_maxdecomp:long_name = "maximum rate of litter & CWD transfer from non-decomposing class into decomposing class" ; + double fates_frag_cwd_frac(fates_NCWD) ; + fates_frag_cwd_frac:units = "fraction" ; + fates_frag_cwd_frac:long_name = "fraction of woody (bdead+bsw) biomass destined for CWD pool" ; + double fates_maxpatches_by_landuse(fates_landuseclass) ; + fates_maxpatches_by_landuse:units = "count" ; + fates_maxpatches_by_landuse:long_name = "maximum number of patches per site on each land use type" ; + double fates_canopy_closure_thresh ; + fates_canopy_closure_thresh:units = "unitless" ; + fates_canopy_closure_thresh:long_name = "tree canopy coverage at which crown area allometry changes from savanna to forest value" ; + double fates_cnp_eca_plant_escalar ; + fates_cnp_eca_plant_escalar:units = "" ; + fates_cnp_eca_plant_escalar:long_name = "scaling factor for plant fine root biomass to calculate nutrient carrier enzyme abundance (ECA)" ; + double fates_cohort_age_fusion_tol ; + fates_cohort_age_fusion_tol:units = "unitless" ; + fates_cohort_age_fusion_tol:long_name = "minimum fraction in differece in cohort age between cohorts." ; + double fates_cohort_size_fusion_tol ; + fates_cohort_size_fusion_tol:units = "unitless" ; + fates_cohort_size_fusion_tol:long_name = "minimum fraction in difference in dbh between cohorts" ; + double fates_comp_excln ; + fates_comp_excln:units = "none" ; + fates_comp_excln:long_name = "IF POSITIVE: weighting factor (exponent on dbh) for canopy layer exclusion and promotion, IF NEGATIVE: switch to use deterministic height sorting" ; + double fates_damage_canopy_layer_code ; + fates_damage_canopy_layer_code:units = "unitless" ; + fates_damage_canopy_layer_code:long_name = "Integer code that decides whether damage affects canopy trees (1), understory trees (2)" ; + double fates_damage_event_code ; + fates_damage_event_code:units = "unitless" ; + fates_damage_event_code:long_name = "Integer code that options how damage events are structured" ; + double fates_daylength_factor_switch ; + fates_daylength_factor_switch:units = "unitless" ; + fates_daylength_factor_switch:long_name = "user switch for turning on (1) or off (0) the day length factor scaling for photosynthetic parameters (ie scale vcmax and jmax)" ; + 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_fire_active_crown_fire ; + fates_fire_active_crown_fire:units = "0 or 1" ; + fates_fire_active_crown_fire:long_name = "flag, 1=active crown fire 0=no active crown fire" ; + double fates_fire_cg_strikes ; + fates_fire_cg_strikes:units = "fraction (0-1)" ; + fates_fire_cg_strikes:long_name = "fraction of cloud to ground lightning strikes" ; + double fates_fire_drying_ratio ; + fates_fire_drying_ratio:units = "NA" ; + fates_fire_drying_ratio:long_name = "spitfire parameter, fire drying ratio for fuel moisture, alpha_FMC EQ 6 Thonicke et al 2010" ; + double fates_fire_durat_slope ; + fates_fire_durat_slope:units = "NA" ; + fates_fire_durat_slope:long_name = "spitfire parameter, fire max duration slope, Equation 14 Thonicke et al 2010" ; + double fates_fire_fdi_alpha ; + fates_fire_fdi_alpha:units = "NA" ; + fates_fire_fdi_alpha:long_name = "spitfire parameter, EQ 7 Venevsky et al. GCB 2002,(modified EQ 8 Thonicke et al. 2010) " ; + double fates_fire_fuel_energy ; + fates_fire_fuel_energy:units = "kJ/kg" ; + fates_fire_fuel_energy:long_name = "spitfire parameter, heat content of fuel" ; + double fates_fire_max_durat ; + fates_fire_max_durat:units = "minutes" ; + fates_fire_max_durat:long_name = "spitfire parameter, fire maximum duration, Equation 14 Thonicke et al 2010" ; + double fates_fire_miner_damp ; + fates_fire_miner_damp:units = "NA" ; + fates_fire_miner_damp:long_name = "spitfire parameter, mineral-dampening coefficient EQ A1 Thonicke et al 2010 " ; + double fates_fire_miner_total ; + fates_fire_miner_total:units = "fraction" ; + fates_fire_miner_total:long_name = "spitfire parameter, total mineral content, Table A1 Thonicke et al 2010" ; + double fates_fire_nignitions ; + fates_fire_nignitions:units = "ignitions per year per km2" ; + fates_fire_nignitions:long_name = "number of annual ignitions per square km" ; + double fates_fire_part_dens ; + fates_fire_part_dens:units = "kg/m2" ; + fates_fire_part_dens:long_name = "spitfire parameter, oven dry particle density, Table A1 Thonicke et al 2010" ; + double fates_fire_threshold ; + fates_fire_threshold:units = "kW/m" ; + fates_fire_threshold:long_name = "spitfire parameter, fire intensity threshold for tracking fires that spread" ; + double fates_frag_cwd_fcel ; + fates_frag_cwd_fcel:units = "unitless" ; + fates_frag_cwd_fcel:long_name = "Cellulose fraction for CWD" ; + double fates_frag_cwd_flig ; + fates_frag_cwd_flig:units = "unitless" ; + fates_frag_cwd_flig:long_name = "Lignin fraction of coarse woody debris" ; + double fates_hydro_kmax_rsurf1 ; + fates_hydro_kmax_rsurf1:units = "kg water/m2 root area/Mpa/s" ; + fates_hydro_kmax_rsurf1:long_name = "maximum conducitivity for unit root surface (into root)" ; + double fates_hydro_kmax_rsurf2 ; + fates_hydro_kmax_rsurf2:units = "kg water/m2 root area/Mpa/s" ; + fates_hydro_kmax_rsurf2:long_name = "maximum conducitivity for unit root surface (out of root)" ; + double fates_hydro_psi0 ; + fates_hydro_psi0:units = "MPa" ; + fates_hydro_psi0:long_name = "sapwood water potential at saturation" ; + double fates_hydro_psicap ; + fates_hydro_psicap:units = "MPa" ; + fates_hydro_psicap:long_name = "sapwood water potential at which capillary reserves exhausted" ; + double fates_hydro_solver ; + fates_hydro_solver:units = "unitless" ; + fates_hydro_solver:long_name = "switch designating which numerical solver for plant hydraulics, 1 = 1D taylor, 2 = 2D Picard, 3 = 2D Newton (deprecated)" ; + double fates_landuse_logging_coll_under_frac ; + fates_landuse_logging_coll_under_frac:units = "fraction" ; + fates_landuse_logging_coll_under_frac:long_name = "Fraction of stems killed in the understory when logging generates disturbance" ; + double fates_landuse_logging_collateral_frac ; + fates_landuse_logging_collateral_frac:units = "fraction" ; + fates_landuse_logging_collateral_frac:long_name = "Fraction of large stems in upperstory that die from logging collateral damage" ; + double fates_landuse_logging_dbhmax ; + fates_landuse_logging_dbhmax:units = "cm" ; + fates_landuse_logging_dbhmax:long_name = "Maximum dbh below which logging is applied (unset values flag this to be unused)" ; + double fates_landuse_logging_dbhmax_infra ; + fates_landuse_logging_dbhmax_infra:units = "cm" ; + fates_landuse_logging_dbhmax_infra:long_name = "Tree diameter, above which infrastructure from logging does not impact damage or mortality." ; + double fates_landuse_logging_dbhmin ; + fates_landuse_logging_dbhmin:units = "cm" ; + fates_landuse_logging_dbhmin:long_name = "Minimum dbh at which logging is applied" ; + double fates_landuse_logging_direct_frac ; + fates_landuse_logging_direct_frac:units = "fraction" ; + fates_landuse_logging_direct_frac:long_name = "Fraction of stems logged directly per event" ; + double fates_landuse_logging_event_code ; + fates_landuse_logging_event_code:units = "unitless" ; + fates_landuse_logging_event_code:long_name = "Integer code that options how logging events are structured" ; + double fates_landuse_logging_export_frac ; + fates_landuse_logging_export_frac:units = "fraction" ; + fates_landuse_logging_export_frac:long_name = "fraction of trunk product being shipped offsite, the leftovers will be left onsite as large CWD" ; + double fates_landuse_logging_mechanical_frac ; + fates_landuse_logging_mechanical_frac:units = "fraction" ; + fates_landuse_logging_mechanical_frac:long_name = "Fraction of stems killed due infrastructure an other mechanical means" ; + double fates_landuse_pprodharv10_forest_mean ; + fates_landuse_pprodharv10_forest_mean:units = "fraction" ; + fates_landuse_pprodharv10_forest_mean:long_name = "mean harvest mortality proportion of deadstem to 10-yr product (pprodharv10) of all woody PFT types" ; + double fates_leaf_photo_temp_acclim_thome_time ; + fates_leaf_photo_temp_acclim_thome_time:units = "years" ; + fates_leaf_photo_temp_acclim_thome_time:long_name = "Length of the window for the long-term (i.e. T_home in Kumarathunge et al 2019) exponential moving average (ema) of vegetation temperature used in photosynthesis temperature acclimation (used if fates_leaf_photo_tempsens_model = 2)" ; + double fates_leaf_photo_temp_acclim_timescale ; + fates_leaf_photo_temp_acclim_timescale:units = "days" ; + fates_leaf_photo_temp_acclim_timescale:long_name = "Length of the window for the exponential moving average (ema) of vegetation temperature used in photosynthesis temperature acclimation (used if fates_maintresp_leaf_model=2 or fates_leaf_photo_tempsens_model = 2)" ; + double fates_leaf_photo_tempsens_model ; + fates_leaf_photo_tempsens_model:units = "unitless" ; + fates_leaf_photo_tempsens_model:long_name = "switch for choosing the model that defines the temperature sensitivity of photosynthetic parameters (vcmax, jmax). 1=non-acclimating; 2=Kumarathunge et al 2019" ; + double fates_leaf_stomatal_assim_model ; + fates_leaf_stomatal_assim_model:units = "unitless" ; + fates_leaf_stomatal_assim_model:long_name = "a switch designating whether to use net (1) or gross (2) assimilation in the stomatal model" ; + double fates_leaf_stomatal_model ; + fates_leaf_stomatal_model:units = "unitless" ; + fates_leaf_stomatal_model:long_name = "switch for choosing between Ball-Berry (1) stomatal conductance model and Medlyn (2) model" ; + double fates_leaf_theta_cj_c3 ; + fates_leaf_theta_cj_c3:units = "unitless" ; + fates_leaf_theta_cj_c3:long_name = "Empirical curvature parameter for ac, aj photosynthesis co-limitation in c3 plants" ; + double fates_leaf_theta_cj_c4 ; + fates_leaf_theta_cj_c4:units = "unitless" ; + fates_leaf_theta_cj_c4:long_name = "Empirical curvature parameter for ac, aj photosynthesis co-limitation in c4 plants" ; + double fates_maintresp_leaf_model ; + fates_maintresp_leaf_model:units = "unitless" ; + fates_maintresp_leaf_model:long_name = "switch for choosing between maintenance respiration models. 1=Ryan (1991), 2=Atkin et al., (2017)" ; + double fates_maintresp_nonleaf_baserate ; + fates_maintresp_nonleaf_baserate:units = "gC/gN/s" ; + fates_maintresp_nonleaf_baserate:long_name = "Base maintenance respiration rate for plant tissues, using Ryan 1991" ; + double fates_maxcohort ; + fates_maxcohort:units = "count" ; + fates_maxcohort:long_name = "maximum number of cohorts per patch. Actual number of cohorts also depend on cohort fusion tolerances" ; + double fates_mort_cstarvation_model ; + fates_mort_cstarvation_model:units = "unitless" ; + fates_mort_cstarvation_model:long_name = "switch defining the carbon starvation model ( 1) Linear or 2) Exponential) in the mortality_rates function." ; + 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)" ; + double fates_mort_understorey_death ; + fates_mort_understorey_death:units = "fraction" ; + fates_mort_understorey_death:long_name = "fraction of plants in understorey cohort impacted by overstorey tree-fall" ; + double fates_patch_fusion_tol ; + fates_patch_fusion_tol:units = "unitless" ; + fates_patch_fusion_tol:long_name = "minimum fraction in difference in profiles between patches" ; + double fates_phen_chilltemp ; + fates_phen_chilltemp:units = "degrees C" ; + fates_phen_chilltemp:long_name = "chilling day counting threshold for vegetation" ; + double fates_phen_coldtemp ; + fates_phen_coldtemp:units = "degrees C" ; + fates_phen_coldtemp:long_name = "vegetation temperature exceedance that flags a cold-day for leaf-drop" ; + double fates_phen_gddthresh_a ; + fates_phen_gddthresh_a:units = "none" ; + fates_phen_gddthresh_a:long_name = "GDD accumulation function, intercept parameter: gdd_thesh = a + b exp(c*ncd)" ; + double fates_phen_gddthresh_b ; + fates_phen_gddthresh_b:units = "none" ; + fates_phen_gddthresh_b:long_name = "GDD accumulation function, multiplier parameter: gdd_thesh = a + b exp(c*ncd)" ; + double fates_phen_gddthresh_c ; + fates_phen_gddthresh_c:units = "none" ; + fates_phen_gddthresh_c:long_name = "GDD accumulation function, exponent parameter: gdd_thesh = a + b exp(c*ncd)" ; + double fates_phen_mindayson ; + fates_phen_mindayson:units = "days" ; + fates_phen_mindayson:long_name = "day threshold compared against days since leaves became on-allometry" ; + double fates_phen_ncolddayslim ; + fates_phen_ncolddayslim:units = "days" ; + fates_phen_ncolddayslim:long_name = "day threshold exceedance for temperature leaf-drop" ; + double fates_q10_froz ; + fates_q10_froz:units = "unitless" ; + fates_q10_froz:long_name = "Q10 for frozen-soil respiration rates" ; + double fates_q10_mr ; + fates_q10_mr:units = "unitless" ; + fates_q10_mr:long_name = "Q10 for maintenance respiration" ; + double fates_rad_model ; + fates_rad_model:units = "unitless" ; + fates_rad_model:long_name = "switch designating the model for canopy radiation, 1 = Norman, 2 = Two-stream (experimental)" ; + double fates_regeneration_model ; + fates_regeneration_model:units = "-" ; + fates_regeneration_model:long_name = "switch for choosing between FATES\'s: 1) default regeneration scheme , 2) the Tree Recruitment Scheme (Hanbury-Brown et al., 2022), or (3) the Tree Recruitment Scheme without seedling dynamics" ; + 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_trs_seedling2sap_par_timescale ; + fates_trs_seedling2sap_par_timescale:units = "days" ; + fates_trs_seedling2sap_par_timescale:long_name = "Length of the window for the exponential moving average of par at the seedling layer used to calculate seedling to sapling transition rates" ; + double fates_trs_seedling_emerg_h2o_timescale ; + fates_trs_seedling_emerg_h2o_timescale:units = "days" ; + fates_trs_seedling_emerg_h2o_timescale:long_name = "Length of the window for the exponential moving average of smp used to calculate seedling emergence" ; + double fates_trs_seedling_mdd_timescale ; + fates_trs_seedling_mdd_timescale:units = "days" ; + fates_trs_seedling_mdd_timescale:long_name = "Length of the window for the exponential moving average of moisture deficit days used to calculate seedling mortality" ; + double fates_trs_seedling_mort_par_timescale ; + fates_trs_seedling_mort_par_timescale:units = "days" ; + fates_trs_seedling_mort_par_timescale:long_name = "Length of the window for the exponential moving average of par at the seedling layer used to calculate seedling mortality" ; + 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" ; + 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)" ; + +// global attributes: + :history = "This file was generated by BatchPatchParams.py:\nCDL Base File = archive/api24.1.0_101722_fates_params_default.cdl\nXML patch file = archive/api24.1.0_101722_patch_params.xml" ; +data: + + fates_history_ageclass_bin_edges = 0, 1, 2, 5, 10, 20, 50 ; + + fates_history_coageclass_bin_edges = 0, 5 ; + + fates_history_height_bin_edges = 0, 0.1, 0.3, 1, 3, 10 ; + + fates_history_damage_bin_edges = 0, 80 ; + + fates_history_sizeclass_bin_edges = 0, 5, 10, 15, 20, 30, 40, 50, 60, 70, + 80, 90, 100 ; + + fates_alloc_organ_id = 1, 2, 3, 6 ; + + fates_hydro_htftype_node = 1, 1, 1, 1 ; + + fates_pftname = + "broadleaf_evergreen_tropical_tree ", + "needleleaf_evergreen_extratrop_tree ", + "needleleaf_colddecid_extratrop_tree ", + "broadleaf_evergreen_extratrop_tree ", + "broadleaf_hydrodecid_tropical_tree ", + "broadleaf_colddecid_extratrop_tree ", + "broadleaf_evergreen_extratrop_shrub ", + "broadleaf_hydrodecid_extratrop_shrub ", + "broadleaf_colddecid_extratrop_shrub ", + "arctic_c3_grass ", + "cool_c3_grass ", + "c4_grass " ; + + fates_hydro_organ_name = + "leaf ", + "stem ", + "transporting root ", + "absorbing root " ; + + fates_alloc_organ_name = + "leaf", + "fine root", + "sapwood", + "structure" ; + + fates_landuseclass_name = + "primaryland", + "secondaryland", + "rangeland", + "pastureland", + "cropland" ; + + fates_litterclass_name = + "twig ", + "small branch ", + "large branch ", + "trunk ", + "dead leaves ", + "live grass " ; + + fates_alloc_organ_priority = + 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, + 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4 ; + + fates_alloc_storage_cushion = 1.2, 1.2, 1.2, 1.2, 2.4, 1.2, 1.2, 2.4, 1.2, + 1.2, 1.2, 1.2 ; + + fates_alloc_store_priority_frac = 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_allom_agb1 = 0.0673, 0.1364012, 0.0393057, 0.2653695, 0.0673, + 0.0728698, 0.06896, 0.06896, 0.06896, 0.01, 0.01, 0.01 ; + + fates_allom_agb2 = 0.976, 0.9449041, 1.087335, 0.8321321, 0.976, 1.0373211, + 0.572, 0.572, 0.572, 0.572, 0.572, 0.572 ; + + fates_allom_agb3 = 1.94, 1.94, 1.94, 1.94, 1.94, 1.94, 1.94, 1.94, 1.94, + 1.94, 1.94, 1.94 ; + + fates_allom_agb4 = 0.931, 0.931, 0.931, 0.931, 0.931, 0.931, 0.931, 0.931, + 0.931, 0.931, 0.931, 0.931 ; + + fates_allom_agb_frac = 0.6, 0.6, 0.6, 0.6, 0.6, 0.6, 0.6, 0.6, 0.6, 0.6, + 0.6, 0.6 ; + + fates_allom_amode = 3, 3, 3, 3, 3, 3, 1, 1, 1, 1, 1, 1 ; + + fates_allom_blca_expnt_diff = -0.12, -0.34, -0.32, -0.22, -0.12, -0.35, 0, + 0, 0, 0, 0, 0 ; + + fates_allom_cmode = 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1 ; + + fates_allom_d2bl1 = 0.04, 0.07, 0.07, 0.01, 0.04, 0.07, 0.07, 0.07, 0.07, + 0.07, 0.07, 0.07 ; + + fates_allom_d2bl2 = 1.6019679, 1.5234373, 1.3051237, 1.9621397, 1.6019679, + 1.3998939, 1.3, 1.3, 1.3, 1.3, 1.3, 1.3 ; + + fates_allom_d2bl3 = 0.55, 0.55, 0.55, 0.55, 0.55, 0.55, 0.55, 0.55, 0.55, + 0.55, 0.55, 0.55 ; + + fates_allom_d2ca_coefficient_max = 0.2715891, 0.3693718, 1.0787259, + 0.0579297, 0.2715891, 1.1553612, 0.6568464, 0.6568464, 0.6568464, + 0.6568464, 0.6568464, 0.6568464 ; + + fates_allom_d2ca_coefficient_min = 0.2715891, 0.3693718, 1.0787259, + 0.0579297, 0.2715891, 1.1553612, 0.6568464, 0.6568464, 0.6568464, + 0.6568464, 0.6568464, 0.6568464 ; + + fates_allom_d2h1 = 78.4087704, 306.842667, 106.8745821, 104.3586841, + 78.4087704, 31.4557047, 0.64, 0.64, 0.64, 0.64, 0.64, 0.64 ; + + fates_allom_d2h2 = 0.8124383, 0.752377, 0.9471302, 1.1146973, 0.8124383, + 0.9734088, 0.37, 0.37, 0.37, 0.37, 0.37, 0.37 ; + + fates_allom_d2h3 = 47.6666164, 196.6865691, 93.9790461, 160.6835089, + 47.6666164, 16.5928174, -999.9, -999.9, -999.9, -999.9, -999.9, -999.9 ; + + fates_allom_dbh_maxheight = 1000, 1000, 1000, 1000, 1000, 1000, 3, 3, 2, + 0.35, 0.35, 0.35 ; + + fates_allom_dmode = 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1 ; + + fates_allom_fmode = 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1 ; + + fates_allom_fnrt_prof_a = 7, 7, 7, 7, 6, 6, 7, 7, 7, 11, 11, 11 ; + + fates_allom_fnrt_prof_b = 1, 2, 2, 1, 2, 2, 1.5, 1.5, 1.5, 2, 2, 2 ; + + fates_allom_fnrt_prof_mode = 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3 ; + + fates_allom_frbstor_repro = 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 ; + + fates_allom_h2cd1 = 0.5, 0.5, 0.5, 0.5, 0.5, 0.5, 0.95, 0.95, 0.95, 1, 1, 1 ; + + fates_allom_h2cd2 = 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1 ; + + fates_allom_hmode = 5, 5, 5, 5, 5, 5, 1, 1, 1, 1, 1, 1 ; + + fates_allom_l2fr = 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1 ; + + fates_allom_la_per_sa_int = 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_allom_la_per_sa_slp = 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 ; + + fates_allom_lmode = 2, 2, 2, 2, 2, 2, 1, 1, 1, 1, 1, 1 ; + + fates_allom_sai_scaler = 0.1, 0.1, 0.1, 0.1, 0.1, 0.1, 0.1, 0.1, 0.1, 0.1, + 0.1, 0.1 ; + + fates_allom_smode = 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1 ; + + fates_allom_stmode = 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1 ; + + fates_allom_zroot_k = 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10 ; + + fates_allom_zroot_max_dbh = 100, 100, 100, 100, 100, 100, 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_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_zroot_min_z = 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, + 100, 100 ; + + fates_c2b = 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2 ; + + fates_cnp_eca_alpha_ptase = 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 ; + + fates_cnp_eca_decompmicc = 280, 280, 280, 280, 280, 280, 280, 280, 280, 280, + 280, 280 ; + + fates_cnp_eca_km_nh4 = 0.14, 0.14, 0.14, 0.14, 0.14, 0.14, 0.14, 0.14, 0.14, + 0.14, 0.14, 0.14 ; + + fates_cnp_eca_km_no3 = 0.27, 0.27, 0.27, 0.27, 0.27, 0.27, 0.27, 0.27, 0.27, + 0.27, 0.27, 0.27 ; + + fates_cnp_eca_km_p = 0.1, 0.1, 0.1, 0.1, 0.1, 0.1, 0.1, 0.1, 0.1, 0.1, 0.1, + 0.1 ; + + fates_cnp_eca_km_ptase = 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1 ; + + fates_cnp_eca_lambda_ptase = 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 ; + + fates_cnp_eca_vmax_ptase = 5e-09, 5e-09, 5e-09, 5e-09, 5e-09, 5e-09, 5e-09, + 5e-09, 5e-09, 5e-09, 5e-09, 5e-09 ; + + fates_cnp_nfix1 = 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 ; + + fates_cnp_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_cnp_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_cnp_pid_kd = 0.1, 0.1, 0.1, 0.1, 0.1, 0.1, 0.1, 0.1, 0.1, 0.1, 0.1, 0.1 ; + + fates_cnp_pid_ki = 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 ; + + fates_cnp_pid_kp = 0.0005, 0.0005, 0.0005, 0.0005, 0.0005, 0.0005, 0.0005, + 0.0005, 0.0005, 0.0005, 0.0005, 0.0005 ; + + fates_cnp_prescribed_nuptake = 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1 ; + + fates_cnp_prescribed_puptake = 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1 ; + + fates_cnp_store_ovrflw_frac = 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1 ; + + fates_cnp_turnover_nitr_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 ; + + fates_cnp_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 ; + + fates_cnp_vmax_nh4 = 2.5e-09, 2.5e-09, 2.5e-09, 2.5e-09, 2.5e-09, 2.5e-09, + 2.5e-09, 2.5e-09, 2.5e-09, 2.5e-09, 2.5e-09, 2.5e-09 ; + + fates_cnp_vmax_no3 = 2.5e-09, 2.5e-09, 2.5e-09, 2.5e-09, 2.5e-09, 2.5e-09, + 2.5e-09, 2.5e-09, 2.5e-09, 2.5e-09, 2.5e-09, 2.5e-09 ; + + fates_cnp_vmax_p = 5e-10, 5e-10, 5e-10, 5e-10, 5e-10, 5e-10, 5e-10, 5e-10, + 5e-10, 5e-10, 5e-10, 5e-10 ; + + fates_damage_frac = 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_damage_mort_p1 = 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9 ; + + fates_damage_mort_p2 = 5.5, 5.5, 5.5, 5.5, 5.5, 5.5, 5.5, 5.5, 5.5, 5.5, + 5.5, 5.5 ; + + fates_damage_recovery_scalar = 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 ; + + fates_dev_arbitrary_pft = _, _, _, _, _, _, _, _, _, _, _, _ ; + + fates_fire_alpha_SH = 0.2, 0.2, 0.2, 0.2, 0.2, 0.2, 0.2, 0.2, 0.2, 0.2, 0.2, + 0.2 ; + + fates_fire_bark_scaler = 0.07, 0.07, 0.07, 0.07, 0.07, 0.07, 0.07, 0.07, + 0.07, 0.07, 0.07, 0.07 ; + + fates_fire_crown_kill = 0.775, 0.775, 0.775, 0.775, 0.775, 0.775, 0.775, + 0.775, 0.775, 0.775, 0.775, 0.775 ; + + fates_frag_fnrt_fcel = 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_frag_fnrt_flab = 0.25, 0.25, 0.25, 0.25, 0.25, 0.25, 0.25, 0.25, 0.25, + 0.25, 0.25, 0.25 ; + + fates_frag_fnrt_flig = 0.25, 0.25, 0.25, 0.25, 0.25, 0.25, 0.25, 0.25, 0.25, + 0.25, 0.25, 0.25 ; + + fates_frag_leaf_fcel = 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_frag_leaf_flab = 0.25, 0.25, 0.25, 0.25, 0.25, 0.25, 0.25, 0.25, 0.25, + 0.25, 0.25, 0.25 ; + + fates_frag_leaf_flig = 0.25, 0.25, 0.25, 0.25, 0.25, 0.25, 0.25, 0.25, 0.25, + 0.25, 0.25, 0.25 ; + + fates_frag_seed_decay_rate = 0.51, 0.51, 0.51, 0.51, 0.51, 0.51, 0.51, 0.51, + 0.51, 0.51, 0.51, 0.51 ; + + fates_grperc = 0.11, 0.11, 0.11, 0.11, 0.11, 0.11, 0.11, 0.11, 0.11, 0.11, + 0.11, 0.11 ; + + fates_hydro_avuln_gs = 2.5, 2.5, 2.5, 2.5, 2.5, 2.5, 2.5, 2.5, 2.5, 2.5, + 2.5, 2.5 ; + + fates_hydro_avuln_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_hydro_epsil_node = + 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, + 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, + 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, + 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8 ; + + fates_hydro_fcap_node = + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 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.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_hydro_k_lwp = 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 ; + + fates_hydro_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, + -999, -999, -999, -999, -999, -999, -999, -999, -999, -999, -999, -999, + -999, -999, -999, -999, -999, -999, -999, -999, -999, -999, -999, -999 ; + + fates_hydro_p50_gs = -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_hydro_p50_node = + -2.25, -2.25, -2.25, -2.25, -2.25, -2.25, -2.25, -2.25, -2.25, -2.25, + -2.25, -2.25, + -2.25, -2.25, -2.25, -2.25, -2.25, -2.25, -2.25, -2.25, -2.25, -2.25, + -2.25, -2.25, + -2.25, -2.25, -2.25, -2.25, -2.25, -2.25, -2.25, -2.25, -2.25, -2.25, + -2.25, -2.25, + -2.25, -2.25, -2.25, -2.25, -2.25, -2.25, -2.25, -2.25, -2.25, -2.25, + -2.25, -2.25 ; + + fates_hydro_p_taper = 0.333, 0.333, 0.333, 0.333, 0.333, 0.333, 0.333, + 0.333, 0.333, 0.333, 0.333, 0.333 ; + + fates_hydro_pinot_node = + -1.465984, -1.465984, -1.465984, -1.465984, -1.465984, -1.465984, + -1.465984, -1.465984, -1.465984, -1.465984, -1.465984, -1.465984, + -1.22807, -1.22807, -1.22807, -1.22807, -1.22807, -1.22807, -1.22807, + -1.22807, -1.22807, -1.22807, -1.22807, -1.22807, + -1.22807, -1.22807, -1.22807, -1.22807, -1.22807, -1.22807, -1.22807, + -1.22807, -1.22807, -1.22807, -1.22807, -1.22807, + -1.043478, -1.043478, -1.043478, -1.043478, -1.043478, -1.043478, + -1.043478, -1.043478, -1.043478, -1.043478, -1.043478, -1.043478 ; + + fates_hydro_pitlp_node = + -1.67, -1.67, -1.67, -1.67, -1.67, -1.67, -1.67, -1.67, -1.67, -1.67, + -1.67, -1.67, + -1.4, -1.4, -1.4, -1.4, -1.4, -1.4, -1.4, -1.4, -1.4, -1.4, -1.4, -1.4, + -1.4, -1.4, -1.4, -1.4, -1.4, -1.4, -1.4, -1.4, -1.4, -1.4, -1.4, -1.4, + -1.2, -1.2, -1.2, -1.2, -1.2, -1.2, -1.2, -1.2, -1.2, -1.2, -1.2, -1.2 ; + + fates_hydro_resid_node = + 0.16, 0.16, 0.16, 0.16, 0.16, 0.16, 0.16, 0.16, 0.16, 0.16, 0.16, 0.16, + 0.21, 0.21, 0.21, 0.21, 0.21, 0.21, 0.21, 0.21, 0.21, 0.21, 0.21, 0.21, + 0.21, 0.21, 0.21, 0.21, 0.21, 0.21, 0.21, 0.21, 0.21, 0.21, 0.21, 0.21, + 0.11, 0.11, 0.11, 0.11, 0.11, 0.11, 0.11, 0.11, 0.11, 0.11, 0.11, 0.11 ; + + fates_hydro_rfrac_stem = 0.625, 0.625, 0.625, 0.625, 0.625, 0.625, 0.625, + 0.625, 0.625, 0.625, 0.625, 0.625 ; + + fates_hydro_rs2 = 0.0001, 0.0001, 0.0001, 0.0001, 0.0001, 0.0001, 0.0001, + 0.0001, 0.0001, 0.0001, 0.0001, 0.0001 ; + + fates_hydro_srl = 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25 ; + + fates_hydro_thetas_node = + 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.65, 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.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_hydro_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_hydro_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_hydro_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_jmaxha = 43540, 43540, 43540, 43540, 43540, 43540, 43540, 43540, + 43540, 43540, 43540, 43540 ; + + fates_leaf_jmaxhd = 152040, 152040, 152040, 152040, 152040, 152040, 152040, + 152040, 152040, 152040, 152040, 152040 ; + + fates_leaf_jmaxse = 495, 495, 495, 495, 495, 495, 495, 495, 495, 495, 495, + 495 ; + + fates_leaf_slamax = 0.0954, 0.0954, 0.0954, 0.0954, 0.0954, 0.0954, 0.012, + 0.03, 0.03, 0.03, 0.03, 0.03 ; + + fates_leaf_slatop = 0.012, 0.005, 0.024, 0.009, 0.03, 0.03, 0.012, 0.03, + 0.03, 0.03, 0.03, 0.03 ; + + fates_leaf_stomatal_intercept = 10000, 10000, 10000, 10000, 10000, 10000, + 10000, 10000, 10000, 10000, 10000, 40000 ; + + fates_leaf_stomatal_slope_ballberry = 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8 ; + + fates_leaf_stomatal_slope_medlyn = 4.1, 2.3, 2.3, 4.1, 4.4, 4.4, 4.7, 4.7, + 4.7, 2.2, 5.3, 1.6 ; + + fates_leaf_vcmax25top = + 50, 62, 39, 61, 58, 58, 62, 54, 54, 78, 78, 78 ; + + fates_leaf_vcmaxha = 65330, 65330, 65330, 65330, 65330, 65330, 65330, 65330, + 65330, 65330, 65330, 65330 ; + + fates_leaf_vcmaxhd = 149250, 149250, 149250, 149250, 149250, 149250, 149250, + 149250, 149250, 149250, 149250, 149250 ; + + fates_leaf_vcmaxse = 485, 485, 485, 485, 485, 485, 485, 485, 485, 485, 485, + 485 ; + + fates_leafn_vert_scaler_coeff1 = 0.00963, 0.00963, 0.00963, 0.00963, + 0.00963, 0.00963, 0.00963, 0.00963, 0.00963, 0.00963, 0.00963, 0.00963 ; + + fates_leafn_vert_scaler_coeff2 = 2.43, 2.43, 2.43, 2.43, 2.43, 2.43, 2.43, + 2.43, 2.43, 2.43, 2.43, 2.43 ; + + fates_maintresp_leaf_atkin2017_baserate = 1.756, 1.4995, 1.4995, 1.756, + 1.756, 1.756, 2.0749, 2.0749, 2.0749, 2.1956, 2.1956, 2.1956 ; + + fates_maintresp_leaf_ryan1991_baserate = 2.525e-06, 2.525e-06, 2.525e-06, + 2.525e-06, 2.525e-06, 2.525e-06, 2.525e-06, 2.525e-06, 2.525e-06, + 2.525e-06, 2.525e-06, 2.525e-06 ; + + fates_maintresp_leaf_vert_scaler_coeff1 = 0.00963, 0.00963, 0.00963, + 0.00963, 0.00963, 0.00963, 0.00963, 0.00963, 0.00963, 0.00963, 0.00963, + 0.00963 ; + + fates_maintresp_leaf_vert_scaler_coeff2 = 2.43, 2.43, 2.43, 2.43, 2.43, + 2.43, 2.43, 2.43, 2.43, 2.43, 2.43, 2.43 ; + + 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, 1, 1, 1 ; + + fates_maintresp_reduction_upthresh = 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 ; + + fates_mort_freezetol = 2.5, -55, -80, -30, 2.5, -80, -60, -10, -80, -80, + -20, 2.5 ; + + fates_mort_hf_flc_threshold = 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_mort_hf_sm_threshold = 1e-06, 1e-06, 1e-06, 1e-06, 1e-06, 1e-06, + 1e-06, 1e-06, 1e-06, 1e-06, 1e-06, 1e-06 ; + + fates_mort_ip_age_senescence = _, _, _, _, _, _, _, _, _, _, _, _ ; + + fates_mort_ip_size_senescence = _, _, _, _, _, _, _, _, _, _, _, _ ; + + fates_mort_prescribed_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 ; + + fates_mort_prescribed_understory = 0.025, 0.025, 0.025, 0.025, 0.025, 0.025, + 0.025, 0.025, 0.025, 0.025, 0.025, 0.025 ; + + fates_mort_r_age_senescence = _, _, _, _, _, _, _, _, _, _, _, _ ; + + fates_mort_r_size_senescence = _, _, _, _, _, _, _, _, _, _, _, _ ; + + fates_mort_scalar_coldstress = 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3 ; + + fates_mort_scalar_cstarvation = 0.6, 0.6, 0.6, 0.6, 0.6, 0.6, 0.6, 0.6, 0.6, + 0.6, 0.6, 0.6 ; + + fates_mort_scalar_hydrfailure = 0.6, 0.6, 0.6, 0.6, 0.6, 0.6, 0.6, 0.6, 0.6, + 0.6, 0.6, 0.6 ; + + fates_mort_upthresh_cstarvation = 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1 ; + + fates_nonhydro_smpsc = -255000, -255000, -255000, -255000, -255000, -255000, + -255000, -255000, -255000, -255000, -255000, -255000 ; + + fates_nonhydro_smpso = -66000, -66000, -66000, -66000, -66000, -66000, + -66000, -66000, -66000, -66000, -66000, -66000 ; + + fates_phen_cold_size_threshold = 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 ; + + fates_phen_drought_threshold = -152957.4, -152957.4, -152957.4, -152957.4, + -152957.4, -152957.4, -152957.4, -152957.4, -152957.4, -152957.4, + -152957.4, -152957.4 ; + + fates_phen_evergreen = 1, 1, 0, 1, 0, 0, 1, 0, 0, 0, 0, 0 ; + + fates_phen_flush_fraction = _, _, 0.5, _, 0.5, 0.5, _, 0.5, 0.5, 0.5, 0.5, + 0.5 ; + + fates_phen_fnrt_drop_fraction = 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 ; + + fates_phen_mindaysoff = 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, + 100, 100 ; + + fates_phen_moist_threshold = -122365.9, -122365.9, -122365.9, -122365.9, + -122365.9, -122365.9, -122365.9, -122365.9, -122365.9, -122365.9, + -122365.9, -122365.9 ; + + fates_phen_season_decid = 0, 0, 1, 0, 0, 1, 0, 0, 1, 1, 0, 0 ; + + fates_phen_stem_drop_fraction = 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 ; + + fates_phen_stress_decid = 0, 0, 0, 0, 1, 0, 0, 1, 0, 0, 1, 1 ; + + fates_prescribed_npp_canopy = 0.4, 0.4, 0.4, 0.4, 0.4, 0.4, 0.4, 0.4, 0.4, + 0.4, 0.4, 0.4 ; + + 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_rad_leaf_clumping_index = 0.85, 0.85, 0.8, 0.85, 0.85, 0.9, 0.85, 0.9, + 0.9, 0.75, 0.75, 0.75 ; + + fates_rad_leaf_rhonir = 0.46, 0.41, 0.39, 0.46, 0.41, 0.41, 0.46, 0.41, + 0.41, 0.28, 0.28, 0.28 ; + + fates_rad_leaf_rhovis = 0.11, 0.09, 0.08, 0.11, 0.08, 0.08, 0.11, 0.08, + 0.08, 0.05, 0.05, 0.05 ; + + fates_rad_leaf_taunir = 0.33, 0.32, 0.42, 0.33, 0.43, 0.43, 0.33, 0.43, + 0.43, 0.4, 0.4, 0.4 ; + + fates_rad_leaf_tauvis = 0.06, 0.04, 0.06, 0.06, 0.06, 0.06, 0.06, 0.06, + 0.06, 0.05, 0.05, 0.05 ; + + fates_rad_leaf_xl = 0.32, 0.01, 0.01, 0.32, 0.2, 0.59, 0.32, 0.59, 0.59, + -0.23, -0.23, -0.23 ; + + fates_rad_stem_rhonir = 0.49, 0.36, 0.36, 0.49, 0.49, 0.49, 0.49, 0.49, + 0.49, 0.53, 0.53, 0.53 ; + + fates_rad_stem_rhovis = 0.21, 0.12, 0.12, 0.21, 0.21, 0.21, 0.21, 0.21, + 0.21, 0.31, 0.31, 0.31 ; + + fates_rad_stem_taunir = 0.001, 0.001, 0.001, 0.001, 0.001, 0.001, 0.001, + 0.001, 0.001, 0.25, 0.25, 0.25 ; + + fates_rad_stem_tauvis = 0.001, 0.001, 0.001, 0.001, 0.001, 0.001, 0.001, + 0.001, 0.001, 0.12, 0.12, 0.12 ; + + fates_recruit_height_min = 1.3, 1.3, 1.3, 1.3, 1.3, 1.3, 0.2, 0.2, 0.2, + 0.125, 0.125, 0.125 ; + + fates_recruit_init_density = 0.2, 0.2, 0.2, 0.2, 0.2, 0.2, 0.2, 0.2, 0.2, + 0.2, 0.2, 0.2 ; + + fates_recruit_prescribed_rate = 0.02, 0.02, 0.02, 0.02, 0.02, 0.02, 0.02, + 0.02, 0.02, 0.02, 0.02, 0.02 ; + + fates_recruit_seed_alloc = 0.1, 0.1, 0.1, 0.1, 0.1, 0.1, 0.1, 0.1, 0.1, 0.1, + 0.1, 0.1 ; + + fates_recruit_seed_alloc_mature = 0, 0, 0, 0, 0, 0, 0.9, 0.9, 0.9, 0.9, 0.9, + 0.9 ; + + fates_recruit_seed_dbh_repro_threshold = 90, 80, 80, 80, 90, 80, 3, 3, 2, + 0.35, 0.35, 0.35 ; + + fates_recruit_seed_germination_rate = 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_recruit_seed_supplement = 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 ; + + fates_seed_dispersal_fraction = _, _, _, _, _, _, _, _, _, _, _, _ ; + + fates_seed_dispersal_max_dist = _, _, _, _, _, _, _, _, _, _, _, _ ; + + fates_seed_dispersal_pdf_scale = _, _, _, _, _, _, _, _, _, _, _, _ ; + + fates_seed_dispersal_pdf_shape = _, _, _, _, _, _, _, _, _, _, _, _ ; + + fates_stoich_nitr = + 0.033, 0.029, 0.04, 0.033, 0.04, 0.04, 0.033, 0.04, 0.04, 0.04, 0.04, 0.04, + 0.024, 0.024, 0.024, 0.024, 0.024, 0.024, 0.024, 0.024, 0.024, 0.024, + 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, + 0.0047, 0.0047, 0.0047, 0.0047, 0.0047, 0.0047, 0.0047, 0.0047, 0.0047, + 0.0047, 0.0047, 0.0047 ; + + fates_stoich_phos = + 0.0033, 0.0029, 0.004, 0.0033, 0.004, 0.004, 0.0033, 0.004, 0.004, 0.004, + 0.004, 0.004, + 0.0024, 0.0024, 0.0024, 0.0024, 0.0024, 0.0024, 0.0024, 0.0024, 0.0024, + 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, + 0.00047, 0.00047, 0.00047, 0.00047, 0.00047, 0.00047, 0.00047, 0.00047, + 0.00047, 0.00047, 0.00047, 0.00047 ; + + fates_trim_inc = 0.03, 0.03, 0.03, 0.03, 0.03, 0.03, 0.03, 0.03, 0.03, 0.03, + 0.03, 0.03 ; + + 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_trs_repro_alloc_a = 0.0049, 0.0049, 0.0049, 0.0049, 0.0049, 0.0049, + 0.0049, 0.0049, 0.0049, 0.0049, 0.0049, 0.0049 ; + + fates_trs_repro_alloc_b = -2.6171, -2.6171, -2.6171, -2.6171, -2.6171, + -2.6171, -2.6171, -2.6171, -2.6171, -2.6171, -2.6171, -2.6171 ; + + fates_trs_repro_frac_seed = 0.24, 0.24, 0.24, 0.24, 0.24, 0.24, 0.24, 0.24, + 0.24, 0.24, 0.24, 0.24 ; + + fates_trs_seedling_a_emerg = 0.0003, 0.0003, 0.0003, 0.0003, 0.0003, 0.0003, + 0.0003, 0.0003, 0.0003, 0.0003, 0.0003, 0.0003 ; + + fates_trs_seedling_b_emerg = 1.2, 1.2, 1.2, 1.2, 1.2, 1.2, 1.2, 1.2, 1.2, + 1.2, 1.2, 1.2 ; + + fates_trs_seedling_background_mort = 0.1085371, 0.1085371, 0.1085371, + 0.1085371, 0.1085371, 0.1085371, 0.1085371, 0.1085371, 0.1085371, + 0.1085371, 0.1085371, 0.1085371 ; + + fates_trs_seedling_h2o_mort_a = 4.070565e-17, 4.070565e-17, 4.070565e-17, + 4.070565e-17, 4.070565e-17, 4.070565e-17, 4.070565e-17, 4.070565e-17, + 4.070565e-17, 4.070565e-17, 4.070565e-17, 4.070565e-17 ; + + fates_trs_seedling_h2o_mort_b = -6.390757e-11, -6.390757e-11, -6.390757e-11, + -6.390757e-11, -6.390757e-11, -6.390757e-11, -6.390757e-11, + -6.390757e-11, -6.390757e-11, -6.390757e-11, -6.390757e-11, -6.390757e-11 ; + + fates_trs_seedling_h2o_mort_c = 1.268992e-05, 1.268992e-05, 1.268992e-05, + 1.268992e-05, 1.268992e-05, 1.268992e-05, 1.268992e-05, 1.268992e-05, + 1.268992e-05, 1.268992e-05, 1.268992e-05, 1.268992e-05 ; + + fates_trs_seedling_light_mort_a = -0.009897694, -0.009897694, -0.009897694, + -0.009897694, -0.009897694, -0.009897694, -0.009897694, -0.009897694, + -0.009897694, -0.009897694, -0.009897694, -0.009897694 ; + + fates_trs_seedling_light_mort_b = -7.154063, -7.154063, -7.154063, + -7.154063, -7.154063, -7.154063, -7.154063, -7.154063, -7.154063, + -7.154063, -7.154063, -7.154063 ; + + fates_trs_seedling_light_rec_a = 0.007, 0.007, 0.007, 0.007, 0.007, 0.007, + 0.007, 0.007, 0.007, 0.007, 0.007, 0.007 ; + + fates_trs_seedling_light_rec_b = 0.8615, 0.8615, 0.8615, 0.8615, 0.8615, + 0.8615, 0.8615, 0.8615, 0.8615, 0.8615, 0.8615, 0.8615 ; + + fates_trs_seedling_mdd_crit = 1400000, 1400000, 1400000, 1400000, 1400000, + 1400000, 1400000, 1400000, 1400000, 1400000, 1400000, 1400000 ; + + fates_trs_seedling_par_crit_germ = 0.656, 0.656, 0.656, 0.656, 0.656, 0.656, + 0.656, 0.656, 0.656, 0.656, 0.656, 0.656 ; + + fates_trs_seedling_psi_crit = -251995.7, -251995.7, -251995.7, -251995.7, + -251995.7, -251995.7, -251995.7, -251995.7, -251995.7, -251995.7, + -251995.7, -251995.7 ; + + fates_trs_seedling_psi_emerg = -15744.65, -15744.65, -15744.65, -15744.65, + -15744.65, -15744.65, -15744.65, -15744.65, -15744.65, -15744.65, + -15744.65, -15744.65 ; + + fates_trs_seedling_root_depth = 0.06, 0.06, 0.06, 0.06, 0.06, 0.06, 0.06, + 0.06, 0.06, 0.06, 0.06, 0.06 ; + + fates_turb_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 ; + + fates_turb_leaf_diameter = 0.04, 0.04, 0.04, 0.04, 0.04, 0.04, 0.04, 0.04, + 0.04, 0.04, 0.04, 0.04 ; + + fates_turb_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_turnover_branch = 150, 150, 150, 150, 150, 150, 150, 150, 150, 0, 0, 0 ; + + fates_turnover_fnrt = 1, 2, 1, 1.5, 1, 1, 1.5, 1, 1, 1, 1, 1 ; + + fates_turnover_leaf = + 1.5, 4, 1, 1.5, 1, 1, 1.5, 1, 1, 1, 1, 1 ; + + fates_turnover_senleaf_fdrought = 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1 ; + + fates_wood_density = 0.548327, 0.44235, 0.454845, 0.754336, 0.548327, + 0.566452, 0.7, 0.7, 0.7, 0.7, 0.7, 0.7 ; + + fates_woody = 1, 1, 1, 1, 1, 1, 1, 1, 1, 0, 0, 0 ; + + 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 ; + + fates_fire_low_moisture_Slope = 0.62, 0.72, 0.85, 0.8, 0.62, 0.62 ; + + fates_fire_mid_moisture = 0.72, 0.51, 0.38, 1, 0.8, 0.8 ; + + fates_fire_mid_moisture_Coeff = 2.35, 1.47, 1.06, 0.8, 3.2, 3.2 ; + + fates_fire_mid_moisture_Slope = 2.35, 1.47, 1.06, 0.8, 3.2, 3.2 ; + + fates_fire_min_moisture = 0.18, 0.12, 0, 0, 0.24, 0.24 ; + + fates_fire_SAV = 13, 3.58, 0.98, 0.2, 66, 66 ; + + fates_frag_maxdecomp = 0.52, 0.383, 0.383, 0.19, 1, 999 ; + + fates_frag_cwd_frac = 0.045, 0.075, 0.21, 0.67 ; + + fates_maxpatches_by_landuse = 9, 4, 1, 1, 1 ; + + fates_canopy_closure_thresh = 0.8 ; + + fates_cnp_eca_plant_escalar = 1.25e-05 ; + + fates_cohort_age_fusion_tol = 0.08 ; + + fates_cohort_size_fusion_tol = 0.08 ; + + fates_comp_excln = 3 ; + + fates_damage_canopy_layer_code = 1 ; + + fates_damage_event_code = 1 ; + + fates_daylength_factor_switch = 1 ; + + fates_dev_arbitrary = _ ; + + fates_fire_active_crown_fire = 0 ; + + fates_fire_cg_strikes = 0.2 ; + + fates_fire_drying_ratio = 66000 ; + + fates_fire_durat_slope = -11.06 ; + + fates_fire_fdi_alpha = 0.00037 ; + + fates_fire_fuel_energy = 18000 ; + + fates_fire_max_durat = 240 ; + + fates_fire_miner_damp = 0.41739 ; + + fates_fire_miner_total = 0.055 ; + + fates_fire_nignitions = 15 ; + + fates_fire_part_dens = 513 ; + + fates_fire_threshold = 50 ; + + fates_frag_cwd_fcel = 0.76 ; + + fates_frag_cwd_flig = 0.24 ; + + fates_hydro_kmax_rsurf1 = 20 ; + + fates_hydro_kmax_rsurf2 = 0.0001 ; + + fates_hydro_psi0 = 0 ; + + fates_hydro_psicap = -0.6 ; + + fates_hydro_solver = 1 ; + + fates_landuse_logging_coll_under_frac = 0.55983 ; + + fates_landuse_logging_collateral_frac = 0.05 ; + + fates_landuse_logging_dbhmax = _ ; + + fates_landuse_logging_dbhmax_infra = 35 ; + + fates_landuse_logging_dbhmin = 50 ; + + fates_landuse_logging_direct_frac = 0.15 ; + + fates_landuse_logging_event_code = -30 ; + + fates_landuse_logging_export_frac = 0.8 ; + + fates_landuse_logging_mechanical_frac = 0.05 ; + + fates_landuse_pprodharv10_forest_mean = 0.8125 ; + + fates_leaf_photo_temp_acclim_thome_time = 30 ; + + fates_leaf_photo_temp_acclim_timescale = 30 ; + + fates_leaf_photo_tempsens_model = 1 ; + + fates_leaf_stomatal_assim_model = 1 ; + + fates_leaf_stomatal_model = 1 ; + + fates_leaf_theta_cj_c3 = 0.999 ; + + fates_leaf_theta_cj_c4 = 0.999 ; + + fates_maintresp_leaf_model = 1 ; + + fates_maintresp_nonleaf_baserate = 2.525e-06 ; + + fates_maxcohort = 100 ; + + fates_mort_cstarvation_model = 1 ; + + fates_mort_disturb_frac = 1 ; + + fates_mort_understorey_death = 0.55983 ; + + fates_patch_fusion_tol = 0.05 ; + + fates_phen_chilltemp = 5 ; + + fates_phen_coldtemp = 7.5 ; + + fates_phen_gddthresh_a = -68 ; + + fates_phen_gddthresh_b = 638 ; + + fates_phen_gddthresh_c = -0.01 ; + + fates_phen_mindayson = 90 ; + + fates_phen_ncolddayslim = 5 ; + + fates_q10_froz = 1.5 ; + + fates_q10_mr = 1.5 ; + + fates_rad_model = 1 ; + + fates_regeneration_model = 1 ; + + fates_soil_salinity = 0.4 ; + + fates_trs_seedling2sap_par_timescale = 32 ; + + fates_trs_seedling_emerg_h2o_timescale = 7 ; + + fates_trs_seedling_mdd_timescale = 126 ; + + fates_trs_seedling_mort_par_timescale = 32 ; + + fates_vai_top_bin_width = 1 ; + + fates_vai_width_increase_factor = 1 ; +} diff --git a/parameter_files/archive/api36.0.0_051724_patch_params.xml b/parameter_files/archive/api36.0.0_051724_patch_params.xml index 938bd4bd78..3af518bde2 100644 --- a/parameter_files/archive/api36.0.0_051724_patch_params.xml +++ b/parameter_files/archive/api36.0.0_051724_patch_params.xml @@ -52,14 +52,14 @@ fates_landuse_crop_lu_pft_vector - fates_landuse_class + fates_landuseclass NA the FATES PFT index to use on a given crop land-use type (dummy value of -999 for non-crop types) - 999, -999, -999, -999, 11 + -999, -999, -999, -999, 11 fates_max_nocomp_pfts_by_landuse - fates_landuse_class + fates_landuseclass count maximum number of nocomp PFTs on each land use type (only used in nocomp mode) 4, 4, 1, 1, 1 @@ -67,30 +67,5 @@ fates_landuse_pprodharv10_forest_mean - - - - fates_landuse_harvest_pprod10:units = "fraction" ; - fates_landuse_harvest_pprod10:long_name = "fraction of harvest wood product that goes to 10-year product pool (remainder goes to 100-year pool)" ; - double fates_landuse_luc_frac_burned(fates_pft) ; - fates_landuse_luc_frac_burned:units = "fraction" ; - fates_landuse_luc_frac_burned:long_name = "fraction of land use change-generated and not-exported material that is burned (the remainder goes to litter)" ; - - double fates_landuse_luc_frac_exported(fates_pft) ; - fates_landuse_luc_frac_exported:units = "fraction" ; - fates_landuse_luc_frac_exported:long_name = "fraction of land use change-generated wood material that is exported to wood product (the remainder is either burned or goes to litter)" ; - - double fates_landuse_luc_pprod10(fates_pft) ; - fates_landuse_luc_pprod10:units = "fraction" ; - fates_landuse_luc_pprod10:long_name = "fraction of land use change wood product that goes to 10-year product pool (remainder goes to 100-year pool)" ; - -double fates_landuse_crop_lu_pft_vector(fates_landuseclass) ; - fates_landuse_crop_lu_pft_vector:units = "NA" ; - fates_landuse_crop_lu_pft_vector:long_name = "What FATES PFT index to use on a given crop land-use type? (dummy value of -999 for non-crop types)" ; - double fates_max_nocomp_pfts_by_landuse(fates_landuseclass) ; - fates_max_nocomp_pfts_by_landuse:units = "count" ; - fates_max_nocomp_pfts_by_landuse:long_name = "maximum number of nocomp PFTs on each land use type (only used in nocomp mode)" ; - - diff --git a/parameter_files/fates_params_default.cdl b/parameter_files/fates_params_default.cdl index 19f4234436..b66336bbf2 100644 --- a/parameter_files/fates_params_default.cdl +++ b/parameter_files/fates_params_default.cdl @@ -704,7 +704,7 @@ variables: fates_frag_cwd_frac:long_name = "fraction of woody (bdead+bsw) biomass destined for CWD pool" ; double fates_landuse_crop_lu_pft_vector(fates_landuseclass) ; fates_landuse_crop_lu_pft_vector:units = "NA" ; - fates_landuse_crop_lu_pft_vector:long_name = "What FATES PFT index to use on a given crop land-use type? (dummy value of -999 for non-crop types)" ; + fates_landuse_crop_lu_pft_vector:long_name = "the FATES PFT index to use on a given crop land-use type (dummy value of -999 for non-crop types)" ; double fates_max_nocomp_pfts_by_landuse(fates_landuseclass) ; fates_max_nocomp_pfts_by_landuse:units = "count" ; fates_max_nocomp_pfts_by_landuse:long_name = "maximum number of nocomp PFTs on each land use type (only used in nocomp mode)" ; @@ -920,9 +920,7 @@ variables: fates_vai_width_increase_factor:long_name = "factor by which each leaf+stem scattering element increases in VAI width (1 = uniform spacing)" ; // global attributes: - :history = "This file was generated by BatchPatchParams.py:\n", - "CDL Base File = archive/api24.1.0_101722_fates_params_default.cdl\n", - "XML patch file = archive/api24.1.0_101722_patch_params.xml" ; + :history = "This file was generated by BatchPatchParams.py:\nCDL Base File = archive/api24.1.0_101722_fates_params_default.cdl\nXML patch file = archive/api24.1.0_101722_patch_params.xml" ; data: fates_history_ageclass_bin_edges = 0, 1, 2, 5, 10, 20, 50 ; From 37f02457bb2f52609eb0923510103f696d5a964a Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Mon, 20 May 2024 12:31:02 -0600 Subject: [PATCH 092/112] fixed logic on when to initialize patches when not in nocomp-fixedbio --- main/EDInitMod.F90 | 17 ++++++++++++++--- 1 file changed, 14 insertions(+), 3 deletions(-) diff --git a/main/EDInitMod.F90 b/main/EDInitMod.F90 index efef68aae4..49099b7ddf 100644 --- a/main/EDInitMod.F90 +++ b/main/EDInitMod.F90 @@ -795,7 +795,16 @@ subroutine init_patches( nsites, sites, bc_in) end_landuse_idx = 1 endif - not_all_bareground_if: if ((1._r8 - sites(s)%area_bareground) .gt. nearzero) then + + ! not_all_bareground_if: if ((1._r8 - sites(s)%area_bareground) .gt. nearzero) then + + ! Next, create the non-bareground patches. We do this for either of two scenarios: + ! If 1) we are not doing both nocomp & fixed-biogeo + ! 2) we are, but there is some non-zero bare-ground area + + not_all_bare_if: if( ((1._r8 - sites(s)%area_bareground) > nearzero) .or. & + (.not.(hlm_use_nocomp.eq.itrue .and. hlm_use_fixed_biogeog.eq.itrue)) ) then + ! now make one or more vegetated patches based on nocomp and land use logic luh_state_loop: do i_lu_state = 1, end_landuse_idx lu_state_present_if: if (state_vector(i_lu_state) .gt. nearzero) then @@ -876,7 +885,7 @@ subroutine init_patches( nsites, sites, bc_in) end do new_patch_nocomp_loop end if lu_state_present_if end do luh_state_loop - end if not_all_bareground_if + end if not_all_bare_if ! if we had to skip small patches above, resize things accordingly if ( area_error .gt. nearzero) then @@ -907,7 +916,9 @@ subroutine init_patches( nsites, sites, bc_in) end do else !this is a big error not just a precision error. - write(fates_log(),*) 'issue with patch area in EDinit', area_diff, total + write(fates_log(),*) 'issue with patch area in EDinit', area_diff, total,sites(s)%lat,sites(s)%lon + write(fates_log(),*) 'hlm_use_nocomp: ',hlm_use_nocomp + write(fates_log(),*) 'hlm_use_fixed_biogeog: ',hlm_use_fixed_biogeog newp => sites(s)%oldest_patch do while (associated(newp)) write(fates_log(),*) newp%area, newp%nocomp_pft_label, newp%land_use_label From a997af58f38db8ffda259e11f3abcc65478a4903 Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Wed, 22 May 2024 11:14:10 -0600 Subject: [PATCH 093/112] updated parameter check to ignore SP --- main/EDPftvarcon.F90 | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) diff --git a/main/EDPftvarcon.F90 b/main/EDPftvarcon.F90 index 32c7800249..8e10ebdcf7 100644 --- a/main/EDPftvarcon.F90 +++ b/main/EDPftvarcon.F90 @@ -2237,8 +2237,11 @@ subroutine FatesCheckParams(is_master) ! if nocomp is enabled, check to make sure the max number of nocomp PFTs per land use is - ! less than or equal to the max number of patches per land use. - if ( hlm_use_nocomp .eq. itrue ) then + ! less than or equal to the max number of patches per land use. (unless this is an + ! SP run, then all PFTS are tracked on the primary LU and the others are allocated + ! zero patch space + + if ( hlm_use_nocomp .eq. itrue .and. hlm_use_sp.eq.ifalse) then do i_lu = 1, n_landuse_cats if (max_nocomp_pfts_by_landuse(i_lu) .gt. maxpatches_by_landuse(i_lu)) then write(fates_log(),*) 'The max number of nocomp PFTs must all be less than or equal to the number of patches, for a given land use type' From d38bc5986bd8963642f656b6ed0d04935fcd53b0 Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Wed, 29 May 2024 16:37:45 -0600 Subject: [PATCH 094/112] remove merge conflict artifacts --- main/EDTypesMod.F90 | 4 ---- 1 file changed, 4 deletions(-) diff --git a/main/EDTypesMod.F90 b/main/EDTypesMod.F90 index 2e5b98a0d1..d8a0eb5e73 100644 --- a/main/EDTypesMod.F90 +++ b/main/EDTypesMod.F90 @@ -464,11 +464,7 @@ module EDTypesMod procedure, public :: get_current_landuse_statevector procedure, public :: get_secondary_young_fraction -<<<<<<< HEAD - -======= ->>>>>>> 827ab3f1d63f710f8819d4329253d0a7d75a4bed end type ed_site_type ! Make public necessary subroutines and functions From 9d8628e1d7cb79d235dff93ace8ab4f0c79cf330 Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Thu, 30 May 2024 12:24:28 -0600 Subject: [PATCH 095/112] shortened some restart var names --- main/FatesRestartInterfaceMod.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/main/FatesRestartInterfaceMod.F90 b/main/FatesRestartInterfaceMod.F90 index 57b0bd6ea9..3f7e8375fe 100644 --- a/main/FatesRestartInterfaceMod.F90 +++ b/main/FatesRestartInterfaceMod.F90 @@ -1157,12 +1157,12 @@ subroutine define_restart_vars(this, initialize_variables) end if - call this%RegisterCohortVector(symbol_base='fates_woodproduct_harvest', vtype=cohort_r8, & + call this%RegisterCohortVector(symbol_base='fates_woodprod_harv', vtype=cohort_r8, & long_name_base='Current wood product flux from harvest', & units='kg/m2/day', veclength=num_elements, flushval = flushzero, & hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_woodprod_harvest_mbal) - call this%RegisterCohortVector(symbol_base='fates_woodproduct_landusechange', vtype=cohort_r8, & + call this%RegisterCohortVector(symbol_base='fates_woodprod_luc', vtype=cohort_r8, & long_name_base='Current wood product flux from land use change', & units='kg/m2/day', veclength=num_elements, flushval = flushzero, & hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_woodprod_landusechange_mbal) From 9c2444ffe393dbf49bebfbc301cef7e6269a63ff Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Tue, 4 Jun 2024 11:12:57 -0700 Subject: [PATCH 096/112] change nocomp_pft_area_vector check to first diff then sum for better precision --- biogeochem/EDPatchDynamicsMod.F90 | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/biogeochem/EDPatchDynamicsMod.F90 b/biogeochem/EDPatchDynamicsMod.F90 index a6e05617be..38a5c16793 100644 --- a/biogeochem/EDPatchDynamicsMod.F90 +++ b/biogeochem/EDPatchDynamicsMod.F90 @@ -1472,7 +1472,7 @@ subroutine spawn_patches( currentSite, bc_in) buffer_patch_used_if: if ( buffer_patch_used ) then ! at this point, lets check that the total patch area remaining to be relabelled equals what we think that it is. - if (abs(sum(nocomp_pft_area_vector(:)) - sum(nocomp_pft_area_vector_filled(:)) - buffer_patch%area) .gt. rsnbl_math_prec) then + if (abs(sum(nocomp_pft_area_vector(:) - nocomp_pft_area_vector_filled(:)) - buffer_patch%area) .gt. rsnbl_math_prec) then write(fates_log(),*) 'midway through patch reallocation and things are already not adding up.', i_land_use_label write(fates_log(),*) currentSite%area_pft(:,i_land_use_label) write(fates_log(),*) '-----' @@ -1552,7 +1552,7 @@ subroutine spawn_patches( currentSite, bc_in) write(fates_log(),*) 'Buffer patch still has area and it wasnt put into the linked list' write(fates_log(),*) 'buffer_patch%area', buffer_patch%area write(fates_log(),*) sum(nocomp_pft_area_vector_filled(:)), sum(nocomp_pft_area_vector(:)) - write(fates_log(),*) sum(nocomp_pft_area_vector_filled(:)) - sum(nocomp_pft_area_vector(:)) + write(fates_log(),*) sum(nocomp_pft_area_vector_filled(:) - nocomp_pft_area_vector(:)) call endrun(msg=errMsg(sourcefile, __LINE__)) end if @@ -1568,8 +1568,8 @@ subroutine spawn_patches( currentSite, bc_in) end if buffer_patch_used_if ! check that the area we have added is the same as the area we have taken away. if not, crash. - if ( abs(sum(nocomp_pft_area_vector_filled(:)) - sum(nocomp_pft_area_vector(:))) .gt. rsnbl_math_prec) then - write(fates_log(),*) 'patch reallocation logic doesnt add up. difference is: ', sum(nocomp_pft_area_vector_filled(:)) - sum(nocomp_pft_area_vector(:)) + if ( abs(sum(nocomp_pft_area_vector_filled(:) - nocomp_pft_area_vector(:))) .gt. rsnbl_math_prec) then + write(fates_log(),*) 'patch reallocation logic doesnt add up. difference is: ', sum(nocomp_pft_area_vector_filled(:) - nocomp_pft_area_vector(:)) write(fates_log(),*) nocomp_pft_area_vector_filled write(fates_log(),*) nocomp_pft_area_vector write(fates_log(),*) i_land_use_label From 737e81d3015eaf3fb83b7c6823b26d9208940c9a Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Wed, 5 Jun 2024 22:47:26 -0600 Subject: [PATCH 097/112] change check for buffer split to use fraction to keep --- biogeochem/EDPatchDynamicsMod.F90 | 10 +++++++--- 1 file changed, 7 insertions(+), 3 deletions(-) diff --git a/biogeochem/EDPatchDynamicsMod.F90 b/biogeochem/EDPatchDynamicsMod.F90 index 38a5c16793..40ca2ba7e4 100644 --- a/biogeochem/EDPatchDynamicsMod.F90 +++ b/biogeochem/EDPatchDynamicsMod.F90 @@ -1499,15 +1499,19 @@ subroutine spawn_patches( currentSite, bc_in) if (nocomp_pft_area_vector_filled(i_pft) .lt. currentSite%area_pft(i_pft,i_land_use_label) * sum(nocomp_pft_area_vector(:))) then ! newp_area = currentSite%area_pft(i_pft,i_land_use_label) * sum(nocomp_pft_area_vector(:)) - nocomp_pft_area_vector_filled(i_pft) + ! only bother doing this if the new new patch area needed is greater than some tiny amount if ( newp_area .gt. rsnbl_math_prec * 0.01_r8) then - ! - if (buffer_patch%area - newp_area .gt. rsnbl_math_prec * 0.01_r8) then + + ! Compute fraction to keep in buffer + fraction_to_keep = (buffer_patch%area - newp_area) / buffer_patch%area + + if (fraction_to_keep .gt. rsnbl_math_prec) then ! split buffer patch in two, keeping the smaller buffer patch to put into new patches allocate(temp_patch) - call split_patch(currentSite, buffer_patch, temp_patch, (1._r8 - newp_area/buffer_patch%area)) + call split_patch(currentSite, buffer_patch, temp_patch, fraction_to_keep) ! give the new patch the intended nocomp PFT label temp_patch%nocomp_pft_label = i_pft From 4b018eade498d063b21dddf26f77c9658ff80261 Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Thu, 6 Jun 2024 16:53:16 -0600 Subject: [PATCH 098/112] add check to avoid bareground patches This avoids an out-of-bounds indexing error when in landuse mode --- biogeochem/FatesSoilBGCFluxMod.F90 | 175 +++++++++++++++-------------- 1 file changed, 88 insertions(+), 87 deletions(-) diff --git a/biogeochem/FatesSoilBGCFluxMod.F90 b/biogeochem/FatesSoilBGCFluxMod.F90 index 9d813c32b3..2c5b7d9b18 100644 --- a/biogeochem/FatesSoilBGCFluxMod.F90 +++ b/biogeochem/FatesSoilBGCFluxMod.F90 @@ -69,6 +69,7 @@ module FatesSoilBGCFluxMod use FatesConstantsMod, only : sec_per_day use FatesConstantsMod, only : years_per_day use FatesConstantsMod, only : itrue + use FatesConstantsMod, only : nocomp_bareground use FatesLitterMod, only : litter_type use FatesLitterMod , only : ncwd use FatesLitterMod , only : ndcmpy @@ -287,107 +288,107 @@ subroutine PrepCH4BCs(csite,bc_in,bc_out) 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)) + if_notbare: if(cpatch%nocomp_pft_label .ne. nocomp_bareground)then + ! Patch ordering when passing boundary conditions + ! always goes from oldest to youngest, following + ! the convention of EDPatchDynamics::set_patchno() - ! For consistency, only apply calculations to non-new - ! cohorts. New cohorts will not have respiration rates - ! at this point in the call sequence. + fp = fp + 1 - 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) - - ! [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 + agnpp = 0._r8 + bgnpp = 0._r8 + woody_area = 0._r8 + plant_area = 0._r8 + + ccohort => cpatch%tallest + do while (associated(ccohort)) - ! [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 + ! For consistency, only apply calculations to non-new + ! cohorts. New cohorts will not have respiration rates + ! at this point in the call sequence. - if(hlm_use_ch4==itrue)then + if(.not.ccohort%isnew) then - ! 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) + 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) + + ! [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 - ! 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 + if(hlm_use_ch4==itrue)then + + ! 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 + + ! (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) + + end if + + if( prt_params%woody(pft)==itrue ) then + woody_area = woody_area + ccohort%c_area + end if + plant_area = plant_area + ccohort%c_area - ! (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) end if - if( prt_params%woody(pft)==itrue ) then - woody_area = woody_area + ccohort%c_area + ccohort => ccohort%shorter + end do + + if(hlm_use_ch4==itrue)then + 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 - plant_area = plant_area + ccohort%c_area + ! 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 - end if - - ccohort => ccohort%shorter - end do - - if(hlm_use_ch4==itrue)then - 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 + ! 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 - end if - + end if + end if if_notbare cpatch => cpatch%younger end do From b43cb3a2a96b7761641f59dc0838759819d9220d Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Sun, 23 Jun 2024 23:48:16 -0600 Subject: [PATCH 099/112] update split_patches to take optional area input --- biogeochem/EDPatchDynamicsMod.F90 | 29 +++++++++++++++++++---------- 1 file changed, 19 insertions(+), 10 deletions(-) diff --git a/biogeochem/EDPatchDynamicsMod.F90 b/biogeochem/EDPatchDynamicsMod.F90 index 40ca2ba7e4..ec077dbc9e 100644 --- a/biogeochem/EDPatchDynamicsMod.F90 +++ b/biogeochem/EDPatchDynamicsMod.F90 @@ -1511,7 +1511,7 @@ subroutine spawn_patches( currentSite, bc_in) ! split buffer patch in two, keeping the smaller buffer patch to put into new patches allocate(temp_patch) - call split_patch(currentSite, buffer_patch, temp_patch, fraction_to_keep) + call split_patch(currentSite, buffer_patch, temp_patch, fraction_to_keep, newp_area) ! give the new patch the intended nocomp PFT label temp_patch%nocomp_pft_label = i_pft @@ -1621,16 +1621,17 @@ end subroutine spawn_patches ! ----------------------------------------------------------------------------------------- - subroutine split_patch(currentSite, currentPatch, new_patch, fraction_to_keep) + subroutine split_patch(currentSite, currentPatch, new_patch, fraction_to_keep, new_area) ! ! !DESCRIPTION: ! Split a patch into two patches that are identical except in their areas ! ! !ARGUMENTS: type(ed_site_type),intent(inout) :: currentSite - type(fates_patch_type) , intent(inout), pointer :: currentPatch ! Donor Patch - type(fates_patch_type) , intent(inout), pointer :: new_patch ! New Patch - real(r8), intent(in) :: fraction_to_keep ! fraction of currentPatch to keep, the rest goes to newpatch + type(fates_patch_type) , intent(inout), pointer :: currentPatch ! Donor Patch + type(fates_patch_type) , intent(inout), pointer :: new_patch ! New Patch + real(r8), intent(in) :: fraction_to_keep ! fraction of currentPatch to keep, the rest goes to newpatch + real(r8), intent(in), optional :: area_to_remove ! area of currentPatch to remove, the rest goes to newpatch ! ! !LOCAL VARIABLES: integer :: el ! element loop index @@ -1641,11 +1642,19 @@ subroutine split_patch(currentSite, currentPatch, new_patch, fraction_to_keep) integer :: tnull ! is there a tallest cohort? integer :: snull ! is there a shortest cohort? integer :: pft + real(r8) :: temp_area + + temp_area = 0._r8 + if (present(area_to_remove)) then + temp_area = area_to_remove + else + temp_area = currentPatch%area - (currentPatch%area * fraction_to_keep) + end if ! first we need to make the new patch - call new_patch%Create(0._r8, & - currentPatch%area * (1._r8 - fraction_to_keep), currentPatch%land_use_label, currentPatch%nocomp_pft_label, & - num_swb, numpft, currentSite%nlevsoil, hlm_current_tod, & + call new_patch%Create(0._r8, temp_area, & + currentPatch%land_use_label, currentPatch%nocomp_pft_label, & + num_swb, numpft, currentSite%nlevsoil, hlm_current_tod, & regeneration_model) ! Initialize the litter pools to zero, these @@ -1663,7 +1672,7 @@ subroutine split_patch(currentSite, currentPatch, new_patch, fraction_to_keep) call CopyPatchMeansTimers(currentPatch, new_patch) - call TransLitterNewPatch( currentSite, currentPatch, new_patch, currentPatch%area * (1.-fraction_to_keep)) + call TransLitterNewPatch( currentSite, currentPatch, new_patch, temp_area) currentPatch%burnt_frac_litter(:) = 0._r8 @@ -1730,7 +1739,7 @@ subroutine split_patch(currentSite, currentPatch, new_patch, fraction_to_keep) call sort_cohorts(currentPatch) !update area of donor patch - currentPatch%area = currentPatch%area * fraction_to_keep + currentPatch%area = currentPatch%area - temp_area end subroutine split_patch From 29621bc5fb0589da94ea470cb40c4b35a483776c Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Mon, 24 Jun 2024 12:02:02 -0600 Subject: [PATCH 100/112] fix split patch optional argument name error --- biogeochem/EDPatchDynamicsMod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/biogeochem/EDPatchDynamicsMod.F90 b/biogeochem/EDPatchDynamicsMod.F90 index ec077dbc9e..e62ae68dc7 100644 --- a/biogeochem/EDPatchDynamicsMod.F90 +++ b/biogeochem/EDPatchDynamicsMod.F90 @@ -1621,7 +1621,7 @@ end subroutine spawn_patches ! ----------------------------------------------------------------------------------------- - subroutine split_patch(currentSite, currentPatch, new_patch, fraction_to_keep, new_area) + subroutine split_patch(currentSite, currentPatch, new_patch, fraction_to_keep, area_to_remove) ! ! !DESCRIPTION: ! Split a patch into two patches that are identical except in their areas From 9b724ea40a1c0dd4728ed198e4bae8f0af321e99 Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Mon, 24 Jun 2024 11:38:40 -0600 Subject: [PATCH 101/112] correct bad merge --- main/FatesHistoryInterfaceMod.F90 | 47 ++++++++++++++++++++++++++++++- 1 file changed, 46 insertions(+), 1 deletion(-) diff --git a/main/FatesHistoryInterfaceMod.F90 b/main/FatesHistoryInterfaceMod.F90 index 6219f34915..c5b48735f6 100644 --- a/main/FatesHistoryInterfaceMod.F90 +++ b/main/FatesHistoryInterfaceMod.F90 @@ -14,7 +14,7 @@ module FatesHistoryInterfaceMod use FatesConstantsMod , only : i_term_mort_type_cstarv use FatesConstantsMod , only : i_term_mort_type_canlev use FatesConstantsMod , only : i_term_mort_type_numdens - use FatesConstantsMo , only : nocomp_bareground_land + use FatesConstantsMod , only : nocomp_bareground_land use FatesGlobals , only : fates_log use FatesGlobals , only : endrun => fates_endrun use EDParamsMod , only : nclmax, maxpft @@ -90,6 +90,51 @@ module FatesHistoryInterfaceMod use shr_log_mod , only : errMsg => shr_log_errMsg use shr_infnan_mod , only : isnan => shr_infnan_isnan + use FatesConstantsMod , only : g_per_kg + use FatesConstantsMod , only : kg_per_g + use FatesConstantsMod , only : ha_per_m2 + use FatesConstantsMod , only : days_per_sec + use FatesConstantsMod , only : sec_per_day + use FatesConstantsMod , only : days_per_sec + use FatesConstantsMod , only : days_per_year + use FatesConstantsMod , only : years_per_day + use FatesConstantsMod , only : m2_per_km2 + use FatesConstantsMod , only : J_per_kJ + use FatesConstantsMod , only : m2_per_ha + use FatesConstantsMod , only : ha_per_m2 + use FatesConstantsMod , only : m_per_cm + use FatesConstantsMod , only : m_per_mm + use FatesConstantsMod , only : sec_per_min + use FatesConstantsMod , only : umol_per_mol,mol_per_umol + use FatesConstantsMod , only : pa_per_mpa + use FatesConstantsMod , only : dens_fresh_liquid_water + use FatesConstantsMod , only : grav_earth + use FatesLitterMod , only : litter_type + use FatesConstantsMod , only : secondaryland + + use PRTGenericMod , only : leaf_organ, fnrt_organ, sapw_organ + use PRTGenericMod , only : struct_organ, store_organ, repro_organ + use PRTGenericMod , only : carbon12_element + use PRTGenericMod , only : nitrogen_element, phosphorus_element + use PRTGenericMod , only : prt_carbon_allom_hyp + use PRTAllometricCNPMod , only : stoich_max,stoich_growth_min + use FatesSizeAgeTypeIndicesMod, only : get_layersizetype_class_index + use FatesSizeAgeTypeIndicesMod, only : get_age_class_index + + use FatesLitterMod , only : nfsc + use FatesLitterMod , only : ncwd + use FatesConstantsMod , only : ican_upper + use FatesConstantsMod , only : ican_ustory + use FatesSizeAgeTypeIndicesMod, only : get_sizeage_class_index + use FatesSizeAgeTypeIndicesMod, only : get_sizeagepft_class_index + use FatesSizeAgeTypeIndicesMod, only : get_agepft_class_index + use FatesSizeAgeTypeIndicesMod, only : get_agefuel_class_index + use FatesSizeAgeTypeIndicesMod, only : get_height_index + use FatesSizeAgeTypeIndicesMod, only : sizetype_class_index + use FatesSizeAgeTypeIndicesMod, only : get_cdamagesize_class_index + use FatesSizeAgeTypeIndicesMod, only : get_cdamagesizepft_class_index + use FatesSizeAgeTypeIndicesMod, only : coagetype_class_index + implicit none private ! By default everything is private From 3c02ded0ac23c46fd0784217b6ad0096a7385a6d Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Mon, 24 Jun 2024 00:49:50 -0600 Subject: [PATCH 102/112] refactor checks to determine what is sent to buffer patch --- biogeochem/EDPatchDynamicsMod.F90 | 18 ++++++++++++------ 1 file changed, 12 insertions(+), 6 deletions(-) diff --git a/biogeochem/EDPatchDynamicsMod.F90 b/biogeochem/EDPatchDynamicsMod.F90 index e62ae68dc7..083f290fb9 100644 --- a/biogeochem/EDPatchDynamicsMod.F90 +++ b/biogeochem/EDPatchDynamicsMod.F90 @@ -559,7 +559,7 @@ subroutine spawn_patches( currentSite, bc_in) real(r8) :: fraction_to_keep integer :: i_land_use_label integer :: i_pft - real(r8) :: newp_area + real(r8) :: newp_area, area_to_keep logical :: buffer_patch_in_linked_list integer :: n_pfts_by_landuse integer :: which_pft_allowed @@ -1424,11 +1424,15 @@ subroutine spawn_patches( currentSite, bc_in) do while(associated(currentPatch)) if (currentPatch%changed_landuse_this_ts .and. currentPatch%land_use_label .eq. i_land_use_label) then - fraction_to_keep = (currentSite%area_pft(currentPatch%nocomp_pft_label,i_land_use_label) * sum(nocomp_pft_area_vector(:)) & - - nocomp_pft_area_vector_filled(currentPatch%nocomp_pft_label)) / currentPatch%area + ! Calculate the areas to be given to potentially give to the buffer patch and those to keep in the current patch + area_to_keep = currentSite%area_pft(currentPatch%nocomp_pft_label,i_land_use_label) * sum(nocomp_pft_area_vector(:)) - & + nocomp_pft_area_vector_filled(currentPatch%nocomp_pft_label) + newp_area = currentPatch%area - area_to_keep + fraction_to_keep = area_to_keep / currentPatch%area - if (fraction_to_keep .le. nearzero) then + if (fraction_to_keep .le. nearzero .or. area_to_keep .lt. rsnbl_math_prec) then ! we don't want any patch area with this PFT identity at all anymore. Fuse it into the buffer patch. + currentPatch%nocomp_pft_label = 0 if (associated(currentPatch%older)) then previousPatch => currentPatch%older @@ -1441,13 +1445,13 @@ subroutine spawn_patches( currentSite, bc_in) buffer_patch_used = .true. - elseif ( (1._r8 - fraction_to_keep) .gt. rsnbl_math_prec) then + elseif ( area_to_keep .ge. rsnbl_math_prec .and. newp_area .ge. rsnbl_math_prec) then ! we have more patch are of this PFT than we want, but we do want to keep some of it. ! we want to split the patch into two here. leave one patch as-is, and put the rest into the buffer patch. allocate(temp_patch) - call split_patch(currentSite, currentPatch, temp_patch, fraction_to_keep) + call split_patch(currentSite, currentPatch, temp_patch, fraction_to_keep, newp_area) ! temp_patch%nocomp_pft_label = 0 @@ -1461,9 +1465,11 @@ subroutine spawn_patches( currentSite, bc_in) buffer_patch_used = .true. else ! we want to keep all of this patch (and possibly more) + nocomp_pft_area_vector_filled(currentPatch%nocomp_pft_label) = & nocomp_pft_area_vector_filled(currentPatch%nocomp_pft_label) + currentPatch%area currentPatch%changed_landuse_this_ts = .false. + endif end if From 7add4a11547caaead9d4b9b06c401e3cb34294a7 Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Mon, 24 Jun 2024 00:54:50 -0600 Subject: [PATCH 103/112] make sure to skip the buffer patch split loop if the buffer patch is already in the linked list --- biogeochem/EDPatchDynamicsMod.F90 | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/biogeochem/EDPatchDynamicsMod.F90 b/biogeochem/EDPatchDynamicsMod.F90 index 083f290fb9..24909933da 100644 --- a/biogeochem/EDPatchDynamicsMod.F90 +++ b/biogeochem/EDPatchDynamicsMod.F90 @@ -1499,8 +1499,10 @@ subroutine spawn_patches( currentSite, bc_in) ! now we need to loop through the nocomp PFTs, and split the buffer patch into a set of patches to put back in the linked list nocomp_pft_loop_2: do i_pft = 1, numpft - ! - if ( currentSite%area_pft(i_pft,i_land_use_label) .gt. nearzero) then + + ! Check the area fraction to makes sure that this pft should have area. Also make sure that the buffer patch hasn't been + ! added to the linked list already + if ( currentSite%area_pft(i_pft,i_land_use_label) .gt. nearzero .and. .not. buffer_patch_in_linked_list) then ! if (nocomp_pft_area_vector_filled(i_pft) .lt. currentSite%area_pft(i_pft,i_land_use_label) * sum(nocomp_pft_area_vector(:))) then ! From fe795df74216244b15e8db647eca6a61c7b1a235 Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Mon, 24 Jun 2024 01:07:03 -0600 Subject: [PATCH 104/112] refactor newp_area calculation to avoid potential precision error --- biogeochem/EDPatchDynamicsMod.F90 | 10 ++++++++-- 1 file changed, 8 insertions(+), 2 deletions(-) diff --git a/biogeochem/EDPatchDynamicsMod.F90 b/biogeochem/EDPatchDynamicsMod.F90 index 24909933da..3f9464e822 100644 --- a/biogeochem/EDPatchDynamicsMod.F90 +++ b/biogeochem/EDPatchDynamicsMod.F90 @@ -556,6 +556,7 @@ subroutine spawn_patches( currentSite, bc_in) type (fates_patch_type) , pointer :: buffer_patch, temp_patch, copyPatch, previousPatch real(r8) :: nocomp_pft_area_vector(numpft) real(r8) :: nocomp_pft_area_vector_filled(numpft) + real(r8) :: nocomp_pft_area_vector_alt(numpft) real(r8) :: fraction_to_keep integer :: i_land_use_label integer :: i_pft @@ -1505,8 +1506,13 @@ subroutine spawn_patches( currentSite, bc_in) if ( currentSite%area_pft(i_pft,i_land_use_label) .gt. nearzero .and. .not. buffer_patch_in_linked_list) then ! if (nocomp_pft_area_vector_filled(i_pft) .lt. currentSite%area_pft(i_pft,i_land_use_label) * sum(nocomp_pft_area_vector(:))) then - ! - newp_area = currentSite%area_pft(i_pft,i_land_use_label) * sum(nocomp_pft_area_vector(:)) - nocomp_pft_area_vector_filled(i_pft) + + ! Slightly complicated way of making sure that the same pfts are subtracted from each other which may help to avoid precision + ! errors due to differencing between very large and very small areas + nocomp_pft_area_vector_alt(:) = nocomp_pft_area_vector(:) + nocomp_pft_area_vector_alt(i_pft) = 0._r8 + newp_area = (currentSite%area_pft(i_pft,i_land_use_label) * nocomp_pft_area_vector(i_pft)) - nocomp_pft_area_vector_filled(i_pft) + newp_area = newp_area + sum(currentSite%area_pft(i_pft,i_land_use_label)*nocomp_pft_area_vector_alt(:)) ! only bother doing this if the new new patch area needed is greater than some tiny amount if ( newp_area .gt. rsnbl_math_prec * 0.01_r8) then From 28511d1eb59bb58d2bee5d75c8ca4d83735fde78 Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Mon, 24 Jun 2024 01:10:31 -0600 Subject: [PATCH 105/112] move the fraction to keep calculation earlier --- biogeochem/EDPatchDynamicsMod.F90 | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/biogeochem/EDPatchDynamicsMod.F90 b/biogeochem/EDPatchDynamicsMod.F90 index 3f9464e822..4eca17362d 100644 --- a/biogeochem/EDPatchDynamicsMod.F90 +++ b/biogeochem/EDPatchDynamicsMod.F90 @@ -1514,12 +1514,12 @@ subroutine spawn_patches( currentSite, bc_in) newp_area = (currentSite%area_pft(i_pft,i_land_use_label) * nocomp_pft_area_vector(i_pft)) - nocomp_pft_area_vector_filled(i_pft) newp_area = newp_area + sum(currentSite%area_pft(i_pft,i_land_use_label)*nocomp_pft_area_vector_alt(:)) + ! Compute fraction to keep in buffer + fraction_to_keep = (buffer_patch%area - newp_area) / buffer_patch%area + ! only bother doing this if the new new patch area needed is greater than some tiny amount if ( newp_area .gt. rsnbl_math_prec * 0.01_r8) then - ! Compute fraction to keep in buffer - fraction_to_keep = (buffer_patch%area - newp_area) / buffer_patch%area - if (fraction_to_keep .gt. rsnbl_math_prec) then ! split buffer patch in two, keeping the smaller buffer patch to put into new patches From e8238300cbda07adf93355b3935b1c49be8e4742 Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Mon, 24 Jun 2024 01:22:43 -0600 Subject: [PATCH 106/112] check absolute value of buffer area to keep --- biogeochem/EDPatchDynamicsMod.F90 | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/biogeochem/EDPatchDynamicsMod.F90 b/biogeochem/EDPatchDynamicsMod.F90 index 4eca17362d..a20ede746c 100644 --- a/biogeochem/EDPatchDynamicsMod.F90 +++ b/biogeochem/EDPatchDynamicsMod.F90 @@ -1514,13 +1514,14 @@ subroutine spawn_patches( currentSite, bc_in) newp_area = (currentSite%area_pft(i_pft,i_land_use_label) * nocomp_pft_area_vector(i_pft)) - nocomp_pft_area_vector_filled(i_pft) newp_area = newp_area + sum(currentSite%area_pft(i_pft,i_land_use_label)*nocomp_pft_area_vector_alt(:)) - ! Compute fraction to keep in buffer - fraction_to_keep = (buffer_patch%area - newp_area) / buffer_patch%area + ! Compute area and fraction to keep in buffer + area_to_keep = buffer_patch%area - newp_area + fraction_to_keep = area_to_keep / buffer_patch%area ! only bother doing this if the new new patch area needed is greater than some tiny amount if ( newp_area .gt. rsnbl_math_prec * 0.01_r8) then - if (fraction_to_keep .gt. rsnbl_math_prec) then + if (area_to_keep .gt. rsnbl_math_prec) then ! split buffer patch in two, keeping the smaller buffer patch to put into new patches allocate(temp_patch) From 2ec67f9370298d4086a2ab88baff13b50fa93608 Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Tue, 25 Jun 2024 12:19:17 -0600 Subject: [PATCH 107/112] remove this check as we are now checking the new and remaining areas are non-negative --- biogeochem/EDPatchDynamicsMod.F90 | 3 --- 1 file changed, 3 deletions(-) diff --git a/biogeochem/EDPatchDynamicsMod.F90 b/biogeochem/EDPatchDynamicsMod.F90 index a20ede746c..af333bfe84 100644 --- a/biogeochem/EDPatchDynamicsMod.F90 +++ b/biogeochem/EDPatchDynamicsMod.F90 @@ -1504,8 +1504,6 @@ subroutine spawn_patches( currentSite, bc_in) ! Check the area fraction to makes sure that this pft should have area. Also make sure that the buffer patch hasn't been ! added to the linked list already if ( currentSite%area_pft(i_pft,i_land_use_label) .gt. nearzero .and. .not. buffer_patch_in_linked_list) then - ! - if (nocomp_pft_area_vector_filled(i_pft) .lt. currentSite%area_pft(i_pft,i_land_use_label) * sum(nocomp_pft_area_vector(:))) then ! Slightly complicated way of making sure that the same pfts are subtracted from each other which may help to avoid precision ! errors due to differencing between very large and very small areas @@ -1551,7 +1549,6 @@ subroutine spawn_patches( currentSite, bc_in) end if end if - end if end if end do nocomp_pft_loop_2 From 69e8f6a8feafb88929194b986525cecdd6060ae2 Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Tue, 25 Jun 2024 13:01:31 -0600 Subject: [PATCH 108/112] correct whitespace --- biogeochem/EDPatchDynamicsMod.F90 | 60 +++++++++++++++---------------- 1 file changed, 30 insertions(+), 30 deletions(-) diff --git a/biogeochem/EDPatchDynamicsMod.F90 b/biogeochem/EDPatchDynamicsMod.F90 index af333bfe84..a5ec0e40b1 100644 --- a/biogeochem/EDPatchDynamicsMod.F90 +++ b/biogeochem/EDPatchDynamicsMod.F90 @@ -1505,50 +1505,50 @@ subroutine spawn_patches( currentSite, bc_in) ! added to the linked list already if ( currentSite%area_pft(i_pft,i_land_use_label) .gt. nearzero .and. .not. buffer_patch_in_linked_list) then - ! Slightly complicated way of making sure that the same pfts are subtracted from each other which may help to avoid precision - ! errors due to differencing between very large and very small areas - nocomp_pft_area_vector_alt(:) = nocomp_pft_area_vector(:) - nocomp_pft_area_vector_alt(i_pft) = 0._r8 - newp_area = (currentSite%area_pft(i_pft,i_land_use_label) * nocomp_pft_area_vector(i_pft)) - nocomp_pft_area_vector_filled(i_pft) - newp_area = newp_area + sum(currentSite%area_pft(i_pft,i_land_use_label)*nocomp_pft_area_vector_alt(:)) + ! Slightly complicated way of making sure that the same pfts are subtracted from each other which may help to avoid precision + ! errors due to differencing between very large and very small areas + nocomp_pft_area_vector_alt(:) = nocomp_pft_area_vector(:) + nocomp_pft_area_vector_alt(i_pft) = 0._r8 + newp_area = (currentSite%area_pft(i_pft,i_land_use_label) * nocomp_pft_area_vector(i_pft)) - nocomp_pft_area_vector_filled(i_pft) + newp_area = newp_area + sum(currentSite%area_pft(i_pft,i_land_use_label)*nocomp_pft_area_vector_alt(:)) - ! Compute area and fraction to keep in buffer - area_to_keep = buffer_patch%area - newp_area - fraction_to_keep = area_to_keep / buffer_patch%area + ! Compute area and fraction to keep in buffer + area_to_keep = buffer_patch%area - newp_area + fraction_to_keep = area_to_keep / buffer_patch%area - ! only bother doing this if the new new patch area needed is greater than some tiny amount - if ( newp_area .gt. rsnbl_math_prec * 0.01_r8) then + ! only bother doing this if the new new patch area needed is greater than some tiny amount + if ( newp_area .gt. rsnbl_math_prec * 0.01_r8) then - if (area_to_keep .gt. rsnbl_math_prec) then + if (area_to_keep .gt. rsnbl_math_prec) then - ! split buffer patch in two, keeping the smaller buffer patch to put into new patches - allocate(temp_patch) + ! split buffer patch in two, keeping the smaller buffer patch to put into new patches + allocate(temp_patch) - call split_patch(currentSite, buffer_patch, temp_patch, fraction_to_keep, newp_area) + call split_patch(currentSite, buffer_patch, temp_patch, fraction_to_keep, newp_area) - ! give the new patch the intended nocomp PFT label - temp_patch%nocomp_pft_label = i_pft + ! give the new patch the intended nocomp PFT label + temp_patch%nocomp_pft_label = i_pft - ! track that we have added this patch area - nocomp_pft_area_vector_filled(i_pft) = nocomp_pft_area_vector_filled(i_pft) + temp_patch%area + ! track that we have added this patch area + nocomp_pft_area_vector_filled(i_pft) = nocomp_pft_area_vector_filled(i_pft) + temp_patch%area - ! put the new patch into the linked list - call InsertPatch(currentSite, temp_patch) + ! put the new patch into the linked list + call InsertPatch(currentSite, temp_patch) - else - ! give the buffer patch the intended nocomp PFT label - buffer_patch%nocomp_pft_label = i_pft + else + ! give the buffer patch the intended nocomp PFT label + buffer_patch%nocomp_pft_label = i_pft - ! track that we have added this patch area - nocomp_pft_area_vector_filled(i_pft) = nocomp_pft_area_vector_filled(i_pft) + buffer_patch%area + ! track that we have added this patch area + nocomp_pft_area_vector_filled(i_pft) = nocomp_pft_area_vector_filled(i_pft) + buffer_patch%area - ! put the buffer patch directly into the linked list - call InsertPatch(currentSite, buffer_patch) + ! put the buffer patch directly into the linked list + call InsertPatch(currentSite, buffer_patch) - buffer_patch_in_linked_list = .true. + buffer_patch_in_linked_list = .true. - end if end if + end if end if end do nocomp_pft_loop_2 From 88ce982d51fbfea6434f46ad6a4e36cf8938bca5 Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Wed, 26 Jun 2024 08:44:50 -0600 Subject: [PATCH 109/112] Add logic to check for cases in which buffer should be inserted straight into the list This handles cases in which only one pft needs to receive patch area from the buffer, but due to precision errors, following the splitting routine would result in a very small patch, technically above the reasonable math precision limit, being held in the buffer --- biogeochem/EDPatchDynamicsMod.F90 | 39 ++++++++++++++++++++++++++++--- 1 file changed, 36 insertions(+), 3 deletions(-) diff --git a/biogeochem/EDPatchDynamicsMod.F90 b/biogeochem/EDPatchDynamicsMod.F90 index a5ec0e40b1..55f7ba1311 100644 --- a/biogeochem/EDPatchDynamicsMod.F90 +++ b/biogeochem/EDPatchDynamicsMod.F90 @@ -557,10 +557,12 @@ subroutine spawn_patches( currentSite, bc_in) real(r8) :: nocomp_pft_area_vector(numpft) real(r8) :: nocomp_pft_area_vector_filled(numpft) real(r8) :: nocomp_pft_area_vector_alt(numpft) - real(r8) :: fraction_to_keep + real(r8) :: newp_area_buffer_frac(numpft) + real(r8) :: newp_area_vector(numpft) + real(r8) :: max_val integer :: i_land_use_label integer :: i_pft - real(r8) :: newp_area, area_to_keep + real(r8) :: newp_area, area_to_keep, fraction_to_keep logical :: buffer_patch_in_linked_list integer :: n_pfts_by_landuse integer :: which_pft_allowed @@ -1498,7 +1500,38 @@ subroutine spawn_patches( currentSite, bc_in) call endrun(msg=errMsg(sourcefile, __LINE__)) end if - ! now we need to loop through the nocomp PFTs, and split the buffer patch into a set of patches to put back in the linked list + ! It's possible that we only need to move all of the buffer into one patch, so first determine what the new patch areas look + ! like and compare to the buffer patch area + newp_area_vector(:)= (currentSite%area_pft(:,i_land_use_label) * sum(nocomp_pft_area_vector(:))) - nocomp_pft_area_vector_filled(:) + newp_area_buffer_frac(:) = newp_area_vector(:) / buffer_patch%area + + ! Find the maximum value of the vector + max_val = maxval(newp_area_buffer_frac) + + ! If the max value is the only value in the array then loop through the array to find the max value pft index and insert buffer + if (abs(sum(newp_area_buffer_frac(:)) - max_val) .le. nearzero) then + i_pft = 1 + do while(.not. buffer_patch_in_linked_list) + if (abs(newp_area_buffer_frac(i_pft) - max_val) .le. nearzero) then + + ! give the buffer patch the intended nocomp PFT label + buffer_patch%nocomp_pft_label = i_pft + + ! track that we have added this patch area + nocomp_pft_area_vector_filled(i_pft) = nocomp_pft_area_vector_filled(i_pft) + buffer_patch%area + + ! put the buffer patch directly into the linked list + call InsertPatch(currentSite, buffer_patch) + + ! Set flag to skip the next pft loop + buffer_patch_in_linked_list = .true. + end if + i_pft = i_pft + 1 + end do + end if + + ! Now we need to loop through the nocomp PFTs, and split the buffer patch into a set of patches to put back in the linked list + ! if not already done so above nocomp_pft_loop_2: do i_pft = 1, numpft ! Check the area fraction to makes sure that this pft should have area. Also make sure that the buffer patch hasn't been From c9e72712f2822665083d3d6f9a0c39e178f2de52 Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Thu, 27 Jun 2024 17:02:21 -0600 Subject: [PATCH 110/112] add sp mode check to litter initialization for bareground patches --- main/EDInitMod.F90 | 23 +++++++++++++---------- 1 file changed, 13 insertions(+), 10 deletions(-) diff --git a/main/EDInitMod.F90 b/main/EDInitMod.F90 index 49099b7ddf..ce76ba9017 100644 --- a/main/EDInitMod.F90 +++ b/main/EDInitMod.F90 @@ -760,7 +760,7 @@ subroutine init_patches( nsites, sites, bc_in) if (newparea .gt. min_patch_area_forced) then allocate(newp) - + call newp%Create(age, newparea, nocomp_bareground_land, nocomp_bareground, & num_swb, numpft, sites(s)%nlevsoil, hlm_current_tod, & regeneration_model) @@ -776,14 +776,20 @@ subroutine init_patches( nsites, sites, bc_in) ! Initialize the litter pools to zero, these ! pools will be populated by looping over the existing patches ! and transfering in mass + if(hlm_use_sp.eq.itrue)then + litt_init = fates_unset_r8 + else + litt_init = 0._r8 + end if do el=1,num_elements - call newp%litter(el)%InitConditions(init_leaf_fines=0._r8, & - init_root_fines=0._r8, & - init_ag_cwd=0._r8, & - init_bg_cwd=0._r8, & - init_seed=0._r8, & - init_seed_germ=0._r8) + call newp%litter(el)%InitConditions(init_leaf_fines=litt_init, & + init_root_fines=litt_init, & + init_ag_cwd=litt_init, & + init_bg_cwd=litt_init, & + init_seed=litt_init, & + init_seed_germ=litt_init) end do + else area_error = area_error + newparea endif @@ -796,12 +802,9 @@ subroutine init_patches( nsites, sites, bc_in) endif - ! not_all_bareground_if: if ((1._r8 - sites(s)%area_bareground) .gt. nearzero) then - ! Next, create the non-bareground patches. We do this for either of two scenarios: ! If 1) we are not doing both nocomp & fixed-biogeo ! 2) we are, but there is some non-zero bare-ground area - not_all_bare_if: if( ((1._r8 - sites(s)%area_bareground) > nearzero) .or. & (.not.(hlm_use_nocomp.eq.itrue .and. hlm_use_fixed_biogeog.eq.itrue)) ) then From bb3d58e0878964490ddc998bfd5593c53dab8b97 Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Fri, 28 Jun 2024 12:39:38 -0600 Subject: [PATCH 111/112] initialize current tag for event code logging --- biogeochem/EDLoggingMortalityMod.F90 | 1 + 1 file changed, 1 insertion(+) diff --git a/biogeochem/EDLoggingMortalityMod.F90 b/biogeochem/EDLoggingMortalityMod.F90 index 6d373e995a..addb821f9a 100644 --- a/biogeochem/EDLoggingMortalityMod.F90 +++ b/biogeochem/EDLoggingMortalityMod.F90 @@ -287,6 +287,7 @@ subroutine LoggingMortality_frac( currentSite, bc_in, pft_i, dbh, canopy_layer, ! 0=use fates logging parameters directly when logging_time == .true. ! this means harvest the whole cohort area harvest_rate = 1._r8 + cur_harvest_tag = 0 else if (hlm_use_lu_harvest == itrue .and. hlm_harvest_units == hlm_harvest_area_fraction) then ! We are harvesting based on areal fraction, not carbon/biomass terms. From 4ae398b955b1f4faddbd2632d98e6a8a3d247c03 Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Sun, 7 Jul 2024 22:40:25 -0600 Subject: [PATCH 112/112] Revert "initialize current tag for event code logging" This reverts commit bb3d58e0878964490ddc998bfd5593c53dab8b97. --- biogeochem/EDLoggingMortalityMod.F90 | 1 - 1 file changed, 1 deletion(-) diff --git a/biogeochem/EDLoggingMortalityMod.F90 b/biogeochem/EDLoggingMortalityMod.F90 index addb821f9a..6d373e995a 100644 --- a/biogeochem/EDLoggingMortalityMod.F90 +++ b/biogeochem/EDLoggingMortalityMod.F90 @@ -287,7 +287,6 @@ subroutine LoggingMortality_frac( currentSite, bc_in, pft_i, dbh, canopy_layer, ! 0=use fates logging parameters directly when logging_time == .true. ! this means harvest the whole cohort area harvest_rate = 1._r8 - cur_harvest_tag = 0 else if (hlm_use_lu_harvest == itrue .and. hlm_harvest_units == hlm_harvest_area_fraction) then ! We are harvesting based on areal fraction, not carbon/biomass terms.