From b3eb3f1f2034c29b2c4eee8a82472f2f876669e9 Mon Sep 17 00:00:00 2001 From: jessica needham Date: Wed, 18 Oct 2023 16:57:30 -0700 Subject: [PATCH 01/13] remove unnecessary columns from inventory init --- main/FatesInventoryInitMod.F90 | 56 ++++++++++------------------------ 1 file changed, 16 insertions(+), 40 deletions(-) diff --git a/main/FatesInventoryInitMod.F90 b/main/FatesInventoryInitMod.F90 index ec099860f1..edfa97cf59 100644 --- a/main/FatesInventoryInitMod.F90 +++ b/main/FatesInventoryInitMod.F90 @@ -16,7 +16,12 @@ module FatesInventoryInitMod ! See: https://github.com/EDmodel/ED2/blob/master/ED/src/io/ed_read_ed10_20_history.f90 ! At the time of writing this ED2 is unlicensed, and only concepts were borrowed with no direct ! code copied. - !----------------------------------------------------------------------------------------------- + ! + ! + ! Update: Jessica Needham October 2023 + ! As discussed in FATES issue #1062 we decided to remove columns not used in FATES from the + ! PSS and CSS files. + !----------------------------------------------------------------------------------------------- ! CIME GLOBALS @@ -744,14 +749,6 @@ subroutine set_inventory_edpatch_type1(newpatch,pss_file_unit,ipa,ios,patch_name ! trk (integer) LU type index (0 non-forest, 1 secondary, 2 primary ! age (years) Time since this patch was disturbed (created) ! area (fraction) Fraction of the site occupied by this patch - ! water (NA) Water content of soil (NOT USED) - ! fsc (kg/m2) Fast Soil Carbon - ! stsc (kg/m2) Structural Soil Carbon - ! stsl (kg/m2) Structural Soil Lignin - ! ssc (kg/m2) Slow Soil Carbon - ! psc (NA) Passive Soil Carbon (NOT USED) - ! msn (kg/m2) Mineralized Soil Nitrogen - ! fsn (kg/m2) Fast Soil Nitrogen ! -------------------------------------------------------------------------------------------- use FatesSizeAgeTypeIndicesMod, only: get_age_class_index @@ -772,14 +769,6 @@ subroutine set_inventory_edpatch_type1(newpatch,pss_file_unit,ipa,ios,patch_name 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] - real(r8) :: p_water ! Patch water (unused) - real(r8) :: p_fsc ! Patch fast soil carbon - real(r8) :: p_stsc ! Patch structural soil carbon - real(r8) :: p_stsl ! Patch structural soil lignins - real(r8) :: p_ssc ! Patch slow soil carbon - real(r8) :: p_psc ! Patch P soil carbon - real(r8) :: p_msn ! Patch mean soil nitrogen - real(r8) :: p_fsn ! Patch fast soil nitrogen integer :: icwd ! index for counting CWD pools integer :: ipft ! index for counting PFTs real(r8) :: pftfrac ! the inverse of the total number of PFTs @@ -788,9 +777,7 @@ subroutine set_inventory_edpatch_type1(newpatch,pss_file_unit,ipa,ios,patch_name '(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)' - read(pss_file_unit,fmt=*,iostat=ios) p_time, p_name, p_trk, p_age, p_area, & - p_water,p_fsc, p_stsc, p_stsl, p_ssc, & - p_psc, p_msn, p_fsn + read(pss_file_unit,fmt=*,iostat=ios) p_time, p_name, p_trk, p_age, p_area if (ios/=0) return @@ -798,9 +785,7 @@ subroutine set_inventory_edpatch_type1(newpatch,pss_file_unit,ipa,ios,patch_name if( debug_inv) then write(*,fmt=wr_fmt) & - p_time, p_name, p_trk, p_age, p_area, & - p_water,p_fsc, p_stsc, p_stsl, p_ssc, & - p_psc, p_msn, p_fsn + p_time, p_name, p_trk, p_age, p_area end if ! Fill in the patch's memory structures @@ -859,12 +844,8 @@ subroutine set_inventory_edcohort_type1(csite,bc_in,css_file_unit,npatches, & ! patch (string) patch id string associated with this cohort ! index (integer) cohort index ! dbh (cm) diameter at breast height - ! height (m) height of the tree - ! pft (integer) the plant functional type index (must be consistent with param file) + ! pft (integer) the plant functional type index (must be consistent with param file) ! n (/m2) The plant number density - ! bdead (kgC/plant)The dead biomass per indiv of this cohort (NOT USED) - ! balive (kgC/plant)The live biomass per indiv of this cohort (NOT USED) - ! avgRG (cm/yr?) Average Radial Growth (NOT USED) ! -------------------------------------------------------------------------------------------- use FatesAllometryMod , only : h_allom @@ -895,12 +876,8 @@ subroutine set_inventory_edcohort_type1(csite,bc_in,css_file_unit,npatches, & character(len=patchname_strlen) :: p_name ! The patch associated with this cohort character(len=cohortname_strlen) :: c_name ! cohort index real(r8) :: c_dbh ! diameter at breast height (cm) - real(r8) :: c_height ! tree height (m) integer :: c_pft ! plant functional type index real(r8) :: c_nplant ! plant density (/m2) - real(r8) :: c_bdead ! dead biomass (kg) - real(r8) :: c_balive ! live biomass (kg) - real(r8) :: c_avgRG ! avg radial growth (NOT USED) real(r8) :: site_spread ! initial guess of site spread ! should be quickly re-calculated integer,parameter :: rstatus = 0 ! recruit status @@ -938,13 +915,12 @@ subroutine set_inventory_edcohort_type1(csite,bc_in,css_file_unit,npatches, & integer, parameter :: recruitstatus = 0 - read(css_file_unit,fmt=*,iostat=ios) c_time, p_name, c_name, c_dbh, c_height, & - c_pft, c_nplant, c_bdead, c_balive, c_avgRG + read(css_file_unit,fmt=*,iostat=ios) c_time, p_name, c_name, c_dbh, & + c_pft, c_nplant if( debug_inv) then write(*,fmt=wr_fmt) & - c_time, p_name, c_name, c_dbh, c_height, & - c_pft, c_nplant, c_bdead, c_balive, c_avgRG + c_time, p_name, c_name, c_dbh, c_pft, c_nplant end if if (ios/=0) return @@ -961,8 +937,7 @@ subroutine set_inventory_edcohort_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=wr_fmt) & - c_time, p_name, c_name, c_dbh, c_height, & - c_pft, c_nplant, c_bdead, c_balive, c_avgRG + c_time, p_name, c_name, c_dbh, c_pft, c_nplant call endrun(msg=errMsg(sourcefile, __LINE__)) end if @@ -1215,6 +1190,7 @@ subroutine write_inventory_type1(currentSite) ! a recommended file type for restarting a run. ! The files will have a lat/long tag added to their name, and will be ! generated in the run folder. + ! JFN Oct 2023 - updated to get rid of unused ED columns ! -------------------------------------------------------------------------------- use shr_file_mod, only : shr_file_getUnit @@ -1267,8 +1243,8 @@ subroutine write_inventory_type1(currentSite) open(unit=pss_file_out,file=trim(pss_name_out), status='UNKNOWN',action='WRITE',form='FORMATTED') open(unit=css_file_out,file=trim(css_name_out), status='UNKNOWN',action='WRITE',form='FORMATTED') - write(pss_file_out,*) 'time patch trk age area water fsc stsc stsl ssc psc msn fsn' - write(css_file_out,*) 'time patch cohort dbh height pft nplant bdead alive Avgrg' + write(pss_file_out,*) 'time patch trk age area' + write(css_file_out,*) 'time patch cohort dbh pft nplant' ipatch=0 currentpatch => currentSite%youngest_patch From 10a724c2de48083607cababc290deffdfe1b91ce Mon Sep 17 00:00:00 2001 From: jessica needham Date: Wed, 18 Oct 2023 21:09:23 -0700 Subject: [PATCH 02/13] remove cohort index from inventory init files --- main/FatesInventoryInitMod.F90 | 8 +++----- 1 file changed, 3 insertions(+), 5 deletions(-) diff --git a/main/FatesInventoryInitMod.F90 b/main/FatesInventoryInitMod.F90 index edfa97cf59..d1af0be58f 100644 --- a/main/FatesInventoryInitMod.F90 +++ b/main/FatesInventoryInitMod.F90 @@ -842,7 +842,6 @@ subroutine set_inventory_edcohort_type1(csite,bc_in,css_file_unit,npatches, & ! FILE FORMAT: ! time (year) year of measurement ! patch (string) patch id string associated with this cohort - ! index (integer) cohort index ! dbh (cm) diameter at breast height ! pft (integer) the plant functional type index (must be consistent with param file) ! n (/m2) The plant number density @@ -874,7 +873,6 @@ subroutine set_inventory_edcohort_type1(csite,bc_in,css_file_unit,npatches, & class(prt_vartypes), pointer :: prt_obj real(r8) :: c_time ! Time patch was recorded character(len=patchname_strlen) :: p_name ! The patch associated with this cohort - character(len=cohortname_strlen) :: c_name ! cohort index real(r8) :: c_dbh ! diameter at breast height (cm) integer :: c_pft ! plant functional type index real(r8) :: c_nplant ! plant density (/m2) @@ -915,12 +913,12 @@ subroutine set_inventory_edcohort_type1(csite,bc_in,css_file_unit,npatches, & integer, parameter :: recruitstatus = 0 - read(css_file_unit,fmt=*,iostat=ios) c_time, p_name, c_name, c_dbh, & + read(css_file_unit,fmt=*,iostat=ios) c_time, p_name, c_dbh, & c_pft, c_nplant if( debug_inv) then write(*,fmt=wr_fmt) & - c_time, p_name, c_name, c_dbh, c_pft, c_nplant + c_time, p_name, c_dbh, c_pft, c_nplant end if if (ios/=0) return @@ -937,7 +935,7 @@ subroutine set_inventory_edcohort_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=wr_fmt) & - c_time, p_name, c_name, c_dbh, c_pft, c_nplant + c_time, p_name, c_dbh, c_pft, c_nplant call endrun(msg=errMsg(sourcefile, __LINE__)) end if From 97707c0275d22f95ba8a15b2a87a345eb9f5dcc0 Mon Sep 17 00:00:00 2001 From: jessica needham Date: Wed, 18 Oct 2023 21:58:10 -0700 Subject: [PATCH 03/13] add script to convert ed to fates inventory init files --- tools/ed2_to_fates_inventory_init.py | 46 ++++++++++++++++++++++++++++ 1 file changed, 46 insertions(+) create mode 100644 tools/ed2_to_fates_inventory_init.py diff --git a/tools/ed2_to_fates_inventory_init.py b/tools/ed2_to_fates_inventory_init.py new file mode 100644 index 0000000000..a8959134ee --- /dev/null +++ b/tools/ed2_to_fates_inventory_init.py @@ -0,0 +1,46 @@ +#!/usr/bin/env python + +### This script takes a ED2 style inventory init file and converts it to a file compatible with FATES. +# It accepts the following flags: +# --type : patch or cohort +# --fin : input filename +# --fout : output file name + +import argparse +import pandas as pd +import sys + +def main(): + parser = argparse.ArgumentParser(description='Parse command line arguments to this script.') + # + parser.add_argument('--type', dest='fatestype', type=str, help="patch or cohort. Required.", required=True) + parser.add_argument('--fin', dest='fnamein', type=str, help="Input filename. Required.", required=True) + parser.add_argument('--fout', dest='fnameout', type=str, help="Output filename. Required.", required=True) + + args = parser.parse_args() + + # open the input data + dsin = pd.read_csv(args.fnamein, delim_whitespace=True) + + # if patch file delete unnecessary patch columns + if args.fatestype == 'patch' : + keep_col = ['time', 'patch', 'trk', 'age', 'area'] + newds = dsin[keep_col] + + + # if cohort file delete unnecessary cohort columns + elif args.fatestype == 'cohort' : + keep_col = ['time', 'patch', 'dbh', 'pft', 'nplant'] + newds = dsin[keep_col] + + else : + print("type must be one of patch or cohort") + + + newds.to_csv(args.fnameout , index=False, sep=' ') +# ======================================================================================================== +# This is the actual call to main + +if __name__ == "__main__": + main() + From c541a74d4ca57492ce146ea66ddc2a46c79be1d8 Mon Sep 17 00:00:00 2001 From: jessica needham Date: Thu, 19 Oct 2023 10:18:04 -0700 Subject: [PATCH 04/13] clean up python script -make simpler --- tools/ed2_to_fates_inventory_init.py | 19 +++++++++++-------- 1 file changed, 11 insertions(+), 8 deletions(-) diff --git a/tools/ed2_to_fates_inventory_init.py b/tools/ed2_to_fates_inventory_init.py index a8959134ee..a4a00475f4 100644 --- a/tools/ed2_to_fates_inventory_init.py +++ b/tools/ed2_to_fates_inventory_init.py @@ -2,9 +2,7 @@ ### This script takes a ED2 style inventory init file and converts it to a file compatible with FATES. # It accepts the following flags: -# --type : patch or cohort # --fin : input filename -# --fout : output file name import argparse import pandas as pd @@ -13,23 +11,28 @@ def main(): parser = argparse.ArgumentParser(description='Parse command line arguments to this script.') # - parser.add_argument('--type', dest='fatestype', type=str, help="patch or cohort. Required.", required=True) parser.add_argument('--fin', dest='fnamein', type=str, help="Input filename. Required.", required=True) - parser.add_argument('--fout', dest='fnameout', type=str, help="Output filename. Required.", required=True) - + args = parser.parse_args() + # is it a pss or css file? + filetype = args.fnamein.split('.')[1] + + # make the new file name + base_filename = args.fnamein.split('.')[0] + output_filename = f"{base_filename}_{'fates'}.{filetype}" + # open the input data dsin = pd.read_csv(args.fnamein, delim_whitespace=True) # if patch file delete unnecessary patch columns - if args.fatestype == 'patch' : + if filetype == 'pss' : keep_col = ['time', 'patch', 'trk', 'age', 'area'] newds = dsin[keep_col] # if cohort file delete unnecessary cohort columns - elif args.fatestype == 'cohort' : + elif filetype == 'css' : keep_col = ['time', 'patch', 'dbh', 'pft', 'nplant'] newds = dsin[keep_col] @@ -37,7 +40,7 @@ def main(): print("type must be one of patch or cohort") - newds.to_csv(args.fnameout , index=False, sep=' ') + newds.to_csv(output_filename, index=False, sep=' ') # ======================================================================================================== # This is the actual call to main From 1108024d67d3a8bfc9775c66694508ced91c8b49 Mon Sep 17 00:00:00 2001 From: jessica needham Date: Mon, 23 Oct 2023 13:49:38 -0700 Subject: [PATCH 05/13] add height back in --- main/FatesInventoryInitMod.F90 | 10 ++++++---- tools/ed2_to_fates_inventory_init.py | 4 ++-- 2 files changed, 8 insertions(+), 6 deletions(-) diff --git a/main/FatesInventoryInitMod.F90 b/main/FatesInventoryInitMod.F90 index d1af0be58f..fdef68cf11 100644 --- a/main/FatesInventoryInitMod.F90 +++ b/main/FatesInventoryInitMod.F90 @@ -843,6 +843,7 @@ subroutine set_inventory_edcohort_type1(csite,bc_in,css_file_unit,npatches, & ! time (year) year of measurement ! patch (string) patch id string associated with this cohort ! dbh (cm) diameter at breast height + ! height (m) height of vegetation in m. Currently not used. ! pft (integer) the plant functional type index (must be consistent with param file) ! n (/m2) The plant number density ! -------------------------------------------------------------------------------------------- @@ -874,6 +875,7 @@ subroutine set_inventory_edcohort_type1(csite,bc_in,css_file_unit,npatches, & real(r8) :: c_time ! Time patch was recorded character(len=patchname_strlen) :: p_name ! The patch associated with this cohort real(r8) :: c_dbh ! diameter at breast height (cm) + real(r8) :: c_height ! tree height (m) integer :: c_pft ! plant functional type index real(r8) :: c_nplant ! plant density (/m2) real(r8) :: site_spread ! initial guess of site spread @@ -914,11 +916,11 @@ subroutine set_inventory_edcohort_type1(csite,bc_in,css_file_unit,npatches, & read(css_file_unit,fmt=*,iostat=ios) c_time, p_name, c_dbh, & - c_pft, c_nplant + c_height, c_pft, c_nplant if( debug_inv) then write(*,fmt=wr_fmt) & - c_time, p_name, c_dbh, c_pft, c_nplant + c_time, p_name, c_dbh, c_height, c_pft, c_nplant end if if (ios/=0) return @@ -935,7 +937,7 @@ subroutine set_inventory_edcohort_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=wr_fmt) & - c_time, p_name, c_dbh, c_pft, c_nplant + c_time, p_name, c_dbh, c_height, c_pft, c_nplant call endrun(msg=errMsg(sourcefile, __LINE__)) end if @@ -1242,7 +1244,7 @@ subroutine write_inventory_type1(currentSite) open(unit=css_file_out,file=trim(css_name_out), status='UNKNOWN',action='WRITE',form='FORMATTED') write(pss_file_out,*) 'time patch trk age area' - write(css_file_out,*) 'time patch cohort dbh pft nplant' + write(css_file_out,*) 'time patch cohort dbh height pft nplant' ipatch=0 currentpatch => currentSite%youngest_patch diff --git a/tools/ed2_to_fates_inventory_init.py b/tools/ed2_to_fates_inventory_init.py index a4a00475f4..b258341a08 100644 --- a/tools/ed2_to_fates_inventory_init.py +++ b/tools/ed2_to_fates_inventory_init.py @@ -33,11 +33,11 @@ def main(): # if cohort file delete unnecessary cohort columns elif filetype == 'css' : - keep_col = ['time', 'patch', 'dbh', 'pft', 'nplant'] + keep_col = ['time', 'patch', 'dbh', 'height', 'pft', 'nplant'] newds = dsin[keep_col] else : - print("type must be one of patch or cohort") + print("file type must be one of patch (pss) or cohort (css)") newds.to_csv(output_filename, index=False, sep=' ') From 701a47172f70ceca27d8015039218877283c42f0 Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Tue, 31 Oct 2023 12:30:47 -0400 Subject: [PATCH 06/13] Removed some ed syntax conventions, enabled using height in the inventory data --- main/FatesInventoryInitMod.F90 | 51 +++++++++++++++++++++------------- 1 file changed, 31 insertions(+), 20 deletions(-) diff --git a/main/FatesInventoryInitMod.F90 b/main/FatesInventoryInitMod.F90 index fdef68cf11..92ed690786 100644 --- a/main/FatesInventoryInitMod.F90 +++ b/main/FatesInventoryInitMod.F90 @@ -11,9 +11,7 @@ module FatesInventoryInitMod ! site, or a small collection of sparse/irregularly spaced group of sites ! ! Created: Ryan Knox June 2017 - ! This code borrows heavily in concept from what is done in ED2. We will also do our best to - ! maintain compatibility with the PSS/CSS file formats that were used in ED2. - ! See: https://github.com/EDmodel/ED2/blob/master/ED/src/io/ed_read_ed10_20_history.f90 + ! This code borrows heavily in concept from what is done in ED2. ! At the time of writing this ED2 is unlicensed, and only concepts were borrowed with no direct ! code copied. ! @@ -295,7 +293,7 @@ subroutine initialize_sites_by_inventory(nsites,sites,bc_in) if( inv_format_list(invsite) == 1 ) then - call set_inventory_edpatch_type1(newpatch,pss_file_unit,ipa,ios,patch_name) + call set_inventory_patch_type1(newpatch,pss_file_unit,ipa,ios,patch_name) end if ! Add it to the site's patch list @@ -384,7 +382,7 @@ subroutine initialize_sites_by_inventory(nsites,sites,bc_in) invcohortloop: do if ( inv_format_list(invsite) == 1 ) then - call set_inventory_edcohort_type1(sites(s),bc_in(s),css_file_unit, & + call set_inventory_cohort_type1(sites(s),bc_in(s),css_file_unit, & npatches, patch_pointer_vec,patch_name_vec, ios) end if if ( ios/=0 ) exit @@ -621,8 +619,8 @@ subroutine assess_inventory_sites(sitelist_file_unit,nsites, inv_format_list, & ! ! type integer We will accomodate different file format with different ! field values as the need arises. format 1 will read in - ! datasets via "set_inventory_edpatch_type1()", - ! "set_inventory_edcohort_type1()" + ! datasets via "set_inventory_patch_type1()", + ! "set_inventory_cohort_type1()" ! ! latitude float The geographic latitude coordinate of the site ! longitude float The geogarphic longitude coordinate of the site @@ -734,7 +732,7 @@ end subroutine assess_inventory_sites ! ============================================================================================== - subroutine set_inventory_edpatch_type1(newpatch,pss_file_unit,ipa,ios,patch_name) + subroutine set_inventory_patch_type1(newpatch,pss_file_unit,ipa,ios,patch_name) ! -------------------------------------------------------------------------------------------- ! This subroutine reads in a line of an inventory patch file (pss) @@ -823,12 +821,12 @@ subroutine set_inventory_edpatch_type1(newpatch,pss_file_unit,ipa,ios,patch_name end do return - end subroutine set_inventory_edpatch_type1 + end subroutine set_inventory_patch_type1 ! ============================================================================================== - subroutine set_inventory_edcohort_type1(csite,bc_in,css_file_unit,npatches, & + subroutine set_inventory_cohort_type1(csite,bc_in,css_file_unit,npatches, & patch_pointer_vec,patch_name_vec,ios) ! -------------------------------------------------------------------------------------------- @@ -842,8 +840,8 @@ subroutine set_inventory_edcohort_type1(csite,bc_in,css_file_unit,npatches, & ! FILE FORMAT: ! time (year) year of measurement ! patch (string) patch id string associated with this cohort - ! dbh (cm) diameter at breast height - ! height (m) height of vegetation in m. Currently not used. + ! dbh (cm) diameter at breast height. Optional, set height to negative if used + ! height (m) height of vegetation in m. Optional, set dbh to negative if used ! pft (integer) the plant functional type index (must be consistent with param file) ! n (/m2) The plant number density ! -------------------------------------------------------------------------------------------- @@ -912,6 +910,7 @@ subroutine set_inventory_edcohort_type1(csite,bc_in,css_file_unit,npatches, & 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 + real(r8), parameter :: abnormal_large_height = 500.0_r8 ! I've never heard of a tree > 500m tall integer, parameter :: recruitstatus = 0 @@ -958,9 +957,10 @@ subroutine set_inventory_edcohort_type1(csite,bc_in,css_file_unit,npatches, & call endrun(msg=errMsg(sourcefile, __LINE__)) end if - if (c_dbh <=0 ) then + if (c_dbh < 0._r8 .and. c_height < 0._r8) then write(fates_log(), *) 'inventory dbh: ', c_dbh - write(fates_log(), *) 'The inventory produced a cohort with <= 0 dbh' + write(fates_log(), *) 'and inventory height: ',c_height + write(fates_log(), *) 'are both zero. One must be positive.' call endrun(msg=errMsg(sourcefile, __LINE__)) end if @@ -970,6 +970,12 @@ subroutine set_inventory_edcohort_type1(csite,bc_in,css_file_unit,npatches, & call endrun(msg=errMsg(sourcefile, __LINE__)) end if + if (c_height > abnormal_large_height ) then + write(fates_log(), *) 'inventory height: ', c_height + write(fates_log(), *) 'The inventory produced a cohort with very large height [m]' + call endrun(msg=errMsg(sourcefile, __LINE__)) + end if + if (c_nplant <=0 ) then write(fates_log(), *) 'inventory nplant: ', c_nplant write(fates_log(), *) 'The inventory produced a cohort with <= 0 density /m2' @@ -1005,10 +1011,17 @@ subroutine set_inventory_edcohort_type1(csite,bc_in,css_file_unit,npatches, & endif temp_cohort%n = c_nplant * cpatch%area / real(ncohorts_to_create,r8) - temp_cohort%dbh = c_dbh + temp_cohort%crowndamage = 1 ! assume undamaged - call h_allom(c_dbh,temp_cohort%pft,temp_cohort%height) + if( c_dbh> 0._r8)then + temp_cohort%dbh = c_dbh + call h_allom(c_dbh,temp_cohort%pft,temp_cohort%height) + else + temp_cohort%height = c_height + call h2d_allom(c_height,temp_cohort%pft,temp_cohort%dbh) + end if + temp_cohort%canopy_trim = 1.0_r8 ! Determine the phenology status and the elongation factors. @@ -1177,7 +1190,7 @@ subroutine set_inventory_edcohort_type1(csite,bc_in,css_file_unit,npatches, & end do return - end subroutine set_inventory_edcohort_type1 + end subroutine set_inventory_cohort_type1 ! ==================================================================================== @@ -1185,9 +1198,7 @@ subroutine write_inventory_type1(currentSite) ! -------------------------------------------------------------------------------- ! This subroutine writes the cohort/patch inventory type files in the "type 1" - ! format. Note that for compatibility with ED2, we chose an old type that has - ! both extra unused fields and is missing fields from FATES. THis is not - ! a recommended file type for restarting a run. + ! format. ! The files will have a lat/long tag added to their name, and will be ! generated in the run folder. ! JFN Oct 2023 - updated to get rid of unused ED columns From 9c556ff03413be1241ca40e08187d751c6669321 Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Tue, 31 Oct 2023 12:37:23 -0400 Subject: [PATCH 07/13] added check in inventory init to make sure at least on of dbh or height is positive --- main/FatesInventoryInitMod.F90 | 11 +++++++++-- 1 file changed, 9 insertions(+), 2 deletions(-) diff --git a/main/FatesInventoryInitMod.F90 b/main/FatesInventoryInitMod.F90 index 92ed690786..962e05212f 100644 --- a/main/FatesInventoryInitMod.F90 +++ b/main/FatesInventoryInitMod.F90 @@ -957,13 +957,20 @@ subroutine set_inventory_cohort_type1(csite,bc_in,css_file_unit,npatches, & call endrun(msg=errMsg(sourcefile, __LINE__)) end if - if (c_dbh < 0._r8 .and. c_height < 0._r8) then + if (c_dbh < nearzero .and. c_height < nearzero) then write(fates_log(), *) 'inventory dbh: ', c_dbh write(fates_log(), *) 'and inventory height: ',c_height - write(fates_log(), *) 'are both zero. One must be positive.' + write(fates_log(), *) 'are both zero or negative. One must be positive.' call endrun(msg=errMsg(sourcefile, __LINE__)) end if + if (c_dbh > nearzero .and. c_height > nearzero) then + write(fates_log(), *) 'inventory dbh: ', c_dbh + write(fates_log(), *) 'and inventory height: ',c_height + write(fates_log(), *) 'are both positive. One must be zero or negative.' + call endrun(msg=errMsg(sourcefile, __LINE__)) + end if + if (c_dbh > abnormal_large_dbh ) then write(fates_log(), *) 'inventory dbh: ', c_nplant write(fates_log(), *) 'The inventory produced a cohort with very large diameter [cm]' From 6dfe90a595a0521bb9f08dabe2a834b6144b2a9b Mon Sep 17 00:00:00 2001 From: jessica needham Date: Wed, 1 Nov 2023 10:18:42 -0700 Subject: [PATCH 08/13] add nearzero to inventory initialization mod --- main/FatesInventoryInitMod.F90 | 1 + 1 file changed, 1 insertion(+) diff --git a/main/FatesInventoryInitMod.F90 b/main/FatesInventoryInitMod.F90 index 962e05212f..fef10084f3 100644 --- a/main/FatesInventoryInitMod.F90 +++ b/main/FatesInventoryInitMod.F90 @@ -29,6 +29,7 @@ module FatesInventoryInitMod use FatesConstantsMod, only : r8 => fates_r8 use FatesConstantsMod, only : pi_const use FatesConstantsMod, only : itrue + use FatesConstantsMod, only : nearzero use FatesGlobals , only : endrun => fates_endrun use FatesGlobals , only : fates_log use EDParamsMod , only : regeneration_model From e7e9367176c192b5f341f7be4860431eda4faaf4 Mon Sep 17 00:00:00 2001 From: jessica needham Date: Wed, 1 Nov 2023 20:58:41 -0700 Subject: [PATCH 09/13] fix LL logic to allow case where all patches and cohorts are identical --- main/FatesInventoryInitMod.F90 | 56 ++++++++++++++++++++++++++++++++-- 1 file changed, 54 insertions(+), 2 deletions(-) diff --git a/main/FatesInventoryInitMod.F90 b/main/FatesInventoryInitMod.F90 index fef10084f3..544cb3fc7f 100644 --- a/main/FatesInventoryInitMod.F90 +++ b/main/FatesInventoryInitMod.F90 @@ -168,6 +168,11 @@ subroutine initialize_sites_by_inventory(nsites,sites,bc_in) character(len=patchname_strlen), allocatable :: patch_name_vec(:) ! vector of patch ID strings real(r8) :: basal_area_postf ! basal area before fusion (m2/ha) real(r8) :: basal_area_pref ! basal area after fusion (m2/ha) + real(r8) :: min_patch_age + real(r8) :: max_patch_age + real(r8) :: min_cohort_dbh + real(r8) :: max_cohort_dbh + ! I. Load the inventory list file, do some file handle checks ! ------------------------------------------------------------------------------------------ @@ -367,6 +372,7 @@ subroutine initialize_sites_by_inventory(nsites,sites,bc_in) enddo end if + ! OPEN THE CSS FILE ! --------------------------------------------------------------------------------------- css_file_unit = shr_file_getUnit() @@ -399,8 +405,53 @@ subroutine initialize_sites_by_inventory(nsites,sites,bc_in) deallocate(patch_pointer_vec,patch_name_vec) - ! now that we've read in the patch and cohort info, check to see if there is any real age info - if ( abs(sites(s)%youngest_patch%age - sites(s)%oldest_patch%age) <= nearzero .and. & + + ! if all patches are identical in age and biomass then don't change the order of the LL + min_patch_age = 0._r8 + max_patch_age = 0._r8 + min_cohort_dbh = 100000._r8 + max_cohort_dbh = 0._r8 + + ! get min and max patch age and cohort dbh + currentpatch => sites(s)%youngest_patch + do while(associated(currentpatch)) + + if ( currentpatch%age > max_patch_age ) then + max_patch_age = currentpatch%age + else if ( currentpatch%age < min_patch_age ) then + min_patch_age = currentpatch%age + end if + + currentcohort => currentpatch%tallest + do while(associated(currentcohort)) + + if ( currentcohort%dbh > max_cohort_dbh ) then + max_cohort_dbh = currentcohort%dbh + else if ( currentcohort%dbh < min_cohort_dbh ) then + min_cohort_dbh = currentcohort%dbh + end if + + currentcohort => currentcohort%shorter + end do + currentPatch => currentpatch%older + enddo + + if (debug_inv) then + write(fates_log(),*) 'min patch age', min_patch_age + write(fates_log(),*) 'max patch age', max_patch_age + write(fates_log(),*) 'min cohort dbh', min_cohort_dbh + write(fates_log(),*) 'max cohort dbh', max_cohort_dbh + end if + + if ( min_patch_age .eq. max_patch_age .and. min_cohort_dbh .eq. max_cohort_dbh ) then + + if(debug_inv)then + write(fates_log(), *) 'All patches and cohorts are identical' + end if + + + ! now that we've read in the patch and cohort info, check to see if there is any real age info + else if ( abs(sites(s)%youngest_patch%age - sites(s)%oldest_patch%age) <= nearzero .and. & associated(sites(s)%youngest_patch%older) ) then ! so there are at least two patches and the oldest and youngest are the same age. @@ -501,6 +552,7 @@ subroutine initialize_sites_by_inventory(nsites,sites,bc_in) ! ---------------------------------------------------------------------------------------- ipa=1 total_cohorts = 0 + currentpatch => sites(s)%youngest_patch do while(associated(currentpatch)) currentpatch%patchno = ipa From 8e2e9f74e83ef2bc9082a5a4e67fee9936b98f4d Mon Sep 17 00:00:00 2001 From: jessica needham Date: Thu, 2 Nov 2023 14:42:58 -0700 Subject: [PATCH 10/13] remove sorting of ll after init data read --- main/FatesInventoryInitMod.F90 | 254 +++++++++++++++++---------------- 1 file changed, 132 insertions(+), 122 deletions(-) diff --git a/main/FatesInventoryInitMod.F90 b/main/FatesInventoryInitMod.F90 index 544cb3fc7f..f713102998 100644 --- a/main/FatesInventoryInitMod.F90 +++ b/main/FatesInventoryInitMod.F90 @@ -168,10 +168,12 @@ subroutine initialize_sites_by_inventory(nsites,sites,bc_in) character(len=patchname_strlen), allocatable :: patch_name_vec(:) ! vector of patch ID strings real(r8) :: basal_area_postf ! basal area before fusion (m2/ha) real(r8) :: basal_area_pref ! basal area after fusion (m2/ha) - real(r8) :: min_patch_age - real(r8) :: max_patch_age - real(r8) :: min_cohort_dbh - real(r8) :: max_cohort_dbh + real(r8) :: n_pref + real(r8) :: n_postf + ! real(r8) :: min_patch_age +! real(r8) :: max_patch_age +! real(r8) :: min_cohort_dbh +! real(r8) :: max_cohort_dbh ! I. Load the inventory list file, do some file handle checks @@ -406,137 +408,139 @@ subroutine initialize_sites_by_inventory(nsites,sites,bc_in) deallocate(patch_pointer_vec,patch_name_vec) - ! if all patches are identical in age and biomass then don't change the order of the LL - min_patch_age = 0._r8 - max_patch_age = 0._r8 - min_cohort_dbh = 100000._r8 - max_cohort_dbh = 0._r8 - - ! get min and max patch age and cohort dbh - currentpatch => sites(s)%youngest_patch - do while(associated(currentpatch)) - - if ( currentpatch%age > max_patch_age ) then - max_patch_age = currentpatch%age - else if ( currentpatch%age < min_patch_age ) then - min_patch_age = currentpatch%age - end if - - currentcohort => currentpatch%tallest - do while(associated(currentcohort)) - - if ( currentcohort%dbh > max_cohort_dbh ) then - max_cohort_dbh = currentcohort%dbh - else if ( currentcohort%dbh < min_cohort_dbh ) then - min_cohort_dbh = currentcohort%dbh - end if - - currentcohort => currentcohort%shorter - end do - currentPatch => currentpatch%older - enddo - - if (debug_inv) then - write(fates_log(),*) 'min patch age', min_patch_age - write(fates_log(),*) 'max patch age', max_patch_age - write(fates_log(),*) 'min cohort dbh', min_cohort_dbh - write(fates_log(),*) 'max cohort dbh', max_cohort_dbh - end if + ! ! if all patches are identical in age and biomass then don't change the order of the LL + ! min_patch_age = 0._r8 + ! max_patch_age = 0._r8 + ! min_cohort_dbh = 100000._r8 + ! max_cohort_dbh = 0._r8 + + ! ! get min and max patch age and cohort dbh + ! currentpatch => sites(s)%youngest_patch + ! do while(associated(currentpatch)) + + ! if ( currentpatch%age > max_patch_age ) then + ! max_patch_age = currentpatch%age + ! else if ( currentpatch%age < min_patch_age ) then + ! min_patch_age = currentpatch%age + ! end if + + ! currentcohort => currentpatch%tallest + ! do while(associated(currentcohort)) + + ! if ( currentcohort%dbh > max_cohort_dbh ) then + ! max_cohort_dbh = currentcohort%dbh + ! else if ( currentcohort%dbh < min_cohort_dbh ) then + ! min_cohort_dbh = currentcohort%dbh + ! end if + + ! currentcohort => currentcohort%shorter + ! end do + ! currentPatch => currentpatch%older + ! enddo + + ! if (debug_inv) then + ! write(fates_log(),*) 'min patch age', min_patch_age + ! write(fates_log(),*) 'max patch age', max_patch_age + ! write(fates_log(),*) 'min cohort dbh', min_cohort_dbh + ! write(fates_log(),*) 'max cohort dbh', max_cohort_dbh + ! end if - if ( min_patch_age .eq. max_patch_age .and. min_cohort_dbh .eq. max_cohort_dbh ) then + ! if ( min_patch_age .eq. max_patch_age .and. min_cohort_dbh .eq. max_cohort_dbh ) then - if(debug_inv)then - write(fates_log(), *) 'All patches and cohorts are identical' - end if + ! if(debug_inv)then + ! write(fates_log(), *) 'All patches and cohorts are identical' + ! end if - ! now that we've read in the patch and cohort info, check to see if there is any real age info - else if ( abs(sites(s)%youngest_patch%age - sites(s)%oldest_patch%age) <= nearzero .and. & - associated(sites(s)%youngest_patch%older) ) then - - ! so there are at least two patches and the oldest and youngest are the same age. - ! this means that sorting by age wasn't very useful. try sorting by total biomass instead - - ! first calculate the biomass in each patch. simplest way is to use the patch fusion criteria - currentpatch => sites(s)%youngest_patch - do while(associated(currentpatch)) - call patch_pft_size_profile(currentPatch) - currentPatch => currentpatch%older - enddo - - ! now we need to sort them. - ! first generate a new head of the linked list. - head_of_unsorted_patch_list => sites(s)%youngest_patch%older - - ! reset the site-level patch linked list, keeping only the youngest patch. - sites(s)%youngest_patch%older => null() - sites(s)%youngest_patch%younger => null() - sites(s)%oldest_patch => sites(s)%youngest_patch - - ! loop through each patch in the unsorted LL, peel it off, - ! and insert it into the new, sorted LL - do while(associated(head_of_unsorted_patch_list)) - - ! first keep track of the next patch in the old (unsorted) linked list - next_in_unsorted_patch_list => head_of_unsorted_patch_list%older - - ! check the two end-cases - - ! Youngest Patch - if(sum(head_of_unsorted_patch_list%pft_agb_profile(:,:)) <= & - sum(sites(s)%youngest_patch%pft_agb_profile(:,:)))then - head_of_unsorted_patch_list%older => sites(s)%youngest_patch - head_of_unsorted_patch_list%younger => null() - sites(s)%youngest_patch%younger => head_of_unsorted_patch_list - sites(s)%youngest_patch => head_of_unsorted_patch_list - - ! Oldest Patch - else if(sum(head_of_unsorted_patch_list%pft_agb_profile(:,:)) > & - sum(sites(s)%oldest_patch%pft_agb_profile(:,:)))then - head_of_unsorted_patch_list%older => null() - head_of_unsorted_patch_list%younger => sites(s)%oldest_patch - sites(s)%oldest_patch%older => head_of_unsorted_patch_list - sites(s)%oldest_patch => head_of_unsorted_patch_list - - ! Somewhere in the middle - else - currentpatch => sites(s)%youngest_patch - do while(associated(currentpatch)) - olderpatch => currentpatch%older - if(associated(currentpatch%older)) then - if(sum(head_of_unsorted_patch_list%pft_agb_profile(:,:)) >= & - sum(currentpatch%pft_agb_profile(:,:)) .and. & - sum(head_of_unsorted_patch_list%pft_agb_profile(:,:)) < & - sum(olderpatch%pft_agb_profile(:,:))) then - ! Set the new patches pointers - head_of_unsorted_patch_list%older => currentpatch%older - head_of_unsorted_patch_list%younger => currentpatch - ! Fix the patch's older pointer - currentpatch%older => head_of_unsorted_patch_list - ! Fix the older patch's younger pointer - olderpatch%younger => head_of_unsorted_patch_list - ! Exit the loop once head sorted to avoid later re-sort - exit - end if - end if - currentPatch => olderpatch - enddo - end if - - ! now work through to the next element in the unsorted linked list - head_of_unsorted_patch_list => next_in_unsorted_patch_list - end do - endif + ! ! now that we've read in the patch and cohort info, check to see if there is any real age info + ! else if ( abs(sites(s)%youngest_patch%age - sites(s)%oldest_patch%age) <= nearzero .and. & + ! associated(sites(s)%youngest_patch%older) ) then + + ! ! so there are at least two patches and the oldest and youngest are the same age. + ! ! this means that sorting by age wasn't very useful. try sorting by total biomass instead + + ! ! first calculate the biomass in each patch. simplest way is to use the patch fusion criteria + ! currentpatch => sites(s)%youngest_patch + ! do while(associated(currentpatch)) + ! call patch_pft_size_profile(currentPatch) + ! currentPatch => currentpatch%older + ! enddo + + ! ! now we need to sort them. + ! ! first generate a new head of the linked list. + ! head_of_unsorted_patch_list => sites(s)%youngest_patch%older + + ! ! reset the site-level patch linked list, keeping only the youngest patch. + ! sites(s)%youngest_patch%older => null() + ! sites(s)%youngest_patch%younger => null() + ! sites(s)%oldest_patch => sites(s)%youngest_patch + + ! ! loop through each patch in the unsorted LL, peel it off, + ! ! and insert it into the new, sorted LL + ! do while(associated(head_of_unsorted_patch_list)) + + ! ! first keep track of the next patch in the old (unsorted) linked list + ! next_in_unsorted_patch_list => head_of_unsorted_patch_list%older + + ! ! check the two end-cases + + ! ! Youngest Patch + ! if(sum(head_of_unsorted_patch_list%pft_agb_profile(:,:)) <= & + ! sum(sites(s)%youngest_patch%pft_agb_profile(:,:)))then + ! head_of_unsorted_patch_list%older => sites(s)%youngest_patch + ! head_of_unsorted_patch_list%younger => null() + ! sites(s)%youngest_patch%younger => head_of_unsorted_patch_list + ! sites(s)%youngest_patch => head_of_unsorted_patch_list + + ! ! Oldest Patch + ! else if(sum(head_of_unsorted_patch_list%pft_agb_profile(:,:)) > & + ! sum(sites(s)%oldest_patch%pft_agb_profile(:,:)))then + ! head_of_unsorted_patch_list%older => null() + ! head_of_unsorted_patch_list%younger => sites(s)%oldest_patch + ! sites(s)%oldest_patch%older => head_of_unsorted_patch_list + ! sites(s)%oldest_patch => head_of_unsorted_patch_list + + ! ! Somewhere in the middle + ! else + ! currentpatch => sites(s)%youngest_patch + ! do while(associated(currentpatch)) + ! olderpatch => currentpatch%older + ! if(associated(currentpatch%older)) then + ! if(sum(head_of_unsorted_patch_list%pft_agb_profile(:,:)) >= & + ! sum(currentpatch%pft_agb_profile(:,:)) .and. & + ! sum(head_of_unsorted_patch_list%pft_agb_profile(:,:)) < & + ! sum(olderpatch%pft_agb_profile(:,:))) then + ! ! Set the new patches pointers + ! head_of_unsorted_patch_list%older => currentpatch%older + ! head_of_unsorted_patch_list%younger => currentpatch + ! ! Fix the patch's older pointer + ! currentpatch%older => head_of_unsorted_patch_list + ! ! Fix the older patch's younger pointer + ! olderpatch%younger => head_of_unsorted_patch_list + ! ! Exit the loop once head sorted to avoid later re-sort + ! exit + ! end if + ! end if + ! currentPatch => olderpatch + ! enddo + ! end if + + ! ! now work through to the next element in the unsorted linked list + ! head_of_unsorted_patch_list => next_in_unsorted_patch_list + ! end do + ! endif ! Report Basal Area (as a check on if things were read in) ! ------------------------------------------------------------------------------ basal_area_pref = 0.0_r8 + n_pref = 0.0_r8 currentpatch => sites(s)%youngest_patch do while(associated(currentpatch)) currentcohort => currentpatch%tallest do while(associated(currentcohort)) basal_area_pref = basal_area_pref + & - currentcohort%n*0.25*((currentcohort%dbh/100.0_r8)**2.0_r8)*pi_const + currentcohort%n*0.25*((currentcohort%dbh/100.0_r8)**2.0_r8)*pi_const + n_pref = n_pref + currentcohort%n currentcohort => currentcohort%shorter end do currentPatch => currentpatch%older @@ -546,6 +550,7 @@ subroutine initialize_sites_by_inventory(nsites,sites,bc_in) write(fates_log(),*) 'Basal Area from inventory, BEFORE fusion' write(fates_log(),*) 'Lat: ',sites(s)%lat,' Lon: ',sites(s)%lon write(fates_log(),*) basal_area_pref,' [m2/ha]' + write(fates_log(),*) 'number of plants: ', n_pref write(fates_log(),*) '-------------------------------------------------------' ! Update the patch index numbers and fuse the cohorts in the patches @@ -583,12 +588,14 @@ subroutine initialize_sites_by_inventory(nsites,sites,bc_in) ! ---------------------------------------------------------------------------------------- !call canopy_structure(sites(s),bc_in(s)) basal_area_postf = 0.0_r8 + n_postf = 0.0_r8 currentpatch => sites(s)%youngest_patch do while(associated(currentpatch)) currentcohort => currentpatch%tallest do while(associated(currentcohort)) basal_area_postf = basal_area_postf + & currentcohort%n*0.25*((currentcohort%dbh/100.0_r8)**2.0_r8)*pi_const + n_postf = n_postf + currentcohort%n currentcohort => currentcohort%shorter end do @@ -601,6 +608,7 @@ subroutine initialize_sites_by_inventory(nsites,sites,bc_in) write(fates_log(),*) 'Basal Area from inventory, AFTER fusion' write(fates_log(),*) 'Lat: ',sites(s)%lat,' Lon: ',sites(s)%lon write(fates_log(),*) basal_area_postf,' [m2/ha]' + write(fates_log(),*) 'jfn n post f :', n_postf write(fates_log(),*) '-------------------------------------------------------' ! If this is flagged as true, the post-fusion inventory will be written to file @@ -1077,9 +1085,11 @@ subroutine set_inventory_cohort_type1(csite,bc_in,css_file_unit,npatches, & if( c_dbh> 0._r8)then temp_cohort%dbh = c_dbh call h_allom(c_dbh,temp_cohort%pft,temp_cohort%height) + write(fates_log(),*) 'jfn - using dbh' else temp_cohort%height = c_height call h2d_allom(c_height,temp_cohort%pft,temp_cohort%dbh) + write(fates_log(),*) 'jfn - using height' end if temp_cohort%canopy_trim = 1.0_r8 From 35a6abd748c91f56f949d4852713e8fcfab36662 Mon Sep 17 00:00:00 2001 From: jessica needham Date: Thu, 2 Nov 2023 16:02:13 -0700 Subject: [PATCH 11/13] Clean writing of inventory files. Remove unused code. --- main/FatesInventoryInitMod.F90 | 142 ++------------------------------- 1 file changed, 5 insertions(+), 137 deletions(-) diff --git a/main/FatesInventoryInitMod.F90 b/main/FatesInventoryInitMod.F90 index f713102998..c462c45112 100644 --- a/main/FatesInventoryInitMod.F90 +++ b/main/FatesInventoryInitMod.F90 @@ -170,11 +170,6 @@ subroutine initialize_sites_by_inventory(nsites,sites,bc_in) real(r8) :: basal_area_pref ! basal area after fusion (m2/ha) real(r8) :: n_pref real(r8) :: n_postf - ! real(r8) :: min_patch_age -! real(r8) :: max_patch_age -! real(r8) :: min_cohort_dbh -! real(r8) :: max_cohort_dbh - ! I. Load the inventory list file, do some file handle checks ! ------------------------------------------------------------------------------------------ @@ -407,129 +402,6 @@ subroutine initialize_sites_by_inventory(nsites,sites,bc_in) deallocate(patch_pointer_vec,patch_name_vec) - - ! ! if all patches are identical in age and biomass then don't change the order of the LL - ! min_patch_age = 0._r8 - ! max_patch_age = 0._r8 - ! min_cohort_dbh = 100000._r8 - ! max_cohort_dbh = 0._r8 - - ! ! get min and max patch age and cohort dbh - ! currentpatch => sites(s)%youngest_patch - ! do while(associated(currentpatch)) - - ! if ( currentpatch%age > max_patch_age ) then - ! max_patch_age = currentpatch%age - ! else if ( currentpatch%age < min_patch_age ) then - ! min_patch_age = currentpatch%age - ! end if - - ! currentcohort => currentpatch%tallest - ! do while(associated(currentcohort)) - - ! if ( currentcohort%dbh > max_cohort_dbh ) then - ! max_cohort_dbh = currentcohort%dbh - ! else if ( currentcohort%dbh < min_cohort_dbh ) then - ! min_cohort_dbh = currentcohort%dbh - ! end if - - ! currentcohort => currentcohort%shorter - ! end do - ! currentPatch => currentpatch%older - ! enddo - - ! if (debug_inv) then - ! write(fates_log(),*) 'min patch age', min_patch_age - ! write(fates_log(),*) 'max patch age', max_patch_age - ! write(fates_log(),*) 'min cohort dbh', min_cohort_dbh - ! write(fates_log(),*) 'max cohort dbh', max_cohort_dbh - ! end if - - ! if ( min_patch_age .eq. max_patch_age .and. min_cohort_dbh .eq. max_cohort_dbh ) then - - ! if(debug_inv)then - ! write(fates_log(), *) 'All patches and cohorts are identical' - ! end if - - - ! ! now that we've read in the patch and cohort info, check to see if there is any real age info - ! else if ( abs(sites(s)%youngest_patch%age - sites(s)%oldest_patch%age) <= nearzero .and. & - ! associated(sites(s)%youngest_patch%older) ) then - - ! ! so there are at least two patches and the oldest and youngest are the same age. - ! ! this means that sorting by age wasn't very useful. try sorting by total biomass instead - - ! ! first calculate the biomass in each patch. simplest way is to use the patch fusion criteria - ! currentpatch => sites(s)%youngest_patch - ! do while(associated(currentpatch)) - ! call patch_pft_size_profile(currentPatch) - ! currentPatch => currentpatch%older - ! enddo - - ! ! now we need to sort them. - ! ! first generate a new head of the linked list. - ! head_of_unsorted_patch_list => sites(s)%youngest_patch%older - - ! ! reset the site-level patch linked list, keeping only the youngest patch. - ! sites(s)%youngest_patch%older => null() - ! sites(s)%youngest_patch%younger => null() - ! sites(s)%oldest_patch => sites(s)%youngest_patch - - ! ! loop through each patch in the unsorted LL, peel it off, - ! ! and insert it into the new, sorted LL - ! do while(associated(head_of_unsorted_patch_list)) - - ! ! first keep track of the next patch in the old (unsorted) linked list - ! next_in_unsorted_patch_list => head_of_unsorted_patch_list%older - - ! ! check the two end-cases - - ! ! Youngest Patch - ! if(sum(head_of_unsorted_patch_list%pft_agb_profile(:,:)) <= & - ! sum(sites(s)%youngest_patch%pft_agb_profile(:,:)))then - ! head_of_unsorted_patch_list%older => sites(s)%youngest_patch - ! head_of_unsorted_patch_list%younger => null() - ! sites(s)%youngest_patch%younger => head_of_unsorted_patch_list - ! sites(s)%youngest_patch => head_of_unsorted_patch_list - - ! ! Oldest Patch - ! else if(sum(head_of_unsorted_patch_list%pft_agb_profile(:,:)) > & - ! sum(sites(s)%oldest_patch%pft_agb_profile(:,:)))then - ! head_of_unsorted_patch_list%older => null() - ! head_of_unsorted_patch_list%younger => sites(s)%oldest_patch - ! sites(s)%oldest_patch%older => head_of_unsorted_patch_list - ! sites(s)%oldest_patch => head_of_unsorted_patch_list - - ! ! Somewhere in the middle - ! else - ! currentpatch => sites(s)%youngest_patch - ! do while(associated(currentpatch)) - ! olderpatch => currentpatch%older - ! if(associated(currentpatch%older)) then - ! if(sum(head_of_unsorted_patch_list%pft_agb_profile(:,:)) >= & - ! sum(currentpatch%pft_agb_profile(:,:)) .and. & - ! sum(head_of_unsorted_patch_list%pft_agb_profile(:,:)) < & - ! sum(olderpatch%pft_agb_profile(:,:))) then - ! ! Set the new patches pointers - ! head_of_unsorted_patch_list%older => currentpatch%older - ! head_of_unsorted_patch_list%younger => currentpatch - ! ! Fix the patch's older pointer - ! currentpatch%older => head_of_unsorted_patch_list - ! ! Fix the older patch's younger pointer - ! olderpatch%younger => head_of_unsorted_patch_list - ! ! Exit the loop once head sorted to avoid later re-sort - ! exit - ! end if - ! end if - ! currentPatch => olderpatch - ! enddo - ! end if - - ! ! now work through to the next element in the unsorted linked list - ! head_of_unsorted_patch_list => next_in_unsorted_patch_list - ! end do - ! endif - ! Report Basal Area (as a check on if things were read in) ! ------------------------------------------------------------------------------ basal_area_pref = 0.0_r8 @@ -1085,11 +957,9 @@ subroutine set_inventory_cohort_type1(csite,bc_in,css_file_unit,npatches, & if( c_dbh> 0._r8)then temp_cohort%dbh = c_dbh call h_allom(c_dbh,temp_cohort%pft,temp_cohort%height) - write(fates_log(),*) 'jfn - using dbh' else temp_cohort%height = c_height call h2d_allom(c_height,temp_cohort%pft,temp_cohort%dbh) - write(fates_log(),*) 'jfn - using height' end if temp_cohort%canopy_trim = 1.0_r8 @@ -1313,9 +1183,9 @@ subroutine write_inventory_type1(currentSite) ilon_sign = 'W' end if - write(pss_name_out,'(A8,I2.2,A1,I5.5,A1,A1,I3.3,A1,I5.5,A1,A4)') & + write(pss_name_out,'(A8, I2.2, A1, I5.5, A1)') & 'pss_out_',ilat_int,'.',ilat_dec,ilat_sign,'_',ilon_int,'.',ilon_dec,ilon_sign,'.txt' - write(css_name_out,'(A8,I2.2,A1,I5.5,A1,A1,I3.3,A1,I5.5,A1,A4)') & + write(css_name_out,'(A8, I2.2, A1, A1, I3.3, A1)') & 'css_out_',ilat_int,'.',ilat_dec,ilat_sign,'_',ilon_int,'.',ilon_dec,ilon_sign,'.txt' pss_file_out = shr_file_getUnit() @@ -1334,16 +1204,14 @@ subroutine write_inventory_type1(currentSite) write(patch_str,'(A7,i4.4,A)') '' - write(pss_file_out,*) '0000 ',trim(patch_str),' 2 ',currentPatch%age,currentPatch%area/AREA, & - '0.0000 0.0000 0.0000 0.0000 0.0000 0.0000 0.0000 0.0000' + write(pss_file_out,*) '0000 ',trim(patch_str),' 2 ',currentPatch%age,currentPatch%area/AREA icohort=0 currentcohort => currentpatch%tallest do while(associated(currentcohort)) icohort=icohort+1 - write(cohort_str,'(A7,i4.4,A)') '' - write(css_file_out,*) '0000 ',trim(patch_str),' ',trim(cohort_str), & - currentCohort%dbh,0.0,currentCohort%pft,currentCohort%n/currentPatch%area,0.0,0.0,0.0 + write(css_file_out,*) '0000 ',trim(patch_str), & + currentCohort%dbh,currentCohort%height,currentCohort%pft,currentCohort%n/currentPatch%area currentcohort => currentcohort%shorter end do From 00c0ab81d1cbc06e0f94987dccda1971090f8084 Mon Sep 17 00:00:00 2001 From: jessica needham Date: Thu, 2 Nov 2023 16:14:25 -0700 Subject: [PATCH 12/13] remove another cohort name from write css --- main/FatesInventoryInitMod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/main/FatesInventoryInitMod.F90 b/main/FatesInventoryInitMod.F90 index c462c45112..b3d305d48d 100644 --- a/main/FatesInventoryInitMod.F90 +++ b/main/FatesInventoryInitMod.F90 @@ -1195,7 +1195,7 @@ subroutine write_inventory_type1(currentSite) open(unit=css_file_out,file=trim(css_name_out), status='UNKNOWN',action='WRITE',form='FORMATTED') write(pss_file_out,*) 'time patch trk age area' - write(css_file_out,*) 'time patch cohort dbh height pft nplant' + write(css_file_out,*) 'time patch dbh height pft nplant' ipatch=0 currentpatch => currentSite%youngest_patch From 44f9a4aa1e8eec5e75ba8f831c4fbea827e7a450 Mon Sep 17 00:00:00 2001 From: jessica needham Date: Thu, 2 Nov 2023 17:11:05 -0700 Subject: [PATCH 13/13] remove debugging checks --- main/FatesInventoryInitMod.F90 | 10 +--------- 1 file changed, 1 insertion(+), 9 deletions(-) diff --git a/main/FatesInventoryInitMod.F90 b/main/FatesInventoryInitMod.F90 index b3d305d48d..304c40cfb0 100644 --- a/main/FatesInventoryInitMod.F90 +++ b/main/FatesInventoryInitMod.F90 @@ -168,9 +168,7 @@ subroutine initialize_sites_by_inventory(nsites,sites,bc_in) character(len=patchname_strlen), allocatable :: patch_name_vec(:) ! vector of patch ID strings real(r8) :: basal_area_postf ! basal area before fusion (m2/ha) real(r8) :: basal_area_pref ! basal area after fusion (m2/ha) - real(r8) :: n_pref - real(r8) :: n_postf - + ! I. Load the inventory list file, do some file handle checks ! ------------------------------------------------------------------------------------------ @@ -405,14 +403,12 @@ subroutine initialize_sites_by_inventory(nsites,sites,bc_in) ! Report Basal Area (as a check on if things were read in) ! ------------------------------------------------------------------------------ basal_area_pref = 0.0_r8 - n_pref = 0.0_r8 currentpatch => sites(s)%youngest_patch do while(associated(currentpatch)) currentcohort => currentpatch%tallest do while(associated(currentcohort)) basal_area_pref = basal_area_pref + & currentcohort%n*0.25*((currentcohort%dbh/100.0_r8)**2.0_r8)*pi_const - n_pref = n_pref + currentcohort%n currentcohort => currentcohort%shorter end do currentPatch => currentpatch%older @@ -422,7 +418,6 @@ subroutine initialize_sites_by_inventory(nsites,sites,bc_in) write(fates_log(),*) 'Basal Area from inventory, BEFORE fusion' write(fates_log(),*) 'Lat: ',sites(s)%lat,' Lon: ',sites(s)%lon write(fates_log(),*) basal_area_pref,' [m2/ha]' - write(fates_log(),*) 'number of plants: ', n_pref write(fates_log(),*) '-------------------------------------------------------' ! Update the patch index numbers and fuse the cohorts in the patches @@ -460,14 +455,12 @@ subroutine initialize_sites_by_inventory(nsites,sites,bc_in) ! ---------------------------------------------------------------------------------------- !call canopy_structure(sites(s),bc_in(s)) basal_area_postf = 0.0_r8 - n_postf = 0.0_r8 currentpatch => sites(s)%youngest_patch do while(associated(currentpatch)) currentcohort => currentpatch%tallest do while(associated(currentcohort)) basal_area_postf = basal_area_postf + & currentcohort%n*0.25*((currentcohort%dbh/100.0_r8)**2.0_r8)*pi_const - n_postf = n_postf + currentcohort%n currentcohort => currentcohort%shorter end do @@ -480,7 +473,6 @@ subroutine initialize_sites_by_inventory(nsites,sites,bc_in) write(fates_log(),*) 'Basal Area from inventory, AFTER fusion' write(fates_log(),*) 'Lat: ',sites(s)%lat,' Lon: ',sites(s)%lon write(fates_log(),*) basal_area_postf,' [m2/ha]' - write(fates_log(),*) 'jfn n post f :', n_postf write(fates_log(),*) '-------------------------------------------------------' ! If this is flagged as true, the post-fusion inventory will be written to file