From 0c35e38134fe24734d048d02d937b5a9e6b6b686 Mon Sep 17 00:00:00 2001 From: Charlie Koven Date: Fri, 14 Jul 2023 13:37:51 -0700 Subject: [PATCH 001/176] 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/176] 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/176] 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/176] 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/176] 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/176] 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/176] 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/176] 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/176] 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/176] 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/176] 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/176] 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/176] 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/176] 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/176] 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/176] 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/176] 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/176] 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/176] 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/176] 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/176] 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/176] 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/176] 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/176] 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/176] 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/176] 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/176] 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/176] 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/176] 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/176] 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/176] 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/176] 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/176] 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/176] 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/176] 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/176] 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/176] 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/176] 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/176] 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/176] 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/176] 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/176] 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/176] 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/176] 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/176] 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/176] 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/176] 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/176] 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/176] 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/176] 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/176] 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/176] 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/176] 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/176] 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/176] 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/176] 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/176] 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/176] 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/176] 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 1d5e02cfb0826361d2177e7096caeb73ae9d567c Mon Sep 17 00:00:00 2001 From: adrifoster Date: Tue, 12 Mar 2024 14:34:49 -0600 Subject: [PATCH 060/176] adding nesterov module --- fire/SFFireWeatherMod.F90 | 32 +++++++++++++ fire/SFMainMod.F90 | 4 +- fire/SFNestorvMod.F90 | 95 +++++++++++++++++++++++++++++++++++++++ main/EDInitMod.F90 | 4 ++ main/EDTypesMod.F90 | 3 ++ 5 files changed, 136 insertions(+), 2 deletions(-) create mode 100644 fire/SFFireWeatherMod.F90 create mode 100644 fire/SFNestorvMod.F90 diff --git a/fire/SFFireWeatherMod.F90 b/fire/SFFireWeatherMod.F90 new file mode 100644 index 0000000000..e39834ad1e --- /dev/null +++ b/fire/SFFireWeatherMod.F90 @@ -0,0 +1,32 @@ +module SFFireWeatherMod + + use FatesConstantsMod, only : r8 => fates_r8 + + implicit none + private + + type, abstract, public :: fire_weather + real(r8) :: fire_weather_index ! fire weather index + contains + procedure(initialize_fire_weather), public, deferred :: Init + procedure(update_fire_weather), public, deferred :: Update + end type fire_weather + + abstract interface + subroutine initialize_fire_weather(this) + import :: fire_weather + class(fire_weather), intent(inout) :: this + end subroutine initialize_fire_weather + + subroutine update_fire_weather(this, temp_C, precip, rh, wind) + use FatesConstantsMod, only : r8 => fates_r8 + import :: fire_weather + class(fire_weather), intent(inout) :: this + real(r8), intent(in) :: temp_C + real(r8), intent(in) :: precip + real(r8), intent(in) :: rh + real(r8), intent(in) :: wind + end subroutine update_fire_weather + end interface + +end module SFFireWeatherMod \ No newline at end of file diff --git a/fire/SFMainMod.F90 b/fire/SFMainMod.F90 index ef245b04f9..8525a0bb6f 100644 --- a/fire/SFMainMod.F90 +++ b/fire/SFMainMod.F90 @@ -1,7 +1,7 @@ module SFMainMod ! ============================================================================ - ! All subroutines realted to the SPITFIRE fire routine. + ! All subroutines related to the SPITFIRE fire routine. ! Code originally developed by Allan Spessa & Rosie Fisher as part of the NERC-QUEST project. ! ============================================================================ @@ -77,7 +77,7 @@ module SFMainMod ! ============================================================================ ! Area of site burned by fire ! ============================================================================ - subroutine fire_model( currentSite, bc_in) + subroutine fire_model(currentSite, bc_in) diff --git a/fire/SFNestorvMod.F90 b/fire/SFNestorvMod.F90 new file mode 100644 index 0000000000..860a2ec6f9 --- /dev/null +++ b/fire/SFNestorvMod.F90 @@ -0,0 +1,95 @@ +module SFNesterovMod + + use FatesConstantsMod, only : r8 => fates_r8 + use SFFireWeatherMod, only : fire_weather + + implicit none + private + + type, public, extends(fire_weather) :: nesterov_index + + contains + + procedure, public :: Init => init_nesterov_fire_weather + procedure, public :: Update => update_nesterov_index + procedure :: calc_nesterov_index + + end type nesterov_index + + real(r8), parameter :: min_precip_thresh = 3.0_r8 ! threshold for precipitation above which to 0.0 NI + + contains + + subroutine init_nesterov_fire_weather(this) + ! + ! DESCRIPTION: + ! Initializes class attributes + + ! ARGUMENTS + class(nesterov_index), intent(inout) :: this ! nesterov index extended class + + ! initialize values to 0.0 + this%fire_weather_index = 0.0_r8 + + end subroutine init_nesterov_fire_weather + + !------------------------------------------------------------------------------------- + + subroutine update_nesterov_index(this, temp_C, precip, rh, wind) + ! + ! DESCRIPTION: + ! Updates Nesterov Index + + ! ARGUMENTS + class(nesterov_index), intent(inout) :: this ! nesterov index extended class + real(r8), intent(in) :: temp_C ! daily averaged temperature [degrees C] + real(r8), intent(in) :: precip ! daily precipitation [mm] + real(r8), intent(in) :: rh ! daily relative humidity [%] + real(r8), intent(in) :: wind ! daily wind speed [m/min] + + if (precip > min_precip_thresh) then ! rezero NI if it rains + this%fire_weather_index = 0.0_r8 + else + ! Accumulate Nesterov index over fire season. + this%fire_weather_index = this%fire_weather_index + & + this%calc_nesterov_index(temp_C, precip, rh) + end if + + end subroutine update_nesterov_index + + !------------------------------------------------------------------------------------- + + real(r8) function calc_nesterov_index(this, temp_C, precip, rh) + ! + ! DESCRIPTION: + ! Calculates current day's Nesterov Index for a given input values + + use SFParamsMod, only : SF_val_fdi_a, SF_val_fdi_b + + ! ARGUMENTS: + class(nesterov_index), intent(in) :: this ! nesterov index extended class + real(r8), intent(in) :: temp_C ! daily averaged temperature [degrees C] + real(r8), intent(in) :: precip ! daily precipitation [mm] + real(r8), intent(in) :: rh ! daily relative humidity [rh] + + ! LOCALS: + real(r8) :: yipsolon ! intermediate variable for dewpoint calculation + real(r8) :: dewpoint ! dewpoint + + if (precip > min_precip_thresh) then ! NI is 0.0 if it rains + calc_nesterov_index = 0.0_r8 + else + ! Calculate dewpoint temperature + yipsolon = (SF_val_fdi_a*temp_C)/(SF_val_fdi_b + temp_C) + log(max(1.0_r8, rh)/100.0_r8) + dewpoint = (SF_val_fdi_b*yipsolon)/(SF_val_fdi_a - yipsolon) + + ! Nesterov 1968. Eq 5, Thonicke et al. 2010 + calc_nesterov_index = (temp_C - dewpoint)*temp_C + if (calc_nesterov_index < 0.0_r8) calc_nesterov_index = 0.0_r8 ! can't be negative + endif + + end function calc_nesterov_index + + !------------------------------------------------------------------------------------- + +end module SFNesterovMod \ No newline at end of file diff --git a/main/EDInitMod.F90 b/main/EDInitMod.F90 index 4ab881c4f6..25ffbbdf19 100644 --- a/main/EDInitMod.F90 +++ b/main/EDInitMod.F90 @@ -92,6 +92,7 @@ module EDInitMod use DamageMainMod, only : undamaged_class use FatesConstantsMod, only : n_term_mort_types use FatesInterfaceTypesMod , only : hlm_num_luh2_transitions + use SFNesterovMod, only : nesterov_index ! CIME GLOBALS use shr_log_mod , only : errMsg => shr_log_errMsg @@ -220,6 +221,9 @@ subroutine init_site_vars( site_in, bc_in, bc_out ) allocate(site_in%seed_in(1:numpft)) allocate(site_in%seed_out(1:numpft)) + allocate(nesterov_index :: site_in%fireWeather) + call site_in%fireWeather%Init() + end subroutine init_site_vars ! ============================================================================ diff --git a/main/EDTypesMod.F90 b/main/EDTypesMod.F90 index d310f0b84b..7203457fd7 100644 --- a/main/EDTypesMod.F90 +++ b/main/EDTypesMod.F90 @@ -31,6 +31,8 @@ module EDTypesMod use EDParamsMod, only : nclmax, nlevleaf, maxpft use FatesConstantsMod, only : n_dbh_bins, n_dist_types use shr_log_mod, only : errMsg => shr_log_errMsg + use SFFireWeatherMod, only : fire_weather + use SFNesterovMod, only : nesterov_index implicit none private ! By default everything is private @@ -339,6 +341,7 @@ module EDTypesMod real(r8) :: fdi ! daily probability an ignition event will start a fire real(r8) :: NF ! daily ignitions in km2 real(r8) :: NF_successful ! daily ignitions in km2 that actually lead to fire + type(fire_weather) :: fireWeather ! PLANT HYDRAULICS type(ed_site_hydr_type), pointer :: si_hydr From 46b26ceb1776f53fa4a6228e54ac9bf29c248bd2 Mon Sep 17 00:00:00 2001 From: adrifoster Date: Tue, 12 Mar 2024 16:31:00 -0600 Subject: [PATCH 061/176] use site fire weather object --- fire/SFMainMod.F90 | 132 +++++++++++++++++++------------------------- main/EDTypesMod.F90 | 2 +- 2 files changed, 58 insertions(+), 76 deletions(-) diff --git a/fire/SFMainMod.F90 b/fire/SFMainMod.F90 index 8525a0bb6f..af59517004 100644 --- a/fire/SFMainMod.F90 +++ b/fire/SFMainMod.F90 @@ -52,7 +52,6 @@ module SFMainMod private public :: fire_model - public :: fire_danger_index public :: charecteristics_of_fuel public :: rate_of_spread public :: ground_fuel_consumption @@ -69,79 +68,72 @@ module SFMainMod integer :: write_SF = ifalse ! for debugging logical :: debug = .false. ! for debugging - ! ============================================================================ - ! ============================================================================ + ! ====================================================================================== contains - ! ============================================================================ - ! Area of site burned by fire - ! ============================================================================ subroutine fire_model(currentSite, bc_in) + ! + ! DESCRIPTION: + ! Runs the daily fire weather model + ! ARGUMENTS: + type(ed_site_type), intent(inout), target :: currentSite ! site object + type(bc_in_type), intent(in) :: bc_in ! BC in object + ! LOCALS: + type (fates_patch_type), pointer :: currentPatch ! patch object - type(ed_site_type) , intent(inout), target :: currentSite - type(bc_in_type) , intent(in) :: bc_in - - - type (fates_patch_type), pointer :: currentPatch - - !zero fire things + ! zero fire things currentPatch => currentSite%youngest_patch do while(associated(currentPatch)) - currentPatch%frac_burnt = 0.0_r8 - currentPatch%fire = 0 - currentPatch => currentPatch%older - enddo - - if(write_SF==itrue)then - write(fates_log(),*) 'spitfire_mode', hlm_spitfire_mode - endif - - if( hlm_spitfire_mode > hlm_sf_nofire_def )then - call fire_danger_index(currentSite, bc_in) - call wind_effect(currentSite, bc_in) - call charecteristics_of_fuel(currentSite) - call rate_of_spread(currentSite) - call ground_fuel_consumption(currentSite) - call area_burnt_intensity(currentSite, bc_in) - call crown_scorching(currentSite) - call crown_damage(currentSite) - call cambial_damage_kill(currentSite) - call post_fire_mortality(currentSite) + currentPatch%frac_burnt = 0.0_r8 + currentPatch%fire = 0 + currentPatch => currentPatch%older + end do + + if (hlm_spitfire_mode > hlm_sf_nofire_def) then + call UpdateFireWeather(currentSite, bc_in) + call wind_effect(currentSite, bc_in) + call charecteristics_of_fuel(currentSite) + call rate_of_spread(currentSite) + call ground_fuel_consumption(currentSite) + call area_burnt_intensity(currentSite, bc_in) + call crown_scorching(currentSite) + call crown_damage(currentSite) + call cambial_damage_kill(currentSite) + call post_fire_mortality(currentSite) end if end subroutine fire_model - !***************************************************************** - subroutine fire_danger_index ( currentSite, bc_in) - - !***************************************************************** - ! currentSite%acc_NI is the accumulated Nesterov fire danger index - - use SFParamsMod, only : SF_val_fdi_a, SF_val_fdi_b - use FatesConstantsMod , only : tfrz => t_water_freeze_k_1atm - use FatesConstantsMod , only : sec_per_day - - type(ed_site_type) , intent(inout), target :: currentSite - type(bc_in_type) , intent(in) :: bc_in + !--------------------------------------------------------------------------------------- + + subroutine UpdateFireWeather(currentSite, bc_in) + ! + ! DESCRIPTION: + ! Updates the site's fire weather index - type(fates_patch_type), pointer :: currentPatch + use SFParamsMod, only : SF_val_fdi_a, SF_val_fdi_b + use FatesConstantsMod, only : tfrz => t_water_freeze_k_1atm + use FatesConstantsMod, only : sec_per_day - real(r8) :: temp_in_C ! daily averaged temperature in celcius - real(r8) :: rainfall ! daily precip in mm/day - real(r8) :: rh ! daily rh - - real(r8) :: yipsolon !intermediate varable for dewpoint calculation - real(r8) :: dewpoint !dewpoint in K - real(r8) :: d_NI !daily change in Nesterov Index. C^2 - integer :: iofp ! index of oldest the fates patch + ! ARGUMENTS: + type(ed_site_type), intent(inout), target :: currentSite + type(bc_in_type), intent(in) :: bc_in + + ! LOCALS: + type(fates_patch_type), pointer :: currentPatch ! patch object + real(r8) :: temp_C ! daily averaged temperature [deg C] + real(r8) :: precip ! daily precip [mm/day] + real(r8) :: rh ! daily relative humidity [%] + real(r8) :: wind ! wind speed [m/s] + integer :: iofp ! index of oldest the fates patch ! NOTE that the boundary conditions of temperature, precipitation and relative humidity ! are available at the patch level. We are currently using a simplification where the whole site ! is simply using the values associated with the first patch. - ! which probably won't have much inpact, unless we decide to ever calculated the NI for each patch. + ! which probably won't have much inpact, unless we decide to ever calculated fire weather for each patch. currentPatch => currentSite%oldest_patch @@ -152,30 +144,20 @@ subroutine fire_danger_index ( currentSite, bc_in) endif iofp = currentPatch%patchno - - temp_in_C = currentPatch%tveg24%GetMean() - tfrz - rainfall = bc_in%precip24_pa(iofp)*sec_per_day - rh = bc_in%relhumid24_pa(iofp) - - if (rainfall > 3.0_r8) then !rezero NI if it rains... - d_NI = 0.0_r8 - currentSite%acc_NI = 0.0_r8 - else - yipsolon = (SF_val_fdi_a* temp_in_C)/(SF_val_fdi_b+ temp_in_C)+log(max(1.0_r8,rh)/100.0_r8) - dewpoint = (SF_val_fdi_b*yipsolon)/(SF_val_fdi_a-yipsolon) !Standard met. formula - d_NI = ( temp_in_C-dewpoint)* temp_in_C !follows Nesterov 1968. Equation 5. Thonicke et al. 2010. - if (d_NI < 0.0_r8) then !Change in NI cannot be negative. - d_NI = 0.0_r8 !check - endif - endif - currentSite%acc_NI = currentSite%acc_NI + d_NI !Accumulate Nesterov index over the fire season. + temp_C = currentPatch%tveg24%GetMean() - tfrz + precip = bc_in%precip24_pa(iofp)*sec_per_day + rh = bc_in%relhumid24_pa(iofp) + wind = bc_in%wind24_pa(iofp) - end subroutine fire_danger_index + ! update fire weather index + currentSite%fireWeather%Update(temp_C, precip, rh, wind) + currentSite%acc_ni = currentSite%fireWeather%fire_weather_index + end subroutine UpdateFireWeather + + !--------------------------------------------------------------------------------------- - !***************************************************************** subroutine charecteristics_of_fuel ( currentSite ) - !***************************************************************** use SFParamsMod, only : SF_val_drying_ratio, SF_val_SAV, SF_val_FBD diff --git a/main/EDTypesMod.F90 b/main/EDTypesMod.F90 index 7203457fd7..e22c98fdcd 100644 --- a/main/EDTypesMod.F90 +++ b/main/EDTypesMod.F90 @@ -341,7 +341,7 @@ module EDTypesMod real(r8) :: fdi ! daily probability an ignition event will start a fire real(r8) :: NF ! daily ignitions in km2 real(r8) :: NF_successful ! daily ignitions in km2 that actually lead to fire - type(fire_weather) :: fireWeather + class(fire_weather), pointer :: fireWeather ! fire weather object ! PLANT HYDRAULICS type(ed_site_hydr_type), pointer :: si_hydr From 9e863c8d0557ed1e6b70ed2782d3ae4d0ffe78ad Mon Sep 17 00:00:00 2001 From: adrifoster Date: Tue, 12 Mar 2024 16:45:57 -0600 Subject: [PATCH 062/176] bug fix --- fire/SFMainMod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/fire/SFMainMod.F90 b/fire/SFMainMod.F90 index af59517004..69c77c913c 100644 --- a/fire/SFMainMod.F90 +++ b/fire/SFMainMod.F90 @@ -150,7 +150,7 @@ subroutine UpdateFireWeather(currentSite, bc_in) wind = bc_in%wind24_pa(iofp) ! update fire weather index - currentSite%fireWeather%Update(temp_C, precip, rh, wind) + call currentSite%fireWeather%Update(temp_C, precip, rh, wind) currentSite%acc_ni = currentSite%fireWeather%fire_weather_index end subroutine UpdateFireWeather From 055fd0098d38f2b48b509307dcc8ead7d8adacbf Mon Sep 17 00:00:00 2001 From: adrifoster Date: Tue, 12 Mar 2024 19:19:40 -0600 Subject: [PATCH 063/176] change acc_ni to nesterov --- fire/SFMainMod.F90 | 11 ++++++----- main/EDInitMod.F90 | 4 ---- main/EDTypesMod.F90 | 1 - main/FatesHistoryInterfaceMod.F90 | 2 +- main/FatesRestartInterfaceMod.F90 | 12 ++++++------ 5 files changed, 13 insertions(+), 17 deletions(-) diff --git a/fire/SFMainMod.F90 b/fire/SFMainMod.F90 index 69c77c913c..b5b9ad0ce6 100644 --- a/fire/SFMainMod.F90 +++ b/fire/SFMainMod.F90 @@ -151,7 +151,6 @@ subroutine UpdateFireWeather(currentSite, bc_in) ! update fire weather index call currentSite%fireWeather%Update(temp_C, precip, rh, wind) - currentSite%acc_ni = currentSite%fireWeather%fire_weather_index end subroutine UpdateFireWeather @@ -247,19 +246,21 @@ subroutine charecteristics_of_fuel ( currentSite ) ! Calculate fuel moisture for trunks to hold value for fuel consumption alpha_FMC(tw_sf:dl_sf) = SF_val_SAV(tw_sf:dl_sf)/SF_val_drying_ratio - fuel_moisture(tw_sf:dl_sf) = exp(-1.0_r8 * alpha_FMC(tw_sf:dl_sf) * currentSite%acc_NI) + fuel_moisture(tw_sf:dl_sf) = exp(-1.0_r8 * alpha_FMC(tw_sf:dl_sf) * & + currentSite%fireWeather%fire_weather_index) if(write_SF == itrue)then if ( hlm_masterproc == itrue ) write(fates_log(),*) 'ff3 ',currentPatch%fuel_frac if ( hlm_masterproc == itrue ) write(fates_log(),*) 'fm ',fuel_moisture - if ( hlm_masterproc == itrue ) write(fates_log(),*) 'csa ',currentSite%acc_NI + if ( hlm_masterproc == itrue ) write(fates_log(),*) 'csa ',currentSite%fireWeather%fire_weather_index if ( hlm_masterproc == itrue ) write(fates_log(),*) 'sfv ',alpha_FMC endif ! live grass moisture is a function of SAV and changes via Nesterov Index ! along the same relationship as the 1 hour fuels (live grass has same SAV as dead grass, ! but retains more moisture with this calculation.) - fuel_moisture(lg_sf) = exp(-1.0_r8 * ((SF_val_SAV(tw_sf)/SF_val_drying_ratio) * currentSite%acc_NI)) + fuel_moisture(lg_sf) = exp(-1.0_r8 * ((SF_val_SAV(tw_sf)/SF_val_drying_ratio) * & + currentSite%fireWeather%fire_weather_index)) ! Average properties over the first three litter pools (twigs, s branches, l branches) currentPatch%fuel_bulkd = sum(currentPatch%fuel_frac(tw_sf:lb_sf) * SF_val_FBD(tw_sf:lb_sf)) @@ -715,7 +716,7 @@ subroutine area_burnt_intensity ( currentSite, bc_in ) ! force ignition potential to be extreme cloud_to_ground_strikes = 1.0_r8 ! cloud_to_ground = 1 = use 100% incoming observed ignitions else ! USING LIGHTNING DATA - currentSite%FDI = 1.0_r8 - exp(-SF_val_fdi_alpha*currentSite%acc_NI) + currentSite%FDI = 1.0_r8 - exp(-SF_val_fdi_alpha*currentSite%fireWeather%fire_weather_index) cloud_to_ground_strikes = cg_strikes end if diff --git a/main/EDInitMod.F90 b/main/EDInitMod.F90 index 25ffbbdf19..e33ee5e7ec 100644 --- a/main/EDInitMod.F90 +++ b/main/EDInitMod.F90 @@ -274,7 +274,6 @@ subroutine zero_site( site_in ) site_in%disturbance_rates(:,:,:) = 0.0_r8 ! FIRE - site_in%acc_ni = 0.0_r8 ! daily nesterov index accumulating over time. time unlimited theoretically. site_in%FDI = 0.0_r8 ! daily fire danger index (0-1) site_in%NF = 0.0_r8 ! daily lightning strikes per km2 site_in%NF_successful = 0.0_r8 ! daily successful iginitions per km2 @@ -373,7 +372,6 @@ subroutine set_site_properties( nsites, sites,bc_in ) integer :: cstat ! cold status phenology flag real(r8) :: GDD integer :: dstat ! drought status phenology flag - real(r8) :: acc_NI real(r8) :: liqvolmem real(r8) :: smpmem real(r8) :: elong_factor ! Elongation factor (0 - fully off; 1 - fully on) @@ -405,7 +403,6 @@ subroutine set_site_properties( nsites, sites,bc_in ) cndleafon = 0 cndleafoff = 0 cstat = phen_cstat_notcold ! Leaves are on - acc_NI = 0.0_r8 dstat = phen_dstat_moiston ! Leaves are on dleafoff = 300 dleafon = 100 @@ -440,7 +437,6 @@ subroutine set_site_properties( nsites, sites,bc_in ) sites(s)%dstatus(1:numpft) = dstat sites(s)%elong_factor(1:numpft) = elong_factor - 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 diff --git a/main/EDTypesMod.F90 b/main/EDTypesMod.F90 index e22c98fdcd..c3f71d6ff8 100644 --- a/main/EDTypesMod.F90 +++ b/main/EDTypesMod.F90 @@ -337,7 +337,6 @@ module EDTypesMod ! FIRE real(r8) :: wind ! daily wind in m/min for Spitfire units - real(r8) :: acc_ni ! daily nesterov index accumulating over time. real(r8) :: fdi ! daily probability an ignition event will start a fire real(r8) :: NF ! daily ignitions in km2 real(r8) :: NF_successful ! daily ignitions in km2 that actually lead to fire diff --git a/main/FatesHistoryInterfaceMod.F90 b/main/FatesHistoryInterfaceMod.F90 index 71013177ec..9edabe933a 100644 --- a/main/FatesHistoryInterfaceMod.F90 +++ b/main/FatesHistoryInterfaceMod.F90 @@ -2734,7 +2734,7 @@ subroutine update_history_dyn(this,nc,nsites,sites,bc_in) ! site-level fire variables: ! Nesterov index (unitless) - hio_nesterov_fire_danger_si(io_si) = sites(s)%acc_NI + hio_nesterov_fire_danger_si(io_si) = sites(s)%fireWeather%fire_weather_index ! number of ignitions [#/km2/day -> #/m2/s] hio_fire_nignitions_si(io_si) = sites(s)%NF_successful / m2_per_km2 / & diff --git a/main/FatesRestartInterfaceMod.F90 b/main/FatesRestartInterfaceMod.F90 index 90e282253b..ffef39eb6f 100644 --- a/main/FatesRestartInterfaceMod.F90 +++ b/main/FatesRestartInterfaceMod.F90 @@ -99,7 +99,7 @@ module FatesRestartInterfaceMod integer :: ir_cndaysleafon_si integer :: ir_cndaysleafoff_si integer :: ir_phenmodeldate_si - integer :: ir_acc_ni_si + integer :: ir_fireweather_index_si integer :: ir_gdd_si integer :: ir_snow_depth_si integer :: ir_trunk_product_si @@ -704,7 +704,7 @@ subroutine define_restart_vars(this, initialize_variables) call this%set_restart_var(vname='fates_acc_nesterov_id', vtype=site_r8, & long_name='a nesterov index accumulator', units='unitless', flushval = flushzero, & - hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_acc_ni_si ) + hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_fireweather_index_si ) call this%set_restart_var(vname='fates_gdd_site', vtype=site_r8, & long_name='growing degree days at each site', units='degC days', flushval = flushzero, & @@ -2034,7 +2034,7 @@ subroutine set_restart_vectors(this,nc,nsites,sites) rio_cndaysleafon_si => this%rvars(ir_cndaysleafon_si)%int1d, & rio_cndaysleafoff_si => this%rvars(ir_cndaysleafoff_si)%int1d, & rio_phenmodeldate_si => this%rvars(ir_phenmodeldate_si)%int1d, & - rio_acc_ni_si => this%rvars(ir_acc_ni_si)%r81d, & + rio_fireweather_index_si => this%rvars(ir_fireweather_index_si)%r81d, & rio_gdd_si => this%rvars(ir_gdd_si)%r81d, & rio_snow_depth_si => this%rvars(ir_snow_depth_si)%r81d, & rio_trunk_product_si => this%rvars(ir_trunk_product_si)%r81d, & @@ -2638,7 +2638,7 @@ subroutine set_restart_vectors(this,nc,nsites,sites) - rio_acc_ni_si(io_idx_si) = sites(s)%acc_NI + rio_fireweather_index_si(io_idx_si) = sites(s)%fireWeather%fire_weather_index rio_snow_depth_si(io_idx_si) = sites(s)%snow_depth ! Accumulated trunk product @@ -3001,7 +3001,7 @@ subroutine get_restart_vectors(this, nc, nsites, sites) rio_cndaysleafon_si => this%rvars(ir_cndaysleafon_si)%int1d, & rio_cndaysleafoff_si => this%rvars(ir_cndaysleafoff_si)%int1d, & rio_phenmodeldate_si => this%rvars(ir_phenmodeldate_si)%int1d, & - rio_acc_ni_si => this%rvars(ir_acc_ni_si)%r81d, & + rio_fireweather_index_si => this%rvars(ir_fireweather_index_si)%r81d, & rio_gdd_si => this%rvars(ir_gdd_si)%r81d, & rio_snow_depth_si => this%rvars(ir_snow_depth_si)%r81d, & rio_trunk_product_si => this%rvars(ir_trunk_product_si)%r81d, & @@ -3643,7 +3643,7 @@ subroutine get_restart_vectors(this, nc, nsites, sites) - sites(s)%acc_NI = rio_acc_ni_si(io_idx_si) + sites(s)%fireWeather%fire_weather_index = rio_fireweather_index_si(io_idx_si) sites(s)%snow_depth = rio_snow_depth_si(io_idx_si) sites(s)%resources_management%trunk_product_site = rio_trunk_product_si(io_idx_si) From 9d2724488738d30188571553c81f4254525516f4 Mon Sep 17 00:00:00 2001 From: adrifoster Date: Tue, 12 Mar 2024 21:55:10 -0600 Subject: [PATCH 064/176] add unit test --- CMakeLists.txt | 74 +++++++++++++++++++ biogeochem/CMakeLists.txt | 9 +++ biogeophys/CMakeLists.txt | 5 ++ fire/CMakeLists.txt | 8 ++ fire/{SFNestorvMod.F90 => SFNesterovMod.F90} | 0 fire/SFParamsMod.F90 | 4 +- fire/test/CMakeLists.txt | 1 + fire/test/fire_weather_test/CMakeLists.txt | 5 ++ .../fire_weather_test/test_FireWeather.pf | 70 ++++++++++++++++++ main/CMakeLists.txt | 17 +++++ parteh/CMakeLists.txt | 8 ++ radiation/CMakeLists.txt | 6 ++ 12 files changed, 205 insertions(+), 2 deletions(-) create mode 100644 CMakeLists.txt create mode 100644 biogeochem/CMakeLists.txt create mode 100644 biogeophys/CMakeLists.txt create mode 100644 fire/CMakeLists.txt rename fire/{SFNestorvMod.F90 => SFNesterovMod.F90} (100%) create mode 100644 fire/test/CMakeLists.txt create mode 100644 fire/test/fire_weather_test/CMakeLists.txt create mode 100644 fire/test/fire_weather_test/test_FireWeather.pf create mode 100644 parteh/CMakeLists.txt create mode 100644 radiation/CMakeLists.txt diff --git a/CMakeLists.txt b/CMakeLists.txt new file mode 100644 index 0000000000..5d37d14a81 --- /dev/null +++ b/CMakeLists.txt @@ -0,0 +1,74 @@ +cmake_minimum_required(VERSION 3.4) + +list(APPEND CMAKE_MODULE_PATH ${CIME_CMAKE_MODULE_DIRECTORY}) +include(CIME_initial_setup) + +project(FATES_tests Fortran C) + +include(CIME_utils) + +set(HLM_ROOT "../../") + +# Add source directories from other share code (csm_share, etc.) +add_subdirectory(${HLM_ROOT}/share/src csm_share) +add_subdirectory(${HLM_ROOT}/share/unit_test_stubs/util csm_share_stubs) + +# Add FATES source directories +add_subdirectory(${HLM_ROOT}/src/fates/main fates_main) +add_subdirectory(${HLM_ROOT}/src/fates/biogeochem fates_biogeochem) +add_subdirectory(${HLM_ROOT}/src/fates/biogeophys fates_biogeophys) +add_subdirectory(${HLM_ROOT}/src/fates/parteh fates_parteh) +add_subdirectory(${HLM_ROOT}/src/fates/fire fates_fire) +add_subdirectory(${HLM_ROOT}/src/fates/radiation fates_radiation) + +# Remove shr_mpi_mod from share_sources. +# This is needed because we want to use the mock shr_mpi_mod in place of the real one +# +# TODO: this should be moved into a general-purpose function in Sourcelist_utils. +# Then this block of code could be replaced with a single call, like: +# remove_source_file(${share_sources} "shr_mpi_mod.F90") +foreach (sourcefile ${share_sources}) + string(REGEX MATCH "shr_mpi_mod.F90" match_found ${sourcefile}) + if(match_found) + list(REMOVE_ITEM share_sources ${sourcefile}) + endif() +endforeach() + +# Remove shr_cal_mod from share_sources. +# +# shr_cal_mod depends on ESMF (or the lightweight esmf wrf timemgr, at +# least). Since CTSM doesn't currently use shr_cal_mod, we're avoiding +# the extra overhead of including esmf_wrf_timemgr sources in this +# build. +# +# TODO: like above, this should be moved into a general-purpose function +# in Sourcelist_utils. Then this block of code could be replaced with a +# single call, like: remove_source_file(${share_sources} +# "shr_cal_mod.F90") +foreach (sourcefile ${share_sources}) + string(REGEX MATCH "shr_cal_mod.F90" match_found ${sourcefile}) + if(match_found) + list(REMOVE_ITEM share_sources ${sourcefile}) + endif() +endforeach() + +# Build libraries containing stuff needed for the unit tests. +# Eventually, these add_library calls should probably be distributed into the correct location, rather than being in this top-level CMakeLists.txt file. +add_library(csm_share ${share_sources}) +declare_generated_dependencies(csm_share "${share_genf90_sources}") +add_library(fates ${fates_sources}) +add_dependencies(fates csm_share) + +# We need to look for header files here, in order to pick up shr_assert.h +include_directories(${HLM_ROOT}/share/include) + +# Tell cmake to look for libraries & mod files here, because this is where we built libraries +include_directories(${CMAKE_CURRENT_BINARY_DIR}) +link_directories(${CMAKE_CURRENT_BINARY_DIR}) + +# Add the test directories +# Note: it's possible that these could be added by each source directory that +# has tests in it. However, it appears that the order needs to be done +# carefully: for example, include_directories and link_directories needs to be +# done before adding the tests themselves. +add_subdirectory(${HLM_ROOT}/src/fates/fire/test fates_fire_test) \ No newline at end of file diff --git a/biogeochem/CMakeLists.txt b/biogeochem/CMakeLists.txt new file mode 100644 index 0000000000..7cea7da00e --- /dev/null +++ b/biogeochem/CMakeLists.txt @@ -0,0 +1,9 @@ +list(APPEND fates_sources + FatesLitterMod.F90 + FatesCohortMod.F90 + FatesAllometryMod.F90 + DamageMainMod.F90 + FatesPatchMod.F90 + ) + +sourcelist_to_parent(fates_sources) \ No newline at end of file diff --git a/biogeophys/CMakeLists.txt b/biogeophys/CMakeLists.txt new file mode 100644 index 0000000000..a4252bcabf --- /dev/null +++ b/biogeophys/CMakeLists.txt @@ -0,0 +1,5 @@ +list(APPEND fates_sources + FatesHydroWTFMod.F90 + ) + +sourcelist_to_parent(fates_sources) \ No newline at end of file diff --git a/fire/CMakeLists.txt b/fire/CMakeLists.txt new file mode 100644 index 0000000000..0dff75efeb --- /dev/null +++ b/fire/CMakeLists.txt @@ -0,0 +1,8 @@ +list(APPEND fates_sources + SFMainMod.F90 + SFParamsMod.F90 + SFFireWeatherMod.F90 + SFNesterovMod.F90 + ) + +sourcelist_to_parent(fates_sources) \ No newline at end of file diff --git a/fire/SFNestorvMod.F90 b/fire/SFNesterovMod.F90 similarity index 100% rename from fire/SFNestorvMod.F90 rename to fire/SFNesterovMod.F90 diff --git a/fire/SFParamsMod.F90 b/fire/SFParamsMod.F90 index 306034a804..e07777f25d 100644 --- a/fire/SFParamsMod.F90 +++ b/fire/SFParamsMod.F90 @@ -19,8 +19,8 @@ module SFParamsMod ! this is what the user can use for the actual values ! - real(r8),protected, public :: SF_val_fdi_a - real(r8),protected, public :: SF_val_fdi_b + real(r8), public :: SF_val_fdi_a + real(r8), public :: SF_val_fdi_b real(r8),protected, public :: SF_val_fdi_alpha real(r8),protected, public :: SF_val_miner_total real(r8),protected, public :: SF_val_fuel_energy diff --git a/fire/test/CMakeLists.txt b/fire/test/CMakeLists.txt new file mode 100644 index 0000000000..4dcfa244d4 --- /dev/null +++ b/fire/test/CMakeLists.txt @@ -0,0 +1 @@ +add_subdirectory(fire_weather_test) \ No newline at end of file diff --git a/fire/test/fire_weather_test/CMakeLists.txt b/fire/test/fire_weather_test/CMakeLists.txt new file mode 100644 index 0000000000..2a3554cd86 --- /dev/null +++ b/fire/test/fire_weather_test/CMakeLists.txt @@ -0,0 +1,5 @@ +set(pfunit_sources test_FireWeather.pf) + +add_pfunit_ctest(FireWeather + TEST_SOURCES "${pfunit_sources}" + LINK_LIBRARIES fates csm_share) \ No newline at end of file diff --git a/fire/test/fire_weather_test/test_FireWeather.pf b/fire/test/fire_weather_test/test_FireWeather.pf new file mode 100644 index 0000000000..21338b5f90 --- /dev/null +++ b/fire/test/fire_weather_test/test_FireWeather.pf @@ -0,0 +1,70 @@ +module test_FireWeather + ! + ! DESCRIPTION: + ! Test the FATES fire weather portion of the SPITFIRE model + ! + use FatesConstantsMod, only : r8 => fates_r8 + use SFFireWeatherMod, only : fire_weather + use SFNesterovMod, only : nesterov_index + use SFParamsMod, only : SF_val_fdi_a, SF_val_fdi_b + use funit + + implicit none + + @TestCase + type, extends(TestCase) :: TestFireWeather + + class(fire_weather), allocatable :: fireWeatherNesterov + + contains + procedure :: setUp + procedure :: tearDown + end type TestFireWeather + + real(r8), parameter :: tol = 1.e-13_r8 + + contains + + subroutine setUp(this) + class(TestFireWeather), intent(inout) :: this + allocate(nesterov_index :: this%fireWeatherNesterov) + call this%fireWeatherNesterov%Init() + SF_val_fdi_a = 17.62_r8 + SF_val_fdi_b = 243.12_r8 + end subroutine setUp + + subroutine tearDown(this) + class(TestFireWeather), intent(inout) :: this + if (allocated(this%fireWeatherNesterov)) deallocate(this%fireWeatherNesterov) + end subroutine tearDown + + @Test + subroutine zero_NI_rain(this) + ! test that over 3 mm of rain is 0.0 + class(TestFireWeather), intent(inout) :: this ! fire weather object + + call this%fireWeatherNesterov%Update(25.0_r8, 3.1_r8, 10.0_r8, 0.0_r8) + @assertEqual(this%fireWeatherNesterov%fire_weather_index, 0.0_r8, tolerance=tol) + this%fireWeatherNesterov%fire_weather_index = 0.0_r8 + end subroutine zero_NI_rain + + @Test + subroutine NI_rain_min(this) + ! test that at 3 mm is over zero + class(TestFireWeather), intent(inout) :: this ! fire weather object + + call this%fireWeatherNesterov%Update(25.0_r8, 3.0_r8, 10.0_r8, 0.0_r8) + @assertGreaterThan(this%fireWeatherNesterov%fire_weather_index, 0.0_r8, tolerance=tol) + this%fireWeatherNesterov%fire_weather_index = 0.0_r8 + end subroutine NI_rain_min + + @Test + subroutine NI_not_negative(this) + ! test that NI is not negative + class(TestFireWeather), intent(inout) :: this ! fire weather object + + call this%fireWeatherNesterov%Update(-30.0_r8, 0.0_r8, 99.0_r8, 0.0_r8) + @assertEqual(this%fireWeatherNesterov%fire_weather_index, 0.0_r8, tolerance=tol) + end subroutine NI_not_negative + + end module test_FireWeather \ No newline at end of file diff --git a/main/CMakeLists.txt b/main/CMakeLists.txt index dfd5eaba2a..d2be271c71 100644 --- a/main/CMakeLists.txt +++ b/main/CMakeLists.txt @@ -11,4 +11,21 @@ list(APPEND clm_sources FatesUtilsMod.F90 ) +list(APPEND fates_sources + FatesConstantsMod.F90 + FatesGlobals.F90 + FatesParametersInterface.F90 + FatesInterfaceTypesMod.F90 + EDTypesMod.F90 + FatesHydraulicsMemMod.F90 + FatesRunningMeanMod.F90 + EDParamsMod.F90 + FatesParameterDerivedMod.F90 + EDPftVarcon.F90 + FatesSizeAgeTypeIndicesMod.F90 + FatesIntegratorsMod.F90 + FatesUtilsMod.F90 + ) + +sourcelist_to_parent(fates_sources) sourcelist_to_parent(clm_sources) diff --git a/parteh/CMakeLists.txt b/parteh/CMakeLists.txt new file mode 100644 index 0000000000..bf9981b509 --- /dev/null +++ b/parteh/CMakeLists.txt @@ -0,0 +1,8 @@ +list(APPEND fates_sources + PRTGenericMod.F90 + PRTParametersMod.F90 + PRTAllometricCarbonMod.F90 + PRTAllometricCNPMod.F90 + ) + +sourcelist_to_parent(fates_sources) \ No newline at end of file diff --git a/radiation/CMakeLists.txt b/radiation/CMakeLists.txt new file mode 100644 index 0000000000..84e72877ec --- /dev/null +++ b/radiation/CMakeLists.txt @@ -0,0 +1,6 @@ +list(APPEND fates_sources + TwoStreamMLPEMod.F90 + FatesRadiationMemMod.F90 + ) + +sourcelist_to_parent(fates_sources) \ No newline at end of file From 1e1be1c64af0e686eead750d3e165870bcd5e5da Mon Sep 17 00:00:00 2001 From: adrifoster Date: Wed, 13 Mar 2024 09:41:18 -0600 Subject: [PATCH 065/176] update unit test --- CMakeLists.txt | 2 -- biogeochem/CMakeLists.txt | 4 ---- biogeophys/CMakeLists.txt | 5 ----- fire/CMakeLists.txt | 1 - main/CMakeLists.txt | 12 +----------- parteh/CMakeLists.txt | 8 -------- radiation/CMakeLists.txt | 1 - 7 files changed, 1 insertion(+), 32 deletions(-) delete mode 100644 biogeophys/CMakeLists.txt delete mode 100644 parteh/CMakeLists.txt diff --git a/CMakeLists.txt b/CMakeLists.txt index 5d37d14a81..00544cc654 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -16,8 +16,6 @@ add_subdirectory(${HLM_ROOT}/share/unit_test_stubs/util csm_share_stubs) # Add FATES source directories add_subdirectory(${HLM_ROOT}/src/fates/main fates_main) add_subdirectory(${HLM_ROOT}/src/fates/biogeochem fates_biogeochem) -add_subdirectory(${HLM_ROOT}/src/fates/biogeophys fates_biogeophys) -add_subdirectory(${HLM_ROOT}/src/fates/parteh fates_parteh) add_subdirectory(${HLM_ROOT}/src/fates/fire fates_fire) add_subdirectory(${HLM_ROOT}/src/fates/radiation fates_radiation) diff --git a/biogeochem/CMakeLists.txt b/biogeochem/CMakeLists.txt index 7cea7da00e..692e22d9dc 100644 --- a/biogeochem/CMakeLists.txt +++ b/biogeochem/CMakeLists.txt @@ -1,9 +1,5 @@ list(APPEND fates_sources FatesLitterMod.F90 - FatesCohortMod.F90 - FatesAllometryMod.F90 - DamageMainMod.F90 - FatesPatchMod.F90 ) sourcelist_to_parent(fates_sources) \ No newline at end of file diff --git a/biogeophys/CMakeLists.txt b/biogeophys/CMakeLists.txt deleted file mode 100644 index a4252bcabf..0000000000 --- a/biogeophys/CMakeLists.txt +++ /dev/null @@ -1,5 +0,0 @@ -list(APPEND fates_sources - FatesHydroWTFMod.F90 - ) - -sourcelist_to_parent(fates_sources) \ No newline at end of file diff --git a/fire/CMakeLists.txt b/fire/CMakeLists.txt index 0dff75efeb..2cd6b992d1 100644 --- a/fire/CMakeLists.txt +++ b/fire/CMakeLists.txt @@ -1,5 +1,4 @@ list(APPEND fates_sources - SFMainMod.F90 SFParamsMod.F90 SFFireWeatherMod.F90 SFNesterovMod.F90 diff --git a/main/CMakeLists.txt b/main/CMakeLists.txt index d2be271c71..173d5c9f45 100644 --- a/main/CMakeLists.txt +++ b/main/CMakeLists.txt @@ -10,21 +10,11 @@ list(APPEND clm_sources FatesParametersInterface.F90 FatesUtilsMod.F90 ) - + list(APPEND fates_sources FatesConstantsMod.F90 FatesGlobals.F90 FatesParametersInterface.F90 - FatesInterfaceTypesMod.F90 - EDTypesMod.F90 - FatesHydraulicsMemMod.F90 - FatesRunningMeanMod.F90 - EDParamsMod.F90 - FatesParameterDerivedMod.F90 - EDPftVarcon.F90 - FatesSizeAgeTypeIndicesMod.F90 - FatesIntegratorsMod.F90 - FatesUtilsMod.F90 ) sourcelist_to_parent(fates_sources) diff --git a/parteh/CMakeLists.txt b/parteh/CMakeLists.txt deleted file mode 100644 index bf9981b509..0000000000 --- a/parteh/CMakeLists.txt +++ /dev/null @@ -1,8 +0,0 @@ -list(APPEND fates_sources - PRTGenericMod.F90 - PRTParametersMod.F90 - PRTAllometricCarbonMod.F90 - PRTAllometricCNPMod.F90 - ) - -sourcelist_to_parent(fates_sources) \ No newline at end of file diff --git a/radiation/CMakeLists.txt b/radiation/CMakeLists.txt index 84e72877ec..7cb7a324c2 100644 --- a/radiation/CMakeLists.txt +++ b/radiation/CMakeLists.txt @@ -1,6 +1,5 @@ list(APPEND fates_sources TwoStreamMLPEMod.F90 - FatesRadiationMemMod.F90 ) sourcelist_to_parent(fates_sources) \ No newline at end of file From 07dc8c1174342a8593083ee16e14dda6343edba9 Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Mon, 25 Mar 2024 11:29:17 -0400 Subject: [PATCH 066/176] Adding simple tool to make unstructured grids --- tools/make_unstruct_grid/MakeUnstructGrid.py | 315 +++++++++++++++++++ tools/make_unstruct_grid/andes7x7.xml | 43 +++ 2 files changed, 358 insertions(+) create mode 100644 tools/make_unstruct_grid/MakeUnstructGrid.py create mode 100644 tools/make_unstruct_grid/andes7x7.xml diff --git a/tools/make_unstruct_grid/MakeUnstructGrid.py b/tools/make_unstruct_grid/MakeUnstructGrid.py new file mode 100644 index 0000000000..159fb92f8b --- /dev/null +++ b/tools/make_unstruct_grid/MakeUnstructGrid.py @@ -0,0 +1,315 @@ +import numpy as np +import xarray as xr +import matplotlib.pyplot as plt +import matplotlib +import matplotlib.dates as mdates +import sys +import code # For development: code.interact(local=locals()) code.interact(local=dict(globals(), **locals())) +import argparse +import math +from scipy.io import netcdf as nc +import xml.etree.ElementTree as et + +# The user specifies a couplet of domain/surface files +# from which they want to base their new unstructured grid. Then they provide +# a list of geographic coordinates in latitude and longitude. These coordinates +# are sampled from the base dataset, and written to an output dataset. +# +# This method is certainly useful for generating small sets of unstructured +# grid-cells. It may not be the best method for generating large sets. One +# may want to use "ncks" (ie Charlie Zender's NCO tools) for subsetting large +# grids. This method will arrange the new grid cells in a 1D vector, and assumes +# the input grids are based on a 2d array of cells. +# +# This method will assume that the grid-cell extents of the new unstructured grids +# match the extents of the base files. If you want finer or coarser resolution, +# just dig up a different base file. +# +# This method uses nearest neighbor. +# +# This may have trouble on newer surface files, particularly if they have topo +# unit information. It won't be difficult to add that type of functionality +# if it doesn't work, I (Ryan) just haven't tried it. +# +# All controls over this process can be found in the xml control file. See +# andes7x7.xml for an example. + +# Usage MakeUnstructGrid.py --fin=xmlfile.xml + +def TransferData(da_key,ds_base,ds_unst,minis,minjs,dset_type): + + print(' Transferring: {}'.format(da_key)) + + if(dset_type=='domain'): + xname = 'nj' + yname = 'ni' + ny = len(minis) #nj = len(minis) + nx = 1 #ni + nv = 4 + elif(dset_type=='surface'): + xname = 'lsmlat' + yname = 'lsmlon' + ny = len(minis) + nx = 1 + + #numurbl = 3 ; + #nlevurb = 5 ; + #numrad = 2 ; + #nchar = 256 ; + #nlevsoi = 10 ; + #time = UNLIMITED ; // (12 currently) + #lsmpft = 17 ; + #natpft = 17 ; + + + + # Determin the data type + if(ds_base[da_key].dtype == 'float64'): + dtype_out = np.float64 + elif(ds_base[da_key].dtype == 'int32'): + dtype_out = np.int32 + else: + print('unknown data type: {}.\n Exiting'.format(ds_base[da_key].dtype)) + exit(2) + + + + # The lat-lon is always the last two dimensions + # Time is always the first dimension + + # Check to see if this has spatial dimensions + dimlist = list(ds_base[da_key].dims) + + # 2D (nj,ni) + # (lsmlat,lsmlon) + # 3D (nj, ni, nv) + # (x, lsmlat, lsmlon) + # 4D (x,y,lsmlat, lsmlon) + + if(any([dim==xname for dim in dimlist]) and (len(dimlist)==2)): + + # This is 2D and they are or use geographic coordinates + + ds_unst[da_key] = \ + xr.DataArray(np.empty((nx,ny), dtype=dtype_out),dims=dimlist) + + for k in range(len(minis)): + i = minis[k] + j = minjs[k] + ds_unst[da_key].loc[0,k] = ds_base[da_key].data[j,i] + + elif(any([dim==xname for dim in dimlist]) and any([dim=='nv' for dim in dimlist]) ): + + # This is the 3D coordinate in the domain file for vertices + + ds_unst[da_key] = \ + xr.DataArray(np.empty((nx,ny,nv), dtype=dtype_out),dims=dimlist) + for k in range(len(minis)): + i = minis[k] + j = minjs[k] + ds_unst[da_key].loc[0,k,:] = ds_base[da_key].data[j,i,:] + + elif(any([dim==xname for dim in dimlist]) and len(dimlist)==3): + + # This has dim==3, surface file and contains coordinates (x,lsmlat, lsmlon) + + dim0 = ds_base.dims[dimlist[0]] + ds_unst[da_key] = \ + xr.DataArray(np.empty((dim0,nx,ny), dtype=dtype_out),dims=dimlist) + for k in range(len(minis)): + i = minis[k] + j = minjs[k] + ds_unst[da_key].loc[:,0,k] = ds_base[da_key].data[:,j,i] + + elif(any([dim==xname for dim in dimlist]) and len(dimlist)==4): + + # This has dim==4, surface file and contains coordinates (x,y,lsmlat, lsmlon) + + dim0 = ds_base.dims[dimlist[0]] + dim1 = ds_base.dims[dimlist[1]] + ds_unst[da_key] = \ + xr.DataArray(np.empty((dim0,dim1,nx,ny), dtype=dtype_out),dims=dimlist) + for k in range(len(minis)): + i = minis[k] + j = minjs[k] + ds_unst[da_key].loc[:,:,0,k] = ds_base[da_key].data[:,:,j,i] + + elif(len(dimlist)==1): + # If there is no spatial coordinate, then just copy over what is there + #dimsizes = tuple([ds_base.dims[txt] for txt in dimlist]) + #ds_unst[da_key] = \ + # xr.DataArray(np.empty(dimsizes,dtype=dtype_out),dims=dimlist) + #ds_unst[da_key].loc[:] = ds_base[da_key].data[:] + ds_unst[da_key] = ds_base[da_key] + else: + # If there is no spatial coordinate, then just copy over what is there + + ds_unst[da_key] = ds_base[da_key] + + + # Once the new dataarray is created, transfer over metadata from original + ds_unst[da_key].attrs = ds_base[da_key].attrs + + return(ds_unst) + + +def main(argv): + + parser = argparse.ArgumentParser(description='Parse command line arguments to this script.') + parser.add_argument('--fin', dest='xmlfile', type=str, help="path to the xml control file",required=True) + args = parser.parse_args() + + xmlroot = et.parse(args.xmlfile).getroot() + + print(' -------------------------------------------------------------- ') + print('\n Creating a new domain/surface couplet \n') + print(' --------------------------------------------------------------\n ') + + # Get the domain base name + try: + domain_base = xmlroot.find('domain_base').text.strip() + domain_base_file = domain_base.split('/')[-1] + + except: + print('Could not find xml entry: {}'.format('domain_base')) + exit(2) + + # Get the new unstructured domain name (ie output) + try: + domain_unst = xmlroot.find('domain_unst').text.strip() + except: + print('Could not find xml entry: {}'.format('domain_unst')) + exit(2) + + + # Get the surface base name + try: + surface_base = xmlroot.find('surface_base').text.strip() + surface_base_file = surface_base.split('/')[-1] + + except: + print('Could not find xml entry: {}'.format('surface_base')) + exit(2) + + # Get the new unstructured surface name (ie output) + try: + surface_unst = xmlroot.find('surface_unst').text.strip() + except: + print('Could not find xml entry: {}'.format('surface_unst')) + exit(2) + + + + # Get a list of lon coordinates (force them into 0-360 convention) + try: + lon_subset_text = xmlroot.find('lon_list').text.strip().split(',') + lon_subset = [] + for txt in lon_subset_text: + lon = float(txt) + if(lon<0.0): + lon = 360.0+lon + lon_subset.append(lon) + + except: + print('Could not find xml entry: {}'.format('lon_list')) + exit(2) + + # Get a list of lat coordinates + try: + lat_subset_text = xmlroot.find('lat_list').text.strip().split(',') + lat_subset = [float(txt) for txt in lat_subset_text] + + except: + print('Could not find xml entry: {}'.format('lat_list')) + exit(2) + + # Check to make sure that the lat and lons are same length + + if( len(lat_subset) != len(lon_subset) ): + print('number of latitude subset points must match number of longitude subsets') + exit(2) + else: + nj = len(lat_subset) + print(' Found N={} lat/lon coordinates'.format(nj)) + + + #code.interact(local=dict(globals(), **locals())) + # ------------------------------------------------------------------------------ + # >>> ds_domain_base.data_vars + # Data variables: + #xv (nj, ni, nv) float64 358.8 1.25 1.25 358.8 ... 358.7 358.7 356.2 + #yv (nj, ni, nv) float64 -90.0 -90.0 -89.05 -89.05 ... 89.05 90.0 90.0 + #mask (nj, ni) int32 1 1 1 1 1 1 1 1 1 1 1 1 ... 0 0 0 0 0 0 0 0 0 0 0 0 + #area (nj, ni) float64 5.964e-06 5.964e-06 ... 5.964e-06 5.964e-06 + #frac (nj, ni) float64 1.0 1.0 1.0 1.0 1.0 1.0 ... 0.0 0.0 0.0 0.0 0.0 + # >>> ds_domain_base.coords + #Coordinates: + # xc (nj, ni) float64 0.0 2.5 5.0 7.5 10.0 ... 350.0 352.5 355.0 357.5 + # yc (nj, ni) float64 -90.0 -90.0 -90.0 -90.0 ... 90.0 90.0 90.0 90.0 + # ------------------------------------------------------------------------------ + + lon_subset_faux_2d = np.reshape(lon_subset, (-1, 1)) + lat_subset_faux_2d = np.reshape(lat_subset, (-1, 1)) + + ds_domain_base = xr.open_dataset(domain_base) + + # Lets find the indices for xc and yc that most closely match our coordinates + minis = [] + minjs = [] + for j in range(nj): + lat = lat_subset[j] + lon = lon_subset[j] + delt = (ds_domain_base['xc'].data-lon)**2.0 + (ds_domain_base['yc'].data-lat)**2.0 + minj,mini = np.unravel_index(delt.argmin(), delt.shape) + minis.append(mini) + minjs.append(minj) + + # Domain Processing + # =========================================================================================== + # Initialize the new dataset + ds_domain_unst = xr.Dataset( + attrs=ds_domain_base.attrs, + ) + ds_domain_unst.attrs["modification"]="Modified with SurfToVec.py, based on {}.".format(domain_base_file) + + #ode.interact(local=dict(globals(), **locals())) + + # Loop through existing datasets, allocate new arrays + # and transfer over point data + for da_key in ds_domain_base.data_vars: + ds_domain_unst = TransferData(da_key,ds_domain_base,ds_domain_unst,minis,minjs,'domain') + + for da_key in ds_domain_base.coords: + ds_domain_unst = TransferData(da_key,ds_domain_base,ds_domain_unst,minis,minjs,'domain') + + print('\n Writing: {}'.format(domain_unst)) + ds_domain_unst.to_netcdf(domain_unst) #,mode='a') + + # Surface Processing + # =========================================================================================== + + ds_surface_base = xr.open_dataset(surface_base) + + # Initialize the new dataset + ds_surface_unst = xr.Dataset( + attrs=ds_surface_base.attrs, + ) + ds_surface_unst.attrs["modification"]="Modified with SurfToVec.py, based on {}.".format(surface_base_file) + + + # Loop through existing datasets, allocate new arrays + # and transfer over point data + for da_key in ds_surface_base.data_vars: + ds_surface_unst = TransferData(da_key,ds_surface_base,ds_surface_unst,minis,minjs,'surface') + + for da_key in ds_surface_base.coords: + ds_surface_unst = TransferData(da_key,ds_surface_base,ds_surface_unst,minis,minjs,'surface') + + print('\n Writing: {}'.format(surface_unst)) + ds_surface_unst.to_netcdf(surface_unst) #,mode='a') + + print('\n') + +# This is the actual call to main +if __name__ == "__main__": + main(sys.argv) diff --git a/tools/make_unstruct_grid/andes7x7.xml b/tools/make_unstruct_grid/andes7x7.xml new file mode 100644 index 0000000000..ae99882ccd --- /dev/null +++ b/tools/make_unstruct_grid/andes7x7.xml @@ -0,0 +1,43 @@ + + + + + + + + Bases/domain.lnd.fv1.9x2.5_gx1v6.090206.nc + Bases/surfdata_1.9x2.5_simyr2000_c180306.nc + + + SAHydroStress/domain.lnd.fv1.9x2.5_gx1v6_SAHydroStress_c240320.nc + SAHydroStress/surfdata_1.9x2.5_simyr2000_SAHydroStress_c240320.nc + + + + -19.8947368421, -19.8947368421, -19.8947368421, + -18, -18, -18, -18, + -16.1052631579, -16.1052631579, -16.1052631579, -16.1052631579, -16.1052631579, + -14.2105263158, -14.2105263158, -14.2105263158, -14.2105263158, -14.2105263158, + -12.3157894737, -12.3157894737, -12.3157894737, -12.3157894737, -12.3157894737, -12.3157894737, + -10.4210526316, -10.4210526316, -10.4210526316, -10.4210526316, -10.4210526316, -10.4210526316, + -8.52631578947, -8.52631578947, -8.52631578947, -8.52631578947, -8.52631578947, -8.52631578947, -8.52631578947 + + + + + + 290, 292.5, 295, + 287.5, 290, 292.5, 295, + 285, 287.5, 290, 292.5, 295, + 285, 287.5, 290, 292.5, 295, + 282.5, 285, 287.5, 290, 292.5, 295, + 282.5, 285, 287.5, 290, 292.5, 295, + 280, 282.5, 285, 287.5, 290, 292.5, 295 + + + From 2ade2b15244e3d25a40018df9dd4cc8981a080ae Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Tue, 2 Apr 2024 14:33:24 -0700 Subject: [PATCH 067/176] 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 068/176] 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 069/176] 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 070/176] 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 071/176] 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 072/176] 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 94028398c20894bcc136b0eeb6a47d26903a71ed Mon Sep 17 00:00:00 2001 From: Marcos Longo Date: Mon, 8 Apr 2024 13:52:09 -0400 Subject: [PATCH 073/176] Revision of some error message output for inventory initialisation, so it is more informative. --- main/FatesInventoryInitMod.F90 | 19 +++++++++++++------ 1 file changed, 13 insertions(+), 6 deletions(-) diff --git a/main/FatesInventoryInitMod.F90 b/main/FatesInventoryInitMod.F90 index 61f77387f4..22a48537b5 100644 --- a/main/FatesInventoryInitMod.F90 +++ b/main/FatesInventoryInitMod.F90 @@ -686,7 +686,7 @@ subroutine set_inventory_patch_type1(newpatch,pss_file_unit,ipa,ios,patch_name) type(litter_type),pointer :: litt integer :: el ! index for elements real(r8) :: p_time ! Time patch was recorded - real(r8) :: p_trk ! Land Use index (see above descriptions) + integer :: p_trk ! Land Use index (see above descriptions) character(len=patchname_strlen) :: p_name ! unique string identifier of patch real(r8) :: p_age ! Patch age [years] real(r8) :: p_area ! Patch area [fraction] @@ -694,9 +694,10 @@ subroutine set_inventory_patch_type1(newpatch,pss_file_unit,ipa,ios,patch_name) integer :: ipft ! index for counting PFTs real(r8) :: pftfrac ! the inverse of the total number of PFTs - character(len=128),parameter :: wr_fmt = & - '(F5.2,2X,A4,2X,F5.2,2X,F5.2,2X,F5.2,2X,F5.2,2X,F5.2,2X,F5.2,2X,F5.2,2X,F5.2,2X,F5.2,2X,F5.2,2X,F5.2)' - + character(len=30),parameter :: hd_fmt = & + '(A5,2X,A20,2X,A4,2X,A5,2X,A17)' + character(len=47),parameter :: wr_fmt = & + '(F5.2,2X,A20,2X,I4,2X,F5.2,2X,F17.14)' read(pss_file_unit,fmt=*,iostat=ios) p_time, p_name, p_trk, p_age, p_area @@ -705,6 +706,8 @@ subroutine set_inventory_patch_type1(newpatch,pss_file_unit,ipa,ios,patch_name) patch_name = trim(p_name) if( debug_inv) then + write(*,fmt=hd_fmt) & + ' time',' patch',' trk',' age',' area' write(*,fmt=wr_fmt) & p_time, p_name, p_trk, p_age, p_area end if @@ -828,8 +831,10 @@ subroutine set_inventory_cohort_type1(csite,bc_in,css_file_unit,npatches, & real(r8) :: stem_drop_fraction ! Stem abscission fraction integer :: i_pft, ncohorts_to_create - character(len=128),parameter :: wr_fmt = & - '(F7.1,2X,A20,2X,A20,2X,F5.2,2X,F5.2,2X,I4,2X,F5.2,2X,F5.2,2X,F5.2,2X,F5.2)' + character(len=35),parameter :: hd_fmt = & + '(A7,2X,A20,2X,A5,2X,A6,2X,A4,2X,A9)' + character(len=43),parameter :: wr_fmt = & + '(F7.1,2X,A20,2X,F5.2,2X,F6.2,2X,I4,2X,F9.6)' real(r8), parameter :: abnormal_large_nplant = 1000.0_r8 ! Used to catch bad values real(r8), parameter :: abnormal_large_dbh = 500.0_r8 ! I've never heard of a tree > 3m @@ -858,6 +863,8 @@ subroutine set_inventory_cohort_type1(csite,bc_in,css_file_unit,npatches, & if(.not.matched_patch)then write(fates_log(), *) 'could not match a cohort with a patch' + write(fates_log(),fmt=hd_fmt) & + ' time',' patch',' dbh','height',' pft',' nplant' write(fates_log(),fmt=wr_fmt) & c_time, p_name, c_dbh, c_height, c_pft, c_nplant call endrun(msg=errMsg(sourcefile, __LINE__)) From 2a5b19f749412f6824e98f17fe73a873a50de22a Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Thu, 11 Apr 2024 10:16:51 -0700 Subject: [PATCH 074/176] 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 075/176] 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 076/176] 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 077/176] 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 078/176] 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 81f04e39899d7c42100fd55d3c0d490f985e64b5 Mon Sep 17 00:00:00 2001 From: adrifoster Date: Sat, 13 Apr 2024 15:08:05 -0600 Subject: [PATCH 079/176] initial commit --- CMakeLists.txt | 75 ++ biogeochem/CMakeLists.txt | 8 + biogeophys/CMakeLists.txt | 4 + fire/CMakeLists.txt | 5 + functional_unit_testing/CMakeLists.txt | 1 + .../allometry/AutoGenVarCon.py | 140 ---- .../allometry/CMakeLists.txt | 12 + .../allometry/FatesTestAllometry.F90 | 16 + .../allometry/drive_allomtests.py | 730 ------------------ .../allometry/f90src/AllomUnitWrap.F90_in | 218 ------ .../allometry/include/README | 1 - .../allometry/plots/README | 1 - .../allometry/simple_build.sh | 58 -- .../build_fortran_tests.py | 217 ++++++ functional_unit_testing/run_fates_tests.py | 37 + functional_unit_testing/utils.py | 57 ++ main/CMakeLists.txt | 17 + parteh/CMakeLists.txt | 8 + radiation/CMakeLists.txt | 6 + unit_test_shr/CMakeLists.txt | 5 + unit_test_shr/FatesUnitTestIOMod.F90 | 571 ++++++++++++++ unit_test_shr/FatesUnitTestParamReaderMod.F90 | 59 ++ 22 files changed, 1098 insertions(+), 1148 deletions(-) create mode 100644 CMakeLists.txt create mode 100644 biogeochem/CMakeLists.txt create mode 100644 biogeophys/CMakeLists.txt create mode 100644 fire/CMakeLists.txt create mode 100644 functional_unit_testing/CMakeLists.txt delete mode 100644 functional_unit_testing/allometry/AutoGenVarCon.py create mode 100644 functional_unit_testing/allometry/CMakeLists.txt create mode 100644 functional_unit_testing/allometry/FatesTestAllometry.F90 delete mode 100644 functional_unit_testing/allometry/drive_allomtests.py delete mode 100644 functional_unit_testing/allometry/f90src/AllomUnitWrap.F90_in delete mode 100644 functional_unit_testing/allometry/include/README delete mode 100644 functional_unit_testing/allometry/plots/README delete mode 100755 functional_unit_testing/allometry/simple_build.sh create mode 100644 functional_unit_testing/build_fortran_tests.py create mode 100755 functional_unit_testing/run_fates_tests.py create mode 100644 functional_unit_testing/utils.py create mode 100644 parteh/CMakeLists.txt create mode 100644 radiation/CMakeLists.txt create mode 100644 unit_test_shr/CMakeLists.txt create mode 100644 unit_test_shr/FatesUnitTestIOMod.F90 create mode 100644 unit_test_shr/FatesUnitTestParamReaderMod.F90 diff --git a/CMakeLists.txt b/CMakeLists.txt new file mode 100644 index 0000000000..3f15615d18 --- /dev/null +++ b/CMakeLists.txt @@ -0,0 +1,75 @@ +cmake_minimum_required(VERSION 3.4) + +list(APPEND CMAKE_MODULE_PATH ${CIME_CMAKE_MODULE_DIRECTORY}) +include(CIME_initial_setup) + +project(FATES_tests Fortran C) + +include(CIME_utils) + +set(HLM_ROOT "../../") + +# Add source directories from other share code (csm_share, etc.) +add_subdirectory(${HLM_ROOT}/share/src csm_share) +add_subdirectory(${HLM_ROOT}/share/unit_test_stubs/util csm_share_stubs) + +# Add FATES source directories +add_subdirectory(${HLM_ROOT}/src/fates/main fates_main) +add_subdirectory(${HLM_ROOT}/src/fates/biogeochem fates_biogeochem) +add_subdirectory(${HLM_ROOT}/src/fates/biogeophys fates_biogeophys) +add_subdirectory(${HLM_ROOT}/src/fates/parteh fates_parteh) +add_subdirectory(${HLM_ROOT}/src/fates/fire fates_fire) +add_subdirectory(${HLM_ROOT}/src/fates/radiation fates_radiation) +add_subdirectory(${HLM_ROOT}/src/fates/unit_test_shr unit_share) + +# Remove shr_mpi_mod from share_sources. +# This is needed because we want to use the mock shr_mpi_mod in place of the real one +# +# TODO: this should be moved into a general-purpose function in Sourcelist_utils. +# Then this block of code could be replaced with a single call, like: +# remove_source_file(${share_sources} "shr_mpi_mod.F90") +foreach (sourcefile ${share_sources}) + string(REGEX MATCH "shr_mpi_mod.F90" match_found ${sourcefile}) + if(match_found) + list(REMOVE_ITEM share_sources ${sourcefile}) + endif() +endforeach() + +# Remove shr_cal_mod from share_sources. +# +# shr_cal_mod depends on ESMF (or the lightweight esmf wrf timemgr, at +# least). Since CTSM doesn't currently use shr_cal_mod, we're avoiding +# the extra overhead of including esmf_wrf_timemgr sources in this +# build. +# +# TODO: like above, this should be moved into a general-purpose function +# in Sourcelist_utils. Then this block of code could be replaced with a +# single call, like: remove_source_file(${share_sources} +# "shr_cal_mod.F90") +foreach (sourcefile ${share_sources}) + string(REGEX MATCH "shr_cal_mod.F90" match_found ${sourcefile}) + if(match_found) + list(REMOVE_ITEM share_sources ${sourcefile}) + endif() +endforeach() + +# Build libraries containing stuff needed for the unit tests. +# Eventually, these add_library calls should probably be distributed into the correct location, rather than being in this top-level CMakeLists.txt file. +add_library(csm_share ${share_sources}) +declare_generated_dependencies(csm_share "${share_genf90_sources}") +add_library(fates ${fates_sources}) +add_dependencies(fates csm_share) + +# We need to look for header files here, in order to pick up shr_assert.h +include_directories(${HLM_ROOT}/share/include) + +# Tell cmake to look for libraries & mod files here, because this is where we built libraries +include_directories(${CMAKE_CURRENT_BINARY_DIR}) +link_directories(${CMAKE_CURRENT_BINARY_DIR}) + +# Add the test directories +# Note: it's possible that these could be added by each source directory that +# has tests in it. However, it appears that the order needs to be done +# carefully: for example, include_directories and link_directories needs to be +# done before adding the tests themselves. +add_subdirectory(${HLM_ROOT}/src/fates/functional_unit_testing/allometry fates_allom_test) \ No newline at end of file diff --git a/biogeochem/CMakeLists.txt b/biogeochem/CMakeLists.txt new file mode 100644 index 0000000000..268b0d4305 --- /dev/null +++ b/biogeochem/CMakeLists.txt @@ -0,0 +1,8 @@ +list(APPEND fates_sources + FatesLitterMod.F90 + FatesCohortMod.F90 + FatesAllometryMod.F90 + DamageMainMod.F90 + FatesPatchMod.F90) + +sourcelist_to_parent(fates_sources) \ No newline at end of file diff --git a/biogeophys/CMakeLists.txt b/biogeophys/CMakeLists.txt new file mode 100644 index 0000000000..c6048491b9 --- /dev/null +++ b/biogeophys/CMakeLists.txt @@ -0,0 +1,4 @@ +list(APPEND fates_sources + FatesHydroWTFMod.F90) + +sourcelist_to_parent(fates_sources) \ No newline at end of file diff --git a/fire/CMakeLists.txt b/fire/CMakeLists.txt new file mode 100644 index 0000000000..f5d64a17a4 --- /dev/null +++ b/fire/CMakeLists.txt @@ -0,0 +1,5 @@ +list(APPEND fates_sources + SFParamsMod.F90 + ) + +sourcelist_to_parent(fates_sources) \ No newline at end of file diff --git a/functional_unit_testing/CMakeLists.txt b/functional_unit_testing/CMakeLists.txt new file mode 100644 index 0000000000..90d16c8d18 --- /dev/null +++ b/functional_unit_testing/CMakeLists.txt @@ -0,0 +1 @@ +add_subdirectory(allometry) \ No newline at end of file diff --git a/functional_unit_testing/allometry/AutoGenVarCon.py b/functional_unit_testing/allometry/AutoGenVarCon.py deleted file mode 100644 index 7bf0f85a6b..0000000000 --- a/functional_unit_testing/allometry/AutoGenVarCon.py +++ /dev/null @@ -1,140 +0,0 @@ - - -# Walk through lines of a file, if a line contains -# the string of interest (EDPftvarcon_inst), then -# parse the string to find the variable name, and save that -# to the list - - -class ParamType: - - def __init__(self,var_sym,n_dims): - - self.var_sym = var_sym - self.n_dims = n_dims - self.var_name = '' - - - - -def CheckFile(filename,check_str): - file_ptr = open(filename,'r') - var_list = [] - found = False - for line in file_ptr: - if check_str in line: - line_split = line.split() - # substr = [i for i in line_split if check_str in i][0] - substr = line - p1 = substr.find('%')+1 - if(p1>0): - substr=substr[p1:] - p2 = substr.find('(') - p3 = substr.find(')') - # Count the number of commas between p2 and p3 - n_dims = substr[p2:p3].count(',')+1 - if(p2>0): - var_list.append(ParamType(substr[:p2],n_dims)) - - unique_list = [] - for var in var_list: - found = False - for uvar in unique_list: - if (var.var_sym == uvar.var_sym): - found = True - if(not found): - unique_list.append(var) - - return(unique_list) - - - -check_str = 'EDPftvarcon_inst%' -filename = '../../biogeochem/FatesAllometryMod.F90' - -var_list = CheckFile(filename,check_str) - - -# Add symbols here - -var_list.append(ParamType('hgt_min',1)) - - -# Now look through EDPftvarcon.F90 to determine the variable name in file -# that is associated with the variable pointer - -filename = '../../main/EDPftvarcon.F90' - -f = open(filename,"r") -contents = f.readlines() - - -var_name_list = [] -for var in var_list: - for i,line in enumerate(contents): - if (var.var_sym in line) and ('data' in line) and ('=' in line): - var.var_name = contents[i-2].split()[-1].strip('\'') - print("{} {} {}".format(var.var_sym,var.var_name,var.n_dims)) - - -f = open("f90src/AllomUnitWrap.F90_in", "r") -contents = f.readlines() -f.close() - -# Identify where we define the variables, and insert the variable definitions - -for i,str in enumerate(contents): - if 'VARIABLE-DEFINITIONS-HERE' in str: - index0=i - -index=index0+2 -for var in var_list: - if(var.n_dims==1): - contents.insert(index,' real(r8),pointer :: {}(:)\n'.format(var.var_sym)) - elif(var.n_dims==2): - contents.insert(index,' real(r8),pointer :: {}(:,:)\n'.format(var.var_sym)) - else: - print('Incorrect number of dims...') - exit(-2) - index=index+1 - -# Identify where we do the pointer assignments, and insert the pointer assignments - - -for i,str in enumerate(contents): - if 'POINTER-SPECIFICATION-HERE' in str: - index0=i - -index=index0+2 -for ivar,var in enumerate(var_list): - if(var.n_dims==1): - ins_l1='\t allocate(EDPftvarcon_inst%{}(1:numpft))\n'.format(var.var_sym) - ins_l2='\t EDPftvarcon_inst%{}(:) = nan\n'.format(var.var_sym) - ins_l3='\t iv1 = iv1 + 1\n' - ins_l4='\t EDPftvarcon_ptr%var1d(iv1)%var_name = "{}"\n'.format(var.var_name) - ins_l5='\t EDPftvarcon_ptr%var1d(iv1)%var_rp => EDPftvarcon_inst%{}\n'.format(var.var_sym) - ins_l6='\t EDPftvarcon_ptr%var1d(iv1)%vtype = 1\n' - ins_l7='\n' - if(var.n_dims==2): - ins_l1='\t allocate(EDPftvarcon_inst%{}(1:numpft,1))\n'.format(var.var_sym) - ins_l2='\t EDPftvarcon_inst%{}(:,:) = nan\n'.format(var.var_sym) - ins_l3='\t iv2 = iv2 + 1\n' - ins_l4='\t EDPftvarcon_ptr%var2d(iv2)%var_name = "{}"\n'.format(var.var_name) - ins_l5='\t EDPftvarcon_ptr%var2d(iv2)%var_rp => EDPftvarcon_inst%{}\n'.format(var.var_sym) - ins_l6='\t EDPftvarcon_ptr%var2d(iv2)%vtype = 1\n' - ins_l7='\n' - - contents.insert(index,ins_l1) - contents.insert(index+1,ins_l2) - contents.insert(index+2,ins_l3) - contents.insert(index+3,ins_l4) - contents.insert(index+4,ins_l5) - contents.insert(index+5,ins_l6) - contents.insert(index+6,ins_l7) - index=index+7 - - -f = open("f90src/AllomUnitWrap.F90", "w+") -contents = "".join(contents) -f.write(contents) -f.close() diff --git a/functional_unit_testing/allometry/CMakeLists.txt b/functional_unit_testing/allometry/CMakeLists.txt new file mode 100644 index 0000000000..362a541b61 --- /dev/null +++ b/functional_unit_testing/allometry/CMakeLists.txt @@ -0,0 +1,12 @@ +set(allom_sources FatesTestAllometry.F90) + +add_executable(FATES_allom_exe ${allom_sources}) + +target_link_libraries(FATES_allom_exe + fates + csm_share) + +add_test(allom_test FATES_allom_exe) + +# Tell CTest how to figure out that "STOP 1" fails for the current +define_Fortran_stop_failure(allom_test) \ No newline at end of file diff --git a/functional_unit_testing/allometry/FatesTestAllometry.F90 b/functional_unit_testing/allometry/FatesTestAllometry.F90 new file mode 100644 index 0000000000..10be571f67 --- /dev/null +++ b/functional_unit_testing/allometry/FatesTestAllometry.F90 @@ -0,0 +1,16 @@ +program FatesTestAllometry + + !use FatesAllometryMod, only : h2d_allom + !use PRTParametersMod, only : prt_params + use FatesUnitTestParamReaderMod, only : fates_unit_test_param_reader + + implicit none + + ! LOCALS: + type(fates_unit_test_param_reader) :: param_reader + + call param_reader%param_read() + + print *, "Hello, allometry" + +end program FatesTestAllometry \ No newline at end of file diff --git a/functional_unit_testing/allometry/drive_allomtests.py b/functional_unit_testing/allometry/drive_allomtests.py deleted file mode 100644 index d97da4ded3..0000000000 --- a/functional_unit_testing/allometry/drive_allomtests.py +++ /dev/null @@ -1,730 +0,0 @@ -import numpy as np -import math -import matplotlib.pyplot as plt -import matplotlib as mp -import ctypes -import importlib -from ctypes import * #byref, cdll, c_int, c_double, c_char_p, c_long -import xml.etree.ElementTree as ET -import argparse -import re # This is a heftier string parser -import code # For development: code.interact(local=dict(globals(), **locals())) -import sys -sys.path.append('../shared/py_src') -from PyF90Utils import c8, ci, cchar, c8_arr, ci_arr - -# ======================================================================================= -# Set some constants. If they are used as constant arguments to the F90 routines, -# define them with their ctype identifiers -# ======================================================================================= - -ndbh = 200 -maxdbh = 50 -ccanopy_trim = c_double(1.0) # Crown Trim (0=0% of target, 1=100% of targ) -csite_spread = c_double(0.0) # Canopy spread (0=closed, 1=open) -cnplant = c_double(1.0) # Number of plants (don't change) -cilayer = c_int(1) # Index of the plant's canopy layer -ccanopy_lai = (2 * c_double)(1.0,1.0) # The LAI of the different canopy layers - # THIS VECTOR MUST MATCH ncanlayer -cdo_reverse = c_bool(0) # DO NOT GET REVERSE CROWN AREA - -# ======================================================================================= -# Setup references to fortran shared libraries -# ======================================================================================= - -allom_const_object = "./include/FatesConstantsMod.o" -allom_wrap_object = "./include/AllomUnitWrap.o" -allom_lib_object = "./include/FatesAllometryMod.o" - -# ============================================================================== -# Instantiate fortran allometry and other libraries -# ============================================================================== - -f90constlib= ctypes.CDLL(allom_const_object,mode=ctypes.RTLD_GLOBAL) -f90wraplib = ctypes.CDLL(allom_wrap_object,mode=ctypes.RTLD_GLOBAL) -f90funclib = ctypes.CDLL(allom_lib_object,mode=ctypes.RTLD_GLOBAL) - -# ======================================================================================= -# Create aliases to all of the different routines, set return types for functions -# ======================================================================================= - -f90_pftalloc = f90wraplib.__edpftvarcon_MOD_edpftvarconalloc #(numpft) -f90_pftset = f90wraplib.__edpftvarcon_MOD_edpftvarconpyset -f90_pftset.argtypes = [POINTER(c_int),POINTER(c_double),POINTER(c_int),c_char_p,c_long] -f90_h2d = f90funclib.__fatesallometrymod_MOD_h2d_allom #(h,ipft,d,dddh) -f90_h = f90funclib.__fatesallometrymod_MOD_h_allom #(d,ipft,h,dhdd) -f90_bagw = f90funclib.__fatesallometrymod_MOD_bagw_allom #(d,ipft,bagw,dbagwdd) -f90_bleaf = f90funclib.__fatesallometrymod_MOD_bleaf #(d,ipft,canopy_trim,bl,dbldd) -f90_bsap = f90funclib.__fatesallometrymod_MOD_bsap_allom #(d,ipft,canopy_trim,asapw,bsap,dbsapdd) -f90_bstore = f90funclib.__fatesallometrymod_MOD_bstore_allom #(d,ipft,canopy_trim,bstore,dbstoredd) -f90_bbgw = f90funclib.__fatesallometrymod_MOD_bbgw_allom #(d,ipft,canopy_trim,bbgw,dbbgwdd) -f90_bfineroot = f90funclib.__fatesallometrymod_MOD_bfineroot #(d,ipft,canopy_trim,bfr,dbfrdd) -f90_bdead = f90funclib.__fatesallometrymod_MOD_bdead_allom #(bagw,bbgw,bsap,ipft,bdead,dbagwdd,dbbgwdd,dbsapdd,dbdeaddd) -f90_carea = f90funclib.__fatesallometrymod_MOD_carea_allom #(d,nplant,site_spread,ipft,c_area)(d,nplant,site_spread,ipft,c_area) -f90_treelai = f90funclib.__fatesallometrymod_MOD_tree_lai #(leaf_c, pft, c_area, nplant, cl, canopy_lai, vcmax25top) -f90_treelai.restype = c_double - - -# This is the object type that holds our parameters -# ======================================================================================= -class parameter: - - def __init__(self,symbol): - - self.dtype = -9 - self.symbol = symbol - self.vals = [] - - def setval(self,val,ipft): - - self.vals[ipft] = val - -# This is just a helper script that generates random colors -# ======================================================================================= -def DiscreteCubeHelix(N): - - base = plt.cm.get_cmap('cubehelix') - np.random.seed(2) - color_list = base(np.random.randint(0,high=255,size=N)) - cmap_name = base.name + str(N) - return base.from_list(cmap_name, color_list, N) - - -# This will look through a CDL file for the provided parameter and determine -# the parameter's type, as well as fill an array with the data -# ======================================================================================= -def CDLParse(file_name,parm): - - fp = open(file_name,"r") - contents = fp.readlines() - fp.close() - - # Look in the file for the parameters - # symbol/name, record the line number - iline=-1 - isfirst = True - for i,line in enumerate(contents): - if(parm.symbol in line): - iline=i - if(isfirst): - dtype = line.split()[0] - if(dtype.strip()=="float" or (dtype.strip()=="double")): - parm.dtype = 0 - elif(dtype.strip()=="char"): - parm.dtype = 1 - isFirst=False - - if(iline==-1): - print('Could not find symbol: {} in file: {}'.format(parm.symbol,file_name)) - exit(2) - else: - search_field=True - line="" - lcount=0 - while(search_field and (lcount<100)): - line+=contents[iline] - if(line.count(';')>0): - search_field=False - else: - search_field=True - lcount=lcount+1 - iline=iline+1 - - # Parse the line - line_split = re.split(',|=',line) - # Remove the variable name entry - del line_split[0] - - # This is for read numbers - if(parm.dtype == 0): - ival=0 - for str0 in line_split: - str="" - isnum=False - for s in str0: - if (s.isdigit() or s=='.'): - str+=s - isnum=True - if(isnum): - parm.vals.append(float(str)) - - # This is a sting - elif(parm.dtype == 1): - for str0 in line_split: - # Loop several times to trim stuff off - for i in range(5): - str0=str0.strip().strip('\"').strip(';').strip() - parm.vals.append(str0) - - return(parm) - - - -# Read in the arguments -# ======================================================================================= - -parser = argparse.ArgumentParser(description='Parse command line arguments to this script.') -parser.add_argument('--fin', '--input', dest='fnamein', type=str, help="Input CDL filename. Required.", required=True) -args = parser.parse_args() - - -# Read in the parameters of interest that are used in the fortran objects. These -# parameters will be passed to the fortran allocation. -# ======================================================================================= - -parms = {} -parms['dbh_maxheight'] = CDLParse(args.fnamein,parameter('fates_allom_dbh_maxheight')) -parms['hmode'] = CDLParse(args.fnamein,parameter('fates_allom_hmode')) -parms['amode'] = CDLParse(args.fnamein,parameter('fates_allom_amode')) -parms['lmode'] = CDLParse(args.fnamein,parameter('fates_allom_lmode')) -parms['smode'] = CDLParse(args.fnamein,parameter('fates_allom_smode')) -parms['cmode'] = CDLParse(args.fnamein,parameter('fates_allom_cmode')) -parms['fmode'] = CDLParse(args.fnamein,parameter('fates_allom_fmode')) -parms['stmode'] = CDLParse(args.fnamein,parameter('fates_allom_stmode')) -parms['cushion'] = CDLParse(args.fnamein,parameter('fates_alloc_storage_cushion')) -parms['d2h1'] = CDLParse(args.fnamein,parameter('fates_allom_d2h1')) -parms['d2h2'] = CDLParse(args.fnamein,parameter('fates_allom_d2h2')) -parms['d2h3'] = CDLParse(args.fnamein,parameter('fates_allom_d2h3')) -parms['agb1'] = CDLParse(args.fnamein,parameter('fates_allom_agb1')) -parms['agb2'] = CDLParse(args.fnamein,parameter('fates_allom_agb2')) -parms['agb3'] = CDLParse(args.fnamein,parameter('fates_allom_agb3')) -parms['agb4'] = CDLParse(args.fnamein,parameter('fates_allom_agb4')) -parms['d2bl1'] = CDLParse(args.fnamein,parameter('fates_allom_d2bl1')) -parms['d2bl2'] = CDLParse(args.fnamein,parameter('fates_allom_d2bl2')) -parms['d2bl3'] = CDLParse(args.fnamein,parameter('fates_allom_d2bl3')) -parms['wood_density'] = CDLParse(args.fnamein,parameter('fates_wood_density')) -parms['c2b'] = CDLParse(args.fnamein,parameter('fates_c2b')) -parms['la_per_sa_int'] = CDLParse(args.fnamein,parameter('fates_allom_la_per_sa_int')) -parms['la_per_sa_slp'] = CDLParse(args.fnamein,parameter('fates_allom_la_per_sa_slp')) -parms['slatop'] = CDLParse(args.fnamein,parameter('fates_leaf_slatop')) -parms['slamax'] = CDLParse(args.fnamein,parameter('fates_leaf_slamax')) -parms['l2fr'] = CDLParse(args.fnamein,parameter('fates_allom_l2fr')) -parms['agb_frac'] = CDLParse(args.fnamein,parameter('fates_allom_agb_frac')) -parms['blca_expnt_diff'] = CDLParse(args.fnamein,parameter('fates_allom_blca_expnt_diff')) -parms['d2ca_coeff_min'] = CDLParse(args.fnamein,parameter('fates_allom_d2ca_coefficient_min')) -parms['d2ca_coeff_max'] = CDLParse(args.fnamein,parameter('fates_allom_d2ca_coefficient_max')) -parms['sai_scaler'] = CDLParse(args.fnamein,parameter('fates_allom_sai_scaler')) - -# Read in the parameters that are not necessary for the F90 allometry algorithms, -# but are useful for these scripts (e.g. the name of the parameter, and minimum height) -# ======================================================================================= - -eparms = {} -eparms['recruit_hgt_min'] = CDLParse(args.fnamein,parameter('fates_recruit_hgt_min')) -eparms['name'] = CDLParse(args.fnamein,parameter('fates_pftname')) -eparms['vcmax25top'] = CDLParse(args.fnamein,parameter('fates_leaf_vcmax25top')) - - -# Determine how many PFTs are here, also check to make sure that all parameters -# have the same number -# ======================================================================================= -numpft=-1 -for key, parm in parms.items(): - if( (len(parm.vals) == numpft) or (numpft==-1) ): - numpft=len(parm.vals) - else: - print('Bad length in PFT parameter') - print('parameter: {}, vals:'.format(parm.symbol),parm.vals) - - -# ============================================================================== -# Allocate fortran PFT arrays -# ============================================================================== - -iret=f90_pftalloc(ci(numpft)) - -# ============================================================================== -# Populate the Fortran PFT structure -# ============================================================================== - -for ipft in range(numpft): - for key, parm in parms.items(): - print('{} {} '.format(parm.symbol,parm.vals[ipft])) - iret=f90_pftset(c_int(ipft+1), \ - c_double(parm.vals[ipft]), \ - c_int(0), \ - c_char_p(parm.symbol.encode('utf-8')), \ - c_long(len(parm.symbol))) - - -# ========================================================================= -# Initialize Output Arrays -# ========================================================================= - -blmaxi = np.zeros((numpft,ndbh)) -blmaxd = np.zeros((numpft,ndbh)) -bfrmax = np.zeros((numpft,ndbh)) -hi = np.zeros((numpft,ndbh)) -hd = np.zeros((numpft,ndbh)) -bagwi = np.zeros((numpft,ndbh)) -bagwd = np.zeros((numpft,ndbh)) - -bagwr = np.zeros((numpft,ndbh)) - -dbh = np.zeros((numpft,ndbh)) -bbgw = np.zeros((numpft,ndbh)) -bsapi = np.zeros((numpft,ndbh)) -bsapd = np.zeros((numpft,ndbh)) -asapd = np.zeros((numpft,ndbh)) -bstore = np.zeros((numpft,ndbh)) -bdead = np.zeros((numpft,ndbh)) -dbhe = np.zeros((numpft,ndbh)) -camin = np.zeros((numpft,ndbh)) -ldense = np.zeros((numpft,ndbh)) -treelai = np.zeros((numpft,ndbh)) -blmax_o_dbagwdh = np.zeros((numpft,ndbh)) -blmax_o_dbagwdd = np.zeros((numpft,ndbh)) - - -for ipft in range(numpft): - - print('py: Solving for pft: {}'.format(ipft+1)) - - # Initialize Height #(d,ipft,h,dhdd) - ch_min = c_double(eparms['recruit_hgt_min'].vals[ipft]) - - cd = c_double(-9.0) - cdddh = c_double(-9.0) - cipft = c_int(ipft+1) - cinit = c_int(0) - - # Calculate the minimum dbh - iret=f90_h2d(byref(ch_min),byref(cipft),byref(cd),byref(cdddh)) - - # Generate a vector of diameters (use dbh) - dbh[ipft,:] = np.linspace(cd.value,maxdbh,num=ndbh) - - # Initialize various output vectors - cd = c_double(dbh[ipft,0]) - ch = c_double(-9.0) - cdhdd = c_double(-9.0) - cbagw = c_double(-9.0) - cdbagwdd = c_double(-9.0) - cblmax = c_double(-9.0) - cdblmaxdd = c_double(-9.0) - cbfrmax = c_double(-9.0) - cdbfrmaxdd = c_double(-9.0) - cbbgw = c_double(-9.0) - cdbbgwdd = c_double(-9.0) - cbsap = c_double(-9.0) - cdbsapdd = c_double(-9.0) - cbdead = c_double(-9.0) - cdbdeaddd = c_double(-9.0) - ccamin = c_double(-9.0) - casapw = c_double(-9.0) # Sapwood area - cbstore = c_double(-9.0) - cdbstoredd = c_double(-9.0) - - iret=f90_h(byref(cd),byref(cipft),byref(ch),byref(cdhdd)) - hi[ipft,0] = ch.value - hd[ipft,0] = ch.value - print('py: initialize h[{},0]={}'.format(ipft+1,ch.value)) - - # Initialize AGB #(d,ipft,bagw,dbagwdd) - iret=f90_bagw(byref(cd),byref(cipft),byref(cbagw),byref(cdbagwdd)) - bagwi[ipft,0] = cbagw.value - print('py: initialize bagwi[{},0]={}'.format(ipft+1,cbagw.value)) - - # Initialize bleaf #(d,ipft,canopy_trim,bl,dbldd) - iret=f90_bleaf(byref(cd),byref(cipft),byref(ccanopy_trim),byref(cblmax),byref(cdblmaxdd)) - blmaxi[ipft,0] = cblmax.value - blmaxd[ipft,0] = cblmax.value - print('py: initialize blmaxi[{},0]={}'.format(ipft+1,cblmax.value)) - - # Initialize bstore #(d,ipft,canopy_trim,bstore,dbstoredd) - iret=f90_bstore(byref(cd),byref(cipft),byref(ccanopy_trim),byref(cbstore),byref(cdbstoredd)) - bstore[ipft,0] = cbstore.value - - # calculate crown area (d,nplant,site_spread,ipft,c_area) Using nplant = 1, generates units of m2 - # spread is likely 0.0, which is the value it tends towards when canopies close - # (dbh, nplant, site_spread, ipft, c_area,inverse) - iret= f90_carea(byref(cd),byref(cnplant),byref(csite_spread),byref(cipft),byref(ccamin),byref(cdo_reverse)) - camin[ipft,0] = ccamin.value - - - ldense[ipft,0] = blmaxi[ipft,0]/camin[ipft,0] - print('py: initialize careai[{},0]={}'.format(ipft+1,ccamin.value)) - - #f90_treelai(leaf_c, pft, c_area, nplant, cl, canopy_lai, vcmax25top) - cvcmax=c_double(eparms['vcmax25top'].vals[ipft]) - treelai[ipft,0]=f90_treelai(byref(cblmax),byref(cipft),byref(ccamin), \ - byref(cnplant),byref(cilayer),byref(ccanopy_lai),byref(cvcmax)) - - # Initialize fine roots #(d,ipft,canopy_trim,bfr,dbfrdd) - iret=f90_bfineroot(byref(cd),byref(cipft),byref(ccanopy_trim), \ - byref(cbfrmax),byref(cdbfrmaxdd)) - bfrmax[ipft,0] = cbfrmax.value - print('py: initialize bfrmax[{},0]={}'.format(ipft+1,cbfrmax.value)) - - # Initialize coarse roots #(d,ipft,bbgw,dbbgwdd) - iret=f90_bbgw(byref(cd),byref(cipft),byref(c_double(1.0)), \ - byref(cbbgw),byref(cdbbgwdd)) - bbgw[ipft,0] = cbbgw.value - print('py: initialize bbgw[{},0]={}'.format(ipft+1,cbbgw.value)) - - - # Initialize bsap (d,ipft,canopy_trim,asapw,bsap,dbsapdd) - iret=f90_bsap(byref(cd),byref(cipft),byref(ccanopy_trim),byref(casapw),byref(cbsap),byref(cdbsapdd)) - bsapi[ipft,0] = cbsap.value - bsapd[ipft,0] = cbsap.value - asapd[ipft,0] = casapw.value - print('py: initialize bsapi[{},0]={}'.format(ipft+1,cbsap.value)) - - # bdead #(bagw,bbgw,bsap,ipft,bdead,dbagwdd,dbbgwdd,dbsapdd,dbdeaddd) - iret=f90_bdead(byref(cbagw),byref(cbbgw),byref(cbsap),byref(cipft), \ - byref(cbdead),byref(cdbagwdd),byref(cdbbgwdd), \ - byref(cdbsapdd),byref(cdbdeaddd)) - - bdead[ipft,0] = cbdead.value - print('py: initialize bdead[{},0]={}'.format(ipft+1,cbdead.value)) - - bagwr[ipft,0] = (bdead[ipft,0]) * 0.6 - - # the metric that shan't be spoken - blmax_o_dbagwdh[ipft,0] = blmaxi[ipft,0]/(cdbagwdd.value/cdhdd.value) - - # the metric that shan't be spoken - blmax_o_dbagwdd[ipft,0] = blmaxi[ipft,0]/(cdbagwdd.value) - - for idi in range(1,ndbh): - - dp = dbh[ipft,idi-1] # previous position - dc = dbh[ipft,idi] # current position - dd = dc-dp - - cdp = c_double(dp) - cdc = c_double(dc) - cdbhe = c_double(-9.0) - cddedh = c_double(-9.0) - - if(ipft==2): - print("===") - - # integrate height #(d,ipft,h,dhdd) - iret=f90_h(byref(cdc),byref(cipft),byref(ch),byref(cdhdd)) - hi[ipft,idi] = hi[ipft,idi-1] + cdhdd.value*dd - - # diagnosed height - hd[ipft,idi] = ch.value - - # diagnose AGB #(d,h,ipft,bagw,dbagwdd) - iret=f90_bagw(byref(cdc),byref(cipft),byref(cbagw),byref(cdbagwdd)) - bagwd[ipft,idi] = cbagw.value - - # integrate AGB #(d,h,ipft,bagw,dbagwdd) - iret=f90_bagw(byref(cdp),byref(cipft),byref(cbagw),byref(cdbagwdd)) - bagwi[ipft,idi] = bagwi[ipft,idi-1] + cdbagwdd.value*dd - - # diagnose bleaf #(d,ipft,blmax,dblmaxdd) - iret=f90_bleaf(byref(cdc),byref(cipft),byref(ccanopy_trim),byref(cblmax),byref(cdblmaxdd)) - blmaxd[ipft,idi] = cblmax.value - - # bstore #(d,ipft,canopy_trim,bstore,dbstoredd) - iret=f90_bstore(byref(cdc),byref(cipft),byref(ccanopy_trim),byref(cbstore),byref(cdbstoredd)) - bstore[ipft,idi] = cbstore.value - - # calculate crown area (d,nplant,site_spread,ipft,c_area) Using nplant = 1, generates units of m2 - iret= f90_carea(byref(cdc),byref(cnplant),byref(csite_spread),byref(cipft),byref(ccamin),byref(cdo_reverse)) - camin[ipft,idi] = ccamin.value - - #f90_treelai(leaf_c, pft, c_area, nplant, cl, canopy_lai, vcmax25top) - cvcmax=c_double(eparms['vcmax25top'].vals[ipft]) - treelai[ipft,idi]=f90_treelai(byref(cblmax),byref(cipft),byref(ccamin), \ - byref(cnplant),byref(cilayer),byref(ccanopy_lai),byref(cvcmax)) - - - - - # integrate bleaf #(d,ipft,blmax,dblmaxdd) - iret=f90_bleaf(byref(cdp),byref(cipft),byref(c_double(1.0)),byref(cblmax),byref(cdblmaxdd)) - blmaxi[ipft,idi] = blmaxi[ipft,idi-1] + cdblmaxdd.value*dd - - # leaf mass per square meter of crown - ldense[ipft,idi] = blmaxd[ipft,idi]/camin[ipft,idi] - - # integrate bfineroot #(d,ipft,canopy_trim,bfr,dbfrdd) - iret=f90_bfineroot(byref(cdp),byref(cipft),byref(c_double(1.0)),byref(cbfrmax),byref(cdbfrmaxdd)) - bfrmax[ipft,idi] = bfrmax[ipft,idi-1] + cdbfrmaxdd.value*dd - - # integrate bbgw #(d,h,ipft,bbgw,dbbgwdd) - iret=f90_bbgw(byref(cdp),byref(cipft),byref(cbbgw),byref(cdbbgwdd)) - bbgw[ipft,idi] = bbgw[ipft,idi-1] + cdbbgwdd.value*dd - - # diagnose bsap # (d,ipft,canopy_trim,asapw,bsap,dbsapdd) - iret=f90_bsap(byref(cdc),byref(cipft),byref(ccanopy_trim),byref(casapw),byref(cbsap),byref(cdbsapdd)) - bsapd[ipft,idi] = cbsap.value # Biomass - asapd[ipft,idi] = casapw.value # Area - - # integrate bsap - iret=f90_bsap(byref(cdp),byref(cipft),byref(ccanopy_trim),byref(casapw),byref(cbsap),byref(cdbsapdd)) - bsapi[ipft,idi] = bsapi[ipft,idi-1] + cdbsapdd.value*dd - - - - - # the metric that shan't be spoken - # previous t-step derivatives are used for simplicity - if cdhdd.value<0.000001: - blmax_o_dbagwdh[ipft,idi] = None - else: - blmax_o_dbagwdh[ipft,idi] = blmaxi[ipft,idi-1]/(cdbagwdd.value/cdhdd.value) - - # the metric that shan't be spoken - # previous t-step derivatives are used for simplicity - blmax_o_dbagwdd[ipft,idi] = blmaxi[ipft,idi-1]/(cdbagwdd.value) - - # Diagnose bdead (bagw,bbgw,bsap,ipft,bdead,dbagwdd,dbbgwdd,dbsapdd,dbdeaddd) - - iret=f90_bdead(byref(c_double(bagwd[ipft,idi])), \ - byref(c_double(bbgw[ipft,idi])), \ - byref(c_double(bsapd[ipft,idi])), \ - byref(cipft), byref(cbdead), \ - byref(cdbagwdd),byref(cdbbgwdd), \ - byref(cdbsapdd),byref(cdbdeaddd)) - bdead[ipft,idi] = cbdead.value - - - bagwr[ipft,idi] = (bdead[ipft,idi] + bsapd[ipft,idi]) * 0.6 - -# Create the appropriate number of line-styles, colors and widths -linestyles_base = ['-', '--', '-.', ':'] -linestyles=[] -for i in range(int(math.floor(float(numpft)/float(len(linestyles_base))))): - linestyles.extend(linestyles_base) -for i in range(numpft-len(linestyles)): - linestyles.append(linestyles_base[i]) - -my_colors = DiscreteCubeHelix(numpft) - - -mp.rcParams.update({'font.size': 14}) -mp.rcParams["savefig.directory"] = "" #os.chdir(os.path.dirname(__file__)) - -legfs = 12 -lwidth = 2.0 - -#code.interact(local=dict(globals(), **locals())) - -if(True): - fig0 = plt.figure() - figleg = plt.figure() - ax = fig0.add_subplot(111) - ax.axis("off") - ax.set_axis_off() - proxies = () - for ipft in range(numpft): - proxies = proxies + (mp.lines.Line2D([],[], \ - linestyle=linestyles[ipft], \ - color=my_colors(ipft), \ - label=eparms['name'].vals[ipft], \ - linewidth=lwidth),) - figleg.legend(handles=proxies,fontsize=12,frameon=False,labelspacing=0.25,loc='center') - plt.show(block=False) - plt.close(fig0) - - - -if(False): - fig1_12 = plt.figure() - for ipft in range(numpft): - plt.plot(bagwd[ipft,:],bagwr[ipft,:],linestyle=linestyles[ipft],color=my_colors(ipft),linewidth=lwidth) - plt.xlabel('bagw [m]') - plt.ylabel('bagr [m]') - plt.title('') - plt.grid(True) - plt.savefig("plots/bagw_vs_bagwr.png") - - -if(True): - fig1 = plt.figure() - figleg = plt.figure() - for ipft in range(numpft): - plt.plot(dbh[ipft,:],hi[ipft,:],linestyle=linestyles[ipft],color=my_colors(ipft),linewidth=lwidth) - plt.xlabel('diameter [cm]') - plt.ylabel('height [m]') - plt.title('Integrated Heights') - plt.grid(True) - plt.tight_layout() - -if(True): - fig1_1 = plt.figure() - for ipft in range(numpft): - plt.plot(hd[ipft,:],hi[ipft,:],linestyle=linestyles[ipft],color=my_colors(ipft),linewidth=lwidth) - plt.xlabel('height (diagnosed) [m]') - plt.ylabel('height (integrated) [m]') - plt.title('Height') - plt.grid(True) - plt.savefig("plots/hdhi.png") - -if(False): - fig2=plt.figure() - for ipft in range(numpft): - plt.plot(blmaxd[ipft,:],blmaxi[ipft,:],linestyle=linestyles[ipft],color=my_colors(ipft),linewidth=lwidth) - plt.xlabel('diagnosed [kgC]') - plt.ylabel('integrated [kgC]') - plt.title('Maximum Leaf Biomass') - plt.grid(True) - plt.tight_layout() - -if(True): - fig3=plt.figure() - for ipft in range(numpft): - plt.plot(dbh[ipft,:],blmaxi[ipft,:],linestyle=linestyles[ipft],color=my_colors(ipft),linewidth=lwidth) - plt.xlabel('diameter [cm]') - plt.ylabel('mass [kgC]') - plt.title('Maximum Leaf Biomass') - plt.grid(True) - plt.tight_layout() - -if(True): - fig3_1=plt.figure() - for ipft in range(numpft): - plt.plot(dbh[ipft,1:15],blmaxi[ipft,1:15],linestyle=linestyles[ipft],color=my_colors(ipft),linewidth=lwidth) - plt.xlabel('diameter [cm]') - plt.ylabel('mass [kgC]') - plt.title('Maximum Leaf Biomass (saplings)') - plt.grid(True) - plt.tight_layout() - - -if(True): - fig4=plt.figure() - for ipft in range(numpft): - plt.plot(dbh[ipft,:],camin[ipft,:],linestyle=linestyles[ipft],color=my_colors(ipft),linewidth=lwidth) - plt.xlabel('diameter [cm]') - plt.ylabel('[m2] (closed canopy)') - plt.title('Crown Area') - plt.grid(True) - plt.tight_layout() - -if(True): - fig4_1=plt.figure() - for ipft in range(numpft): - plt.plot(dbh[ipft,:],ldense[ipft,:],linestyle=linestyles[ipft],color=my_colors(ipft),linewidth=lwidth) - plt.xlabel('diameter [cm]') - plt.ylabel('[kgC/m2] (closed canopy)') - plt.title('Leaf Mass Per Crown Area') - plt.grid(True) - plt.tight_layout() - - -if(True): - fig6=plt.figure() - for ipft in range(numpft): - plt.plot(dbh[ipft,:],bagwi[ipft,:]/1000,linestyle=linestyles[ipft],color=my_colors(ipft),linewidth=lwidth) - plt.xlabel('diameter [cm]') - plt.ylabel('AGB [MgC]') - plt.title('Above Ground Biomass') - plt.grid(True) - plt.tight_layout() - -if(False): - fig6_1=plt.figure() - for ipft in range(numpft): - plt.plot(bagwd[ipft,:]/1000,bagwi[ipft,:]/1000,linestyle=linestyles[ipft],color=my_colors(ipft),linewidth=lwidth) - plt.xlabel('AGBW deterministic [MgC]') - plt.ylabel('AGBW integrated [MgC]') - plt.title('Above Ground Biomass') - plt.grid(True) - plt.tight_layout() - -if(False): - fig5=plt.figure() - for ipft in range(numpft): - gpmask = np.isfinite(blmax_o_dbagwdh[ipft,:]) - plt.plot(dbh[ipft,gpmask],blmax_o_dbagwdh[ipft,gpmask],linestyle=linestyles[ipft],color=my_colors(ipft),linewidth=lwidth) - plt.xlabel('diameter [cm]') - plt.ylabel('growth potential: bl/(dAGB/dh) [m]') - plt.title('Height Growth Potential') - plt.grid(True) - plt.tight_layout() - -if(False): - fig6=plt.figure() - for ipft in range(numpft): - plt.plot(dbh[ipft,:],blmax_o_dbagwdd[ipft,:],linestyle=linestyles[ipft],color=my_colors(ipft),linewidth=lwidth) - plt.xlabel('diameter [cm]') - plt.ylabel('growth potential: bl/(dAGB/dd) [cm]') - plt.title('Diameter Growth Potential') - plt.grid(True) - plt.tight_layout() - -if(False): - fig7=plt.figure() - for ipft in range(numpft): - plt.plot(bsapd[ipft,:],bsapi[ipft,:],linestyle=linestyles[ipft],color=my_colors(ipft),linewidth=lwidth) - plt.xlabel('deterministic [kgC]') - plt.ylabel('integrated [kgC]') - plt.title('Sapwood Biomass') - plt.grid(True) - plt.tight_layout() - -if(False): - fig7_0=plt.figure() - for ipft in range(numpft): - plt.plot(dbh[ipft,:],bsapd[ipft,:],linestyle=linestyles[ipft],color=my_colors(ipft),linewidth=lwidth) - plt.xlabel('Diameter [cm]') - plt.ylabel('[kgC]') - plt.title('Sapwood Biomass') - plt.grid(True) - plt.tight_layout() - -if(True): - fig7_2=plt.figure(figsize=(8,6)) - # Sapwood - ax = fig7_2.add_subplot(221) - for ipft in range(numpft): - ax.plot(dbh[ipft,:],bsapd[ipft,:]/(bsapd[ipft,:]+blmaxi[ipft,:]+bfrmax[ipft,:]+bstore[ipft,:]), \ - linestyle=linestyles[ipft],color=my_colors(ipft),linewidth=lwidth) - ax.set_xlabel('diameter [cm]') - ax.set_ylabel('[kgC/kgC]') - ax.set_title('Sapwood (fraction of live)') - ax.grid(True) - # Leaf - ax = fig7_2.add_subplot(222) - for ipft in range(numpft): - ax.plot(dbh[ipft,:],blmaxi[ipft,:]/(bsapd[ipft,:]+blmaxi[ipft,:]+bfrmax[ipft,:]+bstore[ipft,:]), \ - linestyle=linestyles[ipft],color=my_colors(ipft),linewidth=lwidth) - ax.set_xlabel('diameter [cm]') - ax.set_ylabel('[kgC/kgC]') - ax.set_title('Leaf (fraction of live)') - ax.grid(True) - # Fine Root - ax = fig7_2.add_subplot(223) - for ipft in range(numpft): - ax.plot(dbh[ipft,:],bfrmax[ipft,:]/(bsapd[ipft,:]+blmaxi[ipft,:]+bfrmax[ipft,:]+bstore[ipft,:]), \ - linestyle=linestyles[ipft],color=my_colors(ipft),linewidth=lwidth) - ax.set_xlabel('diameter [cm]') - ax.set_ylabel('[kgC/kgC]') - ax.set_title('Fine-Root (fraction of live)') - ax.grid(True) - # Storage - ax = fig7_2.add_subplot(224) - for ipft in range(numpft): - ax.plot(dbh[ipft,:],bstore[ipft,:]/(bsapd[ipft,:]+blmaxi[ipft,:]+bfrmax[ipft,:]+bstore[ipft,:]), \ - linestyle=linestyles[ipft],color=my_colors(ipft),linewidth=lwidth) - ax.set_xlabel('diameter [cm]') - ax.set_ylabel('[kgC/kgC]') - ax.set_title('Storage (fraction of live)') - ax.grid(True) - - plt.tight_layout() - - - -if(True): - fig8=plt.figure() - ax = fig8.add_subplot(111) - for ipft in range(numpft): - ax.plot(dbh[ipft,:],treelai[ipft,:],linestyle=linestyles[ipft],color=my_colors(ipft),linewidth=lwidth) - ax.ticklabel_format(style='plain') - ax.set_xlabel('diameter [cm]') - ax.set_ylabel('[m2/m2]') - ax.set_title('Untrimmed In-Crown LAI') - ax.grid(True) - plt.tight_layout() - - - - -plt.show() diff --git a/functional_unit_testing/allometry/f90src/AllomUnitWrap.F90_in b/functional_unit_testing/allometry/f90src/AllomUnitWrap.F90_in deleted file mode 100644 index 471314b0bf..0000000000 --- a/functional_unit_testing/allometry/f90src/AllomUnitWrap.F90_in +++ /dev/null @@ -1,218 +0,0 @@ - -! ======================================================================================= -! -! This file is an alternative to key files in the fates -! filesystem. Noteably, we replace fates_r8 and fates_in -! with types that work with "ctypes". This is -! a key step in working with python -! -! We also wrap FatesGlobals to reduce the dependancy -! cascade that it pulls in from shr_log_mod. -! -! ======================================================================================= - -module shr_log_mod - - use iso_c_binding, only : c_char - use iso_c_binding, only : c_int - - contains - - function shr_log_errMsg(source, line) result(ans) - character(kind=c_char,len=*), intent(in) :: source - integer(c_int), intent(in) :: line - character(kind=c_char,len=128) :: ans - - ans = "source: " // trim(source) // " line: " - end function shr_log_errMsg - -end module shr_log_mod - - -module FatesGlobals - - contains - - integer function fates_log() - fates_log = -1 - end function fates_log - - subroutine fates_endrun(msg) - - implicit none - character(len=*), intent(in) :: msg ! string to be printed - - stop - - end subroutine fates_endrun - -end module FatesGlobals - - -module EDTypesMod - - use iso_c_binding, only : r8 => c_double - - integer, parameter :: nclmax = 2 - integer, parameter :: nlevleaf = 30 - real(r8), parameter :: dinc_ed = 1.0_r8 - -end module EDTypesMod - - -module EDPftvarcon - - use iso_c_binding, only : r8 => c_double - use iso_c_binding, only : i4 => c_int - use iso_c_binding, only : c_char - - integer,parameter :: SHR_KIND_CS = 80 ! short char - - type, public :: EDPftvarcon_inst_type - - ! VARIABLE-DEFINITIONS-HERE (DO NOT REMOVE THIS LINE, OR MOVE IT) - - end type EDPftvarcon_inst_type - - type ptr_var1 - real(r8), dimension(:), pointer :: var_rp - integer(i4), dimension(:), pointer :: var_ip - character(len=shr_kind_cs) :: var_name - integer :: vtype - end type ptr_var1 - - type ptr_var2 - real(r8), dimension(:,:), pointer :: var_rp - integer(i4), dimension(:,:), pointer :: var_ip - character(len=shr_kind_cs) :: var_name - integer :: vtype - end type ptr_var2 - - type EDPftvarcon_ptr_type - type(ptr_var1), allocatable :: var1d(:) - type(ptr_var2), allocatable :: var2d(:) - end type EDPftvarcon_ptr_type - - - type(EDPftvarcon_inst_type), public :: EDPftvarcon_inst ! ED ecophysiological constants structure - type(EDPftvarcon_ptr_type), public :: EDPftvarcon_ptr ! Pointer structure for obj-oriented id - - integer :: numparm1d ! Number of different PFT parameters - integer :: numparm2d - integer :: numpft - - logical, parameter :: debug = .true. - -contains - - - subroutine EDPftvarconPySet(ipft,rval,ival,name) - - implicit none - ! Arguments - integer(i4),intent(in) :: ipft - character(kind=c_char,len=*), intent(in) :: name - real(r8),intent(in) :: rval - integer(i4),intent(in) :: ival - ! Locals - logical :: npfound - integer :: ip - integer :: namelen - - namelen = len(trim(name)) - - if(debug) print*,"F90: ARGS: ",trim(name)," IPFT: ",ipft," RVAL: ",rval," IVAL: ",ival - - ip=0 - npfound = .true. - do ip=1,numparm1d - - if (trim(name) == trim(EDPftvarcon_ptr%var1d(ip)%var_name ) ) then - print*,"F90: Found ",trim(name)," in lookup table" - npfound = .false. - if(EDPftvarcon_ptr%var1d(ip)%vtype == 1) then ! real - EDPftvarcon_ptr%var1d(ip)%var_rp(ipft) = rval - elseif(EDPftvarcon_ptr%var1d(ip)%vtype == 2) then ! integer - EDPftvarcon_ptr%var1d(ip)%var_ip(ipft) = ival - else - print*,"F90: STRANGE TYPE" - stop - end if - end if - end do - - if(npfound)then - print*,"F90: The parameter you loaded DNE: ",name(:) - stop - end if - - do ip=1,numparm2d - if (trim(name) == trim(EDPftvarcon_ptr%var2d(ip)%var_name)) then - print*,"F90: Found ",trim(name)," in lookup table" - print*,"BUT... WE AVOID USING 2D VARIABLES FOR NOW..." - print*,"REMOVE THIS TEST" - stop - end if - end do - - - ! Perform a check to see if the target array is being filled - if (trim(name) == 'fates_allom_d2h1') then - if (EDPftvarcon_inst%allom_d2h1(ipft) == rval) then - print*,"F90: POINTER CHECK PASSES:",rval," = ",EDPftvarcon_inst%allom_d2h1(ipft) - else - print*,"F90: POINTER CHECK FAILS:",rval," != ",EDPftvarcon_inst%allom_d2h1(ipft) - stop - end if - end if - - if (trim(name) == 'fates_wood_density' ) then - if (EDPftvarcon_inst%wood_density(ipft) == rval) then - print*,"F90: POINTER CHECK PASSES:",rval," = ",EDPftvarcon_inst%wood_density(ipft) - else - print*,"F90: POINTER CHECK FAILS:",rval," != ",EDPftvarcon_inst%wood_density(ipft) - stop - end if - end if - - return - end subroutine EDPftvarconPySet - - - subroutine EDPftvarconAlloc(numpft_in) - ! - - ! !ARGUMENTS: - integer(i4), intent(in) :: numpft_in - ! LOCALS: - integer :: iv1 ! The parameter incrementer - integer :: iv2 - !------------------------------------------------------------------------ - - numpft = numpft_in - - allocate( EDPftvarcon_ptr%var1d(100)) ! Make this plenty large - allocate( EDPftvarcon_ptr%var2d(100)) - iv1=0 - iv2=0 - - ! POINTER-SPECIFICATION-HERE (DO NOT REMOVE THIS LINE, OR MOVE IT) - -! allocate( EDPftvarcon_inst%allom_dbh_maxheight (1:numpft)); EDPftvarcon_inst%allom_dbh_maxheight (:) = nan -! iv = iv + 1 -! EDPftvarcon_ptr%var1d(iv)%var_name = "fates_allom_dbh_maxheight" -! EDPftvarcon_ptr%var1d(iv)%var_rp => EDPftvarcon_inst%allom_dbh_maxheight -! EDPftvarcon_ptr%var1d(iv)%vtype = 1 - - - numparm1d = iv1 - numparm2d = iv2 - - - print*,"F90: ALLOCATED ",numparm1d," PARAMETERS, FOR ",numpft," PFTs" - - - return - end subroutine EDPftvarconAlloc - -end module EDPftvarcon diff --git a/functional_unit_testing/allometry/include/README b/functional_unit_testing/allometry/include/README deleted file mode 100644 index bfa612f78d..0000000000 --- a/functional_unit_testing/allometry/include/README +++ /dev/null @@ -1 +0,0 @@ -This holds the place of the include folder \ No newline at end of file diff --git a/functional_unit_testing/allometry/plots/README b/functional_unit_testing/allometry/plots/README deleted file mode 100644 index c32df9df9a..0000000000 --- a/functional_unit_testing/allometry/plots/README +++ /dev/null @@ -1 +0,0 @@ -Placeholder for the folder \ No newline at end of file diff --git a/functional_unit_testing/allometry/simple_build.sh b/functional_unit_testing/allometry/simple_build.sh deleted file mode 100755 index 114c82a15d..0000000000 --- a/functional_unit_testing/allometry/simple_build.sh +++ /dev/null @@ -1,58 +0,0 @@ -#!/bin/bash - -FC='gfortran -g -shared -fPIC' - -# First copy over the FatesConstants file, but change the types of the fates_r8 and fates_int - -old_fates_r8_str=`grep -e integer ../../main/FatesConstantsMod.F90 | grep fates_r8 | sed 's/^[ \t]*//;s/[ \t]*$//'` -new_fates_r8_str='use iso_c_binding, only: fates_r8 => c_double' - -old_fates_int_str=`grep -e integer ../../main/FatesConstantsMod.F90 | grep fates_int | sed 's/^[ \t]*//;s/[ \t]*$//'` -new_fates_int_str='use iso_c_binding, only: fates_int => c_int' - -# Add the new lines (need position change, don't swap) - -sed "/implicit none/i $new_fates_r8_str" ../../main/FatesConstantsMod.F90 > f90src/FatesConstantsMod.F90 -sed -i "/implicit none/i $new_fates_int_str" f90src/FatesConstantsMod.F90 - -# Delete the old lines - -sed -i "/$old_fates_r8_str/d" f90src/FatesConstantsMod.F90 -sed -i "/$old_fates_int_str/d" f90src/FatesConstantsMod.F90 - -sed -i "/private/d" f90src/FatesConstantsMod.F90 - -# This re-writes the wrapper so that it uses all the correct parameters -# in FatesAllometryMod.F90 -python AutoGenVarCon.py - - -# Procedure for auto-generating AllomUnitWrap -# 1) scan FatesAllometry and create list of EDPftVarcon_inst variables -# 2) scan EDpftVarcon and get the name of the in-file parameter names associated -# with these variables - - - - -rm -f include/*.o -rm -f include/*.mod - - -# Build the new file with constants - -${FC} -I include/ -J include/ -o include/FatesConstantsMod.o f90src/FatesConstantsMod.F90 - -${FC} -I include/ -J include/ -o include/AllomUnitWrap.o f90src/AllomUnitWrap.F90 - -${FC} -I include/ -J include/ -o include/FatesAllometryMod.o ../../biogeochem/FatesAllometryMod.F90 - - -#${FC} -g -o include/FatesConstantsMod.o ../main/FatesConstantsMod.F90 - -#gfortran -shared -fPIC -g -o include/EDTypesMod.o ../main/EDTypesMod.F90 - - - - -#gfortran diff --git a/functional_unit_testing/build_fortran_tests.py b/functional_unit_testing/build_fortran_tests.py new file mode 100644 index 0000000000..678a559f3c --- /dev/null +++ b/functional_unit_testing/build_fortran_tests.py @@ -0,0 +1,217 @@ +import os +import sys +import shutil + +_FATES_PYTHON = os.path.join(os.path.dirname(os.path.abspath(__file__))) +sys.path.insert(1, _FATES_PYTHON) + +from utils import add_cime_lib_to_path +add_cime_lib_to_path() + +from CIME.utils import get_src_root, run_cmd_no_fail, expect, stringify_bool +from CIME.build import CmakeTmpBuildDir +from CIME.XML.machines import Machines +from CIME.BuildTools.configure import configure, FakeCase +from CIME.XML.env_mach_specific import EnvMachSpecific + +_CIMEROOT = os.path.join(os.path.dirname(os.path.abspath(__file__)), "../../../cime") + +def run_cmake(name, test_dir, pfunit_path, cmake_args): + """Run cmake for the fortran unit tests + Arguments: + name (str) - name for output messages + test_dir (str) - directory to run Cmake in + pfunit_path (str) - path to pfunit + clean (bool) - clean the build + """ + if not os.path.isfile("CMakeCache.txt"): + print(f"Running cmake for {name}.") + + # directory with cmake modules + cmake_module_dir = os.path.abspath(os.path.join(_CIMEROOT, "CIME", "non_py", "src", "CMake")) + + # directory with genf90 + genf90_dir = os.path.join(_CIMEROOT, "CIME", "non_py", "externals", "genf90") + + cmake_command = [ + "cmake", + "-C Macros.cmake", + test_dir, + f"-DCIMEROOT={_CIMEROOT}", + f"-DSRC_ROOT={get_src_root()}", + f"-DCIME_CMAKE_MODULE_DIRECTORY={cmake_module_dir}", + "-DCMAKE_BUILD_TYPE=CESM_DEBUG", + f"-DCMAKE_PREFIX_PATH={pfunit_path}", + "-DUSE_MPI_SERIAL=ON", + "-DENABLE_GENF90=ON", + f"-DCMAKE_PROGRAM_PATH={genf90_dir}" + ] + + cmake_command.extend(cmake_args.split(" ")) + #print(" ".join(cmake_command)) + + run_cmd_no_fail(" ".join(cmake_command), combine_output=True) + + +def find_pfunit(caseroot, cmake_args): + """Find the pfunit installation we'll be using, and print its path + + Args: + caseroot (str): Directory with pfunit macros + cmake_args (str): The cmake args used to invoke cmake (so that we get the correct makefile vars) + """ + with CmakeTmpBuildDir(macroloc=caseroot) as cmaketmp: + all_vars = cmaketmp.get_makefile_vars(cmake_args=cmake_args) + + all_vars_list = all_vars.splitlines() + for all_var in all_vars_list: + if ":=" in all_var: + expect(all_var.count(":=") == 1, f"Bad makefile: {all_var}") + varname, value = [item.strip() for item in all_var.split(":=")] + if varname == "PFUNIT_PATH": + return value + + expect(False, "PFUNIT_PATH not found for this machine and compiler") + + return None + + +def prep_build_dir(build_dir, clean): + """Create (if necessary) build directory and clean contents (if asked to) + + Args: + build_dir (str): build directory name + clean (bool): whether or not to clean contents + """ + + # create the build directory + build_dir_path = os.path.abspath(build_dir) + if not os.path.isdir(build_dir_path): + os.mkdir(build_dir_path) + + # change into that directory + os.chdir(build_dir_path) + + # clean up any files if we want to + if clean: + clean_cmake_files() + + return build_dir_path + + +def clean_cmake_files(): + """Deletes all files related to build + + """ + if os.path.isfile("CMakeCache.txt"): + os.remove("CMakeCache.txt") + if os.path.isdir("CMakeFiles"): + shutil.rmtree("CMakeFiles") + + cwd_contents = os.listdir(os.getcwd()) + + # Clear contents to do with cmake cache + for file in cwd_contents: + if ( + file in ("Macros.cmake", "env_mach_specific.xml") + or file.startswith("Depends") + or file.startswith(".env_mach_specific") + ): + os.remove(file) + +def get_extra_cmake_args(build_dir, mpilib): + """Makes a fake case to grab the required cmake arguments + Args: + build_dir (str): build directory name + mpilib (str): MPI library name + """ + # get the machine objects file + machobj = Machines() + + # get compiler + compiler = machobj.get_default_compiler() + + # get operating system + os_ = machobj.get_value("OS") + + # Create the environment, and the Macros.cmake file + # + # + configure( + machobj, + build_dir, + ["CMake"], + compiler, + mpilib, + True, + "nuopc", + os_, + unit_testing=True, + ) + machspecific = EnvMachSpecific(build_dir, unit_testing=True) + + # make a fake case + fake_case = FakeCase(compiler, mpilib, True, "nuopc", threading=False) + + cmake_args = ( + "{}-DOS={} -DMACH={} -DCOMPILER={} -DDEBUG={} -DMPILIB={} -Dcompile_threaded={} -DCASEROOT={}".format( + "", + os_, + machobj.get_machine_name(), + compiler, + stringify_bool(True), + mpilib, + stringify_bool(False), + build_dir + ) + ) + + return cmake_args + +def run_make(name, make_j, clean=False, verbose=False): + """Run make in current working directory + + Args: + name (str): Name for output messages + make_j (int): number of processes to use for make + clean (bool, optional): whether or not to clean Defaults to False. + verbose (bool, optional): verbose error logging for make Defaults to False. + """ + + print(f"Running make for {name}.") + + if clean: + run_cmd_no_fail("make clean") + + make_command = ["make", "-j", str(make_j)] + + if verbose: + make_command.append("VERBOSE=1") + + run_cmd_no_fail(" ".join(make_command), combine_output=True) + + +def build_unit_tests(build_dir, name, cmake_directory, make_j, clean=False): + """Build the unit test executables + + Args: + build_dir (str): build directory + name (str): name for set of tests + cmake_directory (str): directory where the make CMakeLists.txt file is + make_j (int): number of processes to use for make + clean (bool, optional): whether or not to clean the build first. Defaults to False. + """ + # create the build directory + full_build_path = prep_build_dir(build_dir, clean=clean) + + # get cmake args and the pfunit path + cmake_args = get_extra_cmake_args(full_build_path, "mpi-serial") + pfunit_path = find_pfunit(full_build_path, cmake_args) + + # change into the build dir + os.chdir(full_build_path) + + # run cmake and make + run_cmake(name, cmake_directory, pfunit_path, cmake_args) + run_make(name, make_j, clean=clean) + diff --git a/functional_unit_testing/run_fates_tests.py b/functional_unit_testing/run_fates_tests.py new file mode 100755 index 0000000000..3d08002291 --- /dev/null +++ b/functional_unit_testing/run_fates_tests.py @@ -0,0 +1,37 @@ +#!/usr/bin/env python3 + +import os +import sys +from build_fortran_tests import build_unit_tests + +_FATES_PYTHON = os.path.join(os.path.dirname(os.path.abspath(__file__))) +sys.path.insert(1, _FATES_PYTHON) + +from utils import add_cime_lib_to_path +add_cime_lib_to_path() + +from CIME.utils import run_cmd_no_fail + + +if __name__ == "__main__": + + ## Arguments + clean = True + build = True + build_dir = "../_build" + name = "fates_unit_tests" + make_j = 8 + cmake_directory = os.path.abspath("../") + + ## Constants + test_dir = "fates_allom_test" + test_exe = "FATES_allom_exe" + + if build: + build_unit_tests(build_dir, name, cmake_directory, make_j, clean=clean) + + build_dir_path = os.path.abspath(build_dir) + exe_path = os.path.join(build_dir_path, test_dir, test_exe) + + out = run_cmd_no_fail(exe_path, combine_output=True) + print(out) \ No newline at end of file diff --git a/functional_unit_testing/utils.py b/functional_unit_testing/utils.py new file mode 100644 index 0000000000..e4f74e0b68 --- /dev/null +++ b/functional_unit_testing/utils.py @@ -0,0 +1,57 @@ +"""Utility functions related to getting paths to various important places +""" + +import os +import sys + +# ======================================================================== +# Constants that may need to be changed if directory structures change +# ======================================================================== + +# Path to the root directory of FATES, based on the path of this file +# +# Note: It's important that this NOT end with a trailing slash; +# os.path.normpath guarantees this. +_FATES_ROOT = os.path.normpath( + os.path.join(os.path.dirname(os.path.abspath(__file__)), os.pardir) +) + +def path_to_fates_root(): + """Returns the path to the root directory of FATES""" + return _FATES_ROOT + +def path_to_cime(): + """Returns the path to cime, if it can be found + + Raises a RuntimeError if it cannot be found + + """ + cime_path = os.path.join(path_to_fates_root(), "../../cime") + if os.path.isdir(cime_path): + return cime_path + raise RuntimeError("Cannot find cime.") + +def prepend_to_python_path(path): + """Adds the given path to python's sys.path if it isn't already in the path + + The path is added near the beginning, so that it takes precedence over existing + entries in the path + """ + if not path in sys.path: + # Insert at location 1 rather than 0, because 0 is special + sys.path.insert(1, path) + +def add_cime_lib_to_path(): + """Adds the CIME python library to the python path, to allow importing + modules from that library + + Returns the path to the top-level cime directory + + For documentation on standalone_only: See documentation in + path_to_cime + """ + cime_path = path_to_cime() + prepend_to_python_path(cime_path) + cime_lib_path = os.path.join(cime_path, "CIME", "Tools") + prepend_to_python_path(cime_lib_path) + return cime_path \ No newline at end of file diff --git a/main/CMakeLists.txt b/main/CMakeLists.txt index dfd5eaba2a..a680dbaa4b 100644 --- a/main/CMakeLists.txt +++ b/main/CMakeLists.txt @@ -12,3 +12,20 @@ list(APPEND clm_sources ) sourcelist_to_parent(clm_sources) + +list(APPEND fates_sources + FatesConstantsMod.F90 + FatesGlobals.F90 + FatesParametersInterface.F90 + FatesInterfaceTypesMod.F90 + EDPftvarcon.F90 + EDParamsMod.F90 + EDTypesMod.F90 + FatesHydraulicsMemMod.F90 + FatesRunningMeanMod.F90 + FatesParameterDerivedMod.F90 + FatesSizeAgeTypeIndicesMod.F90 + FatesIntegratorsMod.F90 + FatesUtilsMod.F90) + +sourcelist_to_parent(fates_sources) diff --git a/parteh/CMakeLists.txt b/parteh/CMakeLists.txt new file mode 100644 index 0000000000..67c8a175a2 --- /dev/null +++ b/parteh/CMakeLists.txt @@ -0,0 +1,8 @@ +list(APPEND fates_sources + PRTParametersMod.F90 + PRTParamsFATESMod.F90 + PRTGenericMod.F90 + PRTAllometricCarbonMod.F90 + PRTAllometricCNPMod.F90) + +sourcelist_to_parent(fates_sources) \ No newline at end of file diff --git a/radiation/CMakeLists.txt b/radiation/CMakeLists.txt new file mode 100644 index 0000000000..84e72877ec --- /dev/null +++ b/radiation/CMakeLists.txt @@ -0,0 +1,6 @@ +list(APPEND fates_sources + TwoStreamMLPEMod.F90 + FatesRadiationMemMod.F90 + ) + +sourcelist_to_parent(fates_sources) \ No newline at end of file diff --git a/unit_test_shr/CMakeLists.txt b/unit_test_shr/CMakeLists.txt new file mode 100644 index 0000000000..18d2931194 --- /dev/null +++ b/unit_test_shr/CMakeLists.txt @@ -0,0 +1,5 @@ +list(APPEND fates_sources + FatesUnitTestParamReaderMod.F90 + ) + +sourcelist_to_parent(fates_sources) \ No newline at end of file diff --git a/unit_test_shr/FatesUnitTestIOMod.F90 b/unit_test_shr/FatesUnitTestIOMod.F90 new file mode 100644 index 0000000000..07ae70c765 --- /dev/null +++ b/unit_test_shr/FatesUnitTestIOMod.F90 @@ -0,0 +1,571 @@ +module FatesUnitTestIOMod + use FatesConstantsMod, only : r8 => fates_r8 + use shr_kind_mod, only : SHR_KIND_CL + !use netcdf + + implicit none + + ! LOCALS + ! integer, parameter :: BASE_UNIT = 10 ! Base unit for files the first time unit_number is called + ! integer, parameter :: MAX_PATH = 256 ! Maximum path length + ! integer, parameter :: MAX_CHAR = 80 ! Maximum length for messages + ! integer :: logf ! Unit number for output log file + ! integer, parameter :: type_double = 1 ! type + ! integer, parameter :: type_int = 2 ! type + + ! interface GetVar + ! module procedure GetVar1DReal + ! module procedure GetVar2DReal + ! module procedure GetVar3DReal + ! module procedure GetVar1DInt + ! module procedure GetVar2DInt + ! module procedure GetVar3DInt + ! end interface + + contains + + character(len=*) function full_file_path(filename) + ! + ! DESCRIPTION: + ! Obtain full path of file + ! First check current working directory + ! Then check full pathname on disk + + ! ARGUMENTS: + character(len=*), intent(in) :: filename + + ! LOCALS: + + ! get local file name + !full_file_path = 'file_path'!get_filename(filename) + + end function full_file_path + + ! integer function UnitNumber() + ! ! + ! ! DESCRIPTION: + ! ! Generates a unit number to be used in opening files + ! ! The first time the function is called, it returns BASE_UNIT + ! ! + ! ! LOCALS: + ! integer :: iunit ! File unit (increments after first call) + ! logical :: first = .true. ! First time this has been called? + ! save + + ! if (first) then + ! ! Set first to false and iunit to base unit on first call + ! iunit = BASE_UNIT + ! first = .false. + ! else + ! ! Otherwise, increment + ! iunit = iunit + 1 + ! endif + + ! ! Set to output + ! UnitNumber = iunit + + ! end function UnitNumber + + ! !===================================================================================== + + ! character(len=9) function FileMode(mode) + ! ! + ! ! DESCRIPTION: + ! ! Gets a file mode + ! ! + + ! ! ARGUMENTS: + ! character(len=*), intent(in), optional :: mode ! Optional mode ('r', 'w', 'rw') + + ! ! Get mode of open (read, write, or read/write) + ! select case(mode) + ! case ('r', 'R') + ! FileMode = 'read' + ! case ('w', 'W') + ! FileMode = 'write' + ! case ('rw', 'RW', 'wr', 'WR') + ! FileMode = 'readwrite' + ! case DEFAULT + ! FileMode = 'readwrite' + ! end select + + ! end function FileMode + + ! !===================================================================================== + + ! logical function CheckFile(filename, fmode) + ! ! + ! ! DESCRIPTION: + ! ! Checks to see if a file exists and checks against the mode + ! ! + + ! ! ARGUMENTS: + ! character(len=*), intent(in) :: filename ! Name of file to open + ! character(len=*), intent(in) :: fmode ! File mode + + ! ! LOCALS: + ! character(len=MAX_PATH) :: fname ! Local filename (trimmed) + ! integer, dimension(MAX_PATH) :: farray ! Array of characters of file name + ! integer :: i ! looping index + ! integer :: ios ! I/O status + ! logical :: file_exists ! Does the file exist? + + ! ! trim filename of whitespace + ! fname = trim(adjustl(filename)) + + ! if (fmode == 'read' .or. fmode == 'readwrite') then + ! ! Check for valid name of file + ! farray = 0 + ! do i = 1, len_trim(fname) + ! farray(i) = ichar(fname(i:i)) + ! enddo + ! if (any(farray > MAX_PATH)) then + ! write(logf,'(A)') "Invalid filename" + ! CheckFile = .false. + ! return + ! endif + ! endif + + ! ! Does the file exist? + ! inquire(file=fname, exist=file_exists) + + ! ! Open file if conditions are correct + ! if (file_exists .and. fmode == 'write') then + ! write(logf,'(A,A,A)') "File ", fname(1:len_trim(fname)), & + ! " exists. Cannot open write only." + ! CheckFile = .false. + ! else if (.not. file_exists .and. fmode == 'read') then + ! write(logf, '(A,A,A)') "File ", fname(1:len_trim(fname)), & + ! " does not exist. Can't read." + ! CheckFile = .false. + ! else + ! CheckFile = .true. + ! endif + + ! end function CheckFile + + ! !===================================================================================== + + ! integer function OpenFile(filename, mode) + ! ! + ! ! DESCRIPTION: + ! ! Opens the file filename if it can, returns a unit number for it. + ! ! The first time the function is called, it returns BASE_UNIT + ! ! + + ! ! ARGUMENTS: + ! character(len = *), intent(in) :: filename ! Name of file to open + ! character(len = *), intent(in), optional :: mode ! Optional mode ('r', 'w', 'rw') + + ! ! LOCALS: + ! character(len=9) :: fmode ! file mode + ! integer :: iunit ! file unit number + ! integer :: ios ! I/O status + ! character(len=MAX_PATH) :: fname ! Local filename (trimmed) + + ! ! get the file mode, defaults to readwrite + ! if (present(mode)) then + ! fmode = FileMode(mode) + ! else + ! fmode = 'readwrite' + ! end if + + ! if (CheckFile(filename, fmode)) then + + ! ! trim filename of whitespace + ! fname = trim(adjustl(filename)) + + ! iunit = UnitNumber() + ! open(iunit, file=fname, action=fmode, iostat=ios) + ! if (ios /= 0) then + ! write(logf,'(A,A,A,I6)') "Problem opening", & + ! fname(1:len_trim(fname)), " ios: ", ios + ! stop + ! endif + ! else + ! stop + ! end if + + ! OpenFile = iunit + + ! end function OpenFile + + ! !===================================================================================== + + ! subroutine Check(status) + ! ! + ! ! DESCRIPTION: + ! ! Checks status of netcdf operations + + ! ! ARGUMENTS: + ! integer, intent(in) :: status ! return status code from a netcdf procedure + + ! if (status /= nf90_noerr) then + ! write(logf,*) trim(nf90_strerror(status)) + ! stop + ! end if + + ! end subroutine Check + + ! !===================================================================================== + + ! subroutine OpenNCFile(nc_file, ncid, fmode) + ! ! + ! ! DESCRIPTION: + ! ! Opens a netcdf file + + ! ! ARGUMENTS: + ! character(len=*), intent(in) :: nc_file ! file name + ! integer, intent(out) :: ncid ! netcdf file unit number + ! character(len=*) :: fmode ! file mode + + ! if (CheckFile(nc_file, fmode)) then + ! ! depending on mode + ! select case(fmode) + ! case ('read') + ! call Check(nf90_open(trim(nc_file), NF90_NOCLOBBER, ncid)) + ! case ('write') + ! call Check(nf90_create(trim(nc_file), NF90_CLOBBER, ncid)) + ! case ('readwrite') + ! call Check(nf90_create(trim(nc_file), NF90_CLOBBER, ncid)) + ! case DEFAULT + ! write(logf,*) 'Need to specify read, write, or readwrite' + ! stop + ! end select + ! else + ! write(logf,*) 'Problem reading file' + ! stop + ! end if + + ! end subroutine OpenNCFile + + ! !===================================================================================== + + ! subroutine CloseNCFile(ncid) + ! ! + ! ! DESCRIPTION: + ! ! Closes a netcdf file + + ! ! ARGUMENTS: + ! integer, intent(in) :: ncid ! netcdf file unit number + + ! call Check(nf90_close(ncid)) + + ! end subroutine CloseNCFile + + ! !===================================================================================== + + ! subroutine GetDims(ncid, varID, dim_lens) + ! ! + ! ! DESCRIPTION: + ! ! Get dimensions for a netcdf variable + ! ! + + ! ! ARGUMENTS + ! integer, intent(in) :: ncid ! netcdf file unit ID + ! integer, intent(in) :: varID ! variable ID + ! integer, allocatable, intent(out) :: dim_lens(:) ! dimension lengths + + ! ! LOCALS: + ! integer :: numDims ! number of dimensions + ! integer, allocatable :: dimIDs(:) ! dimension IDs + ! integer :: i ! looping index + + ! ! find dimensions of data + ! call Check(nf90_inquire_variable(ncid, varID, ndims=numDims)) + + ! ! allocate data to grab dimension information + ! allocate(dim_lens(numDims)) + ! allocate(dimIDs(numDims)) + + ! ! get dimIDs + ! call Check(nf90_inquire_variable(ncid, varID, dimids=dimIDs)) + + ! ! grab these dimensions + ! do i = 1, numDims + ! call Check(nf90_inquire_dimension(ncid, dimIDs(i), len=dim_lens(i))) + ! end do + + ! end subroutine GetDims + + ! !===================================================================================== + + ! subroutine GetVar1DReal(ncid, var_name, data) + ! ! + ! ! DESCRIPTION: + ! ! Read in variables for 1D real data + ! ! + + ! ! ARGUMENTS: + ! integer, intent(in) :: ncid ! netcdf file unit ID + ! character(len=*), intent(in) :: var_name ! variable name + ! real(r8), allocatable, intent(out) :: data(:) ! data values + + ! ! LOCALS: + ! integer :: varID ! variable ID + ! integer, allocatable :: dim_lens(:) ! dimension lengths + + ! ! find variable ID first + ! call Check(nf90_inq_varid(ncid, var_name, varID)) + + ! ! get dimensions of data + ! call GetDims(ncid, varID, dim_lens) + + ! ! read data + ! allocate(data(dim_lens(1))) + ! call Check(nf90_get_var(ncid, varID, data)) + + ! end subroutine GetVar1DReal + + ! !===================================================================================== + + ! subroutine GetVar1DInt(ncid, var_name, data) + ! ! + ! ! DESCRIPTION: + ! ! Read in variables for 1D integer data + ! ! + + ! ! ARGUMENTS: + ! integer, intent(in) :: ncid ! netcdf file unit ID + ! character(len=*), intent(in) :: var_name ! variable name + ! integer, allocatable, intent(out) :: data(:) ! data values + + ! ! LOCALS: + ! integer :: varID ! variable ID + ! integer, allocatable :: dim_lens(:) ! dimension lengths + + ! ! find variable ID first + ! call Check(nf90_inq_varid(ncid, var_name, varID)) + + ! ! get dimensions of data + ! call GetDims(ncid, varID, dim_lens) + + ! ! read data + ! allocate(data(dim_lens(1))) + ! call Check(nf90_get_var(ncid, varID, data)) + + ! end subroutine GetVar1DInt + + ! !===================================================================================== + + ! subroutine GetVar2DReal(ncid, var_name, data) + ! ! + ! ! DESCRIPTION: + ! ! Read in variables for 2D real data + ! ! + + ! ! ARGUMENTS: + ! integer, intent(in) :: ncid ! netcdf file unit ID + ! character(len=*), intent(in) :: var_name ! variable name + ! real(r8), allocatable, intent(out) :: data(:,:) ! data values + + ! ! LOCALS: + ! integer :: varID ! variable ID + ! integer, allocatable :: dim_lens(:) ! dimension lengths + + ! ! find variable ID first + ! call Check(nf90_inq_varid(ncid, var_name, varID)) + + ! ! get dimensions of data + ! call GetDims(ncid, varID, dim_lens) + + ! ! read data + ! allocate(data(dim_lens(1), dim_lens(2))) + ! call Check(nf90_get_var(ncid, varID, data)) + + ! end subroutine GetVar2DReal + + ! !===================================================================================== + + ! subroutine GetVar2DInt(ncid, var_name, data) + ! ! + ! ! DESCRIPTION: + ! ! Read in variables for 2D integer data + ! ! + + ! ! ARGUMENTS: + ! integer, intent(in) :: ncid ! netcdf file unit ID + ! character(len=*), intent(in) :: var_name ! variable name + ! integer, allocatable, intent(out) :: data(:,:) ! data values + + ! ! LOCALS: + ! integer :: varID ! variable ID + ! integer, allocatable :: dim_lens(:) ! dimension lengths + + ! ! find variable ID first + ! call Check(nf90_inq_varid(ncid, var_name, varID)) + + ! ! get dimensions of data + ! call GetDims(ncid, varID, dim_lens) + + ! ! read data + ! allocate(data(dim_lens(1), dim_lens(2))) + ! call Check(nf90_get_var(ncid, varID, data)) + + ! end subroutine GetVar2DInt + + ! !===================================================================================== + + ! subroutine GetVar3DReal(ncid, var_name, data) + ! ! + ! ! DESCRIPTION: + ! ! Read in variables for 3D real data + ! ! + + ! ! ARGUMENTS: + ! integer, intent(in) :: ncid ! netcdf file unit ID + ! character(len=*), intent(in) :: var_name ! variable name + ! real(r8), allocatable, intent(out) :: data(:,:,:) ! data values + + ! ! LOCALS: + ! integer :: varID ! variable ID + ! integer, allocatable :: dim_lens(:) ! dimension lengths + + ! ! find variable ID first + ! call Check(nf90_inq_varid(ncid, var_name, varID)) + + ! ! get dimensions of data + ! call GetDims(ncid, varID, dim_lens) + + ! ! read data + ! allocate(data(dim_lens(1), dim_lens(2), dim_lens(3))) + ! call Check(nf90_get_var(ncid, varID, data)) + + ! end subroutine GetVar3DReal + + ! !===================================================================================== + + ! subroutine GetVar3DInt(ncid, var_name, data) + ! ! + ! ! DESCRIPTION: + ! ! Read in variables for 3D integer data + ! ! + + ! ! ARGUMENTS: + ! integer, intent(in) :: ncid ! netcdf file unit ID + ! character(len=*), intent(in) :: var_name ! variable name + ! integer, allocatable, intent(out) :: data(:,:,:) ! data values + + ! ! LOCALS: + ! integer :: varID ! variable ID + ! integer, allocatable :: dim_lens(:) ! dimension lengths + + ! ! find variable ID first + ! call Check(nf90_inq_varid(ncid, var_name, varID)) + + ! ! get dimensions of data + ! call GetDims(ncid, varID, dim_lens) + + ! ! read data + ! allocate(data(dim_lens(1), dim_lens(2), dim_lens(3))) + ! call Check(nf90_get_var(ncid, varID, data)) + + ! end subroutine GetVar3DInt + + ! !===================================================================================== + + ! subroutine RegisterNCDims(ncid, dim_names, dim_lens, num_dims, dim_IDs) + ! ! + ! ! DESCRIPTION: + ! ! Defines variables and dimensions + ! ! + + ! ! ARGUMENTS: + ! integer, intent(in) :: ncid ! netcdf file id + ! character(len=*), intent(in) :: dim_names(num_dims) ! dimension names + ! integer, intent(in) :: dim_lens(num_dims) ! dimension lengths + ! integer, intent(in) :: num_dims ! number of dimensions + ! integer, intent(out) :: dim_IDs(num_dims) ! dimension IDs + + ! ! LOCALS: + ! integer :: i ! looping index + + ! do i = 1, num_dims + ! call Check(nf90_def_dim(ncid, dim_names(i), dim_lens(i), dim_IDs(i))) + ! end do + + ! end subroutine RegisterNCDims + + ! !===================================================================================== + + ! subroutine RegisterVar1D(ncid, var_name, dimID, type, att_names, atts, num_atts, varID) + ! ! + ! ! DESCRIPTION: + ! ! Defines variables and dimensions + ! ! + + ! ! ARGUMENTS: + ! integer, intent(in) :: ncid ! netcdf file id + ! character(len=*), intent(in) :: var_name ! variable name + ! integer, intent(in) :: dimID(1) ! dimension ID + ! integer, intent(in) :: type ! type: int or double + ! character(len=*), intent(in) :: att_names(num_atts) ! attribute names + ! character(len=*), intent(in) :: atts(num_atts) ! attribute values + ! integer, intent(in) :: num_atts ! number of attributes + ! integer, intent(out) :: varID ! variable ID + + + ! ! LOCALS: + ! integer :: i ! looping index + ! integer :: nc_type ! netcdf type + + ! if (type == type_double) then + ! nc_type = NF90_DOUBLE + ! else if (type == type_int) then + ! nc_type = NF90_INT + ! else + ! write(logf, *) "Must pick correct type" + ! stop + ! end if + + ! call Check(nf90_def_var(ncid, var_name, nc_type, dimID, varID)) + + ! do i = 1, num_atts + ! call Check(nf90_put_att(ncid, varID, att_names(i), atts(i))) + ! end do + + ! end subroutine RegisterVar1D + + ! !===================================================================================== + + ! subroutine RegisterVar2D(ncid, var_name, dimID, type, att_names, atts, num_atts, varID) + ! ! + ! ! DESCRIPTION: + ! ! Defines variables and dimensions + ! ! + + ! ! ARGUMENTS: + ! integer, intent(in) :: ncid ! netcdf file id + ! character(len=*), intent(in) :: var_name ! variable name + ! integer, intent(in) :: dimID(1:2) ! dimension ID + ! integer, intent(in) :: type ! type: int or double + ! character(len=*), intent(in) :: att_names(num_atts) ! attribute names + ! character(len=*), intent(in) :: atts(num_atts) ! attribute values + ! integer, intent(in) :: num_atts ! number of attributes + ! integer, intent(out) :: varID ! variable ID + + + ! ! LOCALS: + ! integer :: i ! looping index + ! integer :: nc_type ! netcdf type + + ! if (type == type_double) then + ! nc_type = NF90_DOUBLE + ! else if (type == type_int) then + ! nc_type = NF90_INT + ! else + ! write(logf, *) "Must pick correct type" + ! stop + ! end if + + ! call Check(nf90_def_var(ncid, var_name, nc_type, dimID, varID)) + + ! do i = 1, num_atts + ! call Check(nf90_put_att(ncid, varID, att_names(i), atts(i))) + ! end do + + ! end subroutine RegisterVar2D + + !===================================================================================== + +end module FatesUnitTestIOMod \ No newline at end of file diff --git a/unit_test_shr/FatesUnitTestParamReaderMod.F90 b/unit_test_shr/FatesUnitTestParamReaderMod.F90 new file mode 100644 index 0000000000..6cefe91df5 --- /dev/null +++ b/unit_test_shr/FatesUnitTestParamReaderMod.F90 @@ -0,0 +1,59 @@ +module FatesUnitTestParamReaderMod + + use FatesParametersInterface, only : fates_param_reader_type + use FatesParametersInterface, only : fates_parameters_type + use PRTInitParamsFatesMod, only : PRTRegisterParams + + implicit none + private + + type, public, extends(fates_param_reader_type) :: fates_unit_test_param_reader + + character(:), allocatable :: filename ! local file name of parameter + + contains + procedure, public :: Read => read_parameters + procedure, public :: param_read + + end type fates_unit_test_param_reader + + contains + + subroutine read_parameters(this, fates_params) + ! + ! DESCRIPTION: + ! Read 'fates_params' parameters from storage + ! + ! ARGUMENTS: + class(fates_unit_test_param_reader) :: this + class(fates_parameters_type), intent(inout) :: fates_params + + print *, "read in parameters" + + !call ParametersFromNetCDF(fates_paramfile, is_host_file, fates_params) + + end subroutine read_parameters + + ! -------------------------------------------------------------------------------------- + + subroutine param_read(this) + ! + ! DESCRIPTION: + ! Read in fates parameters + ! + ! ARGUMENTS: + class(fates_unit_test_param_reader), intent(in) :: this + + ! LOCALS: + !class(fates_parameters_type), allocatable :: fates_params + + ! allocate and read in parameters + !allocate(fates_params) + !call fates_params%Init() + !call PRTRegisterParams(fates_params) + + !call this%Read(fates_params) + + end subroutine param_read + +end module FatesUnitTestParamReaderMod \ No newline at end of file From 762681d91284fdb9cbf8f0380aa7c6495462b595 Mon Sep 17 00:00:00 2001 From: adrifoster Date: Mon, 15 Apr 2024 09:18:06 -0600 Subject: [PATCH 080/176] trying to get test to work --- functional_unit_testing/allometry/FatesTestAllometry.F90 | 1 + 1 file changed, 1 insertion(+) diff --git a/functional_unit_testing/allometry/FatesTestAllometry.F90 b/functional_unit_testing/allometry/FatesTestAllometry.F90 index 10be571f67..03ef9ac4d3 100644 --- a/functional_unit_testing/allometry/FatesTestAllometry.F90 +++ b/functional_unit_testing/allometry/FatesTestAllometry.F90 @@ -2,6 +2,7 @@ program FatesTestAllometry !use FatesAllometryMod, only : h2d_allom !use PRTParametersMod, only : prt_params + use funit use FatesUnitTestParamReaderMod, only : fates_unit_test_param_reader implicit none From a5223429f69c7ce2e84791af3a79be4b0e7ca4c2 Mon Sep 17 00:00:00 2001 From: adrifoster Date: Tue, 16 Apr 2024 12:25:46 -0600 Subject: [PATCH 081/176] allow read in of parameters --- CMakeLists.txt | 15 + .../allometry/CMakeLists.txt | 18 +- .../allometry/FatesTestAllometry.F90 | 12 +- functional_unit_testing/run_fates_tests.py | 12 + main/CMakeLists.txt | 3 +- main/FatesParametersInterface.F90 | 2 +- unit_test_shr/CMakeLists.txt | 1 + unit_test_shr/FatesUnitTestIOMod.F90 | 942 ++++++++---------- unit_test_shr/FatesUnitTestParamReaderMod.F90 | 173 +++- 9 files changed, 650 insertions(+), 528 deletions(-) diff --git a/CMakeLists.txt b/CMakeLists.txt index 3f15615d18..868614bfac 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -63,6 +63,21 @@ add_dependencies(fates csm_share) # We need to look for header files here, in order to pick up shr_assert.h include_directories(${HLM_ROOT}/share/include) +# This needs to be something we add dynamically +# via some calls using cime +set(NETCDF_C_DIR "/usr/local/Cellar/netcdf/4.9.2_1") +set(NETCDF_FORTRAN_DIR "/usr/local/Cellar/netcdf-fortran/4.6.1") + +FIND_PATH(NETCDFC_FOUND libnetcdf.a ${NETCDF_C_DIR}/lib) +FIND_PATH(NETCDFF_FOUND libnetcdff.a ${NETCDF_FORTRAN_DIR}/lib) +MESSAGE(" NETCDFC_FOUND = ${NETCDFC_FOUND}") +MESSAGE(" NETCDFF_FOUND = ${NETCDFF_FOUND}") + +include_directories(${NETCDF_C_DIR}/include + ${NETCDF_FORTRAN_DIR}/include) +link_directories(${NETCDF_C_DIR}/lib + ${NETCDF_FORTRAN_DIR}/lib) + # Tell cmake to look for libraries & mod files here, because this is where we built libraries include_directories(${CMAKE_CURRENT_BINARY_DIR}) link_directories(${CMAKE_CURRENT_BINARY_DIR}) diff --git a/functional_unit_testing/allometry/CMakeLists.txt b/functional_unit_testing/allometry/CMakeLists.txt index 362a541b61..3e05759809 100644 --- a/functional_unit_testing/allometry/CMakeLists.txt +++ b/functional_unit_testing/allometry/CMakeLists.txt @@ -1,10 +1,26 @@ set(allom_sources FatesTestAllometry.F90) +set(NETCDF_C_DIR "/usr/local/Cellar/netcdf/4.9.2_1") +set(NETCDF_FORTRAN_DIR "/usr/local/Cellar/netcdf-fortran/4.6.1") + +FIND_PATH(NETCDFC_FOUND libnetcdf.a ${NETCDF_C_DIR}/lib) +FIND_PATH(NETCDFF_FOUND libnetcdff.a ${NETCDF_FORTRAN_DIR}/lib) + +include_directories(${NETCDF_C_DIR}/include + ${NETCDF_FORTRAN_DIR}/include) + +link_directories(${NETCDF_C_DIR}/lib + ${NETCDF_FORTRAN_DIR}/lib + ${PFUNIT_TOP_DIR}/lib) + add_executable(FATES_allom_exe ${allom_sources}) target_link_libraries(FATES_allom_exe + netcdf + netcdff fates - csm_share) + csm_share + funit) add_test(allom_test FATES_allom_exe) diff --git a/functional_unit_testing/allometry/FatesTestAllometry.F90 b/functional_unit_testing/allometry/FatesTestAllometry.F90 index 03ef9ac4d3..b9f9446ed2 100644 --- a/functional_unit_testing/allometry/FatesTestAllometry.F90 +++ b/functional_unit_testing/allometry/FatesTestAllometry.F90 @@ -1,17 +1,17 @@ program FatesTestAllometry !use FatesAllometryMod, only : h2d_allom - !use PRTParametersMod, only : prt_params - use funit + use PRTParametersMod, only : prt_params use FatesUnitTestParamReaderMod, only : fates_unit_test_param_reader implicit none ! LOCALS: type(fates_unit_test_param_reader) :: param_reader - - call param_reader%param_read() - - print *, "Hello, allometry" + character(len=*), parameter :: param_file = 'fates_params_default.nc' + + call param_reader%Init(param_file) + call param_reader%RetrieveParameters() + end program FatesTestAllometry \ No newline at end of file diff --git a/functional_unit_testing/run_fates_tests.py b/functional_unit_testing/run_fates_tests.py index 3d08002291..6ca39c4fc7 100755 --- a/functional_unit_testing/run_fates_tests.py +++ b/functional_unit_testing/run_fates_tests.py @@ -22,6 +22,8 @@ name = "fates_unit_tests" make_j = 8 cmake_directory = os.path.abspath("../") + param_file = None + param_cdl_path = "../parameter_files/fates_params_default.cdl" ## Constants test_dir = "fates_allom_test" @@ -33,5 +35,15 @@ build_dir_path = os.path.abspath(build_dir) exe_path = os.path.join(build_dir_path, test_dir, test_exe) + if param_file is None: + file_basename = os.path.basename(param_cdl_path).split(".")[-2] + file_nc_name = f"{file_basename}.nc" + file_gen_command = [ + "ncgen -o", + os.path.join(file_nc_name), + param_cdl_path + ] + run_cmd_no_fail(" ".join(file_gen_command), combine_output=True) + out = run_cmd_no_fail(exe_path, combine_output=True) print(out) \ No newline at end of file diff --git a/main/CMakeLists.txt b/main/CMakeLists.txt index a680dbaa4b..064ed5c992 100644 --- a/main/CMakeLists.txt +++ b/main/CMakeLists.txt @@ -26,6 +26,7 @@ list(APPEND fates_sources FatesParameterDerivedMod.F90 FatesSizeAgeTypeIndicesMod.F90 FatesIntegratorsMod.F90 - FatesUtilsMod.F90) + FatesUtilsMod.F90 + FatesSynchronizedParamsMod.F90) sourcelist_to_parent(fates_sources) diff --git a/main/FatesParametersInterface.F90 b/main/FatesParametersInterface.F90 index aa0ef85287..8ea2b8a13e 100644 --- a/main/FatesParametersInterface.F90 +++ b/main/FatesParametersInterface.F90 @@ -135,7 +135,7 @@ subroutine Destroy(this) integer :: n do n = 1, this%num_parameters - deallocate(this%parameters(n)%data) + if(allocated(this%parameters(n)%data)) deallocate(this%parameters(n)%data) end do end subroutine Destroy diff --git a/unit_test_shr/CMakeLists.txt b/unit_test_shr/CMakeLists.txt index 18d2931194..8cf4eb69c0 100644 --- a/unit_test_shr/CMakeLists.txt +++ b/unit_test_shr/CMakeLists.txt @@ -1,5 +1,6 @@ list(APPEND fates_sources FatesUnitTestParamReaderMod.F90 + FatesUnitTestIOMod.F90 ) sourcelist_to_parent(fates_sources) \ No newline at end of file diff --git a/unit_test_shr/FatesUnitTestIOMod.F90 b/unit_test_shr/FatesUnitTestIOMod.F90 index 07ae70c765..bbdf72b90c 100644 --- a/unit_test_shr/FatesUnitTestIOMod.F90 +++ b/unit_test_shr/FatesUnitTestIOMod.F90 @@ -1,571 +1,513 @@ module FatesUnitTestIOMod use FatesConstantsMod, only : r8 => fates_r8 + use FatesGlobals, only : fates_endrun use shr_kind_mod, only : SHR_KIND_CL - !use netcdf + use netcdf implicit none + private ! LOCALS - ! integer, parameter :: BASE_UNIT = 10 ! Base unit for files the first time unit_number is called - ! integer, parameter :: MAX_PATH = 256 ! Maximum path length - ! integer, parameter :: MAX_CHAR = 80 ! Maximum length for messages - ! integer :: logf ! Unit number for output log file - ! integer, parameter :: type_double = 1 ! type - ! integer, parameter :: type_int = 2 ! type - - ! interface GetVar - ! module procedure GetVar1DReal - ! module procedure GetVar2DReal - ! module procedure GetVar3DReal - ! module procedure GetVar1DInt - ! module procedure GetVar2DInt - ! module procedure GetVar3DInt - ! end interface + integer, parameter :: type_double = 1 ! type + integer, parameter :: type_int = 2 ! type + + interface GetVar + module procedure GetVarScalarReal + module procedure GetVar1DReal + module procedure GetVar2DReal + module procedure GetVar3DReal + module procedure GetVar1DInt + module procedure GetVar2DInt + module procedure GetVar3DInt + end interface + + public :: OpenNCFile + public :: CloseNCFile + public :: GetDimID + public :: GetDimLen + public :: GetVar contains - character(len=*) function full_file_path(filename) - ! - ! DESCRIPTION: - ! Obtain full path of file - ! First check current working directory - ! Then check full pathname on disk - - ! ARGUMENTS: - character(len=*), intent(in) :: filename - - ! LOCALS: - - ! get local file name - !full_file_path = 'file_path'!get_filename(filename) - - end function full_file_path - - ! integer function UnitNumber() - ! ! - ! ! DESCRIPTION: - ! ! Generates a unit number to be used in opening files - ! ! The first time the function is called, it returns BASE_UNIT - ! ! - ! ! LOCALS: - ! integer :: iunit ! File unit (increments after first call) - ! logical :: first = .true. ! First time this has been called? - ! save - - ! if (first) then - ! ! Set first to false and iunit to base unit on first call - ! iunit = BASE_UNIT - ! first = .false. - ! else - ! ! Otherwise, increment - ! iunit = iunit + 1 - ! endif - - ! ! Set to output - ! UnitNumber = iunit - - ! end function UnitNumber - - ! !===================================================================================== - - ! character(len=9) function FileMode(mode) - ! ! - ! ! DESCRIPTION: - ! ! Gets a file mode - ! ! - - ! ! ARGUMENTS: - ! character(len=*), intent(in), optional :: mode ! Optional mode ('r', 'w', 'rw') - - ! ! Get mode of open (read, write, or read/write) - ! select case(mode) - ! case ('r', 'R') - ! FileMode = 'read' - ! case ('w', 'W') - ! FileMode = 'write' - ! case ('rw', 'RW', 'wr', 'WR') - ! FileMode = 'readwrite' - ! case DEFAULT - ! FileMode = 'readwrite' - ! end select - - ! end function FileMode - - ! !===================================================================================== - - ! logical function CheckFile(filename, fmode) - ! ! - ! ! DESCRIPTION: - ! ! Checks to see if a file exists and checks against the mode - ! ! - - ! ! ARGUMENTS: - ! character(len=*), intent(in) :: filename ! Name of file to open - ! character(len=*), intent(in) :: fmode ! File mode - - ! ! LOCALS: - ! character(len=MAX_PATH) :: fname ! Local filename (trimmed) - ! integer, dimension(MAX_PATH) :: farray ! Array of characters of file name - ! integer :: i ! looping index - ! integer :: ios ! I/O status - ! logical :: file_exists ! Does the file exist? - - ! ! trim filename of whitespace - ! fname = trim(adjustl(filename)) - - ! if (fmode == 'read' .or. fmode == 'readwrite') then - ! ! Check for valid name of file - ! farray = 0 - ! do i = 1, len_trim(fname) - ! farray(i) = ichar(fname(i:i)) - ! enddo - ! if (any(farray > MAX_PATH)) then - ! write(logf,'(A)') "Invalid filename" - ! CheckFile = .false. - ! return - ! endif - ! endif - - ! ! Does the file exist? - ! inquire(file=fname, exist=file_exists) - - ! ! Open file if conditions are correct - ! if (file_exists .and. fmode == 'write') then - ! write(logf,'(A,A,A)') "File ", fname(1:len_trim(fname)), & - ! " exists. Cannot open write only." - ! CheckFile = .false. - ! else if (.not. file_exists .and. fmode == 'read') then - ! write(logf, '(A,A,A)') "File ", fname(1:len_trim(fname)), & - ! " does not exist. Can't read." - ! CheckFile = .false. - ! else - ! CheckFile = .true. - ! endif - - ! end function CheckFile - - ! !===================================================================================== - - ! integer function OpenFile(filename, mode) - ! ! - ! ! DESCRIPTION: - ! ! Opens the file filename if it can, returns a unit number for it. - ! ! The first time the function is called, it returns BASE_UNIT - ! ! - - ! ! ARGUMENTS: - ! character(len = *), intent(in) :: filename ! Name of file to open - ! character(len = *), intent(in), optional :: mode ! Optional mode ('r', 'w', 'rw') - - ! ! LOCALS: - ! character(len=9) :: fmode ! file mode - ! integer :: iunit ! file unit number - ! integer :: ios ! I/O status - ! character(len=MAX_PATH) :: fname ! Local filename (trimmed) - - ! ! get the file mode, defaults to readwrite - ! if (present(mode)) then - ! fmode = FileMode(mode) - ! else - ! fmode = 'readwrite' - ! end if - - ! if (CheckFile(filename, fmode)) then - - ! ! trim filename of whitespace - ! fname = trim(adjustl(filename)) - - ! iunit = UnitNumber() - ! open(iunit, file=fname, action=fmode, iostat=ios) - ! if (ios /= 0) then - ! write(logf,'(A,A,A,I6)') "Problem opening", & - ! fname(1:len_trim(fname)), " ios: ", ios - ! stop - ! endif - ! else - ! stop - ! end if - - ! OpenFile = iunit - - ! end function OpenFile - - ! !===================================================================================== - - ! subroutine Check(status) - ! ! - ! ! DESCRIPTION: - ! ! Checks status of netcdf operations - - ! ! ARGUMENTS: - ! integer, intent(in) :: status ! return status code from a netcdf procedure - - ! if (status /= nf90_noerr) then - ! write(logf,*) trim(nf90_strerror(status)) - ! stop - ! end if + !======================================================================================= - ! end subroutine Check + logical function CheckFile(filename, fmode) + ! + ! DESCRIPTION: + ! Checks to see if a file exists and checks against the mode + ! - ! !===================================================================================== + ! ARGUMENTS: + character(len=*), intent(in) :: filename ! Name of file to open + character(len=*), intent(in) :: fmode ! File mode - ! subroutine OpenNCFile(nc_file, ncid, fmode) - ! ! - ! ! DESCRIPTION: - ! ! Opens a netcdf file + ! LOCALS: + character(len=len(filename)) :: fname ! Local filename (trimmed) + integer :: ios ! I/O status + logical :: file_exists ! Does the file exist? - ! ! ARGUMENTS: - ! character(len=*), intent(in) :: nc_file ! file name - ! integer, intent(out) :: ncid ! netcdf file unit number - ! character(len=*) :: fmode ! file mode - - ! if (CheckFile(nc_file, fmode)) then - ! ! depending on mode - ! select case(fmode) - ! case ('read') - ! call Check(nf90_open(trim(nc_file), NF90_NOCLOBBER, ncid)) - ! case ('write') - ! call Check(nf90_create(trim(nc_file), NF90_CLOBBER, ncid)) - ! case ('readwrite') - ! call Check(nf90_create(trim(nc_file), NF90_CLOBBER, ncid)) - ! case DEFAULT - ! write(logf,*) 'Need to specify read, write, or readwrite' - ! stop - ! end select - ! else - ! write(logf,*) 'Problem reading file' - ! stop - ! end if - - ! end subroutine OpenNCFile - - ! !===================================================================================== - - ! subroutine CloseNCFile(ncid) - ! ! - ! ! DESCRIPTION: - ! ! Closes a netcdf file + ! trim filename of whitespace + fname = trim(adjustl(filename)) + + ! Does the file exist? + inquire(file=fname, exist=file_exists) + + select case (fmode) + case('read') + + if (.not. file_exists) then + write(*,'(a,a,a)') "File ", fname(1:len_trim(fname)), " does not exist. Can't read." + CheckFile = .false. + else + CheckFile = .true. + end if + + case('readwrite') + + if (.not. file_exists) then + write(*,'(a,a,a)') "File ", fname(1:len_trim(fname)), " does not exist. Can't read." + CheckFile = .false. + else + CheckFile = .true. + end if + + case('write') + if (file_exists) then + write(*, '(a, a, a)') "File ", fname(1:len_trim(fname)), " exists. Cannot open write only." + else + CheckFile = .true. + CheckFile = .false. + end if + case default + write(*,'(a)') "Invalid file mode." + CheckFile = .false. + end select + + end function CheckFile + + !======================================================================================= + + subroutine Check(status) + ! + ! DESCRIPTION: + ! Checks status of netcdf operations + + ! ARGUMENTS: + integer, intent(in) :: status ! return status code from a netcdf procedure - ! ! ARGUMENTS: - ! integer, intent(in) :: ncid ! netcdf file unit number + if (status /= nf90_noerr) then + write(*,*) trim(nf90_strerror(status)) + stop + end if - ! call Check(nf90_close(ncid)) + end subroutine Check - ! end subroutine CloseNCFile + ! ======================================================================================= - ! !===================================================================================== + subroutine OpenNCFile(nc_file, ncid, fmode) + ! + ! DESCRIPTION: + ! Opens a netcdf file - ! subroutine GetDims(ncid, varID, dim_lens) - ! ! - ! ! DESCRIPTION: - ! ! Get dimensions for a netcdf variable - ! ! - - ! ! ARGUMENTS - ! integer, intent(in) :: ncid ! netcdf file unit ID - ! integer, intent(in) :: varID ! variable ID - ! integer, allocatable, intent(out) :: dim_lens(:) ! dimension lengths - - ! ! LOCALS: - ! integer :: numDims ! number of dimensions - ! integer, allocatable :: dimIDs(:) ! dimension IDs - ! integer :: i ! looping index + ! ARGUMENTS: + character(len=*), intent(in) :: nc_file ! file name + integer, intent(out) :: ncid ! netcdf file unit number + character(len=*) :: fmode ! file mode + + if (CheckFile(nc_file, fmode)) then + ! depending on mode + select case(fmode) + case ('read') + call Check(nf90_open(trim(nc_file), NF90_NOCLOBBER, ncid)) + case ('write') + call Check(nf90_create(trim(nc_file), NF90_CLOBBER, ncid)) + case ('readwrite') + call Check(nf90_create(trim(nc_file), NF90_CLOBBER, ncid)) + case DEFAULT + write(*,*) 'Need to specify read, write, or readwrite' + stop + end select + else + write(*,*) 'Problem reading file' + stop + end if + + end subroutine OpenNCFile + + !======================================================================================= + + subroutine CloseNCFile(ncid) + ! + ! DESCRIPTION: + ! Closes a netcdf file - ! ! find dimensions of data - ! call Check(nf90_inquire_variable(ncid, varID, ndims=numDims)) + ! ARGUMENTS: + integer, intent(in) :: ncid ! netcdf file unit number - ! ! allocate data to grab dimension information - ! allocate(dim_lens(numDims)) - ! allocate(dimIDs(numDims)) + call Check(nf90_close(ncid)) - ! ! get dimIDs - ! call Check(nf90_inquire_variable(ncid, varID, dimids=dimIDs)) + end subroutine CloseNCFile - ! ! grab these dimensions - ! do i = 1, numDims - ! call Check(nf90_inquire_dimension(ncid, dimIDs(i), len=dim_lens(i))) - ! end do + !======================================================================================= - ! end subroutine GetDims + subroutine GetDimID(ncid, var_name, dim_id) + integer, intent(in) :: ncid + character(len=*), intent(in) :: var_name + integer, intent(out) :: dim_id - ! !===================================================================================== + call Check(nf90_inq_dimid(ncid, var_name, dim_id)) - ! subroutine GetVar1DReal(ncid, var_name, data) - ! ! - ! ! DESCRIPTION: - ! ! Read in variables for 1D real data - ! ! + end subroutine GetDimID - ! ! ARGUMENTS: - ! integer, intent(in) :: ncid ! netcdf file unit ID - ! character(len=*), intent(in) :: var_name ! variable name - ! real(r8), allocatable, intent(out) :: data(:) ! data values + !======================================================================================= - ! ! LOCALS: - ! integer :: varID ! variable ID - ! integer, allocatable :: dim_lens(:) ! dimension lengths + subroutine GetDimLen(ncid, dim_id, dim_len) + integer, intent(in) :: ncid + integer, intent(in) :: dim_id + integer, intent(out) :: dim_len - ! ! find variable ID first - ! call Check(nf90_inq_varid(ncid, var_name, varID)) + call Check(nf90_inquire_dimension(ncid, dim_id, len=dim_len)) - ! ! get dimensions of data - ! call GetDims(ncid, varID, dim_lens) + end subroutine GetDimLen - ! ! read data - ! allocate(data(dim_lens(1))) - ! call Check(nf90_get_var(ncid, varID, data)) + !======================================================================================= - ! end subroutine GetVar1DReal + subroutine GetDims(ncid, varID, dim_lens) + ! + ! DESCRIPTION: + ! Get dimensions for a netcdf variable + ! - ! !===================================================================================== + ! ARGUMENTS + integer, intent(in) :: ncid ! netcdf file unit ID + integer, intent(in) :: varID ! variable ID + integer, allocatable, intent(out) :: dim_lens(:) ! dimension lengths - ! subroutine GetVar1DInt(ncid, var_name, data) - ! ! - ! ! DESCRIPTION: - ! ! Read in variables for 1D integer data - ! ! + ! LOCALS: + integer :: numDims ! number of dimensions + integer, allocatable :: dimIDs(:) ! dimension IDs + integer :: i ! looping index - ! ! ARGUMENTS: - ! integer, intent(in) :: ncid ! netcdf file unit ID - ! character(len=*), intent(in) :: var_name ! variable name - ! integer, allocatable, intent(out) :: data(:) ! data values + ! find dimensions of data + call Check(nf90_inquire_variable(ncid, varID, ndims=numDims)) - ! ! LOCALS: - ! integer :: varID ! variable ID - ! integer, allocatable :: dim_lens(:) ! dimension lengths + ! allocate data to grab dimension information + allocate(dim_lens(numDims)) + allocate(dimIDs(numDims)) - ! ! find variable ID first - ! call Check(nf90_inq_varid(ncid, var_name, varID)) + ! get dimIDs + call Check(nf90_inquire_variable(ncid, varID, dimids=dimIDs)) - ! ! get dimensions of data - ! call GetDims(ncid, varID, dim_lens) + ! grab these dimensions + do i = 1, numDims + call Check(nf90_inquire_dimension(ncid, dimIDs(i), len=dim_lens(i))) + end do - ! ! read data - ! allocate(data(dim_lens(1))) - ! call Check(nf90_get_var(ncid, varID, data)) - - ! end subroutine GetVar1DInt + end subroutine GetDims - ! !===================================================================================== + !===================================================================================== - ! subroutine GetVar2DReal(ncid, var_name, data) - ! ! - ! ! DESCRIPTION: - ! ! Read in variables for 2D real data - ! ! + subroutine GetVarScalarReal(ncid, var_name, data) + ! + ! DESCRIPTION: + ! Read in variables for scalar real data + ! - ! ! ARGUMENTS: - ! integer, intent(in) :: ncid ! netcdf file unit ID - ! character(len=*), intent(in) :: var_name ! variable name - ! real(r8), allocatable, intent(out) :: data(:,:) ! data values + ! ARGUMENTS: + integer, intent(in) :: ncid ! netcdf file unit ID + character(len=*), intent(in) :: var_name ! variable name + real(r8), intent(out) :: data ! data value - ! ! LOCALS: - ! integer :: varID ! variable ID - ! integer, allocatable :: dim_lens(:) ! dimension lengths + ! LOCALS: + integer :: varID ! variable ID + integer, allocatable :: dim_lens(:) ! dimension lengths - ! ! find variable ID first - ! call Check(nf90_inq_varid(ncid, var_name, varID)) + ! find variable ID first + call Check(nf90_inq_varid(ncid, var_name, varID)) - ! ! get dimensions of data - ! call GetDims(ncid, varID, dim_lens) + ! read data + call Check(nf90_get_var(ncid, varID, data)) - ! ! read data - ! allocate(data(dim_lens(1), dim_lens(2))) - ! call Check(nf90_get_var(ncid, varID, data)) - - ! end subroutine GetVar2DReal + end subroutine GetVarScalarReal - ! !===================================================================================== + !===================================================================================== - ! subroutine GetVar2DInt(ncid, var_name, data) - ! ! - ! ! DESCRIPTION: - ! ! Read in variables for 2D integer data - ! ! + subroutine GetVar1DReal(ncid, var_name, data) + ! + ! DESCRIPTION: + ! Read in variables for 1D real data + ! - ! ! ARGUMENTS: - ! integer, intent(in) :: ncid ! netcdf file unit ID - ! character(len=*), intent(in) :: var_name ! variable name - ! integer, allocatable, intent(out) :: data(:,:) ! data values + ! ARGUMENTS: + integer, intent(in) :: ncid ! netcdf file unit ID + character(len=*), intent(in) :: var_name ! variable name + real(r8), allocatable, intent(out) :: data(:) ! data values - ! ! LOCALS: - ! integer :: varID ! variable ID - ! integer, allocatable :: dim_lens(:) ! dimension lengths + ! LOCALS: + integer :: varID ! variable ID + integer, allocatable :: dim_lens(:) ! dimension lengths - ! ! find variable ID first - ! call Check(nf90_inq_varid(ncid, var_name, varID)) + ! find variable ID first + call Check(nf90_inq_varid(ncid, var_name, varID)) - ! ! get dimensions of data - ! call GetDims(ncid, varID, dim_lens) + ! get dimensions of data + call GetDims(ncid, varID, dim_lens) - ! ! read data - ! allocate(data(dim_lens(1), dim_lens(2))) - ! call Check(nf90_get_var(ncid, varID, data)) - - ! end subroutine GetVar2DInt + ! read data + allocate(data(dim_lens(1))) + call Check(nf90_get_var(ncid, varID, data)) - ! !===================================================================================== + end subroutine GetVar1DReal - ! subroutine GetVar3DReal(ncid, var_name, data) - ! ! - ! ! DESCRIPTION: - ! ! Read in variables for 3D real data - ! ! + !===================================================================================== - ! ! ARGUMENTS: - ! integer, intent(in) :: ncid ! netcdf file unit ID - ! character(len=*), intent(in) :: var_name ! variable name - ! real(r8), allocatable, intent(out) :: data(:,:,:) ! data values + subroutine GetVar1DInt(ncid, var_name, data) + ! + ! DESCRIPTION: + ! Read in variables for 1D integer data + ! - ! ! LOCALS: - ! integer :: varID ! variable ID - ! integer, allocatable :: dim_lens(:) ! dimension lengths + ! ARGUMENTS: + integer, intent(in) :: ncid ! netcdf file unit ID + character(len=*), intent(in) :: var_name ! variable name + integer, allocatable, intent(out) :: data(:) ! data values - ! ! find variable ID first - ! call Check(nf90_inq_varid(ncid, var_name, varID)) + ! LOCALS: + integer :: varID ! variable ID + integer, allocatable :: dim_lens(:) ! dimension lengths - ! ! get dimensions of data - ! call GetDims(ncid, varID, dim_lens) + ! find variable ID first + call Check(nf90_inq_varid(ncid, var_name, varID)) - ! ! read data - ! allocate(data(dim_lens(1), dim_lens(2), dim_lens(3))) - ! call Check(nf90_get_var(ncid, varID, data)) - - ! end subroutine GetVar3DReal + ! get dimensions of data + call GetDims(ncid, varID, dim_lens) + + ! read data + allocate(data(dim_lens(1))) + call Check(nf90_get_var(ncid, varID, data)) + + end subroutine GetVar1DInt + + !===================================================================================== + + subroutine GetVar2DReal(ncid, var_name, data) + ! + ! DESCRIPTION: + ! Read in variables for 2D real data + ! + + ! ARGUMENTS: + integer, intent(in) :: ncid ! netcdf file unit ID + character(len=*), intent(in) :: var_name ! variable name + real(r8), allocatable, intent(out) :: data(:,:) ! data values + + ! LOCALS: + integer :: varID ! variable ID + integer, allocatable :: dim_lens(:) ! dimension lengths + + ! find variable ID first + call Check(nf90_inq_varid(ncid, var_name, varID)) + + ! get dimensions of data + call GetDims(ncid, varID, dim_lens) + + ! read data + allocate(data(dim_lens(1), dim_lens(2))) + call Check(nf90_get_var(ncid, varID, data)) + + end subroutine GetVar2DReal + + !===================================================================================== + + subroutine GetVar2DInt(ncid, var_name, data) + ! + ! DESCRIPTION: + ! Read in variables for 2D integer data + ! + + ! ARGUMENTS: + integer, intent(in) :: ncid ! netcdf file unit ID + character(len=*), intent(in) :: var_name ! variable name + integer, allocatable, intent(out) :: data(:,:) ! data values + + ! LOCALS: + integer :: varID ! variable ID + integer, allocatable :: dim_lens(:) ! dimension lengths + + ! find variable ID first + call Check(nf90_inq_varid(ncid, var_name, varID)) + + ! get dimensions of data + call GetDims(ncid, varID, dim_lens) - ! !===================================================================================== + ! read data + allocate(data(dim_lens(1), dim_lens(2))) + call Check(nf90_get_var(ncid, varID, data)) - ! subroutine GetVar3DInt(ncid, var_name, data) - ! ! - ! ! DESCRIPTION: - ! ! Read in variables for 3D integer data - ! ! + end subroutine GetVar2DInt - ! ! ARGUMENTS: - ! integer, intent(in) :: ncid ! netcdf file unit ID - ! character(len=*), intent(in) :: var_name ! variable name - ! integer, allocatable, intent(out) :: data(:,:,:) ! data values + !===================================================================================== - ! ! LOCALS: - ! integer :: varID ! variable ID - ! integer, allocatable :: dim_lens(:) ! dimension lengths + subroutine GetVar3DReal(ncid, var_name, data) + ! + ! DESCRIPTION: + ! Read in variables for 3D real data + ! - ! ! find variable ID first - ! call Check(nf90_inq_varid(ncid, var_name, varID)) + ! ARGUMENTS: + integer, intent(in) :: ncid ! netcdf file unit ID + character(len=*), intent(in) :: var_name ! variable name + real(r8), allocatable, intent(out) :: data(:,:,:) ! data values - ! ! get dimensions of data - ! call GetDims(ncid, varID, dim_lens) + ! LOCALS: + integer :: varID ! variable ID + integer, allocatable :: dim_lens(:) ! dimension lengths - ! ! read data - ! allocate(data(dim_lens(1), dim_lens(2), dim_lens(3))) - ! call Check(nf90_get_var(ncid, varID, data)) + ! find variable ID first + call Check(nf90_inq_varid(ncid, var_name, varID)) + + ! get dimensions of data + call GetDims(ncid, varID, dim_lens) + + ! read data + allocate(data(dim_lens(1), dim_lens(2), dim_lens(3))) + call Check(nf90_get_var(ncid, varID, data)) + + end subroutine GetVar3DReal + + !===================================================================================== + + subroutine GetVar3DInt(ncid, var_name, data) + ! + ! DESCRIPTION: + ! Read in variables for 3D integer data + ! + + ! ARGUMENTS: + integer, intent(in) :: ncid ! netcdf file unit ID + character(len=*), intent(in) :: var_name ! variable name + integer, allocatable, intent(out) :: data(:,:,:) ! data values + + ! LOCALS: + integer :: varID ! variable ID + integer, allocatable :: dim_lens(:) ! dimension lengths + + ! find variable ID first + call Check(nf90_inq_varid(ncid, var_name, varID)) + + ! get dimensions of data + call GetDims(ncid, varID, dim_lens) + + ! read data + allocate(data(dim_lens(1), dim_lens(2), dim_lens(3))) + call Check(nf90_get_var(ncid, varID, data)) + + end subroutine GetVar3DInt + + !===================================================================================== + + subroutine RegisterNCDims(ncid, dim_names, dim_lens, num_dims, dim_IDs) + ! + ! DESCRIPTION: + ! Defines variables and dimensions + ! + + ! ARGUMENTS: + integer, intent(in) :: ncid ! netcdf file id + character(len=*), intent(in) :: dim_names(num_dims) ! dimension names + integer, intent(in) :: dim_lens(num_dims) ! dimension lengths + integer, intent(in) :: num_dims ! number of dimensions + integer, intent(out) :: dim_IDs(num_dims) ! dimension IDs + + ! LOCALS: + integer :: i ! looping index + + do i = 1, num_dims + call Check(nf90_def_dim(ncid, dim_names(i), dim_lens(i), dim_IDs(i))) + end do + + end subroutine RegisterNCDims + + !===================================================================================== + + subroutine RegisterVar1D(ncid, var_name, dimID, type, att_names, atts, num_atts, varID) + ! + ! DESCRIPTION: + ! Defines variables and dimensions + ! + + ! ARGUMENTS: + integer, intent(in) :: ncid ! netcdf file id + character(len=*), intent(in) :: var_name ! variable name + integer, intent(in) :: dimID(1) ! dimension ID + integer, intent(in) :: type ! type: int or double + character(len=*), intent(in) :: att_names(num_atts) ! attribute names + character(len=*), intent(in) :: atts(num_atts) ! attribute values + integer, intent(in) :: num_atts ! number of attributes + integer, intent(out) :: varID ! variable ID + + + ! LOCALS: + integer :: i ! looping index + integer :: nc_type ! netcdf type + + if (type == type_double) then + nc_type = NF90_DOUBLE + else if (type == type_int) then + nc_type = NF90_INT + else + write(*, *) "Must pick correct type" + stop + end if + + call Check(nf90_def_var(ncid, var_name, nc_type, dimID, varID)) + + do i = 1, num_atts + call Check(nf90_put_att(ncid, varID, att_names(i), atts(i))) + end do - ! end subroutine GetVar3DInt - - ! !===================================================================================== - - ! subroutine RegisterNCDims(ncid, dim_names, dim_lens, num_dims, dim_IDs) - ! ! - ! ! DESCRIPTION: - ! ! Defines variables and dimensions - ! ! - - ! ! ARGUMENTS: - ! integer, intent(in) :: ncid ! netcdf file id - ! character(len=*), intent(in) :: dim_names(num_dims) ! dimension names - ! integer, intent(in) :: dim_lens(num_dims) ! dimension lengths - ! integer, intent(in) :: num_dims ! number of dimensions - ! integer, intent(out) :: dim_IDs(num_dims) ! dimension IDs - - ! ! LOCALS: - ! integer :: i ! looping index - - ! do i = 1, num_dims - ! call Check(nf90_def_dim(ncid, dim_names(i), dim_lens(i), dim_IDs(i))) - ! end do - - ! end subroutine RegisterNCDims - - ! !===================================================================================== - - ! subroutine RegisterVar1D(ncid, var_name, dimID, type, att_names, atts, num_atts, varID) - ! ! - ! ! DESCRIPTION: - ! ! Defines variables and dimensions - ! ! - - ! ! ARGUMENTS: - ! integer, intent(in) :: ncid ! netcdf file id - ! character(len=*), intent(in) :: var_name ! variable name - ! integer, intent(in) :: dimID(1) ! dimension ID - ! integer, intent(in) :: type ! type: int or double - ! character(len=*), intent(in) :: att_names(num_atts) ! attribute names - ! character(len=*), intent(in) :: atts(num_atts) ! attribute values - ! integer, intent(in) :: num_atts ! number of attributes - ! integer, intent(out) :: varID ! variable ID - - - ! ! LOCALS: - ! integer :: i ! looping index - ! integer :: nc_type ! netcdf type - - ! if (type == type_double) then - ! nc_type = NF90_DOUBLE - ! else if (type == type_int) then - ! nc_type = NF90_INT - ! else - ! write(logf, *) "Must pick correct type" - ! stop - ! end if - - ! call Check(nf90_def_var(ncid, var_name, nc_type, dimID, varID)) - - ! do i = 1, num_atts - ! call Check(nf90_put_att(ncid, varID, att_names(i), atts(i))) - ! end do - - ! end subroutine RegisterVar1D - - ! !===================================================================================== - - ! subroutine RegisterVar2D(ncid, var_name, dimID, type, att_names, atts, num_atts, varID) - ! ! - ! ! DESCRIPTION: - ! ! Defines variables and dimensions - ! ! - - ! ! ARGUMENTS: - ! integer, intent(in) :: ncid ! netcdf file id - ! character(len=*), intent(in) :: var_name ! variable name - ! integer, intent(in) :: dimID(1:2) ! dimension ID - ! integer, intent(in) :: type ! type: int or double - ! character(len=*), intent(in) :: att_names(num_atts) ! attribute names - ! character(len=*), intent(in) :: atts(num_atts) ! attribute values - ! integer, intent(in) :: num_atts ! number of attributes - ! integer, intent(out) :: varID ! variable ID - - - ! ! LOCALS: - ! integer :: i ! looping index - ! integer :: nc_type ! netcdf type - - ! if (type == type_double) then - ! nc_type = NF90_DOUBLE - ! else if (type == type_int) then - ! nc_type = NF90_INT - ! else - ! write(logf, *) "Must pick correct type" - ! stop - ! end if - - ! call Check(nf90_def_var(ncid, var_name, nc_type, dimID, varID)) - - ! do i = 1, num_atts - ! call Check(nf90_put_att(ncid, varID, att_names(i), atts(i))) - ! end do - - ! end subroutine RegisterVar2D + end subroutine RegisterVar1D + + !===================================================================================== + + subroutine RegisterVar2D(ncid, var_name, dimID, type, att_names, atts, num_atts, varID) + ! + ! DESCRIPTION: + ! Defines variables and dimensions + ! + + ! ARGUMENTS: + integer, intent(in) :: ncid ! netcdf file id + character(len=*), intent(in) :: var_name ! variable name + integer, intent(in) :: dimID(1:2) ! dimension ID + integer, intent(in) :: type ! type: int or double + character(len=*), intent(in) :: att_names(num_atts) ! attribute names + character(len=*), intent(in) :: atts(num_atts) ! attribute values + integer, intent(in) :: num_atts ! number of attributes + integer, intent(out) :: varID ! variable ID + + + ! LOCALS: + integer :: i ! looping index + integer :: nc_type ! netcdf type + + if (type == type_double) then + nc_type = NF90_DOUBLE + else if (type == type_int) then + nc_type = NF90_INT + else + write(*, *) "Must pick correct type" + stop + end if + + call Check(nf90_def_var(ncid, var_name, nc_type, dimID, varID)) + + do i = 1, num_atts + call Check(nf90_put_att(ncid, varID, att_names(i), atts(i))) + end do + + end subroutine RegisterVar2D - !===================================================================================== +! ===================================================================================== end module FatesUnitTestIOMod \ No newline at end of file diff --git a/unit_test_shr/FatesUnitTestParamReaderMod.F90 b/unit_test_shr/FatesUnitTestParamReaderMod.F90 index 6cefe91df5..f36f2fd58e 100644 --- a/unit_test_shr/FatesUnitTestParamReaderMod.F90 +++ b/unit_test_shr/FatesUnitTestParamReaderMod.F90 @@ -1,8 +1,17 @@ module FatesUnitTestParamReaderMod - use FatesParametersInterface, only : fates_param_reader_type - use FatesParametersInterface, only : fates_parameters_type - use PRTInitParamsFatesMod, only : PRTRegisterParams + use FatesConstantsMod, only : r8 => fates_r8 + use FatesParametersInterface, only : fates_param_reader_type + use FatesParametersInterface, only : fates_parameters_type + use FatesParametersInterface, only : param_string_length + use FatesParametersInterface, only : max_dimensions, max_used_dimensions + use FatesParametersInterface, only : dimension_shape_scalar, dimension_shape_1d, dimension_shape_2d + use EDParamsMod, only : FatesRegisterParams, FatesReceiveParams + use SFParamsMod, only : SpitFireRegisterParams, SpitFireReceiveParams + use PRTInitParamsFatesMod, only : PRTRegisterParams, PRTReceiveParams + use FatesSynchronizedParamsMod, only : FatesSynchronizedParamsInst + use EDPftvarcon, only : EDPftvarcon_inst + use FatesUnitTestIOMod, only : OpenNCFile, GetDimID, GetDimLen, GetVar, CloseNCFile implicit none private @@ -12,14 +21,30 @@ module FatesUnitTestParamReaderMod character(:), allocatable :: filename ! local file name of parameter contains - procedure, public :: Read => read_parameters - procedure, public :: param_read + procedure, public :: Read => ReadParameters + procedure, public :: Init + procedure, public :: RetrieveParameters end type fates_unit_test_param_reader - contains + contains - subroutine read_parameters(this, fates_params) + subroutine Init(this, param_file) + ! + ! DESCRIPTION: + ! Initialize the parameter reader class + ! + ! ARGUMENTS: + class(fates_unit_test_param_reader) :: this + character(len=*) :: param_file + + this%filename = trim(param_file) + + end subroutine Init + + ! -------------------------------------------------------------------------------------- + + subroutine ReadParameters(this, fates_params) ! ! DESCRIPTION: ! Read 'fates_params' parameters from storage @@ -28,15 +53,54 @@ subroutine read_parameters(this, fates_params) class(fates_unit_test_param_reader) :: this class(fates_parameters_type), intent(inout) :: fates_params - print *, "read in parameters" - - !call ParametersFromNetCDF(fates_paramfile, is_host_file, fates_params) - - end subroutine read_parameters + ! LOCALS: + real(r8), allocatable :: data2d(:, :) + real(r8), allocatable :: data1d(:) + real(r8) :: data_scalar + integer :: ncid + integer :: num_params + integer :: dimension_shape + integer :: i + integer :: max_dim_size + character(len=param_string_length) :: name + integer :: dimension_sizes(max_dimensions) + character(len=param_string_length) :: dimension_names(max_dimensions) + logical :: is_host_param + + call OpenNCFile(this%filename, ncid, 'read') + call SetParameterDimensions(ncid, fates_params) + + num_params = fates_params%num_params() + do i = 1, num_params + call fates_params%GetMetaData(i, name, dimension_shape, dimension_sizes, & + dimension_names, is_host_param) + select case(dimension_shape) + case(dimension_shape_scalar) + call GetVar(ncid, name, data_scalar) + call fates_params%SetData(i, data_scalar) + case(dimension_shape_1d) + call GetVar(ncid, name, data1d) + call fates_params%SetData(i, data1d) + case(dimension_shape_2d) + call GetVar(ncid, name, data2d) + call fates_params%SetData(i, data2d) + case default + write(*, '(a,a)') 'dimension shape:', dimension_shape + write(*, '(a)') 'unsupported number of dimensions reading parameters.' + stop + end select + end do + + if (allocated(data1d)) deallocate(data1d) + if (allocated(data2d)) deallocate(data2d) + + call CloseNCFile(ncid) + + end subroutine ReadParameters ! -------------------------------------------------------------------------------------- - subroutine param_read(this) + subroutine RetrieveParameters(this) ! ! DESCRIPTION: ! Read in fates parameters @@ -45,15 +109,86 @@ subroutine param_read(this) class(fates_unit_test_param_reader), intent(in) :: this ! LOCALS: - !class(fates_parameters_type), allocatable :: fates_params + class(fates_parameters_type), allocatable :: fates_params + class(fates_parameters_type), allocatable :: fates_pft_params ! allocate and read in parameters - !allocate(fates_params) - !call fates_params%Init() - !call PRTRegisterParams(fates_params) + allocate(fates_params) + allocate(fates_pft_params) + call fates_params%Init() + call fates_pft_params%Init() + + call EDPftvarcon_inst%Init() + + call PRTRegisterParams(fates_params) + call FatesRegisterParams(fates_params) + call SpitFireRegisterParams(fates_params) + call FatesSynchronizedParamsInst%RegisterParams(fates_params) + call EDPftvarcon_inst%Register(fates_pft_params) + + call this%Read(fates_params) - !call this%Read(fates_params) + call FatesReceiveParams(fates_params) + call SpitFireReceiveParams(fates_params) + call PRTReceiveParams(fates_params) + call FatesSynchronizedParamsInst%ReceiveParams(fates_params) + + call fates_params%Destroy() + call fates_pft_params%Destroy() + deallocate(fates_params) + deallocate(fates_pft_params) + + end subroutine RetrieveParameters + + ! -------------------------------------------------------------------------------------- - end subroutine param_read + subroutine SetParameterDimensions(ncid, fates_params) + ! + ! DESCRIPTION: + ! Read in fates parameters + ! + ! ARGUMENTS: + integer, intent(in) :: ncid ! netcdf file ID + class(fates_parameters_type), intent(inout) :: fates_params ! fates parameters class + + ! LOCALS: + integer :: num_used_dimensions + character(len=param_string_length) :: used_dimension_names(max_used_dimensions) + integer :: used_dimension_sizes(max_used_dimensions) + + call fates_params%GetUsedDimensions(.false., num_used_dimensions, used_dimension_names) + + call GetUsedDimensionSizes(ncid, num_used_dimensions, used_dimension_names, & + used_dimension_sizes) + + call fates_params%SetDimensionSizes(.false., num_used_dimensions, & + used_dimension_names, used_dimension_sizes) + + end subroutine SetParameterDimensions + + ! -------------------------------------------------------------------------------------- + + subroutine GetUsedDimensionSizes(ncid, num_used_dimensions, dimension_names, dimension_sizes) + ! + ! DESCRIPTION: + ! Get dimension sizes for parameters + ! + ! ARGUMENTS: + integer, intent(in) :: ncid + integer, intent(in) :: num_used_dimensions + character(len=param_string_length), intent(in) :: dimension_names(:) + integer, intent(out) :: dimension_sizes(:) + + ! LOCALS + integer :: d + integer :: dim_id + + dimension_sizes(:) = 0 + do d = 1, num_used_dimensions + call GetDimID(ncid, dimension_names(d), dim_id) + call GetDimLen(ncid, dim_id, dimension_sizes(d)) + end do + + end subroutine GetUsedDimensionSizes end module FatesUnitTestParamReaderMod \ No newline at end of file From dfb4260c4854307234edbcb9eb6b2d52e52a1ea9 Mon Sep 17 00:00:00 2001 From: adrifoster Date: Tue, 16 Apr 2024 12:37:07 -0600 Subject: [PATCH 082/176] start adding allometry calculations --- .../allometry/FatesTestAllometry.F90 | 18 ++++++++++++++++-- 1 file changed, 16 insertions(+), 2 deletions(-) diff --git a/functional_unit_testing/allometry/FatesTestAllometry.F90 b/functional_unit_testing/allometry/FatesTestAllometry.F90 index b9f9446ed2..23ce863cc1 100644 --- a/functional_unit_testing/allometry/FatesTestAllometry.F90 +++ b/functional_unit_testing/allometry/FatesTestAllometry.F90 @@ -1,6 +1,7 @@ program FatesTestAllometry - !use FatesAllometryMod, only : h2d_allom + use FatesConstantsMod, only : r8 => fates_r8 + use FatesAllometryMod, only : h_allom use PRTParametersMod, only : prt_params use FatesUnitTestParamReaderMod, only : fates_unit_test_param_reader @@ -9,9 +10,22 @@ program FatesTestAllometry ! LOCALS: type(fates_unit_test_param_reader) :: param_reader character(len=*), parameter :: param_file = 'fates_params_default.nc' + integer :: numpft + integer :: i + real(r8) :: height + + ! CONSTANTS: + real(r8) :: min_dbh = 0.5_r8 ! minimum DBH to calculate [cm] + real(r8) :: max_dbh = 200.0_r8 ! maximum DBH to calculate [cm] + ! read in parameter file call param_reader%Init(param_file) call param_reader%RetrieveParameters() - + numpft = size(prt_params%wood_density, dim=1) - 1 + do i = 1, numpft + call h_allom(25.0_r8, i, height) + print *, height + end do + end program FatesTestAllometry \ No newline at end of file From fc3e66c22d6637b5f56a09d7dfea08825c7acc63 Mon Sep 17 00:00:00 2001 From: adrifoster Date: Tue, 16 Apr 2024 15:30:12 -0600 Subject: [PATCH 083/176] get plotting to work --- .../allometry/FatesTestAllometry.F90 | 123 +++++++++++++++++- functional_unit_testing/run_fates_tests.py | 122 ++++++++++++++--- 2 files changed, 221 insertions(+), 24 deletions(-) diff --git a/functional_unit_testing/allometry/FatesTestAllometry.F90 b/functional_unit_testing/allometry/FatesTestAllometry.F90 index 23ce863cc1..b83e83a1c4 100644 --- a/functional_unit_testing/allometry/FatesTestAllometry.F90 +++ b/functional_unit_testing/allometry/FatesTestAllometry.F90 @@ -10,22 +10,133 @@ program FatesTestAllometry ! LOCALS: type(fates_unit_test_param_reader) :: param_reader character(len=*), parameter :: param_file = 'fates_params_default.nc' + character(len=*), parameter :: out_file = 'allometry_out.nc' integer :: numpft - integer :: i - real(r8) :: height + integer :: i, j + integer :: numdbh + real(r8), allocatable :: dbh(:) ! diameter at breast height [cm] + real(r8), allocatable :: height(:, :) ! height [m] ! CONSTANTS: real(r8) :: min_dbh = 0.5_r8 ! minimum DBH to calculate [cm] real(r8) :: max_dbh = 200.0_r8 ! maximum DBH to calculate [cm] + real(r8) :: dbh_inc = 0.5_r8 ! DBH increment to use [cm] + + interface + + subroutine WriteAllometryData(out_file, ndbh, numpft, dbh, height) + + use FatesUnitTestIOMod, only : OpenNCFile, RegisterNCDims, CloseNCFile + use FatesUnitTestIOMod, only : RegisterVar1D, WriteVar, RegisterVar2D + use FatesUnitTestIOMod, only : type_double, type_int + use FatesConstantsMod, only : r8 => fates_r8 + implicit none + + character(len=*), intent(in) :: out_file + integer, intent(in) :: ndbh, numpft + real(r8), intent(in) :: dbh(:) + real(r8), intent(in) :: height(:,:) + + end subroutine WriteAllometryData + + end interface ! read in parameter file call param_reader%Init(param_file) call param_reader%RetrieveParameters() - numpft = size(prt_params%wood_density, dim=1) - 1 + numpft = size(prt_params%wood_density, dim=1) + + ! allocate arrays and initialize DBH array + numdbh = int((max_dbh - min_dbh)/dbh_inc + 1) + + allocate(dbh(numdbh)) + allocate(height(numdbh, numpft)) + + do i = 1, numdbh + dbh(i) = min_dbh + dbh_inc*(i-1) + end do + ! calculate allometries do i = 1, numpft - call h_allom(25.0_r8, i, height) - print *, height + do j = 1, numdbh + call h_allom(dbh(j), i, height(j, i)) + end do end do + + call WriteAllometryData(out_file, numdbh, numpft, dbh, height) -end program FatesTestAllometry \ No newline at end of file +end program FatesTestAllometry + +! ---------------------------------------------------------------------------------------- + +subroutine WriteAllometryData(out_file, numdbh, numpft, dbh, height) + ! + ! DESCRIPTION: + ! Writes out data from the allometry test + ! + use FatesConstantsMod, only : r8 => fates_r8 + use FatesUnitTestIOMod, only : OpenNCFile, RegisterNCDims, CloseNCFile + use FatesUnitTestIOMod, only : RegisterVar1D, WriteVar, RegisterVar2D + use FatesUnitTestIOMod, only : EndNCDef + use FatesUnitTestIOMod, only : type_double, type_int + + implicit none + + ! ARGUMENTS: + character(len=*), intent(in) :: out_file + integer, intent(in) :: numdbh, numpft + real(r8), intent(in) :: dbh(:) + real(r8), intent(in) :: height(:,:) + + ! LOCALS: + integer, allocatable :: pft_indices(:) ! array of pft indices to write out + integer :: i ! looping index + integer :: ncid ! netcdf file id + character(len=8) :: dim_names(2) ! dimension names + integer :: dimIDs(2) ! dimension IDs + integer :: dbhID, pftID ! variable IDs for dimensions + integer :: heightID + + ! create pft indices + allocate(pft_indices(numpft)) + do i = 1, numpft + pft_indices(i) = i + end do + + ! dimension names + dim_names = [character(len=12) :: 'dbh', 'pft'] + + ! open file + call OpenNCFile(trim(out_file), ncid, 'readwrite') + + ! register dimensions + call RegisterNCDims(ncid, dim_names, (/numdbh, numpft/), 2, dimIDs) + + ! register dbh + call RegisterVar1D(ncid, dim_names(1), dimIDs(1), type_double, & + [character(len=20) :: 'units', 'long_name'], & + [character(len=150) :: 'cm', 'diameter at breast height'], 2, dbhID) + + ! register pft + call RegisterVar1D(ncid, dim_names(2), dimIDs(2), type_int, & + [character(len=20) :: 'units', 'long_name'], & + [character(len=150) :: '', 'plant functional type'], 2, pftID) + + ! register height + call RegisterVar2D(ncid, 'height', dimIDs(1:2), type_double, & + [character(len=20) :: 'coordinates', 'units', 'long_name'], & + [character(len=150) :: 'pft dbh', 'm', 'plant height'], & + 3, heightID) + + ! finish defining variables + call EndNCDef(ncid) + + ! write out data + call WriteVar(ncid, dbhID, dbh(:)) + call WriteVar(ncid, pftID, pft_indices(:)) + call WriteVar(ncid, heightID, height(:,:)) + + ! close the file + call CloseNCFile(ncid) + +end subroutine WriteAllometryData \ No newline at end of file diff --git a/functional_unit_testing/run_fates_tests.py b/functional_unit_testing/run_fates_tests.py index 6ca39c4fc7..1e513dcd87 100755 --- a/functional_unit_testing/run_fates_tests.py +++ b/functional_unit_testing/run_fates_tests.py @@ -1,23 +1,97 @@ -#!/usr/bin/env python3 +#!/usr/bin/env python import os import sys from build_fortran_tests import build_unit_tests -_FATES_PYTHON = os.path.join(os.path.dirname(os.path.abspath(__file__))) -sys.path.insert(1, _FATES_PYTHON) +import math +import pandas as pd +import numpy as np +import xarray as xr +import matplotlib +import matplotlib.pyplot as plt from utils import add_cime_lib_to_path add_cime_lib_to_path() from CIME.utils import run_cmd_no_fail +def round_up(n, decimals=0): + multiplier = 10**decimals + return math.ceil(n * multiplier) / multiplier + +def truncate(n, decimals=0): + multiplier = 10**decimals + return int(n * multiplier) / multiplier + +def get_color_pallete(): + + colors = [(31, 119, 180), (174, 199, 232), (255, 127, 14), (255, 187, 120), + (44, 160, 44), (152, 223, 138), (214, 39, 40), (255, 152, 150), + (148, 103, 189), (197, 176, 213), (140, 86, 75), (196, 156, 148), + (227, 119, 194), (247, 182, 210), (127, 127, 127), (199, 199, 199), + (188, 189, 34), (219, 219, 141), (23, 190, 207), (158, 218, 229)] + + for i in range(len(colors)): + r, g, b = colors[i] + colors[i] = (r/255., g/255., b/255.) + + return colors + + +def plot_allometry_var(data, var, varname, units): + df = pd.DataFrame({'dbh': np.tile(data.dbh, len(data.pft)), + 'pft': np.repeat(data.pft, len(data.dbh)), + var: data.values.flatten()}) + + maxdbh = df['dbh'].max() + maxvar = round_up(df[var].max()) + + colors = get_color_pallete() + + plt.figure(figsize=(7, 5)) + ax = plt.subplot(111) + ax.spines["top"].set_visible(False) + ax.spines["bottom"].set_visible(False) + ax.spines["right"].set_visible(False) + ax.spines["left"].set_visible(False) + + ax.get_xaxis().tick_bottom() + ax.get_yaxis().tick_left() + + plt.xlim(0.0, maxdbh) + plt.ylim(0.0, maxvar) + + plt.yticks(fontsize=10) + plt.xticks(fontsize=10) + + for y in range(0, int(maxvar), 5): + plt.plot(range(math.floor(0), math.ceil(maxdbh)), + [y] * len(range(math.floor(0), math.ceil(maxdbh))), + "--", lw=0.5, color="black", alpha=0.3) + + plt.tick_params(bottom=False, top=False, left=False, right=False) + + pfts = np.unique(df.pft.values) + for rank, pft in enumerate(pfts): + data = df[df.pft == pft] + plt.plot(data.dbh.values, data[var].values, lw=2, color=colors[rank], + label=pft) + + plt.xlabel('DBH (cm)', fontsize=11) + plt.ylabel(f'{varname} ({units})', fontsize=11) + plt.title(f"Simulated {varname} for input parameter file", fontsize=11) + plt.legend(loc='upper left', title='PFT') + + plt.show() + if __name__ == "__main__": ## Arguments clean = True - build = True + build = False + run = False build_dir = "../_build" name = "fates_unit_tests" make_j = 8 @@ -26,24 +100,36 @@ param_cdl_path = "../parameter_files/fates_params_default.cdl" ## Constants + out_file = "allometry_out.nc" test_dir = "fates_allom_test" test_exe = "FATES_allom_exe" + build_dir_path = os.path.abspath(build_dir) + + ## Actual Program if build: build_unit_tests(build_dir, name, cmake_directory, make_j, clean=clean) - build_dir_path = os.path.abspath(build_dir) - exe_path = os.path.join(build_dir_path, test_dir, test_exe) - - if param_file is None: - file_basename = os.path.basename(param_cdl_path).split(".")[-2] - file_nc_name = f"{file_basename}.nc" - file_gen_command = [ - "ncgen -o", - os.path.join(file_nc_name), - param_cdl_path - ] - run_cmd_no_fail(" ".join(file_gen_command), combine_output=True) + if run: + exe_path = os.path.join(build_dir_path, test_dir, test_exe) + + if param_file is None: + file_basename = os.path.basename(param_cdl_path).split(".")[-2] + file_nc_name = f"{file_basename}.nc" + file_gen_command = [ + "ncgen -o", + os.path.join(file_nc_name), + param_cdl_path + ] + run_cmd_no_fail(" ".join(file_gen_command), combine_output=True) - out = run_cmd_no_fail(exe_path, combine_output=True) - print(out) \ No newline at end of file + out = run_cmd_no_fail(exe_path, combine_output=True) + print(out) + + # read in allometry data + allometry_dat = xr.open_dataset(os.path.join(build_dir_path, out_file)) + + # plot allometry data + plot_allometry_var(allometry_dat.height, 'height', 'height', 'm') + + \ No newline at end of file From 4ecaeedefbd6182f29ad7ff0eb0a53d96523b0dd Mon Sep 17 00:00:00 2001 From: adrifoster Date: Tue, 16 Apr 2024 16:01:41 -0600 Subject: [PATCH 084/176] add parameter file as argument to program --- .../allometry/FatesTestAllometry.F90 | 10 +- functional_unit_testing/run_fates_tests.py | 98 +++++++++++-------- functional_unit_testing/utils.py | 11 ++- 3 files changed, 75 insertions(+), 44 deletions(-) diff --git a/functional_unit_testing/allometry/FatesTestAllometry.F90 b/functional_unit_testing/allometry/FatesTestAllometry.F90 index b83e83a1c4..471b8711e9 100644 --- a/functional_unit_testing/allometry/FatesTestAllometry.F90 +++ b/functional_unit_testing/allometry/FatesTestAllometry.F90 @@ -9,11 +9,12 @@ program FatesTestAllometry ! LOCALS: type(fates_unit_test_param_reader) :: param_reader - character(len=*), parameter :: param_file = 'fates_params_default.nc' + character(len=*), :: param_file character(len=*), parameter :: out_file = 'allometry_out.nc' integer :: numpft integer :: i, j integer :: numdbh + integer :: nargs real(r8), allocatable :: dbh(:) ! diameter at breast height [cm] real(r8), allocatable :: height(:, :) ! height [m] @@ -40,6 +41,13 @@ subroutine WriteAllometryData(out_file, ndbh, numpft, dbh, height) end subroutine WriteAllometryData end interface + + nargs = command_argument_count() + if (nargs /= 1) then + write(*, '(a, i, a)') "Incorrect number of arguments: ", nargs, ". Should only be 1" + else + call get_command_argument(1, param_file) + endif ! read in parameter file call param_reader%Init(param_file) diff --git a/functional_unit_testing/run_fates_tests.py b/functional_unit_testing/run_fates_tests.py index 1e513dcd87..67370636f0 100755 --- a/functional_unit_testing/run_fates_tests.py +++ b/functional_unit_testing/run_fates_tests.py @@ -11,20 +11,17 @@ import matplotlib import matplotlib.pyplot as plt -from utils import add_cime_lib_to_path +from utils import add_cime_lib_to_path, round_up add_cime_lib_to_path() from CIME.utils import run_cmd_no_fail -def round_up(n, decimals=0): - multiplier = 10**decimals - return math.ceil(n * multiplier) / multiplier - -def truncate(n, decimals=0): - multiplier = 10**decimals - return int(n * multiplier) / multiplier - def get_color_pallete(): + """Generate a color pallete + + Returns: + real: array of colors to use in plotting + """ colors = [(31, 119, 180), (174, 199, 232), (255, 127, 14), (255, 187, 120), (44, 160, 44), (152, 223, 138), (214, 39, 40), (255, 152, 150), @@ -40,6 +37,14 @@ def get_color_pallete(): def plot_allometry_var(data, var, varname, units): + """Plot an allometry variable + + Args: + data (xarray DataArray): the data array of the variable to plot + var (str): variable name (for data structure) + varname (str): variable name for plot labels + units (str): variable units for plot labels + """ df = pd.DataFrame({'dbh': np.tile(data.dbh, len(data.pft)), 'pft': np.repeat(data.pft, len(data.dbh)), var: data.values.flatten()}) @@ -84,52 +89,61 @@ def plot_allometry_var(data, var, varname, units): plt.legend(loc='upper left', title='PFT') plt.show() - - -if __name__ == "__main__": - ## Arguments - clean = True - build = False - run = False - build_dir = "../_build" - name = "fates_unit_tests" - make_j = 8 - cmake_directory = os.path.abspath("../") - param_file = None - param_cdl_path = "../parameter_files/fates_params_default.cdl" +def create_nc_file(cdl_path): + file_basename = os.path.basename(cdl_path).split(".")[-2] + file_nc_name = f"{file_basename}.nc" - ## Constants + file_gen_command = [ + "ncgen -o", + os.path.join(file_nc_name), + cdl_path + ] + run_cmd_no_fail(" ".join(file_gen_command), combine_output=True) + +def main(clean, build, run, build_dir, make_j, param_file): + + # Constants for now out_file = "allometry_out.nc" test_dir = "fates_allom_test" test_exe = "FATES_allom_exe" + name = "fates_unit_tests" + default_cdl_path = "../parameter_files/fates_params_default.cdl" - build_dir_path = os.path.abspath(build_dir) + # absolute path to desired build directory + build_dir_path = os.path.abspath(build_dir) - ## Actual Program + if param_file is None: + print("Using default parameter file.") + param_file = default_cdl_path + create_nc_file(param_file) + else: + print("Using parameter file {param_file}.") + if build: - build_unit_tests(build_dir, name, cmake_directory, make_j, clean=clean) - + build_unit_tests(build_dir, name, os.path.abspath("../"), make_j, clean=clean) + if run: exe_path = os.path.join(build_dir_path, test_dir, test_exe) + run_command = [exe_path, os.path.abspath(param_file)] + out = run_cmd_no_fail(" ".join(run_command), combine_output=True) + print(out) - if param_file is None: - file_basename = os.path.basename(param_cdl_path).split(".")[-2] - file_nc_name = f"{file_basename}.nc" - file_gen_command = [ - "ncgen -o", - os.path.join(file_nc_name), - param_cdl_path - ] - run_cmd_no_fail(" ".join(file_gen_command), combine_output=True) - - out = run_cmd_no_fail(exe_path, combine_output=True) - print(out) - # read in allometry data - allometry_dat = xr.open_dataset(os.path.join(build_dir_path, out_file)) + allometry_dat = xr.open_dataset(out_file) # plot allometry data plot_allometry_var(allometry_dat.height, 'height', 'height', 'm') - \ No newline at end of file + +if __name__ == "__main__": + + ## Arguments + clean = False + build = False + run = True + build_dir = "../_build" + make_j = 8 + param_file = None + + main(clean, build, run, build_dir, make_j, param_file) \ No newline at end of file diff --git a/functional_unit_testing/utils.py b/functional_unit_testing/utils.py index e4f74e0b68..86e7038f34 100644 --- a/functional_unit_testing/utils.py +++ b/functional_unit_testing/utils.py @@ -3,6 +3,7 @@ import os import sys +import math # ======================================================================== # Constants that may need to be changed if directory structures change @@ -54,4 +55,12 @@ def add_cime_lib_to_path(): prepend_to_python_path(cime_path) cime_lib_path = os.path.join(cime_path, "CIME", "Tools") prepend_to_python_path(cime_lib_path) - return cime_path \ No newline at end of file + return cime_path + +def round_up(n, decimals=0): + multiplier = 10**decimals + return math.ceil(n * multiplier) / multiplier + +def truncate(n, decimals=0): + multiplier = 10**decimals + return int(n * multiplier) / multiplier \ No newline at end of file From 0a52c5298107da910135586616c979b03050c46e Mon Sep 17 00:00:00 2001 From: adrifoster Date: Wed, 17 Apr 2024 11:57:55 -0600 Subject: [PATCH 085/176] plot all allometries --- .../allometry/FatesTestAllometry.F90 | 208 +++++++++-- .../build_fortran_tests.py | 1 - functional_unit_testing/run_fates_tests.py | 326 ++++++++++++++++-- unit_test_shr/FatesUnitTestIOMod.F90 | 111 +++++- unit_test_shr/FatesUnitTestParamReaderMod.F90 | 7 + 5 files changed, 587 insertions(+), 66 deletions(-) diff --git a/functional_unit_testing/allometry/FatesTestAllometry.F90 b/functional_unit_testing/allometry/FatesTestAllometry.F90 index 471b8711e9..c7c542a8b2 100644 --- a/functional_unit_testing/allometry/FatesTestAllometry.F90 +++ b/functional_unit_testing/allometry/FatesTestAllometry.F90 @@ -1,7 +1,9 @@ program FatesTestAllometry use FatesConstantsMod, only : r8 => fates_r8 - use FatesAllometryMod, only : h_allom + use FatesAllometryMod, only : h_allom, bagw_allom, blmax_allom + use FatesAllometryMod, only : carea_allom, bsap_allom, bbgw_allom + use FatesAllometryMod, only : bfineroot, bstore_allom, bdead_allom use PRTParametersMod, only : prt_params use FatesUnitTestParamReaderMod, only : fates_unit_test_param_reader @@ -9,23 +11,45 @@ program FatesTestAllometry ! LOCALS: type(fates_unit_test_param_reader) :: param_reader - character(len=*), :: param_file + character(len=:), allocatable :: param_file character(len=*), parameter :: out_file = 'allometry_out.nc' integer :: numpft + integer :: arglen integer :: i, j integer :: numdbh integer :: nargs - real(r8), allocatable :: dbh(:) ! diameter at breast height [cm] - real(r8), allocatable :: height(:, :) ! height [m] + real(r8), allocatable :: dbh(:) ! diameter at breast height [cm] + real(r8), allocatable :: height(:, :) ! height [m] + real(r8), allocatable :: bagw(:, :) ! aboveground woody biomass [kgC] + real(r8), allocatable :: blmax(:, :) ! plant leaf biomass [kgC] + real(r8), allocatable :: crown_area(:, :) ! crown area per cohort [m2] + real(r8), allocatable :: sapwood_area(:, :) ! cross sectional area of sapwood at reference height [m2] + real(r8), allocatable :: bsap(:, :) ! sapwood biomass [kgC] + real(r8), allocatable :: bbgw(:, :) ! belowground woody biomass [kgC] + real(r8), allocatable :: fineroot_biomass(:, :) ! belowground fineroot biomass [kgC] + real(r8), allocatable :: bstore(:, :) ! allometric target storage biomass [kgC] + real(r8), allocatable :: bdead(:, :) ! structural biomass (heartwood/struct) [kgC] + real(r8), allocatable :: total_biom_tissues(:,:) ! total biomass calculated as bleaf + bfineroot + bdead + bsap [kgC] + real(r8), allocatable :: total_biom_parts(:,:) ! total biomass calculated as bleaf + bfineroot + agbw + bgbw [kgC] ! CONSTANTS: - real(r8) :: min_dbh = 0.5_r8 ! minimum DBH to calculate [cm] - real(r8) :: max_dbh = 200.0_r8 ! maximum DBH to calculate [cm] - real(r8) :: dbh_inc = 0.5_r8 ! DBH increment to use [cm] + real(r8), parameter :: min_dbh = 0.5_r8 ! minimum DBH to calculate [cm] + real(r8), parameter :: max_dbh = 200.0_r8 ! maximum DBH to calculate [cm] + real(r8), parameter :: dbh_inc = 0.5_r8 ! DBHncrement to use [cm] + + integer, parameter :: crown_damage = 1 + real(r8), parameter :: elongation_factor = 1.0_r8 + real(r8), parameter :: elongation_factor_roots = 1.0_r8 + real(r8), parameter :: site_spread = 1.0_r8 + real(r8), parameter :: canopy_trim = 1.0_r8 + real(r8), parameter :: nplant = 1.0_r8 + real(r8), parameter :: leaf_to_fineroot = 1.0_r8 interface - subroutine WriteAllometryData(out_file, ndbh, numpft, dbh, height) + subroutine WriteAllometryData(out_file, ndbh, numpft, dbh, height, bagw, blmax, & + crown_area, sapwood_area, bsap, bbgw, fineroot_biomass, bstore, bdead, & + total_biom_parts, total_biom_tissues) use FatesUnitTestIOMod, only : OpenNCFile, RegisterNCDims, CloseNCFile use FatesUnitTestIOMod, only : RegisterVar1D, WriteVar, RegisterVar2D @@ -37,47 +61,95 @@ subroutine WriteAllometryData(out_file, ndbh, numpft, dbh, height) integer, intent(in) :: ndbh, numpft real(r8), intent(in) :: dbh(:) real(r8), intent(in) :: height(:,:) - + real(r8), intent(in) :: bagw(:,:) + real(r8), intent(in) :: blmax(:, :) + real(r8), intent(in) :: crown_area(:, :) + real(r8), intent(in) :: sapwood_area(:, :) + real(r8), intent(in) :: bsap(:, :) + real(r8), intent(in) :: bbgw(:, :) + real(r8), intent(in) :: fineroot_biomass(:, :) + real(r8), intent(in) :: bstore(:, :) + real(r8), intent(in) :: bdead(:, :) + real(r8), intent(in) :: total_biom_parts(:, :) + real(r8), intent(in) :: total_biom_tissues(:, :) end subroutine WriteAllometryData end interface + ! get parameter file from command-line argument nargs = command_argument_count() if (nargs /= 1) then - write(*, '(a, i, a)') "Incorrect number of arguments: ", nargs, ". Should only be 1" + write(*, '(a, i2, a)') "Incorrect number of arguments: ", nargs, ". Should be 1" + stop else - call get_command_argument(1, param_file) + call get_command_argument(1, length=arglen) + allocate(character(arglen) :: param_file) + call get_command_argument(1, value=param_file) endif ! read in parameter file call param_reader%Init(param_file) call param_reader%RetrieveParameters() - numpft = size(prt_params%wood_density, dim=1) - ! allocate arrays and initialize DBH array + ! determine sizes of arrays + numpft = size(prt_params%wood_density, dim=1) numdbh = int((max_dbh - min_dbh)/dbh_inc + 1) + ! allocate arrays allocate(dbh(numdbh)) allocate(height(numdbh, numpft)) + allocate(bagw(numdbh, numpft)) + allocate(blmax(numdbh, numpft)) + allocate(crown_area(numdbh, numpft)) + allocate(sapwood_area(numdbh, numpft)) + allocate(bsap(numdbh, numpft)) + allocate(bbgw(numdbh, numpft)) + allocate(fineroot_biomass(numdbh, numpft)) + allocate(bstore(numdbh, numpft)) + allocate(bdead(numdbh, numpft)) + allocate(total_biom_parts(numdbh, numpft)) + allocate(total_biom_tissues(numdbh, numpft)) + ! initialize dbh array do i = 1, numdbh dbh(i) = min_dbh + dbh_inc*(i-1) end do + ! total biomass = bleaf + bfineroot + agbw + bgbw + ! ... or ... + ! total biomass = bleaf + bfineroot + bdead + bsap + ! calculate allometries do i = 1, numpft do j = 1, numdbh call h_allom(dbh(j), i, height(j, i)) + call bagw_allom(dbh(j), i, crown_damage, elongation_factor, bagw(j, i)) + call blmax_allom(dbh(j), i, blmax(j, i)) + call carea_allom(dbh(j), nplant, site_spread, i, crown_damage, crown_area(j, i)) + call bsap_allom(dbh(j), i, crown_damage, canopy_trim, elongation_factor, & + sapwood_area(j, i), bsap(j, i)) + call bbgw_allom(dbh(j), i, elongation_factor, bbgw(j, i)) + call bfineroot(dbh(j), i, canopy_trim, leaf_to_fineroot, elongation_factor_roots, & + fineroot_biomass(j, i)) + call bstore_allom(dbh(j), i, crown_damage, canopy_trim, bstore(j, i)) + call bdead_allom(bagw(j, i), bbgw(j, i), bsap(j, i), i, bdead(j, i)) + total_biom_parts(j, i) = blmax(j, i) + fineroot_biomass(j, i) + bagw(j, i) + bbgw(j, i) + total_biom_tissues(j, i) = blmax(j, i) + fineroot_biomass(j, i) + bdead(j, i) + bsap(j, i) end do end do - call WriteAllometryData(out_file, numdbh, numpft, dbh, height) + ! write out data to netcdf file + call WriteAllometryData(out_file, numdbh, numpft, dbh, height, bagw, blmax, crown_area, & + sapwood_area, bsap, bbgw, fineroot_biomass, bstore, bdead, total_biom_parts, & + total_biom_tissues) end program FatesTestAllometry ! ---------------------------------------------------------------------------------------- -subroutine WriteAllometryData(out_file, numdbh, numpft, dbh, height) +subroutine WriteAllometryData(out_file, numdbh, numpft, dbh, height, bagw, blmax, & + crown_area, sapwood_area, bsap, bbgw, fineroot_biomass, bstore, bdead, total_biom_parts, & + total_biom_tissues) ! ! DESCRIPTION: ! Writes out data from the allometry test @@ -95,6 +167,17 @@ subroutine WriteAllometryData(out_file, numdbh, numpft, dbh, height) integer, intent(in) :: numdbh, numpft real(r8), intent(in) :: dbh(:) real(r8), intent(in) :: height(:,:) + real(r8), intent(in) :: bagw(:,:) + real(r8), intent(in) :: blmax(:, :) + real(r8), intent(in) :: crown_area(:, :) + real(r8), intent(in) :: sapwood_area(:, :) + real(r8), intent(in) :: bsap(:, :) + real(r8), intent(in) :: bbgw(:, :) + real(r8), intent(in) :: fineroot_biomass(:, :) + real(r8), intent(in) :: bstore(:, :) + real(r8), intent(in) :: bdead(:, :) + real(r8), intent(in) :: total_biom_parts(:, :) + real(r8), intent(in) :: total_biom_tissues(:, :) ! LOCALS: integer, allocatable :: pft_indices(:) ! array of pft indices to write out @@ -103,8 +186,13 @@ subroutine WriteAllometryData(out_file, numdbh, numpft, dbh, height) character(len=8) :: dim_names(2) ! dimension names integer :: dimIDs(2) ! dimension IDs integer :: dbhID, pftID ! variable IDs for dimensions - integer :: heightID - + integer :: heightID, bagwID + integer :: blmaxID, c_areaID + integer :: sapwoodareaID, bsapID + integer :: bbgwID, finerootID + integer :: bstoreID, bdeadID + integer :: totbiomID1, totbiomID2 + ! create pft indices allocate(pft_indices(numpft)) do i = 1, numpft @@ -121,21 +209,88 @@ subroutine WriteAllometryData(out_file, numdbh, numpft, dbh, height) call RegisterNCDims(ncid, dim_names, (/numdbh, numpft/), 2, dimIDs) ! register dbh - call RegisterVar1D(ncid, dim_names(1), dimIDs(1), type_double, & + call RegisterVar1D(ncid, dim_names(1), dimIDs(1), type_double, & [character(len=20) :: 'units', 'long_name'], & [character(len=150) :: 'cm', 'diameter at breast height'], 2, dbhID) ! register pft - call RegisterVar1D(ncid, dim_names(2), dimIDs(2), type_int, & - [character(len=20) :: 'units', 'long_name'], & + call RegisterVar1D(ncid, dim_names(2), dimIDs(2), type_int, & + [character(len=20) :: 'units', 'long_name'], & [character(len=150) :: '', 'plant functional type'], 2, pftID) ! register height - call RegisterVar2D(ncid, 'height', dimIDs(1:2), type_double, & + call RegisterVar2D(ncid, 'height', dimIDs(1:2), type_double, & [character(len=20) :: 'coordinates', 'units', 'long_name'], & [character(len=150) :: 'pft dbh', 'm', 'plant height'], & 3, heightID) + ! register aboveground biomass + call RegisterVar2D(ncid, 'bagw', dimIDs(1:2), type_double, & + [character(len=20) :: 'coordinates', 'units', 'long_name'], & + [character(len=150) :: 'pft dbh', 'kgC', 'plant aboveground woody biomass'], & + 3, bagwID) + + ! register leaf biomass + call RegisterVar2D(ncid, 'blmax', dimIDs(1:2), type_double, & + [character(len=20) :: 'coordinates', 'units', 'long_name'], & + [character(len=150) :: 'pft dbh', 'kgC', 'plant maximum leaf biomass'], & + 3, blmaxID) + + ! register crown area + call RegisterVar2D(ncid, 'crown_area', dimIDs(1:2), type_double, & + [character(len=20) :: 'coordinates', 'units', 'long_name'], & + [character(len=150) :: 'pft dbh', 'm2', 'plant crown area per cohort'], & + 3, c_areaID) + + ! register sapwood area + call RegisterVar2D(ncid, 'sapwood_area', dimIDs(1:2), type_double, & + [character(len=20) :: 'coordinates', 'units', 'long_name'], & + [character(len=150) :: 'pft dbh', 'm2', 'plant cross section area sapwood at reference height'], & + 3, sapwoodareaID) + + ! register sapwood biomass + call RegisterVar2D(ncid, 'bsap', dimIDs(1:2), type_double, & + [character(len=20) :: 'coordinates', 'units', 'long_name'], & + [character(len=150) :: 'pft dbh', 'kgC', 'plant sapwood biomass'], & + 3, bsapID) + + ! register belowground woody biomass + call RegisterVar2D(ncid, 'bbgw', dimIDs(1:2), type_double, & + [character(len=20) :: 'coordinates', 'units', 'long_name'], & + [character(len=150) :: 'pft dbh', 'kgC', 'plant belowground woody biomass'], & + 3, bbgwID) + + ! register fineroot biomass + call RegisterVar2D(ncid, 'fineroot_biomass', dimIDs(1:2), type_double, & + [character(len=20) :: 'coordinates', 'units', 'long_name'], & + [character(len=150) :: 'pft dbh', 'kgC', 'plant fineroot biomass'], & + 3, finerootID) + + ! register storage biomass + call RegisterVar2D(ncid, 'bstore', dimIDs(1:2), type_double, & + [character(len=20) :: 'coordinates', 'units', 'long_name'], & + [character(len=150) :: 'pft dbh', 'kgC', 'plant storage biomass'], & + 3, bstoreID) + + ! register structural biomass + call RegisterVar2D(ncid, 'bdead', dimIDs(1:2), type_double, & + [character(len=20) :: 'coordinates', 'units', 'long_name'], & + [character(len=150) :: 'pft dbh', 'kgC', 'plant deadwood (structural/heartwood) biomass'], & + 3, bdeadID) + + ! register total biomass (parts) + call RegisterVar2D(ncid, 'total_biomass_parts', dimIDs(1:2), type_double, & + [character(len=20) :: 'coordinates', 'units', 'long_name'], & + [character(len=150) :: 'pft dbh', 'kgC', 'plant total biomass calculated from parts'], & + 3, totbiomID1) + + ! register total biomass (tissues) + call RegisterVar2D(ncid, 'total_biomass_tissues', dimIDs(1:2), type_double, & + [character(len=20) :: 'coordinates', 'units', 'long_name'], & + [character(len=150) :: 'pft dbh', 'kgC', 'plant total biomass calculated from tissues'], & + 3, totbiomID2) + + ! finish defining variables call EndNCDef(ncid) @@ -143,6 +298,17 @@ subroutine WriteAllometryData(out_file, numdbh, numpft, dbh, height) call WriteVar(ncid, dbhID, dbh(:)) call WriteVar(ncid, pftID, pft_indices(:)) call WriteVar(ncid, heightID, height(:,:)) + call WriteVar(ncid, bagwID, bagw(:,:)) + call WriteVar(ncid, blmaxID, blmax(:,:)) + call WriteVar(ncid, c_areaID, crown_area(:,:)) + call WriteVar(ncid, sapwoodareaID, sapwood_area(:,:)) + call WriteVar(ncid, bsapID, bsap(:,:)) + call WriteVar(ncid, bbgwID, bbgw(:,:)) + call WriteVar(ncid, finerootID, fineroot_biomass(:,:)) + call WriteVar(ncid, bstoreID, bstore(:,:)) + call WriteVar(ncid, bdeadID, bdead(:,:)) + call WriteVar(ncid, totbiomID1, total_biom_parts(:,:)) + call WriteVar(ncid, totbiomID2, total_biom_tissues(:,:)) ! close the file call CloseNCFile(ncid) diff --git a/functional_unit_testing/build_fortran_tests.py b/functional_unit_testing/build_fortran_tests.py index 678a559f3c..16072450c2 100644 --- a/functional_unit_testing/build_fortran_tests.py +++ b/functional_unit_testing/build_fortran_tests.py @@ -48,7 +48,6 @@ def run_cmake(name, test_dir, pfunit_path, cmake_args): ] cmake_command.extend(cmake_args.split(" ")) - #print(" ".join(cmake_command)) run_cmd_no_fail(" ".join(cmake_command), combine_output=True) diff --git a/functional_unit_testing/run_fates_tests.py b/functional_unit_testing/run_fates_tests.py index 67370636f0..93ab844bc4 100755 --- a/functional_unit_testing/run_fates_tests.py +++ b/functional_unit_testing/run_fates_tests.py @@ -4,6 +4,7 @@ import sys from build_fortran_tests import build_unit_tests +import argparse import math import pandas as pd import numpy as np @@ -16,6 +17,15 @@ from CIME.utils import run_cmd_no_fail +DEFAULT_CDL_PATH = "../parameter_files/fates_params_default.cdl" +CMAKE_BASE_DIR = os.path.join(os.path.dirname(os.path.abspath(__file__)), "../") + +# Constants for now +out_file = "allometry_out.nc" +test_dir = "fates_allom_test" +test_exe = "FATES_allom_exe" +name = "fates_unit_tests" + def get_color_pallete(): """Generate a color pallete @@ -70,7 +80,9 @@ def plot_allometry_var(data, var, varname, units): plt.yticks(fontsize=10) plt.xticks(fontsize=10) - for y in range(0, int(maxvar), 5): + inc = (int(maxvar) - 0)/20 + for i in range(0, 20): + y = 0.0 + i*inc plt.plot(range(math.floor(0), math.ceil(maxdbh)), [y] * len(range(math.floor(0), math.ceil(maxdbh))), "--", lw=0.5, color="black", alpha=0.3) @@ -88,62 +100,310 @@ def plot_allometry_var(data, var, varname, units): plt.title(f"Simulated {varname} for input parameter file", fontsize=11) plt.legend(loc='upper left', title='PFT') - plt.show() -def create_nc_file(cdl_path): +def plot_total_biomass(data): + """Plot two calculations of total biomass against each other + + Args: + data (xarray DataSet): the allometry dataset + """ + df = pd.DataFrame({'dbh': np.tile(data.dbh, len(data.pft)), + 'pft': np.repeat(data.pft, len(data.dbh)), + 'total_biomass_parts': data.total_biomass_parts.values.flatten(), + 'total_biomass_tissues': data.total_biomass_tissues.values.flatten()}) + + colors = get_color_pallete() + + plt.figure(figsize=(7, 5)) + ax = plt.subplot(111) + ax.spines["top"].set_visible(False) + ax.spines["bottom"].set_visible(False) + ax.spines["right"].set_visible(False) + ax.spines["left"].set_visible(False) + + ax.get_xaxis().tick_bottom() + ax.get_yaxis().tick_left() + + maxbiomass = np.maximum(df['total_biomass_parts'].max(), df['total_biomass_tissues'].max()) + + plt.xlim(0.0, maxbiomass) + plt.ylim(0.0, maxbiomass) + + plt.yticks(fontsize=10) + plt.xticks(fontsize=10) + plt.tick_params(bottom=False, top=False, left=False, right=False) + + pfts = np.unique(df.pft.values) + for rank, pft in enumerate(pfts): + data = df[df.pft == pft] + plt.scatter(data.total_biomass_parts.values, data.total_biomass_parts.values, + color=colors[rank], label=pft) + + plt.xlabel('Total biomass (kgC) from parts', fontsize=11) + plt.ylabel('Total biomass (kgC) from tissues', fontsize=11) + plt.title("Simulated total biomass for input parameter file", fontsize=11) + plt.legend(loc='upper left', title='PFT') + +def create_nc_file(cdl_path, run_dir): + """Creates a netcdf file from a cdl file + + Args: + cdl_path (str): full path to desired cdl file + run_dir (str): where the file should be written to + """ file_basename = os.path.basename(cdl_path).split(".")[-2] file_nc_name = f"{file_basename}.nc" file_gen_command = [ "ncgen -o", - os.path.join(file_nc_name), + os.path.join(run_dir, file_nc_name), cdl_path ] - run_cmd_no_fail(" ".join(file_gen_command), combine_output=True) + out = run_cmd_no_fail(" ".join(file_gen_command), combine_output=True) + print(out) + + return file_nc_name + +def copy_file(file_path, dir): + """Copies a file file to a desired directory -def main(clean, build, run, build_dir, make_j, param_file): + Args: + file_path (str): full path to file + dir (str): where the file should be copied to + """ + file_basename = os.path.basename(file_path) + + file_copy_command = [ + "cp", + os.path.abspath(file_path), + os.path.abspath(dir) + ] + run_cmd_no_fail(" ".join(file_copy_command), combine_output=True) - # Constants for now - out_file = "allometry_out.nc" - test_dir = "fates_allom_test" - test_exe = "FATES_allom_exe" - name = "fates_unit_tests" - default_cdl_path = "../parameter_files/fates_params_default.cdl" + return file_basename + + +def run_exectuables(build_dir, test_dir, test_exe, run_dir, args): + """Run the generated executables + + Args: + build_dir (str): full path to build directory + run_dir (str): full path to run directory + test_dir (str): test directory within the run directory + test_exe (str): test executable to run + args ([str]): arguments for executable + """ + # move executable to run directory + exe_path = os.path.join(build_dir, test_dir, test_exe) + copy_file(exe_path, run_dir) + + # run the executable + new_exe_path = os.path.join(run_dir, test_exe) + run_command = [new_exe_path] + run_command.extend(args) + + os.chdir(run_dir) + print("Running exectuables") + out = run_cmd_no_fail(" ".join(run_command), combine_output=True) + print(out) + + +def run_tests(clean, build, run, build_dir, run_dir, make_j, param_file): + # absolute path to desired build directory build_dir_path = os.path.abspath(build_dir) + # absolute path to desired run directory + run_dir_path = os.path.abspath(run_dir) + + if not os.path.isdir(run_dir_path): + os.mkdir(run_dir_path) + if param_file is None: - print("Using default parameter file.") - param_file = default_cdl_path - create_nc_file(param_file) + print("Using default parameter file.") + param_file = DEFAULT_CDL_PATH + param_file = create_nc_file(param_file, run_dir_path) else: - print("Using parameter file {param_file}.") + print(f"Using parameter file {param_file}.") + file_suffix = os.path.basename(param_file).split(".")[-1] + if file_suffix == 'cdl': + param_file = create_nc_file(param_file, run_dir_path) + elif file_suffix == "nc": + param_file = copy_file(param_file, run_dir_path) + else: + raise RuntimeError("Must supply file with .cdl or .nc ending.") if build: - build_unit_tests(build_dir, name, os.path.abspath("../"), make_j, clean=clean) - + build_unit_tests(build_dir, name, CMAKE_BASE_DIR, make_j, clean=clean) + if run: - exe_path = os.path.join(build_dir_path, test_dir, test_exe) - run_command = [exe_path, os.path.abspath(param_file)] - out = run_cmd_no_fail(" ".join(run_command), combine_output=True) - print(out) - + run_exectuables(build_dir_path, test_dir, test_exe, run_dir_path, [param_file]) + # read in allometry data - allometry_dat = xr.open_dataset(out_file) + allometry_dat = xr.open_dataset(os.path.join(run_dir_path, out_file)) # plot allometry data plot_allometry_var(allometry_dat.height, 'height', 'height', 'm') + plot_allometry_var(allometry_dat.bagw, 'bagw', 'aboveground biomass', 'kgC') + plot_allometry_var(allometry_dat.blmax, 'blmax', 'maximum leaf biomass', 'kgC') + plot_allometry_var(allometry_dat.crown_area, 'crown_area', 'crown area', 'm$^2$') + plot_allometry_var(allometry_dat.sapwood_area, 'sapwood_area', 'sapwood area', 'm$^2$') + plot_allometry_var(allometry_dat.bsap, 'bsap', 'sapwood biomass', 'kgC') + plot_allometry_var(allometry_dat.bbgw, 'bbgw', 'belowground biomass', 'kgC') + plot_allometry_var(allometry_dat.fineroot_biomass, 'fineroot_biomass', 'fineroot biomass', 'kgC') + plot_allometry_var(allometry_dat.bstore, 'bstore', 'storage biomass', 'kgC') + plot_allometry_var(allometry_dat.bdead, 'bdead', 'deadwood biomass', 'kgC') + plot_allometry_var(allometry_dat.total_biomass_parts, 'total_biomass_parts', 'total biomass (calculated from parts)', 'kgC') + plot_allometry_var(allometry_dat.total_biomass_tissues, 'total_biomass_tissues', 'total biomass (calculated from tissues)', 'kgC') + plot_total_biomass(allometry_dat) + plt.show() + + +def commandline_args(): + """Parse and return command-line arguments""" + + description = """ + Driver for running FATES unit and functional tests + + Typical usage: + + ./run_fates_tests -f parameter_file.nc + """ + + parser = argparse.ArgumentParser( + description=description, formatter_class=argparse.RawTextHelpFormatter + ) + + parser.add_argument( + "-f", + "--parameter-file", + default=DEFAULT_CDL_PATH, + help="Parameter file to run the FATES tests with.\n" + "Can be a netcdf (.nc) or cdl (.cdl) file.\n" + "If no file is specified the script will use the default .cdl file in the\n" + "parameter_files directory.\n", + ) -if __name__ == "__main__": + parser.add_argument( + "-b", + "--build-dir", + default="../_build", + help="Directory where tests are built.\n" + "Will be created if it does not exist.\n", + ) + + parser.add_argument( + "-r", + "--run-dir", + default="../_run", + help="Directory where tests are run.\n" + "Will be created if it does not exist.\n", + ) + + parser.add_argument( + "--make-j", + type=int, + default=8, + help="Number of processes to use for build.", + ) + + parser.add_argument( + "-c", + "--clean", + action="store_true", + help="Clean build directory before building.\n" + "Removes CMake cache and runs 'make clean'.\n", + ) + + parser.add_argument( + "--skip-build", + action="store_true", + help="Skip building and compiling the test code.\n" + "Only do this if you already have run build.\n" + "Script will check to make sure executables are present.\n", + ) + + parser.add_argument( + "--skip-run", + action="store_true", + help="Skip running test code executables.\n" + "Only do this if you already have run the code previously.\n" + "Script will check to make sure required output files are present.\n", + ) + + args = parser.parse_args() - ## Arguments - clean = False - build = False - run = True - build_dir = "../_build" - make_j = 8 - param_file = None + check_arg_validity(args) + + return args + + +def check_build_exists(build_dir): + """Checks to see if the build directory and associated executables exist. + + Args: + build_dir (str): build directory + """ + + build_path = os.path.abspath(build_dir) + if not os.path.isdir(build_path): + return False + + exe_path = os.path.join(build_path, test_dir, test_exe) + if not os.path.isfile(exe_path): + return False + + return True + + +def check_out_file_exists(out_file): + """Checks to see if the required output files exist. + + Args: + out_file (str): required output file + """ + + full_path = os.path.abspath(out_file) + if not os.path.isfile(full_path): + return False + + return True + + +def check_arg_validity(args): + """Checks validity of input script arguments + + Args: + args (parse_args): input arguments + + Raises: + RuntimeError: Can't find input parameter file + RuntimeError: Can't find build directory or required executables + RuntimeError: Can't find required output files for plotting + """ + if args.parameter_file is not None: + if not os.path.isfile(args.parameter_file): + raise RuntimeError(f"Cannot find file {args.parameter_file}.") + if args.skip_build: + if not check_build_exists(os.path.abspath(args.build_dir)): + raise RuntimeError("Can't find build directory or executables, run again without --skip-build") + if args.skip_run: + if not check_out_file_exists(os.path.join(os.path.abspath(args.run_dir), out_file)): + raise RuntimeError(f"Can't find output file {out_file}, run again without --skip-run") + +def main(): + """Main script + """ + + args = commandline_args() + + build = not args.skip_build + run = not args.skip_run + + run_tests(args.clean, build, run, args.build_dir, args.run_dir, args.make_j, args.parameter_file) + +if __name__ == "__main__": - main(clean, build, run, build_dir, make_j, param_file) \ No newline at end of file + main() \ No newline at end of file diff --git a/unit_test_shr/FatesUnitTestIOMod.F90 b/unit_test_shr/FatesUnitTestIOMod.F90 index bbdf72b90c..cb65fdffa3 100644 --- a/unit_test_shr/FatesUnitTestIOMod.F90 +++ b/unit_test_shr/FatesUnitTestIOMod.F90 @@ -8,8 +8,8 @@ module FatesUnitTestIOMod private ! LOCALS - integer, parameter :: type_double = 1 ! type - integer, parameter :: type_int = 2 ! type + integer, public, parameter :: type_double = 1 ! type + integer, public, parameter :: type_int = 2 ! type interface GetVar module procedure GetVarScalarReal @@ -21,11 +21,22 @@ module FatesUnitTestIOMod module procedure GetVar3DInt end interface + interface WriteVar + module procedure WriteVar1DReal + module procedure WriteVar2DReal + module procedure WriteVar1DInt + module procedure WriteVar2DInt + end interface + public :: OpenNCFile public :: CloseNCFile public :: GetDimID public :: GetDimLen public :: GetVar + public :: RegisterNCDims + public :: RegisterVar2D, RegisterVar1D + public :: WriteVar + public :: EndNCDef contains @@ -64,13 +75,8 @@ logical function CheckFile(filename, fmode) case('readwrite') - if (.not. file_exists) then - write(*,'(a,a,a)') "File ", fname(1:len_trim(fname)), " does not exist. Can't read." - CheckFile = .false. - else - CheckFile = .true. - end if - + CheckFile = .true. + case('write') if (file_exists) then write(*, '(a, a, a)') "File ", fname(1:len_trim(fname)), " exists. Cannot open write only." @@ -439,7 +445,7 @@ subroutine RegisterVar1D(ncid, var_name, dimID, type, att_names, atts, num_atts, ! ARGUMENTS: integer, intent(in) :: ncid ! netcdf file id character(len=*), intent(in) :: var_name ! variable name - integer, intent(in) :: dimID(1) ! dimension ID + integer, intent(in) :: dimID ! dimension ID integer, intent(in) :: type ! type: int or double character(len=*), intent(in) :: att_names(num_atts) ! attribute names character(len=*), intent(in) :: atts(num_atts) ! attribute values @@ -508,6 +514,89 @@ subroutine RegisterVar2D(ncid, var_name, dimID, type, att_names, atts, num_atts, end subroutine RegisterVar2D -! ===================================================================================== + ! ===================================================================================== + + subroutine EndNCDef(ncid) + ! + ! DESCRIPTION: + ! End defining of netcdf dimensions and variables + ! + + ! ARGUMENTS: + integer, intent(in) :: ncid ! netcdf file id + + call Check(nf90_enddef(ncid)) + + end subroutine EndNCDef + + ! ===================================================================================== + + subroutine WriteVar1DReal(ncid, varID, data) + ! + ! DESCRIPTION: + ! Write 1D real data + ! + + ! ARGUMENTS: + integer, intent(in) :: ncid ! netcdf file id + integer, intent(in) :: varID ! variable ID + real(r8), intent(in) :: data(:) ! data to write + + call Check(nf90_put_var(ncid, varID, data(:))) + + end subroutine WriteVar1DReal + + ! ===================================================================================== + + subroutine WriteVar2DReal(ncid, varID, data) + ! + ! DESCRIPTION: + ! Write 2D real data + ! + + ! ARGUMENTS: + integer, intent(in) :: ncid ! netcdf file id + integer, intent(in) :: varID ! variable ID + real(r8), intent(in) :: data(:,:) ! data to write + + call Check(nf90_put_var(ncid, varID, data(:,:))) + + end subroutine WriteVar2DReal + + ! ===================================================================================== + + subroutine WriteVar1DInt(ncid, varID, data) + ! + ! DESCRIPTION: + ! Write 1D integer data + ! + + ! ARGUMENTS: + integer, intent(in) :: ncid ! netcdf file id + integer, intent(in) :: varID ! variable ID + integer, intent(in) :: data(:) ! data to write + + call Check(nf90_put_var(ncid, varID, data(:))) + + end subroutine WriteVar1DInt + + ! ===================================================================================== + + subroutine WriteVar2DInt(ncid, varID, data) + ! + ! DESCRIPTION: + ! Write 2D integer data + ! + + ! ARGUMENTS: + integer, intent(in) :: ncid ! netcdf file id + integer, intent(in) :: varID ! variable ID + integer, intent(in) :: data(:,:) ! data to write + + call Check(nf90_put_var(ncid, varID, data(:,:))) + + end subroutine WriteVar2DInt + + ! ===================================================================================== end module FatesUnitTestIOMod \ No newline at end of file diff --git a/unit_test_shr/FatesUnitTestParamReaderMod.F90 b/unit_test_shr/FatesUnitTestParamReaderMod.F90 index f36f2fd58e..3b14b98824 100644 --- a/unit_test_shr/FatesUnitTestParamReaderMod.F90 +++ b/unit_test_shr/FatesUnitTestParamReaderMod.F90 @@ -9,6 +9,8 @@ module FatesUnitTestParamReaderMod use EDParamsMod, only : FatesRegisterParams, FatesReceiveParams use SFParamsMod, only : SpitFireRegisterParams, SpitFireReceiveParams use PRTInitParamsFatesMod, only : PRTRegisterParams, PRTReceiveParams + use PRTParametersMod, only : prt_params + use FatesParameterDerivedMod, only : param_derived use FatesSynchronizedParamsMod, only : FatesSynchronizedParamsInst use EDPftvarcon, only : EDPftvarcon_inst use FatesUnitTestIOMod, only : OpenNCFile, GetDimID, GetDimLen, GetVar, CloseNCFile @@ -127,17 +129,22 @@ subroutine RetrieveParameters(this) call EDPftvarcon_inst%Register(fates_pft_params) call this%Read(fates_params) + call this%Read(fates_pft_params) call FatesReceiveParams(fates_params) call SpitFireReceiveParams(fates_params) call PRTReceiveParams(fates_params) call FatesSynchronizedParamsInst%ReceiveParams(fates_params) + call EDPftvarcon_inst%Receive(fates_pft_params) call fates_params%Destroy() call fates_pft_params%Destroy() deallocate(fates_params) deallocate(fates_pft_params) + ! initialize derived parameters + call param_derived%Init(size(prt_params%wood_density, dim=1)) + end subroutine RetrieveParameters ! -------------------------------------------------------------------------------------- From c6e95bc3ed10b70d0f028f4d189ca91401b2fa32 Mon Sep 17 00:00:00 2001 From: adrifoster Date: Wed, 17 Apr 2024 12:00:13 -0600 Subject: [PATCH 086/176] add function docstring --- functional_unit_testing/run_fates_tests.py | 14 ++++++++++++++ 1 file changed, 14 insertions(+) diff --git a/functional_unit_testing/run_fates_tests.py b/functional_unit_testing/run_fates_tests.py index 93ab844bc4..8089a3e930 100755 --- a/functional_unit_testing/run_fates_tests.py +++ b/functional_unit_testing/run_fates_tests.py @@ -210,6 +210,20 @@ def run_exectuables(build_dir, test_dir, test_exe, run_dir, args): def run_tests(clean, build, run, build_dir, run_dir, make_j, param_file): + """Builds and runs the fates tests + + Args: + clean (bool): whether or not to clean the build directory + build (bool): whether or not to build the exectuables + run (bool): whether or not to run the executables + build_dir (str): build directory + run_dir (str): run directory + make_j (int): number of processors for the build + param_file (str): input FATES parameter file + + Raises: + RuntimeError: Parameter file is not the correct file type + """ # absolute path to desired build directory build_dir_path = os.path.abspath(build_dir) From 101974e96d25e810f9304229717975e9a1f8dbf0 Mon Sep 17 00:00:00 2001 From: adrifoster Date: Wed, 17 Apr 2024 12:21:46 -0600 Subject: [PATCH 087/176] add more comments and instructions --- .../allometry/FatesTestAllometry.F90 | 61 ++++++++++--------- functional_unit_testing/run_fates_tests.py | 33 ++++++++-- unit_test_shr/FatesUnitTestIOMod.F90 | 24 ++++++-- unit_test_shr/FatesUnitTestParamReaderMod.F90 | 51 ++++++++-------- 4 files changed, 103 insertions(+), 66 deletions(-) diff --git a/functional_unit_testing/allometry/FatesTestAllometry.F90 b/functional_unit_testing/allometry/FatesTestAllometry.F90 index c7c542a8b2..5f021d57ed 100644 --- a/functional_unit_testing/allometry/FatesTestAllometry.F90 +++ b/functional_unit_testing/allometry/FatesTestAllometry.F90 @@ -10,14 +10,14 @@ program FatesTestAllometry implicit none ! LOCALS: - type(fates_unit_test_param_reader) :: param_reader - character(len=:), allocatable :: param_file - character(len=*), parameter :: out_file = 'allometry_out.nc' - integer :: numpft - integer :: arglen - integer :: i, j - integer :: numdbh - integer :: nargs + type(fates_unit_test_param_reader) :: param_reader ! param reader instance + character(len=:), allocatable :: param_file ! input parameter file + character(len=*), parameter :: out_file = 'allometry_out.nc' ! output file + integer :: numpft ! number of pfts (from parameter file) + integer :: arglen ! length of command line argument + integer :: i, j ! looping indices + integer :: numdbh ! size of dbh array + integer :: nargs ! number of command line arguments real(r8), allocatable :: dbh(:) ! diameter at breast height [cm] real(r8), allocatable :: height(:, :) ! height [m] real(r8), allocatable :: bagw(:, :) ! aboveground woody biomass [kgC] @@ -37,13 +37,13 @@ program FatesTestAllometry real(r8), parameter :: max_dbh = 200.0_r8 ! maximum DBH to calculate [cm] real(r8), parameter :: dbh_inc = 0.5_r8 ! DBHncrement to use [cm] - integer, parameter :: crown_damage = 1 - real(r8), parameter :: elongation_factor = 1.0_r8 - real(r8), parameter :: elongation_factor_roots = 1.0_r8 - real(r8), parameter :: site_spread = 1.0_r8 - real(r8), parameter :: canopy_trim = 1.0_r8 - real(r8), parameter :: nplant = 1.0_r8 - real(r8), parameter :: leaf_to_fineroot = 1.0_r8 + integer, parameter :: crown_damage = 1 ! crown damage + real(r8), parameter :: elongation_factor = 1.0_r8 ! elongation factor for stem + real(r8), parameter :: elongation_factor_roots = 1.0_r8 ! elongation factor for roots + real(r8), parameter :: site_spread = 1.0_r8 ! site spread + real(r8), parameter :: canopy_trim = 1.0_r8 ! canopy trim + real(r8), parameter :: nplant = 1.0_r8 ! number of plants per cohort + real(r8), parameter :: leaf_to_fineroot = 1.0_r8 ! leaf to fineroot ratio interface @@ -163,21 +163,22 @@ subroutine WriteAllometryData(out_file, numdbh, numpft, dbh, height, bagw, blmax implicit none ! ARGUMENTS: - character(len=*), intent(in) :: out_file - integer, intent(in) :: numdbh, numpft - real(r8), intent(in) :: dbh(:) - real(r8), intent(in) :: height(:,:) - real(r8), intent(in) :: bagw(:,:) - real(r8), intent(in) :: blmax(:, :) - real(r8), intent(in) :: crown_area(:, :) - real(r8), intent(in) :: sapwood_area(:, :) - real(r8), intent(in) :: bsap(:, :) - real(r8), intent(in) :: bbgw(:, :) - real(r8), intent(in) :: fineroot_biomass(:, :) - real(r8), intent(in) :: bstore(:, :) - real(r8), intent(in) :: bdead(:, :) - real(r8), intent(in) :: total_biom_parts(:, :) - real(r8), intent(in) :: total_biom_tissues(:, :) + character(len=*), intent(in) :: out_file ! output file name + integer, intent(in) :: numdbh ! size of dbh array + integer, intent(in) :: numpft ! number of pfts + real(r8), intent(in) :: dbh(:) ! diameter at breast height [cm] + real(r8), intent(in) :: height(:,:) ! height [m] + real(r8), intent(in) :: bagw(:,:) ! aboveground biomass [kgC] + real(r8), intent(in) :: blmax(:, :) ! leaf biomass [kgC] + real(r8), intent(in) :: crown_area(:, :) ! crown area [m2] + real(r8), intent(in) :: sapwood_area(:, :) ! sapwood cross-sectional area [m2] + real(r8), intent(in) :: bsap(:, :) ! sapwood biomass [kgC] + real(r8), intent(in) :: bbgw(:, :) ! belowground biomass [kgC] + real(r8), intent(in) :: fineroot_biomass(:, :) ! fineroot biomass [kgC] + real(r8), intent(in) :: bstore(:, :) ! storage biomass [kgC] + real(r8), intent(in) :: bdead(:, :) ! deadwood biomass [kgC] + real(r8), intent(in) :: total_biom_parts(:, :) ! total biomass calculated from parts [kgC] + real(r8), intent(in) :: total_biom_tissues(:, :) ! total biomass calculated from tissues [kgC] ! LOCALS: integer, allocatable :: pft_indices(:) ! array of pft indices to write out diff --git a/functional_unit_testing/run_fates_tests.py b/functional_unit_testing/run_fates_tests.py index 8089a3e930..8f97827365 100755 --- a/functional_unit_testing/run_fates_tests.py +++ b/functional_unit_testing/run_fates_tests.py @@ -1,11 +1,36 @@ #!/usr/bin/env python -import os -import sys -from build_fortran_tests import build_unit_tests +""" +|------------------------------------------------------------------| +|--------------------- Instructions -----------------------------| +|------------------------------------------------------------------| +To run this script the following python packages are required: + - numpy + - xarray + - matplotlib + - pandas -import argparse +Though this script does not require any host land model code, it does require some CIME and shr code, +so you should still get these repositories as you normally would (i.e., manage_externals, etc.) + +Additionally, this requires netcdf and netcdff as well as a fortran compiler. + +You must also have a .cime folder in your home directory which specifies machine +configurations for CIME. + +This script builds and runs various FATES unit and functional tests, and plots any +relevant output from those tests. + +You can supply your own parameter file (either a .cdl or a .nc file), or if you do not +specify anything, the sript will use the default FATES parameter cdl file. + +""" + +import os import math +import argparse + +from build_fortran_tests import build_unit_tests import pandas as pd import numpy as np import xarray as xr diff --git a/unit_test_shr/FatesUnitTestIOMod.F90 b/unit_test_shr/FatesUnitTestIOMod.F90 index cb65fdffa3..d1428ea3ec 100644 --- a/unit_test_shr/FatesUnitTestIOMod.F90 +++ b/unit_test_shr/FatesUnitTestIOMod.F90 @@ -157,9 +157,15 @@ end subroutine CloseNCFile !======================================================================================= subroutine GetDimID(ncid, var_name, dim_id) - integer, intent(in) :: ncid - character(len=*), intent(in) :: var_name - integer, intent(out) :: dim_id + ! + ! DESCRIPTION: + ! Gets dimension IDs for a variable ID + ! + + ! ARGUMENTS: + integer, intent(in) :: ncid ! netcdf file unit number + character(len=*), intent(in) :: var_name ! variable name + integer, intent(out) :: dim_id ! dimension ID call Check(nf90_inq_dimid(ncid, var_name, dim_id)) @@ -168,9 +174,15 @@ end subroutine GetDimID !======================================================================================= subroutine GetDimLen(ncid, dim_id, dim_len) - integer, intent(in) :: ncid - integer, intent(in) :: dim_id - integer, intent(out) :: dim_len + ! + ! DESCRIPTION: + ! Gets dimension lengths given a dimension ID + ! + + ! ARGUMENTS: + integer, intent(in) :: ncid ! netcdf file unit number + integer, intent(in) :: dim_id ! dimension ID + integer, intent(out) :: dim_len ! dimension length call Check(nf90_inquire_dimension(ncid, dim_id, len=dim_len)) diff --git a/unit_test_shr/FatesUnitTestParamReaderMod.F90 b/unit_test_shr/FatesUnitTestParamReaderMod.F90 index 3b14b98824..624c98ea68 100644 --- a/unit_test_shr/FatesUnitTestParamReaderMod.F90 +++ b/unit_test_shr/FatesUnitTestParamReaderMod.F90 @@ -56,17 +56,16 @@ subroutine ReadParameters(this, fates_params) class(fates_parameters_type), intent(inout) :: fates_params ! LOCALS: - real(r8), allocatable :: data2d(:, :) - real(r8), allocatable :: data1d(:) - real(r8) :: data_scalar - integer :: ncid - integer :: num_params - integer :: dimension_shape - integer :: i - integer :: max_dim_size - character(len=param_string_length) :: name - integer :: dimension_sizes(max_dimensions) - character(len=param_string_length) :: dimension_names(max_dimensions) + real(r8), allocatable :: data2d(:, :) ! data for 2D parameters + real(r8), allocatable :: data1d(:) ! data for 1D parameters + real(r8) :: data_scalar ! data for scalar parameters + integer :: ncid ! netcdf file ID + integer :: num_params ! total number of parameters + integer :: dimension_shape ! shape of parameter's dimension + integer :: i ! looping index + character(len=param_string_length) :: name ! parameter name + integer :: dimension_sizes(max_dimensions) ! sizes of dimensions from parameter file + character(len=param_string_length) :: dimension_names(max_dimensions) ! names of dimensions from parameter file logical :: is_host_param call OpenNCFile(this%filename, ncid, 'read') @@ -108,11 +107,11 @@ subroutine RetrieveParameters(this) ! Read in fates parameters ! ! ARGUMENTS: - class(fates_unit_test_param_reader), intent(in) :: this - + class(fates_unit_test_param_reader), intent(in) :: this ! parameter reader class + ! LOCALS: - class(fates_parameters_type), allocatable :: fates_params - class(fates_parameters_type), allocatable :: fates_pft_params + class(fates_parameters_type), allocatable :: fates_params ! fates parameters (for non-pft parameters) + class(fates_parameters_type), allocatable :: fates_pft_params ! fates parameters (for pft parameters) ! allocate and read in parameters allocate(fates_params) @@ -122,9 +121,9 @@ subroutine RetrieveParameters(this) call EDPftvarcon_inst%Init() - call PRTRegisterParams(fates_params) - call FatesRegisterParams(fates_params) + call FatesRegisterParams(fates_params) call SpitFireRegisterParams(fates_params) + call PRTRegisterParams(fates_params) call FatesSynchronizedParamsInst%RegisterParams(fates_params) call EDPftvarcon_inst%Register(fates_pft_params) @@ -152,16 +151,16 @@ end subroutine RetrieveParameters subroutine SetParameterDimensions(ncid, fates_params) ! ! DESCRIPTION: - ! Read in fates parameters + ! Gets and sets the parameter dimensions for the fates parameters class ! ! ARGUMENTS: integer, intent(in) :: ncid ! netcdf file ID class(fates_parameters_type), intent(inout) :: fates_params ! fates parameters class ! LOCALS: - integer :: num_used_dimensions - character(len=param_string_length) :: used_dimension_names(max_used_dimensions) - integer :: used_dimension_sizes(max_used_dimensions) + integer :: num_used_dimensions ! total number of dimensions + character(len=param_string_length) :: used_dimension_names(max_used_dimensions) ! dimension names + integer :: used_dimension_sizes(max_used_dimensions) ! dimension sizes call fates_params%GetUsedDimensions(.false., num_used_dimensions, used_dimension_names) @@ -178,13 +177,13 @@ end subroutine SetParameterDimensions subroutine GetUsedDimensionSizes(ncid, num_used_dimensions, dimension_names, dimension_sizes) ! ! DESCRIPTION: - ! Get dimension sizes for parameters + ! Gets dimension sizes for parameters ! ! ARGUMENTS: - integer, intent(in) :: ncid - integer, intent(in) :: num_used_dimensions - character(len=param_string_length), intent(in) :: dimension_names(:) - integer, intent(out) :: dimension_sizes(:) + integer, intent(in) :: ncid ! netcdf file ID + integer, intent(in) :: num_used_dimensions ! number of dimensions + character(len=param_string_length), intent(in) :: dimension_names(:) ! dimension names + integer, intent(out) :: dimension_sizes(:) ! dimension sizes ! LOCALS integer :: d From e800023987947b526add19aaa1277efa95f3e758 Mon Sep 17 00:00:00 2001 From: adrifoster Date: Wed, 17 Apr 2024 12:24:54 -0600 Subject: [PATCH 088/176] absolute path for parameter file --- functional_unit_testing/run_fates_tests.py | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/functional_unit_testing/run_fates_tests.py b/functional_unit_testing/run_fates_tests.py index 8f97827365..7a429b08a5 100755 --- a/functional_unit_testing/run_fates_tests.py +++ b/functional_unit_testing/run_fates_tests.py @@ -42,14 +42,15 @@ from CIME.utils import run_cmd_no_fail -DEFAULT_CDL_PATH = "../parameter_files/fates_params_default.cdl" +DEFAULT_CDL_PATH = os.path.abspath("../parameter_files/fates_params_default.cdl") CMAKE_BASE_DIR = os.path.join(os.path.dirname(os.path.abspath(__file__)), "../") +NAME = "fates_unit_tests" # Constants for now +## TODO update this to be some kind of dictionary we can loop through out_file = "allometry_out.nc" test_dir = "fates_allom_test" test_exe = "FATES_allom_exe" -name = "fates_unit_tests" def get_color_pallete(): """Generate a color pallete @@ -274,7 +275,7 @@ def run_tests(clean, build, run, build_dir, run_dir, make_j, param_file): raise RuntimeError("Must supply file with .cdl or .nc ending.") if build: - build_unit_tests(build_dir, name, CMAKE_BASE_DIR, make_j, clean=clean) + build_unit_tests(build_dir, NAME, CMAKE_BASE_DIR, make_j, clean=clean) if run: run_exectuables(build_dir_path, test_dir, test_exe, run_dir_path, [param_file]) From c4bc8e61919eb0e497650a0d1de4f6f8a07af113 Mon Sep 17 00:00:00 2001 From: adrifoster Date: Wed, 17 Apr 2024 12:30:35 -0600 Subject: [PATCH 089/176] remove if allocated statement --- main/FatesParametersInterface.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/main/FatesParametersInterface.F90 b/main/FatesParametersInterface.F90 index 8ea2b8a13e..0559ec3eb6 100644 --- a/main/FatesParametersInterface.F90 +++ b/main/FatesParametersInterface.F90 @@ -135,7 +135,7 @@ subroutine Destroy(this) integer :: n do n = 1, this%num_parameters - if(allocated(this%parameters(n)%data)) deallocate(this%parameters(n)%data) + deallocate(this%parameters(n)%data) end do end subroutine Destroy From 98cb1a45caa7401b06132cf11870dc2d9b107217 Mon Sep 17 00:00:00 2001 From: adrifoster Date: Wed, 17 Apr 2024 13:24:06 -0600 Subject: [PATCH 090/176] automatically find netcdf paths --- CMakeLists.txt | 4 +-- .../allometry/CMakeLists.txt | 4 +-- .../build_fortran_tests.py | 28 +++++++++++-------- 3 files changed, 21 insertions(+), 15 deletions(-) diff --git a/CMakeLists.txt b/CMakeLists.txt index 868614bfac..a8822035a8 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -65,8 +65,8 @@ include_directories(${HLM_ROOT}/share/include) # This needs to be something we add dynamically # via some calls using cime -set(NETCDF_C_DIR "/usr/local/Cellar/netcdf/4.9.2_1") -set(NETCDF_FORTRAN_DIR "/usr/local/Cellar/netcdf-fortran/4.6.1") +set(NETCDF_C_DIR ${NETCDF_C_PATH}) +set(NETCDF_FORTRAN_DIR ${NETCDF_F_PATH}) FIND_PATH(NETCDFC_FOUND libnetcdf.a ${NETCDF_C_DIR}/lib) FIND_PATH(NETCDFF_FOUND libnetcdff.a ${NETCDF_FORTRAN_DIR}/lib) diff --git a/functional_unit_testing/allometry/CMakeLists.txt b/functional_unit_testing/allometry/CMakeLists.txt index 3e05759809..f43992847d 100644 --- a/functional_unit_testing/allometry/CMakeLists.txt +++ b/functional_unit_testing/allometry/CMakeLists.txt @@ -1,7 +1,7 @@ set(allom_sources FatesTestAllometry.F90) -set(NETCDF_C_DIR "/usr/local/Cellar/netcdf/4.9.2_1") -set(NETCDF_FORTRAN_DIR "/usr/local/Cellar/netcdf-fortran/4.6.1") +set(NETCDF_C_DIR ${NETCDF_C_PATH}) +set(NETCDF_FORTRAN_DIR ${NETCDF_F_PATH}) FIND_PATH(NETCDFC_FOUND libnetcdf.a ${NETCDF_C_DIR}/lib) FIND_PATH(NETCDFF_FOUND libnetcdff.a ${NETCDF_FORTRAN_DIR}/lib) diff --git a/functional_unit_testing/build_fortran_tests.py b/functional_unit_testing/build_fortran_tests.py index 16072450c2..fa609a0929 100644 --- a/functional_unit_testing/build_fortran_tests.py +++ b/functional_unit_testing/build_fortran_tests.py @@ -16,12 +16,14 @@ _CIMEROOT = os.path.join(os.path.dirname(os.path.abspath(__file__)), "../../../cime") -def run_cmake(name, test_dir, pfunit_path, cmake_args): +def run_cmake(name, test_dir, pfunit_path, netcdf_c_path, netcdf_f_path, cmake_args): """Run cmake for the fortran unit tests Arguments: name (str) - name for output messages test_dir (str) - directory to run Cmake in pfunit_path (str) - path to pfunit + netcdf_c_path (str) - path to netcdf + netcdf_f_path (str) - path to netcdff clean (bool) - clean the build """ if not os.path.isfile("CMakeCache.txt"): @@ -42,6 +44,8 @@ def run_cmake(name, test_dir, pfunit_path, cmake_args): f"-DCIME_CMAKE_MODULE_DIRECTORY={cmake_module_dir}", "-DCMAKE_BUILD_TYPE=CESM_DEBUG", f"-DCMAKE_PREFIX_PATH={pfunit_path}", + f"-DNETCDF_C_PATH={netcdf_c_path}", + f"-DNETCDF_F_PATH={netcdf_f_path}", "-DUSE_MPI_SERIAL=ON", "-DENABLE_GENF90=ON", f"-DCMAKE_PROGRAM_PATH={genf90_dir}" @@ -52,8 +56,8 @@ def run_cmake(name, test_dir, pfunit_path, cmake_args): run_cmd_no_fail(" ".join(cmake_command), combine_output=True) -def find_pfunit(caseroot, cmake_args): - """Find the pfunit installation we'll be using, and print its path +def find_library(caseroot, cmake_args, lib_string): + """Find the library installation we'll be using, and print its path Args: caseroot (str): Directory with pfunit macros @@ -67,14 +71,14 @@ def find_pfunit(caseroot, cmake_args): if ":=" in all_var: expect(all_var.count(":=") == 1, f"Bad makefile: {all_var}") varname, value = [item.strip() for item in all_var.split(":=")] - if varname == "PFUNIT_PATH": + if varname == lib_string: return value - expect(False, "PFUNIT_PATH not found for this machine and compiler") + expect(False, f"{lib_string} not found for this machine and compiler") return None - - + + def prep_build_dir(build_dir, clean): """Create (if necessary) build directory and clean contents (if asked to) @@ -203,14 +207,16 @@ def build_unit_tests(build_dir, name, cmake_directory, make_j, clean=False): # create the build directory full_build_path = prep_build_dir(build_dir, clean=clean) - # get cmake args and the pfunit path + # get cmake args and the pfunit and netcdf paths cmake_args = get_extra_cmake_args(full_build_path, "mpi-serial") - pfunit_path = find_pfunit(full_build_path, cmake_args) - + pfunit_path = find_library(full_build_path, cmake_args, "PFUNIT_PATH") + netcdf_c_path = find_library(full_build_path, cmake_args, "NETCDF_C_PATH") + netcdf_f_path = find_library(full_build_path, cmake_args, "NETCDF_FORTRAN_PATH") + # change into the build dir os.chdir(full_build_path) # run cmake and make - run_cmake(name, cmake_directory, pfunit_path, cmake_args) + run_cmake(name, cmake_directory, pfunit_path, netcdf_c_path, netcdf_f_path, cmake_args) run_make(name, make_j, clean=clean) From e5571ed2ba12857595cd6dd8336cb6be910951d9 Mon Sep 17 00:00:00 2001 From: Adrianna Foster Date: Wed, 17 Apr 2024 14:37:29 -0600 Subject: [PATCH 091/176] get working on derecho, save figures --- .../build_fortran_tests.py | 17 ++++-- functional_unit_testing/run_fates_tests.py | 61 +++++++++++++------ 2 files changed, 57 insertions(+), 21 deletions(-) diff --git a/functional_unit_testing/build_fortran_tests.py b/functional_unit_testing/build_fortran_tests.py index fa609a0929..66556ac189 100644 --- a/functional_unit_testing/build_fortran_tests.py +++ b/functional_unit_testing/build_fortran_tests.py @@ -44,13 +44,17 @@ def run_cmake(name, test_dir, pfunit_path, netcdf_c_path, netcdf_f_path, cmake_a f"-DCIME_CMAKE_MODULE_DIRECTORY={cmake_module_dir}", "-DCMAKE_BUILD_TYPE=CESM_DEBUG", f"-DCMAKE_PREFIX_PATH={pfunit_path}", - f"-DNETCDF_C_PATH={netcdf_c_path}", - f"-DNETCDF_F_PATH={netcdf_f_path}", "-DUSE_MPI_SERIAL=ON", "-DENABLE_GENF90=ON", f"-DCMAKE_PROGRAM_PATH={genf90_dir}" ] + if netcdf_c_path is not None: + cmake_command.append(f"-DNETCDF_C_PATH={netcdf_c_path}") + + if netcdf_f_path is not None: + cmake_command.append(f"-DNETCDF_F_PATH={netcdf_f_path}") + cmake_command.extend(cmake_args.split(" ")) run_cmd_no_fail(" ".join(cmake_command), combine_output=True) @@ -210,8 +214,13 @@ def build_unit_tests(build_dir, name, cmake_directory, make_j, clean=False): # get cmake args and the pfunit and netcdf paths cmake_args = get_extra_cmake_args(full_build_path, "mpi-serial") pfunit_path = find_library(full_build_path, cmake_args, "PFUNIT_PATH") - netcdf_c_path = find_library(full_build_path, cmake_args, "NETCDF_C_PATH") - netcdf_f_path = find_library(full_build_path, cmake_args, "NETCDF_FORTRAN_PATH") + + if not "NETCDF" in os.environ: + netcdf_c_path = find_library(full_build_path, cmake_args, "NETCDF_C_PATH") + netcdf_f_path = find_library(full_build_path, cmake_args, "NETCDF_FORTRAN_PATH") + else: + netcdf_c_path = None + netcdf_f_path = None # change into the build dir os.chdir(full_build_path) diff --git a/functional_unit_testing/run_fates_tests.py b/functional_unit_testing/run_fates_tests.py index 7a429b08a5..3ab6be6941 100755 --- a/functional_unit_testing/run_fates_tests.py +++ b/functional_unit_testing/run_fates_tests.py @@ -72,7 +72,7 @@ def get_color_pallete(): return colors -def plot_allometry_var(data, var, varname, units): +def plot_allometry_var(data, var, varname, units, save_fig, plot_dir=None): """Plot an allometry variable Args: @@ -80,6 +80,8 @@ def plot_allometry_var(data, var, varname, units): var (str): variable name (for data structure) varname (str): variable name for plot labels units (str): variable units for plot labels + save_fig (bool): whether or not to write out plot + plot_dir (str): if saving figure, where to write to """ df = pd.DataFrame({'dbh': np.tile(data.dbh, len(data.pft)), 'pft': np.repeat(data.pft, len(data.dbh)), @@ -126,8 +128,12 @@ def plot_allometry_var(data, var, varname, units): plt.title(f"Simulated {varname} for input parameter file", fontsize=11) plt.legend(loc='upper left', title='PFT') + if save_fig: + fig_name = os.path.join(plot_dir, f"allometry_plot_{var}.png") + plt.savefig(fig_name) -def plot_total_biomass(data): + +def plot_total_biomass(data, save_fig, plot_dir): """Plot two calculations of total biomass against each other Args: @@ -169,6 +175,10 @@ def plot_total_biomass(data): plt.ylabel('Total biomass (kgC) from tissues', fontsize=11) plt.title("Simulated total biomass for input parameter file", fontsize=11) plt.legend(loc='upper left', title='PFT') + + if save_fig: + fig_name = os.path.join(plot_dir, "allometry_plot_total_biomass_compare.png") + plt.savefig(fig_name) def create_nc_file(cdl_path, run_dir): """Creates a netcdf file from a cdl file @@ -235,7 +245,7 @@ def run_exectuables(build_dir, test_dir, test_exe, run_dir, args): print(out) -def run_tests(clean, build, run, build_dir, run_dir, make_j, param_file): +def run_tests(clean, build, run, build_dir, run_dir, make_j, param_file, save_figs): """Builds and runs the fates tests Args: @@ -246,6 +256,7 @@ def run_tests(clean, build, run, build_dir, run_dir, make_j, param_file): run_dir (str): run directory make_j (int): number of processors for the build param_file (str): input FATES parameter file + save_figs (bool): whether or not to write figures to file Raises: RuntimeError: Parameter file is not the correct file type @@ -260,6 +271,13 @@ def run_tests(clean, build, run, build_dir, run_dir, make_j, param_file): if not os.path.isdir(run_dir_path): os.mkdir(run_dir_path) + if save_figs: + plot_dir = os.path.join(run_dir_path, 'plots') + if not os.path.isdir(plot_dir): + os.mkdir(plot_dir) + else: + plot_dir = None + if param_file is None: print("Using default parameter file.") param_file = DEFAULT_CDL_PATH @@ -284,19 +302,19 @@ def run_tests(clean, build, run, build_dir, run_dir, make_j, param_file): allometry_dat = xr.open_dataset(os.path.join(run_dir_path, out_file)) # plot allometry data - plot_allometry_var(allometry_dat.height, 'height', 'height', 'm') - plot_allometry_var(allometry_dat.bagw, 'bagw', 'aboveground biomass', 'kgC') - plot_allometry_var(allometry_dat.blmax, 'blmax', 'maximum leaf biomass', 'kgC') - plot_allometry_var(allometry_dat.crown_area, 'crown_area', 'crown area', 'm$^2$') - plot_allometry_var(allometry_dat.sapwood_area, 'sapwood_area', 'sapwood area', 'm$^2$') - plot_allometry_var(allometry_dat.bsap, 'bsap', 'sapwood biomass', 'kgC') - plot_allometry_var(allometry_dat.bbgw, 'bbgw', 'belowground biomass', 'kgC') - plot_allometry_var(allometry_dat.fineroot_biomass, 'fineroot_biomass', 'fineroot biomass', 'kgC') - plot_allometry_var(allometry_dat.bstore, 'bstore', 'storage biomass', 'kgC') - plot_allometry_var(allometry_dat.bdead, 'bdead', 'deadwood biomass', 'kgC') - plot_allometry_var(allometry_dat.total_biomass_parts, 'total_biomass_parts', 'total biomass (calculated from parts)', 'kgC') - plot_allometry_var(allometry_dat.total_biomass_tissues, 'total_biomass_tissues', 'total biomass (calculated from tissues)', 'kgC') - plot_total_biomass(allometry_dat) + plot_allometry_var(allometry_dat.height, 'height', 'height', 'm', save_figs, plot_dir) + plot_allometry_var(allometry_dat.bagw, 'bagw', 'aboveground biomass', 'kgC', save_figs, plot_dir) + plot_allometry_var(allometry_dat.blmax, 'blmax', 'maximum leaf biomass', 'kgC', save_figs, plot_dir) + plot_allometry_var(allometry_dat.crown_area, 'crown_area', 'crown area', 'm$^2$', save_figs, plot_dir) + plot_allometry_var(allometry_dat.sapwood_area, 'sapwood_area', 'sapwood area', 'm$^2$', save_figs, plot_dir) + plot_allometry_var(allometry_dat.bsap, 'bsap', 'sapwood biomass', 'kgC', save_figs, plot_dir) + plot_allometry_var(allometry_dat.bbgw, 'bbgw', 'belowground biomass', 'kgC', save_figs, plot_dir) + plot_allometry_var(allometry_dat.fineroot_biomass, 'fineroot_biomass', 'fineroot biomass', 'kgC', save_figs, plot_dir) + plot_allometry_var(allometry_dat.bstore, 'bstore', 'storage biomass', 'kgC', save_figs, plot_dir) + plot_allometry_var(allometry_dat.bdead, 'bdead', 'deadwood biomass', 'kgC', save_figs, plot_dir) + plot_allometry_var(allometry_dat.total_biomass_parts, 'total_biomass_parts', 'total biomass (calculated from parts)', 'kgC', save_figs, plot_dir) + plot_allometry_var(allometry_dat.total_biomass_tissues, 'total_biomass_tissues', 'total biomass (calculated from tissues)', 'kgC', save_figs, plot_dir) + plot_total_biomass(allometry_dat, save_figs, plot_dir) plt.show() @@ -373,6 +391,14 @@ def commandline_args(): "Script will check to make sure required output files are present.\n", ) + parser.add_argument( + "--save-figs", + action="store_true", + help="Write out generated figures to files.\n" + "Will be placed in run_dir/plots.\n" + "Should probably do this on remote machines.\n", + ) + args = parser.parse_args() check_arg_validity(args) @@ -442,7 +468,8 @@ def main(): build = not args.skip_build run = not args.skip_run - run_tests(args.clean, build, run, args.build_dir, args.run_dir, args.make_j, args.parameter_file) + run_tests(args.clean, build, run, args.build_dir, args.run_dir, args.make_j, + args.parameter_file, args.save_figs) if __name__ == "__main__": From 73cd037372f0f54563340ff5cbe9ddb506d0bff6 Mon Sep 17 00:00:00 2001 From: Sam Rabin Date: Thu, 18 Apr 2024 10:48:12 -0600 Subject: [PATCH 092/176] 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 093/176] 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 a3dd198cdbf9371e638d0a98a856e4b1c1080b9c Mon Sep 17 00:00:00 2001 From: adrifoster Date: Fri, 19 Apr 2024 09:53:11 -0600 Subject: [PATCH 094/176] add quadratic test; refactor to allow picking which test to run --- CMakeLists.txt | 3 +- functional_unit_testing/CMakeLists.txt | 3 +- .../allometry/AllometryUtils.py | 179 +++++++ .../allometry/CMakeLists.txt | 9 +- .../allometry/FatesTestAllometry.F90 | 72 ++- .../build_fortran_tests.py | 90 ++-- .../math_utils/CMakeLists.txt | 10 + .../math_utils/FatesTestMathUtils.F90 | 138 ++++++ .../math_utils/MathUtils.py | 34 ++ .../math_utils/MathUtilsDriver.py | 172 ------- functional_unit_testing/math_utils/bld/README | 1 - .../math_utils/build_math_objects.sh | 47 -- .../math_utils/f90_src/UnitWrapMod.F90 | 49 -- functional_unit_testing/path_utils.py | 51 ++ functional_unit_testing/run_fates_tests.py | 451 +++++++----------- functional_unit_testing/utils.py | 111 +++-- 16 files changed, 726 insertions(+), 694 deletions(-) create mode 100644 functional_unit_testing/allometry/AllometryUtils.py create mode 100644 functional_unit_testing/math_utils/CMakeLists.txt create mode 100644 functional_unit_testing/math_utils/FatesTestMathUtils.F90 create mode 100644 functional_unit_testing/math_utils/MathUtils.py delete mode 100644 functional_unit_testing/math_utils/MathUtilsDriver.py delete mode 100644 functional_unit_testing/math_utils/bld/README delete mode 100755 functional_unit_testing/math_utils/build_math_objects.sh delete mode 100644 functional_unit_testing/math_utils/f90_src/UnitWrapMod.F90 create mode 100644 functional_unit_testing/path_utils.py diff --git a/CMakeLists.txt b/CMakeLists.txt index a8822035a8..b8b7b12a08 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -87,4 +87,5 @@ link_directories(${CMAKE_CURRENT_BINARY_DIR}) # has tests in it. However, it appears that the order needs to be done # carefully: for example, include_directories and link_directories needs to be # done before adding the tests themselves. -add_subdirectory(${HLM_ROOT}/src/fates/functional_unit_testing/allometry fates_allom_test) \ No newline at end of file +add_subdirectory(${HLM_ROOT}/src/fates/functional_unit_testing/allometry fates_allom_test) +add_subdirectory(${HLM_ROOT}/src/fates/functional_unit_testing/math_utils fates_math_test) \ No newline at end of file diff --git a/functional_unit_testing/CMakeLists.txt b/functional_unit_testing/CMakeLists.txt index 90d16c8d18..1ab61abfc2 100644 --- a/functional_unit_testing/CMakeLists.txt +++ b/functional_unit_testing/CMakeLists.txt @@ -1 +1,2 @@ -add_subdirectory(allometry) \ No newline at end of file +add_subdirectory(allometry) +add_subdirectory(math_utils) \ No newline at end of file diff --git a/functional_unit_testing/allometry/AllometryUtils.py b/functional_unit_testing/allometry/AllometryUtils.py new file mode 100644 index 0000000000..ac0a285672 --- /dev/null +++ b/functional_unit_testing/allometry/AllometryUtils.py @@ -0,0 +1,179 @@ +"""Utility functions for allometry functional unit tests +""" +import os +import math +import pandas as pd +import numpy as np +import xarray as xr +import matplotlib +import matplotlib.pyplot as plt +from utils import get_color_pallete, round_up + +def plot_allometry_var(data, varname, units, save_fig, plot_dir=None): + """Plot an allometry variable + + Args: + data (xarray DataArray): the data array of the variable to plot + var (str): variable name (for data structure) + varname (str): variable name for plot labels + units (str): variable units for plot labels + save_fig (bool): whether or not to write out plot + plot_dir (str): if saving figure, where to write to + """ + df = pd.DataFrame({'dbh': np.tile(data.dbh, len(data.pft)), + 'pft': np.repeat(data.pft, len(data.dbh)), + data.name: data.values.flatten()}) + + maxdbh = df['dbh'].max() + maxvar = round_up(df[data.name].max()) + + colors = get_color_pallete() + + plt.figure(figsize=(7, 5)) + ax = plt.subplot(111) + ax.spines["top"].set_visible(False) + ax.spines["bottom"].set_visible(False) + ax.spines["right"].set_visible(False) + ax.spines["left"].set_visible(False) + + ax.get_xaxis().tick_bottom() + ax.get_yaxis().tick_left() + + plt.xlim(0.0, maxdbh) + plt.ylim(0.0, maxvar) + + plt.yticks(fontsize=10) + plt.xticks(fontsize=10) + + inc = (int(maxvar) - 0)/20 + for i in range(0, 20): + y = 0.0 + i*inc + plt.plot(range(math.floor(0), math.ceil(maxdbh)), + [y] * len(range(math.floor(0), math.ceil(maxdbh))), + "--", lw=0.5, color="black", alpha=0.3) + + plt.tick_params(bottom=False, top=False, left=False, right=False) + + pfts = np.unique(df.pft.values) + for rank, pft in enumerate(pfts): + dat = df[df.pft == pft] + plt.plot(dat.dbh.values, dat[data.name].values, lw=2, color=colors[rank], + label=pft) + + plt.xlabel('DBH (cm)', fontsize=11) + plt.ylabel(f'{varname} ({units})', fontsize=11) + plt.title(f"Simulated {varname} for input parameter file", fontsize=11) + plt.legend(loc='upper left', title='PFT') + + if save_fig: + fig_name = os.path.join(plot_dir, f"allometry_plot_{var}.png") + plt.savefig(fig_name) + +def plot_total_biomass(data, save_fig, plot_dir): + """Plot two calculations of total biomass against each other + + Args: + data (xarray DataSet): the allometry dataset + """ + df = pd.DataFrame({'dbh': np.tile(data.dbh, len(data.pft)), + 'pft': np.repeat(data.pft, len(data.dbh)), + 'total_biomass_parts': data.total_biomass_parts.values.flatten(), + 'total_biomass_tissues': data.total_biomass_tissues.values.flatten()}) + + colors = get_color_pallete() + + plt.figure(figsize=(7, 5)) + ax = plt.subplot(111) + ax.spines["top"].set_visible(False) + ax.spines["bottom"].set_visible(False) + ax.spines["right"].set_visible(False) + ax.spines["left"].set_visible(False) + + ax.get_xaxis().tick_bottom() + ax.get_yaxis().tick_left() + + maxbiomass = np.maximum(df['total_biomass_parts'].max(), df['total_biomass_tissues'].max()) + + plt.xlim(0.0, maxbiomass) + plt.ylim(0.0, maxbiomass) + + plt.yticks(fontsize=10) + plt.xticks(fontsize=10) + plt.tick_params(bottom=False, top=False, left=False, right=False) + + pfts = np.unique(df.pft.values) + for rank, pft in enumerate(pfts): + data = df[df.pft == pft] + plt.scatter(data.total_biomass_parts.values, data.total_biomass_parts.values, + color=colors[rank], label=pft) + + plt.xlabel('Total biomass (kgC) from parts', fontsize=11) + plt.ylabel('Total biomass (kgC) from tissues', fontsize=11) + plt.title("Simulated total biomass for input parameter file", fontsize=11) + plt.legend(loc='upper left', title='PFT') + + if save_fig: + fig_name = os.path.join(plot_dir, "allometry_plot_total_biomass_compare.png") + plt.savefig(fig_name) + +def plot_allometry_dat(run_dir, out_file, save_figs, plot_dir): + + # read in allometry data + allometry_dat = xr.open_dataset(os.path.join(run_dir, out_file)) + + plot_dict = { + 'height': { + 'varname': 'height', + 'units': 'm', + }, + 'bagw': { + 'varname': 'aboveground biomass', + 'units': 'kgC', + }, + 'blmax': { + 'varname': 'maximum leaf biomass', + 'units': 'kgC', + }, + 'crown_area': { + 'varname': 'crown area', + 'units': 'm$^2$', + }, + 'sapwood_area': { + 'varname': 'sapwood area', + 'units': 'm$^2$', + }, + 'bsap': { + 'varname': 'sapwood biomass', + 'units': 'kgC', + }, + 'bbgw': { + 'varname': 'belowground biomass', + 'units': 'kgC', + }, + 'fineroot_biomass': { + 'varname': 'fineroot biomass', + 'units': 'kgC', + }, + 'bstore': { + 'varname': 'storage biomass', + 'units': 'kgC', + }, + 'bdead': { + 'varname': 'deadwood biomass', + 'units': 'kgC', + }, + 'total_biomass_parts': { + 'varname': 'total biomass (calculated from parts)', + 'units': 'kgC', + }, + 'total_biomass_tissues': { + 'varname': 'total biomass (calculated from tissues)', + 'units': 'kgC', + }, + + } + for plot in plot_dict: + plot_allometry_var(allometry_dat[plot], plot_dict[plot]['varname'], + plot_dict[plot]['units'], save_figs, plot_dir) + + plot_total_biomass(allometry_dat, save_figs, plot_dir) \ No newline at end of file diff --git a/functional_unit_testing/allometry/CMakeLists.txt b/functional_unit_testing/allometry/CMakeLists.txt index f43992847d..0a48161e49 100644 --- a/functional_unit_testing/allometry/CMakeLists.txt +++ b/functional_unit_testing/allometry/CMakeLists.txt @@ -16,13 +16,8 @@ link_directories(${NETCDF_C_DIR}/lib add_executable(FATES_allom_exe ${allom_sources}) target_link_libraries(FATES_allom_exe - netcdf + netcdf netcdff fates csm_share - funit) - -add_test(allom_test FATES_allom_exe) - -# Tell CTest how to figure out that "STOP 1" fails for the current -define_Fortran_stop_failure(allom_test) \ No newline at end of file + funit) \ No newline at end of file diff --git a/functional_unit_testing/allometry/FatesTestAllometry.F90 b/functional_unit_testing/allometry/FatesTestAllometry.F90 index 5f021d57ed..7ee85b7675 100644 --- a/functional_unit_testing/allometry/FatesTestAllometry.F90 +++ b/functional_unit_testing/allometry/FatesTestAllometry.F90 @@ -12,7 +12,6 @@ program FatesTestAllometry ! LOCALS: type(fates_unit_test_param_reader) :: param_reader ! param reader instance character(len=:), allocatable :: param_file ! input parameter file - character(len=*), parameter :: out_file = 'allometry_out.nc' ! output file integer :: numpft ! number of pfts (from parameter file) integer :: arglen ! length of command line argument integer :: i, j ! looping indices @@ -33,17 +32,18 @@ program FatesTestAllometry real(r8), allocatable :: total_biom_parts(:,:) ! total biomass calculated as bleaf + bfineroot + agbw + bgbw [kgC] ! CONSTANTS: - real(r8), parameter :: min_dbh = 0.5_r8 ! minimum DBH to calculate [cm] - real(r8), parameter :: max_dbh = 200.0_r8 ! maximum DBH to calculate [cm] - real(r8), parameter :: dbh_inc = 0.5_r8 ! DBHncrement to use [cm] - - integer, parameter :: crown_damage = 1 ! crown damage - real(r8), parameter :: elongation_factor = 1.0_r8 ! elongation factor for stem - real(r8), parameter :: elongation_factor_roots = 1.0_r8 ! elongation factor for roots - real(r8), parameter :: site_spread = 1.0_r8 ! site spread - real(r8), parameter :: canopy_trim = 1.0_r8 ! canopy trim - real(r8), parameter :: nplant = 1.0_r8 ! number of plants per cohort - real(r8), parameter :: leaf_to_fineroot = 1.0_r8 ! leaf to fineroot ratio + character(len=*), parameter :: out_file = 'allometry_out.nc' ! output file + real(r8), parameter :: min_dbh = 0.5_r8 ! minimum DBH to calculate [cm] + real(r8), parameter :: max_dbh = 200.0_r8 ! maximum DBH to calculate [cm] + real(r8), parameter :: dbh_inc = 0.5_r8 ! DBH increment to use [cm] + + integer, parameter :: crown_damage = 1 ! crown damage + real(r8), parameter :: elongation_factor = 1.0_r8 ! elongation factor for stem + real(r8), parameter :: elongation_factor_roots = 1.0_r8 ! elongation factor for roots + real(r8), parameter :: site_spread = 1.0_r8 ! site spread + real(r8), parameter :: canopy_trim = 1.0_r8 ! canopy trim + real(r8), parameter :: nplant = 1.0_r8 ! number of plants per cohort + real(r8), parameter :: leaf_to_fineroot = 1.0_r8 ! leaf to fineroot ratio interface @@ -66,9 +66,9 @@ subroutine WriteAllometryData(out_file, ndbh, numpft, dbh, height, bagw, blmax, real(r8), intent(in) :: crown_area(:, :) real(r8), intent(in) :: sapwood_area(:, :) real(r8), intent(in) :: bsap(:, :) - real(r8), intent(in) :: bbgw(:, :) - real(r8), intent(in) :: fineroot_biomass(:, :) - real(r8), intent(in) :: bstore(:, :) + real(r8), intent(in) :: bbgw(:, :) + real(r8), intent(in) :: fineroot_biomass(:, :) + real(r8), intent(in) :: bstore(:, :) real(r8), intent(in) :: bdead(:, :) real(r8), intent(in) :: total_biom_parts(:, :) real(r8), intent(in) :: total_biom_tissues(:, :) @@ -79,14 +79,14 @@ end subroutine WriteAllometryData ! get parameter file from command-line argument nargs = command_argument_count() if (nargs /= 1) then - write(*, '(a, i2, a)') "Incorrect number of arguments: ", nargs, ". Should be 1" + write(*, '(a, i2, a)') "Incorrect number of arguments: ", nargs, ". Should be 1." stop else call get_command_argument(1, length=arglen) allocate(character(arglen) :: param_file) call get_command_argument(1, value=param_file) endif - + ! read in parameter file call param_reader%Init(param_file) call param_reader%RetrieveParameters() @@ -94,7 +94,7 @@ end subroutine WriteAllometryData ! determine sizes of arrays numpft = size(prt_params%wood_density, dim=1) numdbh = int((max_dbh - min_dbh)/dbh_inc + 1) - + ! allocate arrays allocate(dbh(numdbh)) allocate(height(numdbh, numpft)) @@ -109,16 +109,12 @@ end subroutine WriteAllometryData allocate(bdead(numdbh, numpft)) allocate(total_biom_parts(numdbh, numpft)) allocate(total_biom_tissues(numdbh, numpft)) - + ! initialize dbh array do i = 1, numdbh dbh(i) = min_dbh + dbh_inc*(i-1) end do - ! total biomass = bleaf + bfineroot + agbw + bgbw - ! ... or ... - ! total biomass = bleaf + bfineroot + bdead + bsap - ! calculate allometries do i = 1, numpft do j = 1, numdbh @@ -142,7 +138,7 @@ end subroutine WriteAllometryData call WriteAllometryData(out_file, numdbh, numpft, dbh, height, bagw, blmax, crown_area, & sapwood_area, bsap, bbgw, fineroot_biomass, bstore, bdead, total_biom_parts, & total_biom_tissues) - + end program FatesTestAllometry ! ---------------------------------------------------------------------------------------- @@ -193,7 +189,7 @@ subroutine WriteAllometryData(out_file, numdbh, numpft, dbh, height, bagw, blmax integer :: bbgwID, finerootID integer :: bstoreID, bdeadID integer :: totbiomID1, totbiomID2 - + ! create pft indices allocate(pft_indices(numpft)) do i = 1, numpft @@ -222,73 +218,73 @@ subroutine WriteAllometryData(out_file, numdbh, numpft, dbh, height, bagw, blmax ! register height call RegisterVar2D(ncid, 'height', dimIDs(1:2), type_double, & [character(len=20) :: 'coordinates', 'units', 'long_name'], & - [character(len=150) :: 'pft dbh', 'm', 'plant height'], & + [character(len=150) :: 'pft dbh', 'm', 'plant height'], & 3, heightID) ! register aboveground biomass call RegisterVar2D(ncid, 'bagw', dimIDs(1:2), type_double, & [character(len=20) :: 'coordinates', 'units', 'long_name'], & - [character(len=150) :: 'pft dbh', 'kgC', 'plant aboveground woody biomass'], & + [character(len=150) :: 'pft dbh', 'kgC', 'plant aboveground woody biomass'], & 3, bagwID) ! register leaf biomass call RegisterVar2D(ncid, 'blmax', dimIDs(1:2), type_double, & [character(len=20) :: 'coordinates', 'units', 'long_name'], & - [character(len=150) :: 'pft dbh', 'kgC', 'plant maximum leaf biomass'], & + [character(len=150) :: 'pft dbh', 'kgC', 'plant maximum leaf biomass'], & 3, blmaxID) ! register crown area call RegisterVar2D(ncid, 'crown_area', dimIDs(1:2), type_double, & [character(len=20) :: 'coordinates', 'units', 'long_name'], & - [character(len=150) :: 'pft dbh', 'm2', 'plant crown area per cohort'], & + [character(len=150) :: 'pft dbh', 'm2', 'plant crown area per cohort'], & 3, c_areaID) ! register sapwood area call RegisterVar2D(ncid, 'sapwood_area', dimIDs(1:2), type_double, & [character(len=20) :: 'coordinates', 'units', 'long_name'], & - [character(len=150) :: 'pft dbh', 'm2', 'plant cross section area sapwood at reference height'], & + [character(len=150) :: 'pft dbh', 'm2', 'plant cross section area sapwood at reference height'], & 3, sapwoodareaID) - + ! register sapwood biomass call RegisterVar2D(ncid, 'bsap', dimIDs(1:2), type_double, & [character(len=20) :: 'coordinates', 'units', 'long_name'], & - [character(len=150) :: 'pft dbh', 'kgC', 'plant sapwood biomass'], & + [character(len=150) :: 'pft dbh', 'kgC', 'plant sapwood biomass'], & 3, bsapID) ! register belowground woody biomass call RegisterVar2D(ncid, 'bbgw', dimIDs(1:2), type_double, & [character(len=20) :: 'coordinates', 'units', 'long_name'], & - [character(len=150) :: 'pft dbh', 'kgC', 'plant belowground woody biomass'], & + [character(len=150) :: 'pft dbh', 'kgC', 'plant belowground woody biomass'], & 3, bbgwID) ! register fineroot biomass call RegisterVar2D(ncid, 'fineroot_biomass', dimIDs(1:2), type_double, & [character(len=20) :: 'coordinates', 'units', 'long_name'], & - [character(len=150) :: 'pft dbh', 'kgC', 'plant fineroot biomass'], & + [character(len=150) :: 'pft dbh', 'kgC', 'plant fineroot biomass'], & 3, finerootID) ! register storage biomass call RegisterVar2D(ncid, 'bstore', dimIDs(1:2), type_double, & [character(len=20) :: 'coordinates', 'units', 'long_name'], & - [character(len=150) :: 'pft dbh', 'kgC', 'plant storage biomass'], & + [character(len=150) :: 'pft dbh', 'kgC', 'plant storage biomass'], & 3, bstoreID) ! register structural biomass call RegisterVar2D(ncid, 'bdead', dimIDs(1:2), type_double, & [character(len=20) :: 'coordinates', 'units', 'long_name'], & - [character(len=150) :: 'pft dbh', 'kgC', 'plant deadwood (structural/heartwood) biomass'], & + [character(len=150) :: 'pft dbh', 'kgC', 'plant deadwood (structural/heartwood) biomass'], & 3, bdeadID) ! register total biomass (parts) call RegisterVar2D(ncid, 'total_biomass_parts', dimIDs(1:2), type_double, & [character(len=20) :: 'coordinates', 'units', 'long_name'], & - [character(len=150) :: 'pft dbh', 'kgC', 'plant total biomass calculated from parts'], & + [character(len=150) :: 'pft dbh', 'kgC', 'plant total biomass calculated from parts'], & 3, totbiomID1) ! register total biomass (tissues) call RegisterVar2D(ncid, 'total_biomass_tissues', dimIDs(1:2), type_double, & [character(len=20) :: 'coordinates', 'units', 'long_name'], & - [character(len=150) :: 'pft dbh', 'kgC', 'plant total biomass calculated from tissues'], & + [character(len=150) :: 'pft dbh', 'kgC', 'plant total biomass calculated from tissues'], & 3, totbiomID2) diff --git a/functional_unit_testing/build_fortran_tests.py b/functional_unit_testing/build_fortran_tests.py index 66556ac189..ef6d6577e9 100644 --- a/functional_unit_testing/build_fortran_tests.py +++ b/functional_unit_testing/build_fortran_tests.py @@ -28,13 +28,13 @@ def run_cmake(name, test_dir, pfunit_path, netcdf_c_path, netcdf_f_path, cmake_a """ if not os.path.isfile("CMakeCache.txt"): print(f"Running cmake for {name}.") - + # directory with cmake modules cmake_module_dir = os.path.abspath(os.path.join(_CIMEROOT, "CIME", "non_py", "src", "CMake")) - + # directory with genf90 genf90_dir = os.path.join(_CIMEROOT, "CIME", "non_py", "externals", "genf90") - + cmake_command = [ "cmake", "-C Macros.cmake", @@ -48,17 +48,16 @@ def run_cmake(name, test_dir, pfunit_path, netcdf_c_path, netcdf_f_path, cmake_a "-DENABLE_GENF90=ON", f"-DCMAKE_PROGRAM_PATH={genf90_dir}" ] - + if netcdf_c_path is not None: cmake_command.append(f"-DNETCDF_C_PATH={netcdf_c_path}") - + if netcdf_f_path is not None: cmake_command.append(f"-DNETCDF_F_PATH={netcdf_f_path}") - + cmake_command.extend(cmake_args.split(" ")) - - run_cmd_no_fail(" ".join(cmake_command), combine_output=True) + run_cmd_no_fail(" ".join(cmake_command), combine_output=True) def find_library(caseroot, cmake_args, lib_string): """Find the library installation we'll be using, and print its path @@ -79,10 +78,9 @@ def find_library(caseroot, cmake_args, lib_string): return value expect(False, f"{lib_string} not found for this machine and compiler") - + return None - - + def prep_build_dir(build_dir, clean): """Create (if necessary) build directory and clean contents (if asked to) @@ -90,36 +88,35 @@ def prep_build_dir(build_dir, clean): build_dir (str): build directory name clean (bool): whether or not to clean contents """ - + # create the build directory build_dir_path = os.path.abspath(build_dir) if not os.path.isdir(build_dir_path): os.mkdir(build_dir_path) - + # change into that directory os.chdir(build_dir_path) - + # clean up any files if we want to if clean: clean_cmake_files() - - return build_dir_path + return build_dir_path def clean_cmake_files(): """Deletes all files related to build - + """ if os.path.isfile("CMakeCache.txt"): os.remove("CMakeCache.txt") if os.path.isdir("CMakeFiles"): shutil.rmtree("CMakeFiles") - + cwd_contents = os.listdir(os.getcwd()) - + # Clear contents to do with cmake cache for file in cwd_contents: - if ( + if ( file in ("Macros.cmake", "env_mach_specific.xml") or file.startswith("Depends") or file.startswith(".env_mach_specific") @@ -134,13 +131,13 @@ def get_extra_cmake_args(build_dir, mpilib): """ # get the machine objects file machobj = Machines() - + # get compiler compiler = machobj.get_default_compiler() - + # get operating system os_ = machobj.get_value("OS") - + # Create the environment, and the Macros.cmake file # # @@ -156,10 +153,10 @@ def get_extra_cmake_args(build_dir, mpilib): unit_testing=True, ) machspecific = EnvMachSpecific(build_dir, unit_testing=True) - + # make a fake case fake_case = FakeCase(compiler, mpilib, True, "nuopc", threading=False) - + cmake_args = ( "{}-DOS={} -DMACH={} -DCOMPILER={} -DDEBUG={} -DMPILIB={} -Dcompile_threaded={} -DCASEROOT={}".format( "", @@ -172,9 +169,9 @@ def get_extra_cmake_args(build_dir, mpilib): build_dir ) ) - + return cmake_args - + def run_make(name, make_j, clean=False, verbose=False): """Run make in current working directory @@ -184,19 +181,40 @@ def run_make(name, make_j, clean=False, verbose=False): clean (bool, optional): whether or not to clean Defaults to False. verbose (bool, optional): verbose error logging for make Defaults to False. """ - + print(f"Running make for {name}.") - + if clean: run_cmd_no_fail("make clean") - + make_command = ["make", "-j", str(make_j)] - + if verbose: make_command.append("VERBOSE=1") - + run_cmd_no_fail(" ".join(make_command), combine_output=True) +def build_exists(build_dir, test_dir, test_exe=None): + """Checks to see if the build directory and associated executables exist. + + Args: + build_dir (str): build directory + test_dir (str): test directory + test_exe (str): test executable + """ + + build_path = os.path.abspath(build_dir) + if not os.path.isdir(build_path): + return False + + if not os.path.isdir(os.path.join(build_path, test_dir)): + return False + + if test_exe is not None: + if not os.path.isfile(os.path.join(build_path, test_dir, test_exe)): + return False + + return True def build_unit_tests(build_dir, name, cmake_directory, make_j, clean=False): """Build the unit test executables @@ -210,21 +228,21 @@ def build_unit_tests(build_dir, name, cmake_directory, make_j, clean=False): """ # create the build directory full_build_path = prep_build_dir(build_dir, clean=clean) - + # get cmake args and the pfunit and netcdf paths cmake_args = get_extra_cmake_args(full_build_path, "mpi-serial") pfunit_path = find_library(full_build_path, cmake_args, "PFUNIT_PATH") - + if not "NETCDF" in os.environ: netcdf_c_path = find_library(full_build_path, cmake_args, "NETCDF_C_PATH") netcdf_f_path = find_library(full_build_path, cmake_args, "NETCDF_FORTRAN_PATH") else: netcdf_c_path = None netcdf_f_path = None - + # change into the build dir os.chdir(full_build_path) - + # run cmake and make run_cmake(name, cmake_directory, pfunit_path, netcdf_c_path, netcdf_f_path, cmake_args) run_make(name, make_j, clean=clean) diff --git a/functional_unit_testing/math_utils/CMakeLists.txt b/functional_unit_testing/math_utils/CMakeLists.txt new file mode 100644 index 0000000000..e23eac3dcf --- /dev/null +++ b/functional_unit_testing/math_utils/CMakeLists.txt @@ -0,0 +1,10 @@ +set(math_sources FatesTestMathUtils.F90) + +link_directories(${PFUNIT_TOP_DIR}/lib) + +add_executable(FATES_math_exe ${math_sources}) + +target_link_libraries(FATES_math_exe + fates + csm_share + funit) \ No newline at end of file diff --git a/functional_unit_testing/math_utils/FatesTestMathUtils.F90 b/functional_unit_testing/math_utils/FatesTestMathUtils.F90 new file mode 100644 index 0000000000..f13b888d47 --- /dev/null +++ b/functional_unit_testing/math_utils/FatesTestMathUtils.F90 @@ -0,0 +1,138 @@ +program FatesTestQuadSolvers + + use FatesConstantsMod, only : r8 => fates_r8 + use FatesUtilsMod, only : QuadraticRootsNSWC, QuadraticRootsSridharachary + use FatesUtilsMod, only : GetNeighborDistance + + implicit none + + ! CONSTANTS: + integer, parameter :: n = 4 ! number of points to test + character(len=*), parameter :: out_file = 'quad_out.nc' ! output file + + + ! LOCALS: + integer :: i ! looping index + real(r8) :: a(n), b(n), c(n) ! coefficients for quadratic solvers + real(r8) :: root1(n) ! real part of first root of quadratic solver + real(r8) :: root2(n) ! real part of second root of quadratic solver + + interface + + subroutine WriteQuadData(out_file, n, a, b, c, root1, root2) + + use FatesUnitTestIOMod, only : OpenNCFile, RegisterNCDims, CloseNCFile + use FatesUnitTestIOMod, only : RegisterVar1D, WriteVar, RegisterVar2D + use FatesUnitTestIOMod, only : type_double, type_int + use FatesConstantsMod, only : r8 => fates_r8 + implicit none + + character(len=*), intent(in) :: out_file + integer, intent(in) :: n + real(r8), intent(in) :: a(:) + real(r8), intent(in) :: b(:) + real(r8), intent(in) :: c(:) + real(r8), intent(in) :: root1(:) + real(r8), intent(in) :: root2(:) + end subroutine WriteQuadData + + end interface + + a = (/1.0_r8, 1.0_r8, 5.0_r8, 1.5_r8/) + b = (/-2.0_r8, 7.0_r8, 10.0_r8, 3.2_r8/) + c = (/1.0_r8, 12.0_r8, 3.0_r8, 1.1_r8/) + + do i = 1, n + call QuadraticRootsNSWC(a(i), b(i), c(i), root1(i), root2(i)) + end do + + call WriteQuadData(out_file, n, a, b, c, root1, root2) + +end program FatesTestQuadSolvers + +! ---------------------------------------------------------------------------------------- + +subroutine WriteQuadData(out_file, n, a, b, c, root1, root2) + ! + ! DESCRIPTION: + ! Writes out data from the quadratic solver test + ! + use FatesConstantsMod, only : r8 => fates_r8 + use FatesUnitTestIOMod, only : OpenNCFile, RegisterNCDims, CloseNCFile + use FatesUnitTestIOMod, only : RegisterVar1D, WriteVar, RegisterVar2D + use FatesUnitTestIOMod, only : EndNCDef + use FatesUnitTestIOMod, only : type_double, type_int + + implicit none + + ! ARGUMENTS: + character(len=*), intent(in) :: out_file ! output file name + integer, intent(in) :: n ! number of points to write out + real(r8), intent(in) :: a(:) ! coefficient a + real(r8), intent(in) :: b(:) ! coefficient b + real(r8), intent(in) :: c(:) ! coefficient c + real(r8), intent(in) :: root1(:) ! root1 from quadratic solver + real(r8), intent(in) :: root2(:) ! root2 from quadratic solver + + ! LOCALS: + integer :: n_index(n) ! array of pft indices to write out + integer :: i ! looping index + integer :: ncid ! netcdf file id + character(len=8) :: dim_names(1) ! dimension names + integer :: dimIDs(1) ! dimension IDs + integer :: aID, bID, cID + integer :: root1ID, root2ID + + ! make index + do i = 1, n + n_index(i) = i + end do + + ! dimension names + dim_names = [character(len=12) :: 'n'] + + ! open file + call OpenNCFile(trim(out_file), ncid, 'readwrite') + + ! register dimensions + call RegisterNCDims(ncid, dim_names, (/n/), 1, dimIDs) + + ! register a + call RegisterVar1D(ncid, 'a', dimIDs(1), type_double, & + [character(len=20) :: 'units', 'long_name'], & + [character(len=150) :: '', 'coefficient a'], 2, aID) + + ! register b + call RegisterVar1D(ncid, 'b', dimIDs(1), type_double, & + [character(len=20) :: 'units', 'long_name'], & + [character(len=150) :: '', 'coefficient b'], 2, bID) + + ! register c + call RegisterVar1D(ncid, 'c', dimIDs(1), type_double, & + [character(len=20) :: 'units', 'long_name'], & + [character(len=150) :: '', 'coefficient c'], 2, cID) + + ! register root1 + call RegisterVar1D(ncid, 'root1', dimIDs(1), type_double, & + [character(len=20) :: 'units', 'long_name'], & + [character(len=150) :: '', 'root 1'], 2, root1ID) + + ! register root2 + call RegisterVar1D(ncid, 'root2', dimIDs(1), type_double, & + [character(len=20) :: 'units', 'long_name'], & + [character(len=150) :: '', 'root 2'], 2, root2ID) + + ! finish defining variables + call EndNCDef(ncid) + + ! write out data + call WriteVar(ncid, aID, a(:)) + call WriteVar(ncid, bID, b(:)) + call WriteVar(ncid, cID, c(:)) + call WriteVar(ncid, root1ID, root1(:)) + call WriteVar(ncid, root2ID, root2(:)) + + ! close the file + call CloseNCFile(ncid) + +end subroutine WriteQuadData diff --git a/functional_unit_testing/math_utils/MathUtils.py b/functional_unit_testing/math_utils/MathUtils.py new file mode 100644 index 0000000000..63c68ae820 --- /dev/null +++ b/functional_unit_testing/math_utils/MathUtils.py @@ -0,0 +1,34 @@ +"""Utility functions for allometry functional unit tests +""" +import os +import math +import xarray as xr +import pandas as pd +import numpy as np +import matplotlib +import matplotlib.pyplot as plt + +from utils import get_color_pallete + +def plot_quadratic_dat(run_dir, out_file, save_figs, plot_dir): + + # read in quadratic data + quadratic_dat = xr.open_dataset(os.path.join(run_dir, out_file)) + + # plot output + PlotQuadAndRoots(quadratic_dat.a.values, quadratic_dat.b.values, + quadratic_dat.c.values, quadratic_dat.root1.values, + quadratic_dat.root2.values) + +def PlotQuadAndRoots(a, b, c, r1, r2): + + colors = get_color_pallete() + + fig, axs = plt.subplots(ncols=1, nrows=1, figsize=(8,8)) + x = np.linspace(-10.0, 10.0, num=20) + + for i in range(0, len(a)): + y = a[i]*x**2 + b[i]*x + c[i] + plt.plot(x, y, lw=2, color=colors[i]) + plt.scatter(r1[i], r2[i], color=colors[i], s=50) + plt.axhline(y=0.0, color='k', linestyle='dotted') diff --git a/functional_unit_testing/math_utils/MathUtilsDriver.py b/functional_unit_testing/math_utils/MathUtilsDriver.py deleted file mode 100644 index 4add288126..0000000000 --- a/functional_unit_testing/math_utils/MathUtilsDriver.py +++ /dev/null @@ -1,172 +0,0 @@ -# ======================================================================================= -# -# For usage: $python HydroUTestDriver.py --help -# -# This script runs unit tests on the hydraulics functions. -# -# -# ======================================================================================= - -import matplotlib as mpl -#mpl.use('Agg') -import matplotlib.pyplot as plt -from datetime import datetime -import argparse -#from matplotlib.backends.backend_pdf import PdfPages -import platform -import numpy as np -import os -import sys -import getopt -import code # For development: code.interact(local=dict(globals(), **locals())) -import time -import imp -import ctypes -from ctypes import * -from operator import add - - -#CDLParse = imp.load_source('CDLParse','../shared/py_src/CDLParse.py') -#F90ParamParse = imp.load_source('F90ParamParse','../shared/py_src/F90ParamParse.py') -PyF90Utils = imp.load_source('PyF90Utils','../shared/py_src/PyF90Utils.py') - - -#from CDLParse import CDLParseDims, CDLParseParam, cdl_param_type -#from F90ParamParse import f90_param_type, GetSymbolUsage, GetPFTParmFileSymbols, MakeListUnique - -from PyF90Utils import c8, ci, cchar, c8_arr, ci_arr - -# Load the fortran objects via CTYPES - -f90_unitwrap_obj = ctypes.CDLL('bld/UnitWrapMod.o',mode=ctypes.RTLD_GLOBAL) -f90_constants_obj = ctypes.CDLL('bld/FatesConstantsMod.o',mode=ctypes.RTLD_GLOBAL) -f90_fatesutils_obj = ctypes.CDLL('bld/FatesUtilsMod.o',mode=ctypes.RTLD_GLOBAL) - -# Alias the F90 functions, specify the return type -# ----------------------------------------------------------------------------------- - -neighbor_dist = f90_fatesutils_obj.__fatesutilsmod_MOD_getneighbordistance -#quadratic_f = f90_fatesutils_obj.__fatesutilsmod_MOD_quadratic_f -quadratic_roots = f90_fatesutils_obj.__fatesutilsmod_MOD_quadraticroots -quadratic_sroots = f90_fatesutils_obj.__fatesutilsmod_MOD_quadraticrootssridharachary - -# Some constants -rwcft = [1.0,0.958,0.958,0.958] -rwccap = [1.0,0.947,0.947,0.947] -pm_leaf = 1 -pm_stem = 2 -pm_troot = 3 -pm_aroot = 4 -pm_rhiz = 5 - -# These parameters are matched with the indices in FATES-HYDRO -vg_type = 1 -cch_type = 2 -tfs_type = 3 - -isoil1 = 0 # Top soil layer parameters (@BCI) -isoil2 = 1 # Bottom soil layer parameters - -# Constants for rhizosphere -watsat = [0.567, 0.444] -sucsat = [159.659, 256.094] -bsw = [6.408, 9.27] - -unconstrained = True - - -# ======================================================================================== -# ======================================================================================== -# Main -# ======================================================================================== -# ======================================================================================== - -def main(argv): - - # First check to make sure python 2.7 is being used - version = platform.python_version() - verlist = version.split('.') - - #if( not ((verlist[0] == '2') & (verlist[1] == '7') & (int(verlist[2])>=15) ) ): - # print("The PARTEH driver mus be run with python 2.7") - # print(" with tertiary version >=15.") - # print(" your version is {}".format(version)) - # print(" exiting...") - # sys.exit(2) - - # Read in the arguments - # ======================================================================================= - - # parser = argparse.ArgumentParser(description='Parse command line arguments to this script.') - # parser.add_argument('--cdl-file', dest='cdlfile', type=str, \ - # help="Input CDL filename. Required.", required=True) - # args = parser.parse_args() - - # Set number of analysis points - - # y = ax2 + bx + c - - a = [1,1,5,1.5] - b = [-2,7,10,3.2] - c = [1,12,3,1.1] - - cd_r1 = c_double(-9.0) - cd_r2 = c_double(-9.0) - - r1 = np.zeros([3,1]) - r2 = np.zeros([3,1]) - - for ic in range(len(a)): - - #iret = quadratic_f(c8(a[ic]),c8(b[ic]),c8(c[ic]),byref(cd_r1),byref(cd_r2)) - #r1[0] = cd_r1.value - #r2[0] = cd_r2.value - - iret = quadratic_roots(c8(a[ic]),c8(b[ic]),c8(c[ic]),byref(cd_r1),byref(cd_r2)) - r1[1] = cd_r1.value - r2[1] = cd_r2.value - - iret = quadratic_sroots(c8(a[ic]),c8(b[ic]),c8(c[ic]),byref(cd_r1),byref(cd_r2)) - r1[2] = cd_r2.value - r2[2] = cd_r1.value - - print(a[ic],b[ic],c[ic]) - print(r1) - print(r2) - - #PlotQuadAndRoots(a[ic],b[ic],c[ic],r1,r2) - - -def PlotQuadAndRoots(a,b,c,d,r1,r2): - - fig, axs = plt.subplots(ncols=1,nrows=1,figsize=(8,8)) - ax1s = axs.reshape(-1) - ic=0 - - npts = 1000 - - for i in range(npts): - print(i) - - - -# code.interact(local=dict(globals(), **locals())) - -# Helper code to plot negative logs - -def semilogneg(x): - - y = np.sign(x)*np.log(abs(x)) - return(y) - -def semilog10net(x): - - y = np.sign(x)*np.log10(abs(x)) - return(y) - - -# ======================================================================================= -# This is the actual call to main - -if __name__ == "__main__": - main(sys.argv) diff --git a/functional_unit_testing/math_utils/bld/README b/functional_unit_testing/math_utils/bld/README deleted file mode 100644 index 4e67e5f091..0000000000 --- a/functional_unit_testing/math_utils/bld/README +++ /dev/null @@ -1 +0,0 @@ -PLACEHOLDER FOR DIR \ No newline at end of file diff --git a/functional_unit_testing/math_utils/build_math_objects.sh b/functional_unit_testing/math_utils/build_math_objects.sh deleted file mode 100755 index 40ac3eb9d1..0000000000 --- a/functional_unit_testing/math_utils/build_math_objects.sh +++ /dev/null @@ -1,47 +0,0 @@ -#!/bin/bash - -# Path to FATES src - -FC='gfortran' - -F_OPTS="-shared -fPIC -g -ffpe-trap=zero,overflow,underflow -fbacktrace -fbounds-check" -#F_OPTS="-shared -fPIC -O" - - -MOD_FLAG="-J" - -rm -f bld/*.o -rm -f bld/*.mod - - -# First copy over the FatesConstants file, but change the types of the fates_r8 and fates_int - -old_fates_r8_str=`grep -e integer ../../main/FatesConstantsMod.F90 | grep fates_r8 | sed 's/^[ \t]*//;s/[ \t]*$//'` -new_fates_r8_str='use iso_c_binding, only: fates_r8 => c_double' - -old_fates_int_str=`grep -e integer ../../main/FatesConstantsMod.F90 | grep fates_int | sed 's/^[ \t]*//;s/[ \t]*$//'` -new_fates_int_str='use iso_c_binding, only: fates_int => c_int' - -# Add the new lines (need position change, don't swap) - -sed "/implicit none/i $new_fates_r8_str" ../../main/FatesConstantsMod.F90 > f90_src/FatesConstantsMod.F90 -sed -i "/implicit none/i $new_fates_int_str" f90_src/FatesConstantsMod.F90 -sed -i "/private /i public :: fates_r8" f90_src/FatesConstantsMod.F90 -sed -i "/private /i public :: fates_int" f90_src/FatesConstantsMod.F90 - -# Delete the old lines - -sed -i "/$old_fates_r8_str/d" f90_src/FatesConstantsMod.F90 -sed -i "/$old_fates_int_str/d" f90_src/FatesConstantsMod.F90 - -# Build the new file with constants - -${FC} ${F_OPTS} -I bld/ ${MOD_FLAG} bld/ -o bld/FatesConstantsMod.o f90_src/FatesConstantsMod.F90 - -${FC} ${F_OPTS} -I bld/ ${MOD_FLAG} bld/ -o bld/UnitWrapMod.o f90_src/UnitWrapMod.F90 - -${FC} ${F_OPTS} -I bld/ ${MOD_FLAG} bld/ -o bld/FatesUtilsMod.o ../../main/FatesUtilsMod.F90 - - - - diff --git a/functional_unit_testing/math_utils/f90_src/UnitWrapMod.F90 b/functional_unit_testing/math_utils/f90_src/UnitWrapMod.F90 deleted file mode 100644 index f12311655a..0000000000 --- a/functional_unit_testing/math_utils/f90_src/UnitWrapMod.F90 +++ /dev/null @@ -1,49 +0,0 @@ - -! ======================================================================================= -! -! This file is an alternative to key files in the fates -! filesystem. Noteably, we replace fates_r8 and fates_in -! with types that work with "ctypes". This is -! a key step in working with python -! -! We also wrap FatesGlobals to reduce the dependancy -! cascade that it pulls in from shr_log_mod. -! -! ======================================================================================= - -module shr_log_mod - - use iso_c_binding, only : c_char - use iso_c_binding, only : c_int - - contains - - function shr_log_errMsg(source, line) result(ans) - character(kind=c_char,len=*), intent(in) :: source - integer(c_int), intent(in) :: line - character(kind=c_char,len=128) :: ans - - ans = "source: " // trim(source) // " line: " - end function shr_log_errMsg - -end module shr_log_mod - - -module FatesGlobals - - contains - - integer function fates_log() - fates_log = -1 - end function fates_log - - subroutine fates_endrun(msg) - - implicit none - character(len=*), intent(in) :: msg ! string to be printed - - stop - - end subroutine fates_endrun - -end module FatesGlobals diff --git a/functional_unit_testing/path_utils.py b/functional_unit_testing/path_utils.py new file mode 100644 index 0000000000..85aea6085a --- /dev/null +++ b/functional_unit_testing/path_utils.py @@ -0,0 +1,51 @@ +"""Utility functions related to getting paths to various important places +""" + +import os +import sys + +# Path to the root directory of FATES, based on the path of this file +# Note: It's important that this NOT end with a trailing slash; +_FATES_ROOT = os.path.normpath( + os.path.join(os.path.dirname(os.path.abspath(__file__)), os.pardir) +) + +def path_to_fates_root(): + """Returns the path to the root directory of FATES""" + return _FATES_ROOT + +def path_to_cime(): + """Returns the path to cime, if it can be found + + Raises a RuntimeError if it cannot be found + + """ + cime_path = os.path.join(path_to_fates_root(), "../../cime") + if os.path.isdir(cime_path): + return cime_path + raise RuntimeError("Cannot find cime.") + +def prepend_to_python_path(path): + """Adds the given path to python's sys.path if it isn't already in the path + + The path is added near the beginning, so that it takes precedence over existing + entries in the path + """ + if not path in sys.path: + # Insert at location 1 rather than 0, because 0 is special + sys.path.insert(1, path) + +def add_cime_lib_to_path(): + """Adds the CIME python library to the python path, to allow importing + modules from that library + + Returns the path to the top-level cime directory + + For documentation on standalone_only: See documentation in + path_to_cime + """ + cime_path = path_to_cime() + prepend_to_python_path(cime_path) + cime_lib_path = os.path.join(cime_path, "CIME", "Tools") + prepend_to_python_path(cime_lib_path) + return cime_path diff --git a/functional_unit_testing/run_fates_tests.py b/functional_unit_testing/run_fates_tests.py index 3ab6be6941..ed3e64b1bf 100755 --- a/functional_unit_testing/run_fates_tests.py +++ b/functional_unit_testing/run_fates_tests.py @@ -14,7 +14,7 @@ so you should still get these repositories as you normally would (i.e., manage_externals, etc.) Additionally, this requires netcdf and netcdff as well as a fortran compiler. - + You must also have a .cime folder in your home directory which specifies machine configurations for CIME. @@ -22,203 +22,51 @@ relevant output from those tests. You can supply your own parameter file (either a .cdl or a .nc file), or if you do not -specify anything, the sript will use the default FATES parameter cdl file. +specify anything, the script will use the default FATES parameter cdl file. """ - import os -import math import argparse - -from build_fortran_tests import build_unit_tests -import pandas as pd -import numpy as np -import xarray as xr import matplotlib import matplotlib.pyplot as plt +from build_fortran_tests import build_unit_tests, build_exists +from path_utils import add_cime_lib_to_path +from utils import round_up, copy_file, create_nc_file +from allometry.AllometryUtils import plot_allometry_dat +from math_utils.MathUtils import plot_quadratic_dat -from utils import add_cime_lib_to_path, round_up add_cime_lib_to_path() from CIME.utils import run_cmd_no_fail +# Constants for this script DEFAULT_CDL_PATH = os.path.abspath("../parameter_files/fates_params_default.cdl") CMAKE_BASE_DIR = os.path.join(os.path.dirname(os.path.abspath(__file__)), "../") NAME = "fates_unit_tests" -# Constants for now -## TODO update this to be some kind of dictionary we can loop through -out_file = "allometry_out.nc" -test_dir = "fates_allom_test" -test_exe = "FATES_allom_exe" - -def get_color_pallete(): - """Generate a color pallete - - Returns: - real: array of colors to use in plotting - """ - - colors = [(31, 119, 180), (174, 199, 232), (255, 127, 14), (255, 187, 120), - (44, 160, 44), (152, 223, 138), (214, 39, 40), (255, 152, 150), - (148, 103, 189), (197, 176, 213), (140, 86, 75), (196, 156, 148), - (227, 119, 194), (247, 182, 210), (127, 127, 127), (199, 199, 199), - (188, 189, 34), (219, 219, 141), (23, 190, 207), (158, 218, 229)] - - for i in range(len(colors)): - r, g, b = colors[i] - colors[i] = (r/255., g/255., b/255.) - - return colors - - -def plot_allometry_var(data, var, varname, units, save_fig, plot_dir=None): - """Plot an allometry variable - - Args: - data (xarray DataArray): the data array of the variable to plot - var (str): variable name (for data structure) - varname (str): variable name for plot labels - units (str): variable units for plot labels - save_fig (bool): whether or not to write out plot - plot_dir (str): if saving figure, where to write to - """ - df = pd.DataFrame({'dbh': np.tile(data.dbh, len(data.pft)), - 'pft': np.repeat(data.pft, len(data.dbh)), - var: data.values.flatten()}) - - maxdbh = df['dbh'].max() - maxvar = round_up(df[var].max()) - - colors = get_color_pallete() - - plt.figure(figsize=(7, 5)) - ax = plt.subplot(111) - ax.spines["top"].set_visible(False) - ax.spines["bottom"].set_visible(False) - ax.spines["right"].set_visible(False) - ax.spines["left"].set_visible(False) - - ax.get_xaxis().tick_bottom() - ax.get_yaxis().tick_left() - - plt.xlim(0.0, maxdbh) - plt.ylim(0.0, maxvar) - - plt.yticks(fontsize=10) - plt.xticks(fontsize=10) - - inc = (int(maxvar) - 0)/20 - for i in range(0, 20): - y = 0.0 + i*inc - plt.plot(range(math.floor(0), math.ceil(maxdbh)), - [y] * len(range(math.floor(0), math.ceil(maxdbh))), - "--", lw=0.5, color="black", alpha=0.3) - - plt.tick_params(bottom=False, top=False, left=False, right=False) - - pfts = np.unique(df.pft.values) - for rank, pft in enumerate(pfts): - data = df[df.pft == pft] - plt.plot(data.dbh.values, data[var].values, lw=2, color=colors[rank], - label=pft) - - plt.xlabel('DBH (cm)', fontsize=11) - plt.ylabel(f'{varname} ({units})', fontsize=11) - plt.title(f"Simulated {varname} for input parameter file", fontsize=11) - plt.legend(loc='upper left', title='PFT') - - if save_fig: - fig_name = os.path.join(plot_dir, f"allometry_plot_{var}.png") - plt.savefig(fig_name) - - -def plot_total_biomass(data, save_fig, plot_dir): - """Plot two calculations of total biomass against each other - - Args: - data (xarray DataSet): the allometry dataset - """ - df = pd.DataFrame({'dbh': np.tile(data.dbh, len(data.pft)), - 'pft': np.repeat(data.pft, len(data.dbh)), - 'total_biomass_parts': data.total_biomass_parts.values.flatten(), - 'total_biomass_tissues': data.total_biomass_tissues.values.flatten()}) - - colors = get_color_pallete() - - plt.figure(figsize=(7, 5)) - ax = plt.subplot(111) - ax.spines["top"].set_visible(False) - ax.spines["bottom"].set_visible(False) - ax.spines["right"].set_visible(False) - ax.spines["left"].set_visible(False) - - ax.get_xaxis().tick_bottom() - ax.get_yaxis().tick_left() - - maxbiomass = np.maximum(df['total_biomass_parts'].max(), df['total_biomass_tissues'].max()) - - plt.xlim(0.0, maxbiomass) - plt.ylim(0.0, maxbiomass) - - plt.yticks(fontsize=10) - plt.xticks(fontsize=10) - plt.tick_params(bottom=False, top=False, left=False, right=False) - - pfts = np.unique(df.pft.values) - for rank, pft in enumerate(pfts): - data = df[df.pft == pft] - plt.scatter(data.total_biomass_parts.values, data.total_biomass_parts.values, - color=colors[rank], label=pft) - - plt.xlabel('Total biomass (kgC) from parts', fontsize=11) - plt.ylabel('Total biomass (kgC) from tissues', fontsize=11) - plt.title("Simulated total biomass for input parameter file", fontsize=11) - plt.legend(loc='upper left', title='PFT') - - if save_fig: - fig_name = os.path.join(plot_dir, "allometry_plot_total_biomass_compare.png") - plt.savefig(fig_name) - -def create_nc_file(cdl_path, run_dir): - """Creates a netcdf file from a cdl file - - Args: - cdl_path (str): full path to desired cdl file - run_dir (str): where the file should be written to - """ - file_basename = os.path.basename(cdl_path).split(".")[-2] - file_nc_name = f"{file_basename}.nc" - - file_gen_command = [ - "ncgen -o", - os.path.join(run_dir, file_nc_name), - cdl_path - ] - out = run_cmd_no_fail(" ".join(file_gen_command), combine_output=True) - print(out) - - return file_nc_name - -def copy_file(file_path, dir): - """Copies a file file to a desired directory +# Dictionary with needed constants for running the executables and reading in the +# output files - developers who add tests should add things here. +test_dict = { + "allometry": { + "test_dir": "fates_allom_test", + "test_exe": "FATES_allom_exe", + "out_file": "allometry_out.nc", + "unit_test": False, + "use_param_file": True, + "other_args": [], + "plotting_function": plot_allometry_dat, + }, + "quadratic": { + "test_dir": "fates_math_test", + "test_exe": "FATES_math_exe", + "out_file": "quad_out.nc", + "unit_test": False, + "use_param_file": False, + "other_args": [], + "plotting_function": plot_quadratic_dat, + } + } - Args: - file_path (str): full path to file - dir (str): where the file should be copied to - """ - file_basename = os.path.basename(file_path) - - file_copy_command = [ - "cp", - os.path.abspath(file_path), - os.path.abspath(dir) - ] - run_cmd_no_fail(" ".join(file_copy_command), combine_output=True) - - return file_basename - - def run_exectuables(build_dir, test_dir, test_exe, run_dir, args): """Run the generated executables @@ -229,23 +77,52 @@ def run_exectuables(build_dir, test_dir, test_exe, run_dir, args): test_exe (str): test executable to run args ([str]): arguments for executable """ - + # move executable to run directory exe_path = os.path.join(build_dir, test_dir, test_exe) copy_file(exe_path, run_dir) - + # run the executable new_exe_path = os.path.join(run_dir, test_exe) run_command = [new_exe_path] run_command.extend(args) - + os.chdir(run_dir) print("Running exectuables") out = run_cmd_no_fail(" ".join(run_command), combine_output=True) print(out) - -def run_tests(clean, build, run, build_dir, run_dir, make_j, param_file, save_figs): +def make_plotdirs(run_dir, test_list): + # make main plot directory + plot_dir = os.path.join(run_dir, 'plots') + if not os.path.isdir(plot_dir): + os.mkdir(plot_dir) + + # make sub-plot directories + for test in test_list: + if test_dict[test]['plotting_function'] is not None: + sub_dir = os.path.join(plot_dir, test) + if not os.path.isdir(sub_dir): + os.mkdir(sub_dir) + +def create_param_file(param_file, run_dir): + if param_file is None: + print("Using default parameter file.") + param_file = DEFAULT_CDL_PATH + param_file_update = create_nc_file(param_file, run_dir) + else: + print(f"Using parameter file {param_file}.") + file_suffix = os.path.basename(param_file).split(".")[-1] + if file_suffix == 'cdl': + param_file_update = create_nc_file(param_file, run_dir) + elif file_suffix == "nc": + param_file_update = copy_file(param_file, run_dir) + else: + raise RuntimeError("Must supply parameter file with .cdl or .nc ending.") + + return param_file_update + +def run_tests(clean, build, run, build_dir, run_dir, make_j, param_file, save_figs, test_list): """Builds and runs the fates tests Args: @@ -261,62 +138,49 @@ def run_tests(clean, build, run, build_dir, run_dir, make_j, param_file, save_fi Raises: RuntimeError: Parameter file is not the correct file type """ - + # absolute path to desired build directory build_dir_path = os.path.abspath(build_dir) - + # absolute path to desired run directory run_dir_path = os.path.abspath(run_dir) - + + # make run directory if it doesn't already exist if not os.path.isdir(run_dir_path): os.mkdir(run_dir_path) - + + # create plot directories if we need to if save_figs: - plot_dir = os.path.join(run_dir_path, 'plots') - if not os.path.isdir(plot_dir): - os.mkdir(plot_dir) - else: - plot_dir = None - - if param_file is None: - print("Using default parameter file.") - param_file = DEFAULT_CDL_PATH - param_file = create_nc_file(param_file, run_dir_path) - else: - print(f"Using parameter file {param_file}.") - file_suffix = os.path.basename(param_file).split(".")[-1] - if file_suffix == 'cdl': - param_file = create_nc_file(param_file, run_dir_path) - elif file_suffix == "nc": - param_file = copy_file(param_file, run_dir_path) - else: - raise RuntimeError("Must supply file with .cdl or .nc ending.") + make_plotdirs(os.path.abspath(run_dir), test_list) + + # move parameter file to correct location (creates nc file if cdl supplied) + param_file = create_param_file(param_file, run_dir) if build: build_unit_tests(build_dir, NAME, CMAKE_BASE_DIR, make_j, clean=clean) - + if run: - run_exectuables(build_dir_path, test_dir, test_exe, run_dir_path, [param_file]) - - # read in allometry data - allometry_dat = xr.open_dataset(os.path.join(run_dir_path, out_file)) - - # plot allometry data - plot_allometry_var(allometry_dat.height, 'height', 'height', 'm', save_figs, plot_dir) - plot_allometry_var(allometry_dat.bagw, 'bagw', 'aboveground biomass', 'kgC', save_figs, plot_dir) - plot_allometry_var(allometry_dat.blmax, 'blmax', 'maximum leaf biomass', 'kgC', save_figs, plot_dir) - plot_allometry_var(allometry_dat.crown_area, 'crown_area', 'crown area', 'm$^2$', save_figs, plot_dir) - plot_allometry_var(allometry_dat.sapwood_area, 'sapwood_area', 'sapwood area', 'm$^2$', save_figs, plot_dir) - plot_allometry_var(allometry_dat.bsap, 'bsap', 'sapwood biomass', 'kgC', save_figs, plot_dir) - plot_allometry_var(allometry_dat.bbgw, 'bbgw', 'belowground biomass', 'kgC', save_figs, plot_dir) - plot_allometry_var(allometry_dat.fineroot_biomass, 'fineroot_biomass', 'fineroot biomass', 'kgC', save_figs, plot_dir) - plot_allometry_var(allometry_dat.bstore, 'bstore', 'storage biomass', 'kgC', save_figs, plot_dir) - plot_allometry_var(allometry_dat.bdead, 'bdead', 'deadwood biomass', 'kgC', save_figs, plot_dir) - plot_allometry_var(allometry_dat.total_biomass_parts, 'total_biomass_parts', 'total biomass (calculated from parts)', 'kgC', save_figs, plot_dir) - plot_allometry_var(allometry_dat.total_biomass_tissues, 'total_biomass_tissues', 'total biomass (calculated from tissues)', 'kgC', save_figs, plot_dir) - plot_total_biomass(allometry_dat, save_figs, plot_dir) + for test in test_list: + if not test_dict[test]['unit_test']: + args = test_dict[test]['other_args'] + if test_dict[test]['use_param_file']: + args.insert(0, param_file) + run_exectuables(build_dir_path, test_dict[test]['test_dir'], + test_dict[test]['test_exe'], run_dir_path, args) + + # plot output + for test in test_list: + if test_dict[test]['plotting_function'] is not None: + test_dict[test]['plotting_function'](run_dir_path, + test_dict[test]['out_file'], save_figs, + os.path.join(run_dir_path, 'plots', test)) plt.show() +def out_file_exists(run_dir, out_file): + + if not os.path.isfile(os.path.join(run_dir, out_file)): + return False + return True def commandline_args(): """Parse and return command-line arguments""" @@ -327,13 +191,13 @@ def commandline_args(): Typical usage: ./run_fates_tests -f parameter_file.nc - + """ - + parser = argparse.ArgumentParser( description=description, formatter_class=argparse.RawTextHelpFormatter ) - + parser.add_argument( "-f", "--parameter-file", @@ -343,7 +207,7 @@ def commandline_args(): "If no file is specified the script will use the default .cdl file in the\n" "parameter_files directory.\n", ) - + parser.add_argument( "-b", "--build-dir", @@ -351,7 +215,7 @@ def commandline_args(): help="Directory where tests are built.\n" "Will be created if it does not exist.\n", ) - + parser.add_argument( "-r", "--run-dir", @@ -359,22 +223,22 @@ def commandline_args(): help="Directory where tests are run.\n" "Will be created if it does not exist.\n", ) - + parser.add_argument( "--make-j", type=int, default=8, help="Number of processes to use for build.", ) - + parser.add_argument( "-c", "--clean", action="store_true", - help="Clean build directory before building.\n" + help="Clean build directory before building.\n" "Removes CMake cache and runs 'make clean'.\n", ) - + parser.add_argument( "--skip-build", action="store_true", @@ -382,7 +246,7 @@ def commandline_args(): "Only do this if you already have run build.\n" "Script will check to make sure executables are present.\n", ) - + parser.add_argument( "--skip-run", action="store_true", @@ -390,7 +254,7 @@ def commandline_args(): "Only do this if you already have run the code previously.\n" "Script will check to make sure required output files are present.\n", ) - + parser.add_argument( "--save-figs", action="store_true", @@ -398,45 +262,19 @@ def commandline_args(): "Will be placed in run_dir/plots.\n" "Should probably do this on remote machines.\n", ) - - args = parser.parse_args() - - check_arg_validity(args) - - return args + parser.add_argument( + "-t", + "--test", + help="Test(s) to run. Comma-separated list of test names, or 'all'\n" + "for all tests. If not supplied, will run all tests." + ) -def check_build_exists(build_dir): - """Checks to see if the build directory and associated executables exist. - - Args: - build_dir (str): build directory - """ - - build_path = os.path.abspath(build_dir) - if not os.path.isdir(build_path): - return False - - exe_path = os.path.join(build_path, test_dir, test_exe) - if not os.path.isfile(exe_path): - return False - - return True + args = parser.parse_args() + test_list = check_arg_validity(args) -def check_out_file_exists(out_file): - """Checks to see if the required output files exist. - - Args: - out_file (str): required output file - """ - - full_path = os.path.abspath(out_file) - if not os.path.isfile(full_path): - return False - - return True - + return args, test_list def check_arg_validity(args): """Checks validity of input script arguments @@ -445,32 +283,63 @@ def check_arg_validity(args): args (parse_args): input arguments Raises: - RuntimeError: Can't find input parameter file - RuntimeError: Can't find build directory or required executables + IOError: Can't find input parameter file, or parameter file is not correct form + RuntimeError: Invalid test name or test list + RuntimeError: Can't find required build directories or executables RuntimeError: Can't find required output files for plotting """ + # check to make sure parameter file exists and is one of the correct forms if args.parameter_file is not None: if not os.path.isfile(args.parameter_file): - raise RuntimeError(f"Cannot find file {args.parameter_file}.") + raise IOError(f"Cannot find file {args.parameter_file}.") + else: + file_suffix = os.path.basename(args.parameter_file).split(".")[-1] + if not file_suffix in ['cdl', 'nc']: + raise IOError("Must supply parameter file with .cdl or .nc ending.") + + # check test names + valid_test_names = test_dict.keys() + if args.test is not None: + test_list = args.test.split(',') + for test in test_list: + if test not in valid_test_names: + raise RuntimeError("Invalid test supplied, must supply one of:\n" + f"{', '.join(valid_test_names)}\n" + "or do not supply a test name to run all tests.") + else: + test_list = valid_test_names + + # make sure build directory exists if args.skip_build: - if not check_build_exists(os.path.abspath(args.build_dir)): - raise RuntimeError("Can't find build directory or executables, run again without --skip-build") + for test in test_list: + if not build_exists(args.build_dir, test_dict[test]['test_dir'], + test_dict[test]['test_exe']): + raise RuntimeError("Build directory or executable does not exist.\n" + "Re-run script without --skip-build.") + + # make sure relevant output files exist: if args.skip_run: - if not check_out_file_exists(os.path.join(os.path.abspath(args.run_dir), out_file)): - raise RuntimeError(f"Can't find output file {out_file}, run again without --skip-run") + for test in test_list: + if test_dict[test]['out_file'] is not None: + if not out_file_exists(os.path.abspath(args.run_dir), test_dict[test]['out_file']): + raise RuntimeError(f"Required file for {test} test does not exist.\n" + "Re-run script without --skip-run.") + + return test_list def main(): """Main script + Reads in command-line arguments and then runs the tests. """ - - args = commandline_args() - + + args, test_list = commandline_args() + build = not args.skip_build run = not args.skip_run - - run_tests(args.clean, build, run, args.build_dir, args.run_dir, args.make_j, - args.parameter_file, args.save_figs) + + run_tests(args.clean, build, run, args.build_dir, args.run_dir, args.make_j, + args.parameter_file, args.save_figs, test_list) if __name__ == "__main__": - - main() \ No newline at end of file + + main() diff --git a/functional_unit_testing/utils.py b/functional_unit_testing/utils.py index 86e7038f34..025938c1d8 100644 --- a/functional_unit_testing/utils.py +++ b/functional_unit_testing/utils.py @@ -1,66 +1,75 @@ -"""Utility functions related to getting paths to various important places +"""Utility functions for file checking, math equations, etc. """ -import os -import sys import math +import os +from path_utils import add_cime_lib_to_path -# ======================================================================== -# Constants that may need to be changed if directory structures change -# ======================================================================== +add_cime_lib_to_path() -# Path to the root directory of FATES, based on the path of this file -# -# Note: It's important that this NOT end with a trailing slash; -# os.path.normpath guarantees this. -_FATES_ROOT = os.path.normpath( - os.path.join(os.path.dirname(os.path.abspath(__file__)), os.pardir) -) +from CIME.utils import run_cmd_no_fail -def path_to_fates_root(): - """Returns the path to the root directory of FATES""" - return _FATES_ROOT +def round_up(num, decimals=0): + multiplier = 10**decimals + return math.ceil(num * multiplier)/multiplier -def path_to_cime(): - """Returns the path to cime, if it can be found +def truncate(num, decimals=0): + multiplier = 10**decimals + return int(num * multiplier)/multiplier - Raises a RuntimeError if it cannot be found +def create_nc_file(cdl_path, run_dir): + """Creates a netcdf file from a cdl file + Args: + cdl_path (str): full path to desired cdl file + run_dir (str): where the file should be written to """ - cime_path = os.path.join(path_to_fates_root(), "../../cime") - if os.path.isdir(cime_path): - return cime_path - raise RuntimeError("Cannot find cime.") - -def prepend_to_python_path(path): - """Adds the given path to python's sys.path if it isn't already in the path - - The path is added near the beginning, so that it takes precedence over existing - entries in the path + file_basename = os.path.basename(cdl_path).split(".")[-2] + file_nc_name = f"{file_basename}.nc" + + file_gen_command = [ + "ncgen -o", + os.path.join(run_dir, file_nc_name), + cdl_path + ] + out = run_cmd_no_fail(" ".join(file_gen_command), combine_output=True) + print(out) + + return file_nc_name + +def copy_file(file_path, dir): + """Copies a file file to a desired directory + + Args: + file_path (str): full path to file + dir (str): where the file should be copied to """ - if not path in sys.path: - # Insert at location 1 rather than 0, because 0 is special - sys.path.insert(1, path) + file_basename = os.path.basename(file_path) + + file_copy_command = [ + "cp", + os.path.abspath(file_path), + os.path.abspath(dir) + ] + run_cmd_no_fail(" ".join(file_copy_command), combine_output=True) -def add_cime_lib_to_path(): - """Adds the CIME python library to the python path, to allow importing - modules from that library + return file_basename - Returns the path to the top-level cime directory +def get_color_pallete(): + """Generate a color pallete - For documentation on standalone_only: See documentation in - path_to_cime + Returns: + real: array of colors to use in plotting """ - cime_path = path_to_cime() - prepend_to_python_path(cime_path) - cime_lib_path = os.path.join(cime_path, "CIME", "Tools") - prepend_to_python_path(cime_lib_path) - return cime_path - -def round_up(n, decimals=0): - multiplier = 10**decimals - return math.ceil(n * multiplier) / multiplier - -def truncate(n, decimals=0): - multiplier = 10**decimals - return int(n * multiplier) / multiplier \ No newline at end of file + + colors = [(31, 119, 180), (174, 199, 232), (255, 127, 14), (255, 187, 120), + (44, 160, 44), (152, 223, 138), (214, 39, 40), (255, 152, 150), + (148, 103, 189), (197, 176, 213), (140, 86, 75), (196, 156, 148), + (227, 119, 194), (247, 182, 210), (127, 127, 127), (199, 199, 199), + (188, 189, 34), (219, 219, 141), (23, 190, 207), (158, 218, 229)] + + for i in range(len(colors)): + r, g, b = colors[i] + colors[i] = (r/255., g/255., b/255.) + + return colors \ No newline at end of file From 5163a3f43585b4275f6384c909a411a004d3ae23 Mon Sep 17 00:00:00 2001 From: adrifoster Date: Fri, 19 Apr 2024 12:25:01 -0600 Subject: [PATCH 095/176] some pylint changes --- .gitignore | 4 + .../{AllometryUtils.py => allometry_utils.py} | 69 ++++--- .../build_fortran_tests.py | 69 ++++--- .../math_utils/MathUtils.py | 34 ---- .../math_utils/math_utils.py | 52 +++++ functional_unit_testing/run_fates_tests.py | 187 +++++++++++++----- functional_unit_testing/utils.py | 30 ++- 7 files changed, 288 insertions(+), 157 deletions(-) rename functional_unit_testing/allometry/{AllometryUtils.py => allometry_utils.py} (70%) delete mode 100644 functional_unit_testing/math_utils/MathUtils.py create mode 100644 functional_unit_testing/math_utils/math_utils.py diff --git a/.gitignore b/.gitignore index 40f2a49386..cf080967fe 100644 --- a/.gitignore +++ b/.gitignore @@ -46,6 +46,10 @@ Thumbs.db *.dvi *.toc +# Folders created with unit/functional tests +_build/ +_run/ + # Old Files *~ diff --git a/functional_unit_testing/allometry/AllometryUtils.py b/functional_unit_testing/allometry/allometry_utils.py similarity index 70% rename from functional_unit_testing/allometry/AllometryUtils.py rename to functional_unit_testing/allometry/allometry_utils.py index ac0a285672..08814602b6 100644 --- a/functional_unit_testing/allometry/AllometryUtils.py +++ b/functional_unit_testing/allometry/allometry_utils.py @@ -20,24 +20,24 @@ def plot_allometry_var(data, varname, units, save_fig, plot_dir=None): save_fig (bool): whether or not to write out plot plot_dir (str): if saving figure, where to write to """ - df = pd.DataFrame({'dbh': np.tile(data.dbh, len(data.pft)), + data_frame = pd.DataFrame({'dbh': np.tile(data.dbh, len(data.pft)), 'pft': np.repeat(data.pft, len(data.dbh)), data.name: data.values.flatten()}) - maxdbh = df['dbh'].max() - maxvar = round_up(df[data.name].max()) + maxdbh = data_frame['dbh'].max() + maxvar = round_up(data_frame[data.name].max()) colors = get_color_pallete() plt.figure(figsize=(7, 5)) - ax = plt.subplot(111) - ax.spines["top"].set_visible(False) - ax.spines["bottom"].set_visible(False) - ax.spines["right"].set_visible(False) - ax.spines["left"].set_visible(False) + axis = plt.subplot(111) + axis.spines["top"].set_visible(False) + axis.spines["bottom"].set_visible(False) + axis.spines["right"].set_visible(False) + axis.spines["left"].set_visible(False) - ax.get_xaxis().tick_bottom() - ax.get_yaxis().tick_left() + axis.get_xaxis().tick_bottom() + axis.get_yaxis().tick_left() plt.xlim(0.0, maxdbh) plt.ylim(0.0, maxvar) @@ -47,16 +47,16 @@ def plot_allometry_var(data, varname, units, save_fig, plot_dir=None): inc = (int(maxvar) - 0)/20 for i in range(0, 20): - y = 0.0 + i*inc + y_val = 0.0 + i*inc plt.plot(range(math.floor(0), math.ceil(maxdbh)), - [y] * len(range(math.floor(0), math.ceil(maxdbh))), + [y_val] * len(range(math.floor(0), math.ceil(maxdbh))), "--", lw=0.5, color="black", alpha=0.3) plt.tick_params(bottom=False, top=False, left=False, right=False) - pfts = np.unique(df.pft.values) + pfts = np.unique(data_frame.pft.values) for rank, pft in enumerate(pfts): - dat = df[df.pft == pft] + dat = data_frame[data_frame.pft == pft] plt.plot(dat.dbh.values, dat[data.name].values, lw=2, color=colors[rank], label=pft) @@ -66,7 +66,7 @@ def plot_allometry_var(data, varname, units, save_fig, plot_dir=None): plt.legend(loc='upper left', title='PFT') if save_fig: - fig_name = os.path.join(plot_dir, f"allometry_plot_{var}.png") + fig_name = os.path.join(plot_dir, f"allometry_plot_{data.name}.png") plt.savefig(fig_name) def plot_total_biomass(data, save_fig, plot_dir): @@ -75,7 +75,7 @@ def plot_total_biomass(data, save_fig, plot_dir): Args: data (xarray DataSet): the allometry dataset """ - df = pd.DataFrame({'dbh': np.tile(data.dbh, len(data.pft)), + data_frame = pd.DataFrame({'dbh': np.tile(data.dbh, len(data.pft)), 'pft': np.repeat(data.pft, len(data.dbh)), 'total_biomass_parts': data.total_biomass_parts.values.flatten(), 'total_biomass_tissues': data.total_biomass_tissues.values.flatten()}) @@ -83,16 +83,17 @@ def plot_total_biomass(data, save_fig, plot_dir): colors = get_color_pallete() plt.figure(figsize=(7, 5)) - ax = plt.subplot(111) - ax.spines["top"].set_visible(False) - ax.spines["bottom"].set_visible(False) - ax.spines["right"].set_visible(False) - ax.spines["left"].set_visible(False) + axis = plt.subplot(111) + axis.spines["top"].set_visible(False) + axis.spines["bottom"].set_visible(False) + axis.spines["right"].set_visible(False) + axis.spines["left"].set_visible(False) - ax.get_xaxis().tick_bottom() - ax.get_yaxis().tick_left() + axis.get_xaxis().tick_bottom() + axis.get_yaxis().tick_left() - maxbiomass = np.maximum(df['total_biomass_parts'].max(), df['total_biomass_tissues'].max()) + maxbiomass = np.maximum(data_frame['total_biomass_parts'].max(), + data_frame['total_biomass_tissues'].max()) plt.xlim(0.0, maxbiomass) plt.ylim(0.0, maxbiomass) @@ -101,9 +102,9 @@ def plot_total_biomass(data, save_fig, plot_dir): plt.xticks(fontsize=10) plt.tick_params(bottom=False, top=False, left=False, right=False) - pfts = np.unique(df.pft.values) + pfts = np.unique(data_frame.pft.values) for rank, pft in enumerate(pfts): - data = df[df.pft == pft] + data = data_frame[data_frame.pft == pft] plt.scatter(data.total_biomass_parts.values, data.total_biomass_parts.values, color=colors[rank], label=pft) @@ -117,6 +118,14 @@ def plot_total_biomass(data, save_fig, plot_dir): plt.savefig(fig_name) def plot_allometry_dat(run_dir, out_file, save_figs, plot_dir): + """Plots all allometry plots + + Args: + run_dir (str): run directory + out_file (str): output file name + save_figs (bool): whether or not to save the figures + plot_dir (str): plot directory to save the figures to + """ # read in allometry data allometry_dat = xr.open_dataset(os.path.join(run_dir, out_file)) @@ -172,8 +181,8 @@ def plot_allometry_dat(run_dir, out_file, save_figs, plot_dir): }, } - for plot in plot_dict: - plot_allometry_var(allometry_dat[plot], plot_dict[plot]['varname'], - plot_dict[plot]['units'], save_figs, plot_dir) + for plot, attributes in plot_dict.items(): + plot_allometry_var(allometry_dat[plot], attributes['varname'], + attributes['units'], save_figs, plot_dir) - plot_total_biomass(allometry_dat, save_figs, plot_dir) \ No newline at end of file + plot_total_biomass(allometry_dat, save_figs, plot_dir) diff --git a/functional_unit_testing/build_fortran_tests.py b/functional_unit_testing/build_fortran_tests.py index ef6d6577e9..722948ed09 100644 --- a/functional_unit_testing/build_fortran_tests.py +++ b/functional_unit_testing/build_fortran_tests.py @@ -1,18 +1,17 @@ +""" +Builds/compiles any tests within the FATES repository +""" import os -import sys import shutil - -_FATES_PYTHON = os.path.join(os.path.dirname(os.path.abspath(__file__))) -sys.path.insert(1, _FATES_PYTHON) - from utils import add_cime_lib_to_path + add_cime_lib_to_path() -from CIME.utils import get_src_root, run_cmd_no_fail, expect, stringify_bool -from CIME.build import CmakeTmpBuildDir -from CIME.XML.machines import Machines -from CIME.BuildTools.configure import configure, FakeCase -from CIME.XML.env_mach_specific import EnvMachSpecific +from CIME.utils import get_src_root, run_cmd_no_fail, expect, stringify_bool # pylint: disable=wrong-import-position,import-error,wrong-import-order +from CIME.build import CmakeTmpBuildDir # pylint: disable=wrong-import-position,import-error,wrong-import-order +from CIME.XML.machines import Machines # pylint: disable=wrong-import-position,import-error,wrong-import-order +from CIME.BuildTools.configure import configure, FakeCase # pylint: disable=wrong-import-position,import-error,wrong-import-order +from CIME.XML.env_mach_specific import EnvMachSpecific # pylint: disable=wrong-import-position,import-error,wrong-import-order _CIMEROOT = os.path.join(os.path.dirname(os.path.abspath(__file__)), "../../../cime") @@ -30,7 +29,8 @@ def run_cmake(name, test_dir, pfunit_path, netcdf_c_path, netcdf_f_path, cmake_a print(f"Running cmake for {name}.") # directory with cmake modules - cmake_module_dir = os.path.abspath(os.path.join(_CIMEROOT, "CIME", "non_py", "src", "CMake")) + cmake_module_dir = os.path.abspath(os.path.join(_CIMEROOT, "CIME", "non_py", + "src", "CMake")) # directory with genf90 genf90_dir = os.path.join(_CIMEROOT, "CIME", "non_py", "externals", "genf90") @@ -64,7 +64,8 @@ def find_library(caseroot, cmake_args, lib_string): Args: caseroot (str): Directory with pfunit macros - cmake_args (str): The cmake args used to invoke cmake (so that we get the correct makefile vars) + cmake_args (str): The cmake args used to invoke cmake + (so that we get the correct makefile vars) """ with CmakeTmpBuildDir(macroloc=caseroot) as cmaketmp: all_vars = cmaketmp.get_makefile_vars(cmake_args=cmake_args) @@ -92,7 +93,7 @@ def prep_build_dir(build_dir, clean): # create the build directory build_dir_path = os.path.abspath(build_dir) if not os.path.isdir(build_dir_path): - os.mkdir(build_dir_path) + os.mkdir(build_dir_path) # change into that directory os.chdir(build_dir_path) @@ -116,12 +117,12 @@ def clean_cmake_files(): # Clear contents to do with cmake cache for file in cwd_contents: - if ( - file in ("Macros.cmake", "env_mach_specific.xml") - or file.startswith("Depends") - or file.startswith(".env_mach_specific") - ): - os.remove(file) + if ( + file in ("Macros.cmake", "env_mach_specific.xml") + or file.startswith("Depends") + or file.startswith(".env_mach_specific") + ): + os.remove(file) def get_extra_cmake_args(build_dir, mpilib): """Makes a fake case to grab the required cmake arguments @@ -152,23 +153,22 @@ def get_extra_cmake_args(build_dir, mpilib): os_, unit_testing=True, ) - machspecific = EnvMachSpecific(build_dir, unit_testing=True) + EnvMachSpecific(build_dir, unit_testing=True) # make a fake case - fake_case = FakeCase(compiler, mpilib, True, "nuopc", threading=False) - - cmake_args = ( - "{}-DOS={} -DMACH={} -DCOMPILER={} -DDEBUG={} -DMPILIB={} -Dcompile_threaded={} -DCASEROOT={}".format( - "", - os_, - machobj.get_machine_name(), - compiler, - stringify_bool(True), - mpilib, - stringify_bool(False), - build_dir - ) - ) + FakeCase(compiler, mpilib, True, "nuopc", threading=False) + + cmake_args_list = [ + f"-DOS={os_}", + f"-DMACH={machobj.get_machine_name()}", + f"-DCOMPILER={compiler}", + f"-DDEBUG={stringify_bool(True)}", + f"-DMPILIB={mpilib}", + f"-Dcompile_threaded={stringify_bool(False)}", + f"-DCASEROOT={build_dir}" + ] + + cmake_args = " ".join(cmake_args_list) return cmake_args @@ -246,4 +246,3 @@ def build_unit_tests(build_dir, name, cmake_directory, make_j, clean=False): # run cmake and make run_cmake(name, cmake_directory, pfunit_path, netcdf_c_path, netcdf_f_path, cmake_args) run_make(name, make_j, clean=clean) - diff --git a/functional_unit_testing/math_utils/MathUtils.py b/functional_unit_testing/math_utils/MathUtils.py deleted file mode 100644 index 63c68ae820..0000000000 --- a/functional_unit_testing/math_utils/MathUtils.py +++ /dev/null @@ -1,34 +0,0 @@ -"""Utility functions for allometry functional unit tests -""" -import os -import math -import xarray as xr -import pandas as pd -import numpy as np -import matplotlib -import matplotlib.pyplot as plt - -from utils import get_color_pallete - -def plot_quadratic_dat(run_dir, out_file, save_figs, plot_dir): - - # read in quadratic data - quadratic_dat = xr.open_dataset(os.path.join(run_dir, out_file)) - - # plot output - PlotQuadAndRoots(quadratic_dat.a.values, quadratic_dat.b.values, - quadratic_dat.c.values, quadratic_dat.root1.values, - quadratic_dat.root2.values) - -def PlotQuadAndRoots(a, b, c, r1, r2): - - colors = get_color_pallete() - - fig, axs = plt.subplots(ncols=1, nrows=1, figsize=(8,8)) - x = np.linspace(-10.0, 10.0, num=20) - - for i in range(0, len(a)): - y = a[i]*x**2 + b[i]*x + c[i] - plt.plot(x, y, lw=2, color=colors[i]) - plt.scatter(r1[i], r2[i], color=colors[i], s=50) - plt.axhline(y=0.0, color='k', linestyle='dotted') diff --git a/functional_unit_testing/math_utils/math_utils.py b/functional_unit_testing/math_utils/math_utils.py new file mode 100644 index 0000000000..d2ae7d743f --- /dev/null +++ b/functional_unit_testing/math_utils/math_utils.py @@ -0,0 +1,52 @@ +"""Utility functions for allometry functional unit tests +""" +import os +import math +import xarray as xr +import numpy as np +import matplotlib.pyplot as plt + +from utils import get_color_pallete + +def plot_quadratic_dat(run_dir, out_file, save_figs, plot_dir): + """Reads in and plots quadratic formula test output + + Args: + run_dir (str): run directory + out_file (str): output file + save_figs (bool): whether or not to save the figures + plot_dir (str): plot directory + """ + + # read in quadratic data + quadratic_dat = xr.open_dataset(os.path.join(run_dir, out_file)) + + # plot output + plot_quad_and_roots(quadratic_dat.a.values, quadratic_dat.b.values, + quadratic_dat.c.values, quadratic_dat.root1.values, + quadratic_dat.root2.values) + if save_figs: + fig_name = os.path.join(plot_dir, "quadratic_test.png") + plt.savefig(fig_name) + +def plot_quad_and_roots(a_coeff, b_coeff, c_coeff, root1, root2): + """Plots a set of quadratic formulas (ax**2 + bx + c) and their two roots + + Args: + a (float array): set of a coefficients + b (float array): set of b coefficients + c (float array): set of b coefficients + r1 (float array): set of first real roots + r2 (float array): set of second real roots + """ + + colors = get_color_pallete() + + plt.figure(figsize=(7, 5)) + x_vals = np.linspace(-10.0, 10.0, num=20) + + for i in range(len(a_coeff)): + y_vals = a_coeff[i]*x_vals**2 + b_coeff[i]*x_vals + c_coeff[i] + plt.plot(x_vals, y_vals, lw=2, color=colors[i]) + plt.scatter(root1[i], root2[i], color=colors[i], s=50) + plt.axhline(y=0.0, color='k', linestyle='dotted') diff --git a/functional_unit_testing/run_fates_tests.py b/functional_unit_testing/run_fates_tests.py index ed3e64b1bf..2ee2903554 100755 --- a/functional_unit_testing/run_fates_tests.py +++ b/functional_unit_testing/run_fates_tests.py @@ -10,8 +10,9 @@ - matplotlib - pandas -Though this script does not require any host land model code, it does require some CIME and shr code, -so you should still get these repositories as you normally would (i.e., manage_externals, etc.) +Though this script does not require any host land model code, it does require some CIME +and shr code, so you should still get these repositories as you normally would +(i.e., manage_externals, etc.) Additionally, this requires netcdf and netcdff as well as a fortran compiler. @@ -27,17 +28,16 @@ """ import os import argparse -import matplotlib import matplotlib.pyplot as plt from build_fortran_tests import build_unit_tests, build_exists from path_utils import add_cime_lib_to_path -from utils import round_up, copy_file, create_nc_file -from allometry.AllometryUtils import plot_allometry_dat -from math_utils.MathUtils import plot_quadratic_dat +from utils import copy_file, create_nc_file +from allometry.allometry_utils import plot_allometry_dat +from math_utils.math_utils import plot_quadratic_dat add_cime_lib_to_path() -from CIME.utils import run_cmd_no_fail +from CIME.utils import run_cmd_no_fail # pylint: disable=wrong-import-position,import-error,wrong-import-order # Constants for this script DEFAULT_CDL_PATH = os.path.abspath("../parameter_files/fates_params_default.cdl") @@ -46,6 +46,10 @@ # Dictionary with needed constants for running the executables and reading in the # output files - developers who add tests should add things here. + +# NOTE: if the functional test you write requires a parameter file read in as a +# command-line argument, this should be the *first* (or only) argument in the +# command-line argument list test_dict = { "allometry": { "test_dir": "fates_allom_test", @@ -93,6 +97,12 @@ def run_exectuables(build_dir, test_dir, test_exe, run_dir, args): print(out) def make_plotdirs(run_dir, test_list): + """Create plotting directories if they don't already exist + + Args: + run_dir (str): full path to run directory + test_list (list, str): list of test names + """ # make main plot directory plot_dir = os.path.join(run_dir, 'plots') if not os.path.isdir(plot_dir): @@ -106,6 +116,19 @@ def make_plotdirs(run_dir, test_list): os.mkdir(sub_dir) def create_param_file(param_file, run_dir): + """Creates and/or move the default or input parameter file to the run directory + Creates a netcdf file from a cdl file if a cdl file is supplied + + Args: + param_file (str): path to parmaeter file + run_dir (str): full path to run directory + + Raises: + RuntimeError: Supplied parameter file is not netcdf (.cd) or cdl (.cdl) + + Returns: + str: full path to new parameter file name/location + """ if param_file is None: print("Using default parameter file.") param_file = DEFAULT_CDL_PATH @@ -134,9 +157,7 @@ def run_tests(clean, build, run, build_dir, run_dir, make_j, param_file, save_fi make_j (int): number of processors for the build param_file (str): input FATES parameter file save_figs (bool): whether or not to write figures to file - - Raises: - RuntimeError: Parameter file is not the correct file type + test_list(str, list): list of test names to run """ # absolute path to desired build directory @@ -156,19 +177,24 @@ def run_tests(clean, build, run, build_dir, run_dir, make_j, param_file, save_fi # move parameter file to correct location (creates nc file if cdl supplied) param_file = create_param_file(param_file, run_dir) + # compile code if build: build_unit_tests(build_dir, NAME, CMAKE_BASE_DIR, make_j, clean=clean) + # run executables for each test in test list if run: for test in test_list: + # we don't run executables for pfunit tests if not test_dict[test]['unit_test']: + # prepend parameter file (if required) to argument list args = test_dict[test]['other_args'] if test_dict[test]['use_param_file']: args.insert(0, param_file) + # run run_exectuables(build_dir_path, test_dict[test]['test_dir'], test_dict[test]['test_exe'], run_dir_path, args) - # plot output + # plot output for relevant tests for test in test_list: if test_dict[test]['plotting_function'] is not None: test_dict[test]['plotting_function'](run_dir_path, @@ -177,11 +203,46 @@ def run_tests(clean, build, run, build_dir, run_dir, make_j, param_file, save_fi plt.show() def out_file_exists(run_dir, out_file): + """Checks to see if the file out_file exists in the run_dir + + Args: + run_dir (str): full path to run directory + out_file (str): output file name + + Returns: + bool: yes/no file exists in correct location + """ if not os.path.isfile(os.path.join(run_dir, out_file)): return False return True +def parse_test_list(test_string): + """Parses the input test list and checks for errors + + Args: + test (str): user-supplied comma-separated list of test names + + Returns: + str, list: list of test names to run + + Raises: + RuntimeError: Invalid test name supplied + """ + valid_test_names = test_dict.keys() + + if test_string != "all": + test_list = test_string.split(',') + for test in test_list: + if test not in valid_test_names: + raise argparse.ArgumentTypeError("Invalid test supplied, must supply one of:\n" + f"{', '.join(valid_test_names)}\n" + "or do not supply a test name to run all tests.") + else: + test_list = [test for test in valid_test_names] + + return test_list + def commandline_args(): """Parse and return command-line arguments""" @@ -193,7 +254,6 @@ def commandline_args(): ./run_fates_tests -f parameter_file.nc """ - parser = argparse.ArgumentParser( description=description, formatter_class=argparse.RawTextHelpFormatter ) @@ -201,6 +261,7 @@ def commandline_args(): parser.add_argument( "-f", "--parameter-file", + type=str, default=DEFAULT_CDL_PATH, help="Parameter file to run the FATES tests with.\n" "Can be a netcdf (.nc) or cdl (.cdl) file.\n" @@ -211,6 +272,7 @@ def commandline_args(): parser.add_argument( "-b", "--build-dir", + type=str, default="../_build", help="Directory where tests are built.\n" "Will be created if it does not exist.\n", @@ -219,6 +281,7 @@ def commandline_args(): parser.add_argument( "-r", "--run-dir", + type=str, default="../_run", help="Directory where tests are run.\n" "Will be created if it does not exist.\n", @@ -265,16 +328,68 @@ def commandline_args(): parser.add_argument( "-t", - "--test", + "--test-list", + action="store", + dest="test_list", + type=parse_test_list, + default="all", help="Test(s) to run. Comma-separated list of test names, or 'all'\n" "for all tests. If not supplied, will run all tests." ) args = parser.parse_args() - test_list = check_arg_validity(args) + check_arg_validity(args) + + return args - return args, test_list +def check_param_file(param_file): + """Checks to see if param_file exists and is of the correct form (.nc or .cdl) + + Args: + param_file (str): path to parameter file + + Raises: + IOError: Parameter file is not of the correct form (.nc or .cdl) + IOError: Can't find parameter file + """ + file_suffix = os.path.basename(param_file).split(".")[-1] + if not file_suffix in ['cdl', 'nc']: + raise argparse.ArgumentError("Must supply parameter file with .cdl or .nc ending.") + if not os.path.isfile(param_file): + raise argparse.ArgumentError(f"Cannot find file {param_file}.") + +def check_build_dir(build_dir, test_list): + """Checks to see if all required build directories and executables are present + + Args: + build_dir (str): build directory + test_list (list, str): list of test names + + Raises: + RuntimeError: Can't find a required build directory or executable + """ + for test in test_list: + if not build_exists(build_dir, test_dict[test]['test_dir'], + test_dict[test]['test_exe']): + raise argparse.ArgumentError("Build directory or executable does not exist.\n" + "Re-run script without --skip-build.") + +def check_out_files(run_dir, test_list): + """Checks to see that required output files are present in the run directory + + Args: + run_dir (str): run directory + test_list (str, list): list of test names + + Raises: + RuntimeError: Can't find a required output file + """ + for test in test_list: + if test_dict[test]['out_file'] is not None: + if not out_file_exists(os.path.abspath(run_dir), test_dict[test]['out_file']): + raise argparse.ArgumentError(f"Required file for {test} test does not exist.\n" + "Re-run script without --skip-run.") def check_arg_validity(args): """Checks validity of input script arguments @@ -282,63 +397,33 @@ def check_arg_validity(args): Args: args (parse_args): input arguments - Raises: - IOError: Can't find input parameter file, or parameter file is not correct form - RuntimeError: Invalid test name or test list - RuntimeError: Can't find required build directories or executables - RuntimeError: Can't find required output files for plotting """ # check to make sure parameter file exists and is one of the correct forms if args.parameter_file is not None: - if not os.path.isfile(args.parameter_file): - raise IOError(f"Cannot find file {args.parameter_file}.") - else: - file_suffix = os.path.basename(args.parameter_file).split(".")[-1] - if not file_suffix in ['cdl', 'nc']: - raise IOError("Must supply parameter file with .cdl or .nc ending.") - - # check test names - valid_test_names = test_dict.keys() - if args.test is not None: - test_list = args.test.split(',') - for test in test_list: - if test not in valid_test_names: - raise RuntimeError("Invalid test supplied, must supply one of:\n" - f"{', '.join(valid_test_names)}\n" - "or do not supply a test name to run all tests.") + check_param_file(args.parameter_file) else: - test_list = valid_test_names + check_param_file(DEFAULT_CDL_PATH) # make sure build directory exists if args.skip_build: - for test in test_list: - if not build_exists(args.build_dir, test_dict[test]['test_dir'], - test_dict[test]['test_exe']): - raise RuntimeError("Build directory or executable does not exist.\n" - "Re-run script without --skip-build.") + check_build_dir(args.build_dir, args.test_list) # make sure relevant output files exist: if args.skip_run: - for test in test_list: - if test_dict[test]['out_file'] is not None: - if not out_file_exists(os.path.abspath(args.run_dir), test_dict[test]['out_file']): - raise RuntimeError(f"Required file for {test} test does not exist.\n" - "Re-run script without --skip-run.") - - return test_list + check_out_files(args.run_dir, args.test_list) def main(): """Main script Reads in command-line arguments and then runs the tests. """ - args, test_list = commandline_args() + args = commandline_args() build = not args.skip_build run = not args.skip_run run_tests(args.clean, build, run, args.build_dir, args.run_dir, args.make_j, - args.parameter_file, args.save_figs, test_list) + args.parameter_file, args.save_figs, args.test_list) if __name__ == "__main__": diff --git a/functional_unit_testing/utils.py b/functional_unit_testing/utils.py index 025938c1d8..4388ea5eb9 100644 --- a/functional_unit_testing/utils.py +++ b/functional_unit_testing/utils.py @@ -7,13 +7,31 @@ add_cime_lib_to_path() -from CIME.utils import run_cmd_no_fail +from CIME.utils import run_cmd_no_fail # pylint: disable=wrong-import-position,import-error,wrong-import-order def round_up(num, decimals=0): + """Rounds a number up + + Args: + num (float): number to round + decimals (int, optional): number of decimals to round to. Defaults to 0. + + Returns: + float: input number rounded up + """ multiplier = 10**decimals return math.ceil(num * multiplier)/multiplier def truncate(num, decimals=0): + """Rounds a number down + + Args: + num (float): number to round + decimals (int, optional): Decimals to round down to. Defaults to 0. + + Returns: + float: number rounded down + """ multiplier = 10**decimals return int(num * multiplier)/multiplier @@ -37,7 +55,7 @@ def create_nc_file(cdl_path, run_dir): return file_nc_name -def copy_file(file_path, dir): +def copy_file(file_path, directory): """Copies a file file to a desired directory Args: @@ -49,7 +67,7 @@ def copy_file(file_path, dir): file_copy_command = [ "cp", os.path.abspath(file_path), - os.path.abspath(dir) + os.path.abspath(directory) ] run_cmd_no_fail(" ".join(file_copy_command), combine_output=True) @@ -68,8 +86,6 @@ def get_color_pallete(): (227, 119, 194), (247, 182, 210), (127, 127, 127), (199, 199, 199), (188, 189, 34), (219, 219, 141), (23, 190, 207), (158, 218, 229)] - for i in range(len(colors)): - r, g, b = colors[i] - colors[i] = (r/255., g/255., b/255.) + colors = [(red/255.0, green/255.0, blue/255.0) for red, green, blue in colors] - return colors \ No newline at end of file + return colors From f2a805bb2e88ee2b1c59a923ae125962362a153b Mon Sep 17 00:00:00 2001 From: adrifoster Date: Mon, 22 Apr 2024 10:05:54 -0600 Subject: [PATCH 096/176] some pythonic updates --- ...lometry_utils.py => allometry_plotting.py} | 87 +++++----- .../build_fortran_tests.py | 6 +- .../{math_utils.py => math_plotting.py} | 22 +-- functional_unit_testing/run_fates_tests.py | 152 +++++++++--------- functional_unit_testing/utils.py | 13 +- 5 files changed, 139 insertions(+), 141 deletions(-) rename functional_unit_testing/allometry/{allometry_utils.py => allometry_plotting.py} (80%) rename functional_unit_testing/math_utils/{math_utils.py => math_plotting.py} (71%) diff --git a/functional_unit_testing/allometry/allometry_utils.py b/functional_unit_testing/allometry/allometry_plotting.py similarity index 80% rename from functional_unit_testing/allometry/allometry_utils.py rename to functional_unit_testing/allometry/allometry_plotting.py index 08814602b6..caa6cc1069 100644 --- a/functional_unit_testing/allometry/allometry_utils.py +++ b/functional_unit_testing/allometry/allometry_plotting.py @@ -7,27 +7,19 @@ import xarray as xr import matplotlib import matplotlib.pyplot as plt -from utils import get_color_pallete, round_up +from utils import get_color_palette, round_up -def plot_allometry_var(data, varname, units, save_fig, plot_dir=None): - """Plot an allometry variable +def blank_plot(x_max, x_min, y_max, y_min, draw_horizontal_lines=False): + """Generate a blank plot with set attributes Args: - data (xarray DataArray): the data array of the variable to plot - var (str): variable name (for data structure) - varname (str): variable name for plot labels - units (str): variable units for plot labels - save_fig (bool): whether or not to write out plot - plot_dir (str): if saving figure, where to write to + x_max (float): maximum x value + x_min (float): minimum x value + y_max (float): maximum y value + y_min (float): minimum y value + draw_horizontal_lines (bool, optional): whether or not to draw horizontal + lines across plot. Defaults to False. """ - data_frame = pd.DataFrame({'dbh': np.tile(data.dbh, len(data.pft)), - 'pft': np.repeat(data.pft, len(data.dbh)), - data.name: data.values.flatten()}) - - maxdbh = data_frame['dbh'].max() - maxvar = round_up(data_frame[data.name].max()) - - colors = get_color_pallete() plt.figure(figsize=(7, 5)) axis = plt.subplot(111) @@ -39,22 +31,45 @@ def plot_allometry_var(data, varname, units, save_fig, plot_dir=None): axis.get_xaxis().tick_bottom() axis.get_yaxis().tick_left() - plt.xlim(0.0, maxdbh) - plt.ylim(0.0, maxvar) + plt.xlim(0.0, x_max) + plt.ylim(0.0, y_max) plt.yticks(fontsize=10) plt.xticks(fontsize=10) - inc = (int(maxvar) - 0)/20 - for i in range(0, 20): - y_val = 0.0 + i*inc - plt.plot(range(math.floor(0), math.ceil(maxdbh)), - [y_val] * len(range(math.floor(0), math.ceil(maxdbh))), - "--", lw=0.5, color="black", alpha=0.3) + if draw_horizontal_lines: + inc = (int(y_max) - y_min)/20 + for i in range(0, 20): + plt.plot(range(math.floor(x_min), math.ceil(x_max)), + [0.0 + i*inc] * len(range(math.floor(x_min), math.ceil(x_max))), + "--", lw=0.5, color="black", alpha=0.3) plt.tick_params(bottom=False, top=False, left=False, right=False) + return plt + +def plot_allometry_var(data, varname, units, save_fig, plot_dir=None): + """Plot an allometry variable + + Args: + data (xarray DataArray): the data array of the variable to plot + var (str): variable name (for data structure) + varname (str): variable name for plot labels + units (str): variable units for plot labels + save_fig (bool): whether or not to write out plot + plot_dir (str): if saving figure, where to write to + """ + data_frame = pd.DataFrame({'dbh': np.tile(data.dbh, len(data.pft)), + 'pft': np.repeat(data.pft, len(data.dbh)), + data.name: data.values.flatten()}) + + max_dbh = data_frame['dbh'].max() + max_var = round_up(data_frame[data.name].max()) + + blank_plot(max_dbh, 0.0, max_var, 0.0, draw_horizontal_lines=True) + pfts = np.unique(data_frame.pft.values) + colors = get_color_palette(len(pfts)) for rank, pft in enumerate(pfts): dat = data_frame[data_frame.pft == pft] plt.plot(dat.dbh.values, dat[data.name].values, lw=2, color=colors[rank], @@ -80,29 +95,13 @@ def plot_total_biomass(data, save_fig, plot_dir): 'total_biomass_parts': data.total_biomass_parts.values.flatten(), 'total_biomass_tissues': data.total_biomass_tissues.values.flatten()}) - colors = get_color_pallete() - - plt.figure(figsize=(7, 5)) - axis = plt.subplot(111) - axis.spines["top"].set_visible(False) - axis.spines["bottom"].set_visible(False) - axis.spines["right"].set_visible(False) - axis.spines["left"].set_visible(False) - - axis.get_xaxis().tick_bottom() - axis.get_yaxis().tick_left() - - maxbiomass = np.maximum(data_frame['total_biomass_parts'].max(), + max_biomass = np.maximum(data_frame['total_biomass_parts'].max(), data_frame['total_biomass_tissues'].max()) - plt.xlim(0.0, maxbiomass) - plt.ylim(0.0, maxbiomass) - - plt.yticks(fontsize=10) - plt.xticks(fontsize=10) - plt.tick_params(bottom=False, top=False, left=False, right=False) + blank_plot(max_biomass, 0.0, max_biomass, 0.0, draw_horizontal_lines=False) pfts = np.unique(data_frame.pft.values) + colors = get_color_palette(len(pfts)) for rank, pft in enumerate(pfts): data = data_frame[data_frame.pft == pft] plt.scatter(data.total_biomass_parts.values, data.total_biomass_parts.values, diff --git a/functional_unit_testing/build_fortran_tests.py b/functional_unit_testing/build_fortran_tests.py index 722948ed09..0c4cbb535f 100644 --- a/functional_unit_testing/build_fortran_tests.py +++ b/functional_unit_testing/build_fortran_tests.py @@ -15,10 +15,10 @@ _CIMEROOT = os.path.join(os.path.dirname(os.path.abspath(__file__)), "../../../cime") -def run_cmake(name, test_dir, pfunit_path, netcdf_c_path, netcdf_f_path, cmake_args): +def run_cmake(test_name, test_dir, pfunit_path, netcdf_c_path, netcdf_f_path, cmake_args): """Run cmake for the fortran unit tests Arguments: - name (str) - name for output messages + test_name (str) - name for output messages test_dir (str) - directory to run Cmake in pfunit_path (str) - path to pfunit netcdf_c_path (str) - path to netcdf @@ -26,7 +26,7 @@ def run_cmake(name, test_dir, pfunit_path, netcdf_c_path, netcdf_f_path, cmake_a clean (bool) - clean the build """ if not os.path.isfile("CMakeCache.txt"): - print(f"Running cmake for {name}.") + print(f"Running cmake for {test_name}.") # directory with cmake modules cmake_module_dir = os.path.abspath(os.path.join(_CIMEROOT, "CIME", "non_py", diff --git a/functional_unit_testing/math_utils/math_utils.py b/functional_unit_testing/math_utils/math_plotting.py similarity index 71% rename from functional_unit_testing/math_utils/math_utils.py rename to functional_unit_testing/math_utils/math_plotting.py index d2ae7d743f..4e386dbe93 100644 --- a/functional_unit_testing/math_utils/math_utils.py +++ b/functional_unit_testing/math_utils/math_plotting.py @@ -6,7 +6,7 @@ import numpy as np import matplotlib.pyplot as plt -from utils import get_color_pallete +from utils import get_color_palette def plot_quadratic_dat(run_dir, out_file, save_figs, plot_dir): """Reads in and plots quadratic formula test output @@ -26,26 +26,26 @@ def plot_quadratic_dat(run_dir, out_file, save_figs, plot_dir): quadratic_dat.c.values, quadratic_dat.root1.values, quadratic_dat.root2.values) if save_figs: - fig_name = os.path.join(plot_dir, "quadratic_test.png") - plt.savefig(fig_name) + fig_name = os.path.join(plot_dir, "quadratic_test.png") + plt.savefig(fig_name) def plot_quad_and_roots(a_coeff, b_coeff, c_coeff, root1, root2): """Plots a set of quadratic formulas (ax**2 + bx + c) and their two roots Args: - a (float array): set of a coefficients - b (float array): set of b coefficients - c (float array): set of b coefficients - r1 (float array): set of first real roots - r2 (float array): set of second real roots + a_coeff (float array): set of a coefficients + b_coeff (float array): set of b coefficients + c_coeff (float array): set of b coefficients + root1 (float array): set of first real roots + root2 (float array): set of second real roots """ - - colors = get_color_pallete() + num_equations = len(a_coeff) plt.figure(figsize=(7, 5)) x_vals = np.linspace(-10.0, 10.0, num=20) - for i in range(len(a_coeff)): + colors = get_color_palette(num_equations) + for i in range(num_equations): y_vals = a_coeff[i]*x_vals**2 + b_coeff[i]*x_vals + c_coeff[i] plt.plot(x_vals, y_vals, lw=2, color=colors[i]) plt.scatter(root1[i], root2[i], color=colors[i], s=50) diff --git a/functional_unit_testing/run_fates_tests.py b/functional_unit_testing/run_fates_tests.py index 2ee2903554..0aa53fd4a8 100755 --- a/functional_unit_testing/run_fates_tests.py +++ b/functional_unit_testing/run_fates_tests.py @@ -32,17 +32,17 @@ from build_fortran_tests import build_unit_tests, build_exists from path_utils import add_cime_lib_to_path from utils import copy_file, create_nc_file -from allometry.allometry_utils import plot_allometry_dat -from math_utils.math_utils import plot_quadratic_dat +from allometry.allometry_plotting import plot_allometry_dat +from math_utils.math_plotting import plot_quadratic_dat add_cime_lib_to_path() from CIME.utils import run_cmd_no_fail # pylint: disable=wrong-import-position,import-error,wrong-import-order # Constants for this script -DEFAULT_CDL_PATH = os.path.abspath("../parameter_files/fates_params_default.cdl") -CMAKE_BASE_DIR = os.path.join(os.path.dirname(os.path.abspath(__file__)), "../") -NAME = "fates_unit_tests" +_DEFAULT_CDL_PATH = os.path.abspath("../parameter_files/fates_params_default.cdl") +_CMAKE_BASE_DIR = os.path.join(os.path.dirname(os.path.abspath(__file__)), "../") +_TEST_NAME = "fates_unit_tests" # Dictionary with needed constants for running the executables and reading in the # output files - developers who add tests should add things here. @@ -50,7 +50,7 @@ # NOTE: if the functional test you write requires a parameter file read in as a # command-line argument, this should be the *first* (or only) argument in the # command-line argument list -test_dict = { +_ALL_TESTS_DICT = { "allometry": { "test_dir": "fates_allom_test", "test_exe": "FATES_allom_exe", @@ -71,8 +71,8 @@ } } -def run_exectuables(build_dir, test_dir, test_exe, run_dir, args): - """Run the generated executables +def run_fortran_exectuables(build_dir, test_dir, test_exe, run_dir, args): + """Run the generated Fortran executables Args: build_dir (str): full path to build directory @@ -92,16 +92,15 @@ def run_exectuables(build_dir, test_dir, test_exe, run_dir, args): run_command.extend(args) os.chdir(run_dir) - print("Running exectuables") out = run_cmd_no_fail(" ".join(run_command), combine_output=True) print(out) -def make_plotdirs(run_dir, test_list): +def make_plotdirs(run_dir, test_dict): """Create plotting directories if they don't already exist Args: run_dir (str): full path to run directory - test_list (list, str): list of test names + test_dict (dict): dictionary of test to run """ # make main plot directory plot_dir = os.path.join(run_dir, 'plots') @@ -109,11 +108,11 @@ def make_plotdirs(run_dir, test_list): os.mkdir(plot_dir) # make sub-plot directories - for test in test_list: - if test_dict[test]['plotting_function'] is not None: - sub_dir = os.path.join(plot_dir, test) - if not os.path.isdir(sub_dir): - os.mkdir(sub_dir) + for test in dict(filter(lambda pair: pair[1]['plotting_function'] is not None, + test_dict.items())): + sub_dir = os.path.join(plot_dir, test) + if not os.path.isdir(sub_dir): + os.mkdir(sub_dir) def create_param_file(param_file, run_dir): """Creates and/or move the default or input parameter file to the run directory @@ -131,7 +130,7 @@ def create_param_file(param_file, run_dir): """ if param_file is None: print("Using default parameter file.") - param_file = DEFAULT_CDL_PATH + param_file = _DEFAULT_CDL_PATH param_file_update = create_nc_file(param_file, run_dir) else: print(f"Using parameter file {param_file}.") @@ -145,19 +144,20 @@ def create_param_file(param_file, run_dir): return param_file_update -def run_tests(clean, build, run, build_dir, run_dir, make_j, param_file, save_figs, test_list): +def run_tests(clean, build_tests, run_executables, build_dir, run_dir, make_j, + param_file, save_figs, test_dict): """Builds and runs the fates tests Args: clean (bool): whether or not to clean the build directory - build (bool): whether or not to build the exectuables - run (bool): whether or not to run the executables + build_tests (bool): whether or not to build the exectuables + run_executables (bool): whether or not to run the executables build_dir (str): build directory run_dir (str): run directory make_j (int): number of processors for the build param_file (str): input FATES parameter file save_figs (bool): whether or not to write figures to file - test_list(str, list): list of test names to run + test_dict (dict): dictionary of tests to run """ # absolute path to desired build directory @@ -172,34 +172,35 @@ def run_tests(clean, build, run, build_dir, run_dir, make_j, param_file, save_fi # create plot directories if we need to if save_figs: - make_plotdirs(os.path.abspath(run_dir), test_list) + make_plotdirs(os.path.abspath(run_dir), test_dict) # move parameter file to correct location (creates nc file if cdl supplied) param_file = create_param_file(param_file, run_dir) # compile code - if build: - build_unit_tests(build_dir, NAME, CMAKE_BASE_DIR, make_j, clean=clean) + if build_tests: + build_unit_tests(build_dir, _TEST_NAME, _CMAKE_BASE_DIR, make_j, clean=clean) # run executables for each test in test list - if run: - for test in test_list: - # we don't run executables for pfunit tests - if not test_dict[test]['unit_test']: - # prepend parameter file (if required) to argument list - args = test_dict[test]['other_args'] - if test_dict[test]['use_param_file']: - args.insert(0, param_file) - # run - run_exectuables(build_dir_path, test_dict[test]['test_dir'], - test_dict[test]['test_exe'], run_dir_path, args) + if run_executables: + print("Running executables") + # we don't run executables for pfunit tests + for test, attributes in dict(filter(lambda pair: not pair[1]['unit_test'], + test_dict.items())).items(): + # prepend parameter file (if required) to argument list + args = attributes['other_args'] + if attributes['use_param_file']: + args.insert(0, param_file) + # run + run_fortran_exectuables(build_dir_path, attributes['test_dir'], + attributes['test_exe'], run_dir_path, args) # plot output for relevant tests - for test in test_list: - if test_dict[test]['plotting_function'] is not None: - test_dict[test]['plotting_function'](run_dir_path, - test_dict[test]['out_file'], save_figs, - os.path.join(run_dir_path, 'plots', test)) + for test, attributes in dict(filter(lambda pair: pair[1]['plotting_function'] is not None, + test_dict.items())).items(): + attributes['plotting_function'](run_dir_path, + attributes['out_file'], save_figs, + os.path.join(run_dir_path, 'plots', test)) plt.show() def out_file_exists(run_dir, out_file): @@ -212,7 +213,6 @@ def out_file_exists(run_dir, out_file): Returns: bool: yes/no file exists in correct location """ - if not os.path.isfile(os.path.join(run_dir, out_file)): return False return True @@ -224,24 +224,26 @@ def parse_test_list(test_string): test (str): user-supplied comma-separated list of test names Returns: - str, list: list of test names to run + dictionary: filtered dictionary of tests to run Raises: RuntimeError: Invalid test name supplied """ - valid_test_names = test_dict.keys() + valid_test_names = _ALL_TESTS_DICT.keys() if test_string != "all": test_list = test_string.split(',') for test in test_list: if test not in valid_test_names: - raise argparse.ArgumentTypeError("Invalid test supplied, must supply one of:\n" + raise argparse.ArgumentTypeError("Invalid test supplied, \n" + "must supply one of:\n" f"{', '.join(valid_test_names)}\n" "or do not supply a test name to run all tests.") + test_dict = {key: _ALL_TESTS_DICT[key] for key in test_list} else: - test_list = [test for test in valid_test_names] + test_dict = _ALL_TESTS_DICT - return test_list + return test_dict def commandline_args(): """Parse and return command-line arguments""" @@ -262,7 +264,7 @@ def commandline_args(): "-f", "--parameter-file", type=str, - default=DEFAULT_CDL_PATH, + default=_DEFAULT_CDL_PATH, help="Parameter file to run the FATES tests with.\n" "Can be a netcdf (.nc) or cdl (.cdl) file.\n" "If no file is specified the script will use the default .cdl file in the\n" @@ -311,7 +313,7 @@ def commandline_args(): ) parser.add_argument( - "--skip-run", + "--skip-run-executables", action="store_true", help="Skip running test code executables.\n" "Only do this if you already have run the code previously.\n" @@ -330,7 +332,7 @@ def commandline_args(): "-t", "--test-list", action="store", - dest="test_list", + dest="test_dict", type=parse_test_list, default="all", help="Test(s) to run. Comma-separated list of test names, or 'all'\n" @@ -350,16 +352,16 @@ def check_param_file(param_file): param_file (str): path to parameter file Raises: - IOError: Parameter file is not of the correct form (.nc or .cdl) - IOError: Can't find parameter file + argparse.ArgumentError: Parameter file is not of the correct form (.nc or .cdl) + argparse.ArgumentError: Can't find parameter file """ file_suffix = os.path.basename(param_file).split(".")[-1] if not file_suffix in ['cdl', 'nc']: - raise argparse.ArgumentError("Must supply parameter file with .cdl or .nc ending.") + raise argparse.ArgumentError(None, "Must supply parameter file with .cdl or .nc ending.") if not os.path.isfile(param_file): - raise argparse.ArgumentError(f"Cannot find file {param_file}.") + raise argparse.ArgumentError(None, f"Cannot find file {param_file}.") -def check_build_dir(build_dir, test_list): +def check_build_dir(build_dir, test_dict): """Checks to see if all required build directories and executables are present Args: @@ -367,50 +369,45 @@ def check_build_dir(build_dir, test_list): test_list (list, str): list of test names Raises: - RuntimeError: Can't find a required build directory or executable + argparse.ArgumentError: Can't find a required build directory or executable """ - for test in test_list: - if not build_exists(build_dir, test_dict[test]['test_dir'], - test_dict[test]['test_exe']): - raise argparse.ArgumentError("Build directory or executable does not exist.\n" + for test, attributes in test_dict.items(): + if not build_exists(build_dir, attributes['test_dir'], attributes['test_exe']): + raise argparse.ArgumentError(None, "Build directory or executable does not exist.\n" "Re-run script without --skip-build.") -def check_out_files(run_dir, test_list): +def check_out_files(run_dir, test_dict): """Checks to see that required output files are present in the run directory Args: run_dir (str): run directory - test_list (str, list): list of test names + test_dict (dict): dictionary of tests to run Raises: - RuntimeError: Can't find a required output file + argparse.ArgumentError: Can't find a required output file """ - for test in test_list: - if test_dict[test]['out_file'] is not None: - if not out_file_exists(os.path.abspath(run_dir), test_dict[test]['out_file']): - raise argparse.ArgumentError(f"Required file for {test} test does not exist.\n" - "Re-run script without --skip-run.") + for test, attributes in dict(filter(lambda pair: pair[1]['out_file'] is not None, + test_dict.items())).items(): + if not out_file_exists(os.path.abspath(run_dir), attributes['out_file']): + raise argparse.ArgumentError(None, f"Required file for {test} test does not exist.\n" + "Re-run script without --skip-run.") def check_arg_validity(args): """Checks validity of input script arguments Args: args (parse_args): input arguments - """ # check to make sure parameter file exists and is one of the correct forms - if args.parameter_file is not None: - check_param_file(args.parameter_file) - else: - check_param_file(DEFAULT_CDL_PATH) + check_param_file(args.parameter_file) # make sure build directory exists if args.skip_build: - check_build_dir(args.build_dir, args.test_list) + check_build_dir(args.build_dir, args.test_dict) # make sure relevant output files exist: - if args.skip_run: - check_out_files(args.run_dir, args.test_list) + if args.skip_run_executables: + check_out_files(args.run_dir, args.test_dict) def main(): """Main script @@ -420,11 +417,10 @@ def main(): args = commandline_args() build = not args.skip_build - run = not args.skip_run + run = not args.skip_run_executables run_tests(args.clean, build, run, args.build_dir, args.run_dir, args.make_j, - args.parameter_file, args.save_figs, args.test_list) + args.parameter_file, args.save_figs, args.test_dict) if __name__ == "__main__": - main() diff --git a/functional_unit_testing/utils.py b/functional_unit_testing/utils.py index 4388ea5eb9..aa6079757d 100644 --- a/functional_unit_testing/utils.py +++ b/functional_unit_testing/utils.py @@ -1,4 +1,4 @@ -"""Utility functions for file checking, math equations, etc. +"""Utility functions for plotting, file checking, math equations, etc. """ import math @@ -73,12 +73,15 @@ def copy_file(file_path, directory): return file_basename -def get_color_pallete(): +def get_color_palette(number): """Generate a color pallete - + Args: + number: number of colors to get - must be <= 20 Returns: - real: array of colors to use in plotting + float: array of colors to use in plotting """ + if number > 20: + raise RuntimeError("get_color_palette: number must be <=20") colors = [(31, 119, 180), (174, 199, 232), (255, 127, 14), (255, 187, 120), (44, 160, 44), (152, 223, 138), (214, 39, 40), (255, 152, 150), @@ -88,4 +91,4 @@ def get_color_pallete(): colors = [(red/255.0, green/255.0, blue/255.0) for red, green, blue in colors] - return colors + return colors[:number] From 79b7369ddbdcc1e86b029a62ab99dfdb16b59ea8 Mon Sep 17 00:00:00 2001 From: adrifoster Date: Mon, 22 Apr 2024 10:07:16 -0600 Subject: [PATCH 097/176] check for executable instead of unit test --- functional_unit_testing/run_fates_tests.py | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/functional_unit_testing/run_fates_tests.py b/functional_unit_testing/run_fates_tests.py index 0aa53fd4a8..ecbddbb094 100755 --- a/functional_unit_testing/run_fates_tests.py +++ b/functional_unit_testing/run_fates_tests.py @@ -184,8 +184,8 @@ def run_tests(clean, build_tests, run_executables, build_dir, run_dir, make_j, # run executables for each test in test list if run_executables: print("Running executables") - # we don't run executables for pfunit tests - for test, attributes in dict(filter(lambda pair: not pair[1]['unit_test'], + # we don't run executables for only pfunit tests + for test, attributes in dict(filter(lambda pair: pair[1]['test_exe'] is not None, test_dict.items())).items(): # prepend parameter file (if required) to argument list args = attributes['other_args'] From ac21898dbbb4d0ef405c01b39b4aa150241d63d7 Mon Sep 17 00:00:00 2001 From: adrifoster Date: Mon, 22 Apr 2024 10:07:51 -0600 Subject: [PATCH 098/176] more clear dictionary key --- functional_unit_testing/run_fates_tests.py | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/functional_unit_testing/run_fates_tests.py b/functional_unit_testing/run_fates_tests.py index ecbddbb094..0884bcf54a 100755 --- a/functional_unit_testing/run_fates_tests.py +++ b/functional_unit_testing/run_fates_tests.py @@ -55,7 +55,7 @@ "test_dir": "fates_allom_test", "test_exe": "FATES_allom_exe", "out_file": "allometry_out.nc", - "unit_test": False, + "has_unit_test": False, "use_param_file": True, "other_args": [], "plotting_function": plot_allometry_dat, @@ -64,7 +64,7 @@ "test_dir": "fates_math_test", "test_exe": "FATES_math_exe", "out_file": "quad_out.nc", - "unit_test": False, + "has_unit_test": False, "use_param_file": False, "other_args": [], "plotting_function": plot_quadratic_dat, From af5cb131d3774493117b766da01d4a2eba4d6cc5 Mon Sep 17 00:00:00 2001 From: adrifoster Date: Mon, 22 Apr 2024 10:26:15 -0600 Subject: [PATCH 099/176] upading dict lambdas --- functional_unit_testing/run_fates_tests.py | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/functional_unit_testing/run_fates_tests.py b/functional_unit_testing/run_fates_tests.py index 0884bcf54a..6bae07e2b3 100755 --- a/functional_unit_testing/run_fates_tests.py +++ b/functional_unit_testing/run_fates_tests.py @@ -185,8 +185,8 @@ def run_tests(clean, build_tests, run_executables, build_dir, run_dir, make_j, if run_executables: print("Running executables") # we don't run executables for only pfunit tests - for test, attributes in dict(filter(lambda pair: pair[1]['test_exe'] is not None, - test_dict.items())).items(): + for attributes in dict(filter(lambda pair: pair[1]['test_exe'] is not None, + test_dict.items())).values(): # prepend parameter file (if required) to argument list args = attributes['other_args'] if attributes['use_param_file']: @@ -371,7 +371,7 @@ def check_build_dir(build_dir, test_dict): Raises: argparse.ArgumentError: Can't find a required build directory or executable """ - for test, attributes in test_dict.items(): + for attributes in test_dict.values(): if not build_exists(build_dir, attributes['test_dir'], attributes['test_exe']): raise argparse.ArgumentError(None, "Build directory or executable does not exist.\n" "Re-run script without --skip-build.") From 0e9867165cf839786f97834ade30962e7c3af221 Mon Sep 17 00:00:00 2001 From: adrifoster Date: Tue, 23 Apr 2024 09:06:07 -0600 Subject: [PATCH 100/176] fix need to call 2 separate registervar subroutines --- .../allometry/FatesTestAllometry.F90 | 33 ++-- .../math_utils/FatesTestMathUtils.F90 | 15 +- unit_test_shr/FatesUnitTestIOMod.F90 | 157 +++++++----------- 3 files changed, 86 insertions(+), 119 deletions(-) diff --git a/functional_unit_testing/allometry/FatesTestAllometry.F90 b/functional_unit_testing/allometry/FatesTestAllometry.F90 index 7ee85b7675..1d0c433d9f 100644 --- a/functional_unit_testing/allometry/FatesTestAllometry.F90 +++ b/functional_unit_testing/allometry/FatesTestAllometry.F90 @@ -52,7 +52,7 @@ subroutine WriteAllometryData(out_file, ndbh, numpft, dbh, height, bagw, blmax, total_biom_parts, total_biom_tissues) use FatesUnitTestIOMod, only : OpenNCFile, RegisterNCDims, CloseNCFile - use FatesUnitTestIOMod, only : RegisterVar1D, WriteVar, RegisterVar2D + use FatesUnitTestIOMod, only : WriteVar, RegisterVar use FatesUnitTestIOMod, only : type_double, type_int use FatesConstantsMod, only : r8 => fates_r8 implicit none @@ -152,7 +152,8 @@ subroutine WriteAllometryData(out_file, numdbh, numpft, dbh, height, bagw, blmax ! use FatesConstantsMod, only : r8 => fates_r8 use FatesUnitTestIOMod, only : OpenNCFile, RegisterNCDims, CloseNCFile - use FatesUnitTestIOMod, only : RegisterVar1D, WriteVar, RegisterVar2D + use FatesUnitTestIOMod, only : WriteVar + use FatesUnitTestIOMod, only : RegisterVar use FatesUnitTestIOMod, only : EndNCDef use FatesUnitTestIOMod, only : type_double, type_int @@ -206,83 +207,83 @@ subroutine WriteAllometryData(out_file, numdbh, numpft, dbh, height, bagw, blmax call RegisterNCDims(ncid, dim_names, (/numdbh, numpft/), 2, dimIDs) ! register dbh - call RegisterVar1D(ncid, dim_names(1), dimIDs(1), type_double, & + call RegisterVar(ncid, dim_names(1), dimIDs(1:1), type_double, & [character(len=20) :: 'units', 'long_name'], & [character(len=150) :: 'cm', 'diameter at breast height'], 2, dbhID) ! register pft - call RegisterVar1D(ncid, dim_names(2), dimIDs(2), type_int, & + call RegisterVar(ncid, dim_names(2), dimIDs(2:2), type_int, & [character(len=20) :: 'units', 'long_name'], & [character(len=150) :: '', 'plant functional type'], 2, pftID) ! register height - call RegisterVar2D(ncid, 'height', dimIDs(1:2), type_double, & + call RegisterVar(ncid, 'height', dimIDs(1:2), type_double, & [character(len=20) :: 'coordinates', 'units', 'long_name'], & [character(len=150) :: 'pft dbh', 'm', 'plant height'], & 3, heightID) ! register aboveground biomass - call RegisterVar2D(ncid, 'bagw', dimIDs(1:2), type_double, & + call RegisterVar(ncid, 'bagw', dimIDs(1:2), type_double, & [character(len=20) :: 'coordinates', 'units', 'long_name'], & [character(len=150) :: 'pft dbh', 'kgC', 'plant aboveground woody biomass'], & 3, bagwID) ! register leaf biomass - call RegisterVar2D(ncid, 'blmax', dimIDs(1:2), type_double, & + call RegisterVar(ncid, 'blmax', dimIDs(1:2), type_double, & [character(len=20) :: 'coordinates', 'units', 'long_name'], & [character(len=150) :: 'pft dbh', 'kgC', 'plant maximum leaf biomass'], & 3, blmaxID) ! register crown area - call RegisterVar2D(ncid, 'crown_area', dimIDs(1:2), type_double, & + call RegisterVar(ncid, 'crown_area', dimIDs(1:2), type_double, & [character(len=20) :: 'coordinates', 'units', 'long_name'], & [character(len=150) :: 'pft dbh', 'm2', 'plant crown area per cohort'], & 3, c_areaID) ! register sapwood area - call RegisterVar2D(ncid, 'sapwood_area', dimIDs(1:2), type_double, & + call RegisterVar(ncid, 'sapwood_area', dimIDs(1:2), type_double, & [character(len=20) :: 'coordinates', 'units', 'long_name'], & [character(len=150) :: 'pft dbh', 'm2', 'plant cross section area sapwood at reference height'], & 3, sapwoodareaID) ! register sapwood biomass - call RegisterVar2D(ncid, 'bsap', dimIDs(1:2), type_double, & + call RegisterVar(ncid, 'bsap', dimIDs(1:2), type_double, & [character(len=20) :: 'coordinates', 'units', 'long_name'], & [character(len=150) :: 'pft dbh', 'kgC', 'plant sapwood biomass'], & 3, bsapID) ! register belowground woody biomass - call RegisterVar2D(ncid, 'bbgw', dimIDs(1:2), type_double, & + call RegisterVar(ncid, 'bbgw', dimIDs(1:2), type_double, & [character(len=20) :: 'coordinates', 'units', 'long_name'], & [character(len=150) :: 'pft dbh', 'kgC', 'plant belowground woody biomass'], & 3, bbgwID) ! register fineroot biomass - call RegisterVar2D(ncid, 'fineroot_biomass', dimIDs(1:2), type_double, & + call RegisterVar(ncid, 'fineroot_biomass', dimIDs(1:2), type_double, & [character(len=20) :: 'coordinates', 'units', 'long_name'], & [character(len=150) :: 'pft dbh', 'kgC', 'plant fineroot biomass'], & 3, finerootID) ! register storage biomass - call RegisterVar2D(ncid, 'bstore', dimIDs(1:2), type_double, & + call RegisterVar(ncid, 'bstore', dimIDs(1:2), type_double, & [character(len=20) :: 'coordinates', 'units', 'long_name'], & [character(len=150) :: 'pft dbh', 'kgC', 'plant storage biomass'], & 3, bstoreID) ! register structural biomass - call RegisterVar2D(ncid, 'bdead', dimIDs(1:2), type_double, & + call RegisterVar(ncid, 'bdead', dimIDs(1:2), type_double, & [character(len=20) :: 'coordinates', 'units', 'long_name'], & [character(len=150) :: 'pft dbh', 'kgC', 'plant deadwood (structural/heartwood) biomass'], & 3, bdeadID) ! register total biomass (parts) - call RegisterVar2D(ncid, 'total_biomass_parts', dimIDs(1:2), type_double, & + call RegisterVar(ncid, 'total_biomass_parts', dimIDs(1:2), type_double, & [character(len=20) :: 'coordinates', 'units', 'long_name'], & [character(len=150) :: 'pft dbh', 'kgC', 'plant total biomass calculated from parts'], & 3, totbiomID1) ! register total biomass (tissues) - call RegisterVar2D(ncid, 'total_biomass_tissues', dimIDs(1:2), type_double, & + call RegisterVar(ncid, 'total_biomass_tissues', dimIDs(1:2), type_double, & [character(len=20) :: 'coordinates', 'units', 'long_name'], & [character(len=150) :: 'pft dbh', 'kgC', 'plant total biomass calculated from tissues'], & 3, totbiomID2) diff --git a/functional_unit_testing/math_utils/FatesTestMathUtils.F90 b/functional_unit_testing/math_utils/FatesTestMathUtils.F90 index f13b888d47..2eae197f57 100644 --- a/functional_unit_testing/math_utils/FatesTestMathUtils.F90 +++ b/functional_unit_testing/math_utils/FatesTestMathUtils.F90 @@ -22,7 +22,7 @@ program FatesTestQuadSolvers subroutine WriteQuadData(out_file, n, a, b, c, root1, root2) use FatesUnitTestIOMod, only : OpenNCFile, RegisterNCDims, CloseNCFile - use FatesUnitTestIOMod, only : RegisterVar1D, WriteVar, RegisterVar2D + use FatesUnitTestIOMod, only : WriteVar, RegisterVar use FatesUnitTestIOMod, only : type_double, type_int use FatesConstantsMod, only : r8 => fates_r8 implicit none @@ -59,7 +59,8 @@ subroutine WriteQuadData(out_file, n, a, b, c, root1, root2) ! use FatesConstantsMod, only : r8 => fates_r8 use FatesUnitTestIOMod, only : OpenNCFile, RegisterNCDims, CloseNCFile - use FatesUnitTestIOMod, only : RegisterVar1D, WriteVar, RegisterVar2D + use FatesUnitTestIOMod, only : WriteVar + use FatesUnitTestIOMod, only : RegisterVar use FatesUnitTestIOMod, only : EndNCDef use FatesUnitTestIOMod, only : type_double, type_int @@ -98,27 +99,27 @@ subroutine WriteQuadData(out_file, n, a, b, c, root1, root2) call RegisterNCDims(ncid, dim_names, (/n/), 1, dimIDs) ! register a - call RegisterVar1D(ncid, 'a', dimIDs(1), type_double, & + call RegisterVar(ncid, 'a', dimIDs(1:1), type_double, & [character(len=20) :: 'units', 'long_name'], & [character(len=150) :: '', 'coefficient a'], 2, aID) ! register b - call RegisterVar1D(ncid, 'b', dimIDs(1), type_double, & + call RegisterVar(ncid, 'b', dimIDs(1:1), type_double, & [character(len=20) :: 'units', 'long_name'], & [character(len=150) :: '', 'coefficient b'], 2, bID) ! register c - call RegisterVar1D(ncid, 'c', dimIDs(1), type_double, & + call RegisterVar(ncid, 'c', dimIDs(1:1), type_double, & [character(len=20) :: 'units', 'long_name'], & [character(len=150) :: '', 'coefficient c'], 2, cID) ! register root1 - call RegisterVar1D(ncid, 'root1', dimIDs(1), type_double, & + call RegisterVar(ncid, 'root1', dimIDs(1:1), type_double, & [character(len=20) :: 'units', 'long_name'], & [character(len=150) :: '', 'root 1'], 2, root1ID) ! register root2 - call RegisterVar1D(ncid, 'root2', dimIDs(1), type_double, & + call RegisterVar(ncid, 'root2', dimIDs(1:1), type_double, & [character(len=20) :: 'units', 'long_name'], & [character(len=150) :: '', 'root 2'], 2, root2ID) diff --git a/unit_test_shr/FatesUnitTestIOMod.F90 b/unit_test_shr/FatesUnitTestIOMod.F90 index d1428ea3ec..c6cccbd11a 100644 --- a/unit_test_shr/FatesUnitTestIOMod.F90 +++ b/unit_test_shr/FatesUnitTestIOMod.F90 @@ -3,12 +3,12 @@ module FatesUnitTestIOMod use FatesGlobals, only : fates_endrun use shr_kind_mod, only : SHR_KIND_CL use netcdf - + implicit none private ! LOCALS - integer, public, parameter :: type_double = 1 ! type + integer, public, parameter :: type_double = 1 ! type integer, public, parameter :: type_int = 2 ! type interface GetVar @@ -28,16 +28,21 @@ module FatesUnitTestIOMod module procedure WriteVar2DInt end interface + ! interface RegisterVar + ! !module procedure RegisterVar1D + ! module procedure RegisterVar_all + ! end interface + public :: OpenNCFile public :: CloseNCFile public :: GetDimID public :: GetDimLen public :: GetVar public :: RegisterNCDims - public :: RegisterVar2D, RegisterVar1D + public :: RegisterVar public :: WriteVar public :: EndNCDef - + contains !======================================================================================= @@ -56,7 +61,7 @@ logical function CheckFile(filename, fmode) character(len=len(filename)) :: fname ! Local filename (trimmed) integer :: ios ! I/O status logical :: file_exists ! Does the file exist? - + ! trim filename of whitespace fname = trim(adjustl(filename)) @@ -65,26 +70,26 @@ logical function CheckFile(filename, fmode) select case (fmode) case('read') - - if (.not. file_exists) then + + if (.not. file_exists) then write(*,'(a,a,a)') "File ", fname(1:len_trim(fname)), " does not exist. Can't read." CheckFile = .false. - else + else CheckFile = .true. end if case('readwrite') CheckFile = .true. - - case('write') - if (file_exists) then + + case('write') + if (file_exists) then write(*, '(a, a, a)') "File ", fname(1:len_trim(fname)), " exists. Cannot open write only." - else + else CheckFile = .true. CheckFile = .false. - end if - case default + end if + case default write(*,'(a)') "Invalid file mode." CheckFile = .false. end select @@ -97,13 +102,13 @@ subroutine Check(status) ! ! DESCRIPTION: ! Checks status of netcdf operations - + ! ARGUMENTS: integer, intent(in) :: status ! return status code from a netcdf procedure - - if (status /= nf90_noerr) then + + if (status /= nf90_noerr) then write(*,*) trim(nf90_strerror(status)) - stop + stop end if end subroutine Check @@ -114,7 +119,7 @@ subroutine OpenNCFile(nc_file, ncid, fmode) ! ! DESCRIPTION: ! Opens a netcdf file - + ! ARGUMENTS: character(len=*), intent(in) :: nc_file ! file name integer, intent(out) :: ncid ! netcdf file unit number @@ -133,10 +138,10 @@ subroutine OpenNCFile(nc_file, ncid, fmode) write(*,*) 'Need to specify read, write, or readwrite' stop end select - else + else write(*,*) 'Problem reading file' stop - end if + end if end subroutine OpenNCFile @@ -146,7 +151,7 @@ subroutine CloseNCFile(ncid) ! ! DESCRIPTION: ! Closes a netcdf file - + ! ARGUMENTS: integer, intent(in) :: ncid ! netcdf file unit number @@ -161,7 +166,7 @@ subroutine GetDimID(ncid, var_name, dim_id) ! DESCRIPTION: ! Gets dimension IDs for a variable ID ! - + ! ARGUMENTS: integer, intent(in) :: ncid ! netcdf file unit number character(len=*), intent(in) :: var_name ! variable name @@ -189,7 +194,7 @@ subroutine GetDimLen(ncid, dim_id, dim_len) end subroutine GetDimLen !======================================================================================= - + subroutine GetDims(ncid, varID, dim_lens) ! ! DESCRIPTION: @@ -206,7 +211,7 @@ subroutine GetDims(ncid, varID, dim_lens) integer, allocatable :: dimIDs(:) ! dimension IDs integer :: i ! looping index - ! find dimensions of data + ! find dimensions of data call Check(nf90_inquire_variable(ncid, varID, ndims=numDims)) ! allocate data to grab dimension information @@ -238,7 +243,7 @@ subroutine GetVarScalarReal(ncid, var_name, data) ! LOCALS: integer :: varID ! variable ID - integer, allocatable :: dim_lens(:) ! dimension lengths + integer, allocatable :: dim_lens(:) ! dimension lengths ! find variable ID first call Check(nf90_inq_varid(ncid, var_name, varID)) @@ -263,7 +268,7 @@ subroutine GetVar1DReal(ncid, var_name, data) ! LOCALS: integer :: varID ! variable ID - integer, allocatable :: dim_lens(:) ! dimension lengths + integer, allocatable :: dim_lens(:) ! dimension lengths ! find variable ID first call Check(nf90_inq_varid(ncid, var_name, varID)) @@ -292,7 +297,7 @@ subroutine GetVar1DInt(ncid, var_name, data) ! LOCALS: integer :: varID ! variable ID - integer, allocatable :: dim_lens(:) ! dimension lengths + integer, allocatable :: dim_lens(:) ! dimension lengths ! find variable ID first call Check(nf90_inq_varid(ncid, var_name, varID)) @@ -321,7 +326,7 @@ subroutine GetVar2DReal(ncid, var_name, data) ! LOCALS: integer :: varID ! variable ID - integer, allocatable :: dim_lens(:) ! dimension lengths + integer, allocatable :: dim_lens(:) ! dimension lengths ! find variable ID first call Check(nf90_inq_varid(ncid, var_name, varID)) @@ -350,7 +355,7 @@ subroutine GetVar2DInt(ncid, var_name, data) ! LOCALS: integer :: varID ! variable ID - integer, allocatable :: dim_lens(:) ! dimension lengths + integer, allocatable :: dim_lens(:) ! dimension lengths ! find variable ID first call Check(nf90_inq_varid(ncid, var_name, varID)) @@ -379,7 +384,7 @@ subroutine GetVar3DReal(ncid, var_name, data) ! LOCALS: integer :: varID ! variable ID - integer, allocatable :: dim_lens(:) ! dimension lengths + integer, allocatable :: dim_lens(:) ! dimension lengths ! find variable ID first call Check(nf90_inq_varid(ncid, var_name, varID)) @@ -408,7 +413,7 @@ subroutine GetVar3DInt(ncid, var_name, data) ! LOCALS: integer :: varID ! variable ID - integer, allocatable :: dim_lens(:) ! dimension lengths + integer, allocatable :: dim_lens(:) ! dimension lengths ! find variable ID first call Check(nf90_inq_varid(ncid, var_name, varID)) @@ -427,10 +432,10 @@ end subroutine GetVar3DInt subroutine RegisterNCDims(ncid, dim_names, dim_lens, num_dims, dim_IDs) ! ! DESCRIPTION: - ! Defines variables and dimensions + ! Defines variables and dimensions ! - ! ARGUMENTS: + ! ARGUMENTS: integer, intent(in) :: ncid ! netcdf file id character(len=*), intent(in) :: dim_names(num_dims) ! dimension names integer, intent(in) :: dim_lens(num_dims) ! dimension lengths @@ -440,27 +445,27 @@ subroutine RegisterNCDims(ncid, dim_names, dim_lens, num_dims, dim_IDs) ! LOCALS: integer :: i ! looping index - do i = 1, num_dims + do i = 1, num_dims call Check(nf90_def_dim(ncid, dim_names(i), dim_lens(i), dim_IDs(i))) - end do + end do end subroutine RegisterNCDims !===================================================================================== - subroutine RegisterVar1D(ncid, var_name, dimID, type, att_names, atts, num_atts, varID) + subroutine RegisterVar(ncid, var_name, dimID, type, att_names, atts, num_atts, varID) ! ! DESCRIPTION: - ! Defines variables and dimensions + ! Defines variables and dimensions ! - ! ARGUMENTS: + ! ARGUMENTS: integer, intent(in) :: ncid ! netcdf file id character(len=*), intent(in) :: var_name ! variable name - integer, intent(in) :: dimID ! dimension ID + integer, intent(in) :: dimID(:) ! dimension IDs integer, intent(in) :: type ! type: int or double character(len=*), intent(in) :: att_names(num_atts) ! attribute names - character(len=*), intent(in) :: atts(num_atts) ! attribute values + character(len=*), intent(in) :: atts(num_atts) ! attribute values integer, intent(in) :: num_atts ! number of attributes integer, intent(out) :: varID ! variable ID @@ -469,62 +474,22 @@ subroutine RegisterVar1D(ncid, var_name, dimID, type, att_names, atts, num_atts, integer :: i ! looping index integer :: nc_type ! netcdf type - if (type == type_double) then + if (type == type_double) then nc_type = NF90_DOUBLE - else if (type == type_int) then + else if (type == type_int) then nc_type = NF90_INT else write(*, *) "Must pick correct type" stop - end if + end if call Check(nf90_def_var(ncid, var_name, nc_type, dimID, varID)) - do i = 1, num_atts + do i = 1, num_atts call Check(nf90_put_att(ncid, varID, att_names(i), atts(i))) end do - - end subroutine RegisterVar1D - - !===================================================================================== - - subroutine RegisterVar2D(ncid, var_name, dimID, type, att_names, atts, num_atts, varID) - ! - ! DESCRIPTION: - ! Defines variables and dimensions - ! - - ! ARGUMENTS: - integer, intent(in) :: ncid ! netcdf file id - character(len=*), intent(in) :: var_name ! variable name - integer, intent(in) :: dimID(1:2) ! dimension ID - integer, intent(in) :: type ! type: int or double - character(len=*), intent(in) :: att_names(num_atts) ! attribute names - character(len=*), intent(in) :: atts(num_atts) ! attribute values - integer, intent(in) :: num_atts ! number of attributes - integer, intent(out) :: varID ! variable ID - - ! LOCALS: - integer :: i ! looping index - integer :: nc_type ! netcdf type - - if (type == type_double) then - nc_type = NF90_DOUBLE - else if (type == type_int) then - nc_type = NF90_INT - else - write(*, *) "Must pick correct type" - stop - end if - - call Check(nf90_def_var(ncid, var_name, nc_type, dimID, varID)) - - do i = 1, num_atts - call Check(nf90_put_att(ncid, varID, att_names(i), atts(i))) - end do - - end subroutine RegisterVar2D + end subroutine RegisterVar ! ===================================================================================== @@ -534,11 +499,11 @@ subroutine EndNCDef(ncid) ! End defining of netcdf dimensions and variables ! - ! ARGUMENTS: + ! ARGUMENTS: integer, intent(in) :: ncid ! netcdf file id call Check(nf90_enddef(ncid)) - + end subroutine EndNCDef ! ===================================================================================== @@ -549,13 +514,13 @@ subroutine WriteVar1DReal(ncid, varID, data) ! Write 1D real data ! - ! ARGUMENTS: + ! ARGUMENTS: integer, intent(in) :: ncid ! netcdf file id integer, intent(in) :: varID ! variable ID real(r8), intent(in) :: data(:) ! data to write call Check(nf90_put_var(ncid, varID, data(:))) - + end subroutine WriteVar1DReal ! ===================================================================================== @@ -566,13 +531,13 @@ subroutine WriteVar2DReal(ncid, varID, data) ! Write 2D real data ! - ! ARGUMENTS: + ! ARGUMENTS: integer, intent(in) :: ncid ! netcdf file id integer, intent(in) :: varID ! variable ID real(r8), intent(in) :: data(:,:) ! data to write call Check(nf90_put_var(ncid, varID, data(:,:))) - + end subroutine WriteVar2DReal ! ===================================================================================== @@ -583,13 +548,13 @@ subroutine WriteVar1DInt(ncid, varID, data) ! Write 1D integer data ! - ! ARGUMENTS: + ! ARGUMENTS: integer, intent(in) :: ncid ! netcdf file id integer, intent(in) :: varID ! variable ID integer, intent(in) :: data(:) ! data to write call Check(nf90_put_var(ncid, varID, data(:))) - + end subroutine WriteVar1DInt ! ===================================================================================== @@ -600,13 +565,13 @@ subroutine WriteVar2DInt(ncid, varID, data) ! Write 2D integer data ! - ! ARGUMENTS: + ! ARGUMENTS: integer, intent(in) :: ncid ! netcdf file id integer, intent(in) :: varID ! variable ID integer, intent(in) :: data(:,:) ! data to write call Check(nf90_put_var(ncid, varID, data(:,:))) - + end subroutine WriteVar2DInt ! ===================================================================================== From b25df0eae4fa384fd5dc885119356d3ba86f23c6 Mon Sep 17 00:00:00 2001 From: adrifoster Date: Tue, 23 Apr 2024 09:26:47 -0600 Subject: [PATCH 101/176] clean up --- .../math_utils/FatesTestMathUtils.F90 | 1 - unit_test_shr/FatesUnitTestIOMod.F90 | 11 +++-------- 2 files changed, 3 insertions(+), 9 deletions(-) diff --git a/functional_unit_testing/math_utils/FatesTestMathUtils.F90 b/functional_unit_testing/math_utils/FatesTestMathUtils.F90 index 2eae197f57..627eb2713b 100644 --- a/functional_unit_testing/math_utils/FatesTestMathUtils.F90 +++ b/functional_unit_testing/math_utils/FatesTestMathUtils.F90 @@ -10,7 +10,6 @@ program FatesTestQuadSolvers integer, parameter :: n = 4 ! number of points to test character(len=*), parameter :: out_file = 'quad_out.nc' ! output file - ! LOCALS: integer :: i ! looping index real(r8) :: a(n), b(n), c(n) ! coefficients for quadratic solvers diff --git a/unit_test_shr/FatesUnitTestIOMod.F90 b/unit_test_shr/FatesUnitTestIOMod.F90 index c6cccbd11a..8f6ea1141a 100644 --- a/unit_test_shr/FatesUnitTestIOMod.F90 +++ b/unit_test_shr/FatesUnitTestIOMod.F90 @@ -1,7 +1,7 @@ module FatesUnitTestIOMod - use FatesConstantsMod, only : r8 => fates_r8 - use FatesGlobals, only : fates_endrun - use shr_kind_mod, only : SHR_KIND_CL + use FatesConstantsMod, only : r8 => fates_r8 + use FatesGlobals, only : fates_endrun + use shr_kind_mod, only : SHR_KIND_CL use netcdf implicit none @@ -28,11 +28,6 @@ module FatesUnitTestIOMod module procedure WriteVar2DInt end interface - ! interface RegisterVar - ! !module procedure RegisterVar1D - ! module procedure RegisterVar_all - ! end interface - public :: OpenNCFile public :: CloseNCFile public :: GetDimID From c611b0d25c2bc610e83ad988bb2cafaad89f62b3 Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Tue, 23 Apr 2024 13:06:18 -0400 Subject: [PATCH 102/176] 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 103/176] 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 104/176] 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 fd80f6ab3b270d8d1bacd734485deeb7d40826e0 Mon Sep 17 00:00:00 2001 From: adrifoster Date: Tue, 30 Apr 2024 10:33:46 -0600 Subject: [PATCH 105/176] trying to fix ldflags --- .../allometry/CMakeLists.txt | 3 ++- .../allometry/FatesTestAllometry.F90 | 1 - .../build_fortran_tests.py | 5 ++-- functional_unit_testing/run_fates_tests.py | 25 +++++++++++++------ 4 files changed, 22 insertions(+), 12 deletions(-) diff --git a/functional_unit_testing/allometry/CMakeLists.txt b/functional_unit_testing/allometry/CMakeLists.txt index 0a48161e49..c2c453e93a 100644 --- a/functional_unit_testing/allometry/CMakeLists.txt +++ b/functional_unit_testing/allometry/CMakeLists.txt @@ -6,13 +6,14 @@ set(NETCDF_FORTRAN_DIR ${NETCDF_F_PATH}) FIND_PATH(NETCDFC_FOUND libnetcdf.a ${NETCDF_C_DIR}/lib) FIND_PATH(NETCDFF_FOUND libnetcdff.a ${NETCDF_FORTRAN_DIR}/lib) + include_directories(${NETCDF_C_DIR}/include ${NETCDF_FORTRAN_DIR}/include) link_directories(${NETCDF_C_DIR}/lib ${NETCDF_FORTRAN_DIR}/lib ${PFUNIT_TOP_DIR}/lib) - + add_executable(FATES_allom_exe ${allom_sources}) target_link_libraries(FATES_allom_exe diff --git a/functional_unit_testing/allometry/FatesTestAllometry.F90 b/functional_unit_testing/allometry/FatesTestAllometry.F90 index 1d0c433d9f..91ee4df2cf 100644 --- a/functional_unit_testing/allometry/FatesTestAllometry.F90 +++ b/functional_unit_testing/allometry/FatesTestAllometry.F90 @@ -288,7 +288,6 @@ subroutine WriteAllometryData(out_file, numdbh, numpft, dbh, height, bagw, blmax [character(len=150) :: 'pft dbh', 'kgC', 'plant total biomass calculated from tissues'], & 3, totbiomID2) - ! finish defining variables call EndNCDef(ncid) diff --git a/functional_unit_testing/build_fortran_tests.py b/functional_unit_testing/build_fortran_tests.py index 0c4cbb535f..7943640f89 100644 --- a/functional_unit_testing/build_fortran_tests.py +++ b/functional_unit_testing/build_fortran_tests.py @@ -216,7 +216,7 @@ def build_exists(build_dir, test_dir, test_exe=None): return True -def build_unit_tests(build_dir, name, cmake_directory, make_j, clean=False): +def build_unit_tests(build_dir, name, cmake_directory, make_j, clean=False, verbose=False): """Build the unit test executables Args: @@ -225,6 +225,7 @@ def build_unit_tests(build_dir, name, cmake_directory, make_j, clean=False): cmake_directory (str): directory where the make CMakeLists.txt file is make_j (int): number of processes to use for make clean (bool, optional): whether or not to clean the build first. Defaults to False. + verbose (bool, optional): whether or not to run make with verbose output. Defaults to False. """ # create the build directory full_build_path = prep_build_dir(build_dir, clean=clean) @@ -245,4 +246,4 @@ def build_unit_tests(build_dir, name, cmake_directory, make_j, clean=False): # run cmake and make run_cmake(name, cmake_directory, pfunit_path, netcdf_c_path, netcdf_f_path, cmake_args) - run_make(name, make_j, clean=clean) + run_make(name, make_j, clean=clean, verbose=verbose) diff --git a/functional_unit_testing/run_fates_tests.py b/functional_unit_testing/run_fates_tests.py index 6bae07e2b3..9c260276ff 100755 --- a/functional_unit_testing/run_fates_tests.py +++ b/functional_unit_testing/run_fates_tests.py @@ -144,12 +144,13 @@ def create_param_file(param_file, run_dir): return param_file_update -def run_tests(clean, build_tests, run_executables, build_dir, run_dir, make_j, - param_file, save_figs, test_dict): +def run_tests(clean, verbose_make, build_tests, run_executables, build_dir, run_dir, + make_j, param_file, save_figs, test_dict): """Builds and runs the fates tests Args: clean (bool): whether or not to clean the build directory + verbose_make (bool): whether or not to run make with verbose output build_tests (bool): whether or not to build the exectuables run_executables (bool): whether or not to run the executables build_dir (str): build directory @@ -179,7 +180,8 @@ def run_tests(clean, build_tests, run_executables, build_dir, run_dir, make_j, # compile code if build_tests: - build_unit_tests(build_dir, _TEST_NAME, _CMAKE_BASE_DIR, make_j, clean=clean) + build_unit_tests(build_dir, _TEST_NAME, _CMAKE_BASE_DIR, make_j, clean=clean, + verbose=verbose_make) # run executables for each test in test list if run_executables: @@ -213,9 +215,7 @@ def out_file_exists(run_dir, out_file): Returns: bool: yes/no file exists in correct location """ - if not os.path.isfile(os.path.join(run_dir, out_file)): - return False - return True + return os.path.isfile(os.path.join(run_dir, out_file)) def parse_test_list(test_string): """Parses the input test list and checks for errors @@ -327,6 +327,12 @@ def commandline_args(): "Will be placed in run_dir/plots.\n" "Should probably do this on remote machines.\n", ) + + parser.add_argument( + "--verbose-make", + action="store_true", + help="Run make with verbose output." + ) parser.add_argument( "-t", @@ -403,6 +409,9 @@ def check_arg_validity(args): # make sure build directory exists if args.skip_build: + if args.verbose_make: + raise argparse.ArgumentError(None, f"Can't run verbose make and skip build.\n" + "Re-run script without --skip-build") check_build_dir(args.build_dir, args.test_dict) # make sure relevant output files exist: @@ -419,8 +428,8 @@ def main(): build = not args.skip_build run = not args.skip_run_executables - run_tests(args.clean, build, run, args.build_dir, args.run_dir, args.make_j, - args.parameter_file, args.save_figs, args.test_dict) + run_tests(args.clean, args.verbose_make, build, run, args.build_dir, args.run_dir, + args.make_j, args.parameter_file, args.save_figs, args.test_dict) if __name__ == "__main__": main() From fb610acf44bae3a0892734f7fab531083d25f29d Mon Sep 17 00:00:00 2001 From: adrifoster Date: Tue, 30 Apr 2024 10:37:30 -0600 Subject: [PATCH 106/176] push cmakelists --- CMakeLists.txt | 16 +++++++++++----- 1 file changed, 11 insertions(+), 5 deletions(-) diff --git a/CMakeLists.txt b/CMakeLists.txt index b8b7b12a08..3961a6780d 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -1,6 +1,15 @@ cmake_minimum_required(VERSION 3.4) list(APPEND CMAKE_MODULE_PATH ${CIME_CMAKE_MODULE_DIRECTORY}) + +FIND_PATH(NETCDFC_FOUND libnetcdf.a ${NETCDF_C_DIR}/lib) +FIND_PATH(NETCDFF_FOUND libnetcdff.a ${NETCDF_FORTRAN_DIR}/lib) +MESSAGE(" NETCDFC_FOUND = ${NETCDFC_FOUND}") +MESSAGE(" NETCDFF_FOUND = ${NETCDFF_FOUND}") + +string(APPEND LDFLAGS " -L${NETCDF_FORTRAN_DIR}/lib -lnetcdff") +string(APPEND LDFLAGS " -L${NETCDF_C_DIR}/lib -lnetcdf") + include(CIME_initial_setup) project(FATES_tests Fortran C) @@ -68,11 +77,6 @@ include_directories(${HLM_ROOT}/share/include) set(NETCDF_C_DIR ${NETCDF_C_PATH}) set(NETCDF_FORTRAN_DIR ${NETCDF_F_PATH}) -FIND_PATH(NETCDFC_FOUND libnetcdf.a ${NETCDF_C_DIR}/lib) -FIND_PATH(NETCDFF_FOUND libnetcdff.a ${NETCDF_FORTRAN_DIR}/lib) -MESSAGE(" NETCDFC_FOUND = ${NETCDFC_FOUND}") -MESSAGE(" NETCDFF_FOUND = ${NETCDFF_FOUND}") - include_directories(${NETCDF_C_DIR}/include ${NETCDF_FORTRAN_DIR}/include) link_directories(${NETCDF_C_DIR}/lib @@ -82,6 +86,8 @@ link_directories(${NETCDF_C_DIR}/lib include_directories(${CMAKE_CURRENT_BINARY_DIR}) link_directories(${CMAKE_CURRENT_BINARY_DIR}) + + # Add the test directories # Note: it's possible that these could be added by each source directory that # has tests in it. However, it appears that the order needs to be done From 5a5dea1102dd64e6b5a00ee3489ddda2d4f67685 Mon Sep 17 00:00:00 2001 From: Charlie Koven Date: Tue, 30 Apr 2024 11:18:01 -0700 Subject: [PATCH 107/176] 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 108/176] 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 109/176] 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 5f79a10ed740822ff56d55071663c268e5d0be1c Mon Sep 17 00:00:00 2001 From: Adrianna Foster Date: Wed, 1 May 2024 10:56:22 -0600 Subject: [PATCH 110/176] Update fire/SFMainMod.F90 Co-authored-by: Charlie Koven --- fire/SFMainMod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/fire/SFMainMod.F90 b/fire/SFMainMod.F90 index b5b9ad0ce6..adc4b63293 100644 --- a/fire/SFMainMod.F90 +++ b/fire/SFMainMod.F90 @@ -75,7 +75,7 @@ module SFMainMod subroutine fire_model(currentSite, bc_in) ! ! DESCRIPTION: - ! Runs the daily fire weather model + ! Runs the daily fire model ! ARGUMENTS: type(ed_site_type), intent(inout), target :: currentSite ! site object From 0538d93fde922ce055459de81859a9f8f2715f06 Mon Sep 17 00:00:00 2001 From: Adrianna Foster Date: Wed, 1 May 2024 10:56:37 -0600 Subject: [PATCH 111/176] Update fire/SFNesterovMod.F90 Co-authored-by: Charlie Koven --- fire/SFNesterovMod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/fire/SFNesterovMod.F90 b/fire/SFNesterovMod.F90 index 860a2ec6f9..a93b956b20 100644 --- a/fire/SFNesterovMod.F90 +++ b/fire/SFNesterovMod.F90 @@ -16,7 +16,7 @@ module SFNesterovMod end type nesterov_index - real(r8), parameter :: min_precip_thresh = 3.0_r8 ! threshold for precipitation above which to 0.0 NI + real(r8), parameter :: min_precip_thresh = 3.0_r8 ! threshold for precipitation above which to zero NI [mm/day] contains From a99035f26e364039ef04b613384a4862b6ee8cc1 Mon Sep 17 00:00:00 2001 From: adrifoster Date: Wed, 1 May 2024 12:02:21 -0600 Subject: [PATCH 112/176] comment updates --- CMakeLists.txt | 3 +++ biogeochem/CMakeLists.txt | 1 + fire/CMakeLists.txt | 1 + radiation/CMakeLists.txt | 2 ++ 4 files changed, 7 insertions(+) diff --git a/CMakeLists.txt b/CMakeLists.txt index 00544cc654..e84fbfb711 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -1,3 +1,6 @@ +# This file helps to build unit test programs to test FATES, but is not used in +# production runs + cmake_minimum_required(VERSION 3.4) list(APPEND CMAKE_MODULE_PATH ${CIME_CMAKE_MODULE_DIRECTORY}) diff --git a/biogeochem/CMakeLists.txt b/biogeochem/CMakeLists.txt index 692e22d9dc..876739a894 100644 --- a/biogeochem/CMakeLists.txt +++ b/biogeochem/CMakeLists.txt @@ -1,3 +1,4 @@ +# This file is required for unit testing, but is not used for production runs list(APPEND fates_sources FatesLitterMod.F90 ) diff --git a/fire/CMakeLists.txt b/fire/CMakeLists.txt index 2cd6b992d1..e0dde25c67 100644 --- a/fire/CMakeLists.txt +++ b/fire/CMakeLists.txt @@ -1,3 +1,4 @@ +# This file is required for unit testing, but is not used for production runs list(APPEND fates_sources SFParamsMod.F90 SFFireWeatherMod.F90 diff --git a/radiation/CMakeLists.txt b/radiation/CMakeLists.txt index 7cb7a324c2..cf092060ea 100644 --- a/radiation/CMakeLists.txt +++ b/radiation/CMakeLists.txt @@ -1,3 +1,5 @@ +# This file is required for unit testing, but is not used for production runs + list(APPEND fates_sources TwoStreamMLPEMod.F90 ) From d864fac68b70cbe2989c0cb3ef63f29c06a39152 Mon Sep 17 00:00:00 2001 From: adrifoster Date: Wed, 1 May 2024 13:50:54 -0600 Subject: [PATCH 113/176] remove dewpoint constants --- fire/SFNesterovMod.F90 | 63 +++++++++++-------- fire/SFParamsMod.F90 | 12 ---- .../fire_weather_test/test_FireWeather.pf | 3 - main/FatesConstantsMod.F90 | 4 ++ parameter_files/fates_params_default.cdl | 10 --- 5 files changed, 40 insertions(+), 52 deletions(-) diff --git a/fire/SFNesterovMod.F90 b/fire/SFNesterovMod.F90 index a93b956b20..85d1d94396 100644 --- a/fire/SFNesterovMod.F90 +++ b/fire/SFNesterovMod.F90 @@ -12,8 +12,7 @@ module SFNesterovMod procedure, public :: Init => init_nesterov_fire_weather procedure, public :: Update => update_nesterov_index - procedure :: calc_nesterov_index - + end type nesterov_index real(r8), parameter :: min_precip_thresh = 3.0_r8 ! threshold for precipitation above which to zero NI [mm/day] @@ -46,50 +45,60 @@ subroutine update_nesterov_index(this, temp_C, precip, rh, wind) real(r8), intent(in) :: precip ! daily precipitation [mm] real(r8), intent(in) :: rh ! daily relative humidity [%] real(r8), intent(in) :: wind ! daily wind speed [m/min] + + ! LOCALS: + real(r8) :: t_dew ! dewpoint temperature [degrees C] if (precip > min_precip_thresh) then ! rezero NI if it rains this%fire_weather_index = 0.0_r8 else + + ! Calculate dewpoint temperature + t_dew = dewpoint(temp_c, rh) + ! Accumulate Nesterov index over fire season. - this%fire_weather_index = this%fire_weather_index + & - this%calc_nesterov_index(temp_C, precip, rh) + this%fire_weather_index = this%fire_weather_index + calc_nesterov_index(temp_C, t_dew) end if end subroutine update_nesterov_index !------------------------------------------------------------------------------------- - real(r8) function calc_nesterov_index(this, temp_C, precip, rh) + real(r8) function calc_nesterov_index(temp_C, t_dew) ! ! DESCRIPTION: ! Calculates current day's Nesterov Index for a given input values - - use SFParamsMod, only : SF_val_fdi_a, SF_val_fdi_b ! ARGUMENTS: - class(nesterov_index), intent(in) :: this ! nesterov index extended class - real(r8), intent(in) :: temp_C ! daily averaged temperature [degrees C] - real(r8), intent(in) :: precip ! daily precipitation [mm] - real(r8), intent(in) :: rh ! daily relative humidity [rh] - - ! LOCALS: - real(r8) :: yipsolon ! intermediate variable for dewpoint calculation - real(r8) :: dewpoint ! dewpoint - - if (precip > min_precip_thresh) then ! NI is 0.0 if it rains - calc_nesterov_index = 0.0_r8 - else - ! Calculate dewpoint temperature - yipsolon = (SF_val_fdi_a*temp_C)/(SF_val_fdi_b + temp_C) + log(max(1.0_r8, rh)/100.0_r8) - dewpoint = (SF_val_fdi_b*yipsolon)/(SF_val_fdi_a - yipsolon) - - ! Nesterov 1968. Eq 5, Thonicke et al. 2010 - calc_nesterov_index = (temp_C - dewpoint)*temp_C - if (calc_nesterov_index < 0.0_r8) calc_nesterov_index = 0.0_r8 ! can't be negative - endif + real(r8), intent(in) :: temp_C ! daily averaged temperature [degrees C] + real(r8), intent(in) :: t_dew ! daily dewpoint temperature [degrees C] + + ! Nesterov 1968. Eq 5, Thonicke et al. 2010 + calc_nesterov_index = (temp_C - t_dew)*temp_C + if (calc_nesterov_index < 0.0_r8) calc_nesterov_index = 0.0_r8 ! can't be negative end function calc_nesterov_index !------------------------------------------------------------------------------------- + + real(r8) function dewpoint(temp_C, rh) + ! + ! DESCRIPTION: + ! Calculates dewpoint from input air temperature and relative humidity + ! Uses Equation 8 from Lawrence 2005, https://doi.org/10.1175/BAMS-86-2-225 + + use FatesConstantsMod, only : dewpoint_a, dewpoint_b + + ! ARGUMENTS + real(r8), intent(in) :: temp_C ! temperature [degrees C] + real(r8), intent(in) :: rh ! relative humidity [%] + + ! LOCALS + real(r8) :: yipsolon ! intermediate value for dewpoint calculation + + yipsolon = log(max(1.0_r8, rh)/100.0_r8) + (dewpoint_a*temp_C)/(dewpoint_b + temp_C) + dewpoint = (dewpoint_b*yipsolon)/(dewpoint_a - yipsolon) + + end function dewpoint end module SFNesterovMod \ No newline at end of file diff --git a/fire/SFParamsMod.F90 b/fire/SFParamsMod.F90 index e07777f25d..5ecd269692 100644 --- a/fire/SFParamsMod.F90 +++ b/fire/SFParamsMod.F90 @@ -18,9 +18,6 @@ module SFParamsMod ! ! this is what the user can use for the actual values ! - - real(r8), public :: SF_val_fdi_a - real(r8), public :: SF_val_fdi_b real(r8),protected, public :: SF_val_fdi_alpha real(r8),protected, public :: SF_val_miner_total real(r8),protected, public :: SF_val_fuel_energy @@ -148,8 +145,6 @@ subroutine SpitFireParamsInit() implicit none - SF_val_fdi_a = nan - SF_val_fdi_b = nan SF_val_fdi_alpha = nan SF_val_miner_total = nan SF_val_fuel_energy = nan @@ -258,13 +253,6 @@ subroutine SpitFireReceiveScalars(fates_params) class(fates_parameters_type), intent(inout) :: fates_params real(r8) :: tmp_real - - - call fates_params%RetrieveParameter(name=SF_name_fdi_a, & - data=SF_val_fdi_a) - - call fates_params%RetrieveParameter(name=SF_name_fdi_b, & - data=SF_val_fdi_b) call fates_params%RetrieveParameter(name=SF_name_fdi_alpha, & data=SF_val_fdi_alpha) diff --git a/fire/test/fire_weather_test/test_FireWeather.pf b/fire/test/fire_weather_test/test_FireWeather.pf index 21338b5f90..c5111394bc 100644 --- a/fire/test/fire_weather_test/test_FireWeather.pf +++ b/fire/test/fire_weather_test/test_FireWeather.pf @@ -6,7 +6,6 @@ module test_FireWeather use FatesConstantsMod, only : r8 => fates_r8 use SFFireWeatherMod, only : fire_weather use SFNesterovMod, only : nesterov_index - use SFParamsMod, only : SF_val_fdi_a, SF_val_fdi_b use funit implicit none @@ -29,8 +28,6 @@ module test_FireWeather class(TestFireWeather), intent(inout) :: this allocate(nesterov_index :: this%fireWeatherNesterov) call this%fireWeatherNesterov%Init() - SF_val_fdi_a = 17.62_r8 - SF_val_fdi_b = 243.12_r8 end subroutine setUp subroutine tearDown(this) diff --git a/main/FatesConstantsMod.F90 b/main/FatesConstantsMod.F90 index 350979b7c4..b531957096 100644 --- a/main/FatesConstantsMod.F90 +++ b/main/FatesConstantsMod.F90 @@ -277,6 +277,10 @@ module FatesConstantsMod real(fates_r8), parameter, public :: J_per_kJ = 1000.0_fates_r8 ! Physical constants + + ! dewpoint calculation + real(fates_r8), parameter, public :: dewpoint_a = 17.62_fates_r8 + real(fates_r8), parameter, public :: dewpoint_b = 243.12_fates_r8 ![degrees C] ! universal gas constant [J/K/kmol] real(fates_r8), parameter, public :: rgas_J_K_kmol = 8314.4598_fates_r8 diff --git a/parameter_files/fates_params_default.cdl b/parameter_files/fates_params_default.cdl index 2eaeb875fe..2a909ee340 100644 --- a/parameter_files/fates_params_default.cdl +++ b/parameter_files/fates_params_default.cdl @@ -732,15 +732,9 @@ variables: 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_a ; - fates_fire_fdi_a:units = "NA" ; - fates_fire_fdi_a:long_name = "spitfire parameter, fire danger index, EQ 5 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_fdi_b ; - fates_fire_fdi_b:units = "NA" ; - fates_fire_fdi_b:long_name = "spitfire parameter, fire danger index, EQ 5 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" ; @@ -1666,12 +1660,8 @@ data: fates_fire_durat_slope = -11.06 ; - fates_fire_fdi_a = 17.62 ; - fates_fire_fdi_alpha = 0.00037 ; - fates_fire_fdi_b = 243.12 ; - fates_fire_fuel_energy = 18000 ; fates_fire_max_durat = 240 ; From b49d1abcd1d29849a49d60aa743e112ebaf23910 Mon Sep 17 00:00:00 2001 From: Adrianna Foster Date: Wed, 1 May 2024 14:46:28 -0600 Subject: [PATCH 114/176] fix need to clean builds --- functional_unit_testing/build_fortran_tests.py | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/functional_unit_testing/build_fortran_tests.py b/functional_unit_testing/build_fortran_tests.py index 7943640f89..b495f25020 100644 --- a/functional_unit_testing/build_fortran_tests.py +++ b/functional_unit_testing/build_fortran_tests.py @@ -131,7 +131,7 @@ def get_extra_cmake_args(build_dir, mpilib): mpilib (str): MPI library name """ # get the machine objects file - machobj = Machines() + machobj = Machines() # this is different? # get compiler compiler = machobj.get_default_compiler() @@ -153,11 +153,11 @@ def get_extra_cmake_args(build_dir, mpilib): os_, unit_testing=True, ) - EnvMachSpecific(build_dir, unit_testing=True) + machspecific = EnvMachSpecific(build_dir, unit_testing=True) # make a fake case - FakeCase(compiler, mpilib, True, "nuopc", threading=False) - + fake_case = FakeCase(compiler, mpilib, True, "nuopc", threading=False) + machspecific.load_env(fake_case) cmake_args_list = [ f"-DOS={os_}", f"-DMACH={machobj.get_machine_name()}", From 5d5d205616ea4471a1896f59d63b0c46fe4686cd Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Wed, 1 May 2024 17:59:41 -0400 Subject: [PATCH 115/176] migrating unit testing to folder unit_testing --- CMakeLists.txt | 6 +++--- .../allometry/CMakeLists.txt | 0 .../allometry/FatesTestAllometry.F90 | 0 .../allometry/allometry_plotting.py | 0 .../build_fortran_tests.py | 0 .../math_utils/CMakeLists.txt | 0 .../math_utils/FatesTestMathUtils.F90 | 0 .../math_utils/math_plotting.py | 0 {functional_unit_testing => unit_testing}/path_utils.py | 0 .../run_fates_tests.py | 0 .../unit_test_shr}/CMakeLists.txt | 0 .../unit_test_shr}/FatesUnitTestIOMod.F90 | 0 .../unit_test_shr}/FatesUnitTestParamReaderMod.F90 | 0 {functional_unit_testing => unit_testing}/utils.py | 0 14 files changed, 3 insertions(+), 3 deletions(-) rename {functional_unit_testing => unit_testing}/allometry/CMakeLists.txt (100%) rename {functional_unit_testing => unit_testing}/allometry/FatesTestAllometry.F90 (100%) rename {functional_unit_testing => unit_testing}/allometry/allometry_plotting.py (100%) rename {functional_unit_testing => unit_testing}/build_fortran_tests.py (100%) rename {functional_unit_testing => unit_testing}/math_utils/CMakeLists.txt (100%) rename {functional_unit_testing => unit_testing}/math_utils/FatesTestMathUtils.F90 (100%) rename {functional_unit_testing => unit_testing}/math_utils/math_plotting.py (100%) rename {functional_unit_testing => unit_testing}/path_utils.py (100%) rename {functional_unit_testing => unit_testing}/run_fates_tests.py (100%) rename {unit_test_shr => unit_testing/unit_test_shr}/CMakeLists.txt (100%) rename {unit_test_shr => unit_testing/unit_test_shr}/FatesUnitTestIOMod.F90 (100%) rename {unit_test_shr => unit_testing/unit_test_shr}/FatesUnitTestParamReaderMod.F90 (100%) rename {functional_unit_testing => unit_testing}/utils.py (100%) diff --git a/CMakeLists.txt b/CMakeLists.txt index 3961a6780d..4b5a8cdc0b 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -29,7 +29,7 @@ add_subdirectory(${HLM_ROOT}/src/fates/biogeophys fates_biogeophys) add_subdirectory(${HLM_ROOT}/src/fates/parteh fates_parteh) add_subdirectory(${HLM_ROOT}/src/fates/fire fates_fire) add_subdirectory(${HLM_ROOT}/src/fates/radiation fates_radiation) -add_subdirectory(${HLM_ROOT}/src/fates/unit_test_shr unit_share) +add_subdirectory(${HLM_ROOT}/src/fates/unit_testing/unit_test_shr unit_share) # Remove shr_mpi_mod from share_sources. # This is needed because we want to use the mock shr_mpi_mod in place of the real one @@ -93,5 +93,5 @@ link_directories(${CMAKE_CURRENT_BINARY_DIR}) # has tests in it. However, it appears that the order needs to be done # carefully: for example, include_directories and link_directories needs to be # done before adding the tests themselves. -add_subdirectory(${HLM_ROOT}/src/fates/functional_unit_testing/allometry fates_allom_test) -add_subdirectory(${HLM_ROOT}/src/fates/functional_unit_testing/math_utils fates_math_test) \ No newline at end of file +add_subdirectory(${HLM_ROOT}/src/fates/unit_testing/allometry fates_allom_test) +add_subdirectory(${HLM_ROOT}/src/fates/unit_testing/math_utils fates_math_test) diff --git a/functional_unit_testing/allometry/CMakeLists.txt b/unit_testing/allometry/CMakeLists.txt similarity index 100% rename from functional_unit_testing/allometry/CMakeLists.txt rename to unit_testing/allometry/CMakeLists.txt diff --git a/functional_unit_testing/allometry/FatesTestAllometry.F90 b/unit_testing/allometry/FatesTestAllometry.F90 similarity index 100% rename from functional_unit_testing/allometry/FatesTestAllometry.F90 rename to unit_testing/allometry/FatesTestAllometry.F90 diff --git a/functional_unit_testing/allometry/allometry_plotting.py b/unit_testing/allometry/allometry_plotting.py similarity index 100% rename from functional_unit_testing/allometry/allometry_plotting.py rename to unit_testing/allometry/allometry_plotting.py diff --git a/functional_unit_testing/build_fortran_tests.py b/unit_testing/build_fortran_tests.py similarity index 100% rename from functional_unit_testing/build_fortran_tests.py rename to unit_testing/build_fortran_tests.py diff --git a/functional_unit_testing/math_utils/CMakeLists.txt b/unit_testing/math_utils/CMakeLists.txt similarity index 100% rename from functional_unit_testing/math_utils/CMakeLists.txt rename to unit_testing/math_utils/CMakeLists.txt diff --git a/functional_unit_testing/math_utils/FatesTestMathUtils.F90 b/unit_testing/math_utils/FatesTestMathUtils.F90 similarity index 100% rename from functional_unit_testing/math_utils/FatesTestMathUtils.F90 rename to unit_testing/math_utils/FatesTestMathUtils.F90 diff --git a/functional_unit_testing/math_utils/math_plotting.py b/unit_testing/math_utils/math_plotting.py similarity index 100% rename from functional_unit_testing/math_utils/math_plotting.py rename to unit_testing/math_utils/math_plotting.py diff --git a/functional_unit_testing/path_utils.py b/unit_testing/path_utils.py similarity index 100% rename from functional_unit_testing/path_utils.py rename to unit_testing/path_utils.py diff --git a/functional_unit_testing/run_fates_tests.py b/unit_testing/run_fates_tests.py similarity index 100% rename from functional_unit_testing/run_fates_tests.py rename to unit_testing/run_fates_tests.py diff --git a/unit_test_shr/CMakeLists.txt b/unit_testing/unit_test_shr/CMakeLists.txt similarity index 100% rename from unit_test_shr/CMakeLists.txt rename to unit_testing/unit_test_shr/CMakeLists.txt diff --git a/unit_test_shr/FatesUnitTestIOMod.F90 b/unit_testing/unit_test_shr/FatesUnitTestIOMod.F90 similarity index 100% rename from unit_test_shr/FatesUnitTestIOMod.F90 rename to unit_testing/unit_test_shr/FatesUnitTestIOMod.F90 diff --git a/unit_test_shr/FatesUnitTestParamReaderMod.F90 b/unit_testing/unit_test_shr/FatesUnitTestParamReaderMod.F90 similarity index 100% rename from unit_test_shr/FatesUnitTestParamReaderMod.F90 rename to unit_testing/unit_test_shr/FatesUnitTestParamReaderMod.F90 diff --git a/functional_unit_testing/utils.py b/unit_testing/utils.py similarity index 100% rename from functional_unit_testing/utils.py rename to unit_testing/utils.py From c348a7dafcdba4f62b7cc26a4bee43826a79c2a9 Mon Sep 17 00:00:00 2001 From: Charlie Koven Date: Thu, 2 May 2024 14:53:54 -0700 Subject: [PATCH 116/176] 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 9775af6ba2a324e9b9c54fcaf3ec384cb8be6d4c Mon Sep 17 00:00:00 2001 From: adrifoster Date: Thu, 2 May 2024 17:18:08 -0600 Subject: [PATCH 117/176] remove old cmakelists --- functional_unit_testing/CMakeLists.txt | 2 -- 1 file changed, 2 deletions(-) delete mode 100644 functional_unit_testing/CMakeLists.txt diff --git a/functional_unit_testing/CMakeLists.txt b/functional_unit_testing/CMakeLists.txt deleted file mode 100644 index 1ab61abfc2..0000000000 --- a/functional_unit_testing/CMakeLists.txt +++ /dev/null @@ -1,2 +0,0 @@ -add_subdirectory(allometry) -add_subdirectory(math_utils) \ No newline at end of file From 1a5c1987ea96c3154807ae57efe53550b298edf9 Mon Sep 17 00:00:00 2001 From: adrifoster Date: Fri, 3 May 2024 09:04:02 -0600 Subject: [PATCH 118/176] fix merge conflict --- fire/SFParamsMod.F90 | 8 -------- 1 file changed, 8 deletions(-) diff --git a/fire/SFParamsMod.F90 b/fire/SFParamsMod.F90 index 5ecd269692..c2dbc3fcd6 100644 --- a/fire/SFParamsMod.F90 +++ b/fire/SFParamsMod.F90 @@ -38,8 +38,6 @@ module SFParamsMod real(r8),protected, public :: SF_val_mid_moisture_Coeff(NFSC) real(r8),protected, public :: SF_val_mid_moisture_Slope(NFSC) - character(len=param_string_length),parameter :: SF_name_fdi_a = "fates_fire_fdi_a" - character(len=param_string_length),parameter :: SF_name_fdi_b = "fates_fire_fdi_b" character(len=param_string_length),parameter :: SF_name_fdi_alpha = "fates_fire_fdi_alpha" character(len=param_string_length),parameter :: SF_name_miner_total = "fates_fire_miner_total" character(len=param_string_length),parameter :: SF_name_fuel_energy = "fates_fire_fuel_energy" @@ -209,12 +207,6 @@ subroutine SpitFireRegisterScalars(fates_params) character(len=param_string_length), parameter :: dim_names_scalar(1) = (/dimension_name_scalar/) - call fates_params%RegisterParameter(name=SF_name_fdi_a, dimension_shape=dimension_shape_scalar, & - dimension_names=dim_names_scalar) - - call fates_params%RegisterParameter(name=SF_name_fdi_b, dimension_shape=dimension_shape_scalar, & - dimension_names=dim_names_scalar) - call fates_params%RegisterParameter(name=SF_name_fdi_alpha, dimension_shape=dimension_shape_scalar, & dimension_names=dim_names_scalar) From f61c792cc795b14fefc5268c2b350b75fa180da7 Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Mon, 6 May 2024 11:30:04 -0400 Subject: [PATCH 119/176] Finally named that constant defining fraction of energy going to photosystem 2 --- biogeophys/FatesPlantRespPhotosynthMod.F90 | 9 +++++++-- 1 file changed, 7 insertions(+), 2 deletions(-) diff --git a/biogeophys/FatesPlantRespPhotosynthMod.F90 b/biogeophys/FatesPlantRespPhotosynthMod.F90 index 0aad6eb977..c5ffac2884 100644 --- a/biogeophys/FatesPlantRespPhotosynthMod.F90 +++ b/biogeophys/FatesPlantRespPhotosynthMod.F90 @@ -1301,6 +1301,11 @@ subroutine LeafLayerPhotosynthesis(f_sun_lsl, & ! in ! Fraction of light absorbed by non-photosynthetic pigments real(r8),parameter :: fnps = 0.15_r8 + ! term accounting that two photons are needed to fully transport a single + ! electron to the thylakoid-membrane-bound NADP reductase (see Farquhar 1980) + ! ie only have the energy enters photosystem 2 + real(r8), parameter :: photon_to_e_nadp = 0.5_r8 + ! For plants with no leaves, a miniscule amount of conductance ! can happen through the stems, at a partial rate of cuticular conductance real(r8),parameter :: stem_cuticle_loss_frac = 0.1_r8 @@ -1372,7 +1377,7 @@ subroutine LeafLayerPhotosynthesis(f_sun_lsl, & ! in if(( laisun_lsl * canopy_area_lsl) > min_la_to_solve)then qabs = parsun_lsl / (laisun_lsl * canopy_area_lsl ) - qabs = qabs * 0.5_r8 * (1._r8 - fnps) * 4.6_r8 + qabs = qabs * photon_to_e_nadp * (1._r8 - fnps) * 4.6_r8 else qabs = 0.0_r8 @@ -1382,7 +1387,7 @@ subroutine LeafLayerPhotosynthesis(f_sun_lsl, & ! in if( (parsha_lsl>nearzero) .and. (laisha_lsl * canopy_area_lsl) > min_la_to_solve ) then qabs = parsha_lsl / (laisha_lsl * canopy_area_lsl) - qabs = qabs * 0.5_r8 * (1._r8 - fnps) * 4.6_r8 + qabs = qabs * photon_to_e_nadp * (1._r8 - fnps) * 4.6_r8 else ! The radiative transfer schemes are imperfect ! they can sometimes generate negative values here From 35cd29786c8abbc3e9fb08da7d048b36370ee736 Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Mon, 6 May 2024 11:35:57 -0400 Subject: [PATCH 120/176] cleaned up description a tad --- biogeophys/FatesPlantRespPhotosynthMod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/biogeophys/FatesPlantRespPhotosynthMod.F90 b/biogeophys/FatesPlantRespPhotosynthMod.F90 index c5ffac2884..482372470b 100644 --- a/biogeophys/FatesPlantRespPhotosynthMod.F90 +++ b/biogeophys/FatesPlantRespPhotosynthMod.F90 @@ -1303,7 +1303,7 @@ subroutine LeafLayerPhotosynthesis(f_sun_lsl, & ! in ! term accounting that two photons are needed to fully transport a single ! electron to the thylakoid-membrane-bound NADP reductase (see Farquhar 1980) - ! ie only have the energy enters photosystem 2 + ! ie only half the energy from a photon enters photosystem 2 real(r8), parameter :: photon_to_e_nadp = 0.5_r8 ! For plants with no leaves, a miniscule amount of conductance From 4a34bd5fe346babff096b23e8b7d595b4399088d Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Mon, 6 May 2024 15:18:49 -0600 Subject: [PATCH 121/176] remove defunct use calls to fire_fdi_a and b --- fire/SFMainMod.F90 | 1 - 1 file changed, 1 deletion(-) diff --git a/fire/SFMainMod.F90 b/fire/SFMainMod.F90 index 2000c45261..f1e7de14ea 100644 --- a/fire/SFMainMod.F90 +++ b/fire/SFMainMod.F90 @@ -115,7 +115,6 @@ subroutine UpdateFireWeather(currentSite, bc_in) ! DESCRIPTION: ! Updates the site's fire weather index - use SFParamsMod, only : SF_val_fdi_a, SF_val_fdi_b use FatesConstantsMod, only : tfrz => t_water_freeze_k_1atm use FatesConstantsMod, only : sec_per_day From d076c0719214d88095ab33db07bb152645a2556e Mon Sep 17 00:00:00 2001 From: Adrianna Foster Date: Mon, 6 May 2024 15:33:13 -0600 Subject: [PATCH 122/176] Update main/EDTypesMod.F90 Co-authored-by: Gregory Lemieux <7565064+glemieux@users.noreply.github.com> --- main/EDTypesMod.F90 | 1 - 1 file changed, 1 deletion(-) diff --git a/main/EDTypesMod.F90 b/main/EDTypesMod.F90 index c3f71d6ff8..9c92871f1f 100644 --- a/main/EDTypesMod.F90 +++ b/main/EDTypesMod.F90 @@ -32,7 +32,6 @@ module EDTypesMod use FatesConstantsMod, only : n_dbh_bins, n_dist_types use shr_log_mod, only : errMsg => shr_log_errMsg use SFFireWeatherMod, only : fire_weather - use SFNesterovMod, only : nesterov_index implicit none private ! By default everything is private From ebdb992051a30b65a51c884549678a4a773b575d Mon Sep 17 00:00:00 2001 From: adrifoster Date: Mon, 6 May 2024 16:01:49 -0600 Subject: [PATCH 123/176] updated directory structure --- CMakeLists.txt | 13 +++---------- testing/CMakeLists.txt | 3 +++ {unit_testing => testing}/build_fortran_tests.py | 0 .../functional_testing}/allometry/CMakeLists.txt | 0 .../allometry/FatesTestAllometry.F90 | 0 .../allometry/allometry_plotting.py | 0 .../functional_testing}/math_utils/CMakeLists.txt | 0 .../math_utils/FatesTestMathUtils.F90 | 0 .../functional_testing}/math_utils/math_plotting.py | 0 {unit_testing => testing}/path_utils.py | 0 {unit_testing => testing}/run_fates_tests.py | 9 +++++---- .../testing_shr}/CMakeLists.txt | 0 .../testing_shr}/FatesUnitTestIOMod.F90 | 0 .../testing_shr}/FatesUnitTestParamReaderMod.F90 | 0 testing/unit_testing/README_unit_testing | 1 + {unit_testing => testing}/utils.py | 0 16 files changed, 12 insertions(+), 14 deletions(-) create mode 100644 testing/CMakeLists.txt rename {unit_testing => testing}/build_fortran_tests.py (100%) rename {unit_testing => testing/functional_testing}/allometry/CMakeLists.txt (100%) rename {unit_testing => testing/functional_testing}/allometry/FatesTestAllometry.F90 (100%) rename {unit_testing => testing/functional_testing}/allometry/allometry_plotting.py (100%) rename {unit_testing => testing/functional_testing}/math_utils/CMakeLists.txt (100%) rename {unit_testing => testing/functional_testing}/math_utils/FatesTestMathUtils.F90 (100%) rename {unit_testing => testing/functional_testing}/math_utils/math_plotting.py (100%) rename {unit_testing => testing}/path_utils.py (100%) rename {unit_testing => testing}/run_fates_tests.py (98%) rename {unit_testing/unit_test_shr => testing/testing_shr}/CMakeLists.txt (100%) rename {unit_testing/unit_test_shr => testing/testing_shr}/FatesUnitTestIOMod.F90 (100%) rename {unit_testing/unit_test_shr => testing/testing_shr}/FatesUnitTestParamReaderMod.F90 (100%) create mode 100644 testing/unit_testing/README_unit_testing rename {unit_testing => testing}/utils.py (100%) diff --git a/CMakeLists.txt b/CMakeLists.txt index 4b5a8cdc0b..9760a39c1d 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -29,7 +29,7 @@ add_subdirectory(${HLM_ROOT}/src/fates/biogeophys fates_biogeophys) add_subdirectory(${HLM_ROOT}/src/fates/parteh fates_parteh) add_subdirectory(${HLM_ROOT}/src/fates/fire fates_fire) add_subdirectory(${HLM_ROOT}/src/fates/radiation fates_radiation) -add_subdirectory(${HLM_ROOT}/src/fates/unit_testing/unit_test_shr unit_share) +add_subdirectory(${HLM_ROOT}/src/fates/testing/testing_shr test_share) # Remove shr_mpi_mod from share_sources. # This is needed because we want to use the mock shr_mpi_mod in place of the real one @@ -86,12 +86,5 @@ link_directories(${NETCDF_C_DIR}/lib include_directories(${CMAKE_CURRENT_BINARY_DIR}) link_directories(${CMAKE_CURRENT_BINARY_DIR}) - - -# Add the test directories -# Note: it's possible that these could be added by each source directory that -# has tests in it. However, it appears that the order needs to be done -# carefully: for example, include_directories and link_directories needs to be -# done before adding the tests themselves. -add_subdirectory(${HLM_ROOT}/src/fates/unit_testing/allometry fates_allom_test) -add_subdirectory(${HLM_ROOT}/src/fates/unit_testing/math_utils fates_math_test) +# Add the main test directory +add_subdirectory(${HLM_ROOT}/src/fates/testing) diff --git a/testing/CMakeLists.txt b/testing/CMakeLists.txt new file mode 100644 index 0000000000..ac3ac02d18 --- /dev/null +++ b/testing/CMakeLists.txt @@ -0,0 +1,3 @@ +# This is where you add specific test directories +add_subdirectory(functional_testing/allometry fates_allom_test) +add_subdirectory(functional_testing/math_utils fates_math_test) \ No newline at end of file diff --git a/unit_testing/build_fortran_tests.py b/testing/build_fortran_tests.py similarity index 100% rename from unit_testing/build_fortran_tests.py rename to testing/build_fortran_tests.py diff --git a/unit_testing/allometry/CMakeLists.txt b/testing/functional_testing/allometry/CMakeLists.txt similarity index 100% rename from unit_testing/allometry/CMakeLists.txt rename to testing/functional_testing/allometry/CMakeLists.txt diff --git a/unit_testing/allometry/FatesTestAllometry.F90 b/testing/functional_testing/allometry/FatesTestAllometry.F90 similarity index 100% rename from unit_testing/allometry/FatesTestAllometry.F90 rename to testing/functional_testing/allometry/FatesTestAllometry.F90 diff --git a/unit_testing/allometry/allometry_plotting.py b/testing/functional_testing/allometry/allometry_plotting.py similarity index 100% rename from unit_testing/allometry/allometry_plotting.py rename to testing/functional_testing/allometry/allometry_plotting.py diff --git a/unit_testing/math_utils/CMakeLists.txt b/testing/functional_testing/math_utils/CMakeLists.txt similarity index 100% rename from unit_testing/math_utils/CMakeLists.txt rename to testing/functional_testing/math_utils/CMakeLists.txt diff --git a/unit_testing/math_utils/FatesTestMathUtils.F90 b/testing/functional_testing/math_utils/FatesTestMathUtils.F90 similarity index 100% rename from unit_testing/math_utils/FatesTestMathUtils.F90 rename to testing/functional_testing/math_utils/FatesTestMathUtils.F90 diff --git a/unit_testing/math_utils/math_plotting.py b/testing/functional_testing/math_utils/math_plotting.py similarity index 100% rename from unit_testing/math_utils/math_plotting.py rename to testing/functional_testing/math_utils/math_plotting.py diff --git a/unit_testing/path_utils.py b/testing/path_utils.py similarity index 100% rename from unit_testing/path_utils.py rename to testing/path_utils.py diff --git a/unit_testing/run_fates_tests.py b/testing/run_fates_tests.py similarity index 98% rename from unit_testing/run_fates_tests.py rename to testing/run_fates_tests.py index 9c260276ff..7a6b8cc296 100755 --- a/unit_testing/run_fates_tests.py +++ b/testing/run_fates_tests.py @@ -32,8 +32,8 @@ from build_fortran_tests import build_unit_tests, build_exists from path_utils import add_cime_lib_to_path from utils import copy_file, create_nc_file -from allometry.allometry_plotting import plot_allometry_dat -from math_utils.math_plotting import plot_quadratic_dat +from functional_testing.allometry.allometry_plotting import plot_allometry_dat +from functional_testing.math_utils.math_plotting import plot_quadratic_dat add_cime_lib_to_path() @@ -42,7 +42,8 @@ # Constants for this script _DEFAULT_CDL_PATH = os.path.abspath("../parameter_files/fates_params_default.cdl") _CMAKE_BASE_DIR = os.path.join(os.path.dirname(os.path.abspath(__file__)), "../") -_TEST_NAME = "fates_unit_tests" +_TEST_NAME = "fates_tests" +_TEST_SUB_DIR = "testing" # Dictionary with needed constants for running the executables and reading in the # output files - developers who add tests should add things here. @@ -83,7 +84,7 @@ def run_fortran_exectuables(build_dir, test_dir, test_exe, run_dir, args): """ # move executable to run directory - exe_path = os.path.join(build_dir, test_dir, test_exe) + exe_path = os.path.join(build_dir, _TEST_SUB_DIR, test_dir, test_exe) copy_file(exe_path, run_dir) # run the executable diff --git a/unit_testing/unit_test_shr/CMakeLists.txt b/testing/testing_shr/CMakeLists.txt similarity index 100% rename from unit_testing/unit_test_shr/CMakeLists.txt rename to testing/testing_shr/CMakeLists.txt diff --git a/unit_testing/unit_test_shr/FatesUnitTestIOMod.F90 b/testing/testing_shr/FatesUnitTestIOMod.F90 similarity index 100% rename from unit_testing/unit_test_shr/FatesUnitTestIOMod.F90 rename to testing/testing_shr/FatesUnitTestIOMod.F90 diff --git a/unit_testing/unit_test_shr/FatesUnitTestParamReaderMod.F90 b/testing/testing_shr/FatesUnitTestParamReaderMod.F90 similarity index 100% rename from unit_testing/unit_test_shr/FatesUnitTestParamReaderMod.F90 rename to testing/testing_shr/FatesUnitTestParamReaderMod.F90 diff --git a/testing/unit_testing/README_unit_testing b/testing/unit_testing/README_unit_testing new file mode 100644 index 0000000000..1df3d0220a --- /dev/null +++ b/testing/unit_testing/README_unit_testing @@ -0,0 +1 @@ +Nothing here yet - but we will put some tests here eventually. \ No newline at end of file diff --git a/unit_testing/utils.py b/testing/utils.py similarity index 100% rename from unit_testing/utils.py rename to testing/utils.py From 5ee5750d93041f2429ccec32a6bd849213012450 Mon Sep 17 00:00:00 2001 From: adrifoster Date: Tue, 7 May 2024 09:16:21 -0600 Subject: [PATCH 124/176] move pfunit test to new testing dir --- CMakeLists.txt | 79 ------------------- fire/test/CMakeLists.txt | 1 - radiation/CMakeLists.txt | 1 + testing/CMakeLists.txt | 9 ++- testing/run_fates_tests.py | 25 +++++- testing/unit_testing/README_unit_testing | 1 - .../fire_weather_test/CMakeLists.txt | 0 .../fire_weather_test/test_FireWeather.pf | 0 8 files changed, 31 insertions(+), 85 deletions(-) delete mode 100644 fire/test/CMakeLists.txt delete mode 100644 testing/unit_testing/README_unit_testing rename {fire/test => testing/unit_testing}/fire_weather_test/CMakeLists.txt (100%) rename {fire/test => testing/unit_testing}/fire_weather_test/test_FireWeather.pf (100%) diff --git a/CMakeLists.txt b/CMakeLists.txt index 063e5ce4f6..9760a39c1d 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -1,4 +1,3 @@ -<<<<<<< HEAD cmake_minimum_required(VERSION 3.4) list(APPEND CMAKE_MODULE_PATH ${CIME_CMAKE_MODULE_DIRECTORY}) @@ -89,81 +88,3 @@ link_directories(${CMAKE_CURRENT_BINARY_DIR}) # Add the main test directory add_subdirectory(${HLM_ROOT}/src/fates/testing) -||||||| e2621983 -======= -# This file helps to build unit test programs to test FATES, but is not used in -# production runs - -cmake_minimum_required(VERSION 3.4) - -list(APPEND CMAKE_MODULE_PATH ${CIME_CMAKE_MODULE_DIRECTORY}) -include(CIME_initial_setup) - -project(FATES_tests Fortran C) - -include(CIME_utils) - -set(HLM_ROOT "../../") - -# Add source directories from other share code (csm_share, etc.) -add_subdirectory(${HLM_ROOT}/share/src csm_share) -add_subdirectory(${HLM_ROOT}/share/unit_test_stubs/util csm_share_stubs) - -# Add FATES source directories -add_subdirectory(${HLM_ROOT}/src/fates/main fates_main) -add_subdirectory(${HLM_ROOT}/src/fates/biogeochem fates_biogeochem) -add_subdirectory(${HLM_ROOT}/src/fates/fire fates_fire) -add_subdirectory(${HLM_ROOT}/src/fates/radiation fates_radiation) - -# Remove shr_mpi_mod from share_sources. -# This is needed because we want to use the mock shr_mpi_mod in place of the real one -# -# TODO: this should be moved into a general-purpose function in Sourcelist_utils. -# Then this block of code could be replaced with a single call, like: -# remove_source_file(${share_sources} "shr_mpi_mod.F90") -foreach (sourcefile ${share_sources}) - string(REGEX MATCH "shr_mpi_mod.F90" match_found ${sourcefile}) - if(match_found) - list(REMOVE_ITEM share_sources ${sourcefile}) - endif() -endforeach() - -# Remove shr_cal_mod from share_sources. -# -# shr_cal_mod depends on ESMF (or the lightweight esmf wrf timemgr, at -# least). Since CTSM doesn't currently use shr_cal_mod, we're avoiding -# the extra overhead of including esmf_wrf_timemgr sources in this -# build. -# -# TODO: like above, this should be moved into a general-purpose function -# in Sourcelist_utils. Then this block of code could be replaced with a -# single call, like: remove_source_file(${share_sources} -# "shr_cal_mod.F90") -foreach (sourcefile ${share_sources}) - string(REGEX MATCH "shr_cal_mod.F90" match_found ${sourcefile}) - if(match_found) - list(REMOVE_ITEM share_sources ${sourcefile}) - endif() -endforeach() - -# Build libraries containing stuff needed for the unit tests. -# Eventually, these add_library calls should probably be distributed into the correct location, rather than being in this top-level CMakeLists.txt file. -add_library(csm_share ${share_sources}) -declare_generated_dependencies(csm_share "${share_genf90_sources}") -add_library(fates ${fates_sources}) -add_dependencies(fates csm_share) - -# We need to look for header files here, in order to pick up shr_assert.h -include_directories(${HLM_ROOT}/share/include) - -# Tell cmake to look for libraries & mod files here, because this is where we built libraries -include_directories(${CMAKE_CURRENT_BINARY_DIR}) -link_directories(${CMAKE_CURRENT_BINARY_DIR}) - -# Add the test directories -# Note: it's possible that these could be added by each source directory that -# has tests in it. However, it appears that the order needs to be done -# carefully: for example, include_directories and link_directories needs to be -# done before adding the tests themselves. -add_subdirectory(${HLM_ROOT}/src/fates/fire/test fates_fire_test) ->>>>>>> main diff --git a/fire/test/CMakeLists.txt b/fire/test/CMakeLists.txt deleted file mode 100644 index 4dcfa244d4..0000000000 --- a/fire/test/CMakeLists.txt +++ /dev/null @@ -1 +0,0 @@ -add_subdirectory(fire_weather_test) \ No newline at end of file diff --git a/radiation/CMakeLists.txt b/radiation/CMakeLists.txt index abd2b99a94..74d625b12d 100644 --- a/radiation/CMakeLists.txt +++ b/radiation/CMakeLists.txt @@ -1,6 +1,7 @@ # This file is required for unit testing, but is not used for production runs list(APPEND fates_sources TwoStreamMLPEMod.F90 + FatesRadiationMemMod.F90 ) sourcelist_to_parent(fates_sources) diff --git a/testing/CMakeLists.txt b/testing/CMakeLists.txt index ac3ac02d18..d59509c73d 100644 --- a/testing/CMakeLists.txt +++ b/testing/CMakeLists.txt @@ -1,3 +1,8 @@ # This is where you add specific test directories -add_subdirectory(functional_testing/allometry fates_allom_test) -add_subdirectory(functional_testing/math_utils fates_math_test) \ No newline at end of file + +## Functional tests +add_subdirectory(functional_testing/allometry fates_allom_ftest) +add_subdirectory(functional_testing/math_utils fates_math_ftest) + +## Unit tests +add_subdirectory(unit_testing/fire_weather_test fates_fire_weather_utest) \ No newline at end of file diff --git a/testing/run_fates_tests.py b/testing/run_fates_tests.py index 7a6b8cc296..6816e034ad 100755 --- a/testing/run_fates_tests.py +++ b/testing/run_fates_tests.py @@ -53,7 +53,7 @@ # command-line argument list _ALL_TESTS_DICT = { "allometry": { - "test_dir": "fates_allom_test", + "test_dir": "fates_allom_ftest", "test_exe": "FATES_allom_exe", "out_file": "allometry_out.nc", "has_unit_test": False, @@ -62,13 +62,22 @@ "plotting_function": plot_allometry_dat, }, "quadratic": { - "test_dir": "fates_math_test", + "test_dir": "fates_math_ftest", "test_exe": "FATES_math_exe", "out_file": "quad_out.nc", "has_unit_test": False, "use_param_file": False, "other_args": [], "plotting_function": plot_quadratic_dat, + }, + "fire_weather":{ + "test_dir": "fates_fire_weather_utest", + "test_exe": None, + "out_file": None, + "has_unit_test": True, + "use_param_file": False, + "other_args": [], + "plotting_function": None, } } @@ -197,6 +206,17 @@ def run_tests(clean, verbose_make, build_tests, run_executables, build_dir, run_ # run run_fortran_exectuables(build_dir_path, attributes['test_dir'], attributes['test_exe'], run_dir_path, args) + + # run unit tests + for test, attributes in dict(filter(lambda pair: pair[1]['has_unit_test'], + test_dict.items())).items(): + print(f"Running unit tests for {test}.") + + test_dir = os.path.join(build_dir_path, _TEST_SUB_DIR, attributes['test_dir']) + ctest_command = ["ctest", "--output-on-failure"] + output = run_cmd_no_fail(" ".join(ctest_command), from_dir=test_dir, + combine_output=True) + print(output) # plot output for relevant tests for test, attributes in dict(filter(lambda pair: pair[1]['plotting_function'] is not None, @@ -204,6 +224,7 @@ def run_tests(clean, verbose_make, build_tests, run_executables, build_dir, run_ attributes['plotting_function'](run_dir_path, attributes['out_file'], save_figs, os.path.join(run_dir_path, 'plots', test)) + # show plots plt.show() def out_file_exists(run_dir, out_file): diff --git a/testing/unit_testing/README_unit_testing b/testing/unit_testing/README_unit_testing deleted file mode 100644 index 1df3d0220a..0000000000 --- a/testing/unit_testing/README_unit_testing +++ /dev/null @@ -1 +0,0 @@ -Nothing here yet - but we will put some tests here eventually. \ No newline at end of file diff --git a/fire/test/fire_weather_test/CMakeLists.txt b/testing/unit_testing/fire_weather_test/CMakeLists.txt similarity index 100% rename from fire/test/fire_weather_test/CMakeLists.txt rename to testing/unit_testing/fire_weather_test/CMakeLists.txt diff --git a/fire/test/fire_weather_test/test_FireWeather.pf b/testing/unit_testing/fire_weather_test/test_FireWeather.pf similarity index 100% rename from fire/test/fire_weather_test/test_FireWeather.pf rename to testing/unit_testing/fire_weather_test/test_FireWeather.pf From 797798df6a792b9b788d6b53428b066c86a11613 Mon Sep 17 00:00:00 2001 From: adrifoster Date: Tue, 7 May 2024 09:17:47 -0600 Subject: [PATCH 125/176] small pylint fix --- testing/run_fates_tests.py | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/testing/run_fates_tests.py b/testing/run_fates_tests.py index 6816e034ad..ea2cf5b0b1 100755 --- a/testing/run_fates_tests.py +++ b/testing/run_fates_tests.py @@ -432,7 +432,7 @@ def check_arg_validity(args): # make sure build directory exists if args.skip_build: if args.verbose_make: - raise argparse.ArgumentError(None, f"Can't run verbose make and skip build.\n" + raise argparse.ArgumentError(None, "Can't run verbose make and skip build.\n" "Re-run script without --skip-build") check_build_dir(args.build_dir, args.test_dict) From 0b415cfb1d4eceb7a1e19946f6c96eab2ef379e1 Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Tue, 7 May 2024 14:27:37 -0700 Subject: [PATCH 126/176] 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 127/176] 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 128/176] 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 e622877a3fd537623d4f3328a8cbe3d01df6d123 Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Wed, 8 May 2024 11:04:43 -0400 Subject: [PATCH 129/176] Added watt to mole conversion and fixed the photon to electron conversion --- biogeophys/FatesPlantRespPhotosynthMod.F90 | 18 ++++++++++-------- 1 file changed, 10 insertions(+), 8 deletions(-) diff --git a/biogeophys/FatesPlantRespPhotosynthMod.F90 b/biogeophys/FatesPlantRespPhotosynthMod.F90 index 482372470b..ffbac10bdd 100644 --- a/biogeophys/FatesPlantRespPhotosynthMod.F90 +++ b/biogeophys/FatesPlantRespPhotosynthMod.F90 @@ -1302,9 +1302,11 @@ subroutine LeafLayerPhotosynthesis(f_sun_lsl, & ! in real(r8),parameter :: fnps = 0.15_r8 ! term accounting that two photons are needed to fully transport a single - ! electron to the thylakoid-membrane-bound NADP reductase (see Farquhar 1980) - ! ie only half the energy from a photon enters photosystem 2 - real(r8), parameter :: photon_to_e_nadp = 0.5_r8 + ! electron in photosystem 2 + real(r8), parameter :: photon_to_e = 0.5_r8 + + ! Unit conversion of w/m2 to umol photons m-2 s-1 + real(r8), parameter :: wm2_to_umolm2s = 4.6_r8 ! For plants with no leaves, a miniscule amount of conductance ! can happen through the stems, at a partial rate of cuticular conductance @@ -1369,7 +1371,7 @@ subroutine LeafLayerPhotosynthesis(f_sun_lsl, & ! in do sunsha = 1,2 ! Electron transport rate for C3 plants. - ! Convert par from W/m2 to umol photons/m**2/s using the factor 4.6 + ! Convert par from W/m2 to umol photons/m**2/s ! Convert from units of par absorbed per unit ground area to par ! absorbed per unit leaf area. @@ -1377,7 +1379,7 @@ subroutine LeafLayerPhotosynthesis(f_sun_lsl, & ! in if(( laisun_lsl * canopy_area_lsl) > min_la_to_solve)then qabs = parsun_lsl / (laisun_lsl * canopy_area_lsl ) - qabs = qabs * photon_to_e_nadp * (1._r8 - fnps) * 4.6_r8 + qabs = qabs * photon_to_e * (1._r8 - fnps) * wm2_to_umolm2s else qabs = 0.0_r8 @@ -1387,7 +1389,7 @@ subroutine LeafLayerPhotosynthesis(f_sun_lsl, & ! in if( (parsha_lsl>nearzero) .and. (laisha_lsl * canopy_area_lsl) > min_la_to_solve ) then qabs = parsha_lsl / (laisha_lsl * canopy_area_lsl) - qabs = qabs * photon_to_e_nadp * (1._r8 - fnps) * 4.6_r8 + qabs = qabs * photon_to_e * (1._r8 - fnps) * wm2_to_umolm2s else ! The radiative transfer schemes are imperfect ! they can sometimes generate negative values here @@ -1443,14 +1445,14 @@ subroutine LeafLayerPhotosynthesis(f_sun_lsl, & ! in if(sunsha == 1)then !sunlit !guard against /0's in the night. if((laisun_lsl * canopy_area_lsl) > 0.0000000001_r8) then - aj = quant_eff(c3c4_path_index) * parsun_lsl * 4.6_r8 + aj = quant_eff(c3c4_path_index) * parsun_lsl * wm2_to_umolm2s !convert from per cohort to per m2 of leaf) aj = aj / (laisun_lsl * canopy_area_lsl) else aj = 0._r8 end if else - aj = quant_eff(c3c4_path_index) * parsha_lsl * 4.6_r8 + aj = quant_eff(c3c4_path_index) * parsha_lsl * wm2_to_umolm2s aj = aj / (laisha_lsl * canopy_area_lsl) end if From 19e0b167c78cdef8fe8366fad05962e1fe65fdda Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Wed, 8 May 2024 09:39:39 -0700 Subject: [PATCH 130/176] 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 131/176] 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 132/176] 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 133/176] 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 805d302143a1c4e78194e07c6751ad7c1d2d5023 Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Thu, 9 May 2024 12:20:36 -0400 Subject: [PATCH 134/176] Added note on quadratic solves for conductance --- biogeophys/FatesPlantRespPhotosynthMod.F90 | 23 ++++++++++++++++++++++ 1 file changed, 23 insertions(+) diff --git a/biogeophys/FatesPlantRespPhotosynthMod.F90 b/biogeophys/FatesPlantRespPhotosynthMod.F90 index ffbac10bdd..f583e6cbff 100644 --- a/biogeophys/FatesPlantRespPhotosynthMod.F90 +++ b/biogeophys/FatesPlantRespPhotosynthMod.F90 @@ -1495,6 +1495,29 @@ subroutine LeafLayerPhotosynthesis(f_sun_lsl, & ! in ! With an <= 0, then gs_mol = stomatal_intercept_btran leaf_co2_ppress = can_co2_ppress- h2o_co2_bl_diffuse_ratio/gb_mol * a_gs * can_press leaf_co2_ppress = max(leaf_co2_ppress,1.e-06_r8) + + ! A note about the use of the quadratic equations for calculating stomatal conductance + ! ------------------------------------------------------------------------------------ + ! These two following models calculate the conductance between the intercellular leaf + ! space and the leaf surface, not the canopy air space. Transport between the leaf + ! surface and the canopy air space is governed by the leaf boundary layer conductance. + ! However, we need to estimate the properties at the surface of the leaf to solve for + ! the stomatal conductance. We do this by using Fick's law (gradient resistance + ! approximation of diffusion). + ! + ! e_s = (e_i g_s + e_c g_b)/(g_b + g_s) + ! + ! The leaf surface humidity (e_s) then becomes an expression of canopy humidity (e_c), + ! intercellular humidity (e_i), boundary layer conductance (g_b) (these are known) + ! and stomatal conductance (g_s) (this is still unknown). This expression is + ! substituted into the stomatal conductance equation. The resulting form of these + ! equations becomes a quadratic. + ! + ! For a detailed explanation, see the FATES technical note, section + ! "1.11 Stomatal Conductance" + ! + ! ------------------------------------------------------------------------------------ + if ( stomatal_model == medlyn_model ) then !stomatal conductance calculated from Medlyn et al. (2011), the numerical & From dc3198b7a58053557b1596953e0d1b08b4b7f6f6 Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Thu, 9 May 2024 12:23:19 -0400 Subject: [PATCH 135/176] Updated text about quadratic solvers --- biogeophys/FatesPlantRespPhotosynthMod.F90 | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/biogeophys/FatesPlantRespPhotosynthMod.F90 b/biogeophys/FatesPlantRespPhotosynthMod.F90 index f583e6cbff..722e25e275 100644 --- a/biogeophys/FatesPlantRespPhotosynthMod.F90 +++ b/biogeophys/FatesPlantRespPhotosynthMod.F90 @@ -1503,11 +1503,13 @@ subroutine LeafLayerPhotosynthesis(f_sun_lsl, & ! in ! surface and the canopy air space is governed by the leaf boundary layer conductance. ! However, we need to estimate the properties at the surface of the leaf to solve for ! the stomatal conductance. We do this by using Fick's law (gradient resistance - ! approximation of diffusion). + ! approximation of diffusion) to estimate the flux of water vapor across the + ! leaf boundary layer, and balancing that with the flux across the stomata. It + ! results in the following equation for leaf surface humidity: ! ! e_s = (e_i g_s + e_c g_b)/(g_b + g_s) ! - ! The leaf surface humidity (e_s) then becomes an expression of canopy humidity (e_c), + ! The leaf surface humidity (e_s) becomes an expression of canopy humidity (e_c), ! intercellular humidity (e_i), boundary layer conductance (g_b) (these are known) ! and stomatal conductance (g_s) (this is still unknown). This expression is ! substituted into the stomatal conductance equation. The resulting form of these From 589c97297aa2b2c587c7eedf9a004eee70125e65 Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Thu, 9 May 2024 15:08:11 -0400 Subject: [PATCH 136/176] updated comment on intercellular e_i --- biogeophys/FatesPlantRespPhotosynthMod.F90 | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/biogeophys/FatesPlantRespPhotosynthMod.F90 b/biogeophys/FatesPlantRespPhotosynthMod.F90 index 722e25e275..4f3df22449 100644 --- a/biogeophys/FatesPlantRespPhotosynthMod.F90 +++ b/biogeophys/FatesPlantRespPhotosynthMod.F90 @@ -1510,10 +1510,10 @@ subroutine LeafLayerPhotosynthesis(f_sun_lsl, & ! in ! e_s = (e_i g_s + e_c g_b)/(g_b + g_s) ! ! The leaf surface humidity (e_s) becomes an expression of canopy humidity (e_c), - ! intercellular humidity (e_i), boundary layer conductance (g_b) (these are known) - ! and stomatal conductance (g_s) (this is still unknown). This expression is - ! substituted into the stomatal conductance equation. The resulting form of these - ! equations becomes a quadratic. + ! intercellular humidity (e_i, which is the saturation humidity at leaf temperature), + ! boundary layer conductance (g_b) (these are all known) and stomatal conductance + ! (g_s) (this is still unknown). This expression is substituted into the stomatal + ! conductance equation. The resulting form of these equations becomes a quadratic. ! ! For a detailed explanation, see the FATES technical note, section ! "1.11 Stomatal Conductance" From 6b4f3f9e62068ae681727202d5ed4f5bcfcc03ef Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Fri, 10 May 2024 17:29:00 -0400 Subject: [PATCH 137/176] Update tools/make_unstruct_grid/MakeUnstructGrid.py Co-authored-by: Gregory Lemieux <7565064+glemieux@users.noreply.github.com> --- tools/make_unstruct_grid/MakeUnstructGrid.py | 2 ++ 1 file changed, 2 insertions(+) diff --git a/tools/make_unstruct_grid/MakeUnstructGrid.py b/tools/make_unstruct_grid/MakeUnstructGrid.py index 159fb92f8b..dfde3d8e03 100644 --- a/tools/make_unstruct_grid/MakeUnstructGrid.py +++ b/tools/make_unstruct_grid/MakeUnstructGrid.py @@ -68,6 +68,8 @@ def TransferData(da_key,ds_base,ds_unst,minis,minjs,dset_type): dtype_out = np.float64 elif(ds_base[da_key].dtype == 'int32'): dtype_out = np.int32 + elif(ds_base[da_key].dtype == 'float32'): + dtype_out = np.float32 else: print('unknown data type: {}.\n Exiting'.format(ds_base[da_key].dtype)) exit(2) From 6080ab6032814c5e70547bcf82cd39a028e5253f Mon Sep 17 00:00:00 2001 From: Charlie Koven Date: Fri, 10 May 2024 16:58:44 -0700 Subject: [PATCH 138/176] 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 139/176] 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 140/176] 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 141/176] 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 142/176] 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 143/176] 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 144/176] 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 1889a9ffb11862eb9cb1ab1ef1c10e07e0ce9eb9 Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Thu, 23 May 2024 16:00:44 -0400 Subject: [PATCH 145/176] Updates and fixes to zeroing and flushing --- main/EDMainMod.F90 | 6 ---- main/FatesHistoryInterfaceMod.F90 | 49 ++++++++++++------------------- main/FatesIOVariableKindMod.F90 | 26 ++++++++++++++-- 3 files changed, 41 insertions(+), 40 deletions(-) diff --git a/main/EDMainMod.F90 b/main/EDMainMod.F90 index 159e942c6a..06e4b74c80 100644 --- a/main/EDMainMod.F90 +++ b/main/EDMainMod.F90 @@ -166,12 +166,6 @@ subroutine ed_ecosystem_dynamics(currentSite, bc_in, bc_out) call currentSite%flux_diags(el)%ZeroFluxDiags() end do - ! zero dynamics (upfreq_in = 1) output history variables - call fates_hist%zero_site_hvars(currentSite,upfreq_in=1) - - ! zero nutrient fluxes (upfreq_in=5) output hist variables - call fates_hist%zero_site_hvars(currentSite,upfreq_in=5) - ! Call a routine that simply identifies if logging should occur ! This is limited to a global event until more structured event handling is enabled call IsItLoggingTime(hlm_masterproc,currentSite) diff --git a/main/FatesHistoryInterfaceMod.F90 b/main/FatesHistoryInterfaceMod.F90 index fdd459f9c3..45cd3b8a3f 100644 --- a/main/FatesHistoryInterfaceMod.F90 +++ b/main/FatesHistoryInterfaceMod.F90 @@ -33,6 +33,7 @@ module FatesHistoryInterfaceMod use FatesIOVariableKindMod , only : group_dyna_simple, group_dyna_complx use FatesIOVariableKindMod , only : group_hifr_simple, group_hifr_complx use FatesIOVariableKindMod , only : group_hydr_simple, group_hydr_complx + use FatesIOVariableKindMod , only : group_nflx_simple, group_nflx_complx use FatesConstantsMod , only : N_DIST_TYPES use FatesConstantsMod , only : dtype_ifall use FatesConstantsMod , only : dtype_ifire @@ -2093,6 +2094,9 @@ subroutine update_history_nutrflux(this,csite) ! history site index io_si = csite%h_gid + ! zero nutrient fluxes + call this%zero_site_hvars(csite,upfreq_in=group_nflx_simple) + cpatch => csite%youngest_patch do while(associated(cpatch)) @@ -2178,10 +2182,11 @@ subroutine update_history_nutrflux(this,csite) if_dynam2: if(hlm_hist_level_dynam>1) then - ! history site index io_si = csite%h_gid + call this%zero_site_hvars(csite,upfreq_in=group_nflx_complx) + cpatch => csite%youngest_patch do while(associated(cpatch)) @@ -2429,6 +2434,8 @@ subroutine update_history_dyn1(this,nc,nsites,sites,bc_in) ! Loop through the FATES scale hierarchy and fill the history IO arrays ! --------------------------------------------------------------------------------- + call this%flush_hvars(nc,upfreq_in=group_dyna_simple) + siteloop: do s = 1,nsites io_si = sites(s)%h_gid @@ -2436,8 +2443,7 @@ subroutine update_history_dyn1(this,nc,nsites,sites,bc_in) site_ba = 0._r8 site_ca = 0._r8 - ! This should be removed from the interface and put here (RGK 04-24) - ! call this%zero_site_hvars(sites(s),upfreq_in=group_dyna_simple) + call this%zero_site_hvars(sites(s),upfreq_in=group_dyna_simple) ! set the fates fraction to one, since it is zero on non-fates columns, & ! the average is the total gridcell fates fraction @@ -3269,10 +3275,14 @@ subroutine update_history_dyn2(this,nc,nsites,sites,bc_in) ! Loop through the FATES scale hierarchy and fill the history IO arrays ! --------------------------------------------------------------------------------- + call this%flush_hvars(nc,upfreq_in=group_dyna_complx) + siteloop: do s = 1,nsites io_si = sites(s)%h_gid + call this%zero_site_hvars(sites(s),upfreq_in=group_dyna_complx) + ! These are weighting factors storen_canopy_scpf(:) = 0._r8 storen_understory_scpf(:) = 0._r8 @@ -3328,7 +3338,6 @@ subroutine update_history_dyn2(this,nc,nsites,sites,bc_in) end if end do - ! Loop through patches to sum up diagonistics ipa = 0 cpatch => sites(s)%oldest_patch @@ -4518,8 +4527,6 @@ subroutine update_history_dyn2(this,nc,nsites,sites,bc_in) ! Diagnostics discretized by element type ! ------------------------------------------------------------------------------ - hio_cwd_elcwd(io_si,:) = 0._r8 - do el = 1, num_elements flux_diags => sites(s)%flux_diags(el) @@ -4529,17 +4536,6 @@ subroutine update_history_dyn2(this,nc,nsites,sites,bc_in) sum(flux_diags%cwd_bg_input(:)) + sum(flux_diags%leaf_litter_input(:)) + & sum(flux_diags%root_litter_input(:))) / m2_per_ha / sec_per_day - hio_cwd_ag_elem(io_si,el) = 0._r8 - hio_cwd_bg_elem(io_si,el) = 0._r8 - hio_fines_ag_elem(io_si,el) = 0._r8 - hio_fines_bg_elem(io_si,el) = 0._r8 - - hio_seed_bank_elem(io_si,el) = 0._r8 - hio_seed_germ_elem(io_si,el) = 0._r8 - hio_seed_decay_elem(io_si,el) = 0._r8 - hio_seeds_in_local_elem(io_si,el) = 0._r8 - hio_seed_in_extern_elem(io_si,el) = 0._r8 - hio_litter_out_elem(io_si,el) = 0._r8 ! Plant multi-element states and fluxes ! Zero states, and set the fluxes @@ -4867,10 +4863,6 @@ subroutine update_history_hifrq1(this,nc,nsites,sites,bc_in,bc_out,dt_tstep) type(fates_cohort_type),pointer :: ccohort - ! This routine is only called for hlm_hist_level_hifrq >= 1 - if(hlm_hist_level_hifrq<1) return - - associate( hio_gpp_si => this%hvars(ih_gpp_si)%r81d, & hio_gpp_secondary_si => this%hvars(ih_gpp_secondary_si)%r81d, & hio_npp_si => this%hvars(ih_npp_si)%r81d, & @@ -4899,9 +4891,8 @@ subroutine update_history_hifrq1(this,nc,nsites,sites,bc_in,bc_out,dt_tstep) hio_tveg => this%hvars(ih_tveg_si)%r81d) - ! Flush the relevant history variables call this%flush_hvars(nc,upfreq_in=group_hifr_simple) - + dt_tstep_inv = 1.0_r8/dt_tstep allocate(age_area_rad(size(ED_val_history_ageclass_bin_edges,1)+1)) @@ -5142,9 +5133,6 @@ subroutine update_history_hifrq2(this,nc,nsites,sites,bc_in,bc_out,dt_tstep) type(fates_cohort_type),pointer :: ccohort real(r8) :: dt_tstep_inv ! Time step in frequency units (/s) - ! This routine is only called for hlm_hist_level_hifrq >= 1 - if(hlm_hist_level_hifrq<2) return - associate( hio_ar_si_scpf => this%hvars(ih_ar_si_scpf)%r82d, & hio_ar_grow_si_scpf => this%hvars(ih_ar_grow_si_scpf)%r82d, & hio_ar_maint_si_scpf => this%hvars(ih_ar_maint_si_scpf)%r82d, & @@ -5187,13 +5175,15 @@ subroutine update_history_hifrq2(this,nc,nsites,sites,bc_in,bc_out,dt_tstep) hio_laisun_si_can => this%hvars(ih_laisun_si_can)%r82d, & hio_laisha_si_can => this%hvars(ih_laisha_si_can)%r82d ) - ! Flush the relevant history variables - call this%flush_hvars(nc,upfreq_in=group_hifr_complx) + call this%flush_hvars(nc,upfreq_in=group_hifr_complx) + dt_tstep_inv = 1.0_r8/dt_tstep do_sites: do s = 1,nsites + call this%zero_site_hvars(sites(s), upfreq_in=group_hifr_complx) + site_area_veg_inv = 0._r8 cpatch => sites(s)%oldest_patch do while(associated(cpatch)) @@ -5617,7 +5607,6 @@ subroutine update_history_hydraulics(this,nc,nsites,sites,bc_in,dt_tstep) if_hifrq0: if(hlm_hist_level_hifrq>0) then - ! Flush the relevant history variables call this%flush_hvars(nc,upfreq_in=group_hydr_simple) associate( hio_h2oveg_hydro_err_si => this%hvars(ih_h2oveg_hydro_err_si)%r81d, & @@ -5810,8 +5799,6 @@ subroutine update_history_hydraulics(this,nc,nsites,sites,bc_in,dt_tstep) hio_rootuptake10_scpf(io_si,iscpf) = site_hydr%rootuptake10_scpf(iscls,ipft) * ha_per_m2 hio_rootuptake50_scpf(io_si,iscpf) = site_hydr%rootuptake50_scpf(iscls,ipft) * ha_per_m2 hio_rootuptake100_scpf(io_si,iscpf) = site_hydr%rootuptake100_scpf(iscls,ipft) * ha_per_m2 - hio_iterh1_scpf(io_si,iscpf) = 0._r8 - hio_iterh2_scpf(io_si,iscpf) = 0._r8 end do end do diff --git a/main/FatesIOVariableKindMod.F90 b/main/FatesIOVariableKindMod.F90 index 61e2c93c9d..75ea7dbe57 100644 --- a/main/FatesIOVariableKindMod.F90 +++ b/main/FatesIOVariableKindMod.F90 @@ -51,16 +51,36 @@ module FatesIOVariableKindMod character(*), parameter, public :: site_elcwd_r8 = 'SI_ELEMCWD_R8' character(*), parameter, public :: site_elage_r8 = 'SI_ELEMAGE_R8' - + ! ------------------------------------------------------------------ + ! + ! History Variable Groups + ! ! These are group indices for output variables. We use ! these groups to do things like zero-ing and initializing - + ! + ! These groups are updated at the dynamics (daily) step + ! so they are turned on and off with dimlevel(2) + ! + ! active when dimlevel(2)>0 integer, parameter, public :: group_dyna_simple = 1 + integer, parameter, public :: group_nflx_simple = 7 + + ! active when dimlevel(2)>1 integer, parameter, public :: group_dyna_complx = 2 + integer, parameter, public :: group_nflx_complx = 8 + + ! These groups are updated at the fast step + ! so they are turned on and off with dimlevel(1) + ! + ! active when dimlevel(1)>0 integer, parameter, public :: group_hifr_simple = 3 - integer, parameter, public :: group_hifr_complx = 4 integer, parameter, public :: group_hydr_simple = 5 + + ! active when dimlevel(1)>1 + integer, parameter, public :: group_hifr_complx = 4 integer, parameter, public :: group_hydr_complx = 6 + + ! ------------------------------------------------------------------- ! NOTE(RGK, 2016) %active is not used yet. Was intended as a check on the HLM->FATES ! control parameter passing to ensure all active dimension types received all From 7d0876d93708a2865b674cb68b4302e132611a35 Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Thu, 23 May 2024 16:16:29 -0400 Subject: [PATCH 146/176] updated the group_nflx_ specifications for the variables --- main/FatesHistoryInterfaceMod.F90 | 40 ++++++++++++++++++------------- 1 file changed, 23 insertions(+), 17 deletions(-) diff --git a/main/FatesHistoryInterfaceMod.F90 b/main/FatesHistoryInterfaceMod.F90 index 45cd3b8a3f..62680890b4 100644 --- a/main/FatesHistoryInterfaceMod.F90 +++ b/main/FatesHistoryInterfaceMod.F90 @@ -2165,7 +2165,9 @@ subroutine update_history_nutrflux(this,csite) ! Demand this%hvars(ih_pdemand_si)%r81d(io_si) = & + this%hvars(ih_pdemand_si)%r81d(io_si) + & ccohort%daily_p_demand*uconv + end select end do @@ -6366,31 +6368,31 @@ subroutine define_history_vars(this, initialize_variables) call this%set_history_var(vname='FATES_NH4UPTAKE', units='kg m-2 s-1', & long='ammonium uptake rate by plants in kg NH4 per m2 per second', & use_default='active', avgflag='A', vtype=site_r8, hlms='CLM:ALM', & - upfreq=group_dyna_simple, ivar=ivar, initialize=initialize_variables, & + upfreq=group_nflx_simple, ivar=ivar, initialize=initialize_variables, & index = ih_nh4uptake_si) call this%set_history_var(vname='FATES_NO3UPTAKE', units='kg m-2 s-1', & long='nitrate uptake rate by plants in kg NO3 per m2 per second', & use_default='active', avgflag='A', vtype=site_r8, hlms='CLM:ALM', & - upfreq=group_dyna_simple, ivar=ivar, initialize=initialize_variables, & + upfreq=group_nflx_simple, ivar=ivar, initialize=initialize_variables, & index = ih_no3uptake_si) call this%set_history_var(vname='FATES_NEFFLUX', units='kg m-2 s-1', & long='nitrogen effluxed from plant in kg N per m2 per second (unused)', & use_default='active', avgflag='A', vtype=site_r8, hlms='CLM:ALM', & - upfreq=group_dyna_simple, ivar=ivar, initialize=initialize_variables, & + upfreq=group_nflx_simple, ivar=ivar, initialize=initialize_variables, & index = ih_nefflux_si) call this%set_history_var(vname='FATES_NDEMAND', units='kg m-2 s-1', & long='plant nitrogen need (algorithm dependent) in kg N per m2 per second', & use_default='active', avgflag='A', vtype=site_r8, hlms='CLM:ALM', & - upfreq=group_dyna_simple, ivar=ivar, initialize=initialize_variables, & + upfreq=group_nflx_simple, ivar=ivar, initialize=initialize_variables, & index = ih_ndemand_si) call this%set_history_var(vname='FATES_NFIX_SYM', units='kg m-2 s-1', & long='symbiotic dinitrogen fixation in kg N per m2 per second', & use_default='active', avgflag='A', vtype=site_r8, hlms='CLM:ALM', & - upfreq=group_dyna_simple, ivar=ivar, initialize=initialize_variables, & + upfreq=group_nflx_simple, ivar=ivar, initialize=initialize_variables, & index = ih_nfix_si) call this%set_history_var(vname='FATES_STOREN', units='kg m-2', & @@ -6475,19 +6477,19 @@ subroutine define_history_vars(this, initialize_variables) call this%set_history_var(vname='FATES_PUPTAKE', units='kg m-2 s-1', & long='mineralized phosphorus uptake rate of plants in kg P per m2 per second', & use_default='active', avgflag='A', vtype=site_r8, hlms='CLM:ALM', & - upfreq=group_dyna_simple, ivar=ivar, initialize=initialize_variables, & + upfreq=group_nflx_simple, ivar=ivar, initialize=initialize_variables, & index = ih_puptake_si) call this%set_history_var(vname='FATES_PEFFLUX', units='kg m-2 s-1', & long='phosphorus effluxed from plant in kg P per m2 per second (unused)', & use_default='active', avgflag='A', vtype=site_r8, hlms='CLM:ALM', & - upfreq=group_dyna_simple, ivar=ivar, initialize=initialize_variables, & + upfreq=group_nflx_simple, ivar=ivar, initialize=initialize_variables, & index = ih_pefflux_si) call this%set_history_var(vname='FATES_PDEMAND', units='kg m-2 s-1', & long='plant phosphorus need (algorithm dependent) in kg P per m2 per second', & use_default='active', avgflag='A', vtype=site_r8, hlms='CLM:ALM', & - upfreq=group_dyna_simple, ivar=ivar, initialize=initialize_variables, & + upfreq=group_nflx_simple, ivar=ivar, initialize=initialize_variables, & index = ih_pdemand_si) end if phosphorus_active_if0 @@ -6583,11 +6585,15 @@ subroutine define_history_vars(this, initialize_variables) avgflag='A', vtype=site_r8, hlms='CLM:ALM', upfreq=group_dyna_simple, & ivar=ivar, initialize=initialize_variables, index = ih_harvest_debt_sec_si ) + ! Nutrient flux variables (dynamics call frequency) + ! ---------------------------------------------------- call this%set_history_var(vname='FATES_EXCESS_RESP', units='kg m-2 s-1', & long='respiration of un-allocatable carbon gain', & use_default='active', avgflag='A', vtype=site_r8, hlms='CLM:ALM', & - upfreq=group_dyna_simple, ivar=ivar, initialize=initialize_variables, & + upfreq=group_nflx_simple, ivar=ivar, initialize=initialize_variables, & index = ih_excess_resp_si) + + ! slow carbon fluxes associated with mortality from or transfer betweeen canopy and understory call this%set_history_var(vname='FATES_DEMOTION_CARBONFLUX', & @@ -7098,32 +7104,32 @@ subroutine define_history_vars(this, initialize_variables) units='kg m-2 s-1', & long='ammonium uptake rate by plants by size-class x pft in kg NH4 per m2 per second', & use_default='inactive', avgflag='A', vtype=site_size_pft_r8, & - hlms='CLM:ALM', upfreq=group_dyna_complx, ivar=ivar, & + hlms='CLM:ALM', upfreq=group_nflx_complx, ivar=ivar, & initialize=initialize_variables, index = ih_nh4uptake_scpf) call this%set_history_var(vname='FATES_NO3UPTAKE_SZPF', & units='kg m-2 s-1', & long='nitrate uptake rate by plants by size-class x pft in kg NO3 per m2 per second', & use_default='inactive', avgflag='A', vtype=site_size_pft_r8, & - hlms='CLM:ALM', upfreq=group_dyna_complx, ivar=ivar, & + hlms='CLM:ALM', upfreq=group_nflx_complx, ivar=ivar, & initialize=initialize_variables, index = ih_no3uptake_scpf) call this%set_history_var(vname='FATES_NEFFLUX_SZPF', units='kg m-2 s-1', & long='nitrogen efflux, root to soil, by size-class x pft in kg N per m2 per second', & use_default='inactive', avgflag='A', vtype=site_size_pft_r8, & - hlms='CLM:ALM', upfreq=group_dyna_complx, ivar=ivar, & + hlms='CLM:ALM', upfreq=group_nflx_complx, ivar=ivar, & initialize=initialize_variables, index = ih_nefflux_scpf) call this%set_history_var(vname='FATES_NDEMAND_SZPF', units='kg m-2 s-1', & long='plant N need (algorithm dependent), by size-class x pft in kg N per m2 per second', & use_default='inactive', avgflag='A', vtype=site_size_pft_r8, & - hlms='CLM:ALM', upfreq=group_dyna_complx, ivar=ivar, & + hlms='CLM:ALM', upfreq=group_nflx_complx, ivar=ivar, & initialize=initialize_variables, index = ih_ndemand_scpf) call this%set_history_var(vname='FATES_NFIX_SYM_SZPF', units='kg m-2 s-1', & long='symbiotic dinitrogen fixation, by size-class x pft in kg N per m2 per second', & use_default='inactive', avgflag='A', vtype=site_size_pft_r8, & - hlms='CLM:ALM', upfreq=group_dyna_complx, ivar=ivar, & + hlms='CLM:ALM', upfreq=group_nflx_complx, ivar=ivar, & initialize=initialize_variables, index = ih_nfix_scpf) call this%set_history_var(vname='FATES_VEGN_SZPF', units='kg m-2', & @@ -7235,20 +7241,20 @@ subroutine define_history_vars(this, initialize_variables) units='kg m-2 s-1', & long='phosphorus uptake rate by plants, by size-class x pft in kg P per m2 per second', & use_default='inactive', avgflag='A', vtype=site_size_pft_r8, & - hlms='CLM:ALM', upfreq=group_dyna_complx, ivar=ivar, & + hlms='CLM:ALM', upfreq=group_nflx_complx, ivar=ivar, & initialize=initialize_variables, index = ih_puptake_scpf) call this%set_history_var(vname='FATES_PEFFLUX_SZPF', & units='kg m-2 s-1', & long='phosphorus efflux, root to soil, by size-class x pft in kg P per m2 per second', & use_default='inactive', avgflag='A', vtype=site_size_pft_r8, & - hlms='CLM:ALM', upfreq=group_dyna_complx, ivar=ivar, & + hlms='CLM:ALM', upfreq=group_nflx_complx, ivar=ivar, & initialize=initialize_variables, index = ih_pefflux_scpf) call this%set_history_var(vname='FATES_PDEMAND_SZPF', units='kg m-2 s-1', & long='plant P need (algorithm dependent), by size-class x pft in kg P per m2 per second', & use_default='inactive', avgflag='A', vtype=site_size_pft_r8, & - hlms='CLM:ALM', upfreq=group_dyna_complx, ivar=ivar, & + hlms='CLM:ALM', upfreq=group_nflx_complx, ivar=ivar, & initialize=initialize_variables, index = ih_pdemand_scpf) end if phosphorus_active_if1 From c82918fb5c25a7d96af77d6aa7884f65854c27da Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Tue, 28 May 2024 12:17:36 -0600 Subject: [PATCH 147/176] Removed unnecessary dynamics flushing --- main/FatesHistoryInterfaceMod.F90 | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/main/FatesHistoryInterfaceMod.F90 b/main/FatesHistoryInterfaceMod.F90 index 62680890b4..8defbcb3dd 100644 --- a/main/FatesHistoryInterfaceMod.F90 +++ b/main/FatesHistoryInterfaceMod.F90 @@ -2436,8 +2436,6 @@ subroutine update_history_dyn1(this,nc,nsites,sites,bc_in) ! Loop through the FATES scale hierarchy and fill the history IO arrays ! --------------------------------------------------------------------------------- - call this%flush_hvars(nc,upfreq_in=group_dyna_simple) - siteloop: do s = 1,nsites io_si = sites(s)%h_gid @@ -3277,7 +3275,6 @@ subroutine update_history_dyn2(this,nc,nsites,sites,bc_in) ! Loop through the FATES scale hierarchy and fill the history IO arrays ! --------------------------------------------------------------------------------- - call this%flush_hvars(nc,upfreq_in=group_dyna_complx) siteloop: do s = 1,nsites @@ -4893,6 +4890,7 @@ subroutine update_history_hifrq1(this,nc,nsites,sites,bc_in,bc_out,dt_tstep) hio_tveg => this%hvars(ih_tveg_si)%r81d) + ! Move this to the interface for consistency (rgk 0524) call this%flush_hvars(nc,upfreq_in=group_hifr_simple) dt_tstep_inv = 1.0_r8/dt_tstep @@ -5178,6 +5176,7 @@ subroutine update_history_hifrq2(this,nc,nsites,sites,bc_in,bc_out,dt_tstep) hio_laisha_si_can => this%hvars(ih_laisha_si_can)%r82d ) + ! Move this to the interface for consistency (rgk 0524) call this%flush_hvars(nc,upfreq_in=group_hifr_complx) dt_tstep_inv = 1.0_r8/dt_tstep @@ -5609,6 +5608,7 @@ subroutine update_history_hydraulics(this,nc,nsites,sites,bc_in,dt_tstep) if_hifrq0: if(hlm_hist_level_hifrq>0) then + ! Move this to the interface for consistency (rgk 0524) call this%flush_hvars(nc,upfreq_in=group_hydr_simple) associate( hio_h2oveg_hydro_err_si => this%hvars(ih_h2oveg_hydro_err_si)%r81d, & @@ -5715,6 +5715,7 @@ subroutine update_history_hydraulics(this,nc,nsites,sites,bc_in,dt_tstep) hio_rootuptake50_scpf => this%hvars(ih_rootuptake50_scpf)%r82d, & hio_rootuptake100_scpf => this%hvars(ih_rootuptake100_scpf)%r82d ) + ! Move this to the interface for consistency (rgk 0524) call this%flush_hvars(nc,upfreq_in=group_hydr_complx) do s = 1,nsites From b9a8f432f24185c59a8524cbff89b781e0c73a7a Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Tue, 28 May 2024 13:23:50 -0600 Subject: [PATCH 148/176] Added flush_all_hvars to be used by interface calls in cold-start and restart sequences --- main/FatesHistoryInterfaceMod.F90 | 36 ++++++++++++++++++++++++++++++- 1 file changed, 35 insertions(+), 1 deletion(-) diff --git a/main/FatesHistoryInterfaceMod.F90 b/main/FatesHistoryInterfaceMod.F90 index 8defbcb3dd..2ea35e2ce8 100644 --- a/main/FatesHistoryInterfaceMod.F90 +++ b/main/FatesHistoryInterfaceMod.F90 @@ -900,7 +900,7 @@ module FatesHistoryInterfaceMod procedure, public :: flush_hvars procedure, public :: zero_site_hvars - + procedure, public :: flush_all_hvars end type fates_history_interface_type @@ -1812,6 +1812,40 @@ subroutine zero_site_hvars(this, currentSite, upfreq_in) return end subroutine zero_site_hvars + + ! ====================================================================================== + + subroutine flush_all_hvars(this,nc) + + ! A wrapper to flush all active history + ! groups to their flush value + + class(fates_history_interface_type) :: this + integer,intent(in) :: nc + + if(hlm_hist_level_hifrq>0) then + call this%flush_hvars(nc,upfreq_in=group_hifr_simple) + if (hlm_use_planthydro.eq.itrue) call this%flush_hvars(nc,upfreq_in=group_hydr_simple) + end if + if(hlm_hist_level_hifrq>1) then + call this%flush_hvars(nc,upfreq_in=group_hifr_complx) + if (hlm_use_planthydro.eq.itrue) call this%flush_hvars(nc,upfreq_in=group_hydr_complx) + end if + end if + end if + + if(hlm_hist_level_dynam>0) then + call this%flush_hvars(nc,upfreq_in=group_dyna_simple) + call this%flush_hvars(nc,upfreq_in=group_nflx_simple) + if(hlm_hist_level_dynam>1) then + call this%flush_hvars(nc,upfreq_in=group_dyna_complx) + call this%flush_hvars(nc,upfreq_in=group_nflx_complx) + end if + end if + + return + end subroutine flush_all_hvars + ! ====================================================================================== subroutine flush_hvars(this,nc,upfreq_in) From 3d799f9e9f61f08959c7c2fcec2e0f800b542040 Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Tue, 28 May 2024 17:53:59 -0600 Subject: [PATCH 149/176] bug fix for history refactors --- main/FatesHistoryInterfaceMod.F90 | 2 -- 1 file changed, 2 deletions(-) diff --git a/main/FatesHistoryInterfaceMod.F90 b/main/FatesHistoryInterfaceMod.F90 index 2ea35e2ce8..fef7cc2cad 100644 --- a/main/FatesHistoryInterfaceMod.F90 +++ b/main/FatesHistoryInterfaceMod.F90 @@ -1826,11 +1826,9 @@ subroutine flush_all_hvars(this,nc) if(hlm_hist_level_hifrq>0) then call this%flush_hvars(nc,upfreq_in=group_hifr_simple) if (hlm_use_planthydro.eq.itrue) call this%flush_hvars(nc,upfreq_in=group_hydr_simple) - end if if(hlm_hist_level_hifrq>1) then call this%flush_hvars(nc,upfreq_in=group_hifr_complx) if (hlm_use_planthydro.eq.itrue) call this%flush_hvars(nc,upfreq_in=group_hydr_complx) - end if end if end if From 9d8f4040a6f7d3f99942111cbbc81b138dc827c0 Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Wed, 29 May 2024 08:30:37 -0600 Subject: [PATCH 150/176] updates to c13 disc --- main/FatesHistoryInterfaceMod.F90 | 19 +++++++++++++------ 1 file changed, 13 insertions(+), 6 deletions(-) diff --git a/main/FatesHistoryInterfaceMod.F90 b/main/FatesHistoryInterfaceMod.F90 index fef7cc2cad..4f345e24f9 100644 --- a/main/FatesHistoryInterfaceMod.F90 +++ b/main/FatesHistoryInterfaceMod.F90 @@ -3069,8 +3069,9 @@ subroutine update_history_dyn2(this,nc,nsites,sites,bc_in) integer :: iscagpft ! size-class x age x pft index integer :: icdpf, icdsc, icdam ! iterators for the crown damage level integer :: i_agefuel ! age x fuel size class index - real(r8) :: gpp_cached ! variable used to cache gpp value in previous time step; for C13 discrimination + real(r8) :: gpp_cached ! gpp from previous timestep, for c13 discrimination real(r8) :: crown_depth ! Depth of the crown [m] + real(r8) :: gpp_cached_scpf(numpft*nlevsclass) ! variable used to cache gpp value in previous time step; for C13 discrimination real(r8) :: storen_canopy_scpf(numpft*nlevsclass) real(r8) :: storen_understory_scpf(numpft*nlevsclass) real(r8) :: storep_canopy_scpf(numpft*nlevsclass) @@ -3312,6 +3313,11 @@ subroutine update_history_dyn2(this,nc,nsites,sites,bc_in) io_si = sites(s)%h_gid + ! C13 will not get b4b restarts on the first day because + ! there is no mechanism to remember the previous day's values + ! through a restart. This should be added with the next refactor + gpp_cached_scpf(:) = hio_gpp_si_scpf(io_si,:) + call this%zero_site_hvars(sites(s),upfreq_in=group_dyna_complx) ! These are weighting factors @@ -3680,9 +3686,6 @@ subroutine update_history_dyn2(this,nc,nsites,sites,bc_in) capf => ccohort%coage_by_pft_class, & cdam => ccohort%crowndamage) - gpp_cached = (hio_gpp_si_scpf(io_si,scpf)) * & - days_per_year * sec_per_day - ! [kgC/m2/s] hio_gpp_si_scpf(io_si,scpf) = hio_gpp_si_scpf(io_si,scpf) + & n_perm2*ccohort%gpp_acc_hold / days_per_year / sec_per_day @@ -3786,12 +3789,16 @@ subroutine update_history_dyn2(this,nc,nsites,sites,bc_in) end if !C13 discrimination - if(gpp_cached + ccohort%gpp_acc_hold > 0.0_r8)then + if(abs(gpp_cached_scpf(scpf)-hlm_hio_ignore_val)>nearzero .and. & + (gpp_cached_scpf(scpf) + ccohort%gpp_acc_hold) > 0.0_r8) then + + gpp_cached = gpp_cached_scpf(scpf)*days_per_year*sec_per_day + hio_c13disc_si_scpf(io_si,scpf) = ((hio_c13disc_si_scpf(io_si,scpf) * gpp_cached) + & (ccohort%c13disc_acc * ccohort%gpp_acc_hold)) / (gpp_cached + ccohort%gpp_acc_hold) else hio_c13disc_si_scpf(io_si,scpf) = 0.0_r8 - endif + end if ! number density [/m2] hio_nplant_si_scpf(io_si,scpf) = hio_nplant_si_scpf(io_si,scpf) + ccohort%n / m2_per_ha From 7a3c437861dffbde2115bbfec2c9dfddb840e911 Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Wed, 29 May 2024 10:15:47 -0600 Subject: [PATCH 151/176] update to cached gpp in c13 disc --- main/EDTypesMod.F90 | 21 +++++++++++++++-- main/FatesHistoryInterfaceMod.F90 | 38 +++++++++++++++++++------------ 2 files changed, 42 insertions(+), 17 deletions(-) diff --git a/main/EDTypesMod.F90 b/main/EDTypesMod.F90 index 9c92871f1f..b482370058 100644 --- a/main/EDTypesMod.F90 +++ b/main/EDTypesMod.F90 @@ -150,8 +150,13 @@ module EDTypesMod type, public :: site_fluxdiags_type ! ---------------------------------------------------------------------------------- - ! Diagnostics for fluxes into the litter pool from plants - ! these fluxes are the total from + ! Diagnostics of fluxes + ! These act as an intermediary to write fluxes to the history + ! file after number densities of plants have changed. They also + ! allow the history flux diagnostics to be rebuilt during restart + ! + ! + ! Litter fluxes are the total from ! (1) turnover from living plants ! (2) mass transfer from non-disturbance inducing mortality events ! (3) mass transfer from disturbance inducing mortality events @@ -162,6 +167,13 @@ module EDTypesMod real(r8) :: cwd_bg_input(1:ncwd) real(r8),allocatable :: leaf_litter_input(:) real(r8),allocatable :: root_litter_input(:) + + ! This variable is slated as to-do, but the fluxdiags type needs + ! to be refactored first. Currently this type is allocated + ! by chemical species (ie C, N or P). GPP is C, but not N or P (RGK 0524) + ! Previous day GPP [kgC/m2/year], partitioned by size x pft + !real(r8),allocatable :: gpp_prev_scpf(:) + contains @@ -464,6 +476,11 @@ subroutine ZeroFluxDiags(this) this%cwd_bg_input(:) = 0._r8 this%leaf_litter_input(:) = 0._r8 this%root_litter_input(:) = 0._r8 + + ! We don't zero gpp_prev_scpf because this is not + ! incremented like others, it is assigned at the end + ! of the daily history write process + return end subroutine ZeroFluxDiags diff --git a/main/FatesHistoryInterfaceMod.F90 b/main/FatesHistoryInterfaceMod.F90 index 4f345e24f9..cf46ac8130 100644 --- a/main/FatesHistoryInterfaceMod.F90 +++ b/main/FatesHistoryInterfaceMod.F90 @@ -3651,16 +3651,16 @@ subroutine update_history_dyn2(this,nc,nsites,sites,bc_in) ! update pft-resolved NPP and GPP fluxes hio_gpp_si_pft(io_si, ft) = hio_gpp_si_pft(io_si, ft) + & - ccohort%gpp_acc_hold * n_perm2 / days_per_year / sec_per_day + ccohort%gpp_acc_hold * n_perm2 / (days_per_year* sec_per_day) hio_npp_si_pft(io_si, ft) = hio_npp_si_pft(io_si, ft) + & - ccohort%npp_acc_hold * n_perm2 / days_per_year / sec_per_day + ccohort%npp_acc_hold * n_perm2 / (days_per_year*sec_per_day) if ( cpatch%land_use_label .eq. secondaryland ) then hio_gpp_sec_si_pft(io_si, ft) = hio_gpp_sec_si_pft(io_si, ft) + & - ccohort%gpp_acc_hold * n_perm2 / days_per_year / sec_per_day + ccohort%gpp_acc_hold * n_perm2 / (days_per_year*sec_per_day) hio_npp_sec_si_pft(io_si, ft) = hio_npp_sec_si_pft(io_si, ft) + & - ccohort%npp_acc_hold * n_perm2 / days_per_year / sec_per_day + ccohort%npp_acc_hold * n_perm2 / (days_per_year*sec_per_day) end if ! Turnover pools [kgC/day] * [day/yr] = [kgC/yr] @@ -3686,32 +3686,40 @@ subroutine update_history_dyn2(this,nc,nsites,sites,bc_in) capf => ccohort%coage_by_pft_class, & cdam => ccohort%crowndamage) - ! [kgC/m2/s] + ! convert [kgC/plant/year] -> [kgC/m2/s] hio_gpp_si_scpf(io_si,scpf) = hio_gpp_si_scpf(io_si,scpf) + & - n_perm2*ccohort%gpp_acc_hold / days_per_year / sec_per_day + n_perm2*ccohort%gpp_acc_hold / (days_per_year*sec_per_day) + hio_npp_totl_si_scpf(io_si,scpf) = hio_npp_totl_si_scpf(io_si,scpf) + & - ccohort%npp_acc_hold * n_perm2 / days_per_year / sec_per_day + ccohort%npp_acc_hold * n_perm2 / (days_per_year*sec_per_day) hio_npp_leaf_si_scpf(io_si,scpf) = hio_npp_leaf_si_scpf(io_si,scpf) + & - leaf_m_net_alloc*n_perm2 / days_per_year / sec_per_day + leaf_m_net_alloc*n_perm2 / (days_per_year*sec_per_day) + hio_npp_fnrt_si_scpf(io_si,scpf) = hio_npp_fnrt_si_scpf(io_si,scpf) + & - fnrt_m_net_alloc*n_perm2 / days_per_year / sec_per_day + fnrt_m_net_alloc*n_perm2 / (days_per_year*sec_per_day) + hio_npp_bgsw_si_scpf(io_si,scpf) = hio_npp_bgsw_si_scpf(io_si,scpf) + & sapw_m_net_alloc*n_perm2*(1._r8-prt_params%allom_agb_frac(ccohort%pft)) / & - days_per_year / sec_per_day + (days_per_year*sec_per_day) + hio_npp_agsw_si_scpf(io_si,scpf) = hio_npp_agsw_si_scpf(io_si,scpf) + & sapw_m_net_alloc*n_perm2*prt_params%allom_agb_frac(ccohort%pft) / & - days_per_year / sec_per_day + (days_per_year*sec_per_day) + hio_npp_bgdw_si_scpf(io_si,scpf) = hio_npp_bgdw_si_scpf(io_si,scpf) + & struct_m_net_alloc*n_perm2*(1._r8-prt_params%allom_agb_frac(ccohort%pft)) / & - days_per_year / sec_per_day + (days_per_year*sec_per_day) + hio_npp_agdw_si_scpf(io_si,scpf) = hio_npp_agdw_si_scpf(io_si,scpf) + & struct_m_net_alloc*n_perm2*prt_params%allom_agb_frac(ccohort%pft) / & - days_per_year / sec_per_day + (days_per_year*sec_per_day) + hio_npp_seed_si_scpf(io_si,scpf) = hio_npp_seed_si_scpf(io_si,scpf) + & - repro_m_net_alloc*n_perm2 / days_per_year / sec_per_day + repro_m_net_alloc*n_perm2 / (days_per_year*sec_per_day) + hio_npp_stor_si_scpf(io_si,scpf) = hio_npp_stor_si_scpf(io_si,scpf) + & - store_m_net_alloc*n_perm2 / days_per_year / sec_per_day + store_m_net_alloc*n_perm2 / (days_per_year*sec_per_day) ! Woody State Variables (basal area growth increment) if ( prt_params%woody(ft) == itrue) then From d38bc5986bd8963642f656b6ed0d04935fcd53b0 Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Wed, 29 May 2024 16:37:45 -0600 Subject: [PATCH 152/176] 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 153/176] 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 154/176] 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 155/176] 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 156/176] 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 e407b81d3c0a9c8a3dede0dcd48df9c6dd3ee4bb Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Mon, 10 Jun 2024 11:57:07 -0600 Subject: [PATCH 157/176] Updated some text --- main/FatesHistoryInterfaceMod.F90 | 12 ++++++++---- 1 file changed, 8 insertions(+), 4 deletions(-) diff --git a/main/FatesHistoryInterfaceMod.F90 b/main/FatesHistoryInterfaceMod.F90 index cf46ac8130..156da135c2 100644 --- a/main/FatesHistoryInterfaceMod.F90 +++ b/main/FatesHistoryInterfaceMod.F90 @@ -4937,7 +4937,8 @@ subroutine update_history_hifrq1(this,nc,nsites,sites,bc_in,bc_out,dt_tstep) hio_tveg => this%hvars(ih_tveg_si)%r81d) - ! Move this to the interface for consistency (rgk 0524) + ! THIS CAN BE REMOVED WHEN BOTH CTSM AND E3SM CALL FLUSH_ALL_HVARS + ! THIS IS NOT A LIABILITY, IT IS JUST REDUNDANT call this%flush_hvars(nc,upfreq_in=group_hifr_simple) dt_tstep_inv = 1.0_r8/dt_tstep @@ -5223,7 +5224,8 @@ subroutine update_history_hifrq2(this,nc,nsites,sites,bc_in,bc_out,dt_tstep) hio_laisha_si_can => this%hvars(ih_laisha_si_can)%r82d ) - ! Move this to the interface for consistency (rgk 0524) + ! THIS CAN BE REMOVED WHEN BOTH CTSM AND E3SM CALL FLUSH_ALL_HVARS + ! THIS IS NOT A LIABILITY, IT IS JUST REDUNDANT call this%flush_hvars(nc,upfreq_in=group_hifr_complx) dt_tstep_inv = 1.0_r8/dt_tstep @@ -5655,7 +5657,8 @@ subroutine update_history_hydraulics(this,nc,nsites,sites,bc_in,dt_tstep) if_hifrq0: if(hlm_hist_level_hifrq>0) then - ! Move this to the interface for consistency (rgk 0524) + ! THIS CAN BE REMOVED WHEN BOTH CTSM AND E3SM CALL FLUSH_ALL_HVARS + ! THIS IS NOT A LIABILITY, IT IS JUST REDUNDANT call this%flush_hvars(nc,upfreq_in=group_hydr_simple) associate( hio_h2oveg_hydro_err_si => this%hvars(ih_h2oveg_hydro_err_si)%r81d, & @@ -5762,7 +5765,8 @@ subroutine update_history_hydraulics(this,nc,nsites,sites,bc_in,dt_tstep) hio_rootuptake50_scpf => this%hvars(ih_rootuptake50_scpf)%r82d, & hio_rootuptake100_scpf => this%hvars(ih_rootuptake100_scpf)%r82d ) - ! Move this to the interface for consistency (rgk 0524) + ! THIS CAN BE REMOVED WHEN BOTH CTSM AND E3SM CALL FLUSH_ALL_HVARS + ! THIS IS NOT A LIABILITY, IT IS JUST REDUNDANT call this%flush_hvars(nc,upfreq_in=group_hydr_complx) do s = 1,nsites From 8d028eb7ea6c2f1f0c67cb4adad988b2422ee955 Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Mon, 10 Jun 2024 11:58:43 -0600 Subject: [PATCH 158/176] removed redundant zero flush in history --- main/FatesHistoryInterfaceMod.F90 | 2 -- 1 file changed, 2 deletions(-) diff --git a/main/FatesHistoryInterfaceMod.F90 b/main/FatesHistoryInterfaceMod.F90 index 156da135c2..6c34f48292 100644 --- a/main/FatesHistoryInterfaceMod.F90 +++ b/main/FatesHistoryInterfaceMod.F90 @@ -5253,8 +5253,6 @@ subroutine update_history_hifrq2(this,nc,nsites,sites,bc_in,bc_out,dt_tstep) patch_area_by_age(1:nlevage) = 0._r8 canopy_area_by_age(1:nlevage) = 0._r8 - call this%zero_site_hvars(sites(s), upfreq_in=group_hifr_complx) - cpatch => sites(s)%oldest_patch do while(associated(cpatch)) From b43cb3a2a96b7761641f59dc0838759819d9220d Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Sun, 23 Jun 2024 23:48:16 -0600 Subject: [PATCH 159/176] 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 160/176] 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 161/176] 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 162/176] 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 163/176] 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 164/176] 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 165/176] 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 166/176] 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 167/176] 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 168/176] 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 169/176] 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 170/176] 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 171/176] 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 172/176] 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. From a2b71d0daa131b2b7da8b78eea3b0d1bfd46a723 Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Mon, 15 Jul 2024 09:40:59 -0700 Subject: [PATCH 173/176] make sure to define state_vector if not in land use mode --- biogeochem/EDPatchDynamicsMod.F90 | 2 ++ 1 file changed, 2 insertions(+) diff --git a/biogeochem/EDPatchDynamicsMod.F90 b/biogeochem/EDPatchDynamicsMod.F90 index 55f7ba1311..586c3a1e3b 100644 --- a/biogeochem/EDPatchDynamicsMod.F90 +++ b/biogeochem/EDPatchDynamicsMod.F90 @@ -325,6 +325,8 @@ subroutine disturbance_rates( site_in, bc_in) 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)) + else + state_vector = current_fates_landuse_state_vector end if currentPatch => site_in%oldest_patch From dfe771cf84a5cc447b8bfb97fa9c2857229e2d06 Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Tue, 23 Jul 2024 11:54:04 -0600 Subject: [PATCH 174/176] initialize the transitions matrix to zero --- main/EDInitMod.F90 | 1 + 1 file changed, 1 insertion(+) diff --git a/main/EDInitMod.F90 b/main/EDInitMod.F90 index ce76ba9017..95da8cbfa8 100644 --- a/main/EDInitMod.F90 +++ b/main/EDInitMod.F90 @@ -276,6 +276,7 @@ subroutine zero_site( site_in ) ! Disturbance rates tracking site_in%primary_land_patchfusion_error = 0.0_r8 site_in%disturbance_rates(:,:,:) = 0.0_r8 + site_in%landuse_transition_matrix(:,:) = 0.0_r8 ! FIRE site_in%FDI = 0.0_r8 ! daily fire danger index (0-1) From 953eb7c2c8f9fdbda5e07587daf0abe1973b4fd8 Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Tue, 13 Aug 2024 11:02:34 -0400 Subject: [PATCH 175/176] Added parameter checking for sapwood allometry 2 and woody pft, removed crown damage code from grass sapwood allometry --- biogeochem/FatesAllometryMod.F90 | 20 +++++--------------- main/EDPftvarcon.F90 | 13 +++++++++++++ 2 files changed, 18 insertions(+), 15 deletions(-) diff --git a/biogeochem/FatesAllometryMod.F90 b/biogeochem/FatesAllometryMod.F90 index d0957ef190..2339df3b1a 100644 --- a/biogeochem/FatesAllometryMod.F90 +++ b/biogeochem/FatesAllometryMod.F90 @@ -1050,21 +1050,11 @@ subroutine bsap_allom(d,ipft,crowndamage,canopy_trim,elongf_stem, sapw_area,bsap call bbgw_allom(d,ipft, elongf_stem,bbgw,dbbgwdd) bsap = bagw + bbgw - ! replicate the crown damage code - ! Do we really need this for grass? I would think this can be helpful for - ! grazing in the future. --XLG - if(crowndamage > 1)then - call GetCrownReduction(crowndamage, crown_reduction) - bsap = elongf_stem * (bsap - (bsap * agb_frac * branch_frac * crown_reduction)) - if(present(dbsapdd))then - dbsapdd = elongf_stem * & - (dbagwdd + dbbgwdd - ((dbagwdd + dbbgwdd) * agb_frac * branch_frac * crown_reduction)) - end if - else - bsap = elongf_stem * bsap - if (present(dbsapdd))then - dbsapdd = elongf_stem * (dbagwdd + dbbgwdd) - end if + ! This is a grass-only functionnal type, no need to run crown-damage effects + + bsap = elongf_stem * bsap + if (present(dbsapdd))then + dbsapdd = elongf_stem * (dbagwdd + dbbgwdd) end if if(present(dbsapdd))then diff --git a/main/EDPftvarcon.F90 b/main/EDPftvarcon.F90 index 8e10ebdcf7..3d91f2f1b9 100644 --- a/main/EDPftvarcon.F90 +++ b/main/EDPftvarcon.F90 @@ -2183,6 +2183,19 @@ subroutine FatesCheckParams(is_master) end if + ! Check to make sure that if a grass sapwood allometry is used, it is not + ! a woody plant. + if ( ( prt_params%allom_smode(ipft)==2 ) .and. (prt_params%woody(ipft)==itrue) ) then + write(fates_log(),*) 'Allometry mode 2 is a mode that is only appropriate' + write(fates_log(),*) 'for a grass functional type. Sapwood allometry is set with' + write(fates_log(),*) 'fates_allom_smode in the parameter file. Woody versus non woody' + write(fates_log(),*) 'plants are set via fates_woody in the parameter file.' + write(fates_log(),*) 'Current settings for pft number: ',ipft + write(fates_log(),*) 'fates_woody: true' + write(fates_log(),*) 'fates_allom_smode: ',prt_params%allom_smode(ipft) + write(fates_log(),*) 'Please correct this discrepancy before re-running. Aborting.' + call endrun(msg=errMsg(sourcefile, __LINE__)) + end if ! Check if fraction of storage to reproduction is between 0-1 ! ---------------------------------------------------------------------------------- From f73999b554ef05517ca7a83569d710998948753d Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Tue, 13 Aug 2024 18:30:00 -0400 Subject: [PATCH 176/176] Reverting changes to the parameter file. Those changes will be added to a later PR --- parameter_files/fates_params_default.cdl | 56 ++++++++++++------------ 1 file changed, 28 insertions(+), 28 deletions(-) diff --git a/parameter_files/fates_params_default.cdl b/parameter_files/fates_params_default.cdl index 036a43cb4f..b66336bbf2 100644 --- a/parameter_files/fates_params_default.cdl +++ b/parameter_files/fates_params_default.cdl @@ -992,55 +992,55 @@ data: 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.001, 0.001, 0.003 ; + 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, 1.6592, 1.6592, 1.3456 ; + 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.248, 1.248, 1.869 ; + 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, -999.9, -999.9, -999.9 ; + 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, 1, - 1, 1 ; + 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, 5, 5, 5 ; + 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.487, -0.487, -0.259 ; + 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.0004, 0.0004, 0.0012 ; + 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.7092, 1.7092, 1.5879 ; + 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.3417, 0.3417, 0.9948 ; + 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.0408, 0.0408, 0.0862 ; + 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.0408, 0.0862 ; + 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.1812, 0.1812, 0.3353 ; + 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.6384, 0.6384, 0.4235 ; + 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, - 20, 20, 30 ; + 0.35, 0.35, 0.35 ; fates_allom_dmode = 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1 ; @@ -1058,21 +1058,21 @@ data: 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, 3, 3, 3 ; + 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, 0.67, 0.67, 1.41 ; + 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, 5, 5, 5 ; + 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, 2, 2, 2 ; + 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 ; @@ -1325,10 +1325,10 @@ data: 495 ; fates_leaf_slamax = 0.0954, 0.0954, 0.0954, 0.0954, 0.0954, 0.0954, 0.012, - 0.03, 0.03, 0.05, 0.05, 0.05 ; + 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.05, 0.05, 0.05 ; + 0.03, 0.03, 0.03, 0.03 ; fates_leaf_stomatal_intercept = 10000, 10000, 10000, 10000, 10000, 10000, 10000, 10000, 10000, 10000, 10000, 40000 ; @@ -1482,7 +1482,7 @@ data: 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.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 ; @@ -1490,14 +1490,14 @@ data: 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, - 0, 0 ; + 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.25, 0.25, - 0.2 ; + 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, - 3, 3, 3 ; + 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 ;