diff --git a/ChangeLog b/ChangeLog index 1c6a1b418a..2bf37e8cc1 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,4 +1,175 @@ =============================================================== +Tag name: clm4_5_8_r180 +Originator(s): sacks (Bill Sacks) +Date: Mon Jun 6 06:13:57 MDT 2016 +One-line Summary: Refactor dyn_cnbal_patch + +Purpose of changes +------------------ + +There was a lot of duplicated code, as well as almost-but-not-quite-duplicated +code in dyn_cnbal_patch (the code used for updating patch-level BGC variables +when patch weights change). This tag consolidates this duplicated code into some +new shared infrastructure, similar to what is done for column-level variables. + +In addition, do not zero states when patch weights go to zero. (I expected this +to change answers for 1-d history files, but it didn't.) + +Bugs fixed or introduced +------------------------ + +Bugs fixed (include bugzilla ID): +- 2317: incorrect handling of isotopes with transient PFTs starting in clm4_5_1_r097 + + +Notes of particular relevance for users +--------------------------------------- + +Caveats for users (e.g., need to interpolate initial conditions): none + +Changes to CLM's user interface (e.g., new/renamed XML or namelist variables): none + +Changes made to namelist defaults (e.g., changed parameter values): none + +Changes to the datasets (e.g., parameter, surface or initial files): none + +Substantial timing or memory changes: small timing increase: about 10% increase +in dyn_cnbal_patch, amounting to a 0.3% increase in total CLM runtime (for both +transient and non-transient runs). + + +Code reviews and testing +------------------------ + +Code reviewed by: self + +CLM testing: + + [PASS means all tests PASS and OK means tests PASS other than expected fails.] + +NOTE: testing done on +refactor_seed_calculation_n01_maintain_state_zero_weight_n01_dynlu_conserve_cn3_n03_clm4_5_8_r179; +very minor changes since then tested with +SMS_Ld5_D_P24x1.f10_f10.IRCP45CLM45BGC.hobart_nag.clm-decStart + + build-namelist tests: + + yellowstone - not run + + unit-tests (components/clm/src): + + yellowstone - pass + + tools-tests (components/clm/test/tools): + + yellowstone - not run + + PTCLM testing (components/clm/tools/shared/PTCLM/test): + + yellowstone - not run + + regular tests (aux_clm40, aux_clm45): + + yellowstone_intel - ok + yellowstone_pgi - ok + yellowstone_gnu (clm45 only) - ok + hobart_nag - ok + + ok means tests pass, expected baseline failures as noted below + +CLM tag used for the baseline comparisons: clm4_5_8_r179 + CLM40 compared with clm4_5_8_r178 (baselines missing for r179) + + +Answer changes +-------------- + +Changes answers relative to baseline: + + If a tag changes answers relative to baseline comparison the + following should be filled in (otherwise remove this section): + + Summarize any changes to answers, i.e., + - what code configurations: CLM45 / CLM50 transient and CNDV runs + - what platforms/compilers: all + - nature of change (roundoff; larger than roundoff/same climate; new climate): + + Roundoff-level changes + + Greater than roundoff-level for transient runs with isotopes, due to fixing + bug 2317 + + If bitwise differences were observed, how did you show they were no worse + than roundoff? + + Created a branch (dynlu_conserve_cn3_oneoff) that was as similar as possible + to the trunk, with just those changes needed to get bit-for-bit behavior with + my new code (e.g., reordering some calculations). Confirmed that my new code + is bit-for-bit with that. + + If this tag changes climate describe the run(s) done to evaluate the new + climate (put details of the simulations in the experiment database) + - casename: N/A + + URL for LMWG diagnostics output used to validate new climate: N/A + + +Detailed list of changes +------------------------ + +List any svn externals directories updated (cime, rtm, cism, etc.): none + +List all files eliminated: none + +List all files added and what they do: + +========= New, shared infrastructure for updating patch-level variables +A components/clm/src/dyn_subgrid/dynPatchStateUpdaterMod.F90 +A components/clm/src/dyn_subgrid/test/dynPatchStateUpdater_test/CMakeLists.txt +A components/clm/src/dyn_subgrid/test/dynPatchStateUpdater_test/test_patch_state_updater.pf +A components/clm/src/dyn_subgrid/test/dynPatchStateUpdater_test + +========= Extract code common to carbon and nitrogen, for computing seed amounts +A components/clm/src/biogeochem/CNVegComputeSeedMod.F90 +A components/clm/src/biogeochem/test/CNVegComputeSeed_test/CMakeLists.txt +A components/clm/src/biogeochem/test/CNVegComputeSeed_test/test_ComputeSeedAmounts.pf +A components/clm/src/biogeochem/test/CNVegComputeSeed_test + +========= Define constants for identifying whether we're operating on c12, c13, + c14 or n (used in CNVegComputeSeedMod) +A components/clm/src/biogeochem/CNSpeciesMod.F90 + +List all existing files that have been modified, and describe the changes: + +========= Remove a bunch of code - moved to new infrastructure +M components/clm/src/biogeochem/dynConsBiogeochemMod.F90 + +========= Make calls to new patch state updater for each necessary variable +M components/clm/src/biogeochem/CNVegCarbonStateType.F90 +M components/clm/src/biogeochem/CNVegNitrogenStateType.F90 + +========= Set up patch state updater +M components/clm/src/dyn_subgrid/dynSubgridDriverMod.F90 + +========= Other minor changes needed to use the new infrastructure +M components/clm/src/biogeochem/CNVegetationFacade.F90 + +========= Add some unit tests, and some related unit testing infrastructure +M components/clm/src/biogeochem/test/CMakeLists.txt +M components/clm/src/main/pftconMod.F90 +M components/clm/src/biogeochem/CMakeLists.txt +M components/clm/src/dyn_subgrid/CMakeLists.txt +M components/clm/src/dyn_subgrid/test/CMakeLists.txt +M components/clm/src/unit_test_shr/unittestSimpleSubgridSetupsMod.F90 + +========= Remove a bit of unused code +M components/clm/src/dyn_subgrid/dynColumnStateUpdaterMod.F90 + +========= Remove a test that has been passing for a while, and one that no longer exists +M components/clm/cime_config/testdefs/ExpectedTestFails.xml + +=============================================================== +=============================================================== Tag name: clm4_5_8_r179 Originator(s): sacks (Bill Sacks) Date: Fri May 27 10:39:15 MDT 2016 diff --git a/components/clm/cime_config/testdefs/ExpectedTestFails.xml b/components/clm/cime_config/testdefs/ExpectedTestFails.xml index 90646cea75..8dda32f063 100644 --- a/components/clm/cime_config/testdefs/ExpectedTestFails.xml +++ b/components/clm/cime_config/testdefs/ExpectedTestFails.xml @@ -12,12 +12,9 @@ RUN ERP_Ld5.f09_g16.ICLM45VIC.yellowstone_pgi.clm-vrtlay_interp RUN ERI_N2_Ld9.f19_g16.ICRUCLM45BGCCROP.yellowstone_intel.clm-default - RUN SMS_D_Lm1_Mmpi-serial.CLM_USRDAT.I1PTCLM45.yellowstone_pgi.clm-USUMB - RUN ERP_Ly5.1x1_numaIA.ICRUCLM50BGCCROP.hobart_nag.clm-monthly RUN ERP_Ld5_P24x1.f10_f10.I1850CLM45BGC.hobart_nag.clm-default - RUN ERP_Ly5.1x1_numaIA.ICRUCLM50BGCCROP.hobart_nag.clm-clm50BGCCROPmonthly FAIL ERS_D_Ld5.f19_g16.ICLM45ED.yellowstone_pgi.clm-edTest.clm2.h0.nc : test compare clm2.h0 (.base and .rest files) FAIL ERS_D_Ld5.f19_g16.ICLM45ED.yellowstone_pgi.clm-edTest.cpl.hi.nc : test compare cpl.hi (.base and .rest files) diff --git a/components/clm/doc/ChangeLog b/components/clm/doc/ChangeLog index 1c6a1b418a..2bf37e8cc1 100644 --- a/components/clm/doc/ChangeLog +++ b/components/clm/doc/ChangeLog @@ -1,4 +1,175 @@ =============================================================== +Tag name: clm4_5_8_r180 +Originator(s): sacks (Bill Sacks) +Date: Mon Jun 6 06:13:57 MDT 2016 +One-line Summary: Refactor dyn_cnbal_patch + +Purpose of changes +------------------ + +There was a lot of duplicated code, as well as almost-but-not-quite-duplicated +code in dyn_cnbal_patch (the code used for updating patch-level BGC variables +when patch weights change). This tag consolidates this duplicated code into some +new shared infrastructure, similar to what is done for column-level variables. + +In addition, do not zero states when patch weights go to zero. (I expected this +to change answers for 1-d history files, but it didn't.) + +Bugs fixed or introduced +------------------------ + +Bugs fixed (include bugzilla ID): +- 2317: incorrect handling of isotopes with transient PFTs starting in clm4_5_1_r097 + + +Notes of particular relevance for users +--------------------------------------- + +Caveats for users (e.g., need to interpolate initial conditions): none + +Changes to CLM's user interface (e.g., new/renamed XML or namelist variables): none + +Changes made to namelist defaults (e.g., changed parameter values): none + +Changes to the datasets (e.g., parameter, surface or initial files): none + +Substantial timing or memory changes: small timing increase: about 10% increase +in dyn_cnbal_patch, amounting to a 0.3% increase in total CLM runtime (for both +transient and non-transient runs). + + +Code reviews and testing +------------------------ + +Code reviewed by: self + +CLM testing: + + [PASS means all tests PASS and OK means tests PASS other than expected fails.] + +NOTE: testing done on +refactor_seed_calculation_n01_maintain_state_zero_weight_n01_dynlu_conserve_cn3_n03_clm4_5_8_r179; +very minor changes since then tested with +SMS_Ld5_D_P24x1.f10_f10.IRCP45CLM45BGC.hobart_nag.clm-decStart + + build-namelist tests: + + yellowstone - not run + + unit-tests (components/clm/src): + + yellowstone - pass + + tools-tests (components/clm/test/tools): + + yellowstone - not run + + PTCLM testing (components/clm/tools/shared/PTCLM/test): + + yellowstone - not run + + regular tests (aux_clm40, aux_clm45): + + yellowstone_intel - ok + yellowstone_pgi - ok + yellowstone_gnu (clm45 only) - ok + hobart_nag - ok + + ok means tests pass, expected baseline failures as noted below + +CLM tag used for the baseline comparisons: clm4_5_8_r179 + CLM40 compared with clm4_5_8_r178 (baselines missing for r179) + + +Answer changes +-------------- + +Changes answers relative to baseline: + + If a tag changes answers relative to baseline comparison the + following should be filled in (otherwise remove this section): + + Summarize any changes to answers, i.e., + - what code configurations: CLM45 / CLM50 transient and CNDV runs + - what platforms/compilers: all + - nature of change (roundoff; larger than roundoff/same climate; new climate): + + Roundoff-level changes + + Greater than roundoff-level for transient runs with isotopes, due to fixing + bug 2317 + + If bitwise differences were observed, how did you show they were no worse + than roundoff? + + Created a branch (dynlu_conserve_cn3_oneoff) that was as similar as possible + to the trunk, with just those changes needed to get bit-for-bit behavior with + my new code (e.g., reordering some calculations). Confirmed that my new code + is bit-for-bit with that. + + If this tag changes climate describe the run(s) done to evaluate the new + climate (put details of the simulations in the experiment database) + - casename: N/A + + URL for LMWG diagnostics output used to validate new climate: N/A + + +Detailed list of changes +------------------------ + +List any svn externals directories updated (cime, rtm, cism, etc.): none + +List all files eliminated: none + +List all files added and what they do: + +========= New, shared infrastructure for updating patch-level variables +A components/clm/src/dyn_subgrid/dynPatchStateUpdaterMod.F90 +A components/clm/src/dyn_subgrid/test/dynPatchStateUpdater_test/CMakeLists.txt +A components/clm/src/dyn_subgrid/test/dynPatchStateUpdater_test/test_patch_state_updater.pf +A components/clm/src/dyn_subgrid/test/dynPatchStateUpdater_test + +========= Extract code common to carbon and nitrogen, for computing seed amounts +A components/clm/src/biogeochem/CNVegComputeSeedMod.F90 +A components/clm/src/biogeochem/test/CNVegComputeSeed_test/CMakeLists.txt +A components/clm/src/biogeochem/test/CNVegComputeSeed_test/test_ComputeSeedAmounts.pf +A components/clm/src/biogeochem/test/CNVegComputeSeed_test + +========= Define constants for identifying whether we're operating on c12, c13, + c14 or n (used in CNVegComputeSeedMod) +A components/clm/src/biogeochem/CNSpeciesMod.F90 + +List all existing files that have been modified, and describe the changes: + +========= Remove a bunch of code - moved to new infrastructure +M components/clm/src/biogeochem/dynConsBiogeochemMod.F90 + +========= Make calls to new patch state updater for each necessary variable +M components/clm/src/biogeochem/CNVegCarbonStateType.F90 +M components/clm/src/biogeochem/CNVegNitrogenStateType.F90 + +========= Set up patch state updater +M components/clm/src/dyn_subgrid/dynSubgridDriverMod.F90 + +========= Other minor changes needed to use the new infrastructure +M components/clm/src/biogeochem/CNVegetationFacade.F90 + +========= Add some unit tests, and some related unit testing infrastructure +M components/clm/src/biogeochem/test/CMakeLists.txt +M components/clm/src/main/pftconMod.F90 +M components/clm/src/biogeochem/CMakeLists.txt +M components/clm/src/dyn_subgrid/CMakeLists.txt +M components/clm/src/dyn_subgrid/test/CMakeLists.txt +M components/clm/src/unit_test_shr/unittestSimpleSubgridSetupsMod.F90 + +========= Remove a bit of unused code +M components/clm/src/dyn_subgrid/dynColumnStateUpdaterMod.F90 + +========= Remove a test that has been passing for a while, and one that no longer exists +M components/clm/cime_config/testdefs/ExpectedTestFails.xml + +=============================================================== +=============================================================== Tag name: clm4_5_8_r179 Originator(s): sacks (Bill Sacks) Date: Fri May 27 10:39:15 MDT 2016 diff --git a/components/clm/doc/ChangeSum b/components/clm/doc/ChangeSum index 32aa77b45c..9a5ddc2fec 100644 --- a/components/clm/doc/ChangeSum +++ b/components/clm/doc/ChangeSum @@ -1,5 +1,6 @@ Tag Who Date Summary ============================================================================================================================ + clm4_5_8_r180 sacks 06/06/2016 Refactor dyn_cnbal_patch clm4_5_8_r179 sacks 05/27/2016 Update column-level BGC state variables with dynamic landunits clm4_5_8_r178 sacks 04/17/2016 Remove some consistency checks, and merge crop_prog with use_crop in code clm4_5_8_r177 sacks 04/14/2016 Move CN product pools to gridcell level diff --git a/components/clm/doc/UsersGuide/clm_ug.xml b/components/clm/doc/UsersGuide/clm_ug.xml index b47dadc081..6406af803d 100644 --- a/components/clm/doc/UsersGuide/clm_ug.xml +++ b/components/clm/doc/UsersGuide/clm_ug.xml @@ -162,7 +162,7 @@ The purpose of this guide is to instruct both the novice and experienced user, a -$URL: https://svn-ccsm-models.cgd.ucar.edu/clm2/trunk_tags/clm4_5_8_r179/components/clm/doc/UsersGuide/clm_ug.xml $ +$URL: https://svn-ccsm-models.cgd.ucar.edu/clm2/trunk_tags/clm4_5_8_r180/components/clm/doc/UsersGuide/clm_ug.xml $ &build_date; diff --git a/components/clm/src/biogeochem/CMakeLists.txt b/components/clm/src/biogeochem/CMakeLists.txt index c0fc5579d5..0a7ef162f4 100644 --- a/components/clm/src/biogeochem/CMakeLists.txt +++ b/components/clm/src/biogeochem/CMakeLists.txt @@ -3,6 +3,8 @@ list(APPEND clm_sources CNSharedParamsMod.F90 + CNSpeciesMod.F90 + CNVegComputeSeedMod.F90 SpeciesBaseType.F90 SpeciesIsotopeType.F90 SpeciesNonIsotopeType.F90 diff --git a/components/clm/src/biogeochem/CNSpeciesMod.F90 b/components/clm/src/biogeochem/CNSpeciesMod.F90 new file mode 100644 index 0000000000..fc89f3ac02 --- /dev/null +++ b/components/clm/src/biogeochem/CNSpeciesMod.F90 @@ -0,0 +1,68 @@ +module CNSpeciesMod + + !----------------------------------------------------------------------- + ! Module holding information about different species available in the CN code (C, C13, + ! C14, N). + ! + ! + ! NOTE(wjs, 2016-06-05) Eventually I could imagine having a cn_species base class, with + ! derived classes for each species type - so a cn_species_c class, a cn_species_c13 + ! class, a cn_species_c14 class and a cn_species_n class. These would contain methods + ! to handle calculations specific to each species type. For example, there could be a + ! carbon_multiplier method that returns the species-specific multiplier that you would + ! apply to a variable in units of gC/m2 to give you g[this species]/m2 (this would + ! depend on pft type). + ! + ! Basically, anywhere where there is code that has a conditional based on the constants + ! defined here, we could replace that with polymorphism using a cn_species class. + ! + ! Eventually I think it would make sense to make this contain an instance of + ! species_base_type (i.e., the class used to determine history & restart field names), + ! with forwarding methods. So then (e.g.) a cn_products_type object would just contain a + ! cn_species object (which in turn would contain a species_metadata [or whatever we call + ! it] object). + + implicit none + private + + integer, parameter, public :: CN_SPECIES_C12 = 1 + integer, parameter, public :: CN_SPECIES_C13 = 2 + integer, parameter, public :: CN_SPECIES_C14 = 3 + integer, parameter, public :: CN_SPECIES_N = 4 + + public :: species_from_string ! convert a string representation to one of the constants defined here + +contains + + !----------------------------------------------------------------------- + function species_from_string(species_string) result(species) + ! + ! !DESCRIPTION: + ! Convert a string representation to one of the constants defined here + ! + ! !USES: + ! + ! !ARGUMENTS: + integer :: species ! function result + character(len=*), intent(in) :: species_string ! string representation of species (should be lowercase) + ! + ! !LOCAL VARIABLES: + + character(len=*), parameter :: subname = 'species_from_string' + !----------------------------------------------------------------------- + + select case (species_string) + case ('c12') + species = CN_SPECIES_C12 + case ('c13') + species = CN_SPECIES_C13 + case ('c14') + species = CN_SPECIES_C14 + case ('n') + species = CN_SPECIES_N + end select + + end function species_from_string + + +end module CNSpeciesMod diff --git a/components/clm/src/biogeochem/CNVegCarbonStateType.F90 b/components/clm/src/biogeochem/CNVegCarbonStateType.F90 index c1ae58c3f7..dc1b5140cc 100644 --- a/components/clm/src/biogeochem/CNVegCarbonStateType.F90 +++ b/components/clm/src/biogeochem/CNVegCarbonStateType.F90 @@ -10,7 +10,7 @@ module CNVegCarbonStateType use shr_const_mod , only : SHR_CONST_PDB use shr_log_mod , only : errMsg => shr_log_errMsg use pftconMod , only : noveg, npcropmin, pftcon - use clm_varcon , only : spval, c3_r2, c4_r2 + use clm_varcon , only : spval, c3_r2, c4_r2, c14ratio use clm_varctl , only : iulog, use_cndv, use_crop use decompMod , only : bounds_type use abortutils , only : endrun @@ -18,13 +18,19 @@ module CNVegCarbonStateType use LandunitType , only : lun use ColumnType , only : col use PatchType , only : patch + use CNSpeciesMod , only : species_from_string, CN_SPECIES_C12 + use dynPatchStateUpdaterMod, only : patch_state_updater_type + use CNVegComputeSeedMod, only : ComputeSeedAmounts ! ! !PUBLIC TYPES: implicit none private ! + type, public :: cnveg_carbonstate_type - + + integer :: species ! c12, c13, c14 + real(r8), pointer :: grainc_patch (:) ! (gC/m2) grain C (crop model) real(r8), pointer :: grainc_storage_patch (:) ! (gC/m2) grain C storage (crop model) real(r8), pointer :: grainc_xfer_patch (:) ! (gC/m2) grain C transfer (crop model) @@ -81,14 +87,16 @@ module CNVegCarbonStateType contains procedure , public :: Init - procedure , public :: SetValues + procedure , public :: SetValues procedure , public :: ZeroDWT procedure , public :: Restart procedure , public :: Summary => Summary_carbonstate + procedure , public :: DynamicPatchAdjustments ! adjust state variables when patch areas change procedure , public :: DynamicColumnAdjustments ! adjust state variables when column areas change - procedure , private :: InitAllocate + + procedure , private :: InitAllocate procedure , private :: InitHistory - procedure , private :: InitCold + procedure , private :: InitCold end type cnveg_carbonstate_type @@ -106,10 +114,12 @@ subroutine Init(this, bounds, carbon_type, ratio, c12_cnveg_carbonstate_inst) class(cnveg_carbonstate_type) :: this type(bounds_type) , intent(in) :: bounds real(r8) , intent(in) :: ratio - character(len=3) , intent(in) :: carbon_type + character(len=*) , intent(in) :: carbon_type type(cnveg_carbonstate_type) , intent(in), optional :: c12_cnveg_carbonstate_inst !----------------------------------------------------------------------- + this%species = species_from_string(carbon_type) + call this%InitAllocate ( bounds) call this%InitHistory ( bounds, carbon_type) if (present(c12_cnveg_carbonstate_inst)) then @@ -200,7 +210,7 @@ subroutine InitHistory(this, bounds, carbon_type) ! !ARGUMENTS: class (cnveg_carbonstate_type) :: this type(bounds_type) , intent(in) :: bounds - character(len=3) , intent(in) :: carbon_type ! one of ['c12', c13','c14'] + character(len=*) , intent(in) :: carbon_type ! one of ['c12', c13','c14'] ! ! !LOCAL VARIABLES: integer :: k,l,ii,jj @@ -788,7 +798,7 @@ subroutine InitCold(this, bounds, ratio, carbon_type, c12_cnveg_carbonstate_inst class(cnveg_carbonstate_type) :: this type(bounds_type) , intent(in) :: bounds real(r8) , intent(in) :: ratio - character(len=3) , intent(in) :: carbon_type ! 'c12' or 'c13' or 'c14' + character(len=*) , intent(in) :: carbon_type ! 'c12' or 'c13' or 'c14' type(cnveg_carbonstate_type) , optional, intent(in) :: c12_cnveg_carbonstate_inst ! ! !LOCAL VARIABLES: @@ -1026,7 +1036,6 @@ subroutine Restart ( this, bounds, ncid, flag, carbon_type, c12_cnveg_carbonsta ! ! !USES: use shr_infnan_mod , only : isnan => shr_infnan_isnan, nan => shr_infnan_nan, assignment(=) - use clm_varcon , only : c14ratio use clm_varctl , only : spinup_state, use_cndv use clm_time_manager , only : get_nstep use restUtilMod @@ -1037,7 +1046,7 @@ subroutine Restart ( this, bounds, ncid, flag, carbon_type, c12_cnveg_carbonsta type(bounds_type) , intent(in) :: bounds type(file_desc_t) , intent(inout) :: ncid ! netcdf id character(len=*) , intent(in) :: flag !'read' or 'write' - character(len=3) , intent(in) :: carbon_type ! 'c12' or 'c13' or 'c14' + character(len=*) , intent(in) :: carbon_type ! 'c12' or 'c13' or 'c14' type (cnveg_carbonstate_type) , intent(in), optional :: c12_cnveg_carbonstate_inst ! ! !LOCAL VARIABLES: @@ -2201,6 +2210,234 @@ subroutine Summary_carbonstate(this, bounds, num_allc, filter_allc, & end subroutine Summary_carbonstate + !----------------------------------------------------------------------- + subroutine DynamicPatchAdjustments(this, bounds, & + num_soilp_with_inactive, filter_soilp_with_inactive, & + patch_state_updater, & + leafc_seed, deadstemc_seed, & + conv_cflux, product_cflux, & + dwt_frootc_to_litter, & + dwt_livecrootc_to_litter, & + dwt_deadcrootc_to_litter, & + dwt_leafc_seed, & + dwt_deadstemc_seed) + ! + ! !DESCRIPTION: + ! Adjust state variables and compute associated fluxes when patch areas change due to + ! dynamic landuse + ! + ! !USES: + ! + ! !ARGUMENTS: + class(cnveg_carbonstate_type) , intent(inout) :: this + type(bounds_type) , intent(in) :: bounds + integer , intent(in) :: num_soilp_with_inactive ! number of points in filter + integer , intent(in) :: filter_soilp_with_inactive(:) ! soil patch filter that includes inactive points + type(patch_state_updater_type) , intent(in) :: patch_state_updater + real(r8) , intent(in) :: leafc_seed ! seed amount for leaf C + real(r8) , intent(in) :: deadstemc_seed ! seed amount for deadstem C + real(r8) , intent(inout) :: conv_cflux( bounds%begp: ) ! patch-level conversion C flux to atm + real(r8) , intent(inout) :: product_cflux( bounds%begp: ) ! patch-level product C flux + real(r8) , intent(inout) :: dwt_frootc_to_litter( bounds%begp: ) ! patch-level fine root C to litter + real(r8) , intent(inout) :: dwt_livecrootc_to_litter( bounds%begp: ) ! patch-level live coarse root C to litter + real(r8) , intent(inout) :: dwt_deadcrootc_to_litter( bounds%begp: ) ! patch-level live coarse root C to litter + real(r8) , intent(inout) :: dwt_leafc_seed( bounds%begp: ) ! patch-level mass gain due to seeding of new area: leaf C + real(r8) , intent(inout) :: dwt_deadstemc_seed( bounds%begp: ) ! patch-level mass gain due to seeding of new area: deadstem C + ! + ! !LOCAL VARIABLES: + integer :: begp, endp + + logical :: old_weight_was_zero(bounds%begp:bounds%endp) + logical :: patch_grew(bounds%begp:bounds%endp) + + ! The following are only set for growing patches: + real(r8) :: seed_leafc_patch(bounds%begp:bounds%endp) + real(r8) :: seed_leafc_storage_patch(bounds%begp:bounds%endp) + real(r8) :: seed_leafc_xfer_patch(bounds%begp:bounds%endp) + real(r8) :: seed_deadstemc_patch(bounds%begp:bounds%endp) + + character(len=*), parameter :: subname = 'DynamicPatchAdjustments' + !----------------------------------------------------------------------- + + begp = bounds%begp + endp = bounds%endp + + SHR_ASSERT_ALL((ubound(conv_cflux) == (/endp/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(product_cflux) == (/endp/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(dwt_frootc_to_litter) == (/endp/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(dwt_livecrootc_to_litter) == (/endp/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(dwt_deadcrootc_to_litter) == (/endp/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(dwt_leafc_seed) == (/endp/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(dwt_deadstemc_seed) == (/endp/)), errMsg(__FILE__, __LINE__)) + + old_weight_was_zero = patch_state_updater%old_weight_was_zero(bounds) + patch_grew = patch_state_updater%patch_grew(bounds) + + call ComputeSeedAmounts(bounds, & + num_soilp_with_inactive, filter_soilp_with_inactive, & + species = this%species, & + leafc_seed = leafc_seed, & + deadstemc_seed = deadstemc_seed, & + leaf_patch = this%leafc_patch(begp:endp), & + leaf_storage_patch = this%leafc_storage_patch(begp:endp), & + leaf_xfer_patch = this%leafc_xfer_patch(begp:endp), & + + ! Calculations only needed for patches that grew: + compute_here_patch = patch_grew(begp:endp), & + + ! For patches that previously had zero area, ignore the current state for the + ! sake of computing leaf proportions: + ignore_current_state_patch = old_weight_was_zero(begp:endp), & + + seed_leaf_patch = seed_leafc_patch(begp:endp), & + seed_leaf_storage_patch = seed_leafc_storage_patch(begp:endp), & + seed_leaf_xfer_patch = seed_leafc_xfer_patch(begp:endp), & + seed_deadstem_patch = seed_deadstemc_patch(begp:endp)) + + call update_patch_state( & + var = this%leafc_patch(begp:endp), & + flux_out = conv_cflux(begp:endp), & + seed = seed_leafc_patch(begp:endp), & + seed_addition = dwt_leafc_seed(begp:endp)) + + call update_patch_state( & + var = this%leafc_storage_patch(begp:endp), & + flux_out = conv_cflux(begp:endp), & + seed = seed_leafc_storage_patch(begp:endp), & + seed_addition = dwt_leafc_seed(begp:endp)) + + call update_patch_state( & + var = this%leafc_xfer_patch(begp:endp), & + flux_out = conv_cflux(begp:endp), & + seed = seed_leafc_xfer_patch(begp:endp), & + seed_addition = dwt_leafc_seed(begp:endp)) + + call update_patch_state( & + var = this%frootc_patch(begp:endp), & + flux_out = dwt_frootc_to_litter(begp:endp)) + + call update_patch_state( & + var = this%frootc_storage_patch(begp:endp), & + flux_out = conv_cflux(begp:endp)) + + call update_patch_state( & + var = this%frootc_xfer_patch(begp:endp), & + flux_out = conv_cflux(begp:endp)) + + call update_patch_state( & + var = this%livestemc_patch(begp:endp), & + flux_out = conv_cflux(begp:endp)) + + call update_patch_state( & + var = this%livestemc_storage_patch(begp:endp), & + flux_out = conv_cflux(begp:endp)) + + call update_patch_state( & + var = this%livestemc_xfer_patch(begp:endp), & + flux_out = conv_cflux(begp:endp)) + + call patch_state_updater%update_patch_state_partition_flux_by_type(bounds, & + num_soilp_with_inactive, filter_soilp_with_inactive, & + flux1_fraction_by_pft_type = pftcon%pconv, & + var = this%deadstemc_patch(begp:endp), & + flux1_out = conv_cflux(begp:endp), & + flux2_out = product_cflux(begp:endp), & + seed = seed_deadstemc_patch(begp:endp), & + seed_addition = dwt_deadstemc_seed(begp:endp)) + + call update_patch_state( & + var = this%deadstemc_storage_patch(begp:endp), & + flux_out = conv_cflux(begp:endp)) + + call update_patch_state( & + var = this%deadstemc_xfer_patch(begp:endp), & + flux_out = conv_cflux(begp:endp)) + + call update_patch_state( & + var = this%livecrootc_patch(begp:endp), & + flux_out = dwt_livecrootc_to_litter(begp:endp)) + + call update_patch_state( & + var = this%livecrootc_storage_patch(begp:endp), & + flux_out = conv_cflux(begp:endp)) + + call update_patch_state( & + var = this%livecrootc_xfer_patch(begp:endp), & + flux_out = conv_cflux(begp:endp)) + + call update_patch_state( & + var = this%deadcrootc_patch(begp:endp), & + flux_out = dwt_deadcrootc_to_litter(begp:endp)) + + call update_patch_state( & + var = this%deadcrootc_storage_patch(begp:endp), & + flux_out = conv_cflux(begp:endp)) + + call update_patch_state( & + var = this%deadcrootc_xfer_patch(begp:endp), & + flux_out = conv_cflux(begp:endp)) + + call update_patch_state( & + var = this%gresp_storage_patch(begp:endp), & + flux_out = conv_cflux(begp:endp)) + + call update_patch_state( & + var = this%gresp_xfer_patch(begp:endp), & + flux_out = conv_cflux(begp:endp)) + + call update_patch_state( & + var = this%cpool_patch(begp:endp), & + flux_out = conv_cflux(begp:endp)) + + ! BUG(wjs, 2016-06-01, bugz 2316) Probably the behavior should be the same for carbon + ! isotopes as for standard c12, but for now I'm preserving the old behavior. + if (this%species == CN_SPECIES_C12) then + call update_patch_state( & + var = this%xsmrpool_patch(begp:endp), & + flux_out = conv_cflux(begp:endp)) + else + call update_patch_state( & + var = this%xsmrpool_patch(begp:endp)) + end if + + call update_patch_state( & + var = this%ctrunc_patch(begp:endp), & + flux_out = conv_cflux(begp:endp)) + + ! The following are summary diagnostic variables, not involved in mass balance. + ! Hence, they do not have associated fluxes for area decreases. + + call update_patch_state( & + var = this%dispvegc_patch(begp:endp)) + + call update_patch_state( & + var = this%storvegc_patch(begp:endp)) + + call update_patch_state( & + var = this%totc_patch(begp:endp)) + + call update_patch_state( & + var = this%totvegc_patch(begp:endp)) + + contains + subroutine update_patch_state(var, flux_out, seed, seed_addition) + ! Wraps call to update_patch_state, in order to remove duplication + real(r8), intent(inout) :: var( bounds%begp: ) + real(r8), intent(inout), optional :: flux_out( bounds%begp: ) + real(r8), intent(in), optional :: seed( bounds%begp: ) + real(r8), intent(inout), optional :: seed_addition( bounds%begp: ) + + call patch_state_updater%update_patch_state(bounds, & + num_soilp_with_inactive, filter_soilp_with_inactive, & + var = var, & + flux_out = flux_out, & + seed = seed, & + seed_addition = seed_addition) + end subroutine update_patch_state + + end subroutine DynamicPatchAdjustments + + !----------------------------------------------------------------------- subroutine DynamicColumnAdjustments(this, bounds, column_state_updater) ! @@ -2227,5 +2464,4 @@ subroutine DynamicColumnAdjustments(this, bounds, column_state_updater) end subroutine DynamicColumnAdjustments - end module CNVegCarbonStateType diff --git a/components/clm/src/biogeochem/CNVegComputeSeedMod.F90 b/components/clm/src/biogeochem/CNVegComputeSeedMod.F90 new file mode 100644 index 0000000000..2d8762802a --- /dev/null +++ b/components/clm/src/biogeochem/CNVegComputeSeedMod.F90 @@ -0,0 +1,256 @@ +module CNVegComputeSeedMod + + !----------------------------------------------------------------------- + ! Module to compute seed amounts for new patch areas + ! + ! !USES: +#include "shr_assert.h" + + use shr_kind_mod , only : r8 => shr_kind_r8 + use shr_log_mod , only : errMsg => shr_log_errMsg + use decompMod , only : bounds_type + use pftconMod , only : pftcon, noveg + use clm_varcon , only : c3_r2, c4_r2, c14ratio + use clm_varctl , only : iulog + use PatchType , only : patch + use abortutils , only : endrun + use CNSpeciesMod , only : CN_SPECIES_C12, CN_SPECIES_C13, CN_SPECIES_C14, CN_SPECIES_N + ! + ! !PUBLIC ROUTINES: + implicit none + private + + public :: ComputeSeedAmounts + + ! !PRIVATE ROUTINES: + + private :: SpeciesTypeMultiplier + private :: LeafProportions ! compute leaf proportions (leaf, storage and xfer) + + ! !PRIVATE DATA: + + integer, parameter :: COMPONENT_LEAF = 1 + integer, parameter :: COMPONENT_DEADWOOD = 2 + +contains + + !----------------------------------------------------------------------- + subroutine ComputeSeedAmounts(bounds, & + num_soilp_with_inactive, filter_soilp_with_inactive, & + species, & + leafc_seed, deadstemc_seed, & + leaf_patch, leaf_storage_patch, leaf_xfer_patch, & + compute_here_patch, ignore_current_state_patch, & + seed_leaf_patch, seed_leaf_storage_patch, seed_leaf_xfer_patch, & + seed_deadstem_patch) + ! + ! !DESCRIPTION: + ! Compute seed amounts for patches that increase in area, for various variables, for + ! the given species (c12, c13, c14 or n). + ! + ! The output variables are only set for patches inside the filter, where + ! compute_here_patch is true; for other patches, they remain at their original values. + ! + ! Note that, regardless of the species, leafc_seed and deadstemc_seed are specified + ! in terms of gC/m2; these amounts are converted to the amount of the given species + ! here. + ! + ! !USES: + ! + ! !ARGUMENTS: + type(bounds_type) , intent(in) :: bounds + integer , intent(in) :: num_soilp_with_inactive ! number of points in filter + integer , intent(in) :: filter_soilp_with_inactive(:) ! soil patch filter that includes inactive points + integer , intent(in) :: species ! which C/N species we're operating on; should be one of the values in CNSpeciesMod + real(r8) , intent(in) :: leafc_seed ! seed amount for leaf C + real(r8) , intent(in) :: deadstemc_seed ! seed amount for deadstem C + real(r8) , intent(in) :: leaf_patch( bounds%begp: ) ! current leaf C or N content (g/m2) + real(r8) , intent(in) :: leaf_storage_patch( bounds%begp: ) ! current leaf C or N storage content (g/m2) + real(r8) , intent(in) :: leaf_xfer_patch( bounds%begp: ) ! current leaf C or N xfer content (g/m2) + + ! whether to compute outputs for each patch + logical, intent(in) :: compute_here_patch( bounds%begp: ) + + ! If ignore_current_state is true, then use default leaf proportions rather than + ! proportions based on current state. + logical, intent(in) :: ignore_current_state_patch( bounds%begp: ) + + real(r8), intent(inout) :: seed_leaf_patch( bounds%begp: ) ! seed amount for leaf itself for this species (g/m2) + real(r8), intent(inout) :: seed_leaf_storage_patch( bounds%begp: ) ! seed amount for leaf storage for this species (g/m2) + real(r8), intent(inout) :: seed_leaf_xfer_patch( bounds%begp: ) ! seed amount for leaf xfer for this species (g/m2) + real(r8), intent(inout) :: seed_deadstem_patch( bounds%begp: ) ! seed amount for deadstem for this species (g/m2) + ! + ! !LOCAL VARIABLES: + integer :: fp, p + integer :: begp, endp + real(r8) :: my_leaf_seed + real(r8) :: my_deadstem_seed + integer :: pft_type + real(r8) :: pleaf + real(r8) :: pstor + real(r8) :: pxfer + + character(len=*), parameter :: subname = 'ComputeSeedAmounts' + !----------------------------------------------------------------------- + + begp = bounds%begp + endp = bounds%endp + + SHR_ASSERT_ALL((ubound(leaf_patch) == (/endp/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(leaf_storage_patch) == (/endp/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(leaf_xfer_patch) == (/endp/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(compute_here_patch) == (/endp/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(ignore_current_state_patch) == (/endp/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(seed_leaf_patch) == (/endp/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(seed_leaf_storage_patch) == (/endp/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(seed_leaf_xfer_patch) == (/endp/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(seed_deadstem_patch) == (/endp/)), errMsg(__FILE__, __LINE__)) + + + do fp = 1, num_soilp_with_inactive + p = filter_soilp_with_inactive(fp) + + if (compute_here_patch(p)) then + + my_leaf_seed = 0._r8 + my_deadstem_seed = 0._r8 + + pft_type = patch%itype(p) + + call LeafProportions( & + ignore_current_state = ignore_current_state_patch(p), & + pft_type = pft_type, & + leaf = leaf_patch(p), & + leaf_storage = leaf_storage_patch(p), & + leaf_xfer = leaf_xfer_patch(p), & + pleaf = pleaf, & + pstorage = pstor, & + pxfer = pxfer) + + if (pft_type /= noveg) then + my_leaf_seed = leafc_seed * & + SpeciesTypeMultiplier(species, pft_type, COMPONENT_LEAF) + if (pftcon%woody(pft_type) == 1._r8) then + my_deadstem_seed = deadstemc_seed * & + SpeciesTypeMultiplier(species, pft_type, COMPONENT_DEADWOOD) + end if + end if + + seed_leaf_patch(p) = my_leaf_seed * pleaf + seed_leaf_storage_patch(p) = my_leaf_seed * pstor + seed_leaf_xfer_patch(p) = my_leaf_seed * pxfer + seed_deadstem_patch(p) = my_deadstem_seed + end if + + end do + + end subroutine ComputeSeedAmounts + + + !----------------------------------------------------------------------- + function SpeciesTypeMultiplier(species, pft_type, component) result(multiplier) + ! + ! !DESCRIPTION: + ! Returns a multiplier based on the species type. This multiplier is + ! meant to be applied to some state variable expressed in terms of g C, translating + ! this value into an appropriate value for c13, c14 or n. + ! + ! !USES: + ! + ! !ARGUMENTS: + real(r8) :: multiplier ! function result + integer, intent(in) :: species ! which C/N species we're operating on; should be one of the values in CNSpeciesMod + integer, intent(in) :: pft_type + integer, intent(in) :: component ! which plant component; should be one of the COMPONENT_* parameters defined in this module + ! + ! !LOCAL VARIABLES: + + character(len=*), parameter :: subname = 'SpeciesTypeMultiplier' + !----------------------------------------------------------------------- + + select case (species) + case (CN_SPECIES_C12) + multiplier = 1._r8 + + case (CN_SPECIES_C13) + if (pftcon%c3psn(pft_type) == 1._r8) then + multiplier = c3_r2 + else + multiplier = c4_r2 + end if + + case (CN_SPECIES_C14) + ! 14c state is initialized assuming initial "modern" 14C of 1.e-12 + multiplier = c14ratio + + case (CN_SPECIES_N) + select case (component) + case (COMPONENT_LEAF) + multiplier = 1._r8 / pftcon%leafcn(pft_type) + case (COMPONENT_DEADWOOD) + multiplier = 1._r8 / pftcon%deadwdcn(pft_type) + case default + write(iulog,*) subname//' ERROR: unknown component: ', component + call endrun(subname//': unknown component') + end select + + case default + write(iulog,*) subname//' ERROR: unknown species: ', species + call endrun(subname//': unknown species') + end select + + end function SpeciesTypeMultiplier + + + !----------------------------------------------------------------------- + subroutine LeafProportions(ignore_current_state, & + pft_type, & + leaf, leaf_storage, leaf_xfer, & + pleaf, pstorage, pxfer) + ! + ! !DESCRIPTION: + ! Compute leaf proportions (leaf, storage and xfer) + ! + ! If ignore_current_state is true, then use default proportions rather than + ! proportions based on current state. (Also use default proportions if total leaf mass + ! is 0 for this patch.) + ! + ! !USES: + ! + ! !ARGUMENTS: + logical, intent(in) :: ignore_current_state ! see comment above + integer , intent(in) :: pft_type + real(r8), intent(in) :: leaf ! g/m2 leaf C or N + real(r8), intent(in) :: leaf_storage ! g/m2 leaf C or N storage + real(r8), intent(in) :: leaf_xfer ! g/m2 leaf C or N transfer + + real(r8), intent(out) :: pleaf ! proportion in leaf itself + real(r8), intent(out) :: pstorage ! proportion in leaf storage + real(r8), intent(out) :: pxfer ! proportion in leaf xfer + ! + ! !LOCAL VARIABLES: + real(r8) :: tot_leaf + + character(len=*), parameter :: subname = 'LeafProportions' + !----------------------------------------------------------------------- + + tot_leaf = leaf + leaf_storage + leaf_xfer + pleaf = 0._r8 + pstorage = 0._r8 + pxfer = 0._r8 + + if (tot_leaf == 0._r8 .or. ignore_current_state) then + if (pftcon%evergreen(pft_type) == 1._r8) then + pleaf = 1._r8 + else + pstorage = 1._r8 + end if + else + pleaf = leaf/tot_leaf + pstorage = leaf_storage/tot_leaf + pxfer = leaf_xfer/tot_leaf + end if + + end subroutine LeafProportions + +end module CNVegComputeSeedMod diff --git a/components/clm/src/biogeochem/CNVegNitrogenStateType.F90 b/components/clm/src/biogeochem/CNVegNitrogenStateType.F90 index 9dcf5312ab..a1fe2d05c6 100644 --- a/components/clm/src/biogeochem/CNVegNitrogenStateType.F90 +++ b/components/clm/src/biogeochem/CNVegNitrogenStateType.F90 @@ -21,7 +21,10 @@ module CNVegNitrogenStateType use LandunitType , only : lun use ColumnType , only : col use PatchType , only : patch - ! + use dynPatchStateUpdaterMod, only : patch_state_updater_type + use CNSpeciesMod , only : CN_SPECIES_N + use CNVegComputeSeedMod, only : ComputeSeedAmounts + ! ! !PUBLIC TYPES: implicit none @@ -80,6 +83,7 @@ module CNVegNitrogenStateType procedure , public :: SetValues procedure , public :: ZeroDWT procedure , public :: Summary => Summary_nitrogenstate + procedure , public :: DynamicPatchAdjustments ! adjust state variables when patch areas change procedure , public :: DynamicColumnAdjustments ! adjust state variables when column areas change procedure , private :: InitAllocate procedure , private :: InitHistory @@ -956,6 +960,219 @@ subroutine Summary_nitrogenstate(this, bounds, num_allc, filter_allc, & end subroutine Summary_nitrogenstate + !----------------------------------------------------------------------- + subroutine DynamicPatchAdjustments(this, bounds, & + num_soilp_with_inactive, filter_soilp_with_inactive, & + patch_state_updater, & + leafc_seed, deadstemc_seed, & + conv_nflux, product_nflux, & + dwt_frootn_to_litter, & + dwt_livecrootn_to_litter, & + dwt_deadcrootn_to_litter, & + dwt_leafn_seed, & + dwt_deadstemn_seed) + ! + ! !DESCRIPTION: + ! Adjust state variables and compute associated fluxes when patch areas change due to + ! dynamic landuse + ! + ! !USES: + ! + ! !ARGUMENTS: + class(cnveg_nitrogenstate_type) , intent(inout) :: this + type(bounds_type) , intent(in) :: bounds + integer , intent(in) :: num_soilp_with_inactive ! number of points in filter + integer , intent(in) :: filter_soilp_with_inactive(:) ! soil patch filter that includes inactive points + type(patch_state_updater_type) , intent(in) :: patch_state_updater + real(r8) , intent(in) :: leafc_seed ! seed amount for leaf C + real(r8) , intent(in) :: deadstemc_seed ! seed amount for deadstem C + real(r8) , intent(inout) :: conv_nflux( bounds%begp: ) ! patch-level conversion N flux to atm + real(r8) , intent(inout) :: product_nflux( bounds%begp: ) ! patch-level product N flux + real(r8) , intent(inout) :: dwt_frootn_to_litter( bounds%begp: ) ! patch-level fine root N to litter + real(r8) , intent(inout) :: dwt_livecrootn_to_litter( bounds%begp: ) ! patch-level live coarse root N to litter + real(r8) , intent(inout) :: dwt_deadcrootn_to_litter( bounds%begp: ) ! patch-level live coarse root N to litter + real(r8) , intent(inout) :: dwt_leafn_seed( bounds%begp: ) ! patch-level mass gain due to seeding of new area: leaf N + real(r8) , intent(inout) :: dwt_deadstemn_seed( bounds%begp: ) ! patch-level mass gain due to seeding of new area: deadstem N + ! + ! !LOCAL VARIABLES: + integer :: begp, endp + + logical :: old_weight_was_zero(bounds%begp:bounds%endp) + logical :: patch_grew(bounds%begp:bounds%endp) + + ! The following are only set for growing patches: + real(r8) :: seed_leafn_patch(bounds%begp:bounds%endp) + real(r8) :: seed_leafn_storage_patch(bounds%begp:bounds%endp) + real(r8) :: seed_leafn_xfer_patch(bounds%begp:bounds%endp) + real(r8) :: seed_deadstemn_patch(bounds%begp:bounds%endp) + + character(len=*), parameter :: subname = 'DynamicPatchAdjustments' + !----------------------------------------------------------------------- + + begp = bounds%begp + endp = bounds%endp + + SHR_ASSERT_ALL((ubound(conv_nflux) == (/endp/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(product_nflux) == (/endp/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(dwt_frootn_to_litter) == (/endp/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(dwt_livecrootn_to_litter) == (/endp/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(dwt_deadcrootn_to_litter) == (/endp/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(dwt_leafn_seed) == (/endp/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(dwt_deadstemn_seed) == (/endp/)), errMsg(__FILE__, __LINE__)) + + old_weight_was_zero = patch_state_updater%old_weight_was_zero(bounds) + patch_grew = patch_state_updater%patch_grew(bounds) + + call ComputeSeedAmounts(bounds, & + num_soilp_with_inactive, filter_soilp_with_inactive, & + species = CN_SPECIES_N, & + leafc_seed = leafc_seed, & + deadstemc_seed = deadstemc_seed, & + leaf_patch = this%leafn_patch(begp:endp), & + leaf_storage_patch = this%leafn_storage_patch(begp:endp), & + leaf_xfer_patch = this%leafn_xfer_patch(begp:endp), & + + ! Calculations only needed for patches that grew: + compute_here_patch = patch_grew(begp:endp), & + + ! For patches that previously had zero area, ignore the current state for the + ! sake of computing leaf proportions: + ignore_current_state_patch = old_weight_was_zero(begp:endp), & + + seed_leaf_patch = seed_leafn_patch(begp:endp), & + seed_leaf_storage_patch = seed_leafn_storage_patch(begp:endp), & + seed_leaf_xfer_patch = seed_leafn_xfer_patch(begp:endp), & + seed_deadstem_patch = seed_deadstemn_patch(begp:endp)) + + call update_patch_state( & + var = this%leafn_patch(begp:endp), & + flux_out = conv_nflux(begp:endp), & + seed = seed_leafn_patch(begp:endp), & + seed_addition = dwt_leafn_seed(begp:endp)) + + call update_patch_state( & + var = this%leafn_storage_patch(begp:endp), & + flux_out = conv_nflux(begp:endp), & + seed = seed_leafn_storage_patch(begp:endp), & + seed_addition = dwt_leafn_seed(begp:endp)) + + call update_patch_state( & + var = this%leafn_xfer_patch(begp:endp), & + flux_out = conv_nflux(begp:endp), & + seed = seed_leafn_xfer_patch(begp:endp), & + seed_addition = dwt_leafn_seed(begp:endp)) + + call update_patch_state( & + var = this%frootn_patch(begp:endp), & + flux_out = dwt_frootn_to_litter(begp:endp)) + + call update_patch_state( & + var = this%frootn_storage_patch(begp:endp), & + flux_out = conv_nflux(begp:endp)) + + call update_patch_state( & + var = this%frootn_xfer_patch(begp:endp), & + flux_out = conv_nflux(begp:endp)) + + call update_patch_state( & + var = this%livestemn_patch(begp:endp), & + flux_out = conv_nflux(begp:endp)) + + call update_patch_state( & + var = this%livestemn_storage_patch(begp:endp), & + flux_out = conv_nflux(begp:endp)) + + call update_patch_state( & + var = this%livestemn_xfer_patch(begp:endp), & + flux_out = conv_nflux(begp:endp)) + + call patch_state_updater%update_patch_state_partition_flux_by_type(bounds, & + num_soilp_with_inactive, filter_soilp_with_inactive, & + flux1_fraction_by_pft_type = pftcon%pconv, & + var = this%deadstemn_patch(begp:endp), & + flux1_out = conv_nflux(begp:endp), & + flux2_out = product_nflux(begp:endp), & + seed = seed_deadstemn_patch(begp:endp), & + seed_addition = dwt_deadstemn_seed(begp:endp)) + + call update_patch_state( & + var = this%deadstemn_storage_patch(begp:endp), & + flux_out = conv_nflux(begp:endp)) + + call update_patch_state( & + var = this%deadstemn_xfer_patch(begp:endp), & + flux_out = conv_nflux(begp:endp)) + + call update_patch_state( & + var = this%livecrootn_patch(begp:endp), & + flux_out = dwt_livecrootn_to_litter(begp:endp)) + + call update_patch_state( & + var = this%livecrootn_storage_patch(begp:endp), & + flux_out = conv_nflux(begp:endp)) + + call update_patch_state( & + var = this%livecrootn_xfer_patch(begp:endp), & + flux_out = conv_nflux(begp:endp)) + + call update_patch_state( & + var = this%deadcrootn_patch(begp:endp), & + flux_out = dwt_deadcrootn_to_litter(begp:endp)) + + call update_patch_state( & + var = this%deadcrootn_storage_patch(begp:endp), & + flux_out = conv_nflux(begp:endp)) + + call update_patch_state( & + var = this%deadcrootn_xfer_patch(begp:endp), & + flux_out = conv_nflux(begp:endp)) + + call update_patch_state( & + var = this%retransn_patch(begp:endp), & + flux_out = conv_nflux(begp:endp)) + + call update_patch_state( & + var = this%npool_patch(begp:endp), & + flux_out = conv_nflux(begp:endp)) + + call update_patch_state( & + var = this%ntrunc_patch(begp:endp), & + flux_out = conv_nflux(begp:endp)) + + ! The following are summary diagnostic variables, not involved in mass balance. + ! Hence, they do not have associated fluxes for area decreases. + + call update_patch_state( & + var = this%dispvegn_patch(begp:endp)) + + call update_patch_state( & + var = this%storvegn_patch(begp:endp)) + + call update_patch_state( & + var = this%totvegn_patch(begp:endp)) + + call update_patch_state( & + var = this%totn_patch(begp:endp)) + + contains + subroutine update_patch_state(var, flux_out, seed, seed_addition) + ! Wraps call to update_patch_state, in order to remove duplication + real(r8), intent(inout) :: var( bounds%begp: ) + real(r8), intent(inout), optional :: flux_out( bounds%begp: ) + real(r8), intent(in), optional :: seed( bounds%begp: ) + real(r8), intent(inout), optional :: seed_addition( bounds%begp: ) + + call patch_state_updater%update_patch_state(bounds, & + num_soilp_with_inactive, filter_soilp_with_inactive, & + var = var, & + flux_out = flux_out, & + seed = seed, & + seed_addition = seed_addition) + end subroutine update_patch_state + + + end subroutine DynamicPatchAdjustments + !----------------------------------------------------------------------- subroutine DynamicColumnAdjustments(this, bounds, column_state_updater) ! diff --git a/components/clm/src/biogeochem/CNVegetationFacade.F90 b/components/clm/src/biogeochem/CNVegetationFacade.F90 index 0a4f16c2b6..740a2ede59 100644 --- a/components/clm/src/biogeochem/CNVegetationFacade.F90 +++ b/components/clm/src/biogeochem/CNVegetationFacade.F90 @@ -505,7 +505,8 @@ end subroutine UpdateSubgridWeights !----------------------------------------------------------------------- subroutine DynamicAreaConservation(this, bounds, & - prior_weights, column_state_updater, & + num_soilp_with_inactive, filter_soilp_with_inactive, & + prior_weights, patch_state_updater, column_state_updater, & canopystate_inst, photosyns_inst, & soilbiogeochem_carbonflux_inst, soilbiogeochem_carbonstate_inst, & c13_soilbiogeochem_carbonstate_inst, c14_soilbiogeochem_carbonstate_inst, & @@ -518,12 +519,16 @@ subroutine DynamicAreaConservation(this, bounds, & ! ! !USES: use dynPriorWeightsMod , only : prior_weights_type + use dynPatchStateUpdaterMod, only : patch_state_updater_type use dynColumnStateUpdaterMod, only : column_state_updater_type ! ! !ARGUMENTS: class(cn_vegetation_type), intent(inout) :: this type(bounds_type) , intent(in) :: bounds + integer , intent(in) :: num_soilp_with_inactive ! number of points in filter + integer , intent(in) :: filter_soilp_with_inactive(:) ! soil patch filter that includes inactive points type(prior_weights_type) , intent(in) :: prior_weights ! weights prior to the subgrid weight updates + type(patch_state_updater_type) , intent(in) :: patch_state_updater type(column_state_updater_type) , intent(in) :: column_state_updater type(canopystate_type) , intent(inout) :: canopystate_inst type(photosyns_type) , intent(inout) :: photosyns_inst @@ -540,20 +545,26 @@ subroutine DynamicAreaConservation(this, bounds, & character(len=*), parameter :: subname = 'DynamicAreaConservation' !----------------------------------------------------------------------- - call dyn_cnbal_patch(bounds, prior_weights, & + call t_startf('dyn_cnbal_patch') + call dyn_cnbal_patch(bounds, & + num_soilp_with_inactive, filter_soilp_with_inactive, & + prior_weights, patch_state_updater, & canopystate_inst, photosyns_inst, & this%cnveg_state_inst, & this%cnveg_carbonstate_inst, this%c13_cnveg_carbonstate_inst, this%c14_cnveg_carbonstate_inst, & this%cnveg_carbonflux_inst, this%c13_cnveg_carbonflux_inst, this%c14_cnveg_carbonflux_inst, & this%cnveg_nitrogenstate_inst, this%cnveg_nitrogenflux_inst, & soilbiogeochem_carbonflux_inst, soilbiogeochem_state_inst) + call t_stopf('dyn_cnbal_patch') + call t_startf('dyn_cnbal_col') call dyn_cnbal_col(bounds, column_state_updater, & this%cnveg_carbonstate_inst, this%c13_cnveg_carbonstate_inst, this%c14_cnveg_carbonstate_inst, & this%cnveg_nitrogenstate_inst, & soilbiogeochem_carbonstate_inst, c13_soilbiogeochem_carbonstate_inst, & c14_soilbiogeochem_carbonstate_inst, soilbiogeochem_nitrogenstate_inst, & ch4_inst) + call t_stopf('dyn_cnbal_col') end subroutine DynamicAreaConservation diff --git a/components/clm/src/biogeochem/dynConsBiogeochemMod.F90 b/components/clm/src/biogeochem/dynConsBiogeochemMod.F90 index bed7883f54..a28a31386e 100644 --- a/components/clm/src/biogeochem/dynConsBiogeochemMod.F90 +++ b/components/clm/src/biogeochem/dynConsBiogeochemMod.F90 @@ -39,7 +39,9 @@ module dynConsBiogeochemMod contains !----------------------------------------------------------------------- - subroutine dyn_cnbal_patch(bounds, prior_weights, & + subroutine dyn_cnbal_patch(bounds, & + num_soilp_with_inactive, filter_soilp_with_inactive, & + prior_weights, patch_state_updater, & canopystate_inst, photosyns_inst, cnveg_state_inst, & cnveg_carbonstate_inst, c13_cnveg_carbonstate_inst, c14_cnveg_carbonstate_inst, & cnveg_carbonflux_inst, c13_cnveg_carbonflux_inst, c14_cnveg_carbonflux_inst, & @@ -57,10 +59,14 @@ subroutine dyn_cnbal_patch(bounds, prior_weights, & use clm_varcon , only : c13ratio, c14ratio, c3_r2, c4_r2 use clm_time_manager , only : get_step_size use dynPriorWeightsMod , only : prior_weights_type + use dynPatchStateUpdaterMod, only : patch_state_updater_type ! ! !ARGUMENTS: type(bounds_type) , intent(in) :: bounds + integer , intent(in) :: num_soilp_with_inactive ! number of points in filter + integer , intent(in) :: filter_soilp_with_inactive(:) ! soil patch filter that includes inactive points type(prior_weights_type) , intent(in) :: prior_weights ! weights prior to the subgrid weight updates + type(patch_state_updater_type) , intent(in) :: patch_state_updater type(canopystate_type) , intent(inout) :: canopystate_inst type(photosyns_type) , intent(inout) :: photosyns_inst type(cnveg_state_type) , intent(inout) :: cnveg_state_inst @@ -77,11 +83,10 @@ subroutine dyn_cnbal_patch(bounds, prior_weights, & ! ! !LOCAL VARIABLES: integer :: pi,p,c,l,g,j ! indices + integer :: begp, endp integer :: ier ! error code real(r8) :: dwt ! change in patch weight (relative to column) real(r8) :: dt ! land model time step (sec) - real(r8) :: init_h2ocan ! initial canopy water mass - real(r8) :: new_h2ocan ! canopy water mass after weight shift real(r8), allocatable :: dwt_leafc_seed(:) ! patch-level mass gain due to seeding of new area real(r8), allocatable :: dwt_leafn_seed(:) ! patch-level mass gain due to seeding of new area real(r8), allocatable :: dwt_deadstemc_seed(:) ! patch-level mass gain due to seeding of new area @@ -96,12 +101,6 @@ subroutine dyn_cnbal_patch(bounds, prior_weights, & real(r8), allocatable :: product_cflux(:) ! patch-level mass loss due to weight shift real(r8), allocatable, target :: conv_nflux(:) ! patch-level mass loss due to weight shift real(r8), allocatable :: product_nflux(:) ! patch-level mass loss due to weight shift - real(r8) :: t1,t2,wt_new,wt_old - real(r8) :: init_state, change_state, new_state - real(r8) :: tot_leaf, pleaf, pstor, pxfer - real(r8) :: leafc_seed, leafn_seed - real(r8) :: deadstemc_seed, deadstemn_seed - real(r8), pointer :: dwt_ptr0, dwt_ptr1, ptr character(len=32) :: subname='dyn_cbal' ! subroutine name !! C13 real(r8), allocatable :: dwt_leafc13_seed(:) ! patch-level mass gain due to seeding of new area @@ -111,7 +110,6 @@ subroutine dyn_cnbal_patch(bounds, prior_weights, & real(r8), allocatable, target :: dwt_deadcrootc13_to_litter(:) ! patch-level mass loss due to weight shift real(r8), allocatable, target :: conv_c13flux(:) ! patch-level mass loss due to weight shift real(r8), allocatable :: product_c13flux(:) ! patch-level mass loss due to weight shift - real(r8) :: leafc13_seed, deadstemc13_seed !! C14 real(r8), allocatable :: dwt_leafc14_seed(:) ! patch-level mass gain due to seeding of new area real(r8), allocatable :: dwt_deadstemc14_seed(:) ! patch-level mass gain due to seeding of new area @@ -120,152 +118,159 @@ subroutine dyn_cnbal_patch(bounds, prior_weights, & real(r8), allocatable, target :: dwt_deadcrootc14_to_litter(:) ! patch-level mass loss due to weight shift real(r8), allocatable, target :: conv_c14flux(:) ! patch-level mass loss due to weight shift real(r8), allocatable :: product_c14flux(:) ! patch-level mass loss due to weight shift - real(r8) :: c3_del14c ! typical del14C for C3 photosynthesis (permil, relative to PDB) - real(r8) :: c4_del14c ! typical del14C for C4 photosynthesis (permil, relative to PDB) - real(r8) :: leafc14_seed, deadstemc14_seed + + logical :: patch_initiating(bounds%begp:bounds%endp) + + ! amounts to add to growing patches + real(r8), parameter :: leafc_seed = 1._r8 + real(r8), parameter :: deadstemc_seed = 0.1_r8 + !----------------------------------------------------------------------- - + + begp = bounds%begp + endp = bounds%endp + ! Allocate patch-level mass loss arrays - allocate(dwt_leafc_seed(bounds%begp:bounds%endp), stat=ier) + allocate(dwt_leafc_seed(begp:endp), stat=ier) if (ier /= 0) then write(iulog,*)subname,' allocation error for dwt_leafc_seed' call endrun(msg=errMsg(__FILE__, __LINE__)) end if - allocate(dwt_leafn_seed(bounds%begp:bounds%endp), stat=ier) + allocate(dwt_leafn_seed(begp:endp), stat=ier) if (ier /= 0) then write(iulog,*)subname,' allocation error for dwt_leafn_seed' call endrun(msg=errMsg(__FILE__, __LINE__)) end if - allocate(dwt_deadstemc_seed(bounds%begp:bounds%endp), stat=ier) + allocate(dwt_deadstemc_seed(begp:endp), stat=ier) if (ier /= 0) then write(iulog,*)subname,' allocation error for dwt_deadstemc_seed' call endrun(msg=errMsg(__FILE__, __LINE__)) end if - allocate(dwt_deadstemn_seed(bounds%begp:bounds%endp), stat=ier) + allocate(dwt_deadstemn_seed(begp:endp), stat=ier) if (ier /= 0) then write(iulog,*)subname,' allocation error for dwt_deadstemn_seed' call endrun(msg=errMsg(__FILE__, __LINE__)) end if - allocate(dwt_frootc_to_litter(bounds%begp:bounds%endp), stat=ier) + allocate(dwt_frootc_to_litter(begp:endp), stat=ier) if (ier /= 0) then write(iulog,*)subname,' allocation error for dwt_frootc_to_litter' call endrun(msg=errMsg(__FILE__, __LINE__)) end if - allocate(dwt_livecrootc_to_litter(bounds%begp:bounds%endp), stat=ier) + allocate(dwt_livecrootc_to_litter(begp:endp), stat=ier) if (ier /= 0) then write(iulog,*)subname,' allocation error for dwt_livecrootc_to_litter' call endrun(msg=errMsg(__FILE__, __LINE__)) end if - allocate(dwt_deadcrootc_to_litter(bounds%begp:bounds%endp), stat=ier) + allocate(dwt_deadcrootc_to_litter(begp:endp), stat=ier) if (ier /= 0) then write(iulog,*)subname,' allocation error for dwt_deadcrootc_to_litter' call endrun(msg=errMsg(__FILE__, __LINE__)) end if - allocate(dwt_frootn_to_litter(bounds%begp:bounds%endp), stat=ier) + allocate(dwt_frootn_to_litter(begp:endp), stat=ier) if (ier /= 0) then write(iulog,*)subname,' allocation error for dwt_frootn_to_litter' call endrun(msg=errMsg(__FILE__, __LINE__)) end if - allocate(dwt_livecrootn_to_litter(bounds%begp:bounds%endp), stat=ier) + allocate(dwt_livecrootn_to_litter(begp:endp), stat=ier) if (ier /= 0) then write(iulog,*)subname,' allocation error for dwt_livecrootn_to_litter' call endrun(msg=errMsg(__FILE__, __LINE__)) end if - allocate(dwt_deadcrootn_to_litter(bounds%begp:bounds%endp), stat=ier) + allocate(dwt_deadcrootn_to_litter(begp:endp), stat=ier) if (ier /= 0) then write(iulog,*)subname,' allocation error for dwt_deadcrootn_to_litter' call endrun(msg=errMsg(__FILE__, __LINE__)) end if - allocate(conv_cflux(bounds%begp:bounds%endp), stat=ier) + allocate(conv_cflux(begp:endp), stat=ier) if (ier /= 0) then write(iulog,*)subname,' allocation error for conv_cflux' call endrun(msg=errMsg(__FILE__, __LINE__)) end if - allocate(product_cflux(bounds%begp:bounds%endp), stat=ier) + allocate(product_cflux(begp:endp), stat=ier) if (ier /= 0) then write(iulog,*)subname,' allocation error for product_cflux' call endrun(msg=errMsg(__FILE__, __LINE__)) end if - allocate(conv_nflux(bounds%begp:bounds%endp), stat=ier) + allocate(conv_nflux(begp:endp), stat=ier) if (ier /= 0) then write(iulog,*)subname,' allocation error for conv_nflux' call endrun(msg=errMsg(__FILE__, __LINE__)) end if - allocate(product_nflux(bounds%begp:bounds%endp), stat=ier) + allocate(product_nflux(begp:endp), stat=ier) if (ier /= 0) then write(iulog,*)subname,' allocation error for product_nflux' call endrun(msg=errMsg(__FILE__, __LINE__)) end if if ( use_c13 ) then - allocate(dwt_leafc13_seed(bounds%begp:bounds%endp), stat=ier) + allocate(dwt_leafc13_seed(begp:endp), stat=ier) if (ier /= 0) then write(iulog,*)subname,' allocation error for dwt_leafc13_seed' call endrun(msg=errMsg(__FILE__, __LINE__)) end if - allocate(dwt_deadstemc13_seed(bounds%begp:bounds%endp), stat=ier) + allocate(dwt_deadstemc13_seed(begp:endp), stat=ier) if (ier /= 0) then write(iulog,*)subname,' allocation error for dwt_deadstemc13_seed' call endrun(msg=errMsg(__FILE__, __LINE__)) end if - allocate(dwt_frootc13_to_litter(bounds%begp:bounds%endp), stat=ier) + allocate(dwt_frootc13_to_litter(begp:endp), stat=ier) if (ier /= 0) then write(iulog,*)subname,' allocation error for dwt_frootc13_to_litter' call endrun(msg=errMsg(__FILE__, __LINE__)) end if - allocate(dwt_livecrootc13_to_litter(bounds%begp:bounds%endp), stat=ier) + allocate(dwt_livecrootc13_to_litter(begp:endp), stat=ier) if (ier /= 0) then write(iulog,*)subname,' allocation error for dwt_livecrootc13_to_litter' call endrun(msg=errMsg(__FILE__, __LINE__)) end if - allocate(dwt_deadcrootc13_to_litter(bounds%begp:bounds%endp), stat=ier) + allocate(dwt_deadcrootc13_to_litter(begp:endp), stat=ier) if (ier /= 0) then write(iulog,*)subname,' allocation error for dwt_deadcrootc13_to_litter' call endrun(msg=errMsg(__FILE__, __LINE__)) end if - allocate(conv_c13flux(bounds%begp:bounds%endp), stat=ier) + allocate(conv_c13flux(begp:endp), stat=ier) if (ier /= 0) then write(iulog,*)subname,' allocation error for conv_c13flux' call endrun(msg=errMsg(__FILE__, __LINE__)) end if - allocate(product_c13flux(bounds%begp:bounds%endp), stat=ier) + allocate(product_c13flux(begp:endp), stat=ier) if (ier /= 0) then write(iulog,*)subname,' allocation error for product_c13flux' call endrun(msg=errMsg(__FILE__, __LINE__)) end if endif if ( use_c14 ) then - allocate(dwt_leafc14_seed(bounds%begp:bounds%endp), stat=ier) + allocate(dwt_leafc14_seed(begp:endp), stat=ier) if (ier /= 0) then write(iulog,*)subname,' allocation error for dwt_leafc14_seed' call endrun(msg=errMsg(__FILE__, __LINE__)) end if - allocate(dwt_deadstemc14_seed(bounds%begp:bounds%endp), stat=ier) + allocate(dwt_deadstemc14_seed(begp:endp), stat=ier) if (ier /= 0) then write(iulog,*)subname,' allocation error for dwt_deadstemc14_seed' call endrun(msg=errMsg(__FILE__, __LINE__)) end if - allocate(dwt_frootc14_to_litter(bounds%begp:bounds%endp), stat=ier) + allocate(dwt_frootc14_to_litter(begp:endp), stat=ier) if (ier /= 0) then write(iulog,*)subname,' allocation error for dwt_frootc14_to_litter' call endrun(msg=errMsg(__FILE__, __LINE__)) end if - allocate(dwt_livecrootc14_to_litter(bounds%begp:bounds%endp), stat=ier) + allocate(dwt_livecrootc14_to_litter(begp:endp), stat=ier) if (ier /= 0) then write(iulog,*)subname,' allocation error for dwt_livecrootc14_to_litter' call endrun(msg=errMsg(__FILE__, __LINE__)) end if - allocate(dwt_deadcrootc14_to_litter(bounds%begp:bounds%endp), stat=ier) + allocate(dwt_deadcrootc14_to_litter(begp:endp), stat=ier) if (ier /= 0) then write(iulog,*)subname,' allocation error for dwt_deadcrootc14_to_litter' call endrun(msg=errMsg(__FILE__, __LINE__)) end if - allocate(conv_c14flux(bounds%begp:bounds%endp), stat=ier) + allocate(conv_c14flux(begp:endp), stat=ier) if (ier /= 0) then write(iulog,*)subname,' allocation error for conv_c14flux' call endrun(msg=errMsg(__FILE__, __LINE__)) end if - allocate(product_c14flux(bounds%begp:bounds%endp), stat=ier) + allocate(product_c14flux(begp:endp), stat=ier) if (ier /= 0) then write(iulog,*)subname,' allocation error for product_c14flux' call endrun(msg=errMsg(__FILE__, __LINE__)) @@ -274,8 +279,10 @@ subroutine dyn_cnbal_patch(bounds, prior_weights, & ! Get time step dt = real( get_step_size(), r8 ) - - do p = bounds%begp,bounds%endp + + patch_initiating = patch_state_updater%patch_initiating(bounds) + + do p = begp,endp c = patch%column(p) ! initialize all the patch-level local flux arrays dwt_leafc_seed(p) = 0._r8 @@ -317,1686 +324,173 @@ subroutine dyn_cnbal_patch(bounds, prior_weights, & if (lun%itype(l) == istsoil .or. lun%itype(l) == istcrop) then ! calculate the change in weight for the timestep + ! TODO(wjs, 2016-06-01) Should this be moved elsewhere? Or should we get rid of + ! this lfpftd_patch variable entirely, instead using information that exists in + ! other places? dwt = patch%wtcol(p)-prior_weights%pwtcol(p) CNveg_state_inst%lfpftd_patch(p) = -dwt - ! Patches for which weight increases on this timestep - if (dwt > 0._r8) then - - ! first identify Patches that are initiating on this timestep - ! and set all the necessary state and flux variables - if (prior_weights%pwtcol(p) == 0._r8) then - - ! set initial conditions for PFT that is being initiated - ! in this time step. Based on the settings in cnIniTimeVar. - - ! patch-level carbon state variables - cnveg_carbonstate_inst%leafc_patch(p) = 0._r8 - cnveg_carbonstate_inst%leafc_storage_patch(p) = 0._r8 - cnveg_carbonstate_inst%leafc_xfer_patch(p) = 0._r8 - cnveg_carbonstate_inst%frootc_patch(p) = 0._r8 - cnveg_carbonstate_inst%frootc_storage_patch(p) = 0._r8 - cnveg_carbonstate_inst%frootc_xfer_patch(p) = 0._r8 - cnveg_carbonstate_inst%livestemc_patch(p) = 0._r8 - cnveg_carbonstate_inst%livestemc_storage_patch(p) = 0._r8 - cnveg_carbonstate_inst%livestemc_xfer_patch(p) = 0._r8 - cnveg_carbonstate_inst%deadstemc_patch(p) = 0._r8 - cnveg_carbonstate_inst%deadstemc_storage_patch(p) = 0._r8 - cnveg_carbonstate_inst%deadstemc_xfer_patch(p) = 0._r8 - cnveg_carbonstate_inst%livecrootc_patch(p) = 0._r8 - cnveg_carbonstate_inst%livecrootc_storage_patch(p) = 0._r8 - cnveg_carbonstate_inst%livecrootc_xfer_patch(p) = 0._r8 - cnveg_carbonstate_inst%deadcrootc_patch(p) = 0._r8 - cnveg_carbonstate_inst%deadcrootc_storage_patch(p) = 0._r8 - cnveg_carbonstate_inst%deadcrootc_xfer_patch(p) = 0._r8 - cnveg_carbonstate_inst%gresp_storage_patch(p) = 0._r8 - cnveg_carbonstate_inst%gresp_xfer_patch(p) = 0._r8 - cnveg_carbonstate_inst%cpool_patch(p) = 0._r8 - cnveg_carbonstate_inst%xsmrpool_patch(p) = 0._r8 - cnveg_carbonstate_inst%ctrunc_patch(p) = 0._r8 - cnveg_carbonstate_inst%dispvegc_patch(p) = 0._r8 - cnveg_carbonstate_inst%storvegc_patch(p) = 0._r8 - cnveg_carbonstate_inst%totc_patch(p) = 0._r8 - cnveg_carbonstate_inst%totvegc_patch(p) = 0._r8 - - if ( use_c13 ) then - ! patch-level carbon-13 state variables - c13_cnveg_carbonstate_inst%leafc_patch(p) = 0._r8 - c13_cnveg_carbonstate_inst%leafc_storage_patch(p) = 0._r8 - c13_cnveg_carbonstate_inst%leafc_xfer_patch(p) = 0._r8 - c13_cnveg_carbonstate_inst%frootc_patch(p) = 0._r8 - c13_cnveg_carbonstate_inst%frootc_storage_patch(p) = 0._r8 - c13_cnveg_carbonstate_inst%frootc_xfer_patch(p) = 0._r8 - c13_cnveg_carbonstate_inst%livestemc_patch(p) = 0._r8 - c13_cnveg_carbonstate_inst%livestemc_storage_patch(p) = 0._r8 - c13_cnveg_carbonstate_inst%livestemc_xfer_patch(p) = 0._r8 - c13_cnveg_carbonstate_inst%deadstemc_patch(p) = 0._r8 - c13_cnveg_carbonstate_inst%deadstemc_storage_patch(p) = 0._r8 - c13_cnveg_carbonstate_inst%deadstemc_xfer_patch(p) = 0._r8 - c13_cnveg_carbonstate_inst%livecrootc_patch(p) = 0._r8 - c13_cnveg_carbonstate_inst%livecrootc_storage_patch(p) = 0._r8 - c13_cnveg_carbonstate_inst%livecrootc_xfer_patch(p) = 0._r8 - c13_cnveg_carbonstate_inst%deadcrootc_patch(p) = 0._r8 - c13_cnveg_carbonstate_inst%deadcrootc_storage_patch(p) = 0._r8 - c13_cnveg_carbonstate_inst%deadcrootc_xfer_patch(p) = 0._r8 - c13_cnveg_carbonstate_inst%gresp_storage_patch(p) = 0._r8 - c13_cnveg_carbonstate_inst%gresp_xfer_patch(p) = 0._r8 - c13_cnveg_carbonstate_inst%cpool_patch(p) = 0._r8 - c13_cnveg_carbonstate_inst%xsmrpool_patch(p) = 0._r8 - c13_cnveg_carbonstate_inst%ctrunc_patch(p) = 0._r8 - c13_cnveg_carbonstate_inst%dispvegc_patch(p) = 0._r8 - c13_cnveg_carbonstate_inst%storvegc_patch(p) = 0._r8 - c13_cnveg_carbonstate_inst%totc_patch(p) = 0._r8 - c13_cnveg_carbonstate_inst%totvegc_patch(p) = 0._r8 - endif - - if ( use_c14 ) then - ! patch-level carbon-14 state variables - c14_cnveg_carbonstate_inst%leafc_patch(p) = 0._r8 - c14_cnveg_carbonstate_inst%leafc_storage_patch(p) = 0._r8 - c14_cnveg_carbonstate_inst%leafc_xfer_patch(p) = 0._r8 - c14_cnveg_carbonstate_inst%frootc_patch(p) = 0._r8 - c14_cnveg_carbonstate_inst%frootc_storage_patch(p) = 0._r8 - c14_cnveg_carbonstate_inst%frootc_xfer_patch(p) = 0._r8 - c14_cnveg_carbonstate_inst%livestemc_patch(p) = 0._r8 - c14_cnveg_carbonstate_inst%livestemc_storage_patch(p) = 0._r8 - c14_cnveg_carbonstate_inst%livestemc_xfer_patch(p) = 0._r8 - c14_cnveg_carbonstate_inst%deadstemc_patch(p) = 0._r8 - c14_cnveg_carbonstate_inst%deadstemc_storage_patch(p) = 0._r8 - c14_cnveg_carbonstate_inst%deadstemc_xfer_patch(p) = 0._r8 - c14_cnveg_carbonstate_inst%livecrootc_patch(p) = 0._r8 - c14_cnveg_carbonstate_inst%livecrootc_storage_patch(p) = 0._r8 - c14_cnveg_carbonstate_inst%livecrootc_xfer_patch(p) = 0._r8 - c14_cnveg_carbonstate_inst%deadcrootc_patch(p) = 0._r8 - c14_cnveg_carbonstate_inst%deadcrootc_storage_patch(p) = 0._r8 - c14_cnveg_carbonstate_inst%deadcrootc_xfer_patch(p) = 0._r8 - c14_cnveg_carbonstate_inst%gresp_storage_patch(p) = 0._r8 - c14_cnveg_carbonstate_inst%gresp_xfer_patch(p) = 0._r8 - c14_cnveg_carbonstate_inst%cpool_patch(p) = 0._r8 - c14_cnveg_carbonstate_inst%xsmrpool_patch(p) = 0._r8 - c14_cnveg_carbonstate_inst%ctrunc_patch(p) = 0._r8 - c14_cnveg_carbonstate_inst%dispvegc_patch(p) = 0._r8 - c14_cnveg_carbonstate_inst%storvegc_patch(p) = 0._r8 - c14_cnveg_carbonstate_inst%totc_patch(p) = 0._r8 - c14_cnveg_carbonstate_inst%totvegc_patch(p) = 0._r8 - endif - - ! patch-level nitrogen state variables - cnveg_nitrogenstate_inst%leafn_patch(p) = 0._r8 - cnveg_nitrogenstate_inst%leafn_storage_patch(p) = 0._r8 - cnveg_nitrogenstate_inst%leafn_xfer_patch(p) = 0._r8 - cnveg_nitrogenstate_inst%frootn_patch(p) = 0._r8 - cnveg_nitrogenstate_inst%frootn_storage_patch(p) = 0._r8 - cnveg_nitrogenstate_inst%frootn_xfer_patch(p) = 0._r8 - cnveg_nitrogenstate_inst%livestemn_patch(p) = 0._r8 - cnveg_nitrogenstate_inst%livestemn_storage_patch(p) = 0._r8 - cnveg_nitrogenstate_inst%livestemn_xfer_patch(p) = 0._r8 - cnveg_nitrogenstate_inst%deadstemn_patch(p) = 0._r8 - cnveg_nitrogenstate_inst%deadstemn_storage_patch(p) = 0._r8 - cnveg_nitrogenstate_inst%deadstemn_xfer_patch(p) = 0._r8 - cnveg_nitrogenstate_inst%livecrootn_patch(p) = 0._r8 - cnveg_nitrogenstate_inst%livecrootn_storage_patch(p) = 0._r8 - cnveg_nitrogenstate_inst%livecrootn_xfer_patch(p) = 0._r8 - cnveg_nitrogenstate_inst%deadcrootn_patch(p) = 0._r8 - cnveg_nitrogenstate_inst%deadcrootn_storage_patch(p) = 0._r8 - cnveg_nitrogenstate_inst%deadcrootn_xfer_patch(p) = 0._r8 - cnveg_nitrogenstate_inst%retransn_patch(p) = 0._r8 - cnveg_nitrogenstate_inst%npool_patch(p) = 0._r8 - cnveg_nitrogenstate_inst%ntrunc_patch(p) = 0._r8 - cnveg_nitrogenstate_inst%dispvegn_patch(p) = 0._r8 - cnveg_nitrogenstate_inst%storvegn_patch(p) = 0._r8 - cnveg_nitrogenstate_inst%totvegn_patch(p) = 0._r8 - cnveg_nitrogenstate_inst%totn_patch (p) = 0._r8 - - ! initialize same flux and epv variables that are set - canopystate_inst%laisun_patch(p) = 0._r8 - canopystate_inst%laisha_patch(p) = 0._r8 - - cnveg_state_inst%dormant_flag_patch(p) = 1._r8 - cnveg_state_inst%days_active_patch(p) = 0._r8 - cnveg_state_inst%onset_flag_patch(p) = 0._r8 - cnveg_state_inst%onset_counter_patch(p) = 0._r8 - cnveg_state_inst%onset_gddflag_patch(p) = 0._r8 - cnveg_state_inst%onset_fdd_patch(p) = 0._r8 - cnveg_state_inst%onset_gdd_patch(p) = 0._r8 - cnveg_state_inst%onset_swi_patch(p) = 0._r8 - cnveg_state_inst%offset_flag_patch(p) = 0._r8 - cnveg_state_inst%offset_counter_patch(p) = 0._r8 - cnveg_state_inst%offset_fdd_patch(p) = 0._r8 - cnveg_state_inst%offset_swi_patch(p) = 0._r8 - cnveg_state_inst%lgsf_patch(p) = 0._r8 - cnveg_state_inst%bglfr_patch(p) = 0._r8 - cnveg_state_inst%bgtr_patch(p) = 0._r8 - cnveg_state_inst%annavg_t2m_patch(p) = cnveg_state_inst%annavg_t2m_col(c) - cnveg_state_inst%tempavg_t2m_patch(p) = 0._r8 - cnveg_state_inst%c_allometry_patch(p) = 0._r8 - cnveg_state_inst%n_allometry_patch(p) = 0._r8 - cnveg_state_inst%tempsum_potential_gpp_patch(p) = 0._r8 - cnveg_state_inst%annsum_potential_gpp_patch(p) = 0._r8 - cnveg_state_inst%tempmax_retransn_patch(p) = 0._r8 - cnveg_state_inst%annmax_retransn_patch(p) = 0._r8 - cnveg_state_inst%downreg_patch(p) = 0._r8 + ! Identify patches that are initiating on this timestep and set all the + ! necessary state and flux variables + + ! TODO(wjs, 2016-06-01) It seems like this code should be moved to a new + ! subroutine that is solely responsible for initializing newly-active patches + + ! NOTE(wjs, 2016-06-01) We could replace the check of patch_initiating with a + ! check of something like (patch%active(p) .and. .not. + ! prior_weights%pactive(p)). That would mean that 0-weight active patches would + ! remain in their spunup state when they began to grow. But I think that's a bad + ! idea, because it means that the evolution of the system depends on which + ! 0-weight patches we choose to keep active. It seems better to reinitialize + ! patches as soon as they grow to > 0 area, as is done here. + + if (patch_initiating(p)) then + + canopystate_inst%laisun_patch(p) = 0._r8 + canopystate_inst%laisha_patch(p) = 0._r8 + + cnveg_state_inst%dormant_flag_patch(p) = 1._r8 + cnveg_state_inst%days_active_patch(p) = 0._r8 + cnveg_state_inst%onset_flag_patch(p) = 0._r8 + cnveg_state_inst%onset_counter_patch(p) = 0._r8 + cnveg_state_inst%onset_gddflag_patch(p) = 0._r8 + cnveg_state_inst%onset_fdd_patch(p) = 0._r8 + cnveg_state_inst%onset_gdd_patch(p) = 0._r8 + cnveg_state_inst%onset_swi_patch(p) = 0._r8 + cnveg_state_inst%offset_flag_patch(p) = 0._r8 + cnveg_state_inst%offset_counter_patch(p) = 0._r8 + cnveg_state_inst%offset_fdd_patch(p) = 0._r8 + cnveg_state_inst%offset_swi_patch(p) = 0._r8 + cnveg_state_inst%lgsf_patch(p) = 0._r8 + cnveg_state_inst%bglfr_patch(p) = 0._r8 + cnveg_state_inst%bgtr_patch(p) = 0._r8 + cnveg_state_inst%annavg_t2m_patch(p) = cnveg_state_inst%annavg_t2m_col(c) + cnveg_state_inst%tempavg_t2m_patch(p) = 0._r8 + cnveg_state_inst%c_allometry_patch(p) = 0._r8 + cnveg_state_inst%n_allometry_patch(p) = 0._r8 + cnveg_state_inst%tempsum_potential_gpp_patch(p) = 0._r8 + cnveg_state_inst%annsum_potential_gpp_patch(p) = 0._r8 + cnveg_state_inst%tempmax_retransn_patch(p) = 0._r8 + cnveg_state_inst%annmax_retransn_patch(p) = 0._r8 + cnveg_state_inst%downreg_patch(p) = 0._r8 + + cnveg_carbonflux_inst%xsmrpool_recover_patch(p) = 0._r8 + cnveg_carbonflux_inst%plant_calloc_patch(p) = 0._r8 + cnveg_carbonflux_inst%excess_cflux_patch(p) = 0._r8 + cnveg_carbonflux_inst%prev_leafc_to_litter_patch(p) = 0._r8 + cnveg_carbonflux_inst%prev_frootc_to_litter_patch(p) = 0._r8 + cnveg_carbonflux_inst%availc_patch(p) = 0._r8 + cnveg_carbonflux_inst%gpp_before_downreg_patch(p) = 0._r8 + + cnveg_carbonflux_inst%tempsum_npp_patch(p) = 0._r8 + cnveg_carbonflux_inst%annsum_npp_patch(p) = 0._r8 + + cnveg_nitrogenflux_inst%plant_ndemand_patch(p) = 0._r8 + cnveg_nitrogenflux_inst%avail_retransn_patch(p) = 0._r8 + cnveg_nitrogenflux_inst%plant_nalloc_patch(p) = 0._r8 - cnveg_carbonflux_inst%xsmrpool_recover_patch(p) = 0._r8 - cnveg_carbonflux_inst%plant_calloc_patch(p) = 0._r8 - cnveg_carbonflux_inst%excess_cflux_patch(p) = 0._r8 - cnveg_carbonflux_inst%prev_leafc_to_litter_patch(p) = 0._r8 - cnveg_carbonflux_inst%prev_frootc_to_litter_patch(p) = 0._r8 - cnveg_carbonflux_inst%availc_patch(p) = 0._r8 - cnveg_carbonflux_inst%gpp_before_downreg_patch(p) = 0._r8 + if ( use_c13 ) then + c13_cnveg_carbonflux_inst%xsmrpool_c13ratio_patch(p) = c13ratio + end if + + call photosyns_inst%NewPatchinit(p) + + end if ! end initialization of new patch + end if ! is soil + end do ! patch loop + + ! Adjust patch variables and compute associated fluxes for changing patch areas + + call cnveg_carbonstate_inst%DynamicPatchAdjustments(bounds, & + num_soilp_with_inactive, filter_soilp_with_inactive, & + patch_state_updater, & + leafc_seed = leafc_seed, & + deadstemc_seed = deadstemc_seed, & + conv_cflux = conv_cflux(begp:endp), & + product_cflux = product_cflux(begp:endp), & + dwt_frootc_to_litter = dwt_frootc_to_litter(begp:endp), & + dwt_livecrootc_to_litter = dwt_livecrootc_to_litter(begp:endp), & + dwt_deadcrootc_to_litter = dwt_deadcrootc_to_litter(begp:endp), & + dwt_leafc_seed = dwt_leafc_seed(begp:endp), & + dwt_deadstemc_seed = dwt_deadstemc_seed(begp:endp)) + + ! These fluxes are computed as negative quantities, but are expected to be positive, + ! so flip the signs + do p = begp, endp + dwt_frootc_to_litter(p) = -1._r8 * dwt_frootc_to_litter(p) + dwt_livecrootc_to_litter(p) = -1._r8 * dwt_livecrootc_to_litter(p) + dwt_deadcrootc_to_litter(p) = -1._r8 * dwt_deadcrootc_to_litter(p) + end do - cnveg_carbonflux_inst%tempsum_npp_patch(p) = 0._r8 - cnveg_carbonflux_inst%annsum_npp_patch(p) = 0._r8 + if (use_c13) then + call c13_cnveg_carbonstate_inst%DynamicPatchAdjustments(bounds, & + num_soilp_with_inactive, filter_soilp_with_inactive, & + patch_state_updater, & + leafc_seed = leafc_seed, & + deadstemc_seed = deadstemc_seed, & + conv_cflux = conv_c13flux(begp:endp), & + product_cflux = product_c13flux(begp:endp), & + dwt_frootc_to_litter = dwt_frootc13_to_litter(begp:endp), & + dwt_livecrootc_to_litter = dwt_livecrootc13_to_litter(begp:endp), & + dwt_deadcrootc_to_litter = dwt_deadcrootc13_to_litter(begp:endp), & + dwt_leafc_seed = dwt_leafc13_seed(begp:endp), & + dwt_deadstemc_seed = dwt_deadstemc13_seed(begp:endp)) + + ! These fluxes are computed as negative quantities, but are expected to be positive, + ! so flip the signs + do p = begp,endp + dwt_frootc13_to_litter(p) = -1._r8 * dwt_frootc13_to_litter(p) + dwt_livecrootc13_to_litter(p) = -1._r8 * dwt_livecrootc13_to_litter(p) + dwt_deadcrootc13_to_litter(p) = -1._r8 * dwt_deadcrootc13_to_litter(p) + end do - cnveg_nitrogenflux_inst%plant_ndemand_patch(p) = 0._r8 - cnveg_nitrogenflux_inst%avail_retransn_patch(p) = 0._r8 - cnveg_nitrogenflux_inst%plant_nalloc_patch(p) = 0._r8 - - if ( use_c13 ) then - c13_cnveg_carbonflux_inst%xsmrpool_c13ratio_patch(p) = c13ratio - end if + end if - call photosyns_inst%NewPatchinit(p) - - end if ! end initialization of new patch - - ! (still in dwt > 0 block) - - ! set the seed sources for leaf and deadstem - ! leaf source is split later between leaf, leaf_storage, leaf_xfer - leafc_seed = 0._r8 - leafn_seed = 0._r8 - deadstemc_seed = 0._r8 - deadstemn_seed = 0._r8 - if ( use_c13 ) then - leafc13_seed = 0._r8 - deadstemc13_seed = 0._r8 - endif - if ( use_c14 ) then - leafc14_seed = 0._r8 - deadstemc14_seed = 0._r8 - endif - if (patch%itype(p) /= 0) then - leafc_seed = 1._r8 - leafn_seed = leafc_seed / pftcon%leafcn(patch%itype(p)) - if (pftcon%woody(patch%itype(p)) == 1._r8) then - deadstemc_seed = 0.1_r8 - deadstemn_seed = deadstemc_seed / pftcon%deadwdcn(patch%itype(p)) - end if - - if ( use_c13 ) then - if (pftcon%c3psn(patch%itype(p)) == 1._r8) then - leafc13_seed = leafc_seed * c3_r2 - deadstemc13_seed = deadstemc_seed * c3_r2 - else - leafc13_seed = leafc_seed * c4_r2 - deadstemc13_seed = deadstemc_seed * c4_r2 - end if - endif - - if ( use_c14 ) then - ! 14c state is initialized assuming initial "modern" 14C of 1.e-12 - if (pftcon%c3psn(patch%itype(p)) == 1._r8) then - leafc14_seed = leafc_seed * c14ratio - deadstemc14_seed = deadstemc_seed * c14ratio - else - leafc14_seed = leafc_seed * c14ratio - deadstemc14_seed = deadstemc_seed * c14ratio - end if - endif - end if - - ! When PATCH area expands (dwt > 0), the patch-level mass density - ! is modified to conserve the original patch mass distributed - ! over the new (larger) area, plus a term to account for the - ! introduction of new seed source for leaf and deadstem - t1 = prior_weights%pwtcol(p)/patch%wtcol(p) - t2 = dwt/patch%wtcol(p) - - tot_leaf = cnveg_carbonstate_inst%leafc_patch(p) + & - cnveg_carbonstate_inst%leafc_storage_patch(p) + & - cnveg_carbonstate_inst%leafc_xfer_patch(p) - pleaf = 0._r8 - pstor = 0._r8 - pxfer = 0._r8 - if (tot_leaf /= 0._r8) then - ! when adding seed source to non-zero leaf state, use current proportions - pleaf = cnveg_carbonstate_inst%leafc_patch(p)/tot_leaf - pstor = cnveg_carbonstate_inst%leafc_storage_patch(p)/tot_leaf - pxfer = cnveg_carbonstate_inst%leafc_xfer_patch(p)/tot_leaf - else - ! when initiating from zero leaf state, use evergreen flag to set proportions - if (pftcon%evergreen(patch%itype(p)) == 1._r8) then - pleaf = 1._r8 - else - pstor = 1._r8 - end if - end if - cnveg_carbonstate_inst%leafc_patch(p) = cnveg_carbonstate_inst%leafc_patch(p) *t1 & - + leafc_seed*pleaf*t2 - cnveg_carbonstate_inst%leafc_storage_patch(p) = cnveg_carbonstate_inst%leafc_storage_patch(p) *t1 & - + leafc_seed*pstor*t2 - cnveg_carbonstate_inst%leafc_xfer_patch(p) = cnveg_carbonstate_inst%leafc_xfer_patch(p) *t1 & - + leafc_seed*pxfer*t2 - cnveg_carbonstate_inst%frootc_patch(p) = cnveg_carbonstate_inst%frootc_patch(p) *t1 - cnveg_carbonstate_inst%frootc_storage_patch(p) = cnveg_carbonstate_inst%frootc_storage_patch(p) *t1 - cnveg_carbonstate_inst%frootc_xfer_patch(p) = cnveg_carbonstate_inst%frootc_xfer_patch(p) *t1 - cnveg_carbonstate_inst%livestemc_patch(p) = cnveg_carbonstate_inst%livestemc_patch(p) *t1 - cnveg_carbonstate_inst%livestemc_storage_patch(p) = cnveg_carbonstate_inst%livestemc_storage_patch(p) *t1 - cnveg_carbonstate_inst%livestemc_xfer_patch(p) = cnveg_carbonstate_inst%livestemc_xfer_patch(p) *t1 - cnveg_carbonstate_inst%deadstemc_patch(p) = cnveg_carbonstate_inst%deadstemc_patch(p) *t1 & - + deadstemc_seed*t2 - cnveg_carbonstate_inst%deadstemc_storage_patch(p) = cnveg_carbonstate_inst%deadstemc_storage_patch(p) *t1 - cnveg_carbonstate_inst%deadstemc_xfer_patch(p) = cnveg_carbonstate_inst%deadstemc_xfer_patch(p) *t1 - cnveg_carbonstate_inst%livecrootc_patch(p) = cnveg_carbonstate_inst%livecrootc_patch(p) *t1 - cnveg_carbonstate_inst%livecrootc_storage_patch(p) = cnveg_carbonstate_inst%livecrootc_storage_patch(p) *t1 - cnveg_carbonstate_inst%livecrootc_xfer_patch(p) = cnveg_carbonstate_inst%livecrootc_xfer_patch(p) *t1 - cnveg_carbonstate_inst%deadcrootc_patch(p) = cnveg_carbonstate_inst%deadcrootc_patch(p) *t1 - cnveg_carbonstate_inst%deadcrootc_storage_patch(p) = cnveg_carbonstate_inst%deadcrootc_storage_patch(p) *t1 - cnveg_carbonstate_inst%deadcrootc_xfer_patch(p) = cnveg_carbonstate_inst%deadcrootc_xfer_patch(p) *t1 - cnveg_carbonstate_inst%gresp_storage_patch(p) = cnveg_carbonstate_inst%gresp_storage_patch(p) *t1 - cnveg_carbonstate_inst%gresp_xfer_patch(p) = cnveg_carbonstate_inst%gresp_xfer_patch(p) *t1 - cnveg_carbonstate_inst%cpool_patch(p) = cnveg_carbonstate_inst%cpool_patch(p) *t1 - cnveg_carbonstate_inst%xsmrpool_patch(p) = cnveg_carbonstate_inst%xsmrpool_patch(p) *t1 - cnveg_carbonstate_inst%ctrunc_patch(p) = cnveg_carbonstate_inst%ctrunc_patch(p) *t1 - cnveg_carbonstate_inst%dispvegc_patch(p) = cnveg_carbonstate_inst%dispvegc_patch(p) *t1 - cnveg_carbonstate_inst%storvegc_patch(p) = cnveg_carbonstate_inst%storvegc_patch(p) *t1 - cnveg_carbonstate_inst%totc_patch(p) = cnveg_carbonstate_inst%totc_patch(p) *t1 - cnveg_carbonstate_inst%totvegc_patch(p) = cnveg_carbonstate_inst%totvegc_patch(p) *t1 - - if ( use_c13 ) then - ! patch-level carbon-13 state variables - tot_leaf = & - c13_cnveg_carbonstate_inst%leafc_patch(p) + & - c13_cnveg_carbonstate_inst%leafc_storage_patch(p) + & - c13_cnveg_carbonstate_inst%leafc_xfer_patch(p) - pleaf = 0._r8 - pstor = 0._r8 - pxfer = 0._r8 - if (tot_leaf /= 0._r8) then - pleaf = c13_cnveg_carbonstate_inst%leafc_patch(p)/tot_leaf - pstor = c13_cnveg_carbonstate_inst%leafc_storage_patch(p)/tot_leaf - pxfer = c13_cnveg_carbonstate_inst%leafc_xfer_patch(p)/tot_leaf - else - ! when initiating from zero leaf state, use evergreen flag to set proportions - if (pftcon%evergreen(patch%itype(p)) == 1._r8) then - pleaf = 1._r8 - else - pstor = 1._r8 - end if - end if - c13_cnveg_carbonstate_inst%leafc_patch(p) = c13_cnveg_carbonstate_inst%leafc_patch(p) *t1 & - + leafc13_seed*pleaf*t2 - c13_cnveg_carbonstate_inst%leafc_storage_patch(p) = c13_cnveg_carbonstate_inst%leafc_storage_patch(p) *t1 & - + leafc13_seed*pstor*t2 - c13_cnveg_carbonstate_inst%leafc_xfer_patch(p) = c13_cnveg_carbonstate_inst%leafc_xfer_patch(p) *t1 & - + leafc13_seed*pxfer*t2 - c13_cnveg_carbonstate_inst%frootc_patch(p) = c13_cnveg_carbonstate_inst%frootc_patch(p) *t1 - c13_cnveg_carbonstate_inst%frootc_storage_patch(p) = c13_cnveg_carbonstate_inst%frootc_storage_patch(p) *t1 - c13_cnveg_carbonstate_inst%frootc_xfer_patch(p) = c13_cnveg_carbonstate_inst%frootc_xfer_patch(p) *t1 - c13_cnveg_carbonstate_inst%livestemc_patch(p) = c13_cnveg_carbonstate_inst%livestemc_patch(p) *t1 - c13_cnveg_carbonstate_inst%livestemc_storage_patch(p) = c13_cnveg_carbonstate_inst%livestemc_storage_patch(p) *t1 - c13_cnveg_carbonstate_inst%livestemc_xfer_patch(p) = c13_cnveg_carbonstate_inst%livestemc_xfer_patch(p) *t1 - c13_cnveg_carbonstate_inst%deadstemc_patch(p) = c13_cnveg_carbonstate_inst%deadstemc_patch(p) *t1 & - + deadstemc13_seed*t2 - c13_cnveg_carbonstate_inst%deadstemc_storage_patch(p) = c13_cnveg_carbonstate_inst%deadstemc_storage_patch(p) *t1 - c13_cnveg_carbonstate_inst%deadstemc_xfer_patch(p) = c13_cnveg_carbonstate_inst%deadstemc_xfer_patch(p) *t1 - c13_cnveg_carbonstate_inst%livecrootc_patch(p) = c13_cnveg_carbonstate_inst%livecrootc_patch(p) *t1 - c13_cnveg_carbonstate_inst%livecrootc_storage_patch(p) = c13_cnveg_carbonstate_inst%livecrootc_storage_patch(p) *t1 - c13_cnveg_carbonstate_inst%livecrootc_xfer_patch(p) = c13_cnveg_carbonstate_inst%livecrootc_xfer_patch(p) *t1 - c13_cnveg_carbonstate_inst%deadcrootc_patch(p) = c13_cnveg_carbonstate_inst%deadcrootc_patch(p) *t1 - c13_cnveg_carbonstate_inst%deadcrootc_storage_patch(p) = c13_cnveg_carbonstate_inst%deadcrootc_storage_patch(p) *t1 - c13_cnveg_carbonstate_inst%deadcrootc_xfer_patch(p) = c13_cnveg_carbonstate_inst%deadcrootc_xfer_patch(p) *t1 - c13_cnveg_carbonstate_inst%gresp_storage_patch(p) = c13_cnveg_carbonstate_inst%gresp_storage_patch(p) *t1 - c13_cnveg_carbonstate_inst%gresp_xfer_patch(p) = c13_cnveg_carbonstate_inst%gresp_xfer_patch(p) *t1 - c13_cnveg_carbonstate_inst%cpool_patch(p) = c13_cnveg_carbonstate_inst%cpool_patch(p) *t1 - c13_cnveg_carbonstate_inst%xsmrpool_patch(p) = c13_cnveg_carbonstate_inst%xsmrpool_patch(p) *t1 - c13_cnveg_carbonstate_inst%ctrunc_patch(p) = c13_cnveg_carbonstate_inst%ctrunc_patch(p) *t1 - c13_cnveg_carbonstate_inst%dispvegc_patch(p) = c13_cnveg_carbonstate_inst%dispvegc_patch(p) *t1 - c13_cnveg_carbonstate_inst%storvegc_patch(p) = c13_cnveg_carbonstate_inst%storvegc_patch(p) *t1 - c13_cnveg_carbonstate_inst%totc_patch(p) = c13_cnveg_carbonstate_inst%totc_patch(p) *t1 - c13_cnveg_carbonstate_inst%totvegc_patch(p) = c13_cnveg_carbonstate_inst%totvegc_patch(p) *t1 - - endif - - if ( use_c14 ) then - ! patch-level carbon-14 state variables - tot_leaf = & - c14_cnveg_carbonstate_inst%leafc_patch(p) + & - c14_cnveg_carbonstate_inst%leafc_storage_patch(p) + & - c14_cnveg_carbonstate_inst%leafc_xfer_patch(p) - pleaf = 0._r8 - pstor = 0._r8 - pxfer = 0._r8 - if (tot_leaf /= 0._r8) then - pleaf = c14_cnveg_carbonstate_inst%leafc_patch(p)/tot_leaf - pstor = c14_cnveg_carbonstate_inst%leafc_storage_patch(p)/tot_leaf - pxfer = c14_cnveg_carbonstate_inst%leafc_xfer_patch(p)/tot_leaf - else - ! when initiating from zero leaf state, use evergreen flag to set proportions - if (pftcon%evergreen(patch%itype(p)) == 1._r8) then - pleaf = 1._r8 - else - pstor = 1._r8 - end if - end if - c14_cnveg_carbonstate_inst%leafc_patch(p) = c14_cnveg_carbonstate_inst%leafc_patch(p) *t1 & - + leafc14_seed*pleaf*t2 - c14_cnveg_carbonstate_inst%leafc_storage_patch(p) = c14_cnveg_carbonstate_inst%leafc_storage_patch(p) *t1 & - + leafc14_seed*pstor*t2 - c14_cnveg_carbonstate_inst%leafc_xfer_patch(p) = c14_cnveg_carbonstate_inst%leafc_xfer_patch(p) *t1 & - + leafc14_seed*pxfer*t2 - c14_cnveg_carbonstate_inst%frootc_patch(p) = c14_cnveg_carbonstate_inst%frootc_patch(p) *t1 - c14_cnveg_carbonstate_inst%frootc_storage_patch(p) = c14_cnveg_carbonstate_inst%frootc_storage_patch(p) *t1 - c14_cnveg_carbonstate_inst%frootc_xfer_patch(p) = c14_cnveg_carbonstate_inst%frootc_xfer_patch(p) *t1 - c14_cnveg_carbonstate_inst%livestemc_patch(p) = c14_cnveg_carbonstate_inst%livestemc_patch(p) *t1 - c14_cnveg_carbonstate_inst%livestemc_storage_patch(p) = c14_cnveg_carbonstate_inst%livestemc_storage_patch(p) *t1 - c14_cnveg_carbonstate_inst%livestemc_xfer_patch(p) = c14_cnveg_carbonstate_inst%livestemc_xfer_patch(p) *t1 - c14_cnveg_carbonstate_inst%deadstemc_patch(p) = c14_cnveg_carbonstate_inst%deadstemc_patch(p) *t1 & - + deadstemc14_seed*t2 - c14_cnveg_carbonstate_inst%deadstemc_storage_patch(p) = c14_cnveg_carbonstate_inst%deadstemc_storage_patch(p) *t1 - c14_cnveg_carbonstate_inst%deadstemc_xfer_patch(p) = c14_cnveg_carbonstate_inst%deadstemc_xfer_patch(p) *t1 - c14_cnveg_carbonstate_inst%livecrootc_patch(p) = c14_cnveg_carbonstate_inst%livecrootc_patch(p) *t1 - c14_cnveg_carbonstate_inst%livecrootc_storage_patch(p) = c14_cnveg_carbonstate_inst%livecrootc_storage_patch(p) *t1 - c14_cnveg_carbonstate_inst%livecrootc_xfer_patch(p) = c14_cnveg_carbonstate_inst%livecrootc_xfer_patch(p) *t1 - c14_cnveg_carbonstate_inst%deadcrootc_patch(p) = c14_cnveg_carbonstate_inst%deadcrootc_patch(p) *t1 - c14_cnveg_carbonstate_inst%deadcrootc_storage_patch(p) = c14_cnveg_carbonstate_inst%deadcrootc_storage_patch(p) *t1 - c14_cnveg_carbonstate_inst%deadcrootc_xfer_patch(p) = c14_cnveg_carbonstate_inst%deadcrootc_xfer_patch(p) *t1 - c14_cnveg_carbonstate_inst%gresp_storage_patch(p) = c14_cnveg_carbonstate_inst%gresp_storage_patch(p) *t1 - c14_cnveg_carbonstate_inst%gresp_xfer_patch(p) = c14_cnveg_carbonstate_inst%gresp_xfer_patch(p) *t1 - c14_cnveg_carbonstate_inst%cpool_patch(p) = c14_cnveg_carbonstate_inst%cpool_patch(p) *t1 - c14_cnveg_carbonstate_inst%xsmrpool_patch(p) = c14_cnveg_carbonstate_inst%xsmrpool_patch(p) *t1 - c14_cnveg_carbonstate_inst%ctrunc_patch(p) = c14_cnveg_carbonstate_inst%ctrunc_patch(p) *t1 - c14_cnveg_carbonstate_inst%dispvegc_patch(p) = c14_cnveg_carbonstate_inst%dispvegc_patch(p) *t1 - c14_cnveg_carbonstate_inst%storvegc_patch(p) = c14_cnveg_carbonstate_inst%storvegc_patch(p) *t1 - c14_cnveg_carbonstate_inst%totc_patch(p) = c14_cnveg_carbonstate_inst%totc_patch(p) *t1 - c14_cnveg_carbonstate_inst%totvegc_patch(p) = c14_cnveg_carbonstate_inst%totvegc_patch(p) *t1 - endif - - tot_leaf = cnveg_nitrogenstate_inst%leafn_patch(p) + & - cnveg_nitrogenstate_inst%leafn_storage_patch(p) + & - cnveg_nitrogenstate_inst%leafn_xfer_patch(p) - pleaf = 0._r8 - pstor = 0._r8 - pxfer = 0._r8 - if (tot_leaf /= 0._r8) then - pleaf = cnveg_nitrogenstate_inst%leafn_patch(p)/tot_leaf - pstor = cnveg_nitrogenstate_inst%leafn_storage_patch(p)/tot_leaf - pxfer = cnveg_nitrogenstate_inst%leafn_xfer_patch(p)/tot_leaf - else - ! when initiating from zero leaf state, use evergreen flag to set proportions - if (pftcon%evergreen(patch%itype(p)) == 1._r8) then - pleaf = 1._r8 - else - pstor = 1._r8 - end if - end if - ! patch-level nitrogen state variables - cnveg_nitrogenstate_inst%leafn_patch(p) = cnveg_nitrogenstate_inst%leafn_patch(p) *t1 & - + leafn_seed*pleaf*t2 - cnveg_nitrogenstate_inst%leafn_storage_patch(p) = cnveg_nitrogenstate_inst%leafn_storage_patch(p) *t1 & - + leafn_seed*pstor*t2 - cnveg_nitrogenstate_inst%leafn_xfer_patch(p) = cnveg_nitrogenstate_inst%leafn_xfer_patch(p) *t1 & - + leafn_seed*pxfer*t2 - cnveg_nitrogenstate_inst%frootn_patch(p) = cnveg_nitrogenstate_inst%frootn_patch(p) *t1 - cnveg_nitrogenstate_inst%frootn_storage_patch(p) = cnveg_nitrogenstate_inst%frootn_storage_patch(p) *t1 - cnveg_nitrogenstate_inst%frootn_xfer_patch(p) = cnveg_nitrogenstate_inst%frootn_xfer_patch(p) *t1 - cnveg_nitrogenstate_inst%livestemn_patch(p) = cnveg_nitrogenstate_inst%livestemn_patch(p) *t1 - cnveg_nitrogenstate_inst%livestemn_storage_patch(p) = cnveg_nitrogenstate_inst%livestemn_storage_patch(p) *t1 - cnveg_nitrogenstate_inst%livestemn_xfer_patch(p) = cnveg_nitrogenstate_inst%livestemn_xfer_patch(p) *t1 - cnveg_nitrogenstate_inst%deadstemn_patch(p) = cnveg_nitrogenstate_inst%deadstemn_patch(p) *t1 & - + deadstemn_seed*t2 - cnveg_nitrogenstate_inst%deadstemn_storage_patch(p) = cnveg_nitrogenstate_inst%deadstemn_storage_patch(p) *t1 - cnveg_nitrogenstate_inst%deadstemn_xfer_patch(p) = cnveg_nitrogenstate_inst%deadstemn_xfer_patch(p) *t1 - cnveg_nitrogenstate_inst%livecrootn_patch(p) = cnveg_nitrogenstate_inst%livecrootn_patch(p) *t1 - cnveg_nitrogenstate_inst%livecrootn_storage_patch(p) = cnveg_nitrogenstate_inst%livecrootn_storage_patch(p) *t1 - cnveg_nitrogenstate_inst%livecrootn_xfer_patch(p) = cnveg_nitrogenstate_inst%livecrootn_xfer_patch(p) *t1 - cnveg_nitrogenstate_inst%deadcrootn_patch(p) = cnveg_nitrogenstate_inst%deadcrootn_patch(p) *t1 - cnveg_nitrogenstate_inst%deadcrootn_storage_patch(p) = cnveg_nitrogenstate_inst%deadcrootn_storage_patch(p) *t1 - cnveg_nitrogenstate_inst%deadcrootn_xfer_patch(p) = cnveg_nitrogenstate_inst%deadcrootn_xfer_patch(p) *t1 - cnveg_nitrogenstate_inst%retransn_patch(p) = cnveg_nitrogenstate_inst%retransn_patch(p) *t1 - cnveg_nitrogenstate_inst%npool_patch(p) = cnveg_nitrogenstate_inst%npool_patch(p) *t1 - cnveg_nitrogenstate_inst%ntrunc_patch(p) = cnveg_nitrogenstate_inst%ntrunc_patch(p) *t1 - cnveg_nitrogenstate_inst%dispvegn_patch(p) = cnveg_nitrogenstate_inst%dispvegn_patch(p) *t1 - cnveg_nitrogenstate_inst%storvegn_patch(p) = cnveg_nitrogenstate_inst%storvegn_patch(p) *t1 - cnveg_nitrogenstate_inst%totvegn_patch(p) = cnveg_nitrogenstate_inst%totvegn_patch(p) *t1 - cnveg_nitrogenstate_inst%totn_patch(p) = cnveg_nitrogenstate_inst%totn_patch(p) *t1 - - ! update temporary seed source arrays - ! These are calculated in terms of the required contributions from - ! column-level seed source - dwt_leafc_seed(p) = leafc_seed * dwt - if ( use_c13 ) then - dwt_leafc13_seed(p) = leafc13_seed * dwt - dwt_deadstemc13_seed(p) = deadstemc13_seed * dwt - endif - if ( use_c14 ) then - dwt_leafc14_seed(p) = leafc14_seed * dwt - dwt_deadstemc14_seed(p) = deadstemc14_seed * dwt - endif - dwt_leafn_seed(p) = leafn_seed * dwt - dwt_deadstemc_seed(p) = deadstemc_seed * dwt - dwt_deadstemn_seed(p) = deadstemn_seed * dwt - - else if (dwt < 0._r8) then - - ! if the pft lost weight on the timestep, then the carbon and nitrogen state - ! variables are directed to litter, CWD, and wood product pools. - - ! N.B. : the conv_cflux and product_cflux fluxes are accumulated as negative - ! values, but the fluxes for pft-to-litter are accumulated as positive values - - ! set local weight variables for this pft - wt_new = patch%wtcol(p) - wt_old = prior_weights%pwtcol(p) - - !--------------- - ! C state update - !--------------- - - ! leafc - ptr => cnveg_carbonstate_inst%leafc_patch(p) - init_state = ptr*wt_old - change_state = ptr*dwt - new_state = init_state+change_state - if (wt_new /= 0._r8) then - ptr = new_state/wt_new - conv_cflux(p) = conv_cflux(p) + change_state - else - ptr = 0._r8 - conv_cflux(p) = conv_cflux(p) - init_state - end if - - ! leafc_storage - ptr => cnveg_carbonstate_inst%leafc_storage_patch(p) - init_state = ptr*wt_old - change_state = ptr*dwt - new_state = init_state+change_state - if (wt_new /= 0._r8) then - ptr = new_state/wt_new - conv_cflux(p) = conv_cflux(p) + change_state - else - ptr = 0._r8 - conv_cflux(p) = conv_cflux(p) - init_state - end if - - ! leafc_xfer - ptr => cnveg_carbonstate_inst%leafc_xfer_patch(p) - init_state = ptr*wt_old - change_state = ptr*dwt - new_state = init_state+change_state - if (wt_new /= 0._r8) then - ptr = new_state/wt_new - conv_cflux(p) = conv_cflux(p) + change_state - else - ptr = 0._r8 - conv_cflux(p) = conv_cflux(p) - init_state - end if - - ! frootc - ptr => cnveg_carbonstate_inst%frootc_patch(p) - init_state = ptr*wt_old - change_state = ptr*dwt - new_state = init_state+change_state - if (wt_new /= 0._r8) then - ptr = new_state/wt_new - dwt_frootc_to_litter(p) = dwt_frootc_to_litter(p) - change_state - else - ptr = 0._r8 - dwt_frootc_to_litter(p) = dwt_frootc_to_litter(p) + init_state - end if - - ! frootc_storage - ptr => cnveg_carbonstate_inst%frootc_storage_patch(p) - init_state = ptr*wt_old - change_state = ptr*dwt - new_state = init_state+change_state - if (wt_new /= 0._r8) then - ptr = new_state/wt_new - conv_cflux(p) = conv_cflux(p) + change_state - else - ptr = 0._r8 - conv_cflux(p) = conv_cflux(p) - init_state - end if - - ! frootc_xfer - ptr => cnveg_carbonstate_inst%frootc_xfer_patch(p) - init_state = ptr*wt_old - change_state = ptr*dwt - new_state = init_state+change_state - if (wt_new /= 0._r8) then - ptr = new_state/wt_new - conv_cflux(p) = conv_cflux(p) + change_state - else - ptr = 0._r8 - conv_cflux(p) = conv_cflux(p) - init_state - end if - - ! livestemc - ptr => cnveg_carbonstate_inst%livestemc_patch(p) - init_state = ptr*wt_old - change_state = ptr*dwt - new_state = init_state+change_state - if (wt_new /= 0._r8) then - ptr = new_state/wt_new - conv_cflux(p) = conv_cflux(p) + change_state - else - ptr = 0._r8 - conv_cflux(p) = conv_cflux(p) - init_state - end if - - ! livestemc_storage - ptr => cnveg_carbonstate_inst%livestemc_storage_patch(p) - init_state = ptr*wt_old - change_state = ptr*dwt - new_state = init_state+change_state - if (wt_new /= 0._r8) then - ptr = new_state/wt_new - conv_cflux(p) = conv_cflux(p) + change_state - else - ptr = 0._r8 - conv_cflux(p) = conv_cflux(p) - init_state - end if - - ! livestemc_xfer - ptr => cnveg_carbonstate_inst%livestemc_xfer_patch(p) - init_state = ptr*wt_old - change_state = ptr*dwt - new_state = init_state+change_state - if (wt_new /= 0._r8) then - ptr = new_state/wt_new - conv_cflux(p) = conv_cflux(p) + change_state - else - ptr = 0._r8 - conv_cflux(p) = conv_cflux(p) - init_state - end if - - ! deadstemc - ptr => cnveg_carbonstate_inst%deadstemc_patch(p) - init_state = ptr*wt_old - change_state = ptr*dwt - new_state = init_state+change_state - if (wt_new /= 0._r8) then - ptr = new_state/wt_new - conv_cflux(p) = conv_cflux(p) + change_state * pftcon%pconv(patch%itype(p)) - product_cflux(p) = product_cflux(p) + & - change_state * (1._r8 - pftcon%pconv(patch%itype(p))) - else - ptr = 0._r8 - conv_cflux(p) = conv_cflux(p) - init_state * pftcon%pconv(patch%itype(p)) - product_cflux(p) = product_cflux(p) - & - init_state * (1._r8 - pftcon%pconv(patch%itype(p))) - end if - - ! deadstemc_storage - ptr => cnveg_carbonstate_inst%deadstemc_storage_patch(p) - init_state = ptr*wt_old - change_state = ptr*dwt - new_state = init_state+change_state - if (wt_new /= 0._r8) then - ptr = new_state/wt_new - conv_cflux(p) = conv_cflux(p) + change_state - else - ptr = 0._r8 - conv_cflux(p) = conv_cflux(p) - init_state - end if - - ! deadstemc_xfer - ptr => cnveg_carbonstate_inst%deadstemc_xfer_patch(p) - init_state = ptr*wt_old - change_state = ptr*dwt - new_state = init_state+change_state - if (wt_new /= 0._r8) then - ptr = new_state/wt_new - conv_cflux(p) = conv_cflux(p) + change_state - else - ptr = 0._r8 - conv_cflux(p) = conv_cflux(p) - init_state - end if - - ! livecrootc - ptr => cnveg_carbonstate_inst%livecrootc_patch(p) - init_state = ptr*wt_old - change_state = ptr*dwt - new_state = init_state+change_state - if (wt_new /= 0._r8) then - ptr = new_state/wt_new - dwt_livecrootc_to_litter(p) = dwt_livecrootc_to_litter(p) - change_state - else - ptr = 0._r8 - dwt_livecrootc_to_litter(p) = dwt_livecrootc_to_litter(p) + init_state - end if - - ! livecrootc_storage - ptr => cnveg_carbonstate_inst%livecrootc_storage_patch(p) - init_state = ptr*wt_old - change_state = ptr*dwt - new_state = init_state+change_state - if (wt_new /= 0._r8) then - ptr = new_state/wt_new - conv_cflux(p) = conv_cflux(p) + change_state - else - ptr = 0._r8 - conv_cflux(p) = conv_cflux(p) - init_state - end if - - ! livecrootc_xfer - ptr => cnveg_carbonstate_inst%livecrootc_xfer_patch(p) - init_state = ptr*wt_old - change_state = ptr*dwt - new_state = init_state+change_state - if (wt_new /= 0._r8) then - ptr = new_state/wt_new - conv_cflux(p) = conv_cflux(p) + change_state - else - ptr = 0._r8 - conv_cflux(p) = conv_cflux(p) - init_state - end if - - ! deadcrootc - ptr => cnveg_carbonstate_inst%deadcrootc_patch(p) - init_state = ptr*wt_old - change_state = ptr*dwt - new_state = init_state+change_state - if (wt_new /= 0._r8) then - ptr = new_state/wt_new - dwt_deadcrootc_to_litter(p) = dwt_deadcrootc_to_litter(p) - change_state - else - ptr = 0._r8 - dwt_deadcrootc_to_litter(p) = dwt_deadcrootc_to_litter(p) + init_state - end if - - ! deadcrootc_storage - ptr => cnveg_carbonstate_inst%deadcrootc_storage_patch(p) - init_state = ptr*wt_old - change_state = ptr*dwt - new_state = init_state+change_state - if (wt_new /= 0._r8) then - ptr = new_state/wt_new - conv_cflux(p) = conv_cflux(p) + change_state - else - ptr = 0._r8 - conv_cflux(p) = conv_cflux(p) - init_state - end if - - ! deadcrootc_xfer - ptr => cnveg_carbonstate_inst%deadcrootc_xfer_patch(p) - init_state = ptr*wt_old - change_state = ptr*dwt - new_state = init_state+change_state - if (wt_new /= 0._r8) then - ptr = new_state/wt_new - conv_cflux(p) = conv_cflux(p) + change_state - else - ptr = 0._r8 - conv_cflux(p) = conv_cflux(p) - init_state - end if - - ! gresp_storage - ptr => cnveg_carbonstate_inst%gresp_storage_patch(p) - init_state = ptr*wt_old - change_state = ptr*dwt - new_state = init_state+change_state - if (wt_new /= 0._r8) then - ptr = new_state/wt_new - conv_cflux(p) = conv_cflux(p) + change_state - else - ptr = 0._r8 - conv_cflux(p) = conv_cflux(p) - init_state - end if - - ! gresp_xfer - ptr => cnveg_carbonstate_inst%gresp_xfer_patch(p) - init_state = ptr*wt_old - change_state = ptr*dwt - new_state = init_state+change_state - if (wt_new /= 0._r8) then - ptr = new_state/wt_new - conv_cflux(p) = conv_cflux(p) + change_state - else - ptr = 0._r8 - conv_cflux(p) = conv_cflux(p) - init_state - end if - - ! cpool - ptr => cnveg_carbonstate_inst%cpool_patch(p) - init_state = ptr*wt_old - change_state = ptr*dwt - new_state = init_state+change_state - if (wt_new /= 0._r8) then - ptr = new_state/wt_new - conv_cflux(p) = conv_cflux(p) + change_state - else - ptr = 0._r8 - conv_cflux(p) = conv_cflux(p) - init_state - end if - - ! xsmrpool - ptr => cnveg_carbonstate_inst%xsmrpool_patch(p) - init_state = ptr*wt_old - change_state = ptr*dwt - new_state = init_state+change_state - if (wt_new /= 0._r8) then - ptr = new_state/wt_new - conv_cflux(p) = conv_cflux(p) + change_state - else - ptr = 0._r8 - conv_cflux(p) = conv_cflux(p) - init_state - end if - - ! pft_ctrunc - ptr => cnveg_carbonstate_inst%ctrunc_patch(p) - init_state = ptr*wt_old - change_state = ptr*dwt - new_state = init_state+change_state - if (wt_new /= 0._r8) then - ptr = new_state/wt_new - conv_cflux(p) = conv_cflux(p) + change_state - else - ptr = 0._r8 - conv_cflux(p) = conv_cflux(p) - init_state - end if + if (use_c14) then + call c14_cnveg_carbonstate_inst%DynamicPatchAdjustments(bounds, & + num_soilp_with_inactive, filter_soilp_with_inactive, & + patch_state_updater, & + leafc_seed = leafc_seed, & + deadstemc_seed = deadstemc_seed, & + conv_cflux = conv_c14flux(begp:endp), & + product_cflux = product_c14flux(begp:endp), & + dwt_frootc_to_litter = dwt_frootc14_to_litter(begp:endp), & + dwt_livecrootc_to_litter = dwt_livecrootc14_to_litter(begp:endp), & + dwt_deadcrootc_to_litter = dwt_deadcrootc14_to_litter(begp:endp), & + dwt_leafc_seed = dwt_leafc14_seed(begp:endp), & + dwt_deadstemc_seed = dwt_deadstemc14_seed(begp:endp)) + + ! These fluxes are computed as negative quantities, but are expected to be positive, + ! so flip the signs + do p = begp,endp + dwt_frootc14_to_litter(p) = -1._r8 * dwt_frootc14_to_litter(p) + dwt_livecrootc14_to_litter(p) = -1._r8 * dwt_livecrootc14_to_litter(p) + dwt_deadcrootc14_to_litter(p) = -1._r8 * dwt_deadcrootc14_to_litter(p) + end do - if ( use_c13 ) then - !------------------- - ! C13 state update - !------------------- - - ! set pointers to the conversion and product pool fluxes for this pft - ! dwt_ptr0 is reserved for local assignment to dwt_xxx_to_litter fluxes - dwt_ptr1 => conv_c13flux(p) - - ! leafc - ptr => cnveg_carbonstate_inst%leafc_patch(p) - init_state = ptr*wt_old - change_state = ptr*dwt - new_state = init_state+change_state - if (wt_new /= 0._r8) then - ptr = new_state/wt_new - dwt_ptr1 = dwt_ptr1 + change_state - else - ptr = 0._r8 - dwt_ptr1 = dwt_ptr1 - init_state - end if - - ! leafc_storage - ptr => cnveg_carbonstate_inst%leafc_storage_patch(p) - init_state = ptr*wt_old - change_state = ptr*dwt - new_state = init_state+change_state - if (wt_new /= 0._r8) then - ptr = new_state/wt_new - dwt_ptr1 = dwt_ptr1 + change_state - else - ptr = 0._r8 - dwt_ptr1 = dwt_ptr1 - init_state - end if - - ! leafc_xfer - ptr => cnveg_carbonstate_inst%leafc_xfer_patch(p) - init_state = ptr*wt_old - change_state = ptr*dwt - new_state = init_state+change_state - if (wt_new /= 0._r8) then - ptr = new_state/wt_new - dwt_ptr1 = dwt_ptr1 + change_state - else - ptr = 0._r8 - dwt_ptr1 = dwt_ptr1 - init_state - end if - - ! frootc - ptr => cnveg_carbonstate_inst%frootc_patch(p) - dwt_ptr0 => dwt_frootc13_to_litter(p) - init_state = ptr*wt_old - change_state = ptr*dwt - new_state = init_state+change_state - if (wt_new /= 0._r8) then - ptr = new_state/wt_new - dwt_ptr0 = dwt_ptr0 - change_state - else - ptr = 0._r8 - dwt_ptr0 = dwt_ptr0 + init_state - end if - - ! frootc_storage - ptr => cnveg_carbonstate_inst%frootc_storage_patch(p) - init_state = ptr*wt_old - change_state = ptr*dwt - new_state = init_state+change_state - if (wt_new /= 0._r8) then - ptr = new_state/wt_new - dwt_ptr1 = dwt_ptr1 + change_state - else - ptr = 0._r8 - dwt_ptr1 = dwt_ptr1 - init_state - end if - - ! frootc_xfer - ptr => cnveg_carbonstate_inst%frootc_xfer_patch(p) - init_state = ptr*wt_old - change_state = ptr*dwt - new_state = init_state+change_state - if (wt_new /= 0._r8) then - ptr = new_state/wt_new - dwt_ptr1 = dwt_ptr1 + change_state - else - ptr = 0._r8 - dwt_ptr1 = dwt_ptr1 - init_state - end if - - ! livestemc - ptr => cnveg_carbonstate_inst%livestemc_patch(p) - init_state = ptr*wt_old - change_state = ptr*dwt - new_state = init_state+change_state - if (wt_new /= 0._r8) then - ptr = new_state/wt_new - dwt_ptr1 = dwt_ptr1 + change_state - else - ptr = 0._r8 - dwt_ptr1 = dwt_ptr1 - init_state - end if - - ! livestemc_storage - ptr => cnveg_carbonstate_inst%livestemc_storage_patch(p) - init_state = ptr*wt_old - change_state = ptr*dwt - new_state = init_state+change_state - if (wt_new /= 0._r8) then - ptr = new_state/wt_new - dwt_ptr1 = dwt_ptr1 + change_state - else - ptr = 0._r8 - dwt_ptr1 = dwt_ptr1 - init_state - end if - - ! livestemc_xfer - ptr => cnveg_carbonstate_inst%livestemc_xfer_patch(p) - init_state = ptr*wt_old - change_state = ptr*dwt - new_state = init_state+change_state - if (wt_new /= 0._r8) then - ptr = new_state/wt_new - dwt_ptr1 = dwt_ptr1 + change_state - else - ptr = 0._r8 - dwt_ptr1 = dwt_ptr1 - init_state - end if - - ! deadstemc - ptr => cnveg_carbonstate_inst%deadstemc_patch(p) - init_state = ptr*wt_old - change_state = ptr*dwt - new_state = init_state+change_state - if (wt_new /= 0._r8) then - ptr = new_state/wt_new - dwt_ptr1 = dwt_ptr1 + change_state * pftcon%pconv(patch%itype(p)) - product_c13flux(p) = product_c13flux(p) + & - change_state * (1._r8 - pftcon%pconv(patch%itype(p))) - else - ptr = 0._r8 - dwt_ptr1 = dwt_ptr1 - init_state * pftcon%pconv(patch%itype(p)) - product_c13flux(p) = product_c13flux(p) - & - init_state * (1._r8 - pftcon%pconv(patch%itype(p))) - end if - - ! deadstemc_storage - ptr => cnveg_carbonstate_inst%deadstemc_storage_patch(p) - init_state = ptr*wt_old - change_state = ptr*dwt - new_state = init_state+change_state - if (wt_new /= 0._r8) then - ptr = new_state/wt_new - dwt_ptr1 = dwt_ptr1 + change_state - else - ptr = 0._r8 - dwt_ptr1 = dwt_ptr1 - init_state - end if - - ! deadstemc_xfer - ptr => cnveg_carbonstate_inst%deadstemc_xfer_patch(p) - init_state = ptr*wt_old - change_state = ptr*dwt - new_state = init_state+change_state - if (wt_new /= 0._r8) then - ptr = new_state/wt_new - dwt_ptr1 = dwt_ptr1 + change_state - else - ptr = 0._r8 - dwt_ptr1 = dwt_ptr1 - init_state - end if - - ! livecrootc - ptr => cnveg_carbonstate_inst%livecrootc_patch(p) - dwt_ptr0 => dwt_livecrootc13_to_litter(p) - init_state = ptr*wt_old - change_state = ptr*dwt - new_state = init_state+change_state - if (wt_new /= 0._r8) then - ptr = new_state/wt_new - dwt_ptr0 = dwt_ptr0 - change_state - else - ptr = 0._r8 - dwt_ptr0 = dwt_ptr0 + init_state - end if - - ! livecrootc_storage - ptr => cnveg_carbonstate_inst%livecrootc_storage_patch(p) - init_state = ptr*wt_old - change_state = ptr*dwt - new_state = init_state+change_state - if (wt_new /= 0._r8) then - ptr = new_state/wt_new - dwt_ptr1 = dwt_ptr1 + change_state - else - ptr = 0._r8 - dwt_ptr1 = dwt_ptr1 - init_state - end if - - ! livecrootc_xfer - ptr => cnveg_carbonstate_inst%livecrootc_xfer_patch(p) - init_state = ptr*wt_old - change_state = ptr*dwt - new_state = init_state+change_state - if (wt_new /= 0._r8) then - ptr = new_state/wt_new - dwt_ptr1 = dwt_ptr1 + change_state - else - ptr = 0._r8 - dwt_ptr1 = dwt_ptr1 - init_state - end if - - ! deadcrootc - ptr => cnveg_carbonstate_inst%deadcrootc_patch(p) - dwt_ptr0 => dwt_deadcrootc13_to_litter(p) - init_state = ptr*wt_old - change_state = ptr*dwt - new_state = init_state+change_state - if (wt_new /= 0._r8) then - ptr = new_state/wt_new - dwt_ptr0 = dwt_ptr0 - change_state - else - ptr = 0._r8 - dwt_ptr0 = dwt_ptr0 + init_state - end if - - ! deadcrootc_storage - ptr => cnveg_carbonstate_inst%deadcrootc_storage_patch(p) - init_state = ptr*wt_old - change_state = ptr*dwt - new_state = init_state+change_state - if (wt_new /= 0._r8) then - ptr = new_state/wt_new - dwt_ptr1 = dwt_ptr1 + change_state - else - ptr = 0._r8 - dwt_ptr1 = dwt_ptr1 - init_state - end if - - ! deadcrootc_xfer - ptr => cnveg_carbonstate_inst%deadcrootc_xfer_patch(p) - init_state = ptr*wt_old - change_state = ptr*dwt - new_state = init_state+change_state - if (wt_new /= 0._r8) then - ptr = new_state/wt_new - dwt_ptr1 = dwt_ptr1 + change_state - else - ptr = 0._r8 - dwt_ptr1 = dwt_ptr1 - init_state - end if - - ! gresp_storage - ptr => cnveg_carbonstate_inst%gresp_storage_patch(p) - init_state = ptr*wt_old - change_state = ptr*dwt - new_state = init_state+change_state - if (wt_new /= 0._r8) then - ptr = new_state/wt_new - dwt_ptr1 = dwt_ptr1 + change_state - else - ptr = 0._r8 - dwt_ptr1 = dwt_ptr1 - init_state - end if - - ! gresp_xfer - ptr => cnveg_carbonstate_inst%gresp_xfer_patch(p) - init_state = ptr*wt_old - change_state = ptr*dwt - new_state = init_state+change_state - if (wt_new /= 0._r8) then - ptr = new_state/wt_new - dwt_ptr1 = dwt_ptr1 + change_state - else - ptr = 0._r8 - dwt_ptr1 = dwt_ptr1 - init_state - end if - - ! cpool - ptr => cnveg_carbonstate_inst%cpool_patch(p) - init_state = ptr*wt_old - change_state = ptr*dwt - new_state = init_state+change_state - if (wt_new /= 0._r8) then - ptr = new_state/wt_new - dwt_ptr1 = dwt_ptr1 + change_state - else - ptr = 0._r8 - dwt_ptr1 = dwt_ptr1 - init_state - end if - - ! pft_ctrunc - ptr => cnveg_carbonstate_inst%ctrunc_patch(p) - init_state = ptr*wt_old - change_state = ptr*dwt - new_state = init_state+change_state - if (wt_new /= 0._r8) then - ptr = new_state/wt_new - dwt_ptr1 = dwt_ptr1 + change_state - else - ptr = 0._r8 - dwt_ptr1 = dwt_ptr1 - init_state - end if - - endif + end if + + call cnveg_nitrogenstate_inst%DynamicPatchAdjustments(bounds, & + num_soilp_with_inactive, filter_soilp_with_inactive, & + patch_state_updater, & + leafc_seed = leafc_seed, & + deadstemc_seed = deadstemc_seed, & + conv_nflux = conv_nflux(begp:endp), & + product_nflux = product_nflux(begp:endp), & + dwt_frootn_to_litter = dwt_frootn_to_litter(begp:endp), & + dwt_livecrootn_to_litter = dwt_livecrootn_to_litter(begp:endp), & + dwt_deadcrootn_to_litter = dwt_deadcrootn_to_litter(begp:endp), & + dwt_leafn_seed = dwt_leafn_seed(begp:endp), & + dwt_deadstemn_seed = dwt_deadstemn_seed(begp:endp)) + + ! These fluxes are computed as negative quantities, but are expected to be positive, + ! so flip the signs + do p = begp,endp + dwt_frootn_to_litter(p) = -1._r8 * dwt_frootn_to_litter(p) + dwt_livecrootn_to_litter(p) = -1._r8 * dwt_livecrootn_to_litter(p) + dwt_deadcrootn_to_litter(p) = -1._r8 * dwt_deadcrootn_to_litter(p) + end do - if ( use_c14 ) then - !------------------- - ! C14 state update - !------------------- - - ! set pointers to the conversion and product pool fluxes for this patch - ! dwt_ptr0 is reserved for local assignment to dwt_xxx_to_litter fluxes - dwt_ptr1 => conv_c14flux(p) - - ! leafc - ptr => cnveg_carbonstate_inst%leafc_patch(p) - init_state = ptr*wt_old - change_state = ptr*dwt - new_state = init_state+change_state - if (wt_new /= 0._r8) then - ptr = new_state/wt_new - dwt_ptr1 = dwt_ptr1 + change_state - else - ptr = 0._r8 - dwt_ptr1 = dwt_ptr1 - init_state - end if - - ! leafc_storage - ptr => cnveg_carbonstate_inst%leafc_storage_patch(p) - init_state = ptr*wt_old - change_state = ptr*dwt - new_state = init_state+change_state - if (wt_new /= 0._r8) then - ptr = new_state/wt_new - dwt_ptr1 = dwt_ptr1 + change_state - else - ptr = 0._r8 - dwt_ptr1 = dwt_ptr1 - init_state - end if - - ! leafc_xfer - ptr => cnveg_carbonstate_inst%leafc_xfer_patch(p) - init_state = ptr*wt_old - change_state = ptr*dwt - new_state = init_state+change_state - if (wt_new /= 0._r8) then - ptr = new_state/wt_new - dwt_ptr1 = dwt_ptr1 + change_state - else - ptr = 0._r8 - dwt_ptr1 = dwt_ptr1 - init_state - end if - - ! frootc - ptr => cnveg_carbonstate_inst%frootc_patch(p) - dwt_ptr0 => dwt_frootc14_to_litter(p) - init_state = ptr*wt_old - change_state = ptr*dwt - new_state = init_state+change_state - if (wt_new /= 0._r8) then - ptr = new_state/wt_new - dwt_ptr0 = dwt_ptr0 - change_state - else - ptr = 0._r8 - dwt_ptr0 = dwt_ptr0 + init_state - end if - - ! frootc_storage - ptr => cnveg_carbonstate_inst%frootc_storage_patch(p) - init_state = ptr*wt_old - change_state = ptr*dwt - new_state = init_state+change_state - if (wt_new /= 0._r8) then - ptr = new_state/wt_new - dwt_ptr1 = dwt_ptr1 + change_state - else - ptr = 0._r8 - dwt_ptr1 = dwt_ptr1 - init_state - end if - - ! frootc_xfer - ptr => cnveg_carbonstate_inst%frootc_xfer_patch(p) - init_state = ptr*wt_old - change_state = ptr*dwt - new_state = init_state+change_state - if (wt_new /= 0._r8) then - ptr = new_state/wt_new - dwt_ptr1 = dwt_ptr1 + change_state - else - ptr = 0._r8 - dwt_ptr1 = dwt_ptr1 - init_state - end if - - ! livestemc - ptr => cnveg_carbonstate_inst%livestemc_patch(p) - init_state = ptr*wt_old - change_state = ptr*dwt - new_state = init_state+change_state - if (wt_new /= 0._r8) then - ptr = new_state/wt_new - dwt_ptr1 = dwt_ptr1 + change_state - else - ptr = 0._r8 - dwt_ptr1 = dwt_ptr1 - init_state - end if - - ! livestemc_storage - ptr => cnveg_carbonstate_inst%livestemc_storage_patch(p) - init_state = ptr*wt_old - change_state = ptr*dwt - new_state = init_state+change_state - if (wt_new /= 0._r8) then - ptr = new_state/wt_new - dwt_ptr1 = dwt_ptr1 + change_state - else - ptr = 0._r8 - dwt_ptr1 = dwt_ptr1 - init_state - end if - - ! livestemc_xfer - ptr => cnveg_carbonstate_inst%livestemc_xfer_patch(p) - init_state = ptr*wt_old - change_state = ptr*dwt - new_state = init_state+change_state - if (wt_new /= 0._r8) then - ptr = new_state/wt_new - dwt_ptr1 = dwt_ptr1 + change_state - else - ptr = 0._r8 - dwt_ptr1 = dwt_ptr1 - init_state - end if - - ! deadstemc - ptr => cnveg_carbonstate_inst%deadstemc_patch(p) - init_state = ptr*wt_old - change_state = ptr*dwt - new_state = init_state+change_state - if (wt_new /= 0._r8) then - ptr = new_state/wt_new - dwt_ptr1 = dwt_ptr1 + change_state * pftcon%pconv(patch%itype(p)) - product_c14flux(p) = product_c14flux(p) + & - change_state * (1._r8 - pftcon%pconv(patch%itype(p))) - else - ptr = 0._r8 - dwt_ptr1 = dwt_ptr1 - init_state * pftcon%pconv(patch%itype(p)) - product_c14flux(p) = product_c14flux(p) - & - init_state * (1._r8 - pftcon%pconv(patch%itype(p))) - end if - - ! deadstemc_storage - ptr => cnveg_carbonstate_inst%deadstemc_storage_patch(p) - init_state = ptr*wt_old - change_state = ptr*dwt - new_state = init_state+change_state - if (wt_new /= 0._r8) then - ptr = new_state/wt_new - dwt_ptr1 = dwt_ptr1 + change_state - else - ptr = 0._r8 - dwt_ptr1 = dwt_ptr1 - init_state - end if - - ! deadstemc_xfer - ptr => cnveg_carbonstate_inst%deadstemc_xfer_patch(p) - init_state = ptr*wt_old - change_state = ptr*dwt - new_state = init_state+change_state - if (wt_new /= 0._r8) then - ptr = new_state/wt_new - dwt_ptr1 = dwt_ptr1 + change_state - else - ptr = 0._r8 - dwt_ptr1 = dwt_ptr1 - init_state - end if - - ! livecrootc - ptr => cnveg_carbonstate_inst%livecrootc_patch(p) - dwt_ptr0 => dwt_livecrootc14_to_litter(p) - init_state = ptr*wt_old - change_state = ptr*dwt - new_state = init_state+change_state - if (wt_new /= 0._r8) then - ptr = new_state/wt_new - dwt_ptr0 = dwt_ptr0 - change_state - else - ptr = 0._r8 - dwt_ptr0 = dwt_ptr0 + init_state - end if - - ! livecrootc_storage - ptr => cnveg_carbonstate_inst%livecrootc_storage_patch(p) - init_state = ptr*wt_old - change_state = ptr*dwt - new_state = init_state+change_state - if (wt_new /= 0._r8) then - ptr = new_state/wt_new - dwt_ptr1 = dwt_ptr1 + change_state - else - ptr = 0._r8 - dwt_ptr1 = dwt_ptr1 - init_state - end if - - ! livecrootc_xfer - ptr => cnveg_carbonstate_inst%livecrootc_xfer_patch(p) - init_state = ptr*wt_old - change_state = ptr*dwt - new_state = init_state+change_state - if (wt_new /= 0._r8) then - ptr = new_state/wt_new - dwt_ptr1 = dwt_ptr1 + change_state - else - ptr = 0._r8 - dwt_ptr1 = dwt_ptr1 - init_state - end if - - ! deadcrootc - ptr => cnveg_carbonstate_inst%deadcrootc_patch(p) - dwt_ptr0 => dwt_deadcrootc14_to_litter(p) - init_state = ptr*wt_old - change_state = ptr*dwt - new_state = init_state+change_state - if (wt_new /= 0._r8) then - ptr = new_state/wt_new - dwt_ptr0 = dwt_ptr0 - change_state - else - ptr = 0._r8 - dwt_ptr0 = dwt_ptr0 + init_state - end if - - ! deadcrootc_storage - ptr => cnveg_carbonstate_inst%deadcrootc_storage_patch(p) - init_state = ptr*wt_old - change_state = ptr*dwt - new_state = init_state+change_state - if (wt_new /= 0._r8) then - ptr = new_state/wt_new - dwt_ptr1 = dwt_ptr1 + change_state - else - ptr = 0._r8 - dwt_ptr1 = dwt_ptr1 - init_state - end if - - ! deadcrootc_xfer - ptr => cnveg_carbonstate_inst%deadcrootc_xfer_patch(p) - init_state = ptr*wt_old - change_state = ptr*dwt - new_state = init_state+change_state - if (wt_new /= 0._r8) then - ptr = new_state/wt_new - dwt_ptr1 = dwt_ptr1 + change_state - else - ptr = 0._r8 - dwt_ptr1 = dwt_ptr1 - init_state - end if - - ! gresp_storage - ptr => cnveg_carbonstate_inst%gresp_storage_patch(p) - init_state = ptr*wt_old - change_state = ptr*dwt - new_state = init_state+change_state - if (wt_new /= 0._r8) then - ptr = new_state/wt_new - dwt_ptr1 = dwt_ptr1 + change_state - else - ptr = 0._r8 - dwt_ptr1 = dwt_ptr1 - init_state - end if - - ! gresp_xfer - ptr => cnveg_carbonstate_inst%gresp_xfer_patch(p) - init_state = ptr*wt_old - change_state = ptr*dwt - new_state = init_state+change_state - if (wt_new /= 0._r8) then - ptr = new_state/wt_new - dwt_ptr1 = dwt_ptr1 + change_state - else - ptr = 0._r8 - dwt_ptr1 = dwt_ptr1 - init_state - end if - - ! cpool - ptr => cnveg_carbonstate_inst%cpool_patch(p) - init_state = ptr*wt_old - change_state = ptr*dwt - new_state = init_state+change_state - if (wt_new /= 0._r8) then - ptr = new_state/wt_new - dwt_ptr1 = dwt_ptr1 + change_state - else - ptr = 0._r8 - dwt_ptr1 = dwt_ptr1 - init_state - end if - - ! pft_ctrunc - ptr => cnveg_carbonstate_inst%ctrunc_patch(p) - init_state = ptr*wt_old - change_state = ptr*dwt - new_state = init_state+change_state - if (wt_new /= 0._r8) then - ptr = new_state/wt_new - dwt_ptr1 = dwt_ptr1 + change_state - else - ptr = 0._r8 - dwt_ptr1 = dwt_ptr1 - init_state - end if - endif - - - !--------------- - ! N state update - !--------------- - - ! set pointers to the conversion and product pool fluxes for this patch - ! dwt_ptr0 is reserved for local assignment to dwt_xxx_to_litter fluxes - dwt_ptr1 => conv_nflux(p) - - ! leafn - ptr => cnveg_nitrogenstate_inst%leafn_patch(p) - init_state = ptr*wt_old - change_state = ptr*dwt - new_state = init_state+change_state - if (wt_new /= 0._r8) then - ptr = new_state/wt_new - dwt_ptr1 = dwt_ptr1 + change_state - else - ptr = 0._r8 - dwt_ptr1 = dwt_ptr1 - init_state - end if - - ! leafn_storage - ptr => cnveg_nitrogenstate_inst%leafn_storage_patch(p) - init_state = ptr*wt_old - change_state = ptr*dwt - new_state = init_state+change_state - if (wt_new /= 0._r8) then - ptr = new_state/wt_new - dwt_ptr1 = dwt_ptr1 + change_state - else - ptr = 0._r8 - dwt_ptr1 = dwt_ptr1 - init_state - end if - - ! leafn_xfer - ptr => cnveg_nitrogenstate_inst%leafn_xfer_patch(p) - init_state = ptr*wt_old - change_state = ptr*dwt - new_state = init_state+change_state - if (wt_new /= 0._r8) then - ptr = new_state/wt_new - dwt_ptr1 = dwt_ptr1 + change_state - else - ptr = 0._r8 - dwt_ptr1 = dwt_ptr1 - init_state - end if - - ! frootn - ptr => cnveg_nitrogenstate_inst%frootn_patch(p) - dwt_ptr0 => dwt_frootn_to_litter(p) - init_state = ptr*wt_old - change_state = ptr*dwt - new_state = init_state+change_state - if (wt_new /= 0._r8) then - ptr = new_state/wt_new - dwt_ptr0 = dwt_ptr0 - change_state - else - ptr = 0._r8 - dwt_ptr0 = dwt_ptr0 + init_state - end if - - ! frootn_storage - ptr => cnveg_nitrogenstate_inst%frootn_storage_patch(p) - init_state = ptr*wt_old - change_state = ptr*dwt - new_state = init_state+change_state - if (wt_new /= 0._r8) then - ptr = new_state/wt_new - dwt_ptr1 = dwt_ptr1 + change_state - else - ptr = 0._r8 - dwt_ptr1 = dwt_ptr1 - init_state - end if - - ! frootn_xfer - ptr => cnveg_nitrogenstate_inst%frootn_xfer_patch(p) - init_state = ptr*wt_old - change_state = ptr*dwt - new_state = init_state+change_state - if (wt_new /= 0._r8) then - ptr = new_state/wt_new - dwt_ptr1 = dwt_ptr1 + change_state - else - ptr = 0._r8 - dwt_ptr1 = dwt_ptr1 - init_state - end if - - ! livestemn - ptr => cnveg_nitrogenstate_inst%livestemn_patch(p) - init_state = ptr*wt_old - change_state = ptr*dwt - new_state = init_state+change_state - if (wt_new /= 0._r8) then - ptr = new_state/wt_new - dwt_ptr1 = dwt_ptr1 + change_state - else - ptr = 0._r8 - dwt_ptr1 = dwt_ptr1 - init_state - end if - - ! livestemn_storage - ptr => cnveg_nitrogenstate_inst%livestemn_storage_patch(p) - init_state = ptr*wt_old - change_state = ptr*dwt - new_state = init_state+change_state - if (wt_new /= 0._r8) then - ptr = new_state/wt_new - dwt_ptr1 = dwt_ptr1 + change_state - else - ptr = 0._r8 - dwt_ptr1 = dwt_ptr1 - init_state - end if - - ! livestemn_xfer - ptr => cnveg_nitrogenstate_inst%livestemn_xfer_patch(p) - init_state = ptr*wt_old - change_state = ptr*dwt - new_state = init_state+change_state - if (wt_new /= 0._r8) then - ptr = new_state/wt_new - dwt_ptr1 = dwt_ptr1 + change_state - else - ptr = 0._r8 - dwt_ptr1 = dwt_ptr1 - init_state - end if - - ! deadstemn - ptr => cnveg_nitrogenstate_inst%deadstemn_patch(p) - init_state = ptr*wt_old - change_state = ptr*dwt - new_state = init_state+change_state - if (wt_new /= 0._r8) then - ptr = new_state/wt_new - dwt_ptr1 = dwt_ptr1 + change_state * pftcon%pconv(patch%itype(p)) - product_nflux(p) = product_nflux(p) + & - change_state * (1._r8 - pftcon%pconv(patch%itype(p))) - else - ptr = 0._r8 - dwt_ptr1 = dwt_ptr1 - init_state * pftcon%pconv(patch%itype(p)) - product_nflux(p) = product_nflux(p) - & - init_state * (1._r8 - pftcon%pconv(patch%itype(p))) - end if - - ! deadstemn_storage - ptr => cnveg_nitrogenstate_inst%deadstemn_storage_patch(p) - init_state = ptr*wt_old - change_state = ptr*dwt - new_state = init_state+change_state - if (wt_new /= 0._r8) then - ptr = new_state/wt_new - dwt_ptr1 = dwt_ptr1 + change_state - else - ptr = 0._r8 - dwt_ptr1 = dwt_ptr1 - init_state - end if - - ! deadstemn_xfer - ptr => cnveg_nitrogenstate_inst%deadstemn_xfer_patch(p) - init_state = ptr*wt_old - change_state = ptr*dwt - new_state = init_state+change_state - if (wt_new /= 0._r8) then - ptr = new_state/wt_new - dwt_ptr1 = dwt_ptr1 + change_state - else - ptr = 0._r8 - dwt_ptr1 = dwt_ptr1 - init_state - end if - - ! livecrootn - ptr => cnveg_nitrogenstate_inst%livecrootn_patch(p) - dwt_ptr0 => dwt_livecrootn_to_litter(p) - init_state = ptr*wt_old - change_state = ptr*dwt - new_state = init_state+change_state - if (wt_new /= 0._r8) then - ptr = new_state/wt_new - dwt_ptr0 = dwt_ptr0 - change_state - else - ptr = 0._r8 - dwt_ptr0 = dwt_ptr0 + init_state - end if - - ! livecrootn_storage - ptr => cnveg_nitrogenstate_inst%livecrootn_storage_patch(p) - init_state = ptr*wt_old - change_state = ptr*dwt - new_state = init_state+change_state - if (wt_new /= 0._r8) then - ptr = new_state/wt_new - dwt_ptr1 = dwt_ptr1 + change_state - else - ptr = 0._r8 - dwt_ptr1 = dwt_ptr1 - init_state - end if - - ! livecrootn_xfer - ptr => cnveg_nitrogenstate_inst%livecrootn_xfer_patch(p) - init_state = ptr*wt_old - change_state = ptr*dwt - new_state = init_state+change_state - if (wt_new /= 0._r8) then - ptr = new_state/wt_new - dwt_ptr1 = dwt_ptr1 + change_state - else - ptr = 0._r8 - dwt_ptr1 = dwt_ptr1 - init_state - end if - - ! deadcrootn - ptr => cnveg_nitrogenstate_inst%deadcrootn_patch(p) - dwt_ptr0 => dwt_deadcrootn_to_litter(p) - init_state = ptr*wt_old - change_state = ptr*dwt - new_state = init_state+change_state - if (wt_new /= 0._r8) then - ptr = new_state/wt_new - dwt_ptr0 = dwt_ptr0 - change_state - else - ptr = 0._r8 - dwt_ptr0 = dwt_ptr0 + init_state - end if - - ! deadcrootn_storage - ptr => cnveg_nitrogenstate_inst%deadcrootn_storage_patch(p) - init_state = ptr*wt_old - change_state = ptr*dwt - new_state = init_state+change_state - if (wt_new /= 0._r8) then - ptr = new_state/wt_new - dwt_ptr1 = dwt_ptr1 + change_state - else - ptr = 0._r8 - dwt_ptr1 = dwt_ptr1 - init_state - end if - - ! deadcrootn_xfer - ptr => cnveg_nitrogenstate_inst%deadcrootn_xfer_patch(p) - init_state = ptr*wt_old - change_state = ptr*dwt - new_state = init_state+change_state - if (wt_new /= 0._r8) then - ptr = new_state/wt_new - dwt_ptr1 = dwt_ptr1 + change_state - else - ptr = 0._r8 - dwt_ptr1 = dwt_ptr1 - init_state - end if - - ! retransn - ptr => cnveg_nitrogenstate_inst%retransn_patch(p) - init_state = ptr*wt_old - change_state = ptr*dwt - new_state = init_state+change_state - if (wt_new /= 0._r8) then - ptr = new_state/wt_new - dwt_ptr1 = dwt_ptr1 + change_state - else - ptr = 0._r8 - dwt_ptr1 = dwt_ptr1 - init_state - end if - - ! npool - ptr => cnveg_nitrogenstate_inst%npool_patch(p) - init_state = ptr*wt_old - change_state = ptr*dwt - new_state = init_state+change_state - if (wt_new /= 0._r8) then - ptr = new_state/wt_new - dwt_ptr1 = dwt_ptr1 + change_state - else - ptr = 0._r8 - dwt_ptr1 = dwt_ptr1 - init_state - end if - - ! pft_ntrunc - ptr => cnveg_nitrogenstate_inst%ntrunc_patch(p) - init_state = ptr*wt_old - change_state = ptr*dwt - new_state = init_state+change_state - if (wt_new /= 0._r8) then - ptr = new_state/wt_new - dwt_ptr1 = dwt_ptr1 + change_state - else - ptr = 0._r8 - dwt_ptr1 = dwt_ptr1 - init_state - end if - - end if ! weight decreasing - end if ! is soil - end do ! patch loop - ! calculate column-level seeding fluxes do pi = 1,max_patch_per_col do c = bounds%begc, bounds%endc @@ -2159,7 +653,7 @@ subroutine dyn_cnbal_patch(bounds, prior_weights, & ! First store temporary values that are needed elsewhere. Note that the temporary ! conv_cflux, product_cflux (and similar) fluxes are accumulated as negative values, ! but the values stored in carbonflux_inst and nitrogenflux_inst are positive values. - do p = bounds%begp, bounds%endp + do p = begp, endp cnveg_carbonflux_inst%dwt_productc_gain_patch(p) = -product_cflux(p)/dt if (use_c13) then c13_cnveg_carbonflux_inst%dwt_productc_gain_patch(p) = -product_c13flux(p)/dt diff --git a/components/clm/src/biogeochem/test/CMakeLists.txt b/components/clm/src/biogeochem/test/CMakeLists.txt index f1c6014184..15d41be10a 100644 --- a/components/clm/src/biogeochem/test/CMakeLists.txt +++ b/components/clm/src/biogeochem/test/CMakeLists.txt @@ -1 +1,2 @@ add_subdirectory(Species_test) +add_subdirectory(CNVegComputeSeed_test) \ No newline at end of file diff --git a/components/clm/src/biogeochem/test/CNVegComputeSeed_test/CMakeLists.txt b/components/clm/src/biogeochem/test/CNVegComputeSeed_test/CMakeLists.txt new file mode 100644 index 0000000000..35173a6dc3 --- /dev/null +++ b/components/clm/src/biogeochem/test/CNVegComputeSeed_test/CMakeLists.txt @@ -0,0 +1,7 @@ +set (pfunit_sources + test_ComputeSeedAmounts.pf) + +create_pFUnit_test(CNVegComputeSeed test_CNVegComputeSeed_exe + "${pfunit_sources}" "") + +target_link_libraries(test_CNVegComputeSeed_exe clm csm_share esmf_wrf_timemgr) \ No newline at end of file diff --git a/components/clm/src/biogeochem/test/CNVegComputeSeed_test/test_ComputeSeedAmounts.pf b/components/clm/src/biogeochem/test/CNVegComputeSeed_test/test_ComputeSeedAmounts.pf new file mode 100644 index 0000000000..f5e8aeff9b --- /dev/null +++ b/components/clm/src/biogeochem/test/CNVegComputeSeed_test/test_ComputeSeedAmounts.pf @@ -0,0 +1,361 @@ +module test_ComputeSeedAmounts + + ! Tests of CNVegComputeSeedMod: ComputeSeedAmounts + + use pfunit_mod + use CNVegComputeSeedMod + use shr_kind_mod , only : r8 => shr_kind_r8 + use unittestSubgridMod + use unittestSimpleSubgridSetupsMod + use unittestFilterBuilderMod + use pftconMod + use CNSpeciesMod + use PatchType + use clm_varcon, only : c3_r2, c4_r2, c14ratio + + implicit none + + @TestCase + type, extends(TestCase) :: TestComputeSeed + ! filter + integer :: numf + integer, allocatable :: filter(:) + contains + procedure :: setUp + procedure :: tearDown + procedure :: do_ComputeSeedAmounts + end type TestComputeSeed + + real(r8), parameter :: tol = 1.e-13_r8 + + ! patch of interest + integer, parameter :: POI = begp + 1 + + ! PFT type in the patch of interest + integer, parameter :: POI_TYPE = 7 + + real(r8), parameter :: LEAFC_SEED = 12._r8 + real(r8), parameter :: DEADSTEMC_SEED = 13._r8 + + ! leaf contents in the patch of interest + real(r8), parameter :: LEAF_POI = 1._r8 + real(r8), parameter :: LEAF_STORAGE_POI = 2._r8 + real(r8), parameter :: LEAF_XFER_POI = 3._r8 + real(r8), parameter :: LEAF_TOTAL_POI = LEAF_POI + LEAF_STORAGE_POI + LEAF_XFER_POI + +contains + + subroutine setUp(this) + class(TestComputeSeed), intent(inout) :: this + integer :: pft_types(begp:begp+2) + + ! Tests use a grid with a single gridcell containing 3 vegetated patches, with a + ! filter active over all patches + pft_types(:) = 1 + pft_types(POI) = POI_TYPE + call setup_n_veg_patches(pwtcol = [0.25_r8, 0.5_r8, 0.25_r8], pft_types = pft_types) + call filter_from_range(bounds%begp, bounds%endp, this%numf, this%filter) + + ! Set relevant pftcon values to defaults; these should be overridden by individual + ! tests where they matter + call pftcon%InitForTesting() + pftcon%evergreen(:) = 0 + pftcon%woody(:) = 1 + pftcon%c3psn(:) = 1 + pftcon%leafcn(:) = 1._r8 + pftcon%deadwdcn(:) = 1._r8 + + end subroutine setUp + + subroutine tearDown(this) + class(TestComputeSeed), intent(inout) :: this + + call unittest_subgrid_teardown() + call pftcon%Clean() + end subroutine tearDown + + subroutine do_ComputeSeedAmounts(this, species, & + ignore_current_state, & + seed_leaf, seed_leaf_storage, seed_leaf_xfer, seed_deadstem) + ! Wraps the call to ComputeSeedAmounts + ! + ! Returns values for patch POI + class(TestComputeSeed), intent(inout) :: this + integer, intent(in) :: species + + ! if not provided, ignore_current_state is assumed to be false + logical, intent(in), optional :: ignore_current_state + + ! The following outputs are all for patch POI + real(r8), intent(out), optional :: seed_leaf + real(r8), intent(out), optional :: seed_leaf_storage + real(r8), intent(out), optional :: seed_leaf_xfer + real(r8), intent(out), optional :: seed_deadstem + + real(r8) :: leaf_patch(bounds%begp:bounds%endp) + real(r8) :: leaf_storage_patch(bounds%begp:bounds%endp) + real(r8) :: leaf_xfer_patch(bounds%begp:bounds%endp) + logical :: compute_here_patch(bounds%begp:bounds%endp) + logical :: ignore_current_state_patch(bounds%begp:bounds%endp) + real(r8) :: seed_leaf_patch(bounds%begp:bounds%endp) + real(r8) :: seed_leaf_storage_patch(bounds%begp:bounds%endp) + real(r8) :: seed_leaf_xfer_patch(bounds%begp:bounds%endp) + real(r8) :: seed_deadstem_patch(bounds%begp:bounds%endp) + + leaf_patch(:) = 0._r8 + leaf_patch(POI) = LEAF_POI + leaf_storage_patch(:) = 0._r8 + leaf_storage_patch(POI) = LEAF_STORAGE_POI + leaf_xfer_patch(:) = 0._r8 + leaf_xfer_patch(POI) = LEAF_XFER_POI + + compute_here_patch(:) = .true. + ignore_current_state_patch(:) = .false. + if (present(ignore_current_state)) then + ignore_current_state_patch(POI) = ignore_current_state + end if + + call ComputeSeedAmounts(bounds, & + this%numf, this%filter, & + species = species, & + leafc_seed = LEAFC_SEED, & + deadstemc_seed = DEADSTEMC_SEED, & + leaf_patch = leaf_patch, & + leaf_storage_patch = leaf_storage_patch, & + leaf_xfer_patch = leaf_xfer_patch, & + compute_here_patch = compute_here_patch, & + ignore_current_state_patch = ignore_current_state_patch, & + seed_leaf_patch = seed_leaf_patch, & + seed_leaf_storage_patch = seed_leaf_storage_patch, & + seed_leaf_xfer_patch = seed_leaf_xfer_patch, & + seed_deadstem_patch = seed_deadstem_patch) + + if (present(seed_leaf)) then + seed_leaf = seed_leaf_patch(POI) + end if + if (present(seed_leaf_storage)) then + seed_leaf_storage = seed_leaf_storage_patch(POI) + end if + if (present(seed_leaf_xfer)) then + seed_leaf_xfer = seed_leaf_xfer_patch(POI) + end if + if (present(seed_deadstem)) then + seed_deadstem = seed_deadstem_patch(POI) + end if + + end subroutine do_ComputeSeedAmounts + + @Test + subroutine c12_leaf(this) + class(TestComputeSeed), intent(inout) :: this + real(r8) :: seed_leaf + real(r8) :: expected + + call this%do_ComputeSeedAmounts( & + species = CN_SPECIES_C12, & + seed_leaf = seed_leaf) + + expected = LEAFC_SEED * LEAF_POI / LEAF_TOTAL_POI + @assertEqual(expected, seed_leaf, tolerance=tol) + end subroutine c12_leaf + + @Test + subroutine c12_leaf_storage(this) + class(TestComputeSeed), intent(inout) :: this + real(r8) :: seed_leaf_storage + real(r8) :: expected + + call this%do_ComputeSeedAmounts( & + species = CN_SPECIES_C12, & + seed_leaf_storage = seed_leaf_storage) + + expected = LEAFC_SEED * LEAF_STORAGE_POI / LEAF_TOTAL_POI + @assertEqual(expected, seed_leaf_storage, tolerance=tol) + end subroutine c12_leaf_storage + + @Test + subroutine c12_leaf_xfer(this) + class(TestComputeSeed), intent(inout) :: this + real(r8) :: seed_leaf_xfer + real(r8) :: expected + + call this%do_ComputeSeedAmounts( & + species = CN_SPECIES_C12, & + seed_leaf_xfer = seed_leaf_xfer) + + expected = LEAFC_SEED * LEAF_XFER_POI / LEAF_TOTAL_POI + @assertEqual(expected, seed_leaf_xfer, tolerance=tol) + end subroutine c12_leaf_xfer + + @Test + subroutine c12_deadstem_woody(this) + class(TestComputeSeed), intent(inout) :: this + real(r8) :: seed_deadstem + real(r8) :: expected + + pftcon%woody(POI_TYPE) = 1 + + call this%do_ComputeSeedAmounts( & + species = CN_SPECIES_C12, & + seed_deadstem = seed_deadstem) + + expected = DEADSTEMC_SEED + @assertEqual(expected, seed_deadstem, tolerance=tol) + end subroutine c12_deadstem_woody + + @Test + subroutine c12_deadstem_nonwoody(this) + class(TestComputeSeed), intent(inout) :: this + real(r8) :: seed_deadstem + + pftcon%woody(POI_TYPE) = 0 + + call this%do_ComputeSeedAmounts( & + species = CN_SPECIES_C12, & + seed_deadstem = seed_deadstem) + + @assertEqual(0._r8, seed_deadstem, tolerance=tol) + end subroutine c12_deadstem_nonwoody + + @Test + subroutine c12_leaf_ignoreCurrentState_evergreen(this) + ! When ignoring the current state, for evergreen, all leaf seed amount should be put + ! in the leaf itself + class(TestComputeSeed), intent(inout) :: this + real(r8) :: seed_leaf + real(r8) :: expected + + pftcon%evergreen(POI_TYPE) = 1 + + call this%do_ComputeSeedAmounts( & + species = CN_SPECIES_C12, & + ignore_current_state = .true., & + seed_leaf = seed_leaf) + + expected = LEAFC_SEED + @assertEqual(expected, seed_leaf, tolerance=tol) + end subroutine c12_leaf_ignoreCurrentState_evergreen + + @Test + subroutine c12_leaf_storage_ignoreCurrentState_nonEvergreen(this) + ! When ignoring the current state, for evergreen, all leaf seed amount should be put + ! in leaf storage + class(TestComputeSeed), intent(inout) :: this + real(r8) :: seed_leaf_storage + real(r8) :: expected + + pftcon%evergreen(POI_TYPE) = 0 + + call this%do_ComputeSeedAmounts( & + species = CN_SPECIES_C12, & + ignore_current_state = .true., & + seed_leaf_storage = seed_leaf_storage) + + expected = LEAFC_SEED + @assertEqual(expected, seed_leaf_storage, tolerance=tol) + end subroutine c12_leaf_storage_ignoreCurrentState_nonEvergreen + + @Test + subroutine c13_deadstem_woody_c3(this) + class(TestComputeSeed), intent(inout) :: this + real(r8) :: seed_deadstem + real(r8) :: expected + + pftcon%woody(POI_TYPE) = 1 + pftcon%c3psn(POI_TYPE) = 1 + + call this%do_ComputeSeedAmounts( & + species = CN_SPECIES_C13, & + seed_deadstem = seed_deadstem) + + expected = DEADSTEMC_SEED * c3_r2 + @assertEqual(expected, seed_deadstem, tolerance=tol) + end subroutine c13_deadstem_woody_c3 + + @Test + subroutine c13_deadstem_woody_c4(this) + class(TestComputeSeed), intent(inout) :: this + real(r8) :: seed_deadstem + real(r8) :: expected + + pftcon%woody(POI_TYPE) = 1 + pftcon%c3psn(POI_TYPE) = 0 + + call this%do_ComputeSeedAmounts( & + species = CN_SPECIES_C13, & + seed_deadstem = seed_deadstem) + + expected = DEADSTEMC_SEED * c4_r2 + @assertEqual(expected, seed_deadstem, tolerance=tol) + end subroutine c13_deadstem_woody_c4 + + @Test + subroutine c14_deadstem_woody(this) + class(TestComputeSeed), intent(inout) :: this + real(r8) :: seed_deadstem + real(r8) :: expected + + pftcon%woody(POI_TYPE) = 1 + + call this%do_ComputeSeedAmounts( & + species = CN_SPECIES_C14, & + seed_deadstem = seed_deadstem) + + expected = DEADSTEMC_SEED * c14ratio + @assertEqual(expected, seed_deadstem, tolerance=tol) + end subroutine c14_deadstem_woody + + @Test + subroutine n_leaf(this) + class(TestComputeSeed), intent(inout) :: this + real(r8), parameter :: leafcn = 10._r8 + real(r8) :: seed_leaf + real(r8) :: expected + + pftcon%leafcn(POI_TYPE) = leafcn + + call this%do_ComputeSeedAmounts( & + species = CN_SPECIES_N, & + seed_leaf = seed_leaf) + + expected = (LEAFC_SEED / leafcn) * (LEAF_POI / LEAF_TOTAL_POI) + @assertEqual(expected, seed_leaf, tolerance=tol) + end subroutine n_leaf + + @Test + subroutine n_deadstem_woody(this) + class(TestComputeSeed), intent(inout) :: this + real(r8), parameter :: deadwdcn = 10._r8 + real(r8) :: seed_deadstem + real(r8) :: expected + + pftcon%deadwdcn(POI_TYPE) = deadwdcn + + call this%do_ComputeSeedAmounts( & + species = CN_SPECIES_N, & + seed_deadstem = seed_deadstem) + + expected = DEADSTEMC_SEED / deadwdcn + @assertEqual(expected, seed_deadstem, tolerance=tol) + end subroutine n_deadstem_woody + + @Test + subroutine nonveg(this) + class(TestComputeSeed), intent(inout) :: this + real(r8) :: seed_leaf, seed_leaf_storage, seed_leaf_xfer, seed_deadstem + + patch%itype(POI) = noveg + + call this%do_ComputeSeedAmounts( & + species = CN_SPECIES_C12, & + seed_leaf = seed_leaf, seed_leaf_storage = seed_leaf_storage, & + seed_leaf_xfer = seed_leaf_xfer, seed_deadstem = seed_deadstem) + + @assertEqual(0._r8, seed_leaf) + @assertEqual(0._r8, seed_leaf_storage) + @assertEqual(0._r8, seed_leaf_xfer) + @assertEqual(0._r8, seed_deadstem) + end subroutine nonveg + +end module test_ComputeSeedAmounts + diff --git a/components/clm/src/dyn_subgrid/CMakeLists.txt b/components/clm/src/dyn_subgrid/CMakeLists.txt index d7e7a390e0..41ed645376 100644 --- a/components/clm/src/dyn_subgrid/CMakeLists.txt +++ b/components/clm/src/dyn_subgrid/CMakeLists.txt @@ -16,6 +16,7 @@ list(APPEND clm_sources "${clm_genf90_sources}") list(APPEND clm_sources dynColumnStateUpdaterMod.F90 dynColumnTemplateMod.F90 + dynPatchStateUpdaterMod.F90 dynPriorWeightsMod.F90 dynTimeInfoMod.F90 dynLandunitAreaMod.F90 diff --git a/components/clm/src/dyn_subgrid/dynColumnStateUpdaterMod.F90 b/components/clm/src/dyn_subgrid/dynColumnStateUpdaterMod.F90 index ccc4c12ab4..c05f2362b0 100644 --- a/components/clm/src/dyn_subgrid/dynColumnStateUpdaterMod.F90 +++ b/components/clm/src/dyn_subgrid/dynColumnStateUpdaterMod.F90 @@ -222,13 +222,12 @@ subroutine set_new_weights(this, bounds) type(bounds_type) , intent(in) :: bounds ! ! !LOCAL VARIABLES: - integer :: c, g + integer :: c character(len=*), parameter :: subname = 'set_new_weights' !----------------------------------------------------------------------- do c = bounds%begc, bounds%endc - g = col%gridcell(c) this%cwtgcell_new(c) = col%wtgcell(c) this%area_gained_col(c) = this%cwtgcell_new(c) - this%cwtgcell_old(c) end do diff --git a/components/clm/src/dyn_subgrid/dynPatchStateUpdaterMod.F90 b/components/clm/src/dyn_subgrid/dynPatchStateUpdaterMod.F90 new file mode 100644 index 0000000000..f85067a8c7 --- /dev/null +++ b/components/clm/src/dyn_subgrid/dynPatchStateUpdaterMod.F90 @@ -0,0 +1,411 @@ +module dynPatchStateUpdaterMod + + !--------------------------------------------------------------------------- + ! + ! !DESCRIPTION: + ! Class for adjusting patch-level (aboveground) state variables due to transient patch + ! areas. + ! + ! In each time step, the object should be set up with: + ! + ! - call patch_state_updater%set_old_weights (before dyn subgrid weight updates) + ! + ! - call patch_state_updater%set_new_weights (after dyn subgrid weight updates) + ! + ! Then it can be used to update each state variable with a call to: + ! + ! - call patch_state_updater%update_patch_state + ! + ! !USES: +#include "shr_assert.h" + use shr_kind_mod , only : r8 => shr_kind_r8 + use shr_infnan_mod , only : nan => shr_infnan_nan, assignment(=) + use shr_log_mod , only : errMsg => shr_log_errMsg + use decompMod , only : bounds_type, BOUNDS_LEVEL_PROC + use PatchType , only : patch + use clm_varpar , only : mxpft + use abortutils , only : endrun + ! + implicit none + private + ! + ! !PUBLIC TYPES: + public :: patch_state_updater_type + + type patch_state_updater_type + private + real(r8), allocatable :: pwtcol_old(:) ! old patch weights on the column + real(r8), allocatable :: pwtcol_new(:) ! new patch weights on the column + + ! (pwtcol_new - pwtcol_old) from last call to set_new_weights + real(r8), allocatable :: dwt(:) + + ! (pwtcol_old / pwtcol_new) from last call to set_new_weights; only valid for + ! growing patches + real(r8), allocatable :: growing_old_fraction(:) + + ! (dwt / pwtcol_new) from last call to set_new_weights; only valid for growing + ! patches + real(r8), allocatable :: growing_new_fraction(:) + + contains + ! Public routines + procedure, public :: set_old_weights ! set weights before dyn subgrid updates + procedure, public :: set_new_weights ! set weights after dyn subgrid updates + + ! Update a patch-level state variable and compute associated fluxes based on changing + ! patch areas + procedure, public :: update_patch_state + + ! Update a patch-level state variable and compute associated fluxes based on + ! changing patch areas, with flux out partitioned into two fluxes. Partitioning is + ! based on pft type. + procedure, public :: update_patch_state_partition_flux_by_type + + ! returns a patch-level logical array that is true wherever the patch weight was zero + ! prior to weight updates + procedure, public :: old_weight_was_zero + + ! returns a patch-level logical array that is true wherever the patch grew in this + ! time step + procedure, public :: patch_grew + + ! returns a patch-level logical array that is true wherever a patch newly has + ! non-zero weight in this time step + procedure, public :: patch_initiating + + end type patch_state_updater_type + + interface patch_state_updater_type + module procedure constructor + end interface patch_state_updater_type + +contains + + ! ======================================================================== + ! Constructors + ! ======================================================================== + + !----------------------------------------------------------------------- + function constructor(bounds) result(this) + ! + ! !DESCRIPTION: + ! Initialize a patch_state_updater_type object + ! + ! !USES: + ! + ! !ARGUMENTS: + type(patch_state_updater_type) :: this ! function result + type(bounds_type), intent(in) :: bounds + ! + ! !LOCAL VARIABLES: + integer :: begp, endp + + character(len=*), parameter :: subname = 'constructor' + !----------------------------------------------------------------------- + + SHR_ASSERT(bounds%level == BOUNDS_LEVEL_PROC, errMsg(__FILE__, __LINE__)) + + begp = bounds%begp + endp = bounds%endp + + allocate(this%pwtcol_old(begp:endp)) + this%pwtcol_old(:) = nan + allocate(this%pwtcol_new(begp:endp)) + this%pwtcol_new(:) = nan + allocate(this%dwt(begp:endp)) + this%dwt(:) = nan + allocate(this%growing_old_fraction(begp:endp)) + this%growing_old_fraction(:) = nan + allocate(this%growing_new_fraction(begp:endp)) + this%growing_new_fraction(:) = nan + + end function constructor + + ! ======================================================================== + ! Public methods + ! ======================================================================== + + !----------------------------------------------------------------------- + subroutine set_old_weights(this, bounds) + ! + ! !DESCRIPTION: + ! Set subgrid weights before dyn subgrid updates + ! + ! !USES: + ! + ! !ARGUMENTS: + class(patch_state_updater_type), intent(inout) :: this + type(bounds_type), intent(in) :: bounds + ! + ! !LOCAL VARIABLES: + integer :: p + + character(len=*), parameter :: subname = 'set_old_weights' + !----------------------------------------------------------------------- + + do p = bounds%begp, bounds%endp + this%pwtcol_old(p) = patch%wtcol(p) + end do + + end subroutine set_old_weights + + !----------------------------------------------------------------------- + subroutine set_new_weights(this, bounds) + ! + ! !DESCRIPTION: + ! Set subgrid weights after dyn subgrid updates + ! + ! !USES: + ! + ! !ARGUMENTS: + class(patch_state_updater_type), intent(inout) :: this + type(bounds_type), intent(in) :: bounds + ! + ! !LOCAL VARIABLES: + integer :: p + + character(len=*), parameter :: subname = 'set_new_weights' + !----------------------------------------------------------------------- + + do p = bounds%begp, bounds%endp + this%pwtcol_new(p) = patch%wtcol(p) + this%dwt(p) = this%pwtcol_new(p) - this%pwtcol_old(p) + this%growing_old_fraction(p) = nan + this%growing_new_fraction(p) = nan + if (this%dwt(p) /= 0) then + if (this%dwt(p) > 0) then + this%growing_old_fraction(p) = this%pwtcol_old(p) / this%pwtcol_new(p) + this%growing_new_fraction(p) = this%dwt(p) / this%pwtcol_new(p) + end if + end if + end do + + end subroutine set_new_weights + + !----------------------------------------------------------------------- + subroutine update_patch_state(this, bounds, & + num_filterp_with_inactive, filterp_with_inactive, & + var, flux_out, & + seed, seed_addition) + ! + ! !DESCRIPTION: + ! Update a patch-level state variable and compute associated fluxes based on changing + ! patch areas + ! + ! For growing patches, this subroutine adjusts var. For shrinking patches, this + ! subroutine accumulates flux in flux_out. + ! + ! Changes are only made within the given filter. Note that this filter should include + ! inactive as well as active patches, so that it includes patches that just became + ! inactive. + ! + ! !USES: + ! + ! !ARGUMENTS: + class(patch_state_updater_type), intent(in) :: this + type(bounds_type), intent(in) :: bounds + integer, intent(in) :: num_filterp_with_inactive ! number of points in filterp_with_inactive + integer, intent(in) :: filterp_with_inactive(:) ! patch filter that includes inactive points + real(r8), intent(inout) :: var( bounds%begp: ) ! patch-level state variable + + ! Accumulated flux from shrinking areas. This is optional: you do not need to provide + ! it if you don't need to track the flux out from this state variable. For shrinking + ! areas, this is given as a NEGATIVE quantity. + real(r8), intent(inout), optional :: flux_out( bounds%begp: ) + + ! If provided, this gives some 'seed' amount added to the state in the area into + ! which each growing patch grows. The value is ignored for patches that are either + ! constant or shrinking in area. + real(r8), intent(in), optional :: seed( bounds%begp: ) + + ! If provided, this accumulates the amount of seed added to each patch. This gives + ! seed(p) * dwt(p). This can only be provided if seed is provided. + real(r8), intent(inout), optional :: seed_addition( bounds%begp: ) + ! + ! + ! !LOCAL VARIABLES: + integer :: fp, p + + character(len=*), parameter :: subname = 'update_patch_state' + !----------------------------------------------------------------------- + + SHR_ASSERT_ALL((ubound(var) == (/bounds%endp/)), errMsg(__FILE__, __LINE__)) + + if (present(flux_out)) then + SHR_ASSERT_ALL((ubound(flux_out) == (/bounds%endp/)), errMsg(__FILE__, __LINE__)) + end if + + if (present(seed)) then + SHR_ASSERT_ALL((ubound(seed) == (/bounds%endp/)), errMsg(__FILE__, __LINE__)) + end if + + if (present(seed_addition)) then + if (.not. present(seed)) then + call endrun(subname//' ERROR: seed_addition can only be provided if seed is provided') + end if + SHR_ASSERT_ALL((ubound(seed_addition) == (/bounds%endp/)), errMsg(__FILE__, __LINE__)) + end if + + do fp = 1, num_filterp_with_inactive + p = filterp_with_inactive(fp) + + if (this%dwt(p) > 0._r8) then + var(p) = var(p) * this%growing_old_fraction(p) + if (present(seed)) then + var(p) = var(p) + seed(p) * this%growing_new_fraction(p) + if (present(seed_addition)) then + seed_addition(p) = seed_addition(p) + seed(p) * this%dwt(p) + end if + end if + + else if (this%dwt(p) < 0._r8) then + if (present(flux_out)) then + flux_out(p) = flux_out(p) + var(p) * this%dwt(p) + end if + end if + end do + + end subroutine update_patch_state + + !----------------------------------------------------------------------- + subroutine update_patch_state_partition_flux_by_type(this, bounds, & + num_filterp_with_inactive, filterp_with_inactive, & + flux1_fraction_by_pft_type, & + var, flux1_out, flux2_out, & + seed, seed_addition) + ! + ! !DESCRIPTION: + ! Update a patch-level state variable and compute associated fluxes based on + ! changing patch areas, with flux out partitioned into two fluxes. Partitioning is + ! based on pft type. + ! + ! !USES: + ! + ! !ARGUMENTS: + class(patch_state_updater_type), intent(in) :: this + type(bounds_type), intent(in) :: bounds + integer, intent(in) :: num_filterp_with_inactive ! number of points in filterp_with_inactive + integer, intent(in) :: filterp_with_inactive(:) ! patch filter that includes inactive points + real(r8), intent(in) :: flux1_fraction_by_pft_type( 0: ) ! fraction of flux that goes into flux1_out, indexed by pft type + real(r8), intent(inout) :: var( bounds%begp: ) ! patch-level state variable + real(r8), intent(inout) :: flux1_out( bounds%begp: ) ! accumulated flux1 from shrinking areas + real(r8), intent(inout) :: flux2_out( bounds%begp: ) ! accumulated flux2 from shrinking areas + + ! If provided, this gives some 'seed' amount added to the state in the area into + ! which each growing patch grows. The value is ignored for patches that are either + ! constant or shrinking in area. + real(r8), intent(in), optional :: seed( bounds%begp: ) + + ! If provided, this accumulates the amount of seed added to each patch. This gives + ! seed(p) * dwt(p). This can only be provided if seed is provided. + real(r8), intent(inout), optional :: seed_addition( bounds%begp: ) + ! + ! !LOCAL VARIABLES: + integer :: fp, p + real(r8) :: total_flux_out(bounds%begp:bounds%endp) + real(r8) :: my_flux1_fraction + + character(len=*), parameter :: subname = 'update_patch_state_partition_flux_by_type' + !----------------------------------------------------------------------- + + SHR_ASSERT_ALL((ubound(flux1_fraction_by_pft_type) == (/mxpft/)), errMsg(__FILE__, __LINE__)) + + total_flux_out(bounds%begp:bounds%endp) = 0._r8 + call this%update_patch_state(bounds, & + num_filterp_with_inactive, filterp_with_inactive, & + var, total_flux_out, & + seed, seed_addition) + + do fp = 1, num_filterp_with_inactive + p = filterp_with_inactive(fp) + my_flux1_fraction = flux1_fraction_by_pft_type(patch%itype(p)) + flux1_out(p) = flux1_out(p) + total_flux_out(p) * my_flux1_fraction + flux2_out(p) = flux2_out(p) + total_flux_out(p) * (1._r8 - my_flux1_fraction) + end do + + end subroutine update_patch_state_partition_flux_by_type + + + !----------------------------------------------------------------------- + function old_weight_was_zero(this, bounds) + ! + ! !DESCRIPTION: + ! Returns a patch-level logical array that is true wherever the patch weight was zero + ! prior to weight updates + ! + ! !USES: + ! + ! !ARGUMENTS: + class(patch_state_updater_type), intent(in) :: this + type(bounds_type), intent(in) :: bounds + logical :: old_weight_was_zero(bounds%begp:bounds%endp) ! function result + ! + ! !LOCAL VARIABLES: + integer :: p + + character(len=*), parameter :: subname = 'old_weight_was_zero' + !----------------------------------------------------------------------- + + do p = bounds%begp, bounds%endp + old_weight_was_zero(p) = (this%pwtcol_old(p) == 0._r8) + end do + + end function old_weight_was_zero + + !----------------------------------------------------------------------- + function patch_grew(this, bounds) + ! + ! !DESCRIPTION: + ! Returns a patch-level logical array that is true wherever the patch grew in this + ! time step + ! + ! !USES: + ! + ! !ARGUMENTS: + class(patch_state_updater_type), intent(in) :: this + type(bounds_type), intent(in) :: bounds + logical :: patch_grew(bounds%begp:bounds%endp) ! function result + ! + ! !LOCAL VARIABLES: + integer :: p + + character(len=*), parameter :: subname = 'patch_grew' + !----------------------------------------------------------------------- + + do p = bounds%begp, bounds%endp + patch_grew(p) = (this%dwt(p) > 0._r8) + end do + + end function patch_grew + + !----------------------------------------------------------------------- + function patch_initiating(this, bounds) + ! + ! !DESCRIPTION: + ! Returns a patch-level logical array wherever the patch is initiating - i.e., growing + ! from zero area to non-zero area - in this time step + ! + ! !USES: + ! + ! !ARGUMENTS: + class(patch_state_updater_type), intent(in) :: this + type(bounds_type), intent(in) :: bounds + logical :: patch_initiating(bounds%begp:bounds%endp) ! function result + ! + ! !LOCAL VARIABLES: + integer :: p + + character(len=*), parameter :: subname = 'patch_initiating' + !----------------------------------------------------------------------- + + do p = bounds%begp, bounds%endp + patch_initiating(p) = ( & + this%pwtcol_old(p) == 0._r8 .and. & + this%pwtcol_new(p) > 0._r8) + end do + + end function patch_initiating + + +end module dynPatchStateUpdaterMod diff --git a/components/clm/src/dyn_subgrid/dynSubgridDriverMod.F90 b/components/clm/src/dyn_subgrid/dynSubgridDriverMod.F90 index b434274cda..50efd46d75 100644 --- a/components/clm/src/dyn_subgrid/dynSubgridDriverMod.F90 +++ b/components/clm/src/dyn_subgrid/dynSubgridDriverMod.F90 @@ -13,6 +13,7 @@ module dynSubgridDriverMod use dynSubgridControlMod , only : get_do_transient_pfts, get_do_transient_crops use dynSubgridControlMod , only : get_do_harvest use dynPriorWeightsMod , only : prior_weights_type + use dynPatchStateUpdaterMod , only : patch_state_updater_type use dynColumnStateUpdaterMod , only : column_state_updater_type use UrbanParamsType , only : urbanparams_type use CanopyStateType , only : canopystate_type @@ -31,6 +32,7 @@ module dynSubgridDriverMod use WaterstateType , only : waterstate_type use TemperatureType , only : temperature_type use glc2lndMod , only : glc2lnd_type + use filterMod , only : filter_inactive_and_active ! ! !PUBLIC MEMBER FUNCTIONS: implicit none @@ -44,6 +46,9 @@ module dynSubgridDriverMod ! saved weights from before the subgrid weight updates type(prior_weights_type), target :: prior_weights + ! object used to update patch-level states after subgrid weight updates + type(patch_state_updater_type), target :: patch_state_updater + ! object used to update column-level states after subgrid weight updates type(column_state_updater_type), target :: column_state_updater !--------------------------------------------------------------------------- @@ -92,6 +97,7 @@ subroutine dynSubgrid_init(bounds) SHR_ASSERT(bounds%level == BOUNDS_LEVEL_PROC, subname // ': argument must be PROC-level bounds') prior_weights = prior_weights_type(bounds) + patch_state_updater = patch_state_updater_type(bounds) column_state_updater = column_state_updater_type(bounds) ! Initialize stuff for prescribed transient Patches @@ -182,11 +188,13 @@ subroutine dynSubgrid_driver(bounds_proc, ! These are used if this is the first step of a cold start type(prior_weights_type), target :: new_weights + type(patch_state_updater_type), target :: patch_state_updater_new_weights type(column_state_updater_type), target :: column_state_updater_new_weights - ! These point to the appropriate prior_weights and column_state_updater instances, - ! depending on whether it's a cold start + ! These point to the appropriate prior_weights, patch_state_updater and + ! column_state_updater instances, depending on whether it's a cold start type(prior_weights_type), pointer :: my_prior_weights + type(patch_state_updater_type), pointer :: my_patch_state_updater type(column_state_updater_type), pointer :: my_column_state_updater character(len=*), parameter :: subname = 'dynSubgrid_driver' @@ -204,6 +212,7 @@ subroutine dynSubgrid_driver(bounds_proc, if (first_step_cold_start) then ! These objects need to be constructed outside a loop over clumps new_weights = prior_weights_type(bounds_proc) + patch_state_updater_new_weights = patch_state_updater_type(bounds_proc) column_state_updater_new_weights = column_state_updater_type(bounds_proc) end if @@ -216,6 +225,7 @@ subroutine dynSubgrid_driver(bounds_proc, waterstate_inst, waterflux_inst, temperature_inst, energyflux_inst) call prior_weights%set_prior_weights(bounds_clump) + call patch_state_updater%set_old_weights(bounds_clump) call column_state_updater%set_old_weights(bounds_clump) end do !$OMP END PARALLEL DO @@ -275,6 +285,7 @@ subroutine dynSubgrid_driver(bounds_proc, ! Here: filters are re-made call reweight_wrapup(bounds_clump, glc_behavior) + call patch_state_updater%set_new_weights(bounds_clump) call column_state_updater%set_new_weights(bounds_clump) call set_subgrid_diagnostic_fields(bounds_clump) @@ -291,12 +302,16 @@ subroutine dynSubgrid_driver(bounds_proc, ! object that say that there were no weight updates in this time step - i.e., ! that the old weights are the same as the new weights. call new_weights%set_prior_weights(bounds_clump) + call patch_state_updater_new_weights%set_old_weights(bounds_clump) + call patch_state_updater_new_weights%set_new_weights(bounds_clump) call column_state_updater_new_weights%set_old_weights(bounds_clump) call column_state_updater_new_weights%set_new_weights(bounds_clump) my_prior_weights => new_weights + my_patch_state_updater => patch_state_updater_new_weights my_column_state_updater => column_state_updater_new_weights else my_prior_weights => prior_weights + my_patch_state_updater => patch_state_updater my_column_state_updater => column_state_updater end if @@ -306,7 +321,8 @@ subroutine dynSubgrid_driver(bounds_proc, if (use_cn) then call bgc_vegetation_inst%DynamicAreaConservation(bounds_clump, & - my_prior_weights, my_column_state_updater, & + filter_inactive_and_active(nc)%num_soilp, filter_inactive_and_active(nc)%soilp, & + my_prior_weights, my_patch_state_updater, my_column_state_updater, & canopystate_inst, photosyns_inst, & soilbiogeochem_carbonflux_inst, soilbiogeochem_carbonstate_inst, & c13_soilbiogeochem_carbonstate_inst, c14_soilbiogeochem_carbonstate_inst, & diff --git a/components/clm/src/dyn_subgrid/test/CMakeLists.txt b/components/clm/src/dyn_subgrid/test/CMakeLists.txt index 22d94bba55..2cb9be01bf 100644 --- a/components/clm/src/dyn_subgrid/test/CMakeLists.txt +++ b/components/clm/src/dyn_subgrid/test/CMakeLists.txt @@ -1,5 +1,6 @@ add_subdirectory(dynColumnTemplate_test) add_subdirectory(dynColumnStateUpdater_test) +add_subdirectory(dynPatchStateUpdater_test) add_subdirectory(dynInitColumns_test) add_subdirectory(dynLandunitArea_test) add_subdirectory(dynVar_test) diff --git a/components/clm/src/dyn_subgrid/test/dynPatchStateUpdater_test/CMakeLists.txt b/components/clm/src/dyn_subgrid/test/dynPatchStateUpdater_test/CMakeLists.txt new file mode 100644 index 0000000000..932fa98ea2 --- /dev/null +++ b/components/clm/src/dyn_subgrid/test/dynPatchStateUpdater_test/CMakeLists.txt @@ -0,0 +1,4 @@ +create_pFUnit_test(PatchStateUpdater test_PatchStateUpdater_exe + "test_patch_state_updater.pf" "") + +target_link_libraries(test_PatchStateUpdater_exe clm csm_share) \ No newline at end of file diff --git a/components/clm/src/dyn_subgrid/test/dynPatchStateUpdater_test/test_patch_state_updater.pf b/components/clm/src/dyn_subgrid/test/dynPatchStateUpdater_test/test_patch_state_updater.pf new file mode 100644 index 0000000000..597741fa45 --- /dev/null +++ b/components/clm/src/dyn_subgrid/test/dynPatchStateUpdater_test/test_patch_state_updater.pf @@ -0,0 +1,317 @@ +module test_patch_state_updater + + ! Tests of dynPatchStateUpdaterMod + + use pfunit_mod + use dynPatchStateUpdaterMod + use shr_kind_mod , only : r8 => shr_kind_r8 + use unittestSubgridMod + use unittestSimpleSubgridSetupsMod + use unittestFilterBuilderMod + use PatchType + use subgridWeightsMod, only : compute_higher_order_weights + use clm_varpar, only : mxpft + + implicit none + + @TestCase + type, extends(TestCase) :: TestPSUpdater + ! filter + integer :: numf + integer, allocatable :: filter(:) + + contains + procedure :: setUp + procedure :: tearDown + procedure :: do_all_setup_with_n_vegetated_patches + end type TestPSUpdater + + real(r8), parameter :: tol = 1.e-13_r8 + +contains + + ! ======================================================================== + ! Test helpers + ! ======================================================================== + + subroutine setUp(this) + class(TestPSUpdater), intent(inout) :: this + end subroutine setUp + + subroutine tearDown(this) + class(TestPSUpdater), intent(inout) :: this + end subroutine tearDown + + !----------------------------------------------------------------------- + subroutine do_all_setup_with_n_vegetated_patches(this, ps_updater, & + pwtcol_old, pwtcol_new, pft_types) + ! + ! !DESCRIPTION: + ! Does all setup needed when setting up one grid cell with a single vegetated column + ! containing n patches + ! + ! !ARGUMENTS: + class(TestPSUpdater), intent(inout) :: this + type(patch_state_updater_type), intent(out) :: ps_updater + real(r8), intent(in) :: pwtcol_old(begp:) + real(r8), intent(in) :: pwtcol_new(begp:) + integer, intent(in), optional :: pft_types(:) + ! + ! !LOCAL VARIABLES: + integer :: p + + character(len=*), parameter :: subname = 'do_all_setup_with_n_vegetated_patches' + !----------------------------------------------------------------------- + + call setup_n_veg_patches(pwtcol_old, pft_types) + call filter_from_range(bounds%begp, bounds%endp, this%numf, this%filter) + ps_updater = patch_state_updater_type(bounds) + call ps_updater%set_old_weights(bounds) + + do p = bounds%begp, bounds%endp + patch%wtcol(p) = pwtcol_new(p) + end do + call compute_higher_order_weights(bounds) + + call ps_updater%set_new_weights(bounds) + + end subroutine do_all_setup_with_n_vegetated_patches + + + ! ======================================================================== + ! Actual tests + ! + ! Note: in most tests, there are 3 patches; the 2nd patch is the patch of interest + ! ======================================================================== + + @Test + subroutine noAreaChange(this) + ! no area change => no change in value, flux stays the same + class(TestPSUpdater), intent(inout) :: this + real(r8), parameter :: pwtcol_old(3) = [0.25_r8, 0.5_r8, 0.25_r8] + real(r8), parameter :: pwtcol_new(3) = pwtcol_old + type(patch_state_updater_type) :: ps_updater + real(r8) :: var(3), expected_var(3) + real(r8) :: flux(3), expected_flux(3) + + ! Setup + + call this%do_all_setup_with_n_vegetated_patches(ps_updater, & + pwtcol_old = pwtcol_old, & + pwtcol_new = pwtcol_new) + + var = [2._r8, 3._r8, 4._r8] + expected_var = var + flux = [12._r8, 13._r8, 14._r8] + expected_flux = flux + + ! Exercise + call ps_updater%update_patch_state(bounds, & + this%numf, this%filter, & + var, flux) + + ! Verify + @assertEqual(expected_var, var) + @assertEqual(expected_flux, flux) + end subroutine noAreaChange + + @Test + subroutine areaIncreases(this) + ! if area increases from non-zero, then value is decreased appropriately; there + ! should be no change in flux + class(TestPSUpdater), intent(inout) :: this + ! The second patch is the patch of interest + real(r8), parameter :: pwtcol_old(3) = [0.3_r8, 0.2_r8, 0.5_r8] + real(r8), parameter :: pwtcol_new(3) = [0.2_r8, 0.3_r8, 0.5_r8] + type(patch_state_updater_type) :: ps_updater + real(r8) :: var(3) + real(r8) :: flux(3) + + call this%do_all_setup_with_n_vegetated_patches(ps_updater, & + pwtcol_old = pwtcol_old, & + pwtcol_new = pwtcol_new) + + var = [2._r8, 3._r8, 4._r8] + flux = [12._r8, 13._r8, 14._r8] + + ! Exercise + call ps_updater%update_patch_state(bounds, & + this%numf, this%filter, & + var, flux) + + ! Verify + @assertEqual(2._r8, var(2)) + ! same as starting flux: + @assertEqual(13._r8, flux(2), tolerance=tol) + end subroutine areaIncreases + + @Test + subroutine areaIncreasesFromZero(this) + ! if area increases from zero, var should be set to 0 + class(TestPSUpdater), intent(inout) :: this + real(r8), parameter :: pwtcol_old(3) = [0.5_r8, 0.0_r8, 0.5_r8] + real(r8), parameter :: pwtcol_new(3) = [0.4_r8, 0.1_r8, 0.5_r8] + type(patch_state_updater_type) :: ps_updater + real(r8) :: var(3), flux(3) + + ! Setup + + call this%do_all_setup_with_n_vegetated_patches(ps_updater, & + pwtcol_old = pwtcol_old, & + pwtcol_new = pwtcol_new) + + var = [2._r8, 3._r8, 4._r8] + flux = [12._r8, 13._r8, 14._r8] + + ! Exercise + call ps_updater%update_patch_state(bounds, & + this%numf, this%filter, & + var, flux) + + ! Verify + @assertEqual(0._r8, var(2)) + end subroutine areaIncreasesFromZero + + @Test + subroutine areaIncreases_withSeed(this) + ! area increases from non-zero with an additional seed amount + class(TestPSUpdater), intent(inout) :: this + ! The second patch is the patch of interest + real(r8), parameter :: pwtcol_old(3) = [0.3_r8, 0.2_r8, 0.5_r8] + real(r8), parameter :: pwtcol_new(3) = [0.2_r8, 0.3_r8, 0.5_r8] + type(patch_state_updater_type) :: ps_updater + real(r8) :: var(3) + real(r8) :: flux(3) + real(r8) :: seed(3) + real(r8) :: seed_addition(3) + real(r8) :: expected_seed_addition + + call this%do_all_setup_with_n_vegetated_patches(ps_updater, & + pwtcol_old = pwtcol_old, & + pwtcol_new = pwtcol_new) + + var = [2._r8, 3._r8, 4._r8] + flux = [12._r8, 13._r8, 14._r8] + seed = [0._r8, 9._r8, 0._r8] + seed_addition = [22._r8, 23._r8, 24._r8] + expected_seed_addition = seed_addition(2) + seed(2) * 0.1_r8 + + ! Exercise + call ps_updater%update_patch_state(bounds, & + this%numf, this%filter, & + var, flux, & + seed = seed, & + seed_addition = seed_addition) + + ! Verify + @assertEqual(5._r8, var(2), tolerance=tol) + @assertEqual(expected_seed_addition, seed_addition(2)) + end subroutine areaIncreases_withSeed + + @Test + subroutine areaDecreases(this) + ! if area decreases, var should stay the same, and there should be a flux out + class(TestPSUpdater), intent(inout) :: this + ! The second patch is the patch of interest + real(r8), parameter :: pwtcol_old(3) = [0.2_r8, 0.3_r8, 0.5_r8] + real(r8), parameter :: pwtcol_new(3) = [0.3_r8, 0.2_r8, 0.5_r8] + type(patch_state_updater_type) :: ps_updater + real(r8) :: var(3) + real(r8) :: flux(3) + + call this%do_all_setup_with_n_vegetated_patches(ps_updater, & + pwtcol_old = pwtcol_old, & + pwtcol_new = pwtcol_new) + + var = [2._r8, 3._r8, 4._r8] + flux = [12._r8, 13._r8, 14._r8] + + ! Exercise + call ps_updater%update_patch_state(bounds, & + this%numf, this%filter, & + var, flux) + + ! Verify + ! flux(2) changes by dwt(2) * var(2) + @assertEqual(13._r8 - 0.3_r8, flux(2), tolerance=tol) + ! same as starting state: + @assertEqual(3._r8, var(2)) + end subroutine areaDecreases + + @Test + subroutine multiplePatches_increase_zero_decrease(this) + ! Test multiple patches: one that increases, one with zero change, and one that + ! decreases. Make sure that new var and flux are correct in all of them + class(TestPSUpdater), intent(inout) :: this + real(r8), parameter :: pwtcol_old(3) = [0.2_r8, 0.5_r8, 0.3_r8] + real(r8), parameter :: pwtcol_new(3) = [0.3_r8, 0.5_r8, 0.2_r8] + type(patch_state_updater_type) :: ps_updater + real(r8) :: var(3), expected_var(3) + real(r8) :: flux(3), expected_flux(3) + + call this%do_all_setup_with_n_vegetated_patches(ps_updater, & + pwtcol_old = pwtcol_old, & + pwtcol_new = pwtcol_new) + + var = [2._r8, 3._r8, 4._r8] + expected_var = var + expected_var(1) = 4._r8 / 3._r8 + flux = [12._r8, 13._r8, 14._r8] + expected_flux = flux + expected_flux(3) = flux(3) - 0.4_r8 + + ! Exercise + call ps_updater%update_patch_state(bounds, & + this%numf, this%filter, & + var, flux) + + ! Verify + @assertEqual(expected_var, var, tolerance=tol) + @assertEqual(expected_flux, flux, tolerance=tol) + end subroutine multiplePatches_increase_zero_decrease + + @Test + subroutine areaDecreases_partitionFluxByType(this) + ! Test decrease in area with flux out partitioned into two pieces based on a variable + ! indexed by pft type + class(TestPSUpdater), intent(inout) :: this + ! The second patch is the patch of interest + real(r8), parameter :: pwtcol_old(3) = [0.2_r8, 0.3_r8, 0.5_r8] + real(r8), parameter :: pwtcol_new(3) = [0.3_r8, 0.2_r8, 0.5_r8] + integer, parameter :: patch2_type = 4 + integer, parameter :: pft_types(3) = [1, patch2_type, 1] + real(r8) :: flux1_fraction(0:mxpft) + real(r8), parameter :: patch2_flux_fraction = 0.6_r8 + type(patch_state_updater_type) :: ps_updater + real(r8) :: var(3) + real(r8) :: expected_total_flux, expected_flux1, expected_flux2 + real(r8) :: flux1(3), flux2(3) + + call this%do_all_setup_with_n_vegetated_patches(ps_updater, & + pwtcol_old = pwtcol_old, & + pwtcol_new = pwtcol_new, & + pft_types = pft_types) + + var = [2._r8, 3._r8, 4._r8] + flux1 = [12._r8, 13._r8, 14._r8] + flux2 = [22._r8, 23._r8, 24._r8] + + flux1_fraction(:) = 0._r8 + flux1_fraction(patch2_type) = patch2_flux_fraction + + ! Exercise + call ps_updater%update_patch_state_partition_flux_by_type(bounds, & + this%numf, this%filter, flux1_fraction, & + var, flux1, flux2) + + ! Verify + ! total flux is dwt(2) * var(2) + expected_total_flux = -0.3_r8 + expected_flux1 = expected_total_flux * patch2_flux_fraction + expected_flux2 = expected_total_flux * (1._r8 - patch2_flux_fraction) + ! For these assertions, we add the expected new flux to the original value of the flux: + @assertEqual(13._r8 + expected_flux1, flux1(2), tolerance=tol) + @assertEqual(23._r8 + expected_flux2, flux2(2), tolerance=tol) + end subroutine areaDecreases_partitionFluxByType + +end module test_patch_state_updater diff --git a/components/clm/src/main/pftconMod.F90 b/components/clm/src/main/pftconMod.F90 index 19b8d52528..d1abf29aaa 100644 --- a/components/clm/src/main/pftconMod.F90 +++ b/components/clm/src/main/pftconMod.F90 @@ -258,6 +258,8 @@ module pftconMod contains procedure, public :: Init + procedure, public :: InitForTesting ! version of Init meant for unit testing + procedure, public :: Clean procedure, private :: InitAllocate procedure, private :: InitRead procedure, private :: set_is_pft_known_to_model ! Set is_pft_known_to_model based on mergetoclmpft @@ -291,6 +293,20 @@ subroutine Init(this) end subroutine Init + !------------------------------------------------------------------------ + subroutine InitForTesting(this) + ! Version of Init meant for unit testing + ! + ! Allocate arrays, but don't try to read from file. + ! + ! Values can then be set by tests as needed + + class(pftcon_type) :: this + + call this%InitAllocate() + + end subroutine InitForTesting + !----------------------------------------------------------------------- subroutine InitAllocate (this) ! @@ -373,7 +389,7 @@ subroutine InitAllocate (this) allocate( this%fr_flab (0:mxpft) ) allocate( this%fr_fcel (0:mxpft) ) allocate( this%fr_flig (0:mxpft) ) - allocate( this%leaf_long (0:mxpft) ) + allocate( this%leaf_long (0:mxpft) ) allocate( this%evergreen (0:mxpft) ) allocate( this%stress_decid (0:mxpft) ) allocate( this%season_decid (0:mxpft) ) @@ -1190,5 +1206,147 @@ subroutine set_num_cfts_known_to_model(this) end subroutine set_num_cfts_known_to_model + !----------------------------------------------------------------------- + subroutine Clean(this) + ! + ! !DESCRIPTION: + ! Deallocate memory + ! + ! !USES: + ! + ! !ARGUMENTS: + class(pftcon_type), intent(inout) :: this + ! + ! !LOCAL VARIABLES: + + character(len=*), parameter :: subname = 'Clean' + !----------------------------------------------------------------------- + + deallocate( this%noveg) + deallocate( this%tree) + + deallocate( this%dleaf) + deallocate( this%c3psn) + deallocate( this%xl) + deallocate( this%rhol) + deallocate( this%rhos) + deallocate( this%taul) + deallocate( this%taus) + deallocate( this%z0mr) + deallocate( this%displar) + deallocate( this%roota_par) + deallocate( this%rootb_par) + deallocate( this%crop) + deallocate( this%mergetoclmpft) + deallocate( this%is_pft_known_to_model) + deallocate( this%irrigated) + deallocate( this%smpso) + deallocate( this%smpsc) + deallocate( this%fnitr) + deallocate( this%slatop) + deallocate( this%dsladlai) + deallocate( this%leafcn) + deallocate( this%flnr) + deallocate( this%woody) + deallocate( this%lflitcn) + deallocate( this%frootcn) + deallocate( this%livewdcn) + deallocate( this%deadwdcn) + deallocate( this%grperc) + deallocate( this%grpnow) + deallocate( this%rootprof_beta) + deallocate( this%graincn) + deallocate( this%mxtmp) + deallocate( this%baset) + deallocate( this%declfact) + deallocate( this%bfact) + deallocate( this%aleaff) + deallocate( this%arootf) + deallocate( this%astemf) + deallocate( this%arooti) + deallocate( this%fleafi) + deallocate( this%allconsl) + deallocate( this%allconss) + deallocate( this%ztopmx) + deallocate( this%laimx) + deallocate( this%gddmin) + deallocate( this%hybgdd) + deallocate( this%lfemerg) + deallocate( this%grnfill) + deallocate( this%mxmat) + deallocate( this%mnNHplantdate) + deallocate( this%mxNHplantdate) + deallocate( this%mnSHplantdate) + deallocate( this%mxSHplantdate) + deallocate( this%planttemp) + deallocate( this%minplanttemp) + deallocate( this%froot_leaf) + deallocate( this%stem_leaf) + deallocate( this%croot_stem) + deallocate( this%flivewd) + deallocate( this%fcur) + deallocate( this%fcurdv) + deallocate( this%lf_flab) + deallocate( this%lf_fcel) + deallocate( this%lf_flig) + deallocate( this%fr_flab) + deallocate( this%fr_fcel) + deallocate( this%fr_flig) + deallocate( this%leaf_long) + deallocate( this%evergreen) + deallocate( this%stress_decid) + deallocate( this%season_decid) + deallocate( this%dwood) + deallocate( this%pconv) + deallocate( this%pprod10) + deallocate( this%pprod100) + deallocate( this%pprodharv10) + deallocate( this%cc_leaf) + deallocate( this%cc_lstem) + deallocate( this%cc_dstem) + deallocate( this%cc_other) + deallocate( this%fm_leaf) + deallocate( this%fm_lstem) + deallocate( this%fm_dstem) + deallocate( this%fm_other) + deallocate( this%fm_root) + deallocate( this%fm_lroot) + deallocate( this%fm_droot) + deallocate( this%fsr_pft) + deallocate( this%fd_pft) + deallocate( this%fertnitro) + deallocate( this%fleafcn) + deallocate( this%ffrootcn) + deallocate( this%fstemcn) + deallocate( this%i_vcad) + deallocate( this%s_vcad) + deallocate( this%i_flnr) + deallocate( this%s_flnr) + deallocate( this%pftpar20) + deallocate( this%pftpar28) + deallocate( this%pftpar29) + deallocate( this%pftpar30) + deallocate( this%pftpar31) + deallocate( this%a_fix) + deallocate( this%b_fix) + deallocate( this%c_fix) + deallocate( this%s_fix) + deallocate( this%akc_active) + deallocate( this%akn_active) + deallocate( this%ekc_active) + deallocate( this%ekn_active) + deallocate( this%kc_nonmyc) + deallocate( this%kn_nonmyc) + deallocate( this%kr_resorb) + deallocate( this%perecm) + deallocate( this%root_dmx) + deallocate( this%fun_cn_flex_a) + deallocate( this%fun_cn_flex_b) + deallocate( this%fun_cn_flex_c) + deallocate( this%FUN_fracfixers) + + end subroutine Clean + + end module pftconMod diff --git a/components/clm/src/unit_test_shr/unittestSimpleSubgridSetupsMod.F90 b/components/clm/src/unit_test_shr/unittestSimpleSubgridSetupsMod.F90 index 44009df870..cb1fab7640 100644 --- a/components/clm/src/unit_test_shr/unittestSimpleSubgridSetupsMod.F90 +++ b/components/clm/src/unit_test_shr/unittestSimpleSubgridSetupsMod.F90 @@ -21,6 +21,9 @@ module unittestSimpleSubgridSetupsMod ! Create a grid that has a single gridcell with a single vegetated patch public :: setup_single_veg_patch + ! Create a grid that has a single gridcell with N vegetated patches + public :: setup_n_veg_patches + ! Create a grid that has N grid cells, each with a single vegetated patch public :: setup_ncells_single_veg_patch @@ -69,6 +72,53 @@ subroutine setup_single_veg_patch(pft_type) end subroutine setup_single_veg_patch + !----------------------------------------------------------------------- + subroutine setup_n_veg_patches(pwtcol, pft_types) + ! + ! !DESCRIPTION: + ! Create a grid that has a single gridcell with N vegetated patches on one column. + ! + ! !USES: + ! + ! !ARGUMENTS: + real(r8), intent(in) :: pwtcol(:) + + ! If given, this gives the pft type for each patch. If not given, pft types go 1..N. + integer, optional, intent(in) :: pft_types(:) + ! + ! !LOCAL VARIABLES: + integer :: npatches + integer :: p + integer, allocatable :: l_pft_types(:) + + character(len=*), parameter :: subname = 'setup_n_veg_patches' + !----------------------------------------------------------------------- + + npatches = size(pwtcol) + allocate(l_pft_types(npatches)) + if (present(pft_types)) then + SHR_ASSERT((size(pft_types) == npatches), errMsg(__FILE__, __LINE__)) + l_pft_types = pft_types + else + do p = 1, npatches + l_pft_types(p) = p + end do + end if + + call unittest_subgrid_setup_start() + + call unittest_add_gridcell() + call unittest_add_landunit(my_gi=gi, ltype=istsoil, wtgcell=1._r8) + call unittest_add_column(my_li=li, ctype=1, wtlunit=1._r8) + do p = 1, npatches + call unittest_add_patch(my_ci=ci, ptype=l_pft_types(p), wtcol=pwtcol(p)) + end do + + call unittest_subgrid_setup_end() + + end subroutine setup_n_veg_patches + + !----------------------------------------------------------------------- subroutine setup_ncells_single_veg_patch(ncells, pft_type) ! diff --git a/components/clm/src_clm40/main/findHistFields.pl b/components/clm/src_clm40/main/findHistFields.pl index a59d36916e..15130e7e8b 100755 --- a/components/clm/src_clm40/main/findHistFields.pl +++ b/components/clm/src_clm40/main/findHistFields.pl @@ -180,7 +180,7 @@ sub XML_Header { my $filename = shift; print STDERR " Write out header to history fields file to: $outfilename\n"; - my $svnurl = '$URL: https://svn-ccsm-models.cgd.ucar.edu/clm2/trunk_tags/clm4_5_8_r179/components/clm/src_clm40/main/findHistFields.pl $'; + my $svnurl = '$URL: https://svn-ccsm-models.cgd.ucar.edu/clm2/trunk_tags/clm4_5_8_r180/components/clm/src_clm40/main/findHistFields.pl $'; my $svnid = '$Id: findHistFields.pl 69899 2015-04-10 20:45:24Z erik $'; print $outfh <<"EOF"; diff --git a/components/clm/tools/clm4_0/interpinic/src/interpinic.F90 b/components/clm/tools/clm4_0/interpinic/src/interpinic.F90 index 6c353d3854..81cf647b3d 100644 --- a/components/clm/tools/clm4_0/interpinic/src/interpinic.F90 +++ b/components/clm/tools/clm4_0/interpinic/src/interpinic.F90 @@ -1389,7 +1389,7 @@ subroutine addglobal (ncid, cmdline) character(len= 5) :: zone character(len=18) :: datetime character(len=256):: version = & - "$HeadURL: https://svn-ccsm-models.cgd.ucar.edu/clm2/trunk_tags/clm4_5_8_r179/components/clm/tools/clm4_0/interpinic/src/interpinic.F90 $" + "$HeadURL: https://svn-ccsm-models.cgd.ucar.edu/clm2/trunk_tags/clm4_5_8_r180/components/clm/tools/clm4_0/interpinic/src/interpinic.F90 $" character(len=256) :: revision_id = "$Id: interpinic.F90 55582 2013-11-23 21:15:59Z erik $" character(len=16) :: logname character(len=16) :: hostname diff --git a/components/clm/tools/clm4_0/mksurfdata_map/src/mkfileMod.F90 b/components/clm/tools/clm4_0/mksurfdata_map/src/mkfileMod.F90 index 4e51d839bc..1d1ddd8fb6 100644 --- a/components/clm/tools/clm4_0/mksurfdata_map/src/mkfileMod.F90 +++ b/components/clm/tools/clm4_0/mksurfdata_map/src/mkfileMod.F90 @@ -93,7 +93,7 @@ subroutine mkfile(domain, fname, dynlanduse, urban_format) 'Source', len_trim(str), trim(str)), subname) str = & -'$HeadURL: https://svn-ccsm-models.cgd.ucar.edu/clm2/trunk_tags/clm4_5_8_r179/components/clm/tools/clm4_0/mksurfdata_map/src/mkfileMod.F90 $' +'$HeadURL: https://svn-ccsm-models.cgd.ucar.edu/clm2/trunk_tags/clm4_5_8_r180/components/clm/tools/clm4_0/mksurfdata_map/src/mkfileMod.F90 $' call check_ret(nf_put_att_text (ncid, NF_GLOBAL, & 'Version', len_trim(str), trim(str)), subname) diff --git a/components/clm/tools/clm4_5/mksurfdata_map/src/mkfileMod.F90 b/components/clm/tools/clm4_5/mksurfdata_map/src/mkfileMod.F90 index 136d567ca8..d872c4f2bf 100644 --- a/components/clm/tools/clm4_5/mksurfdata_map/src/mkfileMod.F90 +++ b/components/clm/tools/clm4_5/mksurfdata_map/src/mkfileMod.F90 @@ -92,7 +92,7 @@ subroutine mkfile(domain, fname, dynlanduse) 'Source', len_trim(str), trim(str)), subname) str = & -'$HeadURL: https://svn-ccsm-models.cgd.ucar.edu/clm2/trunk_tags/clm4_5_8_r179/components/clm/tools/clm4_5/mksurfdata_map/src/mkfileMod.F90 $' +'$HeadURL: https://svn-ccsm-models.cgd.ucar.edu/clm2/trunk_tags/clm4_5_8_r180/components/clm/tools/clm4_5/mksurfdata_map/src/mkfileMod.F90 $' call check_ret(nf_put_att_text (ncid, NF_GLOBAL, & 'Version', len_trim(str), trim(str)), subname) diff --git a/components/clm/tools/shared/mkmapdata/rmdups.ncl b/components/clm/tools/shared/mkmapdata/rmdups.ncl index 5a2f951c7b..358c6f9177 100644 --- a/components/clm/tools/shared/mkmapdata/rmdups.ncl +++ b/components/clm/tools/shared/mkmapdata/rmdups.ncl @@ -118,7 +118,7 @@ begin nco@history = nco@history + " Removed duplicate weights from mapping file with: rmdups.ncl " nco@rmdups_Logname = logname; nco@rmdups_mod_date = ldate; - nco@rmdups_version = "$HeadURL: https://svn-ccsm-models.cgd.ucar.edu/clm2/trunk_tags/clm4_5_8_r179/components/clm/tools/shared/mkmapdata/rmdups.ncl $"; + nco@rmdups_version = "$HeadURL: https://svn-ccsm-models.cgd.ucar.edu/clm2/trunk_tags/clm4_5_8_r180/components/clm/tools/shared/mkmapdata/rmdups.ncl $"; nco@rmdups_revision_id = "$Id: rmdups.ncl 47629 2013-05-31 08:59:50Z erik $"; print("Successfully removed duplicate weights from mapping file" ); diff --git a/components/clm/tools/shared/mkmapgrids/mkscripgrid.ncl b/components/clm/tools/shared/mkmapgrids/mkscripgrid.ncl index 42139b8efb..b4a9049dbb 100644 --- a/components/clm/tools/shared/mkmapgrids/mkscripgrid.ncl +++ b/components/clm/tools/shared/mkmapgrids/mkscripgrid.ncl @@ -158,7 +158,7 @@ end nc = addfile( outfilename, "w" ); nc@history = ldate+": create using mkscripgrid.ncl"; nc@comment = "Ocean is assumed to non-existant at this point"; - nc@Version = "$HeadURL: https://svn-ccsm-models.cgd.ucar.edu/clm2/trunk_tags/clm4_5_8_r179/components/clm/tools/shared/mkmapgrids/mkscripgrid.ncl $"; + nc@Version = "$HeadURL: https://svn-ccsm-models.cgd.ucar.edu/clm2/trunk_tags/clm4_5_8_r180/components/clm/tools/shared/mkmapgrids/mkscripgrid.ncl $"; nc@Revision = "$Id: mkscripgrid.ncl 72547 2015-08-25 16:28:29Z erik $"; if ( printn )then print( "================================================================================================" ); diff --git a/components/clm/tools/shared/ncl_scripts/getco2_historical.ncl b/components/clm/tools/shared/ncl_scripts/getco2_historical.ncl index dd0ba86a2e..9af044d768 100644 --- a/components/clm/tools/shared/ncl_scripts/getco2_historical.ncl +++ b/components/clm/tools/shared/ncl_scripts/getco2_historical.ncl @@ -109,7 +109,7 @@ begin fileattdef ( nco, ncg ); nco@history = ldate+": Convert by getco2_historical.ncl"; nco@source = "Convert from:"+ghgfile; - nco@Version = "$HeadURL: https://svn-ccsm-models.cgd.ucar.edu/clm2/trunk_tags/clm4_5_8_r179/components/clm/tools/shared/ncl_scripts/getco2_historical.ncl $"; + nco@Version = "$HeadURL: https://svn-ccsm-models.cgd.ucar.edu/clm2/trunk_tags/clm4_5_8_r180/components/clm/tools/shared/ncl_scripts/getco2_historical.ncl $"; nco@Revision = "$Id: getco2_historical.ncl 69995 2015-04-14 20:26:21Z erik $"; ; ; Set static variables