From af920a4b47051e70c227727a493da05550aaf56c Mon Sep 17 00:00:00 2001 From: Gautam Bisht Date: Tue, 30 May 2017 12:46:10 -0700 Subject: [PATCH 01/68] Updates ALM build script for BGC relatved variables Values for suplnitro and suplphos from the user defined namelist are used during the generation of land namelist file. Adds few more consistency checks. Fixes #1565 --- components/clm/bld/CLMBuildNamelist.pm | 38 ++++++++++++++++++++++++++ 1 file changed, 38 insertions(+) diff --git a/components/clm/bld/CLMBuildNamelist.pm b/components/clm/bld/CLMBuildNamelist.pm index b14b2227aa97..3c9441198ee9 100755 --- a/components/clm/bld/CLMBuildNamelist.pm +++ b/components/clm/bld/CLMBuildNamelist.pm @@ -1094,6 +1094,10 @@ sub setup_cmdl_methane { $var = "use_lch4"; $val = ".true."; + if ( defined($nl->get_value($var)) && $nl->get_value($var) ne $val ) { + fatal_error("$var is inconsistent with the commandline setting of -methane"); + } + my $group = $definition->get_group_name($var); $nl_flags->{$var} = $val; $nl->set_variable_value($group, $var, $val); @@ -1128,6 +1132,9 @@ sub setup_cmdl_nutrient { if ($val eq "c"){ $var = "suplnitro"; $val = "'ALL'"; + if ( defined($nl->get_value($var)) ) { + $val = $nl->get_value($var); + } my $group = $definition->get_group_name($var); $nl_flags->{$var} = $val; @@ -1140,6 +1147,9 @@ sub setup_cmdl_nutrient { $var = "suplphos"; $val = "'ALL'"; + if ( defined($nl->get_value($var)) ) { + $val = $nl->get_value($var); + } my $group = $definition->get_group_name($var); $nl_flags->{$var} = $val; @@ -1153,6 +1163,9 @@ sub setup_cmdl_nutrient { } elsif ($val eq "cn") { $var = "suplnitro"; $val = "'NONE'"; + if ( defined($nl->get_value($var)) ) { + $val = $nl->get_value($var); + } my $group = $definition->get_group_name($var); $nl_flags->{$var} = $val; @@ -1165,6 +1178,9 @@ sub setup_cmdl_nutrient { $var = "suplphos"; $val = "'ALL'"; + if ( defined($nl->get_value($var)) ) { + $val = $nl->get_value($var); + } my $group = $definition->get_group_name($var); $nl_flags->{$var} = $val; @@ -1178,6 +1194,9 @@ sub setup_cmdl_nutrient { } elsif ($val eq "cnp") { $var = "suplnitro"; $val = "'NONE'"; + if ( defined($nl->get_value($var)) ) { + $val = $nl->get_value($var); + } my $group = $definition->get_group_name($var); $nl_flags->{$var} = $val; @@ -1190,6 +1209,9 @@ sub setup_cmdl_nutrient { $var = "suplphos"; $val = "'NONE'"; + if ( defined($nl->get_value($var)) ) { + $val = $nl->get_value($var); + } my $group = $definition->get_group_name($var); $nl_flags->{$var} = $val; @@ -1230,6 +1252,10 @@ sub setup_cmdl_nutrient_comp { $var = "nu_com"; $val = "'RD'"; + if ( defined($nl->get_value($var)) && $nl->get_value($var) ne $val ) { + fatal_error("$var is inconsistent with the commandline setting of -nutrient_comp_pathway"); + } + my $group = $definition->get_group_name($var); $nl_flags->{$var} = $val; $nl->set_variable_value($group, $var, $val); @@ -1245,6 +1271,10 @@ sub setup_cmdl_nutrient_comp { $var = "nu_com"; $val = "'ECA'"; + if ( defined($nl->get_value($var)) && $nl->get_value($var) ne $val ) { + fatal_error("$var is inconsistent with the commandline setting of -nutrient_comp_pathway"); + } + my $group = $definition->get_group_name($var); $nl_flags->{$var} = $val; $nl->set_variable_value($group, $var, $val); @@ -1284,6 +1314,10 @@ sub setup_cmdl_soil_decomp { $var = "use_century_decomp"; $val = ".false."; + if ( defined($nl->get_value($var)) && $nl->get_value($var) ne $val ) { + fatal_error("$var is inconsistent with the commandline setting of -soil_decomp"); + } + my $group = $definition->get_group_name($var); $nl_flags->{$var} = $val; $nl->set_variable_value($group, $var, $val); @@ -1297,6 +1331,10 @@ sub setup_cmdl_soil_decomp { $var = "use_century_decomp"; $val = ".true."; + if ( defined($nl->get_value($var)) && $nl->get_value($var) ne $val ) { + fatal_error("$var is inconsistent with the commandline setting of -soil_decomp"); + } + my $group = $definition->get_group_name($var); $nl_flags->{$var} = $val; $nl->set_variable_value($group, $var, $val); From 64dd5f6902ee157053f098de461015246eaafe93 Mon Sep 17 00:00:00 2001 From: Andy Salinger Date: Fri, 30 Jun 2017 17:06:59 -0600 Subject: [PATCH 02/68] Update path to new Albany install: redsky, edison A new MPAS Landice tag, to be pulled into ACME in the next few weeks, will have an updated interface to Albany/FELIX. I have started to upgrade the Albany installation on targeted machines. In this commit, we update the path in the ALBANY_PATH variable in config_compiler.xml for some machines. This makes that change for redsky/chama, edison, and sandia-srn-sems machines. ToDo: install new albany on Mira, Titan, Anvil, and other machines. The hope is that the test MPASLIALB in acme_integration will pass with this change on these machines when done in concert with the MPAS Landice update. --- cime/config/acme/machines/config_compilers.xml | 17 +++++------------ cime/config/acme/machines/config_machines.xml | 1 + 2 files changed, 6 insertions(+), 12 deletions(-) diff --git a/cime/config/acme/machines/config_compilers.xml b/cime/config/acme/machines/config_compilers.xml index ab849681b733..8c8aad6aae7b 100644 --- a/cime/config/acme/machines/config_compilers.xml +++ b/cime/config/acme/machines/config_compilers.xml @@ -558,7 +558,7 @@ for mct, etc. cc CC $(PETSC_DIR) - /global/project/projectdirs/acme/software/AlbanyTrilinos_09232015/Albany/build/install + /global/project/projectdirs/acme/software/AlbanyTrilinos_06262017/Albany/build/install @@ -697,7 +697,7 @@ for mct, etc. $(PNETCDFROOT) $(shell $(NETCDF_PATH)/bin/nf-config --flibs) -L/usr/lib64 -L/usr/lib64/atlas -lblas -llapack -lstdc++ -lmpi_cxx - /projects/install/rhel6-x86_64/ACME/AlbanyTrilinos/Albany/build/install + /data/acme/AlbanyTrilinos_06262017/Albany/build/install @@ -709,7 +709,7 @@ for mct, etc. $(shell $(NETCDF_PATH)/bin/nf-config --flibs) -L/usr/lib64 -L/usr/lib64/atlas -lblas -llapack /projects/sems/install/rhel6-x86_64/sems/compiler/intel/15.0.2/base/mkl/lib/mic/libmkl_scalapack_lp64.a -Wl,--start-group /projects/sems/install/rhel6-x86_64/sems/compiler/intel/15.0.2/base/mkl/lib/intel64/libmkl_intel_lp64.a /projects/sems/install/rhel6-x86_64/sems/compiler/intel/15.0.2/base/mkl/lib/intel64/libmkl_core.a /projects/sems/install/rhel6-x86_64/sems/compiler/intel/15.0.2/base/mkl/lib/intel64/libmkl_sequential.a -Wl,--end-group /projects/sems/install/rhel6-x86_64/sems/compiler/intel/15.0.2/base/mkl/lib/mic/libmkl_blacs_intelmpi_lp64.a -lpthread -lm -lstdc++ -lmpi_cxx - /projects/install/rhel6-x86_64/ACME/AlbanyTrilinos/Albany/build/install + /data/acme/AlbanyTrilinos_06262017/Albany/build/install @@ -733,7 +733,7 @@ for mct, etc. lustre -mkl=cluster -mkl - /projects/ccsm/AlbanyTrilinos/Albany/build/install + /projects/ccsm/AlbanyTrilinos_06262017/Albany/build/install @@ -748,7 +748,7 @@ for mct, etc. lustre -mkl=cluster -mkl - /projects/ccsm/AlbanyTrilinos/Albany/build/install + /projects/ccsm/AlbanyTrilinos_06262017/Albany/build/install @@ -765,13 +765,6 @@ for mct, etc. /projects/ccsm/AlbanyTrilinos/Albany/build/install - - $(NETCDFROOT) - $(PNETCDFROOT) - $(shell $(NETCDF_PATH)/bin/nf-config --flibs) -lblas - -DHAVE_COMM_F2C - - /usr/local/tools/netcdf-pgi-4.1.3 /usr/local/tools/mvapich2-pgi-1.7/ diff --git a/cime/config/acme/machines/config_machines.xml b/cime/config/acme/machines/config_machines.xml index 9444f9850a63..c15183e4abde 100644 --- a/cime/config/acme/machines/config_machines.xml +++ b/cime/config/acme/machines/config_machines.xml @@ -616,6 +616,7 @@ sems-openmpi/1.8.7 sems-cmake/2.8.12 sems-netcdf/4.3.2/parallel + sems-boost/1.58.0/base From c369705e8af938e6f1dd324ab00dd6ad200f2ffe Mon Sep 17 00:00:00 2001 From: Jon Wolfe Date: Thu, 6 Jul 2017 13:34:02 -0700 Subject: [PATCH 03/68] Update MPAS framework and components, including MPAS-O threading improvements. --- components/mpas-cice/bld/build-namelist | 2 + .../mpas-cice/bld/build-namelist-section | 2 + .../namelist_defaults_mpas-cice.xml | 2 + .../namelist_definition_mpas-cice.xml | 16 +++++ components/mpas-cice/driver/ice_comp_mct.F | 2 +- components/mpas-cice/model | 2 +- components/mpas-o/bld/build-namelist | 2 + components/mpas-o/bld/build-namelist-section | 2 + .../namelist_defaults_mpas-o.xml | 4 +- .../namelist_definition_mpas-o.xml | 16 +++++ components/mpas-o/model | 2 +- components/mpasli/bld/build-namelist | 9 +++ components/mpasli/bld/build-namelist-section | 9 +++ .../namelist_defaults_mpasli.xml | 9 +++ .../namelist_definition_mpasli.xml | 72 +++++++++++++++++++ components/mpasli/model | 2 +- 16 files changed, 148 insertions(+), 5 deletions(-) diff --git a/components/mpas-cice/bld/build-namelist b/components/mpas-cice/bld/build-namelist index 3a83a399b931..f755380be366 100755 --- a/components/mpas-cice/bld/build-namelist +++ b/components/mpas-cice/bld/build-namelist @@ -438,6 +438,7 @@ add_default($nl, 'config_pio_stride'); add_default($nl, 'config_write_output_on_startup'); add_default($nl, 'config_test_case_diag'); add_default($nl, 'config_test_case_diag_type'); +add_default($nl, 'config_full_abort_write'); ################################# # Namelist group: decomposition # @@ -526,6 +527,7 @@ add_default($nl, 'config_perform_unit_test'); add_default($nl, 'config_unit_test_type'); add_default($nl, 'config_unit_test_subtype'); add_default($nl, 'config_use_test_ice_shelf'); +add_default($nl, 'config_testing_system_test'); ################################### # Namelist group: velocity_solver # diff --git a/components/mpas-cice/bld/build-namelist-section b/components/mpas-cice/bld/build-namelist-section index c2092bebe6d6..9ba9432b83b8 100644 --- a/components/mpas-cice/bld/build-namelist-section +++ b/components/mpas-cice/bld/build-namelist-section @@ -22,6 +22,7 @@ add_default($nl, 'config_pio_stride'); add_default($nl, 'config_write_output_on_startup'); add_default($nl, 'config_test_case_diag'); add_default($nl, 'config_test_case_diag_type'); +add_default($nl, 'config_full_abort_write'); ################################# # Namelist group: decomposition # @@ -106,6 +107,7 @@ add_default($nl, 'config_perform_unit_test'); add_default($nl, 'config_unit_test_type'); add_default($nl, 'config_unit_test_subtype'); add_default($nl, 'config_use_test_ice_shelf'); +add_default($nl, 'config_testing_system_test'); ################################### # Namelist group: velocity_solver # diff --git a/components/mpas-cice/bld/namelist_files/namelist_defaults_mpas-cice.xml b/components/mpas-cice/bld/namelist_files/namelist_defaults_mpas-cice.xml index 315d2f1787a3..819e46eb132e 100644 --- a/components/mpas-cice/bld/namelist_files/namelist_defaults_mpas-cice.xml +++ b/components/mpas-cice/bld/namelist_files/namelist_defaults_mpas-cice.xml @@ -30,6 +30,7 @@ false false 'none' +true 'graph.info.part.' @@ -83,6 +84,7 @@ '' '' false +false 1 diff --git a/components/mpas-cice/bld/namelist_files/namelist_definition_mpas-cice.xml b/components/mpas-cice/bld/namelist_files/namelist_definition_mpas-cice.xml index 3738ae097f99..5308b848180d 100644 --- a/components/mpas-cice/bld/namelist_files/namelist_definition_mpas-cice.xml +++ b/components/mpas-cice/bld/namelist_files/namelist_definition_mpas-cice.xml @@ -143,6 +143,14 @@ Valid values: MISSING POSSIBLE VALUES Default: Defined in namelist_defaults.xml + +MISSING DESCRIPTION + +Valid values: MISSING POSSIBLE VALUES +Default: Defined in namelist_defaults.xml + + @@ -476,6 +484,14 @@ Valid values: MISSING POSSIBLE VALUES Default: Defined in namelist_defaults.xml + +MISSING DESCRIPTION + +Valid values: MISSING POSSIBLE VALUES +Default: Defined in namelist_defaults.xml + + diff --git a/components/mpas-cice/driver/ice_comp_mct.F b/components/mpas-cice/driver/ice_comp_mct.F index 9c757cd5dc42..d04188697c12 100644 --- a/components/mpas-cice/driver/ice_comp_mct.F +++ b/components/mpas-cice/driver/ice_comp_mct.F @@ -826,7 +826,7 @@ subroutine ice_run_mct( EClock, cdata_i, x2i_i, i2x_i)!{{{ if (debugOn) call mpas_log_write(' Starting forward update', masterOnly=.true.) call mpas_timer_start("time integration", .false.) - call cice_timestep(domain, domain % clock, itimestep) + call cice_timestep(domain, domain % clock, itimestep, ierr) call mpas_timer_stop("time integration") if (debugOn) call mpas_log_write(' Finished forward update', masterOnly=.true.) diff --git a/components/mpas-cice/model b/components/mpas-cice/model index 67b6349c85a3..20e220da002f 160000 --- a/components/mpas-cice/model +++ b/components/mpas-cice/model @@ -1 +1 @@ -Subproject commit 67b6349c85a395488acc9c6930687279df2c09aa +Subproject commit 20e220da002f31d66229833ad9667de3558fea57 diff --git a/components/mpas-o/bld/build-namelist b/components/mpas-o/bld/build-namelist index addb5693805c..19531ccd3df0 100755 --- a/components/mpas-o/bld/build-namelist +++ b/components/mpas-o/bld/build-namelist @@ -1403,6 +1403,8 @@ add_default($nl, 'config_AM_waterMassCensus_minTemperature'); add_default($nl, 'config_AM_waterMassCensus_maxTemperature'); add_default($nl, 'config_AM_waterMassCensus_minSalinity'); add_default($nl, 'config_AM_waterMassCensus_maxSalinity'); +add_default($nl, 'config_AM_waterMassCensus_compute_predefined_regions'); +add_default($nl, 'config_AM_waterMassCensus_region_group'); ################################################# # Namelist group: AM_layerVolumeWeightedAverage # diff --git a/components/mpas-o/bld/build-namelist-section b/components/mpas-o/bld/build-namelist-section index b0e1bd976a50..8d49ce4a9814 100644 --- a/components/mpas-o/bld/build-namelist-section +++ b/components/mpas-o/bld/build-namelist-section @@ -977,6 +977,8 @@ add_default($nl, 'config_AM_waterMassCensus_minTemperature'); add_default($nl, 'config_AM_waterMassCensus_maxTemperature'); add_default($nl, 'config_AM_waterMassCensus_minSalinity'); add_default($nl, 'config_AM_waterMassCensus_maxSalinity'); +add_default($nl, 'config_AM_waterMassCensus_compute_predefined_regions'); +add_default($nl, 'config_AM_waterMassCensus_region_group'); ################################################# # Namelist group: AM_layerVolumeWeightedAverage # diff --git a/components/mpas-o/bld/namelist_files/namelist_defaults_mpas-o.xml b/components/mpas-o/bld/namelist_files/namelist_defaults_mpas-o.xml index 77988bdb3254..c2cc85f1edd3 100644 --- a/components/mpas-o/bld/namelist_files/namelist_defaults_mpas-o.xml +++ b/components/mpas-o/bld/namelist_files/namelist_defaults_mpas-o.xml @@ -16,7 +16,7 @@ 'gregorian' -.true. +.false. 0 1 @@ -851,6 +851,8 @@ 30.0 32.0 37.0 +.true. +'' .true. diff --git a/components/mpas-o/bld/namelist_files/namelist_definition_mpas-o.xml b/components/mpas-o/bld/namelist_files/namelist_definition_mpas-o.xml index f1b759e63e89..905cb095dca6 100644 --- a/components/mpas-o/bld/namelist_files/namelist_definition_mpas-o.xml +++ b/components/mpas-o/bld/namelist_files/namelist_definition_mpas-o.xml @@ -5547,6 +5547,22 @@ Valid values: any real number greater than config_AM_waterMassCensus_minSalinity Default: Defined in namelist_defaults.xml + +Computes predefined regions. (Does not require a region mask file.) + +Valid values: .true. or .false. +Default: Defined in namelist_defaults.xml + + + +The name of the region group, for which the WMC should be computed in addition to the existing WMC. + +Valid values: 'all', '', or the name of a region group. +Default: Defined in namelist_defaults.xml + + diff --git a/components/mpas-o/model b/components/mpas-o/model index 21b8bf992f21..d7fccd22bbdc 160000 --- a/components/mpas-o/model +++ b/components/mpas-o/model @@ -1 +1 @@ -Subproject commit 21b8bf992f21ea71eac5c6a82334ceb7282d5c81 +Subproject commit d7fccd22bbdccfb2f2611d41f8c1bc3032e19705 diff --git a/components/mpasli/bld/build-namelist b/components/mpasli/bld/build-namelist index 9abfb4489dbe..da0cc132ea3b 100755 --- a/components/mpasli/bld/build-namelist +++ b/components/mpasli/bld/build-namelist @@ -416,6 +416,7 @@ add_default($nl, 'config_sia_tangent_slope_calculation'); add_default($nl, 'config_flowParamA_calculation'); add_default($nl, 'config_do_velocity_reconstruction_for_external_dycore'); add_default($nl, 'config_simple_velocity_type'); +add_default($nl, 'config_use_glp'); ############################# # Namelist group: advection # @@ -545,6 +546,14 @@ add_default($nl, 'config_SGH_bed_roughness_max'); add_default($nl, 'config_SGH_creep_coefficient'); add_default($nl, 'config_SGH_englacial_porosity'); add_default($nl, 'config_SGH_till_max'); +add_default($nl, 'config_SGH_chnl_active'); +add_default($nl, 'config_SGH_chnl_alpha'); +add_default($nl, 'config_SGH_chnl_beta'); +add_default($nl, 'config_SGH_chnl_conduc_coeff'); +add_default($nl, 'config_SGH_chnl_creep_coefficient'); +add_default($nl, 'config_SGH_incipient_channel_width'); +add_default($nl, 'config_SGH_include_pressure_melt'); +add_default($nl, 'config_SGH_shmip_forcing'); ################################## # Namelist group: AM_globalStats # diff --git a/components/mpasli/bld/build-namelist-section b/components/mpasli/bld/build-namelist-section index f628aa5a7f21..f77bc651043f 100644 --- a/components/mpasli/bld/build-namelist-section +++ b/components/mpasli/bld/build-namelist-section @@ -10,6 +10,7 @@ add_default($nl, 'config_sia_tangent_slope_calculation'); add_default($nl, 'config_flowParamA_calculation'); add_default($nl, 'config_do_velocity_reconstruction_for_external_dycore'); add_default($nl, 'config_simple_velocity_type'); +add_default($nl, 'config_use_glp'); ############################# # Namelist group: advection # @@ -139,6 +140,14 @@ add_default($nl, 'config_SGH_bed_roughness_max'); add_default($nl, 'config_SGH_creep_coefficient'); add_default($nl, 'config_SGH_englacial_porosity'); add_default($nl, 'config_SGH_till_max'); +add_default($nl, 'config_SGH_chnl_active'); +add_default($nl, 'config_SGH_chnl_alpha'); +add_default($nl, 'config_SGH_chnl_beta'); +add_default($nl, 'config_SGH_chnl_conduc_coeff'); +add_default($nl, 'config_SGH_chnl_creep_coefficient'); +add_default($nl, 'config_SGH_incipient_channel_width'); +add_default($nl, 'config_SGH_include_pressure_melt'); +add_default($nl, 'config_SGH_shmip_forcing'); ################################## # Namelist group: AM_globalStats # diff --git a/components/mpasli/bld/namelist_files/namelist_defaults_mpasli.xml b/components/mpasli/bld/namelist_files/namelist_defaults_mpasli.xml index ca55960cffe3..3b239c6e7acb 100644 --- a/components/mpasli/bld/namelist_files/namelist_defaults_mpasli.xml +++ b/components/mpasli/bld/namelist_files/namelist_defaults_mpasli.xml @@ -10,6 +10,7 @@ 'constant' .false. 'uniform' +.false. 'fo' @@ -104,6 +105,14 @@ 0.04 0.01 2.0 +.false. +1.25 +1.5 +0.1 +0.04 +2.0 +.true. +'none' .true. diff --git a/components/mpasli/bld/namelist_files/namelist_definition_mpasli.xml b/components/mpasli/bld/namelist_files/namelist_definition_mpasli.xml index 24392d71d493..75e4d37c364a 100644 --- a/components/mpasli/bld/namelist_files/namelist_definition_mpasli.xml +++ b/components/mpasli/bld/namelist_files/namelist_definition_mpasli.xml @@ -92,6 +92,14 @@ Valid values: 'uniform', 'radial' Default: Defined in namelist_defaults.xml + +If true, then apply Albany's grounding line parameterization + +Valid values: .true. or .false. +Default: Defined in namelist_defaults.xml + + @@ -706,6 +714,70 @@ Valid values: positive real number Default: Defined in namelist_defaults.xml + +activate channels in subglacial hydrology model + +Valid values: .true. or .false. +Default: Defined in namelist_defaults.xml + + + +power in flux formula + +Valid values: positive real number +Default: Defined in namelist_defaults.xml + + + +power in flux formula + +Valid values: positive real number +Default: Defined in namelist_defaults.xml + + + +conductivity coefficient + +Valid values: positive real number +Default: Defined in namelist_defaults.xml + + + +creep closure coefficient + +Valid values: positive real number +Default: Defined in namelist_defaults.xml + + + +width of sheet beneath/around channel that contributes to melt within the channel + +Valid values: positive real number +Default: Defined in namelist_defaults.xml + + + +whether to include the pressure melt term in the channel opening + +Valid values: .true. or .false. +Default: Defined in namelist_defaults.xml + + + +calculate time-varying forcing specified by SHMIP experiments C or D + +Valid values: 'none', 'C1'-'C4', 'D1'-'D5' +Default: Defined in namelist_defaults.xml + + diff --git a/components/mpasli/model b/components/mpasli/model index 006424abef09..37fde6df873b 160000 --- a/components/mpasli/model +++ b/components/mpasli/model @@ -1 +1 @@ -Subproject commit 006424abef097b22b06d3c3eda2bd963e0444c93 +Subproject commit 37fde6df873b5988cdcc84b4375425feb0767156 From 36d359c295d6e529ef1f14f6fea99c1db6eb9d3c Mon Sep 17 00:00:00 2001 From: Jon Wolfe Date: Tue, 11 Jul 2017 07:12:33 -0700 Subject: [PATCH 04/68] Also include corresponding mpas-o threading changes --- components/mpas-o/model | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/components/mpas-o/model b/components/mpas-o/model index d7fccd22bbdc..f2adff7a58cc 160000 --- a/components/mpas-o/model +++ b/components/mpas-o/model @@ -1 +1 @@ -Subproject commit d7fccd22bbdccfb2f2611d41f8c1bc3032e19705 +Subproject commit f2adff7a58cc15f163ce2b624245a4b3ba18d25e From 7e0ccd1f9bd457cfd1faa3c6ac463776a3715a31 Mon Sep 17 00:00:00 2001 From: Benjamin Hillman Date: Tue, 11 Jul 2017 11:27:42 -0600 Subject: [PATCH 05/68] Add cime configuration for ENA grid Add support for enax4v1_enax4v1 and enax4v1_ne30_enax4v1 resolutions in cime. --- cime/config/acme/config_grids.xml | 51 +++++++++++++++++++++++++++++++ 1 file changed, 51 insertions(+) diff --git a/cime/config/acme/config_grids.xml b/cime/config/acme/config_grids.xml index 3ce67f709f7a..5b462810bc61 100644 --- a/cime/config/acme/config_grids.xml +++ b/cime/config/acme/config_grids.xml @@ -466,6 +466,20 @@ sooberingoax4x8v1_sooberingoax4x8v1 + + + ne0np4_enax4v1_ne0np4_enax4v1 + a%ne0np4_enax4v1_l%ne0np4_enax4v1_oi%ne0np4_enax4v1_r%r01_m%oRRS18to6_g%null_w%null + enax4v1_enax4v1 + + + + + ne0np4_enax4v1_ne30np4_ne0np4_enax4v1 + a%ne0np4_enax4v1_l%ne30np4_oi%ne0np4_enax4v1_r%r01_m%oRRS18to6_g%null_w%null + enax4v1_ne30_enax4v1 + + ne16np4_ne16np4 ne16_ne16 @@ -1457,6 +1471,20 @@ domain.ocn.conusx4v1_tx0.1v2.141022.nc + + 78788 + 1 + 1-deg with 1/4-deg over Eastern North Atlantic (version 1): + domain.lnd.enax4v1_gx1v6.170523.nc + domain.ocn.enax4v1_gx1v6.170523.nc + domain.lnd.enax4v1_gx1v6.170523.nc + domain.ocn.enax4v1_gx1v6.170523.nc + domain.lnd.enax4v1_oRRS18to6.170621.nc + domain.ocn.enax4v1_oRRS18to6.170621.nc + domain.lnd.enax4v1_oRRS18to6.170621.nc + domain.ocn.enax4v1_oRRS18to6.170621.nc + + 71912 1 @@ -1749,6 +1777,29 @@ cpl/gridmaps/fv0.23x0.31/map_fv0.23x0.31_to_ne240np4_aave_110428.nc + + cpl/cpl6/map_enax4v1_TO_ne30np4_aave.170517.nc + cpl/cpl6/map_enax4v1_TO_ne30np4_aave.170517.nc + cpl/cpl6/map_ne30np4_TO_enax4v1_aave.170517.nc + cpl/cpl6/map_ne30np4_TO_enax4v1_aave.170517.nc + + + + cpl/cpl6/map_enax4v1_TO_gx1v6_aave.170523.nc + cpl/cpl6/map_enax4v1_TO_gx1v6_blin.170523.nc + cpl/cpl6/map_enax4v1_TO_gx1v6_patc.170523.nc + cpl/cpl6/map_gx1v6_TO_enax4v1_aave.170523.nc + cpl/cpl6/map_gx1v6_TO_enax4v1_aave.170523.nc + + + + cpl/cpl6/map_enax4v1_TO_oRRS18to6_aave.170620.nc + cpl/cpl6/map_enax4v1_TO_oRRS18to6_blin.170620.nc + cpl/cpl6/map_enax4v1_TO_oRRS18to6_patc.170620.nc + cpl/cpl6/map_oRRS18to6_TO_enax4v1_aave.170620.nc + cpl/cpl6/map_oRRS18to6_TO_enax4v1_aave.170620.nc + + cpl/gridmaps/T62/map_T62_TO_gx3v7_aave.130322.nc cpl/gridmaps/T62/map_T62_TO_gx3v7_blin.130322.nc From 2af9b40ebf961d486a268c460ebe4db3c2d9ffec Mon Sep 17 00:00:00 2001 From: Benjamin Hillman Date: Tue, 11 Jul 2017 11:29:29 -0600 Subject: [PATCH 06/68] Add ENA grid size to CAM configuration Add horiz_grid entry for ENA to CAM configuration. Sets the grid name and size (number of columns). --- components/cam/bld/config_files/horiz_grid.xml | 1 + 1 file changed, 1 insertion(+) diff --git a/components/cam/bld/config_files/horiz_grid.xml b/components/cam/bld/config_files/horiz_grid.xml index 86eccd4098be..543dd9910057 100644 --- a/components/cam/bld/config_files/horiz_grid.xml +++ b/components/cam/bld/config_files/horiz_grid.xml @@ -44,5 +44,6 @@ + From d7f735eb86fe52c58dfac0ab5bae2689f12e0a46 Mon Sep 17 00:00:00 2001 From: Benjamin Hillman Date: Tue, 11 Jul 2017 11:31:25 -0600 Subject: [PATCH 07/68] Set CAM namelist defaults for ENA grid Set dycore parameters and input data paths for CAM when the grid is ne0np4_enax4v1. --- .../namelist_files/namelist_defaults_cam.xml | 22 ++++++++++++++++--- 1 file changed, 19 insertions(+), 3 deletions(-) diff --git a/components/cam/bld/namelist_files/namelist_defaults_cam.xml b/components/cam/bld/namelist_files/namelist_defaults_cam.xml index 36c8a7bed758..290cb47eacca 100644 --- a/components/cam/bld/namelist_files/namelist_defaults_cam.xml +++ b/components/cam/bld/namelist_files/namelist_defaults_cam.xml @@ -26,6 +26,7 @@ 900 600 600 +900 3600 @@ -180,6 +181,9 @@ atm/cam/inic/homme/cami-mam3_0000-01-01_sooberingoax4x8v1np4_L30_c141110.nc atm/cam/inic/homme/cami_0003-01-01_sooberingoax4x8v1np4_L30_ape_c000000.nc + + +atm/cam/inic/homme/cami_0002-01-01_enax4v1_L72_c170706.nc atm/cam/inic/homme/cami_0000-01-01_ne5np8_L26_ape_c061102.nc atm/cam/inic/homme/cami_0000-01-01_ne16np4_L26_ape_c071213.nc @@ -220,6 +224,7 @@ atm/cam/topo/USGS_conusx4v1-tensor12x_consistentSGH_c150924.nc atm/cam/topo/USGS_svalbardx8v1-tensor12x_c150612.nc atm/cam/topo/USGS_sooberingoax4x8v1-tensor12x_c150612.nc +atm/cam/topo/USGS_enax4v1_tensorx12_consistentSGH_170522.nc @@ -708,6 +713,8 @@ atm/cam/chem/trop_mam/atmsrf_conusx4v1.nc atm/cam/chem/trop_mam/atmsrf_svalbardx8v1.nc atm/cam/chem/trop_mam/atmsrf_sooberingoax4x8v1.nc + +atm/cam/chem/trop_mam/atmsrf_enax4v1_170517.nc atm/cam/chem/trop_mozart/dvel/depvel_monthly.nc @@ -1288,6 +1295,7 @@ atm/cam/inic/homme/conusx4v1.g atm/cam/inic/homme/svalbardx8v1.g atm/cam/inic/homme/sooberingoax4x8v1.g +atm/cam/inic/homme/enax4v1.g 2.5e5 1.0e5 @@ -1304,7 +1312,7 @@ 8.0e-8 8.0e-8 8.0e-8 - +8.0e-8 8.0e-8 @@ -1327,7 +1335,7 @@ 8.0e-8 8.0e-8 8.0e-8 - +8.0e-8 2.5e15 1.25e18 @@ -1341,6 +1349,7 @@ 20.0e-8 20.0e-8 20.0e-8 +20.0e-8 2 @@ -1357,6 +1366,7 @@ 7 8 8 +7 1 @@ -1385,6 +1395,7 @@ 4 5 5 +4 5 5 @@ -1398,12 +1409,13 @@ 3.2 3.2 3.2 +3.2 0 0 0 0 - +0 0 @@ -1573,6 +1585,8 @@ share/domains/domain.lnd.ne120np4_gx1v6.111226.nc share/domains/domain.lnd.ne240np4_gx1v6.120125.nc +share/domains/domain.lnd.enax4v1_oRRS18to6.170621.nc + lnd/clm2/snicardata/snicar_optics_5bnd_mam_c160322.nc lnd/clm2/snicardata/snicar_drdt_bst_fit_60_c070416.nc @@ -1663,4 +1677,6 @@ share/domains/domain.ocn.ne120np4_gx1v6.111226.nc share/domains/domain.ocn.ne240np4_gx1v6.111226.nc +share/domains/domain.ocn.enax4v1_oRRS18to6.170621.nc + From 27d0bb0daac6af2633ec4ce42c396dc26a010365 Mon Sep 17 00:00:00 2001 From: Benjamin Hillman Date: Tue, 11 Jul 2017 11:33:15 -0600 Subject: [PATCH 08/68] Set CLM namelist definitions and defaults for ENA Configure CLM to run on new ENA grid. Set paths for initial condition (year 2000 conditions) and surface data in namelist defaults, and add ne0np4_enax4v1 to list of supported grids in namelist definitions. --- .../bld/namelist_files/namelist_defaults_clm4_5.xml | 13 +++++++++++-- .../namelist_files/namelist_definition_clm4_5.xml | 2 +- 2 files changed, 12 insertions(+), 3 deletions(-) diff --git a/components/clm/bld/namelist_files/namelist_defaults_clm4_5.xml b/components/clm/bld/namelist_files/namelist_defaults_clm4_5.xml index 2f632fcbf01f..e8af5ff294bb 100644 --- a/components/clm/bld/namelist_files/namelist_defaults_clm4_5.xml +++ b/components/clm/bld/namelist_files/namelist_defaults_clm4_5.xml @@ -295,11 +295,11 @@ ic_tod="0" sim_year="2000" glc_nec="0" use_crop=".true." irrigate=".false." >lnd ic_tod="0" sim_year="2000" glc_nec="0" use_crop=".true." irrigate=".true." >lnd/clm2/initdata_map/clmi.ICRUCLM45BGCCROPmp24Irrig.0241-01-01.10x15_USGS_simyr2000_c140111.nc - + lnd/clm2/initdata/clmi.armx8v3.1850-01-01.nc lnd/clm2/initdata_map/clmi.I1850CLM45.conusx4v1.74e105b.clm2.r.0021-01-01-00000.nc lnd/clm2/initdata_map/clmi.ICRUCLM45.conusx4v1.74e105b.clm2.r.0021-01-01-00000.nc - +lnd/clm2/initdata_map/clmi.ICRUCLM45SP.2000-01-01.enax4v1_oRRS18to6_simyr2000_c170621.nc @@ -390,6 +390,10 @@ lnd/clm2/surfdata_map/surfdata_conusx4v1_simyr1850_c160503.nc lnd/clm2/surfdata_map/surfdata_conusx4v1_simyr2000_c160503.nc + + lnd/clm2/surfdata/surfdata_enax4v1_mp24_simyr1850_c170518.nc + + lnd/clm2/surfdata/surfdata_enax4v1_mp24_simyr2000_c170518.nc diff --git a/components/clm/bld/namelist_files/namelist_definition_clm4_5.xml b/components/clm/bld/namelist_files/namelist_definition_clm4_5.xml index 1add00e6b107..e13045a9740a 100644 --- a/components/clm/bld/namelist_files/namelist_definition_clm4_5.xml +++ b/components/clm/bld/namelist_files/namelist_definition_clm4_5.xml @@ -1113,7 +1113,7 @@ CLM run type. +"512x1024,360x720cru,128x256,64x128,48x96,32x64,8x16,94x192,0.23x0.31,0.9x1.25,1.9x2.5,2.5x3.33,4x5,10x15,5x5_amazon,1x1_tropicAtl,1x1_camdenNJ,1x1_vancouverCAN,1x1_mexicocityMEX,1x1_asphaltjungleNJ,1x1_brazil,1x1_urbanc_alpha,1x1_numaIA,1x1_smallvilleIA,0.1x0.1,0.5x0.5,3x3min,5x5min,10x10min,0.33x0.33,0.125x0.125,ne4np4,ne11np4,ne16np4,ne30np4,ne60np4,ne120np4,ne240np4,1km-merge-10min,ne0np4_arm_x8v3_lowcon,ne0np4_conus_x4v1_lowcon,ne0np4_enax4v1"> Horizontal resolutions Note: 0.1x0.1, 0.5x0.5, 5x5min, 10x10min, 3x3min and 0.33x0.33 are only used for CLM tools From 4b859cedbf81584e96bbfa888ff88e933740925d Mon Sep 17 00:00:00 2001 From: Benjamin Hillman Date: Tue, 11 Jul 2017 11:43:47 -0600 Subject: [PATCH 09/68] Set CAM_DYCORE to se for RRM grids RRM grids using the se dycore should all start with ne0, but CAM_DYCORE was only set explicitly when the atmosphere grid started with ne[1-9]. Setting this to se when the grid begins with ne[0-9] sets CAM_DYCORE properly for all RRM grids. Fixes #1357. --- components/cam/cime_config/config_component.xml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/components/cam/cime_config/config_component.xml b/components/cam/cime_config/config_component.xml index 3d52ac4f4100..0abc36dcf821 100644 --- a/components/cam/cime_config/config_component.xml +++ b/components/cam/cime_config/config_component.xml @@ -19,7 +19,7 @@ fv eul - se + se build_component_cam env_build.xml From b0b15e37822edd63b87575b4a137947ce099f512 Mon Sep 17 00:00:00 2001 From: Benjamin Hillman Date: Tue, 11 Jul 2017 11:49:20 -0600 Subject: [PATCH 10/68] Set ATM_NCPL for ENA grid Set ATM_NCPL in driver configuration when atmosphere grid is ne0np4_enax4v1. --- cime/src/drivers/mct/cime_config/config_component_acme.xml | 1 + 1 file changed, 1 insertion(+) diff --git a/cime/src/drivers/mct/cime_config/config_component_acme.xml b/cime/src/drivers/mct/cime_config/config_component_acme.xml index 0198b7eecb1c..3963f49e0cc1 100644 --- a/cime/src/drivers/mct/cime_config/config_component_acme.xml +++ b/cime/src/drivers/mct/cime_config/config_component_acme.xml @@ -279,6 +279,7 @@ 96 144 144 + 96 72 144 288 From 9aa04f6dac73d8e9fd800025fe8947df25eb6b7c Mon Sep 17 00:00:00 2001 From: Mark Petersen Date: Wed, 12 Jul 2017 22:56:12 -0600 Subject: [PATCH 11/68] Update mpas-ocean commit to remove OMP master diretives --- components/mpas-o/model | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/components/mpas-o/model b/components/mpas-o/model index f2adff7a58cc..48a9ae9250b0 160000 --- a/components/mpas-o/model +++ b/components/mpas-o/model @@ -1 +1 @@ -Subproject commit f2adff7a58cc15f163ce2b624245a4b3ba18d25e +Subproject commit 48a9ae9250b0e0fa54ccf844b3ae7f668cdc7b0c From fe45b0ced4748609f49d79b383a551db762a51be Mon Sep 17 00:00:00 2001 From: Azamat Mametjanov Date: Fri, 14 Jul 2017 17:50:06 +0000 Subject: [PATCH 12/68] Swap mem highwater and usage logs for memleak tests --- cime/src/drivers/mct/main/cesm_comp_mod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/cime/src/drivers/mct/main/cesm_comp_mod.F90 b/cime/src/drivers/mct/main/cesm_comp_mod.F90 index 2395d47b2227..dbd3efbb2eba 100644 --- a/cime/src/drivers/mct/main/cesm_comp_mod.F90 +++ b/cime/src/drivers/mct/main/cesm_comp_mod.F90 @@ -3831,7 +3831,7 @@ subroutine cesm_run() call shr_mem_getusage(msize,mrss,.true.) write(logunit,105) ' memory_write: model date = ',ymd,tod, & - ' memory = ',mrss,' MB (usage) ',msize,' MB (highwater)', & + ' memory = ',msize,' MB (highwater) ',mrss,' MB (usage)', & ' (pe=',iam_GLOID,' comps=',trim(complist)//')' endif endif From 15173b7c0ae72ab256ac29805760b0a1282fd927 Mon Sep 17 00:00:00 2001 From: Sean Patrick Santos Date: Fri, 14 Jul 2017 14:52:09 -0700 Subject: [PATCH 13/68] Enforce MG2 precondition for 'in_cloud' method. Add a limiter that requires the precipitation fraction calculated by MG2's 'in_cloud' method to be at least as great as the cloud fraction. As currently written, MG2 assumes that the fraction of a level containing cloud is a subset of the fraction of a level containing precipitation. Therefore we should require the precipitation fraction to be greater than or equal to the current cloud fraction for consistency. While the previous behavior should be considered a bug, the effect of this change is expected to be negligible for several reasons: 1) The inconsistent state (in this case, precip_frac < cldm) is only possible if there is a significant cloud fraction in a level that has negligible cloud mass. Depending on the model configuration, this might be either rare or impossible. (In the latter case, this change is bit-for-bit.) 2) Even if the precipitation fraction does drop below the cloud fraction, the two values will likely be similar. 3) Processes that involve interactions between precipitation and clouds will be shut off if there is no cloud mass. 4) The code controlling evaporation/sublimation code, while it does use both the precipitation and cloud fractions, contains a limiter that causes it to ignore the cloud fraction when the cloud mass is small. [non-BFB] --- components/cam/src/physics/cam/micro_mg2_0.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/components/cam/src/physics/cam/micro_mg2_0.F90 b/components/cam/src/physics/cam/micro_mg2_0.F90 index 85720f5a5403..5881c2c49c15 100644 --- a/components/cam/src/physics/cam/micro_mg2_0.F90 +++ b/components/cam/src/physics/cam/micro_mg2_0.F90 @@ -1240,7 +1240,7 @@ subroutine micro_mg_tend ( & if (k /= 1) then where (qc(:,k) < qsmall .and. qi(:,k) < qsmall) - precip_frac(:,k) = precip_frac(:,k-1) + precip_frac(:,k) = max(precip_frac(:,k-1),precip_frac(:,k)) end where endif From 529b1fd5add08b93fd727778dc32ed1514e0768f Mon Sep 17 00:00:00 2001 From: Azamat Mametjanov Date: Fri, 14 Jul 2017 19:14:00 -0500 Subject: [PATCH 14/68] Bebop machine config entry --- cime/config/acme/machines/config_machines.xml | 59 +++++++++++++++++++ 1 file changed, 59 insertions(+) diff --git a/cime/config/acme/machines/config_machines.xml b/cime/config/acme/machines/config_machines.xml index 59acde27baa0..8d49cc9727be 100644 --- a/cime/config/acme/machines/config_machines.xml +++ b/cime/config/acme/machines/config_machines.xml @@ -1027,6 +1027,65 @@ + + ANL/LCRC Cluster, Cray CS400, 352-nodes Xeon Phi 7230 KNLs 64C/1.3GHz + 672-nodes Xeon E5-2695v4 Broadwells 36C/2.10GHz, Intel Omni-Path network, SLURM batch system, Lmod module environment. + bebop + acme_developer + intel,gnu + mpt + $ENV{HOME}/acme_scratch/bebop + $CIME_OUTPUT_ROOT/$CASE/run + $CIME_OUTPUT_ROOT/$CASE/bld + /home/ccsm-data/inputdata + /home/ccsm-data/inputdata/atm/datm7 + $CIME_OUTPUT_ROOT/archive/$CASE + csm/$CASE + /lcrc/group/earthscience/acme_baselines + /home/ccsm-data/tools/cprnc + CNL + slurm + acme + 8 + 36 + 36 + acme + TRUE + -D PIO_BUILD_TIMING:BOOL=ON + + srun + + --label + -n $TOTALPES + + + + module + module + + intel + gcc + cmake + + + intel/17.0.4-74uvhji + intel-mkl/2017.3.196-jyjmyut + + + gcc/7.1.0-4bgguyp + + + cmake/2.8.12.2-qndad62 + mpich/3.2-5koqqym + netcdf/4.4.1.1-prsuusl + + + + 128M + spread + threads + + + ANL IBM BG/Q, os is BGQ, 16 cores/node, batch system is cobalt cetus From 2faeb8e8aeb65dd5a9e540e21412679b3afdd155 Mon Sep 17 00:00:00 2001 From: Jinyun Tang Date: Mon, 19 Jun 2017 16:38:10 -0700 Subject: [PATCH 15/68] initialize sbetr submodule for betr-v2 integration Include sbetr as a submodule for betr-v2 integration. No test has been done, and no change is expected due to the inclusion of betr. [BFB] --- .gitmodules | 3 +++ components/clm/src/external_models/sbetr | 1 + 2 files changed, 4 insertions(+) create mode 160000 components/clm/src/external_models/sbetr diff --git a/.gitmodules b/.gitmodules index 043e17168c8b..1339847f460e 100644 --- a/.gitmodules +++ b/.gitmodules @@ -16,3 +16,6 @@ path = components/clm/src/external_models/mpp url = git@github.com:ACME-Climate/mpp.git branch = alm/develop +[submodule "sbetr"] + path = components/clm/src/external_models/sbetr + url = git@github.com:ACME-Climate/sbetr.git diff --git a/components/clm/src/external_models/sbetr b/components/clm/src/external_models/sbetr new file mode 160000 index 000000000000..f85c283debe0 --- /dev/null +++ b/components/clm/src/external_models/sbetr @@ -0,0 +1 @@ +Subproject commit f85c283debe0de53538a72f1de3d58f2e163dd0d From f2017158afd7a916716f63fb84c2b1dcbf80b91d Mon Sep 17 00:00:00 2001 From: Jinyun Tang Date: Thu, 6 Jul 2017 10:50:26 -0700 Subject: [PATCH 16/68] Replace betr-v1 with betr-v2 Now betr-v1 is repalced wtih betr-v2. When betr is on, the code run smoothly with intel compilers >15.x, and gnu compilers >5.x on edison. The test suite will be run for edison in the next commit and no answer change is expected for simulations with betr off. --- components/clm/bld/configure | 19 +- .../namelist_definition_clm4_5.xml | 28 +- .../clm/src/betr/BGCReactionsFactoryMod.F90 | 76 - .../clm/src/betr/SOMStateVarUpdateMod.F90 | 33 - .../clm/src/betr/betr_core/BeTRTracerType.F90 | 260 -- .../clm/src/betr/betr_core/KineticsMod.F90 | 362 -- .../betr/betr_core/TracerBoundaryCondType.F90 | 168 - .../clm/src/betr/betr_core/Tracer_varcon.F90 | 89 - .../clm/src/betr/betr_core/TransportMod.F90 | 917 ----- .../clm/src/betr/betr_initializeMod.F90 | 138 - .../clm/src/betr/betr_math/FindRootMod.F90 | 935 ------ .../src/betr/betr_math/InterpolationMod.F90 | 357 -- .../clm/src/betr/betr_math/MathfuncMod.F90 | 432 --- components/clm/src/betr/betr_math/ODEMod.F90 | 594 ---- .../src/betr/bgc_century/BGCCenturyParMod.F90 | 557 ---- .../src/biogeochem/CNAllocationBetrMod.F90 | 2703 ++++++++++----- .../clm/src/biogeochem/CNBeTRIndicatorMod.F90 | 77 + .../clm/src/biogeochem/CNCStateUpdate1Mod.F90 | 31 +- .../clm/src/biogeochem/CNCStateUpdate2Mod.F90 | 35 +- .../clm/src/biogeochem/CNCStateUpdate3Mod.F90 | 27 - .../clm/src/biogeochem/CNCarbonFluxType.F90 | 7 + .../clm/src/biogeochem/CNCarbonStateType.F90 | 18 +- .../src/biogeochem/CNEcosystemDynBetrMod.F90 | 927 +++--- .../src/biogeochem/CNGapMortalityBeTRMod.F90 | 621 ++++ .../clm/src/biogeochem/CNNDynamicsMod.F90 | 5 +- .../src/biogeochem/CNNStateUpdate1BeTRMod.F90 | 221 ++ .../clm/src/biogeochem/CNNStateUpdate1Mod.F90 | 50 +- .../src/biogeochem/CNNStateUpdate2BeTRMod.F90 | 177 + .../clm/src/biogeochem/CNNStateUpdate2Mod.F90 | 31 - .../src/biogeochem/CNNStateUpdate3BeTRMod.F90 | 122 + .../clm/src/biogeochem/CNNStateUpdate3Mod.F90 | 27 - .../clm/src/biogeochem/CNNitrogenFluxType.F90 | 74 +- .../src/biogeochem/CNNitrogenStateType.F90 | 49 +- .../clm/src/biogeochem/CNPhenologyBeTRMod.F90 | 2957 +++++++++++++++++ .../clm/src/biogeochem/PStateUpdate1Mod.F90 | 4 +- .../clm/src/biogeochem/PStateUpdate2Mod.F90 | 7 +- .../clm/src/biogeochem/PStateUpdate3Mod.F90 | 58 +- .../clm/src/biogeochem/PhosphorusFluxType.F90 | 9 + .../src/biogeochem/PhosphorusStateType.F90 | 13 +- .../src/biogeochem/PlantMicKineticsMod.F90 | 98 + .../src/biogeophys/HydrologyDrainageMod.F90 | 16 +- .../src/biogeophys/HydrologyNoDrainageMod.F90 | 37 +- .../clm/src/biogeophys/SoilHydrologyType.F90 | 2 + .../src/biogeophys/SoilWaterMovementMod.F90 | 22 +- .../clm/src/biogeophys/WaterStateType.F90 | 32 +- .../clm/src/biogeophys/WaterfluxType.F90 | 8 +- components/clm/src/data_types/CNStateType.F90 | 5 +- components/clm/src/external_models/sbetr | 2 +- components/clm/src/main/clm_driver.F90 | 232 +- components/clm/src/main/clm_initializeMod.F90 | 41 +- components/clm/src/main/clm_instMod.F90 | 11 +- components/clm/src/main/controlMod.F90 | 6 +- components/clm/src/main/lnd2atmType.F90 | 9 + components/clm/src/main/readParamsMod.F90 | 54 +- components/clm/src/main/restFileMod.F90 | 27 +- 55 files changed, 7032 insertions(+), 6785 deletions(-) delete mode 100644 components/clm/src/betr/BGCReactionsFactoryMod.F90 delete mode 100644 components/clm/src/betr/SOMStateVarUpdateMod.F90 delete mode 100644 components/clm/src/betr/betr_core/BeTRTracerType.F90 delete mode 100644 components/clm/src/betr/betr_core/KineticsMod.F90 delete mode 100644 components/clm/src/betr/betr_core/TracerBoundaryCondType.F90 delete mode 100644 components/clm/src/betr/betr_core/Tracer_varcon.F90 delete mode 100644 components/clm/src/betr/betr_core/TransportMod.F90 delete mode 100644 components/clm/src/betr/betr_initializeMod.F90 delete mode 100644 components/clm/src/betr/betr_math/FindRootMod.F90 delete mode 100644 components/clm/src/betr/betr_math/InterpolationMod.F90 delete mode 100644 components/clm/src/betr/betr_math/MathfuncMod.F90 delete mode 100644 components/clm/src/betr/betr_math/ODEMod.F90 delete mode 100644 components/clm/src/betr/bgc_century/BGCCenturyParMod.F90 create mode 100644 components/clm/src/biogeochem/CNBeTRIndicatorMod.F90 create mode 100644 components/clm/src/biogeochem/CNGapMortalityBeTRMod.F90 create mode 100644 components/clm/src/biogeochem/CNNStateUpdate1BeTRMod.F90 create mode 100644 components/clm/src/biogeochem/CNNStateUpdate2BeTRMod.F90 create mode 100644 components/clm/src/biogeochem/CNNStateUpdate3BeTRMod.F90 create mode 100644 components/clm/src/biogeochem/CNPhenologyBeTRMod.F90 create mode 100644 components/clm/src/biogeochem/PlantMicKineticsMod.F90 diff --git a/components/clm/bld/configure b/components/clm/bld/configure index fe2439c52ca7..fb77ba42c0ff 100755 --- a/components/clm/bld/configure +++ b/components/clm/bld/configure @@ -646,11 +646,6 @@ sub write_filepath_cesmbld # source directories under root my @dirs = ( "main", "data_types", - "betr", - "betr/betr_math", - "betr/betr_core", - "betr/bgc_century", - "betr/bgc_sminn", "biogeophys", "biogeochem", "dyn_subgrid", @@ -663,6 +658,20 @@ sub write_filepath_cesmbld "external_models/mpp/src/mpp/util", "external_models/mpp/src/mpp/vsfm", "external_models/emi/src/", + "external_models/sbetr/src/betr/betr_core", + "external_models/sbetr/src/betr/betr_dtype", + "external_models/sbetr/src/betr/betr_bgc", + "external_models/sbetr/src/betr/betr_grid", + "external_models/sbetr/src/betr/betr_para", + "external_models/sbetr/src/betr/betr_main", + "external_models/sbetr/src/betr/betr_math", + "external_models/sbetr/src/betr/betr_rxns", + "external_models/sbetr/src/betr/betr_util", + "external_models/sbetr/src/driver/shared", + "external_models/sbetr/src/driver/alm", + "external_models/sbetr/src/Applications/app_util", + "external_models/sbetr/src/Applications/soil-farm/bgcfarm_util", + "external_models/sbetr/src/Applications/soil-farm/CENT_ECACNP", "utils", "cpl" ); diff --git a/components/clm/bld/namelist_files/namelist_definition_clm4_5.xml b/components/clm/bld/namelist_files/namelist_definition_clm4_5.xml index 82eaaa0752d4..632c37e2c481 100644 --- a/components/clm/bld/namelist_files/namelist_definition_clm4_5.xml +++ b/components/clm/bld/namelist_files/namelist_definition_clm4_5.xml @@ -1379,11 +1379,35 @@ Set to alblak values (0.6, 0.4) to keep albedo constant for ice-covered lakes wi - -Specify what bgc module will be used within the betr framework. +Specify what reaction module will be used within the betr framework. + +Specify file to input parameters that will be used within the betr framework. + + + +Turn on advection in betr if it is true. + + + +Turn on diffusion in betr if it is true. + + + +Turn on ebullition in betr if it is true. + + + +Turn on reaction in betr if it is true. + diff --git a/components/clm/src/betr/BGCReactionsFactoryMod.F90 b/components/clm/src/betr/BGCReactionsFactoryMod.F90 deleted file mode 100644 index ffc441759773..000000000000 --- a/components/clm/src/betr/BGCReactionsFactoryMod.F90 +++ /dev/null @@ -1,76 +0,0 @@ -module BGCReactionsFactoryMod - ! - ! !DESCRIPTION: - ! factory to load the specific bgc reaction modules - ! - ! History: - ! Created by Jinyun Tang, Oct 2, 2014 - ! - ! - ! !USES: - ! - use shr_kind_mod , only : r8 => shr_kind_r8 - use decompMod , only : bounds_type - use shr_log_mod , only : errMsg => shr_log_errMsg - implicit none - save - private - public :: ctreate_bgc_reaction_type - - -contains - - function ctreate_bgc_reaction_type(method) result(bgc_reaction) - ! - ! !DESCRIPTION: - ! create and return an object of bgc_reaction - ! - ! !USES: - use BGCReactionsMod , only : bgc_reaction_type - use BGCReactionsMockRunType , only : bgc_reaction_mock_run_type - use BGCReactionsCenturyType , only : bgc_reaction_CENTURY_type - use BGCReactionsCenturyCLMType , only : bgc_reaction_CENTURY_clm_type - use BGCReactionsCenturyECAType , only : bgc_reaction_CENTURY_ECA_type - use BGCReactionsSminNType , only : bgc_reaction_sminn_type - use BGCReactionsCenturyCLM3Type , only : bgc_reaction_CENTURY_clm3_type - use BGCReactionsCenturyCLMOType , only : bgc_reaction_CENTURY_clmo_type - use abortutils , only : endrun - use clm_varctl , only : iulog - use tracer_varcon , only : is_active_betr_bgc, do_betr_leaching - - ! !ARGUMENTS: - class(bgc_reaction_type), allocatable :: bgc_reaction - character(len=*), intent(in) :: method - character(len=*), parameter :: subname = 'ctreate_bgc_reaction_type' - - select case(trim(method)) - case ("mock_run") - allocate(bgc_reaction, source=bgc_reaction_mock_run_type()) - case ("century_bgc") - is_active_betr_bgc = .true. - allocate(bgc_reaction, source=bgc_reaction_CENTURY_type()) - case ("century_bgcclm") - is_active_betr_bgc = .true. - allocate(bgc_reaction, source=bgc_reaction_CENTURY_clm_type()) - case ("century_bgcECA") - is_active_betr_bgc = .true. - allocate(bgc_reaction, source=bgc_reaction_CENTURY_ECA_type()) - case ("century_bgcclm3") - is_active_betr_bgc=.true. - allocate(bgc_reaction, source=bgc_reaction_CENTURY_clm3_type()) - case ("century_bgcclmo") - is_active_betr_bgc=.true. - allocate(bgc_reaction, source=bgc_reaction_CENTURY_clmo_type()) - case ("betr_sminn") - !this must be used together with clm45bgc - do_betr_leaching = .true. - allocate(bgc_reaction, source=bgc_reaction_sminn_type()) - !case ("o18_istope") ! on hold - ! allocate(bgc_reaction, source=bgc_reaction_O18ISO_type()) - case default - write(iulog,*)subname //' ERROR: unknown method: ', method - call endrun(msg=errMsg(__FILE__, __LINE__)) - end select - end function ctreate_bgc_reaction_type - -end module BGCReactionsFactoryMod diff --git a/components/clm/src/betr/SOMStateVarUpdateMod.F90 b/components/clm/src/betr/SOMStateVarUpdateMod.F90 deleted file mode 100644 index bdd8ab8b5ca6..000000000000 --- a/components/clm/src/betr/SOMStateVarUpdateMod.F90 +++ /dev/null @@ -1,33 +0,0 @@ -module SOMStateVarUpdateMod - ! - ! DESCRIPTION: - ! subroutines to update state variables of any - ! reaction based bgc module - ! !USES: - use shr_kind_mod , only: r8 => shr_kind_r8 - implicit none - public :: calc_dtrend_som_bgc - -contains - - !----------------------------------------------------------------------- - subroutine calc_dtrend_som_bgc(nx, ny, cascade_matrix, reaction_rates, dxdt) - ! - ! !DESCRIPTION: - ! return the temporal trend of the state variables - implicit none - ! !ARGUMENTS: - integer, intent(in) :: nx, ny - real(r8), intent(in) :: cascade_matrix(1:nx,1:ny) - real(r8), intent(in) :: reaction_rates(1:ny) - real(r8), intent(out):: dxdt(1:nx) - - !intel mkl f90 interface - !call gemv(cascade_matrix, reaction_rates, dxdt, alpha=1._r8, beta=0._r8) - ! BLAS INTERFACE - ! DGEMV(TRANS,M,N,ALPHA,A,LDA,X,INCX,BETA,Y,INCY) - call dgemv('N', nx, ny, 1._r8, cascade_matrix, nx, reaction_rates, 1, 0._r8, dxdt, 1) - - end subroutine calc_dtrend_som_bgc - -end module SOMStateVarUpdateMod diff --git a/components/clm/src/betr/betr_core/BeTRTracerType.F90 b/components/clm/src/betr/betr_core/BeTRTracerType.F90 deleted file mode 100644 index 5864451652b5..000000000000 --- a/components/clm/src/betr/betr_core/BeTRTracerType.F90 +++ /dev/null @@ -1,260 +0,0 @@ -module BeTRTracerType - !------------------------------------------------------------------------------ - ! !DESCRIPTION: - ! data type to configure betr simulations - ! - ! !USES: - use shr_kind_mod , only: r8 => shr_kind_r8 - use decompMod , only : bounds_type - ! - implicit none - private - - - !---------------------------------------------------- - !betr tracer setup structure - !---------------------------------------------------- - type, public :: BeTRtracer_type - character(len=255) :: betr_simname ! name of the simulation - integer :: nmem_max ! maximum number of members in a transport group - integer :: ntracers ! total number of tracers, gas/aqueous tracers + solid tracers that undergo active mineral protection - integer :: ngwmobile_tracers ! total number of tracers potentially undergoing gas/aqueous movement - integer :: nvolatile_tracers ! number of volatile_tracers - integer :: nsolid_equil_tracers ! number of tracers that undergo equilibrium adsorption in soil could include adsorbed doc, nh4(+) - integer :: nsolid_passive_tracers ! number of tracers that undergo active mineral protection - - integer :: ntracer_groups ! - integer :: ngwmobile_tracer_groups ! total number of groups for mobile tracers - integer :: nvolatile_tracer_groups ! sub group within gwmobile group - integer :: nsolid_equil_tracer_groups ! sub group in solid group - integer :: nsolid_passive_tracer_groups ! sub group in solid group - - integer :: nh2o_tracers ! number of h2o tracers, this will be used to compute vapor gradient and thermal gradient driven isotopic flow - logical :: is_oddstep = .true. !this is not used now, originally was included to set up alternative numerical methods - integer :: id_trc_n2 ! tag for n2 - integer :: id_trc_o2 ! tag for co2 - integer :: id_trc_ar ! tag for ar - integer :: id_trc_co2x ! tag for co2 and its related species, co2x(CO2, H2CO3, HCO3(-), CO3(2-)), - integer :: id_trc_ch4 ! tag for methane - - integer :: id_trc_no ! tag for no - integer :: id_trc_n2o ! tag for n2o - integer :: id_trc_air_co2x ! tag for atmospheric co2 - integer :: id_trc_arrt_co2x ! tag for autotrophic co2 - integer :: id_trc_hrsoi_co2x ! tag for heterotrophic co2 - integer :: id_trc_nh3x ! tag for nh3 and its related species, nh3x(NH3, NH4OH,NH4(+)) - integer :: id_trc_no3x ! tag for no3 and its related species, no3x(HNO3,NO3(-)) - integer :: id_trc_no2x ! tag for no2 and its related species, no2x(HNO2,NO2(-)) - integer :: id_trc_dom ! tag for generic dissolved organic matter - integer :: id_trc_doc ! tag for generic dissolved organic carbon, used for testing single carbon pool model - - - integer :: id_trc_o18_h2o ! tag for H2O(18) - integer :: id_trc_o17_h2o ! tag for H2O(17) - integer :: id_trc_o18_h2o_ice ! tag for H2O(18) in ice - integer :: id_trc_d_h2o ! tag for DHO - integer :: id_trc_d_h2o_ice ! tag for DHO in ice - integer :: id_trc_c13_co2x ! tag for C(13)O2 and its related species - integer :: id_trc_c14_co2x ! tag for C(14)O2 and its related species - integer :: id_trc_o18_co2x ! tag for O(18)CO and its related species - integer :: id_trc_o17_co2x ! tag for O(17)CO and its related species - - integer :: id_trc_o18_o2 ! tag for O(18)O and its related species - integer :: id_trc_o17_o2 ! tag for O(17)O and its related species - integer, pointer :: id_trc_h2o_tags(:) !tagged h2o tracers - - logical, pointer :: is_volatile(:) !flag for volatile species, true/false, (yes/no) - logical, pointer :: is_diffusive(:) - logical, pointer :: is_adsorb(:) !flag for adsorbable species, true/false (year/no), in equilibrium with aqueous phase and/or gaseous phase - logical, pointer :: is_advective(:) !flag for advective species, some species, like non-dissolved som does not undergo advection, rather bioturbation is the major mechanism for vertical transport - logical, pointer :: is_mobile(:) !flag indicating whether the tracer is mobile or inert, when it is innert, do not move it around - logical, pointer :: is_h2o(:) !flag for water isotope - logical, pointer :: is_co2tag(:) !tagged co2 tracer? - logical, pointer :: is_dom(:) !true if it is a dom tracer, place holder for rtm bgc - logical, pointer :: is_isotope(:) - integer, pointer :: refisoid(:) !reference tracer for isotope calculation, this is setup only for non-h2o isotope now - integer, pointer :: adsorbid(:) !which tracer is adsorbed - integer, pointer :: volatileid(:) - integer, pointer :: h2oid(:) - integer, pointer :: adsorbgroupid(:) - integer, pointer :: volatilegroupid(:) ! - integer, pointer :: groupid(:) - - logical :: is_tagged_h2o =.false. !no tagged h2o run by default - real(r8),pointer :: tracer_solid_passive_diffus_scal_group(:) !reference diffusivity for solid phase tracer, for modeling turbation - real(r8),pointer :: tracer_solid_passive_diffus_thc_group(:) !threshold diffusivity for solid phase tracer, for modeling turbation - - integer, pointer :: solid_passive_tracer_groupid(:,:) - integer, pointer :: tracer_group_memid(:,:) !grp, gmem - character(len=36),pointer :: tracernames(:) !array with tracer names - real(r8),pointer :: gram_mole_wt(:) !molecular weight of the master species, [g/mol] - real(r8),pointer :: vtrans_scal(:) !scaling factor for plant tracer uptake through transpiration, for non-water neutral aqueous tracers - - contains - procedure, public :: Init - procedure, public :: init_scalars - procedure, public :: set_tracer - procedure, private :: InitAllocate - end type BeTRtracer_type - - - - contains - - - subroutine Init(this) - - implicit none - class(BeTRtracer_type) :: this - - this%ntracers=this%ngwmobile_tracers+this%nsolid_passive_tracers - this%ntracer_groups = this%nsolid_passive_tracer_groups + this%ngwmobile_tracer_groups - - call this%InitAllocate() - end subroutine Init -!-------------------------------------------------------------------------------- - subroutine init_scalars(this) - - ! !DESCRIPTION: - ! initilaize scalar variables within the type - - implicit none - class(BeTRtracer_type) :: this - - this%ntracers = 0 ! total number of tracers, gas/aqueous tracers + solid tracers that undergo active mineral protection - this%ngwmobile_tracers = 0 ! total number of tracers undergoing gas/aqueous movement - this%nvolatile_tracers = 0 ! number of volatile_tracers - this%nsolid_equil_tracers = 0 ! number of tracers that undergo equilibrium adsorption in soil could include adsorbed doc, nh4(+) - this%nsolid_passive_tracers = 0 ! number of tracers that undergo active mineral protection - - this%ntracer_groups = 0 - this%ngwmobile_tracer_groups = 0 - this%nvolatile_tracer_groups = 0 - this%nsolid_equil_tracer_groups = 0 - this%nsolid_passive_tracer_groups = 0 - - this%nh2o_tracers = 0 ! number of h2o tracers, this will be used to compute vapor gradient and thermal gradient driven isotopic flow - this%is_oddstep = .true. !this is not used now, originally was included to set up alternative numerical methods - - - this%id_trc_ch4 = 0 ! tag for methane - this%id_trc_o2 = 0 ! tag for co2 - this%id_trc_n2 = 0 ! tag for n2 - this%id_trc_no = 0 ! tag for no - this%id_trc_n2o = 0 ! tag for n2o - this%id_trc_ar = 0 ! tag for ar - this%id_trc_air_co2x = 0 ! tag for atmospheric co2 - this%id_trc_arrt_co2x = 0 ! tag for autotrophic co2 - this%id_trc_hrsoi_co2x = 0 ! tag for heterotrophic co2 - - this%id_trc_co2x = 0 ! tag for co2 and its related species, co2x(CO2, H2CO3, HCO3(-), CO3(2-)), - this%id_trc_nh3x = 0 ! tag for nh3 and its related species, nh3x(NH3, NH4OH,NH4(+)) - this%id_trc_no3x = 0 ! tag for no3 and its related species, no3x(HNO3,NO3(-)) - this%id_trc_no2x = 0 ! tag for no2 and its related species, no2x(HNO2,NO2(-)) - this%id_trc_dom = 0 ! tag for generic dissolved organic matter - - - this%id_trc_o18_h2o = 0 ! tag for H2O(18) - this%id_trc_o17_h2o = 0 ! tag for H2O(17) - this%id_trc_d_h2o = 0 ! tag for DHO - this%id_trc_c13_co2x = 0 ! tag for C(13)O2 and its related species - this%id_trc_c14_co2x = 0 ! tag for C(14)O2 and its related species - this%id_trc_o18_co2x = 0 ! tag for O(18)CO and its related species - this%id_trc_o17_co2x = 0 ! tag for O(17)CO and its related species - this%id_trc_o18_h2o_ice = 0 ! tag for H2O(18) in ice - this%id_trc_d_h2o_ice = 0 ! tag for HDO in ice - this%id_trc_o18_o2 = 0 ! tag for O(18)O and its related species - this%id_trc_o17_o2 = 0 ! tag for O(17)O and its related species - - this%betr_simname = '' - end subroutine init_scalars - - -!-------------------------------------------------------------------------------- - subroutine InitAllocate(this) - - ! !DESCRIPTION: - ! allocate memories for vectors - - implicit none - class(BeTRtracer_type) :: this - integer, parameter :: nanid=-1 - - allocate(this%is_volatile (this%ngwmobile_tracers)); this%is_volatile(:) = .false. - allocate(this%is_adsorb (this%ngwmobile_tracers)); this%is_adsorb(:) = .false. - allocate(this%is_advective (this%ntracers)); this%is_advective(:) = .false. - allocate(this%is_diffusive (this%ntracers)); this%is_diffusive(:) = .false. - allocate(this%is_mobile (this%ntracers)); this%is_mobile(:) = .false. - allocate(this%is_h2o (this%ngwmobile_tracers)); this%is_h2o(:) = .false. - allocate(this%is_co2tag (this%ngwmobile_tracers)); this%is_co2tag(:) = .false. - allocate(this%is_dom (this%ngwmobile_tracers)); this%is_dom(:) = .false. - allocate(this%is_isotope (this%ngwmobile_tracers)); this%is_isotope(:) = .false. - - allocate(this%adsorbgroupid (this%ngwmobile_tracers)); this%adsorbgroupid(:) = nanid - allocate(this%adsorbid (this%ngwmobile_tracers)); this%adsorbid(:) = nanid - - allocate(this%volatileid (this%ngwmobile_tracers)); this%volatileid(:) = nanid - allocate(this%volatilegroupid (this%ngwmobile_tracers)); this%volatilegroupid(:) = nanid - allocate(this%h2oid (this%nh2o_tracers)); this%h2oid(:) = nanid - allocate(this%id_trc_h2o_tags (this%nh2o_tracers)); this%id_trc_h2o_tags(:) = nanid - allocate(this%tracernames (this%ntracers)); this%tracernames(:) = '' - allocate(this%vtrans_scal (this%ngwmobile_tracers)); this%vtrans_scal(:) = 0._r8 !no transport through xylem transpiration - - allocate(this%tracer_solid_passive_diffus_scal_group(this%nsolid_passive_tracer_groups)); this%tracer_solid_passive_diffus_scal_group(:) = 1._r8 - allocate(this%tracer_solid_passive_diffus_thc_group (this%nsolid_passive_tracer_groups)); this%tracer_solid_passive_diffus_thc_group(:) = 1e-4_r8 / (86400._r8 * 365._r8) * 1.e-36_r8 - - allocate(this%tracer_group_memid(this%ntracer_groups, this%nmem_max)); this%tracer_group_memid(:,:) = nanid - - allocate(this%solid_passive_tracer_groupid(this%nsolid_passive_tracer_groups, 1:this%nmem_max)); this%solid_passive_tracer_groupid(:,:) = nanid - - allocate(this%groupid(this%ntracers)); this%groupid(:) = nanid - - end subroutine InitAllocate - -!-------------------------------------------------------------------------------- - - subroutine set_tracer(this, trc_id, trc_name, is_trc_mobile, is_trc_advective, trc_group_id, & - trc_group_mem, is_trc_diffusive, is_trc_volatile, trc_volatile_id, trc_volatile_group_id,trc_vtrans_scal) - - ! !DESCRIPTION: - ! set up tracer property based on input configurations - - ! !ARGUMENTS: - class(BeTRtracer_type) :: this - integer , intent(in) :: trc_id - character(len=*) , intent(in) :: trc_name - logical , intent(in) :: is_trc_mobile - logical , intent(in) :: is_trc_advective - integer , intent(in) :: trc_group_id - integer , intent(in) :: trc_group_mem - - logical, optional , intent(in) :: is_trc_diffusive - logical, optional , intent(in) :: is_trc_volatile - integer, optional , intent(in) :: trc_volatile_id - integer, optional , intent(in) :: trc_volatile_group_id - real(r8),optional , intent(in) :: trc_vtrans_scal - - this%tracernames (trc_id) = trim(trc_name) - this%is_mobile (trc_id) = is_trc_mobile - this%groupid (trc_id) = trc_group_id - this%tracer_group_memid(trc_group_id,trc_group_mem) = trc_id - - this%is_advective (trc_id) = is_trc_advective - - if(present(is_trc_diffusive)) this%is_diffusive (trc_id) = is_trc_diffusive - if(present(is_trc_volatile))then - this%is_volatile (trc_id) = is_trc_volatile - if(this%is_volatile (trc_id)) then - this%volatileid (trc_id) = trc_volatile_id - this%volatilegroupid(trc_id) = trc_volatile_group_id - endif - endif - if(present(trc_vtrans_scal))then - this%vtrans_scal(trc_id) = trc_vtrans_scal - endif - - - end subroutine set_tracer - - -end module BeTRTracerType diff --git a/components/clm/src/betr/betr_core/KineticsMod.F90 b/components/clm/src/betr/betr_core/KineticsMod.F90 deleted file mode 100644 index e96d9e980599..000000000000 --- a/components/clm/src/betr/betr_core/KineticsMod.F90 +++ /dev/null @@ -1,362 +0,0 @@ -module KineticsMod - ! !DESCRIPTION: - ! Subroutines to do substrate kinetics - ! Created by Jinyun Tang, Apr 11, 2013 - ! !USES: - - use shr_kind_mod, only: r8 => shr_kind_r8 - use abortutils, only: endrun - use clm_varctl, only: iulog - implicit none - real(r8),public, parameter :: kd_infty = 1.e40_r8 !internal parameter - - interface mmcomplex !the m-m kinetics - module procedure mmcomplex_v1s,mmcomplex_v1e, mmcomplex_m - end interface mmcomplex - - interface ecacomplex !the eca kinetics - module procedure ecacomplex_v1s,ecacomplex_v1e, ecacomplex_m - end interface ecacomplex - - interface ecacomplex_cell_norm !the eca kinetics - module procedure ecacomplex_cell_norm_v1s,ecacomplex_cell_norm_v1e, ecacomplex_cell_norm_m - end interface ecacomplex_cell_norm - -contains - !------------------------------------------------------------------------------- - subroutine mmcomplex_v1s(kd,ee,ss,siej) - - ! !DESCRIPTION: - ! Compute concentrations of the enzyme substrate complexes - ! many microbes vs single substrate - ! using the traditional M-M kinetics - - ! !USES: - - implicit none - ! !ARGUMENTS: - real(r8), dimension(:), intent(in) :: kd - real(r8), dimension(:), intent(in) :: ee - real(r8), intent(in) :: ss - real(r8), dimension(:), intent(out) :: siej - - ! !LOCAL VARIABLES: - integer :: jj, j - real(r8) :: dS - jj = size(ee) - siej = 0._r8 - - do j = 1, jj - if(kd(j)>0._r8 .and. (kd(j)<.9*kd_infty))then - siej(j) = ss * ee(j) / (kd(j) + ss) - endif - enddo - ds = sum(siej) - if(ds>ss)then - do j = 1, jj - siej(j) = siej(j) * ss / ds - enddo - endif - - end subroutine mmcomplex_v1s - !------------------------------------------------------------------------------- - subroutine mmcomplex_v1e(kd,ee,ss,siej) - ! !DESCRIPTION: - !compute concentrations of the enzyme substrate complexes - !using the traditional M-M kinetics - !many substrates vs single microbe - - implicit none - ! !ARGUMENTS: - real(r8), dimension(:), intent(in) :: kd - real(r8), dimension(:), intent(in) :: ss - real(r8), intent(in) :: ee - real(r8), dimension(:), intent(out) :: siej - - ! !LOCAL VARIABLES - integer :: ii - integer :: i - real(r8) :: dE - ii = size(ss) - siej = 0._r8 - - do i = 1, ii - if(kd(i)>0._r8 .and. (kd(i)<.9*kd_infty))then - siej(i) = ss(i) * ee / (kd(i) + ss(i)) - endif - enddo - dE = sum(siej) - if(dE>ee)then - do i = 1, ii - siej(i) = siej(i) * ee / dE - enddo - endif - - end subroutine mmcomplex_v1e - !------------------------------------------------------------------------------- - subroutine mmcomplex_m(kd,ee,ss,siej) - ! !DESCRIPTION: - !compute concentrations of the enzyme substrate complexes - !using the traditional M-M kinetics - !many substrates vs many microbes - - implicit none - ! !ARGUMENTS: - real(r8), dimension(:,:), intent(in) :: kd - real(r8), dimension(:), intent(in) :: ee, ss - real(r8), dimension(:,:), intent(out) :: siej - - ! !LOCAL VARIABLES: - integer :: ii,jj - integer :: i, j - real(r8) :: dS, dE - - ii = size(ss) - jj = size(ee) - siej = 0._r8 - do i = 1, ii - do j = 1, jj - if(kd(i,j)>0._r8 .and. (kd(i,j)<.9*kd_infty))then - siej(i,j) = ss(i) * ee(j) / (kd(i,j) + ss(i)) - endif - enddo - ds = sum(siej(i,:)) - if(ds>ss(i))then - do j = 1, jj - siej(i,j) = siej(i,j) * ss(i) / ds - enddo - endif - enddo - - do j = 1, jj - dE = sum(siej(:,j)) - if(dE>ee(j))then - do i = 1, ii - siej(i,j) = siej(i,j) * ee(j) / dE - enddo - endif - enddo - end subroutine mmcomplex_m - !------------------------------------------------------------------------------- - subroutine ecacomplex_v1s(kd,ss,ee,siej) - ! !DESCRIPTION: - !compute concentrations of the enzyme substrate complexes - !using the first order accurate ECA kinetics - !many microbes vs one substrate - implicit none - ! !ARGUMENTS: - real(r8), dimension(:), intent(in) :: kd - real(r8), dimension(:), intent(in) :: ee - real(r8), intent(in) :: ss - real(r8), dimension(:), intent(out) :: siej - - ! !LOCAL VARIABLES: - integer :: jj - integer :: j - real(r8) :: dnm2 - - jj = size(ee) - siej = 0._r8 - - dnm2=1._r8 - do j = 1, jj - if(kd(j)>0._r8 .and. (kd(j)<.9*kd_infty))then - dnm2=dnm2 + ee(j)/kd(j) - endif - enddo - do j = 1, jj - if(kd(j)>0._r8 .and. (kd(j)<.9*kd_infty))then - siej(j) = ss*ee(j)/(kd(j)*(dnm2+ss/kd(j))) - endif - enddo - end subroutine ecacomplex_v1s -!------------------------------------------------------------------------------- - subroutine ecacomplex_v1e(kd,ss,ee,siej) - ! !DESCRIPTION: - !compute concentrations of the enzyme substrate complexes - !using the first order accurate ECA kinetics - !many substrate vs single microbe - implicit none - ! !ARGUMENTS: - real(r8), dimension(:), intent(in) :: kd - real(r8), dimension(:), intent(in) :: ss - real(r8), intent(in) :: ee - real(r8), dimension(:), intent(out) :: siej - - ! !LOCAL VARIABLES: - integer :: ii - integer :: i - real(r8) :: dnm1 - - ii = size(ss) - siej = 0._r8 - dnm1=1._r8 - do i = 1, ii - if(kd(i)>0._r8 .and. (kd(i)<.9*kd_infty))then - dnm1 = dnm1 + ss(i)/kd(i) - endif - enddo - do i = 1, ii - if(kd(i)>0._r8 .and. (kd(i)<.9*kd_infty))then - siej(i) = ss(i)*ee/(kd(i)*(dnm1+ee/kd(i))) - endif - enddo - end subroutine ecacomplex_v1e - !------------------------------------------------------------------------------- - subroutine ecacomplex_m(kd,ss,ee,siej) - ! !DESCRIPTION: - !compute concentrations of the enzyme substrate complexes - !using the first order accurate ECA kinetics - ! many substrate vs many enzymes - implicit none - ! !ARGUMENTS: - real(r8), dimension(:,:), intent(in) :: kd - real(r8), dimension(:), intent(in) :: ee, ss - real(r8), dimension(:,:), intent(out) :: siej - - ! !LOCAL VARIABLES: - integer :: ii,jj - integer :: i, j, k - real(r8) :: dnm1, dnm2 - - ii = size(ss) !number of substrates, dim 1 - jj = size(ee) !number of enzymes, dim2 - if(ii/=size(siej,1) .or. jj/=size(siej,2))then - write(iulog,*)'wrong matrix shape in ecacomplex_m' - write(iulog,*)'clm model is stopping' - call endrun() - endif - siej = 0._r8 - do i = 1, ii - dnm1 = 0._r8 - do k = 1, jj - if(kd(i,k)>0._r8 .and. (kd(i,k)<.9*kd_infty))then - dnm1 = dnm1 + ee(k)/kd(i,k) - endif - enddo - do j = 1, jj - dnm2 = 0._r8 - if(kd(i,j)>0._r8 .and. (kd(i,j)<.9*kd_infty) )then - do k = 1, ii - if(kd(k,j)>0._r8 .and. (kd(k,j)<.9*kd_infty))then - dnm2=dnm2 + ss(k)/kd(k,j) - endif - enddo - siej(i,j) = ss(i)*ee(j)/(kd(i,j)*(1._r8+dnm1+dnm2)) - endif - enddo - enddo - end subroutine ecacomplex_m - !------------------------------------------------------------------------------- - subroutine ecacomplex_cell_norm_m(kd,ss,ee,siej) - ! !DESCRIPTION: - ! compute concentrations of the enzyme substrate complexes - ! using the first order accurate ECA kinetics - ! and noramlize the return value with cell abundance - ! many substrates vs many enzymes - implicit none - ! !ARGUMENTS: - real(r8), dimension(:,:), intent(in) :: kd - real(r8), dimension(:), intent(in) :: ee, ss - real(r8), dimension(:,:), intent(out) :: siej - ! !LOCAL VARIABLES: - integer :: ii,jj - integer :: i, j, k - real(r8) :: dnm1, dnm2 - - ii = size(ss) !number of substrates, dim 1 - jj = size(ee) !number of enzymes, dim2 - if(ii/=size(siej,1) .or. jj/=size(siej,2))then - write(iulog,*)'wrong matrix shape in ecacomplex_m' - write(iulog,*)'clm model is stopping' - call endrun() - endif - siej = 0._r8 - do i = 1, ii - dnm1 = 0._r8 - do k = 1, jj - if(kd(i,k)>0._r8 .and. (kd(i,k)<.9*kd_infty))then - dnm1 = dnm1 + ee(k)/kd(i,k) - endif - enddo - do j = 1, jj - dnm2 = 0._r8 - if(kd(i,j)>0._r8 .and. (kd(i,j)<.9*kd_infty))then - do k = 1, ii - if(kd(k,j)>0._r8)then - dnm2=dnm2 + ss(k)/kd(k,j) - endif - enddo - siej(i,j) = ss(i)/(kd(i,j)*(1._r8+dnm1+dnm2)) - endif - enddo - enddo - end subroutine ecacomplex_cell_norm_m - - !------------------------------------------------------------------------------- - subroutine ecacomplex_cell_norm_v1s(kd,ss,ee,siej) - ! !DESCRIPTION: - !compute concentrations of the enzyme substrate complexes - !using the first order accurate ECA kinetics - !many microbes vs one substrate - !and normalize return value with cell abundance - - implicit none - ! !ARGUMENTS: - real(r8), dimension(:), intent(in) :: kd - real(r8), dimension(:), intent(in) :: ee - real(r8), intent(in) :: ss - real(r8), dimension(:), intent(out) :: siej - ! !LOCAL VARIABLES: - integer :: jj - integer :: j - real(r8) :: dnm2 - - jj = size(ee) - siej = 0._r8 - - dnm2=1._r8 - do j = 1, jj - if(kd(j)>0._r8 .and. (kd(j)<.9*kd_infty))then - dnm2=dnm2 + ee(j)/kd(j) - endif - enddo - do j = 1, jj - if(kd(j)>0._r8 .and. (kd(j)<.9*kd_infty))then - siej(j) = ss/(kd(j)*(dnm2+ss/kd(j))) - endif - enddo - end subroutine ecacomplex_cell_norm_v1s - !------------------------------------------------------------------------------- - subroutine ecacomplex_cell_norm_v1e(kd,ss,ee,siej) - ! !DESCRIPTION: - ! compute concentrations of the enzyme substrate complexes - ! using the first order accurate ECA kinetics - ! many substrate vs single microbe - ! and normalize the return value with cell abundance - implicit none - ! !ARGUMENTS: - real(r8), dimension(:), intent(in) :: kd - real(r8), dimension(:), intent(in) :: ss - real(r8), intent(in) :: ee - real(r8), dimension(:), intent(out) :: siej - ! !LOCAL VARIABLES: - integer :: ii - integer :: i - real(r8) :: dnm1 - - ii = size(ss) - siej = 0._r8 - dnm1=1._r8 - do i = 1, ii - if(kd(i)>0._r8 .and. (kd(i)<.9*kd_infty))then - dnm1 = dnm1 + ss(i)/kd(i) - endif - enddo - do i = 1, ii - if(kd(i)>0._r8 .and. (kd(i)<.9*kd_infty))then - siej(i) = ss(i)/(kd(i)*(dnm1+ee/kd(i))) - endif - enddo - end subroutine ecacomplex_cell_norm_v1e -end module KineticsMod diff --git a/components/clm/src/betr/betr_core/TracerBoundaryCondType.F90 b/components/clm/src/betr/betr_core/TracerBoundaryCondType.F90 deleted file mode 100644 index f7d3b1ddba47..000000000000 --- a/components/clm/src/betr/betr_core/TracerBoundaryCondType.F90 +++ /dev/null @@ -1,168 +0,0 @@ -module TracerBoundaryCondType -! -! !DESCRIPTION: -! data type to specify boundary conditions for tracer tranpsort -! -! !USES: - use shr_kind_mod , only : r8 => shr_kind_r8 - use decompMod , only : bounds_type - - implicit none - save - private - ! - ! !PUBLIC DATA: - ! - - !-------------------------------------------------------------------------------- - type, public :: tracerboundarycond_type - real(r8), pointer :: tracer_gwdif_concflux_top_col( : , : , : ) !tracer concentration or incoming flux imposed at top boundary for dual diffusion calculation - real(r8), pointer :: condc_toplay_col ( : , : ) !conductance at the column-air interface - real(r8), pointer :: bot_concflux_col ( : , : , : ) !bottom boundary condition - integer, pointer :: topbc_type ( : ) !type of top boundary condition, it depends on tracer type - integer, pointer :: botbc_type ( : ) !type of bottom boundary condition, it depends on tracer type - integer, pointer :: jtops_col ( : ) !index of the top numerical node - contains - procedure, public :: Init - procedure, public :: Restart - procedure, public :: Reset - procedure, private :: InitAllocate - procedure, private :: InitHistory - procedure, private :: InitCold - - end type tracerboundarycond_type -contains - - !------------------------------------------------------------------------ - subroutine Init(this, bounds, betrtracer_vars) - ! - ! !DESCRIPTION: - ! Initialize the datatype - ! - ! !USES: - use BeTRTracerType, only : BeTRTracer_Type - ! - ! !ARGUMENTS: - class(tracerboundarycond_type) :: this - type(bounds_type), intent(in) :: bounds - type(BeTRTracer_Type), intent(in) :: betrtracer_vars - - call this%InitAllocate(bounds, betrtracer_vars) - call this%InitHistory(bounds) - call this%InitCold(bounds) - - end subroutine Init - - !----------------------------------------------------------------------- - subroutine InitAllocate(this, bounds, betrtracer_vars) - use BeTRTracerType, only : BeTRTracer_Type - ! - ! !DESCRIPTION: - ! allocate memories to relevant variables - ! - ! !ARGUMENTS: - class(tracerboundarycond_type) :: this - type(bounds_type), intent(in) :: bounds - type(BeTRTracer_Type), intent(in) :: betrtracer_vars - ! - ! !LOCAL VARIABLES: - integer :: begc, endc - !--------------------------------------------------------------------- - - begc = bounds%begc; endc= bounds%endc - - allocate(this%tracer_gwdif_concflux_top_col (begc:endc, 1:2, 1:betrtracer_vars%ntracers)) ! 1: values at previous time step, 2: values at current time step - allocate(this%bot_concflux_col (begc:endc, 1:2, 1:betrtracer_vars%ntracers)) ! 1: values at previous time step, 2: values at current time step - - allocate(this%condc_toplay_col (begc:endc, 1:betrtracer_vars%ntracer_groups)) - allocate(this%topbc_type (1:betrtracer_vars%ntracer_groups)) - allocate(this%botbc_type (1:betrtracer_vars%ntracer_groups)) - allocate(this%jtops_col (begc:endc)) - end subroutine InitAllocate - - !----------------------------------------------------------------------- - subroutine InitHistory(this, bounds) - ! - ! !DESCRIPTION: - ! History fields initialization - ! - ! !USES: - use clm_varcon , only: spval - use clm_varpar , only: nlevsno - - ! - ! !ARGUMENTS: - class(tracerboundarycond_type) :: this - type(bounds_type), intent(in) :: bounds - ! - ! !LOCAL VARIABLES: - integer :: begc, endc - real(r8), pointer :: data2dptr_col(:,:) ! temp. pointers for slicing larger arrays - - - end subroutine InitHistory - - !----------------------------------------------------------------------- - subroutine InitCold(this, bounds) - ! - ! !DESCRIPTION: - ! do cold initialization - ! !USES: - ! - use shr_infnan_mod, only : nan => shr_infnan_nan, assignment(=) - implicit none - ! !ARGUMENTS: - class(tracerboundarycond_type) :: this - type(bounds_type) , intent(in) :: bounds - ! - ! !LOCAL VARIABLES: - - - !----------------------------------------------------------------------- - this%topbc_type(:) = -1 - this%botbc_type(:) = -1 - this%tracer_gwdif_concflux_top_col(:,:,:) = nan - this%condc_toplay_col(:,:) = nan - this%bot_concflux_col(:,:,:) = 0._r8 - this%jtops_col(:) = 1 - end subroutine InitCold - - !------------------------------------------------------------------------ - subroutine Restart(this, bounds, ncid, flag) - ! - ! !DESCRIPTION: - ! Read/Write module information to/from restart file. - ! - ! !USES: - use clm_varpar , only : nlevsno, nlevsoi - use clm_varcon , only : spval - use clm_varctl , only : iulog - use ncdio_pio - ! - ! !ARGUMENTS: - class(tracerboundarycond_type) :: this - type(bounds_type) , intent(in) :: bounds - type(file_desc_t) , intent(inout) :: ncid ! netcdf id - character(len=*) , intent(in) :: flag ! 'read' or 'write' - ! - ! !LOCAL VARIABLES: - integer :: j,c ! indices - logical :: readvar ! determine if variable is on initial file - - - end subroutine Restart - - !----------------------------------------------------------------------- - subroutine Reset(this, column) - ! - ! !DESCRIPTION: - ! Intitialize SNICAR variables for fresh snow column - ! - ! !ARGUMENTS: - class(tracerboundarycond_type) :: this - integer , intent(in) :: column ! column index - - - - end subroutine Reset - end module TracerBoundaryCondType diff --git a/components/clm/src/betr/betr_core/Tracer_varcon.F90 b/components/clm/src/betr/betr_core/Tracer_varcon.F90 deleted file mode 100644 index 042b789ed936..000000000000 --- a/components/clm/src/betr/betr_core/Tracer_varcon.F90 +++ /dev/null @@ -1,89 +0,0 @@ -module Tracer_varcon - !----------------------------------------------------------------------- - !BOP - ! - ! !MODULE: Tracer_varcon - ! - ! !DESCRIPTION: - ! Module containing parameters and logical switches and routine to read constants from CLM namelist for tracer transport set up. - ! - ! !USES: - use shr_kind_mod, only : r8 => shr_kind_r8 - use abortutils , only : endrun - use clm_varctl , only : iulog - ! - ! !PUBLIC TYPES: - implicit none - save - - logical, public :: l2ndadvsolver = .false. ! by default use 1st order solver for advection - - real(r8),public, parameter :: SHR_CONST_VSMOW_O18 = 2005.20e-6_R8 ! ratio of 18O/16O in Vienna Standard Mean Ocean Water (VSMOW) - real(r8),public, parameter :: SHR_CONST_VSMOW_O17 = 379.9e-6_R8 ! ratio of 17O/16O in Vienna Standard Mean Ocean Water (VSMOW) - real(r8),public, parameter :: SHR_CONST_VSMOW_D = 155.76e-6_R8 ! ratio of D/H in Vienna Standard Mean Ocean Water (VSMOW) - real(r8),public, parameter :: SHR_CONST_VSMOW_T = 1.85e-6_R8 ! ratio of T/H in Vienna Standard Mean Ocean Water (VSMOW) - - ! underground tracer transport logical switches - logical, public :: ltracer_offline=.true. ! true=> do not pass volatile tracers from/to atmosphere - logical, public :: ltrcunsat=.false. ! ture=> swith on tracer transport for specified underground processes in unsaturated upland soil - logical, public :: ltrcsat =.false. ! ture=> swith on tracer transport for specified underground processes in unsaturated wetland soil - logical, public :: ltrclake =.false. ! ture=> swith on tracer transport for specified underground processes in lake water and lake soil - logical, public :: laquadv_off =.false. ! true=> turn off aqueous advection - logical, public :: lgasadv_off = .false. ! true=> turn off gas advection - logical, public :: lzero_restart = .false. ! true => start with nil tracer concentration, by default - logical, public :: is_online_soilchem = .false. ! true=> chemistry is done outside TracerUpdate, added for plug&play capability, say microbial model - logical, public :: ldsolvn_vtransport = .false. ! this is not in the namelist, and its value will be determined in SoilTracersMod, don transport? - logical, public :: ldsolvc_vtransport = .false. ! this is not in the namelist, and its value will be determined in SoilTracersMod, doc transport? - logical, public :: lco2_refix = .false. ! true => refix co2 transported to leaf - logical, public :: lneut = .false. ! true => only allow neutral molecules to go through xylem - logical, public :: ltracer_stem = .false. ! true => model valatile tracer in stem - logical, public :: use_pH_data = .false. - logical, public :: licecoat = .false. ! true => switch on ice coating for dissolved tracers, the coating is defined as the dice/h2oliq, - ! where, dice is the change of ice content during to free-thaw cyles - logical, public :: is_active_betr_bgc = .false. - logical, public :: do_betr_leaching = .false. - logical, public :: liceseal = .true. ! true => allow ice to seal the surface soil and keep the gas tracer - real(r8),public :: rr_dif_scal = 1._r8 ! scaling factor for how much root respiration is diffused out into soil - real(r8),public :: mr_dif_scal = 0._r8 ! how much fraction of stem respiration is back into xylem - real(r8),public :: co2_refix_scal = 0.0_r8 ! how much fraction of co2 in the xylem is refixed in leaf - real(r8),public :: site_pH = 7._r8 ! pH value of the site - - ! atmospheric compositions, (v/v) - real(r8),public :: atm_n2 = 0.78084_r8 - real(r8),public :: atm_o2 = 0.20946_r8 - real(r8),public :: atm_ar = 0.009340_r8 - real(r8),public :: atm_co2 = 379e-6_r8 !this will be set to the value provided from co2_ppmv - real(r8),public :: atm_ch4 = 1.7e-6_r8 !this will be set to the value provided from atmch4 if clm4me is on - real(r8),public :: atm_n2o = 3.1e-7_r8 - real(r8),public :: atm_no = 4.56e-9_r8 - real(r8),public :: atm_nh3 = 300.e-12_r8 ! - real(r8),public :: atm_h2 = 0.55e-6_r8 - - ! atmospheric isotopic signatures - ! the zeros will be replaced with updated value from literature searching. - real(r8),public :: atm_deld_h2 = 0._r8 !relative to VSMOW - real(r8),public :: atm_delt_h2 = 0._r8 !relative to VSMOW - real(r8),public :: atm_del13c_co2 =-6._r8 !set to pre-industrial value by default, it will be used to set the value of c13ratio, PDB - real(r8),public :: atm_del13c_ch4 = 0._r8 !relative to PDB - real(r8),public :: atm_del14c_co2 = 0._r8 !relative to what? - real(r8),public :: atm_del14c_ch4 = 0._r8 !relative to what? - real(r8),public :: atm_del18o_co2 = 0._r8 !relative to VSMOW - real(r8),public :: atm_del18o_h2o = 0._r8 !relative to VSMOW - real(r8),public :: atm_del18o_o2 = 0._r8 !relative to VSMOW - real(r8),public :: atm_del17o_co2 = 0._r8 !relative to VSMOW - real(r8),public :: atm_del17o_h2o = 0._r8 !relative to VSMOW - real(r8),public :: atm_del17o_o2 = 0._r8 !relative to VSMOW - real(r8),public :: atm_deld_ch4 = 0._r8 !realtive to VSMOW - real(r8),public :: atm_deld_h2o = 0._r8 !relative to VSMOW - - integer, parameter, public :: bndcond_as_conc = 1 !top boundary conditions as tracer concentration - integer, parameter, public :: bndcond_as_flux=2 !top boundary condition as tracer flux - - - !true fractions of the isotopologues in the atmosphere - real(r8),public :: atm_dratio_h2, atm_tratio_h2 - real(r8),public :: atm_c13rc12_co2, atm_c14rc12_co2, atm_o18ro16_co2, atm_o17ro16_co2 - real(r8),public :: atm_drh_h2o,atm_tratio_h2o,atm_o18ro16_h2o, atm_o17ro16_h2o - real(r8),public :: atm_c13rc12_ch4, atm_c14rc12_ch4, atm_drh_ch4 - -end module Tracer_varcon diff --git a/components/clm/src/betr/betr_core/TransportMod.F90 b/components/clm/src/betr/betr_core/TransportMod.F90 deleted file mode 100644 index 7551cf6343e1..000000000000 --- a/components/clm/src/betr/betr_core/TransportMod.F90 +++ /dev/null @@ -1,917 +0,0 @@ -module TransportMod - ! - ! !DESCRIPTION: - ! - ! subroutines to do 1d vertical multiphase transport in soil/water - ! History: created by Jinyun Tang, Jun 2011 - -#include "shr_assert.h" - ! !USES: - use shr_log_mod , only : errMsg => shr_log_errMsg - use tracer_varcon , only : bndcond_as_conc, bndcond_as_flux - use clm_varctl , only : iulog - use abortutils , only : endrun - use shr_kind_mod , only : r8 => shr_kind_r8 - implicit none - private - public :: DiffusTransp !do tracer transport through diffusion, for both lake and soil - public :: calc_interface_conductance - public :: init_transportmod - public :: get_cntheta - public :: calc_col_CFL !claculate CFL critieria - public :: semi_lagrange_adv_backward - interface DiffusTransp - module procedure DiffusTransp_gw - module procedure DiffusTransp_solid - end interface DiffusTransp - - type, private :: Extra_type - real(r8), pointer :: zi(:) !interfaces - real(r8), pointer :: us(:) !flow velocity at the interfaces - integer :: nlen !total number of interfaces - contains - procedure, public :: InitAllocate - procedure, public :: DDeallocate - procedure, public :: AAssign - end type Extra_type - - type(Extra_type), private :: Extra_inst - - !default configuration parameters - real(r8), private :: cntheta - -contains - !------------------------------------------------------------------------------- - subroutine InitAllocate(this, lbj, ubj) - ! - ! !DESCRIPTION: - ! allocate memory for arrays of the specified data type - - ! !ARGUMENTS: - class(Extra_type) :: this - integer, intent(in) :: lbj, ubj - character(len=32) :: subname ='InitAllocate' - - - allocate(this%zi(lbj:ubj)) - allocate(this%us(lbj:ubj)) - - end subroutine InitAllocate - !------------------------------------------------------------------------------- - - subroutine DDeallocate(this) - ! - ! !DESCRIPTION: - ! Deallocate memories - ! - ! !ARGUMENTS: - class(Extra_type) :: this - character(len=32) :: subname ='DDeallocate' - deallocate(this%zi) - deallocate(this%us) - - end subroutine DDeallocate - - !------------------------------------------------------------------------------- - - subroutine AAssign(this, zi_t,us_t) - ! - ! !DESCRIPTION: - ! Assgin values for member variables for the specified data type - ! - ! !ARGUMENTS: - class(Extra_type) :: this - real(r8), dimension(:), intent(in) :: zi_t - real(r8), dimension(:), intent(in) :: us_t - - ! !LOCAL VARIABLES: - integer :: n1, n2 - character(len=32) :: subname ='AAssign' - - n1 = size(zi_t) - n2 = size(us_t) - SHR_ASSERT_ALL((n1 == n2), errMsg(__FILE__,__LINE__)) - this%zi(1:n1) = zi_t - this%us(1:n2) = us_t - this%nlen = n1 - end subroutine AAssign - !------------------------------------------------------------------------------- - function get_cntheta()result(ans) - ! - ! !DESCRIPTION: - ! return the theta factor - ! - implicit none - - ! !LOCAL VARIABLES: - real(r8) :: ans - character(len=32) :: subname ='get_cntheta' - - ans = cntheta - return - end function get_cntheta - !------------------------------------------------------------------------------- - subroutine init_transportmod(lcntheta) - ! - ! !DESCRIPTION: - ! initialize transportmod - ! - implicit none - ! !ARGUMENTS: - real(r8), optional, intent(in) :: lcntheta - character(len=32) :: subname ='init_transportmod' - if(present(lcntheta))then - cntheta = lcntheta - else - ! use implicit solver by default - cntheta = 1._r8 - endif - - end subroutine init_transportmod - !------------------------------------------------------------------------------- - - subroutine calc_interface_conductance(bounds, lbj, ubj, jtop, numfl, filter, bulkdiffus, dz, hmconductance) - ! - ! !DESCRIPTION: - ! calcualte conductances at the interfaces using input layered diffusivity and - ! thickness - ! - ! !USES: - ! - use shr_kind_mod, only: r8 => shr_kind_r8 - use decompMod, only : bounds_type - implicit none - ! !ARGUMENTS: - type(bounds_type), intent(in) :: bounds !bounds - integer, intent(in) :: lbj, ubj ! lbinning and ubing level indices - integer, intent(in) :: jtop(bounds%begc: ) ! index of upper boundary, which could be variable - integer, intent(in) :: numfl ! length of the filter - integer, intent(in) :: filter(:) ! the actual filter - real(r8), intent(in) :: bulkdiffus(bounds%begc: ,lbj: ) !weighted bulk diffusivity for dual-phase diffusion - real(r8), intent(in) :: dz(bounds%begc: , lbj: ) - real(r8), intent(inout) :: hmconductance(bounds%begc: , lbj: ) !weighted bulk conductance - - ! !LOCAL VARIABLES: - integer :: n, c, fc - - SHR_ASSERT_ALL((ubound(jtop) == (/bounds%endc/)), errMsg(__FILE__,__LINE__)) - SHR_ASSERT_ALL((ubound(dz) == (/bounds%endc, ubj/)), errMsg(__FILE__,__LINE__)) - SHR_ASSERT_ALL((ubound(bulkdiffus) == (/bounds%endc, ubj/)), errMsg(__FILE__,__LINE__)) - SHR_ASSERT_ALL((ubound(hmconductance) == (/bounds%endc, ubj-1/)), errMsg(__FILE__,__LINE__)) - - do n=lbj, ubj-1 - do fc = 1, numfl - c = filter(fc) - if(n>=jtop(c))then - hmconductance(c,n) = 2._r8/(dz(c,n)/bulkdiffus(c,n)+dz(c,n+1)/bulkdiffus(c,n+1)) - endif - enddo - enddo - - - end subroutine calc_interface_conductance - !------------------------------------------------------------------------------- - subroutine DiffusTransp_gw_tridiag(bounds, lbj, ubj, jtop, numfl, filter, ntrcs, trcin_mobile, & - Rfactor, hmconductance, dtime, dz, source, trc_concflx_air,condc_toplay, topbc_type,& - bot_concflx, update_col, source_only, rt, at,bt,ct, botbc_type, condc_botlay) - ! - ! !DESCRIPTION: - ! Assemble the tridiagonal matrix for the multiphase diffusive transport - ! - ! !USES - ! - use shr_kind_mod, only: r8 => shr_kind_r8 - use decompMod, only : bounds_type - - implicit none - ! !ARGUMENTS: - type(bounds_type), intent(in) :: bounds ! bounds - integer, intent(in) :: lbj, ubj ! lbinning and ubing level indices - integer, intent(in) :: jtop(bounds%begc: ) ! index of upper boundary, which could be variable - integer, intent(in) :: numfl ! length of the filter - integer, intent(in) :: filter(:) ! the actual filter - integer, intent(in) :: ntrcs - real(r8), intent(in) :: Rfactor(bounds%begc: , lbj: ) ! conversion parameter from the given tracer phase to bulk mobile phase - real(r8), intent(in) :: hmconductance(bounds%begc: , lbj: ) ! weighted bulk tracer conductances - real(r8), intent(in) :: dz(bounds%begc: , lbj: ) ! node thickness - real(r8), intent(in) :: dtime(bounds%begc: ) ! time step - real(r8), intent(in) :: condc_toplay(bounds%begc: ) ! top layer conductance - integer, intent(in) :: topbc_type ! type of top boundary condtion: 1, concentration, 2 flux - real(r8), intent(in) :: bot_concflx (bounds%begc: , 1: , 1: ) ! flux or concentration at the bottom boundary - real(r8), intent(in) :: trc_concflx_air(bounds%begc: , 1: , 1: ) ! atmospheric tracer concentration (topbc_type=1) or flux (topbc_type=2) - real(r8), intent(in) :: trcin_mobile (bounds%begc: , lbj: , 1: ) ! incoming mobile tracer concentration - real(r8), intent(in) :: source (bounds%begc: , lbj: , 1: ) ! chemical sources [mol/m3] - - logical, intent(in) :: source_only ! if .true. only update the source array rt, used for explicit solver - logical, intent(in) :: update_col(bounds%begc: ) ! logical switch indicating if the column is for active update - - real(r8), intent(out):: rt(bounds%begc: ,lbj: , 1: ) ! tridiagonal matrix element r - real(r8), optional,intent(inout):: at(bounds%begc: , lbj: ) ! tridiagonal matrix element a - real(r8), optional,intent(inout):: bt(bounds%begc: , lbj: ) ! tridiagonal matrix element b - real(r8), optional,intent(inout):: ct(bounds%begc: , lbj: ) ! tridiagonal matrix element c - integer, optional,intent(in) :: botbc_type ! type of bottom boundary condition - real(r8), optional,intent(in) :: condc_botlay(bounds%begc: ) !conductance at bottom layer - - ! !LOCAL VARIABLES: - integer :: j, fc, c, k !indices - integer :: botbc_ltype !temp. variable - real(r8) ::Fl, Fr - character(len=255) :: subname='DiffusTransp_gw' - - SHR_ASSERT_ALL((ubound(jtop) == (/bounds%endc/)), errMsg(__FILE__,__LINE__)) - SHR_ASSERT_ALL((ubound(Rfactor) == (/bounds%endc, ubj/)), errMsg(__FILE__,__LINE__)) - SHR_ASSERT_ALL((ubound(hmconductance) == (/bounds%endc, ubj-1/)), errMsg(__FILE__,__LINE__)) - SHR_ASSERT_ALL((ubound(dz) == (/bounds%endc, ubj/)), errMsg(__FILE__,__LINE__)) - SHR_ASSERT_ALL((ubound(dtime) == (/bounds%endc/)), errMsg(__FILE__,__LINE__)) - SHR_ASSERT_ALL((ubound(condc_toplay) == (/bounds%endc/)), errMsg(__FILE__,__LINE__)) - SHR_ASSERT_ALL((ubound(update_col) == (/bounds%endc/)), errMsg(__FILE__,__LINE__)) - - SHR_ASSERT_ALL((ubound(source) == (/bounds%endc, ubj, ntrcs/)), errMsg(__FILE__,__LINE__)) - SHR_ASSERT_ALL((ubound(rt) == (/bounds%endc, ubj, ntrcs/)), errMsg(__FILE__,__LINE__)) - - SHR_ASSERT_ALL((ubound(trcin_mobile , 1) == (/bounds%endc/)) , errMsg(__FILE__,__LINE__)) - SHR_ASSERT_ALL((ubound(trcin_mobile , 2) == (/ubj/)) , errMsg(__FILE__,__LINE__)) - SHR_ASSERT_ALL((size(trcin_mobile , 3) == (/ntrcs/)) , errMsg(__FILE__,__LINE__)) - - SHR_ASSERT_ALL((ubound(bot_concflx,1) == (/bounds%endc/)) , errMsg(__FILE__,__LINE__)) - SHR_ASSERT_ALL((ubound(bot_concflx,2) == (/2/)) , errMsg(__FILE__,__LINE__)) - SHR_ASSERT_ALL((size(bot_concflx,3) == (/ntrcs/)) , errMsg(__FILE__,__LINE__)) - - SHR_ASSERT_ALL((ubound(trc_concflx_air, 1) == (/bounds%endc/)) , errMsg(__FILE__,__LINE__)) - SHR_ASSERT_ALL((ubound(trc_concflx_air, 2) == (/2/)) , errMsg(__FILE__,__LINE__)) - SHR_ASSERT_ALL((size(trc_concflx_air, 3) == (/ntrcs/)) , errMsg(__FILE__,__LINE__)) - - - if(.not. source_only) then - SHR_ASSERT_ALL((ubound(at) == (/bounds%endc, ubj/)), errMsg(__FILE__,__LINE__)) - SHR_ASSERT_ALL((ubound(bt) == (/bounds%endc, ubj/)), errMsg(__FILE__,__LINE__)) - SHR_ASSERT_ALL((ubound(ct) == (/bounds%endc, ubj/)), errMsg(__FILE__,__LINE__)) - endif - !unless specified explicitly, the bottom boundary condition is given as flux - if(present(botbc_type))then - botbc_ltype = botbc_type - if(botbc_type==bndcond_as_conc)then - SHR_ASSERT_ALL((ubound(condc_botlay) == (/bounds%endc/)), errMsg(__FILE__,__LINE__)) - endif - else - botbc_ltype = bndcond_as_flux - endif - - do fc = 1, numfl - !form the diffusion matrix - c = filter(fc) - if(update_col(c))then - - do j = jtop(c), ubj - do k = 1, ntrcs - if(j == jtop(c))then - !by default the top node is always assumed as snow surface, - !though when it snow free, the conductance is defined with respect to the soil - Fr = -hmconductance(c,j)*(trcin_mobile(c,j+1, k)/rfactor(c,j+1)-trcin_mobile(c,j, k)/rfactor(c,j)) - if(topbc_type == bndcond_as_conc)then - !top boundary condition given as concentration - Fl = -condc_toplay(c)*(trcin_mobile(c,j, k)/rfactor(c,j)-trc_concflx_air(c, 1, k)) - elseif(topbc_type == bndcond_as_flux)then - !top boundary condition given as flux, this only happens when the flux is given at soil surface - Fl = trc_concflx_air(c,1, k) - endif - elseif(j == ubj)then - Fl = -hmconductance(c,j-1)*(trcin_mobile(c,j,k)/rfactor(c,j)-trcin_mobile(c,j-1,k)/rfactor(c,j-1)) - if(botbc_ltype==bndcond_as_conc)then - Fr = - condc_botlay(c)*(bot_concflx(c,1,k)-trcin_mobile(c,j,k)/rfactor(c,j)) - else - Fr = bot_concflx(c,1,k) - endif - else - Fl = -hmconductance(c,j-1)*(trcin_mobile(c,j,k)/rfactor(c,j)-trcin_mobile(c,j-1,k)/rfactor(c,j-1)) - Fr = -hmconductance(c,j)*(trcin_mobile(c,j+1,k)/rfactor(c,j+1)-trcin_mobile(c,j,k)/rfactor(c,j)) - endif - rt(c,j,k) = Fl-Fr + source(c,j,k)*dz(c,j) - if(j==jtop(c) .and. topbc_type == bndcond_as_conc)then - rt(c,j,k) = rt(c,j,k)+cntheta*condc_toplay(c)*(trc_concflx_air(c, 2,k)-trc_concflx_air(c, 1,k)) - endif - if(j == ubj .and. botbc_ltype==bndcond_as_conc)then - rt(c,j,k) = rt(c,j,k) + cntheta*condc_botlay(c)*(bot_concflx(c,2,k) - bot_concflx(c,1,k)) - endif - enddo - enddo - endif - enddo - - if(source_only)return - do fc = 1, numfl - !form the diffusion matrix - c = filter(fc) - if(update_col(c))then - do j = jtop(c), ubj - if(j == jtop(c))then - if(topbc_type == bndcond_as_conc)then !top boundary condition given as concentration - bt(c,j)=dz(c,j)/dtime(c)+cntheta*(hmconductance(c,j) & - +condc_toplay(c))/Rfactor(c,j) - elseif(topbc_type == bndcond_as_flux)then !top boundary condition given as flux - bt(c,j)=dz(c,j)/dtime(c)+cntheta*hmconductance(c,j)/Rfactor(c,j) - endif - ct(c,j)=-cntheta*hmconductance(c,j)/Rfactor(c,j+1) - elseif(j==ubj)then - at(c,j)=-cntheta*hmconductance(c,j-1)/rfactor(c,j-1) - if(botbc_ltype == bndcond_as_conc)then - bt(c,j)=dz(c,j)/dtime(c)+cntheta*(hmconductance(c,j-1)+condc_botlay(c))/Rfactor(c,j) - else - bt(c,j)=dz(c,j)/dtime(c)+cntheta*hmconductance(c,j-1)/Rfactor(c,j) - endif - else - at(c,j)=-cntheta*hmconductance(c,j-1)/rfactor(c,j-1) - ct(c,j)=-cntheta*hmconductance(c,j)/rfactor(c,j+1) - bt(c,j)=dz(c,j)/dtime(c)+cntheta*(hmconductance(c,j-1)+hmconductance(c,j))/Rfactor(c,j) - endif - enddo - endif - enddo - - end subroutine DiffusTransp_gw_tridiag -!------------------------------------------------------------------------------- - subroutine DiffusTransp_gw(bounds, lbj, ubj, jtop, numfl, filter, ntrcs, trcin_mobile, & - Rfactor, hmconductance, dtime, dz, source, trc_concflx_air,condc_toplay, topbc_type,& - bot_flux, update_col, dtracer, botbc_type, condc_botlay) - ! - ! !DESCRIPTION: - ! solve the dual phase transport problem. - ! the solver returns the tracer change due to diffusive transport - ! - ! !USES: - use shr_kind_mod , only : r8 => shr_kind_r8 - use decompMod , only : bounds_type - use TridiagonalMod, only : Tridiagonal - - implicit none - ! !ARGUMENTS: - type(bounds_type) , intent(in) :: bounds !bounds - integer , intent(in) :: lbj, ubj ! lbinning and ubing level indices - integer , intent(in) :: jtop(bounds%begc: ) ! index of upper boundary, which could be variable - integer , intent(in) :: numfl ! length of the filter - integer , intent(in) :: filter(:) ! the actual filter - integer , intent(in) :: ntrcs - real(r8) , intent(in) :: Rfactor(bounds%begc: , lbj: ) !conversion parameter from the given tracer phase to bulk mobile phase - real(r8) , intent(in) :: hmconductance(bounds%begc: , lbj: ) !weighted bulk tracer conductances - real(r8) , intent(in) :: dz(bounds%begc: , lbj: ) !node thickness - real(r8) , intent(in) :: dtime(bounds%begc: ) !time step - real(r8) , intent(in) :: condc_toplay(bounds%begc: ) !top layer conductance - integer , intent(in) :: topbc_type !type of top boundary condtion: 1, concentration, 2 flux - integer , optional, intent(in) :: botbc_type - real(r8), optional, intent(in) :: condc_botlay(bounds%begc: ) - logical , intent(in) :: update_col(bounds%begc: ) !logical switch indicating if the column is for active update - real(r8) , intent(in) :: trcin_mobile(bounds%begc: , lbj: ,1: ) ! incoming mobile tracer concentration - real(r8) , intent(in) :: source(bounds%begc: , lbj: , 1: ) !chemical sources [mol/m3] - real(r8) , intent(in) :: bot_flux(bounds%begc: , 1: , 1: ) !flux at the bottom boundary - real(r8) , intent(in) :: trc_concflx_air(bounds%begc: , 1: , 1: ) !atmospheric tracer concentration (topbc_type=1) or flux (topbc_type=2) - real(r8) , intent(inout) :: dtracer(bounds%begc: , lbj: , 1: ) !change of tracer concentration during the time step - - ! !LOCAL VARIABLES: - real(r8) :: rt(bounds%begc:bounds%endc, lbj:ubj, 1:ntrcs) !tridiagonal matrix element r - real(r8) :: at(bounds%begc:bounds%endc, lbj:ubj) !tridiagonal matrix element a - real(r8) :: bt(bounds%begc:bounds%endc, lbj:ubj) !tridiagonal matrix element b - real(r8) :: ct(bounds%begc:bounds%endc, lbj:ubj) !tridiagonal matrix element c - real(r8) :: dtracer1(bounds%begc:bounds%endc, lbj:ubj) - character(len=255) :: subname = 'DiffusTransp_gw' - integer :: kk, fc, c - - SHR_ASSERT_ALL((ubound(jtop) == (/bounds%endc/)) , errMsg(__FILE__,__LINE__)) - SHR_ASSERT_ALL((ubound(dtime) == (/bounds%endc/)) , errMsg(__FILE__,__LINE__)) - SHR_ASSERT_ALL((ubound(update_col) == (/bounds%endc/)) , errMsg(__FILE__,__LINE__)) - SHR_ASSERT_ALL((ubound(condc_toplay) == (/bounds%endc/)) , errMsg(__FILE__,__LINE__)) - SHR_ASSERT_ALL((ubound(dz) == (/bounds%endc, ubj/)) , errMsg(__FILE__,__LINE__)) - SHR_ASSERT_ALL((ubound(Rfactor ) == (/bounds%endc, ubj/)) , errMsg(__FILE__,__LINE__)) - SHR_ASSERT_ALL((ubound(hmconductance) == (/bounds%endc, ubj-1/)), errMsg(__FILE__,__LINE__)) - SHR_ASSERT_ALL((ubound(source) == (/bounds%endc, ubj, ntrcs/)), errMsg(__FILE__,__LINE__)) - SHR_ASSERT_ALL((ubound(dtracer) == (/bounds%endc, ubj, ntrcs/)) , errMsg(__FILE__,__LINE__)) - - SHR_ASSERT_ALL((ubound(trcin_mobile , 1) == (/bounds%endc/)) , errMsg(__FILE__,__LINE__)) - SHR_ASSERT_ALL((ubound(trcin_mobile , 2) == (/ubj/)) , errMsg(__FILE__,__LINE__)) - SHR_ASSERT_ALL((size(trcin_mobile , 3) == (/ntrcs/)) , errMsg(__FILE__,__LINE__)) - - SHR_ASSERT_ALL((ubound(bot_flux , 1) == (/bounds%endc/)) , errMsg(__FILE__,__LINE__)) - SHR_ASSERT_ALL((ubound(bot_flux , 2) == (/2/)) , errMsg(__FILE__,__LINE__)) - SHR_ASSERT_ALL((size(bot_flux , 3) == (/ntrcs/)) , errMsg(__FILE__,__LINE__)) - - SHR_ASSERT_ALL((ubound(trc_concflx_air, 1) == (/bounds%endc/)) , errMsg(__FILE__,__LINE__)) - SHR_ASSERT_ALL((ubound(trc_concflx_air, 2) == (/2/)) , errMsg(__FILE__,__LINE__)) - SHR_ASSERT_ALL((size(trc_concflx_air, 3) == (/ntrcs/)) , errMsg(__FILE__,__LINE__)) - - !assemble the tridiagonal maxtrix - if(present(botbc_type))then - SHR_ASSERT_ALL((ubound(condc_botlay) == (/bounds%endc/)), errMsg(__FILE__,__LINE__)) - - call DiffusTransp_gw_tridiag(bounds, lbj, ubj, jtop, numfl, filter, ntrcs, trcin_mobile, & - Rfactor, hmconductance, dtime, dz, source, trc_concflx_air,& - condc_toplay, topbc_type, bot_flux, update_col, source_only=.false.,& - rt=rt, at=at,bt=bt,ct=ct, botbc_type=botbc_type, condc_botlay=condc_botlay) - else - call DiffusTransp_gw_tridiag(bounds, lbj, ubj, jtop, numfl, filter, ntrcs, trcin_mobile, & - Rfactor, hmconductance, dtime, dz, source, trc_concflx_air,& - condc_toplay, topbc_type, bot_flux, update_col, source_only=.false.,& - rt=rt, at=at,bt=bt,ct=ct) - endif - - !calculate the change to tracer - call Tridiagonal (bounds, lbj, ubj, jtop, numfl, filter, ntrcs, at, bt, ct, rt, dtracer, update_col) - - end subroutine DiffusTransp_gw - - !------------------------------------------------------------------------------- - subroutine Diffustransp_solid_tridiag(bounds, lbj, ubj, lbn, numfl, filter, ntrcs, trcin,& - hmconductance, dtime_col, dz, source, update_col, at,bt,ct, rt) - ! - ! !DESCRIPTION: - ! - ! Do solid phase transport with tracer source - ! - ! !USES: - use shr_kind_mod, only: r8 => shr_kind_r8 - use decompMod, only : bounds_type - - implicit none - ! !ARGUMENTS: - type(bounds_type), intent(in) :: bounds !bounds - integer , intent(in) :: lbj, ubj ! lbinning and ubing level indices - integer , intent(in) :: lbn(bounds%begc: ) !indices of top boundary - integer , intent(in) :: numfl !filter dimension - integer , intent(in) :: filter(:) !filter - integer , intent(in) :: ntrcs - real(r8) , intent(in) :: trcin(bounds%begc: , lbj: ,1: ) !tracer concentration [mol/m3] - real(r8) , intent(in) :: hmconductance(bounds%begc: , lbj: ) !weighted conductance - real(r8) , intent(in) :: dtime_col(bounds%begc: ) !model time step - real(r8) , intent(in) :: dz(bounds%begc: , lbj: ) !layer thickness - real(r8) , intent(in) :: source(bounds%begc: , lbj: ,1: ) !chemical sources [mol/m3] - logical , intent(in) :: update_col(bounds%begc: ) !logical switch indicating if the column is for active update - real(r8) , intent(out) :: at(bounds%begc: , lbj: ) !returning tridiagonal a matrix - real(r8) , intent(out) :: bt(bounds%begc: , lbj: ) !returning tridiagonal b matrix - real(r8) , intent(out) :: ct(bounds%begc: , lbj: ) !returning tridiagonal c matrix - real(r8) , intent(out) :: rt(bounds%begc: , lbj: ,1: ) !returning tridiagonal r matrix - - !LOCAL VARIABLES: - real(r8) :: bot - integer :: j, k, fc, c - real(r8) :: Fl, Fr - real(r8) :: dtime - character(len=255) :: subname='DiffusTransp_solid_tridiag' - - SHR_ASSERT_ALL((ubound(lbn) == (/bounds%endc/)) , errMsg(__FILE__,__LINE__)) - SHR_ASSERT_ALL((ubound(hmconductance) == (/bounds%endc, ubj-1/)), errMsg(__FILE__,__LINE__)) - SHR_ASSERT_ALL((ubound(dz) == (/bounds%endc, ubj/)) , errMsg(__FILE__,__LINE__)) - SHR_ASSERT_ALL((ubound(dtime_col) == (/bounds%endc/)) , errMsg(__FILE__,__LINE__)) - SHR_ASSERT_ALL((ubound(update_col) == (/bounds%endc/)) , errMsg(__FILE__,__LINE__)) - SHR_ASSERT_ALL((ubound(at) == (/bounds%endc, ubj/)) , errMsg(__FILE__,__LINE__)) - SHR_ASSERT_ALL((ubound(bt) == (/bounds%endc, ubj/)) , errMsg(__FILE__,__LINE__)) - SHR_ASSERT_ALL((ubound(ct) == (/bounds%endc, ubj/)) , errMsg(__FILE__,__LINE__)) - SHR_ASSERT_ALL((ubound(rt) == (/bounds%endc, ubj, ntrcs/)) , errMsg(__FILE__,__LINE__)) - SHR_ASSERT_ALL((ubound(source) == (/bounds%endc, ubj, ntrcs/)), errMsg(__FILE__,__LINE__)) - - SHR_ASSERT_ALL(((/ubound(trcin,1),ubound(trcin,2),size(trcin,3)/) == (/bounds%endc, ubj, ntrcs/)), errMsg(__FILE__,__LINE__)) - - - - !zero flux is imposed both at the top and bottom boundaries - !set zero outgoing flux - bot = 0._r8 - do fc = 1, numfl - c = filter(fc) - if(update_col(c))then - dtime=dtime_col(c) - do j = lbn(c), ubj - do k = 1, ntrcs - if(j==lbn(c))then - Fr=-hmconductance(c,j)*(trcin(c,j+1,k)-trcin(c,j,k)) - Fl=0._r8 !zero flux at top boundary for solid phase - elseif(j==ubj)then - !assume zero flux for diffusion - Fl=-hmconductance(c,j-1)*(trcin(c,j,k)-trcin(c,j-1,k)) - Fr=bot - else - Fl=-hmconductance(c,j-1)*(trcin(c,j,k)-trcin(c,j-1,k)) - Fr=-hmconductance(c,j)*(trcin(c,j+1,k)-trcin(c,j,k)) - endif - rt(c,j,k) = Fl-Fr + source(c,j,k)*dz(c,j) - enddo - enddo - - do j = lbn(c), ubj - if(j==lbn(c))then - !top boundary condition given as flux - at(c,j)=0._r8 - bt(c,j)=dz(c,j)/dtime+cntheta*hmconductance(c,j) - ct(c,j)=-cntheta*hmconductance(c,j) - elseif(j==ubj)then - at(c,j)=-cntheta*hmconductance(c,j-1) - bt(c,j)=dz(c,j)/dtime+cntheta*hmconductance(c,j-1) - else - at(c,j)=-cntheta*hmconductance(c,j-1) - ct(c,j)=-cntheta*hmconductance(c,j) - bt(c,j)=dz(c,j)/dtime-at(c,j)-ct(c,j) - endif - enddo - endif - enddo - - end subroutine DiffusTransp_solid_tridiag - !------------------------------------------------------------------------------- - - subroutine DiffusTransp_solid(bounds, lbj, ubj, lbn, numfl, filter, ntrcs, trcin,& - hmconductance, dtime_col, dz, source, update_col, dtracer) - ! - ! !DESCRIPTION: - ! Do diffusive solid phase tracer transport - ! - ! !USES: - use shr_kind_mod, only: r8 => shr_kind_r8 - use decompMod, only : bounds_type - use TridiagonalMod, only : Tridiagonal - - implicit none - ! !ARGUMENTS: - type(bounds_type), intent(in) :: bounds ! bounds - integer , intent(in) :: lbj, ubj ! lbinning and ubing level indices - integer , intent(in) :: lbn(bounds%begc: ) ! indices of top boundary - integer , intent(in) :: numfl ! filter dimension - integer , intent(in) :: filter(:) ! filter - integer , intent(in) :: ntrcs - real(r8) , intent(in) :: hmconductance(bounds%begc: , lbj: ) ! weighted conductance - real(r8) , intent(in) :: dtime_col(bounds%begc: ) ! model time step - real(r8) , intent(in) :: dz(bounds%begc: , lbj: ) ! layer thickness - real(r8) , intent(in) :: trcin (bounds%begc: , lbj: , 1: ) ! tracer concentration [mol/m3] - real(r8) , intent(in) :: source(bounds%begc: , lbj: , 1: ) ! chemical sources [mol/m3/s] - logical , intent(in) :: update_col(bounds%begc: ) ! logical switch indicating if the column is for active update - real(r8), intent(inout) :: dtracer(bounds%begc: , lbj: ,1: ) ! update to the tracer - - ! !LOCAL VARIABLES: - real(r8) :: at(bounds%begc:bounds%endc, lbj:ubj) !returning tridiagonal a matrix - real(r8) :: bt(bounds%begc:bounds%endc, lbj:ubj) !returning tridiagonal b matrix - real(r8) :: ct(bounds%begc:bounds%endc, lbj:ubj) !returning tridiagonal c matrix - real(r8) :: rt(bounds%begc:bounds%endc, lbj:ubj, 1:ntrcs) !returning tridiagonal r matrix - character(len=255) :: subname = 'DiffusTransp_solid' - - SHR_ASSERT_ALL((ubound(lbn) == (/bounds%endc/)), errMsg(__FILE__,__LINE__)) - SHR_ASSERT_ALL((ubound(hmconductance) == (/bounds%endc, ubj-1/)), errMsg(__FILE__,__LINE__)) - SHR_ASSERT_ALL((ubound(dz) == (/bounds%endc, ubj/)), errMsg(__FILE__,__LINE__)) - SHR_ASSERT_ALL((ubound(update_col) == (/bounds%endc/)), errMsg(__FILE__,__LINE__)) - SHR_ASSERT_ALL((ubound(dtime_col) == (/bounds%endc/)), errMsg(__FILE__,__LINE__)) - SHR_ASSERT_ALL((ubound(dtracer) == (/bounds%endc, ubj, ntrcs/)), errMsg(__FILE__,__LINE__)) - SHR_ASSERT_ALL((ubound(source) == (/bounds%endc, ubj, ntrcs/)), errMsg(__FILE__,__LINE__)) - - SHR_ASSERT_ALL(((/ubound(trcin,1),ubound(trcin,2),size(trcin,3)/) == (/bounds%endc, ubj,ntrcs/)), errMsg(__FILE__,__LINE__)) - - - !assemble the tridiagonal matrix - call Diffustransp_solid_tridiag(bounds, lbj, ubj, lbn, numfl, filter, ntrcs, trcin,& - hmconductance, dtime_col, dz, source, update_col, at,bt,ct, rt) - - !calculate the change to tracer - call Tridiagonal (bounds, lbj, ubj, lbn, numfl, filter, ntrcs, at, bt, ct, rt, dtracer, update_col) - - end subroutine DiffusTransp_solid - !------------------------------------------------------------------------------- - function calc_col_CFL(lbj, ubj, us, dx, dtime) result(cfl) - ! - ! DESCRIPTION: - ! calculate the CFL number for the given grid and velocity field - ! this subroutine is now not actively used, but can be used - ! when a Eulerian advection scheme is adopted. - implicit none - ! !ARGUMENTS: - integer, intent(in) :: lbj, ubj !left and right bounds - real(r8), intent(in) :: us(lbj: ) !velocity vector, [m/s] - real(r8), intent(in) :: dx(lbj: ) !node length, [m] - real(r8), intent(in) :: dtime !imposed time step, [s] - - ! !LOCAL VARIABLES: - real(r8) :: cfl - integer :: len, j - character(len=32) :: subname ='calc_col_CFL' - - SHR_ASSERT_ALL((ubound(us) == (/ubj+1/)), errMsg(__FILE__,__LINE__)) - SHR_ASSERT_ALL((ubound(dx) == (/ubj/)), errMsg(__FILE__,__LINE__)) - - cfl = 0._r8 - !the column cfl number is defined as the maximum over the whole domain - do j = lbj, ubj - if(us(j)>0._r8)then - if(us(j)<0._r8)then - cfl= max(dtime/dx(j)*max(abs(us(j)), abs(us(j+1))), cfl) - else - cfl=max(abs(dtime*us(j)/dx(j)), cfl) - endif - else - if(us(j+1)>0._r8)then - cfl=max(abs(dtime*us(j+1)/dx(j)),cfl) - else - cfl= max(dtime/dx(j)*max(abs(us(j)), abs(us(j+1))), cfl) - endif - endif - enddo - end function calc_col_CFL - - !------------------------------------------------------------------------------- - subroutine semi_lagrange_adv_backward(bounds, lbj, ubj, lbn, numfl, filter, ntrcs, dtime, dz, & - zi, us, inflx_top, inflx_bot, update_col, halfdt_col, trcin, trcou, leaching_mass) - ! - ! DESCRIPTION: - ! do semi-lagrangian advection for equation - ! pu/pt+c*pu/px=0 - ! for a certain tracer group - ! - ! !USES: - use shr_kind_mod, only : r8 => shr_kind_r8 - use decompMod, only : bounds_type - use MathfuncMod, only : cumsum, cumdif, safe_div, dot_sum, asc_sort_vec - use InterpolationMod, only : pchip_polycc, pchip_interp - - implicit none - ! !ARGUMENTS: - type(bounds_type) , intent(in) :: bounds !bounds - integer , intent(in) :: lbj, ubj ! lbinning and ubing level indices - integer , intent(in) :: lbn(bounds%begc: ) !label of the top/left boundary - integer , intent(in) :: numfl - integer , intent(in) :: ntrcs - integer , intent(in) :: filter(:) - real(r8) , intent(in) :: dtime(bounds%begc: ) - real(r8) , intent(in) :: zi(bounds%begc: , lbj-1: ) - real(r8) , intent(in) :: dz(bounds%begc: , lbj: ) - real(r8) , intent(in) :: inflx_top(bounds%begc: , 1: ) ! incoming tracer flow at top boundary [mol/m2/s] - real(r8) , intent(in) :: inflx_bot(bounds%begc: , 1: ) !incoming tracer flow at bottom boundary - logical , intent(in) :: update_col(bounds%begc: ) !indicator of active clumns - real(r8) , intent(in) :: us(bounds%begc: , lbj-1: ) !convective flux defined at the boundary, positive downwards, [m/s] - logical , intent(out) :: halfdt_col(bounds%begc:bounds%endc) - real(r8) , intent(in) :: trcin(bounds%begc: , lbj: , 1: ) !input tracer concentration - real(r8) , intent(out) :: trcou(bounds%begc: , lbj: , 1: ) - real(r8), optional, intent(out) :: leaching_mass(bounds%begc: , 1: ) !leaching tracer mass - - ! !LOCAL VARIABLES: - integer, parameter :: pn = 2 !first order lagrangian interpolation to avoid overshooting - integer :: j, fc, c, k - integer :: ntr !indices for tracer - integer :: length, lengthp2 - real(r8) :: mass_curve(0:ubj-lbj+5 , ntrcs) !total number of nodes + two ghost cells at each boundary - real(r8) :: cmass_curve(0:ubj-lbj+5, ntrcs) - real(r8) :: mass_new(1:ubj-lbj+1 , ntrcs) - real(r8) :: cmass_new(0:ubj-lbj+1 , ntrcs) - real(r8) :: zold(0:ubj-lbj+1) - real(r8) :: di(0:ubj-lbj+5) - real(r8) :: zghostl(1:2) !ghost grid left interface at the left boundary - real(r8) :: zghostr(1:2) !ghost grid left interface at the right boundary - real(r8) :: ughostl(1:2) !flow velocity at the ghost grid leff interface at the left boundary - real(r8) :: ughostr(1:2) !flow velocity at the ghost grid leff interface at the right boundary - real(r8) :: z0 - real(r8) :: zf - real(r8) :: utmp - real(r8) :: dinfl_mass - character(len=32) :: subname='semi_lagrange_adv_backward' - - SHR_ASSERT_ALL((ubound(lbn) == (/bounds%endc/)), errMsg(__FILE__,__LINE__)) - SHR_ASSERT_ALL((ubound(dtime) == (/bounds%endc/)), errMsg(__FILE__,__LINE__)) - SHR_ASSERT_ALL((ubound(dz) == (/bounds%endc, ubj/)), errMsg(__FILE__,__LINE__)) - SHR_ASSERT_ALL((ubound(update_col) == (/bounds%endc/)), errMsg(__FILE__,__LINE__)) - SHR_ASSERT_ALL((ubound(us) == (/bounds%endc, ubj/)), errMsg(__FILE__,__LINE__)) - SHR_ASSERT_ALL((ubound(zi) == (/bounds%endc, ubj/)), errMsg(__FILE__,__LINE__)) - SHR_ASSERT_ALL((ubound(inflx_top) == (/bounds%endc, ntrcs/)), errMsg(__FILE__,__LINE__)) - SHR_ASSERT_ALL((ubound(inflx_bot) == (/bounds%endc, ntrcs/)), errMsg(__FILE__,__LINE__)) - SHR_ASSERT_ALL((ubound(leaching_mass) == (/bounds%endc,ntrcs/)), errMsg(__FILE__,__LINE__)) - SHR_ASSERT_ALL((ubound(trcou) == (/bounds%endc, ubj,ntrcs/)), errMsg(__FILE__,__LINE__)) - SHR_ASSERT_ALL(((/ubound(trcin,1),ubound(trcin,2),size(trcin,3)/) == (/bounds%endc, ubj,ntrcs/)), errMsg(__FILE__,__LINE__)) - - - - call Extra_inst%InitAllocate(1,ubj-lbj+6) - halfdt_col(:) = .false. - do fc = 1, numfl - - c = filter(fc) - if(.not. update_col(c))cycle - !do backward advection for all boundaries, including leftmost (lbn(c)-1) and rightmost (ubj) - length = ubj - lbn(c) + 1 !total number of grid cells - lengthp2 = length + 4 ! add 2 ghost cells both at the left and right boundaries - - !define ghost boundary - !NOTE: because of the setup, the left boundary and right boundary should have non-zero flow - utmp = us(c,lbn(c)-1) - zghostl(1) = -abs(utmp)*dtime(c)*2._r8 + zi(c,lbn(c)-1)-2.e-20_r8 - zghostl(2) = -abs(utmp)*dtime(c) + zi(c,lbn(c)-1)-1.e-20_r8 - ughostl(1) = us(c,lbn(c)-1) - ughostl(2) = us(c,lbn(c)-1) - - zghostr(1) = zi(c,ubj) + abs(us(c,ubj)) * dtime(c) + 1.e-14_r8 - zghostr(2) = zi(c,ubj) + abs(us(c,ubj)) * dtime(c) * 2._r8+ 2.e-14_r8 - - ughostr(1) = us(c,ubj) - ughostr(2) = us(c,ubj) - - call backward_advection((/zghostl, zi(c, lbn(c)-1:ubj),zghostr/), (/ughostl, us(c, lbn(c)-1:ubj), ughostr/), dtime(c), zold(0:length)) - - if(.not. is_ascending_vec(zold(0:length)))then - halfdt_col(c) = .true. - cycle - endif - - !create the cumulative mass curve - do ntr = 1, ntrcs - !left boundary ghost grids - j = 0 - mass_curve(j, ntr) = 0._r8 - j = 1 - mass_curve(j, ntr) = inflx_top(c, ntr)*dtime(c) - j = 2 - mass_curve(j, ntr) = inflx_top(c, ntr)*dtime(c) - - !regular grids - do k = lbn(c), ubj - j = k - lbn(c) + 3 - mass_curve(j, ntr) = trcin(c,k, ntr)*dz(c,k) - enddo - - !right ghost grids - if(inflx_bot(c,ntr)==0._r8)then - j = ubj - lbn(c) + 4 - mass_curve(j, ntr) = trcin(c,ubj, ntr)*(zghostr(1)-zi(c,ubj)) - - j = ubj - lbn(c) + 5 - mass_curve(j, ntr) = trcin(c,ubj, ntr)*(zghostr(2)-zghostr(1)) - else - j = ubj - lbn(c) + 4 - mass_curve(j, ntr) = inflx_bot(c, ntr) * dtime(c) - - j = ubj - lbn(c) + 5 - mass_curve(j, ntr) = inflx_bot(c, ntr) * dtime(c) - endif - enddo - !compute cumulative mass curve - call cumsum(mass_curve(0:lengthp2,1:ntr), cmass_curve(0:lengthp2, 1:ntr),idim=1) - - !do mass interpolation - do ntr = 1, ntrcs - call pchip_polycc((/zghostl,zi(c,lbn(c)-1:ubj),zghostr/), cmass_curve(0:lengthp2, ntr), di(0:lengthp2)) - - call pchip_interp((/zghostl,zi(c,lbn(c)-1:ubj),zghostr/), cmass_curve(0:lengthp2, ntr), di(0:lengthp2),& - zold(0:length), cmass_new(0:length, ntr)) - - !ensure mass is increasing monotonically - call asc_sort_vec(cmass_new(0:length,ntr)) - - !ensure no negative leaching - call cmass_mono_smoother(cmass_new(0:length, ntr),cmass_curve(ubj-lbn(c)+3, ntr)) - - !diagnose the leaching flux - if(present(leaching_mass))then - leaching_mass(c, ntr) = cmass_curve(ubj-lbn(c)+3, ntr)-cmass_new(length, ntr) !add the numerical error to leaching - endif - - !obtain the grid concentration - call cumdif(cmass_new(0:length, ntr), mass_new(0:length, ntr)) - do k = lbn(c), ubj - j = k - lbn(c) + 1 - !correct for small negative values - if(mass_new(j, ntr)<0._r8)then - write(iulog,*)j,mass_new(j, ntr),cmass_new(j, ntr),cmass_new(j-1, ntr) - call endrun('negative tracer '//errMsg(__FILE__, __LINE__)) - if(present(leaching_mass))then - leaching_mass(c, ntr) = leaching_mass(c, ntr)+mass_new(j, ntr) !add the numerical error to leaching - endif - mass_new(j, ntr)=mass_curve_correct(mass_new(j, ntr)) - endif - trcou(c,k, ntr)=mass_new(j, ntr)/dz(c,k) - enddo - enddo - - enddo - call Extra_inst%DDeallocate() - end subroutine semi_lagrange_adv_backward - !------------------------------------------------------------------------------- - subroutine cmass_mono_smoother(cmass,mass_thc) - ! - ! !DESCRIPTION: - ! assuming cmass is sorted as ascending vector, make sure no mass is greater than mass_thc - ! - implicit none - ! !ARGUMENTS: - real(r8), dimension(:), intent(inout) :: cmass - real(r8), intent(in) :: mass_thc - ! !LOCAL VARIABLES: - integer :: n , j - character(len=32) :: subname = 'cmass_mono_smoother' - - n = size(cmass) - do j = n, 1 - if(cmass(j)>=mass_thc)then - cmass(j) = mass_thc - else - exit - endif - enddo - end subroutine cmass_mono_smoother - !------------------------------------------------------------------------------- - - function is_ascending_vec(zcor)result(ans) - ! - ! DESCRIPTION: - ! check if it is an ascending array - - implicit none - ! !ARGUMENTS: - real(r8), dimension(:), intent(in) :: zcor - - ! !LOCAL VARIABLES: - logical :: ans - integer :: j, n - character(len=32) :: subname= 'is_ascending_vec' - - n = size(zcor) - ans = .true. - do j = 2 , n - if(zcor(j) shr_log_errMsg - implicit none - save - private ! By default everything is public - - public :: betr_initialize - public :: betr_readNL - character(len=32) :: bgc_method='mock_run' - - ! - !----------------------------------------- - ! Instances of component types - !----------------------------------------- - type(BeTRtracer_type) , public :: betrtracer_vars - type(TracerCoeff_type) , public :: tracercoeff_vars - type(TracerFlux_type) , public :: tracerflux_vars - type(TracerState_type) , public :: tracerState_vars - type(tracerboundarycond_type) , public :: tracerboundarycond_vars - type(plantsoilnutrientflux_type) , public :: plantsoilnutrientflux_vars - class(bgc_reaction_type),allocatable , public :: bgc_reaction - -contains - - !------------------------------------------------------------------------------- - subroutine betr_readNL(NLFilename) - ! - ! !DESCRIPTION: - ! read namelist for betr configuration - ! !USES: - use spmdMod , only : masterproc, mpicom - use fileutils , only : getavu, relavu, opnfil - use shr_nl_mod , only : shr_nl_find_group_name - use shr_mpi_mod , only : shr_mpi_bcast - implicit none - ! !ARGUMENTS: - character(len=*), intent(IN) :: NLFilename ! Namelist filename - ! - ! !LOCAL VARIABLES: - integer :: ierr ! error code - integer :: unitn ! unit for namelist file - character(len=32) :: subname = 'betr_readNL' ! subroutine name - !----------------------------------------------------------------------- - - namelist / betr_inparm / bgc_method - - ! ---------------------------------------------------------------------- - ! Read namelist from standard input. - ! ---------------------------------------------------------------------- - - if ( masterproc )then - - unitn = getavu() - write(iulog,*) 'Read in betr_inparm namelist' - call opnfil (NLFilename, unitn, 'F') - call shr_nl_find_group_name(unitn, 'clm_CanopyHydrology_inparm', status=ierr) - if (ierr == 0) then - read(unitn, betr_inparm, iostat=ierr) - if (ierr /= 0) then - call endrun(msg="ERROR reading betr_inparm namelist"//errmsg(__FILE__, __LINE__)) - end if - end if - call relavu( unitn ) - - end if - ! Broadcast namelist variables read in - call shr_mpi_bcast(bgc_method, mpicom) - - end subroutine betr_readNL - - !------------------------------------------------------------------------------- - subroutine betr_initialize(bounds, lbj, ubj, waterstate_vars) - ! - ! !DESCRIPTION: - ! Initialize BeTR - ! - ! !USES: - use decompMod , only : bounds_type - use BGCReactionsFactoryMod, only : ctreate_bgc_reaction_type - use BetrBGCMod , only : betrbgc_init - use TransportMod , only : init_transportmod - use TracerParamsMod , only : tracer_param_init - use WaterstateType , only : waterstate_type - - implicit none - ! !ARGUMENTS: - type(bounds_type) , intent(in) :: bounds - integer , intent(in) :: lbj, ubj - type(waterstate_type), intent(in) :: waterstate_vars - - call betrtracer_vars%init_scalars() - - allocate(bgc_reaction, source=ctreate_bgc_reaction_type(bgc_method)) - - call bgc_reaction%Init_betrbgc(bounds, lbj, ubj, betrtracer_vars) - - call init_transportmod - - call tracerState_vars%Init(bounds, lbj, ubj, betrtracer_vars) - - call tracerflux_vars%Init(bounds, lbj, ubj, betrtracer_vars) - - call tracercoeff_vars%Init(bounds, lbj, ubj, betrtracer_vars) - - call tracerboundarycond_vars%Init(bounds, betrtracer_vars) - - call plantsoilnutrientflux_vars%Init(bounds, lbj, ubj) - - !initialize state variable - call bgc_reaction%initCold(bounds, betrtracer_vars, waterstate_vars, tracerstate_vars) - - !initialize boundary condition type - call bgc_reaction%init_boundary_condition_type(bounds, betrtracer_vars, tracerboundarycond_vars) - - !initialize the betr parameterization module - call tracer_param_init(bounds) - - !initialize the betrBGC module - call betrbgc_init(bounds, betrtracer_vars) - - end subroutine betr_initialize - !--------------------------------------------------------------------------------- - -end module betr_initializeMod diff --git a/components/clm/src/betr/betr_math/FindRootMod.F90 b/components/clm/src/betr/betr_math/FindRootMod.F90 deleted file mode 100644 index 5b3395d62deb..000000000000 --- a/components/clm/src/betr/betr_math/FindRootMod.F90 +++ /dev/null @@ -1,935 +0,0 @@ -module FindRootMod - ! - ! !DESCRIPTION: - ! Functions to solve simple equations - ! History: created by Jinyun Tang, 2013 - - ! !USES: - use shr_kind_mod , only : r8 => shr_kind_r8 - use shr_log_mod , only : errMsg => shr_log_errMsg - use abortutils , only : endrun - use clm_varctl , only : iulog - use MathfuncMod , only : is_bounded - implicit none - interface hybrid_findroot - module procedure hybrid_findroot_np, hybrid_findroot_p - end interface hybrid_findroot - - interface brent - module procedure brent_np, brent_p - end interface brent - -contains - !------------------------------------------------------------------------------- - function quadrootbnd(a,b,c, xl, xr)result(x) - ! - ! !DESCRIPTION: - ! return a root of the qudratic equation - ! within bound xl and xr - - implicit none - ! !ARGUMENTS: - real(r8), intent(in) :: a, b, c - real(r8), intent(in) :: xl, xr - - ! !LOCAL VARIABLES: - real(r8) :: x - real(r8) :: delta - character(len=32) :: subname ='quadrootbnd' - - delta = b * b -4._r8 * a * c - if(delta>=0._r8)then - x = (-b + sqrt(delta))/2._r8 - if(is_bounded(x,xl,xr))then - return - else - x = (-b - sqrt(delta))/2._r8 - if(is_bounded(x,xl,xr))then - return - else - write(iulog,*)'no bounded solution for the given quadratic equation' - call endrun(msg=errmsg(__FILE__, __LINE__)) - endif - endif - else - write(iulog,*)'no real solution for the given quadratic equation' - call endrun(msg=errmsg(__FILE__, __LINE__)) - endif - return - end function quadrootbnd - - !------------------------------------------------------------------------------- - - function quadproot(a,b,c)result(x) - ! - ! !DESCRIPTION: - ! return positive root of the qudratic equation - - implicit none - ! !ARGUMENTS: - real(r8), intent(in) :: a, b, c - - ! !LOCAL VARIABLES: - real(r8) :: x - real(r8) :: delta - character(len=32) :: subname ='quadproot' - - delta = b * b -4._r8 * a * c - if(delta>=0._r8)then - x = (-b + sqrt(delta))/2._r8 - else - write(iulog,*)'no positive solution for the given quadratic equation' - call endrun(msg=errmsg(__FILE__, __LINE__)) - endif - return - end function quadproot - !=============================================================================== - - function cubicrootbnd(a,b,c,d, xl, xr)result(x) - ! - ! !DESCRIPTION: - ! return positive root of the cubic equation - ! - ! !USES: - use clm_varcon , only : rpi - implicit none - ! !ARGUMENTS: - real(r8), intent(in) :: a, b, c, d - real(r8), intent(in) :: xl, xr - - ! !LOCAL VARIABLES: - real(r8) :: x - real(r8) :: p, q - real(r8) :: b1, c1, d1 - real(r8) :: n, u, f, y - real(r8) :: delta - character(len=32) :: subname ='cubicrootbnd' - - b1 = b/a - c1 = c/a - d1 = d/a - - p = c1 - b1 * b1 /3._r8 - q = d1 - b1 / 3._r8 * (c1 - 2._r8 * b1**2._r8/9._r8) - - delta =-4._r8 * p**3._r8 - 27._r8 * q ** 2._r8 - if(delta<0._r8)then - write(iulog,*)'no real solution for the given cubic equation' - call endrun(msg=errmsg(__FILE__, __LINE__)) - else - n = sqrt(-4._r8*p/3._r8) - f = -q/2._r8 * (-p/3._r8)**(-1.5_r8) - u = acos(f)/3._r8 - - y = n * cos(u) - x = y - b1 / 3._r8 - if(is_bounded(x,xl,xr))then - return - else - y = n * max(cos(u), cos(u-rpi*2._r8/3._r8)) - x = y - b1 /3._r8 - if(is_bounded(x,xl,xr))then - return - else - y = n * cos(u-rpi*2._r8/3._r8) - x = y - b1 / 3._r8 - if(is_bounded(x,xl,xr))then - return - else - write(iulog,*)'no bounded solution for the given cubic equation' - call endrun(msg=errmsg(__FILE__, __LINE__)) - endif - endif - endif - - endif - end function cubicrootbnd - - !=============================================================================== - function cubicproot(a,b,c,d)result(x) - ! - ! !DESCRIPTION: - ! return positive root of the cubic equation - ! - ! !USES: - use clm_varcon , only : rpi - implicit none - ! !ARGUMENTS: - real(r8), intent(in) :: a, b, c, d - ! !LOCAL VARIABLES: - real(r8) :: x - real(r8) :: p, q - real(r8) :: b1, c1, d1 - real(r8) :: n, u, f, y - real(r8) :: delta - b1 = b/a - c1 = c/a - d1 = d/a - - p = c1 - b1 * b1 /3._r8 - q = d1 - b1 / 3._r8 * (c1 - 2._r8 * b1**2._r8/9._r8) - - delta =-4._r8 * p**3._r8 - 27._r8 * q ** 2._r8 - if(delta<0._r8)then - write(iulog,*)'no real solution for the given cubic equation' - call endrun(msg=errmsg(__FILE__, __LINE__)) - else - n = sqrt(-4._r8*p/3._r8) - f = -q/2._r8 * (-p/3._r8)**(-1.5_r8) - u = acos(f)/3._r8 - - if(u<=rpi/3._r8)then - y = n * cos(u) - elseif(u>rpi/3._r8 .and. u < rpi/2._r8)then - !return the maximum of the two non-negative solutions - y = n * max(cos(u), cos(u-rpi*2._r8/3._r8)) - else - y = n * cos(u-rpi*2._r8/3._r8) - endif - x = y - b1 / 3._r8 - endif - end function cubicproot - - !=============================================================================== - - subroutine LUsolvAxr(a,r, n) - ! !DESCRIPTION: - !solve linear equation Ax=r, using the LU decomposition - implicit none - ! !ARGUMENTS: - real(r8) , intent(inout) :: a(n,n) - real(r8) , intent(inout) :: r(n) - integer , intent(in) :: n - - ! !LOCAL VARIABLES: - real(r8) :: d(n) - integer :: indx(n) - - !do lu decomposition - call ludcmp(a,indx,d,n) - - !solve for the equation - - call lubksb(a,indx,r,n) - end subroutine LUsolvAxr - !=============================================================================== - - subroutine lubksb(a,indx,b,n) - ! - ! !DESCRIPTION: - ! Solves the set of N linear equations A X = B. Here the N x N matrix a is input, not - ! as the original matrix A, but rather as its LU decomposition, determined by the routine - ! ludcmp. indx is input as the permutation vector of length N returned by ludcmp. b is - ! input as the right-hand-side vector B, also of length N, and returns with the solution vector - ! X. a and indx are not modified by this routine and can be left in place for successive calls - ! with different right-hand sides b. This routine takes into account the possibility that b will - ! begin with many zero elements, so it is efficient for use in matrix inversion. - - implicit none - ! !ARGUMENTS: - real(r8) , intent(in) :: a(n,n) - integer , intent(in) :: indx(n) - real(r8) , intent(inout) :: b(n) - integer , intent(in) :: n - - ! !LOCAL VARIABLES: - integer :: i,ii,ll - real(r8) :: summ - - ii=0 !When ii is set to a positive value, it will become the index - ! of the first nonvanishing element of b. We now do - ! the forward substitution, equation (2.3.6). The only new - ! wrinkle is to unscramble the permutation as we go. - do i=1,n - ll=indx(i) - summ=b(ll) - b(ll)=b(i) - if (ii /= 0) then - summ=summ-dot_product(a(i,ii:i-1),b(ii:i-1)) - else if (summ /= 0.0) then - ii=i !A nonzero element was encountered, so from now on we will - end if !have to do the dot product above. - b(i)=summ - end do - do i=n,1,-1 !Now we do the backsubstitution, equation (2.3.7). - b(i) = (b(i)-dot_product(a(i,i+1:n),b(i+1:n)))/a(i,i) - end do - end subroutine lubksb - !=============================================================================== - - - subroutine ludcmp(a,indx,d,n) - ! !DESCRIPTION: - ! - ! LU docomposition - ! adapted from Numerical recipe, chptB2 - ! Given an N by N input matrix a, this routine replaces it by the LU decomposition of a - ! rowwise permutation of itself. On output, a is arranged as in equation (2.3.14); indx is an - ! output vector of length N that records the row permutation effected by the partial pivoting; - ! d is output as �1 depending on whether the number of row interchanges was even or odd, - ! respectively. This routine is used in combination with lubksb to solve linear equations or - ! invert a matrix. - ! - ! !USES: - use MathfuncMod, only : swap - implicit none - ! !ARGUMENTS: - real(r8), intent(inout) :: a(n,n) - integer , intent(out) :: indx(n) - real(r8) , intent(out) :: d(n) - integer , intent(in) :: n - - ! !LOCAL VARIABLES: - real(r8), dimension(size(a,1)) :: vv !vv stores the implicit scaling of each row. - real(r8), parameter :: TINY=1.0e-20 !A small number. - integer :: j,imax - - - d=1.0 !No row interchanges yet. - vv=maxval(abs(a),dim=2) !Loop over rows to get the implicit scaling - if (any(vv == 0.0)) then - write(6,*)'singular matrix in ludcmp' !information. - stop - endif - !There is a row of zeros. - vv=1.0 / vv !Save the scaling. - do j=1,n - imax=(j-1)+imaxloc(vv(j:n)*abs(a(j:n,j))) !Find the pivot row. - if (j /= imax) then !Do we need to interchange rows? - call swap(a(imax,:),a(j,:)) !Yes, do so... - d=-d !...and change the parity of d. - vv(imax)=vv(j) !Also interchange the scale factor. - end if - indx(j)=imax - if (a(j,j) == 0.0) a(j,j)=TINY - ! If the pivot element is zero the matrix is singular (at least to the precision of the algorithm). - ! For some applications on singular matrices, it is desirable to substitute TINY - ! for zero. - a(j+1:n,j)=a(j+1:n,j)/a(j,j) !Divide by the pivot element. - a(j+1:n,j+1:n)=a(j+1:n,j+1:n)-outerprod(a(j+1:n,j),a(j,j+1:n)) - !Reduce remaining submatrix. - end do - end subroutine ludcmp - !=============================================================================== - function imaxloc(arr) - ! - ! !DESCRIPTION: - ! locate the maximum in a vector - - implicit none - ! !ARGUMENTS: - real(r8), dimension(:), intent(in) :: arr - - ! !LOCAL VARIABLES: - integer :: imaxloc - integer, dimension(1) :: imax - - imax=maxloc(arr(:)) - imaxloc=imax(1) - - end function imaxloc - - !=============================================================================== - - function outerprod(a,b) - ! !DESCRIPTION: - ! do out product of two vectors - - implicit none - ! !ARGUMENTS: - real(r8), dimension(:), intent(in) :: a,b - - ! !LOCAL VARIABLES: - real(r8), dimension(size(a),size(b)) :: outerprod - - outerprod = spread(a,dim=2,ncopies=size(b)) * & - spread(b,dim=1,ncopies=size(a)) - - end function outerprod - !------------------------------------------------------------------------------- - !BOP - ! - ! !IROUTINE: brent - ! - ! !INTERFACE: - - subroutine brent_p(x, x1,x2,f1, f2, macheps, tol, pp, func) - - ! - !!DESCRIPTION: - !Use Brent's method to find the root of a single variable function func, which is known to exist between x1 and x2. - !The found root will be updated until its accuracy is tol. - - !!REVISION HISTORY: - !Dec 14/2012: Jinyun Tang, modified from numerical recipes in F90 by press et al. 1188-1189 - ! - !!USES: - - - ! - !!ARGUMENTS: - implicit none - real(r8), intent(in) :: x1, x2, f1, f2 !minimum and maximum of the variable domain to search for the solution ci_func(x1) = f1, ci_func(x2)=f2 - real(r8), intent(in) :: macheps !machine precision - integer, intent(in) :: pp !index argument used by subroutine func - real(r8), intent(in) :: tol !the error tolerance - real(r8), intent(out):: x !indepedent variable of the single value function func(x) - - interface - subroutine func(x,f, pp) - use shr_kind_mod , only : r8 => shr_kind_r8 - implicit none - real(r8), intent(in) :: x - real(r8), intent(out) :: f - integer, intent(in) :: pp - end subroutine func - end interface - - ! !LOCAL VARIABLES: - integer, parameter :: ITMAX = 40 !maximum number of iterations - integer :: iter - real(r8) :: a,b,c,d,e,fa,fb,fc,p,q,r,s,xm,tol1 - - - a=x1 - b=x2 - fa=f1 - fb=f2 - if((fa > 0._r8 .and. fb > 0._r8).or.(fa < 0._r8 .and. fb < 0._r8))then - write(iulog,*) 'root must be bracketed for brent' - write(iulog,*) 'a=',a,' b=',b,' fa=',fa,' fb=',fb - call endrun(msg=errmsg(__FILE__, __LINE__)) - endif - c=b - fc=fb - iter = 0 - do - if(iter==ITMAX)exit - iter=iter+1 - if((fb > 0._r8 .and. fc > 0._r8) .or. (fb < 0._r8 .and. fc < 0._r8))then - c=a !Rename a, b, c and adjust bounding interval d. - fc=fa - d=b-a - e=d - endif - if( abs(fc) < abs(fb)) then - a=b - b=c - c=a - fa=fb - fb=fc - fc=fa - endif - tol1=2._r8*macheps*abs(b)+0.5_r8*tol !Convergence check. - xm=0.5_r8*(c-b) - if(abs(xm) <= tol1 .or. fb == 0.)then - x=b - return - endif - if(abs(e) >= tol1 .and. abs(fa) > abs(fb)) then - s=fb/fa !Attempt inverse quadratic interpolation. - if(a == c) then - p=2._r8*xm*s - q=1._r8-s - else - q=fa/fc - r=fb/fc - p=s*(2._r8*xm*q*(q-r)-(b-a)*(r-1._r8)) - q=(q-1._r8)*(r-1._r8)*(s-1._r8) - endif - if(p > 0._r8) q=-q !Check whether in bounds. - p=abs(p) - if(2._r8*p < min(3._r8*xm*q-abs(tol1*q),abs(e*q))) then - e=d !Accept interpolation. - d=p/q - else - d=xm !Interpolation failed, use bisection. - e=d - endif - else !Bounds decreasing too slowly, use bisection. - d=xm - e=d - endif - a=b !Move last best guess to a. - fa=fb - if(abs(d) > tol1) then !Evaluate new trial root. - b=b+d - else - b=b+sign(tol1,xm) - endif - call func(b,fb, pp) - if(fb==0._r8)exit - enddo - if(iter==ITMAX)write(iulog,*) 'brent exceeding maximum iterations', b, fb - x=b - - end subroutine brent_p - !------------------------------------------------------------------------------ - !BOP - ! - ! !IROUTINE: brent - ! - ! !INTERFACE: - - subroutine brent_np(x, x1,x2,f1, f2, macheps, tol,func) - - ! - !!DESCRIPTION: - !Use Brent's method to find the root to a single variable function func, which is known to exist between x1 and x2. - !The found root will be updated until its accuracy is tol. - - !!REVISION HISTORY: - !Dec 14/2012: Jinyun Tang, modified from numerical recipes in F90 by press et al. 1188-1189 - ! - !!USES: - - ! - !!ARGUMENTS: - implicit none - real(r8), intent(in) :: x1, x2, f1, f2 !minimum and maximum of the variable domain to search for the solution ci_func(x1) = f1, ci_func(x2)=f2 - real(r8), intent(in) :: macheps !machine precision - real(r8), intent(in) :: tol !the error tolerance - real(r8), intent(out):: x - interface - subroutine func(x,f) - use shr_kind_mod , only : r8 => shr_kind_r8 - implicit none - real(r8), intent(in) :: x - real(r8), intent(out) :: f - end subroutine func - end interface - - ! !CALLED FROM: - ! whenever it is needed - - integer, parameter :: ITMAX = 40 !maximum number of iterations - integer, parameter :: iulog = 6 - integer :: iter - real(r8) :: a,b,c,d,e,fa,fb,fc,p,q,r,s,xm,tol1 - - - a=x1 - b=x2 - fa=f1 - fb=f2 - if((fa > 0._r8 .and. fb > 0._r8).or.(fa < 0._r8 .and. fb < 0._r8))then - write(iulog,*) 'root must be bracketed for brent' - write(iulog,*) 'a=',a,' b=',b,' fa=',fa,' fb=',fb - call endrun(msg=errmsg(__FILE__, __LINE__)) - endif - c=b - fc=fb - iter = 0 - do - if(iter==ITMAX)exit - iter=iter+1 - if((fb > 0._r8 .and. fc > 0._r8) .or. (fb < 0._r8 .and. fc < 0._r8))then - c=a !Rename a, b, c and adjust bounding interval d. - fc=fa - d=b-a - e=d - endif - if( abs(fc) < abs(fb)) then - a=b - b=c - c=a - fa=fb - fb=fc - fc=fa - endif - tol1=2._r8*macheps*abs(b)+0.5_r8*tol !Convergence check. - xm=0.5_r8*(c-b) - if(abs(xm) <= tol1 .or. fb == 0.)then - x=b - return - endif - if(abs(e) >= tol1 .and. abs(fa) > abs(fb)) then - s=fb/fa !Attempt inverse quadratic interpolation. - if(a == c) then - p=2._r8*xm*s - q=1._r8-s - else - q=fa/fc - r=fb/fc - p=s*(2._r8*xm*q*(q-r)-(b-a)*(r-1._r8)) - q=(q-1._r8)*(r-1._r8)*(s-1._r8) - endif - if(p > 0._r8) q=-q !Check whether in bounds. - p=abs(p) - if(2._r8*p < min(3._r8*xm*q-abs(tol1*q),abs(e*q))) then - e=d !Accept interpolation. - d=p/q - else - d=xm !Interpolation failed, use bisection. - e=d - endif - else !Bounds decreasing too slowly, use bisection. - d=xm - e=d - endif - a=b !Move last best guess to a. - fa=fb - if(abs(d) > tol1) then !Evaluate new trial root. - b=b+d - else - b=b+sign(tol1,xm) - endif - call func(b, fb) - if(fb==0._r8)exit - enddo - if(iter==ITMAX)write(iulog,*) 'brent exceeding maximum iterations', b, fb - x=b - - end subroutine brent_np - - !------------------------------------------------------------------------------------ - subroutine hybrid_findroot_p(x0, p, iter, func) - ! - !! DESCRIPTION: - ! use a hybrid solver to find the root of equation - ! f(x) = x- h(x), - ! s.t. f(x) = 0. - !the hybrid approach combines the strength of the newton secant approach (find the solution domain) - !and the bisection approach implemented with the Brent's method to guarrantee convergence. - ! - !! REVISION HISTORY: - !Apr 14/2013: created by Jinyun Tang - - implicit none - ! !ARGUMENTS: - real(r8) , intent(inout) :: x0 !solution's initial guess - integer , intent(in) :: p !index used in the function - integer , intent(out) :: iter !number of used iterations - interface - subroutine func(x,f,p) - use shr_kind_mod , only : r8 => shr_kind_r8 - implicit none - real(r8), intent(in) :: x - real(r8), intent(out) :: f - integer, intent(in) :: p - end subroutine func - end interface - - ! !LOCAL VARIABLES: - real(r8) :: a, b - real(r8) :: fa, fb - real(r8) :: x1, f0, f1 - real(r8) :: x, dx - real(r8), parameter :: eps = 1.e-2_r8 !relative accuracy - real(r8), parameter :: eps1= 1.e-4_r8 - integer, parameter :: itmax = 40 !maximum number of iterations - real(r8) :: tol,minx,minf - - - call func(x0, f0, p) - if(f0 == 0._r8)return - - minx=x0 - minf=f0 - x1 = x0 * 0.99_r8 - call func(x1,f1, p) - - if(f1==0._r8)then - x0 = x1 - return - endif - if(f1itmax)then - !in case of failing to converge within itmax iterations - !stop at the minimum function - !this happens because of some other issues besides the stomatal conductance calculation - !and it happens usually in very dry places and more likely with c4 plants. - call func(minx,f1, p) - exit - endif - enddo - end subroutine hybrid_findroot_p - - - !------------------------------------------------------------------------------------ - subroutine hybrid_findroot_np(x0, iter, func) - ! - !! DESCRIPTION: - ! use a hybrid solver to find the root of equation - ! f(x) = x- h(x), - ! s.t. f(x) = 0. - !the hybrid approach combines the strength of the newton secant approach (find the solution domain) - !and the bisection approach implemented with the Brent's method to guarrantee convergence. - - ! - !! REVISION HISTORY: - !Apr 14/2013: created by Jinyun Tang - - implicit none - ! !ARGUMENTS: - real(r8), intent(inout) :: x0 !solution's initial guess - integer, intent(out) :: iter - interface - subroutine func(x,f) - use shr_kind_mod , only : r8 => shr_kind_r8 - implicit none - real(r8), intent(in) :: x - real(r8), intent(out) :: f - end subroutine func - end interface - - ! !LOCAL VARIABLES: - real(r8) :: a, b - real(r8) :: fa, fb - real(r8) :: x1, f0, f1 - real(r8) :: x, dx - real(r8), parameter :: eps = 1.e-2_r8 !relative accuracy - real(r8), parameter :: eps1= 1.e-4_r8 - integer, parameter :: itmax = 40 !maximum number of iterations - real(r8) :: tol,minx,minf - - call func(x0, f0) - if(f0 == 0._r8)return - - minx=x0 - minf=f0 - x1 = x0 * 0.99_r8 - call func(x1,f1) - - if(f1==0._r8)then - x0 = x1 - return - endif - if(f1itmax)then - !in case of failing to converge within itmax iterations - !stop at the minimum function - !this happens because of some other issues besides the stomatal conductance calculation - !and it happens usually in very dry places and more likely with c4 plants. - call func(minx,f1) - exit - endif - enddo - end subroutine hybrid_findroot_np - - !-------------------------------------------------------------------------- - SUBROUTINE gaussian_solve(a,b,error) - ! !DESCRIPTION: - ! This subroutine solves the linear system Ax = b - ! Copyright 1994, Miles Ellis, Ivor Philips and Tom Lahey - ! Copyright 1994, Addison-Wesley Publishers Ltd. - ! Copyright 1994, Addison-Wesley Publishing Company Inc. - ! Permission is granted for the use of this code for the purpose of teaching - ! and/or learning the Fortran 90 language provided that the above copyright - ! notices are included in any copies made. - ! Neither the authors nor the publishers accept any responsibility for - ! any results obtained by use of this code. - ! modified by Jinyun Tang - - ! !ARGUMENTS: - real(r8), dimension(:,:), intent(inout) :: a !coefficients of A - real(r8), dimension(:) , intent(inout) :: b !right handside and solution on returning. - integer, intent(out) :: error ! indicates if errors are found - - ! Reduce the equations by Gaussian elimination - call gaussian_elimination(a,b,error) - - ! If reduction was successful, calculate solution by - ! back substitution - if (error == 0) call back_substitution(a,b,error) - - end subroutine gaussian_solve - - !--------------------------------------------------------------------------- - - subroutine gaussian_elimination(a,b,error) - - ! !DESCRIPTION: - ! This subroutine performs Gaussian elimination on a - ! system of linear equations - ! Copyright 1994, Miles Ellis, Ivor Philips and Tom Lahey - ! Copyright 1994, Addison-Wesley Publishers Ltd. - ! Copyright 1994, Addison-Wesley Publishing Company Inc. - ! Permission is granted for the use of this code for the purpose of teaching - ! and/or learning the Fortran 90 language provided that the above copyright - ! notices are included in any copies made. - ! Neither the authors nor the publishers accept any responsibility for - ! any results obtained by use of this code. - - ! !USES: - use MathfuncMod, only : swap - implicit none - ! !ARGUMENTS: - real(r8), dimension(:,:), intent(inout) :: a !contains the coefficients - real(r8), dimension(:) , intent(inout) :: b !contains the right-hand side - integer, intent(out) :: error - - ! !LOCAL VARIABLES: - real(r8), dimension(size(a,1)) :: temp_array ! Automatic array - integer, dimension(1) :: ksave - integer :: i, j, k, n - real(r8) :: temp, m - - ! Validity checks - n = size(a,1) - - if (n == 0) then - error = -1 ! There is no problem to solve - return - endif - - if (n /= size(a,2))then - error = -2 ! a is not square - return - endif - - if (n/=size(b))then - error = -3 ! Size of b does not match a - return - endif - - ! Dimensions of arrays are OK, so go ahead with Gaussian - ! elimination - error = 0 - - do i = 1, n-1 - ! Find row with largest value of |a(j,i)|, j=i, ..., n - ksave = maxloc(abs(a(i:n, i))) - - ! Check whether largest |a(j,i)| is near zero - k = ksave(1) + i - 1 - - if ( abs(a(k,i)) <= 1.e-5_r8 ) then - error = -4 ! No solution possible - return - endif - - !Interchange row i and row k, if necessary - if(k /= i) then - call swap(a(i,:),a(k,:)) - ! Interchange corresponding elements of b - call swap(b(i), b(k)) - endif - - ! Subtract multiples of row i from subsequent rows to - ! zero all subsequent coefficients of x sub i - do j = i + 1, n - m = a(j,i)/a(i,i) - a(j,:) = a(j,:) - m*a(i,:) - b(j) = b(j) - m*b(i) - enddo - enddo - - end subroutine gaussian_elimination - - - !----------------------------------------------------------------- - SUBROUTINE back_substitution(a,b,error) - - ! !DESCRIPTION: - ! - ! This subroutine performs back substition once a system - ! of equations has been reduced by Gaussian elimination - ! Copyright 1994, Miles Ellis, Ivor Philips and Tom Lahey - ! Copyright 1994, Addison-Wesley Publishers Ltd. - ! Copyright 1994, Addison-Wesley Publishing Company Inc. - ! Permission is granted for the use of this code for the purpose of teaching - ! and/or learning the Fortran 90 language provided that the above copyright - ! notices are included in any copies made. - ! Neither the authors nor the publishers accept any responsibility for - ! any results obtained by use of this code. - ! Modified by Jinyun Tang, Apr, 2013 - - implicit none - - ! !ARGUMENTS: - real(r8), dimension(:,:), intent(in) :: a !contains the coefficients - real(r8), dimension(:), intent(inout) :: b !contains the right-hand side coefficients, will contain the solution on exit - integer , intent(out) :: error ! will be set non-zero if an error is found - - ! !LOCAL VARIABLES: - real(r8) :: sum - integer :: i,j,n - - - error = 0 - n = size(b) - ! Solve for each variable in turn - do i = n,1,-1 - ! Check for zero coefficient - if ( abs(a(i,i)) <= 1.e-5_r8 ) then - error = -4 - return - endif - sum = b(i) - do j = i+1,n - sum = sum - a(i,j)*b(j) - enddo - b(i) = sum/a(i,i) - enddo - - end subroutine back_substitution -end module FindRootMod diff --git a/components/clm/src/betr/betr_math/InterpolationMod.F90 b/components/clm/src/betr/betr_math/InterpolationMod.F90 deleted file mode 100644 index b7b06a457bec..000000000000 --- a/components/clm/src/betr/betr_math/InterpolationMod.F90 +++ /dev/null @@ -1,357 +0,0 @@ -module InterpolationMod -#include "shr_assert.h" - ! - ! !DESCRIPTION: - ! subroutines to do polynomial interpolation - ! author: Jinyun Tang, Sep, 2014 - - ! !USES: - use shr_kind_mod, only: r8 => shr_kind_r8 - use abortutils , only : endrun - use shr_log_mod , only: errMsg => shr_log_errMsg - implicit none - private - save - - public :: Lagrange_interp - public :: pchip_polycc - public :: pchip_interp -contains - - !------------------------------------------------------------------------------- - subroutine Lagrange_interp(pn, x, y, xi, yi) - ! - ! !DESCRIPTION: - ! do order pn lagrangian interpolation - implicit none - ! !ARGUMENTS: - integer, intent(in) :: pn !order of interpolation - real(r8), dimension(:), intent(in) :: x !location of data - real(r8), dimension(:), intent(in) :: y !value of data - real(r8), dimension(:), intent(in) :: xi !target points to be evaluated - real(r8), dimension(:), intent(out) :: yi !target values - - ! !LOCAL VARIABLES: - integer :: k, ni, nx - integer :: pos, disp, disp1 - - SHR_ASSERT_ALL((ubound(x) == ubound(y)), errMsg(__FILE__,__LINE__)) - SHR_ASSERT_ALL((ubound(xi) == ubound(yi)), errMsg(__FILE__,__LINE__)) - SHR_ASSERT_ALL((ubound(x) >= pn+1), errMsg(__FILE__,__LINE__)) - - ni = size(xi) - nx = size(x) - disp=int((pn+1)*0.5_r8+1.e-8_r8) - !get the half size of the local window - if(mod(pn,2)==0)then - disp1=disp - else - disp1=disp-1 - endif - - do k = 1, ni - ! find the position of z in array x - pos = find_idx(x, xi(k)) - if(pos == -100) then - !left boundary - yi(k) = y(1) - elseif(pos == -200) then - !right boundary - yi(k) = y(nx) - else - ! call function Lagrange - if (pos <= disp1) then - yi(k) = Lagrange_poly(pn, x(1:pn+1), y(1:pn+1), xi(k)) - else if (pos >= nx-disp) then - yi(k) = Lagrange_poly(pn, x(nx-pn:nx), y(nx-pn:nx), xi(k)) - else - yi(k) = Lagrange_poly(pn, x(pos-disp1:pos+disp), y(pos-disp1:pos+disp), xi(k)) - end if - endif - enddo - - end subroutine Lagrange_interp - - !------------------------------------------------------------------------------- - function Lagrange_poly(pn, xvect, yvect, z)result(Pz) - ! - ! !DESCRIPTION: - ! do lagrangian interpolation at order pn - ! - implicit none - ! !ARGUMENTS: - integer, intent(in) :: pn ! Order of Interpolation Polynomial - real(r8), dimension(:), intent(in) :: xvect, yvect ! vectors of known data: x,y-values - real(r8), intent(in) :: z ! the target point "z" - - ! !LOCAL VARIABLES: - integer :: i, j, n - real(r8) :: L(pn+1) ! Lagrange cardinal function - real(r8) :: Pz ! target value - - SHR_ASSERT_ALL((size(xvect) == size(yvect)), errMsg(__FILE__,__LINE__)) - SHR_ASSERT_ALL((size(xvect) == pn+1), errMsg(__FILE__,__LINE__)) - - ! n = number of data points:length of each data vector - n = size(xvect) - ! Initializations of Pz and L - Pz = 0._r8 ! initializing the polynomia value at z - L(:) = 1._r8 ! initalizing the vector of cardinal functions to 1 - ! Performing the interpolation - do i = 1, n - do j = 1, n - if (i /= j) then - ! part of L(i) - L(i) = ( (z - xvect(j)) / (xvect(i) - xvect(j)) )* L(i) - end if - end do - Pz = Pz + L(i)*yvect(i) ! update Pz ~ f(z) - end do - end function Lagrange_poly - !------------------------------------------------------------ - function find_idx(xvect, x)result(k) - ! - ! !DESCRIPTION: - ! locate the position of x in xvect - ! - implicit none - ! !ARGUMENTS: - real(r8), dimension(:), intent(in) :: xvect ! vector of x-values - real(r8), intent(in) :: x - - integer :: i, k, n - - ! array dimension - n = size(xvect) - - - - if(xxvect(n))then - k = -200 !beyond right boundary - elseif(x==xvect(1))then - k=1 - elseif(x==xvect(n))then - k=n-1 - else - ! find index k so that x[k] < x < x[k+1] - do i = 1, n-1 - if ((xvect(i) <= x) .and. (x < xvect(i+1))) then - k = i - exit - end if - end do - endif - - - end function find_idx - !------------------------------------------------------------ - subroutine pchip_polycc(x, fx, di, region) - ! - ! DESCRIPTION - ! Given the data, generate the coefficients of the monotonic cubic - ! polynomials - ! Ref, Fritsch and Carlson, 1980 - ! - ! !USES: - use MathfuncMod, only : diff - implicit none - ! !ARGUMENTS: - real(r8), dimension(:), intent(in) :: x - real(r8), dimension(:), intent(in) :: fx - real(r8), dimension(:), intent(out):: di - integer, optional, intent(in) :: region - - ! !LOCAL VARIABLES: - real(r8), allocatable :: h(:) - real(r8), allocatable :: df(:) - real(r8), allocatable :: slp(:) - real(r8) :: alpha, beta, tao, rr - integer :: region_loc - integer :: n, j - - SHR_ASSERT_ALL((size(x) == size(fx)), errMsg(__FILE__,__LINE__)) - SHR_ASSERT_ALL((size(x) == size(di)), errMsg(__FILE__,__LINE__)) - region_loc=2 - if(present(region))region_loc=region - - n = size(x) - allocate(h(n-1)) - allocate(df(n-1)) - allocate(slp(n-1)) - !get interval length - call diff(x, h) - !get function step - call diff(fx, df) - - !get slope - do j = 1, n-1 - slp(j)=df(j)/h(j) - enddo - - !get di - di(:) = 0._r8 - - j = 1 - di(j)=(fx(j+1)+fx(j+2)-2*fx(1))/(2*h(j)+h(j+1)) - do j = 2, n-1 - di(j)=(fx(j+1)-fx(j-1))/(h(j)+h(j-1)) - enddo - j = n - di(j)=(2._r8*fx(j)-(fx(j-1)+fx(j-2)))/(2._r8*h(j-1)+h(j-2)) - - !enforce the sign condition - if(slp(1)*di(1)<=0._r8)then - di(1)=0._r8 - endif - - if(slp(n-1)*di(n)<=0)then - di(n)=0._r8 - endif - - !enforce the range 2 constraint - - do j = 1, n-1 - if(abs(slp(j))<=1.e-16_r8)then - di(j)=0._r8 - di(j+1)=0._r8 - else - alpha=di(j)/slp(j) - beta =di(j+1)/slp(j) - select case (region_loc) - case (1) - rr=beta/alpha - if(rr>1._r8)then - if(beta>3._r8)then - beta=3._r8 - alpha=beta/rr - di(j)=slp(j)*alpha - di(j+1)=slp(j)*beta - endif - else - if(alpha>3._r8)then - alpha=3._r8 - beta=rr*alpha - di(j)=slp(j)*alpha - di(j+1)=slp(j)*beta - endif - endif - case (2) - tao=3._r8/sqrt(alpha*alpha+beta*beta) - if(tao<1._r8)then - di(j)=tao*di(j) - di(j+1)=tao*di(j+1) - endif - case (3) - if(alpha+beta>3._r8)then - if(alpha>0._r8)then - rr=beta/alpha - alpha=3._r8/(1._r8+rr) - beta=alpha*rr - di(j)=slp(j)*alpha - di(j+1)=slp(j)*beta - else - beta=3._r8 - di(j+1)=slp(j)*beta - endif - endif - case (4) - if(alpha>0._r8)then - rr=beta/alpha - if(rr>=1._r8)then - if(2._r8*alpha+beta>3._r8)then - alpha=3._r8/(2._r8+rr) - beta=alpha*rr - di(j)=slp(j)*alpha - di(j+1)=slp(j)*beta; - endif - else - if(alpha+2._r8*beta>3._r8)then - alpha=3._r8/(1._r8+2._r8*rr) - beta=alpha*rr - di(j)=slp(j)*alpha - di(j+1)=slp(j)*beta - endif - endif - else - if(beta>3._r8)then - beta=3._r8 - di(j+1)=slp(j)*beta - endif - endif - case default - call endrun(msg='an constraint region must be specified for pchip_polycc '//errMsg(__FILE__, __LINE__)) - end select - - endif - enddo - - deallocate(h) - deallocate(df) - deallocate(slp) - end subroutine pchip_polycc - !------------------------------------------------------------ - - subroutine pchip_interp(x, fx, di, xi, yi) - - ! !DESCRIPTION: - ! do monotonic cubic spline interpolation - implicit none - ! !ARGUMENTS: - real(r8), dimension(:), intent(in) :: x - real(r8), dimension(:), intent(in) :: fx - real(r8), dimension(:), intent(in) :: di - real(r8), dimension(:), intent(in) :: xi - real(r8), dimension(:), intent(out) :: yi - - ! !LOCAL VARIABLES: - real(r8) :: h, t1, t2 - real(r8) :: h1x, h2x, h3x, h4x - integer :: n, j - integer :: id - - SHR_ASSERT_ALL((size(x) == size(fx)), errMsg(__FILE__,__LINE__)) - SHR_ASSERT_ALL((size(x) == size(di)), errMsg(__FILE__,__LINE__)) - SHR_ASSERT_ALL((size(xi) == size(yi)), errMsg(__FILE__,__LINE__)) - - n=size(xi) !total number of points to be interpolated - - yi(:)=0._r8 - do j = 1, n - - id=find_idx(x,xi(j)) - h=x(id+1)-x(id) - t1=(x(id+1)-xi(j))/h - t2=(xi(j)-x(id))/h - - h1x=phi(t1) - h2x=phi(t2) - h3x=-h*psi(t1) - h4x=h*psi(t2) - yi(j)=fx(id)*h1x+fx(id+1)*h2x+di(id)*h3x+di(id+1)*h4x - enddo - - contains - - function phi(t) result(fval) - implicit none - real(r8), intent(in) :: t - - real(r8) :: fval - - fval=(3._r8-2._r8*t)*t*t - - end function phi - - - function psi(t) result(fval) - implicit none - real(r8), intent(in) :: t - - real(r8) :: fval - fval=t*t*(t-1._r8) - end function psi - end subroutine pchip_interp - -end module InterpolationMod diff --git a/components/clm/src/betr/betr_math/MathfuncMod.F90 b/components/clm/src/betr/betr_math/MathfuncMod.F90 deleted file mode 100644 index 1cfe52890515..000000000000 --- a/components/clm/src/betr/betr_math/MathfuncMod.F90 +++ /dev/null @@ -1,432 +0,0 @@ -module MathfuncMod -#include "shr_assert.h" - ! !DESCRIPTION: - ! mathematical functions for some elementary manipulations - ! History: Created by Jinyun Tang - ! - ! !USES: - use shr_kind_mod , only : r8 => shr_kind_r8 - use clm_varctl , only : iulog - use abortutils , only : endrun - use shr_log_mod , only : errMsg => shr_log_errMsg - implicit none - save - private - public :: cumsum - public :: swap - public :: minmax - public :: cumdif - public :: diff - public :: safe_div - public :: dot_sum - public :: addone - public :: asc_sort_vec - public :: is_bounded - public :: minp - public :: pd_decomp - public :: num2str - interface cumsum - module procedure cumsum_v, cumsum_m - end interface cumsum - interface swap - module procedure swap_i, swap_r, swap_rv - end interface swap -contains - !------------------------------------------------------------------------------- - function heviside(x)result(ans) - ! - ! !DESCRIPTION: - ! heviside function - implicit none - ! !ARGUMENTS: - real(r8), intent(in) :: x - ! !LOCAL VARIABLES: - real(r8) :: ans - - if(x>0._r8)then - ans = 1._r8 - else - ans = 0._r8 - endif - end function heviside - - - !------------------------------------------------------------------------------- - subroutine swap_i(a,b) - ! - ! !DESCRIPTION: - ! swap two integers - implicit none - ! !ARGUMENTS: - integer, intent(inout) :: a, b - - ! !LOCAL VARIABLES: - integer :: c - - c = a - a = b - b = c - - end subroutine swap_i - !------------------------------------------------------------------------------- - subroutine swap_r(a,b) - ! - ! !DESCRIPTION: - ! swap two real numbers - implicit none - ! !ARGUMENTS: - real(r8), intent(inout) :: a, b - - ! !LOCAL VARIABLES: - real(r8) :: c - - c = a - a = b - b = c - - end subroutine swap_r - !------------------------------------------------------------------------------- - subroutine swap_rv(a,b) - ! - ! !DESCRIPTION: - ! swap two vectors - implicit none - ! !ARGUMENTS: - real(r8), dimension(:), intent(inout) :: a, b - ! !LOCAL VARIABLES: - real(r8), dimension(size(a)) :: c - - integer :: n - - if(size(a)/=size(b))then - write(iulog,*)'the input vectors are not of same size in swap_rv' - write(iulog,*)'clm model is stopping' - call endrun() - endif - - c = a - a = b - b = c - - end subroutine swap_rv - !------------------------------------------------------------------------------- - function minmax(x)result(ans) - ! - ! !DESCRIPTION: - !returnd the minimum and maximum of the input vector - implicit none - ! !ARGUMENTS: - real(r8), dimension(:), intent(in) :: x - - ! !LOCAL VARIABLES: - integer :: n, j - real(r8) :: ans(2) - n = size(x) - ans(1) = x(1) - ans(2) = x(1) - - do j = 2, n - if(ans(1)>x(j))then - ans(1) = x(j) - endif - - if(ans(2) shr_kind_r8 - implicit none - ! !ARGUMENTS: - real(r8), dimension(:), intent(in) :: x - real(r8), dimension(:), intent(in) :: y - ! !LOCAL VARIABLES: - integer :: n, j - real(r8) :: ans - SHR_ASSERT_ALL((size(x) == size(y)), errMsg(__FILE__,__LINE__)) - - n = size(x) - ! use subroutine from blas - !DOUBLE PRECISION FUNCTION ddot(N,DX,INCX,DY,INCY) - ! - ans=dot_product(x,y) - - end function dot_sum - !-------------------------------------------------------------------------------- - function addone(a)result(ans) - ! !DESCRIPTION: - ! return a variable with a + 1 - ! - ! !USES: - use shr_kind_mod, only: r8 => shr_kind_r8 - implicit none - ! !ARGUMENTS: - integer, intent(inout) :: a - ! !LOCAL VARIABLES: - integer :: ans - - a = a + 1 - ans = a - end function addone - - !-------------------------------------------------------------------------------- - subroutine asc_sort_vec(zvec) - ! - ! !DESCRIPTION: - ! sort an array into ascending order - implicit none - ! !ARGUMENTS: - real(r8), dimension(:), intent(inout) :: zvec - ! !LOCAL VARIABLES: - integer :: n, j, k - logical :: lswap - - n = size(zvec) - - do j = 1, n - lswap=.false. - do k = 2, n-j+1 - if(zvec(k)=xl .and. x<=xr)then - ans = .true. - else - ans = .false. - endif - end function is_bounded - - !-------------------------------------------------------------------------------- - function minp(p,v)result(ans) - ! - ! !DESCRIPTION: - !find the minimum of the nonzero p entries, with the entry determined by - !nonzero values of v - - implicit none - ! !ARGUMENTS: - real(r8), dimension(:), intent(in) :: p - real(r8), dimension(:), intent(in) :: v - ! !LOCAL VARIABLES: - integer :: j, sz - real(r8) :: ans !(<=1._r8) - - SHR_ASSERT_ALL((size(p) == size(v)), errMsg(__FILE__,__LINE__)) - - sz = size(p) - ans = 1._r8 - do j = 1, sz - if(v(j)/=0._r8)then - ans = min(ans, p(j)) - endif - enddo - end function minp - - !-------------------------------------------------------------------------------- - subroutine pd_decomp(m, n, A, AP, AD) - ! - ! !DESCRIPTION: - !separate a input matrix A into AP and AD with positive - !and negative entries respectively. - - implicit none - ! !ARGUMENTS: - integer , intent(in) :: n, m - real(r8) , intent(in) :: A(1: , 1: ) - real(r8) , intent(out):: AP(1: , 1: ) - real(r8) , intent(out):: AD(1: , 1: ) - - ! !LOCAL VARIABLES: - integer :: i, j - - - SHR_ASSERT_ALL((ubound(A) == (/m,n/)), errMsg(__FILE__,__LINE__)) - SHR_ASSERT_ALL((ubound(AP) == (/m,n/)), errMsg(__FILE__,__LINE__)) - SHR_ASSERT_ALL((ubound(AD) == (/m,n/)), errMsg(__FILE__,__LINE__)) - - AP(:,:) = 0._r8 - AD(:,:) = 0._r8 - - where(A>0._r8) - AP=A - elsewhere - AD=A - endwhere - end subroutine pd_decomp - !-------------------------------------------------------------------------------- - - function num2str(a,fmt)result(ans) - ! - ! !DESCRIPTION: - !turn a number into a string using the specified format - implicit none - ! !ARGUMENTS: - integer, intent(in) :: a - character(len=*), intent(in) :: fmt - - ! !LOCAL VARIABLES: - character(len=32) :: ans - character(len=32) :: str - - write(str,fmt)a - ans = trim(adjustl(str)) - end function num2str -end module MathfuncMod diff --git a/components/clm/src/betr/betr_math/ODEMod.F90 b/components/clm/src/betr/betr_math/ODEMod.F90 deleted file mode 100644 index a6879a242b29..000000000000 --- a/components/clm/src/betr/betr_math/ODEMod.F90 +++ /dev/null @@ -1,594 +0,0 @@ -module ODEMod - ! - ! !DESCRIPTION: - ! ode integrators for the biogeochemistry model - ! Jinyun Tang, 2013 - ! - ! !USES: - use shr_kind_mod , only : r8 => shr_kind_r8 - use clm_varctl , only : iulog - implicit none - save - private - - public :: ode_mbbks1, ode_adapt_mbbks1 - public :: ode_ebbks1 - public :: ode_rk4 - public :: ode_rk2 - real(r8), parameter :: tiny = 1.e-23_r8 - - type, private:: mbkks_type - real(r8), pointer :: aj(:) - real(r8) :: iJ - integer :: nJ - end type mbkks_type - logical,public :: ldebug_ode=.false. - type(mbkks_type), private :: mbkks_data - interface get_rerr - module procedure get_rerr_v, get_rerr_s - end interface get_rerr - -contains - - !------------------------------------------------------------------------------- - subroutine ode_ebbks1(odefun, y0, nprimeq, neq, t, dt, y, pscal) - ! !DESCRIPTION: - !first order accurate explicit BBKS fixed time step positive preserving ode integrator - !reference: Broekhuizen et al., 2008 - !! - ! - implicit none - ! !ARGUMENTS: - integer, intent(in) :: nprimeq !number of primary equations that are subject to positive constraint - integer, intent(in) :: neq !total number of equations - real(r8), intent(in) :: y0(neq) !initial values - real(r8), intent(in) :: t !current time - real(r8), intent(in) :: dt !time step - real(r8), intent(out) :: y(neq) !return values - real(r8), optional, intent(out) :: pscal !scaling factor - external :: odefun - - ! !LOCAL VARIABLES: - real(r8) :: f(neq) - real(r8) :: pscal_loc - call odefun(y0, dt, t, nprimeq, neq, f) - - call ebbks(y0, f, nprimeq, neq, dt, y,pscal_loc) - if(present(pscal))pscal=pscal_loc - end subroutine ode_ebbks1 - !------------------------------------------------------------------------------- - subroutine ode_ebbks2(odefun, y0, nprimeq, neq, t, dt, y) - ! !DESCRIPTION: - !second order accurate explicit BBKS fixed time step positive preserving ode integrator - !reference: Broekhuizen et al., 2008 - !! - ! - implicit none - ! !ARGUMENTS: - integer, intent(in) :: nprimeq !number of primary equations that are subject to positive constraint - integer, intent(in) :: neq !total number of equations - real(r8), intent(in) :: y0(neq) !initial values - real(r8), intent(in) :: t !current time - real(r8), intent(in) :: dt !time step - real(r8), intent(out) :: y(neq) !return value - - external :: odefun - - ! !LOCAL VARIABLES: - real(r8) :: f(neq) - real(r8) :: f1(neq) - real(r8) :: y1(neq) - real(r8) :: ti - integer :: n - - call odefun(y0, dt, t, nprimeq, neq, f) - call ebbks(y0, f, nprimeq, neq, dt, y1) - ti=t+dt - call odefun(y1, dt, ti, nprimeq, neq, f1) - do n = 1, neq - f(n) = (f(n)+f1(n))*0.5_r8 - enddo - call ebbks(y0, f, nprimeq, neq, dt, y) - end subroutine ode_ebbks2 - !------------------------------------------------------------------------------- - subroutine ode_mbbks1(odefun, y0, nprimeq, neq, t, dt, y, pscal) - ! !DESCRPTION: - !first order accurate implicit BBKS fixed time step positive preserving ode integrator - implicit none - ! !ARGUMENTS: - integer, intent(in) :: nprimeq - integer, intent(in) :: neq - real(r8), intent(in) :: y0(neq) - real(r8), intent(in) :: t - real(r8), intent(in) :: dt - real(r8), intent(out) :: y(neq) - real(r8), optional, intent(out) :: pscal - external :: odefun - - ! !LOCAL VARIABLES: - real(r8) :: f(neq) - real(r8) :: pscal1 - - call odefun(y0, dt, t, nprimeq, neq, f) - - call mbbks(y0, f, nprimeq, neq, dt, y, pscal1) - - if(present(pscal))pscal=pscal1 - end subroutine ode_mbbks1 - !------------------------------------------------------------------------------- - subroutine get_tscal(rerr,dt_scal,acc) - ! - ! !DESCRIPTION: - !obtain the time step scalar for adaptive ode - implicit none - ! !ARGUMENTS: - real(r8), intent(in) :: rerr !input relative err - real(r8), intent(out):: dt_scal !output dt_scal, 2, 1, 0.5 - logical, intent(out):: acc !true or false - - ! !LOCAL VARIABLES: - real(r8), parameter :: rerr_thr=1.e-4_r8 !relative error threshold - - if(rerr<0.5*rerr_thr)then - dt_scal = 2._r8 - acc = .true. - elseif(rerr0._r8)then - do n = 1, neq - f(n) = f(n) * pp**(1._r8/nJ) - enddo - endif - - call mbbks(y0, f, nprimeq, neq, dt, y, pscal) - - end subroutine ode_mbbks2 - !------------------------------------------------------------------------------- - subroutine mbbks(y0, f, nprimeq, neq, dt, y, pscal) - ! !DESCRIPTION: - ! mbbks update - ! - ! !USES: - use MathfuncMod , only : safe_div - implicit none - ! !ARGUMENTS: - real(r8), intent(in) :: y0(neq) ! state variable at previous time step - real(r8), intent(in) :: f(neq) ! derivative - real(r8), intent(in) :: dt ! time stepping - integer, intent(in) :: nprimeq ! - integer, intent(in) :: neq ! number of equations - real(r8), intent(out) :: y(neq) ! updated state variable - real(r8), intent(out) :: pscal - - ! !LOCAL VARIABLES: - real(r8), pointer :: aj(:) - real(r8) :: pmax - real(r8) :: pm - real(r8) :: a - integer :: n, nJ - - allocate(mbkks_data%aj(neq)) - aj => mbkks_data%aj - nJ = 0 - pmax = 0._r8 - do n = 1, nprimeq - if(f(n)<0._r8)then - nJ = nJ + 1 - pm = -y0(n)/(f(n)*dt) - - pm = min(pm,1.e30_r8) - aj(nJ) = -safe_div(1._r8,pm) - if(nJ==1)then - pmax= pm - else - pmax = min(pm, pmax) - endif - endif - enddo - if(nJ>0)then - pmax=min(1._r8,pmax**(nJ)) - - - !solve the gradient modifier function - mbkks_data%nJ=nJ - mbkks_data%iJ=1._r8/nJ - if(pmax<1.e-8_r8)then - pscal=pmax - else - pscal=GetGdtScalar(aj,nJ,pmax) - pscal=pscal**(1._r8/nJ) - endif - !reduce the chance of negative y(n) from roundoff error - pscal=pscal*0.9999_r8 - else - pscal=1._r8 - endif - - y(:)=y0(:) - a=pscal*dt - !daxpy(N,DA,DX,INCX,DY,INCY) - call daxpy(neq, a, f, 1, y, 1) - deallocate(mbkks_data%aj) - - - end subroutine mbbks - - !------------------------------------------------------------------------------- - subroutine ode_adapt_mbbks1(odefun, y0, nprimeq, neq, t, dt, y) - ! !DESCRIPTION: - !first order implicit bkks ode integration with the adaptive time stepping - !This could be used as an example for the implementation of time-adaptive - !mbbks1. - ! !NOTE: - ! this code should only be used for mass positive ODE integration - implicit none - ! !ARGUMENTS: - real(r8), intent(in) :: y0(neq) ! state variable at previous time step - real(r8), intent(in) :: t ! time stamp - real(r8), intent(in) :: dt ! time stepping - integer, intent(in) :: nprimeq ! - integer, intent(in) :: neq ! number of equations - real(r8), intent(out) :: y(neq) ! updated state variable - external :: odefun - - ! !LOCAL VARIABLES: - real(r8) :: yc(neq) !coarse time stepping solution - real(r8) :: yf(neq) !fine time stepping solution - real(r8) :: ycp(neq) !temporary variable - real(r8) :: f(neq) ! derivative - real(r8) :: dt2 - real(r8) :: dtr - real(r8) :: dt05 - real(r8) :: dtmin - real(r8) :: tt,tt2 !temporary variables - logical :: acc - real(r8) :: rerr, dt_scal, pscal - integer :: n, nJ - - dt2=dt - dtmin=dt/64._r8 - dtr=dt - tt=0._r8 - !make a copy of the solution at the current time step - y=y0 - do - if(dt2<=dtmin)then - call odefun(y, dt2, tt, nprimeq, neq, f) - call mbbks(y, f, nprimeq, neq, dt2, yc, pscal) - dtr=dtr-dt2 - tt=tt+dt2 - y=yc - else - !get coarse grid solution - call odefun(y, dt2, tt, nprimeq, neq, f) - call mbbks(y, f, nprimeq, neq, dt2, yc, pscal) - - !get fine grid solution - dt05=dt2*0.5_r8 - call mbbks(y,f,nprimeq, neq,dt05, yf, pscal) - tt2=tt+dt05 - ycp=yf - call odefun(ycp, dt05, tt, nprimeq, neq, f) - call mbbks(ycp,f,nprimeq, neq,dt05,yf,pscal) - - !determine the relative error - rerr=get_rerr_v(yc,yf, neq) - - !determine time scalar factor - call get_tscal(rerr,dt_scal,acc) - - if(acc)then - dtr=dtr-dt2 - tt=tt+dt2 - y=yf - endif - dt2=dt2*dt_scal - dt2=min(dt2,dtr) - endif - if(abs(dtr/dt)<1.e-4_r8)exit - enddo - - end subroutine ode_adapt_mbbks1 - - !------------------------------------------------------------------------------- - function get_rerr_v(yc,yf,neq)result(rerr) - ! - ! !DESCRIPTION: - ! obtain the relative error - implicit none - ! !ARGUMENTS: - real(r8), intent(in) :: yc(neq) !coarse solution - real(r8), intent(in) :: yf(neq) !fine solution - integer, intent(in) :: neq !number of equations - - ! !LOCAL VARIABLES: - real(r8) :: rerr - real(r8) :: rtmp - integer :: n - rerr=abs(yc(1)-yf(1))/(abs(yf(1))+1.e-20_r8) - do n = 2, neq - rtmp=abs(yc(n)-yf(n))/(abs(yf(n))+1.e-20_r8) - rerr=max(rerr,rtmp) - enddo - - end function get_rerr_v - !------------------------------------------------------------------------------- - function get_rerr_s(yc,yf)result(rerr) - ! - ! DESCRIPTION: - ! obtain the relative error - implicit none - ! !ARGUMENTS: - real(r8), intent(in) :: yc !coarse solution - real(r8), intent(in) :: yf !fine solution - ! !LOCAL VARIABLES - real(r8) :: rerr - real(r8) :: rtmp - integer :: n - - rerr=abs(yc-yf)/(abs(yf)+1.e-20_r8) - - end function get_rerr_s - - !------------------------------------------------------------------------------- - function GetGdtScalar(aj,nJ,pmax)result(pp) - ! !DESCRIPTION: - !get the gradient scaling factor for bkks integrator - ! - ! !USES: - use FindRootMod, only : brent - implicit none - ! !ARGUMENTS: - real(r8), intent(in) :: aj(nJ) - real(r8), intent(in) :: pmax - integer, intent(in) :: nJ - ! !LOCAL VARIABLES: - real(r8) :: iJ - real(r8) :: f1, f2 - real(r8), parameter :: macheps = 1.e-8_r8 - real(r8), parameter :: tol = 1.e-8_r8 - - real(r8) :: pp - - call gfunc_mbkks(0._r8, f1) - call gfunc_mbkks(pmax, f2) - call brent(pp, 0._r8, pmax, f1, f2, macheps, tol, gfunc_mbkks) - end function GetGdtScalar - !------------------------------------------------------------------------------- - - subroutine gfunc_mbkks(p, value) - ! !DESCRIPTION: - !the bkks function - implicit none - ! !ARGUMENTS: - real(r8), intent(in) :: p - real(r8), intent(out):: value - - ! !LOCAL VARIABLES: - integer :: jj - real(r8), pointer :: aj(:) - integer :: nJ - real(r8) :: iJ - - aj => mbkks_data%aj - nJ = mbkks_data%nJ - iJ = mbkks_data%iJ - value = 1._r8 - do jj = 1, nJ - value = value * (1._r8 + aj(jj) * p**(iJ)) - enddo - value = value - p - if(abs(value)<1.e-20_r8)value=0._r8 - end subroutine gfunc_mbkks - - !------------------------------------------------------------------------------- - subroutine ebbks(y0, f, nprimeq, neq, dt, y,ps) - ! !DESCRIPTION: - !ebbks update - implicit none - ! !ARGUMENTS: - real(r8), intent(in) :: y0(neq) - real(r8), intent(in) :: f(neq) - real(r8), intent(in) :: dt - integer, intent(in) :: nprimeq - integer, intent(in) :: neq - real(r8), intent(out):: y(neq) - real(r8), optional, intent(out):: ps - ! !LOCAL VARIABLES: - real(r8), parameter :: beta=0.999_r8 !scaling parameter - real(r8) :: js, jsmin - real(r8) :: p - integer :: n, nJ - - nJ=0 - do n = 1, nprimeq - if(f(n)<0._r8)then - js = y0(n)/(-f(n)*dt) - nJ=nJ+1 - if(nJ==1)then - jsmin=js - else - jsmin=min(jsmin,js) - endif - if(ldebug_ode)then - write(*,'(A,X,I3,3(X,E20.10))')'debbkb',n,f(n),js,y0(n) - endif - endif - enddo - p=1._r8 - if(nJ>0)then - p = min(jsmin*beta,1._r8) - endif - - y(:) = y0(:) - if(present(ps))ps=p - p = p * dt - call daxpy(neq, p, f, 1, y, 1) - - end subroutine ebbks - - - - !------------------------------------------------------------------------------- - subroutine ode_rk4(odefun, y0, neq, t, dt, y ) - ! - ! !DESCRIPTION: - ! 4-th order runge-kutta method for ode integration - ! Solve differential equations with a non-adaptive method of order 4. - ! call rk4(y, ODEFUN,t, dt,Y0, neq) integrates - ! the system of differential equations y' = f(t,y) by stepping from T to - ! t+dt. Function ODEFUN(T,Y) must return f(t,y) in a column vector. - ! The vector Y0 is the initial conditions at T0. Each row in the solution - ! array Y corresponds to a time specified in TSPAN. - ! - ! This is a non-adaptive solver. The step sequence is determined by TSPAN - ! but the derivative function ODEFUN is evaluated multiple times per step. - ! - implicit none - ! !ARGUMENTS: - integer, intent(in) :: neq - real(r8), intent(in) :: y0(neq) - real(r8), intent(in) :: t - real(r8), intent(in) :: dt - real(r8), intent(out) :: y(neq) - ! !LOCAL VARIABLES: - real(r8) :: k1(neq) - real(r8) :: k2(neq) - real(r8) :: k3(neq) - real(r8) :: k4(neq) - real(r8) :: kt(neq) - real(r8) :: ti, dt05, a - integer :: n - external :: odefun - - ti = t - dt05 = dt * 0.5_r8 - - call odefun(y0, dt05, ti, neq, k1) - - y(:) = y0(:) - call daxpy(neq, dt05, k1, 1, y, 1) - - ti = t + dt05 - call odefun(y, dt05, ti, neq, k2) - - y(:) = y0(:) - call daxpy(neq, dt05, k2, 1, y, 1) - - ti = t + dt05 - call odefun( y, dt05, ti, neq, k3) - - y(:) = y0(:) - call daxpy(neq, dt, k3, 1, y, 1) - - ti = t + dt - call odefun(y, dt, ti, neq, k4) - - do n = 1, neq - kt(n) = k1(n)+2._r8*K2(n)+2._r8*k3(n)+k4(n) - enddo - a = dt / 6._r8 - - y(:) = y0(:) - call daxpy(neq, a, kt, 1, y, 1) - - end subroutine ode_rk4 - - - !------------------------------------------------------------------------------- - subroutine ode_rk2(odefun, y0, neq, t, dt, y ) - ! - ! !DESCRIPTION: - ! 2-th order runge-kutta method for ode integration - ! Solve differential equations with a non-adaptive method of order 2. - ! call rk2(y, ODEFUN,t, dt,Y0, neq) integrates - ! the system of differential equations y' = f(t,y) by stepping from T to - ! t+dt. Function ODEFUN(T,Y) must return f(t,y) in a column vector. - ! The vector Y0 is the initial conditions at T0. Each row in the solution - ! array Y corresponds to a time specified in TSPAN. - - ! - ! This is a non-adaptive solver. The step sequence is determined by TSPAN - ! but the derivative function ODEFUN is evaluated multiple times per step. - ! - implicit none - ! !ARGUMENTS: - integer, intent(in) :: neq - real(r8), intent(in) :: y0(neq) - real(r8), intent(in) :: t - real(r8), intent(in) :: dt - real(r8), intent(out) :: y(neq) - ! !LOCAL VARIABLES: - real(r8) :: k1(neq) - real(r8) :: k2(neq) - real(r8) :: ti, dt05 - integer :: n - external :: odefun - - ti = t - dt05 = dt * 0.5_r8 - - call odefun(y0, dt, ti, neq, k1) - - y(:) = y0(:) - call daxpy(neq, dt05, k1, 1, y, 1) - - ti = t + dt05 - call odefun(y, dt05, ti, neq, k2) - - y(:) = y0(:) - call daxpy(neq, dt, k2, 1, y, 1) - end subroutine ode_rk2 - -end module ODEMod diff --git a/components/clm/src/betr/bgc_century/BGCCenturyParMod.F90 b/components/clm/src/betr/bgc_century/BGCCenturyParMod.F90 deleted file mode 100644 index f6b30d1dfdd3..000000000000 --- a/components/clm/src/betr/bgc_century/BGCCenturyParMod.F90 +++ /dev/null @@ -1,557 +0,0 @@ -module BGCCenturyParMod - ! - ! !DESCRIPTION: - ! parameterization module for century bgc - ! - ! !USES: - use shr_kind_mod , only : r8 => shr_kind_r8 - use abortutils , only : endrun - use shr_log_mod , only : errMsg => shr_log_errMsg - implicit none - - public :: readCentDecompBgcParams - public :: readCentNitrifDenitrifParams - public :: readCentCNAllocParams - - type, private :: CNNitrifDenitrifParamsType - real(r8) :: k_nitr_max ! maximum nitrification rate constant (1/s) - real(r8) :: surface_tension_water ! surface tension of water(J/m^2), Arah an and Vinten 1995 - real(r8) :: rij_kro_a ! Arah and Vinten 1995) - real(r8) :: rij_kro_alpha ! parameter to calculate anoxic fraction of soil (Arah and Vinten 1995) - real(r8) :: rij_kro_beta ! (Arah and Vinten 1995) - real(r8) :: rij_kro_gamma ! (Arah and Vinten 1995) - real(r8) :: rij_kro_delta ! (Arah and Vinten 1995) - end type CNNitrifDenitrifParamsType - - type(CNNitrifDenitrifParamsType), protected :: CNNitrifDenitrifParamsInst - - - type :: NutrientCompetitionParamsType - - real(r8) :: dayscrecover ! number of days to recover negative cpool - real(r8) :: compet_plant_no3 ! (unitless) relative compettiveness of plants for NO3 - real(r8) :: compet_plant_nh4 ! (unitless) relative compettiveness of plants for NH4 - real(r8) :: compet_decomp_no3 ! (unitless) relative competitiveness of immobilizers for NO3 - real(r8) :: compet_decomp_nh4 ! (unitless) relative competitiveness of immobilizers for NH4 - real(r8) :: compet_denit ! (unitless) relative competitiveness of denitrifiers for NO3 - real(r8) :: compet_nit ! (unitless) relative competitiveness of nitrifiers for NH4 - end type NutrientCompetitionParamsType - - ! NutrientCompetitionParamsInst is populated in readCNAllocParams which is called in - type(NutrientCompetitionParamsType),protected :: NutrientCompetitionParamsInst - - - type, private :: CNDecompBgcParamsType - real(r8) :: cn_s1_bgc !C:N for SOM 1 - real(r8) :: cn_s2_bgc !C:N for SOM 2 - real(r8) :: cn_s3_bgc !C:N for SOM 3 - - real(r8) :: rf_l1s1_bgc !respiration fraction litter 1 -> SOM 1 - real(r8) :: rf_l2s1_bgc - real(r8) :: rf_l3s2_bgc - - real(r8) :: rf_s2s1_bgc - real(r8) :: rf_s2s3_bgc - real(r8) :: rf_s3s1_bgc - - real(r8) :: rf_cwdl2_bgc - real(r8) :: rf_cwdl3_bgc - - real(r8) :: tau_l1_bgc ! turnover time of litter 1 (yr) - real(r8) :: tau_l2_l3_bgc ! turnover time of litter 2 and litter 3 (yr) - real(r8) :: tau_s1_bgc ! turnover time of SOM 1 (yr) - real(r8) :: tau_s2_bgc ! turnover time of SOM 2 (yr) - real(r8) :: tau_s3_bgc ! turnover time of SOM 3 (yr) - real(r8) :: tau_cwd_bgc ! corrected fragmentation rate constant CWD - - real(r8) :: k_decay_lit1 - real(r8) :: k_decay_lit2 - real(r8) :: k_decay_lit3 - real(r8) :: k_decay_som1 - real(r8) :: k_decay_som2 - real(r8) :: k_decay_som3 - real(r8) :: k_decay_cwd - - real(r8) :: cwd_fcel_bgc !cellulose fraction for CWD - real(r8) :: cwd_flig_bgc ! - - real(r8) :: k_frag_bgc !fragmentation rate for CWD - real(r8) :: minpsi_bgc !minimum soil water potential for heterotrophic resp - - integer :: nsompools = 3 - - real(r8),allocatable :: spinup_vector(:) ! multipliers for soil decomp during accelerated spinup - - end type CNDecompBgcParamsType - - type(CNDecompBgcParamsType),protected :: CNDecompBgcParamsInst - - -contains - - !------------------------------------------------------------------------------- - subroutine readCentNitrifDenitrifParams ( ncid ) - ! - ! !DESCRIPTION: - ! read in nitrification denitrification parameters: - - ! !USES: - use ncdio_pio , only : file_desc_t,ncd_io - use clm_varcon , only : secspday - use clm_time_manager , only : get_days_per_year - ! - ! !ARGUMENTS: - type(file_desc_t),intent(inout) :: ncid ! pio netCDF file id - ! - ! !LOCAL VARIABLES: - character(len=32) :: subname = 'CNNitrifDenitrifParamsType' - character(len=100) :: errCode = '-Error reading in parameters file:' - logical :: readv ! has variable been read in or not - real(r8) :: tempr ! temporary to read in constant - character(len=100) :: tString ! temp. var for reading - !----------------------------------------------------------------------- - ! - ! read in constants - ! - tString='k_nitr_max' - call ncd_io(trim(tString),tempr, 'read', ncid, readvar=readv) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(__FILE__, __LINE__)) - CNNitrifDenitrifParamsInst%k_nitr_max=tempr - - tString='surface_tension_water' - call ncd_io(trim(tString),tempr, 'read', ncid, readvar=readv) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(__FILE__, __LINE__)) - CNNitrifDenitrifParamsInst%surface_tension_water=tempr - - tString='rij_kro_a' - call ncd_io(trim(tString),tempr, 'read', ncid, readvar=readv) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(__FILE__, __LINE__)) - CNNitrifDenitrifParamsInst%rij_kro_a=tempr - - tString='rij_kro_alpha' - call ncd_io(trim(tString),tempr, 'read', ncid, readvar=readv) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(__FILE__, __LINE__)) - CNNitrifDenitrifParamsInst%rij_kro_alpha=tempr - - tString='rij_kro_beta' - call ncd_io(trim(tString),tempr, 'read', ncid, readvar=readv) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(__FILE__, __LINE__)) - CNNitrifDenitrifParamsInst%rij_kro_beta=tempr - - tString='rij_kro_gamma' - call ncd_io(trim(tString),tempr, 'read', ncid, readvar=readv) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(__FILE__, __LINE__)) - CNNitrifDenitrifParamsInst%rij_kro_gamma=tempr - - tString='rij_kro_delta' - call ncd_io(trim(tString),tempr, 'read', ncid, readvar=readv) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(__FILE__, __LINE__)) - CNNitrifDenitrifParamsInst%rij_kro_delta=tempr - - end subroutine readCentNitrifDenitrifParams - - !----------------------------------------------------------------------- - subroutine readCentDecompBgcParams ( ncid, nelms, betrtracer_vars ) - ! - ! !DESCRIPTION: - ! read in decomposition parameters for century bgc - ! - ! !USES: - use ncdio_pio , only: file_desc_t,ncd_io - use clm_varcon , only : secspday - use clm_varctl , only : spinup_state - use clm_varpar , only : i_met_lit, i_cel_lit, i_lig_lit, i_cwd - use clm_time_manager , only : get_days_per_year - use BeTRTracerType , only : BeTRTracer_Type - use CNDecompCascadeConType , only : decomp_cascade_con - ! - ! !ARGUMENTS: - type(file_desc_t) , intent(inout) :: ncid ! pio netCDF file id - type(BeTRTracer_Type) , intent(inout) :: betrtracer_vars - integer , intent(in) :: nelms - ! - ! !LOCAL VARIABLES: - character(len=32) :: subname = 'CNDecompBgcParamsType' - character(len=100) :: errCode = 'Error reading in CN const file ' - logical :: readv ! has variable been read in or not - real(r8) :: tempr ! temporary to read in constant - character(len=100) :: tString ! temp. var for reading - - real(r8) :: tau_l1 - real(r8) :: tau_l2_l3 - real(r8) :: tau_s1 - real(r8) :: tau_s2 - real(r8) :: tau_s3 - real(r8) :: days_per_year - real(r8) :: tau_cwd - real(r8) :: cn_s1 - real(r8) :: cn_s2 - real(r8) :: cn_s3 - integer :: i_litr1 - integer :: i_litr2 - integer :: i_litr3 - integer :: i_soil1 - integer :: i_soil2 - integer :: i_soil3 - integer :: ii, jj, kk - !----------------------------------------------------------------------- - associate( & ! - floating_cn_ratio_decomp_pools => decomp_cascade_con%floating_cn_ratio_decomp_pools , & ! Output: [logical (:) ] TRUE => pool has fixed C:N ratio - decomp_pool_name_restart => decomp_cascade_con%decomp_pool_name_restart , & ! Output: [character(len=8) (:) ] name of pool for restart files - decomp_pool_name_history => decomp_cascade_con%decomp_pool_name_history , & ! Output: [character(len=8) (:) ] name of pool for history files - decomp_pool_name_long => decomp_cascade_con%decomp_pool_name_long , & ! Output: [character(len=20) (:) ] name of pool for netcdf long names - decomp_pool_name_short => decomp_cascade_con%decomp_pool_name_short , & ! Output: [character(len=8) (:) ] name of pool for netcdf short names - is_litter => decomp_cascade_con%is_litter , & ! Output: [logical (:) ] TRUE => pool is a litter pool - is_soil => decomp_cascade_con%is_soil , & ! Output: [logical (:) ] TRUE => pool is a soil pool - is_cwd => decomp_cascade_con%is_cwd , & ! Output: [logical (:) ] TRUE => pool is a cwd pool - initial_cn_ratio => decomp_cascade_con%initial_cn_ratio , & ! Output: [real(r8) (:) ] c:n ratio for initialization of pools - initial_stock => decomp_cascade_con%initial_stock , & ! Output: [real(r8) (:) ] initial concentration for seeding at spinup - is_metabolic => decomp_cascade_con%is_metabolic , & ! Output: [logical (:) ] TRUE => pool is metabolic material - is_cellulose => decomp_cascade_con%is_cellulose , & ! Output: [logical (:) ] TRUE => pool is cellulose - is_lignin => decomp_cascade_con%is_lignin , & ! Output: [logical (:) ] TRUE => pool is lignin - spinup_factor => decomp_cascade_con%spinup_factor & ! Output: [real(r8) (:) - ) - ! These are not read off of netcdf file - allocate(CNDecompBgcParamsInst%spinup_vector(CNDecompBgcParamsInst%nsompools)) - CNDecompBgcParamsInst%spinup_vector(:) = (/ 1.0_r8, 15.0_r8, 675.0_r8 /) - - - - ! Read off of netcdf file - tString='tau_l1' - call ncd_io(trim(tString),tempr, 'read', ncid, readvar=readv) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(__FILE__, __LINE__)) - CNDecompBgcParamsInst%tau_l1_bgc=tempr - - tString='tau_l2_l3' - call ncd_io(trim(tString),tempr, 'read', ncid, readvar=readv) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(__FILE__, __LINE__)) - CNDecompBgcParamsInst%tau_l2_l3_bgc=tempr - - tString='tau_s1' - call ncd_io(trim(tString),tempr, 'read', ncid, readvar=readv) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(__FILE__, __LINE__)) - CNDecompBgcParamsInst%tau_s1_bgc=tempr - - tString='tau_s2' - call ncd_io(trim(tString),tempr, 'read', ncid, readvar=readv) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(__FILE__, __LINE__)) - CNDecompBgcParamsInst%tau_s2_bgc=tempr - - tString='tau_s3' - call ncd_io(trim(tString),tempr, 'read', ncid, readvar=readv) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(__FILE__, __LINE__)) - CNDecompBgcParamsInst%tau_s3_bgc=tempr - - tString='tau_cwd' - call ncd_io(trim(tString),tempr, 'read', ncid, readvar=readv) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(__FILE__, __LINE__)) - CNDecompBgcParamsInst%tau_cwd_bgc=tempr - - tString='cn_s1_bgc' - call ncd_io(trim(tString),tempr, 'read', ncid, readvar=readv) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(__FILE__, __LINE__)) - CNDecompBgcParamsInst%cn_s1_bgc=tempr - - tString='cn_s2_bgc' - call ncd_io(trim(tString),tempr, 'read', ncid, readvar=readv) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(__FILE__, __LINE__)) - CNDecompBgcParamsInst%cn_s2_bgc=tempr - - tString='cn_s3_bgc' - call ncd_io(trim(tString),tempr, 'read', ncid, readvar=readv) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(__FILE__, __LINE__)) - CNDecompBgcParamsInst%cn_s3_bgc=tempr - - tString='rf_l1s1_bgc' - call ncd_io(trim(tString),tempr, 'read', ncid, readvar=readv) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(__FILE__, __LINE__)) - CNDecompBgcParamsInst%rf_l1s1_bgc=tempr - - tString='rf_l2s1_bgc' - call ncd_io(trim(tString),tempr, 'read', ncid, readvar=readv) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(__FILE__, __LINE__)) - CNDecompBgcParamsInst%rf_l2s1_bgc=tempr - - tString='rf_l3s2_bgc' - call ncd_io(trim(tString),tempr, 'read', ncid, readvar=readv) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(__FILE__, __LINE__)) - CNDecompBgcParamsInst%rf_l3s2_bgc=tempr - - tString='rf_s2s1_bgc' - call ncd_io(trim(tString),tempr, 'read', ncid, readvar=readv) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(__FILE__, __LINE__)) - CNDecompBgcParamsInst%rf_s2s1_bgc=tempr - - tString='rf_s2s3_bgc' - call ncd_io(trim(tString),tempr, 'read', ncid, readvar=readv) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(__FILE__, __LINE__)) - CNDecompBgcParamsInst%rf_s2s3_bgc=tempr - - tString='rf_s3s1_bgc' - call ncd_io(trim(tString),tempr, 'read', ncid, readvar=readv) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(__FILE__, __LINE__)) - CNDecompBgcParamsInst%rf_s3s1_bgc=tempr - - tString='rf_cwdl2_bgc' - call ncd_io(trim(tString),tempr, 'read', ncid, readvar=readv) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(__FILE__, __LINE__)) - CNDecompBgcParamsInst%rf_cwdl2_bgc=tempr - - tString='rf_cwdl3_bgc' - call ncd_io(trim(tString),tempr, 'read', ncid, readvar=readv) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(__FILE__, __LINE__)) - CNDecompBgcParamsInst%rf_cwdl3_bgc=tempr - - tString='cwd_fcel' - call ncd_io(trim(tString),tempr, 'read', ncid, readvar=readv) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(__FILE__, __LINE__)) - CNDecompBgcParamsInst%cwd_fcel_bgc=tempr - - tString='k_frag' - call ncd_io(trim(tString),tempr, 'read', ncid, readvar=readv) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(__FILE__, __LINE__)) - CNDecompBgcParamsInst%k_frag_bgc=tempr - - tString='minpsi_hr' - call ncd_io(trim(tString),tempr, 'read', ncid, readvar=readv) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(__FILE__, __LINE__)) - CNDecompBgcParamsInst%minpsi_bgc=tempr - - tString='cwd_flig' - call ncd_io(trim(tString),tempr, 'read', ncid, readvar=readv) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(__FILE__, __LINE__)) - CNDecompBgcParamsInst%cwd_flig_bgc=tempr - - !------- time-constant coefficients ---------- ! - ! set soil organic matter compartment C:N ratios - cn_s1 = CNDecompBgcParamsInst%cn_s1_bgc - cn_s2 = CNDecompBgcParamsInst%cn_s2_bgc - cn_s3 = CNDecompBgcParamsInst%cn_s3_bgc - - !------------------- list of pools and their attributes ------------ - i_litr1 = i_met_lit - floating_cn_ratio_decomp_pools(i_litr1) = .true. - decomp_pool_name_restart(i_litr1) = 'litr1' - decomp_pool_name_history(i_litr1) = 'LITR1' - decomp_pool_name_long(i_litr1) = 'litter 1' - decomp_pool_name_short(i_litr1) = 'L1' - is_litter(i_litr1) = .true. - is_soil(i_litr1) = .false. - is_cwd(i_litr1) = .false. - initial_cn_ratio(i_litr1) = 90._r8 - initial_stock(i_litr1) = 0._r8 - is_metabolic(i_litr1) = .true. - is_cellulose(i_litr1) = .false. - is_lignin(i_litr1) = .false. - - i_litr2 = i_cel_lit - floating_cn_ratio_decomp_pools(i_litr2) = .true. - decomp_pool_name_restart(i_litr2) = 'litr2' - decomp_pool_name_history(i_litr2) = 'LITR2' - decomp_pool_name_long(i_litr2) = 'litter 2' - decomp_pool_name_short(i_litr2) = 'L2' - is_litter(i_litr2) = .true. - is_soil(i_litr2) = .false. - is_cwd(i_litr2) = .false. - initial_cn_ratio(i_litr2) = 90._r8 - initial_stock(i_litr2) = 0._r8 - is_metabolic(i_litr2) = .false. - is_cellulose(i_litr2) = .true. - is_lignin(i_litr2) = .false. - - i_litr3 = i_lig_lit - floating_cn_ratio_decomp_pools(i_litr3) = .true. - decomp_pool_name_restart(i_litr3) = 'litr3' - decomp_pool_name_history(i_litr3) = 'LITR3' - decomp_pool_name_long(i_litr3) = 'litter 3' - decomp_pool_name_short(i_litr3) = 'L3' - is_litter(i_litr3) = .true. - is_soil(i_litr3) = .false. - is_cwd(i_litr3) = .false. - initial_cn_ratio(i_litr3) = 90._r8 - initial_stock(i_litr3) = 0._r8 - is_metabolic(i_litr3) = .false. - is_cellulose(i_litr3) = .false. - is_lignin(i_litr3) = .true. - - ! CWD - floating_cn_ratio_decomp_pools(i_cwd) = .true. - decomp_pool_name_restart(i_cwd) = 'cwd' - decomp_pool_name_history(i_cwd) = 'CWD' - decomp_pool_name_long(i_cwd) = 'coarse woody debris' - decomp_pool_name_short(i_cwd) = 'CWD' - is_litter(i_cwd) = .false. - is_soil(i_cwd) = .false. - is_cwd(i_cwd) = .true. - initial_cn_ratio(i_cwd) = 90._r8 - initial_stock(i_cwd) = 0._r8 - is_metabolic(i_cwd) = .false. - is_cellulose(i_cwd) = .false. - is_lignin(i_cwd) = .false. - - i_soil1 = 5 - floating_cn_ratio_decomp_pools(i_soil1) = .false. - decomp_pool_name_restart(i_soil1) = 'soil1' - decomp_pool_name_history(i_soil1) = 'SOIL1' - decomp_pool_name_long(i_soil1) = 'soil 1' - decomp_pool_name_short(i_soil1) = 'S1' - is_litter(i_soil1) = .false. - is_soil(i_soil1) = .true. - is_cwd(i_soil1) = .false. - initial_cn_ratio(i_soil1) = cn_s1 - initial_stock(i_soil1) = 20._r8 - is_metabolic(i_soil1) = .false. - is_cellulose(i_soil1) = .false. - is_lignin(i_soil1) = .false. - - i_soil2 = 6 - floating_cn_ratio_decomp_pools(i_soil2) = .false. - decomp_pool_name_restart(i_soil2) = 'soil2' - decomp_pool_name_history(i_soil2) = 'SOIL2' - decomp_pool_name_long(i_soil2) = 'soil 2' - decomp_pool_name_short(i_soil2) = 'S2' - is_litter(i_soil2) = .false. - is_soil(i_soil2) = .true. - is_cwd(i_soil2) = .false. - initial_cn_ratio(i_soil2) = cn_s2 - initial_stock(i_soil2) = 20._r8 - is_metabolic(i_soil2) = .false. - is_cellulose(i_soil2) = .false. - is_lignin(i_soil2) = .false. - - i_soil3 = 7 - floating_cn_ratio_decomp_pools(i_soil3) = .false. - decomp_pool_name_restart(i_soil3) = 'soil3' - decomp_pool_name_history(i_soil3) = 'SOIL3' - decomp_pool_name_long(i_soil3) = 'soil 3' - decomp_pool_name_short(i_soil3) = 'S3' - is_litter(i_soil3) = .false. - is_soil(i_soil3) = .true. - is_cwd(i_soil3) = .false. - initial_cn_ratio(i_soil3) = cn_s3 - initial_stock(i_soil3) = 20._r8 - is_metabolic(i_soil3) = .false. - is_cellulose(i_soil3) = .false. - is_lignin(i_soil3) = .false. - - spinup_factor(i_litr1) = 1._r8 - spinup_factor(i_litr2) = 1._r8 - spinup_factor(i_litr3) = 1._r8 - spinup_factor(i_cwd) = 1._r8 - spinup_factor(i_soil1) = CNDecompBgcParamsInst%spinup_vector(1) - spinup_factor(i_soil2) = CNDecompBgcParamsInst%spinup_vector(2) - spinup_factor(i_soil3) = CNDecompBgcParamsInst%spinup_vector(3) - - tau_l1 = 1./18.5 - tau_l2_l3 = 1./4.9 - tau_s1 = 1./7.3 - tau_s2 = 1./0.2 - tau_s3 = 1./.0045 - - ! century leaves wood decomposition rates open, within range of 0 - 0.5 yr^-1 - tau_cwd = 1./0.3 - days_per_year = get_days_per_year() - - CNDecompBgcParamsInst%k_decay_lit1=1._r8/(secspday * days_per_year * tau_l1) ![1/s] - CNDecompBgcParamsInst%k_decay_lit2=1._r8/(secspday * days_per_year * tau_l2_l3) - CNDecompBgcParamsInst%k_decay_lit3=1._r8/(secspday * days_per_year * tau_l2_l3) - CNDecompBgcParamsInst%k_decay_som1=1._r8/(secspday * days_per_year * tau_s1) - CNDecompBgcParamsInst%k_decay_som2=1._r8/(secspday * days_per_year * tau_s2) - CNDecompBgcParamsInst%k_decay_som3=1._r8/(secspday * days_per_year * tau_s3) - CNDecompBgcParamsInst%k_decay_cwd =1._r8/(secspday * days_per_year * tau_cwd) - - - kk = 1 - betrtracer_vars%tracer_solid_passive_diffus_scal_group(kk) = 1._r8 - betrtracer_vars%tracer_solid_passive_diffus_thc_group(kk) = 1.e-30_r8 - - if ( spinup_state .eq. 1 ) then - CNDecompBgcParamsInst%k_decay_som1 = CNDecompBgcParamsInst%k_decay_som1 * CNDecompBgcParamsInst%spinup_vector(1) - CNDecompBgcParamsInst%k_decay_som2 = CNDecompBgcParamsInst%k_decay_som2 * CNDecompBgcParamsInst%spinup_vector(2) - CNDecompBgcParamsInst%k_decay_som3 = CNDecompBgcParamsInst%k_decay_som3 * CNDecompBgcParamsInst%spinup_vector(3) - - ii=i_soil1 - kk = 2 - do jj = 1, nelms - betrtracer_vars%tracer_solid_passive_diffus_scal_group(kk) = & - betrtracer_vars%tracer_solid_passive_diffus_scal_group(kk) * spinup_factor(ii) - enddo - - ii=i_soil2 - kk = 3 - do jj = 1, nelms - betrtracer_vars%tracer_solid_passive_diffus_scal_group(kk) = & - betrtracer_vars%tracer_solid_passive_diffus_scal_group(kk) * spinup_factor(ii) - enddo - - ii=i_soil3 - kk = 4 - do jj = 1, nelms - betrtracer_vars%tracer_solid_passive_diffus_scal_group(kk) = & - betrtracer_vars%tracer_solid_passive_diffus_scal_group(kk) * spinup_factor(ii) - enddo - - endif - end associate - -end subroutine readCentDecompBgcParams - -!----------------------------------------------------------------------- -subroutine readCentCNAllocParams ( ncid ) - ! - ! !DESCRIPTION: - ! read in allocation parameters. - ! - ! !USES: - use ncdio_pio , only : file_desc_t,ncd_io - - ! !ARGUMENTS: - implicit none - type(file_desc_t),intent(inout) :: ncid ! pio netCDF file id - ! - ! !LOCAL VARIABLES: - character(len=32) :: subname = 'readCentCNAllocParams' - character(len=100) :: errCode = '-Error reading in parameters file:' - logical :: readv ! has variable been read in or not - real(r8) :: tempr ! temporary to read in parameter - character(len=100) :: tString ! temp. var for reading - !----------------------------------------------------------------------- - - ! read in parameters - - tString='compet_plant_no3' - call ncd_io(varname=trim(tString),data=tempr, flag='read', ncid=ncid, readvar=readv) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(__FILE__, __LINE__)) - NutrientCompetitionParamsInst%compet_plant_no3=tempr - - tString='compet_plant_nh4' - call ncd_io(varname=trim(tString),data=tempr, flag='read', ncid=ncid, readvar=readv) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(__FILE__, __LINE__)) - NutrientCompetitionParamsInst%compet_plant_nh4=tempr - - tString='compet_decomp_no3' - call ncd_io(varname=trim(tString),data=tempr, flag='read', ncid=ncid, readvar=readv) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(__FILE__, __LINE__)) - NutrientCompetitionParamsInst%compet_decomp_no3=tempr - - tString='compet_decomp_nh4' - call ncd_io(varname=trim(tString),data=tempr, flag='read', ncid=ncid, readvar=readv) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(__FILE__, __LINE__)) - NutrientCompetitionParamsInst%compet_decomp_nh4=tempr - - tString='compet_denit' - call ncd_io(varname=trim(tString),data=tempr, flag='read', ncid=ncid, readvar=readv) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(__FILE__, __LINE__)) - NutrientCompetitionParamsInst%compet_denit=tempr - - tString='compet_nit' - call ncd_io(varname=trim(tString),data=tempr, flag='read', ncid=ncid, readvar=readv) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(__FILE__, __LINE__)) - NutrientCompetitionParamsInst%compet_nit=tempr - - -end subroutine readCentCNAllocParams - - -end module BGCCenturyParMod diff --git a/components/clm/src/biogeochem/CNAllocationBetrMod.F90 b/components/clm/src/biogeochem/CNAllocationBetrMod.F90 index 371e737b34f4..7a78988de8f7 100644 --- a/components/clm/src/biogeochem/CNAllocationBetrMod.F90 +++ b/components/clm/src/biogeochem/CNAllocationBetrMod.F90 @@ -1,7 +1,5 @@ -module CNAllocationBetrMod +module CNAllocationBeTRMod -#include "shr_assert.h" - !----------------------------------------------------------------------- ! !DESCRIPTION: ! Module holding routines used in allocation model for coupled carbon @@ -11,7 +9,8 @@ module CNAllocationBetrMod use shr_kind_mod , only : r8 => shr_kind_r8 use shr_log_mod , only : errMsg => shr_log_errMsg use clm_varcon , only : dzsoi_decomp - use clm_varctl , only : use_c13, use_c14, use_nitrif_denitrif + use clm_varctl , only : use_c13, use_c14, use_nitrif_denitrif, spinup_state + use clm_varctl , only : nyears_ad_carbon_only use abortutils , only : endrun use decompMod , only : bounds_type use subgridAveMod , only : p2c @@ -20,154 +19,149 @@ module CNAllocationBetrMod use CNCarbonStateType , only : carbonstate_type use CNNitrogenFluxType , only : nitrogenflux_type use CNNitrogenStateType , only : nitrogenstate_type + !!! add phosphorus + use PhosphorusFluxType , only : phosphorusflux_type + use PhosphorusStateType , only : phosphorusstate_type use CNStateType , only : cnstate_type use PhotosynthesisType , only : photosyns_type use CropType , only : crop_type - use VegetationPropertiesType , only : veg_vp + use VegetationPropertiesType, only : veg_vp use LandunitType , only : lun_pp use ColumnType , only : col_pp - use VegetationType , only : veg_pp + use VegetationType , only : veg_pp + ! bgc interface & pflotran module switches + use clm_varctl , only: use_bgc_interface,use_clm_bgc, use_pflotran, pf_cmode + use clm_varctl , only : nu_com + use SoilStatetype , only : soilstate_type + use WaterStateType , only : waterstate_type + use PlantMicKineticsMod , only : PlantMicKinetics_type + use CNAllocationMod , only : CNAllocParamsInst ! implicit none save - private + ! ! !PUBLIC MEMBER FUNCTIONS: - public :: readCNAllocBetrParams - public :: CNAllocationBetrInit ! Initialization - public :: calc_plant_nutrient_demand - public :: plantCNAlloc - type :: CNAllocParamsType - real(r8) :: bdnr ! bulk denitrification rate (1/s) - real(r8) :: dayscrecover ! number of days to recover negative cpool - real(r8) :: compet_plant_no3 ! (unitless) relative compettiveness of plants for NO3 - real(r8) :: compet_plant_nh4 ! (unitless) relative compettiveness of plants for NH4 - real(r8) :: compet_decomp_no3 ! (unitless) relative competitiveness of immobilizers for NO3 - real(r8) :: compet_decomp_nh4 ! (unitless) relative competitiveness of immobilizers for NH4 - real(r8) :: compet_denit ! (unitless) relative competitiveness of denitrifiers for NO3 - real(r8) :: compet_nit ! (unitless) relative competitiveness of nitrifiers for NH4 - end type CNAllocParamsType + public :: CNAllocationBeTRInit ! Initialization + private:: calc_plantN_kineticpar + + !!----------------------------------------------------------------------------------------------------- + !! CNAllocation is divided into 3 subroutines/phases: + private :: CNAllocation1_PlantNPDemand !!Plant N/P Demand; called in CNEcosystemDynNoLeaching1 + public :: CNAllocation3_PlantCNPAlloc !!Plant C/N/P Allocation; called in CNDecompAlloc2 + !!----------------------------------------------------------------------------------------------------- + private :: dynamic_plant_alloc ! dynamic plant carbon allocation based on different nutrient stress + ! - ! CNAllocParamsInst is populated in readCNAllocParams which is called in - type(CNAllocParamsType),protected :: CNAllocParamsInst ! ! !PUBLIC DATA MEMBERS: - character(len=*), parameter, public :: suplnAll='ALL' ! Supplemental Nitrogen for all PFT's - character(len=*), parameter, public :: suplnNon='NONE' ! No supplemental Nitrogen - character(len=15) , public :: suplnitro = suplnNon ! Supplemental Nitrogen mode + character(len=*), parameter, public :: suplnAll='ALL' ! Supplemental Nitrogen for all PFT's + character(len=*), parameter, public :: suplnNon='NONE' ! No supplemental Nitrogen + character(len=15), public :: suplnitro = suplnNon ! Supplemental Nitrogen mode + !! add phosphorus - X. YANG + character(len=*), parameter, public :: suplpAll='ALL' ! Supplemental Phosphorus for all PFT's + character(len=*), parameter, public :: suplpNon='NONE' ! No supplemental Phosphorus + character(len=15), public :: suplphos = suplpAll ! Supplemental Phosphorus mode + !! add competition, - Q. Zhu + logical, public :: nu_com_leaf_physiology = .false. + logical, public :: nu_com_root_kinetics = .false. + logical, public :: nu_com_phosphatase = .false. + logical, public :: nu_com_nfix = .false. + ! ! !PRIVATE DATA MEMBERS: real(r8) :: dt !decomp timestep (seconds) - real(r8) :: bdnr !bulk denitrification rate (1/s) real(r8) :: dayscrecover !number of days to recover negative cpool real(r8), allocatable :: arepr(:) !reproduction allocation coefficient real(r8), allocatable :: aroot(:) !root allocation coefficient - !----------------------------------------------------------------------- + real(r8), allocatable :: col_plant_ndemand(:) !column-level plant N demand + real(r8), allocatable :: col_plant_pdemand(:) !column-level plant P demand -contains + logical :: crop_supln = .false. !Prognostic crop receives supplemental Nitrogen - !----------------------------------------------------------------------- - subroutine readCNAllocBetrParams ( ncid ) - ! - ! !USES: - use ncdio_pio , only : file_desc_t,ncd_io + real(r8), allocatable :: decompmicc(:,:) ! column-level soil microbial decomposer biomass gC/m3 - ! !ARGUMENTS: - implicit none - type(file_desc_t),intent(inout) :: ncid ! pio netCDF file id - ! - ! !LOCAL VARIABLES: - character(len=32) :: subname = 'CNAllocParamsType' ! - character(len=100) :: errCode = '-Error reading in parameters file:' ! - logical :: readv ! has variable been read in or not - real(r8) :: tempr ! temporary to read in parameter - character(len=100) :: tString ! temp. var for reading - !----------------------------------------------------------------------- + real(r8), parameter :: E_plant_scalar = 0.0000125_r8 ! scaling factor for plant fine root biomass to calculate nutrient carrier enzyme abundance + real(r8), parameter :: E_decomp_scalar = 0.05_r8 ! scaling factor for plant fine root biomass to calculate nutrient carrier enzyme abundance + + real(r8) :: e_km_nh4 ! temp variable of sum(E/KM) for NH4 competition BGC mode + real(r8) :: e_km_no3 ! temp variable of sum(E/KM) for NO3 competition BGC mode + real(r8) :: e_km_p ! temp variable of sum(E/KM) for P competition + real(r8) :: e_km_n ! temp variable of sum(E/KM) for N competition CN mode - ! read in parameters - - tString='bdnr' - call ncd_io(varname=trim(tString),data=tempr, flag='read', ncid=ncid, readvar=readv) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(__FILE__, __LINE__)) - CNAllocParamsInst%bdnr=tempr - - tString='dayscrecover' - call ncd_io(varname=trim(tString),data=tempr, flag='read', ncid=ncid, readvar=readv) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(__FILE__, __LINE__)) - CNAllocParamsInst%dayscrecover=tempr - - tString='compet_plant_no3' - call ncd_io(varname=trim(tString),data=tempr, flag='read', ncid=ncid, readvar=readv) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(__FILE__, __LINE__)) - CNAllocParamsInst%compet_plant_no3=tempr - - tString='compet_plant_nh4' - call ncd_io(varname=trim(tString),data=tempr, flag='read', ncid=ncid, readvar=readv) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(__FILE__, __LINE__)) - CNAllocParamsInst%compet_plant_nh4=tempr - - tString='compet_decomp_no3' - call ncd_io(varname=trim(tString),data=tempr, flag='read', ncid=ncid, readvar=readv) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(__FILE__, __LINE__)) - CNAllocParamsInst%compet_decomp_no3=tempr - - tString='compet_decomp_nh4' - call ncd_io(varname=trim(tString),data=tempr, flag='read', ncid=ncid, readvar=readv) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(__FILE__, __LINE__)) - CNAllocParamsInst%compet_decomp_nh4=tempr - - tString='compet_denit' - call ncd_io(varname=trim(tString),data=tempr, flag='read', ncid=ncid, readvar=readv) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(__FILE__, __LINE__)) - CNAllocParamsInst%compet_denit=tempr - - tString='compet_nit' - call ncd_io(varname=trim(tString),data=tempr, flag='read', ncid=ncid, readvar=readv) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(__FILE__, __LINE__)) - CNAllocParamsInst%compet_nit=tempr - - end subroutine readCNAllocBetrParams + !----------------------------------------------------------------------- + +contains !----------------------------------------------------------------------- - subroutine CNAllocationBetrInit ( bounds) + subroutine CNAllocationBeTRInit ( bounds) ! ! !DESCRIPTION: ! ! !USES: use clm_varcon , only: secspday - use clm_time_manager, only: get_step_size + use clm_time_manager, only: get_step_size, get_curr_date use clm_varpar , only: crop_prog use clm_varctl , only: iulog, cnallocate_carbon_only_set + use clm_varctl , only: cnallocate_carbonnitrogen_only_set + use clm_varctl , only: cnallocate_carbonphosphorus_only_set use shr_infnan_mod , only: nan => shr_infnan_nan, assignment(=) + use clm_varpar , only: nlevdecomp ! ! !ARGUMENTS: implicit none - type(bounds_type), intent(in) :: bounds + type(bounds_type), intent(in) :: bounds ! ! !LOCAL VARIABLES: - character(len=32) :: subname = 'CNAllocationInit' - logical :: carbon_only + character(len=32) :: subname = 'CNAllocationBeTRInit' + integer :: yr, mon, day, sec + logical :: carbon_only + logical :: carbonnitrogen_only + logical :: carbonphosphorus_only !----------------------------------------------------------------------- if ( crop_prog )then allocate(arepr(bounds%begp:bounds%endp)); arepr(bounds%begp : bounds%endp) = nan allocate(aroot(bounds%begp:bounds%endp)); aroot(bounds%begp : bounds%endp) = nan end if - + allocate(col_plant_ndemand(bounds%begc:bounds%endc)); col_plant_ndemand(bounds%begc : bounds%endc) = nan + allocate(col_plant_pdemand(bounds%begc:bounds%endc)); col_plant_pdemand(bounds%begc : bounds%endc) = nan + allocate(decompmicc(bounds%begc:bounds%endc,1:nlevdecomp)); decompmicc(bounds%begc:bounds%endc,1:nlevdecomp) = nan ! set time steps dt = real( get_step_size(), r8 ) ! set space-and-time parameters from parameter file - bdnr = CNAllocParamsInst%bdnr * (dt/secspday) dayscrecover = CNAllocParamsInst%dayscrecover ! Change namelist settings into private logical variables select case(suplnitro) case(suplnNon) - Carbon_only = .false. + select case (suplphos) + case(suplpNon) + Carbon_only = .false. + CarbonNitrogen_only = .false. + CarbonPhosphorus_only=.false. + crop_supln = .false. + case(suplpAll) + Carbon_only = .false. + CarbonNitrogen_only = .true. + CarbonPhosphorus_only=.false. + crop_supln = .false. + end select case(suplnAll) - Carbon_only = .true. + select case (suplphos) + case(suplpNon) + Carbon_only = .false. + CarbonNitrogen_only = .false. + CarbonPhosphorus_only=.true. + crop_supln = .false. + case(suplpAll) + Carbon_only = .true. + CarbonNitrogen_only = .false. + CarbonPhosphorus_only=.false. + crop_supln = .false. + end select case default write(iulog,*) 'Supplemental Nitrogen flag (suplnitro) can only be: ', & suplnNon, ' or ', suplnAll @@ -175,800 +169,1835 @@ subroutine CNAllocationBetrInit ( bounds) errMsg(__FILE__, __LINE__)) end select - end subroutine CNAllocationBetrInit - - -!------------------------------------------------------------------------------- + ! phosphorus conditions of plants are needed, in order to use new fixation and phosphatase + ! activity subroutines, under carbon only or carbon nitrogen only mode, fixation and phosphatase + ! activity are set to false + if (carbon_only .or. carbonnitrogen_only) then + nu_com_nfix = .false. + nu_com_phosphatase = .false. + end if - subroutine plantCNAlloc(bounds, num_soilc, filter_soilc, num_soilp, filter_soilp, & - photosyns_vars, cnstate_vars, carbonstate_vars, carbonflux_vars, & - c13_carbonflux_vars, c14_carbonflux_vars, nitrogenstate_vars, nitrogenflux_vars) - ! - ! DESCRIPTION - ! - ! do plant productivity downregulation after considering nutrient limitation - + call get_curr_date(yr, mon, day, sec) + if (spinup_state == 1 .and. yr .le. nyears_ad_carbon_only) then + Carbon_only = .true. + end if - ! - ! !USES: - use shr_sys_mod , only: shr_sys_flush - use clm_varctl , only: iulog, cnallocate_carbon_only - use pftvarcon , only: npcropmin, declfact, bfact, aleaff, arootf, astemf - use pftvarcon , only: arooti, fleafi, allconsl, allconss, grperc, grpnow, nsoybean - use clm_varpar , only: nlevsoi, nlevdecomp - use clm_varcon , only: nitrif_n2o_loss_frac, secspday - use landunit_varcon , only: istsoil, istcrop - use clm_time_manager , only: get_step_size - use clm_varctl , only: use_c13, use_c14 - implicit none - ! - ! !ARGUMENTS: - type(bounds_type) , intent(in) :: bounds - integer , intent(in) :: num_soilc ! number of soil columns in filter - integer , intent(in) :: filter_soilc(:) ! filter for soil columns - integer , intent(in) :: num_soilp ! number of soil patches in filter - integer , intent(in) :: filter_soilp(:) ! filter for soil patches - type(photosyns_type) , intent(in) :: photosyns_vars - type(cnstate_type) , intent(inout) :: cnstate_vars - type(carbonstate_type) , intent(in) :: carbonstate_vars - type(carbonflux_type) , intent(inout) :: carbonflux_vars - type(carbonflux_type) , intent(inout) :: c13_carbonflux_vars - type(carbonflux_type) , intent(inout) :: c14_carbonflux_vars - type(nitrogenstate_type) , intent(inout) :: nitrogenstate_vars - type(nitrogenflux_type) , intent(inout) :: nitrogenflux_vars + call cnallocate_carbon_only_set(carbon_only) + call cnallocate_carbonnitrogen_only_set(carbonnitrogen_only) + call cnallocate_carbonphosphorus_only_set(carbonphosphorus_only) + + end subroutine CNAllocationBeTRInit +!!------------------------------------------------------------------------------------------------- + subroutine SetPlantMicNPDemand(bounds, num_soilc, filter_soilc, num_soilp, filter_soilp, & + photosyns_vars, crop_vars, canopystate_vars, cnstate_vars, & + carbonstate_vars, carbonflux_vars, c13_carbonflux_vars, c14_carbonflux_vars, & + nitrogenstate_vars, nitrogenflux_vars,& + phosphorusstate_vars,phosphorusflux_vars, PlantMicKinetics_vars) + implicit none + ! + ! !ARGUMENTS: + type(bounds_type) , intent(in) :: bounds + integer , intent(in) :: num_soilc ! number of soil columns in filter + integer , intent(in) :: filter_soilc(:) ! filter for soil columns + integer , intent(in) :: num_soilp ! number of soil patches in filter + integer , intent(in) :: filter_soilp(:) ! filter for soil patches + type(photosyns_type) , intent(in) :: photosyns_vars + type(crop_type) , intent(in) :: crop_vars + type(canopystate_type) , intent(in) :: canopystate_vars + type(cnstate_type) , intent(inout) :: cnstate_vars + type(carbonstate_type) , intent(in) :: carbonstate_vars + type(carbonflux_type) , intent(inout) :: carbonflux_vars + type(carbonflux_type) , intent(inout) :: c13_carbonflux_vars + type(carbonflux_type) , intent(inout) :: c14_carbonflux_vars + type(nitrogenstate_type) , intent(inout) :: nitrogenstate_vars + type(nitrogenflux_type) , intent(inout) :: nitrogenflux_vars + type(phosphorusstate_type) , intent(inout) :: phosphorusstate_vars + type(phosphorusflux_type) , intent(inout) :: phosphorusflux_vars + type(PlantMicKinetics_type) , intent(inout) :: PlantMicKinetics_vars + + !calculate the plant nutrient demand + call CNAllocation1_PlantNPDemand(bounds, num_soilc, filter_soilc, num_soilp, filter_soilp, & + photosyns_vars, crop_vars, canopystate_vars, cnstate_vars, & + carbonstate_vars, carbonflux_vars, c13_carbonflux_vars, c14_carbonflux_vars, & + nitrogenstate_vars, nitrogenflux_vars,& + phosphorusstate_vars,phosphorusflux_vars) + + !extract the kinetic parameters + call calc_plantN_kineticpar(bounds, num_soilc, filter_soilc , & + num_soilp, filter_soilp , & + cnstate_vars , & + carbonstate_vars , & + nitrogenstate_vars , & + phosphorusstate_vars , & + carbonflux_vars , & + PlantMicKinetics_vars ) + + end subroutine SetPlantMicNPDemand +!!------------------------------------------------------------------------------------------------- + subroutine CNAllocation1_PlantNPDemand (bounds, num_soilc, filter_soilc, num_soilp, filter_soilp, & + photosyns_vars, crop_vars, canopystate_vars, cnstate_vars, & + carbonstate_vars, carbonflux_vars, c13_carbonflux_vars, c14_carbonflux_vars, & + nitrogenstate_vars, nitrogenflux_vars,& + phosphorusstate_vars,phosphorusflux_vars) + !! PHASE-1 of CNAllocation: loop over patches to assess the total plant N demand and P demand + ! !USES: + use shr_sys_mod , only: shr_sys_flush + use clm_varctl , only: iulog,cnallocate_carbon_only,cnallocate_carbonnitrogen_only,& + cnallocate_carbonphosphorus_only + use pftvarcon , only: npcropmin, declfact, bfact, aleaff, arootf, astemf, noveg + use pftvarcon , only: arooti, fleafi, allconsl, allconss, grperc, grpnow, nsoybean + use clm_varpar , only: nlevdecomp + use clm_varcon , only: nitrif_n2o_loss_frac, secspday + use clm_varctl , only: cnallocate_carbon_only_set +! use landunit_varcon , only: istsoil, istcrop + use clm_time_manager , only: get_step_size, get_curr_date + ! + ! !ARGUMENTS: + type(bounds_type) , intent(in) :: bounds + integer , intent(in) :: num_soilc ! number of soil columns in filter + integer , intent(in) :: filter_soilc(:) ! filter for soil columns + integer , intent(in) :: num_soilp ! number of soil patches in filter + integer , intent(in) :: filter_soilp(:) ! filter for soil patches + type(photosyns_type) , intent(in) :: photosyns_vars + type(crop_type) , intent(in) :: crop_vars + type(canopystate_type) , intent(in) :: canopystate_vars + type(cnstate_type) , intent(inout) :: cnstate_vars + type(carbonstate_type) , intent(in) :: carbonstate_vars + type(carbonflux_type) , intent(inout) :: carbonflux_vars + type(carbonflux_type) , intent(inout) :: c13_carbonflux_vars + type(carbonflux_type) , intent(inout) :: c14_carbonflux_vars + type(nitrogenstate_type) , intent(inout) :: nitrogenstate_vars + type(nitrogenflux_type) , intent(inout) :: nitrogenflux_vars +! !! add phosphorus -X.YANG + type(phosphorusstate_type) , intent(inout) :: phosphorusstate_vars + type(phosphorusflux_type) , intent(inout) :: phosphorusflux_vars ! ! !LOCAL VARIABLES: + real(r8) :: fpi_no3_vr(bounds%begc:bounds%endc,1:nlevdecomp) ! fraction of potential immobilization supplied by no3(no units) + real(r8) :: fpi_nh4_vr(bounds%begc:bounds%endc,1:nlevdecomp) ! fraction of potential immobilization supplied by nh4 (no units) + real(r8) :: sum_nh4_demand_vr(bounds%begc:bounds%endc,1:nlevdecomp) + real(r8) :: sum_nh4_demand_scaled(bounds%begc:bounds%endc,1:nlevdecomp) + real(r8) :: sum_no3_demand_vr(bounds%begc:bounds%endc,1:nlevdecomp) + real(r8) :: sum_no3_demand_scaled(bounds%begc:bounds%endc,1:nlevdecomp) + + real(r8) :: sum_pdemand_scaled(bounds%begc:bounds%endc,1:nlevdecomp) ! sum of total P demand, scaled with relative competitiveness + real(r8) :: excess_immob_nh4_vr(bounds%begc:bounds%endc,1:nlevdecomp) ! nh4 excess flux, if soil microbes are more P limited + real(r8) :: excess_immob_no3_vr(bounds%begc:bounds%endc,1:nlevdecomp) ! no3 excess flux, if soil microbes are more P limited + real(r8) :: excess_immob_p_vr(bounds%begc:bounds%endc,1:nlevdecomp) ! P excess flux, if soil microbes are more N limited + real(r8) :: compet_plant_no3(bounds%begp:bounds%endp) ! (unitless) relative compettiveness of plants for NO3 BGC mode + real(r8) :: compet_plant_nh4(bounds%begp:bounds%endp) ! (unitless) relative compettiveness of plants for NH4 BGC mode + real(r8) :: compet_plant_n(bounds%begp:bounds%endp) ! (unitless) relative compettiveness of plants for N CN mode + real(r8) :: compet_plant_p(bounds%begp:bounds%endp) ! (unitless) relative competitiveness of plant for P + real(r8) :: compet_leach_no3 ! (unitless) relative competitiveness of leaching for NO3 + real(r8) :: compet_decomp_p ! (unitless) relative competitiveness of immobilizer for P + real(r8) :: compet_minsurf_p ! (unitless) relative competitiveness of mineral surface for P + real(r8) :: compet_leach_p ! (unitless) relative competitiveness of leaching for P + ! - integer :: c,p,l,pi,j !indices - integer :: fp !lake filter pft index - integer :: fc !lake filter column index - real(r8):: f1,f2,f3,f4,g1,g2 !allocation parameters - real(r8):: cnl,cnfr,cnlw,cndw !C:N ratios for leaf, fine root, and wood - real(r8):: fcur !fraction of current psn displayed as growth - real(r8):: gresp_storage !temporary variable for growth resp to storage - real(r8):: nlc !temporary variable for total new leaf carbon allocation - real(r8):: f5 !grain allocation parameter - real(r8):: cng !C:N ratio for grain (= cnlw for now; slevis) - !----------------------------------------------------------------------- + integer :: c,p,l,j !indices + integer :: fp !lake filter pft index + integer :: fc !lake filter column index + real(r8):: mr !maintenance respiration (gC/m2/s) + real(r8):: f1,f2,f3,f4,g1,g2 !allocation parameters + real(r8):: cnl,cnfr,cnlw,cndw !C:N ratios for leaf, fine root, and wood + + real(r8):: curmr, curmr_ratio !xsmrpool temporary variables +! real(r8):: sum_ndemand_vr(bounds%begc:bounds%endc, 1:nlevdecomp) !total column N demand (gN/m3/s) at a given level +! real(r8):: sminn_tot(bounds%begc:bounds%endc) + real(r8):: nuptake_prof(bounds%begc:bounds%endc, 1:nlevdecomp) + + real(r8) f5 !grain allocation parameter + real(r8) cng !C:N ratio for grain (= cnlw for now; slevis) + real(r8) fleaf !fraction allocated to leaf + real(r8) t1 !temporary variable + integer :: yr, mon, day, sec + + !! Local P variables + real(r8):: cpl,cpfr,cplw,cpdw,cpg !C:N ratios for leaf, fine root, and wood + real(r8):: sum_pdemand_vr(bounds%begc:bounds%endc, 1:nlevdecomp) !total column P demand (gN/m3/s) at a given level + real(r8):: puptake_prof(bounds%begc:bounds%endc, 1:nlevdecomp) + real(r8):: solutionp_tot(bounds%begc:bounds%endc) + integer :: plimit(bounds%begc:bounds%endc,0:nlevdecomp) !flag for P limitation + real(r8):: residual_sminp_vr(bounds%begc:bounds%endc, 1:nlevdecomp) + real(r8):: residual_sminp(bounds%begc:bounds%endc) + real(r8):: residual_plant_pdemand(bounds%begc:bounds%endc) + real(r8):: sum_ndemand_scaled(bounds%begc:bounds%endc, 1:nlevdecomp) !total column N demand (gN/m3/s) at a given level + + real(r8), pointer :: desorb_to_solutionp_vr (:,:) + real(r8), pointer :: primp_to_labilep_vr_col (:,:) + real(r8), pointer :: biochem_pmin_vr_col (:,:) + real(r8), pointer :: secondp_to_labilep_vr_col (:,:) + real(r8), pointer :: labilep_to_secondp_vr_col (:,:) + real(r8), pointer :: adsorb_to_labilep_vr (:,:) + real(r8), pointer :: plant_pdemand_vr_patch (:,:) + real(r8), pointer :: plant_n_uptake_flux (:) + + real(r8), pointer :: labilep_vr (:,:) + real(r8), pointer :: secondp_vr (:,:) + real(r8), pointer :: actual_leafcp (:) + real(r8), pointer :: actual_frootcp (:) + real(r8), pointer :: actual_livewdcp (:) + real(r8), pointer :: actual_deadwdcp (:) + real(r8), pointer :: leafp (:) + real(r8), pointer :: plant_p_uptake_flux (:) + + real(r8), pointer :: col_plant_ndemand_vr (:,:) + real(r8), pointer :: col_plant_nh4demand_vr (:,:) + real(r8), pointer :: col_plant_no3demand_vr (:,:) + real(r8), pointer :: col_plant_pdemand_vr (:,:) + real(r8), pointer :: plant_nh4demand_vr_patch (:,:) + real(r8), pointer :: plant_no3demand_vr_patch (:,:) + real(r8), pointer :: plant_ndemand_vr_patch (:,:) + real(r8), pointer :: actual_immob_no3 (:) + real(r8), pointer :: actual_immob_nh4 (:) + real(r8), pointer :: benefit_pgpp_pleafc (:) - associate( & - ivt => veg_pp%itype , & ! Input: [integer (:) ] pft vegetation type - - woody => veg_vp%woody , & ! Input: [real(r8) (:) ] binary flag for woody lifeform (1=woody, 0=not woody) - froot_leaf => veg_vp%froot_leaf , & ! Input: [real(r8) (:) ] allocation parameter: new fine root C per new leaf C (gC/gC) - croot_stem => veg_vp%croot_stem , & ! Input: [real(r8) (:) ] allocation parameter: new coarse root C per new stem C (gC/gC) - stem_leaf => veg_vp%stem_leaf , & ! Input: [real(r8) (:) ] allocation parameter: new stem c per new leaf C (gC/gC) - flivewd => veg_vp%flivewd , & ! Input: [real(r8) (:) ] allocation parameter: fraction of new wood that is live (phloem and ray parenchyma) (no units) - leafcn => veg_vp%leafcn , & ! Input: [real(r8) (:) ] leaf C:N (gC/gN) - frootcn => veg_vp%frootcn , & ! Input: [real(r8) (:) ] fine root C:N (gC/gN) - livewdcn => veg_vp%livewdcn , & ! Input: [real(r8) (:) ] live wood (phloem and ray parenchyma) C:N (gC/gN) - deadwdcn => veg_vp%deadwdcn , & ! Input: [real(r8) (:) ] dead wood (xylem and heartwood) C:N (gC/gN) - fcur2 => veg_vp%fcur , & ! Input: [real(r8) (:) ] allocation parameter: fraction of allocation that goes to currently displayed growth, remainder to storage - graincn => veg_vp%graincn , & ! Input: [real(r8) (:) ] grain C:N (gC/gN) - psnsun => photosyns_vars%psnsun_patch , & ! Input: [real(r8) (:) ] sunlit leaf-level photosynthesis (umol CO2 /m**2/ s) - psnsha => photosyns_vars%psnsha_patch , & ! Input: [real(r8) (:) ] shaded leaf-level photosynthesis (umol CO2 /m**2/ s) - leafc => carbonstate_vars%leafc_patch , & ! Input: [real(r8) (:) ] - frootc => carbonstate_vars%frootc_patch , & ! Input: [real(r8) (:) ] - livestemc => carbonstate_vars%livestemc_patch , & ! Input: [real(r8) (:) ] - croplive => cnstate_vars%croplive_patch , & ! Input: [logical (:) ] flag, true if planted, not harvested - aleaf => cnstate_vars%aleaf_patch , & ! Output: [real(r8) (:) ] leaf allocation coefficient - astem => cnstate_vars%astem_patch , & ! Output: [real(r8) (:) ] stem allocation coefficient - fpg => cnstate_vars%fpg_col , & ! Output: [real(r8) (:) ] fraction of potential gpp (no units) - c_allometry => cnstate_vars%c_allometry_patch , & ! Output: [real(r8) (:) ] C allocation index (DIM) - n_allometry => cnstate_vars%n_allometry_patch , & ! Output: [real(r8) (:) ] N allocation index (DIM) = - downreg => cnstate_vars%downreg_patch , & ! Output: [real(r8) (:) ] fractional reduction in GPP due to N limitation (DIM) - - annsum_npp => carbonflux_vars%annsum_npp_patch , & ! Input: [real(r8) (:) ] annual sum of NPP, for wood allocation - gpp => carbonflux_vars%gpp_before_downreg_patch , & ! Output: [real(r8) (:) ] GPP flux before downregulation (gC/m2/s) - availc => carbonflux_vars%availc_patch , & ! Output: [real(r8) (:) ] C flux available for allocation (gC/m2/s) - excess_cflux => carbonflux_vars%excess_cflux_patch , & ! Output: [real(r8) (:) ] C flux not allocated due to downregulation (gC/m2/s) - plant_calloc => carbonflux_vars%plant_calloc_patch , & ! Output: [real(r8) (:) ] total allocated C flux (gC/m2/s) - psnsun_to_cpool => carbonflux_vars%psnsun_to_cpool_patch , & ! Output: [real(r8) (:) ] - psnshade_to_cpool => carbonflux_vars%psnshade_to_cpool_patch , & ! Output: [real(r8) (:) ] - - cpool_to_leafc => carbonflux_vars%cpool_to_leafc_patch , & ! Output: [real(r8) (:) ] - cpool_to_leafc_storage => carbonflux_vars%cpool_to_leafc_storage_patch , & ! Output: [real(r8) (:) ] - cpool_to_frootc => carbonflux_vars%cpool_to_frootc_patch , & ! Output: [real(r8) (:) ] - cpool_to_frootc_storage => carbonflux_vars%cpool_to_frootc_storage_patch , & ! Output: [real(r8) (:) ] - cpool_to_livestemc => carbonflux_vars%cpool_to_livestemc_patch , & ! Output: [real(r8) (:) ] - cpool_to_livestemc_storage => carbonflux_vars%cpool_to_livestemc_storage_patch , & ! Output: [real(r8) (:) ] - cpool_to_deadstemc => carbonflux_vars%cpool_to_deadstemc_patch , & ! Output: [real(r8) (:) ] - cpool_to_deadstemc_storage => carbonflux_vars%cpool_to_deadstemc_storage_patch , & ! Output: [real(r8) (:) ] - cpool_to_livecrootc => carbonflux_vars%cpool_to_livecrootc_patch , & ! Output: [real(r8) (:) ] - cpool_to_livecrootc_storage => carbonflux_vars%cpool_to_livecrootc_storage_patch , & ! Output: [real(r8) (:) ] - cpool_to_deadcrootc => carbonflux_vars%cpool_to_deadcrootc_patch , & ! Output: [real(r8) (:) ] - cpool_to_deadcrootc_storage => carbonflux_vars%cpool_to_deadcrootc_storage_patch , & ! Output: [real(r8) (:) ] - cpool_to_gresp_storage => carbonflux_vars%cpool_to_gresp_storage_patch , & ! Output: [real(r8) (:) ] allocation to growth respiration storage (gC/m2/s) - cpool_to_grainc => carbonflux_vars%cpool_to_grainc_patch , & ! Output: [real(r8) (:) ] allocation to grain C (gC/m2/s) - cpool_to_grainc_storage => carbonflux_vars%cpool_to_grainc_storage_patch , & ! Output: [real(r8) (:) ] allocation to grain C storage (gC/m2/s) - - retransn => nitrogenstate_vars%retransn_patch , & ! Input: [real(r8) (:) ] (gN/m2) plant pool of retranslocated N - - plant_ndemand => nitrogenflux_vars%plant_ndemand_patch , & ! Output: [real(r8) (:) ] N flux required to support initial GPP (gN/m2/s) - plant_nalloc => nitrogenflux_vars%plant_nalloc_patch , & ! Output: [real(r8) (:) ] total allocated N flux (gN/m2/s) - npool_to_grainn => nitrogenflux_vars%npool_to_grainn_patch , & ! Output: [real(r8) (:) ] allocation to grain N (gN/m2/s) - npool_to_grainn_storage => nitrogenflux_vars%npool_to_grainn_storage_patch , & ! Output: [real(r8) (:) ] allocation to grain N storage (gN/m2/s) - retransn_to_npool => nitrogenflux_vars%retransn_to_npool_patch , & ! Output: [real(r8) (:) ] deployment of retranslocated N (gN/m2/s) - sminn_to_npool => nitrogenflux_vars%sminn_to_npool_patch , & ! Output: [real(r8) (:) ] deployment of soil mineral N uptake (gN/m2/s) - npool_to_leafn => nitrogenflux_vars%npool_to_leafn_patch , & ! Output: [real(r8) (:) ] allocation to leaf N (gN/m2/s) - npool_to_leafn_storage => nitrogenflux_vars%npool_to_leafn_storage_patch , & ! Output: [real(r8) (:) ] allocation to leaf N storage (gN/m2/s) - npool_to_frootn => nitrogenflux_vars%npool_to_frootn_patch , & ! Output: [real(r8) (:) ] allocation to fine root N (gN/m2/s) - npool_to_frootn_storage => nitrogenflux_vars%npool_to_frootn_storage_patch , & ! Output: [real(r8) (:) ] allocation to fine root N storage (gN/m2/s) - npool_to_livestemn => nitrogenflux_vars%npool_to_livestemn_patch , & ! Output: [real(r8) (:) ] - npool_to_livestemn_storage => nitrogenflux_vars%npool_to_livestemn_storage_patch , & ! Output: [real(r8) (:) ] - npool_to_deadstemn => nitrogenflux_vars%npool_to_deadstemn_patch , & ! Output: [real(r8) (:) ] - npool_to_deadstemn_storage => nitrogenflux_vars%npool_to_deadstemn_storage_patch , & ! Output: [real(r8) (:) ] - npool_to_livecrootn => nitrogenflux_vars%npool_to_livecrootn_patch , & ! Output: [real(r8) (:) ] - npool_to_livecrootn_storage => nitrogenflux_vars%npool_to_livecrootn_storage_patch , & ! Output: [real(r8) (:) ] - npool_to_deadcrootn => nitrogenflux_vars%npool_to_deadcrootn_patch , & ! Output: [real(r8) (:) ] - npool_to_deadcrootn_storage => nitrogenflux_vars%npool_to_deadcrootn_storage_patch , & ! Output: [real(r8) (:) ] - frootn_to_retransn => nitrogenflux_vars%frootn_to_retransn_patch , & ! Output: [real(r8) (:) ] - sminn_to_plant => nitrogenflux_vars%sminn_to_plant_col , & ! Output: [real(r8) (:) ] - - c13cf => c13_carbonflux_vars, & - c14cf => c14_carbonflux_vars & - ) - - - ! start new pft loop to distribute the available N between the - ! competing patches on the basis of relative demand, and allocate C and N to - ! new growth and storage + !----------------------------------------------------------------------- - do fp=1,num_soilp - p = filter_soilp(fp) - c = veg_pp%column(p) - - ! set some local allocation variables - f1 = froot_leaf(ivt(p)) - f2 = croot_stem(ivt(p)) - - ! modified wood allocation to be 2.2 at npp=800 gC/m2/yr, 0.2 at npp=0, - ! constrained so that it does not go lower than 0.2 (under negative annsum_npp) - ! There was an error in this formula in previous version, where the coefficient - ! was 0.004 instead of 0.0025. - ! This variable allocation is only for trees. Shrubs have a constant - ! allocation as specified in the pft-physiology file. The value is also used - ! as a trigger here: -1.0 means to use the dynamic allocation (trees). - if (stem_leaf(ivt(p)) == -1._r8) then - f3 = (2.7/(1.0+exp(-0.004*(annsum_npp(p) - 300.0)))) - 0.4 - else - f3 = stem_leaf(ivt(p)) + associate( & + ivt => veg_pp%itype , & ! Input: [integer (:) ] pft vegetation type + + woody => veg_vp%woody , & ! Input: [real(r8) (:) ] binary flag for woody lifeform (1=woody, 0=not woody) + froot_leaf => veg_vp%froot_leaf , & ! Input: [real(r8) (:) ] allocation parameter: new fine root C per new leaf C (gC/gC) + croot_stem => veg_vp%croot_stem , & ! Input: [real(r8) (:) ] allocation parameter: new coarse root C per new stem C (gC/gC) + stem_leaf => veg_vp%stem_leaf , & ! Input: [real(r8) (:) ] allocation parameter: new stem c per new leaf C (gC/gC) + flivewd => veg_vp%flivewd , & ! Input: [real(r8) (:) ] allocation parameter: fraction of new wood that is live (phloem and ray parenchyma) (no units) + leafcn => veg_vp%leafcn , & ! Input: [real(r8) (:) ] leaf C:N (gC/gN) + frootcn => veg_vp%frootcn , & ! Input: [real(r8) (:) ] fine root C:N (gC/gN) + livewdcn => veg_vp%livewdcn , & ! Input: [real(r8) (:) ] live wood (phloem and ray parenchyma) C:N (gC/gN) + deadwdcn => veg_vp%deadwdcn , & ! Input: [real(r8) (:) ] dead wood (xylem and heartwood) C:N (gC/gN) + fcur2 => veg_vp%fcur , & ! Input: [real(r8) (:) ] allocation parameter: fraction of allocation that goes to currently displayed growth, remainder to storage + graincn => veg_vp%graincn , & ! Input: [real(r8) (:) ] grain C:N (gC/gN) + fleafcn => veg_vp%fleafcn , & ! Input: [real(r8) (:) ] leaf c:n during organ fill + ffrootcn => veg_vp%ffrootcn , & ! Input: [real(r8) (:) ] froot c:n during organ fill + fstemcn => veg_vp%fstemcn , & ! Input: [real(r8) (:) ] stem c:n during organ fill + + psnsun => photosyns_vars%psnsun_patch , & ! Input: [real(r8) (:) ] sunlit leaf-level photosynthesis (umol CO2 /m**2/ s) + psnsha => photosyns_vars%psnsha_patch , & ! Input: [real(r8) (:) ] shaded leaf-level photosynthesis (umol CO2 /m**2/ s) + c13_psnsun => photosyns_vars%c13_psnsun_patch , & ! Input: [real(r8) (:) ] sunlit leaf-level photosynthesis (umol CO2 /m**2/ s) + c13_psnsha => photosyns_vars%c13_psnsha_patch , & ! Input: [real(r8) (:) ] shaded leaf-level photosynthesis (umol CO2 /m**2/ s) + c14_psnsun => photosyns_vars%c14_psnsun_patch , & ! Input: [real(r8) (:) ] sunlit leaf-level photosynthesis (umol CO2 /m**2/ s) + c14_psnsha => photosyns_vars%c14_psnsha_patch , & ! Input: [real(r8) (:) ] shaded leaf-level photosynthesis (umol CO2 /m**2/ s) + + laisun => canopystate_vars%laisun_patch , & ! Input: [real(r8) (:) ] sunlit projected leaf area index + laisha => canopystate_vars%laisha_patch , & ! Input: [real(r8) (:) ] shaded projected leaf area index + + hui => crop_vars%gddplant_patch , & ! Input: [real(r8) (:) ] =gdd since planting (gddplant) + leafout => crop_vars%gddtsoi_patch , & ! Input: [real(r8) (:) ] =gdd from top soil layer temperature + + xsmrpool => carbonstate_vars%xsmrpool_patch , & ! Input: [real(r8) (:) ] (gC/m2) temporary photosynthate C pool + leafc => carbonstate_vars%leafc_patch , & ! Input: [real(r8) (:) ] + frootc => carbonstate_vars%frootc_patch , & ! Input: [real(r8) (:) ] + livestemc => carbonstate_vars%livestemc_patch , & ! Input: [real(r8) (:) ] + plant_ndemand_col => nitrogenflux_vars%plant_ndemand_col , & ! Output: [real(r8) (:,:) ] + plant_pdemand_col => phosphorusflux_vars%plant_pdemand_col , & ! Output: [real(r8) (:,:) ] + plant_ndemand_vr_col => nitrogenflux_vars%plant_ndemand_vr_col , & ! Output: [real(r8) (:,:) ] + plant_pdemand_vr_col => phosphorusflux_vars%plant_pdemand_vr_col , & ! Output: [real(r8) (:,:) ] + + gddmaturity => cnstate_vars%gddmaturity_patch , & ! Input: [real(r8) (:) ] gdd needed to harvest + huileaf => cnstate_vars%huileaf_patch , & ! Input: [real(r8) (:) ] heat unit index needed from planting to leaf emergence + huigrain => cnstate_vars%huigrain_patch , & ! Input: [real(r8) (:) ] same to reach vegetative maturity + croplive => cnstate_vars%croplive_patch , & ! Input: [logical (:) ] flag, true if planted, not harvested + peaklai => cnstate_vars%peaklai_patch , & ! Input: [integer (:) ] 1: max allowed lai; 0: not at max + !lgsf => cnstate_vars%lgsf_patch , & ! Input: [real(r8) (:) ] long growing season factor [0-1] + aleafi => cnstate_vars%aleafi_patch , & ! Output: [real(r8) (:) ] saved allocation coefficient from phase 2 + astemi => cnstate_vars%astemi_patch , & ! Output: [real(r8) (:) ] saved allocation coefficient from phase 2 + aleaf => cnstate_vars%aleaf_patch , & ! Output: [real(r8) (:) ] leaf allocation coefficient + astem => cnstate_vars%astem_patch , & ! Output: [real(r8) (:) ] stem allocation coefficient + fpg => cnstate_vars%fpg_col , & ! Output: [real(r8) (:) ] fraction of potential gpp (no units) + fpi => cnstate_vars%fpi_col , & ! Output: [real(r8) (:) ] fraction of potential immobilization (no units) + fpi_vr => cnstate_vars%fpi_vr_col , & ! Output: [real(r8) (:,:) ] fraction of potential immobilization (no units) + + !!! add phosphorus + leafcp => veg_vp%leafcp , & ! Input: [real(r8) (:) ] leaf C:P (gC/gP) + frootcp => veg_vp%frootcp , & ! Input: [real(r8) (:) ] fine root C:P (gC/gP) + livewdcp => veg_vp%livewdcp , & ! Input: [real(r8) (:) ] live wood (phloem and ray parenchyma) C:P (gC/gP) + deadwdcp => veg_vp%deadwdcp , & ! Input: [real(r8) (:) ] dead wood (xylem and heartwood) C:P (gC/gP) + graincp => veg_vp%graincp , & ! Input: [real(r8) (:) ] grain C:P (gC/gP) + fpg_p => cnstate_vars%fpg_p_col , & ! Output: [real(r8) (:) ] fraction of potential gpp (no units) + fpi_p => cnstate_vars%fpi_p_col , & ! Output: [real(r8) (:) ] fraction of potential immobilization (no units) + fpi_p_vr => cnstate_vars%fpi_p_vr_col , & ! Output: [real(r8) (:,:) ] fraction of potential immobilization (no units) + + nfixation_prof => cnstate_vars%nfixation_prof_col , & ! Output: [real(r8) (:,:) ] + grain_flag => cnstate_vars%grain_flag_patch , & ! Output: [real(r8) (:) ] 1: grain fill stage; 0: not + c_allometry => cnstate_vars%c_allometry_patch , & ! Output: [real(r8) (:) ] C allocation index (DIM) + n_allometry => cnstate_vars%n_allometry_patch , & ! Output: [real(r8) (:) ] N allocation index (DIM) + tempsum_potential_gpp => cnstate_vars%tempsum_potential_gpp_patch , & ! Output: [real(r8) (:) ] temporary annual sum of potential GPP + tempmax_retransn => cnstate_vars%tempmax_retransn_patch , & ! Output: [real(r8) (:) ] temporary annual max of retranslocated N pool (gN/m2) + annsum_potential_gpp => cnstate_vars%annsum_potential_gpp_patch , & ! Output: [real(r8) (:) ] annual sum of potential GPP + annmax_retransn => cnstate_vars%annmax_retransn_patch , & ! Output: [real(r8) (:) ] annual max of retranslocated N pool + downreg => cnstate_vars%downreg_patch , & ! Output: [real(r8) (:) ] fractional reduction in GPP due to N limitation (DIM) + + leaf_mr => carbonflux_vars%leaf_mr_patch , & ! Input: [real(r8) (:) ] + froot_mr => carbonflux_vars%froot_mr_patch , & ! Input: [real(r8) (:) ] + livestem_mr => carbonflux_vars%livestem_mr_patch , & ! Input: [real(r8) (:) ] + livecroot_mr => carbonflux_vars%livecroot_mr_patch , & ! Input: [real(r8) (:) ] + grain_mr => carbonflux_vars%grain_mr_patch , & ! Input: [real(r8) (:) ] + annsum_npp => carbonflux_vars%annsum_npp_patch , & ! Input: [real(r8) (:) ] annual sum of NPP, for wood allocation + gpp => carbonflux_vars%gpp_before_downreg_patch , & ! Output: [real(r8) (:) ] GPP flux before downregulation (gC/m2/s) + availc => carbonflux_vars%availc_patch , & ! Output: [real(r8) (:) ] C flux available for allocation (gC/m2/s) + xsmrpool_recover => carbonflux_vars%xsmrpool_recover_patch , & ! Output: [real(r8) (:) ] C flux assigned to recovery of negative cpool (gC/m2/s) + excess_cflux => carbonflux_vars%excess_cflux_patch , & ! Output: [real(r8) (:) ] C flux not allocated due to downregulation (gC/m2/s) + plant_calloc => carbonflux_vars%plant_calloc_patch , & ! Output: [real(r8) (:) ] total allocated C flux (gC/m2/s) + psnsun_to_cpool => carbonflux_vars%psnsun_to_cpool_patch , & ! Output: [real(r8) (:) ] + psnshade_to_cpool => carbonflux_vars%psnshade_to_cpool_patch , & ! Output: [real(r8) (:) ] + + leaf_curmr => carbonflux_vars%leaf_curmr_patch , & + froot_curmr => carbonflux_vars%froot_curmr_patch , & ! Output: [real(r8) (:) ] + livestem_curmr => carbonflux_vars%livestem_curmr_patch , & ! Output: [real(r8) (:) ] + livecroot_curmr => carbonflux_vars%livecroot_curmr_patch , & ! Output: [real(r8) (:) ] + grain_curmr => carbonflux_vars%grain_curmr_patch , & ! Output: [real(r8) (:) ] + leaf_xsmr => carbonflux_vars%leaf_xsmr_patch , & ! Output: [real(r8) (:) ] + froot_xsmr => carbonflux_vars%froot_xsmr_patch , & ! Output: [real(r8) (:) ] + livestem_xsmr => carbonflux_vars%livestem_xsmr_patch , & ! Output: [real(r8) (:) ] + livecroot_xsmr => carbonflux_vars%livecroot_xsmr_patch , & ! Output: [real(r8) (:) ] + grain_xsmr => carbonflux_vars%grain_xsmr_patch , & ! Output: [real(r8) (:) ] + cpool_to_xsmrpool => carbonflux_vars%cpool_to_xsmrpool_patch , & ! Output: [real(r8) (:) ] + cpool_to_leafc => carbonflux_vars%cpool_to_leafc_patch , & ! Output: [real(r8) (:) ] + cpool_to_leafc_storage => carbonflux_vars%cpool_to_leafc_storage_patch , & ! Output: [real(r8) (:) ] + cpool_to_frootc => carbonflux_vars%cpool_to_frootc_patch , & ! Output: [real(r8) (:) ] + cpool_to_frootc_storage => carbonflux_vars%cpool_to_frootc_storage_patch , & ! Output: [real(r8) (:) ] + cpool_to_livestemc => carbonflux_vars%cpool_to_livestemc_patch , & ! Output: [real(r8) (:) ] + cpool_to_livestemc_storage => carbonflux_vars%cpool_to_livestemc_storage_patch , & ! Output: [real(r8) (:) ] + cpool_to_deadstemc => carbonflux_vars%cpool_to_deadstemc_patch , & ! Output: [real(r8) (:) ] + cpool_to_deadstemc_storage => carbonflux_vars%cpool_to_deadstemc_storage_patch , & ! Output: [real(r8) (:) ] + cpool_to_livecrootc => carbonflux_vars%cpool_to_livecrootc_patch , & ! Output: [real(r8) (:) ] + cpool_to_livecrootc_storage => carbonflux_vars%cpool_to_livecrootc_storage_patch , & ! Output: [real(r8) (:) ] + cpool_to_deadcrootc => carbonflux_vars%cpool_to_deadcrootc_patch , & ! Output: [real(r8) (:) ] + cpool_to_deadcrootc_storage => carbonflux_vars%cpool_to_deadcrootc_storage_patch , & ! Output: [real(r8) (:) ] + cpool_to_gresp_storage => carbonflux_vars%cpool_to_gresp_storage_patch , & ! Output: [real(r8) (:) ] allocation to growth respiration storage (gC/m2/s) + cpool_to_grainc => carbonflux_vars%cpool_to_grainc_patch , & ! Output: [real(r8) (:) ] allocation to grain C (gC/m2/s) + cpool_to_grainc_storage => carbonflux_vars%cpool_to_grainc_storage_patch , & ! Output: [real(r8) (:) ] allocation to grain C storage (gC/m2/s) + + sminn_vr => nitrogenstate_vars%sminn_vr_col , & ! Input: [real(r8) (:,:) ] (gN/m3) soil mineral N + retransn => nitrogenstate_vars%retransn_patch , & ! Input: [real(r8) (:) ] (gN/m2) plant pool of retranslocated N + smin_nh4_vr => nitrogenstate_vars%smin_nh4_vr_col , & ! Output: [real(r8) (:,:) ] (gN/m3) soil mineral NH4 + smin_no3_vr => nitrogenstate_vars%smin_no3_vr_col , & ! Output: [real(r8) (:,:) ] (gN/m3) soil mineral NO3 + + plant_ndemand => nitrogenflux_vars%plant_ndemand_patch , & ! Output: [real(r8) (:) ] N flux required to support initial GPP (gN/m2/s) + plant_nalloc => nitrogenflux_vars%plant_nalloc_patch , & ! Output: [real(r8) (:) ] total allocated N flux (gN/m2/s) + avail_retransn => nitrogenflux_vars%avail_retransn_patch , & ! Output: [real(r8) (:) ] N flux available from retranslocation pool (gN/m2/s) + npool_to_grainn => nitrogenflux_vars%npool_to_grainn_patch , & ! Output: [real(r8) (:) ] allocation to grain N (gN/m2/s) + npool_to_grainn_storage => nitrogenflux_vars%npool_to_grainn_storage_patch , & ! Output: [real(r8) (:) ] allocation to grain N storage (gN/m2/s) + retransn_to_npool => nitrogenflux_vars%retransn_to_npool_patch , & ! Output: [real(r8) (:) ] deployment of retranslocated N (gN/m2/s) + sminn_to_npool => nitrogenflux_vars%sminn_to_npool_patch , & ! Output: [real(r8) (:) ] deployment of soil mineral N uptake (gN/m2/s) + npool_to_leafn => nitrogenflux_vars%npool_to_leafn_patch , & ! Output: [real(r8) (:) ] allocation to leaf N (gN/m2/s) + npool_to_leafn_storage => nitrogenflux_vars%npool_to_leafn_storage_patch , & ! Output: [real(r8) (:) ] allocation to leaf N storage (gN/m2/s) + npool_to_frootn => nitrogenflux_vars%npool_to_frootn_patch , & ! Output: [real(r8) (:) ] allocation to fine root N (gN/m2/s) + npool_to_frootn_storage => nitrogenflux_vars%npool_to_frootn_storage_patch , & ! Output: [real(r8) (:) ] allocation to fine root N storage (gN/m2/s) + npool_to_livestemn => nitrogenflux_vars%npool_to_livestemn_patch , & ! Output: [real(r8) (:) ] + npool_to_livestemn_storage => nitrogenflux_vars%npool_to_livestemn_storage_patch , & ! Output: [real(r8) (:) ] + npool_to_deadstemn => nitrogenflux_vars%npool_to_deadstemn_patch , & ! Output: [real(r8) (:) ] + npool_to_deadstemn_storage => nitrogenflux_vars%npool_to_deadstemn_storage_patch , & ! Output: [real(r8) (:) ] + npool_to_livecrootn => nitrogenflux_vars%npool_to_livecrootn_patch , & ! Output: [real(r8) (:) ] + npool_to_livecrootn_storage => nitrogenflux_vars%npool_to_livecrootn_storage_patch , & ! Output: [real(r8) (:) ] + npool_to_deadcrootn => nitrogenflux_vars%npool_to_deadcrootn_patch , & ! Output: [real(r8) (:) ] + npool_to_deadcrootn_storage => nitrogenflux_vars%npool_to_deadcrootn_storage_patch , & ! Output: [real(r8) (:) ] + leafn_to_retransn => nitrogenflux_vars%leafn_to_retransn_patch , & ! Output: [real(r8) (:) ] + frootn_to_retransn => nitrogenflux_vars%frootn_to_retransn_patch , & ! Output: [real(r8) (:) ] + livestemn_to_retransn => nitrogenflux_vars%livestemn_to_retransn_patch , & ! Output: [real(r8) (:) ] + potential_immob => nitrogenflux_vars%potential_immob_col , & ! Output: [real(r8) (:) ] + actual_immob => nitrogenflux_vars%actual_immob_col , & ! Output: [real(r8) (:) ] + sminn_to_denit_excess_vr => nitrogenflux_vars%sminn_to_denit_excess_vr_col , & ! Output: [real(r8) (:,:) ] + pot_f_nit_vr => nitrogenflux_vars%pot_f_nit_vr_col , & ! Output: [real(r8) (:,:) ] (gN/m3/s) potential soil nitrification flux + pot_f_denit_vr => nitrogenflux_vars%pot_f_denit_vr_col , & ! Output: [real(r8) (:,:) ] (gN/m3/s) potential soil denitrification flux + f_nit_vr => nitrogenflux_vars%f_nit_vr_col , & ! Output: [real(r8) (:,:) ] (gN/m3/s) soil nitrification flux + f_denit_vr => nitrogenflux_vars%f_denit_vr_col , & ! Output: [real(r8) (:,:) ] (gN/m3/s) soil denitrification flux + actual_immob_no3_vr => nitrogenflux_vars%actual_immob_no3_vr_col , & ! Output: [real(r8) (:,:) ] + actual_immob_nh4_vr => nitrogenflux_vars%actual_immob_nh4_vr_col , & ! Output: [real(r8) (:,:) ] + n2_n2o_ratio_denit_vr => nitrogenflux_vars%n2_n2o_ratio_denit_vr_col , & ! Output: [real(r8) (:,:) ] ratio of N2 to N2O production by denitrification [gN/gN] + f_n2o_denit_vr => nitrogenflux_vars%f_n2o_denit_vr_col , & ! Output: [real(r8) (:,:) ] flux of N2O from denitrification [gN/m3/s] + f_n2o_nit_vr => nitrogenflux_vars%f_n2o_nit_vr_col , & ! Output: [real(r8) (:,:) ] flux of N2O from nitrification [gN/m3/s] + supplement_to_sminn_vr => nitrogenflux_vars%supplement_to_sminn_vr_col , & ! Output: [real(r8) (:,:) ] + potential_immob_vr => nitrogenflux_vars%potential_immob_vr_col , & ! Output: [real(r8) (:,:) ] + actual_immob_vr => nitrogenflux_vars%actual_immob_vr_col , & ! Output: [real(r8) (:,:) ] + + !!! add phosphorus variables - X. YANG + sminp_vr => phosphorusstate_vars%sminp_vr_col , & ! Input: [real(r8) (:,:) ] (gP/m3) soil mineral P + solutionp_vr => phosphorusstate_vars%solutionp_vr_col , & ! Input: [real(r8) (:,:) ] (gP/m3) soil mineral P + retransp => phosphorusstate_vars%retransp_patch , & ! Input: [real(r8) (:) ] (gP/m2) plant pool of retranslocated P + + plant_pdemand => phosphorusflux_vars%plant_pdemand_patch , & ! Output: [real(r8) (:) ] P flux required to support initial GPP (gP/m2/s) + plant_palloc => phosphorusflux_vars%plant_palloc_patch , & ! Output: [real(r8) (:) ] total allocated P flux (gP/m2/s) + avail_retransp => phosphorusflux_vars%avail_retransp_patch , & ! Output: [real(r8) (:) ] P flux available from retranslocation pool (gP/m2/s) + ppool_to_grainp => phosphorusflux_vars%ppool_to_grainp_patch , & ! Output: [real(r8) (:) ] allocation to grain P (gP/m2/s) + ppool_to_grainp_storage => phosphorusflux_vars%ppool_to_grainp_storage_patch , & ! Output: [real(r8) (:) ] allocation to grain P storage (gP/m2/s) + retransp_to_ppool => phosphorusflux_vars%retransp_to_ppool_patch , & ! Output: [real(r8) (:) ] deployment of retranslocated P (gP/m2/s) + sminp_to_ppool => phosphorusflux_vars%sminp_to_ppool_patch , & ! Output: [real(r8) (:) ] deployment of soil mineral P uptake (gP/m2/s) + ppool_to_leafp => phosphorusflux_vars%ppool_to_leafp_patch , & ! Output: [real(r8) (:) ] allocation to leaf P (gP/m2/s) + ppool_to_leafp_storage => phosphorusflux_vars%ppool_to_leafp_storage_patch , & ! Output: [real(r8) (:) ] allocation to leaf P storage (gP/m2/s) + ppool_to_frootp => phosphorusflux_vars%ppool_to_frootp_patch , & ! Output: [real(r8) (:) ] allocation to fine root P (gP/m2/s) + ppool_to_frootp_storage => phosphorusflux_vars%ppool_to_frootp_storage_patch , & ! Output: [real(r8) (:) ] allocation to fine root P storage (gP/m2/s) + ppool_to_livestemp => phosphorusflux_vars%ppool_to_livestemp_patch , & ! Output: [real(r8) (:) ] + ppool_to_livestemp_storage => phosphorusflux_vars%ppool_to_livestemp_storage_patch , & ! Output: [real(r8) (:) ] + ppool_to_deadstemp => phosphorusflux_vars%ppool_to_deadstemp_patch , & ! Output: [real(r8) (:) ] + ppool_to_deadstemp_storage => phosphorusflux_vars%ppool_to_deadstemp_storage_patch , & ! Output: [real(r8) (:) ] + ppool_to_livecrootp => phosphorusflux_vars%ppool_to_livecrootp_patch , & ! Output: [real(r8) (:) ] + ppool_to_livecrootp_storage => phosphorusflux_vars%ppool_to_livecrootp_storage_patch , & ! Output: [real(r8) (:) ] + ppool_to_deadcrootp => phosphorusflux_vars%ppool_to_deadcrootp_patch , & ! Output: [real(r8) (:) ] + ppool_to_deadcrootp_storage => phosphorusflux_vars%ppool_to_deadcrootp_storage_patch , & ! Output: [real(r8) (:) ] + leafp_to_retransp => phosphorusflux_vars%leafp_to_retransp_patch , & ! Output: [real(r8) (:) ] + frootp_to_retransp => phosphorusflux_vars%frootp_to_retransp_patch , & ! Output: [real(r8) (:) ] + livestemp_to_retransp => phosphorusflux_vars%livestemp_to_retransp_patch , & ! Output: [real(r8) (:) ] + potential_immob_p => phosphorusflux_vars%potential_immob_p_col , & ! Output: [real(r8) (:) ] + actual_immob_p => phosphorusflux_vars%actual_immob_p_col , & ! Output: [real(r8) (:) ] + supplement_to_sminp_vr => phosphorusflux_vars%supplement_to_sminp_vr_col , & ! Output: [real(r8) (:,:) ] + potential_immob_p_vr => phosphorusflux_vars%potential_immob_p_vr_col , & ! Output: [real(r8) (:,:) ] + actual_immob_p_vr => phosphorusflux_vars%actual_immob_p_vr_col , & ! Output: [real(r8) (:,:) ] + p_allometry => cnstate_vars%p_allometry_patch , & ! Output: [real(r8) (:) ] P allocation index (DIM) + tempmax_retransp => cnstate_vars%tempmax_retransp_patch , & ! Output: [real(r8) (:) ] temporary annual max of retranslocated P pool (gP/m2) + annmax_retransp => cnstate_vars%annmax_retransp_patch , & ! Output: [real(r8) (:) ] annual max of retranslocated P pool + + c13cf => c13_carbonflux_vars , & + c14cf => c14_carbonflux_vars , & + + froot_prof => cnstate_vars%froot_prof_patch , & ! fine root vertical profile Zeng, X. 2001. Global vegetation root distribution for land modeling. J. Hydrometeor. 2:525-530 + fpg_nh4_vr => cnstate_vars%fpg_nh4_vr_col , & + fpg_no3_vr => cnstate_vars%fpg_no3_vr_col , & + fpg_vr => cnstate_vars%fpg_vr_col , & + fpg_p_vr => cnstate_vars%fpg_p_vr_col , & + cn_scalar => cnstate_vars%cn_scalar , & + cp_scalar => cnstate_vars%cp_scalar , & + isoilorder => cnstate_vars%isoilorder , & + slatop => veg_vp%slatop , & + t_scalar => carbonflux_vars%t_scalar_col , & + w_scalar => carbonflux_vars%w_scalar_col , & + leafn => nitrogenstate_vars%leafn_patch & + ) + secondp_vr => phosphorusstate_vars%secondp_vr_col + leafp => phosphorusstate_vars%leafp_patch + col_plant_ndemand_vr => nitrogenflux_vars%col_plant_ndemand_vr + col_plant_nh4demand_vr => nitrogenflux_vars%col_plant_nh4demand_vr + col_plant_no3demand_vr => nitrogenflux_vars%col_plant_no3demand_vr + col_plant_pdemand_vr => nitrogenflux_vars%col_plant_pdemand_vr + plant_nh4demand_vr_patch => nitrogenflux_vars%plant_nh4demand_vr_patch + plant_no3demand_vr_patch => nitrogenflux_vars%plant_no3demand_vr_patch + plant_ndemand_vr_patch => nitrogenflux_vars%plant_ndemand_vr_patch + plant_pdemand_vr_patch => phosphorusflux_vars%plant_pdemand_vr_patch + actual_immob_no3 => nitrogenflux_vars%actual_immob_no3_col + actual_immob_nh4 => nitrogenflux_vars%actual_immob_nh4_col + adsorb_to_labilep_vr => phosphorusflux_vars%adsorb_to_labilep_vr + desorb_to_solutionp_vr => phosphorusflux_vars%desorb_to_solutionp_vr + primp_to_labilep_vr_col => phosphorusflux_vars%primp_to_labilep_vr_col + biochem_pmin_vr_col => phosphorusflux_vars%biochem_pmin_vr_col + secondp_to_labilep_vr_col => phosphorusflux_vars%secondp_to_labilep_vr_col + labilep_to_secondp_vr_col => phosphorusflux_vars%labilep_to_secondp_vr_col + labilep_vr => phosphorusstate_vars%labilep_vr_col + benefit_pgpp_pleafc => nitrogenstate_vars%benefit_pgpp_pleafc_patch + + ! for debug + plant_n_uptake_flux => nitrogenflux_vars%plant_n_uptake_flux + plant_p_uptake_flux => phosphorusflux_vars%plant_p_uptake_flux + + ! set time steps + dt = real( get_step_size(), r8 ) + ! set space-and-time parameters from parameter file + dayscrecover = CNAllocParamsInst%dayscrecover + + call get_curr_date(yr, mon, day, sec) + if (spinup_state == 1 .and. yr .gt. nyears_ad_carbon_only) then + call cnallocate_carbon_only_set(.false.) end if - f4 = flivewd(ivt(p)) - g1 = grperc(ivt(p)) - g2 = grpnow(ivt(p)) - cnl = leafcn(ivt(p)) - cnfr = frootcn(ivt(p)) - cnlw = livewdcn(ivt(p)) - cndw = deadwdcn(ivt(p)) - fcur = fcur2(ivt(p)) - - if (ivt(p) >= npcropmin) then ! skip 2 generic crops - if (croplive(p)) then - f1 = aroot(p) / aleaf(p) - f3 = astem(p) / aleaf(p) - f5 = arepr(p) / aleaf(p) - g1 = 0.25_r8 - else - f1 = 0._r8 - f3 = 0._r8 - f5 = 0._r8 - g1 = 0.25_r8 - end if - end if + ! loop over patches to assess the total plant N demand and P demand + do fp=1,num_soilp + p = filter_soilp(fp) + + ! get the time step total gross photosynthesis + ! this is coming from the canopy fluxes code, and is the + ! gpp that is used to control stomatal conductance. + ! For the nitrogen downregulation code, this is assumed + ! to be the potential gpp, and the actual gpp will be + ! reduced due to N limitation. + + ! Convert psn from umol/m2/s -> gC/m2/s + + ! The input psn (psnsun and psnsha) are expressed per unit LAI + ! in the sunlit and shaded canopy, respectively. These need to be + ! scaled by laisun and laisha to get the total gpp for allocation + + ! Note that no associate statement is used for the isotope carbon fluxes below + ! since they are not always allocated AND nag compiler will complain if you try to + ! to have an associate statement with unallocated memory + + psnsun_to_cpool(p) = psnsun(p) * laisun(p) * 12.011e-6_r8 + psnshade_to_cpool(p) = psnsha(p) * laisha(p) * 12.011e-6_r8 - ! increase fcur linearly with ndays_active, until fcur reaches 1.0 at - ! ndays_active = days/year. This prevents the continued storage of C and N. - ! turning off this correction (PET, 12/11/03), instead using bgtr in - ! phenology algorithm. - !fcur = fcur + (1._r8 - fcur)*lgsf(p) - sminn_to_npool(p) = plant_ndemand(p) * fpg(c) - plant_nalloc(p) = sminn_to_npool(p) + retransn_to_npool(p) - - - ! calculate the associated carbon allocation, and the excess - ! carbon flux that must be accounted for through downregulation - plant_calloc(p) = plant_nalloc(p) * (c_allometry(p)/n_allometry(p)) - excess_cflux(p) = availc(p) - plant_calloc(p) - - ! reduce gpp fluxes due to N limitation - if (gpp(p) > 0.0_r8) then - downreg(p) = excess_cflux(p)/gpp(p) - psnsun_to_cpool(p) = psnsun_to_cpool(p) *(1._r8 - downreg(p)) - psnshade_to_cpool(p) = psnshade_to_cpool(p)*(1._r8 - downreg(p)) if ( use_c13 ) then - c13cf%psnsun_to_cpool_patch(p) = c13cf%psnsun_to_cpool_patch(p) *(1._r8 - downreg(p)) - c13cf%psnshade_to_cpool_patch(p) = c13cf%psnshade_to_cpool_patch(p)*(1._r8 - downreg(p)) + c13cf%psnsun_to_cpool_patch(p) = c13_psnsun(p) * laisun(p) * 12.011e-6_r8 + c13cf%psnshade_to_cpool_patch(p) = c13_psnsha(p) * laisha(p) * 12.011e-6_r8 endif if ( use_c14 ) then - c14cf%psnsun_to_cpool_patch(p) = c14cf%psnsun_to_cpool_patch(p) *(1._r8 - downreg(p)) - c14cf%psnshade_to_cpool_patch(p) = c14cf%psnshade_to_cpool_patch(p)*(1._r8 - downreg(p)) + c14cf%psnsun_to_cpool_patch(p) = c14_psnsun(p) * laisun(p) * 12.011e-6_r8 + c14cf%psnshade_to_cpool_patch(p) = c14_psnsha(p) * laisha(p) * 12.011e-6_r8 endif - end if - ! calculate the amount of new leaf C dictated by these allocation - ! decisions, and calculate the daily fluxes of C and N to current - ! growth and storage pools - - ! fcur is the proportion of this day's growth that is displayed now, - ! the remainder going into storage for display next year through the - ! transfer pools - - nlc = plant_calloc(p) / c_allometry(p) - - cpool_to_leafc(p) = nlc * fcur - cpool_to_leafc_storage(p) = nlc * (1._r8 - fcur) - cpool_to_frootc(p) = nlc * f1 * fcur - cpool_to_frootc_storage(p) = nlc * f1 * (1._r8 - fcur) - if (woody(ivt(p)) == 1._r8) then - cpool_to_livestemc(p) = nlc * f3 * f4 * fcur - cpool_to_livestemc_storage(p) = nlc * f3 * f4 * (1._r8 - fcur) - cpool_to_deadstemc(p) = nlc * f3 * (1._r8 - f4) * fcur - cpool_to_deadstemc_storage(p) = nlc * f3 * (1._r8 - f4) * (1._r8 - fcur) - cpool_to_livecrootc(p) = nlc * f2 * f3 * f4 * fcur - cpool_to_livecrootc_storage(p) = nlc * f2 * f3 * f4 * (1._r8 - fcur) - cpool_to_deadcrootc(p) = nlc * f2 * f3 * (1._r8 - f4) * fcur - cpool_to_deadcrootc_storage(p) = nlc * f2 * f3 * (1._r8 - f4) * (1._r8 - fcur) - end if - if (ivt(p) >= npcropmin) then ! skip 2 generic crops - cpool_to_livestemc(p) = nlc * f3 * f4 * fcur - cpool_to_livestemc_storage(p) = nlc * f3 * f4 * (1._r8 - fcur) - cpool_to_deadstemc(p) = nlc * f3 * (1._r8 - f4) * fcur - cpool_to_deadstemc_storage(p) = nlc * f3 * (1._r8 - f4) * (1._r8 - fcur) - cpool_to_livecrootc(p) = nlc * f2 * f3 * f4 * fcur - cpool_to_livecrootc_storage(p) = nlc * f2 * f3 * f4 * (1._r8 - fcur) - cpool_to_deadcrootc(p) = nlc * f2 * f3 * (1._r8 - f4) * fcur - cpool_to_deadcrootc_storage(p) = nlc * f2 * f3 * (1._r8 - f4) * (1._r8 - fcur) - cpool_to_grainc(p) = nlc * f5 * fcur - cpool_to_grainc_storage(p) = nlc * f5 * (1._r8 -fcur) - end if + gpp(p) = psnsun_to_cpool(p) + psnshade_to_cpool(p) - ! corresponding N fluxes - npool_to_leafn(p) = (nlc / cnl) * fcur - npool_to_leafn_storage(p) = (nlc / cnl) * (1._r8 - fcur) - npool_to_frootn(p) = (nlc * f1 / cnfr) * fcur - npool_to_frootn_storage(p) = (nlc * f1 / cnfr) * (1._r8 - fcur) - if (woody(ivt(p)) == 1._r8) then - npool_to_livestemn(p) = (nlc * f3 * f4 / cnlw) * fcur - npool_to_livestemn_storage(p) = (nlc * f3 * f4 / cnlw) * (1._r8 - fcur) - npool_to_deadstemn(p) = (nlc * f3 * (1._r8 - f4) / cndw) * fcur - npool_to_deadstemn_storage(p) = (nlc * f3 * (1._r8 - f4) / cndw) * (1._r8 - fcur) - npool_to_livecrootn(p) = (nlc * f2 * f3 * f4 / cnlw) * fcur - npool_to_livecrootn_storage(p) = (nlc * f2 * f3 * f4 / cnlw) * (1._r8 - fcur) - npool_to_deadcrootn(p) = (nlc * f2 * f3 * (1._r8 - f4) / cndw) * fcur - npool_to_deadcrootn_storage(p) = (nlc * f2 * f3 * (1._r8 - f4) / cndw) * (1._r8 - fcur) - end if - if (ivt(p) >= npcropmin) then ! skip 2 generic crops - cng = graincn(ivt(p)) - npool_to_livestemn(p) = (nlc * f3 * f4 / cnlw) * fcur - npool_to_livestemn_storage(p) = (nlc * f3 * f4 / cnlw) * (1._r8 - fcur) - npool_to_deadstemn(p) = (nlc * f3 * (1._r8 - f4) / cndw) * fcur - npool_to_deadstemn_storage(p) = (nlc * f3 * (1._r8 - f4) / cndw) * (1._r8 - fcur) - npool_to_livecrootn(p) = (nlc * f2 * f3 * f4 / cnlw) * fcur - npool_to_livecrootn_storage(p) = (nlc * f2 * f3 * f4 / cnlw) * (1._r8 - fcur) - npool_to_deadcrootn(p) = (nlc * f2 * f3 * (1._r8 - f4) / cndw) * fcur - npool_to_deadcrootn_storage(p) = (nlc * f2 * f3 * (1._r8 - f4) / cndw) * (1._r8 - fcur) - npool_to_grainn(p) = (nlc * f5 / cng) * fcur - npool_to_grainn_storage(p) = (nlc * f5 / cng) * (1._r8 -fcur) - end if + ! carbon return of leaf C investment + benefit_pgpp_pleafc(p) = max(gpp(p) / max(laisun(p)/slatop(ivt(p)) ,1e-20_r8), 0.0_r8) - ! Calculate the amount of carbon that needs to go into growth - ! respiration storage to satisfy all of the storage growth demands. - ! Allows for the fraction of growth respiration that is released at the - ! time of fixation, versus the remaining fraction that is stored for - ! release at the time of display. Note that all the growth respiration - ! fluxes that get released on a given timestep are calculated in growth_resp(), - ! but that the storage of C for growth resp during display of transferred - ! growth is assigned here. - - gresp_storage = cpool_to_leafc_storage(p) + cpool_to_frootc_storage(p) - if (woody(ivt(p)) == 1._r8) then - gresp_storage = gresp_storage + cpool_to_livestemc_storage(p) - gresp_storage = gresp_storage + cpool_to_deadstemc_storage(p) - gresp_storage = gresp_storage + cpool_to_livecrootc_storage(p) - gresp_storage = gresp_storage + cpool_to_deadcrootc_storage(p) - end if - if (ivt(p) >= npcropmin) then ! skip 2 generic crops - gresp_storage = gresp_storage + cpool_to_livestemc_storage(p) - gresp_storage = gresp_storage + cpool_to_grainc_storage(p) - end if - cpool_to_gresp_storage(p) = gresp_storage * g1 * (1._r8 - g2) + ! get the time step total maintenance respiration + ! These fluxes should already be in gC/m2/s - end do ! end pft loop + mr = leaf_mr(p) + froot_mr(p) + if (woody(ivt(p)) == 1.0_r8) then + mr = mr + livestem_mr(p) + livecroot_mr(p) + else if (ivt(p) >= npcropmin) then + if (croplive(p)) mr = mr + livestem_mr(p) + grain_mr(p) + end if - end associate - end subroutine plantCNAlloc + ! carbon flux available for allocation + availc(p) = gpp(p) - mr + ! new code added for isotope calculations, 7/1/05, PET + ! If mr > gpp, then some mr comes from gpp, the rest comes from + ! cpool (xsmr) + if (mr > 0._r8 .and. availc(p) < 0._r8) then + curmr = gpp(p) + curmr_ratio = curmr / mr + else + curmr_ratio = 1._r8 + end if - !----------------------------------------------------------------------------- - subroutine calc_plant_nutrient_demand(bounds, num_soilc, filter_soilc, num_soilp, filter_soilp,& - photosyns_vars, crop_vars, canopystate_vars, & - cnstate_vars, carbonstate_vars, carbonflux_vars, & - c13_carbonflux_vars, c14_carbonflux_vars, & - nitrogenstate_vars, nitrogenflux_vars, plantsoilnutrientflux_vars ) + leaf_curmr(p) = leaf_mr(p) * curmr_ratio + leaf_xsmr(p) = leaf_mr(p) - leaf_curmr(p) + froot_curmr(p) = froot_mr(p) * curmr_ratio + froot_xsmr(p) = froot_mr(p) - froot_curmr(p) + livestem_curmr(p) = livestem_mr(p) * curmr_ratio + livestem_xsmr(p) = livestem_mr(p) - livestem_curmr(p) + livecroot_curmr(p) = livecroot_mr(p) * curmr_ratio + livecroot_xsmr(p) = livecroot_mr(p) - livecroot_curmr(p) + grain_curmr(p) = grain_mr(p) * curmr_ratio + grain_xsmr(p) = grain_mr(p) - grain_curmr(p) + + ! no allocation when available c is negative + availc(p) = max(availc(p),0.0_r8) + + ! test for an xsmrpool deficit + if (xsmrpool(p) < 0.0_r8) then + ! Running a deficit in the xsmrpool, so the first priority is to let + ! some availc from this timestep accumulate in xsmrpool. + ! Determine rate of recovery for xsmrpool deficit + xsmrpool_recover(p) = -xsmrpool(p)/(dayscrecover*secspday) + if (xsmrpool_recover(p) < availc(p)) then + ! available carbon reduced by amount for xsmrpool recovery + availc(p) = availc(p) - xsmrpool_recover(p) + else + ! all of the available carbon goes to xsmrpool recovery + xsmrpool_recover(p) = availc(p) + availc(p) = 0.0_r8 + end if + cpool_to_xsmrpool(p) = xsmrpool_recover(p) + end if - use CNStateType , only : cnstate_type - use CNCarbonFluxType , only : carbonflux_type - use CNCarbonStateType , only : carbonstate_type - use CNNitrogenFluxType , only : nitrogenflux_type - use CNNitrogenStateType , only : nitrogenstate_type - use CanopyStateType , only : canopystate_type - use CanopyStateType , only : canopystate_type - use PhotosynthesisType , only : photosyns_type - use PlantSoilnutrientFluxType, only : plantsoilnutrientflux_type + f1 = froot_leaf(ivt(p)) + f2 = croot_stem(ivt(p)) - implicit none - ! !ARGUMENTS: - type(bounds_type) , intent(in) :: bounds ! - integer , intent(in) :: num_soilc ! number of soil columns in filter - integer , intent(in) :: filter_soilc(:) ! filter for soil columns - integer , intent(in) :: num_soilp ! number of soil patches in filter - integer , intent(in) :: filter_soilp(:) ! filter for soil patches - type(photosyns_type) , intent(in) :: photosyns_vars ! - type(crop_type) , intent(in) :: crop_vars ! - type(canopystate_type) , intent(in) :: canopystate_vars ! - type(carbonstate_type) , intent(in) :: carbonstate_vars ! - type(cnstate_type) , intent(inout) :: cnstate_vars ! - type(carbonflux_type) , intent(inout) :: carbonflux_vars ! - type(carbonflux_type) , intent(inout) :: c13_carbonflux_vars ! - type(carbonflux_type) , intent(inout) :: c14_carbonflux_vars ! - type(nitrogenstate_type) , intent(inout) :: nitrogenstate_vars ! - type(nitrogenflux_type) , intent(inout) :: nitrogenflux_vars ! - type(plantsoilnutrientflux_type), intent(inout) :: plantsoilnutrientflux_vars ! - - call calc_plant_nitrogen_demand(bounds, num_soilc, filter_soilc, num_soilp, filter_soilp, & - photosyns_vars, canopystate_vars, crop_vars, carbonstate_vars, & - cnstate_vars, carbonflux_vars, nitrogenstate_vars, nitrogenflux_vars, & - c13_carbonflux_vars, c14_carbonflux_vars, & - plantsoilnutrientflux_vars%plant_totn_demand_flx_col(bounds%begc:bounds%endc)) - - !this can used to plug in phosphorus? - end subroutine calc_plant_nutrient_demand - - !----------------------------------------------------------------------------- - subroutine calc_plant_nitrogen_demand(bounds, num_soilc, filter_soilc, num_soilp, filter_soilp, & - photosyns_vars, canopystate_vars, crop_vars, carbonstate_vars, & - cnstate_vars, carbonflux_vars, nitrogenstate_vars, nitrogenflux_vars, & - c13_carbonflux_vars, c14_carbonflux_vars, plant_totn_demand_flx_col) - ! - ! DESCRIPTION - ! compute plant nitrogen demand - ! + ! modified wood allocation to be 2.2 at npp=800 gC/m2/yr, 0.2 at npp=0, + ! constrained so that it does not go lower than 0.2 (under negative annsum_npp) + ! This variable allocation is only for trees. Shrubs have a constant + ! allocation as specified in the pft-physiology file. The value is also used + ! as a trigger here: -1.0 means to use the dynamic allocation (trees). - ! !USES: - use pftvarcon , only : npcropmin, declfact, bfact, aleaff, arootf, astemf - use pftvarcon , only : arooti, fleafi, allconsl, allconss, grperc, grpnow, nsoybean - use clm_varcon , only : secspday - use clm_varctl , only : use_c13, use_c14 - use clm_time_manager , only : get_step_size - use subgridAveMod , only : p2c - implicit none - - ! !ARGUMENTS: - type(bounds_type) , intent(in) :: bounds ! - integer , intent(in) :: num_soilc ! number of soil columns in filter - integer , intent(in) :: filter_soilc(:) ! filter for soil columns - integer , intent(in) :: num_soilp ! number of soil patches in filter - integer , intent(in) :: filter_soilp(:) ! filter for soil patches - type(photosyns_type) , intent(in) :: photosyns_vars ! - type(crop_type) , intent(in) :: crop_vars ! - type(canopystate_type) , intent(in) :: canopystate_vars ! - type(carbonstate_type) , intent(in) :: carbonstate_vars ! - type(cnstate_type) , intent(inout) :: cnstate_vars ! - type(carbonflux_type) , intent(inout) :: carbonflux_vars ! - type(carbonflux_type) , intent(inout) :: c13_carbonflux_vars ! - type(carbonflux_type) , intent(inout) :: c14_carbonflux_vars ! - type(nitrogenstate_type) , intent(inout) :: nitrogenstate_vars ! - type(nitrogenflux_type) , intent(inout) :: nitrogenflux_vars ! - real(r8) , intent(inout) :: plant_totn_demand_flx_col(bounds%begc:bounds%endc) ! - integer :: c,p,l,pi,j ! indices - integer :: fp ! lake filter pft index - integer :: fc ! lake filter column index - real(r8) :: mr ! maintenance respiration (gC/m2/s) - real(r8) :: f1,f2,f3,f4,g1,g2 ! allocation parameters - real(r8) :: cnl,cnfr,cnlw,cndw ! C:N ratios for leaf, fine root, and wood - real(r8) :: curmr, curmr_ratio ! xsmrpool temporary variables - real(r8) :: f5 ! grain allocation parameter - real(r8) :: cng ! C:N ratio for grain (= cnlw for now; slevis) - real(r8) :: fleaf ! fraction allocated to leaf - real(r8) :: t1 ! temporary variable - real(r8) :: dt ! model time step - real(r8) :: dayscrecover ! - - associate( & - ivt => veg_pp%itype , & ! Input: [integer (:) ] pft vegetation type - woody => veg_vp%woody , & ! Input: [real(r8) (:) ] binary flag for woody lifeform (1=woody, 0=not woody) - froot_leaf => veg_vp%froot_leaf , & ! Input: [real(r8) (:) ] allocation parameter: new fine root C per new leaf C (gC/gC) - croot_stem => veg_vp%croot_stem , & ! Input: [real(r8) (:) ] allocation parameter: new coarse root C per new stem C (gC/gC) - stem_leaf => veg_vp%stem_leaf , & ! Input: [real(r8) (:) ] allocation parameter: new stem c per new leaf C (gC/gC) - flivewd => veg_vp%flivewd , & ! Input: [real(r8) (:) ] allocation parameter: fraction of new wood that is live (phloem and ray parenchyma) (no units) - leafcn => veg_vp%leafcn , & ! Input: [real(r8) (:) ] leaf C:N (gC/gN) - frootcn => veg_vp%frootcn , & ! Input: [real(r8) (:) ] fine root C:N (gC/gN) - livewdcn => veg_vp%livewdcn , & ! Input: [real(r8) (:) ] live wood (phloem and ray parenchyma) C:N (gC/gN) - deadwdcn => veg_vp%deadwdcn , & ! Input: [real(r8) (:) ] dead wood (xylem and heartwood) C:N (gC/gN) - graincn => veg_vp%graincn , & ! Input: [real(r8) (:) ] grain C:N (gC/gN) - fleafcn => veg_vp%fleafcn , & ! Input: [real(r8) (:) ] leaf c:n during organ fill - ffrootcn => veg_vp%ffrootcn , & ! Input: [real(r8) (:) ] froot c:n during organ fill - fstemcn => veg_vp%fstemcn , & ! Input: [real(r8) (:) ] stem c:n during organ fill - - psnsun => photosyns_vars%psnsun_patch , & ! Input: [real(r8) (:) ] sunlit leaf-level photosynthesis (umol CO2 /m**2/ s) - psnsha => photosyns_vars%psnsha_patch , & ! Input: [real(r8) (:) ] shaded leaf-level photosynthesis (umol CO2 /m**2/ s) - c13_psnsun => photosyns_vars%c13_psnsun_patch , & ! Input: [real(r8) (:) ] sunlit leaf-level photosynthesis (umol CO2 /m**2/ s) - c13_psnsha => photosyns_vars%c13_psnsha_patch , & ! Input: [real(r8) (:) ] shaded leaf-level photosynthesis (umol CO2 /m**2/ s) - c14_psnsun => photosyns_vars%c14_psnsun_patch , & ! Input: [real(r8) (:) ] sunlit leaf-level photosynthesis (umol CO2 /m**2/ s) - c14_psnsha => photosyns_vars%c14_psnsha_patch , & ! Input: [real(r8) (:) ] shaded leaf-level photosynthesis (umol CO2 /m**2/ s) - - laisun => canopystate_vars%laisun_patch , & ! Input: [real(r8) (:) ] sunlit projected leaf area index - laisha => canopystate_vars%laisha_patch , & ! Input: [real(r8) (:) ] shaded projected leaf area index - - hui => crop_vars%gddplant_patch , & ! Input: [real(r8) (:) ] =gdd since planting (gddplant) - leafout => crop_vars%gddtsoi_patch , & ! Input: [real(r8) (:) ] =gdd from top soil layer temperature - - xsmrpool => carbonstate_vars%xsmrpool_patch , & ! Input: [real(r8) (:) ] (gC/m2) temporary photosynthate C pool - leafc => carbonstate_vars%leafc_patch , & ! Input: [real(r8) (:) ] - frootc => carbonstate_vars%frootc_patch , & ! Input: [real(r8) (:) ] - livestemc => carbonstate_vars%livestemc_patch , & ! Input: [real(r8) (:) ] - - gddmaturity => cnstate_vars%gddmaturity_patch , & ! Input: [real(r8) (:) ] gdd needed to harvest - huileaf => cnstate_vars%huileaf_patch , & ! Input: [real(r8) (:) ] heat unit index needed from planting to leaf emergence - huigrain => cnstate_vars%huigrain_patch , & ! Input: [real(r8) (:) ] same to reach vegetative maturity - croplive => cnstate_vars%croplive_patch , & ! Input: [logical (:) ] flag, true if planted, not harvested - peaklai => cnstate_vars%peaklai_patch , & ! Input: [integer (:) ] 1: max allowed lai; 0: not at max - aleafi => cnstate_vars%aleafi_patch , & ! Output: [real(r8) (:) ] saved allocation coefficient from phase 2 - astemi => cnstate_vars%astemi_patch , & ! Output: [real(r8) (:) ] saved allocation coefficient from phase 2 - aleaf => cnstate_vars%aleaf_patch , & ! Output: [real(r8) (:) ] leaf allocation coefficient - astem => cnstate_vars%astem_patch , & ! Output: [real(r8) (:) ] stem allocation coefficient - grain_flag => cnstate_vars%grain_flag_patch , & ! Output: [real(r8) (:) ] 1: grain fill stage; 0: not - c_allometry => cnstate_vars%c_allometry_patch , & ! Output: [real(r8) (:) ] C allocation index (DIM) - n_allometry => cnstate_vars%n_allometry_patch , & ! Output: [real(r8) (:) ] N allocation index (DIM) - tempsum_potential_gpp => cnstate_vars%tempsum_potential_gpp_patch , & ! Output: [real(r8) (:) ] temporary annual sum of potential GPP - tempmax_retransn => cnstate_vars%tempmax_retransn_patch , & ! Output: [real(r8) (:) ] temporary annual max of retranslocated N pool (gN/m2) - annsum_potential_gpp => cnstate_vars%annsum_potential_gpp_patch , & ! Output: [real(r8) (:) ] annual sum of potential GPP - annmax_retransn => cnstate_vars%annmax_retransn_patch , & ! Output: [real(r8) (:) ] annual max of retranslocated N pool - - leaf_mr => carbonflux_vars%leaf_mr_patch , & ! Input: [real(r8) (:) ] - froot_mr => carbonflux_vars%froot_mr_patch , & ! Input: [real(r8) (:) ] - livestem_mr => carbonflux_vars%livestem_mr_patch , & ! Input: [real(r8) (:) ] - livecroot_mr => carbonflux_vars%livecroot_mr_patch , & ! Input: [real(r8) (:) ] - grain_mr => carbonflux_vars%grain_mr_patch , & ! Input: [real(r8) (:) ] - annsum_npp => carbonflux_vars%annsum_npp_patch , & ! Input: [real(r8) (:) ] annual sum of NPP, for wood allocation - gpp => carbonflux_vars%gpp_before_downreg_patch , & ! Output: [real(r8) (:) ] GPP flux before downregulation (gC/m2/s) - availc => carbonflux_vars%availc_patch , & ! Output: [real(r8) (:) ] C flux available for allocation (gC/m2/s) - xsmrpool_recover => carbonflux_vars%xsmrpool_recover_patch , & ! Output: [real(r8) (:) ] C flux assigned to recovery of negative cpool (gC/m2/s) - psnsun_to_cpool => carbonflux_vars%psnsun_to_cpool_patch , & ! Output: [real(r8) (:) ] - psnshade_to_cpool => carbonflux_vars%psnshade_to_cpool_patch , & ! Output: [real(r8) (:) ] - - leaf_curmr => carbonflux_vars%leaf_curmr_patch , & - froot_curmr => carbonflux_vars%froot_curmr_patch , & ! Output: [real(r8) (:) ] - livestem_curmr => carbonflux_vars%livestem_curmr_patch , & ! Output: [real(r8) (:) ] - livecroot_curmr => carbonflux_vars%livecroot_curmr_patch , & ! Output: [real(r8) (:) ] - grain_curmr => carbonflux_vars%grain_curmr_patch , & ! Output: [real(r8) (:) ] - leaf_xsmr => carbonflux_vars%leaf_xsmr_patch , & ! Output: [real(r8) (:) ] - froot_xsmr => carbonflux_vars%froot_xsmr_patch , & ! Output: [real(r8) (:) ] - livestem_xsmr => carbonflux_vars%livestem_xsmr_patch , & ! Output: [real(r8) (:) ] - livecroot_xsmr => carbonflux_vars%livecroot_xsmr_patch , & ! Output: [real(r8) (:) ] - grain_xsmr => carbonflux_vars%grain_xsmr_patch , & ! Output: [real(r8) (:) ] - cpool_to_xsmrpool => carbonflux_vars%cpool_to_xsmrpool_patch , & ! Output: [real(r8) (:) ] - retransn => nitrogenstate_vars%retransn_patch , & ! Input: [real(r8) (:) ] (gN/m2) plant pool of retranslocated N - plant_ndemand => nitrogenflux_vars%plant_ndemand_patch , & ! Output: [real(r8) (:) ] N flux required to support initial GPP (gN/m2/s) - avail_retransn => nitrogenflux_vars%avail_retransn_patch , & ! Output: [real(r8) (:) ] N flux available from retranslocation pool (gN/m2/s) - retransn_to_npool => nitrogenflux_vars%retransn_to_npool_patch , & ! Output: [real(r8) (:) ] deployment of retranslocated N (gN/m2/s) - leafn_to_retransn => nitrogenflux_vars%leafn_to_retransn_patch , & ! Output: [real(r8) (:) ] - frootn_to_retransn => nitrogenflux_vars%frootn_to_retransn_patch , & ! Output: [real(r8) (:) ] - livestemn_to_retransn => nitrogenflux_vars%livestemn_to_retransn_patch , & ! Output: [real(r8) (:) ] - c13cf => c13_carbonflux_vars, & - c14cf => c14_carbonflux_vars & - ) + if (stem_leaf(ivt(p)) == -1._r8) then + f3 = (2.7/(1.0+exp(-0.004*(annsum_npp(p) - 300.0)))) - 0.4 + else + f3 = stem_leaf(ivt(p)) + end if - ! set time steps - dt = real( get_step_size(), r8 ) + f4 = flivewd(ivt(p)) + g1 = grperc(ivt(p)) + g2 = grpnow(ivt(p)) + cnl = leafcn(ivt(p)) + cnfr = frootcn(ivt(p)) + cnlw = livewdcn(ivt(p)) + cndw = deadwdcn(ivt(p)) + + cpl = leafcp(ivt(p)) + cpfr = frootcp(ivt(p)) + cplw = livewdcp(ivt(p)) + cpdw = deadwdcp(ivt(p)) + + + ! calculate f1 to f5 for prog crops following AgroIBIS subr phenocrop + + f5 = 0._r8 ! continued intializations from above + + if (ivt(p) >= npcropmin) then ! skip 2 generic crops + + if (croplive(p)) then + ! same phases appear in subroutine CropPhenology + + ! Phase 1 completed: + ! ================== + ! if hui is less than the number of gdd needed for filling of grain + ! leaf emergence also has to have taken place for lai changes to occur + ! and carbon assimilation + ! Next phase: leaf emergence to start of leaf decline + + if (leafout(p) >= huileaf(p) .and. hui(p) < huigrain(p)) then + + ! allocation rules for crops based on maturity and linear decrease + ! of amount allocated to roots over course of the growing season + + if (peaklai(p) == 1) then ! lai at maximum allowed + arepr(p) = 0._r8 + aleaf(p) = 1.e-5_r8 + aroot(p) = max(0._r8, min(1._r8, arooti(ivt(p)) - & + (arooti(ivt(p)) - arootf(ivt(p))) * & + min(1._r8, hui(p)/gddmaturity(p)))) + astem(p) = 1._r8 - arepr(p) - aleaf(p) - aroot(p) + else + arepr(p) = 0._r8 + aroot(p) = max(0._r8, min(1._r8, arooti(ivt(p)) - & + (arooti(ivt(p)) - arootf(ivt(p))) * & + min(1._r8, hui(p)/gddmaturity(p)))) + fleaf = fleafi(ivt(p)) * (exp(-bfact(ivt(p))) - & + exp(-bfact(ivt(p))*hui(p)/huigrain(p))) / & + (exp(-bfact(ivt(p)))-1) ! fraction alloc to leaf (from J Norman alloc curve) + aleaf(p) = max(1.e-5_r8, (1._r8 - aroot(p)) * fleaf) + astem(p) = 1._r8 - arepr(p) - aleaf(p) - aroot(p) + end if + + ! AgroIBIS included here an immediate adjustment to aleaf & astem if the + ! predicted lai from the above allocation coefficients exceeded laimx. + ! We have decided to live with lais slightly higher than laimx by + ! enforcing the cap in the following tstep through the peaklai logic above. + + astemi(p) = astem(p) ! save for use by equations after shift + aleafi(p) = aleaf(p) ! to reproductive phenology stage begins + grain_flag(p) = 0._r8 ! setting to 0 while in phase 2 + + ! Phase 2 completed: + ! ================== + ! shift allocation either when enough gdd are accumulated or maximum number + ! of days has elapsed since planting + + else if (hui(p) >= huigrain(p)) then + + aroot(p) = max(0._r8, min(1._r8, arooti(ivt(p)) - & + (arooti(ivt(p)) - arootf(ivt(p))) * min(1._r8, hui(p)/gddmaturity(p)))) + if (astemi(p) > astemf(ivt(p))) then + astem(p) = max(0._r8, max(astemf(ivt(p)), astem(p) * & + (1._r8 - min((hui(p)- & + huigrain(p))/((gddmaturity(p)*declfact(ivt(p)))- & + huigrain(p)),1._r8)**allconss(ivt(p)) ))) + end if + if (aleafi(p) > aleaff(ivt(p))) then + aleaf(p) = max(1.e-5_r8, max(aleaff(ivt(p)), aleaf(p) * & + (1._r8 - min((hui(p)- & + huigrain(p))/((gddmaturity(p)*declfact(ivt(p)))- & + huigrain(p)),1._r8)**allconsl(ivt(p)) ))) + end if + + !Beth's retranslocation of leafn, stemn, rootn to organ + !Filter excess plant N to retransn pool for organ N + !Only do one time then hold grain_flag till onset next season + + ! slevis: Will astem ever = astemf exactly? + ! Beth's response: ...looks like astem can equal astemf under the right circumstances. + !It might be worth a rewrite to capture what I was trying to do, but the retranslocation for + !corn and wheat begins at the beginning of the grain fill stage, but for soybean I was holding it + !until after the leaf and stem decline were complete. Looking at how astem is calculated, once the + !stem decline is near complete, astem should (usually) be set to astemf. The reason for holding off + !on soybean is that the retranslocation scheme begins at the beginning of the grain phase, when the + !leaf and stem are still growing, but declining. Since carbon is still getting allocated and now + !there is more nitrogen available, the nitrogen can be diverted from grain. For corn and wheat + !the impact was probably enough to boost productivity, but for soybean the nitrogen was better off + !fulfilling the grain fill. It seems that if the peak lai is reached for soybean though that this + !would be bypassed altogether, not the intended outcome. I checked several of my output files and + !they all seemed to be going through the retranslocation loop for soybean - good news. + + if (ivt(p) /= nsoybean .or. astem(p) == astemf(ivt(p)) .or. peaklai(p) == 1._r8) then + if (grain_flag(p) == 0._r8) then + t1 = 1 / dt + leafn_to_retransn(p) = t1 * ((leafc(p) / leafcn(ivt(p))) - (leafc(p) / & + fleafcn(ivt(p)))) + livestemn_to_retransn(p) = t1 * ((livestemc(p) / livewdcn(ivt(p))) - (livestemc(p) / & + fstemcn(ivt(p)))) + frootn_to_retransn(p) = 0._r8 + if (ffrootcn(ivt(p)) > 0._r8) then + frootn_to_retransn(p) = t1 * ((frootc(p) / frootcn(ivt(p))) - (frootc(p) / & + ffrootcn(ivt(p)))) + end if + grain_flag(p) = 1._r8 + end if + end if + + arepr(p) = 1._r8 - aroot(p) - astem(p) - aleaf(p) + + else ! pre emergence + aleaf(p) = 1.e-5_r8 ! allocation coefficients should be irrelevant + astem(p) = 0._r8 ! because crops have no live carbon pools; + aroot(p) = 0._r8 ! this applies to this "else" and to the "else" + arepr(p) = 0._r8 ! a few lines down + end if + + f1 = aroot(p) / aleaf(p) + f3 = astem(p) / aleaf(p) + f5 = arepr(p) / aleaf(p) + g1 = 0.25_r8 + + else ! .not croplive + f1 = 0._r8 + f3 = 0._r8 + f5 = 0._r8 + g1 = 0.25_r8 + end if + end if - dayscrecover = CNAllocParamsInst%dayscrecover - ! loop over patches to assess the total plant N demand - do fp=1,num_soilp - p = filter_soilp(fp) + ! based on available C, use constant allometric relationships to + ! determine N requirements + ! determine P requirements -X. YANG - ! get the time step total gross photosynthesis - ! this is coming from the canopy fluxes code, and is the - ! gpp that is used to control stomatal conductance. - ! For the nitrogen downregulation code, this is assumed - ! to be the potential gpp, and the actual gpp will be - ! reduced due to N limitation. + if (woody(ivt(p)) == 1.0_r8) then + c_allometry(p) = (1._r8+g1)*(1._r8+f1+f3*(1._r8+f2)) + n_allometry(p) = 1._r8/cnl + f1/cnfr + (f3*f4*(1._r8+f2))/cnlw + & + (f3*(1._r8-f4)*(1._r8+f2))/cndw + p_allometry(p) = 1._r8/cpl + f1/cpfr + (f3*f4*(1._r8+f2))/cplw + & + (f3*(1._r8-f4)*(1._r8+f2))/cpdw + + else if (ivt(p) >= npcropmin) then ! skip generic crops + cng = graincn(ivt(p)) + cpg = graincp(ivt(p)) + c_allometry(p) = (1._r8+g1)*(1._r8+f1+f5+f3*(1._r8+f2)) + n_allometry(p) = 1._r8/cnl + f1/cnfr + f5/cng + (f3*f4*(1._r8+f2))/cnlw + & + (f3*(1._r8-f4)*(1._r8+f2))/cndw + p_allometry(p) = 1._r8/cpl + f1/cpfr + f5/cpg + (f3*f4*(1._r8+f2))/cplw + & + (f3*(1._r8-f4)*(1._r8+f2))/cpdw - ! Convert psn from umol/m2/s -> gC/m2/s + else + c_allometry(p) = 1._r8+g1+f1+f1*g1 + n_allometry(p) = 1._r8/cnl + f1/cnfr + p_allometry(p) = 1._r8/cpl + f1/cpfr + end if + plant_ndemand(p) = availc(p)*(n_allometry(p)/c_allometry(p)) + plant_pdemand(p) = availc(p)*(p_allometry(p)/c_allometry(p)) - ! The input psn (psnsun and psnsha) are expressed per unit LAI - ! in the sunlit and shaded canopy, respectively. These need to be - ! scaled by laisun and laisha to get the total gpp for allocation + ! retranslocated N deployment depends on seasonal cycle of potential GPP + ! (requires one year run to accumulate demand) - ! Note that no associate statement is used for the isotope carbon fluxes below - ! since they are not always allocated AND nag compiler will complain if you try to - ! to have an associate statement with unallocated memory + tempsum_potential_gpp(p) = tempsum_potential_gpp(p) + gpp(p) - psnsun_to_cpool(p) = psnsun(p) * laisun(p) * 12.011e-6_r8 - psnshade_to_cpool(p) = psnsha(p) * laisha(p) * 12.011e-6_r8 + ! Adding the following line to carry max retransn info to CN Annual Update + tempmax_retransn(p) = max(tempmax_retransn(p),retransn(p)) + tempmax_retransp(p) = max(tempmax_retransp(p),retransp(p)) !! phosphorus - if ( use_c13 ) then - c13cf%psnsun_to_cpool_patch(p) = c13_psnsun(p) * laisun(p) * 12.011e-6_r8 - c13cf%psnshade_to_cpool_patch(p) = c13_psnsha(p) * laisha(p) * 12.011e-6_r8 - endif + ! Beth's code: crops pull from retransn pool only during grain fill; + ! retransn pool has N from leaves, stems, and roots for + ! retranslocation - if ( use_c14 ) then - c14cf%psnsun_to_cpool_patch(p) = c14_psnsun(p) * laisun(p) * 12.011e-6_r8 - c14cf%psnshade_to_cpool_patch(p) = c14_psnsha(p) * laisha(p) * 12.011e-6_r8 - endif + if (ivt(p) >= npcropmin .and. grain_flag(p) == 1._r8) then + avail_retransn(p) = plant_ndemand(p) + avail_retransp(p) = plant_pdemand(p) + else if (ivt(p) < npcropmin .and. annsum_potential_gpp(p) > 0._r8) then + avail_retransn(p) = (annmax_retransn(p)/2._r8)*(gpp(p)/annsum_potential_gpp(p))/dt + avail_retransp(p) = (annmax_retransp(p)/2._r8)*(gpp(p)/annsum_potential_gpp(p))/dt + else + avail_retransn(p) = 0.0_r8 + avail_retransp(p) = 0.0_r8 + end if - gpp(p) = psnsun_to_cpool(p) + psnshade_to_cpool(p) + ! make sure available retrans N doesn't exceed storage + avail_retransn(p) = min(avail_retransn(p), retransn(p)/dt) + avail_retransp(p) = min(avail_retransp(p), retransp(p)/dt) !! phosphorus - ! get the time step total maintenance respiration - ! These fluxes should already be in gC/m2/s + ! modify plant N demand according to the availability of + ! retranslocated N + ! take from retransn pool at most the flux required to meet + ! plant ndemand - mr = leaf_mr(p) + froot_mr(p) - if (woody(ivt(p)) == 1.0_r8) then - mr = mr + livestem_mr(p) + livecroot_mr(p) - else if (ivt(p) >= npcropmin) then - if (croplive(p)) mr = mr + livestem_mr(p) + grain_mr(p) - end if + if (plant_ndemand(p) > avail_retransn(p)) then + retransn_to_npool(p) = avail_retransn(p) + else + retransn_to_npool(p) = plant_ndemand(p) + end if - ! carbon flux available for allocation - availc(p) = gpp(p) - mr - ! new code added for isotope calculations, 7/1/05, PET - ! If mr > gpp, then some mr comes from gpp, the rest comes from - ! cpool (xsmr) - if (mr > 0._r8 .and. availc(p) < 0._r8) then - curmr = gpp(p) - curmr_ratio = curmr / mr - else - curmr_ratio = 1._r8 - end if - leaf_curmr(p) = leaf_mr(p) * curmr_ratio - leaf_xsmr(p) = leaf_mr(p) - leaf_curmr(p) - froot_curmr(p) = froot_mr(p) * curmr_ratio - froot_xsmr(p) = froot_mr(p) - froot_curmr(p) - livestem_curmr(p) = livestem_mr(p) * curmr_ratio - livestem_xsmr(p) = livestem_mr(p) - livestem_curmr(p) - livecroot_curmr(p) = livecroot_mr(p) * curmr_ratio - livecroot_xsmr(p) = livecroot_mr(p) - livecroot_curmr(p) - grain_curmr(p) = grain_mr(p) * curmr_ratio - grain_xsmr(p) = grain_mr(p) - grain_curmr(p) - - ! no allocation when available c is negative - availc(p) = max(availc(p),0.0_r8) - - ! test for an xsmrpool deficit - if (xsmrpool(p) < 0.0_r8) then - ! Running a deficit in the xsmrpool, so the first priority is to let - ! some availc from this timestep accumulate in xsmrpool. - ! Determine rate of recovery for xsmrpool deficit - - xsmrpool_recover(p) = -xsmrpool(p)/(dayscrecover*secspday) - if (xsmrpool_recover(p) < availc(p)) then - ! available carbon reduced by amount for xsmrpool recovery - availc(p) = availc(p) - xsmrpool_recover(p) - else - ! all of the available carbon goes to xsmrpool recovery - xsmrpool_recover(p) = availc(p) - availc(p) = 0.0_r8 - end if - cpool_to_xsmrpool(p) = xsmrpool_recover(p) - end if - - f1 = froot_leaf(ivt(p)) - f2 = croot_stem(ivt(p)) - - ! modified wood allocation to be 2.2 at npp=800 gC/m2/yr, 0.2 at npp=0, - ! constrained so that it does not go lower than 0.2 (under negative annsum_npp) - ! This variable allocation is only for trees. Shrubs have a constant - ! allocation as specified in the pft-physiology file. The value is also used - ! as a trigger here: -1.0 means to use the dynamic allocation (trees). - - if (stem_leaf(ivt(p)) == -1._r8) then - f3 = (2.7/(1.0+exp(-0.004*(annsum_npp(p) - 300.0)))) - 0.4 - else - f3 = stem_leaf(ivt(p)) - end if - - f4 = flivewd(ivt(p)) - g1 = grperc(ivt(p)) - g2 = grpnow(ivt(p)) - cnl = leafcn(ivt(p)) - cnfr = frootcn(ivt(p)) - cnlw = livewdcn(ivt(p)) - cndw = deadwdcn(ivt(p)) - - ! calculate f1 to f5 for prog crops following AgroIBIS subr phenocrop - - f5 = 0._r8 ! continued intializations from above - - if (ivt(p) >= npcropmin) then ! skip 2 generic crops - - if (croplive(p)) then - ! same phases appear in subroutine CropPhenology - - ! Phase 1 completed: - ! ================== - ! if hui is less than the number of gdd needed for filling of grain - ! leaf emergence also has to have taken place for lai changes to occur - ! and carbon assimilation - ! Next phase: leaf emergence to start of leaf decline - - if (leafout(p) >= huileaf(p) .and. hui(p) < huigrain(p)) then - - ! allocation rules for crops based on maturity and linear decrease - ! of amount allocated to roots over course of the growing season - - if (peaklai(p) == 1) then ! lai at maximum allowed - arepr(p) = 0._r8 - aleaf(p) = 1.e-5_r8 - astem(p) = 0._r8 - aroot(p) = 1._r8 - arepr(p) - aleaf(p) - astem(p) + if (plant_pdemand(p) > avail_retransp(p)) then + retransp_to_ppool(p) = avail_retransp(p) + else + retransp_to_ppool(p) = plant_pdemand(p) + end if + + + end do ! end pft loop + + end associate + + end subroutine CNAllocation1_PlantNPDemand +!------------------------------------------------------------------------------ + subroutine calc_plantN_kineticpar(bounds, num_soilc, filter_soilc , & + num_soilp, filter_soilp , & + cnstate_vars , & + carbonstate_vars , & + nitrogenstate_vars , & + phosphorusstate_vars , & + carbonflux_vars , & + PlantMicKinetics_vars ) + ! + !DESCRIPTION + !compute kinetic parameters for nutrient competition + use clm_varpar , only: nlevdecomp !!nlevsoi, + use pftvarcon , only: noveg + implicit none + type(bounds_type), intent(in) :: bounds + integer, intent(in) :: num_soilc + integer, intent(in) :: filter_soilc(:) + integer, intent(in) :: num_soilp + integer, intent(in) :: filter_soilp(:) + type(cnstate_type), intent(in) :: cnstate_vars + type(carbonstate_type), intent(in) :: carbonstate_vars + type(nitrogenstate_type), intent(in) :: nitrogenstate_vars + type(phosphorusstate_type), intent(in):: phosphorusstate_vars + type(carbonflux_type), intent(in) :: carbonflux_vars + type(PlantMicKinetics_type), intent(inout) :: PlantMicKinetics_vars + + real(r8) :: leaf_totc + real(r8) :: leaf_totn + real(r8) :: leaf_totp + integer :: p, c, fc, j + + real(r8), parameter :: cn_stoich_var=0.2_r8 ! variability of CN ratio + real(r8), parameter :: cp_stoich_var=0.4_r8 ! variability of CP ratio + + associate( & + ivt => veg_pp%itype , & ! Input: [integer (:) ] pft vegetation type + + frootcn => veg_vp%frootcn , & ! Input: [real(r8) (:) ] fine root C:N (gC/gN) + leafcn => veg_vp%leafcn , & ! Input: [real(r8) (:) ] leaf C:N (gC/gN) + leafcp => veg_vp%leafcp , & ! Input: [real(r8) (:) ] leaf C:P (gC/gP) + + vmax_plant_nh4 => veg_vp%vmax_plant_nh4 , & + vmax_plant_no3 => veg_vp%vmax_plant_no3 , & + vmax_plant_p => veg_vp%vmax_plant_p , & + decompmicc_patch_vr => veg_vp%decompmicc_patch_vr , & + vmax_minsurf_p_vr => veg_vp%vmax_minsurf_p_vr , & + + +! the following parameter are defined uniformly for all grids + km_decomp_nh4 => veg_vp%km_decomp_nh4 , & + km_decomp_no3 => veg_vp%km_decomp_no3 , & + km_decomp_p => veg_vp%km_decomp_p , & + km_nit => veg_vp%km_nit , & + km_den => veg_vp%km_den , & + + km_plant_nh4 => veg_vp%km_plant_nh4 , & + km_plant_no3 => veg_vp%km_plant_no3 , & + km_plant_p => veg_vp%km_plant_p , & +! the following parameter is defined based on soil order + km_minsurf_p_vr => veg_vp%km_minsurf_p_vr , & + + plant_nh4_vmax_vr_patch => PlantMicKinetics_vars%plant_nh4_vmax_vr_patch , & ! Output: [real(r8) (:,:) ] vmax for nh4 uptake + plant_no3_vmax_vr_patch => PlantMicKinetics_vars%plant_no3_vmax_vr_patch , & ! Output: [real(r8) (:,:) ] vmax for nh4 uptake + plant_p_vmax_vr_patch => PlantMicKinetics_vars%plant_p_vmax_vr_patch , & ! Output: [real(r8) (:,:) ] vmax for nh4 uptake + plant_nh4_km_vr_patch => PlantMicKinetics_vars%plant_nh4_km_vr_patch , & ! + plant_no3_km_vr_patch => PlantMicKinetics_vars%plant_no3_km_vr_patch , & ! + plant_p_km_vr_patch => PlantMicKinetics_vars%plant_p_km_vr_patch , & ! + vmax_minsurf_p_vr_col => PlantMicKinetics_vars%vmax_minsurf_p_vr_col , & ! + km_minsurf_p_vr_col => PlantMicKinetics_vars%km_minsurf_p_vr_col , & + km_den_no3_vr_col => PlantMicKinetics_vars%km_den_no3_vr_col , & + km_nit_nh4_vr_col => PlantMicKinetics_vars%km_nit_nh4_vr_col , & + km_decomp_p_vr_col => PlantMicKinetics_vars%km_decomp_p_vr_col , & + km_decomp_nh4_vr_col => PlantMicKinetics_vars%km_decomp_nh4_vr_col , & + km_decomp_no3_vr_col => PlantMicKinetics_vars%km_decomp_no3_vr_col , & + plant_eff_ncompet_b => PlantMicKinetics_vars%plant_eff_ncompet_b_vr_patch , & + plant_eff_pcompet_b => PlantMicKinetics_vars%plant_eff_pcompet_b_vr_patch , & + decomp_eff_ncompet_b => PlantMicKinetics_vars%decomp_eff_ncompet_b_vr_col, & + decomp_eff_pcompet_b => PlantMicKinetics_vars%decomp_eff_pcompet_b_vr_col, & + den_eff_ncompet_b => PlantMicKinetics_vars%den_eff_ncompet_b_vr_col, & + nit_eff_ncompet_b => PlantMicKinetics_vars%nit_eff_ncompet_b_vr_col, & + minsurf_p_compet => PlantMicKinetics_vars%minsurf_p_compet_vr_col, & + minsurf_nh4_compet => PlantMicKinetics_vars%minsurf_nh4_compet_vr_col, & + isoilorder => cnstate_vars%isoilorder , & + cn_scalar => cnstate_vars%cn_scalar , & + cp_scalar => cnstate_vars%cp_scalar , & + froot_prof => cnstate_vars%froot_prof_patch , & ! fine root vertical profile Zeng, X. 2001. Global vegetation root distribution for land modeling. J. Hydrometeor. 2:525-530 + frootc => carbonstate_vars%frootc_patch , & ! Input: [real(r8) (:) ] + leafc => carbonstate_vars%leafc_patch , & ! Input: [real(r8) (:) ] + leafc_storage => carbonstate_vars%leafc_storage_patch , & + leafc_xfer => carbonstate_vars%leafc_xfer_patch , & + t_scalar => carbonflux_vars%t_scalar_col , & + leafn => nitrogenstate_vars%leafn_patch , & + leafn_storage => nitrogenstate_vars%leafn_storage_patch , & + leafn_xfer => nitrogenstate_vars%leafn_xfer_patch , & + leafp => phosphorusstate_vars%leafp_patch , & + leafp_storage => phosphorusstate_vars%leafp_storage_patch , & + leafp_xfer => phosphorusstate_vars%leafp_xfer_patch & + ) + + do j = 1, nlevdecomp + do fc=1,num_soilc + c = filter_soilc(fc) + vmax_minsurf_p_vr_col(c,j) = vmax_minsurf_p_vr(isoilorder(c),j) + km_minsurf_p_vr_col(c,j) = km_minsurf_p_vr(isoilorder(c),j) + + !the following is temporary set using alm, in the future, it will be + !set through the betr_alm interface + km_den_no3_vr_col(c,j) = km_den + km_nit_nh4_vr_col(c,j) = km_nit + km_decomp_p_vr_col(c,j) = km_decomp_p + km_decomp_no3_vr_col(c,j) = km_decomp_no3 + km_decomp_nh4_vr_col(c,j) = km_decomp_nh4 + decomp_eff_ncompet_b(c,j) = 0._r8 + decomp_eff_pcompet_b(c,j) = 0._r8 + do p = col_pp%pfti(c), col_pp%pftf(c) + if (veg_pp%active(p).and. (veg_pp%itype(p) .ne. noveg)) then + ! scaling factor based on CN ratio flexibility + leaf_totc=leafc(p) + leafc_storage(p) + leafc_xfer(p) + leaf_totn=leafn(p) + leafn_storage(p) + leafn_xfer(p) + leaf_totp=leafp(p) + leafp_storage(p) + leafp_xfer(p) + cn_scalar(p) = min(max((leaf_totc/max(leaf_totn, 1e-20_r8) - leafcn(ivt(p))*(1- cn_stoich_var)) / & + (leafcn(ivt(p)) - leafcn(ivt(p))*(1- cn_stoich_var)),0.0_r8),1.0_r8) + + cp_scalar(p) = min(max((leaf_totc/max(leaf_totp, 1e-20_r8) - leafcp(ivt(p))*(1- cp_stoich_var)) / & + (leafcp(ivt(p)) - leafcp(ivt(p))*(1- cp_stoich_var)),0.0_r8),1.0_r8) + + plant_nh4_vmax_vr_patch(p,j) = vmax_plant_nh4(ivt(p))* frootc(p) * froot_prof(p,j) * & + cn_scalar(p) * t_scalar(c,j) + plant_no3_vmax_vr_patch(p,j) = vmax_plant_no3(ivt(p)) * frootc(p) * froot_prof(p,j) * & + cn_scalar(p) * t_scalar(c,j) + plant_p_vmax_vr_patch(p,j) = vmax_plant_p(ivt(p)) * frootc(p) * froot_prof(p,j) * & + cp_scalar(p) * t_scalar(c,j) + + plant_nh4_km_vr_patch(p,j) = km_plant_nh4(ivt(p)) + plant_no3_km_vr_patch(p,j) = km_plant_no3(ivt(p)) + plant_p_km_vr_patch(p,j) = km_plant_p(ivt(p)) + + plant_eff_ncompet_b(p,j) = e_plant_scalar*frootc(p)*froot_prof(p,j) * veg_pp%wtcol(p) + plant_eff_pcompet_b(p,j) = e_plant_scalar*frootc(p)*froot_prof(p,j) * veg_pp%wtcol(p) + + !effective n competing decomposers + decomp_eff_ncompet_b(c,j) = decomp_eff_ncompet_b(c,j) + & + e_decomp_scalar*decompmicc_patch_vr(ivt(p),j)*veg_pp%wtcol(p) + !effective p competing decomposers + decomp_eff_pcompet_b(c,j) = decomp_eff_pcompet_b(c,j) + & + e_decomp_scalar*decompmicc_patch_vr(ivt(p),j)*veg_pp%wtcol(p) else - arepr(p) = 0._r8 - aroot(p) = max(0._r8, min(1._r8, arooti(ivt(p)) - & - (arooti(ivt(p)) - arootf(ivt(p))) * & - min(1._r8, hui(p)/gddmaturity(p)))) - fleaf = fleafi(ivt(p)) * (exp(-bfact(ivt(p))) - & - exp(-bfact(ivt(p))*hui(p)/huigrain(p))) / & - (exp(-bfact(ivt(p)))-1) ! fraction alloc to leaf (from J Norman alloc curve) - aleaf(p) = max(1.e-5_r8, (1._r8 - aroot(p)) * fleaf) - astem(p) = 1._r8 - arepr(p) - aleaf(p) - aroot(p) + cn_scalar(p) = 1.0_r8 end if + !effective p competing mineral surfaces, this needs update as a function of soil texutre, anion exchange capacity, pH?. + minsurf_p_compet(c,j) = 0._r8 + minsurf_nh4_compet(c,j) = minsurf_p_compet(c,j) + !lines below are a crude approximation + den_eff_ncompet_b(c,j) = decomp_eff_ncompet_b(c,j) + nit_eff_ncompet_b(c,j) = decomp_eff_ncompet_b(c,j) + end do + enddo + end do + end associate + end subroutine calc_plantN_kineticpar + +!!------------------------------------------------------------------------------------------------- + subroutine CNAllocation3_PlantCNPAlloc (bounds , & + num_soilc, filter_soilc, num_soilp, filter_soilp , & + canopystate_vars , & + cnstate_vars, carbonstate_vars, carbonflux_vars , & + c13_carbonflux_vars, c14_carbonflux_vars , & + nitrogenstate_vars, nitrogenflux_vars , & + phosphorusstate_vars, phosphorusflux_vars) + !! PHASE-3 of CNAllocation: start new pft loop to distribute the available N/P between the + ! competing patches on the basis of relative demand, and allocate C/N/P to new growth and storage + + ! !USES: + use shr_sys_mod , only: shr_sys_flush + use clm_varctl , only: iulog,cnallocate_carbon_only,cnallocate_carbonnitrogen_only,& + cnallocate_carbonphosphorus_only +! use pftvarcon , only: npcropmin, declfact, bfact, aleaff, arootf, astemf +! use pftvarcon , only: arooti, fleafi, allconsl, allconss, grperc, grpnow, nsoybean + use pftvarcon , only: noveg + use pftvarcon , only: npcropmin, grperc, grpnow + use clm_varpar , only: nlevdecomp !!nlevsoi, + use clm_varcon , only: nitrif_n2o_loss_frac, secspday +! use landunit_varcon , only: istsoil, istcrop +! use clm_time_manager , only: get_step_size + ! + ! !ARGUMENTS: + type(bounds_type) , intent(in) :: bounds + integer , intent(in) :: num_soilc ! number of soil columns in filter + integer , intent(in) :: filter_soilc(:) ! filter for soil columns + integer , intent(in) :: num_soilp ! number of soil patches in filter + integer , intent(in) :: filter_soilp(:) ! filter for soil patches +! type(photosyns_type) , intent(in) :: photosyns_vars +! type(crop_type) , intent(in) :: crop_vars + type(canopystate_type) , intent(in) :: canopystate_vars + type(cnstate_type) , intent(inout) :: cnstate_vars + type(carbonstate_type) , intent(in) :: carbonstate_vars + type(carbonflux_type) , intent(inout) :: carbonflux_vars + type(carbonflux_type) , intent(inout) :: c13_carbonflux_vars + type(carbonflux_type) , intent(inout) :: c14_carbonflux_vars + type(nitrogenstate_type) , intent(inout) :: nitrogenstate_vars + type(nitrogenflux_type) , intent(inout) :: nitrogenflux_vars +! !! add phosphorus -X.YANG + type(phosphorusstate_type) , intent(inout) :: phosphorusstate_vars + type(phosphorusflux_type) , intent(inout) :: phosphorusflux_vars + ! + ! !LOCAL VARIABLES: + ! + integer :: c,p,j !!l,pi, !indices + integer :: fp !lake filter pft index + integer :: fc !lake filter column index + real(r8):: mr !maintenance respiration (gC/m2/s) + real(r8):: f1,f2,f3,f4,f5,g1,g2 !allocation parameters + real(r8):: cnl,cnfr,cnlw,cndw !C:N ratios for leaf, fine root, and wood + real(r8):: fcur !fraction of current psn displayed as growth + real(r8):: gresp_storage !temporary variable for growth resp to storage + real(r8):: nlc !temporary variable for total new leaf carbon allocation + real(r8):: nuptake_prof(bounds%begc:bounds%endc, 1:nlevdecomp) + real(r8) cng !C:N ratio for grain (= cnlw for now; slevis) + + !! Local P variables + real(r8):: rc_npool, rc, r !Factors for nitrogen pool + real(r8):: cpl,cpfr,cplw,cpdw,cpg !C:N ratios for leaf, fine root, and wood + real(r8):: puptake_prof(bounds%begc:bounds%endc, 1:nlevdecomp) + + !real(r8) :: allocation_leaf(bounds%begp : bounds%endp) ! fraction of NPP allocated into leaf + !real(r8) :: allocation_stem(bounds%begp : bounds%endp) ! fraction of NPP allocated into stem + !real(r8) :: allocation_froot(bounds%begp : bounds%endp) ! fraction of NPP allocated into froot + + real(r8):: N_lim_factor(bounds%begp : bounds%endp) ! N stress factor that impact dynamic C allocation + real(r8):: P_lim_factor(bounds%begp : bounds%endp) ! P stress factor that impact dynamic C allocation + real(r8):: W_lim_factor(bounds%begp : bounds%endp) ! water stress factor that impact dynamic C allocation + real(r8):: nlc_adjust_high ! adjustment of C allocation to non-structural pools due to CNP imbalance + real(r8):: cn_stoich_var=0.2_r8 ! variability of CN ratio + real(r8):: cp_stoich_var=0.4_r8 ! variability of CP ratio + real(r8):: curmr, curmr_ratio !xsmrpool temporary variables + real(r8), parameter :: taup = 3600._r8 !turnover of the abstract plant p storage + real(r8), parameter :: taun = 3600._r8 !turnover of the abstract plant n storage + real(r8):: xsmr_ratio ! ratio of mr comes from non-structue carobn hydrate pool + !----------------------------------------------------------------------- + + associate( & + ivt => veg_pp%itype , & ! Input: [integer (:) ] pft vegetation type +! + woody => veg_vp%woody , & ! Input: [real(r8) (:) ] binary flag for woody lifeform (1=woody, 0=not woody) + froot_leaf => veg_vp%froot_leaf , & ! Input: [real(r8) (:) ] allocation parameter: new fine root C per new leaf C (gC/gC) + croot_stem => veg_vp%croot_stem , & ! Input: [real(r8) (:) ] allocation parameter: new coarse root C per new stem C (gC/gC) + stem_leaf => veg_vp%stem_leaf , & ! Input: [real(r8) (:) ] allocation parameter: new stem c per new leaf C (gC/gC) + flivewd => veg_vp%flivewd , & ! Input: [real(r8) (:) ] allocation parameter: fraction of new wood that is live (phloem and ray parenchyma) (no units) + leafcn => veg_vp%leafcn , & ! Input: [real(r8) (:) ] leaf C:N (gC/gN) + frootcn => veg_vp%frootcn , & ! Input: [real(r8) (:) ] fine root C:N (gC/gN) + livewdcn => veg_vp%livewdcn , & ! Input: [real(r8) (:) ] live wood (phloem and ray parenchyma) C:N (gC/gN) + deadwdcn => veg_vp%deadwdcn , & ! Input: [real(r8) (:) ] dead wood (xylem and heartwood) C:N (gC/gN) + fcur2 => veg_vp%fcur , & ! Input: [real(r8) (:) ] allocation parameter: fraction of allocation that goes to currently displayed growth, remainder to storage + graincn => veg_vp%graincn , & ! Input: [real(r8) (:) ] grain C:N (gC/gN) + + croplive => cnstate_vars%croplive_patch , & ! Input: [logical (:) ] flag, true if planted, not harvested + aleaf => cnstate_vars%aleaf_patch , & ! Output: [real(r8) (:) ] leaf allocation coefficient + astem => cnstate_vars%astem_patch , & ! Output: [real(r8) (:) ] stem allocation coefficient + fpg => cnstate_vars%fpg_col , & ! Output: [real(r8) (:) ] fraction of potential gpp (no units) + + !!! add phosphorus + leafcp => veg_vp%leafcp , & ! Input: [real(r8) (:) ] leaf C:P (gC/gP) + frootcp => veg_vp%frootcp , & ! Input: [real(r8) (:) ] fine root C:P (gC/gP) + livewdcp => veg_vp%livewdcp , & ! Input: [real(r8) (:) ] live wood (phloem and ray parenchyma) C:P (gC/gP) + deadwdcp => veg_vp%deadwdcp , & ! Input: [real(r8) (:) ] dead wood (xylem and heartwood) C:P (gC/gP) + graincp => veg_vp%graincp , & ! Input: [real(r8) (:) ] grain C:P (gC/gP) + fpg_p => cnstate_vars%fpg_p_col , & ! Output: [real(r8) (:) ] fraction of potential gpp (no units) + + c_allometry => cnstate_vars%c_allometry_patch , & ! Output: [real(r8) (:) ] C allocation index (DIM) + n_allometry => cnstate_vars%n_allometry_patch , & ! Output: [real(r8) (:) ] N allocation index (DIM) + downreg => cnstate_vars%downreg_patch , & ! Output: [real(r8) (:) ] fractional reduction in GPP due to N limitation (DIM) + + annsum_npp => carbonflux_vars%annsum_npp_patch , & ! Input: [real(r8) (:) ] annual sum of NPP, for wood allocation + gpp => carbonflux_vars%gpp_before_downreg_patch , & ! Output: [real(r8) (:) ] GPP flux before downregulation (gC/m2/s) + availc => carbonflux_vars%availc_patch , & ! Output: [real(r8) (:) ] C flux available for allocation (gC/m2/s) + excess_cflux => carbonflux_vars%excess_cflux_patch , & ! Output: [real(r8) (:) ] C flux not allocated due to downregulation (gC/m2/s) + plant_calloc => carbonflux_vars%plant_calloc_patch , & ! Output: [real(r8) (:) ] total allocated C flux (gC/m2/s) + psnsun_to_cpool => carbonflux_vars%psnsun_to_cpool_patch , & ! Output: [real(r8) (:) ] + psnshade_to_cpool => carbonflux_vars%psnshade_to_cpool_patch , & ! Output: [real(r8) (:) ] + + cpool_to_leafc => carbonflux_vars%cpool_to_leafc_patch , & ! Output: [real(r8) (:) ] + cpool_to_leafc_storage => carbonflux_vars%cpool_to_leafc_storage_patch , & ! Output: [real(r8) (:) ] + cpool_to_frootc => carbonflux_vars%cpool_to_frootc_patch , & ! Output: [real(r8) (:) ] + cpool_to_frootc_storage => carbonflux_vars%cpool_to_frootc_storage_patch , & ! Output: [real(r8) (:) ] + cpool_to_livestemc => carbonflux_vars%cpool_to_livestemc_patch , & ! Output: [real(r8) (:) ] + cpool_to_livestemc_storage => carbonflux_vars%cpool_to_livestemc_storage_patch , & ! Output: [real(r8) (:) ] + cpool_to_deadstemc => carbonflux_vars%cpool_to_deadstemc_patch , & ! Output: [real(r8) (:) ] + cpool_to_deadstemc_storage => carbonflux_vars%cpool_to_deadstemc_storage_patch , & ! Output: [real(r8) (:) ] + cpool_to_livecrootc => carbonflux_vars%cpool_to_livecrootc_patch , & ! Output: [real(r8) (:) ] + cpool_to_livecrootc_storage => carbonflux_vars%cpool_to_livecrootc_storage_patch , & ! Output: [real(r8) (:) ] + cpool_to_deadcrootc => carbonflux_vars%cpool_to_deadcrootc_patch , & ! Output: [real(r8) (:) ] + cpool_to_deadcrootc_storage => carbonflux_vars%cpool_to_deadcrootc_storage_patch , & ! Output: [real(r8) (:) ] + cpool_to_gresp_storage => carbonflux_vars%cpool_to_gresp_storage_patch , & ! Output: [real(r8) (:) ] allocation to growth respiration storage (gC/m2/s) + cpool_to_grainc => carbonflux_vars%cpool_to_grainc_patch , & ! Output: [real(r8) (:) ] allocation to grain C (gC/m2/s) + cpool_to_grainc_storage => carbonflux_vars%cpool_to_grainc_storage_patch , & ! Output: [real(r8) (:) ] allocation to grain C storage (gC/m2/s) + + npool => nitrogenstate_vars%npool_patch , & ! Input: [real(r8) (:) ] (gN/m3) plant N pool storage + plant_n_buffer_patch => nitrogenstate_vars%plant_n_buffer_patch , & ! Inout: [real(r8) (:) ] gN/m2 + + plant_ndemand => nitrogenflux_vars%plant_ndemand_patch , & ! Output: [real(r8) (:) ] N flux required to support initial GPP (gN/m2/s) + plant_nalloc => nitrogenflux_vars%plant_nalloc_patch , & ! Output: [real(r8) (:) ] total allocated N flux (gN/m2/s) + npool_to_grainn => nitrogenflux_vars%npool_to_grainn_patch , & ! Output: [real(r8) (:) ] allocation to grain N (gN/m2/s) + npool_to_grainn_storage => nitrogenflux_vars%npool_to_grainn_storage_patch , & ! Output: [real(r8) (:) ] allocation to grain N storage (gN/m2/s) + retransn_to_npool => nitrogenflux_vars%retransn_to_npool_patch , & ! Output: [real(r8) (:) ] deployment of retranslocated N (gN/m2/s) + sminn_to_npool => nitrogenflux_vars%sminn_to_npool_patch , & ! Output: [real(r8) (:) ] deployment of soil mineral N uptake (gN/m2/s) + npool_to_leafn => nitrogenflux_vars%npool_to_leafn_patch , & ! Output: [real(r8) (:) ] allocation to leaf N (gN/m2/s) + npool_to_leafn_storage => nitrogenflux_vars%npool_to_leafn_storage_patch , & ! Output: [real(r8) (:) ] allocation to leaf N storage (gN/m2/s) + npool_to_frootn => nitrogenflux_vars%npool_to_frootn_patch , & ! Output: [real(r8) (:) ] allocation to fine root N (gN/m2/s) + npool_to_frootn_storage => nitrogenflux_vars%npool_to_frootn_storage_patch , & ! Output: [real(r8) (:) ] allocation to fine root N storage (gN/m2/s) + npool_to_livestemn => nitrogenflux_vars%npool_to_livestemn_patch , & ! Output: [real(r8) (:) ] + npool_to_livestemn_storage => nitrogenflux_vars%npool_to_livestemn_storage_patch , & ! Output: [real(r8) (:) ] + npool_to_deadstemn => nitrogenflux_vars%npool_to_deadstemn_patch , & ! Output: [real(r8) (:) ] + npool_to_deadstemn_storage => nitrogenflux_vars%npool_to_deadstemn_storage_patch , & ! Output: [real(r8) (:) ] + npool_to_livecrootn => nitrogenflux_vars%npool_to_livecrootn_patch , & ! Output: [real(r8) (:) ] + npool_to_livecrootn_storage => nitrogenflux_vars%npool_to_livecrootn_storage_patch , & ! Output: [real(r8) (:) ] + npool_to_deadcrootn => nitrogenflux_vars%npool_to_deadcrootn_patch , & ! Output: [real(r8) (:) ] + npool_to_deadcrootn_storage => nitrogenflux_vars%npool_to_deadcrootn_storage_patch , & ! Output: [real(r8) (:) ] + + !!! add phosphorus variables - X. YANG + plant_pdemand => phosphorusflux_vars%plant_pdemand_patch , & ! Output: [real(r8) (:) ] P flux required to support initial GPP (gP/m2/s) + plant_palloc => phosphorusflux_vars%plant_palloc_patch , & ! Output: [real(r8) (:) ] total allocated P flux (gP/m2/s) + ppool_to_grainp => phosphorusflux_vars%ppool_to_grainp_patch , & ! Output: [real(r8) (:) ] allocation to grain P (gP/m2/s) + ppool_to_grainp_storage => phosphorusflux_vars%ppool_to_grainp_storage_patch , & ! Output: [real(r8) (:) ] allocation to grain P storage (gP/m2/s) + retransp_to_ppool => phosphorusflux_vars%retransp_to_ppool_patch , & ! Output: [real(r8) (:) ] deployment of retranslocated P (gP/m2/s) + sminp_to_ppool => phosphorusflux_vars%sminp_to_ppool_patch , & ! Output: [real(r8) (:) ] deployment of soil mineral P uptake (gP/m2/s) + ppool_to_leafp => phosphorusflux_vars%ppool_to_leafp_patch , & ! Output: [real(r8) (:) ] allocation to leaf P (gP/m2/s) + ppool_to_leafp_storage => phosphorusflux_vars%ppool_to_leafp_storage_patch , & ! Output: [real(r8) (:) ] allocation to leaf P storage (gP/m2/s) + ppool_to_frootp => phosphorusflux_vars%ppool_to_frootp_patch , & ! Output: [real(r8) (:) ] allocation to fine root P (gP/m2/s) + ppool_to_frootp_storage => phosphorusflux_vars%ppool_to_frootp_storage_patch , & ! Output: [real(r8) (:) ] allocation to fine root P storage (gP/m2/s) + ppool_to_livestemp => phosphorusflux_vars%ppool_to_livestemp_patch , & ! Output: [real(r8) (:) ] + ppool_to_livestemp_storage => phosphorusflux_vars%ppool_to_livestemp_storage_patch , & ! Output: [real(r8) (:) ] + ppool_to_deadstemp => phosphorusflux_vars%ppool_to_deadstemp_patch , & ! Output: [real(r8) (:) ] + ppool_to_deadstemp_storage => phosphorusflux_vars%ppool_to_deadstemp_storage_patch , & ! Output: [real(r8) (:) ] + ppool_to_livecrootp => phosphorusflux_vars%ppool_to_livecrootp_patch , & ! Output: [real(r8) (:) ] + ppool_to_livecrootp_storage => phosphorusflux_vars%ppool_to_livecrootp_storage_patch , & ! Output: [real(r8) (:) ] + ppool_to_deadcrootp => phosphorusflux_vars%ppool_to_deadcrootp_patch , & ! Output: [real(r8) (:) ] + ppool_to_deadcrootp_storage => phosphorusflux_vars%ppool_to_deadcrootp_storage_patch , & ! Output: [real(r8) (:) ] + p_allometry => cnstate_vars%p_allometry_patch , & ! Output: [real(r8) (:) ] P allocation index (DIM) + + avail_retransn => nitrogenflux_vars%avail_retransn_patch , & ! Output: [real(r8) (:) ] N flux available from retranslocation pool (gN/m2/s) + avail_retransp => phosphorusflux_vars%avail_retransp_patch , & ! Output: [real(r8) (:) ] P flux available from retranslocation pool (gP/m2/s) + retransn => nitrogenstate_vars%retransn_patch , & + retransp => phosphorusstate_vars%retransp_patch , & + plant_p_buffer_patch => phosphorusstate_vars%plant_p_buffer_patch , & ! Inout: [real(r8) (:) ] gN/m2 + + laisun => canopystate_vars%laisun_patch , & ! Input: [real(r8) (:) ] sunlit projected leaf area index + laisha => canopystate_vars%laisha_patch , & ! Input: [real(r8) (:) ] shaded projected leaf area index + leafc => carbonstate_vars%leafc_patch , & + leafn => nitrogenstate_vars%leafn_patch , & + leafp => phosphorusstate_vars%leafp_patch , & + supplement_to_sminn_vr => nitrogenflux_vars%supplement_to_sminn_vr_col , & + supplement_to_sminp_vr => phosphorusflux_vars%supplement_to_sminp_vr_col , & + + ! for debug +! plant_n_uptake_flux => nitrogenflux_vars%plant_n_uptake_flux , & +! plant_p_uptake_flux => phosphorusflux_vars%plant_p_uptake_flux , & + leafc_storage => carbonstate_vars%leafc_storage_patch , & + leafc_xfer => carbonstate_vars%leafc_xfer_patch , & + leafn_storage => nitrogenstate_vars%leafn_storage_patch , & + leafn_xfer => nitrogenstate_vars%leafn_xfer_patch , & + leafp_storage => phosphorusstate_vars%leafp_storage_patch , & + leafp_xfer => phosphorusstate_vars%leafp_xfer_patch , & + annsum_potential_gpp => cnstate_vars%annsum_potential_gpp_patch , & + annmax_retransn => cnstate_vars%annmax_retransn_patch , & + grain_flag => cnstate_vars%grain_flag_patch , & + cn_scalar => cnstate_vars%cn_scalar , & + cp_scalar => cnstate_vars%cp_scalar , & + annmax_retransp => cnstate_vars%annmax_retransp_patch , & + cpool_to_xsmrpool => carbonflux_vars%cpool_to_xsmrpool_patch , & + w_scalar => carbonflux_vars%w_scalar_col , & + froot_prof => cnstate_vars%froot_prof_patch , & + leaf_mr => carbonflux_vars%leaf_mr_patch , & + froot_mr => carbonflux_vars%froot_mr_patch , & + livestem_mr => carbonflux_vars%livestem_mr_patch , & + livecroot_mr => carbonflux_vars%livecroot_mr_patch , & + grain_mr => carbonflux_vars%grain_mr_patch , & + xsmrpool => carbonstate_vars%xsmrpool_patch , & + xsmrpool_recover => carbonflux_vars%xsmrpool_recover_patch , & + leaf_curmr => carbonflux_vars%leaf_curmr_patch , & + froot_curmr => carbonflux_vars%froot_curmr_patch , & + livestem_curmr => carbonflux_vars%livestem_curmr_patch , & + livecroot_curmr => carbonflux_vars%livecroot_curmr_patch , & + grain_curmr => carbonflux_vars%grain_curmr_patch , & + leaf_xsmr => carbonflux_vars%leaf_xsmr_patch , & + froot_xsmr => carbonflux_vars%froot_xsmr_patch , & + livestem_xsmr => carbonflux_vars%livestem_xsmr_patch , & + livecroot_xsmr => carbonflux_vars%livecroot_xsmr_patch , & + grain_xsmr => carbonflux_vars%grain_xsmr_patch , & + allocation_leaf => carbonflux_vars%allocation_leaf , & + allocation_stem => carbonflux_vars%allocation_stem , & + allocation_froot => carbonflux_vars%allocation_froot , & + xsmrpool_turnover => carbonflux_vars%xsmrpool_turnover_patch , & + c13cf => c13_carbonflux_vars, & + c14cf => c14_carbonflux_vars & + ) + +! +! !------------------------------------------------------------------- + ! set space-and-time parameters from parameter file + dayscrecover = CNAllocParamsInst%dayscrecover + + ! start new pft loop to distribute the available N between the + ! competing patches on the basis of relative demand, and allocate C and N to + ! new growth and storage - ! AgroIBIS included here an immediate adjustment to aleaf & astem if the - ! predicted lai from the above allocation coefficients exceeded laimx. - ! We have decided to live with lais slightly higher than laimx by - ! enforcing the cap in the following tstep through the peaklai logic above. + do fp=1,num_soilp + p = filter_soilp(fp) + c = veg_pp%column(p) + + ! 'ECA' or 'MIC' mode + ! dynamic allocation based on light limitation (more woody growth) vs nutrient limitations (more fine root growth) + ! set allocation coefficients + N_lim_factor(p) = cn_scalar(p) ! N stress factor + P_lim_factor(p) = cp_scalar(p) ! P stress factor + + if (cnallocate_carbon_only()) then + N_lim_factor(p) = 0.0_r8 + P_lim_factor(p) = 0.0_r8 + else if (cnallocate_carbonnitrogen_only()) then + P_lim_factor(p) = 0.0_r8 + else if (cnallocate_carbonphosphorus_only()) then + N_lim_factor(p) = 0.0_r8 + end if + W_lim_factor(p) = 0.0_r8 + do j = 1 , nlevdecomp + W_lim_factor(p) = W_lim_factor(p) + w_scalar(c,j) * froot_prof(p,j) + end do + ! N_lim_factor/P_lim_factor ones: highly limited + ! N_lim_factor/P_lim_factor zeros: not limited + ! convert to 1- X, see explanation in dynamic_plant_alloc + call dynamic_plant_alloc(min(1.0_r8-N_lim_factor(p),1.0_r8-P_lim_factor(p)),W_lim_factor(p), & + laisun(p)+laisha(p), allocation_leaf(p), allocation_stem(p), allocation_froot(p), woody(ivt(p))) + + f1 = allocation_froot(p) / allocation_leaf(p) + f2 = croot_stem(ivt(p)) + f3 = allocation_stem(p) / allocation_leaf(p) + + ! modified wood allocation to be 2.2 at npp=800 gC/m2/yr, 0.2 at npp=0, + ! constrained so that it does not go lower than 0.2 (under negative annsum_npp) + ! There was an error in this formula in previous version, where the coefficient + ! was 0.004 instead of 0.0025. + ! This variable allocation is only for trees. Shrubs have a constant + ! allocation as specified in the pft-physiology file. The value is also used + ! as a trigger here: -1.0 means to use the dynamic allocation (trees). + !if (stem_leaf(ivt(p)) == -1._r8) then + ! f3 = (2.7/(1.0+exp(-0.004*(annsum_npp(p) - 300.0)))) - 0.4 + !else + ! f3 = stem_leaf(ivt(p)) + !end if + + f4 = flivewd(ivt(p)) + g1 = grperc(ivt(p)) + g2 = grpnow(ivt(p)) + + cnl = leafcn(ivt(p)) + cnfr = frootcn(ivt(p)) + cnlw = livewdcn(ivt(p)) + cndw = deadwdcn(ivt(p)) + + cpl = leafcp(ivt(p)) + cpfr = frootcp(ivt(p)) + cplw = livewdcp(ivt(p)) + cpdw = deadwdcp(ivt(p)) + + fcur = fcur2(ivt(p)) + + if (ivt(p) >= npcropmin) then ! skip 2 generic crops + if (croplive(p)) then + f1 = aroot(p) / aleaf(p) + f3 = astem(p) / aleaf(p) + f5 = arepr(p) / aleaf(p) + g1 = 0.25_r8 + else + f1 = 0._r8 + f3 = 0._r8 + f5 = 0._r8 + g1 = 0.25_r8 + end if + end if - astemi(p) = astem(p) ! save for use by equations after shift - aleafi(p) = aleaf(p) ! to reproductive phenology stage begins - grain_flag(p) = 0._r8 ! setting to 0 while in phase 2 + sminn_to_npool(p) = plant_n_buffer_patch(p)/taun + sminp_to_ppool(p) = plant_p_buffer_patch(p)/taup + plant_n_buffer_patch(p) = plant_n_buffer_patch(p) * (1._r8-dt/taun) + plant_p_buffer_patch(p) = plant_p_buffer_patch(p) * (1._r8-dt/taun) + + if (ivt(p) >= npcropmin .and. grain_flag(p) == 1._r8) then + avail_retransn(p) = retransn(p)/dt + avail_retransp(p) = retransp(p)/dt + else if (ivt(p) < npcropmin .and. annsum_potential_gpp(p) > 0._r8) then + avail_retransn(p) = (annmax_retransn(p)/2._r8)*(gpp(p)/annsum_potential_gpp(p))/dt + avail_retransp(p) = (annmax_retransp(p)/2._r8)*(gpp(p)/annsum_potential_gpp(p))/dt + else + avail_retransn(p) = 0.0_r8 + avail_retransp(p) = 0.0_r8 + end if - ! Phase 2 completed: - ! ================== - ! shift allocation either when enough gdd are accumulated or maximum number - ! of days has elapsed since planting + ! make sure available retrans N doesn't exceed storage + avail_retransn(p) =max( min(avail_retransn(p),retransn(p)/dt),0.0_r8) + avail_retransp(p) =max( min(avail_retransp(p),retransp(p)/dt),0.0_r8) - else if (hui(p) >= huigrain(p)) then + retransn_to_npool(p) = avail_retransn(p) + retransp_to_ppool(p) = avail_retransp(p) - aroot(p) = max(0._r8, min(1._r8, arooti(ivt(p)) - & - (arooti(ivt(p)) - arootf(ivt(p))) * min(1._r8, hui(p)/gddmaturity(p)))) - if (astemi(p) > astemf(ivt(p))) then - astem(p) = max(0._r8, max(astemf(ivt(p)), astem(p) * & - (1._r8 - min((hui(p)- & - huigrain(p))/((gddmaturity(p)*declfact(ivt(p)))- & - huigrain(p)),1._r8)**allconss(ivt(p)) ))) - end if - if (aleafi(p) > aleaff(ivt(p))) then - aleaf(p) = max(1.e-5_r8, max(aleaff(ivt(p)), aleaf(p) * & - (1._r8 - min((hui(p)- & - huigrain(p))/((gddmaturity(p)*declfact(ivt(p)))- & - huigrain(p)),1._r8)**allconsl(ivt(p)) ))) - end if + plant_nalloc(p) = sminn_to_npool(p) + retransn_to_npool(p) + plant_palloc(p) = sminp_to_ppool(p) + retransp_to_ppool(p) - !Beth's retranslocation of leafn, stemn, rootn to organ - !Filter excess plant N to retransn pool for organ N - !Only do one time then hold grain_flag till onset next season - - ! slevis: Will astem ever = astemf exactly? - ! Beth's response: ...looks like astem can equal astemf under the right circumstances. - !It might be worth a rewrite to capture what I was trying to do, but the retranslocation for - !corn and wheat begins at the beginning of the grain fill stage, but for soybean I was holding it - !until after the leaf and stem decline were complete. Looking at how astem is calculated, once the - !stem decline is near complete, astem should (usually) be set to astemf. The reason for holding off - !on soybean is that the retranslocation scheme begins at the beginning of the grain phase, when the - !leaf and stem are still growing, but declining. Since carbon is still getting allocated and now - !there is more nitrogen available, the nitrogen can be diverted from grain. For corn and wheat - !the impact was probably enough to boost productivity, but for soybean the nitrogen was better off - !fulfilling the grain fill. It seems that if the peak lai is reached for soybean though that this - !would be bypassed altogether, not the intended outcome. I checked several of my output files and - !they all seemed to be going through the retranslocation loop for soybean - good news. - - if (ivt(p) /= nsoybean .or. astem(p) == astemf(ivt(p))) then - if (grain_flag(p) == 0._r8) then - t1 = 1 / dt - leafn_to_retransn(p) = t1 * ((leafc(p) / leafcn(ivt(p))) - (leafc(p) / & - fleafcn(ivt(p)))) - livestemn_to_retransn(p) = t1 * ((livestemc(p) / livewdcn(ivt(p))) - (livestemc(p) / & - fstemcn(ivt(p)))) - frootn_to_retransn(p) = 0._r8 - if (ffrootcn(ivt(p)) > 0._r8) then - frootn_to_retransn(p) = t1 * ((frootc(p) / frootcn(ivt(p))) - (frootc(p) / & - ffrootcn(ivt(p)))) + mr = leaf_mr(p) + froot_mr(p) + if (woody(ivt(p)) == 1.0_r8) then + mr = mr + livestem_mr(p) + livecroot_mr(p) + else if (ivt(p) >= npcropmin) then + if (croplive(p)) mr = mr + livestem_mr(p) + grain_mr(p) + end if + ! try to take mr from xsmr storage pool first + if (xsmrpool(p) > 0) then + if (mr > 0._r8 .and. (xsmrpool(p)/dt + gpp(p)) <= mr) then + curmr = gpp(p) + curmr_ratio = curmr / mr + xsmr_ratio = xsmrpool(p)/dt/mr ! not enough non-structure carbon hydrate, limit mr + availc(p) = 0.0 + else if (mr > 0._r8 .and. (xsmrpool(p)/dt + gpp(p)) > mr .and. xsmrpool(p)/dt <= mr ) then + curmr = mr - xsmrpool(p)/dt + curmr_ratio = curmr / mr + xsmr_ratio = xsmrpool(p)/dt/mr + availc(p) = gpp(p) - (mr - xsmrpool(p)/dt) + else if (mr > 0._r8 .and. (xsmrpool(p)/dt + gpp(p)) > mr .and. xsmrpool(p)/dt > mr ) then + curmr = 0.0 + curmr_ratio = curmr / mr + xsmr_ratio = 1 - curmr_ratio + availc(p) = gpp(p) + end if + else + if (mr > 0._r8 .and. gpp(p) <= mr) then + curmr = gpp(p) + curmr_ratio = curmr / mr + xsmr_ratio = 0 ! not enough non-structure carbon hydrate, limit mr + availc(p) = 0.0 + else if (mr > 0._r8 .and. gpp(p) > mr ) then + curmr = mr + curmr_ratio = curmr / mr + xsmr_ratio = 0._r8 + availc(p) = gpp(p) - mr + end if + end if + + ! carbon flux available for allocation + leaf_curmr(p) = leaf_mr(p) * curmr_ratio + leaf_xsmr(p) = leaf_mr(p) * xsmr_ratio + leaf_mr(p) = leaf_curmr(p) + leaf_xsmr(p) + froot_curmr(p) = froot_mr(p) * curmr_ratio + froot_xsmr(p) = froot_mr(p) * xsmr_ratio + froot_mr(p) = froot_curmr(p) + froot_xsmr(p) + livestem_curmr(p) = livestem_mr(p) * curmr_ratio + livestem_xsmr(p) = livestem_mr(p) * xsmr_ratio + livestem_mr(p) = livestem_curmr(p) + livestem_xsmr(p) + livecroot_curmr(p) = livecroot_mr(p) * curmr_ratio + livecroot_xsmr(p) = livecroot_mr(p) * xsmr_ratio + livecroot_mr(p) = livecroot_curmr(p) + livecroot_xsmr(p) + grain_curmr(p) = grain_mr(p) * curmr_ratio + grain_xsmr(p) = grain_mr(p) * xsmr_ratio + + ! no allocation when available c is negative + availc(p) = max(availc(p),0.0_r8) + ! test for an xsmrpool deficit + if (xsmrpool(p) < 0.0_r8) then + ! Running a deficit in the xsmrpool, so the first priority is to let + ! some availc from this timestep accumulate in xsmrpool. + ! Determine rate of recovery for xsmrpool deficit + + xsmrpool_recover(p) = -xsmrpool(p)/(dayscrecover*secspday) + if (xsmrpool_recover(p) < availc(p)) then + ! available carbon reduced by amount for xsmrpool recovery + availc(p) = availc(p) - xsmrpool_recover(p) + else + ! all of the available carbon goes to xsmrpool recovery + xsmrpool_recover(p) = availc(p) + availc(p) = 0.0_r8 + end if + cpool_to_xsmrpool(p) = xsmrpool_recover(p) + + ! storage pool turnover + xsmrpool_turnover(p) = 0.0_r8 + else + + ! bug fix: set to zero otherwise xsmrpool may grow infinitely when: + ! (1) at one timestep xsmrpool(p) <0, cpool_to_xsmrpool(p) is set a positive value + ! (2) later on if xsmrpool(p) >0; then cpool_to_xsmrpool(p) will neither be updated by following codes nor re-set to zero + ! (3) each time step in CNCStateUpdate1 xsmrpool(p) = xsmrpool(p) + cpool_to_xsmrpool(p)*dt + cpool_to_xsmrpool(p) = 0.0_r8 + + ! storage pool turnover + xsmrpool_turnover(p) = max(xsmrpool(p) - mr*xsmr_ratio*dt , 0.0_r8) / (10.0*365.0*secspday) + end if + + plant_calloc(p) = availc(p) + + ! here no down-regulation on allocatable C here, NP limitation is implemented in leaf-level NP control on GPP + if (woody(ivt(p)) == 1.0_r8) then + c_allometry(p) = (1._r8+g1)*(1._r8+f1+f3*(1._r8+f2)) + n_allometry(p) = 1._r8/cnl + f1/cnfr + (f3*f4*(1._r8+f2))/cnlw + & + (f3*(1._r8-f4)*(1._r8+f2))/cndw + p_allometry(p) = 1._r8/cpl + f1/cpfr + (f3*f4*(1._r8+f2))/cplw + & + (f3*(1._r8-f4)*(1._r8+f2))/cpdw + + else if (ivt(p) >= npcropmin) then ! skip generic crops + cng = graincn(ivt(p)) + cpg = graincp(ivt(p)) + c_allometry(p) = (1._r8+g1)*(1._r8+f1+f5+f3*(1._r8+f2)) + n_allometry(p) = 1._r8/cnl + f1/cnfr + f5/cng + (f3*f4*(1._r8+f2))/cnlw + & + (f3*(1._r8-f4)*(1._r8+f2))/cndw + p_allometry(p) = 1._r8/cpl + f1/cpfr + f5/cpg + (f3*f4*(1._r8+f2))/cplw + & + (f3*(1._r8-f4)*(1._r8+f2))/cpdw + + else + c_allometry(p) = 1._r8+g1+f1+f1*g1 + n_allometry(p) = 1._r8/cnl + f1/cnfr + p_allometry(p) = 1._r8/cpl + f1/cpfr + end if + + + ! calculate the amount of new leaf C dictated by these allocation + ! decisions, and calculate the daily fluxes of C and N to current + ! growth and storage pools + + ! fcur is the proportion of this day's growth that is displayed now, + ! the remainder going into storage for display next year through the + ! transfer pools + + ! recover default coefficient for carbon allocation to leaf, which is possibly changed due to previous time step allocation adjustment + nlc = plant_calloc(p) / c_allometry(p) + ! recover allocation fraction, which is possibly changed due to previous time step allocation adjustment + !fcur = fcur2(ivt(p)) + + ! under ECA or MIC mode, CNP stoichiometry is flexible + ! If nutrient is limited, plant will accumulate non-structural carbon hydrate (sink strength limitation) + ! e.g., in the model if allocatable C is too much, allocate excess C to storage pool, later could be respired + ! Here, adjust the fraction allocate to structure vs storage pool so that: + ! CN only mode adjust C allocation to maintain CN ratio within natural variability + ! CP only mode adjust C allocation to maintain CP ratio within natural variability + ! CNP mode adjust C allocation to maintain CN and CP ratio within natural variability + + if (cnallocate_carbon_only()) then ! C only mode + ! nothing to adjust + nlc_adjust_high = nlc + else if (cnallocate_carbonnitrogen_only()) then ! CN only mode + + ! maximum amount of C allocated to leaf pool that could be supported by plant N allocated to leaf pool: + ! plant_nalloc(p) / (n_allometry(p) )/ cnl * (cnl*(1 + cn_stoich_var ) ) + ! maximum amount of C allocated to leaf pool that could be supported by plant P allocated to leaf pool: + ! plant_palloc(p) / (p_allometry(p) )/ cpl * (cpl* (1 + cp_stoich_var ) ) + ! actual amount of C allocated to leaf pool if no adjustment occur + ! plant_calloc/c_allometry * x* (x*=1) + ! adjust fcur* to reduce the C allocated to leaf pool + ! x* = plant_nalloc(p) / n_allometry(p) * (1 + cn_stoich_var ) / (plant_calloc/c_allometry) + ! x* = plant_palloc(p) / p_allometry(p) * (1 + cp_stoich_var ) / (plant_calloc/c_allometry) + + + nlc_adjust_high = plant_nalloc(p) / n_allometry(p) * (1 + cn_stoich_var ) ! upper bound of allocatable C to leaf to satisfy N allocation + nlc_adjust_high = nlc_adjust_high + max((leafn(p)+leafn_storage(p) + leafn_xfer(p))* cnl * (1 + cn_stoich_var ) - & + (leafc(p)+leafc_storage(p) + leafc_xfer(p)),0.0_r8)/dt ! upper bound of allocatable C to leaf account for offsetting current leaf N deficit + else if (cnallocate_carbonphosphorus_only()) then ! CP only mode + nlc_adjust_high = plant_palloc(p) / p_allometry(p) * (1 + cp_stoich_var ) ! upper bound of allocatable C to leaf to satisfy P allocation + nlc_adjust_high = nlc_adjust_high + max((leafp(p)+leafp_storage(p) + leafp_xfer(p))* cpl * (1 + cp_stoich_var ) - & + (leafc(p)+leafc_storage(p) + leafc_xfer(p)),0.0_r8)/dt ! upper bound of allocatable C to leaf account for offsetting current leaf N deficit + else ! CNP mode + nlc_adjust_high = min(plant_nalloc(p) / n_allometry(p) * (1 + cn_stoich_var ) + max((leafn(p)+leafn_storage(p) + leafn_xfer(p))* cnl * (1 + cn_stoich_var ) - & + (leafc(p)+leafc_storage(p) + leafc_xfer(p)),0.0_r8)/dt, & + plant_palloc(p) / p_allometry(p) * (1 + cp_stoich_var ) + max((leafp(p)+leafp_storage(p) + leafp_xfer(p))* cpl * (1 + cp_stoich_var ) - & + (leafc(p)+leafc_storage(p) + leafc_xfer(p)),0.0_r8)/dt) + end if + + ! calculate excess carbon + ! put excess carbon into respiration storage pool (if nlc > nlc_adjust_high) + nlc = max(nlc - nlc_adjust_high,0.0_r8) + cpool_to_xsmrpool(p) = cpool_to_xsmrpool(p) + nlc * fcur * (1 + g1) + cpool_to_xsmrpool(p) = cpool_to_xsmrpool(p) + nlc * (1._r8 - fcur) * (1 + g1) + cpool_to_xsmrpool(p) = cpool_to_xsmrpool(p) + nlc * f1 * fcur * (1 + g1) + cpool_to_xsmrpool(p) = cpool_to_xsmrpool(p) + nlc * f1 * (1._r8 - fcur) * (1 + g1) + if (woody(ivt(p)) == 1._r8) then + cpool_to_xsmrpool(p) = cpool_to_xsmrpool(p) + nlc * f3 * f4 * fcur * (1 + g1) + cpool_to_xsmrpool(p) = cpool_to_xsmrpool(p) + nlc * f3 * f4 * (1._r8 - fcur) * (1 + g1) + cpool_to_xsmrpool(p) = cpool_to_xsmrpool(p) + nlc * f3 * (1._r8 - f4) * fcur * (1 + g1) + cpool_to_xsmrpool(p) = cpool_to_xsmrpool(p) + nlc * f3 * (1._r8 - f4) * (1._r8 - fcur) * (1 + g1) + cpool_to_xsmrpool(p) = cpool_to_xsmrpool(p) + nlc * f2 * f3 * f4 * fcur * (1 + g1) + cpool_to_xsmrpool(p) = cpool_to_xsmrpool(p) + nlc * f2 * f3 * f4 * (1._r8 - fcur) * (1 + g1) + cpool_to_xsmrpool(p) = cpool_to_xsmrpool(p) + nlc * f2 * f3 * (1._r8 - f4) * fcur * (1 + g1) + cpool_to_xsmrpool(p) = cpool_to_xsmrpool(p) + nlc * f2 * f3 * (1._r8 - f4) * (1._r8 - fcur) * (1 + g1) + end if + if (ivt(p) >= npcropmin) then ! skip 2 generic crops + cpool_to_xsmrpool(p) = cpool_to_xsmrpool(p) + nlc * f3 * f4 * fcur * (1 + g1) + cpool_to_xsmrpool(p) = cpool_to_xsmrpool(p) + nlc * f3 * f4 * (1._r8 - fcur) * (1 + g1) + cpool_to_xsmrpool(p) = cpool_to_xsmrpool(p) + nlc * f3 * (1._r8 - f4) * fcur * (1 + g1) + cpool_to_xsmrpool(p) = cpool_to_xsmrpool(p) + nlc * f3 * (1._r8 - f4) * (1._r8 - fcur) * (1 + g1) + cpool_to_xsmrpool(p) = cpool_to_xsmrpool(p) + nlc * f2 * f3 * f4 * fcur * (1 + g1) + cpool_to_xsmrpool(p) = cpool_to_xsmrpool(p) + nlc * f2 * f3 * f4 * (1._r8 - fcur) * (1 + g1) + cpool_to_xsmrpool(p) = cpool_to_xsmrpool(p) + nlc * f2 * f3 * (1._r8 - f4) * fcur * (1 + g1) + cpool_to_xsmrpool(p) = cpool_to_xsmrpool(p) + nlc * f2 * f3 * (1._r8 - f4) * (1._r8 - fcur) * (1 + g1) + cpool_to_xsmrpool(p) = cpool_to_xsmrpool(p) + nlc * f5 * fcur * (1 + g1) + cpool_to_xsmrpool(p) = cpool_to_xsmrpool(p) + nlc * f5 * (1._r8 -fcur) * (1 + g1) + end if + + ! updated allocation if necessary + nlc = min(nlc_adjust_high ,plant_calloc(p) / c_allometry(p) ) + + + cpool_to_leafc(p) = nlc * fcur + cpool_to_leafc_storage(p) = nlc * (1._r8 - fcur) + cpool_to_frootc(p) = nlc * f1 * fcur + cpool_to_frootc_storage(p) = nlc * f1 * (1._r8 - fcur) + if (woody(ivt(p)) == 1._r8) then + cpool_to_livestemc(p) = nlc * f3 * f4 * fcur + cpool_to_livestemc_storage(p) = nlc * f3 * f4 * (1._r8 - fcur) + cpool_to_deadstemc(p) = nlc * f3 * (1._r8 - f4) * fcur + cpool_to_deadstemc_storage(p) = nlc * f3 * (1._r8 - f4) * (1._r8 - fcur) + cpool_to_livecrootc(p) = nlc * f2 * f3 * f4 * fcur + cpool_to_livecrootc_storage(p) = nlc * f2 * f3 * f4 * (1._r8 - fcur) + cpool_to_deadcrootc(p) = nlc * f2 * f3 * (1._r8 - f4) * fcur + cpool_to_deadcrootc_storage(p) = nlc * f2 * f3 * (1._r8 - f4) * (1._r8 - fcur) + end if + if (ivt(p) >= npcropmin) then ! skip 2 generic crops + cpool_to_livestemc(p) = nlc * f3 * f4 * fcur + cpool_to_livestemc_storage(p) = nlc * f3 * f4 * (1._r8 - fcur) + cpool_to_deadstemc(p) = nlc * f3 * (1._r8 - f4) * fcur + cpool_to_deadstemc_storage(p) = nlc * f3 * (1._r8 - f4) * (1._r8 - fcur) + cpool_to_livecrootc(p) = nlc * f2 * f3 * f4 * fcur + cpool_to_livecrootc_storage(p) = nlc * f2 * f3 * f4 * (1._r8 - fcur) + cpool_to_deadcrootc(p) = nlc * f2 * f3 * (1._r8 - f4) * fcur + cpool_to_deadcrootc_storage(p) = nlc * f2 * f3 * (1._r8 - f4) * (1._r8 - fcur) + cpool_to_grainc(p) = nlc * f5 * fcur + cpool_to_grainc_storage(p) = nlc * f5 * (1._r8 -fcur) + end if + + ! corresponding N fluxes + ! recover default coefficient for carbon allocation to leaf, which is possibly changed due to previous time step allocation adjustment + !nlc = plant_calloc(p) / c_allometry(p) + ! recover allocation fraction, which is possibly changed due to previous time step allocation adjustment + !fcur = fcur2(ivt(p)) + + if (cnallocate_carbon_only()) then ! C only mode + ! nothing to adjust + else ! CN/ CP/ CNP mode + ! ! minimum amount of C allocated to structural leaf pool that could be supported by plant N allocated to structural leaf pool: + ! ! plant_nalloc(p) / (n_allometry(p) )/ cnl * (cnl*(1 - cn_stoich_var ) )*x* (x*=1) + ! ! minimum amount of C allocated to structural leaf pool that could be supported by plant P allocated to structural leaf pool: + ! ! plant_palloc(p) / (p_allometry(p) )/ cpl * (cpl* (1 - cp_stoich_var ) )*x* (x*=1) + ! ! actual amount of C allocated to structural leaf pool if no adjustment occur + ! ! plant_calloc/c_allometry + ! ! adjust fcur* to reduce the NP allocated to structural leaf pool + ! ! x* = (plant_calloc/c_allometry)* fcur /(plant_nalloc(p) / n_allometry(p) * (1 - cn_stoich_var ) ) + ! ! x* = (plant_calloc/c_allometry)* fcur /(plant_palloc(p) / p_allometry(p) * (1 - cp_stoich_var ) ) + ! + ! if (plant_nalloc(p) / n_allometry(p) / cnl * fcur > cpool_to_leafc(p) / (cnl * (1 - cn_stoich_var ) ) ) then ! excess N + ! fcur = cpool_to_leafc(p) / (plant_nalloc(p) / n_allometry(p) * (1 - cn_stoich_var ) ) + ! end if + nlc = plant_nalloc(p) / n_allometry(p) + end if + + + npool_to_leafn(p) = (nlc / cnl) * fcur + npool_to_leafn_storage(p) = (nlc / cnl) * (1._r8 - fcur) + npool_to_frootn(p) = (nlc * f1 / cnfr) * fcur + npool_to_frootn_storage(p) = (nlc * f1 / cnfr) * (1._r8 - fcur) + if (woody(ivt(p)) == 1._r8) then + npool_to_livestemn(p) = (nlc * f3 * f4 / cnlw) * fcur + npool_to_livestemn_storage(p) = (nlc * f3 * f4 / cnlw) * (1._r8 - fcur) + npool_to_deadstemn(p) = (nlc * f3 * (1._r8 - f4) / cndw) * fcur + npool_to_deadstemn_storage(p) = (nlc * f3 * (1._r8 - f4) / cndw) * (1._r8 - fcur) + npool_to_livecrootn(p) = (nlc * f2 * f3 * f4 / cnlw) * fcur + npool_to_livecrootn_storage(p) = (nlc * f2 * f3 * f4 / cnlw) * (1._r8 - fcur) + npool_to_deadcrootn(p) = (nlc * f2 * f3 * (1._r8 - f4) / cndw) * fcur + npool_to_deadcrootn_storage(p) = (nlc * f2 * f3 * (1._r8 - f4) / cndw) * (1._r8 - fcur) + end if + if (ivt(p) >= npcropmin) then ! skip 2 generic crops + cng = graincn(ivt(p)) + npool_to_livestemn(p) = (nlc * f3 * f4 / cnlw) * fcur + npool_to_livestemn_storage(p) = (nlc * f3 * f4 / cnlw) * (1._r8 - fcur) + npool_to_deadstemn(p) = (nlc * f3 * (1._r8 - f4) / cndw) * fcur + npool_to_deadstemn_storage(p) = (nlc * f3 * (1._r8 - f4) / cndw) * (1._r8 - fcur) + npool_to_livecrootn(p) = (nlc * f2 * f3 * f4 / cnlw) * fcur + npool_to_livecrootn_storage(p) = (nlc * f2 * f3 * f4 / cnlw) * (1._r8 - fcur) + npool_to_deadcrootn(p) = (nlc * f2 * f3 * (1._r8 - f4) / cndw) * fcur + npool_to_deadcrootn_storage(p) = (nlc * f2 * f3 * (1._r8 - f4) / cndw) * (1._r8 - fcur) + npool_to_grainn(p) = (nlc * f5 / cng) * fcur + npool_to_grainn_storage(p) = (nlc * f5 / cng) * (1._r8 -fcur) + end if + + ! corresponding P fluxes + ! recover default coefficient for carbon allocation to leaf, which is possibly changed due to previous time step allocation adjustment + !nlc = plant_calloc(p) / c_allometry(p) + ! recover allocation fraction, which is possibly changed due to previous time step allocation adjustment + !fcur = fcur2(ivt(p)) + + if (cnallocate_carbon_only()) then ! C only mode + ! nothing to adjust + else ! CN/ CP/ CNP mode + ! if (plant_palloc(p) / p_allometry(p) / cpl * fcur > cpool_to_leafc(p) / (cpl * (1 - cp_stoich_var ) ) ) then ! excess P + ! fcur = cpool_to_leafc(p) / (plant_palloc(p) / p_allometry(p) * (1 - cp_stoich_var ) ) + ! end if + nlc = plant_palloc(p) / p_allometry(p) end if - grain_flag(p) = 1._r8 - end if - end if - arepr(p) = 1._r8 - aroot(p) - astem(p) - aleaf(p) - else ! pre emergence - aleaf(p) = 1.e-5_r8 ! allocation coefficients should be irrelevant - astem(p) = 0._r8 ! because crops have no live carbon pools; - aroot(p) = 0._r8 ! this applies to this "else" and to the "else" - arepr(p) = 0._r8 ! a few lines down - end if + ppool_to_leafp(p) = (nlc / cpl) * fcur + ppool_to_leafp_storage(p) = (nlc / cpl) * (1._r8 - fcur) + ppool_to_frootp(p) = (nlc * f1 / cpfr) * fcur + ppool_to_frootp_storage(p) = (nlc * f1 / cpfr) * (1._r8 - fcur) + if (woody(ivt(p)) == 1._r8) then + ppool_to_livestemp(p) = (nlc * f3 * f4 / cplw) * fcur + ppool_to_livestemp_storage(p) = (nlc * f3 * f4 / cplw) * (1._r8 -fcur) + ppool_to_deadstemp(p) = (nlc * f3 * (1._r8 - f4) / cpdw) *fcur + ppool_to_deadstemp_storage(p) = (nlc * f3 * (1._r8 - f4) / cpdw) *(1._r8 - fcur) + ppool_to_livecrootp(p) = (nlc * f2 * f3 * f4 / cplw) * fcur + ppool_to_livecrootp_storage(p) = (nlc * f2 * f3 * f4 / cplw) * (1._r8 -fcur) + ppool_to_deadcrootp(p) = (nlc * f2 * f3 * (1._r8 - f4) / cpdw)* fcur + ppool_to_deadcrootp_storage(p) = (nlc * f2 * f3 * (1._r8 - f4) / cpdw)* (1._r8 - fcur) + end if + if (ivt(p) >= npcropmin) then ! skip 2 generic crops + cpg = graincp(ivt(p)) + ppool_to_livestemp(p) = (nlc * f3 * f4 / cplw) * fcur + ppool_to_livestemp_storage(p) = (nlc * f3 * f4 / cplw) * (1._r8 -fcur) + ppool_to_deadstemp(p) = (nlc * f3 * (1._r8 - f4) / cpdw) * fcur + ppool_to_deadstemp_storage(p) = (nlc * f3 * (1._r8 - f4) / cpdw) *(1._r8 - fcur) + ppool_to_livecrootp(p) = (nlc * f2 * f3 * f4 / cplw) * fcur + ppool_to_livecrootp_storage(p) = (nlc * f2 * f3 * f4 / cplw) * (1._r8 -fcur) + ppool_to_deadcrootp(p) = (nlc * f2 * f3 * (1._r8 - f4) / cpdw)* fcur + ppool_to_deadcrootp_storage(p) = (nlc * f2 * f3 * (1._r8 - f4) / cpdw)* (1._r8 - fcur) + ppool_to_grainp(p) = (nlc * f5 / cpg) * fcur + ppool_to_grainp_storage(p) = (nlc * f5 / cpg) * (1._r8 -fcur) + end if + + ! Calculate the amount of carbon that needs to go into growth + ! respiration storage to satisfy all of the storage growth demands. + ! Allows for the fraction of growth respiration that is released at the + ! time of fixation, versus the remaining fraction that is stored for + ! release at the time of display. Note that all the growth respiration + ! fluxes that get released on a given timestep are calculated in growth_resp(), + ! but that the storage of C for growth resp during display of transferred + ! growth is assigned here. + + gresp_storage = cpool_to_leafc_storage(p) + cpool_to_frootc_storage(p) + if (woody(ivt(p)) == 1._r8) then + gresp_storage = gresp_storage + cpool_to_livestemc_storage(p) + gresp_storage = gresp_storage + cpool_to_deadstemc_storage(p) + gresp_storage = gresp_storage + cpool_to_livecrootc_storage(p) + gresp_storage = gresp_storage + cpool_to_deadcrootc_storage(p) + end if + if (ivt(p) >= npcropmin) then ! skip 2 generic crops + gresp_storage = gresp_storage + cpool_to_livestemc_storage(p) + gresp_storage = gresp_storage + cpool_to_grainc_storage(p) + end if + cpool_to_gresp_storage(p) = gresp_storage * g1 * (1._r8 - g2) + + ! ECA root NP uptake is based on kinetics, plant CNP stoichiometry can vary even + ! when certain element is set to not limiting (e.g., P not limiting under CN mode) + ! additional supplement N/P come from first soil layer + ! must ensure plant get enough N or P or both to maintain its stoichiometry: + ! (1) maintain plant PC stoichiometry at optimal ratio under CN mode + ! (2) maintain plant NC stoichiometry at optimal ratio under CP mode + ! (3) maintain plant PC/NC stoichiometry at optimal ratios under C mode + if (cnallocate_carbon_only() .or. cnallocate_carbonphosphorus_only()) then + + supplement_to_sminn_vr(c,1) = supplement_to_sminn_vr(c,1) + cpool_to_leafc(p) / cnl - npool_to_leafn(p) + supplement_to_sminn_vr(c,1) = supplement_to_sminn_vr(c,1) + cpool_to_leafc_storage(p) / cnl - npool_to_leafn_storage(p) + supplement_to_sminn_vr(c,1) = supplement_to_sminn_vr(c,1) + cpool_to_frootc(p) / cnfr - npool_to_frootn(p) + supplement_to_sminn_vr(c,1) = supplement_to_sminn_vr(c,1) + cpool_to_frootc_storage(p) / cnfr- npool_to_frootn_storage(p) + + npool_to_leafn(p) = cpool_to_leafc(p) / cnl + npool_to_leafn_storage(p) = cpool_to_leafc_storage(p) / cnl + npool_to_frootn(p) = cpool_to_frootc(p) / cnfr + npool_to_frootn_storage(p) = cpool_to_frootc_storage(p) / cnfr + + if (woody(ivt(p)) == 1._r8) then + supplement_to_sminn_vr(c,1) = supplement_to_sminn_vr(c,1) + cpool_to_livestemc(p) / cnlw - npool_to_livestemn(p) + supplement_to_sminn_vr(c,1) = supplement_to_sminn_vr(c,1) + cpool_to_livestemc_storage(p) / cnlw - npool_to_livestemn_storage(p) + supplement_to_sminn_vr(c,1) = supplement_to_sminn_vr(c,1) + cpool_to_deadstemc(p) / cndw - npool_to_deadstemn(p) + supplement_to_sminn_vr(c,1) = supplement_to_sminn_vr(c,1) + cpool_to_deadstemc_storage(p) / cndw - npool_to_deadstemn_storage(p) + supplement_to_sminn_vr(c,1) = supplement_to_sminn_vr(c,1) + cpool_to_livecrootc(p) / cnlw - npool_to_livecrootn(p) + supplement_to_sminn_vr(c,1) = supplement_to_sminn_vr(c,1) + cpool_to_livecrootc_storage(p) / cnlw - npool_to_livecrootn_storage(p) + supplement_to_sminn_vr(c,1) = supplement_to_sminn_vr(c,1) + cpool_to_deadcrootc(p) / cndw - npool_to_deadcrootn(p) + supplement_to_sminn_vr(c,1) = supplement_to_sminn_vr(c,1) + cpool_to_deadcrootc_storage(p) / cndw - npool_to_deadcrootn_storage(p) + + npool_to_livestemn(p) = cpool_to_livestemc(p) / cnlw + npool_to_livestemn_storage(p) = cpool_to_livestemc_storage(p) / cnlw + npool_to_deadstemn(p) = cpool_to_deadstemc(p) / cndw + npool_to_deadstemn_storage(p) = cpool_to_deadstemc_storage(p) / cndw + npool_to_livecrootn(p) = cpool_to_livecrootc(p) / cnlw + npool_to_livecrootn_storage(p) = cpool_to_livecrootc_storage(p) / cnlw + npool_to_deadcrootn(p) = cpool_to_deadcrootc(p) / cndw + npool_to_deadcrootn_storage(p) = cpool_to_deadcrootc_storage(p) / cndw + end if + if (ivt(p) >= npcropmin) then ! skip 2 generic crops + cng = graincn(ivt(p)) + supplement_to_sminn_vr(c,1) = supplement_to_sminn_vr(c,1) + cpool_to_livestemc(p) / cnlw - npool_to_livestemn(p) + supplement_to_sminn_vr(c,1) = supplement_to_sminn_vr(c,1) + cpool_to_livestemc_storage(p) / cnlw - npool_to_livestemn_storage(p) + supplement_to_sminn_vr(c,1) = supplement_to_sminn_vr(c,1) + cpool_to_deadstemc(p) / cndw - npool_to_deadstemn(p) + supplement_to_sminn_vr(c,1) = supplement_to_sminn_vr(c,1) + cpool_to_deadstemc_storage(p) / cndw - npool_to_deadstemn_storage(p) + supplement_to_sminn_vr(c,1) = supplement_to_sminn_vr(c,1) + cpool_to_livecrootc(p) / cnlw - npool_to_livecrootn(p) + supplement_to_sminn_vr(c,1) = supplement_to_sminn_vr(c,1) + cpool_to_livecrootc_storage(p) / cnlw - npool_to_livecrootn_storage(p) + supplement_to_sminn_vr(c,1) = supplement_to_sminn_vr(c,1) + cpool_to_deadcrootc(p) / cndw - npool_to_deadcrootn(p) + supplement_to_sminn_vr(c,1) = supplement_to_sminn_vr(c,1) + cpool_to_deadcrootc_storage(p) / cndw - npool_to_deadcrootn_storage(p) + supplement_to_sminn_vr(c,1) = supplement_to_sminn_vr(c,1) + cpool_to_grainc(p) / cng - npool_to_grainn(p) + supplement_to_sminn_vr(c,1) = supplement_to_sminn_vr(c,1) + cpool_to_grainc_storage(p) / cng - npool_to_grainn_storage(p) + + npool_to_livestemn(p) = cpool_to_livestemc(p) / cnlw + npool_to_livestemn_storage(p) = cpool_to_livestemc_storage(p) / cnlw + npool_to_deadstemn(p) = cpool_to_deadstemc(p) / cndw + npool_to_deadstemn_storage(p) = cpool_to_deadstemc_storage(p) / cndw + npool_to_livecrootn(p) = cpool_to_livecrootc(p) / cnlw + npool_to_livecrootn_storage(p) = cpool_to_livecrootc_storage(p) / cnlw + npool_to_deadcrootn(p) = cpool_to_deadcrootc(p) / cndw + npool_to_deadcrootn_storage(p) = cpool_to_deadcrootc_storage(p) / cndw + npool_to_grainn(p) = cpool_to_grainc(p) / cng + npool_to_grainn_storage(p) = cpool_to_grainc_storage(p) / cng + end if + + else if (cnallocate_carbon_only() .or. cnallocate_carbonnitrogen_only()) then + + supplement_to_sminp_vr(c,1) = supplement_to_sminp_vr(c,1) + max(cpool_to_leafc(p) / cpl - ppool_to_leafp(p),0._r8) + supplement_to_sminp_vr(c,1) = supplement_to_sminp_vr(c,1) + max(cpool_to_leafc_storage(p) / cpl - ppool_to_leafp_storage(p),0._r8) + supplement_to_sminp_vr(c,1) = supplement_to_sminp_vr(c,1) + max(cpool_to_frootc(p) / cpfr - ppool_to_frootp(p),0._r8) + supplement_to_sminp_vr(c,1) = supplement_to_sminp_vr(c,1) + max(cpool_to_frootc_storage(p) / cpfr - ppool_to_frootp_storage(p),0._r8) + + ppool_to_leafp(p) = cpool_to_leafc(p) / cpl + ppool_to_leafp_storage(p) = cpool_to_leafc_storage(p) / cpl + ppool_to_frootp(p) = cpool_to_frootc(p) / cpfr + ppool_to_frootp_storage(p) = cpool_to_frootc_storage(p) / cpfr + + if (woody(ivt(p)) == 1._r8) then + supplement_to_sminp_vr(c,1) = supplement_to_sminp_vr(c,1) + max(cpool_to_livestemc(p) / cplw - ppool_to_livestemp(p),0._r8) + supplement_to_sminp_vr(c,1) = supplement_to_sminp_vr(c,1) + max(cpool_to_livestemc_storage(p) / cplw - ppool_to_livestemp_storage(p),0._r8) + supplement_to_sminp_vr(c,1) = supplement_to_sminp_vr(c,1) + max(cpool_to_deadstemc(p) /cpdw - ppool_to_deadstemp(p),0._r8) + supplement_to_sminp_vr(c,1) = supplement_to_sminp_vr(c,1) + max(cpool_to_deadstemc_storage(p) / cpdw- ppool_to_deadstemp_storage(p),0._r8) + supplement_to_sminp_vr(c,1) = supplement_to_sminp_vr(c,1) + max(cpool_to_livecrootc(p) / cplw - ppool_to_livecrootp(p),0._r8) + supplement_to_sminp_vr(c,1) = supplement_to_sminp_vr(c,1) + max(cpool_to_livecrootc_storage(p) / cplw - ppool_to_livecrootp_storage(p),0._r8) + supplement_to_sminp_vr(c,1) = supplement_to_sminp_vr(c,1) + max(cpool_to_deadcrootc(p) / cpdw - ppool_to_deadcrootp(p),0._r8) + supplement_to_sminp_vr(c,1) = supplement_to_sminp_vr(c,1) + max(cpool_to_deadcrootc_storage(p) / cpdw - ppool_to_deadcrootp_storage(p),0._r8) + + ppool_to_livestemp(p) = cpool_to_livestemc(p) / cplw + ppool_to_livestemp_storage(p) = cpool_to_livestemc_storage(p) / cplw + ppool_to_deadstemp(p) = cpool_to_deadstemc(p) / cpdw + ppool_to_deadstemp_storage(p) = cpool_to_deadstemc_storage(p) / cpdw + ppool_to_livecrootp(p) = cpool_to_livecrootc(p) / cplw + ppool_to_livecrootp_storage(p) = cpool_to_livecrootc_storage(p) / cplw + ppool_to_deadcrootp(p) = cpool_to_deadcrootc(p) / cpdw + ppool_to_deadcrootp_storage(p) = cpool_to_deadcrootc_storage(p) / cpdw + end if + if (ivt(p) >= npcropmin) then ! skip 2 generic crops + cpg = graincp(ivt(p)) + supplement_to_sminp_vr(c,1) = supplement_to_sminp_vr(c,1) + max(cpool_to_livestemc(p) / cplw - ppool_to_livestemp(p),0._r8) + supplement_to_sminp_vr(c,1) = supplement_to_sminp_vr(c,1) + max(cpool_to_livestemc_storage(p) / cplw - ppool_to_livestemp_storage(p),0._r8) + supplement_to_sminp_vr(c,1) = supplement_to_sminp_vr(c,1) + max(cpool_to_deadstemc(p) /cpdw - ppool_to_deadstemp(p),0._r8) + supplement_to_sminp_vr(c,1) = supplement_to_sminp_vr(c,1) + max(cpool_to_deadstemc_storage(p) / cpdw- ppool_to_deadstemp_storage(p),0._r8) + supplement_to_sminp_vr(c,1) = supplement_to_sminp_vr(c,1) + max(cpool_to_livecrootc(p) / cplw - ppool_to_livecrootp(p),0._r8) + supplement_to_sminp_vr(c,1) = supplement_to_sminp_vr(c,1) + max(cpool_to_livecrootc_storage(p) / cplw - ppool_to_livecrootp_storage(p),0._r8) + supplement_to_sminp_vr(c,1) = supplement_to_sminp_vr(c,1) + max(cpool_to_deadcrootc(p) / cpdw - ppool_to_deadcrootp(p),0._r8) + supplement_to_sminp_vr(c,1) = supplement_to_sminp_vr(c,1) + max(cpool_to_deadcrootc_storage(p) / cpdw - ppool_to_deadcrootp_storage(p),0._r8) + supplement_to_sminp_vr(c,1) = supplement_to_sminp_vr(c,1) + max(cpool_to_grainc(p) / cpg - ppool_to_grainp(p),0._r8) + supplement_to_sminp_vr(c,1) = supplement_to_sminp_vr(c,1) + max(cpool_to_grainc_storage(p) / cpg - ppool_to_grainp_storage(p),0._r8) + + ppool_to_livestemp(p) = cpool_to_livestemc(p) / cplw + ppool_to_livestemp_storage(p) = cpool_to_livestemc_storage(p) / cplw + ppool_to_deadstemp(p) = cpool_to_deadstemc(p) / cpdw + ppool_to_deadstemp_storage(p) = cpool_to_deadstemc_storage(p) / cpdw + ppool_to_livecrootp(p) = cpool_to_livecrootc(p) / cplw + ppool_to_livecrootp_storage(p) = cpool_to_livecrootc_storage(p) / cplw + ppool_to_deadcrootp(p) = cpool_to_deadcrootc(p) / cpdw + ppool_to_deadcrootp_storage(p) = cpool_to_deadcrootc_storage(p) / cpdw + ppool_to_grainp(p) = cpool_to_grainc(p) / cpg + ppool_to_grainp_storage(p) = cpool_to_grainc_storage(p) / cpg + end if + + end if + + end do ! end pft loop + + !---------------------------------------------------------------- - f1 = aroot(p) / aleaf(p) - f3 = astem(p) / aleaf(p) - f5 = arepr(p) / aleaf(p) - g1 = 0.25_r8 + end associate - else ! .not croplive - f1 = 0._r8 - f3 = 0._r8 - f5 = 0._r8 - g1 = 0.25_r8 + end subroutine CNAllocation3_PlantCNPAlloc + + +!----------------------------------------------------------------------- + + subroutine dynamic_plant_alloc( nutrient_scalar, water_scalar, laindex, alloc_leaf, alloc_stem, alloc_froot, woody) + + ! !DESCRIPTION + ! Added by Qing Zhu 2015 based on P. Friedlingstein DOI: 10.1046/j.1365-2486.1999.00269.x + ! allocation coefficients for leaf, stem and root are not fixed + ! update allocation coefficients based on nutrient and light availability + ! (1) light limited, allocate more C into stem + ! (2) nutrient/water limited, allocate more C into root + + ! !USES: + + ! + ! !ARGUMENTS: + real(r8), intent(in) :: nutrient_scalar ! scalar for nutrient availability + real(r8), intent(in) :: water_scalar ! scalar for water availability + real(r8), intent(in) :: laindex ! lai + real(r8), intent(out) :: alloc_leaf + real(r8), intent(out) :: alloc_stem + real(r8), intent(out) :: alloc_froot + real(r8), intent(in) :: woody + + !! variables + real(r8) :: laindex_max = 8 + real(r8) :: allocmin_leaf = 0.25 + !real(r8) :: allocmax_leaf = 0.5 + real(r8) :: alloc_r0 = 0.25 ! initial allocation to roots for unlimiting conditions + real(r8) :: alloc_s0 = 0.25 ! initial allocation to stem for unlimiting conditions + real(r8) :: klight_ex = 0.5 ! light extinction parameter + real(r8) :: light_scalar ! scalar for light availability + real(r8) :: nu_scalar + real(r8) :: w_scalar + + ! general framework P. Friedlingstein DOI: 10.1046/j.1365-2486.1999.00269.x + ! allocation to a certain compartment A = sum(X)/(X + Y) + ! increase resource X availability lead to increase allocation to A + ! increase resource Y availability lead to decrease allocation to A + + ! for nu_scalar from 0->1, system from high nutrient limited -> non-nutrient limited + ! nutrient resource availability increase, root allocation decrease + ! in this case nu_scalar is the availability scalar + + ! light scalar lai high->low, light_scalar 0->1 + ! light availability increase, allocation to wood decrease + ! define the light availability scalar based on LAI + light_scalar = exp (-klight_ex * laindex) + + ! adjust scalar for numerical stability purposes + light_scalar = max( 0.1_r8, min( 1.0_r8, light_scalar ) ) + nu_scalar = max( 0.1_r8, min( 1.0_r8, nutrient_scalar ) ) + w_scalar = max( 0.1_r8, min( 1.0_r8, water_scalar ) ) + + ! root allocation + alloc_froot = alloc_r0 * 3.0_r8 * light_scalar / (light_scalar + 2.0_r8 * min(nu_scalar,w_scalar)) + alloc_froot = min(alloc_froot, 0.4_r8) + + ! stem allocation + if (woody == 1.0_r8) then + alloc_stem = alloc_s0 * 3.0_r8 * min(nu_scalar,w_scalar) / (2.0_r8 * light_scalar + min(nu_scalar,w_scalar)) + else + alloc_stem = 0.0_r8 + end if + ! leaf allocation + alloc_leaf = 1.0_r8 - (alloc_froot + alloc_stem) + + ! adjustment under extreme nutrient/light limitation condition + if (alloc_leaf < allocmin_leaf) then + alloc_leaf = allocmin_leaf + alloc_froot = alloc_froot * (1-allocmin_leaf) / (alloc_froot + alloc_stem) + alloc_stem = 1.0 - alloc_leaf - alloc_froot end if - end if - ! based on available C, use constant allometric relationships to - ! determine N requirements + ! if lai greater than laimax then no allocation to leaf; leaf allocation goes to stem or fine root + if (laindex > laindex_max) then + if (woody == 1.0_r8) then + alloc_stem = alloc_stem + alloc_leaf - 0.01_r8 + else + alloc_froot = alloc_froot + alloc_leaf - 0.01_r8 + end if + alloc_leaf = 0.01_r8 + end if - if (woody(ivt(p)) == 1.0_r8) then - c_allometry(p) = (1._r8+g1)*(1._r8+f1+f3*(1._r8+f2)) - n_allometry(p) = 1._r8/cnl + f1/cnfr + (f3*f4*(1._r8+f2))/cnlw + & - (f3*(1._r8-f4)*(1._r8+f2))/cndw - else if (ivt(p) >= npcropmin) then ! skip generic crops - cng = graincn(ivt(p)) - c_allometry(p) = (1._r8+g1)*(1._r8+f1+f5+f3*(1._r8+f2)) - n_allometry(p) = 1._r8/cnl + f1/cnfr + f5/cng + (f3*f4*(1._r8+f2))/cnlw + & - (f3*(1._r8-f4)*(1._r8+f2))/cndw - else - c_allometry(p) = 1._r8+g1+f1+f1*g1 - n_allometry(p) = 1._r8/cnl + f1/cnfr - end if - plant_ndemand(p) = availc(p)*(n_allometry(p)/c_allometry(p)) - - ! retranslocated N deployment depends on seasonal cycle of potential GPP - ! (requires one year run to accumulate demand) - - tempsum_potential_gpp(p) = tempsum_potential_gpp(p) + gpp(p) - - ! Adding the following line to carry max retransn info to CN Annual Update - tempmax_retransn(p) = max(tempmax_retransn(p),retransn(p)) - - ! Beth's code: crops pull from retransn pool only during grain fill; - ! retransn pool has N from leaves, stems, and roots for - ! retranslocation - - if (ivt(p) >= npcropmin .and. grain_flag(p) == 1._r8) then - avail_retransn(p) = plant_ndemand(p) - else if (ivt(p) < npcropmin .and. annsum_potential_gpp(p) > 0._r8) then - avail_retransn(p) = (annmax_retransn(p)/2._r8)*(gpp(p)/annsum_potential_gpp(p))/dt - else - avail_retransn(p) = 0.0_r8 - end if - - ! make sure available retrans N doesn't exceed storage - avail_retransn(p) = min(avail_retransn(p), retransn(p)/dt) - - ! modify plant N demand according to the availability of - ! retranslocated N - ! take from retransn pool at most the flux required to meet - ! plant ndemand - - if (plant_ndemand(p) > avail_retransn(p)) then - retransn_to_npool(p) = avail_retransn(p) - else - retransn_to_npool(p) = plant_ndemand(p) - end if - plant_ndemand(p) = plant_ndemand(p) - retransn_to_npool(p) - - end do ! end pft loop - - ! now use the p2c routine to get the column-averaged plant_ndemand - call p2c(bounds, num_soilc, filter_soilc, & - plant_ndemand(bounds%begp:bounds%endp), & - plant_totn_demand_flx_col(bounds%begc:bounds%endc)) - - ! obtain the nutrient uptake potential based on fine root profile - - end associate - end subroutine calc_plant_nitrogen_demand - -end module CNAllocationBetrMod + end subroutine dynamic_plant_alloc + + +!----------------------------------------------------------------------- + +end module CNAllocationBeTRMod diff --git a/components/clm/src/biogeochem/CNBeTRIndicatorMod.F90 b/components/clm/src/biogeochem/CNBeTRIndicatorMod.F90 new file mode 100644 index 000000000000..9bcc6ba00c0d --- /dev/null +++ b/components/clm/src/biogeochem/CNBeTRIndicatorMod.F90 @@ -0,0 +1,77 @@ +module CNBeTRIndicatorMod + ! + ! DESCRIPTION + ! code to switch on/off of gap mortality and phenology relevant processes. + + use shr_kind_mod , only : r8 => shr_kind_r8 +implicit none +public +integer, parameter :: pid_leafn_to_litter = 1 +integer, parameter :: pid_frootn_to_litter = 2 +integer, parameter :: pid_livestemn_to_litter =3 + +integer, parameter :: gid_m_leafn_to_litter = 1 +integer, parameter :: gid_m_frootn_to_litter = 2 +integer, parameter :: gid_m_livestemn_to_litter = 3 +integer, parameter :: gid_m_deadstemn_to_litter = 4 +integer, parameter :: gid_m_livecrootn_to_litter = 5 +integer, parameter :: gid_m_deadcrootn_to_litter = 6 +integer, parameter :: gid_m_retransn_to_litter = 7 +integer, parameter :: gid_m_leafn_storage_to_litter = 8 +integer, parameter :: gid_m_frootn_storage_to_litter = 9 +integer, parameter :: gid_m_livestemn_storage_to_litter = 10 +integer, parameter :: gid_m_deadstemn_storage_to_litter = 11 +integer, parameter :: gid_m_livecrootn_storage_to_litter = 12 +integer, parameter :: gid_m_deadcrootn_storage_to_litter = 13 +integer, parameter :: gid_m_leafn_xfer_to_litter = 14 +integer, parameter :: gid_m_frootn_xfer_to_litter = 15 +integer, parameter :: gid_m_livestemn_xfer_to_litter = 16 +integer, parameter :: gid_m_deadstemn_xfer_to_litter = 17 +integer, parameter :: gid_m_livecrootn_xfer_to_litter = 18 +integer, parameter :: gid_m_deadcrootn_xfer_to_litter = 19 + +real(r8) :: pheno_indicator(3) +real(r8) :: gap_indicator(19) + +contains + subroutine set_pheno_indicators + implicit none + + pheno_indicator(:) = 1._r8 + return + pheno_indicator(pid_leafn_to_litter) = 0._r8 + pheno_indicator(pid_frootn_to_litter) = 0._r8 + pheno_indicator(pid_livestemn_to_litter) = 0._r8 + + end subroutine set_pheno_indicators + +!---------------------------------------------------------------------- + subroutine set_gap_indicators + implicit none + + gap_indicator(:) = 1._r8 + return + gap_indicator(gid_m_leafn_to_litter) = 0._r8 + gap_indicator(gid_m_frootn_to_litter) = 0._r8 + gap_indicator(gid_m_livestemn_to_litter) = 0._r8 + gap_indicator(gid_m_deadstemn_to_litter) = 0._r8 + gap_indicator(gid_m_livecrootn_to_litter) = 0._r8 + gap_indicator(gid_m_deadcrootn_to_litter) = 0._r8 + gap_indicator(gid_m_retransn_to_litter) = 0._r8 + gap_indicator(gid_m_leafn_storage_to_litter) = 0._r8 + gap_indicator(gid_m_frootn_storage_to_litter) = 0._r8 + gap_indicator(gid_m_livestemn_storage_to_litter) = 0._r8 + gap_indicator(gid_m_deadstemn_storage_to_litter) = 0._r8 + gap_indicator(gid_m_livecrootn_storage_to_litter) = 0._r8 + gap_indicator(gid_m_deadcrootn_storage_to_litter) = 0._r8 + gap_indicator(gid_m_leafn_xfer_to_litter) = 0._r8 + gap_indicator(gid_m_frootn_xfer_to_litter) = 0._r8 + gap_indicator(gid_m_livestemn_xfer_to_litter) = 0._r8 + gap_indicator(gid_m_deadstemn_xfer_to_litter) = 0._r8 + gap_indicator(gid_m_livecrootn_xfer_to_litter) = 0._r8 + gap_indicator(gid_m_deadcrootn_xfer_to_litter) = 0._r8 + + end subroutine set_gap_indicators + + +end module CNBeTRIndicatorMod diff --git a/components/clm/src/biogeochem/CNCStateUpdate1Mod.F90 b/components/clm/src/biogeochem/CNCStateUpdate1Mod.F90 index 0c6a041c853e..db815ae27de8 100644 --- a/components/clm/src/biogeochem/CNCStateUpdate1Mod.F90 +++ b/components/clm/src/biogeochem/CNCStateUpdate1Mod.F90 @@ -128,30 +128,13 @@ subroutine CStateUpdate1(bounds, & ! seeding fluxes, from dynamic landcover cs%seedc_col(c) = cs%seedc_col(c) - cf%dwt_seedc_to_leaf_col(c) * dt cs%seedc_col(c) = cs%seedc_col(c) - cf%dwt_seedc_to_deadstem_col(c) * dt + cs%decomp_som2c_vr_col(c,1:nlevdecomp) = cs%decomp_cpools_vr_col(c,1:nlevdecomp,6) end do end if - if (is_active_betr_bgc) then - !summarize litter carbon input - ! plant to litter fluxes - do j = 1,nlevdecomp - ! column loop - do fc = 1,num_soilc - c = filter_soilc(fc) - ! phenology and dynamic land cover fluxes - cf%bgc_cpool_ext_inputs_vr_col(c,j,i_met_lit) = & - ( cf%phenology_c_to_litr_met_c_col(c,j) + cf%dwt_frootc_to_litr_met_c_col(c,j) ) *dt - cf%bgc_cpool_ext_inputs_vr_col(c,j,i_cel_lit) = & - ( cf%phenology_c_to_litr_cel_c_col(c,j) + cf%dwt_frootc_to_litr_cel_c_col(c,j) ) *dt - cf%bgc_cpool_ext_inputs_vr_col(c,j,i_lig_lit) = & - ( cf%phenology_c_to_litr_lig_c_col(c,j) + cf%dwt_frootc_to_litr_lig_c_col(c,j) ) *dt - cf%bgc_cpool_ext_inputs_vr_col(c,j,i_cwd) = & - ( cf%dwt_livecrootc_to_cwdc_col(c,j) + cf%dwt_deadcrootc_to_cwdc_col(c,j) ) *dt - enddo - enddo - - elseif (.not.(use_pflotran .and. pf_cmode) .and. .not.use_ed ) then + + if (.not. is_active_betr_bgc .and. .not.(use_pflotran .and. pf_cmode) .and. .not.use_ed ) then ! plant to litter fluxes @@ -423,14 +406,6 @@ subroutine CStateUpdate1(bounds, & end if - if(is_active_betr_bgc)then - - !the following is introduced to fix the spinup problem with simultaneous nitrogen competition - - call p2c(bounds, num_soilc, filter_soilc, & - cs%frootc_patch(bounds%begp:bounds%endp), & - cnstate_vars%frootc_nfix_scalar_col(bounds%begc:bounds%endc)) - endif end associate end subroutine CStateUpdate1 diff --git a/components/clm/src/biogeochem/CNCStateUpdate2Mod.F90 b/components/clm/src/biogeochem/CNCStateUpdate2Mod.F90 index 8552083ab1b6..94d56ca3dace 100644 --- a/components/clm/src/biogeochem/CNCStateUpdate2Mod.F90 +++ b/components/clm/src/biogeochem/CNCStateUpdate2Mod.F90 @@ -16,6 +16,7 @@ module CNCStateUpdate2Mod use pftvarcon , only : npcropmin use clm_varctl , only : use_pflotran, pf_cmode use VegetationType , only : veg_pp + use tracer_varcon , only : is_active_betr_bgc ! implicit none save @@ -77,25 +78,6 @@ subroutine CStateUpdate2(num_soilc, filter_soilc, num_soilp, filter_soilp, & cs%decomp_cpools_vr_col(c,j,i_cwd) = & cs%decomp_cpools_vr_col(c,j,i_cwd) + cf%gap_mortality_c_to_cwdc_col(c,j) * dt - end do - end do - else if (is_active_betr_bgc) then - - do j = 1,nlevdecomp - ! column loop - do fc = 1,num_soilc - c = filter_soilc(fc) - - ! column gap mortality fluxes - cf%bgc_cpool_ext_inputs_vr_col(c,j,i_met_lit) = & - cf%bgc_cpool_ext_inputs_vr_col(c,j,i_met_lit) + cf%gap_mortality_c_to_litr_met_c_col(c,j) * dt - cf%bgc_cpool_ext_inputs_vr_col(c,j,i_cel_lit) = & - cf%bgc_cpool_ext_inputs_vr_col(c,j,i_cel_lit) + cf%gap_mortality_c_to_litr_cel_c_col(c,j) * dt - cf%bgc_cpool_ext_inputs_vr_col(c,j,i_lig_lit) = & - cf%bgc_cpool_ext_inputs_vr_col(c,j,i_lig_lit) + cf%gap_mortality_c_to_litr_lig_c_col(c,j) * dt - cf%bgc_cpool_ext_inputs_vr_col(c,j,i_cwd) = & - cf%bgc_cpool_ext_inputs_vr_col(c,j,i_cwd) + cf%gap_mortality_c_to_cwdc_col(c,j) * dt - end do end do endif @@ -189,21 +171,6 @@ subroutine CStateUpdate2h(num_soilc, filter_soilc, num_soilp, filter_soilp, & end do end do - else if (is_active_betr_bgc) then - do j = 1, nlevdecomp - ! column loop - do fc = 1,num_soilc - c = filter_soilc(fc) - cf%bgc_cpool_ext_inputs_vr_col(c,j,i_met_lit) = & - cf%bgc_cpool_ext_inputs_vr_col(c,j,i_met_lit) + cf%harvest_c_to_litr_met_c_col(c,j) * dt - cf%bgc_cpool_ext_inputs_vr_col(c,j,i_cel_lit) = & - cf%bgc_cpool_ext_inputs_vr_col(c,j,i_cel_lit) + cf%harvest_c_to_litr_cel_c_col(c,j) * dt - cf%bgc_cpool_ext_inputs_vr_col(c,j,i_lig_lit) = & - cf%bgc_cpool_ext_inputs_vr_col(c,j,i_lig_lit) + cf%harvest_c_to_litr_lig_c_col(c,j) * dt - cf%bgc_cpool_ext_inputs_vr_col(c,j,i_cwd) = & - cf%bgc_cpool_ext_inputs_vr_col(c,j,i_cwd) + cf%harvest_c_to_cwdc_col(c,j) * dt - end do - end do endif ! patch loop diff --git a/components/clm/src/biogeochem/CNCStateUpdate3Mod.F90 b/components/clm/src/biogeochem/CNCStateUpdate3Mod.F90 index e38819b4c0a1..8646ebc78130 100644 --- a/components/clm/src/biogeochem/CNCStateUpdate3Mod.F90 +++ b/components/clm/src/biogeochem/CNCStateUpdate3Mod.F90 @@ -81,33 +81,6 @@ subroutine CStateUpdate3( num_soilc, filter_soilc, num_soilp, filter_soilp, & end do end do end do - - else - - ! column level carbon fluxes from fire - do j = 1, nlevdecomp - do fc = 1,num_soilc - c = filter_soilc(fc) - ! pft-level wood to column-level CWD (uncombusted wood) - cf%bgc_cpool_ext_inputs_vr_col(c,j,i_cwd) = cf%bgc_cpool_ext_inputs_vr_col(c,j,i_cwd) + cf%fire_mortality_c_to_cwdc_col(c,j) * dt - - ! pft-level wood to column-level litter (uncombusted wood) - cf%bgc_cpool_ext_inputs_vr_col(c,j,i_met_lit) = cf%bgc_cpool_ext_inputs_vr_col(c,j,i_met_lit) + cf%m_c_to_litr_met_fire_col(c,j)* dt - cf%bgc_cpool_ext_inputs_vr_col(c,j,i_cel_lit) = cf%bgc_cpool_ext_inputs_vr_col(c,j,i_cel_lit) + cf%m_c_to_litr_cel_fire_col(c,j)* dt - cf%bgc_cpool_ext_inputs_vr_col(c,j,i_lig_lit) = cf%bgc_cpool_ext_inputs_vr_col(c,j,i_lig_lit) + cf%m_c_to_litr_lig_fire_col(c,j)* dt - end do - end do - - ! litter and CWD losses to fire - do l = 1, ndecomp_pools - do j = 1, nlevdecomp - do fc = 1,num_soilc - c = filter_soilc(fc) - cf%bgc_cpool_ext_loss_vr_col(c,j,l) = cf%bgc_cpool_ext_loss_vr_col(c,j,l) + cf%m_decomp_cpools_to_fire_vr_col(c,j,l) * dt - end do - end do - end do - endif ! diff --git a/components/clm/src/biogeochem/CNCarbonFluxType.F90 b/components/clm/src/biogeochem/CNCarbonFluxType.F90 index 9750574fba76..42b4db144d3d 100644 --- a/components/clm/src/biogeochem/CNCarbonFluxType.F90 +++ b/components/clm/src/biogeochem/CNCarbonFluxType.F90 @@ -373,6 +373,7 @@ module CNCarbonFluxType real(r8), pointer :: npp_col (:) ! column (gC/m2/s) net primary production (p2c) real(r8), pointer :: fire_closs_p2c_col (:) ! column (gC/m2/s) patch2col averaged column-level fire C loss (p2c) real(r8), pointer :: fire_closs_col (:) ! column (gC/m2/s) total patch-level fire C loss + real(r8), pointer :: fire_decomp_closs_col (:) ! column (gC/m2/s) carbon loss to fire for decomposable pools real(r8), pointer :: litfall_col (:) ! column (gC/m2/s) total patch-level litterfall C loss (p2c) real(r8), pointer :: vegfire_col (:) ! column (gC/m2/s) patch-level fire loss (obsolete, mark for removal) (p2c) real(r8), pointer :: wood_harvestc_col (:) ! column (p2c) @@ -726,6 +727,7 @@ subroutine InitAllocate(this, bounds) allocate(this%npp_col (begc:endc)) ; this%npp_col (:) =nan allocate(this%fire_closs_p2c_col (begc:endc)) ; this%fire_closs_p2c_col (:) =nan allocate(this%fire_closs_col (begc:endc)) ; this%fire_closs_col (:) =nan + allocate(this%fire_decomp_closs_col (begc:endc)) ; this%fire_decomp_closs_col (:) =nan allocate(this%litfall_col (begc:endc)) ; this%litfall_col (:) =nan allocate(this%vegfire_col (begc:endc)) ; this%vegfire_col (:) =nan allocate(this%wood_harvestc_col (begc:endc)) ; this%wood_harvestc_col (:) =nan @@ -3048,6 +3050,11 @@ subroutine InitHistory(this, bounds, carbon_type) avgflag='A', long_name='total column-level fire C loss for non-peat fires outside land-type converted region', & ptr_col=this%fire_closs_col, default='inactive') + this%fire_decomp_closs_col(begc:endc) = spval + call hist_addfld1d (fname='DECOMP_FIRE_CLOSS', units='gC/m^2/s', & + avgflag='A', long_name='decomposable fire C loss for non-peat fires outside land-type converted region', & + ptr_col=this%fire_decomp_closs_col, default='inactive') + this%dwt_seedc_to_leaf_col(begc:endc) = spval call hist_addfld1d (fname='DWT_SEEDC_TO_LEAF', units='gC/m^2/s', & avgflag='A', long_name='seed source to patch-level leaf', & diff --git a/components/clm/src/biogeochem/CNCarbonStateType.F90 b/components/clm/src/biogeochem/CNCarbonStateType.F90 index b18eb5c57a38..4862e06982a2 100644 --- a/components/clm/src/biogeochem/CNCarbonStateType.F90 +++ b/components/clm/src/biogeochem/CNCarbonStateType.F90 @@ -96,6 +96,7 @@ module CNCarbonStateType real(r8), pointer :: totecosysc_col (:) ! col (gC/m2) total ecosystem carbon, incl veg but excl cpool real(r8), pointer :: totcolc_col (:) ! col (gC/m2) total column carbon, incl veg and cpool real(r8), pointer :: totabgc_col (:) ! col (gC/m2) total column above ground carbon, excluding som + real(r8), pointer :: totblgc_col (:) ! col (gc/m2) total column non veg carbon ! Balance checks real(r8), pointer :: begcb_patch (:) ! patch carbon mass, beginning of time step (gC/m**2) @@ -114,6 +115,7 @@ module CNCarbonStateType real(r8), pointer :: cwdc_end_col(:) real(r8), pointer :: totlitc_end_col(:) real(r8), pointer :: totsomc_end_col(:) + real(r8), pointer :: decomp_som2c_vr_col(:,:) contains @@ -225,9 +227,11 @@ subroutine InitAllocate(this, bounds) allocate(this%totvegc_col (begc :endc)) ; this%totvegc_col (:) = nan allocate(this%totabgc_col (begc :endc)) ; this%totabgc_col (:) = nan + allocate(this%totblgc_col (begc:endc)) ; this%totblgc_col (:) = nan allocate(this%decomp_cpools_vr_col(begc:endc,1:nlevdecomp_full,1:ndecomp_pools)) this%decomp_cpools_vr_col(:,:,:)= nan + allocate(this%decomp_som2c_vr_col(begc:endc,1:nlevdecomp_full)); this%decomp_som2c_vr_col(:,:)= nan allocate(this%begcb_patch (begp:endp)); this%begcb_patch (:) = nan allocate(this%begcb_col (begc:endc)); this%begcb_col (:) = nan allocate(this%endcb_patch (begp:endp)); this%endcb_patch (:) = nan @@ -766,6 +770,7 @@ subroutine InitHistory(this, bounds, carbon_type) !those variables are now ouput in betr this%decomp_cpools_col(begc:endc,:) = spval do l = 1, ndecomp_pools + if(trim(decomp_cascade_con%decomp_pool_name_history(l))=='')exit if ( nlevdecomp_full > 1 ) then data2dptr => this%decomp_cpools_vr_col(:,:,l) fieldname = trim(decomp_cascade_con%decomp_pool_name_history(l))//'C_vr' @@ -1337,6 +1342,7 @@ subroutine Restart ( this, bounds, ncid, flag, carbon_type, c12_carbonstate_var use restUtilMod use ncdio_pio + use tracer_varcon , only : is_active_betr_bgc ! ! !ARGUMENTS: class (carbonstate_type) :: this @@ -2353,7 +2359,17 @@ subroutine Restart ( this, bounds, ncid, flag, carbon_type, c12_carbonstate_var end if end do end if - + if(is_active_betr_bgc)then + if (carbon_type == 'c12') then + call restartvar(ncid=ncid, flag=flag, varname='totblgc', xtype=ncd_double, & + dim1name='column', long_name='', units='', & + interpinic_flag='interp', readvar=readvar, data=this%totblgc_col) + + call restartvar(ncid=ncid, flag=flag, varname='cwdc', xtype=ncd_double, & + dim1name='column', long_name='', units='', & + interpinic_flag='interp', readvar=readvar, data=this%cwdc_col) + endif + endif if (carbon_type == 'c12') then if (use_vertsoilc) then ptr2d => this%ctrunc_vr_col diff --git a/components/clm/src/biogeochem/CNEcosystemDynBetrMod.F90 b/components/clm/src/biogeochem/CNEcosystemDynBetrMod.F90 index c5b59575ac90..d1673c7dd222 100644 --- a/components/clm/src/biogeochem/CNEcosystemDynBetrMod.F90 +++ b/components/clm/src/biogeochem/CNEcosystemDynBetrMod.F90 @@ -9,7 +9,7 @@ module CNEcosystemDynBetrMod ! be enabled gradually. use shr_kind_mod , only : r8 => shr_kind_r8 use shr_sys_mod , only : shr_sys_flush - use clm_varctl , only : flanduse_timeseries, use_c13, use_c14, use_ed + use clm_varctl , only : flanduse_timeseries, use_c13, use_c14, use_ed, use_dynroot use decompMod , only : bounds_type use perf_mod , only : t_startf, t_stopf use spmdMod , only : masterproc @@ -26,105 +26,82 @@ module CNEcosystemDynBetrMod use WaterstateType , only : waterstate_type use WaterfluxType , only : waterflux_type use atm2lndType , only : atm2lnd_type - use SoilStateType , only : soilstate_type use CanopyStateType , only : canopystate_type - use TemperatureType , only : temperature_type + use TemperatureType , only : temperature_type use PhotosynthesisType , only : photosyns_type use ch4Mod , only : ch4_type use EnergyFluxType , only : energyflux_type use SoilHydrologyType , only : soilhydrology_type use FrictionVelocityType , only : frictionvel_type - use PlantSoilnutrientFluxType , only : plantsoilnutrientflux_type use tracerfluxType , only : tracerflux_type use tracerstatetype , only : tracerstate_type - use BetrTracerType , only : betrtracer_type + use BetrTracerType , only : betrtracer_type use PhosphorusFluxType , only : phosphorusflux_type use PhosphorusStateType , only : phosphorusstate_type implicit none private - public :: CNEcosystemDynBetrVeg - public :: CNEcosystemDynBetrSummary + public :: CNEcosystemDynBeTR public :: CNFluxStateBetrSummary - public :: CNEcosystemDynBetrInit contains + !----------------------------------------------------------------------- - subroutine CNEcosystemDynBetrInit(bounds) - ! - ! !DESCRIPTION: - ! Initialzation of the CN Ecosystem dynamics. + subroutine CNEcosystemDynBetr(bounds, & + num_soilc, filter_soilc, & + num_soilp, filter_soilp, num_pcropp, filter_pcropp, doalb, & + cnstate_vars, carbonflux_vars, carbonstate_vars, & + c13_carbonflux_vars, c13_carbonstate_vars, & + c14_carbonflux_vars, c14_carbonstate_vars, & + nitrogenflux_vars, nitrogenstate_vars, & + atm2lnd_vars, waterstate_vars, waterflux_vars, & + canopystate_vars, soilstate_vars, temperature_vars, crop_vars, & + dgvs_vars, photosyns_vars, soilhydrology_vars, energyflux_vars, & + PlantMicKinetics_vars, & + phosphorusflux_vars, phosphorusstate_vars) + + ! Description: + ! Update vegetation related state variables and + ! setup fluxes and parameters for plant-microbe coupling in soibgc ! ! !USES: - use CNAllocationBetrMod, only : CNAllocationBetrInit - use CNPhenologyMod , only : CNPhenologyInit - use CNFireMod , only : CNFireInit - use CNC14DecayMod , only : C14_init_BombSpike - ! - ! !ARGUMENTS: + use CNNDynamicsMod , only : CNNDeposition,CNNFixation, CNNFert, CNSoyfix + use CNMRespMod , only : CNMResp + use CNDecompMod , only : CNDecompAlloc + use CNPhenologyBeTRMod , only : CNPhenology + use CNGRespMod , only : CNGResp + use CNCStateUpdate1Mod , only : CStateUpdate1,CStateUpdate0 + use CNNStateUpdate1BeTRMod , only : NStateUpdate1 + use CNGapMortalityBeTRMod , only : CNGapMortality + use CNCStateUpdate2Mod , only : CStateUpdate2, CStateUpdate2h + use CNNStateUpdate2BeTRMod , only : NStateUpdate2, NStateUpdate2h + use CNFireMod , only : CNFireArea, CNFireFluxes + use CNCStateUpdate3Mod , only : CStateUpdate3 + use CNCIsoFluxMod , only : CIsoFlux1, CIsoFlux2, CIsoFlux2h, CIsoFlux3 + use CNC14DecayMod , only : C14Decay, C14BombSpike + use CNWoodProductsMod , only : CNWoodProducts + use CNDecompCascadeBGCMod , only : decomp_rate_constants_bgc + use CNDecompCascadeCNMod , only : decomp_rate_constants_cn + use CropType , only : crop_type + use dynHarvestMod , only : CNHarvest + use clm_varpar , only : crop_prog + use CNCropHarvestPoolsMod , only : CNCropHarvestPools + use PlantMicKineticsMod , only : PlantMicKinetics_type + use CNAllocationBetrMod , only : SetPlantMicNPDemand, CNAllocation3_PlantCNPAlloc + use CNNStateUpdate3BeTRMod , only : NStateUpdate3 + use CNNDynamicsMod , only : CNNFixation_balance + use PStateUpdate1Mod , only : PStateUpdate1 + use PStateUpdate2Mod , only : PStateUpdate2, PStateUpdate2h + use PDynamicsMod , only : PBiochemMin_balance,PDeposition,PWeathering + use CNVerticalProfileMod , only : decomp_vertprofiles + use CNRootDynMod , only : CNRootDyn implicit none - type(bounds_type), intent(in) :: bounds - !----------------------------------------------------------------------- - call CNAllocationBetrInit (bounds) - call CNPhenologyInit (bounds) - call CNFireInit (bounds) - - if ( use_c14 ) then - call C14_init_BombSpike() - end if - - end subroutine CNEcosystemDynBetrInit - !----------------------------------------------------------------------- - subroutine CNEcosystemDynBetrVeg(bounds, & - num_soilc, filter_soilc, & - num_soilp, filter_soilp, num_pcropp, filter_pcropp, doalb, & - cnstate_vars, carbonflux_vars, carbonstate_vars, & - c13_carbonflux_vars, c13_carbonstate_vars, & - c14_carbonflux_vars, c14_carbonstate_vars, & - nitrogenflux_vars, nitrogenstate_vars, & - atm2lnd_vars, waterstate_vars, waterflux_vars, & - canopystate_vars, soilstate_vars, temperature_vars, crop_vars, & - dgvs_vars, photosyns_vars, soilhydrology_vars, energyflux_vars, & - plantsoilnutrientflux_vars, & - phosphorusflux_vars, phosphorusstate_vars) - - ! - ! Update vegetation related state variables and fluxes - ! and obtain some belowground fluxes to be applied in belowground bgc - ! - ! !USES: - use CNNDynamicsMod , only: CNNDeposition,CNNFixation, CNNFert, CNSoyfix - use CNMRespMod , only: CNMResp - use CNDecompMod , only: CNDecompAlloc - use CNPhenologyMod , only: CNPhenology - use CNGRespMod , only: CNGResp - use CNCStateUpdate1Mod , only: CStateUpdate1,CStateUpdate0 - use CNNStateUpdate1Mod , only: NStateUpdate1 - use CNGapMortalityMod , only: CNGapMortality - use CNCStateUpdate2Mod , only: CStateUpdate2, CStateUpdate2h - use CNNStateUpdate2Mod , only: NStateUpdate2, NStateUpdate2h - use CNFireMod , only: CNFireArea, CNFireFluxes - use CNCStateUpdate3Mod , only: CStateUpdate3 - use CNCIsoFluxMod , only: CIsoFlux1, CIsoFlux2, CIsoFlux2h, CIsoFlux3 - use CNC14DecayMod , only: C14Decay, C14BombSpike - use CNWoodProductsMod , only: CNWoodProducts - use CNDecompCascadeBGCMod , only: decomp_rate_constants_bgc - use CNDecompCascadeCNMod , only: decomp_rate_constants_cn - use CropType , only: crop_type - use dynHarvestMod , only: CNHarvest - use clm_varpar , only: crop_prog - use PlantSoilnutrientFluxType , only : plantsoilnutrientflux_type - use CNAllocationBetrMod , only : calc_plant_nutrient_demand - use CNVerticalProfileMod , only : decomp_vertprofiles - use CNAllocationBetrMod , only : plantCNAlloc - use CNNStateUpdate3Mod , only : NStateUpdate3 - implicit none ! ! !ARGUMENTS: - type(bounds_type) , intent(in) :: bounds + type(bounds_type) , intent(in) :: bounds integer , intent(in) :: num_soilc ! number of soil columns in filter integer , intent(in) :: filter_soilc(:) ! filter for soil columns integer , intent(in) :: num_soilp ! number of soil patches in filter @@ -141,426 +118,410 @@ subroutine CNEcosystemDynBetrVeg(bounds, & type(carbonstate_type) , intent(inout) :: c14_carbonstate_vars type(nitrogenflux_type) , intent(inout) :: nitrogenflux_vars type(nitrogenstate_type) , intent(inout) :: nitrogenstate_vars - type(atm2lnd_type) , intent(in) :: atm2lnd_vars + type(atm2lnd_type) , intent(in) :: atm2lnd_vars type(waterstate_type) , intent(in) :: waterstate_vars type(waterflux_type) , intent(in) :: waterflux_vars type(canopystate_type) , intent(in) :: canopystate_vars - type(soilstate_type) , intent(in) :: soilstate_vars + type(soilstate_type) , intent(inout) :: soilstate_vars type(temperature_type) , intent(inout) :: temperature_vars type(crop_type) , intent(inout) :: crop_vars type(dgvs_type) , intent(inout) :: dgvs_vars type(photosyns_type) , intent(in) :: photosyns_vars type(soilhydrology_type) , intent(in) :: soilhydrology_vars type(energyflux_type) , intent(in) :: energyflux_vars - type(plantsoilnutrientflux_type) , intent(inout) :: plantsoilnutrientflux_vars + type(PlantMicKinetics_type) , intent(inout) :: PlantMicKinetics_vars type(phosphorusflux_type) , intent(inout) :: phosphorusflux_vars type(phosphorusstate_type) , intent(inout) :: phosphorusstate_vars - - ! -------------------------------------------------- - ! zero the column-level C and N fluxes - ! -------------------------------------------------- - - call t_startf('CNZero') - call carbonflux_vars%SetValues( & - num_soilp, filter_soilp, 0._r8, & - num_soilc, filter_soilc, 0._r8) + if(.not. use_ed)then + ! -------------------------------------------------- + ! zero the column-level C and N fluxes + ! -------------------------------------------------- - if ( use_c13 ) then - call c13_carbonflux_vars%SetValues( & + call t_startf('CNZero') + + call carbonflux_vars%SetValues( & num_soilp, filter_soilp, 0._r8, & num_soilc, filter_soilc, 0._r8) - end if - - if ( use_c14 ) then - call c14_carbonflux_vars%SetValues( & + + if ( use_c13 ) then + call c13_carbonflux_vars%SetValues( & + num_soilp, filter_soilp, 0._r8, & + num_soilc, filter_soilc, 0._r8) + end if + + if ( use_c14 ) then + call c14_carbonflux_vars%SetValues( & + num_soilp, filter_soilp, 0._r8, & + num_soilc, filter_soilc, 0._r8) + end if + call nitrogenflux_vars%SetValues( & num_soilp, filter_soilp, 0._r8, & num_soilc, filter_soilc, 0._r8) - end if - - call nitrogenflux_vars%SetValues( & - num_soilp, filter_soilp, 0._r8, & - num_soilc, filter_soilc, 0._r8) - - call t_stopf('CNZero') - - ! -------------------------------------------------- - ! Nitrogen Deposition, Fixation and Respiration - ! -------------------------------------------------- - - call t_startf('CNDeposition') - call CNNDeposition(bounds, & - atm2lnd_vars, nitrogenflux_vars) - call t_stopf('CNDeposition') - - call t_startf('CNFixation') - call CNNFixation( num_soilc, filter_soilc, waterflux_vars, & - carbonflux_vars, nitrogenflux_vars) - call t_stopf('CNFixation') - - call t_startf('CNMResp') - if (crop_prog) then - call CNNFert(bounds, num_soilc,filter_soilc, & - nitrogenflux_vars) - - call CNSoyfix(bounds, num_soilc, filter_soilc, num_soilp, filter_soilp, & - waterstate_vars, crop_vars, cnstate_vars, & - nitrogenstate_vars, nitrogenflux_vars) - end if - call CNMResp(bounds, num_soilc, filter_soilc, num_soilp, filter_soilp, & - canopystate_vars, soilstate_vars, temperature_vars, photosyns_vars, & - carbonflux_vars, nitrogenstate_vars) - - call t_stopf('CNMResp') - - !calculate vertical profiles to destribute various variables, this could also pet put outside this block of codes - call decomp_vertprofiles(bounds, num_soilc, filter_soilc, num_soilp, filter_soilp, & - soilstate_vars, canopystate_vars, cnstate_vars) - - call calc_plant_nutrient_demand(bounds, num_soilc, filter_soilc, num_soilp, filter_soilp, & - photosyns_vars, crop_vars, canopystate_vars, & - cnstate_vars, carbonstate_vars, carbonflux_vars, & - c13_carbonflux_vars, c14_carbonflux_vars, & - nitrogenstate_vars, nitrogenflux_vars, plantsoilnutrientflux_vars ) - - call calc_fpg(bounds, num_soilc, filter_soilc, & - plantsoilnutrientflux_vars%plant_totn_demand_flx_col(bounds%begc:bounds%endc), & - nitrogenstate_vars%plant_nbuffer_col(bounds%begc:bounds%endc), & - cnstate_vars%fpg_col(bounds%begc:bounds%endc)) - - call plantCNAlloc(bounds, num_soilc, filter_soilc, num_soilp, filter_soilp, & - photosyns_vars, cnstate_vars, carbonstate_vars, carbonflux_vars, & - c13_carbonflux_vars, c14_carbonflux_vars, nitrogenstate_vars, nitrogenflux_vars) - - !-------------------------------------------- - ! Phenology - !-------------------------------------------- - - ! CNphenology needs to be called after CNdecompAlloc, because it - ! depends on current time-step fluxes to new growth on the last - ! litterfall timestep in deciduous systems - - call t_startf('CNPhenology') - call CNPhenology(num_soilc, filter_soilc, num_soilp, filter_soilp, & - num_pcropp, filter_pcropp, doalb, & - waterstate_vars, temperature_vars, crop_vars, canopystate_vars, soilstate_vars, & - dgvs_vars, cnstate_vars, carbonstate_vars, carbonflux_vars, & - nitrogenstate_vars, nitrogenflux_vars, & - phosphorusstate_vars, phosphorusflux_vars) - call t_stopf('CNPhenology') - - !-------------------------------------------- - ! Growth respiration - !-------------------------------------------- - - call t_startf('CNGResp') - call CNGResp(num_soilp, filter_soilp, & - carbonflux_vars) - - call carbonflux_vars%summary_rr(bounds,num_soilp, filter_soilp, num_soilc, filter_soilc) - call t_stopf('CNGResp') - - !-------------------------------------------- - ! CNUpdate0 - !-------------------------------------------- - - call t_startf('CNUpdate0') - call CStateUpdate0(& - num_soilp, filter_soilp, & - carbonflux_vars, carbonstate_vars) - - if ( use_c13 ) then - call CStateUpdate0(& - num_soilp, filter_soilp, & - c13_carbonflux_vars, c13_carbonstate_vars) - end if + call phosphorusflux_vars%SetValues( & + num_soilp, filter_soilp, 0._r8, & + num_soilc, filter_soilc, 0._r8) - if ( use_c14 ) then + call t_stopf('CNZero') + + ! -------------------------------------------------- + ! Nitrogen Deposition, Fixation and Respiration, phosphorus dynamics + ! -------------------------------------------------- + + call t_startf('CNDeposition') + call CNNDeposition(bounds, & + atm2lnd_vars, nitrogenflux_vars) + call t_stopf('CNDeposition') + + call t_startf('CNMResp') + if (crop_prog) then + call CNNFert(bounds, num_soilc,filter_soilc, & + nitrogenflux_vars) + + end if + call CNMResp(bounds, num_soilc, filter_soilc, num_soilp, filter_soilp, & + canopystate_vars, soilstate_vars, temperature_vars, photosyns_vars, & + carbonflux_vars, nitrogenstate_vars) + call t_stopf('CNMResp') + + ! for P competition purpose, calculate P fluxes that will potentially increase solution P pool + ! then competitors take up solution P + call t_startf('PWeathering') + call PWeathering(num_soilc, filter_soilc, & + cnstate_vars,phosphorusstate_vars,phosphorusflux_vars) + call t_stopf('PWeathering') + + + ! -------------------------------------------------- + ! Phosphorus Deposition ! X.SHI + ! -------------------------------------------------- + + call t_startf('PDeposition') + call PDeposition(bounds, & + atm2lnd_vars, phosphorusflux_vars) + call t_stopf('PDeposition') + + !This specifies the vertical distribution of deposition fluxes and + !root exudates + call decomp_vertprofiles(bounds, & + num_soilc, filter_soilc, num_soilp, filter_soilp, & + soilstate_vars, canopystate_vars, cnstate_vars) +!!-------------------------------------------------------------- + + call t_startf('CNAllocation - phase-1') + call SetPlantMicNPDemand (bounds , & + num_soilc, filter_soilc, num_soilp, filter_soilp , & + photosyns_vars, crop_vars, canopystate_vars, cnstate_vars , & + carbonstate_vars, carbonflux_vars, c13_carbonflux_vars , & + c14_carbonflux_vars, nitrogenstate_vars, nitrogenflux_vars , & + phosphorusstate_vars, phosphorusflux_vars, PlantMicKinetics_vars) + + call t_stopf('CNAllocation - phase-1') + + call t_startf('CNFixation') + !nfixation comes after SetPlantMicNPDemand because it needs cnp ratio + !computed first + call CNNFixation_balance( num_soilc, filter_soilc, & + cnstate_vars, carbonflux_vars, nitrogenstate_vars, nitrogenflux_vars, & + temperature_vars, waterstate_vars, carbonstate_vars, phosphorusstate_vars) + call t_stopf('CNFixation') + + ! nu_com_phosphatase is true + call t_startf('PBiochemMin') + call PBiochemMin_balance(bounds,num_soilc, filter_soilc, & + cnstate_vars,nitrogenstate_vars,phosphorusstate_vars,phosphorusflux_vars) + call t_stopf('PBiochemMin') + + if (crop_prog) then + !be careful about CNSoyfix, it is coded by using CTC-RD formulation + !of CN interactions + call CNSoyfix(bounds, num_soilc, filter_soilc, num_soilp, filter_soilp, & + waterstate_vars, crop_vars, cnstate_vars, & + nitrogenstate_vars, nitrogenflux_vars) + endif + call t_startf('CNAllocation - phase-3') + call CNAllocation3_PlantCNPAlloc (bounds , & + num_soilc, filter_soilc, num_soilp, filter_soilp , & + canopystate_vars , & + cnstate_vars, carbonstate_vars, carbonflux_vars , & + c13_carbonflux_vars, c14_carbonflux_vars , & + nitrogenstate_vars, nitrogenflux_vars , & + phosphorusstate_vars, phosphorusflux_vars) + call t_stopf('CNAllocation - phase-3') + + !-------------------------------------------- + ! Phenology + !-------------------------------------------- + + ! CNphenology needs to be called after CNdecompAlloc, because it + ! depends on current time-step fluxes to new growth on the last + ! litterfall timestep in deciduous systems + + call t_startf('CNPhenology') + call CNPhenology(num_soilc, filter_soilc, num_soilp, filter_soilp, & + num_pcropp, filter_pcropp, doalb, & + waterstate_vars, temperature_vars, crop_vars, canopystate_vars, soilstate_vars, & + dgvs_vars, cnstate_vars, carbonstate_vars, carbonflux_vars, & + nitrogenstate_vars, nitrogenflux_vars,& + phosphorusstate_vars,phosphorusflux_vars) + call t_stopf('CNPhenology') + + + !-------------------------------------------- + ! Growth respiration + !-------------------------------------------- + + call t_startf('CNGResp') + call CNGResp(num_soilp, filter_soilp, & + carbonflux_vars) + call t_stopf('CNGResp') + call carbonflux_vars%summary_rr(bounds, num_soilp, filter_soilp, num_soilc, filter_soilc) + + if(use_c13) then + call c13_carbonflux_vars%summary_rr(bounds, num_soilp, filter_soilp, num_soilc, filter_soilc) + endif + + if(use_c14) then + call c14_carbonflux_vars%summary_rr(bounds, num_soilp, filter_soilp, num_soilc, filter_soilc) + endif + !-------------------------------------------- + ! Dynamic Roots + !-------------------------------------------- + + if( use_dynroot ) then + call t_startf('CNRootDyn') + + call CNRootDyn(bounds, num_soilc, filter_soilc, num_soilp, filter_soilp, & + carbonstate_vars, nitrogenstate_vars, carbonflux_vars, & + cnstate_vars, crop_vars, soilstate_vars) + call t_stopf('CNRootDyn') + end if + + !-------------------------------------------- + ! CNUpdate0 + !-------------------------------------------- + + call t_startf('CNUpdate0') call CStateUpdate0(& num_soilp, filter_soilp, & - c14_carbonflux_vars, c14_carbonstate_vars) - end if - call t_stopf('CNUpdate0') + carbonflux_vars, carbonstate_vars) - !-------------------------------------------- - ! Update1 - !-------------------------------------------- + if ( use_c13 ) then + call CStateUpdate0(& + num_soilp, filter_soilp, & + c13_carbonflux_vars, c13_carbonstate_vars) + end if - call t_startf('CNUpdate1') + if ( use_c14 ) then + call CStateUpdate0(& + num_soilp, filter_soilp, & + c14_carbonflux_vars, c14_carbonstate_vars) + end if + call t_stopf('CNUpdate0') - if ( use_c13 ) then - call CIsoFlux1(num_soilc, filter_soilc, num_soilp, filter_soilp, & - cnstate_vars, carbonflux_vars, carbonstate_vars, & - isotopeflux_vars=c13_carbonflux_vars, isotopestate_vars=c13_carbonstate_vars, & - isotope='c13') - end if + !-------------------------------------------- + ! Update1 + !-------------------------------------------- + + call t_startf('CNUpdate1') + + if ( use_c13 ) then + call CIsoFlux1(num_soilc, filter_soilc, num_soilp, filter_soilp, & + cnstate_vars, carbonflux_vars, carbonstate_vars, & + isotopeflux_vars=c13_carbonflux_vars, isotopestate_vars=c13_carbonstate_vars, & + isotope='c13') + end if + + if ( use_c14 ) then + call CIsoFlux1(num_soilc, filter_soilc, num_soilp, filter_soilp, & + cnstate_vars, carbonflux_vars, carbonstate_vars, & + isotopeflux_vars=c14_carbonflux_vars, isotopestate_vars=c14_carbonstate_vars, & + isotope='c14') + end if - if ( use_c14 ) then - call CIsoFlux1(num_soilc, filter_soilc, num_soilp, filter_soilp, & - cnstate_vars, carbonflux_vars, carbonstate_vars, & - isotopeflux_vars=c14_carbonflux_vars, isotopestate_vars=c14_carbonstate_vars, & - isotope='c14') - end if - - call CStateUpdate1(bounds, num_soilc, filter_soilc, num_soilp, filter_soilp, & - cnstate_vars, carbonflux_vars, carbonstate_vars) - - if ( use_c13 ) then - call CStateUpdate1(bounds, num_soilc, filter_soilc, num_soilp, filter_soilp, & - cnstate_vars, c13_carbonflux_vars, c13_carbonstate_vars) - end if - - if ( use_c14 ) then call CStateUpdate1(bounds, num_soilc, filter_soilc, num_soilp, filter_soilp, & - cnstate_vars, c14_carbonflux_vars, c14_carbonstate_vars) - end if - - call NStateUpdate1(num_soilc, filter_soilc, num_soilp, filter_soilp, & - cnstate_vars, nitrogenflux_vars, nitrogenstate_vars) - call t_stopf('CNUpdate1') - - call t_startf('CNGapMortality') - call CNGapMortality( num_soilc, filter_soilc, num_soilp, filter_soilp, & - dgvs_vars, cnstate_vars, & - carbonstate_vars, nitrogenstate_vars, carbonflux_vars, nitrogenflux_vars, & - phosphorusstate_vars, phosphorusflux_vars) - call t_stopf('CNGapMortality') - - !-------------------------------------------- - ! Update2 - !-------------------------------------------- - - call t_startf('CNUpdate2') - - if ( use_c13 ) then - call CIsoFlux2(num_soilc, filter_soilc, num_soilp, filter_soilp, & - cnstate_vars, carbonflux_vars, carbonstate_vars, & - isotopeflux_vars=c13_carbonflux_vars, isotopestate_vars=c13_carbonstate_vars, & - isotope='c13') - end if - - if ( use_c14 ) then - call CIsoFlux2(num_soilc, filter_soilc, num_soilp, filter_soilp, & - cnstate_vars, carbonflux_vars, carbonstate_vars, & - isotopeflux_vars=c14_carbonflux_vars, isotopestate_vars=c14_carbonstate_vars, & - isotope='c14') - end if - - call CStateUpdate2( num_soilc, filter_soilc, num_soilp, filter_soilp, & - carbonflux_vars, carbonstate_vars) - - if ( use_c13 ) then - call CStateUpdate2(num_soilc, filter_soilc, num_soilp, filter_soilp, & - c13_carbonflux_vars, c13_carbonstate_vars) - end if + cnstate_vars, carbonflux_vars, carbonstate_vars) - if ( use_c14 ) then - call CStateUpdate2(num_soilc, filter_soilc, num_soilp, filter_soilp, & - c14_carbonflux_vars, c14_carbonstate_vars) - end if + if ( use_c13 ) then + call CStateUpdate1(bounds, num_soilc, filter_soilc, num_soilp, filter_soilp, & + cnstate_vars, c13_carbonflux_vars, c13_carbonstate_vars) + end if + if ( use_c14 ) then + call CStateUpdate1(bounds, num_soilc, filter_soilc, num_soilp, filter_soilp, & + cnstate_vars, c14_carbonflux_vars, c14_carbonstate_vars) + end if + + call NStateUpdate1(num_soilc, filter_soilc, num_soilp, filter_soilp, & + cnstate_vars, nitrogenflux_vars, nitrogenstate_vars) + + call PStateUpdate1(num_soilc, filter_soilc, num_soilp, filter_soilp, & + cnstate_vars, phosphorusflux_vars, phosphorusstate_vars) + + call t_stopf('CNUpdate1') + + call t_startf('CNGapMortality') + call CNGapMortality( num_soilc, filter_soilc, num_soilp, filter_soilp, & + dgvs_vars, cnstate_vars, & + carbonstate_vars, nitrogenstate_vars, carbonflux_vars, nitrogenflux_vars,& + phosphorusstate_vars,phosphorusflux_vars ) + call t_stopf('CNGapMortality') + + !-------------------------------------------- + ! Update2 + !-------------------------------------------- + + call t_startf('CNUpdate2') + + if ( use_c13 ) then + call CIsoFlux2(num_soilc, filter_soilc, num_soilp, filter_soilp, & + cnstate_vars, carbonflux_vars, carbonstate_vars, & + isotopeflux_vars=c13_carbonflux_vars, isotopestate_vars=c13_carbonstate_vars, & + isotope='c13') + end if + + if ( use_c14 ) then + call CIsoFlux2(num_soilc, filter_soilc, num_soilp, filter_soilp, & + cnstate_vars, carbonflux_vars, carbonstate_vars, & + isotopeflux_vars=c14_carbonflux_vars, isotopestate_vars=c14_carbonstate_vars, & + isotope='c14') + end if - call NStateUpdate2(num_soilc, filter_soilc, num_soilp, filter_soilp, & - nitrogenflux_vars, nitrogenstate_vars) + call CStateUpdate2( num_soilc, filter_soilc, num_soilp, filter_soilp, & + carbonflux_vars, carbonstate_vars) - if (flanduse_timeseries /= ' ') then - call CNHarvest(num_soilc, filter_soilc, num_soilp, filter_soilp, & - cnstate_vars, carbonstate_vars, nitrogenstate_vars, & - carbonflux_vars, nitrogenflux_vars, & + if ( use_c13 ) then + call CStateUpdate2(num_soilc, filter_soilc, num_soilp, filter_soilp, & + c13_carbonflux_vars, c13_carbonstate_vars) + end if + if ( use_c14 ) then + call CStateUpdate2(num_soilc, filter_soilc, num_soilp, filter_soilp, & + c14_carbonflux_vars, c14_carbonstate_vars) + end if + call NStateUpdate2(num_soilc, filter_soilc, num_soilp, filter_soilp, & + nitrogenflux_vars, nitrogenstate_vars) + + call PStateUpdate2(num_soilc, filter_soilc, num_soilp, filter_soilp, & + phosphorusflux_vars, phosphorusstate_vars) + + if (flanduse_timeseries /= ' ') then + call CNHarvest(num_soilc, filter_soilc, num_soilp, filter_soilp, & + cnstate_vars, carbonstate_vars, nitrogenstate_vars, carbonflux_vars, nitrogenflux_vars,& + phosphorusstate_vars, phosphorusflux_vars) + end if + + if ( use_c13 ) then + call CIsoFlux2h(num_soilc, filter_soilc, num_soilp, filter_soilp, & + cnstate_vars, carbonflux_vars, carbonstate_vars, & + isotopeflux_vars=c13_carbonflux_vars, isotopestate_vars=c13_carbonstate_vars, & + isotope='c13') + end if + if ( use_c14 ) then + call CIsoFlux2h(num_soilc, filter_soilc, num_soilp, filter_soilp, & + cnstate_vars, carbonflux_vars, carbonstate_vars, & + isotopeflux_vars=c14_carbonflux_vars, isotopestate_vars=c14_carbonstate_vars, & + isotope='c14') + end if + + call CStateUpdate2h( num_soilc, filter_soilc, num_soilp, filter_soilp, & + carbonflux_vars, carbonstate_vars) + if ( use_c13 ) then + call CStateUpdate2h(num_soilc, filter_soilc, num_soilp, filter_soilp, & + c13_carbonflux_vars, c13_carbonstate_vars) + end if + if ( use_c14 ) then + call CStateUpdate2h(num_soilc, filter_soilc, num_soilp, filter_soilp, & + c14_carbonflux_vars, c14_carbonstate_vars) + end if + + call NStateUpdate2h(num_soilc, filter_soilc, num_soilp, filter_soilp, & + nitrogenflux_vars, nitrogenstate_vars) + + call PStateUpdate2h(num_soilc, filter_soilc, num_soilp, filter_soilp, & + phosphorusflux_vars, phosphorusstate_vars) + + call CNWoodProducts(num_soilc, filter_soilc, & + carbonstate_vars, c13_carbonstate_vars, c14_carbonstate_vars, nitrogenstate_vars, & + carbonflux_vars, c13_carbonflux_vars, c14_carbonflux_vars, nitrogenflux_vars,& phosphorusstate_vars,phosphorusflux_vars) - end if - - if ( use_c13 ) then - call CIsoFlux2h(num_soilc, filter_soilc, num_soilp, filter_soilp, & - cnstate_vars, carbonflux_vars, carbonstate_vars, & - isotopeflux_vars=c13_carbonflux_vars, & - isotopestate_vars=c13_carbonstate_vars, & - isotope='c13') - end if - - if ( use_c14 ) then - call CIsoFlux2h(num_soilc, filter_soilc, num_soilp, filter_soilp, & - cnstate_vars, carbonflux_vars, carbonstate_vars, & - isotopeflux_vars=c14_carbonflux_vars, & - isotopestate_vars=c14_carbonstate_vars, & - isotope='c14') - end if - - call CStateUpdate2h( num_soilc, filter_soilc, num_soilp, filter_soilp, & - carbonflux_vars, carbonstate_vars) - if ( use_c13 ) then - call CStateUpdate2h(num_soilc, filter_soilc, num_soilp, filter_soilp, & - c13_carbonflux_vars, c13_carbonstate_vars) - end if - if ( use_c14 ) then - call CStateUpdate2h(num_soilc, filter_soilc, num_soilp, filter_soilp, & - c14_carbonflux_vars, c14_carbonstate_vars) - end if - - call NStateUpdate2h(num_soilc, filter_soilc, num_soilp, filter_soilp, & - nitrogenflux_vars, nitrogenstate_vars) - - call CNWoodProducts(num_soilc, filter_soilc, & - carbonstate_vars, c13_carbonstate_vars, c14_carbonstate_vars, nitrogenstate_vars, & - carbonflux_vars, c13_carbonflux_vars, c14_carbonflux_vars, nitrogenflux_vars, & - phosphorusstate_vars, phosphorusflux_vars) - - call CNFireArea(bounds, num_soilc, filter_soilc, num_soilp, filter_soilp, & - atm2lnd_vars, temperature_vars, energyflux_vars, soilhydrology_vars, waterstate_vars, & - cnstate_vars, carbonstate_vars) - - call CNFireFluxes(num_soilc, filter_soilc, num_soilp, filter_soilp, & - dgvs_vars, cnstate_vars, carbonstate_vars, nitrogenstate_vars, & - carbonflux_vars, nitrogenflux_vars, phosphorusstate_vars,phosphorusflux_vars) - - call t_stopf('CNUpdate2') - - !-------------------------------------------- - ! Update3 - !-------------------------------------------- + call CNCropHarvestPools(num_soilc, filter_soilc, & + carbonstate_vars, c13_carbonstate_vars, c14_carbonstate_vars, nitrogenstate_vars, & + phosphorusstate_vars, carbonflux_vars, c13_carbonflux_vars, c14_carbonflux_vars, & + nitrogenflux_vars, phosphorusflux_vars) - if ( use_c13 ) then - call CIsoFlux3(num_soilc, filter_soilc, num_soilp, filter_soilp, & - cnstate_vars, carbonflux_vars, carbonstate_vars, & - isotopeflux_vars=c13_carbonflux_vars, isotopestate_vars=c13_carbonstate_vars, & - isotope='c13') - end if - if ( use_c14 ) then - call CIsoFlux3(num_soilc, filter_soilc, num_soilp, filter_soilp, & - cnstate_vars, carbonflux_vars, carbonstate_vars, & - isotopeflux_vars=c14_carbonflux_vars, isotopestate_vars=c14_carbonstate_vars, & - isotope='c14') - end if + call CNFireArea(bounds, num_soilc, filter_soilc, num_soilp, filter_soilp, & + atm2lnd_vars, temperature_vars, energyflux_vars, soilhydrology_vars, waterstate_vars, & + cnstate_vars, carbonstate_vars) - call CStateUpdate3( num_soilc, filter_soilc, num_soilp, filter_soilp, & - carbonflux_vars, carbonstate_vars) + call CNFireFluxes(num_soilc, filter_soilc, num_soilp, filter_soilp, & + dgvs_vars, cnstate_vars, carbonstate_vars, nitrogenstate_vars, & + carbonflux_vars,nitrogenflux_vars,phosphorusstate_vars,phosphorusflux_vars) - if ( use_c13 ) then - call CStateUpdate3( num_soilc, filter_soilc, num_soilp, filter_soilp, & - c13_carbonflux_vars, c13_carbonstate_vars) - end if + call t_stopf('CNUpdate2') - if ( use_c14 ) then - call CStateUpdate3( num_soilc, filter_soilc, num_soilp, filter_soilp, & - c14_carbonflux_vars, c14_carbonstate_vars) - end if + !-------------------------------------------- + ! Update3 + !-------------------------------------------- + if ( use_c13 ) then + call CIsoFlux3(num_soilc, filter_soilc, num_soilp, filter_soilp, & + cnstate_vars, carbonflux_vars, carbonstate_vars, & + isotopeflux_vars=c13_carbonflux_vars, isotopestate_vars=c13_carbonstate_vars, & + isotope='c13') + end if + if ( use_c14 ) then + call CIsoFlux3(num_soilc, filter_soilc, num_soilp, filter_soilp, & + cnstate_vars, carbonflux_vars, carbonstate_vars, & + isotopeflux_vars=c14_carbonflux_vars, isotopestate_vars=c14_carbonstate_vars, & + isotope='c14') + end if - if ( use_c14 ) then - call C14Decay(num_soilc, filter_soilc, num_soilp, filter_soilp, & - c14_carbonstate_vars) + call CStateUpdate3( num_soilc, filter_soilc, num_soilp, filter_soilp, & + carbonflux_vars, carbonstate_vars) - call C14BombSpike(num_soilp, filter_soilp, & - cnstate_vars) - end if + if ( use_c13 ) then + call CStateUpdate3( num_soilc, filter_soilc, num_soilp, filter_soilp, & + c13_carbonflux_vars, c13_carbonstate_vars) + end if + if ( use_c14 ) then + call CStateUpdate3( num_soilc, filter_soilc, num_soilp, filter_soilp, & + c14_carbonflux_vars, c14_carbonstate_vars) + end if - call t_startf('CNUpdate3') - - call NStateUpdate3(num_soilc, filter_soilc, num_soilp, filter_soilp, & - nitrogenflux_vars, nitrogenstate_vars) - call t_stopf('CNUpdate3') - - end subroutine CNEcosystemDynBetrVeg - - - !------------------------------------------------------------------------------- - subroutine CNEcosystemDynBetrSummary(bounds, & - num_soilc, filter_soilc, & - num_soilp, filter_soilp, num_pcropp, filter_pcropp, doalb, & - cnstate_vars, carbonflux_vars, carbonstate_vars, & - c13_carbonflux_vars, c13_carbonstate_vars, & - c14_carbonflux_vars, c14_carbonstate_vars, & - nitrogenflux_vars, nitrogenstate_vars, & - atm2lnd_vars, waterstate_vars, waterflux_vars, & - canopystate_vars, soilstate_vars, temperature_vars, crop_vars, & - dgvs_vars, photosyns_vars, soilhydrology_vars, energyflux_vars, & - plantsoilnutrientflux_vars, phosphorusstate_vars) - ! - ! this goes after leaching is done - ! !USES: - use CNNDynamicsMod , only: CNNDeposition,CNNFixation, CNNFert, CNSoyfix - use CNMRespMod , only: CNMResp - use CNDecompMod , only: CNDecompAlloc - use CNPhenologyMod , only: CNPhenology - use CNGRespMod , only: CNGResp - use CNCStateUpdate1Mod , only: CStateUpdate1,CStateUpdate0 - use CNNStateUpdate1Mod , only: NStateUpdate1 - use CNGapMortalityMod , only: CNGapMortality - use CNCStateUpdate2Mod , only: CStateUpdate2, CStateUpdate2h - use CNNStateUpdate2Mod , only: NStateUpdate2, NStateUpdate2h - use CNFireMod , only: CNFireArea, CNFireFluxes - use CNCStateUpdate3Mod , only: CStateUpdate3 - use CNCIsoFluxMod , only: CIsoFlux1, CIsoFlux2, CIsoFlux2h, CIsoFlux3 - use CNC14DecayMod , only: C14Decay, C14BombSpike - use CNWoodProductsMod , only: CNWoodProducts - use CNDecompCascadeBGCMod , only: decomp_rate_constants_bgc - use CNDecompCascadeCNMod , only: decomp_rate_constants_cn - use CropType , only: crop_type - use dynHarvestMod , only: CNHarvest - use clm_varpar , only: crop_prog - use PlantSoilnutrientFluxType , only: plantsoilnutrientflux_type - use CNPrecisionControlMod , only: CNPrecisionControl - implicit none - ! - ! !ARGUMENTS: - type(bounds_type) , intent(in) :: bounds - integer , intent(in) :: num_soilc ! number of soil columns in filter - integer , intent(in) :: filter_soilc(:) ! filter for soil columns - integer , intent(in) :: num_soilp ! number of soil patches in filter - integer , intent(in) :: filter_soilp(:) ! filter for soil patches - integer , intent(in) :: num_pcropp ! number of prog. crop patches in filter - integer , intent(in) :: filter_pcropp(:) ! filter for prognostic crop patches - logical , intent(in) :: doalb ! true = surface albedo calculation time step - type(cnstate_type) , intent(inout) :: cnstate_vars - type(carbonflux_type) , intent(inout) :: carbonflux_vars - type(carbonstate_type) , intent(inout) :: carbonstate_vars - type(carbonflux_type) , intent(inout) :: c13_carbonflux_vars - type(carbonstate_type) , intent(inout) :: c13_carbonstate_vars - type(carbonflux_type) , intent(inout) :: c14_carbonflux_vars - type(carbonstate_type) , intent(inout) :: c14_carbonstate_vars - type(nitrogenflux_type) , intent(inout) :: nitrogenflux_vars - type(nitrogenstate_type) , intent(inout) :: nitrogenstate_vars - type(atm2lnd_type) , intent(in) :: atm2lnd_vars - type(waterstate_type) , intent(in) :: waterstate_vars - type(waterflux_type) , intent(in) :: waterflux_vars - type(canopystate_type) , intent(in) :: canopystate_vars - type(soilstate_type) , intent(in) :: soilstate_vars - type(temperature_type) , intent(inout) :: temperature_vars - type(crop_type) , intent(in) :: crop_vars - type(dgvs_type) , intent(inout) :: dgvs_vars - type(photosyns_type) , intent(in) :: photosyns_vars - type(soilhydrology_type) , intent(in) :: soilhydrology_vars - type(energyflux_type) , intent(in) :: energyflux_vars - type(plantsoilnutrientflux_type) , intent(in) :: plantsoilnutrientflux_vars - type(phosphorusstate_type) , intent(inout) :: phosphorusstate_vars + if ( use_c14 ) then + call C14Decay(num_soilc, filter_soilc, num_soilp, filter_soilp, & + c14_carbonstate_vars) + + call C14BombSpike(num_soilp, filter_soilp, & + cnstate_vars) + end if - call nitrogenstate_vars%nbuffer_update(bounds, num_soilc, filter_soilc, & - plantsoilnutrientflux_vars%plant_minn_active_yield_flx_col(bounds%begc:bounds%endc), & - plantsoilnutrientflux_vars%plant_minn_passive_yield_flx_col(bounds%begc:bounds%endc)) + endif - call t_startf('CNsum') - call CNPrecisionControl(num_soilc, filter_soilc, num_soilp, filter_soilp, & - carbonstate_vars, c13_carbonstate_vars, c14_carbonstate_vars, nitrogenstate_vars, & - phosphorusstate_vars) + end subroutine CNEcosystemDynBetr - end subroutine CNEcosystemDynBetrSummary - !----------------------------------------------------------------------- - subroutine CNFluxStateBetrSummary(bounds, num_soilc, filter_soilc, & + !----------------------------------------------------------------------- + subroutine CNFluxStateBetrSummary(bounds, col, pft, num_soilc, filter_soilc, & num_soilp, filter_soilp, & carbonflux_vars, carbonstate_vars, & c13_carbonflux_vars, c13_carbonstate_vars, & c14_carbonflux_vars, c14_carbonstate_vars, & nitrogenflux_vars, nitrogenstate_vars, & - betrtracer_vars, tracerflux_vars, tracerstate_vars) + phosphorusflux_vars, phosphorusstate_vars) ! ! DESCRIPTION ! summarize all fluxes and state varaibles, prepare for mass balance analysis ! + use ColumnType , only : column_physical_properties_type + use VegetationType , only : vegetation_physical_properties_type + use CNPrecisionControlMod, only: CNPrecisionControl implicit none - type(bounds_type) , intent(in) :: bounds + type(bounds_type) , intent(in) :: bounds + type(column_physical_properties_type) , intent(in) :: col + type(vegetation_physical_properties_type) , intent(in) :: pft integer , intent(in) :: num_soilc ! number of soil columns in filter integer , intent(in) :: filter_soilc(:) ! filter for soil columns integer , intent(in) :: num_soilp ! number of soil patches in filter @@ -573,9 +534,13 @@ subroutine CNFluxStateBetrSummary(bounds, num_soilc, filter_soilc, & type(carbonstate_type) , intent(inout) :: c14_carbonstate_vars ! type(nitrogenflux_type) , intent(inout) :: nitrogenflux_vars ! type(nitrogenstate_type) , intent(inout) :: nitrogenstate_vars ! - type(betrtracer_type) , intent(in) :: betrtracer_vars ! betr configuration information - type(tracerstate_type) , intent(in) :: tracerstate_vars ! - type(tracerflux_type) , intent(in) :: tracerflux_vars ! + type(phosphorusflux_type), intent(inout) :: phosphorusflux_vars + type(phosphorusstate_type),intent(inout) :: phosphorusstate_vars + + call t_startf('CNsumBetr') + + call CNPrecisionControl(num_soilc, filter_soilc, num_soilp, filter_soilp, & + carbonstate_vars, c13_carbonstate_vars, c14_carbonstate_vars, nitrogenstate_vars,phosphorusstate_vars) call carbonflux_vars%Summary(bounds, num_soilc, filter_soilc, num_soilp, filter_soilp, 'bulk') @@ -590,50 +555,68 @@ subroutine CNFluxStateBetrSummary(bounds, num_soilc, filter_soilc, & call c14_carbonflux_vars%Summary(bounds, num_soilc, filter_soilc, num_soilp, filter_soilp, 'c14') call c14_carbonstate_vars%Summary(bounds, num_soilc, filter_soilc, num_soilp, filter_soilp) end if + + call update_plant_nutrient_buffer(bounds, col, pft, num_soilc, filter_soilc, num_soilp, filter_soilp, & + nitrogenflux_vars, nitrogenstate_vars, phosphorusflux_vars, phosphorusstate_vars) + call nitrogenflux_vars%Summary(bounds, num_soilc, filter_soilc, num_soilp, filter_soilp) call nitrogenstate_vars%Summary(bounds, num_soilc, filter_soilc, num_soilp, filter_soilp) - call t_stopf('CNsum') + call phosphorusflux_vars%Summary(bounds, num_soilc, filter_soilc, num_soilp, filter_soilp) + call phosphorusstate_vars%Summary(bounds, num_soilc, filter_soilc, num_soilp, filter_soilp) + + + call t_stopf('CNsumBetr') end subroutine CNFluxStateBetrSummary - !----------------------------------------------------------------------- - subroutine calc_fpg(bounds, num_soilc, filter_soilc, plant_totn_demand_flx, plant_nbuffer, fpg) + !----------------------------------------------------------------------- + subroutine update_plant_nutrient_buffer(bounds,col, pft, num_soilc, filter_soilc, num_soilp, filter_soilp, & + nitrogenflux_vars, nitrogenstate_vars, phosphorusflux_vars, phosphorusstate_vars) ! ! DESCRIPTION ! calculate gpp downregulation factor - use PlantSoilnutrientFluxType, only : plantsoilnutrientflux_type - use clm_time_manager , only : get_step_size + use clm_time_manager , only : get_step_size + use ColumnType , only : column_physical_properties_type + use VegetationType , only : vegetation_physical_properties_type + use pftvarcon , only : noveg implicit none - type(bounds_type) , intent(in) :: bounds + type(bounds_type) , intent(in) :: bounds + type(column_physical_properties_type) , intent(in) :: col + type(vegetation_physical_properties_type) , intent(in) :: pft integer , intent(in) :: num_soilc ! number of soil columns in filter - integer , intent(in) :: filter_soilc(:) ! filter for soil columns - real(r8) , intent(inout) :: plant_totn_demand_flx(bounds%begc:bounds%endc) ! - real(r8) , intent(inout) :: plant_nbuffer(bounds%begc:bounds%endc) ! - real(r8) , intent(inout) :: fpg(bounds%begc:bounds%endc) ! + integer , intent(in) :: filter_soilc(:) ! filter for soil columns + integer , intent(in) :: num_soilp + integer , intent(in) :: filter_soilp(:) + type(nitrogenflux_type) , intent(in) :: nitrogenflux_vars ! + type(nitrogenstate_type) , intent(inout) :: nitrogenstate_vars ! + type(phosphorusflux_type), intent(in) :: phosphorusflux_vars + type(phosphorusstate_type),intent(inout) :: phosphorusstate_vars - integer :: fc, c + integer :: fc, c, p real(r8) :: dtime - + associate(& + plant_n_buffer_patch => nitrogenstate_vars%plant_n_buffer_patch , & ! Inout: [real(r8) (:) ] gN/m2 + plant_p_buffer_patch => phosphorusstate_vars%plant_p_buffer_patch , & ! Inout: [real(r8) (:) ] gN/m2 + smin_nh4_to_plant_patch => nitrogenflux_vars%smin_nh4_to_plant_patch , & + smin_no3_to_plant_patch => nitrogenflux_vars%smin_no3_to_plant_patch , & + sminp_to_plant_patch => phosphorusflux_vars%sminp_to_plant_patch & + ) dtime = get_step_size() do fc=1,num_soilc - c = filter_soilc(fc) - ! calculate the fraction of potential growth that can be - ! acheived with the N available to plants - ! now a silly question here is does plant take more than necessary? - if (plant_totn_demand_flx(c) > 0.0_r8) then - fpg(c) = min(plant_nbuffer(c) / (plant_totn_demand_flx(c)*dtime),1._r8) - if(fpg(c)<1._r8)then - plant_nbuffer(c) = 0._r8 - else - plant_nbuffer(c) = plant_nbuffer(c)-plant_totn_demand_flx(c)*dtime - endif - !plant_totn_demand_flx(c) = plant_totn_demand_flx(c)* (1._r8-fpg(c)) - else - fpg(c) = 1.0_r8 - end if + c = filter_soilc(fc) + do p = col%pfti(c), col%pftf(c) + if (pft%active(p).and. (pft%itype(p) .ne. noveg)) then + plant_n_buffer_patch(p) = plant_n_buffer_patch(p) + dtime * & + (smin_nh4_to_plant_patch(p) + smin_no3_to_plant_patch(p)) + + plant_p_buffer_patch(p) = plant_p_buffer_patch(p) + dtime * & + sminp_to_plant_patch(p) + endif + enddo enddo - end subroutine calc_fpg + end associate + end subroutine update_plant_nutrient_buffer end module CNEcosystemDynBetrMod diff --git a/components/clm/src/biogeochem/CNGapMortalityBeTRMod.F90 b/components/clm/src/biogeochem/CNGapMortalityBeTRMod.F90 new file mode 100644 index 000000000000..81da3e979ba3 --- /dev/null +++ b/components/clm/src/biogeochem/CNGapMortalityBeTRMod.F90 @@ -0,0 +1,621 @@ +module CNGapMortalityBeTRMod + + !----------------------------------------------------------------------- + ! !DESCRIPTION: + ! Module holding routines used in gap mortality for coupled carbon + ! nitrogen code. + ! add phosphorus fluxes - X.YANG + ! + ! !USES: + use shr_kind_mod , only : r8 => shr_kind_r8 + use abortutils , only : endrun + use shr_log_mod , only : errMsg => shr_log_errMsg + use CNDVType , only : dgvs_type + use CNStateType , only : cnstate_type + use CNCarbonFluxType , only : carbonflux_type + use CNCarbonStateType , only : carbonstate_type + use CNNitrogenFluxType , only : nitrogenflux_type + use CNNitrogenStateType , only : nitrogenstate_type + use ColumnType , only : col_pp + use VegetationPropertiesType , only : veg_vp + use VegetationType , only : veg_pp + + use PhosphorusFluxType , only : phosphorusflux_type + use PhosphorusStateType , only : phosphorusstate_type + use CNBeTRIndicatorMod + ! + implicit none + save + private + ! + ! !PUBLIC MEMBER FUNCTIONS: + public :: CNGapMortality + public :: readCNGapMortBeTRParams + + type, private :: CNGapMortParamsType + real(r8):: am ! mortality rate based on annual rate, fractional mortality (1/yr) + real(r8):: k_mort ! coeff. of growth efficiency in mortality equation + end type CNGapMortParamsType + + type(CNGapMortParamsType),private :: CNGapMortParamsInst + !----------------------------------------------------------------------- + +contains + + !----------------------------------------------------------------------- + subroutine readCNGapMortBeTRParams ( ncid ) + ! + ! !DESCRIPTION: + ! Read in parameters + ! + ! !USES: + use ncdio_pio , only : file_desc_t,ncd_io + ! + ! !ARGUMENTS: + implicit none + type(file_desc_t),intent(inout) :: ncid ! pio netCDF file id + ! + ! !LOCAL VARIABLES: + character(len=32) :: subname = 'CNGapMortParamsType' + character(len=100) :: errCode = '-Error reading in parameters file:' + logical :: readv ! has variable been read in or not + real(r8) :: tempr ! temporary to read in constant + character(len=100) :: tString ! temp. var for reading + !----------------------------------------------------------------------- + + tString='r_mort' + call ncd_io(varname=trim(tString),data=tempr, flag='read', ncid=ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(__FILE__, __LINE__)) + CNGapMortParamsInst%am=tempr + + tString='k_mort' + call ncd_io(varname=trim(tString),data=tempr, flag='read', ncid=ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(__FILE__, __LINE__)) + CNGapMortParamsInst%k_mort=tempr + + call set_gap_indicators + end subroutine readCNGapMortBeTRParams + + !----------------------------------------------------------------------- + subroutine CNGapMortality (& + num_soilc, filter_soilc, num_soilp, filter_soilp, & + dgvs_vars, cnstate_vars, & + carbonstate_vars, nitrogenstate_vars, carbonflux_vars,nitrogenflux_vars,& + phosphorusstate_vars,phosphorusflux_vars) + ! + ! !DESCRIPTION: + ! Gap-phase mortality routine for coupled carbon-nitrogen code (CN) + ! + ! !USES: + use clm_time_manager , only: get_days_per_year + use clm_varcon , only: secspday + use pftvarcon , only: npcropmin + use clm_varctl , only: use_cndv, spinup_state, spinup_mortality_factor + ! + ! !ARGUMENTS: + integer , intent(in) :: num_soilc ! number of soil columns in filter + integer , intent(in) :: filter_soilc(:) ! column filter for soil points + integer , intent(in) :: num_soilp ! number of soil patches in filter + integer , intent(in) :: filter_soilp(:) ! patch filter for soil points + type(dgvs_type) , intent(inout) :: dgvs_vars + type(cnstate_type) , intent(in) :: cnstate_vars + type(carbonstate_type) , intent(in) :: carbonstate_vars + type(nitrogenstate_type) , intent(in) :: nitrogenstate_vars + type(carbonflux_type) , intent(inout) :: carbonflux_vars + type(nitrogenflux_type) , intent(inout) :: nitrogenflux_vars + + type(phosphorusstate_type) , intent(in) :: phosphorusstate_vars + type(phosphorusflux_type) , intent(inout) :: phosphorusflux_vars + + ! + ! !LOCAL VARIABLES: + integer :: p ! patch index + integer :: fp ! patch filter index + real(r8):: am ! rate for fractional mortality (1/yr) + real(r8):: m ! rate for fractional mortality (1/s) + real(r8):: mort_max ! asymptotic max mortality rate (/yr) + real(r8):: k_mort = 0.3 ! coeff of growth efficiency in mortality equation + !----------------------------------------------------------------------- + + associate( & + ivt => veg_pp%itype , & ! Input: [integer (:) ] pft vegetation type + + woody => veg_vp%woody , & ! Input: [real(r8) (:) ] binary flag for woody lifeform + + greffic => dgvs_vars%greffic_patch , & ! Input: [real(r8) (:) ] + heatstress => dgvs_vars%heatstress_patch , & ! Input: [real(r8) (:) ] + nind => dgvs_vars%nind_patch & ! Output: [real(r8) (:) ] number of individuals (#/m2) added by F. Li and S. Levis + ) + + ! set the mortality rate based on annual rate + am = CNGapMortParamsInst%am + ! set coeff of growth efficiency in mortality equation + k_mort = CNGapMortParamsInst%k_mort + + ! patch loop + do fp = 1,num_soilp + p = filter_soilp(fp) + + if (use_cndv) then + ! Stress mortality from lpj's subr Mortality. + + if (woody(ivt(p)) == 1._r8) then + + if (ivt(p) == 8) then + mort_max = 0.03_r8 ! BDT boreal + else + mort_max = 0.01_r8 ! original value for all patches + end if + + ! heatstress and greffic calculated in Establishment once/yr + + ! Mortality rate inversely related to growth efficiency + ! (Prentice et al 1993) + am = mort_max / (1._r8 + k_mort * greffic(p)) + + ! Mortality rate inversely related to growth efficiency + ! (Prentice et al 1993) + am = mort_max / (1._r8 + k_mort * greffic(p)) + + am = min(1._r8, am + heatstress(p)) + else ! lpj didn't set this for grasses; cn does + ! set the mortality rate based on annual rate + am = CNGapMortParamsInst%am + end if + + end if + + m = am/(get_days_per_year() * secspday) + + !------------------------------------------------------ + ! patch-level gap mortality carbon fluxes + !------------------------------------------------------ + + ! displayed pools + carbonflux_vars%m_leafc_to_litter_patch(p) = carbonstate_vars%leafc_patch(p) * m + carbonflux_vars%m_frootc_to_litter_patch(p) = carbonstate_vars%frootc_patch(p) * m + carbonflux_vars%m_livestemc_to_litter_patch(p) = carbonstate_vars%livestemc_patch(p) * m + carbonflux_vars%m_deadstemc_to_litter_patch(p) = carbonstate_vars%deadstemc_patch(p) * m + carbonflux_vars%m_livecrootc_to_litter_patch(p) = carbonstate_vars%livecrootc_patch(p) * m + carbonflux_vars%m_deadcrootc_to_litter_patch(p) = carbonstate_vars%deadcrootc_patch(p) * m + if (spinup_state >= 1) then + carbonflux_vars%m_deadstemc_to_litter_patch(p) = carbonstate_vars%deadstemc_patch(p) * m * spinup_mortality_factor + carbonflux_vars%m_deadcrootc_to_litter_patch(p) = carbonstate_vars%deadcrootc_patch(p) * m * spinup_mortality_factor + end if + + ! storage pools + carbonflux_vars%m_leafc_storage_to_litter_patch(p) = carbonstate_vars%leafc_storage_patch(p) * m + carbonflux_vars%m_frootc_storage_to_litter_patch(p) = carbonstate_vars%frootc_storage_patch(p) * m + carbonflux_vars%m_livestemc_storage_to_litter_patch(p) = carbonstate_vars%livestemc_storage_patch(p) * m + carbonflux_vars%m_deadstemc_storage_to_litter_patch(p) = carbonstate_vars%deadstemc_storage_patch(p) * m + carbonflux_vars%m_livecrootc_storage_to_litter_patch(p) = carbonstate_vars%livecrootc_storage_patch(p) * m + carbonflux_vars%m_deadcrootc_storage_to_litter_patch(p) = carbonstate_vars%deadcrootc_storage_patch(p) * m + carbonflux_vars%m_gresp_storage_to_litter_patch(p) = carbonstate_vars%gresp_storage_patch(p) * m + + ! transfer pools + carbonflux_vars%m_leafc_xfer_to_litter_patch(p) = carbonstate_vars%leafc_xfer_patch(p) * m + carbonflux_vars%m_frootc_xfer_to_litter_patch(p) = carbonstate_vars%frootc_xfer_patch(p) * m + carbonflux_vars%m_livestemc_xfer_to_litter_patch(p) = carbonstate_vars%livestemc_xfer_patch(p) * m + carbonflux_vars%m_deadstemc_xfer_to_litter_patch(p) = carbonstate_vars%deadstemc_xfer_patch(p) * m + carbonflux_vars%m_livecrootc_xfer_to_litter_patch(p) = carbonstate_vars%livecrootc_xfer_patch(p) * m + carbonflux_vars%m_deadcrootc_xfer_to_litter_patch(p) = carbonstate_vars%deadcrootc_xfer_patch(p) * m + carbonflux_vars%m_gresp_xfer_to_litter_patch(p) = carbonstate_vars%gresp_xfer_patch(p) * m + + !------------------------------------------------------ + ! patch-level gap mortality nitrogen fluxes + !------------------------------------------------------ + + ! displayed pools + nitrogenflux_vars%m_leafn_to_litter_patch(p) = nitrogenstate_vars%leafn_patch(p) * m & + * gap_indicator(gid_m_leafn_to_litter) + nitrogenflux_vars%m_frootn_to_litter_patch(p) = nitrogenstate_vars%frootn_patch(p) * m & + * gap_indicator(gid_m_frootn_to_litter) + nitrogenflux_vars%m_livestemn_to_litter_patch(p) = nitrogenstate_vars%livestemn_patch(p) * m & + * gap_indicator(gid_m_livestemn_to_litter) + nitrogenflux_vars%m_deadstemn_to_litter_patch(p) = nitrogenstate_vars%deadstemn_patch(p) * m & + * gap_indicator(gid_m_deadstemn_to_litter) + nitrogenflux_vars%m_livecrootn_to_litter_patch(p) = nitrogenstate_vars%livecrootn_patch(p) * m & + * gap_indicator(gid_m_livecrootn_to_litter) + nitrogenflux_vars%m_deadcrootn_to_litter_patch(p) = nitrogenstate_vars%deadcrootn_patch(p) * m & + * gap_indicator(gid_m_deadcrootn_to_litter) + + + if (ivt(p) < npcropmin) then + nitrogenflux_vars%m_retransn_to_litter_patch(p) = nitrogenstate_vars%retransn_patch(p) * m & + * gap_indicator(gid_m_retransn_to_litter) + end if + + if (spinup_state >= 1) then + nitrogenflux_vars%m_deadstemn_to_litter_patch(p) = nitrogenflux_vars%m_deadstemn_to_litter_patch(p) * spinup_mortality_factor + nitrogenflux_vars%m_deadcrootn_to_litter_patch(p) = nitrogenflux_vars%m_deadcrootn_to_litter_patch(p) * spinup_mortality_factor + end if + + ! storage pools + nitrogenflux_vars%m_leafn_storage_to_litter_patch(p) = nitrogenstate_vars%leafn_storage_patch(p) * m & + * gap_indicator(gid_m_leafn_storage_to_litter) + nitrogenflux_vars%m_frootn_storage_to_litter_patch(p) = nitrogenstate_vars%frootn_storage_patch(p) * m & + * gap_indicator(gid_m_frootn_storage_to_litter) + nitrogenflux_vars%m_livestemn_storage_to_litter_patch(p) = nitrogenstate_vars%livestemn_storage_patch(p) * m & + * gap_indicator(gid_m_livestemn_storage_to_litter) + nitrogenflux_vars%m_deadstemn_storage_to_litter_patch(p) = nitrogenstate_vars%deadstemn_storage_patch(p) * m & + * gap_indicator(gid_m_deadstemn_storage_to_litter) + nitrogenflux_vars%m_livecrootn_storage_to_litter_patch(p) = nitrogenstate_vars%livecrootn_storage_patch(p) * m & + * gap_indicator(gid_m_livecrootn_storage_to_litter) + nitrogenflux_vars%m_deadcrootn_storage_to_litter_patch(p) = nitrogenstate_vars%deadcrootn_storage_patch(p) * m & + * gap_indicator(gid_m_deadcrootn_storage_to_litter) + + ! transfer pools + nitrogenflux_vars%m_leafn_xfer_to_litter_patch(p) = nitrogenstate_vars%leafn_xfer_patch(p) * m & + * gap_indicator(gid_m_leafn_xfer_to_litter) + nitrogenflux_vars%m_frootn_xfer_to_litter_patch(p) = nitrogenstate_vars%frootn_xfer_patch(p) * m & + * gap_indicator(gid_m_frootn_xfer_to_litter) + nitrogenflux_vars%m_livestemn_xfer_to_litter_patch(p) = nitrogenstate_vars%livestemn_xfer_patch(p) * m & + * gap_indicator(gid_m_livestemn_xfer_to_litter) + nitrogenflux_vars%m_deadstemn_xfer_to_litter_patch(p) = nitrogenstate_vars%deadstemn_xfer_patch(p) * m & + * gap_indicator(gid_m_deadstemn_xfer_to_litter) + nitrogenflux_vars%m_livecrootn_xfer_to_litter_patch(p) = nitrogenstate_vars%livecrootn_xfer_patch(p) * m & + * gap_indicator(gid_m_livecrootn_xfer_to_litter) + nitrogenflux_vars%m_deadcrootn_xfer_to_litter_patch(p) = nitrogenstate_vars%deadcrootn_xfer_patch(p) * m & + * gap_indicator(gid_m_deadcrootn_xfer_to_litter) + + !------------------------------------------------------ + ! patch-level gap mortality phosphorus fluxes + !------------------------------------------------------ + + ! displayed pools + phosphorusflux_vars%m_leafp_to_litter_patch(p) = phosphorusstate_vars%leafp_patch(p) * m + phosphorusflux_vars%m_frootp_to_litter_patch(p) = phosphorusstate_vars%frootp_patch(p) * m + phosphorusflux_vars%m_livestemp_to_litter_patch(p) = phosphorusstate_vars%livestemp_patch(p) * m + phosphorusflux_vars%m_deadstemp_to_litter_patch(p) = phosphorusstate_vars%deadstemp_patch(p) * m + phosphorusflux_vars%m_livecrootp_to_litter_patch(p) = phosphorusstate_vars%livecrootp_patch(p) * m + phosphorusflux_vars%m_deadcrootp_to_litter_patch(p) = phosphorusstate_vars%deadcrootp_patch(p) * m + if (ivt(p) < npcropmin) then + phosphorusflux_vars%m_retransp_to_litter_patch(p) = phosphorusstate_vars%retransp_patch(p) * m + end if + + if (spinup_state >= 1) then + phosphorusflux_vars%m_deadstemp_to_litter_patch(p) = phosphorusstate_vars%deadstemp_patch(p) * m * spinup_mortality_factor + phosphorusflux_vars%m_deadcrootp_to_litter_patch(p) = phosphorusstate_vars%deadcrootp_patch(p) * m * spinup_mortality_factor + end if + + ! storage pools + phosphorusflux_vars%m_leafp_storage_to_litter_patch(p) = phosphorusstate_vars%leafp_storage_patch(p) * m + phosphorusflux_vars%m_frootp_storage_to_litter_patch(p) = phosphorusstate_vars%frootp_storage_patch(p) * m + phosphorusflux_vars%m_livestemp_storage_to_litter_patch(p) = phosphorusstate_vars%livestemp_storage_patch(p) * m + phosphorusflux_vars%m_deadstemp_storage_to_litter_patch(p) = phosphorusstate_vars%deadstemp_storage_patch(p) * m + phosphorusflux_vars%m_livecrootp_storage_to_litter_patch(p) = phosphorusstate_vars%livecrootp_storage_patch(p) * m + phosphorusflux_vars%m_deadcrootp_storage_to_litter_patch(p) = phosphorusstate_vars%deadcrootp_storage_patch(p) * m + + ! transfer pools + phosphorusflux_vars%m_leafp_xfer_to_litter_patch(p) = phosphorusstate_vars%leafp_xfer_patch(p) * m + phosphorusflux_vars%m_frootp_xfer_to_litter_patch(p) = phosphorusstate_vars%frootp_xfer_patch(p) * m + phosphorusflux_vars%m_livestemp_xfer_to_litter_patch(p) = phosphorusstate_vars%livestemp_xfer_patch(p) * m + phosphorusflux_vars%m_deadstemp_xfer_to_litter_patch(p) = phosphorusstate_vars%deadstemp_xfer_patch(p) * m + phosphorusflux_vars%m_livecrootp_xfer_to_litter_patch(p) = phosphorusstate_vars%livecrootp_xfer_patch(p) * m + phosphorusflux_vars%m_deadcrootp_xfer_to_litter_patch(p) = phosphorusstate_vars%deadcrootp_xfer_patch(p) * m + + ! added by F. Li and S. Levis + if (use_cndv) then + if (woody(ivt(p)) == 1._r8)then + if (carbonstate_vars%livestemc_patch(p) + carbonstate_vars%deadstemc_patch(p)> 0._r8)then + nind(p)=nind(p)*(1._r8-m) + else + nind(p) = 0._r8 + end if + end if + end if + + end do ! end of pft loop + + ! gather all pft-level litterfall fluxes to the column + ! for litter C and N inputs + + call CNGapPftToColumn(num_soilc, filter_soilc, & + cnstate_vars, carbonflux_vars, nitrogenflux_vars,phosphorusflux_vars) + + end associate + end subroutine CNGapMortality + + !----------------------------------------------------------------------- + subroutine CNGapPftToColumn ( & + num_soilc, filter_soilc, & + cnstate_vars, carbonflux_vars, nitrogenflux_vars,phosphorusflux_vars) + ! + ! !DESCRIPTION: + ! called in the middle of CNGapMoratlity to gather all pft-level gap mortality fluxes + ! to the column level and assign them to the three litter pools + ! + ! !USES: + use clm_varpar , only : maxpatch_pft, nlevdecomp + ! + ! !ARGUMENTS: + integer , intent(in) :: num_soilc ! number of soil columns in filter + integer , intent(in) :: filter_soilc(:) ! soil column filter + type(cnstate_type) , intent(in) :: cnstate_vars + type(carbonflux_type) , intent(inout) :: carbonflux_vars + type(nitrogenflux_type) , intent(inout) :: nitrogenflux_vars + type(phosphorusflux_type) , intent(inout) :: phosphorusflux_vars + ! + ! !LOCAL VARIABLES: + integer :: fc,c,pi,p,j ! indices + !----------------------------------------------------------------------- + + associate( & + ivt => veg_pp%itype , & ! Input: [integer (:) ] pft vegetation type + wtcol => veg_pp%wtcol , & ! Input: [real(r8) (:) ] pft weight relative to column (0-1) + + lf_flab => veg_vp%lf_flab , & ! Input: [real(r8) (:) ] leaf litter labile fraction + lf_fcel => veg_vp%lf_fcel , & ! Input: [real(r8) (:) ] leaf litter cellulose fraction + lf_flig => veg_vp%lf_flig , & ! Input: [real(r8) (:) ] leaf litter lignin fraction + fr_flab => veg_vp%fr_flab , & ! Input: [real(r8) (:) ] fine root litter labile fraction + fr_fcel => veg_vp%fr_fcel , & ! Input: [real(r8) (:) ] fine root litter cellulose fraction + fr_flig => veg_vp%fr_flig , & ! Input: [real(r8) (:) ] fine root litter lignin fraction + + leaf_prof => cnstate_vars%leaf_prof_patch , & ! Input: [real(r8) (:,:) ] (1/m) profile of leaves + froot_prof => cnstate_vars%froot_prof_patch , & ! Input: [real(r8) (:,:) ] (1/m) profile of fine roots + croot_prof => cnstate_vars%croot_prof_patch , & ! Input: [real(r8) (:,:) ] (1/m) profile of coarse roots + stem_prof => cnstate_vars%stem_prof_patch , & ! Input: [real(r8) (:,:) ] (1/m) profile of stems + + m_leafc_to_litter => carbonflux_vars%m_leafc_to_litter_patch , & ! Input: [real(r8) (:) ] + m_frootc_to_litter => carbonflux_vars%m_frootc_to_litter_patch , & ! Input: [real(r8) (:) ] + m_livestemc_to_litter => carbonflux_vars%m_livestemc_to_litter_patch , & ! Input: [real(r8) (:) ] + m_deadstemc_to_litter => carbonflux_vars%m_deadstemc_to_litter_patch , & ! Input: [real(r8) (:) ] + m_livecrootc_to_litter => carbonflux_vars%m_livecrootc_to_litter_patch , & ! Input: [real(r8) (:) ] + m_deadcrootc_to_litter => carbonflux_vars%m_deadcrootc_to_litter_patch , & ! Input: [real(r8) (:) ] + m_leafc_storage_to_litter => carbonflux_vars%m_leafc_storage_to_litter_patch , & ! Input: [real(r8) (:) ] + m_frootc_storage_to_litter => carbonflux_vars%m_frootc_storage_to_litter_patch , & ! Input: [real(r8) (:) ] + m_livestemc_storage_to_litter => carbonflux_vars%m_livestemc_storage_to_litter_patch , & ! Input: [real(r8) (:) ] + m_deadstemc_storage_to_litter => carbonflux_vars%m_deadstemc_storage_to_litter_patch , & ! Input: [real(r8) (:) ] + m_livecrootc_storage_to_litter => carbonflux_vars%m_livecrootc_storage_to_litter_patch , & ! Input: [real(r8) (:) ] + m_deadcrootc_storage_to_litter => carbonflux_vars%m_deadcrootc_storage_to_litter_patch , & ! Input: [real(r8) (:) ] + m_gresp_storage_to_litter => carbonflux_vars%m_gresp_storage_to_litter_patch , & ! Input: [real(r8) (:) ] + m_leafc_xfer_to_litter => carbonflux_vars%m_leafc_xfer_to_litter_patch , & ! Input: [real(r8) (:) ] + m_frootc_xfer_to_litter => carbonflux_vars%m_frootc_xfer_to_litter_patch , & ! Input: [real(r8) (:) ] + m_livestemc_xfer_to_litter => carbonflux_vars%m_livestemc_xfer_to_litter_patch , & ! Input: [real(r8) (:) ] + m_deadstemc_xfer_to_litter => carbonflux_vars%m_deadstemc_xfer_to_litter_patch , & ! Input: [real(r8) (:) ] + m_livecrootc_xfer_to_litter => carbonflux_vars%m_livecrootc_xfer_to_litter_patch , & ! Input: [real(r8) (:) ] + m_deadcrootc_xfer_to_litter => carbonflux_vars%m_deadcrootc_xfer_to_litter_patch , & ! Input: [real(r8) (:) ] + m_gresp_xfer_to_litter => carbonflux_vars%m_gresp_xfer_to_litter_patch , & ! Input: [real(r8) (:) ] + + m_leafn_to_litter => nitrogenflux_vars%m_leafn_to_litter_patch , & ! Input: [real(r8) (:) ] + m_frootn_to_litter => nitrogenflux_vars%m_frootn_to_litter_patch , & ! Input: [real(r8) (:) ] + m_livestemn_to_litter => nitrogenflux_vars%m_livestemn_to_litter_patch , & ! Input: [real(r8) (:) ] + m_deadstemn_to_litter => nitrogenflux_vars%m_deadstemn_to_litter_patch , & ! Input: [real(r8) (:) ] + m_livecrootn_to_litter => nitrogenflux_vars%m_livecrootn_to_litter_patch , & ! Input: [real(r8) (:) ] + m_deadcrootn_to_litter => nitrogenflux_vars%m_deadcrootn_to_litter_patch , & ! Input: [real(r8) (:) ] + m_retransn_to_litter => nitrogenflux_vars%m_retransn_to_litter_patch , & ! Input: [real(r8) (:) ] + m_leafn_storage_to_litter => nitrogenflux_vars%m_leafn_storage_to_litter_patch , & ! Input: [real(r8) (:) ] + m_frootn_storage_to_litter => nitrogenflux_vars%m_frootn_storage_to_litter_patch , & ! Input: [real(r8) (:) ] + m_livestemn_storage_to_litter => nitrogenflux_vars%m_livestemn_storage_to_litter_patch , & ! Input: [real(r8) (:) ] + m_deadstemn_storage_to_litter => nitrogenflux_vars%m_deadstemn_storage_to_litter_patch , & ! Input: [real(r8) (:) ] + m_livecrootn_storage_to_litter => nitrogenflux_vars%m_livecrootn_storage_to_litter_patch , & ! Input: [real(r8) (:) ] + m_deadcrootn_storage_to_litter => nitrogenflux_vars%m_deadcrootn_storage_to_litter_patch , & ! Input: [real(r8) (:) ] + m_leafn_xfer_to_litter => nitrogenflux_vars%m_leafn_xfer_to_litter_patch , & ! Input: [real(r8) (:) ] + m_frootn_xfer_to_litter => nitrogenflux_vars%m_frootn_xfer_to_litter_patch , & ! Input: [real(r8) (:) ] + m_livestemn_xfer_to_litter => nitrogenflux_vars%m_livestemn_xfer_to_litter_patch , & ! Input: [real(r8) (:) ] + m_deadstemn_xfer_to_litter => nitrogenflux_vars%m_deadstemn_xfer_to_litter_patch , & ! Input: [real(r8) (:) ] + m_livecrootn_xfer_to_litter => nitrogenflux_vars%m_livecrootn_xfer_to_litter_patch , & ! Input: [real(r8) (:) ] + m_deadcrootn_xfer_to_litter => nitrogenflux_vars%m_deadcrootn_xfer_to_litter_patch , & ! Input: [real(r8) (:) ] + + !! add phosphorus -X.YANG + m_leafp_to_litter => phosphorusflux_vars%m_leafp_to_litter_patch , & ! Input: [real(r8) (:) ] + m_frootp_to_litter => phosphorusflux_vars%m_frootp_to_litter_patch , & ! Input: [real(r8) (:) ] + m_livestemp_to_litter => phosphorusflux_vars%m_livestemp_to_litter_patch , & ! Input: [real(r8) (:) ] + m_deadstemp_to_litter => phosphorusflux_vars%m_deadstemp_to_litter_patch , & ! Input: [real(r8) (:) ] + m_livecrootp_to_litter => phosphorusflux_vars%m_livecrootp_to_litter_patch , & ! Input: [real(r8) (:) ] + m_deadcrootp_to_litter => phosphorusflux_vars%m_deadcrootp_to_litter_patch , & ! Input: [real(r8) (:) ] + m_retransp_to_litter => phosphorusflux_vars%m_retransp_to_litter_patch , & ! Input: [real(r8) (:) ] + m_leafp_storage_to_litter => phosphorusflux_vars%m_leafp_storage_to_litter_patch , & ! Input: [real(r8) (:) ] + m_frootp_storage_to_litter => phosphorusflux_vars%m_frootp_storage_to_litter_patch , & ! Input: [real(r8) (:) ] + m_livestemp_storage_to_litter => phosphorusflux_vars%m_livestemp_storage_to_litter_patch , & ! Input: [real(r8) (:) ] + m_deadstemp_storage_to_litter => phosphorusflux_vars%m_deadstemp_storage_to_litter_patch , & ! Input: [real(r8) (:) ] + m_livecrootp_storage_to_litter => phosphorusflux_vars%m_livecrootp_storage_to_litter_patch , & ! Input: [real(r8) (:) ] + m_deadcrootp_storage_to_litter => phosphorusflux_vars%m_deadcrootp_storage_to_litter_patch , & ! Input: [real(r8) (:) ] + m_leafp_xfer_to_litter => phosphorusflux_vars%m_leafp_xfer_to_litter_patch , & ! Input: [real(r8) (:) ] + m_frootp_xfer_to_litter => phosphorusflux_vars%m_frootp_xfer_to_litter_patch , & ! Input: [real(r8) (:) ] + m_livestemp_xfer_to_litter => phosphorusflux_vars%m_livestemp_xfer_to_litter_patch , & ! Input: [real(r8) (:) ] + m_deadstemp_xfer_to_litter => phosphorusflux_vars%m_deadstemp_xfer_to_litter_patch , & ! Input: [real(r8) (:) ] + m_livecrootp_xfer_to_litter => phosphorusflux_vars%m_livecrootp_xfer_to_litter_patch , & ! Input: [real(r8) (:) ] + m_deadcrootp_xfer_to_litter => phosphorusflux_vars%m_deadcrootp_xfer_to_litter_patch , & ! Input: [real(r8) (:) ] + + gap_mortality_c_to_litr_met_c => carbonflux_vars%gap_mortality_c_to_litr_met_c_col , & ! InOut: [real(r8) (:,:) ] C fluxes associated with gap mortality to litter metabolic pool (gC/m3/s) + gap_mortality_c_to_litr_cel_c => carbonflux_vars%gap_mortality_c_to_litr_cel_c_col , & ! InOut: [real(r8) (:,:) ] C fluxes associated with gap mortality to litter cellulose pool (gC/m3/s) + gap_mortality_c_to_litr_lig_c => carbonflux_vars%gap_mortality_c_to_litr_lig_c_col , & ! InOut: [real(r8) (:,:) ] C fluxes associated with gap mortality to litter lignin pool (gC/m3/s) + gap_mortality_c_to_cwdc => carbonflux_vars%gap_mortality_c_to_cwdc_col , & ! InOut: [real(r8) (:,:) ] C fluxes associated with gap mortality to CWD pool (gC/m3/s) + + gap_mortality_n_to_litr_met_n => nitrogenflux_vars%gap_mortality_n_to_litr_met_n_col , & ! InOut: [real(r8) (:,:) ] N fluxes associated with gap mortality to litter metabolic pool (gN/m3/s) + gap_mortality_n_to_litr_cel_n => nitrogenflux_vars%gap_mortality_n_to_litr_cel_n_col , & ! InOut: [real(r8) (:,:) ] N fluxes associated with gap mortality to litter cellulose pool (gN/m3/s) + gap_mortality_n_to_litr_lig_n => nitrogenflux_vars%gap_mortality_n_to_litr_lig_n_col , & ! InOut: [real(r8) (:,:) ] N fluxes associated with gap mortality to litter lignin pool (gN/m3/s) + gap_mortality_n_to_cwdn => nitrogenflux_vars%gap_mortality_n_to_cwdn_col , & ! InOut: [real(r8) (:,:) ] N fluxes associated with gap mortality to CWD pool (gN/m3/s) + + gap_mortality_p_to_litr_met_p => phosphorusflux_vars%gap_mortality_p_to_litr_met_p_col , & ! InOut: [real(r8) (:,:) ] N fluxes associated with gap mortality to litter metabolic pool (gN/m3/s) + gap_mortality_p_to_litr_cel_p => phosphorusflux_vars%gap_mortality_p_to_litr_cel_p_col , & ! InOut: [real(r8) (:,:) ] N fluxes associated with gap mortality to litter cellulose pool (gN/m3/s) + gap_mortality_p_to_litr_lig_p => phosphorusflux_vars%gap_mortality_p_to_litr_lig_p_col , & ! InOut: [real(r8) (:,:) ] N fluxes associated with gap mortality to litter lignin pool (gN/m3/s) + gap_mortality_p_to_cwdp => phosphorusflux_vars%gap_mortality_p_to_cwdp_col & ! InOut: [real(r8) (:,:) ] N fluxes associated with gap mortality to CWD pool (gN/m3/s) + + ) + if(.false.)then + do pi = 1,maxpatch_pft + do fc = 1,num_soilc + c = filter_soilc(fc) + + if (pi <= col_pp%npfts(c)) then + p = col_pp%pfti(c) + pi - 1 + + if (veg_pp%active(p)) then + write(*,*)'====================================' + write(*,*)'01 m_leafn_to_litter =',p,m_leafn_to_litter(p) + write(*,*)'02 m_frootn_to_litter =',p,m_frootn_to_litter(p) + write(*,*)'03 m_retransn_to_litter =',p,m_retransn_to_litter(p) + write(*,*)'04 m_leafn_storage_to_litter =',p,m_leafn_storage_to_litter(p) + write(*,*)'05 m_frootn_storage_to_litter =',p,m_frootn_storage_to_litter(p) + write(*,*)'06 m_livestemn_storage_to_litter =',p,m_livestemn_storage_to_litter(p) + write(*,*)'07 m_deadstemn_storage_to_litter =',p,m_deadstemn_storage_to_litter(p) + write(*,*)'08 m_livecrootn_storage_to_litter=',p,m_livecrootn_storage_to_litter(p) + write(*,*)'09 m_deadcrootn_storage_to_litter=',p,m_deadcrootn_storage_to_litter(p) + write(*,*)'10 m_leafn_xfer_to_litter =',p,m_leafn_xfer_to_litter(p) + write(*,*)'11 m_frootn_xfer_to_litter =',p,m_frootn_xfer_to_litter(p) + !write(*,*)'12 m_livestemn_xfer_to_litter =',p,m_livestemn_xfer_to_litter(p) + !write(*,*)'13 m_deadstemn_xfer_to_litter =',p,m_deadstemn_xfer_to_litter(p) + !write(*,*)'14 m_livecrootn_xfer_to_litter =',p,m_livecrootn_xfer_to_litter(p) + !write(*,*)'15 m_deadcrootn_xfer_to_litter =',p,m_deadcrootn_xfer_to_litter(p) + endif + endif + enddo + enddo + endif + do j = 1,nlevdecomp + do pi = 1,maxpatch_pft + do fc = 1,num_soilc + c = filter_soilc(fc) + + if (pi <= col_pp%npfts(c)) then + p = col_pp%pfti(c) + pi - 1 + + if (veg_pp%active(p)) then + + ! leaf gap mortality carbon fluxes + gap_mortality_c_to_litr_met_c(c,j) = gap_mortality_c_to_litr_met_c(c,j) + & + m_leafc_to_litter(p) * lf_flab(ivt(p)) * wtcol(p) * leaf_prof(p,j) + gap_mortality_c_to_litr_cel_c(c,j) = gap_mortality_c_to_litr_cel_c(c,j) + & + m_leafc_to_litter(p) * lf_fcel(ivt(p)) * wtcol(p) * leaf_prof(p,j) + gap_mortality_c_to_litr_lig_c(c,j) = gap_mortality_c_to_litr_lig_c(c,j) + & + m_leafc_to_litter(p) * lf_flig(ivt(p)) * wtcol(p) * leaf_prof(p,j) + + ! fine root gap mortality carbon fluxes + gap_mortality_c_to_litr_met_c(c,j) = gap_mortality_c_to_litr_met_c(c,j) + & + m_frootc_to_litter(p) * fr_flab(ivt(p)) * wtcol(p) * froot_prof(p,j) + gap_mortality_c_to_litr_cel_c(c,j) = gap_mortality_c_to_litr_cel_c(c,j) + & + m_frootc_to_litter(p) * fr_fcel(ivt(p)) * wtcol(p) * froot_prof(p,j) + gap_mortality_c_to_litr_lig_c(c,j) = gap_mortality_c_to_litr_lig_c(c,j) + & + m_frootc_to_litter(p) * fr_flig(ivt(p)) * wtcol(p) * froot_prof(p,j) + + ! wood gap mortality carbon fluxes + gap_mortality_c_to_cwdc(c,j) = gap_mortality_c_to_cwdc(c,j) + & + (m_livestemc_to_litter(p) + m_deadstemc_to_litter(p)) * wtcol(p) * stem_prof(p,j) + gap_mortality_c_to_cwdc(c,j) = gap_mortality_c_to_cwdc(c,j) + & + (m_livecrootc_to_litter(p) + m_deadcrootc_to_litter(p)) * wtcol(p) * croot_prof(p,j) + ! storage gap mortality carbon fluxes + gap_mortality_c_to_litr_met_c(c,j) = gap_mortality_c_to_litr_met_c(c,j) + & + (m_leafc_storage_to_litter(p) + m_gresp_storage_to_litter(p)) * wtcol(p) * leaf_prof(p,j) + gap_mortality_c_to_litr_met_c(c,j) = gap_mortality_c_to_litr_met_c(c,j) + & + m_frootc_storage_to_litter(p) * wtcol(p) * froot_prof(p,j) + gap_mortality_c_to_litr_met_c(c,j) = gap_mortality_c_to_litr_met_c(c,j) + & + (m_livestemc_storage_to_litter(p) + m_deadstemc_storage_to_litter(p)) * wtcol(p) * stem_prof(p,j) + gap_mortality_c_to_litr_met_c(c,j) = gap_mortality_c_to_litr_met_c(c,j) + & + (m_livecrootc_storage_to_litter(p) + m_deadcrootc_storage_to_litter(p)) * wtcol(p) * croot_prof(p,j) + + ! transfer gap mortality carbon fluxes + gap_mortality_c_to_litr_met_c(c,j) = gap_mortality_c_to_litr_met_c(c,j) + & + (m_leafc_xfer_to_litter(p) + m_gresp_xfer_to_litter(p)) * wtcol(p) * leaf_prof(p,j) + gap_mortality_c_to_litr_met_c(c,j) = gap_mortality_c_to_litr_met_c(c,j) + & + m_frootc_xfer_to_litter(p) * wtcol(p) * froot_prof(p,j) + gap_mortality_c_to_litr_met_c(c,j) = gap_mortality_c_to_litr_met_c(c,j) + & + (m_livestemc_xfer_to_litter(p) + m_deadstemc_xfer_to_litter(p)) * wtcol(p) * stem_prof(p,j) + gap_mortality_c_to_litr_met_c(c,j) = gap_mortality_c_to_litr_met_c(c,j) + & + (m_livecrootc_xfer_to_litter(p) + m_deadcrootc_xfer_to_litter(p)) * wtcol(p) * croot_prof(p,j) + + ! leaf gap mortality nitrogen fluxes + gap_mortality_n_to_litr_met_n(c,j) = gap_mortality_n_to_litr_met_n(c,j) + & + m_leafn_to_litter(p) * lf_flab(ivt(p)) * wtcol(p) * leaf_prof(p,j) + gap_mortality_n_to_litr_cel_n(c,j) = gap_mortality_n_to_litr_cel_n(c,j) + & + m_leafn_to_litter(p) * lf_fcel(ivt(p)) * wtcol(p) * leaf_prof(p,j) + gap_mortality_n_to_litr_lig_n(c,j) = gap_mortality_n_to_litr_lig_n(c,j) + & + m_leafn_to_litter(p) * lf_flig(ivt(p)) * wtcol(p) * leaf_prof(p,j) + + ! fine root litter nitrogen fluxes + gap_mortality_n_to_litr_met_n(c,j) = gap_mortality_n_to_litr_met_n(c,j) + & + m_frootn_to_litter(p) * fr_flab(ivt(p)) * wtcol(p) * froot_prof(p,j) + gap_mortality_n_to_litr_cel_n(c,j) = gap_mortality_n_to_litr_cel_n(c,j) + & + m_frootn_to_litter(p) * fr_fcel(ivt(p)) * wtcol(p) * froot_prof(p,j) + gap_mortality_n_to_litr_lig_n(c,j) = gap_mortality_n_to_litr_lig_n(c,j) + & + m_frootn_to_litter(p) * fr_flig(ivt(p)) * wtcol(p) * froot_prof(p,j) + + ! wood gap mortality nitrogen fluxes + gap_mortality_n_to_cwdn(c,j) = gap_mortality_n_to_cwdn(c,j) + & + (m_livestemn_to_litter(p) + m_deadstemn_to_litter(p)) * wtcol(p) * stem_prof(p,j) + gap_mortality_n_to_cwdn(c,j) = gap_mortality_n_to_cwdn(c,j) + & + (m_livecrootn_to_litter(p) + m_deadcrootn_to_litter(p)) * wtcol(p) * croot_prof(p,j) + + ! retranslocated N pool gap mortality fluxes + gap_mortality_n_to_litr_met_n(c,j) = gap_mortality_n_to_litr_met_n(c,j) + & + m_retransn_to_litter(p) * wtcol(p) * leaf_prof(p,j) + + ! storage gap mortality nitrogen fluxes + gap_mortality_n_to_litr_met_n(c,j) = gap_mortality_n_to_litr_met_n(c,j) + & + m_leafn_storage_to_litter(p) * wtcol(p) * leaf_prof(p,j) + gap_mortality_n_to_litr_met_n(c,j) = gap_mortality_n_to_litr_met_n(c,j) + & + m_frootn_storage_to_litter(p) * wtcol(p) * froot_prof(p,j) + gap_mortality_n_to_litr_met_n(c,j) = gap_mortality_n_to_litr_met_n(c,j) + & + (m_livestemn_storage_to_litter(p) + m_deadstemn_storage_to_litter(p)) * wtcol(p) * stem_prof(p,j) + gap_mortality_n_to_litr_met_n(c,j) = gap_mortality_n_to_litr_met_n(c,j) + & + (m_livecrootn_storage_to_litter(p) + m_deadcrootn_storage_to_litter(p)) * wtcol(p) * croot_prof(p,j) + + ! transfer gap mortality nitrogen fluxes + gap_mortality_n_to_litr_met_n(c,j) = gap_mortality_n_to_litr_met_n(c,j) + & + m_leafn_xfer_to_litter(p) * wtcol(p) * leaf_prof(p,j) + gap_mortality_n_to_litr_met_n(c,j) = gap_mortality_n_to_litr_met_n(c,j) + & + m_frootn_xfer_to_litter(p) * wtcol(p) * froot_prof(p,j) + gap_mortality_n_to_litr_met_n(c,j) = gap_mortality_n_to_litr_met_n(c,j) + & + (m_livestemn_xfer_to_litter(p) + m_deadstemn_xfer_to_litter(p)) * wtcol(p) * stem_prof(p,j) + gap_mortality_n_to_litr_met_n(c,j) = gap_mortality_n_to_litr_met_n(c,j) + & + (m_livecrootn_xfer_to_litter(p) + m_deadcrootn_xfer_to_litter(p)) * wtcol(p) * croot_prof(p,j) + + ! leaf gap mortality phosphorus fluxes + gap_mortality_p_to_litr_met_p(c,j) = gap_mortality_p_to_litr_met_p(c,j) + & + m_leafp_to_litter(p) * lf_flab(ivt(p)) * wtcol(p) * leaf_prof(p,j) + gap_mortality_p_to_litr_cel_p(c,j) = gap_mortality_p_to_litr_cel_p(c,j) + & + m_leafp_to_litter(p) * lf_fcel(ivt(p)) * wtcol(p) * leaf_prof(p,j) + gap_mortality_p_to_litr_lig_p(c,j) = gap_mortality_p_to_litr_lig_p(c,j) + & + m_leafp_to_litter(p) * lf_flig(ivt(p)) * wtcol(p) * leaf_prof(p,j) + + ! fine root litter phosphorus fluxes + gap_mortality_p_to_litr_met_p(c,j) = gap_mortality_p_to_litr_met_p(c,j) + & + m_frootp_to_litter(p) * fr_flab(ivt(p)) * wtcol(p) * froot_prof(p,j) + gap_mortality_p_to_litr_cel_p(c,j) = gap_mortality_p_to_litr_cel_p(c,j) + & + m_frootp_to_litter(p) * fr_fcel(ivt(p)) * wtcol(p) * froot_prof(p,j) + gap_mortality_p_to_litr_lig_p(c,j) = gap_mortality_p_to_litr_lig_p(c,j) + & + m_frootp_to_litter(p) * fr_flig(ivt(p)) * wtcol(p) * froot_prof(p,j) + + ! wood gap mortality phosphorus fluxes + gap_mortality_p_to_cwdp(c,j) = gap_mortality_p_to_cwdp(c,j) + & + (m_livestemp_to_litter(p) + m_deadstemp_to_litter(p)) * wtcol(p) * stem_prof(p,j) + gap_mortality_p_to_cwdp(c,j) = gap_mortality_p_to_cwdp(c,j) + & + (m_livecrootp_to_litter(p) + m_deadcrootp_to_litter(p)) * wtcol(p) * croot_prof(p,j) + + ! retranslocated N pool gap mortality fluxes + gap_mortality_p_to_litr_met_p(c,j) = gap_mortality_p_to_litr_met_p(c,j) + & + m_retransp_to_litter(p) * wtcol(p) * leaf_prof(p,j) + + ! storage gap mortality phosphorus fluxes + gap_mortality_p_to_litr_met_p(c,j) = gap_mortality_p_to_litr_met_p(c,j) + & + m_leafp_storage_to_litter(p) * wtcol(p) * leaf_prof(p,j) + gap_mortality_p_to_litr_met_p(c,j) = gap_mortality_p_to_litr_met_p(c,j) + & + m_frootp_storage_to_litter(p) * wtcol(p) * froot_prof(p,j) + gap_mortality_p_to_litr_met_p(c,j) = gap_mortality_p_to_litr_met_p(c,j) + & + (m_livestemp_storage_to_litter(p) + m_deadstemp_storage_to_litter(p)) * wtcol(p) * stem_prof(p,j) + gap_mortality_p_to_litr_met_p(c,j) = gap_mortality_p_to_litr_met_p(c,j) + & + (m_livecrootp_storage_to_litter(p) + m_deadcrootp_storage_to_litter(p)) * wtcol(p) * croot_prof(p,j) + + ! transfer gap mortality phosphorus fluxes + gap_mortality_p_to_litr_met_p(c,j) = gap_mortality_p_to_litr_met_p(c,j) + & + m_leafp_xfer_to_litter(p) * wtcol(p) * leaf_prof(p,j) + gap_mortality_p_to_litr_met_p(c,j) = gap_mortality_p_to_litr_met_p(c,j) + & + m_frootp_xfer_to_litter(p) * wtcol(p) * froot_prof(p,j) + gap_mortality_p_to_litr_met_p(c,j) = gap_mortality_p_to_litr_met_p(c,j) + & + (m_livestemp_xfer_to_litter(p) + m_deadstemp_xfer_to_litter(p)) * wtcol(p) * stem_prof(p,j) + gap_mortality_p_to_litr_met_p(c,j) = gap_mortality_p_to_litr_met_p(c,j) + & + (m_livecrootp_xfer_to_litter(p) + m_deadcrootp_xfer_to_litter(p)) * wtcol(p) * croot_prof(p,j) + + end if + end if + + end do + end do + end do + + end associate + + end subroutine CNGapPftToColumn + +end module CNGapMortalityBeTRMod diff --git a/components/clm/src/biogeochem/CNNDynamicsMod.F90 b/components/clm/src/biogeochem/CNNDynamicsMod.F90 index 7f50f0181e45..dd8ef0377815 100644 --- a/components/clm/src/biogeochem/CNNDynamicsMod.F90 +++ b/components/clm/src/biogeochem/CNNDynamicsMod.F90 @@ -671,13 +671,14 @@ subroutine CNNFixation_balance(num_soilc, filter_soilc,cnstate_vars, carbonflux_ ! calculate c cost of root n uptake: rastetter 2001, ecosystems, 4(4), 369-388. r_nup = benefit_pgpp_pleafc(p) / max(pnup_pfrootc(p),1e-20_r8) ! calculate fraction of root that is nodulated: wang 2007 gbc doi:10.1029/2006gb002797 + !f_nodule = 1 - min(1.0_r8,r_fix * r_nup / (r_nup*r_nup + 1.e-20_r8) ) f_nodule = 1 - min(1.0_r8,r_fix / r_nup ) ! np limitation factor of n2 fixation (not considered now) ! calculate aqueous N2 concentration and bulk aqueous N2 concentration ! aqueous N2 concentration under pure nitrogen is 6.1e-4 mol/L/atm (based on Hery's law) ! 78% atm * 6.1e-4 mol/L/atm * 28 g/mol * 1e3L/m3 * water content m3/m3 at 10 cm - N2_aq = 0.78_r8 * 6.1e-4_r8 *28 *1e3 * h2osoi_vol(c,4) - km_n2 = 5 ! calibrated value + N2_aq = 0.78_r8 * 6.1e-4_r8 *28._r8 *1.e3_r8 * h2osoi_vol(c,4) + km_n2 = 5._r8 ! calibrated value ! calculate n2 fixation rate for each pft and add it to column total nfix_to_sminn(c) = nfix_to_sminn(c) + vmax_nfix * frootc(p) * cn_scalar(p) *f_nodule * & N2_aq/ (N2_aq + km_n2) * veg_pp%wtcol(p) diff --git a/components/clm/src/biogeochem/CNNStateUpdate1BeTRMod.F90 b/components/clm/src/biogeochem/CNNStateUpdate1BeTRMod.F90 new file mode 100644 index 000000000000..d692b563dec9 --- /dev/null +++ b/components/clm/src/biogeochem/CNNStateUpdate1BeTRMod.F90 @@ -0,0 +1,221 @@ +module CNNStateUpdate1BeTRMod + !----------------------------------------------------------------------- + ! !DESCRIPTION: + ! Module for nitrogen state variable updates, non-mortality fluxes. + ! + ! !USES: + use shr_kind_mod , only: r8 => shr_kind_r8 + use clm_time_manager , only : get_step_size + use clm_varpar , only : nlevdecomp, ndecomp_pools, ndecomp_cascade_transitions + use clm_varpar , only : crop_prog, i_met_lit, i_cel_lit, i_lig_lit, i_cwd + use clm_varctl , only : iulog, use_nitrif_denitrif + use clm_varcon , only : nitrif_n2o_loss_frac + use pftvarcon , only : npcropmin, nc3crop + use VegetationPropertiesType , only : veg_vp + use CNDecompCascadeConType , only : decomp_cascade_con + use CNStateType , only : cnstate_type + use CNNitrogenFluxType , only : nitrogenflux_type + use CNNitrogenStateType , only : nitrogenstate_type + use VegetationType , only : veg_pp + use tracer_varcon , only : is_active_betr_bgc + !! bgc interface & pflotran: + use clm_varctl , only : use_pflotran, pf_cmode + ! + implicit none + save + private + ! + ! !PUBLIC MEMBER FUNCTIONS: + public:: NStateUpdate1 + !----------------------------------------------------------------------- + +contains + + !----------------------------------------------------------------------- + subroutine NStateUpdate1(num_soilc, filter_soilc, num_soilp, filter_soilp, & + cnstate_vars, nitrogenflux_vars, nitrogenstate_vars) + ! + ! !DESCRIPTION: + ! On the radiation time step, update all the prognostic nitrogen state + ! variables (except for gap-phase mortality and fire fluxes) + ! + ! !ARGUMENTS: + integer , intent(in) :: num_soilc ! number of soil columns in filter + integer , intent(in) :: filter_soilc(:) ! filter for soil columns + integer , intent(in) :: num_soilp ! number of soil patches in filter + integer , intent(in) :: filter_soilp(:) ! filter for soil patches + type(cnstate_type) , intent(in) :: cnstate_vars + type(nitrogenflux_type) , intent(inout) :: nitrogenflux_vars + type(nitrogenstate_type) , intent(inout) :: nitrogenstate_vars + ! + ! !LOCAL VARIABLES: + integer :: c,p,j,l,k ! indices + integer :: fp,fc ! lake filter indices + real(r8):: dt ! radiation time step (seconds) + real(r8), parameter :: frootc_nfix_thc = 10._r8 !threshold fine root carbon for nitrogen fixation gC/m2 + !----------------------------------------------------------------------- + + associate( & + ivt => veg_pp%itype , & ! Input: [integer (:) ] pft vegetation type + + woody => veg_vp%woody , & ! Input: [real(r8) (:) ] binary flag for woody lifeform (1=woody, 0=not woody) + + cascade_donor_pool => decomp_cascade_con%cascade_donor_pool , & ! Input: [integer (:) ] which pool is C taken from for a given decomposition step + cascade_receiver_pool => decomp_cascade_con%cascade_receiver_pool , & ! Input: [integer (:) ] which pool is C added to for a given decomposition step + + ndep_prof => cnstate_vars%ndep_prof_col , & ! Input: [real(r8) (:,:) ] profile over which N deposition is distributed through column (1/m) + nfixation_prof => cnstate_vars%nfixation_prof_col , & ! Input: [real(r8) (:,:) ] profile over which N fixation is distributed through column (1/m) + + nf => nitrogenflux_vars , & + ns => nitrogenstate_vars & + ) + + ! set time steps + dt = real( get_step_size(), r8 ) + + ! column-level fluxes + + ! seeding fluxes, from dynamic landcover + do fc = 1,num_soilc + c = filter_soilc(fc) + ns%seedn_col(c) = ns%seedn_col(c) - nf%dwt_seedn_to_leaf_col(c) * dt + ns%seedn_col(c) = ns%seedn_col(c) - nf%dwt_seedn_to_deadstem_col(c) * dt + end do + + + ! patch loop + + do fp = 1,num_soilp + p = filter_soilp(fp) + + ! phenology: transfer growth fluxes + ns%leafn_patch(p) = ns%leafn_patch(p) + nf%leafn_xfer_to_leafn_patch(p)*dt + ns%leafn_xfer_patch(p) = ns%leafn_xfer_patch(p) - nf%leafn_xfer_to_leafn_patch(p)*dt + ns%frootn_patch(p) = ns%frootn_patch(p) + nf%frootn_xfer_to_frootn_patch(p)*dt + ns%frootn_xfer_patch(p) = ns%frootn_xfer_patch(p) - nf%frootn_xfer_to_frootn_patch(p)*dt + + if (woody(ivt(p)) == 1.0_r8) then + ns%livestemn_patch(p) = ns%livestemn_patch(p) + nf%livestemn_xfer_to_livestemn_patch(p)*dt + ns%livestemn_xfer_patch(p) = ns%livestemn_xfer_patch(p) - nf%livestemn_xfer_to_livestemn_patch(p)*dt + ns%deadstemn_patch(p) = ns%deadstemn_patch(p) + nf%deadstemn_xfer_to_deadstemn_patch(p)*dt + ns%deadstemn_xfer_patch(p) = ns%deadstemn_xfer_patch(p) - nf%deadstemn_xfer_to_deadstemn_patch(p)*dt + ns%livecrootn_patch(p) = ns%livecrootn_patch(p) + nf%livecrootn_xfer_to_livecrootn_patch(p)*dt + ns%livecrootn_xfer_patch(p) = ns%livecrootn_xfer_patch(p) - nf%livecrootn_xfer_to_livecrootn_patch(p)*dt + ns%deadcrootn_patch(p) = ns%deadcrootn_patch(p) + nf%deadcrootn_xfer_to_deadcrootn_patch(p)*dt + ns%deadcrootn_xfer_patch(p) = ns%deadcrootn_xfer_patch(p) - nf%deadcrootn_xfer_to_deadcrootn_patch(p)*dt + end if + + if (ivt(p) >= npcropmin) then ! skip 2 generic crops + ! lines here for consistency; the transfer terms are zero + ns%livestemn_patch(p) = ns%livestemn_patch(p) + nf%livestemn_xfer_to_livestemn_patch(p)*dt + ns%livestemn_xfer_patch(p) = ns%livestemn_xfer_patch(p) - nf%livestemn_xfer_to_livestemn_patch(p)*dt + ns%grainn_patch(p) = ns%grainn_patch(p) + nf%grainn_xfer_to_grainn_patch(p)*dt + ns%grainn_xfer_patch(p) = ns%grainn_xfer_patch(p) - nf%grainn_xfer_to_grainn_patch(p)*dt + end if + + ! phenology: litterfall and retranslocation fluxes + ns%leafn_patch(p) = ns%leafn_patch(p) - nf%leafn_to_litter_patch(p)*dt + ns%frootn_patch(p) = ns%frootn_patch(p) - nf%frootn_to_litter_patch(p)*dt + ns%leafn_patch(p) = ns%leafn_patch(p) - nf%leafn_to_retransn_patch(p)*dt + ns%retransn_patch(p) = ns%retransn_patch(p) + nf%leafn_to_retransn_patch(p)*dt + + ! live wood turnover and retranslocation fluxes + if (woody(ivt(p)) == 1._r8) then + ns%livestemn_patch(p) = ns%livestemn_patch(p) - nf%livestemn_to_deadstemn_patch(p)*dt + ns%deadstemn_patch(p) = ns%deadstemn_patch(p) + nf%livestemn_to_deadstemn_patch(p)*dt + ns%livestemn_patch(p) = ns%livestemn_patch(p) - nf%livestemn_to_retransn_patch(p)*dt + ns%retransn_patch(p) = ns%retransn_patch(p) + nf%livestemn_to_retransn_patch(p)*dt + ns%livecrootn_patch(p) = ns%livecrootn_patch(p) - nf%livecrootn_to_deadcrootn_patch(p)*dt + ns%deadcrootn_patch(p) = ns%deadcrootn_patch(p) + nf%livecrootn_to_deadcrootn_patch(p)*dt + ns%livecrootn_patch(p) = ns%livecrootn_patch(p) - nf%livecrootn_to_retransn_patch(p)*dt + ns%retransn_patch(p) = ns%retransn_patch(p) + nf%livecrootn_to_retransn_patch(p)*dt + end if + if (ivt(p) >= npcropmin) then ! Beth adds retrans from froot + ns%frootn_patch(p) = ns%frootn_patch(p) - nf%frootn_to_retransn_patch(p)*dt + ns%retransn_patch(p) = ns%retransn_patch(p) + nf%frootn_to_retransn_patch(p)*dt + ns%livestemn_patch(p) = ns%livestemn_patch(p) - nf%livestemn_to_litter_patch(p)*dt + ns%livestemn_patch(p) = ns%livestemn_patch(p) - nf%livestemn_to_retransn_patch(p)*dt + ns%retransn_patch(p) = ns%retransn_patch(p) + nf%livestemn_to_retransn_patch(p)*dt + ns%grainn_patch(p) = ns%grainn_patch(p) - nf%grainn_to_food_patch(p)*dt + end if + + ! uptake from soil mineral N pool + ns%npool_patch(p) = & + ns%npool_patch(p) + nf%sminn_to_npool_patch(p)*dt + !write(*,*)'sminn uptake',p,nf%sminn_to_npool_patch(p)*dt + ! deployment from retranslocation pool + ns%npool_patch(p) = ns%npool_patch(p) + nf%retransn_to_npool_patch(p)*dt + ns%retransn_patch(p) = ns%retransn_patch(p) - nf%retransn_to_npool_patch(p)*dt + + ! allocation fluxes + ns%npool_patch(p) = ns%npool_patch(p) - nf%npool_to_leafn_patch(p)*dt + ns%leafn_patch(p) = ns%leafn_patch(p) + nf%npool_to_leafn_patch(p)*dt + ns%npool_patch(p) = ns%npool_patch(p) - nf%npool_to_leafn_storage_patch(p)*dt + ns%leafn_storage_patch(p) = ns%leafn_storage_patch(p) + nf%npool_to_leafn_storage_patch(p)*dt + ns%npool_patch(p) = ns%npool_patch(p) - nf%npool_to_frootn_patch(p)*dt + ns%frootn_patch(p) = ns%frootn_patch(p) + nf%npool_to_frootn_patch(p)*dt + ns%npool_patch(p) = ns%npool_patch(p) - nf%npool_to_frootn_storage_patch(p)*dt + ns%frootn_storage_patch(p) = ns%frootn_storage_patch(p) + nf%npool_to_frootn_storage_patch(p)*dt + + if (woody(ivt(p)) == 1._r8) then + ns%npool_patch(p) = ns%npool_patch(p) - nf%npool_to_livestemn_patch(p)*dt + ns%livestemn_patch(p) = ns%livestemn_patch(p) + nf%npool_to_livestemn_patch(p)*dt + ns%npool_patch(p) = ns%npool_patch(p) - nf%npool_to_livestemn_storage_patch(p)*dt + ns%livestemn_storage_patch(p) = ns%livestemn_storage_patch(p) + nf%npool_to_livestemn_storage_patch(p)*dt + ns%npool_patch(p) = ns%npool_patch(p) - nf%npool_to_deadstemn_patch(p)*dt + ns%deadstemn_patch(p) = ns%deadstemn_patch(p) + nf%npool_to_deadstemn_patch(p)*dt + ns%npool_patch(p) = ns%npool_patch(p) - nf%npool_to_deadstemn_storage_patch(p)*dt + ns%deadstemn_storage_patch(p) = ns%deadstemn_storage_patch(p) + nf%npool_to_deadstemn_storage_patch(p)*dt + ns%npool_patch(p) = ns%npool_patch(p) - nf%npool_to_livecrootn_patch(p)*dt + ns%livecrootn_patch(p) = ns%livecrootn_patch(p) + nf%npool_to_livecrootn_patch(p)*dt + ns%npool_patch(p) = ns%npool_patch(p) - nf%npool_to_livecrootn_storage_patch(p)*dt + ns%livecrootn_storage_patch(p) = ns%livecrootn_storage_patch(p) + nf%npool_to_livecrootn_storage_patch(p)*dt + ns%npool_patch(p) = ns%npool_patch(p) - nf%npool_to_deadcrootn_patch(p)*dt + ns%deadcrootn_patch(p) = ns%deadcrootn_patch(p) + nf%npool_to_deadcrootn_patch(p)*dt + ns%npool_patch(p) = ns%npool_patch(p) - nf%npool_to_deadcrootn_storage_patch(p)*dt + ns%deadcrootn_storage_patch(p) = ns%deadcrootn_storage_patch(p) + nf%npool_to_deadcrootn_storage_patch(p)*dt + end if + + if (ivt(p) >= npcropmin) then ! skip 2 generic crops + ns%npool_patch(p) = ns%npool_patch(p) - nf%npool_to_livestemn_patch(p)*dt + ns%livestemn_patch(p) = ns%livestemn_patch(p) + nf%npool_to_livestemn_patch(p)*dt + ns%npool_patch(p) = ns%npool_patch(p) - nf%npool_to_livestemn_storage_patch(p)*dt + ns%livestemn_storage_patch(p) = ns%livestemn_storage_patch(p) + nf%npool_to_livestemn_storage_patch(p)*dt + ns%npool_patch(p) = ns%npool_patch(p) - nf%npool_to_grainn_patch(p)*dt + ns%grainn_patch(p) = ns%grainn_patch(p) + nf%npool_to_grainn_patch(p)*dt + ns%npool_patch(p) = ns%npool_patch(p) - nf%npool_to_grainn_storage_patch(p)*dt + ns%grainn_storage_patch(p) = ns%grainn_storage_patch(p) + nf%npool_to_grainn_storage_patch(p)*dt + end if + + ! move storage pools into transfer pools + ns%leafn_storage_patch(p) = ns%leafn_storage_patch(p) - nf%leafn_storage_to_xfer_patch(p)*dt + ns%leafn_xfer_patch(p) = ns%leafn_xfer_patch(p) + nf%leafn_storage_to_xfer_patch(p)*dt + ns%frootn_storage_patch(p) = ns%frootn_storage_patch(p) - nf%frootn_storage_to_xfer_patch(p)*dt + ns%frootn_xfer_patch(p) = ns%frootn_xfer_patch(p) + nf%frootn_storage_to_xfer_patch(p)*dt + + if (woody(ivt(p)) == 1._r8) then + ns%livestemn_storage_patch(p) = ns%livestemn_storage_patch(p) - nf%livestemn_storage_to_xfer_patch(p)*dt + ns%livestemn_xfer_patch(p) = ns%livestemn_xfer_patch(p) + nf%livestemn_storage_to_xfer_patch(p)*dt + ns%deadstemn_storage_patch(p) = ns%deadstemn_storage_patch(p) - nf%deadstemn_storage_to_xfer_patch(p)*dt + ns%deadstemn_xfer_patch(p) = ns%deadstemn_xfer_patch(p) + nf%deadstemn_storage_to_xfer_patch(p)*dt + ns%livecrootn_storage_patch(p) = ns%livecrootn_storage_patch(p) - nf%livecrootn_storage_to_xfer_patch(p)*dt + ns%livecrootn_xfer_patch(p) = ns%livecrootn_xfer_patch(p) + nf%livecrootn_storage_to_xfer_patch(p)*dt + ns%deadcrootn_storage_patch(p) = ns%deadcrootn_storage_patch(p) - nf%deadcrootn_storage_to_xfer_patch(p)*dt + ns%deadcrootn_xfer_patch(p) = ns%deadcrootn_xfer_patch(p) + nf%deadcrootn_storage_to_xfer_patch(p)*dt + end if + + if (ivt(p) >= npcropmin) then ! skip 2 generic crops + ! lines here for consistency; the transfer terms are zero + ns%livestemn_storage_patch(p) = ns%livestemn_storage_patch(p) - nf%livestemn_storage_to_xfer_patch(p)*dt + ns%livestemn_xfer_patch(p) = ns%livestemn_xfer_patch(p) + nf%livestemn_storage_to_xfer_patch(p)*dt + ns%grainn_storage_patch(p) = ns%grainn_storage_patch(p) - nf%grainn_storage_to_xfer_patch(p)*dt + ns%grainn_xfer_patch(p) = ns%grainn_xfer_patch(p) + nf%grainn_storage_to_xfer_patch(p)*dt + end if + + end do + + end associate + + end subroutine NStateUpdate1 + +end module CNNStateUpdate1BeTRMod diff --git a/components/clm/src/biogeochem/CNNStateUpdate1Mod.F90 b/components/clm/src/biogeochem/CNNStateUpdate1Mod.F90 index 1ec30ff6ab12..b9257b82eaee 100644 --- a/components/clm/src/biogeochem/CNNStateUpdate1Mod.F90 +++ b/components/clm/src/biogeochem/CNNStateUpdate1Mod.F90 @@ -17,6 +17,7 @@ module CNNStateUpdate1Mod use CNNitrogenFluxType , only : nitrogenflux_type use CNNitrogenStateType , only : nitrogenstate_type use VegetationType , only : veg_pp + use tracer_varcon , only : is_active_betr_bgc !! bgc interface & pflotran: use clm_varctl , only : use_pflotran, pf_cmode ! @@ -82,54 +83,7 @@ subroutine NStateUpdate1(num_soilc, filter_soilc, num_soilp, filter_soilp, & ns%seedn_col(c) = ns%seedn_col(c) - nf%dwt_seedn_to_deadstem_col(c) * dt end do - if (is_active_betr_bgc) then - !summarize Organic N input and mineral nitrogen input from litter, deposition, fixation and fertilization - do fc = 1, num_soilc - c = filter_soilc(fc) - ns%plant_nbuffer_col(c) = ns%plant_nbuffer_col(c) + nf%nfix_to_sminn_col(c)*dt * exp(-cnstate_vars%frootc_nfix_scalar_col(c)/frootc_nfix_thc) - enddo - - do j = 1, nlevdecomp - do fc = 1,num_soilc - c = filter_soilc(fc) - ! N deposition and fixation (put all into NH4 pool) - nf%sminn_nh4_input_vr_col(c,j) = nf%sminn_nh4_input_vr_col(c,j) + nf%ndep_to_sminn_col(c)*dt * ndep_prof(c,j) - !now a fraction of fixed nitrogen is first added to plant nitrogen pool - nf%sminn_nh4_input_vr_col(c,j) = nf%sminn_nh4_input_vr_col(c,j) + nf%nfix_to_sminn_col(c)*dt * nfixation_prof(c,j) * (1._r8-exp(-cnstate_vars%frootc_nfix_scalar_col(c)/frootc_nfix_thc)) - - ! plant to litter fluxes - ! phenology and dynamic landcover fluxes - nf%bgc_npool_ext_inputs_vr_col(c,j,i_met_lit) = nf%bgc_npool_ext_inputs_vr_col(c,j,i_met_lit) + & - ( nf%phenology_n_to_litr_met_n_col(c,j) + nf%dwt_frootn_to_litr_met_n_col(c,j) ) * dt - - nf%bgc_npool_ext_inputs_vr_col(c,j,i_cel_lit) = nf%bgc_npool_ext_inputs_vr_col(c,j,i_cel_lit) + & - ( nf%phenology_n_to_litr_cel_n_col(c,j) + nf%dwt_frootn_to_litr_cel_n_col(c,j) ) * dt - - nf%bgc_npool_ext_inputs_vr_col(c,j,i_lig_lit) = nf%bgc_npool_ext_inputs_vr_col(c,j,i_lig_lit) + & - ( nf%phenology_n_to_litr_lig_n_col(c,j) + nf%dwt_frootn_to_litr_lig_n_col(c,j) ) * dt - - nf%bgc_npool_ext_inputs_vr_col(c,j,i_cwd) = nf%bgc_npool_ext_inputs_vr_col(c,j,i_cwd) + & - ( nf%dwt_livecrootn_to_cwdn_col(c,j) + nf%dwt_deadcrootn_to_cwdn_col(c,j) ) * dt - enddo - enddo - - ! repeating N dep and fixation for crops - if ( crop_prog )then - do j = 1, nlevdecomp - - ! column loop - do fc = 1,num_soilc - c = filter_soilc(fc) - - ! N deposition and fixation (put all into NH4 pool) - nf%sminn_nh4_input_vr_col(c,j) = nf%sminn_nh4_input_vr_col(c,j) + nf%fert_to_sminn_col(c)*dt * ndep_prof(c,j) - nf%sminn_nh4_input_vr_col(c,j) = nf%sminn_nh4_input_vr_col(c,j) + nf%soyfixn_to_sminn_col(c)*dt * nfixation_prof(c,j) - nf%sminn_nh4_input_vr_col(c,j) = nf%sminn_nh4_input_vr_col(c,j) + nf%supplement_to_sminn_vr_col(c,j)*dt - end do - end do - end if - - elseif (.not.(use_pflotran .and. pf_cmode)) then + if (.not. is_active_betr_bgc .and. .not.(use_pflotran .and. pf_cmode)) then do j = 1, nlevdecomp do fc = 1,num_soilc diff --git a/components/clm/src/biogeochem/CNNStateUpdate2BeTRMod.F90 b/components/clm/src/biogeochem/CNNStateUpdate2BeTRMod.F90 new file mode 100644 index 000000000000..e46075fe7ab4 --- /dev/null +++ b/components/clm/src/biogeochem/CNNStateUpdate2BeTRMod.F90 @@ -0,0 +1,177 @@ +module CNNStateUpdate2BeTRMod + + !----------------------------------------------------------------------- + ! !DESCRIPTION: + ! Module for nitrogen state variable update, mortality fluxes. + ! + ! !USES: + use shr_kind_mod , only : r8 => shr_kind_r8 + use clm_time_manager , only : get_step_size + use clm_varpar , only : nlevsoi, nlevdecomp + use clm_varpar , only : i_met_lit, i_cel_lit, i_lig_lit, i_cwd + use clm_varctl , only : iulog + use CNNitrogenStateType , only : nitrogenstate_type + use CNNitrogenFLuxType , only : nitrogenflux_type + use VegetationType , only : veg_pp + use pftvarcon , only : npcropmin + !! bgc interface & pflotran: + use clm_varctl , only : use_pflotran, pf_cmode + ! + implicit none + save + private + ! + ! !PUBLIC MEMBER FUNCTIONS: + public:: NStateUpdate2 + public:: NStateUpdate2h + !----------------------------------------------------------------------- + +contains + + !----------------------------------------------------------------------- + subroutine NStateUpdate2(num_soilc, filter_soilc, num_soilp, filter_soilp, & + nitrogenflux_vars, nitrogenstate_vars) + ! + ! !DESCRIPTION: + ! On the radiation time step, update all the prognostic nitrogen state + ! variables affected by gap-phase mortality fluxes + ! NOTE - associate statements have been removed where there are + ! no science equations. This increases readability and maintainability + ! + use tracer_varcon, only : is_active_betr_bgc + ! !ARGUMENTS: + integer , intent(in) :: num_soilc ! number of soil columns in filter + integer , intent(in) :: filter_soilc(:) ! filter for soil columns + integer , intent(in) :: num_soilp ! number of soil patches in filter + integer , intent(in) :: filter_soilp(:) ! filter for soil patches + type(nitrogenflux_type) , intent(inout) :: nitrogenflux_vars + type(nitrogenstate_type) , intent(inout) :: nitrogenstate_vars + ! + ! !LOCAL VARIABLES: + integer :: c,p,j,l ! indices + integer :: fp,fc ! lake filter indices + real(r8) :: dt ! radiation time step (seconds) + !----------------------------------------------------------------------- + + associate( & + nf => nitrogenflux_vars , & + ns => nitrogenstate_vars & + ) + + ! set time steps + dt = real( get_step_size(), r8 ) + + ! patch -level nitrogen fluxes from gap-phase mortality + + do fp = 1,num_soilp + p = filter_soilp(fp) + + ! displayed pools + ns%leafn_patch(p) = ns%leafn_patch(p) - nf%m_leafn_to_litter_patch(p) * dt + ns%frootn_patch(p) = ns%frootn_patch(p) - nf%m_frootn_to_litter_patch(p) * dt + ns%livestemn_patch(p) = ns%livestemn_patch(p) - nf%m_livestemn_to_litter_patch(p) * dt + ns%deadstemn_patch(p) = ns%deadstemn_patch(p) - nf%m_deadstemn_to_litter_patch(p) * dt + ns%livecrootn_patch(p) = ns%livecrootn_patch(p) - nf%m_livecrootn_to_litter_patch(p) * dt + ns%deadcrootn_patch(p) = ns%deadcrootn_patch(p) - nf%m_deadcrootn_to_litter_patch(p) * dt + ns%retransn_patch(p) = ns%retransn_patch(p) - nf%m_retransn_to_litter_patch(p) * dt + + ! storage pools + ns%leafn_storage_patch(p) = ns%leafn_storage_patch(p) - nf%m_leafn_storage_to_litter_patch(p) * dt + ns%frootn_storage_patch(p) = ns%frootn_storage_patch(p) - nf%m_frootn_storage_to_litter_patch(p) * dt + ns%livestemn_storage_patch(p) = ns%livestemn_storage_patch(p) - nf%m_livestemn_storage_to_litter_patch(p) * dt + ns%deadstemn_storage_patch(p) = ns%deadstemn_storage_patch(p) - nf%m_deadstemn_storage_to_litter_patch(p) * dt + ns%livecrootn_storage_patch(p) = ns%livecrootn_storage_patch(p) - nf%m_livecrootn_storage_to_litter_patch(p) * dt + ns%deadcrootn_storage_patch(p) = ns%deadcrootn_storage_patch(p) - nf%m_deadcrootn_storage_to_litter_patch(p) * dt + + ! transfer pools + ns%leafn_xfer_patch(p) = ns%leafn_xfer_patch(p) - nf%m_leafn_xfer_to_litter_patch(p) * dt + ns%frootn_xfer_patch(p) = ns%frootn_xfer_patch(p) - nf%m_frootn_xfer_to_litter_patch(p) * dt + ns%livestemn_xfer_patch(p) = ns%livestemn_xfer_patch(p) - nf%m_livestemn_xfer_to_litter_patch(p) * dt + ns%deadstemn_xfer_patch(p) = ns%deadstemn_xfer_patch(p) - nf%m_deadstemn_xfer_to_litter_patch(p) * dt + ns%livecrootn_xfer_patch(p) = ns%livecrootn_xfer_patch(p) - nf%m_livecrootn_xfer_to_litter_patch(p) * dt + ns%deadcrootn_xfer_patch(p) = ns%deadcrootn_xfer_patch(p) - nf%m_deadcrootn_xfer_to_litter_patch(p) * dt + + end do + + end associate + + end subroutine NStateUpdate2 + + !----------------------------------------------------------------------- + subroutine NStateUpdate2h(num_soilc, filter_soilc, num_soilp, filter_soilp, & + nitrogenflux_vars, nitrogenstate_vars) + ! + ! !DESCRIPTION: + ! Update all the prognostic nitrogen state + ! variables affected by harvest mortality fluxes + ! NOTE - associate statements have been removed where there are + ! no science equations. This increases readability and maintainability + ! + use tracer_varcon, only : is_active_betr_bgc + ! !ARGUMENTS: + integer , intent(in) :: num_soilc ! number of soil columns in filter + integer , intent(in) :: filter_soilc(:) ! filter for soil columns + integer , intent(in) :: num_soilp ! number of soil patches in filter + integer , intent(in) :: filter_soilp(:) ! filter for soil patches + type(nitrogenflux_type) , intent(inout) :: nitrogenflux_vars + type(nitrogenstate_type) , intent(inout) :: nitrogenstate_vars + ! + ! !LOCAL VARIABLES: + integer :: c,p,j,l ! indices + integer :: fp,fc ! lake filter indices + real(r8):: dt ! radiation time step (seconds) + !----------------------------------------------------------------------- + + associate( & + ivt => veg_pp%itype , & ! Input: [integer (:) ] pft vegetation type + nf => nitrogenflux_vars , & + ns => nitrogenstate_vars & + ) + + ! set time steps + dt = real( get_step_size(), r8 ) + + ! patch-level nitrogen fluxes from harvest mortality + + do fp = 1,num_soilp + p = filter_soilp(fp) + + ! displayed pools + ns%leafn_patch(p) = ns%leafn_patch(p) - nf%hrv_leafn_to_litter_patch(p) * dt + ns%frootn_patch(p) = ns%frootn_patch(p) - nf%hrv_frootn_to_litter_patch(p) * dt + ns%livestemn_patch(p) = ns%livestemn_patch(p) - nf%hrv_livestemn_to_litter_patch(p) * dt + ns%deadstemn_patch(p) = ns%deadstemn_patch(p) - nf%hrv_deadstemn_to_prod10n_patch(p) * dt + ns%deadstemn_patch(p) = ns%deadstemn_patch(p) - nf%hrv_deadstemn_to_prod100n_patch(p)* dt + ns%livecrootn_patch(p) = ns%livecrootn_patch(p) - nf%hrv_livecrootn_to_litter_patch(p) * dt + ns%deadcrootn_patch(p) = ns%deadcrootn_patch(p) - nf%hrv_deadcrootn_to_litter_patch(p) * dt + ns%retransn_patch(p) = ns%retransn_patch(p) - nf%hrv_retransn_to_litter_patch(p) * dt + + if (ivt(p) >= npcropmin) then ! skip 2 generic crops + ns%livestemn_patch(p)= ns%livestemn_patch(p) - nf%hrv_livestemn_to_prod1n_patch(p) * dt + ns%leafn_patch(p) = ns%leafn_patch(p) - nf%hrv_leafn_to_prod1n_patch(p) * dt + ns%grainn_patch(p) = ns%grainn_patch(p) - nf%hrv_grainn_to_prod1n_patch(p) * dt + end if + + ! storage pools + ns%leafn_storage_patch(p) = ns%leafn_storage_patch(p) - nf%hrv_leafn_storage_to_litter_patch(p) * dt + ns%frootn_storage_patch(p) = ns%frootn_storage_patch(p) - nf%hrv_frootn_storage_to_litter_patch(p) * dt + ns%livestemn_storage_patch(p) = ns%livestemn_storage_patch(p) - nf%hrv_livestemn_storage_to_litter_patch(p) * dt + ns%deadstemn_storage_patch(p) = ns%deadstemn_storage_patch(p) - nf%hrv_deadstemn_storage_to_litter_patch(p) * dt + ns%livecrootn_storage_patch(p) = ns%livecrootn_storage_patch(p) - nf%hrv_livecrootn_storage_to_litter_patch(p) * dt + ns%deadcrootn_storage_patch(p) = ns%deadcrootn_storage_patch(p) - nf%hrv_deadcrootn_storage_to_litter_patch(p) * dt + + ! transfer pools + ns%leafn_xfer_patch(p) = ns%leafn_xfer_patch(p) - nf%hrv_leafn_xfer_to_litter_patch(p) *dt + ns%frootn_xfer_patch(p) = ns%frootn_xfer_patch(p) - nf%hrv_frootn_xfer_to_litter_patch(p) *dt + ns%livestemn_xfer_patch(p) = ns%livestemn_xfer_patch(p) - nf%hrv_livestemn_xfer_to_litter_patch(p) *dt + ns%deadstemn_xfer_patch(p) = ns%deadstemn_xfer_patch(p) - nf%hrv_deadstemn_xfer_to_litter_patch(p) *dt + ns%livecrootn_xfer_patch(p) = ns%livecrootn_xfer_patch(p) - nf%hrv_livecrootn_xfer_to_litter_patch(p) *dt + ns%deadcrootn_xfer_patch(p) = ns%deadcrootn_xfer_patch(p) - nf%hrv_deadcrootn_xfer_to_litter_patch(p) *dt + + end do + + end associate + + end subroutine NStateUpdate2h + +end module CNNStateUpdate2BeTRMod diff --git a/components/clm/src/biogeochem/CNNStateUpdate2Mod.F90 b/components/clm/src/biogeochem/CNNStateUpdate2Mod.F90 index 07af3c68e016..51f7e1feccc9 100644 --- a/components/clm/src/biogeochem/CNNStateUpdate2Mod.F90 +++ b/components/clm/src/biogeochem/CNNStateUpdate2Mod.F90 @@ -80,22 +80,6 @@ subroutine NStateUpdate2(num_soilc, filter_soilc, num_soilp, filter_soilp, & end do end do - elseif (is_active_betr_bgc) then - - do j = 1, nlevdecomp - do fc = 1,num_soilc - c = filter_soilc(fc) - - nf%bgc_npool_ext_inputs_vr_col(c,j,i_met_lit) = & - nf%bgc_npool_ext_inputs_vr_col(c,j,i_met_lit) + nf%gap_mortality_n_to_litr_met_n_col(c,j) * dt - nf%bgc_npool_ext_inputs_vr_col(c,j,i_cel_lit) = & - nf%bgc_npool_ext_inputs_vr_col(c,j,i_cel_lit) + nf%gap_mortality_n_to_litr_cel_n_col(c,j) * dt - nf%bgc_npool_ext_inputs_vr_col(c,j,i_lig_lit) = & - nf%bgc_npool_ext_inputs_vr_col(c,j,i_lig_lit) + nf%gap_mortality_n_to_litr_lig_n_col(c,j) * dt - nf%bgc_npool_ext_inputs_vr_col(c,j,i_cwd) = & - nf%bgc_npool_ext_inputs_vr_col(c,j,i_cwd) + nf%gap_mortality_n_to_cwdn_col(c,j) * dt - end do - end do endif ! patch -level nitrogen fluxes from gap-phase mortality @@ -186,21 +170,6 @@ subroutine NStateUpdate2h(num_soilc, filter_soilc, num_soilp, filter_soilp, & end do end do - elseif (is_active_betr_bgc) then - - do j = 1,nlevdecomp - do fc = 1,num_soilc - c = filter_soilc(fc) - nf%bgc_npool_ext_inputs_vr_col(c,j,i_met_lit) = & - nf%bgc_npool_ext_inputs_vr_col(c,j,i_met_lit) + nf%harvest_n_to_litr_met_n_col(c,j) * dt - nf%bgc_npool_ext_inputs_vr_col(c,j,i_cel_lit) = & - nf%bgc_npool_ext_inputs_vr_col(c,j,i_cel_lit) + nf%harvest_n_to_litr_cel_n_col(c,j) * dt - nf%bgc_npool_ext_inputs_vr_col(c,j,i_lig_lit) = & - nf%bgc_npool_ext_inputs_vr_col(c,j,i_lig_lit) + nf%harvest_n_to_litr_lig_n_col(c,j) * dt - nf%bgc_npool_ext_inputs_vr_col(c,j,i_cwd) = & - nf%bgc_npool_ext_inputs_vr_col(c,j,i_cwd) + nf%harvest_n_to_cwdn_col(c,j) * dt - end do - end do endif ! patch-level nitrogen fluxes from harvest mortality diff --git a/components/clm/src/biogeochem/CNNStateUpdate3BeTRMod.F90 b/components/clm/src/biogeochem/CNNStateUpdate3BeTRMod.F90 new file mode 100644 index 000000000000..a7b2dd238eee --- /dev/null +++ b/components/clm/src/biogeochem/CNNStateUpdate3BeTRMod.F90 @@ -0,0 +1,122 @@ +module CNNStateUpdate3BeTRMod + + !----------------------------------------------------------------------- + ! !DESCRIPTION: + ! Module for nitrogen state variable update, mortality fluxes. + ! Also, sminn leaching flux. + ! + ! !USES: + use shr_kind_mod , only: r8 => shr_kind_r8 + use clm_varpar , only: nlevdecomp, ndecomp_pools + use clm_time_manager , only : get_step_size + use clm_varctl , only : iulog, use_nitrif_denitrif + use clm_varpar , only : i_cwd, i_met_lit, i_cel_lit, i_lig_lit + use CNNitrogenStateType , only : nitrogenstate_type + use CNNitrogenFLuxType , only : nitrogenflux_type + !! bgc interface & pflotran: + use clm_varctl , only : use_pflotran, pf_cmode + ! + implicit none + save + private + ! + ! !PUBLIC MEMBER FUNCTIONS: + public:: NStateUpdate3 + !----------------------------------------------------------------------- + +contains + + !----------------------------------------------------------------------- + subroutine NStateUpdate3(num_soilc, filter_soilc, num_soilp, filter_soilp, & + nitrogenflux_vars, nitrogenstate_vars) + ! + ! !DESCRIPTION: + ! On the radiation time step, update all the prognostic nitrogen state + ! variables affected by gap-phase mortality fluxes. Also the Sminn leaching flux. + ! NOTE - associate statements have been removed where there are + ! no science equations. This increases readability and maintainability. + ! + use tracer_varcon, only : is_active_betr_bgc + ! !ARGUMENTS: + integer , intent(in) :: num_soilc ! number of soil columns in filter + integer , intent(in) :: filter_soilc(:) ! filter for soil columns + integer , intent(in) :: num_soilp ! number of soil patches in filter + integer , intent(in) :: filter_soilp(:) ! filter for soil patches + type(nitrogenflux_type) , intent(inout) :: nitrogenflux_vars + type(nitrogenstate_type) , intent(inout) :: nitrogenstate_vars + ! + ! !LOCAL VARIABLES: + integer :: c,p,j,l,k ! indices + integer :: fp,fc ! lake filter indices + real(r8):: dt ! radiation time step (seconds) + !----------------------------------------------------------------------- + + associate( & + nf => nitrogenflux_vars , & + ns => nitrogenstate_vars & + ) + + ! set time steps + dt = real( get_step_size(), r8 ) + + ! patch-level nitrogen fluxes + + do fp = 1,num_soilp + p = filter_soilp(fp) + + !from fire displayed pools + ns%leafn_patch(p) = ns%leafn_patch(p) - nf%m_leafn_to_fire_patch(p) * dt + ns%frootn_patch(p) = ns%frootn_patch(p) - nf%m_frootn_to_fire_patch(p) * dt + ns%livestemn_patch(p) = ns%livestemn_patch(p) - nf%m_livestemn_to_fire_patch(p) * dt + ns%deadstemn_patch(p) = ns%deadstemn_patch(p) - nf%m_deadstemn_to_fire_patch(p) * dt + ns%livecrootn_patch(p) = ns%livecrootn_patch(p) - nf%m_livecrootn_to_fire_patch(p) * dt + ns%deadcrootn_patch(p) = ns%deadcrootn_patch(p) - nf%m_deadcrootn_to_fire_patch(p) * dt + + ns%leafn_patch(p) = ns%leafn_patch(p) - nf%m_leafn_to_litter_fire_patch(p) * dt + ns%frootn_patch(p) = ns%frootn_patch(p) - nf%m_frootn_to_litter_fire_patch(p) * dt + ns%livestemn_patch(p) = ns%livestemn_patch(p) - nf%m_livestemn_to_litter_fire_patch(p) * dt + ns%deadstemn_patch(p) = ns%deadstemn_patch(p) - nf%m_deadstemn_to_litter_fire_patch(p) * dt + ns%livecrootn_patch(p) = ns%livecrootn_patch(p) - nf%m_livecrootn_to_litter_fire_patch(p) * dt + ns%deadcrootn_patch(p) = ns%deadcrootn_patch(p) - nf%m_deadcrootn_to_litter_fire_patch(p) * dt + + ! storage pools + ns%leafn_storage_patch(p) = ns%leafn_storage_patch(p) - nf%m_leafn_storage_to_fire_patch(p) * dt + ns%frootn_storage_patch(p) = ns%frootn_storage_patch(p) - nf%m_frootn_storage_to_fire_patch(p) * dt + ns%livestemn_storage_patch(p) = ns%livestemn_storage_patch(p) - nf%m_livestemn_storage_to_fire_patch(p) * dt + ns%deadstemn_storage_patch(p) = ns%deadstemn_storage_patch(p) - nf%m_deadstemn_storage_to_fire_patch(p) * dt + ns%livecrootn_storage_patch(p) = ns%livecrootn_storage_patch(p) - nf%m_livecrootn_storage_to_fire_patch(p) * dt + ns%deadcrootn_storage_patch(p) = ns%deadcrootn_storage_patch(p) - nf%m_deadcrootn_storage_to_fire_patch(p) * dt + + ns%leafn_storage_patch(p) = ns%leafn_storage_patch(p) - nf%m_leafn_storage_to_litter_fire_patch(p) * dt + ns%frootn_storage_patch(p) = ns%frootn_storage_patch(p) - nf%m_frootn_storage_to_litter_fire_patch(p) * dt + ns%livestemn_storage_patch(p) = ns%livestemn_storage_patch(p) - nf%m_livestemn_storage_to_litter_fire_patch(p) * dt + ns%deadstemn_storage_patch(p) = ns%deadstemn_storage_patch(p) - nf%m_deadstemn_storage_to_litter_fire_patch(p) * dt + ns%livecrootn_storage_patch(p) = ns%livecrootn_storage_patch(p) - nf%m_livecrootn_storage_to_litter_fire_patch(p) * dt + ns%deadcrootn_storage_patch(p) = ns%deadcrootn_storage_patch(p) - nf%m_deadcrootn_storage_to_litter_fire_patch(p) * dt + + + ! transfer pools + ns%leafn_xfer_patch(p) = ns%leafn_xfer_patch(p) - nf%m_leafn_xfer_to_fire_patch(p) * dt + ns%frootn_xfer_patch(p) = ns%frootn_xfer_patch(p) - nf%m_frootn_xfer_to_fire_patch(p) * dt + ns%livestemn_xfer_patch(p) = ns%livestemn_xfer_patch(p) - nf%m_livestemn_xfer_to_fire_patch(p) * dt + ns%deadstemn_xfer_patch(p) = ns%deadstemn_xfer_patch(p) - nf%m_deadstemn_xfer_to_fire_patch(p) * dt + ns%livecrootn_xfer_patch(p) = ns%livecrootn_xfer_patch(p) - nf%m_livecrootn_xfer_to_fire_patch(p) * dt + ns%deadcrootn_xfer_patch(p) = ns%deadcrootn_xfer_patch(p) - nf%m_deadcrootn_xfer_to_fire_patch(p) * dt + + ns%leafn_xfer_patch(p) = ns%leafn_xfer_patch(p) - nf%m_leafn_xfer_to_litter_fire_patch(p) * dt + ns%frootn_xfer_patch(p) = ns%frootn_xfer_patch(p) - nf%m_frootn_xfer_to_litter_fire_patch(p) * dt + ns%livestemn_xfer_patch(p) = ns%livestemn_xfer_patch(p) - nf%m_livestemn_xfer_to_litter_fire_patch(p) * dt + ns%deadstemn_xfer_patch(p) = ns%deadstemn_xfer_patch(p) - nf%m_deadstemn_xfer_to_litter_fire_patch(p) * dt + ns%livecrootn_xfer_patch(p) = ns%livecrootn_xfer_patch(p) - nf%m_livecrootn_xfer_to_litter_fire_patch(p) * dt + ns%deadcrootn_xfer_patch(p) = ns%deadcrootn_xfer_patch(p) - nf%m_deadcrootn_xfer_to_litter_fire_patch(p) * dt + + ! retranslocated N pool + ns%retransn_patch(p) = ns%retransn_patch(p) - nf%m_retransn_to_fire_patch(p) * dt + ns%retransn_patch(p) = ns%retransn_patch(p) - nf%m_retransn_to_litter_fire_patch(p) * dt + end do + + end associate + + end subroutine NStateUpdate3 + +end module CNNStateUpdate3BeTRMod diff --git a/components/clm/src/biogeochem/CNNStateUpdate3Mod.F90 b/components/clm/src/biogeochem/CNNStateUpdate3Mod.F90 index 057600453fde..db4450e38f26 100644 --- a/components/clm/src/biogeochem/CNNStateUpdate3Mod.F90 +++ b/components/clm/src/biogeochem/CNNStateUpdate3Mod.F90 @@ -98,33 +98,6 @@ subroutine NStateUpdate3(num_soilc, filter_soilc, num_soilp, filter_soilp, & end do end do - else - - do j = 1, nlevdecomp - ! column loop - do fc = 1,num_soilc - c = filter_soilc(fc) - ! column level nitrogen fluxes from fire - ! pft-level wood to column-level CWD (uncombusted wood) - nf%bgc_npool_ext_inputs_vr_col(c,j,i_cwd) = nf%bgc_npool_ext_inputs_vr_col(c,j,i_cwd) + nf%fire_mortality_n_to_cwdn_col(c,j) * dt - - ! pft-level wood to column-level litter (uncombusted wood) - nf%bgc_npool_ext_inputs_vr_col(c,j,i_met_lit) = nf%bgc_npool_ext_inputs_vr_col(c,j,i_met_lit) + nf%m_n_to_litr_met_fire_col(c,j)* dt - nf%bgc_npool_ext_inputs_vr_col(c,j,i_cel_lit) = nf%bgc_npool_ext_inputs_vr_col(c,j,i_cel_lit) + nf%m_n_to_litr_cel_fire_col(c,j)* dt - nf%bgc_npool_ext_inputs_vr_col(c,j,i_lig_lit) = nf%bgc_npool_ext_inputs_vr_col(c,j,i_lig_lit) + nf%m_n_to_litr_lig_fire_col(c,j)* dt - end do ! end of column loop - end do - - ! litter and CWD losses to fire - do l = 1, ndecomp_pools - do j = 1, nlevdecomp - ! column loop - do fc = 1,num_soilc - c = filter_soilc(fc) - nf%bgc_npool_ext_loss_vr_col(c,j,l) = nf%bgc_npool_ext_loss_vr_col(c,j,l) + nf%m_decomp_npools_to_fire_vr_col(c,j,l) * dt - end do - end do - end do endif ! patch-level nitrogen fluxes diff --git a/components/clm/src/biogeochem/CNNitrogenFluxType.F90 b/components/clm/src/biogeochem/CNNitrogenFluxType.F90 index 67be7a52c2c3..ea7dadecdfca 100644 --- a/components/clm/src/biogeochem/CNNitrogenFluxType.F90 +++ b/components/clm/src/biogeochem/CNNitrogenFluxType.F90 @@ -126,6 +126,7 @@ module CNNitrogenFluxType real(r8), pointer :: m_retransn_to_litter_fire_patch (:) ! patch (gN/m2/s) from retransn to deadcrootn due to fire real(r8), pointer :: fire_nloss_patch (:) ! patch total pft-level fire N loss (gN/m2/s) real(r8), pointer :: fire_nloss_col (:) ! col total column-level fire N loss (gN/m2/s) + real(r8), pointer :: fire_decomp_nloss_col (:) ! col fire N loss from decomposable pools (gN/m2/s) real(r8), pointer :: fire_nloss_p2c_col (:) ! col patch2col column-level fire N loss (gN/m2/s) (p2c) real(r8), pointer :: fire_mortality_n_to_cwdn_col (:,:) ! col N fluxes associated with fire mortality to CWD pool (gN/m3/s) @@ -590,6 +591,7 @@ subroutine InitAllocate(this, bounds) allocate(this%ninputs_col (begc:endc)) ; this%ninputs_col (:) = nan allocate(this%noutputs_col (begc:endc)) ; this%noutputs_col (:) = nan allocate(this%fire_nloss_col (begc:endc)) ; this%fire_nloss_col (:) = nan + allocate(this%fire_decomp_nloss_col (begc:endc)) ; this%fire_decomp_nloss_col (:) = nan allocate(this%fire_nloss_p2c_col (begc:endc)) ; this%fire_nloss_p2c_col (:) = nan allocate(this%som_n_leached_col (begc:endc)) ; this%som_n_leached_col (:) = nan @@ -795,7 +797,6 @@ subroutine InitHistory(this, bounds) use shr_infnan_mod , only : nan => shr_infnan_nan, assignment(=) use clm_varpar , only : nlevsno, nlevgrnd, crop_prog use histFileMod , only : hist_addfld1d, hist_addfld2d, hist_addfld_decomp - use tracer_varcon , only : is_active_betr_bgc, do_betr_leaching ! ! !ARGUMENTS: class(nitrogenflux_type) :: this @@ -1259,8 +1260,8 @@ subroutine InitHistory(this, bounds) endif end do - if (.not. is_active_betr_bgc) then do l = 1, ndecomp_cascade_transitions + if(trim(decomp_cascade_con%decomp_pool_name_history(decomp_cascade_con%cascade_receiver_pool(l)))=='')exit ! vertically integrated fluxes !-- mineralization/immobilization fluxes (none from CWD) if ( .not. decomp_cascade_con%is_cwd(decomp_cascade_con%cascade_donor_pool(l)) ) then @@ -1338,7 +1339,6 @@ subroutine InitHistory(this, bounds) endif end do - endif this%sminn_no3_input_vr_col(begc:endc,:) = spval data2dptr => this%sminn_no3_input_vr_col(:,:) @@ -1384,6 +1384,7 @@ subroutine InitHistory(this, bounds) ptr_col=this%som_n_leached_col, default='inactive') do k = 1, ndecomp_pools + if(trim(decomp_cascade_con%decomp_pool_name_history(k))=='')exit if ( .not. decomp_cascade_con%is_cwd(k) ) then this%decomp_npools_leached_col(begc:endc,k) = spval data1dptr => this%decomp_npools_leached_col(:,k) @@ -1792,6 +1793,11 @@ subroutine InitHistory(this, bounds) avgflag='A', long_name='total column-level fire N loss', & ptr_col=this%fire_nloss_col, default='inactive') + this%fire_decomp_nloss_col(begc:endc) = spval + call hist_addfld1d (fname='DECOMP_FIRE_NLOSS', units='gN/m^2/s', & + avgflag='A', long_name='fire N loss from decomposable pools', & + ptr_col=this%fire_decomp_nloss_col, default='inactive') + this%dwt_seedn_to_leaf_col(begc:endc) = spval call hist_addfld1d (fname='DWT_SEEDN_TO_LEAF', units='gN/m^2/s', & avgflag='A', long_name='seed source to PFT-level leaf', & @@ -2258,7 +2264,6 @@ subroutine SetValues ( this, & ! !DESCRIPTION: ! Set nitrogen flux variables ! - use tracer_varcon , only : is_active_betr_bgc ! !ARGUMENTS: ! !ARGUMENTS: class (nitrogenflux_type) :: this @@ -2444,7 +2449,7 @@ subroutine SetValues ( this, & this%harvest_n_to_litr_lig_n_col(i,j) = value_column this%harvest_n_to_cwdn_col(i,j) = value_column - if (.not. use_nitrif_denitrif .and. (.not.is_active_betr_bgc )) then + if (.not. use_nitrif_denitrif) then this%sminn_to_denit_excess_vr_col(i,j) = value_column this%sminn_leached_vr_col(i,j) = value_column else @@ -2522,7 +2527,7 @@ subroutine SetValues ( this, & this%gross_nmin_col(i) = value_column this%net_nmin_col(i) = value_column this%denit_col(i) = value_column - if (use_nitrif_denitrif .or. is_active_betr_bgc) then + if (use_nitrif_denitrif) then this%f_nit_col(i) = value_column this%pot_f_nit_col(i) = value_column this%f_denit_col(i) = value_column @@ -2580,7 +2585,6 @@ subroutine SetValues ( this, & end do end do - if (.not. is_active_betr_bgc)then do l = 1, ndecomp_cascade_transitions do fi = 1,num_column i = filter_column(fi) @@ -2604,7 +2608,6 @@ subroutine SetValues ( this, & end do end do end do - endif do k = 1, ndecomp_pools do j = 1, nlevdecomp_full @@ -2695,7 +2698,7 @@ subroutine Summary(this, bounds, num_soilc, filter_soilc, num_soilp, filter_soil use clm_varctl , only: use_nitrif_denitrif use subgridAveMod , only: p2c use pftvarcon , only : npcropmin - use tracer_varcon , only: is_active_betr_bgc, do_betr_leaching + use tracer_varcon , only: is_active_betr_bgc ! ! !ARGUMENTS: class (nitrogenflux_type) :: this @@ -2769,8 +2772,7 @@ subroutine Summary(this, bounds, num_soilc, filter_soilc, num_soilp, filter_soil end do - if ( (.not. (is_active_betr_bgc )) .and. & - (.not. (use_pflotran .and. pf_cmode)) ) then + if ( (.not. (use_pflotran .and. pf_cmode)) ) then ! BeTR is off AND PFLOTRAN's pf_cmode is false @@ -2869,16 +2871,14 @@ subroutine Summary(this, bounds, num_soilc, filter_soilc, num_soilp, filter_soil this%f_n2o_denit_col(c) + & this%f_n2o_denit_vr_col(c,j) * dzsoi_decomp(j) - if (.not. do_betr_leaching) then - ! leaching/runoff flux - this%smin_no3_leached_col(c) = & + ! leaching/runoff flux + this%smin_no3_leached_col(c) = & this%smin_no3_leached_col(c) + & this%smin_no3_leached_vr_col(c,j) * dzsoi_decomp(j) - this%smin_no3_runoff_col(c) = & + this%smin_no3_runoff_col(c) = & this%smin_no3_runoff_col(c) + & this%smin_no3_runoff_vr_col(c,j) * dzsoi_decomp(j) - endif end do end do @@ -2889,48 +2889,6 @@ subroutine Summary(this, bounds, num_soilc, filter_soilc, num_soilp, filter_soil end if - elseif (is_active_betr_bgc) then - - ! BeTR is active - - do j = 1, nlevdecomp - do fc = 1,num_soilc - c = filter_soilc(fc) - this%f_denit_col(c) = & - this%f_denit_col(c) + & - this%f_denit_vr_col(c,j) * dzsoi_decomp(j) - - this%actual_immob_vr_col(c,j) = & - this%actual_immob_nh4_vr_col(c,j) + & - this%actual_immob_no3_vr_col(c,j) - - this%actual_immob_col(c) = & - this%actual_immob_col(c) + & - this%actual_immob_vr_col(c,j) * dzsoi_decomp(j) - - this%f_nit_col(c) = & - this%f_nit_col(c) + & - this%f_nit_vr_col(c,j) * dzsoi_decomp(j) - - this%f_n2o_nit_col(c) = & - this%f_n2o_nit_col(c) + & - this%f_n2o_nit_vr_col(c,j) * dzsoi_decomp(j) - - this%smin_nh4_to_plant_col(c) = & - this%smin_nh4_to_plant_col(c) + & - this%smin_nh4_to_plant_vr_col(c,j) * dzsoi_decomp(j) - - this%smin_no3_to_plant_col(c) = & - this%smin_no3_to_plant_col(c) + & - this%smin_no3_to_plant_vr_col(c,j) * dzsoi_decomp(j) - - enddo - enddo - do fc = 1,num_soilc - c = filter_soilc(fc) - this%denit_col(c) = this%f_denit_col(c) - end do - end if ! vertically integrate column-level fire N losses diff --git a/components/clm/src/biogeochem/CNNitrogenStateType.F90 b/components/clm/src/biogeochem/CNNitrogenStateType.F90 index bcaf8eb705db..68696e980554 100644 --- a/components/clm/src/biogeochem/CNNitrogenStateType.F90 +++ b/components/clm/src/biogeochem/CNNitrogenStateType.F90 @@ -55,7 +55,8 @@ module CNNitrogenStateType real(r8), pointer :: retransn_patch (:) ! patch (gN/m2) plant pool of retranslocated N real(r8), pointer :: npool_patch (:) ! patch (gN/m2) temporary plant N pool real(r8), pointer :: ntrunc_patch (:) ! patch (gN/m2) pft-level sink for N truncation - + real(r8), pointer :: plant_n_buffer_patch (:) ! patch (gN/m2) pft-level abstract N storage + real(r8), pointer :: plant_n_buffer_col (:) ! patch (gN/m2) col-level abstract N storage real(r8), pointer :: decomp_npools_vr_col (:,:,:) ! col (gN/m3) vertically-resolved decomposing (litter, cwd, soil) N pools real(r8), pointer :: sminn_vr_col (:,:) ! col (gN/m3) vertically-resolved soil mineral N real(r8), pointer :: ntrunc_vr_col (:,:) ! col (gN/m3) vertically-resolved column-level sink for N truncation @@ -267,7 +268,8 @@ subroutine InitAllocate(this, bounds) allocate(this%storvegn_patch (begp:endp)) ; this%storvegn_patch (:) = nan allocate(this%totvegn_patch (begp:endp)) ; this%totvegn_patch (:) = nan allocate(this%totpftn_patch (begp:endp)) ; this%totpftn_patch (:) = nan - + allocate(this%plant_n_buffer_patch (begp:endp)) ; this%plant_n_buffer_patch (:) = nan + allocate(this%plant_n_buffer_col (begc:endc)) ; this%plant_n_buffer_col (:) = nan allocate(this%sminn_vr_col (begc:endc,1:nlevdecomp_full)) ; this%sminn_vr_col (:,:) = nan allocate(this%ntrunc_vr_col (begc:endc,1:nlevdecomp_full)) ; this%ntrunc_vr_col (:,:) = nan allocate(this%smin_no3_vr_col (begc:endc,1:nlevdecomp_full)) ; this%smin_no3_vr_col (:,:) = nan @@ -600,10 +602,10 @@ subroutine InitHistory(this, bounds) ptr_col=this%totsomn_1m_col, default='inactive') endif - this%plant_nbuffer_col(begc:endc) = spval + this%plant_n_buffer_patch(begp:endp) = spval call hist_addfld1d (fname='PLANTN_BUFFER', units='gN/m^2', & avgflag='A', long_name='plant nitrogen stored as buffer', & - ptr_col=this%plant_nbuffer_col) + ptr_col=this%plant_n_buffer_patch,default='inactive') this%ntrunc_col(begc:endc) = spval call hist_addfld1d (fname='COL_NTRUNC', units='gN/m^2', & @@ -841,6 +843,7 @@ subroutine InitCold(this, bounds, & this%npimbalance_patch(p) = 0.0_r8 this%pnup_pfrootc_patch(p) = 0.0_r8 this%benefit_pgpp_pleafc_patch(p) = 0.0_r8 + this%plant_n_buffer_patch(p)= 0.01_r8 end do !------------------------------------------- @@ -898,7 +901,6 @@ subroutine InitCold(this, bounds, & this%prod10n_col(c) = 0._r8 this%prod100n_col(c) = 0._r8 this%totprodn_col(c) = 0._r8 - this%plant_nbuffer_col(c) = 1._r8 end if end do @@ -1206,10 +1208,6 @@ subroutine Restart ( this, bounds, ncid, flag, cnstate_vars ) end do end do - call restartvar(ncid=ncid, flag=flag, varname='plant_nbuffer', xtype=ncd_double, & - dim1name='column', long_name='', units='', & - interpinic_flag='interp', readvar=readvar, data=this%plant_nbuffer_col) - call restartvar(ncid=ncid, flag=flag, varname='totcoln', xtype=ncd_double, & dim1name='column', long_name='', units='', & interpinic_flag='interp', readvar=readvar, data=this%totcoln_col) @@ -1793,15 +1791,13 @@ subroutine Summary(this, bounds, num_soilc, filter_soilc, num_soilp, filter_soil this%sminn_col(c) + & this%totprodn_col(c) + & this%seedn_col(c) + & - this%ntrunc_col(c) + & - this%plant_nbuffer_col(c) + this%ntrunc_col(c) this%totabgn_col (c) = & this%totpftn_col(c) + & this%totprodn_col(c) + & this%seedn_col(c) + & - this%ntrunc_col(c) + & - this%plant_nbuffer_col(c) + this%ntrunc_col(c) this%totblgn_col(c) = & this%cwdn_col(c) + & @@ -1815,31 +1811,30 @@ end subroutine Summary !----------------------------------------------------------------------- - subroutine nbuffer_update(this, bounds, num_soilc, filter_soilc, & - plant_minn_active_yield_flx_col, plant_minn_passive_yield_flx_col) + subroutine nbuffer_update(this, bounds, num_soilp, filter_soilp, & + plant_minn_active_yield_flx_patch, plant_minn_passive_yield_flx_patch) use clm_time_manager , only : get_step_size ! !ARGUMENTS: class (nitrogenstate_type) :: this type(bounds_type) , intent(in) :: bounds - integer , intent(in) :: num_soilc ! number of soil columns in filter - integer , intent(in) :: filter_soilc(:) ! filter for soil columns - - real(r8) , intent(in) :: plant_minn_active_yield_flx_col(bounds%begc:bounds%endc) - real(r8) , intent(in) :: plant_minn_passive_yield_flx_col(bounds%begc:bounds%endc) - integer :: fc, c + integer , intent(in) :: num_soilp ! number of soil columns in filter + integer , intent(in) :: filter_soilp(:) ! filter for soil columns + + real(r8) , intent(in) :: plant_minn_active_yield_flx_patch(bounds%begp:bounds%endp) + real(r8) , intent(in) :: plant_minn_passive_yield_flx_patch(bounds%begp:bounds%endp) + integer :: fp, p real(r8) :: dtime dtime = get_step_size() - do fc = 1, num_soilc - c = filter_soilc(fc) - this%plant_nbuffer_col(c) = this%plant_nbuffer_col(c) + & - (plant_minn_active_yield_flx_col(c) + & - plant_minn_passive_yield_flx_col(c))*dtime + do fp = 1, num_soilp + p = filter_soilp(fp) + this%plant_n_buffer_patch(p) = this%plant_n_buffer_patch(p) + & + (plant_minn_active_yield_flx_patch(p) + & + plant_minn_passive_yield_flx_patch(p))*dtime enddo - end subroutine nbuffer_update end module CNNitrogenStateType diff --git a/components/clm/src/biogeochem/CNPhenologyBeTRMod.F90 b/components/clm/src/biogeochem/CNPhenologyBeTRMod.F90 new file mode 100644 index 000000000000..fa5711077de6 --- /dev/null +++ b/components/clm/src/biogeochem/CNPhenologyBeTRMod.F90 @@ -0,0 +1,2957 @@ +module CNPhenologyBeTRMod + !----------------------------------------------------------------------- + ! !MODULE: CNPhenologyBeTRMod + ! + ! !DESCRIPTION: + ! Module holding routines used in phenology model for coupled carbon + ! nitrogen code. + + !!Adding phosphorus -X.YANG + ! + ! !USES: + use shr_kind_mod , only : r8 => shr_kind_r8 + use shr_log_mod , only : errMsg => shr_log_errMsg + use shr_sys_mod , only : shr_sys_flush + use decompMod , only : bounds_type + use clm_varpar , only : numpft + use clm_varctl , only : iulog, use_cndv + use clm_varcon , only : tfrz + use abortutils , only : endrun + use CanopyStateType , only : canopystate_type + use CNCarbonFluxType , only : carbonflux_type + use CNCarbonStateType , only : carbonstate_type + use CNDVType , only : dgvs_type + use CNNitrogenFluxType , only : nitrogenflux_type + use CNNitrogenStateType , only : nitrogenstate_type + use CNStateType , only : cnstate_type + use CropType , only : crop_type + use VegetationPropertiesType , only : veg_vp + use SoilStateType , only : soilstate_type + use TemperatureType , only : temperature_type + use WaterstateType , only : waterstate_type + use ColumnType , only : col_pp + use GridcellType , only : grc_pp + use VegetationType , only : veg_pp + use PhosphorusFluxType , only : phosphorusflux_type + use PhosphorusStateType , only : phosphorusstate_type + use clm_varctl , only : nu_com + use CNBeTRIndicatorMod + ! + implicit none + save + private + ! + ! !PUBLIC MEMBER FUNCTIONS: + public :: CNPhenologyInit ! Initialization + public :: CNPhenology ! Update + public :: readCNPhenolBeTRParams ! + ! + ! !PRIVATE DATA MEMBERS: + type, private :: CNPnenolParamsType + real(r8) :: crit_dayl ! critical day length for senescence + real(r8) :: ndays_on ! number of days to complete leaf onset + real(r8) :: ndays_off ! number of days to complete leaf offset + real(r8) :: fstor2tran ! fraction of storage to move to transfer for each onset + real(r8) :: crit_onset_fdd ! critical number of freezing days to set gdd counter + real(r8) :: crit_onset_swi ! critical number of days > soilpsi_on for onset + real(r8) :: soilpsi_on ! critical soil water potential for leaf onset + real(r8) :: crit_offset_fdd ! critical number of freezing days to initiate offset + real(r8) :: crit_offset_swi ! critical number of water stress days to initiate offset + real(r8) :: soilpsi_off ! critical soil water potential for leaf offset + real(r8) :: lwtop ! live wood turnover proportion (annual fraction) + end type CNPnenolParamsType + + ! CNPhenolParamsInst is populated in readCNPhenolParams + type(CNPnenolParamsType) :: CNPhenolParamsInst + + real(r8) :: dt ! radiation time step delta t (seconds) + real(r8) :: fracday ! dtime as a fraction of day + real(r8) :: crit_dayl ! critical daylength for offset (seconds) + real(r8) :: ndays_on ! number of days to complete onset + real(r8) :: ndays_off ! number of days to complete offset + real(r8) :: fstor2tran ! fraction of storage to move to transfer on each onset + real(r8) :: crit_onset_fdd ! critical number of freezing days + real(r8) :: crit_onset_swi ! water stress days for offset trigger + real(r8) :: soilpsi_on ! water potential for onset trigger (MPa) + real(r8) :: crit_offset_fdd ! critical number of freezing degree days to trigger offset + real(r8) :: crit_offset_swi ! water stress days for offset trigger + real(r8) :: soilpsi_off ! water potential for offset trigger (MPa) + real(r8) :: lwtop ! live wood turnover proportion (annual fraction) + + ! CropPhenology variables and constants + real(r8) :: p1d, p1v ! photoperiod factor constants for crop vernalization + real(r8) :: hti ! cold hardening index threshold for vernalization + real(r8) :: tbase ! base temperature for vernalization + + integer, parameter :: NOT_Planted = 999 ! If not planted yet in year + integer, parameter :: NOT_Harvested = 999 ! If not harvested yet in year + integer, parameter :: inNH = 1 ! Northern Hemisphere + integer, parameter :: inSH = 2 ! Southern Hemisphere + integer, pointer :: inhemi(:) ! Hemisphere that pft is in + + integer, allocatable :: minplantjday(:,:) ! minimum planting julian day + integer, allocatable :: maxplantjday(:,:) ! maximum planting julian day + integer :: jdayyrstart(inSH) ! julian day of start of year + !----------------------------------------------------------------------- + +contains + + !----------------------------------------------------------------------- + subroutine readCNPhenolBeTRParams ( ncid ) + ! + ! !DESCRIPTION: + ! + ! !USES: + use ncdio_pio , only: file_desc_t,ncd_io + + ! !ARGUMENTS: + implicit none + type(file_desc_t),intent(inout) :: ncid ! pio netCDF file id + ! + ! !LOCAL VARIABLES: + character(len=32) :: subname = 'CNPhenolParamsType' + character(len=100) :: errCode = '-Error reading in parameters file:' + logical :: readv ! has variable been read in or not + real(r8) :: tempr ! temporary to read in parameter + character(len=100) :: tString ! temp. var for reading + !----------------------------------------------------------------------- + + ! + ! read in parameters + ! + tString='crit_dayl' + call ncd_io(varname=trim(tString),data=tempr, flag='read', ncid=ncid, readvar=readv) + if ( .not. readv ) call endrun( msg=trim(errCode)//trim(tString)//errMsg(__FILE__, __LINE__)) + CNPhenolParamsInst%crit_dayl=tempr + + tString='ndays_on' + call ncd_io(varname=trim(tString),data=tempr, flag='read', ncid=ncid, readvar=readv) + if ( .not. readv ) call endrun( msg=trim(errCode)//trim(tString)//errMsg(__FILE__, __LINE__)) + CNPhenolParamsInst%ndays_on=tempr + + tString='ndays_off' + call ncd_io(varname=trim(tString),data=tempr, flag='read', ncid=ncid, readvar=readv) + if ( .not. readv ) call endrun( msg=trim(errCode)//trim(tString)//errMsg(__FILE__, __LINE__)) + CNPhenolParamsInst%ndays_off=tempr + + tString='fstor2tran' + call ncd_io(varname=trim(tString),data=tempr, flag='read', ncid=ncid, readvar=readv) + if ( .not. readv ) call endrun( msg=trim(errCode)//trim(tString)//errMsg(__FILE__, __LINE__)) + CNPhenolParamsInst%fstor2tran=tempr + + tString='crit_onset_fdd' + call ncd_io(varname=trim(tString),data=tempr, flag='read', ncid=ncid, readvar=readv) + if ( .not. readv ) call endrun( msg=trim(errCode)//trim(tString)//errMsg(__FILE__, __LINE__)) + CNPhenolParamsInst%crit_onset_fdd=tempr + + tString='crit_onset_swi' + call ncd_io(varname=trim(tString),data=tempr, flag='read', ncid=ncid, readvar=readv) + if ( .not. readv ) call endrun( msg=trim(errCode)//trim(tString)//errMsg(__FILE__, __LINE__)) + CNPhenolParamsInst%crit_onset_swi=tempr + + tString='soilpsi_on' + call ncd_io(varname=trim(tString),data=tempr, flag='read', ncid=ncid, readvar=readv) + if ( .not. readv ) call endrun( msg=trim(errCode)//trim(tString)//errMsg(__FILE__, __LINE__)) + CNPhenolParamsInst%soilpsi_on=tempr + + tString='crit_offset_fdd' + call ncd_io(varname=trim(tString),data=tempr, flag='read', ncid=ncid, readvar=readv) + if ( .not. readv ) call endrun( msg=trim(errCode)//trim(tString)//errMsg(__FILE__, __LINE__)) + CNPhenolParamsInst%crit_offset_fdd=tempr + + tString='crit_offset_swi' + call ncd_io(varname=trim(tString),data=tempr, flag='read', ncid=ncid, readvar=readv) + if ( .not. readv ) call endrun( msg=trim(errCode)//trim(tString)//errMsg(__FILE__, __LINE__)) + CNPhenolParamsInst%crit_offset_swi=tempr + + tString='soilpsi_off' + call ncd_io(varname=trim(tString),data=tempr, flag='read', ncid=ncid, readvar=readv) + if ( .not. readv ) call endrun( msg=trim(errCode)//trim(tString)//errMsg(__FILE__, __LINE__)) + CNPhenolParamsInst%soilpsi_off=tempr + + tString='lwtop_ann' + call ncd_io(varname=trim(tString),data=tempr, flag='read', ncid=ncid, readvar=readv) + if ( .not. readv ) call endrun( msg=trim(errCode)//trim(tString)//errMsg(__FILE__, __LINE__)) + CNPhenolParamsInst%lwtop=tempr + + call set_pheno_indicators + end subroutine readCNPhenolBeTRParams + + !----------------------------------------------------------------------- + subroutine CNPhenology (num_soilc, filter_soilc, num_soilp, filter_soilp, & + num_pcropp, filter_pcropp, doalb, & + waterstate_vars, temperature_vars, crop_vars, canopystate_vars, soilstate_vars, & + dgvs_vars, cnstate_vars, carbonstate_vars, carbonflux_vars, & + nitrogenstate_vars,nitrogenflux_vars,phosphorusstate_vars,phosphorusflux_vars) + ! + ! !DESCRIPTION: + ! Dynamic phenology routine for coupled carbon-nitrogen code (CN) + ! 1. grass phenology + ! + ! !ARGUMENTS: + integer , intent(in) :: num_soilc ! number of soil columns in filter + integer , intent(in) :: filter_soilc(:) ! filter for soil columns + integer , intent(in) :: num_soilp ! number of soil patches in filter + integer , intent(in) :: filter_soilp(:) ! filter for soil patches + integer , intent(in) :: num_pcropp ! number of prog. crop patches in filter + integer , intent(in) :: filter_pcropp(:)! filter for prognostic crop patches + logical , intent(in) :: doalb ! true if time for sfc albedo calc + type(waterstate_type) , intent(in) :: waterstate_vars + type(temperature_type) , intent(inout) :: temperature_vars + type(crop_type) , intent(inout) :: crop_vars + type(canopystate_type) , intent(in) :: canopystate_vars + type(soilstate_type) , intent(in) :: soilstate_vars + type(dgvs_type) , intent(inout) :: dgvs_vars + type(cnstate_type) , intent(inout) :: cnstate_vars + type(carbonstate_type) , intent(inout) :: carbonstate_vars + type(carbonflux_type) , intent(inout) :: carbonflux_vars + type(nitrogenstate_type) , intent(inout) :: nitrogenstate_vars + type(nitrogenflux_type) , intent(inout) :: nitrogenflux_vars + + type(phosphorusstate_type) , intent(inout) :: phosphorusstate_vars + type(phosphorusflux_type) , intent(inout) :: phosphorusflux_vars + !----------------------------------------------------------------------- + + ! each of the following phenology type routines includes a filter + ! to operate only on the relevant patches + + call CNPhenologyClimate(num_soilp, filter_soilp, num_pcropp, filter_pcropp, & + temperature_vars, cnstate_vars) + + call CNEvergreenPhenology(num_soilp, filter_soilp, & + cnstate_vars) + + call CNSeasonDecidPhenology(num_soilp, filter_soilp, & + temperature_vars, cnstate_vars, dgvs_vars, & + carbonstate_vars, nitrogenstate_vars, carbonflux_vars, nitrogenflux_vars,& + phosphorusstate_vars,phosphorusflux_vars) + + call CNStressDecidPhenology(num_soilp, filter_soilp, & + soilstate_vars, temperature_vars, cnstate_vars, & + carbonstate_vars, nitrogenstate_vars, carbonflux_vars, nitrogenflux_vars,& + phosphorusstate_vars,phosphorusflux_vars) + + if (doalb .and. num_pcropp > 0 ) then + call CropPhenology(num_pcropp, filter_pcropp, & + waterstate_vars, temperature_vars, crop_vars, canopystate_vars, cnstate_vars, & + carbonstate_vars, nitrogenstate_vars, carbonflux_vars, nitrogenflux_vars,& + phosphorusstate_vars,phosphorusflux_vars) + end if + + ! the same onset and offset routines are called regardless of + ! phenology type - they depend only on onset_flag, offset_flag, bglfr, and bgtr + + call CNOnsetGrowth(num_soilp, filter_soilp, & + cnstate_vars, & + carbonstate_vars, nitrogenstate_vars, carbonflux_vars, nitrogenflux_vars,& + phosphorusstate_vars,phosphorusflux_vars) + + if (num_pcropp > 0 ) then + call CNCropHarvest(num_pcropp, filter_pcropp, & + num_soilc, filter_soilc, crop_vars, & + cnstate_vars, carbonstate_vars, carbonflux_vars, nitrogenstate_vars, & + nitrogenflux_vars, phosphorusstate_vars, phosphorusflux_vars) + end if + + call CNOffsetLitterfall(num_soilp, filter_soilp, & + cnstate_vars, carbonstate_vars, carbonflux_vars, nitrogenflux_vars,& + phosphorusflux_vars, nitrogenstate_vars,phosphorusstate_vars) + + call CNBackgroundLitterfall(num_soilp, filter_soilp, & + cnstate_vars, carbonstate_vars, carbonflux_vars, nitrogenflux_vars,& + phosphorusflux_vars, nitrogenstate_vars, phosphorusstate_vars) + + call CNLivewoodTurnover(num_soilp, filter_soilp, & + carbonstate_vars, nitrogenstate_vars, carbonflux_vars, nitrogenflux_vars,& + phosphorusstate_vars,phosphorusflux_vars) + + ! gather all patch-level litterfall fluxes to the column for litter C and N inputs + + call CNLitterToColumn(num_soilc, filter_soilc, & + cnstate_vars, carbonflux_vars, nitrogenflux_vars,phosphorusflux_vars) + + end subroutine CNPhenology + + !----------------------------------------------------------------------- + subroutine CNPhenologyInit(bounds) + ! + ! !DESCRIPTION: + ! Initialization of CNPhenology. Must be called after time-manager is + ! initialized, and after ecophyscon file is read in. + ! + ! !USES: + use clm_time_manager, only: get_step_size + use clm_varpar , only: crop_prog + use clm_varcon , only: secspday + ! + ! !ARGUMENTS: + implicit none + type(bounds_type), intent(in) :: bounds + !------------------------------------------------------------------------ + + ! + ! Get time-step and what fraction of a day it is + ! + dt = real( get_step_size(), r8 ) + fracday = dt/secspday + + ! set constants for CNSeasonDecidPhenology + ! (critical daylength from Biome-BGC, v4.1.2) + crit_dayl=CNPhenolParamsInst%crit_dayl + + ! Set constants for CNSeasonDecidPhenology and CNStressDecidPhenology + ndays_on=CNPhenolParamsInst%ndays_on + ndays_off=CNPhenolParamsInst%ndays_off + + ! set transfer parameters + fstor2tran=CNPhenolParamsInst%fstor2tran + + ! ----------------------------------------- + ! Constants for CNStressDecidPhenology + ! ----------------------------------------- + + ! onset parameters + crit_onset_fdd=CNPhenolParamsInst%crit_onset_fdd + ! critical onset gdd now being calculated as a function of annual + ! average 2m temp. + ! crit_onset_gdd = 150.0 ! c3 grass value + ! crit_onset_gdd = 1000.0 ! c4 grass value + crit_onset_swi=CNPhenolParamsInst%crit_onset_swi + soilpsi_on=CNPhenolParamsInst%soilpsi_on + + ! offset parameters + crit_offset_fdd=CNPhenolParamsInst%crit_offset_fdd + crit_offset_swi=CNPhenolParamsInst%crit_offset_swi + soilpsi_off=CNPhenolParamsInst%soilpsi_off + + ! ----------------------------------------- + ! Constants for CNLivewoodTurnover + ! ----------------------------------------- + + ! set the global parameter for livewood turnover rate + ! define as an annual fraction (0.7), and convert to fraction per second + lwtop=CNPhenolParamsInst%lwtop/31536000.0_r8 !annual fraction converted to per second + + ! ----------------------------------------- + ! Call any subroutine specific initialization routines + ! ----------------------------------------- + + if ( crop_prog ) call CropPhenologyInit(bounds) + + end subroutine CNPhenologyInit + + !----------------------------------------------------------------------- + subroutine CNPhenologyClimate (num_soilp, filter_soilp, num_pcropp, filter_pcropp, & + temperature_vars, cnstate_vars) + ! + ! !DESCRIPTION: + ! For coupled carbon-nitrogen code (CN). + ! + ! !USES: + use clm_time_manager , only : get_days_per_year + use clm_time_manager , only : get_curr_date, is_first_step + ! + ! !ARGUMENTS: + integer , intent(in) :: num_soilp ! number of soil patches in filter + integer , intent(in) :: filter_soilp(:) ! filter for soil patches + integer , intent(in) :: num_pcropp ! number of prognostic crops in filter + integer , intent(in) :: filter_pcropp(:)! filter for prognostic crop patches + type(temperature_type) , intent(inout) :: temperature_vars + type(cnstate_type) , intent(inout) :: cnstate_vars + ! + ! !LOCAL VARIABLES: + integer :: p ! indices + integer :: fp ! lake filter pft index + integer :: nyrs ! number of years prognostic crop has run + real(r8):: dayspyr ! days per year (days) + integer kyr ! current year + integer kmo ! month of year (1, ..., 12) + integer kda ! day of month (1, ..., 31) + integer mcsec ! seconds of day (0, ..., seconds/day) + real(r8), parameter :: yravg = 20.0_r8 ! length of years to average for gdd + real(r8), parameter :: yravgm1 = yravg-1.0_r8 ! minus 1 of above + !----------------------------------------------------------------------- + + associate( & + t_ref2m => temperature_vars%t_ref2m_patch , & ! Input: [real(r8) (:) ] 2m air temperature (K) + gdd0 => temperature_vars%gdd0_patch , & ! Output: [real(r8) (:) ] growing deg. days base 0 deg C (ddays) + gdd8 => temperature_vars%gdd8_patch , & ! Output: [real(r8) (:) ] " " " " 8 " " " + gdd10 => temperature_vars%gdd10_patch , & ! Output: [real(r8) (:) ] " " " " 10 " " " + gdd020 => temperature_vars%gdd020_patch , & ! Output: [real(r8) (:) ] 20-yr mean of gdd0 (ddays) + gdd820 => temperature_vars%gdd820_patch , & ! Output: [real(r8) (:) ] 20-yr mean of gdd8 (ddays) + gdd1020 => temperature_vars%gdd1020_patch , & ! Output: [real(r8) (:) ] 20-yr mean of gdd10 (ddays) + + tempavg_t2m => cnstate_vars%tempavg_t2m_patch & ! Output: [real(r8) (:) ] temp. avg 2m air temperature (K) + ) + + ! set time steps + + dayspyr = get_days_per_year() + + do fp = 1,num_soilp + p = filter_soilp(fp) + tempavg_t2m(p) = tempavg_t2m(p) + t_ref2m(p) * (fracday/dayspyr) + end do + + ! + ! The following crop related steps are done here rather than CropPhenology + ! so that they will be completed each time-step rather than with doalb. + ! + ! The following lines come from ibis's climate.f + stats.f + ! gdd SUMMATIONS ARE RELATIVE TO THE PLANTING DATE (see subr. updateAccFlds) + + if (num_pcropp > 0) then + ! get time-related info + call get_curr_date(kyr, kmo, kda, mcsec) + nyrs = cnstate_vars%CropRestYear + end if + + do fp = 1,num_pcropp + p = filter_pcropp(fp) + if (kmo == 1 .and. kda == 1 .and. nyrs == 0) then ! YR 1: + gdd020(p) = 0._r8 ! set gdd..20 variables to 0 + gdd820(p) = 0._r8 ! and crops will not be planted + gdd1020(p) = 0._r8 + end if + if (kmo == 1 .and. kda == 1 .and. mcsec == 0) then ! <-- END of EVERY YR: + if (nyrs == 1) then ! <-- END of YR 1 + gdd020(p) = gdd0(p) ! <-- END of YR 1 + gdd820(p) = gdd8(p) ! <-- END of YR 1 + gdd1020(p) = gdd10(p) ! <-- END of YR 1 + end if ! <-- END of YR 1 + gdd020(p) = (yravgm1* gdd020(p) + gdd0(p)) / yravg ! gdd..20 must be long term avgs + gdd820(p) = (yravgm1* gdd820(p) + gdd8(p)) / yravg ! so ignore results for yrs 1 & 2 + gdd1020(p) = (yravgm1* gdd1020(p) + gdd10(p)) / yravg + end if + end do + + end associate + + end subroutine CNPhenologyClimate + + !----------------------------------------------------------------------- + subroutine CNEvergreenPhenology (num_soilp, filter_soilp , & + cnstate_vars) + ! + ! !DESCRIPTION: + ! For coupled carbon-nitrogen code (CN). + ! + ! !USES: + use clm_varcon , only : secspday + use clm_time_manager , only : get_days_per_year + ! + ! !ARGUMENTS: + integer , intent(in) :: num_soilp ! number of soil patches in filter + integer , intent(in) :: filter_soilp(:) ! filter for soil patches + type(cnstate_type), intent(inout) :: cnstate_vars + ! + ! !LOCAL VARIABLES: + real(r8):: dayspyr ! Days per year + integer :: p ! indices + integer :: fp ! lake filter pft index + !----------------------------------------------------------------------- + + associate( & + ivt => veg_pp%itype , & ! Input: [integer (:) ] pft vegetation type + + evergreen => veg_vp%evergreen , & ! Input: [real(r8) (:) ] binary flag for evergreen leaf habit (0 or 1) + leaf_long => veg_vp%leaf_long , & ! Input: [real(r8) (:) ] leaf longevity (yrs) + + bglfr => cnstate_vars%bglfr_patch , & ! Output: [real(r8) (:) ] background litterfall rate (1/s) + bgtr => cnstate_vars%bgtr_patch , & ! Output: [real(r8) (:) ] background transfer growth rate (1/s) + lgsf => cnstate_vars%lgsf_patch & ! Output: [real(r8) (:) ] long growing season factor [0-1] + ) + + dayspyr = get_days_per_year() + + do fp = 1,num_soilp + p = filter_soilp(fp) + if (evergreen(ivt(p)) == 1._r8) then + bglfr(p) = 1._r8/(leaf_long(ivt(p)) * dayspyr * secspday) + bgtr(p) = 0._r8 + lgsf(p) = 0._r8 + end if + end do + + end associate + + end subroutine CNEvergreenPhenology + + !----------------------------------------------------------------------- + subroutine CNSeasonDecidPhenology (num_soilp, filter_soilp , & + temperature_vars, cnstate_vars, dgvs_vars , & + carbonstate_vars, nitrogenstate_vars, carbonflux_vars, nitrogenflux_vars,& + phosphorusstate_vars, phosphorusflux_vars) + ! + ! !DESCRIPTION: + ! For coupled carbon-nitrogen code (CN). + ! This routine handles the seasonal deciduous phenology code (temperate + ! deciduous vegetation that has only one growing season per year). + ! + ! !USES: + use shr_const_mod , only: SHR_CONST_TKFRZ, SHR_CONST_PI + use clm_varcon , only: secspday + use clm_varctl , only: use_cndv + ! + ! !ARGUMENTS: + integer , intent(in) :: num_soilp ! number of soil patches in filter + integer , intent(in) :: filter_soilp(:) ! filter for soil patches + type(temperature_type) , intent(in) :: temperature_vars + type(cnstate_type) , intent(inout) :: cnstate_vars + type(dgvs_type) , intent(inout) :: dgvs_vars + type(carbonstate_type) , intent(inout) :: carbonstate_vars + type(nitrogenstate_type) , intent(inout) :: nitrogenstate_vars + type(carbonflux_type) , intent(inout) :: carbonflux_vars + type(nitrogenflux_type) , intent(inout) :: nitrogenflux_vars + type(phosphorusstate_type) , intent(inout) :: phosphorusstate_vars + type(phosphorusflux_type) , intent(inout) :: phosphorusflux_vars + ! + ! !LOCAL VARIABLES: + integer :: g,c,p !indices + integer :: fp !lake filter pft index + real(r8):: ws_flag !winter-summer solstice flag (0 or 1) + real(r8):: crit_onset_gdd !critical onset growing degree-day sum + real(r8):: soilt + !----------------------------------------------------------------------- + + associate( & + ivt => veg_pp%itype , & ! Input: [integer (:) ] pft vegetation type + dayl => grc_pp%dayl , & ! Input: [real(r8) (:) ] daylength (s) + prev_dayl => grc_pp%prev_dayl , & ! Input: [real(r8) (:) ] daylength from previous time step (s) + + season_decid => veg_vp%season_decid , & ! Input: [real(r8) (:) ] binary flag for seasonal-deciduous leaf habit (0 or 1) + woody => veg_vp%woody , & ! Input: [real(r8) (:) ] binary flag for woody lifeform (1=woody, 0=not woody) + + t_soisno => temperature_vars%t_soisno_col , & ! Input: [real(r8) (:,:) ] soil temperature (Kelvin) (-nlevsno+1:nlevgrnd) + + pftmayexist => dgvs_vars%pftmayexist_patch , & ! Output: [logical (:) ] exclude seasonal decid patches from tropics + + annavg_t2m => cnstate_vars%annavg_t2m_patch , & ! Input: [real(r8) (:) ] annual average 2m air temperature (K) + dormant_flag => cnstate_vars%dormant_flag_patch , & ! Output: [real(r8) (:) ] dormancy flag + days_active => cnstate_vars%days_active_patch , & ! Output: [real(r8) (:) ] number of days since last dormancy + onset_flag => cnstate_vars%onset_flag_patch , & ! Output: [real(r8) (:) ] onset flag + onset_counter => cnstate_vars%onset_counter_patch , & ! Output: [real(r8) (:) ] onset counter (seconds) + onset_gddflag => cnstate_vars%onset_gddflag_patch , & ! Output: [real(r8) (:) ] onset freeze flag + onset_gdd => cnstate_vars%onset_gdd_patch , & ! Output: [real(r8) (:) ] onset growing degree days + offset_flag => cnstate_vars%offset_flag_patch , & ! Output: [real(r8) (:) ] offset flag + offset_counter => cnstate_vars%offset_counter_patch , & ! Output: [real(r8) (:) ] offset counter (seconds) + bglfr => cnstate_vars%bglfr_patch , & ! Output: [real(r8) (:) ] background litterfall rate (1/s) + bgtr => cnstate_vars%bgtr_patch , & ! Output: [real(r8) (:) ] background transfer growth rate (1/s) + lgsf => cnstate_vars%lgsf_patch , & ! Output: [real(r8) (:) ] long growing season factor [0-1] + + leafc_storage => carbonstate_vars%leafc_storage_patch , & ! Input: [real(r8) (:) ] (gC/m2) leaf C storage + frootc_storage => carbonstate_vars%frootc_storage_patch , & ! Input: [real(r8) (:) ] (gC/m2) fine root C storage + livestemc_storage => carbonstate_vars%livestemc_storage_patch , & ! Input: [real(r8) (:) ] (gC/m2) live stem C storage + deadstemc_storage => carbonstate_vars%deadstemc_storage_patch , & ! Input: [real(r8) (:) ] (gC/m2) dead stem C storage + livecrootc_storage => carbonstate_vars%livecrootc_storage_patch , & ! Input: [real(r8) (:) ] (gC/m2) live coarse root C storage + deadcrootc_storage => carbonstate_vars%deadcrootc_storage_patch , & ! Input: [real(r8) (:) ] (gC/m2) dead coarse root C storage + gresp_storage => carbonstate_vars%gresp_storage_patch , & ! Input: [real(r8) (:) ] (gC/m2) growth respiration storage + leafc_xfer => carbonstate_vars%leafc_xfer_patch , & ! Output: [real(r8) (:) ] (gC/m2) leaf C transfer + frootc_xfer => carbonstate_vars%frootc_xfer_patch , & ! Output: [real(r8) (:) ] (gC/m2) fine root C transfer + livestemc_xfer => carbonstate_vars%livestemc_xfer_patch , & ! Output: [real(r8) (:) ] (gC/m2) live stem C transfer + deadstemc_xfer => carbonstate_vars%deadstemc_xfer_patch , & ! Output: [real(r8) (:) ] (gC/m2) dead stem C transfer + livecrootc_xfer => carbonstate_vars%livecrootc_xfer_patch , & ! Output: [real(r8) (:) ] (gC/m2) live coarse root C transfer + deadcrootc_xfer => carbonstate_vars%deadcrootc_xfer_patch , & ! Output: [real(r8) (:) ] (gC/m2) dead coarse root C transfer + + leafn_storage => nitrogenstate_vars%leafn_storage_patch , & ! Input: [real(r8) (:) ] (gN/m2) leaf N storage + frootn_storage => nitrogenstate_vars%frootn_storage_patch , & ! Input: [real(r8) (:) ] (gN/m2) fine root N storage + livestemn_storage => nitrogenstate_vars%livestemn_storage_patch , & ! Input: [real(r8) (:) ] (gN/m2) live stem N storage + deadstemn_storage => nitrogenstate_vars%deadstemn_storage_patch , & ! Input: [real(r8) (:) ] (gN/m2) dead stem N storage + livecrootn_storage => nitrogenstate_vars%livecrootn_storage_patch , & ! Input: [real(r8) (:) ] (gN/m2) live coarse root N storage + deadcrootn_storage => nitrogenstate_vars%deadcrootn_storage_patch , & ! Input: [real(r8) (:) ] (gN/m2) dead coarse root N storage + + !! phosphorus + leafp_storage => phosphorusstate_vars%leafp_storage_patch , & ! Input: [real(r8) (:) ] (gP/m2) leaf P storage + frootp_storage => phosphorusstate_vars%frootp_storage_patch , & ! Input: [real(r8) (:) ] (gP/m2) fine root P storage + livestemp_storage => phosphorusstate_vars%livestemp_storage_patch , & ! Input: [real(r8) (:) ] (gP/m2) live stem P storage + deadstemp_storage => phosphorusstate_vars%deadstemp_storage_patch , & ! Input: [real(r8) (:) ] (gP/m2) dead stem P storage + livecrootp_storage => phosphorusstate_vars%livecrootp_storage_patch , & ! Input: [real(r8) (:) ] (gP/m2) live coarse root P storage + deadcrootp_storage => phosphorusstate_vars%deadcrootp_storage_patch , & ! Input: [real(r8) (:) ] (gP/m2) dead coarse root P storage + + prev_leafc_to_litter => carbonflux_vars%prev_leafc_to_litter_patch , & ! Output: [real(r8) (:) ] previous timestep leaf C litterfall flux (gC/m2/s) + prev_frootc_to_litter => carbonflux_vars%prev_frootc_to_litter_patch , & ! Output: [real(r8) (:) ] previous timestep froot C litterfall flux (gC/m2/s) + leafc_xfer_to_leafc => carbonflux_vars%leafc_xfer_to_leafc_patch , & ! Output: [real(r8) (:) ] + frootc_xfer_to_frootc => carbonflux_vars%frootc_xfer_to_frootc_patch , & ! Output: [real(r8) (:) ] + livestemc_xfer_to_livestemc => carbonflux_vars%livestemc_xfer_to_livestemc_patch , & ! Output: [real(r8) (:) ] + deadstemc_xfer_to_deadstemc => carbonflux_vars%deadstemc_xfer_to_deadstemc_patch , & ! Output: [real(r8) (:) ] + livecrootc_xfer_to_livecrootc => carbonflux_vars%livecrootc_xfer_to_livecrootc_patch , & ! Output: [real(r8) (:) ] + deadcrootc_xfer_to_deadcrootc => carbonflux_vars%deadcrootc_xfer_to_deadcrootc_patch , & ! Output: [real(r8) (:) ] + leafc_storage_to_xfer => carbonflux_vars%leafc_storage_to_xfer_patch , & ! Output: [real(r8) (:) ] + frootc_storage_to_xfer => carbonflux_vars%frootc_storage_to_xfer_patch , & ! Output: [real(r8) (:) ] + livestemc_storage_to_xfer => carbonflux_vars%livestemc_storage_to_xfer_patch , & ! Output: [real(r8) (:) ] + deadstemc_storage_to_xfer => carbonflux_vars%deadstemc_storage_to_xfer_patch , & ! Output: [real(r8) (:) ] + livecrootc_storage_to_xfer => carbonflux_vars%livecrootc_storage_to_xfer_patch , & ! Output: [real(r8) (:) ] + deadcrootc_storage_to_xfer => carbonflux_vars%deadcrootc_storage_to_xfer_patch , & ! Output: [real(r8) (:) ] + gresp_storage_to_xfer => carbonflux_vars%gresp_storage_to_xfer_patch , & ! Output: [real(r8) (:) ] + + leafn_xfer_to_leafn => nitrogenflux_vars%leafn_xfer_to_leafn_patch , & ! Output: [real(r8) (:) ] + frootn_xfer_to_frootn => nitrogenflux_vars%frootn_xfer_to_frootn_patch , & ! Output: [real(r8) (:) ] + livestemn_xfer_to_livestemn => nitrogenflux_vars%livestemn_xfer_to_livestemn_patch , & ! Output: [real(r8) (:) ] + deadstemn_xfer_to_deadstemn => nitrogenflux_vars%deadstemn_xfer_to_deadstemn_patch , & ! Output: [real(r8) (:) ] + livecrootn_xfer_to_livecrootn => nitrogenflux_vars%livecrootn_xfer_to_livecrootn_patch , & ! Output: [real(r8) (:) ] + deadcrootn_xfer_to_deadcrootn => nitrogenflux_vars%deadcrootn_xfer_to_deadcrootn_patch , & ! Output: [real(r8) (:) ] + leafn_xfer => nitrogenstate_vars%leafn_xfer_patch , & ! Output: [real(r8) (:) ] (gN/m2) leaf N transfer + frootn_xfer => nitrogenstate_vars%frootn_xfer_patch , & ! Output: [real(r8) (:) ] (gN/m2) fine root N transfer + livestemn_xfer => nitrogenstate_vars%livestemn_xfer_patch , & ! Output: [real(r8) (:) ] (gN/m2) live stem N transfer + deadstemn_xfer => nitrogenstate_vars%deadstemn_xfer_patch , & ! Output: [real(r8) (:) ] (gN/m2) dead stem N transfer + livecrootn_xfer => nitrogenstate_vars%livecrootn_xfer_patch , & ! Output: [real(r8) (:) ] (gN/m2) live coarse root N transfer + deadcrootn_xfer => nitrogenstate_vars%deadcrootn_xfer_patch , & ! Output: [real(r8) (:) ] (gN/m2) dead coarse root N transfer + leafn_storage_to_xfer => nitrogenflux_vars%leafn_storage_to_xfer_patch , & ! Output: [real(r8) (:) ] + frootn_storage_to_xfer => nitrogenflux_vars%frootn_storage_to_xfer_patch , & ! Output: [real(r8) (:) ] + livestemn_storage_to_xfer => nitrogenflux_vars%livestemn_storage_to_xfer_patch , & ! Output: [real(r8) (:) ] + deadstemn_storage_to_xfer => nitrogenflux_vars%deadstemn_storage_to_xfer_patch , & ! Output: [real(r8) (:) ] + livecrootn_storage_to_xfer => nitrogenflux_vars%livecrootn_storage_to_xfer_patch , & ! Output: [real(r8) (:) ] + deadcrootn_storage_to_xfer => nitrogenflux_vars%deadcrootn_storage_to_xfer_patch , & ! Output: [real(r8) (:) ] + + leafp_xfer_to_leafp => phosphorusflux_vars%leafp_xfer_to_leafp_patch , & ! Output: [real(r8) (:) ] + frootp_xfer_to_frootp => phosphorusflux_vars%frootp_xfer_to_frootp_patch , & ! Output: [real(r8) (:) ] + livestemp_xfer_to_livestemp => phosphorusflux_vars%livestemp_xfer_to_livestemp_patch , & ! Output: [real(r8) (:) ] + deadstemp_xfer_to_deadstemp => phosphorusflux_vars%deadstemp_xfer_to_deadstemp_patch , & ! Output: [real(r8) (:) ] + livecrootp_xfer_to_livecrootp => phosphorusflux_vars%livecrootp_xfer_to_livecrootp_patch , & ! Output: [real(r8) (:) ] + deadcrootp_xfer_to_deadcrootp => phosphorusflux_vars%deadcrootp_xfer_to_deadcrootp_patch , & ! Output: [real(r8) (:) ] + leafp_xfer => phosphorusstate_vars%leafp_xfer_patch , & ! Output: [real(r8) (:) ] (gP/m2) leaf P transfer + frootp_xfer => phosphorusstate_vars%frootp_xfer_patch , & ! Output: [real(r8) (:) ] (gP/m2) fine root P transfer + livestemp_xfer => phosphorusstate_vars%livestemp_xfer_patch , & ! Output: [real(r8) (:) ] (gP/m2) live stem P transfer + deadstemp_xfer => phosphorusstate_vars%deadstemp_xfer_patch , & ! Output: [real(r8) (:) ] (gP/m2) dead stem P transfer + livecrootp_xfer => phosphorusstate_vars%livecrootp_xfer_patch , & ! Output: [real(r8) (:) ] (gP/m2) live coarse root P transfer + deadcrootp_xfer => phosphorusstate_vars%deadcrootp_xfer_patch , & ! Output: [real(r8) (:) ] (gP/m2) dead coarse root P transfer + leafp_storage_to_xfer => phosphorusflux_vars%leafp_storage_to_xfer_patch , & ! Output: [real(r8) (:) ] + frootp_storage_to_xfer => phosphorusflux_vars%frootp_storage_to_xfer_patch , & ! Output: [real(r8) (:) ] + livestemp_storage_to_xfer => phosphorusflux_vars%livestemp_storage_to_xfer_patch , & ! Output: [real(r8) (:) ] + deadstemp_storage_to_xfer => phosphorusflux_vars%deadstemp_storage_to_xfer_patch , & ! Output: [real(r8) (:) ] + livecrootp_storage_to_xfer => phosphorusflux_vars%livecrootp_storage_to_xfer_patch , & ! Output: [real(r8) (:) ] + deadcrootp_storage_to_xfer => phosphorusflux_vars%deadcrootp_storage_to_xfer_patch & ! Output: [real(r8) (:) ] + + ) + + ! start pft loop + do fp = 1,num_soilp + p = filter_soilp(fp) + c = veg_pp%column(p) + g = veg_pp%gridcell(p) + + if (season_decid(ivt(p)) == 1._r8) then + + ! set background litterfall rate, background transfer rate, and + ! long growing season factor to 0 for seasonal deciduous types + bglfr(p) = 0._r8 + bgtr(p) = 0._r8 + lgsf(p) = 0._r8 + + ! onset gdd sum from Biome-BGC, v4.1.2 + crit_onset_gdd = exp(4.8_r8 + 0.13_r8*(annavg_t2m(p) - SHR_CONST_TKFRZ)) + + ! set flag for solstice period (winter->summer = 1, summer->winter = 0) + if (dayl(g) >= prev_dayl(g)) then + ws_flag = 1._r8 + else + ws_flag = 0._r8 + end if + + ! update offset_counter and test for the end of the offset period + if (offset_flag(p) == 1.0_r8) then + ! decrement counter for offset period + offset_counter(p) = offset_counter(p) - dt + + ! if this is the end of the offset_period, reset phenology + ! flags and indices + if (offset_counter(p) == 0.0_r8) then + ! this code block was originally handled by call cn_offset_cleanup(p) + ! inlined during vectorization + + offset_flag(p) = 0._r8 + offset_counter(p) = 0._r8 + dormant_flag(p) = 1._r8 + days_active(p) = 0._r8 + if (use_cndv) then + pftmayexist(p) = .true. + end if + + ! reset the previous timestep litterfall flux memory + prev_leafc_to_litter(p) = 0._r8 + prev_frootc_to_litter(p) = 0._r8 + end if + end if + + ! update onset_counter and test for the end of the onset period + if (onset_flag(p) == 1.0_r8) then + ! decrement counter for onset period + onset_counter(p) = onset_counter(p) - dt + + ! if this is the end of the onset period, reset phenology + ! flags and indices + if (onset_counter(p) == 0.0_r8) then + ! this code block was originally handled by call cn_onset_cleanup(p) + ! inlined during vectorization + + onset_flag(p) = 0.0_r8 + onset_counter(p) = 0.0_r8 + ! set all transfer growth rates to 0.0 + leafc_xfer_to_leafc(p) = 0.0_r8 + frootc_xfer_to_frootc(p) = 0.0_r8 + leafn_xfer_to_leafn(p) = 0.0_r8 + frootn_xfer_to_frootn(p) = 0.0_r8 + leafp_xfer_to_leafp(p) = 0.0_r8 + frootp_xfer_to_frootp(p) = 0.0_r8 + if (woody(ivt(p)) == 1.0_r8) then + livestemc_xfer_to_livestemc(p) = 0.0_r8 + deadstemc_xfer_to_deadstemc(p) = 0.0_r8 + livecrootc_xfer_to_livecrootc(p) = 0.0_r8 + deadcrootc_xfer_to_deadcrootc(p) = 0.0_r8 + livestemn_xfer_to_livestemn(p) = 0.0_r8 + deadstemn_xfer_to_deadstemn(p) = 0.0_r8 + livecrootn_xfer_to_livecrootn(p) = 0.0_r8 + deadcrootn_xfer_to_deadcrootn(p) = 0.0_r8 + livestemp_xfer_to_livestemp(p) = 0.0_r8 + deadstemp_xfer_to_deadstemp(p) = 0.0_r8 + livecrootp_xfer_to_livecrootp(p) = 0.0_r8 + deadcrootp_xfer_to_deadcrootp(p) = 0.0_r8 + end if + ! set transfer pools to 0.0 + leafc_xfer(p) = 0.0_r8 + leafn_xfer(p) = 0.0_r8 + leafp_xfer(p) = 0.0_r8 + frootc_xfer(p) = 0.0_r8 + frootn_xfer(p) = 0.0_r8 + frootp_xfer(p) = 0.0_r8 + if (woody(ivt(p)) == 1.0_r8) then + livestemc_xfer(p) = 0.0_r8 + livestemn_xfer(p) = 0.0_r8 + livestemp_xfer(p) = 0.0_r8 + deadstemc_xfer(p) = 0.0_r8 + deadstemn_xfer(p) = 0.0_r8 + deadstemp_xfer(p) = 0.0_r8 + livecrootc_xfer(p) = 0.0_r8 + livecrootn_xfer(p) = 0.0_r8 + livecrootp_xfer(p) = 0.0_r8 + deadcrootc_xfer(p) = 0.0_r8 + deadcrootn_xfer(p) = 0.0_r8 + deadcrootp_xfer(p) = 0.0_r8 + end if + end if + end if + + ! test for switching from dormant period to growth period + if (dormant_flag(p) == 1.0_r8) then + + ! Test to turn on growing degree-day sum, if off. + ! switch on the growing degree day sum on the winter solstice + + if (onset_gddflag(p) == 0._r8 .and. ws_flag == 1._r8) then + onset_gddflag(p) = 1._r8 + onset_gdd(p) = 0._r8 + end if + + ! Test to turn off growing degree-day sum, if on. + ! This test resets the growing degree day sum if it gets past + ! the summer solstice without reaching the threshold value. + ! In that case, it will take until the next winter solstice + ! before the growing degree-day summation starts again. + + if (onset_gddflag(p) == 1._r8 .and. ws_flag == 0._r8) then + onset_gddflag(p) = 0._r8 + onset_gdd(p) = 0._r8 + end if + + ! if the gdd flag is set, and if the soil is above freezing + ! then accumulate growing degree days for onset trigger + + soilt = t_soisno(c,3) + if (onset_gddflag(p) == 1.0_r8 .and. soilt > SHR_CONST_TKFRZ) then + onset_gdd(p) = onset_gdd(p) + (soilt-SHR_CONST_TKFRZ)*fracday + end if + + ! set onset_flag if critical growing degree-day sum is exceeded + if (onset_gdd(p) > crit_onset_gdd) then + onset_flag(p) = 1.0_r8 + dormant_flag(p) = 0.0_r8 + onset_gddflag(p) = 0.0_r8 + onset_gdd(p) = 0.0_r8 + onset_counter(p) = ndays_on * secspday + + ! move all the storage pools into transfer pools, + ! where they will be transfered to displayed growth over the onset period. + ! this code was originally handled with call cn_storage_to_xfer(p) + ! inlined during vectorization + + ! set carbon fluxes for shifting storage pools to transfer pools + leafc_storage_to_xfer(p) = fstor2tran * leafc_storage(p)/dt + frootc_storage_to_xfer(p) = fstor2tran * frootc_storage(p)/dt + if (woody(ivt(p)) == 1.0_r8) then + livestemc_storage_to_xfer(p) = fstor2tran * livestemc_storage(p)/dt + deadstemc_storage_to_xfer(p) = fstor2tran * deadstemc_storage(p)/dt + livecrootc_storage_to_xfer(p) = fstor2tran * livecrootc_storage(p)/dt + deadcrootc_storage_to_xfer(p) = fstor2tran * deadcrootc_storage(p)/dt + gresp_storage_to_xfer(p) = fstor2tran * gresp_storage(p)/dt + end if + + ! set nitrogen fluxes for shifting storage pools to transfer pools + leafn_storage_to_xfer(p) = fstor2tran * leafn_storage(p)/dt + frootn_storage_to_xfer(p) = fstor2tran * frootn_storage(p)/dt + if (woody(ivt(p)) == 1.0_r8) then + livestemn_storage_to_xfer(p) = fstor2tran * livestemn_storage(p)/dt + deadstemn_storage_to_xfer(p) = fstor2tran * deadstemn_storage(p)/dt + livecrootn_storage_to_xfer(p) = fstor2tran * livecrootn_storage(p)/dt + deadcrootn_storage_to_xfer(p) = fstor2tran * deadcrootn_storage(p)/dt + end if + + ! set phosphorus fluxes for shifting storage pools to transfer pools + leafp_storage_to_xfer(p) = fstor2tran * leafp_storage(p)/dt + frootp_storage_to_xfer(p) = fstor2tran * frootp_storage(p)/dt + if (woody(ivt(p)) == 1.0_r8) then + livestemp_storage_to_xfer(p) = fstor2tran * livestemp_storage(p)/dt + deadstemp_storage_to_xfer(p) = fstor2tran * deadstemp_storage(p)/dt + livecrootp_storage_to_xfer(p) = fstor2tran * livecrootp_storage(p)/dt + deadcrootp_storage_to_xfer(p) = fstor2tran * deadcrootp_storage(p)/dt + end if + end if + + ! test for switching from growth period to offset period + else if (offset_flag(p) == 0.0_r8) then + if (use_cndv) then + ! If days_active > 355, then remove pft in + ! CNDVEstablishment at the end of the year. + ! days_active > 355 is a symptom of seasonal decid. patches occurring in + ! gridcells where dayl never drops below crit_dayl. + ! This results in TLAI>1e4 in a few gridcells. + days_active(p) = days_active(p) + fracday + if (days_active(p) > 355._r8) pftmayexist(p) = .false. + end if + + ! only begin to test for offset daylength once past the summer sol + if (ws_flag == 0._r8 .and. dayl(g) < crit_dayl) then + offset_flag(p) = 1._r8 + offset_counter(p) = ndays_off * secspday + prev_leafc_to_litter(p) = 0._r8 + prev_frootc_to_litter(p) = 0._r8 + end if + end if + + end if ! end if seasonal deciduous + + end do ! end of pft loop + + end associate + + end subroutine CNSeasonDecidPhenology + + !----------------------------------------------------------------------- + subroutine CNStressDecidPhenology (num_soilp, filter_soilp , & + soilstate_vars, temperature_vars, cnstate_vars , & + carbonstate_vars, nitrogenstate_vars, carbonflux_vars,nitrogenflux_vars,& + phosphorusstate_vars,phosphorusflux_vars) + ! + ! !DESCRIPTION: + ! This routine handles phenology for vegetation types, such as grasses and + ! tropical drought deciduous trees, that respond to cold and drought stress + ! signals and that can have multiple growing seasons in a given year. + ! This routine allows for the possibility that leaves might persist year-round + ! in the absence of a suitable stress trigger, by switching to an essentially + ! evergreen habit, but maintaining a deciduous leaf longevity, while waiting + ! for the next stress trigger. This is in contrast to the seasonal deciduous + ! algorithm (for temperate deciduous trees) that forces a single growing season + ! per year. + ! + ! !USES: + use clm_time_manager , only : get_days_per_year + use clm_varcon , only : secspday + use shr_const_mod , only : SHR_CONST_TKFRZ, SHR_CONST_PI + ! + ! !ARGUMENTS: + integer , intent(in) :: num_soilp ! number of soil patches in filter + integer , intent(in) :: filter_soilp(:) ! filter for soil patches + type(soilstate_type) , intent(in) :: soilstate_vars + type(temperature_type) , intent(in) :: temperature_vars + type(cnstate_type) , intent(inout) :: cnstate_vars + type(carbonstate_type) , intent(inout) :: carbonstate_vars + type(nitrogenstate_type) , intent(inout) :: nitrogenstate_vars + type(carbonflux_type) , intent(inout) :: carbonflux_vars + type(nitrogenflux_type) , intent(inout) :: nitrogenflux_vars + type(phosphorusstate_type) , intent(inout) :: phosphorusstate_vars + type(phosphorusflux_type) , intent(inout) :: phosphorusflux_vars + ! + ! !LOCAL VARIABLES: + real(r8),parameter :: secspqtrday = secspday / 4 ! seconds per quarter day + integer :: g,c,p ! indices + integer :: fp ! lake filter pft index + real(r8):: dayspyr ! days per year + real(r8):: crit_onset_gdd ! degree days for onset trigger + real(r8):: soilt ! temperature of top soil layer + real(r8):: psi ! water stress of top soil layer + !----------------------------------------------------------------------- + + associate( & + ivt => veg_pp%itype , & ! Input: [integer (:) ] pft vegetation type + dayl => grc_pp%dayl , & ! Input: [real(r8) (:) ] daylength (s) + + leaf_long => veg_vp%leaf_long , & ! Input: [real(r8) (:) ] leaf longevity (yrs) + woody => veg_vp%woody , & ! Input: [real(r8) (:) ] binary flag for woody lifeform (1=woody, 0=not woody) + stress_decid => veg_vp%stress_decid , & ! Input: [real(r8) (:) ] binary flag for stress-deciduous leaf habit (0 or 1) + + soilpsi => soilstate_vars%soilpsi_col , & ! Input: [real(r8) (:,:) ] soil water potential in each soil layer (MPa) + + t_soisno => temperature_vars%t_soisno_col , & ! Input: [real(r8) (:,:) ] soil temperature (Kelvin) (-nlevsno+1:nlevgrnd) + + dormant_flag => cnstate_vars%dormant_flag_patch , & ! Output: [real(r8) (:) ] dormancy flag + days_active => cnstate_vars%days_active_patch , & ! Output: [real(r8) (:) ] number of days since last dormancy + onset_flag => cnstate_vars%onset_flag_patch , & ! Output: [real(r8) (:) ] onset flag + onset_counter => cnstate_vars%onset_counter_patch , & ! Output: [real(r8) (:) ] onset counter (seconds) + onset_gddflag => cnstate_vars%onset_gddflag_patch , & ! Output: [real(r8) (:) ] onset freeze flag + onset_fdd => cnstate_vars%onset_fdd_patch , & ! Output: [real(r8) (:) ] onset freezing degree days counter + onset_gdd => cnstate_vars%onset_gdd_patch , & ! Output: [real(r8) (:) ] onset growing degree days + onset_swi => cnstate_vars%onset_swi_patch , & ! Output: [real(r8) (:) ] onset soil water index + offset_flag => cnstate_vars%offset_flag_patch , & ! Output: [real(r8) (:) ] offset flag + offset_counter => cnstate_vars%offset_counter_patch , & ! Output: [real(r8) (:) ] offset counter (seconds) + offset_fdd => cnstate_vars%offset_fdd_patch , & ! Output: [real(r8) (:) ] offset freezing degree days counter + offset_swi => cnstate_vars%offset_swi_patch , & ! Output: [real(r8) (:) ] offset soil water index + lgsf => cnstate_vars%lgsf_patch , & ! Output: [real(r8) (:) ] long growing season factor [0-1] + bglfr => cnstate_vars%bglfr_patch , & ! Output: [real(r8) (:) ] background litterfall rate (1/s) + bgtr => cnstate_vars%bgtr_patch , & ! Output: [real(r8) (:) ] background transfer growth rate (1/s) + annavg_t2m => cnstate_vars%annavg_t2m_patch , & ! Output: [real(r8) (:) ] annual average 2m air temperature (K) + + leafc_storage => carbonstate_vars%leafc_storage_patch , & ! Input: [real(r8) (:) ] (gC/m2) leaf C storage + frootc_storage => carbonstate_vars%frootc_storage_patch , & ! Input: [real(r8) (:) ] (gC/m2) fine root C storage + livestemc_storage => carbonstate_vars%livestemc_storage_patch , & ! Input: [real(r8) (:) ] (gC/m2) live stem C storage + deadstemc_storage => carbonstate_vars%deadstemc_storage_patch , & ! Input: [real(r8) (:) ] (gC/m2) dead stem C storage + livecrootc_storage => carbonstate_vars%livecrootc_storage_patch , & ! Input: [real(r8) (:) ] (gC/m2) live coarse root C storage + deadcrootc_storage => carbonstate_vars%deadcrootc_storage_patch , & ! Input: [real(r8) (:) ] (gC/m2) dead coarse root C storage + gresp_storage => carbonstate_vars%gresp_storage_patch , & ! Input: [real(r8) (:) ] (gC/m2) growth respiration storage + leafc_xfer => carbonstate_vars%leafc_xfer_patch , & ! Output: [real(r8) (:) ] (gC/m2) leaf C transfer + frootc_xfer => carbonstate_vars%frootc_xfer_patch , & ! Output: [real(r8) (:) ] (gC/m2) fine root C transfer + livestemc_xfer => carbonstate_vars%livestemc_xfer_patch , & ! Output: [real(r8) (:) ] (gC/m2) live stem C transfer + deadstemc_xfer => carbonstate_vars%deadstemc_xfer_patch , & ! Output: [real(r8) (:) ] (gC/m2) dead stem C transfer + livecrootc_xfer => carbonstate_vars%livecrootc_xfer_patch , & ! Output: [real(r8) (:) ] (gC/m2) live coarse root C transfer + deadcrootc_xfer => carbonstate_vars%deadcrootc_xfer_patch , & ! Output: [real(r8) (:) ] (gC/m2) dead coarse root C transfer + + leafn_storage => nitrogenstate_vars%leafn_storage_patch , & ! Input: [real(r8) (:) ] (gN/m2) leaf N storage + frootn_storage => nitrogenstate_vars%frootn_storage_patch , & ! Input: [real(r8) (:) ] (gN/m2) fine root N storage + livestemn_storage => nitrogenstate_vars%livestemn_storage_patch , & ! Input: [real(r8) (:) ] (gN/m2) live stem N storage + deadstemn_storage => nitrogenstate_vars%deadstemn_storage_patch , & ! Input: [real(r8) (:) ] (gN/m2) dead stem N storage + livecrootn_storage => nitrogenstate_vars%livecrootn_storage_patch , & ! Input: [real(r8) (:) ] (gN/m2) live coarse root N storage + deadcrootn_storage => nitrogenstate_vars%deadcrootn_storage_patch , & ! Input: [real(r8) (:) ] (gN/m2) dead coarse root N storage + leafn_xfer => nitrogenstate_vars%leafn_xfer_patch , & ! Output: [real(r8) (:) ] (gN/m2) leaf N transfer + frootn_xfer => nitrogenstate_vars%frootn_xfer_patch , & ! Output: [real(r8) (:) ] (gN/m2) fine root N transfer + livestemn_xfer => nitrogenstate_vars%livestemn_xfer_patch , & ! Output: [real(r8) (:) ] (gN/m2) live stem N transfer + deadstemn_xfer => nitrogenstate_vars%deadstemn_xfer_patch , & ! Output: [real(r8) (:) ] (gN/m2) dead stem N transfer + livecrootn_xfer => nitrogenstate_vars%livecrootn_xfer_patch , & ! Output: [real(r8) (:) ] (gN/m2) live coarse root N transfer + deadcrootn_xfer => nitrogenstate_vars%deadcrootn_xfer_patch , & ! Output: [real(r8) (:) ] (gN/m2) dead coarse root N transfer + + + leafp_storage => phosphorusstate_vars%leafp_storage_patch , & ! Input: [real(r8) (:) ] (gP/m2) leaf P storage + frootp_storage => phosphorusstate_vars%frootp_storage_patch , & ! Input: [real(r8) (:) ] (gP/m2) fine root P storage + livestemp_storage => phosphorusstate_vars%livestemp_storage_patch , & ! Input: [real(r8) (:) ] (gP/m2) live stem P storage + deadstemp_storage => phosphorusstate_vars%deadstemp_storage_patch , & ! Input: [real(r8) (:) ] (gP/m2) dead stem P storage + livecrootp_storage => phosphorusstate_vars%livecrootp_storage_patch , & ! Input: [real(r8) (:) ] (gP/m2) live coarse root P storage + deadcrootp_storage => phosphorusstate_vars%deadcrootp_storage_patch , & ! Input: [real(r8) (:) ] (gP/m2) dead coarse root P storage + leafp_xfer => phosphorusstate_vars%leafp_xfer_patch , & ! Output: [real(r8) (:) ] (gP/m2) leaf P transfer + frootp_xfer => phosphorusstate_vars%frootp_xfer_patch , & ! Output: [real(r8) (:) ] (gP/m2) fine root P transfer + livestemp_xfer => phosphorusstate_vars%livestemp_xfer_patch , & ! Output: [real(r8) (:) ] (gP/m2) live stem P transfer + deadstemp_xfer => phosphorusstate_vars%deadstemp_xfer_patch , & ! Output: [real(r8) (:) ] (gP/m2) dead stem P transfer + livecrootp_xfer => phosphorusstate_vars%livecrootp_xfer_patch , & ! Output: [real(r8) (:) ] (gP/m2) live coarse root P transfer + deadcrootp_xfer => phosphorusstate_vars%deadcrootp_xfer_patch , & ! Output: [real(r8) (:) ] (gP/m2) dead coarse root P transfer + + prev_leafc_to_litter => carbonflux_vars%prev_leafc_to_litter_patch , & ! Output: [real(r8) (:) ] previous timestep leaf C litterfall flux (gC/m2/s) + prev_frootc_to_litter => carbonflux_vars%prev_frootc_to_litter_patch , & ! Output: [real(r8) (:) ] previous timestep froot C litterfall flux (gC/m2/s) + leafc_xfer_to_leafc => carbonflux_vars%leafc_xfer_to_leafc_patch , & ! Output: [real(r8) (:) ] + frootc_xfer_to_frootc => carbonflux_vars%frootc_xfer_to_frootc_patch , & ! Output: [real(r8) (:) ] + livestemc_xfer_to_livestemc => carbonflux_vars%livestemc_xfer_to_livestemc_patch , & ! Output: [real(r8) (:) ] + deadstemc_xfer_to_deadstemc => carbonflux_vars%deadstemc_xfer_to_deadstemc_patch , & ! Output: [real(r8) (:) ] + livecrootc_xfer_to_livecrootc => carbonflux_vars%livecrootc_xfer_to_livecrootc_patch , & ! Output: [real(r8) (:) ] + deadcrootc_xfer_to_deadcrootc => carbonflux_vars%deadcrootc_xfer_to_deadcrootc_patch , & ! Output: [real(r8) (:) ] + leafc_storage_to_xfer => carbonflux_vars%leafc_storage_to_xfer_patch , & ! Output: [real(r8) (:) ] + frootc_storage_to_xfer => carbonflux_vars%frootc_storage_to_xfer_patch , & ! Output: [real(r8) (:) ] + livestemc_storage_to_xfer => carbonflux_vars%livestemc_storage_to_xfer_patch , & ! Output: [real(r8) (:) ] + deadstemc_storage_to_xfer => carbonflux_vars%deadstemc_storage_to_xfer_patch , & ! Output: [real(r8) (:) ] + livecrootc_storage_to_xfer => carbonflux_vars%livecrootc_storage_to_xfer_patch , & ! Output: [real(r8) (:) ] + deadcrootc_storage_to_xfer => carbonflux_vars%deadcrootc_storage_to_xfer_patch , & ! Output: [real(r8) (:) ] + gresp_storage_to_xfer => carbonflux_vars%gresp_storage_to_xfer_patch , & ! Output: [real(r8) (:) ] + + leafn_xfer_to_leafn => nitrogenflux_vars%leafn_xfer_to_leafn_patch , & ! Output: [real(r8) (:) ] + frootn_xfer_to_frootn => nitrogenflux_vars%frootn_xfer_to_frootn_patch , & ! Output: [real(r8) (:) ] + livestemn_xfer_to_livestemn => nitrogenflux_vars%livestemn_xfer_to_livestemn_patch , & ! Output: [real(r8) (:) ] + deadstemn_xfer_to_deadstemn => nitrogenflux_vars%deadstemn_xfer_to_deadstemn_patch , & ! Output: [real(r8) (:) ] + livecrootn_xfer_to_livecrootn => nitrogenflux_vars%livecrootn_xfer_to_livecrootn_patch , & ! Output: [real(r8) (:) ] + deadcrootn_xfer_to_deadcrootn => nitrogenflux_vars%deadcrootn_xfer_to_deadcrootn_patch , & ! Output: [real(r8) (:) ] + leafn_storage_to_xfer => nitrogenflux_vars%leafn_storage_to_xfer_patch , & ! Output: [real(r8) (:) ] + frootn_storage_to_xfer => nitrogenflux_vars%frootn_storage_to_xfer_patch , & ! Output: [real(r8) (:) ] + livestemn_storage_to_xfer => nitrogenflux_vars%livestemn_storage_to_xfer_patch , & ! Output: [real(r8) (:) ] + deadstemn_storage_to_xfer => nitrogenflux_vars%deadstemn_storage_to_xfer_patch , & ! Output: [real(r8) (:) ] + livecrootn_storage_to_xfer => nitrogenflux_vars%livecrootn_storage_to_xfer_patch , & ! Output: [real(r8) (:) ] + deadcrootn_storage_to_xfer => nitrogenflux_vars%deadcrootn_storage_to_xfer_patch , & ! Output: [real(r8) (:) ] + + leafp_xfer_to_leafp => phosphorusflux_vars%leafp_xfer_to_leafp_patch , & ! Output: [real(r8) (:) ] + frootp_xfer_to_frootp => phosphorusflux_vars%frootp_xfer_to_frootp_patch , & ! Output: [real(r8) (:) ] + livestemp_xfer_to_livestemp => phosphorusflux_vars%livestemp_xfer_to_livestemp_patch , & ! Output: [real(r8) (:) ] + deadstemp_xfer_to_deadstemp => phosphorusflux_vars%deadstemp_xfer_to_deadstemp_patch , & ! Output: [real(r8) (:) ] + livecrootp_xfer_to_livecrootp => phosphorusflux_vars%livecrootp_xfer_to_livecrootp_patch , & ! Output: [real(r8) (:) ] + deadcrootp_xfer_to_deadcrootp => phosphorusflux_vars%deadcrootp_xfer_to_deadcrootp_patch , & ! Output: [real(r8) (:) ] + leafp_storage_to_xfer => phosphorusflux_vars%leafp_storage_to_xfer_patch , & ! Output: [real(r8) (:) ] + frootp_storage_to_xfer => phosphorusflux_vars%frootp_storage_to_xfer_patch , & ! Output: [real(r8) (:) ] + livestemp_storage_to_xfer => phosphorusflux_vars%livestemp_storage_to_xfer_patch , & ! Output: [real(r8) (:) ] + deadstemp_storage_to_xfer => phosphorusflux_vars%deadstemp_storage_to_xfer_patch , & ! Output: [real(r8) (:) ] + livecrootp_storage_to_xfer => phosphorusflux_vars%livecrootp_storage_to_xfer_patch , & ! Output: [real(r8) (:) ] + deadcrootp_storage_to_xfer => phosphorusflux_vars%deadcrootp_storage_to_xfer_patch & ! Output: [real(r8) (:) ] + + ) + + ! set time steps + dayspyr = get_days_per_year() + + do fp = 1,num_soilp + p = filter_soilp(fp) + c = veg_pp%column(p) + g = veg_pp%gridcell(p) + + if (stress_decid(ivt(p)) == 1._r8) then + soilt = t_soisno(c,3) + psi = soilpsi(c,3) + + ! onset gdd sum from Biome-BGC, v4.1.2 + crit_onset_gdd = exp(4.8_r8 + 0.13_r8*(annavg_t2m(p) - SHR_CONST_TKFRZ)) + + + ! update offset_counter and test for the end of the offset period + if (offset_flag(p) == 1._r8) then + ! decrement counter for offset period + offset_counter(p) = offset_counter(p) - dt + + ! if this is the end of the offset_period, reset phenology + ! flags and indices + if (offset_counter(p) == 0._r8) then + ! this code block was originally handled by call cn_offset_cleanup(p) + ! inlined during vectorization + offset_flag(p) = 0._r8 + offset_counter(p) = 0._r8 + dormant_flag(p) = 1._r8 + days_active(p) = 0._r8 + + ! reset the previous timestep litterfall flux memory + prev_leafc_to_litter(p) = 0._r8 + prev_frootc_to_litter(p) = 0._r8 + end if + end if + + ! update onset_counter and test for the end of the onset period + if (onset_flag(p) == 1.0_r8) then + ! decrement counter for onset period + onset_counter(p) = onset_counter(p) - dt + + ! if this is the end of the onset period, reset phenology + ! flags and indices + if (onset_counter(p) == 0.0_r8) then + ! this code block was originally handled by call cn_onset_cleanup(p) + ! inlined during vectorization + onset_flag(p) = 0._r8 + onset_counter(p) = 0._r8 + ! set all transfer growth rates to 0.0 + leafc_xfer_to_leafc(p) = 0._r8 + frootc_xfer_to_frootc(p) = 0._r8 + leafn_xfer_to_leafn(p) = 0._r8 + frootn_xfer_to_frootn(p) = 0._r8 + leafp_xfer_to_leafp(p) = 0._r8 + frootp_xfer_to_frootp(p) = 0._r8 + if (woody(ivt(p)) == 1.0_r8) then + livestemc_xfer_to_livestemc(p) = 0._r8 + deadstemc_xfer_to_deadstemc(p) = 0._r8 + livecrootc_xfer_to_livecrootc(p) = 0._r8 + deadcrootc_xfer_to_deadcrootc(p) = 0._r8 + livestemn_xfer_to_livestemn(p) = 0._r8 + deadstemn_xfer_to_deadstemn(p) = 0._r8 + livecrootn_xfer_to_livecrootn(p) = 0._r8 + deadcrootn_xfer_to_deadcrootn(p) = 0._r8 + livestemp_xfer_to_livestemp(p) = 0._r8 + deadstemp_xfer_to_deadstemp(p) = 0._r8 + livecrootp_xfer_to_livecrootp(p) = 0._r8 + deadcrootp_xfer_to_deadcrootp(p) = 0._r8 + end if + ! set transfer pools to 0.0 + leafc_xfer(p) = 0._r8 + leafn_xfer(p) = 0._r8 + leafp_xfer(p) = 0._r8 + frootc_xfer(p) = 0._r8 + frootn_xfer(p) = 0._r8 + frootp_xfer(p) = 0._r8 + if (woody(ivt(p)) == 1.0_r8) then + livestemc_xfer(p) = 0._r8 + livestemn_xfer(p) = 0._r8 + livestemp_xfer(p) = 0._r8 + deadstemc_xfer(p) = 0._r8 + deadstemn_xfer(p) = 0._r8 + deadstemp_xfer(p) = 0._r8 + livecrootc_xfer(p) = 0._r8 + livecrootn_xfer(p) = 0._r8 + livecrootp_xfer(p) = 0._r8 + deadcrootc_xfer(p) = 0._r8 + deadcrootn_xfer(p) = 0._r8 + deadcrootp_xfer(p) = 0._r8 + end if + end if + end if + + ! test for switching from dormant period to growth period + if (dormant_flag(p) == 1._r8) then + + ! keep track of the number of freezing degree days in this + ! dormancy period (only if the freeze flag has not previously been set + ! for this dormancy period + + if (onset_gddflag(p) == 0._r8 .and. soilt < SHR_CONST_TKFRZ) onset_fdd(p) = onset_fdd(p) + fracday + + ! if the number of freezing degree days exceeds a critical value, + ! then onset will require both wet soils and a critical soil + ! temperature sum. If this case is triggered, reset any previously + ! accumulated value in onset_swi, so that onset now depends on + ! the accumulated soil water index following the freeze trigger + + if (onset_fdd(p) > crit_onset_fdd) then + onset_gddflag(p) = 1._r8 + onset_fdd(p) = 0._r8 + onset_swi(p) = 0._r8 + end if + + ! if the freeze flag is set, and if the soil is above freezing + ! then accumulate growing degree days for onset trigger + + if (onset_gddflag(p) == 1._r8 .and. soilt > SHR_CONST_TKFRZ) then + onset_gdd(p) = onset_gdd(p) + (soilt-SHR_CONST_TKFRZ)*fracday + end if + + ! if soils are wet, accumulate soil water index for onset trigger + if (psi >= soilpsi_on) onset_swi(p) = onset_swi(p) + fracday + + ! if critical soil water index is exceeded, set onset_flag, and + ! then test for soil temperature criteria + + if (onset_swi(p) > crit_onset_swi) then + onset_flag(p) = 1._r8 + + ! only check soil temperature criteria if freeze flag set since + ! beginning of last dormancy. If freeze flag set and growing + ! degree day sum (since freeze trigger) is lower than critical + ! value, then override the onset_flag set from soil water. + + if (onset_gddflag(p) == 1._r8 .and. onset_gdd(p) < crit_onset_gdd) onset_flag(p) = 0._r8 + end if + + ! only allow onset if dayl > 6hrs + if (onset_flag(p) == 1._r8 .and. dayl(g) <= secspqtrday) then + onset_flag(p) = 0._r8 + end if + + ! if this is the beginning of the onset period + ! then reset the phenology flags and indices + + if (onset_flag(p) == 1._r8) then + dormant_flag(p) = 0._r8 + days_active(p) = 0._r8 + onset_gddflag(p) = 0._r8 + onset_fdd(p) = 0._r8 + onset_gdd(p) = 0._r8 + onset_swi(p) = 0._r8 + onset_counter(p) = ndays_on * secspday + + ! call subroutine to move all the storage pools into transfer pools, + ! where they will be transfered to displayed growth over the onset period. + ! this code was originally handled with call cn_storage_to_xfer(p) + ! inlined during vectorization + + ! set carbon fluxes for shifting storage pools to transfer pools + leafc_storage_to_xfer(p) = fstor2tran * leafc_storage(p)/dt + frootc_storage_to_xfer(p) = fstor2tran * frootc_storage(p)/dt + if (woody(ivt(p)) == 1.0_r8) then + livestemc_storage_to_xfer(p) = fstor2tran * livestemc_storage(p)/dt + deadstemc_storage_to_xfer(p) = fstor2tran * deadstemc_storage(p)/dt + livecrootc_storage_to_xfer(p) = fstor2tran * livecrootc_storage(p)/dt + deadcrootc_storage_to_xfer(p) = fstor2tran * deadcrootc_storage(p)/dt + gresp_storage_to_xfer(p) = fstor2tran * gresp_storage(p)/dt + end if + + ! set nitrogen fluxes for shifting storage pools to transfer pools + leafn_storage_to_xfer(p) = fstor2tran * leafn_storage(p)/dt + frootn_storage_to_xfer(p) = fstor2tran * frootn_storage(p)/dt + if (woody(ivt(p)) == 1.0_r8) then + livestemn_storage_to_xfer(p) = fstor2tran * livestemn_storage(p)/dt + deadstemn_storage_to_xfer(p) = fstor2tran * deadstemn_storage(p)/dt + livecrootn_storage_to_xfer(p) = fstor2tran * livecrootn_storage(p)/dt + deadcrootn_storage_to_xfer(p) = fstor2tran * deadcrootn_storage(p)/dt + end if + + ! set phosphorus fluxes for shifting storage pools to transfer pools + leafp_storage_to_xfer(p) = fstor2tran * leafp_storage(p)/dt + frootp_storage_to_xfer(p) = fstor2tran * frootp_storage(p)/dt + if (woody(ivt(p)) == 1.0_r8) then + livestemp_storage_to_xfer(p) = fstor2tran * livestemp_storage(p)/dt + deadstemp_storage_to_xfer(p) = fstor2tran * deadstemp_storage(p)/dt + livecrootp_storage_to_xfer(p) = fstor2tran * livecrootp_storage(p)/dt + deadcrootp_storage_to_xfer(p) = fstor2tran * deadcrootp_storage(p)/dt + end if + + end if + + ! test for switching from growth period to offset period + else if (offset_flag(p) == 0._r8) then + + ! if soil water potential lower than critical value, accumulate + ! as stress in offset soil water index + + if (psi <= soilpsi_off) then + offset_swi(p) = offset_swi(p) + fracday + + ! if the offset soil water index exceeds critical value, and + ! if this is not the middle of a previously initiated onset period, + ! then set flag to start the offset period and reset index variables + + if (offset_swi(p) >= crit_offset_swi .and. onset_flag(p) == 0._r8) offset_flag(p) = 1._r8 + + ! if soil water potential higher than critical value, reduce the + ! offset water stress index. By this mechanism, there must be a + ! sustained period of water stress to initiate offset. + + else if (psi >= soilpsi_on) then + offset_swi(p) = offset_swi(p) - fracday + offset_swi(p) = max(offset_swi(p),0._r8) + end if + + ! decrease freezing day accumulator for warm soil + if (offset_fdd(p) > 0._r8 .and. soilt > SHR_CONST_TKFRZ) then + offset_fdd(p) = offset_fdd(p) - fracday + offset_fdd(p) = max(0._r8, offset_fdd(p)) + end if + + ! increase freezing day accumulator for cold soil + if (soilt <= SHR_CONST_TKFRZ) then + offset_fdd(p) = offset_fdd(p) + fracday + + ! if freezing degree day sum is greater than critical value, initiate offset + if (offset_fdd(p) > crit_offset_fdd .and. onset_flag(p) == 0._r8) offset_flag(p) = 1._r8 + end if + + ! force offset if daylength is < 6 hrs + if (dayl(g) <= secspqtrday) then + offset_flag(p) = 1._r8 + end if + + ! if this is the beginning of the offset period + ! then reset flags and indices + if (offset_flag(p) == 1._r8) then + offset_fdd(p) = 0._r8 + offset_swi(p) = 0._r8 + offset_counter(p) = ndays_off * secspday + prev_leafc_to_litter(p) = 0._r8 + prev_frootc_to_litter(p) = 0._r8 + end if + end if + + ! keep track of number of days since last dormancy for control on + ! fraction of new growth to send to storage for next growing season + + if (dormant_flag(p) == 0.0_r8) then + days_active(p) = days_active(p) + fracday + end if + + ! calculate long growing season factor (lgsf) + ! only begin to calculate a lgsf greater than 0.0 once the number + ! of days active exceeds days/year. + lgsf(p) = max(min((days_active(p)-dayspyr)/dayspyr, 1._r8),0._r8) + + ! set background litterfall rate, when not in the phenological offset period + if (offset_flag(p) == 1._r8) then + bglfr(p) = 0._r8 + else + ! calculate the background litterfall rate (bglfr) + ! in units 1/s, based on leaf longevity (yrs) and correction for long growing season + + bglfr(p) = (1._r8/(leaf_long(ivt(p))*dayspyr*secspday))*lgsf(p) + end if + + ! set background transfer rate when active but not in the phenological onset period + if (onset_flag(p) == 1._r8) then + bgtr(p) = 0._r8 + else + ! the background transfer rate is calculated as the rate that would result + ! in complete turnover of the storage pools in one year at steady state, + ! once lgsf has reached 1.0 (after 730 days active). + + bgtr(p) = (1._r8/(dayspyr*secspday))*lgsf(p) + + ! set carbon fluxes for shifting storage pools to transfer pools + + leafc_storage_to_xfer(p) = leafc_storage(p) * bgtr(p) + frootc_storage_to_xfer(p) = frootc_storage(p) * bgtr(p) + if (woody(ivt(p)) == 1.0_r8) then + livestemc_storage_to_xfer(p) = livestemc_storage(p) * bgtr(p) + deadstemc_storage_to_xfer(p) = deadstemc_storage(p) * bgtr(p) + livecrootc_storage_to_xfer(p) = livecrootc_storage(p) * bgtr(p) + deadcrootc_storage_to_xfer(p) = deadcrootc_storage(p) * bgtr(p) + gresp_storage_to_xfer(p) = gresp_storage(p) * bgtr(p) + end if + + ! set nitrogen fluxes for shifting storage pools to transfer pools + leafn_storage_to_xfer(p) = leafn_storage(p) * bgtr(p) + frootn_storage_to_xfer(p) = frootn_storage(p) * bgtr(p) + if (woody(ivt(p)) == 1.0_r8) then + livestemn_storage_to_xfer(p) = livestemn_storage(p) * bgtr(p) + deadstemn_storage_to_xfer(p) = deadstemn_storage(p) * bgtr(p) + livecrootn_storage_to_xfer(p) = livecrootn_storage(p) * bgtr(p) + deadcrootn_storage_to_xfer(p) = deadcrootn_storage(p) * bgtr(p) + end if + + + ! set phosphorus fluxes for shifting storage pools to transfer pools + leafp_storage_to_xfer(p) = leafp_storage(p) * bgtr(p) + frootp_storage_to_xfer(p) = frootp_storage(p) * bgtr(p) + if (woody(ivt(p)) == 1.0_r8) then + livestemp_storage_to_xfer(p) = livestemp_storage(p) * bgtr(p) + deadstemp_storage_to_xfer(p) = deadstemp_storage(p) * bgtr(p) + livecrootp_storage_to_xfer(p) = livecrootp_storage(p) * bgtr(p) + deadcrootp_storage_to_xfer(p) = deadcrootp_storage(p) * bgtr(p) + end if + end if + + end if ! end if stress deciduous + + end do ! end of pft loop + + end associate + + end subroutine CNStressDecidPhenology + + !----------------------------------------------------------------------- + subroutine CropPhenology(num_pcropp, filter_pcropp , & + waterstate_vars, temperature_vars, crop_vars, canopystate_vars, cnstate_vars , & + carbonstate_vars, nitrogenstate_vars,carbonflux_vars,nitrogenflux_vars,& + phosphorusstate_vars, phosphorusflux_vars) + + ! !DESCRIPTION: + ! Code from AgroIBIS to determine crop phenology and code from CN to + ! handle CN fluxes during the phenological onset & offset periods. + + ! !USES: + use clm_time_manager , only : get_curr_date, get_curr_calday, get_days_per_year + use pftvarcon , only : ncorn, nscereal, nwcereal, nsoybean, gddmin, hybgdd + use pftvarcon , only : nwcerealirrig, nsoybeanirrig, ncornirrig, nscerealirrig + use pftvarcon , only : lfemerg, grnfill, mxmat, minplanttemp, planttemp + use clm_varcon , only : spval, secspday + ! + ! !ARGUMENTS: + integer , intent(in) :: num_pcropp ! number of prog crop patches in filter + integer , intent(in) :: filter_pcropp (:) ! filter for prognostic crop patches + type(waterstate_type) , intent(in) :: waterstate_vars + type(temperature_type) , intent(in) :: temperature_vars + type(crop_type) , intent(inout) :: crop_vars + type(canopystate_type) , intent(in) :: canopystate_vars + type(cnstate_type) , intent(inout) :: cnstate_vars + type(carbonstate_type) , intent(inout) :: carbonstate_vars + type(nitrogenstate_type) , intent(inout) :: nitrogenstate_vars + type(carbonflux_type) , intent(inout) :: carbonflux_vars + type(nitrogenflux_type) , intent(inout) :: nitrogenflux_vars + type(phosphorusstate_type) , intent(inout) :: phosphorusstate_vars + type(phosphorusflux_type) , intent(inout) :: phosphorusflux_vars + + ! + ! LOCAL VARAIBLES: + integer kyr ! current year + integer kmo ! month of year (1, ..., 12) + integer kda ! day of month (1, ..., 31) + integer mcsec ! seconds of day (0, ..., seconds/day) + integer jday ! julian day of the year + integer fp,p ! patch indices + integer c ! column indices + integer g ! gridcell indices + integer h ! hemisphere indices + integer idpp ! number of days past planting + real(r8) dayspyr ! days per year + real(r8) crmcorn ! comparitive relative maturity for corn + real(r8) ndays_on ! number of days to fertilize + !------------------------------------------------------------------------ + + associate( & + ivt => veg_pp%itype , & ! Input: [integer (:) ] pft vegetation type + + leaf_long => veg_vp%leaf_long , & ! Input: [real(r8) (:) ] leaf longevity (yrs) + leafcn => veg_vp%leafcn , & ! Input: [real(r8) (:) ] leaf C:N (gC/gN) + fertnitro => veg_vp%fertnitro , & ! Input: [real(r8) (:) ] max fertilizer to be applied in total (kgN/m2) + + t_ref2m_min => temperature_vars%t_ref2m_min_patch , & ! Input: [real(r8) (:) ] daily minimum of average 2 m height surface air temperature (K) + t10 => temperature_vars%t_a10_patch , & ! Input: [real(r8) (:) ] 10-day running mean of the 2 m temperature (K) + a5tmin => temperature_vars%t_a5min_patch , & ! Input: [real(r8) (:) ] 5-day running mean of min 2-m temperature + a10tmin => temperature_vars%t_a10min_patch , & ! Input: [real(r8) (:) ] 10-day running mean of min 2-m temperature + gdd020 => temperature_vars%gdd020_patch , & ! Input: [real(r8) (:) ] 20 yr mean of gdd0 + gdd820 => temperature_vars%gdd820_patch , & ! Input: [real(r8) (:) ] 20 yr mean of gdd8 + gdd1020 => temperature_vars%gdd1020_patch , & ! Input: [real(r8) (:) ] 20 yr mean of gdd10 + hui => crop_vars%gddplant_patch , & ! Input: [real(r8) (:) ] gdd since planting (gddplant) + leafout => crop_vars%gddtsoi_patch , & ! Input: [real(r8) (:) ] gdd from top soil layer temperature + + tlai => canopystate_vars%tlai_patch , & ! Input: [real(r8) (:) ] one-sided leaf area index, no burying by snow + + idop => cnstate_vars%idop_patch , & ! Output: [integer (:) ] date of planting + harvdate => cnstate_vars%harvdate_patch , & ! Output: [integer (:) ] harvest date + croplive => cnstate_vars%croplive_patch , & ! Output: [logical (:) ] Flag, true if planted, not harvested + cropplant => cnstate_vars%cropplant_patch , & ! Output: [logical (:) ] Flag, true if crop may be planted + gddmaturity => cnstate_vars%gddmaturity_patch , & ! Output: [real(r8) (:) ] gdd needed to harvest + huileaf => cnstate_vars%huileaf_patch , & ! Output: [real(r8) (:) ] heat unit index needed from planting to leaf emergence + huigrain => cnstate_vars%huigrain_patch , & ! Output: [real(r8) (:) ] same to reach vegetative maturity + cumvd => cnstate_vars%cumvd_patch , & ! Output: [real(r8) (:) ] cumulative vernalization d?ependence? + hdidx => cnstate_vars%hdidx_patch , & ! Output: [real(r8) (:) ] cold hardening index? + vf => cnstate_vars%vf_patch , & ! Output: [real(r8) (:) ] vernalization factor + bglfr => cnstate_vars%bglfr_patch , & ! Output: [real(r8) (:) ] background litterfall rate (1/s) + bgtr => cnstate_vars%bgtr_patch , & ! Output: [real(r8) (:) ] background transfer growth rate (1/s) + lgsf => cnstate_vars%lgsf_patch , & ! Output: [real(r8) (:) ] long growing season factor [0-1] + onset_flag => cnstate_vars%onset_flag_patch , & ! Output: [real(r8) (:) ] onset flag + offset_flag => cnstate_vars%offset_flag_patch , & ! Output: [real(r8) (:) ] offset flag + onset_counter => cnstate_vars%onset_counter_patch , & ! Output: [real(r8) (:) ] onset counter + offset_counter => cnstate_vars%offset_counter_patch , & ! Output: [real(r8) (:) ] offset counter + + leafc_xfer => carbonstate_vars%leafc_xfer_patch , & ! Output: [real(r8) (:) ] (gC/m2) leaf C transfer + + dwt_seedc_to_leaf => carbonflux_vars%dwt_seedc_to_leaf_col , & ! Output: [real(r8) (:) ] (gC/m2/s) seed source to PFT-level + + fert_counter => nitrogenflux_vars%fert_counter_patch , & ! Output: [real(r8) (:) ] >0 fertilize; <=0 not (seconds) + leafn_xfer => nitrogenstate_vars%leafn_xfer_patch , & ! Output: [real(r8) (:) ] (gN/m2) leaf N transfer + dwt_seedn_to_leaf => nitrogenflux_vars%dwt_seedn_to_leaf_col , & ! Output: [real(r8) (:) ] (gN/m2/s) seed source to PFT-level + crpyld => crop_vars%crpyld_patch , & ! Output: [real(r8) ):)] harvested crop (bu/acre) + dmyield => crop_vars%dmyield_patch , & ! Output: [real(r8) ):)] dry matter harvested crop (t/ha) + leafcp => veg_vp%leafcp , & ! Input: [real(r8) (:) ] leaf C:P (gC/gP) + leafp_xfer => phosphorusstate_vars%leafp_xfer_patch , & ! Output: [real(r8) (:) ] (gP/m2) leaf P transfer + dwt_seedp_to_leaf => phosphorusflux_vars%dwt_seedp_to_leaf_col , & ! Output: [real(r8) (:) ] (gP/m2/s) seed source to PFT-level + fert => nitrogenflux_vars%fert_patch & ! Output: [real(r8) (:) ] (gN/m2/s) fertilizer applied each timestep + ) + + ! get time info + dayspyr = get_days_per_year() + jday = get_curr_calday() + call get_curr_date(kyr, kmo, kda, mcsec) + + ndays_on = 20._r8 ! number of days to fertilize + + do fp = 1, num_pcropp + p = filter_pcropp(fp) + c = veg_pp%column(p) + g = veg_pp%gridcell(p) + h = inhemi(p) + + ! background litterfall and transfer rates; long growing season factor + + bglfr(p) = 0._r8 ! this value changes later in a crop's life cycle + bgtr(p) = 0._r8 + lgsf(p) = 0._r8 + + ! B.Drewniak - zero our yield calculator + crpyld(p) = 0._r8 + dmyield(p) = 0._r8 + + ! --------------------------------- + ! from AgroIBIS subroutine planting + ! --------------------------------- + + ! in order to allow a crop to be planted only once each year + ! initialize cropplant = .false., but hold it = .true. through the end of the year + + ! initialize other variables that are calculated for crops + ! on an annual basis in cropresidue subroutine + + if ( jday == jdayyrstart(h) .and. mcsec == 0 )then + + ! make sure variables aren't changed at beginning of the year + ! for a crop that is currently planted (e.g. winter temperate cereal) + + if (.not. croplive(p)) then + cropplant(p) = .false. + idop(p) = NOT_Planted + + ! keep next for continuous, annual winter temperate cereal type crop; + ! if we removed elseif, + ! winter cereal grown continuously would amount to a cereal/fallow + ! rotation because cereal would only be planted every other year + + else if (croplive(p) .and. (ivt(p) == nwcereal .or. ivt(p) == nwcerealirrig)) then + cropplant(p) = .false. + ! else ! not possible to have croplive and ivt==cornORsoy? (slevis) + end if + + end if + + if ( (.not. croplive(p)) .and. (.not. cropplant(p)) ) then + + ! gdd needed for * chosen crop and a likely hybrid (for that region) * + ! to reach full physiological maturity + + ! based on accumulated seasonal average growing degree days from + ! April 1 - Sept 30 (inclusive) + ! for corn and soybeans in the United States - + ! decided upon by what the typical average growing season length is + ! and the gdd needed to reach maturity in those regions + + ! first choice is used for spring temperate cereal and/or soybeans and maize + + ! slevis: ibis reads xinpdate in io.f from control.crops.nc variable name 'plantdate' + ! According to Chris Kucharik, the dataset of + ! xinpdate was generated from a previous model run at 0.5 deg resolution + + ! winter temperate cereal : use gdd0 as a limit to plant winter cereal + + if (ivt(p) == nwcereal .or. ivt(p) == nwcerealirrig) then + + ! add check to only plant winter cereal after other crops (soybean, maize) + ! have been harvested + + ! *** remember order of planting is crucial - in terms of which crops you want + ! to be grown in what order *** + + ! in this case, corn or soybeans are assumed to be planted before + ! cereal would be in any particular year that both patches are allowed + ! to grow in the same grid cell (e.g., double-cropping) + + ! slevis: harvdate below needs cropplant(p) above to be cropplant(p,ivt(p)) + ! where ivt(p) has rotated to winter cereal because + ! cropplant through the end of the year for a harvested crop. + ! Also harvdate(p) should be harvdate(p,ivt(p)) and should be + ! updated on Jan 1st instead of at harvest (slevis) + if (a5tmin(p) /= spval .and. & + a5tmin(p) <= minplanttemp(ivt(p)) .and. & + jday >= minplantjday(ivt(p),h) .and. & + (gdd020(p) /= spval .and. & + gdd020(p) >= gddmin(ivt(p)))) then + + cumvd(p) = 0._r8 + hdidx(p) = 0._r8 + vf(p) = 0._r8 + croplive(p) = .true. + cropplant(p) = .true. + idop(p) = jday + harvdate(p) = NOT_Harvested + gddmaturity(p) = hybgdd(ivt(p)) + leafc_xfer(p) = 1._r8 ! initial seed at planting to appear + leafn_xfer(p) = leafc_xfer(p) / leafcn(ivt(p)) ! with onset + dwt_seedc_to_leaf(c) = dwt_seedc_to_leaf(c) + leafc_xfer(p)/dt + dwt_seedn_to_leaf(c) = dwt_seedn_to_leaf(c) + leafn_xfer(p)/dt + + leafp_xfer(p) = leafc_xfer(p) / leafcp(ivt(p)) ! with onset + dwt_seedp_to_leaf(c) = dwt_seedp_to_leaf(c) + leafp_xfer(p)/dt + + ! latest possible date to plant winter cereal and after all other + ! crops were harvested for that year + + else if (jday >= maxplantjday(ivt(p),h) .and. & + gdd020(p) /= spval .and. & + gdd020(p) >= gddmin(ivt(p))) then + + cumvd(p) = 0._r8 + hdidx(p) = 0._r8 + vf(p) = 0._r8 + croplive(p) = .true. + cropplant(p) = .true. + idop(p) = jday + harvdate(p) = NOT_Harvested + gddmaturity(p) = hybgdd(ivt(p)) + leafc_xfer(p) = 1._r8 ! initial seed at planting to appear + leafn_xfer(p) = leafc_xfer(p) / leafcn(ivt(p)) ! with onset + dwt_seedc_to_leaf(c) = dwt_seedc_to_leaf(c) + leafc_xfer(p)/dt + dwt_seedn_to_leaf(c) = dwt_seedn_to_leaf(c) + leafn_xfer(p)/dt + + leafp_xfer(p) = leafc_xfer(p) / leafcp(ivt(p)) ! with onset + dwt_seedp_to_leaf(c) = dwt_seedp_to_leaf(c) + leafp_xfer(p)/dt + else + gddmaturity(p) = 0._r8 + end if + + else ! not winter cereal... slevis: added distinction between NH and SH + ! slevis: The idea is that jday will equal idop sooner or later in the year + ! while the gdd part is either true or false for the year. + if (t10(p) /= spval.and. a10tmin(p) /= spval .and. & + t10(p) > planttemp(ivt(p)) .and. & + a10tmin(p) > minplanttemp(ivt(p)) .and. & + jday >= minplantjday(ivt(p),h) .and. & + jday <= maxplantjday(ivt(p),h) .and. & + t10(p) /= spval .and. a10tmin(p) /= spval .and. & + gdd820(p) /= spval .and. & + gdd820(p) >= gddmin(ivt(p))) then + + ! impose limit on growing season length needed + ! for crop maturity - for cold weather constraints + croplive(p) = .true. + cropplant(p) = .true. + idop(p) = jday + harvdate(p) = NOT_Harvested + + ! go a specified amount of time before/after + ! climatological date + if (ivt(p)==nsoybean .or. ivt(p) == nsoybeanirrig) gddmaturity(p)=min(gdd1020(p),hybgdd(ivt(p))) + if (ivt(p)==ncorn .or. ivt(p)==ncornirrig) then + gddmaturity(p)=max(950._r8, min(gdd820(p)*0.85_r8, hybgdd(ivt(p)))) + gddmaturity(p)=max(950._r8, min(gddmaturity(p)+150._r8,1850._r8)) + end if + if (ivt(p)==nscereal .or. ivt(p) == nscerealirrig) gddmaturity(p)=min(gdd020(p),hybgdd(ivt(p))) + + leafc_xfer(p) = 1._r8 ! initial seed at planting to appear + leafn_xfer(p) = leafc_xfer(p) / leafcn(ivt(p)) ! with onset + dwt_seedc_to_leaf(c) = dwt_seedc_to_leaf(c) + leafc_xfer(p)/dt + dwt_seedn_to_leaf(c) = dwt_seedn_to_leaf(c) + leafn_xfer(p)/dt + + leafp_xfer(p) = leafc_xfer(p) / leafcp(ivt(p)) ! with onset + dwt_seedp_to_leaf(c) = dwt_seedp_to_leaf(c) + leafp_xfer(p)/dt + + ! If hit the max planting julian day -- go ahead and plant + else if (jday == maxplantjday(ivt(p),h) .and. gdd820(p) > 0._r8 .and. & + gdd820(p) /= spval ) then + croplive(p) = .true. + cropplant(p) = .true. + idop(p) = jday + harvdate(p) = NOT_Harvested + + if (ivt(p)==nsoybean .or. ivt(p) == nsoybeanirrig) gddmaturity(p)=min(gdd1020(p),hybgdd(ivt(p))) + if (ivt(p)==ncorn .or. ivt(p)==ncornirrig) gddmaturity(p)=max(950._r8, min(gdd820(p)*0.85_r8, hybgdd(ivt(p)))) + if (ivt(p)==nscereal .or. ivt(p) == nscerealirrig) gddmaturity(p)=min(gdd020(p),hybgdd(ivt(p))) + + leafc_xfer(p) = 1._r8 ! initial seed at planting to appear + leafn_xfer(p) = leafc_xfer(p) / leafcn(ivt(p)) ! with onset + dwt_seedc_to_leaf(c) = dwt_seedc_to_leaf(c) + leafc_xfer(p)/dt + dwt_seedn_to_leaf(c) = dwt_seedn_to_leaf(c) + leafn_xfer(p)/dt + + leafp_xfer(p) = leafc_xfer(p) / leafcp(ivt(p)) ! with onset + dwt_seedp_to_leaf(c) = dwt_seedp_to_leaf(c) + leafp_xfer(p)/dt + else + gddmaturity(p) = 0._r8 + end if + end if ! crop pft distinction + + ! crop phenology (gdd thresholds) controlled by gdd needed for + ! maturity (physiological) which is based on the average gdd + ! accumulation and hybrids in United States from April 1 - Sept 30 + + ! calculate threshold from phase 1 to phase 2: + ! threshold for attaining leaf emergence (based on fraction of + ! gdd(i) -- climatological average) + ! Hayhoe and Dwyer, 1990, Can. J. Soil Sci 70:493-497 + ! Carlson and Gage, 1989, Agric. For. Met., 45: 313-324 + ! J.T. Ritchie, 1991: Modeling Plant and Soil systems + + huileaf(p) = lfemerg(ivt(p)) * gddmaturity(p) ! 3-7% in cereal + + ! calculate threshhold from phase 2 to phase 3: + ! from leaf emergence to beginning of grain-fill period + ! this hypothetically occurs at the end of tassling, not the beginning + ! tassel initiation typically begins at 0.5-0.55 * gddmaturity + + ! calculate linear relationship between huigrain fraction and relative + ! maturity rating for maize + + if (ivt(p) == ncorn .or. ivt(p)==ncornirrig) then + ! the following estimation of crmcorn from gddmaturity is based on a linear + ! regression using data from Pioneer-brand corn hybrids (Kucharik, 2003, + ! Earth Interactions 7:1-33: fig. 2) + crmcorn = max(73._r8, min(135._r8, (gddmaturity(p)+ 53.683_r8)/13.882_r8)) + + ! the following adjustment of grnfill based on crmcorn is based on a tuning + ! of Agro-IBIS to give reasonable results for max LAI and the seasonal + ! progression of LAI growth (pers. comm. C. Kucharik June 10, 2010) + huigrain(p) = -0.002_r8 * (crmcorn - 73._r8) + grnfill(ivt(p)) + + huigrain(p) = min(max(huigrain(p), grnfill(ivt(p))-0.1_r8), grnfill(ivt(p))) + huigrain(p) = huigrain(p) * gddmaturity(p) ! Cabelguenne et + else + huigrain(p) = grnfill(ivt(p)) * gddmaturity(p) ! al. 1999 + end if + + end if ! crop not live nor planted + + ! ---------------------------------- + ! from AgroIBIS subroutine phenocrop + ! ---------------------------------- + + ! all of the phenology changes are based on the total number of gdd needed + ! to change to the next phase - based on fractions of the total gdd typical + ! for that region based on the April 1 - Sept 30 window of development + + ! crop phenology (gdd thresholds) controlled by gdd needed for + ! maturity (physiological) which is based on the average gdd + ! accumulation and hybrids in United States from April 1 - Sept 30 + + ! Phase 1: Planting to leaf emergence (now in CNAllocation) + ! Phase 2: Leaf emergence to beginning of grain fill (general LAI accumulation) + ! Phase 3: Grain fill to physiological maturity and harvest (LAI decline) + ! Harvest: if gdd past grain fill initiation exceeds limit + ! or number of days past planting reaches a maximum, the crop has + ! reached physiological maturity and plant is harvested; + ! crop could be live or dead at this stage - these limits + ! could lead to reaching physiological maturity or determining + ! a harvest date for a crop killed by an early frost (see next comments) + ! --- --- --- + ! keeping comments without the code (slevis): + ! if minimum temperature, t_ref2m_min <= freeze kill threshold, tkill + ! for 3 consecutive days and lai is above a minimum, + ! plant will be damaged/killed. This function is more for spring freeze events + ! or for early fall freeze events + + ! spring temperate cereal is affected by this, winter cereal kill function + ! is determined in crops.f - is a more elaborate function of + ! cold hardening of the plant + + ! currently simulates too many grid cells killed by freezing temperatures + + ! removed on March 12 2002 - C. Kucharik + ! until it can be a bit more refined, or used at a smaller scale. + ! we really have no way of validating this routine + ! too difficult to implement on 0.5 degree scale grid cells + ! --- --- --- + + onset_flag(p) = 0._r8 ! CN terminology to trigger certain + offset_flag(p) = 0._r8 ! carbon and nitrogen transfers + + if (croplive(p)) then + + ! call vernalization if winter temperate cereal planted, living, and the + ! vernalization factor is not 1; + ! vf affects the calculation of gddtsoi & gddplant + + if (t_ref2m_min(p) < 1.e30_r8 .and. vf(p) /= 1._r8 .and. (ivt(p) == nwcereal .or. ivt(p) == nwcerealirrig)) then + call vernalization(p, & + canopystate_vars, temperature_vars, waterstate_vars, cnstate_vars) + end if + + ! days past planting may determine harvest + + if (jday >= idop(p)) then + idpp = jday - idop(p) + else + idpp = int(dayspyr) + jday - idop(p) + end if + + ! onset_counter initialized to zero when .not. croplive + ! offset_counter relevant only at time step of harvest + + onset_counter(p) = onset_counter(p) - dt + + ! enter phase 2 onset for one time step: + ! transfer seed carbon to leaf emergence + + if (leafout(p) >= huileaf(p) .and. hui(p) < huigrain(p) .and. idpp < mxmat(ivt(p))) then + if (abs(onset_counter(p)) > 1.e-6_r8) then + onset_flag(p) = 1._r8 + onset_counter(p) = dt + fert_counter(p) = ndays_on * secspday + fert(p) = fertnitro(ivt(p)) * 1000._r8 / fert_counter(p) + else + ! this ensures no re-entry to onset of phase2 + ! b/c onset_counter(p) = onset_counter(p) - dt + ! at every time step + + onset_counter(p) = dt + end if + + ! enter harvest for one time step: + ! - transfer live biomass to litter and to crop yield + ! - send xsmrpool to the atmosphere + ! if onset and harvest needed to last longer than one timestep + ! the onset_counter would change from dt and you'd need to make + ! changes to the offset subroutine below + + else if (hui(p) >= gddmaturity(p) .or. idpp >= mxmat(ivt(p))) then + if (harvdate(p) >= NOT_Harvested) harvdate(p) = jday + croplive(p) = .false. ! no re-entry in greater if-block + if (tlai(p) > 0._r8) then ! plant had emerged before harvest + offset_flag(p) = 1._r8 + offset_counter(p) = dt + else ! plant never emerged from the ground + dwt_seedc_to_leaf(c) = dwt_seedc_to_leaf(c) - leafc_xfer(p)/dt + dwt_seedn_to_leaf(c) = dwt_seedn_to_leaf(c) - leafn_xfer(p)/dt + dwt_seedp_to_leaf(c) = dwt_seedp_to_leaf(c) - leafp_xfer(p)/dt + leafc_xfer(p) = 0._r8 ! revert planting transfers + leafn_xfer(p) = leafc_xfer(p) / leafcn(ivt(p)) + leafp_xfer(p) = leafc_xfer(p) / leafcp(ivt(p)) + end if + + ! enter phase 3 while previous criteria fail and next is true; + ! in terms of order, phase 3 occurs before harvest, but when + ! harvest *can* occur, we want it to have first priority. + ! AgroIBIS uses a complex formula for lai decline. + ! Use CN's simple formula at least as a place holder (slevis) + + else if (hui(p) >= huigrain(p)) then + bglfr(p) = 1._r8/(leaf_long(ivt(p))*dayspyr*secspday) + end if + + ! continue fertilizer application while in phase 2; + ! assumes that onset of phase 2 took one time step only + + if (fert_counter(p) <= 0._r8) then + fert(p) = 0._r8 + else ! continue same fert application every timestep + fert_counter(p) = fert_counter(p) - dt + end if + + else ! crop not live + ! next 2 lines conserve mass if leaf*_xfer > 0 due to interpinic + dwt_seedc_to_leaf(c) = dwt_seedc_to_leaf(c) - leafc_xfer(p)/dt + dwt_seedn_to_leaf(c) = dwt_seedn_to_leaf(c) - leafn_xfer(p)/dt + dwt_seedp_to_leaf(c) = dwt_seedp_to_leaf(c) - leafp_xfer(p)/dt + onset_counter(p) = 0._r8 + leafc_xfer(p) = 0._r8 + leafn_xfer(p) = leafc_xfer(p) / leafcn(ivt(p)) + leafp_xfer(p) = leafc_xfer(p) / leafcp(ivt(p)) + end if ! croplive + + end do ! prognostic crops loop + + end associate + + end subroutine CropPhenology + + !----------------------------------------------------------------------- + subroutine CropPhenologyInit(bounds) + ! + ! !DESCRIPTION: + ! Initialization of CropPhenology. Must be called after time-manager is + ! initialized, and after ecophyscon file is read in. + ! + ! !USES: + use pftvarcon , only: npcropmin, npcropmax, mnNHplantdate + use pftvarcon , only: mnSHplantdate, mxNHplantdate + use pftvarcon , only: mxSHplantdate + use clm_time_manager, only: get_calday + ! + ! !ARGUMENTS: + implicit none + type(bounds_type), intent(in) :: bounds + ! + ! LOCAL VARAIBLES: + integer :: p,g,n,i ! indices + !------------------------------------------------------------------------ + + allocate( inhemi(bounds%begp:bounds%endp) ) + + allocate( minplantjday(0:numpft,inSH)) ! minimum planting julian day + allocate( maxplantjday(0:numpft,inSH)) ! minimum planting julian day + + ! Julian day for the start of the year (mid-winter) + jdayyrstart(inNH) = 1 + jdayyrstart(inSH) = 182 + + ! Convert planting dates into julian day + minplantjday(:,:) = huge(1) + maxplantjday(:,:) = huge(1) + do n = npcropmin, npcropmax + minplantjday(n,inNH) = int( get_calday( mnNHplantdate(n), 0 ) ) + maxplantjday(n,inNH) = int( get_calday( mxNHplantdate(n), 0 ) ) + end do + do n = npcropmin, npcropmax + minplantjday(n,inSH) = int( get_calday( mnSHplantdate(n), 0 ) ) + maxplantjday(n,inSH) = int( get_calday( mxSHplantdate(n), 0 ) ) + end do + + ! Figure out what hemisphere each PFT is in + do p = bounds%begp, bounds%endp + g = veg_pp%gridcell(p) + ! Northern hemisphere + if ( grc_pp%latdeg(g) > 0.0_r8 )then + inhemi(p) = inNH + else + inhemi(p) = inSH + end if + end do + + ! + ! Constants for Crop vernalization + ! + ! photoperiod factor calculation + ! genetic constant - can be modified + + p1d = 0.004_r8 ! average for genotypes from Ritchey, 1991. + ! Modeling plant & soil systems: Wheat phasic developmt + p1v = 0.003_r8 ! average for genotypes from Ritchey, 1991. + + hti = 1._r8 + tbase = 0._r8 + + end subroutine CropPhenologyInit + + !----------------------------------------------------------------------- + subroutine vernalization(p, & + canopystate_vars, temperature_vars, waterstate_vars, cnstate_vars) + ! + ! !DESCRIPTION: + ! + ! * * * only call for winter temperate cereal * * * + ! + ! subroutine calculates vernalization and photoperiod effects on + ! gdd accumulation in winter temperate cereal varieties. Thermal time accumulation + ! is reduced in 1st period until plant is fully vernalized. During this + ! time of emergence to spikelet formation, photoperiod can also have a + ! drastic effect on plant development. + ! + ! !ARGUMENTS: + integer , intent(in) :: p ! PATCH index running over + type(canopystate_type) , intent(in) :: canopystate_vars + type(temperature_type) , intent(in) :: temperature_vars + type(waterstate_type) , intent(in) :: waterstate_vars + type(cnstate_type) , intent(inout) :: cnstate_vars + ! + ! LOCAL VARAIBLES: + real(r8) tcrown ! ? + real(r8) vd, vd1, vd2 ! vernalization dependence + real(r8) tkil ! Freeze kill threshold + integer c,g ! indices + !------------------------------------------------------------------------ + + associate( & + tlai => canopystate_vars%tlai_patch , & ! Input: [real(r8) (:) ] one-sided leaf area index, no burying by snow + + t_ref2m => temperature_vars%t_ref2m_patch , & ! Input: [real(r8) (:) ] 2 m height surface air temperature (K) + t_ref2m_min => temperature_vars%t_ref2m_min_patch , & ! Input: [real(r8) (:) ] daily minimum of average 2 m height surface air temperature (K) + t_ref2m_max => temperature_vars%t_ref2m_max_patch , & ! Input: [real(r8) (:) ] daily maximum of average 2 m height surface air temperature (K) + + snow_depth => waterstate_vars%snow_depth_col , & ! Input: [real(r8) (:) ] snow height (m) + + hdidx => cnstate_vars%hdidx_patch , & ! Output: [real(r8) (:) ] cold hardening index? + cumvd => cnstate_vars%cumvd_patch , & ! Output: [real(r8) (:) ] cumulative vernalization d?ependence? + vf => cnstate_vars%vf_patch , & ! Output: [real(r8) (:) ] vernalization factor for cereal + gddmaturity => cnstate_vars%gddmaturity_patch , & ! Output: [real(r8) (:) ] gdd needed to harvest + huigrain => cnstate_vars%huigrain_patch & ! Output: [real(r8) (:) ] heat unit index needed to reach vegetative maturity + ) + + c = veg_pp%column(p) + + ! for all equations - temperatures must be in degrees (C) + ! calculate temperature of crown of crop (e.g., 3 cm soil temperature) + ! snow depth in centimeters + + if (t_ref2m(p) < tfrz) then !slevis: t_ref2m inst of td=daily avg (K) + tcrown = 2._r8 + (t_ref2m(p) - tfrz) * (0.4_r8 + 0.0018_r8 * & + (min(snow_depth(c)*100._r8, 15._r8) - 15._r8)**2) + else !slevis: snow_depth inst of adsnod=daily average (m) + tcrown = t_ref2m(p) - tfrz + end if + + ! vernalization factor calculation + ! if vf(p) = 1. then plant is fully vernalized - and thermal time + ! accumulation in phase 1 will be unaffected + ! refers to gddtsoi & gddplant, defined in the accumulation routines (slevis) + ! reset vf, cumvd, and hdidx to 0 at planting of crop (slevis) + + if (t_ref2m_max(p) > tfrz) then + if (t_ref2m_min(p) <= tfrz+15._r8) then + vd1 = 1.4_r8 - 0.0778_r8 * tcrown + vd2 = 0.5_r8 + 13.44_r8 / ((t_ref2m_max(p)-t_ref2m_min(p)+3._r8)**2) * tcrown + vd = max(0._r8, min(1._r8, vd1, vd2)) + cumvd(p) = cumvd(p) + vd + end if + + if (cumvd(p) < 10._r8 .and. t_ref2m_max(p) > tfrz+30._r8) then + cumvd(p) = cumvd(p) - 0.5_r8 * (t_ref2m_max(p) - tfrz - 30._r8) + end if + cumvd(p) = max(0._r8, cumvd(p)) ! must be > 0 + + vf(p) = 1._r8 - p1v * (50._r8 - cumvd(p)) + vf(p) = max(0._r8, min(vf(p), 1._r8)) ! must be between 0 - 1 + end if + + ! calculate cold hardening of plant + ! determines for winter cereal varieties whether the plant has completed + ! a period of cold hardening to protect it from freezing temperatures. If + ! not, then exposure could result in death or killing of plants. + + ! there are two distinct phases of hardening + + if (t_ref2m_min(p) <= tfrz-3._r8 .or. hdidx(p) /= 0._r8) then + if (hdidx(p) >= hti) then ! done with phase 1 + hdidx(p) = hdidx(p) + 0.083_r8 + hdidx(p) = min(hdidx(p), hti*2._r8) + end if + + if (t_ref2m_max(p) >= tbase + tfrz + 10._r8) then + hdidx(p) = hdidx(p) - 0.02_r8 * (t_ref2m_max(p)-tbase-tfrz-10._r8) + if (hdidx(p) > hti) hdidx(p) = hdidx(p) - 0.02_r8 * (t_ref2m_max(p)-tbase-tfrz-10._r8) + hdidx(p) = max(0._r8, hdidx(p)) + end if + + else if (tcrown >= tbase-1._r8) then + if (tcrown <= tbase+8._r8) then + hdidx(p) = hdidx(p) + 0.1_r8 - (tcrown-tbase+3.5_r8)**2 / 506._r8 + if (hdidx(p) >= hti .and. tcrown <= tbase + 0._r8) then + hdidx(p) = hdidx(p) + 0.083_r8 + hdidx(p) = min(hdidx(p), hti*2._r8) + end if + end if + + if (t_ref2m_max(p) >= tbase + tfrz + 10._r8) then + hdidx(p) = hdidx(p) - 0.02_r8 * (t_ref2m_max(p)-tbase-tfrz-10._r8) + if (hdidx(p) > hti) hdidx(p) = hdidx(p) - 0.02_r8 * (t_ref2m_max(p)-tbase-tfrz-10._r8) + hdidx(p) = max(0._r8, hdidx(p)) + end if + end if + + ! calculate what the cereal killing temperature + ! there is a linear inverse relationship between + ! hardening of the plant and the killing temperature or + ! threshold that the plant can withstand + ! when plant is fully-hardened (hdidx = 2), the killing threshold is -18 C + + ! will have to develop some type of relationship that reduces LAI and + ! biomass pools in response to cold damaged crop + + if (t_ref2m_min(p) <= tfrz - 6._r8) then + tkil = (tbase - 6._r8) - 6._r8 * hdidx(p) + if (tkil >= tcrown) then + if ((0.95_r8 - 0.02_r8 * (tcrown - tkil)**2) >= 0.02_r8) then + write (iulog,*) 'crop damaged by cold temperatures at p,c =', p,c + else if (tlai(p) > 0._r8) then ! slevis: kill if past phase1 + gddmaturity(p) = 0._r8 ! by forcing through + huigrain(p) = 0._r8 ! harvest + write (iulog,*) '95% of crop killed by cold temperatures at p,c =', p,c + end if + end if + end if + + end associate + + end subroutine vernalization + + !----------------------------------------------------------------------- + subroutine CNOnsetGrowth (num_soilp, filter_soilp, & + cnstate_vars, & + carbonstate_vars, nitrogenstate_vars, carbonflux_vars,nitrogenflux_vars,& + phosphorusstate_vars,phosphorusflux_vars) + ! + ! !DESCRIPTION: + ! Determines the flux of stored C and N from transfer pools to display + ! pools during the phenological onset period. + ! add flux for phosphorus - X.YANG + ! + ! !ARGUMENTS: + integer , intent(in) :: num_soilp ! number of soil patches in filter + integer , intent(in) :: filter_soilp(:) ! filter for soil patches + type(cnstate_type) , intent(in) :: cnstate_vars + type(carbonstate_type) , intent(in) :: carbonstate_vars + type(nitrogenstate_type) , intent(in) :: nitrogenstate_vars + type(carbonflux_type) , intent(inout) :: carbonflux_vars + type(nitrogenflux_type) , intent(inout) :: nitrogenflux_vars + type(phosphorusstate_type) , intent(in) :: phosphorusstate_vars + type(phosphorusflux_type) , intent(inout) :: phosphorusflux_vars + ! + ! !LOCAL VARIABLES: + integer :: p ! indices + integer :: fp ! lake filter pft index + real(r8):: t1 ! temporary variable + !----------------------------------------------------------------------- + + associate( & + ivt => veg_pp%itype , & ! Input: [integer (:) ] pft vegetation type + + woody => veg_vp%woody , & ! Input: [real(r8) (:) ] binary flag for woody lifeform (1=woody, 0=not woody) + + onset_flag => cnstate_vars%onset_flag_patch , & ! Input: [real(r8) (:) ] onset flag + onset_counter => cnstate_vars%onset_counter_patch , & ! Input: [real(r8) (:) ] onset days counter + bgtr => cnstate_vars%bgtr_patch , & ! Input: [real(r8) (:) ] background transfer growth rate (1/s) + + leafc_xfer => carbonstate_vars%leafc_xfer_patch , & ! Input: [real(r8) (:) ] (gC/m2) leaf C transfer + frootc_xfer => carbonstate_vars%frootc_xfer_patch , & ! Input: [real(r8) (:) ] (gC/m2) fine root C transfer + livestemc_xfer => carbonstate_vars%livestemc_xfer_patch , & ! Input: [real(r8) (:) ] (gC/m2) live stem C transfer + deadstemc_xfer => carbonstate_vars%deadstemc_xfer_patch , & ! Input: [real(r8) (:) ] (gC/m2) dead stem C transfer + livecrootc_xfer => carbonstate_vars%livecrootc_xfer_patch , & ! Input: [real(r8) (:) ] (gC/m2) live coarse root C transfer + deadcrootc_xfer => carbonstate_vars%deadcrootc_xfer_patch , & ! Input: [real(r8) (:) ] (gC/m2) dead coarse root C transfer + + leafn_xfer => nitrogenstate_vars%leafn_xfer_patch , & ! Input: [real(r8) (:) ] (gN/m2) leaf N transfer + frootn_xfer => nitrogenstate_vars%frootn_xfer_patch , & ! Input: [real(r8) (:) ] (gN/m2) fine root N transfer + livestemn_xfer => nitrogenstate_vars%livestemn_xfer_patch , & ! Input: [real(r8) (:) ] (gN/m2) live stem N transfer + deadstemn_xfer => nitrogenstate_vars%deadstemn_xfer_patch , & ! Input: [real(r8) (:) ] (gN/m2) dead stem N transfer + livecrootn_xfer => nitrogenstate_vars%livecrootn_xfer_patch , & ! Input: [real(r8) (:) ] (gN/m2) live coarse root N transfer + deadcrootn_xfer => nitrogenstate_vars%deadcrootn_xfer_patch , & ! Input: [real(r8) (:) ] (gN/m2) dead coarse root N transfer + + + leafp_xfer => phosphorusstate_vars%leafp_xfer_patch , & ! Input: [real(r8)(:) ] (gP/m2) leaf P transfer + frootp_xfer => phosphorusstate_vars%frootp_xfer_patch , & ! Input: [real(r8)(:) ] (gP/m2) fine root P transfer + livestemp_xfer => phosphorusstate_vars%livestemp_xfer_patch , & ! Input: [real(r8)(:) ] (gP/m2) live stem P transfer + deadstemp_xfer => phosphorusstate_vars%deadstemp_xfer_patch , & ! Input: [real(r8)(:) ] (gP/m2) dead stem P transfer + livecrootp_xfer => phosphorusstate_vars%livecrootp_xfer_patch , & ! Input: [real(r8)(:) ] (gP/m2) live coarse root P transfer + deadcrootp_xfer => phosphorusstate_vars%deadcrootp_xfer_patch , & ! Input: [real(r8)(:) ] (gP/m2) dead coarse root P transfer + + + leafc_xfer_to_leafc => carbonflux_vars%leafc_xfer_to_leafc_patch , & ! Output: [real(r8) (:) ] + frootc_xfer_to_frootc => carbonflux_vars%frootc_xfer_to_frootc_patch , & ! Output: [real(r8) (:) ] + livestemc_xfer_to_livestemc => carbonflux_vars%livestemc_xfer_to_livestemc_patch , & ! Output: [real(r8) (:) ] + deadstemc_xfer_to_deadstemc => carbonflux_vars%deadstemc_xfer_to_deadstemc_patch , & ! Output: [real(r8) (:) ] + livecrootc_xfer_to_livecrootc => carbonflux_vars%livecrootc_xfer_to_livecrootc_patch , & ! Output: [real(r8) (:) ] + deadcrootc_xfer_to_deadcrootc => carbonflux_vars%deadcrootc_xfer_to_deadcrootc_patch , & ! Output: [real(r8) (:) ] + + leafn_xfer_to_leafn => nitrogenflux_vars%leafn_xfer_to_leafn_patch , & ! Output: [real(r8) (:) ] + frootn_xfer_to_frootn => nitrogenflux_vars%frootn_xfer_to_frootn_patch , & ! Output: [real(r8) (:) ] + livestemn_xfer_to_livestemn => nitrogenflux_vars%livestemn_xfer_to_livestemn_patch , & ! Output: [real(r8) (:) ] + deadstemn_xfer_to_deadstemn => nitrogenflux_vars%deadstemn_xfer_to_deadstemn_patch , & ! Output: [real(r8) (:) ] + livecrootn_xfer_to_livecrootn => nitrogenflux_vars%livecrootn_xfer_to_livecrootn_patch , & ! Output: [real(r8) (:) ] + deadcrootn_xfer_to_deadcrootn => nitrogenflux_vars%deadcrootn_xfer_to_deadcrootn_patch , & ! Output: [real(r8) (:) ] + + leafp_xfer_to_leafp => phosphorusflux_vars%leafp_xfer_to_leafp_patch , & ! Output: [real(r8) (:) ] + frootp_xfer_to_frootp => phosphorusflux_vars%frootp_xfer_to_frootp_patch , & ! Output: [real(r8) (:) ] + livestemp_xfer_to_livestemp => phosphorusflux_vars%livestemp_xfer_to_livestemp_patch , & ! Output: [real(r8) (:) ] + deadstemp_xfer_to_deadstemp => phosphorusflux_vars%deadstemp_xfer_to_deadstemp_patch , & ! Output: [real(r8) (:) ] + livecrootp_xfer_to_livecrootp => phosphorusflux_vars%livecrootp_xfer_to_livecrootp_patch , & ! Output: [real(r8) (:) ] + deadcrootp_xfer_to_deadcrootp => phosphorusflux_vars%deadcrootp_xfer_to_deadcrootp_patch & ! Output: [real(r8) (:) ] + ) + + ! patch loop + do fp = 1,num_soilp + p = filter_soilp(fp) + + ! only calculate these fluxes during onset period + if (onset_flag(p) == 1._r8) then + + ! The transfer rate is a linearly decreasing function of time, + ! going to zero on the last timestep of the onset period + + if (onset_counter(p) == dt) then + t1 = 1.0_r8 / dt + else + t1 = 2.0_r8 / (onset_counter(p)) + end if + leafc_xfer_to_leafc(p) = t1 * leafc_xfer(p) + frootc_xfer_to_frootc(p) = t1 * frootc_xfer(p) + leafn_xfer_to_leafn(p) = t1 * leafn_xfer(p) + frootn_xfer_to_frootn(p) = t1 * frootn_xfer(p) + leafp_xfer_to_leafp(p) = t1 * leafp_xfer(p) + frootp_xfer_to_frootp(p) = t1 * frootp_xfer(p) + if (woody(ivt(p)) == 1.0_r8) then + livestemc_xfer_to_livestemc(p) = t1 * livestemc_xfer(p) + deadstemc_xfer_to_deadstemc(p) = t1 * deadstemc_xfer(p) + livecrootc_xfer_to_livecrootc(p) = t1 * livecrootc_xfer(p) + deadcrootc_xfer_to_deadcrootc(p) = t1 * deadcrootc_xfer(p) + livestemn_xfer_to_livestemn(p) = t1 * livestemn_xfer(p) + deadstemn_xfer_to_deadstemn(p) = t1 * deadstemn_xfer(p) + livecrootn_xfer_to_livecrootn(p) = t1 * livecrootn_xfer(p) + deadcrootn_xfer_to_deadcrootn(p) = t1 * deadcrootn_xfer(p) + + livestemp_xfer_to_livestemp(p) = t1 * livestemp_xfer(p) + deadstemp_xfer_to_deadstemp(p) = t1 * deadstemp_xfer(p) + livecrootp_xfer_to_livecrootp(p) = t1 * livecrootp_xfer(p) + deadcrootp_xfer_to_deadcrootp(p) = t1 * deadcrootp_xfer(p) + end if + + end if ! end if onset period + + ! calculate the background rate of transfer growth (used for stress + ! deciduous algorithm). In this case, all of the mass in the transfer + ! pools should be moved to displayed growth in each timestep. + + if (bgtr(p) > 0._r8) then + leafc_xfer_to_leafc(p) = leafc_xfer(p) / dt + frootc_xfer_to_frootc(p) = frootc_xfer(p) / dt + leafn_xfer_to_leafn(p) = leafn_xfer(p) / dt + frootn_xfer_to_frootn(p) = frootn_xfer(p) / dt + leafp_xfer_to_leafp(p) = leafp_xfer(p) / dt + frootp_xfer_to_frootp(p) = frootp_xfer(p) / dt + if (woody(ivt(p)) == 1.0_r8) then + livestemc_xfer_to_livestemc(p) = livestemc_xfer(p) / dt + deadstemc_xfer_to_deadstemc(p) = deadstemc_xfer(p) / dt + livecrootc_xfer_to_livecrootc(p) = livecrootc_xfer(p) / dt + deadcrootc_xfer_to_deadcrootc(p) = deadcrootc_xfer(p) / dt + livestemn_xfer_to_livestemn(p) = livestemn_xfer(p) / dt + deadstemn_xfer_to_deadstemn(p) = deadstemn_xfer(p) / dt + livecrootn_xfer_to_livecrootn(p) = livecrootn_xfer(p) / dt + deadcrootn_xfer_to_deadcrootn(p) = deadcrootn_xfer(p) / dt + livestemp_xfer_to_livestemp(p) = livestemp_xfer(p) / dt + deadstemp_xfer_to_deadstemp(p) = deadstemp_xfer(p) / dt + livecrootp_xfer_to_livecrootp(p) = livecrootp_xfer(p) / dt + deadcrootp_xfer_to_deadcrootp(p) = deadcrootp_xfer(p) / dt + end if + end if ! end if bgtr + + end do ! end pft loop + + end associate + + end subroutine CNOnsetGrowth + + !---------------------------------------------------------------------- + subroutine CNCropHarvest (num_pcropp, filter_pcropp, num_soilc, filter_soilc, crop_vars, & + cnstate_vars, carbonstate_vars, carbonflux_vars, nitrogenstate_vars, nitrogenflux_vars, & + phosphorusstate_vars, phosphorusflux_vars) + ! + ! !DESCRIPTION: + ! This routine handles harvest for agriculture vegetation types, such as + ! corn, soybean, and wheat. This routine allows harvest to be calculated + ! instead of in the OffsetLitterfall subroutine. The harvest index is + ! determined based on the LPJ model. + ! + ! !ARGUMENTS: + integer, intent(in) :: num_pcropp ! number of prog crop pfts in filter + integer, intent(in) :: filter_pcropp(:) ! filter for prognostic crop pfts + integer, intent(in) :: num_soilc ! number of soil columns in filter + integer, intent(in) :: filter_soilc(:) ! soil column filter + + type(crop_type) , intent(inout) :: crop_vars + type(cnstate_type) , intent(inout) :: cnstate_vars + type(carbonstate_type) , intent(in) :: carbonstate_vars + type(carbonflux_type) , intent(inout) :: carbonflux_vars + type(nitrogenstate_type), intent(in) :: nitrogenstate_vars + type(nitrogenflux_type) , intent(inout) :: nitrogenflux_vars + type(phosphorusstate_type),intent(inout):: phosphorusstate_vars + type(phosphorusflux_type), intent(inout):: phosphorusflux_vars + ! + ! !LOCAL VARIABLES: + ! local pointers to implicit in scalars + integer :: p ! indices + integer :: fp ! lake filter pft index + real(r8):: t1 ! temporary variable + real(r8):: cgrain ! amount of carbon in the grain + !------------------------------------------------------------------------- + associate(& + ivt => veg_pp%itype , & ! Input: [integer (:)] pft vegetation type + offset_flag => cnstate_vars%offset_flag_patch , & ! Input: [real(r8) (:) ] offset flag + offset_counter => cnstate_vars%offset_counter_patch , & ! Input: [real(r8) (:) ] offset days counter + + presharv => veg_vp%presharv , & ! Input: [real(r8) (:) ] porportion of residue harvested + fyield => veg_vp%fyield , & ! Input: [real(r8) (:) ] fraction of grain actually harvested + convfact => veg_vp%convfact , & ! Input: [real(r8) (:) ] converstion factor for bu/acre + + leafc => carbonstate_vars%leafc_patch , & ! Input: [real(r8) (:) ] (gC/m2) leaf C + grainc => carbonstate_vars%grainc_patch , & ! Input: [real(r8) (:) ] (gC/m2) grain C + livestemc => carbonstate_vars%livestemc_patch , & ! Input: [real(r8) (:) ] (gC/m2) livestem C + leafn => nitrogenstate_vars%leafn_patch , & ! Input: [real(r8) (:) ] (gN/m2) leaf N + grainn => nitrogenstate_vars%grainn_patch , & ! Input: [real(r8) (:) ] (gN/m2) grain N + livestemn => nitrogenstate_vars%livestemn_patch , & ! Input: [real(r8) (:) ] (gN/m2) livestem N + leafp => phosphorusstate_vars%leafp_patch , & ! Input: [real(r8) (:) ] (gP/m2) leaf P + grainp => phosphorusstate_vars%grainp_patch , & ! Input: [real(r8) (:) ] (gP/m2) grain P + livestemp => phosphorusstate_vars%livestemp_patch , & ! Input: [real(r8) (:) ] (gP/m2) livestem P + cpool_to_grainc => carbonflux_vars%cpool_to_grainc_patch , & ! Input: [real(r8) (:) ] allocation to grain C (gC/m2/s) + cpool_to_livestemc => carbonflux_vars%cpool_to_livestemc_patch , & ! Input: [real(r8) (:) ] allocation to live stem C (gC/m2/s) + cpool_to_leafc => carbonflux_vars%cpool_to_leafc_patch , & ! Input: [real(r8) (:) ] allocation to leaf C (gC/m2/s) + npool_to_leafn => nitrogenflux_vars%npool_to_leafn_patch , & ! Input: [real(r8) (:)] allocation to grain N (gN/m2/s) + npool_to_livestemn => nitrogenflux_vars%npool_to_livestemn_patch , & ! Input: [real(r8) (:)] allocation to grain N (gN/m2/s) + npool_to_grainn => nitrogenflux_vars%npool_to_grainn_patch , & ! Input: [real(r8) (:)] allocation to grain N (gN/m2/s) + ppool_to_leafp => phosphorusflux_vars%ppool_to_leafp_patch , & ! Input: [real(r8) (:)] allocation to grain P (gP/m2/s) + ppool_to_livestemp => phosphorusflux_vars%ppool_to_livestemp_patch, & ! Input: [real(r8) (:)] allocation to grain P (gP/m2/s) + ppool_to_grainp => phosphorusflux_vars%ppool_to_grainp_patch , & ! Input: [real(r8) (:)] allocation to grain P (gP/m2/s) + hrv_leafc_to_prod1c => carbonflux_vars%hrv_leafc_to_prod1c_patch , & ! Input: [real(r8) (:)] crop leafc harvested + hrv_livestemc_to_prod1c => carbonflux_vars%hrv_livestemc_to_prod1c_patch, & ! Input: [real(r8) (:)] crop stemc harvested + hrv_grainc_to_prod1c => carbonflux_vars%hrv_grainc_to_prod1c_patch , & ! Input: [real(r8) (:)] crop grainc harvested + hrv_leafn_to_prod1n => nitrogenflux_vars%hrv_leafn_to_prod1n_patch , & ! Input: [real(r8) (:)] crop leafn harvested + hrv_livestemn_to_prod1n => nitrogenflux_vars%hrv_livestemn_to_prod1n_patch, & ! Input: [real(r8) (:)] crop stemn harvested + hrv_grainn_to_prod1n => nitrogenflux_vars%hrv_grainn_to_prod1n_patch, & ! Input: [real(r8) (:)] crop grainn harvested + hrv_leafp_to_prod1p => phosphorusflux_vars%hrv_leafp_to_prod1p_patch , & ! Input: [real(r8) (:)] crop leafp harvested + hrv_livestemp_to_prod1p => phosphorusflux_vars%hrv_livestemp_to_prod1p_patch, & ! Input: [real(r8) (:)] crop stemp harvested + hrv_grainp_to_prod1p => phosphorusflux_vars%hrv_grainp_to_prod1p_patch, & ! Input: [real(r8) (:)] crop grainp harvested + crpyld => crop_vars%crpyld_patch , & ! InOut: [real(r8) ):)] harvested crop (bu/acre) + dmyield => crop_vars%dmyield_patch & ! InOut: [real(r8) ):)] dry matter harvested crop (t/ha) + ) + + cgrain = 0.50_r8 + do fp = 1,num_pcropp + p = filter_pcropp(fp) + ! only calculate during the offset period + if (offset_flag(p) == 1._r8) then + + if (offset_counter(p) == dt) then + t1 = 1._r8 / dt + !calculate yield (crpyld = bu/acre and dmyield = t/ha) + crpyld(p) = (grainc(p)+cpool_to_grainc(p)*dt) * fyield(ivt(p)) * convfact(ivt(p)) / (cgrain * 1000) + dmyield(p) = (grainc(p)+cpool_to_grainc(p)*dt) * fyield(ivt(p)) * 0.01 / cgrain + + !calculate harvested carbon and nitrogen; remaining goes into litterpool + !except for grain which goes into next years availc for growth after + !planting + hrv_leafc_to_prod1c(p) = presharv(ivt(p)) * ((t1 * leafc(p)) + cpool_to_leafc(p)) + hrv_livestemc_to_prod1c(p) = presharv(ivt(p)) * ((t1 * livestemc(p)) + cpool_to_livestemc(p)) + hrv_grainc_to_prod1c(p) = t1 * grainc(p) + cpool_to_grainc(p) + + ! Do the same for Nitrogen + hrv_leafn_to_prod1n(p) = presharv(ivt(p)) * ((t1 * leafn(p)) + npool_to_leafn(p)) + hrv_livestemn_to_prod1n(p) = presharv(ivt(p)) * ((t1 * livestemn(p)) + npool_to_livestemn(p)) + hrv_grainn_to_prod1n(p) = t1 * grainn(p) + npool_to_grainn(p) + + ! Do the same for Phosphorus + hrv_leafp_to_prod1p(p) = presharv(ivt(p)) * ((t1 * leafp(p)) + ppool_to_leafp(p)) + hrv_livestemp_to_prod1p(p) = presharv(ivt(p)) * ((t1 * livestemp(p)) + ppool_to_livestemp(p)) + hrv_grainp_to_prod1p(p) = t1 * grainp(p) + ppool_to_grainp(p) + + end if ! offseddt_counter + + end if ! offset_flag + end do + + ! gather all pft-level fluxes from harvest to the column + ! for C and N inputs + + call CNCropHarvestPftToColumn(num_soilc, filter_soilc,cnstate_vars, & + carbonflux_vars, nitrogenflux_vars, phosphorusflux_vars) + end associate + end subroutine CNCropHarvest + + !----------------------------------------------------------------------- + subroutine CNOffsetLitterfall (num_soilp, filter_soilp, & + cnstate_vars, carbonstate_vars, carbonflux_vars, nitrogenflux_vars,& + phosphorusflux_vars, nitrogenstate_vars,phosphorusstate_vars) + ! + ! !DESCRIPTION: + ! Determines the flux of C and N from displayed pools to litter + ! pools during the phenological offset period. + ! + ! !USES: + use pftvarcon , only : npcropmin + ! + ! !ARGUMENTS: + integer , intent(in) :: num_soilp ! number of soil patches in filter + integer , intent(in) :: filter_soilp(:) ! filter for soil patches + type(cnstate_type) , intent(inout) :: cnstate_vars + type(carbonstate_type) , intent(in) :: carbonstate_vars + type(carbonflux_type) , intent(inout) :: carbonflux_vars + type(nitrogenflux_type) , intent(inout) :: nitrogenflux_vars + type(phosphorusflux_type) , intent(inout) :: phosphorusflux_vars + type(nitrogenstate_type) , intent(in) :: nitrogenstate_vars + type(phosphorusstate_type), intent(in) :: phosphorusstate_vars + ! + ! !LOCAL VARIABLES: + integer :: p, c ! indices + integer :: fp ! lake filter pft index + real(r8):: t1 ! temporary variable + !----------------------------------------------------------------------- + + associate( & + ivt => veg_pp%itype , & ! Input: [integer (:) ] pft vegetation type + + leafcn => veg_vp%leafcn , & ! Input: [real(r8) (:) ] leaf C:N (gC/gN) + lflitcn => veg_vp%lflitcn , & ! Input: [real(r8) (:) ] leaf litter C:N (gC/gN) + frootcn => veg_vp%frootcn , & ! Input: [real(r8) (:) ] fine root C:N (gC/gN) + livewdcn => veg_vp%livewdcn , & ! Input: [real(r8) (:) ] live wood C:N (gC/gN) + graincn => veg_vp%graincn , & ! Input: [real(r8) (:) ] grain C:N (gC/gN) + presharv => veg_vp%presharv , & ! Input: [real(r8) (:) ] porportion of residue harvested + + leafcp => veg_vp%leafcp , & ! Input: [real(r8) (:) ] leaf C:P (gC/gP) + lflitcp => veg_vp%lflitcp , & ! Input: [real(r8) (:) ] leaf litter C:P (gC/gP) + frootcp => veg_vp%frootcp , & ! Input: [real(r8) (:) ] fine root C:P (gC/gP) + livewdcp => veg_vp%livewdcp , & ! Input: [real(r8) (:) ] live wood C:P (gC/gP) + graincp => veg_vp%graincp , & ! Input: [real(r8) (:) ] grain C:P (gC/gP) + + offset_flag => cnstate_vars%offset_flag_patch , & ! Input: [real(r8) (:) ] offset flag + offset_counter => cnstate_vars%offset_counter_patch , & ! Input: [real(r8) (:) ] offset days counter + + leafc => carbonstate_vars%leafc_patch , & ! Input: [real(r8) (:) ] (gC/m2) leaf C + frootc => carbonstate_vars%frootc_patch , & ! Input: [real(r8) (:) ] (gC/m2) fine root C + grainc => carbonstate_vars%grainc_patch , & ! Input: [real(r8) (:) ] (gC/m2) grain C + livestemc => carbonstate_vars%livestemc_patch , & ! Input: [real(r8) (:) ] (gC/m2) livestem C + + cpool_to_grainc => carbonflux_vars%cpool_to_grainc_patch , & ! Input: [real(r8) (:) ] allocation to grain C (gC/m2/s) + cpool_to_livestemc => carbonflux_vars%cpool_to_livestemc_patch , & ! Input: [real(r8) (:) ] allocation to live stem C (gC/m2/s) + cpool_to_leafc => carbonflux_vars%cpool_to_leafc_patch , & ! Input: [real(r8) (:) ] allocation to leaf C (gC/m2/s) + cpool_to_frootc => carbonflux_vars%cpool_to_frootc_patch , & ! Input: [real(r8) (:) ] allocation to fine root C (gC/m2/s) + prev_leafc_to_litter => carbonflux_vars%prev_leafc_to_litter_patch , & ! Output: [real(r8) (:) ] previous timestep leaf C litterfall flux (gC/m2/s) + prev_frootc_to_litter => carbonflux_vars%prev_frootc_to_litter_patch , & ! Output: [real(r8) (:) ] previous timestep froot C litterfall flux (gC/m2/s) + leafc_to_litter => carbonflux_vars%leafc_to_litter_patch , & ! Output: [real(r8) (:) ] leaf C litterfall (gC/m2/s) + frootc_to_litter => carbonflux_vars%frootc_to_litter_patch , & ! Output: [real(r8) (:) ] fine root C litterfall (gC/m2/s) + livestemc_to_litter => carbonflux_vars%livestemc_to_litter_patch , & ! Output: [real(r8) (:) ] live stem C litterfall (gC/m2/s) + grainc_to_food => carbonflux_vars%grainc_to_food_patch , & ! Output: [real(r8) (:) ] grain C to food (gC/m2/s) + + livestemn_to_litter => nitrogenflux_vars%livestemn_to_litter_patch , & ! Output: [real(r8) (:) ] livestem N to litter (gN/m2/s) + grainn_to_food => nitrogenflux_vars%grainn_to_food_patch , & ! Output: [real(r8) (:) ] grain N to food (gN/m2/s) + leafn_to_litter => nitrogenflux_vars%leafn_to_litter_patch , & ! Output: [real(r8) (:) ] leaf N litterfall (gN/m2/s) + leafn_to_retransn => nitrogenflux_vars%leafn_to_retransn_patch , & ! Output: [real(r8) (:) ] leaf N to retranslocated N pool (gN/m2/s) + frootn_to_litter => nitrogenflux_vars%frootn_to_litter_patch , & ! Output: [real(r8) (:) ] fine root N litterfall (gN/m2/s) + + livestemp_to_litter => phosphorusflux_vars%livestemp_to_litter_patch , & ! Output: [real(r8) (:) ] livestem P to litter (gP/m2/s) + grainp_to_food => phosphorusflux_vars%grainp_to_food_patch , & ! Output: [real(r8) (:) ] grain P to food (gP/m2/s) + leafp_to_litter => phosphorusflux_vars%leafp_to_litter_patch , & ! Output: [real(r8) (:) ] leaf P litterfall (gP/m2/s) + leafp_to_retransp => phosphorusflux_vars%leafp_to_retransp_patch , & ! Output: [real(r8) (:) ] leaf P to retranslocated P pool (gP/m2/s) + frootp_to_litter => phosphorusflux_vars%frootp_to_litter_patch , & ! Output: [real(r8) (:) ] fine root P litterfall (gP/m2/s) + + prev_leafn_to_litter => nitrogenflux_vars%prev_leafn_to_litter_patch , & ! Output: [real(r8) (:) ] previous timestep leaf N litterfall flux (gN/m2/s) + prev_frootn_to_litter => nitrogenflux_vars%prev_frootn_to_litter_patch , & ! Output: [real(r8) (:) ] previous timestep froot N litterfall flux (gN/m2/s) + prev_leafp_to_litter => phosphorusflux_vars%prev_leafp_to_litter_patch , & ! Output: [real(r8) (:) ] previous timestep leaf P litterfall flux (gP/m2/s) + prev_frootp_to_litter => phosphorusflux_vars%prev_frootp_to_litter_patch , & ! Output: [real(r8) (:) ] previous timestep froot P litterfall flux (gP/m2/s) + leafn => nitrogenstate_vars%leafn_patch , & ! Input: [real(r8) (:) ] (gN/m2) leaf N + frootn => nitrogenstate_vars%frootn_patch , & ! Input: [real(r8) (:) ] (gN/m2) fine root N + livestemn => nitrogenstate_vars%livestemn_patch , & ! Input: [real(r8) (:) ] (gN/m2) livestem N + leafp => phosphorusstate_vars%leafp_patch , & ! Input: [real(r8) (:) ] (gP/m2) leaf P + frootp => phosphorusstate_vars%frootp_patch , & ! Input: [real(r8) (:) ] (gP/m2) fine root P + livestemp => phosphorusstate_vars%livestemp_patch , & ! Input: [real(r8) (:) ] (gP/m2) livestem P + npool_to_leafn => nitrogenflux_vars%npool_to_leafn_patch , & + npool_to_frootn => nitrogenflux_vars%npool_to_frootn_patch , & + npool_to_livestemn => nitrogenflux_vars%npool_to_livestemn_patch , & + ppool_to_leafp => phosphorusflux_vars%ppool_to_leafp_patch , & + ppool_to_frootp => phosphorusflux_vars%ppool_to_frootp_patch , & + ppool_to_livestemp => phosphorusflux_vars%ppool_to_livestemp_patch & + ) + + ! The litterfall transfer rate starts at 0.0 and increases linearly + ! over time, with displayed growth going to 0.0 on the last day of litterfall + + do fp = 1,num_soilp + p = filter_soilp(fp) + + ! only calculate fluxes during offset period + if (offset_flag(p) == 1._r8) then + + if (offset_counter(p) == dt) then + t1 = 1.0_r8 / dt + if (ivt(p) >= npcropmin) then + ! this assumes that offset_counter == dt for crops + ! if this were ever changed, we'd need to add code to the "else" + leafc_to_litter(p) = (1.0_r8 - presharv(ivt(p))) * ((t1 * leafc(p)) + cpool_to_leafc(p)) + frootc_to_litter(p) = t1 * frootc(p) + cpool_to_frootc(p) + livestemc_to_litter(p) = (1.0_r8 - presharv(ivt(p))) * ((t1 * livestemc(p)) + cpool_to_livestemc(p)) + else + leafc_to_litter(p) = t1 * leafc(p) + cpool_to_leafc(p) + frootc_to_litter(p) = t1 * frootc(p) + cpool_to_frootc(p) + end if + else + t1 = dt * 2.0_r8 / (offset_counter(p) * offset_counter(p)) + leafc_to_litter(p) = prev_leafc_to_litter(p) + t1*(leafc(p) - prev_leafc_to_litter(p)*offset_counter(p)) + frootc_to_litter(p) = prev_frootc_to_litter(p) + t1*(frootc(p) - prev_frootc_to_litter(p)*offset_counter(p)) + end if + + if ( nu_com .eq. 'RD') then + ! calculate the leaf N litterfall and retranslocation + leafn_to_litter(p) = leafc_to_litter(p) / lflitcn(ivt(p)) + leafn_to_retransn(p) = (leafc_to_litter(p) / leafcn(ivt(p))) - leafn_to_litter(p) + + ! calculate fine root N litterfall (no retranslocation of fine root N) + frootn_to_litter(p) = frootc_to_litter(p) / frootcn(ivt(p)) + + ! calculate the leaf P litterfall and retranslocation + leafp_to_litter(p) = leafc_to_litter(p) / lflitcp(ivt(p)) + leafp_to_retransp(p) = (leafc_to_litter(p) / leafcp(ivt(p))) - leafp_to_litter(p) + + ! calculate fine root P litterfall (no retranslocation of fine root N) + frootp_to_litter(p) = frootc_to_litter(p) / frootcp(ivt(p)) + + if (ivt(p) >= npcropmin) then + livestemn_to_litter(p) = livestemc_to_litter(p) / livewdcn(ivt(p)) + livestemp_to_litter(p) = livestemc_to_litter(p) / livewdcp(ivt(p)) + end if + else + if (offset_counter(p) == dt) then + t1 = 1.0_r8 / dt + if (ivt(p) >= npcropmin) then + ! this assumes that offset_counter == dt for crops + ! if this were ever changed, we'd need to add code to the "else" + leafn_to_litter(p) = (1.0_r8 - presharv(ivt(p))) * ((t1 * leafn(p)) + npool_to_leafn(p)) + leafp_to_litter(p) = (1.0_r8 - presharv(ivt(p))) * ((t1 * leafp(p)) + ppool_to_leafp(p)) + + frootn_to_litter(p) = t1 * frootn(p) + npool_to_frootn(p) + frootp_to_litter(p) = t1 * frootp(p) + ppool_to_frootp(p) + + livestemn_to_litter(p) = (1.0_r8 - presharv(ivt(p))) * ((t1 * livestemn(p)) + npool_to_livestemn(p)) + livestemp_to_litter(p) = (1.0_r8 - presharv(ivt(p))) * ((t1 * livestemp(p)) + ppool_to_livestemp(p)) + + else + leafn_to_litter(p) = (t1 * leafn(p) + npool_to_leafn(p))*0.38_r8 + leafn_to_retransn(p) = (t1 * leafn(p) + npool_to_leafn(p))*0.62_r8 + frootn_to_litter(p) = t1 * frootn(p) + npool_to_frootn(p) + + leafp_to_litter(p) = (t1 * leafp(p) + ppool_to_leafp(p))*0.35_r8 + leafp_to_retransp(p) = (t1 * leafp(p) + ppool_to_leafp(p))*0.65_r8 + frootp_to_litter(p) = t1 * frootp(p) + ppool_to_frootp(p) + end if + else + leafn_to_litter(p) = leafc_to_litter(p) / max(leafc(p), 1.e-20_r8) * leafn(p) * 0.38_r8 + leafn_to_retransn(p) = leafc_to_litter(p) / max(leafc(p), 1.e-20_r8) * leafn(p) * 0.62_r8 + frootn_to_litter(p) = frootc_to_litter(p)/ max(frootc(p), 1.e-20_r8) * frootn(p) + + leafp_to_litter(p) = leafc_to_litter(p) / max(leafc(p), 1.e-20_r8) * leafp(p) * 0.35_r8 + leafp_to_retransp(p) = leafc_to_litter(p) / max(leafc(p), 1.e-20_r8) * leafp(p) * 0.65_r8 + frootp_to_litter(p) = frootc_to_litter(p)/ max(frootc(p), 1.e-20_r8) * frootp(p) + end if + end if + leafn_to_litter(p) = leafn_to_litter(p) * pheno_indicator(pid_leafn_to_litter) + frootn_to_litter(p) = frootn_to_litter(p) * pheno_indicator(pid_frootn_to_litter) + livestemn_to_litter(p) = livestemn_to_litter(p) * pheno_indicator(pid_livestemn_to_litter) + + ! save the current litterfall fluxes + prev_leafc_to_litter(p) = leafc_to_litter(p) + prev_frootc_to_litter(p) = frootc_to_litter(p) + + end if ! end if offset period + + end do ! end pft loop + + end associate + + end subroutine CNOffsetLitterfall + + !----------------------------------------------------------------------- + subroutine CNBackgroundLitterfall (num_soilp, filter_soilp, & + cnstate_vars, carbonstate_vars, carbonflux_vars, nitrogenflux_vars,& + phosphorusflux_vars, nitrogenstate_vars, phosphorusstate_vars) + ! + ! !DESCRIPTION: + ! Determines the flux of C and N from displayed pools to litter + ! pools as the result of background litter fall. + ! + ! !ARGUMENTS: + integer , intent(in) :: num_soilp ! number of soil patches in filter + integer , intent(in) :: filter_soilp(:) ! filter for soil patches + type(cnstate_type) , intent(in) :: cnstate_vars + type(carbonstate_type) , intent(in) :: carbonstate_vars + type(carbonflux_type) , intent(inout) :: carbonflux_vars + type(nitrogenflux_type) , intent(inout) :: nitrogenflux_vars + type(phosphorusflux_type) , intent(inout) :: phosphorusflux_vars + type(nitrogenstate_type) , intent(in) :: nitrogenstate_vars + type(phosphorusstate_type), intent(in) :: phosphorusstate_vars + ! + ! !LOCAL VARIABLES: + integer :: p ! indices + integer :: fp ! lake filter pft index + !----------------------------------------------------------------------- + + associate( & + ivt => veg_pp%itype , & ! Input: [integer (:) ] pft vegetation type + + leafcn => veg_vp%leafcn , & ! Input: [real(r8) (:) ] leaf C:N (gC/gN) + lflitcn => veg_vp%lflitcn , & ! Input: [real(r8) (:) ] leaf litter C:N (gC/gN) + frootcn => veg_vp%frootcn , & ! Input: [real(r8) (:) ] fine root C:N (gC/gN) + + leafcp => veg_vp%leafcp , & ! Input: [real(r8) (:) ] leaf C:P (gC/gP) + lflitcp => veg_vp%lflitcp , & ! Input: [real(r8) (:) ] leaf litter C:P (gC/gP) + frootcp => veg_vp%frootcp , & ! Input: [real(r8) (:) ] fine root C:P (gC/gP) + + bglfr => cnstate_vars%bglfr_patch , & ! Input: [real(r8) (:) ] background litterfall rate (1/s) + + leafc => carbonstate_vars%leafc_patch , & ! Input: [real(r8) (:) ] (gC/m2) leaf C + frootc => carbonstate_vars%frootc_patch , & ! Input: [real(r8) (:) ] (gC/m2) fine root C + + leafc_to_litter => carbonflux_vars%leafc_to_litter_patch , & ! Output: [real(r8) (:) ] + frootc_to_litter => carbonflux_vars%frootc_to_litter_patch , & ! Output: [real(r8) (:) ] + + leafn_to_litter => nitrogenflux_vars%leafn_to_litter_patch , & ! Output: [real(r8) (:) ] + leafn_to_retransn => nitrogenflux_vars%leafn_to_retransn_patch , & ! Output: [real(r8) (:) ] + frootn_to_litter => nitrogenflux_vars%frootn_to_litter_patch , & ! Output: [real(r8) (:) ] + + leafp_to_litter => phosphorusflux_vars%leafp_to_litter_patch , & ! Output: [real(r8) (:) ] + leafp_to_retransp => phosphorusflux_vars%leafp_to_retransp_patch , & ! Output: [real(r8) (:) ] + frootp_to_litter => phosphorusflux_vars%frootp_to_litter_patch , & ! Output: [real(r8) (:) ] + + leafn => nitrogenstate_vars%leafn_patch , & + frootn => nitrogenstate_vars%frootn_patch , & + leafp => phosphorusstate_vars%leafp_patch , & + frootp => phosphorusstate_vars%frootp_patch & + ) + + ! patch loop + do fp = 1,num_soilp + p = filter_soilp(fp) + + ! only calculate these fluxes if the background litterfall rate is non-zero + if (bglfr(p) > 0._r8) then + ! units for bglfr are already 1/s + leafc_to_litter(p) = bglfr(p) * leafc(p) + frootc_to_litter(p) = bglfr(p) * frootc(p) + + if ( nu_com .eq. 'RD') then + ! calculate the leaf N litterfall and retranslocation + leafn_to_litter(p) = leafc_to_litter(p) / lflitcn(ivt(p)) + leafn_to_litter(p) = leafn_to_litter(p) * pheno_indicator(pid_leafn_to_litter) + leafn_to_retransn(p) = (leafc_to_litter(p) / leafcn(ivt(p))) - leafn_to_litter(p) + + ! calculate fine root N litterfall (no retranslocation of fine root N) + frootn_to_litter(p) = frootc_to_litter(p) / frootcn(ivt(p)) + + ! calculate the leaf P litterfall and retranslocation + leafp_to_litter(p) = leafc_to_litter(p) / lflitcp(ivt(p)) + leafp_to_retransp(p) = (leafc_to_litter(p) / leafcp(ivt(p))) - leafp_to_litter(p) + + ! calculate fine root P litterfall (no retranslocation of fine root P) + frootp_to_litter(p) = frootc_to_litter(p) / frootcp(ivt(p)) + else + ! calculate the leaf N litterfall and retranslocation + leafn_to_litter(p) = bglfr(p) * leafn(p) * 0.38_r8 ! 62% N resorption rate; LEONARDUS VERGUTZ 2012 Ecological Monographs 82(2) 205-220. + leafn_to_litter(p) = leafn_to_litter(p) * pheno_indicator(pid_leafn_to_litter) + leafn_to_retransn(p) = bglfr(p) * leafn(p) - leafn_to_litter(p) + + ! calculate fine root N litterfall (no retranslocation of fine root N) + frootn_to_litter(p) = bglfr(p) * frootn(p) + + ! calculate the leaf P litterfall and retranslocation + leafp_to_litter(p) = bglfr(p) * leafp(p) * 0.35_r8 ! 65% P resorption rate; LEONARDUS VERGUTZ 2012 Ecological Monographs 82(2) 205-220. + leafp_to_retransp(p) = bglfr(p) * leafp(p) - leafp_to_litter(p) + + ! calculate fine root P litterfall (no retranslocation of fine root P) + frootp_to_litter(p) = bglfr(p) * frootp(p) ! fine root P retranslocation occur (but not N retranslocation), why not include it here + end if + end if + frootn_to_litter(p) = frootn_to_litter(p) * pheno_indicator(pid_frootn_to_litter) + end do + + end associate + + end subroutine CNBackgroundLitterfall + + !----------------------------------------------------------------------- + subroutine CNLivewoodTurnover (num_soilp, filter_soilp, & + carbonstate_vars, nitrogenstate_vars, carbonflux_vars,nitrogenflux_vars,& + phosphorusstate_vars,phosphorusflux_vars) + ! + ! !DESCRIPTION: + ! Determines the flux of C and N from live wood to + ! dead wood pools, for stem and coarse root. + ! add phosphorus flux - X.YANG + ! + ! !ARGUMENTS: + integer , intent(in) :: num_soilp ! number of soil patches in filter + integer , intent(in) :: filter_soilp(:) ! filter for soil patches + type(carbonstate_type) , intent(in) :: carbonstate_vars + type(nitrogenstate_type) , intent(in) :: nitrogenstate_vars + type(carbonflux_type) , intent(inout) :: carbonflux_vars + type(nitrogenflux_type) , intent(inout) :: nitrogenflux_vars + type(phosphorusstate_type) , intent(in) :: phosphorusstate_vars + type(phosphorusflux_type) , intent(inout) :: phosphorusflux_vars + ! + ! !LOCAL VARIABLES: + integer :: p ! indices + integer :: fp ! lake filter pft index + real(r8):: ctovr ! temporary variable for carbon turnover + real(r8):: ntovr ! temporary variable for nitrogen turnover + real(r8):: ptovr ! temporary variable for phosphorus turnover + !----------------------------------------------------------------------- + + associate( & + ivt => veg_pp%itype , & ! Input: [integer (:) ] pft vegetation type + + woody => veg_vp%woody , & ! Input: [real(r8) (:) ] binary flag for woody lifeform (1=woody, 0=not woody) + livewdcn => veg_vp%livewdcn , & ! Input: [real(r8) (:) ] live wood (phloem and ray parenchyma) C:N (gC/gN) + deadwdcn => veg_vp%deadwdcn , & ! Input: [real(r8) (:) ] dead wood (xylem and heartwood) C:N (gC/gN) + + livestemc => carbonstate_vars%livestemc_patch , & ! Input: [real(r8) (:) ] (gC/m2) live stem C + livecrootc => carbonstate_vars%livecrootc_patch , & ! Input: [real(r8) (:) ] (gC/m2) live coarse root C + + livestemn => nitrogenstate_vars%livestemn_patch , & ! Input: [real(r8) (:) ] (gN/m2) live stem N + livecrootn => nitrogenstate_vars%livecrootn_patch , & ! Input: [real(r8) (:) ] (gN/m2) live coarse root N + + livestemp => phosphorusstate_vars%livestemp_patch , & ! Input: [real(r8) (:) ] (gN/m2) live stem N + livecrootp => phosphorusstate_vars%livecrootp_patch , & ! Input: [real(r8) (:) ] (gN/m2) live coarse root N + + livestemc_to_deadstemc => carbonflux_vars%livestemc_to_deadstemc_patch , & ! Output: [real(r8) (:) ] + livecrootc_to_deadcrootc => carbonflux_vars%livecrootc_to_deadcrootc_patch , & ! Output: [real(r8) (:) ] + + livestemn_to_deadstemn => nitrogenflux_vars%livestemn_to_deadstemn_patch , & ! Output: [real(r8) (:) ] + livestemn_to_retransn => nitrogenflux_vars%livestemn_to_retransn_patch , & ! Output: [real(r8) (:) ] + livecrootn_to_deadcrootn => nitrogenflux_vars%livecrootn_to_deadcrootn_patch , & ! Output: [real(r8) (:) ] + livecrootn_to_retransn => nitrogenflux_vars%livecrootn_to_retransn_patch , & ! Output: [real(r8) (:) ] + + livewdcp => veg_vp%livewdcp , & ! Input: [real(r8) (:) ] live wood (phloem and ray parenchyma) C:P (gC/gP) + deadwdcp => veg_vp%deadwdcp , & ! Input: [real(r8) (:) ] dead wood (xylem and heartwood) C:P (gC/gP) + livestemp_to_deadstemp => phosphorusflux_vars%livestemp_to_deadstemp_patch , & ! Output: [real(r8) (:) ] + livestemp_to_retransp => phosphorusflux_vars%livestemp_to_retransp_patch , & ! Output: [real(r8) (:) ] + livecrootp_to_deadcrootp => phosphorusflux_vars%livecrootp_to_deadcrootp_patch , & ! Output: [real(r8) (:) ] + livecrootp_to_retransp => phosphorusflux_vars%livecrootp_to_retransp_patch & ! Output: [real(r8) (:) ] + ) + + ! patch loop + do fp = 1,num_soilp + p = filter_soilp(fp) + + ! only calculate these fluxes for woody types + if (woody(ivt(p)) > 0._r8) then + if ( nu_com .eq. 'RD') then + ! live stem to dead stem turnover + + ctovr = livestemc(p) * lwtop + ntovr = ctovr / livewdcn(ivt(p)) + ptovr = ctovr / livewdcp(ivt(p)) + + livestemc_to_deadstemc(p) = ctovr + livestemn_to_deadstemn(p) = ctovr / deadwdcn(ivt(p)) + livestemn_to_retransn(p) = ntovr - livestemn_to_deadstemn(p) + + livestemp_to_deadstemp(p) = ctovr / deadwdcp(ivt(p)) + livestemp_to_retransp(p) = ptovr - livestemp_to_deadstemp(p) + ! live coarse root to dead coarse root turnover + + ctovr = livecrootc(p) * lwtop + ntovr = ctovr / livewdcn(ivt(p)) + ptovr = ctovr / livewdcp(ivt(p)) + + livecrootc_to_deadcrootc(p) = ctovr + livecrootn_to_deadcrootn(p) = ctovr / deadwdcn(ivt(p)) + livecrootn_to_retransn(p) = ntovr - livecrootn_to_deadcrootn(p) + + livecrootp_to_deadcrootp(p) = ctovr / deadwdcp(ivt(p)) + livecrootp_to_retransp(p) = ptovr - livecrootp_to_deadcrootp(p) + else + ! live stem to dead stem turnover + + ctovr = livestemc(p) * lwtop + ntovr = livestemn(p) * lwtop + ptovr = livestemp(p) * lwtop + + livestemc_to_deadstemc(p) = ctovr + livestemn_to_deadstemn(p) = ntovr * livewdcn(ivt(p))/deadwdcn(ivt(p)) ! N retranslocation + livestemn_to_retransn(p) = ntovr - livestemn_to_deadstemn(p) + + livestemp_to_deadstemp(p) = ptovr* livewdcp(ivt(p))/deadwdcp(ivt(p)) ! P retranslocation + livestemp_to_retransp(p) = ptovr - livestemp_to_deadstemp(p) + ! live coarse root to dead coarse root turnover + + ctovr = livecrootc(p) * lwtop + ntovr = livecrootn(p) * lwtop + ptovr = livecrootp(p) * lwtop + + livecrootc_to_deadcrootc(p) = ctovr + livecrootn_to_deadcrootn(p) = ntovr * livewdcn(ivt(p))/deadwdcn(ivt(p)) ! N retranslocation + livecrootn_to_retransn(p) = ntovr - livecrootn_to_deadcrootn(p) + + livecrootp_to_deadcrootp(p) = ptovr * livewdcp(ivt(p))/deadwdcp(ivt(p)) ! P retranslocation + livecrootp_to_retransp(p) = ptovr - livecrootp_to_deadcrootp(p) + end if + + end if + + end do + + end associate + + end subroutine CNLivewoodTurnover + + !----------------------------------------------------------------------- + subroutine CNLitterToColumn (num_soilc, filter_soilc, & + cnstate_vars, carbonflux_vars, nitrogenflux_vars,phosphorusflux_vars) + ! + ! !DESCRIPTION: + ! called at the end of cn_phenology to gather all pft-level litterfall fluxes + ! to the column level and assign them to the three litter pools + ! + ! !USES: + use clm_varpar , only : max_patch_per_col, nlevdecomp + use pftvarcon , only : npcropmin + ! + ! !ARGUMENTS: + integer , intent(in) :: num_soilc ! number of soil columns in filter + integer , intent(in) :: filter_soilc(:) ! filter for soil columns + type(cnstate_type) , intent(in) :: cnstate_vars + type(carbonflux_type) , intent(inout) :: carbonflux_vars + type(nitrogenflux_type) , intent(inout) :: nitrogenflux_vars + type(phosphorusflux_type) , intent(inout) :: phosphorusflux_vars + ! + ! !LOCAL VARIABLES: + integer :: fc,c,pi,p,j ! indices + !----------------------------------------------------------------------- + + associate( & + ivt => veg_pp%itype , & ! Input: [integer (:) ] pft vegetation type + wtcol => veg_pp%wtcol , & ! Input: [real(r8) (:) ] weight (relative to column) for this pft (0-1) + + lf_flab => veg_vp%lf_flab , & ! Input: [real(r8) (:) ] leaf litter labile fraction + lf_fcel => veg_vp%lf_fcel , & ! Input: [real(r8) (:) ] leaf litter cellulose fraction + lf_flig => veg_vp%lf_flig , & ! Input: [real(r8) (:) ] leaf litter lignin fraction + fr_flab => veg_vp%fr_flab , & ! Input: [real(r8) (:) ] fine root litter labile fraction + fr_fcel => veg_vp%fr_fcel , & ! Input: [real(r8) (:) ] fine root litter cellulose fraction + fr_flig => veg_vp%fr_flig , & ! Input: [real(r8) (:) ] fine root litter lignin fraction + + leaf_prof => cnstate_vars%leaf_prof_patch , & ! Input: [real(r8) (:,:) ] (1/m) profile of leaves + froot_prof => cnstate_vars%froot_prof_patch , & ! Input: [real(r8) (:,:) ] (1/m) profile of fine roots + + leafc_to_litter => carbonflux_vars%leafc_to_litter_patch , & ! Input: [real(r8) (:) ] leaf C litterfall (gC/m2/s) + frootc_to_litter => carbonflux_vars%frootc_to_litter_patch , & ! Input: [real(r8) (:) ] fine root N litterfall (gN/m2/s) + livestemc_to_litter => carbonflux_vars%livestemc_to_litter_patch , & ! Input: [real(r8) (:) ] live stem C litterfall (gC/m2/s) +! grainc_to_food => carbonflux_vars%grainc_to_food_patch , & ! Input: [real(r8) (:) ] grain C to food (gC/m2/s) + phenology_c_to_litr_met_c => carbonflux_vars%phenology_c_to_litr_met_c_col , & ! Output: [real(r8) (:,:) ] C fluxes associated with phenology (litterfall and crop) to litter metabolic pool (gC/m3/s) + phenology_c_to_litr_cel_c => carbonflux_vars%phenology_c_to_litr_cel_c_col , & ! Output: [real(r8) (:,:) ] C fluxes associated with phenology (litterfall and crop) to litter cellulose pool (gC/m3/s) + phenology_c_to_litr_lig_c => carbonflux_vars%phenology_c_to_litr_lig_c_col , & ! Output: [real(r8) (:,:) ] C fluxes associated with phenology (litterfall and crop) to litter lignin pool (gC/m3/s) + + livestemn_to_litter => nitrogenflux_vars%livestemn_to_litter_patch , & ! Input: [real(r8) (:) ] livestem N to litter (gN/m2/s) +! grainn_to_food => nitrogenflux_vars%grainn_to_food_patch , & ! Input: [real(r8) (:) ] grain N to food (gN/m2/s) + leafn_to_litter => nitrogenflux_vars%leafn_to_litter_patch , & ! Input: [real(r8) (:) ] leaf N litterfall (gN/m2/s) + frootn_to_litter => nitrogenflux_vars%frootn_to_litter_patch , & ! Input: [real(r8) (:) ] fine root N litterfall (gN/m2/s) + phenology_n_to_litr_met_n => nitrogenflux_vars%phenology_n_to_litr_met_n_col , & ! Output: [real(r8) (:,:) ] N fluxes associated with phenology (litterfall and crop) to litter metabolic pool (gN/m3/s) + phenology_n_to_litr_cel_n => nitrogenflux_vars%phenology_n_to_litr_cel_n_col , & ! Output: [real(r8) (:,:) ] N fluxes associated with phenology (litterfall and crop) to litter cellulose pool (gN/m3/s) + phenology_n_to_litr_lig_n => nitrogenflux_vars%phenology_n_to_litr_lig_n_col , & ! Output: [real(r8) (:,:) ] N fluxes associated with phenology (litterfall and crop) to litter lignin pool (gN/m3/s) + + livestemp_to_litter => phosphorusflux_vars%livestemp_to_litter_patch , & ! Input: [real(r8) (:) ] livestem P to litter (gP/m2/s) +! grainp_to_food => phosphorusflux_vars%grainp_to_food_patch , & ! Input: [real(r8) (:) ] grain P to food (gP/m2/s) + leafp_to_litter => phosphorusflux_vars%leafp_to_litter_patch , & ! Input: [real(r8) (:) ] leaf P litterfall (gP/m2/s) + frootp_to_litter => phosphorusflux_vars%frootp_to_litter_patch , & ! Input: [real(r8) (:) ] fine root P litterfall (gP/m2/s) + phenology_p_to_litr_met_p => phosphorusflux_vars%phenology_p_to_litr_met_p_col , & ! Output: [real(r8) (:,:) ] P fluxes associated with phenology (litterfall and crop) to litter metabolic pool (gP/m3/s) + phenology_p_to_litr_cel_p => phosphorusflux_vars%phenology_p_to_litr_cel_p_col , & ! Output: [real(r8) (:,:) ] P fluxes associated with phenology (litterfall and crop) to litter cellulose pool (gP/m3/s) + phenology_p_to_litr_lig_p => phosphorusflux_vars%phenology_p_to_litr_lig_p_col & ! Output: [real(r8) (:,:) ] P fluxes associated with phenology (litterfall and crop) to litter lignin pool (gP/m3/s) + ) + + if(.false.)then + do pi = 1,max_patch_per_col + do fc = 1,num_soilc + c = filter_soilc(fc) + + if ( pi <= col_pp%npfts(c) ) then + p = col_pp%pfti(c) + pi - 1 + if (veg_pp%active(p)) then + write(*,*)'==========================================' + write(*,*)'01 leafn_to_litter =',p,leafn_to_litter(p) + write(*,*)'02 frootn_to_litter =',p,frootn_to_litter(p) + !write(*,*)'03 livestemn_to_litter=',p,livestemn_to_litter(p) + endif + endif + enddo + enddo + endif + do j = 1, nlevdecomp + do pi = 1,max_patch_per_col + do fc = 1,num_soilc + c = filter_soilc(fc) + + if ( pi <= col_pp%npfts(c) ) then + p = col_pp%pfti(c) + pi - 1 + if (veg_pp%active(p)) then + + ! leaf litter carbon fluxes + phenology_c_to_litr_met_c(c,j) = phenology_c_to_litr_met_c(c,j) & + + leafc_to_litter(p) * lf_flab(ivt(p)) * wtcol(p) * leaf_prof(p,j) + phenology_c_to_litr_cel_c(c,j) = phenology_c_to_litr_cel_c(c,j) & + + leafc_to_litter(p) * lf_fcel(ivt(p)) * wtcol(p) * leaf_prof(p,j) + phenology_c_to_litr_lig_c(c,j) = phenology_c_to_litr_lig_c(c,j) & + + leafc_to_litter(p) * lf_flig(ivt(p)) * wtcol(p) * leaf_prof(p,j) + + ! leaf litter nitrogen fluxes + phenology_n_to_litr_met_n(c,j) = phenology_n_to_litr_met_n(c,j) & + + leafn_to_litter(p) * lf_flab(ivt(p)) * wtcol(p) * leaf_prof(p,j) + phenology_n_to_litr_cel_n(c,j) = phenology_n_to_litr_cel_n(c,j) & + + leafn_to_litter(p) * lf_fcel(ivt(p)) * wtcol(p) * leaf_prof(p,j) + phenology_n_to_litr_lig_n(c,j) = phenology_n_to_litr_lig_n(c,j) & + + leafn_to_litter(p) * lf_flig(ivt(p)) * wtcol(p) * leaf_prof(p,j) + + ! leaf litter phosphorus fluxes + phenology_p_to_litr_met_p(c,j) = phenology_p_to_litr_met_p(c,j) & + + leafp_to_litter(p) * lf_flab(ivt(p)) * wtcol(p) * leaf_prof(p,j) + phenology_p_to_litr_cel_p(c,j) = phenology_p_to_litr_cel_p(c,j) & + + leafp_to_litter(p) * lf_fcel(ivt(p)) * wtcol(p) * leaf_prof(p,j) + phenology_p_to_litr_lig_p(c,j) = phenology_p_to_litr_lig_p(c,j) & + + leafp_to_litter(p) * lf_flig(ivt(p)) * wtcol(p) * leaf_prof(p,j) + + ! fine root litter carbon fluxes + phenology_c_to_litr_met_c(c,j) = phenology_c_to_litr_met_c(c,j) & + + frootc_to_litter(p) * fr_flab(ivt(p)) * wtcol(p) * froot_prof(p,j) + phenology_c_to_litr_cel_c(c,j) = phenology_c_to_litr_cel_c(c,j) & + + frootc_to_litter(p) * fr_fcel(ivt(p)) * wtcol(p) * froot_prof(p,j) + phenology_c_to_litr_lig_c(c,j) = phenology_c_to_litr_lig_c(c,j) & + + frootc_to_litter(p) * fr_flig(ivt(p)) * wtcol(p) * froot_prof(p,j) + + ! fine root litter nitrogen fluxes + phenology_n_to_litr_met_n(c,j) = phenology_n_to_litr_met_n(c,j) & + + frootn_to_litter(p) * fr_flab(ivt(p)) * wtcol(p) * froot_prof(p,j) + phenology_n_to_litr_cel_n(c,j) = phenology_n_to_litr_cel_n(c,j) & + + frootn_to_litter(p) * fr_fcel(ivt(p)) * wtcol(p) * froot_prof(p,j) + phenology_n_to_litr_lig_n(c,j) = phenology_n_to_litr_lig_n(c,j) & + + frootn_to_litter(p) * fr_flig(ivt(p)) * wtcol(p) * froot_prof(p,j) + + ! fine root litter phosphorus fluxes + phenology_p_to_litr_met_p(c,j) = phenology_p_to_litr_met_p(c,j) & + + frootp_to_litter(p) * fr_flab(ivt(p)) * wtcol(p) * froot_prof(p,j) + phenology_p_to_litr_cel_p(c,j) = phenology_p_to_litr_cel_p(c,j) & + + frootp_to_litter(p) * fr_fcel(ivt(p)) * wtcol(p) * froot_prof(p,j) + phenology_p_to_litr_lig_p(c,j) = phenology_p_to_litr_lig_p(c,j) & + + frootp_to_litter(p) * fr_flig(ivt(p)) * wtcol(p) * froot_prof(p,j) + + ! agroibis puts crop stem litter together with leaf litter + ! so I've used the leaf lf_f* parameters instead of making + ! new ones for now (slevis) + ! The food is now directed to the product pools (BDrewniak) + + if (ivt(p) >= npcropmin) then ! add livestemc to litter + ! stem litter carbon fluxes + phenology_c_to_litr_met_c(c,j) = phenology_c_to_litr_met_c(c,j) & + + livestemc_to_litter(p) * lf_flab(ivt(p)) * wtcol(p) * leaf_prof(p,j) + phenology_c_to_litr_cel_c(c,j) = phenology_c_to_litr_cel_c(c,j) & + + livestemc_to_litter(p) * lf_fcel(ivt(p)) * wtcol(p) * leaf_prof(p,j) + phenology_c_to_litr_lig_c(c,j) = phenology_c_to_litr_lig_c(c,j) & + + livestemc_to_litter(p) * lf_flig(ivt(p)) * wtcol(p) * leaf_prof(p,j) + + ! stem litter nitrogen fluxes + phenology_n_to_litr_met_n(c,j) = phenology_n_to_litr_met_n(c,j) & + + livestemn_to_litter(p) * lf_flab(ivt(p)) * wtcol(p) * leaf_prof(p,j) + phenology_n_to_litr_cel_n(c,j) = phenology_n_to_litr_cel_n(c,j) & + + livestemn_to_litter(p) * lf_fcel(ivt(p)) * wtcol(p) * leaf_prof(p,j) + phenology_n_to_litr_lig_n(c,j) = phenology_n_to_litr_lig_n(c,j) & + + livestemn_to_litter(p) * lf_flig(ivt(p)) * wtcol(p) * leaf_prof(p,j) + + ! stem litter phosphorus fluxes + phenology_p_to_litr_met_p(c,j) = phenology_p_to_litr_met_p(c,j) & + + livestemp_to_litter(p) * lf_flab(ivt(p)) * wtcol(p) * leaf_prof(p,j) + phenology_p_to_litr_cel_p(c,j) = phenology_p_to_litr_cel_p(c,j) & + + livestemp_to_litter(p) * lf_fcel(ivt(p)) * wtcol(p) * leaf_prof(p,j) + phenology_p_to_litr_lig_p(c,j) = phenology_p_to_litr_lig_p(c,j) & + + livestemp_to_litter(p) * lf_flig(ivt(p)) * wtcol(p) * leaf_prof(p,j) + + end if + + end if + end if + + end do + + end do + end do + + end associate + + end subroutine CNLitterToColumn + + !----------------------------------------------------------------------- + subroutine CNCropHarvestPftToColumn (num_soilc, filter_soilc, & + cnstate_vars, carbonflux_vars, nitrogenflux_vars, phosphorusflux_vars) + ! + ! !DESCRIPTION: + ! called at the end of CNCropHarvest to gather all pft-level harvest fluxes + ! to the column level and assign them to a product pools + ! + ! !USES: + use clm_varpar, only : maxpatch_pft + type(cnstate_type) , intent(in) :: cnstate_vars + type(carbonflux_type) , intent(inout) :: carbonflux_vars + type(nitrogenflux_type) , intent(inout) :: nitrogenflux_vars + type(phosphorusflux_type), intent(inout) :: phosphorusflux_vars + ! + ! !ARGUMENTS: + integer, intent(in) :: num_soilc ! number of soil columns in filter + integer, intent(in) :: filter_soilc(:) ! soil column filter + ! !LOCAL VARIABLES: + integer :: fc,c,pi,p ! indices + !----------------------------------------------------------------------- + + associate(& + ivt => veg_pp%itype , & ! Input: [integer (:)] pft vegetation type + wtcol => veg_pp%wtcol , & ! Input: [real(r8) (:)] pft weight relative to column (0-1) + phrv_leafc_to_prod1c => carbonflux_vars%hrv_leafc_to_prod1c_patch , & ! Input: [real(r8) (:)] crop leafc harvested + phrv_livestemc_to_prod1c => carbonflux_vars%hrv_livestemc_to_prod1c_patch, & ! Input: [real(r8) (:)] crop stemc harvested + phrv_grainc_to_prod1c => carbonflux_vars%hrv_grainc_to_prod1c_patch , & ! Input: [real(r8) (:)] crop grainc harvested + phrv_cropc_to_prod1c => carbonflux_vars%hrv_cropc_to_prod1c_patch , & ! InOut: [real(r8) (:)] crop carbon harvested + phrv_leafn_to_prod1n => nitrogenflux_vars%hrv_leafn_to_prod1n_patch , & ! Input: [real(r8) (:)] crop leafn harvested + phrv_livestemn_to_prod1n => nitrogenflux_vars%hrv_livestemn_to_prod1n_patch, & ! Input: [real(r8) (:)] crop stemn harvested + phrv_grainn_to_prod1n => nitrogenflux_vars%hrv_grainn_to_prod1n_patch , & ! Input: [real(r8) (:)] crop grainn harvested + phrv_cropn_to_prod1n => nitrogenflux_vars%hrv_cropn_to_prod1n_patch , & ! InOut: [real(r8) (:)] crop grainn harvested + phrv_leafp_to_prod1p => phosphorusflux_vars%hrv_leafp_to_prod1p_patch , & ! InOut: [real(r8) (:)] crop grainp harvested + phrv_livestemp_to_prod1p => phosphorusflux_vars%hrv_livestemp_to_prod1p_patch, & ! InOut: [real(r8) (:)] column level crop carbon harvested + phrv_grainp_to_prod1p => phosphorusflux_vars%hrv_grainp_to_prod1p_patch , & ! InOut: [real(r8) (:)] column level crop nitrogen harvested + phrv_cropp_to_prod1p => phosphorusflux_vars%hrv_cropp_to_prod1p_patch , & ! InOut: [real(r8) (:)] column level crop phosphorus harvested + chrv_cropc_to_prod1c => carbonflux_vars%hrv_cropc_to_prod1c_col , & ! InOut: [real(r8) (:)] column level crop carbon harvested + chrv_cropn_to_prod1n => nitrogenflux_vars%hrv_cropn_to_prod1n_col , & ! InOut: [real(r8) (:)] column level crop nitrogen harvested + chrv_cropp_to_prod1p => phosphorusflux_vars%hrv_cropp_to_prod1p_col & ! InOut: [real(r8) (:)] column level crop phosphorus harvested + ) + + do pi = 1,maxpatch_pft + do fc = 1,num_soilc + c = filter_soilc(fc) + + if (pi <= col_pp%npfts(c)) then + p = col_pp%pfti(c) + pi - 1 + + if (veg_pp%active(p)) then + + phrv_cropc_to_prod1c(p) = phrv_leafc_to_prod1c(p) + phrv_livestemc_to_prod1c(p) + & + phrv_grainc_to_prod1c(p) + + chrv_cropc_to_prod1c(c) = chrv_cropc_to_prod1c(c) + phrv_cropc_to_prod1c(p) * wtcol(p) + + phrv_cropn_to_prod1n(p) = phrv_leafn_to_prod1n(p) + phrv_livestemn_to_prod1n(p) + & + phrv_grainn_to_prod1n(p) + + chrv_cropn_to_prod1n(c) = chrv_cropn_to_prod1n(c) + phrv_cropn_to_prod1n(p) * wtcol(p) + + phrv_cropp_to_prod1p(p) = phrv_leafp_to_prod1p(p) + phrv_livestemp_to_prod1p(p) + & + phrv_grainp_to_prod1p(p) + + chrv_cropp_to_prod1p(c) = chrv_cropp_to_prod1p(c) + phrv_cropp_to_prod1p(p) * wtcol(p) + + end if + end if + + end do + + end do + end associate +end subroutine CNCropHarvestPftToColumn + +end module CNPhenologyBeTRMod diff --git a/components/clm/src/biogeochem/PStateUpdate1Mod.F90 b/components/clm/src/biogeochem/PStateUpdate1Mod.F90 index 8f71a6be3341..df256c52e58f 100644 --- a/components/clm/src/biogeochem/PStateUpdate1Mod.F90 +++ b/components/clm/src/biogeochem/PStateUpdate1Mod.F90 @@ -18,6 +18,7 @@ module PStateUpdate1Mod use PhosphorusFluxType , only : phosphorusflux_type use PhosphorusStateType , only : phosphorusstate_type use VegetationType , only : veg_pp + use tracer_varcon , only : is_active_betr_bgc !! bgc interface & pflotran: use clm_varctl , only : use_pflotran, pf_cmode use clm_varctl , only : nu_com @@ -89,6 +90,7 @@ subroutine PStateUpdate1(num_soilc, filter_soilc, num_soilp, filter_soilp, & ! if coupled with pflotran, the following updates are NOT needed ! if (.not.(use_pflotran .and. pf_cmode)) then !------------------------------------------------------------------ + if(.not. is_active_betr_bgc)then do j = 1, nlevdecomp do fc = 1,num_soilc c = filter_soilc(fc) @@ -148,7 +150,7 @@ subroutine PStateUpdate1(num_soilc, filter_soilc, num_soilp, filter_soilp, & end do end if end do -! endif ! if (.not.(use_pflotran .and. pf_cmode)) + endif ! if (.not. is_active_betr_bgc)) !------------------------------------------------------------------ ! patch loop diff --git a/components/clm/src/biogeochem/PStateUpdate2Mod.F90 b/components/clm/src/biogeochem/PStateUpdate2Mod.F90 index b8564a78593a..927c5b3caddf 100644 --- a/components/clm/src/biogeochem/PStateUpdate2Mod.F90 +++ b/components/clm/src/biogeochem/PStateUpdate2Mod.F90 @@ -14,6 +14,7 @@ module PStateUpdate2Mod use PhosphorusFLuxType , only : phosphorusflux_type use VegetationType , only : veg_pp use pftvarcon , only : npcropmin + use tracer_varcon , only : is_active_betr_bgc !! bgc interface & pflotran: use clm_varctl , only : use_pflotran, pf_cmode ! @@ -66,7 +67,7 @@ subroutine PStateUpdate2(num_soilc, filter_soilc, num_soilp, filter_soilp, & !------------------------------------------------------------------ ! column-level phosporus fluxes from gap-phase mortality - + if (.not. is_active_betr_bgc) then do j = 1, nlevdecomp do fc = 1,num_soilc c = filter_soilc(fc) @@ -81,7 +82,7 @@ subroutine PStateUpdate2(num_soilc, filter_soilc, num_soilp, filter_soilp, & ps%decomp_ppools_vr_col(c,j,i_cwd) + pf%gap_mortality_p_to_cwdp_col(c,j) * dt end do end do -! endif ! if (.not.(use_pflotran .and. pf_cmode)) + endif ! if (.not.is_active_betr_bgc)) !------------------------------------------------------------------ ! patch -level phosporus fluxes from gap-phase mortality @@ -155,7 +156,7 @@ subroutine PStateUpdate2h(num_soilc, filter_soilc, num_soilp, filter_soilp, & !------------------------------------------------------------------ ! if coupled with pflotran, the following updates are NOT needed - if (.not.(use_pflotran .and. pf_cmode)) then + if ((.not. is_active_betr_bgc) .and. .not.(use_pflotran .and. pf_cmode)) then !------------------------------------------------------------------ ! column-level phosporus fluxes from harvest mortality diff --git a/components/clm/src/biogeochem/PStateUpdate3Mod.F90 b/components/clm/src/biogeochem/PStateUpdate3Mod.F90 index 02c7d68ca2bb..accd872dda4f 100644 --- a/components/clm/src/biogeochem/PStateUpdate3Mod.F90 +++ b/components/clm/src/biogeochem/PStateUpdate3Mod.F90 @@ -17,6 +17,7 @@ module PStateUpdate3Mod use PhosphorusStateType , only : phosphorusstate_type use PhosphorusFLuxType , only : phosphorusflux_type use soilorder_varcon , only : smax,ks_sorption + use tracer_varcon , only : is_active_betr_bgc !! bgc interface & pflotran: use clm_varctl , only : use_pflotran, pf_cmode use clm_varctl , only : nu_com @@ -87,9 +88,16 @@ subroutine PStateUpdate3(bounds,num_soilc, filter_soilc, num_soilp, filter_soilp flux_mineralization(c,j) = 0._r8 enddo enddo - - do k = 1, ndecomp_cascade_transitions - if ( cascade_receiver_pool(k) /= 0 ) then ! skip terminal transitions + if(is_active_betr_bgc)then + do j = 1, nlevdecomp + do fc = 1,num_soilc + c = filter_soilc(fc) + ps%primp_vr_col(c,j) = ps%primp_vr_col(c,j) - pf%primp_to_labilep_vr_col(c,j) *dt + pf%pdep_to_sminp_col(c)*dt * pdep_prof(c,j) + end do + enddo + else + do k = 1, ndecomp_cascade_transitions + if ( cascade_receiver_pool(k) /= 0 ) then ! skip terminal transitions do j = 1, nlevdecomp ! column loop do fc = 1,num_soilc @@ -97,9 +105,9 @@ subroutine PStateUpdate3(bounds,num_soilc, filter_soilc, num_soilp, filter_soilp flux_mineralization(c,j) = flux_mineralization(c,j) - & pf%decomp_cascade_sminp_flux_vr_col(c,j,k)*dt end do - end do - else - do j = 1, nlevdecomp + end do + else + do j = 1, nlevdecomp ! column loop do fc = 1,num_soilc c = filter_soilc(fc) @@ -107,24 +115,24 @@ subroutine PStateUpdate3(bounds,num_soilc, filter_soilc, num_soilp, filter_soilp pf%decomp_cascade_sminp_flux_vr_col(c,j,k)*dt end do - end do - endif - end do - + end do + endif + end do + - do j = 1, nlevdecomp + do j = 1, nlevdecomp ! column loop - do fc = 1,num_soilc - c = filter_soilc(fc) - flux_mineralization(c,j) = flux_mineralization(c,j) + & + do fc = 1,num_soilc + c = filter_soilc(fc) + flux_mineralization(c,j) = flux_mineralization(c,j) + & pf%biochem_pmin_vr_col(c,j) - end do - end do + end do + end do - if (nu_com .eq. 'RD') then - do j = 1, nlevdecomp - do fc = 1,num_soilc + if (nu_com .eq. 'RD') then + do j = 1, nlevdecomp + do fc = 1,num_soilc c = filter_soilc(fc) ! assign read in parameter values smax_c = smax( isoilorder(c) ) @@ -153,10 +161,10 @@ subroutine PStateUpdate3(bounds,num_soilc, filter_soilc, num_soilp, filter_soilp + pf%supplement_to_sminp_vr_col(c,j) - pf%sminp_to_plant_vr_col(c,j) & - pf%labilep_to_secondp_vr_col(c,j) - pf%sminp_leached_vr_col(c,j) ) / & ( 1._r8+(smax_c*ks_sorption_c)/(ks_sorption_c+temp_solutionp(c,j))**2._r8 ) - end do - end do - else ! ECA - do j = 1, nlevdecomp + end do + end do + else ! ECA + do j = 1, nlevdecomp do fc = 1,num_soilc c = filter_soilc(fc) smax_c = vmax_minsurf_p_vr(isoilorder(c),j) @@ -190,7 +198,7 @@ subroutine PStateUpdate3(bounds,num_soilc, filter_soilc, num_soilp, filter_soilp end if enddo enddo - end if + end if do j = 1, nlevdecomp do fc = 1,num_soilc @@ -236,7 +244,7 @@ subroutine PStateUpdate3(bounds,num_soilc, filter_soilc, num_soilp, filter_soilp end do end do - + endif !is_active_betr_bgc ! patch-level phosphorus fluxes do fp = 1,num_soilp diff --git a/components/clm/src/biogeochem/PhosphorusFluxType.F90 b/components/clm/src/biogeochem/PhosphorusFluxType.F90 index 20e0840ed793..4c21c2ddcc23 100755 --- a/components/clm/src/biogeochem/PhosphorusFluxType.F90 +++ b/components/clm/src/biogeochem/PhosphorusFluxType.F90 @@ -127,6 +127,7 @@ module PhosphorusFluxType real(r8), pointer :: m_retransp_to_litter_fire_patch (:) ! patch (gP/m2/s) from retransp to deadcrootp due to fire real(r8), pointer :: fire_ploss_patch (:) ! patch total pft-level fire P loss (gP/m2/s) real(r8), pointer :: fire_ploss_col (:) ! col total column-level fire P loss (gP/m2/s) + real(r8), pointer :: fire_decomp_ploss_col (:) ! col fire p loss from decomposable pools (gP/m2/s) real(r8), pointer :: fire_ploss_p2c_col (:) ! col patch2col column-level fire P loss (gP/m2/s) (p2c) real(r8), pointer :: fire_mortality_p_to_cwdp_col (:,:) ! col P fluxes associated with fire mortality to CWD pool (gP/m3/s) @@ -512,6 +513,7 @@ subroutine InitAllocate(this, bounds) allocate(this%pinputs_col (begc:endc)) ; this%pinputs_col (:) = nan allocate(this%poutputs_col (begc:endc)) ; this%poutputs_col (:) = nan allocate(this%fire_ploss_col (begc:endc)) ; this%fire_ploss_col (:) = nan + allocate(this%fire_decomp_ploss_col (begc:endc)) ; this%fire_decomp_ploss_col (:) = nan allocate(this%fire_ploss_p2c_col (begc:endc)) ; this%fire_ploss_p2c_col (:) = nan allocate(this%som_p_leached_col (begc:endc)) ; this%som_p_leached_col (:) = nan @@ -1137,6 +1139,7 @@ subroutine InitHistory(this, bounds) do l = 1, ndecomp_cascade_transitions ! vertically integrated fluxes !-- mineralization/immobilization fluxes (none from CWD) + if(trim(decomp_cascade_con%decomp_pool_name_history(decomp_cascade_con%cascade_receiver_pool(l)))=='')exit if ( .not. decomp_cascade_con%is_cwd(decomp_cascade_con%cascade_donor_pool(l)) ) then this%decomp_cascade_sminp_flux_col(begc:endc,l) = spval data1dptr => this%decomp_cascade_sminp_flux_col(:,l) @@ -1219,6 +1222,7 @@ subroutine InitHistory(this, bounds) ptr_col=this%som_p_leached_col, default='inactive') do k = 1, ndecomp_pools + if(trim(decomp_cascade_con%decomp_pool_name_history(k))=='')exit if ( .not. decomp_cascade_con%is_cwd(k) ) then this%decomp_ppools_leached_col(begc:endc,k) = spval data1dptr => this%decomp_ppools_leached_col(:,k) @@ -1389,6 +1393,11 @@ subroutine InitHistory(this, bounds) avgflag='A', long_name='total column-level fire P loss', & ptr_col=this%fire_ploss_col, default='inactive') + this%fire_decomp_ploss_col(begc:endc) = spval + call hist_addfld1d (fname='DECOMP_FIRE_PLOSS', units='gP/m^2/s', & + avgflag='A', long_name='fire P loss of decomposable pools', & + ptr_col=this%fire_decomp_ploss_col, default='inactive') + this%dwt_seedp_to_leaf_col(begc:endc) = spval call hist_addfld1d (fname='DWT_SEEDP_TO_LEAF', units='gP/m^2/s', & avgflag='A', long_name='seed source to PFT-level leaf', & diff --git a/components/clm/src/biogeochem/PhosphorusStateType.F90 b/components/clm/src/biogeochem/PhosphorusStateType.F90 index 1aa2259bf2d2..48f0ebfe269b 100755 --- a/components/clm/src/biogeochem/PhosphorusStateType.F90 +++ b/components/clm/src/biogeochem/PhosphorusStateType.F90 @@ -54,7 +54,7 @@ module PhosphorusStateType real(r8), pointer :: retransp_patch (:) ! patch (gP/m2) plant pool of retranslocated P real(r8), pointer :: ppool_patch (:) ! patch (gP/m2) temporary plant P pool real(r8), pointer :: ptrunc_patch (:) ! patch (gP/m2) pft-level sink for P truncation - + real(r8), pointer :: plant_p_buffer_patch (:) ! patch (gP/m2) pft-level abstract p storage real(r8), pointer :: decomp_ppools_vr_col (:,:,:) ! col (gP/m3) vertically-resolved decomposing (litter, cwd, soil) P pools real(r8), pointer :: solutionp_vr_col (:,:) ! col (gP/m3) vertically-resolved soil solution P real(r8), pointer :: labilep_vr_col (:,:) ! col (gP/m3) vertically-resolved soil labile mineral P @@ -207,6 +207,7 @@ subroutine InitAllocate(this, bounds) allocate(this%storvegp_patch (begp:endp)) ; this%storvegp_patch (:) = nan allocate(this%totvegp_patch (begp:endp)) ; this%totvegp_patch (:) = nan allocate(this%totpftp_patch (begp:endp)) ; this%totpftp_patch (:) = nan + allocate(this%plant_p_buffer_patch (begp:endp)) ; this%plant_p_buffer_patch (:) = nan allocate(this%ptrunc_vr_col (begc:endc,1:nlevdecomp_full)) ; this%ptrunc_vr_col (:,:) = nan @@ -439,6 +440,10 @@ subroutine InitHistory(this, bounds) avgflag='A', long_name='total PFT-level phosphorus', & ptr_patch=this%totpftp_patch) + this%plant_p_buffer_patch(begp:endp) = spval + call hist_addfld1d (fname='PLANTP_BUFFER', units='gP/m^2', & + avgflag='A', long_name='plant phosphorus stored as buffer', & + ptr_col=this%plant_p_buffer_patch,default='inactive') !------------------------------- ! P state variables - native to column !------------------------------- @@ -739,7 +744,7 @@ subroutine InitCold(this, bounds, & this%totvegp_patch(p) = 0._r8 this%totpftp_patch(p) = 0._r8 end if - + this%plant_p_buffer_patch(p)= 1.e-4_r8 end do !------------------------------------------- @@ -954,6 +959,10 @@ subroutine Restart ( this, bounds, ncid, flag, cnstate_vars) dim1name='pft', long_name='', units='', & interpinic_flag='interp', readvar=readvar, data=this%ptrunc_patch) + call restartvar(ncid=ncid, flag=flag, varname='plant_p_buffer', xtype=ncd_double, & + dim1name='pft', long_name='', units='', & + interpinic_flag='interp', readvar=readvar, data=this%plant_p_buffer_patch) + if (crop_prog) then call restartvar(ncid=ncid, flag=flag, varname='grainp', xtype=ncd_double, & dim1name='pft', long_name='grain P', units='gP/m2', & diff --git a/components/clm/src/biogeochem/PlantMicKineticsMod.F90 b/components/clm/src/biogeochem/PlantMicKineticsMod.F90 new file mode 100644 index 000000000000..2fce8f403cc4 --- /dev/null +++ b/components/clm/src/biogeochem/PlantMicKineticsMod.F90 @@ -0,0 +1,98 @@ +module PlantMicKineticsMod + +! +! DESCRIPTION +! compute depth-dependent kinetic parameters used for nutrient competition + use shr_kind_mod , only : r8 => shr_kind_r8 + use shr_infnan_mod , only : nan => shr_infnan_nan, assignment(=) + use decompMod , only : bounds_type + use clm_varpar , only : nlevdecomp_full, nlevgrnd, nlevdecomp +implicit none + + type, public :: PlantMicKinetics_type + real(r8), pointer :: plant_nh4_vmax_vr_patch(:,:) + real(r8), pointer :: plant_no3_vmax_vr_patch(:,:) + real(r8), pointer :: plant_p_vmax_vr_patch(:,:) + real(r8), pointer :: plant_nh4_km_vr_patch(:,:) + real(r8), pointer :: plant_no3_km_vr_patch(:,:) + real(r8), pointer :: plant_p_km_vr_patch(:,:) + + real(r8), pointer :: den_eff_ncompet_b_vr_col(:,:) + real(r8), pointer :: nit_eff_ncompet_b_vr_col(:,:) + real(r8), pointer :: plant_eff_ncompet_b_vr_patch(:,:) + real(r8), pointer :: plant_eff_pcompet_b_vr_patch(:,:) + real(r8), pointer :: decomp_eff_ncompet_b_vr_col(:,:) + real(r8), pointer :: decomp_eff_pcompet_b_vr_col(:,:) + real(r8), pointer :: minsurf_p_compet_vr_col(:,:) + real(r8), pointer :: minsurf_nh4_compet_vr_col(:,:) + real(r8), pointer :: vmax_minsurf_p_vr_col(:,:) + real(r8), pointer :: km_minsurf_p_vr_col(:,:) + real(r8), pointer :: km_decomp_nh4_vr_col(:,:) + real(r8), pointer :: km_decomp_no3_vr_col(:,:) + real(r8), pointer :: km_decomp_p_vr_col(:,:) + real(r8), pointer :: km_nit_nh4_vr_col(:,:) + real(r8), pointer :: km_den_no3_vr_col(:,:) + + contains + procedure, public :: Init + procedure, public :: InitAllocate + procedure, public :: InitCold + + end type PlantMicKinetics_type + !------------------------------------------------------------------------ + contains + !------------------------------------------------------------------------ + subroutine Init(this, bounds) + + class(PlantMicKinetics_type) :: this + type(bounds_type), intent(in) :: bounds + + call this%InitAllocate ( bounds) + call this%InitCold (bounds ) + end subroutine Init + !------------------------------------------------------------------------ + subroutine InitAllocate(this, bounds) + + class(PlantMicKinetics_type) :: this + type(bounds_type), intent(in) :: bounds + integer :: begp, endp, begc, endc + + begp = bounds%begp; endp=bounds%endp + begc = bounds%begc; endc=bounds%endc + allocate(this%plant_nh4_vmax_vr_patch(begp:endp, 1:nlevdecomp_full)); this%plant_nh4_vmax_vr_patch(:,:) = nan + allocate(this%plant_no3_vmax_vr_patch(begp:endp, 1:nlevdecomp_full)); this%plant_no3_vmax_vr_patch(:,:) = nan + allocate(this%plant_p_vmax_vr_patch(begp:endp, 1:nlevdecomp_full)); this%plant_p_vmax_vr_patch(:,:) = nan + + allocate(this%plant_no3_km_vr_patch(begp:endp, 1:nlevdecomp_full)); this%plant_no3_km_vr_patch(:,:) = nan + allocate(this%plant_nh4_km_vr_patch(begp:endp, 1:nlevdecomp_full)); this%plant_nh4_km_vr_patch(:,:) = nan + allocate(this%plant_p_km_vr_patch(begp:endp, 1:nlevdecomp_full)); this%plant_p_km_vr_patch(:,:) = nan + + + allocate(this%plant_eff_ncompet_b_vr_patch(begp:endp,1:nlevdecomp_full)); this%plant_eff_ncompet_b_vr_patch(:,:)=nan + allocate(this%plant_eff_pcompet_b_vr_patch(begp:endp,1:nlevdecomp_full)); this%plant_eff_pcompet_b_vr_patch(:,:)=nan + allocate(this%decomp_eff_ncompet_b_vr_col(begc:endc,1:nlevdecomp_full)); this%decomp_eff_ncompet_b_vr_col(:,:) = nan + allocate(this%decomp_eff_pcompet_b_vr_col(begc:endc,1:nlevdecomp_full)); this%decomp_eff_pcompet_b_vr_col(:,:) = nan + allocate(this%minsurf_p_compet_vr_col(begc:endc,1:nlevdecomp_full)); this%minsurf_p_compet_vr_col(:,:) = nan + allocate(this%den_eff_ncompet_b_vr_col(begc:endc,1:nlevdecomp_full)); this%den_eff_ncompet_b_vr_col(:,:) = nan + allocate(this%nit_eff_ncompet_b_vr_col(begc:endc,1:nlevdecomp_full)); this%nit_eff_ncompet_b_vr_col(:,:) = nan + allocate(this%minsurf_nh4_compet_vr_col(begc:endc, 1:nlevdecomp_full)); this%minsurf_nh4_compet_vr_col(:,:) = nan + + allocate(this%vmax_minsurf_p_vr_col(begc:endc, 1:nlevdecomp_full)); this%vmax_minsurf_p_vr_col(:,:) = nan + allocate(this%km_minsurf_p_vr_col(begc:endc,1:nlevdecomp_full)); this%km_minsurf_p_vr_col(:,:) = nan + allocate(this%km_decomp_nh4_vr_col(begc:endc, 1:nlevdecomp_full)); this%km_decomp_nh4_vr_col(:,:) = nan + allocate(this%km_decomp_no3_vr_col(begc:endc,1:nlevdecomp_full)); this%km_decomp_no3_vr_col(:,:) = nan + allocate(this%km_decomp_p_vr_col(begc:endc,1:nlevdecomp_full)); this%km_decomp_p_vr_col(:,:) = nan + allocate(this%km_nit_nh4_vr_col(begc:endc,1:nlevdecomp_full)); this%km_nit_nh4_vr_col(:,:) = nan + allocate(this%km_den_no3_vr_col(begc:endc,1:nlevdecomp_full)); this%km_den_no3_vr_col(:,:) = nan + + + end subroutine InitAllocate + !------------------------------------------------------------------------ + subroutine InitCold(this, bounds) + + class(PlantMicKinetics_type) :: this + type(bounds_type), intent(in) :: bounds + + end subroutine InitCold + +end module PlantMicKineticsMod diff --git a/components/clm/src/biogeophys/HydrologyDrainageMod.F90 b/components/clm/src/biogeophys/HydrologyDrainageMod.F90 index 77a94f75c0e3..5d004b0076a2 100644 --- a/components/clm/src/biogeophys/HydrologyDrainageMod.F90 +++ b/components/clm/src/biogeophys/HydrologyDrainageMod.F90 @@ -18,6 +18,7 @@ module HydrologyDrainageMod use WaterstateType , only : waterstate_type use LandunitType , only : lun_pp use ColumnType , only : col_pp + use VegetationType , only : veg_pp ! ! !PUBLIC TYPES: implicit none @@ -36,7 +37,7 @@ subroutine HydrologyDrainage(bounds, & num_urbanc, filter_urbanc, & num_do_smb_c, filter_do_smb_c, & atm2lnd_vars, glc2lnd_vars, temperature_vars, & - soilhydrology_vars, soilstate_vars, waterstate_vars, waterflux_vars) + soilhydrology_vars, soilstate_vars, waterstate_vars, waterflux_vars, ep_betr) ! ! !DESCRIPTION: ! Calculates soil/snow hydrology with drainage (subsurface runoff) @@ -49,8 +50,8 @@ subroutine HydrologyDrainage(bounds, & use clm_varpar , only : nlevgrnd, nlevurb, nlevsoi use clm_time_manager , only : get_step_size, get_nstep use SoilHydrologyMod , only : CLMVICMap, Drainage - use TracerParamsMod , only : pre_diagnose_soilcol_water_flux, diagnose_drainage_water_flux use clm_varctl , only : use_vsfm + use BeTRSimulationALM, only : betr_simulation_alm_type ! ! !ARGUMENTS: type(bounds_type) , intent(in) :: bounds @@ -69,6 +70,7 @@ subroutine HydrologyDrainage(bounds, & type(soilstate_type) , intent(inout) :: soilstate_vars type(waterstate_type) , intent(inout) :: waterstate_vars type(waterflux_type) , intent(inout) :: waterflux_vars + class(betr_simulation_alm_type), intent(inout) :: ep_betr ! ! !LOCAL VARIABLES: integer :: g,l,c,j,fc ! indices @@ -125,8 +127,8 @@ subroutine HydrologyDrainage(bounds, & endif if (use_betr) then - call pre_diagnose_soilcol_water_flux(bounds, num_hydrologyc, filter_hydrologyc, num_urbanc, filter_urbanc, & - h2osoi_liq(bounds%begc:bounds%endc, 1:nlevsoi)) + call ep_betr%BeTRSetBiophysForcing(bounds, col_pp, veg_pp, 1, nlevsoi, waterstate_vars=waterstate_vars) + call ep_betr%PreDiagSoilColWaterFlux(num_hydrologyc, filter_hydrologyc) endif if (.not. use_vsfm) then @@ -137,8 +139,10 @@ subroutine HydrologyDrainage(bounds, & endif if (use_betr) then - call diagnose_drainage_water_flux(bounds, num_hydrologyc, filter_hydrologyc, num_urbanc, filter_urbanc, & - h2osoi_liq(bounds%begc:bounds%endc, 1:nlevsoi), waterflux_vars) + call ep_betr%BeTRSetBiophysForcing(bounds, col_pp, veg_pp, 1, nlevsoi, waterstate_vars=waterstate_vars, & + waterflux_vars=waterflux_vars) + call ep_betr%DiagDrainWaterFlux(num_hydrologyc, filter_hydrologyc) + call ep_betr%RetrieveBiogeoFlux(bounds, 1, nlevsoi, waterflux_vars=waterflux_vars) endif do j = 1, nlevgrnd diff --git a/components/clm/src/biogeophys/HydrologyNoDrainageMod.F90 b/components/clm/src/biogeophys/HydrologyNoDrainageMod.F90 index e5abe8ca86c0..85244a692403 100644 --- a/components/clm/src/biogeophys/HydrologyNoDrainageMod.F90 +++ b/components/clm/src/biogeophys/HydrologyNoDrainageMod.F90 @@ -19,6 +19,7 @@ Module HydrologyNoDrainageMod use WaterstateType , only : waterstate_type use LandunitType , only : lun_pp use ColumnType , only : col_pp + use VegetationType , only : veg_pp ! ! !PUBLIC TYPES: implicit none @@ -40,7 +41,7 @@ subroutine HydrologyNoDrainage(bounds, & atm2lnd_vars, soilstate_vars, energyflux_vars, temperature_vars, & waterflux_vars, waterstate_vars, & soilhydrology_vars, aerosol_vars, & - soil_water_retention_curve, betrtracer_vars, tracerflux_vars, tracerstate_vars, & + soil_water_retention_curve, ep_betr, & alm_fates) ! ! !DESCRIPTION: @@ -70,15 +71,11 @@ subroutine HydrologyNoDrainage(bounds, & use SoilHydrologyMod , only : CLMVICMap, SurfaceRunoff, Infiltration, WaterTable use SoilWaterMovementMod , only : SoilWater use SoilWaterRetentionCurveMod, only : soil_water_retention_curve_type - use TracerParamsMod , only : pre_diagnose_soilcol_water_flux, diagnose_advect_water_flux, calc_smp_l - use BetrBGCMod , only : calc_dew_sub_flux - use tracerfluxType , only : tracerflux_type - use tracerstatetype , only : tracerstate_type - use BeTRTracerType , only : betrtracer_type use clm_varctl , only : use_vsfm use SoilHydrologyMod , only : DrainageVSFM - use SoilWaterMovementMod, only : Compute_EffecRootFrac_And_VertTranSink_Default - use CLMFatesInterfaceMod , only : hlm_fates_interface_type + use SoilWaterMovementMod , only : Compute_EffecRootFrac_And_VertTranSink_Default + use CLMFatesInterfaceMod , only : hlm_fates_interface_type + use BeTRSimulationALM , only : betr_simulation_alm_type ! ! !ARGUMENTS: type(bounds_type) , intent(in) :: bounds @@ -101,9 +98,7 @@ subroutine HydrologyNoDrainage(bounds, & type(aerosol_type) , intent(inout) :: aerosol_vars type(soilhydrology_type) , intent(inout) :: soilhydrology_vars class(soil_water_retention_curve_type), intent(in) :: soil_water_retention_curve - type(betrtracer_type) , intent(in) :: betrtracer_vars ! betr configuration information - type(tracerflux_type) , intent(inout) :: tracerflux_vars ! tracer flux - type(tracerstate_type) , intent(inout) :: tracerstate_vars ! tracer state variables data structure + class(betr_simulation_alm_type), intent(inout) :: ep_betr type(hlm_fates_interface_type) , intent(inout) :: alm_fates ! ! !LOCAL VARIABLES: @@ -204,8 +199,8 @@ subroutine HydrologyNoDrainage(bounds, & waterflux_vars, waterstate_vars) if (use_betr) then - call pre_diagnose_soilcol_water_flux(bounds, num_hydrologyc, filter_hydrologyc, num_urbanc, filter_urbanc, & - waterstate_vars%h2osoi_liq_col(bounds%begc:bounds%endc, 1:nlevsoi)) + call ep_betr%BeTRSetBiophysForcing(bounds, col_pp, veg_pp, 1, nlevsoi, waterstate_vars=waterstate_vars) + call ep_betr%PreDiagSoilColWaterFlux(num_hydrologyc, filter_hydrologyc) endif if (use_vsfm) then @@ -228,13 +223,12 @@ subroutine HydrologyNoDrainage(bounds, & soil_water_retention_curve) if (use_betr) then - call diagnose_advect_water_flux(bounds, num_hydrologyc, filter_hydrologyc, num_urbanc, filter_urbanc, & - waterstate_vars%h2osoi_liq_col(bounds%begc:bounds%endc, 1:nlevsoi), & - soilhydrology_vars%qcharge_col(bounds%begc:bounds%endc), waterflux_vars) - - call calc_smp_l(bounds, 1, nlevgrnd, num_hydrologyc, filter_hydrologyc, & - temperature_vars%t_soisno_col(bounds%begc:bounds%endc, 1:nlevgrnd), & - soilstate_vars, waterstate_vars, soil_water_retention_curve) + call ep_betr%BeTRSetBiophysForcing(bounds, col_pp, veg_pp, 1, nlevsoi, waterstate_vars=waterstate_vars, & + waterflux_vars=waterflux_vars, soilhydrology_vars = soilhydrology_vars) + + call ep_betr%DiagAdvWaterFlux(num_hydrologyc, filter_hydrologyc) + + call ep_betr%RetrieveBiogeoFlux(bounds, 1, nlevsoi, waterflux_vars=waterflux_vars) endif if (use_vichydro) then @@ -249,8 +243,7 @@ subroutine HydrologyNoDrainage(bounds, & if (use_betr) then !apply dew and sublimation fluxes, this is a temporary work aroud for tracking water isotope !Jinyun Tang, Feb 4, 2015 - call calc_dew_sub_flux(bounds, num_hydrologyc, filter_hydrologyc, & - waterstate_vars, waterflux_vars, betrtracer_vars, tracerflux_vars, tracerstate_vars) + call ep_betr%CalcDewSubFlux(bounds, col_pp, num_hydrologyc, filter_hydrologyc) endif ! Natural compaction and metamorphosis. call SnowCompaction(bounds, num_snowc, filter_snowc, & diff --git a/components/clm/src/biogeophys/SoilHydrologyType.F90 b/components/clm/src/biogeophys/SoilHydrologyType.F90 index 618c3f7c6502..4bb403db4ddf 100644 --- a/components/clm/src/biogeophys/SoilHydrologyType.F90 +++ b/components/clm/src/biogeophys/SoilHydrologyType.F90 @@ -34,6 +34,7 @@ Module SoilHydrologyType real(r8), pointer :: zwts_col (:) ! col water table depth, the shallower of the two water depths real(r8), pointer :: zwt_perched_col (:) ! col perched water table depth real(r8), pointer :: wa_col (:) ! col water in the unconfined aquifer (mm) + real(r8), pointer :: qflx_bot_col (:) real(r8), pointer :: qcharge_col (:) ! col aquifer recharge rate (mm/s) real(r8), pointer :: fracice_col (:,:) ! col fractional impermeability (-) real(r8), pointer :: icefrac_col (:,:) ! col fraction of ice @@ -115,6 +116,7 @@ subroutine InitAllocate(this, bounds) allocate(this%frost_table_col (begc:endc)) ; this%frost_table_col (:) = nan allocate(this%zwt_col (begc:endc)) ; this%zwt_col (:) = nan + allocate(this%qflx_bot_col (begc:endc)) ; this%qflx_bot_col (:) = nan allocate(this%zwt_perched_col (begc:endc)) ; this%zwt_perched_col (:) = nan allocate(this%zwts_col (begc:endc)) ; this%zwts_col (:) = nan diff --git a/components/clm/src/biogeophys/SoilWaterMovementMod.F90 b/components/clm/src/biogeophys/SoilWaterMovementMod.F90 index da1dbf77ce26..02ce8b05cf78 100644 --- a/components/clm/src/biogeophys/SoilWaterMovementMod.F90 +++ b/components/clm/src/biogeophys/SoilWaterMovementMod.F90 @@ -1086,6 +1086,7 @@ subroutine Compute_EffecRootFrac_And_VertTranSink_Default(bounds, num_filterc, & ! vegetation transpiration (mm H2O/s) (+ = to atm) qflx_tran_veg_col => waterflux_vars%qflx_tran_veg_col , & ! Input: [real(r8) (:) ] ! vegetation transpiration (mm H2O/s) (+ = to atm) + qflx_rootsoi_frac_patch => waterflux_vars%qflx_rootsoi_frac_patch , & ! Output: [real(r8) (:,:) ] vegetation/soil water exchange (m H2O/s) (+ = to atm) rootr_patch => soilstate_vars%rootr_patch , & ! Input: [real(r8) (:,:) ] ! effective fraction of roots in each soil layer rootr_col => soilstate_vars%rootr_col & ! Output: [real(r8) (:,:) ] @@ -1118,7 +1119,8 @@ subroutine Compute_EffecRootFrac_And_VertTranSink_Default(bounds, num_filterc, & p = col_pp%pfti(c) + pi - 1 if (veg_pp%active(p)) then rootr_col(c,j) = rootr_col(c,j) + rootr_patch(p,j) * & - qflx_tran_veg_patch(p) * veg_pp%wtcol(p) + qflx_tran_veg_patch(p) * veg_pp%wtcol(p) + qflx_rootsoi_frac_patch(p,j) = rootr_patch(p,j) * qflx_tran_veg_patch(p) * veg_pp%wtcol(p) end if end if end do @@ -1145,6 +1147,24 @@ subroutine Compute_EffecRootFrac_And_VertTranSink_Default(bounds, num_filterc, & end do end do + + do pi = 1,max_patch_per_col + do j = 1,nlevsoi + do fc = 1, num_filterc + c = filterc(fc) + if (pi <= col_pp%npfts(c)) then + p = col_pp%pfti(c) + pi - 1 + if (veg_pp%active(p)) then + if(rootr_col(c,j)==0._r8)then + qflx_rootsoi_frac_patch(p,j) = 0._r8 + else + qflx_rootsoi_frac_patch(p,j) = qflx_rootsoi_frac_patch(p,j)/(temp(c)*rootr_col(c,j)) + endif + end if + end if + end do + end do + enddo end associate return end subroutine Compute_EffecRootFrac_And_VertTranSink_Default diff --git a/components/clm/src/biogeophys/WaterStateType.F90 b/components/clm/src/biogeophys/WaterStateType.F90 index 7cde6b183c3a..b2ce0b7128ee 100644 --- a/components/clm/src/biogeophys/WaterStateType.F90 +++ b/components/clm/src/biogeophys/WaterStateType.F90 @@ -34,11 +34,15 @@ module WaterstateType real(r8), pointer :: bw_col (:,:) ! col partial density of water in the snow pack (ice + liquid) [kg/m3] real(r8), pointer :: finundated_col (:) ! fraction of column that is inundated, this is for bgc caclulation in betr + real(r8), pointer :: rhvap_soi_col (:,:) + real(r8), pointer :: rho_vap_col (:,:) real(r8), pointer :: smp_l_col (:,:) ! col liquid phase soil matric potential, mm real(r8), pointer :: h2osno_col (:) ! col snow water (mm H2O) real(r8), pointer :: h2osno_old_col (:) ! col snow mass for previous time step (kg/m2) (new) real(r8), pointer :: h2osoi_liq_col (:,:) ! col liquid water (kg/m2) (new) (-nlevsno+1:nlevgrnd) real(r8), pointer :: h2osoi_ice_col (:,:) ! col ice lens (kg/m2) (new) (-nlevsno+1:nlevgrnd) + real(r8), pointer :: h2osoi_liq_old_col (:,:) + real(r8), pointer :: h2osoi_ice_old_col (:,:) real(r8), pointer :: h2osoi_liqice_10cm_col (:) ! col liquid water + ice lens in top 10cm of soil (kg/m2) real(r8), pointer :: h2osoi_vol_col (:,:) ! col volumetric soil water (0<=h2osoi_vol<=watsat) [m3/m3] (nlevgrnd) real(r8), pointer :: air_vol_col (:,:) ! col air filled porosity @@ -114,7 +118,7 @@ module WaterstateType procedure, private :: InitAllocate procedure, private :: InitHistory procedure, private :: InitCold - + procedure, public :: save_h2osoi_old end type waterstate_type ! minimum allowed snow effective radius (also "fresh snow" value) [microns] @@ -191,7 +195,10 @@ subroutine InitAllocate(this, bounds) allocate(this%air_vol_col (begc:endc, 1:nlevgrnd)) ; this%air_vol_col (:,:) = nan allocate(this%h2osoi_liqvol_col (begc:endc,-nlevsno+1:nlevgrnd)) ; this%h2osoi_liqvol_col (:,:) = nan allocate(this%h2osoi_icevol_col (begc:endc,-nlevsno+1:nlevgrnd)) ; this%h2osoi_icevol_col (:,:) = nan - + allocate(this%rho_vap_col (begc:endc,-nlevsno+1:nlevgrnd)) ; this%rho_vap_col (:,:) = nan + allocate(this%rhvap_soi_col (begc:endc,-nlevsno+1:nlevgrnd)) ; this%rhvap_soi_col (:,:) = nan + allocate(this%h2osoi_liq_old_col (begc:endc,-nlevsno+1:nlevgrnd)) ; this%h2osoi_liq_old_col (:,:) = nan + allocate(this%h2osoi_ice_old_col (begc:endc,-nlevsno+1:nlevgrnd)) ; this%h2osoi_ice_old_col (:,:) = nan allocate(this%h2osoi_ice_col (begc:endc,-nlevsno+1:nlevgrnd)) ; this%h2osoi_ice_col (:,:) = nan allocate(this%h2osoi_liq_col (begc:endc,-nlevsno+1:nlevgrnd)) ; this%h2osoi_liq_col (:,:) = nan allocate(this%h2ocan_patch (begp:endp)) ; this%h2ocan_patch (:) = nan @@ -763,7 +770,7 @@ subroutine InitCold(this, bounds, & endif end do end do - + call this%save_h2osoi_old(bounds) end associate end subroutine InitCold @@ -1007,4 +1014,23 @@ subroutine Reset(this, column) end subroutine Reset + !----------------------------------------------------------------------- + subroutine save_h2osoi_old(this,bounds) + ! + ! !DESCRIPTION: + ! save current water status to old + ! + ! !ARGUMENTS: + class(waterstate_type) :: this + type(bounds_type) , intent(in) :: bounds + + + integer :: begc, endc + + begc = bounds%begc; endc=bounds%endc + + this%h2osoi_liq_old_col(begc:endc,:) = this%h2osoi_liq_col(begc:endc,:) + this%h2osoi_ice_old_col(begc:endc,:) = this%h2osoi_ice_col(begc:endc,:) + + end subroutine save_h2osoi_old end module WaterstateType diff --git a/components/clm/src/biogeophys/WaterfluxType.F90 b/components/clm/src/biogeophys/WaterfluxType.F90 index 0d35cb98138c..ae35adc69678 100644 --- a/components/clm/src/biogeophys/WaterfluxType.F90 +++ b/components/clm/src/biogeophys/WaterfluxType.F90 @@ -28,6 +28,7 @@ module WaterfluxType real(r8), pointer :: qflx_snow_grnd_col (:) ! col snow on ground after interception (mm H2O/s) [+] real(r8), pointer :: qflx_sub_snow_patch (:) ! patch sublimation rate from snow pack (mm H2O /s) [+] real(r8), pointer :: qflx_sub_snow_col (:) ! col sublimation rate from snow pack (mm H2O /s) [+] + real(r8), pointer :: qflx_sub_snow_vol_col (:) ! real(r8), pointer :: qflx_evap_soi_patch (:) ! patch soil evaporation (mm H2O/s) (+ = to atm) real(r8), pointer :: qflx_evap_soi_col (:) ! col soil evaporation (mm H2O/s) (+ = to atm) real(r8), pointer :: qflx_evap_veg_patch (:) ! patch vegetation evaporation (mm H2O/s) (+ = to atm) @@ -62,11 +63,12 @@ module WaterfluxType real(r8), pointer :: qflx_gross_infl_soil_col (:) ! col gross infiltration, before considering the evaporation real(r8), pointer :: qflx_adv_col (:,:) ! col advective flux across different soil layer interfaces [mm H2O/s] [+ downward] real(r8), pointer :: qflx_rootsoi_col (:,:) ! col root and soil water exchange [mm H2O/s] [+ into root] - + real(r8), pointer :: qflx_rootsoi_frac_patch (:,:) real(r8), pointer :: dwb_col (:) ! coll water mass change [+ increase] [mm H2O/s] real(r8), pointer :: qflx_infl_col (:) ! col infiltration (mm H2O /s) real(r8), pointer :: qflx_surf_col (:) ! col surface runoff (mm H2O /s) real(r8), pointer :: qflx_drain_col (:) ! col sub-surface runoff (mm H2O /s) + real(r8), pointer :: qflx_totdrain_col (:) real(r8), pointer :: qflx_top_soil_col (:) ! col net water input into soil from top (mm/s) real(r8), pointer :: qflx_h2osfc_to_ice_col (:) ! col conversion of h2osfc to ice real(r8), pointer :: qflx_h2osfc_surf_col (:) ! col surface water runoff @@ -196,6 +198,7 @@ subroutine InitAllocate(this, bounds) allocate(this%qflx_snwcp_liq_col (begc:endc)) ; this%qflx_snwcp_liq_col (:) = nan allocate(this%qflx_snwcp_ice_col (begc:endc)) ; this%qflx_snwcp_ice_col (:) = nan allocate(this%qflx_tran_veg_col (begc:endc)) ; this%qflx_tran_veg_col (:) = nan + allocate(this%qflx_sub_snow_vol_col (begc:endc)) ; this%qflx_sub_snow_vol_col (:) = nan allocate(this%qflx_evap_veg_col (begc:endc)) ; this%qflx_evap_veg_col (:) = nan allocate(this%qflx_evap_can_col (begc:endc)) ; this%qflx_evap_can_col (:) = nan allocate(this%qflx_evap_soi_col (begc:endc)) ; this%qflx_evap_soi_col (:) = nan @@ -222,9 +225,10 @@ subroutine InitAllocate(this, bounds) allocate(this%qflx_drain_vr_col (begc:endc,1:nlevgrnd)) ; this%qflx_drain_vr_col (:,:) = nan allocate(this%qflx_adv_col (begc:endc,0:nlevgrnd)) ; this%qflx_adv_col (:,:) = nan allocate(this%qflx_rootsoi_col (begc:endc,1:nlevgrnd)) ; this%qflx_rootsoi_col (:,:) = nan - + allocate(this%qflx_rootsoi_frac_patch (begp:endp,1:nlevsoi)) ; this%qflx_rootsoi_frac_patch (:,:) = nan allocate(this%qflx_infl_col (begc:endc)) ; this%qflx_infl_col (:) = nan allocate(this%qflx_surf_col (begc:endc)) ; this%qflx_surf_col (:) = nan + allocate(this%qflx_totdrain_col (begc:endc)) ; this%qflx_totdrain_col (:) = nan allocate(this%qflx_drain_col (begc:endc)) ; this%qflx_drain_col (:) = nan allocate(this%qflx_top_soil_col (begc:endc)) ; this%qflx_top_soil_col (:) = nan allocate(this%qflx_h2osfc_to_ice_col (begc:endc)) ; this%qflx_h2osfc_to_ice_col (:) = nan diff --git a/components/clm/src/data_types/CNStateType.F90 b/components/clm/src/data_types/CNStateType.F90 index 7249b3ca1d35..c8a3480f7f1f 100644 --- a/components/clm/src/data_types/CNStateType.F90 +++ b/components/clm/src/data_types/CNStateType.F90 @@ -151,6 +151,8 @@ module CNStateType real(r8), pointer :: np_scalar (:) ! np scaling factor for root n/p uptake kinetics (no units) real(r8), pointer :: cost_ben_scalar (:) ! cost benefit analysis scaling factor for root n uptake kinetics (no units) + real(r8), pointer :: frac_loss_lit_to_fire_col (:) + real(r8), pointer :: frac_loss_cwd_to_fire_col (:) contains procedure, public :: Init @@ -321,7 +323,8 @@ subroutine InitAllocate(this, bounds) allocate(this%cp_scalar (begp:endp)) ; this%cp_scalar (:) = 0.0 allocate(this%np_scalar (begp:endp)) ; this%np_scalar (:) = 0.0 allocate(this%cost_ben_scalar (begp:endp)) ; this%cost_ben_scalar(:) = 0.0 - + allocate(this%frac_loss_lit_to_fire_col (begc:endc)) ; this%frac_loss_lit_to_fire_col(:) =0._r8 + allocate(this%frac_loss_cwd_to_fire_col (begc:endc)) ; this%frac_loss_cwd_to_fire_col(:) =0._r8 end subroutine InitAllocate !------------------------------------------------------------------------ diff --git a/components/clm/src/external_models/sbetr b/components/clm/src/external_models/sbetr index f85c283debe0..606d50bed837 160000 --- a/components/clm/src/external_models/sbetr +++ b/components/clm/src/external_models/sbetr @@ -1 +1 @@ -Subproject commit f85c283debe0de53538a72f1de3d58f2e163dd0d +Subproject commit 606d50bed8378054d3000e31daadbf84ab479472 diff --git a/components/clm/src/main/clm_driver.F90 b/components/clm/src/main/clm_driver.F90 index 5b969ac71c4b..45e3912c7af9 100644 --- a/components/clm/src/main/clm_driver.F90 +++ b/components/clm/src/main/clm_driver.F90 @@ -10,7 +10,7 @@ module clm_driver ! !USES: use shr_kind_mod , only : r8 => shr_kind_r8 use clm_varctl , only : wrtdia, iulog, create_glacier_mec_landunit, use_ed - use clm_varpar , only : nlevtrc_soil + use clm_varpar , only : nlevtrc_soil, nlevsoi use clm_varctl , only : wrtdia, iulog, create_glacier_mec_landunit, use_ed, use_betr use clm_varctl , only : use_cn, use_cndv, use_lch4, use_voc, use_noio, use_c13, use_c14 use clm_time_manager , only : get_step_size, get_curr_date, get_ref_date, get_nstep, is_beg_curr_day, get_curr_time_string @@ -79,7 +79,7 @@ module clm_driver use DaylengthMod , only : UpdateDaylength use perf_mod ! - use clm_instMod , only : ch4_vars + use clm_instMod , only : ch4_vars, ep_betr use clm_instMod , only : carbonstate_vars, c13_carbonstate_vars, c14_carbonstate_vars use clm_instMod , only : carbonflux_vars, c13_carbonflux_vars, c14_carbonflux_vars use clm_instMod , only : nitrogenstate_vars @@ -115,23 +115,13 @@ module clm_driver use clm_instMod , only : soil_water_retention_curve use clm_instMod , only : chemstate_vars use clm_instMod , only : alm_fates - use betr_initializeMod , only : betrtracer_vars - use betr_initializeMod , only : tracercoeff_vars - use betr_initializeMod , only : tracerflux_vars - use betr_initializeMod , only : tracerState_vars - use betr_initializeMod , only : tracerboundarycond_vars - use betr_initializeMod , only : bgc_reaction - use betr_initializeMod , only : plantsoilnutrientflux_vars - use BetrBGCMod , only : run_betr_one_step_without_drainage - use BetrBGCMod , only : run_betr_one_step_with_drainage - use TracerBalanceMod , only : betr_tracer_massbalance_check - use TracerBalanceMod , only : begin_betr_tracer_massbalance - use tracer_varcon , only : is_active_betr_bgc, do_betr_leaching - use CNEcosystemDynBetrMod , only : CNEcosystemDynBetrVeg, CNEcosystemDynBetrSummary, CNFluxStateBetrSummary + use clm_instMod , only : PlantMicKinetics_vars + use tracer_varcon , only : is_active_betr_bgc + use CNEcosystemDynBetrMod , only : CNEcosystemDynBetr, CNFluxStateBetrSummary use GridcellType , only : grc_pp use LandunitType , only : lun_pp use ColumnType , only : col_pp - use VegetationType , only : veg_pp + use VegetationType , only : veg_pp use shr_sys_mod , only : shr_sys_flush use shr_log_mod , only : errMsg => shr_log_errMsg @@ -296,12 +286,10 @@ subroutine clm_drv(doalb, nextsw_cday, declinp1, declin, rstwr, nlend, rdate) do nc = 1,nclumps call get_clump_bounds(nc, bounds_clump) - if (use_betr .and. (.not. do_betr_leaching)) then - - call begin_betr_tracer_massbalance(bounds_clump, 1, nlevtrc_soil, & - filter(nc)%num_soilc, filter(nc)%soilc, betrtracer_vars , & - tracerstate_vars, tracerflux_vars) - + if (use_betr) then + dtime=get_step_size(); nstep=get_nstep() + call ep_betr%SetClock(dtime= dtime, nelapstep=nstep) + call ep_betr%BeginMassBalanceCheck(bounds_clump) endif if (use_cn) then @@ -595,7 +583,10 @@ subroutine clm_drv(doalb, nextsw_cday, declinp1, declin, rstwr, nlend, rdate) ! ============================================================================ ! Determine temperatures ! ============================================================================ - + if(use_betr)then + call ep_betr%BeTRSetBiophysForcing(bounds_clump, col_pp, veg_pp, 1, nlevsoi, waterstate_vars=waterstate_vars) + call ep_betr%PreDiagSoilColWaterFlux(filter(nc)%num_nolakec , filter(nc)%nolakec) + endif ! Set lake temperature call LakeTemperature(bounds_clump, & @@ -615,6 +606,11 @@ subroutine clm_drv(doalb, nextsw_cday, declinp1, declin, rstwr, nlend, rdate) solarabs_vars, soilstate_vars, energyflux_vars, temperature_vars) call t_stopf('soiltemperature') + + if(use_betr)then + call ep_betr%BeTRSetBiophysForcing(bounds_clump, col_pp, veg_pp, 1, nlevsoi, waterstate_vars=waterstate_vars) + call ep_betr%DiagnoseDtracerFreezeThaw(bounds_clump, filter(nc)%num_nolakec , filter(nc)%nolakec, col_pp, lun_pp) + endif ! ============================================================================ ! update surface fluxes for new ground temperature. ! ============================================================================ @@ -654,8 +650,8 @@ subroutine clm_drv(doalb, nextsw_cday, declinp1, declin, rstwr, nlend, rdate) filter(nc)%num_nosnowc, filter(nc)%nosnowc, & atm2lnd_vars, soilstate_vars, energyflux_vars, temperature_vars, & waterflux_vars, waterstate_vars, soilhydrology_vars, aerosol_vars, & - soil_water_retention_curve, betrtracer_vars, tracerflux_vars, & - tracerstate_vars, alm_fates) + soil_water_retention_curve, ep_betr, & + alm_fates) ! Calculate column-integrated aerosol masses, and ! mass concentrations for radiative calculations and output @@ -742,58 +738,35 @@ subroutine clm_drv(doalb, nextsw_cday, declinp1, declin, rstwr, nlend, rdate) ! ============================================================================ call t_startf('ecosysdyn') - - if(is_active_betr_bgc)then + if(use_betr)then !right now betr bgc is intended only for non-ed mode - !this returns the plant nutrient demand to soil bgc - call CNEcosystemDynBetrVeg(bounds_clump, & - filter(nc)%num_soilc, filter(nc)%soilc, & - filter(nc)%num_soilp, filter(nc)%soilp, & - filter(nc)%num_pcropp, filter(nc)%pcropp, doalb, & - cnstate_vars, carbonflux_vars, carbonstate_vars, & - c13_carbonflux_vars, c13_carbonstate_vars, & - c14_carbonflux_vars, c14_carbonstate_vars, & - nitrogenflux_vars, nitrogenstate_vars, & - atm2lnd_vars, waterstate_vars, waterflux_vars, & - canopystate_vars, soilstate_vars, temperature_vars, crop_vars, & - dgvs_vars, photosyns_vars, soilhydrology_vars, energyflux_vars,& - plantsoilnutrientflux_vars, & - phosphorusflux_vars, phosphorusstate_vars) - - !do belowground bgc and transport - call t_startf('betr_nodrain') - - call run_betr_one_step_without_drainage(bounds_clump, 1, nlevtrc_soil, & - filter(nc)%num_soilc, filter(nc)%soilc, & - filter(nc)%num_soilp, filter(nc)%soilp, & - col_pp, atm2lnd_vars, & - soilhydrology_vars, soilstate_vars, waterstate_vars, temperature_vars, & - waterflux_vars, chemstate_vars, cnstate_vars, canopystate_vars, & - carbonstate_vars, carbonflux_vars, nitrogenstate_vars, nitrogenflux_vars,& - betrtracer_vars, bgc_reaction, & - tracerboundarycond_vars, tracercoeff_vars, tracerstate_vars, & - tracerflux_vars, plantsoilnutrientflux_vars) - - call t_stopf('betr_nodrain') - - !do ecosystem variable summary - call CNEcosystemDynBetrSummary(bounds_clump, & - filter(nc)%num_soilc, filter(nc)%soilc, & - filter(nc)%num_soilp, filter(nc)%soilp, & - filter(nc)%num_pcropp, filter(nc)%pcropp, doalb, & - cnstate_vars, carbonflux_vars, carbonstate_vars, & - c13_carbonflux_vars, c13_carbonstate_vars, & - c14_carbonflux_vars, c14_carbonstate_vars, & - nitrogenflux_vars, nitrogenstate_vars, & - atm2lnd_vars, waterstate_vars, waterflux_vars, & - canopystate_vars, soilstate_vars, temperature_vars, crop_vars, & - dgvs_vars, photosyns_vars, soilhydrology_vars, energyflux_vars,& - plantsoilnutrientflux_vars, phosphorusstate_vars) - else + if(is_active_betr_bgc)then + !this returns the plant nutrient demand to soil bgc + call CNEcosystemDynBetr(bounds_clump, & + filter(nc)%num_soilc, filter(nc)%soilc, & + filter(nc)%num_soilp, filter(nc)%soilp, & + filter(nc)%num_pcropp, filter(nc)%pcropp, doalb, & + cnstate_vars, carbonflux_vars, carbonstate_vars, & + c13_carbonflux_vars, c13_carbonstate_vars, & + c14_carbonflux_vars, c14_carbonstate_vars, & + nitrogenflux_vars, nitrogenstate_vars, & + atm2lnd_vars, waterstate_vars, waterflux_vars, & + canopystate_vars, soilstate_vars, temperature_vars, crop_vars, & + dgvs_vars, photosyns_vars, soilhydrology_vars, energyflux_vars,& + PlantMicKinetics_vars, & + phosphorusflux_vars, phosphorusstate_vars) + + call CNAnnualUpdate(bounds_clump, & + filter(nc)%num_soilc, filter(nc)%soilc, & + filter(nc)%num_soilp, filter(nc)%soilp, & + cnstate_vars, carbonflux_vars) + endif + endif ! FIX(SPM,032414) push these checks into the routines below and/or make this consistent. - if (.not. use_ed) then + if (.not. use_ed) then + if( .not. is_active_betr_bgc) then if (use_cn) then ! fully prognostic canopy structure and C-N biogeochemistry @@ -914,7 +887,7 @@ subroutine clm_drv(doalb, nextsw_cday, declinp1, declin, rstwr, nlend, rdate) filter(nc)%num_soilc, filter(nc)%soilc, & filter(nc)%num_soilp, filter(nc)%soilp, & cnstate_vars, carbonflux_vars) - else ! not use_cn + else ! not use_cn if (doalb) then ! Prescribed biogeography - prescribed canopy structure, some prognostic carbon fluxes @@ -925,7 +898,7 @@ subroutine clm_drv(doalb, nextsw_cday, declinp1, declin, rstwr, nlend, rdate) end if end if ! end of if-use_cn - + end if ! end of is_active_betr_bgc end if ! end of if-use_ed @@ -940,31 +913,28 @@ subroutine clm_drv(doalb, nextsw_cday, declinp1, declin, rstwr, nlend, rdate) call t_stopf('depvel') if (use_betr)then - if (do_betr_leaching)then - call bgc_reaction%init_betr_alm_bgc_coupler(bounds_proc, & - carbonstate_vars, nitrogenstate_vars, betrtracer_vars, tracerstate_vars) - - !the following is dirty hack, I'll reconsider this in later modifcations, Jinyun Tang May 14, 2015 - call begin_betr_tracer_massbalance(bounds_clump, 1, nlevtrc_soil, & - filter(nc)%num_soilc, filter(nc)%soilc, betrtracer_vars , & - tracerstate_vars, tracerflux_vars) - - endif - - !this is used for non-online bgc with betr - call run_betr_one_step_without_drainage(bounds_clump, 1, nlevtrc_soil, & - filter(nc)%num_soilc, filter(nc)%soilc, & - filter(nc)%num_soilp, filter(nc)%soilp, & - col_pp, atm2lnd_vars, & - soilhydrology_vars, soilstate_vars, waterstate_vars, temperature_vars, & - waterflux_vars, chemstate_vars, cnstate_vars, canopystate_vars, & - carbonstate_vars, carbonflux_vars, nitrogenstate_vars, & - nitrogenflux_vars, betrtracer_vars, bgc_reaction, & - tracerboundarycond_vars, tracercoeff_vars, tracerstate_vars, & - tracerflux_vars, plantsoilnutrientflux_vars) - endif + call ep_betr%CalcSmpL(bounds_clump, 1, nlevsoi, filter(nc)%num_soilc, filter(nc)%soilc, & + temperature_vars%t_soisno_col(bounds_clump%begc:bounds_clump%endc,1:nlevsoi), & + soilstate_vars, waterstate_vars, soil_water_retention_curve) + + call ep_betr%SetBiophysForcing(bounds_clump, col_pp, veg_pp, & + carbonflux_vars=carbonflux_vars, & + waterstate_vars=waterstate_vars, waterflux_vars=waterflux_vars, & + temperature_vars=temperature_vars, soilhydrology_vars=soilhydrology_vars, & + atm2lnd_vars=atm2lnd_vars, canopystate_vars=canopystate_vars, & + chemstate_vars=chemstate_vars, soilstate_vars=soilstate_vars, & + cnstate_vars = cnstate_vars, carbonstate_vars=carbonstate_vars) + + if(is_active_betr_bgc)then + call ep_betr%PlantSoilBGCSend(bounds_clump, col_pp, veg_pp, & + filter(nc)%num_soilc, filter(nc)%soilc, cnstate_vars, & + carbonflux_vars, c13_carbonflux_vars, c14_carbonflux_vars, nitrogenflux_vars, phosphorusflux_vars,& + PlantMicKinetics_vars) + endif + call ep_betr%StepWithoutDrainage(bounds_clump, col_pp, veg_pp) + endif !end use_betr - if (use_lch4) then + if (use_lch4 .and. .not. is_active_betr_bgc) then !warning: do not call ch4 before CNAnnualUpdate, which will fail the ch4 model call t_startf('ch4') call ch4 (bounds_clump, & @@ -976,7 +946,6 @@ subroutine clm_drv(doalb, nextsw_cday, declinp1, declin, rstwr, nlend, rdate) carbonstate_vars, carbonflux_vars, nitrogenflux_vars, ch4_vars, lnd2atm_vars) call t_stopf('ch4') end if - endif !end of if is_active_betr_bgc ! Dry Deposition of chemical tracers (Wesely (1998) parameterizaion) call t_startf('depvel') @@ -996,31 +965,38 @@ subroutine clm_drv(doalb, nextsw_cday, declinp1, declin, rstwr, nlend, rdate) filter(nc)%num_urbanc, filter(nc)%urbanc, & filter(nc)%num_do_smb_c, filter(nc)%do_smb_c, & atm2lnd_vars, glc2lnd_vars, temperature_vars, & - soilhydrology_vars, soilstate_vars, waterstate_vars, waterflux_vars) + soilhydrology_vars, soilstate_vars, waterstate_vars, waterflux_vars,ep_betr) call t_stopf('hydro2 drainage') if (use_betr) then - - call t_startf('betr drainage') - call run_betr_one_step_with_drainage(bounds_clump, 1, nlevtrc_soil, & - filter(nc)%num_soilc, filter(nc)%soilc, & - tracerboundarycond_vars%jtops_col(bounds_clump%begc:bounds_clump%endc), & - waterflux_vars%qflx_drain_vr_col(bounds_clump%begc:bounds_clump%endc, 1:nlevtrc_soil), & - col_pp, betrtracer_vars , tracercoeff_vars, tracerstate_vars, tracerflux_vars) + call t_startf('betr drainage') + call ep_betr%StepWithDrainage(bounds_clump, col_pp) call t_stopf('betr drainage') call t_startf('betr balchk') - call betr_tracer_massbalance_check(bounds_clump, 1, nlevtrc_soil, & - filter(nc)%num_soilc, filter(nc)%soilc, betrtracer_vars, & - tracerstate_vars, tracerflux_vars) - call t_stopf('betr balchk') - - call bgc_reaction%betr_alm_flux_statevar_feedback(bounds_clump, & - filter(nc)%num_soilc, filter(nc)%soilc, & - carbonstate_vars, nitrogenstate_vars, nitrogenflux_vars, & - tracerstate_vars, tracerflux_vars, betrtracer_vars) - endif + call ep_betr%MassBalanceCheck(bounds_clump) + call t_stopf('betr balchk') + call ep_betr%HistRetrieval(bounds_clump, filter(nc)%num_nolakec, filter(nc)%nolakec) + + if(is_active_betr_bgc)then + + !extract nitrogen pool and flux from betr + call ep_betr%PlantSoilBGCRecv(bounds_clump, col_pp, veg_pp, filter(nc)%num_soilc, filter(nc)%soilc,& + carbonstate_vars, carbonflux_vars, c13_carbonstate_vars, c13_carbonflux_vars, & + c14_carbonstate_vars, c14_carbonflux_vars, & + nitrogenstate_vars, nitrogenflux_vars, phosphorusstate_vars, phosphorusflux_vars) + !summarize total column nitrogen and carbon + call CNFluxStateBetrSummary(bounds_clump, col_pp, veg_pp, & + filter(nc)%num_soilc, filter(nc)%soilc, & + filter(nc)%num_soilp, filter(nc)%soilp, & + carbonflux_vars, carbonstate_vars, & + c13_carbonflux_vars, c13_carbonstate_vars, & + c14_carbonflux_vars, c14_carbonstate_vars, & + nitrogenflux_vars, nitrogenstate_vars, & + phosphorusflux_vars, phosphorusstate_vars) + endif + endif !end use_betr ! Execute FATES dynamics if ( use_ed ) then @@ -1068,16 +1044,7 @@ subroutine clm_drv(doalb, nextsw_cday, declinp1, declin, rstwr, nlend, rdate) if (use_cn) then - if (is_active_betr_bgc)then - !extract nitrogen pool and flux from betr - !summarize total column nitrogen and carbon - call CNFluxStateBetrSummary(bounds_clump, filter(nc)%num_soilc, filter(nc)%soilc, & - filter(nc)%num_soilp, filter(nc)%soilp, & - carbonflux_vars, carbonstate_vars, & - c13_carbonflux_vars, c13_carbonstate_vars, & - c14_carbonflux_vars, c14_carbonstate_vars, nitrogenflux_vars, nitrogenstate_vars, & - betrtracer_vars, tracerflux_vars, tracerstate_vars) - else + if (.not. is_active_betr_bgc)then ! FIX(SPM,032414) there are use_ed checks in this routine...be consistent ! (see comment above re: no leaching call CNEcosystemDynLeaching(bounds_clump, & @@ -1097,7 +1064,7 @@ subroutine clm_drv(doalb, nextsw_cday, declinp1, declin, rstwr, nlend, rdate) call CNVegStructUpdate(filter(nc)%num_soilp, filter(nc)%soilp, & waterstate_vars, frictionvel_vars, dgvs_vars, cnstate_vars, & carbonstate_vars, canopystate_vars) - end if + end if end if end if @@ -1184,6 +1151,10 @@ subroutine clm_drv(doalb, nextsw_cday, declinp1, declin, rstwr, nlend, rdate) ! Determine gridcell averaged properties to send to atm ! ============================================================================ + if(use_betr)then + call ep_betr%DiagnoseLnd2atm(bounds_proc, col_pp, lnd2atm_vars) + endif + call t_startf('lnd2atm') call lnd2atm(bounds_proc, & atm2lnd_vars, surfalb_vars, temperature_vars, frictionvel_vars, & @@ -1340,8 +1311,7 @@ subroutine clm_drv(doalb, nextsw_cday, declinp1, declin, rstwr, nlend, rdate) soilstate_vars, solarabs_vars, surfalb_vars, temperature_vars, & waterflux_vars, waterstate_vars, & phosphorusstate_vars,phosphorusflux_vars, & - betrtracer_vars, tracerstate_vars, tracerflux_vars, & - tracercoeff_vars, alm_fates, rdate=rdate ) + ep_betr, alm_fates, rdate=rdate ) call t_stopf('clm_drv_io_wrest') end if diff --git a/components/clm/src/main/clm_initializeMod.F90 b/components/clm/src/main/clm_initializeMod.F90 index 8524a45f3f9a..526d4a7383e7 100644 --- a/components/clm/src/main/clm_initializeMod.F90 +++ b/components/clm/src/main/clm_initializeMod.F90 @@ -18,6 +18,7 @@ module clm_initializeMod use readParamsMod , only : readSharedParameters, readPrivateParameters use ncdio_pio , only : file_desc_t use FatesInterfaceMod, only : set_fates_global_elements + use BeTRSimulationALM, only : create_betr_simulation_alm ! !----------------------------------------- ! Definition of component types @@ -356,7 +357,7 @@ subroutine initialize2( ) use shr_orb_mod , only : shr_orb_decl use shr_scam_mod , only : shr_scam_getCloseLatLon use seq_drydep_mod , only : n_drydep, drydep_method, DD_XLND - use clm_varpar , only : nlevsno, numpft, crop_prog, nlevsoi + use clm_varpar , only : nlevsno, numpft, crop_prog, nlevsoi,max_patch_per_col use clm_varcon , only : h2osno_max, bdsno, spval use landunit_varcon , only : istice, istice_mec, istsoil use clm_varctl , only : finidat, finidat_interp_source, finidat_interp_dest, fsurdat @@ -382,7 +383,6 @@ subroutine initialize2( ) use accumulMod , only : print_accum_fields use ndepStreamMod , only : ndep_init, ndep_interp use CNEcosystemDynMod , only : CNEcosystemDynInit - use CNEcosystemDynBetrMod , only : CNEcosystemDynBetrInit use pdepStreamMod , only : pdep_init, pdep_interp use CNDecompCascadeBGCMod , only : init_decompcascade_bgc use CNDecompCascadeCNMod , only : init_decompcascade_cn @@ -399,11 +399,9 @@ subroutine initialize2( ) use SoilWaterRetentionCurveFactoryMod , only : create_soil_water_retention_curve use clm_varctl , only : use_bgc_interface, use_pflotran use clm_pflotran_interfaceMod , only : clm_pf_interface_init !!, clm_pf_set_restart_stamp - use betr_initializeMod , only : betr_initialize - use betr_initializeMod , only : betrtracer_vars, tracerstate_vars, tracerflux_vars, tracercoeff_vars - use betr_initializeMod , only : bgc_reaction use tracer_varcon , only : is_active_betr_bgc use clm_time_manager , only : is_restart + use ALMbetrNLMod , only : betr_namelist_buffer ! ! !ARGUMENTS implicit none @@ -534,8 +532,12 @@ subroutine initialize2( ) call clm_inst_biogeophys(bounds_proc) if(use_betr)then - !state variables will be initialized inside betr_initialize - call betr_initialize(bounds_proc, 1, nlevsoi, waterstate_vars) + !allocate memory for betr simulator + allocate(ep_betr, source=create_betr_simulation_alm()) + !set internal filters for betr + call ep_betr%BeTRSetFilter(maxpft_per_col=max_patch_per_col, boffline=.false.) + call ep_betr%InitOnline(bounds_proc, lun_pp, col_pp, veg_pp, waterstate_vars, betr_namelist_buffer, masterproc) + is_active_betr_bgc = ep_betr%do_soibgc() endif call SnowOptics_init( ) ! SNICAR optical parameters: @@ -610,11 +612,7 @@ subroutine initialize2( ) ! ------------------------------------------------------------------------ if (use_cn) then - if(is_active_betr_bgc)then - call CNEcosystemDynBetrInit(bounds_proc) - else - call CNEcosystemDynInit(bounds_proc) - endif + call CNEcosystemDynInit(bounds_proc) else call SatellitePhenologyInit(bounds_proc) end if @@ -666,7 +664,7 @@ subroutine initialize2( ) soilstate_vars, solarabs_vars, surfalb_vars, temperature_vars, & waterflux_vars, waterstate_vars, & phosphorusstate_vars,phosphorusflux_vars, & - betrtracer_vars, tracerstate_vars, tracerflux_vars, tracercoeff_vars, & + ep_betr, & alm_fates) end if @@ -682,15 +680,11 @@ subroutine initialize2( ) soilstate_vars, solarabs_vars, surfalb_vars, temperature_vars, & waterflux_vars, waterstate_vars, & phosphorusstate_vars,phosphorusflux_vars, & - betrtracer_vars, tracerstate_vars, tracerflux_vars, tracercoeff_vars, & + ep_betr, & alm_fates) end if - if (use_betr)then - call bgc_reaction%init_betr_alm_bgc_coupler(bounds_proc, & - carbonstate_vars, nitrogenstate_vars, betrtracer_vars, tracerstate_vars) - endif ! ------------------------------------------------------------------------ ! Initialize filters and weights ! ------------------------------------------------------------------------ @@ -718,7 +712,9 @@ subroutine initialize2( ) glc2lnd_vars%icemask_grc(bounds_clump%begg:bounds_clump%endg)) end do !$OMP END PARALLEL DO - + if(use_betr)then + call ep_betr%set_active(bounds_proc, col_pp) + endif ! Create new template file using cold start call restFile_write(bounds_proc, finidat_interp_dest, & atm2lnd_vars, aerosol_vars, canopystate_vars, cnstate_vars, & @@ -728,7 +724,7 @@ subroutine initialize2( ) soilstate_vars, solarabs_vars, surfalb_vars, temperature_vars, & waterflux_vars, waterstate_vars, & phosphorusstate_vars,phosphorusflux_vars, & - betrtracer_vars, tracerstate_vars, tracerflux_vars, tracercoeff_vars, & + ep_betr, & alm_fates) ! Interpolate finidat onto new template file @@ -744,7 +740,7 @@ subroutine initialize2( ) soilstate_vars, solarabs_vars, surfalb_vars, temperature_vars, & waterflux_vars, waterstate_vars, & phosphorusstate_vars,phosphorusflux_vars, & - betrtracer_vars, tracerstate_vars, tracerflux_vars, tracercoeff_vars, & + ep_betr, & alm_fates) ! Reset finidat to now be finidat_interp_dest @@ -761,6 +757,9 @@ subroutine initialize2( ) end do !$OMP END PARALLEL DO + if(use_betr)then + call ep_betr%set_active(bounds_proc, col_pp) + endif ! ------------------------------------------------------------------------ ! Initialize nitrogen deposition ! ------------------------------------------------------------------------ diff --git a/components/clm/src/main/clm_instMod.F90 b/components/clm/src/main/clm_instMod.F90 index 748659b7fa9d..f7fb9efc07d3 100644 --- a/components/clm/src/main/clm_instMod.F90 +++ b/components/clm/src/main/clm_instMod.F90 @@ -5,7 +5,7 @@ module clm_instMod use shr_kind_mod , only : r8 => shr_kind_r8 use shr_log_mod , only : errMsg => shr_log_errMsg use decompMod , only : bounds_type, get_proc_bounds - use clm_varctl , only : use_cn, use_voc, use_c13, use_c14, use_ed + use clm_varctl , only : use_cn, use_voc, use_c13, use_c14, use_ed, use_betr !----------------------------------------- ! Definition of component types !----------------------------------------- @@ -57,7 +57,8 @@ module clm_instMod use clm_bgc_interface_data , only : clm_bgc_interface_data_type use ChemStateType , only : chemstate_type ! structure for chemical indices of the soil, such as pH and Eh - + use BeTRSimulationALM , only : betr_simulation_alm_type + use PlantMicKineticsMod , only : PlantMicKinetics_type use CLMFatesInterfaceMod , only : hlm_fates_interface_type @@ -112,7 +113,8 @@ module clm_instMod type(clm_bgc_interface_data_type) :: clm_bgc_data type(chemstate_type) :: chemstate_vars type(hlm_fates_interface_type) :: alm_fates - + class(betr_simulation_alm_type), pointer :: ep_betr + type(PlantMicKinetics_type) :: PlantMicKinetics_vars public :: clm_inst_biogeochem public :: clm_inst_biogeophys public :: alm_fates @@ -203,6 +205,9 @@ subroutine clm_inst_biogeochem(bounds_proc) call crop_vars%Init(bounds_proc) + if(use_betr)then + call PlantMicKinetics_vars%Init(bounds_proc) + endif end if ! Initialize the Functionaly Assembled Terrestrial Ecosystem Simulator (FATES) diff --git a/components/clm/src/main/controlMod.F90 b/components/clm/src/main/controlMod.F90 index 2be60e52f201..fb002e6555e4 100644 --- a/components/clm/src/main/controlMod.F90 +++ b/components/clm/src/main/controlMod.F90 @@ -109,7 +109,7 @@ subroutine control_init( ) use fileutils , only : getavu, relavu use shr_string_mod , only : shr_string_getParentDir use clm_pflotran_interfaceMod , only : clm_pf_readnl - use betr_initializeMod , only : betr_readNL + use ALMBeTRNLMod , only : betr_readNL ! implicit none ! @@ -441,7 +441,7 @@ subroutine control_init( ) end if if (use_betr) then - call betr_readNL( NLFilename ) + call betr_readNL( NLFilename, use_c13, use_c14) endif ! ---------------------------------------------------------------------- @@ -804,7 +804,7 @@ subroutine control_print () write(iulog,*) ' use_vancouver = ', use_vancouver write(iulog,*) ' use_mexicocity = ', use_mexicocity write(iulog,*) ' use_noio = ', use_noio - + write(iulog,*) ' use_betr = ', use_betr write(iulog,*) 'input data files:' write(iulog,*) ' PFT physiology and parameters file = ',trim(paramfile) write(iulog,*) ' Soil order dependent parameters file = ',trim(fsoilordercon) diff --git a/components/clm/src/main/lnd2atmType.F90 b/components/clm/src/main/lnd2atmType.F90 index 32e0a22b5b09..f030efce6181 100644 --- a/components/clm/src/main/lnd2atmType.F90 +++ b/components/clm/src/main/lnd2atmType.F90 @@ -58,6 +58,10 @@ module lnd2atmType real(r8), pointer :: qflx_rofliq_qgwl_grc (:) => null() ! rof liq -- glacier, wetland and lakes water balance residual component real(r8), pointer :: qflx_rofice_grc (:) => null() ! rof ice forcing + real(r8), pointer :: qflx_rofliq_qsur_doc_grc(:) => null() + real(r8), pointer :: qflx_rofliq_qsur_dic_grc(:) => null() + real(r8), pointer :: qflx_rofliq_qsub_doc_grc(:) => null() + real(r8), pointer :: qflx_rofliq_qsub_dic_grc(:) => null() contains procedure, public :: Init @@ -126,6 +130,11 @@ subroutine InitAllocate(this, bounds) allocate(this%qflx_rofliq_qgwl_grc (begg:endg)) ; this%qflx_rofliq_qgwl_grc (:) =ival allocate(this%qflx_rofice_grc (begg:endg)) ; this%qflx_rofice_grc (:) =ival + allocate(this%qflx_rofliq_qsur_doc_grc(begg:endg)) ; this%qflx_rofliq_qsur_doc_grc(:) = ival + allocate(this%qflx_rofliq_qsur_dic_grc(begg:endg)) ; this%qflx_rofliq_qsur_dic_grc(:) = ival + allocate(this%qflx_rofliq_qsub_doc_grc(begg:endg)) ; this%qflx_rofliq_qsub_doc_grc(:) = ival + allocate(this%qflx_rofliq_qsub_dic_grc(begg:endg)) ; this%qflx_rofliq_qsub_dic_grc(:) = ival + if (shr_megan_mechcomps_n>0) then allocate(this%flxvoc_grc(begg:endg,1:shr_megan_mechcomps_n)); this%flxvoc_grc(:,:)=ival endif diff --git a/components/clm/src/main/readParamsMod.F90 b/components/clm/src/main/readParamsMod.F90 index 8f62c5a29393..ef4bbad0ab83 100644 --- a/components/clm/src/main/readParamsMod.F90 +++ b/components/clm/src/main/readParamsMod.F90 @@ -76,15 +76,16 @@ end subroutine CNParamsSharedReadFile subroutine readPrivateParameters ! read CN and BGC shared parameters ! - use CNAllocationBetrMod , only : readCNAllocBetrParams use CNAllocationMod , only : readCNAllocParams use CNDecompMod , only : readCNDecompParams use CNDecompCascadeBGCMod , only : readCNDecompBgcParams use CNDecompCascadeCNMod , only : readCNDecompCnParams use CNPhenologyMod , only : readCNPhenolParams + use CNPhenologyBeTRMod , only : readCNPhenolBeTRParams use CNMRespMod , only : readCNMRespParams use CNNDynamicsMod , only : readCNNDynamicsParams use CNGapMortalityMod , only : readCNGapMortParams + use CNGapMortalityBeTRMod , only : readCNGapMortBeTRParams use CNNitrifDenitrifMod , only : readCNNitrifDenitrifParams use CNSoilLittVertTranspMod , only : readCNSoilLittVertTranspParams use ch4Mod , only : readCH4Params @@ -94,7 +95,6 @@ subroutine readPrivateParameters use ncdio_pio , only : ncd_pio_closefile, ncd_pio_openfile, & file_desc_t, ncd_inqdid, ncd_inqdlen use tracer_varcon , only : is_active_betr_bgc - use betr_initializeMod , only : bgc_reaction, betrtracer_vars use CLMFatesParamInterfaceMod, only : FatesReadParameters ! @@ -120,44 +120,50 @@ subroutine readPrivateParameters call ncd_inqdlen(ncid,dimid,npft) if(use_betr)then - call bgc_reaction%readParams(ncid, betrtracer_vars) + ! the following will be replaced with something more general. Jinyun Tang + ! call bgc_reaction%readParams(ncid, betrtracer_vars) endif ! ! populate each module with private parameters ! - if (use_cn .and. is_active_betr_bgc) then - call readCNAllocBetrParams(ncid) - end if - if ( (use_cn .or. use_ed) .and. .not.is_active_betr_bgc ) then + if ( (use_cn .or. use_ed) ) then call readCNAllocParams(ncid) - call readCNDecompParams(ncid) - if (use_century_decomp) then - call readCNDecompBgcParams(ncid) - else - call readCNDecompCnParams(ncid) - end if + if(.not. is_active_betr_bgc) then + call readCNDecompParams(ncid) + if (use_century_decomp) then + call readCNDecompBgcParams(ncid) + else + call readCNDecompCnParams(ncid) + end if - if (use_nitrif_denitrif) then - call readCNNitrifDenitrifParams(ncid) - end if + if (use_nitrif_denitrif) then + call readCNNitrifDenitrifParams(ncid) + end if - call readCNSoilLittVertTranspParams(ncid) + call readCNSoilLittVertTranspParams(ncid) - if (use_lch4) then - call readCH4Params (ncid) - end if + if (use_lch4) then + call readCH4Params (ncid) + end if + endif end if - - if (use_cn) then - call readCNPhenolParams(ncid) + if(is_active_betr_bgc)then + call readCNPhenolBeTRParams(ncid) + else + call readCNPhenolParams(ncid) + endif call readCNMRespParams (ncid) call readCNNDynamicsParams (ncid) - call readCNGapMortParams (ncid) + if(is_active_betr_bgc)then + call readCNGapMortBeTRParams (ncid) + else + call readCNGapMortParams (ncid) + endif end if ! diff --git a/components/clm/src/main/restFileMod.F90 b/components/clm/src/main/restFileMod.F90 index bcf53cebf574..c72e2000ee98 100644 --- a/components/clm/src/main/restFileMod.F90 +++ b/components/clm/src/main/restFileMod.F90 @@ -56,6 +56,7 @@ module restFileMod use ncdio_pio , only : file_desc_t, ncd_pio_createfile, ncd_pio_openfile, ncd_global use ncdio_pio , only : ncd_pio_closefile, ncd_defdim, ncd_putatt, ncd_enddef, check_dim use ncdio_pio , only : check_att, ncd_getatt + use BeTRSimulationALM , only : betr_simulation_alm_type ! ! !PUBLIC TYPES: implicit none @@ -99,7 +100,7 @@ subroutine restFile_write( bounds, file, soilstate_vars, solarabs_vars, surfalb_vars, temperature_vars, & waterflux_vars, waterstate_vars, & phosphorusstate_vars, phosphorusflux_vars, & - betrtracer_vars, tracerstate_vars, tracerflux_vars, tracercoeff_vars, & + ep_betr, & alm_fates, & rdate, noptr) ! @@ -134,10 +135,7 @@ subroutine restFile_write( bounds, file, type(waterflux_type) , intent(in) :: waterflux_vars type(phosphorusstate_type) , intent(inout) :: phosphorusstate_vars type(phosphorusflux_type) , intent(in) :: phosphorusflux_vars - type(tracerstate_type) , intent(inout) :: tracerstate_vars ! due to Betrrest call - type(BeTRTracer_Type) , intent(in) :: betrtracer_vars - type(tracerflux_type) , intent(inout) :: tracerflux_vars - type(tracercoeff_type) , intent(inout) :: tracercoeff_vars + class(betr_simulation_alm_type), intent(inout):: ep_betr type(hlm_fates_interface_type) , intent(inout) :: alm_fates character(len=*) , intent(in), optional :: rdate ! restart file time stamp for name logical , intent(in), optional :: noptr ! if should NOT write to the restart pointer file @@ -261,9 +259,7 @@ subroutine restFile_write( bounds, file, end if if (use_betr) then - call tracerstate_vars%Restart(bounds, ncid, flag='define', betrtracer_vars=betrtracer_vars) - call tracerflux_vars%Restart( bounds, ncid, flag='define', betrtracer_vars=betrtracer_vars) - call tracercoeff_vars%Restart(bounds, ncid, flag='define', betrtracer_vars=betrtracer_vars) + call ep_betr%BeTRRestart(bounds, ncid, flag='define') endif if (present(rdate)) then @@ -372,9 +368,7 @@ subroutine restFile_write( bounds, file, end if if (use_betr) then - call tracerstate_vars%Restart(bounds, ncid, flag='write', betrtracer_vars=betrtracer_vars) - call tracerflux_vars%Restart( bounds, ncid, flag='write', betrtracer_vars=betrtracer_vars) - call tracercoeff_vars%Restart(bounds, ncid, flag='write', betrtracer_vars=betrtracer_vars) + call ep_betr%BeTRRestart(bounds, ncid, flag='write') endif call hist_restart_ncd (bounds, ncid, flag='write' ) @@ -408,7 +402,7 @@ subroutine restFile_read( bounds, file, soilstate_vars, solarabs_vars, surfalb_vars, temperature_vars, & waterflux_vars, waterstate_vars, & phosphorusstate_vars,phosphorusflux_vars, & - betrtracer_vars, tracerstate_vars, tracerflux_vars, tracercoeff_vars, & + ep_betr, & alm_fates) ! ! !DESCRIPTION: @@ -447,10 +441,7 @@ subroutine restFile_read( bounds, file, type(waterflux_type) , intent(inout) :: waterflux_vars type(phosphorusstate_type) , intent(inout) :: phosphorusstate_vars type(phosphorusflux_type) , intent(inout) :: phosphorusflux_vars - type(tracerstate_type) , intent(inout) :: tracerstate_vars ! due to Betrrest call - type(BeTRTracer_Type) , intent(in) :: betrtracer_vars - type(tracerflux_type) , intent(inout) :: tracerflux_vars - type(tracercoeff_type) , intent(inout) :: tracercoeff_vars + class(betr_simulation_alm_type), intent(inout) :: ep_betr type(hlm_fates_interface_type) , intent(inout) :: alm_fates ! ! !LOCAL VARIABLES: @@ -560,9 +551,7 @@ subroutine restFile_read( bounds, file, end if if (use_betr) then - call tracerstate_vars%Restart(bounds, ncid, flag='read',betrtracer_vars=betrtracer_vars) - call tracerflux_vars%Restart( bounds, ncid, flag='read',betrtracer_vars=betrtracer_vars) - call tracercoeff_vars%Restart(bounds, ncid, flag='read', betrtracer_vars=betrtracer_vars) + call ep_betr%BeTRRestart(bounds, ncid, flag='read') endif call hist_restart_ncd (bounds, ncid, flag='read') From 4317c7e53a48150a499d50179ce4403f349425e3 Mon Sep 17 00:00:00 2001 From: Jinyun Tang Date: Tue, 18 Jul 2017 12:28:11 -0700 Subject: [PATCH 17/68] remove unused annotations This removed unused comments. No answer change is involved. --- components/clm/src/biogeochem/CNAllocationBetrMod.F90 | 7 ------- 1 file changed, 7 deletions(-) diff --git a/components/clm/src/biogeochem/CNAllocationBetrMod.F90 b/components/clm/src/biogeochem/CNAllocationBetrMod.F90 index 7a78988de8f7..6147c22870b1 100644 --- a/components/clm/src/biogeochem/CNAllocationBetrMod.F90 +++ b/components/clm/src/biogeochem/CNAllocationBetrMod.F90 @@ -58,11 +58,9 @@ module CNAllocationBeTRMod character(len=*), parameter, public :: suplnAll='ALL' ! Supplemental Nitrogen for all PFT's character(len=*), parameter, public :: suplnNon='NONE' ! No supplemental Nitrogen character(len=15), public :: suplnitro = suplnNon ! Supplemental Nitrogen mode - !! add phosphorus - X. YANG character(len=*), parameter, public :: suplpAll='ALL' ! Supplemental Phosphorus for all PFT's character(len=*), parameter, public :: suplpNon='NONE' ! No supplemental Phosphorus character(len=15), public :: suplphos = suplpAll ! Supplemental Phosphorus mode - !! add competition, - Q. Zhu logical, public :: nu_com_leaf_physiology = .false. logical, public :: nu_com_root_kinetics = .false. logical, public :: nu_com_phosphatase = .false. @@ -269,7 +267,6 @@ subroutine CNAllocation1_PlantNPDemand (bounds, num_soilc, filter_soilc, num_soi type(carbonflux_type) , intent(inout) :: c14_carbonflux_vars type(nitrogenstate_type) , intent(inout) :: nitrogenstate_vars type(nitrogenflux_type) , intent(inout) :: nitrogenflux_vars -! !! add phosphorus -X.YANG type(phosphorusstate_type) , intent(inout) :: phosphorusstate_vars type(phosphorusflux_type) , intent(inout) :: phosphorusflux_vars ! @@ -514,7 +511,6 @@ subroutine CNAllocation1_PlantNPDemand (bounds, num_soilc, filter_soilc, num_soi potential_immob_vr => nitrogenflux_vars%potential_immob_vr_col , & ! Output: [real(r8) (:,:) ] actual_immob_vr => nitrogenflux_vars%actual_immob_vr_col , & ! Output: [real(r8) (:,:) ] - !!! add phosphorus variables - X. YANG sminp_vr => phosphorusstate_vars%sminp_vr_col , & ! Input: [real(r8) (:,:) ] (gP/m3) soil mineral P solutionp_vr => phosphorusstate_vars%solutionp_vr_col , & ! Input: [real(r8) (:,:) ] (gP/m3) soil mineral P retransp => phosphorusstate_vars%retransp_patch , & ! Input: [real(r8) (:) ] (gP/m2) plant pool of retranslocated P @@ -852,7 +848,6 @@ subroutine CNAllocation1_PlantNPDemand (bounds, num_soilc, filter_soilc, num_soi ! based on available C, use constant allometric relationships to ! determine N requirements - ! determine P requirements -X. YANG if (woody(ivt(p)) == 1.0_r8) then c_allometry(p) = (1._r8+g1)*(1._r8+f1+f3*(1._r8+f2)) @@ -1132,7 +1127,6 @@ subroutine CNAllocation3_PlantCNPAlloc (bounds , & type(carbonflux_type) , intent(inout) :: c14_carbonflux_vars type(nitrogenstate_type) , intent(inout) :: nitrogenstate_vars type(nitrogenflux_type) , intent(inout) :: nitrogenflux_vars -! !! add phosphorus -X.YANG type(phosphorusstate_type) , intent(inout) :: phosphorusstate_vars type(phosphorusflux_type) , intent(inout) :: phosphorusflux_vars ! @@ -1249,7 +1243,6 @@ subroutine CNAllocation3_PlantCNPAlloc (bounds , & npool_to_deadcrootn => nitrogenflux_vars%npool_to_deadcrootn_patch , & ! Output: [real(r8) (:) ] npool_to_deadcrootn_storage => nitrogenflux_vars%npool_to_deadcrootn_storage_patch , & ! Output: [real(r8) (:) ] - !!! add phosphorus variables - X. YANG plant_pdemand => phosphorusflux_vars%plant_pdemand_patch , & ! Output: [real(r8) (:) ] P flux required to support initial GPP (gP/m2/s) plant_palloc => phosphorusflux_vars%plant_palloc_patch , & ! Output: [real(r8) (:) ] total allocated P flux (gP/m2/s) ppool_to_grainp => phosphorusflux_vars%ppool_to_grainp_patch , & ! Output: [real(r8) (:) ] allocation to grain P (gP/m2/s) From 9d2765c287350da7091bea08b4daf256e60d76b1 Mon Sep 17 00:00:00 2001 From: Jon Wolfe Date: Wed, 19 Jul 2017 08:16:13 -0700 Subject: [PATCH 18/68] Fix CPL_ALBAV setting for DATM/MPASO configurations. --- cime/src/drivers/mct/cime_config/config_component_acme.xml | 1 - 1 file changed, 1 deletion(-) diff --git a/cime/src/drivers/mct/cime_config/config_component_acme.xml b/cime/src/drivers/mct/cime_config/config_component_acme.xml index 0198b7eecb1c..82865f1717ad 100644 --- a/cime/src/drivers/mct/cime_config/config_component_acme.xml +++ b/cime/src/drivers/mct/cime_config/config_component_acme.xml @@ -452,7 +452,6 @@ FALSE TRUE - TRUE TRUE run_component_cpl From dcd6898012b61113c0e3f8586d8983114079fc0b Mon Sep 17 00:00:00 2001 From: Azamat Mametjanov Date: Thu, 20 Jul 2017 15:36:59 -0500 Subject: [PATCH 19/68] Bebop building and batching updates --- cime/config/acme/machines/config_batch.xml | 8 ++++ .../config/acme/machines/config_compilers.xml | 14 +++++++ cime/config/acme/machines/config_machines.xml | 37 ++++++++++++------- 3 files changed, 45 insertions(+), 14 deletions(-) diff --git a/cime/config/acme/machines/config_batch.xml b/cime/config/acme/machines/config_batch.xml index 4b74bf9cc6bd..43058ba91f2b 100644 --- a/cime/config/acme/machines/config_batch.xml +++ b/cime/config/acme/machines/config_batch.xml @@ -199,6 +199,14 @@ + + + debug + bdw + knl + + + diff --git a/cime/config/acme/machines/config_compilers.xml b/cime/config/acme/machines/config_compilers.xml index 66f75ef318b5..c5042df6e505 100644 --- a/cime/config/acme/machines/config_compilers.xml +++ b/cime/config/acme/machines/config_compilers.xml @@ -1178,6 +1178,20 @@ for mct, etc. gpfs + + -O2 -qno-opt-dynamic-align + -O2 + -qopenmp + -qopenmp + -qopenmp + -qopenmp + $(shell $(NETCDF_PATH)/bin/nf-config --flibs) -mkl + -DHAVE_SLASHPROC + mpiifort + mpiicc + mpiicpc + + -O2 -O2 diff --git a/cime/config/acme/machines/config_machines.xml b/cime/config/acme/machines/config_machines.xml index 8d49cc9727be..75a04e36c4a5 100644 --- a/cime/config/acme/machines/config_machines.xml +++ b/cime/config/acme/machines/config_machines.xml @@ -1032,17 +1032,17 @@ bebop acme_developer intel,gnu - mpt - $ENV{HOME}/acme_scratch/bebop + impi,mpich,mvapich,openmpi,mpi-serial + /lcrc/group/acme/$USER/acme_scratch/bebop $CIME_OUTPUT_ROOT/$CASE/run $CIME_OUTPUT_ROOT/$CASE/bld /home/ccsm-data/inputdata /home/ccsm-data/inputdata/atm/datm7 $CIME_OUTPUT_ROOT/archive/$CASE csm/$CASE - /lcrc/group/earthscience/acme_baselines + /lcrc/group/acme/acme_baselines /home/ccsm-data/tools/cprnc - CNL + LINUX slurm acme 8 @@ -1052,19 +1052,17 @@ TRUE -D PIO_BUILD_TIMING:BOOL=ON - srun + mpirun - --label -n $TOTALPES - module - module + module -q + module -q + module -q - intel - gcc - cmake + intel/17.0.4-74uvhji @@ -1073,17 +1071,28 @@ gcc/7.1.0-4bgguyp + + intel-mpi/2017.3-dfphq6k + - cmake/2.8.12.2-qndad62 - mpich/3.2-5koqqym - netcdf/4.4.1.1-prsuusl + cmake + netcdf/4.4.1.1-prsuusl + netcdf-fortran/4.4.4-ojwazvy + parallel-netcdf/1.8.1 + + $SHELL{which nf-config | xargs dirname | xargs dirname} + $SHELL{which pnetcdf_version | xargs dirname | xargs dirname} + 128M spread threads + + shm:tmi + From c67dc45a92225c2d314a4972f467b5278d4924f6 Mon Sep 17 00:00:00 2001 From: Jinyun Tang Date: Sat, 22 Jul 2017 10:31:30 -0700 Subject: [PATCH 20/68] bug fix to N mass budget The nitrogen buffer pool was added to back to make sure the test SMS_Ly2_P1x1.1x1_smallvilleIA.ICLM45CNCROP is bfb. The test was run on cori haswell --- .../src/biogeochem/CNNitrogenStateType.F90 | 39 +++++-------------- 1 file changed, 9 insertions(+), 30 deletions(-) diff --git a/components/clm/src/biogeochem/CNNitrogenStateType.F90 b/components/clm/src/biogeochem/CNNitrogenStateType.F90 index 68696e980554..b1ef450047b2 100644 --- a/components/clm/src/biogeochem/CNNitrogenStateType.F90 +++ b/components/clm/src/biogeochem/CNNitrogenStateType.F90 @@ -189,7 +189,6 @@ module CNNitrogenStateType procedure , public :: SetValues procedure , public :: ZeroDWT procedure , public :: Summary - procedure , public :: nbuffer_update procedure , private :: InitAllocate procedure , private :: InitHistory procedure , private :: InitCold @@ -838,12 +837,12 @@ subroutine InitCold(this, bounds, & this%storvegn_patch(p) = 0._r8 this%totvegn_patch(p) = 0._r8 this%totpftn_patch(p) = 0._r8 + this%plant_n_buffer_patch(p) = 1._r8 end if this%npimbalance_patch(p) = 0.0_r8 this%pnup_pfrootc_patch(p) = 0.0_r8 this%benefit_pgpp_pleafc_patch(p) = 0.0_r8 - this%plant_n_buffer_patch(p)= 0.01_r8 end do !------------------------------------------- @@ -1568,6 +1567,10 @@ subroutine Summary(this, bounds, num_soilc, filter_soilc, num_soilp, filter_soil end do + call p2c(bounds, num_soilc, filter_soilc, & + this%plant_n_buffer_patch(bounds%begp:bounds%endp), & + this%plant_n_buffer_col(bounds%begc:bounds%endc)) + call p2c(bounds, num_soilc, filter_soilc, & this%totvegn_patch(bounds%begp:bounds%endp), & this%totvegn_col(bounds%begc:bounds%endc)) @@ -1791,13 +1794,15 @@ subroutine Summary(this, bounds, num_soilc, filter_soilc, num_soilp, filter_soil this%sminn_col(c) + & this%totprodn_col(c) + & this%seedn_col(c) + & - this%ntrunc_col(c) + this%ntrunc_col(c)+ & + this%plant_n_buffer_col(c) this%totabgn_col (c) = & this%totpftn_col(c) + & this%totprodn_col(c) + & this%seedn_col(c) + & - this%ntrunc_col(c) + this%ntrunc_col(c)+ & + this%plant_n_buffer_col(c) this%totblgn_col(c) = & this%cwdn_col(c) + & @@ -1809,32 +1814,6 @@ subroutine Summary(this, bounds, num_soilc, filter_soilc, num_soilp, filter_soil end subroutine Summary - !----------------------------------------------------------------------- - subroutine nbuffer_update(this, bounds, num_soilp, filter_soilp, & - plant_minn_active_yield_flx_patch, plant_minn_passive_yield_flx_patch) - - use clm_time_manager , only : get_step_size - ! !ARGUMENTS: - class (nitrogenstate_type) :: this - type(bounds_type) , intent(in) :: bounds - integer , intent(in) :: num_soilp ! number of soil columns in filter - integer , intent(in) :: filter_soilp(:) ! filter for soil columns - - real(r8) , intent(in) :: plant_minn_active_yield_flx_patch(bounds%begp:bounds%endp) - real(r8) , intent(in) :: plant_minn_passive_yield_flx_patch(bounds%begp:bounds%endp) - integer :: fp, p - real(r8) :: dtime - - dtime = get_step_size() - - - do fp = 1, num_soilp - p = filter_soilp(fp) - this%plant_n_buffer_patch(p) = this%plant_n_buffer_patch(p) + & - (plant_minn_active_yield_flx_patch(p) + & - plant_minn_passive_yield_flx_patch(p))*dtime - enddo - end subroutine nbuffer_update end module CNNitrogenStateType From f6afef0ef9b3025078b9e1ebe2988ad3b20b35e4 Mon Sep 17 00:00:00 2001 From: Jinyun Tang Date: Mon, 24 Jul 2017 09:23:07 -0700 Subject: [PATCH 21/68] simplify the col pft lun interface in betr Now "use columntype" and alike in the betr interface is called before the subrotuines are defined. This will allow using macros to ensure compatibility with the standalone use. No answer change is involved with alm. --- components/clm/src/external_models/sbetr | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/components/clm/src/external_models/sbetr b/components/clm/src/external_models/sbetr index 606d50bed837..0dcedd060f0e 160000 --- a/components/clm/src/external_models/sbetr +++ b/components/clm/src/external_models/sbetr @@ -1 +1 @@ -Subproject commit 606d50bed8378054d3000e31daadbf84ab479472 +Subproject commit 0dcedd060f0ed3b8d0df6fc18de1b756e8bdff6e From e9417a47a9d64d6ee0718e67297071acf2d0c401 Mon Sep 17 00:00:00 2001 From: Azamat Mametjanov Date: Mon, 24 Jul 2017 11:56:30 -0500 Subject: [PATCH 22/68] Distinguish bebop node names in acme_dev tests --- cime/config/acme/machines/config_machines.xml | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/cime/config/acme/machines/config_machines.xml b/cime/config/acme/machines/config_machines.xml index 75a04e36c4a5..795b58535c45 100644 --- a/cime/config/acme/machines/config_machines.xml +++ b/cime/config/acme/machines/config_machines.xml @@ -849,7 +849,7 @@ ANL/LCRC Linux Cluster - b.*.lcrc.anl.gov + blogin.*.lcrc.anl.gov acme_integration gnu,pgi,intel,nag mvapich,mpich,openmpi,mpi-serial @@ -924,7 +924,7 @@ ANL/LCRC Linux Cluster - b.*.lcrc.anl.gov + blogin.*.lcrc.anl.gov acme_integration intel,gnu,pgi mvapich,openmpi,mpi-serial @@ -1029,7 +1029,7 @@ ANL/LCRC Cluster, Cray CS400, 352-nodes Xeon Phi 7230 KNLs 64C/1.3GHz + 672-nodes Xeon E5-2695v4 Broadwells 36C/2.10GHz, Intel Omni-Path network, SLURM batch system, Lmod module environment. - bebop + beboplogin.* acme_developer intel,gnu impi,mpich,mvapich,openmpi,mpi-serial From 7eaf83bccf51552783bdf92af3a39e7135e7685b Mon Sep 17 00:00:00 2001 From: Azamat Mametjanov Date: Mon, 24 Jul 2017 14:39:30 -0500 Subject: [PATCH 23/68] HOMME CMake file and static cprnc --- cime/config/acme/machines/config_machines.xml | 2 +- .../homme/cmake/machineFiles/bebop.cmake | 23 +++++++++++++++++++ 2 files changed, 24 insertions(+), 1 deletion(-) create mode 100644 components/homme/cmake/machineFiles/bebop.cmake diff --git a/cime/config/acme/machines/config_machines.xml b/cime/config/acme/machines/config_machines.xml index 795b58535c45..974abe0e2470 100644 --- a/cime/config/acme/machines/config_machines.xml +++ b/cime/config/acme/machines/config_machines.xml @@ -1041,7 +1041,7 @@ $CIME_OUTPUT_ROOT/archive/$CASE csm/$CASE /lcrc/group/acme/acme_baselines - /home/ccsm-data/tools/cprnc + /lcrc/group/acme/tools/cprnc/cprnc LINUX slurm acme diff --git a/components/homme/cmake/machineFiles/bebop.cmake b/components/homme/cmake/machineFiles/bebop.cmake new file mode 100644 index 000000000000..4c2f960d0bf4 --- /dev/null +++ b/components/homme/cmake/machineFiles/bebop.cmake @@ -0,0 +1,23 @@ + +SET (CMAKE_Fortran_COMPILER mpiifort CACHE FILEPATH "") +SET (CMAKE_C_COMPILER mpiicc CACHE FILEPATH "") +SET (CMAKE_CXX_COMPILER mpiicpc CACHE FILEPATH "") + +SET (NETCDF_DIR $ENV{NETCDF_PATH} CACHE FILEPATH "") +SET (PNETCDF_DIR $ENV{PNETCDF_PATH} CACHE FILEPATH "") +EXECUTE_PROCESS(COMMAND ${NETCDF_DIR}/bin/nf-config --flibs + RESULT_VARIABLE NFCONFIG_RESULT + OUTPUT_VARIABLE NFCONFIG_OUTPUT + ERROR_VARIABLE NFCONFIG_ERROR + OUTPUT_STRIP_TRAILING_WHITESPACE +) +IF (${NFCONFIG_ERROR}) + MESSAGE(WARNING "${NETCDF_DIR}/bin/nf-config --flibs produced an error. Default linking will be used.") +ELSE () + SET (ADD_LINKER_FLAGS " ${NFCONFIG_OUTPUT} " CACHE STRING "") +ENDIF () + +SET (HOMME_USE_MKL "TRUE" CACHE FILEPATH "") # for Intel +SET (USE_QUEUING FALSE CACHE BOOL "") +SET (CPRNC_DIR /lcrc/group/acme/tools/cprnc CACHE FILEPATH "") + From 1845a387158a3eb8a2d005deb8cda6bf2395ce9b Mon Sep 17 00:00:00 2001 From: Jinyun Tang Date: Tue, 25 Jul 2017 11:57:45 -0700 Subject: [PATCH 24/68] change array declaration in base bgcreactiontype of betr This is a fix to enable the building with the ibm compiler. No change of ALM is involved, so no answer change is expected. BFB. --- components/clm/src/external_models/sbetr | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/components/clm/src/external_models/sbetr b/components/clm/src/external_models/sbetr index 0dcedd060f0e..f5a8455980ff 160000 --- a/components/clm/src/external_models/sbetr +++ b/components/clm/src/external_models/sbetr @@ -1 +1 @@ -Subproject commit 0dcedd060f0ed3b8d0df6fc18de1b756e8bdff6e +Subproject commit f5a8455980ff1c45937c6b154e3b59b1afd01c91 From ecb7d7b4281ab6536580de62016672793675f19a Mon Sep 17 00:00:00 2001 From: Jinyun Tang Date: Tue, 25 Jul 2017 15:23:45 -0700 Subject: [PATCH 25/68] replace some function with subroutines in sbetr This fixes the buidling bug with ibm compiler. Now change in alm is involved. --- components/clm/src/external_models/sbetr | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/components/clm/src/external_models/sbetr b/components/clm/src/external_models/sbetr index f5a8455980ff..8ba49521ae43 160000 --- a/components/clm/src/external_models/sbetr +++ b/components/clm/src/external_models/sbetr @@ -1 +1 @@ -Subproject commit f5a8455980ff1c45937c6b154e3b59b1afd01c91 +Subproject commit 8ba49521ae43ea48d00da623259642bc2323e563 From 27023990c6bcaf8fbcd22d156524037ab80eb084 Mon Sep 17 00:00:00 2001 From: Jinyun Tang Date: Tue, 25 Jul 2017 17:23:49 -0700 Subject: [PATCH 26/68] change intent specifications for betr reaction interface No change to ALM is made. --- components/clm/src/external_models/sbetr | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/components/clm/src/external_models/sbetr b/components/clm/src/external_models/sbetr index 8ba49521ae43..b8c1591f5afd 160000 --- a/components/clm/src/external_models/sbetr +++ b/components/clm/src/external_models/sbetr @@ -1 +1 @@ -Subproject commit 8ba49521ae43ea48d00da623259642bc2323e563 +Subproject commit b8c1591f5afd39f16fc5e3afba8878b6f882f005 From 4f65b1484644438fcd7f8f956d84ebaf42c5090f Mon Sep 17 00:00:00 2001 From: Gautam Bisht Date: Wed, 26 Jul 2017 08:54:07 -0700 Subject: [PATCH 27/68] Adds I-Compsets for ECA Following I-Compsets for the ECA model are added: - IM20TRCNECACNTBC : Carbon-Nitrogen with Century soil BGC - IM20TRCNECACTCBC : Carbon-Nitrogen with CTC soil BGC - IM20TRCNPECACNTBC : Carbon-Nitrogen-Phosphorus with Century soil BGC - IM20TRCNPECACTCBC : Carbon-Nitrogen-Phosphorus with CTC soil BGC --- .../clm/cime_config/config_compsets.xml | 27 ++++++++++++++----- 1 file changed, 21 insertions(+), 6 deletions(-) diff --git a/components/clm/cime_config/config_compsets.xml b/components/clm/cime_config/config_compsets.xml index cfef97a95eb2..6226c63304a6 100644 --- a/components/clm/cime_config/config_compsets.xml +++ b/components/clm/cime_config/config_compsets.xml @@ -306,11 +306,6 @@ 1850_DATM%QIA_CLM45%CNPECACTCBC_SICE_SOCN_MOSART_SGLC_SWAV - - IM20TRCNECACTCBC - 20TR_DATM%QIA_CLM45%CNPECACTCBC_SICE_SOCN_MOSART_SGLC_SWAV - - IM1850CNECACNTBC 1850_DATM%QIA_CLM45%CNECACNTBC_SICE_SOCN_MOSART_SGLC_SWAV @@ -421,7 +416,27 @@ 2000_DATM%QIA_CLM45%CNPECACTCBC_SICE_SOCN_MOSART_SGLC_SWAV - + + IM20TRCNECACTCBC + 20TR_DATM%QIA_CLM45%CNECACTCBC_SICE_SOCN_MOSART_SGLC_SWAV + + + + IM20TRCNECACNTBC + 20TR_DATM%QIA_CLM45%CNECACNTBC_SICE_SOCN_MOSART_SGLC_SWAV + + + + IM20TRCNPECACTCBC + 20TR_DATM%QIA_CLM45%CNPECACTCBC_SICE_SOCN_MOSART_SGLC_SWAV + + + + IM20TRCNPECACNTBC + 20TR_DATM%QIA_CLM45%CNPECACNTBC_SICE_SOCN_MOSART_SGLC_SWAV + + + ICRUCLM45 From d8abdfa1235137d8a9daa0ad4b29d8e2b3616774 Mon Sep 17 00:00:00 2001 From: Gautam Bisht Date: Wed, 26 Jul 2017 09:33:02 -0700 Subject: [PATCH 28/68] Modifies land initial condition for ECA Existing land initial conditions are not valid when land BGC uses the ECA model. Thus, modification are made such that existing land initial conditions are only used when ECA model is not used (i.e. nu_com = RD). --- .../namelist_defaults_clm4_5.xml | 23 +++++++++++-------- 1 file changed, 13 insertions(+), 10 deletions(-) diff --git a/components/clm/bld/namelist_files/namelist_defaults_clm4_5.xml b/components/clm/bld/namelist_files/namelist_defaults_clm4_5.xml index 6cc609b1ecc4..06b75a938389 100644 --- a/components/clm/bld/namelist_files/namelist_defaults_clm4_5.xml +++ b/components/clm/bld/namelist_files/namelist_defaults_clm4_5.xml @@ -46,6 +46,9 @@ attributes from the config_cache.xml file (with keys converted to upper-case). NONE NONE + +RD + 0.60,0.40 0.60,0.40 @@ -113,7 +116,7 @@ ic_tod="0" sim_year="1850" glc_nec="0" use_crop=".false." >lnd/clm2/initdata_map lnd/clm2/initdata_map/clmi.I1850CRUCLM45BGC.0241-01-01.0.9x1.25_g1v6_simyr1850_c140111.nc +ic_tod="0" sim_year="1850" glc_nec="0" use_crop=".false." nu_com="RD" >lnd/clm2/initdata_map/clmi.I1850CRUCLM45BGC.0241-01-01.0.9x1.25_g1v6_simyr1850_c140111.nc @@ -138,13 +141,13 @@ ic_tod="0" sim_year="2000" glc_nec="0" use_crop=".false." >lnd/clm2/initdata_map lnd/clm2/initdata_map/clmi.I1850CRUCLM45BGC.0241-01-01.1.9x2.5_g1v6_simyr1850_c140111.nc +ic_tod="0" sim_year="1850" glc_nec="0" use_crop=".false." nu_com="RD" >lnd/clm2/initdata_map/clmi.I1850CRUCLM45BGC.0241-01-01.1.9x2.5_g1v6_simyr1850_c140111.nc lnd/clm2/initdata_map/clmi.I1850CRUCLM45BGC.0241-01-01.1.9x2.5_g1v6_simyr1850_c140111.nc +ic_tod="0" sim_year="1850" glc_nec="0" use_crop=".false." nu_com="RD" >lnd/clm2/initdata_map/clmi.I1850CRUCLM45BGC.0241-01-01.1.9x2.5_g1v6_simyr1850_c140111.nc @@ -152,12 +155,12 @@ ic_tod="0" sim_year="1850" glc_nec="0" use_crop=".false." >lnd/clm2/initdata_map lnd/clm2/initdata_map/clmi.I1850CRUCLM45BGC.0241-01-01.360x720cru_hcru_simyr1850_c140111.nc +ic_tod="0" sim_year="1850" glc_nec="0" use_crop=".false." nu_com="RD" >lnd/clm2/initdata_map/clmi.I1850CRUCLM45BGC.0241-01-01.360x720cru_hcru_simyr1850_c140111.nc lnd/clm2/initdata_map/clmi.I1850CRUCLM45BGC.0241-01-01.360x720cru_hcru_simyr1850_c140111.nc +ic_tod="0" sim_year="1850" glc_nec="0" use_crop=".false." nu_com="RD" >lnd/clm2/initdata_map/clmi.I1850CRUCLM45BGC.0241-01-01.360x720cru_hcru_simyr1850_c140111.nc @@ -199,7 +202,7 @@ ic_tod="0" sim_year="1850" glc_nec="0" use_crop=".false." >lnd/clm2/initdata_map lnd/clm2/initdata_map/clmi.I1850CRUCLM45BGC.0241-01-01.ne30np4_g1v6_simyr1850_c140111.nc +ic_tod="0" sim_year="1850" glc_nec="0" use_crop=".false." nu_com="RD" >lnd/clm2/initdata_map/clmi.I1850CRUCLM45BGC.0241-01-01.ne30np4_g1v6_simyr1850_c140111.nc @@ -275,7 +278,7 @@ ic_tod="0" sim_year="2000" glc_nec="0" use_crop=".false." >lnd/clm2/initdata_map lnd/clm2/initdata_map/clmi.I1850CRUCLM45BGCDV.0241-01-01.0.9x1.25_g1v6_simyr1850_c140111.nc +ic_tod="0" sim_year="1850" glc_nec="0" use_crop=".false." nu_com="RD" >lnd/clm2/initdata_map/clmi.I1850CRUCLM45BGCDV.0241-01-01.0.9x1.25_g1v6_simyr1850_c140111.nc @@ -283,19 +286,19 @@ ic_tod="0" sim_year="1850" glc_nec="0" use_crop=".false." >lnd/clm2/initdata_map lnd/clm2/initdata_map/clmi.ICRUCLM45BGCCROPmp24.0241-01-01.1.9x2.5_g1v6_simyr2000_c140111.nc +ic_tod="0" sim_year="2000" glc_nec="0" use_crop=".true." irrigate=".false." nu_com="RD" >lnd/clm2/initdata_map/clmi.ICRUCLM45BGCCROPmp24.0241-01-01.1.9x2.5_g1v6_simyr2000_c140111.nc lnd/clm2/initdata_map/clmi.ICRUCLM45BGCCROPmp24.0241-01-01.10x15_USGS_simyr2000_c131028.nc +ic_tod="0" sim_year="2000" glc_nec="0" use_crop=".true." irrigate=".false." nu_com="RD" >lnd/clm2/initdata_map/clmi.ICRUCLM45BGCCROPmp24.0241-01-01.10x15_USGS_simyr2000_c131028.nc lnd/clm2/initdata_map/clmi.ICRUCLM45BGCCROPmp24Irrig.0241-01-01.10x15_USGS_simyr2000_c140111.nc +ic_tod="0" sim_year="2000" glc_nec="0" use_crop=".true." irrigate=".true." nu_com="RD" >lnd/clm2/initdata_map/clmi.ICRUCLM45BGCCROPmp24Irrig.0241-01-01.10x15_USGS_simyr2000_c140111.nc From c9e24937cfa33a8c1074694d496e9f46a8ad45b8 Mon Sep 17 00:00:00 2001 From: Sean Patrick Santos Date: Wed, 26 Jul 2017 09:58:49 -0700 Subject: [PATCH 29/68] Add comment explaining 'in_cloud' method. Explain the 'in_cloud' method briefly, and why a "max" is needed. --- components/cam/src/physics/cam/micro_mg2_0.F90 | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/components/cam/src/physics/cam/micro_mg2_0.F90 b/components/cam/src/physics/cam/micro_mg2_0.F90 index 5881c2c49c15..5369c478e6e2 100644 --- a/components/cam/src/physics/cam/micro_mg2_0.F90 +++ b/components/cam/src/physics/cam/micro_mg2_0.F90 @@ -1238,6 +1238,11 @@ subroutine micro_mg_tend ( & if (trim(micro_mg_precip_frac_method) == 'in_cloud') then + ! If cloud mass exists, keep precip_frac = cldm (precipitation + ! only present in cloud). If not, use the max of cloud fraction + ! and fraction from the level above (precip is originating from + ! above in this case, but we need to use the max because MG2 can't + ! handle precip_frac < cldm correctly). if (k /= 1) then where (qc(:,k) < qsmall .and. qi(:,k) < qsmall) precip_frac(:,k) = max(precip_frac(:,k-1),precip_frac(:,k)) From 0f9f7f84845f19b6679111a27aa5fd496caba08b Mon Sep 17 00:00:00 2001 From: Gautam Bisht Date: Wed, 26 Jul 2017 09:59:19 -0700 Subject: [PATCH 30/68] Minor updates to the land namelist build script Initial condition for the land model is now determined using an additional variable (nu_com). This change allows current land initial for BGC mode to be used only when ECA model is not activated. --- components/clm/bld/CLMBuildNamelist.pm | 3 +++ 1 file changed, 3 insertions(+) diff --git a/components/clm/bld/CLMBuildNamelist.pm b/components/clm/bld/CLMBuildNamelist.pm index b14b2227aa97..1b8c797343c9 100755 --- a/components/clm/bld/CLMBuildNamelist.pm +++ b/components/clm/bld/CLMBuildNamelist.pm @@ -2510,6 +2510,7 @@ sub setup_logic_initial_conditions { 'sim_year'=>$nl_flags->{'sim_year'}, 'maxpft'=>$nl_flags->{'maxpft'}, 'more_vertlayers'=>$nl_flags->{'more_vert'}, 'glc_nec'=>$nl_flags->{'glc_nec'}, 'use_crop'=>$nl_flags->{'use_crop'}, + 'nu_com'=>$nl_flags->{'nu_com'}, 'irrigate'=>$nl_flags->{'irrigate'} ); } } elsif ($opts->{'ignore_ic_year'}) { @@ -2531,6 +2532,7 @@ sub setup_logic_initial_conditions { 'sim_year'=>$nl_flags->{'sim_year'}, 'maxpft'=>$nl_flags->{'maxpft'}, 'more_vertlayers'=>$nl_flags->{'more_vert'}, 'glc_nec'=>$nl_flags->{'glc_nec'}, 'use_crop'=>$nl_flags->{'use_crop'}, + 'nu_com'=>$nl_flags->{'nu_com'}, 'irrigate'=>$nl_flags->{'irrigate'} ); } } else { @@ -2552,6 +2554,7 @@ sub setup_logic_initial_conditions { 'sim_year'=>$nl_flags->{'sim_year'}, 'maxpft'=>$nl_flags->{'maxpft'}, 'more_vertlayers'=>$nl_flags->{'more_vert'}, 'glc_nec'=>$nl_flags->{'glc_nec'}, 'use_crop'=>$nl_flags->{'use_crop'}, + 'nu_com'=>$nl_flags->{'nu_com'}, 'irrigate'=>$nl_flags->{'irrigate'} ); } } From 19af428e723846e35af974e38246b3d988e05cc7 Mon Sep 17 00:00:00 2001 From: Gautam Bisht Date: Wed, 26 Jul 2017 12:53:59 -0700 Subject: [PATCH 31/68] Adds a land test for 20th century transient A test with active land BGC for the 20th century transient is added. This test will ensure the dynamic PFT capability in ALM will be protected. --- cime/scripts/lib/update_acme_tests.py | 1 + 1 file changed, 1 insertion(+) diff --git a/cime/scripts/lib/update_acme_tests.py b/cime/scripts/lib/update_acme_tests.py index 7061cb5c9aac..0207dfd1e387 100644 --- a/cime/scripts/lib/update_acme_tests.py +++ b/cime/scripts/lib/update_acme_tests.py @@ -65,6 +65,7 @@ "acme_land_developer" : ("acme_runoff_developer", "0:45:00", ("ERS.f19_f19.I1850CLM45CN", "ERS.f09_g16.I1850CLM45CN", + "ERS.f19_f19.I20TRCLM45CN", "SMS_Ld1.hcru_hcru.I1850CRUCLM45CN", ("ERS.f19_g16.I1850CNECACNTBC" ,"clm-eca"), ("ERS.f19_g16.I1850CNECACTCBC" ,"clm-eca"), From bcaa479d79c8969e162fceae2bfc8fd2a462a538 Mon Sep 17 00:00:00 2001 From: Jinyun Tang Date: Thu, 27 Jul 2017 15:43:20 -0700 Subject: [PATCH 32/68] update sbetr with bug fixes Now sbetr standalone tests passed. No change to ALM is involved. --- components/clm/src/external_models/sbetr | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/components/clm/src/external_models/sbetr b/components/clm/src/external_models/sbetr index b8c1591f5afd..e8b621d2e86f 160000 --- a/components/clm/src/external_models/sbetr +++ b/components/clm/src/external_models/sbetr @@ -1 +1 @@ -Subproject commit b8c1591f5afd39f16fc5e3afba8878b6f882f005 +Subproject commit e8b621d2e86f5f11c480c668f3e1c11c18d4d693 From d90038f0535c2e33d1c25d09221dbcc3cf235662 Mon Sep 17 00:00:00 2001 From: Azamat Mametjanov Date: Fri, 28 Jul 2017 00:11:46 +0000 Subject: [PATCH 33/68] Init HOMME internal netcdf control-var Also update Mira/Cetus machine config: * link to correct HDF5 and Zlib * use pre-installed cprnc * suppress nested-omp compiler warnings --- components/homme/cmake/SetCompilerFlags.cmake | 2 +- components/homme/cmake/machineFiles/cetus.cmake | 6 +++--- components/homme/cmake/machineFiles/mira.cmake | 6 +++--- components/homme/src/netcdf_io_mod.F90 | 1 + 4 files changed, 8 insertions(+), 7 deletions(-) diff --git a/components/homme/cmake/SetCompilerFlags.cmake b/components/homme/cmake/SetCompilerFlags.cmake index 9ce7f4d4cc60..d7d07d36702a 100644 --- a/components/homme/cmake/SetCompilerFlags.cmake +++ b/components/homme/cmake/SetCompilerFlags.cmake @@ -189,7 +189,7 @@ IF (ENABLE_HORIZ_OPENMP OR ENABLE_COLUMN_OPENMP) IF (CMAKE_Fortran_COMPILER_ID STREQUAL XL) SET(OpenMP_C_FLAGS "-qsmp=omp") IF (ENABLE_COLUMN_OPENMP) - SET(OpenMP_C_FLAGS "-qsmp=omp:nested_par") + SET(OpenMP_C_FLAGS "-qsmp=omp:nested_par -qsuppress=1520-045") ENDIF () ENDIF () # This file is needed for the timing library - this is currently diff --git a/components/homme/cmake/machineFiles/cetus.cmake b/components/homme/cmake/machineFiles/cetus.cmake index 7a53de156e96..7aad9d903d7c 100644 --- a/components/homme/cmake/machineFiles/cetus.cmake +++ b/components/homme/cmake/machineFiles/cetus.cmake @@ -8,11 +8,11 @@ SET (CMAKE_Fortran_FLAGS "-WF,-C! -O2 -Ipreqx_modules" CACHE STRING "") #SET (FORCE_Fortran_FLAGS "-WF,-C!" CACHE STRING "") SET (ENABLE_OPENMP TRUE CACHE BOOL "") -#SET (WITH_PNETCDF FALSE CACHE FILEPATH "") SET (PNETCDF_DIR /soft/libraries/pnetcdf/current/cnk-xl/current CACHE FILEPATH "") SET (NETCDF_DIR /soft/libraries/netcdf/current/cnk-xl/current CACHE FILEPATH "") -SET (HDF5_DIR /soft/libraries/hdf5/current/cnk-xl/current CACHE FILEPATH "") -SET (ZLIB_DIR /soft/libraries/alcf/current/xl/ZLIB CACHE FILEPATH "") +SET (ENV{HDF5} /soft/libraries/hdf5/current/cnk-xl/current CACHE FILEPATH "") +SET (ENV{LIBZ} /soft/libraries/alcf/current/xl/ZLIB CACHE FILEPATH "") +SET (CPRNC_DIR /projects/ccsm/tools/cprnc CACHE FILEPATH "") SET (USE_QUEUING FALSE CACHE BOOL "") SET (USE_MPIEXEC runjob CACHE FILEPATH "") diff --git a/components/homme/cmake/machineFiles/mira.cmake b/components/homme/cmake/machineFiles/mira.cmake index 7a53de156e96..7aad9d903d7c 100644 --- a/components/homme/cmake/machineFiles/mira.cmake +++ b/components/homme/cmake/machineFiles/mira.cmake @@ -8,11 +8,11 @@ SET (CMAKE_Fortran_FLAGS "-WF,-C! -O2 -Ipreqx_modules" CACHE STRING "") #SET (FORCE_Fortran_FLAGS "-WF,-C!" CACHE STRING "") SET (ENABLE_OPENMP TRUE CACHE BOOL "") -#SET (WITH_PNETCDF FALSE CACHE FILEPATH "") SET (PNETCDF_DIR /soft/libraries/pnetcdf/current/cnk-xl/current CACHE FILEPATH "") SET (NETCDF_DIR /soft/libraries/netcdf/current/cnk-xl/current CACHE FILEPATH "") -SET (HDF5_DIR /soft/libraries/hdf5/current/cnk-xl/current CACHE FILEPATH "") -SET (ZLIB_DIR /soft/libraries/alcf/current/xl/ZLIB CACHE FILEPATH "") +SET (ENV{HDF5} /soft/libraries/hdf5/current/cnk-xl/current CACHE FILEPATH "") +SET (ENV{LIBZ} /soft/libraries/alcf/current/xl/ZLIB CACHE FILEPATH "") +SET (CPRNC_DIR /projects/ccsm/tools/cprnc CACHE FILEPATH "") SET (USE_QUEUING FALSE CACHE BOOL "") SET (USE_MPIEXEC runjob CACHE FILEPATH "") diff --git a/components/homme/src/netcdf_io_mod.F90 b/components/homme/src/netcdf_io_mod.F90 index a157fbcf0d8f..0ec55d496084 100644 --- a/components/homme/src/netcdf_io_mod.F90 +++ b/components/homme/src/netcdf_io_mod.F90 @@ -643,6 +643,7 @@ subroutine nf_open_file(masterproc,nprocs,comm,iam,ios,output_prefix,file_prefix else ierr = PIO_CreateFile(pio_subsystem, FileID, iotype_pnetcdf, filename, PIO_64BIT_OFFSET) endif + ncFileID = 0 if(masterproc) print *, 'Opening file ',trim(filename), fileid%fh, output_type end subroutine nf_open_file From 26276c6e61eb218cdb8210a55ab3a734f92e2e41 Mon Sep 17 00:00:00 2001 From: Azamat Mametjanov Date: Fri, 28 Jul 2017 00:14:04 +0000 Subject: [PATCH 34/68] Suppress nested-omp IBM compiler warnings --- cime/config/acme/machines/config_compilers.xml | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/cime/config/acme/machines/config_compilers.xml b/cime/config/acme/machines/config_compilers.xml index 7abe72709771..8d9c0baa0855 100644 --- a/cime/config/acme/machines/config_compilers.xml +++ b/cime/config/acme/machines/config_compilers.xml @@ -109,10 +109,10 @@ for mct, etc. -qrealsize=8 -O2 -qstrict -Q -O3 - -qsmp=omp:nested_par - -qsmp=omp:nested_par - -qsmp=omp:nested_par:noopt - -qsmp=omp:nested_par:noopt + -qsmp=omp:nested_par -qsuppress=1520-045 + -qsmp=omp:nested_par -qsuppress=1520-045 + -qsmp=omp:nested_par:noopt -qsuppress=1520-045 + -qsmp=omp:nested_par:noopt -qsuppress=1520-045 -qinitauto=7FF7FFFF -qflttrap=ov:zero:inv:en -C TRUE From 44201fea17d996625f9c2df9581c6e54a779171d Mon Sep 17 00:00:00 2001 From: Jinyun Tang Date: Fri, 28 Jul 2017 13:10:23 -0700 Subject: [PATCH 35/68] bug fix for ibm compiler Add a logical switch to workaround the failure of creating the betr_parameter namelist on the fly. No change to ALM is made. --- components/clm/src/external_models/sbetr | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/components/clm/src/external_models/sbetr b/components/clm/src/external_models/sbetr index e8b621d2e86f..62740758a108 160000 --- a/components/clm/src/external_models/sbetr +++ b/components/clm/src/external_models/sbetr @@ -1 +1 @@ -Subproject commit e8b621d2e86f5f11c480c668f3e1c11c18d4d693 +Subproject commit 62740758a1085c522b891ced3ac5a43216a67e7b From d13eadf448ec1b6767193fbe041c9f1047cf689c Mon Sep 17 00:00:00 2001 From: Azamat Mametjanov Date: Fri, 28 Jul 2017 15:34:31 -0500 Subject: [PATCH 36/68] Fix module cmd when called from python --- cime/config/acme/machines/config_compilers.xml | 3 +-- cime/config/acme/machines/config_machines.xml | 11 ++++++++--- 2 files changed, 9 insertions(+), 5 deletions(-) diff --git a/cime/config/acme/machines/config_compilers.xml b/cime/config/acme/machines/config_compilers.xml index c5042df6e505..22e56320bce9 100644 --- a/cime/config/acme/machines/config_compilers.xml +++ b/cime/config/acme/machines/config_compilers.xml @@ -1179,8 +1179,7 @@ for mct, etc. - -O2 -qno-opt-dynamic-align - -O2 + -O2 -debug minimal -qno-opt-dynamic-align -qopenmp -qopenmp -qopenmp diff --git a/cime/config/acme/machines/config_machines.xml b/cime/config/acme/machines/config_machines.xml index 974abe0e2470..5971217bc599 100644 --- a/cime/config/acme/machines/config_machines.xml +++ b/cime/config/acme/machines/config_machines.xml @@ -1058,9 +1058,14 @@ - module -q - module -q - module -q + /home/software/spack-0.10.1/opt/spack/linux-centos7-x86_64/gcc-4.8.5/lmod-7.4.9-ic63herzfgw5u3na5mdtvp3nwxy6oj2z/lmod/lmod/init/sh + /home/software/spack-0.10.1/opt/spack/linux-centos7-x86_64/gcc-4.8.5/lmod-7.4.9-ic63herzfgw5u3na5mdtvp3nwxy6oj2z/lmod/lmod/init/csh + /home/software/spack-0.10.1/opt/spack/linux-centos7-x86_64/gcc-4.8.5/lmod-7.4.9-ic63herzfgw5u3na5mdtvp3nwxy6oj2z/lmod/lmod/init/perl + /home/software/spack-0.10.1/opt/spack/linux-centos7-x86_64/gcc-4.8.5/lmod-7.4.9-ic63herzfgw5u3na5mdtvp3nwxy6oj2z/lmod/lmod/init/env_modules_python.py + /home/software/spack-0.10.1/opt/spack/linux-centos7-x86_64/gcc-4.8.5/lmod-7.4.9-ic63herzfgw5u3na5mdtvp3nwxy6oj2z/lmod/lmod/libexec/lmod perl + /home/software/spack-0.10.1/opt/spack/linux-centos7-x86_64/gcc-4.8.5/lmod-7.4.9-ic63herzfgw5u3na5mdtvp3nwxy6oj2z/lmod/lmod/libexec/lmod python + module + module From 1855bcbfe04db0906f8e5e643ea73fcffe7de122 Mon Sep 17 00:00:00 2001 From: Azamat Mametjanov Date: Fri, 28 Jul 2017 16:16:50 -0500 Subject: [PATCH 37/68] Perl module is not installed, use a local one --- cime/config/acme/machines/config_machines.xml | 1 + 1 file changed, 1 insertion(+) diff --git a/cime/config/acme/machines/config_machines.xml b/cime/config/acme/machines/config_machines.xml index 5971217bc599..b32a6ea89e12 100644 --- a/cime/config/acme/machines/config_machines.xml +++ b/cime/config/acme/machines/config_machines.xml @@ -1089,6 +1089,7 @@ $SHELL{which nf-config | xargs dirname | xargs dirname} $SHELL{which pnetcdf_version | xargs dirname | xargs dirname} + /lcrc/group/acme/soft/perl/5.26.0/bin:$ENV{PATH} 128M From 9d6361f2735bc33e20a04392138bcf29317e8d35 Mon Sep 17 00:00:00 2001 From: Gautam Bisht Date: Fri, 28 Jul 2017 23:38:07 -0700 Subject: [PATCH 38/68] Fixes setup of land namelist for soil BGC Removes error checking for CTC and CNT soil bgc models. The error checking needs to be implemented in setup_cmdl_bgc(), which will be updated in the future. --- components/clm/bld/CLMBuildNamelist.pm | 8 -------- 1 file changed, 8 deletions(-) diff --git a/components/clm/bld/CLMBuildNamelist.pm b/components/clm/bld/CLMBuildNamelist.pm index 3c9441198ee9..7a1cc0ddd728 100755 --- a/components/clm/bld/CLMBuildNamelist.pm +++ b/components/clm/bld/CLMBuildNamelist.pm @@ -1314,10 +1314,6 @@ sub setup_cmdl_soil_decomp { $var = "use_century_decomp"; $val = ".false."; - if ( defined($nl->get_value($var)) && $nl->get_value($var) ne $val ) { - fatal_error("$var is inconsistent with the commandline setting of -soil_decomp"); - } - my $group = $definition->get_group_name($var); $nl_flags->{$var} = $val; $nl->set_variable_value($group, $var, $val); @@ -1331,10 +1327,6 @@ sub setup_cmdl_soil_decomp { $var = "use_century_decomp"; $val = ".true."; - if ( defined($nl->get_value($var)) && $nl->get_value($var) ne $val ) { - fatal_error("$var is inconsistent with the commandline setting of -soil_decomp"); - } - my $group = $definition->get_group_name($var); $nl_flags->{$var} = $val; $nl->set_variable_value($group, $var, $val); From 74f9135187ec2a3c119937f13d6a8cf50d56f7cb Mon Sep 17 00:00:00 2001 From: Azamat Mametjanov Date: Sat, 29 Jul 2017 18:30:15 +0000 Subject: [PATCH 39/68] Update Theta machine config --- .../config/acme/machines/config_compilers.xml | 14 +++---- cime/config/acme/machines/config_machines.xml | 39 +++++++++---------- 2 files changed, 24 insertions(+), 29 deletions(-) diff --git a/cime/config/acme/machines/config_compilers.xml b/cime/config/acme/machines/config_compilers.xml index 898d3d9f730c..fcada5dbab91 100644 --- a/cime/config/acme/machines/config_compilers.xml +++ b/cime/config/acme/machines/config_compilers.xml @@ -1012,21 +1012,17 @@ for mct, etc. - ftn - cc - CC - -O2 -xMIC-AVX512 - -O2 -xMIC-AVX512 - -O0 -g -xMIC-AVX512 - -O0 -g -xMIC-AVX512 + ifort + icc + icpc + -O2 -debug minimal -qno-opt-dynamic-align -qopenmp -qopenmp -qopenmp -qopenmp --host=Linux -L$(NETCDF_DIR)/lib -lnetcdff -L$(NETCDF_DIR)/lib -lnetcdf -Wl,-rpath -Wl,$(NETCDF_DIR)/lib - -mkl -lpthread -lm - -DHAVE_COMM_F2C + -mkl -lpthread diff --git a/cime/config/acme/machines/config_machines.xml b/cime/config/acme/machines/config_machines.xml index aaa5c8f40f97..ea072325fd99 100644 --- a/cime/config/acme/machines/config_machines.xml +++ b/cime/config/acme/machines/config_machines.xml @@ -1291,7 +1291,6 @@ /projects/EarlyPerf_theta/acme/csm/$CASE /projects/EarlyPerf_theta/acme/baselines /projects/EarlyPerf_theta/acme/tools/cprnc - /projects/EarlyPerf_theta/acme CNL cobalt_theta acme @@ -1321,47 +1320,47 @@ module module + craype-mic-knl PrgEnv-intel PrgEnv-cray PrgEnv-gnu intel cce + cray-mpich cray-parallel-netcdf cray-hdf5-parallel - pmi - cray-libsci - cray-mpich - cray-netcdf cray-hdf5 + cray-netcdf cray-netcdf-hdf5parallel + cray-libsci craype + + craype/2.5.11 + - PrgEnv-intel/6.0.3 - intel intel/17.0.2.174 - cray-libsci + PrgEnv-intel/6.0.4 + intel/17.0.4.196 - PrgEnv-cray/6.0.3 - cce cce/8.5.4 + PrgEnv-cray/6.0.4 + cce/8.6.0 - PrgEnv-gnu/6.0.3 - gcc gcc/6.2.0 - - - craype craype/2.5.9 + PrgEnv-gnu/6.0.4 + gcc/6.3.0 - cray-libsci/16.09.1 + cray-libsci/17.06.1 - cray-mpich/7.5.3 + craype-mic-knl + cray-mpich/7.6.0 - cray-netcdf-hdf5parallel/4.4.1.1 - cray-hdf5-parallel/1.10.0.1 - cray-parallel-netcdf/1.8.0 + cray-netcdf-hdf5parallel/4.4.1.1.3 + cray-hdf5-parallel/1.10.0.3 + cray-parallel-netcdf/1.8.1.3 From 436d07c32ba1e575bb041f38cd5fae1a1daecd53 Mon Sep 17 00:00:00 2001 From: Azamat Mametjanov Date: Sat, 29 Jul 2017 22:25:58 +0000 Subject: [PATCH 40/68] Resolve paths from $PROJECT --- cime/config/acme/machines/config_machines.xml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/cime/config/acme/machines/config_machines.xml b/cime/config/acme/machines/config_machines.xml index ea072325fd99..84cf88b23b10 100644 --- a/cime/config/acme/machines/config_machines.xml +++ b/cime/config/acme/machines/config_machines.xml @@ -1284,11 +1284,11 @@ acme_developer intel,gnu,cray mpt - /projects/EarlyPerf_theta/acme/scratch/$USER + /projects/$PROJECT/$USER /projects/EarlyPerf_theta/acme/inputdata /projects/EarlyPerf_theta/acme/inputdata/atm/datm7 $CIME_OUTPUT_ROOT/archive/$CASE - /projects/EarlyPerf_theta/acme/csm/$CASE + $CIME_OUTPUT_ROOT/csm/$CASE /projects/EarlyPerf_theta/acme/baselines /projects/EarlyPerf_theta/acme/tools/cprnc CNL From c9b1e6198dc4af8defc31cd8654f3c88df798acb Mon Sep 17 00:00:00 2001 From: Matthew Hoffman Date: Mon, 31 Jul 2017 11:33:11 -0600 Subject: [PATCH 41/68] Update MPASLI to fix bit reproducibility The previous update of MPASLI in this branch brought in changes that were not BFB for the configuration used in ACME. In fixing that bug, I also discovered that the configuration in ACME was not bit-reproducible. So this update also fixes that bug. However, that fix makes this update answer-changing. Differences are small, and the new results are identical across different processor counts. I also update the namelist option to force the Albany mesh to be rebuilt on every time step. This is needed to allow Albany runs to be BFB-restartable until a fix in Albany is brought into ACME. [Non-BFB] --- .../mpasli/bld/namelist_files/namelist_defaults_mpasli.xml | 2 +- components/mpasli/model | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/components/mpasli/bld/namelist_files/namelist_defaults_mpasli.xml b/components/mpasli/bld/namelist_files/namelist_defaults_mpasli.xml index 3b239c6e7acb..7715c7c7edfe 100644 --- a/components/mpasli/bld/namelist_files/namelist_defaults_mpasli.xml +++ b/components/mpasli/bld/namelist_files/namelist_defaults_mpasli.xml @@ -85,7 +85,7 @@ .false. .false. .false. -.false. +.true. .false. diff --git a/components/mpasli/model b/components/mpasli/model index 37fde6df873b..0381d042a608 160000 --- a/components/mpasli/model +++ b/components/mpasli/model @@ -1 +1 @@ -Subproject commit 37fde6df873b5988cdcc84b4375425feb0767156 +Subproject commit 0381d042a608cd83a70051764177d66f21befd3f From aa740dacdb83e065fbb127ed89f80ca01e617b54 Mon Sep 17 00:00:00 2001 From: Azamat Mametjanov Date: Mon, 31 Jul 2017 18:11:34 +0000 Subject: [PATCH 42/68] Update default project on Theta --- cime/config/acme/machines/config_compilers.xml | 1 + cime/config/acme/machines/config_machines.xml | 10 +++++----- 2 files changed, 6 insertions(+), 5 deletions(-) diff --git a/cime/config/acme/machines/config_compilers.xml b/cime/config/acme/machines/config_compilers.xml index fcada5dbab91..da38592e601e 100644 --- a/cime/config/acme/machines/config_compilers.xml +++ b/cime/config/acme/machines/config_compilers.xml @@ -1023,6 +1023,7 @@ for mct, etc. --host=Linux -L$(NETCDF_DIR)/lib -lnetcdff -L$(NETCDF_DIR)/lib -lnetcdf -Wl,-rpath -Wl,$(NETCDF_DIR)/lib -mkl -lpthread + -DARCH_MIC_KNL diff --git a/cime/config/acme/machines/config_machines.xml b/cime/config/acme/machines/config_machines.xml index 84cf88b23b10..590e83c46c44 100644 --- a/cime/config/acme/machines/config_machines.xml +++ b/cime/config/acme/machines/config_machines.xml @@ -1285,19 +1285,19 @@ intel,gnu,cray mpt /projects/$PROJECT/$USER - /projects/EarlyPerf_theta/acme/inputdata - /projects/EarlyPerf_theta/acme/inputdata/atm/datm7 + /projects/$PROJECT/acme/inputdata + /projects/$PROJECT/acme/inputdata/atm/datm7 $CIME_OUTPUT_ROOT/archive/$CASE $CIME_OUTPUT_ROOT/csm/$CASE - /projects/EarlyPerf_theta/acme/baselines - /projects/EarlyPerf_theta/acme/tools/cprnc + /projects/$PROJECT/acme/baselines + /projects/$PROJECT/acme/tools/cprnc/cprnc CNL cobalt_theta acme 8 64 64 - Theta_ESP + OceanClimate TRUE -D PIO_BUILD_TIMING:BOOL=ON From f4890bc4a005ec6f17112fc9e75369842f92734f Mon Sep 17 00:00:00 2001 From: Azamat Mametjanov Date: Mon, 31 Jul 2017 19:40:35 +0000 Subject: [PATCH 43/68] Update PEs for ne120 F-compset cases on Mira --- cime/config/acme/allactive/config_pesall.xml | 295 ++++++++++--------- 1 file changed, 158 insertions(+), 137 deletions(-) diff --git a/cime/config/acme/allactive/config_pesall.xml b/cime/config/acme/allactive/config_pesall.xml index 6d8234ae2b2c..7782291e66cc 100644 --- a/cime/config/acme/allactive/config_pesall.xml +++ b/cime/config/acme/allactive/config_pesall.xml @@ -2702,7 +2702,7 @@ - none + default and minimal 512-node partition 2048 2048 @@ -2735,11 +2735,9 @@ - - - none + default 64x16 PEs for acme_developer tests 64 64 @@ -2772,6 +2770,74 @@ + + + -compset MPASLIALB + + 1 + 1 + 1 + 1 + 1 + 64 + 1 + 64 + + + 1 + 1 + 1 + 1 + 1 + 16 + 1 + 16 + + + 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0 + + + + none + + 1024 + 1024 + 1024 + 1024 + 1024 + 1024 + 1024 + 1024 + + + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + + + 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0 + + + @@ -3807,10 +3873,6 @@ 0 - - - - none @@ -4180,41 +4242,6 @@ - - - none - - 2048 - 2048 - 2048 - 2048 - 2048 - 2048 - 2048 - 2048 - - - 16 - 16 - 16 - 16 - 16 - 16 - 16 - 16 - - - 0 - 0 - 0 - 0 - 0 - 0 - 0 - 0 - - - ne30_ne30 grid on 45 nodes 32 ppn pure-MPI @@ -4391,10 +4418,6 @@ 0 - - - - none @@ -5949,43 +5972,6 @@ - - - - none - - 1024 - 1024 - 1024 - 1024 - 1024 - 1024 - 1024 - 1024 - - - 1 - 1 - 1 - 1 - 1 - 1 - 1 - 1 - - - 0 - 0 - 0 - 0 - 0 - 0 - 0 - 0 - - - - @@ -6171,39 +6157,111 @@ - - - - none + + + + ne120 F-compset on 512 nodes + 64 + 8 + + 3600 + 2048 + 2048 + 2048 + 2048 + 2048 + 1 + 1 + + + 8 + 8 + 8 + 8 + 8 + 8 + 1 + 1 + + + 0 + 0 + 2048 + 0 + 0 + 0 + 0 + 0 + + + + ne120 F-compset on 1024 nodes + 64 + 8 7200 - 992 + 7200 + 7200 992 992 992 1 1 - 992 - 16 - 16 - 1 - 1 - 1 + 6 + 6 + 6 + 6 + 6 + 6 1 1 - 1 0 - 7200 + 0 + 0 7200 7200 7200 - 7200 - 7200 - 7200 + 0 + 0 + + + + ne120 F-compset on 2048 nodes + 64 + 8 + + 14400 + 14400 + 14400 + 1984 + 1984 + 1984 + 1 + 1 + + + 8 + 8 + 8 + 8 + 8 + 8 + 1 + 1 + + + 0 + 0 + 0 + 14400 + 14400 + 14400 + 0 + 0 @@ -6245,43 +6303,6 @@ - - - - none - - 1 - 1 - 1 - 1 - 1 - 64 - 1 - 64 - - - 1 - 1 - 1 - 1 - 1 - 16 - 1 - 16 - - - 0 - 0 - 0 - 0 - 0 - 0 - 0 - 0 - - - - From 349a0de4699ebe31d7007baa863d336ad97d3b1f Mon Sep 17 00:00:00 2001 From: Azamat Mametjanov Date: Mon, 31 Jul 2017 20:45:46 +0000 Subject: [PATCH 44/68] Update batch settings --- cime/config/acme/machines/config_batch.xml | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/cime/config/acme/machines/config_batch.xml b/cime/config/acme/machines/config_batch.xml index f8d5d4df5382..03acb0aa5804 100644 --- a/cime/config/acme/machines/config_batch.xml +++ b/cime/config/acme/machines/config_batch.xml @@ -253,7 +253,8 @@ - default + default + debug-cache-quad From c249fdf18b9ad9790e4260c8ef82eb12344a0b59 Mon Sep 17 00:00:00 2001 From: Gautam Bisht Date: Mon, 31 Jul 2017 14:17:40 -0700 Subject: [PATCH 45/68] Adds I-Compsets for 20th-century with RTM Adds following four compsets: - I20TRCNECACTCBC : Carbon-Nitrogen with Century soil BGC + RTM - I20TRCNECACNTBC : Carbon-Nitrogen with CTC soil BGC + RTM - I20TRCNPECACTCBC : Carbon-Nitrogen-Phosphorus with Century soil BGC + RTM - I20TRCNPECACNTBC : Carbon-Nitrogen-Phosphorus with CTC soil BGC + RTM --- .../clm/cime_config/config_compsets.xml | 20 +++++++++++++++++++ 1 file changed, 20 insertions(+) diff --git a/components/clm/cime_config/config_compsets.xml b/components/clm/cime_config/config_compsets.xml index 6226c63304a6..0bb5867cac0b 100644 --- a/components/clm/cime_config/config_compsets.xml +++ b/components/clm/cime_config/config_compsets.xml @@ -371,6 +371,26 @@ 2000_DATM%QIA_CLM45%CNPECACTCBC_SICE_SOCN_RTM_SGLC_SWAV + + I20TRCNECACTCBC + 20TR_DATM%QIA_CLM45%CNECACTCBC_SICE_SOCN_RTM_SGLC_SWAV + + + + I20TRCNECACNTBC + 20TR_DATM%QIA_CLM45%CNECACNTBC_SICE_SOCN_RTM_SGLC_SWAV + + + + I20TRCNPECACTCBC + 20TR_DATM%QIA_CLM45%CNPECACTCBC_SICE_SOCN_RTM_SGLC_SWAV + + + + I20TRCNPECACNTBC + 20TR_DATM%QIA_CLM45%CNPECACNTBC_SICE_SOCN_RTM_SGLC_SWAV + + IMCRDCTCBC 2000_DATM%QIA_CLM45%CRDCTCBC_SICE_SOCN_MOSART_SGLC_SWAV From 8aad11eea0e450eceb354ef509aa1b048e43668d Mon Sep 17 00:00:00 2001 From: Azamat Mametjanov Date: Mon, 31 Jul 2017 16:59:41 -0500 Subject: [PATCH 46/68] Move Bebop baselines to a subdirectory --- cime/config/acme/machines/config_machines.xml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/cime/config/acme/machines/config_machines.xml b/cime/config/acme/machines/config_machines.xml index b32a6ea89e12..e18576882c31 100644 --- a/cime/config/acme/machines/config_machines.xml +++ b/cime/config/acme/machines/config_machines.xml @@ -1040,7 +1040,7 @@ /home/ccsm-data/inputdata/atm/datm7 $CIME_OUTPUT_ROOT/archive/$CASE csm/$CASE - /lcrc/group/acme/acme_baselines + /lcrc/group/acme/acme_baselines/bebop /lcrc/group/acme/tools/cprnc/cprnc LINUX slurm From bcff4982fc21ec5cd3feb42d2cf270b5fcf1b475 Mon Sep 17 00:00:00 2001 From: James Foucar Date: Tue, 1 Aug 2017 13:12:08 -0600 Subject: [PATCH 47/68] Fix st_archive template. Not sure how we didn't catch this before. [BFB] --- cime/config/acme/machines/template.st_archive | 4 +--- 1 file changed, 1 insertion(+), 3 deletions(-) diff --git a/cime/config/acme/machines/template.st_archive b/cime/config/acme/machines/template.st_archive index 9ebcba17eb60..2f7b91aa4333 100755 --- a/cime/config/acme/machines/template.st_archive +++ b/cime/config/acme/machines/template.st_archive @@ -64,9 +64,7 @@ formatter_class=argparse.ArgumentDefaultsHelpFormatter parser.add_argument("--force-move", default=False, action="store_true", help="Move the files even if it's unsafe to do so") - args = parser.parse_args() - - CIME.utils.handle_standard_logging_options(args) + args = CIME.utils.parse_args_and_handle_standard_logging_options(args, parser) if args.caseroot is not None: os.chdir(args.caseroot) From 5396292fcec237a18feee92be2e428b3f350a445 Mon Sep 17 00:00:00 2001 From: Jinyun Tang Date: Tue, 1 Aug 2017 12:52:43 -0700 Subject: [PATCH 48/68] bug fix for skybridge failures Now ep_betr is always allocated to avoid runtime failure complaining ep_betr is not associated with a target. --- components/clm/src/main/clm_initializeMod.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/components/clm/src/main/clm_initializeMod.F90 b/components/clm/src/main/clm_initializeMod.F90 index 526d4a7383e7..b52438bcae62 100644 --- a/components/clm/src/main/clm_initializeMod.F90 +++ b/components/clm/src/main/clm_initializeMod.F90 @@ -531,9 +531,9 @@ subroutine initialize2( ) call clm_inst_biogeophys(bounds_proc) + !allocate memory for betr simulator + allocate(ep_betr, source=create_betr_simulation_alm()) if(use_betr)then - !allocate memory for betr simulator - allocate(ep_betr, source=create_betr_simulation_alm()) !set internal filters for betr call ep_betr%BeTRSetFilter(maxpft_per_col=max_patch_per_col, boffline=.false.) call ep_betr%InitOnline(bounds_proc, lun_pp, col_pp, veg_pp, waterstate_vars, betr_namelist_buffer, masterproc) From 09daa64ec7bddf1bae9c5e5406b3ace850f9cd09 Mon Sep 17 00:00:00 2001 From: Jayesh Krishna Date: Tue, 1 Aug 2017 17:12:17 -0500 Subject: [PATCH 49/68] Re-organizing modules for blues Moving common modules (python, cmake) to a generic modules block --- cime/config/acme/machines/config_machines.xml | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/cime/config/acme/machines/config_machines.xml b/cime/config/acme/machines/config_machines.xml index d0e2e185af75..37cf4ee00d9a 100644 --- a/cime/config/acme/machines/config_machines.xml +++ b/cime/config/acme/machines/config_machines.xml @@ -863,16 +863,16 @@ /etc/profile.d/a_softenv.sh soft soft + + +cmake-2.8.12 + +python-2.7 + +gcc-5.2 +netcdf-4.3.3.1-gnu5.2-serial - +cmake-2.8.12 - +python-2.7 +mvapich2-2.2b-gcc-5.2 - +cmake-2.8.12 - +python-2.7 +intel-15.0 +pnetcdf-1.6.1-mvapich2-2.2a-intel-15.0 +mvapich2-2.2b-intel-15.0 From 62d6582ff18b9a09dbc4ec32bba7a40e8419b032 Mon Sep 17 00:00:00 2001 From: Jinyun Tang Date: Wed, 2 Aug 2017 16:51:51 -0700 Subject: [PATCH 50/68] change the namelist reader for betr Now namelist of betr is read per processor rather than per column. This is an attempt to fix the runtime failure with ibm compiler. No change to ALM is involved. --- components/clm/src/external_models/sbetr | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/components/clm/src/external_models/sbetr b/components/clm/src/external_models/sbetr index 62740758a108..8faca73a2bdb 160000 --- a/components/clm/src/external_models/sbetr +++ b/components/clm/src/external_models/sbetr @@ -1 +1 @@ -Subproject commit 62740758a1085c522b891ced3ac5a43216a67e7b +Subproject commit 8faca73a2bdba49ab2835ea2672d1d07a937486f From 8af35023442cd0b36dee5aaeeebfe2aac4703c7b Mon Sep 17 00:00:00 2001 From: Jinyun Tang Date: Wed, 2 Aug 2017 22:33:28 -0700 Subject: [PATCH 51/68] change calling method of endrun in betr Now msg is defined before calling endrun in order to avoid building failure with pgi compiler. No changes of ALM are involved. --- components/clm/src/external_models/sbetr | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/components/clm/src/external_models/sbetr b/components/clm/src/external_models/sbetr index 8faca73a2bdb..9b5b814b4d35 160000 --- a/components/clm/src/external_models/sbetr +++ b/components/clm/src/external_models/sbetr @@ -1 +1 @@ -Subproject commit 8faca73a2bdba49ab2835ea2672d1d07a937486f +Subproject commit 9b5b814b4d351f18afd786684fa2a3e871e77d98 From e43157e7bb59034ad048a694a22ce34deaff309e Mon Sep 17 00:00:00 2001 From: Jayesh Krishna Date: Thu, 3 Aug 2017 16:15:31 -0500 Subject: [PATCH 52/68] Adding support for pgi compiler on blues Adding support for pgi compiler (pgi 15.7) on blues. [BFB] --- cime/config/acme/machines/config_machines.xml | 15 +++++++++++++++ 1 file changed, 15 insertions(+) diff --git a/cime/config/acme/machines/config_machines.xml b/cime/config/acme/machines/config_machines.xml index 37cf4ee00d9a..9d3ccf598ff1 100644 --- a/cime/config/acme/machines/config_machines.xml +++ b/cime/config/acme/machines/config_machines.xml @@ -878,6 +878,15 @@ +mvapich2-2.2b-intel-15.0 +mkl-11.2.1 + + +pgi-15.7 + +binutils-2.27 + +netcdf-c-4.4.1-f77-4.4.4-pgi-15.7-serial + + + +mvapich2-2.2-pgi-15.7 + +pnetcdf-1.7.0-pgi-15.7-mvapich2-2.2 + /soft/netcdf_serial/4.3.3.1/gnu-5.2 @@ -896,6 +905,12 @@ /soft/climate/pnetcdf/1.6.1/intel-15.0.1/mvapich2-2.2a-intel-15.0 + + /soft/spack-0.10.0/opt/spack/linux-centos6-x86_64/pgi-15.7-0/netcdf-4.4.1-4el54ak5ic4ukbfxknv64ejvlum2kmy7 + + + /soft/spack-0.10.0/opt/spack/linux-centos6-x86_64/pgi-15.7-0/parallel-netcdf-1.7.0-htrulk5hgp3jjci2f72srr5ujkg6q4i6 + 64M From e1c6cdcd51ce321f8135a71466d61265c5db8449 Mon Sep 17 00:00:00 2001 From: Jayesh Krishna Date: Thu, 3 Aug 2017 17:12:16 -0500 Subject: [PATCH 53/68] Adding support for NAG compiler on blues Adding support for nag compiler (nag 6.0) on blues. * The -std=c99 flag is required because kissvec.c uses the "restrict" attribute that is part of C99 (The C compiler is gcc) * Only "mpich" is currently supported with the nag compiler on blues [BFB] --- .../config/acme/machines/config_compilers.xml | 3 ++- cime/config/acme/machines/config_machines.xml | 21 +++++++++++++++++++ 2 files changed, 23 insertions(+), 1 deletion(-) diff --git a/cime/config/acme/machines/config_compilers.xml b/cime/config/acme/machines/config_compilers.xml index dffd7f1ec0c8..3fcab398de63 100644 --- a/cime/config/acme/machines/config_compilers.xml +++ b/cime/config/acme/machines/config_compilers.xml @@ -481,6 +481,7 @@ for mct, etc. -g -time -f2003 -ieee=stop -g + -std=c99 @@ -1089,7 +1090,7 @@ for mct, etc. $(NETCDFROOT) /home/robl/soft/mpich-3.1.4-nag-6.0 mpi - $(shell $(NETCDF_PATH)/bin/nf-config --flibs) -llapack -lblas + $(shell $(NETCDF_PATH)/bin/nf-config --flibs) $(shell $(NETCDF_PATH)/bin/nc-config --libs) -llapack -lblas gpfs diff --git a/cime/config/acme/machines/config_machines.xml b/cime/config/acme/machines/config_machines.xml index 9d3ccf598ff1..31b42012c0a8 100644 --- a/cime/config/acme/machines/config_machines.xml +++ b/cime/config/acme/machines/config_machines.xml @@ -855,6 +855,12 @@ -n $TOTALPES + + mpiexec + + -n $TOTALPES + + @@ -887,6 +893,15 @@ +mvapich2-2.2-pgi-15.7 +pnetcdf-1.7.0-pgi-15.7-mvapich2-2.2 + + +nag-6.0 + +hdf5-1.8.12-serial-nag + +netcdf-4.3.1-serial-nag + + + +mpich3-3.1.4-nag-6.0 + +pnetcdf-1.6.1-mpich-3.1.4-nag-6.0 + /soft/netcdf_serial/4.3.3.1/gnu-5.2 @@ -911,6 +926,12 @@ /soft/spack-0.10.0/opt/spack/linux-centos6-x86_64/pgi-15.7-0/parallel-netcdf-1.7.0-htrulk5hgp3jjci2f72srr5ujkg6q4i6 + + /soft/netcdf/4.3.1-serial/nag-6.0 + + + /home/robl/soft/pnetcf-trunk-mpich-3.1.4-nag-6.0 + 64M From c9373a12a61d493077fabcf0afc16ae710b86c65 Mon Sep 17 00:00:00 2001 From: Mark Taylor Date: Fri, 4 Aug 2017 13:09:19 -0600 Subject: [PATCH 54/68] tweaks for standalone HOMME to compile on upgraded skybridge [BFB] --- .../homme/cmake/machineFiles/ghost.cmake | 19 ++++++++++++ .../homme/cmake/machineFiles/redsky.cmake | 31 ------------------- .../homme/cmake/machineFiles/skybridge.cmake | 15 +++++---- 3 files changed, 28 insertions(+), 37 deletions(-) create mode 100644 components/homme/cmake/machineFiles/ghost.cmake delete mode 100644 components/homme/cmake/machineFiles/redsky.cmake diff --git a/components/homme/cmake/machineFiles/ghost.cmake b/components/homme/cmake/machineFiles/ghost.cmake new file mode 100644 index 000000000000..6354add4d1b8 --- /dev/null +++ b/components/homme/cmake/machineFiles/ghost.cmake @@ -0,0 +1,19 @@ +# CMake initial cache file for Linux 64bit RHEL6/CENTOS6 +# tested with stock gcc/gfortran & openmpi +# +SET (CMAKE_Fortran_COMPILER mpif90 CACHE FILEPATH "") +SET (CMAKE_C_COMPILER mpicc CACHE FILEPATH "") +SET (CMAKE_CXX_COMPILER mpicc CACHE FILEPATH "") + +SET (WITH_PNETCDF FALSE CACHE FILEPATH "") +SET (NETCDF_DIR $ENV{SEMS_NETCDF_ROOT} CACHE FILEPATH "") +SET (PNETCDF_DIR $ENV{SEMS_NETCDF_ROOT} CACHE FILEPATH "") +SET (HDF5_DIR $ENV{SEMS_HDF5_ROOT} CACHE FILEPATH "") +SET (ZLIB_DIR $ENV{SEMS_ZLIB_ROOT} CACHE FILEPATH "") + +# machine 'ghost' can use sems cmake machine file if we get /sems-data/store mounted on ghost +#SET (CPRNC_DIR /sems-data-store/ACME/cprnc/build CACHE FILEPATH "") + +SET (USE_QUEUING FALSE CACHE BOOL "") +SET (HOMME_FIND_BLASLAPACK TRUE CACHE BOOL "") + diff --git a/components/homme/cmake/machineFiles/redsky.cmake b/components/homme/cmake/machineFiles/redsky.cmake deleted file mode 100644 index 3ddfeefd76fe..000000000000 --- a/components/homme/cmake/machineFiles/redsky.cmake +++ /dev/null @@ -1,31 +0,0 @@ -# -# CMake initial cache file for Sandia's redsky -# configurd for redsky's netcdf-intel/4.1 module -# -SET (CMAKE_Fortran_COMPILER mpif90 CACHE FILEPATH "") -SET (CMAKE_C_COMPILER mpicc CACHE FILEPATH "") -SET (CMAKE_CXX_COMPILER mpicc CACHE FILEPATH "") - -# Openmpi 1.8 only -#SET (USE_MPI_OPTIONS "--map-by node:SPAN" CACHE FILEPATH "") - -# Openmpi 1.6 -SET (USE_MPI_OPTIONS "-loadbalance" CACHE FILEPATH "") - -# this is ignored if we use FORCE_Fortran_FLAGS -SET (ADD_Fortran_FLAGS "-traceback" CACHE STRING "") - -# override cmake's intel defaults: -# default cmake options for Intel: -# -assume byterecl -fp-model precise -ftz -g -O3 -# -O3 causes problems on redsky when openMP is enabled (even for 1 thread) -# -#SET (FORCE_Fortran_FLAGS "-openmp -fp-model fast -ftz -g -O2" CACHE STRING "") -SET (FORCE_Fortran_FLAGS "-openmp -traceback -fp-model precise -ftz -g -O2" CACHE STRING "") - -SET (NETCDF_DIR /projects/ccsm/tpl/netcdf/4.3.2/intel/13.0.1/openmpi/1.6.5 CACHE FILEPATH "") -SET (PNETCDF_DIR /projects/ccsm/tpl/netcdf/4.3.2/intel/13.0.1/openmpi/1.6.5 CACHE FILEPATH "") -SET (HDF5_DIR /projects/ccsm/tpl/hdf5/1.8.11/intel/13.0.1/openmpi/1.6.5 CACHE FILEPATH "") - -SET (USE_QUEUING FALSE CACHE BOOL "") -SET (HOMME_FIND_BLASLAPACK TRUE CACHE BOOL "") diff --git a/components/homme/cmake/machineFiles/skybridge.cmake b/components/homme/cmake/machineFiles/skybridge.cmake index 64317335545f..2007b7a7732b 100644 --- a/components/homme/cmake/machineFiles/skybridge.cmake +++ b/components/homme/cmake/machineFiles/skybridge.cmake @@ -7,10 +7,10 @@ SET (CMAKE_C_COMPILER mpicc CACHE FILEPATH "") SET (CMAKE_CXX_COMPILER mpicc CACHE FILEPATH "") # Openmpi 1.8 only -#SET (USE_MPI_OPTIONS "--map-by node:SPAN" CACHE FILEPATH "") +SET (USE_MPI_OPTIONS "--map-by node:SPAN" CACHE FILEPATH "") # Openmpi 1.6 -SET (USE_MPI_OPTIONS "-loadbalance" CACHE FILEPATH "") +#SET (USE_MPI_OPTIONS "-loadbalance" CACHE FILEPATH "") # this is ignored if we use FORCE_Fortran_FLAGS SET (ADD_Fortran_FLAGS "-traceback" CACHE STRING "") @@ -23,11 +23,14 @@ SET (ADD_Fortran_FLAGS "-traceback" CACHE STRING "") #SET (FORCE_Fortran_FLAGS "-openmp -fp-model fast -ftz -g -O2" CACHE STRING "") SET (FORCE_Fortran_FLAGS "-openmp -traceback -fp-model precise -ftz -g -O2" CACHE STRING "") -SET (NETCDF_DIR /projects/ccsm/tpl/netcdf/4.3.2/intel/13.0.1/openmpi/1.6.5 CACHE FILEPATH "") -SET (PNETCDF_DIR /projects/ccsm/tpl/netcdf/4.3.2/intel/13.0.1/openmpi/1.6.5 CACHE FILEPATH "") -SET (HDF5_DIR /projects/ccsm/tpl/hdf5/1.8.11/intel/13.0.1/openmpi/1.6.5 CACHE FILEPATH "") +# redsky upgrade 8/2017, need to load sems-netcdf module: +SET (WITH_PNETCDF FALSE CACHE FILEPATH "") +SET (NETCDF_DIR $ENV{SEMS_NETCDF_ROOT} CACHE FILEPATH "") +SET (HDF5_DIR $ENV{SEMS_HDF5_ROOT} CACHE FILEPATH "") +SET (ZLIB_DIR $ENV{SEMS_ZLIB_ROOT} CACHE FILEPATH "") + SET (USE_QUEUING FALSE CACHE BOOL "") SET (HOMME_FIND_BLASLAPACK TRUE CACHE BOOL "") -SET (CPRNC_DIR /projects/ccsm/cprnc/build CACHE FILEPATH "") +SET (CPRNC_DIR /projects/ccsm/cprnc/build.toss3 CACHE FILEPATH "") From 4ac2ee78afe2aac31bc29d741f5dd8ca275d8a31 Mon Sep 17 00:00:00 2001 From: Patrick Worley Date: Sun, 6 Aug 2017 17:12:48 -0400 Subject: [PATCH 55/68] Check for NaNs and INFs in input to shr_reprosum_calc In recent development NaNs and INFs are often first identified when passed to the shr_reprosum_calc routine, where they either lead to segmentation faults or to very slow performance (due to the interaction of NaNs and INFs with the reproducible sum logic). To more readily identify this error condition (and to prevent false attributions of error to shr_reprosum_calc), the input array is checked for the presence of NaNs and INFs. If found, an appropriate error message is output and the job is terminated. [BFB] *********1*********2*********3*********4*********5*********6*********7** Longer commit message body describing the commit. Can contain lists as follows: * Item 1 * Item 2 * Item 3 A good commit message should be written like an email, a subject followed by a blank line, followed by a more descriptive body. Can also contain a tag at the bottom describing what type of commit this is. [BFB] - Bit-For-Bit [FCC] - Flag Climate Changing [Non-BFB] - Non Bit-For-Bit [CC] - Climate Changing [NML] - Namelist Changing See confluence for a more detailed description about these tags. --- cime/src/share/util/shr_reprosum_mod.F90 | 39 ++++++++++++++++++++++++ 1 file changed, 39 insertions(+) diff --git a/cime/src/share/util/shr_reprosum_mod.F90 b/cime/src/share/util/shr_reprosum_mod.F90 index ec4654fe2d29..c568cfe97b00 100644 --- a/cime/src/share/util/shr_reprosum_mod.F90 +++ b/cime/src/share/util/shr_reprosum_mod.F90 @@ -38,6 +38,7 @@ module shr_reprosum_mod use shr_log_mod, only: s_loglev => shr_log_Level use shr_log_mod, only: s_logunit => shr_log_Unit use shr_sys_mod, only: shr_sys_abort + use shr_infnan_mod,only: shr_infnan_isnan, shr_infnan_isinf use perf_mod !----------------------------------------------------------------------- @@ -338,8 +339,14 @@ subroutine shr_reprosum_calc (arr, arr_gsum, nsummands, dsummands, & logical :: validate ! flag indicating need to ! verify gmax and max_levels ! are accurate/sufficient + integer :: nan_check, inf_check ! flag on whether there are + ! NaNs and INFs in input array + + integer :: num_nans, num_infs ! count of NaNs and INFs in + ! input array integer :: omp_nthreads ! number of OpenMP threads integer :: mpi_comm ! MPI subcommunicator + integer :: mypid ! MPI process ID (COMM_WORLD) integer :: tasks ! number of MPI processes integer :: ierr ! MPI error return integer :: ifld, isum, ithread ! loop variables @@ -389,6 +396,38 @@ subroutine shr_reprosum_calc (arr, arr_gsum, nsummands, dsummands, & ! !----------------------------------------------------------------------- ! +! check whether input contains NaNs or INFs, and abort if so + + call t_startf('shr_reprosum_NaN_INF_Chk') + nan_check = .false. + inf_check = .false. + num_nans = 0 + num_infs = 0 + + nan_check = any(shr_infnan_isnan(arr)) + inf_check = any(shr_infnan_isinf(arr)) + if (nan_check .or. inf_check) then + do ifld=1,nflds + do isum=1,nsummands + if (shr_infnan_isnan(arr(isum,ifld))) then + num_nans = num_nans + 1 + endif + if (shr_infnan_isinf(arr(isum,ifld))) then + num_infs = num_infs + 1 + endif + end do + end do + endif + call t_stopf('shr_reprosum_NaN_INF_Chk') + + if ((num_nans > 0) .or. (num_infs > 0)) then + call mpi_comm_rank(MPI_COMM_WORLD, mypid, ierr) + write(s_logunit,37) real(num_nans,r8), real(num_infs,r8), mypid +37 format("SHR_REPROSUM_CALC: Input contains ",e12.5, & + " NaNs and ", e12.5, " INFs on process ", i7) + call shr_sys_abort("shr_reprosum_calc ERROR: NaNs or INFs in input") + endif + ! check whether should use shr_reprosum_ddpdd algorithm use_ddpdd_sum = repro_sum_use_ddpdd if ( present(ddpdd_sum) ) then From f1f45cab19dd6fb7003d260ffdbd3fa97c57d9e1 Mon Sep 17 00:00:00 2001 From: Gautam Bisht Date: Mon, 7 Aug 2017 08:26:11 -0700 Subject: [PATCH 56/68] Minor updates to the CLMbuildNamelist Adds back compatability when XML entry for initial condition did not include an identifier for nutrient competition pathway. All existing initial condition XML entries now include a new identifier (nu_com = 'RD'). If nu_com is undefined (=""), the model configuration is using SP (satellite phenology). In order to use existing initial condition nu_com = RD (instead of nu_comp='') is used to indentify the appropriate initial condition. --- components/clm/bld/CLMBuildNamelist.pm | 18 +++++++++++++++--- 1 file changed, 15 insertions(+), 3 deletions(-) diff --git a/components/clm/bld/CLMBuildNamelist.pm b/components/clm/bld/CLMBuildNamelist.pm index 1b8c797343c9..1d794c1d92df 100755 --- a/components/clm/bld/CLMBuildNamelist.pm +++ b/components/clm/bld/CLMBuildNamelist.pm @@ -2500,6 +2500,10 @@ sub setup_logic_initial_conditions { 'irrig'=>$nl_flags->{'irrig'}, 'glc_nec'=>$nl_flags->{'glc_nec'}, 'crop'=>$nl_flags->{'crop'}, 'bgc'=>$nl_flags->{'bgc_mode'} ); } else { + my $nu_com_val = $nl_flags->{'nu_com'}; + if ($nu_com_val eq "") { + $nu_com_val = "RD"; + } add_default($opts->{'test'}, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, $var, 'hgrid'=>$nl_flags->{'res'}, 'mask'=>$nl_flags->{'mask'}, 'nofail'=>$nofail, 'flanduse_timeseries'=>$nl_flags->{'flanduse_timeseries'}, @@ -2510,7 +2514,7 @@ sub setup_logic_initial_conditions { 'sim_year'=>$nl_flags->{'sim_year'}, 'maxpft'=>$nl_flags->{'maxpft'}, 'more_vertlayers'=>$nl_flags->{'more_vert'}, 'glc_nec'=>$nl_flags->{'glc_nec'}, 'use_crop'=>$nl_flags->{'use_crop'}, - 'nu_com'=>$nl_flags->{'nu_com'}, + 'nu_com'=>$nu_com_val, 'irrigate'=>$nl_flags->{'irrigate'} ); } } elsif ($opts->{'ignore_ic_year'}) { @@ -2522,6 +2526,10 @@ sub setup_logic_initial_conditions { 'irrig'=>$nl_flags->{'irrig'}, 'glc_nec'=>$nl_flags->{'glc_nec'}, 'crop'=>$nl_flags->{'crop'}, 'bgc'=>$nl_flags->{'bgc_mode'} ); } else { + my $nu_com_val = $nl_flags->{'nu_com'}; + if ($nu_com_val eq "") { + $nu_com_val = "RD"; + } add_default($opts->{'test'}, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, $var, 'hgrid'=>$nl_flags->{'res'}, 'mask'=>$nl_flags->{'mask'}, 'ic_md'=>$ic_date, 'nofail'=>$nofail, 'flanduse_timeseries'=>$nl_flags->{'flanduse_timeseries'}, @@ -2532,7 +2540,7 @@ sub setup_logic_initial_conditions { 'sim_year'=>$nl_flags->{'sim_year'}, 'maxpft'=>$nl_flags->{'maxpft'}, 'more_vertlayers'=>$nl_flags->{'more_vert'}, 'glc_nec'=>$nl_flags->{'glc_nec'}, 'use_crop'=>$nl_flags->{'use_crop'}, - 'nu_com'=>$nl_flags->{'nu_com'}, + 'nu_com'=>$nu_com_val, 'irrigate'=>$nl_flags->{'irrigate'} ); } } else { @@ -2544,6 +2552,10 @@ sub setup_logic_initial_conditions { 'irrig'=>$nl_flags->{'irrig'}, 'glc_nec'=>$nl_flags->{'glc_nec'}, 'crop'=>$nl_flags->{'crop'}, 'bgc'=>$nl_flags->{'bgc_mode'} ); } else { + my $nu_com_val = $nl_flags->{'nu_com'}; + if ($nu_com_val eq "") { + $nu_com_val = "RD"; + } add_default($opts->{'test'}, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, $var, 'hgrid'=>$nl_flags->{'res'}, 'mask'=>$nl_flags->{'mask'}, 'ic_ymd'=>$ic_date, 'nofail'=>$nofail, 'flanduse_timeseries'=>$nl_flags->{'flanduse_timeseries'}, @@ -2554,7 +2566,7 @@ sub setup_logic_initial_conditions { 'sim_year'=>$nl_flags->{'sim_year'}, 'maxpft'=>$nl_flags->{'maxpft'}, 'more_vertlayers'=>$nl_flags->{'more_vert'}, 'glc_nec'=>$nl_flags->{'glc_nec'}, 'use_crop'=>$nl_flags->{'use_crop'}, - 'nu_com'=>$nl_flags->{'nu_com'}, + 'nu_com'=>$nu_com_val, 'irrigate'=>$nl_flags->{'irrigate'} ); } } From b53732437963214e77d08f8fca00d11c655e7724 Mon Sep 17 00:00:00 2001 From: Patrick Worley Date: Mon, 7 Aug 2017 19:14:08 -0400 Subject: [PATCH 57/68] Fix mistyping of variables New logical variables nan_check and inf_check were mistakenly declared as integer. --- cime/src/share/util/shr_reprosum_mod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/cime/src/share/util/shr_reprosum_mod.F90 b/cime/src/share/util/shr_reprosum_mod.F90 index c568cfe97b00..8e6e8f260993 100644 --- a/cime/src/share/util/shr_reprosum_mod.F90 +++ b/cime/src/share/util/shr_reprosum_mod.F90 @@ -339,7 +339,7 @@ subroutine shr_reprosum_calc (arr, arr_gsum, nsummands, dsummands, & logical :: validate ! flag indicating need to ! verify gmax and max_levels ! are accurate/sufficient - integer :: nan_check, inf_check ! flag on whether there are + logical :: nan_check, inf_check ! flag on whether there are ! NaNs and INFs in input array integer :: num_nans, num_infs ! count of NaNs and INFs in From f21ef4fb27f60835a74719f84247dc8fe14fc40a Mon Sep 17 00:00:00 2001 From: Jinyun Tang Date: Tue, 8 Aug 2017 10:31:29 -0700 Subject: [PATCH 58/68] bug fix for ibm and pgi compiler Now betr no longer reads in namelist from string, which seems to fix the failure from ibm and pgi comiplers. No changes to ALM are involved. --- components/clm/src/external_models/sbetr | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/components/clm/src/external_models/sbetr b/components/clm/src/external_models/sbetr index 9b5b814b4d35..0bec951eef22 160000 --- a/components/clm/src/external_models/sbetr +++ b/components/clm/src/external_models/sbetr @@ -1 +1 @@ -Subproject commit 9b5b814b4d351f18afd786684fa2a3e871e77d98 +Subproject commit 0bec951eef22abbb936373373e7c4072f5ba3633 From d98568161c8484b9295d56cf1b77230c2212054e Mon Sep 17 00:00:00 2001 From: noel Date: Wed, 9 Aug 2017 10:38:57 -0700 Subject: [PATCH 59/68] For all NERSC mmachines, add a `--compiler=intel18` option and continue making the machine settings more consistent. --- .../config/acme/machines/config_compilers.xml | 59 ++ cime/config/acme/machines/config_machines.xml | 512 +++++++++--------- 2 files changed, 326 insertions(+), 245 deletions(-) diff --git a/cime/config/acme/machines/config_compilers.xml b/cime/config/acme/machines/config_compilers.xml index b514dd6bc3c5..62e55049e406 100644 --- a/cime/config/acme/machines/config_compilers.xml +++ b/cime/config/acme/machines/config_compilers.xml @@ -300,7 +300,34 @@ for mct, etc. -cxxlib TRUE TRUE + + + -DFORTRANUNDERSCORE -DNO_R16 -DCPRINTEL + -qopenmp + -qopenmp + -qopenmp + -free + -fixed -132 + -O0 -g -check uninit -check bounds -check pointers -fpe0 -check noarg_temp_created + -O2 -debug minimal -qno-opt-dynamic-align + -O2 -debug minimal + -O0 -g + -convert big_endian -assume byterecl -ftz -traceback -assume realloc_lhs -fp-model source + -O2 -fp-model precise -std=gnu99 + -O0 + -qopenmp + -r8 + ifort + icc + icpc + mpif90 + mpicc + mpicxx + FORTRAN + -cxxlib + TRUE + TRUE @@ -593,6 +620,38 @@ for mct, etc. $(PETSC_DIR) + + + --host=Linux + -L$(NETCDF_DIR) -lnetcdff -Wl,--as-needed,-L$(NETCDF_DIR)/lib -lnetcdff -lnetcdf + -mkl -lpthread + ifort + icc + icpc + $(PETSC_DIR) + + + + --host=Linux + -L$(NETCDF_DIR) -lnetcdff -Wl,--as-needed,-L$(NETCDF_DIR)/lib -lnetcdff -lnetcdf + -mkl -lpthread + ifort + icc + icpc + $(PETSC_DIR) + + + + --host=Linux + -L$(NETCDF_DIR) -lnetcdff -Wl,--as-needed,-L$(NETCDF_DIR)/lib -lnetcdff -lnetcdf + -mkl -lpthread + -DARCH_MIC_KNL + ifort + icc + icpc + $(PETSC_DIR) + + -O2 -g -traceback -O0 -fpe0 -check all -check noarg_temp_created -ftrapuv diff --git a/cime/config/acme/machines/config_machines.xml b/cime/config/acme/machines/config_machines.xml index 87f5bf331fa7..77831c4707c9 100644 --- a/cime/config/acme/machines/config_machines.xml +++ b/cime/config/acme/machines/config_machines.xml @@ -55,12 +55,11 @@ This allows using a different mpirun command to launch unit tests --> - NERSC XC30, os is CNL, 24 pes/node, batch system is SLURM edison acme_developer - intel,gnu + intel,intel18,gnu mpt,mpi-serial $ENV{CSCRATCH}/acme_scratch/edison $CIME_OUTPUT_ROOT/$CASE/run @@ -128,12 +127,20 @@ intel/17.0.2.174 cray-libsci + + + PrgEnv-intel + intel + intel/2018.beta + cray-libsci + + + PrgEnv-intel PrgEnv-gnu gcc gcc/6.3.0 - cray-libsci - cray-libsci/17.06.1 + cray-libsci/16.09.1 @@ -170,276 +177,291 @@ spread threads yes + yes - Cori. XC40 Cray system at NERSC. Haswell partition. os is CNL, 32 pes/node, batch system is SLURM - cori - acme_developer - intel,gnu,cray - mpt,mpi-serial - $ENV{SCRATCH}/acme_scratch/cori-haswell - $CIME_OUTPUT_ROOT/$CASE/run - $CIME_OUTPUT_ROOT/$CASE/bld - /project/projectdirs/acme/inputdata - /project/projectdirs/acme/inputdata/atm/datm7 - $CIME_OUTPUT_ROOT/archive/$CASE - csm/$CASE - /project/projectdirs/acme/baselines - /project/projectdirs/acme/tools/cprnc.cori/cprnc - /project/projectdirs/$PROJECT - CNL - slurm - acme - 8 - 32 - 32 - acme - TRUE - -D PIO_BUILD_TIMING:BOOL=ON - - srun - - --label - -n $TOTALPES - - -c 2 - --cpu_bind=cores - - - - /opt/modules/default/init/perl - /opt/modules/default/init/python - /opt/modules/default/init/sh - /opt/modules/default/init/csh - /opt/modules/default/bin/modulecmd perl - /opt/modules/default/bin/modulecmd python - module - module + Cori. XC40 Cray system at NERSC. Haswell partition. os is CNL, 32 pes/node, batch system is SLURM + cori + acme_developer + intel,intel18,gnu + mpt,mpi-serial + $ENV{SCRATCH}/acme_scratch/cori-haswell + $CIME_OUTPUT_ROOT/$CASE/run + $CIME_OUTPUT_ROOT/$CASE/bld + /project/projectdirs/acme/inputdata + /project/projectdirs/acme/inputdata/atm/datm7 + $CIME_OUTPUT_ROOT/archive/$CASE + csm/$CASE + /project/projectdirs/acme/baselines + /project/projectdirs/acme/tools/cprnc.cori/cprnc + /project/projectdirs/$PROJECT + CNL + slurm + acme + 8 + 32 + 32 + acme + TRUE + -D PIO_BUILD_TIMING:BOOL=ON + + srun + + --label + -n $TOTALPES + + -c 2 + --cpu_bind=cores + + + + /opt/modules/default/init/perl + /opt/modules/default/init/python + /opt/modules/default/init/sh + /opt/modules/default/init/csh + /opt/modules/default/bin/modulecmd perl + /opt/modules/default/bin/modulecmd python + module + module - - PrgEnv-intel - PrgEnv-cray - PrgEnv-gnu - intel - cce - gcc - cray-parallel-netcdf - cray-parallel-hdf5 - pmi - cray-libsci - cray-mpich2 - cray-mpich - cray-netcdf - cray-hdf5 - cray-netcdf-hdf5parallel - craype-sandybridge - craype-ivybridge - craype - papi - cmake - cray-petsc - esmf - + + PrgEnv-intel + PrgEnv-cray + PrgEnv-gnu + intel + cce + gcc + cray-parallel-netcdf + cray-parallel-hdf5 + pmi + cray-libsci + cray-mpich2 + cray-mpich + cray-netcdf + cray-hdf5 + cray-netcdf-hdf5parallel + craype-sandybridge + craype-ivybridge + craype + papi + cmake + cray-petsc + esmf + - - craype - craype/2.5.7 - craype-haswell + + PrgEnv-intel + intel + intel/17.0.2.174 + craype + craype/2.5.7 + - - cray-mpich/7.5.3 - + + PrgEnv-intel + intel + intel/2018.beta + craype + craype/2.5.10 + - - PrgEnv-intel - intel - intel/17.0.2.174 - + + PrgEnv-intel + PrgEnv-gnu + gcc + gcc/6.3.0 + cray-libsci/16.09.1 + craype + craype/2.5.7 + - - PrgEnv-cray - cce cce/8.5.4 - - - PrgEnv-gnu - gcc gcc/6.3.0 - + + cray-mpich + cray-mpich/7.5.5 - - cray-libsci - cray-libsci/16.09.1 - + craype-mic-knl + craype-haswell + - - cray-netcdf-hdf5parallel - cray-hdf5-parallel - cray-parallel-netcdf - cray-hdf5/1.8.16 - cray-netcdf/4.4.0 - - - cray-netcdf-hdf5parallel - cray-netcdf-hdf5parallel/4.4.0 - cray-hdf5-parallel/1.8.16 - cray-parallel-netcdf/1.7.0 - - - git/2.9.1 - cmake/3.3.2 - pmi/5.0.10-1.0000.11069.183.8.ari - zlib/1.2.8 - - + + cray-netcdf-hdf5parallel + cray-hdf5-parallel + cray-parallel-netcdf + cray-hdf5/1.8.16 + cray-netcdf/4.4.0 + + + cray-netcdf-hdf5parallel + cray-netcdf-hdf5parallel/4.4.0 + cray-hdf5-parallel/1.8.16 + cray-parallel-netcdf/1.7.0 + - + + git/2.9.1 + cmake/3.3.2 + pmi/5.0.10-1.0000.11069.183.8.ari + zlib/1.2.8 + + - 1 - 1 - + - 128M - spread - threads - yes - + 1 + 1 + + + 128M + spread + threads + yes + yes + - Cori. XC40 Cray system at NERSC. KNL partition. os is CNL, 68 pes/node (for now only use 64), batch system is SLURM - cori-knl-haswell-is-default - acme_developer - intel,gnu,cray - mpt,mpi-serial - $ENV{SCRATCH}/acme_scratch/cori-knl - $CIME_OUTPUT_ROOT/$CASE/run - $CIME_OUTPUT_ROOT/$CASE/bld - /project/projectdirs/acme/inputdata - /project/projectdirs/acme/inputdata/atm/datm7 - $CIME_OUTPUT_ROOT/archive/$CASE - csm/$CASE - /project/projectdirs/acme/baselines - /project/projectdirs/acme/tools/cprnc.cori/cprnc - /project/projectdirs/$PROJECT - CNL - slurm - acme - 8 - 256 - 64 - acme - TRUE - -D PIO_BUILD_TIMING:BOOL=ON - - srun - - --label - -n $TOTALPES - - -c 4 - --cpu_bind=cores - - - - /opt/modules/default/init/perl - /opt/modules/default/init/python - /opt/modules/default/init/sh - /opt/modules/default/init/csh - /opt/modules/default/bin/modulecmd perl - /opt/modules/default/bin/modulecmd python - module - module - - intel - cce - gcc - cray-parallel-netcdf - cray-parallel-hdf5 - pmi - cray-libsci - cray-mpich2 - cray-mpich - cray-netcdf - cray-hdf5 - cray-netcdf-hdf5parallel - craype-sandybridge - craype-ivybridge - craype - cray-libsci - papi - cmake - cray-petsc - esmf - + Cori. XC40 Cray system at NERSC. KNL partition. os is CNL, 68 pes/node (for now only use 64), batch system is SLURM + cori-knl-haswell-is-default + acme_developer + intel,intel18,gnu + mpt,mpi-serial + $ENV{SCRATCH}/acme_scratch/cori-knl + $CIME_OUTPUT_ROOT/$CASE/run + $CIME_OUTPUT_ROOT/$CASE/bld + /project/projectdirs/acme/inputdata + /project/projectdirs/acme/inputdata/atm/datm7 + $CIME_OUTPUT_ROOT/archive/$CASE + csm/$CASE + /project/projectdirs/acme/baselines + /project/projectdirs/acme/tools/cprnc.cori/cprnc + /project/projectdirs/$PROJECT + CNL + slurm + acme + 8 + 256 + 64 + acme + TRUE + -D PIO_BUILD_TIMING:BOOL=ON + + srun + + --label + -n $TOTALPES + + -c 4 + --cpu_bind=cores + + + + /opt/modules/default/init/perl + /opt/modules/default/init/python + /opt/modules/default/init/sh + /opt/modules/default/init/csh + /opt/modules/default/bin/modulecmd perl + /opt/modules/default/bin/modulecmd python + module + module + + intel + cce + gcc + cray-parallel-netcdf + cray-parallel-hdf5 + pmi + cray-libsci + cray-mpich2 + cray-mpich + cray-netcdf + cray-hdf5 + cray-netcdf-hdf5parallel + craype-sandybridge + craype-ivybridge + craype + cray-libsci + papi + cmake + cray-petsc + esmf + - - PrgEnv-intel - intel - intel/17.0.2.174 - + + PrgEnv-intel + intel + intel/17.0.2.174 + craype + craype/2.5.7 + cray-mpich/7.4.4 + - - PrgEnv-intel - PrgEnv-cray - cce - cce/8.5.4 - - - PrgEnv-intel - PrgEnv-gnu - gcc - gcc/6.3.0 - - - cray-libsci/16.09.1 - + + PrgEnv-intel + intel + intel/2018.beta + craype + craype/2.5.10 + cray-mpich + cray-mpich/7.5.5 + - - craype - craype/2.5.7 + + PrgEnv-intel + PrgEnv-gnu + gcc + gcc/6.3.0 + cray-libsci/16.09.1 + craype + craype/2.5.7 + cray-mpich/7.4.4 + - craype-haswell - craype-mic-knl + + craype-haswell + craype-mic-knl + - cray-mpich/7.4.4 - + + cray-netcdf-hdf5parallel + cray-hdf5-parallel + cray-parallel-netcdf + cray-hdf5/1.8.16 + cray-netcdf/4.4.0 + + + cray-netcdf-hdf5parallel + cray-netcdf-hdf5parallel/4.4.0 + cray-hdf5-parallel/1.8.16 + cray-parallel-netcdf/1.7.0 + + + git/2.9.1 + cmake/3.3.2 + pmi/5.0.10-1.0000.11069.183.8.ari + zlib/1.2.8 + + - - cray-netcdf-hdf5parallel - cray-hdf5-parallel - cray-parallel-netcdf - cray-hdf5/1.8.16 - cray-netcdf/4.4.0 - - - cray-netcdf-hdf5parallel - cray-netcdf-hdf5parallel/4.4.0 - cray-hdf5-parallel/1.8.16 - cray-parallel-netcdf/1.7.0 - - - git/2.9.1 - cmake/3.3.2 - pmi/5.0.10-1.0000.11069.183.8.ari - zlib/1.2.8 - - + + 1 + 1 + - - 1 - 1 - + 128M + spread + threads - 128M - spread - threads + 1 - yes - + yes + yes + + From f8b3eada0f422f851796a3ef31dbb421fa22cdec Mon Sep 17 00:00:00 2001 From: Mark Taylor Date: Wed, 9 Aug 2017 13:07:30 -0600 Subject: [PATCH 60/68] fix incorrect settings for --npernode on skybridge --npernode was set to the number of cores per node, independent of the number of threads used, resulting in oversubscribed nodes. Updated skybridge environment now rejects these jobs (and we shouldn't run this way anyway). Also: remove duplicate sbatch setting (so this is only set in one place) added support for Intel Broadwell machine 'ghost' removed support for decomissioned redsky [BFB] --- cime/config/acme/machines/config_batch.xml | 18 ++--- .../config/acme/machines/config_compilers.xml | 5 +- cime/config/acme/machines/config_machines.xml | 72 ++++++++++++++++++- 3 files changed, 78 insertions(+), 17 deletions(-) diff --git a/cime/config/acme/machines/config_batch.xml b/cime/config/acme/machines/config_batch.xml index 74b0055e892a..76ec9506d09f 100644 --- a/cime/config/acme/machines/config_batch.xml +++ b/cime/config/acme/machines/config_batch.xml @@ -302,32 +302,24 @@ - - --ntasks-per-node={{ tasks_per_node }} - - ec + batch - - --ntasks-per-node={{ tasks_per_node }} - - ec + batch - - - --ntasks-per-node={{ tasks_per_node }} - + - ec + batch + -l nodes={{ num_nodes }}:ppn={{ tasks_per_node }} diff --git a/cime/config/acme/machines/config_compilers.xml b/cime/config/acme/machines/config_compilers.xml index b514dd6bc3c5..adfa7c8fe05c 100644 --- a/cime/config/acme/machines/config_compilers.xml +++ b/cime/config/acme/machines/config_compilers.xml @@ -702,18 +702,19 @@ for mct, etc. /projects/ccsm/AlbanyTrilinos_06262017/Albany/build/install - + -O2 -O2 $(NETCDFROOT) $(PNETCDFROOT) + /opt/openmpi-1.8-intel /projects/ccsm/esmf-6.3.0rp1/lib/libO/Linux.intel.64.openmpi.default --host=Linux $(shell $(NETCDF_PATH)/bin/nf-config --flibs) -L/projects/ccsm/BLAS-intel -lblas_LINUX lustre -mkl=cluster -mkl - /projects/ccsm/AlbanyTrilinos/Albany/build/install + /projects/ccsm/AlbanyTrilinos_06262017/Albany/build/install diff --git a/cime/config/acme/machines/config_machines.xml b/cime/config/acme/machines/config_machines.xml index 87f5bf331fa7..2ae5ae473c10 100644 --- a/cime/config/acme/machines/config_machines.xml +++ b/cime/config/acme/machines/config_machines.xml @@ -710,7 +710,7 @@ --bind-to-core --n $TOTALPES - --npernode $PES_PER_NODE + --npernode {{tasks_per_node}} @@ -778,7 +778,7 @@ --bind-to-core --n $TOTALPES - --npernode $PES_PER_NODE + --npernode {{tasks_per_node}} @@ -827,6 +827,74 @@ + + SNL clust + ghost-login + wwwproxy.sandia.gov:80 + acme_integration + intel + openmpi,mpi-serial + LINUX + /gscratch/$USER/acme_scratch/ghost + $CIME_OUTPUT_ROOT/$CASE/run + $CIME_OUTPUT_ROOT/$CASE/bld + /projects/ccsm/inputdata + /projects/ccsm/inputdata/atm/datm7 + $CIME_OUTPUT_ROOT/archive/$CASE + USERDEFINED_optional_run + /projects/ccsm/ccsm_baselines + /projects/ccsm/cprnc/build.toss3/cprnc_wrap + slurm + jgfouca at sandia dot gov + 8 + 36 + 36 + 1 + TRUE + fy150001 + + + mpiexec + + --bind-to-core + --n $TOTALPES + --npernode {{tasks_per_node}} + + + + + + + /usr/share/lmod/lmod/init/python.py + /usr/share/lmod/lmod/init/perl.pm + /usr/share/lmod/lmod/init/sh + /usr/share/lmod/lmod/init/csh + /usr/share/lmod/lmod/libexec/lmod python + /usr/share/lmod/lmod/libexec/lmod perl + module + module + + + sems-env + sems-git + sems-python/2.7.9 + sems-cmake + gnu/4.9.2 + sems-intel/16.0.2 + sems-openmpi/1.10.5 + mkl/16.0 + sems-netcdf/4.4.1/exo_parallel + + + + $ENV{SEMS_NETCDF_ROOT} + $ENV{SEMS_NETCDF_ROOT} + $ENV{SEMS_NETCDF_ROOT}/include + $ENV{SEMS_NETCDF_ROOT}/lib + 64M + + + ANL/LCRC Linux Cluster blogin.*.lcrc.anl.gov From 07c01d1631b83a5c9eebd2e0fe149266b54cfec9 Mon Sep 17 00:00:00 2001 From: Mark Taylor Date: Wed, 9 Aug 2017 15:59:01 -0600 Subject: [PATCH 61/68] bug fix: needed spaces {{ }} CIME syntax --- cime/config/acme/machines/config_machines.xml | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/cime/config/acme/machines/config_machines.xml b/cime/config/acme/machines/config_machines.xml index 2ae5ae473c10..58dec3cfc3f3 100644 --- a/cime/config/acme/machines/config_machines.xml +++ b/cime/config/acme/machines/config_machines.xml @@ -710,7 +710,7 @@ --bind-to-core --n $TOTALPES - --npernode {{tasks_per_node}} + --npernode {{ tasks_per_node }} @@ -778,7 +778,7 @@ --bind-to-core --n $TOTALPES - --npernode {{tasks_per_node}} + --npernode {{ tasks_per_node }} @@ -858,7 +858,7 @@ --bind-to-core --n $TOTALPES - --npernode {{tasks_per_node}} + --npernode {{ tasks_per_node }} From 7580b6c995fb10c1a2f8f3875a35efa25abfe88e Mon Sep 17 00:00:00 2001 From: Mark Taylor Date: Wed, 9 Aug 2017 17:22:22 -0600 Subject: [PATCH 62/68] replacing --npernode with mapping arguments copied from Anvil [BFB] --- cime/config/acme/machines/config_machines.xml | 9 +++------ 1 file changed, 3 insertions(+), 6 deletions(-) diff --git a/cime/config/acme/machines/config_machines.xml b/cime/config/acme/machines/config_machines.xml index 58dec3cfc3f3..737968149d0d 100644 --- a/cime/config/acme/machines/config_machines.xml +++ b/cime/config/acme/machines/config_machines.xml @@ -708,9 +708,8 @@ mpiexec - --bind-to-core --n $TOTALPES - --npernode {{ tasks_per_node }} + --map-by ppr:{{ tasks_per_numa }}:socket:PE=$ENV{OMP_NUM_THREADS} --bind-to core @@ -776,9 +775,8 @@ mpiexec - --bind-to-core --n $TOTALPES - --npernode {{ tasks_per_node }} + --map-by ppr:{{ tasks_per_numa }}:socket:PE=$ENV{OMP_NUM_THREADS} --bind-to core @@ -856,9 +854,8 @@ mpiexec - --bind-to-core --n $TOTALPES - --npernode {{ tasks_per_node }} + --map-by ppr:{{ tasks_per_numa }}:socket:PE=$ENV{OMP_NUM_THREADS} --bind-to core From 07c1b1c2ecf5eadd5550c6c02e15b84c6371b2e3 Mon Sep 17 00:00:00 2001 From: noel Date: Fri, 11 Aug 2017 08:13:19 -0700 Subject: [PATCH 63/68] After Cori maintenance in August 2017, some modules needed to be updated. Update craype, cray-mpich, pmi for cori-knl and cori-haswell. With cori-knl there are some apparent module bugs that I am working around to allow for the intel18 option. --- .../config/acme/machines/config_compilers.xml | 2 + cime/config/acme/machines/config_machines.xml | 73 +++++++++++-------- 2 files changed, 43 insertions(+), 32 deletions(-) diff --git a/cime/config/acme/machines/config_compilers.xml b/cime/config/acme/machines/config_compilers.xml index 62e55049e406..ac07257c90f3 100644 --- a/cime/config/acme/machines/config_compilers.xml +++ b/cime/config/acme/machines/config_compilers.xml @@ -635,6 +635,8 @@ for mct, etc. --host=Linux -L$(NETCDF_DIR) -lnetcdff -Wl,--as-needed,-L$(NETCDF_DIR)/lib -lnetcdff -lnetcdf -mkl -lpthread + + ifort icc icpc diff --git a/cime/config/acme/machines/config_machines.xml b/cime/config/acme/machines/config_machines.xml index 77831c4707c9..a2bae974b7e2 100644 --- a/cime/config/acme/machines/config_machines.xml +++ b/cime/config/acme/machines/config_machines.xml @@ -121,6 +121,16 @@ esmf + + craype + craype/2.5.12.3 + craype-ivybridge + pmi + pmi/5.0.12 + cray-mpich + cray-mpich/7.6.0 + + PrgEnv-intel intel @@ -140,17 +150,8 @@ PrgEnv-gnu gcc gcc/6.3.0 - cray-libsci/16.09.1 - - - - cray-mpich/7.6.0 - - craype - craype/2.5.12.3 - craype-ivybridge - pmi - pmi/5.0.12 + cray-libsci + cray-libsci/17.06.1 @@ -252,20 +253,25 @@ esmf + + craype + craype/2.5.12 + pmi/5.0.12 + + cray-mpich + cray-mpich/7.6.0 + + PrgEnv-intel intel intel/17.0.2.174 - craype - craype/2.5.7 PrgEnv-intel intel intel/2018.beta - craype - craype/2.5.10 @@ -273,20 +279,14 @@ PrgEnv-gnu gcc gcc/6.3.0 - cray-libsci/16.09.1 - craype - craype/2.5.7 + cray-libsci/17.06.1 - cray-mpich - cray-mpich/7.5.5 - craype-mic-knl craype-haswell - cray-netcdf-hdf5parallel cray-hdf5-parallel @@ -304,7 +304,6 @@ git/2.9.1 cmake/3.3.2 - pmi/5.0.10-1.0000.11069.183.8.ari zlib/1.2.8 @@ -396,18 +395,25 @@ intel intel/17.0.2.174 craype - craype/2.5.7 - cray-mpich/7.4.4 + craype/2.5.12 + cray-mpich + cray-mpich/7.6.0 + PrgEnv-intel intel - intel/2018.beta + intel/17.0.2.174 + craype - craype/2.5.10 + craype/2.5.12 cray-mpich - cray-mpich/7.5.5 + cray-mpich/7.6.0 + + PrgEnv-intel + intel + intel/2018.beta @@ -415,13 +421,17 @@ PrgEnv-gnu gcc gcc/6.3.0 - cray-libsci/16.09.1 + cray-libsci/17.06.1 + craype - craype/2.5.7 - cray-mpich/7.4.4 + craype/2.5.12 + cray-mpich + cray-mpich/7.6.0 + pmi + pmi/5.0.12 craype-haswell craype-mic-knl @@ -442,7 +452,6 @@ git/2.9.1 cmake/3.3.2 - pmi/5.0.10-1.0000.11069.183.8.ari zlib/1.2.8 From b7d532d53e287f3b40eac7cdea82d618ab72b083 Mon Sep 17 00:00:00 2001 From: James Foucar Date: Tue, 15 Aug 2017 12:06:03 -0600 Subject: [PATCH 64/68] Update chama env settings Chama was recently upgraded to TOSS3 [BFB] --- cime/config/acme/machines/config_machines.xml | 30 ++++++------------- 1 file changed, 9 insertions(+), 21 deletions(-) diff --git a/cime/config/acme/machines/config_machines.xml b/cime/config/acme/machines/config_machines.xml index 6419766d4b58..539a4939abf3 100644 --- a/cime/config/acme/machines/config_machines.xml +++ b/cime/config/acme/machines/config_machines.xml @@ -814,12 +814,12 @@ - /usr/share/Modules/init/python.py - /usr/share/Modules/init/perl.pm - /usr/share/Modules/init/sh - /usr/share/Modules/init/csh - /usr/bin/modulecmd python - /usr/bin/modulecmd perl + /usr/share/lmod/lmod/init/python.py + /usr/share/lmod/lmod/init/perl.pm + /usr/share/lmod/lmod/init/sh + /usr/share/lmod/lmod/init/csh + /usr/share/lmod/lmod/libexec/lmod python + /usr/share/lmod/lmod/libexec/lmod perl module module @@ -829,25 +829,13 @@ sems-python/2.7.9 sems-cmake gnu/4.9.2 - intel/intel-15.0.3.187 - openmpi-intel/1.6 - libraries/intel-mkl-15.0.2.164 + sems-intel/16.0.2 + sems-openmpi/1.10.5 + mkl/16.0 sems-netcdf/4.4.1/exo_parallel - - - - - - - - - - - - $ENV{SEMS_NETCDF_ROOT} $ENV{SEMS_NETCDF_ROOT} $ENV{SEMS_NETCDF_ROOT}/include From 4f56630caf4200a2760e680f8a4b172ff638a2d3 Mon Sep 17 00:00:00 2001 From: Michael Deakin Date: Mon, 7 Aug 2017 11:56:01 -0500 Subject: [PATCH 65/68] Change exit to a warning for when stop_num != restart_num --- run_acme.template.csh | 22 ++++++++++++---------- 1 file changed, 12 insertions(+), 10 deletions(-) diff --git a/run_acme.template.csh b/run_acme.template.csh index d3585275c02f..8d57e211ac3a 100755 --- a/run_acme.template.csh +++ b/run_acme.template.csh @@ -267,6 +267,8 @@ endif # BASIC ERROR CHECKING #=========================================== +set seconds_after_warning = 10 + if ( `lowercase $old_executable` == true ) then if ( $seconds_before_delete_source_dir >= 0 ) then acme_newline @@ -297,6 +299,15 @@ if ( `lowercase $case_run_dir` == default && $seconds_before_delete_run_dir >= 0 exit 15 endif +if ( `lowercase $debug_queue` == true && ( $num_resubmits >= 1 || `lowercase $do_short_term_archiving` == true ) ) then + acme_print 'ERROR: Supercomputer centers generally do not allow job chaining in debug queues' + acme_print ' You should either use a different queue, or submit a single job without archiving.' + acme_print ' $debug_queue = '$debug_queue + acme_print ' $num_resubmits = '$num_resubmits + acme_print ' $do_short_term_archiving = '$do_short_term_archiving + exit 16 +endif + if ( $num_resubmits >= 1 && ( $stop_units != $restart_units || $stop_num != $restart_num ) ) then acme_print 'WARNING: It makes no sense to have chained submissions unless the run is producing appropriate restarts!' acme_print ' The run length and restarts do not match exactly. ' @@ -307,16 +318,7 @@ if ( $num_resubmits >= 1 && ( $stop_units != $restart_units || $stop_num != $res acme_print ' $restart_units = '$restart_units acme_print ' $restart_num = '$restart_num acme_print ' $num_resubmits = '$num_resubmits - exit 16 -endif - -if ( `lowercase $debug_queue` == true && ( $num_resubmits >= 1 || `lowercase $do_short_term_archiving` == true ) ) then - acme_print 'ERROR: Supercomputer centers generally do not allow job chaining in debug queues' - acme_print ' You should either use a different queue, or submit a single job without archiving.' - acme_print ' $debug_queue = '$debug_queue - acme_print ' $num_resubmits = '$num_resubmits - acme_print ' $do_short_term_archiving = '$do_short_term_archiving - exit 17 + sleep $seconds_after_warning endif #=========================================== From 4432b40c105d31195dd7306b7378a95f0d69359e Mon Sep 17 00:00:00 2001 From: Michael Deakin Date: Mon, 7 Aug 2017 12:07:32 -0500 Subject: [PATCH 66/68] Update version number and changelog --- run_acme.template.csh | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/run_acme.template.csh b/run_acme.template.csh index 8d57e211ac3a..ca70de13e126 100755 --- a/run_acme.template.csh +++ b/run_acme.template.csh @@ -210,7 +210,7 @@ set cpl_hist_num = 1 #=========================================== # VERSION OF THIS SCRIPT #=========================================== -set script_ver = 3.0.12 +set script_ver = 3.0.14 #=========================================== # DEFINE ALIASES @@ -1355,6 +1355,7 @@ acme_newline # 3.0.10 2017-06-14 To allow data-atm compsets to work, I added a test for CAM_CONFIG_OPTS. (PJC) # 3.0.11 2017-07-14 Replace auto-chaining code with ACME's resubmit feature. Also fix Edison's qos setting (again...) (MD) # 3.0.12 2017-07-24 Supports setting the queue priority for anvil. Also move making machine lowercase up to clean some things up (MD) +# 3.0.14 2017-08-07 Change the exit to a sleep for the warning where stop_num != restart_num (MD) # # NOTE: PJC = Philip Cameron-Smith, PMC = Peter Caldwell, CG = Chris Golaz, MD = Michael Deakin From 2dd3bad07ef7bfa9a33ef09160ad6d250bcfe574 Mon Sep 17 00:00:00 2001 From: Michael Deakin Date: Mon, 7 Aug 2017 14:22:19 -0500 Subject: [PATCH 67/68] Verify that the number of overlapping periods is 0, rather than that stop_num matches restart_num --- run_acme.template.csh | 24 +++++++++++++----------- 1 file changed, 13 insertions(+), 11 deletions(-) diff --git a/run_acme.template.csh b/run_acme.template.csh index ca70de13e126..bfba2a7c7141 100755 --- a/run_acme.template.csh +++ b/run_acme.template.csh @@ -308,17 +308,19 @@ if ( `lowercase $debug_queue` == true && ( $num_resubmits >= 1 || `lowercase $do exit 16 endif -if ( $num_resubmits >= 1 && ( $stop_units != $restart_units || $stop_num != $restart_num ) ) then - acme_print 'WARNING: It makes no sense to have chained submissions unless the run is producing appropriate restarts!' - acme_print ' The run length and restarts do not match exactly. ' - acme_print ' It is hard to check definitively, so stopping just in case.' - acme_print ' If the settings are OK then deactivate this test.' - acme_print ' $stop_units = '$stop_units - acme_print ' $stop_num = '$stop_num - acme_print ' $restart_units = '$restart_units - acme_print ' $restart_num = '$restart_num - acme_print ' $num_resubmits = '$num_resubmits - sleep $seconds_after_warning +if ( $restart_num != 0 ) then + @ remaining_periods = $stop_num - ( $stop_num / $restart_num ) * $restart_num + if ( $num_resubmits >= 1 && ( $stop_units != $restart_units || $remaining_periods != 0 ) ) then + acme_print 'WARNING: run length is not divisible by the restart write frequency, or the units differ.' + acme_print 'If restart write frequency doesnt evenly divide the run length, restarts will simulate the same time period multiple times.' + acme_print ' $stop_units = '$stop_units + acme_print ' $stop_num = '$stop_num + acme_print ' $restart_units = '$restart_units + acme_print ' $restart_num = '$restart_num + acme_print ' $remaining_periods = '$remaining_periods + acme_print ' $num_resubmits = '$num_resubmits + sleep $seconds_after_warning + endif endif #=========================================== From 0952bbdd4a0dec565bd34380d902bd8807196db6 Mon Sep 17 00:00:00 2001 From: Michael Deakin Date: Mon, 7 Aug 2017 14:25:07 -0500 Subject: [PATCH 68/68] Update the version changelog, and add the improved cori check --- run_acme.template.csh | 11 ++++++----- 1 file changed, 6 insertions(+), 5 deletions(-) diff --git a/run_acme.template.csh b/run_acme.template.csh index bfba2a7c7141..8c08114e782d 100755 --- a/run_acme.template.csh +++ b/run_acme.template.csh @@ -210,7 +210,7 @@ set cpl_hist_num = 1 #=========================================== # VERSION OF THIS SCRIPT #=========================================== -set script_ver = 3.0.14 +set script_ver = 3.0.13 #=========================================== # DEFINE ALIASES @@ -772,7 +772,7 @@ endif # https://acme-climate.atlassian.net/wiki/display/WORKFLOW/ACME+Input+Data+Repository #set input_data_dir = 'input_data_dir_NOT_SET' -#if ( $machine == 'cori' || $machine == 'edison' ) then +#if ( $machine == 'cori*' || $machine == 'edison' ) then # set input_data_dir = '/project/projectdirs/m411/ACME_inputdata' # PJC-NERSC ## set input_data_dir = '/project/projectdirs/ccsm1/inputdata' # NERSC #else if ( $machine == 'titan' || $machine == 'eos' ) then @@ -1013,7 +1013,7 @@ mkdir -p batch_output ### Make directory that stdout and stderr will go int set batch_options = '' -if ( $machine == cori || $machine == edison ) then +if ( $machine =~ 'cori*' || $machine == edison ) then set batch_options = "--job-name=${job_name} --output=batch_output/${case_name}.o%j" sed -i /"#SBATCH \( \)*--job-name"/c"#SBATCH --job-name=ST+${job_name}" $shortterm_archive_script @@ -1205,7 +1205,7 @@ endif #NOTE: This section is for making specific changes to the run options (ie env_run.xml). -#if ( $machine == cori ) then ### fix pnetcdf problem on Cori. (github #593) +#if ( $machine == 'cori*' ) then ### fix pnetcdf problem on Cori. (github #593) # $xmlchange_exe --id PIO_TYPENAME --val "netcdf" #endif @@ -1357,7 +1357,8 @@ acme_newline # 3.0.10 2017-06-14 To allow data-atm compsets to work, I added a test for CAM_CONFIG_OPTS. (PJC) # 3.0.11 2017-07-14 Replace auto-chaining code with ACME's resubmit feature. Also fix Edison's qos setting (again...) (MD) # 3.0.12 2017-07-24 Supports setting the queue priority for anvil. Also move making machine lowercase up to clean some things up (MD) -# 3.0.14 2017-08-07 Change the exit to a sleep for the warning where stop_num != restart_num (MD) +# 3.0.13 2017-08-07 Verify that the number of periods between a restart evenly divides the number until the stop with the same units. +# Update the machine check for cori to account for cori-knl (MD) # # NOTE: PJC = Philip Cameron-Smith, PMC = Peter Caldwell, CG = Chris Golaz, MD = Michael Deakin