diff --git a/.config_files.xml b/.config_files.xml
index e07f99db..22860601 100644
--- a/.config_files.xml
+++ b/.config_files.xml
@@ -5,19 +5,19 @@
char
unset
- $SRCROOT
+ $SRCROOT
$CIMEROOT/src/components/data_comps/dlnd
$CIMEROOT/src/components/stub_comps/slnd
$CIMEROOT/src/components/xcpl_comps/xlnd
diff --git a/.gitignore b/.gitignore
index 5f93baa3..85538e29 100644
--- a/.gitignore
+++ b/.gitignore
@@ -33,3 +33,8 @@ core.*
*.gz
*.log !run.log
*.pyc
+
+# buildnml testing
+cime_config/buildnml_test/run
+cime_config/buildnml_test/Buildconf
+cime_config/buildnml_test/buildnml.log
diff --git a/Externals.cfg b/Externals.cfg
index 68aec40a..42b9ebf8 100644
--- a/Externals.cfg
+++ b/Externals.cfg
@@ -1,7 +1,6 @@
[slm]
local_path = .
protocol = externals_only
-externals = Externals_SLIM.cfg
required = True
[cam]
@@ -19,18 +18,12 @@ repo_url = https://github.com/ESCOMP/CESM_CICE5
local_path = components/cice
required = True
-[rtm]
-tag = release-cesm2.0.04
-protocol = git
-repo_url = https://github.com/ESCOMP/rtm
-local_path = components/rtm
-required = True
-
[cime]
local_path = cime
protocol = git
-repo_url = https://github.com/ESMCI/cime
-tag = cime5.6.39
+repo_url = https://github.com/ekluzek/cime
+hash = 25ba7866ec4835b148aac9f83242d0bc6257da5e
+#branch = add_slim_comp
required = True
[externals_description]
diff --git a/Externals_SLIM.cfg b/Externals_SLIM.cfg
deleted file mode 100644
index 31b2036d..00000000
--- a/Externals_SLIM.cfg
+++ /dev/null
@@ -1,3 +0,0 @@
-[externals_description]
-schema_version = 1.0.0
-
diff --git a/README b/README
index 45f7759c..441333ec 100644
--- a/README
+++ b/README
@@ -3,19 +3,47 @@ Important files in main directories:
=============================================================================================
Externals.cfg --------------- File for management of the main high level externals
-Externals_CLM.cfg ----------- File for management of the CLM specific externals (i.e. FATES)
-bld/configure --------------- Script to prepare CLM to be built.
+=============================================================================================
+Important main subdirectories
+=============================================================================================
+
+src --------------- SLIM Source code.
+tools ------------- SLIM Offline tools to prepare input datasets and process output.
+cime_config ------- Configuration files of cime for compsets and SLIM settings
+manage_externals -- Script to manage the external source directories
+py_env_create ----- Script to setup the python environment for SLIM python tools using conda
+python ------------ Some python modules
+components -------- Other active sub-components needed for SLIM to run (CAM and CICE)
+libraries --------- CESM libraries: MCT (Model Coupling Toolkit) and PIO
+share ------------- CESM shared code
+
+cime/scripts --------------- cesm/cime driver scripts
+
+=============================================================================================
+ SLIM XML variables:
+=============================================================================================
+
+SLIM_SCENARIO: Scenario to use, usually set by the compset
+SLIM_START_TYPE: The start type to use, usually set by the RUN_TYPE
+
+=============================================================================================
+ SLIM important namelist items:
+=============================================================================================
+
+mml_surdat -- Dataset of surface characteristics to use (usually set by the compset/grid)
+finidat ----- Initial conditions to startup with
+hist_nhtfrq - History file frequency of output
=============================================================================================
- QUICKSTART: using the CPL7 scripts:
+ QUICKSTART: using the CPL7 scripts:
=============================================================================================
cd cime/scripts
./create_newcase # get help on how to run create_newcase
- ./create_newcase --case testI --res f19_g16 --compset I2000Clm50BgcCrop --mach cheyenne
+ ./create_newcase --case testI --res f19_f19_mg17 --compset I2000SlimRsGs
# create new "I" case for cheyenne_intel at 1.9x2.5_gx1v7 res
- # "I2000Clm50BgcCrop" case is clm5_0 active, datm8, and inactive ice/ocn
+ # "I2000SlimRsGs" case is SLIM active, datm8, and inactive ice/ocn/glc/rof
cd testI
./case.setup # create the $CASE.run file
./case.build # build model and create namelists
diff --git a/README.md b/README.md
index ce4662c6..b6b70e57 100644
--- a/README.md
+++ b/README.md
@@ -2,7 +2,8 @@
Simple Land Model for CESM
-For instructions on how to run SLIM on it's own or coupled to CESM on Cheyenne, see the Wiki.
+For instructions on how to run SLIM on it's own or coupled to CESM on Cheyenne, see the Wiki, and the README file at the top of the
+SLIM checkout.
To cite, please use:
diff --git a/README.rst b/README.rst
index 1a3ae810..4ee39b82 100644
--- a/README.rst
+++ b/README.rst
@@ -1,3 +1,5 @@
================
SimpleLandModel
================
+
+SLIM the Simple Land Interface Model coupled to CESM2
diff --git a/README.testing b/README.testing
index b4217de3..c328cf94 100644
--- a/README.testing
+++ b/README.testing
@@ -2,6 +2,8 @@
#
# The test list "aux_slim" is run as a test suite with the "create_test" script under cime/scripts
# as follows.
+# NOTE: There are also tests for prealpha, prebeta for use with CESM testing
+# And slim_sci to run a few standard tests for SLIM science
#
# Tests on cheyenne
@@ -24,6 +26,4 @@ nohup ./create_test --compare --generate mac
nohup ./create_test --compare --generate machine izumi -r cases \
--xml-category aux_slim --xml-machine izumi --xml-compiler gnu &
nohup ./create_test --compare --generate machine izumi -r cases \
---xml-category aux_slim --xml-machine izumi --xml-compiler pgi &
-nohup ./create_test --compare --generate machine izumi -r cases \
--xml-category aux_slim --xml-machine izumi --xml-compiler intel &
diff --git a/bld/CESM_cppdefs b/bld/CESM_cppdefs
deleted file mode 100644
index 8d1c8b69..00000000
--- a/bld/CESM_cppdefs
+++ /dev/null
@@ -1 +0,0 @@
-
diff --git a/bld/CLMBuildNamelist.pm b/bld/CLMBuildNamelist.pm
deleted file mode 100644
index 458b8daa..00000000
--- a/bld/CLMBuildNamelist.pm
+++ /dev/null
@@ -1,2462 +0,0 @@
-# build-namelist
-#
-# This script builds the namelists for CLM
-#
-# The simplest use of build-namelist is to execute it from the build directory where configure
-# was run. By default it will use the config_cache.xml file that was written by configure to
-# determine the build time properties of the executable, and will write the files that contain
-# the output namelists in that same directory. But if multiple runs are to made using the
-# same executable, successive invocations of build-namelist will overwrite previously generated
-# namelist files. So generally the best strategy is to invoke build-namelist from the run
-# directory and use the -config option to provide the filepath of the config_cache.xml file.
-#
-#
-# Date Contributor Modification
-# -------------------------------------------------------------------------------------------
-# 2009-01-20 Vertenstein Original version
-# 2010-04-27 Kluzek Add ndep streams capability
-# 2011-07-25 Kluzek Add multiple ensemble's of namelists
-# 2012-03-23 Kluzek Add megan namelist and do checking on it
-# 2012-07-01 Kluzek Add some common CESM namelist options
-# 2013-12 Andre Refactor everything into subroutines
-# 2013-12 Muszala Add Ecosystem Demography functionality
-# 2017-08-17 Lague Add namelist options for simple land model (MML)
-#--------------------------------------------------------------------------------------------
-
-package CLMBuildNamelist;
-
-require 5;
-
-use strict;
-#use warnings;
-#use diagnostics;
-
-use Cwd qw(getcwd abs_path);
-use File::Basename qw(dirname);
-use English;
-use Getopt::Long;
-use IO::File;
-use File::Glob ':glob';
-
-#-------------------------------------------------------------------------------
-#
-# Define a small number of global variables
-#
-#-------------------------------------------------------------------------------
-
-(my $ProgName = $0) =~ s!(.*)/!!; # name of this script
-my $ProgDir = $1;
-$ProgName = "CLM " . "$ProgName";
-
-my $cwd = abs_path(getcwd()); # absolute path of the current working directory
-my $log; # Log messages object -- will be set in main, declaring it global here means it can be used everywhere
-
-#-------------------------------------------------------------------------------
-
-sub usage {
- die < Glacier number of elevation classes [0 | 3 | 5 | 10 | 36]
- (default is 0) (standard option with land-ice model is 10)
- -help [or -h] Print usage to STDOUT.
- -ignore_ic_date Ignore the date on the initial condition files
- when determining what input initial condition file to use.
- -ignore_ic_year Ignore just the year part of the date on the initial condition files
- when determining what input initial condition file to use.
- -ignore_warnings Allow build-namelist to continue, rather than stopping on
- warnings
- -infile "filepath" Specify a file (or list of files) containing namelists to
- read values from.
-
- If used with a CLM build with multiple ensembles (ninst_lnd>1)
- and the filename entered is a directory to files of the
- form filepath/filepath and filepath/filepath_\$n where \$n
- is the ensemble member number. the "filepath/filepath"
- input namelist file is the master input namelist file
- that is applied to ALL ensemble members.
-
- (by default for CESM this is setup for files of the
- form \$CASEDIR/user_nl_clm/user_nl_clm_????)
- -inputdata "filepath" Writes out a list containing pathnames for required input datasets in
- file specified.
- -l_ncpl "LND_NCPL" Number of CLM coupling time-steps in a day.
- -mask "landmask" Type of land-mask (default, navy, gx3v5, gx1v5 etc.)
- "-mask list" to list valid land masks.
- -namelist "namelist" Specify namelist settings directly on the commandline by supplying
- a string containing FORTRAN namelist syntax, e.g.,
- -namelist "&clm_inparm dt=1800 /"
- -[no-]note Add note to output namelist [do NOT add note] about the
- arguments to build-namelist.
- -output_reals Output real parameters to the given output file.
- -rcp "value" Representative concentration pathway (rcp) to use for
- future scenarios.
- "-rcp list" to list valid rcp settings.
- -s Turns on silent mode - only fatal messages issued.
- -test Enable checking that input datasets exist on local filesystem.
- -use_case "case" Specify a use case which will provide default values.
- "-use_case list" to list valid use-cases.
- -verbose [or -v] Turn on verbose echoing of informational messages.
- -version Echo the SVN tag name used to check out this CLM distribution.
-
-
-Note: The precedence for setting the values of namelist variables is (highest to lowest):
- 0. namelist values set by specific command-line options, like, -d, -sim_year
- (i.e. compset choice and CLM_BLDNML_OPTS, CLM_ACCELERATED_SPINUP, LND_TUNING_MODE env_run variables)
- (NOTE: If you try to contradict these settings by methods below, an error will be triggered)
- 1. values set on the command-line using the -namelist option,
- (i.e. CLM_NAMELIST_OPTS env_run variable)
- 2. values read from the file(s) specified by -infile,
- (i.e. user_nl_clm files)
- 4. values set from a use-case scenario, e.g., -use_case
- (i.e. CLM_NML_USE_CASE env_run variable)
- 5. values from the namelist defaults file.
-EOF
-}
-
-#-------------------------------------------------------------------------------
-
-sub process_commandline {
- # Process command-line options and return the hash
- my ($nl_flags) = @_;
-
- # Save the command line arguments to the script. NOTE: this must be
- # before GetOptions() is called because items are removed from from
- # the array!
- $nl_flags->{'cmdline'} = "@ARGV";
-
- my %opts = ( cimeroot => undef,
- config => "config_cache.xml",
- csmdata => undef,
- co2_type => undef,
- co2_ppmv => undef,
- clm_demand => "null",
- help => 0,
- glc_nec => "default",
- l_ncpl => undef,
- lnd_frac => undef,
- dir => "$cwd",
- rcp => "default",
- sim_year => "default",
- chk_res => undef,
- note => undef,
- output_reals_filename => undef,
- res => "default",
- silent => 0,
- ignore_warnings => 0,
- mask => "default",
- test => 0,
- bgc => "default",
- envxml_dir => ".",
- maxpft => "default",
- );
-
- GetOptions(
- "cimeroot=s" => \$opts{'cimeroot'},
- "clm_demand=s" => \$opts{'clm_demand'},
- "co2_ppmv=f" => \$opts{'co2_ppmv'},
- "co2_type=s" => \$opts{'co2_type'},
- "config=s" => \$opts{'config'},
- "csmdata=s" => \$opts{'csmdata'},
- "envxml_dir=s" => \$opts{'envxml_dir'},
- "ignore_warnings!" => \$opts{'ignore_warnings'},
- "chk_res!" => \$opts{'chk_res'},
- "note!" => \$opts{'note'},
- "glc_nec=i" => \$opts{'glc_nec'},
- "d:s" => \$opts{'dir'},
- "h|help" => \$opts{'help'},
- "ignore_ic_date" => \$opts{'ignore_ic_date'},
- "ignore_ic_year" => \$opts{'ignore_ic_year'},
- "infile=s" => \$opts{'infile'},
- "lnd_frac=s" => \$opts{'lnd_frac'},
- "l_ncpl=i" => \$opts{'l_ncpl'},
- "inputdata=s" => \$opts{'inputdata'},
- "mask=s" => \$opts{'mask'},
- "namelist=s" => \$opts{'namelist'},
- "res=s" => \$opts{'res'},
- "rcp=s" => \$opts{'rcp'},
- "s|silent" => \$opts{'silent'},
- "sim_year=s" => \$opts{'sim_year'},
- "output_reals=s" => \$opts{'output_reals_filename'},
- "clm_start_type=s" => \$opts{'clm_start_type'},
- "test" => \$opts{'test'},
- "use_case=s" => \$opts{'use_case'},
- "bgc=s" => \$opts{'bgc'},
- "maxpft=i" => \$opts{'maxpft'},
- "v|verbose" => \$opts{'verbose'},
- "version" => \$opts{'version'},
- ) or usage();
-
- # Give usage message.
- usage() if $opts{'help'};
-
- # Check for unparsed arguments
- if (@ARGV) {
- print "ERROR: unrecognized arguments: @ARGV\n";
- usage();
- }
- return %opts;
-}
-
-#-------------------------------------------------------------------------------
-
-sub check_for_perl_utils {
-
- my $cfgdir = shift;
- my $opts_ref = shift;
-
- # Determine CIME root directory and perl5lib root directory
- my $cimeroot = $opts_ref->{'cimeroot'};
- if ( ! defined($cimeroot) ) {
- $cimeroot = "$cfgdir/../cime";
- if ( -d $cimeroot ) {
- } elsif ( -d "$cfgdir/../../../cime" ) {
- $cimeroot = "$cfgdir/../../../cime";
- } else {
- die <<"EOF";
-** Cannot find the root of the cime directory enter it using the -cimeroot option
- Did you run the checkout_externals scripts?
-EOF
- }
- }
-
- my $perl5lib_dir = "$cimeroot/utils/perl5lib";
-
- #-----------------------------------------------------------------------------
- # Add $perl5lib_dir to the list of paths that Perl searches for modules
- my @dirs = ( $ProgDir, $cfgdir, "$perl5lib_dir");
- unshift @INC, @dirs;
-
- require config_files::clm_phys_vers;
- require namelist_files::LogMessages;
-
- my $locallog = namelist_files::LogMessages->new( $ProgName, $opts_ref );
- # The XML::Lite module is required to parse the XML files.
- (-f "$perl5lib_dir/XML/Lite.pm") or
- $locallog->fatal_error("Cannot find perl module \"XML/Lite.pm\" in directory\n" .
- "\"$perl5lib_dir\"");
-
- # The Build::Config module provides utilities to access the configuration information
- # in the config_cache.xml file
- (-f "$perl5lib_dir/Build/Config.pm") or
- $locallog->fatal_error("Cannot find perl module \"Build/Config.pm\" in directory\n" .
- "\"$perl5lib_dir\"");
-
- # The Build::NamelistDefinition module provides utilities to validate that the output
- # namelists are consistent with the namelist definition file
- (-f "$perl5lib_dir/Build/NamelistDefinition.pm") or
- $locallog->fatal_error("Cannot find perl module \"Build/NamelistDefinition.pm\" in directory\n" .
- "\"$perl5lib_dir\"");
-
- # The Build::NamelistDefaults module provides a utility to obtain default values of namelist
- # variables based on finding a best fit with the attributes specified in the defaults file.
- (-f "$perl5lib_dir/Build/NamelistDefaults.pm") or
- $locallog->fatal_error("Cannot find perl module \"Build/NamelistDefaults.pm\" in directory\n" .
- "\"$perl5lib_dir\"");
-
- # The Build::Namelist module provides utilities to parse input namelists, to query and modify
- # namelists, and to write output namelists.
- (-f "$perl5lib_dir/Build/Namelist.pm") or
- $locallog->fatal_error("Cannot find perl module \"Build/Namelist.pm\" in directory\n" .
- "\"$perl5lib_dir\"");
-
-
- # required cesm perl modules
- require XML::Lite;
- require Build::Config;
- require Build::NamelistDefinition;
- require Build::NamelistDefaults;
- require Build::Namelist;
- require Config::SetupTools;
-}
-
-#-------------------------------------------------------------------------------
-
-sub read_configure_definition {
- # Read the configure definition and specific config_cache file for this case
- # configure are the build-time settings for CLM
- my ($cfgdir, $opts) = @_;
-
- $log->verbose_message("Setting CLM configuration script directory to $cfgdir");
-
- # Create a configuration object from the default config_definition file
- my $configfile;
- if ( -f $opts->{'config'} ) {
- $configfile = $opts->{'config'};
- } else {
- $configfile = "$cfgdir/config_files/config_definition.xml";
- }
-
- # Check that configuration cache file exists.
- $log->verbose_message("Using CLM configuration cache file $opts->{'config'}");
- if ( $configfile ne $opts->{'config'} ) {
- $log->fatal_error("Cannot find configuration cache file: \"$opts->{'config'}\"");
- }
-
- my $cfg = Build::Config->new("$configfile");
-
- return $cfg;
-}
-
-#-----------------------------------------------------------------------------------------------
-
-sub read_namelist_definition {
- my ($cfgdir, $opts, $nl_flags, $physv) = @_;
-
- # The namelist definition file contains entries for all namelist
- # variables that can be output by build-namelist.
- my $phys = $physv->as_filename( );
- my @nl_definition_files = ( "$cfgdir/namelist_files/namelist_definition_drv.xml",
- "$cfgdir/namelist_files/namelist_definition_$phys.xml" );
- foreach my $nl_defin_file ( @nl_definition_files ) {
- (-f "$nl_defin_file") or $log->fatal_error("Cannot find namelist definition file \"$nl_defin_file\"");
-
- $log->verbose_message("Using namelist definition file $nl_defin_file");
- }
-
- # Create a namelist definition object. This object provides a
- # method for verifying that the output namelist variables are in the
- # definition file, and are output in the correct namelist groups.
- my $definition = Build::NamelistDefinition->new( shift(@nl_definition_files) );
- foreach my $nl_defin_file ( @nl_definition_files ) {
- $definition->add( "$nl_defin_file" );
- }
-
- return $definition;
-}
-
-#-----------------------------------------------------------------------------------------------
-
-sub read_envxml_case_files {
- # read the contents of the env*.xml files in the case directory
- my ($opts) = @_;
-
- my %envxml = ();
- if ( defined($opts->{'envxml_dir'}) ) {
- (-d $opts->{'envxml_dir'}) or $log->fatal_error( "envxml_dir is not a directory" );
- my @files = glob( $opts->{'envxml_dir'}."/env_*xml" );
- ($#files >= 0) or $log->fatal_error( "there are no env_*xml files in the envxml_dir" );
- foreach my $file (@files) {
- $log->verbose_message( "Open env.xml file: $file" );
- my $xml = XML::Lite->new( "$file" );
- my @e = $xml->elements_by_name('entry');
- while ( my $e = shift @e ) {
- my %a = $e->get_attributes();
- $envxml{$a{'id'}} = $a{'value'};
- }
- }
- foreach my $attr (keys %envxml) {
- if ( $envxml{$attr} =~ m/\$/ ) {
- $envxml{$attr} = SetupTools::expand_xml_var( $envxml{$attr}, \%envxml );
- }
- }
- } else {
- $log->fatal_error( "The -envxml_dir option was NOT given and it is a REQUIRED option" );
- }
- return( %envxml );
-}
-
-#-----------------------------------------------------------------------------------------------
-
-sub read_namelist_defaults {
- my ($cfgdir, $opts, $nl_flags, $cfg, $physv) = @_;
-
- my $phys = $physv->as_filename( );
- # The namelist defaults file contains default values for all required namelist variables.
- my @nl_defaults_files = ( "$cfgdir/namelist_files/namelist_defaults_overall.xml",
- "$cfgdir/namelist_files/namelist_defaults_$phys.xml" );
-
- # Add the location of the use case defaults files to the options hash
- $opts->{'use_case_dir'} = "$cfgdir/namelist_files/use_cases";
-
- if (defined $opts->{'use_case'}) {
- if ( $opts->{'use_case'} ne "list" ) {
- unshift( @nl_defaults_files, "$opts->{'use_case_dir'}/$opts->{'use_case'}.xml" );
- }
- }
-
- foreach my $nl_defaults_file ( @nl_defaults_files ) {
- (-f "$nl_defaults_file") or $log->fatal_error("Cannot find namelist defaults file \"$nl_defaults_file\"");
-
- $log->verbose_message("Using namelist defaults file $nl_defaults_file");
- }
-
- # Create a namelist defaults object. This object provides default
- # values for variables contained in the input defaults file. The
- # configuration object provides attribute values that are relevent
- # for the CLM executable for which the namelist is being produced.
- my $defaults = Build::NamelistDefaults->new( shift( @nl_defaults_files ), $cfg);
- foreach my $nl_defaults_file ( @nl_defaults_files ) {
- $defaults->add( "$nl_defaults_file" );
- }
- return $defaults;
-}
-
-#-------------------------------------------------------------------------------
-
-sub check_cesm_inputdata {
- # Check that the CESM inputdata root directory has been specified. This must be
- # a local or nfs mounted directory.
-
- my ($opts, $nl_flags) = @_;
-
- $nl_flags->{'inputdata_rootdir'} = undef;
- if (defined($opts->{'csmdata'})) {
- $nl_flags->{'inputdata_rootdir'} = $opts->{'csmdata'};
- }
- elsif (defined $ENV{'CSMDATA'}) {
- $nl_flags->{'inputdata_rootdir'} = $ENV{'CSMDATA'};
- }
- else {
- $log->fatal_error("CESM inputdata root directory must be specified by either -csmdata\n" .
- "argument or by the CSMDATA environment variable.");
- }
- if ( ! defined($ENV{'DIN_LOC_ROOT'}) ) {
- $ENV{'DIN_LOC_ROOT'} = $nl_flags->{'inputdata_rootdir'};
- }
-
- if ($opts->{'test'}) {
- (-d $nl_flags->{'inputdata_rootdir'}) or $log->fatal_error("CESM inputdata root is not a directory: \"$nl_flags->{'inputdata_rootdir'}\"");
- }
-
- $log->verbose_message("CESM inputdata root directory: $nl_flags->{'inputdata_rootdir'}");
-}
-
-#-------------------------------------------------------------------------------
-
-sub process_namelist_user_input {
- # Process the user input in general by order of precedence. At each point
- # we'll only add new values to the namelist and not overwrite
- # previously specified specified values which have higher
- # precedence. The one exception to this rule are the specifc command-line
- # options which are done last as if the user contradicts these settings
- # CLM build-namelist will abort with an error.
- #
- # 1. values set on the command-line using the -namelist option,
- # (i.e. CLM_NAMELIST_OPTS env_run variable)
- # 2. values read from the file(s) specified by -infile,
- # (i.e. user_nl_clm files)
- # After the above are done the command line options are processed and they
- # are made sure the user hasn't contradicted any of their settings with
- # anything above. Because of this they are condsidered to have the highest
- # precedence.
- # 0. namelist values set by specific command-line options, like, -d, -sim_year
- # (i.e. CLM_BLDNML_OPTS env_run variable)
- # The results of these are needed for the final two user input
- # 4. values set from a use-case scenario, e.g., -use_case
- # (i.e. CLM_NML_USE_CASE env_run variable)
- #
- # Finally after all the above is done, the defaults are found from the
- # namelist defaults file (outside of this routine).
- #
-
-
- my ($opts, $nl_flags, $definition, $defaults, $nl, $cfg, $envxml_ref, $physv) = @_;
-
- # Get the inputs that will be coming from the user...
- process_namelist_commandline_namelist($opts, $definition, $nl, $envxml_ref);
- process_namelist_commandline_infile($opts, $definition, $nl, $envxml_ref);
-
- # Apply the commandline options and make sure the user didn't change it above
- process_namelist_commandline_options($opts, $nl_flags, $definition, $defaults, $nl, $cfg, $physv);
-
- # The last two process command line arguments for use_case
- # They require that process_namelist_commandline_options was called before this
- process_namelist_commandline_use_case($opts, $nl_flags, $definition, $defaults, $nl, $cfg, $envxml_ref, $physv);
-
- # Set the start_type by the command line setting for clm_start_type
- process_namelist_commandline_clm_start_type($opts, $nl_flags, $definition, $defaults, $nl);
-
-}
-
-#-------------------------------------------------------------------------------
-
-sub process_namelist_commandline_options {
- # First process the commandline args that provide specific namelist values.
- #
- # First get the command-line specified overall values or their defaults
- # Obtain default values for the following build-namelist input arguments
- # : res, mask, rcp, sim_year, sim_year_range.
- #
- my ($opts, $nl_flags, $definition, $defaults, $nl, $cfg, $physv) = @_;
-
- setup_cmdl_chk_res($opts, $defaults);
- setup_cmdl_resolution($opts, $nl_flags, $definition, $defaults);
- setup_cmdl_mask($opts, $nl_flags, $definition, $defaults, $nl);
- setup_cmdl_bgc($opts, $nl_flags, $definition, $defaults, $nl, $cfg, $physv);
- setup_cmdl_maxpft($opts, $nl_flags, $definition, $defaults, $nl, $cfg, $physv);
- setup_cmdl_glc_nec($opts, $nl_flags, $definition, $defaults, $nl);
- setup_cmdl_rcp($opts, $nl_flags, $definition, $defaults, $nl);
- setup_cmdl_simulation_year($opts, $nl_flags, $definition, $defaults, $nl);
- setup_cmdl_run_type($opts, $nl_flags, $definition, $defaults, $nl);
- setup_cmdl_output_reals($opts, $nl_flags, $definition, $defaults, $nl, $physv);
-}
-
-#-------------------------------------------------------------------------------
-
-sub setup_cmdl_chk_res {
- my ($opts, $defaults) = @_;
-
- my $var = "chk_res";
- if ( ! defined($opts->{$var}) ) {
- $opts->{$var} = $defaults->get_value($var);
- }
-}
-
-sub setup_cmdl_resolution {
- my ($opts, $nl_flags, $definition, $defaults) = @_;
-
- my $var = "res";
- my $val;
-
- if ( $opts->{$var} ne "default" ) {
- $val = $opts->{$var};
- } else {
- $val= $defaults->get_value($var);
- }
-
- $nl_flags->{'res'} = $val;
- $log->verbose_message("CLM atm resolution is $nl_flags->{'res'}");
- $opts->{$var} = $val;
- if ( $opts->{'chk_res'} ) {
- $val = "e_string( $nl_flags->{'res'} );
- if ( ! $definition->is_valid_value( $var, $val ) ) {
- my @valid_values = $definition->get_valid_values( $var );
- $log->fatal_error("$var has a value ($val) that is NOT valid. Valid values are: @valid_values");
- }
- }
-}
-
-#-------------------------------------------------------------------------------
-
-sub setup_cmdl_mask {
- my ($opts, $nl_flags, $definition, $defaults, $nl) = @_;
-
- my $var = "mask";
- my $val;
-
- if ( $opts->{$var} ne "default" ) {
- $val = $opts->{$var};
- } else {
- my %tmp = ( 'hgrid'=>$nl_flags->{'res'} );
- $val = $defaults->get_value($var, \%tmp );
- }
-
- $nl_flags->{'mask'} = $val;
- $opts->{'mask'} = $nl_flags->{'mask'};
- if ( $opts->{'chk_res'} ) {
- $val = "e_string( $val );
- my $group = $definition->get_group_name($var);
- $nl->set_variable_value($group, $var, $val);
- if ( ! $definition->is_valid_value( $var, $val ) ) {
- my @valid_values = $definition->get_valid_values( $var );
- $log->fatal_error("$var has a value ($val) that is NOT valid. Valid values are: @valid_values");
- }
- }
- $log->verbose_message("CLM land mask is $nl_flags->{'mask'}");
-}
-
-#-------------------------------------------------------------------------------
-sub setup_cmdl_bgc {
- # BGC - alias for group of biogeochemistry related use_XXX namelists
-
- my ($opts, $nl_flags, $definition, $defaults, $nl, $cfg, $physv) = @_;
-
- my $val;
- my $var = "bgc";
-
- $val = $opts->{$var};
- $nl_flags->{'bgc_mode'} = $val;
-
- my $var = "bgc_mode";
- if ( $nl_flags->{$var} eq "default" ) {
- $nl_flags->{$var} = $defaults->get_value($var);
- }
- my $group = $definition->get_group_name($var);
- $nl->set_variable_value($group, $var, quote_string( $nl_flags->{$var} ) );
- if ( ! $definition->is_valid_value( $var, quote_string( $nl_flags->{$var}) ) ) {
- my @valid_values = $definition->get_valid_values( $var );
- $log->fatal_error("$var has a value (".$nl_flags->{$var}.") that is NOT valid. Valid values are: @valid_values");
- }
- $log->verbose_message("Using $nl_flags->{$var} for bgc.");
-
- # now set the actual name list variables based on the bgc alias
- if ($nl_flags->{$var} eq "bgc" ) {
- $nl_flags->{'use_cn'} = ".true.";
- } else {
- $nl_flags->{'use_cn'} = ".false.";
- }
- if ( defined($nl->get_value("use_cn")) && ($nl_flags->{'use_cn'} ne $nl->get_value("use_cn")) ) {
- $log->fatal_error("The namelist variable use_cn is inconsistent with the -bgc option");
- }
-
- {
- # If the variable has already been set use it, if not set to the value defined by the bgc_mode
- my @list = ( "use_lch4", "use_nitrif_denitrif", "use_vertsoilc", "use_century_decomp" );
- my $ndiff = 0;
- my %settings = ( 'bgc_mode'=>$nl_flags->{'bgc_mode'} );
- foreach my $var ( @list ) {
- my $default_setting = $defaults->get_value($var, \%settings );
- if ( ! defined($nl->get_value($var)) ) {
- $nl_flags->{$var} = $default_setting;
- } else {
- if ( $nl->get_value($var) ne $default_setting ) {
- $ndiff += 1;
- }
- $nl_flags->{$var} = $nl->get_value($var);
- }
- $val = $nl_flags->{$var};
- my $group = $definition->get_group_name($var);
- $nl->set_variable_value($group, $var, $val);
- if ( ! $definition->is_valid_value( $var, $val ) ) {
- my @valid_values = $definition->get_valid_values( $var );
- $log->fatal_error("$var has a value ($val) that is NOT valid. Valid values are: @valid_values");
- }
- }
- # If all the variables are different report it as an error
- if ( $ndiff == ($#list + 1) ) {
- $log->fatal_error("You are contradicting the -bgc setting with the namelist variables: @list" );
- }
- }
-
- # Now set use_cn
- foreach $var ( "use_cn" ) {
- $val = $nl_flags->{$var};
- $group = $definition->get_group_name($var);
- $nl->set_variable_value($group, $var, $val);
- if ( ! $definition->is_valid_value( $var, $val ) ) {
- my @valid_values = $definition->get_valid_values( $var );
- $log->fatal_error("$var has a value ($val) that is NOT valid. Valid values are: @valid_values");
- }
- }
- my $var = "use_fun";
- if ( ! defined($nl->get_value($var)) ) {
- add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, $var,
- 'phys'=>$nl_flags->{'phys'}, 'use_cn'=>$nl_flags->{'use_cn'},
- 'use_nitrif_denitrif'=>$nl_flags->{'use_nitrif_denitrif'} );
- }
- if ( (! &value_is_true($nl_flags->{'use_nitrif_denitrif'}) ) && &value_is_true($nl->get_value('use_fun')) ) {
- $log->fatal_error("When FUN is on, use_nitrif_denitrif MUST also be on!");
- }
-} # end bgc
-
-
-#-------------------------------------------------------------------------------
-
-sub setup_cmdl_maxpft {
- my ($opts, $nl_flags, $definition, $defaults, $nl, $cfg, $physv) = @_;
-
- my $val;
- my $var = "maxpft";
- my $maxpatchpft = 17;
- if ( $opts->{$var} ne "default") {
- $val = $opts->{$var};
- } else {
- $val = $maxpatchpft;
- }
- $nl_flags->{'maxpft'} = $val;
-
- if ( ($nl_flags->{'bgc_mode'} ne "sp") && ($nl_flags->{'maxpft'} != $maxpatchpft) ) {
- $log->fatal_error("** For CN or BGC mode you MUST set max patch PFT's to $maxpatchpft\n" .
- "**\n" .
- "** Set the bgc mode, crop and maxpft by the following means from highest to lowest precedence:\n" .
- "** * by the command-line options -bgc and -maxpft\n" .
- "** * by a default configuration file, specified by -defaults\n" .
- "**");
- }
- if ( $nl_flags->{'maxpft'} > $maxpatchpft ) {
- $log->fatal_error("** Max patch PFT's can NOT exceed $maxpatchpft\n" .
- "**\n" .
- "** Set maxpft by the following means from highest to lowest precedence:\n" .
- "** * by the command-line options -maxpft\n" .
- "** * by a default configuration file, specified by -defaults\n" .
- "**");
- }
- if ( $nl_flags->{'maxpft'} != $maxpatchpft ) {
- $log->warning("running with maxpft NOT equal to $maxpatchpft is " .
- "NOT validated / scientifically supported." );
- }
- $log->verbose_message("Using $nl_flags->{'maxpft'} for maxpft.");
-
- $var = "maxpatch_pft";
- $val = $nl_flags->{'maxpft'};
- my $group = $definition->get_group_name($var);
- $nl->set_variable_value($group, $var, $val);
- if ( ! $definition->is_valid_value( $var, $val ) ) {
- my @valid_values = $definition->get_valid_values( $var );
- $log->fatal_error("$var has a value ($val) that is NOT valid. Valid values are: @valid_values");
- }
-}
-
-#-------------------------------------------------------------------------------
-
-sub setup_cmdl_glc_nec {
- my ($opts, $nl_flags, $definition, $defaults, $nl) = @_;
-
- my $val;
- my $var = "glc_nec";
-
- if ( $opts->{$var} ne "default" ) {
- $val = $opts->{$var};
- } else {
- $val = $defaults->get_value($var);
- }
-
- $nl_flags->{'glc_nec'} = $val;
- $opts->{'glc_nec'} = $val;
- my $group = $definition->get_group_name($var);
- $nl->set_variable_value($group, $var, $val);
- if ( ! $definition->is_valid_value( $var, $val ) ) {
- my @valid_values = $definition->get_valid_values( $var );
- $log->fatal_error("$var has a value ($val) that is NOT valid. Valid values are: @valid_values");
- }
- $log->verbose_message("Glacier number of elevation classes is $val");
-}
-
-#-------------------------------------------------------------------------------
-
-sub setup_cmdl_rcp {
- # representative concentration pathway
- my ($opts, $nl_flags, $definition, $defaults, $nl) = @_;
-
- my $val;
- my $var = "rcp";
- if ( $opts->{$var} ne "default" ) {
- $val = $opts->{$var};
- } else {
- $val = $defaults->get_value($var);
- }
- $nl_flags->{'rcp'} = $val;
- $opts->{'rcp'} = $nl_flags->{'rcp'};
- my $group = $definition->get_group_name($var);
- $nl->set_variable_value($group, $var, $val);
- if ( ! $definition->is_valid_value( $var, $val ) ) {
- my @valid_values = $definition->get_valid_values( $var );
- $log->fatal_error("$var has a value ($val) that is NOT valid. Valid values are: @valid_values");
- }
- $log->verbose_message("CLM future scenario representative concentration is $nl_flags->{'rcp'}");
-}
-
-#-------------------------------------------------------------------------------
-
-sub setup_cmdl_simulation_year {
- my ($opts, $nl_flags, $definition, $defaults, $nl, $cfg) = @_;
-
- my $val;
- my $var = "sim_year";
- if ( $opts->{$var} ne "default" ) {
- $val = $opts->{$var};
- } else {
- $val = $defaults->get_value($var);
- }
-
- $nl_flags->{'sim_year_range'} = $defaults->get_value("sim_year_range");
- $nl_flags->{'sim_year'} = $val;
- if ( $val =~ /([0-9]+)-([0-9]+)/ ) {
- $nl_flags->{'sim_year'} = $1;
- $nl_flags->{'sim_year_range'} = $val;
- }
- $val = $nl_flags->{'sim_year'};
- my $group = $definition->get_group_name($var);
- $nl->set_variable_value($group, $var, $val );
- if ( ! $definition->is_valid_value( $var, $val, 'noquotes'=>1 ) ) {
- my @valid_values = $definition->get_valid_values( $var );
- $log->fatal_error("$var of $val is NOT valid. Valid values are: @valid_values");
- }
- $nl->set_variable_value($group, $var, $val );
- $log->verbose_message("CLM sim_year is $nl_flags->{'sim_year'}");
-
- $var = "sim_year_range";
- $val = $nl_flags->{'sim_year_range'};
- if ( $val ne "constant" ) {
- $opts->{$var} = $val;
- $group = $definition->get_group_name($var);
- $nl->set_variable_value($group, $var, $val );
- if ( ! $definition->is_valid_value( $var, $val, 'noquotes'=>1 ) ) {
- my @valid_values = $definition->get_valid_values( $var );
- $log->fatal_error("$var of $val is NOT valid. Valid values are: @valid_values");
- }
- $val = "'".$defaults->get_value($var)."'";
- $nl->set_variable_value($group, $var, $val );
- $log->verbose_message("CLM sim_year_range is $nl_flags->{'sim_year_range'}");
- }
-}
-
-#-------------------------------------------------------------------------------
-
-sub setup_cmdl_run_type {
- my ($opts, $nl_flags, $definition, $defaults, $nl) = @_;
-
- my $val;
- my $var = "clm_start_type";
- if (defined $opts->{$var}) {
- if ($opts->{$var} eq "default" ) {
- add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, $var,
- 'use_cndv'=>$nl_flags->{'use_cndv'} );
- } else {
- my $group = $definition->get_group_name($var);
- $nl->set_variable_value($group, $var, quote_string( $opts->{$var} ) );
- }
- } else {
- add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, $var,
- 'use_cndv'=>$nl_flags->{'use_cndv'} );
- }
- $nl_flags->{'clm_start_type'} = $nl->get_value($var);
-}
-
-#-------------------------------------------------------------------------------
-
-sub setup_cmdl_output_reals {
- my ($opts, $nl_flags, $definition, $defaults, $nl, $physv) = @_;
-
- my $var = "output_reals_filename";
- my $file = $opts->{$var};
- if ( defined($file) ) {
- # Make sure can open file and if not die with an error
- my $fh = IO::File->new($file, '>') or $log->fatal_error("can't create real parameter filename: $file");
- $fh->close();
- }
-}
-
-#-------------------------------------------------------------------------------
-
-sub process_namelist_commandline_namelist {
- # Process the commandline '-namelist' arg.
- my ($opts, $definition, $nl, $envxml_ref) = @_;
-
- if (defined $opts->{'namelist'}) {
- # Parse commandline namelist
- my $nl_arg = Build::Namelist->new($opts->{'namelist'});
-
- # Validate input namelist -- trap exceptions
- my $nl_arg_valid;
- eval { $nl_arg_valid = $definition->validate($nl_arg); };
- if ($@) {
- $log->fatal_error("Invalid namelist variable in commandline arg '-namelist'.\n $@");
- }
- # Go through all variables and expand any XML env settings in them
- expand_xml_variables_in_namelist( $nl_arg_valid, $envxml_ref );
-
- # Merge input values into namelist. Previously specified values have higher precedence
- # and are not overwritten.
- $nl->merge_nl($nl_arg_valid);
- }
-}
-
-#-------------------------------------------------------------------------------
-
-sub process_namelist_commandline_infile {
- # Process the commandline '-infile' arg.
- my ($opts, $definition, $nl, $envxml_ref) = @_;
-
- if (defined $opts->{'infile'}) {
- my @infiles = split( /,/, $opts->{'infile'} );
- foreach my $infile ( @infiles ) {
- # Make sure a valid file was found
- if ( -f "$infile" ) {
- # Otherwise abort as a valid file doesn't exist
- } else {
- $log->fatal_error("input namelist file does NOT exist $infile.\n $@");
- }
- # Parse namelist input from the next file
- my $nl_infile = Build::Namelist->new($infile);
-
- # Validate input namelist -- trap exceptions
- my $nl_infile_valid;
- eval { $nl_infile_valid = $definition->validate($nl_infile); };
- if ($@) {
- $log->fatal_error("Invalid namelist variable in '-infile' $infile.\n $@");
- }
- # Go through all variables and expand any XML env settings in them
- expand_xml_variables_in_namelist( $nl_infile_valid, $envxml_ref );
-
- # Merge input values into namelist. Previously specified values have higher precedence
- # and are not overwritten.
- $nl->merge_nl($nl_infile_valid);
- }
- }
-}
-
-#-------------------------------------------------------------------------------
-
-sub process_namelist_commandline_use_case {
- # Now process the -use_case arg.
- my ($opts, $nl_flags, $definition, $defaults, $nl, $cfg, $envxml_ref, $physv) = @_;
-
- if (defined $opts->{'use_case'}) {
-
- # The use case definition is contained in an xml file with the same format as the defaults file.
- # Create a new NamelistDefaults object.
- my $uc_defaults = Build::NamelistDefaults->new("$opts->{'use_case_dir'}/$opts->{'use_case'}.xml", $cfg);
-
- my %settings;
- $settings{'res'} = $nl_flags->{'res'};
- $settings{'rcp'} = $nl_flags->{'rcp'};
- $settings{'mask'} = $nl_flags->{'mask'};
- $settings{'sim_year'} = $nl_flags->{'sim_year'};
- $settings{'sim_year_range'} = $nl_flags->{'sim_year_range'};
- $settings{'phys'} = $nl_flags->{'phys'};
- $settings{'use_cn'} = $nl_flags->{'use_cn'};
- $settings{'use_cndv'} = $nl_flags->{'use_cndv'};
- $settings{'cnfireson'} = $nl_flags->{'cnfireson'};
- # Loop over the variables specified in the use case.
- # Add each one to the namelist.
- my @vars = $uc_defaults->get_variable_names();
- my $nl_usecase = Build::Namelist->new();
- foreach my $var (@vars) {
- my $val = $uc_defaults->get_value($var, \%settings );
-
- if ( defined($val) ) {
- $log->message("CLM adding use_case $opts->{'use_case'} defaults for var '$var' with val '$val'");
-
- add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl_usecase, $var, 'val'=>$val);
- }
- }
- # Go through all variables and expand any XML env settings in them
- expand_xml_variables_in_namelist( $nl_usecase, $envxml_ref );
-
- # Merge input values into namelist. Previously specified values have higher precedence
- # and are not overwritten.
- $nl->merge_nl($nl_usecase);
- }
-}
-
-#-------------------------------------------------------------------------------
-
-sub process_namelist_commandline_clm_start_type {
- # Set the start_type according to the command line clm_start_type option
-
- my ($opts, $nl_flags, $definition, $defaults, $nl) = @_;
-
- # Run type for driver namelist - note that arb_ic implies that the run is startup
- my $var = "start_type";
- if ($nl_flags->{'clm_start_type'} eq "'cold'" || $nl_flags->{'clm_start_type'} eq "'arb_ic'") {
- # Add default is used here, but the value is explicitly set
- add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, $var, 'val'=>'startup' );
- } else {
- # Add default is used here, but the value is explicitly set
- add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, $var, 'val'=>$nl_flags->{'clm_start_type'} );
- }
-}
-
-#-------------------------------------------------------------------------------
-
-sub process_namelist_inline_logic {
- # Use the namelist default object to add default values for required
- # namelist variables that have not been previously set.
- my ($opts, $nl_flags, $definition, $defaults, $nl, $cfg, $envxml_ref, $physv) = @_;
-
-
- ##############################
- # namelist group: clm_inparm #
- ##############################
- setup_logic_lnd_frac($opts, $nl_flags, $definition, $defaults, $nl, $envxml_ref);
- setup_logic_co2_type($opts, $nl_flags, $definition, $defaults, $nl);
- setup_logic_start_type($opts, $nl_flags, $nl);
- setup_logic_delta_time($opts, $nl_flags, $definition, $defaults, $nl);
- setup_logic_decomp_performance($opts, $nl_flags, $definition, $defaults, $nl);
- setup_logic_glacier($opts, $nl_flags, $definition, $defaults, $nl, $envxml_ref, $physv);
- setup_logic_dynamic_plant_nitrogen_alloc($opts, $nl_flags, $definition, $defaults, $nl, $physv);
- setup_logic_hydrstress($opts, $nl_flags, $definition, $defaults, $nl, $physv);
- setup_logic_dynamic_roots($opts, $nl_flags, $definition, $defaults, $nl, $physv);
- setup_logic_params_file($opts, $nl_flags, $definition, $defaults, $nl, $physv);
- setup_logic_create_crop_landunit($opts, $nl_flags, $definition, $defaults, $nl, $physv);
- setup_logic_soilstate($opts, $nl_flags, $definition, $defaults, $nl, $physv);
- setup_logic_demand($opts, $nl_flags, $definition, $defaults, $nl, $physv);
- setup_logic_surface_dataset($opts, $nl_flags, $definition, $defaults, $nl, $physv);
- setup_logic_initial_conditions($opts, $nl_flags, $definition, $defaults, $nl, $physv);
- setup_logic_snowpack($opts, $nl_flags, $definition, $defaults, $nl, $physv);
-
- #########################################
- # namelist group: atm2lnd_inparm
- #########################################
- setup_logic_atm_forcing($opts, $nl_flags, $definition, $defaults, $nl, $physv);
-
- #########################################
- # namelist group: lnd2atm_inparm
- #########################################
- setup_logic_lnd2atm($opts, $nl_flags, $definition, $defaults, $nl, $physv);
-
- ###############################
- # namelist group: clmu_inparm #
- ###############################
- setup_logic_urban($opts, $nl_flags, $definition, $defaults, $nl, $physv);
-
- ##################################
- # namelist group: bgc_shared
- ##################################
- setup_logic_bgc_shared($opts, $nl_flags, $definition, $defaults, $nl, $physv);
-
- #############################################
- # namelist group: soilwater_movement_inparm #
- #############################################
- setup_logic_soilwater_movement($opts, $nl_flags, $definition, $defaults, $nl, $physv);
-
- #############################################
- # namelist group: rooting_profile_inparm #
- #############################################
- setup_logic_rooting_profile($opts, $nl_flags, $definition, $defaults, $nl, $physv);
-
- ####################################
- # namelist group: cnvegcarbonstate #
- ####################################
- setup_logic_cnvegcarbonstate($opts, $nl_flags, $definition, $defaults, $nl, $physv);
-
- #############################################
- # namelist group: soil_resis_inparm #
- #############################################
- setup_logic_soil_resis($opts, $nl_flags, $definition, $defaults, $nl, $physv);
-
- #############################################
- # namelist group: canopyhydrology_inparm #
- #############################################
- setup_logic_canopyhydrology($opts, $nl_flags, $definition, $defaults, $nl, $physv);
-
- #####################################
- # namelist group: clm_canopy_inparm #
- #####################################
- setup_logic_canopy($opts, $nl_flags, $definition, $defaults, $nl, $physv);
-
- #######################################################################
- # namelist groups: clm_hydrology1_inparm and clm_soilhydrology_inparm #
- #######################################################################
- setup_logic_hydrology_switches($nl, $physv);
-
-}
-
-#-------------------------------------------------------------------------------
-
-sub setup_logic_lnd_frac {
-
- my ($opts, $nl_flags, $definition, $defaults, $nl, $envxml_ref) = @_;
-
- my $var = "lnd_frac";
- if ( defined($opts->{$var}) ) {
- if ( defined($nl->get_value('fatmlndfrc')) ) {
- $log->fatal_error("Can NOT set both -lnd_frac option (set via LND_DOMAIN_PATH/LND_DOMAIN_FILE " .
- "env variables) AND fatmlndfrac on namelist");
- }
- my $lnd_frac = SetupTools::expand_xml_var( $opts->{$var}, $envxml_ref);
- add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'fatmlndfrc','val'=>$lnd_frac );
- }
-
- # Get the fraction file
- if (defined $nl->get_value('fatmlndfrc')) {
- # do nothing - use value provided by config_grid.xml and clm.cpl7.template
- } else {
- $log->fatal_error("fatmlndfrc was NOT sent into CLM build-namelist.");
- }
-}
-
-#-------------------------------------------------------------------------------
-
-sub setup_logic_co2_type {
- my ($opts, $nl_flags, $definition, $defaults, $nl) = @_;
-
- my $var = "co2_type";
- if ( defined($opts->{$var}) ) {
- if ( ! defined($nl->get_value($var)) ) {
- add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'co2_type','val'=>"$opts->{'co2_type'}");
- } else {
- $log->fatal_error("co2_type set on namelist as well as -co2_type option.");
- }
- }
- add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'co2_type');
- if ( $nl->get_value('co2_type') =~ /constant/ ) {
- my $var = 'co2_ppmv';
- if ( defined($opts->{$var}) ) {
- if ( $opts->{$var} <= 0.0 ) {
- $log->fatal_error("co2_ppmv can NOT be less than or equal to zero.");
- }
- my $group = $definition->get_group_name($var);
- $nl->set_variable_value($group, $var, $opts->{$var});
- } else {
- add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, $var, 'sim_year'=>$nl_flags->{'sim_year'} );
- }
- }
-}
-
-#-------------------------------------------------------------------------------
-
-sub setup_logic_start_type {
- my ($opts, $nl_flags, $nl) = @_;
-
- my $var = "start_type";
- my $drv_start_type = $nl->get_value($var);
- my $my_start_type = $nl_flags->{'clm_start_type'};
- my $nsrest = $nl->get_value('override_nsrest');
-
- if ( defined($nsrest) ) {
- if ( $nsrest == 0 ) { $my_start_type = "startup"; }
- if ( $nsrest == 1 ) { $my_start_type = "continue"; }
- if ( $nsrest == 3 ) { $my_start_type = "branch"; }
- if ( "$my_start_type" eq "$drv_start_type" ) {
- $log->fatal_error("no need to set override_nsrest to same as start_type.");
- }
- if ( "$drv_start_type" !~ /startup/ ) {
- $log->fatal_error("can NOT set override_nsrest if driver is NOT a startup type.");
- }
- }
-
- if ( $my_start_type =~ /branch/ ) {
- if (not defined $nl->get_value('nrevsn')) {
- $log->fatal_error("nrevsn is required for a branch type.");
- }
- } else {
- if (defined $nl->get_value('nrevsn')) {
- $log->fatal_error("nrevsn should ONLY be set for a branch type.");
- }
- }
-}
-
-#-------------------------------------------------------------------------------
-
-sub setup_logic_delta_time {
- my ($opts, $nl_flags, $definition, $defaults, $nl) = @_;
-
- if ( defined($opts->{'l_ncpl'}) ) {
- my $l_ncpl = $opts->{'l_ncpl'};
- if ( $l_ncpl <= 0 ) {
- $log->fatal_error("bad value for -l_ncpl option.");
- }
- my $val = ( 3600 * 24 ) / $l_ncpl;
- my $dtime = $nl->get_value('dtime');
- if ( ! defined($dtime) ) {
- add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'dtime', 'val'=>$val);
- } elsif ( $dtime ne $val ) {
- $log->fatal_error("can NOT set both -l_ncpl option (via LND_NCPL env variable) AND dtime namelist variable.");
- }
- } else {
- add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'dtime', 'hgrid'=>$nl_flags->{'res'});
- }
-}
-
-#-------------------------------------------------------------------------------
-
-sub setup_logic_decomp_performance {
- my ($opts, $nl_flags, $definition, $defaults, $nl) = @_;
-
- # Set the number of segments per clump
- add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'nsegspc', 'hgrid'=>$nl_flags->{'res'});
-}
-
-#-------------------------------------------------------------------------------
-
-sub setup_logic_glacier {
- #
- # Glacier multiple elevation class options
- #
- my ($opts, $nl_flags, $definition, $defaults, $nl, $envxml_ref, $physv) = @_;
-
- my $var = "maxpatch_glcmec";
- add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, $var, 'val'=>$nl_flags->{'glc_nec'} );
-
- my $val = $nl->get_value($var);
- if ( $val != $nl_flags->{'glc_nec'} ) {
- $log->fatal_error("$var set to $val does NOT agree with -glc_nec argument of $nl_flags->{'glc_nec'} (set with GLC_NEC env variable)");
- }
-
- if ( $nl_flags->{'glc_nec'} < 1 ) {
- $log->fatal_error("For clm4_5 and later, GLC_NEC must be at least 1.");
- }
-
- add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'glc_snow_persistence_max_days');
-
- # Dependence of albice on glc_nec has gone away starting in CLM4_5. Thus, we
- # can remove glc_nec from the following call once we ditch CLM4_0.
- add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'albice', 'glc_nec'=>$nl_flags->{'glc_nec'});
- add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'glacier_region_behavior');
- add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'glacier_region_melt_behavior');
- add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'glacier_region_ice_runoff_behavior');
-}
-
-#-------------------------------------------------------------------------------
-
-sub setup_logic_params_file {
- # get param data. For 4_0, pft-physiology, for 4_5 old
- # pft-physiology was used but now now includes CN and BGC century
- # parameters.
- my ($opts, $nl_flags, $definition, $defaults, $nl, $physv) = @_;
-
- add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'paramfile',
- 'phys'=>$nl_flags->{'phys'},
- 'use_flexibleCN'=>$nl_flags->{'use_flexibleCN'} );
-}
-
-#-------------------------------------------------------------------------------
-
-sub setup_logic_create_crop_landunit {
- # Create crop land unit
- my ($opts, $nl_flags, $definition, $defaults, $nl, $physv) = @_;
-
- my $var = 'create_crop_landunit';
- add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, $var );
-}
-#-------------------------------------------------------------------------------
-
-sub setup_logic_urban {
- my ($opts, $nl_flags, $definition, $defaults, $nl, $physv) = @_;
-
- add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'building_temp_method');
- add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'urban_hac');
- add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'urban_traffic');
-}
-
-#-------------------------------------------------------------------------------
-
-sub error_if_set {
- # do a fatal_error and exit if any of the input variable names are set
- my ($nl, $error, @list) = @_;
- foreach my $var ( @list ) {
- if ( defined($nl->get_value($var)) ) {
- $log->fatal_error( "$var $error" );
- }
- }
-}
-
-
-#-------------------------------------------------------------------------------
-
-sub setup_logic_soilstate {
- my ($opts, $nl_flags, $definition, $defaults, $nl, $physv) = @_;
-
- add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'organic_frac_squared' );
- add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'soil_layerstruct' );
- add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'use_bedrock' );
-}
-
-#-------------------------------------------------------------------------------
-
-sub setup_logic_demand {
- #
- # Deal with options that the user has said are required...
- #
- my ($opts, $nl_flags, $definition, $defaults, $nl, $physv) = @_;
-
- my %settings;
- $settings{'hgrid'} = $nl_flags->{'res'};
- $settings{'sim_year'} = $nl_flags->{'sim_year'};
- $settings{'sim_year_range'} = $nl_flags->{'sim_year_range'};
- $settings{'mask'} = $nl_flags->{'mask'};
- $settings{'rcp'} = $nl_flags->{'rcp'};
- $settings{'glc_nec'} = $nl_flags->{'glc_nec'};
- # necessary for demand to be set correctly
- $settings{'use_cn'} = $nl_flags->{'use_cn'};
- $settings{'use_cndv'} = $nl_flags->{'use_cndv'};
- $settings{'use_lch4'} = $nl_flags->{'use_lch4'};
- $settings{'use_nitrif_denitrif'} = $nl_flags->{'use_nitrif_denitrif'};
- $settings{'use_vertsoilc'} = $nl_flags->{'use_vertsoilc'};
- $settings{'use_century_decomp'} = $nl_flags->{'use_century_decomp'};
-
- my $demand = $nl->get_value('clm_demand');
- if (defined($demand)) {
- $demand =~ s/\'//g; # Remove quotes
- if ( $demand =~ /.+/ ) {
- $opts->{'clm_demand'} .= ",$demand";
- }
- }
-
- $demand = $defaults->get_value('clm_demand', \%settings);
- if (defined($demand)) {
- $demand =~ s/\'//g; # Remove quotes
- if ( $demand =~ /.+/ ) {
- $opts->{'clm_demand'} .= ",$demand";
- }
- }
-
- my @demandlist = split( ",", $opts->{'clm_demand'} );
- foreach my $item ( @demandlist ) {
- if ( $item eq "null" ) {
- next;
- }
- if ( $item eq "finidat" ) {
- $log->fatal_error( "Do NOT put findat in the clm_demand list, set the clm_start_type=startup so initial conditions are required");
- }
- add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, $item, %settings );
- }
-}
-
-#-------------------------------------------------------------------------------
-
-sub setup_logic_surface_dataset {
- #
- # Get surface dataset after flanduse_timeseries so that we can get surface data
- # consistent with it
- # MUST BE AFTER: setup_logic_demand which is where flanduse_timeseries is set
- #
- my ($opts, $nl_flags, $definition, $defaults, $nl, $physv) = @_;
-
- $nl_flags->{'flanduse_timeseries'} = "null";
- my $flanduse_timeseries = $nl->get_value('flanduse_timeseries');
- if (defined($flanduse_timeseries)) {
- $flanduse_timeseries =~ s!(.*)/!!;
- $flanduse_timeseries =~ s/\'//;
- $flanduse_timeseries =~ s/\"//;
- if ( $flanduse_timeseries ne "" ) {
- $nl_flags->{'flanduse_timeseries'} = $flanduse_timeseries;
- }
- }
- $flanduse_timeseries = $nl_flags->{'flanduse_timeseries'};
-
- if ($flanduse_timeseries ne "null" && &value_is_true($nl_flags->{'use_cndv'}) ) {
- $log->fatal_error( "dynamic PFT's (setting flanduse_timeseries) are incompatible with dynamic vegetation (use_cndv=.true)." );
- }
- add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'fsurdat',
- 'hgrid'=>$nl_flags->{'res'},
- 'sim_year'=>$nl_flags->{'sim_year'},
- 'glc_nec'=>$nl_flags->{'glc_nec'});
-
- # MML: try and add my own namelist variable for mml_surdat forcing file
- add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'mml_surdat');
-
-
-}
-
-#-------------------------------------------------------------------------------
-
-sub setup_logic_initial_conditions {
- # Initial conditions
- # The initial date is an attribute in the defaults file which should be matched unless
- # the user explicitly requests to ignore the initial date via the -ignore_ic_date option,
- # or just ignore the year of the initial date via the -ignore_ic_year option.
- #
- # MUST BE AFTER: setup_logic_demand which is where flanduse_timeseries is set
- my ($opts, $nl_flags, $definition, $defaults, $nl, $physv) = @_;
-
- my $var = "finidat";
- my $finidat = $nl->get_value($var);
- if ( $nl_flags->{'clm_start_type'} =~ /cold/ ) {
- if (defined $finidat ) {
- $log->warning("setting $var (either explicitly in your user_nl_clm or by doing a hybrid or branch RUN_TYPE)\n is incomptable with using a cold start" .
- " (by setting CLM_FORCE_COLDSTART=on)." );
- $log->warning("Overridding input $var file with one specifying that this is a cold start from arbitrary initial conditions." );
- my $group = $definition->get_group_name($var);
- $nl->set_variable_value($group, $var, "' '" );
- }
- add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl,
- $var, 'val'=>"' '", 'no_abspath'=>1);
- $finidat = $nl->get_value($var);
- } elsif ( defined $finidat ) {
- if ( string_is_undef_or_empty($finidat) ) {
- print "You are setting $var to blank which signals arbitrary initial conditions.\n";
- print "But, CLM_FORCE_COLDSTART is off which is a contradiction. For arbitrary initial conditions just use the CLM_FORCE_COLDSTART option\n";
- $log->fatal_error("To do a cold-start set ./xmlchange CLM_FORCE_COLDSTART=on, and remove the setting of $var in the user_nl_clm file");
- }
- }
- my $useinitvar = "use_init_interp";
-
- if (not defined $finidat ) {
- my $ic_date = $nl->get_value('start_ymd');
- my $st_year = int( $ic_date / 10000);
- my $nofail = 1;
- my %settings;
- $settings{'hgrid'} = $nl_flags->{'res'};
- $settings{'phys'} = $physv->as_string();
- $settings{'nofail'} = $nofail;
- my $fsurdat = $nl->get_value('fsurdat');
- $fsurdat =~ s!(.*)/!!;
- $settings{'fsurdat'} = $fsurdat;
- #
- # If not transient use sim_year, otherwise use date
- #
- if (string_is_undef_or_empty($nl->get_value('flanduse_timeseries'))) {
- $settings{'sim_year'} = $nl_flags->{'sim_year'};
- $opts->{'ignore_ic_year'} = 1;
- } else {
- delete( $settings{'sim_year'} );
- }
- foreach my $item ( "mask", "maxpft", "glc_nec", "use_cn", "use_cndv",
- "use_nitrif_denitrif", "use_vertsoilc", "use_century_decomp",
- ) {
- $settings{$item} = $nl_flags->{$item};
- }
- if ($opts->{'ignore_ic_year'}) {
- $settings{'ic_md'} = $ic_date;
- } else {
- $settings{'ic_ymd'} = $ic_date;
- }
- my $try = 0;
- my $done = 2;
- my $use_init_interp_default = $nl->get_value($useinitvar);
- if ( string_is_undef_or_empty( $use_init_interp_default ) ) {
- $use_init_interp_default = ".false.";
- }
- $settings{$useinitvar} = $use_init_interp_default;
- do {
- $try++;
- add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, $var, %settings );
- # If couldn't find a matching finidat file, check if can turn on interpolation and try to find one again
- $finidat = $nl->get_value($var);
- if ( not defined $finidat ) {
- # Delete any date settings
- delete( $settings{'ic_ymd'} );
- delete( $settings{'ic_md'} );
- add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, "init_interp_sim_years" );
- add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, "init_interp_how_close" );
- foreach my $sim_yr ( split( /,/, $nl->get_value("init_interp_sim_years") )) {
- if ( abs($st_year - $sim_yr) < $nl->get_value("init_interp_how_close") ) {
- $settings{'sim_year'} = $sim_yr;
- }
- }
- add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, $useinitvar,
- 'use_cndv'=>$nl_flags->{'use_cndv'}, 'phys'=>$physv->as_string(),
- 'sim_year'=>$settings{'sim_year'}, 'nofail'=>1 );
- $settings{$useinitvar} = $nl->get_value($useinitvar);
- if ( $try > 1 ) {
- my $group = $definition->get_group_name($useinitvar);
- $nl->set_variable_value($group, $useinitvar, $use_init_interp_default );
- }
- if ( &value_is_true($nl->get_value($useinitvar) ) ) {
-
- add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, "init_interp_attributes",
- 'sim_year'=>$settings{'sim_year'}, 'use_cndv'=>$nl_flags->{'use_cndv'},
- 'glc_nec'=>$nl_flags->{'glc_nec'},
- 'use_cn'=>$nl_flags->{'use_cn'}, 'nofail'=>1 );
- my $attributes_string = remove_leading_and_trailing_quotes($nl->get_value("init_interp_attributes"));
- foreach my $pair ( split( /\s/, $attributes_string) ) {
- if ( $pair =~ /^([a-z_]+)=([a-z._0-9]+)$/ ) {
- $settings{$1} = $2;
- } else {
- $log->fatal_error("Problem interpreting init_interp_attributes");
- }
- }
- } else {
- if ( $nl_flags->{'clm_start_type'} =~ /startup/ ) {
- $log->fatal_error("clm_start_type is startup so an initial conditions ($var) file is required, but can't find one without $useinitvar being set to true");
- }
- $try = $done;
- }
- } else {
- $try = $done
- }
- } while( ($try < $done) && (not defined $finidat ) );
- if ( not defined $finidat ) {
- my $group = $definition->get_group_name($var);
- $nl->set_variable_value($group, $var, "' '" );
- }
- }
- $finidat = $nl->get_value($var);
- if ( &value_is_true($nl->get_value($useinitvar) ) && string_is_undef_or_empty($finidat) ) {
- $log->fatal_error("$useinitvar is set BUT $var is NOT, need to set both" );
- }
-} # end initial conditions
-
-#-------------------------------------------------------------------------------
-
-sub setup_logic_bgc_shared {
- my ($opts, $nl_flags, $definition, $defaults, $nl, $physv) = @_;
-
- if ( $nl_flags->{'bgc_mode'} ne "sp" ) {
- add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'constrain_stress_deciduous_onset', 'phys'=>$physv->as_string() );
- }
-}
-
-#-------------------------------------------------------------------------------
-
-sub setup_logic_hydrology_switches {
- #
- # Check on Switches for hydrology
- #
- my ($nl, $physv) = @_;
-
- my $subgrid = $nl->get_value('subgridflag' );
- my $origflag = $nl->get_value('origflag' );
- my $h2osfcflag = $nl->get_value('h2osfcflag' );
- if ( $origflag == 1 && $subgrid == 1 ) {
- $log->fatal_error("if origflag is ON, subgridflag can NOT also be on!");
- }
- if ( $h2osfcflag == 1 && $subgrid != 1 ) {
- $log->fatal_error("if h2osfcflag is ON, subgridflag can NOT be off!");
- }
- # These should NOT be set for CLM5.0 and beyond
- if ( $physv->as_long() > $physv->as_long("clm4_5") ) {
- foreach my $var ( "origflag", "h2osfcflag", "oldfflag" ) {
- my $val = $nl->get_value($var);
- if ( defined($val) ) {
- $log->fatal_error( "ERROR:: $var=$val is deprecated and can only be used with CLM4.5" );
- }
- }
- }
- # Test bad configurations
- my $lower = $nl->get_value( 'lower_boundary_condition' );
- my $use_bed = $nl->get_value( 'use_bedrock' );
- my $soilmtd = $nl->get_value( 'soilwater_movement_method' );
- if ( defined($soilmtd) && defined($lower) && $soilmtd == 0 && $lower != 4 ) {
- $log->fatal_error( "If soil water movement method is zeng-decker -- lower_boundary_condition can only be aquifer" );
- }
- if ( defined($soilmtd) && defined($lower) && $soilmtd == 1 && $lower == 4 ) {
- $log->fatal_error( "If soil water movement method is adaptive -- lower_boundary_condition can NOT be aquifer" );
- }
- if ( defined($use_bed) && defined($lower) && (&value_is_true($use_bed)) && $lower != 2 ) {
- $log->fatal_error( "If use_bedrock is on -- lower_boundary_condition can only be flux" );
- }
- if ( defined($h2osfcflag) && defined($lower) && $h2osfcflag == 0 && $lower != 4 ) {
- $log->fatal_error( "If h2osfcflag is 0 lower_boundary_condition can only be aquifer" );
- }
-}
-
-#-------------------------------------------------------------------------------
-
-sub setup_logic_dynamic_plant_nitrogen_alloc {
- #
- # dynamic plant nitrogen allocation model, bgc=bgc
- #
- my ($opts, $nl_flags, $definition, $defaults, $nl, $physv) = @_;
-
- if ( &value_is_true($nl_flags->{'use_cn'}) ) {
- add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'use_flexibleCN',
- 'phys'=>$physv->as_string(), 'use_cn'=>$nl_flags->{'use_cn'} );
- $nl_flags->{'use_flexibleCN'} = $nl->get_value('use_flexibleCN');
-
- if ( &value_is_true($nl_flags->{'use_flexibleCN'}) ) {
- # TODO(bja, 2015-04) make this depend on > clm 5.0 and bgc mode at some point.
- add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'MM_Nuptake_opt',
- 'use_flexibleCN'=>$nl_flags->{'use_flexibleCN'} );
- add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'downreg_opt',
- 'use_flexibleCN'=>$nl_flags->{'use_flexibleCN'} );
- add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'plant_ndemand_opt',
- 'use_flexibleCN'=>$nl_flags->{'use_flexibleCN'} );
- add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'substrate_term_opt',
- 'use_flexibleCN'=>$nl_flags->{'use_flexibleCN'} );
- add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'nscalar_opt',
- 'use_flexibleCN'=>$nl_flags->{'use_flexibleCN'} );
- add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'temp_scalar_opt',
- 'use_flexibleCN'=>$nl_flags->{'use_flexibleCN'} );
- add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'CNratio_floating',
- 'use_flexibleCN'=>$nl_flags->{'use_flexibleCN'} );
- add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'reduce_dayl_factor',
- 'use_flexibleCN'=>$nl_flags->{'use_flexibleCN'} );
- add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'vcmax_opt',
- 'use_flexibleCN'=>$nl_flags->{'use_flexibleCN'} );
- add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'CN_residual_opt',
- 'use_flexibleCN'=>$nl_flags->{'use_flexibleCN'} );
- add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'CN_partition_opt',
- 'use_flexibleCN'=>$nl_flags->{'use_flexibleCN'} );
- add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'CN_evergreen_phenology_opt',
- 'use_flexibleCN'=>$nl_flags->{'use_flexibleCN'} );
- add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'carbon_resp_opt',
- 'use_flexibleCN'=>$nl_flags->{'use_flexibleCN'}, 'use_fun'=>$nl->get_value('use_fun') );
- if ( $nl->get_value('carbon_resp_opt') == 1 && &value_is_true($nl->get_value('use_fun')) ) {
- $log->fatal_error("carbon_resp_opt should NOT be set to 1 when FUN is also on");
- }
- }
- } elsif ( ! &value_is_true($nl_flags->{'use_cn'}) ) {
- if ( &value_is_true($nl->get_value('use_flexibleCN')) ) {
- $log->fatal_error("use_flexibleCN can ONLY be set if CN is on");
- }
- }
-}
-
-#-------------------------------------------------------------------------------
-
-sub setup_logic_hydrstress {
- #
- # Plant hydraulic stress model
- #
- my ($opts, $nl_flags, $definition, $defaults, $nl, $physv) = @_;
-
- # TODO(kwo, 2015-09) make this depend on > clm 5.0 at some point.
- add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'use_hydrstress' );
- $nl_flags->{'use_hydrstress'} = $nl->get_value('use_hydrstress');
-}
-
-#-------------------------------------------------------------------------------
-
-sub setup_logic_dynamic_roots {
- #
- # dynamic root model
- #
- my ($opts, $nl_flags, $definition, $defaults, $nl, $physv) = @_;
-
- add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'use_dynroot', 'phys'=>$physv->as_string(), 'bgc_mode'=>$nl_flags->{'bgc_mode'});
- my $use_dynroot = $nl->get_value('use_dynroot');
- if ( &value_is_true($use_dynroot) && ($nl_flags->{'bgc_mode'} eq "sp") ) {
- $log->fatal_error("Cannot turn dynroot mode on mode bgc=sp\n" .
- "Set the bgc mode to 'cn' or 'bgc'.");
- }
- if ( &value_is_true( $use_dynroot ) && &value_is_true( $nl_flags->{'use_hydrstress'} ) ) {
- $log->fatal_error("Cannot turn use_dynroot on when use_hydrstress is on" );
- }
-}
-
-#-------------------------------------------------------------------------------
-
-sub setup_logic_canopy {
- my ($opts, $nl_flags, $definition, $defaults, $nl, $physv) = @_;
- #
- # Canopy state
- #
- add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults,
- $nl, 'leaf_mr_vcm', 'phys'=>$nl_flags->{'phys'} )
-}
-
-#-------------------------------------------------------------------------------
-
-sub setup_logic_soilwater_movement {
- # soilwater_movement require clm4_5/clm5_0
- my ($opts, $nl_flags, $definition, $defaults, $nl, $physv) = @_;
-
- add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'soilwater_movement_method' );
- add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'upper_boundary_condition' );
-
- my $soilmtd = $nl->get_value("soilwater_movement_method");
- my $use_bed = $nl->get_value('use_bedrock' );
- add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl,
- 'lower_boundary_condition',
- 'soilwater_movement_method'=>$soilmtd, 'use_bedrock'=>$use_bed
- );
- add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'dtmin' );
- add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'verySmall' );
- add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'xTolerUpper' );
- add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'xTolerLower' );
- add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'expensive' );
- add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'inexpensive' );
- add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'flux_calculation' );
-}
-#-------------------------------------------------------------------------------
-
-sub setup_logic_cnvegcarbonstate {
- # MUST be AFTER: setup_logic_dynamic_plant_nitrogen_alloc as depends on mm_nuptake_opt which is set there
- my ($opts, $nl_flags, $definition, $defaults, $nl, $physv) = @_;
-
- if ( &value_is_true($nl->get_value('use_cn')) ) {
- my $mmnuptake = $nl->get_value('mm_nuptake_opt');
- if ( ! defined($mmnuptake) ) { $mmnuptake = ".false."; }
- add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'initial_vegC',
- 'use_cn' => $nl->get_value('use_cn'), 'mm_nuptake_opt' => $mmnuptake );
- }
-}
-
-#-------------------------------------------------------------------------------
-
-sub setup_logic_rooting_profile {
- #
- my ($opts, $nl_flags, $definition, $defaults, $nl, $physv) = @_;
-
- add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'rooting_profile_method_water' );
- add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'rooting_profile_method_carbon' );
-}
-
-#-------------------------------------------------------------------------------
-
-sub setup_logic_soil_resis {
- #
- my ($opts, $nl_flags, $definition, $defaults, $nl, $physv) = @_;
-
- add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'soil_resis_method' );
-}
-
-#-------------------------------------------------------------------------------
-
-sub setup_logic_canopyhydrology {
- #
- my ($opts, $nl_flags, $definition, $defaults, $nl, $physv) = @_;
-
- add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'interception_fraction' );
- add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'maximum_leaf_wetted_fraction' );
- add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'use_clm5_fpi' );
-}
-
-#-------------------------------------------------------------------------------
-
-sub setup_logic_snowpack {
- #
- # Snowpack related options
- #
- my ($opts, $nl_flags, $definition, $defaults, $nl, $physv) = @_;
-
- if ($physv->as_long() >= $physv->as_long("clm4_5")) {
- add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'nlevsno');
- add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'h2osno_max');
- add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'int_snow_max');
- add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'n_melt_glcmec');
- add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'wind_dependent_snow_density');
- add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'snow_overburden_compaction_method');
- add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'lotmp_snowdensity_method');
- add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'upplim_destruct_metamorph');
- add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'fresh_snw_rds_max');
- add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'reset_snow');
- add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'reset_snow_glc');
- add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'reset_snow_glc_ela');
-
- if (remove_leading_and_trailing_quotes($nl->get_value('snow_overburden_compaction_method')) eq 'Vionnet2012') {
- # overburden_compress_tfactor isn't used if we're using the Vionnet2012
- # snow overburden compaction method, so make sure the user hasn't tried
- # to set it
- if (defined($nl->get_value('overburden_compress_tfactor'))) {
- $log->fatal_error('overburden_compress_tfactor is set, but does not apply when using snow_overburden_compaction_method=Vionnet2012');
- }
- } else {
- add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'overburden_compress_tfactor');
- }
- }
-}
-
-#-------------------------------------------------------------------------------
-
-sub setup_logic_atm_forcing {
- #
- # Options related to atmospheric forcings
- #
- my ($opts, $nl_flags, $definition, $defaults, $nl, $physv) = @_;
-
- if ($physv->as_long() >= $physv->as_long("clm4_5")) {
- add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'glcmec_downscale_longwave');
- add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'repartition_rain_snow');
- add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'lapse_rate');
-
- my $var;
-
- foreach $var ("lapse_rate_longwave",
- "longwave_downscaling_limit") {
- if ( &value_is_true($nl->get_value("glcmec_downscale_longwave")) ) {
- add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, $var);
- } else {
- if (defined($nl->get_value($var))) {
- $log->fatal_error("$var can only be set if glcmec_downscale_longwave is true");
- }
- }
- }
-
- foreach $var ("precip_repartition_glc_all_snow_t",
- "precip_repartition_glc_all_rain_t",
- "precip_repartition_nonglc_all_snow_t",
- "precip_repartition_nonglc_all_rain_t") {
- if ( &value_is_true($nl->get_value("repartition_rain_snow")) ){
- add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, $var);
- } else {
- if (defined($nl->get_value($var))) {
- $log->fatal_error("$var can only be set if repartition_rain_snow is true");
- }
- }
- }
- }
-}
-
-#-------------------------------------------------------------------------------
-
-sub setup_logic_lnd2atm {
- #
- # Options related to fields sent to atmosphere
- #
- my ($opts, $nl_flags, $definition, $defaults, $nl, $physv) = @_;
-
- if ($physv->as_long() >= $physv->as_long("clm4_5")) {
- add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'melt_non_icesheet_ice_runoff');
- }
-}
-
-#-------------------------------------------------------------------------------
-
-sub write_output_files {
- my ($opts, $nl_flags, $defaults, $nl, $physv) = @_;
-
- my $note = "";
- my $var = "note";
- if ( ! defined($opts->{$var}) ) {
- $opts->{$var} = $defaults->get_value($var);
- }
- if ( $opts->{$var} ) {
- $note = "Comment:\n" .
- "This namelist was created using the following command-line:\n" .
- " $nl_flags->{'cfgdir'}/$ProgName $nl_flags->{'cmdline'}\n" .
- "For help on options use: $nl_flags->{'cfgdir'}/$ProgName -help";
- }
-
- # CLM component
- my @groups = qw(clm_inparm
- lai_streams atm2lnd_inparm lnd2atm_inparm
- cnvegcarbonstate
- finidat_consistency_checks
- clm_initinterp_inparm
- soilwater_movement_inparm rooting_profile_inparm
- soil_resis_inparm bgc_shared
- clmu_inparm clm_soilstate_inparm
- clm_soilhydrology_inparm
- clm_glacier_behavior);
-
- if ( $physv->as_long() >= $physv->as_long("clm4_5") ) {
- push @groups, "cn_general";
- push @groups, "clm_canopy_inparm";
- }
-
- my $outfile;
- $outfile = "$opts->{'dir'}/lnd_in";
- $nl->write($outfile, 'groups'=>\@groups, 'note'=>"$note" );
- $log->verbose_message("Writing clm namelist to $outfile");
-}
-
-sub write_output_real_parameter_file {
- my ($opts, $nl_flags, $definition, $defaults, $nl, $physv) = @_;
-
- # Output real parameters
- if ( defined($opts->{'output_reals_filename'}) ) {
- my $file = $opts->{'output_reals_filename'};
- my $fh = IO::File->new($file, '>>') or $log->fatal_error("can't create real parameter filename: $file");
- foreach my $var ( $definition->get_var_names() ) {
- my $type = $definition->get_var_type($var);
- my $doc = $definition->get_var_doc($var);
- $doc =~ s/\n//g;
- if ( $type =~ /real/ ) {
- my $val = $nl->get_value($var);
- if ( ! defined($val) ) { $val = "?.??"; }
- print $fh "\! $doc\n$var = $val\n";
- }
- }
- $fh->close();
- }
-}
-
-#-------------------------------------------------------------------------------
-
-sub add_default {
-
-# Add a value for the specified variable to the specified namelist object. The variables
-# already in the object have the higher precedence, so if the specified variable is already
-# defined in the object then don't overwrite it, just return.
-#
-# This method checks the definition file and adds the variable to the correct
-# namelist group.
-#
-# The value can be provided by using the optional argument key 'val' in the
-# calling list. Otherwise a default value is obtained from the namelist
-# defaults object. If no default value is found this method throws an exception
-# unless the 'nofail' option is set true.
-#
-# Example 1: Specify the default value $val for the namelist variable $var in namelist
-# object $nl:
-#
-# add_default($inputdata_rootdir, $definition, $defaults, $nl, $var, 'val'=>$val)
-#
-# Example 2: Add a default for variable $var if an appropriate value is found. Otherwise
-# don't add the variable
-#
-# add_default($inputdata_rootdir, $definition, $defaults, $nl, $var, 'nofail'=>1)
-#
-#
-# ***** N.B. ***** This routine assumes the following variables are in package main::
-# $definition -- the namelist definition object
-# $defaults -- the namelist defaults object
-# $inputdata_rootdir -- CESM inputdata root directory
-
- my $opts = shift;
- my $inputdata_rootdir = shift;
- my $definition = shift;
- my $defaults = shift;
- my $nl = shift;
- my $var = shift;
- my %settings = @_;
-
- my $test_files = $opts->{'test'};
- #my $nl = shift; # namelist object
- #my $var = shift; # name of namelist variable
- #my %settings = @_; # options
-
- # If variable has quotes around it
- if ( $var =~ /'(.+)'/ ) {
- $var = $1;
- }
- # Query the definition to find which group the variable belongs to. Exit if not found.
-
- my $group = $definition->get_group_name($var);
- unless ($group) {
- my $fname = $definition->get_file_name();
- $log->fatal_error("variable \"$var\" not found in namelist definition file $fname.");
- }
-
- # check whether the variable has a value in the namelist object -- if so then skip to end
- my $val = $nl->get_variable_value($group, $var);
- if (! defined $val) {
-
- # Look for a specified value in the options hash
-
- if (defined $settings{'val'}) {
- $val = $settings{'val'};
- }
- # or else get a value from namelist defaults object.
- # Note that if the 'val' key isn't in the hash, then just pass anything else
- # in %settings to the get_value method to be used as attributes that are matched
- # when looking for default values.
- else {
-
- $val = $defaults->get_value($var, \%settings);
-
- # Truncate model_version appropriately
-
- if ( $var eq "model_version" ) {
- $val =~ /(URL: https:\/\/[a-zA-Z0-9._-]+\/)([a-zA-Z0-9\/._-]+)(\/bld\/.+)/;
- $val = $2;
- }
- }
-
- # if no value is found then exit w/ error (unless 'nofail' option set)
- unless ( defined($val) ) {
- unless ($settings{'nofail'}) {
- if ($var eq 'finidat') {
- $log->message("No default value found for $var.\n" .
- " Are defaults provided for this resolution and land mask?" );
- } else {
- $log->fatal_error("No default value found for $var.\n" .
- " Are defaults provided for this resolution and land mask?");
- }
- }
- else {
- return;
- }
- }
-
- # query the definition to find out if the variable is an input pathname
- my $is_input_pathname = $definition->is_input_pathname($var);
-
- # The default values for input pathnames are relative. If the namelist
- # variable is defined to be an absolute pathname, then prepend
- # the CESM inputdata root directory.
- if (not defined $settings{'no_abspath'}) {
- if (defined $settings{'set_abspath'}) {
- $val = set_abs_filepath($val, $settings{'set_abspath'});
- } else {
- if ($is_input_pathname eq 'abs') {
- $val = set_abs_filepath($val, $inputdata_rootdir);
- if ( $test_files and ($val !~ /null/) and (! -f "$val") ) {
- $log->fatal_error("file not found: $var = $val");
- }
- }
- }
- }
-
- # query the definition to find out if the variable takes a string value.
- # The returned string length will be >0 if $var is a string, and 0 if not.
- my $str_len = $definition->get_str_len($var);
-
- # If the variable is a string, then add quotes if they're missing
- if ($str_len > 0) {
- $val = quote_string($val);
- }
-
- # set the value in the namelist
- $nl->set_variable_value($group, $var, $val);
- }
-
-}
-
-#-------------------------------------------------------------------------------
-
-sub expand_xml_variables_in_namelist {
- # Go through all variables in the namelist and expand any XML env settings in them
- my ($nl, $xmlvar_ref) = @_;
-
- foreach my $group ( $nl->get_group_names() ) {
- foreach my $var ( $nl->get_variable_names($group) ) {
- my $val = $nl->get_variable_value($group, $var);
- my $newval = SetupTools::expand_xml_var( $val, $xmlvar_ref );
- if ( $newval ne $val ) {
- $nl->set_variable_value($group, $var, $newval);
- }
- }
- }
-}
-
-#-------------------------------------------------------------------------------
-
-sub check_input_files {
-
-# For each variable in the namelist which is an input dataset, check to see if it
-# exists locally.
-#
-# ***** N.B. ***** This routine assumes the following variables are in package main::
-# $definition -- the namelist definition object
-# $nl -- namelist object
-# $inputdata_rootdir -- if false prints test, else creates inputdata file
-
- my ($nl, $inputdata_rootdir, $outfile, $definition) = @_;
-
- open(OUTFILE, ">>$outfile") if defined $inputdata_rootdir;
-
- # Look through all namelist groups
- my @groups = $nl->get_group_names();
- foreach my $group (@groups) {
-
- # Look through all variables in each group
- my @vars = $nl->get_variable_names($group);
- foreach my $var (@vars) {
-
- # Is the variable an input dataset?
- my $input_pathname_type = $definition->is_input_pathname($var);
-
- # If it is, check whether it exists locally and print status
- if ($input_pathname_type) {
-
- # Get pathname of input dataset
- my $pathname = $nl->get_variable_value($group, $var);
- # Need to strip the quotes
- $pathname =~ s/['"]//g;
-
- if ($input_pathname_type eq 'abs') {
- if ($inputdata_rootdir) {
- #MV $pathname =~ s:$inputdata_rootdir::;
- print OUTFILE "$var = $pathname\n";
- }
- else {
- if (-e $pathname) { # use -e rather than -f since the absolute pathname
- # might be a directory
- print "OK -- found $var = $pathname\n";
- }
- else {
- print "NOT FOUND: $var = $pathname\n";
- }
- }
- }
- elsif ($input_pathname_type =~ m/rel:(.+)/o) {
- # The match provides the namelist variable that contains the
- # root directory for a relative filename
- my $rootdir_var = $1;
- my $rootdir = $nl->get_variable_value($group, $rootdir_var);
- $rootdir =~ s/['"]//g;
- if ($inputdata_rootdir) {
- $pathname = "$rootdir/$pathname";
- #MV $pathname =~ s:$inputdata_rootdir::;
- print OUTFILE "$var = $pathname\n";
- }
- else {
- if (-f "$rootdir/$pathname") {
- print "OK -- found $var = $rootdir/$pathname\n";
- }
- else {
- print "NOT FOUND: $var = $rootdir/$pathname\n";
- }
- }
- }
- }
- }
- }
- close OUTFILE if defined $inputdata_rootdir;
- return 0 if defined $inputdata_rootdir;
-}
-
-#-------------------------------------------------------------------------------
-
-sub set_abs_filepath {
-
-# check whether the input filepath is an absolute path, and if it isn't then
-# prepend a root directory
-
- my ($filepath, $rootdir) = @_;
-
- # strip any leading/trailing whitespace and quotes
- $filepath = trim($filepath);
- $filepath = remove_leading_and_trailing_quotes($filepath);
- $rootdir = trim($rootdir);
- $rootdir = remove_leading_and_trailing_quotes($rootdir);
-
- my $out = $filepath;
- unless ( $filepath =~ /^\// ) { # unless $filepath starts with a /
- $out = "$rootdir/$filepath"; # prepend the root directory
- }
- return $out;
-}
-
-#-------------------------------------------------------------------------------
-
-sub valid_option {
-
- my ($val, @expect) = @_;
-
- my $expect;
-
- $val = trim($val);
-
- foreach $expect (@expect) {
- if ($val =~ /^$expect$/i) { return $expect; }
- }
- return undef;
-}
-
-#-------------------------------------------------------------------------------
-
-sub check_use_case_name {
-#
-# Check the use-case name and ensure it follows the naming convention.
-#
- my ($use_case) = @_;
-
- my $diestring = "bad use_case name $use_case, follow the conventions " .
- "in namelist_files/use_cases/README\n";
- my $desc = "[a-zA-Z0-9]*";
- my $rcp = "rcp[0-9\.]+";
- if ( $use_case =~ /^[0-9]+-[0-9]+([a-zA-Z0-9_\.]*)_transient$/ ) {
- my $string = $1;
- if ( $string =~ /^_($rcp)_*($desc)$/ ) {
- # valid name
- } elsif ( $string =~ /^_*($desc)$/ ) {
- # valid name
- } else {
- $log->fatal_error($diestring);
- }
- } elsif ( $use_case =~ /^20thC([a-zA-Z0-9_\.]*)_transient$/ ) {
- my $string = $1;
- if ( $string =~ /^_($rcp)_*($desc)$/ ) {
- # valid name
- } elsif ( $string =~ /^_*($desc)$/ ) {
- # valid name
- } else {
- $log->fatal_error($diestring);
- }
- } elsif ( $use_case =~ /^([0-9]+)_*($desc)_control$/ ) {
- # valid name
- } elsif ( $use_case =~ /^($desc)_pd$/ ) {
- # valid name
- } else {
- $log->fatal_error($diestring);
- }
-}
-
-#-------------------------------------------------------------------------------
-
-sub validate_options {
-
-# $source -- text string declaring the source of the options being validated
-# $cfg -- configure object
-# $opts -- reference to hash that contains the options
-
- my ($source, $cfg, $opts) = @_;
-
- my ($opt, $old, @expect);
-
- # use_case
- $opt = 'use_case';
- if (defined $opts->{$opt}) {
-
- if ( $opts->{$opt} ne "list" ) {
- # create the @expect array by listing the files in $use_case_dir
- # and strip off the ".xml" part of the filename
- @expect = ();
- my @files = glob("$opts->{'use_case_dir'}/*.xml");
- foreach my $file (@files) {
- $file =~ m{.*/(.*)\.xml};
- &check_use_case_name( $1 );
- push @expect, $1;
- }
-
- $old = $opts->{$opt};
- $opts->{$opt} = valid_option($old, @expect)
- or $log->fatal_error("invalid value of $opt ($old) specified in $source\n" .
- "expected one of: @expect");
- } else {
- print "Use cases are:...\n\n";
- my @ucases;
- foreach my $file( sort( glob($opts->{'use_case_dir'}."/*.xml") ) ) {
- my $use_case;
- if ( $file =~ /\/([^\/]+)\.xml$/ ) {
- &check_use_case_name( $1 );
- $use_case = $1;
- } else {
- $log->fatal_error("Bad name for use case file = $file");
- }
- my $uc_defaults = Build::NamelistDefaults->new("$file", $cfg);
- printf "%15s = %s\n", $use_case, $uc_defaults->get_value("use_case_desc");
- push @ucases, $use_case;
- }
- $log->exit_message("use cases : @ucases");
- }
- }
-}
-
-#-------------------------------------------------------------------------------
-
-sub list_options {
-#
-# List the options for different command line values if asked for
-#
- my ($opts_cmdl, $definition, $defaults) = @_;
-
- # options to list values that are in the defaults files
- my @opts_list = ( "res", "mask", "sim_year", "rcp" );
- my %opts_local;
- foreach my $var ( "res", "mask", "sim_year", "rcp" ) {
- my $val;
- if ( $opts_cmdl->{$var} eq "list" ) {
- $val = "default";
- } elsif ( $opts_cmdl->{$var} eq "default" ) {
- $val = $defaults->get_value($var, \%opts_local );
- } else {
- $val = $opts_cmdl->{$var};
- }
- my $vname = $var;
- if ( $vname eq "res" ) { $vname = "hgrid"; }
- $opts_local{$vname} = $val;
- }
- foreach my $var ( @opts_list ) {
- if (defined $opts_cmdl->{$var}) {
-
- if ( $opts_cmdl->{$var} eq "list" ) {
- my @valid_values = $definition->get_valid_values( $var );
- if ( $var eq "sim_year" ) {
- unshift( @valid_values,
- $definition->get_valid_values( "sim_year_range" ) );
- }
- unshift( @valid_values, "default" );
- # Strip out quotes and the constant value
- for( my $i = 0; $i <= $#valid_values; $i++ ) {
- $valid_values[$i] =~ s/('|')//g;
- if ( $valid_values[$i] eq "constant" ) { $valid_values[$i] = undef; }
- }
- my $val= $defaults->get_value($var, \%opts_local);
- my $doc = $definition->get_var_doc( $var );
- $doc =~ s/\n//;
- chomp( $doc );
- $log->exit_message("valid values for $var ($doc) :\n" .
- " Values: @valid_values\n" .
- " Default = $val\n" .
- " (NOTE: resolution and mask and other settings may influence what the default is)");
- }
- }
- }
- # clm_demand
- my $var = 'clm_demand';
- if (defined $opts_cmdl->{$var}) {
-
- if ( $opts_cmdl->{$var} eq "list" ) {
- my @vars = $definition->get_var_names( );
- my @demands = ( "null" );
- foreach my $var ( @vars ) {
- if ( $definition->get_group_name( $var ) ne "clm_inparm" ) { next; }
- if ( defined($defaults->get_value($var, $opts_cmdl ) ) ) {
- push( @demands, $var );
- }
- }
- my $doc = $definition->get_var_doc( 'clm_demand' );
- $doc =~ s/\n//;
- chomp( $doc );
- $log->exit_message("valid values for $var ($doc) :\n" .
- "Namelist options to require: @demands\n" .
- "any valid namelist item for clm_inparm can be set. However, not all are\n" .
- "available in the clm defaults file. The defaults are also dependent on\n" .
- "resolution and landmask, as well as other settings. Hence, the list above\n" .
- "will vary depending on what you set for resolution and landmask.");
- }
- }
-}
-
-#-------------------------------------------------------------------------------
-
-sub trim {
- # remove leading and trailing whitespace from a string.
- my ($str) = @_;
- $str =~ s/^\s+//;
- $str =~ s/\s+$//;
- return $str;
-}
-
-#-------------------------------------------------------------------------------
-
-sub quote_string {
- # Add quotes around a string, unless they are already there
- my ($str) = @_;
- $str = trim($str);
- unless ($str =~ /^['"]/) { #"'
- $str = "\'$str\'";
- }
- return $str;
- }
-
-#-------------------------------------------------------------------------------
-
-sub remove_leading_and_trailing_quotes {
- # Remove leading and trailing single and double quotes from a string. Also
- # removes leading spaces before the leading quotes, and trailing spaces after
- # the trailing quotes.
-
- my ($str) = @_;
-
- $str = trim($str);
-
- # strip any leading/trailing quotes
- $str =~ s/^['"]+//;
- $str =~ s/["']+$//;
-
- return $str;
-}
-
-#-------------------------------------------------------------------------------
-
-sub logical_to_fortran {
- # Given a logical variable ('true' / 'false'), convert it to a fortran-style logical ('.true.' / '.false.')
- # The result will be lowercase, regardless of the case of the input.
- my ($var) = @_;
- my $result;
-
- if (lc($var) eq 'true') {
- $result = ".true.";
- }
- elsif (lc($var) eq 'false') {
- $result = ".false.";
- }
- else {
- $log->fatal_error("Unexpected value in logical_to_fortran: $var");
- }
-
- return $result;
-}
-
-#-------------------------------------------------------------------------------
-
-sub string_is_undef_or_empty {
- # Return true if the given string is undefined or only spaces, false otherwise.
- # A quoted empty string (' ' or " ") is treated as being empty.
- my ($str) = @_;
- if (!defined($str)) {
- return 1;
- }
- else {
- $str = remove_leading_and_trailing_quotes($str);
- if ($str =~ /^\s*$/) {
- return 1;
- }
- else {
- return 0;
- }
- }
-}
-
-#-------------------------------------------------------------------------------
-
-sub value_is_true {
- # Return true if the given namelist value is .true.
- # An undefined value is treated as false (with the assumption that false is the default in the code)
- my ($val) = @_;
-
- # Some regular expressions...
- ###my $TRUE = qr/\.true\./i;
- ###my $FALSE = qr/\.false\./i;
- # **N.B.** the use of qr// for precompiling regexps isn't supported until perl 5.005.
- my $TRUE = '\.?true\.?|[t]';
- my $FALSE = '\.?false\.?|[f]';
- my $is_true = 0;
- if (defined($val)) {
- if ($val =~ /$TRUE/i) {
- $is_true = 1;
- }
- }
-
- return $is_true;
-}
-
-#-------------------------------------------------------------------------------
-
-sub version {
-# The version is found in CLM ChangeLog file.
-# $cfgdir is set by the configure script to the name of its directory.
-
- my ($cfgdir) = @_;
-
- my $logfile = "$cfgdir/../doc/ChangeLog";
-
- my $fh = IO::File->new($logfile, '<') or $log->fatal_error("can't open ChangeLog file: $logfile");
-
- while (my $line = <$fh>) {
-
- if ($line =~ /^Tag name:\s*([a-zA-Z0-9_. -]*[clmcesm0-9_.-]+)$/ ) {
- $log->exit_message("$1");
- }
- }
-}
-
-#-------------------------------------------------------------------------------
-
-sub main {
- my %nl_flags;
- $nl_flags{'cfgdir'} = dirname(abs_path($0));
-
- my %opts = process_commandline(\%nl_flags);
- my $cfgdir = $nl_flags{'cfgdir'};
- check_for_perl_utils($cfgdir, \%opts);
-
- $log = namelist_files::LogMessages->new( $ProgName, \%opts ); # global
- version($cfgdir) if $opts{'version'};
- my $cfg = read_configure_definition($cfgdir, \%opts);
-
- my $physv = config_files::clm_phys_vers->new( $cfg->get('phys') );
- my $definition = read_namelist_definition($cfgdir, \%opts, \%nl_flags, $physv);
- my $defaults = read_namelist_defaults($cfgdir, \%opts, \%nl_flags, $cfg, $physv);
-
- # List valid values if asked for
- list_options(\%opts, $definition, $defaults);
-
- # Validate some of the commandline option values.
- validate_options("commandline", $cfg, \%opts);
-
- # Create an empty namelist object.
- my $nl = Build::Namelist->new();
-
- check_cesm_inputdata(\%opts, \%nl_flags);
-
- # Read in the env_*.xml files
- my %env_xml = read_envxml_case_files( \%opts );
-
- # Process the user inputs
- process_namelist_user_input(\%opts, \%nl_flags, $definition, $defaults, $nl, $cfg, \%env_xml, $physv );
- # Get any other defaults needed from the namelist defaults file
- process_namelist_inline_logic(\%opts, \%nl_flags, $definition, $defaults, $nl, $cfg, \%env_xml, $physv);
-
- # Validate that the entire resultant namelist is valid
- $definition->validate($nl);
- write_output_files(\%opts, \%nl_flags, $defaults, $nl, $physv);
- write_output_real_parameter_file(\%opts, \%nl_flags, $definition, $defaults, $nl, $physv);
-
- if ($opts{'inputdata'}) {
- check_input_files($nl, $nl_flags{'inputdata_rootdir'}, $opts{'inputdata'}, $definition);
- }
- $log->final_exit("Successfully made CLM namelist file");
-}
-
-#-------------------------------------------------------------------------------
-
-1;
diff --git a/bld/Filepath b/bld/Filepath
deleted file mode 100644
index b8ec46d2..00000000
--- a/bld/Filepath
+++ /dev/null
@@ -1,8 +0,0 @@
-../SourceMods/src.clm
-/glade/p/work/erik/SimpleLand/src/main
-/glade/p/work/erik/SimpleLand/src/biogeophys
-/glade/p/work/erik/SimpleLand/src/biogeochem
-/glade/p/work/erik/SimpleLand/src/soilbiogeochem
-/glade/p/work/erik/SimpleLand/src/init_interp
-/glade/p/work/erik/SimpleLand/src/utils
-/glade/p/work/erik/SimpleLand/src/cpl
diff --git a/bld/build-namelist b/bld/build-namelist
deleted file mode 100755
index 46e485d1..00000000
--- a/bld/build-namelist
+++ /dev/null
@@ -1,23 +0,0 @@
-#!/usr/bin/env perl
-#-----------------------------------------------------------------------------------------------
-#
-# clm build-namelist driver
-#
-# Placing all of build-namelist into CLMBuildNamelist.pm means we can unit test the module.
-#
-require 5;
-
-use strict;
-
-BEGIN {
- # ensure that the cesm create_X scripts can find CLMBuildNamelist.pm
- use File::Basename qw(dirname);
- use Cwd qw(abs_path);
- my $dirname = dirname(abs_path($0));
- my @dirs = ($dirname, );
- unshift @INC, @dirs;
-}
-
-use CLMBuildNamelist qw(main);
-
-CLMBuildNamelist::main();
diff --git a/bld/config_cache.xml b/bld/config_cache.xml
deleted file mode 100644
index 2875f0b1..00000000
--- a/bld/config_cache.xml
+++ /dev/null
@@ -1,29 +0,0 @@
-
-
-
-
-
-/glade/p/work/erik/SimpleLand/bld/configure
-
-
-Root directory of CLM source distribution (directory above CLM configure).
-
-
-Component framework interface to use
-(Model Coupling Toolkit, or Earth System Modeling Framework)
-
-
-User specified CPP defines to append to Makefile defaults.
-Note: It's recommended to use configure options to set standard CPP values rather
-than defining them here.
-
-
-Specifies either clm4_5, or clm5_0 physics
-
-
-User source directories to prepend to the filepath. Multiple directories
-are specified as a comma separated list with no embedded white space.
-Normally this is SourceMods/src.clm in your case.
-
-
-
diff --git a/bld/config_files/clm_phys_vers.pm b/bld/config_files/clm_phys_vers.pm
deleted file mode 100755
index efd83609..00000000
--- a/bld/config_files/clm_phys_vers.pm
+++ /dev/null
@@ -1,196 +0,0 @@
-package config_files::clm_phys_vers;
-my $pkg_nm = 'config_files::clm_phys_vers';
-#-----------------------------------------------------------------------------------------------
-#
-# SYNOPSIS
-#
-# require config_files::clm_phys_vers;
-#
-# my $phys = config_files::clm_phys_vers->new("clm4_5");
-# print $phys->as_float();
-# print $phys->as_long();
-# print $phys->as_string();
-# print $phys->as_filename();
-#
-# DESCRIPTION
-#
-# Enter the physics version as a string, with a list of valid versions, and have the ability to convert it to
-# different formats.
-#
-# COLLABORATORS: None
-#
-#-----------------------------------------------------------------------------------------------
-#
-# Date Author Modification
-# 03/06/2014 Erik Kluzek creation
-#
-#--------------------------------------------------------------------------------------------
-
-use strict;
-use bigint;
-#use warnings;
-#use diagnostics;
-
-my $major_mask = 1000000;
-my $minor_mask = 1000;
-my @version_strings = ( "clm4_5", "clm5_0" );
-my @version_long = ( 4*$major_mask+5*$minor_mask, 5*$major_mask );
-
-#-------------------------------------------------------------------------------
-
-sub new {
- # Constructor, enter version string as argument
- my $class = shift;
- my $vers_string = shift;
-
- my $nm = "$class\:\:new";
- my $self = {};
- bless($self, $class);
- $self->__validate_vers__( $vers_string );
- $self->{'vers_string'} = $vers_string;
- return( $self );
-}
-
-#-------------------------------------------------------------------------------
-
-sub __validate_vers__ {
- # Make sure the version string is a valid one
- my $class = shift;
- my $vers_string = shift;
-
- my $found = undef;
- foreach my $i (0..$#version_strings) {
- if ( $vers_string eq $version_strings[$i] ) {
- $found = 1;
- last;
- }
- }
- if ( ! defined($found) ) {
- die "NOT a valid CLM version: $vers_string\n";
- }
-}
-
-#-------------------------------------------------------------------------------
-
-sub as_long {
-# Return the physics version as a long
- my $self = shift;
- my $vers = shift;
-
- if ( ! defined($vers) ) {
- $vers = $self->{'vers_string'};
- } else {
- $self->__validate_vers__( $vers );
- }
- my $phys = undef;
- for( my $i = 0; $i <= $#version_strings; $i++ ) {
- if ( $vers eq $version_strings[$i] ) {
- $phys = $version_long[$i];
- last;
- }
- }
- return( $phys );
-}
-
-#-------------------------------------------------------------------------------
-
-sub as_float {
-# Return the physics version as a float
- my $self = shift;
-
- my $long = $self->as_long();
- my $major = int($long / $major_mask);
- my $minor = int(($long - $major*$major_mask)/ $minor_mask);
- my $rev = $long - $major*$major_mask - $minor*$minor_mask;
- {
- no bigint;
- use bignum;
-
- my $phys = $major*1.0 + $minor/10.0 + $rev / 10000.0;
- return( $phys );
- }
-}
-
-#-------------------------------------------------------------------------------
-
-sub as_string {
-# Return the physics version as a string
- my $self = shift;
-
- my $phys = $self->{'vers_string'};
- return( $phys );
-}
-
-#-------------------------------------------------------------------------------
-
-sub as_filename {
-# Return the physics version string with clm4_5 and clm5_0 pointing to the same name
- my $self = shift;
-
- my $phys = undef;
- if ( $self->as_long() < 5*$major_mask ) {
- $phys = $self->as_string();
- } else {
- $phys = "clm4_5";
- }
- return( $phys );
-}
-
-#-----------------------------------------------------------------------------------------------
-# Unit testing of above
-#-----------------------------------------------------------------------------------------------
-if ( ! defined(caller) && $#ARGV == -1 ) {
- package phys_vers_unit_tester;
-
- require Test::More;
- Test::More->import( );
-
- plan( tests=>8);
-
- sub testit {
- print "unit tester\n";
- my %lastv;
- my @vers_list = ( "clm4_5", "clm5_0" );
- foreach my $vers ( @vers_list ) {
- my $phys = config_files::clm_phys_vers->new($vers);
- isa_ok($phys, "config_files::clm_phys_vers", "created clm_phys_vers object");
- print "$vers: long: ".$phys->as_long()." float: ".$phys->as_float()." string: ".$phys->as_string()." file: ".$phys->as_filename()."\n";
- if ( exists($lastv{"long"}) ) {
- is( $phys->as_long() > $lastv{'long'}, 1, "Definition of long is not increasing\n" );
- }
- if ( exists($lastv{"float"}) ) {
- is( $phys->as_float() > $lastv{'float'}, 1, "Definition of float is not increasing\n" );
- }
- # Check that also can get results of any valid value for long
- foreach my $chvers ( @vers_list ) {
- my $lvalue = $phys->as_long($chvers);
- print "Long value of $chvers = $lvalue\n";
- }
- # Check that a bad value gives an error
- eval { $phys->as_long('xxx'); };
- like( $@, qr/NOT a valid CLM version:/, "check that a bad version fails" );
- # Save last values to make sure increasing
- $lastv{'long'} = $phys->as_long();
- $lastv{'float'} = $phys->as_float();
- }
- my $phys = config_files::clm_phys_vers->new("clm4_5");
- no bigint;
- use bignum;
- is( 4.5, $phys->as_float(), "Make sure clm4_5 correct float value" );
- no bignum;
- use bigint;
- $phys = config_files::clm_phys_vers->new("clm5_0");
- is( 5.0, $phys->as_float(), "Make sure clm5_0 correct float value" );
- print "\nSuccessfully ran all tests\n";
- }
-}
-
-#-----------------------------------------------------------------------------------------------
-# Determine if you should run the unit test or if this is being called from a require statement
-#-----------------------------------------------------------------------------------------------
-
-if ( defined(caller) ) {
- 1 # to make use or require happy
-} elsif ( $#ARGV == -1 ) {
- &phys_vers_unit_tester::testit();
-}
diff --git a/bld/config_files/config_defaults.xml b/bld/config_files/config_defaults.xml
deleted file mode 100644
index 09d5634b..00000000
--- a/bld/config_files/config_defaults.xml
+++ /dev/null
@@ -1,7 +0,0 @@
-
-
-
-
-
-
-
diff --git a/bld/config_files/config_definition.xsl b/bld/config_files/config_definition.xsl
deleted file mode 100644
index f2f88609..00000000
--- a/bld/config_files/config_definition.xsl
+++ /dev/null
@@ -1,72 +0,0 @@
-
-
-
-
-
-
-
-
-
-
-
-
- CLM Configuration Definition
-
-
- CLM Configuration Definition
-
-
- CLM Physics Configurations
-
- Name
- Value
- Description
-
-
- Valid Values
-
-
-
-
-
- CLM Biogeochemistry Configurations
-
- Name
- Value
- Description
-
-
- Valid Value
-
-
-
-
-
- Configuration Directories
-
- Name
- Value
- Description
-
-
- Valid Value
-
-
-
-
-
-
-
-
-
-
-
-
-
-
- Valid values:
-
-
-
-
-
diff --git a/bld/config_files/config_definition_clm4_5.xml b/bld/config_files/config_definition_clm4_5.xml
deleted file mode 100644
index eb38cbe2..00000000
--- a/bld/config_files/config_definition_clm4_5.xml
+++ /dev/null
@@ -1,45 +0,0 @@
-
-
-
-
-
-
-
-Specifies either clm4_5, or clm5_0 physics
-
-
-
-Root directory of CLM source distribution (directory above CLM configure).
-
-
-
-Component framework interface to use
-(Model Coupling Toolkit, or Earth System Modeling Framework)
-
-
-
-User source directories to prepend to the filepath. Multiple directories
-are specified as a comma separated list with no embedded white space.
-Normally this is SourceMods/src.clm in your case.
-
-
-
-User specified CPP defines to append to Makefile defaults.
-Note: It's recommended to use configure options to set standard CPP values rather
-than defining them here.
-
-
-
diff --git a/bld/configure b/bld/configure
deleted file mode 100755
index 9823585f..00000000
--- a/bld/configure
+++ /dev/null
@@ -1,559 +0,0 @@
-#!/usr/bin/env perl
-#-----------------------------------------------------------------------------------------------
-#
-# configure
-#
-#
-# This utility allows the CLM user to specify compile-time configuration
-# options via a commandline interface. The output from configure is a
-# Makefile and a cache file that contains all configuration parameters
-# required to produce the Makefile. A subsequent invocation of configure
-# can use the cache file as input (via the -defaults argument) to reproduce
-# the CLM configuration contained in it. Note that when a cache file is
-# used to set default values only the model parameters are used. The
-# parameters that are platform dependent (e.g., compiler options, library
-# locations, etc) are ignored.
-#
-# As the build time configurable options of CLM are changed, this script
-# must also be changed. Thus configure is maintained under revision
-# control in the CLM source tree and it is assumed that only the version of
-# configure in the source tree will be used to build CLM. Thus we assume
-# that the root of the source tree can be derived from the location of this
-# script.
-#
-#-----------------------------------------------------------------------------------------------
-
-use strict;
-#use warnings;
-#use diagnostics;
-use Cwd qw(getcwd abs_path);
-use English;
-use Getopt::Long;
-use IO::File;
-use IO::Handle;
-use File::Copy;
-
-#-----------------------------------------------------------------------------------------------
-
-sub usage {
- die <). Any value that contains
- white-space must be quoted. Long option names may be supplied with either single
- or double leading dashes. A consequence of this is that single letter options may
- NOT be bundled.
-
- -bgc Build CLM with BGC package [ none | cn | cndv ]
- (default is none).
- -cache Name of output cache file (default: config_cache.xml).
- -cachedir Name of directory where output cache file is written
- (default: CLM build directory).
- -cimeroot REQUIRED: Path to cime directory
- -clm_root Root directory of clm source code
- (default: directory above location of this script)
- -cppdefs A string of user specified CPP defines. Appended to
- Makefile defaults. e.g. -cppdefs '-DVAR1 -DVAR2'
- -crop Toggle for prognostic crop model. [on | off] (default is off)
- (can ONLY be turned on when BGC type is CN or CNDV)
- -comp_intf Component interface to use (ESMF or MCT) (default MCT)
- -defaults Specify full path to a configuration file which will be used
- to supply defaults instead of the defaults in bld/config_files.
- This file is used to specify model configuration parameters only.
- Parameters relating to the build which are system dependent will
- be ignored.
- -help [or -h] Print usage to STDOUT.
- -nofire Turn off wildfires for BGC setting of CN
- (default includes fire for CN)
- -noio Turn history output completely off (typically for testing).
- -phys Value of clm4_5, or clm5_0 (default is clm4_5)
- -silent [or -s] Turns on silent mode - only fatal messages issued.
- -sitespf_pt Setup for the given site specific single-point resolution.
- -snicar_frc Turn on SNICAR radiative forcing calculation. [on | off]
- (default is off)
- -spinup CLM 4.0 Only. For CLM 4.5, spinup is controlled from build-namelist.
- Turn on given spinup mode for BGC setting of CN (level)
- AD Turn on Accelerated Decomposition from (2)
- bare-soil
- exit Jump directly from AD spinup to normal mode (1)
- normal Normal decomposition ("final spinup mode") (0)
- (default)
- The recommended sequence is 2-1-0
- -usr_src [,[,[...]]]
- Directories containing user source code.
- -verbose [or -v] Turn on verbose echoing of settings made by configure.
- -version Echo the SVN tag name used to check out this CLM distribution.
-EOF
-}
-
-#-----------------------------------------------------------------------------------------------
-# Setting autoflush (an IO::Handle method) on STDOUT helps in debugging. It forces the test
-# descriptions to be printed to STDOUT before the error messages start.
-
-*STDOUT->autoflush();
-
-#-----------------------------------------------------------------------------------------------
-# Set the directory that contains the CLM configuration scripts. If the configure command was
-# issued using a relative or absolute path, that path is in $ProgDir. Otherwise assume the
-# command was issued from the current working directory.
-
-(my $ProgName = $0) =~ s!(.*)/!!; # name of this script
-my $ProgDir = $1; # name of directory containing this script -- may be a
- # relative or absolute path, or null if the script is in
- # the user's PATH
-my $cwd = getcwd(); # current working directory
-my $cfgdir; # absolute pathname of directory that contains this script
-if ($ProgDir) {
- $cfgdir = abs_path($ProgDir);
-} else {
- $cfgdir = $cwd;
-}
-
-#-----------------------------------------------------------------------------------------------
-# Save commandline
-my $commandline = "$cfgdir/configure @ARGV";
-
-#-----------------------------------------------------------------------------------------------
-# Parse command-line options.
-my %opts = (
- cache => "config_cache.xml",
- phys => "clm4_5",
- nofire => undef,
- noio => undef,
- cimeroot => undef,
- clm_root => undef,
- spinup => "normal",
- );
-GetOptions(
- "spinup=s" => \$opts{'spinup'},
- "bgc=s" => \$opts{'bgc'},
- "cache=s" => \$opts{'cache'},
- "cachedir=s" => \$opts{'cachedir'},
- "snicar_frc=s" => \$opts{'snicar_frc'},
- "cimeroot=s" => \$opts{'cimeroot'},
- "clm_root=s" => \$opts{'clm_root'},
- "cppdefs=s" => \$opts{'cppdefs'},
- "comp_intf=s" => \$opts{'comp_intf'},
- "defaults=s" => \$opts{'defaults'},
- "clm4me=s" => \$opts{'clm4me'},
- "h|help" => \$opts{'help'},
- "nofire" => \$opts{'nofire'},
- "noio" => \$opts{'noio'},
- "phys=s" => \$opts{'phys'},
- "snicar_frc=s" => \$opts{'snicar_frc'},
- "s|silent" => \$opts{'silent'},
- "sitespf_pt=s" => \$opts{'sitespf_pt'},
- "usr_src=s" => \$opts{'usr_src'},
- "v|verbose" => \$opts{'verbose'},
- "version" => \$opts{'version'},
- "crop=s" => \$opts{'crop'},
-) or usage();
-
-# Give usage message.
-usage() if $opts{'help'};
-
-# Echo version info.
-version($cfgdir) if $opts{'version'};
-
-# Check for unparsed arguments
-if (@ARGV) {
- print "ERROR: unrecognized arguments: @ARGV\n";
- usage();
-}
-
-# Define 3 print levels:
-# 0 - only issue fatal error messages
-# 1 - only informs what files are created (default)
-# 2 - verbose
-my $print = 1;
-if ($opts{'silent'}) { $print = 0; }
-if ($opts{'verbose'}) { $print = 2; }
-my $eol = "\n";
-
-my %cfg = (); # build configuration
-
-#-----------------------------------------------------------------------------------------------
-# Make sure we can find required perl modules and configuration files.
-# Look for them in the directory that contains the configure script.
-
-my $cimeroot = $opts{'cimeroot'};
-if ( ! defined($cimeroot) ) {
- $cimeroot = "$cfgdir/../cime";
- if ( -d $cimeroot ) {
- } elsif ( -d "$cfgdir/../../../cime" ) {
- $cimeroot = "$cfgdir/../../../cime";
- } else {
- die <<"EOF";
-** Cannot find the root of the cime directory enter it using the -cimeroot option
- Did you run the checkout_externals scripts?
-EOF
- }
-}
-my $casecfgdir = "$cimeroot/scripts/Tools";
-my $perl5lib = "$cimeroot/utils/perl5lib/";
-
-# The Build::Config module provides utilities to store and manipulate the configuration.
-my $file = "$perl5lib/Build/Config.pm";
-(-f "$file") or die <<"EOF";
-** Cannot find perl module \"Build/Config.pm\" in path
- \"$file\" **
-EOF
-#-----------------------------------------------------------------------------------------------
-# Add $cfgdir/perl5lib to the list of paths that Perl searches for modules
-my @dirs = ( $cfgdir, "$perl5lib", $casecfgdir);
-unshift @INC, @dirs;
-require Build::Config;
-require config_files::clm_phys_vers;
-
-# Get the physics version
-my $phys = config_files::clm_phys_vers->new($opts{'phys'});
-
-# Check for the physics specific configuration definition file.
-my $phys_string = $phys->as_filename();
-
-my $config_def_file = "config_definition_$phys_string.xml";
-(-f "$cfgdir/config_files/$config_def_file") or die <<"EOF";
-** Cannot find configuration definition file \"$config_def_file\" in directory
- \"$cfgdir/config_files\" **
-EOF
-
-# The configuration defaults file modifies the generic defaults in the configuration
-# definition file. Note that the -defaults option has precedence over all other options.
-my $config_defaults_file;
-my $std_config_defaults_file = "$cfgdir/config_files/config_defaults.xml";
-if ($opts{'defaults'}) {
- $config_defaults_file = $opts{'defaults'};
-} else {
- $config_defaults_file = "$std_config_defaults_file";
-}
-(-f "$config_defaults_file") or die <<"EOF";
-** Cannot find configuration defaults file \"$config_defaults_file\" **
-EOF
-
-if ($print>=2) { print "Setting CLM configuration script directory to $cfgdir$eol"; }
-if ($print>=2) { print "Using configuration defaults file $config_defaults_file$eol"; }
-
-# Initialize the configuration. The $config_def_file provides the definition of a CLM
-# configuration, and the $config_defaults_file provides default values for a specific CLM
-# configuration. $cfg_ref is a reference to the new configuration object.
-my $cfg_ref = Build::Config->new("$cfgdir/config_files/$config_def_file",
- "$config_defaults_file");
-
-#-----------------------------------------------------------------------------------------------
-# CLM root directory.
-my $clm_root;
-
-if ( ! defined($opts{'clm_root'} ) ) {
- $clm_root = abs_path("$cfgdir/..");
-} else {
- $clm_root = $opts{'clm_root'};
-}
-
-if ( &is_valid_directory( "$clm_root/src", allowEnv=>0 ) ) {
- $cfg_ref->set('clm_root', $clm_root);
-} else {
- die <<"EOF";
-** Invalid CLM root directory: $clm_root
-**
-** The CLM root directory must contain the subdirectory /src/.
-** clm_root can be entered on the command line or it will be derived
-** from the location of this script.
-EOF
-}
-
-if ($print>=2) { print "Setting CLM root directory to $clm_root$eol"; }
-
-#-----------------------------------------------------------------------------------------------
-# CLM build directory is current directory
-my $clm_bld = `pwd`;
-chomp( $clm_bld );
-
-# Make sure directory is valid
-if ( ! &is_valid_directory( $clm_bld ) and ! mkdirp($clm_bld)) {
- die <<"EOF";
-** Could not create the specified CLM build directory: $clm_bld
-EOF
-}
-
-if ($print>=2) { print "Setting CLM build directory to $clm_bld$eol"; }
-
-#-----------------------------------------------------------------------------------------------
-# User source directories.
-my $usr_src = '';
-if (defined $opts{'usr_src'}) {
- my @dirs = split ',', $opts{'usr_src'};
- my @adirs;
- while ( my $dir = shift @dirs ) {
- if (&is_valid_directory( "$dir", allowEnv=>0 ) ) {
- push @adirs, $dir;
- } else {
- die "** User source directory does not exist: $dir\n";
- }
- }
- $usr_src = join ',', @adirs;
- $cfg_ref->set('usr_src', $usr_src);
-}
-
-if ($print>=2) { print "Setting user source directories to $usr_src$eol"; }
-
-#-----------------------------------------------------------------------------------------------
-# configuration cache directory and file.
-my $config_cache_dir;
-my $config_cache_file;
-if (defined $opts{'cachedir'}) {
- $config_cache_dir = abs_path($opts{'cachedir'});
-}
-else {
- $config_cache_dir = $clm_bld;
-}
-
-if (&is_valid_directory( $config_cache_dir, allowEnv=>0 ) or mkdirp($config_cache_dir)) {
- $config_cache_file = "$config_cache_dir/$opts{'cache'}";
-} else {
- die <<"EOF";
-** Could not create the specified directory for configuration cache file: $config_cache_dir
-EOF
-}
-
-if ($print>=2) { print "The configuration cache file will be created in $config_cache_file$eol"; }
-
-
-#-----------------------------------------------------------------------------------------------
-# physics
-
-$cfg_ref->set('phys', $opts{'phys'});
-my $phys_string = $phys->as_string();
-if ($print>=2) {
- if( defined($opts{'phys'}) ) {
- print "Using version $phys_string physics.$eol";
- }
-}
-
-#-----------------------------------------------------------------------------------------------
-# comp_intf option
-if (defined $opts{'comp_intf'}) {
- $cfg_ref->set('comp_intf', $opts{'comp_intf'});
-}
-my $comp_intf = $cfg_ref->get('comp_intf');
-if ($print>=2) { print "Using $comp_intf for comp_intf.$eol"; }
-
-
-#-----------------------------------------------------------------------------------------------
-# Makefile configuration #######################################################################
-#-----------------------------------------------------------------------------------------------
-
-#-----------------------------------------------------------------------------------------------
-# Name of CLM executable.
-my $clm_exe = "clm";
-
-if ($print>=2) { print "Name of CLM executable: $clm_exe.$eol"; }
-
-#-----------------------------------------------------------------------------------------------
-# For the CPP tokens, start with the defaults (from defaults file) and append the specifications
-# from the commandline. That way the user can override defaults since the commandline versions
-# occur last.
-my $usr_cppdefs = $cfg_ref->get('cppdefs');
-if (defined $opts{'cppdefs'}) {
- $usr_cppdefs .= " $opts{'cppdefs'}";
- print "Warning:: running with user defined cppdefs is NOT validated / " .
- "scientifically supported.$eol";
-}
-$cfg_ref->set('cppdefs', $usr_cppdefs);
-
-if ($usr_cppdefs and $print>=2) { print "Default and user CPP definitions: \'$usr_cppdefs\'$eol";}
-
-# The following CPP macro definitions are used to implement the compile-time options. They are
-# determined by the configuration parameters that have been set above. They will be appended to
-# the CPP definitions that were explicitly set in the defaults file or by the user on the commandline.
-my $cfg_cppdefs = '';
-if ($phys->as_long() >= $phys->as_long("clm4_5") ) {
- # clm4_5 cppdefs -- SHOULD NOT BE ANY!
- if ( $cfg_cppdefs ne '' ) {
- die <<"EOF";
-** CPP definitions should be empty for clm5_0 and is NOT **
-EOF
- }
-} elsif ($phys->as_long() == $phys->as_long("clm5_0") ) {
- # clm5_0 cppdefs -- SHOULD NOT BE ANY!
- if ( $cfg_cppdefs ne '' ) {
- die <<"EOF";
-** CPP definitions should be empty for clm5_0 and is NOT **
-EOF
- }
-} else {
- # this should NOT happen
- die <<"EOF";
-** Bad CLM physics version **
-EOF
-}
-# CPP defines to put on Makefile
-my $make_cppdefs = "$usr_cppdefs $cfg_cppdefs";
-
-if ($print>=2) { print "CPP definitions set by configure: \'$cfg_cppdefs\'$eol"; }
-
-#-----------------------------------------------------------------------------------------------
-# Write configuration files ####################################################################
-#-----------------------------------------------------------------------------------------------
-
-my $fp_filename = 'Filepath'; # name of output filepath file
-my $cpp_filename = 'CESM_cppdefs'; # name of output file for clm's cppdefs in cesm
-
-# Write the filepath file for cesm.
-write_filepath_cesmbld("$clm_bld/$fp_filename", $cfg_ref, $phys, allowEnv=>0 );
-if ($print>=2) { print "creating $clm_bld/$fp_filename\n"; }
-
-# Write the file for clm's cppdefs needed in cesm.
-write_cppdefs("$clm_bld/$cpp_filename", $make_cppdefs);
-if ($print>=2) { print "creating $clm_bld/$cpp_filename\n"; }
-
-# Write the configuration file.
-$cfg_ref->write_file($config_cache_file, $commandline);
-if ($print>=2) { print "creating $config_cache_file\n"; }
-
-#-----------------------------------------------------------------------------------------------
-# Done
-chdir( $cwd ) || die <<"EOF";
-** Trouble changing directory back to $cwd
-**
-EOF
-if ($print) { print "CLM configure done.\n"; }
-exit;
-
-#-----------------------------------------------------------------------------------------------
-# FINISHED ####################################################################################
-#-----------------------------------------------------------------------------------------------
-
-#-------------------------------------------------------------------------------
-
-sub write_filepath_cesmbld
-{
- my ($file, $cfg_ref, $phys, %opts) = @_;
- my $fh = new IO::File;
-
- $fh->open(">$file") or die "** can't open filepath file: $file\n";
-
- # configuration parameters used to determine paths
- my $usr_src = $cfg_ref->get('usr_src');
- my $clm_root = $cfg_ref->get('clm_root');
-
- # User specified source directories.
- if ($usr_src =~ /\S+/) {
- my @dirs = split ',', $usr_src;
- while ( my $dir = shift @dirs ) {
- print $fh "$dir\n";
- }
- } else {
- print $fh "../SourceMods/src.clm\n";
- }
-
- if ($phys->as_long() == $phys->as_long("clm4_0") ) {
- # source root
- my $srcdir = "$clm_root/src_clm40";
- if ( ! &is_valid_directory( "$srcdir", %opts ) ) { die "** source directory does not exist: $srcdir\n"; }
-
- # source directories under root
- my @dirs = ( "main", "biogeophys", "biogeochem" );
- foreach my $dir ( @dirs ) {
- if ( &is_valid_directory( "$srcdir/$dir", %opts ) ) {
- print $fh "$srcdir/$dir\n";
- } else {
- die "** source directory does not exist: $srcdir/$dir\n";
- }
- }
- } else {
- # source root
- my $srcdir = "$clm_root/src";
- if ( ! &is_valid_directory( "$srcdir", %opts ) ) { die "** source directory does not exist: $srcdir\n"; }
-
- # source directories under root
- my @dirs = ( "main",
- "biogeophys",
- "biogeochem",
- "soilbiogeochem",
- "init_interp",
- "utils",
- "cpl" );
-
- foreach my $dir ( @dirs ) {
- if ( &is_valid_directory( "$srcdir/$dir", %opts ) ) {
- print $fh "$srcdir/$dir\n";
- } else {
- die "** source directory does not exist: $srcdir/$dir\n";
- }
- }
- }
-
-
- $fh->close;
-}
-#-------------------------------------------------------------------------------
-
-sub write_cppdefs
-{
- my ($file, $make_cppdefs) = @_;
- my $fh = new IO::File;
-
- $fh->open(">$file") or die "** can't open cpp defs file: $file\n";
-
- print $fh "$make_cppdefs\n";
- $fh->close;
-}
-
-#-------------------------------------------------------------------------------
-
-sub mkdirp {
- my ($dir) = @_;
- my (@dirs) = split /\//, $dir;
- my (@subdirs, $path);
-
- # if $dir is absolute pathname then @dirs will start with ""
- if ($dirs[0] eq "") { push @subdirs, shift @dirs; }
-
- while ( @dirs ) { # check that each subdir exists and mkdir if it doesn't
- push @subdirs, shift @dirs;
- $path = join '/', @subdirs;
- unless (-d $path or mkdir($path, 0777)) { return 0; }
- }
- return 1;
-}
-
-#-------------------------------------------------------------------------------
-
-sub version {
-# The version is found in CLM's ChangeLog file.
-# $cfgdir is set by the configure script to the name of its directory.
-
- my ($cfgdir) = @_;
-
- my $logfile = "$cfgdir/../doc/ChangeLog";
-
- my $fh = IO::File->new($logfile, '<') or die "** can't open ChangeLog file: $logfile\n";
-
- while (my $line = <$fh>) {
-
- if ($line =~ /^Tag name:\s*[clm0-9_.-]*\s*[toin]*\s*([cesmclm0-9_.-]+)$/ ) {
- print "$1\n";
- exit;
- }
- }
-
-}
-
-#-------------------------------------------------------------------------------
-
-sub is_valid_directory {
-#
-# Validate that the input is a valid existing directory.
-#
- my ($dir, %opts) = @_;
- my $nm = "is_valid_directory";
-
- my $valid = 0;
- if ( -d $dir ) { $valid = 1; }
- return( $valid );
-
-}
-
diff --git a/bld/env_run.xml b/bld/env_run.xml
deleted file mode 100644
index 8bf59d09..00000000
--- a/bld/env_run.xml
+++ /dev/null
@@ -1,13 +0,0 @@
-
-
-
-
-
-
-
-
-
diff --git a/bld/namelist_files/LogMessages.pm b/bld/namelist_files/LogMessages.pm
deleted file mode 100755
index 77f0569b..00000000
--- a/bld/namelist_files/LogMessages.pm
+++ /dev/null
@@ -1,244 +0,0 @@
-package namelist_files::LogMessages;
-my $pkg_nm = 'namelist_files::LogMessages';
-#-----------------------------------------------------------------------------------------------
-#
-# SYNOPSIS
-#
-# require namelist_files::LogMessages;
-#
-# my %opts;
-# my $log = namelist_files::LogMessages->new("ProgName", \%opts);
-# $log->message("message to print");
-# $log->verbose_message("message to print only if verbose mode is on");
-# $log->warning("Warning message");
-# $log->exit_message("clean exit");
-# $log->fatal_error("die with fatal error");
-# $log->final_exit("Final message to send (and exit");
-#
-#
-# DESCRIPTION
-#
-# Handles log messages for perl. Sets up log messages according to verbose
-# or silent setting. It also handles warnings printing them, but on finalization
-# aborting unless ignore_warnings was set.
-#
-# COLLABORATORS: None
-#
-#-----------------------------------------------------------------------------------------------
-#
-# Date Author Modification
-# 10/06/2017 Erik Kluzek creation
-#
-#--------------------------------------------------------------------------------------------
-
-use strict;
-#use warnings;
-#use diagnostics;
-
-#-------------------------------------------------------------------------------
-
-sub new {
- my $class = shift;
- my $ProgName = shift;
- my %opts = %{shift()};
-
- my $nm = "$class\:\:new";
- my $self = {};
- bless($self, $class);
- $self->{'nwarns'} = 0;
- $self->{'verbosity'} = 1;
- $self->{'NO_EXIT'} = $opts{'NO_EXIT'};
- $self->{'ProgName'} = $ProgName;
- $self->{'ignore_warnings'} = $opts{'ignore_warnings'};
- $self->__set_print_level( \%opts );
- return( $self );
-}
-
-
-#-------------------------------------------------------------------------------
-
-sub __set_print_level {
- my $self = shift;
- # Define print levels:
- # 0 - only issue fatal error messages
- # 1 - only informs what files are created (default)
- # 2 - verbose
- my %opts = %{shift()};
-
- if ( $opts{'silent'} && $opts{'verbose'} ) {
- $self->fatal_error( "Can not set both the -silent and the -verbose options -- set one or the other" );
- }
- my $verbosity = 1;
- if ($opts{'silent'}) { $verbosity = 0; }
- if ($opts{'verbose'}) { $verbosity = 2; }
- $self->{'verbosity'} = $verbosity;
- $self->{'print_verbose'} = 2;
-}
-
-#-------------------------------------------------------------------------------
-
-sub message {
- my $self = shift;
- my ($message) = @_;
- if ($self->{'verbosity'} > 0) {
- print "$message\n";
- }
-}
-
-#-------------------------------------------------------------------------------
-
-sub verbose_message {
- my $self = shift;
-
- my ($message) = @_;
- if ($self->{'verbosity'} >= $self->{'print_verbose'}) {
- print "$message\n";
- }
-}
-#-------------------------------------------------------------------------------
-
-sub nwarns {
- my $self = shift;
-
- return( $self->{'nwarns'} );
-}
-
-#-------------------------------------------------------------------------------
-
-sub final_exit {
- my $self = shift;
- my ($message) = @_;
- if ( $self->{'nwarns'} > 0 ) {
- $self->message( "\n\nYou ran with the -ignore_warnings options and allowed $self->{'nwarns'} to go past\n" );
- }
- $self->verbose_message( $message );
- if ( $self->{'NO_EXIT'} ) {
- die
- } else {
- exit;
- }
-}
-
-#-------------------------------------------------------------------------------
-# Some simple subroutines to do a clean exit, print warning, or a fatal error
-
-sub exit_message {
- my $self = shift;
- my ($message) = @_;
- print "$self->{ProgName} : $message\n";
- if ( $self->{'NO_EXIT'} ) {
- die
- } else {
- exit;
- }
-}
-
-#-------------------------------------------------------------------------------
-
-sub warning {
- my $self = shift;
- my $message = shift;
-
- $self->{'nwarns'} = $self->{'nwarns'} + 1;
- my $func_name = (caller(1))[3];
- if ( $self->{'ignore_warnings'} ) {
- print "Warning : $self->{ProgName}::${func_name}() : $message\n\n";
- } else {
- die "Warning : $self->{ProgName}::${func_name}() : $message\n" .
- " -- Add -ignore_warnings option to CLM_BLDNML_OPTS to ignore this warning\n\n";
- }
-}
-
-#-------------------------------------------------------------------------------
-
-sub fatal_error {
- my $self = shift;
- my ($message) = @_;
- my $func_name = (caller(1))[3];
- die "ERROR : $self->{ProgName}::${func_name}() : $message\n";
-}
-
-#-------------------------------------------------------------------------------
-
-#-----------------------------------------------------------------------------------------------
-# Unit testing of above
-#-----------------------------------------------------------------------------------------------
-if ( ! defined(caller) && $#ARGV == -1 ) {
- package LogMessage_unit_tester;
-
- require Test::More;
- Test::More->import( );
-
- plan( tests=>11 );
-
- sub testit {
- print "unit tester\n";
- my %opts;
- my $message;
-
- # Standard verbose level, test all methods
- $opts{'NO_EXIT'} = 1;
- my $log = namelist_files::LogMessages->new("ProgName", \%opts);
- isa_ok($log, "namelist_files::LogMessages", "Created LogMessages object");
- $log->message("message to print");
- $log->verbose_message("YOU SHOULD NOT SEE THIS MESSAGE BECAUSE IT IS VERBOSE AND VERBOSE NOT ON");
- $message = "Warning message";
- is ( $log->nwarns(), 0, "Make sure have zero warnings" );
- eval{ $log->warning($message); };
- like( $@, qr/$message/, "check that a warning dies without ignore_warnings option" );
- is ( $log->nwarns(), 1, "Make sure have one warning" );
- $message = "die with fatal error";
- eval{ $log->fatal_error($message); };
- like( $@, qr/$message/, "check that a fatal_error dies" );
- $message = "exit with exit message";
- eval{ $log->exit_message($message); };
- like( $@, qr/Died/, "check that a exit_message exits" );
- $message = "Final message to send";
- eval{ $log->final_exit($message); };
- like( $@, qr/Died/, "check that a final exits" );
-
- # Test ignore_warnings option and verbose mode
- $opts{'ignore_warnings'} = 1;
- $opts{'verbose'} = 1;
- $opts{'NO_EXIT'} = 1;
- $log = namelist_files::LogMessages->new("ProgName", \%opts);
- isa_ok($log, "namelist_files::LogMessages", "Created LogMessages object");
- $log->verbose_message("message to print only if verbose mode is on");
- $log->warning("Warning message");
- $log->warning("Warning message2");
- $log->warning("Warning message3");
- $log->warning("Warning message4");
- $log->warning("Warning message5");
- is ( $log->nwarns(), 5, "Make sure have five warnings" );
- eval{ $log->final_exit($message); };
- print "content: $@\n";
- like( $@, qr/Died/, "check that a final_exit with warning exits" );
- # silent mode
- $opts{'ignore_warnings'} = 0;
- $opts{'verbose'} = 0;
- $opts{'silent'} = 1;
- $opts{'NO_EXIT'} = 1;
- $log = namelist_files::LogMessages->new("ProgName", \%opts);
- $log->message("YOU SHOULD NOT SEE THIS MESSAGE BECAUSE SILENT MODE IS ON");
- $log->verbose_message("YOU SHOULD NOT SEE THIS VERBOSE MESSAGE BECAUSE SILENT MODE IS ON");
- # Should die with error if both silent and verbose mode is on
- $opts{'ignore_warnings'} = 0;
- $opts{'verbose'} = 1;
- $opts{'silent'} = 1;
- $opts{'NO_EXIT'} = 1;
- eval{ $log = namelist_files::LogMessages->new("ProgName", \%opts); };
- print "content: $@\n";
- like( $@, qr/ERROR : /, "check that died if both verbose and silent mode is on" );
- print "\nSuccessfully ran all tests\n";
- }
-}
-
-#-----------------------------------------------------------------------------------------------
-# Determine if you should run the unit test or if this is being called from a require statement
-#-----------------------------------------------------------------------------------------------
-
-if ( defined(caller) ) {
- 1 # to make use or require happy
-} elsif ( $#ARGV == -1 ) {
- &LogMessage_unit_tester::testit();
-}
diff --git a/bld/namelist_files/namelist_defaults.xsl b/bld/namelist_files/namelist_defaults.xsl
deleted file mode 100644
index 96cb2b6e..00000000
--- a/bld/namelist_files/namelist_defaults.xsl
+++ /dev/null
@@ -1,176 +0,0 @@
-
-
-
-
-
-
-
- CLM Namelist Defaults
-
-
- Default Values for Namelist Variables
- Included in the table are the following pieces of information:
- Table headers include:
-
- Name of variable
- Horizontal grid resolution
- Land ocean mask type
- Simulation year
- Simulation year range (for transient datasets)
-
- Miscellaneous items include:
-
- Biogeochemistry (BGC) type (none, CN, CNDV)
- Initial condition date (ymd - year month day)
- Initial condition time of day (tod) (sec)
- Maximum number of Plant Function Types (maxpft)
- Number of glacier multiple elevation classes (glc_nec)
- Site specific point name (sitespf_pt)
- Crop model (crop)
- Data model forcing source (forcing)
- Representative concentration pathway for future scenarios (rcp)
- New good wood harvest (newwoodharv)
- CN Spin-up mode (spinup)
- Type of file (type)
- Grid mapping to (to_hgrid)
- Land-mask mapping to (to_lmask)
- High resolution file? (hires)
-
-
-
- Namelist Defaults
-
- Name
- Horz. Grid
- Mask
- Sim year
- Sim year range
- Miscellaneous
-
-
- Default Value for this Configuration
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
- All res
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
- MODIS
-
-
- All masks
-
-
-
-
-
-
-
-
-
- All yrs
-
-
-
-
-
-
-
-
-
- All sim-yr-rng
-
-
-
-
-
- bgc=
-
-
- ymd=
-
-
- tod=
-
-
- maxpft=
-
-
- glc_nec=
-
-
- sitespf_pt=
-
-
- datm_presaero=
-
-
- crop=
-
-
- irrig=
-
-
- spinup=
-
-
- forcing=
-
-
- rcp=
-
-
- newwoodharv=
-
-
- type=
-
-
- to_hgrid=
-
-
- to_lmask=
-
-
- hires=
-
-
-
-
- Value:
-
-
-
-
-
-
-
-
-
-
diff --git a/bld/namelist_files/namelist_defaults_clm4_5.xml b/bld/namelist_files/namelist_defaults_clm4_5.xml
deleted file mode 100644
index 6d7e927c..00000000
--- a/bld/namelist_files/namelist_defaults_clm4_5.xml
+++ /dev/null
@@ -1,2125 +0,0 @@
-
-
-
-
-
-
-
-
-
-
-0.9x1.25
-
-2000
-
-
-1800
-
-
-379.0
-379.0
-284.7
-
-
-constant
-
-
-sp
-
-
-0.50,0.30
-0.60,0.40
-
-
-ON_WASTEHEAT
-ON
-
-1
-0
-
-
-.false.
-
-
-.true.
-.false.
-
-20SL_8.5m
-10SL_3.5m
-
-.false.
-.false.
-.true.
-.false.
-
-
-
-1
-0
-
-1
-1
-
-
-1
-0
-
-
-.true.
-.false.
-
-.true.
-
-
-0.006
-
-
-0.032
-
-0.5
-
-0.
-2.
-
-0.
-2.
-
--2.
-0.
-
-
-.false.
-.true.
-
-
-.true.
-1.0
-0.05
-
-.false.
-0.25
-1.0
-
-
-0
-1
-
-1
-1
-
-4
-2
-2
-3
-
-60.
-1.e-8
-1.e-1
-1.e-2
-42
-1
-1
-
-
-0.0
-21600
-14400
--3400.
-0.6
-1.0
-0.5
-0.1
-
-
-.false.
-.false.
-
-
-OFF
-ON_RAD
-
-
-12
-5
-10000.0
-1000.0
-
-2000.
-
-1.e30
-
-10.0d00
-10.0
-
-.true.
-.false.
-
-'Vionnet2012'
-'Anderson1976'
-
-'Slater2017'
-'TruncatedAnderson1976'
-
-100.d00
-175.d00
-
-54.526d00
-204.526d00
-
-0.08d00
-
-.false.
-.false.
-
-1.e9
-
-
-'single_at_atm_topo','virtual','virtual','multiple'
-
-
-'remains_in_place','replaced_by_ice','replaced_by_ice','replaced_by_ice'
-
-
-'melted','melted','remains_ice','remains_ice'
-
-
-0
-7300
-
-
-
-
-lnd/clm2/paramdata/clm5_params.c171117.nc
-lnd/clm2/paramdata/clm_params.c170913.nc
-
-
-
-
-
-lnd/clm2/paramdata/fates_params_2troppftclones.c171018.nc
-
-
-
-
-.true.
-.false.
-.false.
-
-
-.true.
-.false.
-.false.
-
-
-.true.
-.false.
-3
-.true.
-.true.
-.true.
-.true.
-.false.
-3
-1
-1
-1
-1
-0
-
-
-
-
-
-
-.true.
-.false.
-
-.false.
-.true.
-.true.
-
-0.093563
-
-.false.
-.false.
-.true.
-
-3.d00
-1.d00
-
-
-
-0.5
-10.0
-
-
-.false.
-.true.
-
-
-.false.
-.false.
-.false.
-.false.
-.false.
-
-
-.false.
-.false.
-.true.
-
-
-.false.
-.false.
-.true.
-
-
-
-75
-
-
-1850,2000
-
-
-.true.
-.true.
-.false.
-
-
-hgrid=0.9x1.25 maxpft=17 mask=gx1v6 use_cn=.true. use_nitrif_denitrif=.true. use_vertsoilc=.true. use_crop=.false. irrigate=.false. glc_nec=10
-
-
-hgrid=0.9x1.25 maxpft=17 mask=gx1v6 use_cn=.true. use_nitrif_denitrif=.true. use_vertsoilc=.true. use_crop=.false. irrigate=.false. glc_nec=10
-
-
-hgrid=0.9x1.25 maxpft=79 mask=gx1v7 use_cn=.true. use_nitrif_denitrif=.true. use_vertsoilc=.true. use_crop=.true. irrigate=.false. glc_nec=10
-
-
-hgrid=0.9x1.25 maxpft=17 mask=gx1v6 use_cn=.false. use_nitrif_denitrif=.false. use_vertsoilc=.false. use_crop=.false. irrigate=.true. glc_nec=10
-
-
-hgrid=0.9x1.25 maxpft=79 mask=gx1v6 use_cn=.true. use_nitrif_denitrif=.true. use_vertsoilc=.true. use_crop=.true. irrigate=.false. glc_nec=10
-
-
-hgrid=0.9x1.25 maxpft=79 mask=gx1v6 use_cn=.true. use_nitrif_denitrif=.true. use_vertsoilc=.true. use_crop=.true. irrigate=.false. glc_nec=10
-
-
-hgrid=0.9x1.25 maxpft=17 mask=gx1v6 use_cn=.false. use_nitrif_denitrif=.false. use_vertsoilc=.false. use_crop=.false. irrigate=.true. glc_nec=10
-
-
-hgrid=0.9x1.25 maxpft=79 mask=gx1v7 use_cn=.true. use_nitrif_denitrif=.true. use_vertsoilc=.true. use_crop=.true. irrigate=.false. glc_nec=10
-
-
-hgrid=1.9x2.5 maxpft=79 mask=gx1v6 use_cn=.true. use_nitrif_denitrif=.true. use_vertsoilc=.true. use_crop=.true. irrigate=.true. glc_nec=10
-
-
-
-
-
-
-lnd/slim/surdat/mml_1.9x2.5_default_cdf5_c20211105.nc
-
-
-
-
-lnd/clm2/initdata_map/clmi.I1850Clm45BgcGs.0901-01-01.0.9x1.25_gx1v6_simyr1850_c180204.nc
-
-
-lnd/clm2/initdata_map/clmi.I1850Clm45BgcCruGs.1101-01-01.0.9x1.25_gx1v6_simyr1850_c180204.nc
-
-
-lnd/clm2/initdata_map/clmi.B1850.0161-01-01.0.9x1.25_gx1v7_simyr1850_c180130.nc
-
-
-
-lnd/clm2/initdata_map/clmi.I1850Clm50Sp.0181-01-01.0.9x1.25_gx1v6_simyr1850_c171214.nc
-
-
-
-lnd/clm2/initdata_map/clmi.I1850Clm50BgcCrop.1366-01-01.0.9x1.25_gx1v6_simyr1850_c171213.nc
-
-
-
-lnd/clm2/initdata_map/clmi.I1850Clm50BgcCropCru.1526-01-01.0.9x1.25_gx1v6_simyr1850_c180109.nc
-
-
-
-lnd/clm2/initdata_map/clmi.B1850.0161-01-01.0.9x1.25_gx1v7_simyr1850_c180130.nc
-
-
-lnd/clm2/initdata_map/clmi.I1850Clm50SpCru.1706-01-01.0.9x1.25_gx1v6_simyr1850_c180110.nc
-
-
-
-
-
-
-lnd/clm2/initdata_map/clmi.IGM2000GSWP3CLM50BGCCROPIRR.2011-01-01.1.9x2.5_gx1v6_gl5_simyr2000_c170419.nc
-
-
-
-lnd/clm2/initdata_map/clmi.I2000Clm45Fates.0121-01-01.4x5_mgx3v7_simyr2000_c180122.nc
-
-
-lnd/clm2/initdata_map/clmi.I2000Clm45Fates.0101-01-01.1x1_brazil_simyr2000_c180120.nc
-
-
-
-
-
-lnd/clm2/surfdata_map/surfdata_360x720cru_16pfts_Irrig_CMIP6_simyr2000_c170824.nc
-
-lnd/clm2/surfdata_map/surfdata_48x96_16pfts_Irrig_CMIP6_simyr2000_c170824.nc
-
-
-lnd/clm2/surfdata_map/surfdata_0.47x0.63_16pfts_Irrig_CMIP6_simyr2000_c170919.nc
-
-lnd/clm2/surfdata_map/surfdata_0.9x1.25_16pfts_Irrig_CMIP6_simyr2000_c170824.nc
-
-lnd/clm2/surfdata_map/surfdata_1.9x2.5_16pfts_Irrig_CMIP6_simyr2000_c170824.nc
-
-lnd/clm2/surfdata_map/surfdata_4x5_16pfts_Irrig_CMIP6_simyr2000_c170824.nc
-
-lnd/clm2/surfdata_map/surfdata_10x15_16pfts_Irrig_CMIP6_simyr2000_c170824.nc
-
-
-lnd/clm2/surfdata_map/surfdata_ne120np4_16pfts_Irrig_CMIP6_simyr2000_c170824.nc
-
-lnd/clm2/surfdata_map/surfdata_ne30np4_16pfts_Irrig_CMIP6_simyr2000_c170824.nc
-
-lnd/clm2/surfdata_map/surfdata_ne16np4_16pfts_Irrig_CMIP6_simyr2000_c170824.nc
-
-
-lnd/clm2/surfdata_map/surfdata_5x5_amazon_16pfts_Irrig_CMIP6_simyr2000_c171214.nc
-
-lnd/clm2/surfdata_map/surfdata_1x1_brazil_16pfts_Irrig_CMIP6_simyr2000_c171214.nc
-
-
-lnd/clm2/surfdata_map/surfdata_64x128_16pfts_Irrig_CMIP6_simyr2000_c170824.nc
-
-
-
-lnd/clm2/surfdata_map/surfdata_0.47x0.63_78pfts_CMIP6_simyr2000_c170919.nc
-
-lnd/clm2/surfdata_map/surfdata_0.9x1.25_78pfts_CMIP6_simyr2000_c170824.nc
-
-lnd/clm2/surfdata_map/surfdata_1.9x2.5_78pfts_CMIP6_simyr2000_c170824.nc
-
-lnd/clm2/surfdata_map/surfdata_0.125x0.125_mp24_simyr2000_c150114.nc
-
-lnd/clm2/surfdata_map/surfdata_10x15_78pfts_CMIP6_simyr2000_c170824.nc
-
-lnd/clm2/surfdata_map/surfdata_4x5_78pfts_CMIP6_simyr2000_c170824.nc
-
-lnd/clm2/surfdata_map/surfdata_1x1_numaIA_78pfts_CMIP6_simyr2000_c171214.nc
-
-lnd/clm2/surfdata_map/surfdata_1x1_smallvilleIA_78pfts_CMIP6_simyr2000_c171214.nc
-
-
-lnd/clm2/surfdata_map/surfdata_ne120np4_78pfts_CMIP6_simyr2000_c170824.nc
-
-lnd/clm2/surfdata_map/surfdata_ne30np4_78pfts_CMIP6_simyr2000_c170824.nc
-
-lnd/clm2/surfdata_map/surfdata_ne16np4_78pfts_CMIP6_simyr2000_c170824.nc
-
-
-
-lnd/clm2/surfdata_map/surfdata_1x1_camdenNJ_16pfts_Irrig_CMIP6_simyr2000_c171214.nc
-
-lnd/clm2/surfdata_map/surfdata_1x1_vancouverCAN_16pfts_Irrig_CMIP6_simyr2000_c171214.nc
-
-lnd/clm2/surfdata_map/surfdata_1x1_mexicocityMEX_16pfts_Irrig_CMIP6_simyr2000_c171214.nc
-
-lnd/clm2/surfdata_map/surfdata_1x1_urbanc_alpha_16pfts_Irrig_CMIP6_simyr2000_c171214.nc
-
-
-
-lnd/clm2/surfdata_map/surfdata_360x720cru_16pfts_Irrig_CMIP6_simyr1850_c170824.nc
-
-lnd/clm2/surfdata_map/surfdata_48x96_16pfts_Irrig_CMIP6_simyr1850_c170824.nc
-
-
-lnd/clm2/surfdata_map/surfdata_0.47x0.63_16pfts_Irrig_CMIP6_simyr1850_c170919.nc
-
-lnd/clm2/surfdata_map/surfdata_0.9x1.25_16pfts_Irrig_CMIP6_simyr1850_c170824.nc
-
-lnd/clm2/surfdata_map/surfdata_1.9x2.5_16pfts_Irrig_CMIP6_simyr1850_c170824.nc
-
-lnd/clm2/surfdata_map/surfdata_10x15_16pfts_Irrig_CMIP6_simyr1850_c170824.nc
-
-lnd/clm2/surfdata_map/surfdata_4x5_16pfts_Irrig_CMIP6_simyr1850_c170824.nc
-
-
-lnd/clm2/surfdata_map/surfdata_1x1_brazil_16pfts_Irrig_CMIP6_simyr1850_c171214.nc
-
-
-
-lnd/clm2/surfdata_map/surfdata_ne120np4_16pfts_Irrig_CMIP6_simyr1850_c170824.nc
-
-lnd/clm2/surfdata_map/surfdata_ne30np4_16pfts_Irrig_CMIP6_simyr1850_c170824.nc
-
-
-
-lnd/clm2/surfdata_map/surfdata_360x720cru_78pfts_CMIP6_simyr1850_c170824.nc
-
-lnd/clm2/surfdata_map/surfdata_48x96_78pfts_CMIP6_simyr1850_c170824.nc
-
-
-lnd/clm2/surfdata_map/surfdata_0.47x0.63_78pfts_CMIP6_simyr1850_c170919.nc
-
-lnd/clm2/surfdata_map/surfdata_0.9x1.25_78pfts_CMIP6_simyr1850_c170824.nc
-
-lnd/clm2/surfdata_map/surfdata_1.9x2.5_78pfts_CMIP6_simyr1850_c170824.nc
-
-lnd/clm2/surfdata_map/surfdata_10x15_78pfts_CMIP6_simyr1850_c170824.nc
-
-lnd/clm2/surfdata_map/surfdata_4x5_78pfts_CMIP6_simyr1850_c170824.nc
-
-lnd/clm2/surfdata_map/surfdata_1x1_smallvilleIA_78pfts_CMIP6_simyr1850_c171214.nc
-
-lnd/clm2/surfdata_map/surfdata_1x1_numaIA_78pfts_CMIP6_simyr1850_c170917.nc
-
-
-lnd/clm2/surfdata_map/surfdata_1x1_brazil_78pfts_CMIP6_simyr1850_c171214.nc
-
-
-lnd/clm2/surfdata_map/surfdata_ne30np4_78pfts_CMIP6_simyr1850_c170824.nc
-
-lnd/clm2/surfdata_map/surfdata_ne120np4_78pfts_CMIP6_simyr1850_c170824.nc
-
-
-
-
-
-lnd/clm2/surfdata_map/landuse.timeseries_0.47x0.63_hist_16pfts_Irrig_CMIP6_simyr1850-2015_c171025.nc
-lnd/clm2/surfdata_map/landuse.timeseries_360x720cru_hist_16pfts_Irrig_CMIP6_simyr1850-2015_c170824.nc
-lnd/clm2/surfdata_map/landuse.timeseries_0.9x1.25_hist_16pfts_Irrig_CMIP6_simyr1850-2015_c170824.nc
-lnd/clm2/surfdata_map/landuse.timeseries_1.9x2.5_hist_16pfts_Irrig_CMIP6_simyr1850-2015_c170824.nc
-lnd/clm2/surfdata_map/landuse.timeseries_10x15_hist_16pfts_Irrig_CMIP6_simyr1850-2015_c170824.nc
-lnd/clm2/surfdata_map/landuse.timeseries_4x5_hist_16pfts_Irrig_CMIP6_simyr1850-2015_c170824.nc
-lnd/clm2/surfdata_map/landuse.timeseries_48x96_hist_16pfts_Irrig_CMIP6_simyr1850-2015_c170824.nc
-
-lnd/clm2/surfdata_map/landuse.timeseries_1x1_brazil_hist_16pfts_Irrig_CMIP6_simyr1850-2015_c170824.nc
-
-lnd/clm2/surfdata_map/landuse.timeseries_ne120np4_hist_16pfts_Irrig_CMIP6_simyr1850-2015_c170824.nc
-lnd/clm2/surfdata_map/landuse.timeseries_ne30np4_hist_16pfts_Irrig_CMIP6_simyr1850-2015_c170824.nc
-
-
-
-lnd/clm2/surfdata_map/landuse.timeseries_360x720cru_hist_78pfts_CMIP6_simyr1850-2015_c170824.nc
-lnd/clm2/surfdata_map/landuse.timeseries_0.9x1.25_hist_78pfts_CMIP6_simyr1850-2015_c170824.nc
-lnd/clm2/surfdata_map/landuse.timeseries_1.9x2.5_hist_78pfts_CMIP6_simyr1850-2015_c170824.nc
-lnd/clm2/surfdata_map/landuse.timeseries_10x15_hist_78pfts_CMIP6_simyr1850-2015_c170824.nc
-lnd/clm2/surfdata_map/landuse.timeseries_4x5_hist_78pfts_CMIP6_simyr1850-2015_c170824.nc
-lnd/clm2/surfdata_map/landuse.timeseries_48x96_hist_78pfts_CMIP6_simyr1850-2015_c170824.nc
-
-lnd/clm2/surfdata_map/landuse.timeseries_1x1_brazil_hist_78pfts_CMIP6_simyr1850-2015_c170824.nc
-lnd/clm2/surfdata_map/landuse.timeseries_1x1_numaIA_hist_78pfts_CMIP6_simyr1850-2015_c170917.nc
-
-lnd/clm2/surfdata_map/landuse.timeseries_ne120np4_hist_78pfts_CMIP6_simyr1850-2015_c170824.nc
-lnd/clm2/surfdata_map/landuse.timeseries_ne30np4_hist_78pfts_CMIP6_simyr1850-2015_c170824.nc
-
-
-lnd/clm2/surfdata_map/landuse.timeseries_1x1_smallvilleIA_hist_78pfts_simyr1850-1855_c160127.nc
-
-
-
-
-lnd/clm2/surfdata_map/landuse.timeseries_360x720cru_hist_16pfts_Irrig_CMIP6_simyr1850-2015_c170824.nc
-lnd/clm2/surfdata_map/landuse.timeseries_0.9x1.25_hist_16pfts_Irrig_CMIP6_simyr1850-2015_c170824.nc
-lnd/clm2/surfdata_map/landuse.timeseries_1.9x2.5_hist_16pfts_Irrig_CMIP6_simyr1850-2015_c170824.nc
-lnd/clm2/surfdata_map/landuse.timeseries_10x15_hist_16pfts_Irrig_CMIP6_simyr1850-2015_c170824.nc
-lnd/clm2/surfdata_map/landuse.timeseries_48x96_hist_16pfts_Irrig_CMIP6_simyr1850-2015_c170824.nc
-lnd/clm2/surfdata_map/landuse.timeseries_ne30np4_hist_16pfts_Irrig_CMIP6_simyr1850-2015_c170824.nc
-lnd/clm2/surfdata_map/landuse.timeseries_ne120np4_hist_16pfts_Irrig_CMIP6_simyr1850-2015_c170824.nc
-
-lnd/clm2/surfdata_map/landuse.timeseries_1x1_brazil_hist_16pfts_Irrig_CMIP6_simyr1850-2015_c170824.nc
-
-lnd/clm2/surfdata_map/landuse.timeseries_360x720cru_hist_16pfts_Irrig_CMIP6_simyr1850-2015_c170824.nc
-lnd/clm2/surfdata_map/landuse.timeseries_0.9x1.25_hist_16pfts_Irrig_CMIP6_simyr1850-2015_c170824.nc
-lnd/clm2/surfdata_map/landuse.timeseries_1.9x2.5_hist_16pfts_Irrig_CMIP6_simyr1850-2015_c170824.nc
-lnd/clm2/surfdata_map/landuse.timeseries_10x15_hist_16pfts_Irrig_CMIP6_simyr1850-2015_c170824.nc
-lnd/clm2/surfdata_map/landuse.timeseries_48x96_hist_16pfts_Irrig_CMIP6_simyr1850-2015_c170824.nc
-lnd/clm2/surfdata_map/landuse.timeseries_ne30np4_hist_16pfts_Irrig_CMIP6_simyr1850-2015_c170824.nc
-
-lnd/clm2/surfdata_map/landuse.timeseries_360x720cru_hist_16pfts_Irrig_CMIP6_simyr1850-2015_c170824.nc
-lnd/clm2/surfdata_map/landuse.timeseries_0.9x1.25_hist_16pfts_Irrig_CMIP6_simyr1850-2015_c170824.nc
-lnd/clm2/surfdata_map/landuse.timeseries_1.9x2.5_hist_16pfts_Irrig_CMIP6_simyr1850-2015_c170824.nc
-lnd/clm2/surfdata_map/landuse.timeseries_10x15_hist_16pfts_Irrig_CMIP6_simyr1850-2015_c170824.nc
-lnd/clm2/surfdata_map/landuse.timeseries_48x96_hist_16pfts_Irrig_CMIP6_simyr1850-2015_c170824.nc
-lnd/clm2/surfdata_map/landuse.timeseries_ne120np4_hist_16pfts_Irrig_CMIP6_simyr1850-2015_c170824.nc
-lnd/clm2/surfdata_map/landuse.timeseries_ne30np4_hist_16pfts_Irrig_CMIP6_simyr1850-2015_c170824.nc
-
-lnd/clm2/surfdata_map/landuse.timeseries_360x720cru_hist_16pfts_Irrig_CMIP6_simyr1850-2015_c170824.nc
-lnd/clm2/surfdata_map/landuse.timeseries_0.9x1.25_hist_16pfts_Irrig_CMIP6_simyr1850-2015_c170824.nc
-lnd/clm2/surfdata_map/landuse.timeseries_1.9x2.5_hist_16pfts_Irrig_CMIP6_simyr1850-2015_c170824.nc
-lnd/clm2/surfdata_map/landuse.timeseries_10x15_hist_16pfts_Irrig_CMIP6_simyr1850-2015_c170824.nc
-lnd/clm2/surfdata_map/landuse.timeseries_48x96_hist_16pfts_Irrig_CMIP6_simyr1850-2015_c170824.nc
-lnd/clm2/surfdata_map/landuse.timeseries_ne30np4_hist_16pfts_Irrig_CMIP6_simyr1850-2015_c170824.nc
-
-
-lnd/clm2/surfdata_map/landuse.timeseries_360x720cru_hist_78pfts_CMIP6_simyr1850-2015_c170824.nc
-lnd/clm2/surfdata_map/landuse.timeseries_0.9x1.25_hist_78pfts_CMIP6_simyr1850-2015_c170824.nc
-lnd/clm2/surfdata_map/landuse.timeseries_1.9x2.5_hist_78pfts_CMIP6_simyr1850-2015_c170824.nc
-lnd/clm2/surfdata_map/landuse.timeseries_10x15_hist_78pfts_CMIP6_simyr1850-2015_c170824.nc
-lnd/clm2/surfdata_map/landuse.timeseries_4x5_hist_78pfts_CMIP6_simyr1850-2015_c170824.nc
-lnd/clm2/surfdata_map/landuse.timeseries_48x96_hist_78pfts_CMIP6_simyr1850-2015_c170824.nc
-lnd/clm2/surfdata_map/landuse.timeseries_ne30np4_hist_78pfts_CMIP6_simyr1850-2015_c170824.nc
-lnd/clm2/surfdata_map/landuse.timeseries_ne120np4_hist_78pfts_CMIP6_simyr1850-2015_c170824.nc
-
-lnd/clm2/surfdata_map/landuse.timeseries_1x1_brazil_hist_78pfts_CMIP6_simyr1850-2015_c170824.nc
-
-lnd/clm2/surfdata_map/landuse.timeseries_360x720cru_hist_78pfts_CMIP6_simyr1850-2015_c170824.nc
-lnd/clm2/surfdata_map/landuse.timeseries_0.9x1.25_hist_78pfts_CMIP6_simyr1850-2015_c170824.nc
-lnd/clm2/surfdata_map/landuse.timeseries_1.9x2.5_hist_78pfts_CMIP6_simyr1850-2015_c170824.nc
-lnd/clm2/surfdata_map/landuse.timeseries_10x15_hist_78pfts_CMIP6_simyr1850-2015_c170824.nc
-lnd/clm2/surfdata_map/landuse.timeseries_4x5_hist_78pfts_CMIP6_simyr1850-2015_c170824.nc
-lnd/clm2/surfdata_map/landuse.timeseries_48x96_hist_78pfts_CMIP6_simyr1850-2015_c170824.nc
-lnd/clm2/surfdata_map/landuse.timeseries_ne30np4_hist_78pfts_CMIP6_simyr1850-2015_c170824.nc
-
-lnd/clm2/surfdata_map/landuse.timeseries_360x720cru_hist_78pfts_CMIP6_simyr1850-2015_c170824.nc
-lnd/clm2/surfdata_map/landuse.timeseries_0.9x1.25_hist_78pfts_CMIP6_simyr1850-2015_c170824.nc
-lnd/clm2/surfdata_map/landuse.timeseries_1.9x2.5_hist_78pfts_CMIP6_simyr1850-2015_c170824.nc
-lnd/clm2/surfdata_map/landuse.timeseries_10x15_hist_78pfts_CMIP6_simyr1850-2015_c170824.nc
-lnd/clm2/surfdata_map/landuse.timeseries_4x5_hist_78pfts_CMIP6_simyr1850-2015_c170824.nc
-lnd/clm2/surfdata_map/landuse.timeseries_48x96_hist_78pfts_CMIP6_simyr1850-2015_c170824.nc
-lnd/clm2/surfdata_map/landuse.timeseries_ne120np4_hist_78pfts_CMIP6_simyr1850-2015_c170824.nc
-lnd/clm2/surfdata_map/landuse.timeseries_ne30np4_hist_78pfts_CMIP6_simyr1850-2015_c170824.nc
-
-lnd/clm2/surfdata_map/landuse.timeseries_360x720cru_hist_78pfts_CMIP6_simyr1850-2015_c170824.nc
-lnd/clm2/surfdata_map/landuse.timeseries_0.9x1.25_hist_78pfts_CMIP6_simyr1850-2015_c170824.nc
-lnd/clm2/surfdata_map/landuse.timeseries_1.9x2.5_hist_78pfts_CMIP6_simyr1850-2015_c170824.nc
-lnd/clm2/surfdata_map/landuse.timeseries_10x15_hist_78pfts_CMIP6_simyr1850-2015_c170824.nc
-lnd/clm2/surfdata_map/landuse.timeseries_4x5_hist_78pfts_CMIP6_simyr1850-2015_c170824.nc
-lnd/clm2/surfdata_map/landuse.timeseries_48x96_hist_78pfts_CMIP6_simyr1850-2015_c170824.nc
-lnd/clm2/surfdata_map/landuse.timeseries_ne30np4_hist_78pfts_CMIP6_simyr1850-2015_c170824.nc
-
-
-.true.
-.false.
-
-
-0.015d00
-0.015d00
-
-
-20.0d00, 20.0d00, 20.0d00
-200.0d00, 200.0d00, 200.0d00
-20.0d00, 20.0d00, 20.0d00
-200.0d00, 200.0d00, 200.0d00
-
-1.50d00
-0.3
-1.50d00
-0.3
-
-100.d00
-20.d00
-1.d00
-1.d00
-
-
-
-lnd/clm2/snicardata/snicar_optics_5bnd_c090915.nc
-lnd/clm2/snicardata/snicar_drdt_bst_fit_60_c070416.nc
-
-
-.false.
-2001
-2013
-2001
-
-lnd/clm2/lai_streams/MODISPFTLAI_0.5x0.5_c140711.nc
-
-bilinear
-
-nn
-nn
-nn
-nn
-nn
-nn
-nn
-nn
-nn
-nn
-nn
-nn
-nn
-nn
-
-
-.true.
-.false.
-
-
-
-
-
-
-35
-
-
-
-
-
-
-
-
-lnd/clm2/mappingdata/maps/0.1x0.1/map_0.1x0.1_nomask_to_0.1x0.1_nomask_aave_da_c120406.nc
-lnd/clm2/mappingdata/maps/0.1x0.1/map_0.5x0.5_AVHRR_to_0.1x0.1_nomask_aave_da_c120406.nc
-lnd/clm2/mappingdata/maps/0.1x0.1/map_0.5x0.5_MODIS_to_0.1x0.1_nomask_aave_da_c120406.nc
-lnd/clm2/mappingdata/maps/0.1x0.1/map_0.25x0.25_MODIS_to_0.1x0.1_nomask_aave_da_c170321.nc
-lnd/clm2/mappingdata/maps/0.1x0.1/map_0.5x0.5_nomask_to_0.1x0.1_nomask_aave_da_c120406.nc
-lnd/clm2/mappingdata/maps/0.1x0.1/map_10x10min_nomask_to_0.1x0.1_nomask_aave_da_c120406.nc
-lnd/clm2/mappingdata/maps/0.1x0.1/map_3x3min_MODIS_to_0.1x0.1_nomask_aave_da_c120406.nc
-lnd/clm2/mappingdata/maps/0.1x0.1/map_3x3min_MODIS-wCsp_to_0.1x0.1_nomask_aave_da_c160425.nc
-lnd/clm2/mappingdata/maps/0.1x0.1/map_5x5min_IGBP-GSDP_to_0.1x0.1_nomask_aave_da_c120406.nc
-lnd/clm2/mappingdata/maps/0.1x0.1/map_5x5min_ISRIC-WISE_to_0.1x0.1_nomask_aave_da_c120406.nc
-lnd/clm2/mappingdata/maps/0.1x0.1/map_5x5min_ORNL-Soil_to_0.1x0.1_nomask_aave_da_c170706.nc
-lnd/clm2/mappingdata/maps/0.1x0.1/map_5x5min_nomask_to_0.1x0.1_nomask_aave_da_c120406.nc
-lnd/clm2/mappingdata/maps/0.1x0.1/map_ne120np4_nomask_to_0.1x0.1_nomask_aave_da_c120711.nc
-lnd/clm2/mappingdata/maps/0.1x0.1/map_4x5_nomask_to_0.1x0.1_nomask_aave_da_c120706.nc
-lnd/clm2/mappingdata/maps/0.1x0.1/map_1.9x2.5_nomask_to_0.1x0.1_nomask_aave_da_c120709.nc
-lnd/clm2/mappingdata/maps/0.1x0.1/map_ne240np4_nomask_to_0.1x0.1_nomask_aave_da_c120711.nc
-lnd/clm2/mappingdata/maps/0.1x0.1/map_0.9x1.25_GRDC_to_0.1x0.1_nomask_aave_da_c130308.nc
-lnd/clm2/mappingdata/maps/0.1x0.1/map_360x720_cruncep_to_0.1x0.1_nomask_aave_da_c130326.nc
-lnd/clm2/mappingdata/maps/0.1x0.1/map_1km-merge-10min_HYDRO1K-merge-nomask_to_0.1x0.1_nomask_aave_da_c130405.nc
-
-
-
-
-
-lnd/clm2/mappingdata/maps/1x1_asphaltjungleNJ/map_0.5x0.5_AVHRR_to_1x1_asphaltjungleNJ_nomask_aave_da_c120717.nc
-lnd/clm2/mappingdata/maps/1x1_asphaltjungleNJ/map_0.5x0.5_MODIS_to_1x1_asphaltjungleNJ_nomask_aave_da_c120717.nc
-lnd/clm2/mappingdata/maps/1x1_asphaltjungleNJ/map_0.25x0.25_MODIS_to_1x1_asphaltjungleNJ_nomask_aave_da_c170321.nc
-lnd/clm2/mappingdata/maps/1x1_asphaltjungleNJ/map_0.5x0.5_nomask_to_1x1_asphaltjungleNJ_nomask_aave_da_c120717.nc
-lnd/clm2/mappingdata/maps/1x1_asphaltjungleNJ/map_10x10min_nomask_to_1x1_asphaltjungleNJ_nomask_aave_da_c120717.nc
-lnd/clm2/mappingdata/maps/1x1_asphaltjungleNJ/map_3x3min_MODIS_to_1x1_asphaltjungleNJ_nomask_aave_da_c120717.nc
-lnd/clm2/mappingdata/maps/1x1_asphaltjungleNJ/map_3x3min_MODIS-wCsp_to_1x1_asphaltjungleNJ_nomask_aave_da_c160425.nc
-lnd/clm2/mappingdata/maps/1x1_asphaltjungleNJ/map_3x3min_USGS_to_1x1_asphaltjungleNJ_nomask_aave_da_c120927.nc
-lnd/clm2/mappingdata/maps/1x1_asphaltjungleNJ/map_3x3min_LandScan2004_to_1x1_asphaltjungleNJ_nomask_aave_da_c121114.nc
-lnd/clm2/mappingdata/maps/1x1_asphaltjungleNJ/map_5x5min_IGBP-GSDP_to_1x1_asphaltjungleNJ_nomask_aave_da_c120717.nc
-lnd/clm2/mappingdata/maps/1x1_asphaltjungleNJ/map_5x5min_ISRIC-WISE_to_1x1_asphaltjungleNJ_nomask_aave_da_c120717.nc
-lnd/clm2/mappingdata/maps/1x1_asphaltjungleNJ/map_5x5min_ORNL-Soil_to_1x1_asphaltjungleNJ_nomask_aave_da_c170706.nc
-lnd/clm2/mappingdata/maps/1x1_asphaltjungleNJ/map_5x5min_nomask_to_1x1_asphaltjungleNJ_nomask_aave_da_c120717.nc
-lnd/clm2/mappingdata/maps/1x1_asphaltjungleNJ/map_3x3min_GLOBE-Gardner_to_1x1_asphaltjungleNJ_nomask_aave_da_c120927.nc
-lnd/clm2/mappingdata/maps/1x1_asphaltjungleNJ/map_3x3min_GLOBE-Gardner-mergeGIS_to_1x1_asphaltjungleNJ_nomask_aave_da_c120927.nc
-lnd/clm2/mappingdata/maps/1x1_asphaltjungleNJ/map_0.9x1.25_GRDC_to_1x1_asphaltjungleNJ_nomask_aave_da_c130309.nc
-lnd/clm2/mappingdata/maps/1x1_asphaltjungleNJ/map_360x720_cruncep_to_1x1_asphaltjungleNJ_nomask_aave_da_c130326.nc
-lnd/clm2/mappingdata/maps/1x1_asphaltjungleNJ/map_1km-merge-10min_HYDRO1K-merge-nomask_to_1x1_asphaltjungleNJ_nomask_aave_da_c130403.nc
-
-
-
-
-
-lnd/clm2/mappingdata/maps/1x1_brazil/map_0.5x0.5_AVHRR_to_1x1_brazil_nomask_aave_da_c120717.nc
-lnd/clm2/mappingdata/maps/1x1_brazil/map_0.5x0.5_MODIS_to_1x1_brazil_nomask_aave_da_c120717.nc
-lnd/clm2/mappingdata/maps/1x1_brazil/map_0.25x0.25_MODIS_to_1x1_brazil_nomask_aave_da_c170321.nc
-lnd/clm2/mappingdata/maps/1x1_brazil/map_0.5x0.5_nomask_to_1x1_brazil_nomask_aave_da_c120717.nc
-lnd/clm2/mappingdata/maps/1x1_brazil/map_10x10min_nomask_to_1x1_brazil_nomask_aave_da_c120717.nc
-lnd/clm2/mappingdata/maps/1x1_brazil/map_3x3min_MODIS_to_1x1_brazil_nomask_aave_da_c120717.nc
-lnd/clm2/mappingdata/maps/1x1_brazil/map_3x3min_MODIS-wCsp_to_1x1_brazil_nomask_aave_da_c160425.nc
-lnd/clm2/mappingdata/maps/1x1_brazil/map_3x3min_USGS_to_1x1_brazil_nomask_aave_da_c120927.nc
-lnd/clm2/mappingdata/maps/1x1_brazil/map_3x3min_LandScan2004_to_1x1_brazil_nomask_aave_da_c121114.nc
-lnd/clm2/mappingdata/maps/1x1_brazil/map_5x5min_IGBP-GSDP_to_1x1_brazil_nomask_aave_da_c120717.nc
-lnd/clm2/mappingdata/maps/1x1_brazil/map_5x5min_ISRIC-WISE_to_1x1_brazil_nomask_aave_da_c120717.nc
-lnd/clm2/mappingdata/maps/1x1_brazil/map_5x5min_ORNL-Soil_to_1x1_brazil_nomask_aave_da_c170706.nc
-lnd/clm2/mappingdata/maps/1x1_brazil/map_5x5min_nomask_to_1x1_brazil_nomask_aave_da_c120717.nc
-lnd/clm2/mappingdata/maps/1x1_brazil/map_3x3min_GLOBE-Gardner_to_1x1_brazil_nomask_aave_da_c120927.nc
-lnd/clm2/mappingdata/maps/1x1_brazil/map_3x3min_GLOBE-Gardner-mergeGIS_to_1x1_brazil_nomask_aave_da_c120927.nc
-lnd/clm2/mappingdata/maps/1x1_brazil/map_0.9x1.25_GRDC_to_1x1_brazil_nomask_aave_da_c130309.nc
-lnd/clm2/mappingdata/maps/1x1_brazil/map_360x720_cruncep_to_1x1_brazil_nomask_aave_da_c130326.nc
-lnd/clm2/mappingdata/maps/1x1_brazil/map_1km-merge-10min_HYDRO1K-merge-nomask_to_1x1_brazil_nomask_aave_da_c130403.nc
-
-
-
-
-
-lnd/clm2/mappingdata/maps/1x1_camdenNJ/map_0.5x0.5_AVHRR_to_1x1_camdenNJ_nomask_aave_da_c120717.nc
-lnd/clm2/mappingdata/maps/1x1_camdenNJ/map_0.5x0.5_MODIS_to_1x1_camdenNJ_nomask_aave_da_c120717.nc
-lnd/clm2/mappingdata/maps/1x1_camdenNJ/map_0.25x0.25_MODIS_to_1x1_camdenNJ_nomask_aave_da_c170321.nc
-lnd/clm2/mappingdata/maps/1x1_camdenNJ/map_0.5x0.5_nomask_to_1x1_camdenNJ_nomask_aave_da_c120717.nc
-lnd/clm2/mappingdata/maps/1x1_camdenNJ/map_10x10min_nomask_to_1x1_camdenNJ_nomask_aave_da_c120717.nc
-lnd/clm2/mappingdata/maps/1x1_camdenNJ/map_3x3min_MODIS_to_1x1_camdenNJ_nomask_aave_da_c120717.nc
-lnd/clm2/mappingdata/maps/1x1_camdenNJ/map_3x3min_MODIS-wCsp_to_1x1_camdenNJ_nomask_aave_da_c160425.nc
-lnd/clm2/mappingdata/maps/1x1_camdenNJ/map_3x3min_USGS_to_1x1_camdenNJ_nomask_aave_da_c120927.nc
-lnd/clm2/mappingdata/maps/1x1_camdenNJ/map_3x3min_LandScan2004_to_1x1_camdenNJ_nomask_aave_da_c121114.nc
-lnd/clm2/mappingdata/maps/1x1_camdenNJ/map_5x5min_IGBP-GSDP_to_1x1_camdenNJ_nomask_aave_da_c120717.nc
-lnd/clm2/mappingdata/maps/1x1_camdenNJ/map_5x5min_ISRIC-WISE_to_1x1_camdenNJ_nomask_aave_da_c120717.nc
-lnd/clm2/mappingdata/maps/1x1_camdenNJ/map_5x5min_ORNL-Soil_to_1x1_camdenNJ_nomask_aave_da_c170706.nc
-lnd/clm2/mappingdata/maps/1x1_camdenNJ/map_5x5min_nomask_to_1x1_camdenNJ_nomask_aave_da_c120717.nc
-lnd/clm2/mappingdata/maps/1x1_camdenNJ/map_3x3min_GLOBE-Gardner_to_1x1_camdenNJ_nomask_aave_da_c120927.nc
-lnd/clm2/mappingdata/maps/1x1_camdenNJ/map_3x3min_GLOBE-Gardner-mergeGIS_to_1x1_camdenNJ_nomask_aave_da_c120927.nc
-lnd/clm2/mappingdata/maps/1x1_camdenNJ/map_0.9x1.25_GRDC_to_1x1_camdenNJ_nomask_aave_da_c130309.nc
-lnd/clm2/mappingdata/maps/1x1_camdenNJ/map_360x720_cruncep_to_1x1_camdenNJ_nomask_aave_da_c130326.nc
-lnd/clm2/mappingdata/maps/1x1_camdenNJ/map_1km-merge-10min_HYDRO1K-merge-nomask_to_1x1_camdenNJ_nomask_aave_da_c130403.nc
-
-
-
-
-
-lnd/clm2/mappingdata/maps/1x1_mexicocityMEX/map_0.5x0.5_AVHRR_to_1x1_mexicocityMEX_nomask_aave_da_c120717.nc
-lnd/clm2/mappingdata/maps/1x1_mexicocityMEX/map_0.5x0.5_MODIS_to_1x1_mexicocityMEX_nomask_aave_da_c120717.nc
-lnd/clm2/mappingdata/maps/1x1_mexicocityMEX/map_0.25x0.25_MODIS_to_1x1_mexicocityMEX_nomask_aave_da_c170321.nc
-lnd/clm2/mappingdata/maps/1x1_mexicocityMEX/map_0.5x0.5_nomask_to_1x1_mexicocityMEX_nomask_aave_da_c120717.nc
-lnd/clm2/mappingdata/maps/1x1_mexicocityMEX/map_10x10min_nomask_to_1x1_mexicocityMEX_nomask_aave_da_c120717.nc
-lnd/clm2/mappingdata/maps/1x1_mexicocityMEX/map_3x3min_MODIS_to_1x1_mexicocityMEX_nomask_aave_da_c120717.nc
-lnd/clm2/mappingdata/maps/1x1_mexicocityMEX/map_3x3min_MODIS-wCsp_to_1x1_mexicocityMEX_nomask_aave_da_c160425.nc
-lnd/clm2/mappingdata/maps/1x1_mexicocityMEX/map_3x3min_USGS_to_1x1_mexicocityMEX_nomask_aave_da_c120927.nc
-lnd/clm2/mappingdata/maps/1x1_mexicocityMEX/map_3x3min_LandScan2004_to_1x1_mexicocityMEX_nomask_aave_da_c121114.nc
-lnd/clm2/mappingdata/maps/1x1_mexicocityMEX/map_5x5min_IGBP-GSDP_to_1x1_mexicocityMEX_nomask_aave_da_c120717.nc
-lnd/clm2/mappingdata/maps/1x1_mexicocityMEX/map_5x5min_ISRIC-WISE_to_1x1_mexicocityMEX_nomask_aave_da_c120717.nc
-lnd/clm2/mappingdata/maps/1x1_mexicocityMEX/map_5x5min_ORNL-Soil_to_1x1_mexicocityMEX_nomask_aave_da_c170706.nc
-lnd/clm2/mappingdata/maps/1x1_mexicocityMEX/map_5x5min_nomask_to_1x1_mexicocityMEX_nomask_aave_da_c120717.nc
-lnd/clm2/mappingdata/maps/1x1_mexicocityMEX/map_3x3min_GLOBE-Gardner_to_1x1_mexicocityMEX_nomask_aave_da_c120927.nc
-lnd/clm2/mappingdata/maps/1x1_mexicocityMEX/map_3x3min_GLOBE-Gardner-mergeGIS_to_1x1_mexicocityMEX_nomask_aave_da_c120927.nc
-lnd/clm2/mappingdata/maps/1x1_mexicocityMEX/map_0.9x1.25_GRDC_to_1x1_mexicocityMEX_nomask_aave_da_c130309.nc
-lnd/clm2/mappingdata/maps/1x1_mexicocityMEX/map_360x720_cruncep_to_1x1_mexicocityMEX_nomask_aave_da_c130326.nc
-lnd/clm2/mappingdata/maps/1x1_mexicocityMEX/map_1km-merge-10min_HYDRO1K-merge-nomask_to_1x1_mexicocityMEX_nomask_aave_da_c130403.nc
-
-
-
-
-
-lnd/clm2/mappingdata/maps/1x1_numaIA/map_0.5x0.5_AVHRR_to_1x1_numaIA_nomask_aave_da_c120717.nc
-lnd/clm2/mappingdata/maps/1x1_numaIA/map_0.5x0.5_MODIS_to_1x1_numaIA_nomask_aave_da_c120717.nc
-lnd/clm2/mappingdata/maps/1x1_numaIA/map_0.25x0.25_MODIS_to_1x1_numaIA_nomask_aave_da_c170321.nc
-lnd/clm2/mappingdata/maps/1x1_numaIA/map_0.5x0.5_nomask_to_1x1_numaIA_nomask_aave_da_c120717.nc
-lnd/clm2/mappingdata/maps/1x1_numaIA/map_10x10min_nomask_to_1x1_numaIA_nomask_aave_da_c120717.nc
-lnd/clm2/mappingdata/maps/1x1_numaIA/map_3x3min_MODIS_to_1x1_numaIA_nomask_aave_da_c120717.nc
-lnd/clm2/mappingdata/maps/1x1_numaIA/map_3x3min_MODIS-wCsp_to_1x1_numaIA_nomask_aave_da_c160425.nc
-lnd/clm2/mappingdata/maps/1x1_numaIA/map_3x3min_USGS_to_1x1_numaIA_nomask_aave_da_c120927.nc
-lnd/clm2/mappingdata/maps/1x1_numaIA/map_3x3min_LandScan2004_to_1x1_numaIA_nomask_aave_da_c121114.nc
-lnd/clm2/mappingdata/maps/1x1_numaIA/map_5x5min_IGBP-GSDP_to_1x1_numaIA_nomask_aave_da_c120717.nc
-lnd/clm2/mappingdata/maps/1x1_numaIA/map_5x5min_ISRIC-WISE_to_1x1_numaIA_nomask_aave_da_c120717.nc
-lnd/clm2/mappingdata/maps/1x1_numaIA/map_5x5min_ORNL-Soil_to_1x1_numaIA_nomask_aave_da_c170706.nc
-lnd/clm2/mappingdata/maps/1x1_numaIA/map_5x5min_nomask_to_1x1_numaIA_nomask_aave_da_c120717.nc
-lnd/clm2/mappingdata/maps/1x1_numaIA/map_3x3min_GLOBE-Gardner_to_1x1_numaIA_nomask_aave_da_c120927.nc
-lnd/clm2/mappingdata/maps/1x1_numaIA/map_3x3min_GLOBE-Gardner-mergeGIS_to_1x1_numaIA_nomask_aave_da_c120927.nc
-lnd/clm2/mappingdata/maps/1x1_numaIA/map_0.9x1.25_GRDC_to_1x1_numaIA_nomask_aave_da_c130309.nc
-lnd/clm2/mappingdata/maps/1x1_numaIA/map_360x720_cruncep_to_1x1_numaIA_nomask_aave_da_c130326.nc
-lnd/clm2/mappingdata/maps/1x1_numaIA/map_1km-merge-10min_HYDRO1K-merge-nomask_to_1x1_numaIA_nomask_aave_da_c130403.nc
-
-
-
-
-
-lnd/clm2/mappingdata/maps/1x1_smallvilleIA/map_0.5x0.5_AVHRR_to_1x1_smallvilleIA_nomask_aave_da_c120717.nc
-lnd/clm2/mappingdata/maps/1x1_smallvilleIA/map_0.5x0.5_MODIS_to_1x1_smallvilleIA_nomask_aave_da_c120717.nc
-lnd/clm2/mappingdata/maps/1x1_smallvilleIA/map_0.25x0.25_MODIS_to_1x1_smallvilleIA_nomask_aave_da_c170321.nc
-lnd/clm2/mappingdata/maps/1x1_smallvilleIA/map_0.5x0.5_nomask_to_1x1_smallvilleIA_nomask_aave_da_c120717.nc
-lnd/clm2/mappingdata/maps/1x1_smallvilleIA/map_10x10min_nomask_to_1x1_smallvilleIA_nomask_aave_da_c120717.nc
-lnd/clm2/mappingdata/maps/1x1_smallvilleIA/map_3x3min_MODIS_to_1x1_smallvilleIA_nomask_aave_da_c120717.nc
-lnd/clm2/mappingdata/maps/1x1_smallvilleIA/map_3x3min_MODIS-wCsp_to_1x1_smallvilleIA_nomask_aave_da_c160425.nc
-lnd/clm2/mappingdata/maps/1x1_smallvilleIA/map_3x3min_USGS_to_1x1_smallvilleIA_nomask_aave_da_c120927.nc
-lnd/clm2/mappingdata/maps/1x1_smallvilleIA/map_3x3min_LandScan2004_to_1x1_smallvilleIA_nomask_aave_da_c121114.nc
-lnd/clm2/mappingdata/maps/1x1_smallvilleIA/map_5x5min_IGBP-GSDP_to_1x1_smallvilleIA_nomask_aave_da_c120717.nc
-lnd/clm2/mappingdata/maps/1x1_smallvilleIA/map_5x5min_ISRIC-WISE_to_1x1_smallvilleIA_nomask_aave_da_c120717.nc
-lnd/clm2/mappingdata/maps/1x1_smallvilleIA/map_5x5min_ORNL-Soil_to_1x1_smallvilleIA_nomask_aave_da_c170706.nc
-lnd/clm2/mappingdata/maps/1x1_smallvilleIA/map_5x5min_nomask_to_1x1_smallvilleIA_nomask_aave_da_c120717.nc
-lnd/clm2/mappingdata/maps/1x1_smallvilleIA/map_3x3min_GLOBE-Gardner_to_1x1_smallvilleIA_nomask_aave_da_c120927.nc
-lnd/clm2/mappingdata/maps/1x1_smallvilleIA/map_3x3min_GLOBE-Gardner-mergeGIS_to_1x1_smallvilleIA_nomask_aave_da_c120927.nc
-lnd/clm2/mappingdata/maps/1x1_smallvilleIA/map_0.9x1.25_GRDC_to_1x1_smallvilleIA_nomask_aave_da_c130309.nc
-lnd/clm2/mappingdata/maps/1x1_smallvilleIA/map_360x720_cruncep_to_1x1_smallvilleIA_nomask_aave_da_c130326.nc
-lnd/clm2/mappingdata/maps/1x1_smallvilleIA/map_1km-merge-10min_HYDRO1K-merge-nomask_to_1x1_smallvilleIA_nomask_aave_da_c130403.nc
-
-
-
-
-
-lnd/clm2/mappingdata/maps/1x1_urbanc_alpha/map_0.5x0.5_AVHRR_to_1x1_urbanc_alpha_nomask_aave_da_c120717.nc
-lnd/clm2/mappingdata/maps/1x1_urbanc_alpha/map_0.5x0.5_MODIS_to_1x1_urbanc_alpha_nomask_aave_da_c120717.nc
-lnd/clm2/mappingdata/maps/1x1_urbanc_alpha/map_0.25x0.25_MODIS_to_1x1_urbanc_alpha_nomask_aave_da_c170321.nc
-lnd/clm2/mappingdata/maps/1x1_urbanc_alpha/map_0.5x0.5_nomask_to_1x1_urbanc_alpha_nomask_aave_da_c120717.nc
-lnd/clm2/mappingdata/maps/1x1_urbanc_alpha/map_10x10min_nomask_to_1x1_urbanc_alpha_nomask_aave_da_c120717.nc
-lnd/clm2/mappingdata/maps/1x1_urbanc_alpha/map_3x3min_MODIS_to_1x1_urbanc_alpha_nomask_aave_da_c120717.nc
-lnd/clm2/mappingdata/maps/1x1_urbanc_alpha/map_3x3min_MODIS-wCsp_to_1x1_urbanc_alpha_nomask_aave_da_c160425.nc
-lnd/clm2/mappingdata/maps/1x1_urbanc_alpha/map_3x3min_USGS_to_1x1_urbanc_alpha_nomask_aave_da_c120928.nc
-lnd/clm2/mappingdata/maps/1x1_urbanc_alpha/map_3x3min_LandScan2004_to_1x1_urbanc_alpha_nomask_aave_da_c121114.nc
-lnd/clm2/mappingdata/maps/1x1_urbanc_alpha/map_5x5min_IGBP-GSDP_to_1x1_urbanc_alpha_nomask_aave_da_c120717.nc
-lnd/clm2/mappingdata/maps/1x1_urbanc_alpha/map_5x5min_ISRIC-WISE_to_1x1_urbanc_alpha_nomask_aave_da_c120717.nc
-lnd/clm2/mappingdata/maps/1x1_urbanc_alpha/map_5x5min_ORNL-Soil_to_1x1_urbanc_alpha_nomask_aave_da_c170706.nc
-lnd/clm2/mappingdata/maps/1x1_urbanc_alpha/map_5x5min_nomask_to_1x1_urbanc_alpha_nomask_aave_da_c120717.nc
-lnd/clm2/mappingdata/maps/1x1_urbanc_alpha/map_3x3min_GLOBE-Gardner_to_1x1_urbanc_alpha_nomask_aave_da_c120927.nc
-lnd/clm2/mappingdata/maps/1x1_urbanc_alpha/map_3x3min_GLOBE-Gardner-mergeGIS_to_1x1_urbanc_alpha_nomask_aave_da_c120927.nc
-lnd/clm2/mappingdata/maps/1x1_urbanc_alpha/map_0.9x1.25_GRDC_to_1x1_urbanc_alpha_nomask_aave_da_c130309.nc
-lnd/clm2/mappingdata/maps/1x1_urbanc_alpha/map_360x720_cruncep_to_1x1_urbanc_alpha_nomask_aave_da_c130326.nc
-lnd/clm2/mappingdata/maps/1x1_urbanc_alpha/map_1km-merge-10min_HYDRO1K-merge-nomask_to_1x1_urbanc_alpha_nomask_aave_da_c130403.nc
-
-
-
-
-
-lnd/clm2/mappingdata/maps/1x1_vancouverCAN/map_0.5x0.5_AVHRR_to_1x1_vancouverCAN_nomask_aave_da_c120717.nc
-lnd/clm2/mappingdata/maps/1x1_vancouverCAN/map_0.5x0.5_MODIS_to_1x1_vancouverCAN_nomask_aave_da_c120717.nc
-lnd/clm2/mappingdata/maps/1x1_vancouverCAN/map_0.25x0.25_MODIS_to_1x1_vancouverCAN_nomask_aave_da_c170321.nc
-lnd/clm2/mappingdata/maps/1x1_vancouverCAN/map_0.5x0.5_nomask_to_1x1_vancouverCAN_nomask_aave_da_c120717.nc
-lnd/clm2/mappingdata/maps/1x1_vancouverCAN/map_10x10min_nomask_to_1x1_vancouverCAN_nomask_aave_da_c120717.nc
-lnd/clm2/mappingdata/maps/1x1_vancouverCAN/map_3x3min_MODIS_to_1x1_vancouverCAN_nomask_aave_da_c120717.nc
-lnd/clm2/mappingdata/maps/1x1_vancouverCAN/map_3x3min_MODIS-wCsp_to_1x1_vancouverCAN_nomask_aave_da_c160425.nc
-lnd/clm2/mappingdata/maps/1x1_vancouverCAN/map_3x3min_USGS_to_1x1_vancouverCAN_nomask_aave_da_c120927.nc
-lnd/clm2/mappingdata/maps/1x1_vancouverCAN/map_3x3min_LandScan2004_to_1x1_vancouverCAN_nomask_aave_da_c121114.nc
-lnd/clm2/mappingdata/maps/1x1_vancouverCAN/map_5x5min_IGBP-GSDP_to_1x1_vancouverCAN_nomask_aave_da_c120717.nc
-lnd/clm2/mappingdata/maps/1x1_vancouverCAN/map_5x5min_ISRIC-WISE_to_1x1_vancouverCAN_nomask_aave_da_c120717.nc
-lnd/clm2/mappingdata/maps/1x1_vancouverCAN/map_5x5min_ORNL-Soil_to_1x1_vancouverCAN_nomask_aave_da_c170706.nc
-lnd/clm2/mappingdata/maps/1x1_vancouverCAN/map_5x5min_nomask_to_1x1_vancouverCAN_nomask_aave_da_c120717.nc
-lnd/clm2/mappingdata/maps/1x1_vancouverCAN/map_3x3min_GLOBE-Gardner_to_1x1_vancouverCAN_nomask_aave_da_c120927.nc
-lnd/clm2/mappingdata/maps/1x1_vancouverCAN/map_3x3min_GLOBE-Gardner-mergeGIS_to_1x1_vancouverCAN_nomask_aave_da_c120927.nc
-lnd/clm2/mappingdata/maps/1x1_vancouverCAN/map_0.9x1.25_GRDC_to_1x1_vancouverCAN_nomask_aave_da_c130309.nc
-lnd/clm2/mappingdata/maps/1x1_vancouverCAN/map_360x720_cruncep_to_1x1_vancouverCAN_nomask_aave_da_c130326.nc
-lnd/clm2/mappingdata/maps/1x1_vancouverCAN/map_1km-merge-10min_HYDRO1K-merge-nomask_to_1x1_vancouverCAN_nomask_aave_da_c130403.nc
-
-
-
-
-
-lnd/clm2/mappingdata/maps/0.47x0.63/map_0.25x0.25_MODIS_to_0.47x0.63_nomask_aave_da_c170914.nc
-lnd/clm2/mappingdata/maps/0.47x0.63/map_0.5x0.5_AVHRR_to_0.47x0.63_nomask_aave_da_c170914.nc
-lnd/clm2/mappingdata/maps/0.47x0.63/map_0.5x0.5_MODIS_to_0.47x0.63_nomask_aave_da_c170914.nc
-lnd/clm2/mappingdata/maps/0.47x0.63/map_0.9x1.25_GRDC_to_0.47x0.63_nomask_aave_da_c170914.nc
-lnd/clm2/mappingdata/maps/0.47x0.63/map_10x10min_IGBPmergeICESatGIS_to_0.47x0.63_nomask_aave_da_c170914.nc
-lnd/clm2/mappingdata/maps/0.47x0.63/map_10x10min_nomask_to_0.47x0.63_nomask_aave_da_c170914.nc
-lnd/clm2/mappingdata/maps/0.47x0.63/map_1km-merge-10min_HYDRO1K-merge-nomask_to_0.47x0.63_nomask_aave_da_c170914.nc
-lnd/clm2/mappingdata/maps/0.47x0.63/map_360x720cru_cruncep_to_0.47x0.63_nomask_aave_da_c170914.nc
-lnd/clm2/mappingdata/maps/0.47x0.63/map_3x3min_GLOBE-Gardner-mergeGIS_to_0.47x0.63_nomask_aave_da_c170914.nc
-lnd/clm2/mappingdata/maps/0.47x0.63/map_3x3min_GLOBE-Gardner_to_0.47x0.63_nomask_aave_da_c170914.nc
-lnd/clm2/mappingdata/maps/0.47x0.63/map_3x3min_LandScan2004_to_0.47x0.63_nomask_aave_da_c170914.nc
-lnd/clm2/mappingdata/maps/0.47x0.63/map_3x3min_MODIS-wCsp_to_0.47x0.63_nomask_aave_da_c170914.nc
-lnd/clm2/mappingdata/maps/0.47x0.63/map_3x3min_USGS_to_0.47x0.63_nomask_aave_da_c170914.nc
-lnd/clm2/mappingdata/maps/0.47x0.63/map_5x5min_IGBP-GSDP_to_0.47x0.63_nomask_aave_da_c170914.nc
-lnd/clm2/mappingdata/maps/0.47x0.63/map_5x5min_ISRIC-WISE_to_0.47x0.63_nomask_aave_da_c170914.nc
-lnd/clm2/mappingdata/maps/0.47x0.63/map_5x5min_nomask_to_0.47x0.63_nomask_aave_da_c170914.nc
-lnd/clm2/mappingdata/maps/0.47x0.63/map_5x5min_ORNL-Soil_to_0.47x0.63_nomask_aave_da_c170914.nc
-
-
-
-
-lnd/clm2/mappingdata/maps/0.9x1.25/map_0.5x0.5_landuse_to_0.9x1.25_aave_da_110307.nc
-lnd/clm2/mappingdata/maps/0.9x1.25/map_0.25x0.25_MODIS_to_0.9x1.25_nomask_aave_da_c170321.nc
-lnd/clm2/mappingdata/maps/0.9x1.25/map_0.5x0.5_lanwat_to_0.9x1.25_aave_da_110307.nc
-lnd/clm2/mappingdata/maps/0.9x1.25/map_10minx10min_topo_to_0.9x1.25_aave_da_110630.nc
-lnd/clm2/mappingdata/maps/0.9x1.25/map_5minx5min_soitex_to_0.9x1.25_aave_da_110722.nc
-lnd/clm2/mappingdata/maps/0.9x1.25/map_5minx5min_irrig_to_0.9x1.25_aave_da_110529.nc
-lnd/clm2/mappingdata/maps/0.9x1.25/map_5x5min_ISRIC-WISE_to_0.9x1.25_nomask_aave_da_c120525.nc
-lnd/clm2/mappingdata/maps/0.9x1.25/map_5x5min_ORNL-Soil_to_0.9x1.25_nomask_aave_da_c170706.nc
-lnd/clm2/mappingdata/maps/0.9x1.25/map_3x3min_MODIS_to_0.9x1.25_nomask_aave_da_c120523.nc
-lnd/clm2/mappingdata/maps/0.9x1.25/map_3x3min_MODIS-wCsp_to_0.9x1.25_nomask_aave_da_c160425.nc
-lnd/clm2/mappingdata/maps/0.9x1.25/map_3x3min_USGS_to_0.9x1.25_nomask_aave_da_c120926.nc
-lnd/clm2/mappingdata/maps/0.9x1.25/map_3x3min_LandScan2004_to_0.9x1.25_nomask_aave_da_c120522.nc
-lnd/clm2/mappingdata/maps/0.9x1.25/map_3x3min_GLOBE-Gardner_to_0.9x1.25_nomask_aave_da_c120923.nc
-lnd/clm2/mappingdata/maps/0.9x1.25/map_3x3min_GLOBE-Gardner-mergeGIS_to_0.9x1.25_nomask_aave_da_c120923.nc
-lnd/clm2/mappingdata/maps/0.9x1.25/map_0.9x1.25_GRDC_to_0.9x1.25_nomask_aave_da_c130308.nc
-lnd/clm2/mappingdata/maps/0.9x1.25/map_360x720_cruncep_to_0.9x1.25_nomask_aave_da_c130326.nc
-lnd/clm2/mappingdata/maps/0.9x1.25/map_1km-merge-10min_HYDRO1K-merge-nomask_to_0.9x1.25_nomask_aave_da_c130405.nc
-
-lnd/clm2/mappingdata/maps/1.9x2.5/map_0.5x0.5_landuse_to_1.9x2.5_aave_da_110307.nc
-lnd/clm2/mappingdata/maps/1.9x2.5/map_0.25x0.25_MODIS_to_1.9x2.5_nomask_aave_da_c170321.nc
-lnd/clm2/mappingdata/maps/1.9x2.5/map_0.5x0.5_lanwat_to_1.9x2.5_aave_da_110307.nc
-lnd/clm2/mappingdata/maps/1.9x2.5/map_10minx10min_topo_to_1.9x2.5_aave_da_110307.nc
-lnd/clm2/mappingdata/maps/1.9x2.5/map_5minx5min_soitex_to_1.9x2.5_aave_da_110307.nc
-lnd/clm2/mappingdata/maps/1.9x2.5/map_5x5min_nomask_to_1.9x2.5_nomask_aave_da_c120606.nc
-lnd/clm2/mappingdata/maps/1.9x2.5/map_5x5min_ISRIC-WISE_to_1.9x2.5_nomask_aave_da_c111115.nc
-lnd/clm2/mappingdata/maps/1.9x2.5/map_5x5min_ORNL-Soil_to_1.9x2.5_nomask_aave_da_c170706.nc
-lnd/clm2/mappingdata/maps/1.9x2.5/map_3x3min_MODIS_to_1.9x2.5_nomask_aave_da_c111111.nc
-lnd/clm2/mappingdata/maps/1.9x2.5/map_3x3min_MODIS-wCsp_to_1.9x2.5_nomask_aave_da_c160425.nc
-lnd/clm2/mappingdata/maps/1.9x2.5/map_3x3min_USGS_to_1.9x2.5_nomask_aave_da_c120926.nc
-lnd/clm2/mappingdata/maps/1.9x2.5/map_3x3min_LandScan2004_to_1.9x2.5_nomask_aave_da_c120522.nc
-lnd/clm2/mappingdata/maps/1.9x2.5/map_3x3min_GLOBE-Gardner_to_1.9x2.5_nomask_aave_da_c120923.nc
-lnd/clm2/mappingdata/maps/1.9x2.5/map_3x3min_GLOBE-Gardner-mergeGIS_to_1.9x2.5_nomask_aave_da_c120923.nc
-lnd/clm2/mappingdata/maps/1.9x2.5/map_0.9x1.25_GRDC_to_1.9x2.5_nomask_aave_da_c130308.nc
-lnd/clm2/mappingdata/maps/1.9x2.5/map_360x720_cruncep_to_1.9x2.5_nomask_aave_da_c130326.nc
-lnd/clm2/mappingdata/maps/1.9x2.5/map_1km-merge-10min_HYDRO1K-merge-nomask_to_1.9x2.5_nomask_aave_da_c130405.nc
-
-
-lnd/clm2/mappingdata/maps/10x15/map_0.5x0.5_landuse_to_10x15_aave_da_110307.nc
-lnd/clm2/mappingdata/maps/10x15/map_0.25x0.25_MODIS_to_10x15_nomask_aave_da_c170321.nc
-lnd/clm2/mappingdata/maps/10x15/map_0.5x0.5_lanwat_to_10x15_aave_da_110307.nc
-lnd/clm2/mappingdata/maps/10x15/map_10minx10min_topo_to_10x15_aave_da_110307.nc
-lnd/clm2/mappingdata/maps/10x15/map_5minx5min_soitex_to_10x15_aave_da_110307.nc
-lnd/clm2/mappingdata/maps/10x15/map_5x5min_nomask_to_10x15_nomask_aave_da_c120327.nc
-lnd/clm2/mappingdata/maps/10x15/map_5x5min_ISRIC-WISE_to_10x15_nomask_aave_da_c111115.nc
-lnd/clm2/mappingdata/maps/10x15/map_5x5min_ORNL-Soil_to_10x15_nomask_aave_da_c170706.nc
-lnd/clm2/mappingdata/maps/10x15/map_3x3min_MODIS_to_10x15_nomask_aave_da_c111111.nc
-lnd/clm2/mappingdata/maps/10x15/map_3x3min_MODIS-wCsp_to_10x15_nomask_aave_da_c160425.nc
-lnd/clm2/mappingdata/maps/10x15/map_3x3min_USGS_to_10x15_nomask_aave_da_c120926.nc
-lnd/clm2/mappingdata/maps/10x15/map_3x3min_LandScan2004_to_10x15_nomask_aave_da_c120518.nc
-lnd/clm2/mappingdata/maps/10x15/map_3x3min_GLOBE-Gardner_to_10x15_nomask_aave_da_c120923.nc
-lnd/clm2/mappingdata/maps/10x15/map_3x3min_GLOBE-Gardner-mergeGIS_to_10x15_nomask_aave_da_c120923.nc
-lnd/clm2/mappingdata/maps/10x15/map_0.9x1.25_GRDC_to_10x15_nomask_aave_da_c130308.nc
-lnd/clm2/mappingdata/maps/10x15/map_360x720_cruncep_to_10x15_nomask_aave_da_c130326.nc
-lnd/clm2/mappingdata/maps/10x15/map_1km-merge-10min_HYDRO1K-merge-nomask_to_10x15_nomask_aave_da_c130411.nc
-
-lnd/clm2/mappingdata/maps/360x720/map_0.5x0.5_MODIS_to_360x720_nomask_aave_da_c120830.nc
-lnd/clm2/mappingdata/maps/360x720/map_0.25x0.25_MODIS_to_360x720cru_nomask_aave_da_c170321.nc
-lnd/clm2/mappingdata/maps/360x720/map_0.5x0.5_AVHRR_to_360x720_nomask_aave_da_c120830.nc
-lnd/clm2/mappingdata/maps/360x720/map_10x10min_nomask_to_360x720_nomask_aave_da_c120830.nc
-lnd/clm2/mappingdata/maps/360x720/map_5x5min_IGBP-GSDP_to_360x720_nomask_aave_da_c120830.nc
-lnd/clm2/mappingdata/maps/360x720/map_5x5min_nomask_to_360x720_nomask_aave_da_c120830.nc
-lnd/clm2/mappingdata/maps/360x720/map_5x5min_ISRIC-WISE_to_360x720_nomask_aave_da_c120830.nc
-lnd/clm2/mappingdata/maps/360x720/map_5x5min_ORNL-Soil_to_360x720cru_nomask_aave_da_c170706.nc
-lnd/clm2/mappingdata/maps/360x720/map_3x3min_MODIS_to_360x720_nomask_aave_da_c120830.nc
-lnd/clm2/mappingdata/maps/360x720/map_3x3min_MODIS-wCsp_to_360x720cru_nomask_aave_da_c160425.nc
-lnd/clm2/mappingdata/maps/360x720/map_3x3min_USGS_to_360x720_nomask_aave_da_c121128.nc
-lnd/clm2/mappingdata/maps/360x720/map_3x3min_LandScan2004_to_360x720_nomask_aave_da_c121017.nc
-lnd/clm2/mappingdata/maps/360x720/map_3x3min_GLOBE-Gardner_to_360x720_nomask_aave_da_c121128.nc
-lnd/clm2/mappingdata/maps/360x720/map_3x3min_GLOBE-Gardner-mergeGIS_to_360x720_nomask_aave_da_c121128.nc
-lnd/clm2/mappingdata/maps/360x720/map_0.9x1.25_GRDC_to_360x720_nomask_aave_da_c130309.nc
-lnd/clm2/mappingdata/maps/360x720/map_360x720_cruncep_to_360x720_nomask_aave_da_c130326.nc
-lnd/clm2/mappingdata/maps/360x720/map_1km-merge-10min_HYDRO1K-merge-nomask_to_360x720_nomask_aave_da_c130403.nc
-
-
-lnd/clm2/mappingdata/maps/512x1024/map_0.5x0.5_MODIS_to_512x1024_nomask_aave_da_c110920.nc
-lnd/clm2/mappingdata/maps/512x1024/map_0.25x0.25_MODIS_to_512x1024_nomask_aave_da_c170321.nc
-lnd/clm2/mappingdata/maps/512x1024/map_0.5x0.5_AVHRR_to_512x1024_nomask_aave_da_c110920.nc
-lnd/clm2/mappingdata/maps/512x1024/map_10x10min_nomask_to_512x1024_nomask_aave_da_c110920.nc
-lnd/clm2/mappingdata/maps/512x1024/map_5x5min_IGBP-GSDP_to_512x1024_nomask_aave_da_c110920.nc
-lnd/clm2/mappingdata/maps/512x1024/map_5x5min_nomask_to_512x1024_nomask_aave_da_c110920.nc
-lnd/clm2/mappingdata/maps/512x1024/map_5x5min_ISRIC-WISE_to_512x1024_nomask_aave_da_c120906.nc
-lnd/clm2/mappingdata/maps/512x1024/map_5x5min_ORNL-Soil_to_512x1024_nomask_aave_da_c170706.nc
-lnd/clm2/mappingdata/maps/512x1024/map_3x3min_MODIS_to_512x1024_nomask_aave_da_c111111.nc
-lnd/clm2/mappingdata/maps/512x1024/map_3x3min_MODIS-wCsp_to_512x1024_nomask_aave_da_c160425.nc
-lnd/clm2/mappingdata/maps/512x1024/map_3x3min_USGS_to_512x1024_nomask_aave_da_c120927.nc
-lnd/clm2/mappingdata/maps/512x1024/map_3x3min_LandScan2004_to_512x1024_nomask_aave_da_c120518.nc
-lnd/clm2/mappingdata/maps/512x1024/map_3x3min_GLOBE-Gardner_to_512x1024_nomask_aave_da_c120923.nc
-lnd/clm2/mappingdata/maps/512x1024/map_3x3min_GLOBE-Gardner-mergeGIS_to_512x1024_nomask_aave_da_c120923.nc
-lnd/clm2/mappingdata/maps/512x1024/map_0.9x1.25_GRDC_to_512x1024_nomask_aave_da_c130308.nc
-lnd/clm2/mappingdata/maps/512x1024/map_360x720_cruncep_to_512x1024_nomask_aave_da_c130326.nc
-lnd/clm2/mappingdata/maps/512x1024/map_1km-merge-10min_HYDRO1K-merge-nomask_to_512x1024_nomask_aave_da_c130403.nc
-
-
-lnd/clm2/mappingdata/maps/128x256/map_0.5x0.5_MODIS_to_128x256_nomask_aave_da_c110920.nc
-lnd/clm2/mappingdata/maps/128x256/map_0.25x0.25_MODIS_to_128x256_nomask_aave_da_c170321.nc
-lnd/clm2/mappingdata/maps/128x256/map_0.5x0.5_AVHRR_to_128x256_nomask_aave_da_c110920.nc
-lnd/clm2/mappingdata/maps/128x256/map_10x10min_nomask_to_128x256_nomask_aave_da_c110920.nc
-lnd/clm2/mappingdata/maps/128x256/map_5x5min_IGBP-GSDP_to_128x256_nomask_aave_da_c110920.nc
-lnd/clm2/mappingdata/maps/128x256/map_5x5min_nomask_to_128x256_nomask_aave_da_c110920.nc
-lnd/clm2/mappingdata/maps/128x256/map_5x5min_ISRIC-WISE_to_128x256_nomask_aave_da_c111115.nc
-lnd/clm2/mappingdata/maps/128x256/map_5x5min_ORNL-Soil_to_128x256_nomask_aave_da_c170706.nc
-lnd/clm2/mappingdata/maps/128x256/map_3x3min_MODIS_to_128x256_nomask_aave_da_c111111.nc
-lnd/clm2/mappingdata/maps/128x256/map_3x3min_MODIS-wCsp_to_128x256_nomask_aave_da_c160425.nc
-lnd/clm2/mappingdata/maps/128x256/map_3x3min_USGS_to_128x256_nomask_aave_da_c120926.nc
-lnd/clm2/mappingdata/maps/128x256/map_3x3min_LandScan2004_to_128x256_nomask_aave_da_c120518.nc
-lnd/clm2/mappingdata/maps/128x256/map_3x3min_GLOBE-Gardner_to_128x256_nomask_aave_da_c120923.nc
-lnd/clm2/mappingdata/maps/128x256/map_3x3min_GLOBE-Gardner-mergeGIS_to_128x256_nomask_aave_da_c120923.nc
-lnd/clm2/mappingdata/maps/128x256/map_0.9x1.25_GRDC_to_128x256_nomask_aave_da_c130308.nc
-lnd/clm2/mappingdata/maps/128x256/map_360x720_cruncep_to_128x256_nomask_aave_da_c130326.nc
-lnd/clm2/mappingdata/maps/128x256/map_1km-merge-10min_HYDRO1K-merge-nomask_to_128x256_nomask_aave_da_c130403.nc
-
-
-lnd/clm2/mappingdata/maps/64x128/map_0.5x0.5_MODIS_to_64x128_nomask_aave_da_c110920.nc
-lnd/clm2/mappingdata/maps/64x128/map_0.25x0.25_MODIS_to_64x128_nomask_aave_da_c170321.nc
-lnd/clm2/mappingdata/maps/64x128/map_0.5x0.5_AVHRR_to_64x128_nomask_aave_da_c110920.nc
-lnd/clm2/mappingdata/maps/64x128/map_10x10min_nomask_to_64x128_nomask_aave_da_c110920.nc
-lnd/clm2/mappingdata/maps/64x128/map_5x5min_IGBP-GSDP_to_64x128_nomask_aave_da_c110920.nc
-lnd/clm2/mappingdata/maps/64x128/map_5x5min_nomask_to_64x128_nomask_aave_da_c110920.nc
-lnd/clm2/mappingdata/maps/64x128/map_5x5min_ISRIC-WISE_to_64x128_nomask_aave_da_c111115.nc
-lnd/clm2/mappingdata/maps/64x128/map_5x5min_ORNL-Soil_to_64x128_nomask_aave_da_c170706.nc
-lnd/clm2/mappingdata/maps/64x128/map_3x3min_MODIS_to_64x128_nomask_aave_da_c111111.nc
-lnd/clm2/mappingdata/maps/64x128/map_3x3min_MODIS-wCsp_to_64x128_nomask_aave_da_c160428.nc
-lnd/clm2/mappingdata/maps/64x128/map_3x3min_USGS_to_64x128_nomask_aave_da_c120926.nc
-lnd/clm2/mappingdata/maps/64x128/map_3x3min_LandScan2004_to_64x128_nomask_aave_da_c120518.nc
-lnd/clm2/mappingdata/maps/64x128/map_3x3min_GLOBE-Gardner_to_64x128_nomask_aave_da_c120923.nc
-lnd/clm2/mappingdata/maps/64x128/map_3x3min_GLOBE-Gardner-mergeGIS_to_64x128_nomask_aave_da_c120923.nc
-lnd/clm2/mappingdata/maps/64x128/map_0.9x1.25_GRDC_to_64x128_nomask_aave_da_c130308.nc
-lnd/clm2/mappingdata/maps/64x128/map_360x720_cruncep_to_64x128_nomask_aave_da_c130326.nc
-lnd/clm2/mappingdata/maps/64x128/map_1km-merge-10min_HYDRO1K-merge-nomask_to_64x128_nomask_aave_da_c130403.nc
-
-lnd/clm2/mappingdata/maps/48x96/map_0.5x0.5_MODIS_to_48x96_nomask_aave_da_c110822.nc
-lnd/clm2/mappingdata/maps/48x96/map_0.25x0.25_MODIS_to_48x96_nomask_aave_da_c170321.nc
-lnd/clm2/mappingdata/maps/48x96/map_0.5x0.5_AVHRR_to_48x96_nomask_aave_da_c110822.nc
-lnd/clm2/mappingdata/maps/48x96/map_10x10min_nomask_to_48x96_nomask_aave_da_c110822.nc
-lnd/clm2/mappingdata/maps/48x96/map_5x5min_IGBP-GSDP_to_48x96_nomask_aave_da_c110822.nc
-lnd/clm2/mappingdata/maps/48x96/map_5x5min_nomask_to_48x96_nomask_aave_da_c110822.nc
-lnd/clm2/mappingdata/maps/48x96/map_5x5min_ISRIC-WISE_to_48x96_nomask_aave_da_c111115.nc
-lnd/clm2/mappingdata/maps/48x96/map_5x5min_ORNL-Soil_to_48x96_nomask_aave_da_c170706.nc
-lnd/clm2/mappingdata/maps/48x96/map_3x3min_MODIS_to_48x96_nomask_aave_da_c111111.nc
-lnd/clm2/mappingdata/maps/48x96/map_3x3min_MODIS-wCsp_to_48x96_nomask_aave_da_c160425.nc
-lnd/clm2/mappingdata/maps/48x96/map_3x3min_USGS_to_48x96_nomask_aave_da_c120926.nc
-lnd/clm2/mappingdata/maps/48x96/map_3x3min_LandScan2004_to_48x96_nomask_aave_da_c120518.nc
-lnd/clm2/mappingdata/maps/48x96/map_3x3min_GLOBE-Gardner_to_48x96_nomask_aave_da_c120923.nc
-lnd/clm2/mappingdata/maps/48x96/map_3x3min_GLOBE-Gardner-mergeGIS_to_48x96_nomask_aave_da_c120923.nc
-lnd/clm2/mappingdata/maps/48x96/map_0.9x1.25_GRDC_to_48x96_nomask_aave_da_c130308.nc
-lnd/clm2/mappingdata/maps/48x96/map_360x720_cruncep_to_48x96_nomask_aave_da_c130326.nc
-lnd/clm2/mappingdata/maps/48x96/map_1km-merge-10min_HYDRO1K-merge-nomask_to_48x96_nomask_aave_da_c130405.nc
-
-lnd/clm2/mappingdata/maps/32x64/map_0.5x0.5_MODIS_to_32x64_nomask_aave_da_c110920.nc
-lnd/clm2/mappingdata/maps/32x64/map_0.25x0.25_MODIS_to_32x64_nomask_aave_da_c170321.nc
-lnd/clm2/mappingdata/maps/32x64/map_0.5x0.5_AVHRR_to_32x64_nomask_aave_da_c110920.nc
-lnd/clm2/mappingdata/maps/32x64/map_10x10min_nomask_to_32x64_nomask_aave_da_c110920.nc
-lnd/clm2/mappingdata/maps/32x64/map_5x5min_IGBP-GSDP_to_32x64_nomask_aave_da_c110920.nc
-lnd/clm2/mappingdata/maps/32x64/map_5x5min_nomask_to_32x64_nomask_aave_da_c110920.nc
-lnd/clm2/mappingdata/maps/32x64/map_5x5min_ISRIC-WISE_to_32x64_nomask_aave_da_c111115.nc
-lnd/clm2/mappingdata/maps/32x64/map_5x5min_ORNL-Soil_to_32x64_nomask_aave_da_c170706.nc
-lnd/clm2/mappingdata/maps/32x64/map_3x3min_MODIS_to_32x64_nomask_aave_da_c111111.nc
-lnd/clm2/mappingdata/maps/32x64/map_3x3min_MODIS-wCsp_to_32x64_nomask_aave_da_c160425.nc
-lnd/clm2/mappingdata/maps/32x64/map_3x3min_USGS_to_32x64_nomask_aave_da_c120926.nc
-lnd/clm2/mappingdata/maps/32x64/map_3x3min_LandScan2004_to_32x64_nomask_aave_da_c120518.nc
-lnd/clm2/mappingdata/maps/32x64/map_3x3min_GLOBE-Gardner_to_32x64_nomask_aave_da_c120923.nc
-lnd/clm2/mappingdata/maps/32x64/map_3x3min_GLOBE-Gardner-mergeGIS_to_32x64_nomask_aave_da_c120923.nc
-lnd/clm2/mappingdata/maps/32x64/map_0.9x1.25_GRDC_to_32x64_nomask_aave_da_c130308.nc
-lnd/clm2/mappingdata/maps/32x64/map_360x720_cruncep_to_32x64_nomask_aave_da_c130326.nc
-lnd/clm2/mappingdata/maps/32x64/map_1km-merge-10min_HYDRO1K-merge-nomask_to_32x64_nomask_aave_da_c130405.nc
-
-lnd/clm2/mappingdata/maps/8x16/map_0.5x0.5_MODIS_to_8x16_nomask_aave_da_c110920.nc
-lnd/clm2/mappingdata/maps/8x16/map_0.25x0.25_MODIS_to_8x16_nomask_aave_da_c170321.nc
-lnd/clm2/mappingdata/maps/8x16/map_0.5x0.5_AVHRR_to_8x16_nomask_aave_da_c110920.nc
-lnd/clm2/mappingdata/maps/8x16/map_10x10min_nomask_to_8x16_nomask_aave_da_c110920.nc
-lnd/clm2/mappingdata/maps/8x16/map_5x5min_IGBP-GSDP_to_8x16_nomask_aave_da_c110920.nc
-lnd/clm2/mappingdata/maps/8x16/map_5x5min_nomask_to_8x16_nomask_aave_da_c110920.nc
-lnd/clm2/mappingdata/maps/8x16/map_5x5min_ISRIC-WISE_to_8x16_nomask_aave_da_c111115.nc
-lnd/clm2/mappingdata/maps/8x16/map_5x5min_ORNL-Soil_to_8x16_nomask_aave_da_c170706.nc
-lnd/clm2/mappingdata/maps/8x16/map_3x3min_MODIS_to_8x16_nomask_aave_da_c111111.nc
-lnd/clm2/mappingdata/maps/8x16/map_3x3min_MODIS-wCsp_to_8x16_nomask_aave_da_c160425.nc
-lnd/clm2/mappingdata/maps/8x16/map_3x3min_USGS_to_8x16_nomask_aave_da_c120926.nc
-lnd/clm2/mappingdata/maps/8x16/map_3x3min_LandScan2004_to_8x16_nomask_aave_da_c120518.nc
-lnd/clm2/mappingdata/maps/8x16/map_3x3min_GLOBE-Gardner_to_8x16_nomask_aave_da_c120923.nc
-lnd/clm2/mappingdata/maps/8x16/map_3x3min_GLOBE-Gardner-mergeGIS_to_8x16_nomask_aave_da_c120923.nc
-lnd/clm2/mappingdata/maps/8x16/map_0.9x1.25_GRDC_to_8x16_nomask_aave_da_c130308.nc
-lnd/clm2/mappingdata/maps/8x16/map_360x720_cruncep_to_8x16_nomask_aave_da_c130326.nc
-lnd/clm2/mappingdata/maps/8x16/map_1km-merge-10min_HYDRO1K-merge-nomask_to_8x16_nomask_aave_da_c130411.nc
-
-lnd/clm2/mappingdata/maps/4x5/map_0.5x0.5_MODIS_to_4x5_nomask_aave_da_c110822.nc
-lnd/clm2/mappingdata/maps/4x5/map_0.25x0.25_MODIS_to_4x5_nomask_aave_da_c170321.nc
-lnd/clm2/mappingdata/maps/4x5/map_0.5x0.5_AVHRR_to_4x5_nomask_aave_da_c110822.nc
-lnd/clm2/mappingdata/maps/4x5/map_10x10min_nomask_to_4x5_nomask_aave_da_c110822.nc
-lnd/clm2/mappingdata/maps/4x5/map_5x5min_IGBP-GSDP_to_4x5_nomask_aave_da_c110822.nc
-lnd/clm2/mappingdata/maps/4x5/map_5x5min_nomask_to_4x5_nomask_aave_da_c110822.nc
-lnd/clm2/mappingdata/maps/4x5/map_5x5min_ISRIC-WISE_to_4x5_nomask_aave_da_c120906.nc
-lnd/clm2/mappingdata/maps/4x5/map_5x5min_ORNL-Soil_to_4x5_nomask_aave_da_c170706.nc
-lnd/clm2/mappingdata/maps/4x5/map_3x3min_MODIS_to_4x5_nomask_aave_da_c111111.nc
-lnd/clm2/mappingdata/maps/4x5/map_3x3min_MODIS-wCsp_to_4x5_nomask_aave_da_c160425.nc
-lnd/clm2/mappingdata/maps/4x5/map_3x3min_USGS_to_4x5_nomask_aave_da_c120926.nc
-lnd/clm2/mappingdata/maps/4x5/map_3x3min_LandScan2004_to_4x5_nomask_aave_da_c120518.nc
-lnd/clm2/mappingdata/maps/4x5/map_3x3min_GLOBE-Gardner_to_4x5_nomask_aave_da_c120923.nc
-lnd/clm2/mappingdata/maps/4x5/map_3x3min_GLOBE-Gardner-mergeGIS_to_4x5_nomask_aave_da_c120923.nc
-lnd/clm2/mappingdata/maps/4x5/map_0.9x1.25_GRDC_to_4x5_nomask_aave_da_c130308.nc
-lnd/clm2/mappingdata/maps/4x5/map_360x720_cruncep_to_4x5_nomask_aave_da_c130326.nc
-lnd/clm2/mappingdata/maps/4x5/map_1km-merge-10min_HYDRO1K-merge-nomask_to_4x5_nomask_aave_da_c130411.nc
-
-lnd/clm2/mappingdata/maps/0.23x0.31/map_0.5x0.5_MODIS_to_0.23x0.31_nomask_aave_da_c110920.nc
-lnd/clm2/mappingdata/maps/0.23x0.31/map_0.25x0.25_MODIS_to_0.23x0.31_nomask_aave_da_c170321.nc
-lnd/clm2/mappingdata/maps/0.23x0.31/map_0.5x0.5_AVHRR_to_0.23x0.31_nomask_aave_da_c110920.nc
-lnd/clm2/mappingdata/maps/0.23x0.31/map_10x10min_nomask_to_0.23x0.31_nomask_aave_da_c110920.nc
-lnd/clm2/mappingdata/maps/0.23x0.31/map_5x5min_IGBP-GSDP_to_0.23x0.31_nomask_aave_da_c110920.nc
-lnd/clm2/mappingdata/maps/0.23x0.31/map_5x5min_nomask_to_0.23x0.31_nomask_aave_da_c110920.nc
-lnd/clm2/mappingdata/maps/0.23x0.31/map_5x5min_ISRIC-WISE_to_0.23x0.31_nomask_aave_da_c111115.nc
-lnd/clm2/mappingdata/maps/0.23x0.31/map_5x5min_ORNL-Soil_to_0.23x0.31_nomask_aave_da_c170706.nc
-lnd/clm2/mappingdata/maps/0.23x0.31/map_3x3min_MODIS_to_0.23x0.31_nomask_aave_da_c110930.nc
-lnd/clm2/mappingdata/maps/0.23x0.31/map_3x3min_MODIS-wCsp_to_0.23x0.31_nomask_aave_da_c160425.nc
-lnd/clm2/mappingdata/maps/0.23x0.31/map_3x3min_USGS_to_0.23x0.31_nomask_aave_da_c120926.nc
-lnd/clm2/mappingdata/maps/0.23x0.31/map_3x3min_LandScan2004_to_0.23x0.31_nomask_aave_da_c120518.nc
-lnd/clm2/mappingdata/maps/0.23x0.31/map_3x3min_GLOBE-Gardner_to_0.23x0.31_nomask_aave_da_c120923.nc
-lnd/clm2/mappingdata/maps/0.23x0.31/map_3x3min_GLOBE-Gardner-mergeGIS_to_0.23x0.31_nomask_aave_da_c120923.nc
-lnd/clm2/mappingdata/maps/0.23x0.31/map_3x3min_LandScan2004_to_0.23x0.31_nomask_aave_da_c120518.nc
-lnd/clm2/mappingdata/maps/0.23x0.31/map_0.9x1.25_GRDC_to_0.23x0.31_nomask_aave_da_c130308.nc
-lnd/clm2/mappingdata/maps/0.23x0.31/map_360x720_cruncep_to_0.23x0.31_nomask_aave_da_c130326.nc
-lnd/clm2/mappingdata/maps/0.23x0.31/map_1km-merge-10min_HYDRO1K-merge-nomask_to_0.23x0.31_nomask_aave_da_c130405.nc
-
-
-lnd/clm2/mappingdata/maps/2.5x3.33/map_0.5x0.5_MODIS_to_2.5x3.33_nomask_aave_da_c110823.nc
-lnd/clm2/mappingdata/maps/2.5x3.33/map_0.25x0.25_MODIS_to_2.5x3.33_nomask_aave_da_c170321.nc
-lnd/clm2/mappingdata/maps/2.5x3.33/map_0.5x0.5_AVHRR_to_2.5x3.33_nomask_aave_da_c110823.nc
-lnd/clm2/mappingdata/maps/2.5x3.33/map_10x10min_nomask_to_2.5x3.33_nomask_aave_da_c110823.nc
-lnd/clm2/mappingdata/maps/2.5x3.33/map_5x5min_IGBP-GSDP_to_2.5x3.33_nomask_aave_da_c110823.nc
-lnd/clm2/mappingdata/maps/2.5x3.33/map_5x5min_nomask_to_2.5x3.33_nomask_aave_da_c110823.nc
-lnd/clm2/mappingdata/maps/2.5x3.33/map_5x5min_ISRIC-WISE_to_2.5x3.33_nomask_aave_da_c111115.nc
-lnd/clm2/mappingdata/maps/2.5x3.33/map_5x5min_ORNL-Soil_to_2.5x3.33_nomask_aave_da_c170706.nc
-lnd/clm2/mappingdata/maps/2.5x3.33/map_3x3min_MODIS_to_2.5x3.33_nomask_aave_da_c111111.nc
-lnd/clm2/mappingdata/maps/2.5x3.33/map_3x3min_MODIS-wCsp_to_2.5x3.33_nomask_aave_da_c160425.nc
-lnd/clm2/mappingdata/maps/2.5x3.33/map_3x3min_USGS_to_2.5x3.33_nomask_aave_da_c120926.nc
-lnd/clm2/mappingdata/maps/2.5x3.33/map_3x3min_LandScan2004_to_2.5x3.33_nomask_aave_da_c120518.nc
-lnd/clm2/mappingdata/maps/2.5x3.33/map_3x3min_GLOBE-Gardner_to_2.5x3.33_nomask_aave_da_c120923.nc
-lnd/clm2/mappingdata/maps/2.5x3.33/map_3x3min_GLOBE-Gardner-mergeGIS_to_2.5x3.33_nomask_aave_da_c120923.nc
-lnd/clm2/mappingdata/maps/2.5x3.33/map_0.9x1.25_GRDC_to_2.5x3.33_nomask_aave_da_c130308.nc
-lnd/clm2/mappingdata/maps/2.5x3.33/map_360x720_cruncep_to_2.5x3.33_nomask_aave_da_c130326.nc
-lnd/clm2/mappingdata/maps/2.5x3.33/map_1km-merge-10min_HYDRO1K-merge-nomask_to_2.5x3.33_nomask_aave_da_c130405.nc
-
-
-
-
-lnd/clm2/mappingdata/maps/0.5x0.5/map_0.5x0.5_AVHRR_to_0.5x0.5_nomask_aave_da_c111021.nc
-lnd/clm2/mappingdata/maps/0.5x0.5/map_0.25x0.25_MODIS_to_0.5x0.5_nomask_aave_da_c170321.nc
-lnd/clm2/mappingdata/maps/0.5x0.5/map_0.5x0.5_MODIS_to_0.5x0.5_nomask_aave_da_c111021.nc
-lnd/clm2/mappingdata/maps/0.5x0.5/map_0.5x0.5_nomask_to_0.5x0.5_nomask_aave_da_c111021.nc
-lnd/clm2/mappingdata/maps/0.5x0.5/map_10x10min_IGBPmergeICESatGIS_to_0.5x0.5_nomask_aave_da_c111021.nc
-lnd/clm2/mappingdata/maps/0.5x0.5/map_10x10min_nomask_to_0.5x0.5_nomask_aave_da_c111021.nc
-lnd/clm2/mappingdata/maps/0.5x0.5/map_5x5min_IGBP-GSDP_to_0.5x0.5_nomask_aave_da_c111021.nc
-lnd/clm2/mappingdata/maps/0.5x0.5/map_5x5min_nomask_to_0.5x0.5_nomask_aave_da_c111021.nc
-lnd/clm2/mappingdata/maps/0.5x0.5/map_3x3min_MODIS_to_0.5x0.5_nomask_aave_da_c111111.nc
-lnd/clm2/mappingdata/maps/0.5x0.5/map_3x3min_MODIS-wCsp_to_0.5x0.5_nomask_aave_da_c160425.nc
-lnd/clm2/mappingdata/maps/0.5x0.5/map_5x5min_ISRIC-WISE_to_0.5x0.5_nomask_aave_da_c111115.nc
-lnd/clm2/mappingdata/maps/0.5x0.5/map_5x5min_ORNL-Soil_to_0.5x0.5_nomask_aave_da_c170706.nc
-lnd/clm2/mappingdata/maps/0.5x0.5/map_3x3min_LandScan2004_to_0.5x0.5_nomask_aave_da_c120518.nc
-lnd/clm2/mappingdata/maps/0.5x0.5/map_3x3min_GLOBE-Gardner_to_0.5x0.5_nomask_aave_da_c120923.nc
-lnd/clm2/mappingdata/maps/0.5x0.5/map_3x3min_GLOBE-Gardner-mergeGIS_to_0.5x0.5_nomask_aave_da_c120923.nc
-lnd/clm2/mappingdata/maps/0.5x0.5/map_0.1x0.1_nomask_to_0.5x0.5_nomask_aave_da_c120706.nc
-lnd/clm2/mappingdata/maps/0.5x0.5/map_ne240np4_nomask_to_0.5x0.5_nomask_aave_da_c120711.nc
-lnd/clm2/mappingdata/maps/0.5x0.5/map_4x5_nomask_to_0.5x0.5_nomask_aave_da_c120706.nc
-lnd/clm2/mappingdata/maps/0.5x0.5/map_1.9x2.5_nomask_to_0.5x0.5_nomask_aave_da_c120709.nc
-lnd/clm2/mappingdata/maps/0.5x0.5/map_ne120np4_nomask_to_0.5x0.5_nomask_aave_da_c120711.nc
-lnd/clm2/mappingdata/maps/0.5x0.5/map_3x3_USGS_nomask_to_0.5x0.5_nomask_aave_da_c120912.nc
-lnd/clm2/mappingdata/maps/0.5x0.5/map_0.9x1.25_GRDC_to_0.5x0.5_nomask_aave_da_c130308.nc
-lnd/clm2/mappingdata/maps/0.5x0.5/map_360x720_cruncep_to_0.5x0.5_nomask_aave_da_c130326.nc
-lnd/clm2/mappingdata/maps/0.5x0.5/map_1km-merge-10min_HYDRO1K-merge-nomask_to_0.5x0.5_nomask_aave_da_c130405.nc
-
-
-
-lnd/clm2/mappingdata/maps/ne4np4/map_0.5x0.5_MODIS_to_ne4np4_nomask_aave_da_c110923.nc
-lnd/clm2/mappingdata/maps/ne4np4/map_0.25x0.25_MODIS_to_ne4np4_nomask_aave_da_c170321.nc
-lnd/clm2/mappingdata/maps/ne4np4/map_0.5x0.5_AVHRR_to_ne4np4_nomask_aave_da_c110923.nc
-lnd/clm2/mappingdata/maps/ne4np4/map_10x10min_nomask_to_ne4np4_nomask_aave_da_c110923.nc
-lnd/clm2/mappingdata/maps/ne4np4/map_5x5min_IGBP-GSDP_to_ne4np4_nomask_aave_da_c110923.nc
-lnd/clm2/mappingdata/maps/ne4np4/map_5x5min_nomask_to_ne4np4_nomask_aave_da_c110923.nc
-lnd/clm2/mappingdata/maps/ne4np4/map_5x5min_ISRIC-WISE_to_ne4np4_nomask_aave_da_c120906.nc
-lnd/clm2/mappingdata/maps/ne4np4/map_5x5min_ORNL-Soil_to_ne4np4_nomask_aave_da_c170706.nc
-lnd/clm2/mappingdata/maps/ne4np4/map_3x3min_MODIS_to_ne4np4_nomask_aave_da_c120906.nc
-lnd/clm2/mappingdata/maps/ne4np4/map_3x3min_MODIS-wCsp_to_ne4np4_nomask_aave_da_c160425.nc
-lnd/clm2/mappingdata/maps/ne4np4/map_3x3min_USGS_to_ne4np4_nomask_aave_da_c120926.nc
-lnd/clm2/mappingdata/maps/ne4np4/map_3x3min_LandScan2004_to_ne4np4_nomask_aave_da_c120518.nc
-lnd/clm2/mappingdata/maps/ne4np4/map_3x3min_GLOBE-Gardner_to_ne4np4_nomask_aave_da_c120924.nc
-lnd/clm2/mappingdata/maps/ne4np4/map_3x3min_GLOBE-Gardner-mergeGIS_to_ne4np4_nomask_aave_da_c120923.nc
-lnd/clm2/mappingdata/maps/ne4np4/map_3x3min_LandScan2004_to_ne4np4_nomask_aave_da_c120518.nc
-lnd/clm2/mappingdata/maps/ne4np4/map_0.9x1.25_GRDC_to_ne4np4_nomask_aave_da_c130308.nc
-lnd/clm2/mappingdata/maps/ne4np4/map_360x720_cruncep_to_ne4np4_nomask_aave_da_c130326.nc
-lnd/clm2/mappingdata/maps/ne4np4/map_1km-merge-10min_HYDRO1K-merge-nomask_to_ne4np4_nomask_aave_da_c130411.nc
-lnd/clm2/mappingdata/maps/ne4np4/map_ne4np4_nomask_to_0.5x0.5_nomask_aave_da_c110923.nc
-
-
-lnd/clm2/mappingdata/maps/ne16np4/map_0.5x0.5_MODIS_to_ne16np4_nomask_aave_da_c110922.nc
-lnd/clm2/mappingdata/maps/ne16np4/map_0.25x0.25_MODIS_to_ne16np4_nomask_aave_da_c170321.nc
-lnd/clm2/mappingdata/maps/ne16np4/map_0.5x0.5_AVHRR_to_ne16np4_nomask_aave_da_c110922.nc
-lnd/clm2/mappingdata/maps/ne16np4/map_10x10min_nomask_to_ne16np4_nomask_aave_da_c110922.nc
-lnd/clm2/mappingdata/maps/ne16np4/map_5x5min_IGBP-GSDP_to_ne16np4_nomask_aave_da_c110922.nc
-lnd/clm2/mappingdata/maps/ne16np4/map_5x5min_nomask_to_ne16np4_nomask_aave_da_c110922.nc
-lnd/clm2/mappingdata/maps/ne16np4/map_5x5min_ISRIC-WISE_to_ne16np4_nomask_aave_da_c111115.nc
-lnd/clm2/mappingdata/maps/ne16np4/map_5x5min_ORNL-Soil_to_ne16np4_nomask_aave_da_c170706.nc
-lnd/clm2/mappingdata/maps/ne16np4/map_3x3min_MODIS_to_ne16np4_nomask_aave_da_c111111.nc
-lnd/clm2/mappingdata/maps/ne16np4/map_3x3min_MODIS-wCsp_to_ne16np4_nomask_aave_da_c160425.nc
-lnd/clm2/mappingdata/maps/ne16np4/map_3x3min_USGS_to_ne16np4_nomask_aave_da_c120926.nc
-lnd/clm2/mappingdata/maps/ne16np4/map_3x3min_LandScan2004_to_ne16np4_nomask_aave_da_c120518.nc
-lnd/clm2/mappingdata/maps/ne16np4/map_3x3min_GLOBE-Gardner_to_ne16np4_nomask_aave_da_c120924.nc
-lnd/clm2/mappingdata/maps/ne16np4/map_3x3min_GLOBE-Gardner-mergeGIS_to_ne16np4_nomask_aave_da_c120924.nc
-lnd/clm2/mappingdata/maps/ne16np4/map_0.9x1.25_GRDC_to_ne16np4_nomask_aave_da_c130308.nc
-lnd/clm2/mappingdata/maps/ne16np4/map_360x720_cruncep_to_ne16np4_nomask_aave_da_c130326.nc
-lnd/clm2/mappingdata/maps/ne16np4/map_1km-merge-10min_HYDRO1K-merge-nomask_to_ne16np4_nomask_aave_da_c130408.nc
-lnd/clm2/mappingdata/maps/ne16np4/map_ne16np4_nomask_to_0.5x0.5_nomask_aave_da_c110922.nc
-
-
-lnd/clm2/mappingdata/maps/ne30np4/map_0.5x0.5_landuse_to_ne30np4_aave_da_110320.nc
-lnd/clm2/mappingdata/maps/ne30np4/map_0.25x0.25_MODIS_to_ne30np4_nomask_aave_da_c170321.nc
-lnd/clm2/mappingdata/maps/ne30np4/map_0.5x0.5_lanwat_to_ne30np4_aave_da_110320.nc
-lnd/clm2/mappingdata/maps/ne30np4/map_10minx10min_topo_to_ne30np4_aave_da_110320.nc
-lnd/clm2/mappingdata/maps/ne30np4/map_5minx5min_soitex_to_ne30np4_aave_da_110320.nc
-lnd/clm2/mappingdata/maps/ne30np4/map_5minx5min_irrig_to_ne30np4_aave_da_110720.nc
-lnd/clm2/mappingdata/maps/ne30np4/map_5x5min_ISRIC-WISE_to_ne30np4_nomask_aave_da_c111115.nc
-lnd/clm2/mappingdata/maps/ne30np4/map_5x5min_ORNL-Soil_to_ne30np4_nomask_aave_da_c170706.nc
-lnd/clm2/mappingdata/maps/ne30np4/map_3x3min_MODIS_to_ne30np4_nomask_aave_da_c111111.nc
-lnd/clm2/mappingdata/maps/ne30np4/map_3x3min_MODIS-wCsp_to_ne30np4_nomask_aave_da_c160425.nc
-lnd/clm2/mappingdata/maps/ne30np4/map_3x3min_USGS_to_ne30np4_nomask_aave_da_c120926.nc
-lnd/clm2/mappingdata/maps/ne30np4/map_3x3min_LandScan2004_to_ne30np4_nomask_aave_da_c120518.nc
-lnd/clm2/mappingdata/maps/ne30np4/map_3x3min_GLOBE-Gardner_to_ne30np4_nomask_aave_da_c120924.nc
-lnd/clm2/mappingdata/maps/ne30np4/map_3x3min_GLOBE-Gardner-mergeGIS_to_ne30np4_nomask_aave_da_c120924.nc
-lnd/clm2/mappingdata/maps/ne30np4/map_0.9x1.25_GRDC_to_ne30np4_nomask_aave_da_c130308.nc
-lnd/clm2/mappingdata/maps/ne30np4/map_360x720_cruncep_to_ne30np4_nomask_aave_da_c130326.nc
-lnd/clm2/mappingdata/maps/ne30np4/map_1km-merge-10min_HYDRO1K-merge-nomask_to_ne30np4_nomask_aave_da_c130405.nc
-
-lnd/clm2/mappingdata/maps/ne30np4/map_ne30np4_to_0.5x0.5rtm_aave_da_110320.nc
-
-lnd/clm2/mappingdata/maps/ne60np4/map_0.5x0.5_MODIS_to_ne60np4_nomask_aave_da_c110922.nc
-lnd/clm2/mappingdata/maps/ne60np4/map_0.25x0.25_MODIS_to_ne60np4_nomask_aave_da_c170321.nc
-lnd/clm2/mappingdata/maps/ne60np4/map_0.5x0.5_AVHRR_to_ne60np4_nomask_aave_da_c110922.nc
-lnd/clm2/mappingdata/maps/ne60np4/map_10x10min_nomask_to_ne60np4_nomask_aave_da_c110922.nc
-lnd/clm2/mappingdata/maps/ne60np4/map_5x5min_IGBP-GSDP_to_ne60np4_nomask_aave_da_c110922.nc
-lnd/clm2/mappingdata/maps/ne60np4/map_5x5min_nomask_to_ne60np4_nomask_aave_da_c110922.nc
-lnd/clm2/mappingdata/maps/ne60np4/map_5x5min_ISRIC-WISE_to_ne60np4_nomask_aave_da_c111115.nc
-lnd/clm2/mappingdata/maps/ne60np4/map_5x5min_ORNL-Soil_to_ne60np4_nomask_aave_da_c170706.nc
-lnd/clm2/mappingdata/maps/ne60np4/map_3x3min_MODIS_to_ne60np4_nomask_aave_da_c111111.nc
-lnd/clm2/mappingdata/maps/ne60np4/map_3x3min_MODIS-wCsp_to_ne60np4_nomask_aave_da_c160425.nc
-lnd/clm2/mappingdata/maps/ne60np4/map_3x3min_USGS_to_ne60np4_nomask_aave_da_c120926.nc
-lnd/clm2/mappingdata/maps/ne60np4/map_3x3min_LandScan2004_to_ne60np4_nomask_aave_da_c120518.nc
-lnd/clm2/mappingdata/maps/ne60np4/map_3x3min_GLOBE-Gardner_to_ne60np4_nomask_aave_da_c120924.nc
-lnd/clm2/mappingdata/maps/ne60np4/map_3x3min_GLOBE-Gardner-mergeGIS_to_ne60np4_nomask_aave_da_c120924.nc
-lnd/clm2/mappingdata/maps/ne60np4/map_0.9x1.25_GRDC_to_ne60np4_nomask_aave_da_c130308.nc
-lnd/clm2/mappingdata/maps/ne60np4/map_360x720_cruncep_to_ne60np4_nomask_aave_da_c130326.nc
-lnd/clm2/mappingdata/maps/ne60np4/map_1km-merge-10min_HYDRO1K-merge-nomask_to_ne60np4_nomask_aave_da_c130405.nc
-lnd/clm2/mappingdata/maps/ne60np4/map_ne60np4_nomask_to_0.5x0.5_nomask_aave_da_c110922.nc
-
-lnd/clm2/mappingdata/maps/ne120np4/map_0.5x0.5_landuse_to_ne120np4_aave_da_110320.nc
-lnd/clm2/mappingdata/maps/ne120np4/map_0.25x0.25_MODIS_to_ne120np4_nomask_aave_da_c170321.nc
-lnd/clm2/mappingdata/maps/ne120np4/map_0.5x0.5_lanwat_to_ne120np4_aave_da_110320.nc
-lnd/clm2/mappingdata/maps/ne120np4/map_10minx10min_topo_to_ne120np4_aave_da_110320.nc
-lnd/clm2/mappingdata/maps/ne120np4/map_5minx5min_soitex_to_ne120np4_aave_da_110320.nc
-lnd/clm2/mappingdata/maps/ne120np4/map_5x5min_ISRIC-WISE_to_ne120np4_nomask_aave_da_c111115.nc
-lnd/clm2/mappingdata/maps/ne120np4/map_5x5min_ORNL-Soil_to_ne120np4_nomask_aave_da_c170706.nc
-lnd/clm2/mappingdata/maps/ne120np4/map_5minx5min_irrig_to_ne120np4_aave_da_110817.nc
-lnd/clm2/mappingdata/maps/ne120np4/map_3x3min_MODIS_to_ne120np4_nomask_aave_da_c111111.nc
-lnd/clm2/mappingdata/maps/ne120np4/map_3x3min_MODIS-wCsp_to_ne120np4_nomask_aave_da_c160425.nc
-lnd/clm2/mappingdata/maps/ne120np4/map_3x3min_USGS_to_ne120np4_nomask_aave_da_c120913.nc
-lnd/clm2/mappingdata/maps/ne120np4/map_3x3min_LandScan2004_to_ne120np4_nomask_aave_da_c120518.nc
-lnd/clm2/mappingdata/maps/ne120np4/map_3x3min_GLOBE-Gardner_to_ne120np4_nomask_aave_da_c120924.nc
-lnd/clm2/mappingdata/maps/ne120np4/map_3x3min_GLOBE-Gardner-mergeGIS_to_ne120np4_nomask_aave_da_c120924.nc
-lnd/clm2/mappingdata/maps/ne120np4/map_3x3min_USGS_to_ne120np4_nomask_aave_da_c120913.nc
-lnd/clm2/mappingdata/maps/ne120np4/map_0.9x1.25_GRDC_to_ne120np4_nomask_aave_da_c130308.nc
-lnd/clm2/mappingdata/maps/ne120np4/map_360x720_cruncep_to_ne120np4_nomask_aave_da_c130326.nc
-lnd/clm2/mappingdata/maps/ne120np4/map_1km-merge-10min_HYDRO1K-merge-nomask_to_ne120np4_nomask_aave_da_c130405.nc
-
-
-
-
-lnd/clm2/mappingdata/maps/ne120np4/map_0.1x0.1_nomask_to_ne120np4_nomask_aave_da_c120706.nc
-
-
-
-lnd/clm2/mappingdata/maps/5x5_amazon/map_0.5x0.5_MODIS_to_5x5_amazon_nomask_aave_da_c110920.nc
-lnd/clm2/mappingdata/maps/5x5_amazon/map_0.25x0.25_MODIS_to_5x5_amazon_nomask_aave_da_c170321.nc
-lnd/clm2/mappingdata/maps/5x5_amazon/map_0.5x0.5_AVHRR_to_5x5_amazon_nomask_aave_da_c110920.nc
-lnd/clm2/mappingdata/maps/5x5_amazon/map_10x10min_nomask_to_5x5_amazon_nomask_aave_da_c110920.nc
-lnd/clm2/mappingdata/maps/5x5_amazon/map_5x5min_IGBP-GSDP_to_5x5_amazon_nomask_aave_da_c110920.nc
-lnd/clm2/mappingdata/maps/5x5_amazon/map_5x5min_nomask_to_5x5_amazon_nomask_aave_da_c110920.nc
-lnd/clm2/mappingdata/maps/5x5_amazon/map_5x5min_ISRIC-WISE_to_5x5_amazon_nomask_aave_da_c111115.nc
-lnd/clm2/mappingdata/maps/5x5_amazon/map_5x5min_ORNL-Soil_to_5x5_amazon_nomask_aave_da_c170706.nc
-lnd/clm2/mappingdata/maps/5x5_amazon/map_3x3min_MODIS_to_5x5_amazon_nomask_aave_da_c111111.nc
-lnd/clm2/mappingdata/maps/5x5_amazon/map_3x3min_MODIS-wCsp_to_5x5_amazon_nomask_aave_da_c160425.nc
-lnd/clm2/mappingdata/maps/5x5_amazon/map_3x3min_USGS_to_5x5_amazon_nomask_aave_da_c120927.nc
-lnd/clm2/mappingdata/maps/5x5_amazon/map_3x3min_LandScan2004_to_5x5_amazon_nomask_aave_da_c120518.nc
-lnd/clm2/mappingdata/maps/5x5_amazon/map_3x3min_GLOBE-Gardner_to_5x5_amazon_nomask_aave_da_c120923.nc
-lnd/clm2/mappingdata/maps/5x5_amazon/map_3x3min_GLOBE-Gardner-mergeGIS_to_5x5_amazon_nomask_aave_da_c120923.nc
-lnd/clm2/mappingdata/maps/5x5_amazon/map_0.9x1.25_GRDC_to_5x5_amazon_nomask_aave_da_c130309.nc
-lnd/clm2/mappingdata/maps/5x5_amazon/map_360x720_cruncep_to_5x5_amazon_nomask_aave_da_c130326.nc
-lnd/clm2/mappingdata/maps/5x5_amazon/map_1km-merge-10min_HYDRO1K-merge-nomask_to_5x5_amazon_nomask_aave_da_c130403.nc
-
-lnd/clm2/mappingdata/maps/ne240np4/map_0.5x0.5_MODIS_to_ne240np4_nomask_aave_da_c110922.nc
-lnd/clm2/mappingdata/maps/ne240np4/map_0.25x0.25_MODIS_to_ne240np4_nomask_aave_da_c170321.nc
-lnd/clm2/mappingdata/maps/ne240np4/map_0.5x0.5_AVHRR_to_ne240np4_nomask_aave_da_c110922.nc
-lnd/clm2/mappingdata/maps/ne240np4/map_10x10min_nomask_to_ne240np4_nomask_aave_da_c110922.nc
-lnd/clm2/mappingdata/maps/ne240np4/map_5x5min_IGBP-GSDP_to_ne240np4_nomask_aave_da_c110922.nc
-lnd/clm2/mappingdata/maps/ne240np4/map_5x5min_nomask_to_ne240np4_nomask_aave_da_c110922.nc
-lnd/clm2/mappingdata/maps/ne240np4/map_5x5min_ISRIC-WISE_to_ne240np4_nomask_aave_da_c111115.nc
-lnd/clm2/mappingdata/maps/ne240np4/map_5x5min_ORNL-Soil_to_ne240np4_nomask_aave_da_c170706.nc
-lnd/clm2/mappingdata/maps/ne240np4/map_3x3min_MODIS_to_ne240np4_nomask_aave_da_c111111.nc
-lnd/clm2/mappingdata/maps/ne240np4/map_3x3min_MODIS-wCsp_to_ne240np4_nomask_aave_da_c160425.nc
-lnd/clm2/mappingdata/maps/ne240np4/map_3x3min_USGS_to_ne240np4_nomask_aave_da_c120926.nc
-lnd/clm2/mappingdata/maps/ne240np4/map_3x3min_LandScan2004_to_ne240np4_nomask_aave_da_c120521.nc
-lnd/clm2/mappingdata/maps/ne240np4/map_3x3min_GLOBE-Gardner_to_ne240np4_nomask_aave_da_c120925.nc
-lnd/clm2/mappingdata/maps/ne240np4/map_3x3min_GLOBE-Gardner-mergeGIS_to_ne240np4_nomask_aave_da_c120925.nc
-lnd/clm2/mappingdata/maps/ne240np4/map_0.9x1.25_GRDC_to_ne240np4_nomask_aave_da_c130308.nc
-lnd/clm2/mappingdata/maps/ne240np4/map_360x720_cruncep_to_ne240np4_nomask_aave_da_c130326.nc
-lnd/clm2/mappingdata/maps/ne240np4/map_1km-merge-10min_HYDRO1K-merge-nomask_to_ne240np4_nomask_aave_da_c130405.nc
-lnd/clm2/mappingdata/maps/ne240np4/map_ne240np4_nomask_to_0.5x0.5_nomask_aave_da_c110922.nc
-
-
-
-
-lnd/clm2/mappingdata/maps/0.125x0.125/map_0.5x0.5_AVHRR_to_0.125x0.125_nomask_aave_da_c140702.nc
-lnd/clm2/mappingdata/maps/0.125x0.125/map_0.5x0.5_MODIS_to_0.125x0.125_nomask_aave_da_c140702.nc
-lnd/clm2/mappingdata/maps/0.125x0.125/map_0.25x0.25_MODIS_to_0.125x0.125_nomask_aave_da_c170321.nc
-lnd/clm2/mappingdata/maps/0.125x0.125/map_0.9x1.25_GRDC_to_0.125x0.125_nomask_aave_da_c140702.nc
-lnd/clm2/mappingdata/maps/0.125x0.125/map_10x10min_IGBPmergeICESatGIS_to_0.125x0.125_nomask_aave_da_c140702.nc
-lnd/clm2/mappingdata/maps/0.125x0.125/map_10x10min_nomask_to_0.125x0.125_nomask_aave_da_c140702.nc
-lnd/clm2/mappingdata/maps/0.125x0.125/map_1km-merge-10min_HYDRO1K-merge-nomask_to_0.125x0.125_nomask_aave_da_c140702.nc
-lnd/clm2/mappingdata/maps/0.125x0.125/map_360x720cru_cruncep_to_0.125x0.125_nomask_aave_da_c140702.nc
-lnd/clm2/mappingdata/maps/0.125x0.125/map_3x3min_GLOBE-Gardner-mergeGIS_to_0.125x0.125_nomask_aave_da_c140702.nc
-lnd/clm2/mappingdata/maps/0.125x0.125/map_3x3min_GLOBE-Gardner_to_0.125x0.125_nomask_aave_da_c140702.nc
-lnd/clm2/mappingdata/maps/0.125x0.125/map_3x3min_LandScan2004_to_0.125x0.125_nomask_aave_da_c140702.nc
-lnd/clm2/mappingdata/maps/0.125x0.125/map_3x3min_MODIS_to_0.125x0.125_nomask_aave_da_c140702.nc
-lnd/clm2/mappingdata/maps/0.125x0.125/map_3x3min_MODIS-wCsp_to_0.125x0.125_nomask_aave_da_c160427.nc
-lnd/clm2/mappingdata/maps/0.125x0.125/map_3x3min_USGS_to_0.125x0.125_nomask_aave_da_c140702.nc
-lnd/clm2/mappingdata/maps/0.125x0.125/map_5x5min_IGBP-GSDP_to_0.125x0.125_nomask_aave_da_c140702.nc
-lnd/clm2/mappingdata/maps/0.125x0.125/map_5x5min_ISRIC-WISE_to_0.125x0.125_nomask_aave_da_c140702.nc
-lnd/clm2/mappingdata/maps/0.125x0.125/map_5x5min_ORNL-Soil_to_0.125x0.125_nomask_aave_da_c170706.nc
-lnd/clm2/mappingdata/maps/0.125x0.125/map_5x5min_nomask_to_0.125x0.125_nomask_aave_da_c140702.nc
-
-
-
-
-
-
-
-.
-.
-
-
-
-
-
-.false.
-.false.
-.false.
-.false.
-
-.false.
-.false.
-.false.
-.false.
-
-.true.
-.true.
-.true.
-.true.
-
-.true.
-.true.
-.false.
-.false.
-
-
-.false.
-.false.
-.false.
-.false.
-.false.
-.false.
-
-
diff --git a/bld/namelist_files/namelist_defaults_overall.xml b/bld/namelist_files/namelist_defaults_overall.xml
deleted file mode 100644
index 9d8e3da4..00000000
--- a/bld/namelist_files/namelist_defaults_overall.xml
+++ /dev/null
@@ -1,102 +0,0 @@
-
-
-
-
-
-
-
-
-
-startup
-startup
-arb_ic
-arb_ic
-arb_ic
-arb_ic
-cold
-
-
-/fs/cgd/csm/inputdata
-
-
-1.9x2.5
-1x1_brazil
-5x5_amazon
-1x1_camdenNJ
-1x1_vancouverCAN
-1x1_mexicocityMEX
-1x1_asphaltjungleNJ
-1x1_urbanc_alpha
-1x1_numaIA
-1x1_smallvilleIA
-
-
-2000
-
-
-constant
-
-
-1
-0
-
-
-1
-0
-
-
--999.9
-
-
-.false.
-
-
-gx1v6
-gx1v6
-gx1v6
-gx1v6
-gx3v7
-gx3v7
-USGS
-
-cruncep
-USGS
-USGS
-gx3v7
-USGS
-USGS
-
-T62
-
-gx1v6
-gx1v6
-gx1v6
-
-navy
-navy
-navy
-navy
-navy
-navy
-test
-navy
-test
-gx1v6
-
-
-
-.false.
-0
-1
-3
-5
-10
-36
-
-
diff --git a/bld/namelist_files/namelist_definition.xsl b/bld/namelist_files/namelist_definition.xsl
deleted file mode 100644
index 545d810e..00000000
--- a/bld/namelist_files/namelist_definition.xsl
+++ /dev/null
@@ -1,363 +0,0 @@
-
-
-
-
-
-
-
-
-
-
-
-
- CLM Namelist Definition
-
-
-
-
-
-
-
- Definition of CLM namelist variables
- We list all of the relevant namelist variables for CLM I cases. This includes
- CLM Namelist items as well as CLM build-namelist settings and namelist settings
- for CLM offline tools.
-
- Definition of CLM namelist variables
- Note, these all would go into the user_nl_clm file
- before configure):
- Included in the table are the following pieces of information:
-
- Variable name.
- Variable type (char
, integer
,
- real
, or logical
). The type
- char
has the length appended
- following an asterisk, e.g., char*256
. Variables that are
- arrays have their dimension specifier appended inside parentheses. For
- example char*1(6)
denotes a array of six
- char*1
values.
-
- Variable description (includes information on defaults).
- Valid values (if restricted).
-
-
-
- CLM Namelist Physics Options
-
- Name
- Type
- Description
-
-
- Valid values
-
-
-
-
-
- CLM Namelist Lake Model Options
-
- Name
- Type
- Description
-
-
- Valid values
-
-
-
-
-
- CLM Biogeochemistry (BGC) Model Options
-
- Name
- Type
- Description
-
-
- Valid values
-
-
-
-
-
- CLM Biogeochemistry Namelist Nitrogen Model Options
-
- Name
- Type
- Description
-
-
- Valid values
-
-
-
-
-
- CLM Namelist Methane Model Options
-
- Name
- Type
- Description
-
-
- Valid values
-
-
-
-
-
- CLM Namelist Vertical CN Model Options
-
- Name
- Type
- Description
-
-
- Valid values
-
-
-
-
-
- CLM Namelist Carbon Isotope Model Options
-
- Name
- Type
- Description
-
-
- Valid values
-
-
-
-
-
- CLM Namelist Datasets
-
- Name
- Type
- Description
-
-
-
- Valid values
-
-
-
-
-
- CLM Namelist History output settings
-
- Name
- Type
- Description
-
-
- Valid values
-
-
-
-
-
- CLM Namelist Restart settings
-
- Name
- Type
- Description
-
-
- Valid values
-
-
-
-
-
- CLM Namelist Performance Tuning
-
- Name
- Type
- Description
-
-
- Valid values
-
-
-
-
-
-
-
-
-
- Command Line Options to CLM Build-namelist
- Variables that are entered as options to build-namelist (but NOT used by
- namelists in code). Most of these are options that could be added to
- CLM_BLDNML_OPTS. Included in the table are the following pieces
- of information:
-
- Variable name.
- Type.
- Valid values.
- Variable description.
-
-
-
- CLM Namelist Default Settings
-
- Name
- Type
- Description
-
-
- Valid values, if restricted at all
-
-
-
-
-
-
-
-
- Command Line Options to CLM Build-namelist
- Variables that are entered as options to build-namelist (but NOT used by
- namelists in code). Most of these are options that could be added to
- CLM_BLDNML_OPTS. Included in the table are the following pieces
- of information:
-
- Variable name.
- Type.
- Valid values.
- Variable description.
-
-
-
- CLM Namelist Default Settings
-
- Name
- Type
- Description
-
-
- Valid values, if restricted at all
-
-
-
-
-
-
-
-
- Namelist items for CLM Tools
- These are namelist items that appear in the CLM Tools under components/clm/tools.
-
-
- CLM mksurfdata
-
- Name
- Type
- Description
-
-
- Valid values
-
-
-
-
- CLM mkgriddata
-
- Name
- Type
- Description
-
-
- Valid values
-
-
-
-
- CLM mkmapdata
-
- Name
- Type
- Description
-
-
- Valid values
-
-
-
-
- CLM mkgriddata
-
- Name
- Type
- Description
-
-
- Valid values
-
-
-
-
- Miscellaneous CLM tools
-
- Name
- Type
- Description
-
-
- Valid values
-
-
-
-
-
-
-Namelist items for Driver MEGAN Physics
-
- Driver Physics
-
- Name
- Type
- Description
-
-
- Valid values
-
-
-
-
-
-Namelist items for Driver Dry Deposition
-
- Driver Dry-Deposition Namelist Options
-
- Name
- Type
- Description
-
-
- Valid values, if restricted at all
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
- Valid Values:
-
-
-
-
-
diff --git a/bld/namelist_files/namelist_definition_clm4_5.xml b/bld/namelist_files/namelist_definition_clm4_5.xml
deleted file mode 100644
index 0ded4814..00000000
--- a/bld/namelist_files/namelist_definition_clm4_5.xml
+++ /dev/null
@@ -1,1675 +0,0 @@
-
-
-
-
-
-
-
-
-
-
-
-If use_init_interp is set to .true., interpinic will be called to interpolate
-the file given by finidat, creating the output file specified by finidat_interp_dest.
-
-
-
-Full pathname of initial conditions file. If blank CLM will startup from
-arbitrary initial conditions.
-
-
-
-If set to .true., interpinic will be called to interpolate the file given by finidat,
-creating the output file specified by finidat_interp_dest.
-
-This requires that finidat be non-blank.
-
-
-
-Full pathname of master restart file for a branch run. (only used if RUN_TYPE=branch)
-(Set with RUN_REFCASE and RUN_REFDATE)
-
-
-
-Full pathname of land fraction data file.
-
-
-
-Clumps per processor.
-
-
-
-Atmospheric CO2 molar ratio (by volume) only used when co2_type==constant (umol/mol)
-(Set by CCSM_CO2_PPMV)
-
-
-
-Type of CO2 feedback.
- constant = use the input co2_ppmv value
- prognostic = use the prognostic value sent from the atmosphere
- diagnostic = use the diagnostic value sent from the atmosphere
-
-
-
-
-Supplemental Nitrogen mode and for what type of vegetation it's turned on for.
-In this mode Nitrogen is unlimited rather than prognosed and in general vegetation is
-over-productive.
- NONE = No vegetation types get supplemental Nitrogen
- ALL = Supplemental Nitrogen is active for all vegetation types
-
-
-
-If TRUE, separate the vegetated landunit into a crop landunit and a natural vegetation landunit
-
-
-
-If TRUE, make ALL pfts, columns and landunits active, even those with 0 weight.
-This means that computations will be run even over these 0-weight points.
-
-THIS IS ONLY FOR TESTING PURPOSES - IT HAS NOT BEEN CHECKED FOR SCIENTIFIC VALIDITY.
-
-
-
-If TRUE, square the organic fraction when it's used (as was done in CLM4.5)
-Otherwise use the fraction straight up (the default for CLM5.0)
-
-
-
-10SL_3.5m = standard CLM4 and CLM4.5 version
-23SL_3.5m = more vertical layers for permafrost simulations
-49SL_10m = 49 layer soil column, 10m of soil, 5 bedrock layers
-20SL_8.5m = 20 layer soil column, 8m of soil, 5 bedrock layers
-
-
-
-If TRUE, use variable soil depth.
-
-If present on surface dataset, use depth to bedrock information to
-specify spatially variable soil thickness. If not present, use bottom
-of soil column (nlevsoi).
-
-
-
-Index of rooting profile for water
-
-Changes rooting profile from Zeng 2001 double exponential (0) to
-Jackson 1996 single exponential (1) to Koven uniform exponential (2).
-
-
-
-Index of rooting profile for carbon
-
-Changes rooting profile from Zeng 2001 double exponential (0) to
-Jackson 1996 single exponential (1) to Koven uniform exponential (2).
-
-
-
-Index of rooting profile for soil carbon
-
-Changes rooting profile from Zeng 2001 double exponential (0) to
-Jackson 1996 single exponential (1) to Koven uniform exponential (2).
-
-
-
-Variant index of rooting profile for water
-(Currently only used for Jackson 1996 method)
-
-
-
-Variant index of rooting profile for carbon and soil carbon
-(Currently only used for Jackson 1996 method)
-
-
-
-Index of rooting profile for carbon
-
-Changes rooting profile from Zeng 2001 double exponential (0) to
-Jackson 1996 single exponential (1) to Koven uniform exponential (2).
-
-
-
-Index of evaporative resistance method.
-
-Changes soil evaporative resistance method from Sakaguchi and Zeng
-2009 Beta function (0) to Swenson and Lawrence 2014 dry surface layer
-formulation (1).
-
-
-
-Slope of free living Nitrogen fixation with annual ET
-
-
-
-Intercept of free living Nitrogen fixation with zero annual ET
-
-
-
-Fraction of intercepted precipitation
-
-
-
-If TRUE use clm5 equation for fraction of intercepted precipitation
-
-
-
-Maximum fraction of leaf that may be wet prior to drip occuring
-
-
-
-Index of solution method of Richards equation.
-
-Change method for richards equation solution and boundary
-conditions.
-
-CLM 4.5 - soilwater_movement_method = 0 (Zeng and Decker, 2009, method).
-CLM 5.0 - soilwater_movement_method = 1 (adaptive time stepping moisture form from Martyn Clark).
-
-1 (adaptive time stepping moisture form
-
-
-
-Index of upper boundary condition for Richards equation.
-
-
-
-Index of lower boundary condition for Richards equation.
-
-lower_boundary_condition = 1 : flux lower boundary condition (use with soilwater_movement_method=adaptive time stepping)
-lower_boundary_condition = 2 : zero-flux lower boundary condition (use with soilwater_movement_method=adaptive time stepping)
-lower_boundary_condition = 3 : water table head-based lower boundary condition w/ aquifer layer. (use with soilwater_movement_method=adaptive time stepping)
-lower_boundary_condition = 4 : 11-layer solution w/ aquifer layer (only used with soilwater_movement_method=Zeng&Decker 2009)
-
-TODO(bja, 2015-09) these should be strings so they have meaningful names instead of ints.
-
-
-
-minimum time step length (seconds) for adaptive time stepping in richards equation
-
-
-a very small number: used to check for sub step completion for adaptive time stepping in richards equation
-
-
-tolerance to halve length of substep for adaptive time stepping in richards equation
-
-
-tolerance to double length of substep for adaptive time stepping in richards equation
-
-
-
-
-
-
-
-
-
-
-
-
-Minimum leaf area index for irrigation to occur
-
-
-
-Time of day to check whether we need irrigation, seconds (0 = midnight).
-We start applying the irrigation in the time step FOLLOWING this time.
-
-
-
-Desired amount of time to irrigate per day (sec).
-Actual time may differ if this is not a multiple of dtime.
-
-
-
-Target soil matric potential for irrigation (mm).
-When we irrigate, we aim to bring the total soil moisture in the top (irrig_depth) m of soil up to this level.
-
-
-
-Soil depth to which we measure for irrigation (m)
-
-
-
-Determines soil moisture threshold at which we irrigate.
-If h2osoi_liq_wilting_point is the soil moisture level at wilting point and
-h2osoi_liq_target is the soil moisture level at the target irrigation level
-(given by irrig_target_smp), then the threshold at which we irrigate is
- h2osoi_liq_wilting_point +
- irrig_threshold_fraction*(h2osoi_liq_target - h2osoi_liq_wilting_point)
-A value of 1 means that we irrigate whenever soil moisture falls below the target.
-A value of 0 means that we only irrigate when soil moisture falls below the wilting point.
-
-
-
-Threshold for river water volume below which irrigation is shut off (as a fraction of available river water), if limit_irrigation_if_rof_enabled is .true.
-A threshold of 0 means allow all river water to be used;
-a threshold of 0.1 means allow 90% of the river volume to be used; etc.
-
-
-
-If TRUE, limit irrigation when river storage drops below a threshold.
-Only applies if using an active runoff (ROF) model; otherwise, river storage-based limitation
-is turned off regardless of the setting of this namelist variable.
-
-
-
-If TRUE, irrigation will be active.
-
-
-
-Number of multiple elevation classes over glacier points.
-
-
-
-Behavior of each glacier region (GLACIER_REGION in surface dataset).
-First item corresponds to GLACIER_REGION with ID 0 in the surface dataset,
-second to GLACIER_REGION with ID 1, etc.
-Allowed values are:
-'multiple': grid cells can potentially have multiple glacier elevation classes,
- but no virtual columns
-'virtual': grid cells have virtual columns: values are computed for every glacier
- elevation class, even those with 0 area (in order to provide surface mass
- balance for every glacier elevation class).
-'single_at_atm_topo': glacier landunits in these grid cells have a single column,
- whose elevation matches the atmosphere's topographic height (so that there is no
- adjustment due to downscaling)
-Behavior of 'virtual' is required in the region where we have an ice sheet model
-
-
-
-Treatment of ice melt for each glacier region (GLACIER_REGION in surface dataset).
-First item corresponds to GLACIER_REGION with ID 0 in the surface dataset,
-second to GLACIER_REGION with ID 1, etc.
-Allowed values are:
-'replaced_by_ice': any melted ice runs off and is immediately replaced by solid ice;
- this results in positive liquid runoff and negative ice runoff
-'remains_in_place': any melted ice remains in place as liquid until it refreezes;
- thus, ice melt does not result in any runoff
-IMPORTANT NOTE: Regions with the 'remains_in_place' behavior also do not
-compute SMB (because negative SMB would be pretty much meaningless in
-those regions). Thus, you cannot use this behavior where GLC is
-operating.
-Regions with the 'replaced_by_ice' behavior also compute SMB for the
-vegetated column.
-
-
-
-Treatment of ice runoff for each glacier region (GLACIER_REGION in surface dataset).
-First item corresponds to GLACIER_REGION with ID 0 in the surface dataset,
-second to GLACIER_REGION with ID 1, etc.
-Allowed values are:
-'remains_ice': ice runoff is sent to the river model as ice; this is a crude parameterization
- of iceberg calving, and so is appropriate in regions where there is substantial iceberg calving
- in reality
-'melted': ice runoff generated by the CLM physics (primarily due to snow capping) is melted
- (generating a negative sensible heat flux) and runs off as liquid; this is appropriate in
- regions that have little iceberg calving in reality. This can be important to avoid unrealistic
- cooling of the ocean and consequent runaway sea ice growth.
-Only applies when melt_non_icesheet_ice_runoff is .true.
-
-
-
-Number of days before one considers the perennially snow-covered point 'land ice'
-(and thus capable of generating a positive surface mass balance for the glacier model).
-This is meant to compensate for the fact that, with small values of h2osno_max,
-the onset of a snow-capped state (and thus conversion to land ice) can occur in an
-unrealistically short amount of time.
-Thus, in general, large values of h2osno_max should have glc_snow_persistence_max_days = 0;
-small values of h2osno_max should have glc_snow_persistence_max_days > 0.
-
-
-
-Visible and Near-infrared albedo's for glacier ice
-
-
-
-Scalar of leaf respiration to vcmax
-
-
-
-baseline proportion of nitrogen allocated for electron transport (J)
-
-
-
-Time step (seconds)
-
-
-
-Override the start type from the driver: it can only be
-set to 3 meaning branch.
-
-
-
-Toggle to turn on the FATES model
-(use_fates= '.true.' is EXPERIMENTAL NOT SUPPORTED!)
-
-
-
-Toggle to turn on the LUNA model, to effect Photosynthesis by leaf Nitrogen
-LUNA operates on C3 and non-crop vegetation (see vcmax_opt for how other veg is handled)
-LUNA: Leaf Utilization of Nitrogen for Assimilation
-
-
-
-Toggle to turn on the plant hydraulic stress model
-
-
-
-How LUNA and Photosynthesis (if needed) will get Leaf nitrogen content
- lnc_opt = true get from leaf N from CN model
- lnc_opt = false get based on LAI and fixed CN ratio from parameter file
-
-
-
-Full pathname datafile with plant function type (PFT) constants combined with
-constants for biogeochem modules
-
-
-
-Full pathname datafile with fates parameters
-
-
-
-Full pathname of surface data file.
-
-
-
-Full pathname of MML surface data forcing file.
-
-
-
-Per file averaging flag.
- 'A' (average over history period)
- 'I' (instantaneous)
- 'X' (maximum over history period)
- 'M' (minimum over history period)
-
-
-
-Averaging type of output for 1D vector output (when hist_dov2xy is false).
- GRID means average all land-units up to the grid-point level
- LAND means average all columns up to the land-unit level
- COLS means average all PFT's up to the column level
- PFTS means report everything on native PFT level
-
-
-
-If TRUE, implies output data on a 2D latitude/longitude grid. False means
-output in 1D vector format. One setting per history tape series.
-
-
-
-If TRUE, indicates do NOT output any default history fields (requires you to use
-hist_fincl* to set the exact output fields to use)..
-
-
-
-Fields to exclude from history tape series 1.
-
-
-
-Fields to exclude from history tape series 2.
-
-
-
-Fields to exclude from history tape series 3.
-
-
-
-Fields to exclude from history tape series 4.
-
-
-
-Fields to exclude from history tape series 5.
-
-
-
-Fields to exclude from history tape series 6.
-
-
-
-Fields to add to history tape series 1.
-
-
-
-Fields to add to history tape series 2.
-
-
-
-Fields to add to history tape series 3.
-
-
-
-Fields to add to history tape series 4.
-
-
-
-Fields to add to history tape series 5.
-
-
-
-Fields to add to history tape series 6.
-
-
-
-Per tape series maximum number of time samples.
-
-
-
-Per tape series history file density (i.e. output precision)
- 1=double precision
- 2=single precision
-Default: 2,2,2,2,2,2
-
-
-
-Per tape series history write frequency.
- positive means in time steps
- 0=monthly
- negative means hours
-(i.e. 5 means every 24 time-steps and -24 means every day
-Default: 0,-24,-24,-24,-24,-24
-
-
-
-number of segments per clump for decomposition
-Default: 20
-
-
-
-Perturbation limit when doing error growth test
-
-
-
-If FALSE, don't write any restart files.
-
-
-
-Turn urban air conditioning/heating ON or OFF and add wasteheat:
- OFF = Air conditioning/heating is OFF in buildings, internal temperature allowed to float freely
- ON = Air conditioning/heating is ON in buildings, internal temperature constrained
- ON_WASTEHEAT = Air conditioning/heating is ON and waste-heat sent to urban canyon
-
-
-
-If TRUE, urban traffic flux will be activated (Currently NOT implemented).
-
-
-
-0 = simpler method (clm4_5)
-1 = prognostic calculation of interior building temp (clm5_0)
-
-
-
-If TRUE, write diagnostic of global radiative temperature written to CLM log file.
-
-
-
-Subgrid fluxes for snow
-
-
-
-Turn vegetation snow canopy ON, OFF, or ON with albedo influence (ON_RAD)
-
-
-
-
-
-
-Turn on methane model. Standard part of CLM45BGC model.
-
-
-
-CLM Biogeochemistry mode : Carbon Nitrogen model (CN)
-(or CLM45BGC if phys=clm4_5, vsoilc_centbgc='on', and clm4me='on')
-
-
-
-Turn the Fixation and Uptate of Nitrogen model version 2 (FUN2.0)
-Requires the CN model to work (either CN or CNDV).
-
-
-
-Nitrification/denitrification splits the prognostic mineral N pool into two
- mineral N pools: NO3 and NH4, and includes the transformations between them.
-Requires the CN model to work (either CN or CNDV).
-
-
-
-Turn on vertical soil carbon.
-Requires the CN or FATES model to work (either CN or CNDV).
-
-
-
-Use parameters for decomposition from the CENTURY Carbon model
-Requires the CN or FATES model to work (either CN or CNDV).
-
-
-
-Toggle to turn on the prognostic crop model
-
-
-
-Initial seed Carbon to use at planting
-(only used when CN is on as well as crop)
-
-
-
-Toggle to turn all history output completely OFF (possibly used for testing)
-
-
-
-Max number of plant functional types in naturally vegetated landunit.
-
-
-
-Toggle to turn on the dynamic root model
-
-
-
-
-
-
-SCRIP format grid data file
-
-
-
-Flag to pass to the ESMF mapping utility, telling it what kind of large
-file support is needed for an output file generated with this grid as
-either the source or destination ('none', '64bit_offset' or 'netcdf4').
-
-
-
-Flag to pass to the ESMF mapping utility, telling it what kind of grid
-file this is (SCRIP or UGRID).
-
-
-
-For UGRID files, flag to pass to the ESMF mapping utility, telling it the
-name of the dummy variable that has all of the topology information stored
-in its attributes. (Only used if scripgriddata_src_type = UGRID.)
-
-
-
-
-
-
-Filename for mksurfdata_map to remap raw data into the output surface dataset
-
-
-
-Plant Function Type dataset for mksurfdata
-
-
-
-Harvest dataset for mksurfdata
-
-
-
-Dataset for percent glacier land-unit for mksurfdata
-
-
-
-Dataset for glacier region ID for mksurfdata
-
-
-
-Dataset for topography used to define urban threshold
-
-
-
-Leaf Area Index dataset for mksurfdata
-
-
-
-Soil texture dataset for mksurfdata
-
-
-
-Soil color dataset for mksurfdata
-
-
-
-Soil max fraction dataset for mksurfdata
-
-
-
-High resolution land mask/fraction dataset for mksurfdata
-(used for glacier_mec land-units)
-
-
-
-Type of grid to create for mksurfdata
-
-
-
-Grid file at the output resolution for mksurfdata
-
-
-
-Text file with filepaths (or list of XML elements) for vegetation fractions
-and harvesting for each year to run over for mksurfdata to be able to model
-transient land-use change
-
-
-
-High resolution topography dataset for mksurfdata
-(used for glacier_mec land-units)
-
-
-
-Irrigation dataset for mksurfdata
-
-
-
-Organic soil dataset for mksurfdata
-
-
-
-Lake water dataset for mksurfdata
-
-
-
-Wetland dataset for mksurfdata
-
-
-
-Urban dataset for mksurfdata
-
-
-
-Biogenic Volatile Organic Compounds (VOC) emissions dataset for mksurfdata
-
-
-
-GDP dataset for mksurfdata
-
-
-
-Peat dataset for mksurfdata
-
-
-
-Soil depth dataset for mksurfdata
-
-
-
-Agricultural burning dominant month dataset for mksurfdata
-
-
-
-Topography statistics dataset for mksurfdata
-
-
-
-VIC parameters dataset for mksurfdata
-
-
-
-Inversion-derived CH4 parameters dataset for mksurfdata
-
-
-
-If TRUE, output variables in double precision for mksurfdata
-
-
-
-If TRUE, ignore other files, and set the output percentage to 100% urban and
-zero for other land-use types.
-
-
-
-If TRUE, set wetland to 0% over land (renormalizing other landcover types as needed);
-wetland will only be used for ocean points.
-
-
-
-Number of Plant Functional Types (excluding bare-soil)
-
-
-
-Plant Function Type index to override global file with for mksurfdata
-
-
-
-Plant Function Type fraction to override global file with for mksurfdata
-
-
-
-Soil color index to override global file with for mksurfdata
-
-
-
-Soil maximum fraction to override global file with for mksurfdata
-
-
-
-Soil percent sand to override global file with for mksurfdata
-
-
-
-Soil percent clay to override global file with for mksurfdata
-
-
-
-
-
-
-
-Orography file with surface heights and land area fraction
-
-
-
-CLM grid file
-
-
-
-CESM domain file
-
-
-
-CAM file
-
-
-
-Raw topography file
-
-
-
-CAM topography file
-
-
-
-Number of longitudes to use for a regional grid (for single-point set to 1)
-
-
-
-Number of latitudes to use for a regional grid (for single-point set to 1)
-
-
-
-Northern edge of the regional grid
-
-
-
-Southern edge of the regional grid
-
-
-
-Eastern edge of the regional grid
-
-
-
-Western edge of the regional grid
-
-
-
-
-
-
-
-Historical greenhouse gas concentrations from CAM, only used
-by getco2_historical.ncl
-
-
-
-
-
-
-Aerosol deposition file name (only used for aerdepregrid.ncl)
-
-
-
-Full pathname of CLM fraction dataset (only used for mkdatadomain).
-
-
-
-Full pathname of CLM grid dataset (only used for mkdatadomain).
-
-
-
-Full pathname of output domain dataset (only used for mkdatadomain).
-
-
-
-Type of domain file to create (ocean or atmosphere) (only used for mkdatadomain)
-
-
-
-
-
-
-
-If TRUE, repartition rain/snow from atmosphere based on temperature.
-
-
-
-If TRUE, downscale longwave radiation over glc_mec landunits.
-This downscaling is conservative.
-Default: .true.
-
-
-
-Surface temperature lapse rate (K m-1)
-A positive value means a decrease in temperature with increasing height
-
-
-
-Longwave radiation lapse rate (W m-2 m-1)
-A positive value means a decrease in LW radiation with increasing height
-Only relevant if glcmec_downscale_longwave is .true.
-
-
-
-Relative limit for how much longwave downscaling can be done (unitless)
-The pre-normalized, downscaled longwave is restricted to be in the range
-[lwrad*(1-longwave_downscaling_limit), lwrad*(1+longwave_downscaling_limit)]
-This parameter must be in the range [0,1]
-Only relevant if glcmec_downscale_longwave is .true.
-
-
-
-Temperature below which all precipitation falls as snow, for glacier columns (deg C)
-Only relevant if repartition_rain_snow is .true.
-
-
-
-Temperature above which all precipitation falls as rain, for glacier columns (deg C)
-Only relevant if repartition_rain_snow is .true.
-
-
-
-Temperature below which all precipitation falls as snow, for non-glacier columns (deg C)
-Only relevant if repartition_rain_snow is .true.
-
-
-
-Temperature above which all precipitation falls as rain, for non-glacier columns (deg C)
-Only relevant if repartition_rain_snow is .true.
-
-
-
-
-
-
-
-If TRUE, ice runoff generated from non-glacier columns and glacier columns outside icesheet regions
-is converted to liquid, with an appropriate sensible heat flux.
-That is, the atmosphere (rather than the ocean) melts the ice.
-(Exception: ice runoff generated to ensure conservation with dynamic landunits remains as ice.)
-
-
-
-
-
-
-
-
-Toggle to turn on use of LAI streams in place of the LAI on the surface dataset when using Satellite Phenology mode.
-(EXPERIMENTAL and NOT tested)
-
-
-
-First year to loop over for LAI data
-
-
-
-Last year to loop over for LAI data
-
-
-
-Simulation year that aligns with stream_year_first_lai value
-
-
-
-Filename of input stream data for LAI
-
-
-
-Mapping method from LAI input file to the model resolution
- bilinear = bilinear interpolation
- nn = nearest neighbor
- nnoni = nearest neighbor on the "i" (longitude) axis
- nnonj = nearest neighbor on the "j" (latitude) axis
- spval = set to special value
- copy = copy using the same indices
-
-
-
-datm input directory
-
-
-datm output directory
-
-
-Datm logfile name
-
-
-
-
-
-
-
-Mapping file to go from one resolution/land-mask to another resolution/land-mask
-
-
-
-Land mask description for mksurfdata input files
-
-
-
-Horizontal grid resolutions for mksurfdata input files
-
-
-
-
-
-
-
-
-Resolution of finundated inversion streams dataset (stream_fldfilename_ch4finundated)
-to use for methane model
-(only applies when CN and methane model are turned on)
-
-
-
-Resolution of Lightning dataset to use for CN fire model
-(only applies when CN and the CN fire model are turned on)
-
-
-
-Check that the resolution and land-mask is valid before continuing.
-
-
-
-Add a note to the output namelist about the options given to build-namelist
-
-
-
-CLM run type.
- 'default' use the default type of clm_start type for this configuration
- 'cold' is a run from arbitrary initial conditions
- 'arb_ic' is a run using initial conditions if provided, OR arbitrary initial conditions if no files can be found
- 'startup' is an initial run with initial conditions provided.
- 'continue' is a restart run.
- 'branch' is a restart run in which properties of the output history files may be changed.
-
-
-
-Horizontal resolutions
-Note: 0.1x0.1, 0.25x0.25, 0.5x0.5, 5x5min, 10x10min, 3x3min and 0.33x0.33 are only used for CLM tools
-
-
-
-Representative concentration pathway for future scenarios [radiative forcing at peak or 2100 in W/m^2]
--999.9 means do NOT use a future scenario, just use historical data.
-
-
-
-Land mask description
-
-
-
-General configuration of model version and atmospheric forcing to tune the model to run under.
-This sets the model to run with constants and initial conditions that were set to run well under
-the configuration of model version and atmospheric forcing. To run well constants would need to be changed
-to run with a different type of atmospheric forcing.
-
-
-
-If 1, turn on the MEGAN model for BVOC's (Biogenic Volitile Organic Compounds)
-
-
-
-Year to simulate and to provide datasets for (such as surface datasets, initial conditions, aerosol-deposition, Nitrogen deposition rates etc.)
-A sim_year of 1000 corresponds to data used for testing only, NOT corresponding to any real datasets.
-A sim_year greater than 2005 corresponds to rcp scenario data
-Most years are only used for clm_tools and there aren't CLM datasets that correspond to them.
-CLM datasets exist for years: 1000 (for testing), 1850, and 2000
-
-
-
-Range of years to simulate transitory datasets for (such as dynamic: land-use datasets, aerosol-deposition, Nitrogen deposition rates etc.)
-Constant means simulation will be held at a constant year given in sim_year.
-A sim_year_range of 1000-1002 or 1000-1004 corresponds to data used for testing only, NOT corresponding to any real datasets.
-A sim_year_range that goes beyond 2005 corresponds to historical data until 2005 and then scenario data beyond that point.
-
-
-
-Namelist entries to demand be provided on the namelist.
-
-
-
-Description of the use case selected.
-
-
-
-Attributes to use when looking for an initial condition file (finidat) if interpolation is turned on (use_init_interp is .true.)
-
-
-
-How close in years to use when looking for an initial condition file (finidat) if interpolation is turned on (use_init_interp is .true.)
-
-
-
-Simulation years you can look for in initial condition files (finidat) if interpolation is turned on (use_init_interp is .true.)
-
-
-
-Command line argument for setting up your simulation in a mode for faster
-throughput. By default turns off some options, and sets up for a lower level
-of output. When bgc_mode is some level of prognostic BGC (so NOT Satellite Phenology)
-it also sets up for accelerated decomposition.
-NOTE: THIS CORRESPONDS DIRECTLY TO THE env_run.xml VARIABLE OF THE SAME NAME.
- Set the env_run variable, rather than setting this directly.
-
-
-
-Command line arguement for biogeochemistry mode for CLM4.5
- sp = Satellitte Phenology
- cn = Carbon Nitrogen model
- bgc = CLM4.5 BGC model with:
- CENTURY model pools
- Nitrification/De-nitrification
- Methane model
- Vertically resolved Carbon
- fates = FATES/ED ecosystem demography model with below ground BGC:
-
-
-
-
-
-
-
-Flag for setting the state of the Accelerated decomposition spinup state for the BGC model.
- 0 = normal model behavior;
- 1 = AD spinup (standard)
- 2 = AD spinup (accelerated spinup from Ricciuto, doesn't work for CNDV and not implemented for CN soil decomposition)
-Entering and exiting spinup mode occurs automatically by comparing the namelist and restart file values for this variable.
-NOTE: THIS CAN ONLY BE SET TO NON-ZERO WHEN BGC_MODE IS NOT SATELITE PHENOLOGY!
-
-
-
-
-E-folding depth over which decomposition is slowed with depth in all soils.
-
-
-
-separate q10 for frozen soil respiration rates. default to same as above zero rates
-
-
-
-
-
-
-Flag to reseed any dead plants on startup from reading the initial conditions file
-
-
-
-Flag to use the atmospheric time series of C14 concentrations from bomb fallout and Seuss effect, rather than natural abundance C14 (nominally set as 10^-12 mol C14 / mol C)
-(EXPERIMENTAL and NOT tested)
-
-
-
-Filename with time series of atmospheric Delta C14 data. variables in file are "time" and "Delta14co2_in_air". time variable is in format: years since 1850-01-01 0:0:0.0 units are permil.
-(EXPERIMENTAL and NOT tested)
-
-
-
-Flag to use the atmospheric time series of C13 concentrations from natural abundance and the Seuss Effect, rather than static values.
-(EXPERIMENTAL and NOT tested)
-
-
-
-Filename with time series of atmospheric Delta C13 data, which use CMIP6 format. variables in file are "time" and "delta13co2_in_air". time variable is in format: years since 1850-01-01 0:0:0.0. units are permil.
-(EXPERIMENTAL and NOT tested)
-
-
-
-
-
-
-
-If TRUE use additional stress deciduous onset trigger
-
-
-
-Apply the guardrail for leaf-Nitrogen that ensures it doesn't go negative or too small
-
-
-
-
-
-
-
-Allow the CN ratio to flexibly change with the simulation, rather than being fixed
-
-
-
- Michaelis Menten nitrogen uptake kinetics
-
-
-
-How much Carbon to initialize vegetation pools (leafc/frootc and storage) to when -- Michaelis Menten nitrogen uptake kinetics is on
-
-
-
- GPP downregulation for use_flexibleCN option
-(EXPERIMENTAL and NOT tested)
-
-
-
- Plant nitrogen demand for use_flexibleCN option
-(EXPERIMENTAL and NOT tested)
-
-
-
- Michaelis Menten substrate limitation for use_flexibleCN option
-(EXPERIMENTAL and NOT tested)
-
-
-
- Michaelis Menten nitrogen limitation for use_flexibleCN option
-(EXPERIMENTAL and NOT tested)
-
-
-
- Michaelis Menten temperature limitation for use_flexibleCN option
-(EXPERIMENTAL and NOT tested)
-
-
-
- Flexible CN ratio used for Phenology
-(EXPERIMENTAL and NOT tested)
-
-
-
- Reduce day length factor
-(NOT implemented)
-
-
-
-Vcmax calculation for Photosynthesis
- vcmax_opt = 4 As for vcmax_opt=0, but using leafN, and exponential if tree (EXPERIMENTAL NOT TESTED!)
- vcmax_opt = 3 Based on leafN and VCAD (used with Luna for crop and C4 vegetation)
- vcmax_opt = 0 Based on canopy top and foilage Nitrogen limitation factor from params file (clm4.5)
-(EXPERIMENTAL and NOT tested)
-
-
-
-Residual option for flexible-CN
-(EXPERIMENTAL and NOT tested)
-
-
-
-Partition option for flexible-CN
- CN_partition_opt = 1
-(EXPERIMENTAL and NOT tested)
-
-
-
-Evergreen phenology option for CNPhenology
-(EXPERIMENTAL and NOT tested)
-
-
-
-Carbon respiration option to burn off carbon when CN ratio is too high (do NOT use when FUN is on)
-(EXPERIMENTAL and NOT tested)
-
-
-
-
-
-
-
-Use old snow cover fraction from Niu et al. 2007
-(deprecated -- will be removed)
-
-
-
-If surface water is active or not
-(deprecated -- will be removed)
-
-
-
-Use original CLM4 soil hydraulic properties
-(deprecated -- will be removed)
-
-
-
-
-
-
-
-If TRUE (which is the default), check consistency between year on the finidat file
-and the current model year. This check is only done for a transient run.
-
-
-
-If TRUE (which is the default), check consistency between pct_pft on the finidat file
-and pct_pft read from the surface dataset. This check is only done for a NON-transient run.
-
-
-
-
-
-
-
-If TRUE (which is the default), check consistency between pct_nat_pft on the flanduse_timeseries file
-and pct_nat_pft read from the surface dataset.
-
-
-
-
-
-
-
-Number of snow layers.
-Values less than 5 are mainly useful for testing, and should not be used for science.
-
-
-
-Maximum snow depth in mm H2O equivalent. Additional mass gains will be capped when this depth
-is exceeded.
-Changes in this value should possibly be accompanied by changes in:
-- nlevsno: larger values of h2osno_max should be accompanied by increases in nlevsno
-- glc_snow_persistence_max_days: large values of h2osno_max should generally have
- glc_snow_persistence_max_days = 0; small values of h2osno_max should generally have
- glc_snow_persistence_max_days > 0.
-
-
-
-Limit applied to integrated snowfall when determining changes in snow-covered fraction during melt
-(mm H2O)
-
-
-
-SCA shape parameter for glc_mec (glacier multiple elevation class) columns
-For most columns, n_melt is based on the standard deviation of 1km topography in the grid cell;
-but glc_mec columns already account for subgrid topographic variability through their use of
-multiple elevation classes; thus, to avoid double-accounting for topographic variability
-in these columns, we use a fixed value of n_melt.
-
-
-
-If TRUE, the density of new snow depends on wind speed, and there is also
-wind-dependent snow compaction.
-
-
-
-Method used to compute snow overburden compaction
-Anderson1976 -- older method, default in CLM45
-Vionnet2012 --- newer method, default in CLM50
-
-
-
-Snow density method to use for low temperatures (below -15C)
-TruncatedAnderson1976 -- Truncate the Anderson-1976 equation at the value for -15C
-Slater2017 ------------- Use equation from Slater that increases snow density for very cold temperatures (Arctic, Antarctic)
-
-
-
-Upper Limit on Destructive Metamorphism Compaction [kg/m3]
-
-
-
-Snow compaction overburden exponential factor (1/K)
-Not used for snow_overburden_compaction_method=Vionnet2012
-
-
-
-Minimum wind speed tht results in compaction (m/s)
-
-
-
-maximum warm (at freezing) fresh snow effective radius [microns]
-
-
-
-If set to .true., then reset the snow pack over non-glacier columns to a small value.
-This is useful when transitioning from a spinup under one set of atmospheric forcings
-to a run under a different set of atmospheric forcings: By resetting too-large snow packs,
-we make it more likely that points will remain only seasonally snow-covered under the new
-atmospheric forcings. (This is particularly true in a coupled run, where starting with a
-too-large snow pack can cool the atmosphere, thus maintaining the too-large snow pack.)
-
-WARNING: Setting this to .true. will break water conservation for approximately the first
-day of the new run. This is by design: The excess snow is completely removed from the system.
-
-
-
-If set to .true., then reset the snow pack over glacier columns to a small value.
-This is useful when transitioning from a spinup under one set of atmospheric forcings
-to a run under a different set of atmospheric forcings: By resetting too-large snow packs,
-we make it more likely that points will remain only seasonally snow-covered under the new
-atmospheric forcings. (This is particularly true in a coupled run, where starting with a
-too-large snow pack can cool the atmosphere, thus maintaining the too-large snow pack.)
-
-See also reset_snow_glc_ela, which controls the elevation below which
-glacier columns are reset.
-
-WARNING: Setting this to .true. will break water conservation for approximately the first
-day of the new run. This is by design: The excess snow is completely removed from the system.
-
-WARNING: This variable is intended for short test runs, and generally
-should not be used for scientific production runs. By resetting snow
-below a given elevation, you risk forcing the system to evolve
-differently in areas below and above reset_snow_glc_ela.
-
-
-
-Only relevant if reset_snow_glc is .true.
-
-When resetting snow pack over glacier columns, one can choose to do this over all glacier
-columns, or only those below a certain elevation. A typical use case is to reset only those
-columns that have a seasonal snow pack in the real world, i.e. SMB less than 0, also known as
-the equilibrium line altitude (ELA). This parameter sets a single global ELA value. By
-setting this parameter to a large value (i.e. 10000 m), all glacier columns will be reset.
-
-WARNING: This variable is intended for short test runs, and generally
-should not be used for scientific production runs. By resetting snow
-below a given elevation, you risk forcing the system to evolve
-differently in areas below and above reset_snow_glc_ela.
-
-
-
-
-
-
-
-
-If FALSE (which is the default): If an output type cannot be found in the input for initInterp,
-code aborts
-If TRUE: If an output type cannot be found in the input, fill with closest natural veg column
-(using bare soil for patch-level variables)
-
-NOTE: Natural vegetation and crop landunits always behave as if this were true. e.g., if
-we can't find a column with the same type as a given crop column in the output, then we
-always fill with the closest natural veg patch / column, regardless of the value of this
-flag. So interpolation from non-crop to crop cases can be done without setting this flag.
-
-
-
diff --git a/bld/namelist_files/namelist_definition_drv.xml b/bld/namelist_files/namelist_definition_drv.xml
deleted file mode 100644
index 493f2f2a..00000000
--- a/bld/namelist_files/namelist_definition_drv.xml
+++ /dev/null
@@ -1,17 +0,0 @@
-
-
-
-
- 1.0
-
-
-
-
-
-
-
-
-
diff --git a/bld/namelist_files/use_cases/1850_control.xml b/bld/namelist_files/use_cases/1850_control.xml
deleted file mode 100644
index 786b9ae9..00000000
--- a/bld/namelist_files/use_cases/1850_control.xml
+++ /dev/null
@@ -1,11 +0,0 @@
-
-
-
-
-Conditions to simulate 1850 land-use
-
-1850
-
-constant
-
-
diff --git a/bld/namelist_files/use_cases/2000_control.xml b/bld/namelist_files/use_cases/2000_control.xml
deleted file mode 100644
index c339f2d0..00000000
--- a/bld/namelist_files/use_cases/2000_control.xml
+++ /dev/null
@@ -1,11 +0,0 @@
-
-
-
-
-Conditions to simulate 2000 land-use
-
-2000
-
-constant
-
-
diff --git a/cime_config/buildlib b/cime_config/buildlib
index 43016826..598f5dc8 100755
--- a/cime_config/buildlib
+++ b/cime_config/buildlib
@@ -1,7 +1,7 @@
-#!/usr/bin/env python
+#!/usr/bin/env python3
"""
-build clm library
+build slim ibrary
"""
import sys, os, time, filecmp, shutil, imp
@@ -21,7 +21,7 @@ logger = logging.getLogger(__name__)
###############################################################################
def _main_func():
-###############################################################################
+ ###############################################################################
caseroot, libroot, bldroot = parse_input(sys.argv)
@@ -34,54 +34,56 @@ def _main_func():
mach = case.get_value("MACH")
nthrds = case.get_value("LND_NTHRDS")
- clm_config_opts = case.get_value("CLM_CONFIG_OPTS")
- if "clm4_5" in clm_config_opts:
- clm_phys = "clm4_5"
- elif "clm5_0" in clm_config_opts:
- clm_phys = "clm5_0"
- else:
- expect(False, "CLM_CONFIG_OPTS must support either clm4_5 or clm5_0 physics")
-
- if ( nthrds > 1 ):
- expect(False, "LND_NTHRDS must be 1 as threading isn't implemented (see issue #14)" )
-
- #-------------------------------------------------------
- # create Filepath file for clm4_5 or clm5_0
- #-------------------------------------------------------
- filepath_file = os.path.join(bldroot,"Filepath")
+ if nthrds > 1:
+ expect(
+ False,
+ "LND_NTHRDS must be 1 as threading isn't implemented (see issue #14)",
+ )
+
+ # -------------------------------------------------------
+ # create Filepath file
+ # -------------------------------------------------------
+ filepath_file = os.path.join(bldroot, "Filepath")
if not os.path.isfile(filepath_file):
caseroot = case.get_value("CASEROOT")
- paths = [os.path.join(caseroot,"SourceMods","src.clm"),
- os.path.join(lnd_root,"src","main"),
- os.path.join(lnd_root,"src","biogeophys"),
- os.path.join(lnd_root,"src","biogeochem"),
- os.path.join(lnd_root,"src","soilbiogeochem"),
- os.path.join(lnd_root,"src","init_interp"),
- os.path.join(lnd_root,"src","utils"),
- os.path.join(lnd_root,"src","cpl")]
+ paths = [
+ os.path.join(caseroot, "SourceMods", "src.slim"),
+ os.path.join(lnd_root, "src", "main"),
+ os.path.join(lnd_root, "src", "init_interp"),
+ os.path.join(lnd_root, "src", "utils"),
+ os.path.join(lnd_root, "src", "cpl"),
+ ]
+ # Paths needed to build the current system, but won't be long term
+ paths.append(os.path.join(lnd_root, "src", "biogeophys"))
+ paths.append(os.path.join(lnd_root, "src", "biogeochem"))
+ paths.append(os.path.join(lnd_root, "src", "soilbiogeochem"))
with open(filepath_file, "w") as filepath:
filepath.write("\n".join(paths))
filepath.write("\n")
-
- #-------------------------------------------------------
+
+ # -------------------------------------------------------
# create the library in libroot
- #-------------------------------------------------------
+ # -------------------------------------------------------
- clm_config_opts = case.get_value("CLM_CONFIG_OPTS")
- complib = os.path.join(libroot,"libclm.a")
+ complib = os.path.join(libroot, "liblnd.a")
makefile = os.path.join(casetools, "Makefile")
- macfile = os.path.join(caseroot, "Macros.%s" % mach)
+ macfile = os.path.join(caseroot, "Macros.%s" % mach)
- cmd = "%s complib -j %d MODEL=clm COMPLIB=%s -f %s MACFILE=%s " \
- % (gmake, gmake_j, complib, makefile, macfile )
+ cmd = "%s complib -j %d MODEL=slim COMPLIB=%s -f %s MACFILE=%s " % (
+ gmake,
+ gmake_j,
+ complib,
+ makefile,
+ macfile,
+ )
rc, out, err = run_cmd(cmd)
- logger.info("%s: \n\n output:\n %s \n\n err:\n\n%s\n"%(cmd,out,err))
+ logger.info("%s: \n\n output:\n %s \n\n err:\n\n%s\n" % (cmd, out, err))
expect(rc == 0, "Command %s failed with rc=%s" % (cmd, rc))
+
###############################################################################
if __name__ == "__main__":
_main_func()
-
diff --git a/cime_config/buildnml b/cime_config/buildnml
index 77477cbd..9c2a0c3f 100755
--- a/cime_config/buildnml
+++ b/cime_config/buildnml
@@ -1,239 +1,33 @@
-#!/usr/bin/env python
+#!/usr/bin/env python3
"""
-CLM namelist creator
+SLIM namelist creator executable
"""
-import sys, os, time, shutil, re, imp, filecmp
+import sys, os
-_CIMEROOT = os.environ.get("CIMEROOT")
-if _CIMEROOT is None:
- raise SystemExit("ERROR: must set CIMEROOT environment variable")
+_SLIM_PYTHON = os.path.normpath(
+ os.path.join(os.path.dirname(os.path.abspath(__file__)), os.pardir, "python")
+)
+sys.path.insert(1, _SLIM_PYTHON)
-_LIBDIR = os.path.join(_CIMEROOT, "scripts", "Tools")
-sys.path.append(_LIBDIR)
+from slim import add_cime_to_path
+from slim import add_slim_cime_py_to_path
+from slim.slim_logging import setup_logging
-from standard_script_setup import *
-from CIME.buildnml import create_namelist_infile, parse_input
-from CIME.case import Case
-from CIME.utils import expect, run_cmd
-
-logger = logging.getLogger(__name__)
-
-_config_cache_template = """
-
-
-
-Specifies clm physics
-
-"""
-
-###############################################################################
-def buildnml(case, caseroot, compname):
-###############################################################################
- """Build the clm namelist """
-
- # Build the component namelist
- if compname != "clm":
- raise AttributeError
-
- lnd_root = case.get_value("COMP_ROOT_DIR_LND")
- din_loc_root = case.get_value("DIN_LOC_ROOT")
- ccsm_co2_ppmv = case.get_value("CCSM_CO2_PPMV")
- clm_co2_type = case.get_value("CLM_CO2_TYPE")
- clm_namelist_opts = case.get_value("CLM_NAMELIST_OPTS")
- clm_bldnml_opts = case.get_value("CLM_BLDNML_OPTS")
- clm_nml_use_case = case.get_value("CLM_NML_USE_CASE")
- clm_force_coldstart = case.get_value("CLM_FORCE_COLDSTART")
- clm_accelerated_spinup = case.get_value("CLM_ACCELERATED_SPINUP")
- comp_glc = case.get_value("COMP_GLC")
- comp_atm = case.get_value("COMP_ATM")
- lnd_grid = case.get_value("LND_GRID")
- lnd_ncpl = case.get_value("LND_NCPL")
- lnd_domain_path = case.get_value("LND_DOMAIN_PATH")
- lnd_domain_file = case.get_value("LND_DOMAIN_FILE")
- ninst_lnd = case.get_value("NINST_LND")
- rundir = case.get_value("RUNDIR")
- run_type = case.get_value("RUN_TYPE")
- run_startdate = case.get_value("RUN_STARTDATE")
- run_refcase = case.get_value("RUN_REFCASE")
- run_refdate = case.get_value("RUN_REFDATE")
- run_reftod = case.get_value("RUN_REFTOD")
- glc_nec = case.get_value("GLC_NEC")
- mask = case.get_value("MASK_GRID")
-
-
- if ( clm_accelerated_spinup != "off" ):
- expect(False, "CLM_ACCELERATED_SPINUP is not OFF -- SLIM can not use this!" )
-
- # -----------------------------------------------------
- # Clear out old data
- # -----------------------------------------------------
-
- input_data_list = os.path.join(caseroot,"Buildconf","clm.input_data_list")
- if os.path.exists(input_data_list):
- os.remove(input_data_list)
-
- # -----------------------------------------------------
- # Set clmconf
- # -----------------------------------------------------
-
- clmconf = os.path.join(caseroot, "Buildconf", "clmconf")
- if not os.path.isdir(clmconf):
- os.makedirs(clmconf)
-
- # -----------------------------------------------------
- # Create config_cache.xml file
- # -----------------------------------------------------
-
- # Note that build-namelist utilizes the contents of the config_cache.xml file in
- # the namelist_defaults.xml file to obtain namelist variables
-
- clm_config_opts = case.get_value("CLM_CONFIG_OPTS")
- if "clm4_5" in clm_config_opts:
- clm_phys = "clm4_5"
- elif "clm5_0" in clm_config_opts:
- clm_phys = "clm5_0"
- else:
- expect(False, "CLM_CONFIG_OPTS must support either clm4_5 or clm5_0 physics")
-
- config_cache_text = _config_cache_template.format(clm_phys=clm_phys)
- config_cache_path = os.path.join(caseroot, "Buildconf", "clmconf", "config_cache.xml")
- with open(config_cache_path, 'w') as config_cache_file:
- config_cache_file.write(config_cache_text)
-
- # -----------------------------------------------------
- # Determine input arguments into build-namelist
- # -----------------------------------------------------
-
- startfile_type = "finidat"
- start_type = "default"
- if run_type == "hybrid":
- start_type = "startup"
- elif run_type != "startup":
- start_type = run_type
-
- if run_type == "branch":
- startfile_type = "nrevsn"
- if clm_force_coldstart == "on":
- clm_force_coldstart = "off"
- logger.warning( "WARNING: You've turned on CLM_FORCE_COLDSTART for a branch run_type, which is a contradiction, the coldstart will be ignored\n" +
- " turn off CLM_FORCE_COLDSTART, or set RUN_TYPE=hybrid to get rid of this warning"
- )
-
- if (clm_force_coldstart == "on"):
- logger.warning( "WARNING: CLM is starting up from a cold state" )
- start_type = "cold"
-
- if lnd_grid == 'T31':
- lnd_grid = '48x96'
- if lnd_grid == 'T42':
- lnd_grid = '64x128'
- if lnd_grid == 'T85':
- lnd_grid = '128x256'
- if lnd_grid == 'T341':
- lnd_grid = '512x1024'
-
- if clm_nml_use_case != "UNSET":
- usecase = "-use_case %s" %clm_nml_use_case
- else:
- usecase = ""
-
- if ( (mask != "null") and (mask != "UNSET") ):
- gridmask = "-mask %s" %mask
- else:
- gridmask = ""
-
- start_ymd = run_startdate.replace('-','')
-
- if ('-01-01' in run_startdate) or ('-09-01' in run_startdate):
- ignore = "-ignore_ic_year"
- else:
- ignore = "-ignore_ic_date"
-
- infile = os.path.join(clmconf, "namelist")
-
- inputdata_file = os.path.join(caseroot,"Buildconf","clm.input_data_list")
-
- lndfrac_file = os.path.join(lnd_domain_path,lnd_domain_file)
-
- config_cache_file = os.path.join(caseroot,"Buildconf","clmconf","config_cache.xml")
-
- # -----------------------------------------------------
- # loop over instances
- # -----------------------------------------------------
-
- ninst = int(ninst_lnd)
- for inst_counter in range(1, ninst+1):
-
- # determine instance string
- inst_string = ""
- if ninst > 1:
- inst_string = '_' + '%04d' % inst_counter
-
- # If multi-instance case does not have restart file, use
- # single-case restart for each instance
- rpointer = "rpointer.lnd"
- if (os.path.isfile(os.path.join(rundir,rpointer)) and
- (not os.path.isfile(os.path.join(rundir,rpointer + inst_string)))):
- shutil.copy(os.path.join(rundir, rpointer),
- os.path.join(rundir, rpointer + inst_string))
-
- # -----------------------------------------------------
- # call build-namelist
- # -----------------------------------------------------
-
- if run_type == "hybrid" or run_type == "branch":
- clm_startfile = "%s.clm2%s.r.%s-%s.nc"%(run_refcase,inst_string,run_refdate,run_reftod)
- if not os.path.exists(os.path.join(rundir, clm_startfile)):
- clm_startfile = "%s.clm2.r.%s-%s.nc"%(run_refcase,run_refdate,run_reftod)
- clm_icfile = "%s = \'%s\'"%(startfile_type, clm_startfile)
- else:
- clm_icfile = ""
-
- infile_lines = []
- infile_lines.append(clm_icfile)
-
- user_nl_file = os.path.join(caseroot, "user_nl_clm" + inst_string)
- namelist_infile = os.path.join(clmconf, "namelist")
-
- create_namelist_infile(case, user_nl_file, namelist_infile, "\n".join(infile_lines))
-
- cmd = os.path.join(lnd_root,"bld","build-namelist")
-
- command = ("%s -cimeroot %s -infile %s -csmdata %s -inputdata %s %s -namelist \"&clm_inparm start_ymd=%s/ \" "
- "%s %s -res %s -clm_start_type %s -envxml_dir %s -l_ncpl %s "
- "-lnd_frac %s -glc_nec %s -co2_ppmv %s -co2_type %s -config %s "
- "%s %s"
- %(cmd, _CIMEROOT, infile, din_loc_root, inputdata_file, ignore, start_ymd, clm_namelist_opts,
- usecase, lnd_grid, start_type, caseroot, lnd_ncpl,
- lndfrac_file, glc_nec, ccsm_co2_ppmv, clm_co2_type, config_cache_file,
- clm_bldnml_opts, gridmask))
-
- rc, out, err = run_cmd(command, from_dir=clmconf)
- expect(rc==0,"Command %s failed rc=%d\nout=%s\nerr=%s"%(cmd,rc,out,err))
- if out is not None:
- logger.debug(" %s"%out)
- if err is not None:
- logger.debug(" %s"%err)
-
- # -----------------------------------------------------
- # copy resolved namelist to rundir
- # -----------------------------------------------------
-
- if os.path.isdir(rundir):
- file1 = os.path.join(clmconf, "lnd_in")
- file2 = os.path.join(rundir, "lnd_in")
- if ninst > 1:
- file2 += inst_string
- logger.debug("CLM namelist copy: file1 %s file2 %s " %(file1, file2))
- shutil.copy(file1,file2)
+from standard_script_setup import *
+from CIME.buildnml import parse_input
+from CIME.case import Case
+from slim_cime_py import buildnml
###############################################################################
def _main_func():
caseroot = parse_input(sys.argv)
+ level = logging.WARNING
+ setup_logging(level)
with Case(caseroot) as case:
- buildnml(case, caseroot, "clm")
+ buildnml(case, caseroot, "slim")
+
if __name__ == "__main__":
_main_func()
diff --git a/cime_config/buildnml_test/env_archive.xml b/cime_config/buildnml_test/env_archive.xml
new file mode 100644
index 00000000..21e8595f
--- /dev/null
+++ b/cime_config/buildnml_test/env_archive.xml
@@ -0,0 +1,9 @@
+
+
+
+
+
+
+
+
diff --git a/cime_config/buildnml_test/env_batch.xml b/cime_config/buildnml_test/env_batch.xml
new file mode 100644
index 00000000..d9bc277d
--- /dev/null
+++ b/cime_config/buildnml_test/env_batch.xml
@@ -0,0 +1,25 @@
+
+
+
+
+
+
+
+ char
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/cime_config/buildnml_test/env_build.xml b/cime_config/buildnml_test/env_build.xml
new file mode 100644
index 00000000..3464158b
--- /dev/null
+++ b/cime_config/buildnml_test/env_build.xml
@@ -0,0 +1,28 @@
+
+
+
+
+
+
+
+
+ char
+ Land (lnd) grid
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/cime_config/buildnml_test/env_case.xml b/cime_config/buildnml_test/env_case.xml
new file mode 100644
index 00000000..f6f4ef9d
--- /dev/null
+++ b/cime_config/buildnml_test/env_case.xml
@@ -0,0 +1,63 @@
+
+
+
+
+
+
+
+
+
+
+ char
+ file containing specification of component specific definitions and values(for documentation only - DO NOT EDIT)
+ $CIMEROOT/config/xml_schemas/entry_id.xsd
+ $CIMEROOT/config/xml_schemas/entry_id_version3.xsd
+
+
+
+ char
+ Component set long name (for documentation only - DO NOT EDIT)
+
+
+
+ char
+ Root directory of the case land model component
+ $CIMEROOT/config/xml_schemas/config_compsets.xsd
+
+
+
+ char
+ slim
+ Name of land component
+
+
+
+ char
+ full pathname of source root directory
+
+
+
+ char
+ case name
+
+
+
+ char
+ model system name
+
+
+
+ char
+ full pathname of case
+
+
+
+ char
+ Land grid
+
+
+
+
diff --git a/cime_config/buildnml_test/env_mach_pes.xml b/cime_config/buildnml_test/env_mach_pes.xml
new file mode 100644
index 00000000..5697d09f
--- /dev/null
+++ b/cime_config/buildnml_test/env_mach_pes.xml
@@ -0,0 +1,89 @@
+
+
+
+
+
+
+
+
+
+
+ integer
+
+
+
+ integer
+
+
+
+ integer
+
+
+
+ integer
+
+
+
+ integer
+ Force this exact number of spare nodes to be allocated
+
+
+
+ integer
+
+ 1
+ 1
+ 1
+ 1
+
+
+
+
+
+ integer
+
+ -2
+ -2
+ -2
+ -2
+
+
+
+
+
+ integer
+
+ 0
+ 0
+ 0
+ 0
+
+
+
+
+
+ integer
+
+ 1
+ 1
+ 1
+
+
+
+
+
+ integer
+
+ 1
+ 1
+ 1
+ 1
+
+
+
+
+
+
diff --git a/cime_config/buildnml_test/env_mach_specific.xml b/cime_config/buildnml_test/env_mach_specific.xml
new file mode 100644
index 00000000..c38d868a
--- /dev/null
+++ b/cime_config/buildnml_test/env_mach_specific.xml
@@ -0,0 +1,24 @@
+
+
+
+
+
+
+
+
+
+ char
+ executable name
+
+
+
+
+
+
+
+
+
+
diff --git a/cime_config/buildnml_test/env_run.xml b/cime_config/buildnml_test/env_run.xml
new file mode 100644
index 00000000..858cfc74
--- /dev/null
+++ b/cime_config/buildnml_test/env_run.xml
@@ -0,0 +1,50 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/cime_config/buildnml_test/env_workflow.xml b/cime_config/buildnml_test/env_workflow.xml
new file mode 100644
index 00000000..69c9aa80
--- /dev/null
+++ b/cime_config/buildnml_test/env_workflow.xml
@@ -0,0 +1,14 @@
+
+
+
+
+
+
+
+
+
+
+
diff --git a/cime_config/buildnml_test/run_buildnml b/cime_config/buildnml_test/run_buildnml
new file mode 100755
index 00000000..2ad7a4a0
--- /dev/null
+++ b/cime_config/buildnml_test/run_buildnml
@@ -0,0 +1,4 @@
+#!/bin/bash
+rm Buildconf/slimconf/lnd_in
+env CIMEROOT=`pwd`/../../cime ../buildnml `pwd` --verbose --debug
+cat Buildconf/slimconf/lnd_in
diff --git a/cime_config/user_nl_clm b/cime_config/buildnml_test/user_nl_slim
similarity index 69%
rename from cime_config/user_nl_clm
rename to cime_config/buildnml_test/user_nl_slim
index b225eb1d..43893a6e 100644
--- a/cime_config/user_nl_clm
+++ b/cime_config/buildnml_test/user_nl_slim
@@ -3,14 +3,11 @@
! namelist_var = new_namelist_value
!
! EXCEPTIONS:
-! Set use_cn by the compset you use and CLM_BLDNML_OPTS -bgc setting
-! Set co2_ppmv with CCSM_CO2_PPMV option
! Set dtime with L_NCPL option
! Set fatmlndfrc with LND_DOMAIN_PATH/LND_DOMAIN_FILE options
! Set finidat with RUN_REFCASE/RUN_REFDATE/RUN_REFTOD options for hybrid or branch cases
! (includes $inst_string for multi-ensemble cases)
-! or with CLM_FORCE_COLDSTART to do a cold start
+! or with SLIM_START_TYPE=cold to do a cold start
! or set it with an explicit filename here.
-! Set maxpatch_glcmec with GLC_NEC option
!----------------------------------------------------------------------------------
diff --git a/cime_config/config_archive.xml b/cime_config/config_archive.xml
index 4c2412a0..9b3e93b7 100644
--- a/cime_config/config_archive.xml
+++ b/cime_config/config_archive.xml
@@ -1,5 +1,5 @@
-
+
r
rh\d?
h\d*.*\.nc$
@@ -7,18 +7,18 @@
locfnh
rpointer.lnd$NINST_STRING
- ./$CASE.clm2$NINST_STRING.r.$DATENAME.nc
+ ./$CASE.slim$NINST_STRING.r.$DATENAME.nc
rpointer.lnd
rpointer.lnd_9999
- casename.clm2.r.1976-01-01-00000.nc
- casename.clm2.rh4.1976-01-01-00000.nc
- casename.clm2.h0.1976-01-01-00000.nc
- casename.clm2.h0.1976-01-01-00000.nc.base
- casename.clm2_0002.e.postassim.1976-01-01-00000.nc
- casename.clm2_0002.e.preassim.1976-01-01-00000.nc
- anothercasename.clm2.i.1976-01-01-00000.nc
+ casename.slim.r.1976-01-01-00000.nc
+ casename.slim.rh4.1976-01-01-00000.nc
+ casename.slim.h0.1976-01-01-00000.nc
+ casename.slim.h0.1976-01-01-00000.nc.base
+ casename.slim_0002.e.postassim.1976-01-01-00000.nc
+ casename.slim_0002.e.preassim.1976-01-01-00000.nc
+ anothercasename.slim.i.1976-01-01-00000.nc
diff --git a/cime_config/config_component.xml b/cime_config/config_component.xml
index ab8a8c9e..e90e3dcc 100644
--- a/cime_config/config_component.xml
+++ b/cime_config/config_component.xml
@@ -13,135 +13,62 @@
-->
-
- clm4.5:
- clm5.0:
- Satellite phenology:
- BGC (vert. resol. CN and methane):
+
+ Simple Land Model:
char
- clm
- clm
+ slim
+ slim
case_comp
env_case.xml
Name of land component
-
+
char
-
-
- -phys clm4_5
- -phys clm5_0
-
- build_component_clm
- env_build.xml
- Provides option(s) for the CLM configure utility.
- CLM_CONFIG_OPTS are normally set as compset variables (e.g., -bgc cn)
- and in general should not be modified for supported compsets.
- It is recommended that if you want to modify this value for your experiment,
- you should use your own user-defined component sets via using create_newcase
- with a compset_file argument.
- This is an advanced flag and should only be used by expert users.
-
-
-
- char
- UNSET
-
-
- 2000_control
- 1850_control
-
- run_component_clm
- env_run.xml
- CLM namelist use_case.
- Determines the use-case that will be sent to the CLM build-namelist utility.
- This is normally set by the component set. This is an advanced flag and should only be
- used by expert users.
-
-
-
-
-
- char
-
+ global_uniform
+ global_uniform,realistic_from_1850,realistic_from_2000,user_defined
- -bgc sp
- -bgc bgc
-
- -bgc sp
- -bgc bgc
+ realistic_from_2000
+ realistic_from_1850
+ realistic_from_1850
- run_component_clm
+ run_component_slim
env_run.xml
- CLM build-namelist options
+ SLIM namelist use_case scenario.
+ Determines the use-case scenario that will be used in the SLIM buildnml utility.
+ This is normally set by the component set.
+ 'global_uniform' is for surface conditions are globally constant
+ 'realistic_from_1850' are surface conditions taken from a 1850 control simulation with CTSM
+ 'realistic_from_2000' are surface conditions taken from a 2000 control simulation with CTSM
+ 'user_defined' means the user will provide their own surface condition file (mml_surdat)
+
-
+
char
- constant,diagnostic,prognostic
- constant
+ cold,any,required
+ any
- diagnostic
- diagnostic
- prognostic
- diagnostic
+ required
+ required
+ any
- run_component_clm
+ run_component_slim
env_run.xml
- Determines how CLM will determine where CO2 is set.
- If value is constant, it will be set to CCSM_CO2_PPMV,
- if value is either diagnostic or prognostic, the atmosphere model
- MUST send it to CLM. CLM_CO2_TYPE is normally set by the specific
- compset, since it HAS to be coordinated with settings for the
- atmospheric model. Do not modify this variable. If you want to modify for
- your experiment, use your own user-defined component set
- This is an advanced flag and should only be used by expert users.
-
-
-
- char
-
- run_component_clm
- env_run.xml
- CLM-specific namelist settings for -namelist option in the CLM
- build-namelist. CLM_NAMELIST_OPTS is normally set as a compset variable
- and in general should not be modified for supported compsets.
- It is recommended that if you want to modify this value for your experiment,
- you should use your own user-defined component sets via using create_newcase
- with a compset_file argument.
- This is an advanced flag and should only be used by expert users.
-
-
-
- char
- off
- off
- run_component_clm
- env_run.xml
- Turn on any settings for accellerating the model spinup. This is unused for SLIM!
+
+ SLIM run type.
+ 'cold' is a cold start from arbitrary initial conditions, it will fail if you do provide initial conditions
+ 'any' is a run using initial conditions if provided, OR arbitrary initial conditions if no files can be found
+ 'required' is a run where starting from provided initial conditions is required, it will fail if they aren't
-
- char
- on,off
- off
- run_component_clm
- env_run.xml
- Flag to the CLM build-namelist command to force CLM to do a
- cold start (finidat will be set to blanks).
- A value of on forces the model to spin up from a cold-start
- (arbitrary initial conditions). Setting this value in the xml file will take
- precedence over any settings for finidat in the $CASEROOT/user_clm_clm file.
-
-
=========================================
- CLM naming conventions
+ SLIM naming conventions
=========================================
note: [^_]* means match zero or more of any character BUT an underbar.
(in other words make sure there is NOT a underbar before the string afterwards)
diff --git a/cime_config/config_compsets.xml b/cime_config/config_compsets.xml
index d1096214..81d47dc9 100644
--- a/cime_config/config_compsets.xml
+++ b/cime_config/config_compsets.xml
@@ -14,7 +14,7 @@
Where for the CAM specific compsets below the following is supported
TIME = Time period (e.g. 2000, HIST, RCP8...)
ATM = [CAM40, CAM50, CAM55]
- LND = [CLM45, CLM50, SLND]
+ LND = [SLIM, SLND]
ICE = [CICE, DICE, SICE]
OCN = [DOCN, ,AQUAP, SOCN]
ROF = [RTM, SROF]
@@ -34,81 +34,76 @@
- science_support (if this compset is supported scientifically with control simulations)
-
+
- H_MML_2000_CAM6
- 2000_CAM60_CLM50%SP_CICE_DOCN%SOM_SROF_SGLC_SWAV
+ ELT2000ClimoTESTC6I5Slim
+ 2000_CAM60_SLIM_CICE_DOCN%SOM_SROF_SGLC_SWAV
+
+
- H_MML_1850_CAM6
- 1850_CAM60_CLM50%SP_CICE_DOCN%SOM_SROF_SGLC_SWAV
+ ELT1850TESTC6I5Slim
+ 1850_CAM60_SLIM_CICE_DOCN%SOM_SROF_SGLC_SWAV
- F2000Cam6SlimRsGs
- 2000_CAM60_CLM50%SP_CICE%PRES_DOCN%DOM_SROF_SGLC_SWAV
+ FLT2000ClimoC6I5Slim
+ 2000_CAM60_SLIM_CICE%PRES_DOCN%DOM_SROF_SGLC_SWAV
-
+
- H_MML_2000_CAM5
- 2000_CAM50_CLM45%SP_CICE_DOCN%SOM_SROF_SGLC_SWAV
+ ELT2000ClimoTESTC5I5Slim
+ 2000_CAM50_SLIM_CICE_DOCN%SOM_SROF_SGLC_SWAV
+
- FHistCam5SlimRsGs
- HIST_CAM50_CLM45%SP_CICE_DOCN%SOM_SROF_SGLC_SWAV
+ FLTHISTC5I5Slim
+ HIST_CAM50_SLIM_CICE%PRES_DOCN%DOM_SROF_SGLC_SWAV
-
-
- K1850MMLOFFLINE_CPLHIST
- 1850_DATM%CPLHIST_CLM45%SP_SICE_SOCN_SROF_SGLC_SWAV
-
+
+
+
- K2000MMLOFFLINE_CPLHIST
- 2000_DATM%CPLHIST_CLM45%SP_SICE_SOCN_SROF_SGLC_SWAV
+ IHistSlimRsGs
+ HIST_DATM%GSWP3v1_SLIM_SICE_SOCN_SROF_SGLC_SWAV
+
- K1850MMLOFFLINE_CRU
- 1850_DATM%CRUv7_CLM45%SP_SICE_SOCN_SROF_SGLC_SWAV
+ IHistSlimQianRsGs
+ HIST_DATM%QIA_SLIM_SICE_SOCN_SROF_SGLC_SWAV
+
- K1850MMLOFFLINE_GSWP3
- 1850_DATM%GSWP3v1_CLM45%SP_SICE_SOCN_SROF_SGLC_SWAV
+ I2000SlimRsGs
+ 2000_DATM%GSWP3v1_SLIM_SICE_SOCN_SROF_SGLC_SWAV
-
-
-
- K_HIST_MMLOFFLINE_GSWP3
- HIST_DATM%GSWP3v1_CLM45%SP_SICE_SOCN_SROF_SGLC_SWAV
-
-
- K_HIST_MMLOFFLINE_QIA
- HIST_DATM%QIA_CLM50%SP_SICE_SOCN_SROF_SGLC_SWAV
-
-
-
+
- IHistSlim50QianGs
- HIST_DATM%QIA_CLM50%SP_SICE_SOCN_SROF_SGLC_SWAV
+ I1850SlimRsGs
+ 1850_DATM%GSWP3v1_SLIM_SICE_SOCN_SROF_SGLC_SWAV
-
-
+
- I1850Slim50RsGs
- 1850_DATM%GSWP3v1_CLM50%SP_SICE_SOCN_SROF_SGLC_SWAV
+ I1850SlimCruRsGs
+ 1850_DATM%CRUv7_SLIM_SICE_SOCN_SROF_SGLC_SWAV
+
- I2000SlimRsGs
- 2000_DATM%GSWP3v1_CLM45%SP_SICE_SOCN_SROF_SGLC_SWAV
+ I1850SlimCplhistRsGs
+ 1850_DATM%CPLHIST_SLIM_SICE_SOCN_SROF_SGLC_SWAV
diff --git a/cime_config/config_pes.xml b/cime_config/config_pes.xml
index 42005741..9e6fa44b 100644
--- a/cime_config/config_pes.xml
+++ b/cime_config/config_pes.xml
@@ -5,43 +5,82 @@
- none
+ Default 4 nodes for any compset and machine
- -4
- -4
- -4
- -4
- -4
- -4
- -4
- -4
+ -4
+ -4
+ -4
+ -4
+ -4
+ -4
+ -4
+ -4
- 1
- 1
- 1
- 1
- 1
- 1
- 1
- 1
+ 1
+ 1
+ 1
+ 1
+ 1
+ 1
+ 1
+ 1
- 0
- 0
- 0
- 0
- 0
- 0
- 0
- 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+
+
+
+
+
+
+
+
+ Single node for izumi for small PE layout
+
+ -1
+ -1
+ -1
+ -1
+ -1
+ -1
+ -1
+ -1
+
+
+ 1
+ 1
+ 1
+ 1
+ 1
+ 1
+ 1
+ 1
+
+
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
-
+
+ Coupled to CAM for 2 degree on cheyenne
-10
-10
@@ -78,7 +117,7 @@
- none
+ All compsets at 2 degree on any machine
-4
-4
@@ -114,8 +153,8 @@
-
- none
+
+ 2 degree SLIM standalone "I compset" on cheyenne
-1
-40
@@ -188,7 +227,8 @@
-
+
+ 1 degree SLIM standalone "I compset" on cheyenne
none
-1
@@ -260,95 +300,20 @@
-
-
-
- none
-
- 5
- 5
- 5
- 5
- 5
- 5
- 5
- 5
-
-
- 1
- 1
- 1
- 1
- 1
- 1
- 1
- 1
-
-
- 0
- 0
- 0
- 0
- 0
- 0
- 0
- 0
-
-
-
-
-
-
-
- none
-
- -4
- -4
- -4
- -4
- -4
- -4
- -4
- -4
- -4
-
-
- 1 >
- 1
- 1
- 1
- 1
- 1
- 1
- 1
-
-
- 0
- 0
- 0
- 0
- 0
- 0
- 0
- 0
-
-
-
-
- none
+ 10x15 degree single node for any machine and compset
- -2
- -2
- -2
- -2
- -2
- -2
- -2
- -2
- -2
+ -1
+ -1
+ -1
+ -1
+ -1
+ -1
+ -1
+ -1
+ -1
1 >
@@ -373,40 +338,40 @@
-
-
-
- none
+
+
+
+ 4x5 degree for cheyenne for I compsets
- -1
- -1
- -1
- -1
- -1
- -1
- -1
- -1
- -1
+ -1
+ -4
+ -4
+ -4
+ -4
+ -4
+ -4
+ -4
+ -4
1 >
- 1
- 1
- 1
- 1
- 1
- 1
- 1
+ 1
+ 1
+ 1
+ 1
+ 1
+ 1
+ 1
- 0
- 0
- 0
- 0
- 0
- 0
- 0
- 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
diff --git a/cime_config/namelist_definition.xsl b/cime_config/namelist_definition.xsl
new file mode 100644
index 00000000..62e02bf0
--- /dev/null
+++ b/cime_config/namelist_definition.xsl
@@ -0,0 +1,114 @@
+
+
+
+
+
+
+
+
+
+
+
+
+ SLIM Namelist Definition
+
+
+
+
+
+
+
+ Definition of SLIM namelist variables
+ We list all of the relevant namelist variables for SLIM cases. This includes
+ SLIM Namelist items.
+
+ Definition of SLIM namelist variables
+ Note, these all would go into the user_nl_slim file
+ Included in the table are the following pieces of information:
+
+ Variable name.
+ Variable type (char
, integer
,
+ real
, or logical
). The type
+ char
has the length appended
+ following an asterisk, e.g., char*256
. Variables that are
+ arrays have their dimension specifier appended inside parentheses. For
+ example char*1(6)
denotes a array of six
+ char*1
values.
+
+ Variable description (includes information on defaults).
+ Valid values (if restricted).
+
+
+
+ SLIM Namelist Physics Options
+
+ Name
+ Type
+ Description
+
+
+ Valid values
+
+
+
+
+
+ SLIM Namelist Datasets
+
+ Name
+ Type
+ Description
+
+
+
+ Valid values
+
+
+
+
+
+ SLIM Namelist History output settings
+
+ Name
+ Type
+ Description
+
+
+ Valid values
+
+
+
+
+
+ SLIM Namelist Performance Tuning
+
+ Name
+ Type
+ Description
+
+
+ Valid values
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ Valid Values:
+
+
+
+
+
diff --git a/cime_config/namelist_definition_slim.xml b/cime_config/namelist_definition_slim.xml
new file mode 100644
index 00000000..99ed1089
--- /dev/null
+++ b/cime_config/namelist_definition_slim.xml
@@ -0,0 +1,355 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+ char
+ datasets
+ abs
+ slim_data_and_initial
+
+ UNSET
+ UNSET
+ $DIN_LOC_ROOT/lnd/slim/surdat/globalconst_alpha0.2_soilcv2e6_hc0.1_rs100.0_glc_hc0.01_f19_cdf5_20211105.nc
+ $DIN_LOC_ROOT/lnd/slim/surdat/slim_realistic_fromCLM5_alb1850_hc1850_rs1850_f19_20190110.nc
+ $DIN_LOC_ROOT/lnd/slim/surdat/slim2deg_fromCMIP6-AMIP-1deg_ensemble001-010_1991to2010clim_max-ctrl-bucket_rs150_c20210401.nc
+ $DIN_LOC_ROOT/lnd/slim/surdat/slim_realistic_f19_20190110_reverse_cutout_to_f09_c20230224.nc
+ $DIN_LOC_ROOT/lnd/slim/surdat/slim_realistic_f19_20190110_cutout_to_f45_c20230131.nc
+ $DIN_LOC_ROOT/lnd/slim/surdat/slim_realistic_f19_20190110_cutout_to_f10_c20230131.nc
+
+
+ Surface dataset describing surface properties at each gridcell
+
+
+
+
+ char
+ datasets
+ abs
+ slim_data_and_initial
+
+
+ UNSET
+
+
+ If use_init_interp is set to .true., interpinic will be called to interpolate
+ the file given by finidat, creating the output file specified by finidat_interp_dest.
+
+
+
+
+ char
+ datasets
+ slim_data_and_initial
+
+
+ UNSET
+ UNSET
+
+
+ Full pathname of initial conditions file. If blank SLIM will startup from
+ arbitrary initial conditions.
+
+
+
+
+ logical
+ datasets
+ slim_data_and_initial
+
+
+ If set to .true., interpinic will be called to interpolate the file given by finidat,
+ creating the output file specified by finidat_interp_dest.
+
+ This requires that finidat be non-blank.
+
+
+
+
+ char
+ datasets
+ abs
+ slim_data_and_initial
+
+
+ Full pathname of master restart file for a branch run. (only used if RUN_TYPE=branch)
+ (Set with RUN_REFCASE and RUN_REFDATE)
+
+
+
+
+ char
+ datasets
+ abs
+ slim_data_and_initial
+
+
+ $LND_DOMAIN_PATH/$LND_DOMAIN_FILE
+
+ Full pathname of land fraction data file.
+
+
+
+
+
+
+
+ integer
+ slim_performance
+ slim_perf
+ number of segments per clump for decomposition
+ 35
+
+ 35
+
+
+
+
+
+
+
+
+ real
+ slim_physics
+ slim_inparm
+ Time step (seconds)
+
+
+
+
+
+
+
+
+ char(6)
+ history
+ slim_history
+ A,I,X,M
+
+ Per file averaging flag.
+ 'A' (average over history period)
+ 'I' (instantaneous)
+ 'X' (maximum over history period)
+ 'M' (minimum over history period)
+
+
+
+
+ logical
+ history
+ slim_history
+
+ If TRUE, indicates do NOT output any default history fields (requires you to use
+ hist_fincl* to set the exact output fields to use)..
+
+
+
+
+ logical
+ history
+ slim_history
+
+ Toggle to turn all history output completely OFF (possibly used for testing)
+
+
+
+
+ char(1000)
+ history
+ slim_history
+ Fields to exclude from default history tape series 1.
+
+ ''
+
+
+
+
+ char(1000)
+ history
+ slim_history
+ Fields to add to history tape series 1.
+
+ ''
+
+
+
+
+ char(1000)
+ history
+ slim_history
+ Fields to add to history tape series 2.
+
+
+
+ char(1000)
+ history
+ slim_history
+ Fields to add to history tape series 3.
+
+
+
+ char(1000)
+ history
+ slim_history
+ Fields to add to history tape series 4.
+
+
+
+ char(1000)
+ history
+ slim_history
+ Fields to add to history tape series 5.
+
+
+
+ char(1000)
+ history
+ slim_history
+ Fields to add to history tape series 6.
+
+
+
+ integer(6)
+ history
+ slim_history
+ Per tape series maximum number of time samples.
+
+ 1
+
+
+
+
+ integer(6)
+ history
+ slim_history
+ 1,2
+
+ Per tape series history file density (i.e. output precision)
+ 1=double precision
+ 2=single precision
+
+ 2,2,2,2,2,2
+
+ 2
+
+
+
+
+
+ integer(6)
+ history
+ slim_history
+
+ Per tape series history write frequency.
+ positive means in time steps
+ 0=monthly
+ negative means hours
+ (i.e. 5 means every 5 time-steps and -24 means every day
+
+ 0,-24,-24,-24,-24,-24
+
+ 0
+
+
+
+
+
+
+
+
+ char
+ default_settings
+ default_settings
+ cold,any,required
+
+ $SLIM_START_TYPE
+
+
+ SLIM run type.
+ 'cold' is a run from arbitrary initial conditions
+ 'any' is a run using initial conditions if provided, OR arbitrary initial conditions if no files can be found
+ 'required' is a startup run which requires setting initial conditions
+
+
+
+
+ char
+ default_settings
+ default_settings
+
+ $LND_GRID
+
+ Horizontal resolutions
+
+
+
+
+
+
+
+ logical
+ datasets
+ finidat_consistency_checks
+ .false.
+
+ .false.
+
+
+ If TRUE, check consistency between year on the finidat file
+ and the current model year. This check is only done for a transient run.
+
+ This requires that finidat be non-blank.
+
+
+
+
+
+
+
+
+
+ integer
+ performance
+ clm_inparm
+
+ Number of processors to use per clump (when threading is implemented)
+ Currently has no effect
+ See this issue:
+ https://github.com/ESCOMP/SimpleLand/issues/29
+
+
+
+
+ logical
+ datasets
+ clm_inparm
+
+ Write diagnostics out to the log file about global statistics
+ Currently is implemented, but should be removed.
+
+
+
+
+
+ logical
+ datasets
+ clm_inparm
+ .false.
+ .false.
+
+ Run as a single column (NOT currently implemented)
+ See this issue:
+ https://github.com/ESCOMP/SimpleLand/issues/29
+
+
+
+
+
diff --git a/cime_config/slim_cime_py/__init__.py b/cime_config/slim_cime_py/__init__.py
new file mode 100644
index 00000000..f63ce26b
--- /dev/null
+++ b/cime_config/slim_cime_py/__init__.py
@@ -0,0 +1,2 @@
+# pylint: disable=missing-module-docstring
+from .buildnml import buildnml
diff --git a/cime_config/slim_cime_py/buildnml.py b/cime_config/slim_cime_py/buildnml.py
new file mode 100644
index 00000000..d3bf36af
--- /dev/null
+++ b/cime_config/slim_cime_py/buildnml.py
@@ -0,0 +1,523 @@
+"""
+SLIM namelist creator
+"""
+import os
+import shutil
+import logging
+import re
+
+from CIME.buildnml import create_namelist_infile
+from CIME.nmlgen import NamelistGenerator
+from CIME.namelist import literal_to_python_value
+from CIME.utils import expect
+
+logger = logging.getLogger(__name__)
+
+# pylint: disable=too-many-arguments,too-many-locals,too-many-branches,too-many-statements
+####################################################################################
+def check_nml_dtime(nmlgen, case):
+ ####################################################################################
+ """Set the namelist settings for time-step"""
+ # pylint: disable=global-statement
+ global logger
+ # ------------------------------------------------------
+ logger.debug(" check_nml_dtime")
+ ncpl_base_period = case.get_value("NCPL_BASE_PERIOD")
+ calendar = case.get_value("CALENDAR")
+ if ncpl_base_period == "hour":
+ basedt = 3600
+ elif ncpl_base_period == "day":
+ basedt = 3600 * 24
+ elif ncpl_base_period == "year":
+ if calendar == "NO_LEAP":
+ basedt = 3600 * 24 * 365
+ else:
+ logger.error("CALENDAR = %s", calendar)
+ expect(False, "Invalid CALENDAR for NCPL_BASE_PERIOD %s " % ncpl_base_period)
+ elif ncpl_base_period == "decade":
+ if calendar == "NO_LEAP":
+ basedt = 3600 * 24 * 365 * 10
+ else:
+ logger.error("CALENDAR = %s", calendar)
+ expect(
+ False,
+ "Invalid CALENDAR for NCPL_BASE_PERIOD %s " % ncpl_base_period,
+ )
+ else:
+ expect(False, "Invalid NCPL_BASE_PERIOD %s " % ncpl_base_period)
+
+ if basedt < 0:
+ expect(False, "basedt invalid overflow for NCPL_BASE_PERIOD %s " % ncpl_base_period)
+
+ lnd_ncpl = int(case.get_value("LND_NCPL"))
+ if basedt % lnd_ncpl != 0:
+ logger.error("CALENDAR = %s", calendar)
+ expect(
+ False,
+ "LND_NCPL=%s doesn't divide evenly into NCPL_BASE_PERIOD %s\n"
+ % (lnd_ncpl, ncpl_base_period),
+ )
+ else:
+ dtime = basedt // lnd_ncpl
+
+ expect(
+ dtime > 1,
+ "LND_NCPL=%s is too frequent which gives a time step that is too short\n" % lnd_ncpl,
+ )
+ expect(
+ dtime <= 86400,
+ "LND_NCPL=%s is too infrequent which gives a time step that is too long\n" % lnd_ncpl,
+ )
+ nmlgen.set_value("dtime", value=dtime)
+
+
+# pylint: disable=too-many-arguments,too-many-locals,too-many-branches,too-many-statements
+####################################################################################
+def check_nml_general(nmlgen):
+ ####################################################################################
+ """Set the namelist settings for general settings"""
+ # pylint: disable=global-statement
+ global logger
+ # ------------------------------------------------------
+ logger.debug(" check_nml_general")
+ for var in ("slim_start_type", "res"):
+ expect(nmlgen.get_value(var) is not None, var + " must be set")
+
+
+####################################################################################
+def check_file(filename, case):
+ ####################################################################################
+ """Check that the file exists"""
+ if os.path.isabs(filename):
+ expect(os.path.isfile(filename), "filename must exist:" + filename)
+ else:
+ rundir = case.get_value("RUNDIR")
+ fname = os.path.normpath(os.path.join(rundir, filename))
+ expect(os.path.isfile(fname), "filename must exist:" + fname)
+
+
+# pylint: disable=too-many-arguments,too-many-locals,too-many-branches,too-many-statements
+####################################################################################
+def check_nml_performance(nmlgen):
+ ####################################################################################
+ """Set the namelist settings for performance"""
+ # pylint: disable=global-statement
+ global logger
+ # ------------------------------------------------------
+ logger.debug(" check_nml_performance")
+ expect(int(nmlgen.get_value("nsegspc")) > 0, "nsegspc must be positive")
+
+
+# pylint: disable=too-many-arguments,too-many-locals,too-many-branches,too-many-statements
+####################################################################################
+def check_nml_history(nmlgen):
+ ####################################################################################
+ """Set the namelist settings for history"""
+ # pylint: disable=global-statement
+ global logger
+ # ------------------------------------------------------
+ logger.debug(" check_nml_history")
+
+ avg_opts = ("A", "I", "X", "M")
+ hist_mfilt = nmlgen.get_value("hist_mfilt")
+ for mfilt in hist_mfilt:
+ if mfilt is None:
+ break
+ if int(mfilt) <= 0:
+ raise SystemExit("hist_mfilt must be 1 or larger")
+
+ #
+ # Check the list of fincl for validity and get number of tapes
+ #
+ hist_empty_htapes = nmlgen.get_value("hist_empty_htapes")
+ if hist_empty_htapes is not None:
+ hist_empty = literal_to_python_value(hist_empty_htapes, type_="logical")
+ else:
+ hist_empty = False
+
+ if hist_empty:
+ num_tapes = 0
+ else:
+ num_tapes = 1
+
+ ftype = "fincl"
+ for tape in (1, 2, 3, 4, 5, 6):
+ var = "hist_" + ftype + str(tape)
+ val = nmlgen.get_value(var)
+ for field in val:
+ if field is None:
+ break
+ match = re.fullmatch(r"([A-Za-z0-9_.]+):*([A-Z0-9]*)\s*", field)
+ if match is None:
+ raise SystemExit(
+ "History field name "
+ + var
+ + " has invalid characters or whitespace in it="
+ + field
+ )
+ if match.group(2):
+ if match.group(2) not in avg_opts:
+ raise SystemExit(
+ "History averaging option "
+ + match.group(2)
+ + " is not valid in "
+ + var
+ + " = "
+ + field
+ )
+ if val != [None]:
+ num_tapes = tape
+ #
+ # hist_fexcl1 can only be set if hist_empty is NOT true
+ #
+ var = "hist_fexcl1"
+ val = nmlgen.get_value(var)
+ if hist_empty:
+ if val != [None]:
+ raise SystemExit("hist_fexcl1 can not be set if hist_empty_htapes is set to true")
+ else:
+ for field in val:
+ if field is None:
+ break
+ match = re.search(r"^[A-Za-z0-9_.]+\s*$", field)
+ if match is None:
+ raise SystemExit(
+ "History field name "
+ + var
+ + " has invalid characters or whitespace in it="
+ + field
+ )
+ #
+ # Loop through history array types and make sure array sizes
+ # are consistent and match the expected number
+ #
+ for var in (
+ "hist_mfilt",
+ "hist_ndens",
+ "hist_nhtfrq",
+ "hist_avgflag_pertape",
+ ):
+ val = nmlgen.get_value(var)
+ if val != [None]:
+ if len(val) != num_tapes:
+ raise SystemExit(
+ var
+ + " array size does not agree with the expected size of "
+ + str(num_tapes)
+ + " "
+ + str(val)
+ )
+ #
+ # History options should not be used when use_noio is on, because it turns off all history...
+ #
+ use_noio = nmlgen.get_value("use_noio")
+ if use_noio is not None:
+ noio = literal_to_python_value(use_noio, type_="logical")
+ else:
+ noio = False
+
+ if noio:
+ # NOTE: hist_nhtfrq is excluded from this list since it is set by default
+ # Loop over the history array options
+ for var in (
+ "hist_fexcl1",
+ "hist_fincl1",
+ "hist_fincl2",
+ "hist_fincl3",
+ "hist_fincl4",
+ "hist_fincl5",
+ "hist_fincl6",
+ "hist_mfilt",
+ "hist_ndens",
+ "hist_avgflag_pertape",
+ ):
+ val = nmlgen.get_value(var)
+ if val != [None]:
+ raise SystemExit(
+ "use_noio turns off all history output"
+ + ", so no hist_ namelist option should also be set"
+ + ", the %s array is also being set here" % var
+ )
+ # Loop over any history scalar options
+ for var in ("hist_empty_htapes",):
+ val = nmlgen.get_value(var)
+ if val is not None:
+ raise SystemExit(
+ "use_noio turns off all history output"
+ + ", so no hist_ namelist option should also be set"
+ + ", %s is also being set here" % var
+ )
+
+
+# pylint: disable=too-many-arguments,too-many-locals,too-many-branches,too-many-statements
+####################################################################################
+def check_nml_initial_conditions(nmlgen, case, inst_string=""):
+ ####################################################################################
+ """Set the namelist settings for initial conditions"""
+ # pylint: disable=global-statement
+ global logger
+ # ------------------------------------------------------
+ logger.debug(" check_nml_initial_conditions")
+ start_type = case.get_value("SLIM_START_TYPE")
+ run_type = case.get_value("RUN_TYPE")
+ run_refcase = case.get_value("RUN_REFCASE")
+ run_refdate = case.get_value("RUN_REFDATE")
+ run_reftod = case.get_value("RUN_REFTOD")
+ rundir = case.get_value("RUNDIR")
+ if run_type in ("hybrid", "branch"):
+ slim_startfile = "%s.slim%s.r.%s-%s.nc" % (
+ run_refcase,
+ inst_string,
+ run_refdate,
+ run_reftod,
+ )
+ if not os.path.exists(os.path.join(rundir, slim_startfile)):
+ slim_startfile = "%s.slim.r.%s-%s.nc" % (
+ run_refcase,
+ run_refdate,
+ run_reftod,
+ )
+
+ nrevsn = nmlgen.get_value("nrevsn")
+ finidat = nmlgen.get_value("finidat")
+ #
+ # Non branch types
+ #
+ if run_type != "branch":
+ # Handle a cold start
+ if start_type == "cold":
+ if finidat != " " and finidat != "UNSET" and finidat is not None:
+ raise SystemExit(
+ "finidat is set but SLIM_START_TYPE is cold which is a contradiction"
+ )
+ nmlgen.set_value("finidat", value=" ")
+
+ # Set to blank meaning a cold start if still UNSET
+ if finidat == " " or finidat == "UNSET" or finidat is None:
+ if run_type == "hybrid" and start_type != "cold":
+ finidat = slim_startfile
+ check_file(finidat, case)
+ nmlgen.set_value("finidat", value=finidat)
+ else:
+ nmlgen.set_value("finidat", value=" ")
+ logger.warning("WARNING: SLIM is starting up from a cold state")
+
+ else:
+ check_file(finidat, case)
+
+ if nrevsn is not None:
+ raise SystemExit("nrevsn can NOT be set except when RUN_TYPE is a branch")
+ #
+ # branch types
+ #
+ else:
+ if nrevsn is None:
+ nrevsn = slim_startfile
+ nmlgen.set_value("nrevsn", value=nrevsn)
+
+ check_file(nrevsn, case)
+ if finidat is not None:
+ raise SystemExit("finidat can NOT be set when RUN_TYPE is a branch")
+
+
+# pylint: disable=too-many-arguments,too-many-locals,too-many-branches,too-many-statements
+####################################################################################
+def check_nml_data(nmlgen, case):
+ ####################################################################################
+ """Set the namelist settings for data must be after check_nml_initial_conditions"""
+ # pylint: disable=global-statement
+ global logger
+ # ------------------------------------------------------
+ logger.debug(" check_nml_data")
+
+ mml_surdat = nmlgen.get_value("mml_surdat")
+ if mml_surdat == "UNSET":
+ slim_scenario = case.get_value("SLIM_SCENARIO")
+ if slim_scenario == "user_defined":
+ raise SystemExit(
+ "When SLIM_SCENARIO is set to user_defined, you must provide the mml_surdat "
+ + "file by adding it to the user_nl_slim file to add it to the namelist"
+ )
+ raise SystemExit("mml_surdat file is NOT set and is required")
+
+ #
+ # use_init_interp requires that finidat be set
+ #
+ finidat = nmlgen.get_value("finidat")
+ use_init_interp = nmlgen.get_value("use_init_interp")
+ if use_init_interp is not None:
+ interp = literal_to_python_value(use_init_interp, type_="logical")
+ else:
+ interp = False
+
+ if finidat == " " and interp:
+ raise SystemExit("use_init_interp can not be set to TRUE for a cold start")
+ #
+ # use_init_interp can not be set for a branch case
+ #
+ run_type = case.get_value("RUN_TYPE")
+ if run_type == "branch" and interp:
+ raise SystemExit("use_init_interp can NOT be set to TRUE for a branch run type")
+
+ #
+ # finidat destination file can only be set if interp is on
+ #
+ finidat_dest = nmlgen.get_value("finidat_interp_dest")
+ if finidat_dest is not None and not interp:
+ raise SystemExit("finidat_interp_dest can NOT be set if use_init_interp is not on")
+
+
+# pylint: disable=too-many-arguments,too-many-locals,too-many-branches,too-many-statements
+# Turn off unused-argument for inst_string, since isn't in place right now
+# pylint: disable=unused-argument
+####################################################################################
+def _create_namelists(case, confdir, inst_string, infile, nmlgen, data_list_path):
+ ####################################################################################
+ """Write out the namelist for this component.
+
+ Most arguments are the same as those for `NamelistGenerator`. The
+ `inst_string` argument is used as a suffix to distinguish files for
+ different instances. The `confdir` argument is used to specify the directory
+ in which output files will be placed.
+ """
+ # pylint: disable=global-statement
+ global logger
+ # ------------------------------------------------------
+ # Create config dictionary
+ # ------------------------------------------------------
+ config = {}
+ config["lnd_grid"] = case.get_value("LND_GRID")
+ config["compset"] = case.get_value("COMPSET")
+ config["slim_scenario"] = case.get_value("SLIM_SCENARIO")
+ config["slim_start_type"] = case.get_value("SLIM_START_TYPE")
+
+ logger.info(" SLIM lnd grid is %s", config["lnd_grid"])
+
+ # ------------------------------------------------------
+ # Initialize namelist defaults
+ # ------------------------------------------------------
+ nmlgen.init_defaults(infile, config)
+
+ # ------------------------------------------------------
+ # Process different namelists and parts of the namelist
+ # ------------------------------------------------------
+ check_nml_dtime(nmlgen, case)
+ check_nml_general(nmlgen)
+ check_nml_performance(nmlgen)
+ check_nml_history(nmlgen)
+ check_nml_initial_conditions(nmlgen, case, inst_string)
+ check_nml_data(nmlgen, case)
+
+ # ----------------------------------------------------
+ # Write output namelist
+ # ----------------------------------------------------
+ logger.info("Write namelists")
+ namelist_file = os.path.join(confdir, "lnd_in")
+ nmlgen.write_output_file(
+ namelist_file,
+ data_list_path,
+ groups=[
+ "slim_inparm",
+ "slim_data_and_initial",
+ "slim_history",
+ "slim_perf",
+ "finidat_consistency_checks",
+ ],
+ )
+
+
+###############################################################################
+def buildnml(case, caseroot, compname):
+ ###############################################################################
+ """Build the slim namelist"""
+ # pylint: disable=global-statement
+ global logger
+
+ # Build the component namelist
+ if compname != "slim":
+ logger.error("compname = %s", compname)
+ raise AttributeError
+
+ lnd_root = case.get_value("COMP_ROOT_DIR_LND")
+
+ # -----------------------------------------------------
+ # Clear out old data
+ # -----------------------------------------------------
+
+ input_data_list = os.path.join(caseroot, "Buildconf", "slim.input_data_list")
+ if os.path.exists(input_data_list):
+ os.remove(input_data_list)
+
+ # -----------------------------------------------------
+ # Set confdir
+ # -----------------------------------------------------
+
+ confdir = os.path.join(caseroot, "Buildconf", "slimconf")
+ if not os.path.isdir(confdir):
+ os.makedirs(confdir)
+
+ # namelist definition file
+ namelist_xml_dir = os.path.join(lnd_root, "cime_config")
+ definition_file = [os.path.join(namelist_xml_dir, "namelist_definition_slim.xml")]
+ for file_ in definition_file:
+ expect(os.path.isfile(file_), "Namelist XML file %s not found!" % file_)
+
+ # Create the namelist generator object - independent of instance
+ nmlgen = NamelistGenerator(case, definition_file)
+
+ # ----------------------------------------------------
+ # Clear out old data list
+ # ----------------------------------------------------
+ data_list_path = os.path.join(case.get_case_root(), "Buildconf", "slim.input_data_list")
+ if os.path.exists(data_list_path):
+ os.remove(data_list_path)
+
+ ### Independent of instance...
+ rundir = case.get_value("RUNDIR")
+
+ # -----------------------------------------------------
+ # loop over instances
+ # -----------------------------------------------------
+
+ ninst_lnd = case.get_value("NINST_LND")
+ ninst = int(ninst_lnd)
+ for inst_counter in range(1, ninst + 1):
+
+ # determine instance string
+ inst_string = ""
+ if ninst > 1:
+ inst_string = "_" + "%04d" % inst_counter
+
+ # If multi-instance case does not have restart file, use
+ # single-case restart for each instance
+ rpointer = "rpointer.lnd"
+ if os.path.isfile(os.path.join(rundir, rpointer)) and (
+ not os.path.isfile(os.path.join(rundir, rpointer + inst_string))
+ ):
+ shutil.copy(
+ os.path.join(rundir, rpointer),
+ os.path.join(rundir, rpointer + inst_string),
+ )
+ ###
+ ### Namelist infile
+ ###
+ infile_lines = []
+
+ user_nl_file = os.path.join(caseroot, "user_nl_slim" + inst_string)
+ infile = os.path.join(confdir, "namelist_infile")
+
+ create_namelist_infile(case, user_nl_file, infile, "\n".join(infile_lines))
+ namelist_infile = [infile]
+
+ # create namelist
+ _create_namelists(case, confdir, inst_string, namelist_infile, nmlgen, data_list_path)
+ # -----------------------------------------------------
+ # copy resolved namelist to rundir
+ # -----------------------------------------------------
+ if os.path.isdir(rundir):
+ file1 = os.path.join(confdir, "lnd_in")
+ file2 = os.path.join(rundir, "lnd_in")
+ if ninst > 1:
+ file2 += inst_string
+ logger.debug("SLIM namelist copy: file1 %s file2 %s ", file1, file2)
+ shutil.copy(file1, file2)
diff --git a/cime_config/testdefs/ExpectedTestFails.xml b/cime_config/testdefs/ExpectedTestFails.xml
index a58ea3d0..23804416 100644
--- a/cime_config/testdefs/ExpectedTestFails.xml
+++ b/cime_config/testdefs/ExpectedTestFails.xml
@@ -29,82 +29,16 @@
-
-
- FAIL
- marysa/SimpleLand#14
-
-
-
-
- FAIL
- marysa/SimpleLand#14
-
-
-
-
- FAIL
- marysa/SimpleLand#14
-
-
-
-
- FAIL
- marysa/SimpleLand#14
-
-
-
-
- FAIL
- marysa/SimpleLand#14
-
-
-
-
- FAIL
- marysa/SimpleLand#14
-
-
-
-
- FAIL
- marysa/SimpleLand#14
-
-
-
-
- FAIL
- marysa/SimpleLand#14
-
-
-
-
- FAIL
- marysa/SimpleLand#14
-
-
-
-
- FAIL
- marysa/SimpleLand#14
-
-
-
-
- FAIL
- marysa/SimpleLand#25?
-
-
-
+
FAIL
- marysa/SimpleLand#17
+ ESCOMP/SimpleLand#17
-
+
FAIL
- marysa/SimpleLand#17
+ ESCOMP/SimpleLand#17
diff --git a/cime_config/testdefs/testlist_clm.xml b/cime_config/testdefs/testlist_slim.xml
similarity index 56%
rename from cime_config/testdefs/testlist_clm.xml
rename to cime_config/testdefs/testlist_slim.xml
index 47d76184..bf44eb34 100644
--- a/cime_config/testdefs/testlist_clm.xml
+++ b/cime_config/testdefs/testlist_slim.xml
@@ -6,26 +6,28 @@
-
+
+
- 01:20:00
+ 02:00:00
Longer smoke test with SOM for CAM5
-
+
+
01:00:00
Debug smoke test with SOM for CAM5
-
+
@@ -34,7 +36,28 @@
smoke test with SOM for CAM5 at 1850 (historical starting in 1850) saving cplhist files
-
+
+
+
+
+
+
+
+ 00:40:00
+ Short term debug restart test with F case at f10 resolution on cheyenne
+
+
+
+
+
+
+
+
+ 00:40:00
+ Short term debug restart test with F case at f09 resolution on cheyenne; override tasks and threads to 144x1 because F cases get their tasks and threads from CAM and SLIM needs threads = 1
+
+
+
@@ -51,18 +74,19 @@
-
-
+
+
+
01:00:00
smoke test with SOM for CAM6 for global uniform
-
+
@@ -71,25 +95,27 @@
smoke test with DOCN for realistic 2000
-
+
+
01:40:00
Longer smoke test with DOCN for realistic 2000
-
+
+
01:00:00
change Processors test with DOCN for realistic 2000
-
+
@@ -102,11 +128,50 @@
-
+
-
+
+
+
+
+
+
+
+ 00:20:00
+ Short term debug restart test with I case at f09 resolution on izumi
+
+
+
+
+
+
+
+
+
+
+
+
+ 00:20:00
+ Short term debug restart test with I case at f45 resolution
+
+
+
+
+
+
+
+
+
+
+
+
+ 00:20:00
+ Short term debug restart test with I case at f10 resolution on izumi
+
+
+
@@ -116,16 +181,17 @@
Longer smoke test for standalone SLIM, go over at least a year boundary (with clm5_0 and SP to ensure same as above)
-
+
+
02:40:00
Change PE count test for standalone SLIM
-
+
@@ -135,7 +201,7 @@
Restart test with pe layout change with 1850 compset test for standalone SLIM
-
+
@@ -145,7 +211,7 @@
Smoke 1850 compset test for standalone SLIM with realistic conditions
-
+
@@ -154,21 +220,22 @@
Longer smoke 2000 compset test for standalone SLIM with realistic conditions
-
+
+
+
-
00:40:00
Longer smoke 2000 compset test for standalone SLIM with realistic conditions and DEBUG on
-
+
@@ -178,7 +245,7 @@
Restart test changing PE count for 2000 compset test for standalone SLIM with realistic conditions
-
+
diff --git a/cime_config/testdefs/testmods_dirs/clm/2000_CMIP6_AMIP_1deg_ensemble/user_nl_clm b/cime_config/testdefs/testmods_dirs/clm/2000_CMIP6_AMIP_1deg_ensemble/user_nl_clm
deleted file mode 100644
index 4801c113..00000000
--- a/cime_config/testdefs/testmods_dirs/clm/2000_CMIP6_AMIP_1deg_ensemble/user_nl_clm
+++ /dev/null
@@ -1 +0,0 @@
-mml_surdat='$DIN_LOC_ROOT/lnd/slim/surdat/slim2deg_fromCMIP6-AMIP-1deg_ensemble001-010_1991to2010clim_max-ctrl-bucket_rs150_c20210401.nc'
diff --git a/cime_config/testdefs/testmods_dirs/clm/2000_CMIP6_AMIP_1deg_ensembleMonthly/include_user_mods b/cime_config/testdefs/testmods_dirs/clm/2000_CMIP6_AMIP_1deg_ensembleMonthly/include_user_mods
deleted file mode 100644
index 7aeecdf4..00000000
--- a/cime_config/testdefs/testmods_dirs/clm/2000_CMIP6_AMIP_1deg_ensembleMonthly/include_user_mods
+++ /dev/null
@@ -1,2 +0,0 @@
-../Monthly
-../2000_CMIP6_AMIP_1deg_ensemble
diff --git a/cime_config/testdefs/testmods_dirs/clm/2000_CMIP6_AMIP_1deg_ensemble_FHistMonthly/include_user_mods b/cime_config/testdefs/testmods_dirs/clm/2000_CMIP6_AMIP_1deg_ensemble_FHistMonthly/include_user_mods
deleted file mode 100644
index 4b850273..00000000
--- a/cime_config/testdefs/testmods_dirs/clm/2000_CMIP6_AMIP_1deg_ensemble_FHistMonthly/include_user_mods
+++ /dev/null
@@ -1,2 +0,0 @@
-../Monthly
-../2000_CMIP6_AMIP_1deg_ensemble_FHist
diff --git a/cime_config/testdefs/testmods_dirs/clm/Monthly/user_nl_clm b/cime_config/testdefs/testmods_dirs/clm/Monthly/user_nl_clm
deleted file mode 100644
index 4eda119e..00000000
--- a/cime_config/testdefs/testmods_dirs/clm/Monthly/user_nl_clm
+++ /dev/null
@@ -1,4 +0,0 @@
- hist_nhtfrq = 0
- hist_mfilt = 1
- ! Don't restrict the list of fields
- hist_empty_htapes = .false.
diff --git a/cime_config/testdefs/testmods_dirs/clm/default/shell_commands b/cime_config/testdefs/testmods_dirs/clm/default/shell_commands
deleted file mode 100755
index b212e325..00000000
--- a/cime_config/testdefs/testmods_dirs/clm/default/shell_commands
+++ /dev/null
@@ -1,4 +0,0 @@
-#!/bin/bash
-./xmlchange CLM_FORCE_COLDSTART="on"
-./xmlchange CLM_CO2_TYPE="constant"
-./xmlchange CCSM_CO2_PPMV="999.99"
diff --git a/cime_config/testdefs/testmods_dirs/clm/default/user_nl_clm b/cime_config/testdefs/testmods_dirs/clm/default/user_nl_clm
deleted file mode 100644
index 82ac77de..00000000
--- a/cime_config/testdefs/testmods_dirs/clm/default/user_nl_clm
+++ /dev/null
@@ -1,19 +0,0 @@
- hist_ndens = 1
- hist_nhtfrq =-24
- hist_mfilt = 5
-! Empty the default history tapes and just output the MML fields
- hist_empty_htapes = .true.
- hist_fincl1 = 'MML_snowmaskdepth', 'MML_evap_rs', 'MML_bucket_cap', 'MML_soiltype', 'MML_roughness', 'MML_fsds', 'MML_fsdsnd',
-'MML_fsdsni',
- 'MML_fsdsvd', 'MML_fsdsvi', 'MML_lwdn', 'MML_zref', 'MML_tbot', 'MML_thref', 'MML_qbot', 'MML_uref',
- 'MML_eref', 'MML_pbot', 'MML_psrf', 'MML_pco2', 'MML_rhomol', 'MML_rhoair', 'MML_cpair', 'MML_prec_liq',
- 'MML_prec_frz', 'MML_ts', 'MML_qs', 'MML_qa', 'MML_swabs', 'MML_fsr', 'MML_fsrnd', 'MML_fsrni',
- 'MML_fsrvd', 'MML_fsrvi', 'MML_snowmelt', 'MML_l2a_taux', 'MML_l2a_tauy', 'MML_lwup', 'MML_shflx', 'MML_lhflx',
- 'MML_gsoi', 'MML_gsnow', 'MML_evap', 'MML_ustar', 'MML_tstar', 'MML_qstar', 'MML_tvstar', 'MML_obu',
- 'MML_ram', 'MML_rah', 'MML_z0m', 'MML_z0h', 'MML_alb', 'MML_fsns', 'MML_flns', 'MML_maxice',
- 'MML_soilz', 'MML_soil_t', 'MML_soil_liq', 'MML_soil_ice', 'MML_dz', 'MML_zh', 'MML_tk', 'MML_tkh',
- 'MML_dtsoi', 'MML_cv', 'MML_water', 'MML_snow', 'MML_runoff', 'MML_l2a_tref2m', 'MML_l2a_qref2m', 'MML_l2a_uref10m',
- 'MML_diag1_1d', 'MML_diag2_1d', 'MML_diag3_1d', 'MML_diag1_2d', 'MML_diag2_2d', 'MML_diag3_2d', 'MML_q_excess',
-'MML_lh_excess',
- 'MML_q_demand', 'MML_lh_demand', 'mml_err_h2o', 'mml_err_h2osno', 'mml_err_seb', 'mml_err_soi', 'mml_err_sol', 'WIND',
- 'THBOT', 'RAIN', 'SNOW', 'RH'
diff --git a/cime_config/testdefs/testmods_dirs/clm/g16_SOM/shell_commands b/cime_config/testdefs/testmods_dirs/clm/g16_SOM/shell_commands
deleted file mode 100755
index 5e4ba742..00000000
--- a/cime_config/testdefs/testmods_dirs/clm/g16_SOM/shell_commands
+++ /dev/null
@@ -1,4 +0,0 @@
-#!/bin/bash
-CIMEROOT=`./xmlquery --value -s CIMEROOT`
-cp $CIMEROOT/../cime_config/testdefs/testmods_dirs/clm/g16_SOM/user_docn* .
-./xmlchange CLM_CO2_TYPE="diagnostic"
diff --git a/cime_config/testdefs/testmods_dirs/clm/global_uniform/include_user_mods b/cime_config/testdefs/testmods_dirs/clm/global_uniform/include_user_mods
deleted file mode 100644
index d243c2a4..00000000
--- a/cime_config/testdefs/testmods_dirs/clm/global_uniform/include_user_mods
+++ /dev/null
@@ -1,2 +0,0 @@
-../default
-../../../../usermods_dirs/global_uniform
diff --git a/cime_config/testdefs/testmods_dirs/clm/global_uniform_g16_SOM/shell_commands b/cime_config/testdefs/testmods_dirs/clm/global_uniform_g16_SOM/shell_commands
deleted file mode 100755
index 626ff59f..00000000
--- a/cime_config/testdefs/testmods_dirs/clm/global_uniform_g16_SOM/shell_commands
+++ /dev/null
@@ -1,2 +0,0 @@
-#!/bin/bash
-./xmlchange CLM_CO2_TYPE="diagnostic"
diff --git a/cime_config/testdefs/testmods_dirs/clm/realistic_fromCLM5_1850/include_user_mods b/cime_config/testdefs/testmods_dirs/clm/realistic_fromCLM5_1850/include_user_mods
deleted file mode 100644
index ad975dc0..00000000
--- a/cime_config/testdefs/testmods_dirs/clm/realistic_fromCLM5_1850/include_user_mods
+++ /dev/null
@@ -1,2 +0,0 @@
-../default
-../../../../usermods_dirs/realistic_fromCLM5_1850
diff --git a/cime_config/testdefs/testmods_dirs/clm/realistic_fromCLM5_1850Monthly/include_user_mods b/cime_config/testdefs/testmods_dirs/clm/realistic_fromCLM5_1850Monthly/include_user_mods
deleted file mode 100644
index 19c81d9f..00000000
--- a/cime_config/testdefs/testmods_dirs/clm/realistic_fromCLM5_1850Monthly/include_user_mods
+++ /dev/null
@@ -1,2 +0,0 @@
-../Monthly
-../realistic_fromCLM5_1850
diff --git a/cime_config/testdefs/testmods_dirs/clm/realistic_fromCLM5_1850_g16_SOM_save_cplhist/shell_commands b/cime_config/testdefs/testmods_dirs/clm/realistic_fromCLM5_1850_g16_SOM_save_cplhist/shell_commands
deleted file mode 100755
index 626ff59f..00000000
--- a/cime_config/testdefs/testmods_dirs/clm/realistic_fromCLM5_1850_g16_SOM_save_cplhist/shell_commands
+++ /dev/null
@@ -1,2 +0,0 @@
-#!/bin/bash
-./xmlchange CLM_CO2_TYPE="diagnostic"
diff --git a/cime_config/testdefs/testmods_dirs/clm/save_cplhist/shell_commands b/cime_config/testdefs/testmods_dirs/clm/save_cplhist/shell_commands
deleted file mode 100755
index 626ff59f..00000000
--- a/cime_config/testdefs/testmods_dirs/clm/save_cplhist/shell_commands
+++ /dev/null
@@ -1,2 +0,0 @@
-#!/bin/bash
-./xmlchange CLM_CO2_TYPE="diagnostic"
diff --git a/cime_config/testdefs/testmods_dirs/clm/g16_SOM/include_user_mods b/cime_config/testdefs/testmods_dirs/slim/Monthly/include_user_mods
similarity index 100%
rename from cime_config/testdefs/testmods_dirs/clm/g16_SOM/include_user_mods
rename to cime_config/testdefs/testmods_dirs/slim/Monthly/include_user_mods
diff --git a/cime_config/testdefs/testmods_dirs/slim/Monthly/user_nl_slim b/cime_config/testdefs/testmods_dirs/slim/Monthly/user_nl_slim
new file mode 100644
index 00000000..11f012ed
--- /dev/null
+++ b/cime_config/testdefs/testmods_dirs/slim/Monthly/user_nl_slim
@@ -0,0 +1,2 @@
+ hist_nhtfrq = 0
+ hist_mfilt = 1
diff --git a/cime_config/testdefs/testmods_dirs/slim/default/shell_commands b/cime_config/testdefs/testmods_dirs/slim/default/shell_commands
new file mode 100755
index 00000000..f3a1a014
--- /dev/null
+++ b/cime_config/testdefs/testmods_dirs/slim/default/shell_commands
@@ -0,0 +1,2 @@
+#!/bin/bash
+./xmlchange SLIM_START_TYPE="cold"
diff --git a/cime_config/testdefs/testmods_dirs/slim/default/user_nl_slim b/cime_config/testdefs/testmods_dirs/slim/default/user_nl_slim
new file mode 100644
index 00000000..5e69970f
--- /dev/null
+++ b/cime_config/testdefs/testmods_dirs/slim/default/user_nl_slim
@@ -0,0 +1,3 @@
+ hist_ndens = 1
+ hist_nhtfrq =-24
+ hist_mfilt = 5
diff --git a/cime_config/testdefs/testmods_dirs/slim/g16_SOM/include_user_mods b/cime_config/testdefs/testmods_dirs/slim/g16_SOM/include_user_mods
new file mode 100644
index 00000000..fe0e18cf
--- /dev/null
+++ b/cime_config/testdefs/testmods_dirs/slim/g16_SOM/include_user_mods
@@ -0,0 +1 @@
+../default
diff --git a/cime_config/testdefs/testmods_dirs/slim/g16_SOM/shell_commands b/cime_config/testdefs/testmods_dirs/slim/g16_SOM/shell_commands
new file mode 100755
index 00000000..1638132d
--- /dev/null
+++ b/cime_config/testdefs/testmods_dirs/slim/g16_SOM/shell_commands
@@ -0,0 +1,3 @@
+#!/bin/bash
+CIMEROOT=`./xmlquery --value -s CIMEROOT`
+cp $CIMEROOT/../cime_config/testdefs/testmods_dirs/slim/g16_SOM/user_docn* .
diff --git a/cime_config/testdefs/testmods_dirs/clm/g16_SOM/user_docn.streams.txt.som b/cime_config/testdefs/testmods_dirs/slim/g16_SOM/user_docn.streams.txt.som
similarity index 100%
rename from cime_config/testdefs/testmods_dirs/clm/g16_SOM/user_docn.streams.txt.som
rename to cime_config/testdefs/testmods_dirs/slim/g16_SOM/user_docn.streams.txt.som
diff --git a/cime_config/testdefs/testmods_dirs/clm/realistic_fromCLM5_1850_g16_SOM_save_cplhist/include_user_mods b/cime_config/testdefs/testmods_dirs/slim/g16_SOM_save_cplhist/include_user_mods
similarity index 50%
rename from cime_config/testdefs/testmods_dirs/clm/realistic_fromCLM5_1850_g16_SOM_save_cplhist/include_user_mods
rename to cime_config/testdefs/testmods_dirs/slim/g16_SOM_save_cplhist/include_user_mods
index 4cec50ab..c15d76a8 100644
--- a/cime_config/testdefs/testmods_dirs/clm/realistic_fromCLM5_1850_g16_SOM_save_cplhist/include_user_mods
+++ b/cime_config/testdefs/testmods_dirs/slim/g16_SOM_save_cplhist/include_user_mods
@@ -1,3 +1,2 @@
-../realistic_fromCLM5_1850
../g16_SOM
../save_cplhist
diff --git a/cime_config/testdefs/testmods_dirs/slim/global_uniform/include_user_mods b/cime_config/testdefs/testmods_dirs/slim/global_uniform/include_user_mods
new file mode 100644
index 00000000..fe0e18cf
--- /dev/null
+++ b/cime_config/testdefs/testmods_dirs/slim/global_uniform/include_user_mods
@@ -0,0 +1 @@
+../default
diff --git a/cime_config/testdefs/testmods_dirs/slim/global_uniform/shell_commands b/cime_config/testdefs/testmods_dirs/slim/global_uniform/shell_commands
new file mode 100755
index 00000000..9c10e11c
--- /dev/null
+++ b/cime_config/testdefs/testmods_dirs/slim/global_uniform/shell_commands
@@ -0,0 +1,2 @@
+#!/bin/bash
+./xmlchange SLIM_SCENARIO="global_uniform"
diff --git a/cime_config/testdefs/testmods_dirs/clm/global_uniform_g16_SOM/include_user_mods b/cime_config/testdefs/testmods_dirs/slim/global_uniform_g16_SOM/include_user_mods
similarity index 100%
rename from cime_config/testdefs/testmods_dirs/clm/global_uniform_g16_SOM/include_user_mods
rename to cime_config/testdefs/testmods_dirs/slim/global_uniform_g16_SOM/include_user_mods
diff --git a/cime_config/testdefs/testmods_dirs/clm/global_uniform_g16_SOMMonthly/include_user_mods b/cime_config/testdefs/testmods_dirs/slim/global_uniform_g16_SOMMonthly/include_user_mods
similarity index 100%
rename from cime_config/testdefs/testmods_dirs/clm/global_uniform_g16_SOMMonthly/include_user_mods
rename to cime_config/testdefs/testmods_dirs/slim/global_uniform_g16_SOMMonthly/include_user_mods
diff --git a/cime_config/testdefs/testmods_dirs/slim/realistic_2000/include_user_mods b/cime_config/testdefs/testmods_dirs/slim/realistic_2000/include_user_mods
new file mode 100644
index 00000000..fe0e18cf
--- /dev/null
+++ b/cime_config/testdefs/testmods_dirs/slim/realistic_2000/include_user_mods
@@ -0,0 +1 @@
+../default
diff --git a/cime_config/testdefs/testmods_dirs/slim/realistic_2000/shell_commands b/cime_config/testdefs/testmods_dirs/slim/realistic_2000/shell_commands
new file mode 100755
index 00000000..eea2a10d
--- /dev/null
+++ b/cime_config/testdefs/testmods_dirs/slim/realistic_2000/shell_commands
@@ -0,0 +1,2 @@
+#!/bin/bash
+./xmlchange SLIM_SCENARIO="realistic_from_2000"
diff --git a/cime_config/testdefs/testmods_dirs/slim/save_cplhist/include_user_mods b/cime_config/testdefs/testmods_dirs/slim/save_cplhist/include_user_mods
new file mode 100644
index 00000000..fe0e18cf
--- /dev/null
+++ b/cime_config/testdefs/testmods_dirs/slim/save_cplhist/include_user_mods
@@ -0,0 +1 @@
+../default
diff --git a/cime_config/testdefs/testmods_dirs/clm/save_cplhist/user_nl_cpl b/cime_config/testdefs/testmods_dirs/slim/save_cplhist/user_nl_cpl
similarity index 100%
rename from cime_config/testdefs/testmods_dirs/clm/save_cplhist/user_nl_cpl
rename to cime_config/testdefs/testmods_dirs/slim/save_cplhist/user_nl_cpl
diff --git a/cime_config/user_nl_slim b/cime_config/user_nl_slim
new file mode 100644
index 00000000..43893a6e
--- /dev/null
+++ b/cime_config/user_nl_slim
@@ -0,0 +1,13 @@
+!----------------------------------------------------------------------------------
+! Users should add all user specific namelist changes below in the form of
+! namelist_var = new_namelist_value
+!
+! EXCEPTIONS:
+! Set dtime with L_NCPL option
+! Set fatmlndfrc with LND_DOMAIN_PATH/LND_DOMAIN_FILE options
+! Set finidat with RUN_REFCASE/RUN_REFDATE/RUN_REFTOD options for hybrid or branch cases
+! (includes $inst_string for multi-ensemble cases)
+! or with SLIM_START_TYPE=cold to do a cold start
+! or set it with an explicit filename here.
+!----------------------------------------------------------------------------------
+
diff --git a/cime_config/usermods_dirs/global_uniform/user_nl_clm b/cime_config/usermods_dirs/global_uniform/user_nl_clm
deleted file mode 100644
index f84c9987..00000000
--- a/cime_config/usermods_dirs/global_uniform/user_nl_clm
+++ /dev/null
@@ -1 +0,0 @@
-mml_surdat = '$DIN_LOC_ROOT/lnd/slim/surdat/globalconst_alpha0.2_soilcv2e6_hc0.1_rs100.0_glc_hc0.01_f19_cdf5_20211105.nc'
diff --git a/cime_config/usermods_dirs/realistic_fromCLM5_1850/user_nl_clm b/cime_config/usermods_dirs/realistic_fromCLM5_1850/user_nl_clm
deleted file mode 100644
index f7953f1f..00000000
--- a/cime_config/usermods_dirs/realistic_fromCLM5_1850/user_nl_clm
+++ /dev/null
@@ -1 +0,0 @@
-mml_surdat = '$DIN_LOC_ROOT/lnd/slim/surdat/slim_realistic_fromCLM5_alb1850_hc1850_rs1850_f19_20190110.nc'
diff --git a/cime_config/usermods_dirs/realistic_fromCLM5_2000/user_nl_clm b/cime_config/usermods_dirs/realistic_fromCLM5_2000/user_nl_clm
deleted file mode 100644
index 171aa345..00000000
--- a/cime_config/usermods_dirs/realistic_fromCLM5_2000/user_nl_clm
+++ /dev/null
@@ -1 +0,0 @@
-mml_surdat = '$DIN_LOC_ROOT/lnd/slim/surdat/slim2deg_fromCMIP6-AMIP-1deg_ensemble001-010_1991to2010clim_max-ctrl-bucket_rs150_c20210401.nc'
diff --git a/py_env_create b/py_env_create
new file mode 100755
index 00000000..648f1e70
--- /dev/null
+++ b/py_env_create
@@ -0,0 +1,136 @@
+#!/bin/bash
+#
+# py_env_create -- setup the python environment in order to use SLIM python tools
+#
+# Simple bash script to setup the python environment for the user so they can run the SLIM
+# python tools using "conda".
+#
+dir=${0%/*}
+if [ "$dir" = "$0" ];then
+ dir="."
+fi
+
+# Check if conda is in your path
+conda --help >& condahelp.txt
+error=$?
+if [ $error != 0 ]; then
+ echo "conda is NOT in your path for the bash shell add it with modules or whatever is required on your system to get it in your path"
+ echo "on cheyenne/capser/etc use -- module load conda"
+ echo "on izumi/CGD systems use -- module load lang/python"
+ echo "For notes on installing on a user system see: https://docs.conda.io/projects/conda/en/latest/user-guide/install/index.html"
+ echo "Error code was $error"
+ cat condahelp.txt
+ exit -1
+fi
+rm condahelp.txt
+python_env=slim_pylib
+
+
+condadir="$dir/python"
+
+domain=`domainname`
+if [[ $domain =~ cgd.* ]]; then
+ condafile="conda_env_slim_py_cgd.txt"
+else
+ condafile="conda_env_slim_py.txt"
+fi
+#----------------------------------------------------------------------
+# Usage subroutine
+usage() {
+ echo ""
+ echo "***********************************************************************"
+ echo "usage:"
+ echo "./py_env_create"
+ echo ""
+ echo "valid arguments: "
+ echo "[-h|--help] "
+ echo " Displays this help message"
+ echo "[-v|--verbose] "
+ echo " Run with verbose mode for the install so you see the progress bar"
+ echo "[-f|--file ] "
+ echo " Conda environment file to use (can be a text format or YAML format)"
+ echo " Assumed to be under the directory: $condadir"
+ echo " Default is: $condafile"
+ echo "[--option ] "
+ echo " Option(s) to pass to 'conda install' step"
+ echo "***********************************************************************"
+}
+
+verbose="No"
+option=""
+while [ $# -gt 0 ]; do
+ case $1 in
+ -h|--help )
+ usage
+ exit 0
+ ;;
+ -v|--verbose )
+ verbose="Yes"
+ ;;
+ -f|--file )
+ condafile=$2
+ shift
+ ;;
+ --option )
+ option=$2
+ shift
+ ;;
+ * )
+ echo "ERROR:: invalid argument sent in: $2"
+ usage
+ exit 1
+ ;;
+ esac
+ shift
+done
+
+if [ ! -f $condadir/$condafile ]; then
+ echo "$condadir/$condafile does NOT exist"
+ echo "Use the --file option with a valid filename"
+ exit -1
+fi
+
+echo "Use conda to install the python environment needed to run the SLIM python tools in the conda environment: $python_env"
+echo "Using the file: $condadir/$condafile"
+
+# Check if the environment already exists, if it does continue, if not create it
+conda list -n $python_env >& /dev/null
+if [ $? != 0 ]; then
+ echo "Create $python_env"
+ cmd="conda create --force -n $python_env -q"
+ echo "$cmd"
+ $cmd
+ if [ $? != 0 ]; then
+ echo "Error creating conda environment $python_env"
+ exit -1
+ fi
+else
+ echo "$python_env environment already exists"
+fi
+echo "Install $python_env this can take a long time, be patient...."
+verbosity="-q"
+if [ "$verbose" == "Yes" ]; then
+ verbosity="-v"
+fi
+cmd="conda install --yes $verbosity -c conda-forge -n $python_env --file $condadir/$condafile $option"
+echo "$cmd"
+$cmd
+if [ $? != 0 ]; then
+ echo "Trouble installing the $python_env python environment"
+ echo "There must be a problem in the $condadir/$condafile conda specification environment file"
+ echo "Change the file and try again"
+ if [[ $domain =~ cgd.* ]]; then
+ pythonpath=`which python`
+ echo
+ echo "On CGD systems you may need to do the following..."
+ echo "Create a bin subdirectory and then link the python version into it..."
+ echo " mkdir $HOME/.conda/envs/$python_env/bin/"
+ echo " ln -s $pythonpath $HOME/.conda/envs/$python_env/bin/python3.7"
+ echo
+ fi
+ exit -2
+fi
+echo "Successfully installed the $python_env python environment"
+echo
+echo "activate the environment by doing the following..."
+echo "conda activate $python_env"
diff --git a/python/Makefile b/python/Makefile
new file mode 100644
index 00000000..c747736f
--- /dev/null
+++ b/python/Makefile
@@ -0,0 +1,62 @@
+# Makefile for running tests on the python code here
+
+# These variables can be overridden from the command-line
+python = not-set
+verbose = not-set
+debug = not-set
+
+ifneq ($(python), not-set)
+ PYTHON=$(python)
+else
+ PYTHON=python3
+endif
+
+ifneq ($(debug), not-set)
+ TEST_ARGS+=--debug
+endif
+ifneq ($(verbose), not-set)
+ TEST_ARGS+=--verbose
+endif
+
+PYLINT=pylint
+PYLINT_ARGS=-j 4 --rcfile=slim/.pylintrc
+DIR_SRC = \
+ slim \
+ ../cime_config/slim_cime_py
+
+all: lint black test
+test: utest stest
+
+.PHONY: utest
+utest: FORCE
+ $(PYTHON) ./run_slim_py_tests $(TEST_ARGS) --unit
+
+.PHONY: stest
+stest: FORCE
+ $(PYTHON) ./run_slim_py_tests $(TEST_ARGS) --sys
+
+.PHONY: lint
+lint: FORCE
+ $(PYLINT) $(PYLINT_ARGS) $(DIR_SRC)
+
+.PHONY: black
+# Run black check on all of the python files here and undeneath.
+# Should be identical to run_black option below, other than the --check option added in
+# Use the black configure file to explicitly set a few things and specifiy the exact files.
+black: FORCE
+ black --check --config pyproject.toml $(DIR_SRC)
+
+.PHONY: run_black
+# Run black on all of the python files here and undeneath -- CHANGING THE FILES!
+# Should be identical to above, other than the "--check" option is removed.
+# Use the black configure file to explicitly set a few things and specifiy the exact files.
+run_black: FORCE
+ black --config pyproject.toml $(DIR_SRC)
+
+
+.PHONY: clean
+clean: FORCE
+ find . -name '*.pyc' -exec rm {} \;
+
+FORCE:
+
diff --git a/python/README.md b/python/README.md
new file mode 100644
index 00000000..ca864cc5
--- /dev/null
+++ b/python/README.md
@@ -0,0 +1,41 @@
+# Testing the code here
+
+## Running everything
+
+To run all tests (unit tests, system tests and pylint), simply run `make
+all` from this directory.
+
+## Python environment
+
+use the "npl" conda environment on cheyenne
+
+## Unit and system tests
+
+Unit and system tests can be run in one of two ways; these do the same
+thing, but support different options:
+
+1. via `make test`
+
+ You can specify a few arguments to this:
+
+ - python version: `make python=python3.9 test` (defaults to `python3`; you should expect errors if trying to run with python2)
+ - verbose: `make verbose=true test`
+ - debug: `make debug=true test`
+
+ Note that unit tests and system tests can be run separately with
+ `make utest` or `make stest`, or they can all be run with `make
+ test`.
+
+2. via `./run_slim_py_tests`
+
+ You can specify various arguments to this; run `./run_slim_py_tests
+ -h` for details
+
+## pylint
+
+You can run pylint on everything in the slim package with `make lint`.
+
+## black
+
+You can run black on everything in the slim package with `make black`.
+
diff --git a/python/conda_env_slim_py.txt b/python/conda_env_slim_py.txt
new file mode 100644
index 00000000..5f165b47
--- /dev/null
+++ b/python/conda_env_slim_py.txt
@@ -0,0 +1,11 @@
+#
+# NOTE: Changes here should be coordinated with the cgd python environment file
+#
+# To install this on cheyenne with conda loaded in modules
+# use the top level bash script:
+# ../py_env_create # Do this each time you update your CTSM Version
+# conda activate ctsm_pylib # Do this anytime you want to run a CTSM python script
+#
+python=3.7.9
+pylint=2.8.3
+black=22.6.0
diff --git a/python/conda_env_slim_py_cgd.txt b/python/conda_env_slim_py_cgd.txt
new file mode 100644
index 00000000..0a2ff073
--- /dev/null
+++ b/python/conda_env_slim_py_cgd.txt
@@ -0,0 +1,12 @@
+# NOTE: This version is just for cgd.ucar.edu systems, where conda limits python to version 3.7.0
+# See issue https://github.com/ESCOMP/CTSM/issues/1792
+#
+# This should be coordinated with the main python environment file!
+#
+# To install this on cheyenne with conda loaded in modules
+# use the top level bash script:
+# ../py_env_create # Do this each time you update your CTSM Version
+#
+python=3.7.0 # The python version MUST match the python version available on CGD systems through modules exactly
+pylint=2.8.3
+black=22.6.0
diff --git a/python/pyproject.toml b/python/pyproject.toml
new file mode 100644
index 00000000..e5abbcb6
--- /dev/null
+++ b/python/pyproject.toml
@@ -0,0 +1,13 @@
+#
+# This is a configuration file for python projects.
+# Sepcifically covering build system requirements.
+#
+# Here we are just using a couple options to specify the operation
+# of the python formatter "black".
+#
+[tool.black]
+
+ line-length = 100 # This is the black default
+ target-version = ['py37']
+ include = '(run_slim_py_tests|\.py$)' # Files to include
+ exclude = '(\.pylintrc|\.pyc)' # Files to explicitly exclude pylint file and compiled python
diff --git a/python/run_slim_py_tests b/python/run_slim_py_tests
new file mode 100755
index 00000000..e609b318
--- /dev/null
+++ b/python/run_slim_py_tests
@@ -0,0 +1,12 @@
+#!/usr/bin/env python3
+"""Driver for running the unit tests of the python code
+
+We use this rather than simply relying on 'python -m unittest discover' so we can do some
+initial setup, like configuring logging, before running the unit tests.
+"""
+
+from slim import add_cime_to_path
+from slim.run_slim_py_tests import main
+
+if __name__ == "__main__":
+ main(__doc__)
diff --git a/python/slim/.pylintrc b/python/slim/.pylintrc
new file mode 100644
index 00000000..0c65eee9
--- /dev/null
+++ b/python/slim/.pylintrc
@@ -0,0 +1,578 @@
+[MASTER]
+
+# A comma-separated list of package or module names from where C extensions may
+# be loaded. Extensions are loading into the active Python interpreter and may
+# run arbitrary code.
+extension-pkg-whitelist=
+
+# Add files or directories to the blacklist. They should be base names, not
+# paths.
+ignore=CVS
+
+# Add files or directories matching the regex patterns to the blacklist. The
+# regex matches against base names, not paths.
+ignore-patterns=
+
+# Python code to execute, usually for sys.path manipulation such as
+# pygtk.require().
+init-hook="import imp, os; imp.load_source('import_hook', os.path.join( "slim", 'import_hook.py'))"
+
+# Use multiple processes to speed up Pylint. Specifying 0 will auto-detect the
+# number of processors available to use.
+jobs=1
+
+# Control the amount of potential inferred values when inferring a single
+# object. This can help the performance when dealing with large functions or
+# complex, nested conditions.
+limit-inference-results=100
+
+# List of plugins (as comma separated values of python modules names) to load,
+# usually to register additional checkers.
+load-plugins=
+
+# Pickle collected data for later comparisons.
+persistent=yes
+
+# Specify a configuration file.
+#rcfile=
+
+# When enabled, pylint would attempt to guess common misconfiguration and emit
+# user-friendly hints instead of false-positive error messages.
+suggestion-mode=yes
+
+# Allow loading of arbitrary C extensions. Extensions are imported into the
+# active Python interpreter and may run arbitrary code.
+unsafe-load-any-extension=no
+
+
+[MESSAGES CONTROL]
+
+# Only show warnings with the listed confidence levels. Leave empty to show
+# all. Valid levels: HIGH, INFERENCE, INFERENCE_FAILURE, UNDEFINED.
+confidence=
+
+# Disable the message, report, category or checker with the given id(s). You
+# can either give multiple identifiers separated by comma (,) or put this
+# option multiple times (only on the command line, not in the configuration
+# file where it should appear only once). You can also use "--disable=all" to
+# disable everything first and then reenable specific checks. For example, if
+# you want to run only the similarities checker, you can use "--disable=all
+# --enable=similarities". If you want to run only the classes checker, but have
+# no Warning level messages displayed, use "--disable=all --enable=classes
+# --disable=W".
+disable=print-statement,
+ parameter-unpacking,
+ unpacking-in-except,
+ old-raise-syntax,
+ backtick,
+ long-suffix,
+ old-ne-operator,
+ old-octal-literal,
+ import-star-module-level,
+ non-ascii-bytes-literal,
+ raw-checker-failed,
+ bad-inline-option,
+ locally-disabled,
+ locally-enabled,
+ file-ignored,
+ suppressed-message,
+ useless-suppression,
+ deprecated-pragma,
+ use-symbolic-message-instead,
+ apply-builtin,
+ basestring-builtin,
+ buffer-builtin,
+ cmp-builtin,
+ coerce-builtin,
+ execfile-builtin,
+ file-builtin,
+ long-builtin,
+ raw_input-builtin,
+ reduce-builtin,
+ standarderror-builtin,
+ unicode-builtin,
+ xrange-builtin,
+ coerce-method,
+ delslice-method,
+ getslice-method,
+ setslice-method,
+ no-absolute-import,
+ old-division,
+ dict-iter-method,
+ dict-view-method,
+ next-method-called,
+ metaclass-assignment,
+ indexing-exception,
+ raising-string,
+ reload-builtin,
+ oct-method,
+ hex-method,
+ nonzero-method,
+ cmp-method,
+ input-builtin,
+ round-builtin,
+ intern-builtin,
+ unichr-builtin,
+ map-builtin-not-iterating,
+ zip-builtin-not-iterating,
+ range-builtin-not-iterating,
+ filter-builtin-not-iterating,
+ using-cmp-argument,
+ eq-without-hash,
+ div-method,
+ idiv-method,
+ rdiv-method,
+ exception-message-attribute,
+ invalid-str-codec,
+ sys-max-int,
+ bad-python3-import,
+ deprecated-string-function,
+ deprecated-str-translate-call,
+ deprecated-itertools-function,
+ deprecated-types-field,
+ next-method-defined,
+ dict-items-not-iterating,
+ dict-keys-not-iterating,
+ dict-values-not-iterating,
+ deprecated-operator-function,
+ deprecated-urllib-function,
+ xreadlines-attribute,
+ deprecated-sys-function,
+ exception-escape,
+ comprehension-escape,
+ R0801, # This option to the end are options required to use black formatter
+ W1515,
+ W1514,
+ R1732,
+ C0209,
+ C0326, # This and the next are the two options that black documentation tells us to ignore
+ C0330, # This is an option that the formatter "black" requires us to disable
+# --- default list is above here, our own list is below here ---
+# While pylint's recommendations to keep the number of arguments, local
+# variables and branches low is generally a good one, I don't want it to
+# be enforced, because there are times when it's okay to break these:
+ too-many-arguments,
+ too-many-branches,
+ too-many-locals,
+# Allow inheriting from object for the sake of python 2/3 compatibility (we need explicit inheritance from object in python2 to give new-style classes):
+ useless-object-inheritance
+
+# Enable the message, report, category or checker with the given id(s). You can
+# either give multiple identifier separated by comma (,) or put this option
+# multiple time (only on the command line, not in the configuration file where
+# it should appear only once). See also the "--disable" option for examples.
+enable=c-extension-no-member
+
+
+[REPORTS]
+
+# Python expression which should return a note less than 10 (10 is the highest
+# note). You have access to the variables errors warning, statement which
+# respectively contain the number of errors / warnings messages and the total
+# number of statements analyzed. This is used by the global evaluation report
+# (RP0004).
+evaluation=10.0 - ((float(5 * error + warning + refactor + convention) / statement) * 10)
+
+# Template used to display messages. This is a python new-style format string
+# used to format the message information. See doc for all details.
+#msg-template=
+
+# Set the output format. Available formats are text, parseable, colorized, json
+# and msvs (visual studio). You can also give a reporter class, e.g.
+# mypackage.mymodule.MyReporterClass.
+output-format=text
+
+# Tells whether to display a full report or only the messages.
+reports=no
+
+# Activate the evaluation score.
+score=yes
+
+
+[REFACTORING]
+
+# Maximum number of nested blocks for function / method body
+max-nested-blocks=5
+
+# Complete name of functions that never returns. When checking for
+# inconsistent-return-statements if a never returning function is called then
+# it will be considered as an explicit return statement and no message will be
+# printed.
+never-returning-functions=sys.exit
+
+
+[LOGGING]
+
+# Logging modules to check that the string format arguments are in logging
+# function parameter format.
+logging-modules=logging
+
+
+[SPELLING]
+
+# Limits count of emitted suggestions for spelling mistakes.
+max-spelling-suggestions=4
+
+# Spelling dictionary name. Available dictionaries: none. To make it working
+# install python-enchant package..
+spelling-dict=
+
+# List of comma separated words that should not be checked.
+spelling-ignore-words=
+
+# A path to a file that contains private dictionary; one word per line.
+spelling-private-dict-file=
+
+# Tells whether to store unknown words to indicated private dictionary in
+# --spelling-private-dict-file option instead of raising a message.
+spelling-store-unknown-words=no
+
+
+[MISCELLANEOUS]
+
+# List of note tags to take in consideration, separated by a comma.
+notes=FIXME,
+ XXX
+# Removing TODO so we can use that to note long-term to do items
+ # TODO
+
+
+[TYPECHECK]
+
+# List of decorators that produce context managers, such as
+# contextlib.contextmanager. Add to this list to register other decorators that
+# produce valid context managers.
+contextmanager-decorators=contextlib.contextmanager
+
+# List of members which are set dynamically and missed by pylint inference
+# system, and so shouldn't trigger E1101 when accessed. Python regular
+# expressions are accepted.
+generated-members=
+
+# Tells whether missing members accessed in mixin class should be ignored. A
+# mixin class is detected if its name ends with "mixin" (case insensitive).
+ignore-mixin-members=yes
+
+# Tells whether to warn about missing members when the owner of the attribute
+# is inferred to be None.
+ignore-none=yes
+
+# This flag controls whether pylint should warn about no-member and similar
+# checks whenever an opaque object is returned when inferring. The inference
+# can return multiple potential results while evaluating a Python object, but
+# some branches might not be evaluated, which results in partial inference. In
+# that case, it might be useful to still emit no-member and other checks for
+# the rest of the inferred objects.
+ignore-on-opaque-inference=yes
+
+# List of class names for which member attributes should not be checked (useful
+# for classes with dynamically set attributes). This supports the use of
+# qualified names.
+ignored-classes=optparse.Values,thread._local,_thread._local
+
+# List of module names for which member attributes should not be checked
+# (useful for modules/projects where namespaces are manipulated during runtime
+# and thus existing member attributes cannot be deduced by static analysis. It
+# supports qualified module names, as well as Unix pattern matching.
+ignored-modules=
+
+# Show a hint with possible names when a member name was not found. The aspect
+# of finding the hint is based on edit distance.
+missing-member-hint=yes
+
+# The minimum edit distance a name should have in order to be considered a
+# similar match for a missing member name.
+missing-member-hint-distance=1
+
+# The total number of similar names that should be taken in consideration when
+# showing a hint for a missing member.
+missing-member-max-choices=1
+
+
+[VARIABLES]
+
+# List of additional names supposed to be defined in builtins. Remember that
+# you should avoid to define new builtins when possible.
+additional-builtins=
+
+# Tells whether unused global variables should be treated as a violation.
+allow-global-unused-variables=yes
+
+# List of strings which can identify a callback function by name. A callback
+# name must start or end with one of those strings.
+callbacks=cb_,
+ _cb
+
+# A regular expression matching the name of dummy variables (i.e. expected to
+# not be used).
+dummy-variables-rgx=_+$|(_[a-zA-Z0-9_]*[a-zA-Z0-9]+?$)|dummy|^ignored_|^unused_
+
+# Argument names that match this expression will be ignored. Default to name
+# with leading underscore.
+ignored-argument-names=_.*|^ignored_|^unused_
+
+# Tells whether we should check for unused import in __init__ files.
+init-import=no
+
+# List of qualified module names which can have objects that can redefine
+# builtins.
+redefining-builtins-modules=six.moves,past.builtins,future.builtins,builtins,io
+
+
+[FORMAT]
+
+# Expected format of line ending, e.g. empty (any line ending), LF or CRLF.
+expected-line-ending-format=
+
+# Regexp for a line that is allowed to be longer than the limit.
+ignore-long-lines=^\s*(# )??$
+
+# Number of spaces of indent required inside a hanging or continued line.
+indent-after-paren=4
+
+# String used as indentation unit. This is usually " " (4 spaces) or "\t" (1
+# tab).
+indent-string=' '
+
+# Maximum number of characters on a single line.
+max-line-length=100 # Make sure this agrees with black
+
+# Maximum number of lines in a module.
+max-module-lines=1000
+
+# List of optional constructs for which whitespace checking is disabled. `dict-
+# separator` is used to allow tabulation in dicts, etc.: {1 : 1,\n222: 2}.
+# `trailing-comma` allows a space between comma and closing bracket: (a, ).
+# `empty-line` allows space-only lines.
+no-space-check=trailing-comma,
+ dict-separator
+
+# Allow the body of a class to be on the same line as the declaration if body
+# contains single statement.
+single-line-class-stmt=no
+
+# Allow the body of an if to be on the same line as the test if there is no
+# else.
+single-line-if-stmt=no
+
+
+[SIMILARITIES]
+
+# Ignore comments when computing similarities.
+ignore-comments=yes
+
+# Ignore docstrings when computing similarities.
+ignore-docstrings=yes
+
+# Ignore imports when computing similarities.
+ignore-imports=no
+
+# Minimum lines number of a similarity.
+min-similarity-lines=4
+
+
+[BASIC]
+
+# Naming style matching correct argument names.
+argument-naming-style=snake_case
+
+# Regular expression matching correct argument names. Overrides argument-
+# naming-style.
+#argument-rgx=
+
+# Naming style matching correct attribute names.
+attr-naming-style=snake_case
+
+# Regular expression matching correct attribute names. Overrides attr-naming-
+# style.
+#attr-rgx=
+
+# Bad variable names which should always be refused, separated by a comma.
+bad-names=foo,
+ bar,
+ baz,
+ toto,
+ tutu,
+ tata
+
+# Naming style matching correct class attribute names.
+class-attribute-naming-style=any
+
+# Regular expression matching correct class attribute names. Overrides class-
+# attribute-naming-style.
+#class-attribute-rgx=
+
+# Naming style matching correct class names.
+class-naming-style=PascalCase
+
+# Regular expression matching correct class names. Overrides class-naming-
+# style.
+#class-rgx=
+
+# Naming style matching correct constant names.
+const-naming-style=UPPER_CASE
+
+# Regular expression matching correct constant names. Overrides const-naming-
+# style.
+#const-rgx=
+
+# Minimum line length for functions/classes that require docstrings, shorter
+# ones are exempt.
+docstring-min-length=-1
+
+# Naming style matching correct function names.
+function-naming-style=snake_case
+
+# Regular expression matching correct function names. Overrides function-
+# naming-style.
+#function-rgx=
+
+# Good variable names which should always be accepted, separated by a comma.
+good-names=i,
+ j,
+ k,
+ ex,
+ Run,
+ _,
+# --- default list is above here, our own list is below here ---
+# Allow logger as a global name in each module, because this seems to follow general recommended convention:
+ logger
+
+# Include a hint for the correct naming format with invalid-name.
+include-naming-hint=no
+
+# Naming style matching correct inline iteration names.
+inlinevar-naming-style=any
+
+# Regular expression matching correct inline iteration names. Overrides
+# inlinevar-naming-style.
+#inlinevar-rgx=
+
+# Naming style matching correct method names.
+method-naming-style=snake_case
+
+# Regular expression matching correct method names. Overrides method-naming-
+# style.
+#method-rgx=
+
+# Naming style matching correct module names.
+module-naming-style=snake_case
+
+# Regular expression matching correct module names. Overrides module-naming-
+# style.
+#module-rgx=
+
+# Colon-delimited sets of names that determine each other's naming style when
+# the name regexes allow several styles.
+name-group=
+
+# Regular expression which should only match function or class names that do
+# not require a docstring.
+no-docstring-rgx=^_
+
+# List of decorators that produce properties, such as abc.abstractproperty. Add
+# to this list to register other decorators that produce valid properties.
+# These decorators are taken in consideration only for invalid-name.
+property-classes=abc.abstractproperty
+
+# Naming style matching correct variable names.
+variable-naming-style=snake_case
+
+# Regular expression matching correct variable names. Overrides variable-
+# naming-style.
+#variable-rgx=
+
+
+[IMPORTS]
+
+# Allow wildcard imports from modules that define __all__.
+allow-wildcard-with-all=no
+
+# Analyse import fallback blocks. This can be used to support both Python 2 and
+# 3 compatible code, which means that the block might have code that exists
+# only in one or another interpreter, leading to false positives when analysed.
+analyse-fallback-blocks=no
+
+# Deprecated modules which should not be used, separated by a comma.
+deprecated-modules=optparse,tkinter.tix
+
+# Create a graph of external dependencies in the given file (report RP0402 must
+# not be disabled).
+ext-import-graph=
+
+# Create a graph of every (i.e. internal and external) dependencies in the
+# given file (report RP0402 must not be disabled).
+import-graph=
+
+# Create a graph of internal dependencies in the given file (report RP0402 must
+# not be disabled).
+int-import-graph=
+
+# Force import order to recognize a module as part of the standard
+# compatibility libraries.
+known-standard-library=
+
+# Force import order to recognize a module as part of a third party library.
+known-third-party=enchant
+
+
+[CLASSES]
+
+# List of method names used to declare (i.e. assign) instance attributes.
+defining-attr-methods=__init__,
+ __new__,
+ setUp
+
+# List of member names, which should be excluded from the protected access
+# warning.
+exclude-protected=_asdict,
+ _fields,
+ _replace,
+ _source,
+ _make
+
+# List of valid names for the first argument in a class method.
+valid-classmethod-first-arg=cls
+
+# List of valid names for the first argument in a metaclass class method.
+valid-metaclass-classmethod-first-arg=cls
+
+
+[DESIGN]
+
+# Maximum number of arguments for function / method.
+max-args=5
+
+# Maximum number of attributes for a class (see R0902).
+max-attributes=7
+
+# Maximum number of boolean expressions in an if statement.
+max-bool-expr=5
+
+# Maximum number of branch for function / method body.
+max-branches=12
+
+# Maximum number of locals for function / method body.
+max-locals=15
+
+# Maximum number of parents for a class (see R0901).
+max-parents=7
+
+# Maximum number of public methods for a class (see R0904).
+max-public-methods=20
+
+# Maximum number of return / yield for function / method body.
+max-returns=6
+
+# Maximum number of statements in function / method body.
+max-statements=50
+
+# Minimum number of public methods for a class (see R0903).
+min-public-methods=2
+
+
+[EXCEPTIONS]
+
+# Exceptions that will emit a warning when being caught. Defaults to
+# "Exception".
+overgeneral-exceptions=Exception
diff --git a/python/slim/__init__.py b/python/slim/__init__.py
new file mode 100644
index 00000000..e69de29b
diff --git a/python/slim/add_cime_to_path.py b/python/slim/add_cime_to_path.py
new file mode 100644
index 00000000..c5998889
--- /dev/null
+++ b/python/slim/add_cime_to_path.py
@@ -0,0 +1,26 @@
+"""Adds cime lib to path
+
+Any file that can potentially be run as a top-level script (with an if __name__ ==
+'__main__' block) that needs cime should import this. This includes unit test
+modules. However: see the NOTE at the bottom of this documentation.
+
+This should be the very first slim module imported. That way, cime will be added to your
+path before other imports. That is, your script should have:
+
+# Standard library imports go here
+# Then something like this:
+_SLIM_PYTHON = os.path.join(os.path.dirname(os.path.abspath(__file__)), 'python')
+sys.path.insert(1, _SLIM_PYTHON)
+# Then:
+from slim import add_cime_to_path
+
+NOTE: For top-level scripts that either (a) want to pass some argument(s) to
+add_cime_lib_to_path, or (b) want to store the returned value from add_cime_lib_to_path:
+they should include copies of what's in this module (adding the appropriate argument(s)),
+rather than actually importing this module. So this module should be viewed as a
+convenience that can be used by scripts with simple needs, but does not need to be used.
+"""
+
+from slim.path_utils import add_cime_lib_to_path
+
+_ = add_cime_lib_to_path()
diff --git a/python/slim/add_slim_cime_py_to_path.py b/python/slim/add_slim_cime_py_to_path.py
new file mode 100644
index 00000000..824c4558
--- /dev/null
+++ b/python/slim/add_slim_cime_py_to_path.py
@@ -0,0 +1,17 @@
+"""Adds slim_cime_py lib to path
+
+Any file that can potentially be run as a top-level script (with an if __name__ ==
+'__main__' block) that needs slim_cime_py should import this. This includes unit test
+modules.
+
+This should be the very first slim module imported. That way, slim_cime_py will be added to your
+path before other imports. That is, your script should have:
+
+# Standard library imports go here
+# Then:
+from slim import add_slim_cime_py_to_path
+"""
+
+from slim.path_utils import add_slim_cime_pylib_to_path
+
+_ = add_slim_cime_pylib_to_path()
diff --git a/python/slim/config_utils.py b/python/slim/config_utils.py
new file mode 100644
index 00000000..857fd746
--- /dev/null
+++ b/python/slim/config_utils.py
@@ -0,0 +1,162 @@
+"""
+General-purpose utilities and functions for handling command-line
+config files in slim python codes.
+"""
+
+import logging
+import configparser
+
+from slim.utils import abort
+
+logger = logging.getLogger(__name__)
+
+# This string is used in the out-of-the-box slim.cfg and modify.cfg files
+# to denote a value that needs to be filled in
+_CONFIG_PLACEHOLDER = "FILL_THIS_IN"
+# This string is used in the out-of-the-box slim.cfg and modify.cfg files
+# to denote a value that can be filled in, but doesn't absolutely need to be
+_CONFIG_UNSET = "UNSET"
+
+
+def lon_range_0_to_360(lon_in):
+ """
+ Description
+ -----------
+ Restrict longitude to 0 to 360 when given as -180 to 180.
+ """
+ if -180 <= lon_in < 0:
+ lon_out = lon_in % 360
+ logger.info(
+ "Resetting longitude from %s to %s to keep in the range " " 0 to 360",
+ str(lon_in),
+ str(lon_out),
+ )
+ elif 0 <= lon_in <= 360 or lon_in is None:
+ lon_out = lon_in
+ else:
+ errmsg = "lon_in needs to be in the range 0 to 360"
+ abort(errmsg)
+
+ return lon_out
+
+
+def get_config_value(
+ config,
+ section,
+ item,
+ file_path,
+ allowed_values=None,
+ default=None,
+ is_list=False,
+ convert_to_type=None,
+ can_be_unset=False,
+):
+ """Get a given item from a given section of the config object
+ Give a helpful error message if we can't find the given section or item
+ Note that the file_path argument is only used for the sake of the error message
+ If allowed_values is present, it should be a list of strings giving allowed values
+ The function _handle_config_value determines what to do if we read:
+ - a list or
+ - a str that needs to be converted to int / float / bool
+ - _CONFIG_UNSET: anything with the value "UNSET" will become "None"
+ """
+ try:
+ val = config.get(section, item)
+ except configparser.NoSectionError:
+ abort("ERROR: Config file {} must contain section '{}'".format(file_path, section))
+ except configparser.NoOptionError:
+ abort(
+ "ERROR: Config file {} must contain item '{}' in section '{}'".format(
+ file_path, item, section
+ )
+ )
+
+ if val == _CONFIG_PLACEHOLDER:
+ abort("Error: {} needs to be specified in config file {}".format(item, file_path))
+
+ val = _handle_config_value(
+ var=val,
+ default=default,
+ item=item,
+ is_list=is_list,
+ convert_to_type=convert_to_type,
+ can_be_unset=can_be_unset,
+ allowed_values=allowed_values,
+ )
+ return val
+
+
+def _handle_config_value(
+ var, default, item, is_list, convert_to_type, can_be_unset, allowed_values
+):
+ """
+ Description
+ -----------
+ Assign the default value or the user-specified one to var.
+ Convert from default type (str) to reqested type (int or float).
+
+ If is_list is True, then default should be a list
+ """
+ if var == _CONFIG_UNSET:
+ if can_be_unset:
+ return default # default may be None
+ abort("Must set a value for .cfg file variable: {}".format(item))
+
+ # convert string to list of strings; if there is just one element,
+ # we will get a list of size one, which we will convert back to a
+ # scalar later if needed
+ var = var.split()
+
+ if convert_to_type is bool:
+ try:
+ var = [_convert_to_bool(v) for v in var]
+ except ValueError:
+ abort("Non-boolean value found for .cfg file variable: {}".format(item))
+ elif convert_to_type is not None:
+ try:
+ var = [convert_to_type(v) for v in var]
+ except ValueError:
+ abort("Wrong type for .cfg file variable: {}".format(item))
+
+ if allowed_values is not None:
+ for val in var:
+ if val not in allowed_values:
+ print("val = ", val, " in var not in allowed_values")
+ errmsg = (
+ "{} is not an allowed value for {} in .cfg file. "
+ "Check allowed_values".format(val, item)
+ )
+ abort(errmsg)
+
+ if not is_list:
+ if len(var) > 1:
+ abort("More than 1 element found for .cfg file variable: {}".format(item))
+ var = var[0]
+
+ return var
+
+
+def _convert_to_bool(var):
+ """
+ Function for converting different forms of
+ boolean strings to boolean value.
+
+ Args:
+ var (str): String bool input
+
+ Raises:
+ if the argument is not an acceptable boolean string
+ (such as yes or no ; true or false ; y or n ; t or f ; 0 or 1).
+ ValueError: The string should be one of the mentioned values.
+
+ Returns:
+ var_out (bool): Boolean value corresponding to the input.
+ """
+ if var.lower() in ("yes", "true", "t", "y", "1", "on"):
+ var_out = True
+ elif var.lower() in ("no", "false", "f", "n", "0", "off"):
+ var_out = False
+ else:
+ raise ValueError("Boolean value expected. [true or false] or [y or n]")
+
+ return var_out
diff --git a/python/slim/git_utils.py b/python/slim/git_utils.py
new file mode 100644
index 00000000..c4c5cbe1
--- /dev/null
+++ b/python/slim/git_utils.py
@@ -0,0 +1,61 @@
+"""General-purpose git utility functions"""
+
+import logging
+import subprocess
+
+from slim.path_utils import path_to_slim_root
+
+logger = logging.getLogger(__name__)
+
+
+def get_slim_git_short_hash():
+ """
+ Returns Git short SHA for the SLIM repository.
+
+ Args:
+
+ Raises:
+
+ Returns:
+ sha (str) : git short hash for slim repository
+ """
+ sha = (
+ subprocess.check_output(["git", "-C", path_to_slim_root(), "rev-parse", "--short", "HEAD"])
+ .strip()
+ .decode()
+ )
+ return sha
+
+
+def get_slim_git_long_hash():
+ """
+ Returns Git long SHA for the SLIM repository.
+
+ Args:
+
+ Raises:
+
+ Returns:
+ sha (str) : git long hash for slim repository
+ """
+ sha = (
+ subprocess.check_output(["git", "-C", path_to_slim_root(), "rev-parse", "HEAD"])
+ .strip()
+ .decode()
+ )
+ return sha
+
+
+def get_slim_git_describe():
+ """
+ Function for giving the recent tag of the SLIM repository
+
+ Args:
+
+ Raises:
+
+ Returns:
+ label (str) : ouput of running 'git describe' for the SLIM repository
+ """
+ label = subprocess.check_output(["git", "-C", path_to_slim_root(), "describe"]).strip().decode()
+ return label
diff --git a/python/slim/import_hook.py b/python/slim/import_hook.py
new file mode 100644
index 00000000..955e6bae
--- /dev/null
+++ b/python/slim/import_hook.py
@@ -0,0 +1,7 @@
+# pylint: disable=missing-module-docstring
+import sys
+import os
+
+_CIMEROOT = os.path.join(os.path.dirname(os.path.abspath(__file__)), "..", "..", "cime")
+_LIB_DIR = os.path.join(_CIMEROOT, "scripts", "lib")
+sys.path.append(_LIB_DIR)
diff --git a/python/slim/mksurdat/__init__.py b/python/slim/mksurdat/__init__.py
new file mode 100644
index 00000000..e69de29b
diff --git a/python/slim/mksurdat/mksurdat.ipynb b/python/slim/mksurdat/mksurdat.ipynb
new file mode 100644
index 00000000..d774262c
--- /dev/null
+++ b/python/slim/mksurdat/mksurdat.ipynb
@@ -0,0 +1,608 @@
+{
+ "cells": [
+ {
+ "cell_type": "markdown",
+ "metadata": {},
+ "source": [
+ "# Generate a SLIM surdat file from CTSM output\n",
+ "by S. Levis, \n",
+ "modified from pres_vs_hist_alb_LN_postAGU20190621_corrected_rs.ipynb by Marysa Lague"
+ ]
+ },
+ {
+ "cell_type": "code",
+ "execution_count": 1,
+ "metadata": {},
+ "outputs": [],
+ "source": [
+ "import os\n",
+ "import sys\n",
+ "\n",
+ "import time as tm\n",
+ "from copy import copy \n",
+ "\n",
+ "import netCDF4 as nc\n",
+ "import xarray as xr\n",
+ "import numpy as np"
+ ]
+ },
+ {
+ "cell_type": "markdown",
+ "metadata": {},
+ "source": [
+ "## USER MODIFY (first)"
+ ]
+ },
+ {
+ "cell_type": "code",
+ "execution_count": 2,
+ "metadata": {},
+ "outputs": [
+ {
+ "name": "stdout",
+ "output_type": "stream",
+ "text": [
+ "12\n"
+ ]
+ }
+ ],
+ "source": [
+ "# Name of simulation to provide data for the SLIM surdat file generated by this tool\n",
+ "# Simulation must be a bgc case, so as to include the history variable HTOP\n",
+ "casename = 'ihist_bgccrop' # USER MODIFY\n",
+ "\n",
+ "# This tool assumes that it will access files in the user's\n",
+ "# /glade/scratch//archive/ directories\n",
+ "# User may need to modify\n",
+ "username = os.environ.get('USER')\n",
+ "case_archive_dir = '/glade/scratch/' + username + '/archive/' + casename\n",
+ "ctsm_dir = case_archive_dir + '/lnd/hist/'\n",
+ "cpl_dir = case_archive_dir + '/cpl/hist/'\n",
+ "\n",
+ "# USER-GENERATED FILES\n",
+ "# 1) Currently required: CTSM\n",
+ "# nco-generated monthly means of ctsm history files\n",
+ "# assumed file name is .clm2.h0.nc\n",
+ "# Sample use of nco to concatenate 12 months of a single year:\n",
+ "# ncecat .clm2.h0.-* .clm2.h0.nc\n",
+ "# nco user's guide: https://nco.sourceforge.net/\n",
+ "ctsm_concatenated_file = ctsm_dir + casename + '.clm2.h0.nc' # USER may need to modify\n",
+ "\n",
+ "if os.path.exists(ctsm_concatenated_file):\n",
+ " ds = xr.open_dataset(ctsm_concatenated_file, decode_times=False)\n",
+ "else:\n",
+ " errmsg = \"ctsm_concatenated_file does not exist: \" + ctsm_concatenated_file\n",
+ " sys.exit(errmsg)\n",
+ "\n",
+ "ds['time'] = ds['record'] # ncecat (a few lines up) introduced the \"record\" dimension\n",
+ "lat_ctsm = ds.variables['lat'].values[:] # getting lat\n",
+ "lon_ctsm = ds.variables['lon'].values[:] # getting lon\n",
+ "landmask = ds.landmask.values[0,:,:] # getting landmask\n",
+ "dims = np.shape(landmask)\n",
+ "months_per_yr = len(ds['time'].values)\n",
+ "print(months_per_yr) # expect 12\n",
+ "\n",
+ "# 2) Optional: CPL\n",
+ "# nco-generated monthly means of coupler history files\n",
+ "# assumed file name is .cpl.h0.nc\n",
+ "# additional nco information a few lines up\n",
+ "# if dust_file does not exist, dust fluxes will be set to zero (later)\n",
+ "dust_file = cpl_dir + casename + '.cpl.h0.nc' # USER may need to modify"
+ ]
+ },
+ {
+ "cell_type": "markdown",
+ "metadata": {},
+ "source": [
+ "## USER MODIFY (last)"
+ ]
+ },
+ {
+ "cell_type": "code",
+ "execution_count": 3,
+ "metadata": {},
+ "outputs": [],
+ "source": [
+ "# Optional: ctsm fsurdat file from the simulation that produced the ctsm history a few lines up\n",
+ "surfdat_dir ='/glade/p/cesmdata/cseg/inputdata/lnd/clm2/surfdata_map/release-clm5.0.18/' # USER may need to modify\n",
+ "surfdat_file = surfdat_dir + 'surfdata_0.9x1.25_hist_78pfts_CMIP6_simyr2000_c190214.nc' # USER may wish to modify\n",
+ "\n",
+ "# If ctsm fsurdat file does not exist, glc_mask will equal zero everywhere\n",
+ "glc_mask = np.zeros(dims)\n",
+ "if os.path.exists(surfdat_file):\n",
+ " surfdat_ds = xr.open_dataset(surfdat_file)\n",
+ " # get glacier mask\n",
+ " glc_pct = (surfdat_ds.variables['PCT_GLACIER']).values[:]\n",
+ " # apply the glacier mask where glc_pct > 50% \n",
+ " glc_mask[glc_pct > 50] = 1\n",
+ "else:\n",
+ " surfdata_file = ''"
+ ]
+ },
+ {
+ "cell_type": "markdown",
+ "metadata": {},
+ "source": [
+ "### add mask information to the dataset"
+ ]
+ },
+ {
+ "cell_type": "code",
+ "execution_count": 4,
+ "metadata": {},
+ "outputs": [],
+ "source": [
+ "dirt_mask = np.where((landmask==1.) & (glc_mask==0.), 1.0, 0.0)\n",
+ "ds['glc_mask'] = xr.DataArray(dims=['lat','lon'], data=glc_mask)\n",
+ "ds['bareground_mask'] = xr.DataArray(dims=['lat','lon'], data=dirt_mask)"
+ ]
+ },
+ {
+ "cell_type": "markdown",
+ "metadata": {},
+ "source": [
+ "### calculations of variables that will end up in the SLIM surdat file"
+ ]
+ },
+ {
+ "cell_type": "code",
+ "execution_count": 5,
+ "metadata": {},
+ "outputs": [],
+ "source": [
+ "# ctsm history variables used in this script\n",
+ "# lndvars = ['FSR','FSDS','GSSHA','GSSUN','GSSHALN','GSSUNLN','TLAI','HTOP',\n",
+ "# 'LAISUN','LAISHA','SNOW_DEPTH',\n",
+ "# 'FSRND','FSRNI','FSRVD','FSRVI',\n",
+ "# 'FSDSND','FSDSNI','FSDSVD','FSDSVI' ]\n",
+ "\n",
+ "# Construct albedos from sw reflected / down:\n",
+ "#-------ALBEDO------#\n",
+ "nameswap = {}\n",
+ "nameswap['FSR'] = 'ALBEDO'\n",
+ "# albedo:\n",
+ "ds_temp = xr.merge([ds['FSR'], ds['FSDS']])\n",
+ "ds_temp['ALBEDO'] = ds_temp['FSR'] / ds_temp['FSDS']\n",
+ "ds_temp['ALBEDO'].attrs['units'] = 'unitless'\n",
+ "ds_temp['ALBEDO'].attrs['longname'] = 'multistream albedo'\n",
+ "ds['ALBEDO'] = ds_temp['ALBEDO']\n",
+ "\n",
+ "ds_temp = xr.merge([ds['FSRND'], ds['FSDSND']])\n",
+ "ds_temp['ALBEDO_ND'] = ds_temp['FSRND'] / ds_temp['FSDSND']\n",
+ "ds_temp['ALBEDO_ND'].attrs['units'] = 'unitless'\n",
+ "ds_temp['ALBEDO_ND'].attrs['longname'] = 'near-IR direct albedo'\n",
+ "ds['ALBEDO_ND'] = ds_temp['ALBEDO_ND']\n",
+ "\n",
+ "ds_temp = xr.merge([ds['FSRNI'], ds['FSDSNI']])\n",
+ "ds_temp['ALBEDO_NI'] = ds_temp['FSRNI'] / ds_temp['FSDSNI']\n",
+ "ds_temp['ALBEDO_NI'].attrs['units'] = 'unitless'\n",
+ "ds_temp['ALBEDO_NI'].attrs['longname'] = 'near-IR diffuse albedo'\n",
+ "ds['ALBEDO_NI'] = ds_temp['ALBEDO_NI']\n",
+ " \n",
+ "ds_temp = xr.merge([ds['FSRVD'], ds['FSDSVD']])\n",
+ "ds_temp['ALBEDO_VD'] = ds_temp['FSRVD'] / ds_temp['FSDSVD']\n",
+ "ds_temp['ALBEDO_VD'].attrs['units'] = 'unitless'\n",
+ "ds_temp['ALBEDO_VD'].attrs['longname'] = 'visible direct albedo'\n",
+ "ds['ALBEDO_VD'] = ds_temp['ALBEDO_VD']\n",
+ "\n",
+ "ds_temp = xr.merge([ds['FSRVI'], ds['FSDSVI']])\n",
+ "ds_temp['ALBEDO_VI'] = ds_temp['FSRVI'] / ds_temp['FSDSVI']\n",
+ "ds_temp['ALBEDO_VI'].attrs['units'] = 'unitless'\n",
+ "ds_temp['ALBEDO_VI'].attrs['longname'] = 'visible diffuse albedo'\n",
+ "ds['ALBEDO_VI'] = ds_temp['ALBEDO_VI']\n",
+ " \n",
+ "#-------EVAP RS------#\n",
+ "gs_to_rs = 42.3 * 10**6 # umol H20/m2/s to s/m\n",
+ "ds_temp = xr.merge([ds['GSSUNLN'], ds['GSSHALN'], ds['LAISUN'], ds['LAISHA']])\n",
+ "sunLN = ds['GSSUNLN'] * ds['LAISUN']\n",
+ "shaLN = ds['GSSHALN'] * ds['LAISHA']\n",
+ "ds_temp['evap_rs_LN'] = gs_to_rs / (sunLN + shaLN)\n",
+ "ds_temp['evap_rs_LN'].attrs['units'] = 's/m'\n",
+ "ds_temp['evap_rs_LN'].attrs['longname'] = 'evaporative resistance at local noon = (42.3 x 10^6)/(gssunln*laisun + gsshaln*laisha)'\n",
+ "ds['evap_rs_LN'] = ds_temp['evap_rs_LN']\n",
+ " \n",
+ "rs_LN_uncapped = gs_to_rs / (sunLN + shaLN)\n",
+ "rs_LN_capped = rs_LN_uncapped.copy()\n",
+ "rs_LN_capped.values = np.where(rs_LN_uncapped > 1000., 1000., rs_LN_uncapped)\n",
+ "ds_temp['evap_rs_LN_capped'] = rs_LN_capped\n",
+ "ds_temp['evap_rs_LN_capped'].attrs['units'] = 's/m'\n",
+ "ds_temp['evap_rs_LN_capped'].attrs['longname'] = 'evaporative resistance at local noon capped at 1000 s/m; else = (42.3 x 10^6)/(gssunln*laisun + gsshaln*laisha)'\n",
+ "ds['evap_rs_LN_capped'] = ds_temp['evap_rs_LN_capped']\n",
+ " \n",
+ "del ds_temp"
+ ]
+ },
+ {
+ "cell_type": "markdown",
+ "metadata": {},
+ "source": [
+ "### Snow albedos proposed by Marysa L from calculation elsewhere"
+ ]
+ },
+ {
+ "cell_type": "code",
+ "execution_count": 6,
+ "metadata": {},
+ "outputs": [],
+ "source": [
+ "s_alb = {}\n",
+ "s_alb['vd'] = 0.97333038\n",
+ "s_alb['vi'] = 0.965662\n",
+ "s_alb['nd'] = 0.66046935\n",
+ "s_alb['ni'] = 0.7067166"
+ ]
+ },
+ {
+ "cell_type": "markdown",
+ "metadata": {},
+ "source": [
+ "## JJA snowmask"
+ ]
+ },
+ {
+ "cell_type": "code",
+ "execution_count": 7,
+ "metadata": {},
+ "outputs": [],
+ "source": [
+ "snow_thresh = 0.01 # m\n",
+ "snow = ds['SNOW_DEPTH'][6:9,:,:] # JJA\n",
+ "jja_snowfree = np.where(snow > snow_thresh , np.nan , 1.0).mean(axis=0)"
+ ]
+ },
+ {
+ "cell_type": "markdown",
+ "metadata": {},
+ "source": [
+ "## albedo values"
+ ]
+ },
+ {
+ "cell_type": "code",
+ "execution_count": 8,
+ "metadata": {},
+ "outputs": [],
+ "source": [
+ "alb = {}\n",
+ "\n",
+ "alb['vd'] = ds['ALBEDO_VD']\n",
+ "alb['vi'] = ds['ALBEDO_VI']\n",
+ "alb['nd'] = ds['ALBEDO_ND']\n",
+ "alb['ni'] = ds['ALBEDO_NI']\n",
+ "\n",
+ "# make a new albedo field using values anywhere there wasn't snow\n",
+ "nc_alb = {}\n",
+ "nc_alb['ground'] = {}\n",
+ "nc_alb['snow'] = {}\n",
+ "\n",
+ "# do this in np arrays, not datasets\n",
+ "alb_ocn = 0.1 # set ocean points to this generic value\n",
+ "for a in alb.keys():\n",
+ " nc_alb['ground'][a] = np.where(jja_snowfree==1., alb[a], alb[a])\n",
+ " \n",
+ " # put snow albedos where glacier mask is true\n",
+ " nc_alb['ground'][a] = np.where(glc_mask==1., s_alb[a], nc_alb['ground'][a])\n",
+ " \n",
+ " # get rid of nans on ocean points\n",
+ " nc_alb['ground'][a] = np.where(np.isnan(nc_alb['ground'][a]), alb_ocn, nc_alb['ground'][a]).mean(axis=0)\n",
+ " \n",
+ " # snow albedo just a single block of color:\n",
+ " nc_alb['snow'][a] = np.ones(np.shape(landmask)) * s_alb[a]\n",
+ " nc_alb['snow'][a] = np.where(np.isnan(nc_alb['snow'][a]), alb_ocn, nc_alb['snow'][a])"
+ ]
+ },
+ {
+ "cell_type": "markdown",
+ "metadata": {},
+ "source": [
+ "## rs values:"
+ ]
+ },
+ {
+ "cell_type": "code",
+ "execution_count": 9,
+ "metadata": {},
+ "outputs": [],
+ "source": [
+ "nc_rs = {}\n",
+ "nc_rs = ds['evap_rs_LN_capped']\n",
+ "\n",
+ "# eliminate nans: set to 1000\n",
+ "rs_where_nan = 1000\n",
+ "nc_rs = np.where(np.isnan(nc_rs), rs_where_nan, nc_rs)"
+ ]
+ },
+ {
+ "cell_type": "markdown",
+ "metadata": {},
+ "source": [
+ "## hc values:"
+ ]
+ },
+ {
+ "cell_type": "code",
+ "execution_count": 10,
+ "metadata": {},
+ "outputs": [],
+ "source": [
+ "nc_hc = {}\n",
+ "nc_hc = ds['HTOP']\n",
+ "\n",
+ "# eliminate nans: set to 0.01 (very smooth). \n",
+ "hmin=0.01\n",
+ "nc_hc = np.where(np.isnan(nc_hc), hmin, nc_hc)\n",
+ "\n",
+ "# eliminate zeros: messes up the turbulence calculation. Make those smooth, too.\n",
+ "nc_hc = np.where(nc_hc < hmin, hmin, nc_hc)\n",
+ "\n",
+ "# set glacier \"height\" to 0.01\n",
+ "glc_hc = 0.01 # From BATS: glacier roughness 0.01 - constant\n",
+ "nc_hc = np.where(glc_mask==1., glc_hc, nc_hc)"
+ ]
+ },
+ {
+ "cell_type": "markdown",
+ "metadata": {},
+ "source": [
+ "### Other required values"
+ ]
+ },
+ {
+ "cell_type": "code",
+ "execution_count": 11,
+ "metadata": {},
+ "outputs": [],
+ "source": [
+ "if os.path.exists(dust_file):\n",
+ " dust_ds = xr.open_dataset(dust_file)\n",
+ " dust1 = (dust_ds.variables['l2xavg_Fall_flxdst1']).values\n",
+ " dust2 = (dust_ds.variables['l2xavg_Fall_flxdst2']).values\n",
+ " dust3 = (dust_ds.variables['l2xavg_Fall_flxdst3']).values\n",
+ " dust4 = (dust_ds.variables['l2xavg_Fall_flxdst4']).values\n",
+ " # clobber nans\n",
+ " dust1 = np.where(np.isnan(dust1), 0.0, dust1)\n",
+ " dust2 = np.where(np.isnan(dust2), 0.0, dust2)\n",
+ " dust3 = np.where(np.isnan(dust3), 0.0, dust3)\n",
+ " dust4 = np.where(np.isnan(dust4), 0.0, dust4)\n",
+ "else:\n",
+ " dust1 = 0\n",
+ " dust2 = 0\n",
+ " dust3 = 0\n",
+ " dust4 = 0\n",
+ " dust_file = ''"
+ ]
+ },
+ {
+ "cell_type": "code",
+ "execution_count": 12,
+ "metadata": {},
+ "outputs": [],
+ "source": [
+ "soil_cv_str = '2e6'\n",
+ "soil_cv_val = 2.0e6 # [J/m3/K]\n",
+ "soil_tk_val = 1.5 # [W/m/K]\n",
+ "glc_cv = 1.9e6 # [J/m3/K]\n",
+ "glc_tk = 2.4 # [W/m/K]\n",
+ "snow_mask_depth = 50.0 # [kg/m2]\n",
+ "bucket_capacity = 200.0 # [kg/m2]\n",
+ "\n",
+ "# dummy array of ones to extend a lat x lon array into time: mon x lat x lon\n",
+ "stretch = np.ones([months_per_yr, dims[0], dims[1]])"
+ ]
+ },
+ {
+ "cell_type": "markdown",
+ "metadata": {},
+ "source": [
+ "### set up a dictionary called nc_data that stores all the variables to be output"
+ ]
+ },
+ {
+ "cell_type": "code",
+ "execution_count": 13,
+ "metadata": {},
+ "outputs": [],
+ "source": [
+ "nc_data = {} # empty dictionary\n",
+ "\n",
+ "# glacier mask:\n",
+ "nc_data['glc_mask'] = np.copy(glc_mask[:] * stretch)\n",
+ "\n",
+ "# Albedos as alb_[g-ground/s-snow][v-visible/n-nir][d-direct/f-diffuse]\n",
+ "nc_data['alb_gvd'] = nc_alb['ground']['vd'] * stretch\n",
+ "nc_data['alb_svd'] = nc_alb['snow']['vd'] * stretch\n",
+ "nc_data['alb_gnd'] = nc_alb['ground']['nd'] * stretch\n",
+ "nc_data['alb_snd'] = nc_alb['snow']['nd'] * stretch\n",
+ "nc_data['alb_gvf'] = nc_alb['ground']['vi'] * stretch\n",
+ "nc_data['alb_svf'] = nc_alb['snow']['vi'] * stretch\n",
+ "nc_data['alb_gnf'] = nc_alb['ground']['ni'] * stretch\n",
+ "nc_data['alb_snf'] = nc_alb['snow']['ni'] * stretch\n",
+ "\n",
+ "# Bucket capacity in [kg/m2] (or equivalently [mm])\n",
+ "nc_data['bucketdepth'] = np.copy(bucket_capacity * stretch)\n",
+ "\n",
+ "# snow masking \"depth\" in water mass equivalent ([kg/m2] or [mm])\n",
+ "nc_data['snowmask'] = np.copy(snow_mask_depth * stretch)\n",
+ "\n",
+ "# Emissivity (1 = perfect blackbody, not physically realistic)\n",
+ "nc_data['emissivity'] = np.copy(1.0 * stretch)\n",
+ "\n",
+ "# Roughness as \"vegetation height\" [m] (which is then scaled down in the model \n",
+ "# as .1*veg height for actual roughness used)\n",
+ "nc_data['roughness'] = nc_hc.mean(axis=0) * stretch\n",
+ "\n",
+ "# evaporative resistance [s/m] as a sort of \"bulk stomatal resistance\" - actual\n",
+ "# resistance is calculated as a combination of this and how full the bucket is\n",
+ "# Initial pass, set all roughness to 100 (this is our \"base\" for glaciers also)\n",
+ "nc_data['evap_res'] = nc_rs.mean(axis=0) * stretch\n",
+ "\n",
+ "# Dust fluxes (from clm4.5 coupled run). There are 4 different dust bins, each\n",
+ "# is given its own field here, to avoid problems I ran into trying to read\n",
+ "# netcdf fields with depth dimensions in the actual model code\n",
+ "nc_data['l2xavg_Fall_flxdst1'] = np.copy(dust1 * stretch)\n",
+ "nc_data['l2xavg_Fall_flxdst2'] = np.copy(dust2 * stretch)\n",
+ "nc_data['l2xavg_Fall_flxdst3'] = np.copy(dust3 * stretch)\n",
+ "nc_data['l2xavg_Fall_flxdst4'] = np.copy(dust4 * stretch)\n",
+ "\n",
+ "# Soil Type (not used, set to 0)\n",
+ "nc_data['soil_type'] = np.copy(0.0 * stretch)\n",
+ "\n",
+ "# Thermal Properties\n",
+ "# soil heat capacity cv [J/m3/K] (uniform across column using this definition)\n",
+ "# ranges: 1.5e6 for gravel to 3 for clay/silt; 4.2 for water (if we go very saturated, but the dirt'll still be in there...)\n",
+ "nc_data['soil_cv_1d'] = np.copy(soil_cv_val * stretch)\n",
+ "\n",
+ "# soil thermal conductivity tk [W/m/K] (uniform across column using this definition)\n",
+ "nc_data['soil_tk_1d'] = np.copy(soil_tk_val * stretch)\n",
+ "\n",
+ "# ice (glacier) heat capacity cv [J/m3/K] (uniform across column using this definition)\n",
+ "# cv water = 4.188e6 , cv ice = 1.9415e+06 \n",
+ "# near -20 C\n",
+ "nc_data['glc_cv_1d'] = np.copy(glc_cv * stretch)\n",
+ "\n",
+ "# ice (glacier) thermal conductivity tk [W/m/K] (uniform across column using this definition)\n",
+ "# near -20 C\n",
+ "nc_data['glc_tk_1d'] = np.copy(glc_tk * stretch)"
+ ]
+ },
+ {
+ "cell_type": "markdown",
+ "metadata": {},
+ "source": [
+ "## Put all the vars into an xarray dataset"
+ ]
+ },
+ {
+ "cell_type": "code",
+ "execution_count": 14,
+ "metadata": {},
+ "outputs": [],
+ "source": [
+ "# Define a time vector for months 1-12\n",
+ "time_vect = range(months_per_yr + 1)[1:months_per_yr + 1]\n",
+ "\n",
+ "# Prepare dataset to be written out to file\n",
+ "ds_slim = {}\n",
+ "ds_slim = xr.Dataset({'glc_mask': (['time','lsmlat','lsmlon'], nc_data['glc_mask']),\n",
+ " 'alb_gvd': (['time','lsmlat','lsmlon'], nc_data['alb_gvd']),\n",
+ " 'alb_svd': (['time','lsmlat','lsmlon'], nc_data['alb_svd']),\n",
+ " 'alb_gnd': (['time','lsmlat','lsmlon'], nc_data['alb_gnd']),\n",
+ " 'alb_snd': (['time','lsmlat','lsmlon'], nc_data['alb_snd']),\n",
+ " 'alb_gvf': (['time','lsmlat','lsmlon'], nc_data['alb_gvf']),\n",
+ " 'alb_svf': (['time','lsmlat','lsmlon'], nc_data['alb_svf']),\n",
+ " 'alb_gnf': (['time','lsmlat','lsmlon'], nc_data['alb_gnf']),\n",
+ " 'alb_snf': (['time','lsmlat','lsmlon'], nc_data['alb_snf']),\n",
+ " 'bucketdepth': (['time','lsmlat','lsmlon'], nc_data['bucketdepth']),\n",
+ " 'emissivity': (['time','lsmlat','lsmlon'], nc_data['emissivity']),\n",
+ " 'snowmask': (['time','lsmlat','lsmlon'], nc_data['snowmask']), \n",
+ " 'roughness': (['time','lsmlat','lsmlon'], nc_data['roughness']),\n",
+ " 'evap_res': (['time','lsmlat','lsmlon'], nc_data['evap_res']),\n",
+ " 'l2xavg_Fall_flxdst1': (['time','lsmlat','lsmlon'], nc_data['l2xavg_Fall_flxdst1']),\n",
+ " 'l2xavg_Fall_flxdst2': (['time','lsmlat','lsmlon'], nc_data['l2xavg_Fall_flxdst2']),\n",
+ " 'l2xavg_Fall_flxdst3': (['time','lsmlat','lsmlon'], nc_data['l2xavg_Fall_flxdst3']),\n",
+ " 'l2xavg_Fall_flxdst4': (['time','lsmlat','lsmlon'], nc_data['l2xavg_Fall_flxdst4']),\n",
+ " 'soil_type': (['time','lsmlat','lsmlon'], nc_data['soil_type']),\n",
+ " 'soil_tk_1d': (['time','lsmlat','lsmlon'], nc_data['soil_tk_1d']),\n",
+ " 'soil_cv_1d': (['time','lsmlat','lsmlon'], nc_data['soil_cv_1d']),\n",
+ " 'glc_tk_1d': (['time','lsmlat','lsmlon'], nc_data['glc_tk_1d']),\n",
+ " 'glc_cv_1d': (['time','lsmlat','lsmlon'], nc_data['glc_cv_1d'])},\n",
+ " coords = {'lsmlon': (['lsmlon'], lon_ctsm),\n",
+ " 'lsmlat': (['lsmlat'], lat_ctsm), \n",
+ " 'time': (['time'], time_vect)},\n",
+ " attrs = {'Author': username,\n",
+ " 'Date_created': tm.strftime(\"%Y-%m-%d %H:%M:%S\") + ' ' + tm.tzname[0] + ' ' + tm.tzname[1],\n",
+ " 'Resolution': 'see surfdat_file listed below',\n",
+ " 'Description': 'SLIM surdat file',\n",
+ " 'ccesm_source_run': casename,\n",
+ " 'ctsm_file': ctsm_concatenated_file,\n",
+ " 'dust_file': dust_file,\n",
+ " 'surfdat_file_for_glc_mask': surfdat_file,\n",
+ " }\n",
+ " )\n",
+ "\n",
+ "# Define each variable's [units, _FillValue, long_name, valid_range]\n",
+ "# and map onto the dataset\n",
+ "# Guidance: \n",
+ "# https://cfconventions.org/Data/cf-conventions/cf-conventions-1.10/cf-conventions.html#attribute-appendix\n",
+ "attr_map = {'glc_mask': ['unitless', 1e36, 'Glacier/ice sheet mask', [0, 1]], \n",
+ " 'alb_gvd': ['unitless', 1e36, 'Visible direct albedo for bare ground', []], \n",
+ " 'alb_svd': ['unitless', 1e36, 'Visible direct albedo for deep snow', []],\n",
+ " 'alb_gnd': ['unitless', 1e36, 'NIR direct albedo for bare ground', []], \n",
+ " 'alb_snd': ['unitless', 1e36, 'NIR direct albedo for deep snow', []], \n",
+ " 'alb_gvf': ['unitless', 1e36, 'Visible diffuse albedo for bare ground', []],\n",
+ " 'alb_svf': ['unitless', 1e36, 'Visible diffuse albedo for deep snow', []], \n",
+ " 'alb_gnf': ['unitless', 1e36, 'NIR diffuse albedo for bare ground', []], \n",
+ " 'alb_snf': ['unitless', 1e36, 'NIR diffuse albedo for deep snow', []],\n",
+ " 'bucketdepth': ['kg/m2', 1e36, 'Bucket capacity', []], \n",
+ " 'emissivity': ['unitless', 1e36, 'Surface emissivity for longwave radiation', []], \n",
+ " 'snowmask': ['kg/m2', 1e36, 'Snow-masking depth', []],\n",
+ " 'roughness': ['m', 1e36, 'Vegetation height', []], \n",
+ " 'evap_res': ['s/m', 1e36, 'Evaporative resistance', []],\n",
+ " 'l2xavg_Fall_flxdst1': ['unknown', 1e36, 'Dust flux', []], \n",
+ " 'l2xavg_Fall_flxdst2': ['unknown', 1e36, 'Dust flux', []], \n",
+ " 'l2xavg_Fall_flxdst3': ['unknown', 1e36, 'Dust flux', []], \n",
+ " 'l2xavg_Fall_flxdst4': ['unknown', 1e36, 'Dust flux', []], \n",
+ " 'soil_type': ['unitless', 1e36, 'Soil type (unused)', [0]], \n",
+ " 'soil_tk_1d': ['W/m/K', 1e36, 'Soil thermal conductivity', []], \n",
+ " 'soil_cv_1d': ['J/m3/K', 1e36, 'Soil heat capacity', []], \n",
+ " 'glc_tk_1d': ['W/m/K', 1e36, 'Ice thermal conductivity', []], \n",
+ " 'glc_cv_1d': ['J/m3/K', 1e36, 'Ice heat capacity', []], \n",
+ " 'lsmlat': ['degrees north', False, 'Coordinate latitude', []],\n",
+ " 'lsmlon': ['degrees east', False, 'Coordinate longitude', []], \n",
+ " 'time': ['month', False, '', []]}\n",
+ "\n",
+ "for var, val in attr_map.items():\n",
+ " ds_slim[var].attrs['Units'] = val[0]\n",
+ " ds_slim[var].attrs['_FillValue'] = val[1]\n",
+ " ds_slim[var].attrs['long_name'] = val[2]\n",
+ " ds_slim[var].attrs['valid_range'] = val[3]"
+ ]
+ },
+ {
+ "cell_type": "markdown",
+ "metadata": {
+ "tags": []
+ },
+ "source": [
+ "## Write out the new dataset"
+ ]
+ },
+ {
+ "cell_type": "code",
+ "execution_count": 15,
+ "metadata": {},
+ "outputs": [],
+ "source": [
+ "ds_slim.to_netcdf(path = 'surdat_' + tm.strftime(\"%Y%m%d\") + '.nc', format = 'NETCDF3_64BIT')"
+ ]
+ },
+ {
+ "cell_type": "code",
+ "execution_count": null,
+ "metadata": {},
+ "outputs": [],
+ "source": []
+ }
+ ],
+ "metadata": {
+ "kernelspec": {
+ "display_name": "Python [conda env:ctsm_pylib]",
+ "language": "python",
+ "name": "conda-env-ctsm_pylib-py"
+ },
+ "language_info": {
+ "codemirror_mode": {
+ "name": "ipython",
+ "version": 3
+ },
+ "file_extension": ".py",
+ "mimetype": "text/x-python",
+ "name": "python",
+ "nbconvert_exporter": "python",
+ "pygments_lexer": "ipython3",
+ "version": "3.7.9"
+ }
+ },
+ "nbformat": 4,
+ "nbformat_minor": 4
+}
diff --git a/python/slim/modify_input_files/__init__.py b/python/slim/modify_input_files/__init__.py
new file mode 100644
index 00000000..e69de29b
diff --git a/python/slim/modify_input_files/modify_surdat.py b/python/slim/modify_input_files/modify_surdat.py
new file mode 100644
index 00000000..97be7f31
--- /dev/null
+++ b/python/slim/modify_input_files/modify_surdat.py
@@ -0,0 +1,192 @@
+"""
+Run this code by using the following wrapper script:
+/tools/modify_input_files/surdat_modifier
+
+The wrapper script includes a full description and instructions.
+"""
+
+import os
+import logging
+from configparser import ConfigParser
+
+from math import isclose
+import numpy as np
+import xarray as xr
+
+from slim.utils import abort
+from slim.path_utils import path_to_slim_root
+from slim.config_utils import lon_range_0_to_360, get_config_value
+
+logger = logging.getLogger(__name__)
+
+
+class ModifySurdat:
+ """
+ Description
+ -----------
+ """
+
+ def __init__(
+ self, my_data, lon_1, lon_2, lat_1, lat_2, landmask_file, lat_dimname, lon_dimname
+ ):
+
+ self.file = my_data
+
+ self.rectangle = self._get_rectangle(
+ lon_1=lon_1,
+ lon_2=lon_2,
+ lat_1=lat_1,
+ lat_2=lat_2,
+ longxy=self.file.lsmlon,
+ latixy=self.file.lsmlat,
+ )
+
+ if landmask_file is not None:
+ # overwrite self.not_rectangle with data from
+ # user-specified .nc file in the .cfg file
+ landmask_ds = xr.open_dataset(landmask_file)
+ self.rectangle = landmask_ds.mod_lnd_props.data
+ # CF convention has dimension and coordinate variable names the same
+ if lat_dimname is None: # set to default
+ lat_dimname = "lsmlat"
+ if lon_dimname is None: # set to default
+ lon_dimname = "lsmlon"
+ lsmlat = landmask_ds.dims[lat_dimname]
+ lsmlon = landmask_ds.dims[lon_dimname]
+
+ for row in range(lsmlat): # rows from landmask file
+ for col in range(lsmlon): # cols from landmask file
+ errmsg = (
+ "landmask_ds.mod_lnd_props not 0 or 1 at "
+ + f"row, col, value = {row} {col} {self.rectangle[row, col]}"
+ )
+ assert isclose(self.rectangle[row, col], 0, abs_tol=1e-9) or isclose(
+ self.rectangle[row, col], 1, abs_tol=1e-9
+ ), errmsg
+
+ self.not_rectangle = np.logical_not(self.rectangle)
+ self.months = int(max(self.file.time)) # number of months (typically 12)
+
+ @classmethod
+ def init_from_file(
+ cls, surdat_in, lon_1, lon_2, lat_1, lat_2, landmask_file, lat_dimname, lon_dimname
+ ):
+ """Initialize a ModifySurdat object from file surdat_in"""
+ logger.info("Opening surdat_in file to be modified: %s", surdat_in)
+ my_file = xr.open_dataset(surdat_in)
+ return cls(my_file, lon_1, lon_2, lat_1, lat_2, landmask_file, lat_dimname, lon_dimname)
+
+ @staticmethod
+ def _get_rectangle(lon_1, lon_2, lat_1, lat_2, longxy, latixy):
+ """
+ Description
+ -----------
+ """
+
+ # ensure that lon ranges 0-360 in case user entered -180 to 180
+ lon_1 = lon_range_0_to_360(lon_1)
+ lon_2 = lon_range_0_to_360(lon_2)
+
+ # determine the rectangle(s)
+ # TODO This is not really "nearest" for the edges but isel didn't work
+ rectangle_1 = longxy >= lon_1
+ rectangle_2 = longxy <= lon_2
+ eps = np.finfo(np.float32).eps # to avoid roundoff issue
+ rectangle_3 = latixy >= (lat_1 - eps)
+ rectangle_4 = latixy <= (lat_2 + eps)
+
+ if lon_1 <= lon_2:
+ # rectangles overlap
+ union_1 = np.logical_and(rectangle_1, rectangle_2)
+ else:
+ # rectangles don't overlap: stradling the 0-degree meridian
+ union_1 = np.logical_or(rectangle_1, rectangle_2)
+
+ if lat_1 < -90 or lat_1 > 90 or lat_2 < -90 or lat_2 > 90:
+ errmsg = "lat_1 and lat_2 need to be in the range -90 to 90"
+ abort(errmsg)
+ elif lat_1 <= lat_2:
+ # rectangles overlap
+ union_2 = np.logical_and(rectangle_3, rectangle_4)
+ else:
+ # rectangles don't overlap: one in the north, one in the south
+ union_2 = np.logical_or(rectangle_3, rectangle_4)
+
+ # union rectangles overlap
+ rectangle = np.logical_and(union_1, union_2)
+
+ return rectangle
+
+ def set_monthly_values(self, var, val):
+ """
+ Description
+ -----------
+ If user has specified monthly values, use them. Else do nothing.
+ """
+ if len(val) != self.months:
+ errmsg = (
+ "Error: Variable should have exactly "
+ + str(self.months)
+ + " entries in the configure file: "
+ + var
+ )
+ abort(errmsg)
+ for mon in self.file.time - 1: # loop over the months
+ # set 3D variable
+ self.setvar_lev1(var, val[int(mon)], lev1_dim=int(mon))
+
+ def setvar_lev1(self, var, val, lev1_dim):
+ """
+ Sets 3d variable var to value val in user-defined rectangle,
+ defined as "other" in the function
+
+ HINT for working with 2d or 4d variables instead:
+ See ctsm subdirectory /python/ctsm/modify_input_files,
+ file modify_fsurdat.py for templates of the corresponding functions
+ """
+ self.file[var][lev1_dim, ...] = self.file[var][lev1_dim, ...].where(
+ self.not_rectangle, other=val
+ )
+
+ def set_defaults(self, vars_3d, allowed):
+ """
+ Description
+ -----------
+ Set default surdat values in a rectangle defined by lon/lat limits
+ """
+
+ # Overwrite in rectangle(s)
+ # ------------------------
+ # If defaults, then user makes changes to variables as follows.
+ # Values in the user-defined rectangle are replaced.
+ # Values outside the rectangle are preserved.
+ # ------------------------
+
+ # Default values of 3d variables. For guidance in selecting values, see
+ # /glade/p/cesmdata/cseg/inputdata/lnd/slim/surdat/
+ # globalconst_alpha0.2_soilcv2e6_hc0.1_rs100.0_glc_hc0.01_f19_cdf5_20211105.nc
+ # read the .cfg (config) file containing the defaults
+ config = ConfigParser()
+ cfg_path = os.path.join(
+ path_to_slim_root(), "tools/modify_input_files/modify_surdat_defaults.cfg"
+ )
+ config.read(cfg_path)
+ section = config.sections()[0] # name of the first section
+
+ # initialize entry
+ entry = [None, None, None, None, None, None, None, None, None, None, None, None] * len(
+ vars_3d
+ )
+ for var, val in vars_3d.items():
+ # obtain default values from the configure file
+ entry[val[1]] = get_config_value(
+ config=config,
+ section=section,
+ item=var,
+ file_path=cfg_path,
+ allowed_values=allowed,
+ is_list=True,
+ convert_to_type=val[0],
+ can_be_unset=True,
+ )
+ self.set_monthly_values(var=var, val=entry[val[1]])
diff --git a/python/slim/modify_input_files/surdat_modifier.py b/python/slim/modify_input_files/surdat_modifier.py
new file mode 100644
index 00000000..e94dd7d1
--- /dev/null
+++ b/python/slim/modify_input_files/surdat_modifier.py
@@ -0,0 +1,197 @@
+"""
+Run this code by using the following wrapper script:
+tools/modify_input_files/surdat_modifier
+
+The wrapper script includes a full description and instructions.
+"""
+
+import os
+import logging
+import argparse
+from configparser import ConfigParser
+
+from slim.utils import abort, write_output
+from slim.config_utils import get_config_value
+from slim.slim_logging import (
+ setup_logging_pre_config,
+ add_logging_args,
+ process_logging_args,
+)
+from slim.modify_input_files.modify_surdat import ModifySurdat
+
+logger = logging.getLogger(__name__)
+
+
+def main():
+ """
+ Description
+ -----------
+ Calls function that modifies a surdat file (surface dataset)
+ """
+
+ # set up logging allowing user control
+ setup_logging_pre_config()
+
+ # read the command line argument to obtain the path to the .cfg file
+ parser = argparse.ArgumentParser()
+ parser.add_argument("cfg_path", help="/path/name.cfg of input file, eg ./modify.cfg")
+ add_logging_args(parser)
+ args = parser.parse_args()
+ process_logging_args(args)
+ surdat_modifier(args.cfg_path)
+
+
+def surdat_modifier(cfg_path):
+ """Implementation of surdat_modifier command"""
+ # read the .cfg (config) file
+ config = ConfigParser()
+ config.read(cfg_path)
+ section = config.sections()[0] # name of the first section
+
+ # required: user must set these in the .cfg file
+ surdat_in = get_config_value(
+ config=config, section=section, item="surdat_in", file_path=cfg_path
+ )
+ surdat_out = get_config_value(
+ config=config, section=section, item="surdat_out", file_path=cfg_path
+ )
+
+ # required but fallback values available for variables omitted
+ # entirely from the .cfg file
+ defaults = get_config_value(
+ config=config,
+ section=section,
+ item="defaults",
+ file_path=cfg_path,
+ convert_to_type=bool,
+ )
+ lnd_lat_1 = get_config_value(
+ config=config,
+ section=section,
+ item="lnd_lat_1",
+ file_path=cfg_path,
+ convert_to_type=float,
+ )
+ lnd_lat_2 = get_config_value(
+ config=config,
+ section=section,
+ item="lnd_lat_2",
+ file_path=cfg_path,
+ convert_to_type=float,
+ )
+ lnd_lon_1 = get_config_value(
+ config=config,
+ section=section,
+ item="lnd_lon_1",
+ file_path=cfg_path,
+ convert_to_type=float,
+ )
+ lnd_lon_2 = get_config_value(
+ config=config,
+ section=section,
+ item="lnd_lon_2",
+ file_path=cfg_path,
+ convert_to_type=float,
+ )
+
+ landmask_file = get_config_value(
+ config=config,
+ section=section,
+ item="landmask_file",
+ file_path=cfg_path,
+ can_be_unset=True,
+ )
+
+ lat_dimname = get_config_value(
+ config=config, section=section, item="lat_dimname", file_path=cfg_path, can_be_unset=True
+ )
+ lon_dimname = get_config_value(
+ config=config, section=section, item="lon_dimname", file_path=cfg_path, can_be_unset=True
+ )
+
+ # Create ModifySurdat object
+ modify_surdat = ModifySurdat.init_from_file(
+ surdat_in,
+ lnd_lon_1,
+ lnd_lon_2,
+ lnd_lat_1,
+ lnd_lat_2,
+ landmask_file,
+ lat_dimname,
+ lon_dimname,
+ )
+
+ # If output file exists, abort before starting work
+ if os.path.exists(surdat_out):
+ errmsg = "Output file already exists: " + surdat_out
+ abort(errmsg)
+
+ # dictionary of entries to loop over
+ # "variable name": [type, index]
+ # dimensions are time,lsmlat,lsmlon
+ vars_3d = {
+ "glc_mask": [int, 0],
+ "alb_gvd": [float, 1],
+ "alb_svd": [float, 2],
+ "alb_gnd": [float, 3],
+ "alb_snd": [float, 4],
+ "alb_gvf": [float, 5],
+ "alb_svf": [float, 6],
+ "alb_gnf": [float, 7],
+ "alb_snf": [float, 8],
+ "bucketdepth": [float, 9],
+ "emissivity": [float, 10],
+ "snowmask": [float, 11],
+ "roughness": [float, 12],
+ "evap_res": [float, 13],
+ "soil_type": [int, 14],
+ "soil_tk_1d": [float, 15],
+ "soil_cv_1d": [float, 16],
+ "glc_tk_1d": [float, 17],
+ "glc_cv_1d": [float, 18],
+ }
+ # initialize entry
+ entry = [None, None, None, None, None, None, None, None, None, None, None, None] * len(vars_3d)
+ # not required: user may set these in the .cfg file
+ for var, val in vars_3d.items():
+ # obtain allowed from surdat_in variable's metadata
+ allowed = modify_surdat.file[var].attrs["valid_range"]
+ if not allowed.any(): # which means that allowed is "empty"
+ allowed = None
+ # obtain user-defined values from the configure file
+ entry[val[1]] = get_config_value(
+ config=config,
+ section=section,
+ item=var,
+ file_path=cfg_path,
+ allowed_values=allowed,
+ is_list=True,
+ convert_to_type=val[0],
+ can_be_unset=True,
+ )
+
+ # ------------------------------
+ # modify surface data properties
+ # ------------------------------
+
+ # Set surdat variables in a rectangle that could be global (default).
+ # Note that the land/ocean mask gets specified in the domain file for
+ # MCT or the ocean mesh files for NUOPC. Here the user may specify
+ # surdat variables inside a box but cannot change which points will
+ # run as land and which as ocean.
+ if defaults:
+ modify_surdat.set_defaults(vars_3d, allowed) # set 3D variables
+ logger.info("defaults complete")
+
+ # User-selected values will overwrite either
+ # - set_default's values if defaults = True or
+ # - the input surdat's values if defaults = False
+
+ for var, val in vars_3d.items():
+ if entry[val[1]] is not None:
+ modify_surdat.set_monthly_values(var=var, val=entry[val[1]])
+
+ # ----------------------------------------------
+ # Output the now modified SLIM surface data file
+ # ----------------------------------------------
+ write_output(modify_surdat.file, surdat_in, surdat_out, "surdat")
diff --git a/python/slim/path_utils.py b/python/slim/path_utils.py
new file mode 100644
index 00000000..724be4f4
--- /dev/null
+++ b/python/slim/path_utils.py
@@ -0,0 +1,131 @@
+"""Utility functions related to getting paths to various important places
+"""
+
+from __future__ import print_function
+
+import os
+import sys
+
+# ========================================================================
+# Constants that may need to be changed if directory structures change
+# ========================================================================
+
+# Path to the root directory of SLIM, based on the path of this file
+#
+# Note: It's important that this NOT end with a trailing slash;
+# os.path.normpath guarantees this.
+_SLIM_ROOT = os.path.normpath(
+ os.path.join(os.path.dirname(os.path.abspath(__file__)), os.pardir, os.pardir)
+)
+_SLIM_CIME_PY_ROOT = os.path.join(_SLIM_ROOT, "cime_config")
+
+# Candidates for the last path components to the SLIM directory within a
+# CESM checkout
+_CESM_SLIM_PATHS = [os.path.join("components", "slim")]
+
+# ========================================================================
+# Public functions
+# ========================================================================
+
+
+def path_to_slim_cime_py_root():
+ """Returns the path to the buildnml directory of SLIM"""
+ if not os.path.isdir(_SLIM_CIME_PY_ROOT):
+ raise RuntimeError("Cannot find cime_config within SLIM checkout")
+
+ return _SLIM_CIME_PY_ROOT
+
+
+def path_to_slim_root():
+ """Returns the path to the root directory of SLIM"""
+ return _SLIM_ROOT
+
+
+def path_to_cime(standalone_only=False):
+ """Returns the path to cime, if it can be found
+
+ Raises a RuntimeError if it cannot be found
+
+ We first check in the location where cime should be in a standalone
+ checkout. If standalone_only is True, then we ONLY look for cime in
+ that location. If standalone_only is False, then we fall back to
+ checking where cime should be in a full CESM checkout.
+ """
+ cime_standalone_path = os.path.join(path_to_slim_root(), "cime")
+ if os.path.isdir(cime_standalone_path):
+ return cime_standalone_path
+
+ if standalone_only:
+ raise RuntimeError("Cannot find cime within standalone SLIM checkout")
+
+ cesm_path = _path_to_cesm_root()
+ if cesm_path is None:
+ raise RuntimeError(
+ "Cannot find cime within standalone SLIM checkout, "
+ "and we don't seem to be within a CESM checkout."
+ )
+
+ cime_in_cesm_path = os.path.join(cesm_path, "cime")
+ if os.path.isdir(cime_in_cesm_path):
+ return cime_in_cesm_path
+
+ raise RuntimeError(
+ "Cannot find cime within standalone SLIM checkout, "
+ "or within CESM checkout rooted at {}".format(cesm_path)
+ )
+
+
+def prepend_to_python_path(path):
+ """Adds the given path to python's sys.path if it isn't already in the path
+
+ The path is added near the beginning, so that it takes precedence over existing
+ entries in the path
+ """
+ if not path in sys.path:
+ # Insert at location 1 rather than 0, because 0 is special
+ sys.path.insert(1, path)
+
+
+def add_cime_lib_to_path(standalone_only=False):
+ """Adds the CIME python library to the python path, to allow importing
+ modules from that library
+
+ Returns the path to the top-level cime directory
+
+ For documentation on standalone_only: See documentation in
+ path_to_cime
+ """
+ cime_path = path_to_cime(standalone_only=standalone_only)
+ cime_lib_path = os.path.join(cime_path, "scripts", "lib")
+ prepend_to_python_path(cime_lib_path)
+ cime_lib_path = os.path.join(cime_path, "scripts", "Tools")
+ prepend_to_python_path(cime_lib_path)
+ return cime_path
+
+
+def add_slim_cime_pylib_to_path():
+ """Adds the slime_cime_py python library to the python path
+
+ Returns the path to the top-level slim_cime_py directory
+ """
+ slim_cime_py_path = path_to_slim_cime_py_root()
+ prepend_to_python_path(slim_cime_py_path)
+ return slim_cime_py_path
+
+
+# ========================================================================
+# Private functions
+# ========================================================================
+
+
+def _path_to_cesm_root():
+ """Returns the path to the root directory of CESM, if we appear to
+ be inside a CESM checkout. If we don't appear to be inside a CESM
+ checkout, then returns None.
+ """
+ slim_root = path_to_slim_root()
+ for candidate_path in _CESM_SLIM_PATHS:
+ if slim_root.endswith(candidate_path):
+ return os.path.normpath(slim_root[: -len(candidate_path)])
+
+ return None
diff --git a/python/slim/run_slim_py_tests.py b/python/slim/run_slim_py_tests.py
new file mode 100644
index 00000000..491f7ad9
--- /dev/null
+++ b/python/slim/run_slim_py_tests.py
@@ -0,0 +1,83 @@
+"""Runner for the python unit tests defined here
+
+This is the main implementation of the run_slim_py_tests script contained in the
+parent directory
+"""
+
+import unittest
+import os
+import argparse
+import logging
+from slim import unit_testing
+
+logger = logging.getLogger(__name__)
+
+
+def main(description):
+ """Main function called when run_tests is run from the command-line
+
+ Args:
+ description (str): description printed to usage message
+ """
+ args = _commandline_args(description)
+ verbosity = _get_verbosity_level(args)
+
+ if args.pattern is not None:
+ pattern = args.pattern
+ elif args.unit:
+ pattern = "test_unit*.py"
+ elif args.sys:
+ pattern = "test_sys*.py"
+ else:
+ pattern = "test*.py"
+
+ # This setup_for_tests call is the main motivation for having this wrapper script to
+ # run the tests rather than just using 'python -m unittest discover'
+ unit_testing.setup_for_tests(enable_critical_logs=args.debug)
+
+ mydir = os.path.dirname(os.path.abspath(__file__))
+ testsuite = unittest.defaultTestLoader.discover(start_dir=mydir, pattern=pattern)
+ # NOTE(wjs, 2018-08-29) We may want to change the meaning of '--debug'
+ # vs. '--verbose': I could imagine having --verbose set buffer=False, and --debug
+ # additionally sets the logging level to much higher - e.g., debug level.
+ testrunner = unittest.TextTestRunner(buffer=(not args.debug), verbosity=verbosity)
+ testrunner.run(testsuite)
+
+
+def _commandline_args(description):
+ """Parse and return command-line arguments"""
+ parser = argparse.ArgumentParser(
+ description=description, formatter_class=argparse.RawTextHelpFormatter
+ )
+
+ output_level = parser.add_mutually_exclusive_group()
+
+ output_level.add_argument(
+ "-v", "--verbose", action="store_true", help="Run tests with more verbosity"
+ )
+
+ output_level.add_argument(
+ "-d", "--debug", action="store_true", help="Run tests with even more verbosity"
+ )
+
+ test_subset = parser.add_mutually_exclusive_group()
+
+ test_subset.add_argument("-u", "--unit", action="store_true", help="Only run unit tests")
+
+ test_subset.add_argument("-s", "--sys", action="store_true", help="Only run system tests")
+
+ test_subset.add_argument(
+ "-p", "--pattern", help="File name pattern to match\n" "Default is test*.py"
+ )
+
+ args = parser.parse_args()
+
+ return args
+
+
+def _get_verbosity_level(args):
+ if args.debug or args.verbose:
+ verbosity = 2
+ else:
+ verbosity = 1
+ return verbosity
diff --git a/python/slim/slim_logging.py b/python/slim/slim_logging.py
new file mode 100644
index 00000000..dcbc2531
--- /dev/null
+++ b/python/slim/slim_logging.py
@@ -0,0 +1,98 @@
+"""Utilities to facilitate logging
+
+A guide to logging in slim python scripts:
+
+- At the top of each module, you should have:
+ logger = logging.getLogger(__name__)
+
+- Logging should be done via that logger, NOT via logging.[whatever]
+
+- If you want to allow the user to control logging via command-line arguments, you should:
+
+ (1) At the very start of a script / application, call setup_logging_pre_config(). (We
+ need to initialize logging to avoid errors from logging calls made very early in the
+ script.)
+
+ (2) When setting up the argument parser, call add_logging_args(parser)
+
+ (3) After parsing arguments, call process_logging_args(args)
+
+- If you don't want to allow the user to control logging via command-line arguments, then
+ simply:
+
+ (1) At the very start of a script / application, call setup_logging() with the desired
+ arguments
+
+- In unit tests, to avoid messages about loggers not being set up, you should call
+ setup_logging_for_tests (this is typically done via unit_testing.setup_for_tests)
+"""
+
+import logging
+
+logger = logging.getLogger(__name__)
+
+
+def setup_logging_pre_config():
+ """Setup logging for a script / application
+
+ This function should be called at the very start of a script / application where you
+ intend to allow the user to control logging preferences via command-line arguments.
+
+ This sets initial options that may be changed later by process_logging_args.
+ """
+ setup_logging(level=logging.WARNING)
+
+
+def setup_logging_for_tests(enable_critical=False):
+ """Setup logging as appropriate for unit tests"""
+ setup_logging(level=logging.CRITICAL)
+ if not enable_critical:
+ logging.disable(logging.CRITICAL)
+
+
+def setup_logging(level=logging.WARNING):
+ """Setup logging for a script / application
+
+ This function should be called at the very start of a script / application where you
+ do NOT intend to allow the user to control logging preferences via command-line
+ arguments, so that all of the final logging options are set here.
+ """
+ logging.basicConfig(format="%(levelname)s: %(message)s", level=level)
+
+
+def add_logging_args(parser):
+ """Add common logging-related options to the argument parser"""
+
+ logging_level = parser.add_mutually_exclusive_group()
+
+ logging_level.add_argument(
+ "-v", "--verbose", action="store_true", help="Output extra logging info"
+ )
+
+ logging_level.add_argument(
+ "--debug",
+ action="store_true",
+ help="Output even more logging info for debugging",
+ )
+
+
+def process_logging_args(args):
+ """Configure logging based on the logging-related args added by add_logging_args"""
+ root_logger = logging.getLogger()
+
+ if args.debug:
+ root_logger.setLevel(logging.DEBUG)
+ elif args.verbose:
+ root_logger.setLevel(logging.INFO)
+ else:
+ root_logger.setLevel(logging.WARNING)
+
+
+def output_to_file(file_path, message, log_to_logger=False):
+ """
+ helper function to write to log file.
+ """
+ with open(file_path, "a") as log_file:
+ log_file.write(message)
+ if log_to_logger:
+ logger.info(message)
diff --git a/python/slim/test/README b/python/slim/test/README
new file mode 100644
index 00000000..2dc5ef53
--- /dev/null
+++ b/python/slim/test/README
@@ -0,0 +1,23 @@
+SLIM-specific boiler-plate needed for most unit test modules:
+
+(1) If cime stuff is invoked by these unit tests (directly or
+ indirectly, then: the first slim import statement near the top of
+ the module should be:
+
+from slim import add_cime_to_path # pylint: disable=unused-import
+
+(2) Import the slim-specific unit_testing module:
+
+from slim import unit_testing
+
+(3) Allow names that pylint doesn't like:
+
+# Allow names that pylint doesn't like, because otherwise I find it hard
+# to make readable unit test names
+# pylint: disable=invalid-name
+
+(4) Have a 'main' block at the bottom:
+
+if __name__ == '__main__':
+ unit_testing.setup_for_tests()
+ unittest.main()
diff --git a/python/slim/test/__init__.py b/python/slim/test/__init__.py
new file mode 100644
index 00000000..e69de29b
diff --git a/python/slim/test/test_sys_buildnml.py b/python/slim/test/test_sys_buildnml.py
new file mode 100755
index 00000000..ea438743
--- /dev/null
+++ b/python/slim/test/test_sys_buildnml.py
@@ -0,0 +1,285 @@
+#!/usr/bin/env python3
+
+"""System tests for buildnml
+"""
+
+import unittest
+import tempfile
+import shutil
+import os
+import re
+import logging
+
+from pathlib import Path
+
+from CIME.BuildTools.configure import FakeCase
+from CIME.utils import expect
+
+# pylint: disable=wrong-import-order,unused-import
+from slim import add_slim_cime_py_to_path
+from slim import unit_testing
+
+from slim_cime_py.buildnml import buildnml
+
+logger = logging.getLogger(__name__)
+
+# Allow names that pylint doesn't like, because otherwise I find it hard
+# to make readable unit test names
+# pylint: disable=invalid-name
+
+
+def getVariableFromNML(nmlfile, variable):
+ """Get a variable from the namelist file"""
+ with open(nmlfile, "r") as nfile:
+ for line in nfile:
+ if re.search(r"^\s*" + variable + r"\s*=", line) is not None:
+ print("lnd_in:" + line)
+ match = re.search(r'= ["]*([ a-zA-Z0-9._//-]+)["]*', line)
+ if match is not None:
+ return match.group(1)
+ match = re.search(r"= [']*([ a-zA-Z0-9._//-]+)[']*", line)
+ if match is not None:
+ return match.group(1)
+ return None
+
+
+def addLinesToUserNL(user_nl_file, lines):
+ """Add some lines to the user_nl_file for SLIM"""
+ if os.path.exists(user_nl_file):
+ os.remove(user_nl_file)
+ print("Add lines to " + user_nl_file)
+ with open(user_nl_file, "x") as userfile:
+ for line in lines:
+ userfile.write(line + "\n")
+ print(line)
+ userfile.close()
+ print("Close file")
+
+
+class TestBuildNML(unittest.TestCase):
+ """System Tests of buildnml"""
+
+ def setUp(self):
+ """Initialize"""
+ self._testdir = tempfile.mkdtemp()
+ self.curdir = os.getcwd()
+ os.chdir(self._testdir)
+ # namelist definition file
+ lnd_root = os.path.normpath(
+ os.path.join(
+ os.path.dirname(os.path.abspath(__file__)), os.pardir, os.pardir, os.pardir
+ )
+ )
+ self.case = FakeCase(compiler=None, mpilib=None, debug=None)
+ self.case.set_value("CASEROOT", self._testdir)
+ self.case.set_value("COMPSET", "2000_DATM%GSWP3v1_SLIM_SICE_SOCN_SROF_SGLC_SWAV")
+ self.case.set_value("RUN_TYPE", "any")
+ self.case.set_value("RUN_STARTDATE", "2000-01-01")
+ self.case.set_value("RUN_REFCASE", "case.std")
+ self.case.set_value("RUN_REFDATE", "0001-01-01")
+ self.case.set_value("RUN_REFTOD", "00000")
+ self.case.set_value("RUN_REFDIR", "cesm2_init")
+ self.case.set_value("RUNDIR", ".")
+ self.case.set_value("CALENDAR", "NO_LEAP")
+ self.case.set_value("NINST_LND", 1)
+ self.case.set_value("NCPL_BASE_PERIOD", "day")
+ self.case.set_value("LND_NCPL", 48)
+ self.case.set_value("SLIM_SCENARIO", "global_uniform")
+ self.case.set_value("COMP_ROOT_DIR_LND", lnd_root)
+ self.case.set_value("DIN_LOC_ROOT", ".")
+ self.case.set_value("LND_DOMAIN_PATH", ".")
+ self.case.set_value("LND_DOMAIN_FILE", "domain.nc")
+ self.case.set_value("SLIM_START_TYPE", "cold")
+ self.case.set_value("LND_GRID", "1.9x2.5")
+
+ def tearDown(self):
+ """Finalize"""
+ os.chdir(self.curdir)
+ shutil.rmtree(self._testdir, ignore_errors=True)
+
+ def test_simple(self):
+ """Test a simple call of buildnml"""
+ for scenario in ("global_uniform", "realistic_from_1850", "realistic_from_2000"):
+ self.case.set_value("SLIM_SCENARIO", scenario)
+ buildnml(self.case, self._testdir, "slim")
+ expect(
+ os.path.isfile("Buildconf/slimconf/lnd_in"),
+ "Namelist file lnd_in should exist in Buildconf after running buildnml",
+ )
+ expect(
+ os.path.isfile("lnd_in"), "Namelist file lnd_in should exist after running buildnml"
+ )
+ expect(
+ os.path.isfile("Buildconf/slim.input_data_list"),
+ "Input data list file should exist after running buildnml",
+ )
+
+ def test_default_testmod(self):
+ """Test the default testmod options call of buildnml"""
+ lines = []
+ lines.append(
+ "mml_surdat='/glade/p/cesmdata/cseg/inputdata/lnd/slim/surdat/"
+ + "slim2deg_fromCMIP6-AMIP-1deg_ensemble001-010_1991to2010clim_max"
+ + "-ctrl-bucket_rs150_c20210401.nc'"
+ )
+ lines.append("hist_ndens = 1")
+ lines.append("hist_nhtfrq =-24")
+ lines.append("hist_mfilt = 5")
+ lines.append("! Empty the default history tapes and just output the MML fields")
+ lines.append("hist_empty_htapes = .true.")
+ lines.append(
+ "hist_fincl1 = 'MML_snowmaskdepth', 'MML_evap_rs', 'MML_bucket_cap', 'MML_soiltype',"
+ )
+ lines.append(" 'MML_roughness', 'MML_fsds', 'MML_fsdsnd','MML_fsdsni',")
+ lines.append("'MML_fsdsvd', 'MML_fsdsvi', 'MML_lwdn', 'MML_zref', 'MML_tbot', 'MML_thref'")
+ lines.append(",'MML_qbot', 'MML_uref',")
+ lines.append("'MML_eref', 'MML_pbot', 'MML_psrf', 'MML_pco2', 'MML_rhomol', 'MML_rhoair'")
+ lines.append(", 'MML_cpair', 'MML_prec_liq',")
+ lines.append("'MML_prec_frz', 'MML_ts', 'MML_qs', 'MML_qa', 'MML_swabs', 'MML_fsr',")
+ lines.append(" 'MML_fsrnd', 'MML_fsrni',")
+ lines.append("'MML_fsrvd', 'MML_fsrvi', 'MML_snowmelt', 'MML_l2a_taux', 'MML_l2a_tauy',")
+ lines.append(" 'MML_lwup', 'MML_shflx', 'MML_lhflx',")
+ lines.append("'MML_gsoi', 'MML_gsnow', 'MML_evap', 'MML_ustar', 'MML_tstar', 'MML_qstar',")
+ lines.append(" 'MML_tvstar', 'MML_obu',")
+ lines.append("'MML_ram', 'MML_rah', 'MML_z0m', 'MML_z0h', 'MML_alb', 'MML_fsns',")
+ lines.append(" 'MML_flns', 'MML_maxice',")
+ lines.append("'MML_soilz', 'MML_soil_t', 'MML_soil_liq', 'MML_soil_ice', 'MML_dz',")
+ lines.append("'MML_zh', 'MML_tk', 'MML_tkh',")
+ lines.append("'MML_dtsoi', 'MML_cv', 'MML_water', 'MML_snow', 'MML_runoff',")
+ lines.append(" 'MML_l2a_tref2m', 'MML_l2a_qref2m', 'MML_l2a_uref10m',")
+ lines.append("'MML_diag1_1d', 'MML_diag2_1d', 'MML_diag3_1d', 'MML_diag1_2d',")
+ lines.append(" 'MML_diag2_2d', 'MML_diag3_2d', 'MML_q_excess',")
+ lines.append("'MML_lh_excess',")
+ lines.append("'MML_q_demand', 'MML_lh_demand', 'mml_err_h2o', 'mml_err_h2osno',")
+ lines.append("'mml_err_seb', 'mml_err_soi', 'mml_err_sol', 'WIND',")
+ lines.append("'THBOT', 'RAIN', 'SNOW', 'RH'")
+ addLinesToUserNL("user_nl_slim", lines)
+ buildnml(self.case, self._testdir, "slim")
+ expect(
+ os.path.isfile("Buildconf/slimconf/lnd_in"),
+ "Namelist file lnd_in should exist in Buildconf after running buildnml",
+ )
+ expect(os.path.isfile("lnd_in"), "Namelist file lnd_in should exist after running buildnml")
+ expect(
+ os.path.isfile("Buildconf/slim.input_data_list"),
+ "Input data list file should exist after running buildnml",
+ )
+
+ def test_hybrid_start(self):
+ """Test a hybrid startup call of buildnml"""
+ self.case.set_value("SLIM_START_TYPE", "required")
+ self.case.set_value("RUN_TYPE", "hybrid")
+ self.case.set_value("RUN_REFCASE", "TESTCASE")
+ self.case.set_value("RUN_REFDATE", "0001-01-01")
+ self.case.set_value("RUN_REFTOD", "00000")
+ Path("TESTCASE.slim.r.0001-01-01-00000.nc").touch()
+ buildnml(self.case, self._testdir, "slim")
+ expect(
+ os.path.isfile("Buildconf/slimconf/lnd_in"),
+ "Namelist file lnd_in should exist in Buildconf after running buildnml",
+ )
+ expect(os.path.isfile("lnd_in"), "Namelist file lnd_in should exist after running buildnml")
+ expect(
+ os.path.isfile("Buildconf/slim.input_data_list"),
+ "Input data list file should exist after running buildnml",
+ )
+ value = getVariableFromNML("lnd_in", "finidat")
+ self.assertEqual(
+ value, "TESTCASE.slim.r.0001-01-01-00000.nc", msg="finidat not set as expected"
+ )
+
+ def test_hybrid_start_override_cold(self):
+ """Test a hybrid startup call of buildnml where you override with a cold start"""
+ self.case.set_value("SLIM_START_TYPE", "required")
+ self.case.set_value("RUN_TYPE", "hybrid")
+ self.case.set_value("RUN_REFCASE", "TESTCASE")
+ self.case.set_value("RUN_REFDATE", "0001-01-01")
+ self.case.set_value("RUN_REFTOD", "00000")
+ Path("TESTCASE.slim.r.0001-01-01-00000.nc").touch()
+ self.case.set_value("SLIM_START_TYPE", "cold") # Set start type to cold
+ buildnml(self.case, self._testdir, "slim")
+ expect(
+ os.path.isfile("Buildconf/slimconf/lnd_in"),
+ "Namelist file lnd_in should exist in Buildconf after running buildnml",
+ )
+ expect(os.path.isfile("lnd_in"), "Namelist file lnd_in should exist after running buildnml")
+ expect(
+ os.path.isfile("Buildconf/slim.input_data_list"),
+ "Input data list file should exist after running buildnml",
+ )
+ value = getVariableFromNML("lnd_in", "finidat")
+ self.assertEqual(value, " ", msg="finidat not set as expected")
+
+ def test_branch_start(self):
+ """Test a branch startup call of buildnml"""
+ self.case.set_value("SLIM_START_TYPE", "required")
+ self.case.set_value("RUN_TYPE", "branch")
+ self.case.set_value("RUN_REFCASE", "TESTCASE")
+ self.case.set_value("RUN_REFDATE", "0001-01-01")
+ self.case.set_value("RUN_REFTOD", "00000")
+ Path("TESTCASE.slim.r.0001-01-01-00000.nc").touch()
+ buildnml(self.case, self._testdir, "slim")
+ expect(
+ os.path.isfile("Buildconf/slimconf/lnd_in"),
+ "Namelist file lnd_in should exist in Buildconf after running buildnml",
+ )
+ expect(os.path.isfile("lnd_in"), "Namelist file lnd_in should exist after running buildnml")
+ expect(
+ os.path.isfile("Buildconf/slim.input_data_list"),
+ "Input data list file should exist after running buildnml",
+ )
+ value = getVariableFromNML("lnd_in", "nrevsn")
+ self.assertEqual(
+ value, "TESTCASE.slim.r.0001-01-01-00000.nc", msg="nrevsn not set as expected"
+ )
+
+ def test_start_types(self):
+ """Test start types of buildnml"""
+ # Cold start types
+ finidat = " "
+ lines = []
+ for stype in ("cold", "any", "required"):
+ print("Type: " + stype)
+ addLinesToUserNL("user_nl_slim", lines)
+
+ self.case.set_value("SLIM_START_TYPE", stype)
+ buildnml(self.case, self._testdir, "slim")
+ expect(
+ os.path.isfile("Buildconf/slimconf/lnd_in"),
+ "Namelist file lnd_in should exist in Buildconf after running buildnml",
+ )
+ expect(
+ os.path.isfile("lnd_in"), "Namelist file lnd_in should exist after running buildnml"
+ )
+ expect(
+ os.path.isfile("Buildconf/slim.input_data_list"),
+ "Input data list file should exist after running buildnml",
+ )
+ value = getVariableFromNML("lnd_in", "finidat")
+ self.assertEqual(value, finidat, msg="finidat not set as expected: type=" + stype)
+ stype = "required"
+ finidat = "TESTFINIDATFILENAME.nc"
+ Path(finidat).touch()
+ lines = ["finidat = '" + finidat + "'\n"]
+ print("Type: " + stype)
+ addLinesToUserNL("user_nl_slim", lines)
+
+ self.case.set_value("SLIM_START_TYPE", stype)
+ buildnml(self.case, self._testdir, "slim")
+ expect(
+ os.path.isfile("Buildconf/slimconf/lnd_in"),
+ "Namelist file lnd_in should exist in Buildconf after running buildnml",
+ )
+ expect(os.path.isfile("lnd_in"), "Namelist file lnd_in should exist after running buildnml")
+ expect(
+ os.path.isfile("Buildconf/slim.input_data_list"),
+ "Input data list file should exist after running buildnml",
+ )
+ value = getVariableFromNML("lnd_in", "finidat")
+ self.assertEqual(value, finidat, msg="finidat not set as expected")
+ os.remove("user_nl_slim")
+
+
+if __name__ == "__main__":
+ unit_testing.setup_for_tests()
+ unittest.main()
diff --git a/python/slim/test/test_sys_surdat_modifier.py b/python/slim/test/test_sys_surdat_modifier.py
new file mode 100755
index 00000000..4842e52b
--- /dev/null
+++ b/python/slim/test/test_sys_surdat_modifier.py
@@ -0,0 +1,291 @@
+#!/usr/bin/env python3
+
+"""System tests for surdat_modifier
+
+"""
+
+import os
+import re
+
+import unittest
+import tempfile
+import shutil
+
+import numpy as np
+import xarray as xr
+
+from slim.path_utils import path_to_slim_root
+from slim.config_utils import lon_range_0_to_360
+from slim.utils import write_output
+from slim import unit_testing
+from slim.modify_input_files.surdat_modifier import surdat_modifier
+
+# Allow test names that pylint doesn't like; otherwise hard to make them
+# readable
+# pylint: disable=invalid-name
+
+
+class TestSysSurdatModifier(unittest.TestCase):
+ """System tests for surdat_modifier"""
+
+ def setUp(self):
+ """
+ Obtain path to the existing modify_surdat_template.cfg file
+ Make /_tempdir for use by these tests
+ Obtain path and names for the files being created in /_tempdir:
+ - modify_surdat.cfg
+ - surdat_out.nc
+ - surdat_in.nc
+ Generate dummy surdat_in file and save
+ Come up with modifications to be introduced to surdat_in
+ """
+ self._cfg_template_path = os.path.join(
+ path_to_slim_root(), "tools/modify_input_files/modify_surdat_template.cfg"
+ )
+ self._tempdir = tempfile.mkdtemp()
+ self._cfg_file_path = os.path.join(self._tempdir, "modify_surdat.cfg")
+ self._surdat_out = os.path.join(self._tempdir, "surdat_out.nc")
+ self._surdat_in = os.path.join(self._tempdir, "surdat_in.nc")
+ months = 12
+
+ # -----------------------------------------------------------
+ # create dummy SLIM surdat file
+ # -----------------------------------------------------------
+ # get lon/lat that would normally come from a surdat file
+ # self._get_longxy_latixy will convert -180 to 180 to 0-360 longitudes
+ # get cols, rows also
+ self._lon_range = [2, 10] # expected in ascending order: [min, max]
+ self._lat_range = [3, 12] # expected in ascending order: [min, max]
+ longxy, latixy, cols, rows = self._get_longxy_latixy(
+ _min_lon=min(self._lon_range),
+ _max_lon=max(self._lon_range),
+ _min_lat=min(self._lat_range),
+ _max_lat=max(self._lat_range),
+ )
+ lon_1d = longxy[0, :]
+ lat_1d = latixy[:, 0]
+ # create xarray dataset containing lev1 variables;
+ # the surdat_modify tool reads variables like this from a surdat file
+ var_1d = np.arange(cols)
+ ones_3d = np.ones((months, rows, cols))
+ var_lev1 = var_1d * ones_3d
+ self._surdat_in_data = xr.Dataset(
+ data_vars=dict(
+ time=(["time"], np.arange(months) + 1),
+ lsmlon=(["lsmlon"], lon_1d),
+ lsmlat=(["lsmlat"], lat_1d),
+ glc_mask=(["time", "lsmlat", "lsmlon"], var_lev1),
+ alb_gvd=(["time", "lsmlat", "lsmlon"], var_lev1),
+ alb_svd=(["time", "lsmlat", "lsmlon"], var_lev1),
+ alb_gnd=(["time", "lsmlat", "lsmlon"], var_lev1),
+ alb_snd=(["time", "lsmlat", "lsmlon"], var_lev1),
+ alb_gvf=(["time", "lsmlat", "lsmlon"], var_lev1),
+ alb_svf=(["time", "lsmlat", "lsmlon"], var_lev1),
+ alb_gnf=(["time", "lsmlat", "lsmlon"], var_lev1),
+ alb_snf=(["time", "lsmlat", "lsmlon"], var_lev1),
+ bucketdepth=(["time", "lsmlat", "lsmlon"], var_lev1),
+ emissivity=(["time", "lsmlat", "lsmlon"], var_lev1),
+ snowmask=(["time", "lsmlat", "lsmlon"], var_lev1),
+ roughness=(["time", "lsmlat", "lsmlon"], var_lev1),
+ evap_res=(["time", "lsmlat", "lsmlon"], var_lev1),
+ l2xavg_Fall_flxdst1=(["time", "lsmlat", "lsmlon"], var_lev1),
+ l2xavg_Fall_flxdst2=(["time", "lsmlat", "lsmlon"], var_lev1),
+ l2xavg_Fall_flxdst3=(["time", "lsmlat", "lsmlon"], var_lev1),
+ l2xavg_Fall_flxdst4=(["time", "lsmlat", "lsmlon"], var_lev1),
+ soil_type=(["time", "lsmlat", "lsmlon"], var_lev1),
+ soil_tk_1d=(["time", "lsmlat", "lsmlon"], var_lev1),
+ soil_cv_1d=(["time", "lsmlat", "lsmlon"], var_lev1),
+ glc_tk_1d=(["time", "lsmlat", "lsmlon"], var_lev1),
+ glc_cv_1d=(["time", "lsmlat", "lsmlon"], var_lev1),
+ )
+ )
+ # Add attributes to all the variables
+ attr_map = {
+ "glc_mask": ["unitless", 1e36, "Glacier/ice sheet mask", [0, 1]],
+ "alb_gvd": ["unitless", 1e36, "Visible direct albedo for bare ground", []],
+ "alb_svd": ["unitless", 1e36, "Visible direct albedo for deep snow", []],
+ "alb_gnd": ["unitless", 1e36, "NIR direct albedo for bare ground", []],
+ "alb_snd": ["unitless", 1e36, "NIR direct albedo for deep snow", []],
+ "alb_gvf": ["unitless", 1e36, "Visible diffuse albedo for bare ground", []],
+ "alb_svf": ["unitless", 1e36, "Visible diffuse albedo for deep snow", []],
+ "alb_gnf": ["unitless", 1e36, "NIR diffuse albedo for bare ground", []],
+ "alb_snf": ["unitless", 1e36, "NIR diffuse albedo for deep snow", []],
+ "bucketdepth": ["kg/m2", 1e36, "Bucket capacity", []],
+ "emissivity": ["unitless", 1e36, "Surface emissivity for longwave radiation", []],
+ "snowmask": ["kg/m2", 1e36, "Snow-masking depth", []],
+ "roughness": ["m", 1e36, "Vegetation height", []],
+ "evap_res": ["s/m", 1e36, "Evaporative resistance", []],
+ "l2xavg_Fall_flxdst1": ["unknown", 1e36, "Dust flux", []],
+ "l2xavg_Fall_flxdst2": ["unknown", 1e36, "Dust flux", []],
+ "l2xavg_Fall_flxdst3": ["unknown", 1e36, "Dust flux", []],
+ "l2xavg_Fall_flxdst4": ["unknown", 1e36, "Dust flux", []],
+ "soil_type": ["unitless", 1e36, "Soil type (unused)", [0]],
+ "soil_tk_1d": ["W/m/K", 1e36, "Soil thermal conductivity", []],
+ "soil_cv_1d": ["J/m3/K", 1e36, "Soil heat capacity", []],
+ "glc_tk_1d": ["W/m/K", 1e36, "Ice thermal conductivity", []],
+ "glc_cv_1d": ["J/m3/K", 1e36, "Ice heat capacity", []],
+ "lsmlat": ["degrees north", False, "Coordinate latitude", []],
+ "lsmlon": ["degrees east", False, "Coordinate longitude", []],
+ "time": ["month", False, "", []],
+ }
+ for var, val in attr_map.items():
+ self._surdat_in_data[var].attrs["Units"] = val[0]
+ self._surdat_in_data[var].attrs["_FillValue"] = val[1]
+ self._surdat_in_data[var].attrs["long_name"] = val[2]
+ self._surdat_in_data[var].attrs["valid_range"] = val[3]
+
+ # save in tempdir; _in and _out files are the same file in this case
+ write_output(self._surdat_in_data, self._surdat_in, self._surdat_in, "surdat")
+ # come up with modifications to be introduced to surdat_in
+ self._modified_1 = ones_3d.astype(int)
+ self._modified_2 = 0 * self._modified_1
+ self._modified_3 = 0.5 * self._modified_1
+ self._modified_4 = 195 * self._modified_1
+
+ def tearDown(self):
+ """
+ Remove temporary directory
+ """
+ shutil.rmtree(self._tempdir, ignore_errors=True)
+
+ def test_minimalInfo(self):
+ """
+ This test specifies a minimal amount of information
+ Create .cfg file, run the tool, compare surdat_in to surdat_out
+ """
+
+ self._create_config_file_minimal()
+
+ # run the surdat_modifier tool
+ surdat_modifier(self._cfg_file_path)
+ # the critical piece of this test is that the above command
+ # doesn't generate errors; however, we also do some assertions below
+
+ surdat_out_data = xr.open_dataset(self._surdat_out)
+ # assert that surdat_out equals surdat_in
+ self.assertTrue(surdat_out_data.equals(self._surdat_in_data))
+
+ def test_allInfo(self):
+ """
+ This version specifies all possible information
+ Create .cfg file, run the tool, compare surdat_in to surdat_out
+ Here also compare surdat_out to surdat_out_baseline
+ """
+
+ self._create_config_file_complete()
+
+ # run the surdat_modifier tool
+ surdat_modifier(self._cfg_file_path)
+ # the critical piece of this test is that the above command
+ # doesn't generate errors; however, we also do some assertions below
+
+ # compare surdat_out to surdat_in
+ surdat_out_data = xr.open_dataset(self._surdat_out)
+ # assert that surdat_out does not equal surdat_in
+ self.assertFalse(surdat_out_data.equals(self._surdat_in_data))
+
+ # -----------------------------------------------------------
+ # compare surdat_out to surdat_out_baseline
+ # -----------------------------------------------------------
+ # generate surdat_out_baseline by merging surdat_in into the
+ # modified dataset and compare to surdat_out
+ modified_1_through_4 = xr.Dataset(
+ data_vars=dict(
+ glc_mask=(["time", "lsmlat", "lsmlon"], self._modified_1),
+ alb_gvd=(["time", "lsmlat", "lsmlon"], self._modified_2),
+ alb_svd=(["time", "lsmlat", "lsmlon"], self._modified_3),
+ bucketdepth=(["time", "lsmlat", "lsmlon"], self._modified_4),
+ )
+ )
+ surdat_out_base_data = modified_1_through_4.merge(self._surdat_in_data, compat="override")
+
+ # assert that surdat_out equals surdat_out_baseline
+ self.assertTrue(surdat_out_data.equals(surdat_out_base_data))
+
+ def _create_config_file_minimal(self):
+ """
+ Open the new and the template .cfg files
+ Loop line by line through the template .cfg file
+ When string matches, replace that line's content
+ """
+ with open(self._cfg_file_path, "w", encoding="utf-8") as cfg_out:
+ with open(self._cfg_template_path, "r", encoding="utf-8") as cfg_in:
+ for line in cfg_in:
+ if re.match(r" *surdat_in *=", line):
+ line = f"surdat_in = {self._surdat_in}"
+ elif re.match(r" *surdat_out *=", line):
+ line = f"surdat_out = {self._surdat_out}"
+ cfg_out.write(line)
+
+ def _create_config_file_complete(self):
+ """
+ Open the new and the template .cfg files
+ Loop line by line through the template .cfg file
+ When string matches, replace that line's content
+ """
+ with open(self._cfg_file_path, "w", encoding="utf-8") as cfg_out:
+ with open(self._cfg_template_path, "r", encoding="utf-8") as cfg_in:
+ for line in cfg_in:
+ if re.match(r" *surdat_in *=", line):
+ line = f"surdat_in = {self._surdat_in}"
+ elif re.match(r" *surdat_out *=", line):
+ line = f"surdat_out = {self._surdat_out}"
+ elif re.match(r" *defaults *=", line):
+ line = "defaults = False"
+ elif re.match(r" *lnd_lat_1 *=", line):
+ line = "lnd_lat_1 = " + str(min(self._lat_range)) + "\n"
+ elif re.match(r" *lnd_lat_2 *=", line):
+ line = "lnd_lat_2 = " + str(max(self._lat_range)) + "\n"
+ elif re.match(r" *lnd_lon_1 *=", line):
+ line = "lnd_lon_1 = " + str(min(self._lon_range)) + "\n"
+ elif re.match(r" *lnd_lon_2 *=", line):
+ line = "lnd_lon_2 = " + str(max(self._lon_range)) + "\n"
+ elif re.match(r" *glc_mask *=", line):
+ # in .cfg file user enters list of monthly (i.e. 12)
+ # values without punctuation (e.g. brackets or commas)
+ line = "glc_mask = " + str(self._modified_1[:, 0, 0])[1:-1] + "\n"
+ elif re.match(r" *alb_gvd *=", line):
+ # in .cfg file user enters list of monthly (i.e. 12)
+ # values without punctuation (e.g. brackets or commas)
+ line = "alb_gvd = " + str(self._modified_2[:, 0, 0])[1:-1] + "\n"
+ elif re.match(r" *alb_svd *=", line):
+ # in .cfg file user enters list of monthly (i.e. 12)
+ # values without punctuation (e.g. brackets or commas)
+ line = "alb_svd = " + str(self._modified_3[:, 0, 0])[1:-1] + "\n"
+ elif re.match(r" *bucketdepth *=", line):
+ # in .cfg file user enters list of monthly (i.e. 12)
+ # values without punctuation (e.g. brackets or commas)
+ line = "bucketdepth = " + str(self._modified_4[:, 0, 0])[1:-1] + "\n"
+ cfg_out.write(line)
+
+ def _get_longxy_latixy(self, _min_lon, _max_lon, _min_lat, _max_lat):
+ """
+ Return longxy, latixy, cols, rows
+ Function copied from test_unit_modify_surdat.py
+ TODO Move to a separate file of test utilities?
+ """
+ cols = _max_lon - _min_lon + 1
+ rows = _max_lat - _min_lat + 1
+
+ long = np.arange(_min_lon, _max_lon + 1)
+ long = [lon_range_0_to_360(longitude) for longitude in long]
+ longxy = long * np.ones((rows, cols))
+ compare = np.repeat([long], rows, axis=0) # alternative way to form
+ # assert this to confirm intuitive understanding of these matrices
+ np.testing.assert_array_equal(longxy, compare)
+
+ lati = np.arange(_min_lat, _max_lat + 1)
+ self.assertEqual(min(lati), _min_lat)
+ self.assertEqual(max(lati), _max_lat)
+ latixy_transp = lati * np.ones((cols, rows))
+ compare = np.repeat([lati], cols, axis=0) # alternative way to form
+ # assert this to confirm intuitive understanding of these matrices
+ np.testing.assert_array_equal(latixy_transp, compare)
+ latixy = np.transpose(latixy_transp)
+
+ return longxy, latixy, cols, rows
+
+
+if __name__ == "__main__":
+ unit_testing.setup_for_tests()
+ unittest.main()
diff --git a/python/slim/test/test_unit_buildnml.py b/python/slim/test/test_unit_buildnml.py
new file mode 100755
index 00000000..5a2cd5d9
--- /dev/null
+++ b/python/slim/test/test_unit_buildnml.py
@@ -0,0 +1,498 @@
+#!/usr/bin/env python3
+
+"""Unit tests for buildnml
+"""
+
+import unittest
+import tempfile
+import shutil
+import os
+import logging
+
+from pathlib import Path
+
+from CIME.nmlgen import NamelistGenerator
+from CIME.BuildTools.configure import FakeCase
+from CIME.utils import expect
+
+# pylint: disable=wrong-import-order,unused-import
+from slim import add_slim_cime_py_to_path
+from slim import unit_testing
+from slim.slim_logging import setup_logging
+
+from slim_cime_py.buildnml import (
+ check_nml_dtime,
+ check_nml_performance,
+ check_nml_general,
+ check_nml_history,
+ check_nml_data,
+ check_nml_initial_conditions,
+)
+
+logger = logging.getLogger(__name__)
+
+# Allow names that pylint doesn't like, because otherwise I find it hard
+# to make readable unit test names
+# pylint: disable=invalid-name
+
+
+class TestPathUtils(unittest.TestCase):
+ # pylint: disable=too-many-public-methods
+ """Tests of buildnml"""
+
+ def setUp(self):
+ """Initialize"""
+ self._testdir = tempfile.mkdtemp()
+ self._pwd = os.getcwd()
+ # namelist definition file
+ lnd_root = os.path.normpath(
+ os.path.join(
+ os.path.dirname(os.path.abspath(__file__)), os.pardir, os.pardir, os.pardir
+ )
+ )
+ namelist_xml_dir = os.path.join(lnd_root, "cime_config")
+ self._definition_file = [os.path.join(namelist_xml_dir, "namelist_definition_slim.xml")]
+ for file_ in self._definition_file:
+ expect(os.path.isfile(file_), "Namelist XML file %s not found!" % file_)
+
+ setup_logging(logging.DEBUG)
+ os.chdir(self._testdir)
+ self.case = FakeCase(compiler=None, mpilib=None, debug=None)
+ self.case.set_value("RUNDIR", self._testdir)
+ self.case.set_value("RUN_TYPE", "startup")
+ self.case.set_value("RUN_STARTDATE", "2000-01-01")
+ self.case.set_value("RUN_REFCASE", "case.std")
+ self.case.set_value("RUN_REFDATE", "0001-01-01")
+ self.case.set_value("RUN_REFTOD", "00000")
+ self.case.set_value("RUN_REFDIR", "cesm2_init")
+ self.case.set_value("DIN_LOC_ROOT", ".")
+ self.case.set_value("CALENDAR", "NO_LEAP")
+ self.case.set_value("LND_DOMAIN_PATH", ".")
+ self.case.set_value("LND_DOMAIN_FILE", "domain.nc")
+ self.case.set_value("SLIM_SCENARIO", "global_uniform")
+ self.case.set_value("SLIM_START_TYPE", "any")
+ self.case.set_value("LND_GRID", "1.9x2.5")
+
+ self.InitNML()
+
+ def InitNML(self):
+ """Re initialize the Namelist"""
+
+ # Recreate the object so that it will start empty
+ self.nmlgen = NamelistGenerator(self.case, self._definition_file)
+ # ------------------------------------------------------
+ # Create config dictionary
+ # ------------------------------------------------------
+ self.config = {}
+ self.config["lnd_grid"] = self.case.get_value("LND_GRID")
+ self.config["slim_scenario"] = self.case.get_value("SLIM_SCENARIO")
+ self.config["slim_start_type"] = self.case.get_value("SLIM_START_TYPE")
+
+ # ------------------------------------------------------
+ # Initialize namelist defaults
+ # ------------------------------------------------------
+ self.nmlgen.init_defaults(infiles=[], config=self.config)
+
+ def tearDown(self):
+ """Finalize"""
+ shutil.rmtree(self._testdir, ignore_errors=True)
+ os.chdir(self._pwd)
+
+ def test_check_nml_performance(self):
+ """Test the check nml performance subroutine"""
+ self.nmlgen.set_value("nsegspc", 20)
+ check_nml_performance(self.nmlgen)
+ self.nmlgen.set_value("nsegspc", -1)
+ with self.assertRaisesRegex(SystemExit, "nsegspc must be positive"):
+ check_nml_performance(self.nmlgen)
+
+ def test_check_nml_history(self):
+ """Test the check nml history subroutine"""
+ self.nmlgen.set_value("hist_mfilt", [20])
+ check_nml_history(self.nmlgen)
+ self.nmlgen.set_value("hist_mfilt", [0])
+ with self.assertRaisesRegex(SystemExit, "hist_mfilt must be 1 or larger"):
+ check_nml_history(self.nmlgen)
+
+ self.InitNML()
+ # Make a list of settings to a list of history tape streams
+ self.nmlgen.set_value("use_noio", ".false.")
+ self.nmlgen.set_value("hist_empty_htapes", ".true.")
+ self.nmlgen.set_value("hist_mfilt", [1, 1, 2, 3, 4, 5])
+ self.nmlgen.set_value("hist_ndens", [1, 1, 2, 1, 1, 1])
+ self.nmlgen.set_value("hist_nhtfrq", [1, 1, -24, 2, 2, 2])
+ self.nmlgen.set_value("hist_avgflag_pertape", ["A", "I", "X", "M", "A", "A"])
+ self.nmlgen.set_value("hist_fincl1", ["A:I", "B:A", "C:X", "D:M", "E:A", "F:A"])
+ self.nmlgen.set_value("hist_fincl2", ["A", "B", "C", "D", "E", "F"])
+ self.nmlgen.set_value("hist_fincl3", ["A", "B", "C", "D", "E", "F"])
+ self.nmlgen.set_value("hist_fincl4", ["A", "B", "C", "D", "E", "F"])
+ self.nmlgen.set_value("hist_fincl5", ["A", "B", "C", "D", "E", "F"])
+ self.nmlgen.set_value("hist_fincl6", ["A", "B", "C", "D", "E", "F"])
+ check_nml_history(self.nmlgen)
+ # and another complex case
+ self.InitNML()
+ self.nmlgen.set_value("hist_empty_htapes", ".false.")
+ self.nmlgen.set_value("hist_fexcl1", ["A", "B", "C", "D", "E", "F"])
+ check_nml_history(self.nmlgen)
+ # Check that use_noio works if you don't set any hist_* options
+ self.InitNML()
+ self.nmlgen.set_value("use_noio", ".true.")
+ check_nml_history(self.nmlgen)
+
+ def test_check_nml_history_simple_fails_bad_timeavg(self):
+ """Test the check nml history subroutine for simple fails bad time avg"""
+ self.nmlgen.set_value("hist_fincl1", ["A:Z"])
+ with self.assertRaisesRegex(
+ SystemExit, "History averaging option Z is not valid in hist_fincl1"
+ ):
+ check_nml_history(self.nmlgen)
+
+ def test_check_nml_history_simple_fails_bad_characters(self):
+ """Test the check nml history subroutine for simple fails bad characters in field"""
+ self.nmlgen.set_value("hist_fincl1", ["A%$#@!~"])
+ with self.assertRaisesRegex(
+ SystemExit,
+ r"History field name hist_fincl1 has invalid characters or whitespace in it=",
+ ):
+ check_nml_history(self.nmlgen)
+
+ def test_check_nml_history_simple_fails_white_space_in_field(self):
+ """Test the check nml history subroutine for simple fails bad characters in field"""
+ self.nmlgen.set_value("hist_fincl1", [" "])
+ with self.assertRaisesRegex(
+ SystemExit,
+ r"History field name hist_fincl1 has invalid characters or whitespace in it=",
+ ):
+ check_nml_history(self.nmlgen)
+
+ def test_check_nml_history_complex_fails_array_size_not_consistent(self):
+ """Test the check nml history subroutine for complex fails array size not consistent"""
+ self.nmlgen.set_value("hist_mfilt", [1])
+ self.nmlgen.set_value("hist_ndens", [1, 1])
+ self.nmlgen.set_value("hist_fincl2", ["A"])
+ with self.assertRaisesRegex(
+ SystemExit, r"hist_mfilt array size does not agree with the expected size of 2"
+ ):
+ check_nml_history(self.nmlgen)
+
+ def test_check_nml_history_complex_fails_array_size(self):
+ """Test the check nml history subroutine for complex fails array size"""
+ self.nmlgen.set_value("hist_mfilt", [1, 1, 1, 1, 1, 1, 1])
+ self.nmlgen.set_value("hist_fincl2", ["A"])
+ self.nmlgen.set_value("hist_fincl3", ["A"])
+ self.nmlgen.set_value("hist_fincl4", ["A"])
+ self.nmlgen.set_value("hist_fincl5", ["A"])
+ self.nmlgen.set_value("hist_fincl6", ["A"])
+ with self.assertRaisesRegex(
+ SystemExit, r"hist_mfilt array size does not agree with the expected size of 6"
+ ):
+ check_nml_history(self.nmlgen)
+
+ def test_check_nml_history_complex_fails_excl_with_empty(self):
+ """Test the check nml history subroutine for complex fails exclude used with
+ empty history
+ """
+ self.nmlgen.set_value("hist_empty_htapes", ".true.")
+ self.nmlgen.set_value("hist_fexcl1", ["A"])
+ with self.assertRaisesRegex(
+ SystemExit, "hist_fexcl1 can not be set if hist_empty_htapes is set to true"
+ ):
+ check_nml_history(self.nmlgen)
+
+ def test_check_nml_history_fails_excl_use_noio(self):
+ """Test the check nml history subroutine for fails use_noio used with other
+ history settings
+ """
+ self.nmlgen.set_value("use_noio", ".true.")
+ self.nmlgen.set_value("hist_fincl1", ["A"])
+ with self.assertRaisesRegex(
+ SystemExit,
+ r"use_noio turns off all history output"
+ + ", so no hist_ namelist option should also be set.*",
+ ):
+ check_nml_history(self.nmlgen)
+
+ def test_check_nml_general(self):
+ """Test the check nml general subroutine"""
+ self.case.set_value("SLIM_START_TYPE", "cold")
+ self.InitNML()
+ self.nmlgen.set_value("res", self.case.get_value("LND_GRID"))
+ check_nml_general(self.nmlgen)
+ for var in ("slim_start_type", "res"):
+ val = self.nmlgen.get_value(var)
+ self.nmlgen.set_value(var, None)
+ with self.assertRaisesRegex(SystemExit, var + " must be set"):
+ check_nml_general(self.nmlgen)
+
+ self.nmlgen.set_value(var, val)
+
+ def test_check_nml_data(self):
+ """Test the check nml data subroutine"""
+ self.case.set_value("LND_GRID", "1.9x2.5")
+ self.nmlgen.set_value("res", self.case.get_value("LND_GRID"))
+ # Loop through the scenarios that we have datasets for
+ for scen in ("global_uniform", "realistic_from_1850", "realistic_from_2000"):
+ self.case.set_value("SLIM_SCENARIO", scen)
+ print("SLIM_SCENARIO = " + scen)
+ self.InitNML()
+ check_nml_data(self.nmlgen, self.case)
+ # 1-degree has one dataset
+ self.case.set_value("LND_GRID", "0.9x1.25")
+ self.case.set_value("SLIM_SCENARIO", "realistic_from_2000")
+ self.InitNML()
+ check_nml_data(self.nmlgen, self.case)
+ # Check that 1-degree for another scenario fails
+ self.case.set_value("SLIM_SCENARIO", "global_uniform")
+ self.InitNML()
+ with self.assertRaisesRegex(SystemExit, " file is NOT set and is required"):
+ check_nml_data(self.nmlgen, self.case)
+
+ # make the dataset unset and make sure it fails
+ var = "mml_surdat"
+ self.nmlgen.set_value(var, "UNSET")
+ with self.assertRaisesRegex(SystemExit, var + " file is NOT set and is required"):
+ check_nml_data(self.nmlgen, self.case)
+
+ def test_check_init_data(self):
+ """Test the check nml initial data subroutine"""
+ check_nml_initial_conditions(self.nmlgen, self.case)
+
+ #
+ # Check that normal startup acts as expected
+ #
+ # A cold start should have a blank finidat file
+ self.case.set_value("SLIM_START_TYPE", "cold")
+ self.InitNML()
+ check_nml_initial_conditions(self.nmlgen, self.case)
+ val = self.nmlgen.get_value("finidat")
+ expect("' '", val)
+ # If you have a cold-start and explicitly set the finidat file that should error out
+ self.nmlgen.set_value("finidat", "file_is_set.nc")
+ with self.assertRaisesRegex(
+ SystemExit, "finidat is set but SLIM_START_TYPE is cold which is a contradiction"
+ ):
+ check_nml_initial_conditions(self.nmlgen, self.case)
+ # Set to startup so that finidat is required
+ self.case.set_value("SLIM_START_TYPE", "startup")
+ self.InitNML()
+ self.nmlgen.set_value("finidat", "file_is_set.nc")
+ Path("file_is_set.nc").touch()
+ check_nml_initial_conditions(self.nmlgen, self.case)
+ # Don't set the IC file, so make sure it aborts
+ self.nmlgen.set_value("finidat", "UNSET")
+ check_nml_initial_conditions(self.nmlgen, self.case)
+ # Make sure nrevsn can't be set
+ self.nmlgen.set_value("nrevsn", "file_is_set.nc")
+ with self.assertRaisesRegex(
+ SystemExit, "nrevsn can NOT be set except when RUN_TYPE is a branch"
+ ):
+ check_nml_initial_conditions(self.nmlgen, self.case)
+
+ def test_check_set_user_defined(self):
+ """Test the check nml initial data subroutine for user_defined"""
+ self.case.set_value("SLIM_SCENARIO", "user_defined")
+ self.InitNML()
+ with self.assertRaisesRegex(
+ SystemExit, "When SLIM_SCENARIO is set to user_defined, you must provide the mml_surdat"
+ ):
+ check_nml_data(self.nmlgen, self.case)
+
+ def test_check_use_init_interp(self):
+ """Test the check nml initial data subroutine for use_init_interp options"""
+ self.case.set_value("SLIM_START_TYPE", "startup")
+ finidat = "finidat_file_to_interpolate_from.nc"
+ self.nmlgen.set_value("finidat", finidat)
+ Path(finidat).touch()
+ self.nmlgen.set_value("use_init_interp", ".true.")
+ finidat_dest = "finidat_file_to_create.nc"
+ self.nmlgen.set_value("finidat_interp_dest", finidat_dest)
+ check_nml_initial_conditions(self.nmlgen, self.case)
+ check_nml_data(self.nmlgen, self.case)
+
+ def test_check_use_init_interp_fails_cold(self):
+ """Test the check nml initial data subroutine for use_init_interp options that fail 1"""
+ # Cold start with use_init_interp should fail
+ self.case.set_value("SLIM_START_TYPE", "cold")
+ self.nmlgen.set_value("use_init_interp", ".true.")
+ check_nml_initial_conditions(self.nmlgen, self.case)
+ with self.assertRaisesRegex(
+ SystemExit, "use_init_interp can not be set to TRUE for a cold start"
+ ):
+ check_nml_data(self.nmlgen, self.case)
+
+ def test_check_use_init_interp_fails_setdest(self):
+ """Test the check nml initial data subroutine for use_init_interp options that fail 2"""
+ # Setting finidat_interp_dest without use_init_interp should fail
+ self.nmlgen.set_value("use_init_interp", ".false.")
+ finidat_dest = "finidat_file_to_create.nc"
+ self.nmlgen.set_value("finidat_interp_dest", finidat_dest)
+ check_nml_initial_conditions(self.nmlgen, self.case)
+ with self.assertRaisesRegex(
+ SystemExit, "finidat_interp_dest can NOT be set if use_init_interp is not on"
+ ):
+ check_nml_data(self.nmlgen, self.case)
+
+ def test_check_use_init_interp_fails_branch(self):
+ """Test the check nml initial data subroutine for use_init_interp options that fail 3"""
+ # Branch type should fail for use_init_interp set
+ self.case.set_value("RUN_TYPE", "branch")
+ self.case.set_value("SLIM_START_TYPE", "required")
+ self.case.set_value("RUN_REFCASE", "TESTCASE")
+ self.case.set_value("RUN_REFDATE", "0001-01-01")
+ nrevsn = "TESTCASE.slim.r.0001-01-01-00000.nc"
+ self.nmlgen.set_value("use_init_interp", ".true.")
+ Path(nrevsn).touch()
+ check_nml_initial_conditions(self.nmlgen, self.case)
+ with self.assertRaisesRegex(
+ SystemExit, "use_init_interp can NOT be set to TRUE for a branch run type"
+ ):
+ check_nml_data(self.nmlgen, self.case)
+
+ def test_check_init_data_branch(self):
+ """Test the check nml initial data subroutine for branch"""
+ #
+ # Check that a branch works correctly
+ #
+ self.case.set_value("RUN_TYPE", "branch")
+ self.case.set_value("SLIM_START_TYPE", "required")
+ self.case.set_value("RUN_REFCASE", "TESTCASE")
+ self.case.set_value("RUN_REFDATE", "0001-01-01")
+ nrevsn = "TESTCASE.slim.r.0001-01-01-00000.nc"
+ Path(nrevsn).touch()
+ self.InitNML()
+ check_nml_initial_conditions(self.nmlgen, self.case)
+ expect(
+ self.nmlgen.get_value("nrevsn"),
+ nrevsn,
+ "finidat should be set correctly for hybrid case",
+ )
+ # Make sure finidat can't be set
+ self.nmlgen.set_value("finidat", "file_is_set.nc")
+ with self.assertRaisesRegex(SystemExit, "finidat can NOT be set when RUN_TYPE is a branch"):
+ check_nml_initial_conditions(self.nmlgen, self.case)
+
+ def test_check_init_data_hybrid(self):
+ """Test the check nml initial data subroutine for hybrid"""
+ #
+ # Check that a hybrid works correctly
+ #
+ self.case.set_value("RUN_TYPE", "hybrid")
+ self.case.set_value("SLIM_START_TYPE", "required")
+ self.case.set_value("RUN_REFCASE", "TESTCASE")
+ self.case.set_value("RUN_REFDATE", "0001-01-01")
+ finidat = "TESTCASE.slim.r.0001-01-01-00000.nc"
+ Path(finidat).touch()
+ self.InitNML()
+ check_nml_initial_conditions(self.nmlgen, self.case)
+ expect(
+ self.nmlgen.get_value("finidat"),
+ finidat,
+ "finidat should be set correctly for hybrid case",
+ )
+
+ def test_check_dtime(self):
+ """Test the check nml dtime"""
+ self.case.set_value("NCPL_BASE_PERIOD", "hour")
+ self.case.set_value("CALENDAR", "GREGORIAN")
+ self.case.set_value("LND_NCPL", 1)
+ self.InitNML()
+ check_nml_dtime(self.nmlgen, self.case)
+ expect(
+ self.nmlgen.get_value("dtime"),
+ 3600,
+ "dtime should be 3600 seconds for an hour",
+ )
+ self.case.set_value("NCPL_BASE_PERIOD", "day")
+ self.case.set_value("CALENDAR", "NO_LEAP")
+ self.case.set_value("LND_NCPL", 48)
+ self.InitNML()
+ check_nml_dtime(self.nmlgen, self.case)
+ expect(
+ self.nmlgen.get_value("dtime"),
+ 1800,
+ "dtime should be 1800 seconds for 48 cycles per day",
+ )
+ self.case.set_value("NCPL_BASE_PERIOD", "year")
+ self.case.set_value("CALENDAR", "NO_LEAP")
+ self.case.set_value("LND_NCPL", 365)
+ self.InitNML()
+ check_nml_dtime(self.nmlgen, self.case)
+ expect(
+ self.nmlgen.get_value("dtime"),
+ 86400,
+ "dtime should be 86400 seconds for 365 cycles per year",
+ )
+ self.case.set_value("NCPL_BASE_PERIOD", "year")
+ self.case.set_value("CALENDAR", "NO_LEAP")
+ self.case.set_value("LND_NCPL", 36500)
+ self.InitNML()
+ check_nml_dtime(self.nmlgen, self.case)
+ expect(
+ self.nmlgen.get_value("dtime"),
+ 8640,
+ "dtime should be 8640 seconds for 36500 cycles per decade",
+ )
+
+ def test_check_dtime_fail_invalid_cal_year(self):
+ """Test the check nml dtime fail test for invalid calendar year"""
+ self.case.set_value("NCPL_BASE_PERIOD", "year")
+ self.case.set_value("CALENDAR", "GREGORIAN")
+ self.case.set_value("LND_NCPL", 1)
+ with self.assertRaisesRegex(
+ SystemExit, "ERROR: Invalid CALENDAR for NCPL_BASE_PERIOD year"
+ ):
+ check_nml_dtime(self.nmlgen, self.case)
+
+ def test_check_dtime_fail_invalid_cal_decade(self):
+ """Test the check nml dtime fail test for invalid calendar decade"""
+ self.case.set_value("NCPL_BASE_PERIOD", "decade")
+ self.case.set_value("CALENDAR", "GREGORIAN")
+ self.case.set_value("LND_NCPL", 1)
+ with self.assertRaisesRegex(
+ SystemExit, "ERROR: Invalid CALENDAR for NCPL_BASE_PERIOD decade"
+ ):
+ check_nml_dtime(self.nmlgen, self.case)
+
+ def test_check_dtime_fail_invalid_base_period(self):
+ """Test the check nml dtime fail test for invalid base period"""
+ self.case.set_value("NCPL_BASE_PERIOD", "minute")
+ self.case.set_value("CALENDAR", "GREGORIAN")
+ self.case.set_value("LND_NCPL", 1)
+ with self.assertRaisesRegex(SystemExit, "ERROR: Invalid NCPL_BASE_PERIOD "):
+ check_nml_dtime(self.nmlgen, self.case)
+
+ def test_check_dtime_fail_invalid_division(self):
+ """Test the check nml dtime fail test for invalid coupling division"""
+ self.case.set_value("NCPL_BASE_PERIOD", "day")
+ self.case.set_value("CALENDAR", "GREGORIAN")
+ self.case.set_value("LND_NCPL", 47)
+ with self.assertRaisesRegex(
+ SystemExit, "ERROR: LND_NCPL=47 doesn't divide evenly into NCPL_BASE_PERIOD day"
+ ):
+ check_nml_dtime(self.nmlgen, self.case)
+
+ def test_check_dtime_fail_too_short(self):
+ """Test the check nml dtime fail test for too short"""
+ self.case.set_value("NCPL_BASE_PERIOD", "hour")
+ self.case.set_value("LND_NCPL", 3600)
+ with self.assertRaisesRegex(
+ SystemExit,
+ "ERROR: LND_NCPL=3600 is too frequent which gives a time step that is too short",
+ ):
+ check_nml_dtime(self.nmlgen, self.case)
+
+ def test_check_dtime_fail_too_long(self):
+ """Test the check nml dtime fail test for too long"""
+ self.case.set_value("NCPL_BASE_PERIOD", "year")
+ self.case.set_value("CALENDAR", "NO_LEAP")
+ self.case.set_value("LND_NCPL", 5)
+ with self.assertRaisesRegex(
+ SystemExit,
+ "ERROR: LND_NCPL=5 is too infrequent which gives a time step that is too long",
+ ):
+ check_nml_dtime(self.nmlgen, self.case)
+
+
+if __name__ == "__main__":
+ unit_testing.setup_for_tests()
+ unittest.main()
diff --git a/python/slim/test/test_unit_modify_surdat.py b/python/slim/test/test_unit_modify_surdat.py
new file mode 100755
index 00000000..76654054
--- /dev/null
+++ b/python/slim/test/test_unit_modify_surdat.py
@@ -0,0 +1,371 @@
+#!/usr/bin/env python3
+
+"""
+Unit tests for _get_rectangle
+"""
+
+import unittest
+
+import numpy as np
+import xarray as xr
+
+from slim import unit_testing
+from slim.config_utils import lon_range_0_to_360
+from slim.modify_input_files.modify_surdat import ModifySurdat
+
+# Allow test names that pylint doesn't like; otherwise hard to make them
+# readable
+# pylint: disable=invalid-name
+
+# pylint: disable=protected-access
+
+
+class TestModifySurdat(unittest.TestCase):
+ """Tests the setvar_lev functions and the _get_rectangle function"""
+
+ def test_setvarLev1(self):
+ """
+ Tests that setvar_lev1 updates values of
+ variables within a rectangle defined by user-specified
+ lon_1, lon_2, lat_1, lat_2
+ """
+ # get longxy, latixy that would normally come from a surdat file
+ # self._get_longxy_latixy will convert -180 to 180 to 0-360 longitudes
+ # get cols, rows also
+ min_lon = 2 # expects min_lon < max_lon
+ min_lat = 3 # expects min_lat < max_lat
+ longxy, latixy, cols, rows = self._get_longxy_latixy(
+ _min_lon=min_lon, _max_lon=10, _min_lat=min_lat, _max_lat=12
+ )
+
+ # get not_rectangle from user-defined lon_1, lon_2, lat_1, lat_2
+ lon_1 = 3
+ lon_2 = 5 # lon_1 < lon_2
+ lat_1 = 5
+ lat_2 = 7 # lat_1 < lat_2
+
+ # create xarray dataset containing lev1 variables;
+ # the surdat_modify tool reads variables like this from surdat file
+ var_1d = np.arange(cols)
+ var_lev1 = var_1d * np.ones((cols, rows, cols))
+ my_data = xr.Dataset(
+ data_vars=dict(
+ time=(["z"], np.arange(12)), # __init__ expects time
+ lsmlon=(["x", "y"], longxy),
+ lsmlat=(["x", "y"], latixy), # __init__ expects lsmlon, lsmlat
+ var_lev1=(["w", "x", "y"], var_lev1),
+ )
+ )
+
+ # create ModifySurdat object
+ modify_surdat = ModifySurdat(
+ my_data=my_data,
+ lon_1=lon_1,
+ lon_2=lon_2,
+ lat_1=lat_1,
+ lat_2=lat_2,
+ landmask_file=None,
+ lat_dimname=None,
+ lon_dimname=None,
+ )
+
+ # initialize and then modify the comparison matrices
+ comp_lev1 = modify_surdat.file.var_lev1
+ val_for_rectangle = 1.5
+ comp_lev1[
+ ...,
+ lat_1 - min_lat : lat_2 - min_lat + 1,
+ lon_1 - min_lon : lon_2 - min_lon + 1,
+ ] = val_for_rectangle
+
+ # test setvar
+ modify_surdat.setvar_lev1("var_lev1", val_for_rectangle, cols - 1)
+ np.testing.assert_array_equal(modify_surdat.file.var_lev1, comp_lev1)
+
+ def test_getNotRectangle_lon1leLon2Lat1leLat2(self):
+ """
+ Tests that not_rectangle is True and False in the grid cells expected
+ according to the user-specified lon_1, lon_2, lat_1, lat_2
+ When lon_1 <= lon_2 and lat_1 <= lat_2, expect not_rectangle to be
+ False in a rectangle bounded by these lon/lat values
+ Work with integer lon/lat values to keep the testing simple
+ """
+ # get longxy, latixy that would normally come from a surdat file
+ # self._get_longxy_latixy will convert -180 to 180 to 0-360 longitudes
+ # get cols, rows also
+ min_lon = 2 # expects min_lon < max_lon
+ min_lat = 3 # expects min_lat < max_lat
+ longxy, latixy, cols, rows = self._get_longxy_latixy(
+ _min_lon=min_lon, _max_lon=7, _min_lat=min_lat, _max_lat=8
+ )
+
+ # get not_rectangle from user-defined lon_1, lon_2, lat_1, lat_2
+ lon_1 = 3
+ lon_2 = 5 # lon_1 < lon_2
+ lat_1 = 6
+ lat_2 = 8 # lat_1 < lat_2
+ rectangle = ModifySurdat._get_rectangle(
+ lon_1=lon_1,
+ lon_2=lon_2,
+ lat_1=lat_1,
+ lat_2=lat_2,
+ longxy=longxy,
+ latixy=latixy,
+ )
+ not_rectangle = np.logical_not(rectangle)
+ compare = np.ones((rows, cols))
+ # assert this to confirm intuitive understanding of these matrices
+ self.assertEqual(np.size(not_rectangle), np.size(compare))
+
+ # Hardwire where I expect not_rectangle to be False (0)
+ # I have chosen the lon/lat ranges to match their corresponding index
+ # values to keep this simple
+ compare[lat_1 - min_lat : lat_2 - min_lat + 1, lon_1 - min_lon : lon_2 - min_lon + 1] = 0
+ np.testing.assert_array_equal(not_rectangle, compare)
+
+ def test_getNotRectangle_lon1leLon2Lat1gtLat2(self):
+ """
+ Tests that not_rectangle is True and False in the grid cells expected
+ according to the user-specified lon_1, lon_2, lat_1, lat_2
+ When lon_1 <= lon_2 and lat_1 > lat_2, expect not_rectangle to be
+ False in two rectangles bounded by these lon/lat values, one to the
+ north of lat_1 and one to the south of lat_2
+ Work with integer lon/lat values to keep the testing simple
+ """
+ # get longxy, latixy that would normally come from an surdat file
+ # self._get_longxy_latixy will convert -180 to 180 to 0-360 longitudes
+ # get cols, rows also
+ min_lon = -3 # expects min_lon < max_lon
+ min_lat = -2 # expects min_lat < max_lat
+ longxy, latixy, cols, rows = self._get_longxy_latixy(
+ _min_lon=min_lon, _max_lon=6, _min_lat=min_lat, _max_lat=5
+ )
+
+ # get not_rectangle from user-defined lon_1, lon_2, lat_1, lat_2
+ # I have chosen the lon/lat ranges to match their corresponding index
+ # values to keep this simple (see usage below)
+ lon_1 = 0
+ lon_2 = 4 # lon_1 < lon_2
+ lat_1 = 4
+ lat_2 = 0 # lat_1 > lat_2
+ rectangle = ModifySurdat._get_rectangle(
+ lon_1=lon_1,
+ lon_2=lon_2,
+ lat_1=lat_1,
+ lat_2=lat_2,
+ longxy=longxy,
+ latixy=latixy,
+ )
+ not_rectangle = np.logical_not(rectangle)
+ compare = np.ones((rows, cols))
+ # assert this to confirm intuitive understanding of these matrices
+ self.assertEqual(np.size(not_rectangle), np.size(compare))
+
+ # Hardwire where I expect not_rectangle to be False (0)
+ # I have chosen the lon/lat ranges to match their corresponding index
+ # values to keep this simple
+ compare[: lat_2 - min_lat + 1, lon_1 - min_lon : lon_2 - min_lon + 1] = 0
+ compare[lat_1 - min_lat :, lon_1 - min_lon : lon_2 - min_lon + 1] = 0
+ np.testing.assert_array_equal(not_rectangle, compare)
+
+ def test_getNotRectangle_lon1gtLon2Lat1leLat2(self):
+ """
+ Tests that not_rectangle is True and False in the grid cells expected
+ according to the user-specified lon_1, lon_2, lat_1, lat_2
+ When lon_1 > lon_2 and lat_1 <= lat_2, expect not_rectangle to be
+ False in two rectangles bounded by these lon/lat values, one to the
+ east of lat_1 and one to the west of lat_2
+ Work with integer lon/lat values to keep the testing simple
+ """
+ # get longxy, latixy that would normally come from an surdat file
+ # self._get_longxy_latixy will convert -180 to 180 to 0-360 longitudes
+ # get cols, rows also
+ min_lon = 1 # expects min_lon < max_lon
+ min_lat = 1 # expects min_lat < max_lat
+ longxy, latixy, cols, rows = self._get_longxy_latixy(
+ _min_lon=min_lon, _max_lon=359, _min_lat=min_lat, _max_lat=90
+ )
+
+ # get not_rectangle from user-defined lon_1, lon_2, lat_1, lat_2
+ # I have chosen the lon/lat ranges to match their corresponding index
+ # values to keep this simple (see usage below)
+ lon_1 = 4
+ lon_2 = 2 # lon_1 > lon_2
+ lat_1 = 2
+ lat_2 = 3 # lat_1 < lat_2
+ rectangle = ModifySurdat._get_rectangle(
+ lon_1=lon_1,
+ lon_2=lon_2,
+ lat_1=lat_1,
+ lat_2=lat_2,
+ longxy=longxy,
+ latixy=latixy,
+ )
+ not_rectangle = np.logical_not(rectangle)
+ compare = np.ones((rows, cols))
+ # assert this to confirm intuitive understanding of these matrices
+ self.assertEqual(np.size(not_rectangle), np.size(compare))
+
+ # Hardwire where I expect not_rectangle to be False (0)
+ # I have chosen the lon/lat ranges to match their corresponding index
+ # values to keep this simple
+ compare[lat_1 - min_lat : lat_2 - min_lat + 1, : lon_2 - min_lon + 1] = 0
+ compare[lat_1 - min_lat : lat_2 - min_lat + 1, lon_1 - min_lon :] = 0
+ np.testing.assert_array_equal(not_rectangle, compare)
+
+ def test_getNotRectangle_lon1gtLon2Lat1gtLat2(self):
+ """
+ Tests that not_rectangle is True and False in the grid cells expected
+ according to the user-specified lon_1, lon_2, lat_1, lat_2
+ When lon_1 > lon_2 and lat_1 > lat_2, expect not_rectangle to be
+ False in four rectangles bounded by these lon/lat values, in the
+ top left, top right, bottom left, and bottom right of the domain
+ Work with integer lon/lat values to keep the testing simple
+ """
+ # get longxy, latixy that would normally come from an surdat file
+ # self._get_longxy_latixy will convert -180 to 180 to 0-360 longitudes
+ # get cols, rows also
+ min_lon = -8 # expects min_lon < max_lon
+ min_lat = -9 # expects min_lat < max_lat
+ longxy, latixy, cols, rows = self._get_longxy_latixy(
+ _min_lon=min_lon, _max_lon=5, _min_lat=min_lat, _max_lat=6
+ )
+
+ # get not_rectangle from user-defined lon_1, lon_2, lat_1, lat_2
+ # I have chosen the lon/lat ranges to match their corresponding index
+ # values to keep this simple (see usage below)
+ lon_1 = -1
+ lon_2 = -6 # lon_1 > lon_2
+ lat_1 = 0
+ lat_2 = -3 # lat_1 > lat_2
+ rectangle = ModifySurdat._get_rectangle(
+ lon_1=lon_1,
+ lon_2=lon_2,
+ lat_1=lat_1,
+ lat_2=lat_2,
+ longxy=longxy,
+ latixy=latixy,
+ )
+ not_rectangle = np.logical_not(rectangle)
+ compare = np.ones((rows, cols))
+ # assert this to confirm intuitive understanding of these matrices
+ self.assertEqual(np.size(not_rectangle), np.size(compare))
+
+ # Hardwire where I expect not_rectangle to be False (0)
+ # I have chosen the lon/lat ranges to match their corresponding index
+ # values to keep this simple
+ compare[: lat_2 - min_lat + 1, : lon_2 - min_lon + 1] = 0
+ compare[: lat_2 - min_lat + 1, lon_1 - min_lon :] = 0
+ compare[lat_1 - min_lat :, : lon_2 - min_lon + 1] = 0
+ compare[lat_1 - min_lat :, lon_1 - min_lon :] = 0
+ np.testing.assert_array_equal(not_rectangle, compare)
+
+ def test_getNotRectangle_lonsStraddle0deg(self):
+ """
+ Tests that not_rectangle is True and False in the grid cells expected
+ according to the user-specified lon_1, lon_2, lat_1, lat_2
+ When lon_1 > lon_2 and lat_1 > lat_2, expect not_rectangle to be
+ False in four rectangles bounded by these lon/lat values, in the
+ top left, top right, bottom left, and bottom right of the domain
+ Work with integer lon/lat values to keep the testing simple
+ """
+ # get longxy, latixy that would normally come from an surdat file
+ # self._get_longxy_latixy will convert -180 to 180 to 0-360 longitudes
+ # get cols, rows also
+ min_lon = 0 # expects min_lon < max_lon
+ min_lat = -5 # expects min_lat < max_lat
+ longxy, latixy, cols, rows = self._get_longxy_latixy(
+ _min_lon=min_lon, _max_lon=359, _min_lat=min_lat, _max_lat=5
+ )
+
+ # get not_rectangle from user-defined lon_1, lon_2, lat_1, lat_2
+ # I have chosen the lon/lat ranges to match their corresponding index
+ # values to keep this simple (see usage below)
+ lon_1 = 355
+ lon_2 = 5 # lon_1 > lon_2
+ lat_1 = -4
+ lat_2 = -6 # lat_1 > lat_2
+ rectangle = ModifySurdat._get_rectangle(
+ lon_1=lon_1,
+ lon_2=lon_2,
+ lat_1=lat_1,
+ lat_2=lat_2,
+ longxy=longxy,
+ latixy=latixy,
+ )
+ not_rectangle = np.logical_not(rectangle)
+ compare = np.ones((rows, cols))
+ # assert this to confirm intuitive understanding of these matrices
+ self.assertEqual(np.size(not_rectangle), np.size(compare))
+
+ # Hardwire where I expect not_rectangle to be False (0)
+ # I have chosen the lon/lat ranges to match their corresponding index
+ # values to keep this simple
+ compare[: lat_2 - min_lat + 1, : lon_2 - min_lon + 1] = 0
+ compare[: lat_2 - min_lat + 1, lon_1 - min_lon :] = 0
+ compare[lat_1 - min_lat :, : lon_2 - min_lon + 1] = 0
+ compare[lat_1 - min_lat :, lon_1 - min_lon :] = 0
+ np.testing.assert_array_equal(not_rectangle, compare)
+
+ def test_getNotRectangle_latsOutOfBounds(self):
+ """
+ Tests that out-of-bound latitude values abort with message
+ Out-of-bound longitudes already tested in test_unit_utils.py
+ """
+ # get longxy, latixy that would normally come from an surdat file
+ # self._get_longxy_latixy will convert -180 to 180 to 0-360 longitudes
+ # get cols, rows also
+ min_lon = 0 # expects min_lon < max_lon
+ min_lat = -5 # expects min_lat < max_lat
+ longxy, latixy, _, _ = self._get_longxy_latixy(
+ _min_lon=min_lon, _max_lon=359, _min_lat=min_lat, _max_lat=5
+ )
+
+ # get not_rectangle from user-defined lon_1, lon_2, lat_1, lat_2
+ # I have chosen the lon/lat ranges to match their corresponding index
+ # values to keep this simple (see usage below)
+ lon_1 = 355
+ lon_2 = 5
+ lat_1 = -91
+ lat_2 = 91
+ with self.assertRaisesRegex(
+ SystemExit, "lat_1 and lat_2 need to be in the range -90 to 90"
+ ):
+ _ = ModifySurdat._get_rectangle(
+ lon_1=lon_1,
+ lon_2=lon_2,
+ lat_1=lat_1,
+ lat_2=lat_2,
+ longxy=longxy,
+ latixy=latixy,
+ )
+
+ def _get_longxy_latixy(self, _min_lon, _max_lon, _min_lat, _max_lat):
+ """
+ Return longxy, latixy, cols, rows
+ """
+ cols = _max_lon - _min_lon + 1
+ rows = _max_lat - _min_lat + 1
+
+ long = np.arange(_min_lon, _max_lon + 1)
+ long = [lon_range_0_to_360(longitude) for longitude in long]
+ longxy = long * np.ones((rows, cols))
+ compare = np.repeat([long], rows, axis=0) # alternative way to form
+ # assert this to confirm intuitive understanding of these matrices
+ np.testing.assert_array_equal(longxy, compare)
+
+ lati = np.arange(_min_lat, _max_lat + 1)
+ self.assertEqual(min(lati), _min_lat)
+ self.assertEqual(max(lati), _max_lat)
+ latixy_transp = lati * np.ones((cols, rows))
+ compare = np.repeat([lati], cols, axis=0) # alternative way to form
+ # assert this to confirm intuitive understanding of these matrices
+ np.testing.assert_array_equal(latixy_transp, compare)
+ latixy = np.transpose(latixy_transp)
+
+ return longxy, latixy, cols, rows
+
+
+if __name__ == "__main__":
+ unit_testing.setup_for_tests()
+ unittest.main()
diff --git a/python/slim/test/test_unit_path_utils.py b/python/slim/test/test_unit_path_utils.py
new file mode 100755
index 00000000..823bf109
--- /dev/null
+++ b/python/slim/test/test_unit_path_utils.py
@@ -0,0 +1,189 @@
+#!/usr/bin/env python3
+
+"""Unit tests for path_utils
+"""
+
+import unittest
+import tempfile
+import shutil
+import os
+
+from unittest import mock
+from slim import unit_testing
+from slim import path_utils
+
+# Allow names that pylint doesn't like, because otherwise I find it hard
+# to make readable unit test names
+# pylint: disable=invalid-name
+
+
+class TestPathUtils(unittest.TestCase):
+ """Tests of path_utils"""
+
+ def setUp(self):
+ self._testdir = tempfile.mkdtemp()
+
+ def tearDown(self):
+ shutil.rmtree(self._testdir, ignore_errors=True)
+
+ def _slim_cime_py_path_in_cesm(self):
+ """Returns the path to a cime_config directory inside a typical cesm
+ directory structure, where self._testdir is the root of cesm checkout
+ """
+ return os.path.join(self._slim_path_in_cesm(), "cime_config")
+
+ def _slim_path_in_cesm(self):
+ """Returns the path to a slim directory nested inside a typical cesm
+ directory structure, where self._testdir is the root of the cesm
+ checkout
+ """
+ return os.path.join(self._testdir, "components", "slim")
+
+ def _cime_path_in_cesm(self):
+ """Returns the path to a cime directory nested inside a typical
+ cesm directory structure, where self._testdir is the root of the
+ cesm checkout
+ """
+ return os.path.join(self._testdir, "cime")
+
+ def _make_cesm_dirs(self):
+ """Makes a directory structure for a typical CESM layout, where
+ self._testdir is the root of the CESM checkout.
+
+ This makes the slim directory, cime_config and the cime directory.
+
+ Returns a tuple, (slim_path, cime_config, cime_path)
+ """
+ slim_path = self._slim_path_in_cesm()
+ slim_cime_py_path = self._slim_cime_py_path_in_cesm()
+ cime_path = self._cime_path_in_cesm()
+ os.makedirs(slim_path)
+ os.makedirs(slim_cime_py_path)
+ os.makedirs(cime_path)
+ return (slim_path, slim_cime_py_path, cime_path)
+
+ def test_pathToCime_standaloneOnlyWithCime(self):
+ """Test path_to_cime with standalone_only, where cime is in the location
+ it should be with a standalone checkout
+ """
+ slim_path = os.path.join(self._testdir, "slim")
+ actual_cime_py_path = os.path.join(slim_path, "cime_config")
+ actual_path_to_cime = os.path.join(slim_path, "cime")
+ os.makedirs(actual_cime_py_path)
+ os.makedirs(actual_path_to_cime)
+
+ with mock.patch("slim.path_utils.path_to_slim_root", return_value=slim_path):
+ path_to_cime = path_utils.path_to_cime(standalone_only=True)
+ path_to_slim_cime_py = actual_cime_py_path
+
+ self.assertEqual(path_to_cime, actual_path_to_cime)
+ self.assertEqual(path_to_slim_cime_py, actual_cime_py_path)
+
+ def test_pathToCime_standaloneOnlyWithoutCime(self):
+ """Test path_to_cime with standalone_only, where cime is missing"""
+ slim_path = os.path.join(self._testdir, "slim")
+ actual_cime_py_path = os.path.join(slim_path, "cime_config")
+ os.makedirs(actual_cime_py_path)
+
+ with mock.patch("slim.path_utils.path_to_slim_root", return_value=slim_path):
+ path_to_slim_cime_py = actual_cime_py_path
+ with self.assertRaisesRegex(RuntimeError, "Cannot find cime"):
+ _ = path_utils.path_to_cime(standalone_only=True)
+
+ self.assertEqual(path_to_slim_cime_py, actual_cime_py_path)
+
+ def test_pathToCime_standaloneOnlyWithCimeInCesm(self):
+ """Test path_to_cime with standalone_only, where cime is missing from
+ the standalone structure, but cime is present in the CESM
+ directory structure: should raise an exception rather than
+ finding that cime
+ """
+ slim_path, actual_path_to_slim_cime_py, _ = self._make_cesm_dirs()
+
+ with mock.patch("slim.path_utils.path_to_slim_root", return_value=slim_path):
+ path_to_slim_cime_py = actual_path_to_slim_cime_py
+ with self.assertRaisesRegex(RuntimeError, "Cannot find cime"):
+ _ = path_utils.path_to_cime(standalone_only=True)
+
+ self.assertEqual(path_to_slim_cime_py, actual_path_to_slim_cime_py)
+
+ def test_pathToCime_cimeInCesm(self):
+ """Test path_to_cime, where cime is not in the standalone directory but
+ is present in the CESM directory structure
+ """
+ slim_path, actual_path_to_slim_cime_py, actual_path_to_cime = self._make_cesm_dirs()
+
+ with mock.patch("slim.path_utils.path_to_slim_root", return_value=slim_path):
+ path_to_slim_cime_py = actual_path_to_slim_cime_py
+ path_to_cime = path_utils.path_to_cime()
+
+ self.assertEqual(path_to_cime, actual_path_to_cime)
+ self.assertEqual(path_to_slim_cime_py, actual_path_to_slim_cime_py)
+
+ def test_pathToCime_notInCesmCheckout(self):
+ """Test path_to_cime, where cime is not in the standalone directory, and
+ we don't appear to be in a CESM checkout
+ """
+ slim_path = os.path.join(self._testdir, "components", "foo")
+ actual_cime_py_path = os.path.join(slim_path, "cime_config")
+ os.makedirs(actual_cime_py_path)
+ os.makedirs(self._cime_path_in_cesm())
+
+ with mock.patch("slim.path_utils.path_to_slim_root", return_value=slim_path):
+ path_to_slim_cime_py = actual_cime_py_path
+ with self.assertRaisesRegex(
+ RuntimeError,
+ "Cannot find cime.*don't seem to be within a CESM checkout",
+ ):
+ _ = path_utils.path_to_cime()
+
+ self.assertEqual(path_to_slim_cime_py, actual_cime_py_path)
+
+ def test_pathToCime_noCimeInCesm(self):
+ """Test path_to_cime, where we appear to be within a CESM checkout, but
+ there is no cime directory"""
+ slim_path = self._slim_path_in_cesm()
+ actual_cime_py_path = os.path.join(slim_path, "cime_config")
+ os.makedirs(actual_cime_py_path)
+
+ with mock.patch("slim.path_utils.path_to_slim_root", return_value=slim_path):
+ path_to_slim_cime_py = actual_cime_py_path
+ with self.assertRaisesRegex(RuntimeError, "Cannot find cime.*or within CESM checkout"):
+ _ = path_utils.path_to_cime()
+
+ self.assertEqual(path_to_slim_cime_py, actual_cime_py_path)
+
+ def test_pathToCime_cimeInStandaloneAndCesm(self):
+ """Test path_to_cime, where there is a cime directory both in the
+ standalone checkout and in the enclosing CESM checkout. Should
+ give us the cime in the standalone checkout.
+ """
+ slim_path, actual_cime_py_path, _ = self._make_cesm_dirs()
+ actual_path_to_cime = os.path.join(slim_path, "cime")
+ os.makedirs(actual_path_to_cime)
+
+ with mock.patch("slim.path_utils.path_to_slim_root", return_value=slim_path):
+ path_to_slim_cime_py = actual_cime_py_path
+ path_to_cime = path_utils.path_to_cime()
+
+ self.assertEqual(path_to_slim_cime_py, actual_cime_py_path)
+ self.assertEqual(path_to_cime, actual_path_to_cime)
+
+ def test_path_to_slim_and_slim_cime_py_work(self):
+ """Test that the methods to get the path to slim and the path to slim_cime_py both work
+ And check that they are as expected to expected relative path to current location
+ """
+ this_dir = os.path.dirname(os.path.abspath(__file__))
+ expected_slim_path = os.path.normpath(
+ os.path.join(this_dir, os.path.pardir, os.path.pardir, os.path.pardir)
+ )
+ expected_cime_py_path = os.path.join(expected_slim_path, "cime_config")
+ slim_path = path_utils.path_to_slim_root()
+ cime_py_path = path_utils.path_to_slim_cime_py_root()
+ self.assertEqual(slim_path, expected_slim_path)
+ self.assertEqual(cime_py_path, expected_cime_py_path)
+
+
+if __name__ == "__main__":
+ unit_testing.setup_for_tests()
+ unittest.main()
diff --git a/python/slim/unit_testing.py b/python/slim/unit_testing.py
new file mode 100644
index 00000000..38a85aad
--- /dev/null
+++ b/python/slim/unit_testing.py
@@ -0,0 +1,15 @@
+"""Functions to aid unit tests"""
+
+from slim.slim_logging import setup_logging_for_tests
+
+
+def setup_for_tests(enable_critical_logs=False):
+ """Call this at the beginning of unit testing
+
+ Does various setup that would normally be done by the top-level application/script
+
+ Args:
+ enable_critical_logs (bool): If True, then critical logging messages will be output;
+ if False, then even critical messages will be suppressed
+ """
+ setup_logging_for_tests(enable_critical_logs)
diff --git a/python/slim/utils.py b/python/slim/utils.py
new file mode 100644
index 00000000..44fc4664
--- /dev/null
+++ b/python/slim/utils.py
@@ -0,0 +1,107 @@
+"""General-purpose utility functions"""
+
+import logging
+import os
+import sys
+import pdb
+
+from datetime import date
+from getpass import getuser
+
+from slim.git_utils import get_slim_git_short_hash
+
+logger = logging.getLogger(__name__)
+
+
+def abort(errmsg):
+ """Abort the program with the given error message
+
+ No traceback is given, but if the logging level is DEBUG, then we'll enter pdb
+ """
+ if logger.isEnabledFor(logging.DEBUG):
+ pdb.set_trace()
+
+ sys.exit("ERROR: {}".format(errmsg))
+
+
+def update_metadata(file, title, summary, contact, data_script, description):
+ """
+ Description
+ -----------
+ Update netcdf file's metadata
+ Arguments
+ ---------
+ title: No more than short one-sentence explanation.
+ summary: No more than two-sentence explanation.
+ contact: E.g. CAM bulletin board at https://bb.cgd.ucar.edu
+ data_script: Script or instructions used to generate the dataset.
+ description: Anything else that's relevant. Capturing the command-line
+ would be good (sys.argv) here or in data_script.
+ """
+
+ # update attributes
+ today = date.today()
+ today_string = today.strftime("%Y-%m-%d")
+
+ # This is the required metadata for inputdata files
+ file.attrs["title"] = title
+ file.attrs["summary"] = summary
+ file.attrs["creator"] = getuser()
+ file.attrs["contact"] = contact
+ file.attrs["creation_date"] = today_string
+ file.attrs["data_script"] = data_script
+ file.attrs["description"] = description
+
+ # delete unrelated attributes if they exist
+ del_attrs = [
+ "source_code",
+ "SVN_url",
+ "hostname",
+ "history",
+ "History_Log",
+ "Logname",
+ "Host",
+ "Version",
+ "Compiler_Optimized",
+ ]
+ attr_list = file.attrs
+
+ for attr in del_attrs:
+ if attr in attr_list:
+ del file.attrs[attr]
+
+
+def write_output(file, file_in, file_out, file_type):
+ """
+ Description
+ -----------
+ Write output file
+ Arguments
+ ---------
+ file_in:
+ (str) User-defined entry of input file
+ file_out:
+ (str) User-defined entry of output file
+ file_type:
+ (str) examples: mesh, surdat
+ """
+
+ # update attributes
+ title = "Modified " + file_type + " file"
+ summary = "Modified " + file_type + " file"
+ contact = "N/A"
+ data_script = os.path.abspath(__file__) + " -- " + get_slim_git_short_hash()
+ description = "Modified this file: " + file_in
+ update_metadata(
+ file,
+ title=title,
+ summary=summary,
+ contact=contact,
+ data_script=data_script,
+ description=description,
+ )
+
+ # mode 'w' overwrites file if it exists
+ file.to_netcdf(path=file_out, mode="w", format="NETCDF3_64BIT")
+ logger.info("Successfully created: %s", file_out)
+ file.close()
diff --git a/src/biogeochem/CNBalanceCheckMod.F90 b/src/biogeochem/CNBalanceCheckMod.F90
deleted file mode 100644
index f2811d29..00000000
--- a/src/biogeochem/CNBalanceCheckMod.F90
+++ /dev/null
@@ -1,358 +0,0 @@
-module CNBalanceCheckMod
-
- !-----------------------------------------------------------------------
- ! !DESCRIPTION:
- ! Module for carbon/nitrogen mass balance checking.
- !
- ! !USES:
- use shr_kind_mod , only : r8 => shr_kind_r8
- use shr_infnan_mod , only : nan => shr_infnan_nan, assignment(=)
- use shr_log_mod , only : errMsg => shr_log_errMsg
- use decompMod , only : bounds_type
- use abortutils , only : endrun
- use clm_varctl , only : iulog, use_nitrif_denitrif
- use clm_time_manager , only : get_step_size
- use CNVegNitrogenFluxType , only : cnveg_nitrogenflux_type
- use CNVegNitrogenStateType , only : cnveg_nitrogenstate_type
- use CNVegCarbonFluxType , only : cnveg_carbonflux_type
- use CNVegCarbonStateType , only : cnveg_carbonstate_type
- use SoilBiogeochemNitrogenfluxType , only : soilbiogeochem_nitrogenflux_type
- use SoilBiogeochemCarbonfluxType , only : soilbiogeochem_carbonflux_type
- use ColumnType , only : col
- use GridcellType , only : grc
- use CNSharedParamsMod , only : use_fun
-
- !
- implicit none
- private
- !
- ! !PUBLIC TYPES:
- type, public :: cn_balance_type
- private
- real(r8), pointer :: begcb_col(:) ! (gC/m2) carbon mass, beginning of time step
- real(r8), pointer :: endcb_col(:) ! (gC/m2) carbon mass, end of time step
- real(r8), pointer :: begnb_col(:) ! (gN/m2) nitrogen mass, beginning of time step
- real(r8), pointer :: endnb_col(:) ! (gN/m2) nitrogen mass, end of time step
- contains
- procedure , public :: Init
- procedure , public :: BeginCNBalance
- procedure , public :: CBalanceCheck
- procedure , public :: NBalanceCheck
- procedure , private :: InitAllocate
- end type cn_balance_type
- !
-
- character(len=*), parameter, private :: sourcefile = &
- __FILE__
- !-----------------------------------------------------------------------
-
-contains
-
- !-----------------------------------------------------------------------
- subroutine Init(this, bounds)
- class(cn_balance_type) :: this
- type(bounds_type) , intent(in) :: bounds
-
- call this%InitAllocate(bounds)
- end subroutine Init
-
- !-----------------------------------------------------------------------
- subroutine InitAllocate(this, bounds)
- class(cn_balance_type) :: this
- type(bounds_type) , intent(in) :: bounds
-
- integer :: begc, endc
-
- begc = bounds%begc; endc= bounds%endc
-
- allocate(this%begcb_col(begc:endc)) ; this%begcb_col(:) = nan
- allocate(this%endcb_col(begc:endc)) ; this%endcb_col(:) = nan
- allocate(this%begnb_col(begc:endc)) ; this%begnb_col(:) = nan
- allocate(this%endnb_col(begc:endc)) ; this%endnb_col(:) = nan
- end subroutine InitAllocate
-
- !-----------------------------------------------------------------------
- subroutine BeginCNBalance(this, bounds, num_soilc, filter_soilc, &
- cnveg_carbonstate_inst, cnveg_nitrogenstate_inst)
- !
- ! !DESCRIPTION:
- ! Calculate beginning column-level carbon/nitrogen balance, for mass conservation check
- !
- ! Should be called after the CN state summaries have been computed for this time step
- ! (which should be after the dynamic landunit area updates and the associated filter
- ! updates - i.e., using the new version of the filters)
- !
- ! !ARGUMENTS:
- class(cn_balance_type) , intent(inout) :: this
- type(bounds_type) , intent(in) :: bounds
- integer , intent(in) :: num_soilc ! number of soil columns filter
- integer , intent(in) :: filter_soilc(:) ! filter for soil columns
- type(cnveg_carbonstate_type) , intent(in) :: cnveg_carbonstate_inst
- type(cnveg_nitrogenstate_type) , intent(in) :: cnveg_nitrogenstate_inst
- !
- ! !LOCAL VARIABLES:
- integer :: fc,c
- !-----------------------------------------------------------------------
-
- associate( &
- col_begcb => this%begcb_col , & ! Output: [real(r8) (:)] (gC/m2) carbon mass, beginning of time step
- col_begnb => this%begnb_col , & ! Output: [real(r8) (:)] (gN/m2) nitrogen mass, beginning of time step
- totcolc => cnveg_carbonstate_inst%totc_col , & ! Input: [real(r8) (:)] (gC/m2) total column carbon, incl veg and cpool
- totcoln => cnveg_nitrogenstate_inst%totn_col & ! Input: [real(r8) (:)] (gN/m2) total column nitrogen, incl veg
- )
-
- do fc = 1,num_soilc
- c = filter_soilc(fc)
- col_begcb(c) = totcolc(c)
- col_begnb(c) = totcoln(c)
- end do
-
- end associate
-
- end subroutine BeginCNBalance
-
- !-----------------------------------------------------------------------
- subroutine CBalanceCheck(this, bounds, num_soilc, filter_soilc, &
- soilbiogeochem_carbonflux_inst, cnveg_carbonflux_inst, cnveg_carbonstate_inst)
- !
- ! !DESCRIPTION:
- ! Perform carbon mass conservation check for column and patch
- !
- ! !ARGUMENTS:
- class(cn_balance_type) , intent(inout) :: 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
- type(soilbiogeochem_carbonflux_type) , intent(in) :: soilbiogeochem_carbonflux_inst
- type(cnveg_carbonflux_type) , intent(in) :: cnveg_carbonflux_inst
- type(cnveg_carbonstate_type) , intent(inout) :: cnveg_carbonstate_inst
- !
- ! !LOCAL VARIABLES:
- integer :: c,err_index ! indices
- integer :: fc ! lake filter indices
- logical :: err_found ! error flag
- real(r8) :: dt ! radiation time step (seconds)
- real(r8) :: col_cinputs
- real(r8) :: col_coutputs
- real(r8) :: col_errcb(bounds%begc:bounds%endc)
- !-----------------------------------------------------------------------
-
- associate( &
- col_begcb => this%begcb_col , & ! Input: [real(r8) (:) ] (gC/m2) carbon mass, beginning of time step
- col_endcb => this%endcb_col , & ! Output: [real(r8) (:) ] (gC/m2) carbon mass, end of time step
- wood_harvestc => cnveg_carbonflux_inst%wood_harvestc_col , & ! Input: [real(r8) (:) ] (gC/m2/s) wood harvest (to product pools)
- grainc_to_cropprodc => cnveg_carbonflux_inst%grainc_to_cropprodc_col , & ! Input: [real(r8) (:) ] (gC/m2/s) grain C to 1-year crop product pool
- gpp => cnveg_carbonflux_inst%gpp_col , & ! Input: [real(r8) (:) ] (gC/m2/s) gross primary production
- er => cnveg_carbonflux_inst%er_col , & ! Input: [real(r8) (:) ] (gC/m2/s) total ecosystem respiration, autotrophic + heterotrophic
- col_fire_closs => cnveg_carbonflux_inst%fire_closs_col , & ! Input: [real(r8) (:) ] (gC/m2/s) total column-level fire C loss
- col_hrv_xsmrpool_to_atm => cnveg_carbonflux_inst%hrv_xsmrpool_to_atm_col , & ! Input: [real(r8) (:) ] (gC/m2/s) excess MR pool harvest mortality
-
- som_c_leached => soilbiogeochem_carbonflux_inst%som_c_leached_col , & ! Input: [real(r8) (:) ] (gC/m2/s) total SOM C loss from vertical transport
-
- totcolc => cnveg_carbonstate_inst%totc_col & ! Input: [real(r8) (:) ] (gC/m2) total column carbon, incl veg and cpool
- )
-
- ! set time steps
- dt = real( get_step_size(), r8 )
-
- err_found = .false.
- do fc = 1,num_soilc
- c = filter_soilc(fc)
-
- ! calculate the total column-level carbon storage, for mass conservation check
- col_endcb(c) = totcolc(c)
-
- ! calculate total column-level inputs
- col_cinputs = gpp(c)
-
- ! calculate total column-level outputs
- ! er = ar + hr, col_fire_closs includes patch-level fire losses
- col_coutputs = er(c) + col_fire_closs(c) + col_hrv_xsmrpool_to_atm(c)
-
- ! Fluxes to product pools are included in column-level outputs: the product
- ! pools are not included in totcolc, so are outside the system with respect to
- ! these balance checks. (However, the dwt flux to product pools is NOT included,
- ! since col_begcb is initialized after the dynamic area adjustments - i.e.,
- ! after the dwt term has already been taken out.)
- col_coutputs = col_coutputs + &
- wood_harvestc(c) + &
- grainc_to_cropprodc(c)
-
- ! subtract leaching flux
- col_coutputs = col_coutputs - som_c_leached(c)
-
- ! calculate the total column-level carbon balance error for this time step
- col_errcb(c) = (col_cinputs - col_coutputs)*dt - &
- (col_endcb(c) - col_begcb(c))
-
- ! check for significant errors
- if (abs(col_errcb(c)) > 1e-7_r8) then
- err_found = .true.
- err_index = c
- end if
- if (abs(col_errcb(c)) > 1e-8_r8) then
- write(iulog,*) 'cbalance warning',c,col_errcb(c),col_endcb(c)
- end if
-
-
-
- end do ! end of columns loop
-
- if (err_found) then
- c = err_index
- write(iulog,*)'column cbalance error = ', col_errcb(c), c
- write(iulog,*)'Latdeg,Londeg=',grc%latdeg(col%gridcell(c)),grc%londeg(col%gridcell(c))
- write(iulog,*)'begcb = ',col_begcb(c)
- write(iulog,*)'endcb = ',col_endcb(c)
- write(iulog,*)'delta store = ',col_endcb(c)-col_begcb(c)
- write(iulog,*)'--- Inputs ---'
- write(iulog,*)'gpp = ',gpp(c)*dt
- write(iulog,*)'--- Outputs ---'
- write(iulog,*)'er = ',er(c)*dt
- write(iulog,*)'col_fire_closs = ',col_fire_closs(c)*dt
- write(iulog,*)'col_hrv_xsmrpool_to_atm = ',col_hrv_xsmrpool_to_atm(c)*dt
- write(iulog,*)'wood_harvestc = ',wood_harvestc(c)*dt
- write(iulog,*)'grainc_to_cropprodc = ',grainc_to_cropprodc(c)*dt
- write(iulog,*)'-1*som_c_leached = ',som_c_leached(c)*dt
- call endrun(msg=errMsg(sourcefile, __LINE__))
- end if
-
- end associate
-
- end subroutine CBalanceCheck
-
- !-----------------------------------------------------------------------
- subroutine NBalanceCheck(this, bounds, num_soilc, filter_soilc, &
- soilbiogeochem_nitrogenflux_inst, cnveg_nitrogenflux_inst, cnveg_nitrogenstate_inst)
- !
- ! !DESCRIPTION:
- ! Perform nitrogen mass conservation check
- !
- ! !USES:
- use clm_varctl, only : use_crop
- !
- ! !ARGUMENTS:
- class(cn_balance_type) , intent(inout) :: 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
- type(soilbiogeochem_nitrogenflux_type) , intent(in) :: soilbiogeochem_nitrogenflux_inst
- type(cnveg_nitrogenflux_type) , intent(in) :: cnveg_nitrogenflux_inst
- type(cnveg_nitrogenstate_type) , intent(inout) :: cnveg_nitrogenstate_inst
- !
- ! !LOCAL VARIABLES:
- integer :: c,err_index,j ! indices
- integer :: fc ! lake filter indices
- logical :: err_found ! error flag
- real(r8):: dt ! radiation time step (seconds)
- real(r8):: col_ninputs(bounds%begc:bounds%endc)
- real(r8):: col_noutputs(bounds%begc:bounds%endc)
- real(r8):: col_errnb(bounds%begc:bounds%endc)
- !-----------------------------------------------------------------------
-
- associate( &
- col_begnb => this%begnb_col , & ! Input: [real(r8) (:) ] (gN/m2) nitrogen mass, beginning of time step
- col_endnb => this%endnb_col , & ! Output: [real(r8) (:) ] (gN/m2) nitrogen mass, end of time step
- ndep_to_sminn => soilbiogeochem_nitrogenflux_inst%ndep_to_sminn_col , & ! Input: [real(r8) (:) ] (gN/m2/s) atmospheric N deposition to soil mineral N
- nfix_to_sminn => soilbiogeochem_nitrogenflux_inst%nfix_to_sminn_col , & ! Input: [real(r8) (:) ] (gN/m2/s) symbiotic/asymbiotic N fixation to soil mineral N
- ffix_to_sminn => soilbiogeochem_nitrogenflux_inst%ffix_to_sminn_col , & ! Input: [real(r8) (:) ] (gN/m2/s) free living N fixation to soil mineral N
- fert_to_sminn => soilbiogeochem_nitrogenflux_inst%fert_to_sminn_col , & ! Input: [real(r8) (:) ] (gN/m2/s)
- soyfixn_to_sminn => soilbiogeochem_nitrogenflux_inst%soyfixn_to_sminn_col , & ! Input: [real(r8) (:) ] (gN/m2/s)
- supplement_to_sminn => soilbiogeochem_nitrogenflux_inst%supplement_to_sminn_col , & ! Input: [real(r8) (:) ] (gN/m2/s) supplemental N supply
- denit => soilbiogeochem_nitrogenflux_inst%denit_col , & ! Input: [real(r8) (:) ] (gN/m2/s) total rate of denitrification
- sminn_leached => soilbiogeochem_nitrogenflux_inst%sminn_leached_col , & ! Input: [real(r8) (:) ] (gN/m2/s) soil mineral N pool loss to leaching
- smin_no3_leached => soilbiogeochem_nitrogenflux_inst%smin_no3_leached_col , & ! Input: [real(r8) (:) ] (gN/m2/s) soil mineral NO3 pool loss to leaching
- smin_no3_runoff => soilbiogeochem_nitrogenflux_inst%smin_no3_runoff_col , & ! Input: [real(r8) (:) ] (gN/m2/s) soil mineral NO3 pool loss to runoff
- f_n2o_nit => soilbiogeochem_nitrogenflux_inst%f_n2o_nit_col , & ! Input: [real(r8) (:) ] (gN/m2/s) flux of N2o from nitrification
- som_n_leached => soilbiogeochem_nitrogenflux_inst%som_n_leached_col , & ! Input: [real(r8) (:) ] (gN/m2/s) total SOM N loss from vertical transport
-
- col_fire_nloss => cnveg_nitrogenflux_inst%fire_nloss_col , & ! Input: [real(r8) (:) ] (gN/m2/s) total column-level fire N loss
- wood_harvestn => cnveg_nitrogenflux_inst%wood_harvestn_col , & ! Input: [real(r8) (:) ] (gN/m2/s) wood harvest (to product pools)
- grainn_to_cropprodn => cnveg_nitrogenflux_inst%grainn_to_cropprodn_col , & ! Input: [real(r8) (:) ] (gN/m2/s) grain N to 1-year crop product pool
-
- totcoln => cnveg_nitrogenstate_inst%totn_col & ! Input: [real(r8) (:) ] (gN/m2) total column nitrogen, incl veg
- )
-
- ! set time steps
- dt = real( get_step_size(), r8 )
-
- err_found = .false.
- do fc = 1,num_soilc
- c=filter_soilc(fc)
-
- ! calculate the total column-level nitrogen storage, for mass conservation check
- col_endnb(c) = totcoln(c)
-
- ! calculate total column-level inputs
- col_ninputs(c) = ndep_to_sminn(c) + nfix_to_sminn(c) + supplement_to_sminn(c)
-
- if(use_fun)then
- col_ninputs(c) = col_ninputs(c) + ffix_to_sminn(c) ! for FUN, free living fixation is a seprate flux. RF.
- endif
-
- if (use_crop) then
- col_ninputs(c) = col_ninputs(c) + fert_to_sminn(c) + soyfixn_to_sminn(c)
- end if
-
- ! calculate total column-level outputs
- col_noutputs(c) = denit(c) + col_fire_nloss(c)
-
- ! Fluxes to product pools are included in column-level outputs: the product
- ! pools are not included in totcoln, so are outside the system with respect to
- ! these balance checks. (However, the dwt flux to product pools is NOT included,
- ! since col_begnb is initialized after the dynamic area adjustments - i.e.,
- ! after the dwt term has already been taken out.)
- col_noutputs(c) = col_noutputs(c) + &
- wood_harvestn(c) + &
- grainn_to_cropprodn(c)
-
- if (.not. use_nitrif_denitrif) then
- col_noutputs(c) = col_noutputs(c) + sminn_leached(c)
- else
- col_noutputs(c) = col_noutputs(c) + f_n2o_nit(c)
-
- col_noutputs(c) = col_noutputs(c) + smin_no3_leached(c) + smin_no3_runoff(c)
- end if
-
- col_noutputs(c) = col_noutputs(c) - som_n_leached(c)
-
- ! calculate the total column-level nitrogen balance error for this time step
- col_errnb(c) = (col_ninputs(c) - col_noutputs(c))*dt - &
- (col_endnb(c) - col_begnb(c))
-
- if (abs(col_errnb(c)) > 1e-3_r8) then
- err_found = .true.
- err_index = c
- end if
-
- if (abs(col_errnb(c)) > 1e-7_r8) then
- write(iulog,*) 'nbalance warning',c,col_errnb(c),col_endnb(c)
- write(iulog,*)'inputs,ffix,nfix,ndep = ',ffix_to_sminn(c)*dt,nfix_to_sminn(c)*dt,ndep_to_sminn(c)*dt
- write(iulog,*)'outputs,lch,roff,dnit = ',smin_no3_leached(c)*dt, smin_no3_runoff(c)*dt,f_n2o_nit(c)*dt
- end if
-
- end do ! end of columns loop
-
- if (err_found) then
- c = err_index
- write(iulog,*)'column nbalance error = ',col_errnb(c), c
- write(iulog,*)'Latdeg,Londeg = ',grc%latdeg(col%gridcell(c)),grc%londeg(col%gridcell(c))
- write(iulog,*)'begnb = ',col_begnb(c)
- write(iulog,*)'endnb = ',col_endnb(c)
- write(iulog,*)'delta store = ',col_endnb(c)-col_begnb(c)
- write(iulog,*)'input mass = ',col_ninputs(c)*dt
- write(iulog,*)'output mass = ',col_noutputs(c)*dt
- write(iulog,*)'net flux = ',(col_ninputs(c)-col_noutputs(c))*dt
- write(iulog,*)'inputs,ffix,nfix,ndep = ',ffix_to_sminn(c)*dt,nfix_to_sminn(c)*dt,ndep_to_sminn(c)*dt
- write(iulog,*)'outputs,ffix,nfix,ndep = ',smin_no3_leached(c)*dt, smin_no3_runoff(c)*dt,f_n2o_nit(c)*dt
-
-
-
- call endrun(msg=errMsg(sourcefile, __LINE__))
- end if
-
- end associate
-
- end subroutine NBalanceCheck
-
-end module CNBalanceCheckMod
diff --git a/src/biogeochem/CNDVType.F90 b/src/biogeochem/CNDVType.F90
deleted file mode 100644
index daacd845..00000000
--- a/src/biogeochem/CNDVType.F90
+++ /dev/null
@@ -1,519 +0,0 @@
-module CNDVType
-
-#include "shr_assert.h"
-
- !-----------------------------------------------------------------------
- ! !DESCRIPTION:
- ! Module containing routines to drive the annual dynamic vegetation
- ! that works with CN, reset related variables,
- ! and initialize/reset time invariant variables
- !
- ! !USES:
- use shr_kind_mod , only : r8 => shr_kind_r8
- use shr_log_mod , only : errMsg => shr_log_errMsg
- use abortutils , only : endrun
- use decompMod , only : bounds_type
- use clm_varctl , only : use_cndv, iulog
- !
- ! !PUBLIC TYPES:
- implicit none
- private
- !
- ! !PUBLIC DATA TYPES:
- !
- ! DGVM-specific ecophysiological constants structure (patch-level)
- type, public :: dgv_ecophyscon_type
- real(r8), pointer :: crownarea_max(:) ! patch tree maximum crown area [m2]
- real(r8), pointer :: tcmin(:) ! patch minimum coldest monthly mean temperature [units?]
- real(r8), pointer :: tcmax(:) ! patch maximum coldest monthly mean temperature [units?]
- real(r8), pointer :: gddmin(:) ! patch minimum growing degree days (at or above 5 C)
- real(r8), pointer :: twmax(:) ! patch upper limit of temperature of the warmest month [units?]
- real(r8), pointer :: reinickerp(:) ! patch parameter in allometric equation
- real(r8), pointer :: allom1(:) ! patch parameter in allometric
- real(r8), pointer :: allom2(:) ! patch parameter in allometric
- real(r8), pointer :: allom3(:) ! patch parameter in allometric
- end type dgv_ecophyscon_type
- type(dgv_ecophyscon_type), public :: dgv_ecophyscon
- !
- ! DGVM state variables structure
- type, public :: dgvs_type
- real(r8), pointer, public :: agdd_patch (:) ! patch accumulated growing degree days above 5
- real(r8), pointer, public :: agddtw_patch (:) ! patch accumulated growing degree days above twmax
- real(r8), pointer, public :: agdd20_patch (:) ! patch 20-yr running mean of agdd
- real(r8), pointer, public :: tmomin20_patch (:) ! patch 20-yr running mean of tmomin
- logical , pointer, public :: present_patch (:) ! patch whether PATCH present in patch
- logical , pointer, public :: pftmayexist_patch (:) ! patch if .false. then exclude seasonal decid patches from tropics
- real(r8), pointer, public :: nind_patch (:) ! patch number of individuals (#/m**2)
- real(r8), pointer, public :: lm_ind_patch (:) ! patch individual leaf mass
- real(r8), pointer, public :: lai_ind_patch (:) ! patch LAI per individual
- real(r8), pointer, public :: fpcinc_patch (:) ! patch foliar projective cover increment (fraction)
- real(r8), pointer, public :: fpcgrid_patch (:) ! patch foliar projective cover on gridcell (fraction)
- real(r8), pointer, public :: fpcgridold_patch (:) ! patch last yr's fpcgrid
- real(r8), pointer, public :: crownarea_patch (:) ! patch area that each individual tree takes up (m^2)
- real(r8), pointer, public :: greffic_patch (:)
- real(r8), pointer, public :: heatstress_patch (:)
-
- contains
-
- procedure , public :: Init
- procedure , public :: Restart
- procedure , public :: InitAccBuffer
- procedure , public :: InitAccVars
- procedure , public :: UpdateAccVars
- procedure , private :: InitAllocate
- procedure , private :: InitCold
- procedure , private :: InitHistory
- end type dgvs_type
-
- character(len=*), parameter, private :: sourcefile = &
- __FILE__
- !-----------------------------------------------------------------------
-
-contains
-
- !------------------------------------------------------------------------
- subroutine Init(this, bounds)
-
- class(dgvs_type) :: this
- type(bounds_type), intent(in) :: bounds
-
- ! Note - need allocation so that associate statements can be used
- ! at run time for NAG (allocation of variables is needed) - history
- ! should only be initialized if use_cndv is true
-
- call this%InitAllocate (bounds)
-
- if (use_cndv) then
- call this%InitCold (bounds)
- call this%InitHistory (bounds)
- end if
-
- end subroutine Init
-
- !-----------------------------------------------------------------------
- subroutine InitAllocate(this, bounds)
- !
- ! !USES:
- use shr_infnan_mod , only : nan => shr_infnan_nan, assignment(=)
- use clm_varpar , only : numpft
- use pftconMod , only : allom1s, allom2s, allom1, allom2, allom3, reinickerp
- use pftconMod , only : ntree, nbrdlf_dcd_brl_shrub
- use pftconMod , only : pftcon
- !
- ! !ARGUMENTS:
- class(dgvs_type) :: this
- type(bounds_type), intent(in) :: bounds
- !
- ! !LOCAL VARIABLES:
- integer :: begp, endp
- integer :: m
- !---------------------------------------------------------------------
-
- begp = bounds%begp; endp = bounds%endp
-
- allocate(this%agdd_patch (begp:endp)) ; this%agdd_patch (:) = nan
- allocate(this%agddtw_patch (begp:endp)) ; this%agddtw_patch (:) = nan
- allocate(this%agdd20_patch (begp:endp)) ; this%agdd20_patch (:) = nan
- allocate(this%tmomin20_patch (begp:endp)) ; this%tmomin20_patch (:) = nan
- allocate(this%present_patch (begp:endp)) ; this%present_patch (:) = .false.
- allocate(this%pftmayexist_patch (begp:endp)) ; this%pftmayexist_patch (:) = .true.
- allocate(this%nind_patch (begp:endp)) ; this%nind_patch (:) = nan
- allocate(this%lm_ind_patch (begp:endp)) ; this%lm_ind_patch (:) = nan
- allocate(this%lai_ind_patch (begp:endp)) ; this%lai_ind_patch (:) = nan
- allocate(this%fpcinc_patch (begp:endp)) ; this%fpcinc_patch (:) = nan
- allocate(this%fpcgrid_patch (begp:endp)) ; this%fpcgrid_patch (:) = nan
- allocate(this%fpcgridold_patch (begp:endp)) ; this%fpcgridold_patch (:) = nan
- allocate(this%crownarea_patch (begp:endp)) ; this%crownarea_patch (:) = nan
- allocate(this%greffic_patch (begp:endp)) ; this%greffic_patch (:) = nan
- allocate(this%heatstress_patch (begp:endp)) ; this%heatstress_patch (:) = nan
-
- allocate(dgv_ecophyscon%crownarea_max (0:numpft))
- allocate(dgv_ecophyscon%tcmin (0:numpft))
- allocate(dgv_ecophyscon%tcmax (0:numpft))
- allocate(dgv_ecophyscon%gddmin (0:numpft))
- allocate(dgv_ecophyscon%twmax (0:numpft))
- allocate(dgv_ecophyscon%reinickerp (0:numpft))
- allocate(dgv_ecophyscon%allom1 (0:numpft))
- allocate(dgv_ecophyscon%allom2 (0:numpft))
- allocate(dgv_ecophyscon%allom3 (0:numpft))
-
- do m = 0,numpft
- dgv_ecophyscon%crownarea_max(m) = pftcon%pftpar20(m)
- dgv_ecophyscon%tcmin(m) = pftcon%pftpar28(m)
- dgv_ecophyscon%tcmax(m) = pftcon%pftpar29(m)
- dgv_ecophyscon%gddmin(m) = pftcon%pftpar30(m)
- dgv_ecophyscon%twmax(m) = pftcon%pftpar31(m)
- dgv_ecophyscon%reinickerp(m) = reinickerp
- dgv_ecophyscon%allom1(m) = allom1
- dgv_ecophyscon%allom2(m) = allom2
- dgv_ecophyscon%allom3(m) = allom3
- ! modification for shrubs by X.D.Z
- if (m > ntree .and. m <= nbrdlf_dcd_brl_shrub ) then
- dgv_ecophyscon%allom1(m) = allom1s
- dgv_ecophyscon%allom2(m) = allom2s
- end if
- end do
-
- end subroutine InitAllocate
-
- !-----------------------------------------------------------------------
- subroutine InitCold(this, bounds)
- !
- ! !USES:
- use shr_kind_mod , only : r8 => shr_kind_r8
- use shr_const_mod , only : SHR_CONST_TKFRZ
- use decompMod , only : bounds_type
- !
- ! !ARGUMENTS:
- class(dgvs_type) :: this
- type(bounds_type), intent(in) :: bounds
- !
- ! !LOCAL VARIABLES:
- integer :: p ! patch index
- !-----------------------------------------------------------------------
-
- do p = bounds%begp,bounds%endp
- this%present_patch(p) = .false.
- this%crownarea_patch(p) = 0._r8
- this%nind_patch(p) = 0._r8
- this%agdd20_patch(p) = 0._r8
- this%tmomin20_patch(p) = SHR_CONST_TKFRZ - 5._r8 !initialize this way for Phenology code
- end do
-
- end subroutine InitCold
-
- !-----------------------------------------------------------------------
- subroutine InitHistory(this, bounds)
- !
- ! !DESCRIPTION:
- ! Initialize history variables
- !
- ! !USES:
- use histFileMod, only : hist_addfld1d
- !
- ! !ARGUMENTS:
- class(dgvs_type) :: this
- type(bounds_type), intent(in) :: bounds
- !
- ! !LOCAL VARIABLES:
-
- character(len=*), parameter :: subname = 'InitHistory'
- !-----------------------------------------------------------------------
-
- call hist_addfld1d (fname='AGDD', units='K', &
- avgflag='A', long_name='growing degree-days base 5C', &
- ptr_patch=this%agdd_patch, default='inactive')
-
- end subroutine InitHistory
-
-
- !-----------------------------------------------------------------------
- subroutine Restart(this, bounds, ncid, flag)
- !
- ! !DESCRIPTION:
- ! Read/Write module information to/from restart file.
- !
- ! !USES:
- use clm_varcon , only : spval
- use spmdMod , only : masterproc
- use decompMod , only : get_proc_global
- use restUtilMod
- use ncdio_pio
- use pio
- !
- ! !ARGUMENTS:
- class(dgvs_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,p ! indices
- logical :: readvar ! determine if variable is on initial file
- logical :: do_io ! whether to do i/o for the given variable
- integer :: nump_global ! total number of patches, globally
- integer :: dimlen ! dimension length
- integer :: ier ! error status
- integer :: itemp ! temporary
- integer , pointer :: iptemp(:) ! pointer to memory to be allocated
- integer :: err_code ! error code
- !-----------------------------------------------------------------------
-
- ! Get expected total number of points, for later error checks
- call get_proc_global(np=nump_global)
-
- call restartvar(ncid=ncid, flag=flag, varname='CROWNAREA', xtype=ncd_double, &
- dim1name='pft', &
- long_name='', units='', &
- interpinic_flag='interp', readvar=readvar, data=this%crownarea_patch)
-
- call restartvar(ncid=ncid, flag=flag, varname='nind', xtype=ncd_double, &
- dim1name='pft', &
- long_name='', units='', &
- interpinic_flag='interp', readvar=readvar, data=this%nind_patch)
-
- call restartvar(ncid=ncid, flag=flag, varname='fpcgrid', xtype=ncd_double, &
- dim1name='pft', &
- long_name='', units='', &
- interpinic_flag='interp', readvar=readvar, data=this%fpcgrid_patch)
-
- call restartvar(ncid=ncid, flag=flag, varname='fpcgridold', xtype=ncd_double, &
- dim1name='pft', &
- long_name='', units='', &
- interpinic_flag='interp', readvar=readvar, data=this%fpcgridold_patch)
-
- ! tmomin20
- do_io = .true.
- if (flag == 'read') then
- ! On a read, confirm that this variable has the expected size; if not, don't
- ! read it (instead leave it at its arbitrary initial value). This is needed to
- ! support older initial conditions for which this variable had a different size.
- call ncd_inqvdlen(ncid, 'TMOMIN20', 1, dimlen, err_code)
- if (dimlen /= nump_global) then
- do_io = .false.
- end if
- end if
- if (do_io) then
- call restartvar(ncid=ncid, flag=flag, varname='TMOMIN20', xtype=ncd_double, &
- dim1name='pft', &
- long_name='',units='', &
- interpinic_flag='interp', readvar=readvar, data=this%tmomin20_patch)
- end if
-
- ! agdd20
- do_io = .true.
- if (flag == 'read') then
- ! On a read, confirm that this variable has the expected size; if not, don't
- ! read it (instead leave it at its arbitrary initial value). This is needed to
- ! support older initial conditions for which this variable had a different size.
- call ncd_inqvdlen(ncid, 'AGDD20', 1, dimlen, err_code)
- if (dimlen /= nump_global) then
- do_io = .false.
- end if
- end if
- if (do_io) then
- call restartvar(ncid=ncid, flag=flag, varname='AGDD20', xtype=ncd_double, &
- dim1name='pft',&
- long_name='',units='', &
- interpinic_flag='interp', readvar=readvar, data=this%agdd20_patch)
- end if
-
- ! present
- if (flag == 'read' .or. flag == 'write') then
- allocate (iptemp(bounds%begp:bounds%endp), stat=ier)
- end if
- if (flag == 'write') then
- do p = bounds%begp,bounds%endp
- iptemp(p) = 0
- if (this%present_patch(p)) iptemp(p) = 1
- end do
- end if
- call restartvar(ncid=ncid, flag=flag, varname='present', xtype=ncd_int, &
- dim1name='pft',&
- long_name='',units='', &
- interpinic_flag='interp', readvar=readvar, data=iptemp)
- if (flag=='read' .and. readvar) then
- do p = bounds%begp,bounds%endp
- this%present_patch(p) = .false.
- if (iptemp(p) == 1) this%present_patch(p) = .true.
- end do
- end if
- if (flag == 'read' .or. flag == 'write') then
- deallocate (iptemp)
- end if
-
- call restartvar(ncid=ncid, flag=flag, varname='heatstress', xtype=ncd_double, &
- dim1name='pft', &
- long_name='', units='', &
- interpinic_flag='interp', readvar=readvar, data=this%heatstress_patch)
-
- call restartvar(ncid=ncid, flag=flag, varname='greffic', xtype=ncd_double, &
- dim1name='pft', &
- long_name='', units='', &
- interpinic_flag='interp', readvar=readvar, data=this%greffic_patch)
-
- end subroutine Restart
-
- !-----------------------------------------------------------------------
- subroutine InitAccBuffer (this, bounds)
- !
- ! !DESCRIPTION:
- ! Initialize accumulation buffer for all required module accumulated fields
- ! This routine set defaults values that are then overwritten by the
- ! restart file for restart or branch runs
- ! Each interval and accumulation type is unique to each field processed.
- ! Routine [initAccBuffer] defines the fields to be processed
- ! and the type of accumulation.
- ! Routine [updateCNDVAccVars] does the actual accumulation for a given field.
- ! Fields are accumulated by calls to subroutine [update_accum_field].
- ! To accumulate a field, it must first be defined in subroutine [initAccVars]
- ! and then accumulated by calls to [updateCNDVAccVars].
- !
- ! This should only be called if use_cndv is true.
- !
- ! !USES
- use accumulMod , only : init_accum_field
- !
- ! !ARGUMENTS:
- class(dgvs_type) :: this
- type(bounds_type), intent(in) :: bounds
-
- !
- ! !LOCAL VARIABLES:
- integer, parameter :: not_used = huge(1)
-
- !---------------------------------------------------------------------
-
- ! The following are accumulated fields.
- ! These types of fields are accumulated until a trigger value resets
- ! the accumulation to zero (see subroutine update_accum_field).
- ! Hence, [accper] is not valid.
-
- call init_accum_field (name='AGDDTW', units='K', &
- desc='growing degree-days base twmax', accum_type='runaccum', accum_period=not_used, &
- subgrid_type='pft', numlev=1, init_value=0._r8)
-
- call init_accum_field (name='AGDD', units='K', &
- desc='growing degree-days base 5C', accum_type='runaccum', accum_period=not_used, &
- subgrid_type='pft', numlev=1, init_value=0._r8)
-
- end subroutine InitAccBuffer
-
- !-----------------------------------------------------------------------
- subroutine InitAccVars(this, bounds)
- !
- ! !DESCRIPTION:
- ! Initialize module variables that are associated with
- ! time accumulated fields. This routine is called for both an initial run
- ! and a restart run (and must therefore must be called after the restart file
- ! is read in and the accumulation buffer is obtained)
- !
- ! This should only be called if use_cndv is true.
- !
- ! !USES
- use accumulMod , only : extract_accum_field
- use clm_time_manager , only : get_nstep
- !
- ! !ARGUMENTS:
- class(dgvs_type) :: this
- type(bounds_type), intent(in) :: bounds
- !
- ! !LOCAL VARIABLES:
- integer :: begp, endp
- integer :: nstep
- integer :: ier ! error status
- real(r8), pointer :: rbufslp(:) ! temporary
-
- !---------------------------------------------------------------------
-
- begp = bounds%begp; endp = bounds%endp
-
- ! Allocate needed dynamic memory for single level patch field
- allocate(rbufslp(begp:endp), stat=ier)
- if (ier/=0) then
- write(iulog,*)' in '
- call endrun(msg=" allocation error for rbufslp"//&
- errMsg(sourcefile, __LINE__))
- endif
-
- nstep = get_nstep()
-
- call extract_accum_field ('AGDDTW', rbufslp, nstep)
- this%agddtw_patch(begp:endp) = rbufslp(begp:endp)
-
- call extract_accum_field ('AGDD', rbufslp, nstep)
- this%agdd_patch(begp:endp) = rbufslp(begp:endp)
-
- deallocate(rbufslp)
-
- end subroutine InitAccVars
-
- !-----------------------------------------------------------------------
- subroutine UpdateAccVars(this, bounds, t_a10_patch, t_ref2m_patch)
- !
- ! !DESCRIPTION:
- ! Update accumulated variables. Should be called every time step.
- !
- ! This should only be called if use_cndv is true.
- !
- ! !USES:
- use shr_const_mod , only : SHR_CONST_CDAY, SHR_CONST_TKFRZ
- use clm_time_manager , only : get_step_size, get_nstep, get_curr_date
- use pftconMod , only : ndllf_dcd_brl_tree
- use accumulMod , only : update_accum_field, extract_accum_field, accumResetVal
- !
- ! !ARGUMENTS:
- class(dgvs_type) , intent(inout) :: this
- type(bounds_type) , intent(in) :: bounds
- ! COMPILER_BUG(wjs, 2014-11-30, pgi 14.7) These arrays get resized to 0 when running
- ! with threading with pgi 14.7 on yellowstone. My standard workarounds weren't
- ! working; the only thing that I can find that works is to change them to pointers
-! real(r8) , intent(in) :: t_a10_patch( bounds%begp:) ! 10-day running mean of the 2 m temperature (K)
-! real(r8) , intent(in) :: t_ref2m_patch( bounds%begp:) ! 2 m height surface air temperature (K)
- real(r8), pointer , intent(in) :: t_a10_patch(:) ! 10-day running mean of the 2 m temperature (K)
- real(r8), pointer , intent(in) :: t_ref2m_patch(:) ! 2 m height surface air temperature (K)
- !
- ! !LOCAL VARIABLES:
- integer :: p ! index
- integer :: ier ! error status
- integer :: dtime ! timestep size [seconds]
- integer :: nstep ! timestep number
- integer :: year ! year (0, ...) for nstep
- integer :: month ! month (1, ..., 12) for nstep
- integer :: day ! day of month (1, ..., 31) for nstep
- integer :: secs ! seconds into current date for nstep
- integer :: begp, endp
- real(r8), pointer :: rbufslp(:) ! temporary single level - patch level
- !-----------------------------------------------------------------------
-
- begp = bounds%begp; endp = bounds%endp
-
- ! Enforce expected array sizes
- SHR_ASSERT_ALL((ubound(t_a10_patch) == (/endp/)), errMsg(sourcefile, __LINE__))
- SHR_ASSERT_ALL((ubound(t_ref2m_patch) == (/endp/)), errMsg(sourcefile, __LINE__))
-
- dtime = get_step_size()
- nstep = get_nstep()
- call get_curr_date (year, month, day, secs)
-
- ! Allocate needed dynamic memory for single level patch field
-
- allocate(rbufslp(begp:endp), stat=ier)
- if (ier/=0) then
- write(iulog,*)'update_accum_hist allocation error for rbuf1dp'
- call endrun(msg=errMsg(sourcefile, __LINE__))
- endif
-
- ! Accumulate growing degree days based on 10-day running mean temperature.
- ! The trigger to reset the accumulated values to zero is -99999.
-
- ! Accumulate and extract AGDDTW (gdd base twmax, which is 23 deg C
- ! for boreal woody patches)
-
- do p = begp,endp
- rbufslp(p) = max(0._r8, &
- (t_a10_patch(p) - SHR_CONST_TKFRZ - dgv_ecophyscon%twmax(ndllf_dcd_brl_tree)) &
- * dtime/SHR_CONST_CDAY)
- if (month==1 .and. day==1 .and. secs==int(dtime)) rbufslp(p) = accumResetVal
- end do
- call update_accum_field ('AGDDTW', rbufslp, nstep)
- call extract_accum_field ('AGDDTW', this%agddtw_patch, nstep)
-
- ! Accumulate and extract AGDD
-
- do p = begp,endp
- rbufslp(p) = max(0.0_r8, &
- (t_ref2m_patch(p) - (SHR_CONST_TKFRZ + 5.0_r8)) * dtime/SHR_CONST_CDAY)
- !
- ! Fix (for bug 1858) from Sam Levis to reset the annual AGDD variable
- !
- if (month==1 .and. day==1 .and. secs==int(dtime)) rbufslp(p) = accumResetVal
- end do
- call update_accum_field ('AGDD', rbufslp, nstep)
- call extract_accum_field ('AGDD', this%agdd_patch, nstep)
-
- deallocate(rbufslp)
-
- end subroutine UpdateAccVars
-
-end module CNDVType
diff --git a/src/biogeochem/CNDriverMod.F90 b/src/biogeochem/CNDriverMod.F90
deleted file mode 100644
index ea3abb5c..00000000
--- a/src/biogeochem/CNDriverMod.F90
+++ /dev/null
@@ -1,37 +0,0 @@
-module CNDriverMod
-
- !-----------------------------------------------------------------------
- ! !DESCRIPTION:
- ! Ecosystem dynamics: phenology, vegetation
- !
- ! !USES:
- use shr_kind_mod , only : r8 => shr_kind_r8
- use decompMod , only : bounds_type
- use perf_mod , only : t_startf, t_stopf
- !
- ! !PUBLIC TYPES:
- implicit none
- private
- !
- ! !PUBLIC MEMBER FUNCTIONS:
- public :: CNDriverInit ! Ecosystem dynamics: initialization
- !-----------------------------------------------------------------------
-
-contains
-
- !-----------------------------------------------------------------------
- subroutine CNDriverInit(bounds, NLFilename)
- !
- ! !DESCRIPTION:
- ! Initialzation of the CN Ecosystem dynamics.
- !
- ! !USES:
- !
- ! !ARGUMENTS:
- type(bounds_type) , intent(in) :: bounds
- character(len=*) , intent(in) :: NLFilename ! Namelist filename
- !-----------------------------------------------------------------------
-
- end subroutine CNDriverInit
-
-end module CNDriverMod
diff --git a/src/biogeochem/CNGapMortalityMod.F90 b/src/biogeochem/CNGapMortalityMod.F90
deleted file mode 100644
index a2f8c4fd..00000000
--- a/src/biogeochem/CNGapMortalityMod.F90
+++ /dev/null
@@ -1,493 +0,0 @@
-module CNGapMortalityMod
-
-#include "shr_assert.h"
-
- !-----------------------------------------------------------------------
- ! !DESCRIPTION:
- ! Module holding routines used in gap mortality for coupled carbon
- ! nitrogen code.
- !
- ! !USES:
- use shr_kind_mod , only : r8 => shr_kind_r8
- use decompMod , only : bounds_type
- use abortutils , only : endrun
- use shr_log_mod , only : errMsg => shr_log_errMsg
- use pftconMod , only : pftcon
- use CNDVType , only : dgvs_type
- use CNVegCarbonStateType , only : cnveg_carbonstate_type
- use CNVegCarbonFluxType , only : cnveg_carbonflux_type
- use CNVegNitrogenStateType , only : cnveg_nitrogenstate_type
- use CNVegNitrogenFluxType , only : cnveg_nitrogenflux_type
- use CanopyStateType , only : canopystate_type
- use ColumnType , only : col
- use PatchType , only : patch
- !
- implicit none
- private
- !
- ! !PUBLIC MEMBER FUNCTIONS:
- public :: readParams
- public :: CNGapMortality
-
- type, private :: params_type
- 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 params_type
- !
- type(params_type), private :: params_inst
- !
- ! !PRIVATE MEMBER FUNCTIONS:
- private :: CNGap_PatchToColumn
-
- character(len=*), parameter, private :: sourcefile = &
- __FILE__
- !-----------------------------------------------------------------------
-
-contains
-
- !-----------------------------------------------------------------------
- subroutine readParams ( 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(sourcefile, __LINE__))
- params_inst%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(sourcefile, __LINE__))
- params_inst%k_mort=tempr
-
- end subroutine readParams
-
- !-----------------------------------------------------------------------
- subroutine CNGapMortality (bounds, num_soilc, filter_soilc, num_soilp, filter_soilp, &
- dgvs_inst, cnveg_carbonstate_inst, cnveg_nitrogenstate_inst, &
- cnveg_carbonflux_inst, cnveg_nitrogenflux_inst, canopystate_inst, &
- leaf_prof_patch, froot_prof_patch, croot_prof_patch, stem_prof_patch)
- !
- ! !DESCRIPTION:
- ! Gap-phase mortality routine for coupled carbon-nitrogen code (CN)
- !
- ! !USES:
- use clm_time_manager , only: get_days_per_year
- use clm_varpar , only: nlevdecomp_full
- use clm_varcon , only: secspday
- use clm_varctl , only: use_cndv, spinup_state
- use pftconMod , only: npcropmin
- !
- ! !ARGUMENTS:
- type(bounds_type) , intent(in) :: bounds
- 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_inst
- type(cnveg_carbonstate_type) , intent(in) :: cnveg_carbonstate_inst
- type(cnveg_nitrogenstate_type) , intent(in) :: cnveg_nitrogenstate_inst
- type(cnveg_carbonflux_type) , intent(inout) :: cnveg_carbonflux_inst
- type(cnveg_nitrogenflux_type) , intent(inout) :: cnveg_nitrogenflux_inst
- type(canopystate_type) , intent(in) :: canopystate_inst
- real(r8) , intent(in) :: leaf_prof_patch(bounds%begp:,1:)
- real(r8) , intent(in) :: froot_prof_patch(bounds%begp:,1:)
- real(r8) , intent(in) :: croot_prof_patch(bounds%begp:,1:)
- real(r8) , intent(in) :: stem_prof_patch(bounds%begp:,1:)
- !
- ! !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
- !-----------------------------------------------------------------------
-
- SHR_ASSERT_ALL((ubound(leaf_prof_patch) == (/bounds%endp,nlevdecomp_full/)), errMsg(sourcefile, __LINE__))
- SHR_ASSERT_ALL((ubound(froot_prof_patch) == (/bounds%endp,nlevdecomp_full/)), errMsg(sourcefile, __LINE__))
- SHR_ASSERT_ALL((ubound(croot_prof_patch) == (/bounds%endp,nlevdecomp_full/)), errMsg(sourcefile, __LINE__))
- SHR_ASSERT_ALL((ubound(stem_prof_patch) == (/bounds%endp,nlevdecomp_full/)), errMsg(sourcefile, __LINE__))
-
- associate( &
- ivt => patch%itype , & ! Input: [integer (:) ] patch vegetation type
-
- woody => pftcon%woody , & ! Input: binary flag for woody lifeform
-
- greffic => dgvs_inst%greffic_patch , & ! Input: [real(r8) (:) ]
- heatstress => dgvs_inst%heatstress_patch , & ! Input: [real(r8) (:) ]
-
- leafcn => pftcon%leafcn , & ! Input: [real(r8) (:)] leaf C:N (gC/gN)
- frootcn => pftcon%frootcn , & ! Input: [real(r8) (:)] fine root C:N (gC/gN)
- livewdcn => pftcon%livewdcn , & ! Input: [real(r8) (:)] live wood (phloem and ray parenchyma) C:N (gC/gN)
- laisun => canopystate_inst%laisun_patch , & ! Input: [real(r8) (:) ] sunlit projected leaf area index
- laisha => canopystate_inst%laisha_patch , & ! Input: [real(r8) (:) ] shaded projected leaf area index
-
- nind => dgvs_inst%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 = params_inst%am
- ! set coeff of growth efficiency in mortality equation
- k_mort = params_inst%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 = params_inst%am
- end if
-
- end if
-
- m = am/(get_days_per_year() * secspday)
-
- !------------------------------------------------------
- ! patch-level gap mortality carbon fluxes
- !------------------------------------------------------
-
- ! displayed pools
- cnveg_carbonflux_inst%m_leafc_to_litter_patch(p) = cnveg_carbonstate_inst%leafc_patch(p) * m
- cnveg_carbonflux_inst%m_frootc_to_litter_patch(p) = cnveg_carbonstate_inst%frootc_patch(p) * m
- cnveg_carbonflux_inst%m_livestemc_to_litter_patch(p) = cnveg_carbonstate_inst%livestemc_patch(p) * m
- cnveg_carbonflux_inst%m_livecrootc_to_litter_patch(p) = cnveg_carbonstate_inst%livecrootc_patch(p) * m
- if (spinup_state == 2 .and. .not. use_cndv) then !accelerate mortality of dead woody pools
- cnveg_carbonflux_inst%m_deadstemc_to_litter_patch(p) = cnveg_carbonstate_inst%deadstemc_patch(p) * m * 10._r8
- cnveg_carbonflux_inst%m_deadcrootc_to_litter_patch(p) = cnveg_carbonstate_inst%deadcrootc_patch(p) * m * 10._r8
- else
- cnveg_carbonflux_inst%m_deadstemc_to_litter_patch(p) = cnveg_carbonstate_inst%deadstemc_patch(p) * m
- cnveg_carbonflux_inst%m_deadcrootc_to_litter_patch(p) = cnveg_carbonstate_inst%deadcrootc_patch(p) * m
- end if
-
- ! storage pools
- cnveg_carbonflux_inst%m_leafc_storage_to_litter_patch(p) = cnveg_carbonstate_inst%leafc_storage_patch(p) * m
- cnveg_carbonflux_inst%m_frootc_storage_to_litter_patch(p) = cnveg_carbonstate_inst%frootc_storage_patch(p) * m
- cnveg_carbonflux_inst%m_livestemc_storage_to_litter_patch(p) = cnveg_carbonstate_inst%livestemc_storage_patch(p) * m
- cnveg_carbonflux_inst%m_deadstemc_storage_to_litter_patch(p) = cnveg_carbonstate_inst%deadstemc_storage_patch(p) * m
- cnveg_carbonflux_inst%m_livecrootc_storage_to_litter_patch(p) = cnveg_carbonstate_inst%livecrootc_storage_patch(p) * m
- cnveg_carbonflux_inst%m_deadcrootc_storage_to_litter_patch(p) = cnveg_carbonstate_inst%deadcrootc_storage_patch(p) * m
- cnveg_carbonflux_inst%m_gresp_storage_to_litter_patch(p) = cnveg_carbonstate_inst%gresp_storage_patch(p) * m
-
- ! transfer pools
- cnveg_carbonflux_inst%m_leafc_xfer_to_litter_patch(p) = cnveg_carbonstate_inst%leafc_xfer_patch(p) * m
- cnveg_carbonflux_inst%m_frootc_xfer_to_litter_patch(p) = cnveg_carbonstate_inst%frootc_xfer_patch(p) * m
- cnveg_carbonflux_inst%m_livestemc_xfer_to_litter_patch(p) = cnveg_carbonstate_inst%livestemc_xfer_patch(p) * m
- cnveg_carbonflux_inst%m_deadstemc_xfer_to_litter_patch(p) = cnveg_carbonstate_inst%deadstemc_xfer_patch(p) * m
- cnveg_carbonflux_inst%m_livecrootc_xfer_to_litter_patch(p) = cnveg_carbonstate_inst%livecrootc_xfer_patch(p) * m
- cnveg_carbonflux_inst%m_deadcrootc_xfer_to_litter_patch(p) = cnveg_carbonstate_inst%deadcrootc_xfer_patch(p) * m
- cnveg_carbonflux_inst%m_gresp_xfer_to_litter_patch(p) = cnveg_carbonstate_inst%gresp_xfer_patch(p) * m
-
- !------------------------------------------------------
- ! patch-level gap mortality nitrogen fluxes
- !------------------------------------------------------
-
- ! displayed pools
- cnveg_nitrogenflux_inst%m_leafn_to_litter_patch(p) = cnveg_nitrogenstate_inst%leafn_patch(p) * m
- cnveg_nitrogenflux_inst%m_frootn_to_litter_patch(p) = cnveg_nitrogenstate_inst%frootn_patch(p) * m
- cnveg_nitrogenflux_inst%m_livestemn_to_litter_patch(p) = cnveg_nitrogenstate_inst%livestemn_patch(p) * m
- cnveg_nitrogenflux_inst%m_livecrootn_to_litter_patch(p) = cnveg_nitrogenstate_inst%livecrootn_patch(p) * m
-
- if (spinup_state == 2 .and. .not. use_cndv) then !accelerate mortality of dead woody pools
- cnveg_nitrogenflux_inst%m_deadstemn_to_litter_patch(p) = cnveg_nitrogenstate_inst%deadstemn_patch(p) * m * 10._r8
- cnveg_nitrogenflux_inst%m_deadcrootn_to_litter_patch(p) = cnveg_nitrogenstate_inst%deadcrootn_patch(p) * m * 10._r8
- else
- cnveg_nitrogenflux_inst%m_deadstemn_to_litter_patch(p) = cnveg_nitrogenstate_inst%deadstemn_patch(p) * m
- cnveg_nitrogenflux_inst%m_deadcrootn_to_litter_patch(p) = cnveg_nitrogenstate_inst%deadcrootn_patch(p) * m
- end if
-
- if (ivt(p) < npcropmin) then
- cnveg_nitrogenflux_inst%m_retransn_to_litter_patch(p) = cnveg_nitrogenstate_inst%retransn_patch(p) * m
- end if
-
- ! storage pools
- cnveg_nitrogenflux_inst%m_leafn_storage_to_litter_patch(p) = cnveg_nitrogenstate_inst%leafn_storage_patch(p) * m
- cnveg_nitrogenflux_inst%m_frootn_storage_to_litter_patch(p) = cnveg_nitrogenstate_inst%frootn_storage_patch(p) * m
- cnveg_nitrogenflux_inst%m_livestemn_storage_to_litter_patch(p) = cnveg_nitrogenstate_inst%livestemn_storage_patch(p) * m
- cnveg_nitrogenflux_inst%m_deadstemn_storage_to_litter_patch(p) = cnveg_nitrogenstate_inst%deadstemn_storage_patch(p) * m
- cnveg_nitrogenflux_inst%m_livecrootn_storage_to_litter_patch(p) = cnveg_nitrogenstate_inst%livecrootn_storage_patch(p) * m
- cnveg_nitrogenflux_inst%m_deadcrootn_storage_to_litter_patch(p) = cnveg_nitrogenstate_inst%deadcrootn_storage_patch(p) * m
-
- ! transfer pools
- cnveg_nitrogenflux_inst%m_leafn_xfer_to_litter_patch(p) = cnveg_nitrogenstate_inst%leafn_xfer_patch(p) * m
- cnveg_nitrogenflux_inst%m_frootn_xfer_to_litter_patch(p) = cnveg_nitrogenstate_inst%frootn_xfer_patch(p) * m
- cnveg_nitrogenflux_inst%m_livestemn_xfer_to_litter_patch(p) = cnveg_nitrogenstate_inst%livestemn_xfer_patch(p) * m
- cnveg_nitrogenflux_inst%m_deadstemn_xfer_to_litter_patch(p) = cnveg_nitrogenstate_inst%deadstemn_xfer_patch(p) * m
- cnveg_nitrogenflux_inst%m_livecrootn_xfer_to_litter_patch(p) = cnveg_nitrogenstate_inst%livecrootn_xfer_patch(p) * m
- cnveg_nitrogenflux_inst%m_deadcrootn_xfer_to_litter_patch(p) = cnveg_nitrogenstate_inst%deadcrootn_xfer_patch(p) * m
-
- ! added by F. Li and S. Levis
- if (use_cndv) then
- if (woody(ivt(p)) == 1._r8)then
- if (cnveg_carbonstate_inst%livestemc_patch(p) + cnveg_carbonstate_inst%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 patch loop
-
- ! gather all patch-level litterfall fluxes to the column
- ! for litter C and N inputs
-
- call CNGap_PatchToColumn(bounds, num_soilc, filter_soilc, &
- cnveg_carbonflux_inst, cnveg_nitrogenflux_inst, &
- leaf_prof_patch(bounds%begp:bounds%endp, 1:nlevdecomp_full), &
- froot_prof_patch(bounds%begp:bounds%endp, 1:nlevdecomp_full), &
- croot_prof_patch(bounds%begp:bounds%endp, 1:nlevdecomp_full), &
- stem_prof_patch(bounds%begp:bounds%endp, 1:nlevdecomp_full))
-
- end associate
-
- end subroutine CNGapMortality
-
- !-----------------------------------------------------------------------
- subroutine CNGap_PatchToColumn (bounds, num_soilc, filter_soilc, &
- cnveg_carbonflux_inst, cnveg_nitrogenflux_inst, &
- leaf_prof_patch, froot_prof_patch, croot_prof_patch, stem_prof_patch)
- !
- ! !DESCRIPTION:
- ! gathers all patch-level gap mortality fluxes to the column level and
- ! assigns them to the three litter pools
- !
- ! !USES:
- use clm_varpar , only : maxpatch_pft, nlevdecomp, nlevdecomp_full
- !
- ! !ARGUMENTS:
- type(bounds_type) , intent(in) :: bounds
- integer , intent(in) :: num_soilc ! number of soil columns in filter
- integer , intent(in) :: filter_soilc(:) ! soil column filter
- type(cnveg_carbonflux_type) , intent(inout) :: cnveg_carbonflux_inst
- type(cnveg_nitrogenflux_type) , intent(inout) :: cnveg_nitrogenflux_inst
- real(r8) , intent(in) :: leaf_prof_patch(bounds%begp:,1:)
- real(r8) , intent(in) :: froot_prof_patch(bounds%begp:,1:)
- real(r8) , intent(in) :: croot_prof_patch(bounds%begp:,1:)
- real(r8) , intent(in) :: stem_prof_patch(bounds%begp:,1:)
- !
- ! !LOCAL VARIABLES:
- integer :: fc,c,pi,p,j ! indices
- !-----------------------------------------------------------------------
-
- SHR_ASSERT_ALL((ubound(leaf_prof_patch) == (/bounds%endp,nlevdecomp_full/)), errMsg(sourcefile, __LINE__))
- SHR_ASSERT_ALL((ubound(froot_prof_patch) == (/bounds%endp,nlevdecomp_full/)), errMsg(sourcefile, __LINE__))
- SHR_ASSERT_ALL((ubound(croot_prof_patch) == (/bounds%endp,nlevdecomp_full/)), errMsg(sourcefile, __LINE__))
- SHR_ASSERT_ALL((ubound(stem_prof_patch) == (/bounds%endp,nlevdecomp_full/)), errMsg(sourcefile, __LINE__))
-
- associate( &
- leaf_prof => leaf_prof_patch , & ! Input: [real(r8) (:,:) ] (1/m) profile of leaves
- froot_prof => froot_prof_patch , & ! Input: [real(r8) (:,:) ] (1/m) profile of fine roots
- croot_prof => croot_prof_patch , & ! Input: [real(r8) (:,:) ] (1/m) profile of coarse roots
- stem_prof => stem_prof_patch , & ! Input: [real(r8) (:,:) ] (1/m) profile of stems
-
- ivt => patch%itype , & ! Input: [integer (:) ] patch vegetation type
- wtcol => patch%wtcol , & ! Input: [real(r8) (:) ] patch weight relative to column (0-1)
-
- lf_flab => pftcon%lf_flab , & ! Input: [real(r8) (:) ] leaf litter labile fraction
- lf_fcel => pftcon%lf_fcel , & ! Input: [real(r8) (:) ] leaf litter cellulose fraction
- lf_flig => pftcon%lf_flig , & ! Input: [real(r8) (:) ] leaf litter lignin fraction
- fr_flab => pftcon%fr_flab , & ! Input: [real(r8) (:) ] fine root litter labile fraction
- fr_fcel => pftcon%fr_fcel , & ! Input: [real(r8) (:) ] fine root litter cellulose fraction
- fr_flig => pftcon%fr_flig , & ! Input: [real(r8) (:) ] fine root litter lignin fraction
-
- m_leafc_to_litter => cnveg_carbonflux_inst%m_leafc_to_litter_patch , & ! Input: [real(r8) (:) ]
- m_frootc_to_litter => cnveg_carbonflux_inst%m_frootc_to_litter_patch , & ! Input: [real(r8) (:) ]
- m_livestemc_to_litter => cnveg_carbonflux_inst%m_livestemc_to_litter_patch , & ! Input: [real(r8) (:) ]
- m_deadstemc_to_litter => cnveg_carbonflux_inst%m_deadstemc_to_litter_patch , & ! Input: [real(r8) (:) ]
- m_livecrootc_to_litter => cnveg_carbonflux_inst%m_livecrootc_to_litter_patch , & ! Input: [real(r8) (:) ]
- m_deadcrootc_to_litter => cnveg_carbonflux_inst%m_deadcrootc_to_litter_patch , & ! Input: [real(r8) (:) ]
- m_leafc_storage_to_litter => cnveg_carbonflux_inst%m_leafc_storage_to_litter_patch , & ! Input: [real(r8) (:) ]
- m_frootc_storage_to_litter => cnveg_carbonflux_inst%m_frootc_storage_to_litter_patch , & ! Input: [real(r8) (:) ]
- m_livestemc_storage_to_litter => cnveg_carbonflux_inst%m_livestemc_storage_to_litter_patch , & ! Input: [real(r8) (:) ]
- m_deadstemc_storage_to_litter => cnveg_carbonflux_inst%m_deadstemc_storage_to_litter_patch , & ! Input: [real(r8) (:) ]
- m_livecrootc_storage_to_litter => cnveg_carbonflux_inst%m_livecrootc_storage_to_litter_patch , & ! Input: [real(r8) (:) ]
- m_deadcrootc_storage_to_litter => cnveg_carbonflux_inst%m_deadcrootc_storage_to_litter_patch , & ! Input: [real(r8) (:) ]
- m_gresp_storage_to_litter => cnveg_carbonflux_inst%m_gresp_storage_to_litter_patch , & ! Input: [real(r8) (:) ]
- m_leafc_xfer_to_litter => cnveg_carbonflux_inst%m_leafc_xfer_to_litter_patch , & ! Input: [real(r8) (:) ]
- m_frootc_xfer_to_litter => cnveg_carbonflux_inst%m_frootc_xfer_to_litter_patch , & ! Input: [real(r8) (:) ]
- m_livestemc_xfer_to_litter => cnveg_carbonflux_inst%m_livestemc_xfer_to_litter_patch , & ! Input: [real(r8) (:) ]
- m_deadstemc_xfer_to_litter => cnveg_carbonflux_inst%m_deadstemc_xfer_to_litter_patch , & ! Input: [real(r8) (:) ]
- m_livecrootc_xfer_to_litter => cnveg_carbonflux_inst%m_livecrootc_xfer_to_litter_patch , & ! Input: [real(r8) (:) ]
- m_deadcrootc_xfer_to_litter => cnveg_carbonflux_inst%m_deadcrootc_xfer_to_litter_patch , & ! Input: [real(r8) (:) ]
- m_gresp_xfer_to_litter => cnveg_carbonflux_inst%m_gresp_xfer_to_litter_patch , & ! Input: [real(r8) (:) ]
- gap_mortality_c_to_litr_met_c => cnveg_carbonflux_inst%gap_mortality_c_to_litr_met_c_col , & ! Output: [real(r8) (:,:) ] C fluxes associated with gap mortality to litter metabolic pool (gC/m3/s)
- gap_mortality_c_to_litr_cel_c => cnveg_carbonflux_inst%gap_mortality_c_to_litr_cel_c_col , & ! Output: [real(r8) (:,:) ] C fluxes associated with gap mortality to litter cellulose pool (gC/m3/s)
- gap_mortality_c_to_litr_lig_c => cnveg_carbonflux_inst%gap_mortality_c_to_litr_lig_c_col , & ! Output: [real(r8) (:,:) ] C fluxes associated with gap mortality to litter lignin pool (gC/m3/s)
- gap_mortality_c_to_cwdc => cnveg_carbonflux_inst%gap_mortality_c_to_cwdc_col , & ! Output: [real(r8) (:,:) ] C fluxes associated with gap mortality to CWD pool (gC/m3/s)
-
- m_leafn_to_litter => cnveg_nitrogenflux_inst%m_leafn_to_litter_patch , & ! Input: [real(r8) (:) ]
- m_frootn_to_litter => cnveg_nitrogenflux_inst%m_frootn_to_litter_patch , & ! Input: [real(r8) (:) ]
- m_livestemn_to_litter => cnveg_nitrogenflux_inst%m_livestemn_to_litter_patch , & ! Input: [real(r8) (:) ]
- m_deadstemn_to_litter => cnveg_nitrogenflux_inst%m_deadstemn_to_litter_patch , & ! Input: [real(r8) (:) ]
- m_livecrootn_to_litter => cnveg_nitrogenflux_inst%m_livecrootn_to_litter_patch , & ! Input: [real(r8) (:) ]
- m_deadcrootn_to_litter => cnveg_nitrogenflux_inst%m_deadcrootn_to_litter_patch , & ! Input: [real(r8) (:) ]
- m_retransn_to_litter => cnveg_nitrogenflux_inst%m_retransn_to_litter_patch , & ! Input: [real(r8) (:) ]
- m_leafn_storage_to_litter => cnveg_nitrogenflux_inst%m_leafn_storage_to_litter_patch , & ! Input: [real(r8) (:) ]
- m_frootn_storage_to_litter => cnveg_nitrogenflux_inst%m_frootn_storage_to_litter_patch , & ! Input: [real(r8) (:) ]
- m_livestemn_storage_to_litter => cnveg_nitrogenflux_inst%m_livestemn_storage_to_litter_patch , & ! Input: [real(r8) (:) ]
- m_deadstemn_storage_to_litter => cnveg_nitrogenflux_inst%m_deadstemn_storage_to_litter_patch , & ! Input: [real(r8) (:) ]
- m_livecrootn_storage_to_litter => cnveg_nitrogenflux_inst%m_livecrootn_storage_to_litter_patch , & ! Input: [real(r8) (:) ]
- m_deadcrootn_storage_to_litter => cnveg_nitrogenflux_inst%m_deadcrootn_storage_to_litter_patch , & ! Input: [real(r8) (:) ]
- m_leafn_xfer_to_litter => cnveg_nitrogenflux_inst%m_leafn_xfer_to_litter_patch , & ! Input: [real(r8) (:) ]
- m_frootn_xfer_to_litter => cnveg_nitrogenflux_inst%m_frootn_xfer_to_litter_patch , & ! Input: [real(r8) (:) ]
- m_livestemn_xfer_to_litter => cnveg_nitrogenflux_inst%m_livestemn_xfer_to_litter_patch , & ! Input: [real(r8) (:) ]
- m_deadstemn_xfer_to_litter => cnveg_nitrogenflux_inst%m_deadstemn_xfer_to_litter_patch , & ! Input: [real(r8) (:) ]
- m_livecrootn_xfer_to_litter => cnveg_nitrogenflux_inst%m_livecrootn_xfer_to_litter_patch , & ! Input: [real(r8) (:) ]
- m_deadcrootn_xfer_to_litter => cnveg_nitrogenflux_inst%m_deadcrootn_xfer_to_litter_patch , & ! Input: [real(r8) (:) ]
- gap_mortality_n_to_litr_met_n => cnveg_nitrogenflux_inst%gap_mortality_n_to_litr_met_n_col , & ! Output: [real(r8) (:,:) ] N fluxes associated with gap mortality to litter metabolic pool (gN/m3/s)
- gap_mortality_n_to_litr_cel_n => cnveg_nitrogenflux_inst%gap_mortality_n_to_litr_cel_n_col , & ! Output: [real(r8) (:,:) ] N fluxes associated with gap mortality to litter cellulose pool (gN/m3/s)
- gap_mortality_n_to_litr_lig_n => cnveg_nitrogenflux_inst%gap_mortality_n_to_litr_lig_n_col , & ! Output: [real(r8) (:,:) ] N fluxes associated with gap mortality to litter lignin pool (gN/m3/s)
- gap_mortality_n_to_cwdn => cnveg_nitrogenflux_inst%gap_mortality_n_to_cwdn_col & ! Output: [real(r8) (:,:) ] N fluxes associated with gap mortality to CWD pool (gN/m3/s)
- )
-
- do j = 1,nlevdecomp
- do pi = 1,maxpatch_pft
- do fc = 1,num_soilc
- c = filter_soilc(fc)
-
- if (pi <= col%npatches(c)) then
- p = col%patchi(c) + pi - 1
-
- if (patch%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)
-
-
- end if
- end if
-
- end do
- end do
- end do
-
- end associate
-
- end subroutine CNGap_PatchToColumn
-
-end module CNGapMortalityMod
diff --git a/src/biogeochem/CNMRespMod.F90 b/src/biogeochem/CNMRespMod.F90
deleted file mode 100644
index 74ff1a9d..00000000
--- a/src/biogeochem/CNMRespMod.F90
+++ /dev/null
@@ -1,237 +0,0 @@
-module CNMRespMod
-
- !-----------------------------------------------------------------------
- ! !DESCRIPTION:
- ! Module holding maintenance respiration routines for coupled carbon
- ! nitrogen code.
- !
- ! !USES:
- use shr_kind_mod , only : r8 => shr_kind_r8
- use shr_const_mod , only : SHR_CONST_TKFRZ
- use clm_varpar , only : nlevgrnd
- use clm_varcon , only : spval
- use decompMod , only : bounds_type
- use abortutils , only : endrun
- use shr_log_mod , only : errMsg => shr_log_errMsg
- use pftconMod , only : npcropmin, pftcon
- use SoilStateType , only : soilstate_type
- use CanopyStateType , only : canopystate_type
- use TemperatureType , only : temperature_type
- use PhotosynthesisMod , only : photosyns_type
- use CNVegcarbonfluxType , only : cnveg_carbonflux_type
- use CNVegnitrogenstateType , only : cnveg_nitrogenstate_type
- use CNSharedParamsMod , only : CNParamsShareInst
- use PatchType , only : patch
- !
- implicit none
- private
- !
- ! !PUBLIC MEMBER FUNCTIONS:
- public :: readParams ! Read in parameters from file
- public :: CNMResp ! Apply maintenance respiration
-
- type, private :: params_type
- real(r8) :: br = spval ! base rate for maintenance respiration (gC/gN/s)
- real(r8) :: br_root = spval ! base rate for maintenance respiration for roots (gC/gN/s)
- end type params_type
-
- type(params_type), private :: params_inst
-
- character(len=*), parameter, private :: sourcefile = &
- __FILE__
- !-----------------------------------------------------------------------
-
-contains
-
- !-----------------------------------------------------------------------
- subroutine readParams ( ncid )
- !
- ! !DESCRIPTION:
- ! Read parameters (call AFTER CNMRespReadNML!)
- !
- ! !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 = 'CNMRespParamsType'
- 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='br_mr'
- 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(sourcefile, __LINE__))
- params_inst%br=tempr
-
- if ( params_inst%br_root == spval ) then
- params_inst%br_root = params_inst%br
- end if
-
- end subroutine readParams
-
- !-----------------------------------------------------------------------
- ! FIX(SPM,032414) this shouldn't even be called with fates on.
- !
- subroutine CNMResp(bounds, num_soilc, filter_soilc, num_soilp, filter_soilp, &
- canopystate_inst, soilstate_inst, temperature_inst, photosyns_inst, &
- cnveg_carbonflux_inst, cnveg_nitrogenstate_inst)
- !
- ! !DESCRIPTION:
- !
- ! !ARGUMENTS:
- use clm_varcon , only : tfrz
-
- type(bounds_type) , intent(in) :: bounds
- integer , intent(in) :: num_soilc ! number of soil points in column filter
- integer , intent(in) :: filter_soilc(:) ! column filter for soil points
- integer , intent(in) :: num_soilp ! number of soil points in patch filter
- integer , intent(in) :: filter_soilp(:) ! patch filter for soil points
- type(canopystate_type) , intent(in) :: canopystate_inst
- type(soilstate_type) , intent(in) :: soilstate_inst
- type(temperature_type) , intent(in) :: temperature_inst
- type(photosyns_type) , intent(in) :: photosyns_inst
- type(cnveg_carbonflux_type) , intent(inout) :: cnveg_carbonflux_inst
- type(cnveg_nitrogenstate_type) , intent(in) :: cnveg_nitrogenstate_inst
- !
- ! !LOCAL VARIABLES:
- integer :: c,p,j ! indices
- integer :: fp ! soil filter patch index
- integer :: fc ! soil filter column index
- real(r8):: br ! base rate (gC/gN/s)
- real(r8):: br_root ! root base rate (gC/gN/s)
- real(r8):: q10 ! temperature dependence
-
- real(r8):: tc ! temperature correction, 2m air temp (unitless)
- real(r8):: tcsoi(bounds%begc:bounds%endc,nlevgrnd) ! temperature correction by soil layer (unitless)
- !-----------------------------------------------------------------------
-
- associate( &
- ivt => patch%itype , & ! Input: [integer (:) ] patch vegetation type
-
- woody => pftcon%woody , & ! Input: binary flag for woody lifeform (1=woody, 0=not woody)
-
- frac_veg_nosno => canopystate_inst%frac_veg_nosno_patch , & ! Input: [integer (:) ] fraction of vegetation not covered by snow (0 OR 1) [-]
- laisun => canopystate_inst%laisun_patch , & ! Input: [real(r8) (:) ] sunlit projected leaf area index
- laisha => canopystate_inst%laisha_patch , & ! Input: [real(r8) (:) ] shaded projected leaf area index
-
- crootfr => soilstate_inst%crootfr_patch , & ! Input: [real(r8) (:,:) ] fraction of roots for carbon in each soil layer (nlevgrnd)
-
- t_soisno => temperature_inst%t_soisno_col , & ! Input: [real(r8) (:,:) ] soil temperature (Kelvin) (-nlevsno+1:nlevgrnd)
- t_ref2m => temperature_inst%t_ref2m_patch , & ! Input: [real(r8) (:) ] 2 m height surface air temperature (Kelvin)
-
- t10 => temperature_inst%t_a10_patch , & ! Input: [real(r8) (:) ] 10-day running mean of the 2 m temperature (K)
-
- lmrsun => photosyns_inst%lmrsun_patch , & ! Input: [real(r8) (:) ] sunlit leaf maintenance respiration rate (umol CO2/m**2/s)
- lmrsha => photosyns_inst%lmrsha_patch , & ! Input: [real(r8) (:) ] shaded leaf maintenance respiration rate (umol CO2/m**2/s)
- rootstem_acc => photosyns_inst%rootstem_acc , & ! Input: [logical ] root and stem acclimation switch
-
- frootn => cnveg_nitrogenstate_inst%frootn_patch , & ! Input: [real(r8) (:) ] (gN/m2) fine root N
- livestemn => cnveg_nitrogenstate_inst%livestemn_patch , & ! Input: [real(r8) (:) ] (gN/m2) live stem N
- livecrootn => cnveg_nitrogenstate_inst%livecrootn_patch , & ! Input: [real(r8) (:) ] (gN/m2) live coarse root N
- grainn => cnveg_nitrogenstate_inst%grainn_patch , & ! Input: [real(r8) (:) ] (kgN/m2) grain N
-
- leaf_mr => cnveg_carbonflux_inst%leaf_mr_patch , & ! Output: [real(r8) (:) ]
- froot_mr => cnveg_carbonflux_inst%froot_mr_patch , & ! Output: [real(r8) (:) ]
- livestem_mr => cnveg_carbonflux_inst%livestem_mr_patch , & ! Output: [real(r8) (:) ]
- livecroot_mr => cnveg_carbonflux_inst%livecroot_mr_patch , & ! Output: [real(r8) (:) ]
- grain_mr => cnveg_carbonflux_inst%grain_mr_patch & ! Output: [real(r8) (:) ]
-
- )
-
- ! base rate for maintenance respiration is from:
- ! M. Ryan, 1991. Effects of climate change on plant respiration.
- ! Ecological Applications, 1(2), 157-167.
- ! Original expression is br = 0.0106 molC/(molN h)
- ! Conversion by molecular weights of C and N gives 2.525e-6 gC/(gN s)
- ! set constants
- br = params_inst%br
- br_root = params_inst%br_root
-
- ! Peter Thornton: 3/13/09
- ! Q10 was originally set to 2.0, an arbitrary choice, but reduced to 1.5 as part of the tuning
- ! to improve seasonal cycle of atmospheric CO2 concentration in global
- ! simulatoins
- Q10 = CNParamsShareInst%Q10
-
- ! column loop to calculate temperature factors in each soil layer
- do j=1,nlevgrnd
- do fc = 1, num_soilc
- c = filter_soilc(fc)
-
- ! calculate temperature corrections for each soil layer, for use in
- ! estimating fine root maintenance respiration with depth
- tcsoi(c,j) = Q10**((t_soisno(c,j)-SHR_CONST_TKFRZ - 20.0_r8)/10.0_r8)
- end do
- end do
-
- ! patch loop for leaves and live wood
- do fp = 1, num_soilp
- p = filter_soilp(fp)
-
- ! calculate maintenance respiration fluxes in
- ! gC/m2/s for each of the live plant tissues.
- ! Leaf and live wood MR
-
- tc = Q10**((t_ref2m(p)-SHR_CONST_TKFRZ - 20.0_r8)/10.0_r8)
-
- !RF: acclimation of root and stem respiration fluxes
- ! n.b. we do not yet know if this is defensible scientifically (awaiting data analysis)
- ! turning this on will increase R and decrease productivity in boreal forests, A LOT. :)
-
- if(rootstem_acc)then
- br = br * 10._r8**(-0.00794_r8*((t10(p)-tfrz)-25._r8))
- br_root = br_root * 10._r8**(-0.00794_r8*((t10(p)-tfrz)-25._r8))
- end if
-
- if (frac_veg_nosno(p) == 1) then
-
- leaf_mr(p) = lmrsun(p) * laisun(p) * 12.011e-6_r8 + &
- lmrsha(p) * laisha(p) * 12.011e-6_r8
-
- else !nosno
-
- leaf_mr(p) = 0._r8
-
- end if
-
- if (woody(ivt(p)) == 1) then
- livestem_mr(p) = livestemn(p)*br*tc
- livecroot_mr(p) = livecrootn(p)*br_root*tc
- else if (ivt(p) >= npcropmin) then
- livestem_mr(p) = livestemn(p)*br*tc
- grain_mr(p) = grainn(p)*br*tc
- end if
- end do
-
- ! soil and patch loop for fine root
-
- do j = 1,nlevgrnd
- do fp = 1,num_soilp
- p = filter_soilp(fp)
- c = patch%column(p)
-
- ! Fine root MR
- ! crootfr(j) sums to 1.0 over all soil layers, and
- ! describes the fraction of root mass for carbon that is in each
- ! layer. This is used with the layer temperature correction
- ! to estimate the total fine root maintenance respiration as a
- ! function of temperature and N content.
- if(rootstem_acc)then
- br_root = br_root * 10._r8**(-0.00794_r8*((t10(p)-tfrz)-25._r8))
- end if
- froot_mr(p) = froot_mr(p) + frootn(p)*br_root*tcsoi(c,j)*crootfr(p,j)
-
- end do
- end do
-
- end associate
-
- end subroutine CNMResp
-
-end module CNMRespMod
diff --git a/src/biogeochem/CNNDynamicsMod.F90 b/src/biogeochem/CNNDynamicsMod.F90
deleted file mode 100644
index 0d367efe..00000000
--- a/src/biogeochem/CNNDynamicsMod.F90
+++ /dev/null
@@ -1,375 +0,0 @@
-module CNNDynamicsMod
-
- !-----------------------------------------------------------------------
- ! !DESCRIPTION:
- ! Module for mineral nitrogen dynamics (deposition, fixation, leaching)
- ! for coupled carbon-nitrogen code.
- !
- ! !USES:
- use shr_kind_mod , only : r8 => shr_kind_r8
- use decompMod , only : bounds_type
- use clm_varcon , only : dzsoi_decomp, zisoi
- use clm_varctl , only : use_nitrif_denitrif, use_vertsoilc, nfix_timeconst
- use subgridAveMod , only : p2c
- use atm2lndType , only : atm2lnd_type
- use CNVegStateType , only : cnveg_state_type
- use CNVegCarbonFluxType , only : cnveg_carbonflux_type
- use CNVegNitrogenStateType , only : cnveg_nitrogenstate_type
- use CNVegNitrogenFluxType , only : cnveg_nitrogenflux_type
- use SoilBiogeochemStateType , only : soilbiogeochem_state_type
- use SoilBiogeochemNitrogenStateType , only : soilbiogeochem_nitrogenstate_type
- use SoilBiogeochemNitrogenFluxType , only : soilbiogeochem_nitrogenflux_type
- use WaterStateType , only : waterstate_type
- use WaterFluxType , only : waterflux_type
- use CropType , only : crop_type
- use ColumnType , only : col
- use PatchType , only : patch
- use perf_mod , only : t_startf, t_stopf
- !
- implicit none
- private
- !
- ! !PUBLIC MEMBER FUNCTIONS:
- public :: CNNDeposition ! Update N deposition rate from atm forcing
- public :: CNNFixation ! Update N Fixation rate
- public :: CNNFert ! Update N fertilizer for crops
- public :: CNSoyfix ! N Fixation for soybeans
- public :: CNFreeLivingFixation ! N free living fixation
-
- !
- ! !PRIVATE DATA MEMBERS:
- type, private :: params_type
- real(r8) :: freelivfix_intercept ! intercept of line of free living fixation with annual ET
- real(r8) :: freelivfix_slope_wET ! slope of line of free living fixation with annual ET
- end type params_type
- type(params_type) :: params_inst
- !-----------------------------------------------------------------------
-
-contains
-
- !-----------------------------------------------------------------------
- subroutine CNNDeposition( bounds, &
- atm2lnd_inst, soilbiogeochem_nitrogenflux_inst )
- !
- ! !DESCRIPTION:
- ! On the radiation time step, update the nitrogen deposition rate
- ! from atmospheric forcing. For now it is assumed that all the atmospheric
- ! N deposition goes to the soil mineral N pool.
- ! This could be updated later to divide the inputs between mineral N absorbed
- ! directly into the canopy and mineral N entering the soil pool.
- !
- ! !USES:
- use CNSharedParamsMod , only: use_fun
- ! !ARGUMENTS:
- type(bounds_type) , intent(in) :: bounds
- type(atm2lnd_type) , intent(in) :: atm2lnd_inst
- type(soilbiogeochem_nitrogenflux_type) , intent(inout) :: soilbiogeochem_nitrogenflux_inst
- !
- ! !LOCAL VARIABLES:
- integer :: g,c ! indices
- !-----------------------------------------------------------------------
-
- associate( &
- forc_ndep => atm2lnd_inst%forc_ndep_grc , & ! Input: [real(r8) (:)] nitrogen deposition rate (gN/m2/s)
- ndep_to_sminn => soilbiogeochem_nitrogenflux_inst%ndep_to_sminn_col & ! Output: [real(r8) (:)] atmospheric N deposition to soil mineral N (gN/m2/s)
- )
-
- ! Loop through columns
- do c = bounds%begc, bounds%endc
- g = col%gridcell(c)
- ndep_to_sminn(c) = forc_ndep(g)
-
- end do
-
- end associate
-
- end subroutine CNNDeposition
-
- !-----------------------------------------------------------------------
- subroutine CNFreeLivingFixation(num_soilc, filter_soilc, &
- waterflux_inst, soilbiogeochem_nitrogenflux_inst)
-
-
- use clm_time_manager , only : get_days_per_year, get_step_size
- use shr_sys_mod , only : shr_sys_flush
- use clm_varcon , only : secspday, spval
-
- integer , intent(in) :: num_soilc ! number of soil columns in filter
- integer , intent(in) :: filter_soilc(:) ! filter for soil columns
-
- type(soilbiogeochem_nitrogenflux_type) , intent(inout) :: soilbiogeochem_nitrogenflux_inst
- type(waterflux_type) , intent(inout) :: waterflux_inst
- !
- ! !LOCAL VARIABLES:
- integer :: c,fc !indices
- real(r8) :: dayspyr !days per year
- real(r8) :: secs_per_year !seconds per year
-
- associate( &
- AnnET => waterflux_inst%AnnET, & ! Input: [real(:) ] : Annual average ET flux mmH20/s
- freelivfix_slope => params_inst%freelivfix_slope_wET, & ! Input: [real ] : slope of fixation with ET
- freelivfix_inter => params_inst%freelivfix_intercept, & ! Input: [real ] : intercept of fixation with ET
- ffix_to_sminn => soilbiogeochem_nitrogenflux_inst%ffix_to_sminn_col & ! Output: [real(:) ] : free living N fixation to soil mineral N (gN/m2/s)
- )
-
- dayspyr = get_days_per_year()
- secs_per_year = dayspyr*24_r8*3600_r8
-
- do fc = 1,num_soilc
- c = filter_soilc(fc)
- ffix_to_sminn(c) = (freelivfix_slope*(max(0._r8,AnnET(c))*secs_per_year) + freelivfix_inter )/secs_per_year !(units g N m-2 s-1)
-
- end do
-
- end associate
- end subroutine CNFreeLivingFixation
-
- !-----------------------------------------------------------------------
- subroutine CNNFixation(num_soilc, filter_soilc, &
- cnveg_carbonflux_inst, soilbiogeochem_nitrogenflux_inst)
- !
- ! !DESCRIPTION:
- ! On the radiation time step, update the nitrogen fixation rate
- ! as a function of annual total NPP. This rate gets updated once per year.
- ! All N fixation goes to the soil mineral N pool.
- !
- ! !USES:
- use clm_time_manager , only : get_days_per_year, get_step_size
- use shr_sys_mod , only : shr_sys_flush
- use clm_varcon , only : secspday, spval
- use CNSharedParamsMod , only: use_fun
- !
- ! !ARGUMENTS:
- integer , intent(in) :: num_soilc ! number of soil columns in filter
- integer , intent(in) :: filter_soilc(:) ! filter for soil columns
- type(cnveg_carbonflux_type) , intent(inout) :: cnveg_carbonflux_inst
- type(soilbiogeochem_nitrogenflux_type) , intent(inout) :: soilbiogeochem_nitrogenflux_inst
- !
- ! !LOCAL VARIABLES:
- integer :: c,fc ! indices
- real(r8) :: t ! temporary
- real(r8) :: dayspyr ! days per year
- !-----------------------------------------------------------------------
-
- associate( &
- cannsum_npp => cnveg_carbonflux_inst%annsum_npp_col , & ! Input: [real(r8) (:)] nitrogen deposition rate (gN/m2/s)
- col_lag_npp => cnveg_carbonflux_inst%lag_npp_col , & ! Input: [real(r8) (:)] (gC/m2/s) lagged net primary production
-
- nfix_to_sminn => soilbiogeochem_nitrogenflux_inst%nfix_to_sminn_col & ! Output: [real(r8) (:)] symbiotic/asymbiotic N fixation to soil mineral N (gN/m2/s)
- )
-
- dayspyr = get_days_per_year()
-
- if ( nfix_timeconst > 0._r8 .and. nfix_timeconst < 500._r8 ) then
- ! use exponential relaxation with time constant nfix_timeconst for NPP - NFIX relation
- ! Loop through columns
- do fc = 1,num_soilc
- c = filter_soilc(fc)
-
- if (col_lag_npp(c) /= spval) then
- ! need to put npp in units of gC/m^2/year here first
- t = (1.8_r8 * (1._r8 - exp(-0.003_r8 * col_lag_npp(c)*(secspday * dayspyr))))/(secspday * dayspyr)
- nfix_to_sminn(c) = max(0._r8,t)
- else
- nfix_to_sminn(c) = 0._r8
- endif
- end do
- else
- ! use annual-mean values for NPP-NFIX relation
- do fc = 1,num_soilc
- c = filter_soilc(fc)
-
- t = (1.8_r8 * (1._r8 - exp(-0.003_r8 * cannsum_npp(c))))/(secspday * dayspyr)
- nfix_to_sminn(c) = max(0._r8,t)
- end do
- endif
- if(use_fun)then
- nfix_to_sminn(c) = 0.0_r8
- end if
-
- end associate
-
- end subroutine CNNFixation
-
- !-----------------------------------------------------------------------
- subroutine CNNFert(bounds, num_soilc, filter_soilc, &
- cnveg_nitrogenflux_inst, soilbiogeochem_nitrogenflux_inst)
- !
- ! !DESCRIPTION:
- ! On the radiation time step, update the nitrogen fertilizer for crops
- ! All fertilizer goes into the soil mineral N pool.
- !
- ! !USES:
- !
- ! !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
- type(cnveg_nitrogenflux_type) , intent(in) :: cnveg_nitrogenflux_inst
- type(soilbiogeochem_nitrogenflux_type) , intent(inout) :: soilbiogeochem_nitrogenflux_inst
- !
- ! !LOCAL VARIABLES:
- integer :: c,fc ! indices
- !-----------------------------------------------------------------------
-
- associate( &
- fert => cnveg_nitrogenflux_inst%fert_patch , & ! Input: [real(r8) (:)] nitrogen fertilizer rate (gN/m2/s)
- fert_to_sminn => soilbiogeochem_nitrogenflux_inst%fert_to_sminn_col & ! Output: [real(r8) (:)]
- )
-
- call p2c(bounds, num_soilc, filter_soilc, &
- fert(bounds%begp:bounds%endp), &
- fert_to_sminn(bounds%begc:bounds%endc))
-
- end associate
-
- end subroutine CNNFert
-
- !-----------------------------------------------------------------------
- subroutine CNSoyfix (bounds, num_soilc, filter_soilc, num_soilp, filter_soilp, &
- waterstate_inst, crop_inst, cnveg_state_inst, cnveg_nitrogenflux_inst , &
- soilbiogeochem_state_inst, soilbiogeochem_nitrogenstate_inst, soilbiogeochem_nitrogenflux_inst)
- !
- ! !DESCRIPTION:
- ! This routine handles the fixation of nitrogen for soybeans based on
- ! the EPICPHASE model M. Cabelguenne et al., Agricultural systems 60: 175-196, 1999
- ! N-fixation is based on soil moisture, plant growth phase, and availibility of
- ! nitrogen in the soil root zone.
- !
- ! !USES:
- use pftconMod, only : ntmp_soybean, nirrig_tmp_soybean
- use pftconMod, only : ntrp_soybean, nirrig_trp_soybean
- !
- ! !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(waterstate_type) , intent(in) :: waterstate_inst
- type(crop_type) , intent(in) :: crop_inst
- type(cnveg_state_type) , intent(in) :: cnveg_state_inst
- type(cnveg_nitrogenflux_type) , intent(inout) :: cnveg_nitrogenflux_inst
- type(soilbiogeochem_state_type) , intent(in) :: soilbiogeochem_state_inst
- type(soilbiogeochem_nitrogenstate_type) , intent(in) :: soilbiogeochem_nitrogenstate_inst
- type(soilbiogeochem_nitrogenflux_type) , intent(inout) :: soilbiogeochem_nitrogenflux_inst
- !
- ! !LOCAL VARIABLES:
- integer :: fp,p,c
- real(r8):: fxw,fxn,fxg,fxr ! soil water factor, nitrogen factor, growth stage factor
- real(r8):: soy_ndemand ! difference between nitrogen supply and demand
- real(r8):: GDDfrac
- real(r8):: sminnthreshold1, sminnthreshold2
- real(r8):: GDDfracthreshold1, GDDfracthreshold2
- real(r8):: GDDfracthreshold3, GDDfracthreshold4
- !-----------------------------------------------------------------------
-
- associate( &
- wf => waterstate_inst%wf_col , & ! Input: [real(r8) (:) ] soil water as frac. of whc for top 0.5 m
-
- hui => crop_inst%gddplant_patch , & ! Input: [real(r8) (:) ] gdd since planting (gddplant)
- croplive => crop_inst%croplive_patch , & ! Input: [logical (:) ] true if planted and not harvested
-
- gddmaturity => cnveg_state_inst%gddmaturity_patch , & ! Input: [real(r8) (:) ] gdd needed to harvest
-
- plant_ndemand => cnveg_nitrogenflux_inst%plant_ndemand_patch , & ! Input: [real(r8) (:) ] N flux required to support initial GPP (gN/m2/s)
- soyfixn => cnveg_nitrogenflux_inst%soyfixn_patch , & ! Output: [real(r8) (:) ] nitrogen fixed to each soybean crop
-
- fpg => soilbiogeochem_state_inst%fpg_col , & ! Input: [real(r8) (:) ] fraction of potential gpp (no units)
-
- sminn => soilbiogeochem_nitrogenstate_inst%sminn_col , & ! Input: [real(r8) (:) ] (kgN/m2) soil mineral N
- soyfixn_to_sminn => soilbiogeochem_nitrogenflux_inst%soyfixn_to_sminn_col & ! Output: [real(r8) (:) ]
- )
-
- sminnthreshold1 = 30._r8
- sminnthreshold2 = 10._r8
- GDDfracthreshold1 = 0.15_r8
- GDDfracthreshold2 = 0.30_r8
- GDDfracthreshold3 = 0.55_r8
- GDDfracthreshold4 = 0.75_r8
-
- do fp = 1,num_soilp
- p = filter_soilp(fp)
- c = patch%column(p)
-
- ! if soybean currently growing then calculate fixation
-
- if (croplive(p) .and. &
- (patch%itype(p) == ntmp_soybean .or. &
- patch%itype(p) == nirrig_tmp_soybean .or. &
- patch%itype(p) == ntrp_soybean .or. &
- patch%itype(p) == nirrig_trp_soybean) ) then
-
- ! difference between supply and demand
-
- if (fpg(c) < 1._r8) then
- soy_ndemand = 0._r8
- soy_ndemand = plant_ndemand(p) - plant_ndemand(p)*fpg(c)
-
- ! fixation depends on nitrogen, soil water, and growth stage
-
- ! soil water factor
-
- fxw = 0._r8
- fxw = wf(c)/0.85_r8
-
- ! soil nitrogen factor (Beth says: CHECK UNITS)
-
- if (sminn(c) > sminnthreshold1) then
- fxn = 0._r8
- else if (sminn(c) > sminnthreshold2 .and. sminn(c) <= sminnthreshold1) then
- fxn = 1.5_r8 - .005_r8 * (sminn(c) * 10._r8)
- else if (sminn(c) <= sminnthreshold2) then
- fxn = 1._r8
- end if
-
- ! growth stage factor
- ! slevis: to replace GDDfrac, assume...
- ! Beth's crit_offset_gdd_def is similar to my gddmaturity
- ! Beth's ac_gdd (base 5C) similar to my hui=gddplant (base 10
- ! for soy)
- ! Ranges below are not firm. Are they lit. based or tuning based?
-
- GDDfrac = hui(p) / gddmaturity(p)
-
- if (GDDfrac <= GDDfracthreshold1) then
- fxg = 0._r8
- else if (GDDfrac > GDDfracthreshold1 .and. GDDfrac <= GDDfracthreshold2) then
- fxg = 6.67_r8 * GDDfrac - 1._r8
- else if (GDDfrac > GDDfracthreshold2 .and. GDDfrac <= GDDfracthreshold3) then
- fxg = 1._r8
- else if (GDDfrac > GDDfracthreshold3 .and. GDDfrac <= GDDfracthreshold4) then
- fxg = 3.75_r8 - 5._r8 * GDDfrac
- else ! GDDfrac > GDDfracthreshold4
- fxg = 0._r8
- end if
-
- ! calculate the nitrogen fixed by the soybean
-
- fxr = min(1._r8, fxw, fxn) * fxg
- fxr = max(0._r8, fxr)
- soyfixn(p) = fxr * soy_ndemand
- soyfixn(p) = min(soyfixn(p), soy_ndemand)
-
- else ! if nitrogen demand met, no fixation
-
- soyfixn(p) = 0._r8
-
- end if
-
- else ! if not live soybean, no fixation
-
- soyfixn(p) = 0._r8
-
- end if
- end do
-
- call p2c(bounds, num_soilc, filter_soilc, &
- soyfixn(bounds%begp:bounds%endp), &
- soyfixn_to_sminn(bounds%begc:bounds%endc))
-
- end associate
-
- end subroutine CNSoyfix
-
-end module CNNDynamicsMod
diff --git a/src/biogeochem/CNPhenologyMod.F90 b/src/biogeochem/CNPhenologyMod.F90
deleted file mode 100644
index b54cff51..00000000
--- a/src/biogeochem/CNPhenologyMod.F90
+++ /dev/null
@@ -1,247 +0,0 @@
-module CNPhenologyMod
-
-#include "shr_assert.h"
-
- !-----------------------------------------------------------------------
- ! !MODULE: CNPhenologyMod
- !
- ! !DESCRIPTION:
- ! Module holding routines used in phenology model for coupled carbon
- ! nitrogen code.
- !
- ! !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, nlevdecomp_full
- use clm_varctl , only : iulog, use_cndv
- use clm_varcon , only : tfrz
- use abortutils , only : endrun
- use CanopyStateType , only : canopystate_type
- use CNDVType , only : dgvs_type
- use CNVegstateType , only : cnveg_state_type
- use CNVegCarbonStateType , only : cnveg_carbonstate_type
- use CNVegCarbonFluxType , only : cnveg_carbonflux_type
- use CNVegnitrogenstateType , only : cnveg_nitrogenstate_type
- use CNVegnitrogenfluxType , only : cnveg_nitrogenflux_type
- use CropType , only : crop_type
- use pftconMod , only : pftcon
- use SoilStateType , only : soilstate_type
- use TemperatureType , only : temperature_type
- use WaterstateType , only : waterstate_type
- use ColumnType , only : col
- use GridcellType , only : grc
- use PatchType , only : patch
- use atm2lndType , only : atm2lnd_type
- use atm2lndType , only : atm2lnd_type
- !
- implicit none
- private
- !
- ! !PUBLIC MEMBER FUNCTIONS:
- public :: readParams ! Read parameters
- public :: CNPhenologyInit ! Initialization
- !
- ! !PRIVATE DATA MEMBERS:
- type, private :: params_type
- 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 params_type
-
- type(params_type) :: params_inst
-
- 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 patch 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
-
- real(r8), private :: initial_seed_at_planting = 3._r8 ! Initial seed at planting
-
- character(len=*), parameter, private :: sourcefile = &
- __FILE__
- !-----------------------------------------------------------------------
-
-contains
-
- !-----------------------------------------------------------------------
- subroutine readParams ( 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(sourcefile, __LINE__))
- params_inst%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(sourcefile, __LINE__))
- params_inst%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(sourcefile, __LINE__))
- params_inst%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(sourcefile, __LINE__))
- params_inst%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(sourcefile, __LINE__))
- params_inst%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(sourcefile, __LINE__))
- params_inst%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(sourcefile, __LINE__))
- params_inst%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(sourcefile, __LINE__))
- params_inst%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(sourcefile, __LINE__))
- params_inst%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(sourcefile, __LINE__))
- params_inst%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(sourcefile, __LINE__))
- params_inst%lwtop=tempr
-
- end subroutine readParams
-
- !-----------------------------------------------------------------------
- subroutine CNPhenologyInit(bounds)
- !
- ! !DESCRIPTION:
- ! Initialization of CNPhenology. Must be called after time-manager is
- ! initialized, and after pftcon file is read in.
- !
- ! !USES:
- use clm_time_manager, only: get_step_size
- use clm_varctl , only: use_crop
- use clm_varcon , only: secspday
- !
- ! !ARGUMENTS:
- 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=params_inst%crit_dayl
-
- ! Set constants for CNSeasonDecidPhenology and CNStressDecidPhenology
- ndays_on=params_inst%ndays_on
- ndays_off=params_inst%ndays_off
-
- ! set transfer parameters
- fstor2tran=params_inst%fstor2tran
-
- ! -----------------------------------------
- ! Constants for CNStressDecidPhenology
- ! -----------------------------------------
-
- ! onset parameters
- crit_onset_fdd=params_inst%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=params_inst%crit_onset_swi
- soilpsi_on=params_inst%soilpsi_on
-
- ! offset parameters
- crit_offset_fdd=params_inst%crit_offset_fdd
- crit_offset_swi=params_inst%crit_offset_swi
- soilpsi_off=params_inst%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=params_inst%lwtop/31536000.0_r8 !annual fraction converted to per second
-
- ! -----------------------------------------
- ! Call any subroutine specific initialization routines
- ! -----------------------------------------
-
- !if ( use_crop ) call CropPhenologyInit(bounds)
-
- end subroutine CNPhenologyInit
-
-end module CNPhenologyMod
diff --git a/src/biogeochem/CNPrecisionControlMod.F90 b/src/biogeochem/CNPrecisionControlMod.F90
deleted file mode 100644
index 8c5660d1..00000000
--- a/src/biogeochem/CNPrecisionControlMod.F90
+++ /dev/null
@@ -1,498 +0,0 @@
-module CNPrecisionControlMod
-
-#include "shr_assert.h"
-
- !-----------------------------------------------------------------------
- ! !DESCRIPTION:
- ! controls on very low values in critical state variables
- !
- ! !USES:
- use shr_kind_mod , only : r8 => shr_kind_r8
- use CNVegCarbonStateType , only : cnveg_carbonstate_type
- use CNVegNitrogenStateType , only : cnveg_nitrogenstate_type
- use PatchType , only : patch
- use abortutils , only : endrun
- !
- implicit none
- private
- !
- ! !PUBLIC MEMBER FUNCTIONS:
- public:: CNPrecisionControl
-
- ! !PUBLIC DATA:
- real(r8), public :: ccrit = 1.e-8_r8 ! critical carbon state value for truncation (gC/m2)
- real(r8), public :: cnegcrit = -6.e+1_r8 ! critical negative carbon state value for abort (gC/m2)
- real(r8), public :: ncrit = 1.e-8_r8 ! critical nitrogen state value for truncation (gN/m2)
- real(r8), public :: nnegcrit = -6.e+0_r8 ! critical negative nitrogen state value for abort (gN/m2)
- real(r8), public, parameter :: n_min = 0.000000001_r8 ! Minimum Nitrogen value to use when calculating CN ratio (gN/m2)
-
- ! !PRIVATE DATA:
- logical, private :: prec_control_for_froot = .true. ! If true do precision control for frootc/frootn
- character(len=*), parameter, private :: sourcefile = &
- __FILE__
- !-----------------------------------------------------------------------
-
-contains
-
- !-----------------------------------------------------------------------
- subroutine CNPrecisionControl(bounds, num_soilp, filter_soilp, &
- cnveg_carbonstate_inst, c13_cnveg_carbonstate_inst, c14_cnveg_carbonstate_inst, &
- cnveg_nitrogenstate_inst)
- !
- ! !DESCRIPTION:
- ! Force leaf and deadstem c and n to 0 if they get too small.
- !
- ! !USES:
- use clm_varctl , only : iulog
- use clm_varpar , only : use_crop
- use pftconMod , only : nc3crop
- use decompMod , only : bounds_type
- !
- ! !ARGUMENTS:
- type(bounds_type) , intent(in) :: bounds ! bounds
- integer , intent(in) :: num_soilp ! number of soil patchs in filter
- integer , intent(in) :: filter_soilp(:) ! filter for soil patches
- type(cnveg_carbonstate_type) , intent(inout) :: cnveg_carbonstate_inst
- type(cnveg_carbonstate_type) , intent(inout) :: c13_cnveg_carbonstate_inst
- type(cnveg_carbonstate_type) , intent(inout) :: c14_cnveg_carbonstate_inst
- type(cnveg_nitrogenstate_type) , intent(inout) :: cnveg_nitrogenstate_inst
- !
- ! !LOCAL VARIABLES:
- integer :: p,j,k ! indices
- integer :: fp ! filter indices
- real(r8):: pc(bounds%begp:bounds%endp) ! truncation terms for patch-level corrections Carbon
- real(r8):: pn(bounds%begp:bounds%endp) ! truncation terms for patch-level corrections nitrogen
- real(r8):: pc13(bounds%begp:bounds%endp) ! truncation terms for patch-level corrections
- real(r8):: pc14(bounds%begp:bounds%endp) ! truncation terms for patch-level corrections
- !-----------------------------------------------------------------------
-
- ! cnveg_carbonstate_inst%cpool_patch Output: [real(r8) (:) ] (gC/m2) temporary photosynthate C pool
- ! cnveg_carbonstate_inst%deadcrootc_patch Output: [real(r8) (:) ] (gC/m2) dead coarse root C
- ! cnveg_carbonstate_inst%deadcrootc_storage_patch Output: [real(r8) (:) ] (gC/m2) dead coarse root C storage
- ! cnveg_carbonstate_inst%deadcrootc_xfer_patch Output: [real(r8) (:) ] (gC/m2) dead coarse root C transfer
- ! cnveg_carbonstate_inst%deadstemc_patch Output: [real(r8) (:) ] (gC/m2) dead stem C
- ! cnveg_carbonstate_inst%deadstemc_storage_patch Output: [real(r8) (:) ] (gC/m2) dead stem C storage
- ! cnveg_carbonstate_inst%deadstemc_xfer_patch Output: [real(r8) (:) ] (gC/m2) dead stem C transfer
- ! cnveg_carbonstate_inst%frootc_patch Output: [real(r8) (:) ] (gC/m2) fine root C
- ! cnveg_carbonstate_inst%frootc_storage_patch Output: [real(r8) (:) ] (gC/m2) fine root C storage
- ! cnveg_carbonstate_inst%frootc_xfer_patch Output: [real(r8) (:) ] (gC/m2) fine root C transfer
- ! cnveg_carbonstate_inst%gresp_storage_patch Output: [real(r8) (:) ] (gC/m2) growth respiration storage
- ! cnveg_carbonstate_inst%gresp_xfer_patch Output: [real(r8) (:) ] (gC/m2) growth respiration transfer
- ! cnveg_carbonstate_inst%leafc_patch Output: [real(r8) (:) ] (gC/m2) leaf C
- ! cnveg_carbonstate_inst%leafc_storage_patch Output: [real(r8) (:) ] (gC/m2) leaf C storage
- ! cnveg_carbonstate_inst%leafc_xfer_patch Output: [real(r8) (:) ] (gC/m2) leaf C transfer
- ! cnveg_carbonstate_inst%livecrootc_patch Output: [real(r8) (:) ] (gC/m2) live coarse root C
- ! cnveg_carbonstate_inst%livecrootc_storage_patch Output: [real(r8) (:) ] (gC/m2) live coarse root C storage
- ! cnveg_carbonstate_inst%livecrootc_xfer_patch Output: [real(r8) (:) ] (gC/m2) live coarse root C transfer
- ! cnveg_carbonstate_inst%livestemc_patch Output: [real(r8) (:) ] (gC/m2) live stem C
- ! cnveg_carbonstate_inst%livestemc_storage_patch Output: [real(r8) (:) ] (gC/m2) live stem C storage
- ! cnveg_carbonstate_inst%livestemc_xfer_patch Output: [real(r8) (:) ] (gC/m2) live stem C transfer
- ! cnveg_carbonstate_inst%ctrunc_patch Output: [real(r8) (:) ] (gC/m2) patch-level sink for C truncation
- ! cnveg_carbonstate_inst%xsmrpool_patch Output: [real(r8) (:) ] (gC/m2) execss maint resp C pool
- ! cnveg_carbonstate_inst%grainc_patch Output: [real(r8) (:) ] (gC/m2) grain C
- ! cnveg_carbonstate_inst%grainc_storage_patch Output: [real(r8) (:) ] (gC/m2) grain C storage
- ! cnveg_carbonstate_inst%grainc_xfer_patch Output: [real(r8) (:) ] (gC/m2) grain C transfer
-
- ! cnveg_nitrogenstate_inst%deadcrootn_patch Output: [real(r8) (:) ] (gN/m2) dead coarse root N
- ! cnveg_nitrogenstate_inst%deadcrootn_storage_patch Output: [real(r8) (:) ] (gN/m2) dead coarse root N storage
- ! cnveg_nitrogenstate_inst%deadcrootn_xfer_patch Output: [real(r8) (:) ] (gN/m2) dead coarse root N transfer
- ! cnveg_nitrogenstate_inst%deadstemn_patch Output: [real(r8) (:) ] (gN/m2) dead stem N
- ! cnveg_nitrogenstate_inst%deadstemn_storage_patch Output: [real(r8) (:) ] (gN/m2) dead stem N storage
- ! cnveg_nitrogenstate_inst%deadstemn_xfer_patch Output: [real(r8) (:) ] (gN/m2) dead stem N transfer
- ! cnveg_nitrogenstate_inst%frootn_patch Output: [real(r8) (:) ] (gN/m2) fine root N
- ! cnveg_nitrogenstate_inst%frootn_storage_patch Output: [real(r8) (:) ] (gN/m2) fine root N storage
- ! cnveg_nitrogenstate_inst%frootn_xfer_patch Output: [real(r8) (:) ] (gN/m2) fine root N transfer
- ! cnveg_nitrogenstate_inst%leafn_patch Output: [real(r8) (:) ] (gN/m2) leaf N
- ! cnveg_nitrogenstate_inst%leafn_storage_patch Output: [real(r8) (:) ] (gN/m2) leaf N storage
- ! cnveg_nitrogenstate_inst%leafn_xfer_patch Output: [real(r8) (:) ] (gN/m2) leaf N transfer
- ! cnveg_nitrogenstate_inst%livecrootn_patch Output: [real(r8) (:) ] (gN/m2) live coarse root N
- ! cnveg_nitrogenstate_inst%livecrootn_storage_patch Output: [real(r8) (:) ] (gN/m2) live coarse root N storage
- ! cnveg_nitrogenstate_inst%livecrootn_xfer_patch Output: [real(r8) (:) ] (gN/m2) live coarse root N transfer
- ! cnveg_nitrogenstate_inst%grainn_patch Output: [real(r8) (:) ] (gC/m2) grain N
- ! cnveg_nitrogenstate_inst%grainn_storage_patch Output: [real(r8) (:) ] (gC/m2) grain N storage
- ! cnveg_nitrogenstate_inst%grainn_xfer_patch Output: [real(r8) (:) ] (gC/m2) grain N transfer
- ! cnveg_nitrogenstate_inst%livestemn_patch Output: [real(r8) (:) ] (gN/m2) live stem N
- ! cnveg_nitrogenstate_inst%livestemn_storage_patch Output: [real(r8) (:) ] (gN/m2) live stem N storage
- ! cnveg_nitrogenstate_inst%livestemn_xfer_patch Output: [real(r8) (:) ] (gN/m2) live stem N transfer
- ! cnveg_nitrogenstate_inst%npool_patch Output: [real(r8) (:) ] (gN/m2) temporary plant N pool
- ! cnveg_nitrogenstate_inst%ntrunc_patch Output: [real(r8) (:) ] (gN/m2) patch-level sink for N truncation
- ! cnveg_nitrogenstate_inst%retransn_patch Output: [real(r8) (:) ] (gN/m2) plant pool of retranslocated N
-
-
- associate( &
- cs => cnveg_carbonstate_inst , &
- ns => cnveg_nitrogenstate_inst , &
- c13cs => c13_cnveg_carbonstate_inst , &
- c14cs => c14_cnveg_carbonstate_inst &
- )
-
- ! patch loop
- do fp = 1,num_soilp
- p = filter_soilp(fp)
-
- ! initialize the patch-level C and N truncation terms
- pc(p) = 0._r8
- pn(p) = 0._r8
- end do
-
- ! do tests on state variables for precision control
- ! for linked C-N state variables, perform precision test on
- ! the C component, but truncate C, C13, and N components
-
- ! leaf C and N
- call TruncateCandNStates( bounds, filter_soilp, num_soilp, cs%leafc_patch(bounds%begp:bounds%endp), &
- ns%leafn_patch(bounds%begp:bounds%endp), &
- pc(bounds%begp:), pn(bounds%begp:), __LINE__, &
- c13=c13cs%leafc_patch, c14=c14cs%leafc_patch, &
- pc13=pc13(bounds%begp:), pc14=pc14(bounds%begp:) )
-
- ! leaf storage C and N
- call TruncateCandNStates( bounds, filter_soilp, num_soilp, cs%leafc_storage_patch(bounds%begp:bounds%endp), &
- ns%leafn_storage_patch(bounds%begp:bounds%endp), pc(bounds%begp:), pn(bounds%begp:), __LINE__, &
- c13=c13cs%leafc_storage_patch, c14=c14cs%leafc_storage_patch, &
- pc13=pc13(bounds%begp:), pc14=pc14(bounds%begp:) )
-
- ! leaf transfer C and N
- call TruncateCandNStates( bounds, filter_soilp, num_soilp, cs%leafc_xfer_patch(bounds%begp:bounds%endp), &
- ns%leafn_xfer_patch(bounds%begp:bounds%endp), pc(bounds%begp:), pn(bounds%begp:), __LINE__, &
- c13=c13cs%leafc_xfer_patch, c14=c14cs%leafc_xfer_patch, &
- pc13=pc13(bounds%begp:), pc14=pc14(bounds%begp:) )
-
- ! froot C and N
- ! EBK KO DML: For some reason frootc/frootn can go negative and allowing
- ! it to be negative is important for C4 crops (otherwise they die) Jun/3/2016
- if ( prec_control_for_froot ) then
- call TruncateCandNStates( bounds, filter_soilp, num_soilp, cs%frootc_patch(bounds%begp:bounds%endp), &
- ns%frootn_patch(bounds%begp:bounds%endp), pc(bounds%begp:), pn(bounds%begp:), __LINE__, &
- c13=c13cs%frootc_patch, c14=c14cs%frootc_patch, &
- pc13=pc13(bounds%begp:), pc14=pc14(bounds%begp:), allowneg=.true. )
- end if
-
- ! froot storage C and N
- call TruncateCandNStates( bounds, filter_soilp, num_soilp, cs%frootc_storage_patch(bounds%begp:bounds%endp), &
- ns%frootn_storage_patch(bounds%begp:bounds%endp), pc(bounds%begp:), pn(bounds%begp:), &
- __LINE__, c13=c13cs%frootc_storage_patch, c14=c14cs%frootc_storage_patch, &
- pc13=pc13(bounds%begp:), pc14=pc14(bounds%begp:) )
-
- ! froot transfer C and N
- call TruncateCandNStates( bounds, filter_soilp, num_soilp, cs%frootc_xfer_patch(bounds%begp:bounds%endp), &
- ns%frootn_xfer_patch(bounds%begp:bounds%endp), pc(bounds%begp:), pn(bounds%begp:), __LINE__, &
- c13=c13cs%frootc_xfer_patch, c14=c14cs%frootc_xfer_patch, &
- pc13=pc13(bounds%begp:), pc14=pc14(bounds%begp:) )
-
- if ( use_crop )then
- ! grain C and N
- call TruncateCandNStates( bounds, filter_soilp, num_soilp, cs%grainc_patch(bounds%begp:bounds%endp), &
- ns%grainn_patch(bounds%begp:bounds%endp), pc(bounds%begp:), pn(bounds%begp:), __LINE__, &
- c13=c13cs%grainc_patch, c14=c14cs%grainc_patch, &
- pc13=pc13(bounds%begp:), pc14=pc14(bounds%begp:), croponly=.true. )
-
- ! grain storage C and N
- call TruncateCandNStates( bounds, filter_soilp, num_soilp, cs%grainc_storage_patch(bounds%begp:bounds%endp), &
- ns%grainn_storage_patch(bounds%begp:bounds%endp), pc(bounds%begp:), pn(bounds%begp:), &
- __LINE__, c13=c13cs%grainc_storage_patch, c14=c14cs%grainc_storage_patch, &
- pc13=pc13(bounds%begp:), pc14=pc14(bounds%begp:), croponly=.true. )
-
- ! grain transfer C and N
- call TruncateCandNStates( bounds, filter_soilp, num_soilp, cs%grainc_xfer_patch(bounds%begp:bounds%endp), &
- ns%grainn_xfer_patch(bounds%begp:bounds%endp), pc(bounds%begp:), pn(bounds%begp:), __LINE__, &
- c13=c13cs%grainc_xfer_patch, c14=c14cs%grainc_xfer_patch, &
- pc13=pc13(bounds%begp:), pc14=pc14(bounds%begp:), croponly=.true. )
-
- ! grain transfer C and N
- call TruncateCandNStates( bounds, filter_soilp, num_soilp, cs%cropseedc_deficit_patch(bounds%begp:bounds%endp), &
- ns%cropseedn_deficit_patch(bounds%begp:bounds%endp), pc(bounds%begp:), &
- pn(bounds%begp:), __LINE__, &
- c13=c13cs%cropseedc_deficit_patch, c14=c14cs%cropseedc_deficit_patch, &
- pc13=pc13(bounds%begp:), pc14=pc14(bounds%begp:), allowneg=.true., croponly=.true. )
-
- end if
-
- ! livestem C and N
- call TruncateCandNStates( bounds, filter_soilp, num_soilp, cs%livestemc_patch(bounds%begp:bounds%endp), &
- ns%livestemn_patch(bounds%begp:bounds%endp), pc(bounds%begp:), pn(bounds%begp:), __LINE__, &
- c13=c13cs%livestemc_patch, c14=c14cs%livestemc_patch, &
- pc13=pc13(bounds%begp:), pc14=pc14(bounds%begp:) )
-
- ! livestem storage C and N
- call TruncateCandNStates( bounds, filter_soilp, num_soilp, cs%livestemc_storage_patch(bounds%begp:bounds%endp), &
- ns%livestemn_storage_patch(bounds%begp:bounds%endp), pc(bounds%begp:), pn(bounds%begp:), &
- __LINE__, c13=c13cs%livestemc_storage_patch, c14=c14cs%livestemc_storage_patch, &
- pc13=pc13(bounds%begp:), pc14=pc14(bounds%begp:) )
-
- ! livestem transfer C and N
- call TruncateCandNStates( bounds, filter_soilp, num_soilp, cs%livestemc_xfer_patch(bounds%begp:bounds%endp), &
- ns%livestemn_xfer_patch(bounds%begp:bounds%endp), pc(bounds%begp:), pn(bounds%begp:), &
- __LINE__, c13=c13cs%livestemc_xfer_patch, c14=c14cs%livestemc_xfer_patch, &
- pc13=pc13(bounds%begp:), pc14=pc14(bounds%begp:) )
-
- ! deadstem C and N
- call TruncateCandNStates( bounds, filter_soilp, num_soilp, cs%deadstemc_patch(bounds%begp:bounds%endp), &
- ns%deadstemn_patch(bounds%begp:bounds%endp), pc(bounds%begp:), pn(bounds%begp:), __LINE__, &
- c13=c13cs%deadstemc_patch, c14=c14cs%deadstemc_patch, &
- pc13=pc13(bounds%begp:), pc14=pc14(bounds%begp:) )
- ! deadstem storage C and N
- call TruncateCandNStates( bounds, filter_soilp, num_soilp, cs%deadstemc_storage_patch(bounds%begp:bounds%endp), &
- ns%deadstemn_storage_patch(bounds%begp:bounds%endp), pc(bounds%begp:), pn(bounds%begp:), &
- __LINE__, c13=c13cs%deadstemc_storage_patch, c14=c14cs%deadstemc_storage_patch, &
- pc13=pc13(bounds%begp:), pc14=pc14(bounds%begp:) )
-
- ! deadstem transfer C and N
- call TruncateCandNStates( bounds, filter_soilp, num_soilp, cs%deadstemc_xfer_patch(bounds%begp:bounds%endp), &
- ns%deadstemn_xfer_patch(bounds%begp:bounds%endp), pc(bounds%begp:), pn(bounds%begp:), &
- __LINE__, c13=c13cs%deadstemc_xfer_patch, c14=c14cs%deadstemc_xfer_patch, &
- pc13=pc13(bounds%begp:), pc14=pc14(bounds%begp:) )
-
- ! livecroot C and N
- call TruncateCandNStates( bounds, filter_soilp, num_soilp, cs%livecrootc_patch(bounds%begp:bounds%endp), &
- ns%livecrootn_patch(bounds%begp:bounds%endp), pc(bounds%begp:), pn(bounds%begp:), __LINE__, &
- c13=c13cs%livecrootc_patch, c14=c14cs%livecrootc_patch, &
- pc13=pc13(bounds%begp:), pc14=pc14(bounds%begp:) )
-
- ! livecroot storage C and N
- call TruncateCandNStates( bounds, filter_soilp, num_soilp, cs%livecrootc_storage_patch(bounds%begp:bounds%endp), &
- ns%livecrootn_storage_patch(bounds%begp:bounds%endp), pc(bounds%begp:), pn(bounds%begp:), &
- __LINE__, c13=c13cs%livecrootc_storage_patch, c14=c14cs%livecrootc_storage_patch, &
- pc13=pc13(bounds%begp:), pc14=pc14(bounds%begp:) )
-
- ! livecroot transfer C and N
- call TruncateCandNStates( bounds, filter_soilp, num_soilp, cs%livecrootc_xfer_patch(bounds%begp:bounds%endp), &
- ns%livecrootn_xfer_patch(bounds%begp:bounds%endp), pc(bounds%begp:), pn(bounds%begp:), &
- __LINE__, c13=c13cs%livecrootc_xfer_patch, c14=c14cs%livecrootc_xfer_patch, &
- pc13=pc13(bounds%begp:), pc14=pc14(bounds%begp:) )
-
- ! deadcroot C and N
- call TruncateCandNStates( bounds, filter_soilp, num_soilp, cs%deadcrootc_patch(bounds%begp:bounds%endp), &
- ns%deadcrootn_patch(bounds%begp:bounds%endp), pc(bounds%begp:), pn(bounds%begp:), __LINE__, &
- c13=c13cs%deadcrootc_patch, c14=c14cs%deadcrootc_patch, &
- pc13=pc13(bounds%begp:), pc14=pc14(bounds%begp:) )
-
- ! deadcroot storage C and N
- call TruncateCandNStates( bounds, filter_soilp, num_soilp, cs%deadcrootc_storage_patch(bounds%begp:bounds%endp), &
- ns%deadcrootn_storage_patch(bounds%begp:bounds%endp), pc(bounds%begp:), pn(bounds%begp:), &
- __LINE__, c13=c13cs%deadcrootc_storage_patch, c14=c14cs%deadcrootc_storage_patch, &
- pc13=pc13(bounds%begp:), pc14=pc14(bounds%begp:) )
-
- ! deadcroot transfer C and N
- call TruncateCandNStates( bounds, filter_soilp, num_soilp, cs%deadcrootc_xfer_patch(bounds%begp:bounds%endp), &
- ns%deadcrootn_xfer_patch(bounds%begp:bounds%endp), pc(bounds%begp:), pn(bounds%begp:), &
- __LINE__, c13=c13cs%deadcrootc_xfer_patch, c14=c14cs%deadcrootc_xfer_patch, &
- pc13=pc13(bounds%begp:), pc14=pc14(bounds%begp:) )
-
- ! gresp_storage (C only)
- call TruncateCStates( bounds, filter_soilp, num_soilp, cs%gresp_storage_patch(bounds%begp:bounds%endp), &
- pc(bounds%begp:), __LINE__, &
- c13=c13cs%gresp_storage_patch, c14=c14cs%gresp_storage_patch, &
- pc13=pc13(bounds%begp:), pc14=pc14(bounds%begp:) )
-
- ! gresp_xfer(c only)
- call TruncateCStates( bounds, filter_soilp, num_soilp, cs%gresp_xfer_patch(bounds%begp:bounds%endp), &
- pc(bounds%begp:), __LINE__, &
- c13=c13cs%gresp_xfer_patch, c14=c14cs%gresp_xfer_patch, &
- pc13=pc13(bounds%begp:), pc14=pc14(bounds%begp:) )
-
- ! cpool (C only)
- call TruncateCStates( bounds, filter_soilp, num_soilp, cs%cpool_patch(bounds%begp:bounds%endp), &
- pc(bounds%begp:), __LINE__, &
- c13=c13cs%cpool_patch, c14=c14cs%cpool_patch, &
- pc13=pc13(bounds%begp:), pc14=pc14(bounds%begp:) )
-
- if ( use_crop )then
- ! xsmrpool (C only)
- ! xsmr is a pool to balance the budget and as such can be freely negative
- call TruncateCStates( bounds, filter_soilp, num_soilp, cs%xsmrpool_patch(bounds%begp:bounds%endp), &
- pc(bounds%begp:), __LINE__, &
- c13=c13cs%xsmrpool_patch, c14=c14cs%xsmrpool_patch, &
- pc13=pc13(bounds%begp:), pc14=pc14(bounds%begp:), allowneg=.true., croponly=.true. )
-
- end if
-
- ! retransn (N only)
- call TruncateNStates( bounds, filter_soilp, num_soilp, ns%retransn_patch(bounds%begp:bounds%endp), pn(bounds%begp:), &
- __LINE__ )
-
- ! npool (N only)
- call TruncateNStates( bounds, filter_soilp, num_soilp, ns%npool_patch(bounds%begp:bounds%endp), pn(bounds%begp:), &
- __LINE__ )
-
- ! patch loop
- do fp = 1,num_soilp
- p = filter_soilp(fp)
-
- cs%ctrunc_patch(p) = cs%ctrunc_patch(p) + pc(p)
-
- ns%ntrunc_patch(p) = ns%ntrunc_patch(p) + pn(p)
-
- end do
-
- end associate
-
- end subroutine CNPrecisionControl
-
- subroutine TruncateCandNStates( bounds, filter_soilp, num_soilp, carbon_patch, nitrogen_patch, pc, pn, lineno, c13, c14, &
- pc13, pc14, croponly, allowneg )
- !
- ! !DESCRIPTION:
- ! Truncate paired Carbon and Nitrogen states. If a paired carbon and nitrogen state iare too small truncate
- ! the pair of them to zero.
- !
- ! !USES:
- use shr_log_mod, only : errMsg => shr_log_errMsg
- use clm_varctl , only : use_nguardrail
- use clm_varctl , only : iulog
- use pftconMod , only : nc3crop
- use decompMod , only : bounds_type
- !
- ! !ARGUMENTS:
- implicit none
- type(bounds_type) , intent(in) :: bounds ! bounds
- integer , intent(in) :: num_soilp ! number of soil patchs in filter
- integer , intent(in) :: filter_soilp(:) ! filter for soil patches
- real(r8), intent(inout) :: carbon_patch(bounds%begp:)
- real(r8), intent(inout) :: nitrogen_patch(bounds%begp:)
- real(r8), intent(inout) :: pc(bounds%begp:)
- real(r8), intent(inout) :: pn(bounds%begp:)
- integer, intent(in) :: lineno
- real(r8), intent(inout), optional, pointer :: c13(:)
- real(r8), intent(inout), optional, pointer :: c14(:)
- real(r8), intent(inout), optional :: pc13(bounds%begp:)
- real(r8), intent(inout), optional :: pc14(bounds%begp:)
- logical , intent(in) , optional :: croponly
- logical , intent(in) , optional :: allowneg
-
- logical :: lcroponly, lallowneg
- integer :: fp, p
-
- SHR_ASSERT_ALL((ubound(carbon_patch) == (/bounds%endp/)), 'ubnd(carb)'//errMsg(sourcefile, lineno))
- SHR_ASSERT_ALL((ubound(nitrogen_patch) == (/bounds%endp/)), 'ubnd(nitro)'//errMsg(sourcefile, lineno))
- SHR_ASSERT_ALL((ubound(pc) == (/bounds%endp/)), 'ubnd(pc)'//errMsg(sourcefile, lineno))
- SHR_ASSERT_ALL((ubound(pn) == (/bounds%endp/)), 'ubnd(pn)'//errMsg(sourcefile, lineno))
- ! patch loop
- lcroponly = .false.
- if ( present(croponly) )then
- if ( croponly ) lcroponly = .true.
- end if
- lallowneg = .false.
- if ( present(allowneg) )then
- if ( allowneg ) lallowneg = .true.
- end if
- do fp = 1,num_soilp
- p = filter_soilp(fp)
-
- if ( .not. lcroponly .or. (patch%itype(p) >= nc3crop) ) then
- if ( .not. lallowneg .and. ((carbon_patch(p) < cnegcrit) .or. (nitrogen_patch(p) < nnegcrit)) ) then
- write(iulog,*) 'ERROR: Carbon or Nitrogen patch negative = ', carbon_patch(p), nitrogen_patch(p)
- write(iulog,*) 'ERROR: limits = ', cnegcrit, nnegcrit
- call endrun(msg='ERROR: carbon or nitrogen state critically negative '//errMsg(sourcefile, lineno))
- else if ( abs(carbon_patch(p)) < ccrit .or. (use_nguardrail .and. abs(nitrogen_patch(p)) < ncrit) ) then
- pc(p) = pc(p) + carbon_patch(p)
- carbon_patch(p) = 0._r8
-
- pn(p) = pn(p) + nitrogen_patch(p)
- nitrogen_patch(p) = 0._r8
-
- end if
- end if
- end do
- end subroutine TruncateCandNStates
-
- subroutine TruncateCStates( bounds, filter_soilp, num_soilp, carbon_patch, pc, lineno, c13, c14, pc13, pc14, croponly, allowneg )
- !
- ! !DESCRIPTION:
- ! Truncate Carbon states. If a carbon state is too small truncate it to
- ! zero.
- !
- ! !USES:
- use abortutils , only : endrun
- use clm_varctl , only : iulog
- use shr_log_mod, only : errMsg => shr_log_errMsg
- use pftconMod , only : nc3crop
- use decompMod , only : bounds_type
- !
- ! !ARGUMENTS:
- implicit none
- type(bounds_type), intent(in) :: bounds ! bounds
- integer , intent(in) :: num_soilp ! number of soil patchs in filter
- integer , intent(in) :: filter_soilp(:) ! filter for soil patches
- real(r8) , intent(inout) :: carbon_patch(bounds%begp:)
- real(r8) , intent(inout) :: pc(bounds%begp:)
- integer , intent(in) :: lineno
- real(r8) , intent(inout), optional, pointer :: c13(:)
- real(r8) , intent(inout), optional, pointer :: c14(:)
- real(r8) , intent(inout), optional :: pc13(bounds%begp:)
- real(r8) , intent(inout), optional :: pc14(bounds%begp:)
- logical , intent(in) , optional :: croponly
- logical , intent(in) , optional :: allowneg
-
- logical :: lcroponly, lallowneg
- integer :: fp, p
-
- SHR_ASSERT_ALL((ubound(carbon_patch) == (/bounds%endp/)), errMsg(sourcefile, __LINE__))
- SHR_ASSERT_ALL((ubound(pc) == (/bounds%endp/)), errMsg(sourcefile, __LINE__))
- if ( -ccrit < cnegcrit )then
- call endrun(msg='ERROR: cnegcrit should be less than -ccrit: '//errMsg(sourcefile, lineno))
- end if
- lcroponly = .false.
- if ( present(croponly) )then
- if ( croponly ) lcroponly = .true.
- end if
- lallowneg = .false.
- if ( present(allowneg) )then
- if ( allowneg ) lallowneg = .true.
- end if
- do fp = 1,num_soilp
- p = filter_soilp(fp)
-
- if ( .not. lcroponly .or. (patch%itype(p) >= nc3crop) ) then
- if ( .not. lallowneg .and. (carbon_patch(p) < cnegcrit) ) then
- write(iulog,*) 'ERROR: Carbon patch negative = ', carbon_patch(p)
- write(iulog,*) 'ERROR: limit = ', cnegcrit
- call endrun(msg='ERROR: carbon state critically negative '//errMsg(sourcefile, lineno))
- else if ( abs(carbon_patch(p)) < ccrit) then
- pc(p) = pc(p) + carbon_patch(p)
- carbon_patch(p) = 0._r8
-
- end if
- end if
- end do
- end subroutine TruncateCStates
-
- subroutine TruncateNStates( bounds, filter_soilp, num_soilp, nitrogen_patch, pn, lineno )
- !
- ! !DESCRIPTION:
- ! Truncate Nitrogen states. If a nitrogen state is too small truncate it to
- ! zero.
- !
- ! !USES:
- use abortutils , only : endrun
- use shr_log_mod, only : errMsg => shr_log_errMsg
- use clm_varctl , only : iulog
- use decompMod , only : bounds_type
- !
- ! !ARGUMENTS:
- implicit none
- type(bounds_type) , intent(in) :: bounds ! bounds
- integer , intent(in) :: num_soilp ! number of soil patchs in filter
- integer , intent(in) :: filter_soilp(:) ! filter for soil patches
- real(r8), intent(inout) :: nitrogen_patch(bounds%begp:)
- real(r8), intent(inout) :: pn(bounds%begp:)
- integer, intent(in) :: lineno
-
- integer :: fp, p
-
- SHR_ASSERT_ALL((ubound(nitrogen_patch) == (/bounds%endp/)), errMsg(sourcefile, __LINE__))
- SHR_ASSERT_ALL((ubound(pn) == (/bounds%endp/)), errMsg(sourcefile, __LINE__))
- do fp = 1,num_soilp
- p = filter_soilp(fp)
- if ( nitrogen_patch(p) < nnegcrit ) then
- !write(iulog,*) 'WARNING: Nitrogen patch negative = ', nitrogen_patch
- !call endrun(msg='ERROR: nitrogen state critically negative'//errMsg(sourcefile, lineno))
- else if ( abs(nitrogen_patch(p)) < ncrit) then
- pn(p) = pn(p) + nitrogen_patch(p)
- nitrogen_patch(p) = 0._r8
-
- end if
- end do
- end subroutine TruncateNStates
-
-end module CNPrecisionControlMod
diff --git a/src/biogeochem/CNProductsMod.F90 b/src/biogeochem/CNProductsMod.F90
deleted file mode 100644
index d71d7b15..00000000
--- a/src/biogeochem/CNProductsMod.F90
+++ /dev/null
@@ -1,741 +0,0 @@
-module CNProductsMod
- !-----------------------------------------------------------------------
- ! !DESCRIPTION:
- ! Calculate loss fluxes from wood products pools, and update product pool state variables
- !
- ! !USES:
-#include "shr_assert.h"
- use shr_kind_mod , only : r8 => shr_kind_r8
- use shr_infnan_mod , only : nan => shr_infnan_nan, assignment(=)
- use shr_log_mod , only : errMsg => shr_log_errMsg
- use decompMod , only : bounds_type
- use abortutils , only : endrun
- use clm_time_manager , only : get_step_size
- use SpeciesBaseType , only : species_base_type
- use PatchType , only : patch
- !
- implicit none
- private
- !
- ! !PUBLIC TYPES:
- type, public :: cn_products_type
- private
- ! ------------------------------------------------------------------------
- ! Public instance variables
- ! ------------------------------------------------------------------------
-
- real(r8), pointer, public :: product_loss_grc(:) ! (g[C or N]/m2/s) total decomposition loss from ALL product pools
-
- ! ------------------------------------------------------------------------
- ! Private instance variables
- ! ------------------------------------------------------------------------
-
- class(species_base_type), allocatable :: species ! C, N, C13, C14, etc.
-
- ! States
- real(r8), pointer :: cropprod1_grc(:) ! (g[C or N]/m2) grain product pool, 1-year lifespan
- real(r8), pointer :: prod10_grc(:) ! (g[C or N]/m2) wood product pool, 10-year lifespan
- real(r8), pointer :: prod100_grc(:) ! (g[C or N]/m2) wood product pool, 100-year lifespan
- real(r8), pointer :: tot_woodprod_grc(:) ! (g[C or N]/m2) total wood product pool
-
- ! Fluxes: gains
- real(r8), pointer :: dwt_prod10_gain_grc(:) ! (g[C or N]/m2/s) dynamic landcover addition to 10-year wood product pool
- real(r8), pointer :: dwt_prod100_gain_grc(:) ! (g[C or N]/m2/s) dynamic landcover addition to 100-year wood product pool
- real(r8), pointer :: dwt_woodprod_gain_grc(:) ! (g[C or N]/m2/s) dynamic landcover addition to wood product pools
- real(r8), pointer :: dwt_cropprod1_gain_grc(:) ! (g[C or N]/m2/s) dynamic landcover addition to 1-year crop product pool
- real(r8), pointer :: hrv_deadstem_to_prod10_patch(:) ! (g[C or N]/m2/s) dead stem harvest to 10-year wood product pool
- real(r8), pointer :: hrv_deadstem_to_prod10_grc(:) ! (g[C or N]/m2/s) dead stem harvest to 10-year wood product pool
- real(r8), pointer :: hrv_deadstem_to_prod100_patch(:) ! (g[C or N]/m2/s) dead stem harvest to 100-year wood product pool
- real(r8), pointer :: hrv_deadstem_to_prod100_grc(:) ! (g[C or N]/m2/s) dead stem harvest to 100-year wood product pool
- real(r8), pointer :: grain_to_cropprod1_patch(:) ! (g[C or N]/m2/s) grain to 1-year crop product pool
- real(r8), pointer :: grain_to_cropprod1_grc(:) ! (g[C or N]/m2/s) grain to 1-year crop product pool
-
- ! Fluxes: losses
- real(r8), pointer :: cropprod1_loss_grc(:) ! (g[C or N]/m2/s) decomposition loss from 1-yr grain product pool
- real(r8), pointer :: prod10_loss_grc(:) ! (g[C or N]/m2/s) decomposition loss from 10-yr wood product pool
- real(r8), pointer :: prod100_loss_grc(:) ! (g[C or N]/m2/s) decomposition loss from 100-yr wood product pool
- real(r8), pointer :: tot_woodprod_loss_grc(:) ! (g[C or N]/m2/s) decompomposition loss from all wood product pools
-
- contains
-
- ! Infrastructure routines
- procedure, public :: Init
- procedure, private :: InitAllocate
- procedure, private :: InitHistory
- procedure, private :: InitCold
- procedure, public :: Restart
-
- ! Science routines
- procedure, public :: UpdateProducts
- procedure, private :: PartitionWoodFluxes
- procedure, private :: PartitionGrainFluxes
- procedure, private :: ComputeSummaryVars
-
- end type cn_products_type
-
- character(len=*), parameter, private :: sourcefile = &
- __FILE__
-
- !-----------------------------------------------------------------------
-
-contains
-
- !-----------------------------------------------------------------------
- subroutine Init(this, bounds, species)
- ! !ARGUMENTS:
- class(cn_products_type), intent(inout) :: this
- type(bounds_type), intent(in) :: bounds
-
- ! species tells whether this object is being used for C, N, C13, C14, etc. This is
- ! just used for naming history and restart fields
- class(species_base_type), intent(in) :: species
-
- !
- ! !LOCAL VARIABLES:
-
- character(len=*), parameter :: subname = 'Init'
- !-----------------------------------------------------------------------
-
- allocate(this%species, source = species)
-
- call this%InitAllocate(bounds)
- call this%InitHistory(bounds)
- call this%InitCold(bounds)
-
- end subroutine Init
-
- !-----------------------------------------------------------------------
- subroutine InitAllocate(this, bounds)
- ! !ARGUMENTS:
- class(cn_products_type), intent(inout) :: this
- type(bounds_type), intent(in) :: bounds
- !
- ! !LOCAL VARIABLES:
- integer :: begp,endp
- integer :: begg,endg
-
- character(len=*), parameter :: subname = 'InitAllocate'
- !-----------------------------------------------------------------------
-
- begp = bounds%begp
- endp = bounds%endp
- begg = bounds%begg
- endg = bounds%endg
-
- allocate(this%cropprod1_grc(begg:endg)) ; this%cropprod1_grc(:) = nan
- allocate(this%prod10_grc(begg:endg)) ; this%prod10_grc(:) = nan
- allocate(this%prod100_grc(begg:endg)) ; this%prod100_grc(:) = nan
- allocate(this%tot_woodprod_grc(begg:endg)) ; this%tot_woodprod_grc(:) = nan
-
- allocate(this%dwt_prod10_gain_grc(begg:endg)) ; this%dwt_prod10_gain_grc(:) = nan
- allocate(this%dwt_prod100_gain_grc(begg:endg)) ; this%dwt_prod100_gain_grc(:) = nan
- allocate(this%dwt_woodprod_gain_grc(begg:endg)) ; this%dwt_woodprod_gain_grc(:) = nan
-
- allocate(this%dwt_cropprod1_gain_grc(begg:endg)) ; this%dwt_cropprod1_gain_grc(:) = nan
-
- allocate(this%hrv_deadstem_to_prod10_patch(begp:endp)) ; this%hrv_deadstem_to_prod10_patch(:) = nan
- allocate(this%hrv_deadstem_to_prod10_grc(begg:endg)) ; this%hrv_deadstem_to_prod10_grc(:) = nan
-
- allocate(this%hrv_deadstem_to_prod100_patch(begp:endp)) ; this%hrv_deadstem_to_prod100_patch(:) = nan
- allocate(this%hrv_deadstem_to_prod100_grc(begg:endg)) ; this%hrv_deadstem_to_prod100_grc(:) = nan
-
- allocate(this%grain_to_cropprod1_patch(begp:endp)) ; this%grain_to_cropprod1_patch(:) = nan
- allocate(this%grain_to_cropprod1_grc(begg:endg)) ; this%grain_to_cropprod1_grc(:) = nan
-
- allocate(this%cropprod1_loss_grc(begg:endg)) ; this%cropprod1_loss_grc(:) = nan
- allocate(this%prod10_loss_grc(begg:endg)) ; this%prod10_loss_grc(:) = nan
- allocate(this%prod100_loss_grc(begg:endg)) ; this%prod100_loss_grc(:) = nan
- allocate(this%tot_woodprod_loss_grc(begg:endg)) ; this%tot_woodprod_loss_grc(:) = nan
- allocate(this%product_loss_grc(begg:endg)) ; this%product_loss_grc(:) = nan
-
- end subroutine InitAllocate
-
- !-----------------------------------------------------------------------
- subroutine InitHistory(this, bounds)
- ! !USES:
- use histFileMod, only : hist_addfld1d
- use clm_varcon , only : spval
- !
- ! !ARGUMENTS:
- class(cn_products_type), intent(inout) :: this
- type(bounds_type), intent(in) :: bounds
- !
- ! !LOCAL VARIABLES:
- integer :: begg,endg
-
- character(len=*), parameter :: subname = 'InitHistory'
- !-----------------------------------------------------------------------
-
- begg = bounds%begg
- endg = bounds%endg
-
- this%cropprod1_grc(begg:endg) = spval
- call hist_addfld1d( &
- fname = this%species%hist_fname('CROPPROD1'), &
- units = 'g' // this%species%get_species() // '/m^2', &
- avgflag = 'A', &
- long_name = '1-yr grain product ' // this%species%get_species(), &
- ptr_gcell = this%cropprod1_grc, default='inactive')
-
- this%prod10_grc(begg:endg) = spval
- call hist_addfld1d( &
- fname = this%species%hist_fname('PROD10'), &
- units = 'g' // this%species%get_species() // '/m^2', &
- avgflag = 'A', &
- long_name = '10-yr wood product ' // this%species%get_species(), &
- ptr_gcell = this%prod10_grc, default='inactive')
-
- this%prod100_grc(begg:endg) = spval
- call hist_addfld1d( &
- fname = this%species%hist_fname('PROD100'), &
- units = 'g' // this%species%get_species() // '/m^2', &
- avgflag = 'A', &
- long_name = '100-yr wood product ' // this%species%get_species(), &
- ptr_gcell = this%prod100_grc, default='inactive')
-
- this%tot_woodprod_grc(begg:endg) = spval
- call hist_addfld1d( &
- fname = this%species%hist_fname('TOT_WOODPROD'), &
- units = 'g' // this%species%get_species() // '/m^2', &
- avgflag = 'A', &
- long_name = 'total wood product ' // this%species%get_species(), &
- ptr_gcell = this%tot_woodprod_grc, default='inactive')
-
- this%dwt_prod10_gain_grc(begg:endg) = spval
- call hist_addfld1d( &
- fname = this%species%hist_fname('DWT_PROD10', suffix='_GAIN'), &
- units = 'g' // this%species%get_species() // '/m^2/s', &
- avgflag = 'A', &
- long_name = 'landcover change-driven addition to 10-yr wood product pool', &
- ptr_gcell = this%dwt_prod10_gain_grc, default='inactive')
-
- this%dwt_prod100_gain_grc(begg:endg) = spval
- call hist_addfld1d( &
- fname = this%species%hist_fname('DWT_PROD100', suffix='_GAIN'), &
- units = 'g' // this%species%get_species() // '/m^2/s', &
- avgflag = 'A', &
- long_name = 'landcover change-driven addition to 100-yr wood product pool', &
- ptr_gcell = this%dwt_prod100_gain_grc, default='inactive')
-
- this%dwt_woodprod_gain_grc(begg:endg) = spval
- call hist_addfld1d( &
- fname = this%species%hist_fname('DWT_WOODPROD', suffix='_GAIN'), &
- units = 'g' // this%species%get_species() // '/m^2/s', &
- avgflag = 'A', &
- long_name = 'landcover change-driven addition to wood product pools', &
- ptr_gcell = this%dwt_woodprod_gain_grc, default='inactive')
-
- this%dwt_cropprod1_gain_grc(begg:endg) = spval
- call hist_addfld1d( &
- fname = this%species%hist_fname('DWT_CROPPROD1', suffix='_GAIN'), &
- units = 'g' // this%species%get_species() // '/m^2/s', &
- avgflag = 'A', &
- long_name = 'landcover change-driven addition to 1-year crop product pool', &
- ptr_gcell = this%dwt_cropprod1_gain_grc, default='inactive')
-
- this%cropprod1_loss_grc(begg:endg) = spval
- call hist_addfld1d( &
- fname = this%species%hist_fname('CROPPROD1', suffix='_LOSS'), &
- units = 'g' // this%species%get_species() // '/m^2/s', &
- avgflag = 'A', &
- long_name = 'loss from 1-yr grain product pool', &
- ptr_gcell = this%cropprod1_loss_grc, default='inactive')
-
- this%prod10_loss_grc(begg:endg) = spval
- call hist_addfld1d( &
- fname = this%species%hist_fname('PROD10', suffix='_LOSS'), &
- units = 'g' // this%species%get_species() // '/m^2/s', &
- avgflag = 'A', &
- long_name = 'loss from 10-yr wood product pool', &
- ptr_gcell = this%prod10_loss_grc, default='inactive')
-
- this%prod100_loss_grc(begg:endg) = spval
- call hist_addfld1d( &
- fname = this%species%hist_fname('PROD100', suffix='_LOSS'), &
- units = 'g' // this%species%get_species() // '/m^2/s', &
- avgflag = 'A', &
- long_name = 'loss from 100-yr wood product pool', &
- ptr_gcell = this%prod100_loss_grc, default='inactive')
-
- this%tot_woodprod_loss_grc(begg:endg) = spval
- call hist_addfld1d( &
- fname = this%species%hist_fname('TOT_WOODPROD', suffix='_LOSS'), &
- units = 'g' // this%species%get_species() // '/m^2/s', &
- avgflag = 'A', &
- long_name = 'total loss from wood product pools', &
- ptr_gcell = this%tot_woodprod_loss_grc, default='inactive')
-
- end subroutine InitHistory
-
- !-----------------------------------------------------------------------
- subroutine InitCold(this, bounds)
- ! !ARGUMENTS:
- class(cn_products_type), intent(inout) :: this
- type(bounds_type), intent(in) :: bounds
- !
- ! !LOCAL VARIABLES:
- integer :: g, p
-
- character(len=*), parameter :: subname = 'InitCold'
- !-----------------------------------------------------------------------
-
- do g = bounds%begg, bounds%endg
- this%cropprod1_grc(g) = 0._r8
- this%prod10_grc(g) = 0._r8
- this%prod100_grc(g) = 0._r8
- this%tot_woodprod_grc(g) = 0._r8
- end do
-
- ! Need to set these patch-level fluxes to 0 everywhere for the sake of special
- ! landunits (because they don't get set over special landunits in the run loop)
- do p = bounds%begp, bounds%endp
- this%hrv_deadstem_to_prod10_patch(p) = 0._r8
- this%hrv_deadstem_to_prod100_patch(p) = 0._r8
- this%grain_to_cropprod1_patch(p) = 0._r8
- end do
-
- end subroutine InitCold
-
- !-----------------------------------------------------------------------
- subroutine Restart(this, bounds, ncid, flag, &
- template_for_missing_fields, template_multiplier)
- ! !USES:
- use ncdio_pio , only : file_desc_t, ncd_double
- use restUtilMod, only : restartvar, set_missing_from_template, set_grc_field_from_col_field
- !
- ! !ARGUMENTS:
- class(cn_products_type), intent(inout) :: this
- type(bounds_type), intent(in) :: bounds
- type(file_desc_t), intent(inout) :: ncid
- character(len=*), intent(in) :: flag ! 'read' or 'write'
-
- ! If template_for_missing_fields and template_multiplier are provided, then: When
- ! reading the restart file, for any field not present on the restart file, the field
- ! in this object is set equal to the corresponding field in
- ! template_for_missing_fields times template_multiplier.
- !
- ! The Restart routine must have been called on template_for_missing_fields before
- ! calling it on this object.
- !
- ! (Must provide both template_for_missing_fields and template_multiplier or neither)
- class(cn_products_type), optional, intent(in) :: template_for_missing_fields
- real(r8), optional, intent(in) :: template_multiplier
-
- !
- ! !LOCAL VARIABLES:
- logical :: template_provided
- logical :: readvar
-
- character(len=*), parameter :: subname = 'Restart'
- !-----------------------------------------------------------------------
-
- if (present(template_for_missing_fields) .and. present(template_multiplier)) then
- template_provided = .true.
- else if (present(template_for_missing_fields)) then
- call endrun(&
- msg='template_for_missing_fields provided; must also provide template_multiplier' // &
- errMsg(sourcefile, __LINE__))
- else if (present(template_multiplier)) then
- call endrun(&
- msg='template_multiplier provided; must also provide template_for_missing_fields' // &
- errMsg(sourcefile, __LINE__))
- else
- template_provided = .false.
- end if
-
- ! NOTE(wjs, 2016-03-29) Adding '_g' suffixes to the end of the restart field names to
- ! distinguish these gridcell-level restart fields from the obsolete column-level
- ! restart fields that are present on old restart files.
-
- call restartvar(ncid=ncid, flag=flag, &
- varname=this%species%rest_fname('cropprod1', suffix='_g'), &
- xtype=ncd_double, dim1name='gridcell', &
- long_name='', units='', &
- interpinic_flag='interp', readvar=readvar, data=this%cropprod1_grc)
- if (flag == 'read' .and. .not. readvar) then
- ! BACKWARDS_COMPATIBILITY(wjs, 2016-03-31) If the gridcell-level field isn't
- ! present, try to find a column-level field (which may be present on an older
- ! restart file).
- call set_grc_field_from_col_field( &
- bounds = bounds, &
- ncid = ncid, &
- varname = this%species%rest_fname('cropprod1'), &
- data_grc = this%cropprod1_grc, &
- readvar = readvar)
-
- ! If we still haven't found an appropriate field on the restart file, then set
- ! this field from the template, if provided
- if (.not. readvar .and. template_provided) then
- call set_missing_from_template(this%cropprod1_grc, &
- template_for_missing_fields%cropprod1_grc, &
- multiplier = template_multiplier)
- end if
- end if
-
- call restartvar(ncid=ncid, flag=flag, &
- varname=this%species%rest_fname('prod10', suffix='_g'), &
- xtype=ncd_double, dim1name='gridcell', &
- long_name='', units='', &
- interpinic_flag='interp', readvar=readvar, data=this%prod10_grc)
- if (flag == 'read' .and. .not. readvar) then
- ! BACKWARDS_COMPATIBILITY(wjs, 2016-03-31) If the gridcell-level field isn't
- ! present, try to find a column-level field (which may be present on an older
- ! restart file).
- call set_grc_field_from_col_field( &
- bounds = bounds, &
- ncid = ncid, &
- varname = this%species%rest_fname('prod10'), &
- data_grc = this%prod10_grc, &
- readvar = readvar)
-
- ! If we still haven't found an appropriate field on the restart file, then set
- ! this field from the template, if provided
- if (.not. readvar .and. template_provided) then
- call set_missing_from_template(this%prod10_grc, &
- template_for_missing_fields%prod10_grc, &
- multiplier = template_multiplier)
- end if
- end if
-
- call restartvar(ncid=ncid, flag=flag, &
- varname=this%species%rest_fname('prod100', suffix='_g'), &
- xtype=ncd_double, dim1name='gridcell', &
- long_name='', units='', &
- interpinic_flag='interp', readvar=readvar, data=this%prod100_grc)
- if (flag == 'read' .and. .not. readvar) then
- ! BACKWARDS_COMPATIBILITY(wjs, 2016-03-31) If the gridcell-level field isn't
- ! present, try to find a column-level field (which may be present on an older
- ! restart file).
- call set_grc_field_from_col_field( &
- bounds = bounds, &
- ncid = ncid, &
- varname = this%species%rest_fname('prod100'), &
- data_grc = this%prod100_grc, &
- readvar = readvar)
-
- ! If we still haven't found an appropriate field on the restart file, then set
- ! this field from the template, if provided
- if (.not. readvar .and. template_provided) then
- call set_missing_from_template(this%prod100_grc, &
- template_for_missing_fields%prod100_grc, &
- multiplier = template_multiplier)
- end if
- end if
-
- end subroutine Restart
-
- !-----------------------------------------------------------------------
- subroutine UpdateProducts(this, bounds, &
- num_soilp, filter_soilp, &
- dwt_wood_product_gain_patch, &
- wood_harvest_patch, &
- dwt_crop_product_gain_patch, &
- grain_to_cropprod_patch)
- !
- ! !DESCRIPTION:
- ! Update all loss fluxes from wood and grain product pools, and update product pool
- ! state variables for both loss and gain terms
- !
- ! !ARGUMENTS:
- class(cn_products_type) , intent(inout) :: this
- type(bounds_type) , intent(in) :: bounds
- integer , intent(in) :: num_soilp ! number of soil patches in filter
- integer , intent(in) :: filter_soilp(:) ! filter for soil patches
-
- ! dynamic landcover addition to wood product pools (g/m2/s) [patch]; although this is
- ! a patch-level flux, it is expressed per unit GRIDCELL area
- real(r8), intent(in) :: dwt_wood_product_gain_patch( bounds%begp: )
-
- ! wood harvest addition to wood product pools (g/m2/s) [patch]
- real(r8), intent(in) :: wood_harvest_patch( bounds%begp: )
-
- ! dynamic landcover addition to crop product pools (g/m2/s) [patch]; although this is
- ! a patch-level flux, it is expressed per unit GRIDCELL area
- real(r8), intent(in) :: dwt_crop_product_gain_patch( bounds%begp: )
-
- ! grain to crop product pool (g/m2/s) [patch]
- real(r8), intent(in) :: grain_to_cropprod_patch( bounds%begp: )
- !
- ! !LOCAL VARIABLES:
- integer :: g ! indices
- real(r8) :: dt ! time step (seconds)
- real(r8) :: kprod1 ! decay constant for 1-year product pool
- real(r8) :: kprod10 ! decay constant for 10-year product pool
- real(r8) :: kprod100 ! decay constant for 100-year product pool
- !-----------------------------------------------------------------------
-
- SHR_ASSERT_ALL((ubound(dwt_wood_product_gain_patch) == (/bounds%endp/)), errMsg(sourcefile, __LINE__))
- SHR_ASSERT_ALL((ubound(wood_harvest_patch) == (/bounds%endp/)), errMsg(sourcefile, __LINE__))
- SHR_ASSERT_ALL((ubound(dwt_crop_product_gain_patch) == (/bounds%endp/)), errMsg(sourcefile, __LINE__))
- SHR_ASSERT_ALL((ubound(grain_to_cropprod_patch) == (/bounds%endp/)), errMsg(sourcefile, __LINE__))
-
- call this%PartitionWoodFluxes(bounds, &
- num_soilp, filter_soilp, &
- dwt_wood_product_gain_patch(bounds%begp:bounds%endp), &
- wood_harvest_patch(bounds%begp:bounds%endp))
-
- call this%PartitionGrainFluxes(bounds, &
- num_soilp, filter_soilp, &
- dwt_crop_product_gain_patch(bounds%begp:bounds%endp), &
- grain_to_cropprod_patch(bounds%begp:bounds%endp))
-
- ! calculate losses from product pools
- ! the following (1/s) rate constants result in ~90% loss of initial state over 1, 10 and 100 years,
- ! respectively, using a discrete-time fractional decay algorithm.
- kprod1 = 7.2e-8
- kprod10 = 7.2e-9
- kprod100 = 7.2e-10
-
- do g = bounds%begg, bounds%endg
- ! calculate fluxes out of product pools (1/sec)
- this%cropprod1_loss_grc(g) = this%cropprod1_grc(g) * kprod1
- this%prod10_loss_grc(g) = this%prod10_grc(g) * kprod10
- this%prod100_loss_grc(g) = this%prod100_grc(g) * kprod100
- end do
-
- ! set time steps
- dt = real( get_step_size(), r8 )
-
- ! update product state variables
- do g = bounds%begg, bounds%endg
-
- ! fluxes into wood & grain product pools, from landcover change
- this%cropprod1_grc(g) = this%cropprod1_grc(g) + this%dwt_cropprod1_gain_grc(g)*dt
- this%prod10_grc(g) = this%prod10_grc(g) + this%dwt_prod10_gain_grc(g)*dt
- this%prod100_grc(g) = this%prod100_grc(g) + this%dwt_prod100_gain_grc(g)*dt
-
- ! fluxes into wood & grain product pools, from harvest
- this%cropprod1_grc(g) = this%cropprod1_grc(g) + this%grain_to_cropprod1_grc(g)*dt
- this%prod10_grc(g) = this%prod10_grc(g) + this%hrv_deadstem_to_prod10_grc(g)*dt
- this%prod100_grc(g) = this%prod100_grc(g) + this%hrv_deadstem_to_prod100_grc(g)*dt
-
- ! fluxes out of wood & grain product pools, from decomposition
- this%cropprod1_grc(g) = this%cropprod1_grc(g) - this%cropprod1_loss_grc(g)*dt
- this%prod10_grc(g) = this%prod10_grc(g) - this%prod10_loss_grc(g)*dt
- this%prod100_grc(g) = this%prod100_grc(g) - this%prod100_loss_grc(g)*dt
-
- end do
-
- call this%ComputeSummaryVars(bounds)
-
- end subroutine UpdateProducts
-
- !-----------------------------------------------------------------------
- subroutine PartitionWoodFluxes(this, bounds, &
- num_soilp, filter_soilp, &
- dwt_wood_product_gain_patch, &
- wood_harvest_patch)
- !
- ! !DESCRIPTION:
- ! Partition input wood fluxes into 10 and 100 year product pools
- !
- ! !USES:
- use pftconMod , only : pftcon
- use subgridAveMod, only : p2g
- !
- ! !ARGUMENTS:
- class(cn_products_type) , intent(inout) :: this
- type(bounds_type) , intent(in) :: bounds
- integer , intent(in) :: num_soilp ! number of soil patches in filter
- integer , intent(in) :: filter_soilp(:) ! filter for soil patches
-
- ! dynamic landcover addition to wood product pools (g/m2/s) [patch]; although this is
- ! a patch-level flux, it is expressed per unit GRIDCELL area
- real(r8), intent(in) :: dwt_wood_product_gain_patch( bounds%begp: )
-
- ! wood harvest addition to wood product pools (g/m2/s) [patch]
- real(r8), intent(in) :: wood_harvest_patch( bounds%begp: )
-
- !
- ! !LOCAL VARIABLES:
- integer :: fp
- integer :: p
- integer :: g
- real(r8) :: pprod10 ! PFT proportion of deadstem to 10-year product pool
- real(r8) :: pprod100 ! PFT proportion of deadstem to 100-year product pool
- real(r8) :: pprod_tot ! PFT proportion of deadstem to any product pool
- real(r8) :: pprod10_frac ! PFT fraction of deadstem to product pool that goes to 10-year product pool
- real(r8) :: pprod100_frac ! PFT fraction of deadstem to product pool that goes to 100-year product pool
-
- character(len=*), parameter :: subname = 'PartitionWoodFluxes'
- !-----------------------------------------------------------------------
-
- ! Partition patch-level harvest fluxes to 10 and 100-year product pools
- do fp = 1, num_soilp
- p = filter_soilp(fp)
- this%hrv_deadstem_to_prod10_patch(p) = &
- wood_harvest_patch(p) * pftcon%pprodharv10(patch%itype(p))
- this%hrv_deadstem_to_prod100_patch(p) = &
- wood_harvest_patch(p) * (1.0_r8 - pftcon%pprodharv10(patch%itype(p)))
- end do
-
- ! Average harvest fluxes from patch to gridcell
- call p2g(bounds, &
- this%hrv_deadstem_to_prod10_patch(bounds%begp:bounds%endp), &
- this%hrv_deadstem_to_prod10_grc(bounds%begg:bounds%endg), &
- p2c_scale_type = 'unity', &
- c2l_scale_type = 'unity', &
- l2g_scale_type = 'unity')
-
- call p2g(bounds, &
- this%hrv_deadstem_to_prod100_patch(bounds%begp:bounds%endp), &
- this%hrv_deadstem_to_prod100_grc(bounds%begg:bounds%endg), &
- p2c_scale_type = 'unity', &
- c2l_scale_type = 'unity', &
- l2g_scale_type = 'unity')
-
- ! Zero the dwt gains
- do g = bounds%begg, bounds%endg
- this%dwt_prod10_gain_grc(g) = 0._r8
- this%dwt_prod100_gain_grc(g) = 0._r8
- end do
-
- ! Partition dynamic land cover fluxes to 10 and 100-year product pools.
- do p = bounds%begp, bounds%endp
- g = patch%gridcell(p)
-
- ! Note that pprod10 + pprod100 do NOT sum to 1: some fraction of the dwt changes
- ! was lost to other fluxes. dwt_wood_product_gain_patch gives the amount that goes
- ! to all product pools, so we need to determine the fraction of that flux that
- ! goes to each pool.
- pprod10 = pftcon%pprod10(patch%itype(p))
- pprod100 = pftcon%pprod100(patch%itype(p))
- pprod_tot = pprod10 + pprod100
- if (pprod_tot > 0) then
- pprod10_frac = pprod10 / pprod_tot
- pprod100_frac = pprod100 / pprod_tot
- else
- ! Avoid divide by 0
- pprod10_frac = 0._r8
- pprod100_frac = 0._r8
- end if
-
- ! Note that the patch-level fluxes are expressed per unit gridcell area. So, to go
- ! from patch-level fluxes to gridcell-level fluxes, we simply add up the various
- ! patch contributions, without having to multiply by any area weightings.
- this%dwt_prod10_gain_grc(g) = this%dwt_prod10_gain_grc(g) + &
- dwt_wood_product_gain_patch(p) * pprod10_frac
- this%dwt_prod100_gain_grc(g) = this%dwt_prod100_gain_grc(g) + &
- dwt_wood_product_gain_patch(p) * pprod100_frac
- end do
-
- end subroutine PartitionWoodFluxes
-
- !-----------------------------------------------------------------------
- subroutine PartitionGrainFluxes(this, bounds, &
- num_soilp, filter_soilp, &
- dwt_crop_product_gain_patch, &
- grain_to_cropprod_patch)
- !
- ! !DESCRIPTION:
- ! Partition input grain fluxes into crop product pools
- !
- ! For now this doesn't do much, since there is just a single (1-year) crop product
- ! pool. But this provides the capability to add different crop product pools in the
- ! future, without requiring any changes to code outside of this class. It also gives
- ! symmetry with the wood fluxes.
- !
- ! !USES:
- use subgridAveMod, only : p2g
- !
- ! !ARGUMENTS:
- class(cn_products_type) , intent(inout) :: this
- type(bounds_type) , intent(in) :: bounds
- integer , intent(in) :: num_soilp ! number of soil patches in filter
- integer , intent(in) :: filter_soilp(:) ! filter for soil patches
-
- ! dynamic landcover addition to crop product pool (g/m2/s) [patch]; although this is
- ! a patch-level flux, it is expressed per unit GRIDCELL area
- real(r8), intent(in) :: dwt_crop_product_gain_patch( bounds%begp: )
-
- ! grain to crop product pool(s) (g/m2/s) [patch]
- real(r8) , intent(in) :: grain_to_cropprod_patch( bounds%begp: )
- !
- ! !LOCAL VARIABLES:
- integer :: fp
- integer :: p
- integer :: g
-
- character(len=*), parameter :: subname = 'PartitionGrainFluxes'
- !-----------------------------------------------------------------------
-
- ! Determine gains from crop harvest
-
- do fp = 1, num_soilp
- p = filter_soilp(fp)
-
- ! For now all crop product is put in the 1-year crop product pool
- this%grain_to_cropprod1_patch(p) = grain_to_cropprod_patch(p)
- end do
-
- call p2g(bounds, &
- this%grain_to_cropprod1_patch(bounds%begp:bounds%endp), &
- this%grain_to_cropprod1_grc(bounds%begg:bounds%endg), &
- p2c_scale_type = 'unity', &
- c2l_scale_type = 'unity', &
- l2g_scale_type = 'unity')
-
- ! Determine gains from dynamic landcover
-
- do g = bounds%begg, bounds%endg
- this%dwt_cropprod1_gain_grc(g) = 0._r8
- end do
-
- do p = bounds%begp, bounds%endp
- g = patch%gridcell(p)
-
- ! Note that the patch-level fluxes are expressed per unit gridcell area. So, to go
- ! from patch-level fluxes to gridcell-level fluxes, we simply add up the various
- ! patch contributions, without having to multiply by any area weightings.
- this%dwt_cropprod1_gain_grc(g) = this%dwt_cropprod1_gain_grc(g) + &
- dwt_crop_product_gain_patch(p)
- end do
-
- end subroutine PartitionGrainFluxes
-
-
- !-----------------------------------------------------------------------
- subroutine ComputeSummaryVars(this, bounds)
- !
- ! !DESCRIPTION:
- ! Compute summary variables in this object: sums across multiple product pools
- !
- ! !USES:
- !
- ! !ARGUMENTS:
- class(cn_products_type) , intent(inout) :: this
- type(bounds_type) , intent(in) :: bounds
- !
- ! !LOCAL VARIABLES:
- integer :: g ! indices
-
- character(len=*), parameter :: subname = 'ComputeSummaryVars'
- !-----------------------------------------------------------------------
-
- do g = bounds%begg, bounds%endg
-
- ! total wood products
- this%tot_woodprod_grc(g) = &
- this%prod10_grc(g) + &
- this%prod100_grc(g)
-
- ! total loss from wood products
- this%tot_woodprod_loss_grc(g) = &
- this%prod10_loss_grc(g) + &
- this%prod100_loss_grc(g)
-
- ! total loss from ALL products
- this%product_loss_grc(g) = &
- this%cropprod1_loss_grc(g) + &
- this%prod10_loss_grc(g) + &
- this%prod100_loss_grc(g)
-
- this%dwt_woodprod_gain_grc(g) = &
- this%dwt_prod100_gain_grc(g) + &
- this%dwt_prod10_gain_grc(g)
- end do
-
- end subroutine ComputeSummaryVars
-
-
-end module CNProductsMod
diff --git a/src/biogeochem/CNSharedParamsMod.F90 b/src/biogeochem/CNSharedParamsMod.F90
deleted file mode 100644
index 42156b11..00000000
--- a/src/biogeochem/CNSharedParamsMod.F90
+++ /dev/null
@@ -1,192 +0,0 @@
-module CNSharedParamsMod
-
- !-----------------------------------------------------------------------
- !
- ! !USES:
- use shr_kind_mod , only: r8 => shr_kind_r8
- implicit none
-
- ! CNParamsShareInst. PGI wants the type decl. public but the instance
- ! is indeed protected. A generic private statement at the start of the module
- ! overrides the protected functionality with PGI
-
- type, public :: CNParamsShareType
- real(r8) :: Q10 ! temperature dependence
- real(r8) :: minpsi ! minimum soil water potential for heterotrophic resp
- real(r8) :: cwd_fcel ! cellulose fraction of coarse woody debris
- real(r8) :: cwd_flig ! lignin fraction of coarse woody debris
- real(r8) :: froz_q10 ! separate q10 for frozen soil respiration rates
- real(r8) :: decomp_depth_efolding ! e-folding depth for reduction in decomposition (m)
- real(r8) :: mino2lim ! minimum anaerobic decomposition rate as a fraction of potential aerobic rate
- real(r8) :: organic_max ! organic matter content (kg/m3) where soil is assumed to act like peat
- logical :: constrain_stress_deciduous_onset ! if true use additional constraint on stress deciduous onset trigger
- end type CNParamsShareType
-
- type(CNParamsShareType), protected :: CNParamsShareInst
-
- logical, public :: anoxia_wtsat = .false.
- logical, public :: use_fun = .false. ! Use the FUN2.0 model
- integer, public :: nlev_soildecomp_standard = 5
-
- character(len=*), parameter, private :: sourcefile = &
- __FILE__
- !-----------------------------------------------------------------------
-
-contains
-
- !-----------------------------------------------------------------------
- subroutine CNParamsReadShared(ncid, namelist_file)
-
- use ncdio_pio , only : file_desc_t
-
- type(file_desc_t), intent(inout) :: ncid ! pio netCDF file id
- character(len=*), intent(in) :: namelist_file
-
- call CNParamsReadShared_netcdf(ncid)
- call CNParamsReadShared_namelist(namelist_file)
-
- end subroutine CNParamsReadShared
-
- !-----------------------------------------------------------------------
- subroutine CNParamsReadShared_netcdf(ncid)
- !
- use ncdio_pio , only : file_desc_t, ncd_io
- use abortutils , only : endrun
- use shr_log_mod , only : errMsg => shr_log_errMsg
- !
- implicit none
- type(file_desc_t),intent(inout) :: ncid ! pio netCDF file id
- !
- character(len=32) :: subname = 'CNParamsReadShared'
- character(len=100) :: errCode = '-Error reading in CN and BGC shared params file. Var:'
- 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
- !-----------------------------------------------------------------------
- !
- ! netcdf read here
- !
- tString='q10_mr'
- 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(sourcefile, __LINE__))
- CNParamsShareInst%Q10=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(sourcefile, __LINE__))
- CNParamsShareInst%minpsi=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(sourcefile, __LINE__))
- CNParamsShareInst%cwd_fcel=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(sourcefile, __LINE__))
- CNParamsShareInst%cwd_flig=tempr
-
- tString='froz_q10'
- call ncd_io(trim(tString),tempr, 'read', ncid, readvar=readv)
- if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__))
- CNParamsShareInst%froz_q10=tempr
-
- tString='mino2lim'
- call ncd_io(trim(tString),tempr, 'read', ncid, readvar=readv)
- if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__))
- CNParamsShareInst%mino2lim=tempr
- !CNParamsShareInst%mino2lim=0.2_r8
-
- tString='organic_max'
- call ncd_io(trim(tString),tempr, 'read', ncid, readvar=readv)
- if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__))
- CNParamsShareInst%organic_max=tempr
-
- end subroutine CNParamsReadShared_netcdf
-
- !-----------------------------------------------------------------------
- subroutine CNParamsReadShared_namelist(namelist_file)
- !
- ! !DESCRIPTION:
- ! Read and initialize CN Shared parameteres from the namelist.
- !
- ! !USES:
- use fileutils , only : relavu, getavu
- use spmdMod , only : masterproc, mpicom, MPI_REAL8, MPI_LOGICAL
- use shr_nl_mod , only : shr_nl_find_group_name
- use shr_log_mod , only : errMsg => shr_log_errMsg
- use clm_varctl , only : iulog
- use abortutils , only : endrun
- use shr_mpi_mod , only : shr_mpi_bcast
-
- !
- implicit none
- !
-
- character(len=*), intent(in) :: namelist_file
-
- integer :: i,j,n ! loop indices
- integer :: ierr ! error code
- integer :: unitn ! unit for namelist file
-
- real(r8) :: decomp_depth_efolding = 0.0_r8
- logical :: constrain_stress_deciduous_onset = .false.
-
- character(len=32) :: subroutine_name = 'CNParamsReadNamelist'
- character(len=10) :: namelist_group = 'bgc_shared'
-
- !-----------------------------------------------------------------------
-
- ! ----------------------------------------------------------------------
- ! Namelist Variables
- ! ----------------------------------------------------------------------
-
- namelist /bgc_shared/ &
- decomp_depth_efolding, &
- constrain_stress_deciduous_onset
-
-
- ! Read namelist from standard input.
- if (masterproc) then
-
- write(iulog,*) 'Attempting to read CN/BGC shared namelist parameters .....'
- unitn = getavu()
- write(iulog,*) 'Read in ' // namelist_group // ' namelist from: ', trim(namelist_file)
- open( unitn, file=trim(namelist_file), status='old' )
- call shr_nl_find_group_name(unitn, namelist_group, status=ierr)
- if (ierr == 0) then
- read(unitn, bgc_shared, iostat=ierr)
- if (ierr /= 0) then
- call endrun(msg='error in reading in ' // namelist_group // ' namelist' // &
- errMsg(sourcefile, __LINE__))
- end if
- else
- call endrun(msg='error in finding ' // namelist_group // ' namelist' // &
- errMsg(sourcefile, __LINE__))
- end if
- call relavu( unitn )
-
- end if ! masterproc
-
- ! Broadcast the parameters from master
- call shr_mpi_bcast ( decomp_depth_efolding, mpicom )
- call shr_mpi_bcast ( constrain_stress_deciduous_onset, mpicom )
-
- ! Save the parameter to the instance
- CNParamsShareInst%decomp_depth_efolding = decomp_depth_efolding
- CNParamsShareInst%constrain_stress_deciduous_onset = constrain_stress_deciduous_onset
-
- ! Output read parameters to the lnd.log
- if (masterproc) then
- write(iulog,*) 'CN/BGC shared namelist parameters:'
- write(iulog,*)' '
- write(iulog,*)' decomp_depth_efolding = ', decomp_depth_efolding
- write(iulog,*)' constrain_stress_deciduous_onset = ',constrain_stress_deciduous_onset
-
- write(iulog,*)
-
- end if
-
- end subroutine CNParamsReadShared_namelist
-
-end module CNSharedParamsMod
diff --git a/src/biogeochem/CNSpeciesMod.F90 b/src/biogeochem/CNSpeciesMod.F90
deleted file mode 100644
index fc89f3ac..00000000
--- a/src/biogeochem/CNSpeciesMod.F90
+++ /dev/null
@@ -1,68 +0,0 @@
-module CNSpeciesMod
-
- !-----------------------------------------------------------------------
- ! Module holding information about different species available in the CN code (C, C13,
- ! C14, N).
- !
- !
- ! NOTE(wjs, 2016-06-05) Eventually I could imagine having a cn_species base class, with
- ! derived classes for each species type - so a cn_species_c class, a cn_species_c13
- ! class, a cn_species_c14 class and a cn_species_n class. These would contain methods
- ! to handle calculations specific to each species type. For example, there could be a
- ! carbon_multiplier method that returns the species-specific multiplier that you would
- ! apply to a variable in units of gC/m2 to give you g[this species]/m2 (this would
- ! depend on pft type).
- !
- ! Basically, anywhere where there is code that has a conditional based on the constants
- ! defined here, we could replace that with polymorphism using a cn_species class.
- !
- ! Eventually I think it would make sense to make this contain an instance of
- ! species_base_type (i.e., the class used to determine history & restart field names),
- ! with forwarding methods. So then (e.g.) a cn_products_type object would just contain a
- ! cn_species object (which in turn would contain a species_metadata [or whatever we call
- ! it] object).
-
- implicit none
- private
-
- integer, parameter, public :: CN_SPECIES_C12 = 1
- integer, parameter, public :: CN_SPECIES_C13 = 2
- integer, parameter, public :: CN_SPECIES_C14 = 3
- integer, parameter, public :: CN_SPECIES_N = 4
-
- public :: species_from_string ! convert a string representation to one of the constants defined here
-
-contains
-
- !-----------------------------------------------------------------------
- function species_from_string(species_string) result(species)
- !
- ! !DESCRIPTION:
- ! Convert a string representation to one of the constants defined here
- !
- ! !USES:
- !
- ! !ARGUMENTS:
- integer :: species ! function result
- character(len=*), intent(in) :: species_string ! string representation of species (should be lowercase)
- !
- ! !LOCAL VARIABLES:
-
- character(len=*), parameter :: subname = 'species_from_string'
- !-----------------------------------------------------------------------
-
- select case (species_string)
- case ('c12')
- species = CN_SPECIES_C12
- case ('c13')
- species = CN_SPECIES_C13
- case ('c14')
- species = CN_SPECIES_C14
- case ('n')
- species = CN_SPECIES_N
- end select
-
- end function species_from_string
-
-
-end module CNSpeciesMod
diff --git a/src/biogeochem/CNVegCarbonFluxType.F90 b/src/biogeochem/CNVegCarbonFluxType.F90
deleted file mode 100644
index 3fa76b3a..00000000
--- a/src/biogeochem/CNVegCarbonFluxType.F90
+++ /dev/null
@@ -1,3891 +0,0 @@
-module CNVegCarbonFluxType
-
-#include "shr_assert.h"
-
- !-----------------------------------------------------------------------
- !
- ! !USES:
- use shr_kind_mod , only : r8 => shr_kind_r8
- use shr_infnan_mod , only : nan => shr_infnan_nan, assignment(=)
- use shr_log_mod , only : errMsg => shr_log_errMsg
- use decompMod , only : bounds_type
- use SoilBiogeochemDecompCascadeConType , only : decomp_cascade_con
- use clm_varpar , only : ndecomp_cascade_transitions, ndecomp_pools
- use clm_varpar , only : nlevdecomp_full, nlevgrnd, nlevdecomp
- use clm_varcon , only : spval, dzsoi_decomp
- use clm_varctl , only : use_cndv, use_nitrif_denitrif, use_crop
- use clm_varctl , only : use_grainproduct
- use clm_varctl , only : iulog
- use landunit_varcon , only : istsoil, istcrop, istdlak
- use pftconMod , only : npcropmin
- use LandunitType , only : lun
- use ColumnType , only : col
- use PatchType , only : patch
- use abortutils , only : endrun
- !
- ! !PUBLIC TYPES:
- implicit none
- private
- !
- type, public :: cnveg_carbonflux_type
-
- ! gap mortality fluxes
- real(r8), pointer :: m_leafc_to_litter_patch (:) ! leaf C mortality (gC/m2/s)
- real(r8), pointer :: m_leafc_storage_to_litter_patch (:) ! leaf C storage mortality (gC/m2/s)
- real(r8), pointer :: m_leafc_xfer_to_litter_patch (:) ! leaf C transfer mortality (gC/m2/s)
- real(r8), pointer :: m_frootc_to_litter_patch (:) ! fine root C mortality (gC/m2/s)
- real(r8), pointer :: m_frootc_storage_to_litter_patch (:) ! fine root C storage mortality (gC/m2/s)
- real(r8), pointer :: m_frootc_xfer_to_litter_patch (:) ! fine root C transfer mortality (gC/m2/s)
- real(r8), pointer :: m_livestemc_to_litter_patch (:) ! live stem C mortality (gC/m2/s)
- real(r8), pointer :: m_livestemc_storage_to_litter_patch (:) ! live stem C storage mortality (gC/m2/s)
- real(r8), pointer :: m_livestemc_xfer_to_litter_patch (:) ! live stem C transfer mortality (gC/m2/s)
- real(r8), pointer :: m_deadstemc_to_litter_patch (:) ! dead stem C mortality (gC/m2/s)
- real(r8), pointer :: m_deadstemc_storage_to_litter_patch (:) ! dead stem C storage mortality (gC/m2/s)
- real(r8), pointer :: m_deadstemc_xfer_to_litter_patch (:) ! dead stem C transfer mortality (gC/m2/s)
- real(r8), pointer :: m_livecrootc_to_litter_patch (:) ! live coarse root C mortality (gC/m2/s)
- real(r8), pointer :: m_livecrootc_storage_to_litter_patch (:) ! live coarse root C storage mortality (gC/m2/s)
- real(r8), pointer :: m_livecrootc_xfer_to_litter_patch (:) ! live coarse root C transfer mortality (gC/m2/s)
- real(r8), pointer :: m_deadcrootc_to_litter_patch (:) ! dead coarse root C mortality (gC/m2/s)
- real(r8), pointer :: m_deadcrootc_storage_to_litter_patch (:) ! dead coarse root C storage mortality (gC/m2/s)
- real(r8), pointer :: m_deadcrootc_xfer_to_litter_patch (:) ! dead coarse root C transfer mortality (gC/m2/s)
- real(r8), pointer :: m_gresp_storage_to_litter_patch (:) ! growth respiration storage mortality (gC/m2/s)
- real(r8), pointer :: m_gresp_xfer_to_litter_patch (:) ! growth respiration transfer mortality (gC/m2/s)
-
- ! harvest mortality fluxes
- real(r8), pointer :: hrv_leafc_to_litter_patch (:) ! leaf C harvest mortality (gC/m2/s)
- real(r8), pointer :: hrv_leafc_storage_to_litter_patch (:) ! leaf C storage harvest mortality (gC/m2/s)
- real(r8), pointer :: hrv_leafc_xfer_to_litter_patch (:) ! leaf C transfer harvest mortality (gC/m2/s)
- real(r8), pointer :: hrv_frootc_to_litter_patch (:) ! fine root C harvest mortality (gC/m2/s)
- real(r8), pointer :: hrv_frootc_storage_to_litter_patch (:) ! fine root C storage harvest mortality (gC/m2/s)
- real(r8), pointer :: hrv_frootc_xfer_to_litter_patch (:) ! fine root C transfer harvest mortality (gC/m2/s)
- real(r8), pointer :: hrv_livestemc_to_litter_patch (:) ! live stem C harvest mortality (gC/m2/s)
- real(r8), pointer :: hrv_livestemc_storage_to_litter_patch (:) ! live stem C storage harvest mortality (gC/m2/s)
- real(r8), pointer :: hrv_livestemc_xfer_to_litter_patch (:) ! live stem C transfer harvest mortality (gC/m2/s)
- real(r8), pointer :: hrv_deadstemc_storage_to_litter_patch (:) ! dead stem C storage harvest mortality (gC/m2/s)
- real(r8), pointer :: hrv_deadstemc_xfer_to_litter_patch (:) ! dead stem C transfer harvest mortality (gC/m2/s)
- real(r8), pointer :: hrv_livecrootc_to_litter_patch (:) ! live coarse root C harvest mortality (gC/m2/s)
- real(r8), pointer :: hrv_livecrootc_storage_to_litter_patch (:) ! live coarse root C storage harvest mortality (gC/m2/s)
- real(r8), pointer :: hrv_livecrootc_xfer_to_litter_patch (:) ! live coarse root C transfer harvest mortality (gC/m2/s)
- real(r8), pointer :: hrv_deadcrootc_to_litter_patch (:) ! dead coarse root C harvest mortality (gC/m2/s)
- real(r8), pointer :: hrv_deadcrootc_storage_to_litter_patch (:) ! dead coarse root C storage harvest mortality (gC/m2/s)
- real(r8), pointer :: hrv_deadcrootc_xfer_to_litter_patch (:) ! dead coarse root C transfer harvest mortality (gC/m2/s)
- real(r8), pointer :: hrv_gresp_storage_to_litter_patch (:) ! growth respiration storage harvest mortality (gC/m2/s)
- real(r8), pointer :: hrv_gresp_xfer_to_litter_patch (:) ! growth respiration transfer harvest mortality (gC/m2/s)
- real(r8), pointer :: hrv_xsmrpool_to_atm_patch (:) ! excess MR pool harvest mortality (gC/m2/s)
-
- ! fire fluxes
- real(r8), pointer :: m_leafc_to_fire_patch (:) ! (gC/m2/s) fire C emissions from leafc
- real(r8), pointer :: m_leafc_storage_to_fire_patch (:) ! (gC/m2/s) fire C emissions from leafc_storage
- real(r8), pointer :: m_leafc_xfer_to_fire_patch (:) ! (gC/m2/s) fire C emissions from leafc_xfer
- real(r8), pointer :: m_livestemc_to_fire_patch (:) ! (gC/m2/s) fire C emissions from livestemc
- real(r8), pointer :: m_livestemc_storage_to_fire_patch (:) ! (gC/m2/s) fire C emissions from livestemc_storage
- real(r8), pointer :: m_livestemc_xfer_to_fire_patch (:) ! (gC/m2/s) fire C emissions from livestemc_xfer
- real(r8), pointer :: m_deadstemc_to_fire_patch (:) ! (gC/m2/s) fire C emissions from deadstemc_xfer
- real(r8), pointer :: m_deadstemc_storage_to_fire_patch (:) ! (gC/m2/s) fire C emissions from deadstemc_storage
- real(r8), pointer :: m_deadstemc_xfer_to_fire_patch (:) ! (gC/m2/s) fire C emissions from deadstemc_xfer
- real(r8), pointer :: m_frootc_to_fire_patch (:) ! (gC/m2/s) fire C emissions from frootc
- real(r8), pointer :: m_frootc_storage_to_fire_patch (:) ! (gC/m2/s) fire C emissions from frootc_storage
- real(r8), pointer :: m_frootc_xfer_to_fire_patch (:) ! (gC/m2/s) fire C emissions from frootc_xfer
- real(r8), pointer :: m_livecrootc_to_fire_patch (:) ! (gC/m2/s) fire C emissions from livecrootc
- real(r8), pointer :: m_livecrootc_storage_to_fire_patch (:) ! (gC/m2/s) fire C emissions from livecrootc_storage
- real(r8), pointer :: m_livecrootc_xfer_to_fire_patch (:) ! (gC/m2/s) fire C emissions from livecrootc_xfer
- real(r8), pointer :: m_deadcrootc_to_fire_patch (:) ! (gC/m2/s) fire C emissions from deadcrootc
- real(r8), pointer :: m_deadcrootc_storage_to_fire_patch (:) ! (gC/m2/s) fire C emissions from deadcrootc_storage
- real(r8), pointer :: m_deadcrootc_xfer_to_fire_patch (:) ! (gC/m2/s) fire C emissions from deadcrootc_xfer
- real(r8), pointer :: m_gresp_storage_to_fire_patch (:) ! (gC/m2/s) fire C emissions from gresp_storage
- real(r8), pointer :: m_gresp_xfer_to_fire_patch (:) ! (gC/m2/s) fire C emissions from gresp_xfer
- real(r8), pointer :: m_leafc_to_litter_fire_patch (:) ! (gC/m2/s) from leafc to litter c due to fire
- real(r8), pointer :: m_leafc_storage_to_litter_fire_patch (:) ! (gC/m2/s) from leafc_storage to litter C due to fire
- real(r8), pointer :: m_leafc_xfer_to_litter_fire_patch (:) ! (gC/m2/s) from leafc_xfer to litter C due to fire
- real(r8), pointer :: m_livestemc_to_litter_fire_patch (:) ! (gC/m2/s) from livestemc to litter C due to fire
- real(r8), pointer :: m_livestemc_storage_to_litter_fire_patch (:) ! (gC/m2/s) from livestemc_storage to litter C due to fire
- real(r8), pointer :: m_livestemc_xfer_to_litter_fire_patch (:) ! (gC/m2/s) from livestemc_xfer to litter C due to fire
- real(r8), pointer :: m_livestemc_to_deadstemc_fire_patch (:) ! (gC/m2/s) from livestemc to deadstemc due to fire
- real(r8), pointer :: m_deadstemc_to_litter_fire_patch (:) ! (gC/m2/s) from deadstemc to litter C due to fire
- real(r8), pointer :: m_deadstemc_storage_to_litter_fire_patch (:) ! (gC/m2/s) from deadstemc_storage to litter C due to fire
- real(r8), pointer :: m_deadstemc_xfer_to_litter_fire_patch (:) ! (gC/m2/s) from deadstemc_xfer to litter C due to fire
- real(r8), pointer :: m_frootc_to_litter_fire_patch (:) ! (gC/m2/s) from frootc to litter C due to fire
- real(r8), pointer :: m_frootc_storage_to_litter_fire_patch (:) ! (gC/m2/s) from frootc_storage to litter C due to fire
- real(r8), pointer :: m_frootc_xfer_to_litter_fire_patch (:) ! (gC/m2/s) from frootc_xfer to litter C due to fire
- real(r8), pointer :: m_livecrootc_to_litter_fire_patch (:) ! (gC/m2/s) from livecrootc to litter C due to fire
- real(r8), pointer :: m_livecrootc_storage_to_litter_fire_patch (:) ! (gC/m2/s) from livecrootc_storage to litter C due to fire
- real(r8), pointer :: m_livecrootc_xfer_to_litter_fire_patch (:) ! (gC/m2/s) from livecrootc_xfer to litter C due to fire
- real(r8), pointer :: m_livecrootc_to_deadcrootc_fire_patch (:) ! (gC/m2/s) from livecrootc to deadstemc due to fire
- real(r8), pointer :: m_deadcrootc_to_litter_fire_patch (:) ! (gC/m2/s) from deadcrootc to litter C due to fire
- real(r8), pointer :: m_deadcrootc_storage_to_litter_fire_patch (:) ! (gC/m2/s) from deadcrootc_storage to litter C due to fire
- real(r8), pointer :: m_deadcrootc_xfer_to_litter_fire_patch (:) ! (gC/m2/s) from deadcrootc_xfer to litter C due to fire
- real(r8), pointer :: m_gresp_storage_to_litter_fire_patch (:) ! (gC/m2/s) from gresp_storage to litter C due to fire
- real(r8), pointer :: m_gresp_xfer_to_litter_fire_patch (:) ! (gC/m2/s) from gresp_xfer to litter C due to fire
-
- ! phenology fluxes from transfer pools
- real(r8), pointer :: grainc_xfer_to_grainc_patch (:) ! grain C growth from storage for prognostic crop(gC/m2/s)
- real(r8), pointer :: leafc_xfer_to_leafc_patch (:) ! leaf C growth from storage (gC/m2/s)
- real(r8), pointer :: frootc_xfer_to_frootc_patch (:) ! fine root C growth from storage (gC/m2/s)
- real(r8), pointer :: livestemc_xfer_to_livestemc_patch (:) ! live stem C growth from storage (gC/m2/s)
- real(r8), pointer :: deadstemc_xfer_to_deadstemc_patch (:) ! dead stem C growth from storage (gC/m2/s)
- real(r8), pointer :: livecrootc_xfer_to_livecrootc_patch (:) ! live coarse root C growth from storage (gC/m2/s)
- real(r8), pointer :: deadcrootc_xfer_to_deadcrootc_patch (:) ! dead coarse root C growth from storage (gC/m2/s)
-
- ! leaf and fine root litterfall fluxes
- real(r8), pointer :: leafc_to_litter_patch (:) ! leaf C litterfall (gC/m2/s)
- real(r8), pointer :: leafc_to_litter_fun_patch (:) ! leaf C litterfall used by FUN (gC/m2/s)
- real(r8), pointer :: frootc_to_litter_patch (:) ! fine root C litterfall (gC/m2/s)
- real(r8), pointer :: livestemc_to_litter_patch (:) ! live stem C litterfall (gC/m2/s)
- real(r8), pointer :: grainc_to_food_patch (:) ! grain C to food for prognostic crop(gC/m2/s)
- real(r8), pointer :: grainc_to_seed_patch (:) ! grain C to seed for prognostic crop(gC/m2/s)
-
- ! maintenance respiration fluxes
- real(r8), pointer :: cpool_to_resp_patch (:) ! CNflex excess C maintenance respiration (gC/m2/s)
- real(r8), pointer :: cpool_to_leafc_resp_patch (:) ! CNflex excess C maintenance respiration (gC/m2/s)
- real(r8), pointer :: cpool_to_leafc_storage_resp_patch (:) ! CNflex excess C maintenance respiration (gC/m2/s)
- real(r8), pointer :: cpool_to_frootc_resp_patch (:) ! CNflex excess C maintenance respiration (gC/m2/s)
- real(r8), pointer :: cpool_to_frootc_storage_resp_patch (:) ! CNflex excess C maintenance respiration (gC/m2/s)
- real(r8), pointer :: cpool_to_livecrootc_resp_patch (:) ! CNflex excess C maintenance respiration (gC/m2/s)
- real(r8), pointer :: cpool_to_livecrootc_storage_resp_patch (:) ! CNflex excess C maintenance respiration (gC/m2/s)
- real(r8), pointer :: cpool_to_livestemc_resp_patch (:) ! CNflex excess C maintenance respiration (gC/m2/s)
- real(r8), pointer :: cpool_to_livestemc_storage_resp_patch (:) ! CNflex excess C maintenance respiration (gC/m2/s)
- real(r8), pointer :: leaf_mr_patch (:) ! leaf maintenance respiration (gC/m2/s)
- real(r8), pointer :: froot_mr_patch (:) ! fine root maintenance respiration (gC/m2/s)
- real(r8), pointer :: livestem_mr_patch (:) ! live stem maintenance respiration (gC/m2/s)
- real(r8), pointer :: livecroot_mr_patch (:) ! live coarse root maintenance respiration (gC/m2/s)
- real(r8), pointer :: grain_mr_patch (:) ! crop grain or organs maint. respiration (gC/m2/s)
- real(r8), pointer :: leaf_curmr_patch (:) ! leaf maintenance respiration from current GPP (gC/m2/s)
- real(r8), pointer :: froot_curmr_patch (:) ! fine root maintenance respiration from current GPP (gC/m2/s)
- real(r8), pointer :: livestem_curmr_patch (:) ! live stem maintenance respiration from current GPP (gC/m2/s)
- real(r8), pointer :: livecroot_curmr_patch (:) ! live coarse root maintenance respiration from current GPP (gC/m2/s)
- real(r8), pointer :: grain_curmr_patch (:) ! crop grain or organs maint. respiration from current GPP (gC/m2/s)
- real(r8), pointer :: leaf_xsmr_patch (:) ! leaf maintenance respiration from storage (gC/m2/s)
- real(r8), pointer :: froot_xsmr_patch (:) ! fine root maintenance respiration from storage (gC/m2/s)
- real(r8), pointer :: livestem_xsmr_patch (:) ! live stem maintenance respiration from storage (gC/m2/s)
- real(r8), pointer :: livecroot_xsmr_patch (:) ! live coarse root maintenance respiration from storage (gC/m2/s)
- real(r8), pointer :: grain_xsmr_patch (:) ! crop grain or organs maint. respiration from storage (gC/m2/s)
-
- ! photosynthesis fluxes
- real(r8), pointer :: psnsun_to_cpool_patch (:) ! C fixation from sunlit canopy (gC/m2/s)
- real(r8), pointer :: psnshade_to_cpool_patch (:) ! C fixation from shaded canopy (gC/m2/s)
-
- ! allocation fluxes, from current GPP
- real(r8), pointer :: cpool_to_xsmrpool_patch (:) ! allocation to maintenance respiration storage pool (gC/m2/s)
- real(r8), pointer :: cpool_to_grainc_patch (:) ! allocation to grain C for prognostic crop(gC/m2/s)
- real(r8), pointer :: cpool_to_grainc_storage_patch (:) ! allocation to grain C storage for prognostic crop(gC/m2/s)
- real(r8), pointer :: cpool_to_leafc_patch (:) ! allocation to leaf C (gC/m2/s)
- real(r8), pointer :: cpool_to_leafc_storage_patch (:) ! allocation to leaf C storage (gC/m2/s)
- real(r8), pointer :: cpool_to_frootc_patch (:) ! allocation to fine root C (gC/m2/s)
- real(r8), pointer :: cpool_to_frootc_storage_patch (:) ! allocation to fine root C storage (gC/m2/s)
- real(r8), pointer :: cpool_to_livestemc_patch (:) ! allocation to live stem C (gC/m2/s)
- real(r8), pointer :: cpool_to_livestemc_storage_patch (:) ! allocation to live stem C storage (gC/m2/s)
- real(r8), pointer :: cpool_to_deadstemc_patch (:) ! allocation to dead stem C (gC/m2/s)
- real(r8), pointer :: cpool_to_deadstemc_storage_patch (:) ! allocation to dead stem C storage (gC/m2/s)
- real(r8), pointer :: cpool_to_livecrootc_patch (:) ! allocation to live coarse root C (gC/m2/s)
- real(r8), pointer :: cpool_to_livecrootc_storage_patch (:) ! allocation to live coarse root C storage (gC/m2/s)
- real(r8), pointer :: cpool_to_deadcrootc_patch (:) ! allocation to dead coarse root C (gC/m2/s)
- real(r8), pointer :: cpool_to_deadcrootc_storage_patch (:) ! allocation to dead coarse root C storage (gC/m2/s)
- real(r8), pointer :: cpool_to_gresp_storage_patch (:) ! allocation to growth respiration storage (gC/m2/s)
-
- ! growth respiration fluxes
- real(r8), pointer :: xsmrpool_to_atm_patch (:) ! excess MR pool harvest mortality (gC/m2/s)
- real(r8), pointer :: cpool_leaf_gr_patch (:) ! leaf growth respiration (gC/m2/s)
- real(r8), pointer :: cpool_leaf_storage_gr_patch (:) ! leaf growth respiration to storage (gC/m2/s)
- real(r8), pointer :: transfer_leaf_gr_patch (:) ! leaf growth respiration from storage (gC/m2/s)
- real(r8), pointer :: cpool_froot_gr_patch (:) ! fine root growth respiration (gC/m2/s)
- real(r8), pointer :: cpool_froot_storage_gr_patch (:) ! fine root growth respiration to storage (gC/m2/s)
- real(r8), pointer :: transfer_froot_gr_patch (:) ! fine root growth respiration from storage (gC/m2/s)
- real(r8), pointer :: cpool_livestem_gr_patch (:) ! live stem growth respiration (gC/m2/s)
- real(r8), pointer :: cpool_livestem_storage_gr_patch (:) ! live stem growth respiration to storage (gC/m2/s)
- real(r8), pointer :: transfer_livestem_gr_patch (:) ! live stem growth respiration from storage (gC/m2/s)
- real(r8), pointer :: cpool_deadstem_gr_patch (:) ! dead stem growth respiration (gC/m2/s)
- real(r8), pointer :: cpool_deadstem_storage_gr_patch (:) ! dead stem growth respiration to storage (gC/m2/s)
- real(r8), pointer :: transfer_deadstem_gr_patch (:) ! dead stem growth respiration from storage (gC/m2/s)
- real(r8), pointer :: cpool_livecroot_gr_patch (:) ! live coarse root growth respiration (gC/m2/s)
- real(r8), pointer :: cpool_livecroot_storage_gr_patch (:) ! live coarse root growth respiration to storage (gC/m2/s)
- real(r8), pointer :: transfer_livecroot_gr_patch (:) ! live coarse root growth respiration from storage (gC/m2/s)
- real(r8), pointer :: cpool_deadcroot_gr_patch (:) ! dead coarse root growth respiration (gC/m2/s)
- real(r8), pointer :: cpool_deadcroot_storage_gr_patch (:) ! dead coarse root growth respiration to storage (gC/m2/s)
- real(r8), pointer :: transfer_deadcroot_gr_patch (:) ! dead coarse root growth respiration from storage (gC/m2/s)
-
- ! growth respiration for prognostic crop model
- real(r8), pointer :: cpool_grain_gr_patch (:) ! grain growth respiration (gC/m2/s)
- real(r8), pointer :: cpool_grain_storage_gr_patch (:) ! grain growth respiration to storage (gC/m2/s)
- real(r8), pointer :: transfer_grain_gr_patch (:) ! grain growth respiration from storage (gC/m2/s)
-
- ! annual turnover of storage to transfer pools
- real(r8), pointer :: grainc_storage_to_xfer_patch (:) ! grain C shift storage to transfer for prognostic crop model (gC/m2/s)
- real(r8), pointer :: leafc_storage_to_xfer_patch (:) ! leaf C shift storage to transfer (gC/m2/s)
- real(r8), pointer :: frootc_storage_to_xfer_patch (:) ! fine root C shift storage to transfer (gC/m2/s)
- real(r8), pointer :: livestemc_storage_to_xfer_patch (:) ! live stem C shift storage to transfer (gC/m2/s)
- real(r8), pointer :: deadstemc_storage_to_xfer_patch (:) ! dead stem C shift storage to transfer (gC/m2/s)
- real(r8), pointer :: livecrootc_storage_to_xfer_patch (:) ! live coarse root C shift storage to transfer (gC/m2/s)
- real(r8), pointer :: deadcrootc_storage_to_xfer_patch (:) ! dead coarse root C shift storage to transfer (gC/m2/s)
- real(r8), pointer :: gresp_storage_to_xfer_patch (:) ! growth respiration shift storage to transfer (gC/m2/s)
-
- ! turnover of livewood to deadwood
- real(r8), pointer :: livestemc_to_deadstemc_patch (:) ! live stem C turnover (gC/m2/s)
- real(r8), pointer :: livecrootc_to_deadcrootc_patch (:) ! live coarse root C turnover (gC/m2/s)
-
- ! phenology: litterfall and crop fluxes
- real(r8), pointer :: phenology_c_to_litr_met_c_col (:,:) ! C fluxes associated with phenology (litterfall and crop) to litter metabolic pool (gC/m3/s)
- real(r8), pointer :: phenology_c_to_litr_cel_c_col (:,:) ! C fluxes associated with phenology (litterfall and crop) to litter cellulose pool (gC/m3/s)
- real(r8), pointer :: phenology_c_to_litr_lig_c_col (:,:) ! C fluxes associated with phenology (litterfall and crop) to litter lignin pool (gC/m3/s)
-
- ! gap mortality
- real(r8), pointer :: gap_mortality_c_to_litr_met_c_col (:,:) ! C fluxes associated with gap mortality to litter metabolic pool (gC/m3/s)
- real(r8), pointer :: gap_mortality_c_to_litr_cel_c_col (:,:) ! C fluxes associated with gap mortality to litter cellulose pool (gC/m3/s)
- real(r8), pointer :: gap_mortality_c_to_litr_lig_c_col (:,:) ! C fluxes associated with gap mortality to litter lignin pool (gC/m3/s)
- real(r8), pointer :: gap_mortality_c_to_cwdc_col (:,:) ! C fluxes associated with gap mortality to CWD pool (gC/m3/s)
-
- ! fire
- real(r8), pointer :: fire_mortality_c_to_cwdc_col (:,:) ! C fluxes associated with fire mortality to CWD pool (gC/m3/s)
-
- ! harvest
- real(r8), pointer :: harvest_c_to_litr_met_c_col (:,:) ! C fluxes associated with harvest to litter metabolic pool (gC/m3/s)
- real(r8), pointer :: harvest_c_to_litr_cel_c_col (:,:) ! C fluxes associated with harvest to litter cellulose pool (gC/m3/s)
- real(r8), pointer :: harvest_c_to_litr_lig_c_col (:,:) ! C fluxes associated with harvest to litter lignin pool (gC/m3/s)
- real(r8), pointer :: harvest_c_to_cwdc_col (:,:) ! C fluxes associated with harvest to CWD pool (gC/m3/s)
- real(r8), pointer :: grainc_to_cropprodc_patch (:) ! grain C to crop product pool (gC/m2/s)
- real(r8), pointer :: grainc_to_cropprodc_col (:) ! grain C to crop product pool (gC/m2/s)
-
- ! fire fluxes
- real(r8), pointer :: m_decomp_cpools_to_fire_vr_col (:,:,:) ! vertically-resolved decomposing C fire loss (gC/m3/s)
- real(r8), pointer :: m_decomp_cpools_to_fire_col (:,:) ! vertically-integrated (diagnostic) decomposing C fire loss (gC/m2/s)
- real(r8), pointer :: m_c_to_litr_met_fire_col (:,:) ! C from leaf, froot, xfer and storage C to litter labile C by fire (gC/m3/s)
- real(r8), pointer :: m_c_to_litr_cel_fire_col (:,:) ! C from leaf, froot, xfer and storage C to litter cellulose C by fire (gC/m3/s)
- real(r8), pointer :: m_c_to_litr_lig_fire_col (:,:) ! C from leaf, froot, xfer and storage C to litter lignin C by fire (gC/m3/s)
-
- ! dynamic landcover fluxes
- real(r8), pointer :: dwt_seedc_to_leaf_patch (:) ! (gC/m2/s) seed source to patch-level; although this is a patch-level flux, it is expressed per unit GRIDCELL area
- real(r8), pointer :: dwt_seedc_to_leaf_grc (:) ! (gC/m2/s) dwt_seedc_to_leaf_patch summed to the gridcell-level
- real(r8), pointer :: dwt_seedc_to_deadstem_patch (:) ! (gC/m2/s) seed source to patch-level; although this is a patch-level flux, it is expressed per unit GRIDCELL area
- real(r8), pointer :: dwt_seedc_to_deadstem_grc (:) ! (gC/m2/s) dwt_seedc_to_leaf_patch summed to the gridcell-level
- real(r8), pointer :: dwt_conv_cflux_patch (:) ! (gC/m2/s) conversion C flux (immediate loss to atm); although this is a patch-level flux, it is expressed per unit GRIDCELL area
- real(r8), pointer :: dwt_conv_cflux_grc (:) ! (gC/m2/s) dwt_conv_cflux_patch summed to the gridcell-level
- real(r8), pointer :: dwt_conv_cflux_dribbled_grc (:) ! (gC/m2/s) dwt_conv_cflux_grc dribbled evenly throughout the year
- real(r8), pointer :: dwt_wood_productc_gain_patch (:) ! (gC/m2/s) addition to wood product pools from landcover change; although this is a patch-level flux, it is expressed per unit GRIDCELL area
- real(r8), pointer :: dwt_crop_productc_gain_patch (:) ! (gC/m2/s) addition to crop product pools from landcover change; although this is a patch-level flux, it is expressed per unit GRIDCELL area
- real(r8), pointer :: dwt_slash_cflux_col (:) ! (gC/m2/s) conversion slash flux due to landcover change
- real(r8), pointer :: dwt_frootc_to_litr_met_c_col (:,:) ! (gC/m3/s) fine root to litter due to landcover change
- real(r8), pointer :: dwt_frootc_to_litr_cel_c_col (:,:) ! (gC/m3/s) fine root to litter due to landcover change
- real(r8), pointer :: dwt_frootc_to_litr_lig_c_col (:,:) ! (gC/m3/s) fine root to litter due to landcover change
- real(r8), pointer :: dwt_livecrootc_to_cwdc_col (:,:) ! (gC/m3/s) live coarse root to CWD due to landcover change
- real(r8), pointer :: dwt_deadcrootc_to_cwdc_col (:,:) ! (gC/m3/s) dead coarse root to CWD due to landcover change
-
- ! crop fluxes
- real(r8), pointer :: crop_seedc_to_leaf_patch (:) ! (gC/m2/s) seed source to leaf, for crops
-
- ! summary (diagnostic) flux variables, not involved in mass balance
- real(r8), pointer :: gpp_before_downreg_patch (:) ! (gC/m2/s) gross primary production before down regulation
- real(r8), pointer :: current_gr_patch (:) ! (gC/m2/s) growth resp for new growth displayed in this timestep
- real(r8), pointer :: transfer_gr_patch (:) ! (gC/m2/s) growth resp for transfer growth displayed in this timestep
- real(r8), pointer :: storage_gr_patch (:) ! (gC/m2/s) growth resp for growth sent to storage for later display
- real(r8), pointer :: plant_calloc_patch (:) ! (gC/m2/s) total allocated C flux
- real(r8), pointer :: excess_cflux_patch (:) ! (gC/m2/s) C flux not allocated due to downregulation
- real(r8), pointer :: prev_leafc_to_litter_patch (:) ! (gC/m2/s) previous timestep leaf C litterfall flux
- real(r8), pointer :: prev_frootc_to_litter_patch (:) ! (gC/m2/s) previous timestep froot C litterfall flux
- real(r8), pointer :: availc_patch (:) ! (gC/m2/s) C flux available for allocation
- real(r8), pointer :: xsmrpool_recover_patch (:) ! (gC/m2/s) C flux assigned to recovery of negative cpool
- real(r8), pointer :: xsmrpool_c13ratio_patch (:) ! C13/C(12+13) ratio for xsmrpool (proportion)
-
- real(r8), pointer :: cwdc_hr_col (:) ! (gC/m2/s) col-level coarse woody debris C heterotrophic respiration
- real(r8), pointer :: cwdc_loss_col (:) ! (gC/m2/s) col-level coarse woody debris C loss
- real(r8), pointer :: litterc_loss_col (:) ! (gC/m2/s) col-level litter C loss
- real(r8), pointer :: frootc_alloc_patch (:) ! (gC/m2/s) patch-level fine root C alloc
- real(r8), pointer :: frootc_loss_patch (:) ! (gC/m2/s) patch-level fine root C loss
- real(r8), pointer :: leafc_alloc_patch (:) ! (gC/m2/s) patch-level leaf C alloc
- real(r8), pointer :: leafc_loss_patch (:) ! (gC/m2/s) patch-level leaf C loss
- real(r8), pointer :: woodc_alloc_patch (:) ! (gC/m2/s) patch-level wood C alloc
- real(r8), pointer :: woodc_loss_patch (:) ! (gC/m2/s) patch-level wood C loss
-
- real(r8), pointer :: gpp_patch (:) ! (gC/m2/s) patch gross primary production
- real(r8), pointer :: gpp_col (:) ! (gC/m2/s) column GPP flux before downregulation (p2c)
- real(r8), pointer :: rr_patch (:) ! (gC/m2/s) root respiration (fine root MR + total root GR)
- real(r8), pointer :: rr_col (:) ! (gC/m2/s) root respiration (fine root MR + total root GR) (p2c)
- real(r8), pointer :: mr_patch (:) ! (gC/m2/s) maintenance respiration
- real(r8), pointer :: gr_patch (:) ! (gC/m2/s) total growth respiration
- real(r8), pointer :: ar_patch (:) ! (gC/m2/s) patch autotrophic respiration (MR + GR)
- real(r8), pointer :: ar_col (:) ! (gC/m2/s) column autotrophic respiration (MR + GR) (p2c)
- real(r8), pointer :: npp_patch (:) ! (gC/m2/s) patch net primary production
- real(r8), pointer :: npp_col (:) ! (gC/m2/s) column net primary production (p2c)
- real(r8), pointer :: agnpp_patch (:) ! (gC/m2/s) aboveground NPP
- real(r8), pointer :: bgnpp_patch (:) ! (gC/m2/s) belowground NPP
- real(r8), pointer :: litfall_patch (:) ! (gC/m2/s) patch litterfall (leaves and fine roots)
- real(r8), pointer :: wood_harvestc_patch (:) ! (gC/m2/s) patch-level wood harvest (to product pools)
- real(r8), pointer :: wood_harvestc_col (:) ! (gC/m2/s) column-level wood harvest (to product pools) (p2c)
- real(r8), pointer :: slash_harvestc_patch (:) ! (gC/m2/s) patch-level slash from harvest (to litter)
- real(r8), pointer :: cinputs_patch (:) ! (gC/m2/s) patch-level carbon inputs (for balance checking)
- real(r8), pointer :: coutputs_patch (:) ! (gC/m2/s) patch-level carbon outputs (for balance checking)
- real(r8), pointer :: sr_col (:) ! (gC/m2/s) total soil respiration (HR + root resp)
- real(r8), pointer :: er_col (:) ! (gC/m2/s) total ecosystem respiration, autotrophic + heterotrophic
- real(r8), pointer :: litfire_col (:) ! (gC/m2/s) litter fire losses
- real(r8), pointer :: somfire_col (:) ! (gC/m2/s) soil organic matter fire losses
- real(r8), pointer :: totfire_col (:) ! (gC/m2/s) total ecosystem fire losses
- real(r8), pointer :: hrv_xsmrpool_to_atm_col (:) ! (gC/m2/s) excess MR pool harvest mortality (p2c)
-
- ! fire code
- real(r8), pointer :: fire_closs_patch (:) ! (gC/m2/s) total fire C loss
- real(r8), pointer :: fire_closs_p2c_col (:) ! (gC/m2/s) patch2col averaged column-level fire C loss (p2c)
- real(r8), pointer :: fire_closs_col (:) ! (gC/m2/s) total patch-level fire C loss
-
- ! temporary and annual sums
- real(r8), pointer :: tempsum_litfall_patch (:) ! (gC/m2/yr) temporary annual sum of litfall (CNDV only for now)
- real(r8), pointer :: annsum_litfall_patch (:) ! (gC/m2/yr) annual sum of litfall (CNDV only for now)
- real(r8), pointer :: tempsum_npp_patch (:) ! (gC/m2/yr) temporary annual sum of NPP
- real(r8), pointer :: annsum_npp_patch (:) ! (gC/m2/yr) annual sum of NPP
- real(r8), pointer :: annsum_npp_col (:) ! (gC/m2/yr) annual sum of NPP, averaged from patch-level
- real(r8), pointer :: lag_npp_col (:) ! (gC/m2/yr) lagged net primary production
-
- ! Summary C fluxes.
- real(r8), pointer :: nep_col (:) ! (gC/m2/s) net ecosystem production, excludes fire, landuse, and harvest flux, positive for sink
- real(r8), pointer :: nbp_grc (:) ! (gC/m2/s) net biome production, includes fire, landuse, harvest and hrv_xsmrpool flux, positive for sink (same as net carbon exchange between land and atmosphere)
- real(r8), pointer :: nee_grc (:) ! (gC/m2/s) net ecosystem exchange of carbon, includes fire and hrv_xsmrpool, excludes landuse and harvest flux, positive for source
-
- ! Dynamic landcover fluxnes
- real(r8), pointer :: landuseflux_grc(:) ! (gC/m2/s) dwt_conv_cflux+product_closs
- real(r8), pointer :: npp_Nactive_patch (:) ! C used by mycorrhizal uptake (gC/m2/s)
- real(r8), pointer :: npp_burnedoff_patch (:) ! C that cannot be used for N uptake (gC/m2/s)
- real(r8), pointer :: npp_Nnonmyc_patch (:) ! C used by non-myc uptake (gC/m2/s)
- real(r8), pointer :: npp_Nam_patch (:) ! C used by AM plant (gC/m2/s)
- real(r8), pointer :: npp_Necm_patch (:) ! C used by ECM plant (gC/m2/s)
- real(r8), pointer :: npp_Nactive_no3_patch (:) ! C used by mycorrhizal uptake (gC/m2/s)
- real(r8), pointer :: npp_Nactive_nh4_patch (:) ! C used by mycorrhizal uptake (gC/m2/s)
- real(r8), pointer :: npp_Nnonmyc_no3_patch (:) ! C used by non-myc (gC/m2/s)
- real(r8), pointer :: npp_Nnonmyc_nh4_patch (:) ! C used by non-myc (gC/m2/s)
- real(r8), pointer :: npp_Nam_no3_patch (:) ! C used by AM plant (gC/m2/s)
- real(r8), pointer :: npp_Nam_nh4_patch (:) ! C used by AM plant (gC/m2/s)
- real(r8), pointer :: npp_Necm_no3_patch (:) ! C used by ECM plant (gC/m2/s)
- real(r8), pointer :: npp_Necm_nh4_patch (:) ! C used by ECM plant (gC/m2/s)
- real(r8), pointer :: npp_Nfix_patch (:) ! C used by Symbiotic BNF (gC/m2/s)
- real(r8), pointer :: npp_Nretrans_patch (:) ! C used by retranslocation (gC/m2/s)
- real(r8), pointer :: npp_Nuptake_patch (:) ! Total C used by N uptake in FUN (gC/m2/s)
- real(r8), pointer :: npp_growth_patch (:) ! Total C u for growth in FUN (gC/m2/s)
- real(r8), pointer :: leafc_change_patch (:) ! Total used C from leaves (gC/m2/s)
- real(r8), pointer :: soilc_change_patch (:) ! Total used C from soil (gC/m2/s)
-
- contains
-
- procedure , public :: Init
- procedure , private :: InitAllocate
- procedure , private :: InitHistory
- procedure , private :: InitCold
- procedure , public :: Restart
- procedure , private :: RestartBulkOnly ! Handle restart fields only present for bulk C
- procedure , private :: RestartAllIsotopes ! Handle restart fields present for both bulk C and isotopes
- procedure , public :: SetValues
-
- end type cnveg_carbonflux_type
-
- character(len=*), parameter, private :: sourcefile = &
- __FILE__
- !------------------------------------------------------------------------
-
-contains
-
- !------------------------------------------------------------------------
- subroutine Init(this, bounds, carbon_type)
-
- class(cnveg_carbonflux_type) :: this
- type(bounds_type), intent(in) :: bounds
- character(len=3) , intent(in) :: carbon_type ! one of ['c12', c13','c14']
-
- call this%InitAllocate ( bounds, carbon_type)
- call this%InitHistory ( bounds, carbon_type )
- call this%InitCold (bounds )
-
- end subroutine Init
-
- !------------------------------------------------------------------------
- subroutine InitAllocate(this, bounds, carbon_type)
- !
- ! !ARGUMENTS:
- class (cnveg_carbonflux_type) :: this
- type(bounds_type), intent(in) :: bounds
- character(len=*) , intent(in) :: carbon_type ! one of ['c12', c13','c14']
- !
- ! !LOCAL VARIABLES:
- integer :: begp,endp
- integer :: begc,endc
- integer :: begg,endg
- character(len=:), allocatable :: carbon_type_suffix
- !------------------------------------------------------------------------
-
- begp = bounds%begp; endp = bounds%endp
- begc = bounds%begc; endc = bounds%endc
- begg = bounds%begg; endg = bounds%endg
-
- allocate(this%m_leafc_to_litter_patch (begp:endp)) ; this%m_leafc_to_litter_patch (:) = nan
- allocate(this%m_frootc_to_litter_patch (begp:endp)) ; this%m_frootc_to_litter_patch (:) = nan
- allocate(this%m_leafc_storage_to_litter_patch (begp:endp)) ; this%m_leafc_storage_to_litter_patch (:) = nan
- allocate(this%m_frootc_storage_to_litter_patch (begp:endp)) ; this%m_frootc_storage_to_litter_patch (:) = nan
- allocate(this%m_livestemc_storage_to_litter_patch (begp:endp)) ; this%m_livestemc_storage_to_litter_patch (:) = nan
- allocate(this%m_deadstemc_storage_to_litter_patch (begp:endp)) ; this%m_deadstemc_storage_to_litter_patch (:) = nan
- allocate(this%m_livecrootc_storage_to_litter_patch (begp:endp)) ; this%m_livecrootc_storage_to_litter_patch (:) = nan
- allocate(this%m_deadcrootc_storage_to_litter_patch (begp:endp)) ; this%m_deadcrootc_storage_to_litter_patch (:) = nan
- allocate(this%m_leafc_xfer_to_litter_patch (begp:endp)) ; this%m_leafc_xfer_to_litter_patch (:) = nan
- allocate(this%m_frootc_xfer_to_litter_patch (begp:endp)) ; this%m_frootc_xfer_to_litter_patch (:) = nan
- allocate(this%m_livestemc_xfer_to_litter_patch (begp:endp)) ; this%m_livestemc_xfer_to_litter_patch (:) = nan
- allocate(this%m_deadstemc_xfer_to_litter_patch (begp:endp)) ; this%m_deadstemc_xfer_to_litter_patch (:) = nan
- allocate(this%m_livecrootc_xfer_to_litter_patch (begp:endp)) ; this%m_livecrootc_xfer_to_litter_patch (:) = nan
- allocate(this%m_deadcrootc_xfer_to_litter_patch (begp:endp)) ; this%m_deadcrootc_xfer_to_litter_patch (:) = nan
- allocate(this%m_livestemc_to_litter_patch (begp:endp)) ; this%m_livestemc_to_litter_patch (:) = nan
- allocate(this%m_deadstemc_to_litter_patch (begp:endp)) ; this%m_deadstemc_to_litter_patch (:) = nan
- allocate(this%m_livecrootc_to_litter_patch (begp:endp)) ; this%m_livecrootc_to_litter_patch (:) = nan
- allocate(this%m_deadcrootc_to_litter_patch (begp:endp)) ; this%m_deadcrootc_to_litter_patch (:) = nan
- allocate(this%m_gresp_storage_to_litter_patch (begp:endp)) ; this%m_gresp_storage_to_litter_patch (:) = nan
- allocate(this%m_gresp_xfer_to_litter_patch (begp:endp)) ; this%m_gresp_xfer_to_litter_patch (:) = nan
- allocate(this%hrv_leafc_to_litter_patch (begp:endp)) ; this%hrv_leafc_to_litter_patch (:) = nan
- allocate(this%hrv_leafc_storage_to_litter_patch (begp:endp)) ; this%hrv_leafc_storage_to_litter_patch (:) = nan
- allocate(this%hrv_leafc_xfer_to_litter_patch (begp:endp)) ; this%hrv_leafc_xfer_to_litter_patch (:) = nan
- allocate(this%hrv_frootc_to_litter_patch (begp:endp)) ; this%hrv_frootc_to_litter_patch (:) = nan
- allocate(this%hrv_frootc_storage_to_litter_patch (begp:endp)) ; this%hrv_frootc_storage_to_litter_patch (:) = nan
- allocate(this%hrv_frootc_xfer_to_litter_patch (begp:endp)) ; this%hrv_frootc_xfer_to_litter_patch (:) = nan
- allocate(this%hrv_livestemc_to_litter_patch (begp:endp)) ; this%hrv_livestemc_to_litter_patch (:) = nan
- allocate(this%hrv_livestemc_storage_to_litter_patch (begp:endp)) ; this%hrv_livestemc_storage_to_litter_patch (:) = nan
- allocate(this%hrv_livestemc_xfer_to_litter_patch (begp:endp)) ; this%hrv_livestemc_xfer_to_litter_patch (:) = nan
- allocate(this%hrv_deadstemc_storage_to_litter_patch (begp:endp)) ; this%hrv_deadstemc_storage_to_litter_patch (:) = nan
- allocate(this%hrv_deadstemc_xfer_to_litter_patch (begp:endp)) ; this%hrv_deadstemc_xfer_to_litter_patch (:) = nan
- allocate(this%hrv_livecrootc_to_litter_patch (begp:endp)) ; this%hrv_livecrootc_to_litter_patch (:) = nan
- allocate(this%hrv_livecrootc_storage_to_litter_patch (begp:endp)) ; this%hrv_livecrootc_storage_to_litter_patch (:) = nan
- allocate(this%hrv_livecrootc_xfer_to_litter_patch (begp:endp)) ; this%hrv_livecrootc_xfer_to_litter_patch (:) = nan
- allocate(this%hrv_deadcrootc_to_litter_patch (begp:endp)) ; this%hrv_deadcrootc_to_litter_patch (:) = nan
- allocate(this%hrv_deadcrootc_storage_to_litter_patch (begp:endp)) ; this%hrv_deadcrootc_storage_to_litter_patch (:) = nan
- allocate(this%hrv_deadcrootc_xfer_to_litter_patch (begp:endp)) ; this%hrv_deadcrootc_xfer_to_litter_patch (:) = nan
- allocate(this%hrv_gresp_storage_to_litter_patch (begp:endp)) ; this%hrv_gresp_storage_to_litter_patch (:) = nan
- allocate(this%hrv_gresp_xfer_to_litter_patch (begp:endp)) ; this%hrv_gresp_xfer_to_litter_patch (:) = nan
- allocate(this%hrv_xsmrpool_to_atm_patch (begp:endp)) ; this%hrv_xsmrpool_to_atm_patch (:) = nan
- allocate(this%m_leafc_to_fire_patch (begp:endp)) ; this%m_leafc_to_fire_patch (:) = nan
- allocate(this%m_leafc_storage_to_fire_patch (begp:endp)) ; this%m_leafc_storage_to_fire_patch (:) = nan
- allocate(this%m_leafc_xfer_to_fire_patch (begp:endp)) ; this%m_leafc_xfer_to_fire_patch (:) = nan
- allocate(this%m_livestemc_to_fire_patch (begp:endp)) ; this%m_livestemc_to_fire_patch (:) = nan
- allocate(this%m_livestemc_storage_to_fire_patch (begp:endp)) ; this%m_livestemc_storage_to_fire_patch (:) = nan
- allocate(this%m_livestemc_xfer_to_fire_patch (begp:endp)) ; this%m_livestemc_xfer_to_fire_patch (:) = nan
- allocate(this%m_deadstemc_to_fire_patch (begp:endp)) ; this%m_deadstemc_to_fire_patch (:) = nan
- allocate(this%m_deadstemc_storage_to_fire_patch (begp:endp)) ; this%m_deadstemc_storage_to_fire_patch (:) = nan
- allocate(this%m_deadstemc_xfer_to_fire_patch (begp:endp)) ; this%m_deadstemc_xfer_to_fire_patch (:) = nan
- allocate(this%m_frootc_to_fire_patch (begp:endp)) ; this%m_frootc_to_fire_patch (:) = nan
- allocate(this%m_frootc_storage_to_fire_patch (begp:endp)) ; this%m_frootc_storage_to_fire_patch (:) = nan
- allocate(this%m_frootc_xfer_to_fire_patch (begp:endp)) ; this%m_frootc_xfer_to_fire_patch (:) = nan
- allocate(this%m_livecrootc_to_fire_patch (begp:endp)) ; this%m_livecrootc_to_fire_patch (:) = nan
- allocate(this%m_livecrootc_storage_to_fire_patch (begp:endp)) ; this%m_livecrootc_storage_to_fire_patch (:) = nan
- allocate(this%m_livecrootc_xfer_to_fire_patch (begp:endp)) ; this%m_livecrootc_xfer_to_fire_patch (:) = nan
- allocate(this%m_deadcrootc_to_fire_patch (begp:endp)) ; this%m_deadcrootc_to_fire_patch (:) = nan
- allocate(this%m_deadcrootc_storage_to_fire_patch (begp:endp)) ; this%m_deadcrootc_storage_to_fire_patch (:) = nan
- allocate(this%m_deadcrootc_xfer_to_fire_patch (begp:endp)) ; this%m_deadcrootc_xfer_to_fire_patch (:) = nan
- allocate(this%m_gresp_storage_to_fire_patch (begp:endp)) ; this%m_gresp_storage_to_fire_patch (:) = nan
- allocate(this%m_gresp_xfer_to_fire_patch (begp:endp)) ; this%m_gresp_xfer_to_fire_patch (:) = nan
- allocate(this%m_leafc_to_litter_fire_patch (begp:endp)) ; this%m_leafc_to_litter_fire_patch (:) = nan
- allocate(this%m_leafc_storage_to_litter_fire_patch (begp:endp)) ; this%m_leafc_storage_to_litter_fire_patch (:) = nan
- allocate(this%m_leafc_xfer_to_litter_fire_patch (begp:endp)) ; this%m_leafc_xfer_to_litter_fire_patch (:) = nan
- allocate(this%m_livestemc_to_litter_fire_patch (begp:endp)) ; this%m_livestemc_to_litter_fire_patch (:) = nan
- allocate(this%m_livestemc_storage_to_litter_fire_patch (begp:endp)) ; this%m_livestemc_storage_to_litter_fire_patch (:) = nan
- allocate(this%m_livestemc_xfer_to_litter_fire_patch (begp:endp)) ; this%m_livestemc_xfer_to_litter_fire_patch (:) = nan
- allocate(this%m_livestemc_to_deadstemc_fire_patch (begp:endp)) ; this%m_livestemc_to_deadstemc_fire_patch (:) = nan
- allocate(this%m_deadstemc_to_litter_fire_patch (begp:endp)) ; this%m_deadstemc_to_litter_fire_patch (:) = nan
- allocate(this%m_deadstemc_storage_to_litter_fire_patch (begp:endp)) ; this%m_deadstemc_storage_to_litter_fire_patch (:) = nan
- allocate(this%m_deadstemc_xfer_to_litter_fire_patch (begp:endp)) ; this%m_deadstemc_xfer_to_litter_fire_patch (:) = nan
- allocate(this%m_frootc_to_litter_fire_patch (begp:endp)) ; this%m_frootc_to_litter_fire_patch (:) = nan
- allocate(this%m_frootc_storage_to_litter_fire_patch (begp:endp)) ; this%m_frootc_storage_to_litter_fire_patch (:) = nan
- allocate(this%m_frootc_xfer_to_litter_fire_patch (begp:endp)) ; this%m_frootc_xfer_to_litter_fire_patch (:) = nan
- allocate(this%m_livecrootc_to_litter_fire_patch (begp:endp)) ; this%m_livecrootc_to_litter_fire_patch (:) = nan
- allocate(this%m_livecrootc_storage_to_litter_fire_patch (begp:endp)) ; this%m_livecrootc_storage_to_litter_fire_patch (:) = nan
- allocate(this%m_livecrootc_xfer_to_litter_fire_patch (begp:endp)) ; this%m_livecrootc_xfer_to_litter_fire_patch (:) = nan
- allocate(this%m_livecrootc_to_deadcrootc_fire_patch (begp:endp)) ; this%m_livecrootc_to_deadcrootc_fire_patch (:) = nan
- allocate(this%m_deadcrootc_to_litter_fire_patch (begp:endp)) ; this%m_deadcrootc_to_litter_fire_patch (:) = nan
- allocate(this%m_deadcrootc_storage_to_litter_fire_patch (begp:endp)) ; this%m_deadcrootc_storage_to_litter_fire_patch (:) = nan
- allocate(this%m_deadcrootc_xfer_to_litter_fire_patch (begp:endp)) ; this%m_deadcrootc_xfer_to_litter_fire_patch (:) = nan
- allocate(this%m_gresp_storage_to_litter_fire_patch (begp:endp)) ; this%m_gresp_storage_to_litter_fire_patch (:) = nan
- allocate(this%m_gresp_xfer_to_litter_fire_patch (begp:endp)) ; this%m_gresp_xfer_to_litter_fire_patch (:) = nan
- allocate(this%leafc_xfer_to_leafc_patch (begp:endp)) ; this%leafc_xfer_to_leafc_patch (:) = nan
- allocate(this%frootc_xfer_to_frootc_patch (begp:endp)) ; this%frootc_xfer_to_frootc_patch (:) = nan
- allocate(this%livestemc_xfer_to_livestemc_patch (begp:endp)) ; this%livestemc_xfer_to_livestemc_patch (:) = nan
- allocate(this%deadstemc_xfer_to_deadstemc_patch (begp:endp)) ; this%deadstemc_xfer_to_deadstemc_patch (:) = nan
- allocate(this%livecrootc_xfer_to_livecrootc_patch (begp:endp)) ; this%livecrootc_xfer_to_livecrootc_patch (:) = nan
- allocate(this%deadcrootc_xfer_to_deadcrootc_patch (begp:endp)) ; this%deadcrootc_xfer_to_deadcrootc_patch (:) = nan
- allocate(this%leafc_to_litter_patch (begp:endp)) ; this%leafc_to_litter_patch (:) = nan
- allocate(this%leafc_to_litter_fun_patch (begp:endp)) ; this%leafc_to_litter_fun_patch (:) = nan
- allocate(this%frootc_to_litter_patch (begp:endp)) ; this%frootc_to_litter_patch (:) = nan
- allocate(this%cpool_to_resp_patch (begp:endp)) ; this%cpool_to_resp_patch (:) = nan
- allocate(this%cpool_to_leafc_resp_patch (begp:endp)) ; this%cpool_to_leafc_resp_patch (:) = nan
- allocate(this%cpool_to_leafc_storage_resp_patch (begp:endp)) ; this%cpool_to_leafc_storage_resp_patch (:) = nan
- allocate(this%cpool_to_frootc_resp_patch (begp:endp)) ; this%cpool_to_frootc_resp_patch (:) = nan
- allocate(this%cpool_to_frootc_storage_resp_patch (begp:endp)) ; this%cpool_to_frootc_storage_resp_patch (:) = nan
- allocate(this%cpool_to_livecrootc_resp_patch (begp:endp)) ; this%cpool_to_livecrootc_resp_patch (:) = nan
- allocate(this%cpool_to_livecrootc_storage_resp_patch (begp:endp)) ; this%cpool_to_livecrootc_storage_resp_patch (:) = nan
- allocate(this%cpool_to_livestemc_resp_patch (begp:endp)) ; this%cpool_to_livestemc_resp_patch (:) = nan
- allocate(this%cpool_to_livestemc_storage_resp_patch (begp:endp)) ; this%cpool_to_livestemc_storage_resp_patch (:) = nan
- allocate(this%leaf_mr_patch (begp:endp)) ; this%leaf_mr_patch (:) = nan
- allocate(this%froot_mr_patch (begp:endp)) ; this%froot_mr_patch (:) = nan
- allocate(this%livestem_mr_patch (begp:endp)) ; this%livestem_mr_patch (:) = nan
- allocate(this%livecroot_mr_patch (begp:endp)) ; this%livecroot_mr_patch (:) = nan
- allocate(this%grain_mr_patch (begp:endp)) ; this%grain_mr_patch (:) = nan
- allocate(this%leaf_curmr_patch (begp:endp)) ; this%leaf_curmr_patch (:) = nan
- allocate(this%froot_curmr_patch (begp:endp)) ; this%froot_curmr_patch (:) = nan
- allocate(this%livestem_curmr_patch (begp:endp)) ; this%livestem_curmr_patch (:) = nan
- allocate(this%livecroot_curmr_patch (begp:endp)) ; this%livecroot_curmr_patch (:) = nan
- allocate(this%grain_curmr_patch (begp:endp)) ; this%grain_curmr_patch (:) = nan
- allocate(this%leaf_xsmr_patch (begp:endp)) ; this%leaf_xsmr_patch (:) = nan
- allocate(this%froot_xsmr_patch (begp:endp)) ; this%froot_xsmr_patch (:) = nan
- allocate(this%livestem_xsmr_patch (begp:endp)) ; this%livestem_xsmr_patch (:) = nan
- allocate(this%livecroot_xsmr_patch (begp:endp)) ; this%livecroot_xsmr_patch (:) = nan
- allocate(this%grain_xsmr_patch (begp:endp)) ; this%grain_xsmr_patch (:) = nan
- allocate(this%psnsun_to_cpool_patch (begp:endp)) ; this%psnsun_to_cpool_patch (:) = nan
- allocate(this%psnshade_to_cpool_patch (begp:endp)) ; this%psnshade_to_cpool_patch (:) = nan
- allocate(this%cpool_to_xsmrpool_patch (begp:endp)) ; this%cpool_to_xsmrpool_patch (:) = nan
- allocate(this%cpool_to_leafc_patch (begp:endp)) ; this%cpool_to_leafc_patch (:) = nan
- allocate(this%cpool_to_leafc_storage_patch (begp:endp)) ; this%cpool_to_leafc_storage_patch (:) = nan
- allocate(this%cpool_to_frootc_patch (begp:endp)) ; this%cpool_to_frootc_patch (:) = nan
- allocate(this%cpool_to_frootc_storage_patch (begp:endp)) ; this%cpool_to_frootc_storage_patch (:) = nan
- allocate(this%cpool_to_livestemc_patch (begp:endp)) ; this%cpool_to_livestemc_patch (:) = nan
- allocate(this%cpool_to_livestemc_storage_patch (begp:endp)) ; this%cpool_to_livestemc_storage_patch (:) = nan
- allocate(this%cpool_to_deadstemc_patch (begp:endp)) ; this%cpool_to_deadstemc_patch (:) = nan
- allocate(this%cpool_to_deadstemc_storage_patch (begp:endp)) ; this%cpool_to_deadstemc_storage_patch (:) = nan
- allocate(this%cpool_to_livecrootc_patch (begp:endp)) ; this%cpool_to_livecrootc_patch (:) = nan
- allocate(this%cpool_to_livecrootc_storage_patch (begp:endp)) ; this%cpool_to_livecrootc_storage_patch (:) = nan
- allocate(this%cpool_to_deadcrootc_patch (begp:endp)) ; this%cpool_to_deadcrootc_patch (:) = nan
- allocate(this%cpool_to_deadcrootc_storage_patch (begp:endp)) ; this%cpool_to_deadcrootc_storage_patch (:) = nan
- allocate(this%cpool_to_gresp_storage_patch (begp:endp)) ; this%cpool_to_gresp_storage_patch (:) = nan
- allocate(this%cpool_leaf_gr_patch (begp:endp)) ; this%cpool_leaf_gr_patch (:) = nan
- allocate(this%cpool_leaf_storage_gr_patch (begp:endp)) ; this%cpool_leaf_storage_gr_patch (:) = nan
- allocate(this%transfer_leaf_gr_patch (begp:endp)) ; this%transfer_leaf_gr_patch (:) = nan
- allocate(this%cpool_froot_gr_patch (begp:endp)) ; this%cpool_froot_gr_patch (:) = nan
- allocate(this%cpool_froot_storage_gr_patch (begp:endp)) ; this%cpool_froot_storage_gr_patch (:) = nan
- allocate(this%transfer_froot_gr_patch (begp:endp)) ; this%transfer_froot_gr_patch (:) = nan
- allocate(this%cpool_livestem_gr_patch (begp:endp)) ; this%cpool_livestem_gr_patch (:) = nan
- allocate(this%cpool_livestem_storage_gr_patch (begp:endp)) ; this%cpool_livestem_storage_gr_patch (:) = nan
- allocate(this%transfer_livestem_gr_patch (begp:endp)) ; this%transfer_livestem_gr_patch (:) = nan
- allocate(this%cpool_deadstem_gr_patch (begp:endp)) ; this%cpool_deadstem_gr_patch (:) = nan
- allocate(this%cpool_deadstem_storage_gr_patch (begp:endp)) ; this%cpool_deadstem_storage_gr_patch (:) = nan
- allocate(this%transfer_deadstem_gr_patch (begp:endp)) ; this%transfer_deadstem_gr_patch (:) = nan
- allocate(this%cpool_livecroot_gr_patch (begp:endp)) ; this%cpool_livecroot_gr_patch (:) = nan
- allocate(this%cpool_livecroot_storage_gr_patch (begp:endp)) ; this%cpool_livecroot_storage_gr_patch (:) = nan
- allocate(this%transfer_livecroot_gr_patch (begp:endp)) ; this%transfer_livecroot_gr_patch (:) = nan
- allocate(this%cpool_deadcroot_gr_patch (begp:endp)) ; this%cpool_deadcroot_gr_patch (:) = nan
- allocate(this%cpool_deadcroot_storage_gr_patch (begp:endp)) ; this%cpool_deadcroot_storage_gr_patch (:) = nan
- allocate(this%transfer_deadcroot_gr_patch (begp:endp)) ; this%transfer_deadcroot_gr_patch (:) = nan
- allocate(this%leafc_storage_to_xfer_patch (begp:endp)) ; this%leafc_storage_to_xfer_patch (:) = nan
- allocate(this%frootc_storage_to_xfer_patch (begp:endp)) ; this%frootc_storage_to_xfer_patch (:) = nan
- allocate(this%livestemc_storage_to_xfer_patch (begp:endp)) ; this%livestemc_storage_to_xfer_patch (:) = nan
- allocate(this%deadstemc_storage_to_xfer_patch (begp:endp)) ; this%deadstemc_storage_to_xfer_patch (:) = nan
- allocate(this%livecrootc_storage_to_xfer_patch (begp:endp)) ; this%livecrootc_storage_to_xfer_patch (:) = nan
- allocate(this%deadcrootc_storage_to_xfer_patch (begp:endp)) ; this%deadcrootc_storage_to_xfer_patch (:) = nan
- allocate(this%gresp_storage_to_xfer_patch (begp:endp)) ; this%gresp_storage_to_xfer_patch (:) = nan
- allocate(this%livestemc_to_deadstemc_patch (begp:endp)) ; this%livestemc_to_deadstemc_patch (:) = nan
- allocate(this%livecrootc_to_deadcrootc_patch (begp:endp)) ; this%livecrootc_to_deadcrootc_patch (:) = nan
- allocate(this%current_gr_patch (begp:endp)) ; this%current_gr_patch (:) = nan
- allocate(this%transfer_gr_patch (begp:endp)) ; this%transfer_gr_patch (:) = nan
- allocate(this%storage_gr_patch (begp:endp)) ; this%storage_gr_patch (:) = nan
- allocate(this%plant_calloc_patch (begp:endp)) ; this%plant_calloc_patch (:) = nan
- allocate(this%excess_cflux_patch (begp:endp)) ; this%excess_cflux_patch (:) = nan
- allocate(this%prev_leafc_to_litter_patch (begp:endp)) ; this%prev_leafc_to_litter_patch (:) = nan
- allocate(this%prev_frootc_to_litter_patch (begp:endp)) ; this%prev_frootc_to_litter_patch (:) = nan
- allocate(this%gpp_before_downreg_patch (begp:endp)) ; this%gpp_before_downreg_patch (:) = nan
- allocate(this%availc_patch (begp:endp)) ; this%availc_patch (:) = nan
- allocate(this%xsmrpool_recover_patch (begp:endp)) ; this%xsmrpool_recover_patch (:) = nan
- allocate(this%xsmrpool_c13ratio_patch (begp:endp)) ; this%xsmrpool_c13ratio_patch (:) = nan
-
- allocate(this%cpool_to_grainc_patch (begp:endp)) ; this%cpool_to_grainc_patch (:) = nan
- allocate(this%cpool_to_grainc_storage_patch (begp:endp)) ; this%cpool_to_grainc_storage_patch (:) = nan
- allocate(this%livestemc_to_litter_patch (begp:endp)) ; this%livestemc_to_litter_patch (:) = nan
- allocate(this%grainc_to_food_patch (begp:endp)) ; this%grainc_to_food_patch (:) = nan
- allocate(this%grainc_to_seed_patch (begp:endp)) ; this%grainc_to_seed_patch (:) = nan
- allocate(this%grainc_xfer_to_grainc_patch (begp:endp)) ; this%grainc_xfer_to_grainc_patch (:) = nan
- allocate(this%cpool_grain_gr_patch (begp:endp)) ; this%cpool_grain_gr_patch (:) = nan
- allocate(this%cpool_grain_storage_gr_patch (begp:endp)) ; this%cpool_grain_storage_gr_patch (:) = nan
- allocate(this%transfer_grain_gr_patch (begp:endp)) ; this%transfer_grain_gr_patch (:) = nan
- allocate(this%xsmrpool_to_atm_patch (begp:endp)) ; this%xsmrpool_to_atm_patch (:) = nan
- allocate(this%grainc_storage_to_xfer_patch (begp:endp)) ; this%grainc_storage_to_xfer_patch (:) = nan
- allocate(this%frootc_alloc_patch (begp:endp)) ; this%frootc_alloc_patch (:) = nan
- allocate(this%frootc_loss_patch (begp:endp)) ; this%frootc_loss_patch (:) = nan
- allocate(this%leafc_alloc_patch (begp:endp)) ; this%leafc_alloc_patch (:) = nan
- allocate(this%leafc_loss_patch (begp:endp)) ; this%leafc_loss_patch (:) = nan
- allocate(this%woodc_alloc_patch (begp:endp)) ; this%woodc_alloc_patch (:) = nan
- allocate(this%woodc_loss_patch (begp:endp)) ; this%woodc_loss_patch (:) = nan
-
- allocate(this%phenology_c_to_litr_met_c_col (begc:endc,1:nlevdecomp_full));
- this%phenology_c_to_litr_met_c_col (:,:)=nan
-
- allocate(this%phenology_c_to_litr_cel_c_col (begc:endc,1:nlevdecomp_full)); this%phenology_c_to_litr_cel_c_col (:,:)=nan
- allocate(this%phenology_c_to_litr_lig_c_col (begc:endc,1:nlevdecomp_full)); this%phenology_c_to_litr_lig_c_col (:,:)=nan
-
- allocate(this%gap_mortality_c_to_litr_met_c_col (begc:endc,1:nlevdecomp_full)); this%gap_mortality_c_to_litr_met_c_col(:,:)=nan
- allocate(this%gap_mortality_c_to_litr_cel_c_col (begc:endc,1:nlevdecomp_full)); this%gap_mortality_c_to_litr_cel_c_col(:,:)=nan
- allocate(this%gap_mortality_c_to_litr_lig_c_col (begc:endc,1:nlevdecomp_full)); this%gap_mortality_c_to_litr_lig_c_col(:,:)=nan
-
- allocate(this%gap_mortality_c_to_cwdc_col (begc:endc,1:nlevdecomp_full)); this%gap_mortality_c_to_cwdc_col (:,:)=nan
- allocate(this%fire_mortality_c_to_cwdc_col (begc:endc,1:nlevdecomp_full)); this%fire_mortality_c_to_cwdc_col (:,:)=nan
- allocate(this%m_c_to_litr_met_fire_col (begc:endc,1:nlevdecomp_full)); this%m_c_to_litr_met_fire_col (:,:)=nan
- allocate(this%m_c_to_litr_cel_fire_col (begc:endc,1:nlevdecomp_full)); this%m_c_to_litr_cel_fire_col (:,:)=nan
- allocate(this%m_c_to_litr_lig_fire_col (begc:endc,1:nlevdecomp_full)); this%m_c_to_litr_lig_fire_col (:,:)=nan
- allocate(this%harvest_c_to_litr_met_c_col (begc:endc,1:nlevdecomp_full)); this%harvest_c_to_litr_met_c_col (:,:)=nan
- allocate(this%harvest_c_to_litr_cel_c_col (begc:endc,1:nlevdecomp_full)); this%harvest_c_to_litr_cel_c_col (:,:)=nan
- allocate(this%harvest_c_to_litr_lig_c_col (begc:endc,1:nlevdecomp_full)); this%harvest_c_to_litr_lig_c_col (:,:)=nan
- allocate(this%harvest_c_to_cwdc_col (begc:endc,1:nlevdecomp_full)); this%harvest_c_to_cwdc_col (:,:)=nan
-
- allocate(this%dwt_slash_cflux_col (begc:endc)) ; this%dwt_slash_cflux_col (:) =nan
- allocate(this%dwt_frootc_to_litr_met_c_col (begc:endc,1:nlevdecomp_full)); this%dwt_frootc_to_litr_met_c_col (:,:)=nan
- allocate(this%dwt_frootc_to_litr_cel_c_col (begc:endc,1:nlevdecomp_full)); this%dwt_frootc_to_litr_cel_c_col (:,:)=nan
- allocate(this%dwt_frootc_to_litr_lig_c_col (begc:endc,1:nlevdecomp_full)); this%dwt_frootc_to_litr_lig_c_col (:,:)=nan
- allocate(this%dwt_livecrootc_to_cwdc_col (begc:endc,1:nlevdecomp_full)); this%dwt_livecrootc_to_cwdc_col (:,:)=nan
- allocate(this%dwt_deadcrootc_to_cwdc_col (begc:endc,1:nlevdecomp_full)); this%dwt_deadcrootc_to_cwdc_col (:,:)=nan
-
- allocate(this%dwt_seedc_to_leaf_patch (begp:endp)) ; this%dwt_seedc_to_leaf_patch (:) =nan
- allocate(this%dwt_seedc_to_leaf_grc (begg:endg)) ; this%dwt_seedc_to_leaf_grc (:) =nan
- allocate(this%dwt_seedc_to_deadstem_patch (begp:endp)) ; this%dwt_seedc_to_deadstem_patch(:) =nan
- allocate(this%dwt_seedc_to_deadstem_grc (begg:endg)) ; this%dwt_seedc_to_deadstem_grc (:) =nan
- allocate(this%dwt_conv_cflux_patch (begp:endp)) ; this%dwt_conv_cflux_patch (:) =nan
- allocate(this%dwt_conv_cflux_grc (begg:endg)) ; this%dwt_conv_cflux_grc (:) =nan
- allocate(this%dwt_conv_cflux_dribbled_grc (begg:endg)) ; this%dwt_conv_cflux_dribbled_grc(:) =nan
- allocate(this%dwt_wood_productc_gain_patch (begp:endp)) ; this%dwt_wood_productc_gain_patch(:) =nan
- allocate(this%dwt_crop_productc_gain_patch (begp:endp)) ; this%dwt_crop_productc_gain_patch(:) =nan
-
- allocate(this%crop_seedc_to_leaf_patch (begp:endp)) ; this%crop_seedc_to_leaf_patch (:) =nan
-
- allocate(this%cwdc_hr_col (begc:endc)) ; this%cwdc_hr_col (:) =nan
- allocate(this%cwdc_loss_col (begc:endc)) ; this%cwdc_loss_col (:) =nan
- allocate(this%litterc_loss_col (begc:endc)) ; this%litterc_loss_col (:) =nan
-
- allocate(this%grainc_to_cropprodc_patch(begp:endp))
- this%grainc_to_cropprodc_patch(:) = nan
-
- allocate(this%grainc_to_cropprodc_col(begc:endc))
- this%grainc_to_cropprodc_col(:) = nan
-
- allocate(this%m_decomp_cpools_to_fire_vr_col(begc:endc,1:nlevdecomp_full,1:ndecomp_pools))
- this%m_decomp_cpools_to_fire_vr_col(:,:,:)= nan
-
- allocate(this%m_decomp_cpools_to_fire_col(begc:endc,1:ndecomp_pools))
- this%m_decomp_cpools_to_fire_col(:,:)= nan
-
- allocate(this%m_decomp_cpools_to_fire_vr_col(begc:endc,1:nlevdecomp_full,1:ndecomp_pools))
- this%m_decomp_cpools_to_fire_vr_col(:,:,:)= nan
-
- allocate(this%m_decomp_cpools_to_fire_col(begc:endc,1:ndecomp_pools))
- this%m_decomp_cpools_to_fire_col(:,:)= nan
-
- allocate(this%rr_patch (begp:endp)) ; this%rr_patch (:) = nan
- allocate(this%mr_patch (begp:endp)) ; this%mr_patch (:) = nan
- allocate(this%gr_patch (begp:endp)) ; this%gr_patch (:) = nan
- allocate(this%ar_patch (begp:endp)) ; this%ar_patch (:) = nan
- allocate(this%npp_patch (begp:endp)) ; this%npp_patch (:) = nan
- allocate(this%agnpp_patch (begp:endp)) ; this%agnpp_patch (:) = nan
- allocate(this%bgnpp_patch (begp:endp)) ; this%bgnpp_patch (:) = nan
- allocate(this%litfall_patch (begp:endp)) ; this%litfall_patch (:) = nan
- allocate(this%wood_harvestc_patch (begp:endp)) ; this%wood_harvestc_patch (:) = nan
- allocate(this%slash_harvestc_patch (begp:endp)) ; this%slash_harvestc_patch (:) = nan
- allocate(this%cinputs_patch (begp:endp)) ; this%cinputs_patch (:) = nan
- allocate(this%coutputs_patch (begp:endp)) ; this%coutputs_patch (:) = nan
- allocate(this%gpp_patch (begp:endp)) ; this%gpp_patch (:) = nan
- allocate(this%fire_closs_patch (begp:endp)) ; this%fire_closs_patch (:) = nan
- allocate(this%sr_col (begc:endc)) ; this%sr_col (:) = nan
- allocate(this%er_col (begc:endc)) ; this%er_col (:) = nan
- allocate(this%litfire_col (begc:endc)) ; this%litfire_col (:) = nan
- allocate(this%somfire_col (begc:endc)) ; this%somfire_col (:) = nan
- allocate(this%totfire_col (begc:endc)) ; this%totfire_col (:) = nan
- allocate(this%rr_col (begc:endc)) ; this%rr_col (:) = nan
- allocate(this%ar_col (begc:endc)) ; this%ar_col (:) = nan
- allocate(this%gpp_col (begc:endc)) ; this%gpp_col (:) = nan
- 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%wood_harvestc_col (begc:endc)) ; this%wood_harvestc_col (:) = nan
- allocate(this%hrv_xsmrpool_to_atm_col (begc:endc)) ; this%hrv_xsmrpool_to_atm_col (:) = nan
- allocate(this%tempsum_npp_patch (begp:endp)) ; this%tempsum_npp_patch (:) = nan
- allocate(this%annsum_npp_patch (begp:endp)) ; this%annsum_npp_patch (:) = nan
- allocate(this%tempsum_litfall_patch (begp:endp)) ; this%tempsum_litfall_patch (:) = nan
- allocate(this%annsum_litfall_patch (begp:endp)) ; this%annsum_litfall_patch (:) = nan
- allocate(this%annsum_npp_col (begc:endc)) ; this%annsum_npp_col (:) = nan
- allocate(this%lag_npp_col (begc:endc)) ; this%lag_npp_col (:) = spval
-
- allocate(this%nep_col (begc:endc)) ; this%nep_col (:) = nan
- allocate(this%nbp_grc (begg:endg)) ; this%nbp_grc (:) = nan
- allocate(this%nee_grc (begg:endg)) ; this%nee_grc (:) = nan
- allocate(this%landuseflux_grc (begg:endg)) ; this%landuseflux_grc (:) = nan
- allocate(this%npp_Nactive_patch (begp:endp)) ; this%npp_Nactive_patch (:) = nan
- allocate(this%npp_burnedoff_patch (begp:endp)) ; this%npp_burnedoff_patch (:) = nan
- allocate(this%npp_Nnonmyc_patch (begp:endp)) ; this%npp_Nnonmyc_patch (:) = nan
- allocate(this%npp_Nam_patch (begp:endp)) ; this%npp_Nam_patch (:) = nan
- allocate(this%npp_Necm_patch (begp:endp)) ; this%npp_Necm_patch (:) = nan
- allocate(this%npp_Nactive_no3_patch (begp:endp)) ; this%npp_Nactive_no3_patch (:) = nan
- allocate(this%npp_Nactive_nh4_patch (begp:endp)) ; this%npp_Nactive_nh4_patch (:) = nan
- allocate(this%npp_Nnonmyc_no3_patch (begp:endp)) ; this%npp_Nnonmyc_no3_patch (:) = nan
- allocate(this%npp_Nnonmyc_nh4_patch (begp:endp)) ; this%npp_Nnonmyc_nh4_patch (:) = nan
- allocate(this%npp_Nam_no3_patch (begp:endp)) ; this%npp_Nam_no3_patch (:) = nan
- allocate(this%npp_Nam_nh4_patch (begp:endp)) ; this%npp_Nam_nh4_patch (:) = nan
- allocate(this%npp_Necm_no3_patch (begp:endp)) ; this%npp_Necm_no3_patch (:) = nan
- allocate(this%npp_Necm_nh4_patch (begp:endp)) ; this%npp_Necm_nh4_patch (:) = nan
- allocate(this%npp_Nfix_patch (begp:endp)) ; this%npp_Nfix_patch (:) = nan
- allocate(this%npp_Nretrans_patch (begp:endp)) ; this%npp_Nretrans_patch (:) = nan
- allocate(this%npp_Nuptake_patch (begp:endp)) ; this%npp_Nuptake_patch (:) = nan
- allocate(this%npp_growth_patch (begp:endp)) ; this%npp_growth_patch (:) = nan
- allocate(this%leafc_change_patch (begp:endp)) ; this%leafc_change_patch (:) = nan
- allocate(this%soilc_change_patch (begp:endp)) ; this%soilc_change_patch (:) = nan
-
- ! Construct restart field names consistently to what is done in SpeciesNonIsotope &
- ! SpeciesIsotope, to aid future migration to that infrastructure
- if (carbon_type == 'c12') then
- carbon_type_suffix = 'c'
- else if (carbon_type == 'c13') then
- carbon_type_suffix = 'c_13'
- else if (carbon_type == 'c14') then
- carbon_type_suffix = 'c_14'
- else
- write(iulog,*) 'CNVegCarbonFluxType InitAllocate: Unknown carbon_type: ', trim(carbon_type)
- call endrun(msg='CNVegCarbonFluxType InitAllocate: Unknown carbon_type: ' // &
- errMsg(sourcefile, __LINE__))
- end if
-
- end subroutine InitAllocate
-
- !------------------------------------------------------------------------
- subroutine InitHistory(this, bounds, carbon_type)
- !
- ! !DESCRIPTION:
- ! add history fields for all CN variables, always set as default='inactive'
- !
- ! !USES:
- use clm_varpar , only : nlevdecomp, nlevdecomp_full, nlevgrnd
- use clm_varctl , only : hist_wrtch4diag
- use CNSharedParamsMod, only: use_fun
- use histFileMod, only : hist_addfld1d, hist_addfld2d, hist_addfld_decomp
- !
- ! !ARGUMENTS:
- class(cnveg_carbonflux_type) :: this
- type(bounds_type) , intent(in) :: bounds
- character(len=3) , intent(in) :: carbon_type ! one of ['c12', c13','c14']
- !
- ! !LOCAL VARIABLES:
- integer :: k,l,ii,jj
- character(8) :: vr_suffix
- character(10) :: active
- integer :: begp,endp
- integer :: begc,endc
- integer :: begg,endg
- character(24) :: fieldname
- character(100) :: longname
- real(r8), pointer :: data1dptr(:) ! temp. pointer for slicing larger arrays
- real(r8), pointer :: data2dptr(:,:) ! temp. pointer for slicing larger arrays
- !---------------------------------------------------------------------
-
- begp = bounds%begp; endp = bounds%endp
- begc = bounds%begc; endc = bounds%endc
- begg = bounds%begg; endg = bounds%endg
-
- if (nlevdecomp > 1) then
- vr_suffix = "_vr"
- else
- vr_suffix = ""
- endif
-
- !-------------------------------
- ! C flux variables - patch
- !-------------------------------
-
- if (carbon_type == 'c12') then
-
- if (use_crop) then
- this%grainc_to_food_patch(begp:endp) = spval
- call hist_addfld1d (fname='GRAINC_TO_FOOD', units='gC/m^2/s', &
- avgflag='A', long_name='grain C to food', &
- ptr_patch=this%grainc_to_food_patch, default='inactive')
-
- this%grainc_to_seed_patch(begp:endp) = spval
- call hist_addfld1d (fname='GRAINC_TO_SEED', units='gC/m^2/s', &
- avgflag='A', long_name='grain C to seed', &
- ptr_patch=this%grainc_to_seed_patch, default='inactive')
- end if
-
- this%litterc_loss_col(begc:endc) = spval
- call hist_addfld1d (fname='LITTERC_LOSS', units='gC/m^2/s', &
- avgflag='A', long_name='litter C loss', &
- ptr_col=this%litterc_loss_col, default='inactive')
-
- this%woodc_alloc_patch(begp:endp) = spval
- call hist_addfld1d (fname='WOODC_ALLOC', units='gC/m^2/s', &
- avgflag='A', long_name='wood C eallocation', &
- ptr_patch=this%woodc_alloc_patch, default='inactive')
-
- this%woodc_loss_patch(begp:endp) = spval
- call hist_addfld1d (fname='WOODC_LOSS', units='gC/m^2/s', &
- avgflag='A', long_name='wood C loss', &
- ptr_patch=this%woodc_loss_patch, default='inactive')
-
- this%leafc_loss_patch(begp:endp) = spval
- call hist_addfld1d (fname='LEAFC_LOSS', units='gC/m^2/s', &
- avgflag='A', long_name='leaf C loss', &
- ptr_patch=this%leafc_loss_patch, default='inactive')
-
- this%leafc_alloc_patch(begp:endp) = spval
- call hist_addfld1d (fname='LEAFC_ALLOC', units='gC/m^2/s', &
- avgflag='A', long_name='leaf C allocation', &
- ptr_patch=this%leafc_alloc_patch, default='inactive')
-
- this%frootc_loss_patch(begp:endp) = spval
- call hist_addfld1d (fname='FROOTC_LOSS', units='gC/m^2/s', &
- avgflag='A', long_name='fine root C loss', &
- ptr_patch=this%frootc_loss_patch, default='inactive')
-
- this%frootc_alloc_patch(begp:endp) = spval
- call hist_addfld1d (fname='FROOTC_ALLOC', units='gC/m^2/s', &
- avgflag='A', long_name='fine root C allocation', &
- ptr_patch=this%frootc_alloc_patch, default='inactive')
-
- this%m_leafc_to_litter_patch(begp:endp) = spval
- call hist_addfld1d (fname='M_LEAFC_TO_LITTER', units='gC/m^2/s', &
- avgflag='A', long_name='leaf C mortality', &
- ptr_patch=this%m_leafc_to_litter_patch, default='inactive')
-
- this%m_frootc_to_litter_patch(begp:endp) = spval
- call hist_addfld1d (fname='M_FROOTC_TO_LITTER', units='gC/m^2/s', &
- avgflag='A', long_name='fine root C mortality', &
- ptr_patch=this%m_frootc_to_litter_patch, default='inactive')
-
- this%m_leafc_storage_to_litter_patch(begp:endp) = spval
- call hist_addfld1d (fname='M_LEAFC_STORAGE_TO_LITTER', units='gC/m^2/s', &
- avgflag='A', long_name='leaf C storage mortality', &
- ptr_patch=this%m_leafc_storage_to_litter_patch, default='inactive')
-
- this%m_frootc_storage_to_litter_patch(begp:endp) = spval
- call hist_addfld1d (fname='M_FROOTC_STORAGE_TO_LITTER', units='gC/m^2/s', &
- avgflag='A', long_name='fine root C storage mortality', &
- ptr_patch=this%m_frootc_storage_to_litter_patch, default='inactive')
-
- this%m_livestemc_storage_to_litter_patch(begp:endp) = spval
- call hist_addfld1d (fname='M_LIVESTEMC_STORAGE_TO_LITTER', units='gC/m^2/s', &
- avgflag='A', long_name='live stem C storage mortality', &
- ptr_patch=this%m_livestemc_storage_to_litter_patch, default='inactive')
-
- this%m_deadstemc_storage_to_litter_patch(begp:endp) = spval
- call hist_addfld1d (fname='M_DEADSTEMC_STORAGE_TO_LITTER', units='gC/m^2/s', &
- avgflag='A', long_name='dead stem C storage mortality', &
- ptr_patch=this%m_deadstemc_storage_to_litter_patch, default='inactive')
-
- this%m_livecrootc_storage_to_litter_patch(begp:endp) = spval
- call hist_addfld1d (fname='M_LIVECROOTC_STORAGE_TO_LITTER', units='gC/m^2/s', &
- avgflag='A', long_name='live coarse root C storage mortality', &
- ptr_patch=this%m_livecrootc_storage_to_litter_patch, default='inactive')
-
- this%m_deadcrootc_storage_to_litter_patch(begp:endp) = spval
- call hist_addfld1d (fname='M_DEADCROOTC_STORAGE_TO_LITTER', units='gC/m^2/s', &
- avgflag='A', long_name='dead coarse root C storage mortality', &
- ptr_patch=this%m_deadcrootc_storage_to_litter_patch, default='inactive')
-
- this%m_leafc_xfer_to_litter_patch(begp:endp) = spval
- call hist_addfld1d (fname='M_LEAFC_XFER_TO_LITTER', units='gC/m^2/s', &
- avgflag='A', long_name='leaf C transfer mortality', &
- ptr_patch=this%m_leafc_xfer_to_litter_patch, default='inactive')
-
- this%m_frootc_xfer_to_litter_patch(begp:endp) = spval
- call hist_addfld1d (fname='M_FROOTC_XFER_TO_LITTER', units='gC/m^2/s', &
- avgflag='A', long_name='fine root C transfer mortality', &
- ptr_patch=this%m_frootc_xfer_to_litter_patch, default='inactive')
-
- this%m_livestemc_xfer_to_litter_patch(begp:endp) = spval
- call hist_addfld1d (fname='M_LIVESTEMC_XFER_TO_LITTER', units='gC/m^2/s', &
- avgflag='A', long_name='live stem C transfer mortality', &
- ptr_patch=this%m_livestemc_xfer_to_litter_patch, default='inactive')
-
- this%m_deadstemc_xfer_to_litter_patch(begp:endp) = spval
- call hist_addfld1d (fname='M_DEADSTEMC_XFER_TO_LITTER', units='gC/m^2/s', &
- avgflag='A', long_name='dead stem C transfer mortality', &
- ptr_patch=this%m_deadstemc_xfer_to_litter_patch, default='inactive')
-
- this%m_livecrootc_xfer_to_litter_patch(begp:endp) = spval
- call hist_addfld1d (fname='M_LIVECROOTC_XFER_TO_LITTER', units='gC/m^2/s', &
- avgflag='A', long_name='live coarse root C transfer mortality', &
- ptr_patch=this%m_livecrootc_xfer_to_litter_patch, default='inactive')
-
- this%m_deadcrootc_xfer_to_litter_patch(begp:endp) = spval
- call hist_addfld1d (fname='M_DEADCROOTC_XFER_TO_LITTER', units='gC/m^2/s', &
- avgflag='A', long_name='dead coarse root C transfer mortality', &
- ptr_patch=this%m_deadcrootc_xfer_to_litter_patch, default='inactive')
-
- this%m_livestemc_to_litter_patch(begp:endp) = spval
- call hist_addfld1d (fname='M_LIVESTEMC_TO_LITTER', units='gC/m^2/s', &
- avgflag='A', long_name='live stem C mortality', &
- ptr_patch=this%m_livestemc_to_litter_patch, default='inactive')
-
- this%m_deadstemc_to_litter_patch(begp:endp) = spval
- call hist_addfld1d (fname='M_DEADSTEMC_TO_LITTER', units='gC/m^2/s', &
- avgflag='A', long_name='dead stem C mortality', &
- ptr_patch=this%m_deadstemc_to_litter_patch, default='inactive')
-
- this%m_livecrootc_to_litter_patch(begp:endp) = spval
- call hist_addfld1d (fname='M_LIVECROOTC_TO_LITTER', units='gC/m^2/s', &
- avgflag='A', long_name='live coarse root C mortality', &
- ptr_patch=this%m_livecrootc_to_litter_patch, default='inactive')
-
- this%m_deadcrootc_to_litter_patch(begp:endp) = spval
- call hist_addfld1d (fname='M_DEADCROOTC_TO_LITTER', units='gC/m^2/s', &
- avgflag='A', long_name='dead coarse root C mortality', &
- ptr_patch=this%m_deadcrootc_to_litter_patch, default='inactive')
-
- this%m_gresp_storage_to_litter_patch(begp:endp) = spval
- call hist_addfld1d (fname='M_GRESP_STORAGE_TO_LITTER', units='gC/m^2/s', &
- avgflag='A', long_name='growth respiration storage mortality', &
- ptr_patch=this%m_gresp_storage_to_litter_patch, default='inactive')
-
- this%m_gresp_xfer_to_litter_patch(begp:endp) = spval
- call hist_addfld1d (fname='M_GRESP_XFER_TO_LITTER', units='gC/m^2/s', &
- avgflag='A', long_name='growth respiration transfer mortality', &
- ptr_patch=this%m_gresp_xfer_to_litter_patch, default='inactive')
-
- this%m_leafc_to_fire_patch(begp:endp) = spval
- call hist_addfld1d (fname='M_LEAFC_TO_FIRE', units='gC/m^2/s', &
- avgflag='A', long_name='leaf C fire loss', &
- ptr_patch=this%m_leafc_to_fire_patch, default='inactive')
-
- this%m_leafc_storage_to_fire_patch(begp:endp) = spval
- call hist_addfld1d (fname='M_LEAFC_STORAGE_TO_FIRE', units='gC/m^2/s', &
- avgflag='A', long_name='leaf C storage fire loss', &
- ptr_patch=this%m_leafc_storage_to_fire_patch, default='inactive')
-
- this%m_leafc_xfer_to_fire_patch(begp:endp) = spval
- call hist_addfld1d (fname='M_LEAFC_XFER_TO_FIRE', units='gC/m^2/s', &
- avgflag='A', long_name='leaf C transfer fire loss', &
- ptr_patch=this%m_leafc_xfer_to_fire_patch, default='inactive')
-
- this%m_livestemc_to_fire_patch(begp:endp) = spval
- call hist_addfld1d (fname='M_LIVESTEMC_TO_FIRE', units='gC/m^2/s', &
- avgflag='A', long_name='live stem C fire loss', &
- ptr_patch=this%m_livestemc_to_fire_patch, default='inactive')
-
- this%m_livestemc_storage_to_fire_patch(begp:endp) = spval
- call hist_addfld1d (fname='M_LIVESTEMC_STORAGE_TO_FIRE', units='gC/m^2/s', &
- avgflag='A', long_name='live stem C storage fire loss', &
- ptr_patch=this%m_livestemc_storage_to_fire_patch, default='inactive')
-
- this%m_livestemc_xfer_to_fire_patch(begp:endp) = spval
- call hist_addfld1d (fname='M_LIVESTEMC_XFER_TO_FIRE', units='gC/m^2/s', &
- avgflag='A', long_name='live stem C transfer fire loss', &
- ptr_patch=this%m_livestemc_xfer_to_fire_patch, default='inactive')
-
- this%m_deadstemc_to_fire_patch(begp:endp) = spval
- call hist_addfld1d (fname='M_DEADSTEMC_TO_FIRE', units='gC/m^2/s', &
- avgflag='A', long_name='dead stem C fire loss', &
- ptr_patch=this%m_deadstemc_to_fire_patch, default='inactive')
-
- this%m_deadstemc_storage_to_fire_patch(begp:endp) = spval
- call hist_addfld1d (fname='M_DEADSTEMC_STORAGE_TO_FIRE', units='gC/m^2/s', &
- avgflag='A', long_name='dead stem C storage fire loss', &
- ptr_patch=this%m_deadstemc_storage_to_fire_patch, default='inactive')
-
- this%m_deadstemc_xfer_to_fire_patch(begp:endp) = spval
- call hist_addfld1d (fname='M_DEADSTEMC_XFER_TO_FIRE', units='gC/m^2/s', &
- avgflag='A', long_name='dead stem C transfer fire loss', &
- ptr_patch=this%m_deadstemc_xfer_to_fire_patch, default='inactive')
-
- this%m_frootc_to_fire_patch(begp:endp) = spval
- call hist_addfld1d (fname='M_FROOTC_TO_FIRE', units='gC/m^2/s', &
- avgflag='A', long_name='fine root C fire loss', &
- ptr_patch=this%m_frootc_to_fire_patch, default='inactive')
-
- this%m_frootc_storage_to_fire_patch(begp:endp) = spval
- call hist_addfld1d (fname='M_FROOTC_STORAGE_TO_FIRE', units='gC/m^2/s', &
- avgflag='A', long_name='fine root C storage fire loss', &
- ptr_patch=this%m_frootc_storage_to_fire_patch, default='inactive')
-
- this%m_frootc_xfer_to_fire_patch(begp:endp) = spval
- call hist_addfld1d (fname='M_FROOTC_XFER_TO_FIRE', units='gC/m^2/s', &
- avgflag='A', long_name='fine root C transfer fire loss', &
- ptr_patch=this%m_frootc_xfer_to_fire_patch, default='inactive')
-
- this%m_livecrootc_to_fire_patch(begp:endp) = spval
- call hist_addfld1d (fname='M_LIVEROOTC_TO_FIRE', units='gC/m^2/s', &
- avgflag='A', long_name='live root C fire loss', &
- ptr_patch=this%m_livecrootc_to_fire_patch, default='inactive')
-
- this%m_livecrootc_storage_to_fire_patch(begp:endp) = spval
- call hist_addfld1d (fname='M_LIVEROOTC_STORAGE_TO_FIRE', units='gC/m^2/s', &
- avgflag='A', long_name='live root C storage fire loss', &
- ptr_patch=this%m_livecrootc_storage_to_fire_patch, default='inactive')
-
- this%m_livecrootc_xfer_to_fire_patch(begp:endp) = spval
- call hist_addfld1d (fname='M_LIVEROOTC_XFER_TO_FIRE', units='gC/m^2/s', &
- avgflag='A', long_name='live root C transfer fire loss', &
- ptr_patch=this%m_livecrootc_xfer_to_fire_patch, default='inactive')
-
- this%m_deadcrootc_to_fire_patch(begp:endp) = spval
- call hist_addfld1d (fname='M_DEADROOTC_TO_FIRE', units='gC/m^2/s', &
- avgflag='A', long_name='dead root C fire loss', &
- ptr_patch=this%m_deadcrootc_to_fire_patch, default='inactive')
-
- this%m_deadcrootc_storage_to_fire_patch(begp:endp) = spval
- call hist_addfld1d (fname='M_DEADROOTC_STORAGE_TO_FIRE', units='gC/m^2/s', &
- avgflag='A', long_name='dead root C storage fire loss', &
- ptr_patch=this%m_deadcrootc_storage_to_fire_patch, default='inactive')
-
- this%m_deadcrootc_xfer_to_fire_patch(begp:endp) = spval
- call hist_addfld1d (fname='M_DEADROOTC_XFER_TO_FIRE', units='gC/m^2/s', &
- avgflag='A', long_name='dead root C transfer fire loss', &
- ptr_patch=this%m_deadcrootc_xfer_to_fire_patch, default='inactive')
-
- this%m_gresp_storage_to_fire_patch(begp:endp) = spval
- call hist_addfld1d (fname='M_GRESP_STORAGE_TO_FIRE', units='gC/m^2/s', &
- avgflag='A', long_name='growth respiration storage fire loss', &
- ptr_patch=this%m_gresp_storage_to_fire_patch, default='inactive')
-
- this%m_gresp_xfer_to_fire_patch(begp:endp) = spval
- call hist_addfld1d (fname='M_GRESP_XFER_TO_FIRE', units='gC/m^2/s', &
- avgflag='A', long_name='growth respiration transfer fire loss', &
- ptr_patch=this%m_gresp_xfer_to_fire_patch, default='inactive')
-
- this%m_leafc_to_litter_fire_patch(begp:endp) = spval
- call hist_addfld1d (fname='M_LEAFC_TO_LITTER_FIRE', units='gC/m^2/s', &
- avgflag='A', long_name='leaf C fire mortality to litter', &
- ptr_patch=this%m_leafc_to_litter_fire_patch, default='inactive')
-
- ! add by F. Li and S. Levis
- this%m_leafc_storage_to_litter_fire_patch(begp:endp) = spval
- call hist_addfld1d (fname='M_LEAFC_STORAGE_TO_LITTER_FIRE', units='gC/m^2/s', &
- avgflag='A', long_name='leaf C fire mortality to litter', &
- ptr_patch=this%m_leafc_storage_to_litter_fire_patch, default='inactive')
-
- this%m_leafc_xfer_to_litter_fire_patch(begp:endp) = spval
- call hist_addfld1d (fname='M_LEAFC_XFER_TO_LITTER_FIRE', units='gC/m^2/s', &
- avgflag='A', long_name='leaf C transfer fire mortality to litter', &
- ptr_patch=this%m_leafc_xfer_to_litter_fire_patch, default='inactive')
-
- this%m_livestemc_to_litter_fire_patch(begp:endp) = spval
- call hist_addfld1d (fname='M_LIVESTEMC_TO_LITTER_FIRE', units='gC/m^2/s', &
- avgflag='A', long_name='live stem C fire mortality to litter', &
- ptr_patch=this%m_livestemc_to_litter_fire_patch, default='inactive')
-
- this%m_livestemc_storage_to_litter_fire_patch(begp:endp) = spval
- call hist_addfld1d (fname='M_LIVESTEMC_STORAGE_TO_LITTER_FIRE', units='gC/m^2/s', &
- avgflag='A', long_name='live stem C storage fire mortality to litter', &
- ptr_patch=this%m_livestemc_storage_to_litter_fire_patch, default='inactive')
-
- this%m_livestemc_xfer_to_litter_fire_patch(begp:endp) = spval
- call hist_addfld1d (fname='M_LIVESTEMC_XFER_TO_LITTER_FIRE', units='gC/m^2/s', &
- avgflag='A', long_name='live stem C transfer fire mortality to litter', &
- ptr_patch=this%m_livestemc_xfer_to_litter_fire_patch, default='inactive')
-
- this%m_livestemc_to_deadstemc_fire_patch(begp:endp) = spval
- call hist_addfld1d (fname='M_LIVESTEMC_TO_DEADSTEMC_FIRE', units='gC/m^2/s', &
- avgflag='A', long_name='live stem C fire mortality to dead stem C', &
- ptr_patch=this%m_livestemc_to_deadstemc_fire_patch, default='inactive')
-
- this%m_deadstemc_to_litter_fire_patch(begp:endp) = spval
- call hist_addfld1d (fname='M_DEADSTEMC_TO_LITTER_FIRE', units='gC/m^2/s', &
- avgflag='A', long_name='dead stem C fire mortality to litter', &
- ptr_patch=this%m_deadstemc_to_litter_fire_patch, default='inactive')
-
- this%m_deadstemc_storage_to_litter_fire_patch(begp:endp) = spval
- call hist_addfld1d (fname='M_DEADSTEMC_STORAGE_TO_LITTER_FIRE', units='gC/m^2/s', &
- avgflag='A', long_name='dead stem C storage fire mortality to litter', &
- ptr_patch=this%m_deadstemc_storage_to_litter_fire_patch, default='inactive')
-
- this%m_deadstemc_xfer_to_litter_fire_patch(begp:endp) = spval
- call hist_addfld1d (fname='M_DEADSTEMC_XFER_TO_LITTER_FIRE', units='gC/m^2/s', &
- avgflag='A', long_name='dead stem C transfer fire mortality to litter', &
- ptr_patch=this%m_deadstemc_xfer_to_litter_fire_patch, default='inactive')
-
- this%m_frootc_to_litter_fire_patch(begp:endp) = spval
- call hist_addfld1d (fname='M_FROOTC_TO_LITTER_FIRE', units='gC/m^2/s', &
- avgflag='A', long_name='fine root C fire mortality to litter', &
- ptr_patch=this%m_frootc_to_litter_fire_patch, default='inactive')
-
- this%m_frootc_storage_to_litter_fire_patch(begp:endp) = spval
- call hist_addfld1d (fname='M_FROOTC_STORAGE_TO_LITTER_FIRE', units='gC/m^2/s', &
- avgflag='A', long_name='fine root C storage fire mortality to litter', &
- ptr_patch=this%m_frootc_storage_to_litter_fire_patch, default='inactive')
-
- this%m_frootc_xfer_to_litter_fire_patch(begp:endp) = spval
- call hist_addfld1d (fname='M_FROOTC_XFER_TO_LITTER_FIRE', units='gC/m^2/s', &
- avgflag='A', long_name='fine root C transfer fire mortality to litter', &
- ptr_patch=this%m_frootc_xfer_to_litter_fire_patch, default='inactive')
-
- this%m_livecrootc_to_litter_fire_patch(begp:endp) = spval
- call hist_addfld1d (fname='M_LIVEROOTC_TO_LITTER_FIRE', units='gC/m^2/s', &
- avgflag='A', long_name='live root C fire mortality to litter', &
- ptr_patch=this%m_livecrootc_to_litter_fire_patch, default='inactive')
-
- this%m_livecrootc_storage_to_litter_fire_patch(begp:endp) = spval
- call hist_addfld1d (fname='M_LIVEROOTC_STORAGE_TO_LITTER_FIRE', units='gC/m^2/s', &
- avgflag='A', long_name='live root C storage fire mortality to litter', &
- ptr_patch=this%m_livecrootc_storage_to_litter_fire_patch, default='inactive')
-
- this%m_livecrootc_xfer_to_litter_fire_patch(begp:endp) = spval
- call hist_addfld1d (fname='M_LIVEROOTC_XFER_TO_LITTER_FIRE', units='gC/m^2/s', &
- avgflag='A', long_name='live root C transfer fire mortality to litter', &
- ptr_patch=this%m_livecrootc_xfer_to_litter_fire_patch, default='inactive')
-
- this%m_livecrootc_to_deadcrootc_fire_patch(begp:endp) = spval
- call hist_addfld1d (fname='M_LIVEROOTC_TO_DEADROOTC_FIRE', units='gC/m^2/s', &
- avgflag='A', long_name='live root C fire mortality to dead root C', &
- ptr_patch=this%m_livecrootc_to_deadcrootc_fire_patch, default='inactive')
-
-
- this%m_deadcrootc_to_litter_fire_patch(begp:endp) = spval
- call hist_addfld1d (fname='M_DEADROOTC_TO_LITTER_FIRE', units='gC/m^2/s', &
- avgflag='A', long_name='dead root C fire mortality to litter', &
- ptr_patch=this%m_deadcrootc_to_litter_fire_patch, default='inactive')
-
- this%m_deadcrootc_storage_to_litter_fire_patch(begp:endp) = spval
- call hist_addfld1d (fname='M_DEADROOTC_STORAGE_TO_LITTER_FIRE', units='gC/m^2/s', &
- avgflag='A', long_name='dead root C storage fire mortality to litter', &
- ptr_patch=this%m_deadcrootc_storage_to_litter_fire_patch, default='inactive')
-
- this%m_deadcrootc_xfer_to_litter_fire_patch(begp:endp) = spval
- call hist_addfld1d (fname='M_DEADROOTC_XFER_TO_LITTER_FIRE', units='gC/m^2/s', &
- avgflag='A', long_name='dead root C transfer fire mortality to litter', &
- ptr_patch=this%m_deadcrootc_xfer_to_litter_fire_patch, default='inactive')
-
- this%m_livecrootc_storage_to_litter_fire_patch(begp:endp) = spval
- call hist_addfld1d (fname='M_LIVECROOTC_STORAGE_TO_LITTER_FIRE', units='gC/m^2/s', &
- avgflag='A', long_name='live coarse root C fire mortality to litter', &
- ptr_patch=this%m_livecrootc_storage_to_litter_fire_patch, default='inactive')
-
- this%m_deadcrootc_storage_to_litter_fire_patch(begp:endp) = spval
- call hist_addfld1d (fname='M_DEADCROOTC_STORAGE_TO_LITTER_FIRE', units='gC/m^2/s', &
- avgflag='A', long_name='dead coarse root C storage fire mortality to litter', &
- ptr_patch=this%m_deadcrootc_storage_to_litter_fire_patch, default='inactive')
-
- this%m_gresp_storage_to_litter_fire_patch(begp:endp) = spval
- call hist_addfld1d (fname='M_GRESP_STORAGE_TO_LITTER_FIRE', units='gC/m^2/s', &
- avgflag='A', long_name='growth respiration storage fire mortality to litter', &
- ptr_patch=this%m_gresp_storage_to_litter_fire_patch, default='inactive')
-
- this%m_gresp_xfer_to_litter_fire_patch(begp:endp) = spval
- call hist_addfld1d (fname='M_GRESP_XFER_TO_LITTER_FIRE', units='gC/m^2/s', &
- avgflag='A', long_name='growth respiration transfer fire mortality to litter', &
- ptr_patch=this%m_gresp_xfer_to_litter_fire_patch, default='inactive')
-
- this%leafc_xfer_to_leafc_patch(begp:endp) = spval
- call hist_addfld1d (fname='LEAFC_XFER_TO_LEAFC', units='gC/m^2/s', &
- avgflag='A', long_name='leaf C growth from storage', &
- ptr_patch=this%leafc_xfer_to_leafc_patch, default='inactive')
-
- this%frootc_xfer_to_frootc_patch(begp:endp) = spval
- call hist_addfld1d (fname='FROOTC_XFER_TO_FROOTC', units='gC/m^2/s', &
- avgflag='A', long_name='fine root C growth from storage', &
- ptr_patch=this%frootc_xfer_to_frootc_patch, default='inactive')
-
- this%livestemc_xfer_to_livestemc_patch(begp:endp) = spval
- call hist_addfld1d (fname='LIVESTEMC_XFER_TO_LIVESTEMC', units='gC/m^2/s', &
- avgflag='A', long_name='live stem C growth from storage', &
- ptr_patch=this%livestemc_xfer_to_livestemc_patch, default='inactive')
-
- this%deadstemc_xfer_to_deadstemc_patch(begp:endp) = spval
- call hist_addfld1d (fname='DEADSTEMC_XFER_TO_DEADSTEMC', units='gC/m^2/s', &
- avgflag='A', long_name='dead stem C growth from storage', &
- ptr_patch=this%deadstemc_xfer_to_deadstemc_patch, default='inactive')
-
- this%livecrootc_xfer_to_livecrootc_patch(begp:endp) = spval
- call hist_addfld1d (fname='LIVECROOTC_XFER_TO_LIVECROOTC', units='gC/m^2/s', &
- avgflag='A', long_name='live coarse root C growth from storage', &
- ptr_patch=this%livecrootc_xfer_to_livecrootc_patch, default='inactive')
-
- this%deadcrootc_xfer_to_deadcrootc_patch(begp:endp) = spval
- call hist_addfld1d (fname='DEADCROOTC_XFER_TO_DEADCROOTC', units='gC/m^2/s', &
- avgflag='A', long_name='dead coarse root C growth from storage', &
- ptr_patch=this%deadcrootc_xfer_to_deadcrootc_patch, default='inactive')
-
- this%leafc_to_litter_patch(begp:endp) = spval
- call hist_addfld1d (fname='LEAFC_TO_LITTER', units='gC/m^2/s', &
- avgflag='A', long_name='leaf C litterfall', &
- ptr_patch=this%leafc_to_litter_patch, default='inactive')
-
- if ( use_fun ) then
- this%leafc_to_litter_fun_patch(begp:endp) = spval
- call hist_addfld1d (fname='LEAFC_TO_LITTER_FUN', units='gC/m^2/s', &
- avgflag='A', long_name='leaf C litterfall used by FUN', &
- ptr_patch=this%leafc_to_litter_fun_patch, default='inactive')
- end if
-
- this%frootc_to_litter_patch(begp:endp) = spval
- call hist_addfld1d (fname='FROOTC_TO_LITTER', units='gC/m^2/s', &
- avgflag='A', long_name='fine root C litterfall', &
- ptr_patch=this%frootc_to_litter_patch, default='inactive')
-
- this%cpool_to_resp_patch(begp:endp) = spval
- call hist_addfld1d (fname='EXCESSC_MR', units='gC/m^2/s', &
- avgflag='A', long_name='excess C maintenance respiration', &
- ptr_patch=this%cpool_to_resp_patch, default='inactive')
- this%leaf_mr_patch(begp:endp) = spval
- call hist_addfld1d (fname='LEAF_MR', units='gC/m^2/s', &
- avgflag='A', long_name='leaf maintenance respiration', &
- ptr_patch=this%leaf_mr_patch, default='inactive')
-
- this%froot_mr_patch(begp:endp) = spval
- call hist_addfld1d (fname='FROOT_MR', units='gC/m^2/s', &
- avgflag='A', long_name='fine root maintenance respiration', &
- ptr_patch=this%froot_mr_patch, default='inactive')
-
- this%livestem_mr_patch(begp:endp) = spval
- call hist_addfld1d (fname='LIVESTEM_MR', units='gC/m^2/s', &
- avgflag='A', long_name='live stem maintenance respiration', &
- ptr_patch=this%livestem_mr_patch, default='inactive')
-
- this%livecroot_mr_patch(begp:endp) = spval
- call hist_addfld1d (fname='LIVECROOT_MR', units='gC/m^2/s', &
- avgflag='A', long_name='live coarse root maintenance respiration', &
- ptr_patch=this%livecroot_mr_patch, default='inactive')
-
- this%psnsun_to_cpool_patch(begp:endp) = spval
- call hist_addfld1d (fname='PSNSUN_TO_CPOOL', units='gC/m^2/s', &
- avgflag='A', long_name='C fixation from sunlit canopy', &
- ptr_patch=this%psnsun_to_cpool_patch, default='inactive')
-
- this%psnshade_to_cpool_patch(begp:endp) = spval
- call hist_addfld1d (fname='PSNSHADE_TO_CPOOL', units='gC/m^2/s', &
- avgflag='A', long_name='C fixation from shaded canopy', &
- ptr_patch=this%psnshade_to_cpool_patch, default='inactive')
-
- this%cpool_to_leafc_patch(begp:endp) = spval
- call hist_addfld1d (fname='CPOOL_TO_LEAFC', units='gC/m^2/s', &
- avgflag='A', long_name='allocation to leaf C', &
- ptr_patch=this%cpool_to_leafc_patch, default='inactive')
-
- this%cpool_to_leafc_storage_patch(begp:endp) = spval
- call hist_addfld1d (fname='CPOOL_TO_LEAFC_STORAGE', units='gC/m^2/s', &
- avgflag='A', long_name='allocation to leaf C storage', &
- ptr_patch=this%cpool_to_leafc_storage_patch, default='inactive')
-
- this%cpool_to_frootc_patch(begp:endp) = spval
- call hist_addfld1d (fname='CPOOL_TO_FROOTC', units='gC/m^2/s', &
- avgflag='A', long_name='allocation to fine root C', &
- ptr_patch=this%cpool_to_frootc_patch, default='inactive')
-
- this%cpool_to_frootc_storage_patch(begp:endp) = spval
- call hist_addfld1d (fname='CPOOL_TO_FROOTC_STORAGE', units='gC/m^2/s', &
- avgflag='A', long_name='allocation to fine root C storage', &
- ptr_patch=this%cpool_to_frootc_storage_patch, default='inactive')
-
- this%cpool_to_livestemc_patch(begp:endp) = spval
- call hist_addfld1d (fname='CPOOL_TO_LIVESTEMC', units='gC/m^2/s', &
- avgflag='A', long_name='allocation to live stem C', &
- ptr_patch=this%cpool_to_livestemc_patch, default='inactive')
-
- this%cpool_to_livestemc_storage_patch(begp:endp) = spval
- call hist_addfld1d (fname='CPOOL_TO_LIVESTEMC_STORAGE', units='gC/m^2/s', &
- avgflag='A', long_name='allocation to live stem C storage', &
- ptr_patch=this%cpool_to_livestemc_storage_patch, default='inactive')
-
- this%cpool_to_deadstemc_patch(begp:endp) = spval
- call hist_addfld1d (fname='CPOOL_TO_DEADSTEMC', units='gC/m^2/s', &
- avgflag='A', long_name='allocation to dead stem C', &
- ptr_patch=this%cpool_to_deadstemc_patch, default='inactive')
-
- this%cpool_to_deadstemc_storage_patch(begp:endp) = spval
- call hist_addfld1d (fname='CPOOL_TO_DEADSTEMC_STORAGE', units='gC/m^2/s', &
- avgflag='A', long_name='allocation to dead stem C storage', &
- ptr_patch=this%cpool_to_deadstemc_storage_patch, default='inactive')
-
- this%cpool_to_livecrootc_patch(begp:endp) = spval
- call hist_addfld1d (fname='CPOOL_TO_LIVECROOTC', units='gC/m^2/s', &
- avgflag='A', long_name='allocation to live coarse root C', &
- ptr_patch=this%cpool_to_livecrootc_patch, default='inactive')
-
- this%cpool_to_livecrootc_storage_patch(begp:endp) = spval
- call hist_addfld1d (fname='CPOOL_TO_LIVECROOTC_STORAGE', units='gC/m^2/s', &
- avgflag='A', long_name='allocation to live coarse root C storage', &
- ptr_patch=this%cpool_to_livecrootc_storage_patch, default='inactive')
-
- this%cpool_to_deadcrootc_patch(begp:endp) = spval
- call hist_addfld1d (fname='CPOOL_TO_DEADCROOTC', units='gC/m^2/s', &
- avgflag='A', long_name='allocation to dead coarse root C', &
- ptr_patch=this%cpool_to_deadcrootc_patch, default='inactive')
-
- this%cpool_to_deadcrootc_storage_patch(begp:endp) = spval
- call hist_addfld1d (fname='CPOOL_TO_DEADCROOTC_STORAGE', units='gC/m^2/s', &
- avgflag='A', long_name='allocation to dead coarse root C storage', &
- ptr_patch=this%cpool_to_deadcrootc_storage_patch, default='inactive')
-
- this%cpool_to_gresp_storage_patch(begp:endp) = spval
- call hist_addfld1d (fname='CPOOL_TO_GRESP_STORAGE', units='gC/m^2/s', &
- avgflag='A', long_name='allocation to growth respiration storage', &
- ptr_patch=this%cpool_to_gresp_storage_patch, default='inactive')
-
- this%cpool_leaf_gr_patch(begp:endp) = spval
- call hist_addfld1d (fname='CPOOL_LEAF_GR', units='gC/m^2/s', &
- avgflag='A', long_name='leaf growth respiration', &
- ptr_patch=this%cpool_leaf_gr_patch, default='inactive')
-
- this%cpool_leaf_storage_gr_patch(begp:endp) = spval
- call hist_addfld1d (fname='CPOOL_LEAF_STORAGE_GR', units='gC/m^2/s', &
- avgflag='A', long_name='leaf growth respiration to storage', &
- ptr_patch=this%cpool_leaf_storage_gr_patch, default='inactive')
-
- this%transfer_leaf_gr_patch(begp:endp) = spval
- call hist_addfld1d (fname='TRANSFER_LEAF_GR', units='gC/m^2/s', &
- avgflag='A', long_name='leaf growth respiration from storage', &
- ptr_patch=this%transfer_leaf_gr_patch, default='inactive')
-
- this%cpool_froot_gr_patch(begp:endp) = spval
- call hist_addfld1d (fname='CPOOL_FROOT_GR', units='gC/m^2/s', &
- avgflag='A', long_name='fine root growth respiration', &
- ptr_patch=this%cpool_froot_gr_patch, default='inactive')
-
- this%cpool_froot_storage_gr_patch(begp:endp) = spval
- call hist_addfld1d (fname='CPOOL_FROOT_STORAGE_GR', units='gC/m^2/s', &
- avgflag='A', long_name='fine root growth respiration to storage', &
- ptr_patch=this%cpool_froot_storage_gr_patch, default='inactive')
-
- this%transfer_froot_gr_patch(begp:endp) = spval
- call hist_addfld1d (fname='TRANSFER_FROOT_GR', units='gC/m^2/s', &
- avgflag='A', long_name='fine root growth respiration from storage', &
- ptr_patch=this%transfer_froot_gr_patch, default='inactive')
-
- this%cpool_livestem_gr_patch(begp:endp) = spval
- call hist_addfld1d (fname='CPOOL_LIVESTEM_GR', units='gC/m^2/s', &
- avgflag='A', long_name='live stem growth respiration', &
- ptr_patch=this%cpool_livestem_gr_patch, default='inactive')
-
- this%cpool_livestem_storage_gr_patch(begp:endp) = spval
- call hist_addfld1d (fname='CPOOL_LIVESTEM_STORAGE_GR', units='gC/m^2/s', &
- avgflag='A', long_name='live stem growth respiration to storage', &
- ptr_patch=this%cpool_livestem_storage_gr_patch, default='inactive')
-
- this%transfer_livestem_gr_patch(begp:endp) = spval
- call hist_addfld1d (fname='TRANSFER_LIVESTEM_GR', units='gC/m^2/s', &
- avgflag='A', long_name='live stem growth respiration from storage', &
- ptr_patch=this%transfer_livestem_gr_patch, default='inactive')
-
- this%cpool_deadstem_gr_patch(begp:endp) = spval
- call hist_addfld1d (fname='CPOOL_DEADSTEM_GR', units='gC/m^2/s', &
- avgflag='A', long_name='dead stem growth respiration', &
- ptr_patch=this%cpool_deadstem_gr_patch, default='inactive')
-
- this%cpool_deadstem_storage_gr_patch(begp:endp) = spval
- call hist_addfld1d (fname='CPOOL_DEADSTEM_STORAGE_GR', units='gC/m^2/s', &
- avgflag='A', long_name='dead stem growth respiration to storage', &
- ptr_patch=this%cpool_deadstem_storage_gr_patch, default='inactive')
-
- this%transfer_deadstem_gr_patch(begp:endp) = spval
- call hist_addfld1d (fname='TRANSFER_DEADSTEM_GR', units='gC/m^2/s', &
- avgflag='A', long_name='dead stem growth respiration from storage', &
- ptr_patch=this%transfer_deadstem_gr_patch, default='inactive')
-
- this%cpool_livecroot_gr_patch(begp:endp) = spval
- call hist_addfld1d (fname='CPOOL_LIVECROOT_GR', units='gC/m^2/s', &
- avgflag='A', long_name='live coarse root growth respiration', &
- ptr_patch=this%cpool_livecroot_gr_patch, default='inactive')
-
- this%cpool_livecroot_storage_gr_patch(begp:endp) = spval
- call hist_addfld1d (fname='CPOOL_LIVECROOT_STORAGE_GR', units='gC/m^2/s', &
- avgflag='A', long_name='live coarse root growth respiration to storage', &
- ptr_patch=this%cpool_livecroot_storage_gr_patch, default='inactive')
-
- this%transfer_livecroot_gr_patch(begp:endp) = spval
- call hist_addfld1d (fname='TRANSFER_LIVECROOT_GR', units='gC/m^2/s', &
- avgflag='A', long_name='live coarse root growth respiration from storage', &
- ptr_patch=this%transfer_livecroot_gr_patch, default='inactive')
-
- this%cpool_deadcroot_gr_patch(begp:endp) = spval
- call hist_addfld1d (fname='CPOOL_DEADCROOT_GR', units='gC/m^2/s', &
- avgflag='A', long_name='dead coarse root growth respiration', &
- ptr_patch=this%cpool_deadcroot_gr_patch, default='inactive')
-
- this%cpool_deadcroot_storage_gr_patch(begp:endp) = spval
- call hist_addfld1d (fname='CPOOL_DEADCROOT_STORAGE_GR', units='gC/m^2/s', &
- avgflag='A', long_name='dead coarse root growth respiration to storage', &
- ptr_patch=this%cpool_deadcroot_storage_gr_patch, default='inactive')
-
- this%transfer_deadcroot_gr_patch(begp:endp) = spval
- call hist_addfld1d (fname='TRANSFER_DEADCROOT_GR', units='gC/m^2/s', &
- avgflag='A', long_name='dead coarse root growth respiration from storage', &
- ptr_patch=this%transfer_deadcroot_gr_patch, default='inactive')
-
- this%leafc_storage_to_xfer_patch(begp:endp) = spval
- call hist_addfld1d (fname='LEAFC_STORAGE_TO_XFER', units='gC/m^2/s', &
- avgflag='A', long_name='leaf C shift storage to transfer', &
- ptr_patch=this%leafc_storage_to_xfer_patch, default='inactive')
-
- this%frootc_storage_to_xfer_patch(begp:endp) = spval
- call hist_addfld1d (fname='FROOTC_STORAGE_TO_XFER', units='gC/m^2/s', &
- avgflag='A', long_name='fine root C shift storage to transfer', &
- ptr_patch=this%frootc_storage_to_xfer_patch, default='inactive')
-
- this%livestemc_storage_to_xfer_patch(begp:endp) = spval
- call hist_addfld1d (fname='LIVESTEMC_STORAGE_TO_XFER', units='gC/m^2/s', &
- avgflag='A', long_name='live stem C shift storage to transfer', &
- ptr_patch=this%livestemc_storage_to_xfer_patch, default='inactive')
-
- this%deadstemc_storage_to_xfer_patch(begp:endp) = spval
- call hist_addfld1d (fname='DEADSTEMC_STORAGE_TO_XFER', units='gC/m^2/s', &
- avgflag='A', long_name='dead stem C shift storage to transfer', &
- ptr_patch=this%deadstemc_storage_to_xfer_patch, default='inactive')
-
- this%livecrootc_storage_to_xfer_patch(begp:endp) = spval
- call hist_addfld1d (fname='LIVECROOTC_STORAGE_TO_XFER', units='gC/m^2/s', &
- avgflag='A', long_name='live coarse root C shift storage to transfer', &
- ptr_patch=this%livecrootc_storage_to_xfer_patch, default='inactive')
-
- this%deadcrootc_storage_to_xfer_patch(begp:endp) = spval
- call hist_addfld1d (fname='DEADCROOTC_STORAGE_TO_XFER', units='gC/m^2/s', &
- avgflag='A', long_name='dead coarse root C shift storage to transfer', &
- ptr_patch=this%deadcrootc_storage_to_xfer_patch, default='inactive')
-
- this%gresp_storage_to_xfer_patch(begp:endp) = spval
- call hist_addfld1d (fname='GRESP_STORAGE_TO_XFER', units='gC/m^2/s', &
- avgflag='A', long_name='growth respiration shift storage to transfer', &
- ptr_patch=this%gresp_storage_to_xfer_patch, default='inactive')
-
- this%livestemc_to_deadstemc_patch(begp:endp) = spval
- call hist_addfld1d (fname='LIVESTEMC_TO_DEADSTEMC', units='gC/m^2/s', &
- avgflag='A', long_name='live stem C turnover', &
- ptr_patch=this%livestemc_to_deadstemc_patch, default='inactive')
-
- this%livecrootc_to_deadcrootc_patch(begp:endp) = spval
- call hist_addfld1d (fname='LIVECROOTC_TO_DEADCROOTC', units='gC/m^2/s', &
- avgflag='A', long_name='live coarse root C turnover', &
- ptr_patch=this%livecrootc_to_deadcrootc_patch, default='inactive')
-
- this%gpp_before_downreg_patch(begp:endp) = spval
- call hist_addfld1d (fname='INIT_GPP', units='gC/m^2/s', &
- avgflag='A', long_name='GPP flux before downregulation', &
- ptr_patch=this%gpp_before_downreg_patch, default='inactive')
-
- this%current_gr_patch(begp:endp) = spval
- call hist_addfld1d (fname='CURRENT_GR', units='gC/m^2/s', &
- avgflag='A', long_name='growth resp for new growth displayed in this timestep', &
- ptr_patch=this%current_gr_patch, default='inactive')
-
- this%transfer_gr_patch(begp:endp) = spval
- call hist_addfld1d (fname='TRANSFER_GR', units='gC/m^2/s', &
- avgflag='A', long_name='growth resp for transfer growth displayed in this timestep', &
- ptr_patch=this%transfer_gr_patch, default='inactive')
-
- this%storage_gr_patch(begp:endp) = spval
- call hist_addfld1d (fname='STORAGE_GR', units='gC/m^2/s', &
- avgflag='A', long_name='growth resp for growth sent to storage for later display', &
- ptr_patch=this%storage_gr_patch, default='inactive')
-
- this%availc_patch(begp:endp) = spval
- call hist_addfld1d (fname='AVAILC', units='gC/m^2/s', &
- avgflag='A', long_name='C flux available for allocation', &
- ptr_patch=this%availc_patch, default='inactive')
-
- this%plant_calloc_patch(begp:endp) = spval
- call hist_addfld1d (fname='PLANT_CALLOC', units='gC/m^2/s', &
- avgflag='A', long_name='total allocated C flux', &
- ptr_patch=this%plant_calloc_patch, default='inactive')
-
- this%excess_cflux_patch(begp:endp) = spval
- call hist_addfld1d (fname='EXCESS_CFLUX', units='gC/m^2/s', &
- avgflag='A', long_name='C flux not allocated due to downregulation', &
- ptr_patch=this%excess_cflux_patch, default='inactive')
-
- this%prev_leafc_to_litter_patch(begp:endp) = spval
- call hist_addfld1d (fname='PREV_LEAFC_TO_LITTER', units='gC/m^2/s', &
- avgflag='A', long_name='previous timestep leaf C litterfall flux', &
- ptr_patch=this%prev_leafc_to_litter_patch, default='inactive')
-
- this%prev_frootc_to_litter_patch(begp:endp) = spval
- call hist_addfld1d (fname='PREV_FROOTC_TO_LITTER', units='gC/m^2/s', &
- avgflag='A', long_name='previous timestep froot C litterfall flux', &
- ptr_patch=this%prev_frootc_to_litter_patch, default='inactive')
-
- this%xsmrpool_recover_patch(begp:endp) = spval
- call hist_addfld1d (fname='XSMRPOOL_RECOVER', units='gC/m^2/s', &
- avgflag='A', long_name='C flux assigned to recovery of negative xsmrpool', &
- ptr_patch=this%xsmrpool_recover_patch, default='inactive')
-
- this%gpp_patch(begp:endp) = spval
- call hist_addfld1d (fname='GPP', units='gC/m^2/s', &
- avgflag='A', long_name='gross primary production', &
- ptr_patch=this%gpp_patch, default='inactive')
-
- this%rr_patch(begp:endp) = spval
- call hist_addfld1d (fname='RR', units='gC/m^2/s', &
- avgflag='A', long_name='root respiration (fine root MR + total root GR)', &
- ptr_patch=this%rr_patch, default='inactive')
-
- this%mr_patch(begp:endp) = spval
- call hist_addfld1d (fname='MR', units='gC/m^2/s', &
- avgflag='A', long_name='maintenance respiration', &
- ptr_patch=this%mr_patch, default='inactive')
-
- this%gr_patch(begp:endp) = spval
- call hist_addfld1d (fname='GR', units='gC/m^2/s', &
- avgflag='A', long_name='total growth respiration', &
- ptr_patch=this%gr_patch, default='inactive')
-
- this%ar_patch(begp:endp) = spval
- call hist_addfld1d (fname='AR', units='gC/m^2/s', &
- avgflag='A', long_name='autotrophic respiration (MR + GR)', &
- ptr_patch=this%ar_patch, default='inactive')
-
- this%npp_patch(begp:endp) = spval
- call hist_addfld1d (fname='NPP', units='gC/m^2/s', &
- avgflag='A', long_name='net primary production', &
- ptr_patch=this%npp_patch, default='inactive')
-
- this%agnpp_patch(begp:endp) = spval
- call hist_addfld1d (fname='AGNPP', units='gC/m^2/s', &
- avgflag='A', long_name='aboveground NPP', &
- ptr_patch=this%agnpp_patch, default='inactive')
-
- this%bgnpp_patch(begp:endp) = spval
- call hist_addfld1d (fname='BGNPP', units='gC/m^2/s', &
- avgflag='A', long_name='belowground NPP', &
- ptr_patch=this%bgnpp_patch, default='inactive')
-
- this%litfall_patch(begp:endp) = spval
- call hist_addfld1d (fname='LITFALL', units='gC/m^2/s', &
- avgflag='A', long_name='litterfall (leaves and fine roots)', &
- ptr_patch=this%litfall_patch, default='inactive')
-
- this%wood_harvestc_patch(begp:endp) = spval
- call hist_addfld1d (fname='WOOD_HARVESTC', units='gC/m^2/s', &
- avgflag='A', long_name='wood harvest carbon (to product pools)', &
- ptr_patch=this%wood_harvestc_patch, default='inactive')
-
- this%slash_harvestc_patch(begp:endp) = spval
- call hist_addfld1d (fname='SLASH_HARVESTC', units='gC/m^2/s', &
- avgflag='A', long_name='slash harvest carbon (to litter)', &
- ptr_patch=this%slash_harvestc_patch, default='inactive')
-
- this%fire_closs_patch(begp:endp) = spval
- call hist_addfld1d (fname='PFT_FIRE_CLOSS', units='gC/m^2/s', &
- avgflag='A', long_name='total patch-level fire C loss for non-peat fires outside land-type converted region', &
- ptr_patch=this%fire_closs_patch, default='inactive')
-
- if ( use_fun ) then
- this%npp_Nactive_patch(begp:endp) = spval
- call hist_addfld1d (fname='NPP_NACTIVE', units='gC/m^2/s', &
- avgflag='A', long_name='Mycorrhizal N uptake used C', &
- ptr_patch=this%npp_Nactive_patch, default='inactive')
-
- ! BUG(wjs, 2016-04-13, bugz 2292) This field has a threading bug. Making it
- ! inactive for now.
- this%npp_burnedoff_patch(begp:endp) = spval
- call hist_addfld1d (fname='NPP_BURNEDOFF', units='gC/m^2/s', &
- avgflag='A', long_name='C that cannot be used for N uptake', &
- ptr_patch=this%npp_burnedoff_patch, default='inactive')
-
- this%npp_Nnonmyc_patch(begp:endp) = spval
- call hist_addfld1d (fname='NPP_NNONMYC', units='gC/m^2/s', &
- avgflag='A', long_name='Non-mycorrhizal N uptake used C', &
- ptr_patch=this%npp_Nnonmyc_patch, default='inactive')
-
- this%npp_Nam_patch(begp:endp) = spval
- call hist_addfld1d (fname='NPP_NAM', units='gC/m^2/s', &
- avgflag='A', long_name='AM-associated N uptake used C', &
- ptr_patch=this%npp_Nam_patch, default='inactive')
-
- this%npp_Necm_patch(begp:endp) = spval
- call hist_addfld1d (fname='NPP_NECM', units='gC/m^2/s', &
- avgflag='A', long_name='ECM-associated N uptake used C', &
- ptr_patch=this%npp_Necm_patch, default='inactive')
-
- if (use_nitrif_denitrif) then
- this%npp_Nactive_no3_patch(begp:endp) = spval
- call hist_addfld1d (fname='NPP_NACTIVE_NO3', units='gC/m^2/s', &
- avgflag='A', long_name='Mycorrhizal N uptake used C', &
- ptr_patch=this%npp_Nactive_no3_patch, default='inactive')
-
- this%npp_Nactive_nh4_patch(begp:endp) = spval
- call hist_addfld1d (fname='NPP_NACTIVE_NH4', units='gC/m^2/s', &
- avgflag='A', long_name='Mycorrhizal N uptake use C', &
- ptr_patch=this%npp_Nactive_nh4_patch, default='inactive')
-
- this%npp_Nnonmyc_no3_patch(begp:endp) = spval
- call hist_addfld1d (fname='NPP_NNONMYC_NO3', units='gC/m^2/s', &
- avgflag='A', long_name='Non-mycorrhizal N uptake use C', &
- ptr_patch=this%npp_Nnonmyc_no3_patch, default='inactive')
-
- this%npp_Nnonmyc_nh4_patch(begp:endp) = spval
- call hist_addfld1d (fname='NPP_NNONMYC_NH4', units='gC/m^2/s', &
- avgflag='A', long_name='Non-mycorrhizal N uptake use C', &
- ptr_patch=this%npp_Nnonmyc_nh4_patch, default='inactive')
-
- this%npp_Nam_no3_patch(begp:endp) = spval
- call hist_addfld1d (fname='NPP_NAM_NO3', units='gC/m^2/s', &
- avgflag='A', long_name='AM-associated N uptake use C', &
- ptr_patch=this%npp_Nam_no3_patch, default='inactive')
-
- this%npp_Nam_nh4_patch(begp:endp) = spval
- call hist_addfld1d (fname='NPP_NAM_NH4', units='gC/m^2/s', &
- avgflag='A', long_name='AM-associated N uptake use C', &
- ptr_patch=this%npp_Nam_nh4_patch, default='inactive')
-
- this%npp_Necm_no3_patch(begp:endp) = spval
- call hist_addfld1d (fname='NPP_NECM_NO3', units='gC/m^2/s', &
- avgflag='A', long_name='ECM-associated N uptake used C', &
- ptr_patch=this%npp_Necm_no3_patch, default='inactive')
-
- this%npp_Necm_nh4_patch(begp:endp) = spval
- call hist_addfld1d (fname='NPP_NECM_NH4', units='gC/m^2/s', &
- avgflag='A', long_name='ECM-associated N uptake use C', &
- ptr_patch=this%npp_Necm_nh4_patch, default='inactive')
- end if
-
- this%npp_Nfix_patch(begp:endp) = spval
- call hist_addfld1d (fname='NPP_NFIX', units='gC/m^2/s', &
- avgflag='A', long_name='Symbiotic BNF uptake used C', &
- ptr_patch=this%npp_Nfix_patch, default='inactive')
-
- this%npp_Nretrans_patch(begp:endp) = spval
- call hist_addfld1d (fname='NPP_NRETRANS', units='gC/m^2/s', &
- avgflag='A', long_name='Retranslocated N uptake flux', &
- ptr_patch=this%npp_Nretrans_patch, default='inactive')
-
- this%npp_Nuptake_patch(begp:endp) = spval
- call hist_addfld1d (fname='NPP_NUPTAKE', units='gC/m^2/s', &
- avgflag='A', long_name='Total C used by N uptake in FUN', &
- ptr_patch=this%npp_Nuptake_patch, default='inactive')
-
- this%npp_growth_patch(begp:endp) = spval
- call hist_addfld1d (fname='NPP_GROWTH', units='gC/m^2/s', &
- avgflag='A', long_name='Total C used for growth in FUN', &
- ptr_patch=this%npp_growth_patch, default='inactive')
-
-
-
- this%leafc_change_patch(begp:endp) = spval
- call hist_addfld1d (fname='LEAFC_CHANGE', units='gC/m^2/s', &
- avgflag='A', long_name='C change in leaf', &
- ptr_patch=this%leafc_change_patch, default='inactive')
-
- this%soilc_change_patch(begp:endp) = spval
- call hist_addfld1d (fname='SOILC_CHANGE', units='gC/m^2/s', &
- avgflag='A', long_name='C change in soil', &
- ptr_patch=this%soilc_change_patch, default='inactive')
- end if
-! FUN Ends
-
- end if ! end of if-c12
-
- !-------------------------------
- ! C13 flux variables - patch
- !-------------------------------
-
- if ( carbon_type == 'c13') then
-
- this%gpp_patch(begp:endp) = spval
- call hist_addfld1d (fname='C13_GPP', units='gC13/m^2/s', &
- avgflag='A', long_name='C13 gross primary production', &
- ptr_patch=this%gpp_patch, default='inactive')
-
- this%rr_patch(begp:endp) = spval
- call hist_addfld1d (fname='C13_RR', units='gC13/m^2/s', &
- avgflag='A', long_name='C13 root respiration (fine root MR + total root GR)', &
- ptr_patch=this%rr_patch, default='inactive')
-
- this%mr_patch(begp:endp) = spval
- call hist_addfld1d (fname='C13_MR', units='gC13/m^2/s', &
- avgflag='A', long_name='C13 maintenance respiration', &
- ptr_patch=this%mr_patch, default='inactive')
-
- this%gr_patch(begp:endp) = spval
- call hist_addfld1d (fname='C13_GR', units='gC13/m^2/s', &
- avgflag='A', long_name='C13 total growth respiration', &
- ptr_patch=this%gr_patch, default='inactive')
-
- this%ar_patch(begp:endp) = spval
- call hist_addfld1d (fname='C13_AR', units='gC13/m^2/s', &
- avgflag='A', long_name='C13 autotrophic respiration (MR + GR)', &
- ptr_patch=this%ar_patch, default='inactive')
-
- this%npp_patch(begp:endp) = spval
- call hist_addfld1d (fname='C13_NPP', units='gC13/m^2/s', &
- avgflag='A', long_name='C13 net primary production', &
- ptr_patch=this%npp_patch, default='inactive')
-
- this%agnpp_patch(begp:endp) = spval
- call hist_addfld1d (fname='C13_AGNPP', units='gC13/m^2/s', &
- avgflag='A', long_name='C13 aboveground NPP', &
- ptr_patch=this%agnpp_patch, default='inactive')
-
- this%bgnpp_patch(begp:endp) = spval
- call hist_addfld1d (fname='C13_BGNPP', units='gC13/m^2/s', &
- avgflag='A', long_name='C13 belowground NPP', &
- ptr_patch=this%bgnpp_patch, default='inactive')
-
- this%litfall_patch(begp:endp) = spval
- call hist_addfld1d (fname='C13_LITFALL', units='gC13/m^2/s', &
- avgflag='A', long_name='C13 litterfall (leaves and fine roots)', &
- ptr_patch=this%litfall_patch, default='inactive')
-
- this%fire_closs_patch(begp:endp) = spval
- call hist_addfld1d (fname='C13_PFT_FIRE_CLOSS', units='gC13/m^2/s', &
- avgflag='A', long_name='C13 total patch-level fire C loss', &
- ptr_patch=this%fire_closs_patch, default='inactive')
-
- this%m_leafc_to_litter_patch(begp:endp) = spval
- call hist_addfld1d (fname='C13_M_LEAFC_TO_LITTER', units='gC13/m^2/s', &
- avgflag='A', long_name='C13 leaf C mortality', &
- ptr_patch=this%m_leafc_to_litter_patch, default='inactive')
-
- this%m_frootc_to_litter_patch(begp:endp) = spval
- call hist_addfld1d (fname='C13_M_FROOTC_TO_LITTER', units='gC13/m^2/s', &
- avgflag='A', long_name='C13 fine root C mortality', &
- ptr_patch=this%m_frootc_to_litter_patch, default='inactive')
-
- this%m_leafc_storage_to_litter_patch(begp:endp) = spval
- call hist_addfld1d (fname='C13_M_LEAFC_STORAGE_TO_LITTER', units='gC13/m^2/s', &
- avgflag='A', long_name='C13 leaf C storage mortality', &
- ptr_patch=this%m_leafc_storage_to_litter_patch, default='inactive')
-
- this%m_frootc_storage_to_litter_patch(begp:endp) = spval
- call hist_addfld1d (fname='C13_M_FROOTC_STORAGE_TO_LITTER', units='gC13/m^2/s', &
- avgflag='A', long_name='C13 fine root C storage mortality', &
- ptr_patch=this%m_frootc_storage_to_litter_patch, default='inactive')
-
- this%m_livestemc_storage_to_litter_patch(begp:endp) = spval
- call hist_addfld1d (fname='C13_M_LIVESTEMC_STORAGE_TO_LITTER', units='gC13/m^2/s', &
- avgflag='A', long_name='C13 live stem C storage mortality', &
- ptr_patch=this%m_livestemc_storage_to_litter_patch, default='inactive')
-
- this%m_deadstemc_storage_to_litter_patch(begp:endp) = spval
- call hist_addfld1d (fname='C13_M_DEADSTEMC_STORAGE_TO_LITTER', units='gC13/m^2/s', &
- avgflag='A', long_name='C13 dead stem C storage mortality', &
- ptr_patch=this%m_deadstemc_storage_to_litter_patch, default='inactive')
-
- this%m_livecrootc_storage_to_litter_patch(begp:endp) = spval
- call hist_addfld1d (fname='C13_M_LIVECROOTC_STORAGE_TO_LITTER', units='gC13/m^2/s', &
- avgflag='A', long_name='C13 live coarse root C storage mortality', &
- ptr_patch=this%m_livecrootc_storage_to_litter_patch, default='inactive')
-
- this%m_deadcrootc_storage_to_litter_patch(begp:endp) = spval
- call hist_addfld1d (fname='C13_M_DEADCROOTC_STORAGE_TO_LITTER', units='gC13/m^2/s', &
- avgflag='A', long_name='C13 dead coarse root C storage mortality', &
- ptr_patch=this%m_deadcrootc_storage_to_litter_patch, default='inactive')
-
- this%m_leafc_xfer_to_litter_patch(begp:endp) = spval
- call hist_addfld1d (fname='C13_M_LEAFC_XFER_TO_LITTER', units='gC13/m^2/s', &
- avgflag='A', long_name='C13 leaf C transfer mortality', &
- ptr_patch=this%m_leafc_xfer_to_litter_patch, default='inactive')
-
- this%m_frootc_xfer_to_litter_patch(begp:endp) = spval
- call hist_addfld1d (fname='C13_M_FROOTC_XFER_TO_LITTER', units='gC13/m^2/s', &
- avgflag='A', long_name='C13 fine root C transfer mortality', &
- ptr_patch=this%m_frootc_xfer_to_litter_patch, default='inactive')
-
- this%m_livestemc_xfer_to_litter_patch(begp:endp) = spval
- call hist_addfld1d (fname='C13_M_LIVESTEMC_XFER_TO_LITTER', units='gC13/m^2/s', &
- avgflag='A', long_name='C13 live stem C transfer mortality', &
- ptr_patch=this%m_livestemc_xfer_to_litter_patch, default='inactive')
-
- this%m_deadstemc_xfer_to_litter_patch(begp:endp) = spval
- call hist_addfld1d (fname='C13_M_DEADSTEMC_XFER_TO_LITTER', units='gC13/m^2/s', &
- avgflag='A', long_name='C13 dead stem C transfer mortality', &
- ptr_patch=this%m_deadstemc_xfer_to_litter_patch, default='inactive')
-
- this%m_livecrootc_xfer_to_litter_patch(begp:endp) = spval
- call hist_addfld1d (fname='C13_M_LIVECROOTC_XFER_TO_LITTER', units='gC13/m^2/s', &
- avgflag='A', long_name='C13 live coarse root C transfer mortality', &
- ptr_patch=this%m_livecrootc_xfer_to_litter_patch, default='inactive')
-
- this%m_deadcrootc_xfer_to_litter_patch(begp:endp) = spval
- call hist_addfld1d (fname='C13_M_DEADCROOTC_XFER_TO_LITTER', units='gC13/m^2/s', &
- avgflag='A', long_name='C13 dead coarse root C transfer mortality', &
- ptr_patch=this%m_deadcrootc_xfer_to_litter_patch, default='inactive')
-
- this%m_livestemc_to_litter_patch(begp:endp) = spval
- call hist_addfld1d (fname='C13_M_LIVESTEMC_TO_LITTER', units='gC13/m^2/s', &
- avgflag='A', long_name='C13 live stem C mortality', &
- ptr_patch=this%m_livestemc_to_litter_patch, default='inactive')
-
- this%m_deadstemc_to_litter_patch(begp:endp) = spval
- call hist_addfld1d (fname='C13_M_DEADSTEMC_TO_LITTER', units='gC13/m^2/s', &
- avgflag='A', long_name='C13 dead stem C mortality', &
- ptr_patch=this%m_deadstemc_to_litter_patch, default='inactive')
-
- this%m_livecrootc_to_litter_patch(begp:endp) = spval
- call hist_addfld1d (fname='C13_M_LIVECROOTC_TO_LITTER', units='gC13/m^2/s', &
- avgflag='A', long_name='C13 live coarse root C mortality', &
- ptr_patch=this%m_livecrootc_to_litter_patch, default='inactive')
-
- this%m_deadcrootc_to_litter_patch(begp:endp) = spval
- call hist_addfld1d (fname='C13_M_DEADCROOTC_TO_LITTER', units='gC13/m^2/s', &
- avgflag='A', long_name='C13 dead coarse root C mortality', &
- ptr_patch=this%m_deadcrootc_to_litter_patch, default='inactive')
-
- this%m_gresp_storage_to_litter_patch(begp:endp) = spval
- call hist_addfld1d (fname='C13_M_GRESP_STORAGE_TO_LITTER', units='gC13/m^2/s', &
- avgflag='A', long_name='C13 growth respiration storage mortality', &
- ptr_patch=this%m_gresp_storage_to_litter_patch, default='inactive')
-
- this%m_gresp_xfer_to_litter_patch(begp:endp) = spval
- call hist_addfld1d (fname='C13_M_GRESP_XFER_TO_LITTER', units='gC13/m^2/s', &
- avgflag='A', long_name='C13 growth respiration transfer mortality', &
- ptr_patch=this%m_gresp_xfer_to_litter_patch, default='inactive')
-
- this%m_leafc_to_fire_patch(begp:endp) = spval
- call hist_addfld1d (fname='C13_M_LEAFC_TO_FIRE', units='gC13/m^2/s', &
- avgflag='A', long_name='C13 leaf C fire loss', &
- ptr_patch=this%m_leafc_to_fire_patch, default='inactive')
-
- this%m_frootc_to_fire_patch(begp:endp) = spval
- call hist_addfld1d (fname='C13_M_FROOTC_TO_FIRE', units='gC13/m^2/s', &
- avgflag='A', long_name='C13 fine root C fire loss', &
- ptr_patch=this%m_frootc_to_fire_patch, default='inactive')
-
- this%m_leafc_storage_to_fire_patch(begp:endp) = spval
- call hist_addfld1d (fname='C13_M_LEAFC_STORAGE_TO_FIRE', units='gC13/m^2/s', &
- avgflag='A', long_name='C13 leaf C storage fire loss', &
- ptr_patch=this%m_leafc_storage_to_fire_patch, default='inactive')
-
- this%m_frootc_storage_to_fire_patch(begp:endp) = spval
- call hist_addfld1d (fname='C13_M_FROOTC_STORAGE_TO_FIRE', units='gC13/m^2/s', &
- avgflag='A', long_name='C13 fine root C storage fire loss', &
- ptr_patch=this%m_frootc_storage_to_fire_patch, default='inactive')
-
- this%m_livestemc_storage_to_fire_patch(begp:endp) = spval
- call hist_addfld1d (fname='C13_M_LIVESTEMC_STORAGE_TO_FIRE', units='gC13/m^2/s', &
- avgflag='A', long_name='C13 live stem C storage fire loss', &
- ptr_patch=this%m_livestemc_storage_to_fire_patch, default='inactive')
-
- this%m_deadstemc_storage_to_fire_patch(begp:endp) = spval
- call hist_addfld1d (fname='C13_M_DEADSTEMC_STORAGE_TO_FIRE', units='gC13/m^2/s', &
- avgflag='A', long_name='C13 dead stem C storage fire loss', &
- ptr_patch=this%m_deadstemc_storage_to_fire_patch, default='inactive')
-
- this%m_livecrootc_storage_to_fire_patch(begp:endp) = spval
- call hist_addfld1d (fname='C13_M_LIVECROOTC_STORAGE_TO_FIRE', units='gC13/m^2/s', &
- avgflag='A', long_name='C13 live coarse root C storage fire loss', &
- ptr_patch=this%m_livecrootc_storage_to_fire_patch, default='inactive')
-
- this%m_deadcrootc_storage_to_fire_patch(begp:endp) = spval
- call hist_addfld1d (fname='C13_M_DEADCROOTC_STORAGE_TO_FIRE', units='gC13/m^2/s', &
- avgflag='A', long_name='C13 dead coarse root C storage fire loss', &
- ptr_patch=this%m_deadcrootc_storage_to_fire_patch, default='inactive')
-
- this%m_leafc_xfer_to_fire_patch(begp:endp) = spval
- call hist_addfld1d (fname='C13_M_LEAFC_XFER_TO_FIRE', units='gC13/m^2/s', &
- avgflag='A', long_name='C13 leaf C transfer fire loss', &
- ptr_patch=this%m_leafc_xfer_to_fire_patch, default='inactive')
-
- this%m_frootc_xfer_to_fire_patch(begp:endp) = spval
- call hist_addfld1d (fname='C13_M_FROOTC_XFER_TO_FIRE', units='gC13/m^2/s', &
- avgflag='A', long_name='C13 fine root C transfer fire loss', &
- ptr_patch=this%m_frootc_xfer_to_fire_patch, default='inactive')
-
- this%m_livestemc_xfer_to_fire_patch(begp:endp) = spval
- call hist_addfld1d (fname='C13_M_LIVESTEMC_XFER_TO_FIRE', units='gC13/m^2/s', &
- avgflag='A', long_name='C13 live stem C transfer fire loss', &
- ptr_patch=this%m_livestemc_xfer_to_fire_patch, default='inactive')
-
- this%m_deadstemc_xfer_to_fire_patch(begp:endp) = spval
- call hist_addfld1d (fname='C13_M_DEADSTEMC_XFER_TO_FIRE', units='gC13/m^2/s', &
- avgflag='A', long_name='C13 dead stem C transfer fire loss', &
- ptr_patch=this%m_deadstemc_xfer_to_fire_patch, default='inactive')
-
- this%m_livecrootc_xfer_to_fire_patch(begp:endp) = spval
- call hist_addfld1d (fname='C13_M_LIVECROOTC_XFER_TO_FIRE', units='gC13/m^2/s', &
- avgflag='A', long_name='C13 live coarse root C transfer fire loss', &
- ptr_patch=this%m_livecrootc_xfer_to_fire_patch, default='inactive')
-
- this%m_deadcrootc_xfer_to_fire_patch(begp:endp) = spval
- call hist_addfld1d (fname='C13_M_DEADCROOTC_XFER_TO_FIRE', units='gC13/m^2/s', &
- avgflag='A', long_name='C13 dead coarse root C transfer fire loss', &
- ptr_patch=this%m_deadcrootc_xfer_to_fire_patch, default='inactive')
-
- this%m_livestemc_to_fire_patch(begp:endp) = spval
- call hist_addfld1d (fname='C13_M_LIVESTEMC_TO_FIRE', units='gC13/m^2/s', &
- avgflag='A', long_name='C13 live stem C fire loss', &
- ptr_patch=this%m_livestemc_to_fire_patch, default='inactive')
-
- this%m_deadstemc_to_fire_patch(begp:endp) = spval
- call hist_addfld1d (fname='C13_M_DEADSTEMC_TO_FIRE', units='gC13/m^2/s', &
- avgflag='A', long_name='C13 dead stem C fire loss', &
- ptr_patch=this%m_deadstemc_to_fire_patch, default='inactive')
-
- this%m_deadstemc_to_litter_fire_patch(begp:endp) = spval
- call hist_addfld1d (fname='C13_M_DEADSTEMC_TO_LITTER_FIRE', units='gC13/m^2/s', &
- avgflag='A', long_name='C13 dead stem C fire mortality to litter', &
- ptr_patch=this%m_deadstemc_to_litter_fire_patch, default='inactive')
-
- this%m_livecrootc_to_fire_patch(begp:endp) = spval
- call hist_addfld1d (fname='C13_M_LIVECROOTC_TO_FIRE', units='gC13/m^2/s', &
- avgflag='A', long_name='C13 live coarse root C fire loss', &
- ptr_patch=this%m_livecrootc_to_fire_patch, default='inactive')
-
- this%m_deadcrootc_to_fire_patch(begp:endp) = spval
- call hist_addfld1d (fname='C13_M_DEADCROOTC_TO_FIRE', units='gC13/m^2/s', &
- avgflag='A', long_name='C13 dead coarse root C fire loss', &
- ptr_patch=this%m_deadcrootc_to_fire_patch, default='inactive')
-
- this%m_deadcrootc_to_litter_fire_patch(begp:endp) = spval
- call hist_addfld1d (fname='C13_M_DEADCROOTC_TO_LITTER_FIRE', units='gC13/m^2/s', &
- avgflag='A', long_name='C13 dead coarse root C fire mortality to litter', &
- ptr_patch=this%m_deadcrootc_to_litter_fire_patch, default='inactive')
-
- this%m_gresp_storage_to_fire_patch(begp:endp) = spval
- call hist_addfld1d (fname='C13_M_GRESP_STORAGE_TO_FIRE', units='gC13/m^2/s', &
- avgflag='A', long_name='C13 growth respiration storage fire loss', &
- ptr_patch=this%m_gresp_storage_to_fire_patch, default='inactive')
-
- this%m_gresp_xfer_to_fire_patch(begp:endp) = spval
- call hist_addfld1d (fname='C13_M_GRESP_XFER_TO_FIRE', units='gC13/m^2/s', &
- avgflag='A', long_name='C13 growth respiration transfer fire loss', &
- ptr_patch=this%m_gresp_xfer_to_fire_patch, default='inactive')
-
- this%leafc_xfer_to_leafc_patch(begp:endp) = spval
- call hist_addfld1d (fname='C13_LEAFC_XFER_TO_LEAFC', units='gC13/m^2/s', &
- avgflag='A', long_name='C13 leaf C growth from storage', &
- ptr_patch=this%leafc_xfer_to_leafc_patch, default='inactive')
-
- this%frootc_xfer_to_frootc_patch(begp:endp) = spval
- call hist_addfld1d (fname='C13_FROOTC_XFER_TO_FROOTC', units='gC13/m^2/s', &
- avgflag='A', long_name='C13 fine root C growth from storage', &
- ptr_patch=this%frootc_xfer_to_frootc_patch, default='inactive')
-
- this%livestemc_xfer_to_livestemc_patch(begp:endp) = spval
- call hist_addfld1d (fname='C13_LIVESTEMC_XFER_TO_LIVESTEMC', units='gC13/m^2/s', &
- avgflag='A', long_name='C13 live stem C growth from storage', &
- ptr_patch=this%livestemc_xfer_to_livestemc_patch, default='inactive')
-
- this%deadstemc_xfer_to_deadstemc_patch(begp:endp) = spval
- call hist_addfld1d (fname='C13_DEADSTEMC_XFER_TO_DEADSTEMC', units='gC13/m^2/s', &
- avgflag='A', long_name='C13 dead stem C growth from storage', &
- ptr_patch=this%deadstemc_xfer_to_deadstemc_patch, default='inactive')
-
- this%livecrootc_xfer_to_livecrootc_patch(begp:endp) = spval
- call hist_addfld1d (fname='C13_LIVECROOTC_XFER_TO_LIVECROOTC', units='gC13/m^2/s', &
- avgflag='A', long_name='C13 live coarse root C growth from storage', &
- ptr_patch=this%livecrootc_xfer_to_livecrootc_patch, default='inactive')
-
- this%deadcrootc_xfer_to_deadcrootc_patch(begp:endp) = spval
- call hist_addfld1d (fname='C13_DEADCROOTC_XFER_TO_DEADCROOTC', units='gC13/m^2/s', &
- avgflag='A', long_name='C13 dead coarse root C growth from storage', &
- ptr_patch=this%deadcrootc_xfer_to_deadcrootc_patch, default='inactive')
-
- this%leafc_to_litter_patch(begp:endp) = spval
- call hist_addfld1d (fname='C13_LEAFC_TO_LITTER', units='gC13/m^2/s', &
- avgflag='A', long_name='C13 leaf C litterfall', &
- ptr_patch=this%leafc_to_litter_patch, default='inactive')
-
- this%frootc_to_litter_patch(begp:endp) = spval
- call hist_addfld1d (fname='C13_FROOTC_TO_LITTER', units='gC13/m^2/s', &
- avgflag='A', long_name='C13 fine root C litterfall', &
- ptr_patch=this%frootc_to_litter_patch, default='inactive')
-
- this%leaf_mr_patch(begp:endp) = spval
- call hist_addfld1d (fname='C13_LEAF_MR', units='gC13/m^2/s', &
- avgflag='A', long_name='C13 leaf maintenance respiration', &
- ptr_patch=this%leaf_mr_patch, default='inactive')
-
- this%froot_mr_patch(begp:endp) = spval
- call hist_addfld1d (fname='C13_FROOT_MR', units='gC13/m^2/s', &
- avgflag='A', long_name='C13 fine root maintenance respiration', &
- ptr_patch=this%froot_mr_patch, default='inactive')
-
- this%livestem_mr_patch(begp:endp) = spval
- call hist_addfld1d (fname='C13_LIVESTEM_MR', units='gC13/m^2/s', &
- avgflag='A', long_name='C13 live stem maintenance respiration', &
- ptr_patch=this%livestem_mr_patch, default='inactive')
-
- this%livecroot_mr_patch(begp:endp) = spval
- call hist_addfld1d (fname='C13_LIVECROOT_MR', units='gC13/m^2/s', &
- avgflag='A', long_name='C13 live coarse root maintenance respiration', &
- ptr_patch=this%livecroot_mr_patch, default='inactive')
-
- this%psnsun_to_cpool_patch(begp:endp) = spval
- call hist_addfld1d (fname='C13_PSNSUN_TO_CPOOL', units='gC13/m^2/s', &
- avgflag='A', long_name='C13 C fixation from sunlit canopy', &
- ptr_patch=this%psnsun_to_cpool_patch, default='inactive')
-
- this%psnshade_to_cpool_patch(begp:endp) = spval
- call hist_addfld1d (fname='C13_PSNSHADE_TO_CPOOL', units='gC13/m^2/s', &
- avgflag='A', long_name='C13 C fixation from shaded canopy', &
- ptr_patch=this%psnshade_to_cpool_patch, default='inactive')
-
- this%cpool_to_leafc_patch(begp:endp) = spval
- call hist_addfld1d (fname='C13_CPOOL_TO_LEAFC', units='gC13/m^2/s', &
- avgflag='A', long_name='C13 allocation to leaf C', &
- ptr_patch=this%cpool_to_leafc_patch, default='inactive')
-
- this%cpool_to_leafc_storage_patch(begp:endp) = spval
- call hist_addfld1d (fname='C13_CPOOL_TO_LEAFC_STORAGE', units='gC13/m^2/s', &
- avgflag='A', long_name='C13 allocation to leaf C storage', &
- ptr_patch=this%cpool_to_leafc_storage_patch, default='inactive')
-
- this%cpool_to_frootc_patch(begp:endp) = spval
- call hist_addfld1d (fname='C13_CPOOL_TO_FROOTC', units='gC13/m^2/s', &
- avgflag='A', long_name='C13 allocation to fine root C', &
- ptr_patch=this%cpool_to_frootc_patch, default='inactive')
-
- this%cpool_to_frootc_storage_patch(begp:endp) = spval
- call hist_addfld1d (fname='C13_CPOOL_TO_FROOTC_STORAGE', units='gC13/m^2/s', &
- avgflag='A', long_name='C13 allocation to fine root C storage', &
- ptr_patch=this%cpool_to_frootc_storage_patch, default='inactive')
-
- this%cpool_to_livestemc_patch(begp:endp) = spval
- call hist_addfld1d (fname='C13_CPOOL_TO_LIVESTEMC', units='gC13/m^2/s', &
- avgflag='A', long_name='C13 allocation to live stem C', &
- ptr_patch=this%cpool_to_livestemc_patch, default='inactive')
-
- this%cpool_to_livestemc_storage_patch(begp:endp) = spval
- call hist_addfld1d (fname='C13_CPOOL_TO_LIVESTEMC_STORAGE', units='gC13/m^2/s', &
- avgflag='A', long_name='C13 allocation to live stem C storage', &
- ptr_patch=this%cpool_to_livestemc_storage_patch, default='inactive')
-
- this%cpool_to_deadstemc_patch(begp:endp) = spval
- call hist_addfld1d (fname='C13_CPOOL_TO_DEADSTEMC', units='gC13/m^2/s', &
- avgflag='A', long_name='C13 allocation to dead stem C', &
- ptr_patch=this%cpool_to_deadstemc_patch, default='inactive')
-
- this%cpool_to_deadstemc_storage_patch(begp:endp) = spval
- call hist_addfld1d (fname='C13_CPOOL_TO_DEADSTEMC_STORAGE', units='gC13/m^2/s', &
- avgflag='A', long_name='C13 allocation to dead stem C storage', &
- ptr_patch=this%cpool_to_deadstemc_storage_patch, default='inactive')
-
- this%cpool_to_livecrootc_patch(begp:endp) = spval
- call hist_addfld1d (fname='C13_CPOOL_TO_LIVECROOTC', units='gC13/m^2/s', &
- avgflag='A', long_name='C13 allocation to live coarse root C', &
- ptr_patch=this%cpool_to_livecrootc_patch, default='inactive')
-
- this%cpool_to_livecrootc_storage_patch(begp:endp) = spval
- call hist_addfld1d (fname='C13_CPOOL_TO_LIVECROOTC_STORAGE', units='gC13/m^2/s', &
- avgflag='A', long_name='C13 allocation to live coarse root C storage', &
- ptr_patch=this%cpool_to_livecrootc_storage_patch, default='inactive')
-
- this%cpool_to_deadcrootc_patch(begp:endp) = spval
- call hist_addfld1d (fname='C13_CPOOL_TO_DEADCROOTC', units='gC13/m^2/s', &
- avgflag='A', long_name='C13 allocation to dead coarse root C', &
- ptr_patch=this%cpool_to_deadcrootc_patch, default='inactive')
-
- this%cpool_to_deadcrootc_storage_patch(begp:endp) = spval
- call hist_addfld1d (fname='C13_CPOOL_TO_DEADCROOTC_STORAGE', units='gC13/m^2/s', &
- avgflag='A', long_name='C13 allocation to dead coarse root C storage', &
- ptr_patch=this%cpool_to_deadcrootc_storage_patch, default='inactive')
-
- this%cpool_to_gresp_storage_patch(begp:endp) = spval
- call hist_addfld1d (fname='C13_CPOOL_TO_GRESP_STORAGE', units='gC13/m^2/s', &
- avgflag='A', long_name='C13 allocation to growth respiration storage', &
- ptr_patch=this%cpool_to_gresp_storage_patch, default='inactive')
-
- this%cpool_leaf_gr_patch(begp:endp) = spval
- call hist_addfld1d (fname='C13_CPOOL_LEAF_GR', units='gC13/m^2/s', &
- avgflag='A', long_name='C13 leaf growth respiration', &
- ptr_patch=this%cpool_leaf_gr_patch, default='inactive')
-
- this%cpool_leaf_storage_gr_patch(begp:endp) = spval
- call hist_addfld1d (fname='C13_CPOOL_LEAF_STORAGE_GR', units='gC13/m^2/s', &
- avgflag='A', long_name='C13 leaf growth respiration to storage', &
- ptr_patch=this%cpool_leaf_storage_gr_patch, default='inactive')
-
- this%transfer_leaf_gr_patch(begp:endp) = spval
- call hist_addfld1d (fname='C13_TRANSFER_LEAF_GR', units='gC13/m^2/s', &
- avgflag='A', long_name='C13 leaf growth respiration from storage', &
- ptr_patch=this%transfer_leaf_gr_patch, default='inactive')
-
- this%cpool_froot_gr_patch(begp:endp) = spval
- call hist_addfld1d (fname='C13_CPOOL_FROOT_GR', units='gC13/m^2/s', &
- avgflag='A', long_name='C13 fine root growth respiration', &
- ptr_patch=this%cpool_froot_gr_patch, default='inactive')
-
- this%cpool_froot_storage_gr_patch(begp:endp) = spval
- call hist_addfld1d (fname='C13_CPOOL_FROOT_STORAGE_GR', units='gC13/m^2/s', &
- avgflag='A', long_name='C13 fine root growth respiration to storage', &
- ptr_patch=this%cpool_froot_storage_gr_patch, default='inactive')
-
- this%transfer_froot_gr_patch(begp:endp) = spval
- call hist_addfld1d (fname='C13_TRANSFER_FROOT_GR', units='gC13/m^2/s', &
- avgflag='A', long_name='C13 fine root growth respiration from storage', &
- ptr_patch=this%transfer_froot_gr_patch, default='inactive')
-
- this%cpool_livestem_gr_patch(begp:endp) = spval
- call hist_addfld1d (fname='C13_CPOOL_LIVESTEM_GR', units='gC13/m^2/s', &
- avgflag='A', long_name='C13 live stem growth respiration', &
- ptr_patch=this%cpool_livestem_gr_patch, default='inactive')
-
- this%cpool_livestem_storage_gr_patch(begp:endp) = spval
- call hist_addfld1d (fname='C13_CPOOL_LIVESTEM_STORAGE_GR', units='gC13/m^2/s', &
- avgflag='A', long_name='C13 live stem growth respiration to storage', &
- ptr_patch=this%cpool_livestem_storage_gr_patch, default='inactive')
-
- this%transfer_livestem_gr_patch(begp:endp) = spval
- call hist_addfld1d (fname='C13_TRANSFER_LIVESTEM_GR', units='gC13/m^2/s', &
- avgflag='A', long_name='C13 live stem growth respiration from storage', &
- ptr_patch=this%transfer_livestem_gr_patch, default='inactive')
-
- this%cpool_deadstem_gr_patch(begp:endp) = spval
- call hist_addfld1d (fname='C13_CPOOL_DEADSTEM_GR', units='gC13/m^2/s', &
- avgflag='A', long_name='C13 dead stem growth respiration', &
- ptr_patch=this%cpool_deadstem_gr_patch, default='inactive')
-
- this%cpool_deadstem_storage_gr_patch(begp:endp) = spval
- call hist_addfld1d (fname='C13_CPOOL_DEADSTEM_STORAGE_GR', units='gC13/m^2/s', &
- avgflag='A', long_name='C13 dead stem growth respiration to storage', &
- ptr_patch=this%cpool_deadstem_storage_gr_patch, default='inactive')
-
- this%transfer_deadstem_gr_patch(begp:endp) = spval
- call hist_addfld1d (fname='C13_TRANSFER_DEADSTEM_GR', units='gC13/m^2/s', &
- avgflag='A', long_name='C13 dead stem growth respiration from storage', &
- ptr_patch=this%transfer_deadstem_gr_patch, default='inactive')
-
- this%cpool_livecroot_gr_patch(begp:endp) = spval
- call hist_addfld1d (fname='C13_CPOOL_LIVECROOT_GR', units='gC13/m^2/s', &
- avgflag='A', long_name='C13 live coarse root growth respiration', &
- ptr_patch=this%cpool_livecroot_gr_patch, default='inactive')
-
- this%cpool_livecroot_storage_gr_patch(begp:endp) = spval
- call hist_addfld1d (fname='C13_CPOOL_LIVECROOT_STORAGE_GR', units='gC13/m^2/s', &
- avgflag='A', long_name='C13 live coarse root growth respiration to storage', &
- ptr_patch=this%cpool_livecroot_storage_gr_patch, default='inactive')
-
- this%transfer_livecroot_gr_patch(begp:endp) = spval
- call hist_addfld1d (fname='C13_TRANSFER_LIVECROOT_GR', units='gC13/m^2/s', &
- avgflag='A', long_name='C13 live coarse root growth respiration from storage', &
- ptr_patch=this%transfer_livecroot_gr_patch, default='inactive')
-
- this%cpool_deadcroot_gr_patch(begp:endp) = spval
- call hist_addfld1d (fname='C13_CPOOL_DEADCROOT_GR', units='gC13/m^2/s', &
- avgflag='A', long_name='C13 dead coarse root growth respiration', &
- ptr_patch=this%cpool_deadcroot_gr_patch, default='inactive')
-
- this%cpool_deadcroot_storage_gr_patch(begp:endp) = spval
- call hist_addfld1d (fname='C13_CPOOL_DEADCROOT_STORAGE_GR', units='gC13/m^2/s', &
- avgflag='A', long_name='C13 dead coarse root growth respiration to storage', &
- ptr_patch=this%cpool_deadcroot_storage_gr_patch, default='inactive')
-
- this%transfer_deadcroot_gr_patch(begp:endp) = spval
- call hist_addfld1d (fname='C13_TRANSFER_DEADCROOT_GR', units='gC13/m^2/s', &
- avgflag='A', long_name='C13 dead coarse root growth respiration from storage', &
- ptr_patch=this%transfer_deadcroot_gr_patch, default='inactive')
-
- this%leafc_storage_to_xfer_patch(begp:endp) = spval
- call hist_addfld1d (fname='C13_LEAFC_STORAGE_TO_XFER', units='gC13/m^2/s', &
- avgflag='A', long_name='C13 leaf C shift storage to transfer', &
- ptr_patch=this%leafc_storage_to_xfer_patch, default='inactive')
-
- this%frootc_storage_to_xfer_patch(begp:endp) = spval
- call hist_addfld1d (fname='C13_FROOTC_STORAGE_TO_XFER', units='gC13/m^2/s', &
- avgflag='A', long_name='C13 fine root C shift storage to transfer', &
- ptr_patch=this%frootc_storage_to_xfer_patch, default='inactive')
-
- this%livestemc_storage_to_xfer_patch(begp:endp) = spval
- call hist_addfld1d (fname='C13_LIVESTEMC_STORAGE_TO_XFER', units='gC13/m^2/s', &
- avgflag='A', long_name='C13 live stem C shift storage to transfer', &
- ptr_patch=this%livestemc_storage_to_xfer_patch, default='inactive')
-
- this%deadstemc_storage_to_xfer_patch(begp:endp) = spval
- call hist_addfld1d (fname='C13_DEADSTEMC_STORAGE_TO_XFER', units='gC13/m^2/s', &
- avgflag='A', long_name='C13 dead stem C shift storage to transfer', &
- ptr_patch=this%deadstemc_storage_to_xfer_patch, default='inactive')
-
- this%livecrootc_storage_to_xfer_patch(begp:endp) = spval
- call hist_addfld1d (fname='C13_LIVECROOTC_STORAGE_TO_XFER', units='gC13/m^2/s', &
- avgflag='A', long_name='C13 live coarse root C shift storage to transfer', &
- ptr_patch=this%livecrootc_storage_to_xfer_patch, default='inactive')
-
- this%deadcrootc_storage_to_xfer_patch(begp:endp) = spval
- call hist_addfld1d (fname='C13_DEADCROOTC_STORAGE_TO_XFER', units='gC13/m^2/s', &
- avgflag='A', long_name='C13 dead coarse root C shift storage to transfer', &
- ptr_patch=this%deadcrootc_storage_to_xfer_patch, default='inactive')
-
- this%gresp_storage_to_xfer_patch(begp:endp) = spval
- call hist_addfld1d (fname='C13_GRESP_STORAGE_TO_XFER', units='gC13/m^2/s', &
- avgflag='A', long_name='C13 growth respiration shift storage to transfer', &
- ptr_patch=this%gresp_storage_to_xfer_patch, default='inactive')
-
- this%livestemc_to_deadstemc_patch(begp:endp) = spval
- call hist_addfld1d (fname='C13_LIVESTEMC_TO_DEADSTEMC', units='gC13/m^2/s', &
- avgflag='A', long_name='C13 live stem C turnover', &
- ptr_patch=this%livestemc_to_deadstemc_patch, default='inactive')
-
- this%livecrootc_to_deadcrootc_patch(begp:endp) = spval
- call hist_addfld1d (fname='C13_LIVECROOTC_TO_DEADCROOTC', units='gC13/m^2/s', &
- avgflag='A', long_name='C13 live coarse root C turnover', &
- ptr_patch=this%livecrootc_to_deadcrootc_patch, default='inactive')
-
- this%current_gr_patch(begp:endp) = spval
- call hist_addfld1d (fname='C13_CURRENT_GR', units='gC13/m^2/s', &
- avgflag='A', long_name='C13 growth resp for new growth displayed in this timestep', &
- ptr_patch=this%current_gr_patch, default='inactive')
-
- this%transfer_gr_patch(begp:endp) = spval
- call hist_addfld1d (fname='C13_TRANSFER_GR', units='gC13/m^2/s', &
- avgflag='A', long_name='C13 growth resp for transfer growth displayed in this timestep', &
- ptr_patch=this%transfer_gr_patch, default='inactive')
-
- this%storage_gr_patch(begp:endp) = spval
- call hist_addfld1d (fname='C13_STORAGE_GR', units='gC13/m^2/s', &
- avgflag='A', long_name='C13 growth resp for growth sent to storage for later display', &
- ptr_patch=this%storage_gr_patch, default='inactive')
-
- this%xsmrpool_c13ratio_patch(begp:endp) = spval
- call hist_addfld1d (fname='XSMRPOOL_C13RATIO', units='proportion', &
- avgflag='A', long_name='C13/C(12+13) ratio for xsmrpool', &
- ptr_patch=this%xsmrpool_c13ratio_patch, default='inactive')
-
- endif
-
- !-------------------------------
- ! C14 flux variables - patch
- !-------------------------------
-
- if ( carbon_type == 'c14' ) then
-
- this%m_leafc_to_litter_patch(begp:endp) = spval
- call hist_addfld1d (fname='C14_M_LEAFC_TO_LITTER', units='gC14/m^2/s', &
- avgflag='A', long_name='C14 leaf C mortality', &
- ptr_patch=this%m_leafc_to_litter_patch, default='inactive')
-
- this%m_frootc_to_litter_patch(begp:endp) = spval
- call hist_addfld1d (fname='C14_M_FROOTC_TO_LITTER', units='gC14/m^2/s', &
- avgflag='A', long_name='C14 fine root C mortality', &
- ptr_patch=this%m_frootc_to_litter_patch, default='inactive')
-
- this%m_leafc_storage_to_litter_patch(begp:endp) = spval
- call hist_addfld1d (fname='C14_M_LEAFC_STORAGE_TO_LITTER', units='gC14/m^2/s', &
- avgflag='A', long_name='C14 leaf C storage mortality', &
- ptr_patch=this%m_leafc_storage_to_litter_patch, default='inactive')
-
- this%m_frootc_storage_to_litter_patch(begp:endp) = spval
- call hist_addfld1d (fname='C14_M_FROOTC_STORAGE_TO_LITTER', units='gC14/m^2/s', &
- avgflag='A', long_name='C14 fine root C storage mortality', &
- ptr_patch=this%m_frootc_storage_to_litter_patch, default='inactive')
-
- this%m_livestemc_storage_to_litter_patch(begp:endp) = spval
- call hist_addfld1d (fname='C14_M_LIVESTEMC_STORAGE_TO_LITTER', units='gC14/m^2/s', &
- avgflag='A', long_name='C14 live stem C storage mortality', &
- ptr_patch=this%m_livestemc_storage_to_litter_patch, default='inactive')
-
- this%m_deadstemc_storage_to_litter_patch(begp:endp) = spval
- call hist_addfld1d (fname='C14_M_DEADSTEMC_STORAGE_TO_LITTER', units='gC14/m^2/s', &
- avgflag='A', long_name='C14 dead stem C storage mortality', &
- ptr_patch=this%m_deadstemc_storage_to_litter_patch, default='inactive')
-
- this%m_livecrootc_storage_to_litter_patch(begp:endp) = spval
- call hist_addfld1d (fname='C14_M_LIVECROOTC_STORAGE_TO_LITTER', units='gC14/m^2/s', &
- avgflag='A', long_name='C14 live coarse root C storage mortality', &
- ptr_patch=this%m_livecrootc_storage_to_litter_patch, default='inactive')
-
- this%m_deadcrootc_storage_to_litter_patch(begp:endp) = spval
- call hist_addfld1d (fname='C14_M_DEADCROOTC_STORAGE_TO_LITTER', units='gC14/m^2/s', &
- avgflag='A', long_name='C14 dead coarse root C storage mortality', &
- ptr_patch=this%m_deadcrootc_storage_to_litter_patch, default='inactive')
-
- this%m_leafc_xfer_to_litter_patch(begp:endp) = spval
- call hist_addfld1d (fname='C14_M_LEAFC_XFER_TO_LITTER', units='gC14/m^2/s', &
- avgflag='A', long_name='C14 leaf C transfer mortality', &
- ptr_patch=this%m_leafc_xfer_to_litter_patch, default='inactive')
-
- this%m_frootc_xfer_to_litter_patch(begp:endp) = spval
- call hist_addfld1d (fname='C14_M_FROOTC_XFER_TO_LITTER', units='gC14/m^2/s', &
- avgflag='A', long_name='C14 fine root C transfer mortality', &
- ptr_patch=this%m_frootc_xfer_to_litter_patch, default='inactive')
-
- this%m_livestemc_xfer_to_litter_patch(begp:endp) = spval
- call hist_addfld1d (fname='C14_M_LIVESTEMC_XFER_TO_LITTER', units='gC14/m^2/s', &
- avgflag='A', long_name='C14 live stem C transfer mortality', &
- ptr_patch=this%m_livestemc_xfer_to_litter_patch, default='inactive')
-
- this%m_deadstemc_xfer_to_litter_patch(begp:endp) = spval
- call hist_addfld1d (fname='C14_M_DEADSTEMC_XFER_TO_LITTER', units='gC14/m^2/s', &
- avgflag='A', long_name='C14 dead stem C transfer mortality', &
- ptr_patch=this%m_deadstemc_xfer_to_litter_patch, default='inactive')
-
- this%m_livecrootc_xfer_to_litter_patch(begp:endp) = spval
- call hist_addfld1d (fname='C14_M_LIVECROOTC_XFER_TO_LITTER', units='gC14/m^2/s', &
- avgflag='A', long_name='C14 live coarse root C transfer mortality', &
- ptr_patch=this%m_livecrootc_xfer_to_litter_patch, default='inactive')
-
- this%m_deadcrootc_xfer_to_litter_patch(begp:endp) = spval
- call hist_addfld1d (fname='C14_M_DEADCROOTC_XFER_TO_LITTER', units='gC14/m^2/s', &
- avgflag='A', long_name='C14 dead coarse root C transfer mortality', &
- ptr_patch=this%m_deadcrootc_xfer_to_litter_patch, default='inactive')
-
- this%m_livestemc_to_litter_patch(begp:endp) = spval
- call hist_addfld1d (fname='C14_M_LIVESTEMC_TO_LITTER', units='gC14/m^2/s', &
- avgflag='A', long_name='C14 live stem C mortality', &
- ptr_patch=this%m_livestemc_to_litter_patch, default='inactive')
-
- this%m_deadstemc_to_litter_patch(begp:endp) = spval
- call hist_addfld1d (fname='C14_M_DEADSTEMC_TO_LITTER', units='gC14/m^2/s', &
- avgflag='A', long_name='C14 dead stem C mortality', &
- ptr_patch=this%m_deadstemc_to_litter_patch, default='inactive')
-
- this%m_livecrootc_to_litter_patch(begp:endp) = spval
- call hist_addfld1d (fname='C14_M_LIVECROOTC_TO_LITTER', units='gC14/m^2/s', &
- avgflag='A', long_name='C14 live coarse root C mortality', &
- ptr_patch=this%m_livecrootc_to_litter_patch, default='inactive')
-
- this%m_deadcrootc_to_litter_patch(begp:endp) = spval
- call hist_addfld1d (fname='C14_M_DEADCROOTC_TO_LITTER', units='gC14/m^2/s', &
- avgflag='A', long_name='C14 dead coarse root C mortality', &
- ptr_patch=this%m_deadcrootc_to_litter_patch, default='inactive')
-
- this%m_gresp_storage_to_litter_patch(begp:endp) = spval
- call hist_addfld1d (fname='C14_M_GRESP_STORAGE_TO_LITTER', units='gC14/m^2/s', &
- avgflag='A', long_name='C14 growth respiration storage mortality', &
- ptr_patch=this%m_gresp_storage_to_litter_patch, default='inactive')
-
- this%m_gresp_xfer_to_litter_patch(begp:endp) = spval
- call hist_addfld1d (fname='C14_M_GRESP_XFER_TO_LITTER', units='gC14/m^2/s', &
- avgflag='A', long_name='C14 growth respiration transfer mortality', &
- ptr_patch=this%m_gresp_xfer_to_litter_patch, default='inactive')
-
- this%m_leafc_to_fire_patch(begp:endp) = spval
- call hist_addfld1d (fname='C14_M_LEAFC_TO_FIRE', units='gC14/m^2/s', &
- avgflag='A', long_name='C14 leaf C fire loss', &
- ptr_patch=this%m_leafc_to_fire_patch, default='inactive')
-
- this%m_frootc_to_fire_patch(begp:endp) = spval
- call hist_addfld1d (fname='C14_M_FROOTC_TO_FIRE', units='gC14/m^2/s', &
- avgflag='A', long_name='C14 fine root C fire loss', &
- ptr_patch=this%m_frootc_to_fire_patch, default='inactive')
-
- this%m_leafc_storage_to_fire_patch(begp:endp) = spval
- call hist_addfld1d (fname='C14_M_LEAFC_STORAGE_TO_FIRE', units='gC14/m^2/s', &
- avgflag='A', long_name='C14 leaf C storage fire loss', &
- ptr_patch=this%m_leafc_storage_to_fire_patch, default='inactive')
-
- this%m_frootc_storage_to_fire_patch(begp:endp) = spval
- call hist_addfld1d (fname='C14_M_FROOTC_STORAGE_TO_FIRE', units='gC14/m^2/s', &
- avgflag='A', long_name='C14 fine root C storage fire loss', &
- ptr_patch=this%m_frootc_storage_to_fire_patch, default='inactive')
-
- this%m_livestemc_storage_to_fire_patch(begp:endp) = spval
- call hist_addfld1d (fname='C14_M_LIVESTEMC_STORAGE_TO_FIRE', units='gC14/m^2/s', &
- avgflag='A', long_name='C14 live stem C storage fire loss', &
- ptr_patch=this%m_livestemc_storage_to_fire_patch, default='inactive')
-
- this%m_deadstemc_storage_to_fire_patch(begp:endp) = spval
- call hist_addfld1d (fname='C14_M_DEADSTEMC_STORAGE_TO_FIRE', units='gC14/m^2/s', &
- avgflag='A', long_name='C14 dead stem C storage fire loss', &
- ptr_patch=this%m_deadstemc_storage_to_fire_patch, default='inactive')
-
- this%m_livecrootc_storage_to_fire_patch(begp:endp) = spval
- call hist_addfld1d (fname='C14_M_LIVECROOTC_STORAGE_TO_FIRE', units='gC14/m^2/s', &
- avgflag='A', long_name='C14 live coarse root C storage fire loss', &
- ptr_patch=this%m_livecrootc_storage_to_fire_patch, default='inactive')
-
- this%m_deadcrootc_storage_to_fire_patch(begp:endp) = spval
- call hist_addfld1d (fname='C14_M_DEADCROOTC_STORAGE_TO_FIRE', units='gC14/m^2/s', &
- avgflag='A', long_name='C14 dead coarse root C storage fire loss', &
- ptr_patch=this%m_deadcrootc_storage_to_fire_patch, default='inactive')
-
- this%m_leafc_xfer_to_fire_patch(begp:endp) = spval
- call hist_addfld1d (fname='C14_M_LEAFC_XFER_TO_FIRE', units='gC14/m^2/s', &
- avgflag='A', long_name='C14 leaf C transfer fire loss', &
- ptr_patch=this%m_leafc_xfer_to_fire_patch, default='inactive')
-
- this%m_frootc_xfer_to_fire_patch(begp:endp) = spval
- call hist_addfld1d (fname='C14_M_FROOTC_XFER_TO_FIRE', units='gC14/m^2/s', &
- avgflag='A', long_name='C14 fine root C transfer fire loss', &
- ptr_patch=this%m_frootc_xfer_to_fire_patch, default='inactive')
-
- this%m_livestemc_xfer_to_fire_patch(begp:endp) = spval
- call hist_addfld1d (fname='C14_M_LIVESTEMC_XFER_TO_FIRE', units='gC14/m^2/s', &
- avgflag='A', long_name='C14 live stem C transfer fire loss', &
- ptr_patch=this%m_livestemc_xfer_to_fire_patch, default='inactive')
-
- this%m_deadstemc_xfer_to_fire_patch(begp:endp) = spval
- call hist_addfld1d (fname='C14_M_DEADSTEMC_XFER_TO_FIRE', units='gC14/m^2/s', &
- avgflag='A', long_name='C14 dead stem C transfer fire loss', &
- ptr_patch=this%m_deadstemc_xfer_to_fire_patch, default='inactive')
-
- this%m_livecrootc_xfer_to_fire_patch(begp:endp) = spval
- call hist_addfld1d (fname='C14_M_LIVECROOTC_XFER_TO_FIRE', units='gC14/m^2/s', &
- avgflag='A', long_name='C14 live coarse root C transfer fire loss', &
- ptr_patch=this%m_livecrootc_xfer_to_fire_patch, default='inactive')
-
- this%m_deadcrootc_xfer_to_fire_patch(begp:endp) = spval
- call hist_addfld1d (fname='C14_M_DEADCROOTC_XFER_TO_FIRE', units='gC14/m^2/s', &
- avgflag='A', long_name='C14 dead coarse root C transfer fire loss', &
- ptr_patch=this%m_deadcrootc_xfer_to_fire_patch, default='inactive')
-
- this%m_livestemc_to_fire_patch(begp:endp) = spval
- call hist_addfld1d (fname='C14_M_LIVESTEMC_TO_FIRE', units='gC14/m^2/s', &
- avgflag='A', long_name='C14 live stem C fire loss', &
- ptr_patch=this%m_livestemc_to_fire_patch, default='inactive')
-
- this%m_deadstemc_to_fire_patch(begp:endp) = spval
- call hist_addfld1d (fname='C14_M_DEADSTEMC_TO_FIRE', units='gC14/m^2/s', &
- avgflag='A', long_name='C14 dead stem C fire loss', &
- ptr_patch=this%m_deadstemc_to_fire_patch, default='inactive')
-
- this%m_deadstemc_to_litter_fire_patch(begp:endp) = spval
- call hist_addfld1d (fname='C14_M_DEADSTEMC_TO_LITTER_FIRE', units='gC14/m^2/s', &
- avgflag='A', long_name='C14 dead stem C fire mortality to litter', &
- ptr_patch=this%m_deadstemc_to_litter_fire_patch, default='inactive')
-
- this%m_livecrootc_to_fire_patch(begp:endp) = spval
- call hist_addfld1d (fname='C14_M_LIVECROOTC_TO_FIRE', units='gC14/m^2/s', &
- avgflag='A', long_name='C14 live coarse root C fire loss', &
- ptr_patch=this%m_livecrootc_to_fire_patch, default='inactive')
-
- this%m_deadcrootc_to_fire_patch(begp:endp) = spval
- call hist_addfld1d (fname='C14_M_DEADCROOTC_TO_FIRE', units='gC14/m^2/s', &
- avgflag='A', long_name='C14 dead coarse root C fire loss', &
- ptr_patch=this%m_deadcrootc_to_fire_patch, default='inactive')
-
- this%m_deadcrootc_to_litter_fire_patch(begp:endp) = spval
- call hist_addfld1d (fname='C14_M_DEADCROOTC_TO_LITTER_FIRE', units='gC14/m^2/s', &
- avgflag='A', long_name='C14 dead coarse root C fire mortality to litter', &
- ptr_patch=this%m_deadcrootc_to_litter_fire_patch, default='inactive')
-
- this%m_gresp_storage_to_fire_patch(begp:endp) = spval
- call hist_addfld1d (fname='C14_M_GRESP_STORAGE_TO_FIRE', units='gC14/m^2/s', &
- avgflag='A', long_name='C14 growth respiration storage fire loss', &
- ptr_patch=this%m_gresp_storage_to_fire_patch, default='inactive')
-
- this%m_gresp_xfer_to_fire_patch(begp:endp) = spval
- call hist_addfld1d (fname='C14_M_GRESP_XFER_TO_FIRE', units='gC14/m^2/s', &
- avgflag='A', long_name='C14 growth respiration transfer fire loss', &
- ptr_patch=this%m_gresp_xfer_to_fire_patch, default='inactive')
-
- this%leafc_xfer_to_leafc_patch(begp:endp) = spval
- call hist_addfld1d (fname='C14_LEAFC_XFER_TO_LEAFC', units='gC14/m^2/s', &
- avgflag='A', long_name='C14 leaf C growth from storage', &
- ptr_patch=this%leafc_xfer_to_leafc_patch, default='inactive')
-
- this%frootc_xfer_to_frootc_patch(begp:endp) = spval
- call hist_addfld1d (fname='C14_FROOTC_XFER_TO_FROOTC', units='gC14/m^2/s', &
- avgflag='A', long_name='C14 fine root C growth from storage', &
- ptr_patch=this%frootc_xfer_to_frootc_patch, default='inactive')
-
- this%livestemc_xfer_to_livestemc_patch(begp:endp) = spval
- call hist_addfld1d (fname='C14_LIVESTEMC_XFER_TO_LIVESTEMC', units='gC14/m^2/s', &
- avgflag='A', long_name='C14 live stem C growth from storage', &
- ptr_patch=this%livestemc_xfer_to_livestemc_patch, default='inactive')
-
- this%deadstemc_xfer_to_deadstemc_patch(begp:endp) = spval
- call hist_addfld1d (fname='C14_DEADSTEMC_XFER_TO_DEADSTEMC', units='gC14/m^2/s', &
- avgflag='A', long_name='C14 dead stem C growth from storage', &
- ptr_patch=this%deadstemc_xfer_to_deadstemc_patch, default='inactive')
-
- this%livecrootc_xfer_to_livecrootc_patch(begp:endp) = spval
- call hist_addfld1d (fname='C14_LIVECROOTC_XFER_TO_LIVECROOTC', units='gC14/m^2/s', &
- avgflag='A', long_name='C14 live coarse root C growth from storage', &
- ptr_patch=this%livecrootc_xfer_to_livecrootc_patch, default='inactive')
-
- this%deadcrootc_xfer_to_deadcrootc_patch(begp:endp) = spval
- call hist_addfld1d (fname='C14_DEADCROOTC_XFER_TO_DEADCROOTC', units='gC14/m^2/s', &
- avgflag='A', long_name='C14 dead coarse root C growth from storage', &
- ptr_patch=this%deadcrootc_xfer_to_deadcrootc_patch, default='inactive')
-
- this%leafc_to_litter_patch(begp:endp) = spval
- call hist_addfld1d (fname='C14_LEAFC_TO_LITTER', units='gC14/m^2/s', &
- avgflag='A', long_name='C14 leaf C litterfall', &
- ptr_patch=this%leafc_to_litter_patch, default='inactive')
-
- this%frootc_to_litter_patch(begp:endp) = spval
- call hist_addfld1d (fname='C14_FROOTC_TO_LITTER', units='gC14/m^2/s', &
- avgflag='A', long_name='C14 fine root C litterfall', &
- ptr_patch=this%frootc_to_litter_patch, default='inactive')
-
- this%leaf_mr_patch(begp:endp) = spval
- call hist_addfld1d (fname='C14_LEAF_MR', units='gC14/m^2/s', &
- avgflag='A', long_name='C14 leaf maintenance respiration', &
- ptr_patch=this%leaf_mr_patch, default='inactive')
-
- this%froot_mr_patch(begp:endp) = spval
- call hist_addfld1d (fname='C14_FROOT_MR', units='gC14/m^2/s', &
- avgflag='A', long_name='C14 fine root maintenance respiration', &
- ptr_patch=this%froot_mr_patch, default='inactive')
-
- this%livestem_mr_patch(begp:endp) = spval
- call hist_addfld1d (fname='C14_LIVESTEM_MR', units='gC14/m^2/s', &
- avgflag='A', long_name='C14 live stem maintenance respiration', &
- ptr_patch=this%livestem_mr_patch, default='inactive')
-
- this%livecroot_mr_patch(begp:endp) = spval
- call hist_addfld1d (fname='C14_LIVECROOT_MR', units='gC14/m^2/s', &
- avgflag='A', long_name='C14 live coarse root maintenance respiration', &
- ptr_patch=this%livecroot_mr_patch, default='inactive')
-
- this%psnsun_to_cpool_patch(begp:endp) = spval
- call hist_addfld1d (fname='C14_PSNSUN_TO_CPOOL', units='gC14/m^2/s', &
- avgflag='A', long_name='C14 C fixation from sunlit canopy', &
- ptr_patch=this%psnsun_to_cpool_patch, default='inactive')
-
- this%psnshade_to_cpool_patch(begp:endp) = spval
- call hist_addfld1d (fname='C14_PSNSHADE_TO_CPOOL', units='gC14/m^2/s', &
- avgflag='A', long_name='C14 C fixation from shaded canopy', &
- ptr_patch=this%psnshade_to_cpool_patch, default='inactive')
-
- this%cpool_to_leafc_patch(begp:endp) = spval
- call hist_addfld1d (fname='C14_CPOOL_TO_LEAFC', units='gC14/m^2/s', &
- avgflag='A', long_name='C14 allocation to leaf C', &
- ptr_patch=this%cpool_to_leafc_patch, default='inactive')
-
- this%cpool_to_leafc_storage_patch(begp:endp) = spval
- call hist_addfld1d (fname='C14_CPOOL_TO_LEAFC_STORAGE', units='gC14/m^2/s', &
- avgflag='A', long_name='C14 allocation to leaf C storage', &
- ptr_patch=this%cpool_to_leafc_storage_patch, default='inactive')
-
- this%cpool_to_frootc_patch(begp:endp) = spval
- call hist_addfld1d (fname='C14_CPOOL_TO_FROOTC', units='gC14/m^2/s', &
- avgflag='A', long_name='C14 allocation to fine root C', &
- ptr_patch=this%cpool_to_frootc_patch, default='inactive')
-
- this%cpool_to_frootc_storage_patch(begp:endp) = spval
- call hist_addfld1d (fname='C14_CPOOL_TO_FROOTC_STORAGE', units='gC14/m^2/s', &
- avgflag='A', long_name='C14 allocation to fine root C storage', &
- ptr_patch=this%cpool_to_frootc_storage_patch, default='inactive')
-
- this%cpool_to_livestemc_patch(begp:endp) = spval
- call hist_addfld1d (fname='C14_CPOOL_TO_LIVESTEMC', units='gC14/m^2/s', &
- avgflag='A', long_name='C14 allocation to live stem C', &
- ptr_patch=this%cpool_to_livestemc_patch, default='inactive')
-
- this%cpool_to_livestemc_storage_patch(begp:endp) = spval
- call hist_addfld1d (fname='C14_CPOOL_TO_LIVESTEMC_STORAGE', units='gC14/m^2/s', &
- avgflag='A', long_name='C14 allocation to live stem C storage', &
- ptr_patch=this%cpool_to_livestemc_storage_patch, default='inactive')
-
- this%cpool_to_deadstemc_patch(begp:endp) = spval
- call hist_addfld1d (fname='C14_CPOOL_TO_DEADSTEMC', units='gC14/m^2/s', &
- avgflag='A', long_name='C14 allocation to dead stem C', &
- ptr_patch=this%cpool_to_deadstemc_patch, default='inactive')
-
- this%cpool_to_deadstemc_storage_patch(begp:endp) = spval
- call hist_addfld1d (fname='C14_CPOOL_TO_DEADSTEMC_STORAGE', units='gC14/m^2/s', &
- avgflag='A', long_name='C14 allocation to dead stem C storage', &
- ptr_patch=this%cpool_to_deadstemc_storage_patch, default='inactive')
-
- this%cpool_to_livecrootc_patch(begp:endp) = spval
- call hist_addfld1d (fname='C14_CPOOL_TO_LIVECROOTC', units='gC14/m^2/s', &
- avgflag='A', long_name='C14 allocation to live coarse root C', &
- ptr_patch=this%cpool_to_livecrootc_patch, default='inactive')
-
- this%cpool_to_livecrootc_storage_patch(begp:endp) = spval
- call hist_addfld1d (fname='C14_CPOOL_TO_LIVECROOTC_STORAGE', units='gC14/m^2/s', &
- avgflag='A', long_name='C14 allocation to live coarse root C storage', &
- ptr_patch=this%cpool_to_livecrootc_storage_patch, default='inactive')
-
- this%cpool_to_deadcrootc_patch(begp:endp) = spval
- call hist_addfld1d (fname='C14_CPOOL_TO_DEADCROOTC', units='gC14/m^2/s', &
- avgflag='A', long_name='C14 allocation to dead coarse root C', &
- ptr_patch=this%cpool_to_deadcrootc_patch, default='inactive')
-
- this%cpool_to_deadcrootc_storage_patch(begp:endp) = spval
- call hist_addfld1d (fname='C14_CPOOL_TO_DEADCROOTC_STORAGE', units='gC14/m^2/s', &
- avgflag='A', long_name='C14 allocation to dead coarse root C storage', &
- ptr_patch=this%cpool_to_deadcrootc_storage_patch, default='inactive')
-
- this%cpool_to_gresp_storage_patch(begp:endp) = spval
- call hist_addfld1d (fname='C14_CPOOL_TO_GRESP_STORAGE', units='gC14/m^2/s', &
- avgflag='A', long_name='C14 allocation to growth respiration storage', &
- ptr_patch=this%cpool_to_gresp_storage_patch, default='inactive')
-
- this%cpool_leaf_gr_patch(begp:endp) = spval
- call hist_addfld1d (fname='C14_CPOOL_LEAF_GR', units='gC14/m^2/s', &
- avgflag='A', long_name='C14 leaf growth respiration', &
- ptr_patch=this%cpool_leaf_gr_patch, default='inactive')
-
- this%cpool_leaf_storage_gr_patch(begp:endp) = spval
- call hist_addfld1d (fname='C14_CPOOL_LEAF_STORAGE_GR', units='gC14/m^2/s', &
- avgflag='A', long_name='C14 leaf growth respiration to storage', &
- ptr_patch=this%cpool_leaf_storage_gr_patch, default='inactive')
-
- this%transfer_leaf_gr_patch(begp:endp) = spval
- call hist_addfld1d (fname='C14_TRANSFER_LEAF_GR', units='gC14/m^2/s', &
- avgflag='A', long_name='C14 leaf growth respiration from storage', &
- ptr_patch=this%transfer_leaf_gr_patch, default='inactive')
-
- this%cpool_froot_gr_patch(begp:endp) = spval
- call hist_addfld1d (fname='C14_CPOOL_FROOT_GR', units='gC14/m^2/s', &
- avgflag='A', long_name='C14 fine root growth respiration', &
- ptr_patch=this%cpool_froot_gr_patch, default='inactive')
-
- this%cpool_froot_storage_gr_patch(begp:endp) = spval
- call hist_addfld1d (fname='C14_CPOOL_FROOT_STORAGE_GR', units='gC14/m^2/s', &
- avgflag='A', long_name='C14 fine root growth respiration to storage', &
- ptr_patch=this%cpool_froot_storage_gr_patch, default='inactive')
-
- this%transfer_froot_gr_patch(begp:endp) = spval
- call hist_addfld1d (fname='C14_TRANSFER_FROOT_GR', units='gC14/m^2/s', &
- avgflag='A', long_name='C14 fine root growth respiration from storage', &
- ptr_patch=this%transfer_froot_gr_patch, default='inactive')
-
- this%cpool_livestem_gr_patch(begp:endp) = spval
- call hist_addfld1d (fname='C14_CPOOL_LIVESTEM_GR', units='gC14/m^2/s', &
- avgflag='A', long_name='C14 live stem growth respiration', &
- ptr_patch=this%cpool_livestem_gr_patch, default='inactive')
-
- this%cpool_livestem_storage_gr_patch(begp:endp) = spval
- call hist_addfld1d (fname='C14_CPOOL_LIVESTEM_STORAGE_GR', units='gC14/m^2/s', &
- avgflag='A', long_name='C14 live stem growth respiration to storage', &
- ptr_patch=this%cpool_livestem_storage_gr_patch, default='inactive')
-
- this%transfer_livestem_gr_patch(begp:endp) = spval
- call hist_addfld1d (fname='C14_TRANSFER_LIVESTEM_GR', units='gC14/m^2/s', &
- avgflag='A', long_name='C14 live stem growth respiration from storage', &
- ptr_patch=this%transfer_livestem_gr_patch, default='inactive')
-
- this%cpool_deadstem_gr_patch(begp:endp) = spval
- call hist_addfld1d (fname='C14_CPOOL_DEADSTEM_GR', units='gC14/m^2/s', &
- avgflag='A', long_name='C14 dead stem growth respiration', &
- ptr_patch=this%cpool_deadstem_gr_patch, default='inactive')
-
- this%cpool_deadstem_storage_gr_patch(begp:endp) = spval
- call hist_addfld1d (fname='C14_CPOOL_DEADSTEM_STORAGE_GR', units='gC14/m^2/s', &
- avgflag='A', long_name='C14 dead stem growth respiration to storage', &
- ptr_patch=this%cpool_deadstem_storage_gr_patch, default='inactive')
-
- this%transfer_deadstem_gr_patch(begp:endp) = spval
- call hist_addfld1d (fname='C14_TRANSFER_DEADSTEM_GR', units='gC14/m^2/s', &
- avgflag='A', long_name='C14 dead stem growth respiration from storage', &
- ptr_patch=this%transfer_deadstem_gr_patch, default='inactive')
-
- this%cpool_livecroot_gr_patch(begp:endp) = spval
- call hist_addfld1d (fname='C14_CPOOL_LIVECROOT_GR', units='gC14/m^2/s', &
- avgflag='A', long_name='C14 live coarse root growth respiration', &
- ptr_patch=this%cpool_livecroot_gr_patch, default='inactive')
-
- this%cpool_livecroot_storage_gr_patch(begp:endp) = spval
- call hist_addfld1d (fname='C14_CPOOL_LIVECROOT_STORAGE_GR', units='gC14/m^2/s', &
- avgflag='A', long_name='C14 live coarse root growth respiration to storage', &
- ptr_patch=this%cpool_livecroot_storage_gr_patch, default='inactive')
-
- this%transfer_livecroot_gr_patch(begp:endp) = spval
- call hist_addfld1d (fname='C14_TRANSFER_LIVECROOT_GR', units='gC14/m^2/s', &
- avgflag='A', long_name='C14 live coarse root growth respiration from storage', &
- ptr_patch=this%transfer_livecroot_gr_patch, default='inactive')
-
- this%cpool_deadcroot_gr_patch(begp:endp) = spval
- call hist_addfld1d (fname='C14_CPOOL_DEADCROOT_GR', units='gC14/m^2/s', &
- avgflag='A', long_name='C14 dead coarse root growth respiration', &
- ptr_patch=this%cpool_deadcroot_gr_patch, default='inactive')
-
- this%cpool_deadcroot_storage_gr_patch(begp:endp) = spval
- call hist_addfld1d (fname='C14_CPOOL_DEADCROOT_STORAGE_GR', units='gC14/m^2/s', &
- avgflag='A', long_name='C14 dead coarse root growth respiration to storage', &
- ptr_patch=this%cpool_deadcroot_storage_gr_patch, default='inactive')
-
- this%transfer_deadcroot_gr_patch(begp:endp) = spval
- call hist_addfld1d (fname='C14_TRANSFER_DEADCROOT_GR', units='gC14/m^2/s', &
- avgflag='A', long_name='C14 dead coarse root growth respiration from storage', &
- ptr_patch=this%transfer_deadcroot_gr_patch, default='inactive')
-
- this%leafc_storage_to_xfer_patch(begp:endp) = spval
- call hist_addfld1d (fname='C14_LEAFC_STORAGE_TO_XFER', units='gC14/m^2/s', &
- avgflag='A', long_name='C14 leaf C shift storage to transfer', &
- ptr_patch=this%leafc_storage_to_xfer_patch, default='inactive')
-
- this%frootc_storage_to_xfer_patch(begp:endp) = spval
- call hist_addfld1d (fname='C14_FROOTC_STORAGE_TO_XFER', units='gC14/m^2/s', &
- avgflag='A', long_name='C14 fine root C shift storage to transfer', &
- ptr_patch=this%frootc_storage_to_xfer_patch, default='inactive')
-
- this%livestemc_storage_to_xfer_patch(begp:endp) = spval
- call hist_addfld1d (fname='C14_LIVESTEMC_STORAGE_TO_XFER', units='gC14/m^2/s', &
- avgflag='A', long_name='C14 live stem C shift storage to transfer', &
- ptr_patch=this%livestemc_storage_to_xfer_patch, default='inactive')
-
- this%deadstemc_storage_to_xfer_patch(begp:endp) = spval
- call hist_addfld1d (fname='C14_DEADSTEMC_STORAGE_TO_XFER', units='gC14/m^2/s', &
- avgflag='A', long_name='C14 dead stem C shift storage to transfer', &
- ptr_patch=this%deadstemc_storage_to_xfer_patch, default='inactive')
-
- this%livecrootc_storage_to_xfer_patch(begp:endp) = spval
- call hist_addfld1d (fname='C14_LIVECROOTC_STORAGE_TO_XFER', units='gC14/m^2/s', &
- avgflag='A', long_name='C14 live coarse root C shift storage to transfer', &
- ptr_patch=this%livecrootc_storage_to_xfer_patch, default='inactive')
-
- this%deadcrootc_storage_to_xfer_patch(begp:endp) = spval
- call hist_addfld1d (fname='C14_DEADCROOTC_STORAGE_TO_XFER', units='gC14/m^2/s', &
- avgflag='A', long_name='C14 dead coarse root C shift storage to transfer', &
- ptr_patch=this%deadcrootc_storage_to_xfer_patch, default='inactive')
-
- this%gresp_storage_to_xfer_patch(begp:endp) = spval
- call hist_addfld1d (fname='C14_GRESP_STORAGE_TO_XFER', units='gC14/m^2/s', &
- avgflag='A', long_name='C14 growth respiration shift storage to transfer', &
- ptr_patch=this%gresp_storage_to_xfer_patch, default='inactive')
-
- this%livestemc_to_deadstemc_patch(begp:endp) = spval
- call hist_addfld1d (fname='C14_LIVESTEMC_TO_DEADSTEMC', units='gC14/m^2/s', &
- avgflag='A', long_name='C14 live stem C turnover', &
- ptr_patch=this%livestemc_to_deadstemc_patch, default='inactive')
-
- this%livecrootc_to_deadcrootc_patch(begp:endp) = spval
- call hist_addfld1d (fname='C14_LIVECROOTC_TO_DEADCROOTC', units='gC14/m^2/s', &
- avgflag='A', long_name='C14 live coarse root C turnover', &
- ptr_patch=this%livecrootc_to_deadcrootc_patch, default='inactive')
-
- this%current_gr_patch(begp:endp) = spval
- call hist_addfld1d (fname='C14_CURRENT_GR', units='gC14/m^2/s', &
- avgflag='A', long_name='C14 growth resp for new growth displayed in this timestep', &
- ptr_patch=this%current_gr_patch, default='inactive')
-
- this%transfer_gr_patch(begp:endp) = spval
- call hist_addfld1d (fname='C14_TRANSFER_GR', units='gC14/m^2/s', &
- avgflag='A', long_name='C14 growth resp for transfer growth displayed in this timestep', &
- ptr_patch=this%transfer_gr_patch, default='inactive')
-
- this%storage_gr_patch(begp:endp) = spval
- call hist_addfld1d (fname='C14_STORAGE_GR', units='gC14/m^2/s', &
- avgflag='A', long_name='C14 growth resp for growth sent to storage for later display', &
- ptr_patch=this%storage_gr_patch, default='inactive')
-
- this%gpp_patch(begp:endp) = spval
- call hist_addfld1d (fname='C14_GPP', units='gC14/m^2/s', &
- avgflag='A', long_name='C14 gross primary production', &
- ptr_patch=this%gpp_patch, default='inactive')
-
- this%rr_patch(begp:endp) = spval
- call hist_addfld1d (fname='C14_RR', units='gC14/m^2/s', &
- avgflag='A', long_name='C14 root respiration (fine root MR + total root GR)', &
- ptr_patch=this%rr_patch, default='inactive')
-
- this%mr_patch(begp:endp) = spval
- call hist_addfld1d (fname='C14_MR', units='gC14/m^2/s', &
- avgflag='A', long_name='C14 maintenance respiration', &
- ptr_patch=this%mr_patch, default='inactive')
-
- this%gr_patch(begp:endp) = spval
- call hist_addfld1d (fname='C14_GR', units='gC14/m^2/s', &
- avgflag='A', long_name='C14 total growth respiration', &
- ptr_patch=this%gr_patch, default='inactive')
-
- this%ar_patch(begp:endp) = spval
- call hist_addfld1d (fname='C14_AR', units='gC14/m^2/s', &
- avgflag='A', long_name='C14 autotrophic respiration (MR + GR)', &
- ptr_patch=this%ar_patch, default='inactive')
-
- this%npp_patch(begp:endp) = spval
- call hist_addfld1d (fname='C14_NPP', units='gC14/m^2/s', &
- avgflag='A', long_name='C14 net primary production', &
- ptr_patch=this%npp_patch, default='inactive')
-
- this%agnpp_patch(begp:endp) = spval
- call hist_addfld1d (fname='C14_AGNPP', units='gC14/m^2/s', &
- avgflag='A', long_name='C14 aboveground NPP', &
- ptr_patch=this%agnpp_patch, default='inactive')
-
- this%bgnpp_patch(begp:endp) = spval
- call hist_addfld1d (fname='C14_BGNPP', units='gC14/m^2/s', &
- avgflag='A', long_name='C14 belowground NPP', &
- ptr_patch=this%bgnpp_patch, default='inactive')
-
- this%litfall_patch(begp:endp) = spval
- call hist_addfld1d (fname='C14_LITFALL', units='gC14/m^2/s', &
- avgflag='A', long_name='C14 litterfall (leaves and fine roots)', &
- ptr_patch=this%litfall_patch, default='inactive')
-
- this%fire_closs_patch(begp:endp) = spval
- call hist_addfld1d (fname='C14_PFT_FIRE_CLOSS', units='gC14/m^2/s', &
- avgflag='A', long_name='C14 total patch-level fire C loss', &
- ptr_patch=this%fire_closs_patch, default='inactive')
- endif
-
- !-------------------------------
- ! C flux variables - column
- !-------------------------------
-
- if (carbon_type == 'c12') then
-
- this%cwdc_loss_col(begc:endc) = spval
- call hist_addfld1d (fname='CWDC_LOSS', units='gC/m^2/s', &
- avgflag='A', long_name='coarse woody debris C loss', &
- ptr_col=this%cwdc_loss_col)
-
- this%m_decomp_cpools_to_fire_col(begc:endc,:) = spval
- this%m_decomp_cpools_to_fire_vr_col(begc:endc,:,:) = spval
- do k = 1, ndecomp_pools
- if ( decomp_cascade_con%is_litter(k) .or. decomp_cascade_con%is_cwd(k) ) then
- data1dptr => this%m_decomp_cpools_to_fire_col(:,k)
- fieldname = 'M_'//trim(decomp_cascade_con%decomp_pool_name_history(k))//'C_TO_FIRE'
- longname = trim(decomp_cascade_con%decomp_pool_name_long(k))//' C fire loss'
- call hist_addfld1d (fname=fieldname, units='gC/m^2/s', &
- avgflag='A', long_name=longname, &
- ptr_col=data1dptr, default='inactive')
-
- if ( nlevdecomp_full > 1 ) then
- data2dptr => this%m_decomp_cpools_to_fire_vr_col(:,:,k)
- fieldname = 'M_'//trim(decomp_cascade_con%decomp_pool_name_history(k))//'C_TO_FIRE'//trim(vr_suffix)
- longname = trim(decomp_cascade_con%decomp_pool_name_long(k))//' C fire loss'
- call hist_addfld_decomp (fname=fieldname, units='gC/m^3/s', type2d='levdcmp', &
- avgflag='A', long_name=longname, &
- ptr_col=data2dptr, default='inactive')
- endif
- endif
- end do
-
- this%dwt_seedc_to_leaf_grc(begg:endg) = spval
- call hist_addfld1d (fname='DWT_SEEDC_TO_LEAF', units='gC/m^2/s', &
- avgflag='A', long_name='seed source to patch-level leaf', &
- ptr_gcell=this%dwt_seedc_to_leaf_grc, default='inactive')
-
- this%dwt_seedc_to_leaf_patch(begp:endp) = spval
- call hist_addfld1d (fname='DWT_SEEDC_TO_LEAF_PATCH', units='gC/m^2/s', &
- avgflag='A', &
- long_name='patch-level seed source to patch-level leaf ' // &
- '(per-area-gridcell; only makes sense with dov2xy=.false.)', &
- ptr_patch=this%dwt_seedc_to_leaf_patch, default='inactive')
-
- this%dwt_seedc_to_deadstem_grc(begg:endg) = spval
- call hist_addfld1d (fname='DWT_SEEDC_TO_DEADSTEM', units='gC/m^2/s', &
- avgflag='A', long_name='seed source to patch-level deadstem', &
- ptr_gcell=this%dwt_seedc_to_deadstem_grc, default='inactive')
-
- this%dwt_seedc_to_deadstem_patch(begp:endp) = spval
- call hist_addfld1d (fname='DWT_SEEDC_TO_DEADSTEM_PATCH', units='gC/m^2/s', &
- avgflag='A', &
- long_name='patch-level seed source to patch-level deadstem ' // &
- '(per-area-gridcell; only makes sense with dov2xy=.false.)', &
- ptr_patch=this%dwt_seedc_to_deadstem_patch, default='inactive')
-
- this%dwt_conv_cflux_grc(begg:endg) = spval
- call hist_addfld1d (fname='DWT_CONV_CFLUX', units='gC/m^2/s', &
- avgflag='A', &
- long_name='conversion C flux (immediate loss to atm) (0 at all times except first timestep of year)', &
- ptr_gcell=this%dwt_conv_cflux_grc, default='inactive')
-
- this%dwt_conv_cflux_patch(begp:endp) = spval
- call hist_addfld1d (fname='DWT_CONV_CFLUX_PATCH', units='gC/m^2/s', &
- avgflag='A', &
- long_name='patch-level conversion C flux (immediate loss to atm) ' // &
- '(0 at all times except first timestep of year) ' // &
- '(per-area-gridcell; only makes sense with dov2xy=.false.)', &
- ptr_patch=this%dwt_conv_cflux_patch, default='inactive')
-
- this%dwt_conv_cflux_dribbled_grc(begg:endg) = spval
- call hist_addfld1d (fname='DWT_CONV_CFLUX_DRIBBLED', units='gC/m^2/s', &
- avgflag='A', &
- long_name='conversion C flux (immediate loss to atm), dribbled throughout the year', &
- ptr_gcell=this%dwt_conv_cflux_dribbled_grc, default='inactive')
-
- this%dwt_wood_productc_gain_patch(begp:endp) = spval
- call hist_addfld1d (fname='DWT_WOOD_PRODUCTC_GAIN_PATCH', units='gC/m^2/s', &
- avgflag='A', &
- long_name='patch-level landcover change-driven addition to wood product pools' // &
- '(0 at all times except first timestep of year) ' // &
- '(per-area-gridcell; only makes sense with dov2xy=.false.)', &
- ptr_patch=this%dwt_wood_productc_gain_patch, default='inactive')
-
- this%dwt_slash_cflux_col(begc:endc) = spval
- call hist_addfld1d (fname='DWT_SLASH_CFLUX', units='gC/m^2/s', &
- avgflag='A', long_name='slash C flux to litter and CWD due to land use', &
- ptr_col=this%dwt_slash_cflux_col, default='inactive')
-
- this%dwt_frootc_to_litr_met_c_col(begc:endc,:) = spval
- call hist_addfld_decomp (fname='DWT_FROOTC_TO_LITR_MET_C', units='gC/m^2/s', type2d='levdcmp', &
- avgflag='A', long_name='fine root to litter due to landcover change', &
- ptr_col=this%dwt_frootc_to_litr_met_c_col, default='inactive')
-
- this%dwt_frootc_to_litr_cel_c_col(begc:endc,:) = spval
- call hist_addfld_decomp (fname='DWT_FROOTC_TO_LITR_CEL_C', units='gC/m^2/s', type2d='levdcmp', &
- avgflag='A', long_name='fine root to litter due to landcover change', &
- ptr_col=this%dwt_frootc_to_litr_cel_c_col, default='inactive')
-
- this%dwt_frootc_to_litr_lig_c_col(begc:endc,:) = spval
- call hist_addfld_decomp (fname='DWT_FROOTC_TO_LITR_LIG_C', units='gC/m^2/s', type2d='levdcmp', &
- avgflag='A', long_name='fine root to litter due to landcover change', &
- ptr_col=this%dwt_frootc_to_litr_lig_c_col, default='inactive')
-
- this%dwt_livecrootc_to_cwdc_col(begc:endc,:) = spval
- call hist_addfld_decomp (fname='DWT_LIVECROOTC_TO_CWDC', units='gC/m^2/s', type2d='levdcmp', &
- avgflag='A', long_name='live coarse root to CWD due to landcover change', &
- ptr_col=this%dwt_livecrootc_to_cwdc_col, default='inactive')
-
- this%dwt_deadcrootc_to_cwdc_col(begc:endc,:) = spval
- call hist_addfld_decomp (fname='DWT_DEADCROOTC_TO_CWDC', units='gC/m^2/s', type2d='levdcmp', &
- avgflag='A', long_name='dead coarse root to CWD due to landcover change', &
- ptr_col=this%dwt_deadcrootc_to_cwdc_col, default='inactive')
-
- this%crop_seedc_to_leaf_patch(begp:endp) = spval
- call hist_addfld1d (fname='CROP_SEEDC_TO_LEAF', units='gC/m^2/s', &
- avgflag='A', long_name='crop seed source to leaf', &
- ptr_patch=this%crop_seedc_to_leaf_patch, default='inactive')
-
- this%sr_col(begc:endc) = spval
- call hist_addfld1d (fname='SR', units='gC/m^2/s', &
- avgflag='A', long_name='total soil respiration (HR + root resp)', &
- ptr_col=this%sr_col, default='inactive')
-
- this%er_col(begc:endc) = spval
- call hist_addfld1d (fname='ER', units='gC/m^2/s', &
- avgflag='A', long_name='total ecosystem respiration, autotrophic + heterotrophic', &
- ptr_col=this%er_col, default='inactive')
-
- this%litfire_col(begc:endc) = spval
- call hist_addfld1d (fname='LITFIRE', units='gC/m^2/s', &
- avgflag='A', long_name='litter fire losses', &
- ptr_col=this%litfire_col, default='inactive')
-
- this%somfire_col(begc:endc) = spval
- call hist_addfld1d (fname='SOMFIRE', units='gC/m^2/s', &
- avgflag='A', long_name='soil organic matter fire losses', &
- ptr_col=this%somfire_col, default='inactive')
-
- this%totfire_col(begc:endc) = spval
- call hist_addfld1d (fname='TOTFIRE', units='gC/m^2/s', &
- avgflag='A', long_name='total ecosystem fire losses', &
- ptr_col=this%totfire_col, default='inactive')
-
- this%fire_closs_col(begc:endc) = spval
- call hist_addfld1d (fname='COL_FIRE_CLOSS', units='gC/m^2/s', &
- 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%annsum_npp_patch(begp:endp) = spval
- call hist_addfld1d (fname='ANNSUM_NPP', units='gC/m^2/yr', &
- avgflag='A', long_name='annual sum of NPP', &
- ptr_patch=this%annsum_npp_patch, default='inactive')
-
- this%annsum_npp_col(begc:endc) = spval
- call hist_addfld1d (fname='CANNSUM_NPP', units='gC/m^2/s', &
- avgflag='A', long_name='annual sum of column-level NPP', &
- ptr_col=this%annsum_npp_col, default='inactive')
-
- this%nep_col(begc:endc) = spval
- call hist_addfld1d (fname='NEP', units='gC/m^2/s', &
- avgflag='A', long_name='net ecosystem production, excludes fire, landuse, and harvest flux, positive for sink', &
- ptr_col=this%nep_col, default='inactive')
-
- this%nbp_grc(begg:endg) = spval
- call hist_addfld1d (fname='NBP', units='gC/m^2/s', &
- avgflag='A', long_name='net biome production, includes fire, landuse,'&
- //' harvest and hrv_xsmrpool flux (latter smoothed over the year), positive for sink'&
- //' (same as net carbon exchange between land and atmosphere)', &
- ptr_gcell=this%nbp_grc, default='inactive')
-
- this%nee_grc(begg:endg) = spval
- call hist_addfld1d (fname='NEE', units='gC/m^2/s', &
- avgflag='A', long_name='net ecosystem exchange of carbon,'&
- //' includes fire and hrv_xsmrpool (latter smoothed over the year),'&
- //' excludes landuse and harvest flux, positive for source', &
- ptr_gcell=this%nee_grc, default='inactive')
-
- this%landuseflux_grc(begg:endg) = spval
- call hist_addfld1d (fname='LAND_USE_FLUX', units='gC/m^2/s', &
- avgflag='A', &
- long_name='total C emitted from land cover conversion (smoothed over the year)'&
- //' and wood and grain product pools (NOTE: not a net value)', &
- ptr_gcell=this%landuseflux_grc, default='inactive')
-
- end if
- !-------------------------------
- ! C13 flux variables - column
- !-------------------------------
-
- if ( carbon_type == 'c13' ) then
-
- this%m_decomp_cpools_to_fire_col(begc:endc,:) = spval
- this%m_decomp_cpools_to_fire_vr_col(begc:endc,:,:) = spval
- do k = 1, ndecomp_pools
- if ( decomp_cascade_con%is_litter(k) .or. decomp_cascade_con%is_cwd(k) ) then
- data1dptr => this%m_decomp_cpools_to_fire_col(:,k)
- fieldname = 'C13_M_'//trim(decomp_cascade_con%decomp_pool_name_history(k))//'C_TO_FIRE'
- longname = 'C13 '//trim(decomp_cascade_con%decomp_pool_name_long(k))//' C fire loss'
- call hist_addfld1d (fname=fieldname, units='gC13/m^2', &
- avgflag='A', long_name=longname, &
- ptr_col=data1dptr, default='inactive')
-
- if ( nlevdecomp_full > 1 ) then
- data2dptr => this%m_decomp_cpools_to_fire_vr_col(:,:,k)
- fieldname = 'C13_M_'//trim(decomp_cascade_con%decomp_pool_name_history(k))//'C_TO_FIRE'//trim(vr_suffix)
- longname = 'C13 '//trim(decomp_cascade_con%decomp_pool_name_long(k))//' C fire loss'
- call hist_addfld_decomp (fname=fieldname, units='gC13/m^3', type2d='levdcmp', &
- avgflag='A', long_name=longname, &
- ptr_col=data2dptr, default='inactive')
- end if
- endif
- end do
-
- this%dwt_seedc_to_leaf_grc(begg:endg) = spval
- call hist_addfld1d (fname='C13_DWT_SEEDC_TO_LEAF', units='gC13/m^2/s', &
- avgflag='A', long_name='C13 seed source to patch-level leaf', &
- ptr_gcell=this%dwt_seedc_to_leaf_grc, default='inactive')
-
- this%dwt_seedc_to_leaf_patch(begp:endp) = spval
- call hist_addfld1d (fname='C13_DWT_SEEDC_TO_LEAF_PATCH', units='gC13/m^2/s', &
- avgflag='A', &
- long_name='patch-level C13 seed source to patch-level leaf ' // &
- '(per-area-gridcell; only makes sense with dov2xy=.false.)', &
- ptr_patch=this%dwt_seedc_to_leaf_patch, default='inactive')
-
- this%dwt_seedc_to_deadstem_grc(begg:endg) = spval
- call hist_addfld1d (fname='C13_DWT_SEEDC_TO_DEADSTEM', units='gC13/m^2/s', &
- avgflag='A', long_name='C13 seed source to patch-level deadstem', &
- ptr_gcell=this%dwt_seedc_to_deadstem_grc, default='inactive')
-
- this%dwt_seedc_to_deadstem_patch(begp:endp) = spval
- call hist_addfld1d (fname='C13_DWT_SEEDC_TO_DEADSTEM_PATCH', units='gC13/m^2/s', &
- avgflag='A', &
- long_name='patch-level C13 seed source to patch-level deadstem ' // &
- '(per-area-gridcell; only makes sense with dov2xy=.false.)', &
- ptr_patch=this%dwt_seedc_to_deadstem_patch, default='inactive')
-
- this%dwt_conv_cflux_grc(begg:endg) = spval
- call hist_addfld1d (fname='C13_DWT_CONV_CFLUX', units='gC13/m^2/s', &
- avgflag='A', long_name='C13 conversion C flux (immediate loss to atm) ' // &
- '(0 at all times except first timestep of year)', &
- ptr_gcell=this%dwt_conv_cflux_grc, default='inactive')
-
- this%dwt_conv_cflux_patch(begp:endp) = spval
- call hist_addfld1d (fname='C13_DWT_CONV_CFLUX_PATCH', units='gC13/m^2/s', &
- avgflag='A', &
- long_name='patch-level C13 conversion C flux (immediate loss to atm) ' // &
- '(0 at all times except first timestep of year) ' // &
- '(per-area-gridcell; only makes sense with dov2xy=.false.)', &
- ptr_patch=this%dwt_conv_cflux_patch, default='inactive')
-
- this%dwt_conv_cflux_dribbled_grc(begg:endg) = spval
- call hist_addfld1d (fname='C13_DWT_CONV_CFLUX_DRIBBLED', units='gC13/m^2/s', &
- avgflag='A', &
- long_name='C13 conversion C flux (immediate loss to atm), dribbled throughout the year', &
- ptr_gcell=this%dwt_conv_cflux_dribbled_grc, default='inactive')
-
- this%dwt_slash_cflux_col(begc:endc) = spval
- call hist_addfld1d (fname='C13_DWT_SLASH_CFLUX', units='gC/m^2/s', &
- avgflag='A', long_name='C13 slash C flux to litter and CWD due to land use', &
- ptr_col=this%dwt_slash_cflux_col, default='inactive')
-
- this%dwt_frootc_to_litr_met_c_col(begc:endc,:) = spval
- call hist_addfld_decomp (fname='C13_DWT_FROOTC_TO_LITR_MET_C', units='gC13/m^2/s', type2d='levdcmp', &
- avgflag='A', long_name='C13 fine root to litter due to landcover change', &
- ptr_col=this%dwt_frootc_to_litr_met_c_col, default='inactive')
-
- this%dwt_frootc_to_litr_cel_c_col(begc:endc,:) = spval
- call hist_addfld_decomp (fname='C13_DWT_FROOTC_TO_LITR_CEL_C', units='gC13/m^2/s', type2d='levdcmp', &
- avgflag='A', long_name='C13 fine root to litter due to landcover change', &
- ptr_col=this%dwt_frootc_to_litr_cel_c_col, default='inactive')
-
- this%dwt_frootc_to_litr_lig_c_col(begc:endc,:) = spval
- call hist_addfld_decomp (fname='C13_DWT_FROOTC_TO_LITR_LIG_C', units='gC13/m^2/s', type2d='levdcmp', &
- avgflag='A', long_name='C13 fine root to litter due to landcover change', &
- ptr_col=this%dwt_frootc_to_litr_lig_c_col, default='inactive')
-
- this%dwt_livecrootc_to_cwdc_col(begc:endc,:) = spval
- call hist_addfld_decomp (fname='C13_DWT_LIVECROOTC_TO_CWDC', units='gC13/m^2/s', type2d='levdcmp', &
- avgflag='A', long_name='C13 live coarse root to CWD due to landcover change', &
- ptr_col=this%dwt_livecrootc_to_cwdc_col, default='inactive')
-
- this%dwt_deadcrootc_to_cwdc_col(begc:endc,:) = spval
- call hist_addfld_decomp (fname='C13_DWT_DEADCROOTC_TO_CWDC', units='gC13/m^2/s', type2d='levdcmp', &
- avgflag='A', long_name='C13 dead coarse root to CWD due to landcover change', &
- ptr_col=this%dwt_deadcrootc_to_cwdc_col, default='inactive')
-
- this%crop_seedc_to_leaf_patch(begp:endp) = spval
- call hist_addfld1d (fname='C13_CROP_SEEDC_TO_LEAF', units='gC13/m^2/s', &
- avgflag='A', long_name='C13 crop seed source to leaf', &
- ptr_patch=this%crop_seedc_to_leaf_patch, default='inactive')
-
- this%sr_col(begc:endc) = spval
- call hist_addfld1d (fname='C13_SR', units='gC13/m^2/s', &
- avgflag='A', long_name='C13 total soil respiration (HR + root resp)', &
- ptr_col=this%sr_col, default='inactive')
-
- this%er_col(begc:endc) = spval
- call hist_addfld1d (fname='C13_ER', units='gC13/m^2/s', &
- avgflag='A', long_name='C13 total ecosystem respiration, autotrophic + heterotrophic', &
- ptr_col=this%er_col, default='inactive')
-
- this%litfire_col(begc:endc) = spval
- call hist_addfld1d (fname='C13_LITFIRE', units='gC13/m^2/s', &
- avgflag='A', long_name='C13 litter fire losses', &
- ptr_col=this%litfire_col, default='inactive')
-
- this%somfire_col(begc:endc) = spval
- call hist_addfld1d (fname='C13_SOMFIRE', units='gC13/m^2/s', &
- avgflag='A', long_name='C13 soil organic matter fire losses', &
- ptr_col=this%somfire_col, default='inactive')
-
- this%totfire_col(begc:endc) = spval
- call hist_addfld1d (fname='C13_TOTFIRE', units='gC13/m^2/s', &
- avgflag='A', long_name='C13 total ecosystem fire losses', &
- ptr_col=this%totfire_col, default='inactive')
-
- this%fire_closs_col(begc:endc) = spval
- call hist_addfld1d (fname='C13_COL_FIRE_CLOSS', units='gC13/m^2/s', &
- avgflag='A', long_name='C13 total column-level fire C loss', &
- ptr_col=this%fire_closs_col, default='inactive')
-
- this%nep_col(begc:endc) = spval
- call hist_addfld1d (fname='C13_NEP', units='gC13/m^2/s', &
- avgflag='A', long_name='C13 net ecosystem production, excludes fire flux, positive for sink', &
- ptr_col=this%nep_col, default='inactive')
-
- this%nee_grc(begg:endg) = spval
- call hist_addfld1d (fname='C13_NEE', units='gC13/m^2/s', &
- avgflag='A', long_name='C13 net ecosystem exchange of carbon, includes fire flux, positive for source', &
- ptr_gcell=this%nee_grc, default='inactive')
-
- endif
-
- !-------------------------------
- ! C14 flux variables - column
- !-------------------------------
-
- if (carbon_type == 'c14') then
-
- this%m_decomp_cpools_to_fire_col(begc:endc,:) = spval
- this%m_decomp_cpools_to_fire_vr_col(begc:endc,:,:) = spval
- do k = 1, ndecomp_pools
- if ( decomp_cascade_con%is_litter(k) .or. decomp_cascade_con%is_cwd(k) ) then
- data1dptr => this%m_decomp_cpools_to_fire_col(:,k)
- fieldname = 'C14_M_'//trim(decomp_cascade_con%decomp_pool_name_history(k))//'C_TO_FIRE'
- longname = 'C14 '//trim(decomp_cascade_con%decomp_pool_name_long(k))//' C fire loss'
- call hist_addfld1d (fname=fieldname, units='gC14/m^2', &
- avgflag='A', long_name=longname, &
- ptr_col=data1dptr, default='inactive')
-
- if ( nlevdecomp_full > 1 ) then
- data2dptr => this%m_decomp_cpools_to_fire_vr_col(:,:,k)
- fieldname = 'C14_M_'//trim(decomp_cascade_con%decomp_pool_name_history(k))//'C_TO_FIRE'//trim(vr_suffix)
- longname = 'C14 '//trim(decomp_cascade_con%decomp_pool_name_long(k))//' C fire loss'
- call hist_addfld_decomp (fname=fieldname, units='gC14/m^3', type2d='levdcmp', &
- avgflag='A', long_name=longname, &
- ptr_col=data2dptr, default='inactive')
- end if
- endif
- end do
-
- this%dwt_seedc_to_leaf_grc(begg:endg) = spval
- call hist_addfld1d (fname='C14_DWT_SEEDC_TO_LEAF', units='gC14/m^2/s', &
- avgflag='A', long_name='C14 seed source to patch-level leaf', &
- ptr_gcell=this%dwt_seedc_to_leaf_grc, default='inactive')
-
- this%dwt_seedc_to_leaf_patch(begp:endp) = spval
- call hist_addfld1d (fname='C14_DWT_SEEDC_TO_LEAF_PATCH', units='gC14/m^2/s', &
- avgflag='A', &
- long_name='patch-level C14 seed source to patch-level leaf ' // &
- '(per-area-gridcell; only makes sense with dov2xy=.false.)', &
- ptr_patch=this%dwt_seedc_to_leaf_patch, default='inactive')
-
- this%dwt_seedc_to_deadstem_grc(begg:endg) = spval
- call hist_addfld1d (fname='C14_DWT_SEEDC_TO_DEADSTEM', units='gC14/m^2/s', &
- avgflag='A', long_name='C14 seed source to patch-level deadstem', &
- ptr_gcell=this%dwt_seedc_to_deadstem_grc, default='inactive')
-
- this%dwt_seedc_to_deadstem_patch(begp:endp) = spval
- call hist_addfld1d (fname='C14_DWT_SEEDC_TO_DEADSTEM_PATCH', units='gC14/m^2/s', &
- avgflag='A', &
- long_name='patch-level C14 seed source to patch-level deadstem ' // &
- '(per-area-gridcell; only makes sense with dov2xy=.false.)', &
- ptr_patch=this%dwt_seedc_to_deadstem_patch, default='inactive')
-
- this%dwt_conv_cflux_grc(begg:endg) = spval
- call hist_addfld1d (fname='C14_DWT_CONV_CFLUX', units='gC14/m^2/s', &
- avgflag='A', long_name='C14 conversion C flux (immediate loss to atm) ' // &
- '(0 at all times except first timestep of year)', &
- ptr_gcell=this%dwt_conv_cflux_grc, default='inactive')
-
- this%dwt_conv_cflux_patch(begp:endp) = spval
- call hist_addfld1d (fname='C14_DWT_CONV_CFLUX_PATCH', units='gC14/m^2/s', &
- avgflag='A', &
- long_name='patch-level C14 conversion C flux (immediate loss to atm) ' // &
- '(0 at all times except first timestep of year) ' // &
- '(per-area-gridcell; only makes sense with dov2xy=.false.)', &
- ptr_patch=this%dwt_conv_cflux_patch, default='inactive')
-
- this%dwt_conv_cflux_dribbled_grc(begg:endg) = spval
- call hist_addfld1d (fname='C14_DWT_CONV_CFLUX_DRIBBLED', units='gC14/m^2/s', &
- avgflag='A', &
- long_name='C14 conversion C flux (immediate loss to atm), dribbled throughout the year', &
- ptr_gcell=this%dwt_conv_cflux_dribbled_grc, default='inactive')
-
- this%dwt_slash_cflux_col(begc:endc) = spval
- call hist_addfld1d (fname='C14_DWT_SLASH_CFLUX', units='gC/m^2/s', &
- avgflag='A', long_name='C14 slash C flux to litter and CWD due to land use', &
- ptr_col=this%dwt_slash_cflux_col, default='inactive')
-
- this%dwt_frootc_to_litr_met_c_col(begc:endc,:) = spval
- call hist_addfld_decomp (fname='C14_DWT_FROOTC_TO_LITR_MET_C', units='gC14/m^2/s', type2d='levdcmp', &
- avgflag='A', long_name='C14 fine root to litter due to landcover change', &
- ptr_col=this%dwt_frootc_to_litr_met_c_col, default='inactive')
-
- this%dwt_frootc_to_litr_cel_c_col(begc:endc,:) = spval
- call hist_addfld_decomp (fname='C14_DWT_FROOTC_TO_LITR_CEL_C', units='gC14/m^2/s', type2d='levdcmp', &
- avgflag='A', long_name='C14 fine root to litter due to landcover change', &
- ptr_col=this%dwt_frootc_to_litr_cel_c_col, default='inactive')
-
- this%dwt_frootc_to_litr_lig_c_col(begc:endc,:) = spval
- call hist_addfld_decomp (fname='C14_DWT_FROOTC_TO_LITR_LIG_C', units='gC14/m^2/s', type2d='levdcmp', &
- avgflag='A', long_name='C14 fine root to litter due to landcover change', &
- ptr_col=this%dwt_frootc_to_litr_lig_c_col, default='inactive')
-
- this%dwt_livecrootc_to_cwdc_col(begc:endc,:) = spval
- call hist_addfld_decomp (fname='C14_DWT_LIVECROOTC_TO_CWDC', units='gC14/m^2/s', type2d='levdcmp', &
- avgflag='A', long_name='C14 live coarse root to CWD due to landcover change', &
- ptr_col=this%dwt_livecrootc_to_cwdc_col, default='inactive')
-
- this%dwt_deadcrootc_to_cwdc_col(begc:endc,:) = spval
- call hist_addfld_decomp (fname='C14_DWT_DEADCROOTC_TO_CWDC', units='gC14/m^2/s', type2d='levdcmp', &
- avgflag='A', long_name='C14 dead coarse root to CWD due to landcover change', &
- ptr_col=this%dwt_deadcrootc_to_cwdc_col, default='inactive')
-
- this%crop_seedc_to_leaf_patch(begp:endp) = spval
- call hist_addfld1d (fname='C14_CROP_SEEDC_TO_LEAF', units='gC14/m^2/s', &
- avgflag='A', long_name='C14 crop seed source to leaf', &
- ptr_patch=this%crop_seedc_to_leaf_patch, default='inactive')
-
- this%sr_col(begc:endc) = spval
- call hist_addfld1d (fname='C14_SR', units='gC14/m^2/s', &
- avgflag='A', long_name='C14 total soil respiration (HR + root resp)', &
- ptr_col=this%sr_col, default='inactive')
-
- this%er_col(begc:endc) = spval
- call hist_addfld1d (fname='C14_ER', units='gC14/m^2/s', &
- avgflag='A', long_name='C14 total ecosystem respiration, autotrophic + heterotrophic', &
- ptr_col=this%er_col, default='inactive')
-
- this%litfire_col(begc:endc) = spval
- call hist_addfld1d (fname='C14_LITFIRE', units='gC14/m^2/s', &
- avgflag='A', long_name='C14 litter fire losses', &
- ptr_col=this%litfire_col, default='inactive')
-
- this%somfire_col(begc:endc) = spval
- call hist_addfld1d (fname='C14_SOMFIRE', units='gC14/m^2/s', &
- avgflag='A', long_name='C14 soil organic matter fire losses', &
- ptr_col=this%somfire_col, default='inactive')
-
- this%totfire_col(begc:endc) = spval
- call hist_addfld1d (fname='C14_TOTFIRE', units='gC14/m^2/s', &
- avgflag='A', long_name='C14 total ecosystem fire losses', &
- ptr_col=this%totfire_col, default='inactive')
-
- this%fire_closs_col(begc:endc) = spval
- call hist_addfld1d (fname='C14_COL_FIRE_CLOSS', units='gC14/m^2/s', &
- avgflag='A', long_name='C14 total column-level fire C loss', &
- ptr_col=this%fire_closs_col, default='inactive')
-
- this%nep_col(begc:endc) = spval
- call hist_addfld1d (fname='C14_NEP', units='gC14/m^2/s', &
- avgflag='A', long_name='C14 net ecosystem production, excludes fire flux, positive for sink', &
- ptr_col=this%nep_col, default='inactive')
-
- this%nee_grc(begg:endg) = spval
- call hist_addfld1d (fname='C14_NEE', units='gC14/m^2/s', &
- avgflag='A', long_name='C14 net ecosystem exchange of carbon, includes fire flux, positive for source', &
- ptr_gcell=this%nee_grc, default='inactive')
-
- endif
-
- end subroutine InitHistory
-
- !-----------------------------------------------------------------------
- subroutine InitCold(this, bounds)
- !
- ! !ARGUMENTS:
- class(cnveg_carbonflux_type) :: this
- type(bounds_type), intent(in) :: bounds
- !
- ! !LOCAL VARIABLES:
- integer :: p, c, l, j
- integer :: fc ! filter index
- integer :: num_special_col ! number of good values in special_col filter
- integer :: num_special_patch ! number of good values in special_patch filter
- integer :: special_col(bounds%endc-bounds%begc+1) ! special landunit filter - columns
- integer :: special_patch(bounds%endp-bounds%begp+1) ! special landunit filter - patches
- !-----------------------------------------------------------------------
-
- ! Set column filters
-
- num_special_col = 0
- do c = bounds%begc, bounds%endc
- l = col%landunit(c)
- if (lun%ifspecial(l)) then
- num_special_col = num_special_col + 1
- special_col(num_special_col) = c
- end if
- end do
-
- ! Set patch filters
-
- num_special_patch = 0
- do p = bounds%begp,bounds%endp
- l = patch%landunit(p)
-
- if (lun%ifspecial(l)) then
- num_special_patch = num_special_patch + 1
- special_patch(num_special_patch) = p
- end if
- end do
-
- do p = bounds%begp,bounds%endp
- l = patch%landunit(p)
- this%gpp_before_downreg_patch(p) = 0._r8
-
- if (lun%ifspecial(l)) then
- this%availc_patch(p) = spval
- this%xsmrpool_recover_patch(p) = spval
- this%excess_cflux_patch(p) = spval
- this%plant_calloc_patch(p) = spval
- this%prev_leafc_to_litter_patch(p) = spval
- this%prev_frootc_to_litter_patch(p) = spval
- this%leafc_to_litter_fun_patch(p) = spval
- end if
- if (lun%itype(l) == istsoil .or. lun%itype(l) == istcrop) then
- this%availc_patch(p) = 0._r8
- this%xsmrpool_recover_patch(p) = 0._r8
- this%excess_cflux_patch(p) = 0._r8
- this%prev_leafc_to_litter_patch(p) = 0._r8
- this%leafc_to_litter_fun_patch(p) = 0._r8
- this%prev_frootc_to_litter_patch(p) = 0._r8
- this%plant_calloc_patch(p) = 0._r8
- end if
- end do
-
- do c = bounds%begc, bounds%endc
- l = col%landunit(c)
-
- ! also initialize dynamic landcover fluxes so that they have
- ! real values on first timestep, prior to calling pftdyn_cnbal
- if (lun%itype(l) == istsoil .or. lun%itype(l) == istcrop) then
- this%dwt_slash_cflux_col(c) = 0._r8
- do j = 1, nlevdecomp_full
- this%dwt_frootc_to_litr_met_c_col(c,j) = 0._r8
- this%dwt_frootc_to_litr_cel_c_col(c,j) = 0._r8
- this%dwt_frootc_to_litr_lig_c_col(c,j) = 0._r8
- this%dwt_livecrootc_to_cwdc_col(c,j) = 0._r8
- this%dwt_deadcrootc_to_cwdc_col(c,j) = 0._r8
- end do
- end if
- end do
-
- do p = bounds%begp,bounds%endp
- l = patch%landunit(p)
-
- this%gpp_patch(p) = 0._r8
- if (lun%ifspecial(l)) then
- this%tempsum_npp_patch(p) = spval
- this%annsum_npp_patch(p) = spval
- this%tempsum_litfall_patch(p) = spval
- this%annsum_litfall_patch(p) = spval
- end if
- if (lun%itype(l) == istsoil .or. lun%itype(l) == istcrop) then
- this%tempsum_npp_patch(p) = 0._r8
- this%annsum_npp_patch(p) = 0._r8
- this%tempsum_litfall_patch(p) = 0._r8
- this%annsum_litfall_patch(p) = 0._r8
- end if
- end do
-
- do c = bounds%begc, bounds%endc
- l = col%landunit(c)
-
- if (lun%ifspecial(l)) then
- this%annsum_npp_col(c) = spval
- end if
-
- ! also initialize dynamic landcover fluxes so that they have
- ! real values on first timestep, prior to calling pftdyn_cnbal
- if (lun%itype(l) == istsoil .or. lun%itype(l) == istcrop) then
- this%annsum_npp_col(c) = 0._r8
- end if
- end do
-
- ! initialize fields for special filters
-
- call this%SetValues (&
- num_patch=num_special_patch, filter_patch=special_patch, value_patch=0._r8, &
- num_column=num_special_col, filter_column=special_col, value_column=0._r8)
-
- end subroutine InitCold
-
- !-----------------------------------------------------------------------
- subroutine Restart ( this, bounds, ncid, flag, carbon_type )
- !
- ! !DESCRIPTION:
- ! Read/write CN restart data for carbon fluxes
- !
- ! !USES:
- use ncdio_pio, only : file_desc_t
- !
- ! !ARGUMENTS:
- class (cnveg_carbonflux_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'
- character(len=*) , intent(in) :: carbon_type ! 'c12' or 'c13' or 'c14'
- !------------------------------------------------------------------------
-
- if (carbon_type == 'c12') then
- call this%RestartBulkOnly(bounds, ncid, flag)
- end if
-
- call this%RestartAllIsotopes(bounds, ncid, flag)
-
- end subroutine Restart
-
-
- !-----------------------------------------------------------------------
- subroutine RestartBulkOnly ( this, bounds, ncid, flag )
- !
- ! !DESCRIPTION:
- ! Read/write CN restart data for carbon fluxes - fields only present for bulk C
- !
- ! !USES:
- use shr_infnan_mod , only : isnan => shr_infnan_isnan, nan => shr_infnan_nan, assignment(=)
- use clm_time_manager , only : is_restart
- use clm_varcon , only : c13ratio, c14ratio
- use CNSharedParamsMod, only : use_fun
- use restUtilMod
- use ncdio_pio
- !
- ! !ARGUMENTS:
- class (cnveg_carbonflux_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
- !------------------------------------------------------------------------
-
- if (use_crop) then
-
- call restartvar(ncid=ncid, flag=flag, varname='grainc_xfer_to_grainc', xtype=ncd_double, &
- dim1name='pft', &
- long_name='grain C growth from storage', units='gC/m2/s', &
- interpinic_flag='interp', readvar=readvar, data=this%grainc_xfer_to_grainc_patch)
-
- call restartvar(ncid=ncid, flag=flag, varname='livestemc_to_litter', xtype=ncd_double, &
- dim1name='pft', &
- long_name='live stem C litterfall', units='gC/m2/s', &
- interpinic_flag='interp', readvar=readvar, data=this%livestemc_to_litter_patch)
-
- call restartvar(ncid=ncid, flag=flag, varname='grainc_to_food', xtype=ncd_double, &
- dim1name='pft', &
- long_name='grain C to food', units='gC/m2/s', &
- interpinic_flag='interp', readvar=readvar, data=this%grainc_to_food_patch)
-
- call restartvar(ncid=ncid, flag=flag, varname='cpool_to_grainc', xtype=ncd_double, &
- dim1name='pft', &
- long_name='allocation to grain C', units='gC/m2/s', &
- interpinic_flag='interp', readvar=readvar, data=this%cpool_to_grainc_patch)
-
- call restartvar(ncid=ncid, flag=flag, varname='cpool_to_grainc_storage', xtype=ncd_double, &
- dim1name='pft', &
- long_name='allocation to grain C storage', units='gC/m2/s', &
- interpinic_flag='interp', readvar=readvar, data=this%cpool_to_grainc_storage_patch)
-
- call restartvar(ncid=ncid, flag=flag, varname='cpool_grain_gr', xtype=ncd_double, &
- dim1name='pft', &
- long_name='grain growth respiration', units='gC/m2/s', &
- interpinic_flag='interp', readvar=readvar, data=this%cpool_grain_gr_patch)
-
- call restartvar(ncid=ncid, flag=flag, varname='cpool_grain_storage_gr', xtype=ncd_double, &
- dim1name='pft', &
- long_name='grain growth respiration to storage', units='gC/m2/s', &
- interpinic_flag='interp', readvar=readvar, data=this%cpool_grain_storage_gr_patch)
-
- call restartvar(ncid=ncid, flag=flag, varname='transfer_grain_gr', xtype=ncd_double, &
- dim1name='pft', &
- long_name='grain growth respiration from storage', units='gC/m2/s', &
- interpinic_flag='interp', readvar=readvar, data=this%transfer_grain_gr_patch)
-
- call restartvar(ncid=ncid, flag=flag, varname='grainc_storage_to_xfer', xtype=ncd_double, &
- dim1name='pft', &
- long_name='grain C shift storage to transfer', units='gC/m2/s', &
- interpinic_flag='interp', readvar=readvar, data=this%grainc_storage_to_xfer_patch)
-
- end if
-
- call restartvar(ncid=ncid, flag=flag, varname='gpp_pepv', xtype=ncd_double, &
- dim1name='pft', &
- long_name='', units='', &
- interpinic_flag='interp', readvar=readvar, data=this%gpp_before_downreg_patch)
-
- call restartvar(ncid=ncid, flag=flag, varname='availc', xtype=ncd_double, &
- dim1name='pft', &
- long_name='', units='', &
- interpinic_flag='interp', readvar=readvar, data=this%availc_patch)
-
- call restartvar(ncid=ncid, flag=flag, varname='xsmrpool_recover', xtype=ncd_double, &
- dim1name='pft', &
- long_name='', units='', &
- interpinic_flag='interp', readvar=readvar, data=this%xsmrpool_recover_patch)
-
- call restartvar(ncid=ncid, flag=flag, varname='plant_calloc', xtype=ncd_double, &
- dim1name='pft', &
- long_name='', units='', &
- interpinic_flag='interp', readvar=readvar, data=this%plant_calloc_patch)
-
- call restartvar(ncid=ncid, flag=flag, varname='excess_cflux', xtype=ncd_double, &
- dim1name='pft', &
- long_name='', units='', &
- interpinic_flag='interp', readvar=readvar, data=this%excess_cflux_patch)
-
- call restartvar(ncid=ncid, flag=flag, varname='prev_leafc_to_litter', xtype=ncd_double, &
- dim1name='pft', &
- long_name='', units='', &
- interpinic_flag='interp', readvar=readvar, data=this%prev_leafc_to_litter_patch)
-
- call restartvar(ncid=ncid, flag=flag, varname='prev_frootc_to_litter', xtype=ncd_double, &
- dim1name='pft', &
- long_name='', units='', &
- interpinic_flag='interp', readvar=readvar, data=this%prev_frootc_to_litter_patch)
-
- call restartvar(ncid=ncid, flag=flag, varname='tempsum_npp', xtype=ncd_double, &
- dim1name='pft', &
- long_name='', units='', &
- interpinic_flag='interp', readvar=readvar, data=this%tempsum_npp_patch)
-
- call restartvar(ncid=ncid, flag=flag, varname='annsum_npp', xtype=ncd_double, &
- dim1name='pft', &
- long_name='', units='', &
- interpinic_flag='interp', readvar=readvar, data=this%annsum_npp_patch)
-
- call restartvar(ncid=ncid, flag=flag, varname='col_lag_npp', xtype=ncd_double, &
- dim1name='column', &
- long_name='', units='', &
- interpinic_flag='interp', readvar=readvar, data=this%lag_npp_col)
-
- call restartvar(ncid=ncid, flag=flag, varname='cannsum_npp', xtype=ncd_double, &
- dim1name='column', &
- long_name='', units='', &
- interpinic_flag='interp', readvar=readvar, data=this%annsum_npp_col)
-
- call restartvar(ncid=ncid, flag=flag, varname='tempsum_litfall', xtype=ncd_double, &
- dim1name='pft', &
- long_name='', units='', &
- interpinic_flag='interp', readvar=readvar, data=this%tempsum_litfall_patch)
-
- call restartvar(ncid=ncid, flag=flag, varname='annsum_litfall', xtype=ncd_double, &
- dim1name='pft', &
- long_name='', units='', &
- interpinic_flag='interp', readvar=readvar, data=this%annsum_litfall_patch)
-
- if ( use_fun ) then
- call restartvar(ncid=ncid, flag=flag, varname='leafc_to_litter_fun', xtype=ncd_double, &
- dim1name='pft', &
- long_name='', units='', &
- interpinic_flag='interp', readvar=readvar, data=this%leafc_to_litter_fun_patch)
- end if
-
- end subroutine RestartBulkOnly
-
-
- !-----------------------------------------------------------------------
- subroutine RestartAllIsotopes ( this, bounds, ncid, flag )
- !
- ! !DESCRIPTION:
- ! Read/write CN restart data for carbon fluxes - fields present for both bulk C and isotopes
- !
- ! !USES:
- use ncdio_pio, only : file_desc_t
- !
- ! !ARGUMENTS:
- class (cnveg_carbonflux_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'
- !-----------------------------------------------------------------------
-
- end subroutine RestartAllIsotopes
-
- !-----------------------------------------------------------------------
- subroutine SetValues ( this, &
- num_patch, filter_patch, value_patch, &
- num_column, filter_column, value_column)
- !
- ! !DESCRIPTION:
- ! Set carbon state fluxes
- !
- ! !ARGUMENTS:
- class (cnveg_carbonflux_type) :: this
- integer , intent(in) :: num_patch
- integer , intent(in) :: filter_patch(:)
- real(r8), intent(in) :: value_patch
- integer , intent(in) :: num_column
- integer , intent(in) :: filter_column(:)
- real(r8), intent(in) :: value_column
- !
- ! !LOCAL VARIABLES:
- integer :: fi,i ! loop index
- integer :: j,k,l ! indices
- !------------------------------------------------------------------------
-
- do fi = 1,num_patch
- i = filter_patch(fi)
-
- this%m_leafc_to_litter_patch(i) = value_patch
- this%m_frootc_to_litter_patch(i) = value_patch
- this%m_leafc_storage_to_litter_patch(i) = value_patch
- this%m_frootc_storage_to_litter_patch(i) = value_patch
- this%m_livestemc_storage_to_litter_patch(i) = value_patch
- this%m_deadstemc_storage_to_litter_patch(i) = value_patch
- this%m_livecrootc_storage_to_litter_patch(i) = value_patch
- this%m_deadcrootc_storage_to_litter_patch(i) = value_patch
- this%m_leafc_xfer_to_litter_patch(i) = value_patch
- this%m_frootc_xfer_to_litter_patch(i) = value_patch
- this%m_livestemc_xfer_to_litter_patch(i) = value_patch
- this%m_deadstemc_xfer_to_litter_patch(i) = value_patch
- this%m_livecrootc_xfer_to_litter_patch(i) = value_patch
- this%m_deadcrootc_xfer_to_litter_patch(i) = value_patch
- this%m_livestemc_to_litter_patch(i) = value_patch
- this%m_deadstemc_to_litter_patch(i) = value_patch
- this%m_livecrootc_to_litter_patch(i) = value_patch
- this%m_deadcrootc_to_litter_patch(i) = value_patch
- this%m_gresp_storage_to_litter_patch(i) = value_patch
- this%m_gresp_xfer_to_litter_patch(i) = value_patch
- this%hrv_leafc_to_litter_patch(i) = value_patch
- this%hrv_leafc_storage_to_litter_patch(i) = value_patch
- this%hrv_leafc_xfer_to_litter_patch(i) = value_patch
- this%hrv_frootc_to_litter_patch(i) = value_patch
- this%hrv_frootc_storage_to_litter_patch(i) = value_patch
- this%hrv_frootc_xfer_to_litter_patch(i) = value_patch
- this%hrv_livestemc_to_litter_patch(i) = value_patch
- this%hrv_livestemc_storage_to_litter_patch(i) = value_patch
- this%hrv_livestemc_xfer_to_litter_patch(i) = value_patch
- this%hrv_deadstemc_storage_to_litter_patch(i) = value_patch
- this%hrv_deadstemc_xfer_to_litter_patch(i) = value_patch
- this%hrv_livecrootc_to_litter_patch(i) = value_patch
- this%hrv_livecrootc_storage_to_litter_patch(i) = value_patch
- this%hrv_livecrootc_xfer_to_litter_patch(i) = value_patch
- this%hrv_deadcrootc_to_litter_patch(i) = value_patch
- this%hrv_deadcrootc_storage_to_litter_patch(i) = value_patch
- this%hrv_deadcrootc_xfer_to_litter_patch(i) = value_patch
- this%hrv_gresp_storage_to_litter_patch(i) = value_patch
- this%hrv_gresp_xfer_to_litter_patch(i) = value_patch
- this%hrv_xsmrpool_to_atm_patch(i) = value_patch
-
- this%m_leafc_to_fire_patch(i) = value_patch
- this%m_leafc_storage_to_fire_patch(i) = value_patch
- this%m_leafc_xfer_to_fire_patch(i) = value_patch
- this%m_livestemc_to_fire_patch(i) = value_patch
- this%m_livestemc_storage_to_fire_patch(i) = value_patch
- this%m_livestemc_xfer_to_fire_patch(i) = value_patch
- this%m_deadstemc_to_fire_patch(i) = value_patch
- this%m_deadstemc_storage_to_fire_patch(i) = value_patch
- this%m_deadstemc_xfer_to_fire_patch(i) = value_patch
- this%m_frootc_to_fire_patch(i) = value_patch
- this%m_frootc_storage_to_fire_patch(i) = value_patch
- this%m_frootc_xfer_to_fire_patch(i) = value_patch
- this%m_livecrootc_to_fire_patch(i) = value_patch
- this%m_livecrootc_storage_to_fire_patch(i) = value_patch
- this%m_livecrootc_xfer_to_fire_patch(i) = value_patch
- this%m_deadcrootc_to_fire_patch(i) = value_patch
- this%m_deadcrootc_storage_to_fire_patch(i) = value_patch
- this%m_deadcrootc_xfer_to_fire_patch(i) = value_patch
- this%m_gresp_storage_to_fire_patch(i) = value_patch
- this%m_gresp_xfer_to_fire_patch(i) = value_patch
-
- this%m_leafc_to_litter_fire_patch(i) = value_patch
- this%m_leafc_storage_to_litter_fire_patch(i) = value_patch
- this%m_leafc_xfer_to_litter_fire_patch(i) = value_patch
- this%m_livestemc_to_litter_fire_patch(i) = value_patch
- this%m_livestemc_storage_to_litter_fire_patch(i) = value_patch
- this%m_livestemc_xfer_to_litter_fire_patch(i) = value_patch
- this%m_livestemc_to_deadstemc_fire_patch(i) = value_patch
- this%m_deadstemc_to_litter_fire_patch(i) = value_patch
- this%m_deadstemc_storage_to_litter_fire_patch(i) = value_patch
- this%m_deadstemc_xfer_to_litter_fire_patch(i) = value_patch
- this%m_frootc_to_litter_fire_patch(i) = value_patch
- this%m_frootc_storage_to_litter_fire_patch(i) = value_patch
- this%m_frootc_xfer_to_litter_fire_patch(i) = value_patch
- this%m_livecrootc_to_litter_fire_patch(i) = value_patch
- this%m_livecrootc_storage_to_litter_fire_patch(i) = value_patch
- this%m_livecrootc_xfer_to_litter_fire_patch(i) = value_patch
- this%m_livecrootc_to_deadcrootc_fire_patch(i) = value_patch
- this%m_deadcrootc_to_litter_fire_patch(i) = value_patch
- this%m_deadcrootc_storage_to_litter_fire_patch(i) = value_patch
- this%m_deadcrootc_xfer_to_litter_fire_patch(i) = value_patch
- this%m_gresp_storage_to_litter_fire_patch(i) = value_patch
- this%m_gresp_xfer_to_litter_fire_patch(i) = value_patch
-
- this%leafc_xfer_to_leafc_patch(i) = value_patch
- this%frootc_xfer_to_frootc_patch(i) = value_patch
- this%livestemc_xfer_to_livestemc_patch(i) = value_patch
- this%deadstemc_xfer_to_deadstemc_patch(i) = value_patch
- this%livecrootc_xfer_to_livecrootc_patch(i) = value_patch
- this%deadcrootc_xfer_to_deadcrootc_patch(i) = value_patch
- this%leafc_to_litter_patch(i) = value_patch
- this%frootc_to_litter_patch(i) = value_patch
- this%cpool_to_resp_patch(i) = value_patch
- this%cpool_to_leafc_resp_patch(i) = value_patch
- this%cpool_to_leafc_storage_resp_patch(i) = value_patch
- this%cpool_to_frootc_resp_patch(i) = value_patch
- this%cpool_to_frootc_storage_resp_patch(i) = value_patch
- this%cpool_to_livecrootc_resp_patch(i) = value_patch
- this%cpool_to_livecrootc_storage_resp_patch(i) = value_patch
- this%cpool_to_livestemc_resp_patch(i) = value_patch
- this%cpool_to_livestemc_storage_resp_patch(i) = value_patch
- this%leaf_mr_patch(i) = value_patch
- this%froot_mr_patch(i) = value_patch
- this%livestem_mr_patch(i) = value_patch
- this%livecroot_mr_patch(i) = value_patch
- this%grain_mr_patch(i) = value_patch
- this%leaf_curmr_patch(i) = value_patch
- this%froot_curmr_patch(i) = value_patch
- this%livestem_curmr_patch(i) = value_patch
- this%livecroot_curmr_patch(i) = value_patch
- this%grain_curmr_patch(i) = value_patch
- this%leaf_xsmr_patch(i) = value_patch
- this%froot_xsmr_patch(i) = value_patch
- this%livestem_xsmr_patch(i) = value_patch
- this%livecroot_xsmr_patch(i) = value_patch
- this%grain_xsmr_patch(i) = value_patch
- this%psnsun_to_cpool_patch(i) = value_patch
- this%psnshade_to_cpool_patch(i) = value_patch
- this%cpool_to_xsmrpool_patch(i) = value_patch
- this%cpool_to_leafc_patch(i) = value_patch
- this%cpool_to_leafc_storage_patch(i) = value_patch
- this%cpool_to_frootc_patch(i) = value_patch
- this%cpool_to_frootc_storage_patch(i) = value_patch
- this%cpool_to_livestemc_patch(i) = value_patch
- this%cpool_to_livestemc_storage_patch(i) = value_patch
- this%cpool_to_deadstemc_patch(i) = value_patch
- this%cpool_to_deadstemc_storage_patch(i) = value_patch
- this%cpool_to_livecrootc_patch(i) = value_patch
- this%cpool_to_livecrootc_storage_patch(i) = value_patch
- this%cpool_to_deadcrootc_patch(i) = value_patch
- this%cpool_to_deadcrootc_storage_patch(i) = value_patch
- this%cpool_to_gresp_storage_patch(i) = value_patch
- this%cpool_leaf_gr_patch(i) = value_patch
- this%cpool_leaf_storage_gr_patch(i) = value_patch
- this%transfer_leaf_gr_patch(i) = value_patch
- this%cpool_froot_gr_patch(i) = value_patch
- this%cpool_froot_storage_gr_patch(i) = value_patch
- this%transfer_froot_gr_patch(i) = value_patch
- this%cpool_livestem_gr_patch(i) = value_patch
- this%cpool_livestem_storage_gr_patch(i) = value_patch
- this%transfer_livestem_gr_patch(i) = value_patch
- this%cpool_deadstem_gr_patch(i) = value_patch
- this%cpool_deadstem_storage_gr_patch(i) = value_patch
- this%transfer_deadstem_gr_patch(i) = value_patch
- this%cpool_livecroot_gr_patch(i) = value_patch
- this%cpool_livecroot_storage_gr_patch(i) = value_patch
- this%transfer_livecroot_gr_patch(i) = value_patch
- this%cpool_deadcroot_gr_patch(i) = value_patch
- this%cpool_deadcroot_storage_gr_patch(i) = value_patch
- this%transfer_deadcroot_gr_patch(i) = value_patch
- this%leafc_storage_to_xfer_patch(i) = value_patch
- this%frootc_storage_to_xfer_patch(i) = value_patch
- this%livestemc_storage_to_xfer_patch(i) = value_patch
- this%deadstemc_storage_to_xfer_patch(i) = value_patch
- this%livecrootc_storage_to_xfer_patch(i) = value_patch
- this%deadcrootc_storage_to_xfer_patch(i) = value_patch
- this%gresp_storage_to_xfer_patch(i) = value_patch
- this%livestemc_to_deadstemc_patch(i) = value_patch
- this%livecrootc_to_deadcrootc_patch(i) = value_patch
-
- this%current_gr_patch(i) = value_patch
- this%transfer_gr_patch(i) = value_patch
- this%storage_gr_patch(i) = value_patch
- this%frootc_alloc_patch(i) = value_patch
- this%frootc_loss_patch(i) = value_patch
- this%leafc_alloc_patch(i) = value_patch
- this%leafc_loss_patch(i) = value_patch
- this%woodc_alloc_patch(i) = value_patch
- this%woodc_loss_patch(i) = value_patch
-
- this%crop_seedc_to_leaf_patch(i) = value_patch
- this%grainc_to_cropprodc_patch(i) = value_patch
- end do
-
- if ( use_crop )then
- do fi = 1,num_patch
- i = filter_patch(fi)
- this%xsmrpool_to_atm_patch(i) = value_patch
- this%livestemc_to_litter_patch(i) = value_patch
- this%grainc_to_food_patch(i) = value_patch
- this%grainc_to_seed_patch(i) = value_patch
- this%grainc_xfer_to_grainc_patch(i) = value_patch
- this%cpool_to_grainc_patch(i) = value_patch
- this%cpool_to_grainc_storage_patch(i) = value_patch
- this%cpool_grain_gr_patch(i) = value_patch
- this%cpool_grain_storage_gr_patch(i) = value_patch
- this%transfer_grain_gr_patch(i) = value_patch
- this%grainc_storage_to_xfer_patch(i) = value_patch
- end do
- end if
-
- do j = 1, nlevdecomp_full
- do fi = 1,num_column
- i = filter_column(fi)
-
- this%phenology_c_to_litr_met_c_col(i,j) = value_column
- this%phenology_c_to_litr_cel_c_col(i,j) = value_column
- this%phenology_c_to_litr_lig_c_col(i,j) = value_column
-
- this%gap_mortality_c_to_litr_met_c_col(i,j) = value_column
- this%gap_mortality_c_to_litr_cel_c_col(i,j) = value_column
- this%gap_mortality_c_to_litr_lig_c_col(i,j) = value_column
- this%gap_mortality_c_to_cwdc_col(i,j) = value_column
-
- this%fire_mortality_c_to_cwdc_col(i,j) = value_column
- this%m_c_to_litr_met_fire_col(i,j) = value_column
- this%m_c_to_litr_cel_fire_col(i,j) = value_column
- this%m_c_to_litr_lig_fire_col(i,j) = value_column
-
- this%harvest_c_to_litr_met_c_col(i,j) = value_column
- this%harvest_c_to_litr_cel_c_col(i,j) = value_column
- this%harvest_c_to_litr_lig_c_col(i,j) = value_column
- this%harvest_c_to_cwdc_col(i,j) = value_column
-
- end do
- end do
-
- do k = 1, ndecomp_pools
- do j = 1, nlevdecomp_full
- do fi = 1,num_column
- i = filter_column(fi)
- this%m_decomp_cpools_to_fire_vr_col(i,j,k) = value_column
- end do
- end do
- end do
-
- do k = 1, ndecomp_pools
- do fi = 1,num_column
- i = filter_column(fi)
- this%m_decomp_cpools_to_fire_col(i,k) = value_column
- end do
- end do
-
- do fi = 1,num_column
- i = filter_column(fi)
-
- this%grainc_to_cropprodc_col(i) = value_column
- this%cwdc_hr_col(i) = value_column
- this%cwdc_loss_col(i) = value_column
- this%litterc_loss_col(i) = value_column
- end do
-
- do fi = 1,num_patch
- i = filter_patch(fi)
-
- this%gpp_patch(i) = value_patch
- this%mr_patch(i) = value_patch
- this%gr_patch(i) = value_patch
- this%ar_patch(i) = value_patch
- this%rr_patch(i) = value_patch
- this%npp_patch(i) = value_patch
- this%agnpp_patch(i) = value_patch
- this%bgnpp_patch(i) = value_patch
- this%litfall_patch(i) = value_patch
- this%wood_harvestc_patch(i) = value_patch
- this%slash_harvestc_patch(i) = value_patch
- this%cinputs_patch(i) = value_patch
- this%coutputs_patch(i) = value_patch
- this%fire_closs_patch(i) = value_patch
- this%npp_Nactive_patch(i) = value_patch
- this%npp_burnedoff_patch(i) = value_patch
- this%npp_Nnonmyc_patch(i) = value_patch
- this%npp_Nam_patch(i) = value_patch
- this%npp_Necm_patch(i) = value_patch
- this%npp_Nactive_no3_patch(i) = value_patch
- this%npp_Nactive_nh4_patch(i) = value_patch
- this%npp_Nnonmyc_no3_patch(i) = value_patch
- this%npp_Nnonmyc_nh4_patch(i) = value_patch
- this%npp_Nam_no3_patch(i) = value_patch
- this%npp_Nam_nh4_patch(i) = value_patch
- this%npp_Necm_no3_patch(i) = value_patch
- this%npp_Necm_nh4_patch(i) = value_patch
- this%npp_Nfix_patch(i) = value_patch
- this%npp_Nretrans_patch(i) = value_patch
- this%npp_Nuptake_patch(i) = value_patch
- this%npp_growth_patch(i) = value_patch
- this%leafc_change_patch(i) = value_patch
- this%soilc_change_patch(i) = value_patch
- end do
-
- do fi = 1,num_column
- i = filter_column(fi)
-
- this%sr_col(i) = value_column
- this%er_col(i) = value_column
- this%litfire_col(i) = value_column
- this%somfire_col(i) = value_column
- this%totfire_col(i) = value_column
- this%fire_closs_col(i) = value_column
-
- ! Zero p2c column fluxes
- this%rr_col(i) = value_column
- this%ar_col(i) = value_column
- this%gpp_col(i) = value_column
- this%npp_col(i) = value_column
- this%fire_closs_col(i) = value_column
- this%wood_harvestc_col(i) = value_column
- this%hrv_xsmrpool_to_atm_col(i) = value_column
-
- this%nep_col(i) = value_column
-
- end do
-
- end subroutine SetValues
-
-end module CNVegCarbonFluxType
-
-
diff --git a/src/biogeochem/CNVegCarbonStateType.F90 b/src/biogeochem/CNVegCarbonStateType.F90
deleted file mode 100644
index a5800479..00000000
--- a/src/biogeochem/CNVegCarbonStateType.F90
+++ /dev/null
@@ -1,2346 +0,0 @@
-module CNVegCarbonStateType
-
-#include "shr_assert.h"
-
- !-----------------------------------------------------------------------
- !
- ! !USES:
- use shr_kind_mod , only : r8 => shr_kind_r8
- use shr_infnan_mod , only : nan => shr_infnan_nan, assignment(=)
- use shr_const_mod , only : SHR_CONST_PDB
- use shr_log_mod , only : errMsg => shr_log_errMsg
- use pftconMod , only : noveg, npcropmin, pftcon
- use clm_varcon , only : spval, c3_r2, c4_r2, c14ratio
- use clm_varctl , only : iulog, use_cndv, use_crop
- use decompMod , only : bounds_type
- use abortutils , only : endrun
- use spmdMod , only : masterproc
- use LandunitType , only : lun
- use ColumnType , only : col
- use PatchType , only : patch
- use CNSpeciesMod , only : species_from_string, CN_SPECIES_C12
- use CNVegComputeSeedMod, only : ComputeSeedAmounts
- !
- ! !PUBLIC TYPES:
- implicit none
- private
- !
-
- type, public :: cnveg_carbonstate_type
-
- integer :: species ! c12, c13, c14
-
- real(r8), pointer :: grainc_patch (:) ! (gC/m2) grain C (crop model)
- real(r8), pointer :: grainc_storage_patch (:) ! (gC/m2) grain C storage (crop model)
- real(r8), pointer :: grainc_xfer_patch (:) ! (gC/m2) grain C transfer (crop model)
- real(r8), pointer :: leafc_patch (:) ! (gC/m2) leaf C
- real(r8), pointer :: leafc_storage_patch (:) ! (gC/m2) leaf C storage
- real(r8), pointer :: leafc_xfer_patch (:) ! (gC/m2) leaf C transfer
- real(r8), pointer :: leafc_storage_xfer_acc_patch (:) ! (gC/m2) Accmulated leaf C transfer
- real(r8), pointer :: storage_cdemand_patch (:) ! (gC/m2) C use from the C storage pool
- real(r8), pointer :: frootc_patch (:) ! (gC/m2) fine root C
- real(r8), pointer :: frootc_storage_patch (:) ! (gC/m2) fine root C storage
- real(r8), pointer :: frootc_xfer_patch (:) ! (gC/m2) fine root C transfer
- real(r8), pointer :: livestemc_patch (:) ! (gC/m2) live stem C
- real(r8), pointer :: livestemc_storage_patch (:) ! (gC/m2) live stem C storage
- real(r8), pointer :: livestemc_xfer_patch (:) ! (gC/m2) live stem C transfer
- real(r8), pointer :: deadstemc_patch (:) ! (gC/m2) dead stem C
- real(r8), pointer :: deadstemc_storage_patch (:) ! (gC/m2) dead stem C storage
- real(r8), pointer :: deadstemc_xfer_patch (:) ! (gC/m2) dead stem C transfer
- real(r8), pointer :: livecrootc_patch (:) ! (gC/m2) live coarse root C
- real(r8), pointer :: livecrootc_storage_patch (:) ! (gC/m2) live coarse root C storage
- real(r8), pointer :: livecrootc_xfer_patch (:) ! (gC/m2) live coarse root C transfer
- real(r8), pointer :: deadcrootc_patch (:) ! (gC/m2) dead coarse root C
- real(r8), pointer :: deadcrootc_storage_patch (:) ! (gC/m2) dead coarse root C storage
- real(r8), pointer :: deadcrootc_xfer_patch (:) ! (gC/m2) dead coarse root C transfer
- real(r8), pointer :: gresp_storage_patch (:) ! (gC/m2) growth respiration storage
- real(r8), pointer :: gresp_xfer_patch (:) ! (gC/m2) growth respiration transfer
- real(r8), pointer :: cpool_patch (:) ! (gC/m2) temporary photosynthate C pool
- real(r8), pointer :: xsmrpool_patch (:) ! (gC/m2) abstract C pool to meet excess MR demand
- real(r8), pointer :: ctrunc_patch (:) ! (gC/m2) patch-level sink for C truncation
- real(r8), pointer :: woodc_patch (:) ! (gC/m2) wood C
- real(r8), pointer :: leafcmax_patch (:) ! (gC/m2) ann max leaf C
- real(r8), pointer :: totc_patch (:) ! (gC/m2) total patch-level carbon, including cpool
- real(r8), pointer :: rootc_col (:) ! (gC/m2) root carbon at column level (fire)
- real(r8), pointer :: leafc_col (:) ! (gC/m2) column-level leafc (fire)
- real(r8), pointer :: deadstemc_col (:) ! (gC/m2) column-level deadstemc (fire)
- real(r8), pointer :: fuelc_col (:) ! fuel load outside cropland
- real(r8), pointer :: fuelc_crop_col (:) ! fuel load for cropland
- real(r8), pointer :: cropseedc_deficit_patch (:) ! (gC/m2) pool for seeding new crop growth; this is a NEGATIVE term, indicating the amount of seed usage that needs to be repaid
-
- ! pools for dynamic landcover
- real(r8), pointer :: seedc_grc (:) ! (gC/m2) gridcell-level pool for seeding new PFTs via dynamic landcover
-
- ! summary (diagnostic) state variables, not involved in mass balance
- real(r8), pointer :: dispvegc_patch (:) ! (gC/m2) displayed veg carbon, excluding storage and cpool
- real(r8), pointer :: storvegc_patch (:) ! (gC/m2) stored vegetation carbon, excluding cpool
- real(r8), pointer :: totvegc_patch (:) ! (gC/m2) total vegetation carbon, excluding cpool
- real(r8), pointer :: totvegc_col (:) ! (gC/m2) total vegetation carbon, excluding cpool averaged to column (p2c)
-
- ! Total C pools
- real(r8), pointer :: totc_p2c_col (:) ! (gC/m2) totc_patch averaged to col
- real(r8), pointer :: totc_col (:) ! (gC/m2) total column carbon, incl veg and cpool
- real(r8), pointer :: totecosysc_col (:) ! (gC/m2) total ecosystem carbon, incl veg but excl cpool
-
- contains
-
- procedure , public :: Init
- procedure , public :: SetValues
- procedure , public :: Restart
-
- procedure , private :: InitAllocate ! Allocate arrays
- procedure , private :: InitReadNML ! Read in namelist
- procedure , private :: InitHistory ! Initialize history
- procedure , private :: InitCold ! Initialize arrays for a cold-start
-
- end type cnveg_carbonstate_type
-
- ! !PRIVATE DATA:
-
- type, private :: cnvegcarbonstate_const_type
- ! !PRIVATE MEMBER DATA:
- real(r8) :: initial_vegC = 20._r8 ! Initial vegetation carbon for leafc/frootc and storage
- end type
- type(cnvegcarbonstate_const_type), private :: cnvegcstate_const ! Constants used here
- character(len=*), parameter :: sourcefile = &
- __FILE__
-
- !------------------------------------------------------------------------
-
-contains
-
- !------------------------------------------------------------------------
- subroutine Init(this, bounds, carbon_type, ratio, NLFilename, &
- c12_cnveg_carbonstate_inst)
-
- class(cnveg_carbonstate_type) :: this
- type(bounds_type) , intent(in) :: bounds
- real(r8) , intent(in) :: ratio
- character(len=*) , intent(in) :: carbon_type ! Carbon isotope type C12, C13 or C1
- character(len=*) , intent(in) :: NLFilename ! Namelist filename
- type(cnveg_carbonstate_type) , intent(in), optional :: c12_cnveg_carbonstate_inst ! cnveg_carbonstate for C12 (if C13 or C14)
- !-----------------------------------------------------------------------
-
- this%species = species_from_string(carbon_type)
-
- call this%InitAllocate ( bounds)
- call this%InitReadNML ( NLFilename )
- call this%InitHistory ( bounds, carbon_type)
- if (present(c12_cnveg_carbonstate_inst)) then
- call this%InitCold ( bounds, ratio, carbon_type, c12_cnveg_carbonstate_inst )
- else
- call this%InitCold ( bounds, ratio, carbon_type )
- end if
-
- end subroutine Init
-
- !------------------------------------------------------------------------
- subroutine InitReadNML(this, NLFilename)
- !
- ! !DESCRIPTION:
- ! Read the namelist for CNVegCarbonState
- !
- !USES:
- use fileutils , only : getavu, relavu, opnfil
- use shr_nl_mod , only : shr_nl_find_group_name
- use spmdMod , only : masterproc, mpicom
- use shr_mpi_mod , only : shr_mpi_bcast
- use clm_varctl , only : iulog
- !
- ! !ARGUMENTS:
- class(cnveg_carbonstate_type) :: this
- character(len=*) , intent(in) :: NLFilename ! Namelist filename
- !
- ! !LOCAL VARIABLES:
- integer :: ierr ! error code
- integer :: unitn ! unit for namelist file
-
- character(len=*), parameter :: subname = 'InitReadNML'
- character(len=*), parameter :: nmlname = 'cnvegcarbonstate' ! MUST match what is in namelist below
- !-----------------------------------------------------------------------
- real(r8) :: initial_vegC
- namelist /cnvegcarbonstate/ initial_vegC
-
- initial_vegC = cnvegcstate_const%initial_vegC
-
- if (masterproc) then
- unitn = getavu()
- write(iulog,*) 'Read in '//nmlname//' namelist'
- call opnfil (NLFilename, unitn, 'F')
- call shr_nl_find_group_name(unitn, nmlname, status=ierr)
- if (ierr == 0) then
- read(unitn, nml=cnvegcarbonstate, iostat=ierr)
- if (ierr /= 0) then
- call endrun(msg="ERROR reading "//nmlname//"namelist"//errmsg(sourcefile, __LINE__))
- end if
- else
- call endrun(msg="ERROR could NOT find "//nmlname//"namelist"//errmsg(sourcefile, __LINE__))
- end if
- call relavu( unitn )
- end if
-
- call shr_mpi_bcast (initial_vegC , mpicom)
-
- cnvegcstate_const%initial_vegC = initial_vegC
-
- if (masterproc) then
- write(iulog,*) ' '
- write(iulog,*) nmlname//' settings:'
- write(iulog,nml=cnvegcarbonstate) ! Name here MUST be the same as in nmlname above!
- write(iulog,*) ' '
- end if
-
- !-----------------------------------------------------------------------
-
- end subroutine InitReadNML
-
- !------------------------------------------------------------------------
- subroutine InitAllocate(this, bounds)
- !
- ! !ARGUMENTS:
- class (cnveg_carbonstate_type) :: this
- type(bounds_type), intent(in) :: bounds
- !
- ! !LOCAL VARIABLES:
- integer :: begp,endp
- integer :: begc,endc
- integer :: begg,endg
- !------------------------------------------------------------------------
-
- begp = bounds%begp; endp = bounds%endp
- begc = bounds%begc; endc = bounds%endc
- begg = bounds%begg; endg = bounds%endg
-
- allocate(this%leafc_patch (begp:endp)) ; this%leafc_patch (:) = nan
- allocate(this%leafc_storage_patch (begp:endp)) ; this%leafc_storage_patch (:) = nan
- allocate(this%leafc_xfer_patch (begp:endp)) ; this%leafc_xfer_patch (:) = nan
- allocate(this%leafc_storage_xfer_acc_patch (begp:endp)) ; this%leafc_storage_xfer_acc_patch (:) = nan
- allocate(this%storage_cdemand_patch (begp:endp)) ; this%storage_cdemand_patch (:) = nan
- allocate(this%frootc_patch (begp:endp)) ; this%frootc_patch (:) = nan
- allocate(this%frootc_storage_patch (begp:endp)) ; this%frootc_storage_patch (:) = nan
- allocate(this%frootc_xfer_patch (begp:endp)) ; this%frootc_xfer_patch (:) = nan
- allocate(this%livestemc_patch (begp:endp)) ; this%livestemc_patch (:) = nan
- allocate(this%livestemc_storage_patch (begp:endp)) ; this%livestemc_storage_patch (:) = nan
- allocate(this%livestemc_xfer_patch (begp:endp)) ; this%livestemc_xfer_patch (:) = nan
- allocate(this%deadstemc_patch (begp:endp)) ; this%deadstemc_patch (:) = nan
- allocate(this%deadstemc_storage_patch (begp:endp)) ; this%deadstemc_storage_patch (:) = nan
- allocate(this%deadstemc_xfer_patch (begp:endp)) ; this%deadstemc_xfer_patch (:) = nan
- allocate(this%livecrootc_patch (begp:endp)) ; this%livecrootc_patch (:) = nan
- allocate(this%livecrootc_storage_patch (begp:endp)) ; this%livecrootc_storage_patch (:) = nan
- allocate(this%livecrootc_xfer_patch (begp:endp)) ; this%livecrootc_xfer_patch (:) = nan
- allocate(this%deadcrootc_patch (begp:endp)) ; this%deadcrootc_patch (:) = nan
- allocate(this%deadcrootc_storage_patch (begp:endp)) ; this%deadcrootc_storage_patch (:) = nan
- allocate(this%deadcrootc_xfer_patch (begp:endp)) ; this%deadcrootc_xfer_patch (:) = nan
- allocate(this%gresp_storage_patch (begp:endp)) ; this%gresp_storage_patch (:) = nan
- allocate(this%gresp_xfer_patch (begp:endp)) ; this%gresp_xfer_patch (:) = nan
- allocate(this%cpool_patch (begp:endp)) ; this%cpool_patch (:) = nan
- allocate(this%xsmrpool_patch (begp:endp)) ; this%xsmrpool_patch (:) = nan
- allocate(this%ctrunc_patch (begp:endp)) ; this%ctrunc_patch (:) = nan
- allocate(this%dispvegc_patch (begp:endp)) ; this%dispvegc_patch (:) = nan
- allocate(this%storvegc_patch (begp:endp)) ; this%storvegc_patch (:) = nan
- allocate(this%leafcmax_patch (begp:endp)) ; this%leafcmax_patch (:) = nan
- allocate(this%totc_patch (begp:endp)) ; this%totc_patch (:) = nan
- allocate(this%grainc_patch (begp:endp)) ; this%grainc_patch (:) = nan
- allocate(this%grainc_storage_patch (begp:endp)) ; this%grainc_storage_patch (:) = nan
- allocate(this%grainc_xfer_patch (begp:endp)) ; this%grainc_xfer_patch (:) = nan
- allocate(this%woodc_patch (begp:endp)) ; this%woodc_patch (:) = nan
-
- allocate(this%cropseedc_deficit_patch (begp:endp)) ; this%cropseedc_deficit_patch (:) = nan
- allocate(this%seedc_grc (begg:endg)) ; this%seedc_grc (:) = nan
- allocate(this%rootc_col (begc:endc)) ; this%rootc_col (:) = nan
- allocate(this%leafc_col (begc:endc)) ; this%leafc_col (:) = nan
- allocate(this%deadstemc_col (begc:endc)) ; this%deadstemc_col (:) = nan
- allocate(this%fuelc_col (begc:endc)) ; this%fuelc_col (:) = nan
- allocate(this%fuelc_crop_col (begc:endc)) ; this%fuelc_crop_col (:) = nan
-
- allocate(this%totvegc_patch (begp:endp)) ; this%totvegc_patch (:) = nan
- allocate(this%totvegc_col (begc:endc)) ; this%totvegc_col (:) = nan
-
- allocate(this%totc_p2c_col (begc:endc)) ; this%totc_p2c_col (:) = nan
- allocate(this%totc_col (begc:endc)) ; this%totc_col (:) = nan
- allocate(this%totecosysc_col (begc:endc)) ; this%totecosysc_col (:) = nan
-
- end subroutine InitAllocate
-
- !------------------------------------------------------------------------
- subroutine InitHistory(this, bounds, carbon_type)
- !
- ! !DESCRIPTION:
- ! add history fields for all CN variables, always set as default='inactive'
- !
- ! !USES:
- use histFileMod, only : hist_addfld1d, hist_addfld2d, hist_addfld_decomp
- !
- ! !ARGUMENTS:
- class (cnveg_carbonstate_type) :: this
- type(bounds_type) , intent(in) :: bounds
- character(len=*) , intent(in) :: carbon_type ! one of ['c12', c13','c14']
- !
- ! !LOCAL VARIABLES:
- integer :: k,l,ii,jj
- character(10) :: active
- integer :: begp,endp
- integer :: begc,endc
- integer :: begg,endg
- character(24) :: fieldname
- character(100) :: longname
- real(r8), pointer :: data1dptr(:) ! temp. pointer for slicing larger arrays
- real(r8), pointer :: data2dptr(:,:) ! temp. pointer for slicing larger arrays
- !---------------------------------------------------------------------
-
- begp = bounds%begp; endp = bounds%endp
- begc = bounds%begc; endc = bounds%endc
- begg = bounds%begg; endg = bounds%endg
-
- !-------------------------------
- ! C12 state variables
- !-------------------------------
-
- if (carbon_type == 'c12') then
-
- if (use_crop) then
- this%grainc_patch(begp:endp) = spval
- call hist_addfld1d (fname='GRAINC', units='gC/m^2', &
- avgflag='A', long_name='grain C (does not equal yield)', &
- ptr_patch=this%grainc_patch, default='inactive')
- this%cropseedc_deficit_patch(begp:endp) = spval
- call hist_addfld1d (fname='CROPSEEDC_DEFICIT', units='gC/m^2', &
- avgflag='A', long_name='C used for crop seed that needs to be repaid', &
- ptr_patch=this%cropseedc_deficit_patch, default='inactive')
- end if
-
- this%woodc_patch(begp:endp) = spval
- call hist_addfld1d (fname='WOODC', units='gC/m^2', &
- avgflag='A', long_name='wood C', &
- ptr_patch=this%woodc_patch, default='inactive')
-
- this%leafc_patch(begp:endp) = spval
- call hist_addfld1d (fname='LEAFC', units='gC/m^2', &
- avgflag='A', long_name='leaf C', &
- ptr_patch=this%leafc_patch, default='inactive')
-
- this%leafc_storage_patch(begp:endp) = spval
- call hist_addfld1d (fname='LEAFC_STORAGE', units='gC/m^2', &
- avgflag='A', long_name='leaf C storage', &
- ptr_patch=this%leafc_storage_patch, default='inactive')
-
- this%leafc_xfer_patch(begp:endp) = spval
- call hist_addfld1d (fname='LEAFC_XFER', units='gC/m^2', &
- avgflag='A', long_name='leaf C transfer', &
- ptr_patch=this%leafc_xfer_patch, default='inactive')
-
- this%leafc_storage_xfer_acc_patch(begp:endp) = spval
- call hist_addfld1d (fname='LEAFC_STORAGE_XFER_ACC', units='gC/m^2', &
- avgflag='A', long_name='Accumulated leaf C transfer', &
- ptr_patch=this%leafc_storage_xfer_acc_patch, default='inactive')
-
- this%storage_cdemand_patch(begp:endp) = spval
- call hist_addfld1d (fname='STORAGE_CDEMAND', units='gC/m^2', &
- avgflag='A', long_name='C use from the C storage pool', &
- ptr_patch=this%storage_cdemand_patch, default='inactive')
-
- this%frootc_patch(begp:endp) = spval
- call hist_addfld1d (fname='FROOTC', units='gC/m^2', &
- avgflag='A', long_name='fine root C', &
- ptr_patch=this%frootc_patch, default='inactive')
-
- this%frootc_storage_patch(begp:endp) = spval
- call hist_addfld1d (fname='FROOTC_STORAGE', units='gC/m^2', &
- avgflag='A', long_name='fine root C storage', &
- ptr_patch=this%frootc_storage_patch, default='inactive')
-
- this%frootc_xfer_patch(begp:endp) = spval
- call hist_addfld1d (fname='FROOTC_XFER', units='gC/m^2', &
- avgflag='A', long_name='fine root C transfer', &
- ptr_patch=this%frootc_xfer_patch, default='inactive')
-
- this%livestemc_patch(begp:endp) = spval
- call hist_addfld1d (fname='LIVESTEMC', units='gC/m^2', &
- avgflag='A', long_name='live stem C', &
- ptr_patch=this%livestemc_patch, default='inactive')
-
- this%livestemc_storage_patch(begp:endp) = spval
- call hist_addfld1d (fname='LIVESTEMC_STORAGE', units='gC/m^2', &
- avgflag='A', long_name='live stem C storage', &
- ptr_patch=this%livestemc_storage_patch, default='inactive')
-
- this%livestemc_xfer_patch(begp:endp) = spval
- call hist_addfld1d (fname='LIVESTEMC_XFER', units='gC/m^2', &
- avgflag='A', long_name='live stem C transfer', &
- ptr_patch=this%livestemc_xfer_patch, default='inactive')
-
- this%deadstemc_patch(begp:endp) = spval
- call hist_addfld1d (fname='DEADSTEMC', units='gC/m^2', &
- avgflag='A', long_name='dead stem C', &
- ptr_patch=this%deadstemc_patch, default='inactive')
-
- this%deadstemc_storage_patch(begp:endp) = spval
- call hist_addfld1d (fname='DEADSTEMC_STORAGE', units='gC/m^2', &
- avgflag='A', long_name='dead stem C storage', &
- ptr_patch=this%deadstemc_storage_patch, default='inactive')
-
- this%deadstemc_xfer_patch(begp:endp) = spval
- call hist_addfld1d (fname='DEADSTEMC_XFER', units='gC/m^2', &
- avgflag='A', long_name='dead stem C transfer', &
- ptr_patch=this%deadstemc_xfer_patch, default='inactive')
-
- this%livecrootc_patch(begp:endp) = spval
- call hist_addfld1d (fname='LIVECROOTC', units='gC/m^2', &
- avgflag='A', long_name='live coarse root C', &
- ptr_patch=this%livecrootc_patch, default='inactive')
-
- this%livecrootc_storage_patch(begp:endp) = spval
- call hist_addfld1d (fname='LIVECROOTC_STORAGE', units='gC/m^2', &
- avgflag='A', long_name='live coarse root C storage', &
- ptr_patch=this%livecrootc_storage_patch, default='inactive')
-
- this%livecrootc_xfer_patch(begp:endp) = spval
- call hist_addfld1d (fname='LIVECROOTC_XFER', units='gC/m^2', &
- avgflag='A', long_name='live coarse root C transfer', &
- ptr_patch=this%livecrootc_xfer_patch, default='inactive')
-
- this%deadcrootc_patch(begp:endp) = spval
- call hist_addfld1d (fname='DEADCROOTC', units='gC/m^2', &
- avgflag='A', long_name='dead coarse root C', &
- ptr_patch=this%deadcrootc_patch, default='inactive')
-
- this%deadcrootc_storage_patch(begp:endp) = spval
- call hist_addfld1d (fname='DEADCROOTC_STORAGE', units='gC/m^2', &
- avgflag='A', long_name='dead coarse root C storage', &
- ptr_patch=this%deadcrootc_storage_patch, default='inactive')
-
- this%deadcrootc_xfer_patch(begp:endp) = spval
- call hist_addfld1d (fname='DEADCROOTC_XFER', units='gC/m^2', &
- avgflag='A', long_name='dead coarse root C transfer', &
- ptr_patch=this%deadcrootc_xfer_patch, default='inactive')
-
- this%gresp_storage_patch(begp:endp) = spval
- call hist_addfld1d (fname='GRESP_STORAGE', units='gC/m^2', &
- avgflag='A', long_name='growth respiration storage', &
- ptr_patch=this%gresp_storage_patch, default='inactive')
-
- this%gresp_xfer_patch(begp:endp) = spval
- call hist_addfld1d (fname='GRESP_XFER', units='gC/m^2', &
- avgflag='A', long_name='growth respiration transfer', &
- ptr_patch=this%gresp_xfer_patch, default='inactive')
-
- this%cpool_patch(begp:endp) = spval
- call hist_addfld1d (fname='CPOOL', units='gC/m^2', &
- avgflag='A', long_name='temporary photosynthate C pool', &
- ptr_patch=this%cpool_patch, default='inactive')
-
- this%xsmrpool_patch(begp:endp) = spval
- call hist_addfld1d (fname='XSMRPOOL', units='gC/m^2', &
- avgflag='A', long_name='temporary photosynthate C pool', &
- ptr_patch=this%xsmrpool_patch, default='inactive')
-
- this%ctrunc_patch(begp:endp) = spval
- call hist_addfld1d (fname='PFT_CTRUNC', units='gC/m^2', &
- avgflag='A', long_name='patch-level sink for C truncation', &
- ptr_patch=this%ctrunc_patch, default='inactive')
-
- this%dispvegc_patch(begp:endp) = spval
- call hist_addfld1d (fname='DISPVEGC', units='gC/m^2', &
- avgflag='A', long_name='displayed veg carbon, excluding storage and cpool', &
- ptr_patch=this%dispvegc_patch, default='inactive')
-
- this%storvegc_patch(begp:endp) = spval
- call hist_addfld1d (fname='STORVEGC', units='gC/m^2', &
- avgflag='A', long_name='stored vegetation carbon, excluding cpool', &
- ptr_patch=this%storvegc_patch, default='inactive')
-
- this%totvegc_patch(begp:endp) = spval
- call hist_addfld1d (fname='TOTVEGC', units='gC/m^2', &
- avgflag='A', long_name='total vegetation carbon, excluding cpool', &
- ptr_patch=this%totvegc_patch, default='inactive')
-
- this%totc_patch(begp:endp) = spval
- call hist_addfld1d (fname='TOTPFTC', units='gC/m^2', &
- avgflag='A', long_name='total patch-level carbon, including cpool', &
- ptr_patch=this%totc_patch, default='inactive')
-
- this%seedc_grc(begg:endg) = spval
- call hist_addfld1d (fname='SEEDC', units='gC/m^2', &
- avgflag='A', long_name='pool for seeding new PFTs via dynamic landcover', &
- ptr_gcell=this%seedc_grc, default='inactive')
-
- this%fuelc_col(begc:endc) = spval
- call hist_addfld1d (fname='FUELC', units='gC/m^2', &
- avgflag='A', long_name='fuel load', &
- ptr_col=this%fuelc_col, default='inactive')
-
- this%totc_col(begc:endc) = spval
- call hist_addfld1d (fname='TOTCOLC', units='gC/m^2', &
- avgflag='A', long_name='total column carbon, incl veg and cpool but excl product pools', &
- ptr_col=this%totc_col, default='inactive')
-
- this%totecosysc_col(begc:endc) = spval
- call hist_addfld1d (fname='TOTECOSYSC', units='gC/m^2', &
- avgflag='A', long_name='total ecosystem carbon, incl veg but excl cpool and product pools', &
- ptr_col=this%totecosysc_col, default='inactive')
-
- end if
-
- !-------------------------------
- ! C13 state variables
- !-------------------------------
-
- if ( carbon_type == 'c13' ) then
-
- this%leafc_patch(begp:endp) = spval
- call hist_addfld1d (fname='C13_LEAFC', units='gC13/m^2', &
- avgflag='A', long_name='C13 leaf C', &
- ptr_patch=this%leafc_patch, default='inactive')
-
- this%leafc_storage_patch(begp:endp) = spval
- call hist_addfld1d (fname='C13_LEAFC_STORAGE', units='gC13/m^2', &
- avgflag='A', long_name='C13 leaf C storage', &
- ptr_patch=this%leafc_storage_patch, default='inactive')
-
- this%leafc_xfer_patch(begp:endp) = spval
- call hist_addfld1d (fname='C13_LEAFC_XFER', units='gC13/m^2', &
- avgflag='A', long_name='C13 leaf C transfer', &
- ptr_patch=this%leafc_xfer_patch, default='inactive')
-
- this%leafc_storage_xfer_acc_patch(begp:endp) = spval
- call hist_addfld1d (fname='C13_LEAFC_STORAGE_XFER_ACC', units='gC13/m^2', &
- avgflag='A', long_name='Accumulated C13 leaf C transfer', &
- ptr_patch=this%leafc_storage_xfer_acc_patch, default='inactive')
-
- this%frootc_patch(begp:endp) = spval
- call hist_addfld1d (fname='C13_FROOTC', units='gC13/m^2', &
- avgflag='A', long_name='C13 fine root C', &
- ptr_patch=this%frootc_patch, default='inactive')
-
- this%frootc_storage_patch(begp:endp) = spval
- call hist_addfld1d (fname='C13_FROOTC_STORAGE', units='gC13/m^2', &
- avgflag='A', long_name='C13 fine root C storage', &
- ptr_patch=this%frootc_storage_patch, default='inactive')
-
- this%frootc_xfer_patch(begp:endp) = spval
- call hist_addfld1d (fname='C13_FROOTC_XFER', units='gC13/m^2', &
- avgflag='A', long_name='C13 fine root C transfer', &
- ptr_patch=this%frootc_xfer_patch, default='inactive')
-
- this%livestemc_patch(begp:endp) = spval
- call hist_addfld1d (fname='C13_LIVESTEMC', units='gC13/m^2', &
- avgflag='A', long_name='C13 live stem C', &
- ptr_patch=this%livestemc_patch, default='inactive')
-
- this%livestemc_storage_patch(begp:endp) = spval
- call hist_addfld1d (fname='C13_LIVESTEMC_STORAGE', units='gC13/m^2', &
- avgflag='A', long_name='C13 live stem C storage', &
- ptr_patch=this%livestemc_storage_patch, default='inactive')
-
- this%livestemc_xfer_patch(begp:endp) = spval
- call hist_addfld1d (fname='C13_LIVESTEMC_XFER', units='gC13/m^2', &
- avgflag='A', long_name='C13 live stem C transfer', &
- ptr_patch=this%livestemc_xfer_patch, default='inactive')
-
- this%deadstemc_patch(begp:endp) = spval
- call hist_addfld1d (fname='C13_DEADSTEMC', units='gC13/m^2', &
- avgflag='A', long_name='C13 dead stem C', &
- ptr_patch=this%deadstemc_patch, default='inactive')
-
- this%deadstemc_storage_patch(begp:endp) = spval
- call hist_addfld1d (fname='C13_DEADSTEMC_STORAGE', units='gC13/m^2', &
- avgflag='A', long_name='C13 dead stem C storage', &
- ptr_patch=this%deadstemc_storage_patch, default='inactive')
-
- this%deadstemc_xfer_patch(begp:endp) = spval
- call hist_addfld1d (fname='C13_DEADSTEMC_XFER', units='gC13/m^2', &
- avgflag='A', long_name='C13 dead stem C transfer', &
- ptr_patch=this%deadstemc_xfer_patch, default='inactive')
-
- this%livecrootc_patch(begp:endp) = spval
- call hist_addfld1d (fname='C13_LIVECROOTC', units='gC13/m^2', &
- avgflag='A', long_name='C13 live coarse root C', &
- ptr_patch=this%livecrootc_patch, default='inactive')
-
- this%livecrootc_storage_patch(begp:endp) = spval
- call hist_addfld1d (fname='C13_LIVECROOTC_STORAGE', units='gC13/m^2', &
- avgflag='A', long_name='C13 live coarse root C storage', &
- ptr_patch=this%livecrootc_storage_patch, default='inactive')
-
- this%livecrootc_xfer_patch(begp:endp) = spval
- call hist_addfld1d (fname='C13_LIVECROOTC_XFER', units='gC13/m^2', &
- avgflag='A', long_name='C13 live coarse root C transfer', &
- ptr_patch=this%livecrootc_xfer_patch, default='inactive')
-
- this%deadcrootc_patch(begp:endp) = spval
- call hist_addfld1d (fname='C13_DEADCROOTC', units='gC13/m^2', &
- avgflag='A', long_name='C13 dead coarse root C', &
- ptr_patch=this%deadcrootc_patch, default='inactive')
-
- this%deadcrootc_storage_patch(begp:endp) = spval
- call hist_addfld1d (fname='C13_DEADCROOTC_STORAGE', units='gC13/m^2', &
- avgflag='A', long_name='C13 dead coarse root C storage', &
- ptr_patch=this%deadcrootc_storage_patch, default='inactive')
-
- this%deadcrootc_xfer_patch(begp:endp) = spval
- call hist_addfld1d (fname='C13_DEADCROOTC_XFER', units='gC13/m^2', &
- avgflag='A', long_name='C13 dead coarse root C transfer', &
- ptr_patch=this%deadcrootc_xfer_patch, default='inactive')
-
- this%gresp_storage_patch(begp:endp) = spval
- call hist_addfld1d (fname='C13_GRESP_STORAGE', units='gC13/m^2', &
- avgflag='A', long_name='C13 growth respiration storage', &
- ptr_patch=this%gresp_storage_patch, default='inactive')
-
- this%gresp_xfer_patch(begp:endp) = spval
- call hist_addfld1d (fname='C13_GRESP_XFER', units='gC13/m^2', &
- avgflag='A', long_name='C13 growth respiration transfer', &
- ptr_patch=this%gresp_xfer_patch, default='inactive')
-
- this%cpool_patch(begp:endp) = spval
- call hist_addfld1d (fname='C13_CPOOL', units='gC13/m^2', &
- avgflag='A', long_name='C13 temporary photosynthate C pool', &
- ptr_patch=this%cpool_patch, default='inactive')
-
- this%xsmrpool_patch(begp:endp) = spval
- call hist_addfld1d (fname='C13_XSMRPOOL', units='gC13/m^2', &
- avgflag='A', long_name='C13 temporary photosynthate C pool', &
- ptr_patch=this%xsmrpool_patch, default='inactive')
-
- this%ctrunc_patch(begp:endp) = spval
- call hist_addfld1d (fname='C13_PFT_CTRUNC', units='gC13/m^2', &
- avgflag='A', long_name='C13 patch-level sink for C truncation', &
- ptr_patch=this%ctrunc_patch, default='inactive')
-
- this%dispvegc_patch(begp:endp) = spval
- call hist_addfld1d (fname='C13_DISPVEGC', units='gC13/m^2', &
- avgflag='A', long_name='C13 displayed veg carbon, excluding storage and cpool', &
- ptr_patch=this%dispvegc_patch, default='inactive')
-
- this%storvegc_patch(begp:endp) = spval
- call hist_addfld1d (fname='C13_STORVEGC', units='gC13/m^2', &
- avgflag='A', long_name='C13 stored vegetation carbon, excluding cpool', &
- ptr_patch=this%storvegc_patch, default='inactive')
-
- this%totvegc_patch(begp:endp) = spval
- call hist_addfld1d (fname='C13_TOTVEGC', units='gC13/m^2', &
- avgflag='A', long_name='C13 total vegetation carbon, excluding cpool', &
- ptr_patch=this%totvegc_patch, default='inactive')
-
- this%totc_patch(begp:endp) = spval
- call hist_addfld1d (fname='C13_TOTPFTC', units='gC13/m^2', &
- avgflag='A', long_name='C13 total patch-level carbon, including cpool', &
- ptr_patch=this%totc_patch, default='inactive')
-
- this%seedc_grc(begg:endg) = spval
- call hist_addfld1d (fname='C13_SEEDC', units='gC13/m^2', &
- avgflag='A', long_name='C13 pool for seeding new PFTs via dynamic landcover', &
- ptr_gcell=this%seedc_grc, default='inactive')
-
- this%totc_col(begc:endc) = spval
- call hist_addfld1d (fname='C13_TOTCOLC', units='gC13/m^2', &
- avgflag='A', long_name='C13 total column carbon, incl veg and cpool but excl product pools', &
- ptr_col=this%totc_col, default='inactive')
-
- this%totecosysc_col(begc:endc) = spval
- call hist_addfld1d (fname='C13_TOTECOSYSC', units='gC13/m^2', &
- avgflag='A', long_name='C13 total ecosystem carbon, incl veg but excl cpool and product pools', &
- ptr_col=this%totecosysc_col, default='inactive')
-
- if (use_crop) then
- this%grainc_patch(begp:endp) = spval
- call hist_addfld1d (fname='C13_GRAINC', units='gC/m^2', &
- avgflag='A', long_name='C13 grain C (does not equal yield)', &
- ptr_patch=this%grainc_patch, default='inactive')
- this%cropseedc_deficit_patch(begp:endp) = spval
- call hist_addfld1d (fname='C13_CROPSEEDC_DEFICIT', units='gC/m^2', &
- avgflag='A', long_name='C13 C used for crop seed that needs to be repaid', &
- ptr_patch=this%cropseedc_deficit_patch, default='inactive')
- end if
-
-
- endif
-
- !-------------------------------
- ! C14 state variables
- !-------------------------------
-
- if ( carbon_type == 'c14') then
-
- this%leafc_patch(begp:endp) = spval
- call hist_addfld1d (fname='C14_LEAFC', units='gC14/m^2', &
- avgflag='A', long_name='C14 leaf C', &
- ptr_patch=this%leafc_patch, default='inactive')
-
- this%leafc_storage_patch(begp:endp) = spval
- call hist_addfld1d (fname='C14_LEAFC_STORAGE', units='gC14/m^2', &
- avgflag='A', long_name='C14 leaf C storage', &
- ptr_patch=this%leafc_storage_patch, default='inactive')
-
- this%leafc_xfer_patch(begp:endp) = spval
- call hist_addfld1d (fname='C14_LEAFC_XFER', units='gC14/m^2', &
- avgflag='A', long_name='C14 leaf C transfer', &
- ptr_patch=this%leafc_xfer_patch, default='inactive')
-
- this%leafc_storage_xfer_acc_patch(begp:endp) = spval
- call hist_addfld1d (fname='C14_LEAFC_STORAGE_XFER_ACC', units='gC14/m^2', &
- avgflag='A', long_name='Accumulated C14 leaf C transfer', &
- ptr_patch=this%leafc_storage_xfer_acc_patch, default='inactive')
-
- this%frootc_patch(begp:endp) = spval
- call hist_addfld1d (fname='C14_FROOTC', units='gC14/m^2', &
- avgflag='A', long_name='C14 fine root C', &
- ptr_patch=this%frootc_patch, default='inactive')
-
- this%frootc_storage_patch(begp:endp) = spval
- call hist_addfld1d (fname='C14_FROOTC_STORAGE', units='gC14/m^2', &
- avgflag='A', long_name='C14 fine root C storage', &
- ptr_patch=this%frootc_storage_patch, default='inactive')
-
- this%frootc_xfer_patch(begp:endp) = spval
- call hist_addfld1d (fname='C14_FROOTC_XFER', units='gC14/m^2', &
- avgflag='A', long_name='C14 fine root C transfer', &
- ptr_patch=this%frootc_xfer_patch, default='inactive')
-
- this%livestemc_patch(begp:endp) = spval
- call hist_addfld1d (fname='C14_LIVESTEMC', units='gC14/m^2', &
- avgflag='A', long_name='C14 live stem C', &
- ptr_patch=this%livestemc_patch, default='inactive')
-
- this%livestemc_storage_patch(begp:endp) = spval
- call hist_addfld1d (fname='C14_LIVESTEMC_STORAGE', units='gC14/m^2', &
- avgflag='A', long_name='C14 live stem C storage', &
- ptr_patch=this%livestemc_storage_patch, default='inactive')
-
- this%livestemc_xfer_patch(begp:endp) = spval
- call hist_addfld1d (fname='C14_LIVESTEMC_XFER', units='gC14/m^2', &
- avgflag='A', long_name='C14 live stem C transfer', &
- ptr_patch=this%livestemc_xfer_patch, default='inactive')
-
- this%deadstemc_patch(begp:endp) = spval
- call hist_addfld1d (fname='C14_DEADSTEMC', units='gC14/m^2', &
- avgflag='A', long_name='C14 dead stem C', &
- ptr_patch=this%deadstemc_patch, default='inactive')
-
- this%deadstemc_storage_patch(begp:endp) = spval
- call hist_addfld1d (fname='C14_DEADSTEMC_STORAGE', units='gC14/m^2', &
- avgflag='A', long_name='C14 dead stem C storage', &
- ptr_patch=this%deadstemc_storage_patch, default='inactive')
-
- this%deadstemc_xfer_patch(begp:endp) = spval
- call hist_addfld1d (fname='C14_DEADSTEMC_XFER', units='gC14/m^2', &
- avgflag='A', long_name='C14 dead stem C transfer', &
- ptr_patch=this%deadstemc_xfer_patch, default='inactive')
-
- this%livecrootc_patch(begp:endp) = spval
- call hist_addfld1d (fname='C14_LIVECROOTC', units='gC14/m^2', &
- avgflag='A', long_name='C14 live coarse root C', &
- ptr_patch=this%livecrootc_patch, default='inactive')
-
- this%livecrootc_storage_patch(begp:endp) = spval
- call hist_addfld1d (fname='C14_LIVECROOTC_STORAGE', units='gC14/m^2', &
- avgflag='A', long_name='C14 live coarse root C storage', &
- ptr_patch=this%livecrootc_storage_patch, default='inactive')
-
- this%livecrootc_xfer_patch(begp:endp) = spval
- call hist_addfld1d (fname='C14_LIVECROOTC_XFER', units='gC14/m^2', &
- avgflag='A', long_name='C14 live coarse root C transfer', &
- ptr_patch=this%livecrootc_xfer_patch, default='inactive')
-
- this%deadcrootc_patch(begp:endp) = spval
- call hist_addfld1d (fname='C14_DEADCROOTC', units='gC14/m^2', &
- avgflag='A', long_name='C14 dead coarse root C', &
- ptr_patch=this%deadcrootc_patch, default='inactive')
-
- this%deadcrootc_storage_patch(begp:endp) = spval
- call hist_addfld1d (fname='C14_DEADCROOTC_STORAGE', units='gC14/m^2', &
- avgflag='A', long_name='C14 dead coarse root C storage', &
- ptr_patch=this%deadcrootc_storage_patch, default='inactive')
-
- this%deadcrootc_xfer_patch(begp:endp) = spval
- call hist_addfld1d (fname='C14_DEADCROOTC_XFER', units='gC14/m^2', &
- avgflag='A', long_name='C14 dead coarse root C transfer', &
- ptr_patch=this%deadcrootc_xfer_patch, default='inactive')
-
- this%gresp_storage_patch(begp:endp) = spval
- call hist_addfld1d (fname='C14_GRESP_STORAGE', units='gC14/m^2', &
- avgflag='A', long_name='C14 growth respiration storage', &
- ptr_patch=this%gresp_storage_patch, default='inactive')
-
- this%gresp_xfer_patch(begp:endp) = spval
- call hist_addfld1d (fname='C14_GRESP_XFER', units='gC14/m^2', &
- avgflag='A', long_name='C14 growth respiration transfer', &
- ptr_patch=this%gresp_xfer_patch, default='inactive')
-
- this%cpool_patch(begp:endp) = spval
- call hist_addfld1d (fname='C14_CPOOL', units='gC14/m^2', &
- avgflag='A', long_name='C14 temporary photosynthate C pool', &
- ptr_patch=this%cpool_patch, default='inactive')
-
- this%xsmrpool_patch(begp:endp) = spval
- call hist_addfld1d (fname='C14_XSMRPOOL', units='gC14/m^2', &
- avgflag='A', long_name='C14 temporary photosynthate C pool', &
- ptr_patch=this%xsmrpool_patch, default='inactive')
-
- this%ctrunc_patch(begp:endp) = spval
- call hist_addfld1d (fname='C14_PFT_CTRUNC', units='gC14/m^2', &
- avgflag='A', long_name='C14 patch-level sink for C truncation', &
- ptr_patch=this%ctrunc_patch, default='inactive')
-
- this%dispvegc_patch(begp:endp) = spval
- call hist_addfld1d (fname='C14_DISPVEGC', units='gC14/m^2', &
- avgflag='A', long_name='C14 displayed veg carbon, excluding storage and cpool', &
- ptr_patch=this%dispvegc_patch, default='inactive')
-
- this%storvegc_patch(begp:endp) = spval
- call hist_addfld1d (fname='C14_STORVEGC', units='gC14/m^2', &
- avgflag='A', long_name='C14 stored vegetation carbon, excluding cpool', &
- ptr_patch=this%storvegc_patch, default='inactive')
-
- this%totvegc_patch(begp:endp) = spval
- call hist_addfld1d (fname='C14_TOTVEGC', units='gC14/m^2', &
- avgflag='A', long_name='C14 total vegetation carbon, excluding cpool', &
- ptr_patch=this%totvegc_patch, default='inactive')
-
- this%totc_patch(begp:endp) = spval
- call hist_addfld1d (fname='C14_TOTPFTC', units='gC14/m^2', &
- avgflag='A', long_name='C14 total patch-level carbon, including cpool', &
- ptr_patch=this%totc_patch, default='inactive')
-
- this%seedc_grc(begg:endg) = spval
- call hist_addfld1d (fname='C14_SEEDC', units='gC14/m^2', &
- avgflag='A', long_name='C14 pool for seeding new PFTs via dynamic landcover', &
- ptr_gcell=this%seedc_grc, default='inactive')
-
- this%totc_col(begc:endc) = spval
- call hist_addfld1d (fname='C14_TOTCOLC', units='gC14/m^2', &
- avgflag='A', long_name='C14 total column carbon, incl veg and cpool but excl product pools', &
- ptr_col=this%totc_col, default='inactive')
-
- this%totecosysc_col(begc:endc) = spval
- call hist_addfld1d (fname='C14_TOTECOSYSC', units='gC14/m^2', &
- avgflag='A', long_name='C14 total ecosystem carbon, incl veg but excl cpool and product pools', &
- ptr_col=this%totecosysc_col, default='inactive')
-
- if (use_crop) then
- this%grainc_patch(begp:endp) = spval
- call hist_addfld1d (fname='C14_GRAINC', units='gC/m^2', &
- avgflag='A', long_name='C14 grain C (does not equal yield)', &
- ptr_patch=this%grainc_patch, default='inactive')
- this%cropseedc_deficit_patch(begp:endp) = spval
- call hist_addfld1d (fname='C14_CROPSEEDC_DEFICIT', units='gC/m^2', &
- avgflag='A', long_name='C14 C used for crop seed that needs to be repaid', &
- ptr_patch=this%cropseedc_deficit_patch, default='inactive')
- end if
-
-
- endif
-
- end subroutine InitHistory
-
- !-----------------------------------------------------------------------
- subroutine InitCold(this, bounds, ratio, carbon_type, c12_cnveg_carbonstate_inst)
- !
- ! !DESCRIPTION:
- ! Initializes time varying variables used only in coupled carbon-nitrogen mode (CN):
- !
- ! !USES, default='inactive':
- use landunit_varcon , only : istsoil, istcrop
- use clm_time_manager , only : is_restart, get_nstep
- use clm_varctl, only : MM_Nuptake_opt
- !
- ! !ARGUMENTS:
- class(cnveg_carbonstate_type) :: this
- type(bounds_type) , intent(in) :: bounds
- real(r8) , intent(in) :: ratio ! Standard isotope ratio
- character(len=*) , intent(in) :: carbon_type ! 'c12' or 'c13' or 'c14'
- type(cnveg_carbonstate_type) , optional, intent(in) :: c12_cnveg_carbonstate_inst
- !
- ! !LOCAL VARIABLES:
- integer :: p,c,l,g,j,k,i
- integer :: fc ! filter index
- integer :: num_special_col ! number of good values in special_col filter
- integer :: num_special_patch ! number of good values in special_patch filter
- integer :: special_col(bounds%endc-bounds%begc+1) ! special landunit filter - columns
- integer :: special_patch(bounds%endp-bounds%begp+1) ! special landunit filter - patches
- !-----------------------------------------------------------------------
-
- if (carbon_type == 'c13' .or. carbon_type == 'c14') then
- if (.not. present(c12_cnveg_carbonstate_inst)) then
- call endrun(msg=' ERROR: for C13 or C14 must pass in c12_cnveg_carbonstate_inst as argument' //&
- errMsg(sourcefile, __LINE__))
- end if
- end if
-
- ! Set column filters
-
- num_special_col = 0
- do c = bounds%begc, bounds%endc
- l = col%landunit(c)
- if (lun%ifspecial(l)) then
- num_special_col = num_special_col + 1
- special_col(num_special_col) = c
- end if
- end do
-
- ! Set patch filters
-
- num_special_patch = 0
- do p = bounds%begp,bounds%endp
- l = patch%landunit(p)
- if (lun%ifspecial(l)) then
- num_special_patch = num_special_patch + 1
- special_patch(num_special_patch) = p
- end if
- end do
-
- !-----------------------------------------------
- ! initialize patch-level carbon state variables
- !-----------------------------------------------
-
- do p = bounds%begp,bounds%endp
-
- this%leafcmax_patch(p) = 0._r8
-
- l = patch%landunit(p)
- if (lun%itype(l) == istsoil .or. lun%itype(l) == istcrop) then
-
- if (patch%itype(p) == noveg) then
- this%leafc_patch(p) = 0._r8
- this%leafc_storage_patch(p) = 0._r8
- this%frootc_patch(p) = 0._r8
- this%frootc_storage_patch(p) = 0._r8
- else
- if (pftcon%evergreen(patch%itype(p)) == 1._r8) then
- this%leafc_patch(p) = cnvegcstate_const%initial_vegC * ratio
- this%leafc_storage_patch(p) = 0._r8
- this%frootc_patch(p) = cnvegcstate_const%initial_vegC * ratio
- this%frootc_storage_patch(p) = 0._r8
- else if (patch%itype(p) >= npcropmin) then ! prognostic crop types
- this%leafc_patch(p) = 0._r8
- this%leafc_storage_patch(p) = 0._r8
- this%frootc_patch(p) = 0._r8
- this%frootc_storage_patch(p) = 0._r8
- else
- this%leafc_patch(p) = 0._r8
- this%leafc_storage_patch(p) = cnvegcstate_const%initial_vegC * ratio
- this%frootc_patch(p) = 0._r8
- this%frootc_storage_patch(p) = cnvegcstate_const%initial_vegC * ratio
- end if
- end if
- this%leafc_xfer_patch(p) = 0._r8
- this%leafc_storage_xfer_acc_patch(p) = 0._r8
- this%storage_cdemand_patch(p) = 0._r8
-
- if (MM_Nuptake_opt .eqv. .false.) then ! if not running in floating CN ratio option
- this%frootc_patch(p) = 0._r8
- this%frootc_storage_patch(p) = 0._r8
- end if
- this%frootc_xfer_patch(p) = 0._r8
-
- this%livestemc_patch(p) = 0._r8
- this%livestemc_storage_patch(p) = 0._r8
- this%livestemc_xfer_patch(p) = 0._r8
-
- if (pftcon%woody(patch%itype(p)) == 1._r8) then
- this%deadstemc_patch(p) = 0.1_r8 * ratio
- else
- this%deadstemc_patch(p) = 0._r8
- end if
- this%deadstemc_storage_patch(p) = 0._r8
- this%deadstemc_xfer_patch(p) = 0._r8
-
- this%livecrootc_patch(p) = 0._r8
- this%livecrootc_storage_patch(p) = 0._r8
- this%livecrootc_xfer_patch(p) = 0._r8
-
- this%deadcrootc_patch(p) = 0._r8
- this%deadcrootc_storage_patch(p) = 0._r8
- this%deadcrootc_xfer_patch(p) = 0._r8
-
- this%gresp_storage_patch(p) = 0._r8
- this%gresp_xfer_patch(p) = 0._r8
-
- this%cpool_patch(p) = 0._r8
- this%xsmrpool_patch(p) = 0._r8
- this%ctrunc_patch(p) = 0._r8
- this%dispvegc_patch(p) = 0._r8
- this%storvegc_patch(p) = 0._r8
- this%woodc_patch(p) = 0._r8
- this%totc_patch(p) = 0._r8
-
- if ( use_crop )then
- this%grainc_patch(p) = 0._r8
- this%grainc_storage_patch(p) = 0._r8
- this%grainc_xfer_patch(p) = 0._r8
- this%cropseedc_deficit_patch(p) = 0._r8
- end if
-
- endif
-
- end do
-
- ! -----------------------------------------------
- ! initialize column-level variables
- ! -----------------------------------------------
-
- do c = bounds%begc, bounds%endc
- l = col%landunit(c)
- if (lun%itype(l) == istsoil .or. lun%itype(l) == istcrop) then
-! this%totgrainc_col(c) = 0._r8
-
- ! total carbon pools
- this%totecosysc_col(c) = 0._r8
- this%totc_p2c_col(c) = 0._r8
- this%totc_col(c) = 0._r8
- end if
- end do
-
-
- do g = bounds%begg, bounds%endg
- this%seedc_grc(g) = 0._r8
- end do
-
- if ( .not. is_restart() .and. get_nstep() == 1 ) then
-
- do p = bounds%begp,bounds%endp
- if (pftcon%c3psn(patch%itype(p)) == 1._r8) then
- this%grainc_patch(p) = c12_cnveg_carbonstate_inst%grainc_patch(p) * c3_r2
- this%grainc_storage_patch(p) = c12_cnveg_carbonstate_inst%grainc_storage_patch(p) * c3_r2
- this%grainc_xfer_patch(p) = c12_cnveg_carbonstate_inst%grainc_xfer_patch(p) * c3_r2
- this%dispvegc_patch(p) = c12_cnveg_carbonstate_inst%dispvegc_patch(p) * c3_r2
- this%storvegc_patch(p) = c12_cnveg_carbonstate_inst%storvegc_patch(p) * c3_r2
- this%totvegc_patch(p) = c12_cnveg_carbonstate_inst%totvegc_patch(p) * c3_r2
- this%totc_patch(p) = c12_cnveg_carbonstate_inst%totc_patch(p) * c3_r2
- this%woodc_patch(p) = c12_cnveg_carbonstate_inst%woodc_patch(p) * c3_r2
- else
- this%grainc_patch(p) = c12_cnveg_carbonstate_inst%grainc_patch(p) * c4_r2
- this%grainc_storage_patch(p) = c12_cnveg_carbonstate_inst%grainc_storage_patch(p) * c4_r2
- this%grainc_xfer_patch(p) = c12_cnveg_carbonstate_inst%grainc_xfer_patch(p) * c4_r2
- this%dispvegc_patch(p) = c12_cnveg_carbonstate_inst%dispvegc_patch(p) * c4_r2
- this%storvegc_patch(p) = c12_cnveg_carbonstate_inst%storvegc_patch(p) * c4_r2
- this%totvegc_patch(p) = c12_cnveg_carbonstate_inst%totvegc_patch(p) * c4_r2
- this%totc_patch(p) = c12_cnveg_carbonstate_inst%totc_patch(p) * c4_r2
- this%woodc_patch(p) = c12_cnveg_carbonstate_inst%woodc_patch(p) * c4_r2
- end if
- end do
- end if
-
- ! initialize fields for special filters
-
- call this%SetValues (&
- num_patch=num_special_patch, filter_patch=special_patch, value_patch=0._r8, &
- num_column=num_special_col, filter_column=special_col, value_column=0._r8)
-
- end subroutine InitCold
-
- !-----------------------------------------------------------------------
- subroutine Restart ( this, bounds, ncid, flag, carbon_type, reseed_dead_plants, &
- c12_cnveg_carbonstate_inst, filter_reseed_patch, &
- num_reseed_patch)
- !
- ! !DESCRIPTION:
- ! Read/write CN restart data for carbon state
- !
- ! !USES:
- use shr_infnan_mod , only : isnan => shr_infnan_isnan, nan => shr_infnan_nan, assignment(=)
- use clm_varcon , only : c13ratio, c14ratio
- use clm_varctl , only : spinup_state, use_cndv, MM_Nuptake_opt
- use clm_time_manager , only : get_nstep, is_restart, get_nstep
- use landunit_varcon , only : istsoil, istcrop
- use spmdMod , only : mpicom
- use shr_mpi_mod , only : shr_mpi_sum
- use restUtilMod
- use ncdio_pio
- !
- ! !ARGUMENTS:
- class (cnveg_carbonstate_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'
- character(len=*) , intent(in) :: carbon_type ! 'c12' or 'c13' or 'c14'
- logical , intent(in) :: reseed_dead_plants
- type (cnveg_carbonstate_type) , intent(in), optional :: c12_cnveg_carbonstate_inst
- integer , intent(out), optional :: filter_reseed_patch(:)
- integer , intent(out), optional :: num_reseed_patch
- !
- ! !LOCAL VARIABLES:
- integer :: i,j,k,l,c,p
- real(r8) :: ratio
- character(len=128) :: varname ! temporary
- logical :: readvar
- integer :: idata
- logical :: exit_spinup = .false.
- logical :: enter_spinup = .false.
- ! flags for comparing the model and restart decomposition cascades
- integer :: decomp_cascade_state, restart_file_decomp_cascade_state
- ! spinup state as read from restart file, for determining whether to enter or exit spinup mode.
- integer :: restart_file_spinup_state
- integer :: total_num_reseed_patch ! Total number of patches to reseed across all processors
-
- !------------------------------------------------------------------------
-
- if (carbon_type == 'c13' .or. carbon_type == 'c14') then
- if (.not. present(c12_cnveg_carbonstate_inst)) then
- call endrun(msg=' ERROR: for C14 must pass in c12_cnveg_carbonstate_inst as argument' //&
- errMsg(sourcefile, __LINE__))
- end if
- end if
- if (carbon_type == 'c12') then
- ratio = 1._r8
- else if (carbon_type == 'c13') then
- ratio = c13ratio
- else if (carbon_type == 'c14') then
- ratio = c14ratio
- end if
-
- if ( ( present(num_reseed_patch) .and. .not. present(filter_reseed_patch)) &
- .or. (.not. present(num_reseed_patch) .and. present(filter_reseed_patch) ) )then
- call endrun(msg=' ERROR: filter_reseed_patch and num_reseed_patch both need to be entered ' //&
- errMsg(sourcefile, __LINE__))
- end if
- if ( present(num_reseed_patch) )then
- num_reseed_patch = 0
- filter_reseed_patch(:) = -1
- end if
-
- !--------------------------------
- ! patch carbon state variables (c12)
- !--------------------------------
-
- if (carbon_type == 'c12') then
- call restartvar(ncid=ncid, flag=flag, varname='leafc', xtype=ncd_double, &
- dim1name='pft', long_name='', units='', &
- interpinic_flag='interp', readvar=readvar, data=this%leafc_patch)
-
- call restartvar(ncid=ncid, flag=flag, varname='leafc_storage', xtype=ncd_double, &
- dim1name='pft', long_name='', units='', &
- interpinic_flag='interp', readvar=readvar, data=this%leafc_storage_patch)
-
- call restartvar(ncid=ncid, flag=flag, varname='leafc_xfer', xtype=ncd_double, &
- dim1name='pft', long_name='', units='', &
- interpinic_flag='interp', readvar=readvar, data=this%leafc_xfer_patch)
-
- call restartvar(ncid=ncid, flag=flag, varname='leafc_storage_xfer_acc', xtype=ncd_double, &
- dim1name='pft', long_name='', units='', &
- interpinic_flag='interp', readvar=readvar, data=this%leafc_storage_xfer_acc_patch)
-
- call restartvar(ncid=ncid, flag=flag, varname='storage_cdemand', xtype=ncd_double, &
- dim1name='pft', long_name='', units='', &
- interpinic_flag='interp', readvar=readvar, data=this%storage_cdemand_patch)
-
- call restartvar(ncid=ncid, flag=flag, varname='frootc', xtype=ncd_double, &
- dim1name='pft', long_name='', units='', &
- interpinic_flag='interp', readvar=readvar, data=this%frootc_patch)
-
- call restartvar(ncid=ncid, flag=flag, varname='frootc_storage', xtype=ncd_double, &
- dim1name='pft', long_name='', units='', &
- interpinic_flag='interp', readvar=readvar, data=this%frootc_storage_patch)
-
- call restartvar(ncid=ncid, flag=flag, varname='frootc_xfer', xtype=ncd_double, &
- dim1name='pft', long_name='', units='', &
- interpinic_flag='interp', readvar=readvar, data=this%frootc_xfer_patch)
-
- call restartvar(ncid=ncid, flag=flag, varname='livestemc', xtype=ncd_double, &
- dim1name='pft', long_name='', units='', &
- interpinic_flag='interp', readvar=readvar, data=this%livestemc_patch)
-
- call restartvar(ncid=ncid, flag=flag, varname='livestemc_storage', xtype=ncd_double, &
- dim1name='pft', long_name='', units='', &
- interpinic_flag='interp', readvar=readvar, data=this%livestemc_storage_patch)
-
- call restartvar(ncid=ncid, flag=flag, varname='livestemc_xfer', xtype=ncd_double, &
- dim1name='pft', long_name='', units='', &
- interpinic_flag='interp', readvar=readvar, data=this%livestemc_xfer_patch)
-
- call restartvar(ncid=ncid, flag=flag, varname='deadstemc', xtype=ncd_double, &
- dim1name='pft', long_name='', units='', &
- interpinic_flag='interp', readvar=readvar, data=this%deadstemc_patch)
-
- call restartvar(ncid=ncid, flag=flag, varname='deadstemc_storage', xtype=ncd_double, &
- dim1name='pft', long_name='', units='', &
- interpinic_flag='interp', readvar=readvar, data=this%deadstemc_storage_patch)
-
- call restartvar(ncid=ncid, flag=flag, varname='deadstemc_xfer', xtype=ncd_double, &
- dim1name='pft', long_name='', units='', &
- interpinic_flag='interp', readvar=readvar, data=this%deadstemc_xfer_patch)
-
- call restartvar(ncid=ncid, flag=flag, varname='livecrootc', xtype=ncd_double, &
- dim1name='pft', long_name='', units='', &
- interpinic_flag='interp', readvar=readvar, data=this%livecrootc_patch)
-
- call restartvar(ncid=ncid, flag=flag, varname='livecrootc_storage', xtype=ncd_double, &
- dim1name='pft', long_name='', units='', &
- interpinic_flag='interp', readvar=readvar, data=this%livecrootc_storage_patch)
-
- call restartvar(ncid=ncid, flag=flag, varname='livecrootc_xfer', xtype=ncd_double, &
- dim1name='pft', long_name='', units='', &
- interpinic_flag='interp', readvar=readvar, data=this%livecrootc_xfer_patch)
-
- call restartvar(ncid=ncid, flag=flag, varname='deadcrootc', xtype=ncd_double, &
- dim1name='pft', long_name='', units='', &
- interpinic_flag='interp', readvar=readvar, data=this%deadcrootc_patch)
-
- call restartvar(ncid=ncid, flag=flag, varname='deadcrootc_storage', xtype=ncd_double, &
- dim1name='pft', long_name='', units='', &
- interpinic_flag='interp', readvar=readvar, data=this%deadcrootc_storage_patch)
-
- call restartvar(ncid=ncid, flag=flag, varname='deadcrootc_xfer', xtype=ncd_double, &
- dim1name='pft', long_name='', units='', &
- interpinic_flag='interp', readvar=readvar, data=this%deadcrootc_xfer_patch)
-
- call restartvar(ncid=ncid, flag=flag, varname='gresp_storage', xtype=ncd_double, &
- dim1name='pft', long_name='', units='', &
- interpinic_flag='interp', readvar=readvar, data=this%gresp_storage_patch)
-
- call restartvar(ncid=ncid, flag=flag, varname='gresp_xfer', xtype=ncd_double, &
- dim1name='pft', long_name='', units='', &
- interpinic_flag='interp', readvar=readvar, data=this%gresp_xfer_patch)
-
- call restartvar(ncid=ncid, flag=flag, varname='cpool', xtype=ncd_double, &
- dim1name='pft', long_name='', units='', &
- interpinic_flag='interp', readvar=readvar, data=this%cpool_patch)
-
- call restartvar(ncid=ncid, flag=flag, varname='xsmrpool', xtype=ncd_double, &
- dim1name='pft', long_name='', units='', &
- interpinic_flag='interp', readvar=readvar, data=this%xsmrpool_patch)
-
- call restartvar(ncid=ncid, flag=flag, varname='pft_ctrunc', xtype=ncd_double, &
- dim1name='pft', long_name='', units='', &
- interpinic_flag='interp', readvar=readvar, data=this%ctrunc_patch)
-
- call restartvar(ncid=ncid, flag=flag, varname='leafcmax', xtype=ncd_double, &
- dim1name='pft', &
- long_name='', units='', &
- interpinic_flag='interp', readvar=readvar, data=this%leafcmax_patch)
-
- if (flag == 'read') then
- call restartvar(ncid=ncid, flag=flag, varname='spinup_state', xtype=ncd_int, &
- long_name='Spinup state of the model that wrote this restart file: ' &
- // ' 0 = normal model mode, 1 = AD spinup, 2 = AAD spinup', units='', &
- interpinic_flag='copy', readvar=readvar, data=idata)
-
- if (readvar) then
- restart_file_spinup_state = idata
- else
- restart_file_spinup_state = spinup_state
- if ( masterproc ) then
- write(iulog,*) ' CNRest: WARNING! Restart file does not contain info ' &
- // ' on spinup state used to generate the restart file. '
- write(iulog,*) ' Assuming the same as current setting: ', spinup_state
- end if
- end if
- end if
-
- if (flag == 'read' .and. spinup_state /= restart_file_spinup_state .and. .not. use_cndv) then
- if ( masterproc ) write(iulog, *) 'exit_spinup ',exit_spinup,' restart_file_spinup_state ',restart_file_spinup_state
- if (spinup_state <= 1 .and. restart_file_spinup_state == 2 ) then
- if ( masterproc ) write(iulog,*) ' CNRest: taking Dead wood C pools out of AD spinup mode'
- exit_spinup = .true.
- if ( masterproc ) write(iulog, *) 'Multiplying stemc and crootc by 10 for exit spinup'
- do i = bounds%begp,bounds%endp
- this%deadstemc_patch(i) = this%deadstemc_patch(i) * 10._r8
- this%deadcrootc_patch(i) = this%deadcrootc_patch(i) * 10._r8
- end do
- else if (spinup_state == 2 .and. restart_file_spinup_state <= 1 )then
- if (spinup_state == 2 .and. restart_file_spinup_state <= 1 )then
- if ( masterproc ) write(iulog,*) ' CNRest: taking Dead wood C pools into AD spinup mode'
- enter_spinup = .true.
- if ( masterproc ) write(iulog, *) 'Dividing stemc and crootc by 10 for enter spinup '
- do i = bounds%begp,bounds%endp
- this%deadstemc_patch(i) = this%deadstemc_patch(i) / 10._r8
- this%deadcrootc_patch(i) = this%deadcrootc_patch(i) / 10._r8
- end do
- end if
- end if
- end if
- !--------------------------------
- ! C12 carbon state variables
- !--------------------------------
-
- if (carbon_type == 'c12') then
- call restartvar(ncid=ncid, flag=flag, varname='totvegc', xtype=ncd_double, &
- dim1name='pft', long_name='', units='', &
- interpinic_flag='interp', readvar=readvar, data=this%totvegc_patch)
- ! totvegc_col needed for resetting soil carbon stocks during AD spinup exit
- call restartvar(ncid=ncid, flag=flag, varname='totvegc_col', xtype=ncd_double, &
- dim1name='column', long_name='', units='', &
- interpinic_flag='interp', readvar=readvar, data=this%totvegc_col)
- end if
-
- !--------------------------------
- ! C13 carbon state variables
- !--------------------------------
-
- if ( carbon_type == 'c13') then
- call restartvar(ncid=ncid, flag=flag, varname='totvegc_13', xtype=ncd_double, &
- dim1name='pft', long_name='', units='', &
- interpinic_flag='interp', readvar=readvar, data=this%totvegc_patch)
- if (flag=='read' .and. .not. readvar) then
- if ( masterproc ) write(iulog,*) 'initializing cnveg_carbonstate_inst%totvegc with atmospheric c13 value'
- do i = bounds%begp,bounds%endp
- if (pftcon%c3psn(patch%itype(i)) == 1._r8) then
- this%totvegc_patch(i) = c12_cnveg_carbonstate_inst%totvegc_patch(i) * c3_r2
- else
- this%totvegc_patch(i) = c12_cnveg_carbonstate_inst%totvegc_patch(i) * c4_r2
- endif
- end do
- end if
-
- call restartvar(ncid=ncid, flag=flag, varname='totvegc_col_13', xtype=ncd_double, &
- dim1name='column', long_name='', units='', &
- interpinic_flag='interp', readvar=readvar, data=this%totvegc_col)
- if (flag=='read' .and. .not. readvar) then
- if ( masterproc ) write(iulog,*) 'initializing cnveg_carbonstate_inst%totvegc with atmospheric c13 value'
- do i = bounds%begc,bounds%endc
- if (pftcon%c3psn(patch%itype(i)) == 1._r8) then
- this%totvegc_col(i) = c12_cnveg_carbonstate_inst%totvegc_col(i) * c3_r2
- else
- this%totvegc_col(i) = c12_cnveg_carbonstate_inst%totvegc_col(i) * c4_r2
- endif
- end do
- end if
-
- end if
-
- !--------------------------------
- ! C14 patch carbon state variables
- !--------------------------------
-
- if ( carbon_type == 'c14') then
- call restartvar(ncid=ncid, flag=flag, varname='totvegc_14', xtype=ncd_double, &
- dim1name='pft', long_name='', units='', &
- interpinic_flag='interp', readvar=readvar, data=this%totvegc_patch)
- if (flag=='read' .and. .not. readvar) then
- if ( masterproc ) write(iulog,*) 'initializing this%totvegc_patch with atmospheric c14 value'
- do i = bounds%begp,bounds%endp
- if (this%totvegc_patch(i) /= spval .and. &
- .not. isnan(this%totvegc_patch(i)) ) then
- this%totvegc_patch(i) = c12_cnveg_carbonstate_inst%totvegc_patch(i) * c14ratio
- endif
- end do
- endif
-
- call restartvar(ncid=ncid, flag=flag, varname='totvegc_col_14', xtype=ncd_double, &
- dim1name='column', long_name='', units='', &
- interpinic_flag='interp', readvar=readvar, data=this%totvegc_col)
- if (flag=='read' .and. .not. readvar) then
- if ( masterproc ) write(iulog,*) 'initializing cnveg_carbonstate_inst%totvegc with atmospheric c14 value'
- do i = bounds%begc,bounds%endc
- if (this%totvegc_col(i) /= spval .and. &
- .not. isnan(this%totvegc_col(i)) ) then
- this%totvegc_col(i) = c12_cnveg_carbonstate_inst%totvegc_col(i) * c14ratio
- endif
- end do
- end if
- end if
-
-
- if ( flag == 'read' .and. (enter_spinup .or. (reseed_dead_plants .and. .not. is_restart())) .and. .not. use_cndv) then
- if ( masterproc ) write(iulog, *) 'Reseeding dead plants for CNVegCarbonState'
- ! If a pft is dead (indicated by totvegc = 0) then we reseed that
- ! pft according to the cold start protocol in the InitCold subroutine.
- ! Thus, the variable totvegc is required to be read before here
- ! so that if it is zero for a given pft, the pft can be reseeded.
- do i = bounds%begp,bounds%endp
- if (this%totvegc_patch(i) .le. 0.0_r8) then
- !-----------------------------------------------
- ! initialize patch-level carbon state variables
- !-----------------------------------------------
-
- this%leafcmax_patch(i) = 0._r8
-
- l = patch%landunit(i)
- if (lun%itype(l) == istsoil )then
- if ( present(num_reseed_patch) ) then
- num_reseed_patch = num_reseed_patch + 1
- filter_reseed_patch(num_reseed_patch) = i
- end if
-
- if (patch%itype(i) == noveg) then
- this%leafc_patch(i) = 0._r8
- this%leafc_storage_patch(i) = 0._r8
- this%frootc_patch(i) = 0._r8
- this%frootc_storage_patch(i) = 0._r8
- else
- if (pftcon%evergreen(patch%itype(i)) == 1._r8) then
- this%leafc_patch(i) = cnvegcstate_const%initial_vegC * ratio
- this%leafc_storage_patch(i) = 0._r8
- this%frootc_patch(i) = cnvegcstate_const%initial_vegC * ratio
- this%frootc_storage_patch(i) = 0._r8
- else
- this%leafc_patch(i) = 0._r8
- this%leafc_storage_patch(i) = cnvegcstate_const%initial_vegC * ratio
- this%frootc_patch(i) = 0._r8
- this%frootc_storage_patch(i) = cnvegcstate_const%initial_vegC * ratio
- end if
- end if
- this%leafc_xfer_patch(i) = 0._r8
- this%leafc_storage_xfer_acc_patch(i) = 0._r8
- this%storage_cdemand_patch(i) = 0._r8
-
- if (MM_Nuptake_opt .eqv. .false.) then ! if not running in floating CN ratio option
- this%frootc_patch(i) = 0._r8
- this%frootc_storage_patch(i) = 0._r8
- end if
- this%frootc_xfer_patch(i) = 0._r8
-
- this%livestemc_patch(i) = 0._r8
- this%livestemc_storage_patch(i) = 0._r8
- this%livestemc_xfer_patch(i) = 0._r8
-
- if (pftcon%woody(patch%itype(i)) == 1._r8) then
- this%deadstemc_patch(i) = 0.1_r8 * ratio
- else
- this%deadstemc_patch(i) = 0._r8
- end if
- this%deadstemc_storage_patch(i) = 0._r8
- this%deadstemc_xfer_patch(i) = 0._r8
-
- this%livecrootc_patch(i) = 0._r8
- this%livecrootc_storage_patch(i) = 0._r8
- this%livecrootc_xfer_patch(i) = 0._r8
-
- this%deadcrootc_patch(i) = 0._r8
- this%deadcrootc_storage_patch(i) = 0._r8
- this%deadcrootc_xfer_patch(i) = 0._r8
-
- this%gresp_storage_patch(i) = 0._r8
- this%gresp_xfer_patch(i) = 0._r8
-
- this%cpool_patch(i) = 0._r8
- this%xsmrpool_patch(i) = 0._r8
- this%ctrunc_patch(i) = 0._r8
- this%dispvegc_patch(i) = 0._r8
- this%storvegc_patch(i) = 0._r8
- this%woodc_patch(i) = 0._r8
- this%totc_patch(i) = 0._r8
-
- if ( use_crop )then
- this%grainc_patch(i) = 0._r8
- this%grainc_storage_patch(i) = 0._r8
- this%grainc_xfer_patch(i) = 0._r8
- this%cropseedc_deficit_patch(i) = 0._r8
- end if
-
- ! calculate totvegc explicitly so that it is available for the isotope
- ! code on the first time step.
-
- this%totvegc_patch(i) = &
- this%leafc_patch(i) + &
- this%leafc_storage_patch(i) + &
- this%leafc_xfer_patch(i) + &
- this%frootc_patch(i) + &
- this%frootc_storage_patch(i) + &
- this%frootc_xfer_patch(i) + &
- this%livestemc_patch(i) + &
- this%livestemc_storage_patch(i) + &
- this%livestemc_xfer_patch(i) + &
- this%deadstemc_patch(i) + &
- this%deadstemc_storage_patch(i) + &
- this%deadstemc_xfer_patch(i) + &
- this%livecrootc_patch(i) + &
- this%livecrootc_storage_patch(i) + &
- this%livecrootc_xfer_patch(i) + &
- this%deadcrootc_patch(i) + &
- this%deadcrootc_storage_patch(i) + &
- this%deadcrootc_xfer_patch(i) + &
- this%gresp_storage_patch(i) + &
- this%gresp_xfer_patch(i) + &
- this%cpool_patch(i)
-
- if ( use_crop )then
- this%totvegc_patch(i) = &
- this%totvegc_patch(i) + &
- this%grainc_patch(i) + &
- this%grainc_storage_patch(i) + &
- this%grainc_xfer_patch(i)
- end if
-
- endif
- end if
- end do
- if ( .not. is_restart() .and. get_nstep() == 1 ) then
-
- do p = bounds%begp,bounds%endp
- if (this%leafc_patch(p) .lt. 0.01_r8) then
- if (pftcon%c3psn(patch%itype(p)) == 1._r8) then
- this%grainc_patch(p) = c12_cnveg_carbonstate_inst%grainc_patch(p) * c3_r2
- this%grainc_storage_patch(p) = c12_cnveg_carbonstate_inst%grainc_storage_patch(p) * c3_r2
- this%grainc_xfer_patch(p) = c12_cnveg_carbonstate_inst%grainc_xfer_patch(p) * c3_r2
- this%dispvegc_patch(p) = c12_cnveg_carbonstate_inst%dispvegc_patch(p) * c3_r2
- this%storvegc_patch(p) = c12_cnveg_carbonstate_inst%storvegc_patch(p) * c3_r2
- this%totvegc_patch(p) = c12_cnveg_carbonstate_inst%totvegc_patch(p) * c3_r2
- this%totc_patch(p) = c12_cnveg_carbonstate_inst%totc_patch(p) * c3_r2
- this%woodc_patch(p) = c12_cnveg_carbonstate_inst%woodc_patch(p) * c3_r2
- else
- this%grainc_patch(p) = c12_cnveg_carbonstate_inst%grainc_patch(p) * c4_r2
- this%grainc_storage_patch(p) = c12_cnveg_carbonstate_inst%grainc_storage_patch(p) * c4_r2
- this%grainc_xfer_patch(p) = c12_cnveg_carbonstate_inst%grainc_xfer_patch(p) * c4_r2
- this%dispvegc_patch(p) = c12_cnveg_carbonstate_inst%dispvegc_patch(p) * c4_r2
- this%storvegc_patch(p) = c12_cnveg_carbonstate_inst%storvegc_patch(p) * c4_r2
- this%totvegc_patch(p) = c12_cnveg_carbonstate_inst%totvegc_patch(p) * c4_r2
- this%totc_patch(p) = c12_cnveg_carbonstate_inst%totc_patch(p) * c4_r2
- this%woodc_patch(p) = c12_cnveg_carbonstate_inst%woodc_patch(p) * c4_r2
- end if
- end if
- end do
- end if
- if ( present(num_reseed_patch) ) then
- call shr_mpi_sum( num_reseed_patch, total_num_reseed_patch, mpicom )
- if ( masterproc ) write(iulog,*) 'Total num_reseed, over all tasks = ', total_num_reseed_patch
- end if
- end if
-
- end if
-
- !--------------------------------
- ! C13 patch carbon state variables
- !--------------------------------
-
- if ( carbon_type == 'c13') then
- call restartvar(ncid=ncid, flag=flag, varname='leafc_13', xtype=ncd_double, &
- dim1name='pft', long_name='', units='', &
- interpinic_flag='interp', readvar=readvar, data=this%leafc_patch)
- if (flag=='read' .and. .not. readvar) then
- if ( masterproc ) write(iulog,*) 'initializing this%leafc with atmospheric c13 value'
- do i = bounds%begp,bounds%endp
- if (pftcon%c3psn(patch%itype(i)) == 1._r8) then
- this%leafc_patch(i) = c12_cnveg_carbonstate_inst%leafc_patch(i) * c3_r2
- else
- this%leafc_patch(i) = c12_cnveg_carbonstate_inst%leafc_patch(i) * c4_r2
- endif
- end do
- end if
-
- call restartvar(ncid=ncid, flag=flag, varname='leafc_storage_13', xtype=ncd_double, &
- dim1name='pft', long_name='', units='', &
- interpinic_flag='interp', readvar=readvar, data=this%leafc_storage_patch)
- if (flag=='read' .and. .not. readvar) then
- if ( masterproc ) write(iulog,*) 'initializing this%leafc_storage with atmospheric c13 value'
- do i = bounds%begp,bounds%endp
- if (pftcon%c3psn(patch%itype(i)) == 1._r8) then
- this%leafc_storage_patch(i) = c12_cnveg_carbonstate_inst%leafc_storage_patch(i) * c3_r2
- else
- this%leafc_storage_patch(i) = c12_cnveg_carbonstate_inst%leafc_storage_patch(i) * c4_r2
- this%leafc_storage_patch(i) = c12_cnveg_carbonstate_inst%leafc_storage_patch(i) * c4_r2
- endif
- end do
- end if
-
- call restartvar(ncid=ncid, flag=flag, varname='leafc_xfer_13', xtype=ncd_double, &
- dim1name='pft', long_name='', units='', &
- interpinic_flag='interp', readvar=readvar, data=this%leafc_xfer_patch)
- if (flag=='read' .and. .not. readvar) then
- if ( masterproc ) write(iulog,*) 'initializing this%leafc_xfer with atmospheric c13 value'
- do i = bounds%begp,bounds%endp
- if (pftcon%c3psn(patch%itype(i)) == 1._r8) then
- this%leafc_xfer_patch(i) = c12_cnveg_carbonstate_inst%leafc_xfer_patch(i) * c3_r2
- else
- this%leafc_xfer_patch(i) = c12_cnveg_carbonstate_inst%leafc_xfer_patch(i) * c4_r2
- endif
- end do
- end if
-
- call restartvar(ncid=ncid, flag=flag, varname='frootc_13', xtype=ncd_double, &
- dim1name='pft', long_name='', units='', &
- interpinic_flag='interp', readvar=readvar, data=this%frootc_patch)
- if (flag=='read' .and. .not. readvar) then
- if ( masterproc ) write(iulog,*) 'initializing this%frootc with atmospheric c13 value'
- do i = bounds%begp,bounds%endp
- if (pftcon%c3psn(patch%itype(i)) == 1._r8) then
- this%frootc_patch(i) = c12_cnveg_carbonstate_inst%frootc_patch(i) * c3_r2
- else
- this%frootc_patch(i) = c12_cnveg_carbonstate_inst%frootc_patch(i) * c4_r2
- endif
- end do
- end if
-
- call restartvar(ncid=ncid, flag=flag, varname='frootc_storage_13', xtype=ncd_double, &
- dim1name='pft', long_name='', units='', &
- interpinic_flag='interp', readvar=readvar, data=this%frootc_storage_patch)
- if (flag=='read' .and. .not. readvar) then
- if ( masterproc ) write(iulog,*) 'initializing this%frootc_storage with atmospheric c13 value'
- do i = bounds%begp,bounds%endp
- if (pftcon%c3psn(patch%itype(i)) == 1._r8) then
- this%frootc_storage_patch(i) = c12_cnveg_carbonstate_inst%frootc_storage_patch(i) * c3_r2
- else
- this%frootc_storage_patch(i) = c12_cnveg_carbonstate_inst%frootc_storage_patch(i) * c4_r2
- endif
- end do
- end if
-
- call restartvar(ncid=ncid, flag=flag, varname='frootc_xfer_13', xtype=ncd_double, &
- dim1name='pft', long_name='', units='', &
- interpinic_flag='interp', readvar=readvar, data=this%frootc_xfer_patch)
- if (flag=='read' .and. .not. readvar) then
- if ( masterproc ) write(iulog,*) 'initializing this%frootc_xfer with atmospheric c13 value'
- do i = bounds%begp,bounds%endp
- if (pftcon%c3psn(patch%itype(i)) == 1._r8) then
- this%frootc_xfer_patch(i) = c12_cnveg_carbonstate_inst%frootc_xfer_patch(i) * c3_r2
- else
- this%frootc_xfer_patch(i) = c12_cnveg_carbonstate_inst%frootc_xfer_patch(i) * c4_r2
- endif
- end do
- end if
-
- call restartvar(ncid=ncid, flag=flag, varname='livestemc_13', xtype=ncd_double, &
- dim1name='pft', long_name='', units='', &
- interpinic_flag='interp', readvar=readvar, data=this%livestemc_patch)
- if (flag=='read' .and. .not. readvar) then
- if ( masterproc ) write(iulog,*) 'initializing this%livestemc with atmospheric c13 value'
- do i = bounds%begp,bounds%endp
- if (pftcon%c3psn(patch%itype(i)) == 1._r8) then
- this%livestemc_patch(i) = c12_cnveg_carbonstate_inst%livestemc_patch(i) * c3_r2
- else
- this%livestemc_patch(i) = c12_cnveg_carbonstate_inst%livestemc_patch(i) * c4_r2
- endif
- end do
- end if
-
- call restartvar(ncid=ncid, flag=flag, varname='livestemc_storage_13', xtype=ncd_double, &
- dim1name='pft', long_name='', units='', &
- interpinic_flag='interp', readvar=readvar, data=this%livestemc_storage_patch)
- if (flag=='read' .and. .not. readvar) then
- if ( masterproc ) write(iulog,*) 'initializing this%livestemc_storage with atmospheric c13 value'
- do i = bounds%begp,bounds%endp
- if (pftcon%c3psn(patch%itype(i)) == 1._r8) then
- this%livestemc_storage_patch(i) = c12_cnveg_carbonstate_inst%livestemc_storage_patch(i) * c3_r2
- else
- this%livestemc_storage_patch(i) = c12_cnveg_carbonstate_inst%livestemc_storage_patch(i) * c4_r2
- endif
- end do
- end if
-
- call restartvar(ncid=ncid, flag=flag, varname='livestemc_xfer_13', xtype=ncd_double, &
- dim1name='pft', long_name='', units='', &
- interpinic_flag='interp', readvar=readvar, data=this%livestemc_xfer_patch)
- if (flag=='read' .and. .not. readvar) then
- if ( masterproc ) write(iulog,*) 'initializing this%livestemc_xfer with atmospheric c13 value'
- do i = bounds%begp,bounds%endp
- if (pftcon%c3psn(patch%itype(i)) == 1._r8) then
- this%livestemc_xfer_patch(i) = c12_cnveg_carbonstate_inst%livestemc_xfer_patch(i) * c3_r2
- else
- this%livestemc_xfer_patch(i) = c12_cnveg_carbonstate_inst%livestemc_xfer_patch(i) * c4_r2
- endif
- end do
- end if
-
- call restartvar(ncid=ncid, flag=flag, varname='deadstemc_13', xtype=ncd_double, &
- dim1name='pft', long_name='', units='', &
- interpinic_flag='interp', readvar=readvar, data=this%deadstemc_patch)
- if (flag=='read' .and. .not. readvar) then
- if ( masterproc ) write(iulog,*) 'initializing this%deadstemc with atmospheric c13 value'
- do i = bounds%begp,bounds%endp
- if (pftcon%c3psn(patch%itype(i)) == 1._r8) then
- this%deadstemc_patch(i) = c12_cnveg_carbonstate_inst%deadstemc_patch(i) * c3_r2
- else
- this%deadstemc_patch(i) = c12_cnveg_carbonstate_inst%deadstemc_patch(i) * c4_r2
- endif
- end do
- end if
-
- call restartvar(ncid=ncid, flag=flag, varname='deadstemc_storage_13', xtype=ncd_double, &
- dim1name='pft', long_name='', units='', &
- interpinic_flag='interp', readvar=readvar, data=this%deadstemc_storage_patch)
- if (flag=='read' .and. .not. readvar) then
- if ( masterproc ) write(iulog,*) 'initializing this%deadstemc_storage with atmospheric c13 value'
- do i = bounds%begp,bounds%endp
- if (pftcon%c3psn(patch%itype(i)) == 1._r8) then
- this%deadstemc_storage_patch(i) = c12_cnveg_carbonstate_inst%deadstemc_storage_patch(i) * c3_r2
- else
- this%deadstemc_storage_patch(i) = c12_cnveg_carbonstate_inst%deadstemc_storage_patch(i) * c4_r2
- endif
- end do
- end if
-
- call restartvar(ncid=ncid, flag=flag, varname='deadstemc_xfer_13', xtype=ncd_double, &
- dim1name='pft', long_name='', units='', &
- interpinic_flag='interp', readvar=readvar, data=this%deadstemc_xfer_patch)
- if (flag=='read' .and. .not. readvar) then
- if ( masterproc ) write(iulog,*) 'initializing this%deadstemc_xfer with atmospheric c13 value'
- do i = bounds%begp,bounds%endp
- if (pftcon%c3psn(patch%itype(i)) == 1._r8) then
- this%deadstemc_xfer_patch(i) = c12_cnveg_carbonstate_inst%deadstemc_xfer_patch(i) * c3_r2
- else
- this%deadstemc_xfer_patch(i) = c12_cnveg_carbonstate_inst%deadstemc_xfer_patch(i) * c4_r2
- endif
- end do
- end if
-
- call restartvar(ncid=ncid, flag=flag, varname='livecrootc_13', xtype=ncd_double, &
- dim1name='pft', long_name='', units='', &
- interpinic_flag='interp', readvar=readvar, data=this%livecrootc_patch)
- if (flag=='read' .and. .not. readvar) then
- if ( masterproc ) write(iulog,*) 'initializing this%livecrootc with atmospheric c13 value'
- do i = bounds%begp,bounds%endp
- if (pftcon%c3psn(patch%itype(i)) == 1._r8) then
- this%livecrootc_patch(i) = c12_cnveg_carbonstate_inst%livecrootc_patch(i) * c3_r2
- else
- this%livecrootc_patch(i) = c12_cnveg_carbonstate_inst%livecrootc_patch(i) * c4_r2
- endif
- end do
- end if
-
- call restartvar(ncid=ncid, flag=flag, varname='livecrootc_storage_13', xtype=ncd_double, &
- dim1name='pft', long_name='', units='', &
- interpinic_flag='interp', readvar=readvar, data=this%livecrootc_storage_patch)
- if (flag=='read' .and. .not. readvar) then
- if ( masterproc ) write(iulog,*) 'initializing this%livecrootc_storage with atmospheric c13 value'
- do i = bounds%begp,bounds%endp
- if (pftcon%c3psn(patch%itype(i)) == 1._r8) then
- this%livecrootc_storage_patch(i) = c12_cnveg_carbonstate_inst%livecrootc_storage_patch(i) * c3_r2
- else
- this%livecrootc_storage_patch(i) = c12_cnveg_carbonstate_inst%livecrootc_storage_patch(i) * c4_r2
- endif
- end do
- end if
-
- call restartvar(ncid=ncid, flag=flag, varname='livecrootc_xfer_13', xtype=ncd_double, &
- dim1name='pft', long_name='', units='', &
- interpinic_flag='interp', readvar=readvar, data=this%livecrootc_xfer_patch)
- if (flag=='read' .and. .not. readvar) then
- if ( masterproc ) write(iulog,*) 'initializing this%livecrootc_xfer with atmospheric c13 value'
- do i = bounds%begp,bounds%endp
- if (pftcon%c3psn(patch%itype(i)) == 1._r8) then
- this%livecrootc_xfer_patch(i) = c12_cnveg_carbonstate_inst%livecrootc_xfer_patch(i) * c3_r2
- else
- this%livecrootc_xfer_patch(i) = c12_cnveg_carbonstate_inst%livecrootc_xfer_patch(i) * c4_r2
- endif
- end do
- end if
-
- call restartvar(ncid=ncid, flag=flag, varname='deadcrootc_13', xtype=ncd_double, &
- dim1name='pft', long_name='', units='', &
- interpinic_flag='interp', readvar=readvar, data=this%deadcrootc_patch)
- if (flag=='read' .and. .not. readvar) then
- if ( masterproc ) write(iulog,*) 'initializing this%deadcrootc with atmospheric c13 value'
- do i = bounds%begp,bounds%endp
- if (pftcon%c3psn(patch%itype(i)) == 1._r8) then
- this%deadcrootc_patch(i) = c12_cnveg_carbonstate_inst%deadcrootc_patch(i) * c3_r2
- else
- this%deadcrootc_patch(i) = c12_cnveg_carbonstate_inst%deadcrootc_patch(i) * c4_r2
- endif
- end do
- end if
-
- call restartvar(ncid=ncid, flag=flag, varname='deadcrootc_storage_13', xtype=ncd_double, &
- dim1name='pft', long_name='', units='', &
- interpinic_flag='interp', readvar=readvar, data=this%deadcrootc_storage_patch)
- if (flag=='read' .and. .not. readvar) then
- if ( masterproc ) write(iulog,*) 'initializing this%deadcrootc_storage with atmospheric c13 value'
- do i = bounds%begp,bounds%endp
- if (pftcon%c3psn(patch%itype(i)) == 1._r8) then
- this%deadcrootc_storage_patch(i) = c12_cnveg_carbonstate_inst%deadcrootc_storage_patch(i) * c3_r2
- else
- this%deadcrootc_storage_patch(i) = c12_cnveg_carbonstate_inst%deadcrootc_storage_patch(i) * c4_r2
- endif
- end do
- end if
-
- call restartvar(ncid=ncid, flag=flag, varname='deadcrootc_xfer_13', xtype=ncd_double, &
- dim1name='pft', long_name='', units='', &
- interpinic_flag='interp', readvar=readvar, data=this%deadcrootc_xfer_patch)
- if (flag=='read' .and. .not. readvar) then
- if ( masterproc ) write(iulog,*) 'initializing this%deadcrootc_xfer with atmospheric c13 value'
- do i = bounds%begp,bounds%endp
- if (pftcon%c3psn(patch%itype(i)) == 1._r8) then
- this%deadcrootc_xfer_patch(i) = c12_cnveg_carbonstate_inst%deadcrootc_xfer_patch(i) * c3_r2
- else
- this%deadcrootc_xfer_patch(i) = c12_cnveg_carbonstate_inst%deadcrootc_xfer_patch(i) * c4_r2
- endif
- end do
- end if
-
- call restartvar(ncid=ncid, flag=flag, varname='gresp_storage_13', xtype=ncd_double, &
- dim1name='pft', long_name='', units='', &
- interpinic_flag='interp', readvar=readvar, data=this%gresp_storage_patch)
- if (flag=='read' .and. .not. readvar) then
- if ( masterproc ) write(iulog,*) 'initializing this%gresp_storage with atmospheric c13 value'
- do i = bounds%begp,bounds%endp
- if (pftcon%c3psn(patch%itype(i)) == 1._r8) then
- this%gresp_storage_patch(i) = c12_cnveg_carbonstate_inst%gresp_storage_patch(i) * c3_r2
- else
- this%gresp_storage_patch(i) = c12_cnveg_carbonstate_inst%gresp_storage_patch(i) * c4_r2
- endif
- end do
- end if
-
- call restartvar(ncid=ncid, flag=flag, varname='gresp_xfer_13', xtype=ncd_double, &
- dim1name='pft', &
- long_name='', units='', &
- interpinic_flag='interp', readvar=readvar, data=this%gresp_xfer_patch)
- if (flag=='read' .and. .not. readvar) then
- if ( masterproc ) write(iulog,*) 'initializing this%gresp_xfer with atmospheric c13 value'
- do i = bounds%begp,bounds%endp
- if (pftcon%c3psn(patch%itype(i)) == 1._r8) then
- this%gresp_xfer_patch(i) = c12_cnveg_carbonstate_inst%gresp_xfer_patch(i) * c3_r2
- else
- this%gresp_xfer_patch(i) = c12_cnveg_carbonstate_inst%gresp_xfer_patch(i) * c4_r2
- endif
- end do
- end if
-
- call restartvar(ncid=ncid, flag=flag, varname='cpool_13', xtype=ncd_double, &
- dim1name='pft', long_name='', units='', &
- interpinic_flag='interp', readvar=readvar, data=this%cpool_patch)
- if (flag=='read' .and. .not. readvar) then
- if ( masterproc ) write(iulog,*) 'initializing this%cpool with atmospheric c13 value'
- do i = bounds%begp,bounds%endp
- if (pftcon%c3psn(patch%itype(i)) == 1._r8) then
- this%cpool_patch(i) = c12_cnveg_carbonstate_inst%cpool_patch(i) * c3_r2
- else
- this%cpool_patch(i) = c12_cnveg_carbonstate_inst%cpool_patch(i) * c4_r2
- endif
- end do
- end if
-
- call restartvar(ncid=ncid, flag=flag, varname='xsmrpool_13', xtype=ncd_double, &
- dim1name='pft', &
- long_name='', units='', &
- interpinic_flag='interp', readvar=readvar, data=this%xsmrpool_patch)
- if (flag=='read' .and. .not. readvar) then
- if ( masterproc ) write(iulog,*) 'initializing this%xsmrpool with atmospheric c13 value'
- do i = bounds%begp,bounds%endp
- if (pftcon%c3psn(patch%itype(i)) == 1._r8) then
- this%xsmrpool_patch(i) = c12_cnveg_carbonstate_inst%xsmrpool_patch(i) * c3_r2
- else
- this%xsmrpool_patch(i) = c12_cnveg_carbonstate_inst%xsmrpool_patch(i) * c4_r2
- endif
- end do
- end if
-
- call restartvar(ncid=ncid, flag=flag, varname='pft_ctrunc_13', xtype=ncd_double, &
- dim1name='pft', long_name='', units='', &
- interpinic_flag='interp', readvar=readvar, data=this%ctrunc_patch)
- if (flag=='read' .and. .not. readvar) then
- if ( masterproc ) write(iulog,*) 'initializing this%ctrunc with atmospheric c13 value'
- do i = bounds%begp,bounds%endp
- if (pftcon%c3psn(patch%itype(i)) == 1._r8) then
- this%ctrunc_patch(i) = c12_cnveg_carbonstate_inst%ctrunc_patch(i) * c3_r2
- else
- this%ctrunc_patch(i) = c12_cnveg_carbonstate_inst%ctrunc_patch(i) * c4_r2
- endif
- end do
- end if
-
- end if
-
- !--------------------------------
- ! C14 patch carbon state variables
- !--------------------------------
-
- if ( carbon_type == 'c14') then
- call restartvar(ncid=ncid, flag=flag, varname='leafc_14', xtype=ncd_double, &
- dim1name='pft', long_name='', units='', &
- interpinic_flag='interp', readvar=readvar, data=this%leafc_patch)
- if (flag=='read' .and. .not. readvar) then
- if ( masterproc ) write(iulog,*) 'initializing this%leafc_patch with atmospheric c14 value'
- do i = bounds%begp,bounds%endp
- if (this%leafc_patch(i) /= spval .and. &
- .not. isnan(this%leafc_patch(i)) ) then
- this%leafc_patch(i) = c12_cnveg_carbonstate_inst%leafc_patch(i) * c14ratio
- endif
- end do
- end if
-
- call restartvar(ncid=ncid, flag=flag, varname='leafc_storage_14', xtype=ncd_double, &
- dim1name='pft', long_name='', units='', &
- interpinic_flag='interp', readvar=readvar, data=this%leafc_storage_patch)
- if (flag=='read' .and. .not. readvar) then
- if ( masterproc ) write(iulog,*) 'initializing this%leafc_storage_patch with atmospheric c14 value'
- do i = bounds%begp,bounds%endp
- if (this%leafc_storage_patch(i) /= spval .and. &
- .not. isnan(this%leafc_storage_patch(i)) ) then
- this%leafc_storage_patch(i) = c12_cnveg_carbonstate_inst%leafc_storage_patch(i) * c14ratio
- endif
- end do
- end if
-
- call restartvar(ncid=ncid, flag=flag, varname='leafc_xfer_14', xtype=ncd_double, &
- dim1name='pft', long_name='', units='', &
- interpinic_flag='interp', readvar=readvar, data=this%leafc_xfer_patch)
- if (flag=='read' .and. .not. readvar) then
- if ( masterproc ) write(iulog,*) 'initializing this%leafc_xfer_patch with atmospheric c14 value'
- do i = bounds%begp,bounds%endp
- if (this%leafc_xfer_patch(i) /= spval .and. .not. isnan(this%leafc_xfer_patch(i)) ) then
- this%leafc_xfer_patch(i) = c12_cnveg_carbonstate_inst%leafc_xfer_patch(i) * c14ratio
- endif
- end do
- end if
-
- call restartvar(ncid=ncid, flag=flag, varname='frootc_14', xtype=ncd_double, &
- dim1name='pft', long_name='', units='', &
- interpinic_flag='interp', readvar=readvar, data=this%frootc_patch)
- if (flag=='read' .and. .not. readvar) then
- if ( masterproc ) write(iulog,*) 'initializing this%frootc_patch with atmospheric c14 value'
- do i = bounds%begp,bounds%endp
- if (this%frootc_patch(i) /= spval .and. &
- .not. isnan(this%frootc_patch(i)) ) then
- this%frootc_patch(i) = c12_cnveg_carbonstate_inst%frootc_patch(i) * c14ratio
- endif
- end do
- end if
-
- call restartvar(ncid=ncid, flag=flag, varname='frootc_storage_14', xtype=ncd_double, &
- dim1name='pft', long_name='', units='', &
- interpinic_flag='interp', readvar=readvar, data=this%frootc_storage_patch)
- if (flag=='read' .and. .not. readvar) then
- if ( masterproc ) write(iulog,*) 'initializing this%frootc_storage_patch with atmospheric c14 value'
- do i = bounds%begp,bounds%endp
- if (this%frootc_storage_patch(i) /= spval .and. &
- .not. isnan(this%frootc_storage_patch(i)) ) then
- this%frootc_storage_patch(i) = c12_cnveg_carbonstate_inst%frootc_storage_patch(i) * c14ratio
- endif
- end do
- end if
-
- call restartvar(ncid=ncid, flag=flag, varname='frootc_xfer_14', xtype=ncd_double, &
- dim1name='pft', long_name='', units='', &
- interpinic_flag='interp', readvar=readvar, data=this%frootc_xfer_patch)
- if (flag=='read' .and. .not. readvar) then
- if ( masterproc ) write(iulog,*) 'initializing this%frootc_xfer_patch with atmospheric c14 value'
- do i = bounds%begp,bounds%endp
- if (this%frootc_xfer_patch(i) /= spval .and. &
- .not. isnan(this%frootc_xfer_patch(i)) ) then
- this%frootc_xfer_patch(i) = c12_cnveg_carbonstate_inst%frootc_xfer_patch(i) * c14ratio
- endif
- end do
- end if
-
- call restartvar(ncid=ncid, flag=flag, varname='livestemc_14', xtype=ncd_double, &
- dim1name='pft', long_name='', units='', &
- interpinic_flag='interp', readvar=readvar, data=this%livestemc_patch)
- if (flag=='read' .and. .not. readvar) then
- if ( masterproc ) write(iulog,*) 'initializing this%livestemc_patch with atmospheric c14 value'
- do i = bounds%begp,bounds%endp
- if (this%livestemc_patch(i) /= spval .and. .not. isnan(this%livestemc_patch(i)) ) then
- this%livestemc_patch(i) = c12_cnveg_carbonstate_inst%livestemc_patch(i) * c14ratio
- endif
- end do
- end if
-
- call restartvar(ncid=ncid, flag=flag, varname='livestemc_storage_14', xtype=ncd_double, &
- dim1name='pft', long_name='', units='', &
- interpinic_flag='interp', readvar=readvar, data=this%livestemc_storage_patch)
- if (flag=='read' .and. .not. readvar) then
- if ( masterproc ) write(iulog,*) 'initializing this%livestemc_storage_patch with atmospheric c14 value'
- do i = bounds%begp,bounds%endp
- if (this%livestemc_storage_patch(i) /= spval .and. .not. isnan(this%livestemc_storage_patch(i)) ) then
- this%livestemc_storage_patch(i) = c12_cnveg_carbonstate_inst%livestemc_storage_patch(i) * c14ratio
- endif
- end do
- end if
-
- call restartvar(ncid=ncid, flag=flag, varname='livestemc_xfer_14', xtype=ncd_double, &
- dim1name='pft', long_name='', units='', &
- interpinic_flag='interp', readvar=readvar, data=this%livestemc_xfer_patch)
- if (flag=='read' .and. .not. readvar) then
- if ( masterproc ) write(iulog,*) 'initializing this%livestemc_xfer_patch with atmospheric c14 value'
- do i = bounds%begp,bounds%endp
- if (this%livestemc_xfer_patch(i) /= spval .and. .not. isnan(this%livestemc_xfer_patch(i)) ) then
- this%livestemc_xfer_patch(i) = c12_cnveg_carbonstate_inst%livestemc_xfer_patch(i) * c14ratio
- endif
- end do
- end if
-
- call restartvar(ncid=ncid, flag=flag, varname='deadstemc_14', xtype=ncd_double, &
- dim1name='pft', long_name='', units='', &
- interpinic_flag='interp', readvar=readvar, data=this%deadstemc_patch)
- if (flag=='read' .and. .not. readvar) then
- if ( masterproc ) write(iulog,*) 'initializing this%deadstemc_patch with atmospheric c14 value'
- do i = bounds%begp,bounds%endp
- if (this%deadstemc_patch(i) /= spval .and. .not. isnan(this%deadstemc_patch(i)) ) then
- this%deadstemc_patch(i) = c12_cnveg_carbonstate_inst%deadstemc_patch(i) * c14ratio
- endif
- end do
- end if
-
- call restartvar(ncid=ncid, flag=flag, varname='deadstemc_storage_14', xtype=ncd_double, &
- dim1name='pft', long_name='', units='', &
- interpinic_flag='interp', readvar=readvar, data=this%deadstemc_storage_patch)
- if (flag=='read' .and. .not. readvar) then
- if ( masterproc ) write(iulog,*) 'initializing this%deadstemc_storage_patch with atmospheric c14 value'
- do i = bounds%begp,bounds%endp
- if (this%deadstemc_storage_patch(i) /= spval .and. .not. isnan(this%deadstemc_storage_patch(i)) ) then
- this%deadstemc_storage_patch(i) = c12_cnveg_carbonstate_inst%deadstemc_storage_patch(i) * c14ratio
- endif
- end do
- end if
-
- call restartvar(ncid=ncid, flag=flag, varname='deadstemc_xfer_14', xtype=ncd_double, &
- dim1name='pft', long_name='', units='', &
- interpinic_flag='interp', readvar=readvar, data=this%deadstemc_xfer_patch)
- if (flag=='read' .and. .not. readvar) then
- if ( masterproc ) write(iulog,*) 'initializing this%deadstemc_xfer_patch with atmospheric c14 value'
- do i = bounds%begp,bounds%endp
- if (this%deadstemc_xfer_patch(i) /= spval .and. .not. isnan(this%deadstemc_xfer_patch(i)) ) then
- this%deadstemc_xfer_patch(i) = c12_cnveg_carbonstate_inst%deadstemc_xfer_patch(i) * c14ratio
- endif
- end do
- end if
-
- call restartvar(ncid=ncid, flag=flag, varname='livecrootc_14', xtype=ncd_double, &
- dim1name='pft', long_name='', units='', &
- interpinic_flag='interp', readvar=readvar, data=this%livecrootc_patch)
- if (flag=='read' .and. .not. readvar) then
- if ( masterproc ) write(iulog,*) 'initializing this%livecrootc_patch with atmospheric c14 value'
- do i = bounds%begp,bounds%endp
- if (this%livecrootc_patch(i) /= spval .and. .not. isnan(this%livecrootc_patch(i)) ) then
- this%livecrootc_patch(i) = c12_cnveg_carbonstate_inst%livecrootc_patch(i) * c14ratio
- endif
- end do
- end if
-
- call restartvar(ncid=ncid, flag=flag, varname='livecrootc_storage_14', xtype=ncd_double, &
- dim1name='pft', long_name='', units='', &
- interpinic_flag='interp', readvar=readvar, data=this%livecrootc_storage_patch)
- if (flag=='read' .and. .not. readvar) then
- if ( masterproc ) write(iulog,*) 'initializing this%livecrootc_storage_patch with atmospheric c14 value'
- do i = bounds%begp,bounds%endp
- if (this%livecrootc_storage_patch(i) /= spval .and. .not. isnan(this%livecrootc_storage_patch(i)) ) then
- this%livecrootc_storage_patch(i) = c12_cnveg_carbonstate_inst%livecrootc_storage_patch(i) * c14ratio
- endif
- end do
- end if
-
- call restartvar(ncid=ncid, flag=flag, varname='livecrootc_xfer_14', xtype=ncd_double, &
- dim1name='pft', long_name='', units='', &
- interpinic_flag='interp', readvar=readvar, data=this%livecrootc_xfer_patch)
- if (flag=='read' .and. .not. readvar) then
- if ( masterproc ) write(iulog,*) 'initializing this%livecrootc_xfer_patch with atmospheric c14 value'
- do i = bounds%begp,bounds%endp
- if (this%livecrootc_xfer_patch(i) /= spval .and. .not. isnan(this%livecrootc_xfer_patch(i)) ) then
- this%livecrootc_xfer_patch(i) = c12_cnveg_carbonstate_inst%livecrootc_xfer_patch(i) * c14ratio
- endif
- end do
- end if
-
- call restartvar(ncid=ncid, flag=flag, varname='deadcrootc_14', xtype=ncd_double, &
- dim1name='pft', long_name='', units='', &
- interpinic_flag='interp', readvar=readvar, data=this%deadcrootc_patch)
- if (flag=='read' .and. .not. readvar) then
- if ( masterproc ) write(iulog,*) 'initializing this%deadcrootc_patch with atmospheric c14 value'
- do i = bounds%begp,bounds%endp
- if (this%deadcrootc_patch(i) /= spval .and. .not. isnan(this%deadcrootc_patch(i)) ) then
- this%deadcrootc_patch(i) = c12_cnveg_carbonstate_inst%deadcrootc_patch(i) * c14ratio
- endif
- end do
- end if
-
- call restartvar(ncid=ncid, flag=flag, varname='deadcrootc_storage_14', xtype=ncd_double, &
- dim1name='pft', long_name='', units='', &
- interpinic_flag='interp', readvar=readvar, data=this%deadcrootc_storage_patch)
- if (flag=='read' .and. .not. readvar) then
- if ( masterproc ) write(iulog,*) 'initializing this%deadcrootc_storage_patch with atmospheric c14 value'
- do i = bounds%begp,bounds%endp
- if (this%deadcrootc_storage_patch(i) /= spval .and. .not. isnan(this%deadcrootc_storage_patch(i)) ) then
- this%deadcrootc_storage_patch(i) = c12_cnveg_carbonstate_inst%deadcrootc_storage_patch(i) * c14ratio
- endif
- end do
- end if
-
- call restartvar(ncid=ncid, flag=flag, varname='deadcrootc_xfer_14', xtype=ncd_double, &
- dim1name='pft', long_name='', units='', &
- interpinic_flag='interp', readvar=readvar, data=this%deadcrootc_xfer_patch)
- if (flag=='read' .and. .not. readvar) then
- if ( masterproc ) write(iulog,*) 'initializing this%deadcrootc_xfer_patch with atmospheric c14 value'
- do i = bounds%begp,bounds%endp
- if (this%deadcrootc_xfer_patch(i) /= spval .and. .not. isnan(this%deadcrootc_xfer_patch(i)) ) then
- this%deadcrootc_xfer_patch(i) = c12_cnveg_carbonstate_inst%deadcrootc_xfer_patch(i) * c14ratio
- endif
- end do
- end if
-
- call restartvar(ncid=ncid, flag=flag, varname='gresp_storage_14', xtype=ncd_double, &
- dim1name='pft', long_name='', units='', &
- interpinic_flag='interp', readvar=readvar, data=this%gresp_storage_patch)
- if (flag=='read' .and. .not. readvar) then
- if ( masterproc ) write(iulog,*) 'initializing this%gresp_storage_patch with atmospheric c14 value'
- do i = bounds%begp,bounds%endp
- if (this%gresp_storage_patch(i) /= spval .and. .not. isnan(this%gresp_storage_patch(i)) ) then
- this%gresp_storage_patch(i) = c12_cnveg_carbonstate_inst%gresp_storage_patch(i) * c14ratio
- endif
- end do
- end if
-
- call restartvar(ncid=ncid, flag=flag, varname='gresp_xfer_14', xtype=ncd_double, &
- dim1name='pft', long_name='', units='', &
- interpinic_flag='interp', readvar=readvar, data=this%gresp_xfer_patch)
- if (flag=='read' .and. .not. readvar) then
- if ( masterproc ) write(iulog,*) 'initializing this%gresp_xfer_patch with atmospheric c14 value'
- do i = bounds%begp,bounds%endp
- if (this%gresp_xfer_patch(i) /= spval .and. .not. isnan(this%gresp_xfer_patch(i)) ) then
- this%gresp_xfer_patch(i) = c12_cnveg_carbonstate_inst%gresp_xfer_patch(i) * c14ratio
- endif
- end do
- end if
-
- call restartvar(ncid=ncid, flag=flag, varname='cpool_14', xtype=ncd_double, &
- dim1name='pft', long_name='', units='', &
- interpinic_flag='interp', readvar=readvar, data=this%cpool_patch)
- if (flag=='read' .and. .not. readvar) then
- if ( masterproc ) write(iulog,*) 'initializing this%cpool_patch with atmospheric c14 value'
- do i = bounds%begp,bounds%endp
- if (this%cpool_patch(i) /= spval .and. .not. isnan(this%cpool_patch(i)) ) then
- this%cpool_patch(i) = c12_cnveg_carbonstate_inst%cpool_patch(i) * c14ratio
- endif
- end do
- end if
-
- call restartvar(ncid=ncid, flag=flag, varname='xsmrpool_14', xtype=ncd_double, &
- dim1name='pft', long_name='', units='', &
- interpinic_flag='interp', readvar=readvar, data=this%xsmrpool_patch)
- if (flag=='read' .and. .not. readvar) then
- if ( masterproc ) write(iulog,*) 'initializing this%xsmrpool_patch with atmospheric c14 value'
- do i = bounds%begp,bounds%endp
- if (this%xsmrpool_patch(i) /= spval .and. .not. isnan(this%xsmrpool_patch(i)) ) then
- this%xsmrpool_patch(i) = c12_cnveg_carbonstate_inst%xsmrpool_patch(i) * c14ratio
- endif
- end do
- end if
-
- call restartvar(ncid=ncid, flag=flag, varname='pft_ctrunc_14', xtype=ncd_double, &
- dim1name='pft', long_name='', units='', &
- interpinic_flag='interp', readvar=readvar, data=this%ctrunc_patch)
- if (flag=='read' .and. .not. readvar) then
- if ( masterproc ) write(iulog,*) 'initializing this%ctrunc_patch with atmospheric c14 value'
- do i = bounds%begp,bounds%endp
- if (this%ctrunc_patch(i) /= spval .and. .not. isnan(this%ctrunc_patch(i)) ) then
- this%ctrunc_patch(i) = c12_cnveg_carbonstate_inst%ctrunc_patch(i) * c14ratio
- endif
- end do
- end if
-
- end if
-
- !--------------------------------
- ! patch prognostic crop variables
- !--------------------------------
-
- if (use_crop) then
- if (carbon_type == 'c12') then
- call restartvar(ncid=ncid, flag=flag, varname='grainc', xtype=ncd_double, &
- dim1name='pft', long_name='grain C', units='gC/m2', &
- interpinic_flag='interp', readvar=readvar, data=this%grainc_patch)
-
- call restartvar(ncid=ncid, flag=flag, varname='grainc_storage', xtype=ncd_double, &
- dim1name='pft', long_name='grain C storage', units='gC/m2', &
- interpinic_flag='interp', readvar=readvar, data=this%grainc_storage_patch)
-
- call restartvar(ncid=ncid, flag=flag, varname='grainc_xfer', xtype=ncd_double, &
- dim1name='pft', long_name='grain C transfer', units='gC/m2', &
- interpinic_flag='interp', readvar=readvar, data=this%grainc_xfer_patch)
-
- call restartvar(ncid=ncid, flag=flag, varname='cropseedc_deficit', xtype=ncd_double, &
- dim1name='pft', long_name='pool for seeding new crop growth', units='gC/m2', &
- interpinic_flag='interp', readvar=readvar, data=this%cropseedc_deficit_patch)
- end if
-
- if (carbon_type == 'c13') then
- call restartvar(ncid=ncid, flag=flag, varname='grainc_13', xtype=ncd_double, &
- dim1name='pft', long_name='c13 grain C', units='gC13/m2', &
- interpinic_flag='interp', readvar=readvar, data=this%grainc_patch)
- if (flag=='read' .and. .not. readvar) then
- call set_missing_from_template( &
- my_var = this%grainc_patch, &
- template_var = c12_cnveg_carbonstate_inst%grainc_patch, &
- multiplier = c3_r2)
- end if
-
- call restartvar(ncid=ncid, flag=flag, varname='grainc_13_storage', xtype=ncd_double, &
- dim1name='pft', long_name='c13 grain C storage', units='gC13/m2', &
- interpinic_flag='interp', readvar=readvar, data=this%grainc_storage_patch)
- if (flag=='read' .and. .not. readvar) then
- call set_missing_from_template( &
- my_var = this%grainc_storage_patch, &
- template_var = c12_cnveg_carbonstate_inst%grainc_storage_patch, &
- multiplier = c3_r2)
- end if
-
- call restartvar(ncid=ncid, flag=flag, varname='grainc_13_xfer', xtype=ncd_double, &
- dim1name='pft', long_name='c13 grain C transfer', units='gC13/m2', &
- interpinic_flag='interp', readvar=readvar, data=this%grainc_xfer_patch)
- if (flag=='read' .and. .not. readvar) then
- call set_missing_from_template( &
- my_var = this%grainc_xfer_patch, &
- template_var = c12_cnveg_carbonstate_inst%grainc_xfer_patch, &
- multiplier = c3_r2)
- end if
-
- call restartvar(ncid=ncid, flag=flag, varname='cropseedc_13_deficit', xtype=ncd_double, &
- dim1name='pft', long_name='pool for seeding new crop growth', units='gC13/m2', &
- interpinic_flag='interp', readvar=readvar, data=this%cropseedc_deficit_patch)
- if (flag=='read' .and. .not. readvar) then
- call set_missing_from_template( &
- my_var = this%cropseedc_deficit_patch, &
- template_var = c12_cnveg_carbonstate_inst%cropseedc_deficit_patch, &
- multiplier = c3_r2)
- end if
- end if
-
- if ( carbon_type == 'c14' ) then
-
- call restartvar(ncid=ncid, flag=flag, varname='grainc_14', xtype=ncd_double, &
- dim1name='pft', long_name='c14 grain C', units='gC14/m2', &
- interpinic_flag='interp', readvar=readvar, data=this%grainc_patch)
- if (flag=='read' .and. .not. readvar) then
- call set_missing_from_template( &
- my_var = this%grainc_patch, &
- template_var = c12_cnveg_carbonstate_inst%grainc_patch, &
- multiplier = c3_r2)
- end if
-
- call restartvar(ncid=ncid, flag=flag, varname='grainc_14_storage', xtype=ncd_double, &
- dim1name='pft', long_name='c14 grain C storage', units='gC14/m2', &
- interpinic_flag='interp', readvar=readvar, data=this%grainc_storage_patch)
- if (flag=='read' .and. .not. readvar) then
- call set_missing_from_template( &
- my_var = this%grainc_storage_patch, &
- template_var = c12_cnveg_carbonstate_inst%grainc_storage_patch, &
- multiplier = c3_r2)
- end if
-
- call restartvar(ncid=ncid, flag=flag, varname='grainc_14_xfer', xtype=ncd_double, &
- dim1name='pft', long_name='c14 grain C transfer', units='gC14/m2', &
- interpinic_flag='interp', readvar=readvar, data=this%grainc_xfer_patch)
- if (flag=='read' .and. .not. readvar) then
- call set_missing_from_template( &
- my_var = this%grainc_xfer_patch, &
- template_var = c12_cnveg_carbonstate_inst%grainc_xfer_patch, &
- multiplier = c3_r2)
- end if
-
- call restartvar(ncid=ncid, flag=flag, varname='cropseedc_14_deficit', xtype=ncd_double, &
- dim1name='pft', long_name='pool for seeding new crop growth', units='gC14/m2', &
- interpinic_flag='interp', readvar=readvar, data=this%cropseedc_deficit_patch)
- if (flag=='read' .and. .not. readvar) then
- if ( masterproc ) write(iulog,*) 'initializing this%cropseedc_deficit_patch with atmospheric c14 value'
- call set_missing_from_template( &
- my_var = this%cropseedc_deficit_patch, &
- template_var = c12_cnveg_carbonstate_inst%cropseedc_deficit_patch, &
- multiplier = c14ratio)
- end if
- end if
- end if
-
- !--------------------------------
- ! gridcell carbon state variables
- !--------------------------------
-
- if (carbon_type == 'c12') then
- ! BACKWARDS_COMPATIBILITY(wjs, 2017-01-12) Naming this with a _g suffix in order
- ! to distinguish it from the old column-level seedc restart variable
- call restartvar(ncid=ncid, flag=flag, varname='seedc_g', xtype=ncd_double, &
- dim1name='gridcell', long_name='', units='', &
- interpinic_flag='interp', readvar=readvar, data=this%seedc_grc)
- end if
-
- !--------------------------------
- ! C13 gridcell carbon state variables
- !--------------------------------
-
- if (carbon_type == 'c13') then
- call restartvar(ncid=ncid, flag=flag, varname='seedc_13_g', xtype=ncd_double, &
- dim1name='gridcell', long_name='', units='', &
- interpinic_flag='interp', readvar=readvar, data=this%seedc_grc)
- if (flag=='read' .and. .not. readvar) then
- call set_missing_from_template( &
- my_var = this%seedc_grc, &
- template_var = c12_cnveg_carbonstate_inst%seedc_grc, &
- multiplier = c3_r2)
- end if
- end if
-
- !--------------------------------
- ! C14 column carbon state variables
- !--------------------------------
-
- if ( carbon_type == 'c14' ) then
- call restartvar(ncid=ncid, flag=flag, varname='seedc_14_g', xtype=ncd_double, &
- dim1name='gridcell', &
- long_name='', units='', &
- interpinic_flag='interp', readvar=readvar, data=this%seedc_grc)
- if (flag=='read' .and. .not. readvar) then
- if ( masterproc ) write(iulog,*) 'initializing this%seedc_grc with atmospheric c14 value'
- call set_missing_from_template( &
- my_var = this%seedc_grc, &
- template_var = c12_cnveg_carbonstate_inst%seedc_grc, &
- multiplier = c14ratio)
- end if
- end if
-
- end subroutine Restart
-
- !-----------------------------------------------------------------------
- subroutine SetValues ( this, &
- num_patch, filter_patch, value_patch, &
- num_column, filter_column, value_column)
- !
- ! !DESCRIPTION:
- ! Set carbon state variables
- !
- ! !ARGUMENTS:
- class (cnveg_carbonstate_type) :: this
- integer , intent(in) :: num_patch
- integer , intent(in) :: filter_patch(:)
- real(r8), intent(in) :: value_patch
- integer , intent(in) :: num_column
- integer , intent(in) :: filter_column(:)
- real(r8), intent(in) :: value_column
- !
- ! !LOCAL VARIABLES:
- integer :: fi,i,j,k,l ! loop index
- !------------------------------------------------------------------------
-
- do fi = 1,num_patch
- i = filter_patch(fi)
- this%leafc_patch(i) = value_patch
- this%leafc_storage_patch(i) = value_patch
- this%leafc_xfer_patch(i) = value_patch
- this%leafc_storage_xfer_acc_patch(i) = value_patch
- this%storage_cdemand_patch(i) = value_patch
- this%frootc_patch(i) = value_patch
- this%frootc_storage_patch(i) = value_patch
- this%frootc_xfer_patch(i) = value_patch
- this%livestemc_patch(i) = value_patch
- this%livestemc_storage_patch(i) = value_patch
- this%livestemc_xfer_patch(i) = value_patch
- this%deadstemc_patch(i) = value_patch
- this%deadstemc_storage_patch(i) = value_patch
- this%deadstemc_xfer_patch(i) = value_patch
- this%livecrootc_patch(i) = value_patch
- this%livecrootc_storage_patch(i) = value_patch
- this%livecrootc_xfer_patch(i) = value_patch
- this%deadcrootc_patch(i) = value_patch
- this%deadcrootc_storage_patch(i) = value_patch
- this%deadcrootc_xfer_patch(i) = value_patch
- this%gresp_storage_patch(i) = value_patch
- this%gresp_xfer_patch(i) = value_patch
- this%cpool_patch(i) = value_patch
- this%xsmrpool_patch(i) = value_patch
- this%ctrunc_patch(i) = value_patch
- this%dispvegc_patch(i) = value_patch
- this%storvegc_patch(i) = value_patch
- this%woodc_patch(i) = value_patch
- this%totvegc_patch(i) = value_patch
- this%totc_patch(i) = value_patch
- if ( use_crop ) then
- this%grainc_patch(i) = value_patch
- this%grainc_storage_patch(i) = value_patch
- this%grainc_xfer_patch(i) = value_patch
- this%cropseedc_deficit_patch(i) = value_patch
- end if
- end do
-
- do fi = 1,num_column
- i = filter_column(fi)
- this%rootc_col(i) = value_column
- this%leafc_col(i) = value_column
- this%deadstemc_col(i) = value_column
- this%fuelc_col(i) = value_column
- this%fuelc_crop_col(i) = value_column
- this%totvegc_col(i) = value_column
- this%totc_p2c_col(i) = value_column
- this%totc_col(i) = value_column
- this%totecosysc_col(i) = value_column
- end do
-
- end subroutine SetValues
-
-end module CNVegCarbonStateType
diff --git a/src/biogeochem/CNVegComputeSeedMod.F90 b/src/biogeochem/CNVegComputeSeedMod.F90
deleted file mode 100644
index 01cf471e..00000000
--- a/src/biogeochem/CNVegComputeSeedMod.F90
+++ /dev/null
@@ -1,259 +0,0 @@
-module CNVegComputeSeedMod
-
- !-----------------------------------------------------------------------
- ! Module to compute seed amounts for new patch areas
- !
- ! !USES:
-#include "shr_assert.h"
-
- use shr_kind_mod , only : r8 => shr_kind_r8
- use shr_log_mod , only : errMsg => shr_log_errMsg
- use decompMod , only : bounds_type
- use pftconMod , only : pftcon, noveg
- use clm_varcon , only : c3_r2, c4_r2, c14ratio
- use clm_varctl , only : iulog
- use PatchType , only : patch
- use abortutils , only : endrun
- use CNSpeciesMod , only : CN_SPECIES_C12, CN_SPECIES_C13, CN_SPECIES_C14, CN_SPECIES_N
- !
- ! !PUBLIC ROUTINES:
- implicit none
- private
-
- public :: ComputeSeedAmounts
-
- ! !PRIVATE ROUTINES:
-
- private :: SpeciesTypeMultiplier
- private :: LeafProportions ! compute leaf proportions (leaf, storage and xfer)
-
- ! !PRIVATE DATA:
-
- integer, parameter :: COMPONENT_LEAF = 1
- integer, parameter :: COMPONENT_DEADWOOD = 2
-
- character(len=*), parameter, private :: sourcefile = &
- __FILE__
-
-contains
-
- !-----------------------------------------------------------------------
- subroutine ComputeSeedAmounts(bounds, &
- num_soilp_with_inactive, filter_soilp_with_inactive, &
- species, &
- leafc_seed, deadstemc_seed, &
- leaf_patch, leaf_storage_patch, leaf_xfer_patch, &
- compute_here_patch, ignore_current_state_patch, &
- seed_leaf_patch, seed_leaf_storage_patch, seed_leaf_xfer_patch, &
- seed_deadstem_patch)
- !
- ! !DESCRIPTION:
- ! Compute seed amounts for patches that increase in area, for various variables, for
- ! the given species (c12, c13, c14 or n).
- !
- ! The output variables are only set for patches inside the filter, where
- ! compute_here_patch is true; for other patches, they remain at their original values.
- !
- ! Note that, regardless of the species, leafc_seed and deadstemc_seed are specified
- ! in terms of gC/m2; these amounts are converted to the amount of the given species
- ! here.
- !
- ! !USES:
- !
- ! !ARGUMENTS:
- type(bounds_type) , intent(in) :: bounds
- integer , intent(in) :: num_soilp_with_inactive ! number of points in filter
- integer , intent(in) :: filter_soilp_with_inactive(:) ! soil patch filter that includes inactive points
- integer , intent(in) :: species ! which C/N species we're operating on; should be one of the values in CNSpeciesMod
- real(r8) , intent(in) :: leafc_seed ! seed amount for leaf C
- real(r8) , intent(in) :: deadstemc_seed ! seed amount for deadstem C
- real(r8) , intent(in) :: leaf_patch( bounds%begp: ) ! current leaf C or N content (g/m2)
- real(r8) , intent(in) :: leaf_storage_patch( bounds%begp: ) ! current leaf C or N storage content (g/m2)
- real(r8) , intent(in) :: leaf_xfer_patch( bounds%begp: ) ! current leaf C or N xfer content (g/m2)
-
- ! whether to compute outputs for each patch
- logical, intent(in) :: compute_here_patch( bounds%begp: )
-
- ! If ignore_current_state is true, then use default leaf proportions rather than
- ! proportions based on current state.
- logical, intent(in) :: ignore_current_state_patch( bounds%begp: )
-
- real(r8), intent(inout) :: seed_leaf_patch( bounds%begp: ) ! seed amount for leaf itself for this species (g/m2)
- real(r8), intent(inout) :: seed_leaf_storage_patch( bounds%begp: ) ! seed amount for leaf storage for this species (g/m2)
- real(r8), intent(inout) :: seed_leaf_xfer_patch( bounds%begp: ) ! seed amount for leaf xfer for this species (g/m2)
- real(r8), intent(inout) :: seed_deadstem_patch( bounds%begp: ) ! seed amount for deadstem for this species (g/m2)
- !
- ! !LOCAL VARIABLES:
- integer :: fp, p
- integer :: begp, endp
- real(r8) :: my_leaf_seed
- real(r8) :: my_deadstem_seed
- integer :: pft_type
- real(r8) :: pleaf
- real(r8) :: pstor
- real(r8) :: pxfer
-
- character(len=*), parameter :: subname = 'ComputeSeedAmounts'
- !-----------------------------------------------------------------------
-
- begp = bounds%begp
- endp = bounds%endp
-
- SHR_ASSERT_ALL((ubound(leaf_patch) == (/endp/)), errMsg(sourcefile, __LINE__))
- SHR_ASSERT_ALL((ubound(leaf_storage_patch) == (/endp/)), errMsg(sourcefile, __LINE__))
- SHR_ASSERT_ALL((ubound(leaf_xfer_patch) == (/endp/)), errMsg(sourcefile, __LINE__))
- SHR_ASSERT_ALL((ubound(compute_here_patch) == (/endp/)), errMsg(sourcefile, __LINE__))
- SHR_ASSERT_ALL((ubound(ignore_current_state_patch) == (/endp/)), errMsg(sourcefile, __LINE__))
- SHR_ASSERT_ALL((ubound(seed_leaf_patch) == (/endp/)), errMsg(sourcefile, __LINE__))
- SHR_ASSERT_ALL((ubound(seed_leaf_storage_patch) == (/endp/)), errMsg(sourcefile, __LINE__))
- SHR_ASSERT_ALL((ubound(seed_leaf_xfer_patch) == (/endp/)), errMsg(sourcefile, __LINE__))
- SHR_ASSERT_ALL((ubound(seed_deadstem_patch) == (/endp/)), errMsg(sourcefile, __LINE__))
-
-
- do fp = 1, num_soilp_with_inactive
- p = filter_soilp_with_inactive(fp)
-
- if (compute_here_patch(p)) then
-
- my_leaf_seed = 0._r8
- my_deadstem_seed = 0._r8
-
- pft_type = patch%itype(p)
-
- call LeafProportions( &
- ignore_current_state = ignore_current_state_patch(p), &
- pft_type = pft_type, &
- leaf = leaf_patch(p), &
- leaf_storage = leaf_storage_patch(p), &
- leaf_xfer = leaf_xfer_patch(p), &
- pleaf = pleaf, &
- pstorage = pstor, &
- pxfer = pxfer)
-
- if (pft_type /= noveg) then
- my_leaf_seed = leafc_seed * &
- SpeciesTypeMultiplier(species, pft_type, COMPONENT_LEAF)
- if (pftcon%woody(pft_type) == 1._r8) then
- my_deadstem_seed = deadstemc_seed * &
- SpeciesTypeMultiplier(species, pft_type, COMPONENT_DEADWOOD)
- end if
- end if
-
- seed_leaf_patch(p) = my_leaf_seed * pleaf
- seed_leaf_storage_patch(p) = my_leaf_seed * pstor
- seed_leaf_xfer_patch(p) = my_leaf_seed * pxfer
- seed_deadstem_patch(p) = my_deadstem_seed
- end if
-
- end do
-
- end subroutine ComputeSeedAmounts
-
-
- !-----------------------------------------------------------------------
- function SpeciesTypeMultiplier(species, pft_type, component) result(multiplier)
- !
- ! !DESCRIPTION:
- ! Returns a multiplier based on the species type. This multiplier is
- ! meant to be applied to some state variable expressed in terms of g C, translating
- ! this value into an appropriate value for c13, c14 or n.
- !
- ! !USES:
- !
- ! !ARGUMENTS:
- real(r8) :: multiplier ! function result
- integer, intent(in) :: species ! which C/N species we're operating on; should be one of the values in CNSpeciesMod
- integer, intent(in) :: pft_type
- integer, intent(in) :: component ! which plant component; should be one of the COMPONENT_* parameters defined in this module
- !
- ! !LOCAL VARIABLES:
-
- character(len=*), parameter :: subname = 'SpeciesTypeMultiplier'
- !-----------------------------------------------------------------------
-
- select case (species)
- case (CN_SPECIES_C12)
- multiplier = 1._r8
-
- case (CN_SPECIES_C13)
- if (pftcon%c3psn(pft_type) == 1._r8) then
- multiplier = c3_r2
- else
- multiplier = c4_r2
- end if
-
- case (CN_SPECIES_C14)
- ! 14c state is initialized assuming initial "modern" 14C of 1.e-12
- multiplier = c14ratio
-
- case (CN_SPECIES_N)
- select case (component)
- case (COMPONENT_LEAF)
- multiplier = 1._r8 / pftcon%leafcn(pft_type)
- case (COMPONENT_DEADWOOD)
- multiplier = 1._r8 / pftcon%deadwdcn(pft_type)
- case default
- write(iulog,*) subname//' ERROR: unknown component: ', component
- call endrun(subname//': unknown component')
- end select
-
- case default
- write(iulog,*) subname//' ERROR: unknown species: ', species
- call endrun(subname//': unknown species')
- end select
-
- end function SpeciesTypeMultiplier
-
-
- !-----------------------------------------------------------------------
- subroutine LeafProportions(ignore_current_state, &
- pft_type, &
- leaf, leaf_storage, leaf_xfer, &
- pleaf, pstorage, pxfer)
- !
- ! !DESCRIPTION:
- ! Compute leaf proportions (leaf, storage and xfer)
- !
- ! If ignore_current_state is true, then use default proportions rather than
- ! proportions based on current state. (Also use default proportions if total leaf mass
- ! is 0 for this patch.)
- !
- ! !USES:
- !
- ! !ARGUMENTS:
- logical, intent(in) :: ignore_current_state ! see comment above
- integer , intent(in) :: pft_type
- real(r8), intent(in) :: leaf ! g/m2 leaf C or N
- real(r8), intent(in) :: leaf_storage ! g/m2 leaf C or N storage
- real(r8), intent(in) :: leaf_xfer ! g/m2 leaf C or N transfer
-
- real(r8), intent(out) :: pleaf ! proportion in leaf itself
- real(r8), intent(out) :: pstorage ! proportion in leaf storage
- real(r8), intent(out) :: pxfer ! proportion in leaf xfer
- !
- ! !LOCAL VARIABLES:
- real(r8) :: tot_leaf
-
- character(len=*), parameter :: subname = 'LeafProportions'
- !-----------------------------------------------------------------------
-
- tot_leaf = leaf + leaf_storage + leaf_xfer
- pleaf = 0._r8
- pstorage = 0._r8
- pxfer = 0._r8
-
- if (tot_leaf == 0._r8 .or. ignore_current_state) then
- if (pftcon%evergreen(pft_type) == 1._r8) then
- pleaf = 1._r8
- else
- pstorage = 1._r8
- end if
- else
- pleaf = leaf/tot_leaf
- pstorage = leaf_storage/tot_leaf
- pxfer = leaf_xfer/tot_leaf
- end if
-
- end subroutine LeafProportions
-
-end module CNVegComputeSeedMod
diff --git a/src/biogeochem/CNVegNitrogenFluxType.F90 b/src/biogeochem/CNVegNitrogenFluxType.F90
deleted file mode 100644
index 65727f5c..00000000
--- a/src/biogeochem/CNVegNitrogenFluxType.F90
+++ /dev/null
@@ -1,1737 +0,0 @@
-module CNVegNitrogenFluxType
-
- use shr_kind_mod , only : r8 => shr_kind_r8
- use shr_infnan_mod , only : nan => shr_infnan_nan, assignment(=)
- use shr_log_mod , only : errMsg => shr_log_errMsg
- use clm_varpar , only : ndecomp_cascade_transitions, ndecomp_pools
- use clm_varpar , only : nlevdecomp_full, nlevdecomp
- use clm_varcon , only : spval, ispval, dzsoi_decomp
- use clm_varctl , only : use_nitrif_denitrif, use_vertsoilc, use_crop
- use CNSharedParamsMod , only : use_fun
- use decompMod , only : bounds_type
- use abortutils , only : endrun
- use SoilBiogeochemDecompCascadeConType , only : decomp_cascade_con
- use LandunitType , only : lun
- use ColumnType , only : col
- use PatchType , only : patch
- !
- ! !PUBLIC TYPES:
- implicit none
- private
- !
- type, public :: cnveg_nitrogenflux_type
-
- ! gap mortality fluxes
- real(r8), pointer :: m_leafn_to_litter_patch (:) ! patch leaf N mortality (gN/m2/s)
- real(r8), pointer :: m_frootn_to_litter_patch (:) ! patch fine root N mortality (gN/m2/s)
- real(r8), pointer :: m_leafn_storage_to_litter_patch (:) ! patch leaf N storage mortality (gN/m2/s)
- real(r8), pointer :: m_frootn_storage_to_litter_patch (:) ! patch fine root N storage mortality (gN/m2/s)
- real(r8), pointer :: m_livestemn_storage_to_litter_patch (:) ! patch live stem N storage mortality (gN/m2/s)
- real(r8), pointer :: m_deadstemn_storage_to_litter_patch (:) ! patch dead stem N storage mortality (gN/m2/s)
- real(r8), pointer :: m_livecrootn_storage_to_litter_patch (:) ! patch live coarse root N storage mortality (gN/m2/s)
- real(r8), pointer :: m_deadcrootn_storage_to_litter_patch (:) ! patch dead coarse root N storage mortality (gN/m2/s)
- real(r8), pointer :: m_leafn_xfer_to_litter_patch (:) ! patch leaf N transfer mortality (gN/m2/s)
- real(r8), pointer :: m_frootn_xfer_to_litter_patch (:) ! patch fine root N transfer mortality (gN/m2/s)
- real(r8), pointer :: m_livestemn_xfer_to_litter_patch (:) ! patch live stem N transfer mortality (gN/m2/s)
- real(r8), pointer :: m_deadstemn_xfer_to_litter_patch (:) ! patch dead stem N transfer mortality (gN/m2/s)
- real(r8), pointer :: m_livecrootn_xfer_to_litter_patch (:) ! patch live coarse root N transfer mortality (gN/m2/s)
- real(r8), pointer :: m_deadcrootn_xfer_to_litter_patch (:) ! patch dead coarse root N transfer mortality (gN/m2/s)
- real(r8), pointer :: m_livestemn_to_litter_patch (:) ! patch live stem N mortality (gN/m2/s)
- real(r8), pointer :: m_deadstemn_to_litter_patch (:) ! patch dead stem N mortality (gN/m2/s)
- real(r8), pointer :: m_livecrootn_to_litter_patch (:) ! patch live coarse root N mortality (gN/m2/s)
- real(r8), pointer :: m_deadcrootn_to_litter_patch (:) ! patch dead coarse root N mortality (gN/m2/s)
- real(r8), pointer :: m_retransn_to_litter_patch (:) ! patch retranslocated N pool mortality (gN/m2/s)
-
- ! harvest fluxes
- real(r8), pointer :: hrv_leafn_to_litter_patch (:) ! patch leaf N harvest mortality (gN/m2/s)
- real(r8), pointer :: hrv_frootn_to_litter_patch (:) ! patch fine root N harvest mortality (gN/m2/s)
- real(r8), pointer :: hrv_leafn_storage_to_litter_patch (:) ! patch leaf N storage harvest mortality (gN/m2/s)
- real(r8), pointer :: hrv_frootn_storage_to_litter_patch (:) ! patch fine root N storage harvest mortality (gN/m2/s)
- real(r8), pointer :: hrv_livestemn_storage_to_litter_patch (:) ! patch live stem N storage harvest mortality (gN/m2/s)
- real(r8), pointer :: hrv_deadstemn_storage_to_litter_patch (:) ! patch dead stem N storage harvest mortality (gN/m2/s)
- real(r8), pointer :: hrv_livecrootn_storage_to_litter_patch (:) ! patch live coarse root N storage harvest mortality (gN/m2/s)
- real(r8), pointer :: hrv_deadcrootn_storage_to_litter_patch (:) ! patch dead coarse root N storage harvest mortality (gN/m2/s)
- real(r8), pointer :: hrv_leafn_xfer_to_litter_patch (:) ! patch leaf N transfer harvest mortality (gN/m2/s)
- real(r8), pointer :: hrv_frootn_xfer_to_litter_patch (:) ! patch fine root N transfer harvest mortality (gN/m2/s)
- real(r8), pointer :: hrv_livestemn_xfer_to_litter_patch (:) ! patch live stem N transfer harvest mortality (gN/m2/s)
- real(r8), pointer :: hrv_deadstemn_xfer_to_litter_patch (:) ! patch dead stem N transfer harvest mortality (gN/m2/s)
- real(r8), pointer :: hrv_livecrootn_xfer_to_litter_patch (:) ! patch live coarse root N transfer harvest mortality (gN/m2/s)
- real(r8), pointer :: hrv_deadcrootn_xfer_to_litter_patch (:) ! patch dead coarse root N transfer harvest mortality (gN/m2/s)
- real(r8), pointer :: hrv_livestemn_to_litter_patch (:) ! patch live stem N harvest mortality (gN/m2/s)
- real(r8), pointer :: hrv_livecrootn_to_litter_patch (:) ! patch live coarse root N harvest mortality (gN/m2/s)
- real(r8), pointer :: hrv_deadcrootn_to_litter_patch (:) ! patch dead coarse root N harvest mortality (gN/m2/s)
- real(r8), pointer :: hrv_retransn_to_litter_patch (:) ! patch retranslocated N pool harvest mortality (gN/m2/s)
- real(r8), pointer :: grainn_to_cropprodn_patch (:) ! patch grain N to crop product pool (gN/m2/s)
- real(r8), pointer :: grainn_to_cropprodn_col (:) ! col grain N to crop product pool (gN/m2/s)
- real(r8), pointer :: m_n_to_litr_met_fire_col (:,:) ! col N from leaf, froot, xfer and storage N to litter labile N by fire (gN/m3/s)
- real(r8), pointer :: m_n_to_litr_cel_fire_col (:,:) ! col N from leaf, froot, xfer and storage N to litter cellulose N by fire (gN/m3/s)
- real(r8), pointer :: m_n_to_litr_lig_fire_col (:,:) ! col N from leaf, froot, xfer and storage N to litter lignin N by fire (gN/m3/s)
- real(r8), pointer :: harvest_n_to_litr_met_n_col (:,:) ! col N fluxes associated with harvest to litter metabolic pool (gN/m3/s)
- real(r8), pointer :: harvest_n_to_litr_cel_n_col (:,:) ! col N fluxes associated with harvest to litter cellulose pool (gN/m3/s)
- real(r8), pointer :: harvest_n_to_litr_lig_n_col (:,:) ! col N fluxes associated with harvest to litter lignin pool (gN/m3/s)
- real(r8), pointer :: harvest_n_to_cwdn_col (:,:) ! col N fluxes associated with harvest to CWD pool (gN/m3/s)
-
- ! fire N fluxes
- real(r8), pointer :: m_decomp_npools_to_fire_vr_col (:,:,:) ! col vertically-resolved decomposing N fire loss (gN/m3/s)
- real(r8), pointer :: m_decomp_npools_to_fire_col (:,:) ! col vertically-integrated (diagnostic) decomposing N fire loss (gN/m2/s)
- real(r8), pointer :: m_leafn_to_fire_patch (:) ! patch (gN/m2/s) fire N emissions from leafn
- real(r8), pointer :: m_leafn_storage_to_fire_patch (:) ! patch (gN/m2/s) fire N emissions from leafn_storage
- real(r8), pointer :: m_leafn_xfer_to_fire_patch (:) ! patch (gN/m2/s) fire N emissions from leafn_xfer
- real(r8), pointer :: m_livestemn_to_fire_patch (:) ! patch (gN/m2/s) fire N emissions from livestemn
- real(r8), pointer :: m_livestemn_storage_to_fire_patch (:) ! patch (gN/m2/s) fire N emissions from livestemn_storage
- real(r8), pointer :: m_livestemn_xfer_to_fire_patch (:) ! patch (gN/m2/s) fire N emissions from livestemn_xfer
- real(r8), pointer :: m_deadstemn_to_fire_patch (:) ! patch (gN/m2/s) fire N emissions from deadstemn
- real(r8), pointer :: m_deadstemn_storage_to_fire_patch (:) ! patch (gN/m2/s) fire N emissions from deadstemn_storage
- real(r8), pointer :: m_deadstemn_xfer_to_fire_patch (:) ! patch (gN/m2/s) fire N emissions from deadstemn_xfer
- real(r8), pointer :: m_frootn_to_fire_patch (:) ! patch (gN/m2/s) fire N emissions from frootn
- real(r8), pointer :: m_frootn_storage_to_fire_patch (:) ! patch (gN/m2/s) fire N emissions from frootn_storage
- real(r8), pointer :: m_frootn_xfer_to_fire_patch (:) ! patch (gN/m2/s) fire N emissions from frootn_xfer
- real(r8), pointer :: m_livecrootn_to_fire_patch (:) ! patch (gN/m2/s) fire N emissions from m_livecrootn_to_fire
- real(r8), pointer :: m_livecrootn_storage_to_fire_patch (:) ! patch (gN/m2/s) fire N emissions from livecrootn_storage
- real(r8), pointer :: m_livecrootn_xfer_to_fire_patch (:) ! patch (gN/m2/s) fire N emissions from livecrootn_xfer
- real(r8), pointer :: m_deadcrootn_to_fire_patch (:) ! patch (gN/m2/s) fire N emissions from deadcrootn
- real(r8), pointer :: m_deadcrootn_storage_to_fire_patch (:) ! patch (gN/m2/s) fire N emissions from deadcrootn_storage
- real(r8), pointer :: m_deadcrootn_xfer_to_fire_patch (:) ! patch (gN/m2/s) fire N emissions from deadcrootn_xfer
- real(r8), pointer :: m_retransn_to_fire_patch (:) ! patch (gN/m2/s) fire N emissions from retransn
- real(r8), pointer :: m_leafn_to_litter_fire_patch (:) ! patch (gN/m2/s) from leafn to litter N due to fire
- real(r8), pointer :: m_leafn_storage_to_litter_fire_patch (:) ! patch (gN/m2/s) from leafn_storage to litter N due to fire
- real(r8), pointer :: m_leafn_xfer_to_litter_fire_patch (:) ! patch (gN/m2/s) from leafn_xfer to litter N due to fire
- real(r8), pointer :: m_livestemn_to_litter_fire_patch (:) ! patch (gN/m2/s) from livestemn to litter N due to fire
- real(r8), pointer :: m_livestemn_storage_to_litter_fire_patch (:) ! patch (gN/m2/s) from livestemn_storage to litter N due to fire
- real(r8), pointer :: m_livestemn_xfer_to_litter_fire_patch (:) ! patch (gN/m2/s) from livestemn_xfer to litter N due to fire
- real(r8), pointer :: m_livestemn_to_deadstemn_fire_patch (:) ! patch (gN/m2/s) from livestemn to deadstemn N due to fire
- real(r8), pointer :: m_deadstemn_to_litter_fire_patch (:) ! patch (gN/m2/s) from deadstemn to litter N due to fire
- real(r8), pointer :: m_deadstemn_storage_to_litter_fire_patch (:) ! patch (gN/m2/s) from deadstemn_storage to litter N due to fire
- real(r8), pointer :: m_deadstemn_xfer_to_litter_fire_patch (:) ! patch (gN/m2/s) from deadstemn_xfer to litter N due to fire
- real(r8), pointer :: m_frootn_to_litter_fire_patch (:) ! patch (gN/m2/s) from frootn to litter N due to fire
- real(r8), pointer :: m_frootn_storage_to_litter_fire_patch (:) ! patch (gN/m2/s) from frootn_storage to litter N due to fire
- real(r8), pointer :: m_frootn_xfer_to_litter_fire_patch (:) ! patch (gN/m2/s) from frootn_xfer to litter N due to fire
- real(r8), pointer :: m_livecrootn_to_litter_fire_patch (:) ! patch (gN/m2/s) from livecrootn to litter N due to fire
- real(r8), pointer :: m_livecrootn_storage_to_litter_fire_patch (:) ! patch (gN/m2/s) from livecrootn_storage to litter N due to fire
- real(r8), pointer :: m_livecrootn_xfer_to_litter_fire_patch (:) ! patch (gN/m2/s) from livecrootn_xfer to litter N due to fire
- real(r8), pointer :: m_livecrootn_to_deadcrootn_fire_patch (:) ! patch (gN/m2/s) from livecrootn_xfer to deadcrootn due to fire
- real(r8), pointer :: m_deadcrootn_to_litter_fire_patch (:) ! patch (gN/m2/s) from deadcrootn to deadcrootn due to fire
- real(r8), pointer :: m_deadcrootn_storage_to_litter_fire_patch (:) ! patch (gN/m2/s) from deadcrootn_storage to deadcrootn due to fire
- real(r8), pointer :: m_deadcrootn_xfer_to_litter_fire_patch (:) ! patch (gN/m2/s) from deadcrootn_xfer to deadcrootn due to fire
- 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 patch-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_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)
-
- ! phenology fluxes from transfer pool
- real(r8), pointer :: grainn_xfer_to_grainn_patch (:) ! patch grain N growth from storage for prognostic crop model (gN/m2/s)
- real(r8), pointer :: leafn_xfer_to_leafn_patch (:) ! patch leaf N growth from storage (gN/m2/s)
- real(r8), pointer :: frootn_xfer_to_frootn_patch (:) ! patch fine root N growth from storage (gN/m2/s)
- real(r8), pointer :: livestemn_xfer_to_livestemn_patch (:) ! patch live stem N growth from storage (gN/m2/s)
- real(r8), pointer :: deadstemn_xfer_to_deadstemn_patch (:) ! patch dead stem N growth from storage (gN/m2/s)
- real(r8), pointer :: livecrootn_xfer_to_livecrootn_patch (:) ! patch live coarse root N growth from storage (gN/m2/s)
- real(r8), pointer :: deadcrootn_xfer_to_deadcrootn_patch (:) ! patch dead coarse root N growth from storage (gN/m2/s)
-
- ! litterfall fluxes
- real(r8), pointer :: livestemn_to_litter_patch (:) ! patch livestem N to litter (gN/m2/s)
- real(r8), pointer :: grainn_to_food_patch (:) ! patch grain N to food for prognostic crop (gN/m2/s)
- real(r8), pointer :: grainn_to_seed_patch (:) ! patch grain N to seed for prognostic crop (gN/m2/s)
- real(r8), pointer :: leafn_to_litter_patch (:) ! patch leaf N litterfall (gN/m2/s)
- real(r8), pointer :: leafn_to_retransn_patch (:) ! patch leaf N to retranslocated N pool (gN/m2/s)
- real(r8), pointer :: frootn_to_retransn_patch (:) ! patch fine root N to retranslocated N pool (gN/m2/s)
- real(r8), pointer :: frootn_to_litter_patch (:) ! patch fine root N litterfall (gN/m2/s)
-
- ! allocation fluxes
- real(r8), pointer :: retransn_to_npool_patch (:) ! patch deployment of retranslocated N (gN/m2/s)
- real(r8), pointer :: free_retransn_to_npool_patch (:) ! patch deployment of free retranslocated N (gN/m2/s)
- real(r8), pointer :: sminn_to_npool_patch (:) ! patch deployment of soil mineral N uptake (gN/m2/s)
- real(r8), pointer :: npool_to_grainn_patch (:) ! patch allocation to grain N for prognostic crop (gN/m2/s)
- real(r8), pointer :: npool_to_grainn_storage_patch (:) ! patch allocation to grain N storage for prognostic crop (gN/m2/s)
- real(r8), pointer :: npool_to_leafn_patch (:) ! patch allocation to leaf N (gN/m2/s)
- real(r8), pointer :: npool_to_leafn_storage_patch (:) ! patch allocation to leaf N storage (gN/m2/s)
- real(r8), pointer :: npool_to_frootn_patch (:) ! patch allocation to fine root N (gN/m2/s)
- real(r8), pointer :: npool_to_frootn_storage_patch (:) ! patch allocation to fine root N storage (gN/m2/s)
- real(r8), pointer :: npool_to_livestemn_patch (:) ! patch allocation to live stem N (gN/m2/s)
- real(r8), pointer :: npool_to_livestemn_storage_patch (:) ! patch allocation to live stem N storage (gN/m2/s)
- real(r8), pointer :: npool_to_deadstemn_patch (:) ! patch allocation to dead stem N (gN/m2/s)
- real(r8), pointer :: npool_to_deadstemn_storage_patch (:) ! patch allocation to dead stem N storage (gN/m2/s)
- real(r8), pointer :: npool_to_livecrootn_patch (:) ! patch allocation to live coarse root N (gN/m2/s)
- real(r8), pointer :: npool_to_livecrootn_storage_patch (:) ! patch allocation to live coarse root N storage (gN/m2/s)
- real(r8), pointer :: npool_to_deadcrootn_patch (:) ! patch allocation to dead coarse root N (gN/m2/s)
- real(r8), pointer :: npool_to_deadcrootn_storage_patch (:) ! patch allocation to dead coarse root N storage (gN/m2/s)
-
- ! annual turnover of storage to transfer pools
- real(r8), pointer :: grainn_storage_to_xfer_patch (:) ! patch grain N shift storage to transfer for prognostic crop (gN/m2/s)
- real(r8), pointer :: leafn_storage_to_xfer_patch (:) ! patch leaf N shift storage to transfer (gN/m2/s)
- real(r8), pointer :: frootn_storage_to_xfer_patch (:) ! patch fine root N shift storage to transfer (gN/m2/s)
- real(r8), pointer :: livestemn_storage_to_xfer_patch (:) ! patch live stem N shift storage to transfer (gN/m2/s)
- real(r8), pointer :: deadstemn_storage_to_xfer_patch (:) ! patch dead stem N shift storage to transfer (gN/m2/s)
- real(r8), pointer :: livecrootn_storage_to_xfer_patch (:) ! patch live coarse root N shift storage to transfer (gN/m2/s)
- real(r8), pointer :: deadcrootn_storage_to_xfer_patch (:) ! patch dead coarse root N shift storage to transfer (gN/m2/s)
- real(r8), pointer :: fert_patch (:) ! patch applied fertilizer (gN/m2/s)
- real(r8), pointer :: fert_counter_patch (:) ! patch >0 fertilize; <=0 not
- real(r8), pointer :: soyfixn_patch (:) ! patch soybean fixed N (gN/m2/s)
-
- ! turnover of livewood to deadwood, with retranslocation
- real(r8), pointer :: livestemn_to_deadstemn_patch (:) ! patch live stem N turnover (gN/m2/s)
- real(r8), pointer :: livestemn_to_retransn_patch (:) ! patch live stem N to retranslocated N pool (gN/m2/s)
- real(r8), pointer :: livecrootn_to_deadcrootn_patch (:) ! patch live coarse root N turnover (gN/m2/s)
- real(r8), pointer :: livecrootn_to_retransn_patch (:) ! patch live coarse root N to retranslocated N pool (gN/m2/s)
-
- ! summary (diagnostic) flux variables, not involved in mass balance
- real(r8), pointer :: ndeploy_patch (:) ! patch total N deployed to growth and storage (gN/m2/s)
- real(r8), pointer :: wood_harvestn_patch (:) ! patch total N losses to wood product pools (gN/m2/s)
- real(r8), pointer :: wood_harvestn_col (:) ! col total N losses to wood product pools (gN/m2/s) (p2c)
-
- ! phenology: litterfall and crop fluxes
- real(r8), pointer :: phenology_n_to_litr_met_n_col (:,:) ! col N fluxes associated with phenology (litterfall and crop) to litter metabolic pool (gN/m3/s)
- real(r8), pointer :: phenology_n_to_litr_cel_n_col (:,:) ! col N fluxes associated with phenology (litterfall and crop) to litter cellulose pool (gN/m3/s)
- real(r8), pointer :: phenology_n_to_litr_lig_n_col (:,:) ! col N fluxes associated with phenology (litterfall and crop) to litter lignin pool (gN/m3/s)
-
- ! gap mortality fluxes
- real(r8), pointer :: gap_mortality_n_to_litr_met_n_col (:,:) ! col N fluxes associated with gap mortality to litter metabolic pool (gN/m3/s)
- real(r8), pointer :: gap_mortality_n_to_litr_cel_n_col (:,:) ! col N fluxes associated with gap mortality to litter cellulose pool (gN/m3/s)
- real(r8), pointer :: gap_mortality_n_to_litr_lig_n_col (:,:) ! col N fluxes associated with gap mortality to litter lignin pool (gN/m3/s)
- real(r8), pointer :: gap_mortality_n_to_cwdn_col (:,:) ! col N fluxes associated with gap mortality to CWD pool (gN/m3/s)
-
- ! dynamic landcover fluxes
- real(r8), pointer :: dwt_seedn_to_leaf_patch (:) ! (gN/m2/s) seed source to patch-level; although this is a patch-level flux, it is expressed per unit GRIDCELL area
- real(r8), pointer :: dwt_seedn_to_leaf_grc (:) ! (gN/m2/s) dwt_seedn_to_leaf_patch summed to the gridcell-level
- real(r8), pointer :: dwt_seedn_to_deadstem_patch (:) ! (gN/m2/s) seed source to patch-level; although this is a patch-level flux, it is expressed per unit GRIDCELL area
- real(r8), pointer :: dwt_seedn_to_deadstem_grc (:) ! (gN/m2/s) dwt_seedn_to_deadstem_patch summed to the gridcell-level
- real(r8), pointer :: dwt_conv_nflux_patch (:) ! (gN/m2/s) conversion N flux (immediate loss to atm); although this is a patch-level flux, it is expressed per unit GRIDCELL area
- real(r8), pointer :: dwt_conv_nflux_grc (:) ! (gN/m2/s) dwt_conv_nflux_patch summed to the gridcell-level
- real(r8), pointer :: dwt_wood_productn_gain_patch (:) ! patch (gN/m2/s) addition to wood product pools from landcover change; even though this is a patch-level flux, it is expressed per unit GRIDCELL area
- real(r8), pointer :: dwt_crop_productn_gain_patch (:) ! patch (gN/m2/s) addition to crop product pool from landcover change; even though this is a patch-level flux, it is expressed per unit GRIDCELL area
- real(r8), pointer :: dwt_frootn_to_litr_met_n_col (:,:) ! col (gN/m3/s) fine root to litter due to landcover change
- real(r8), pointer :: dwt_frootn_to_litr_cel_n_col (:,:) ! col (gN/m3/s) fine root to litter due to landcover change
- real(r8), pointer :: dwt_frootn_to_litr_lig_n_col (:,:) ! col (gN/m3/s) fine root to litter due to landcover change
- real(r8), pointer :: dwt_livecrootn_to_cwdn_col (:,:) ! col (gN/m3/s) live coarse root to CWD due to landcover change
- real(r8), pointer :: dwt_deadcrootn_to_cwdn_col (:,:) ! col (gN/m3/s) dead coarse root to CWD due to landcover change
-
- ! crop fluxes
- real(r8), pointer :: crop_seedn_to_leaf_patch (:) ! patch (gN/m2/s) seed source to leaf, for crops
-
- ! Misc
- real(r8), pointer :: plant_ndemand_patch (:) ! N flux required to support initial GPP (gN/m2/s)
- real(r8), pointer :: avail_retransn_patch (:) ! N flux available from retranslocation pool (gN/m2/s)
- real(r8), pointer :: plant_nalloc_patch (:) ! total allocated N flux (gN/m2/s)
- real(r8), pointer :: plant_ndemand_retrans_patch (:) ! The N demand pool generated for FUN2.0; mainly used for deciduous trees (gN/m2/s)
- real(r8), pointer :: plant_ndemand_season_patch (:) ! The N demand pool for seasonal deciduous (gN/m2/s)
- real(r8), pointer :: plant_ndemand_stress_patch (:) ! The N demand pool for stress deciduous (gN/m2/s)
- real(r8), pointer :: Nactive_patch (:) ! N acquired by mycorrhizal uptake (gN/m2/s)
- real(r8), pointer :: Nnonmyc_patch (:) ! N acquired by non-myc uptake (gN/m2/s)
- real(r8), pointer :: Nam_patch (:) ! N acquired by AM plant (gN/m2/s)
- real(r8), pointer :: Necm_patch (:) ! N acquired by ECM plant (gN/m2/s)
- real(r8), pointer :: Nactive_no3_patch (:) ! N acquired by mycorrhizal uptake (gN/m2/s)
- real(r8), pointer :: Nactive_nh4_patch (:) ! N acquired by mycorrhizal uptake (gN/m2/s)
- real(r8), pointer :: Nnonmyc_no3_patch (:) ! N acquired by non-myc (gN/m2/s)
- real(r8), pointer :: Nnonmyc_nh4_patch (:) ! N acquired by non-myc (gN/m2/s)
- real(r8), pointer :: Nam_no3_patch (:) ! N acquired by AM plant (gN/m2/s)
- real(r8), pointer :: Nam_nh4_patch (:) ! N acquired by AM plant (gN/m2/s)
- real(r8), pointer :: Necm_no3_patch (:) ! N acquired by ECM plant (gN/m2/s)
- real(r8), pointer :: Necm_nh4_patch (:) ! N acquired by ECM plant (gN/m2/s)
- real(r8), pointer :: Nfix_patch (:) ! N acquired by Symbiotic BNF (gN/m2/s)
- real(r8), pointer :: Npassive_patch (:) ! N acquired by passive uptake (gN/m2/s)
- real(r8), pointer :: Nretrans_patch (:) ! N acquired by retranslocation (gN/m2/s)
- real(r8), pointer :: Nretrans_org_patch (:) ! N acquired by retranslocation (gN/m2/s)
- real(r8), pointer :: Nretrans_season_patch (:) ! N acquired by retranslocation (gN/m2/s)
- real(r8), pointer :: Nretrans_stress_patch (:) ! N acquired by retranslocation (gN/m2/s)
- real(r8), pointer :: Nuptake_patch (:) ! Total N uptake of FUN (gN/m2/s)
- real(r8), pointer :: sminn_to_plant_fun_patch (:) ! Total soil N uptake of FUN (gN/m2/s)
- real(r8), pointer :: sminn_to_plant_fun_vr_patch (:,:) ! Total layer soil N uptake of FUN (gN/m2/s)
- real(r8), pointer :: sminn_to_plant_fun_no3_vr_patch (:,:) ! Total layer no3 uptake of FUN (gN/m2/s)
- real(r8), pointer :: sminn_to_plant_fun_nh4_vr_patch (:,:) ! Total layer nh4 uptake of FUN (gN/m2/s)
- real(r8), pointer :: cost_nfix_patch (:) ! Average cost of fixation (gN/m2/s)
- real(r8), pointer :: cost_nactive_patch (:) ! Average cost of active uptake (gN/m2/s)
- real(r8), pointer :: cost_nretrans_patch (:) ! Average cost of retranslocation (gN/m2/s)
- real(r8), pointer :: nuptake_npp_fraction_patch (:) ! frac of npp spent on N acquisition (gN/m2/s)
-
- contains
-
- procedure , public :: Init
- procedure , public :: Restart
- procedure , public :: SetValues
- procedure , private :: InitAllocate
- procedure , private :: InitHistory
- procedure , private :: InitCold
-
- end type cnveg_nitrogenflux_type
- !------------------------------------------------------------------------
-
-contains
-
- !------------------------------------------------------------------------
- subroutine Init(this, bounds)
-
- class(cnveg_nitrogenflux_type) :: this
- type(bounds_type), intent(in) :: bounds
-
- call this%InitAllocate (bounds)
- call this%InitHistory (bounds)
- call this%InitCold (bounds)
-
- end subroutine Init
-
- !------------------------------------------------------------------------
- subroutine InitAllocate(this, bounds)
- !
- ! !DESCRIPTION:
- ! Initialize patch nitrogen flux
- !
- ! !ARGUMENTS:
- class (cnveg_nitrogenflux_type) :: this
- type(bounds_type) , intent(in) :: bounds
- !
- ! !LOCAL VARIABLES:
- integer :: begp,endp
- integer :: begc,endc
- integer :: begg,endg
- !------------------------------------------------------------------------
-
- begp = bounds%begp; endp = bounds%endp
- begc = bounds%begc; endc = bounds%endc
- begg = bounds%begg; endg = bounds%endg
-
- allocate(this%m_leafn_to_litter_patch (begp:endp)) ; this%m_leafn_to_litter_patch (:) = nan
- allocate(this%m_frootn_to_litter_patch (begp:endp)) ; this%m_frootn_to_litter_patch (:) = nan
- allocate(this%m_leafn_storage_to_litter_patch (begp:endp)) ; this%m_leafn_storage_to_litter_patch (:) = nan
- allocate(this%m_frootn_storage_to_litter_patch (begp:endp)) ; this%m_frootn_storage_to_litter_patch (:) = nan
- allocate(this%m_livestemn_storage_to_litter_patch (begp:endp)) ; this%m_livestemn_storage_to_litter_patch (:) = nan
- allocate(this%m_deadstemn_storage_to_litter_patch (begp:endp)) ; this%m_deadstemn_storage_to_litter_patch (:) = nan
- allocate(this%m_livecrootn_storage_to_litter_patch (begp:endp)) ; this%m_livecrootn_storage_to_litter_patch (:) = nan
- allocate(this%m_deadcrootn_storage_to_litter_patch (begp:endp)) ; this%m_deadcrootn_storage_to_litter_patch (:) = nan
- allocate(this%m_leafn_xfer_to_litter_patch (begp:endp)) ; this%m_leafn_xfer_to_litter_patch (:) = nan
- allocate(this%m_frootn_xfer_to_litter_patch (begp:endp)) ; this%m_frootn_xfer_to_litter_patch (:) = nan
- allocate(this%m_livestemn_xfer_to_litter_patch (begp:endp)) ; this%m_livestemn_xfer_to_litter_patch (:) = nan
- allocate(this%m_deadstemn_xfer_to_litter_patch (begp:endp)) ; this%m_deadstemn_xfer_to_litter_patch (:) = nan
- allocate(this%m_livecrootn_xfer_to_litter_patch (begp:endp)) ; this%m_livecrootn_xfer_to_litter_patch (:) = nan
- allocate(this%m_deadcrootn_xfer_to_litter_patch (begp:endp)) ; this%m_deadcrootn_xfer_to_litter_patch (:) = nan
- allocate(this%m_livestemn_to_litter_patch (begp:endp)) ; this%m_livestemn_to_litter_patch (:) = nan
- allocate(this%m_deadstemn_to_litter_patch (begp:endp)) ; this%m_deadstemn_to_litter_patch (:) = nan
- allocate(this%m_livecrootn_to_litter_patch (begp:endp)) ; this%m_livecrootn_to_litter_patch (:) = nan
- allocate(this%m_deadcrootn_to_litter_patch (begp:endp)) ; this%m_deadcrootn_to_litter_patch (:) = nan
- allocate(this%m_retransn_to_litter_patch (begp:endp)) ; this%m_retransn_to_litter_patch (:) = nan
- allocate(this%hrv_leafn_to_litter_patch (begp:endp)) ; this%hrv_leafn_to_litter_patch (:) = nan
- allocate(this%hrv_frootn_to_litter_patch (begp:endp)) ; this%hrv_frootn_to_litter_patch (:) = nan
- allocate(this%hrv_leafn_storage_to_litter_patch (begp:endp)) ; this%hrv_leafn_storage_to_litter_patch (:) = nan
- allocate(this%hrv_frootn_storage_to_litter_patch (begp:endp)) ; this%hrv_frootn_storage_to_litter_patch (:) = nan
- allocate(this%hrv_livestemn_storage_to_litter_patch (begp:endp)) ; this%hrv_livestemn_storage_to_litter_patch (:) = nan
- allocate(this%hrv_deadstemn_storage_to_litter_patch (begp:endp)) ; this%hrv_deadstemn_storage_to_litter_patch (:) = nan
- allocate(this%hrv_livecrootn_storage_to_litter_patch (begp:endp)) ; this%hrv_livecrootn_storage_to_litter_patch (:) = nan
- allocate(this%hrv_deadcrootn_storage_to_litter_patch (begp:endp)) ; this%hrv_deadcrootn_storage_to_litter_patch (:) = nan
- allocate(this%hrv_leafn_xfer_to_litter_patch (begp:endp)) ; this%hrv_leafn_xfer_to_litter_patch (:) = nan
- allocate(this%hrv_frootn_xfer_to_litter_patch (begp:endp)) ; this%hrv_frootn_xfer_to_litter_patch (:) = nan
- allocate(this%hrv_livestemn_xfer_to_litter_patch (begp:endp)) ; this%hrv_livestemn_xfer_to_litter_patch (:) = nan
- allocate(this%hrv_deadstemn_xfer_to_litter_patch (begp:endp)) ; this%hrv_deadstemn_xfer_to_litter_patch (:) = nan
- allocate(this%hrv_livecrootn_xfer_to_litter_patch (begp:endp)) ; this%hrv_livecrootn_xfer_to_litter_patch (:) = nan
- allocate(this%hrv_deadcrootn_xfer_to_litter_patch (begp:endp)) ; this%hrv_deadcrootn_xfer_to_litter_patch (:) = nan
- allocate(this%hrv_livestemn_to_litter_patch (begp:endp)) ; this%hrv_livestemn_to_litter_patch (:) = nan
- allocate(this%hrv_livecrootn_to_litter_patch (begp:endp)) ; this%hrv_livecrootn_to_litter_patch (:) = nan
- allocate(this%hrv_deadcrootn_to_litter_patch (begp:endp)) ; this%hrv_deadcrootn_to_litter_patch (:) = nan
- allocate(this%hrv_retransn_to_litter_patch (begp:endp)) ; this%hrv_retransn_to_litter_patch (:) = nan
-
- allocate(this%m_leafn_to_fire_patch (begp:endp)) ; this%m_leafn_to_fire_patch (:) = nan
- allocate(this%m_leafn_storage_to_fire_patch (begp:endp)) ; this%m_leafn_storage_to_fire_patch (:) = nan
- allocate(this%m_leafn_xfer_to_fire_patch (begp:endp)) ; this%m_leafn_xfer_to_fire_patch (:) = nan
- allocate(this%m_livestemn_to_fire_patch (begp:endp)) ; this%m_livestemn_to_fire_patch (:) = nan
- allocate(this%m_livestemn_storage_to_fire_patch (begp:endp)) ; this%m_livestemn_storage_to_fire_patch (:) = nan
- allocate(this%m_livestemn_xfer_to_fire_patch (begp:endp)) ; this%m_livestemn_xfer_to_fire_patch (:) = nan
- allocate(this%m_deadstemn_to_fire_patch (begp:endp)) ; this%m_deadstemn_to_fire_patch (:) = nan
- allocate(this%m_deadstemn_storage_to_fire_patch (begp:endp)) ; this%m_deadstemn_storage_to_fire_patch (:) = nan
- allocate(this%m_deadstemn_xfer_to_fire_patch (begp:endp)) ; this%m_deadstemn_xfer_to_fire_patch (:) = nan
- allocate(this%m_frootn_to_fire_patch (begp:endp)) ; this%m_frootn_to_fire_patch (:) = nan
- allocate(this%m_frootn_storage_to_fire_patch (begp:endp)) ; this%m_frootn_storage_to_fire_patch (:) = nan
- allocate(this%m_frootn_xfer_to_fire_patch (begp:endp)) ; this%m_frootn_xfer_to_fire_patch (:) = nan
- allocate(this%m_livecrootn_to_fire_patch (begp:endp)) ;
- allocate(this%m_livecrootn_storage_to_fire_patch (begp:endp)) ; this%m_livecrootn_storage_to_fire_patch (:) = nan
- allocate(this%m_livecrootn_xfer_to_fire_patch (begp:endp)) ; this%m_livecrootn_xfer_to_fire_patch (:) = nan
- allocate(this%m_deadcrootn_to_fire_patch (begp:endp)) ; this%m_deadcrootn_to_fire_patch (:) = nan
- allocate(this%m_deadcrootn_storage_to_fire_patch (begp:endp)) ; this%m_deadcrootn_storage_to_fire_patch (:) = nan
- allocate(this%m_deadcrootn_xfer_to_fire_patch (begp:endp)) ; this%m_deadcrootn_xfer_to_fire_patch (:) = nan
- allocate(this%m_retransn_to_fire_patch (begp:endp)) ; this%m_retransn_to_fire_patch (:) = nan
-
- allocate(this%m_leafn_to_litter_fire_patch (begp:endp)) ; this%m_leafn_to_litter_fire_patch (:) = nan
- allocate(this%m_leafn_storage_to_litter_fire_patch (begp:endp)) ; this%m_leafn_storage_to_litter_fire_patch (:) = nan
- allocate(this%m_leafn_xfer_to_litter_fire_patch (begp:endp)) ; this%m_leafn_xfer_to_litter_fire_patch (:) = nan
- allocate(this%m_livestemn_to_litter_fire_patch (begp:endp)) ; this%m_livestemn_to_litter_fire_patch (:) = nan
- allocate(this%m_livestemn_storage_to_litter_fire_patch (begp:endp)) ; this%m_livestemn_storage_to_litter_fire_patch (:) = nan
- allocate(this%m_livestemn_xfer_to_litter_fire_patch (begp:endp)) ; this%m_livestemn_xfer_to_litter_fire_patch (:) = nan
- allocate(this%m_livestemn_to_deadstemn_fire_patch (begp:endp)) ; this%m_livestemn_to_deadstemn_fire_patch (:) = nan
- allocate(this%m_deadstemn_to_litter_fire_patch (begp:endp)) ; this%m_deadstemn_to_litter_fire_patch (:) = nan
- allocate(this%m_deadstemn_storage_to_litter_fire_patch (begp:endp)) ; this%m_deadstemn_storage_to_litter_fire_patch (:) = nan
- allocate(this%m_deadstemn_xfer_to_litter_fire_patch (begp:endp)) ; this%m_deadstemn_xfer_to_litter_fire_patch (:) = nan
- allocate(this%m_frootn_to_litter_fire_patch (begp:endp)) ; this%m_frootn_to_litter_fire_patch (:) = nan
- allocate(this%m_frootn_storage_to_litter_fire_patch (begp:endp)) ; this%m_frootn_storage_to_litter_fire_patch (:) = nan
- allocate(this%m_frootn_xfer_to_litter_fire_patch (begp:endp)) ; this%m_frootn_xfer_to_litter_fire_patch (:) = nan
- allocate(this%m_livecrootn_to_litter_fire_patch (begp:endp)) ; this%m_livecrootn_to_litter_fire_patch (:) = nan
- allocate(this%m_livecrootn_storage_to_litter_fire_patch (begp:endp)) ; this%m_livecrootn_storage_to_litter_fire_patch (:) = nan
- allocate(this%m_livecrootn_xfer_to_litter_fire_patch (begp:endp)) ; this%m_livecrootn_xfer_to_litter_fire_patch (:) = nan
- allocate(this%m_livecrootn_to_deadcrootn_fire_patch (begp:endp)) ; this%m_livecrootn_to_deadcrootn_fire_patch (:) = nan
- allocate(this%m_deadcrootn_to_litter_fire_patch (begp:endp)) ; this%m_deadcrootn_to_litter_fire_patch (:) = nan
- allocate(this%m_deadcrootn_storage_to_litter_fire_patch (begp:endp)) ; this%m_deadcrootn_storage_to_litter_fire_patch (:) = nan
- allocate(this%m_deadcrootn_xfer_to_litter_fire_patch (begp:endp)) ; this%m_deadcrootn_xfer_to_litter_fire_patch (:) = nan
- allocate(this%m_retransn_to_litter_fire_patch (begp:endp)) ; this%m_retransn_to_litter_fire_patch (:) = nan
-
- allocate(this%leafn_xfer_to_leafn_patch (begp:endp)) ; this%leafn_xfer_to_leafn_patch (:) = nan
- allocate(this%frootn_xfer_to_frootn_patch (begp:endp)) ; this%frootn_xfer_to_frootn_patch (:) = nan
- allocate(this%livestemn_xfer_to_livestemn_patch (begp:endp)) ; this%livestemn_xfer_to_livestemn_patch (:) = nan
- allocate(this%deadstemn_xfer_to_deadstemn_patch (begp:endp)) ; this%deadstemn_xfer_to_deadstemn_patch (:) = nan
- allocate(this%livecrootn_xfer_to_livecrootn_patch (begp:endp)) ; this%livecrootn_xfer_to_livecrootn_patch (:) = nan
- allocate(this%deadcrootn_xfer_to_deadcrootn_patch (begp:endp)) ; this%deadcrootn_xfer_to_deadcrootn_patch (:) = nan
- allocate(this%leafn_to_litter_patch (begp:endp)) ; this%leafn_to_litter_patch (:) = nan
- allocate(this%leafn_to_retransn_patch (begp:endp)) ; this%leafn_to_retransn_patch (:) = nan
- allocate(this%frootn_to_retransn_patch (begp:endp)) ; this%frootn_to_retransn_patch (:) = nan
- allocate(this%frootn_to_litter_patch (begp:endp)) ; this%frootn_to_litter_patch (:) = nan
- allocate(this%retransn_to_npool_patch (begp:endp)) ; this%retransn_to_npool_patch (:) = nan
- allocate(this%free_retransn_to_npool_patch (begp:endp)) ; this%free_retransn_to_npool_patch (:) = nan
- allocate(this%sminn_to_npool_patch (begp:endp)) ; this%sminn_to_npool_patch (:) = nan
-
- allocate(this%npool_to_leafn_patch (begp:endp)) ; this%npool_to_leafn_patch (:) = nan
- allocate(this%npool_to_leafn_storage_patch (begp:endp)) ; this%npool_to_leafn_storage_patch (:) = nan
- allocate(this%npool_to_frootn_patch (begp:endp)) ; this%npool_to_frootn_patch (:) = nan
- allocate(this%npool_to_frootn_storage_patch (begp:endp)) ; this%npool_to_frootn_storage_patch (:) = nan
- allocate(this%npool_to_livestemn_patch (begp:endp)) ; this%npool_to_livestemn_patch (:) = nan
- allocate(this%npool_to_livestemn_storage_patch (begp:endp)) ; this%npool_to_livestemn_storage_patch (:) = nan
- allocate(this%npool_to_deadstemn_patch (begp:endp)) ; this%npool_to_deadstemn_patch (:) = nan
- allocate(this%npool_to_deadstemn_storage_patch (begp:endp)) ; this%npool_to_deadstemn_storage_patch (:) = nan
- allocate(this%npool_to_livecrootn_patch (begp:endp)) ; this%npool_to_livecrootn_patch (:) = nan
- allocate(this%npool_to_livecrootn_storage_patch (begp:endp)) ; this%npool_to_livecrootn_storage_patch (:) = nan
- allocate(this%npool_to_deadcrootn_patch (begp:endp)) ; this%npool_to_deadcrootn_patch (:) = nan
- allocate(this%npool_to_deadcrootn_storage_patch (begp:endp)) ; this%npool_to_deadcrootn_storage_patch (:) = nan
- allocate(this%leafn_storage_to_xfer_patch (begp:endp)) ; this%leafn_storage_to_xfer_patch (:) = nan
- allocate(this%frootn_storage_to_xfer_patch (begp:endp)) ; this%frootn_storage_to_xfer_patch (:) = nan
- allocate(this%livestemn_storage_to_xfer_patch (begp:endp)) ; this%livestemn_storage_to_xfer_patch (:) = nan
- allocate(this%deadstemn_storage_to_xfer_patch (begp:endp)) ; this%deadstemn_storage_to_xfer_patch (:) = nan
- allocate(this%livecrootn_storage_to_xfer_patch (begp:endp)) ; this%livecrootn_storage_to_xfer_patch (:) = nan
- allocate(this%deadcrootn_storage_to_xfer_patch (begp:endp)) ; this%deadcrootn_storage_to_xfer_patch (:) = nan
- allocate(this%livestemn_to_deadstemn_patch (begp:endp)) ; this%livestemn_to_deadstemn_patch (:) = nan
- allocate(this%livestemn_to_retransn_patch (begp:endp)) ; this%livestemn_to_retransn_patch (:) = nan
- allocate(this%livecrootn_to_deadcrootn_patch (begp:endp)) ; this%livecrootn_to_deadcrootn_patch (:) = nan
- allocate(this%livecrootn_to_retransn_patch (begp:endp)) ; this%livecrootn_to_retransn_patch (:) = nan
- allocate(this%ndeploy_patch (begp:endp)) ; this%ndeploy_patch (:) = nan
- allocate(this%wood_harvestn_patch (begp:endp)) ; this%wood_harvestn_patch (:) = nan
- allocate(this%fire_nloss_patch (begp:endp)) ; this%fire_nloss_patch (:) = nan
- allocate(this%npool_to_grainn_patch (begp:endp)) ; this%npool_to_grainn_patch (:) = nan
- allocate(this%npool_to_grainn_storage_patch (begp:endp)) ; this%npool_to_grainn_storage_patch (:) = nan
- allocate(this%livestemn_to_litter_patch (begp:endp)) ; this%livestemn_to_litter_patch (:) = nan
- allocate(this%grainn_to_food_patch (begp:endp)) ; this%grainn_to_food_patch (:) = nan
- allocate(this%grainn_to_seed_patch (begp:endp)) ; this%grainn_to_seed_patch (:) = nan
- allocate(this%grainn_xfer_to_grainn_patch (begp:endp)) ; this%grainn_xfer_to_grainn_patch (:) = nan
- allocate(this%grainn_storage_to_xfer_patch (begp:endp)) ; this%grainn_storage_to_xfer_patch (:) = nan
- allocate(this%fert_patch (begp:endp)) ; this%fert_patch (:) = nan
- allocate(this%fert_counter_patch (begp:endp)) ; this%fert_counter_patch (:) = nan
- allocate(this%soyfixn_patch (begp:endp)) ; this%soyfixn_patch (:) = nan
-
- allocate(this%grainn_to_cropprodn_patch (begp:endp)) ; this%grainn_to_cropprodn_patch (:) = nan
- allocate(this%grainn_to_cropprodn_col (begc:endc)) ; this%grainn_to_cropprodn_col (:) = nan
-
- allocate(this%fire_nloss_col (begc:endc)) ; this%fire_nloss_col (:) = nan
- allocate(this%fire_nloss_p2c_col (begc:endc)) ; this%fire_nloss_p2c_col (:) = nan
-
- allocate(this%m_n_to_litr_met_fire_col (begc:endc,1:nlevdecomp_full)) ; this%m_n_to_litr_met_fire_col (:,:) = nan
- allocate(this%m_n_to_litr_cel_fire_col (begc:endc,1:nlevdecomp_full)) ; this%m_n_to_litr_cel_fire_col (:,:) = nan
- allocate(this%m_n_to_litr_lig_fire_col (begc:endc,1:nlevdecomp_full)) ; this%m_n_to_litr_lig_fire_col (:,:) = nan
-
- allocate(this%dwt_seedn_to_leaf_patch (begp:endp)) ; this%dwt_seedn_to_leaf_patch (:) = nan
- allocate(this%dwt_seedn_to_leaf_grc (begg:endg)) ; this%dwt_seedn_to_leaf_grc (:) = nan
- allocate(this%dwt_seedn_to_deadstem_patch (begp:endp)) ; this%dwt_seedn_to_deadstem_patch (:) = nan
- allocate(this%dwt_seedn_to_deadstem_grc (begg:endg)) ; this%dwt_seedn_to_deadstem_grc (:) = nan
- allocate(this%dwt_conv_nflux_patch (begp:endp)) ; this%dwt_conv_nflux_patch (:) = nan
- allocate(this%dwt_conv_nflux_grc (begg:endg)) ; this%dwt_conv_nflux_grc (:) = nan
- allocate(this%dwt_wood_productn_gain_patch (begp:endp)) ; this%dwt_wood_productn_gain_patch (:) = nan
- allocate(this%dwt_crop_productn_gain_patch (begp:endp)) ; this%dwt_crop_productn_gain_patch (:) = nan
- allocate(this%wood_harvestn_col (begc:endc)) ; this%wood_harvestn_col (:) = nan
-
- allocate(this%dwt_frootn_to_litr_met_n_col (begc:endc,1:nlevdecomp_full)) ; this%dwt_frootn_to_litr_met_n_col (:,:) = nan
- allocate(this%dwt_frootn_to_litr_cel_n_col (begc:endc,1:nlevdecomp_full)) ; this%dwt_frootn_to_litr_cel_n_col (:,:) = nan
- allocate(this%dwt_frootn_to_litr_lig_n_col (begc:endc,1:nlevdecomp_full)) ; this%dwt_frootn_to_litr_lig_n_col (:,:) = nan
- allocate(this%dwt_livecrootn_to_cwdn_col (begc:endc,1:nlevdecomp_full)) ; this%dwt_livecrootn_to_cwdn_col (:,:) = nan
- allocate(this%dwt_deadcrootn_to_cwdn_col (begc:endc,1:nlevdecomp_full)) ; this%dwt_deadcrootn_to_cwdn_col (:,:) = nan
-
- allocate(this%crop_seedn_to_leaf_patch (begp:endp)) ; this%crop_seedn_to_leaf_patch (:) = nan
-
- allocate(this%m_decomp_npools_to_fire_vr_col (begc:endc,1:nlevdecomp_full,1:ndecomp_pools))
- allocate(this%m_decomp_npools_to_fire_col (begc:endc,1:ndecomp_pools ))
-
- this%m_decomp_npools_to_fire_vr_col (:,:,:) = nan
- this%m_decomp_npools_to_fire_col (:,:) = nan
-
- allocate(this%phenology_n_to_litr_met_n_col (begc:endc, 1:nlevdecomp_full))
- allocate(this%phenology_n_to_litr_cel_n_col (begc:endc, 1:nlevdecomp_full))
- allocate(this%phenology_n_to_litr_lig_n_col (begc:endc, 1:nlevdecomp_full))
- allocate(this%gap_mortality_n_to_litr_met_n_col (begc:endc, 1:nlevdecomp_full))
- allocate(this%gap_mortality_n_to_litr_cel_n_col (begc:endc, 1:nlevdecomp_full))
- allocate(this%gap_mortality_n_to_litr_lig_n_col (begc:endc, 1:nlevdecomp_full))
- allocate(this%gap_mortality_n_to_cwdn_col (begc:endc, 1:nlevdecomp_full))
- allocate(this%fire_mortality_n_to_cwdn_col (begc:endc, 1:nlevdecomp_full))
- allocate(this%harvest_n_to_litr_met_n_col (begc:endc, 1:nlevdecomp_full))
- allocate(this%harvest_n_to_litr_cel_n_col (begc:endc, 1:nlevdecomp_full))
- allocate(this%harvest_n_to_litr_lig_n_col (begc:endc, 1:nlevdecomp_full))
- allocate(this%harvest_n_to_cwdn_col (begc:endc, 1:nlevdecomp_full))
-
- this%phenology_n_to_litr_met_n_col (:,:) = nan
- this%phenology_n_to_litr_cel_n_col (:,:) = nan
- this%phenology_n_to_litr_lig_n_col (:,:) = nan
- this%gap_mortality_n_to_litr_met_n_col (:,:) = nan
- this%gap_mortality_n_to_litr_cel_n_col (:,:) = nan
- this%gap_mortality_n_to_litr_lig_n_col (:,:) = nan
- this%gap_mortality_n_to_cwdn_col (:,:) = nan
- this%fire_mortality_n_to_cwdn_col (:,:) = nan
- this%harvest_n_to_litr_met_n_col (:,:) = nan
- this%harvest_n_to_litr_cel_n_col (:,:) = nan
- this%harvest_n_to_litr_lig_n_col (:,:) = nan
- this%harvest_n_to_cwdn_col (:,:) = nan
-
- allocate(this%plant_ndemand_patch (begp:endp)) ; this%plant_ndemand_patch (:) = nan
- allocate(this%avail_retransn_patch (begp:endp)) ; this%avail_retransn_patch (:) = nan
- allocate(this%plant_nalloc_patch (begp:endp)) ; this%plant_nalloc_patch (:) = nan
-
- allocate(this%plant_ndemand_retrans_patch (begp:endp)) ; this%plant_ndemand_retrans_patch (:) = nan
- allocate(this%plant_ndemand_season_patch (begp:endp)) ; this%plant_ndemand_season_patch (:) = nan
- allocate(this%plant_ndemand_stress_patch (begp:endp)) ; this%plant_ndemand_stress_patch (:) = nan
- allocate(this%Nactive_patch (begp:endp)) ; this%Nactive_patch (:) = nan
- allocate(this%Nnonmyc_patch (begp:endp)) ; this%Nnonmyc_patch (:) = nan
- allocate(this%Nam_patch (begp:endp)) ; this%Nam_patch (:) = nan
- allocate(this%Necm_patch (begp:endp)) ; this%Necm_patch (:) = nan
- allocate(this%Nactive_no3_patch (begp:endp)) ; this%Nactive_no3_patch (:) = nan
- allocate(this%Nactive_nh4_patch (begp:endp)) ; this%Nactive_nh4_patch (:) = nan
- allocate(this%Nnonmyc_no3_patch (begp:endp)) ; this%Nnonmyc_no3_patch (:) = nan
- allocate(this%Nnonmyc_nh4_patch (begp:endp)) ; this%Nnonmyc_nh4_patch (:) = nan
- allocate(this%Nam_no3_patch (begp:endp)) ; this%Nam_no3_patch (:) = nan
- allocate(this%Nam_nh4_patch (begp:endp)) ; this%Nam_nh4_patch (:) = nan
- allocate(this%Necm_no3_patch (begp:endp)) ; this%Necm_no3_patch (:) = nan
- allocate(this%Necm_nh4_patch (begp:endp)) ; this%Necm_nh4_patch (:) = nan
- allocate(this%Npassive_patch (begp:endp)) ; this%Npassive_patch (:) = nan
- allocate(this%Nfix_patch (begp:endp)) ; this%Nfix_patch (:) = nan
- allocate(this%Nretrans_patch (begp:endp)) ; this%Nretrans_patch (:) = nan
- allocate(this%Nretrans_org_patch (begp:endp)) ; this%Nretrans_org_patch (:) = nan
- allocate(this%Nretrans_season_patch (begp:endp)) ; this%Nretrans_season_patch (:) = nan
- allocate(this%Nretrans_stress_patch (begp:endp)) ; this%Nretrans_stress_patch (:) = nan
- allocate(this%Nuptake_patch (begp:endp)) ; this%Nuptake_patch (:) = nan
- allocate(this%sminn_to_plant_fun_patch (begp:endp)) ; this%sminn_to_plant_fun_patch (:) = nan
- allocate(this%sminn_to_plant_fun_vr_patch (begp:endp,1:nlevdecomp_full))
- this%sminn_to_plant_fun_vr_patch (:,:) = nan
- allocate(this%sminn_to_plant_fun_no3_vr_patch (begp:endp,1:nlevdecomp_full))
- this%sminn_to_plant_fun_no3_vr_patch (:,:) = nan
- allocate(this%sminn_to_plant_fun_nh4_vr_patch (begp:endp,1:nlevdecomp_full))
- this%sminn_to_plant_fun_nh4_vr_patch (:,:) = nan
- allocate(this%cost_nfix_patch (begp:endp)) ; this%cost_nfix_patch (:) = nan
- allocate(this%cost_nactive_patch (begp:endp)) ; this%cost_nactive_patch (:) = nan
- allocate(this%cost_nretrans_patch (begp:endp)) ; this%cost_nretrans_patch (:) = nan
- allocate(this%nuptake_npp_fraction_patch (begp:endp)) ; this%nuptake_npp_fraction_patch (:) = nan
-
- end subroutine InitAllocate
-
- !------------------------------------------------------------------------
- subroutine InitHistory(this, bounds)
- !
- ! !DESCRIPTION:
- ! Initialize module data structure
- !
- ! !USES:
- use shr_infnan_mod , only : nan => shr_infnan_nan, assignment(=)
- use clm_varpar , only : nlevsno, nlevgrnd
- use histFileMod , only : hist_addfld1d, hist_addfld2d, hist_addfld_decomp
- !
- ! !ARGUMENTS:
- class(cnveg_nitrogenflux_type) :: this
- type(bounds_type), intent(in) :: bounds
- !
- ! !LOCAL VARIABLES:
- integer :: k,l
- integer :: begp, endp
- integer :: begc, endc
- integer :: begg, endg
- character(10) :: active
- character(24) :: fieldname
- character(100) :: longname
- character(8) :: vr_suffix
- real(r8), pointer :: data2dptr(:,:), data1dptr(:) ! temp. pointers for slicing larger arrays
- !------------------------------------------------------------------------
-
- begp = bounds%begp; endp= bounds%endp
- begc = bounds%begc; endc= bounds%endc
- begg = bounds%begg; endg= bounds%endg
-
- ! add suffix if number of soil decomposition depths is greater than 1
- if (nlevdecomp > 1) then
- vr_suffix = "_vr"
- else
- vr_suffix = ""
- endif
-
- this%m_leafn_to_litter_patch(begp:endp) = spval
- call hist_addfld1d (fname='M_LEAFN_TO_LITTER', units='gN/m^2/s', &
- avgflag='A', long_name='leaf N mortality', &
- ptr_patch=this%m_leafn_to_litter_patch, default='inactive')
-
- this%m_frootn_to_litter_patch(begp:endp) = spval
- call hist_addfld1d (fname='M_FROOTN_TO_LITTER', units='gN/m^2/s', &
- avgflag='A', long_name='fine root N mortality', &
- ptr_patch=this%m_frootn_to_litter_patch, default='inactive')
-
- this%m_leafn_storage_to_litter_patch(begp:endp) = spval
- call hist_addfld1d (fname='M_LEAFN_STORAGE_TO_LITTER', units='gN/m^2/s', &
- avgflag='A', long_name='leaf N storage mortality', &
- ptr_patch=this%m_leafn_storage_to_litter_patch, default='inactive')
-
- this%m_frootn_storage_to_litter_patch(begp:endp) = spval
- call hist_addfld1d (fname='M_FROOTN_STORAGE_TO_LITTER', units='gN/m^2/s', &
- avgflag='A', long_name='fine root N storage mortality', &
- ptr_patch=this%m_frootn_storage_to_litter_patch, default='inactive')
-
- this%m_livestemn_storage_to_litter_patch(begp:endp) = spval
- call hist_addfld1d (fname='M_LIVESTEMN_STORAGE_TO_LITTER', units='gN/m^2/s', &
- avgflag='A', long_name='live stem N storage mortality', &
- ptr_patch=this%m_livestemn_storage_to_litter_patch, default='inactive')
-
- this%m_deadstemn_storage_to_litter_patch(begp:endp) = spval
- call hist_addfld1d (fname='M_DEADSTEMN_STORAGE_TO_LITTER', units='gN/m^2/s', &
- avgflag='A', long_name='dead stem N storage mortality', &
- ptr_patch=this%m_deadstemn_storage_to_litter_patch, default='inactive')
-
- this%m_livecrootn_storage_to_litter_patch(begp:endp) = spval
- call hist_addfld1d (fname='M_LIVECROOTN_STORAGE_TO_LITTER', units='gN/m^2/s', &
- avgflag='A', long_name='live coarse root N storage mortality', &
- ptr_patch=this%m_livecrootn_storage_to_litter_patch, default='inactive')
-
- this%m_deadcrootn_storage_to_litter_patch(begp:endp) = spval
- call hist_addfld1d (fname='M_DEADCROOTN_STORAGE_TO_LITTER', units='gN/m^2/s', &
- avgflag='A', long_name='dead coarse root N storage mortality', &
- ptr_patch=this%m_deadcrootn_storage_to_litter_patch, default='inactive')
-
- this%m_leafn_xfer_to_litter_patch(begp:endp) = spval
- call hist_addfld1d (fname='M_LEAFN_XFER_TO_LITTER', units='gN/m^2/s', &
- avgflag='A', long_name='leaf N transfer mortality', &
- ptr_patch=this%m_leafn_xfer_to_litter_patch, default='inactive')
-
- this%m_frootn_xfer_to_litter_patch(begp:endp) = spval
- call hist_addfld1d (fname='M_FROOTN_XFER_TO_LITTER', units='gN/m^2/s', &
- avgflag='A', long_name='fine root N transfer mortality', &
- ptr_patch=this%m_frootn_xfer_to_litter_patch, default='inactive')
-
- this%m_livestemn_xfer_to_litter_patch(begp:endp) = spval
- call hist_addfld1d (fname='M_LIVESTEMN_XFER_TO_LITTER', units='gN/m^2/s', &
- avgflag='A', long_name='live stem N transfer mortality', &
- ptr_patch=this%m_livestemn_xfer_to_litter_patch, default='inactive')
-
- this%m_deadstemn_xfer_to_litter_patch(begp:endp) = spval
- call hist_addfld1d (fname='M_DEADSTEMN_XFER_TO_LITTER', units='gN/m^2/s', &
- avgflag='A', long_name='dead stem N transfer mortality', &
- ptr_patch=this%m_deadstemn_xfer_to_litter_patch, default='inactive')
-
- this%m_livecrootn_xfer_to_litter_patch(begp:endp) = spval
- call hist_addfld1d (fname='M_LIVECROOTN_XFER_TO_LITTER', units='gN/m^2/s', &
- avgflag='A', long_name='live coarse root N transfer mortality', &
- ptr_patch=this%m_livecrootn_xfer_to_litter_patch, default='inactive')
-
- this%m_deadcrootn_xfer_to_litter_patch(begp:endp) = spval
- call hist_addfld1d (fname='M_DEADCROOTN_XFER_TO_LITTER', units='gN/m^2/s', &
- avgflag='A', long_name='dead coarse root N transfer mortality', &
- ptr_patch=this%m_deadcrootn_xfer_to_litter_patch, default='inactive')
-
- this%m_livestemn_to_litter_patch(begp:endp) = spval
- call hist_addfld1d (fname='M_LIVESTEMN_TO_LITTER', units='gN/m^2/s', &
- avgflag='A', long_name='live stem N mortality', &
- ptr_patch=this%m_livestemn_to_litter_patch, default='inactive')
-
- this%m_deadstemn_to_litter_patch(begp:endp) = spval
- call hist_addfld1d (fname='M_DEADSTEMN_TO_LITTER', units='gN/m^2/s', &
- avgflag='A', long_name='dead stem N mortality', &
- ptr_patch=this%m_deadstemn_to_litter_patch, default='inactive')
-
- this%m_livecrootn_to_litter_patch(begp:endp) = spval
- call hist_addfld1d (fname='M_LIVECROOTN_TO_LITTER', units='gN/m^2/s', &
- avgflag='A', long_name='live coarse root N mortality', &
- ptr_patch=this%m_livecrootn_to_litter_patch, default='inactive')
-
- this%m_deadcrootn_to_litter_patch(begp:endp) = spval
- call hist_addfld1d (fname='M_DEADCROOTN_TO_LITTER', units='gN/m^2/s', &
- avgflag='A', long_name='dead coarse root N mortality', &
- ptr_patch=this%m_deadcrootn_to_litter_patch, default='inactive')
-
- this%m_retransn_to_litter_patch(begp:endp) = spval
- call hist_addfld1d (fname='M_RETRANSN_TO_LITTER', units='gN/m^2/s', &
- avgflag='A', long_name='retranslocated N pool mortality', &
- ptr_patch=this%m_retransn_to_litter_patch, default='inactive')
-
- this%m_leafn_to_fire_patch(begp:endp) = spval
- call hist_addfld1d (fname='M_LEAFN_TO_FIRE', units='gN/m^2/s', &
- avgflag='A', long_name='leaf N fire loss', &
- ptr_patch=this%m_leafn_to_fire_patch, default='inactive')
-
- this%m_frootn_to_fire_patch(begp:endp) = spval
- call hist_addfld1d (fname='M_FROOTN_TO_FIRE', units='gN/m^2/s', &
- avgflag='A', long_name='fine root N fire loss ', &
- ptr_patch=this%m_frootn_to_fire_patch, default='inactive')
-
- this%m_leafn_storage_to_fire_patch(begp:endp) = spval
- call hist_addfld1d (fname='M_LEAFN_STORAGE_TO_FIRE', units='gN/m^2/s', &
- avgflag='A', long_name='leaf N storage fire loss', &
- ptr_patch=this%m_leafn_storage_to_fire_patch, default='inactive')
-
- this%m_frootn_storage_to_fire_patch(begp:endp) = spval
- call hist_addfld1d (fname='M_FROOTN_STORAGE_TO_FIRE', units='gN/m^2/s', &
- avgflag='A', long_name='fine root N storage fire loss', &
- ptr_patch=this%m_frootn_storage_to_fire_patch, default='inactive')
-
- this%m_livestemn_storage_to_fire_patch(begp:endp) = spval
- call hist_addfld1d (fname='M_LIVESTEMN_STORAGE_TO_FIRE', units='gN/m^2/s', &
- avgflag='A', long_name='live stem N storage fire loss', &
- ptr_patch=this%m_livestemn_storage_to_fire_patch, default='inactive')
-
- this%m_deadstemn_storage_to_fire_patch(begp:endp) = spval
- call hist_addfld1d (fname='M_DEADSTEMN_STORAGE_TO_FIRE', units='gN/m^2/s', &
- avgflag='A', long_name='dead stem N storage fire loss', &
- ptr_patch=this%m_deadstemn_storage_to_fire_patch, default='inactive')
-
- this%m_livecrootn_storage_to_fire_patch(begp:endp) = spval
- call hist_addfld1d (fname='M_LIVECROOTN_STORAGE_TO_FIRE', units='gN/m^2/s', &
- avgflag='A', long_name='live coarse root N storage fire loss', &
- ptr_patch=this%m_livecrootn_storage_to_fire_patch, default='inactive')
-
- this%m_deadcrootn_storage_to_fire_patch(begp:endp) = spval
- call hist_addfld1d (fname='M_DEADCROOTN_STORAGE_TO_FIRE', units='gN/m^2/s', &
- avgflag='A', long_name='dead coarse root N storage fire loss', &
- ptr_patch=this%m_deadcrootn_storage_to_fire_patch, default='inactive')
-
- this%m_leafn_xfer_to_fire_patch(begp:endp) = spval
- call hist_addfld1d (fname='M_LEAFN_XFER_TO_FIRE', units='gN/m^2/s', &
- avgflag='A', long_name='leaf N transfer fire loss', &
- ptr_patch=this%m_leafn_xfer_to_fire_patch, default='inactive')
-
- this%m_frootn_xfer_to_fire_patch(begp:endp) = spval
- call hist_addfld1d (fname='M_FROOTN_XFER_TO_FIRE', units='gN/m^2/s', &
- avgflag='A', long_name='fine root N transfer fire loss', &
- ptr_patch=this%m_frootn_xfer_to_fire_patch, default='inactive')
-
- this%m_livestemn_xfer_to_fire_patch(begp:endp) = spval
- call hist_addfld1d (fname='M_LIVESTEMN_XFER_TO_FIRE', units='gN/m^2/s', &
- avgflag='A', long_name='live stem N transfer fire loss', &
- ptr_patch=this%m_livestemn_xfer_to_fire_patch, default='inactive')
-
- this%m_deadstemn_xfer_to_fire_patch(begp:endp) = spval
- call hist_addfld1d (fname='M_DEADSTEMN_XFER_TO_FIRE', units='gN/m^2/s', &
- avgflag='A', long_name='dead stem N transfer fire loss', &
- ptr_patch=this%m_deadstemn_xfer_to_fire_patch, default='inactive')
-
- this%m_livecrootn_xfer_to_fire_patch(begp:endp) = spval
- call hist_addfld1d (fname='M_LIVECROOTN_XFER_TO_FIRE', units='gN/m^2/s', &
- avgflag='A', long_name='live coarse root N transfer fire loss', &
- ptr_patch=this%m_livecrootn_xfer_to_fire_patch, default='inactive')
-
- this%m_deadcrootn_xfer_to_fire_patch(begp:endp) = spval
- call hist_addfld1d (fname='M_DEADCROOTN_XFER_TO_FIRE', units='gN/m^2/s', &
- avgflag='A', long_name='dead coarse root N transfer fire loss', &
- ptr_patch=this%m_deadcrootn_xfer_to_fire_patch, default='inactive')
-
- this%m_livestemn_to_fire_patch(begp:endp) = spval
- call hist_addfld1d (fname='M_LIVESTEMN_TO_FIRE', units='gN/m^2/s', &
- avgflag='A', long_name='live stem N fire loss', &
- ptr_patch=this%m_livestemn_to_fire_patch, default='inactive')
-
- this%m_deadstemn_to_fire_patch(begp:endp) = spval
- call hist_addfld1d (fname='M_DEADSTEMN_TO_FIRE', units='gN/m^2/s', &
- avgflag='A', long_name='dead stem N fire loss', &
- ptr_patch=this%m_deadstemn_to_fire_patch, default='inactive')
-
- this%m_deadstemn_to_litter_fire_patch(begp:endp) = spval
- call hist_addfld1d (fname='M_DEADSTEMN_TO_LITTER_FIRE', units='gN/m^2/s', &
- avgflag='A', long_name='dead stem N fire mortality to litter', &
- ptr_patch=this%m_deadstemn_to_litter_fire_patch, default='inactive')
-
- this%m_livecrootn_to_fire_patch(begp:endp) = spval
- call hist_addfld1d (fname='M_LIVECROOTN_TO_FIRE', units='gN/m^2/s', &
- avgflag='A', long_name='live coarse root N fire loss', &
- ptr_patch=this%m_livecrootn_to_fire_patch, default='inactive')
-
- this%m_deadcrootn_to_fire_patch(begp:endp) = spval
- call hist_addfld1d (fname='M_DEADCROOTN_TO_FIRE', units='gN/m^2/s', &
- avgflag='A', long_name='dead coarse root N fire loss', &
- ptr_patch=this%m_deadcrootn_to_fire_patch, default='inactive')
-
- this%m_deadcrootn_to_litter_fire_patch(begp:endp) = spval
- call hist_addfld1d (fname='M_DEADCROOTN_TO_LITTER_FIRE', units='gN/m^2/s', &
- avgflag='A', long_name='dead coarse root N fire mortality to litter', &
- ptr_patch=this%m_deadcrootn_to_litter_fire_patch, default='inactive')
-
- this%m_retransn_to_fire_patch(begp:endp) = spval
- call hist_addfld1d (fname='M_RETRANSN_TO_FIRE', units='gN/m^2/s', &
- avgflag='A', long_name='retranslocated N pool fire loss', &
- ptr_patch=this%m_retransn_to_fire_patch, default='inactive')
-
- this%leafn_xfer_to_leafn_patch(begp:endp) = spval
- call hist_addfld1d (fname='LEAFN_XFER_TO_LEAFN', units='gN/m^2/s', &
- avgflag='A', long_name='leaf N growth from storage', &
- ptr_patch=this%leafn_xfer_to_leafn_patch, default='inactive')
-
- this%frootn_xfer_to_frootn_patch(begp:endp) = spval
- call hist_addfld1d (fname='FROOTN_XFER_TO_FROOTN', units='gN/m^2/s', &
- avgflag='A', long_name='fine root N growth from storage', &
- ptr_patch=this%frootn_xfer_to_frootn_patch, default='inactive')
-
- this%livestemn_xfer_to_livestemn_patch(begp:endp) = spval
- call hist_addfld1d (fname='LIVESTEMN_XFER_TO_LIVESTEMN', units='gN/m^2/s', &
- avgflag='A', long_name='live stem N growth from storage', &
- ptr_patch=this%livestemn_xfer_to_livestemn_patch, default='inactive')
-
- this%deadstemn_xfer_to_deadstemn_patch(begp:endp) = spval
- call hist_addfld1d (fname='DEADSTEMN_XFER_TO_DEADSTEMN', units='gN/m^2/s', &
- avgflag='A', long_name='dead stem N growth from storage', &
- ptr_patch=this%deadstemn_xfer_to_deadstemn_patch, default='inactive')
-
- this%livecrootn_xfer_to_livecrootn_patch(begp:endp) = spval
- call hist_addfld1d (fname='LIVECROOTN_XFER_TO_LIVECROOTN', units='gN/m^2/s', &
- avgflag='A', long_name='live coarse root N growth from storage', &
- ptr_patch=this%livecrootn_xfer_to_livecrootn_patch, default='inactive')
-
- this%deadcrootn_xfer_to_deadcrootn_patch(begp:endp) = spval
- call hist_addfld1d (fname='DEADCROOTN_XFER_TO_DEADCROOTN', units='gN/m^2/s', &
- avgflag='A', long_name='dead coarse root N growth from storage', &
- ptr_patch=this%deadcrootn_xfer_to_deadcrootn_patch, default='inactive')
-
- this%leafn_to_litter_patch(begp:endp) = spval
- call hist_addfld1d (fname='LEAFN_TO_LITTER', units='gN/m^2/s', &
- avgflag='A', long_name='leaf N litterfall', &
- ptr_patch=this%leafn_to_litter_patch, default='inactive')
-
- this%leafn_to_retransn_patch(begp:endp) = spval
- call hist_addfld1d (fname='LEAFN_TO_RETRANSN', units='gN/m^2/s', &
- avgflag='A', long_name='leaf N to retranslocated N pool', &
- ptr_patch=this%leafn_to_retransn_patch, default='inactive')
-
- this%frootn_to_litter_patch(begp:endp) = spval
- call hist_addfld1d (fname='FROOTN_TO_LITTER', units='gN/m^2/s', &
- avgflag='A', long_name='fine root N litterfall', &
- ptr_patch=this%frootn_to_litter_patch, default='inactive')
-
- this%retransn_to_npool_patch(begp:endp) = spval
- call hist_addfld1d (fname='RETRANSN_TO_NPOOL', units='gN/m^2/s', &
- avgflag='A', long_name='deployment of retranslocated N', &
- ptr_patch=this%retransn_to_npool_patch, default='inactive')
-
- this%free_retransn_to_npool_patch(begp:endp) = spval
- call hist_addfld1d (fname='FREE_RETRANSN_TO_NPOOL', units='gN/m^2/s', &
- avgflag='A', long_name='deployment of retranslocated N', &
- ptr_patch=this%free_retransn_to_npool_patch, default='inactive')
-
- this%sminn_to_npool_patch(begp:endp) = spval
- call hist_addfld1d (fname='SMINN_TO_NPOOL', units='gN/m^2/s', &
- avgflag='A', long_name='deployment of soil mineral N uptake', &
- ptr_patch=this%sminn_to_npool_patch, default='inactive')
-
- this%npool_to_leafn_patch(begp:endp) = spval
- call hist_addfld1d (fname='NPOOL_TO_LEAFN', units='gN/m^2/s', &
- avgflag='A', long_name='allocation to leaf N', &
- ptr_patch=this%npool_to_leafn_patch, default='inactive')
-
- this%npool_to_leafn_storage_patch(begp:endp) = spval
- call hist_addfld1d (fname='NPOOL_TO_LEAFN_STORAGE', units='gN/m^2/s', &
- avgflag='A', long_name='allocation to leaf N storage', &
- ptr_patch=this%npool_to_leafn_storage_patch, default='inactive')
-
- this%npool_to_frootn_patch(begp:endp) = spval
- call hist_addfld1d (fname='NPOOL_TO_FROOTN', units='gN/m^2/s', &
- avgflag='A', long_name='allocation to fine root N', &
- ptr_patch=this%npool_to_frootn_patch, default='inactive')
-
- this%npool_to_frootn_storage_patch(begp:endp) = spval
- call hist_addfld1d (fname='NPOOL_TO_FROOTN_STORAGE', units='gN/m^2/s', &
- avgflag='A', long_name='allocation to fine root N storage', &
- ptr_patch=this%npool_to_frootn_storage_patch, default='inactive')
-
- this%npool_to_livestemn_patch(begp:endp) = spval
- call hist_addfld1d (fname='NPOOL_TO_LIVESTEMN', units='gN/m^2/s', &
- avgflag='A', long_name='allocation to live stem N', &
- ptr_patch=this%npool_to_livestemn_patch, default='inactive')
-
- this%npool_to_livestemn_storage_patch(begp:endp) = spval
- call hist_addfld1d (fname='NPOOL_TO_LIVESTEMN_STORAGE', units='gN/m^2/s', &
- avgflag='A', long_name='allocation to live stem N storage', &
- ptr_patch=this%npool_to_livestemn_storage_patch, default='inactive')
-
- this%npool_to_deadstemn_patch(begp:endp) = spval
- call hist_addfld1d (fname='NPOOL_TO_DEADSTEMN', units='gN/m^2/s', &
- avgflag='A', long_name='allocation to dead stem N', &
- ptr_patch=this%npool_to_deadstemn_patch, default='inactive')
-
- this%npool_to_deadstemn_storage_patch(begp:endp) = spval
- call hist_addfld1d (fname='NPOOL_TO_DEADSTEMN_STORAGE', units='gN/m^2/s', &
- avgflag='A', long_name='allocation to dead stem N storage', &
- ptr_patch=this%npool_to_deadstemn_storage_patch, default='inactive')
-
- this%npool_to_livecrootn_patch(begp:endp) = spval
- call hist_addfld1d (fname='NPOOL_TO_LIVECROOTN', units='gN/m^2/s', &
- avgflag='A', long_name='allocation to live coarse root N', &
- ptr_patch=this%npool_to_livecrootn_patch, default='inactive')
-
- this%npool_to_livecrootn_storage_patch(begp:endp) = spval
- call hist_addfld1d (fname='NPOOL_TO_LIVECROOTN_STORAGE', units='gN/m^2/s', &
- avgflag='A', long_name='allocation to live coarse root N storage', &
- ptr_patch=this%npool_to_livecrootn_storage_patch, default='inactive')
-
- this%npool_to_deadcrootn_patch(begp:endp) = spval
- call hist_addfld1d (fname='NPOOL_TO_DEADCROOTN', units='gN/m^2/s', &
- avgflag='A', long_name='allocation to dead coarse root N', &
- ptr_patch=this%npool_to_deadcrootn_patch, default='inactive')
-
- this%npool_to_deadcrootn_storage_patch(begp:endp) = spval
- call hist_addfld1d (fname='NPOOL_TO_DEADCROOTN_STORAGE', units='gN/m^2/s', &
- avgflag='A', long_name='allocation to dead coarse root N storage', &
- ptr_patch=this%npool_to_deadcrootn_storage_patch, default='inactive')
-
- this%leafn_storage_to_xfer_patch(begp:endp) = spval
- call hist_addfld1d (fname='LEAFN_STORAGE_TO_XFER', units='gN/m^2/s', &
- avgflag='A', long_name='leaf N shift storage to transfer', &
- ptr_patch=this%leafn_storage_to_xfer_patch, default='inactive')
-
- this%frootn_storage_to_xfer_patch(begp:endp) = spval
- call hist_addfld1d (fname='FROOTN_STORAGE_TO_XFER', units='gN/m^2/s', &
- avgflag='A', long_name='fine root N shift storage to transfer', &
- ptr_patch=this%frootn_storage_to_xfer_patch, default='inactive')
-
- this%livestemn_storage_to_xfer_patch(begp:endp) = spval
- call hist_addfld1d (fname='LIVESTEMN_STORAGE_TO_XFER', units='gN/m^2/s', &
- avgflag='A', long_name='live stem N shift storage to transfer', &
- ptr_patch=this%livestemn_storage_to_xfer_patch, default='inactive')
-
- this%deadstemn_storage_to_xfer_patch(begp:endp) = spval
- call hist_addfld1d (fname='DEADSTEMN_STORAGE_TO_XFER', units='gN/m^2/s', &
- avgflag='A', long_name='dead stem N shift storage to transfer', &
- ptr_patch=this%deadstemn_storage_to_xfer_patch, default='inactive')
-
- this%livecrootn_storage_to_xfer_patch(begp:endp) = spval
- call hist_addfld1d (fname='LIVECROOTN_STORAGE_TO_XFER', units='gN/m^2/s', &
- avgflag='A', long_name='live coarse root N shift storage to transfer', &
- ptr_patch=this%livecrootn_storage_to_xfer_patch, default='inactive')
-
- this%deadcrootn_storage_to_xfer_patch(begp:endp) = spval
- call hist_addfld1d (fname='DEADCROOTN_STORAGE_TO_XFER', units='gN/m^2/s', &
- avgflag='A', long_name='dead coarse root N shift storage to transfer', &
- ptr_patch=this%deadcrootn_storage_to_xfer_patch, default='inactive')
-
- this%livestemn_to_deadstemn_patch(begp:endp) = spval
- call hist_addfld1d (fname='LIVESTEMN_TO_DEADSTEMN', units='gN/m^2/s', &
- avgflag='A', long_name='live stem N turnover', &
- ptr_patch=this%livestemn_to_deadstemn_patch, default='inactive')
-
- this%livestemn_to_retransn_patch(begp:endp) = spval
- call hist_addfld1d (fname='LIVESTEMN_TO_RETRANSN', units='gN/m^2/s', &
- avgflag='A', long_name='live stem N to retranslocated N pool', &
- ptr_patch=this%livestemn_to_retransn_patch, default='inactive')
-
- this%livecrootn_to_deadcrootn_patch(begp:endp) = spval
- call hist_addfld1d (fname='LIVECROOTN_TO_DEADCROOTN', units='gN/m^2/s', &
- avgflag='A', long_name='live coarse root N turnover', &
- ptr_patch=this%livecrootn_to_deadcrootn_patch, default='inactive')
-
- this%livecrootn_to_retransn_patch(begp:endp) = spval
- call hist_addfld1d (fname='LIVECROOTN_TO_RETRANSN', units='gN/m^2/s', &
- avgflag='A', long_name='live coarse root N to retranslocated N pool', &
- ptr_patch=this%livecrootn_to_retransn_patch, default='inactive')
-
- this%ndeploy_patch(begp:endp) = spval
- call hist_addfld1d (fname='NDEPLOY', units='gN/m^2/s', &
- avgflag='A', long_name='total N deployed in new growth', &
- ptr_patch=this%ndeploy_patch, default='inactive')
-
- this%wood_harvestn_patch(begp:endp) = spval
- call hist_addfld1d (fname='WOOD_HARVESTN', units='gN/m^2/s', &
- avgflag='A', long_name='wood harvest N (to product pools)', &
- ptr_patch=this%wood_harvestn_patch, default='inactive')
-
- this%fire_nloss_patch(begp:endp) = spval
- call hist_addfld1d (fname='PFT_FIRE_NLOSS', units='gN/m^2/s', &
- avgflag='A', long_name='total patch-level fire N loss', &
- ptr_patch=this%fire_nloss_patch, default='inactive')
-
- if (use_crop) then
- this%fert_patch(begp:endp) = spval
- call hist_addfld1d (fname='NFERTILIZATION', units='gN/m^2/s', &
- avgflag='A', long_name='fertilizer added', &
- ptr_patch=this%fert_patch, default='inactive')
- end if
-
- if (use_crop) then
- this%soyfixn_patch(begp:endp) = spval
- call hist_addfld1d (fname='SOYFIXN', units='gN/m^2/s', &
- avgflag='A', long_name='soybean fixation', &
- ptr_patch=this%soyfixn_patch, default='inactive')
- end if
-
- if (use_crop) then
- this%fert_counter_patch(begp:endp) = spval
- call hist_addfld1d (fname='FERT_COUNTER', units='seconds', &
- avgflag='A', long_name='time left to fertilize', &
- ptr_patch=this%fert_counter_patch, default='inactive')
- end if
-
- !-------------------------------
- ! N flux variables - native to column
- !-------------------------------
-
- do k = 1, ndecomp_pools
- if ( decomp_cascade_con%is_litter(k) .or. decomp_cascade_con%is_cwd(k) ) then
- this%m_decomp_npools_to_fire_col(begc:endc,k) = spval
- data1dptr => this%m_decomp_npools_to_fire_col(:,k)
- fieldname = 'M_'//trim(decomp_cascade_con%decomp_pool_name_history(k))//'N_TO_FIRE'
- longname = trim(decomp_cascade_con%decomp_pool_name_long(k))//' N fire loss'
- call hist_addfld1d (fname=fieldname, units='gN/m^2', &
- avgflag='A', long_name=longname, &
- ptr_col=data1dptr, default='inactive')
-
- if ( nlevdecomp_full > 1 ) then
- this%m_decomp_npools_to_fire_vr_col(begc:endc,:,k) = spval
- data2dptr => this%m_decomp_npools_to_fire_vr_col(:,:,k)
- fieldname = 'M_'//trim(decomp_cascade_con%decomp_pool_name_history(k))//'N_TO_FIRE'//trim(vr_suffix)
- longname = trim(decomp_cascade_con%decomp_pool_name_long(k))//' N fire loss'
- call hist_addfld_decomp (fname=fieldname, units='gN/m^3', type2d='levdcmp', &
- avgflag='A', long_name=longname, &
- ptr_col=data2dptr, default='inactive')
- endif
- endif
- end do
-
- this%fire_nloss_col(begc:endc) = spval
- call hist_addfld1d (fname='COL_FIRE_NLOSS', units='gN/m^2/s', &
- avgflag='A', long_name='total column-level fire N loss', &
- ptr_col=this%fire_nloss_col, default='inactive')
-
- this%dwt_seedn_to_leaf_grc(begg:endg) = spval
- call hist_addfld1d (fname='DWT_SEEDN_TO_LEAF', units='gN/m^2/s', &
- avgflag='A', long_name='seed source to patch-level leaf', &
- ptr_gcell=this%dwt_seedn_to_leaf_grc, default='inactive')
-
- this%dwt_seedn_to_leaf_patch(begp:endp) = spval
- call hist_addfld1d (fname='DWT_SEEDN_TO_LEAF_PATCH', units='gN/m^2/s', &
- avgflag='A', &
- long_name='patch-level seed source to patch-level leaf ' // &
- '(per-area-gridcell; only makes sense with dov2xy=.false.)', &
- ptr_patch=this%dwt_seedn_to_leaf_patch, default='inactive')
-
- this%dwt_seedn_to_deadstem_grc(begg:endg) = spval
- call hist_addfld1d (fname='DWT_SEEDN_TO_DEADSTEM', units='gN/m^2/s', &
- avgflag='A', long_name='seed source to patch-level deadstem', &
- ptr_gcell=this%dwt_seedn_to_deadstem_grc, default='inactive')
-
- this%dwt_seedn_to_deadstem_patch(begp:endp) = spval
- call hist_addfld1d (fname='DWT_SEEDN_TO_DEADSTEM_PATCH', units='gN/m^2/s', &
- avgflag='A', &
- long_name='patch-level seed source to patch-level deadstem ' // &
- '(per-area-gridcell; only makes sense with dov2xy=.false.)', &
- ptr_patch=this%dwt_seedn_to_deadstem_patch, default='inactive')
-
- this%dwt_conv_nflux_grc(begg:endg) = spval
- call hist_addfld1d (fname='DWT_CONV_NFLUX', units='gN/m^2/s', &
- avgflag='A', &
- long_name='conversion N flux (immediate loss to atm) (0 at all times except first timestep of year)', &
- ptr_gcell=this%dwt_conv_nflux_grc, default='inactive')
-
- this%dwt_conv_nflux_patch(begp:endp) = spval
- call hist_addfld1d (fname='DWT_CONV_NFLUX_PATCH', units='gN/m^2/s', &
- avgflag='A', &
- long_name='patch-level conversion N flux (immediate loss to atm) ' // &
- '(0 at all times except first timestep of year) ' // &
- '(per-area-gridcell; only makes sense with dov2xy=.false.)', &
- ptr_patch=this%dwt_conv_nflux_patch, default='inactive')
-
- this%dwt_frootn_to_litr_met_n_col(begc:endc,:) = spval
- call hist_addfld_decomp (fname='DWT_FROOTN_TO_LITR_MET_N', units='gN/m^2/s', type2d='levdcmp', &
- avgflag='A', long_name='fine root to litter due to landcover change', &
- ptr_col=this%dwt_frootn_to_litr_met_n_col, default='inactive')
-
- this%dwt_frootn_to_litr_cel_n_col(begc:endc,:) = spval
- call hist_addfld_decomp (fname='DWT_FROOTN_TO_LITR_CEL_N', units='gN/m^2/s', type2d='levdcmp', &
- avgflag='A', long_name='fine root to litter due to landcover change', &
- ptr_col=this%dwt_frootn_to_litr_cel_n_col, default='inactive')
-
- this%dwt_frootn_to_litr_lig_n_col(begc:endc,:) = spval
- call hist_addfld_decomp (fname='DWT_FROOTN_TO_LITR_LIG_N', units='gN/m^2/s', type2d='levdcmp', &
- avgflag='A', long_name='fine root to litter due to landcover change', &
- ptr_col=this%dwt_frootn_to_litr_lig_n_col, default='inactive')
-
- this%dwt_livecrootn_to_cwdn_col(begc:endc,:) = spval
- call hist_addfld_decomp (fname='DWT_LIVECROOTN_TO_CWDN', units='gN/m^2/s', type2d='levdcmp', &
- avgflag='A', long_name='live coarse root to CWD due to landcover change', &
- ptr_col=this%dwt_livecrootn_to_cwdn_col, default='inactive')
-
- this%dwt_deadcrootn_to_cwdn_col(begc:endc,:) = spval
- call hist_addfld_decomp (fname='DWT_DEADCROOTN_TO_CWDN', units='gN/m^2/s', type2d='levdcmp', &
- avgflag='A', long_name='dead coarse root to CWD due to landcover change', &
- ptr_col=this%dwt_deadcrootn_to_cwdn_col, default='inactive')
-
- this%crop_seedn_to_leaf_patch(begp:endp) = spval
- call hist_addfld1d (fname='CROP_SEEDN_TO_LEAF', units='gN/m^2/s', &
- avgflag='A', long_name='crop seed source to leaf', &
- ptr_patch=this%crop_seedn_to_leaf_patch, default='inactive')
-
- this%plant_ndemand_patch(begp:endp) = spval
- call hist_addfld1d (fname='PLANT_NDEMAND', units='gN/m^2/s', &
- avgflag='A', long_name='N flux required to support initial GPP', &
- ptr_patch=this%plant_ndemand_patch, default='inactive')
-
- this%avail_retransn_patch(begp:endp) = spval
- call hist_addfld1d (fname='AVAIL_RETRANSN', units='gN/m^2/s', &
- avgflag='A', long_name='N flux available from retranslocation pool', &
- ptr_patch=this%avail_retransn_patch, default='inactive')
-
- this%plant_nalloc_patch(begp:endp) = spval
- call hist_addfld1d (fname='PLANT_NALLOC', units='gN/m^2/s', &
- avgflag='A', long_name='total allocated N flux', &
- ptr_patch=this%plant_nalloc_patch, default='inactive')
-
- if ( use_fun ) then
- this%Nactive_patch(begp:endp) = spval
- call hist_addfld1d (fname='NACTIVE', units='gN/m^2/s', &
- avgflag='A', long_name='Mycorrhizal N uptake flux', &
- ptr_patch=this%Nactive_patch, default='inactive')
-
- this%Nnonmyc_patch(begp:endp) = spval
- call hist_addfld1d (fname='NNONMYC', units='gN/m^2/s', &
- avgflag='A', long_name='Non-mycorrhizal N uptake flux', &
- ptr_patch=this%Nnonmyc_patch, default='inactive')
-
- this%Nam_patch(begp:endp) = spval
- call hist_addfld1d (fname='NAM', units='gN/m^2/s', &
- avgflag='A', long_name='AM-associated N uptake flux', &
- ptr_patch=this%Nam_patch, default='inactive')
-
- this%Necm_patch(begp:endp) = spval
- call hist_addfld1d (fname='NECM', units='gN/m^2/s', &
- avgflag='A', long_name='ECM-associated N uptake flux', &
- ptr_patch=this%Necm_patch, default='inactive')
-
- if (use_nitrif_denitrif) then
- this%Nactive_no3_patch(begp:endp) = spval
- call hist_addfld1d (fname='NACTIVE_NO3', units='gN/m^2/s', &
- avgflag='A', long_name='Mycorrhizal N uptake flux', &
- ptr_patch=this%Nactive_no3_patch, default='inactive')
-
- this%Nactive_nh4_patch(begp:endp) = spval
- call hist_addfld1d (fname='NACTIVE_NH4', units='gN/m^2/s', &
- avgflag='A', long_name='Mycorrhizal N uptake flux', &
- ptr_patch=this%Nactive_nh4_patch, default='inactive')
-
- this%Nnonmyc_no3_patch(begp:endp) = spval
- call hist_addfld1d (fname='NNONMYC_NO3', units='gN/m^2/s', &
- avgflag='A', long_name='Non-mycorrhizal N uptake flux', &
- ptr_patch=this%Nnonmyc_no3_patch, default='inactive')
-
- this%Nnonmyc_nh4_patch(begp:endp) = spval
- call hist_addfld1d (fname='NNONMYC_NH4', units='gN/m^2/s', &
- avgflag='A', long_name='Non-mycorrhizal N uptake flux', &
- ptr_patch=this%Nnonmyc_nh4_patch, default='inactive')
-
- this%Nam_no3_patch(begp:endp) = spval
- call hist_addfld1d (fname='NAM_NO3', units='gN/m^2/s', &
- avgflag='A', long_name='AM-associated N uptake flux', &
- ptr_patch=this%Nam_no3_patch, default='inactive')
-
- this%Nam_nh4_patch(begp:endp) = spval
- call hist_addfld1d (fname='NAM_NH4', units='gN/m^2/s', &
- avgflag='A', long_name='AM-associated N uptake flux', &
- ptr_patch=this%Nam_nh4_patch, default='inactive')
-
- this%Necm_no3_patch(begp:endp) = spval
- call hist_addfld1d (fname='NECM_NO3', units='gN/m^2/s', &
- avgflag='A', long_name='ECM-associated N uptake flux', &
- ptr_patch=this%Necm_no3_patch, default='inactive')
-
- this%Necm_nh4_patch(begp:endp) = spval
- call hist_addfld1d (fname='NECM_NH4', units='gN/m^2/s', &
- avgflag='A', long_name='ECM-associated N uptake flux', &
- ptr_patch=this%Necm_nh4_patch, default='inactive')
- end if
-
- this%Npassive_patch(begp:endp) = spval
- call hist_addfld1d (fname='NPASSIVE', units='gN/m^2/s', &
- avgflag='A', long_name='Passive N uptake flux', &
- ptr_patch=this%Npassive_patch, default='inactive')
-
- this%Nfix_patch(begp:endp) = spval
- call hist_addfld1d (fname='NFIX', units='gN/m^2/s', &
- avgflag='A', long_name='Symbiotic BNF uptake flux', &
- ptr_patch=this%Nfix_patch, default='inactive')
-
- this%Nretrans_patch(begp:endp) = spval
- call hist_addfld1d (fname='NRETRANS', units='gN/m^2/s', &
- avgflag='A', long_name='Retranslocated N uptake flux', &
- ptr_patch=this%Nretrans_patch, default='inactive')
-
- this%Nretrans_org_patch(begp:endp) = spval
- call hist_addfld1d (fname='NRETRANS_REG', units='gN/m^2/s', &
- avgflag='A', long_name='Retranslocated N uptake flux', &
- ptr_patch=this%Nretrans_org_patch, default='inactive')
-
- this%Nretrans_season_patch(begp:endp) = spval
- call hist_addfld1d (fname='NRETRANS_SEASON', units='gN/m^2/s', &
- avgflag='A', long_name='Retranslocated N uptake flux', &
- ptr_patch=this%Nretrans_season_patch, default='inactive')
-
- this%Nretrans_stress_patch(begp:endp) = spval
- call hist_addfld1d (fname='NRETRANS_STRESS', units='gN/m^2/s', &
- avgflag='A', long_name='Retranslocated N uptake flux', &
- ptr_patch=this%Nretrans_stress_patch, default='inactive')
-
- this%Nuptake_patch(begp:endp) = spval
- call hist_addfld1d (fname='NUPTAKE', units='gN/m^2/s', &
- avgflag='A', long_name='Total N uptake of FUN', &
- ptr_patch=this%Nuptake_patch, default='inactive')
-
- this%sminn_to_plant_fun_patch(begp:endp) = spval
- call hist_addfld1d (fname='SMINN_TO_PLANT_FUN', units='gN/m^2/s',&
- avgflag='A', long_name='Total soil N uptake of FUN', &
- ptr_patch=this%sminn_to_plant_fun_patch, default='inactive')
-
- this%cost_nfix_patch(begp:endp) = spval
- call hist_addfld1d (fname='COST_NFIX', units='gN/gC', &
- avgflag='A', long_name='Cost of fixation', &
- ptr_patch=this%cost_nfix_patch, default='inactive')
-
- this%cost_nactive_patch(begp:endp) = spval
- call hist_addfld1d (fname='COST_NACTIVE', units='gN/gC', &
- avgflag='A', long_name='Cost of active uptake', &
- ptr_patch=this%cost_nactive_patch, default='inactive')
-
- this%cost_nretrans_patch(begp:endp) = spval
- call hist_addfld1d (fname='COST_NRETRANS', units='gN/gC', &
- avgflag='A', long_name='Cost of retranslocation', &
- ptr_patch=this%cost_nretrans_patch, default='inactive')
-
- this%nuptake_npp_fraction_patch(begp:endp) = spval
- call hist_addfld1d (fname='NUPTAKE_NPP_FRACTION', units='-', &
- avgflag='A', long_name='frac of NPP used in N uptake', &
- ptr_patch=this%nuptake_npp_fraction_patch, default='inactive')
-
-
- end if
-
- end subroutine InitHistory
-
- !-----------------------------------------------------------------------
- subroutine InitCold(this, bounds)
- !
- ! !DESCRIPTION:
- ! Initializes time varying variables used only in coupled carbon-nitrogen mode (CN):
- !
- ! !USES:
- use landunit_varcon , only : istsoil, istcrop
- !
- ! !ARGUMENTS:
- class(cnveg_nitrogenflux_type) :: this
- type(bounds_type), intent(in) :: bounds
- !
- ! !LOCAL VARIABLES:
- integer :: p,c,l,j
- integer :: fp, fc ! filter indices
- integer :: num_special_col ! number of good values in special_col filter
- integer :: num_special_patch ! number of good values in special_patch filter
- integer :: special_col(bounds%endc-bounds%begc+1) ! special landunit filter - columns
- integer :: special_patch(bounds%endp-bounds%begp+1) ! special landunit filter - patches
- !---------------------------------------------------------------------
-
- ! Set column filters
-
- num_special_col = 0
- do c = bounds%begc, bounds%endc
- l = col%landunit(c)
- if (lun%ifspecial(l)) then
- num_special_col = num_special_col + 1
- special_col(num_special_col) = c
- end if
- end do
-
- ! Set patch filters
-
- num_special_patch = 0
- do p = bounds%begp,bounds%endp
- l = patch%landunit(p)
- if (lun%ifspecial(l)) then
- num_special_patch = num_special_patch + 1
- special_patch(num_special_patch) = p
- end if
- end do
-
- !-----------------------------------------------
- ! initialize nitrogen flux variables
- !-----------------------------------------------
-
- do p = bounds%begp,bounds%endp
- l = patch%landunit(p)
-
- if ( use_crop )then
- this%fert_counter_patch(p) = spval
- this%fert_patch(p) = 0._r8
- this%soyfixn_patch(p) = 0._r8
- end if
-
- if (lun%itype(l) == istsoil .or. lun%itype(l) == istcrop) then
- this%fert_counter_patch(p) = 0._r8
- end if
- if ( use_fun ) then
- if (lun%ifspecial(l)) then
- this%plant_ndemand_patch(p) = spval
- this%avail_retransn_patch(p) = spval
- this%plant_nalloc_patch(p) = spval
- this%Npassive_patch(p) = spval
- this%Nactive_patch(p) = spval
- this%Nnonmyc_patch(p) = spval
- this%Nam_patch(p) = spval
- this%Necm_patch(p) = spval
- if (use_nitrif_denitrif) then
- this%Nactive_no3_patch(p) = spval
- this%Nactive_nh4_patch(p) = spval
- this%Nnonmyc_no3_patch(p) = spval
- this%Nnonmyc_nh4_patch(p) = spval
- this%Nam_no3_patch(p) = spval
- this%Nam_nh4_patch(p) = spval
- this%Necm_no3_patch(p) = spval
- this%Necm_nh4_patch(p) = spval
- end if
- this%Nfix_patch(p) = spval
- this%Nretrans_patch(p) = spval
- this%Nretrans_org_patch(p) = spval
- this%Nretrans_season_patch(p) = spval
- this%Nretrans_stress_patch(p) = spval
- this%Nuptake_patch(p) = spval
- this%sminn_to_plant_fun_patch(p) = spval
- this%cost_nfix_patch = spval
- this%cost_nactive_patch = spval
- this%cost_nretrans_patch = spval
- this%nuptake_npp_fraction_patch = spval
-
- do j = 1, nlevdecomp
- this%sminn_to_plant_fun_vr_patch(p,j) = spval
- this%sminn_to_plant_fun_no3_vr_patch(p,j) = spval
- this%sminn_to_plant_fun_nh4_vr_patch(p,j) = spval
- end do
- end if
- end if
- end do
-
- ! initialize fields for special filters
-
- call this%SetValues (&
- num_patch=num_special_patch, filter_patch=special_patch, value_patch=0._r8, &
- num_column=num_special_col, filter_column=special_col, value_column=0._r8)
-
- end subroutine InitCold
-
- !-----------------------------------------------------------------------
- subroutine Restart (this, bounds, ncid, flag )
- !
- ! !DESCRIPTION:
- ! Read/write CN restart data for carbon state
- !
- ! !USES:
- use restUtilMod
- use ncdio_pio
- !
- ! !ARGUMENTS:
- class (cnveg_nitrogenflux_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
- real(r8), pointer :: ptr2d(:,:) ! temp. pointers for slicing larger arrays
- real(r8), pointer :: ptr1d(:) ! temp. pointers for slicing larger arrays
- !------------------------------------------------------------------------
-
- if (use_crop) then
- call restartvar(ncid=ncid, flag=flag, varname='fert_counter', xtype=ncd_double, &
- dim1name='pft', &
- long_name='', units='', &
- interpinic_flag='interp', readvar=readvar, data=this%fert_counter_patch)
-
- call restartvar(ncid=ncid, flag=flag, varname='fert', xtype=ncd_double, &
- dim1name='pft', &
- long_name='', units='', &
- interpinic_flag='interp', readvar=readvar, data=this%fert_patch)
- end if
-
- if (use_crop) then
- call restartvar(ncid=ncid, flag=flag, varname='grainn_xfer_to_grainn', xtype=ncd_double, &
- dim1name='pft', &
- long_name='grain N growth from storage', units='gN/m2/s', &
- interpinic_flag='interp', readvar=readvar, data=this%grainn_xfer_to_grainn_patch)
- end if
-
- if (use_crop) then
- call restartvar(ncid=ncid, flag=flag, varname='livestemn_to_litter', xtype=ncd_double, &
- dim1name='pft', &
- long_name='livestem N to litter', units='gN/m2/s', &
- interpinic_flag='interp', readvar=readvar, data=this%livestemn_to_litter_patch)
- end if
-
- if (use_crop) then
- call restartvar(ncid=ncid, flag=flag, varname='grainn_to_food', xtype=ncd_double, &
- dim1name='pft', &
- long_name='grain N to food', units='gN/m2/s', &
- interpinic_flag='interp', readvar=readvar, data=this%grainn_to_food_patch)
- end if
-
- if (use_crop) then
- call restartvar(ncid=ncid, flag=flag, varname='npool_to_grainn', xtype=ncd_double, &
- dim1name='pft', &
- long_name='allocation to grain N', units='gN/m2/s', &
- interpinic_flag='interp', readvar=readvar, data=this%npool_to_grainn_patch)
- end if
-
- if (use_crop) then
- call restartvar(ncid=ncid, flag=flag, varname='npool_to_grainn_storage', xtype=ncd_double, &
- dim1name='pft', &
- long_name='allocation to grain N storage', units='gN/m2/s', &
- interpinic_flag='interp', readvar=readvar, data=this%npool_to_grainn_storage_patch)
- end if
-
- if (use_crop) then
- call restartvar(ncid=ncid, flag=flag, varname='grainn_storage_to_xfer', xtype=ncd_double, &
- dim1name='pft', &
- long_name='grain N shift storage to transfer', units='gN/m2/s', &
- interpinic_flag='interp', readvar=readvar, data=this%grainn_storage_to_xfer_patch)
- end if
-
- call restartvar(ncid=ncid, flag=flag, varname='plant_ndemand', xtype=ncd_double, &
- dim1name='pft', &
- long_name='', units='', &
- interpinic_flag='interp', readvar=readvar, data=this%plant_ndemand_patch)
-
- call restartvar(ncid=ncid, flag=flag, varname='avail_retransn', xtype=ncd_double, &
- dim1name='pft', &
- long_name='', units='', &
- interpinic_flag='interp', readvar=readvar, data=this%avail_retransn_patch)
-
- call restartvar(ncid=ncid, flag=flag, varname='plant_nalloc', xtype=ncd_double, &
- dim1name='pft', &
- long_name='', units='', &
- interpinic_flag='interp', readvar=readvar, data=this%plant_nalloc_patch)
-
- if ( use_fun ) then
- call restartvar(ncid=ncid, flag=flag, varname='Nactive', xtype=ncd_double, &
- dim1name='pft', &
- long_name='', units='', &
- interpinic_flag='interp', readvar=readvar, data=this%Nactive_patch)
-!
- call restartvar(ncid=ncid, flag=flag, varname='Nnonmyc', xtype=ncd_double, &
- dim1name='pft', &
- long_name='', units='', &
- interpinic_flag='interp', readvar=readvar, data=this%Nnonmyc_patch)
-
- call restartvar(ncid=ncid, flag=flag, varname='Nam', xtype=ncd_double, &
- dim1name='pft', &
- long_name='', units='', &
- interpinic_flag='interp', readvar=readvar, data=this%Nam_patch)
-
- call restartvar(ncid=ncid, flag=flag, varname='Necm', xtype=ncd_double, &
- dim1name='pft', &
- long_name='', units='', &
- interpinic_flag='interp', readvar=readvar, data=this%Necm_patch)
-
- if (use_nitrif_denitrif) then
- call restartvar(ncid=ncid, flag=flag, varname='Nactive_no3', xtype=ncd_double, &
- dim1name='pft', &
- long_name='', units='', &
- interpinic_flag='interp', readvar=readvar, data=this%Nactive_no3_patch)
-
- call restartvar(ncid=ncid, flag=flag, varname='Nactive_nh4', xtype=ncd_double, &
- dim1name='pft', &
- long_name='', units='', &
- interpinic_flag='interp', readvar=readvar, data=this%Nactive_nh4_patch)
-
- call restartvar(ncid=ncid, flag=flag, varname='Nnonmyc_no3', xtype=ncd_double, &
- dim1name='pft', &
- long_name='', units='', &
- interpinic_flag='interp', readvar=readvar, data=this%Nnonmyc_no3_patch)
-
- call restartvar(ncid=ncid, flag=flag, varname='Nnonmyc_nh4', xtype=ncd_double, &
- dim1name='pft', &
- long_name='', units='', &
- interpinic_flag='interp', readvar=readvar, data=this%Nnonmyc_nh4_patch)
-
- call restartvar(ncid=ncid, flag=flag, varname='Nam_no3', xtype=ncd_double, &
- dim1name='pft', &
- long_name='', units='', &
- interpinic_flag='interp', readvar=readvar, data=this%Nam_no3_patch)
-
- call restartvar(ncid=ncid, flag=flag, varname='Nam_nh4', xtype=ncd_double, &
- dim1name='pft', &
- long_name='', units='', &
- interpinic_flag='interp', readvar=readvar, data=this%Nam_nh4_patch)
-
- call restartvar(ncid=ncid, flag=flag, varname='Necm_no3', xtype=ncd_double, &
- dim1name='pft', &
- long_name='', units='', &
- interpinic_flag='interp', readvar=readvar, data=this%Necm_no3_patch)
-
- call restartvar(ncid=ncid, flag=flag, varname='Necm_nh4', xtype=ncd_double, &
- dim1name='pft', &
- long_name='', units='', &
- interpinic_flag='interp', readvar=readvar, data=this%Necm_nh4_patch)
- end if
-!
- call restartvar(ncid=ncid, flag=flag, varname='Npassive', xtype=ncd_double, &
- dim1name='pft', &
- long_name='', units='', &
- interpinic_flag='interp', readvar=readvar, data=this%Npassive_patch)
-
- call restartvar(ncid=ncid, flag=flag, varname='Nfix', xtype=ncd_double, &
- dim1name='pft', &
- long_name='', units='', &
- interpinic_flag='interp', readvar=readvar, data=this%Nfix_patch)
-
- call restartvar(ncid=ncid, flag=flag, varname='Nretrans', xtype=ncd_double, &
- dim1name='pft', &
- long_name='', units='', &
- interpinic_flag='interp', readvar=readvar, data=this%Nretrans_patch)
-
- call restartvar(ncid=ncid, flag=flag, varname='Nretrans_org', xtype=ncd_double, &
- dim1name='pft', &
- long_name='', units='', &
- interpinic_flag='interp', readvar=readvar, data=this%Nretrans_org_patch)
-
- call restartvar(ncid=ncid, flag=flag, varname='Nretrans_season', xtype=ncd_double, &
- dim1name='pft', &
- long_name='', units='', &
- interpinic_flag='interp', readvar=readvar, data=this%Nretrans_season_patch)
-
- call restartvar(ncid=ncid, flag=flag, varname='Nretrans_stress', xtype=ncd_double, &
- dim1name='pft', &
- long_name='', units='', &
- interpinic_flag='interp', readvar=readvar, data=this%Nretrans_stress_patch)
-
- call restartvar(ncid=ncid, flag=flag, varname='Nuptake', xtype=ncd_double, &
- dim1name='pft', &
- long_name='', units='', &
- interpinic_flag='interp', readvar=readvar, data=this%Nuptake_patch)
-
- call restartvar(ncid=ncid, flag=flag, varname='sminn_to_plant_fun', xtype=ncd_double, &
- dim1name='pft', &
- long_name='Total soil N uptake of FUN', units='gN/m2/s', &
- interpinic_flag='interp', readvar=readvar, data=this%sminn_to_plant_fun_patch)
- end if
-
- end subroutine Restart
-
- !-----------------------------------------------------------------------
- subroutine SetValues ( this, &
- num_patch, filter_patch, value_patch, &
- num_column, filter_column, value_column)
- !
- ! !DESCRIPTION:
- ! Set nitrogen flux variables
- !
- ! !ARGUMENTS:
- ! !ARGUMENTS:
- class (cnveg_nitrogenflux_type) :: this
- integer , intent(in) :: num_patch
- integer , intent(in) :: filter_patch(:)
- real(r8), intent(in) :: value_patch
- integer , intent(in) :: num_column
- integer , intent(in) :: filter_column(:)
- real(r8), intent(in) :: value_column
- !
- ! !LOCAL VARIABLES:
- integer :: fi,i,j,k,l ! loop index
- !------------------------------------------------------------------------
-
- do fi = 1,num_patch
- i=filter_patch(fi)
-
- this%m_leafn_to_litter_patch(i) = value_patch
- this%m_frootn_to_litter_patch(i) = value_patch
- this%m_leafn_storage_to_litter_patch(i) = value_patch
- this%m_frootn_storage_to_litter_patch(i) = value_patch
- this%m_livestemn_storage_to_litter_patch(i) = value_patch
- this%m_deadstemn_storage_to_litter_patch(i) = value_patch
- this%m_livecrootn_storage_to_litter_patch(i) = value_patch
- this%m_deadcrootn_storage_to_litter_patch(i) = value_patch
- this%m_leafn_xfer_to_litter_patch(i) = value_patch
- this%m_frootn_xfer_to_litter_patch(i) = value_patch
- this%m_livestemn_xfer_to_litter_patch(i) = value_patch
- this%m_deadstemn_xfer_to_litter_patch(i) = value_patch
- this%m_livecrootn_xfer_to_litter_patch(i) = value_patch
- this%m_deadcrootn_xfer_to_litter_patch(i) = value_patch
- this%m_livestemn_to_litter_patch(i) = value_patch
- this%m_deadstemn_to_litter_patch(i) = value_patch
- this%m_livecrootn_to_litter_patch(i) = value_patch
- this%m_deadcrootn_to_litter_patch(i) = value_patch
- this%m_retransn_to_litter_patch(i) = value_patch
- this%hrv_leafn_to_litter_patch(i) = value_patch
- this%hrv_frootn_to_litter_patch(i) = value_patch
- this%hrv_leafn_storage_to_litter_patch(i) = value_patch
- this%hrv_frootn_storage_to_litter_patch(i) = value_patch
- this%hrv_livestemn_storage_to_litter_patch(i) = value_patch
- this%hrv_deadstemn_storage_to_litter_patch(i) = value_patch
- this%hrv_livecrootn_storage_to_litter_patch(i) = value_patch
- this%hrv_deadcrootn_storage_to_litter_patch(i) = value_patch
- this%hrv_leafn_xfer_to_litter_patch(i) = value_patch
- this%hrv_frootn_xfer_to_litter_patch(i) = value_patch
- this%hrv_livestemn_xfer_to_litter_patch(i) = value_patch
- this%hrv_deadstemn_xfer_to_litter_patch(i) = value_patch
- this%hrv_livecrootn_xfer_to_litter_patch(i) = value_patch
- this%hrv_deadcrootn_xfer_to_litter_patch(i) = value_patch
- this%hrv_livestemn_to_litter_patch(i) = value_patch
- this%hrv_livecrootn_to_litter_patch(i) = value_patch
- this%hrv_deadcrootn_to_litter_patch(i) = value_patch
- this%hrv_retransn_to_litter_patch(i) = value_patch
-
- this%m_leafn_to_fire_patch(i) = value_patch
- this%m_leafn_storage_to_fire_patch(i) = value_patch
- this%m_leafn_xfer_to_fire_patch(i) = value_patch
- this%m_livestemn_to_fire_patch(i) = value_patch
- this%m_livestemn_storage_to_fire_patch(i) = value_patch
- this%m_livestemn_xfer_to_fire_patch(i) = value_patch
- this%m_deadstemn_to_fire_patch(i) = value_patch
- this%m_deadstemn_storage_to_fire_patch(i) = value_patch
- this%m_deadstemn_xfer_to_fire_patch(i) = value_patch
- this%m_frootn_to_fire_patch(i) = value_patch
- this%m_frootn_storage_to_fire_patch(i) = value_patch
- this%m_frootn_xfer_to_fire_patch(i) = value_patch
- this%m_livecrootn_to_fire_patch(i) = value_patch
- this%m_livecrootn_storage_to_fire_patch(i) = value_patch
- this%m_livecrootn_xfer_to_fire_patch(i) = value_patch
- this%m_deadcrootn_to_fire_patch(i) = value_patch
- this%m_deadcrootn_storage_to_fire_patch(i) = value_patch
- this%m_deadcrootn_xfer_to_fire_patch(i) = value_patch
- this%m_retransn_to_fire_patch(i) = value_patch
-
-
- this%m_leafn_to_litter_fire_patch(i) = value_patch
- this%m_leafn_storage_to_litter_fire_patch(i) = value_patch
- this%m_leafn_xfer_to_litter_fire_patch(i) = value_patch
- this%m_livestemn_to_litter_fire_patch(i) = value_patch
- this%m_livestemn_storage_to_litter_fire_patch(i) = value_patch
- this%m_livestemn_xfer_to_litter_fire_patch(i) = value_patch
- this%m_livestemn_to_deadstemn_fire_patch(i) = value_patch
- this%m_deadstemn_to_litter_fire_patch(i) = value_patch
- this%m_deadstemn_storage_to_litter_fire_patch(i) = value_patch
- this%m_deadstemn_xfer_to_litter_fire_patch(i) = value_patch
- this%m_frootn_to_litter_fire_patch(i) = value_patch
- this%m_frootn_storage_to_litter_fire_patch(i) = value_patch
- this%m_frootn_xfer_to_litter_fire_patch(i) = value_patch
- this%m_livecrootn_to_litter_fire_patch(i) = value_patch
- this%m_livecrootn_storage_to_litter_fire_patch(i) = value_patch
- this%m_livecrootn_xfer_to_litter_fire_patch(i) = value_patch
- this%m_livecrootn_to_deadcrootn_fire_patch(i) = value_patch
- this%m_deadcrootn_to_litter_fire_patch(i) = value_patch
- this%m_deadcrootn_storage_to_litter_fire_patch(i) = value_patch
- this%m_deadcrootn_xfer_to_litter_fire_patch(i) = value_patch
- this%m_retransn_to_litter_fire_patch(i) = value_patch
-
- this%leafn_xfer_to_leafn_patch(i) = value_patch
- this%frootn_xfer_to_frootn_patch(i) = value_patch
- this%livestemn_xfer_to_livestemn_patch(i) = value_patch
- this%deadstemn_xfer_to_deadstemn_patch(i) = value_patch
- this%livecrootn_xfer_to_livecrootn_patch(i) = value_patch
- this%deadcrootn_xfer_to_deadcrootn_patch(i) = value_patch
- this%leafn_to_litter_patch(i) = value_patch
- this%leafn_to_retransn_patch(i) = value_patch
- this%frootn_to_litter_patch(i) = value_patch
- this%retransn_to_npool_patch(i) = value_patch
- this%free_retransn_to_npool_patch(i) = value_patch
- this%sminn_to_npool_patch(i) = value_patch
- this%npool_to_leafn_patch(i) = value_patch
- this%npool_to_leafn_storage_patch(i) = value_patch
- this%npool_to_frootn_patch(i) = value_patch
- this%npool_to_frootn_storage_patch(i) = value_patch
- this%npool_to_livestemn_patch(i) = value_patch
- this%npool_to_livestemn_storage_patch(i) = value_patch
- this%npool_to_deadstemn_patch(i) = value_patch
- this%npool_to_deadstemn_storage_patch(i) = value_patch
- this%npool_to_livecrootn_patch(i) = value_patch
- this%npool_to_livecrootn_storage_patch(i) = value_patch
- this%npool_to_deadcrootn_patch(i) = value_patch
- this%npool_to_deadcrootn_storage_patch(i) = value_patch
- this%leafn_storage_to_xfer_patch(i) = value_patch
- this%frootn_storage_to_xfer_patch(i) = value_patch
- this%livestemn_storage_to_xfer_patch(i) = value_patch
- this%deadstemn_storage_to_xfer_patch(i) = value_patch
- this%livecrootn_storage_to_xfer_patch(i) = value_patch
- this%deadcrootn_storage_to_xfer_patch(i) = value_patch
- this%livestemn_to_deadstemn_patch(i) = value_patch
- this%livestemn_to_retransn_patch(i) = value_patch
- this%livecrootn_to_deadcrootn_patch(i) = value_patch
- this%livecrootn_to_retransn_patch(i) = value_patch
- this%ndeploy_patch(i) = value_patch
- this%wood_harvestn_patch(i) = value_patch
- this%fire_nloss_patch(i) = value_patch
-
- this%crop_seedn_to_leaf_patch(i) = value_patch
- this%grainn_to_cropprodn_patch(i) = value_patch
- end do
-
- if ( use_crop )then
- do fi = 1,num_patch
- i = filter_patch(fi)
- this%livestemn_to_litter_patch(i) = value_patch
- this%grainn_to_food_patch(i) = value_patch
- this%grainn_to_seed_patch(i) = value_patch
- this%grainn_xfer_to_grainn_patch(i) = value_patch
- this%npool_to_grainn_patch(i) = value_patch
- this%npool_to_grainn_storage_patch(i) = value_patch
- this%grainn_storage_to_xfer_patch(i) = value_patch
- this%soyfixn_patch(i) = value_patch
- this%frootn_to_retransn_patch(i) = value_patch
- end do
- end if
-
- do j = 1, nlevdecomp_full
- do fi = 1,num_column
- i = filter_column(fi)
-
- ! phenology: litterfall and crop fluxes associated wit
- this%phenology_n_to_litr_met_n_col(i,j) = value_column
- this%phenology_n_to_litr_cel_n_col(i,j) = value_column
- this%phenology_n_to_litr_lig_n_col(i,j) = value_column
-
- ! gap mortality
- this%gap_mortality_n_to_litr_met_n_col(i,j) = value_column
- this%gap_mortality_n_to_litr_cel_n_col(i,j) = value_column
- this%gap_mortality_n_to_litr_lig_n_col(i,j) = value_column
- this%gap_mortality_n_to_cwdn_col(i,j) = value_column
-
- ! fire
- this%fire_mortality_n_to_cwdn_col(i,j) = value_column
- this%m_n_to_litr_met_fire_col(i,j) = value_column
- this%m_n_to_litr_cel_fire_col(i,j) = value_column
- this%m_n_to_litr_lig_fire_col(i,j) = value_column
-
- ! harvest
- this%harvest_n_to_litr_met_n_col(i,j) = value_column
- this%harvest_n_to_litr_cel_n_col(i,j) = value_column
- this%harvest_n_to_litr_lig_n_col(i,j) = value_column
- this%harvest_n_to_cwdn_col(i,j) = value_column
- end do
- end do
-
- do fi = 1,num_column
- i = filter_column(fi)
-
- this%grainn_to_cropprodn_col(i) = value_column
- this%fire_nloss_col(i) = value_column
-
- ! Zero p2c column fluxes
- this%fire_nloss_col(i) = value_column
- this%wood_harvestn_col(i) = value_column
- end do
-
- do k = 1, ndecomp_pools
- do fi = 1,num_column
- i = filter_column(fi)
- this%m_decomp_npools_to_fire_col(i,k) = value_column
- end do
- end do
-
- do k = 1, ndecomp_pools
- do j = 1, nlevdecomp_full
- do fi = 1,num_column
- i = filter_column(fi)
- this%m_decomp_npools_to_fire_vr_col(i,j,k) = value_column
- end do
- end do
- end do
-
- end subroutine SetValues
-
-end module CNVegNitrogenFluxType
-
diff --git a/src/biogeochem/CNVegNitrogenStateType.F90 b/src/biogeochem/CNVegNitrogenStateType.F90
deleted file mode 100644
index 5910caad..00000000
--- a/src/biogeochem/CNVegNitrogenStateType.F90
+++ /dev/null
@@ -1,911 +0,0 @@
-module CNVegNitrogenStateType
-
-#include "shr_assert.h"
-
- use shr_kind_mod , only : r8 => shr_kind_r8
- use shr_infnan_mod , only : isnan => shr_infnan_isnan, nan => shr_infnan_nan, assignment(=)
- use shr_log_mod , only : errMsg => shr_log_errMsg
- use clm_varpar , only : ndecomp_cascade_transitions, ndecomp_pools, nlevcan
- use clm_varpar , only : nlevdecomp_full, nlevdecomp
- use clm_varcon , only : spval, ispval, dzsoi_decomp, zisoi
- use landunit_varcon , only : istcrop, istsoil
- use clm_varctl , only : use_nitrif_denitrif, use_vertsoilc, use_century_decomp
- use clm_varctl , only : iulog, override_bgc_restart_mismatch_dump
- use clm_varctl , only : use_crop
- use CNSharedParamsMod , only : use_fun
- use decompMod , only : bounds_type
- use pftconMod , only : npcropmin, noveg, pftcon
- use SoilBiogeochemDecompCascadeConType , only : decomp_cascade_con
- use abortutils , only : endrun
- use spmdMod , only : masterproc
- use LandunitType , only : lun
- use ColumnType , only : col
- use PatchType , only : patch
- use CNSpeciesMod , only : CN_SPECIES_N
- use CNVegComputeSeedMod, only : ComputeSeedAmounts
- !
- ! !PUBLIC TYPES:
- implicit none
-
- private
-
-
- !
- type, public :: cnveg_nitrogenstate_type
-
- real(r8), pointer :: grainn_patch (:) ! (gN/m2) grain N (crop)
- real(r8), pointer :: grainn_storage_patch (:) ! (gN/m2) grain N storage (crop)
- real(r8), pointer :: grainn_xfer_patch (:) ! (gN/m2) grain N transfer (crop)
- real(r8), pointer :: leafn_patch (:) ! (gN/m2) leaf N
- real(r8), pointer :: leafn_storage_patch (:) ! (gN/m2) leaf N storage
- real(r8), pointer :: leafn_xfer_patch (:) ! (gN/m2) leaf N transfer
- real(r8), pointer :: leafn_storage_xfer_acc_patch (:) ! (gN/m2) Accmulated leaf N transfer
- real(r8), pointer :: storage_ndemand_patch (:) ! (gN/m2) N demand during the offset period
- real(r8), pointer :: frootn_patch (:) ! (gN/m2) fine root N
- real(r8), pointer :: frootn_storage_patch (:) ! (gN/m2) fine root N storage
- real(r8), pointer :: frootn_xfer_patch (:) ! (gN/m2) fine root N transfer
- real(r8), pointer :: livestemn_patch (:) ! (gN/m2) live stem N
- real(r8), pointer :: livestemn_storage_patch (:) ! (gN/m2) live stem N storage
- real(r8), pointer :: livestemn_xfer_patch (:) ! (gN/m2) live stem N transfer
- real(r8), pointer :: deadstemn_patch (:) ! (gN/m2) dead stem N
- real(r8), pointer :: deadstemn_storage_patch (:) ! (gN/m2) dead stem N storage
- real(r8), pointer :: deadstemn_xfer_patch (:) ! (gN/m2) dead stem N transfer
- real(r8), pointer :: livecrootn_patch (:) ! (gN/m2) live coarse root N
- real(r8), pointer :: livecrootn_storage_patch (:) ! (gN/m2) live coarse root N storage
- real(r8), pointer :: livecrootn_xfer_patch (:) ! (gN/m2) live coarse root N transfer
- real(r8), pointer :: deadcrootn_patch (:) ! (gN/m2) dead coarse root N
- real(r8), pointer :: deadcrootn_storage_patch (:) ! (gN/m2) dead coarse root N storage
- real(r8), pointer :: deadcrootn_xfer_patch (:) ! (gN/m2) dead coarse root N transfer
- real(r8), pointer :: retransn_patch (:) ! (gN/m2) plant pool of retranslocated N
- real(r8), pointer :: npool_patch (:) ! (gN/m2) temporary plant N pool
- real(r8), pointer :: ntrunc_patch (:) ! (gN/m2) patch-level sink for N truncation
- real(r8), pointer :: cropseedn_deficit_patch (:) ! (gN/m2) pool for seeding new crop growth; this is a NEGATIVE term, indicating the amount of seed usage that needs to be repaid
- real(r8), pointer :: seedn_grc (:) ! (gN/m2) gridcell-level pool for seeding new pFTs via dynamic landcover
-
- ! summary (diagnostic) state variables, not involved in mass balance
- real(r8), pointer :: dispvegn_patch (:) ! (gN/m2) displayed veg nitrogen, excluding storage
- real(r8), pointer :: storvegn_patch (:) ! (gN/m2) stored vegetation nitrogen
- real(r8), pointer :: totvegn_patch (:) ! (gN/m2) total vegetation nitrogen
- real(r8), pointer :: totvegn_col (:) ! (gN/m2) total vegetation nitrogen (p2c)
- real(r8), pointer :: totn_patch (:) ! (gN/m2) total patch-level nitrogen
- real(r8), pointer :: totn_p2c_col (:) ! (gN/m2) totn_patch averaged to col
- real(r8), pointer :: totn_col (:) ! (gN/m2) total column nitrogen, incl veg
- real(r8), pointer :: totecosysn_col (:) ! (gN/m2) total ecosystem nitrogen, incl veg
-
- contains
-
- procedure , public :: Init
- procedure , public :: Restart
- procedure , public :: SetValues
- procedure , private :: InitAllocate
- procedure , private :: InitHistory
- procedure , private :: InitCold
-
- end type cnveg_nitrogenstate_type
- !------------------------------------------------------------------------
-
- ! !PRIVATE DATA:
- character(len=*), parameter :: sourcefile = &
- __FILE__
-
-contains
-
- !------------------------------------------------------------------------
- subroutine Init(this, bounds, &
- leafc_patch, leafc_storage_patch, frootc_patch, frootc_storage_patch, deadstemc_patch)
-
- class(cnveg_nitrogenstate_type) :: this
- type(bounds_type) , intent(in) :: bounds
- real(r8) , intent(in) :: leafc_patch (bounds%begp:)
- real(r8) , intent(in) :: leafc_storage_patch (bounds%begp:)
- real(r8) , intent(in) :: frootc_patch (bounds%begp:)
- real(r8) , intent(in) :: frootc_storage_patch (bounds%begp:)
- real(r8) , intent(in) :: deadstemc_patch (bounds%begp:)
-
- call this%InitAllocate (bounds )
- call this%InitHistory (bounds)
- call this%InitCold ( bounds, &
- leafc_patch, leafc_storage_patch, frootc_patch, frootc_storage_patch, deadstemc_patch)
-
- end subroutine Init
-
- !------------------------------------------------------------------------
- subroutine InitAllocate(this, bounds)
- !
- ! !ARGUMENTS:
- class (cnveg_nitrogenstate_type) :: this
- type(bounds_type) , intent(in) :: bounds
- !
- ! !LOCAL VARIABLES:
- integer :: begp,endp
- integer :: begc,endc
- integer :: begg,endg
- !------------------------------------------------------------------------
-
- begp = bounds%begp; endp = bounds%endp
- begc = bounds%begc; endc = bounds%endc
- begg = bounds%begg; endg = bounds%endg
-
- allocate(this%grainn_patch (begp:endp)) ; this%grainn_patch (:) = nan
- allocate(this%grainn_storage_patch (begp:endp)) ; this%grainn_storage_patch (:) = nan
- allocate(this%grainn_xfer_patch (begp:endp)) ; this%grainn_xfer_patch (:) = nan
- allocate(this%leafn_patch (begp:endp)) ; this%leafn_patch (:) = nan
- allocate(this%leafn_storage_patch (begp:endp)) ; this%leafn_storage_patch (:) = nan
- allocate(this%leafn_xfer_patch (begp:endp)) ; this%leafn_xfer_patch (:) = nan
- allocate(this%leafn_storage_xfer_acc_patch (begp:endp)) ; this%leafn_storage_xfer_acc_patch (:) = nan
- allocate(this%storage_ndemand_patch (begp:endp)) ; this%storage_ndemand_patch (:) = nan
- allocate(this%frootn_patch (begp:endp)) ; this%frootn_patch (:) = nan
- allocate(this%frootn_storage_patch (begp:endp)) ; this%frootn_storage_patch (:) = nan
- allocate(this%frootn_xfer_patch (begp:endp)) ; this%frootn_xfer_patch (:) = nan
- allocate(this%livestemn_patch (begp:endp)) ; this%livestemn_patch (:) = nan
- allocate(this%livestemn_storage_patch (begp:endp)) ; this%livestemn_storage_patch (:) = nan
- allocate(this%livestemn_xfer_patch (begp:endp)) ; this%livestemn_xfer_patch (:) = nan
- allocate(this%deadstemn_patch (begp:endp)) ; this%deadstemn_patch (:) = nan
- allocate(this%deadstemn_storage_patch (begp:endp)) ; this%deadstemn_storage_patch (:) = nan
- allocate(this%deadstemn_xfer_patch (begp:endp)) ; this%deadstemn_xfer_patch (:) = nan
- allocate(this%livecrootn_patch (begp:endp)) ; this%livecrootn_patch (:) = nan
- allocate(this%livecrootn_storage_patch (begp:endp)) ; this%livecrootn_storage_patch (:) = nan
- allocate(this%livecrootn_xfer_patch (begp:endp)) ; this%livecrootn_xfer_patch (:) = nan
- allocate(this%deadcrootn_patch (begp:endp)) ; this%deadcrootn_patch (:) = nan
- allocate(this%deadcrootn_storage_patch (begp:endp)) ; this%deadcrootn_storage_patch (:) = nan
- allocate(this%deadcrootn_xfer_patch (begp:endp)) ; this%deadcrootn_xfer_patch (:) = nan
- allocate(this%retransn_patch (begp:endp)) ; this%retransn_patch (:) = nan
- allocate(this%npool_patch (begp:endp)) ; this%npool_patch (:) = nan
- allocate(this%ntrunc_patch (begp:endp)) ; this%ntrunc_patch (:) = nan
- allocate(this%dispvegn_patch (begp:endp)) ; this%dispvegn_patch (:) = nan
- allocate(this%storvegn_patch (begp:endp)) ; this%storvegn_patch (:) = nan
- allocate(this%totvegn_patch (begp:endp)) ; this%totvegn_patch (:) = nan
- allocate(this%totn_patch (begp:endp)) ; this%totn_patch (:) = nan
-
- allocate(this%cropseedn_deficit_patch (begp:endp)) ; this%cropseedn_deficit_patch (:) = nan
- allocate(this%seedn_grc (begg:endg)) ; this%seedn_grc (:) = nan
- allocate(this%totvegn_col (begc:endc)) ; this%totvegn_col (:) = nan
- allocate(this%totn_p2c_col (begc:endc)) ; this%totn_p2c_col (:) = nan
- allocate(this%totn_col (begc:endc)) ; this%totn_col (:) = nan
- allocate(this%totecosysn_col (begc:endc)) ; this%totecosysn_col (:) = nan
-
- end subroutine InitAllocate
-
- !------------------------------------------------------------------------
- subroutine InitHistory(this, bounds)
- !
- ! !DESCRIPTION:
- ! add history fields for all CN variables, always set as default='inactive'
- !
- ! !USES:
- use histFileMod, only : hist_addfld1d
- !
- ! !ARGUMENTS:
- class(cnveg_nitrogenstate_type) :: this
- type(bounds_type) , intent(in) :: bounds
- !
- ! !LOCAL VARIABLES:
- integer :: k,l,ii,jj
- integer :: begp,endp
- integer :: begc,endc
- integer :: begg,endg
- character(24) :: fieldname
- character(100) :: longname
- real(r8), pointer :: data1dptr(:) ! temp. pointer for slicing larger arrays
- !---------------------------------------------------------------------
-
- begp = bounds%begp; endp = bounds%endp
- begc = bounds%begc; endc = bounds%endc
- begg = bounds%begg; endg = bounds%endg
-
- !-------------------------------
- ! patch state variables
- !-------------------------------
-
- if (use_crop) then
- this%grainn_patch(begp:endp) = spval
- call hist_addfld1d (fname='GRAINN', units='gN/m^2', &
- avgflag='A', long_name='grain N', &
- ptr_patch=this%grainn_patch, default='inactive')
- call hist_addfld1d (fname='CROPSEEDN_DEFICIT', units='gN/m^2', &
- avgflag='A', long_name='N used for crop seed that needs to be repaid', &
- ptr_patch=this%cropseedn_deficit_patch, default='inactive')
- end if
-
- this%leafn_patch(begp:endp) = spval
- call hist_addfld1d (fname='LEAFN', units='gN/m^2', &
- avgflag='A', long_name='leaf N', &
- ptr_patch=this%leafn_patch, default='inactive')
-
- this%leafn_storage_patch(begp:endp) = spval
- call hist_addfld1d (fname='LEAFN_STORAGE', units='gN/m^2', &
- avgflag='A', long_name='leaf N storage', &
- ptr_patch=this%leafn_storage_patch, default='inactive')
-
- this%leafn_xfer_patch(begp:endp) = spval
- call hist_addfld1d (fname='LEAFN_XFER', units='gN/m^2', &
- avgflag='A', long_name='leaf N transfer', &
- ptr_patch=this%leafn_xfer_patch, default='inactive')
-
- if ( use_fun ) then
- this%leafn_storage_xfer_acc_patch(begp:endp) = spval
- call hist_addfld1d (fname='LEAFN_STORAGE_XFER_ACC', units='gN/m^2', &
- avgflag='A', long_name='Accmulated leaf N transfer', &
- ptr_patch=this%leafn_storage_xfer_acc_patch, default='inactive')
-
- this%storage_ndemand_patch(begp:endp) = spval
- call hist_addfld1d (fname='STORAGE_NDEMAND', units='gN/m^2', &
- avgflag='A', long_name='N demand during the offset period', &
- ptr_patch=this%storage_ndemand_patch, default='inactive')
- end if
-
- this%frootn_patch(begp:endp) = spval
- call hist_addfld1d (fname='FROOTN', units='gN/m^2', &
- avgflag='A', long_name='fine root N', &
- ptr_patch=this%frootn_patch, default='inactive')
-
- this%frootn_storage_patch(begp:endp) = spval
- call hist_addfld1d (fname='FROOTN_STORAGE', units='gN/m^2', &
- avgflag='A', long_name='fine root N storage', &
- ptr_patch=this%frootn_storage_patch, default='inactive')
-
- this%frootn_xfer_patch(begp:endp) = spval
- call hist_addfld1d (fname='FROOTN_XFER', units='gN/m^2', &
- avgflag='A', long_name='fine root N transfer', &
- ptr_patch=this%frootn_xfer_patch, default='inactive')
-
- this%livestemn_patch(begp:endp) = spval
- call hist_addfld1d (fname='LIVESTEMN', units='gN/m^2', &
- avgflag='A', long_name='live stem N', &
- ptr_patch=this%livestemn_patch, default='inactive')
-
- this%livestemn_storage_patch(begp:endp) = spval
- call hist_addfld1d (fname='LIVESTEMN_STORAGE', units='gN/m^2', &
- avgflag='A', long_name='live stem N storage', &
- ptr_patch=this%livestemn_storage_patch, default='inactive')
-
- this%livestemn_xfer_patch(begp:endp) = spval
- call hist_addfld1d (fname='LIVESTEMN_XFER', units='gN/m^2', &
- avgflag='A', long_name='live stem N transfer', &
- ptr_patch=this%livestemn_xfer_patch, default='inactive')
-
- this%deadstemn_patch(begp:endp) = spval
- call hist_addfld1d (fname='DEADSTEMN', units='gN/m^2', &
- avgflag='A', long_name='dead stem N', &
- ptr_patch=this%deadstemn_patch, default='inactive')
-
- this%deadstemn_storage_patch(begp:endp) = spval
- call hist_addfld1d (fname='DEADSTEMN_STORAGE', units='gN/m^2', &
- avgflag='A', long_name='dead stem N storage', &
- ptr_patch=this%deadstemn_storage_patch, default='inactive')
-
- this%deadstemn_xfer_patch(begp:endp) = spval
- call hist_addfld1d (fname='DEADSTEMN_XFER', units='gN/m^2', &
- avgflag='A', long_name='dead stem N transfer', &
- ptr_patch=this%deadstemn_xfer_patch, default='inactive')
-
- this%livecrootn_patch(begp:endp) = spval
- call hist_addfld1d (fname='LIVECROOTN', units='gN/m^2', &
- avgflag='A', long_name='live coarse root N', &
- ptr_patch=this%livecrootn_patch, default='inactive')
-
- this%livecrootn_storage_patch(begp:endp) = spval
- call hist_addfld1d (fname='LIVECROOTN_STORAGE', units='gN/m^2', &
- avgflag='A', long_name='live coarse root N storage', &
- ptr_patch=this%livecrootn_storage_patch, default='inactive')
-
- this%livecrootn_xfer_patch(begp:endp) = spval
- call hist_addfld1d (fname='LIVECROOTN_XFER', units='gN/m^2', &
- avgflag='A', long_name='live coarse root N transfer', &
- ptr_patch=this%livecrootn_xfer_patch, default='inactive')
-
- this%deadcrootn_patch(begp:endp) = spval
- call hist_addfld1d (fname='DEADCROOTN', units='gN/m^2', &
- avgflag='A', long_name='dead coarse root N', &
- ptr_patch=this%deadcrootn_patch, default='inactive')
-
- this%deadcrootn_storage_patch(begp:endp) = spval
- call hist_addfld1d (fname='DEADCROOTN_STORAGE', units='gN/m^2', &
- avgflag='A', long_name='dead coarse root N storage', &
- ptr_patch=this%deadcrootn_storage_patch, default='inactive')
-
- this%deadcrootn_xfer_patch(begp:endp) = spval
- call hist_addfld1d (fname='DEADCROOTN_XFER', units='gN/m^2', &
- avgflag='A', long_name='dead coarse root N transfer', &
- ptr_patch=this%deadcrootn_xfer_patch, default='inactive')
-
- this%retransn_patch(begp:endp) = spval
- call hist_addfld1d (fname='RETRANSN', units='gN/m^2', &
- avgflag='A', long_name='plant pool of retranslocated N', &
- ptr_patch=this%retransn_patch, default='inactive')
-
- this%npool_patch(begp:endp) = spval
- call hist_addfld1d (fname='NPOOL', units='gN/m^2', &
- avgflag='A', long_name='temporary plant N pool', &
- ptr_patch=this%npool_patch, default='inactive')
-
- this%ntrunc_patch(begp:endp) = spval
- call hist_addfld1d (fname='PFT_NTRUNC', units='gN/m^2', &
- avgflag='A', long_name='patch-level sink for N truncation', &
- ptr_patch=this%ntrunc_patch, default='inactive')
-
- this%dispvegn_patch(begp:endp) = spval
- call hist_addfld1d (fname='DISPVEGN', units='gN/m^2', &
- avgflag='A', long_name='displayed vegetation nitrogen', &
- ptr_patch=this%dispvegn_patch, default='inactive')
-
- this%storvegn_patch(begp:endp) = spval
- call hist_addfld1d (fname='STORVEGN', units='gN/m^2', &
- avgflag='A', long_name='stored vegetation nitrogen', &
- ptr_patch=this%storvegn_patch, default='inactive')
-
- this%totvegn_patch(begp:endp) = spval
- call hist_addfld1d (fname='TOTVEGN', units='gN/m^2', &
- avgflag='A', long_name='total vegetation nitrogen', &
- ptr_patch=this%totvegn_patch, default='inactive')
-
- this%totn_patch(begp:endp) = spval
- call hist_addfld1d (fname='TOTPFTN', units='gN/m^2', &
- avgflag='A', long_name='total patch-level nitrogen', &
- ptr_patch=this%totn_patch, default='inactive')
-
- !-------------------------------
- ! column state variables
- !-------------------------------
-
- this%seedn_grc(begg:endg) = spval
- call hist_addfld1d (fname='SEEDN', units='gN/m^2', &
- avgflag='A', long_name='pool for seeding new PFTs via dynamic landcover', &
- ptr_gcell=this%seedn_grc, default='inactive')
-
- this%totecosysn_col(begc:endc) = spval
- call hist_addfld1d (fname='TOTECOSYSN', units='gN/m^2', &
- avgflag='A', long_name='total ecosystem N, excluding product pools', &
- ptr_col=this%totecosysn_col, default='inactive')
-
- this%totn_col(begc:endc) = spval
- call hist_addfld1d (fname='TOTCOLN', units='gN/m^2', &
- avgflag='A', long_name='total column-level N, excluding product pools', &
- ptr_col=this%totn_col, default='inactive')
-
- end subroutine InitHistory
-
- !-----------------------------------------------------------------------
- subroutine InitCold(this, bounds, &
- leafc_patch, leafc_storage_patch, frootc_patch, frootc_storage_patch, deadstemc_patch)
- !
- ! !DESCRIPTION:
- ! Initializes time varying variables used only in coupled carbon-nitrogen mode (CN):
- !
- use clm_varctl , only : MM_Nuptake_opt
- ! !ARGUMENTS:
- class(cnveg_nitrogenstate_type) :: this
- type(bounds_type) , intent(in) :: bounds
- real(r8) , intent(in) :: leafc_patch(bounds%begp:)
- real(r8) , intent(in) :: leafc_storage_patch(bounds%begp:)
- real(r8) , intent(in) :: frootc_patch(bounds%begp:)
- real(r8) , intent(in) :: frootc_storage_patch(bounds%begp:)
- real(r8) , intent(in) :: deadstemc_patch(bounds%begp:)
- !
- ! !LOCAL VARIABLES:
- integer :: fc,fp,g,l,c,p,j,k ! indices
- integer :: num_special_col ! number of good values in special_col filter
- integer :: num_special_patch ! number of good values in special_patch filter
- integer :: special_col (bounds%endc-bounds%begc+1) ! special landunit filter - columns
- integer :: special_patch (bounds%endp-bounds%begp+1) ! special landunit filter - patches
- !------------------------------------------------------------------------
-
- SHR_ASSERT_ALL((ubound(leafc_patch) == (/bounds%endp/)), errMsg(sourcefile, __LINE__))
- SHR_ASSERT_ALL((ubound(leafc_storage_patch) == (/bounds%endp/)), errMsg(sourcefile, __LINE__))
- SHR_ASSERT_ALL((ubound(frootc_patch) == (/bounds%endp/)), errMsg(sourcefile, __LINE__))
- SHR_ASSERT_ALL((ubound(frootc_storage_patch) == (/bounds%endp/)), errMsg(sourcefile, __LINE__))
- SHR_ASSERT_ALL((ubound(deadstemc_patch) == (/bounds%endp/)), errMsg(sourcefile, __LINE__))
-
- ! Set column filters
-
- num_special_patch = 0
- do p = bounds%begp,bounds%endp
- l = patch%landunit(p)
- if (lun%ifspecial(l)) then
- num_special_patch = num_special_patch + 1
- special_patch(num_special_patch) = p
- end if
- end do
-
- ! Set patch filters
-
- num_special_col = 0
- do c = bounds%begc, bounds%endc
- l = col%landunit(c)
- if (lun%ifspecial(l)) then
- num_special_col = num_special_col + 1
- special_col(num_special_col) = c
- end if
- end do
-
- !-------------------------------------------
- ! initialize patch-level variables
- !-------------------------------------------
-
- do p = bounds%begp,bounds%endp
-
- l = patch%landunit(p)
- if (lun%itype(l) == istsoil .or. lun%itype(l) == istcrop) then
-
- if (patch%itype(p) == noveg) then
- this%leafn_patch(p) = 0._r8
- this%leafn_storage_patch(p) = 0._r8
- if (MM_Nuptake_opt .eqv. .true.) then
- this%frootn_patch(p) = 0._r8
- this%frootn_storage_patch(p) = 0._r8
- end if
- else
- this%leafn_patch(p) = leafc_patch(p) / pftcon%leafcn(patch%itype(p))
- this%leafn_storage_patch(p) = leafc_storage_patch(p) / pftcon%leafcn(patch%itype(p))
- if (MM_Nuptake_opt .eqv. .true.) then
- this%frootn_patch(p) = frootc_patch(p) / pftcon%frootcn(patch%itype(p))
- this%frootn_storage_patch(p) = frootc_storage_patch(p) / pftcon%frootcn(patch%itype(p))
- end if
- end if
-
- this%leafn_xfer_patch(p) = 0._r8
-
- this%leafn_storage_xfer_acc_patch(p) = 0._r8
- this%storage_ndemand_patch(p) = 0._r8
-
- if ( use_crop )then
- this%grainn_patch(p) = 0._r8
- this%grainn_storage_patch(p) = 0._r8
- this%grainn_xfer_patch(p) = 0._r8
- this%cropseedn_deficit_patch(p) = 0._r8
- end if
- if (MM_Nuptake_opt .eqv. .false.) then ! if not running in floating CN ratio option
- this%frootn_patch(p) = 0._r8
- this%frootn_storage_patch(p) = 0._r8
- end if
- this%frootn_xfer_patch(p) = 0._r8
- this%livestemn_patch(p) = 0._r8
- this%livestemn_storage_patch(p) = 0._r8
- this%livestemn_xfer_patch(p) = 0._r8
-
- ! tree types need to be initialized with some stem mass so that
- ! roughness length is not zero in canopy flux calculation
-
- if (pftcon%woody(patch%itype(p)) == 1._r8) then
- this%deadstemn_patch(p) = deadstemc_patch(p) / pftcon%deadwdcn(patch%itype(p))
- else
- this%deadstemn_patch(p) = 0._r8
- end if
-
- this%deadstemn_storage_patch(p) = 0._r8
- this%deadstemn_xfer_patch(p) = 0._r8
- this%livecrootn_patch(p) = 0._r8
- this%livecrootn_storage_patch(p) = 0._r8
- this%livecrootn_xfer_patch(p) = 0._r8
- this%deadcrootn_patch(p) = 0._r8
- this%deadcrootn_storage_patch(p) = 0._r8
- this%deadcrootn_xfer_patch(p) = 0._r8
- this%retransn_patch(p) = 0._r8
- this%npool_patch(p) = 0._r8
- this%ntrunc_patch(p) = 0._r8
- this%dispvegn_patch(p) = 0._r8
- this%storvegn_patch(p) = 0._r8
- this%totvegn_patch(p) = 0._r8
- this%totn_patch(p) = 0._r8
- end if
- end do
-
- !-------------------------------------------
- ! initialize column-level variables
- !-------------------------------------------
-
- do c = bounds%begc, bounds%endc
- l = col%landunit(c)
- if (lun%itype(l) == istsoil .or. lun%itype(l) == istcrop) then
- ! total nitrogen pools
- this%totecosysn_col(c) = 0._r8
- this%totn_p2c_col(c) = 0._r8
- this%totn_col(c) = 0._r8
- end if
- end do
-
-
- do g = bounds%begg, bounds%endg
- this%seedn_grc(g) = 0._r8
- end do
-
- ! now loop through special filters and explicitly set the variables that
- ! have to be in place for biogeophysics
-
- ! initialize fields for special filters
-
- call this%SetValues (&
- num_patch=num_special_patch, filter_patch=special_patch, value_patch=0._r8, &
- num_column=num_special_col, filter_column=special_col, value_column=0._r8)
-
- end subroutine InitCold
-
- !-----------------------------------------------------------------------
- subroutine Restart ( this, bounds, ncid, flag, leafc_patch, &
- leafc_storage_patch, frootc_patch, frootc_storage_patch, &
- deadstemc_patch, filter_reseed_patch, num_reseed_patch )
- !
- ! !DESCRIPTION:
- ! Read/write restart data
- !
- ! !USES:
- use restUtilMod
- use ncdio_pio
- use clm_varctl , only : spinup_state, use_cndv
- use clm_time_manager , only : get_nstep, is_restart
- use clm_varctl , only : MM_Nuptake_opt
-
- !
- ! !ARGUMENTS:
- class (cnveg_nitrogenstate_type) :: this
- type(bounds_type) , intent(in) :: bounds
- type(file_desc_t) , intent(inout) :: ncid
- character(len=*) , intent(in) :: flag !'read' or 'write' or 'define'
- real(r8) , intent(in) :: leafc_patch(bounds%begp:)
- real(r8) , intent(in) :: leafc_storage_patch(bounds%begp:)
- real(r8) , intent(in) :: frootc_patch(bounds%begp:)
- real(r8) , intent(in) :: frootc_storage_patch(bounds%begp:)
- real(r8) , intent(in) :: deadstemc_patch(bounds%begp:)
- integer , intent(in) :: filter_reseed_patch(:)
- integer , intent(in) :: num_reseed_patch
- !
- ! !LOCAL VARIABLES:
- integer :: i, p, l
- logical :: readvar
- real(r8), pointer :: ptr1d(:) ! temp. pointers for slicing larger arrays
- character(len=128) :: varname ! temporary
- logical :: exit_spinup = .false.
- logical :: enter_spinup = .false.
- integer :: idata
-
- ! spinup state as read from restart file, for determining whether to enter or exit spinup mode.
- integer :: restart_file_spinup_state
-
- !------------------------------------------------------------------------
-
- !--------------------------------
- ! patch nitrogen state variables
- !--------------------------------
-
- call restartvar(ncid=ncid, flag=flag, varname='leafn', xtype=ncd_double, &
- dim1name='pft', long_name='', units='', &
- interpinic_flag='interp', readvar=readvar, data=this%leafn_patch)
-
- call restartvar(ncid=ncid, flag=flag, varname='leafn_storage', xtype=ncd_double, &
- dim1name='pft', long_name='', units='', &
- interpinic_flag='interp', readvar=readvar, data=this%leafn_storage_patch)
-
- call restartvar(ncid=ncid, flag=flag, varname='leafn_xfer', xtype=ncd_double, &
- dim1name='pft', long_name='', units='', &
- interpinic_flag='interp', readvar=readvar, data=this%leafn_xfer_patch)
-
- if ( use_fun ) then
- call restartvar(ncid=ncid, flag=flag, varname='leafn_storage_xfer_acc', xtype=ncd_double, &
- dim1name='pft', long_name='', units='', &
- interpinic_flag='interp', readvar=readvar, data=this%leafn_storage_xfer_acc_patch)
-
- call restartvar(ncid=ncid, flag=flag, varname='storage_ndemand', xtype=ncd_double, &
- dim1name='pft', long_name='', units='', &
- interpinic_flag='interp', readvar=readvar, data=this%storage_ndemand_patch)
- end if
-
-
- call restartvar(ncid=ncid, flag=flag, varname='frootn', xtype=ncd_double, &
- dim1name='pft', long_name='', units='', &
- interpinic_flag='interp', readvar=readvar, data=this%frootn_patch)
-
- call restartvar(ncid=ncid, flag=flag, varname='frootn_storage', xtype=ncd_double, &
- dim1name='pft', long_name='', units='', &
- interpinic_flag='interp', readvar=readvar, data=this%frootn_storage_patch)
-
- call restartvar(ncid=ncid, flag=flag, varname='frootn_xfer', xtype=ncd_double, &
- dim1name='pft', long_name='', units='', &
- interpinic_flag='interp', readvar=readvar, data=this%frootn_xfer_patch)
-
- call restartvar(ncid=ncid, flag=flag, varname='livestemn', xtype=ncd_double, &
- dim1name='pft', long_name='', units='', &
- interpinic_flag='interp', readvar=readvar, data=this%livestemn_patch)
-
- call restartvar(ncid=ncid, flag=flag, varname='livestemn_storage', xtype=ncd_double, &
- dim1name='pft', long_name='', units='', &
- interpinic_flag='interp', readvar=readvar, data=this%livestemn_storage_patch)
-
- call restartvar(ncid=ncid, flag=flag, varname='livestemn_xfer', xtype=ncd_double, &
- dim1name='pft', long_name='', units='', &
- interpinic_flag='interp', readvar=readvar, data=this%livestemn_xfer_patch)
-
- call restartvar(ncid=ncid, flag=flag, varname='deadstemn', xtype=ncd_double, &
- dim1name='pft', long_name='', units='', &
- interpinic_flag='interp', readvar=readvar, data=this%deadstemn_patch)
-
- call restartvar(ncid=ncid, flag=flag, varname='deadstemn_storage', xtype=ncd_double, &
- dim1name='pft', long_name='', units='', &
- interpinic_flag='interp', readvar=readvar, data=this%deadstemn_storage_patch)
-
- call restartvar(ncid=ncid, flag=flag, varname='deadstemn_xfer', xtype=ncd_double, &
- dim1name='pft', long_name='', units='', &
- interpinic_flag='interp', readvar=readvar, data=this%deadstemn_xfer_patch)
-
- call restartvar(ncid=ncid, flag=flag, varname='livecrootn', xtype=ncd_double, &
- dim1name='pft', long_name='', units='', &
- interpinic_flag='interp', readvar=readvar, data=this%livecrootn_patch)
-
- call restartvar(ncid=ncid, flag=flag, varname='livecrootn_storage', xtype=ncd_double, &
- dim1name='pft', long_name='', units='', &
- interpinic_flag='interp', readvar=readvar, data=this%livecrootn_storage_patch)
-
- call restartvar(ncid=ncid, flag=flag, varname='livecrootn_xfer', xtype=ncd_double, &
- dim1name='pft', long_name='', units='', &
- interpinic_flag='interp', readvar=readvar, data=this%livecrootn_xfer_patch)
-
- call restartvar(ncid=ncid, flag=flag, varname='deadcrootn', xtype=ncd_double, &
- dim1name='pft', long_name='', units='', &
- interpinic_flag='interp', readvar=readvar, data=this%deadcrootn_patch)
-
- call restartvar(ncid=ncid, flag=flag, varname='deadcrootn_storage', xtype=ncd_double, &
- dim1name='pft', long_name='', units='', &
- interpinic_flag='interp', readvar=readvar, data=this%deadcrootn_storage_patch)
-
- call restartvar(ncid=ncid, flag=flag, varname='deadcrootn_xfer', xtype=ncd_double, &
- dim1name='pft', long_name='', units='', &
- interpinic_flag='interp', readvar=readvar, data=this%deadcrootn_xfer_patch)
-
- call restartvar(ncid=ncid, flag=flag, varname='retransn', xtype=ncd_double, &
- dim1name='pft', long_name='', units='', &
- interpinic_flag='interp', readvar=readvar, data=this%retransn_patch)
-
- call restartvar(ncid=ncid, flag=flag, varname='npool', xtype=ncd_double, &
- dim1name='pft', long_name='', units='', &
- interpinic_flag='interp', readvar=readvar, data=this%npool_patch)
-
- call restartvar(ncid=ncid, flag=flag, varname='pft_ntrunc', xtype=ncd_double, &
- dim1name='pft', long_name='', units='', &
- interpinic_flag='interp', readvar=readvar, data=this%ntrunc_patch)
-
- if (use_crop) then
- call restartvar(ncid=ncid, flag=flag, varname='grainn', xtype=ncd_double, &
- dim1name='pft', long_name='grain N', units='gN/m2', &
- interpinic_flag='interp', readvar=readvar, data=this%grainn_patch)
-
- call restartvar(ncid=ncid, flag=flag, varname='grainn_storage', xtype=ncd_double, &
- dim1name='pft', long_name='grain N storage', units='gN/m2', &
- interpinic_flag='interp', readvar=readvar, data=this%grainn_storage_patch)
-
- call restartvar(ncid=ncid, flag=flag, varname='grainn_xfer', xtype=ncd_double, &
- dim1name='pft', long_name='grain N transfer', units='gN/m2', &
- interpinic_flag='interp', readvar=readvar, data=this%grainn_xfer_patch)
-
- call restartvar(ncid=ncid, flag=flag, varname='cropseedn_deficit', xtype=ncd_double, &
- dim1name='pft', long_name='pool for seeding new crop growth', units='gN/m2', &
- interpinic_flag='interp', readvar=readvar, data=this%cropseedn_deficit_patch)
- end if
-
- !--------------------------------
- ! gridcell nitrogen state variables
- !--------------------------------
-
- ! BACKWARDS_COMPATIBILITY(wjs, 2017-01-12) Naming this with a _g suffix in order to
- ! distinguish it from the old column-level seedn restart variable
- call restartvar(ncid=ncid, flag=flag, varname='seedn_g', xtype=ncd_double, &
- dim1name='gridcell', long_name='', units='', &
- interpinic_flag='interp', readvar=readvar, data=this%seedn_grc)
-
-
- if (flag == 'read') then
- call restartvar(ncid=ncid, flag=flag, varname='spinup_state', xtype=ncd_int, &
- long_name='Spinup state of the model that wrote this restart file: ' &
- // ' 0 = normal model mode, 1 = AD spinup', units='', &
- interpinic_flag='copy', readvar=readvar, data=idata)
-
- if (readvar) then
- restart_file_spinup_state = idata
- else
- restart_file_spinup_state = spinup_state
- if ( masterproc ) then
- write(iulog,*) ' CNRest: WARNING! Restart file does not contain info ' &
- // ' on spinup state used to generate the restart file. '
- write(iulog,*) ' Assuming the same as current setting: ', spinup_state
- end if
- end if
- end if
-
- if (flag == 'read' .and. spinup_state /= restart_file_spinup_state .and. .not. use_cndv) then
- if (spinup_state <= 1 .and. restart_file_spinup_state == 2 ) then
- if ( masterproc ) write(iulog,*) ' CNRest: taking Dead wood N pools out of AD spinup mode'
- exit_spinup = .true.
- if ( masterproc ) write(iulog, *) 'Multiplying stemn and crootn by 10 for exit spinup '
- do i = bounds%begp,bounds%endp
- this%deadstemn_patch(i) = this%deadstemn_patch(i) * 10._r8
- this%deadcrootn_patch(i) = this%deadcrootn_patch(i) * 10._r8
- end do
- else if (spinup_state == 2 .and. restart_file_spinup_state <= 1 ) then
- if ( masterproc ) write(iulog,*) ' CNRest: taking Dead wood N pools into AD spinup mode'
- enter_spinup = .true.
- if ( masterproc ) write(iulog, *) 'Dividing stemn and crootn by 10 for enter spinup '
- do i = bounds%begp,bounds%endp
- this%deadstemn_patch(i) = this%deadstemn_patch(i) / 10._r8
- this%deadcrootn_patch(i) = this%deadcrootn_patch(i) / 10._r8
- end do
- endif
-
- end if
- ! Reseed dead plants
- if ( flag == 'read' .and. num_reseed_patch > 0 )then
- if ( masterproc ) write(iulog, *) 'Reseed dead plants for CNVegNitrogenState'
- do i = 1, num_reseed_patch
- p = filter_reseed_patch(i)
-
- l = patch%landunit(p)
-
- if (patch%itype(p) == noveg) then
- this%leafn_patch(p) = 0._r8
- this%leafn_storage_patch(p) = 0._r8
- if (MM_Nuptake_opt .eqv. .true.) then
- this%frootn_patch(p) = 0._r8
- this%frootn_storage_patch(p) = 0._r8
- end if
- else
- this%leafn_patch(p) = leafc_patch(p) / pftcon%leafcn(patch%itype(p))
- this%leafn_storage_patch(p) = leafc_storage_patch(p) / pftcon%leafcn(patch%itype(p))
- if (MM_Nuptake_opt .eqv. .true.) then
- this%frootn_patch(p) = frootc_patch(p) / pftcon%frootcn(patch%itype(p))
- this%frootn_storage_patch(p) = frootc_storage_patch(p) / pftcon%frootcn(patch%itype(p))
- end if
- end if
-
- this%leafn_xfer_patch(p) = 0._r8
-
- this%leafn_storage_xfer_acc_patch(p) = 0._r8
- this%storage_ndemand_patch(p) = 0._r8
-
- if ( use_crop )then
- this%grainn_patch(p) = 0._r8
- this%grainn_storage_patch(p) = 0._r8
- this%grainn_xfer_patch(p) = 0._r8
- this%cropseedn_deficit_patch(p) = 0._r8
- end if
- if (MM_Nuptake_opt .eqv. .false.) then ! if not running in floating CN ratio option
- this%frootn_patch(p) = 0._r8
- this%frootn_storage_patch(p) = 0._r8
- end if
- this%frootn_xfer_patch(p) = 0._r8
- this%livestemn_patch(p) = 0._r8
- this%livestemn_storage_patch(p) = 0._r8
- this%livestemn_xfer_patch(p) = 0._r8
-
- ! tree types need to be initialized with some stem mass so that
- ! roughness length is not zero in canopy flux calculation
-
- if (pftcon%woody(patch%itype(p)) == 1._r8) then
- this%deadstemn_patch(p) = deadstemc_patch(p) / pftcon%deadwdcn(patch%itype(p))
- else
- this%deadstemn_patch(p) = 0._r8
- end if
-
- this%deadstemn_storage_patch(p) = 0._r8
- this%deadstemn_xfer_patch(p) = 0._r8
- this%livecrootn_patch(p) = 0._r8
- this%livecrootn_storage_patch(p) = 0._r8
- this%livecrootn_xfer_patch(p) = 0._r8
- this%deadcrootn_patch(p) = 0._r8
- this%deadcrootn_storage_patch(p) = 0._r8
- this%deadcrootn_xfer_patch(p) = 0._r8
- this%retransn_patch(p) = 0._r8
- this%npool_patch(p) = 0._r8
- this%ntrunc_patch(p) = 0._r8
- this%dispvegn_patch(p) = 0._r8
- this%storvegn_patch(p) = 0._r8
- this%totvegn_patch(p) = 0._r8
- this%totn_patch(p) = 0._r8
-
- ! calculate totvegc explicitly so that it is available for the isotope
- ! code on the first time step.
-
- this%totvegn_patch(p) = &
- this%leafn_patch(p) + &
- this%leafn_storage_patch(p) + &
- this%leafn_xfer_patch(p) + &
- this%frootn_patch(p) + &
- this%frootn_storage_patch(p) + &
- this%frootn_xfer_patch(p) + &
- this%livestemn_patch(p) + &
- this%livestemn_storage_patch(p) + &
- this%livestemn_xfer_patch(p) + &
- this%deadstemn_patch(p) + &
- this%deadstemn_storage_patch(p) + &
- this%deadstemn_xfer_patch(p) + &
- this%livecrootn_patch(p) + &
- this%livecrootn_storage_patch(p) + &
- this%livecrootn_xfer_patch(p) + &
- this%deadcrootn_patch(p) + &
- this%deadcrootn_storage_patch(p) + &
- this%deadcrootn_xfer_patch(p) + &
- this%npool_patch(p)
-
- if ( use_crop )then
- this%totvegn_patch(p) = &
- this%totvegn_patch(p) + &
- this%grainn_patch(p) + &
- this%grainn_storage_patch(p) + &
- this%grainn_xfer_patch(p)
- end if
- end do
- end if
-
- end subroutine Restart
-
- !-----------------------------------------------------------------------
- subroutine SetValues ( this, &
- num_patch, filter_patch, value_patch, &
- num_column, filter_column, value_column)
- !
- ! !DESCRIPTION:
- ! Set nitrogen state variables
- !
- ! !ARGUMENTS:
- class (cnveg_nitrogenstate_type) :: this
- integer , intent(in) :: num_patch
- integer , intent(in) :: filter_patch(:)
- real(r8), intent(in) :: value_patch
- integer , intent(in) :: num_column
- integer , intent(in) :: filter_column(:)
- real(r8), intent(in) :: value_column
- !
- ! !LOCAL VARIABLES:
- integer :: fi,i ! loop index
- integer :: j,k ! indices
- !------------------------------------------------------------------------
-
- do fi = 1,num_patch
- i = filter_patch(fi)
-
- this%leafn_patch(i) = value_patch
- this%leafn_storage_patch(i) = value_patch
- this%leafn_xfer_patch(i) = value_patch
- this%leafn_storage_xfer_acc_patch(i) = value_patch
- this%frootn_patch(i) = value_patch
- this%frootn_storage_patch(i) = value_patch
- this%frootn_xfer_patch(i) = value_patch
- this%livestemn_patch(i) = value_patch
- this%livestemn_storage_patch(i) = value_patch
- this%livestemn_xfer_patch(i) = value_patch
- this%deadstemn_patch(i) = value_patch
- this%deadstemn_storage_patch(i) = value_patch
- this%deadstemn_xfer_patch(i) = value_patch
- this%livecrootn_patch(i) = value_patch
- this%livecrootn_storage_patch(i) = value_patch
- this%livecrootn_xfer_patch(i) = value_patch
- this%deadcrootn_patch(i) = value_patch
- this%deadcrootn_storage_patch(i) = value_patch
- this%deadcrootn_xfer_patch(i) = value_patch
- this%retransn_patch(i) = value_patch
- this%npool_patch(i) = value_patch
- this%ntrunc_patch(i) = value_patch
- this%dispvegn_patch(i) = value_patch
- this%storvegn_patch(i) = value_patch
- this%totvegn_patch(i) = value_patch
- this%totn_patch(i) = value_patch
- end do
-
- if ( use_crop )then
- do fi = 1,num_patch
- i = filter_patch(fi)
- this%grainn_patch(i) = value_patch
- this%grainn_storage_patch(i) = value_patch
- this%grainn_xfer_patch(i) = value_patch
- this%cropseedn_deficit_patch(i) = value_patch
- end do
- end if
-
- do fi = 1,num_column
- i = filter_column(fi)
-
- this%totecosysn_col(i) = value_column
- this%totvegn_col(i) = value_column
- this%totn_p2c_col(i) = value_column
- this%totn_col(i) = value_column
- end do
-
- end subroutine SetValues
-
-end module CNVegNitrogenStateType
diff --git a/src/biogeochem/CNVegStateType.F90 b/src/biogeochem/CNVegStateType.F90
deleted file mode 100644
index 1d78017a..00000000
--- a/src/biogeochem/CNVegStateType.F90
+++ /dev/null
@@ -1,905 +0,0 @@
-module CNVegStateType
-
- use shr_kind_mod , only : r8 => shr_kind_r8
- use shr_log_mod , only : errMsg => shr_log_errMsg
- use shr_infnan_mod , only : nan => shr_infnan_nan, assignment(=)
- use decompMod , only : bounds_type
- use abortutils , only : endrun
- use spmdMod , only : masterproc
- use clm_varpar , only : nlevsno, nlevgrnd, nlevlak, nlevsoi
- use clm_varctl , only : use_cn, iulog, fsurdat, use_crop, use_cndv
- use clm_varcon , only : spval, ispval, grlnd
- use landunit_varcon, only : istsoil, istcrop
- use LandunitType , only : lun
- use ColumnType , only : col
- use PatchType , only : patch
- !
- ! !PUBLIC TYPES:
- implicit none
- private
- !
- ! !PUBLIC TYPES:
- type, public :: cnveg_state_type
-
- integer , pointer :: burndate_patch (:) ! patch crop burn date
- real(r8) , pointer :: dwt_smoothed_patch (:) ! change in patch weight (-1 to 1) on the gridcell in this time step; changes in first time step of year are smoothed (dribbled) over the whole year
-
- ! Prognostic crop model
- !
- ! TODO(wjs, 2016-02-22) Most / all of these crop-specific state variables should be
- ! moved to CropType
- real(r8) , pointer :: hdidx_patch (:) ! patch cold hardening index?
- real(r8) , pointer :: cumvd_patch (:) ! patch cumulative vernalization d?ependence?
- real(r8) , pointer :: gddmaturity_patch (:) ! patch growing degree days (gdd) needed to harvest (ddays)
- real(r8) , pointer :: huileaf_patch (:) ! patch heat unit index needed from planting to leaf emergence
- real(r8) , pointer :: huigrain_patch (:) ! patch heat unit index needed to reach vegetative maturity
- real(r8) , pointer :: aleafi_patch (:) ! patch saved leaf allocation coefficient from phase 2
- real(r8) , pointer :: astemi_patch (:) ! patch saved stem allocation coefficient from phase 2
- real(r8) , pointer :: aleaf_patch (:) ! patch leaf allocation coefficient
- real(r8) , pointer :: astem_patch (:) ! patch stem allocation coefficient
- real(r8) , pointer :: htmx_patch (:) ! patch max hgt attained by a crop during yr (m)
- integer , pointer :: peaklai_patch (:) ! patch 1: max allowed lai; 0: not at max
-
- integer , pointer :: idop_patch (:) ! patch date of planting
-
- real(r8) , pointer :: gdp_lf_col (:) ! col global real gdp data (k US$/capita)
- real(r8) , pointer :: peatf_lf_col (:) ! col global peatland fraction data (0-1)
- integer , pointer :: abm_lf_col (:) ! col global peak month of crop fire emissions
-
- real(r8) , pointer :: lgdp_col (:) ! col gdp limitation factor for fire occurrence (0-1)
- real(r8) , pointer :: lgdp1_col (:) ! col gdp limitation factor for fire spreading (0-1)
- real(r8) , pointer :: lpop_col (:) ! col pop limitation factor for fire spreading (0-1)
-
- real(r8) , pointer :: tempavg_t2m_patch (:) ! patch temporary average 2m air temperature (K)
- real(r8) , pointer :: annavg_t2m_patch (:) ! patch annual average 2m air temperature (K)
- real(r8) , pointer :: annavg_t2m_col (:) ! col annual average of 2m air temperature, averaged from patch-level (K)
- real(r8) , pointer :: annsum_counter_col (:) ! col seconds since last annual accumulator turnover
-
- ! Fire
- real(r8) , pointer :: nfire_col (:) ! col fire counts (count/km2/sec), valid only in Reg. C
- real(r8) , pointer :: fsr_col (:) ! col fire spread rate at column level (m/s)
- real(r8) , pointer :: fd_col (:) ! col fire duration at column level (hr)
- real(r8) , pointer :: lfc_col (:) ! col conversion area fraction of BET and BDT that haven't burned before (/timestep)
- real(r8) , pointer :: lfc2_col (:) ! col conversion area fraction of BET and BDT that burned (/sec)
- real(r8) , pointer :: dtrotr_col (:) ! col annual decreased fraction coverage of BET on the gridcell (0-1)
- real(r8) , pointer :: trotr1_col (:) ! col patch weight of BET on the column (0-1)
- real(r8) , pointer :: trotr2_col (:) ! col patch weight of BDT on the column (0-1)
- real(r8) , pointer :: cropf_col (:) ! col crop fraction in veg column (0-1)
- real(r8) , pointer :: baf_crop_col (:) ! col baf for cropland(/sec)
- real(r8) , pointer :: baf_peatf_col (:) ! col baf for peatland (/sec)
- real(r8) , pointer :: fbac_col (:) ! col total burned area out of conversion (/sec)
- real(r8) , pointer :: fbac1_col (:) ! col burned area out of conversion region due to land use fire (/sec)
- real(r8) , pointer :: wtlf_col (:) ! col fractional coverage of non-crop Patches (0-1)
- real(r8) , pointer :: lfwt_col (:) ! col fractional coverage of non-crop and non-bare-soil Patches (0-1)
- real(r8) , pointer :: farea_burned_col (:) ! col fractional area burned (/sec)
-
- real(r8), pointer :: dormant_flag_patch (:) ! patch dormancy flag
- real(r8), pointer :: days_active_patch (:) ! patch number of days since last dormancy
- real(r8), pointer :: onset_flag_patch (:) ! patch onset flag
- real(r8), pointer :: onset_counter_patch (:) ! patch onset days counter
- real(r8), pointer :: onset_gddflag_patch (:) ! patch onset flag for growing degree day sum
- real(r8), pointer :: onset_fdd_patch (:) ! patch onset freezing degree days counter
- real(r8), pointer :: onset_gdd_patch (:) ! patch onset growing degree days
- real(r8), pointer :: onset_swi_patch (:) ! patch onset soil water index
- real(r8), pointer :: offset_flag_patch (:) ! patch offset flag
- real(r8), pointer :: offset_counter_patch (:) ! patch offset days counter
- real(r8), pointer :: offset_fdd_patch (:) ! patch offset freezing degree days counter
- real(r8), pointer :: offset_swi_patch (:) ! patch offset soil water index
- real(r8), pointer :: grain_flag_patch (:) ! patch 1: grain fill stage; 0: not
- real(r8), pointer :: lgsf_patch (:) ! patch long growing season factor [0-1]
- real(r8), pointer :: bglfr_patch (:) ! patch background litterfall rate (1/s)
- real(r8), pointer :: bgtr_patch (:) ! patch background transfer growth rate (1/s)
- real(r8), pointer :: c_allometry_patch (:) ! patch C allocation index (DIM)
- real(r8), pointer :: n_allometry_patch (:) ! patch N allocation index (DIM)
-
- real(r8), pointer :: tempsum_potential_gpp_patch (:) ! patch temporary annual sum of potential GPP
- real(r8), pointer :: annsum_potential_gpp_patch (:) ! patch annual sum of potential GPP
- real(r8), pointer :: tempmax_retransn_patch (:) ! patch temporary annual max of retranslocated N pool (gN/m2)
- real(r8), pointer :: annmax_retransn_patch (:) ! patch annual max of retranslocated N pool (gN/m2)
- real(r8), pointer :: downreg_patch (:) ! patch fractional reduction in GPP due to N limitation (DIM)
- real(r8), pointer :: leafcn_offset_patch (:) ! patch leaf C:N used by FUN
- real(r8), pointer :: plantCN_patch (:) ! patch plant C:N used by FUN
-
- contains
-
- procedure, public :: Init
- procedure, public :: Restart
- procedure, private :: InitAllocate
- procedure, private :: InitHistory
- procedure, private :: InitCold
-
- end type cnveg_state_type
- !------------------------------------------------------------------------
-
- character(len=*), parameter, private :: sourcefile = &
- __FILE__
-
-contains
-
- !------------------------------------------------------------------------
- subroutine Init(this, bounds)
-
- class(cnveg_state_type) :: this
- type(bounds_type), intent(in) :: bounds
-
- call this%InitAllocate ( bounds )
- if (use_cn) then
- call this%InitHistory ( bounds )
- end if
- call this%InitCold ( bounds )
-
- end subroutine Init
-
- !------------------------------------------------------------------------
- subroutine InitAllocate(this, bounds)
- !
- ! !DESCRIPTION:
- ! Initialize module data structure
- !
- ! !USES:
- use shr_infnan_mod , only : nan => shr_infnan_nan, assignment(=)
- !
- ! !ARGUMENTS:
- class(cnveg_state_type) :: this
- type(bounds_type), intent(in) :: bounds
- !
- ! !LOCAL VARIABLES:
- integer :: begp, endp
- integer :: begc, endc
- logical :: allows_non_annual_delta
- !------------------------------------------------------------------------
-
- begp = bounds%begp; endp= bounds%endp
- begc = bounds%begc; endc= bounds%endc
-
- allocate(this%burndate_patch (begp:endp)) ; this%burndate_patch (:) = ispval
- allocate(this%dwt_smoothed_patch (begp:endp)) ; this%dwt_smoothed_patch (:) = nan
-
- allocate(this%hdidx_patch (begp:endp)) ; this%hdidx_patch (:) = nan
- allocate(this%cumvd_patch (begp:endp)) ; this%cumvd_patch (:) = nan
- allocate(this%gddmaturity_patch (begp:endp)) ; this%gddmaturity_patch (:) = spval
- allocate(this%huileaf_patch (begp:endp)) ; this%huileaf_patch (:) = nan
- allocate(this%huigrain_patch (begp:endp)) ; this%huigrain_patch (:) = 0.0_r8
- allocate(this%aleafi_patch (begp:endp)) ; this%aleafi_patch (:) = nan
- allocate(this%astemi_patch (begp:endp)) ; this%astemi_patch (:) = nan
- allocate(this%aleaf_patch (begp:endp)) ; this%aleaf_patch (:) = nan
- allocate(this%astem_patch (begp:endp)) ; this%astem_patch (:) = nan
- allocate(this%htmx_patch (begp:endp)) ; this%htmx_patch (:) = 0.0_r8
- allocate(this%peaklai_patch (begp:endp)) ; this%peaklai_patch (:) = 0
-
- allocate(this%idop_patch (begp:endp)) ; this%idop_patch (:) = huge(1)
-
- allocate(this%gdp_lf_col (begc:endc)) ;
- allocate(this%peatf_lf_col (begc:endc)) ;
- allocate(this%abm_lf_col (begc:endc)) ;
-
- allocate(this%lgdp_col (begc:endc)) ;
- allocate(this%lgdp1_col (begc:endc)) ;
- allocate(this%lpop_col (begc:endc)) ;
-
- allocate(this%tempavg_t2m_patch (begp:endp)) ; this%tempavg_t2m_patch (:) = nan
- allocate(this%annsum_counter_col (begc:endc)) ; this%annsum_counter_col (:) = nan
- allocate(this%annavg_t2m_col (begc:endc)) ; this%annavg_t2m_col (:) = nan
- allocate(this%annavg_t2m_patch (begp:endp)) ; this%annavg_t2m_patch (:) = nan
-
- allocate(this%nfire_col (begc:endc)) ; this%nfire_col (:) = spval
- allocate(this%fsr_col (begc:endc)) ; this%fsr_col (:) = nan
- allocate(this%fd_col (begc:endc)) ; this%fd_col (:) = nan
- allocate(this%lfc_col (begc:endc)) ; this%lfc_col (:) = spval
- allocate(this%lfc2_col (begc:endc)) ; this%lfc2_col (:) = 0._r8
- allocate(this%dtrotr_col (begc:endc)) ; this%dtrotr_col (:) = 0._r8
- allocate(this%trotr1_col (begc:endc)) ; this%trotr1_col (:) = 0._r8
- allocate(this%trotr2_col (begc:endc)) ; this%trotr2_col (:) = 0._r8
- allocate(this%cropf_col (begc:endc)) ; this%cropf_col (:) = nan
- allocate(this%baf_crop_col (begc:endc)) ; this%baf_crop_col (:) = nan
- allocate(this%baf_peatf_col (begc:endc)) ; this%baf_peatf_col (:) = nan
- allocate(this%fbac_col (begc:endc)) ; this%fbac_col (:) = nan
- allocate(this%fbac1_col (begc:endc)) ; this%fbac1_col (:) = nan
- allocate(this%wtlf_col (begc:endc)) ; this%wtlf_col (:) = nan
- allocate(this%lfwt_col (begc:endc)) ; this%lfwt_col (:) = nan
- allocate(this%farea_burned_col (begc:endc)) ; this%farea_burned_col (:) = nan
-
- allocate(this%dormant_flag_patch (begp:endp)) ; this%dormant_flag_patch (:) = nan
- allocate(this%days_active_patch (begp:endp)) ; this%days_active_patch (:) = nan
- allocate(this%onset_flag_patch (begp:endp)) ; this%onset_flag_patch (:) = nan
- allocate(this%onset_counter_patch (begp:endp)) ; this%onset_counter_patch (:) = nan
- allocate(this%onset_gddflag_patch (begp:endp)) ; this%onset_gddflag_patch (:) = nan
- allocate(this%onset_fdd_patch (begp:endp)) ; this%onset_fdd_patch (:) = nan
- allocate(this%onset_gdd_patch (begp:endp)) ; this%onset_gdd_patch (:) = nan
- allocate(this%onset_swi_patch (begp:endp)) ; this%onset_swi_patch (:) = nan
- allocate(this%offset_flag_patch (begp:endp)) ; this%offset_flag_patch (:) = nan
- allocate(this%offset_counter_patch (begp:endp)) ; this%offset_counter_patch (:) = nan
- allocate(this%offset_fdd_patch (begp:endp)) ; this%offset_fdd_patch (:) = nan
- allocate(this%offset_swi_patch (begp:endp)) ; this%offset_swi_patch (:) = nan
- allocate(this%grain_flag_patch (begp:endp)) ; this%grain_flag_patch (:) = nan
- allocate(this%lgsf_patch (begp:endp)) ; this%lgsf_patch (:) = nan
- allocate(this%bglfr_patch (begp:endp)) ; this%bglfr_patch (:) = nan
- allocate(this%bgtr_patch (begp:endp)) ; this%bgtr_patch (:) = nan
- allocate(this%c_allometry_patch (begp:endp)) ; this%c_allometry_patch (:) = nan
- allocate(this%n_allometry_patch (begp:endp)) ; this%n_allometry_patch (:) = nan
- allocate(this%tempsum_potential_gpp_patch (begp:endp)) ; this%tempsum_potential_gpp_patch (:) = nan
- allocate(this%annsum_potential_gpp_patch (begp:endp)) ; this%annsum_potential_gpp_patch (:) = nan
- allocate(this%tempmax_retransn_patch (begp:endp)) ; this%tempmax_retransn_patch (:) = nan
- allocate(this%annmax_retransn_patch (begp:endp)) ; this%annmax_retransn_patch (:) = nan
- allocate(this%downreg_patch (begp:endp)) ; this%downreg_patch (:) = nan
- allocate(this%leafcn_offset_patch (begp:endp)) ; this%leafcn_offset_patch (:) = nan
- allocate(this%plantCN_patch (begp:endp)) ; this%plantCN_patch (:) = nan
-
- end subroutine InitAllocate
-
- !------------------------------------------------------------------------
- subroutine InitHistory(this, bounds)
- !
- ! !DESCRIPTION:
- ! Initialize module data structure
- !
- ! !USES:
- use shr_infnan_mod , only : nan => shr_infnan_nan, assignment(=)
- use histFileMod , only : hist_addfld1d, hist_addfld2d, hist_addfld_decomp, no_snow_normal
- !
- ! !ARGUMENTS:
- class(cnveg_state_type) :: this
- type(bounds_type), intent(in) :: bounds
- !
- ! !LOCAL VARIABLES:
- integer :: begp, endp
- integer :: begc, endc
- character(8) :: vr_suffix
- character(10) :: active
- real(r8), pointer :: data2dptr(:,:), data1dptr(:) ! temp. pointers for slicing larger arrays
- !------------------------------------------------------------------------
-
- begp = bounds%begp; endp= bounds%endp
- begc = bounds%begc; endc= bounds%endc
-
- if ( use_crop) then
- this%gddmaturity_patch(begp:endp) = spval
- call hist_addfld1d (fname='GDDHARV', units='ddays', &
- avgflag='A', long_name='Growing degree days (gdd) needed to harvest', &
- ptr_patch=this%gddmaturity_patch, default='inactive')
- end if
-
- this%lfc2_col(begc:endc) = spval
- call hist_addfld1d (fname='LFC2', units='per sec', &
- avgflag='A', long_name='conversion area fraction of BET and BDT that burned', &
- ptr_col=this%lfc2_col, default='inactive')
-
- this%annsum_counter_col(begc:endc) = spval
- call hist_addfld1d (fname='ANNSUM_COUNTER', units='s', &
- avgflag='A', long_name='seconds since last annual accumulator turnover', &
- ptr_col=this%annsum_counter_col, default='inactive')
-
- this%annavg_t2m_col(begc:endc) = spval
- call hist_addfld1d (fname='CANNAVG_T2M', units='K', &
- avgflag='A', long_name='annual average of 2m air temperature', &
- ptr_col=this%annavg_t2m_col, default='inactive')
-
- this%nfire_col(begc:endc) = spval
- call hist_addfld1d (fname='NFIRE', units='counts/km2/sec', &
- avgflag='A', long_name='fire counts valid only in Reg.C', &
- ptr_col=this%nfire_col, default='inactive')
-
- this%farea_burned_col(begc:endc) = spval
- call hist_addfld1d (fname='FAREA_BURNED', units='proportion/sec', &
- avgflag='A', long_name='timestep fractional area burned', &
- ptr_col=this%farea_burned_col, default='inactive')
-
- this%baf_crop_col(begc:endc) = spval
- call hist_addfld1d (fname='BAF_CROP', units='proportion/sec', &
- avgflag='A', long_name='fractional area burned for crop', &
- ptr_col=this%baf_crop_col, default='inactive')
-
- this%baf_peatf_col(begc:endc) = spval
- call hist_addfld1d (fname='BAF_PEATF', units='proportion/sec', &
- avgflag='A', long_name='fractional area burned in peatland', &
- ptr_col=this%baf_peatf_col, default='inactive')
-
- this%annavg_t2m_patch(begp:endp) = spval
- call hist_addfld1d (fname='ANNAVG_T2M', units='K', &
- avgflag='A', long_name='annual average 2m air temperature', &
- ptr_patch=this%annavg_t2m_patch, default='inactive')
-
- this%tempavg_t2m_patch(begp:endp) = spval
- call hist_addfld1d (fname='TEMPAVG_T2M', units='K', &
- avgflag='A', long_name='temporary average 2m air temperature', &
- ptr_patch=this%tempavg_t2m_patch, default='inactive')
-
- this%dormant_flag_patch(begp:endp) = spval
- call hist_addfld1d (fname='DORMANT_FLAG', units='none', &
- avgflag='A', long_name='dormancy flag', &
- ptr_patch=this%dormant_flag_patch, default='inactive')
-
- this%days_active_patch(begp:endp) = spval
- call hist_addfld1d (fname='DAYS_ACTIVE', units='days', &
- avgflag='A', long_name='number of days since last dormancy', &
- ptr_patch=this%days_active_patch, default='inactive')
-
- this%onset_flag_patch(begp:endp) = spval
- call hist_addfld1d (fname='ONSET_FLAG', units='none', &
- avgflag='A', long_name='onset flag', &
- ptr_patch=this%onset_flag_patch, default='inactive')
-
- this%onset_counter_patch(begp:endp) = spval
- call hist_addfld1d (fname='ONSET_COUNTER', units='days', &
- avgflag='A', long_name='onset days counter', &
- ptr_patch=this%onset_counter_patch, default='inactive')
-
- this%onset_gddflag_patch(begp:endp) = spval
- call hist_addfld1d (fname='ONSET_GDDFLAG', units='none', &
- avgflag='A', long_name='onset flag for growing degree day sum', &
- ptr_patch=this%onset_gddflag_patch, default='inactive')
-
- this%onset_fdd_patch(begp:endp) = spval
- call hist_addfld1d (fname='ONSET_FDD', units='C degree-days', &
- avgflag='A', long_name='onset freezing degree days counter', &
- ptr_patch=this%onset_fdd_patch, default='inactive')
-
- this%onset_gdd_patch(begp:endp) = spval
- call hist_addfld1d (fname='ONSET_GDD', units='C degree-days', &
- avgflag='A', long_name='onset growing degree days', &
- ptr_patch=this%onset_gdd_patch, default='inactive')
-
- this%onset_swi_patch(begp:endp) = spval
- call hist_addfld1d (fname='ONSET_SWI', units='none', &
- avgflag='A', long_name='onset soil water index', &
- ptr_patch=this%onset_swi_patch, default='inactive')
-
- this%offset_flag_patch(begp:endp) = spval
- call hist_addfld1d (fname='OFFSET_FLAG', units='none', &
- avgflag='A', long_name='offset flag', &
- ptr_patch=this%offset_flag_patch, default='inactive')
-
- this%offset_counter_patch(begp:endp) = spval
- call hist_addfld1d (fname='OFFSET_COUNTER', units='days', &
- avgflag='A', long_name='offset days counter', &
- ptr_patch=this%offset_counter_patch, default='inactive')
-
- this%offset_fdd_patch(begp:endp) = spval
- call hist_addfld1d (fname='OFFSET_FDD', units='C degree-days', &
- avgflag='A', long_name='offset freezing degree days counter', &
- ptr_patch=this%offset_fdd_patch, default='inactive')
-
- this%offset_swi_patch(begp:endp) = spval
- call hist_addfld1d (fname='OFFSET_SWI', units='none', &
- avgflag='A', long_name='offset soil water index', &
- ptr_patch=this%offset_swi_patch, default='inactive')
-
- this%lgsf_patch(begp:endp) = spval
- call hist_addfld1d (fname='LGSF', units='proportion', &
- avgflag='A', long_name='long growing season factor', &
- ptr_patch=this%lgsf_patch, default='inactive')
-
- this%bglfr_patch(begp:endp) = spval
- call hist_addfld1d (fname='BGLFR', units='1/s', &
- avgflag='A', long_name='background litterfall rate', &
- ptr_patch=this%bglfr_patch, default='inactive')
-
- this%bgtr_patch(begp:endp) = spval
- call hist_addfld1d (fname='BGTR', units='1/s', &
- avgflag='A', long_name='background transfer growth rate', &
- ptr_patch=this%bgtr_patch, default='inactive')
-
- this%c_allometry_patch(begp:endp) = spval
- call hist_addfld1d (fname='C_ALLOMETRY', units='none', &
- avgflag='A', long_name='C allocation index', &
- ptr_patch=this%c_allometry_patch, default='inactive')
-
- this%n_allometry_patch(begp:endp) = spval
- call hist_addfld1d (fname='N_ALLOMETRY', units='none', &
- avgflag='A', long_name='N allocation index', &
- ptr_patch=this%n_allometry_patch, default='inactive')
-
- this%tempsum_potential_gpp_patch(begp:endp) = spval
- call hist_addfld1d (fname='TEMPSUM_POTENTIAL_GPP', units='gC/m^2/yr', &
- avgflag='A', long_name='temporary annual sum of potential GPP', &
- ptr_patch=this%tempsum_potential_gpp_patch, default='inactive')
-
- this%annsum_potential_gpp_patch(begp:endp) = spval
- call hist_addfld1d (fname='ANNSUM_POTENTIAL_GPP', units='gN/m^2/yr', &
- avgflag='A', long_name='annual sum of potential GPP', &
- ptr_patch=this%annsum_potential_gpp_patch, default='inactive')
-
- this%tempmax_retransn_patch(begp:endp) = spval
- call hist_addfld1d (fname='TEMPMAX_RETRANSN', units='gN/m^2', &
- avgflag='A', long_name='temporary annual max of retranslocated N pool', &
- ptr_patch=this%tempmax_retransn_patch, default='inactive')
-
- this%annmax_retransn_patch(begp:endp) = spval
- call hist_addfld1d (fname='ANNMAX_RETRANSN', units='gN/m^2', &
- avgflag='A', long_name='annual max of retranslocated N pool', &
- ptr_patch=this%annmax_retransn_patch, default='inactive')
-
- this%downreg_patch(begp:endp) = spval
- call hist_addfld1d (fname='DOWNREG', units='proportion', &
- avgflag='A', long_name='fractional reduction in GPP due to N limitation', &
- ptr_patch=this%downreg_patch, default='inactive')
-
- this%leafcn_offset_patch(begp:endp) = spval
- call hist_addfld1d (fname='LEAFCN_OFFSET', units='unitless', &
- avgflag='A', long_name='Leaf C:N used by FUN', &
- ptr_patch=this%leafcn_offset_patch, default='inactive')
-
- this%plantCN_patch(begp:endp) = spval
- call hist_addfld1d (fname='PLANTCN', units='unitless', &
- avgflag='A', long_name='Plant C:N used by FUN', &
- ptr_patch=this%plantCN_patch, default='inactive')
- end subroutine InitHistory
-
- !-----------------------------------------------------------------------
- subroutine initCold(this, bounds)
- !
- ! !USES:
- use spmdMod , only : masterproc
- use fileutils , only : getfil
- use clm_varctl , only : nsrest, nsrStartup
- use ncdio_pio
- !
- ! !ARGUMENTS:
- class(cnveg_state_type) :: this
- type(bounds_type), intent(in) :: bounds
- !
- ! !LOCAL VARIABLES:
- integer :: g,l,c,p,n,j,m ! indices
- real(r8) ,pointer :: gdp (:) ! global gdp data (needs to be a pointer for use in ncdio)
- real(r8) ,pointer :: peatf (:) ! global peatf data (needs to be a pointer for use in ncdio)
- integer ,pointer :: abm (:) ! global abm data (needs to be a pointer for use in ncdio)
- real(r8) ,pointer :: gti (:) ! read in - fmax (needs to be a pointer for use in ncdio)
- integer :: dimid ! dimension id
- integer :: ier ! error status
- type(file_desc_t) :: ncid ! netcdf id
- logical :: readvar
- character(len=256) :: locfn ! local filename
- integer :: begc, endc
- integer :: begg, endg
- !-----------------------------------------------------------------------
-
- begc = bounds%begc; endc= bounds%endc
- begg = bounds%begg; endg= bounds%endg
-
- ! --------------------------------------------------------------------
- ! Open surface dataset
- ! --------------------------------------------------------------------
-
- call getfil (fsurdat, locfn, 0)
- call ncd_pio_openfile (ncid, locfn, 0)
-
- ! --------------------------------------------------------------------
- ! Read in GDP data
- ! --------------------------------------------------------------------
-
- allocate(gdp(bounds%begg:bounds%endg))
- call ncd_io(ncid=ncid, varname='gdp', flag='read', data=gdp, dim1name=grlnd, readvar=readvar)
- if (.not. readvar) then
- call endrun(msg=' ERROR: gdp NOT on surfdata file'//errMsg(sourcefile, __LINE__))
- end if
- do c = bounds%begc, bounds%endc
- g = col%gridcell(c)
- this%gdp_lf_col(c) = gdp(g)
- end do
- deallocate(gdp)
-
- ! --------------------------------------------------------------------
- ! Read in peatf data
- ! --------------------------------------------------------------------
-
- allocate(peatf(bounds%begg:bounds%endg))
- call ncd_io(ncid=ncid, varname='peatf', flag='read', data=peatf, dim1name=grlnd, readvar=readvar)
- if (.not. readvar) then
- call endrun(msg=' ERROR: peatf NOT on surfdata file'//errMsg(sourcefile, __LINE__))
- end if
- do c = bounds%begc, bounds%endc
- g = col%gridcell(c)
- this%peatf_lf_col(c) = peatf(g)
- end do
- deallocate(peatf)
-
- ! --------------------------------------------------------------------
- ! Read in ABM data
- ! --------------------------------------------------------------------
-
- allocate(abm(bounds%begg:bounds%endg))
- call ncd_io(ncid=ncid, varname='abm', flag='read', data=abm, dim1name=grlnd, readvar=readvar)
- if (.not. readvar) then
- call endrun(msg=' ERROR: abm NOT on surfdata file'//errMsg(sourcefile, __LINE__))
- end if
- do c = bounds%begc, bounds%endc
- g = col%gridcell(c)
- this%abm_lf_col(c) = abm(g)
- end do
- deallocate(abm)
-
- ! Close file
-
- call ncd_pio_closefile(ncid)
-
- if (masterproc) then
- write(iulog,*) 'Successfully read fmax, soil color, sand and clay boundary data'
- write(iulog,*)
- endif
-
- ! --------------------------------------------------------------------
- ! Initialize terms needed for dust model
- ! TODO - move these terms to DUSTMod module variables
- ! --------------------------------------------------------------------
-
- do c = bounds%begc, bounds%endc
- l = col%landunit(c)
- if (lun%ifspecial(l)) then
- this%annsum_counter_col (c) = spval
- this%annavg_t2m_col (c) = spval
- this%nfire_col (c) = spval
- this%baf_crop_col (c) = spval
- this%baf_peatf_col (c) = spval
- this%fbac_col (c) = spval
- this%fbac1_col (c) = spval
- this%farea_burned_col (c) = spval
- end if
-
- if (lun%itype(l) == istsoil .or. lun%itype(l) == istcrop) then
- this%annsum_counter_col(c) = 0._r8
- this%annavg_t2m_col(c) = 280._r8
-
- ! fire related variables
- this%baf_crop_col(c) = 0._r8
- this%baf_peatf_col(c) = 0._r8
- this%fbac_col(c) = 0._r8
- this%fbac1_col(c) = 0._r8
- this%farea_burned_col(c) = 0._r8
- this%nfire_col(c) = 0._r8
- end if
- end do
-
- ! ecophysiological and phenology variables
-
- do p = bounds%begp,bounds%endp
- l = patch%landunit(p)
-
- if (lun%ifspecial(l)) then
- this%annavg_t2m_patch (p) = spval
- this%tempavg_t2m_patch (p) = spval
- this%dormant_flag_patch(p) = spval
- this%days_active_patch(p) = spval
- this%onset_flag_patch(p) = spval
- this%onset_counter_patch(p) = spval
- this%onset_gddflag_patch(p) = spval
- this%onset_fdd_patch(p) = spval
- this%onset_gdd_patch(p) = spval
- this%onset_swi_patch(p) = spval
- this%offset_flag_patch(p) = spval
- this%offset_counter_patch(p) = spval
- this%offset_fdd_patch(p) = spval
- this%offset_swi_patch(p) = spval
- this%grain_flag_patch(p) = spval
- this%lgsf_patch(p) = spval
- this%bglfr_patch(p) = spval
- this%bgtr_patch(p) = spval
- this%c_allometry_patch(p) = spval
- this%n_allometry_patch(p) = spval
- this%tempsum_potential_gpp_patch(p) = spval
- this%annsum_potential_gpp_patch(p) = spval
- this%tempmax_retransn_patch(p) = spval
- this%annmax_retransn_patch(p) = spval
- this%downreg_patch(p) = spval
- this%leafcn_offset_patch(p) = spval
- this%plantCN_patch(p) = spval
- end if
-
- if (lun%itype(l) == istsoil .or. lun%itype(l) == istcrop) then
- ! phenology variables
- this%dormant_flag_patch(p) = 1._r8
- this%days_active_patch(p) = 0._r8
- this%onset_flag_patch(p) = 0._r8
- this%onset_counter_patch(p) = 0._r8
- this%onset_gddflag_patch(p) = 0._r8
- this%onset_fdd_patch(p) = 0._r8
- this%onset_gdd_patch(p) = 0._r8
- this%onset_swi_patch(p) = 0._r8
- this%offset_flag_patch(p) = 0._r8
- this%offset_counter_patch(p) = 0._r8
- this%offset_fdd_patch(p) = 0._r8
- this%offset_swi_patch(p) = 0._r8
- this%lgsf_patch(p) = 0._r8
- this%bglfr_patch(p) = 0._r8
- this%bgtr_patch(p) = 0._r8
- this%annavg_t2m_patch(p) = 280._r8
- this%tempavg_t2m_patch(p) = 0._r8
- this%grain_flag_patch(p) = 0._r8
-
- ! non-phenology variables
- this%c_allometry_patch(p) = 0._r8
- this%n_allometry_patch(p) = 0._r8
- this%tempsum_potential_gpp_patch(p) = 0._r8
- this%annsum_potential_gpp_patch(p) = 0._r8
- this%tempmax_retransn_patch(p) = 0._r8
- this%annmax_retransn_patch(p) = 0._r8
- this%downreg_patch(p) = 0._r8
- this%leafcn_offset_patch(p) = spval
- this%plantCN_patch(p) = spval
- end if
-
- end do
-
- ! fire variables
-
- do c = bounds%begc,bounds%endc
- this%lfc2_col(c) = 0._r8
- end do
-
- end subroutine initCold
-
- !------------------------------------------------------------------------
- subroutine Restart(this, bounds, ncid, flag, cnveg_carbonstate, &
- cnveg_nitrogenstate, filter_reseed_patch, num_reseed_patch)
- !
- ! !USES:
- use shr_log_mod, only : errMsg => shr_log_errMsg
- use spmdMod , only : masterproc
- use abortutils , only : endrun
- use CNVegNitrogenStateType, only: cnveg_nitrogenstate_type
- use CNVegCarbonStateType , only: cnveg_carbonstate_type
- use restUtilMod
- use ncdio_pio
- use pftconMod , only : pftcon
- !
- ! !ARGUMENTS:
- class(cnveg_state_type) :: this
- type(bounds_type), intent(in) :: bounds
- type(file_desc_t), intent(inout) :: ncid
- character(len=*) , intent(in) :: flag
- type(cnveg_nitrogenstate_type), intent(in) :: cnveg_nitrogenstate
- type(cnveg_carbonstate_type) , intent(in) :: cnveg_carbonstate
- integer , intent(out), optional :: filter_reseed_patch(:)
- integer , intent(out), optional :: num_reseed_patch
- !
- ! !LOCAL VARIABLES:
- integer :: j,c,i,p ! indices
- logical :: readvar ! determine if variable is on initial file
- real(r8), pointer :: ptr2d(:,:) ! temp. pointers for slicing larger arrays
- real(r8), pointer :: ptr1d(:) ! temp. pointers for slicing larger arrays
- !-----------------------------------------------------------------------
-
- call restartvar(ncid=ncid, flag=flag, varname='dormant_flag', xtype=ncd_double, &
- dim1name='pft', &
- long_name='dormancy flag', units='unitless', &
- interpinic_flag='interp', readvar=readvar, data=this%dormant_flag_patch)
-
- call restartvar(ncid=ncid, flag=flag, varname='days_active', xtype=ncd_double, &
- dim1name='pft', &
- long_name='number of days since last dormancy', units='days' , &
- interpinic_flag='interp', readvar=readvar, data=this%days_active_patch)
-
- call restartvar(ncid=ncid, flag=flag, varname='onset_flag', xtype=ncd_double, &
- dim1name='pft', &
- long_name='flag if critical growing degree-day sum is exceeded', units='unitless' , &
- interpinic_flag='interp', readvar=readvar, data=this%onset_flag_patch)
-
- call restartvar(ncid=ncid, flag=flag, varname='onset_counter', xtype=ncd_double, &
- dim1name='pft', &
- long_name='onset days counter', units='sec' , &
- interpinic_flag='interp', readvar=readvar, data=this%onset_counter_patch)
-
- call restartvar(ncid=ncid, flag=flag, varname='onset_gddflag', xtype=ncd_double, &
- dim1name='pft', &
- long_name='onset flag for growing degree day sum', units='' , &
- interpinic_flag='interp', readvar=readvar, data=this%onset_gddflag_patch)
-
- call restartvar(ncid=ncid, flag=flag, varname='onset_fdd', xtype=ncd_double, &
- dim1name='pft', &
- long_name='onset freezing degree days counter', units='days' , &
- interpinic_flag='interp', readvar=readvar, data=this%onset_fdd_patch)
-
- call restartvar(ncid=ncid, flag=flag, varname='onset_gdd', xtype=ncd_double, &
- dim1name='pft', &
- long_name='onset growing degree days', units='days' , &
- interpinic_flag='interp', readvar=readvar, data=this%onset_gdd_patch)
-
- call restartvar(ncid=ncid, flag=flag, varname='onset_swi', xtype=ncd_double, &
- dim1name='pft', &
- long_name='onset soil water index', units='days' , &
- interpinic_flag='interp', readvar=readvar, data=this%onset_swi_patch)
-
- call restartvar(ncid=ncid, flag=flag, varname='offset_flag', xtype=ncd_double, &
- dim1name='pft', &
- long_name='offset flag', units='unitless' , &
- interpinic_flag='interp', readvar=readvar, data=this%offset_flag_patch)
-
- call restartvar(ncid=ncid, flag=flag, varname='offset_counter', xtype=ncd_double, &
- dim1name='pft', &
- long_name='offset days counter', units='sec' , &
- interpinic_flag='interp', readvar=readvar, data=this%offset_counter_patch)
-
- call restartvar(ncid=ncid, flag=flag, varname='offset_fdd', xtype=ncd_double, &
- dim1name='pft', &
- long_name='offset freezing degree days counter', units='days' , &
- interpinic_flag='interp', readvar=readvar, data=this%offset_fdd_patch)
-
- call restartvar(ncid=ncid, flag=flag, varname='offset_swi', xtype=ncd_double, &
- dim1name='pft', &
- long_name='', units='', &
- interpinic_flag='interp', readvar=readvar, data=this%offset_swi_patch)
-
- call restartvar(ncid=ncid, flag=flag, varname='lgsf', xtype=ncd_double, &
- dim1name='pft', &
- long_name='', units='', &
- interpinic_flag='interp', readvar=readvar, data=this%lgsf_patch)
-
- call restartvar(ncid=ncid, flag=flag, varname='bglfr', xtype=ncd_double, &
- dim1name='pft', &
- long_name='', units='', &
- interpinic_flag='interp', readvar=readvar, data=this%bglfr_patch)
-
- call restartvar(ncid=ncid, flag=flag, varname='bgtr', xtype=ncd_double, &
- dim1name='pft', &
- long_name='', units='', &
- interpinic_flag='interp', readvar=readvar, data=this%bgtr_patch)
-
- call restartvar(ncid=ncid, flag=flag, varname='annavg_t2m', xtype=ncd_double, &
- dim1name='pft', &
- long_name='', units='', &
- interpinic_flag='interp', readvar=readvar, data=this%annavg_t2m_patch)
-
- call restartvar(ncid=ncid, flag=flag, varname='tempavg_t2m', xtype=ncd_double, &
- dim1name='pft', &
- long_name='', units='', &
- interpinic_flag='interp', readvar=readvar, data=this%tempavg_t2m_patch)
-
- call restartvar(ncid=ncid, flag=flag, varname='c_allometry', xtype=ncd_double, &
- dim1name='pft', &
- long_name='', units='', &
- interpinic_flag='interp', readvar=readvar, data=this%c_allometry_patch)
-
- call restartvar(ncid=ncid, flag=flag, varname='n_allometry', xtype=ncd_double, &
- dim1name='pft', &
- long_name='', units='', &
- interpinic_flag='interp', readvar=readvar, data=this%n_allometry_patch)
-
- call restartvar(ncid=ncid, flag=flag, varname='tempsum_potential_gpp', xtype=ncd_double, &
- dim1name='pft', &
- long_name='', units='', &
- interpinic_flag='interp', readvar=readvar, data=this%tempsum_potential_gpp_patch)
-
- call restartvar(ncid=ncid, flag=flag, varname='annsum_potential_gpp', xtype=ncd_double, &
- dim1name='pft', &
- long_name='', units='', &
- interpinic_flag='interp', readvar=readvar, data=this%annsum_potential_gpp_patch)
-
- call restartvar(ncid=ncid, flag=flag, varname='tempmax_retransn', xtype=ncd_double, &
- dim1name='pft', &
- long_name='', units='', &
- interpinic_flag='interp', readvar=readvar, data=this%tempmax_retransn_patch)
-
- call restartvar(ncid=ncid, flag=flag, varname='annmax_retransn', xtype=ncd_double, &
- dim1name='pft', &
- long_name='', units='', &
- interpinic_flag='interp', readvar=readvar, data=this%annmax_retransn_patch)
-
- call restartvar(ncid=ncid, flag=flag, varname='downreg', xtype=ncd_double, &
- dim1name='pft', &
- long_name='', units='', &
- interpinic_flag='interp', readvar=readvar, data=this%downreg_patch)
-
- call restartvar(ncid=ncid, flag=flag, varname='leafcn_offset', xtype=ncd_double, &
- dim1name='pft', &
- long_name='', units='', &
- interpinic_flag='interp', readvar=readvar, data=this%leafcn_offset_patch)
-
- call restartvar(ncid=ncid, flag=flag, varname='plantCN', xtype=ncd_double, &
- dim1name='pft', &
- long_name='', units='', &
- interpinic_flag='interp', readvar=readvar, data=this%plantCN_patch)
-
- call restartvar(ncid=ncid, flag=flag, varname='annsum_counter', xtype=ncd_double, &
- dim1name='column', &
- long_name='', units='', &
- interpinic_flag='interp', readvar=readvar, data=this%annsum_counter_col)
-
- call restartvar(ncid=ncid, flag=flag, varname='burndate', xtype=ncd_int, &
- dim1name='pft', &
- long_name='', units='', &
- interpinic_flag='interp', readvar=readvar, data=this%burndate_patch)
-
- call restartvar(ncid=ncid, flag=flag, varname='lfc', xtype=ncd_double, &
- dim1name='column', &
- long_name='', units='', &
- interpinic_flag='interp', readvar=readvar, data=this%lfc_col)
-
- call restartvar(ncid=ncid, flag=flag, varname='cannavg_t2m', xtype=ncd_double, &
- dim1name='column', &
- long_name='', units='', &
- interpinic_flag='interp', readvar=readvar, data=this%annavg_t2m_col)
-
- if (use_crop) then
-
- call restartvar(ncid=ncid, flag=flag, varname='htmx', xtype=ncd_double, &
- dim1name='pft', long_name='max height attained by a crop during year', units='m', &
- interpinic_flag='interp', readvar=readvar, data=this%htmx_patch)
-
- call restartvar(ncid=ncid, flag=flag, varname='peaklai', xtype=ncd_int, &
- dim1name='pft', long_name='Flag if at max allowed LAI or not', &
- flag_values=(/0,1/), nvalid_range=(/0,1/), &
- flag_meanings=(/'NOT-at-peak', 'AT_peak-LAI' /) , &
- interpinic_flag='interp', readvar=readvar, data=this%peaklai_patch)
-
- call restartvar(ncid=ncid, flag=flag, varname='idop', xtype=ncd_int, &
- dim1name='pft', long_name='Date of planting', units='jday', nvalid_range=(/1,366/), &
- interpinic_flag='interp', readvar=readvar, data=this%idop_patch)
-
- call restartvar(ncid=ncid, flag=flag, varname='aleaf', xtype=ncd_double, &
- dim1name='pft', long_name='leaf allocation coefficient', units='', &
- interpinic_flag='interp', readvar=readvar, data=this%aleaf_patch)
-
- call restartvar(ncid=ncid, flag=flag, varname='aleafi', xtype=ncd_double, &
- dim1name='pft', long_name='Saved leaf allocation coefficient from phase 2', units='', &
- interpinic_flag='interp', readvar=readvar, data=this%aleafi_patch)
-
- call restartvar(ncid=ncid, flag=flag, varname='astem', xtype=ncd_double, &
- dim1name='pft', long_name='stem allocation coefficient', units='', &
- interpinic_flag='interp', readvar=readvar, data=this%astem_patch)
-
- call restartvar(ncid=ncid, flag=flag, varname='astemi', xtype=ncd_double, &
- dim1name='pft', long_name='Saved stem allocation coefficient from phase 2', units='', &
- interpinic_flag='interp', readvar=readvar, data=this%astemi_patch)
-
- call restartvar(ncid=ncid, flag=flag, varname='hdidx', xtype=ncd_double, &
- dim1name='pft', long_name='cold hardening index', units='', &
- interpinic_flag='interp', readvar=readvar, data=this%hdidx_patch)
-
- call restartvar(ncid=ncid, flag=flag, varname='cumvd', xtype=ncd_double, &
- dim1name='pft', long_name='cumulative vernalization d', units='', &
- interpinic_flag='interp', readvar=readvar, data=this%cumvd_patch)
-
- call restartvar(ncid=ncid, flag=flag, varname='gddmaturity', xtype=ncd_double, &
- dim1name='pft', long_name='Growing degree days needed to harvest', units='ddays', &
- interpinic_flag='interp', readvar=readvar, data=this%gddmaturity_patch)
-
- call restartvar(ncid=ncid, flag=flag, varname='huileaf', xtype=ncd_double, &
- dim1name='pft', long_name='heat unit index needed from planting to leaf emergence', units='', &
- interpinic_flag='interp', readvar=readvar, data=this%huileaf_patch)
-
- call restartvar(ncid=ncid, flag=flag, varname='huigrain', xtype=ncd_double, &
- dim1name='pft', long_name='heat unit index needed to reach vegetative maturity', units='', &
- interpinic_flag='interp', readvar=readvar, data=this%huigrain_patch)
-
- call restartvar(ncid=ncid, flag=flag, varname='grain_flag', xtype=ncd_double, &
- dim1name='pft', long_name='', units='', &
- interpinic_flag='interp', readvar=readvar, data=this%grain_flag_patch)
- end if
- if ( flag == 'read' .and. num_reseed_patch > 0 )then
- if ( masterproc ) write(iulog, *) 'Reseed dead plants for CNVegState'
- do i = 1, num_reseed_patch
- p = filter_reseed_patch(i)
- ! phenology variables
- this%dormant_flag_patch(p) = 1._r8
- this%days_active_patch(p) = 0._r8
- this%onset_flag_patch(p) = 0._r8
- this%onset_counter_patch(p) = 0._r8
- this%onset_gddflag_patch(p) = 0._r8
- this%onset_fdd_patch(p) = 0._r8
- this%onset_gdd_patch(p) = 0._r8
- this%onset_swi_patch(p) = 0._r8
- this%offset_flag_patch(p) = 0._r8
- this%offset_counter_patch(p) = 0._r8
- this%offset_fdd_patch(p) = 0._r8
- this%offset_swi_patch(p) = 0._r8
- this%lgsf_patch(p) = 0._r8
- this%bglfr_patch(p) = 0._r8
- this%bgtr_patch(p) = 0._r8
- this%annavg_t2m_patch(p) = 280._r8
- this%tempavg_t2m_patch(p) = 0._r8
- this%grain_flag_patch(p) = 0._r8
-
- this%c_allometry_patch(p) = 0._r8
- this%n_allometry_patch(p) = 0._r8
- this%tempsum_potential_gpp_patch(p) = 0._r8
- this%annsum_potential_gpp_patch(p) = 0._r8
- this%tempmax_retransn_patch(p) = 0._r8
- this%annmax_retransn_patch(p) = 0._r8
- this%downreg_patch(p) = 0._r8
- this%leafcn_offset_patch(p) = spval
- this%plantCN_patch(p) = spval
- end do
- end if
-
- end subroutine Restart
-
-end module CNVegStateType
diff --git a/src/biogeochem/CNVegStructUpdateMod.F90 b/src/biogeochem/CNVegStructUpdateMod.F90
deleted file mode 100644
index 27b677b0..00000000
--- a/src/biogeochem/CNVegStructUpdateMod.F90
+++ /dev/null
@@ -1,307 +0,0 @@
-module CNVegStructUpdateMod
-
- !-----------------------------------------------------------------------
- ! Module for vegetation structure updates (LAI, SAI, htop, hbot)
- !
- ! !USES:
- use shr_kind_mod , only: r8 => shr_kind_r8
- use shr_const_mod , only : SHR_CONST_PI
- use clm_varctl , only : iulog, use_cndv
- use CNDVType , only : dgv_ecophyscon
- use WaterStateType , only : waterstate_type
- use FrictionVelocityMod , only : frictionvel_type
- use CNDVType , only : dgvs_type
- use CNVegStateType , only : cnveg_state_type
- use CropType , only : crop_type
- use CNVegCarbonStateType , only : cnveg_carbonstate_type
- use CanopyStateType , only : canopystate_type
- use PatchType , only : patch
- !
- implicit none
- private
- !
- ! !PUBLIC MEMBER FUNCTIONS:
- public :: CNVegStructUpdate
- !-----------------------------------------------------------------------
-
-contains
-
- !-----------------------------------------------------------------------
- subroutine CNVegStructUpdate(num_soilp, filter_soilp, &
- waterstate_inst, frictionvel_inst, dgvs_inst, cnveg_state_inst, crop_inst, &
- cnveg_carbonstate_inst, canopystate_inst)
- !
- ! !DESCRIPTION:
- ! On the radiation time step, use C state variables and epc to diagnose
- ! vegetation structure (LAI, SAI, height)
- !
- ! !USES:
- use pftconMod , only : noveg, nc3crop, nc3irrig, nbrdlf_evr_shrub, nbrdlf_dcd_brl_shrub
- use pftconMod , only : npcropmin
- use pftconMod , only : ntmp_corn, nirrig_tmp_corn
- use pftconMod , only : ntrp_corn, nirrig_trp_corn
- use pftconMod , only : nsugarcane, nirrig_sugarcane
- use pftconMod , only : pftcon
- use clm_varctl , only : spinup_state
- use clm_time_manager , only : get_rad_step_size
- !
- ! !ARGUMENTS:
- integer , intent(in) :: num_soilp ! number of column soil points in patch filter
- integer , intent(in) :: filter_soilp(:) ! patch filter for soil points
- type(waterstate_type) , intent(in) :: waterstate_inst
- type(frictionvel_type) , intent(in) :: frictionvel_inst
- type(dgvs_type) , intent(in) :: dgvs_inst
- type(cnveg_state_type) , intent(inout) :: cnveg_state_inst
- type(crop_type) , intent(in) :: crop_inst
- type(cnveg_carbonstate_type) , intent(in) :: cnveg_carbonstate_inst
- type(canopystate_type) , intent(inout) :: canopystate_inst
- !
- ! !REVISION HISTORY:
- ! 10/28/03: Created by Peter Thornton
- ! 2/29/08, David Lawrence: revised snow burial fraction for short vegetation
- !
- ! !LOCAL VARIABLES:
- integer :: p,c,g ! indices
- integer :: fp ! lake filter indices
- real(r8) :: taper ! ratio of height:radius_breast_height (tree allometry)
- real(r8) :: stocking ! #stems / ha (stocking density)
- real(r8) :: ol ! thickness of canopy layer covered by snow (m)
- real(r8) :: fb ! fraction of canopy layer covered by snow
- real(r8) :: tlai_old ! for use in Zeng tsai formula
- real(r8) :: tsai_old ! for use in Zeng tsai formula
- real(r8) :: tsai_min ! PATCH derived minimum tsai
- real(r8) :: tsai_alpha ! monthly decay rate of tsai
- real(r8) :: dt ! radiation time step (sec)
-
- real(r8), parameter :: dtsmonth = 2592000._r8 ! number of seconds in a 30 day month (60x60x24x30)
- !-----------------------------------------------------------------------
- ! tsai formula from Zeng et. al. 2002, Journal of Climate, p1835
- !
- ! tsai(p) = max( tsai_alpha(ivt(p))*tsai_old + max(tlai_old-tlai(p),0_r8), tsai_min(ivt(p)) )
- ! notes:
- ! * RHS tsai & tlai are from previous timestep
- ! * should create tsai_alpha(ivt(p)) & tsai_min(ivt(p)) in pftconMod.F90 - slevis
- ! * all non-crop patches use same values:
- ! crop tsai_alpha,tsai_min = 0.0,0.1
- ! noncrop tsai_alpha,tsai_min = 0.5,1.0 (includes bare soil and urban)
- !-------------------------------------------------------------------------------
-
- associate( &
- ivt => patch%itype , & ! Input: [integer (:) ] patch vegetation type
-
- woody => pftcon%woody , & ! Input: binary flag for woody lifeform (1=woody, 0=not woody)
- slatop => pftcon%slatop , & ! Input: specific leaf area at top of canopy, projected area basis [m^2/gC]
- dsladlai => pftcon%dsladlai , & ! Input: dSLA/dLAI, projected area basis [m^2/gC]
- z0mr => pftcon%z0mr , & ! Input: ratio of momentum roughness length to canopy top height (-)
- displar => pftcon%displar , & ! Input: ratio of displacement height to canopy top height (-)
- dwood => pftcon%dwood , & ! Input: density of wood (gC/m^3)
- ztopmx => pftcon%ztopmx , & ! Input:
- laimx => pftcon%laimx , & ! Input:
-
- allom2 => dgv_ecophyscon%allom2 , & ! Input: [real(r8) (:) ] ecophys const
- allom3 => dgv_ecophyscon%allom3 , & ! Input: [real(r8) (:) ] ecophys const
-
- nind => dgvs_inst%nind_patch , & ! Input: [real(r8) (:) ] number of individuals (#/m**2)
- fpcgrid => dgvs_inst%fpcgrid_patch , & ! Input: [real(r8) (:) ] fractional area of patch (pft area/nat veg area)
-
- snow_depth => waterstate_inst%snow_depth_col , & ! Input: [real(r8) (:) ] snow height (m)
-
- forc_hgt_u_patch => frictionvel_inst%forc_hgt_u_patch , & ! Input: [real(r8) (:) ] observational height of wind at patch-level [m]
-
- leafc => cnveg_carbonstate_inst%leafc_patch , & ! Input: [real(r8) (:) ] (gC/m2) leaf C
- deadstemc => cnveg_carbonstate_inst%deadstemc_patch , & ! Input: [real(r8) (:) ] (gC/m2) dead stem C
-
- farea_burned => cnveg_state_inst%farea_burned_col , & ! Input: [real(r8) (:) ] F. Li and S. Levis
- htmx => cnveg_state_inst%htmx_patch , & ! Output: [real(r8) (:) ] max hgt attained by a crop during yr (m)
- peaklai => cnveg_state_inst%peaklai_patch , & ! Output: [integer (:) ] 1: max allowed lai; 0: not at max
-
- harvdate => crop_inst%harvdate_patch , & ! Input: [integer (:) ] harvest date
-
- ! *** Key Output from CN***
- tlai => canopystate_inst%tlai_patch , & ! Output: [real(r8) (:) ] one-sided leaf area index, no burying by snow
- tsai => canopystate_inst%tsai_patch , & ! Output: [real(r8) (:) ] one-sided stem area index, no burying by snow
- htop => canopystate_inst%htop_patch , & ! Output: [real(r8) (:) ] canopy top (m)
- hbot => canopystate_inst%hbot_patch , & ! Output: [real(r8) (:) ] canopy bottom (m)
- elai => canopystate_inst%elai_patch , & ! Output: [real(r8) (:) ] one-sided leaf area index with burying by snow
- esai => canopystate_inst%esai_patch , & ! Output: [real(r8) (:) ] one-sided stem area index with burying by snow
- frac_veg_nosno_alb => canopystate_inst%frac_veg_nosno_alb_patch & ! Output: [integer (:) ] frac of vegetation not covered by snow [-]
- )
-
- dt = real( get_rad_step_size(), r8 )
-
- ! constant allometric parameters
- taper = 200._r8
- stocking = 1000._r8
-
- ! convert from stems/ha -> stems/m^2
- stocking = stocking / 10000._r8
-
- ! patch loop
- do fp = 1,num_soilp
- p = filter_soilp(fp)
- c = patch%column(p)
- g = patch%gridcell(p)
-
- if (ivt(p) /= noveg) then
-
- tlai_old = tlai(p) ! n-1 value
- tsai_old = tsai(p) ! n-1 value
-
- ! update the leaf area index based on leafC and SLA
- ! Eq 3 from Thornton and Zimmerman, 2007, J Clim, 20, 3902-3923.
- if (dsladlai(ivt(p)) > 0._r8) then
- tlai(p) = (slatop(ivt(p))*(exp(leafc(p)*dsladlai(ivt(p))) - 1._r8))/dsladlai(ivt(p))
- else
- tlai(p) = slatop(ivt(p)) * leafc(p)
- end if
- tlai(p) = max(0._r8, tlai(p))
-
- ! update the stem area index and height based on LAI, stem mass, and veg type.
- ! With the exception of htop for woody vegetation, this follows the DGVM logic.
-
- ! tsai formula from Zeng et. al. 2002, Journal of Climate, p1835 (see notes)
- ! Assumes doalb time step .eq. CLM time step, SAI min and monthly decay factor
- ! alpha are set by PFT, and alpha is scaled to CLM time step by multiplying by
- ! dt and dividing by dtsmonth (seconds in average 30 day month)
- ! tsai_min scaled by 0.5 to match MODIS satellite derived values
- if (ivt(p) == nc3crop .or. ivt(p) == nc3irrig) then ! generic crops
-
- tsai_alpha = 1.0_r8-1.0_r8*dt/dtsmonth
- tsai_min = 0.1_r8
- else
- tsai_alpha = 1.0_r8-0.5_r8*dt/dtsmonth
- tsai_min = 1.0_r8
- end if
- tsai_min = tsai_min * 0.5_r8
- tsai(p) = max(tsai_alpha*tsai_old+max(tlai_old-tlai(p),0._r8),tsai_min)
-
- if (woody(ivt(p)) == 1._r8) then
-
- ! trees and shrubs
-
- ! if shrubs have a squat taper
- if (ivt(p) >= nbrdlf_evr_shrub .and. ivt(p) <= nbrdlf_dcd_brl_shrub) then
- taper = 10._r8
- ! otherwise have a tall taper
- else
- taper = 200._r8
- end if
-
- ! trees and shrubs for now have a very simple allometry, with hard-wired
- ! stem taper (height:radius) and hard-wired stocking density (#individuals/area)
- if (use_cndv) then
-
- if (fpcgrid(p) > 0._r8 .and. nind(p) > 0._r8) then
-
- stocking = nind(p)/fpcgrid(p) !#ind/m2 nat veg area -> #ind/m2 patch area
- htop(p) = allom2(ivt(p)) * ( (24._r8 * deadstemc(p) / &
- (SHR_CONST_PI * stocking * dwood(ivt(p)) * taper))**(1._r8/3._r8) )**allom3(ivt(p)) ! lpj's htop w/ cn's stemdiam
-
- else
- htop(p) = 0._r8
- end if
-
- else
- !correct height calculation if doing accelerated spinup
- if (spinup_state == 2) then
- htop(p) = ((3._r8 * deadstemc(p) * 10._r8 * taper * taper)/ &
- (SHR_CONST_PI * stocking * dwood(ivt(p))))**(1._r8/3._r8)
- else
- htop(p) = ((3._r8 * deadstemc(p) * taper * taper)/ &
- (SHR_CONST_PI * stocking * dwood(ivt(p))))**(1._r8/3._r8)
- end if
-
- endif
-
- ! Peter Thornton, 5/3/2004
- ! Adding test to keep htop from getting too close to forcing height for windspeed
- ! Also added for grass, below, although it is not likely to ever be an issue.
- htop(p) = min(htop(p),(forc_hgt_u_patch(p)/(displar(ivt(p))+z0mr(ivt(p))))-3._r8)
-
- ! Peter Thornton, 8/11/2004
- ! Adding constraint to keep htop from going to 0.0.
- ! This becomes an issue when fire mortality is pushing deadstemc
- ! to 0.0.
- htop(p) = max(htop(p), 0.01_r8)
-
- hbot(p) = max(0._r8, min(3._r8, htop(p)-1._r8))
-
- else if (ivt(p) >= npcropmin) then ! prognostic crops
-
- if (tlai(p) >= laimx(ivt(p))) peaklai(p) = 1 ! used in CNAllocation
-
- if (ivt(p) == ntmp_corn .or. ivt(p) == nirrig_tmp_corn .or. &
- ivt(p) == ntrp_corn .or. ivt(p) == nirrig_trp_corn .or. &
- ivt(p) == nsugarcane .or. ivt(p) == nirrig_sugarcane) then
- tsai(p) = 0.1_r8 * tlai(p)
- else
- tsai(p) = 0.2_r8 * tlai(p)
- end if
-
- ! "stubble" after harvest
- if (harvdate(p) < 999 .and. tlai(p) == 0._r8) then
- tsai(p) = 0.25_r8*(1._r8-farea_burned(c)*0.90_r8) !changed by F. Li and S. Levis
- htmx(p) = 0._r8
- peaklai(p) = 0
- end if
- !if (harvdate(p) < 999 .and. tlai(p) > 0._r8) write(iulog,*) 'CNVegStructUpdate: tlai>0 after harvest!' ! remove after initial debugging?
-
- ! canopy top and bottom heights
- htop(p) = ztopmx(ivt(p)) * (min(tlai(p)/(laimx(ivt(p))-1._r8),1._r8))**2
- htmx(p) = max(htmx(p), htop(p))
- htop(p) = max(0.05_r8, max(htmx(p),htop(p)))
- hbot(p) = 0.02_r8
-
- else ! generic crops and ...
-
- ! grasses
-
- ! height for grasses depends only on LAI
- htop(p) = max(0.25_r8, tlai(p) * 0.25_r8)
-
- htop(p) = min(htop(p),(forc_hgt_u_patch(p)/(displar(ivt(p))+z0mr(ivt(p))))-3._r8)
-
- ! Peter Thornton, 8/11/2004
- ! Adding constraint to keep htop from going to 0.0.
- htop(p) = max(htop(p), 0.01_r8)
-
- hbot(p) = max(0.0_r8, min(0.05_r8, htop(p)-0.20_r8))
- end if
-
- else
-
- tlai(p) = 0._r8
- tsai(p) = 0._r8
- htop(p) = 0._r8
- hbot(p) = 0._r8
-
- end if
-
- ! adjust lai and sai for burying by snow.
- ! snow burial fraction for short vegetation (e.g. grasses) as in
- ! Wang and Zeng, 2007.
- if (ivt(p) > noveg .and. ivt(p) <= nbrdlf_dcd_brl_shrub ) then
- ol = min( max(snow_depth(c)-hbot(p), 0._r8), htop(p)-hbot(p))
- fb = 1._r8 - ol / max(1.e-06_r8, htop(p)-hbot(p))
- else
- fb = 1._r8 - max(min(snow_depth(c),0.2_r8),0._r8)/0.2_r8 ! 0.2m is assumed
- !depth of snow required for complete burial of grasses
- endif
-
- elai(p) = max(tlai(p)*fb, 0.0_r8)
- esai(p) = max(tsai(p)*fb, 0.0_r8)
-
- ! Fraction of vegetation free of snow
- if ((elai(p) + esai(p)) > 0._r8) then
- frac_veg_nosno_alb(p) = 1
- else
- frac_veg_nosno_alb(p) = 0
- end if
-
- end do
-
- end associate
-
- end subroutine CNVegStructUpdate
-
-end module CNVegStructUpdateMod
diff --git a/src/biogeochem/CNVegetationFacade.F90 b/src/biogeochem/CNVegetationFacade.F90
deleted file mode 100644
index 02d0f98a..00000000
--- a/src/biogeochem/CNVegetationFacade.F90
+++ /dev/null
@@ -1,422 +0,0 @@
-module CNVegetationFacade
-
- !-----------------------------------------------------------------------
- ! !DESCRIPTION:
- ! Facade for the CN Vegetation subsystem.
- !
- ! (A "facade", in software engineering terms, is a unified interface to a set of
- ! interfaces in a subsystem. The facade defines a higher-level interface that makes the
- ! subsystem easier to use.)
- !
- ! NOTE(wjs, 2016-02-19) I envision that we will introduce an abstract base class
- ! (VegBase). Then both CNVeg and EDVeg will extend VegBase. The rest of the CLM code can
- ! then have an instance of VegBase, which depending on the run, can be either a CNVeg or
- ! EDVeg instance.
- !
- ! In addition, we probably want an implementation when running without CN or fates - i.e.,
- ! an SPVeg inst. This would provide implementations for get_leafn_patch,
- ! get_downreg_patch, etc., so that we don't need to handle the non-cn case here (note
- ! that, currently, we return NaN for most of these getters, because these arrays are
- ! invalid and shouldn't be used when running in SP mode). Also, in its EcosystemDynamics
- ! routine, it would call SatellitePhenology (but note that the desired interface for
- ! EcosystemDynamics would be quite different... could just pass everything needed by any
- ! model, and ignore unneeded arguments). Then we can get rid of comments in this module
- ! like, "only call if use_cn is true", as well as use_cn conditionals in this module.
- !
- ! NOTE(wjs, 2016-02-23) Currently, SatellitePhenology is called even when running with
- ! CN, for the sake of dry deposition. This seems weird to me, and my gut feeling -
- ! without understanding it well - is that this should be rewritten to depend on LAI from
- ! CN rather than from satellite phenology. Until that is done, the separation between SP
- ! and other Veg modes will be messier.
- !
- ! NOTE(wjs, 2016-02-23) Currently, this class coordinates calls to soil BGC routines as
- ! well as veg BGC routines (even though it doesn't contain any soil BGC types). This is
- ! because CNDriver coordinates both the veg & soil BGC. We should probably split up
- ! CNDriver so that there is a cleaner separation between veg BGC and soil BGC, to allow
- ! easier swapping of (for example) CN and ED. At that point, this class could
- ! coordinate just the calls to veg BGC routines, with a similar facade class
- ! coordinating the calls to soil BGC routines.
- !
- ! !USES:
-#include "shr_assert.h"
- use shr_kind_mod , only : r8 => shr_kind_r8
- use shr_infnan_mod , only : nan => shr_infnan_nan, assignment(=)
- use shr_log_mod , only : errMsg => shr_log_errMsg
- use perf_mod , only : t_startf, t_stopf
- use decompMod , only : bounds_type
- use clm_varctl , only : iulog, use_cn
- use abortutils , only : endrun
- use spmdMod , only : masterproc
- use CNBalanceCheckMod , only : cn_balance_type
- use CNVegStateType , only : cnveg_state_type
- use CNVegCarbonFluxType , only : cnveg_carbonflux_type
- use CNVegCarbonStateType , only : cnveg_carbonstate_type
- use CNVegNitrogenFluxType , only : cnveg_nitrogenflux_type
- use CNVegNitrogenStateType , only : cnveg_nitrogenstate_type
- use CNProductsMod , only : cn_products_type
- use SpeciesIsotopeType , only : species_isotope_type
- use SpeciesNonIsotopeType , only : species_non_isotope_type
- use CNDriverMod , only : CNDriverInit
- !
- implicit none
- private
-
- ! !PUBLIC TYPES:
-
- type, public :: cn_vegetation_type
- ! FIXME(bja, 2016-06) These need to be public for use when fates is
- ! turned on. Should either be moved out of here or create some ED
- ! version of the facade....
- type(cnveg_state_type) :: cnveg_state_inst
- type(cnveg_carbonstate_type) :: cnveg_carbonstate_inst
- type(cnveg_carbonflux_type) :: cnveg_carbonflux_inst
-
- !X!private
-
- type(cnveg_carbonstate_type) :: c13_cnveg_carbonstate_inst
- type(cnveg_carbonstate_type) :: c14_cnveg_carbonstate_inst
- type(cnveg_carbonflux_type) :: c13_cnveg_carbonflux_inst
- type(cnveg_carbonflux_type) :: c14_cnveg_carbonflux_inst
- type(cnveg_nitrogenstate_type) :: cnveg_nitrogenstate_inst
- type(cnveg_nitrogenflux_type) :: cnveg_nitrogenflux_inst
-
- type(cn_products_type) :: c_products_inst
- type(cn_products_type) :: c13_products_inst
- type(cn_products_type) :: c14_products_inst
- type(cn_products_type) :: n_products_inst
-
- type(cn_balance_type) :: cn_balance_inst
-
- ! Control variables
- logical, private :: reseed_dead_plants ! Flag to indicate if should reseed dead plants when starting up the model
-
- ! TODO(wjs, 2016-02-19) Evaluate whether some other variables should be moved in
- ! here. Whether they should be moved in depends on how tightly they are tied in with
- ! the other CN Vegetation stuff. A question to ask is: Is this module used when
- ! running with SP or ED? If so, then it should probably remain outside of CNVeg.
- !
- ! From the clm_instMod section on "CN vegetation types":
- ! - nutrient_competition_method
- ! - I'm pretty sure this should be moved into here; it's just a little messy to do
- ! so, because of how it's initialized (specifically, the call to readParameters
- ! in clm_initializeMod).
- !
- ! From the clm_instMod section on "general biogeochem types":
- ! - ch4_inst
- ! - probably not: really seems to belong in soilbiogeochem
- ! - crop_inst
- ! - dust_inst
- ! - vocemis_inst
- ! - fireemis_inst
- ! - drydepvel_inst
-
- contains
- procedure, public :: Init
- procedure, public :: InitAccBuffer
- procedure, public :: InitAccVars
- procedure, public :: Restart
-
- procedure, public :: Init2 ! Do initialization in initialize phase, after subgrid weights are determined
- procedure, public :: WriteHistory ! Do any history writes that are specific to veg dynamics
-
- procedure, public :: get_totvegc_col ! Get column-level total vegetation carbon array
-
- procedure, private :: CNReadNML ! Read in the CN general namelist
- end type cn_vegetation_type
-
- character(len=*), parameter, private :: sourcefile = &
- __FILE__
-
-contains
-
- !-----------------------------------------------------------------------
- subroutine Init(this, bounds, NLFilename)
- !
- ! !DESCRIPTION:
- ! Initialize a CNVeg object.
- !
- ! Should be called regardless of whether use_cn is true
- !
- ! !USES:
- use clm_varcon , only : c13ratio, c14ratio
- !
- ! !ARGUMENTS:
- class(cn_vegetation_type), intent(inout) :: this
- type(bounds_type), intent(in) :: bounds
- character(len=*) , intent(in) :: NLFilename ! namelist filename
- !
- ! !LOCAL VARIABLES:
- integer :: begp, endp
-
- character(len=*), parameter :: subname = 'Init'
- !-----------------------------------------------------------------------
-
- begp = bounds%begp
- endp = bounds%endp
-
- ! Note - always initialize the memory for cnveg_state_inst (used in biogeophys/)
- call this%cnveg_state_inst%Init(bounds)
-
- if (use_cn) then
-
- ! Read in the general CN namelist
- call this%CNReadNML( NLFilename ) ! MUST be called first as passes down control information to others
-
- call this%cnveg_carbonstate_inst%Init(bounds, carbon_type='c12', ratio=1._r8, NLFilename=NLFilename)
- call this%cnveg_carbonflux_inst%Init(bounds, carbon_type='c12')
- call this%cnveg_nitrogenstate_inst%Init(bounds, &
- this%cnveg_carbonstate_inst%leafc_patch(begp:endp), &
- this%cnveg_carbonstate_inst%leafc_storage_patch(begp:endp), &
- this%cnveg_carbonstate_inst%frootc_patch(begp:endp), &
- this%cnveg_carbonstate_inst%frootc_storage_patch(begp:endp), &
- this%cnveg_carbonstate_inst%deadstemc_patch(begp:endp) )
- call this%cnveg_nitrogenflux_inst%Init(bounds)
-
- call this%c_products_inst%Init(bounds, species_non_isotope_type('C'))
- call this%n_products_inst%Init(bounds, species_non_isotope_type('N'))
-
- call this%cn_balance_inst%Init(bounds)
-
- end if
-
- end subroutine Init
-
- !-----------------------------------------------------------------------
- subroutine CNReadNML( this, NLFilename )
- !
- ! !DESCRIPTION:
- ! Read in the general CN control namelist
- !
- ! !USES:
- use fileutils , only : getavu, relavu, opnfil
- use shr_nl_mod , only : shr_nl_find_group_name
- use spmdMod , only : masterproc, mpicom
- use shr_mpi_mod , only : shr_mpi_bcast
- use clm_varctl , only : iulog
- !
- ! !ARGUMENTS:
- class(cn_vegetation_type), intent(inout) :: this
- character(len=*) , intent(in) :: NLFilename ! Namelist filename
- !
- ! !LOCAL VARIABLES:
- integer :: ierr ! error code
- integer :: unitn ! unit for namelist file
-
- character(len=*), parameter :: subname = 'CNReadNML'
- character(len=*), parameter :: nmlname = 'cn_general' ! MUST match what is in namelist below
- !-----------------------------------------------------------------------
- logical :: reseed_dead_plants
- namelist /cn_general/ reseed_dead_plants
-
- reseed_dead_plants = this%reseed_dead_plants
-
- if (masterproc) then
- unitn = getavu()
- write(iulog,*) 'Read in '//nmlname//' namelist'
- call opnfil (NLFilename, unitn, 'F')
- call shr_nl_find_group_name(unitn, nmlname, status=ierr)
- if (ierr == 0) then
- read(unitn, nml=cn_general, iostat=ierr) ! Namelist name here MUST be the same as in nmlname above!
- if (ierr /= 0) then
- call endrun(msg="ERROR reading "//nmlname//"namelist"//errmsg(sourcefile, __LINE__))
- end if
- else
- call endrun(msg="ERROR could NOT find "//nmlname//"namelist"//errmsg(sourcefile, __LINE__))
- end if
- call relavu( unitn )
- end if
-
- call shr_mpi_bcast (reseed_dead_plants , mpicom)
-
- this%reseed_dead_plants = reseed_dead_plants
-
- if (masterproc) then
- write(iulog,*) ' '
- write(iulog,*) nmlname//' settings:'
- write(iulog,nml=cn_general) ! Name here MUST be the same as in nmlname above!
- write(iulog,*) ' '
- end if
-
- !-----------------------------------------------------------------------
-
- end subroutine CNReadNML
-
-
- !-----------------------------------------------------------------------
- subroutine InitAccBuffer(this, bounds)
- !
- ! !DESCRIPTION:
- ! Initialize accumulation buffer for types contained here
- !
- ! !USES:
- !
- ! !ARGUMENTS:
- class(cn_vegetation_type), intent(inout) :: this
- type(bounds_type), intent(in) :: bounds
- !
- ! !LOCAL VARIABLES:
-
- character(len=*), parameter :: subname = 'InitAccBuffer'
- !-----------------------------------------------------------------------
-
- end subroutine InitAccBuffer
-
- !-----------------------------------------------------------------------
- subroutine InitAccVars(this, bounds)
- !
- ! !DESCRIPTION:
- ! Initialize variables that are associated with accumulated fields
- !
- ! !USES:
- !
- ! !ARGUMENTS:
- class(cn_vegetation_type), intent(inout) :: this
- type(bounds_type), intent(in) :: bounds
- !
- ! !LOCAL VARIABLES:
-
- character(len=*), parameter :: subname = 'InitAccVars'
- !-----------------------------------------------------------------------
-
- end subroutine InitAccVars
-
- !-----------------------------------------------------------------------
- subroutine Restart(this, bounds, ncid, flag)
- !
- ! !DESCRIPTION:
- ! Handle restart (read / write) for CNVeg
- !
- ! Should be called regardless of whether use_cn is true
- !
- ! !USES:
- use ncdio_pio, only : file_desc_t
- use clm_varcon, only : c3_r2, c14ratio
- !
- ! !ARGUMENTS:
- class(cn_vegetation_type), intent(inout) :: this
- type(bounds_type), intent(in) :: bounds
- type(file_desc_t), intent(inout) :: ncid
- character(len=*) , intent(in) :: flag
- integer :: reseed_patch(bounds%endp-bounds%begp+1)
- integer :: num_reseed_patch
- !
- ! !LOCAL VARIABLES:
-
- integer :: begp, endp
-
- character(len=*), parameter :: subname = 'Restart'
- !-----------------------------------------------------------------------
-
- if (use_cn) then
- begp = bounds%begp
- endp = bounds%endp
- call this%cnveg_carbonstate_inst%restart(bounds, ncid, flag=flag, carbon_type='c12', &
- reseed_dead_plants=this%reseed_dead_plants, filter_reseed_patch=reseed_patch, &
- num_reseed_patch=num_reseed_patch )
- if ( flag /= 'read' .and. num_reseed_patch /= 0 )then
- call endrun(msg="ERROR num_reseed should be zero and is not"//errmsg(sourcefile, __LINE__))
- end if
- call this%cnveg_carbonflux_inst%restart(bounds, ncid, flag=flag, carbon_type='c12')
-
- call this%cnveg_nitrogenstate_inst%restart(bounds, ncid, flag=flag, &
- leafc_patch=this%cnveg_carbonstate_inst%leafc_patch(begp:endp), &
- leafc_storage_patch=this%cnveg_carbonstate_inst%leafc_storage_patch(begp:endp), &
- frootc_patch=this%cnveg_carbonstate_inst%frootc_patch(begp:endp), &
- frootc_storage_patch=this%cnveg_carbonstate_inst%frootc_storage_patch(begp:endp), &
- deadstemc_patch=this%cnveg_carbonstate_inst%deadstemc_patch(begp:endp), &
- filter_reseed_patch=reseed_patch, num_reseed_patch=num_reseed_patch)
- call this%cnveg_nitrogenflux_inst%restart(bounds, ncid, flag=flag)
- call this%cnveg_state_inst%restart(bounds, ncid, flag=flag, &
- cnveg_carbonstate=this%cnveg_carbonstate_inst, &
- cnveg_nitrogenstate=this%cnveg_nitrogenstate_inst, &
- filter_reseed_patch=reseed_patch, num_reseed_patch=num_reseed_patch)
-
- call this%c_products_inst%restart(bounds, ncid, flag)
- call this%n_products_inst%restart(bounds, ncid, flag)
-
- end if
-
- end subroutine Restart
-
- !-----------------------------------------------------------------------
- subroutine Init2(this, bounds, NLFilename)
- !
- ! !DESCRIPTION:
- ! Do initialization that is needed in the initialize phase, after subgrid weights are
- ! determined
- !
- ! Should only be called if use_cn is true
- !
- ! !USES:
- !
- ! !ARGUMENTS:
- class(cn_vegetation_type) , intent(inout) :: this
- type(bounds_type) , intent(in) :: bounds
- character(len=*) , intent(in) :: NLFilename ! namelist filename
- !
- ! !LOCAL VARIABLES:
-
- character(len=*), parameter :: subname = 'Init2'
- !-----------------------------------------------------------------------
-
- call CNDriverInit(bounds, NLFilename )
-
- end subroutine Init2
-
-
- !-----------------------------------------------------------------------
- subroutine WriteHistory(this, bounds)
- !
- ! !DESCRIPTION:
- ! Do any history writes that are specific to vegetation dynamics
- !
- ! NOTE(wjs, 2016-02-23) This could probably be combined with
- ! EndOfTimeStepVegDynamics, except for the fact that (currently) history writes are
- ! done with proc bounds rather than clump bounds. If that were changed, then the body
- ! of this could be moved into EndOfTimeStepVegDynamics, inside a "if (.not.
- ! use_noio)" conditional.
- !
- ! Should only be called if use_cn is true
- !
- ! !USES:
- !
- ! !ARGUMENTS:
- class(cn_vegetation_type), intent(in) :: this
- type(bounds_type) , intent(in) :: bounds
- !
- ! !LOCAL VARIABLES:
-
- character(len=*), parameter :: subname = 'WriteHistory'
- !-----------------------------------------------------------------------
-
- end subroutine WriteHistory
-
- !-----------------------------------------------------------------------
- function get_totvegc_col(this, bounds) result(totvegc_col)
- !
- ! !DESCRIPTION:
- ! Get column-level total vegetation carbon array
- !
- ! !USES:
- !
- ! !ARGUMENTS:
- class(cn_vegetation_type), intent(in) :: this
- type(bounds_type), intent(in) :: bounds
- real(r8) :: totvegc_col(bounds%begc:bounds%endc) ! function result: (gC/m2)
- !
- ! !LOCAL VARIABLES:
-
- character(len=*), parameter :: subname = 'get_totvegc_col'
- !-----------------------------------------------------------------------
-
- if (use_cn) then
- totvegc_col(bounds%begc:bounds%endc) = &
- this%cnveg_carbonstate_inst%totvegc_col(bounds%begc:bounds%endc)
- else
- totvegc_col(bounds%begc:bounds%endc) = nan
- end if
-
- end function get_totvegc_col
-
-
-end module CNVegetationFacade
diff --git a/src/biogeochem/CropType.F90 b/src/biogeochem/CropType.F90
deleted file mode 100644
index 1b28927b..00000000
--- a/src/biogeochem/CropType.F90
+++ /dev/null
@@ -1,644 +0,0 @@
-module CropType
-
-#include "shr_assert.h"
-
- !-----------------------------------------------------------------------
- ! !DESCRIPTION:
- ! Module containing variables needed for the crop model
- !
- ! TODO(wjs, 2014-08-05) Move more crop-specific variables into here - many are
- ! currently in CNVegStateType
- !
- ! !USES:
- use shr_kind_mod , only : r8 => shr_kind_r8
- use shr_log_mod , only : errMsg => shr_log_errMsg
- use spmdMod , only : masterproc
- use abortutils , only : endrun
- use decompMod , only : bounds_type
- use clm_varcon , only : spval
- use clm_varctl , only : iulog, use_crop
- !
- ! !PUBLIC TYPES:
- implicit none
- private
- !
- ! !PUBLIC DATA TYPES:
- !
- ! Crop state variables structure
- type, public :: crop_type
-
- ! Note that cropplant and harvdate could be 2D to facilitate rotation
- integer , pointer :: nyrs_crop_active_patch (:) ! number of years this crop patch has been active (0 for non-crop patches)
- logical , pointer :: croplive_patch (:) ! patch Flag, true if planted, not harvested
- logical , pointer :: cropplant_patch (:) ! patch Flag, true if planted
- integer , pointer :: harvdate_patch (:) ! patch harvest date
- real(r8), pointer :: fertnitro_patch (:) ! patch fertilizer nitrogen
- real(r8), pointer :: gddplant_patch (:) ! patch accum gdd past planting date for crop (ddays)
- real(r8), pointer :: gddtsoi_patch (:) ! patch growing degree-days from planting (top two soil layers) (ddays)
- real(r8), pointer :: vf_patch (:) ! patch vernalization factor for cereal
- real(r8), pointer :: cphase_patch (:) ! phenology phase
- real(r8), pointer :: latbaset_patch (:) ! Latitude vary baset for gddplant (degree C)
- character(len=20) :: baset_mapping
- real(r8) :: baset_latvary_intercept
- real(r8) :: baset_latvary_slope
-
- contains
- ! Public routines
- procedure, public :: Init ! Initialize the crop type
- procedure, public :: InitAccBuffer
- procedure, public :: InitAccVars
- procedure, public :: Restart
- ! NOTE(wjs, 2014-09-29) need to rename this from UpdateAccVars to CropUpdateAccVars
- ! to prevent cryptic error messages with pgi (v. 13.9 on yellowstone)
- ! This is probably related to this bug
- ! , which was fixed in pgi 14.7.
- procedure, public :: CropUpdateAccVars
-
- procedure, public :: CropIncrementYear
-
- ! Private routines
- procedure, private :: InitAllocate
- procedure, private :: InitHistory
- procedure, private :: InitCold
- procedure, private, nopass :: checkDates
-
- end type crop_type
-
- character(len=*), parameter, private :: baset_map_constant = 'constant'
- character(len=*), parameter, private :: baset_map_latvary = 'varytropicsbylat'
- character(len=*), parameter, private :: sourcefile = &
- __FILE__
-
- !------------------------------------------------------------------------
-
-contains
-
- !-----------------------------------------------------------------------
- subroutine Init(this, bounds)
- !
- ! !ARGUMENTS:
- class(crop_type) , intent(inout) :: this
- type(bounds_type), intent(in) :: bounds
- !
- ! !LOCAL VARIABLES:
-
- character(len=*), parameter :: subname = 'Init'
- !-----------------------------------------------------------------------
-
- call this%InitAllocate(bounds)
-
- if (use_crop) then
- call this%InitHistory(bounds)
- call this%InitCold(bounds)
- end if
-
- end subroutine Init
-
- !-----------------------------------------------------------------------
- subroutine InitAllocate(this, bounds)
- ! !USES:
- !
- ! !ARGUMENTS:
- class(crop_type) , intent(inout) :: this
- type(bounds_type), intent(in) :: bounds
- !
- ! !LOCAL VARIABLES:
- integer :: begp, endp
-
- character(len=*), parameter :: subname = 'InitAllocate'
- !-----------------------------------------------------------------------
-
- begp = bounds%begp; endp = bounds%endp
-
- allocate(this%nyrs_crop_active_patch(begp:endp)) ; this%nyrs_crop_active_patch(:) = 0
- allocate(this%croplive_patch (begp:endp)) ; this%croplive_patch (:) = .false.
- allocate(this%cropplant_patch(begp:endp)) ; this%cropplant_patch(:) = .false.
- allocate(this%harvdate_patch (begp:endp)) ; this%harvdate_patch (:) = huge(1)
- allocate(this%fertnitro_patch (begp:endp)) ; this%fertnitro_patch (:) = spval
- allocate(this%gddplant_patch (begp:endp)) ; this%gddplant_patch (:) = spval
- allocate(this%gddtsoi_patch (begp:endp)) ; this%gddtsoi_patch (:) = spval
- allocate(this%vf_patch (begp:endp)) ; this%vf_patch (:) = 0.0_r8
- allocate(this%cphase_patch (begp:endp)) ; this%cphase_patch (:) = 0.0_r8
- allocate(this%latbaset_patch (begp:endp)) ; this%latbaset_patch (:) = spval
-
- end subroutine InitAllocate
-
- !-----------------------------------------------------------------------
- subroutine InitHistory(this, bounds)
- !
- ! !USES:
- use histFileMod , only : hist_addfld1d
- !
- ! !ARGUMENTS:
- class(crop_type), intent(inout) :: this
- type(bounds_type), intent(in) :: bounds
- !
- ! !LOCAL VARIABLES:
- integer :: begp, endp
-
- character(len=*), parameter :: subname = 'InitHistory'
- !-----------------------------------------------------------------------
-
- begp = bounds%begp; endp = bounds%endp
-
- this%fertnitro_patch(begp:endp) = spval
- call hist_addfld1d (fname='FERTNITRO', units='gN/m2/yr', &
- avgflag='A', long_name='Nitrogen fertilizer for each crop', &
- ptr_patch=this%fertnitro_patch, default='inactive')
-
- this%gddplant_patch(begp:endp) = spval
- call hist_addfld1d (fname='GDDPLANT', units='ddays', &
- avgflag='A', long_name='Accumulated growing degree days past planting date for crop', &
- ptr_patch=this%gddplant_patch, default='inactive')
-
- this%gddtsoi_patch(begp:endp) = spval
- call hist_addfld1d (fname='GDDTSOI', units='ddays', &
- avgflag='A', long_name='Growing degree-days from planting (top two soil layers)', &
- ptr_patch=this%gddtsoi_patch, default='inactive')
-
- this%cphase_patch(begp:endp) = spval
- call hist_addfld1d (fname='CPHASE', units='0-not planted, 1-planted, 2-leaf emerge, 3-grain fill, 4-harvest', &
- avgflag='A', long_name='crop phenology phase', &
- ptr_patch=this%cphase_patch, default='inactive')
-
- if ( (trim(this%baset_mapping) == baset_map_latvary) )then
- this%latbaset_patch(begp:endp) = spval
- call hist_addfld1d (fname='LATBASET', units='degree C', &
- avgflag='A', long_name='latitude vary base temperature for gddplant', &
- ptr_patch=this%latbaset_patch, default='inactive')
- end if
-
- end subroutine InitHistory
-
- subroutine InitCold(this, bounds)
- ! !USES:
- use LandunitType, only : lun
- use landunit_varcon, only : istcrop
- use PatchType, only : patch
- use clm_instur, only : fert_cft
- use pftconMod , only : pftcon
- use GridcellType , only : grc
- use shr_infnan_mod , only : nan => shr_infnan_nan, assignment(=)
- ! !ARGUMENTS:
- class(crop_type), intent(inout) :: this
- type(bounds_type), intent(in) :: bounds
- !
- ! !LOCAL VARIABLES:
- integer :: c, l, g, p, m, ivt ! indices
-
- character(len=*), parameter :: subname = 'InitCold'
- !-----------------------------------------------------------------------
-
-!DLL - added wheat & sugarcane restrictions to base T vary by lat
- do p= bounds%begp,bounds%endp
- g = patch%gridcell(p)
- ivt = patch%itype(p)
-
- this%nyrs_crop_active_patch(p) = 0
-
- if ( grc%latdeg(g) >= 0.0_r8 .and. grc%latdeg(g) <= 30.0_r8) then
- this%latbaset_patch(p)=pftcon%baset(ivt)+12._r8-0.4_r8*grc%latdeg(g)
- else if (grc%latdeg(g) < 0.0_r8 .and. grc%latdeg(g) >= -30.0_r8) then
- this%latbaset_patch(p)=pftcon%baset(ivt)+12._r8+0.4_r8*grc%latdeg(g)
- else
- this%latbaset_patch(p)=pftcon%baset(ivt)
- end if
- if ( trim(this%baset_mapping) == baset_map_constant ) then
- this%latbaset_patch(p) = nan
- end if
- end do
-!DLL -- end of mods
-
- if (use_crop) then
- do p= bounds%begp,bounds%endp
- g = patch%gridcell(p)
- l = patch%landunit(p)
- c = patch%column(p)
-
- if (lun%itype(l) == istcrop) then
- m = patch%itype(p)
- this%fertnitro_patch(p) = fert_cft(g,m)
- end if
- end do
- end if
-
- end subroutine InitCold
-
- !-----------------------------------------------------------------------
-
- !-----------------------------------------------------------------------
- subroutine InitAccBuffer (this, bounds)
- !
- ! !DESCRIPTION:
- ! Initialize accumulation buffer for all required module accumulated fields
- ! This routine set defaults values that are then overwritten by the
- ! restart file for restart or branch runs
- ! Each interval and accumulation type is unique to each field processed.
- ! Routine [initAccBuffer] defines the fields to be processed
- ! and the type of accumulation.
- ! Routine [updateAccVars] does the actual accumulation for a given field.
- ! Fields are accumulated by calls to subroutine [update_accum_field].
- ! To accumulate a field, it must first be defined in subroutine [initAccVars]
- ! and then accumulated by calls to [updateAccVars].
- !
- ! Should only be called if use_crop is true
- !
- ! !USES
- use accumulMod , only : init_accum_field
- !
- ! !ARGUMENTS:
- class(crop_type) , intent(in) :: this
- type(bounds_type), intent(in) :: bounds
-
- !
- ! !LOCAL VARIABLES:
- integer, parameter :: not_used = huge(1)
-
- !---------------------------------------------------------------------
-
- call init_accum_field (name='GDDPLANT', units='K', &
- desc='growing degree-days from planting', accum_type='runaccum', accum_period=not_used, &
- subgrid_type='pft', numlev=1, init_value=0._r8)
-
- call init_accum_field (name='GDDTSOI', units='K', &
- desc='growing degree-days from planting (top two soil layers)', accum_type='runaccum', accum_period=not_used, &
- subgrid_type='pft', numlev=1, init_value=0._r8)
-
- end subroutine InitAccBuffer
-
- !-----------------------------------------------------------------------
- subroutine InitAccVars(this, bounds)
- !
- ! !DESCRIPTION:
- ! Initialize module variables that are associated with
- ! time accumulated fields. This routine is called for both an initial run
- ! and a restart run (and must therefore must be called after the restart file
- ! is read in and the accumulation buffer is obtained)
- !
- ! !USES:
- use accumulMod , only : extract_accum_field
- use clm_time_manager , only : get_nstep
- !
- ! !ARGUMENTS:
- class(crop_type), intent(inout) :: this
- type(bounds_type), intent(in) :: bounds
- !
- ! !LOCAL VARIABLES:
- integer :: begp, endp
- integer :: nstep
- integer :: ier
- real(r8), pointer :: rbufslp(:) ! temporary
-
- character(len=*), parameter :: subname = 'InitAccVars'
- !-----------------------------------------------------------------------
-
- begp = bounds%begp; endp = bounds%endp
-
- ! Allocate needed dynamic memory for single level patch field
- allocate(rbufslp(begp:endp), stat=ier)
- if (ier/=0) then
- write(iulog,*)' in '
- call endrun(msg=" allocation error for rbufslp"//&
- errMsg(sourcefile, __LINE__))
- endif
-
- nstep = get_nstep()
-
- call extract_accum_field ('GDDPLANT', rbufslp, nstep)
- this%gddplant_patch(begp:endp) = rbufslp(begp:endp)
-
- call extract_accum_field ('GDDTSOI', rbufslp, nstep)
- this%gddtsoi_patch(begp:endp) = rbufslp(begp:endp)
-
- deallocate(rbufslp)
-
- end subroutine InitAccVars
-
- !-----------------------------------------------------------------------
- subroutine Restart(this, bounds, ncid, flag)
- !
- ! !USES:
- use restUtilMod
- use ncdio_pio
- use PatchType, only : patch
- use pftconMod, only : npcropmin, npcropmax
- !
- ! !ARGUMENTS:
- class(crop_type), intent(inout) :: this
- type(bounds_type), intent(in) :: bounds
- type(file_desc_t), intent(inout) :: ncid
- character(len=*) , intent(in) :: flag
- !
- ! !LOCAL VARIABLES:
- integer, pointer :: temp1d(:) ! temporary
- integer :: restyear
- integer :: p
- logical :: readvar ! determine if variable is on initial file
-
- character(len=*), parameter :: subname = 'Restart'
- !-----------------------------------------------------------------------
-
- if (use_crop) then
- call restartvar(ncid=ncid, flag=flag, varname='nyrs_crop_active', xtype=ncd_int, &
- dim1name='pft', &
- long_name='Number of years this crop patch has been active (0 for non-crop patches)', &
- units='years', &
- interpinic_flag='interp', readvar=readvar, data=this%nyrs_crop_active_patch)
- if (flag == 'read' .and. .not. readvar) then
- ! BACKWARDS_COMPATIBILITY(wjs, 2017-02-17) Old restart files did not have this
- ! patch-level variable. Instead, they had a single scalar tracking the number
- ! of years the crop model ran. Copy this scalar onto all *active* crop patches.
-
- ! Some arguments in the following restartvar call are irrelevant, because we
- ! only call this for 'read'. I'm simply maintaining the old restartvar call.
- call restartvar(ncid=ncid, flag=flag, varname='restyear', xtype=ncd_int, &
- long_name='Number of years prognostic crop ran', units="years", &
- interpinic_flag='copy', readvar=readvar, data=restyear)
- if (readvar) then
- do p = bounds%begp, bounds%endp
- if (patch%itype(p) >= npcropmin .and. patch%itype(p) <= npcropmax .and. &
- patch%active(p)) then
- this%nyrs_crop_active_patch(p) = restyear
- end if
- end do
- end if
- end if
-
- allocate(temp1d(bounds%begp:bounds%endp))
- if (flag == 'write') then
- do p= bounds%begp,bounds%endp
- if (this%croplive_patch(p)) then
- temp1d(p) = 1
- else
- temp1d(p) = 0
- end if
- end do
- end if
- call restartvar(ncid=ncid, flag=flag, varname='croplive', xtype=ncd_log, &
- dim1name='pft', &
- long_name='Flag that crop is alive, but not harvested', &
- interpinic_flag='interp', readvar=readvar, data=temp1d)
- if (flag == 'read') then
- do p= bounds%begp,bounds%endp
- if (temp1d(p) == 1) then
- this%croplive_patch(p) = .true.
- else
- this%croplive_patch(p) = .false.
- end if
- end do
- end if
- deallocate(temp1d)
-
- allocate(temp1d(bounds%begp:bounds%endp))
- if (flag == 'write') then
- do p= bounds%begp,bounds%endp
- if (this%cropplant_patch(p)) then
- temp1d(p) = 1
- else
- temp1d(p) = 0
- end if
- end do
- end if
- call restartvar(ncid=ncid, flag=flag, varname='cropplant', xtype=ncd_log, &
- dim1name='pft', &
- long_name='Flag that crop is planted, but not harvested' , &
- interpinic_flag='interp', readvar=readvar, data=temp1d)
- if (flag == 'read') then
- do p= bounds%begp,bounds%endp
- if (temp1d(p) == 1) then
- this%cropplant_patch(p) = .true.
- else
- this%cropplant_patch(p) = .false.
- end if
- end do
- end if
- deallocate(temp1d)
-
- call restartvar(ncid=ncid, flag=flag, varname='harvdate', xtype=ncd_int, &
- dim1name='pft', long_name='harvest date', units='jday', nvalid_range=(/1,366/), &
- interpinic_flag='interp', readvar=readvar, data=this%harvdate_patch)
-
- call restartvar(ncid=ncid, flag=flag, varname='vf', xtype=ncd_double, &
- dim1name='pft', long_name='vernalization factor', units='', &
- interpinic_flag='interp', readvar=readvar, data=this%vf_patch)
-
- call restartvar(ncid=ncid, flag=flag, varname='cphase',xtype=ncd_double, &
- dim1name='pft', long_name='crop phenology phase', &
- units='0-not planted, 1-planted, 2-leaf emerge, 3-grain fill, 4-harvest', &
- interpinic_flag='interp', readvar=readvar, data=this%cphase_patch)
- if (flag=='read' )then
- call this%checkDates( ) ! Check that restart date is same calendar date (even if year is different)
- ! This is so that it properly goes through
- ! the crop phases
- end if
- end if
-
- end subroutine Restart
-
-
- !-----------------------------------------------------------------------
- subroutine CropUpdateAccVars(this, bounds, t_ref2m_patch, t_soisno_col)
- !
- ! !DESCRIPTION:
- ! Update accumulated variables. Should be called every time step.
- ! Should only be called if use_crop is true.
- !
- ! !USES:
- use accumulMod , only : update_accum_field, extract_accum_field, accumResetVal
- use shr_const_mod , only : SHR_CONST_CDAY, SHR_CONST_TKFRZ
- use clm_time_manager , only : get_step_size, get_nstep
- use clm_varpar , only : nlevsno, nlevgrnd
- use pftconMod , only : nswheat, nirrig_swheat, pftcon
- use pftconMod , only : nwwheat, nirrig_wwheat
- use pftconMod , only : nsugarcane, nirrig_sugarcane
- use ColumnType , only : col
- use PatchType , only : patch
- !
- ! !ARGUMENTS:
- implicit none
- class(crop_type) , intent(inout) :: this
- type(bounds_type) , intent(in) :: bounds
- real(r8) , intent(in) :: t_ref2m_patch( bounds%begp:)
- real(r8) , intent(inout) :: t_soisno_col(bounds%begc:, -nlevsno+1:)
- !
- ! !LOCAL VARIABLES:
- integer :: p,c,g ! indices
- integer :: ivt ! vegetation type
- integer :: dtime ! timestep size [seconds]
- integer :: nstep ! timestep number
- integer :: ier ! error status
- integer :: begp, endp
- integer :: begc, endc
- real(r8), pointer :: rbufslp(:) ! temporary single level - patch level
- character(len=*), parameter :: subname = 'CropUpdateAccVars'
- !-----------------------------------------------------------------------
-
- begp = bounds%begp; endp = bounds%endp
- begc = bounds%begc; endc = bounds%endc
-
- ! Enforce expected array sizes
- SHR_ASSERT_ALL((ubound(t_ref2m_patch) == (/endp/)) , errMsg(sourcefile, __LINE__))
- SHR_ASSERT_ALL((ubound(t_soisno_col) == (/endc,nlevgrnd/)) , errMsg(sourcefile, __LINE__))
-
- dtime = get_step_size()
- nstep = get_nstep()
-
- ! Allocate needed dynamic memory for single level patch field
-
- allocate(rbufslp(begp:endp), stat=ier)
- if (ier/=0) then
- write(iulog,*)'update_accum_hist allocation error for rbuf1dp'
- call endrun(msg=errMsg(sourcefile, __LINE__))
- endif
-
- ! Accumulate and extract GDDPLANT
-
- call extract_accum_field ('GDDPLANT', rbufslp, nstep)
- do p = begp,endp
- rbufslp(p) = max(0.,this%gddplant_patch(p)-rbufslp(p))
- end do
- call update_accum_field ('GDDPLANT', rbufslp, nstep)
- do p = begp,endp
- if (this%croplive_patch(p)) then ! relative to planting date
- ivt = patch%itype(p)
- if ( (trim(this%baset_mapping) == baset_map_latvary) .and. &
- ((ivt == nswheat) .or. (ivt == nirrig_swheat) .or. &
- (ivt == nsugarcane) .or. (ivt == nirrig_sugarcane)) ) then
- rbufslp(p) = max(0._r8, min(pftcon%mxtmp(ivt), &
- t_ref2m_patch(p)-(SHR_CONST_TKFRZ + this%latbaset_patch(p)))) &
- * dtime/SHR_CONST_CDAY
- else
- rbufslp(p) = max(0._r8, min(pftcon%mxtmp(ivt), &
- t_ref2m_patch(p)-(SHR_CONST_TKFRZ + pftcon%baset(ivt)))) &
- * dtime/SHR_CONST_CDAY
- end if
- if (ivt == nwwheat .or. ivt == nirrig_wwheat) then
- rbufslp(p) = rbufslp(p) * this%vf_patch(p)
- end if
- else
- rbufslp(p) = accumResetVal
- end if
- end do
- call update_accum_field ('GDDPLANT', rbufslp, nstep)
- call extract_accum_field ('GDDPLANT', this%gddplant_patch, nstep)
-
- ! Accumulate and extract GDDTSOI
- ! In agroibis this variable is calculated
- ! to 0.05 m, so here we use the top two soil layers
-
- do p = begp,endp
- if (this%croplive_patch(p)) then ! relative to planting date
- ivt = patch%itype(p)
- c = patch%column(p)
- rbufslp(p) = max(0._r8, min(pftcon%mxtmp(ivt), &
- ((t_soisno_col(c,1)*col%dz(c,1) + &
- t_soisno_col(c,2)*col%dz(c,2))/(col%dz(c,1)+col%dz(c,2))) - &
- (SHR_CONST_TKFRZ + pftcon%baset(ivt)))) * dtime/SHR_CONST_CDAY
- if (ivt == nwwheat .or. ivt == nwwheat) then
- rbufslp(p) = rbufslp(p) * this%vf_patch(p)
- end if
- else
- rbufslp(p) = accumResetVal
- end if
- end do
- call update_accum_field ('GDDTSOI', rbufslp, nstep)
- call extract_accum_field ('GDDTSOI', this%gddtsoi_patch, nstep)
-
- deallocate(rbufslp)
-
- end subroutine CropUpdateAccVars
-
- !-----------------------------------------------------------------------
- subroutine CropIncrementYear (this, num_pcropp, filter_pcropp)
- !
- ! !DESCRIPTION:
- ! Increment the crop year, if appropriate
- !
- ! This routine should be called every time step
- !
- ! !USES:
- use clm_time_manager , only : get_curr_date, is_first_step
- !
- ! !ARGUMENTS:
- class(crop_type) :: this
- integer , intent(in) :: num_pcropp ! number of prog. crop patches in filter
- integer , intent(in) :: filter_pcropp(:) ! filter for prognostic crop patches
- !
- ! !LOCAL VARIABLES:
- 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 :: fp, p
- !-----------------------------------------------------------------------
-
- call get_curr_date ( kyr, kmo, kda, mcsec)
- ! Update nyrs when it's the end of the year (unless it's the very start of the
- ! run). This assumes that, if this patch is active at the end of the year, then it was
- ! active for the whole year.
- if ((kmo == 1 .and. kda == 1 .and. mcsec == 0) .and. .not. is_first_step()) then
- do fp = 1, num_pcropp
- p = filter_pcropp(fp)
-
- this%nyrs_crop_active_patch(p) = this%nyrs_crop_active_patch(p) + 1
- end do
- end if
-
- end subroutine CropIncrementYear
-
- !-----------------------------------------------------------------------
- subroutine checkDates( )
- !
- ! !DESCRIPTION:
- ! Make sure the dates are compatible. The date given to startup the model
- ! and the date on the restart file must be the same although years can be
- ! different. The dates need to be checked when the restart file is being
- ! read in for a startup or branch case (they are NOT allowed to be different
- ! for a restart case).
- !
- ! For the prognostic crop model the date of planting is tracked and growing
- ! degree days is tracked (with a 20 year mean) -- so shifting the start dates
- ! messes up these bits of saved information.
- !
- ! !ARGUMENTS:
- use clm_time_manager, only : get_driver_start_ymd, get_start_date
- use clm_varctl , only : iulog
- use clm_varctl , only : nsrest, nsrBranch, nsrStartup
- !
- ! !LOCAL VARIABLES:
- integer :: stymd ! Start date YYYYMMDD from driver
- integer :: styr ! Start year from driver
- integer :: stmon_day ! Start date MMDD from driver
- integer :: rsmon_day ! Restart date MMDD from restart file
- integer :: rsyr ! Restart year from restart file
- integer :: rsmon ! Restart month from restart file
- integer :: rsday ! Restart day from restart file
- integer :: tod ! Restart time of day from restart file
- character(len=*), parameter :: formDate = '(A,i4.4,"/",i2.2,"/",i2.2)' ! log output format
- character(len=32) :: subname = 'CropRest::checkDates'
- !-----------------------------------------------------------------------
- !
- ! If branch or startup make sure the startdate is compatible with the date
- ! on the restart file.
- !
- if ( nsrest == nsrBranch .or. nsrest == nsrStartup )then
- stymd = get_driver_start_ymd()
- styr = stymd / 10000
- stmon_day = stymd - styr*10000
- call get_start_date( rsyr, rsmon, rsday, tod )
- rsmon_day = rsmon*100 + rsday
- if ( masterproc ) &
- write(iulog,formDate) 'Date on the restart file is: ', rsyr, rsmon, rsday
- if ( stmon_day /= rsmon_day )then
- write(iulog,formDate) 'Start date is: ', styr, stmon_day/100, &
- (stmon_day - stmon_day/100)
- call endrun(msg=' ERROR: For prognostic crop to work correctly, the start date (month and day)'// &
- ' and the date on the restart file needs to match (years can be different)'//&
- errMsg(sourcefile, __LINE__))
- end if
- end if
-
- end subroutine checkDates
-
-end module CropType
-
diff --git a/src/biogeochem/DUSTMod.F90 b/src/biogeochem/DUSTMod.F90
deleted file mode 100644
index 6a906e41..00000000
--- a/src/biogeochem/DUSTMod.F90
+++ /dev/null
@@ -1,925 +0,0 @@
-module DUSTMod
-
- !-----------------------------------------------------------------------
- ! !DESCRIPTION:
- ! Routines in this module calculate Dust mobilization and dry deposition for dust.
- ! Simulates dust mobilization due to wind from the surface into the
- ! lowest atmospheric layer. On output flx_mss_vrt_dst(ndst) is the surface dust
- ! emission (kg/m**2/s) [ + = to atm].
- ! Calculates the turbulent component of dust dry deposition, (the turbulent deposition
- ! velocity through the lowest atmospheric layer). CAM will calculate the settling
- ! velocity through the whole atmospheric column. The two calculations will determine
- ! the dust dry deposition flux to the surface.
- !
- ! !USES:
- use shr_kind_mod , only : r8 => shr_kind_r8
- use shr_log_mod , only : errMsg => shr_log_errMsg
- use shr_infnan_mod , only : nan => shr_infnan_nan, assignment(=)
- use clm_varpar , only : dst_src_nbr, ndst, sz_nbr
- use clm_varcon , only : grav, spval
- use landunit_varcon , only : istcrop, istsoil
- use clm_varctl , only : iulog
- use abortutils , only : endrun
- use subgridAveMod , only : p2l_1d
- use decompMod , only : bounds_type
- use atm2lndType , only : atm2lnd_type
- use SoilStateType , only : soilstate_type
- use CanopyStateType , only : canopystate_type
- use WaterstateType , only : waterstate_type
- use FrictionVelocityMod , only : frictionvel_type
- use LandunitType , only : lun
- use ColumnType , only : col
- use PatchType , only : patch
- !
- ! !PUBLIC TYPES
- implicit none
- private
- !
- ! !PUBLIC MEMBER FUNCTIONS:
- !
- public DustEmission ! Dust mobilization
- public DustDryDep ! Turbulent dry deposition for dust
- !
- ! !PUBLIC DATA:
- !
- real(r8) , allocatable :: ovr_src_snk_mss(:,:)
- real(r8) , allocatable :: dmt_vwr(:) ![m] Mass-weighted mean diameter resolved
- real(r8) , allocatable :: stk_crc(:) ![frc] Correction to Stokes settling velocity
- real(r8) tmp1 !Factor in saltation computation (named as in Charlie's code)
- real(r8) dns_aer ![kg m-3] Aerosol density
- !
- ! !PUBLIC DATA TYPES:
- !
- type, public :: dust_type
-
- real(r8), pointer, PUBLIC :: flx_mss_vrt_dst_patch (:,:) ! surface dust emission (kg/m**2/s) [ + = to atm] (ndst)
- real(r8), pointer, private :: flx_mss_vrt_dst_tot_patch (:) ! total dust flux into atmosphere
- real(r8), pointer, private :: vlc_trb_patch (:,:) ! turbulent deposition velocity (m/s) (ndst)
- real(r8), pointer, private :: vlc_trb_1_patch (:) ! turbulent deposition velocity 1(m/s)
- real(r8), pointer, private :: vlc_trb_2_patch (:) ! turbulent deposition velocity 2(m/s)
- real(r8), pointer, private :: vlc_trb_3_patch (:) ! turbulent deposition velocity 3(m/s)
- real(r8), pointer, private :: vlc_trb_4_patch (:) ! turbulent deposition velocity 4(m/s)
- real(r8), pointer, private :: mbl_bsn_fct_col (:) ! basin factor
-
- contains
-
- procedure , public :: Init
- procedure , private :: InitAllocate
- procedure , private :: InitHistory
- procedure , private :: InitCold
- procedure , private :: InitDustVars ! Initialize variables used in subroutine Dust
-
- end type dust_type
- !------------------------------------------------------------------------
-
- character(len=*), parameter, private :: sourcefile = &
- __FILE__
-
-contains
-
- !------------------------------------------------------------------------
- subroutine Init(this, bounds)
-
- class(dust_type) :: this
- type(bounds_type), intent(in) :: bounds
-
- call this%InitAllocate (bounds)
- call this%InitHistory (bounds)
- call this%InitCold (bounds)
- call this%InitDustVars (bounds)
-
- end subroutine Init
-
- !------------------------------------------------------------------------
- subroutine InitAllocate(this, bounds)
- !
- ! !ARGUMENTS:
- class (dust_type) :: this
- type(bounds_type), intent(in) :: bounds
- !
- ! !LOCAL VARIABLES:
- integer :: begp,endp
- integer :: begc,endc
- !------------------------------------------------------------------------
-
- begp = bounds%begp ; endp = bounds%endp
- begc = bounds%begc ; endc = bounds%endc
-
- allocate(this%flx_mss_vrt_dst_patch (begp:endp,1:ndst)) ; this%flx_mss_vrt_dst_patch (:,:) = nan
- allocate(this%flx_mss_vrt_dst_tot_patch (begp:endp)) ; this%flx_mss_vrt_dst_tot_patch (:) = nan
- allocate(this%vlc_trb_patch (begp:endp,1:ndst)) ; this%vlc_trb_patch (:,:) = nan
- allocate(this%vlc_trb_1_patch (begp:endp)) ; this%vlc_trb_1_patch (:) = nan
- allocate(this%vlc_trb_2_patch (begp:endp)) ; this%vlc_trb_2_patch (:) = nan
- allocate(this%vlc_trb_3_patch (begp:endp)) ; this%vlc_trb_3_patch (:) = nan
- allocate(this%vlc_trb_4_patch (begp:endp)) ; this%vlc_trb_4_patch (:) = nan
- allocate(this%mbl_bsn_fct_col (begc:endc)) ; this%mbl_bsn_fct_col (:) = nan
-
- end subroutine InitAllocate
-
- !------------------------------------------------------------------------
- subroutine InitHistory(this, bounds)
- !
- ! !USES:
- use histFileMod, only : hist_addfld1d
- !
- !
- ! !ARGUMENTS:
- class (dust_type) :: this
- type(bounds_type), intent(in) :: bounds
- !
- ! !LOCAL VARIABLES:
- integer :: begp,endp
- !------------------------------------------------------------------------
-
- begp = bounds%begp; endp = bounds%endp
-
- this%flx_mss_vrt_dst_tot_patch(begp:endp) = spval
- call hist_addfld1d (fname='DSTFLXT', units='kg/m2/s', &
- avgflag='A', long_name='total surface dust emission', &
- ptr_patch=this%flx_mss_vrt_dst_tot_patch, set_lake=0._r8, set_urb=0._r8, default='inactive')
-
- this%vlc_trb_1_patch(begp:endp) = spval
- call hist_addfld1d (fname='DPVLTRB1', units='m/s', &
- avgflag='A', long_name='turbulent deposition velocity 1', &
- ptr_patch=this%vlc_trb_1_patch, default='inactive')
-
- this%vlc_trb_2_patch(begp:endp) = spval
- call hist_addfld1d (fname='DPVLTRB2', units='m/s', &
- avgflag='A', long_name='turbulent deposition velocity 2', &
- ptr_patch=this%vlc_trb_2_patch, default='inactive')
-
- this%vlc_trb_3_patch(begp:endp) = spval
- call hist_addfld1d (fname='DPVLTRB3', units='m/s', &
- avgflag='A', long_name='turbulent deposition velocity 3', &
- ptr_patch=this%vlc_trb_3_patch, default='inactive')
-
- this%vlc_trb_4_patch(begp:endp) = spval
- call hist_addfld1d (fname='DPVLTRB4', units='m/s', &
- avgflag='A', long_name='turbulent deposition velocity 4', &
- ptr_patch=this%vlc_trb_4_patch, default='inactive')
-
- end subroutine InitHistory
-
- !-----------------------------------------------------------------------
- subroutine InitCold(this, bounds)
- !
- ! !ARGUMENTS:
- class (dust_type) :: this
- type(bounds_type), intent(in) :: bounds
- !
- ! !LOCAL VARIABLES:
- integer :: c,l
- !-----------------------------------------------------------------------
-
- ! Set basin factor to 1 for now
-
- do c = bounds%begc, bounds%endc
- l = col%landunit(c)
-
- if (.not.lun%lakpoi(l)) then
- this%mbl_bsn_fct_col(c) = 1.0_r8
- end if
- end do
-
- end subroutine InitCold
-
- !------------------------------------------------------------------------
- subroutine DustEmission (bounds, &
- num_nolakep, filter_nolakep, &
- atm2lnd_inst, soilstate_inst, canopystate_inst, waterstate_inst, &
- frictionvel_inst, dust_inst)
- !
- ! !DESCRIPTION:
- ! Dust mobilization. This code simulates dust mobilization due to wind
- ! from the surface into the lowest atmospheric layer
- ! On output flx_mss_vrt_dst(ndst) is the surface dust emission
- ! (kg/m**2/s) [ + = to atm]
- ! Source: C. Zender's dust model
- !
- ! !USES
- use shr_const_mod, only : SHR_CONST_RHOFW
- use subgridaveMod, only : p2g
- !
- ! !ARGUMENTS:
- type(bounds_type) , intent(in) :: bounds
- integer , intent(in) :: num_nolakep ! number of column non-lake points in patch filter
- integer , intent(in) :: filter_nolakep(num_nolakep) ! patch filter for non-lake points
- type(atm2lnd_type) , intent(in) :: atm2lnd_inst
- type(soilstate_type) , intent(in) :: soilstate_inst
- type(canopystate_type) , intent(in) :: canopystate_inst
- type(waterstate_type) , intent(in) :: waterstate_inst
- type(frictionvel_type) , intent(in) :: frictionvel_inst
- type(dust_type) , intent(inout) :: dust_inst
-
- !
- ! !LOCAL VARIABLES
- integer :: fp,p,c,l,g,m,n ! indices
- real(r8) :: liqfrac ! fraction of total water that is liquid
- real(r8) :: wnd_frc_rat ! [frc] Wind friction threshold over wind friction
- real(r8) :: wnd_frc_slt_dlt ! [m s-1] Friction velocity increase from saltatn
- real(r8) :: wnd_rfr_dlt ! [m s-1] Reference windspeed excess over threshld
- real(r8) :: dst_slt_flx_rat_ttl
- real(r8) :: flx_mss_hrz_slt_ttl
- real(r8) :: flx_mss_vrt_dst_ttl(bounds%begp:bounds%endp)
- real(r8) :: frc_thr_wet_fct
- real(r8) :: frc_thr_rgh_fct
- real(r8) :: wnd_frc_thr_slt
- real(r8) :: wnd_rfr_thr_slt
- real(r8) :: wnd_frc_slt
- real(r8) :: lnd_frc_mbl(bounds%begp:bounds%endp)
- real(r8) :: bd
- real(r8) :: gwc_sfc
- real(r8) :: ttlai(bounds%begp:bounds%endp)
- real(r8) :: tlai_lu(bounds%begl:bounds%endl)
- real(r8) :: sumwt(bounds%begl:bounds%endl) ! sum of weights
- logical :: found ! temporary for error check
- integer :: index
- !
- ! constants
- !
- real(r8), parameter :: cst_slt = 2.61_r8 ! [frc] Saltation constant
- real(r8), parameter :: flx_mss_fdg_fct = 5.0e-4_r8 ! [frc] Empir. mass flx tuning eflx_lh_vegt
- real(r8), parameter :: vai_mbl_thr = 0.3_r8 ! [m2 m-2] VAI threshold quenching dust mobilization
- !------------------------------------------------------------------------
-
- associate( &
- forc_rho => atm2lnd_inst%forc_rho_downscaled_col , & ! Input: [real(r8) (:) ] downscaled density (kg/m**3)
-
- gwc_thr => soilstate_inst%gwc_thr_col , & ! Input: [real(r8) (:) ] threshold gravimetric soil moisture based on clay content
- mss_frc_cly_vld => soilstate_inst%mss_frc_cly_vld_col , & ! Input: [real(r8) (:) ] [frc] Mass fraction clay limited to 0.20
- watsat => soilstate_inst%watsat_col , & ! Input: [real(r8) (:,:) ] saturated volumetric soil water
-
- tlai => canopystate_inst%tlai_patch , & ! Input: [real(r8) (:) ] one-sided leaf area index, no burying by snow
- tsai => canopystate_inst%tsai_patch , & ! Input: [real(r8) (:) ] one-sided stem area index, no burying by snow
-
- frac_sno => waterstate_inst%frac_sno_col , & ! Input: [real(r8) (:) ] fraction of ground covered by snow (0 to 1)
- h2osoi_vol => waterstate_inst%h2osoi_vol_col , & ! Input: [real(r8) (:,:) ] volumetric soil water (0<=h2osoi_vol<=watsat)
- h2osoi_liq => waterstate_inst%h2osoi_liq_col , & ! Input: [real(r8) (:,:) ] liquid soil water (kg/m2)
- h2osoi_ice => waterstate_inst%h2osoi_ice_col , & ! Input: [real(r8) (:,:) ] frozen soil water (kg/m2)
-
- fv => frictionvel_inst%fv_patch , & ! Input: [real(r8) (:) ] friction velocity (m/s) (for dust model)
- u10 => frictionvel_inst%u10_patch , & ! Input: [real(r8) (:) ] 10-m wind (m/s) (created for dust model)
-
- mbl_bsn_fct => dust_inst%mbl_bsn_fct_col , & ! Input: [real(r8) (:) ] basin factor
- flx_mss_vrt_dst => dust_inst%flx_mss_vrt_dst_patch , & ! Output: [real(r8) (:,:) ] surface dust emission (kg/m**2/s)
- flx_mss_vrt_dst_tot => dust_inst%flx_mss_vrt_dst_tot_patch & ! Output: [real(r8) (:) ] total dust flux back to atmosphere (pft)
- )
-
- ttlai(bounds%begp : bounds%endp) = 0._r8
- ! make lai average at landunit level
- do fp = 1,num_nolakep
- p = filter_nolakep(fp)
- ttlai(p) = tlai(p)+tsai(p)
- enddo
-
- tlai_lu(bounds%begl : bounds%endl) = spval
- sumwt(bounds%begl : bounds%endl) = 0._r8
- do p = bounds%begp,bounds%endp
- if (ttlai(p) /= spval .and. patch%active(p) .and. patch%wtlunit(p) /= 0._r8) then
- c = patch%column(p)
- l = patch%landunit(p)
- if (sumwt(l) == 0._r8) tlai_lu(l) = 0._r8
- tlai_lu(l) = tlai_lu(l) + ttlai(p) * patch%wtlunit(p)
- sumwt(l) = sumwt(l) + patch%wtlunit(p)
- end if
- end do
- found = .false.
- do l = bounds%begl,bounds%endl
- if (sumwt(l) > 1.0_r8 + 1.e-6_r8) then
- found = .true.
- index = l
- exit
- else if (sumwt(l) /= 0._r8) then
- tlai_lu(l) = tlai_lu(l)/sumwt(l)
- end if
- end do
- if (found) then
- write(iulog,*) 'p2l_1d error: sumwt is greater than 1.0 at l= ',index
- call endrun(msg=errMsg(sourcefile, __LINE__))
- end if
-
- ! Loop through patches
-
- ! initialize variables which get passed to the atmosphere
- flx_mss_vrt_dst(bounds%begp:bounds%endp,:)=0._r8
-
- do fp = 1,num_nolakep
- p = filter_nolakep(fp)
- c = patch%column(p)
- l = patch%landunit(p)
-
- ! the following code from subr. lnd_frc_mbl_get was adapted for lsm use
- ! purpose: return fraction of each gridcell suitable for dust mobilization
-
- ! the "bare ground" fraction of the current sub-gridscale cell decreases
- ! linearly from 1 to 0 as VAI(=tlai+tsai) increases from 0 to vai_mbl_thr
- ! if ice sheet, wetland, or lake, no dust allowed
-
- if (lun%itype(l) == istsoil .or. lun%itype(l) == istcrop) then
- if (tlai_lu(l) < vai_mbl_thr) then
- lnd_frc_mbl(p) = 1.0_r8 - (tlai_lu(l))/vai_mbl_thr
- else
- lnd_frc_mbl(p) = 0.0_r8
- endif
- lnd_frc_mbl(p) = lnd_frc_mbl(p) * (1.0_r8 - frac_sno(c))
- else
- lnd_frc_mbl(p) = 0.0_r8
- end if
- end do
-
- do fp = 1,num_nolakep
- p = filter_nolakep(fp)
- if (lnd_frc_mbl(p)>1.0_r8 .or. lnd_frc_mbl(p)<0.0_r8) then
- write(iulog,*)'Error dstmbl: pft= ',p,' lnd_frc_mbl(p)= ',lnd_frc_mbl(p)
- call endrun(msg=errMsg(sourcefile, __LINE__))
- end if
- end do
-
- ! reset history output variables before next if-statement to avoid output = inf
-
- do fp = 1,num_nolakep
- p = filter_nolakep(fp)
- flx_mss_vrt_dst_tot(p) = 0.0_r8
- end do
- do n = 1, ndst
- do fp = 1,num_nolakep
- p = filter_nolakep(fp)
- flx_mss_vrt_dst(p,n) = 0.0_r8
- end do
- end do
-
- do fp = 1,num_nolakep
- p = filter_nolakep(fp)
- c = patch%column(p)
- l = patch%landunit(p)
- g = patch%gridcell(p)
-
- ! only perform the following calculations if lnd_frc_mbl is non-zero
-
- if (lnd_frc_mbl(p) > 0.0_r8) then
-
- ! the following comes from subr. frc_thr_rgh_fct_get
- ! purpose: compute factor by which surface roughness increases threshold
- ! friction velocity (currently a constant)
-
- frc_thr_rgh_fct = 1.0_r8
-
- ! the following comes from subr. frc_thr_wet_fct_get
- ! purpose: compute factor by which soil moisture increases threshold friction velocity
- ! adjust threshold velocity for inhibition by moisture
- ! modified 4/5/2002 (slevis) to use gravimetric instead of volumetric
- ! water content
-
- bd = (1._r8-watsat(c,1))*2.7e3_r8 ![kg m-3] Bulk density of dry surface soil
- gwc_sfc = h2osoi_vol(c,1)*SHR_CONST_RHOFW/bd ![kg kg-1] Gravimetric H2O cont
- if (gwc_sfc > gwc_thr(c)) then
- frc_thr_wet_fct = sqrt(1.0_r8 + 1.21_r8 * (100.0_r8*(gwc_sfc - gwc_thr(c)))**0.68_r8)
- else
- frc_thr_wet_fct = 1.0_r8
- end if
-
- ! slevis: adding liqfrac here, because related to effects from soil water
-
- liqfrac = max( 0.0_r8, min( 1.0_r8, h2osoi_liq(c,1) / (h2osoi_ice(c,1)+h2osoi_liq(c,1)+1.0e-6_r8) ) )
-
- ! the following lines come from subr. dst_mbl
- ! purpose: adjust threshold friction velocity to acct for moisture and
- ! roughness. The ratio tmp1 / sqrt(forc_rho) comes from
- ! subr. wnd_frc_thr_slt_get which computes dry threshold
- ! friction velocity for saltation
-
- wnd_frc_thr_slt = tmp1 / sqrt(forc_rho(c)) * frc_thr_wet_fct * frc_thr_rgh_fct
-
- ! reset these variables which will be updated in the following if-block
-
- wnd_frc_slt = fv(p)
- flx_mss_hrz_slt_ttl = 0.0_r8
- flx_mss_vrt_dst_ttl(p) = 0.0_r8
-
- ! the following line comes from subr. dst_mbl
- ! purpose: threshold saltation wind speed
-
- wnd_rfr_thr_slt = u10(p) * wnd_frc_thr_slt / fv(p)
-
- ! the following if-block comes from subr. wnd_frc_slt_get
- ! purpose: compute the saltating friction velocity
- ! theory: saltation roughens the boundary layer, AKA "Owen's effect"
-
- if (u10(p) >= wnd_rfr_thr_slt) then
- wnd_rfr_dlt = u10(p) - wnd_rfr_thr_slt
- wnd_frc_slt_dlt = 0.003_r8 * wnd_rfr_dlt * wnd_rfr_dlt
- wnd_frc_slt = fv(p) + wnd_frc_slt_dlt
- end if
-
- ! the following comes from subr. flx_mss_hrz_slt_ttl_Whi79_get
- ! purpose: compute vertically integrated streamwise mass flux of particles
-
- if (wnd_frc_slt > wnd_frc_thr_slt) then
- wnd_frc_rat = wnd_frc_thr_slt / wnd_frc_slt
- flx_mss_hrz_slt_ttl = cst_slt * forc_rho(c) * (wnd_frc_slt**3.0_r8) * &
- (1.0_r8 - wnd_frc_rat) * (1.0_r8 + wnd_frc_rat) * (1.0_r8 + wnd_frc_rat) / grav
-
- ! the following loop originates from subr. dst_mbl
- ! purpose: apply land sfc and veg limitations and global tuning factor
- ! slevis: multiply flx_mss_hrz_slt_ttl by liqfrac to incude the effect
- ! of frozen soil
-
- flx_mss_hrz_slt_ttl = flx_mss_hrz_slt_ttl * lnd_frc_mbl(p) * mbl_bsn_fct(c) * &
- flx_mss_fdg_fct * liqfrac
- end if
-
- ! the following comes from subr. flx_mss_vrt_dst_ttl_MaB95_get
- ! purpose: diagnose total vertical mass flux of dust from vertically
- ! integrated streamwise mass flux
-
- dst_slt_flx_rat_ttl = 100.0_r8 * exp( log(10.0_r8) * (13.4_r8 * mss_frc_cly_vld(c) - 6.0_r8) )
- flx_mss_vrt_dst_ttl(p) = flx_mss_hrz_slt_ttl * dst_slt_flx_rat_ttl
-
- end if ! lnd_frc_mbl > 0.0
-
- end do
-
- ! the following comes from subr. flx_mss_vrt_dst_prt in C. Zender's code
- ! purpose: partition total vertical mass flux of dust into transport bins
-
- do n = 1, ndst
- do m = 1, dst_src_nbr
- do fp = 1,num_nolakep
- p = filter_nolakep(fp)
- if (lnd_frc_mbl(p) > 0.0_r8) then
- flx_mss_vrt_dst(p,n) = flx_mss_vrt_dst(p,n) + ovr_src_snk_mss(m,n) * flx_mss_vrt_dst_ttl(p)
- end if
- end do
- end do
- end do
-
- do n = 1, ndst
- do fp = 1,num_nolakep
- p = filter_nolakep(fp)
- if (lnd_frc_mbl(p) > 0.0_r8) then
- flx_mss_vrt_dst_tot(p) = flx_mss_vrt_dst_tot(p) + flx_mss_vrt_dst(p,n)
- end if
- end do
- end do
-
- end associate
-
- end subroutine DustEmission
-
- !------------------------------------------------------------------------
- subroutine DustDryDep (bounds, &
- atm2lnd_inst, frictionvel_inst, dust_inst)
- !
- ! !DESCRIPTION:
- !
- ! Determine Turbulent dry deposition for dust. Calculate the turbulent
- ! component of dust dry deposition, (the turbulent deposition velocity
- ! through the lowest atmospheric layer. CAM will calculate the settling
- ! velocity through the whole atmospheric column. The two calculations
- ! will determine the dust dry deposition flux to the surface.
- ! Note: Same process should occur over oceans. For the coupled CESM,
- ! we may find it more efficient to let CAM calculate the turbulent dep
- ! velocity over all surfaces. This would require passing the
- ! aerodynamic resistance, ram(1), and the friction velocity, fv, from
- ! the land to the atmosphere component. In that case, dustini need not
- ! calculate particle diamter (dmt_vwr) and particle density (dns_aer).
- ! Source: C. Zender's dry deposition code
- !
- ! !USES
- use shr_const_mod, only : SHR_CONST_PI, SHR_CONST_RDAIR, SHR_CONST_BOLTZ
- !
- ! !ARGUMENTS:
- type(bounds_type) , intent(in) :: bounds
- type(atm2lnd_type) , intent(in) :: atm2lnd_inst
- type(frictionvel_type) , intent(in) :: frictionvel_inst
- type(dust_type) , intent(inout) :: dust_inst
- !
- ! !LOCAL VARIABLES
- integer :: p,c,g,m,n ! indices
- real(r8) :: vsc_dyn_atm(bounds%begp:bounds%endp) ! [kg m-1 s-1] Dynamic viscosity of air
- real(r8) :: vsc_knm_atm(bounds%begp:bounds%endp) ! [m2 s-1] Kinematic viscosity of atmosphere
- real(r8) :: shm_nbr_xpn ! [frc] Sfc-dep exponent for aerosol-diffusion dependence on Schmidt number
- real(r8) :: shm_nbr ! [frc] Schmidt number
- real(r8) :: stk_nbr ! [frc] Stokes number
- real(r8) :: mfp_atm ! [m] Mean free path of air
- real(r8) :: dff_aer ! [m2 s-1] Brownian diffusivity of particle
- real(r8) :: rss_trb ! [s m-1] Resistance to turbulent deposition
- real(r8) :: slp_crc(bounds%begp:bounds%endp,ndst) ! [frc] Slip correction factor
- real(r8) :: vlc_grv(bounds%begp:bounds%endp,ndst) ! [m s-1] Settling velocity
- real(r8) :: rss_lmn(bounds%begp:bounds%endp,ndst) ! [s m-1] Quasi-laminar layer resistance
- real(r8) :: tmp ! temporary
- real(r8), parameter::shm_nbr_xpn_lnd=-2._r8/3._r8 ![frc] shm_nbr_xpn over land
- !------------------------------------------------------------------------
-
- associate( &
- forc_pbot => atm2lnd_inst%forc_pbot_downscaled_col , & ! Input: [real(r8) (:) ] atm pressure (Pa)
- forc_rho => atm2lnd_inst%forc_rho_downscaled_col , & ! Input: [real(r8) (:) ] atm density (kg/m**3)
- forc_t => atm2lnd_inst%forc_t_downscaled_col , & ! Input: [real(r8) (:) ] atm temperature (K)
-
- ram1 => frictionvel_inst%ram1_patch , & ! Input: [real(r8) (:) ] aerodynamical resistance (s/m)
- fv => frictionvel_inst%fv_patch , & ! Input: [real(r8) (:) ] friction velocity (m/s)
-
- vlc_trb => dust_inst%vlc_trb_patch , & ! Output: [real(r8) (:,:) ] Turbulent deposn velocity (m/s)
- vlc_trb_1 => dust_inst%vlc_trb_1_patch , & ! Output: [real(r8) (:) ] Turbulent deposition velocity 1
- vlc_trb_2 => dust_inst%vlc_trb_2_patch , & ! Output: [real(r8) (:) ] Turbulent deposition velocity 2
- vlc_trb_3 => dust_inst%vlc_trb_3_patch , & ! Output: [real(r8) (:) ] Turbulent deposition velocity 3
- vlc_trb_4 => dust_inst%vlc_trb_4_patch & ! Output: [real(r8) (:) ] Turbulent deposition velocity 4
- )
-
- do p = bounds%begp,bounds%endp
- if (patch%active(p)) then
- g = patch%gridcell(p)
- c = patch%column(p)
-
- ! from subroutine dst_dps_dry (consider adding sanity checks from line 212)
- ! when code asks to use midlayer density, pressure, temperature,
- ! I use the data coming in from the atmosphere, ie forc_t, forc_pbot, forc_rho
-
- ! Quasi-laminar layer resistance: call rss_lmn_get
- ! Size-independent thermokinetic properties
-
- vsc_dyn_atm(p) = 1.72e-5_r8 * ((forc_t(c)/273.0_r8)**1.5_r8) * 393.0_r8 / &
- (forc_t(c)+120.0_r8) ![kg m-1 s-1] RoY94 p. 102
- mfp_atm = 2.0_r8 * vsc_dyn_atm(p) / & ![m] SeP97 p. 455
- (forc_pbot(c)*sqrt(8.0_r8/(SHR_CONST_PI*SHR_CONST_RDAIR*forc_t(c))))
- vsc_knm_atm(p) = vsc_dyn_atm(p) / forc_rho(c) ![m2 s-1] Kinematic viscosity of air
-
- do m = 1, ndst
- slp_crc(p,m) = 1.0_r8 + 2.0_r8 * mfp_atm * &
- (1.257_r8+0.4_r8*exp(-1.1_r8*dmt_vwr(m)/(2.0_r8*mfp_atm))) / &
- dmt_vwr(m) ![frc] Slip correction factor SeP97 p. 464
- vlc_grv(p,m) = (1.0_r8/18.0_r8) * dmt_vwr(m) * dmt_vwr(m) * dns_aer * &
- grav * slp_crc(p,m) / vsc_dyn_atm(p) ![m s-1] Stokes' settling velocity SeP97 p. 466
- vlc_grv(p,m) = vlc_grv(p,m) * stk_crc(m) ![m s-1] Correction to Stokes settling velocity
- end do
- end if
- end do
-
- do m = 1, ndst
- do p = bounds%begp,bounds%endp
- if (patch%active(p)) then
- g = patch%gridcell(p)
- c = patch%column(p)
-
- stk_nbr = vlc_grv(p,m) * fv(p) * fv(p) / (grav * vsc_knm_atm(p)) ![frc] SeP97 p.965
- dff_aer = SHR_CONST_BOLTZ * forc_t(c) * slp_crc(p,m) / & ![m2 s-1]
- (3.0_r8*SHR_CONST_PI * vsc_dyn_atm(p) * dmt_vwr(m)) !SeP97 p.474
- shm_nbr = vsc_knm_atm(p) / dff_aer ![frc] SeP97 p.972
- shm_nbr_xpn = shm_nbr_xpn_lnd ![frc]
-
- ! fxm: Turning this on dramatically reduces
- ! deposition velocity in low wind regimes
- ! Schmidt number exponent is -2/3 over solid surfaces and
- ! -1/2 over liquid surfaces SlS80 p. 1014
- ! if (oro(i)==0.0) shm_nbr_xpn=shm_nbr_xpn_ocn else shm_nbr_xpn=shm_nbr_xpn_lnd
- ! [frc] Surface-dependent exponent for aerosol-diffusion dependence on Schmidt #
-
- tmp = shm_nbr**shm_nbr_xpn + 10.0_r8**(-3.0_r8/stk_nbr)
- rss_lmn(p,m) = 1.0_r8 / (tmp * fv(p)) ![s m-1] SeP97 p.972,965
- end if
- end do
- end do
-
- ! Lowest layer: Turbulent deposition (CAM will calc. gravitational dep)
-
- do m = 1, ndst
- do p = bounds%begp,bounds%endp
- if (patch%active(p)) then
- rss_trb = ram1(p) + rss_lmn(p,m) + ram1(p) * rss_lmn(p,m) * vlc_grv(p,m) ![s m-1]
- vlc_trb(p,m) = 1.0_r8 / rss_trb ![m s-1]
- end if
- end do
- end do
-
- do p = bounds%begp,bounds%endp
- if (patch%active(p)) then
- vlc_trb_1(p) = vlc_trb(p,1)
- vlc_trb_2(p) = vlc_trb(p,2)
- vlc_trb_3(p) = vlc_trb(p,3)
- vlc_trb_4(p) = vlc_trb(p,4)
- end if
- end do
-
- end associate
-
- end subroutine DustDryDep
-
- !------------------------------------------------------------------------
- subroutine InitDustVars(this, bounds)
- !
- ! !DESCRIPTION:
- !
- ! Compute source efficiency factor from topography
- ! Initialize other variables used in subroutine Dust:
- ! ovr_src_snk_mss(m,n) and tmp1.
- ! Define particle diameter and density needed by atm model
- ! as well as by dry dep model
- ! Source: Paul Ginoux (for source efficiency factor)
- ! Modifications by C. Zender and later by S. Levis
- ! Rest of subroutine from C. Zender's dust model
- !
- ! !USES
- use shr_const_mod , only: SHR_CONST_PI, SHR_CONST_RDAIR
- use shr_spfn_mod , only: erf => shr_spfn_erf
- use decompMod , only : get_proc_bounds
- !
- ! !ARGUMENTS:
- class(dust_type) :: this
- type(bounds_type), intent(in) :: bounds
- !
- ! !LOCAL VARIABLES
- integer :: fc,c,l,m,n ! indices
- real(r8) :: ovr_src_snk_frc
- real(r8) :: sqrt2lngsdi ! [frc] Factor in erf argument
- real(r8) :: lndmaxjovrdmdni ! [frc] Factor in erf argument
- real(r8) :: lndminjovrdmdni ! [frc] Factor in erf argument
- real(r8) :: ryn_nbr_frc_thr_prx_opt ! [frc] Threshold friction Reynolds number approximation for optimal size
- real(r8) :: ryn_nbr_frc_thr_opt_fnc ! [frc] Threshold friction Reynolds factor for saltation calculation
- real(r8) :: icf_fct ! Interpartical cohesive forces factor for saltation calc
- real(r8) :: dns_fct ! Density ratio factor for saltation calculation
- real(r8) :: dmt_min(ndst) ! [m] Size grid minimum
- real(r8) :: dmt_max(ndst) ! [m] Size grid maximum
- real(r8) :: dmt_ctr(ndst) ! [m] Diameter at bin center
- real(r8) :: dmt_dlt(ndst) ! [m] Width of size bin
- real(r8) :: slp_crc(ndst) ! [frc] Slip correction factor
- real(r8) :: vlm_rsl(ndst) ! [m3 m-3] Volume concentration resolved
- real(r8) :: vlc_stk(ndst) ! [m s-1] Stokes settling velocity
- real(r8) :: vlc_grv(ndst) ! [m s-1] Settling velocity
- real(r8) :: ryn_nbr_grv(ndst) ! [frc] Reynolds number at terminal velocity
- real(r8) :: cff_drg_grv(ndst) ! [frc] Drag coefficient at terminal velocity
- real(r8) :: tmp ! temporary
- real(r8) :: ln_gsd ! [frc] ln(gsd)
- real(r8) :: gsd_anl ! [frc] Geometric standard deviation
- real(r8) :: dmt_vma ! [m] Mass median diameter analytic She84 p.75 Tabl.1
- real(r8) :: dmt_nma ! [m] Number median particle diameter
- real(r8) :: lgn_dst ! Lognormal distribution at sz_ctr
- real(r8) :: eps_max ! [frc] Relative accuracy for convergence
- real(r8) :: eps_crr ! [frc] Current relative accuracy
- real(r8) :: itr_idx ! [idx] Counting index
- real(r8) :: dns_mdp ! [kg m-3] Midlayer density
- real(r8) :: mfp_atm ! [m] Mean free path of air
- real(r8) :: vsc_dyn_atm ! [kg m-1 s-1] Dynamic viscosity of air
- real(r8) :: vsc_knm_atm ! [kg m-1 s-1] Kinematic viscosity of air
- real(r8) :: vlc_grv_old ! [m s-1] Previous gravitational settling velocity
- real(r8) :: series_ratio ! Factor for logarithmic grid
- real(r8) :: lngsdsqrttwopi_rcp ! Factor in lognormal distribution
- real(r8) :: sz_min(sz_nbr) ! [m] Size Bin minima
- real(r8) :: sz_max(sz_nbr) ! [m] Size Bin maxima
- real(r8) :: sz_ctr(sz_nbr) ! [m] Size Bin centers
- real(r8) :: sz_dlt(sz_nbr) ! [m] Size Bin widths
-
- ! constants
- real(r8), allocatable :: dmt_vma_src(:) ! [m] Mass median diameter BSM96 p. 73 Table 2
- real(r8), allocatable :: gsd_anl_src(:) ! [frc] Geometric std deviation BSM96 p. 73 Table 2
- real(r8), allocatable :: mss_frc_src(:) ! [frc] Mass fraction BSM96 p. 73 Table 2
-
- real(r8) :: dmt_grd(5) = & ! [m] Particle diameter grid
- (/ 0.1e-6_r8, 1.0e-6_r8, 2.5e-6_r8, 5.0e-6_r8, 10.0e-6_r8 /)
- real(r8), parameter :: dmt_slt_opt = 75.0e-6_r8 ! [m] Optim diam for saltation
- real(r8), parameter :: dns_slt = 2650.0_r8 ! [kg m-3] Density of optimal saltation particles
- !------------------------------------------------------------------------
-
- associate(&
- mbl_bsn_fct => this%mbl_bsn_fct_col & ! Output: [real(r8) (:)] basin factor
- )
-
- ! allocate module variable
- allocate (ovr_src_snk_mss(dst_src_nbr,ndst))
- allocate (dmt_vwr(ndst))
- allocate (stk_crc(ndst))
-
- ! allocate local variable
- allocate (dmt_vma_src(dst_src_nbr))
- allocate (gsd_anl_src(dst_src_nbr))
- allocate (mss_frc_src(dst_src_nbr))
-
- dmt_vma_src(:) = (/ 0.832e-6_r8 , 4.82e-6_r8 , 19.38e-6_r8 /)
- gsd_anl_src(:) = (/ 2.10_r8 , 1.90_r8 , 1.60_r8 /)
- mss_frc_src(:) = (/ 0.036_r8 , 0.957_r8 , 0.007_r8 /)
-
- ! the following comes from (1) szdstlgn.F subroutine ovr_src_snk_frc_get
- ! and (2) dstszdst.F subroutine dst_szdst_ini
- ! purpose(1): given one set (the "source") of lognormal distributions,
- ! and one set of bin boundaries (the "sink"), compute and return
- ! the overlap factors between the source and sink distributions
- ! purpose(2): set important statistics of size distributions
-
- do m = 1, dst_src_nbr
- sqrt2lngsdi = sqrt(2.0_r8) * log(gsd_anl_src(m))
- do n = 1, ndst
- lndmaxjovrdmdni = log(dmt_grd(n+1)/dmt_vma_src(m))
- lndminjovrdmdni = log(dmt_grd(n )/dmt_vma_src(m))
- ovr_src_snk_frc = 0.5_r8 * (erf(lndmaxjovrdmdni/sqrt2lngsdi) - &
- erf(lndminjovrdmdni/sqrt2lngsdi))
- ovr_src_snk_mss(m,n) = ovr_src_snk_frc * mss_frc_src(m)
- end do
- end do
-
- ! The following code from subroutine wnd_frc_thr_slt_get was placed
- ! here because tmp1 needs to be defined just once
-
- ryn_nbr_frc_thr_prx_opt = 0.38_r8 + 1331.0_r8 * (100.0_r8*dmt_slt_opt)**1.56_r8
-
- if (ryn_nbr_frc_thr_prx_opt < 0.03_r8) then
- write(iulog,*) 'dstmbl: ryn_nbr_frc_thr_prx_opt < 0.03'
- call endrun(msg=errMsg(sourcefile, __LINE__))
- else if (ryn_nbr_frc_thr_prx_opt < 10.0_r8) then
- ryn_nbr_frc_thr_opt_fnc = -1.0_r8 + 1.928_r8 * (ryn_nbr_frc_thr_prx_opt**0.0922_r8)
- ryn_nbr_frc_thr_opt_fnc = 0.1291_r8 * 0.1291_r8 / ryn_nbr_frc_thr_opt_fnc
- else
- ryn_nbr_frc_thr_opt_fnc = 1.0_r8 - 0.0858_r8 * exp(-0.0617_r8*(ryn_nbr_frc_thr_prx_opt-10.0_r8))
- ryn_nbr_frc_thr_opt_fnc = 0.120_r8 * 0.120_r8 * ryn_nbr_frc_thr_opt_fnc * ryn_nbr_frc_thr_opt_fnc
- end if
-
- icf_fct = 1.0_r8 + 6.0e-07_r8 / (dns_slt * grav * (dmt_slt_opt**2.5_r8))
- dns_fct = dns_slt * grav * dmt_slt_opt
- tmp1 = sqrt(icf_fct * dns_fct * ryn_nbr_frc_thr_opt_fnc)
-
- ! Introducing particle diameter. Needed by atm model and by dry dep model.
- ! Taken from Charlie Zender's subroutines dst_psd_ini, dst_sz_rsl,
- ! grd_mk (dstpsd.F90) and subroutine lgn_evl (psdlgn.F90)
-
- ! Charlie allows logarithmic or linear option for size distribution
- ! however, he hardwires the distribution to logarithmic in his code
- ! therefore, I take his logarithmic code only
- ! furthermore, if dst_nbr == 4, he overrides the automatic grid calculation
- ! he currently works with dst_nbr = 4, so I only take the relevant code
- ! if ndst ever becomes different from 4, must add call grd_mk (dstpsd.F90)
- ! as done in subroutine dst_psd_ini
- ! note that here ndst = dst_nbr
-
- ! Override automatic grid with preset grid if available
-
- if (ndst == 4) then
- do n = 1, ndst
- dmt_min(n) = dmt_grd(n) ![m] Max diameter in bin
- dmt_max(n) = dmt_grd(n+1) ![m] Min diameter in bin
- dmt_ctr(n) = 0.5_r8 * (dmt_min(n)+dmt_max(n)) ![m] Diameter at bin ctr
- dmt_dlt(n) = dmt_max(n)-dmt_min(n) ![m] Width of size bin
- end do
- else
- write(iulog,*) 'Dustini error: ndst must equal to 4 with current code'
- call endrun(msg=errMsg(sourcefile, __LINE__))
- !see more comments above end if ndst == 4
- end if
-
- ! Bin physical properties
-
- gsd_anl = 2.0_r8 ! [frc] Geometric std dev PaG77 p. 2080 Table1
- ln_gsd = log(gsd_anl)
- dns_aer = 2.5e+3_r8 ! [kg m-3] Aerosol density
-
- ! Set a fundamental statistic for each bin
-
- dmt_vma = 3.5000e-6_r8 ! [m] Mass median diameter analytic She84 p.75 Table1
-
- ! Compute analytic size statistics
- ! Convert mass median diameter to number median diameter (call vma2nma)
-
- dmt_nma = dmt_vma * exp(-3.0_r8*ln_gsd*ln_gsd) ! [m]
-
- ! Compute resolved size statistics for each size distribution
- ! In C. Zender's code call dst_sz_rsl
-
- do n = 1, ndst
-
- series_ratio = (dmt_max(n)/dmt_min(n))**(1.0_r8/sz_nbr)
- sz_min(1) = dmt_min(n)
- do m = 2, sz_nbr ! Loop starts at 2
- sz_min(m) = sz_min(m-1) * series_ratio
- end do
-
- ! Derived grid values
- do m = 1, sz_nbr-1 ! Loop ends at sz_nbr-1
- sz_max(m) = sz_min(m+1) ! [m]
- end do
- sz_max(sz_nbr) = dmt_max(n) ! [m]
-
- ! Final derived grid values
- do m = 1, sz_nbr
- sz_ctr(m) = 0.5_r8 * (sz_min(m)+sz_max(m))
- sz_dlt(m) = sz_max(m)-sz_min(m)
- end do
-
- lngsdsqrttwopi_rcp = 1.0_r8 / (ln_gsd*sqrt(2.0_r8*SHR_CONST_PI))
- dmt_vwr(n) = 0.0_r8 ! [m] Mass wgted diameter resolved
- vlm_rsl(n) = 0.0_r8 ! [m3 m-3] Volume concentration resolved
-
- do m = 1, sz_nbr
-
- ! Evaluate lognormal distribution for these sizes (call lgn_evl)
- tmp = log(sz_ctr(m)/dmt_nma) / ln_gsd
- lgn_dst = lngsdsqrttwopi_rcp * exp(-0.5_r8*tmp*tmp) / sz_ctr(m)
-
- ! Integrate moments of size distribution
- dmt_vwr(n) = dmt_vwr(n) + sz_ctr(m) * &
- SHR_CONST_PI / 6.0_r8 * (sz_ctr(m)**3.0_r8) * & ![m3] Volume
- lgn_dst * sz_dlt(m) ![# m-3] Number concentrn
- vlm_rsl(n) = vlm_rsl(n) + &
- SHR_CONST_PI / 6.0_r8 * (sz_ctr(m)**3.0_r8) * & ![m3] Volume
- lgn_dst * sz_dlt(m) ![# m-3] Number concentrn
-
- end do
-
- dmt_vwr(n) = dmt_vwr(n) / vlm_rsl(n) ![m] Mass weighted diameter resolved
-
- end do
-
- ! calculate correction to Stokes' settling velocity (subroutine stk_crc_get)
-
- eps_max = 1.0e-4_r8
- dns_mdp = 100000._r8 / (295.0_r8*SHR_CONST_RDAIR) ![kg m-3] const prs_mdp & tpt_vrt
-
- ! Size-independent thermokinetic properties
-
- vsc_dyn_atm = 1.72e-5_r8 * ((295.0_r8/273.0_r8)**1.5_r8) * 393.0_r8 / &
- (295.0_r8+120.0_r8) ![kg m-1 s-1] RoY94 p.102 tpt_mdp=295.0
- mfp_atm = 2.0_r8 * vsc_dyn_atm / & !SeP97 p. 455 constant prs_mdp, tpt_mdp
- (100000._r8*sqrt(8.0_r8/(SHR_CONST_PI*SHR_CONST_RDAIR*295.0_r8)))
- vsc_knm_atm = vsc_dyn_atm / dns_mdp ![m2 s-1] Kinematic viscosity of air
-
- do m = 1, ndst
- slp_crc(m) = 1.0_r8 + 2.0_r8 * mfp_atm * &
- (1.257_r8+0.4_r8*exp(-1.1_r8*dmt_vwr(m)/(2.0_r8*mfp_atm))) / &
- dmt_vwr(m) ! [frc] Slip correction factor SeP97 p.464
- vlc_stk(m) = (1.0_r8/18.0_r8) * dmt_vwr(m) * dmt_vwr(m) * dns_aer * &
- grav * slp_crc(m) / vsc_dyn_atm ! [m s-1] SeP97 p.466
- end do
-
- ! For Reynolds number flows Re < 0.1 Stokes' velocity is valid for
- ! vlc_grv SeP97 p. 466 (8.42). For larger Re, inertial effects become
- ! important and empirical drag coefficients must be employed
- ! Implicit equation for Re, Cd, and Vt is SeP97 p. 467 (8.44)
- ! Using Stokes' velocity rather than iterative solution with empirical
- ! drag coefficient causes 60% errors for D = 200 um SeP97 p. 468
-
- ! Iterative solution for drag coefficient, Reynolds number, and terminal veloc
- do m = 1, ndst
-
- ! Initialize accuracy and counter
- eps_crr = eps_max + 1.0_r8 ![frc] Current relative accuracy
- itr_idx = 0 ![idx] Counting index
-
- ! Initial guess for vlc_grv is exact for Re < 0.1
- vlc_grv(m) = vlc_stk(m) ![m s-1]
-
- do while(eps_crr > eps_max)
-
- ! Save terminal velocity for convergence test
- vlc_grv_old = vlc_grv(m) ![m s-1]
- ryn_nbr_grv(m) = vlc_grv(m) * dmt_vwr(m) / vsc_knm_atm !SeP97 p.460
-
- ! Update drag coefficient based on new Reynolds number
- if (ryn_nbr_grv(m) < 0.1_r8) then
- cff_drg_grv(m) = 24.0_r8 / ryn_nbr_grv(m) !Stokes' law Sep97 p.463 (8.32)
- else if (ryn_nbr_grv(m) < 2.0_r8) then
- cff_drg_grv(m) = (24.0_r8/ryn_nbr_grv(m)) * &
- (1.0_r8 + 3.0_r8*ryn_nbr_grv(m)/16.0_r8 + &
- 9.0_r8*ryn_nbr_grv(m)*ryn_nbr_grv(m)* &
- log(2.0_r8*ryn_nbr_grv(m))/160.0_r8) !Sep97 p.463 (8.32)
- else if (ryn_nbr_grv(m) < 500.0_r8) then
- cff_drg_grv(m) = (24.0_r8/ryn_nbr_grv(m)) * &
- (1.0_r8 + 0.15_r8*ryn_nbr_grv(m)**0.687_r8) !Sep97 p.463 (8.32)
- else if (ryn_nbr_grv(m) < 2.0e5_r8) then
- cff_drg_grv(m) = 0.44_r8 !Sep97 p.463 (8.32)
- else
- write(iulog,'(a,es9.2)') "ryn_nbr_grv(m) = ",ryn_nbr_grv(m)
- write(iulog,*)'Dustini error: Reynolds number too large in stk_crc_get()'
- call endrun(msg=errMsg(sourcefile, __LINE__))
- end if
-
- ! Update terminal velocity based on new Reynolds number and drag coeff
- ! [m s-1] Terminal veloc SeP97 p.467 (8.44)
-
- vlc_grv(m) = sqrt(4.0_r8 * grav * dmt_vwr(m) * slp_crc(m) * dns_aer / &
- (3.0_r8*cff_drg_grv(m)*dns_mdp))
- eps_crr = abs((vlc_grv(m)-vlc_grv_old)/vlc_grv(m)) !Relative convergence
- if (itr_idx == 12) then
- ! Numerical pingpong may occur when Re = 0.1, 2.0, or 500.0
- ! due to discontinuities in derivative of drag coefficient
- vlc_grv(m) = 0.5_r8 * (vlc_grv(m)+vlc_grv_old) ! [m s-1]
- end if
- if (itr_idx > 20) then
- write(iulog,*) 'Dustini error: Terminal velocity not converging ',&
- ' in stk_crc_get(), breaking loop...'
- goto 100 !to next iteration
- end if
- itr_idx = itr_idx + 1
-
- end do !end while
-
-100 continue !Label to jump to when iteration does not converge
- end do !end loop over size
-
- ! Compute factors to convert Stokes' settling velocities to
- ! actual settling velocities
-
- do m = 1, ndst
- stk_crc(m) = vlc_grv(m) / vlc_stk(m)
- end do
-
- end associate
-
- end subroutine InitDustVars
-
-end module DUSTMod
diff --git a/src/biogeochem/DryDepVelocity.F90 b/src/biogeochem/DryDepVelocity.F90
deleted file mode 100644
index 603e9d24..00000000
--- a/src/biogeochem/DryDepVelocity.F90
+++ /dev/null
@@ -1,678 +0,0 @@
-Module DryDepVelocity
-
- !-----------------------------------------------------------------------
- !
- ! Purpose:
- ! Deposition velocity (m/s)
- !
- ! Method:
- ! This code simulates dry deposition velocities using the Wesely scheme.
- ! Details of this method can be found in:
- !
- ! M.L Wesely. Parameterization of surface resistances to gaseous dry deposition
- ! in regional-scale numericl models. 1989. Atmospheric Environment vol.23 No.6
- ! pp. 1293-1304.
- !
- ! In Wesely (1998) "the magnitude of the dry deposition velocity can be found
- ! as:
- !
- ! |vd|=(ra+rb+rc)^-1
- !
- ! where ra is the aerodynamic resistance (common to all gases) between a
- ! specific height and the surface, rb is the quasilaminar sublayer resistance
- ! (whose only dependence on the porperties of the gas of interest is its
- ! molecular diffusivity in air), and rc is the bulk surface resistance".
- !
- ! In this subroutine both ra and rb are calculated elsewhere in CLM.
- !
- ! In Wesely (1989) rc is estimated for five seasonal categories and 11 landuse
- ! types. For each season and landuse type, Wesely compiled data into a
- ! look-up-table for several parameters used to calculate rc. In this subroutine
- ! the same values are used as found in wesely's look-up-tables, the only
- ! difference is that this subroutine uses a CLM generated LAI to select values
- ! from the look-up-table instead of seasonality. Inaddition, Wesely(1989)
- ! land use types are "mapped" into CLM patch types.
- !
- ! Subroutine written to operate at the patch level.
- !
- ! Output:
- !
- ! vd(n_species) !Dry deposition velocity [m s-1] for each molecule or species
- !
- ! Author: Beth Holland and James Sulzman
- !
- ! Modified: Francis Vitt -- 30 Mar 2007
- ! Modified: Maria Val Martin -- 15 Jan 2014
- ! Corrected major bugs in the leaf and stomatal resitances. The code is now
- ! coupled to LAI and Rs uses the Ball-Berry Scheme. Also, corrected minor
- ! bugs in rlu and rcl calculations. Added
- ! no vegetation removal for CO. See README for details and
- ! Val Martin et al., 2014 GRL for major corrections
- ! Modified: Louisa Emmons -- 30 November 2017
- ! Corrected the equation calculating stomatal resistance from rssun and rssha,
- ! and removed factor that scaled Rs to match observations
- !
- !-----------------------------------------------------------------------
-
- use shr_log_mod , only : errMsg => shr_log_errMsg
- use shr_kind_mod , only : r8 => shr_kind_r8
- use abortutils , only : endrun
- use clm_time_manager , only : get_nstep, get_curr_date, get_curr_time
- use spmdMod , only : masterproc
- use seq_drydep_mod , only : n_drydep, drydep_list
- use seq_drydep_mod , only : drydep_method, DD_XLND
- use seq_drydep_mod , only : index_o3=>o3_ndx, index_o3a=>o3a_ndx, index_so2=>so2_ndx, index_h2=>h2_ndx
- use seq_drydep_mod , only : index_co=>co_ndx, index_ch4=>ch4_ndx, index_pan=>pan_ndx
- use seq_drydep_mod , only : index_xpan=>xpan_ndx
- use decompMod , only : bounds_type
- use clm_varcon , only : namep
- use atm2lndType , only : atm2lnd_type
- use CanopyStateType , only : canopystate_type
- use FrictionVelocityMod , only : frictionvel_type
- use PhotosynthesisMod , only : photosyns_type
- use WaterstateType , only : waterstate_type
- use GridcellType , only : grc
- use LandunitType , only : lun
- use PatchType , only : patch
- !
- implicit none
- private
- !
- public :: depvel_compute
- !
- type, public :: drydepvel_type
-
- real(r8), pointer, public :: velocity_patch (:,:) ! Dry Deposition Velocity
- real(r8), pointer, private :: rs_drydep_patch (:) ! Stomatal resistance associated with dry deposition velocity for Ozone
-
- contains
-
- procedure , public :: Init
- procedure , private :: InitAllocate
- procedure , private :: InitHistory
-
- end type drydepvel_type
- !-----------------------------------------------------------------------
-
- character(len=*), parameter, private :: sourcefile = &
- __FILE__
-
-CONTAINS
-
- !------------------------------------------------------------------------
- subroutine Init(this, bounds)
-
- class(drydepvel_type) :: this
- type(bounds_type), intent(in) :: bounds
-
- call this%InitAllocate(bounds)
- call this%InitHistory(bounds)
-
- end subroutine Init
-
- !------------------------------------------------------------------------
- subroutine InitAllocate(this, bounds)
- !
- ! !USES:
- use shr_infnan_mod , only : nan => shr_infnan_nan, assignment(=)
- use seq_drydep_mod , only : n_drydep, drydep_method, DD_XLND
- !
- ! !ARGUMENTS:
- class(drydepvel_type) :: this
- type(bounds_type), intent(in) :: bounds
- !
- ! !LOCAL VARIABLES:
- integer :: begp, endp
- !------------------------------------------------------------------------
-
- begp = bounds%begp; endp= bounds%endp
-
- ! Dry Deposition Velocity
- if ( n_drydep > 0 .and. drydep_method == DD_XLND )then
- allocate(this%velocity_patch(begp:endp, n_drydep)); this%velocity_patch(:,:) = nan
- allocate(this%rs_drydep_patch(begp:endp)) ; this%rs_drydep_patch(:) = nan
- end if
-
- end subroutine InitAllocate
-
- !-----------------------------------------------------------------------
- subroutine InitHistory(this, bounds)
- !
- ! !DESCRIPTION:
- ! Initialize history output fields for dry deposition diagnositics
- !
- ! !USES
- use clm_varcon , only : spval
- use histFileMod , only : hist_addfld1d
- use seq_drydep_mod , only : mapping
- !
- ! !ARGUMENTS:
- class(drydepvel_type) :: this
- type(bounds_type), intent(in) :: bounds
- real(r8), pointer :: ptr_1d(:) ! pointer to 1d patch array
- !
- ! !LOCAL VARIABLES
- integer :: ispec
- integer :: begp, endp
- !---------------------------------------------------------------------
-
- begp = bounds%begp; endp = bounds%endp
-
- if ( n_drydep == 0 .or. drydep_method /= DD_XLND ) return
-
- do ispec=1,n_drydep
- if(mapping(ispec) <= 0) cycle
-
- this%velocity_patch(begp:endp,ispec)= spval
- ptr_1d => this%velocity_patch(begp:endp,ispec)
- call hist_addfld1d ( fname='DRYDEPV_'//trim(drydep_list(ispec)), units='cm/sec', &
- avgflag='A', long_name='Dry Deposition Velocity', &
- ptr_patch=ptr_1d, default='inactive' )
- end do
-
- this%rs_drydep_patch(begp:endp)= spval
- call hist_addfld1d ( fname='RS_DRYDEP_O3', units='s/m', &
- avgflag='A', long_name='Stomatal Resistance Associated with Ozone Dry Deposition Velocity', &
- ptr_patch=this%rs_drydep_patch, default='inactive' )
-
- end subroutine InitHistory
-
- !-----------------------------------------------------------------------
- subroutine depvel_compute( bounds, &
- atm2lnd_inst, canopystate_inst, waterstate_inst, frictionvel_inst, &
- photosyns_inst, drydepvel_inst)
- !
- ! !DESCRIPTION:
- ! computes the dry deposition velocity of tracers
- !
- ! !USES:
- use shr_const_mod , only : tmelt => shr_const_tkfrz
- use seq_drydep_mod , only : seq_drydep_setHCoeff, mapping, drat, foxd
- use seq_drydep_mod , only : rcls, h2_a, h2_b, h2_c, ri, rac, rclo, rlu, rgss, rgso
- use landunit_varcon, only : istsoil, istice_mec, istdlak, istwet
- use clm_varctl , only : iulog
- use pftconMod , only : noveg, ndllf_evr_tmp_tree, ndllf_evr_brl_tree
- use pftconMod , only : ndllf_dcd_brl_tree, nbrdlf_evr_trp_tree
- use pftconMod , only : nbrdlf_evr_tmp_tree, nbrdlf_dcd_trp_tree
- use pftconMod , only : nbrdlf_dcd_tmp_tree, nbrdlf_dcd_brl_tree
- use pftconMod , only : nbrdlf_evr_shrub, nbrdlf_dcd_tmp_shrub
- use pftconMod , only : nbrdlf_dcd_brl_shrub,nc3_arctic_grass
- use pftconMod , only : nc3_nonarctic_grass, nc4_grass, nc3crop
- use pftconMod , only : nc3irrig, npcropmin, npcropmax
- use clm_varcon , only : spval
-
- !
- ! !ARGUMENTS:
- type(bounds_type) , intent(in) :: bounds
- type(atm2lnd_type) , intent(in) :: atm2lnd_inst
- type(canopystate_type) , intent(in) :: canopystate_inst
- type(waterstate_type) , intent(in) :: waterstate_inst
- type(frictionvel_type) , intent(in) :: frictionvel_inst
- type(photosyns_type) , intent(in) :: photosyns_inst
- type(drydepvel_type) , intent(inout) :: drydepvel_inst
- !
- ! !LOCAL VARIABLES:
- integer :: c
- real(r8) :: soilw, var_soilw, fact_h2, dv_soil_h2
- integer :: pi,g, l
- integer :: ispec
- integer :: length
- integer :: wesveg !wesely vegegation index
- integer :: clmveg !clm veg index from ivegtype
- integer :: i
- integer :: index_season !seasonal index based on LAI. This indexs wesely data tables
- integer :: nstep !current step
- integer :: indexp
-
- real(r8) :: pg ! surface pressure
- real(r8) :: tc ! temperature in celsius
- real(r8) :: es ! saturation vapor pressur
- real(r8) :: ws ! saturation mixing ratio
- real(r8) :: rmx ! resistance by vegetation
- real(r8) :: qs ! saturation specific humidity
- real(r8) :: dewm ! multiplier for rs when dew occurs
- real(r8) :: crs ! multiplier to calculate crs
- real(r8) :: rdc ! part of lower canopy resistance
- real(r8) :: rain ! rain fall
- real(r8) :: spec_hum ! specific humidity
- real(r8) :: solar_flux ! solar radiation(direct beam) W/m2
- real(r8) :: lat ! latitude in degrees
- real(r8) :: lon ! longitude in degrees
- real(r8) :: sfc_temp ! surface temp
- real(r8) :: minlai ! minimum of monthly lai
- real(r8) :: maxlai ! maximum of monthly lai
- real(r8) :: rds ! resistance for aerosols
-
- !mvm 11/30/2013
- real(r8) :: rlu_lai ! constant to calculate rlu over bulk canopy
-
- logical :: has_dew
- logical :: has_rain
- real(r8), parameter :: rain_threshold = 1.e-7_r8 ! of the order of 1cm/day expressed in m/s
-
- ! local arrays: dependent on species only
- real(r8), dimension(n_drydep) :: rsmx !vegetative resistance (plant mesophyll)
- real(r8), dimension(n_drydep) :: rclx !lower canopy resistance
- real(r8), dimension(n_drydep) :: rlux !vegetative resistance (upper canopy)
- real(r8), dimension(n_drydep) :: rgsx !gournd resistance
- real(r8), dimension(n_drydep) :: heff
- real(r8) :: rs ! stomatal resistance associated with dry deposition velocity (s/m)
- real(r8) :: rc !combined surface resistance
- real(r8) :: cts !correction to flu rcl and rgs for frost
- real(r8) :: rlux_o3 !to calculate O3 leaf resistance in dew/rain conditions
-
- ! constants
- real(r8), parameter :: slope = 0._r8 ! Used to calculate rdc in (lower canopy resistance)
- integer, parameter :: wveg_unset = -1 ! Unset Wesley vegetation type
- character(len=32), parameter :: subname = "depvel_compute"
-
- ! jfl : mods for PAN
- real(r8) :: dv_pan
- real(r8) :: c0_pan(11) = (/ 0.000_r8, 0.006_r8, 0.002_r8, 0.009_r8, 0.015_r8, &
- 0.006_r8, 0.000_r8, 0.000_r8, 0.000_r8, 0.002_r8, 0.002_r8 /)
- real(r8) :: k_pan (11) = (/ 0.000_r8, 0.010_r8, 0.005_r8, 0.004_r8, 0.003_r8, &
- 0.005_r8, 0.000_r8, 0.000_r8, 0.000_r8, 0.075_r8, 0.002_r8 /)
- !-----------------------------------------------------------------------
-
- if ( n_drydep == 0 .or. drydep_method /= DD_XLND ) return
-
- associate( &
- forc_solai => atm2lnd_inst%forc_solai_grc , & ! Input: [real(r8) (:,:) ] direct beam radiation (visible only)
- forc_solad => atm2lnd_inst%forc_solad_grc , & ! Input: [real(r8) (:,:) ] direct beam radiation (visible only)
- forc_t => atm2lnd_inst%forc_t_downscaled_col , & ! Input: [real(r8) (:) ] downscaled atmospheric temperature (Kelvin)
- forc_q => atm2lnd_inst%forc_q_downscaled_col , & ! Input: [real(r8) (:) ] downscaled atmospheric specific humidity (kg/kg)
- forc_psrf => atm2lnd_inst%forc_pbot_downscaled_col , & ! Input: [real(r8) (:) ] downscaled surface pressure (Pa)
- forc_rain => atm2lnd_inst%forc_rain_downscaled_col , & ! Input: [real(r8) (:) ] downscaled rain rate [mm/s]
-
- h2osoi_vol => waterstate_inst%h2osoi_vol_col , & ! Input: [real(r8) (:,:) ] volumetric soil water (0<=h2osoi_vol<=watsat)
- snow_depth => waterstate_inst%snow_depth_col , & ! Input: [real(r8) (:) ] snow height (m)
-
- ram1 => frictionvel_inst%ram1_patch , & ! Input: [real(r8) (:) ] aerodynamical resistance
- rb1 => frictionvel_inst%rb1_patch , & ! Input: [real(r8) (:) ] leaf boundary layer resistance [s/m]
- vds => frictionvel_inst%vds_patch , & ! Input: [real(r8) (:) ] aerodynamical resistance
-
- rssun => photosyns_inst%rssun_patch , & ! Input: [real(r8) (:) ] stomatal resistance
- rssha => photosyns_inst%rssha_patch , & ! Input: [real(r8) (:) ] shaded stomatal resistance (s/m)
-
- fsun => canopystate_inst%fsun_patch , & ! Input: [real(r8) (:) ] sunlit fraction of canopy
- elai => canopystate_inst%elai_patch , & ! Input: [real(r8) (:) ] one-sided leaf area index with burying by snow
- mlaidiff => canopystate_inst%mlaidiff_patch , & ! Input: [real(r8) (:) ] difference in lai between month one and month two
- annlai => canopystate_inst%annlai_patch , & ! Input: [real(r8) (:,:) ] 12 months of monthly lai from input data set
-
- velocity => drydepvel_inst%velocity_patch , & ! Output: [real(r8) (:,:) ] cm/sec
- rs_drydep => drydepvel_inst%rs_drydep_patch & ! Output: [real(r8) (:) ] stomatal resistance associated with Ozone dry deposition velocity (s/m)
- )
-
- !_________________________________________________________________
- ! Begin loop through patches
-
- pft_loop: do pi = bounds%begp,bounds%endp
- l = patch%landunit(pi)
-
- active: if (patch%active(pi)) then
-
- c = patch%column(pi)
- g = patch%gridcell(pi)
- pg = forc_psrf(c)
- spec_hum = forc_q(c)
- rain = forc_rain(c)
- sfc_temp = forc_t(c)
- solar_flux = forc_solad(g,1)
- lat = grc%latdeg(g)
- lon = grc%londeg(g)
- clmveg = patch%itype(pi)
- soilw = h2osoi_vol(c,1)
-
- !map CLM veg type into Wesely veg type
- wesveg = wveg_unset
- if (clmveg == noveg ) wesveg = 8
- if (clmveg == ndllf_evr_tmp_tree ) wesveg = 5
- if (clmveg == ndllf_evr_brl_tree ) wesveg = 5
- if (clmveg == ndllf_dcd_brl_tree ) wesveg = 5
- if (clmveg == nbrdlf_evr_trp_tree ) wesveg = 4
- if (clmveg == nbrdlf_evr_tmp_tree ) wesveg = 4
- if (clmveg == nbrdlf_dcd_trp_tree ) wesveg = 4
- if (clmveg == nbrdlf_dcd_tmp_tree ) wesveg = 4
- if (clmveg == nbrdlf_dcd_brl_tree ) wesveg = 4
- if (clmveg == nbrdlf_evr_shrub ) wesveg = 11
- if (clmveg == nbrdlf_dcd_tmp_shrub ) wesveg = 11
- if (clmveg == nbrdlf_dcd_brl_shrub ) wesveg = 11
- if (clmveg == nc3_arctic_grass ) wesveg = 3
- if (clmveg == nc3_nonarctic_grass ) wesveg = 3
- if (clmveg == nc4_grass ) wesveg = 3
- if (clmveg == nc3crop ) wesveg = 2
- if (clmveg == nc3irrig ) wesveg = 2
- if (clmveg >= npcropmin .and. clmveg <= npcropmax ) wesveg = 2
- if (wesveg == wveg_unset )then
- write(iulog,*) 'clmveg = ', clmveg, 'lun%itype = ', lun%itype(l)
- call endrun(decomp_index=pi, clmlevel=namep, &
- msg='ERROR: Not able to determine Wesley vegetation type'//&
- errMsg(sourcefile, __LINE__))
- end if
-
- ! create seasonality index used to index wesely data tables from LAI, Bascially
- !if elai is between max lai from input data and half that max the index_season=1
-
-
- !mail1j and mlai2j are the two monthly lai values pulled from a CLM input data set
- !/fs/cgd/csm/inputdata/lnd/clm2/rawdata/mksrf_lai.nc. lai for dates in the middle
- !of the month are interpolated using using these values and stored in the variable
- !elai (done elsewhere). If the difference between mlai1j and mlai2j is greater
- !than zero it is assumed to be fall and less than zero it is assumed to be spring.
-
- !wesely seasonal "index_season"
- ! 1 - midsummer with lush vegetation
- ! 2 - Autumn with unharvested cropland
- ! 3 - Late autumn after frost, no snow
- ! 4 - Winter, snow on ground and subfreezing
- ! 5 - Transitional spring with partially green short annuals
-
-
- !mlaidiff=jan-feb
- minlai=minval(annlai(:,pi))
- maxlai=maxval(annlai(:,pi))
-
- index_season = -1
-
- if ( lun%itype(l) /= istsoil )then
- if ( lun%itype(l) == istice_mec ) then
- wesveg = 8
- index_season = 4
- elseif ( lun%itype(l) == istdlak ) then
- wesveg = 7
- index_season = 4
- elseif ( lun%itype(l) == istwet ) then
- wesveg = 9
- index_season = 2
- elseif ( lun%urbpoi(l) ) then
- wesveg = 1
- index_season = 2
- end if
- else if ( snow_depth(c) > 0 ) then
- index_season = 4
- else if(elai(pi) > 0.5_r8*maxlai) then
- index_season = 1
- endif
-
- if (index_season<0) then
- if (elai(pi) < (minlai+0.05*(maxlai-minlai))) then
- index_season = 3
- endif
- endif
-
- if (index_season<0) then
- if (mlaidiff(pi) > 0.0_r8) then
- index_season = 2
- elseif (mlaidiff(pi) < 0.0_r8) then
- index_season = 5
- elseif (mlaidiff(pi).eq.0.0_r8) then
- index_season = 3
- endif
- endif
-
- if (index_season<0) then
- call endrun('ERROR: not able to determine season'//errmsg(sourcefile, __LINE__))
- endif
-
- ! saturation specific humidity
- !
- es = 611_r8*exp(5414.77_r8*((1._r8/tmelt)-(1._r8/sfc_temp)))
- ws = .622_r8*es/(pg-es)
- qs = ws/(1._r8+ws)
-
- has_dew = .false.
- if( qs <= spec_hum ) then
- has_dew = .true.
- end if
- if( sfc_temp < tmelt ) then
- has_dew = .false.
- end if
-
- has_rain = rain > rain_threshold
-
- if ( has_dew .or. has_rain ) then
- dewm = 3._r8
- else
- dewm = 1._r8
- end if
-
- !Define tc
- tc = sfc_temp - tmelt
-
- !
- ! rdc (lower canopy res)
- !
- rdc=100._r8*(1._r8+1000._r8/(solar_flux+10._r8))/(1._r8+1000._r8*slope)
-
- ! surface resistance : depends on both land type and species
- ! land types are computed seperately, then resistance is computed as average of values
- ! following wesely rc=(1/(rs+rm) + 1/rlu +1/(rdc+rcl) + 1/(rac+rgs))**-1
-
- !*******************************************************
- call seq_drydep_setHCoeff( sfc_temp, heff(:n_drydep) )
- !*********************************************************
-
- species_loop1: do ispec=1, n_drydep
- if(mapping(ispec) <= 0) cycle
-
- if(ispec.eq.index_o3.or.ispec.eq.index_o3a.or.ispec.eq.index_so2) then
- rmx=0._r8
- else
- rmx=1._r8/((heff(ispec)/3000._r8)+(100._r8*foxd(ispec)))
- endif
-
- ! correction for frost
- cts = 1000._r8*exp( -tc - 4._r8 )
-
- !ground resistance
- rgsx(ispec) = 1._r8/((heff(ispec)/(1.e5_r8*(rgss(index_season,wesveg)+cts))) + &
- (foxd(ispec)/(rgso(index_season,wesveg)+cts)))
-
- !-------------------------------------------------------------------------------------
- ! special case for H2 and CO;; CH4 is set ot a fraction of dv(H2)
- !-------------------------------------------------------------------------------------
- if( ispec == index_h2 .or. ispec == index_co .or. ispec == index_ch4 ) then
-
- if( ispec == index_co ) then
- fact_h2 = 1.0_r8
- elseif ( ispec == index_h2 ) then
- fact_h2 = 0.5_r8
- elseif ( ispec == index_ch4 ) then
- fact_h2 = 50.0_r8
- end if
-
- !-------------------------------------------------------------------------------------
- ! no deposition on snow, ice, desert, and water
- !-------------------------------------------------------------------------------------
- if( wesveg == 1 .or. wesveg == 7 .or. wesveg == 8 .or. index_season == 4 ) then
- rgsx(ispec) = spval
- else
- var_soilw = max( .1_r8,min( soilw,.3_r8 ) )
- if( wesveg == 3 ) then
- var_soilw = log( var_soilw )
- end if
- dv_soil_h2 = h2_c(wesveg) + var_soilw*(h2_b(wesveg) + var_soilw*h2_a(wesveg))
- if( dv_soil_h2 > 0._r8 ) then
- rgsx(ispec) = fact_h2/(dv_soil_h2*1.e-4_r8)
- end if
- end if
- end if
-
- !-------------------------------------------------------------------------------------
- ! no deposition on water or no vegetation or snow (elai<=0)
- !-------------------------------------------------------------------------------------
-
- no_dep: if( wesveg == 7 .or. elai(pi).le.0_r8 ) then !mvm 11/26/2013
- rclx(ispec) = spval
- rsmx(ispec) = spval
- rlux(ispec) = spval
- rs = spval
- else
-
- !Stomatal resistance
-
- ! fvitt -- at midnight rssun and/or rssha can be zero in some places which sets rs to zero
- ! --- this fix prevents divide by zero error (when rsmx is zero)
- if (rssun(pi)>0._r8 .and. rssun(pi)<1.e30 .and. rssha(pi)>0._r8 .and. rssha(pi)<1.e30 ) then
- !LKE: corrected rs to add rssun and rssha in parallel (11/30/2017)
- rs=1._r8/(fsun(pi)*elai(pi)/rssun(pi) + (1.-fsun(pi))*elai(pi)/rssha(pi))
- else
- rs=spval
- endif
-
- rsmx(ispec) = rs*drat(ispec)+rmx
-
- ! Leaf resistance
- !MVM: adjusted rlu by LAI to get leaf resistance over bulk canopy (gao and wesely, 1995)
- rlu_lai=cts+rlu(index_season,wesveg)/elai(pi)
- rlux(ispec) = rlu_lai/(1.e-5_r8*heff(ispec)+foxd(ispec))
-
- !Lower canopy resistance
- rclx(ispec) = 1._r8/((heff(ispec)/(1.e5_r8*(rcls(index_season,wesveg)+cts))) + &
- (foxd(ispec)/(rclo(index_season,wesveg)+cts)))
-
- !-----------------------------------
- !mvm 11/30/2013: special case for CO
- !Dry deposition of CO and hydrocarbons is negligibly
- !small in vegetation [Mueller and Brasseur, 1995].
- !------------------------------------
- if( ispec == index_co ) then
- rclx(ispec) = spval
- rsmx(ispec) = spval
- rlux(ispec) = spval
- endif
-
- !--------------------------------------------
- ! jfl : special case for PAN
- !--------------------------------------------
- if( ispec == index_pan ) then
- dv_pan = c0_pan(wesveg) * (1._r8 - exp(-k_pan(wesveg)*(rs*drat(ispec))*1.e-2_r8 ))
-
- if( dv_pan > 0._r8 .and. index_season /= 4 ) then
- rsmx(ispec) = ( 1._r8/dv_pan )
- end if
- end if
-
- endif no_dep
- if ( ispec == index_o3 )then
- rs_drydep(pi) = rs
- end if
-
- end do species_loop1
-
-
- !----------------------------------------------
- !Adjustment for dew and rain in leaf resitances
- !---------------------------------------------
- ! no effect over water
- no_water: if( wesveg.ne.7 ) then
- !MVM: effect only on vegetated areas (elai> 0)
- with_LAI: if (elai(pi).gt.0._r8) then
-
- !
- ! no effect if sfc_temp < O C
- !
- non_freezing: if(sfc_temp.gt.tmelt) then
- if( has_dew ) then
- rlu_lai=cts+rlu(index_season,wesveg)/elai(pi)
- rlux_o3 = 1._r8/((1._r8/3000._r8)+(1._r8/(3._r8*rlu_lai)))
-
- if (index_o3 > 0) then
- rlux(index_o3) = rlux_o3
- endif
- if (index_o3a > 0) then
- rlux(index_o3a) = rlux_o3
- endif
- endif
-
- if(has_rain) then
- rlu_lai=cts+rlu(index_season,wesveg)/elai(pi)
- rlux_o3 = 1._r8/((1._r8/1000._r8)+(1._r8/(3._r8*rlu_lai)))
-
- if (index_o3 > 0) then
- rlux(index_o3) = rlux_o3
- endif
- if (index_o3a > 0) then
- rlux(index_o3a) = rlux_o3
- endif
- endif
-
- species_loop2: do ispec=1,n_drydep
- if(mapping(ispec).le.0) cycle
- if(ispec.ne.index_o3.and.ispec.ne.index_o3a.and.ispec.ne.index_so2) then
-
- if( has_dew .or. has_rain) then
- rlu_lai=cts+rlu(index_season,wesveg)/elai(pi)
- rlux(ispec)=1._r8/((1._r8/(3._r8*rlu_lai))+ &
- (1.e-7_r8*heff(ispec))+(foxd(ispec)/rlux_o3))
- endif
-
- elseif(ispec.eq.index_so2) then
-
- if( has_dew ) then
- rlux(ispec) = 100._r8
- endif
-
- if(has_rain) then
- rlu_lai=cts+rlu(index_season,wesveg)/elai(pi)
- rlux(ispec) = 1._r8/((1._r8/5000._r8)+(1._r8/(3._r8*rlu_lai)))
- endif
-
- if( has_dew .or. has_rain ) then
- !MVM:rlux=50 for SO2 in dew or rain only for *urban land* type surfaces.
- if (wesveg.eq.1) then
- rlux(ispec)=50._r8
- endif
- endif
- end if
- !mvm 11/30/2013: special case for CO
- if( ispec.eq.index_co ) then
- rlux(ispec) = spval
- endif
- end do species_loop2
- endif non_freezing
- endif with_LAI
- endif no_water
-
- ! resistance for aerosols
- rds = 1._r8/vds(pi)
-
- species_loop3: do ispec=1,n_drydep
- if(mapping(ispec) <= 0) cycle
-
- !
- ! compute rc
- !
- rc = 1._r8/((1._r8/rsmx(ispec))+(1._r8/rlux(ispec)) + &
- (1._r8/(rdc+rclx(ispec)))+(1._r8/(rac(index_season,wesveg)+rgsx(ispec))))
- rc = max( 10._r8, rc)
- !
- ! assume no surface resistance for SO2 over water
- !
- if ( drydep_list(ispec) == 'SO2' .and. wesveg == 7 ) then
- rc = 0._r8
- end if
-
- select case( drydep_list(ispec) )
- case ( 'SO4' )
- velocity(pi,ispec) = (1._r8/(ram1(pi)+rds))*100._r8
- case ( 'NH4','NH4NO3','XNH4NO3' )
- velocity(pi,ispec) = (1._r8/(ram1(pi)+0.5_r8*rds))*100._r8
- case ( 'Pb' )
- velocity(pi,ispec) = 0.2_r8
- case ( 'CB1', 'CB2', 'OC1', 'OC2', 'SOAM', 'SOAI', 'SOAT', 'SOAB', 'SOAX' )
- velocity(pi,ispec) = 0.10_r8
- case ( 'SO2' )
- velocity(pi,ispec) = (1._r8/(ram1(pi)+rb1(pi)+rc))*200._r8
- case default
- velocity(pi,ispec) = (1._r8/(ram1(pi)+rb1(pi)+rc))*100._r8
- end select
- end do species_loop3
- endif active
- end do pft_loop
-
- end associate
-
- end subroutine depvel_compute
-
-end module DryDepVelocity
diff --git a/src/biogeochem/SatellitePhenologyMod.F90 b/src/biogeochem/SatellitePhenologyMod.F90
deleted file mode 100644
index 78b2cf0e..00000000
--- a/src/biogeochem/SatellitePhenologyMod.F90
+++ /dev/null
@@ -1,684 +0,0 @@
-module SatellitePhenologyMod
-
- !-----------------------------------------------------------------------
- ! !DESCRIPTION:
- ! CLM Satelitte Phenology model (SP) ecosystem dynamics (phenology, vegetation).
- ! Allow some subroutines to be used by the CLM Carbon Nitrogen model (CLMCN)
- ! so that DryDeposition code can get estimates of LAI differences between months.
- !
- ! !USES:
- use shr_strdata_mod , only : shr_strdata_type, shr_strdata_create
- use shr_strdata_mod , only : shr_strdata_print, shr_strdata_advance
- use shr_kind_mod , only : r8 => shr_kind_r8
- use shr_kind_mod , only : CL => shr_kind_CL
- use shr_log_mod , only : errMsg => shr_log_errMsg
- use decompMod , only : bounds_type
- use abortutils , only : endrun
- use clm_varctl , only : scmlat,scmlon,single_column
- use clm_varctl , only : iulog, use_lai_streams
- use clm_varcon , only : grlnd
- use controlMod , only : NLFilename
- use decompMod , only : gsmap_lnd_gdc2glo
- use domainMod , only : ldomain
- use fileutils , only : getavu, relavu
- use PatchType , only : patch
- use CanopyStateType , only : canopystate_type
- use WaterstateType , only : waterstate_type
- use perf_mod , only : t_startf, t_stopf
- use spmdMod , only : masterproc
- use spmdMod , only : mpicom, comp_id
- use mct_mod
- use ncdio_pio
- !
- ! !PUBLIC TYPES:
- implicit none
- private
- !
- ! !PUBLIC MEMBER FUNCTIONS:
- public :: SatellitePhenology ! CLMSP Ecosystem dynamics: phenology, vegetation
- public :: SatellitePhenologyInit ! Dynamically allocate memory
- public :: interpMonthlyVeg ! interpolate monthly vegetation data
- public :: readAnnualVegetation ! Read in annual vegetation (needed for Dry-deposition)
- !
- ! !PRIVATE MEMBER FUNCTIONS:
- private :: readMonthlyVegetation ! read monthly vegetation data for two months
- private :: lai_init ! position datasets for LAI
- private :: lai_interp ! interpolates between two years of LAI data
-
- ! !PRIVATE MEMBER DATA:
- type(shr_strdata_type) :: sdat_lai ! LAI input data stream
- !
- ! !PRIVATE TYPES:
- integer , private :: InterpMonths1 ! saved month index
- real(r8), private :: timwt(2) ! time weights for month 1 and month 2
- real(r8), private, allocatable :: mlai2t(:,:) ! lai for interpolation (2 months)
- real(r8), private, allocatable :: msai2t(:,:) ! sai for interpolation (2 months)
- real(r8), private, allocatable :: mhvt2t(:,:) ! top vegetation height for interpolation (2 months)
- real(r8), private, allocatable :: mhvb2t(:,:) ! bottom vegetation height for interpolation(2 months)
-
- character(len=*), parameter, private :: sourcefile = &
- __FILE__
- !-----------------------------------------------------------------------
-
-contains
-
- !-----------------------------------------------------------------------
- !
- ! lai_init
- !
- !-----------------------------------------------------------------------
- subroutine lai_init(bounds)
- !
- ! Initialize data stream information for LAI.
- !
- !
- ! !USES:
- use clm_varctl , only : inst_name
- use clm_time_manager , only : get_calendar
- use ncdio_pio , only : pio_subsystem
- use shr_pio_mod , only : shr_pio_getiotype
- use clm_nlUtilsMod , only : find_nlgroup_name
- use ndepStreamMod , only : clm_domain_mct
- use histFileMod , only : hist_addfld1d
- use shr_stream_mod , only : shr_stream_file_null
- use shr_string_mod , only : shr_string_listCreateField
- !
- ! !ARGUMENTS:
- implicit none
- type(bounds_type), intent(in) :: bounds ! bounds
- !
- ! !LOCAL VARIABLES:
- integer :: i ! index
- integer :: stream_year_first_lai ! first year in Lai stream to use
- integer :: stream_year_last_lai ! last year in Lai stream to use
- integer :: model_year_align_lai ! align stream_year_first_lai with
- integer :: nu_nml ! unit for namelist file
- integer :: nml_error ! namelist i/o error flag
- type(mct_ggrid) :: dom_clm ! domain information
- character(len=CL) :: stream_fldFileName_lai ! lai stream filename to read
- character(len=CL) :: lai_mapalgo = 'bilinear' ! Mapping alogrithm
-
- character(*), parameter :: subName = "('laidyn_init')"
- character(*), parameter :: F00 = "('(laidyn_init) ',4a)"
- character(*), parameter :: laiString = "LAI" ! base string for field string
- integer , parameter :: numLaiFields = 16 ! number of fields to build field string
- character(SHR_KIND_CXX) :: fldList ! field string
- !-----------------------------------------------------------------------
- !
- ! deal with namelist variables here in init
- !
- namelist /lai_streams/ &
- stream_year_first_lai, &
- stream_year_last_lai, &
- model_year_align_lai, &
- lai_mapalgo, &
- stream_fldFileName_lai
-
- ! Default values for namelist
- stream_year_first_lai = 1 ! first year in stream to use
- stream_year_last_lai = 1 ! last year in stream to use
- model_year_align_lai = 1 ! align stream_year_first_lai with this model year
- stream_fldFileName_lai = shr_stream_file_null
-
- ! Read lai_streams namelist
- if (masterproc) then
- nu_nml = getavu()
- open( nu_nml, file=trim(NLFilename), status='old', iostat=nml_error )
- call find_nlgroup_name(nu_nml, 'lai_streams', status=nml_error)
- if (nml_error == 0) then
- read(nu_nml, nml=lai_streams,iostat=nml_error)
- if (nml_error /= 0) then
- call endrun(subname // ':: ERROR reading lai_streams namelist')
- end if
- else
- call endrun(subname // ':: ERROR finding lai_streams namelist')
- end if
- close(nu_nml)
- call relavu( nu_nml )
- endif
-
- call shr_mpi_bcast(stream_year_first_lai, mpicom)
- call shr_mpi_bcast(stream_year_last_lai, mpicom)
- call shr_mpi_bcast(model_year_align_lai, mpicom)
- call shr_mpi_bcast(stream_fldFileName_lai, mpicom)
-
- if (masterproc) then
-
- write(iulog,*) ' '
- write(iulog,*) 'lai_stream settings:'
- write(iulog,*) ' stream_year_first_lai = ',stream_year_first_lai
- write(iulog,*) ' stream_year_last_lai = ',stream_year_last_lai
- write(iulog,*) ' model_year_align_lai = ',model_year_align_lai
- write(iulog,*) ' stream_fldFileName_lai = ',trim(stream_fldFileName_lai)
-
- endif
-
- call clm_domain_mct (bounds, dom_clm)
-
- !
- ! create the field list for these lai fields...use in shr_strdata_create
- !
- fldList = shr_string_listCreateField( numLaiFields, laiString )
-
- call shr_strdata_create(sdat_lai,name="laidyn", &
- pio_subsystem=pio_subsystem, &
- pio_iotype=shr_pio_getiotype(inst_name), &
- mpicom=mpicom, compid=comp_id, &
- gsmap=gsmap_lnd_gdc2glo, ggrid=dom_clm, &
- nxg=ldomain%ni, nyg=ldomain%nj, &
- yearFirst=stream_year_first_lai, &
- yearLast=stream_year_last_lai, &
- yearAlign=model_year_align_lai, &
- offset=0, &
- domFilePath='', &
- domFileName=trim(stream_fldFileName_lai), &
- domTvarName='time', &
- domXvarName='lon' , &
- domYvarName='lat' , &
- domAreaName='area', &
- domMaskName='mask', &
- filePath='', &
- filename=(/stream_fldFileName_lai/), &
- fldListFile=fldList, &
- fldListModel=fldList, &
- fillalgo='none', &
- mapalgo=lai_mapalgo, &
- calendar=get_calendar(), &
- taxmode='cycle' )
-
- if (masterproc) then
- call shr_strdata_print(sdat_lai,'LAI data')
- endif
-
- end subroutine lai_init
-
- !-----------------------------------------------------------------------
- !
- ! lai_interp
- !
- !-----------------------------------------------------------------------
- subroutine lai_interp(bounds, canopystate_inst)
- !
- ! Interpolate data stream information for Lai.
- !
- ! !USES:
- use clm_time_manager, only : get_curr_date
- use pftconMod , only : noveg
- !
- ! !ARGUMENTS:
- implicit none
- type(bounds_type) , intent(in) :: bounds
- type(canopystate_type) , intent(inout) :: canopystate_inst
- !
- ! !LOCAL VARIABLES:
- integer :: ivt, p, g, ip, ig, gpft
- integer :: year ! year (0, ...) for nstep+1
- integer :: mon ! month (1, ..., 12) for nstep+1
- integer :: day ! day of month (1, ..., 31) for nstep+1
- integer :: sec ! seconds into current date for nstep+1
- integer :: mcdate ! Current model date (yyyymmdd)
- character(len=CL) :: stream_var_name
- !-----------------------------------------------------------------------
-
- call get_curr_date(year, mon, day, sec)
- mcdate = year*10000 + mon*100 + day
-
- call shr_strdata_advance(sdat_lai, mcdate, sec, mpicom, 'laidyn')
-
- do p = bounds%begp, bounds%endp
- ivt = patch%itype(p)
- if (ivt /= noveg) then ! vegetated pft
- write(stream_var_name,"(i6)") ivt
- stream_var_name = 'LAI_'//trim(adjustl(stream_var_name))
- ip = mct_aVect_indexRA(sdat_lai%avs(1),trim(stream_var_name))
- endif
- gpft = patch%gridcell(p)
-
- !
- ! Determine vector index corresponding to gpft
- !
- ig = 0
- do g = bounds%begg,bounds%endg
- ig = ig+1
- if (g == gpft) exit
- end do
-
- !
- ! Set lai for each gridcell/patch combination
- !
- if (ivt /= noveg) then ! vegetated pft
- canopystate_inst%tlai_patch(p) = sdat_lai%avs(1)%rAttr(ip,ig)
- else ! non-vegetated pft
- canopystate_inst%tlai_patch(p) = 0._r8
- endif
- end do
-
- end subroutine lai_interp
-
- !-----------------------------------------------------------------------
- subroutine SatellitePhenologyInit (bounds)
- !
- ! !DESCRIPTION:
- ! Dynamically allocate memory and set to signaling NaN.
- !
- ! !USES:
- use shr_infnan_mod, only : nan => shr_infnan_nan, assignment(=)
- !
- ! !ARGUMENTS:
- type(bounds_type), intent(in) :: bounds
- !
- ! !LOCAL VARIABLES:
- integer :: ier ! error code
- !-----------------------------------------------------------------------
-
- InterpMonths1 = -999 ! saved month index
-
- ier = 0
- if(.not.allocated(mlai2t)) then
- allocate (mlai2t(bounds%begp:bounds%endp,2), &
- msai2t(bounds%begp:bounds%endp,2), &
- mhvt2t(bounds%begp:bounds%endp,2), &
- mhvb2t(bounds%begp:bounds%endp,2), stat=ier)
- end if
- if (ier /= 0) then
- write(iulog,*) 'EcosystemDynini allocation error'
- call endrun(msg=errMsg(sourcefile, __LINE__))
- end if
-
- mlai2t(bounds%begp : bounds%endp, :) = nan
- msai2t(bounds%begp : bounds%endp, :) = nan
- mhvt2t(bounds%begp : bounds%endp, :) = nan
- mhvb2t(bounds%begp : bounds%endp, :) = nan
-
- if (use_lai_streams) then
- call lai_init(bounds)
- endif
-
- end subroutine SatellitePhenologyInit
-
- !-----------------------------------------------------------------------
- subroutine SatellitePhenology(bounds, num_nolakep, filter_nolakep, &
- waterstate_inst, canopystate_inst)
- !
- ! !DESCRIPTION:
- ! Ecosystem dynamics: phenology, vegetation
- ! Calculates leaf areas (tlai, elai), stem areas (tsai, esai) and height (htop).
- !
- ! !USES:
- use pftconMod, only : noveg, nbrdlf_dcd_brl_shrub
- !
- ! !ARGUMENTS:
- type(bounds_type) , intent(in) :: bounds
- integer , intent(in) :: num_nolakep ! number of column non-lake points in patch filter
- integer , intent(in) :: filter_nolakep(bounds%endp-bounds%begp+1) ! patch filter for non-lake points
- type(waterstate_type) , intent(in) :: waterstate_inst
- type(canopystate_type) , intent(inout) :: canopystate_inst
- !
- ! !LOCAL VARIABLES:
- integer :: fp,p,c ! indices
- real(r8) :: ol ! thickness of canopy layer covered by snow (m)
- real(r8) :: fb ! fraction of canopy layer covered by snow
- !-----------------------------------------------------------------------
-
- associate( &
- frac_sno => waterstate_inst%frac_sno_col , & ! Input: [real(r8) (:) ] fraction of ground covered by snow (0 to 1)
- snow_depth => waterstate_inst%snow_depth_col , & ! Input: [real(r8) (:) ] snow height (m)
- tlai => canopystate_inst%tlai_patch , & ! Output: [real(r8) (:) ] one-sided leaf area index, no burying by snow
- tsai => canopystate_inst%tsai_patch , & ! Output: [real(r8) (:) ] one-sided stem area index, no burying by snow
- elai => canopystate_inst%elai_patch , & ! Output: [real(r8) (:) ] one-sided leaf area index with burying by snow
- esai => canopystate_inst%esai_patch , & ! Output: [real(r8) (:) ] one-sided stem area index with burying by snow
- htop => canopystate_inst%htop_patch , & ! Output: [real(r8) (:) ] canopy top (m)
- hbot => canopystate_inst%hbot_patch , & ! Output: [real(r8) (:) ] canopy bottom (m)
- frac_veg_nosno_alb => canopystate_inst%frac_veg_nosno_alb_patch & ! Output: [integer (:) ] fraction of vegetation not covered by snow (0 OR 1) [-]
- )
-
- if (use_lai_streams) then
- call lai_interp(bounds, canopystate_inst)
- endif
-
- do fp = 1, num_nolakep
- p = filter_nolakep(fp)
- c = patch%column(p)
-
- ! need to update elai and esai only every albedo time step so do not
- ! have any inconsistency in lai and sai between SurfaceAlbedo calls (i.e.,
- ! if albedos are not done every time step).
- ! leaf phenology
- ! Set leaf and stem areas based on day of year
- ! Interpolate leaf area index, stem area index, and vegetation heights
- ! between two monthly
- ! The weights below (timwt(1) and timwt(2)) were obtained by a call to
- ! routine InterpMonthlyVeg in subroutine NCARlsm.
- ! Field Monthly Values
- ! -------------------------
- ! leaf area index LAI <- mlai1 and mlai2
- ! leaf area index SAI <- msai1 and msai2
- ! top height HTOP <- mhvt1 and mhvt2
- ! bottom height HBOT <- mhvb1 and mhvb2
-
- if (.not. use_lai_streams) then
- tlai(p) = timwt(1)*mlai2t(p,1) + timwt(2)*mlai2t(p,2)
- endif
-
- tsai(p) = timwt(1)*msai2t(p,1) + timwt(2)*msai2t(p,2)
- htop(p) = timwt(1)*mhvt2t(p,1) + timwt(2)*mhvt2t(p,2)
- hbot(p) = timwt(1)*mhvb2t(p,1) + timwt(2)*mhvb2t(p,2)
-
- ! adjust lai and sai for burying by snow. if exposed lai and sai
- ! are less than 0.05, set equal to zero to prevent numerical
- ! problems associated with very small lai and sai.
-
- ! snow burial fraction for short vegetation (e.g. grasses) as in
- ! Wang and Zeng, 2007.
-
- if (patch%itype(p) > noveg .and. patch%itype(p) <= nbrdlf_dcd_brl_shrub ) then
- ol = min( max(snow_depth(c)-hbot(p), 0._r8), htop(p)-hbot(p))
- fb = 1._r8 - ol / max(1.e-06_r8, htop(p)-hbot(p))
- else
- fb = 1._r8 - max(min(snow_depth(c),0.2_r8),0._r8)/0.2_r8 ! 0.2m is assumed
- !depth of snow required for complete burial of grasses
- endif
-
- ! area weight by snow covered fraction
-
- elai(p) = max(tlai(p)*(1.0_r8 - frac_sno(c)) + tlai(p)*fb*frac_sno(c), 0.0_r8)
- esai(p) = max(tsai(p)*(1.0_r8 - frac_sno(c)) + tsai(p)*fb*frac_sno(c), 0.0_r8)
- if (elai(p) < 0.05_r8) elai(p) = 0._r8
- if (esai(p) < 0.05_r8) esai(p) = 0._r8
-
- ! Fraction of vegetation free of snow
-
- if ((elai(p) + esai(p)) >= 0.05_r8) then
- frac_veg_nosno_alb(p) = 1
- else
- frac_veg_nosno_alb(p) = 0
- end if
-
- end do ! end of patch loop
-
- end associate
-
- end subroutine SatellitePhenology
-
- !-----------------------------------------------------------------------
- subroutine interpMonthlyVeg (bounds, canopystate_inst)
- !
- ! !DESCRIPTION:
- ! Determine if 2 new months of data are to be read.
- !
- ! !USES:
- use clm_varctl , only : fsurdat
- use clm_time_manager, only : get_curr_date, get_step_size, get_nstep
- !
- ! !ARGUMENTS:
- type(bounds_type), intent(in) :: bounds
- type(canopystate_type), intent(inout) :: canopystate_inst
- !
- ! !LOCAL VARIABLES:
- integer :: kyr ! year (0, ...) for nstep+1
- integer :: kmo ! month (1, ..., 12)
- integer :: kda ! day of month (1, ..., 31)
- integer :: ksec ! seconds into current date for nstep+1
- real(r8):: dtime ! land model time step (sec)
- real(r8):: t ! a fraction: kda/ndaypm
- integer :: it(2) ! month 1 and month 2 (step 1)
- integer :: months(2) ! months to be interpolated (1 to 12)
- integer, dimension(12) :: ndaypm= &
- (/31,28,31,30,31,30,31,31,30,31,30,31/) !days per month
- !-----------------------------------------------------------------------
-
- dtime = get_step_size()
-
- call get_curr_date(kyr, kmo, kda, ksec, offset=int(dtime))
-
- t = (kda-0.5_r8) / ndaypm(kmo)
- it(1) = t + 0.5_r8
- it(2) = it(1) + 1
- months(1) = kmo + it(1) - 1
- months(2) = kmo + it(2) - 1
- if (months(1) < 1) months(1) = 12
- if (months(2) > 12) months(2) = 1
- timwt(1) = (it(1)+0.5_r8) - t
- timwt(2) = 1._r8-timwt(1)
-
- if (InterpMonths1 /= months(1)) then
- if (masterproc) then
- write(iulog,*) 'Attempting to read monthly vegetation data .....'
- write(iulog,*) 'nstep = ',get_nstep(),' month = ',kmo,' day = ',kda
- end if
- call t_startf('readMonthlyVeg')
- call readMonthlyVegetation (bounds, fsurdat, months, canopystate_inst)
- InterpMonths1 = months(1)
- call t_stopf('readMonthlyVeg')
- end if
-
- end subroutine interpMonthlyVeg
-
- !-----------------------------------------------------------------------
- subroutine readAnnualVegetation (bounds, canopystate_inst)
- !
- ! !DESCRIPTION:
- ! read 12 months of veg data for dry deposition
- !
- ! !USES:
- use clm_varpar , only : numpft
- use pftconMod , only : noveg
- use domainMod , only : ldomain
- use fileutils , only : getfil
- use clm_varctl , only : fsurdat
- use shr_scam_mod, only : shr_scam_getCloseLatLon
- !
- ! !ARGUMENTS:
- type(bounds_type), intent(in) :: bounds
- type(canopystate_type), intent(inout) :: canopystate_inst
- !
- ! !LOCAL VARIABLES:
- type(file_desc_t) :: ncid ! netcdf id
- real(r8), pointer :: annlai(:,:) ! 12 months of monthly lai from input data set
- real(r8), pointer :: mlai(:,:) ! lai read from input files
- real(r8):: closelat,closelon ! single column vars
- integer :: ier ! error code
- integer :: g,k,l,m,n,p ! indices
- integer :: ni,nj,ns ! indices
- integer :: dimid,varid ! input netCDF id's
- integer :: ntim ! number of input data time samples
- integer :: nlon_i ! number of input data longitudes
- integer :: nlat_i ! number of input data latitudes
- integer :: npft_i ! number of input data patch types
- integer :: closelatidx,closelonidx ! single column vars
- logical :: isgrid2d ! true => file is 2d
- character(len=256) :: locfn ! local file name
- character(len=32) :: subname = 'readAnnualVegetation'
- !-----------------------------------------------------------------------
-
- annlai => canopystate_inst%annlai_patch
-
- ! Determine necessary indices
-
- allocate(mlai(bounds%begg:bounds%endg,0:numpft), stat=ier)
- if (ier /= 0) then
- write(iulog,*)subname, 'allocation error '
- call endrun(msg=errMsg(sourcefile, __LINE__))
- end if
-
- if (masterproc) then
- write (iulog,*) 'Attempting to read annual vegetation data .....'
- end if
-
- call getfil(fsurdat, locfn, 0)
- call ncd_pio_openfile (ncid, trim(locfn), 0)
- call ncd_inqfdims (ncid, isgrid2d, ni, nj, ns)
-
- if (ldomain%ns /= ns .or. ldomain%ni /= ni .or. ldomain%nj /= nj) then
- write(iulog,*)trim(subname), 'ldomain and input file do not match dims '
- write(iulog,*)trim(subname), 'ldomain%ni,ni,= ',ldomain%ni,ni
- write(iulog,*)trim(subname), 'ldomain%nj,nj,= ',ldomain%nj,nj
- write(iulog,*)trim(subname), 'ldomain%ns,ns,= ',ldomain%ns,ns
- call endrun(msg=errMsg(sourcefile, __LINE__))
- end if
- call check_dim(ncid, 'lsmpft', numpft+1)
-
- if (single_column) then
- call shr_scam_getCloseLatLon(locfn, scmlat, scmlon, &
- closelat, closelon, closelatidx, closelonidx)
- endif
-
- do k=1,12 !! loop over months and read vegetated data
-
- call ncd_io(ncid=ncid, varname='MONTHLY_LAI', flag='read', data=mlai, &
- dim1name=grlnd, nt=k)
-
- !! only vegetated patches have nonzero values
- !! Assign lai/sai/hgtt/hgtb to the top [maxpatch_pft] patches
- !! as determined in subroutine surfrd
-
- do p = bounds%begp,bounds%endp
- g =patch%gridcell(p)
- if (patch%itype(p) /= noveg) then !! vegetated pft
- do l = 0, numpft
- if (l == patch%itype(p)) then
- annlai(k,p) = mlai(g,l)
- end if
- end do
- else !! non-vegetated pft
- annlai(k,p) = 0._r8
- end if
- end do ! end of loop over patches
-
- enddo ! months loop
-
- call ncd_pio_closefile(ncid)
-
- deallocate(mlai)
-
- endsubroutine readAnnualVegetation
-
- !-----------------------------------------------------------------------
- subroutine readMonthlyVegetation (bounds, &
- fveg, months, canopystate_inst)
- !
- ! !DESCRIPTION:
- ! Read monthly vegetation data for two consec. months.
- !
- ! !USES:
- use clm_varpar , only : numpft
- use pftconMod , only : noveg
- use fileutils , only : getfil
- use spmdMod , only : masterproc, mpicom, MPI_REAL8, MPI_INTEGER
- use shr_scam_mod , only : shr_scam_getCloseLatLon
- use clm_time_manager , only : get_nstep
- use netcdf
- !
- ! !ARGUMENTS:
- type(bounds_type) , intent(in) :: bounds
- character(len=*) , intent(in) :: fveg ! file with monthly vegetation data
- integer , intent(in) :: months(2) ! months to be interpolated (1 to 12)
- type(canopystate_type), intent(inout) :: canopystate_inst
- !
- ! !LOCAL VARIABLES:
- character(len=256) :: locfn ! local file name
- type(file_desc_t) :: ncid ! netcdf id
- integer :: g,n,k,l,m,p,ni,nj,ns ! indices
- integer :: dimid,varid ! input netCDF id's
- integer :: ntim ! number of input data time samples
- integer :: nlon_i ! number of input data longitudes
- integer :: nlat_i ! number of input data latitudes
- integer :: npft_i ! number of input data patch types
- integer :: ier ! error code
- integer :: closelatidx,closelonidx
- real(r8):: closelat,closelon
- logical :: readvar
- real(r8), pointer :: mlai(:,:) ! lai read from input files
- real(r8), pointer :: msai(:,:) ! sai read from input files
- real(r8), pointer :: mhgtt(:,:) ! top vegetation height
- real(r8), pointer :: mhgtb(:,:) ! bottom vegetation height
- character(len=32) :: subname = 'readMonthlyVegetation'
- !-----------------------------------------------------------------------
-
- ! Determine necessary indices
-
- allocate(&
- mlai(bounds%begg:bounds%endg,0:numpft), &
- msai(bounds%begg:bounds%endg,0:numpft), &
- mhgtt(bounds%begg:bounds%endg,0:numpft), &
- mhgtb(bounds%begg:bounds%endg,0:numpft), &
- stat=ier)
- if (ier /= 0) then
- write(iulog,*)subname, 'allocation big error '
- call endrun(msg=errMsg(sourcefile, __LINE__))
- end if
-
- ! ----------------------------------------------------------------------
- ! Open monthly vegetation file
- ! Read data and convert from gridcell to patch data
- ! ----------------------------------------------------------------------
-
- call getfil(fveg, locfn, 0)
- call ncd_pio_openfile (ncid, trim(locfn), 0)
-
- if (single_column) then
- call shr_scam_getCloseLatLon (ncid, scmlat, scmlon, closelat, closelon,&
- closelatidx, closelonidx)
- endif
-
- do k=1,2 !loop over months and read vegetated data
-
- call ncd_io(ncid=ncid, varname='MONTHLY_LAI', flag='read', data=mlai, dim1name=grlnd, &
- nt=months(k), readvar=readvar)
- if (.not. readvar) call endrun(msg=' ERROR: MONTHLY_LAI NOT on fveg file'//errMsg(sourcefile, __LINE__))
-
- call ncd_io(ncid=ncid, varname='MONTHLY_SAI', flag='read', data=msai, dim1name=grlnd, &
- nt=months(k), readvar=readvar)
- if (.not. readvar) call endrun(msg=' ERROR: MONTHLY_SAI NOT on fveg file'//errMsg(sourcefile, __LINE__))
-
- call ncd_io(ncid=ncid, varname='MONTHLY_HEIGHT_TOP', flag='read', data=mhgtt, dim1name=grlnd, &
- nt=months(k), readvar=readvar)
- if (.not. readvar) call endrun(msg=' ERROR: MONTHLY_HEIGHT_TOP NOT on fveg file'//errMsg(sourcefile, __LINE__))
-
- call ncd_io(ncid=ncid, varname='MONTHLY_HEIGHT_BOT', flag='read', data=mhgtb, dim1name=grlnd, &
- nt=months(k), readvar=readvar)
- if (.not. readvar) call endrun(msg=' ERROR: MONTHLY_HEIGHT_TOP NOT on fveg file'//errMsg(sourcefile, __LINE__))
-
- ! Only vegetated patches have nonzero values
- ! Assign lai/sai/hgtt/hgtb to the top [maxpatch_pft] patches
- ! as determined in subroutine surfrd
-
- do p = bounds%begp,bounds%endp
- g =patch%gridcell(p)
- if (patch%itype(p) /= noveg) then ! vegetated pft
- do l = 0, numpft
- if (l == patch%itype(p)) then
- mlai2t(p,k) = mlai(g,l)
- msai2t(p,k) = msai(g,l)
- mhvt2t(p,k) = mhgtt(g,l)
- mhvb2t(p,k) = mhgtb(g,l)
- end if
- end do
- else ! non-vegetated pft
- mlai2t(p,k) = 0._r8
- msai2t(p,k) = 0._r8
- mhvt2t(p,k) = 0._r8
- mhvb2t(p,k) = 0._r8
- end if
- end do ! end of loop over patches
-
- end do ! end of loop over months
-
- call ncd_pio_closefile(ncid)
-
- if (masterproc) then
- k = 2
- write(iulog,*) 'Successfully read monthly vegetation data for'
- write(iulog,*) 'month ', months(k)
- write(iulog,*)
- end if
-
- deallocate(mlai, msai, mhgtt, mhgtb)
-
- do p = bounds%begp,bounds%endp
- canopystate_inst%mlaidiff_patch(p) = mlai2t(p,1)-mlai2t(p,2)
- enddo
-
- end subroutine readMonthlyVegetation
-
-end module SatellitePhenologyMod
diff --git a/src/biogeochem/SpeciesBaseType.F90 b/src/biogeochem/SpeciesBaseType.F90
deleted file mode 100644
index 239ca91f..00000000
--- a/src/biogeochem/SpeciesBaseType.F90
+++ /dev/null
@@ -1,67 +0,0 @@
-module SpeciesBaseType
-
- !-----------------------------------------------------------------------
- ! !DESCRIPTION:
- ! Defines a base class for working with chemical species, such as building history and
- ! restart field names.
- !
- ! !USES:
- !
- implicit none
- private
-
- ! !PUBLIC TYPES:
-
- type, abstract, public :: species_base_type
- contains
- ! Get a history field name for this species
- procedure(hist_fname_interface), public, deferred :: hist_fname
-
- ! Get a restart field name for this species
- procedure(rest_fname_interface), public, deferred :: rest_fname
-
- ! Get the full species name
- procedure(get_species_interface), public, deferred :: get_species
- end type species_base_type
-
- abstract interface
- pure function hist_fname_interface(this, basename, suffix) result(fname)
- ! Get a history field name for this species
- !
- ! basename gives the base name of the history field
- !
- ! suffix, if provided, gives a suffix that appears after all species information
- ! in the field name
- import :: species_base_type
-
- character(len=:) , allocatable :: fname ! function result
- class(species_base_type) , intent(in) :: this
- character(len=*) , intent(in) :: basename
- character(len=*) , optional, intent(in) :: suffix
- end function hist_fname_interface
-
- function rest_fname_interface(this, basename, suffix) result(fname)
- ! Get a restart field name for this species
- !
- ! basename gives the base name of the restart field
- !
- ! suffix, if provided, gives a suffix that appears after all species information
- ! in the field name
- import :: species_base_type
-
- character(len=:) , allocatable :: fname ! function result
- class(species_base_type) , intent(in) :: this
- character(len=*) , intent(in) :: basename
- character(len=*) , optional, intent(in) :: suffix
- end function rest_fname_interface
-
- pure function get_species_interface(this) result(species_name)
- ! Get the full species name
- import :: species_base_type
-
- character(len=:), allocatable :: species_name
- class(species_base_type) , intent(in) :: this
- end function get_species_interface
- end interface
-
-end module SpeciesBaseType
diff --git a/src/biogeochem/SpeciesIsotopeType.F90 b/src/biogeochem/SpeciesIsotopeType.F90
deleted file mode 100644
index b5fb7498..00000000
--- a/src/biogeochem/SpeciesIsotopeType.F90
+++ /dev/null
@@ -1,136 +0,0 @@
-module SpeciesIsotopeType
-
- !-----------------------------------------------------------------------
- ! !DESCRIPTION:
- ! Defines a class for working with chemical species, such as building history and
- ! restart field names.
- !
- ! This version is used for isotopic species
- !
- ! !USES:
- !
- use SpeciesBaseType, only : species_base_type
- use abortutils, only : endrun
- use shr_log_mod, only : errMsg => shr_log_errMsg
- use clm_varctl, only : iulog
-
- implicit none
- save
- private
-
- ! COMPILER_BUG(wjs, 2016-03-16, pgi 15.10) Ideally, we would use allocatable characters
- ! for species_name and isotope_name. However, this causes problems for pgi: it seems
- ! that these allocatable characters randomly get changed. So, for now, using
- ! fixed-length character variables. (It's possible that this was programmer error on my
- ! part, although using allocatable character variables worked with other compilers.)
- !
- ! If species_name and isotope_name were changed back to allocatable-length characters,
- ! then we could remove the error checking in the constructor as well as various 'trim'
- ! statements scattered throughout the code (because this%species_name and
- ! this%isotope_name would already be trimmed).
- integer, parameter :: species_name_maxlen = 8
- integer, parameter :: isotope_name_maxlen = 8
-
- type, extends(species_base_type), public :: species_isotope_type
- private
- character(len=species_name_maxlen) :: species_name ! does not contain the isotope number
- character(len=isotope_name_maxlen) :: isotope_name ! e.g., just the 13 for C13
- contains
- procedure, public :: hist_fname
- procedure, public :: rest_fname
- procedure, public :: get_species
- end type species_isotope_type
-
- interface species_isotope_type
- module procedure constructor
- end interface species_isotope_type
-
- character(len=*), parameter, private :: sourcefile = &
- __FILE__
-
-contains
-
- function constructor(species_name, isotope_name) result(this)
- ! Create a species_isotope_type object
-
- type(species_isotope_type) :: this ! function result
- character(len=*), intent(in) :: species_name ! e.g., 'C' or 'N' - without the isotope number
- character(len=*), intent(in) :: isotope_name ! e.g., '13' for C13
- !-----------------------------------------------------------------------
-
- if (len_trim(species_name) > species_name_maxlen) then
- write(iulog,*) 'species_isotope_type constructor: species_name too long'
- write(iulog,*) trim(species_name) // ' exceeds max length: ', species_name_maxlen
- call endrun(msg='species_isotope_type constructor: species_name too long: '// &
- errMsg(sourcefile, __LINE__))
- end if
- if (len_trim(isotope_name) > isotope_name_maxlen) then
- write(iulog,*) 'species_isotope_type constructor: isotope_name too long'
- write(iulog,*) trim(isotope_name) // ' exceeds max length: ', isotope_name_maxlen
- call endrun(msg='species_isotope_type constructor: isotope_name too long: '// &
- errMsg(sourcefile, __LINE__))
- end if
-
- this%species_name = trim(species_name)
- this%isotope_name = trim(isotope_name)
- end function constructor
-
- pure function hist_fname(this, basename, suffix) result(fname)
- ! Get a history field name for this species
- !
- ! basename gives the base name of the history field
- !
- ! suffix, if provided, gives a suffix that appears after all species information
- ! in the field name
-
- character(len=:), allocatable :: fname ! function result
- class(species_isotope_type) , intent(in) :: this
- character(len=*), intent(in) :: basename
- character(len=*), optional, intent(in) :: suffix
- !-----------------------------------------------------------------------
-
- fname = trim(this%species_name) // trim(this%isotope_name) // '_' // &
- trim(basename) // trim(this%species_name)
- if (present(suffix)) then
- fname = trim(fname) // trim(suffix)
- end if
-
- end function hist_fname
-
- function rest_fname(this, basename, suffix) result(fname)
- ! Get a restart field name for this species
- !
- ! basename gives the base name of the restart field
- !
- ! suffix, if provided, gives a suffix that appears after all species information in
- ! the field name
- use shr_string_mod, only : shr_string_toLower
-
- character(len=:), allocatable :: fname ! function result
- class(species_isotope_type) , intent(in) :: this
- character(len=*), intent(in) :: basename
- character(len=*), optional, intent(in) :: suffix
-
- character(len=:), allocatable :: species_name_lcase
- !-----------------------------------------------------------------------
-
- species_name_lcase = shr_string_toLower(trim(this%species_name))
- fname = trim(basename) // species_name_lcase // '_' // trim(this%isotope_name)
- if (present(suffix)) then
- fname = trim(fname) // trim(suffix)
- end if
-
- end function rest_fname
-
- pure function get_species(this) result(species_name)
- ! Get the full species name (e.g., 'C13')
-
- character(len=:), allocatable :: species_name
- class(species_isotope_type) , intent(in) :: this
- !-----------------------------------------------------------------------
-
- species_name = trim(this%species_name) // trim(this%isotope_name)
-
- end function get_species
-
-end module SpeciesIsotopeType
diff --git a/src/biogeochem/SpeciesNonIsotopeType.F90 b/src/biogeochem/SpeciesNonIsotopeType.F90
deleted file mode 100644
index 0daf6b3f..00000000
--- a/src/biogeochem/SpeciesNonIsotopeType.F90
+++ /dev/null
@@ -1,125 +0,0 @@
-module SpeciesNonIsotopeType
-
- !-----------------------------------------------------------------------
- ! !DESCRIPTION:
- ! Defines a class for working with chemical species, such as building history and
- ! restart field names.
- !
- ! This version is used for non-isotopic species
- !
- ! !USES:
- !
- use SpeciesBaseType, only : species_base_type
- use abortutils, only : endrun
- use shr_log_mod, only : errMsg => shr_log_errMsg
- use clm_varctl, only : iulog
-
- implicit none
- save
- private
-
- ! COMPILER_BUG(wjs, 2016-03-16, pgi 15.10) Ideally, we would use an allocatable
- ! character variable for species_name. However, this causes problems for pgi: it seems
- ! that this allocatable character variable randomly gets changed. So, for now, using a
- ! fixed-length character variable. (It's possible that this was programmer error on my
- ! part, although using allocatable character variables worked with other compilers.)
- !
- ! If species_name was changed back to an allocatable-length character variable, then we
- ! could remove the error checking in the constructor as well as various 'trim'
- ! statements scattered throughout the code (because this%species_name would already be
- ! trimmed).
- integer, parameter :: species_name_maxlen = 8
-
- type, extends(species_base_type), public :: species_non_isotope_type
- private
- character(len=species_name_maxlen) :: species_name
- contains
- procedure, public :: hist_fname
- procedure, public :: rest_fname
- procedure, public :: get_species
- end type species_non_isotope_type
-
- interface species_non_isotope_type
- module procedure constructor
- end interface species_non_isotope_type
-
- character(len=*), parameter, private :: sourcefile = &
- __FILE__
-
-contains
-
- function constructor(species_name) result(this)
- ! Create a species_non_isotope_type object
-
- type(species_non_isotope_type) :: this ! function result
- character(len=*), intent(in) :: species_name ! e.g., 'C' or 'N'
- !-----------------------------------------------------------------------
-
- if (len_trim(species_name) > species_name_maxlen) then
- write(iulog,*) 'species_isotope_type constructor: species_name too long'
- write(iulog,*) trim(species_name) // ' exceeds max length: ', species_name_maxlen
- call endrun(msg='species_isotope_type constructor: species_name too long: '// &
- errMsg(sourcefile, __LINE__))
- end if
-
- this%species_name = trim(species_name)
- end function constructor
-
- pure function hist_fname(this, basename, suffix) result(fname)
- ! Get a history field name for this species
- !
- ! basename gives the base name of the history field
- !
- ! suffix, if provided, gives a suffix that appears after all species information
- ! in the field name
-
- character(len=:), allocatable :: fname ! function result
- class(species_non_isotope_type) , intent(in) :: this
- character(len=*), intent(in) :: basename
- character(len=*), optional, intent(in) :: suffix
- !-----------------------------------------------------------------------
-
- fname = trim(basename) // trim(this%species_name)
- if (present(suffix)) then
- fname = trim(fname) // trim(suffix)
- end if
-
- end function hist_fname
-
- function rest_fname(this, basename, suffix) result(fname)
- ! Get a restart field name for this species
- !
- ! basename gives the base name of the restart field
- !
- ! suffix, if provided, gives a suffix that appears after all species information in
- ! the field name
- use shr_string_mod, only : shr_string_toLower
-
- character(len=:), allocatable :: fname ! function result
- class(species_non_isotope_type) , intent(in) :: this
- character(len=*), intent(in) :: basename
- character(len=*), optional, intent(in) :: suffix
-
- character(len=:), allocatable :: species_name_lcase
- !-----------------------------------------------------------------------
-
- species_name_lcase = shr_string_toLower(trim(this%species_name))
- fname = trim(basename) // trim(species_name_lcase)
- if (present(suffix)) then
- fname = trim(fname) // trim(suffix)
- end if
-
- end function rest_fname
-
- pure function get_species(this) result(species_name)
- ! Get the full species name
-
- character(len=:), allocatable :: species_name
- class(species_non_isotope_type) , intent(in) :: this
- !-----------------------------------------------------------------------
-
- species_name = trim(this%species_name)
-
- end function get_species
-
-end module SpeciesNonIsotopeType
diff --git a/src/biogeochem/VOCEmissionMod.F90 b/src/biogeochem/VOCEmissionMod.F90
deleted file mode 100644
index 1c9a0e58..00000000
--- a/src/biogeochem/VOCEmissionMod.F90
+++ /dev/null
@@ -1,26 +0,0 @@
-module VOCEmissionMod
-
- !-----------------------------------------------------------------------
- ! !DESCRIPTION:
- ! Volatile organic compound emission
- !
- ! !USES:
- use shr_kind_mod , only : r8 => shr_kind_r8
- use shr_log_mod , only : errMsg => shr_log_errMsg
- !
- implicit none
- private
- !
- ! !PUBLIC MEMBER FUNCTIONS:
- !
- ! !PUBLIC TYPES:
- type, public :: vocemis_type
- end type vocemis_type
- !
- character(len=*), parameter, private :: sourcefile = &
- __FILE__
- !------------------------------------------------------------------------
-
-end module VOCEmissionMod
-
-
diff --git a/src/biogeochem/ch4Mod.F90 b/src/biogeochem/ch4Mod.F90
deleted file mode 100644
index 81978bf6..00000000
--- a/src/biogeochem/ch4Mod.F90
+++ /dev/null
@@ -1,123 +0,0 @@
-module ch4Mod
-
-#include "shr_assert.h"
-
- !-----------------------------------------------------------------------
- ! !DESCRIPTION:
- ! Module holding routines to calculate methane fluxes
- ! The driver averages up to gridcell, weighting by finundated, and checks for balance errors.
- ! Sources, sinks, "competition" for CH4 & O2, & transport are resolved in ch4_tran.
- !
- ! !USES:
- use shr_kind_mod , only : r8 => shr_kind_r8
- use shr_infnan_mod , only : nan => shr_infnan_nan, assignment(=), shr_infnan_isnan
- use shr_log_mod , only : errMsg => shr_log_errMsg
- use abortutils , only : endrun
- !
- implicit none
- private
-
- ! Non-tunable constants
- real(r8) :: rgasm ! J/mol.K; rgas / 1000; will be set below
- real(r8), parameter :: rgasLatm = 0.0821_r8 ! L.atm/mol.K
-
- type, public :: ch4_type
- real(r8), pointer, private :: ch4_prod_depth_sat_col (:,:) ! col CH4 production rate from methanotrophs (mol/m3/s) (nlevsoi)
- real(r8), pointer, private :: ch4_prod_depth_unsat_col (:,:) ! col CH4 production rate from methanotrophs (mol/m3/s) (nlevsoi)
- real(r8), pointer, private :: ch4_prod_depth_lake_col (:,:) ! col CH4 production rate from methanotrophs (mol/m3/s) (nlevsoi)
- real(r8), pointer, private :: ch4_oxid_depth_sat_col (:,:) ! col CH4 consumption rate via oxidation in each soil layer (mol/m3/s) (nlevsoi)
- real(r8), pointer, private :: ch4_oxid_depth_unsat_col (:,:) ! col CH4 consumption rate via oxidation in each soil layer (mol/m3/s) (nlevsoi)
- real(r8), pointer, private :: ch4_oxid_depth_lake_col (:,:) ! col CH4 consumption rate via oxidation in each soil layer (mol/m3/s) (nlevsoi)
- real(r8), pointer, private :: ch4_aere_depth_sat_col (:,:) ! col CH4 loss rate via aerenchyma in each soil layer (mol/m3/s) (nlevsoi)
- real(r8), pointer, private :: ch4_aere_depth_unsat_col (:,:) ! col CH4 loss rate via aerenchyma in each soil layer (mol/m3/s) (nlevsoi)
- real(r8), pointer, private :: ch4_tran_depth_sat_col (:,:) ! col CH4 loss rate via transpiration in each soil layer (mol/m3/s) (nlevsoi)
- real(r8), pointer, private :: ch4_tran_depth_unsat_col (:,:) ! col CH4 loss rate via transpiration in each soil layer (mol/m3/s) (nlevsoi)
- real(r8), pointer, private :: ch4_ebul_depth_sat_col (:,:) ! col CH4 loss rate via ebullition in each soil layer (mol/m3/s) (nlevsoi)
- real(r8), pointer, private :: ch4_ebul_depth_unsat_col (:,:) ! col CH4 loss rate via ebullition in each soil layer (mol/m3/s) (nlevsoi)
- real(r8), pointer, private :: ch4_ebul_total_sat_col (:) ! col Total col CH4 ebullition (mol/m2/s)
- real(r8), pointer, private :: ch4_ebul_total_unsat_col (:) ! col Total col CH4 ebullition (mol/m2/s)
- real(r8), pointer, private :: ch4_surf_aere_sat_col (:) ! col CH4 aerenchyma flux to atmosphere (after oxidation) (mol/m2/s)
- real(r8), pointer, private :: ch4_surf_aere_unsat_col (:) ! col CH4 aerenchyma flux to atmosphere (after oxidation) (mol/m2/s)
- real(r8), pointer, private :: ch4_surf_ebul_sat_col (:) ! col CH4 ebullition flux to atmosphere (after oxidation) (mol/m2/s)
- real(r8), pointer, private :: ch4_surf_ebul_unsat_col (:) ! col CH4 ebullition flux to atmosphere (after oxidation) (mol/m2/s)
- real(r8), pointer, private :: ch4_surf_ebul_lake_col (:) ! col CH4 ebullition flux to atmosphere (after oxidation) (mol/m2/s)
- real(r8), pointer, private :: co2_aere_depth_sat_col (:,:) ! col CO2 loss rate via aerenchyma in each soil layer (mol/m3/s) (nlevsoi)
- real(r8), pointer, private :: co2_aere_depth_unsat_col (:,:) ! col CO2 loss rate via aerenchyma in each soil layer (mol/m3/s) (nlevsoi)
- real(r8), pointer, private :: o2_oxid_depth_sat_col (:,:) ! col O2 consumption rate via oxidation in each soil layer (mol/m3/s) (nlevsoi)
- real(r8), pointer, private :: o2_oxid_depth_unsat_col (:,:) ! col O2 consumption rate via oxidation in each soil layer (mol/m3/s) (nlevsoi)
- real(r8), pointer, private :: o2_aere_depth_sat_col (:,:) ! col O2 gain rate via aerenchyma in each soil layer (mol/m3/s) (nlevsoi)
- real(r8), pointer, private :: o2_aere_depth_unsat_col (:,:) ! col O2 gain rate via aerenchyma in each soil layer (mol/m3/s) (nlevsoi)
- real(r8), pointer, private :: co2_decomp_depth_sat_col (:,:) ! col CO2 production during decomposition in each soil layer (nlevsoi) (mol/m3/s)
- real(r8), pointer, private :: co2_decomp_depth_unsat_col (:,:) ! col CO2 production during decomposition in each soil layer (nlevsoi) (mol/m3/s)
- real(r8), pointer, private :: co2_oxid_depth_sat_col (:,:) ! col CO2 production rate via oxidation in each soil layer (mol/m3/s) (nlevsoi)
- real(r8), pointer, private :: co2_oxid_depth_unsat_col (:,:) ! col CO2 production rate via oxidation in each soil layer (mol/m3/s) (nlevsoi)
- real(r8), pointer, private :: conc_o2_lake_col (:,:) ! col O2 conc in each soil layer (mol/m3) (nlevsoi)
- real(r8), pointer, private :: conc_ch4_sat_col (:,:) ! col CH4 conc in each soil layer (mol/m3) (nlevsoi)
- real(r8), pointer, private :: conc_ch4_unsat_col (:,:) ! col CH4 conc in each soil layer (mol/m3) (nlevsoi)
- real(r8), pointer, private :: conc_ch4_lake_col (:,:) ! col CH4 conc in each soil layer (mol/m3) (nlevsoi)
- real(r8), pointer, private :: ch4_surf_diff_sat_col (:) ! col CH4 surface flux (mol/m2/s)
- real(r8), pointer, private :: ch4_surf_diff_unsat_col (:) ! col CH4 surface flux (mol/m2/s)
- real(r8), pointer, private :: ch4_surf_diff_lake_col (:) ! col CH4 surface flux (mol/m2/s)
- real(r8), pointer, private :: ch4_dfsat_flux_col (:) ! col CH4 flux to atm due to decreasing fsat (kg C/m^2/s) [+]
-
- real(r8), pointer, private :: zwt_ch4_unsat_col (:) ! col depth of water table for unsaturated fraction (m)
- real(r8), pointer, private :: lake_soilc_col (:,:) ! col total soil organic matter found in level (g C / m^3) (nlevsoi)
- real(r8), pointer, private :: totcolch4_col (:) ! col total methane found in soil col (g C / m^2)
- real(r8), pointer, private :: totcolch4_bef_col (:) ! col total methane found in soil col, start of timestep (g C / m^2)
- real(r8), pointer, private :: annsum_counter_col (:) ! col seconds since last annual accumulator turnover
- real(r8), pointer, private :: tempavg_somhr_col (:) ! col temporary average SOM heterotrophic resp. (gC/m2/s)
- real(r8), pointer, private :: annavg_somhr_col (:) ! col annual average SOM heterotrophic resp. (gC/m2/s)
- real(r8), pointer, private :: tempavg_finrw_col (:) ! col respiration-weighted annual average of finundated
- real(r8), pointer, private :: annavg_finrw_col (:) ! col respiration-weighted annual average of finundated
- real(r8), pointer, private :: sif_col (:) ! col (unitless) ratio applied to sat. prod. to account for seasonal inundation
- real(r8), pointer, private :: ch4stress_unsat_col (:,:) ! col Ratio of methane available to the total per-timestep methane sinks (nlevsoi)
- real(r8), pointer, private :: ch4stress_sat_col (:,:) ! col Ratio of methane available to the total per-timestep methane sinks (nlevsoi)
- real(r8), pointer, private :: qflx_surf_lag_col (:) ! col time-lagged surface runoff (mm H2O /s)
- real(r8), pointer, private :: finundated_lag_col (:) ! col time-lagged fractional inundated area
- real(r8), pointer, private :: layer_sat_lag_col (:,:) ! col Lagged saturation status of soil layer in the unsaturated zone (1 = sat)
- real(r8), pointer, private :: zwt0_col (:) ! col coefficient for determining finundated (m)
- real(r8), pointer, private :: f0_col (:) ! col maximum inundated fraction for a gridcell (for methane code)
- real(r8), pointer, private :: p3_col (:) ! col coefficient for determining finundated (m)
- real(r8), pointer, private :: pH_col (:) ! col pH values for methane production
- !
- real(r8), pointer, private :: dyn_ch4bal_adjustments_col (:) ! adjustments to each column made in this timestep via dynamic column area adjustments (only makes sense at the column-level: meaningless if averaged to the gridcell-level) (g C / m^2)
- !
- real(r8), pointer, private :: c_atm_grc (:,:) ! grc atmospheric conc of CH4, O2, CO2 (mol/m3)
- real(r8), pointer, private :: ch4co2f_grc (:) ! grc CO2 production from CH4 oxidation (g C/m**2/s)
- real(r8), pointer, private :: ch4prodg_grc (:) ! grc average CH4 production (g C/m^2/s)
- !
- ! for aerenchyma calculations
- real(r8), pointer, private :: annavg_agnpp_patch (:) ! patch (gC/m2/s) annual average aboveground NPP
- real(r8), pointer, private :: annavg_bgnpp_patch (:) ! patch (gC/m2/s) annual average belowground NPP
- real(r8), pointer, private :: tempavg_agnpp_patch (:) ! patch (gC/m2/s) temp. average aboveground NPP
- real(r8), pointer, private :: tempavg_bgnpp_patch (:) ! patch (gC/m2/s) temp. average belowground NPP
- !
- ! The following variable reports whether this is the first timestep that includes
- ! ch4. It is true in the first timestep of the run, and remains true until the
- ! methane code is first run - at which point it becomes false, and remains
- ! false. This could be a scalar, but scalars cause problems with threading, so we use
- ! a column-level array (column-level for convenience, because it is referenced in
- ! column-level loops).
- logical , pointer, private :: ch4_first_time_col (:) ! col whether this is the first time step that includes ch4
- !
- real(r8), pointer, public :: finundated_col (:) ! col fractional inundated area (excluding dedicated wetland cols)
- real(r8), pointer, public :: finundated_pre_snow_col (:) ! col fractional inundated area (excluding dedicated wetland cols) before snow
- real(r8), pointer, public :: o2stress_unsat_col (:,:) ! col Ratio of oxygen available to that demanded by roots, aerobes, & methanotrophs (nlevsoi)
- real(r8), pointer, public :: o2stress_sat_col (:,:) ! col Ratio of oxygen available to that demanded by roots, aerobes, & methanotrophs (nlevsoi)
- real(r8), pointer, public :: conc_o2_sat_col (:,:) ! col O2 conc in each soil layer (mol/m3) (nlevsoi)
- real(r8), pointer, public :: conc_o2_unsat_col (:,:) ! col O2 conc in each soil layer (mol/m3) (nlevsoi)
- real(r8), pointer, public :: o2_decomp_depth_sat_col (:,:) ! col O2 consumption during decomposition in each soil layer (nlevsoi) (mol/m3/s)
- real(r8), pointer, public :: o2_decomp_depth_unsat_col (:,:) ! col O2 consumption during decomposition in each soil layer (nlevsoi) (mol/m3/s)
- real(r8), pointer, public :: ch4_surf_flux_tot_col (:) ! col CH4 surface flux (to atm) (kg C/m**2/s)
-
- real(r8), pointer, public :: grnd_ch4_cond_patch (:) ! patch tracer conductance for boundary layer [m/s]
- real(r8), pointer, public :: grnd_ch4_cond_col (:) ! col tracer conductance for boundary layer [m/s]
-
- end type ch4_type
-
- character(len=*), parameter, private :: sourcefile = &
- __FILE__
- !------------------------------------------------------------------------
-
-end module ch4Mod
-
diff --git a/src/biogeophys/ActiveLayerMod.F90 b/src/biogeophys/ActiveLayerMod.F90
deleted file mode 100644
index a1b87182..00000000
--- a/src/biogeophys/ActiveLayerMod.F90
+++ /dev/null
@@ -1,155 +0,0 @@
-module ActiveLayerMod
-
- !-----------------------------------------------------------------------
- ! !DESCRIPTION:
- ! Module holding routines for calculation of active layer dynamics
- !
- ! !USES:
- use shr_kind_mod , only : r8 => shr_kind_r8
- use shr_const_mod , only : SHR_CONST_TKFRZ
- use clm_varctl , only : iulog
- use TemperatureType , only : temperature_type
- use CanopyStateType , only : canopystate_type
- use GridcellType , only : grc
- use ColumnType , only : col
- !
- implicit none
- save
- private
- !
- ! !PUBLIC MEMBER FUNCTIONS:
- public:: alt_calc
- !-----------------------------------------------------------------------
-
-contains
-
- !-----------------------------------------------------------------------
- subroutine alt_calc(num_soilc, filter_soilc, &
- temperature_inst, canopystate_inst)
- !
- ! !DESCRIPTION:
- ! define active layer thickness similarly to frost_table, except set as deepest thawed layer and define on nlevgrnd
- ! also update annual maxima, and keep track of prior year for rooting memory
- !
- ! BUG(wjs, 2014-12-15, bugz 2107) Because of this routine's placement in the driver
- ! sequence (it is called very early in each timestep, before weights are adjusted and
- ! filters are updated), it may be necessary for this routine to compute values over
- ! inactive as well as active points (since some inactive points may soon become
- ! active) - so that's what is done now. Currently, it seems to be okay to do this,
- ! because the variables computed here seem to only depend on quantities that are valid
- ! over inactive as well as active points.
- !
- ! !USES:
- use shr_const_mod , only : SHR_CONST_TKFRZ
- use clm_varpar , only : nlevgrnd
- use clm_time_manager , only : get_curr_date, get_step_size
- use clm_varctl , only : iulog
- use clm_varcon , only : zsoi
- !
- ! !ARGUMENTS:
- integer , intent(in) :: num_soilc ! number of soil columns in filter
- integer , intent(in) :: filter_soilc(:) ! filter for soil columns
- type(temperature_type) , intent(in) :: temperature_inst
- type(canopystate_type) , intent(inout) :: canopystate_inst
- !
- ! !LOCAL VARIABLES:
- integer :: c, j, fc, g ! counters
- integer :: alt_ind ! index of base of activel layer
- integer :: year ! year (0, ...) for nstep+1
- integer :: mon ! month (1, ..., 12) for nstep+1
- integer :: day ! day of month (1, ..., 31) for nstep+1
- integer :: sec ! seconds into current date for nstep+1
- integer :: dtime ! time step length in seconds
- integer :: k_frz ! index of first nonfrozen soil layer
- logical :: found_thawlayer ! used to break loop when first unfrozen layer reached
- real(r8) :: t1, t2, z1, z2 ! temporary variables
- !-----------------------------------------------------------------------
-
- associate( &
- t_soisno => temperature_inst%t_soisno_col , & ! Input: [real(r8) (:,:) ] soil temperature (Kelvin) (-nlevsno+1:nlevgrnd)
-
- alt => canopystate_inst%alt_col , & ! Output: [real(r8) (:) ] current depth of thaw
- altmax => canopystate_inst%altmax_col , & ! Output: [real(r8) (:) ] maximum annual depth of thaw
- altmax_lastyear => canopystate_inst%altmax_lastyear_col , & ! Output: [real(r8) (:) ] prior year maximum annual depth of thaw
- alt_indx => canopystate_inst%alt_indx_col , & ! Output: [integer (:) ] current depth of thaw
- altmax_indx => canopystate_inst%altmax_indx_col , & ! Output: [integer (:) ] maximum annual depth of thaw
- altmax_lastyear_indx => canopystate_inst%altmax_lastyear_indx_col & ! Output: [integer (:) ] prior year maximum annual depth of thaw
- )
-
- ! on a set annual timestep, update annual maxima
- ! make this 1 January for NH columns, 1 July for SH columns
- call get_curr_date(year, mon, day, sec)
- dtime = get_step_size()
- if ( (mon .eq. 1) .and. (day .eq. 1) .and. ( sec / dtime .eq. 1) ) then
- do fc = 1,num_soilc
- c = filter_soilc(fc)
- g = col%gridcell(c)
- if ( grc%lat(g) > 0. ) then
- altmax_lastyear(c) = altmax(c)
- altmax_lastyear_indx(c) = altmax_indx(c)
- altmax(c) = 0.
- altmax_indx(c) = 0
- endif
- end do
- endif
- if ( (mon .eq. 7) .and. (day .eq. 1) .and. ( sec / dtime .eq. 1) ) then
- do fc = 1,num_soilc
- c = filter_soilc(fc)
- g = col%gridcell(c)
- if ( grc%lat(g) <= 0. ) then
- altmax_lastyear(c) = altmax(c)
- altmax_lastyear_indx(c) = altmax_indx(c)
- altmax(c) = 0.
- altmax_indx(c) = 0
- endif
- end do
- endif
-
- do fc = 1,num_soilc
- c = filter_soilc(fc)
-
- ! calculate alt for a given timestep
- ! start from base of soil and search upwards for first thawed layer.
- ! note that this will put talik in with active layer
- ! a different way of doing this could be to keep track of how long a given layer has ben frozen for, and define ALT as the first layer that has been frozen for less than 2 years.
- if (t_soisno(c,nlevgrnd) > SHR_CONST_TKFRZ ) then
- alt(c) = zsoi(nlevgrnd)
- alt_indx(c) = nlevgrnd
- else
- k_frz=0
- found_thawlayer = .false.
- do j=nlevgrnd-1,1,-1
- if ( ( t_soisno(c,j) > SHR_CONST_TKFRZ ) .and. .not. found_thawlayer ) then
- k_frz=j
- found_thawlayer = .true.
- endif
- end do
-
- if ( k_frz > 0 ) then
- ! define active layer as the depth at which the linearly interpolated temperature line intersects with zero
- z1 = zsoi(k_frz)
- z2 = zsoi(k_frz+1)
- t1 = t_soisno(c,k_frz)
- t2 = t_soisno(c,k_frz+1)
- alt(c) = z1 + (t1-SHR_CONST_TKFRZ)*(z2-z1)/(t1-t2)
- alt_indx(c) = k_frz
- else
- alt(c)=0._r8
- alt_indx(c) = 0
- endif
- endif
-
-
- ! if appropriate, update maximum annual active layer thickness
- if (alt(c) > altmax(c)) then
- altmax(c) = alt(c)
- altmax_indx(c) = alt_indx(c)
- endif
-
- end do
-
- end associate
-
- end subroutine alt_calc
-
-end module ActiveLayerMod
diff --git a/src/biogeophys/AerosolMod.F90 b/src/biogeophys/AerosolMod.F90
deleted file mode 100644
index 06111cd1..00000000
--- a/src/biogeophys/AerosolMod.F90
+++ /dev/null
@@ -1,29 +0,0 @@
-module AerosolMod
-
-#include "shr_assert.h"
-
- !-----------------------------------------------------------------------
- use shr_kind_mod , only : r8 => shr_kind_r8
- use shr_log_mod , only : errMsg => shr_log_errMsg
- use shr_infnan_mod , only : nan => shr_infnan_nan, assignment(=)
- use abortutils , only : endrun
- !
- ! !PUBLIC TYPES:
- implicit none
- private
- !
- ! !PUBLIC MEMBER FUNCTIONS:
- !
- ! !PUBLIC DATA MEMBERS:
- real(r8), public, parameter :: snw_rds_min = 54.526_r8 ! minimum allowed snow effective radius (also cold "fresh snow" value) [microns]
- real(r8), public :: fresh_snw_rds_max = 204.526_r8 ! maximum warm fresh snow effective radius [microns]
- !
- type, public :: aerosol_type
-
- end type aerosol_type
-
- character(len=*), parameter, private :: sourcefile = &
- __FILE__
- !-----------------------------------------------------------------------
-
-end module AerosolMod
diff --git a/src/biogeophys/BandDiagonalMod.F90 b/src/biogeophys/BandDiagonalMod.F90
deleted file mode 100644
index 5065ea59..00000000
--- a/src/biogeophys/BandDiagonalMod.F90
+++ /dev/null
@@ -1,224 +0,0 @@
-module BandDiagonalMod
-
-#include "shr_assert.h"
-
- !-----------------------------------------------------------------------
- ! !DESCRIPTION:
- ! Band Diagonal matrix solution
- !
- ! !USES:
- use shr_log_mod , only : errMsg => shr_log_errMsg
- use decompMod , only : bounds_type
- use abortutils , only : endrun
- use shr_kind_mod , only : r8 => shr_kind_r8
- use clm_varctl , only : iulog
- !
- ! !PUBLIC TYPES:
- implicit none
- save
- !
- ! !PUBLIC MEMBER FUNCTIONS:
- public :: BandDiagonal
-
- character(len=*), parameter, private :: sourcefile = &
- __FILE__
- !-----------------------------------------------------------------------
-
-contains
-
- !-----------------------------------------------------------------------
- subroutine BandDiagonal(bounds, lbj, ubj, jtop, jbot, numf, filter, nband, b, r, u)
- !
- ! !DESCRIPTION:
- ! Tridiagonal matrix solution
- !
- ! !ARGUMENTS:
- implicit none
- type(bounds_type), intent(in) :: bounds
- integer , intent(in) :: lbj, ubj ! lbinning and ubing level indices
- integer , intent(in) :: jtop( bounds%begc: ) ! top level for each column [col]
- integer , intent(in) :: jbot( bounds%begc: ) ! bottom level for each column [col]
- integer , intent(in) :: numf ! filter dimension
- integer , intent(in) :: nband ! band width
- integer , intent(in) :: filter(:) ! filter
- real(r8), intent(in) :: b( bounds%begc: , 1: , lbj: ) ! compact band matrix [col, nband, j]
- real(r8), intent(in) :: r( bounds%begc: , lbj: ) ! "r" rhs of linear system [col, j]
- real(r8), intent(inout) :: u( bounds%begc: , lbj: ) ! solution [col, j]
- !
- ! ! LOCAL VARIABLES:
- integer :: j,ci,fc,info,m,n !indices
- integer :: kl,ku !number of sub/super diagonals
- integer, allocatable :: ipiv(:) !temporary
- real(r8),allocatable :: ab(:,:),temp(:,:) !compact storage array
- real(r8),allocatable :: result(:)
-
- !-----------------------------------------------------------------------
-
- ! Enforce expected array sizes
- SHR_ASSERT_ALL((ubound(jtop) == (/bounds%endc/)), errMsg(sourcefile, __LINE__))
- SHR_ASSERT_ALL((ubound(jbot) == (/bounds%endc/)), errMsg(sourcefile, __LINE__))
- SHR_ASSERT_ALL((ubound(b) == (/bounds%endc, nband, ubj/)), errMsg(sourcefile, __LINE__))
- SHR_ASSERT_ALL((ubound(r) == (/bounds%endc, ubj/)), errMsg(sourcefile, __LINE__))
- SHR_ASSERT_ALL((ubound(u) == (/bounds%endc, ubj/)), errMsg(sourcefile, __LINE__))
-
-
-!!$ SUBROUTINE SGBSV( N, KL, KU, NRHS, AB, LDAB, IPIV, B, LDB, INFO )
-!!$*
-!!$* -- LAPACK driver routine (version 3.1) --
-!!$* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-!!$* November 2006
-!!$*
-!!$* .. Scalar Arguments ..
-!!$ INTEGER INFO, KL, KU, LDAB, LDB, N, NRHS
-!!$* ..
-!!$* .. Array Arguments ..
-!!$ INTEGER IPIV( * )
-!!$ REAL AB( LDAB, * ), B( LDB, * )
-!!$* ..
-!!$*
-!!$* Purpose
-!!$* =======
-!!$*
-!!$* SGBSV computes the solution to a real system of linear equations
-!!$* A * X = B, where A is a band matrix of order N with KL subdiagonals
-!!$* and KU superdiagonals, and X and B are N-by-NRHS matrices.
-!!$*
-!!$* The LU decomposition with partial pivoting and row interchanges is
-!!$* used to factor A as A = L * U, where L is a product of permutation
-!!$* and unit lower triangular matrices with KL subdiagonals, and U is
-!!$* upper triangular with KL+KU superdiagonals. The factored form of A
-!!$* is then used to solve the system of equations A * X = B.
-!!$*
-!!$* Arguments
-!!$* =========
-!!$*
-!!$* N (input) INTEGER
-!!$* The number of linear equations, i.e., the order of the
-!!$* matrix A. N >= 0.
-!!$*
-!!$* KL (input) INTEGER
-!!$* The number of subdiagonals within the band of A. KL >= 0.
-!!$*
-!!$* KU (input) INTEGER
-!!$* The number of superdiagonals within the band of A. KU >= 0.
-!!$*
-!!$* NRHS (input) INTEGER
-!!$* The number of right hand sides, i.e., the number of columns
-!!$* of the matrix B. NRHS >= 0.
-!!$*
-!!$* AB (input/output) REAL array, dimension (LDAB,N)
-!!$* On entry, the matrix A in band storage, in rows KL+1 to
-!!$* 2*KL+KU+1; rows 1 to KL of the array need not be set.
-!!$* The j-th column of A is stored in the j-th column of the
-!!$* array AB as follows:
-!!$* AB(KL+KU+1+i-j,j) = A(i,j) for max(1,j-KU)<=i<=min(N,j+KL)
-!!$* On exit, details of the factorization: U is stored as an
-!!$* upper triangular band matrix with KL+KU superdiagonals in
-!!$* rows 1 to KL+KU+1, and the multipliers used during the
-!!$* factorization are stored in rows KL+KU+2 to 2*KL+KU+1.
-!!$* See below for further details.
-!!$*
-!!$* LDAB (input) INTEGER
-!!$* The leading dimension of the array AB. LDAB >= 2*KL+KU+1.
-!!$*
-!!$* IPIV (output) INTEGER array, dimension (N)
-!!$* The pivot indices that define the permutation matrix P;
-!!$* row i of the matrix was interchanged with row IPIV(i).
-!!$*
-!!$* B (input/output) REAL array, dimension (LDB,NRHS)
-!!$* On entry, the N-by-NRHS right hand side matrix B.
-!!$* On exit, if INFO = 0, the N-by-NRHS solution matrix X.
-!!$*
-!!$* LDB (input) INTEGER
-!!$* The leading dimension of the array B. LDB >= max(1,N).
-!!$*
-!!$* INFO (output) INTEGER
-!!$* = 0: successful exit
-!!$* < 0: if INFO = -i, the i-th argument had an illegal value
-!!$* > 0: if INFO = i, U(i,i) is exactly zero. The factorization
-!!$* has been completed, but the factor U is exactly
-!!$* singular, and the solution has not been computed.
-!!$*
-!!$* Further Details
-!!$* ===============
-!!$*
-!!$* The band storage scheme is illustrated by the following example, when
-!!$* M = N = 6, KL = 2, KU = 1:
-!!$*
-!!$* On entry: On exit:
-!!$*
-!!$* * * * + + + * * * u14 u25 u36
-!!$* * * + + + + * * u13 u24 u35 u46
-!!$* * a12 a23 a34 a45 a56 * u12 u23 u34 u45 u56
-!!$* a11 a22 a33 a44 a55 a66 u11 u22 u33 u44 u55 u66
-!!$* a21 a32 a43 a54 a65 * m21 m32 m43 m54 m65 *
-!!$* a31 a42 a53 a64 * * m31 m42 m53 m64 * *
-!!$*
-!!$* Array elements marked * are not used by the routine; elements marked
-!!$* + need not be set on entry, but are required by the routine to store
-!!$* elements of U because of fill-in resulting from the row interchanges.
-
-
-!Set up input matrix AB
-!An m-by-n band matrix with kl subdiagonals and ku superdiagonals
-!may be stored compactly in a two-dimensional array with
-!kl+ku+1 rows and n columns
-!AB(KL+KU+1+i-j,j) = A(i,j)
-
- do fc = 1,numf
- ci = filter(fc)
-
- kl=(nband-1)/2
- ku=kl
-! m is the number of rows required for storage space by dgbsv
- m=2*kl+ku+1
-! n is the number of levels (snow/soil)
-!scs: replace ubj with jbot
- n=jbot(ci)-jtop(ci)+1
-
- allocate(ab(m,n))
- ab=0.0
-
- ab(kl+ku-1,3:n)=b(ci,1,jtop(ci):jbot(ci)-2) ! 2nd superdiagonal
- ab(kl+ku+0,2:n)=b(ci,2,jtop(ci):jbot(ci)-1) ! 1st superdiagonal
- ab(kl+ku+1,1:n)=b(ci,3,jtop(ci):jbot(ci)) ! diagonal
- ab(kl+ku+2,1:n-1)=b(ci,4,jtop(ci)+1:jbot(ci)) ! 1st subdiagonal
- ab(kl+ku+3,1:n-2)=b(ci,5,jtop(ci)+2:jbot(ci)) ! 2nd subdiagonal
-
- allocate(temp(m,n))
- temp=ab
-
- allocate(ipiv(n))
- allocate(result(n))
-
-! on input result is rhs, on output result is solution vector
- result(:)=r(ci,jtop(ci):jbot(ci))
-
-! DGBSV( N, KL, KU, NRHS, AB, LDAB, IPIV, B, LDB, INFO )
- call dgbsv( n, kl, ku, 1, ab, m, ipiv, result, n, info )
- u(ci,jtop(ci):jbot(ci))=result(:)
-
- if(info /= 0) then
- write(iulog,*)'index: ', ci
- write(iulog,*)'n,kl,ku,m ',n,kl,ku,m
- write(iulog,*)'dgbsv info: ',ci,info
-
- write(iulog,*) ''
- write(iulog,*) 'ab matrix'
- do j=1,n
- ! write(iulog,'(i2,7f18.7)') j,temp(:,j)
- write(iulog,'(i2,5f18.7)') j,temp(3:7,j)
- enddo
- write(iulog,*) ''
- call endrun( 'BandDiagonal ERROR: dgbsv returned error code' )
- endif
- deallocate(temp)
-
- deallocate(ab)
- deallocate(ipiv)
- deallocate(result)
- end do
-
- end subroutine BandDiagonal
-
-end module BandDiagonalMod
diff --git a/src/biogeophys/CanopyStateType.F90 b/src/biogeophys/CanopyStateType.F90
deleted file mode 100644
index beef9527..00000000
--- a/src/biogeophys/CanopyStateType.F90
+++ /dev/null
@@ -1,640 +0,0 @@
-module CanopyStateType
-
- !------------------------------------------------------------------------------
- ! !USES:
- use shr_kind_mod , only : r8 => shr_kind_r8
- use shr_infnan_mod , only : nan => shr_infnan_nan, shr_infnan_isnan, assignment(=)
- use shr_log_mod , only : errMsg => shr_log_errMsg
- use abortutils , only : endrun
- use decompMod , only : bounds_type
- use landunit_varcon , only : istsoil, istcrop
- use clm_varpar , only : nlevcan, nvegwcs
- use clm_varcon , only : spval
- use clm_varctl , only : iulog, use_cn, use_fates, use_hydrstress
- use LandunitType , only : lun
- use ColumnType , only : col
- use PatchType , only : patch
- !
- implicit none
- save
- private
- !
- ! !PUBLIC TYPES:
- type, public :: CanopyState_type
-
- integer , pointer :: frac_veg_nosno_patch (:) ! patch fraction of vegetation not covered by snow (0 OR 1) [-]
- integer , pointer :: frac_veg_nosno_alb_patch (:) ! patch fraction of vegetation not covered by snow (0 OR 1) [-]
-
- real(r8) , pointer :: tlai_patch (:) ! patch canopy one-sided leaf area index, no burying by snow
- real(r8) , pointer :: tsai_patch (:) ! patch canopy one-sided stem area index, no burying by snow
- real(r8) , pointer :: elai_patch (:) ! patch canopy one-sided leaf area index with burying by snow
- real(r8) , pointer :: esai_patch (:) ! patch canopy one-sided stem area index with burying by snow
- real(r8) , pointer :: elai240_patch (:) ! patch canopy one-sided leaf area index with burying by snow average over 10days
- real(r8) , pointer :: laisun_patch (:) ! patch patch sunlit projected leaf area index
- real(r8) , pointer :: laisha_patch (:) ! patch patch shaded projected leaf area index
- real(r8) , pointer :: laisun_z_patch (:,:) ! patch patch sunlit leaf area for canopy layer
- real(r8) , pointer :: laisha_z_patch (:,:) ! patch patch shaded leaf area for canopy layer
- real(r8) , pointer :: mlaidiff_patch (:) ! patch difference between lai month one and month two (for dry deposition of chemical tracers)
- real(r8) , pointer :: annlai_patch (:,:) ! patch 12 months of monthly lai from input data set (for dry deposition of chemical tracers)
- real(r8) , pointer :: htop_patch (:) ! patch canopy top (m)
- real(r8) , pointer :: hbot_patch (:) ! patch canopy bottom (m)
- real(r8) , pointer :: displa_patch (:) ! patch displacement height (m)
- real(r8) , pointer :: fsun_patch (:) ! patch sunlit fraction of canopy
- real(r8) , pointer :: fsun24_patch (:) ! patch 24hr average of sunlit fraction of canopy
- real(r8) , pointer :: fsun240_patch (:) ! patch 240hr average of sunlit fraction of canopy
-
- real(r8) , pointer :: alt_col (:) ! col current depth of thaw
- integer , pointer :: alt_indx_col (:) ! col current depth of thaw
- real(r8) , pointer :: altmax_col (:) ! col maximum annual depth of thaw
- real(r8) , pointer :: altmax_lastyear_col (:) ! col prior year maximum annual depth of thaw
- integer , pointer :: altmax_indx_col (:) ! col maximum annual depth of thaw
- integer , pointer :: altmax_lastyear_indx_col (:) ! col prior year maximum annual depth of thaw
-
- real(r8) , pointer :: dewmx_patch (:) ! patch maximum allowed dew [mm]
- real(r8) , pointer :: dleaf_patch (:) ! patch characteristic leaf width (diameter) [m]
- ! for non-ED/FATES this is the same as pftcon%dleaf()
- real(r8) , pointer :: rscanopy_patch (:) ! patch canopy stomatal resistance (s/m) (ED specific)
-
- real(r8) , pointer :: vegwp_patch (:,:) ! patch vegetation water matric potential (mm)
-
- real(r8) :: leaf_mr_vcm = spval ! Scalar constant of leaf respiration with Vcmax
-
- contains
-
- procedure, public :: Init
- procedure, private :: InitAllocate
- procedure, private :: InitHistory
- procedure, private :: InitCold
- procedure, public :: ReadNML
- procedure, public :: InitAccBuffer
- procedure, public :: InitAccVars
- procedure, public :: UpdateAccVars
- procedure, public :: Restart
-
- end type CanopyState_type
-
- character(len=*), parameter, private :: sourcefile = &
- __FILE__
- !------------------------------------------------------------------------
-
-contains
-
- !------------------------------------------------------------------------
- subroutine Init(this, bounds)
-
- class(canopystate_type) :: this
- type(bounds_type), intent(in) :: bounds
-
- call this%InitAllocate(bounds)
- call this%InitHistory(bounds)
- call this%InitCold(bounds)
-
- if ( this%leaf_mr_vcm == spval ) then
- call endrun(msg="ERROR canopystate Init called before ReadNML"//errmsg(sourcefile, __LINE__))
- end if
-
- end subroutine Init
-
- !------------------------------------------------------------------------
- subroutine InitAllocate(this, bounds)
- !
- ! !USES:
- !
- ! !ARGUMENTS:
- class(canopystate_type) :: this
- type(bounds_type), intent(in) :: bounds
- !
- ! !LOCAL VARIABLES:
- integer :: begp, endp
- integer :: begc, endc
- integer :: begg, endg
- !------------------------------------------------------------------------
-
- begp = bounds%begp; endp= bounds%endp
- begc = bounds%begc; endc= bounds%endc
- begg = bounds%begg; endg= bounds%endg
-
- allocate(this%frac_veg_nosno_patch (begp:endp)) ; this%frac_veg_nosno_patch (:) = huge(1)
- allocate(this%frac_veg_nosno_alb_patch (begp:endp)) ; this%frac_veg_nosno_alb_patch (:) = 0
- allocate(this%tlai_patch (begp:endp)) ; this%tlai_patch (:) = nan
- allocate(this%tsai_patch (begp:endp)) ; this%tsai_patch (:) = nan
- allocate(this%elai_patch (begp:endp)) ; this%elai_patch (:) = nan
- allocate(this%elai240_patch (begp:endp)) ; this%elai240_patch (:) = nan
- allocate(this%esai_patch (begp:endp)) ; this%esai_patch (:) = nan
- allocate(this%laisun_patch (begp:endp)) ; this%laisun_patch (:) = nan
- allocate(this%laisha_patch (begp:endp)) ; this%laisha_patch (:) = nan
- allocate(this%laisun_z_patch (begp:endp,1:nlevcan)) ; this%laisun_z_patch (:,:) = nan
- allocate(this%laisha_z_patch (begp:endp,1:nlevcan)) ; this%laisha_z_patch (:,:) = nan
- allocate(this%mlaidiff_patch (begp:endp)) ; this%mlaidiff_patch (:) = nan
- allocate(this%annlai_patch (12,begp:endp)) ; this%annlai_patch (:,:) = nan
- allocate(this%htop_patch (begp:endp)) ; this%htop_patch (:) = nan
- allocate(this%hbot_patch (begp:endp)) ; this%hbot_patch (:) = nan
- allocate(this%displa_patch (begp:endp)) ; this%displa_patch (:) = nan
- allocate(this%fsun_patch (begp:endp)) ; this%fsun_patch (:) = nan
- allocate(this%fsun24_patch (begp:endp)) ; this%fsun24_patch (:) = nan
- allocate(this%fsun240_patch (begp:endp)) ; this%fsun240_patch (:) = nan
-
- allocate(this%alt_col (begc:endc)) ; this%alt_col (:) = spval
- allocate(this%altmax_col (begc:endc)) ; this%altmax_col (:) = spval
- allocate(this%altmax_lastyear_col (begc:endc)) ; this%altmax_lastyear_col (:) = spval
- allocate(this%alt_indx_col (begc:endc)) ; this%alt_indx_col (:) = huge(1)
- allocate(this%altmax_indx_col (begc:endc)) ; this%altmax_indx_col (:) = huge(1)
- allocate(this%altmax_lastyear_indx_col (begc:endc)) ; this%altmax_lastyear_indx_col (:) = huge(1)
-
- allocate(this%dewmx_patch (begp:endp)) ; this%dewmx_patch (:) = nan
- allocate(this%dleaf_patch (begp:endp)) ; this%dleaf_patch (:) = nan
- allocate(this%rscanopy_patch (begp:endp)) ; this%rscanopy_patch (:) = nan
-! allocate(this%gccanopy_patch (begp:endp)) ; this%gccanopy_patch (:) = 0.0_r8
- allocate(this%vegwp_patch (begp:endp,1:nvegwcs)) ; this%vegwp_patch (:,:) = nan
-
- end subroutine InitAllocate
-
- !-----------------------------------------------------------------------
- subroutine InitHistory(this, bounds)
- !
- ! !USES:
- use histFileMod , only: hist_addfld1d, hist_addfld2d
- !
- ! !ARGUMENTS:
- class(canopystate_type) :: this
- type(bounds_type), intent(in) :: bounds
- !
- ! !LOCAL VARIABLES:
- integer :: begc, endc
- integer :: begp, endp
- real(r8), pointer :: data2dptr(:,:), data1dptr(:) ! temp. pointers for slicing larger arrays
- !---------------------------------------------------------------------
-
- begp = bounds%begp; endp= bounds%endp
- begc = bounds%begc; endc= bounds%endc
-
- this%elai_patch(begp:endp) = spval
- call hist_addfld1d (fname='ELAI', units='m^2/m^2', &
- avgflag='A', long_name='exposed one-sided leaf area index', &
- ptr_patch=this%elai_patch, default='inactive')
-
- this%esai_patch(begp:endp) = spval
- call hist_addfld1d (fname='ESAI', units='m^2/m^2', &
- avgflag='A', long_name='exposed one-sided stem area index', &
- ptr_patch=this%esai_patch, default='inactive')
-
- this%tlai_patch(begp:endp) = spval
- call hist_addfld1d (fname='TLAI', units='none', &
- avgflag='A', long_name='total projected leaf area index', &
- ptr_patch=this%tlai_patch, default='inactive')
-
- this%tsai_patch(begp:endp) = spval
- call hist_addfld1d (fname='TSAI', units='none', &
- avgflag='A', long_name='total projected stem area index', &
- ptr_patch=this%tsai_patch, default='inactive')
-
- this%laisun_patch(begp:endp) = spval
- call hist_addfld1d (fname='LAISUN', units='none', &
- avgflag='A', long_name='sunlit projected leaf area index', &
- ptr_patch=this%laisun_patch, set_urb=0._r8, default='inactive')
-
- this%laisha_patch(begp:endp) = spval
- call hist_addfld1d (fname='LAISHA', units='none', &
- avgflag='A', long_name='shaded projected leaf area index', &
- ptr_patch=this%laisha_patch, set_urb=0._r8, default='inactive')
-
- if (use_cn .or. use_fates) then
- this%fsun_patch(begp:endp) = spval
- call hist_addfld1d (fname='FSUN', units='proportion', &
- avgflag='A', long_name='sunlit fraction of canopy', &
- ptr_patch=this%fsun_patch, default='inactive')
-
- this%dewmx_patch(begp:endp) = spval
- call hist_addfld1d (fname='DEWMX', units='mm', &
- avgflag='A', long_name='Maximum allowed dew', &
- ptr_patch=this%dewmx_patch, default='inactive')
-
- this%htop_patch(begp:endp) = spval
- call hist_addfld1d (fname='HTOP', units='m', &
- avgflag='A', long_name='canopy top', &
- ptr_patch=this%htop_patch, default='inactive')
-
- this%hbot_patch(begp:endp) = spval
- call hist_addfld1d (fname='HBOT', units='m', &
- avgflag='A', long_name='canopy bottom', &
- ptr_patch=this%hbot_patch, default='inactive')
-
- this%displa_patch(begp:endp) = spval
- call hist_addfld1d (fname='DISPLA', units='m', &
- avgflag='A', long_name='displacement height', &
- ptr_patch=this%displa_patch, default='inactive')
- end if
-
- if (use_cn) then
- this%alt_col(begc:endc) = spval
- call hist_addfld1d (fname='ALT', units='m', &
- avgflag='A', long_name='current active layer thickness', &
- ptr_col=this%alt_col, default='inactive')
-
- this%altmax_col(begc:endc) = spval
- call hist_addfld1d (fname='ALTMAX', units='m', &
- avgflag='A', long_name='maximum annual active layer thickness', &
- ptr_col=this%altmax_col, default='inactive')
-
- this%altmax_lastyear_col(begc:endc) = spval
- call hist_addfld1d (fname='ALTMAX_LASTYEAR', units='m', &
- avgflag='A', long_name='maximum prior year active layer thickness', &
- ptr_col=this%altmax_lastyear_col, default='inactive')
- end if
-
- ! Allow active layer fields to be optionally output even if not running CN
-
- if (.not. use_cn) then
- this%alt_col(begc:endc) = spval
- call hist_addfld1d (fname='ALT', units='m', &
- avgflag='A', long_name='current active layer thickness', &
- ptr_col=this%alt_col, default='inactive')
-
- this%altmax_col(begc:endc) = spval
- call hist_addfld1d (fname='ALTMAX', units='m', &
- avgflag='A', long_name='maximum annual active layer thickness', &
- ptr_col=this%altmax_col, default='inactive')
-
- this%altmax_lastyear_col(begc:endc) = spval
- call hist_addfld1d (fname='ALTMAX_LASTYEAR', units='m', &
- avgflag='A', long_name='maximum prior year active layer thickness', &
- ptr_col=this%altmax_lastyear_col, default='inactive')
- end if
-
-
-
- ! Accumulated fields
- this%fsun24_patch(begp:endp) = spval
- call hist_addfld1d (fname='FSUN24', units='K', &
- avgflag='A', long_name='fraction sunlit (last 24hrs)', &
- ptr_patch=this%fsun24_patch, default='inactive')
-
- this%fsun240_patch(begp:endp) = spval
- call hist_addfld1d (fname='FSUN240', units='K', &
- avgflag='A', long_name='fraction sunlit (last 240hrs)', &
- ptr_patch=this%fsun240_patch, default='inactive')
-
- this%elai240_patch(begp:endp) = spval
- call hist_addfld1d (fname='LAI240', units='m^2/m^2', &
- avgflag='A', long_name='240hr average of leaf area index', &
- ptr_patch=this%elai240_patch, default='inactive')
-
- ! Ed specific field
- if ( use_fates ) then
- this%rscanopy_patch(begp:endp) = spval
- call hist_addfld1d (fname='RSCANOPY', units=' s m-1', &
- avgflag='A', long_name='canopy resistance', &
- ptr_patch=this%rscanopy_patch, set_lake=0._r8, set_urb=0._r8, default='inactive')
- end if
-
-! call hist_addfld1d (fname='GCCANOPY', units='none', &
-! avgflag='A', long_name='Canopy Conductance: mmol m-2 s-1', &
-! ptr_patch=this%GCcanopy_patch, set_lake=0._r8, set_urb=0._r8)
-
- if ( use_hydrstress ) then
- this%vegwp_patch(begp:endp,:) = spval
- call hist_addfld2d (fname='VEGWP', units='mm', type2d='nvegwcs', &
- avgflag='A', long_name='vegetation water matric potential for sun/sha canopy,xyl,root segments', &
- ptr_patch=this%vegwp_patch, default='inactive')
- end if
-
- end subroutine InitHistory
-
- !-----------------------------------------------------------------------
- subroutine InitAccBuffer (this, bounds)
- !
- ! !DESCRIPTION:
- ! Initialize accumulation buffer for all required module accumulated fields
- ! This routine set defaults values that are then overwritten by the
- ! restart file for restart or branch runs
- !
- ! !USES
- use accumulMod , only : init_accum_field
- !
- ! !ARGUMENTS:
- class(canopystate_type) :: this
- type(bounds_type), intent(in) :: bounds
- !---------------------------------------------------------------------
-
- this%fsun24_patch(bounds%begp:bounds%endp) = spval
- call init_accum_field (name='FSUN24', units='fraction', &
- desc='24hr average of diffuse solar radiation', accum_type='runmean', accum_period=-1, &
- subgrid_type='pft', numlev=1, init_value=0._r8)
-
- this%fsun240_patch(bounds%begp:bounds%endp) = spval
- call init_accum_field (name='FSUN240', units='fraction', &
- desc='240hr average of diffuse solar radiation', accum_type='runmean', accum_period=-10, &
- subgrid_type='pft', numlev=1, init_value=0._r8)
-
- this%elai240_patch(bounds%begp:bounds%endp) = spval
- call init_accum_field (name='LAI240', units='m2/m2', &
- desc='240hr average of leaf area index', accum_type='runmean', accum_period=-10, &
- subgrid_type='pft', numlev=1, init_value=0._r8)
-
- end subroutine InitAccBuffer
-
- !-----------------------------------------------------------------------
- subroutine InitAccVars(this, bounds)
- !
- ! !DESCRIPTION:
- ! Initialize module variables that are associated with
- ! time accumulated fields. This routine is called for both an initial run
- ! and a restart run (and must therefore must be called after the restart file
- ! is read in and the accumulation buffer is obtained)
- !
- ! !USES
- use accumulMod , only : extract_accum_field
- use clm_time_manager , only : get_nstep
- !
- ! !ARGUMENTS:
- class(canopystate_type) :: this
- type(bounds_type), intent(in) :: bounds
- !
- ! !LOCAL VARIABLES:
- integer :: begp, endp
- integer :: nstep
- integer :: ier
- real(r8), pointer :: rbufslp(:) ! temporary
- !---------------------------------------------------------------------
-
- begp = bounds%begp; endp = bounds%endp
-
- ! Allocate needed dynamic memory for single level patch field
- allocate(rbufslp(begp:endp), stat=ier)
- if (ier/=0) then
- write(iulog,*)' in '
- call endrun(msg="extract_accum_hist allocation error for rbufslp"//&
- errMsg(sourcefile, __LINE__))
- endif
-
- ! Determine time step
- nstep = get_nstep()
-
- call extract_accum_field ('FSUN24', rbufslp, nstep)
- this%fsun24_patch(begp:endp) = rbufslp(begp:endp)
-
- call extract_accum_field ('FSUN240', rbufslp, nstep)
- this%fsun240_patch(begp:endp) = rbufslp(begp:endp)
-
- call extract_accum_field ('LAI240', rbufslp, nstep)
- this%elai240_patch(begp:endp) = rbufslp(begp:endp)
-
- call extract_accum_field ('FSUN24', rbufslp, nstep)
- this%fsun24_patch(begp:endp) = rbufslp(begp:endp)
-
- deallocate(rbufslp)
-
- end subroutine InitAccVars
-
- !-----------------------------------------------------------------------
- subroutine ReadNML( this, NLFilename )
- !
- ! Read in canopy parameter namelist
- !
- ! USES:
- use shr_mpi_mod , only : shr_mpi_bcast
- use abortutils , only : endrun
- 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
- use clm_varctl , only : iulog
- use shr_log_mod , only : errMsg => shr_log_errMsg
- !
- ! ARGUMENTS:
- implicit none
- class(canopystate_type) :: this
- character(len=*), intent(IN) :: NLFilename ! Namelist filename
- ! LOCAL VARIABLES:
- integer :: ierr ! error code
- integer :: unitn ! unit for namelist file
- real(r8) :: leaf_mr_vcm ! Scalar of leaf respiration to vcmax
- character(len=32) :: subname = 'CanopyStateType::ReadNML' ! subroutine name
- !-----------------------------------------------------------------------
- namelist / clm_canopy_inparm / leaf_mr_vcm
-
- ! ----------------------------------------------------------------------
- ! Read namelist from input namelist filename
- ! ----------------------------------------------------------------------
-
- if ( masterproc )then
-
- unitn = getavu()
- write(iulog,*) 'Read in clm_canopy_inparm namelist'
- call opnfil (NLFilename, unitn, 'F')
- call shr_nl_find_group_name(unitn, 'clm_canopy_inparm', status=ierr)
- if (ierr == 0) then
- read(unitn, clm_canopy_inparm, iostat=ierr)
- if (ierr /= 0) then
- call endrun(msg="ERROR reading clm_canopy_inparm namelist"//errmsg(sourcefile, __LINE__))
- end if
- else
- call endrun(msg="ERROR finding clm_canopy_inparm namelist"//errmsg(sourcefile, __LINE__))
- end if
- call relavu( unitn )
-
- end if
-
- ! Broadcast namelist variables read in
- call shr_mpi_bcast(leaf_mr_vcm, mpicom)
- this%leaf_mr_vcm = leaf_mr_vcm
-
- end subroutine ReadNML
-
- !-----------------------------------------------------------------------
- subroutine UpdateAccVars (this, bounds)
- !
- ! USES
- use clm_time_manager, only : get_nstep
- use accumulMod , only : update_accum_field, extract_accum_field
- use abortutils , only : endrun
- !
- ! !ARGUMENTS:
- class(canopystate_type) :: this
- type(bounds_type) , intent(in) :: bounds
- !
- ! !LOCAL VARIABLES:
- integer :: g,p ! indices
- integer :: dtime ! timestep size [seconds]
- integer :: nstep ! timestep number
- integer :: ier ! error status
- integer :: begp, endp
- real(r8), pointer :: rbufslp(:) ! temporary single level - patch level
- !---------------------------------------------------------------------
-
- begp = bounds%begp; endp = bounds%endp
-
- nstep = get_nstep()
-
- ! Allocate needed dynamic memory for single level patch field
-
- allocate(rbufslp(begp:endp), stat=ier)
- if (ier/=0) then
- write(iulog,*)'update_accum_hist allocation error for rbuf1dp'
- call endrun(msg=errMsg(sourcefile, __LINE__))
- endif
-
- ! Accumulate and extract fsun24 & fsun240
- do p = begp,endp
- rbufslp(p) = this%fsun_patch(p)
- end do
- call update_accum_field ('FSUN24' , rbufslp , nstep)
- call extract_accum_field ('FSUN24' , this%fsun24_patch , nstep)
- call update_accum_field ('FSUN240', rbufslp , nstep)
- call extract_accum_field ('FSUN240', this%fsun240_patch , nstep)
-
- ! Accumulate and extract elai240
- do p = begp,endp
- rbufslp(p) = this%elai_patch(p)
- end do
- call update_accum_field ('LAI240', rbufslp , nstep)
- call extract_accum_field ('LAI240', this%elai240_patch , nstep)
-
- deallocate(rbufslp)
-
- end subroutine UpdateAccVars
-
- !-----------------------------------------------------------------------
- subroutine InitCold(this, bounds)
- !
- ! !ARGUMENTS:
- class(canopystate_type) :: this
- type(bounds_type), intent(in) :: bounds
- !
- ! !LOCAL VARIABLES:
- integer :: p,l,c,g
- !-----------------------------------------------------------------------
-
- do p = bounds%begp, bounds%endp
- l = patch%landunit(p)
-
- this%frac_veg_nosno_patch(p) = 0._r8
- this%tlai_patch(p) = 0._r8
- this%tsai_patch(p) = 0._r8
- this%elai_patch(p) = 0._r8
- this%esai_patch(p) = 0._r8
- this%htop_patch(p) = 0._r8
- this%hbot_patch(p) = 0._r8
- this%dewmx_patch(p) = 0.1_r8
- this%vegwp_patch(p,:) = -2.5e4_r8
-
- if (lun%itype(l) == istsoil .or. lun%itype(l) == istcrop) then
- this%laisun_patch(p) = 0._r8
- this%laisha_patch(p) = 0._r8
- end if
-
- ! needs to be initialized to spval to avoid problems when averaging for the accum
- ! field
- this%fsun_patch(p) = spval
- end do
-
- do c = bounds%begc, bounds%endc
- l = col%landunit(c)
-
- if (lun%itype(l) == istsoil .or. lun%itype(l) == istcrop) then
- this%alt_col(c) = 0._r8 !iniitialized to spval for all columns
- this%altmax_col(c) = 0._r8 !iniitialized to spval for all columns
- this%altmax_lastyear_col(c) = 0._r8 !iniitialized to spval for all columns
- this%alt_indx_col(c) = 0 !initiialized to huge for all columns
- this%altmax_indx_col(c) = 0 !initiialized to huge for all columns
- this%altmax_lastyear_indx_col = 0 !initiialized to huge for all columns
- end if
- end do
-
- end subroutine InitCold
-
- !------------------------------------------------------------------------
- subroutine Restart(this, bounds, ncid, flag)
- !
- ! !USES:
- use spmdMod , only : masterproc
- use ncdio_pio , only : file_desc_t, ncd_defvar, ncd_io, ncd_double, ncd_int, ncd_inqvdlen
- use restUtilMod
- !
- ! !ARGUMENTS:
- class(canopystate_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,p,c,iv ! indices
- logical :: readvar ! determine if variable is on initial file
- integer :: begp, endp
- !-----------------------------------------------------------------------
-
- begp = bounds%begp; endp = bounds%endp
-
- call restartvar(ncid=ncid, flag=flag, varname='FRAC_VEG_NOSNO_ALB', xtype=ncd_int, &
- dim1name='pft', long_name='fraction of vegetation not covered by snow (0 or 1)', units='', &
- interpinic_flag='interp', readvar=readvar, data=this%frac_veg_nosno_alb_patch)
-
- call restartvar(ncid=ncid, flag=flag, varname='tlai', xtype=ncd_double, &
- dim1name='pft', long_name='one-sided leaf area index, no burying by snow', units='', &
- interpinic_flag='interp', readvar=readvar, data=this%tlai_patch)
-
- call restartvar(ncid=ncid, flag=flag, varname='tsai', xtype=ncd_double, &
- dim1name='pft', long_name='one-sided stem area index, no burying by snow', units='', &
- interpinic_flag='interp', readvar=readvar, data=this%tsai_patch)
-
- call restartvar(ncid=ncid, flag=flag, varname='elai', xtype=ncd_double, &
- dim1name='pft', long_name='one-sided leaf area index, with burying by snow', units='', &
- interpinic_flag='interp', readvar=readvar, data=this%elai_patch)
-
- call restartvar(ncid=ncid, flag=flag, varname='esai', xtype=ncd_double, &
- dim1name='pft', long_name='one-sided stem area index, with burying by snow', units='', &
- interpinic_flag='interp', readvar=readvar, data=this%esai_patch)
-
- call restartvar(ncid=ncid, flag=flag, varname='htop', xtype=ncd_double, &
- dim1name='pft', long_name='canopy top', units='m', &
- interpinic_flag='interp', readvar=readvar, data=this%htop_patch)
-
- call restartvar(ncid=ncid, flag=flag, varname='hbot', xtype=ncd_double, &
- dim1name='pft', long_name='canopy botton', units='m', &
- interpinic_flag='interp', readvar=readvar, data=this%hbot_patch)
-
- call restartvar(ncid=ncid, flag=flag, varname='mlaidiff', xtype=ncd_double, &
- dim1name='pft', long_name='difference between lai month one and month two', units='', &
- interpinic_flag='interp', readvar=readvar, data=this%mlaidiff_patch)
-
- call restartvar(ncid=ncid, flag=flag, varname='fsun', xtype=ncd_double, &
- dim1name='pft', long_name='sunlit fraction of canopy', units='', &
- interpinic_flag='interp', readvar=readvar, data=this%fsun_patch)
-
- if (flag=='read' )then
- do p = bounds%begp,bounds%endp
- if (shr_infnan_isnan(this%fsun_patch(p)) ) then
- this%fsun_patch(p) = spval
- end if
- end do
- end if
-
- if (use_cn .or. use_fates) then
- call restartvar(ncid=ncid, flag=flag, varname='altmax', xtype=ncd_double, &
- dim1name='column', long_name='', units='', &
- interpinic_flag='interp', readvar=readvar, data=this%altmax_col)
-
- call restartvar(ncid=ncid, flag=flag, varname='altmax_lastyear', xtype=ncd_double, &
- dim1name='column', long_name='', units='', &
- interpinic_flag='interp', readvar=readvar, data=this%altmax_lastyear_col)
-
- call restartvar(ncid=ncid, flag=flag, varname='altmax_indx', xtype=ncd_int, &
- dim1name='column', long_name='', units='', &
- interpinic_flag='interp', readvar=readvar, data=this%altmax_indx_col)
-
- call restartvar(ncid=ncid, flag=flag, varname='altmax_lastyear_indx', xtype=ncd_int, &
- dim1name='column', long_name='', units='', &
- interpinic_flag='interp', readvar=readvar, data=this%altmax_lastyear_indx_col)
- end if
-
- if ( use_hydrstress ) then
- call restartvar(ncid=ncid, flag=flag, varname='vegwp', xtype=ncd_double, &
- dim1name='pft', dim2name='vegwcs', switchdim=.true., &
- long_name='vegetation water matric potential', units='mm', &
- interpinic_flag='interp', readvar=readvar, data=this%vegwp_patch)
-
- end if
-
- end subroutine Restart
-
-end module CanopyStateType
diff --git a/src/biogeophys/EnergyFluxType.F90 b/src/biogeophys/EnergyFluxType.F90
deleted file mode 100644
index 83b5281e..00000000
--- a/src/biogeophys/EnergyFluxType.F90
+++ /dev/null
@@ -1,1022 +0,0 @@
-module EnergyFluxType
-
-#include "shr_assert.h"
-
- !------------------------------------------------------------------------------
- ! Energy flux data structure
- !
- use shr_kind_mod , only : r8 => shr_kind_r8
- use shr_log_mod , only : errMsg => shr_log_errMsg
- use clm_varcon , only : spval
- use decompMod , only : bounds_type
- use LandunitType , only : lun
- use ColumnType , only : col
- use PatchType , only : patch
- !
- implicit none
- save
- private
- !
- type, public :: energyflux_type
-
- ! Fluxes
- real(r8), pointer :: eflx_sh_grnd_patch (:) ! patch sensible heat flux from ground (W/m**2) [+ to atm]
- real(r8), pointer :: eflx_sh_veg_patch (:) ! patch sensible heat flux from leaves (W/m**2) [+ to atm]
- real(r8), pointer :: eflx_sh_snow_patch (:) ! patch sensible heat flux from snow (W/m**2) [+ to atm]
- real(r8), pointer :: eflx_sh_soil_patch (:) ! patch sensible heat flux from soil (W/m**2) [+ to atm]
- real(r8), pointer :: eflx_sh_h2osfc_patch (:) ! patch sensible heat flux from surface water (W/m**2) [+ to atm]
- real(r8), pointer :: eflx_sh_tot_patch (:) ! patch total sensible heat flux (W/m**2) [+ to atm]
- real(r8), pointer :: eflx_sh_tot_u_patch (:) ! patch urban total sensible heat flux (W/m**2) [+ to atm]
- real(r8), pointer :: eflx_sh_tot_r_patch (:) ! patch rural total sensible heat flux (W/m**2) [+ to atm]
- real(r8), pointer :: eflx_sh_precip_conversion_col(:) ! col sensible heat flux from precipitation conversion (W/m**2) [+ to atm]
- real(r8), pointer :: eflx_lh_tot_patch (:) ! patch total latent heat flux (W/m**2) [+ to atm]
- real(r8), pointer :: eflx_lh_tot_u_patch (:) ! patch urban total latent heat flux (W/m**2) [+ to atm]
- real(r8), pointer :: eflx_lh_tot_r_patch (:) ! patch rural total latent heat flux (W/m**2) [+ to atm]
- real(r8), pointer :: eflx_lh_vegt_patch (:) ! patch transpiration heat flux from veg (W/m**2) [+ to atm]
- real(r8), pointer :: eflx_lh_vege_patch (:) ! patch evaporation heat flux from veg (W/m**2) [+ to atm]
- real(r8), pointer :: eflx_lh_grnd_patch (:) ! patch evaporation heat flux from ground (W/m**2) [+ to atm]
- real(r8), pointer :: eflx_soil_grnd_patch (:) ! patch soil heat flux (W/m**2) [+ = into soil]
- real(r8), pointer :: eflx_soil_grnd_u_patch (:) ! patch urban soil heat flux (W/m**2) [+ = into soil]
- real(r8), pointer :: eflx_soil_grnd_r_patch (:) ! patch rural soil heat flux (W/m**2) [+ = into soil]
- real(r8), pointer :: eflx_lwrad_net_patch (:) ! patch net infrared (longwave) rad (W/m**2) [+ = to atm]
- real(r8), pointer :: eflx_lwrad_net_r_patch (:) ! patch rural net infrared (longwave) rad (W/m**2) [+ = to atm]
- real(r8), pointer :: eflx_lwrad_net_u_patch (:) ! patch urban net infrared (longwave) rad (W/m**2) [+ = to atm]
- real(r8), pointer :: eflx_lwrad_out_patch (:) ! patch emitted infrared (longwave) radiation (W/m**2)
- real(r8), pointer :: eflx_lwrad_out_r_patch (:) ! patch rural emitted infrared (longwave) rad (W/m**2)
- real(r8), pointer :: eflx_lwrad_out_u_patch (:) ! patch urban emitted infrared (longwave) rad (W/m**2)
- real(r8), pointer :: eflx_snomelt_col (:) ! col snow melt heat flux (W/m**2)
- real(r8), pointer :: eflx_snomelt_r_col (:) ! col rural snow melt heat flux (W/m**2)
- real(r8), pointer :: eflx_snomelt_u_col (:) ! col urban snow melt heat flux (W/m**2)
- real(r8), pointer :: eflx_gnet_patch (:) ! patch net heat flux into ground (W/m**2)
- real(r8), pointer :: eflx_grnd_lake_patch (:) ! patch net heat flux into lake / snow surface, excluding light transmission (W/m**2)
- real(r8), pointer :: eflx_dynbal_grc (:) ! grc dynamic land cover change conversion energy flux (W/m**2)
- real(r8), pointer :: eflx_bot_col (:) ! col heat flux from beneath the soil or ice column (W/m**2)
- real(r8), pointer :: eflx_fgr12_col (:) ! col ground heat flux between soil layers 1 and 2 (W/m**2)
- real(r8), pointer :: eflx_fgr_col (:,:) ! col (rural) soil downward heat flux (W/m2) (1:nlevgrnd) (pos upward; usually eflx_bot >= 0)
- real(r8), pointer :: eflx_building_heat_errsoi_col(:) ! col heat flux to interior surface of walls and roof for errsoi check (W m-2)
- real(r8), pointer :: eflx_urban_ac_col (:) ! col urban air conditioning flux (W/m**2)
- real(r8), pointer :: eflx_urban_heat_col (:) ! col urban heating flux (W/m**2)
- real(r8), pointer :: eflx_anthro_patch (:) ! patch total anthropogenic heat flux (W/m**2)
- real(r8), pointer :: eflx_traffic_patch (:) ! patch traffic sensible heat flux (W/m**2)
- real(r8), pointer :: eflx_wasteheat_patch (:) ! patch sensible heat flux from domestic heating/cooling sources of waste heat (W/m**2)
- real(r8), pointer :: eflx_heat_from_ac_patch (:) ! patch sensible heat flux put back into canyon due to removal by AC (W/m**2)
- real(r8), pointer :: eflx_traffic_lun (:) ! lun traffic sensible heat flux (W/m**2)
- real(r8), pointer :: eflx_wasteheat_lun (:) ! lun sensible heat flux from domestic heating/cooling sources of waste heat (W/m**2)
- real(r8), pointer :: eflx_heat_from_ac_lun (:) ! lun sensible heat flux to be put back into canyon due to removal by AC (W/m**2)
- real(r8), pointer :: eflx_building_lun (:) ! lun building heat flux from change in interior building air temperature (W/m**2)
- real(r8), pointer :: eflx_urban_ac_lun (:) ! lun urban air conditioning flux (W/m**2)
- real(r8), pointer :: eflx_urban_heat_lun (:) ! lun urban heating flux (W/m**2)
-
- ! Derivatives of energy fluxes
- real(r8), pointer :: dgnetdT_patch (:) ! patch derivative of net ground heat flux wrt soil temp (W/m**2 K)
- real(r8), pointer :: netrad_patch (:) ! col net radiation (W/m**2) [+ = to sfc]
- real(r8), pointer :: cgrnd_patch (:) ! col deriv. of soil energy flux wrt to soil temp [W/m2/k]
- real(r8), pointer :: cgrndl_patch (:) ! col deriv. of soil latent heat flux wrt soil temp [W/m**2/k]
- real(r8), pointer :: cgrnds_patch (:) ! col deriv. of soil sensible heat flux wrt soil temp [W/m2/k]
-
- ! Canopy radiation
- real(r8), pointer :: dlrad_patch (:) ! col downward longwave radiation below the canopy [W/m2]
- real(r8), pointer :: ulrad_patch (:) ! col upward longwave radiation above the canopy [W/m2]
-
- ! Wind Stress
- real(r8), pointer :: taux_patch (:) ! patch wind (shear) stress: e-w (kg/m/s**2)
- real(r8), pointer :: tauy_patch (:) ! patch wind (shear) stress: n-s (kg/m/s**2)
-
- ! Conductance
- real(r8), pointer :: canopy_cond_patch (:) ! patch tracer conductance for canopy [m/s]
-
- ! Transpiration
- real(r8), pointer :: btran_patch (:) ! patch transpiration wetness factor (0 to 1)
- real(r8), pointer :: btran_min_patch (:) ! patch daily minimum transpiration wetness factor (0 to 1)
- real(r8), pointer :: btran_min_inst_patch (:) ! patch instantaneous daily minimum transpiration wetness factor (0 to 1)
- real(r8), pointer :: bsun_patch (:) ! patch sunlit canopy transpiration wetness factor (0 to 1)
- real(r8), pointer :: bsha_patch (:) ! patch shaded canopy transpiration wetness factor (0 to 1)
-
- ! Roots
- real(r8), pointer :: btran2_patch (:) ! patch root zone soil wetness factor (0 to 1)
- real(r8), pointer :: rresis_patch (:,:) ! patch root resistance by layer (0-1) (nlevgrnd)
-
- ! Latent heat
- real(r8), pointer :: htvp_col (:) ! latent heat of vapor of water (or sublimation) [j/kg]
-
- ! Balance Checks
- real(r8), pointer :: errsoi_patch (:) ! soil/lake energy conservation error (W/m**2)
- real(r8), pointer :: errsoi_col (:) ! soil/lake energy conservation error (W/m**2)
- real(r8), pointer :: errseb_patch (:) ! surface energy conservation error (W/m**2)
- real(r8), pointer :: errseb_col (:) ! surface energy conservation error (W/m**2)
- real(r8), pointer :: errsol_patch (:) ! solar radiation conservation error (W/m**2)
- real(r8), pointer :: errsol_col (:) ! solar radiation conservation error (W/m**2)
- real(r8), pointer :: errlon_patch (:) ! longwave radiation conservation error (W/m**2)
- real(r8), pointer :: errlon_col (:) ! longwave radiation conservation error (W/m**2)
-
- contains
-
- procedure, public :: Init ! Public initialization method
- procedure, private :: InitAllocate ! initialize/allocate
- procedure, private :: InitHistory ! setup history fields
- procedure, private :: InitCold ! initialize for cold start
- procedure, public :: Restart ! setup restart fields
- procedure, public :: InitAccBuffer
- procedure, public :: InitAccVars
- procedure, public :: UpdateAccVars
-
- end type energyflux_type
-
- character(len=*), parameter, private :: sourcefile = &
- __FILE__
- !------------------------------------------------------------------------
-
-contains
-
- !------------------------------------------------------------------------
- subroutine Init(this, bounds, t_grnd_col, is_simple_buildtemp, is_prog_buildtemp )
- !
- ! !DESCRIPTION:
- ! Allocate and initialize the data type and setup history, and initialize for cold-start.
- ! !USES:
- implicit none
- ! !ARGUMENTS:
- class(energyflux_type) :: this
- type(bounds_type) , intent(in) :: bounds
- real(r8) , intent(in) :: t_grnd_col( bounds%begc: )
- logical , intent(in) :: is_simple_buildtemp ! If using simple building temp method
- logical , intent(in) :: is_prog_buildtemp ! If using prognostic building temp method
-
- SHR_ASSERT_ALL((ubound(t_grnd_col) == (/bounds%endc/)), errMsg(sourcefile, __LINE__))
-
- call this%InitAllocate ( bounds )
- call this%InitHistory ( bounds, is_simple_buildtemp )
- call this%InitCold ( bounds, t_grnd_col, is_simple_buildtemp, is_prog_buildtemp )
-
- end subroutine Init
-
- !------------------------------------------------------------------------
- subroutine InitAllocate(this, bounds)
- !
- ! !DESCRIPTION:
- ! Initialize and allocate data structure
- !
- ! !USES:
- use shr_infnan_mod , only : nan => shr_infnan_nan, assignment(=)
- use clm_varpar , only : nlevsno, nlevgrnd, nlevlak
- implicit none
- !
- ! !ARGUMENTS:
- class(energyflux_type) :: this
- type(bounds_type), intent(in) :: bounds
- !
- ! !LOCAL VARIABLES:
- integer :: begp, endp
- integer :: begc, endc
- integer :: begl, endl
- integer :: begg, endg
- !------------------------------------------------------------------------
-
- begp = bounds%begp; endp= bounds%endp
- begc = bounds%begc; endc= bounds%endc
- begl = bounds%begl; endl= bounds%endl
- begg = bounds%begg; endg= bounds%endg
-
- allocate( this%eflx_sh_snow_patch (begp:endp)) ; this%eflx_sh_snow_patch (:) = nan
- allocate( this%eflx_sh_soil_patch (begp:endp)) ; this%eflx_sh_soil_patch (:) = nan
- allocate( this%eflx_sh_h2osfc_patch (begp:endp)) ; this%eflx_sh_h2osfc_patch (:) = nan
- allocate( this%eflx_sh_tot_patch (begp:endp)) ; this%eflx_sh_tot_patch (:) = nan
- allocate( this%eflx_sh_tot_u_patch (begp:endp)) ; this%eflx_sh_tot_u_patch (:) = nan
- allocate( this%eflx_sh_tot_r_patch (begp:endp)) ; this%eflx_sh_tot_r_patch (:) = nan
- allocate( this%eflx_sh_grnd_patch (begp:endp)) ; this%eflx_sh_grnd_patch (:) = nan
- allocate( this%eflx_sh_veg_patch (begp:endp)) ; this%eflx_sh_veg_patch (:) = nan
- allocate( this%eflx_sh_precip_conversion_col(begc:endc)) ; this%eflx_sh_precip_conversion_col(:) = nan
- allocate( this%eflx_lh_tot_u_patch (begp:endp)) ; this%eflx_lh_tot_u_patch (:) = nan
- allocate( this%eflx_lh_tot_patch (begp:endp)) ; this%eflx_lh_tot_patch (:) = nan
- allocate( this%eflx_lh_tot_r_patch (begp:endp)) ; this%eflx_lh_tot_r_patch (:) = nan
- allocate( this%eflx_lh_grnd_patch (begp:endp)) ; this%eflx_lh_grnd_patch (:) = nan
- allocate( this%eflx_lh_vege_patch (begp:endp)) ; this%eflx_lh_vege_patch (:) = nan
- allocate( this%eflx_lh_vegt_patch (begp:endp)) ; this%eflx_lh_vegt_patch (:) = nan
- allocate( this%eflx_soil_grnd_patch (begp:endp)) ; this%eflx_soil_grnd_patch (:) = nan
- allocate( this%eflx_soil_grnd_u_patch (begp:endp)) ; this%eflx_soil_grnd_u_patch (:) = nan
- allocate( this%eflx_soil_grnd_r_patch (begp:endp)) ; this%eflx_soil_grnd_r_patch (:) = nan
- allocate( this%eflx_lwrad_net_patch (begp:endp)) ; this%eflx_lwrad_net_patch (:) = nan
- allocate( this%eflx_lwrad_net_u_patch (begp:endp)) ; this%eflx_lwrad_net_u_patch (:) = nan
- allocate( this%eflx_lwrad_net_r_patch (begp:endp)) ; this%eflx_lwrad_net_r_patch (:) = nan
- allocate( this%eflx_lwrad_out_patch (begp:endp)) ; this%eflx_lwrad_out_patch (:) = nan
- allocate( this%eflx_lwrad_out_u_patch (begp:endp)) ; this%eflx_lwrad_out_u_patch (:) = nan
- allocate( this%eflx_lwrad_out_r_patch (begp:endp)) ; this%eflx_lwrad_out_r_patch (:) = nan
- allocate( this%eflx_gnet_patch (begp:endp)) ; this%eflx_gnet_patch (:) = nan
- allocate( this%eflx_grnd_lake_patch (begp:endp)) ; this%eflx_grnd_lake_patch (:) = nan
- allocate( this%eflx_dynbal_grc (begg:endg)) ; this%eflx_dynbal_grc (:) = nan
- allocate( this%eflx_bot_col (begc:endc)) ; this%eflx_bot_col (:) = nan
- allocate( this%eflx_snomelt_col (begc:endc)) ; this%eflx_snomelt_col (:) = nan
- allocate( this%eflx_snomelt_r_col (begc:endc)) ; this%eflx_snomelt_r_col (:) = nan
- allocate( this%eflx_snomelt_u_col (begc:endc)) ; this%eflx_snomelt_u_col (:) = nan
- allocate( this%eflx_fgr12_col (begc:endc)) ; this%eflx_fgr12_col (:) = nan
- allocate( this%eflx_fgr_col (begc:endc, 1:nlevgrnd)) ; this%eflx_fgr_col (:,:) = nan
- allocate( this%eflx_building_heat_errsoi_col (begc:endc)) ; this%eflx_building_heat_errsoi_col(:)= nan
- allocate( this%eflx_urban_ac_col (begc:endc)) ; this%eflx_urban_ac_col (:) = nan
- allocate( this%eflx_urban_heat_col (begc:endc)) ; this%eflx_urban_heat_col (:) = nan
- allocate( this%eflx_wasteheat_patch (begp:endp)) ; this%eflx_wasteheat_patch (:) = nan
- allocate( this%eflx_traffic_patch (begp:endp)) ; this%eflx_traffic_patch (:) = nan
- allocate( this%eflx_heat_from_ac_patch (begp:endp)) ; this%eflx_heat_from_ac_patch (:) = nan
- allocate( this%eflx_heat_from_ac_lun (begl:endl)) ; this%eflx_heat_from_ac_lun (:) = nan
- allocate( this%eflx_building_lun (begl:endl)) ; this%eflx_building_lun (:) = nan
- allocate( this%eflx_urban_ac_lun (begl:endl)) ; this%eflx_urban_ac_lun (:) = nan
- allocate( this%eflx_urban_heat_lun (begl:endl)) ; this%eflx_urban_heat_lun (:) = nan
- allocate( this%eflx_traffic_lun (begl:endl)) ; this%eflx_traffic_lun (:) = nan
- allocate( this%eflx_wasteheat_lun (begl:endl)) ; this%eflx_wasteheat_lun (:) = nan
- allocate( this%eflx_anthro_patch (begp:endp)) ; this%eflx_anthro_patch (:) = nan
-
- allocate( this%dgnetdT_patch (begp:endp)) ; this%dgnetdT_patch (:) = nan
- allocate( this%cgrnd_patch (begp:endp)) ; this%cgrnd_patch (:) = nan
- allocate( this%cgrndl_patch (begp:endp)) ; this%cgrndl_patch (:) = nan
- allocate( this%cgrnds_patch (begp:endp)) ; this%cgrnds_patch (:) = nan
- allocate( this%dlrad_patch (begp:endp)) ; this%dlrad_patch (:) = nan
- allocate( this%ulrad_patch (begp:endp)) ; this%ulrad_patch (:) = nan
- allocate( this%netrad_patch (begp:endp)) ; this%netrad_patch (:) = nan
-
- allocate( this%taux_patch (begp:endp)) ; this%taux_patch (:) = nan
- allocate( this%tauy_patch (begp:endp)) ; this%tauy_patch (:) = nan
-
- allocate( this%canopy_cond_patch (begp:endp)) ; this%canopy_cond_patch (:) = nan
-
- allocate( this%htvp_col (begc:endc)) ; this%htvp_col (:) = nan
-
- allocate(this%rresis_patch (begp:endp,1:nlevgrnd)) ; this%rresis_patch (:,:) = nan
- allocate(this%btran_patch (begp:endp)) ; this%btran_patch (:) = nan
- allocate(this%btran_min_patch (begp:endp)) ; this%btran_min_patch (:) = nan
- allocate(this%btran_min_inst_patch (begp:endp)) ; this%btran_min_inst_patch (:) = nan
- allocate(this%btran2_patch (begp:endp)) ; this%btran2_patch (:) = nan
- allocate( this%bsun_patch (begp:endp)) ; this%bsun_patch (:) = nan
- allocate( this%bsha_patch (begp:endp)) ; this%bsha_patch (:) = nan
- allocate( this%errsoi_patch (begp:endp)) ; this%errsoi_patch (:) = nan
- allocate( this%errsoi_col (begc:endc)) ; this%errsoi_col (:) = nan
- allocate( this%errseb_patch (begp:endp)) ; this%errseb_patch (:) = nan
- allocate( this%errseb_col (begc:endc)) ; this%errseb_col (:) = nan
- allocate( this%errsol_patch (begp:endp)) ; this%errsol_patch (:) = nan
- allocate( this%errsol_col (begc:endc)) ; this%errsol_col (:) = nan
- allocate( this%errlon_patch (begp:endp)) ; this%errlon_patch (:) = nan
- allocate( this%errlon_col (begc:endc)) ; this%errlon_col (:) = nan
-
- end subroutine InitAllocate
-
- !------------------------------------------------------------------------
- subroutine InitHistory(this, bounds, is_simple_buildtemp)
- !
- ! !DESCRIPTION:
- ! Setup fields that can be output to history files
- !
- ! !USES:
- use shr_infnan_mod , only : nan => shr_infnan_nan, assignment(=)
- use clm_varpar , only : nlevsno, nlevgrnd
- use clm_varctl , only : use_cn, use_hydrstress
- use histFileMod , only : hist_addfld1d, hist_addfld2d, no_snow_normal
- use ncdio_pio , only : ncd_inqvdlen
- implicit none
- !
- ! !ARGUMENTS:
- class(energyflux_type) :: this
- type(bounds_type), intent(in) :: bounds
- logical , intent(in) :: is_simple_buildtemp ! If using simple building temp method
- !
- ! !LOCAL VARIABLES:
- integer :: begp, endp
- integer :: begc, endc
- integer :: begl, endl
- integer :: begg, endg
- integer :: dimlen
- integer :: err_code
- logical :: do_io
- character(10) :: active
- real(r8), pointer :: data2dptr(:,:), data1dptr(:) ! temp. pointers for slicing larger arrays
- !------------------------------------------------------------------------
-
- begp = bounds%begp; endp= bounds%endp
- begc = bounds%begc; endc= bounds%endc
- begl = bounds%begl; endl= bounds%endl
- begg = bounds%begg; endg= bounds%endg
-
-
- this%eflx_dynbal_grc(begg:endg) = spval
- call hist_addfld1d (fname='EFLX_DYNBAL', units='W/m^2', &
- avgflag='A', long_name='dynamic land cover change conversion energy flux', &
- ptr_lnd=this%eflx_dynbal_grc, default='inactive')
-
- this%eflx_snomelt_col(begc:endc) = spval
- call hist_addfld1d (fname='FSM', units='W/m^2', &
- avgflag='A', long_name='snow melt heat flux', &
- ptr_col=this%eflx_snomelt_col, c2l_scale_type='urbanf', default='inactive')
-
- call hist_addfld1d (fname='FSM_ICE', units='W/m^2', &
- avgflag='A', long_name='snow melt heat flux (ice landunits only)', &
- ptr_col=this%eflx_snomelt_col, c2l_scale_type='urbanf', l2g_scale_type='ice', &
- default='inactive')
-
- this%eflx_snomelt_r_col(begc:endc) = spval
- call hist_addfld1d (fname='FSM_R', units='W/m^2', &
- avgflag='A', long_name='Rural snow melt heat flux', &
- ptr_col=this%eflx_snomelt_r_col, set_spec=spval, default='inactive')
-
- this%eflx_snomelt_u_col(begc:endc) = spval
- call hist_addfld1d (fname='FSM_U', units='W/m^2', &
- avgflag='A', long_name='Urban snow melt heat flux', &
- ptr_col=this%eflx_snomelt_u_col, c2l_scale_type='urbanf', set_nourb=spval, default='inactive')
-
- this%eflx_lwrad_net_patch(begp:endp) = spval
- call hist_addfld1d (fname='FIRA', units='W/m^2', &
- avgflag='A', long_name='net infrared (longwave) radiation', &
- ptr_patch=this%eflx_lwrad_net_patch, c2l_scale_type='urbanf', default='inactive')
-
- call hist_addfld1d (fname='FIRA_ICE', units='W/m^2', &
- avgflag='A', long_name='net infrared (longwave) radiation (ice landunits only)', &
- ptr_patch=this%eflx_lwrad_net_patch, c2l_scale_type='urbanf', l2g_scale_type='ice',&
- default='inactive')
-
- this%eflx_lwrad_net_r_patch(begp:endp) = spval
- call hist_addfld1d (fname='FIRA_R', units='W/m^2', &
- avgflag='A', long_name='Rural net infrared (longwave) radiation', &
- ptr_patch=this%eflx_lwrad_net_r_patch, set_spec=spval, default='inactive')
-
- this%eflx_lwrad_out_patch(begp:endp) = spval
- call hist_addfld1d (fname='FIRE', units='W/m^2', &
- avgflag='A', long_name='emitted infrared (longwave) radiation', &
- ptr_patch=this%eflx_lwrad_out_patch, c2l_scale_type='urbanf', default='inactive')
- ! Rename of FIRE for Urban intercomparision project
- call hist_addfld1d (fname='LWup', units='W/m^2', &
- avgflag='A', long_name='upwelling longwave radiation', &
- ptr_patch=this%eflx_lwrad_out_patch, c2l_scale_type='urbanf', default='inactive')
-
- call hist_addfld1d (fname='FIRE_ICE', units='W/m^2', &
- avgflag='A', long_name='emitted infrared (longwave) radiation (ice landunits only)', &
- ptr_patch=this%eflx_lwrad_out_patch, c2l_scale_type='urbanf', l2g_scale_type='ice', &
- default='inactive')
-
- this%eflx_lwrad_out_r_patch(begp:endp) = spval
- call hist_addfld1d (fname='FIRE_R', units='W/m^2', &
- avgflag='A', long_name='Rural emitted infrared (longwave) radiation', &
- ptr_patch=this%eflx_lwrad_out_r_patch, set_spec=spval, default='inactive')
-
- this%eflx_lh_vegt_patch(begp:endp) = spval
- call hist_addfld1d (fname='FCTR', units='W/m^2', &
- avgflag='A', long_name='canopy transpiration', &
- ptr_patch=this%eflx_lh_vegt_patch, set_lake=0._r8, c2l_scale_type='urbanf', default='inactive')
-
- this%eflx_lh_vege_patch(begp:endp) = spval
- call hist_addfld1d (fname='FCEV', units='W/m^2', &
- avgflag='A', long_name='canopy evaporation', &
- ptr_patch=this%eflx_lh_vege_patch, set_lake=0._r8, c2l_scale_type='urbanf', default='inactive')
-
- this%eflx_lh_grnd_patch(begp:endp) = spval
- call hist_addfld1d (fname='FGEV', units='W/m^2', &
- avgflag='A', long_name='ground evaporation', &
- ptr_patch=this%eflx_lh_grnd_patch, c2l_scale_type='urbanf', default='inactive')
-
- this%eflx_sh_tot_patch(begp:endp) = spval
- call hist_addfld1d (fname='FSH', units='W/m^2', &
- avgflag='A', long_name='sensible heat not including correction for land use change and rain/snow conversion', &
- ptr_patch=this%eflx_sh_tot_patch, c2l_scale_type='urbanf', default='inactive')
-
- call hist_addfld1d (fname='FSH_ICE', units='W/m^2', &
- avgflag='A', &
- long_name='sensible heat not including correction for land use change and rain/snow conversion (ice landunits only)', &
- ptr_patch=this%eflx_sh_tot_patch, c2l_scale_type='urbanf', l2g_scale_type='ice', &
- default='inactive')
-
- this%eflx_sh_tot_r_patch(begp:endp) = spval
- call hist_addfld1d (fname='FSH_R', units='W/m^2', &
- avgflag='A', long_name='Rural sensible heat', &
- ptr_patch=this%eflx_sh_tot_r_patch, set_spec=spval, default='inactive')
-
- this%eflx_sh_tot_patch(begp:endp) = spval
- call hist_addfld1d (fname='Qh', units='W/m^2', &
- avgflag='A', long_name='sensible heat', &
- ptr_patch=this%eflx_sh_tot_patch, c2l_scale_type='urbanf', &
- default = 'inactive')
-
- this%eflx_lh_tot_patch(begp:endp) = spval
- call hist_addfld1d (fname='Qle', units='W/m^2', &
- avgflag='A', long_name='total evaporation', &
- ptr_patch=this%eflx_lh_tot_patch, c2l_scale_type='urbanf', &
- default = 'inactive')
-
- this%eflx_lh_tot_patch(begp:endp) = spval
- call hist_addfld1d (fname='EFLX_LH_TOT', units='W/m^2', &
- avgflag='A', long_name='total latent heat flux [+ to atm]', &
- ptr_patch=this%eflx_lh_tot_patch, c2l_scale_type='urbanf', default='inactive')
-
- call hist_addfld1d (fname='EFLX_LH_TOT_ICE', units='W/m^2', &
- avgflag='A', long_name='total latent heat flux [+ to atm] (ice landunits only)', &
- ptr_patch=this%eflx_lh_tot_patch, c2l_scale_type='urbanf', l2g_scale_type='ice', &
- default='inactive')
-
- this%eflx_lh_tot_r_patch(begp:endp) = spval
- call hist_addfld1d (fname='EFLX_LH_TOT_R', units='W/m^2', &
- avgflag='A', long_name='Rural total evaporation', &
- ptr_patch=this%eflx_lh_tot_r_patch, set_spec=spval, default='inactive')
-
- this%eflx_soil_grnd_patch(begp:endp) = spval
- call hist_addfld1d (fname='Qstor', units='W/m^2', &
- avgflag='A', long_name='storage heat flux (includes snowmelt)', &
- ptr_patch=this%eflx_soil_grnd_patch, c2l_scale_type='urbanf', &
- default = 'inactive')
- this%eflx_sh_veg_patch(begp:endp) = spval
- call hist_addfld1d (fname='FSH_V', units='W/m^2', &
- avgflag='A', long_name='sensible heat from veg', &
- ptr_patch=this%eflx_sh_veg_patch, set_lake=0._r8, c2l_scale_type='urbanf', default='inactive')
-
- this%eflx_sh_grnd_patch(begp:endp) = spval
- call hist_addfld1d (fname='FSH_G', units='W/m^2', &
- avgflag='A', long_name='sensible heat from ground', &
- ptr_patch=this%eflx_sh_grnd_patch, c2l_scale_type='urbanf', default='inactive')
-
- this%eflx_soil_grnd_patch(begp:endp) = spval
- call hist_addfld1d (fname='FGR', units='W/m^2', &
- avgflag='A', long_name='heat flux into soil/snow including snow melt and lake / snow light transmission', &
- ptr_patch=this%eflx_soil_grnd_patch, c2l_scale_type='urbanf', default='inactive')
-
- call hist_addfld1d (fname='FGR_ICE', units='W/m^2', &
- avgflag='A', &
- long_name='heat flux into soil/snow including snow melt and lake / snow light transmission (ice landunits only)', &
- ptr_patch=this%eflx_soil_grnd_patch, c2l_scale_type='urbanf', l2g_scale_type='ice', &
- default='inactive')
-
- this%eflx_soil_grnd_r_patch(begp:endp) = spval
- call hist_addfld1d (fname='FGR_R', units='W/m^2', &
- avgflag='A', long_name='Rural heat flux into soil/snow including snow melt and snow light transmission', &
- ptr_patch=this%eflx_soil_grnd_r_patch, set_spec=spval, default='inactive')
-
- this%eflx_lwrad_net_u_patch(begp:endp) = spval
- call hist_addfld1d (fname='FIRA_U', units='W/m^2', &
- avgflag='A', long_name='Urban net infrared (longwave) radiation', &
- ptr_patch=this%eflx_lwrad_net_u_patch, c2l_scale_type='urbanf', set_nourb=spval, default='inactive')
-
- this%eflx_soil_grnd_patch(begp:endp) = spval
- call hist_addfld1d (fname='EFLX_SOIL_GRND', units='W/m^2', &
- avgflag='A', long_name='soil heat flux [+ into soil]', &
- ptr_patch=this%eflx_soil_grnd_patch, default='inactive', c2l_scale_type='urbanf')
-
- this%eflx_lwrad_out_u_patch(begp:endp) = spval
- call hist_addfld1d (fname='FIRE_U', units='W/m^2', &
- avgflag='A', long_name='Urban emitted infrared (longwave) radiation', &
- ptr_patch=this%eflx_lwrad_out_u_patch, c2l_scale_type='urbanf', set_nourb=spval, default='inactive')
-
- this%eflx_sh_tot_u_patch(begp:endp) = spval
- call hist_addfld1d (fname='FSH_U', units='W/m^2', &
- avgflag='A', long_name='Urban sensible heat', &
- ptr_patch=this%eflx_sh_tot_u_patch, c2l_scale_type='urbanf', set_nourb=spval, default='inactive')
-
- this%eflx_sh_precip_conversion_col(begc:endc) = spval
- call hist_addfld1d (fname = 'FSH_PRECIP_CONVERSION', units='W/m^2', &
- avgflag='A', long_name='Sensible heat flux from conversion of rain/snow atm forcing', &
- ptr_col=this%eflx_sh_precip_conversion_col, c2l_scale_type='urbanf', default='inactive')
-
- this%eflx_lh_tot_u_patch(begp:endp) = spval
- call hist_addfld1d (fname='EFLX_LH_TOT_U', units='W/m^2', &
- avgflag='A', long_name='Urban total evaporation', &
- ptr_patch=this%eflx_lh_tot_u_patch, c2l_scale_type='urbanf', set_nourb=spval, default='inactive')
-
- this%eflx_soil_grnd_u_patch(begp:endp) = spval
- call hist_addfld1d (fname='FGR_U', units='W/m^2', &
- avgflag='A', long_name='Urban heat flux into soil/snow including snow melt', &
- ptr_patch=this%eflx_soil_grnd_u_patch, c2l_scale_type='urbanf', set_nourb=spval, default='inactive')
-
- this%netrad_patch(begp:endp) = spval
- call hist_addfld1d (fname='Rnet', units='W/m^2', &
- avgflag='A', long_name='net radiation', &
- ptr_patch=this%netrad_patch, c2l_scale_type='urbanf', &
- default='inactive')
-
- if (use_cn) then
- this%dlrad_patch(begp:endp) = spval
- call hist_addfld1d (fname='DLRAD', units='W/m^2', &
- avgflag='A', long_name='downward longwave radiation below the canopy', &
- ptr_patch=this%dlrad_patch, default='inactive', c2l_scale_type='urbanf')
- end if
-
- if (use_cn) then
- this%ulrad_patch(begp:endp) = spval
- call hist_addfld1d (fname='ULRAD', units='W/m^2', &
- avgflag='A', long_name='upward longwave radiation above the canopy', &
- ptr_patch=this%ulrad_patch, default='inactive', c2l_scale_type='urbanf')
- end if
-
- if (use_cn) then
- this%cgrnd_patch(begp:endp) = spval
- call hist_addfld1d (fname='CGRND', units='W/m^2/K', &
- avgflag='A', long_name='deriv. of soil energy flux wrt to soil temp', &
- ptr_patch=this%cgrnd_patch, default='inactive', c2l_scale_type='urbanf')
- end if
-
- if (use_cn) then
- this%cgrndl_patch(begp:endp) = spval
- call hist_addfld1d (fname='CGRNDL', units='W/m^2/K', &
- avgflag='A', long_name='deriv. of soil latent heat flux wrt soil temp', &
- ptr_patch=this%cgrndl_patch, default='inactive', c2l_scale_type='urbanf')
- end if
-
- if (use_cn) then
- this%cgrnds_patch(begp:endp) = spval
- call hist_addfld1d (fname='CGRNDS', units='W/m^2/K', &
- avgflag='A', long_name='deriv. of soil sensible heat flux wrt soil temp', &
- ptr_patch=this%cgrnds_patch, default='inactive', c2l_scale_type='urbanf')
- end if
-
- if (use_cn) then
- this%eflx_gnet_patch(begp:endp) = spval
- call hist_addfld1d (fname='EFLX_GNET', units='W/m^2', &
- avgflag='A', long_name='net heat flux into ground', &
- ptr_patch=this%eflx_gnet_patch, default='inactive', c2l_scale_type='urbanf')
- end if
-
- this%eflx_grnd_lake_patch(begp:endp) = spval
- call hist_addfld1d (fname='EFLX_GRND_LAKE', units='W/m^2', &
- avgflag='A', long_name='net heat flux into lake/snow surface, excluding light transmission', &
- ptr_patch=this%eflx_grnd_lake_patch, set_nolake=spval, default='inactive')
-
- if ( is_simple_buildtemp )then
- this%eflx_building_heat_errsoi_col(begc:endc) = spval
- call hist_addfld1d (fname='BUILDHEAT', units='W/m^2', &
- avgflag='A', long_name='heat flux from urban building interior to walls and roof', &
- ptr_col=this%eflx_building_heat_errsoi_col, set_nourb=0._r8, c2l_scale_type='urbanf', default='inactive')
-
- this%eflx_urban_ac_col(begc:endc) = spval
- call hist_addfld1d (fname='URBAN_AC', units='W/m^2', &
- avgflag='A', long_name='urban air conditioning flux', &
- ptr_col=this%eflx_urban_ac_col, set_nourb=0._r8, c2l_scale_type='urbanf', default='inactive')
-
- this%eflx_urban_heat_col(begc:endc) = spval
- call hist_addfld1d (fname='URBAN_HEAT', units='W/m^2', &
- avgflag='A', long_name='urban heating flux', &
- ptr_col=this%eflx_urban_heat_col, set_nourb=0._r8, c2l_scale_type='urbanf', default='inactive')
- else
- this%eflx_urban_ac_lun(begl:endl) = spval
- call hist_addfld1d (fname='EFLXBUILD', units='W/m^2', &
- avgflag='A', long_name='building heat flux from change in interior building air temperature', &
- ptr_lunit=this%eflx_building_lun, set_nourb=0._r8, l2g_scale_type='unity', default='inactive')
-
- this%eflx_urban_ac_lun(begl:endl) = spval
- call hist_addfld1d (fname='URBAN_AC', units='W/m^2', &
- avgflag='A', long_name='urban air conditioning flux', &
- ptr_lunit=this%eflx_urban_ac_lun, set_nourb=0._r8, l2g_scale_type='unity', default='inactive')
-
- this%eflx_urban_heat_lun(begl:endl) = spval
- call hist_addfld1d (fname='URBAN_HEAT', units='W/m^2', &
- avgflag='A', long_name='urban heating flux', &
- ptr_lunit=this%eflx_urban_heat_lun, set_nourb=0._r8, l2g_scale_type='unity', default='inactive')
- end if
-
-
- this%dgnetdT_patch(begp:endp) = spval
- call hist_addfld1d (fname='DGNETDT', units='W/m^2/K', &
- avgflag='A', long_name='derivative of net ground heat flux wrt soil temp', &
- ptr_patch=this%dgnetdT_patch, default='inactive', c2l_scale_type='urbanf')
-
- this%eflx_fgr12_col(begc:endc) = spval
- call hist_addfld1d (fname='FGR12', units='W/m^2', &
- avgflag='A', long_name='heat flux between soil layers 1 and 2', &
- ptr_col=this%eflx_fgr12_col, set_lake=spval, default='inactive')
-
- this%eflx_fgr_col(begc:endc,:) = spval
- call hist_addfld2d (fname='FGR_SOIL_R', units='watt/m^2', type2d='levgrnd', &
- avgflag='A', long_name='Rural downward heat flux at interface below each soil layer', &
- ptr_col=this%eflx_fgr_col, set_spec=spval, default='inactive')
-
- this%eflx_traffic_patch(begp:endp) = spval
- call hist_addfld1d (fname='TRAFFICFLUX', units='W/m^2', &
- avgflag='A', long_name='sensible heat flux from urban traffic', &
- ptr_patch=this%eflx_traffic_patch, set_nourb=0._r8, c2l_scale_type='urbanf', &
- default='inactive')
-
- this%eflx_wasteheat_patch(begp:endp) = spval
- call hist_addfld1d (fname='WASTEHEAT', units='W/m^2', &
- avgflag='A', long_name='sensible heat flux from heating/cooling sources of urban waste heat', &
- ptr_patch=this%eflx_wasteheat_patch, set_nourb=0._r8, c2l_scale_type='urbanf', default='inactive')
-
- this%eflx_heat_from_ac_patch(begp:endp) = spval
- call hist_addfld1d (fname='HEAT_FROM_AC', units='W/m^2', &
- avgflag='A', long_name='sensible heat flux put into canyon due to heat removed from air conditioning', &
- ptr_patch=this%eflx_heat_from_ac_patch, set_nourb=0._r8, c2l_scale_type='urbanf', default='inactive')
-
- if ( is_simple_buildtemp )then
- this%eflx_anthro_patch(begp:endp) = spval
- call hist_addfld1d (fname='Qanth', units='W/m^2', &
- avgflag='A', long_name='anthropogenic heat flux', &
- ptr_patch=this%eflx_anthro_patch, set_nourb=0._r8, c2l_scale_type='urbanf', &
- default='inactive')
- end if
-
- this%taux_patch(begp:endp) = spval
- call hist_addfld1d (fname='TAUX', units='kg/m/s^2', &
- avgflag='A', long_name='zonal surface stress', &
- ptr_patch=this%taux_patch, default='inactive')
- ! Rename of TAUX for Urban intercomparision project (when U=V)
- call hist_addfld1d (fname='Qtau', units='kg/m/s^2', &
- avgflag='A', long_name='momentum flux', &
- ptr_patch=this%taux_patch, default='inactive')
-
- this%tauy_patch(begp:endp) = spval
- call hist_addfld1d (fname='TAUY', units='kg/m/s^2', &
- avgflag='A', long_name='meridional surface stress', &
- ptr_patch=this%tauy_patch, default='inactive')
-
- this%btran_patch(begp:endp) = spval
- if (.not. use_hydrstress) then
- call hist_addfld1d (fname='BTRAN', units='unitless', &
- avgflag='A', long_name='transpiration beta factor', &
- ptr_patch=this%btran_patch, set_lake=spval, set_urb=spval, default='inactive')
- end if
-
- this%btran_min_patch(begp:endp) = spval
- call hist_addfld1d (fname='BTRANMN', units='unitless', &
- avgflag='A', long_name='daily minimum of transpiration beta factor', &
- ptr_patch=this%btran_min_patch, set_lake=spval, set_urb=spval, default='inactive')
-
- this%btran2_patch(begp:endp) = spval
- call hist_addfld1d (fname='BTRAN2', units='unitless', &
- avgflag='A', long_name='root zone soil wetness factor', &
- ptr_patch=this%btran2_patch, set_lake=spval, set_urb=spval, default='inactive')
-
- if (use_cn) then
- this%rresis_patch(begp:endp,:) = spval
- call hist_addfld2d (fname='RRESIS', units='proportion', type2d='levgrnd', &
- avgflag='A', long_name='root resistance in each soil layer', &
- ptr_patch=this%rresis_patch, default='inactive')
- end if
-
- this%errsoi_col(begc:endc) = spval
- call hist_addfld1d (fname='ERRSOI', units='W/m^2', &
- avgflag='A', long_name='soil/lake energy conservation error', &
- ptr_col=this%errsoi_col, default='inactive')
-
- this%errseb_patch(begp:endp) = spval
- call hist_addfld1d (fname='ERRSEB', units='W/m^2', &
- avgflag='A', long_name='surface energy conservation error', &
- ptr_patch=this%errseb_patch, default='inactive')
-
- this%errsol_patch(begp:endp) = spval
- call hist_addfld1d (fname='ERRSOL', units='W/m^2', &
- avgflag='A', long_name='solar radiation conservation error', &
- ptr_patch=this%errsol_patch, set_urb=spval, default='inactive')
-
- end subroutine InitHistory
-
- !-----------------------------------------------------------------------
- subroutine InitCold(this, bounds, t_grnd_col, is_simple_buildtemp, is_prog_buildtemp)
- !
- ! !DESCRIPTION:
- ! Initialize cold start conditions for module variables
- !
- ! !USES:
- use shr_kind_mod , only : r8 => shr_kind_r8
- use shr_const_mod , only : SHR_CONST_TKFRZ
- use clm_varpar , only : nlevsoi, nlevgrnd, nlevsno, nlevlak, nlevurb
- use clm_varcon , only : denice, denh2o, sb
- use landunit_varcon , only : istwet, istsoil, istdlak
- use column_varcon , only : icol_road_imperv, icol_roof, icol_sunwall
- use column_varcon , only : icol_shadewall, icol_road_perv
- use clm_varctl , only : iulog, use_vancouver, use_mexicocity
- implicit none
- !
- ! !ARGUMENTS:
- class(energyflux_type) :: this
- type(bounds_type) , intent(in) :: bounds
- real(r8) , intent(in) :: t_grnd_col( bounds%begc: )
- logical , intent(in) :: is_simple_buildtemp ! If using simple building temp method
- logical , intent(in) :: is_prog_buildtemp ! If using prognostic building temp method
- !
- ! !LOCAL VARIABLES:
- integer :: j,l,c,p,levs,lev
- !-----------------------------------------------------------------------
-
- SHR_ASSERT_ALL((ubound(t_grnd_col) == (/bounds%endc/)), errMsg(sourcefile, __LINE__))
-
- ! Columns
- if ( is_simple_buildtemp )then
- do c = bounds%begc, bounds%endc
- l = col%landunit(c)
-
- if (lun%urbpoi(l)) then
- this%eflx_building_heat_errsoi_col(c) = 0._r8
- this%eflx_urban_ac_col(c) = 0._r8
- this%eflx_urban_heat_col(c) = 0._r8
- else
- this%eflx_building_heat_errsoi_col(c) = 0._r8
- this%eflx_urban_ac_col(c) = 0._r8
- this%eflx_urban_heat_col(c) = 0._r8
- end if
-
- end do
- end if
-
- ! Patches
- do p = bounds%begp, bounds%endp
- c = patch%column(p)
- l = patch%landunit(p)
-
- if (.not. lun%urbpoi(l)) then ! non-urban
- this%eflx_lwrad_net_u_patch(p) = spval
- this%eflx_lwrad_out_u_patch(p) = spval
- this%eflx_lh_tot_u_patch(p) = spval
- this%eflx_sh_tot_u_patch(p) = spval
- this%eflx_soil_grnd_u_patch(p) = spval
- end if
-
- this%eflx_lwrad_out_patch(p) = sb * (t_grnd_col(c))**4
- end do
-
- ! patches
- do p = bounds%begp, bounds%endp
- l = patch%landunit(p)
-
- if (.not. lun%urbpoi(l)) then
- this%eflx_traffic_lun(l) = spval
- this%eflx_wasteheat_lun(l) = spval
- if ( is_prog_buildtemp )then
- this%eflx_building_lun(l) = 0._r8
- this%eflx_urban_ac_lun(l) = 0._r8
- this%eflx_urban_heat_lun(l) = 0._r8
- end if
-
- this%eflx_wasteheat_patch(p) = 0._r8
- this%eflx_heat_from_ac_patch(p) = 0._r8
- this%eflx_traffic_patch(p) = 0._r8
- if ( is_simple_buildtemp) &
- this%eflx_anthro_patch(p) = 0._r8
- else
- if ( is_prog_buildtemp )then
- this%eflx_building_lun(l) = 0._r8
- this%eflx_urban_ac_lun(l) = 0._r8
- this%eflx_urban_heat_lun(l) = 0._r8
- end if
- end if
- end do
-
- ! initialize rresis, for use in ecosystemdyn
- do p = bounds%begp,bounds%endp
- do lev = 1,nlevgrnd
- this%rresis_patch(p,lev) = 0._r8
- end do
- end do
-
- end subroutine InitCold
-
- !------------------------------------------------------------------------
- subroutine Restart(this, bounds, ncid, flag, is_simple_buildtemp, is_prog_buildtemp)
- !
- ! !DESCRIPTION:
- ! Read/Write module information to/from restart file.
- !
- ! !USES:
- use shr_log_mod, only : errMsg => shr_log_errMsg
- use spmdMod , only : masterproc
- use abortutils , only : endrun
- use ncdio_pio , only : file_desc_t, ncd_defvar, ncd_io, ncd_double, ncd_int, &
- ncd_inqvdlen
- use restUtilMod
- use decompMod , only : get_proc_global
- implicit none
- !
- ! !ARGUMENTS:
- class(energyflux_type) :: this
- type(bounds_type), intent(in) :: bounds
- type(file_desc_t), intent(inout) :: ncid
- character(len=*) , intent(in) :: flag
- logical , intent(in) :: is_simple_buildtemp ! If using simple building temp method
- logical , intent(in) :: is_prog_buildtemp ! If using prognostic building temp method
- !
- ! !LOCAL VARIABLES:
- integer :: j,c ! indices
- integer :: dimlen
- integer :: err_code
- integer :: numl_global
- logical :: readvar ! determine if variable is on initial file
- logical :: do_io
- !-----------------------------------------------------------------------
-
- call get_proc_global(nl=numl_global)
- call restartvar(ncid=ncid, flag=flag, varname='EFLX_LWRAD_OUT', xtype=ncd_double, &
- dim1name='pft', &
- long_name='emitted infrared (longwave) radiation', units='watt/m^2', &
- interpinic_flag='interp', readvar=readvar, data=this%eflx_lwrad_out_patch)
-
- ! Restart for building air temperature method
- if ( is_prog_buildtemp )then
- ! landunit urban energy state variable - eflx_urban_ac
- do_io = .true.
- ! On a read, confirm that this variable has the expected size (landunit-level); if not,
- ! don't read it (instead give it a default value). This is needed to support older initial
- ! conditions for which this variable had a different size (column-level).
- if (flag == 'read') then
- call ncd_inqvdlen(ncid, 'URBAN_AC_L', 1, dimlen, err_code)
- if (dimlen /= numl_global) then
- do_io = .false.
- readvar = .false.
- end if
- end if
- if (do_io) then
- call restartvar(ncid=ncid, flag=flag, varname='URBAN_AC_L', xtype=ncd_double, &
- dim1name='landunit',&
- long_name='urban air conditioning flux', units='watt/m^2', &
- interpinic_flag='interp', readvar=readvar, data=this%eflx_urban_ac_lun)
- else
- this%eflx_urban_ac_lun = 0.0_r8
- end if
- ! landunit urban energy state variable - eflx_urban_heat
- do_io = .true.
- ! On a read, confirm that this variable has the expected size (landunit-level); if not,
- ! don't read it (instead give it a default value). This is needed to support older initial
- ! conditions for which this variable had a different size (column-level).
- if (flag == 'read') then
- call ncd_inqvdlen(ncid, 'URBAN_HEAT_L', 1, dimlen, err_code)
- if (dimlen /= numl_global) then
- do_io = .false.
- readvar = .false.
- end if
- end if
- if (do_io) then
- call restartvar(ncid=ncid, flag=flag, varname='URBAN_HEAT_L', xtype=ncd_double, &
- dim1name='landunit',&
- long_name='urban heating flux', units='watt/m^2', &
- interpinic_flag='interp', readvar=readvar, data=this%eflx_urban_heat_lun)
- else
- this%eflx_urban_heat_lun = 0.0_r8
- end if
- else if ( is_simple_buildtemp )then
- call restartvar(ncid=ncid, flag=flag, varname='URBAN_AC', xtype=ncd_double, &
- dim1name='column', &
- long_name='urban air conditioning flux', units='watt/m^2', &
- interpinic_flag='interp', readvar=readvar, data=this%eflx_urban_ac_col)
- call restartvar(ncid=ncid, flag=flag, varname='URBAN_HEAT', xtype=ncd_double, &
- dim1name='column', &
- long_name='urban heating flux', units='watt/m^2', &
- interpinic_flag='interp', readvar=readvar, data=this%eflx_urban_heat_col)
- end if
-
- call restartvar(ncid=ncid, flag=flag, varname='btran2', xtype=ncd_double, &
- dim1name='pft', &
- long_name='', units='', &
- interpinic_flag='interp', readvar=readvar, data=this%btran2_patch)
-
- call restartvar(ncid=ncid, flag=flag, varname='BTRAN_MIN', xtype=ncd_double, &
- dim1name='pft', &
- long_name='daily minimum of transpiration wetness factor', units='', &
- interpinic_flag='interp', readvar=readvar, data=this%btran_min_patch)
-
- call restartvar(ncid=ncid, flag=flag, varname='BTRAN_MIN_INST', xtype=ncd_double, &
- dim1name='pft', &
- long_name='instantaneous daily minimum of transpiration wetness factor', units='', &
- interpinic_flag='interp', readvar=readvar, data=this%btran_min_inst_patch)
-
- call restartvar(ncid=ncid, flag=flag, varname='eflx_grnd_lake', xtype=ncd_double, &
- dim1name='pft', &
- long_name='net heat flux into lake/snow surface, excluding light transmission', units='W/m^2', &
- interpinic_flag='interp', readvar=readvar, data=this%eflx_grnd_lake_patch)
-
- end subroutine Restart
- !-----------------------------------------------------------------------
- subroutine InitAccBuffer (this, bounds)
- !
- ! !DESCRIPTION:
- ! Initialize accumulation buffer for all required module accumulated fields
- ! This routine set defaults values that are then overwritten by the
- ! restart file for restart or branch runs
- ! Each interval and accumulation type is unique to each field processed.
- ! Routine [initAccBuffer] defines the fields to be processed
- ! and the type of accumulation.
- ! Routine [updateAccVars] does the actual accumulation for a given field.
- ! Fields are accumulated by calls to subroutine [update_accum_field].
- ! To accumulate a field, it must first be defined in subroutine [initAccVars]
- ! and then accumulated by calls to [updateAccVars].
- ! Four types of accumulations are possible:
- ! o average over time interval
- ! o running mean over time interval
- ! o running accumulation over time interval
- ! Time average fields are only valid at the end of the averaging interval.
- ! Running means are valid once the length of the simulation exceeds the
- ! averaging interval. Accumulated fields are continuously accumulated.
- ! The trigger value "-99999." resets the accumulation to zero.
- !
- ! !USES
- use accumulMod , only : init_accum_field
- use clm_time_manager , only : get_step_size
- use shr_const_mod , only : SHR_CONST_CDAY, SHR_CONST_TKFRZ
- !
- ! !ARGUMENTS:
- class(energyflux_type) :: this
- type(bounds_type), intent(in) :: bounds
- !
- ! !LOCAL VARIABLES:
- real(r8) :: dtime
- integer, parameter :: not_used = huge(1)
- !---------------------------------------------------------------------
-
- dtime = get_step_size()
-
- call init_accum_field(name='BTRANAV', units='-', &
- desc='average over an hour of btran', accum_type='timeavg', accum_period=nint(3600._r8/dtime), &
- subgrid_type='pft', numlev=1, init_value=0._r8)
-
- end subroutine InitAccBuffer
- !-----------------------------------------------------------------------
- subroutine InitAccVars(this, bounds)
- !
- ! !DESCRIPTION:
- ! Initialize module variables that are associated with
- ! time accumulated fields. This routine is called for both an initial run
- ! and a restart run (and must therefore must be called after the restart file
- ! is read in and the accumulation buffer is obtained)
- !
- ! !USES
- use accumulMod , only : init_accum_field, extract_accum_field
- use clm_time_manager , only : get_nstep
- use clm_varctl , only : nsrest, nsrStartup
- use abortutils , only : endrun
- !
- ! !ARGUMENTS:
- class(energyflux_type) :: this
- type(bounds_type), intent(in) :: bounds
- !
- ! !LOCAL VARIABLES:
- integer :: begp, endp
- integer :: nstep
- integer :: ier
- !---------------------------------------------------------------------
-
- begp = bounds%begp; endp = bounds%endp
-
- ! Initialize variables that are to be time accumulated
- ! Initialize btran min values
- if (nsrest == nsrStartup) then
- this%btran_min_patch(begp:endp) = spval
-
- this%btran_min_inst_patch(begp:endp) = spval
- end if
-
- end subroutine InitAccVars
- !-----------------------------------------------------------------------
- subroutine UpdateAccVars (this, bounds)
- !
- ! USES
- use shr_const_mod , only : SHR_CONST_CDAY, SHR_CONST_TKFRZ
- use clm_time_manager , only : get_step_size, get_nstep, is_end_curr_day, get_curr_date
- use accumulMod , only : update_accum_field, extract_accum_field, accumResetVal
- use clm_varctl , only : iulog
- use abortutils , only : endrun
- !
- ! !ARGUMENTS:
- class(energyflux_type) :: this
- type(bounds_type) , intent(in) :: bounds
-
- !
- ! !LOCAL VARIABLES:
- integer :: m,g,l,c,p ! indices
- integer :: ier ! error status
- integer :: dtime ! timestep size [seconds]
- integer :: nstep ! timestep number
- integer :: year ! year (0, ...) for nstep
- integer :: month ! month (1, ..., 12) for nstep
- integer :: day ! day of month (1, ..., 31) for nstep
- integer :: secs ! seconds into current date for nstep
- logical :: end_cd ! temporary for is_end_curr_day() value
- integer :: begp, endp
- real(r8), pointer :: rbufslp(:) ! temporary single level - pft level
- !---------------------------------------------------------------------
-
- begp = bounds%begp; endp = bounds%endp
-
- dtime = get_step_size()
- nstep = get_nstep()
- call get_curr_date (year, month, day, secs)
-
- ! Allocate needed dynamic memory for single level pft field
-
- allocate(rbufslp(begp:endp), stat=ier)
- if (ier/=0) then
- write(iulog,*)'update_accum_hist allocation error for rbuf1dp'
- call endrun(msg=errMsg(__FILE__, __LINE__))
- endif
-
- ! Accumulate and extract BTRANAV - hourly average btran
- ! Used to compute minimum of hourly averaged btran
- ! over a day. Note that "spval" is returned by the call to
- ! accext if the time step does not correspond to the end of an
- ! accumulation interval. First, initialize the necessary values for
- ! an initial run at the first time step the accumulator is called
-
- call update_accum_field ('BTRANAV', this%btran_patch, nstep)
- call extract_accum_field ('BTRANAV', rbufslp, nstep)
- end_cd = is_end_curr_day()
- do p = begp,endp
- if (rbufslp(p) /= spval) then
- this%btran_min_inst_patch(p) = min(rbufslp(p), this%btran_min_inst_patch(p))
- endif
- if (end_cd) then
- this%btran_min_patch(p) = this%btran_min_inst_patch(p)
- this%btran_min_inst_patch(p) = spval
- else if (secs == dtime) then
- this%btran_min_patch(p) = spval
- endif
- end do
-
- deallocate(rbufslp)
-
- end subroutine UpdateAccVars
-
-end module EnergyFluxType
diff --git a/src/biogeophys/FrictionVelocityMod.F90 b/src/biogeophys/FrictionVelocityMod.F90
deleted file mode 100644
index 46ce6087..00000000
--- a/src/biogeophys/FrictionVelocityMod.F90
+++ /dev/null
@@ -1,772 +0,0 @@
-module FrictionVelocityMod
-
-#include "shr_assert.h"
-
- !------------------------------------------------------------------------------
- ! !DESCRIPTION:
- ! Calculation of the friction velocity, relation for potential
- ! temperature and humidity profiles of surface boundary layer.
- !
- ! !USES:
- use shr_kind_mod , only : r8 => shr_kind_r8
- use shr_log_mod , only : errMsg => shr_log_errMsg
- use decompMod , only : bounds_type
- use clm_varcon , only : spval
- use clm_varctl , only : use_cn, use_luna
- use LandunitType , only : lun
- use ColumnType , only : col
- use PatchType , only : patch
- !
- ! !PUBLIC TYPES:
- implicit none
- save
- !
- ! !PUBLIC MEMBER FUNCTIONS:
- public :: FrictionVelocity ! Calculate friction velocity
- public :: MoninObukIni ! Initialization of the Monin-Obukhov length
- !
- ! !PRIVATE MEMBER FUNCTIONS:
- private :: StabilityFunc1 ! Stability function for rib < 0.
- private :: StabilityFunc2 ! Stability function for rib < 0.
-
- type, public :: frictionvel_type
-
- ! Roughness length/resistance for friction velocity calculation
-
- real(r8), pointer, public :: forc_hgt_u_patch (:) ! patch wind forcing height (10m+z0m+d) (m)
- real(r8), pointer, public :: forc_hgt_t_patch (:) ! patch temperature forcing height (10m+z0m+d) (m)
- real(r8), pointer, public :: forc_hgt_q_patch (:) ! patch specific humidity forcing height (10m+z0m+d) (m)
- real(r8), pointer, public :: u10_patch (:) ! patch 10-m wind (m/s) (for dust model)
- real(r8), pointer, public :: u10_clm_patch (:) ! patch 10-m wind (m/s) (for clm_map2gcell)
- real(r8), pointer, public :: va_patch (:) ! patch atmospheric wind speed plus convective velocity (m/s)
- real(r8), pointer, public :: vds_patch (:) ! patch deposition velocity term (m/s) (for dry dep SO4, NH4NO3)
- real(r8), pointer, public :: fv_patch (:) ! patch friction velocity (m/s) (for dust model)
- real(r8), pointer, public :: rb1_patch (:) ! patch aerodynamical resistance (s/m) (for dry deposition of chemical tracers)
- real(r8), pointer, public :: rb10_patch (:) ! 10-day mean patch aerodynamical resistance (s/m) (for LUNA model)
- real(r8), pointer, public :: ram1_patch (:) ! patch aerodynamical resistance (s/m)
- real(r8), pointer, public :: z0m_patch (:) ! patch momentum roughness length (m)
- real(r8), pointer, public :: z0mv_patch (:) ! patch roughness length over vegetation, momentum [m]
- real(r8), pointer, public :: z0hv_patch (:) ! patch roughness length over vegetation, sensible heat [m]
- real(r8), pointer, public :: z0qv_patch (:) ! patch roughness length over vegetation, latent heat [m]
- real(r8), pointer, public :: z0mg_col (:) ! col roughness length over ground, momentum [m]
- real(r8), pointer, public :: z0hg_col (:) ! col roughness length over ground, sensible heat [m]
- real(r8), pointer, public :: z0qg_col (:) ! col roughness length over ground, latent heat [m]
-
- contains
-
- ! Public procedures
- procedure, public :: Init
- procedure, public :: Restart
-
- ! Private procedures
- procedure, private :: InitAllocate
- procedure, private :: InitHistory
- procedure, private :: InitCold
-
- end type frictionvel_type
-
- type, public :: frictionvel_parms_type
- real(r8) :: zetamaxstable ! Max value zeta ("height" used in Monin-Obukhov theory) can go to under stable conditions
- end type frictionvel_parms_type
-
- character(len=*), parameter, private :: sourcefile = &
- __FILE__
- !------------------------------------------------------------------------------
-
- type(frictionvel_parms_type), public, protected :: frictionvel_parms_inst
-
-contains
-
- !------------------------------------------------------------------------
- subroutine Init(this, bounds)
-
- class(frictionvel_type) :: this
- type(bounds_type), intent(in) :: bounds
-
- call this%InitAllocate(bounds)
- call this%InitHistory(bounds)
- call this%InitCold(bounds)
-
- end subroutine Init
-
- !------------------------------------------------------------------------
- subroutine InitAllocate(this, bounds)
- !
- ! !DESCRIPTION:
- ! Initialize module data structure
- !
- ! !USES:
- use shr_infnan_mod , only : nan => shr_infnan_nan, assignment(=)
- !
- ! !ARGUMENTS:
- class(frictionvel_type) :: this
- type(bounds_type), intent(in) :: bounds
- !
- ! !LOCAL VARIABLES:
- integer :: begp, endp
- integer :: begc, endc
- !------------------------------------------------------------------------
-
- begp = bounds%begp; endp= bounds%endp
- begc = bounds%begc; endc= bounds%endc
-
- allocate(this%forc_hgt_u_patch (begp:endp)) ; this%forc_hgt_u_patch (:) = nan
- allocate(this%forc_hgt_t_patch (begp:endp)) ; this%forc_hgt_t_patch (:) = nan
- allocate(this%forc_hgt_q_patch (begp:endp)) ; this%forc_hgt_q_patch (:) = nan
- allocate(this%u10_patch (begp:endp)) ; this%u10_patch (:) = nan
- allocate(this%u10_clm_patch (begp:endp)) ; this%u10_clm_patch (:) = nan
- allocate(this%va_patch (begp:endp)) ; this%va_patch (:) = nan
- allocate(this%vds_patch (begp:endp)) ; this%vds_patch (:) = nan
- allocate(this%fv_patch (begp:endp)) ; this%fv_patch (:) = nan
- allocate(this%rb1_patch (begp:endp)) ; this%rb1_patch (:) = nan
- allocate(this%rb10_patch (begp:endp)) ; this%rb10_patch (:) = spval
- allocate(this%ram1_patch (begp:endp)) ; this%ram1_patch (:) = nan
- allocate(this%z0m_patch (begp:endp)) ; this%z0m_patch (:) = nan
- allocate(this%z0mv_patch (begp:endp)) ; this%z0mv_patch (:) = nan
- allocate(this%z0hv_patch (begp:endp)) ; this%z0hv_patch (:) = nan
- allocate(this%z0qv_patch (begp:endp)) ; this%z0qv_patch (:) = nan
- allocate(this%z0mg_col (begc:endc)) ; this%z0mg_col (:) = nan
- allocate(this%z0qg_col (begc:endc)) ; this%z0qg_col (:) = nan
- allocate(this%z0hg_col (begc:endc)) ; this%z0hg_col (:) = nan
-
- end subroutine InitAllocate
-
- !-----------------------------------------------------------------------
- subroutine InitHistory(this, bounds)
- !
- ! History fields initialization
- !
- ! !USES:
- use shr_infnan_mod, only: nan => shr_infnan_nan, assignment(=)
- use histFileMod , only: hist_addfld1d, hist_addfld2d
- !
- ! !ARGUMENTS:
- class(frictionvel_type) :: this
- type(bounds_type), intent(in) :: bounds
- !
- ! !LOCAL VARIABLES:
- integer :: begc, endc
- integer :: begp, endp
- !---------------------------------------------------------------------
-
- begp = bounds%begp; endp= bounds%endp
- begc = bounds%begc; endc= bounds%endc
-
- this%z0mg_col(begc:endc) = spval
- call hist_addfld1d (fname='Z0MG', units='m', &
- avgflag='A', long_name='roughness length over ground, momentum', &
- ptr_col=this%z0mg_col, default='inactive')
-
- this%z0hg_col(begc:endc) = spval
- call hist_addfld1d (fname='Z0HG', units='m', &
- avgflag='A', long_name='roughness length over ground, sensible heat', &
- ptr_col=this%z0hg_col, default='inactive')
-
- this%z0qg_col(begc:endc) = spval
- call hist_addfld1d (fname='Z0QG', units='m', &
- avgflag='A', long_name='roughness length over ground, latent heat', &
- ptr_col=this%z0qg_col, default='inactive')
-
- this%va_patch(begp:endp) = spval
- call hist_addfld1d (fname='VA', units='m/s', &
- avgflag='A', long_name='atmospheric wind speed plus convective velocity', &
- ptr_patch=this%va_patch, default='inactive')
-
- this%u10_clm_patch(begp:endp) = spval
- call hist_addfld1d (fname='U10', units='m/s', &
- avgflag='A', long_name='10-m wind', &
- ptr_patch=this%u10_clm_patch, default='inactive')
-
- call hist_addfld1d (fname='U10_ICE', units='m/s', &
- avgflag='A', long_name='10-m wind (ice landunits only)', &
- ptr_patch=this%u10_clm_patch, l2g_scale_type='ice', default='inactive')
-
- this%u10_patch(begp:endp) = spval
- call hist_addfld1d (fname='U10_DUST', units='m/s', &
- avgflag='A', long_name='10-m wind for dust model', &
- ptr_patch=this%u10_patch, default='inactive')
-
- if (use_cn) then
- this%ram1_patch(begp:endp) = spval
- call hist_addfld1d (fname='RAM1', units='s/m', &
- avgflag='A', long_name='aerodynamical resistance ', &
- ptr_patch=this%ram1_patch, default='inactive')
- end if
-
- if (use_cn) then
- this%fv_patch(begp:endp) = spval
- call hist_addfld1d (fname='FV', units='m/s', &
- avgflag='A', long_name='friction velocity for dust model', &
- ptr_patch=this%fv_patch, default='inactive')
- end if
-
- if (use_cn) then
- this%z0hv_patch(begp:endp) = spval
- call hist_addfld1d (fname='Z0HV', units='m', &
- avgflag='A', long_name='roughness length over vegetation, sensible heat', &
- ptr_patch=this%z0hv_patch, default='inactive')
- end if
-
- if (use_cn) then
- this%z0m_patch(begp:endp) = spval
- call hist_addfld1d (fname='Z0M', units='m', &
- avgflag='A', long_name='momentum roughness length', &
- ptr_patch=this%z0m_patch, default='inactive')
- end if
-
- if (use_cn) then
- this%z0mv_patch(begp:endp) = spval
- call hist_addfld1d (fname='Z0MV', units='m', &
- avgflag='A', long_name='roughness length over vegetation, momentum', &
- ptr_patch=this%z0mv_patch, default='inactive')
- end if
-
- if (use_cn) then
- this%z0qv_patch(begp:endp) = spval
- call hist_addfld1d (fname='Z0QV', units='m', &
- avgflag='A', long_name='roughness length over vegetation, latent heat', &
- ptr_patch=this%z0qv_patch, default='inactive')
- end if
-
- if (use_luna) then
- call hist_addfld1d (fname='RB10', units='s/m', &
- avgflag='A', long_name='10 day running mean boundary layer resistance', &
- ptr_patch=this%rb10_patch, default='inactive')
- end if
-
- end subroutine InitHistory
-
- !-----------------------------------------------------------------------
- subroutine InitCold(this, bounds)
- !
- ! Initialize module surface albedos to reasonable values
- !
- ! !ARGUMENTS:
- class(frictionvel_type) :: this
- type(bounds_type), intent(in) :: bounds
- !
- ! !LOCAL VARIABLES:
- integer :: p, c, l ! indices
- !-----------------------------------------------------------------------
-
- ! Added 5/4/04, PET: initialize forc_hgt_u (gridcell-level),
- ! since this is not initialized before first call to CNVegStructUpdate,
- ! and it is required to set the upper bound for canopy top height.
- ! Changed 3/21/08, KO: still needed but don't have sufficient information
- ! to set this properly (e.g., patch-level displacement height and roughness
- ! length). So leave at 30m.
-
- if (use_cn) then
- do p = bounds%begp, bounds%endp
- this%forc_hgt_u_patch(p) = 30._r8
- end do
- end if
-
- do c = bounds%begc, bounds%endc
- l = col%landunit(c)
- if (lun%lakpoi(l)) then !lake
- this%z0mg_col(c) = 0.0004_r8
- end if
- end do
-
- end subroutine InitCold
-
- !------------------------------------------------------------------------
- subroutine Restart(this, bounds, ncid, flag)
- !
- ! !DESCRIPTION:
- ! Read/Write module information to/from restart file.
- !
- ! !USES:
- use spmdMod , only : masterproc
- use ncdio_pio , only : file_desc_t, ncd_defvar, ncd_io, ncd_double, ncd_int, ncd_inqvdlen
- use restUtilMod
- !
- ! !ARGUMENTS:
- class(frictionvel_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
- !-----------------------------------------------------------------------
-
- call restartvar(ncid=ncid, flag=flag, varname='Z0MG', xtype=ncd_double, &
- dim1name='column', &
- long_name='ground momentum roughness length', units='m', &
- interpinic_flag='interp', readvar=readvar, data=this%z0mg_col)
-
- if(use_luna)then
- call restartvar(ncid=ncid, flag=flag, varname='rb10', xtype=ncd_double, &
- dim1name='pft', long_name='10-day mean boundary layer resistance at the pacth', units='s/m', &
- interpinic_flag='interp', readvar=readvar, data=this%rb10_patch)
- endif
-
- end subroutine Restart
-
- !------------------------------------------------------------------------------
- subroutine FrictionVelocity(lbn, ubn, fn, filtern, &
- displa, z0m, z0h, z0q, &
- obu, iter, ur, um, ustar, &
- temp1, temp2, temp12m, temp22m, fm, frictionvel_inst, landunit_index)
- !
- ! !DESCRIPTION:
- ! Calculation of the friction velocity, relation for potential
- ! temperature and humidity profiles of surface boundary layer.
- ! The scheme is based on the work of Zeng et al. (1998):
- ! Intercomparison of bulk aerodynamic algorithms for the computation
- ! of sea surface fluxes using TOGA CORE and TAO data. J. Climate,
- ! Vol. 11, 2628-2644.
- !
- ! !USES:
- use clm_varcon, only : vkc
- use clm_varctl, only : iulog
- !
- ! !ARGUMENTS:
- integer , intent(in) :: lbn, ubn ! pft/landunit array bounds
- integer , intent(in) :: fn ! number of filtered pft/landunit elements
- integer , intent(in) :: filtern(fn) ! pft/landunit filter
- real(r8) , intent(in) :: displa ( lbn: ) ! displacement height (m) [lbn:ubn]
- real(r8) , intent(in) :: z0m ( lbn: ) ! roughness length over vegetation, momentum [m] [lbn:ubn]
- real(r8) , intent(in) :: z0h ( lbn: ) ! roughness length over vegetation, sensible heat [m] [lbn:ubn]
- real(r8) , intent(in) :: z0q ( lbn: ) ! roughness length over vegetation, latent heat [m] [lbn:ubn]
- real(r8) , intent(in) :: obu ( lbn: ) ! monin-obukhov length (m) [lbn:ubn]
- integer , intent(in) :: iter ! iteration number
- real(r8) , intent(in) :: ur ( lbn: ) ! wind speed at reference height [m/s] [lbn:ubn]
- real(r8) , intent(in) :: um ( lbn: ) ! wind speed including the stablity effect [m/s] [lbn:ubn]
- real(r8) , intent(out) :: ustar ( lbn: ) ! friction velocity [m/s] [lbn:ubn]
- real(r8) , intent(out) :: temp1 ( lbn: ) ! relation for potential temperature profile [lbn:ubn]
- real(r8) , intent(out) :: temp12m ( lbn: ) ! relation for potential temperature profile applied at 2-m [lbn:ubn]
- real(r8) , intent(out) :: temp2 ( lbn: ) ! relation for specific humidity profile [lbn:ubn]
- real(r8) , intent(out) :: temp22m ( lbn: ) ! relation for specific humidity profile applied at 2-m [lbn:ubn]
- real(r8) , intent(inout) :: fm ( lbn: ) ! diagnose 10m wind (DUST only) [lbn:ubn]
- type(frictionvel_type) , intent(inout) :: frictionvel_inst
- logical , intent(in), optional :: landunit_index ! optional argument that defines landunit or pft level
- !
- ! !LOCAL VARIABLES:
- real(r8), parameter :: zetam = 1.574_r8 ! transition point of flux-gradient relation (wind profile)
- real(r8), parameter :: zetat = 0.465_r8 ! transition point of flux-gradient relation (temp. profile)
- integer :: f ! pft/landunit filter index
- integer :: n ! pft/landunit index
- integer :: g ! gridcell index
- integer :: pp ! pfti,pftf index
- real(r8) :: zldis(lbn:ubn) ! reference height "minus" zero displacement heght [m]
- real(r8) :: zeta(lbn:ubn) ! dimensionless height used in Monin-Obukhov theory
- real(r8) :: tmp1,tmp2,tmp3,tmp4 ! Used to diagnose the 10 meter wind
- real(r8) :: fmnew ! Used to diagnose the 10 meter wind
- real(r8) :: fm10 ! Used to diagnose the 10 meter wind
- real(r8) :: zeta10 ! Used to diagnose the 10 meter wind
- real(r8) :: vds_tmp ! Temporary for dry deposition velocity
- !------------------------------------------------------------------------------
-
- ! Enforce expected array sizes
- SHR_ASSERT_ALL((ubound(displa) == (/ubn/)), errMsg(sourcefile, __LINE__))
- SHR_ASSERT_ALL((ubound(z0m) == (/ubn/)), errMsg(sourcefile, __LINE__))
- SHR_ASSERT_ALL((ubound(z0h) == (/ubn/)), errMsg(sourcefile, __LINE__))
- SHR_ASSERT_ALL((ubound(z0q) == (/ubn/)), errMsg(sourcefile, __LINE__))
- SHR_ASSERT_ALL((ubound(obu) == (/ubn/)), errMsg(sourcefile, __LINE__))
- SHR_ASSERT_ALL((ubound(ur) == (/ubn/)), errMsg(sourcefile, __LINE__))
- SHR_ASSERT_ALL((ubound(um) == (/ubn/)), errMsg(sourcefile, __LINE__))
- SHR_ASSERT_ALL((ubound(ustar) == (/ubn/)), errMsg(sourcefile, __LINE__))
- SHR_ASSERT_ALL((ubound(temp1) == (/ubn/)), errMsg(sourcefile, __LINE__))
- SHR_ASSERT_ALL((ubound(temp12m) == (/ubn/)), errMsg(sourcefile, __LINE__))
- SHR_ASSERT_ALL((ubound(temp2) == (/ubn/)), errMsg(sourcefile, __LINE__))
- SHR_ASSERT_ALL((ubound(temp22m) == (/ubn/)), errMsg(sourcefile, __LINE__))
- SHR_ASSERT_ALL((ubound(fm) == (/ubn/)), errMsg(sourcefile, __LINE__))
-
- associate( &
- pfti => lun%patchi , & ! Input: [integer (:) ] beginning pfti index for landunit
- pftf => lun%patchf , & ! Input: [integer (:) ] final pft index for landunit
-
- forc_hgt_u_patch => frictionvel_inst%forc_hgt_u_patch , & ! Input: [real(r8) (:) ] observational height of wind at pft level [m]
- forc_hgt_t_patch => frictionvel_inst%forc_hgt_t_patch , & ! Input: [real(r8) (:) ] observational height of temperature at pft level [m]
- forc_hgt_q_patch => frictionvel_inst%forc_hgt_q_patch , & ! Input: [real(r8) (:) ] observational height of specific humidity at pft level [m]
- vds => frictionvel_inst%vds_patch , & ! Output: [real(r8) (:) ] dry deposition velocity term (m/s) (for SO4 NH4NO3)
- u10 => frictionvel_inst%u10_patch , & ! Output: [real(r8) (:) ] 10-m wind (m/s) (for dust model)
- u10_clm => frictionvel_inst%u10_clm_patch , & ! Output: [real(r8) (:) ] 10-m wind (m/s)
- va => frictionvel_inst%va_patch , & ! Output: [real(r8) (:) ] atmospheric wind speed plus convective velocity (m/s)
- fv => frictionvel_inst%fv_patch & ! Output: [real(r8) (:) ] friction velocity (m/s) (for dust model)
- )
-
- ! Adjustment factors for unstable (moz < 0) or stable (moz > 0) conditions.
-
- do f = 1, fn
- n = filtern(f)
- if (present(landunit_index)) then
- g = lun%gridcell(n)
- else
- g = patch%gridcell(n)
- end if
-
- ! Wind profile
-
- if (present(landunit_index)) then
- zldis(n) = forc_hgt_u_patch(pfti(n))-displa(n)
- else
- zldis(n) = forc_hgt_u_patch(n)-displa(n)
- end if
- zeta(n) = zldis(n)/obu(n)
- if (zeta(n) < -zetam) then
- ustar(n) = vkc*um(n)/(log(-zetam*obu(n)/z0m(n))&
- - StabilityFunc1(-zetam) &
- + StabilityFunc1(z0m(n)/obu(n)) &
- + 1.14_r8*((-zeta(n))**0.333_r8-(zetam)**0.333_r8))
- else if (zeta(n) < 0._r8) then
- ustar(n) = vkc*um(n)/(log(zldis(n)/z0m(n))&
- - StabilityFunc1(zeta(n))&
- + StabilityFunc1(z0m(n)/obu(n)))
- else if (zeta(n) <= 1._r8) then
- ustar(n) = vkc*um(n)/(log(zldis(n)/z0m(n)) + 5._r8*zeta(n) -5._r8*z0m(n)/obu(n))
- else
- ustar(n) = vkc*um(n)/(log(obu(n)/z0m(n))+5._r8-5._r8*z0m(n)/obu(n) &
- +(5._r8*log(zeta(n))+zeta(n)-1._r8))
- end if
-
- if (zeta(n) < 0._r8) then
- vds_tmp = 2.e-3_r8*ustar(n) * ( 1._r8 + (300._r8/(-obu(n)))**0.666_r8)
- else
- vds_tmp = 2.e-3_r8*ustar(n)
- endif
-
- if (present(landunit_index)) then
- do pp = pfti(n),pftf(n)
- vds(pp) = vds_tmp
- end do
- else
- vds(n) = vds_tmp
- end if
-
- ! Calculate a 10-m wind (10m + z0m + d)
- ! For now, this will not be the same as the 10-m wind calculated for the dust
- ! model because the CLM stability functions are used here, not the LSM stability
- ! functions used in the dust model. We will eventually change the dust model to be
- ! consistent with the following formulation.
- ! Note that the 10-m wind calculated this way could actually be larger than the
- ! atmospheric forcing wind because 1) this includes the convective velocity, 2)
- ! this includes the 1 m/s minimum wind threshold
-
- ! If forcing height is less than or equal to 10m, then set 10-m wind to um
- if (present(landunit_index)) then
- do pp = pfti(n),pftf(n)
- if (zldis(n)-z0m(n) <= 10._r8) then
- u10_clm(pp) = um(n)
- else
- if (zeta(n) < -zetam) then
- u10_clm(pp) = um(n) - ( ustar(n)/vkc*(log(-zetam*obu(n)/(10._r8+z0m(n))) &
- - StabilityFunc1(-zetam) &
- + StabilityFunc1((10._r8+z0m(n))/obu(n)) &
- + 1.14_r8*((-zeta(n))**0.333_r8-(zetam)**0.333_r8)) )
- else if (zeta(n) < 0._r8) then
- u10_clm(pp) = um(n) - ( ustar(n)/vkc*(log(zldis(n)/(10._r8+z0m(n))) &
- - StabilityFunc1(zeta(n)) &
- + StabilityFunc1((10._r8+z0m(n))/obu(n))) )
- else if (zeta(n) <= 1._r8) then
- u10_clm(pp) = um(n) - ( ustar(n)/vkc*(log(zldis(n)/(10._r8+z0m(n))) &
- + 5._r8*zeta(n) - 5._r8*(10._r8+z0m(n))/obu(n)) )
- else
- u10_clm(pp) = um(n) - ( ustar(n)/vkc*(log(obu(n)/(10._r8+z0m(n))) &
- + 5._r8 - 5._r8*(10._r8+z0m(n))/obu(n) &
- + (5._r8*log(zeta(n))+zeta(n)-1._r8)) )
-
- end if
- end if
- va(pp) = um(n)
- end do
- else
- if (zldis(n)-z0m(n) <= 10._r8) then
- u10_clm(n) = um(n)
- else
- if (zeta(n) < -zetam) then
- u10_clm(n) = um(n) - ( ustar(n)/vkc*(log(-zetam*obu(n)/(10._r8+z0m(n))) &
- - StabilityFunc1(-zetam) &
- + StabilityFunc1((10._r8+z0m(n))/obu(n)) &
- + 1.14_r8*((-zeta(n))**0.333_r8-(zetam)**0.333_r8)) )
- else if (zeta(n) < 0._r8) then
- u10_clm(n) = um(n) - ( ustar(n)/vkc*(log(zldis(n)/(10._r8+z0m(n))) &
- - StabilityFunc1(zeta(n)) &
- + StabilityFunc1((10._r8+z0m(n))/obu(n))) )
- else if (zeta(n) <= 1._r8) then
- u10_clm(n) = um(n) - ( ustar(n)/vkc*(log(zldis(n)/(10._r8+z0m(n))) &
- + 5._r8*zeta(n) - 5._r8*(10._r8+z0m(n))/obu(n)) )
- else
- u10_clm(n) = um(n) - ( ustar(n)/vkc*(log(obu(n)/(10._r8+z0m(n))) &
- + 5._r8 - 5._r8*(10._r8+z0m(n))/obu(n) &
- + (5._r8*log(zeta(n))+zeta(n)-1._r8)) )
- end if
- end if
- va(n) = um(n)
- end if
-
- ! Temperature profile
-
- if (present(landunit_index)) then
- zldis(n) = forc_hgt_t_patch(pfti(n))-displa(n)
- else
- zldis(n) = forc_hgt_t_patch(n)-displa(n)
- end if
- zeta(n) = zldis(n)/obu(n)
- if (zeta(n) < -zetat) then
- temp1(n) = vkc/(log(-zetat*obu(n)/z0h(n))&
- - StabilityFunc2(-zetat) &
- + StabilityFunc2(z0h(n)/obu(n)) &
- + 0.8_r8*((zetat)**(-0.333_r8)-(-zeta(n))**(-0.333_r8)))
- else if (zeta(n) < 0._r8) then
- temp1(n) = vkc/(log(zldis(n)/z0h(n)) &
- - StabilityFunc2(zeta(n)) &
- + StabilityFunc2(z0h(n)/obu(n)))
- else if (zeta(n) <= 1._r8) then
- temp1(n) = vkc/(log(zldis(n)/z0h(n)) + 5._r8*zeta(n) - 5._r8*z0h(n)/obu(n))
- else
- temp1(n) = vkc/(log(obu(n)/z0h(n)) + 5._r8 - 5._r8*z0h(n)/obu(n) &
- + (5._r8*log(zeta(n))+zeta(n)-1._r8))
- end if
-
- ! Humidity profile
-
- if (present(landunit_index)) then
- if (forc_hgt_q_patch(pfti(n)) == forc_hgt_t_patch(pfti(n)) .and. z0q(n) == z0h(n)) then
- temp2(n) = temp1(n)
- else
- zldis(n) = forc_hgt_q_patch(pfti(n))-displa(n)
- zeta(n) = zldis(n)/obu(n)
- if (zeta(n) < -zetat) then
- temp2(n) = vkc/(log(-zetat*obu(n)/z0q(n)) &
- - StabilityFunc2(-zetat) &
- + StabilityFunc2(z0q(n)/obu(n)) &
- + 0.8_r8*((zetat)**(-0.333_r8)-(-zeta(n))**(-0.333_r8)))
- else if (zeta(n) < 0._r8) then
- temp2(n) = vkc/(log(zldis(n)/z0q(n)) &
- - StabilityFunc2(zeta(n)) &
- + StabilityFunc2(z0q(n)/obu(n)))
- else if (zeta(n) <= 1._r8) then
- temp2(n) = vkc/(log(zldis(n)/z0q(n)) + 5._r8*zeta(n)-5._r8*z0q(n)/obu(n))
- else
- temp2(n) = vkc/(log(obu(n)/z0q(n)) + 5._r8 - 5._r8*z0q(n)/obu(n) &
- + (5._r8*log(zeta(n))+zeta(n)-1._r8))
- end if
- end if
- else
- if (forc_hgt_q_patch(n) == forc_hgt_t_patch(n) .and. z0q(n) == z0h(n)) then
- temp2(n) = temp1(n)
- else
- zldis(n) = forc_hgt_q_patch(n)-displa(n)
- zeta(n) = zldis(n)/obu(n)
- if (zeta(n) < -zetat) then
- temp2(n) = vkc/(log(-zetat*obu(n)/z0q(n)) &
- - StabilityFunc2(-zetat) &
- + StabilityFunc2(z0q(n)/obu(n)) &
- + 0.8_r8*((zetat)**(-0.333_r8)-(-zeta(n))**(-0.333_r8)))
- else if (zeta(n) < 0._r8) then
- temp2(n) = vkc/(log(zldis(n)/z0q(n)) &
- - StabilityFunc2(zeta(n)) &
- + StabilityFunc2(z0q(n)/obu(n)))
- else if (zeta(n) <= 1._r8) then
- temp2(n) = vkc/(log(zldis(n)/z0q(n)) + 5._r8*zeta(n)-5._r8*z0q(n)/obu(n))
- else
- temp2(n) = vkc/(log(obu(n)/z0q(n)) + 5._r8 - 5._r8*z0q(n)/obu(n) &
- + (5._r8*log(zeta(n))+zeta(n)-1._r8))
- end if
- endif
- endif
-
- ! Temperature profile applied at 2-m
-
- zldis(n) = 2.0_r8 + z0h(n)
- zeta(n) = zldis(n)/obu(n)
- if (zeta(n) < -zetat) then
- temp12m(n) = vkc/(log(-zetat*obu(n)/z0h(n))&
- - StabilityFunc2(-zetat) &
- + StabilityFunc2(z0h(n)/obu(n)) &
- + 0.8_r8*((zetat)**(-0.333_r8)-(-zeta(n))**(-0.333_r8)))
- else if (zeta(n) < 0._r8) then
- temp12m(n) = vkc/(log(zldis(n)/z0h(n)) &
- - StabilityFunc2(zeta(n)) &
- + StabilityFunc2(z0h(n)/obu(n)))
- else if (zeta(n) <= 1._r8) then
- temp12m(n) = vkc/(log(zldis(n)/z0h(n)) + 5._r8*zeta(n) - 5._r8*z0h(n)/obu(n))
- else
- temp12m(n) = vkc/(log(obu(n)/z0h(n)) + 5._r8 - 5._r8*z0h(n)/obu(n) &
- + (5._r8*log(zeta(n))+zeta(n)-1._r8))
- end if
-
- ! Humidity profile applied at 2-m
-
- if (z0q(n) == z0h(n)) then
- temp22m(n) = temp12m(n)
- else
- zldis(n) = 2.0_r8 + z0q(n)
- zeta(n) = zldis(n)/obu(n)
- if (zeta(n) < -zetat) then
- temp22m(n) = vkc/(log(-zetat*obu(n)/z0q(n)) - &
- StabilityFunc2(-zetat) + StabilityFunc2(z0q(n)/obu(n)) &
- + 0.8_r8*((zetat)**(-0.333_r8)-(-zeta(n))**(-0.333_r8)))
- else if (zeta(n) < 0._r8) then
- temp22m(n) = vkc/(log(zldis(n)/z0q(n)) - &
- StabilityFunc2(zeta(n))+StabilityFunc2(z0q(n)/obu(n)))
- else if (zeta(n) <= 1._r8) then
- temp22m(n) = vkc/(log(zldis(n)/z0q(n)) + 5._r8*zeta(n)-5._r8*z0q(n)/obu(n))
- else
- temp22m(n) = vkc/(log(obu(n)/z0q(n)) + 5._r8 - 5._r8*z0q(n)/obu(n) &
- + (5._r8*log(zeta(n))+zeta(n)-1._r8))
- end if
- end if
-
- ! diagnose 10-m wind for dust model (dstmbl.F)
- ! Notes from C. Zender's dst.F:
- ! According to Bon96 p. 62, the displacement height d (here displa) is
- ! 0.0 <= d <= 0.34 m in dust source regions (i.e., regions w/o trees).
- ! Therefore d <= 0.034*z1 and may safely be neglected.
- ! Code from LSM routine SurfaceTemperature was used to obtain u10
-
- if (present(landunit_index)) then
- zldis(n) = forc_hgt_u_patch(pfti(n))-displa(n)
- else
- zldis(n) = forc_hgt_u_patch(n)-displa(n)
- end if
- zeta(n) = zldis(n)/obu(n)
- if (min(zeta(n), 1._r8) < 0._r8) then
- tmp1 = (1._r8 - 16._r8*min(zeta(n),1._r8))**0.25_r8
- tmp2 = log((1._r8+tmp1*tmp1)/2._r8)
- tmp3 = log((1._r8+tmp1)/2._r8)
- fmnew = 2._r8*tmp3 + tmp2 - 2._r8*atan(tmp1) + 1.5707963_r8
- else
- fmnew = -5._r8*min(zeta(n),1._r8)
- endif
- if (iter == 1) then
- fm(n) = fmnew
- else
- fm(n) = 0.5_r8 * (fm(n)+fmnew)
- end if
- zeta10 = min(10._r8/obu(n), 1._r8)
- if (zeta(n) == 0._r8) zeta10 = 0._r8
- if (zeta10 < 0._r8) then
- tmp1 = (1.0_r8 - 16.0_r8 * zeta10)**0.25_r8
- tmp2 = log((1.0_r8 + tmp1*tmp1)/2.0_r8)
- tmp3 = log((1.0_r8 + tmp1)/2.0_r8)
- fm10 = 2.0_r8*tmp3 + tmp2 - 2.0_r8*atan(tmp1) + 1.5707963_r8
- else ! not stable
- fm10 = -5.0_r8 * zeta10
- end if
- if (present(landunit_index)) then
- tmp4 = log( max( 1.0_r8, forc_hgt_u_patch(pfti(n)) / 10._r8) )
- else
- tmp4 = log( max( 1.0_r8, forc_hgt_u_patch(n) / 10._r8) )
- end if
- if (present(landunit_index)) then
- do pp = pfti(n),pftf(n)
- u10(pp) = ur(n) - ustar(n)/vkc * (tmp4 - fm(n) + fm10)
- fv(pp) = ustar(n)
- end do
- else
- u10(n) = ur(n) - ustar(n)/vkc * (tmp4 - fm(n) + fm10)
- fv(n) = ustar(n)
- end if
-
- end do
-
- end associate
- end subroutine FrictionVelocity
-
- !------------------------------------------------------------------------------
- real(r8) function StabilityFunc1(zeta)
- !
- ! !DESCRIPTION:
- ! Stability function for rib < 0.
- !
- ! !USES:
- use shr_const_mod, only: SHR_CONST_PI
- !
- ! !ARGUMENTS:
- implicit none
- real(r8), intent(in) :: zeta ! dimensionless height used in Monin-Obukhov theory
- !
- ! !LOCAL VARIABLES:
- real(r8) :: chik, chik2
- !------------------------------------------------------------------------------
-
- chik2 = sqrt(1._r8-16._r8*zeta)
- chik = sqrt(chik2)
- StabilityFunc1 = 2._r8*log((1._r8+chik)*0.5_r8) &
- + log((1._r8+chik2)*0.5_r8)-2._r8*atan(chik)+SHR_CONST_PI*0.5_r8
-
- end function StabilityFunc1
-
- !------------------------------------------------------------------------------
- real(r8) function StabilityFunc2(zeta)
- !
- ! !DESCRIPTION:
- ! Stability function for rib < 0.
- !
- ! !USES:
- use shr_const_mod, only: SHR_CONST_PI
- !
- ! !ARGUMENTS:
- implicit none
- real(r8), intent(in) :: zeta ! dimensionless height used in Monin-Obukhov theory
- !
- ! !LOCAL VARIABLES:
- real(r8) :: chik2
- !------------------------------------------------------------------------------
-
- chik2 = sqrt(1._r8-16._r8*zeta)
- StabilityFunc2 = 2._r8*log((1._r8+chik2)*0.5_r8)
-
- end function StabilityFunc2
-
- !-----------------------------------------------------------------------
- subroutine MoninObukIni (ur, thv, dthv, zldis, z0m, um, obu)
- !
- ! !DESCRIPTION:
- ! Initialization of the Monin-Obukhov length.
- ! The scheme is based on the work of Zeng et al. (1998):
- ! Intercomparison of bulk aerodynamic algorithms for the computation
- ! of sea surface fluxes using TOGA CORE and TAO data. J. Climate,
- ! Vol. 11, 2628-2644.
- !
- ! !USES:
- use clm_varcon, only : grav
- !
- ! !ARGUMENTS:
- implicit none
- real(r8), intent(in) :: ur ! wind speed at reference height [m/s]
- real(r8), intent(in) :: thv ! virtual potential temperature (kelvin)
- real(r8), intent(in) :: dthv ! diff of vir. poten. temp. between ref. height and surface
- real(r8), intent(in) :: zldis ! reference height "minus" zero displacement heght [m]
- real(r8), intent(in) :: z0m ! roughness length, momentum [m]
- real(r8), intent(out) :: um ! wind speed including the stability effect [m/s]
- real(r8), intent(out) :: obu ! monin-obukhov length (m)
- !
- ! !LOCAL VARIABLES:
- real(r8) :: wc ! convective velocity [m/s]
- real(r8) :: rib ! bulk Richardson number
- real(r8) :: zeta ! dimensionless height used in Monin-Obukhov theory
- real(r8) :: ustar ! friction velocity [m/s]
- !-----------------------------------------------------------------------
-
- ! Initial values of u* and convective velocity
-
- ustar=0.06_r8
- wc=0.5_r8
- if (dthv >= 0._r8) then
- um=max(ur,0.1_r8)
- else
- um=sqrt(ur*ur+wc*wc)
- endif
-
- rib=grav*zldis*dthv/(thv*um*um)
-
- if (rib >= 0._r8) then ! neutral or stable
- zeta = rib*log(zldis/z0m)/(1._r8-5._r8*min(rib,0.19_r8))
- zeta = min(frictionvel_parms_inst%zetamaxstable,max(zeta,0.01_r8 ))
- else ! unstable
- zeta=rib*log(zldis/z0m)
- zeta = max(-100._r8,min(zeta,-0.01_r8 ))
- endif
-
- obu=zldis/zeta
-
- end subroutine MoninObukIni
-
-end module FrictionVelocityMod
diff --git a/src/biogeophys/GlacierSurfaceMassBalanceMod.F90 b/src/biogeophys/GlacierSurfaceMassBalanceMod.F90
deleted file mode 100644
index adaa6cee..00000000
--- a/src/biogeophys/GlacierSurfaceMassBalanceMod.F90
+++ /dev/null
@@ -1,452 +0,0 @@
-module GlacierSurfaceMassBalanceMod
-
- !-----------------------------------------------------------------------
- ! !DESCRIPTION:
- ! Computes fluxes that are specific to glaciers
- !
- ! !USES:
-#include "shr_assert.h"
- use shr_kind_mod , only : r8 => shr_kind_r8
- use shr_log_mod , only : errMsg => shr_log_errMsg
- use shr_infnan_mod , only : nan => shr_infnan_nan, assignment(=)
- use decompMod , only : bounds_type
- use clm_varcon , only : spval, secspday
- use clm_varpar , only : nlevgrnd
- use clm_varctl , only : glc_snow_persistence_max_days
- use clm_time_manager, only : get_step_size
- use landunit_varcon, only : istice_mec
- use ColumnType , only : col
- use LandunitType , only : lun
- use glc2lndMod , only : glc2lnd_type
- use WaterstateType , only : waterstate_type
- use WaterfluxType , only : waterflux_type
-
- ! !PUBLIC TYPES:
- implicit none
- private
- save
-
- type, public :: glacier_smb_type
- private
-
- ! ------------------------------------------------------------------------
- ! Public data
- ! ------------------------------------------------------------------------
-
- real(r8), pointer, public :: qflx_glcice_col(:) ! col net flux of new glacial ice (growth - melt) (mm H2O/s), passed to GLC; only valid inside the do_smb_c filter
- real(r8), pointer, public :: qflx_glcice_dyn_water_flux_col(:) ! col water flux needed for balance check due to glc_dyn_runoff_routing (mm H2O/s) (positive means addition of water to the system); valid for all columns
-
- ! ------------------------------------------------------------------------
- ! Private data
- ! ------------------------------------------------------------------------
-
- real(r8), pointer :: qflx_glcice_frz_col (:) ! col ice growth (positive definite) (mm H2O/s); only valid inside the do_smb_c filter
- real(r8), pointer :: qflx_glcice_melt_col(:) ! col ice melt (positive definite) (mm H2O/s); only valid inside the do_smb_c filter
-
- contains
-
- ! ------------------------------------------------------------------------
- ! Public routines
- ! ------------------------------------------------------------------------
-
- procedure, public :: Init
-
- ! The science routines need to be separated into a few pieces so they can be
- ! sequenced properly based on what variables they depend on, and what they affect
- procedure, public :: HandleIceMelt ! compute ice melt in glacier columns, and convert liquid back to ice
- procedure, public :: ComputeSurfaceMassBalance ! compute fluxes other than ice melt
- procedure, public :: AdjustRunoffTerms ! adjust liquid and ice runoff fluxes due to glacier fluxes
-
- ! ------------------------------------------------------------------------
- ! Private routines
- ! ------------------------------------------------------------------------
-
- procedure, private :: InitAllocate
- procedure, private :: InitHistory
- procedure, private :: InitCold
-
- end type glacier_smb_type
-
- character(len=*), parameter, private :: sourcefile = &
- __FILE__
-
-contains
-
- ! ========================================================================
- ! Infrastructure routines
- ! ========================================================================
-
- !-----------------------------------------------------------------------
- subroutine Init(this, bounds)
- class(glacier_smb_type), intent(inout) :: this
- type(bounds_type), intent(in) :: bounds
- !-----------------------------------------------------------------------
-
- call this%InitAllocate(bounds)
- call this%InitHistory(bounds)
- call this%InitCold(bounds)
- end subroutine Init
-
- !-----------------------------------------------------------------------
- subroutine InitAllocate(this, bounds)
- class(glacier_smb_type), intent(inout) :: this
- type(bounds_type), intent(in) :: bounds
-
- integer :: begc, endc
- !-----------------------------------------------------------------------
-
- begc = bounds%begc; endc = bounds%endc
-
- allocate(this%qflx_glcice_col (begc:endc)) ; this%qflx_glcice_col (:) = nan
- allocate(this%qflx_glcice_dyn_water_flux_col(begc:endc)) ; this%qflx_glcice_dyn_water_flux_col (:) = nan
- allocate(this%qflx_glcice_frz_col (begc:endc)) ; this%qflx_glcice_frz_col (:) = nan
- allocate(this%qflx_glcice_melt_col (begc:endc)) ; this%qflx_glcice_melt_col (:) = nan
- end subroutine InitAllocate
-
- !-----------------------------------------------------------------------
- subroutine InitHistory(this, bounds)
- !
- ! !USES:
- use histFileMod , only : hist_addfld1d
- !
- ! !ARGUMENTS:
- class(glacier_smb_type), intent(inout) :: this
- type(bounds_type), intent(in) :: bounds
- !
- ! !LOCAL VARIABLES:
- integer :: begc, endc
- !-----------------------------------------------------------------------
-
- begc = bounds%begc; endc = bounds%endc
-
- this%qflx_glcice_col(begc:endc) = spval
- call hist_addfld1d (fname='QICE', units='mm/s', &
- avgflag='A', long_name='ice growth/melt', &
- ptr_col=this%qflx_glcice_col, l2g_scale_type='ice', default='inactive')
-
- this%qflx_glcice_frz_col(begc:endc) = spval
- call hist_addfld1d (fname='QICE_FRZ', units='mm/s', &
- avgflag='A', long_name='ice growth', &
- ptr_col=this%qflx_glcice_frz_col, l2g_scale_type='ice', default='inactive')
-
- this%qflx_glcice_melt_col(begc:endc) = spval
- call hist_addfld1d (fname='QICE_MELT', units='mm/s', &
- avgflag='A', long_name='ice melt', &
- ptr_col=this%qflx_glcice_melt_col, l2g_scale_type='ice', default='inactive')
-
- end subroutine InitHistory
-
- !-----------------------------------------------------------------------
- subroutine InitCold(this, bounds)
- class(glacier_smb_type), intent(inout) :: this
- type(bounds_type), intent(in) :: bounds
-
- integer :: c
- !-----------------------------------------------------------------------
-
- ! Initialize qflx_glcice_dyn_water_flux_col to 0 for all columns because we want this
- ! flux to remain 0 for columns where is is never set, including non-glacier columns.
- !
- ! Other fluxes intentionally remain unset (spval) outside the do_smb filter, so that
- ! they are flagged as missing value outside that filter.
- do c = bounds%begc, bounds%endc
- this%qflx_glcice_dyn_water_flux_col(c) = 0._r8
- end do
-
- end subroutine InitCold
-
- ! ========================================================================
- ! Science routines
- ! ========================================================================
-
- !-----------------------------------------------------------------------
- subroutine HandleIceMelt(this, bounds, num_do_smb_c, filter_do_smb_c, &
- waterstate_inst)
- !
- ! !DESCRIPTION:
- ! Compute ice melt in glacier columns, and convert liquid back to ice
- !
- ! Ideally this should be called immediately after ice is melted, so that liquid is
- ! converted back to ice as soon as possible.
- !
- ! NOTE(wjs, 2016-06-29) Currently this is separated from the main ComputeSurfaceMassBalance
- ! routine so that it can be called from the same place in the driver loop where it was
- ! done before the introduction of GlacierSurfaceMassBalanceMod. This was needed to maintain
- ! identical answers, due to the adjustment of h2osoi_ice and h2osoi_liq in this
- ! routine. In principle we should be able to do these adjustments of h2osoi_ice and
- ! h2osoi_liq later in the driver loop: this would just mean that some intervening
- ! science code is operating on the temporarily-thawed state, before the water runs off
- ! and is replaced by ice from below. The main reason to make this change would be to
- ! simplify the driver logic, consolidating calls to this module. On the other hand,
- ! having a period when there is liquid water at the top of the glacier column could
- ! defeat some of the purpose of converting it immediately back to ice (i.e., so that
- ! the surface fluxes are always generated based on an ice-covered surface) - so it
- ! may be best to keep this separate.
- !
- ! !ARGUMENTS:
- class(glacier_smb_type), intent(inout) :: this
- type(bounds_type), intent(in) :: bounds
- integer, intent(in) :: num_do_smb_c ! number of column points in filter_do_smb_c
- integer, intent(in) :: filter_do_smb_c(:) ! column filter for points where SMB is calculated
- type(waterstate_type), intent(inout) :: waterstate_inst
- !
- ! !LOCAL VARIABLES:
- integer :: j
- integer :: fc, c, l
- real(r8) :: dtime ! land model time step (sec)
-
- character(len=*), parameter :: subname = 'HandleIceMelt'
- !-----------------------------------------------------------------------
-
- associate( &
- qflx_glcice_melt => this%qflx_glcice_melt_col , & ! Output: [real(r8) (:) ] ice melt (positive definite) (mm H2O/s)
- h2osoi_liq => waterstate_inst%h2osoi_liq_col , & ! Output: [real(r8) (:,:) ] liquid water (kg/m2)
- h2osoi_ice => waterstate_inst%h2osoi_ice_col & ! Output: [real(r8) (:,:) ] ice lens (kg/m2)
- )
-
- dtime = get_step_size()
-
- do fc = 1, num_do_smb_c
- c = filter_do_smb_c(fc)
- qflx_glcice_melt(c) = 0._r8
- end do
-
- ! Note that, because the following code only operates over the do_smb filter, that
- ! means that the conversion of water back to ice only happens for glacier columns
- ! where we're computing SMB.
-
- do j = 1, nlevgrnd
- do fc = 1, num_do_smb_c
- c = filter_do_smb_c(fc)
- l = col%landunit(c)
-
- if (lun%itype(l) == istice_mec) then
- if (h2osoi_liq(c,j) > 0._r8) then ! ice layer with meltwater
- qflx_glcice_melt(c) = qflx_glcice_melt(c) + h2osoi_liq(c,j)/dtime
-
- ! convert layer back to pure ice by "borrowing" ice from below the column
- h2osoi_ice(c,j) = h2osoi_ice(c,j) + h2osoi_liq(c,j)
- h2osoi_liq(c,j) = 0._r8
- end if ! liquid water is present
- end if ! istice_mec
- end do
- end do
-
- end associate
-
- end subroutine HandleIceMelt
-
- !-----------------------------------------------------------------------
- subroutine ComputeSurfaceMassBalance(this, bounds, num_allc, filter_allc, &
- num_do_smb_c, filter_do_smb_c, glc2lnd_inst, waterstate_inst, waterflux_inst)
- !
- ! !DESCRIPTION:
- ! Compute glacier fluxes other than ice melt.
- !
- ! This sets the public fields qflx_glcice_col and qflx_glcice_dyn_water_flux_col to
- ! their final values.
- !
- ! Should be called after HandleIceMelt, and after waterflux_inst%qflx_snwcp_ice_col is
- ! computed
- !
- ! !ARGUMENTS:
- class(glacier_smb_type), intent(inout) :: this
- type(bounds_type), intent(in) :: bounds
- integer, intent(in) :: num_allc ! number of column points in filter_allc
- integer, intent(in) :: filter_allc(:) ! column filter for all points
- integer, intent(in) :: num_do_smb_c ! number of column points in filter_do_smb_c
- integer, intent(in) :: filter_do_smb_c(:) ! column filter for points where SMB is calculated
- type(glc2lnd_type), intent(in) :: glc2lnd_inst
- type(waterstate_type), intent(in) :: waterstate_inst
- type(waterflux_type), intent(in) :: waterflux_inst
- !
- ! !LOCAL VARIABLES:
- integer :: fc, c, l, g
-
- character(len=*), parameter :: subname = 'ComputeSurfaceMassBalance'
- !-----------------------------------------------------------------------
-
- associate( &
- qflx_glcice => this%qflx_glcice_col , & ! Output: [real(r8) (:)] net flux of new glacial ice (growth - melt) (mm H2O/s)
- qflx_glcice_frz => this%qflx_glcice_frz_col , & ! Output: [real(r8) (:)] ice growth (positive definite) (mm H2O/s)
- qflx_glcice_dyn_water_flux => this%qflx_glcice_dyn_water_flux_col , & ! Output: [real(r8) (:)] water flux needed for balance check due to glc_dyn_runoff_routing (mm H2O/s) (positive means addition of water to the system)
- qflx_glcice_melt => this%qflx_glcice_melt_col , & ! Input: [real(r8) (:)] ice melt (positive definite) (mm H2O/s)
- glc_dyn_runoff_routing => glc2lnd_inst%glc_dyn_runoff_routing_grc , & ! Input: [real(r8) (:)] whether we're doing runoff routing appropriate for having a dynamic icesheet
- snow_persistence => waterstate_inst%snow_persistence_col , & ! Input: [real(r8) (:)] counter for length of time snow-covered
- qflx_snwcp_ice => waterflux_inst%qflx_snwcp_ice_col & ! Input: [real(r8) (:)] excess solid h2o due to snow capping (outgoing) (mm H2O /s) [+]
- )
-
- ! NOTE(wjs, 2016-06-29) The following initialization is done in case the columns
- ! included / excluded in the do_smb_c filter can change mid-run (besides just being
- ! active vs. inactive): If an active column was inside this filter in the previous
- ! timestep, but is no longer inside this filter in this timestep, we want this flux to
- ! be 0 (rather than remaining at its previous value). (Currently, the set of active
- ! columns included in the do_smb filter cannot change mid-run, but the logic is
- ! complex enough that I don't want to assume that that will always remain true.) This
- ! initialization also handles the case where glc_dyn_runoff_routing may change
- ! mid-run, so that a point previously inside that mask no longer is.
- do fc = 1, num_allc
- c = filter_allc(fc)
- qflx_glcice_dyn_water_flux(c) = 0._r8
- end do
-
-
- ! Calculate positive surface mass balance to ice sheets, both from already-glaciated
- ! landunits and from non-glaciated landunits (glacial inception)
- do fc = 1, num_do_smb_c
- c = filter_do_smb_c(fc)
- l = col%landunit(c)
- g = col%gridcell(c)
- ! In the following, we convert glc_snow_persistence_max_days to r8 to avoid overflow
- if ( (snow_persistence(c) >= (real(glc_snow_persistence_max_days, r8) * secspday)) &
- .or. lun%itype(l) == istice_mec) then
- qflx_glcice_frz(c) = qflx_snwcp_ice(c)
- else
- qflx_glcice_frz(c) = 0._r8
- end if
-
- qflx_glcice(c) = qflx_glcice_frz(c) - qflx_glcice_melt(c)
-
- ! For glc_dyn_runoff_routing > 0::
- ! (1) All or part of the excess snow (from snow capping) has been incorporated in
- ! qflx_glcice_frz. This flux must be included here to complete the water
- ! balance, because it is a sink of water as far as CLM is concerned (this water
- ! will now be owned by CISM).
- ! (2) Meltwater from ice (qflx_glcice_melt) is allowed to run off and is included
- ! in qflx_qrgwl, but the water content of the ice column has not changed
- ! because an equivalent ice mass has been "borrowed" from the base of the
- ! column. So this borrowing is a source of water as far as CLM is concerned.
- !
- ! For glc_dyn_runoff_routing = 0: Point (2) is the same as for the
- ! glc_dyn_runoff_routing > 0 case: there is a source of water equal to
- ! qflx_glcice_melt. However, in this case, the sink of water is also equal to
- ! qflx_glcice_melt: We have simply replaced some liquid water with an equal amount
- ! of solid ice. Another way to think about this is:
- ! (1) qflx_ice_runoff_snwcp is reduced by an amount equal to qflx_glcice_melt (done
- ! elsewhere in this module). The amount of snow removal is therefore given by
- ! (qflx_ice_runoff_snwcp + qflx_glcice_melt), meaning that there is an
- ! additional sink of water equal to qflx_glcice_melt.
- ! (2) Meltwater from ice (qflx_glcice_melt) is allowed to run off and is included
- ! in qflx_qrgwl, but the water content of the ice column has not changed
- ! because an equivalent ice mass has been "borrowed" from the base of the
- ! column. So this borrowing is a source of water as far as CLM is concerned.
- ! These two corrections cancel out, so nothing is done here.
- qflx_glcice_dyn_water_flux(c) = glc_dyn_runoff_routing(g) * (qflx_glcice_melt(c) - qflx_glcice_frz(c))
- end do
-
- end associate
-
- end subroutine ComputeSurfaceMassBalance
-
- !-----------------------------------------------------------------------
- subroutine AdjustRunoffTerms(this, bounds, num_do_smb_c, filter_do_smb_c, &
- glc2lnd_inst, qflx_qrgwl, qflx_ice_runoff_snwcp)
- !
- ! !DESCRIPTION:
- ! Adjust liquid and ice runoff fluxes due to glacier fluxes
- !
- ! Should be called after ComputeSurfaceMassBalance, and after qflx_qrgwl and
- ! qflx_ice_runoff_snwcp have been given their initial values
- !
- ! !USES:
- !
- ! !ARGUMENTS:
- class(glacier_smb_type), intent(in) :: this
- type(bounds_type), intent(in) :: bounds
- integer, intent(in) :: num_do_smb_c ! number of column points in filter_do_smb_c
- integer, intent(in) :: filter_do_smb_c(:) ! column filter for points where SMB is calculated
- type(glc2lnd_type), intent(in) :: glc2lnd_inst
- real(r8), intent(inout) :: qflx_qrgwl( bounds%begc: ) ! col qflx_surf at glaciers, wetlands, lakes
- real(r8), intent(inout) :: qflx_ice_runoff_snwcp( bounds%begc: ) ! col solid runoff from snow capping (mm H2O /s)
- !
- ! !LOCAL VARIABLES:
- integer :: fc, c, g
-
- character(len=*), parameter :: subname = 'AdjustRunoffTerms'
- !-----------------------------------------------------------------------
-
- SHR_ASSERT_ALL((ubound(qflx_qrgwl) == (/bounds%endc/)), errMsg(sourcefile, __LINE__))
- SHR_ASSERT_ALL((ubound(qflx_ice_runoff_snwcp) == (/bounds%endc/)), errMsg(sourcefile, __LINE__))
-
- associate( &
- qflx_glcice_frz => this%qflx_glcice_frz_col , & ! Input: [real(r8) (:)] ice growth (positive definite) (mm H2O/s)
- qflx_glcice_melt => this%qflx_glcice_melt_col , & ! Input: [real(r8) (:)] ice melt (positive definite) (mm H2O/s)
- glc_dyn_runoff_routing => glc2lnd_inst%glc_dyn_runoff_routing_grc & ! Input: [real(r8) (:)] gridcell fraction coupled to dynamic ice sheet
- )
-
- ! Note that, because the following code only operates over the do_smb filter, that
- ! means that the adjustments here are only applied for glacier columns where we're
- ! computing SMB. This is consistent with the use of the do_smb filter in
- ! HandleIceMelt.
-
- do fc = 1, num_do_smb_c
- c = filter_do_smb_c(fc)
- g = col%gridcell(c)
-
- ! Melt is only generated for glacier columns. But it doesn't hurt to do this for
- ! all columns in the do_smb filter: this melt term will be 0 for other columns.
- ! Note: Ice melt is added to the runoff whether or not the column is coupled
- ! to a dynamic glacier model.
-
- qflx_qrgwl(c) = qflx_qrgwl(c) + qflx_glcice_melt(c)
-
- ! For the part of the column that is coupled to a dynamic glacier model,
- ! the glacier model handles the fate of capped snow, so we do not want it sent to runoff.
- qflx_ice_runoff_snwcp(c) = qflx_ice_runoff_snwcp(c) - glc_dyn_runoff_routing(g)*qflx_glcice_frz(c)
-
- ! In places where we are not coupled to a dynamic glacier model, CLM sends all of
- ! the snow capping to the ocean as an ice runoff term. (This is essentially a crude
- ! parameterization of calving, assuming steady state - i.e., all ice gain is
- ! balanced by an ice loss.) But each unit of melt that happens is an indication
- ! that 1 unit of the ice shouldn't have made it to the ocean - but instead melted
- ! before it got there. So we need to correct for that by removing 1 unit of ice
- ! runoff for each unit of melt. Note that, for a given point in space & time, this
- ! can result in negative ice runoff. However, we expect that, in a temporally and
- ! spatially-integrated sense (if we're near equilibrium), this will just serve to
- ! decrease the too-high positive ice runoff.
- !
- ! Another way to think about this is: ice melt removes mass; the snow capping flux
- ! also removes mass. If both the accumulation and melt remove mass, there is a
- ! double-counting. So we need to correct that by: for each unit of ice melt
- ! (resulting in 1 unit of liquid runoff), remove 1 unit of ice runoff. (This is not
- ! an issue for parts of the column coupled to the dynamic glacier model, because
- ! then the snow capping mass is retained in the LND-GLC coupled system.)
- !
- ! The alternative of simply not adding ice melt to the runoff stream where
- ! glc_dyn_runoff_routing = 0 conserves mass, but fails to conserve energy, for a
- ! similar reason: Ice melt in CLM removes energy; also, the ocean's melting of the
- ! snow capping flux removes energy. If both the accumulation and melting remove
- ! energy, there is a double-counting.
- !
- ! Yet another way to think about this is: When ice melted, we let the liquid run
- ! off, and replaced it with new ice from below. But that new ice needed to come
- ! from somewhere to keep the system in water balance. We "request" the new ice from
- ! the ocean by generating a negataive ice runoff equivalent to the amount we have
- ! melted (i.e., equivalent to the amount of new ice that we created from below).
-
- ! As above: Melt is only generated for glacier columns. But it doesn't hurt to do
- ! this for all columns in the do_smb filter: this melt term will be 0 for other
- ! columns.
-
- qflx_ice_runoff_snwcp(c) = qflx_ice_runoff_snwcp(c) - (1.0_r8 - glc_dyn_runoff_routing(g)) * qflx_glcice_melt(c)
-
- ! Recall that glc_dyn_runoff_routing = min(lfrac, Sg_icemask_coupled_fluxes_l) / lfrac.
- !
- ! Consider a cell with lfrac = 0.8 and Sg_icemask_coupled_fluxes_l = 0.4. (For
- ! instance, the cell might have half its land coverage in Greenland and the other
- ! half in Ellemere.) Given qflx_ice_runoff_snwcp(c) = 1 m/yr, half the flux (0.5
- ! m/yr) will be sent to the runoff model, where it will be multiplied by lfrac to
- ! give a net flux of 0.4 m/yr times the cell area.
- !
- ! The full SMB of 1 m/yr will be sent to the coupler's prep_glc_mod, but it will be
- ! weighted by 0.4 when integrating over the whole ice sheet. So a net flux of 0.4
- ! m/yr will also be applied to the ice sheet model. The total flux of 0.8 m/yr,
- ! split evenly between runoff and ice sheet, is what we want.
-
- end do
-
- end associate
-
- end subroutine AdjustRunoffTerms
-
-end module GlacierSurfaceMassBalanceMod
diff --git a/src/biogeophys/LakeCon.F90 b/src/biogeophys/LakeCon.F90
deleted file mode 100644
index a42a3d01..00000000
--- a/src/biogeophys/LakeCon.F90
+++ /dev/null
@@ -1,178 +0,0 @@
-module LakeCon
-
- !-----------------------------------------------------------------------
- ! !DESCRIPTION:
- ! Module containing constants and parameters for the Lake code
- ! (CLM4-LISSS, documented in Subin et al. 2011, JAMES)
- ! Also contains time constant variables for Lake code
- ! Created by Zack Subin, 2011
- !
- ! !USES:
- use shr_kind_mod , only : r8 => shr_kind_r8
- use decompMod , only : bounds_type
- use clm_varctl , only : iulog
- use spmdMod , only : masterproc
- !
- ! !PUBLIC TYPES:
- implicit none
- save
- !
- ! !PUBLIC MEMBER FUNCTIONS:
- public :: LakeConInit
- !-----------------------------------------------------------------------
-
- !------------------------------------------------------------------
- ! Lake Model non-tuneable constants
- !------------------------------------------------------------------
-
- ! temperature of maximum water density (K)
- ! This is from Hostetler and Bartlein (1990); more updated sources suggest 277.13 K.
- real(r8), parameter :: tdmax = 277._r8
-
- !------------------------------------------------------------------
- ! Lake Model tuneable constants
- !------------------------------------------------------------------
-
- ! lake emissivity. This is used for both frozen and unfrozen lakes.
- ! This is pulled in from CLM4 and the reference is unclear.
- real(r8), parameter :: emg_lake = 0.97_r8
-
- ! The fraction of the visible (e.g. vis not nir from atm) sunlight
- ! absorbed in ~1 m of water (the surface layer za_lake).
- ! This is roughly the fraction over 700 nm but may depend on the details
- ! of atmospheric radiative transfer. As long as NIR = 700 nm and up, this can be zero.
- real(r8) :: betavis = 0.0_r8
-
- ! Momentum Roughness length over frozen lakes without snow (m)
- ! Typical value found in the literature, and consistent with Mironov expressions.
- ! See e.g. Morris EM 1989, Andreas EL 1987, Guest & Davidson 1991 (as cited in Vavrus 1996)
- real(r8), parameter :: z0frzlake = 0.001_r8
-
- ! Base of surface light absorption layer for lakes (m)
- real(r8), parameter :: za_lake = 0.6_r8
-
- ! For calculating prognostic roughness length
- real(r8), parameter :: cur0 = 0.01_r8 ! min. Charnock parameter
- real(r8), parameter :: cus = 0.1_r8 ! empirical constant for roughness under smooth flow
- real(r8), parameter :: curm = 0.1_r8 ! maximum Charnock parameter
-
- ! The following will be set in initLake based on namelists. !TODO - fix this commend
- real(r8) :: fcrit ! critical dimensionless fetch for Charnock parameter.
- real(r8) :: minz0lake ! (m) Minimum allowed roughness length for unfrozen lakes.
-
- ! For calculating enhanced diffusivity
- real(r8), parameter :: n2min = 7.5e-5_r8 ! (s^-2) (yields diffusivity about 6 times km) ! Fang & Stefan 1996
-
- ! Note, this will be adjusted in initLake if the timestep is not 1800 s.
- ! Lake top numerics can oscillate with 0.01m top layer and 1800 s timestep.
- ! The problem is that the surface flux is fixed during the calculation of the top
- ! layer temperature in the diffusion and not corrected for the tendency of the top layer.
- ! This thickness will be added to all minimum and maximum snow layer thicknesses compared to that used over non-lakes.
- ! Analysis of the CFL condition suggests that the minimum snow layer thickness for 1800 s needs
- ! to be at least ~1.2 cm for the bulk snow values of conductivity and heat capacity
- ! and as much as 2.3 cm for pure ice.
- ! Alternatively, a check could be done in LakeTemperature in case
- ! t_grnd(c) - t_soisno(c,snl(c)+1) changed sign after the Crank-Nicholson step.
- ! Such an approach, while perhaps allowing additional snow layer resolution, has not been tested.
- ! The approach used over non-lakes is to have a first-order surface flux correction.
- ! We choose not to do that here because t_grnd can vary independently of the top model
- ! layer temperature, while it is fixed to the top layer temperature if tbot > tfrz and
- ! the lake is frozen, or if there is an unstable density gradient in the top unfrozen lake layer.
- real(r8) :: lsadz = 0.03_r8 ! m
-
- !! The following will be set in initLake based on namelists.
- real(r8) :: pudz ! (m) Optional minimum total ice thickness required to allow lake puddling.
- ! Currently used for sensitivity tests only.
- real(r8) :: depthcrit ! (m) Depth beneath which to increase mixing. See discussion in Subin et al. 2011
- real(r8) :: mixfact ! Mixing increase factor.
-
- !!!!!!!!!!!
- ! Namelists (some of these have not been extensively tested and are hardwired to default values currently).
- !!!!!!!!!!!
-
- ! used in LakeFluxes
- ! true => use old fcrit & minz0 as per Subin et al 2011 form
- ! See initLakeMod for details. Difference is very small for
- ! small lakes and negligible for large lakes. Currently hardwired off.
- logical, public :: lake_use_old_fcrit_minz0 = .false.
-
- ! used in LakeTemperature
- ! Increase mixing by a large factor for deep lakes
- ! Crude but enhanced performance at all 4 deep lakes tested.
- ! See Subin et al 2011 (JAMES) for details
-
- ! (m) minimum lake depth to invoke deepmixing
- real(r8), public :: deepmixing_depthcrit = 25._r8
-
- ! factor to increase mixing by
- real(r8), public :: deepmixing_mixfact = 10._r8
-
- ! true => Suppress enhanced diffusion. Small differences.
- ! Currently hardwired .false.
- ! See Subin et al 2011 for details.
- ! Enhanced diffusion is intended for under ice and at large depths.
- ! It is a much smaller change on its own than the "deepmixing"
- ! above, but it increases the effect of deepmixing under ice and for large depths.
- logical, public :: lake_no_ed = .false.
-
- ! puddling (not extensively tested and currently hardwired off)
- ! used in LakeTemperature and SurfaceAlbedo
-
- ! true => suppress convection when greater than minimum amount
- ! of ice is present. This also effectively sets lake_no_melt_icealb.
- logical, public :: lakepuddling = .false.
-
- ! (m) minimum amount of total ice nominal thickness before
- ! convection is suppressed
- real(r8), public :: lake_puddle_thick = 0.2_r8
- !-----------------------------------------------------------------------
-
-contains
-
- !-----------------------------------------------------------------------
- subroutine LakeConInit()
- !
- ! !DESCRIPTION:
- ! Initialize time invariant variables for S Lake code
- !------------------------------------------------------------------------
-
- if (masterproc) write (iulog,*) 'Attempting to initialize time invariant variables for lakes'
-
- ! Set LakeCon constants according to namelist fields
- if (lake_use_old_fcrit_minz0) then
- ! critical dimensionless fetch for Charnock parameter. From Vickers & Mahrt 1997
- ! but converted to use u instead of u* (Form used in Subin et al. 2011)
- fcrit = 22._r8
-
- ! (m) Minimum allowed roughness length for unfrozen lakes.
- ! (Used in Subin et al. 2011)
- minz0lake = 1.e-5_r8
- else
- ! Vickers & Mahrt 1997
- fcrit = 100._r8
-
- ! (m) Minimum allowed roughness length for unfrozen lakes.
- ! Now set low so it is only to avoid floating point exceptions.
- minz0lake = 1.e-10_r8
- end if
-
- if (lakepuddling) then
- ! (m) Minimum total ice thickness required to allow lake puddling. Default is 0.2m.
- ! This option has not been extensively tested.
- ! This option turns on lake_no_melt_icealb, as the decrease in albedo will be based
- ! on whether there is water over nice, not purely a function of ice top temperature.
- pudz = lake_puddle_thick
- end if
-
- ! (m) Depth beneath which to increase mixing. See discussion in Subin et al. 2011
- depthcrit = deepmixing_depthcrit
-
- ! Mixing increase factor. ! Defaults are 25 m, increase by 10.
- ! Note some other namelists will be used directly in lake physics during model integration.
- mixfact = deepmixing_mixfact
-
- if (masterproc) write (iulog,*) 'Successfully initialized time invariant variables for lakes'
-
- end subroutine LakeConInit
-
-end module LakeCon
diff --git a/src/biogeophys/LakeStateType.F90 b/src/biogeophys/LakeStateType.F90
deleted file mode 100644
index f440a819..00000000
--- a/src/biogeophys/LakeStateType.F90
+++ /dev/null
@@ -1,296 +0,0 @@
-module LakeStateType
-
- !-----------------------------------------------------------------------
- ! !DESCRIPTION:
- ! Lake data types and associated procesures
- !
- ! !USES:
- use shr_kind_mod , only : r8 => shr_kind_r8
- use shr_log_mod , only : errMsg => shr_log_errMsg
- use clm_varcon , only : spval, grlnd
- use decompMod , only : bounds_type
- use spmdMod , only : masterproc
- use abortUtils , only : endrun
- use LandunitType , only : lun
- use ColumnType , only : col
- !
- implicit none
- save
- private
- !
- ! !PUBLIC TYPES:
- type, public :: lakestate_type
- ! Time constant variables
- real(r8), pointer :: lakefetch_col (:) ! col lake fetch from surface data (m)
- real(r8), pointer :: etal_col (:) ! col lake extinction coefficient from surface data (1/m)
-
- ! Time varying variables
- real(r8), pointer :: lake_raw_col (:) ! col aerodynamic resistance for moisture (s/m)
- real(r8), pointer :: ks_col (:) ! col coefficient for calculation of decay of eddy diffusivity with depth
- real(r8), pointer :: ws_col (:) ! col surface friction velocity (m/s)
- real(r8), pointer :: ust_lake_col (:) ! col friction velocity (m/s)
- real(r8), pointer :: betaprime_col (:) ! col effective beta: sabg_lyr(p,jtop) for snow layers, beta otherwise
- real(r8), pointer :: savedtke1_col (:) ! col top level eddy conductivity from previous timestep (W/mK)
- real(r8), pointer :: lake_icefrac_col (:,:) ! col mass fraction of lake layer that is frozen
- real(r8), pointer :: lake_icefracsurf_col(:) ! col mass fraction of surface lake layer that is frozen
- real(r8), pointer :: lake_icethick_col (:) ! col ice thickness (m) (integrated if lakepuddling)
- real(r8), pointer :: lakeresist_col (:) ! col [s/m] (Needed for calc. of grnd_ch4_cond)
- real(r8), pointer :: ram1_lake_patch (:) ! patch aerodynamical resistance (s/m)
-
- contains
-
- procedure, public :: Init
- procedure, public :: Restart
- procedure, private :: InitAllocate
- procedure, private :: InitHistory
- procedure, private :: InitCold
-
- end type lakestate_type
- !-----------------------------------------------------------------------
-
-contains
-
- !------------------------------------------------------------------------
- subroutine Init(this, bounds)
-
- class(lakestate_type) :: this
- type(bounds_type), intent(in) :: bounds
-
- call this%InitAllocate ( bounds )
- call this%InitHistory ( bounds )
- call this%InitCold ( bounds )
-
- end subroutine Init
-
- !-----------------------------------------------------------------------
- subroutine InitAllocate(this, bounds)
- !
- ! !DESCRIPTION:
- ! Allocate module variables and data structures
- !
- ! !USES:
- use shr_infnan_mod, only: nan => shr_infnan_nan, assignment(=)
- use clm_varpar , only: nlevlak, nlevsno
- !
- ! !ARGUMENTS:
- class(lakestate_type) :: this
- type(bounds_type), intent(in) :: bounds
- !
- ! !LOCAL VARIABLES:
- integer :: begp, endp
- integer :: begc, endc
- !---------------------------------------------------------------------
-
- ! Initialize savedtke1 to spval so that c->g averaging will be done correctly
- ! TODO: can this be now be set to nan???
- ! Initialize ust_lake to spval to detect input from restart file if not arbinit
- ! TODO: can this be removed now???
-
- begp = bounds%begp; endp= bounds%endp
- begc = bounds%begc; endc = bounds%endc
-
- allocate(this%etal_col (begc:endc)) ; this%etal_col (:) = nan
- allocate(this%lakefetch_col (begc:endc)) ; this%lakefetch_col (:) = nan
- allocate(this%lakeresist_col (begc:endc)) ; this%lakeresist_col (:) = nan
- allocate(this%savedtke1_col (begc:endc)) ; this%savedtke1_col (:) = spval
- allocate(this%lake_icefrac_col (begc:endc,1:nlevlak)) ; this%lake_icefrac_col (:,:) = nan
- allocate(this%lake_icefracsurf_col (begc:endc)) ; this%lake_icefracsurf_col (:) = nan
- allocate(this%lake_icethick_col (begc:endc)) ; this%lake_icethick_col (:) = nan
- allocate(this%ust_lake_col (begc:endc)) ; this%ust_lake_col (:) = spval
- allocate(this%ram1_lake_patch (begp:endp)) ; this%ram1_lake_patch (:) = nan
- allocate(this%lake_raw_col (begc:endc)) ; this%lake_raw_col (:) = nan
- allocate(this%ks_col (begc:endc)) ; this%ks_col (:) = nan
- allocate(this%ws_col (begc:endc)) ; this%ws_col (:) = nan
- allocate(this%betaprime_col (begc:endc)) ; this%betaprime_col (:) = nan
-
- end subroutine InitAllocate
-
- !-----------------------------------------------------------------------
- subroutine InitHistory(this, bounds)
- !
- ! History fields initialization
- !
- ! !USES:
- use shr_infnan_mod, only: nan => shr_infnan_nan, assignment(=)
- use histFileMod , only: hist_addfld1d, hist_addfld2d
- !
- ! !ARGUMENTS:
- class(lakestate_type) :: this
- type(bounds_type), intent(in) :: bounds
- !
- ! !LOCAL VARIABLES:
- integer :: begp, endp
- integer :: begc, endc
- !---------------------------------------------------------------------
-
- begp = bounds%begp; endp= bounds%endp
- begc = bounds%begc; endc= bounds%endc
-
- this%lake_icefrac_col(begc:endc,:) = spval
- call hist_addfld2d (fname='LAKEICEFRAC', units='unitless', type2d='levlak', &
- avgflag='A', long_name='lake layer ice mass fraction', &
- ptr_col=this%lake_icefrac_col, default='inactive')
-
- this%lake_icefracsurf_col(begc:endc) = spval
- call hist_addfld1d (fname='LAKEICEFRAC_SURF', units='unitless', &
- avgflag='A', long_name='surface lake layer ice mass fraction', &
- ptr_col=this%lake_icefracsurf_col, set_nolake=spval, default='inactive')
-
- this%lake_icethick_col(begc:endc) = spval ! This will be more useful than LAKEICEFRAC for many users.
- call hist_addfld1d (fname='LAKEICETHICK', units='m', &
- avgflag='A', long_name='thickness of lake ice (including physical expansion on freezing)', &
- ptr_col=this%lake_icethick_col, set_nolake=spval, default='inactive')
-
- this%savedtke1_col(begc:endc) = spval
- call hist_addfld1d (fname='TKE1', units='W/(mK)', &
- avgflag='A', long_name='top lake level eddy thermal conductivity', &
- ptr_col=this%savedtke1_col, default='inactive')
-
- this%ram1_lake_patch(begp:endp) = spval
- call hist_addfld1d (fname='RAM_LAKE', units='s/m', &
- avgflag='A', long_name='aerodynamic resistance for momentum (lakes only)', &
- ptr_patch=this%ram1_lake_patch, set_nolake=spval, default='inactive')
-
- this%ust_lake_col(begc:endc) = spval
- call hist_addfld1d (fname='UST_LAKE', units='m/s', &
- avgflag='A', long_name='friction velocity (lakes only)', &
- ptr_col=this%ust_lake_col, set_nolake=spval, default='inactive')
-
- end subroutine InitHistory
-
- !-----------------------------------------------------------------------
- subroutine InitCold(this, bounds)
- !
- ! !DESCRIPTION:
- ! Initialize time constant and time varying module variables
- !
- ! !USES:
- use clm_varctl , only : fsurdat
- use clm_varctl , only : iulog
- use clm_varpar , only : nlevlak
- use clm_varcon , only : tkwat
- use fileutils , only : getfil
- use ncdio_pio , only : file_desc_t, ncd_defvar, ncd_io, ncd_double, ncd_int, ncd_inqvdlen
- use ncdio_pio , only : ncd_pio_openfile, ncd_inqfdims, ncd_pio_closefile, ncd_inqdid, ncd_inqdlen
- !
- ! !ARGUMENTS:
- class(lakestate_type) :: this
- type(bounds_type), intent(in) :: bounds
- !
- ! !LOCAL VARIABLES:
- integer :: c,g,i,j,l,lev
- logical :: readvar
- type(file_desc_t) :: ncid ! netcdf id
- character(len=256) :: locfn ! local filename
- real(r8) :: depthratio ! ratio of lake depth to standard deep lake depth
- real(r8) ,pointer :: lakefetch_in (:) ! read in - lakefetch
- real(r8) ,pointer :: etal_in (:) ! read in - etal
- !-----------------------------------------------------------------------
-
- !-------------------------------------------------
- ! Initialize time constant variables
- !-------------------------------------------------
-
- call getfil (fsurdat, locfn, 0)
- call ncd_pio_openfile (ncid, locfn, 0)
-
- ! Read lake eta
- allocate(etal_in(bounds%begg:bounds%endg))
- call ncd_io(ncid=ncid, varname='ETALAKE', flag='read', data=etal_in, dim1name=grlnd, readvar=readvar)
- if (.not. readvar) then
- if (masterproc) then
- write(iulog,*) 'WARNING:: ETALAKE not found on surface data set. All lake columns will have eta', &
- ' set equal to default value as a function of depth.'
- end if
- etal_in(:) = -1._r8
- end if
- do c = bounds%begc, bounds%endc
- g = col%gridcell(c)
- this%etal_col(c) = etal_in(g)
- end do
- deallocate(etal_in)
-
- ! Read lake fetch
- allocate(lakefetch_in(bounds%begg:bounds%endg))
- call ncd_io(ncid=ncid, varname='LAKEFETCH', flag='read', data=lakefetch_in, dim1name=grlnd, readvar=readvar)
- if (.not. readvar) then
- if (masterproc) then
- write(iulog,*) 'WARNING:: LAKEFETCH not found on surface data set. All lake columns will have fetch', &
- ' set equal to default value as a function of depth.'
- end if
- lakefetch_in(:) = -1._r8
- end if
- do c = bounds%begc, bounds%endc
- g = col%gridcell(c)
- this%lakefetch_col(c) = lakefetch_in(g)
- end do
- deallocate(lakefetch_in)
-
- call ncd_pio_closefile(ncid)
-
- !-------------------------------------------------
- ! Initialize time varying variables
- !-------------------------------------------------
-
- do c = bounds%begc, bounds%endc
- l = col%landunit(c)
- if (lun%lakpoi(l)) then
-
- ! Set lake ice fraction and top eddy conductivity from previous timestep
- ! Always initialize with no ice to prevent excessive ice sheets from forming when
- ! starting with old lake model that has unrealistically cold lake conseratures.
- ! Keep lake temperature as is, and the energy deficit below freezing (which is no smaller
- ! than it would have been with prognostic ice, as the temperature would then have been higher
- ! and more heat would have flowed out of the lake) will be converted to ice in the first timestep.
- this%lake_icefrac_col(c,1:nlevlak) = 0._r8
-
- ! Set lake top eddy conductivity from previous timestep
- this%savedtke1_col(c) = tkwat
-
- ! Set column friction vlocity
- this%ust_lake_col(c) = 0.1_r8
- end if
- end do
-
- end subroutine InitCold
-
- !------------------------------------------------------------------------
- subroutine Restart(this, bounds, ncid, flag)
- !
- ! !DESCRIPTION:
- ! Read/Write module information to/from restart file.
- !
- ! !USES:
- use ncdio_pio , only : file_desc_t, ncd_defvar, ncd_io, ncd_double, ncd_int, ncd_inqvdlen
- use restUtilMod
- !
- ! !ARGUMENTS:
- class(lakestate_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
- !-----------------------------------------------------------------------
-
- call restartvar(ncid=ncid, flag=flag, varname='LAKE_ICEFRAC', xtype=ncd_double, &
- dim1name='column', dim2name='levlak', switchdim=.true., &
- long_name='lake layer ice fraction', units='kg/kg', &
- interpinic_flag='interp', readvar=readvar, data=this%lake_icefrac_col)
-
- call restartvar(ncid=ncid, flag=flag, varname='SAVEDTKE1', xtype=ncd_double, &
- dim1name='column', &
- long_name='top lake layer eddy conductivity', units='W/(m K)', &
- interpinic_flag='interp', readvar=readvar, data=this%savedtke1_col)
-
- call restartvar(ncid=ncid, flag=flag, varname='USTLAKE', xtype=ncd_double, &
- dim1name='column', &
- long_name='friction velocity for lakes', units='m/s', &
- interpinic_flag='interp', readvar=readvar, data=this%ust_lake_col)
-
- end subroutine Restart
-
-end module LakeStateType
-
diff --git a/src/biogeophys/OzoneBaseMod.F90 b/src/biogeophys/OzoneBaseMod.F90
deleted file mode 100644
index c50818f3..00000000
--- a/src/biogeophys/OzoneBaseMod.F90
+++ /dev/null
@@ -1,146 +0,0 @@
-module OzoneBaseMod
-
- !-----------------------------------------------------------------------
- ! !DESCRIPTION:
- ! Define the interface for ozone_type, which calculates ozone-induced stress. The type
- ! defined here is abstract; it will get instantiated as a concrete type that extends
- ! this base type (e.g., an ozone-off or ozone-on version).
- !
- ! !USES:
- use shr_kind_mod, only : r8 => shr_kind_r8
- use decompMod , only : bounds_type
-
- implicit none
- save
- private
-
- ! !PUBLIC TYPES:
- type, abstract, public :: ozone_base_type
- private
-
- ! Public data members
- ! These should be treated as read-only by other modules (except that they can be
- ! modified by extensions of the ozone_base_type)
- real(r8), pointer, public :: o3coefvsha_patch(:) ! ozone coefficient for photosynthesis, shaded leaves (0 - 1)
- real(r8), pointer, public :: o3coefvsun_patch(:) ! ozone coefficient for photosynthesis, sunlit leaves (0 - 1)
- real(r8), pointer, public :: o3coefgsha_patch(:) ! ozone coefficient for conductance, shaded leaves (0 - 1)
- real(r8), pointer, public :: o3coefgsun_patch(:) ! ozone coefficient for conductance, sunlit leaves (0 - 1)
-
-
- contains
- ! The following routines need to be implemented by all type extensions
- procedure(Init_interface) , public, deferred :: Init
- procedure(Restart_interface) , public, deferred :: Restart
- procedure(CalcOzoneStress_interface) , public, deferred :: CalcOzoneStress
-
- ! The following routines should only be called by extensions of the ozone_base_type
- procedure, public :: InitAllocateBase
- procedure, public :: InitColdBase
-
- end type ozone_base_type
-
- abstract interface
-
- subroutine Init_interface(this, bounds)
- use decompMod, only : bounds_type
- import :: ozone_base_type
-
- class(ozone_base_type), intent(inout) :: this
- type(bounds_type), intent(in) :: bounds
- end subroutine Init_interface
-
- subroutine Restart_interface(this, bounds, ncid, flag)
- use decompMod , only : bounds_type
- use ncdio_pio , only : file_desc_t
- import :: ozone_base_type
-
- class(ozone_base_type) :: this
- type(bounds_type) , intent(in) :: bounds
- type(file_desc_t) , intent(inout) :: ncid ! netcdf id
- character(len=*) , intent(in) :: flag ! 'read', 'write' or 'define'
- end subroutine Restart_interface
-
- subroutine CalcOzoneStress_interface(this, bounds, num_exposedvegp, filter_exposedvegp, &
- forc_pbot, forc_th, rssun, rssha, rb, ram, tlai)
- use decompMod , only : bounds_type
- use shr_kind_mod , only : r8 => shr_kind_r8
- import :: ozone_base_type
-
- class(ozone_base_type) , intent(inout) :: this
- type(bounds_type) , intent(in) :: bounds
- integer , intent(in) :: num_exposedvegp ! number of points in filter_exposedvegp
- integer , intent(in) :: filter_exposedvegp(:) ! patch filter for non-snow-covered veg
- real(r8) , intent(in) :: forc_pbot( bounds%begc: ) ! atmospheric pressure (Pa)
- real(r8) , intent(in) :: forc_th( bounds%begc: ) ! atmospheric potential temperature (K)
- real(r8) , intent(in) :: rssun( bounds%begp: ) ! leaf stomatal resistance, sunlit leaves (s/m)
- real(r8) , intent(in) :: rssha( bounds%begp: ) ! leaf stomatal resistance, shaded leaves (s/m)
- real(r8) , intent(in) :: rb( bounds%begp: ) ! boundary layer resistance (s/m)
- real(r8) , intent(in) :: ram( bounds%begp: ) ! aerodynamical resistance (s/m)
- real(r8) , intent(in) :: tlai( bounds%begp: ) ! one-sided leaf area index, no burying by snow
- end subroutine CalcOzoneStress_interface
-
- end interface
-
-contains
-
- !-----------------------------------------------------------------------
- subroutine InitAllocateBase(this, bounds)
- !
- ! !DESCRIPTION:
- ! Allocate variables in the base class
- !
- ! !USES:
- use shr_infnan_mod , only : nan => shr_infnan_nan, assignment(=)
- !
- ! !ARGUMENTS:
- class(ozone_base_type), intent(inout) :: this
- type(bounds_type), intent(in) :: bounds
- !
- ! !LOCAL VARIABLES:
- integer :: begp, endp
-
- character(len=*), parameter :: subname = 'InitAllocateBase'
- !-----------------------------------------------------------------------
-
- begp = bounds%begp
- endp = bounds%endp
-
- allocate(this%o3coefvsha_patch(begp:endp)) ; this%o3coefvsha_patch(:) = nan
- allocate(this%o3coefvsun_patch(begp:endp)) ; this%o3coefvsun_patch(:) = nan
- allocate(this%o3coefgsha_patch(begp:endp)) ; this%o3coefgsha_patch(:) = nan
- allocate(this%o3coefgsun_patch(begp:endp)) ; this%o3coefgsun_patch(:) = nan
-
- end subroutine InitAllocateBase
-
-
- !-----------------------------------------------------------------------
- subroutine InitColdBase(this, bounds)
- !
- ! !DESCRIPTION:
- ! Do cold start initialization for variables in the base class. Note that this
- ! initialization will be the same for all ozone implementations, including the
- ! ozone-off implementation.
- !
- ! !USES:
- !
- ! !ARGUMENTS:
- class(ozone_base_type), intent(inout) :: this
- type(bounds_type), intent(in) :: bounds
- !
- ! !LOCAL VARIABLES:
- integer :: begp, endp
-
- character(len=*), parameter :: subname = 'InitColdBase'
- !-----------------------------------------------------------------------
-
- begp = bounds%begp
- endp = bounds%endp
-
- this%o3coefvsha_patch(begp:endp) = 1._r8
- this%o3coefvsun_patch(begp:endp) = 1._r8
- this%o3coefgsha_patch(begp:endp) = 1._r8
- this%o3coefgsun_patch(begp:endp) = 1._r8
-
- end subroutine InitColdBase
-
-end module OzoneBaseMod
diff --git a/src/biogeophys/OzoneFactoryMod.F90 b/src/biogeophys/OzoneFactoryMod.F90
deleted file mode 100644
index 2b28587a..00000000
--- a/src/biogeophys/OzoneFactoryMod.F90
+++ /dev/null
@@ -1,53 +0,0 @@
-module OzoneFactoryMod
-
- !---------------------------------------------------------------------------
- ! !DESCRIPTION:
- ! Factory to create an instance of ozone_base_type. This module figures out the
- ! particular type to return.
- !
- ! !USES:
- use decompMod , only : bounds_type
-
- implicit none
- save
- private
-
- !
- ! !PUBLIC ROUTINES:
- public :: create_and_init_ozone_type ! create an object of class ozone_base_type
-
-contains
-
- !-----------------------------------------------------------------------
- function create_and_init_ozone_type(bounds) result(ozone)
- !
- ! !DESCRIPTION:
- ! Create and initialize an object of ozone_base_type, and return this object. The
- ! particular type is determined based on the use_ozone namelist parameter.
- !
- ! !USES:
- use clm_varctl , only : use_ozone
- use OzoneBaseMod , only : ozone_base_type
- use OzoneOffMod , only : ozone_off_type
- use OzoneMod , only : ozone_type
- !
- ! !ARGUMENTS:
- class(ozone_base_type), allocatable :: ozone ! function result
- type(bounds_type), intent(in) :: bounds
- !
- ! !LOCAL VARIABLES:
-
- character(len=*), parameter :: subname = 'create_and_init_ozone_type'
- !-----------------------------------------------------------------------
-
- if (use_ozone) then
- allocate(ozone, source = ozone_type())
- else
- allocate(ozone, source = ozone_off_type())
- end if
-
- call ozone%Init(bounds)
-
- end function create_and_init_ozone_type
-
-end module OzoneFactoryMod
diff --git a/src/biogeophys/OzoneMod.F90 b/src/biogeophys/OzoneMod.F90
deleted file mode 100644
index 6c0e3577..00000000
--- a/src/biogeophys/OzoneMod.F90
+++ /dev/null
@@ -1,543 +0,0 @@
-module OzoneMod
-
- !-----------------------------------------------------------------------
- ! !DESCRIPTION:
- ! Calculates ozone-induced stress.
- !
- ! Note that the ozone calculations need to happen AFTER rssun and rsshade are computed
- ! by the Photosynthesis routine. However, Photosynthesis also uses the ozone stress
- ! computed here. Thus, the ozone stress computed in timestep i is applied in timestep
- ! (i+1), requiring these stresses to be saved on the restart file.
- !
- ! Developed by Danica Lombardozzi.
- !
- ! !USES:
-#include "shr_assert.h"
- use shr_kind_mod, only : r8 => shr_kind_r8
- use decompMod , only : bounds_type
- use clm_varcon , only : spval
- use shr_log_mod , only : errMsg => shr_log_errMsg
- use OzoneBaseMod, only : ozone_base_type
- use abortutils , only : endrun
-
- implicit none
- save
- private
-
- ! !PUBLIC TYPES:
- type, extends(ozone_base_type), public :: ozone_type
- private
- ! Private data members
- real(r8), pointer :: o3uptakesha_patch(:) ! ozone dose, shaded leaves (mmol O3/m^2)
- real(r8), pointer :: o3uptakesun_patch(:) ! ozone dose, sunlit leaves (mmol O3/m^2)
-
- ! NOTE(wjs, 2014-09-29) tlai_old_patch really belongs alongside tlai_patch in
- ! CanopyStateType. But there are problems with any way I can think to implement
- ! that:
- !
- ! - Updating tlai_old from a call in clm_driver, just before tlai is updated: This
- ! is problematic to do correctly because tlai is updated in different places
- ! depending on whether you're using SP, CN or ED.
- !
- ! - Updating tlai_old within each routine that updates tlai: This feels fragile,
- ! since it depends on each scheme remembering to do this update at the correct
- ! time.
- !
- ! - Making tlai a private member of CanopyFluxes, with getter and setter methods.
- ! Then the setter method would also set tlai_old. This feels like the most robust
- ! solution, but we don't have any precedent for using getters and setters for data
- ! arrays.
- real(r8), pointer :: tlai_old_patch(:) ! tlai from last time step
-
- contains
- ! Public routines
- procedure, public :: Init
- procedure, public :: Restart
- procedure, public :: CalcOzoneStress
-
- ! Private routines
- procedure, private :: InitAllocate
- procedure, private :: InitHistory
- procedure, private :: InitCold
-
- ! Calculate ozone stress for a single point, for just sunlit or shaded leaves
- procedure, private, nopass :: CalcOzoneStressOnePoint
- end type ozone_type
-
- interface ozone_type
- module procedure constructor
- end interface ozone_type
-
- ! !PRIVATE TYPES:
-
- ! TODO(wjs, 2014-09-29) This parameter will eventually become a spatially-varying
- ! value, obtained from ATM
- real(r8), parameter :: forc_ozone = 100._r8 * 1.e-9_r8 ! ozone partial pressure [mol/mol]
-
- ! TODO(wjs, 2014-09-29) The following parameters should eventually be moved to the
- ! params file. Parameters differentiated on veg type should be put on the params file
- ! with a pft dimension.
-
- ! o3:h2o resistance ratio defined by Sitch et al. 2007
- real(r8), parameter :: ko3 = 1.67_r8
-
- ! LAI threshold for LAIs that asymptote and don't reach 0
- real(r8), parameter :: lai_thresh = 0.5_r8
-
- ! threshold below which o3flux is set to 0 (nmol m^-2 s^-1)
- real(r8), parameter :: o3_flux_threshold = 0.8_r8
-
- ! o3 intercepts and slopes for photosynthesis
- real(r8), parameter :: needleleafPhotoInt = 0.8390_r8 ! units = unitless
- real(r8), parameter :: needleleafPhotoSlope = 0._r8 ! units = per mmol m^-2
- real(r8), parameter :: broadleafPhotoInt = 0.8752_r8 ! units = unitless
- real(r8), parameter :: broadleafPhotoSlope = 0._r8 ! units = per mmol m^-2
- real(r8), parameter :: nonwoodyPhotoInt = 0.8021_r8 ! units = unitless
- real(r8), parameter :: nonwoodyPhotoSlope = -0.0009_r8 ! units = per mmol m^-2
-
- ! o3 intercepts and slopes for conductance
- real(r8), parameter :: needleleafCondInt = 0.7823_r8 ! units = unitless
- real(r8), parameter :: needleleafCondSlope = 0.0048_r8 ! units = per mmol m^-2
- real(r8), parameter :: broadleafCondInt = 0.9125_r8 ! units = unitless
- real(r8), parameter :: broadleafCondSlope = 0._r8 ! units = per mmol m^-2
- real(r8), parameter :: nonwoodyCondInt = 0.7511_r8 ! units = unitless
- real(r8), parameter :: nonwoodyCondSlope = 0._r8 ! units = per mmol m^-2
-
- character(len=*), parameter, private :: sourcefile = &
- __FILE__
-
-contains
-
- ! ========================================================================
- ! Infrastructure routines (initialization, restart, etc.)
- ! ========================================================================
-
- !-----------------------------------------------------------------------
- function constructor() result(ozone)
- !
- ! !DESCRIPTION:
- ! Return an instance of ozone_type
- !
- ! !USES:
- !
- ! !ARGUMENTS:
- type(ozone_type) :: ozone ! function result
- !
- ! !LOCAL VARIABLES:
-
- character(len=*), parameter :: subname = 'constructor'
- !-----------------------------------------------------------------------
-
- ! DO NOTHING (simply return a variable of the appropriate type)
-
- ! Eventually this should call the Init routine (or replace the Init routine
- ! entirely). But I think it would be confusing to do that until we switch everything
- ! to use a constructor rather than the init routine.
-
- end function constructor
-
-
- !-----------------------------------------------------------------------
- subroutine Init(this, bounds)
- !
- ! !DESCRIPTION:
- ! Initialize ozone data structure
- !
- ! !ARGUMENTS:
- class(ozone_type), intent(inout) :: this
- type(bounds_type), intent(in) :: bounds
- !-----------------------------------------------------------------------
-
- call this%InitAllocate(bounds)
- call this%InitHistory(bounds)
- call this%InitCold(bounds)
-
- end subroutine Init
-
-
- !-----------------------------------------------------------------------
- subroutine InitAllocate(this, bounds)
- !
- ! !DESCRIPTION:
- ! Allocate memory for ozone data structure
- !
- ! !USES:
- use shr_infnan_mod , only : nan => shr_infnan_nan, assignment(=)
- !
- ! !ARGUMENTS:
- class(ozone_type), intent(inout) :: this
- type(bounds_type), intent(in) :: bounds
- !
- ! !LOCAL VARIABLES:
- integer :: begp, endp
- !-----------------------------------------------------------------------
-
- begp = bounds%begp
- endp = bounds%endp
-
- call this%InitAllocateBase(bounds)
-
- allocate(this%o3uptakesha_patch(begp:endp)) ; this%o3uptakesha_patch(:) = nan
- allocate(this%o3uptakesun_patch(begp:endp)) ; this%o3uptakesun_patch(:) = nan
- allocate(this%tlai_old_patch(begp:endp)) ; this%tlai_old_patch(:) = nan
-
- end subroutine InitAllocate
-
- !-----------------------------------------------------------------------
- subroutine InitHistory(this, bounds)
- !
- ! !DESCRIPTION:
- ! Initialize ozone history variables
- !
- ! !USES:
- use histFileMod , only : hist_addfld1d
- !
- ! !ARGUMENTS:
- class(ozone_type), intent(inout) :: this
- type(bounds_type), intent(in) :: bounds
- !
- ! !LOCAL VARIABLES:
- integer :: begp, endp
-
- character(len=*), parameter :: subname = 'InitHistory'
- !-----------------------------------------------------------------------
-
- begp = bounds%begp
- endp = bounds%endp
-
- this%o3uptakesun_patch(begp:endp) = spval
- call hist_addfld1d (fname='O3UPTAKESUN', units='mmol/m^2', &
- avgflag='A', long_name='total ozone flux into sunlit leaves', &
- ptr_patch=this%o3uptakesun_patch, default='inactive')
-
- this%o3uptakesha_patch(begp:endp) = spval
- call hist_addfld1d (fname='O3UPTAKESHA', units='mmol/m^2', &
- avgflag='A', long_name='total ozone flux into shaded leaves', &
- ptr_patch=this%o3uptakesha_patch, default='inactive')
-
- end subroutine InitHistory
-
- !-----------------------------------------------------------------------
- subroutine InitCold(this, bounds)
- !
- ! !DESCRIPTION:
- ! Perform cold-start initialization for ozone
- !
- ! !ARGUMENTS:
- class(ozone_type), intent(inout) :: this
- type(bounds_type), intent(in) :: bounds
- !
- ! !LOCAL VARIABLES:
- integer :: begp, endp
-
- character(len=*), parameter :: subname = 'InitCold'
- !-----------------------------------------------------------------------
-
- begp = bounds%begp
- endp = bounds%endp
-
- call this%InitColdBase(bounds)
-
- this%o3uptakesha_patch(begp:endp) = 0._r8
- this%o3uptakesun_patch(begp:endp) = 0._r8
- this%tlai_old_patch(begp:endp) = 0._r8
-
- end subroutine InitCold
-
- !-----------------------------------------------------------------------
- subroutine Restart(this, bounds, ncid, flag)
- !
- ! !DESCRIPTION:
- ! Handle restart of ozone variables.
- !
- ! !USES:
- use ncdio_pio , only : file_desc_t, ncd_inqvdlen, ncd_double
- use restUtilMod
- !
- ! !ARGUMENTS:
- class(ozone_type) :: this
- type(bounds_type), intent(in) :: bounds
- type(file_desc_t), intent(inout) :: ncid ! netcdf id
- character(len=*) , intent(in) :: flag ! 'read', 'write' or 'define'
- !
- ! !LOCAL VARIABLES:
- logical :: readvar
-
- character(len=*), parameter :: subname = 'Restart'
- !-----------------------------------------------------------------------
-
- call restartvar(ncid=ncid, flag=flag, varname='o3_tlaiold', xtype=ncd_double, &
- dim1name='pft', &
- long_name='one-sided leaf area index, from previous timestep, for ozone calculations', units='', &
- readvar=readvar, interpinic_flag='interp', data=this%tlai_old_patch)
-
- call restartvar(ncid=ncid, flag=flag, varname='o3uptakesha', xtype=ncd_double, &
- dim1name='pft', &
- long_name='ozone uptake for shaded leaves', units='mmol m^-3', &
- readvar=readvar, interpinic_flag='interp', data=this%o3uptakesha_patch)
-
- call restartvar(ncid=ncid, flag=flag, varname='o3uptakesun', xtype=ncd_double, &
- dim1name='pft', &
- long_name='ozone uptake for sunlit leaves', units='mmol m^-3', &
- readvar=readvar, interpinic_flag='interp', data=this%o3uptakesun_patch)
-
- call restartvar(ncid=ncid, flag=flag, varname='o3coefvsun', xtype=ncd_double, &
- dim1name='pft', &
- long_name='ozone coefficient for photosynthesis for sunlit leaves', units='unitless', &
- readvar=readvar, interpinic_flag='interp', data=this%o3coefvsun_patch)
-
- call restartvar(ncid=ncid, flag=flag, varname='o3coefgsun', xtype=ncd_double, &
- dim1name='pft', &
- long_name='ozone coefficient for stomatal conductance for sunlit leaves', units='unitless', &
- readvar=readvar, interpinic_flag='interp', data=this%o3coefgsun_patch)
-
- call restartvar(ncid=ncid, flag=flag, varname='o3coefvsha', xtype=ncd_double, &
- dim1name='pft', &
- long_name='ozone coefficient for photosynthesis for shaded leaves', units='unitless', &
- readvar=readvar, interpinic_flag='interp', data=this%o3coefvsha_patch)
-
- call restartvar(ncid=ncid, flag=flag, varname='o3coefgsha', xtype=ncd_double, &
- dim1name='pft', &
- long_name='ozone coefficient for stomatal conductance for shaded leaves', units='unitless', &
- readvar=readvar, interpinic_flag='interp', data=this%o3coefgsha_patch)
-
- end subroutine Restart
-
- ! ========================================================================
- ! Science routines
- ! ========================================================================
-
- !-----------------------------------------------------------------------
- subroutine CalcOzoneStress(this, bounds, num_exposedvegp, filter_exposedvegp, &
- forc_pbot, forc_th, rssun, rssha, rb, ram, tlai)
- !
- ! !DESCRIPTION:
- ! Calculate ozone stress.
- !
- ! !USES:
- use PatchType , only : patch
- !
- ! !ARGUMENTS:
- class(ozone_type) , intent(inout) :: this
- type(bounds_type) , intent(in) :: bounds
- integer , intent(in) :: num_exposedvegp ! number of points in filter_exposedvegp
- integer , intent(in) :: filter_exposedvegp(:) ! patch filter for non-snow-covered veg
- real(r8) , intent(in) :: forc_pbot( bounds%begc: ) ! atmospheric pressure (Pa)
- real(r8) , intent(in) :: forc_th( bounds%begc: ) ! atmospheric potential temperature (K)
- real(r8) , intent(in) :: rssun( bounds%begp: ) ! leaf stomatal resistance, sunlit leaves (s/m)
- real(r8) , intent(in) :: rssha( bounds%begp: ) ! leaf stomatal resistance, shaded leaves (s/m)
- real(r8) , intent(in) :: rb( bounds%begp: ) ! boundary layer resistance (s/m)
- real(r8) , intent(in) :: ram( bounds%begp: ) ! aerodynamical resistance (s/m)
- real(r8) , intent(in) :: tlai( bounds%begp: ) ! one-sided leaf area index, no burying by snow
- !
- ! !LOCAL VARIABLES:
- integer :: fp ! filter index
- integer :: p ! patch index
- integer :: c ! column index
-
- character(len=*), parameter :: subname = 'CalcOzoneStress'
- !-----------------------------------------------------------------------
-
- ! Enforce expected array sizes
- SHR_ASSERT_ALL((ubound(forc_pbot) == (/bounds%endc/)), errMsg(sourcefile, __LINE__))
- SHR_ASSERT_ALL((ubound(forc_th) == (/bounds%endc/)), errMsg(sourcefile, __LINE__))
- SHR_ASSERT_ALL((ubound(rssun) == (/bounds%endp/)), errMsg(sourcefile, __LINE__))
- SHR_ASSERT_ALL((ubound(rssha) == (/bounds%endp/)), errMsg(sourcefile, __LINE__))
- SHR_ASSERT_ALL((ubound(rb) == (/bounds%endp/)), errMsg(sourcefile, __LINE__))
- SHR_ASSERT_ALL((ubound(ram) == (/bounds%endp/)), errMsg(sourcefile, __LINE__))
- SHR_ASSERT_ALL((ubound(tlai) == (/bounds%endp/)), errMsg(sourcefile, __LINE__))
-
- associate( &
- o3coefvsha => this%o3coefvsha_patch , & ! Output: [real(r8) (:)] ozone coef
- o3coefvsun => this%o3coefvsun_patch , & ! Output: [real(r8) (:)] ozone coef
- o3coefgsha => this%o3coefgsha_patch , & ! Output: [real(r8) (:)] ozone coef
- o3coefgsun => this%o3coefgsun_patch , & ! Output: [real(r8) (:)] ozone coef
- o3uptakesha => this%o3uptakesha_patch , & ! Output: [real(r8) (:)] ozone dose
- o3uptakesun => this%o3uptakesun_patch , & ! Output: [real(r8) (:)] ozone dose
- tlai_old => this%tlai_old_patch & ! Output: [real(r8) (:)] tlai from last time step
- )
-
- do fp = 1, num_exposedvegp
- p = filter_exposedvegp(fp)
- c = patch%column(p)
-
-! if (.not.patch%is_fates(p)) then ! When FATES coexists with other vegetation,
- ! or when it has an ozone compatible module, this
- ! logic will likely come into play
-
- ! Ozone stress for shaded leaves
- call CalcOzoneStressOnePoint( &
- forc_ozone=forc_ozone, forc_pbot=forc_pbot(c), forc_th=forc_th(c), &
- rs=rssha(p), rb=rb(p), ram=ram(p), &
- tlai=tlai(p), tlai_old=tlai_old(p), pft_type=patch%itype(p), &
- o3uptake=o3uptakesha(p), o3coefv=o3coefvsha(p), o3coefg=o3coefgsha(p))
-
- ! Ozone stress for sunlit leaves
- call CalcOzoneStressOnePoint( &
- forc_ozone=forc_ozone, forc_pbot=forc_pbot(c), forc_th=forc_th(c), &
- rs=rssun(p), rb=rb(p), ram=ram(p), &
- tlai=tlai(p), tlai_old=tlai_old(p), pft_type=patch%itype(p), &
- o3uptake=o3uptakesun(p), o3coefv=o3coefvsun(p), o3coefg=o3coefgsun(p))
-
- tlai_old(p) = tlai(p)
-
-! else
-! ! FATES is fundamentlaly incompatible with this type of patch-level
-! ! association with plant functional type, so for the time
-! ! being, fates patches will just push these values to invalid
-! o3uptakesha(p) = spval
-! o3coefvsha(p) = spval
-! o3coefgsha(p) = spval
-! o3uptakesun(p) = spval
-! o3coefvsun(p) = spval
-! o3coefgsun(p) = spval
-!
-! end if
-
-! else
-! ! FATES is fundamentlaly incompatible with this type of patch-level
-! ! association with plant functional type, so for the time
-! ! being, fates patches will just push these values to invalid
-! o3uptakesha(p) = spval
-! o3coefvsha(p) = spval
-! o3coefgsha(p) = spval
-! o3uptakesun(p) = spval
-! o3coefvsun(p) = spval
-! o3coefgsun(p) = spval
-!
-! end if
-
- end do
-
- end associate
-
- end subroutine CalcOzoneStress
-
- !-----------------------------------------------------------------------
- subroutine CalcOzoneStressOnePoint( &
- forc_ozone, forc_pbot, forc_th, &
- rs, rb, ram, &
- tlai, tlai_old, pft_type, &
- o3uptake, o3coefv, o3coefg)
- !
- ! !DESCRIPTION:
- ! Calculates ozone stress for a single point, for just sunlit or shaded leaves
- !
- ! !USES:
- use shr_const_mod , only : SHR_CONST_RGAS
- use pftconMod , only : pftcon
- use clm_time_manager , only : get_step_size
- !
- ! !ARGUMENTS:
- real(r8) , intent(in) :: forc_ozone ! ozone partial pressure (mol/mol)
- real(r8) , intent(in) :: forc_pbot ! atmospheric pressure (Pa)
- real(r8) , intent(in) :: forc_th ! atmospheric potential temperature (K)
- real(r8) , intent(in) :: rs ! leaf stomatal resistance (s/m)
- real(r8) , intent(in) :: rb ! boundary layer resistance (s/m)
- real(r8) , intent(in) :: ram ! aerodynamical resistance (s/m)
- real(r8) , intent(in) :: tlai ! one-sided leaf area index, no burying by snow
- real(r8) , intent(in) :: tlai_old ! tlai from last time step
- integer , intent(in) :: pft_type ! vegetation type, for indexing into pftvarcon arrays
- real(r8) , intent(inout) :: o3uptake ! ozone entering the leaf
- real(r8) , intent(out) :: o3coefv ! ozone coefficient for photosynthesis (0 - 1)
- real(r8) , intent(out) :: o3coefg ! ozone coefficient for conductance (0 - 1)
- !
- ! !LOCAL VARIABLES:
- integer :: dtime ! land model time step (sec)
- real(r8) :: dtimeh ! time step in hours
- real(r8) :: o3concnmolm3 ! o3 concentration (nmol/m^3)
- real(r8) :: o3flux ! instantaneous o3 flux (nmol m^-2 s^-1)
- real(r8) :: o3fluxcrit ! instantaneous o3 flux beyond threshold (nmol m^-2 s^-1)
- real(r8) :: o3fluxperdt ! o3 flux per timestep (mmol m^-2)
- real(r8) :: heal ! o3uptake healing rate based on % of new leaves growing (mmol m^-2)
- real(r8) :: leafturn ! leaf turnover time / mortality rate (per hour)
- real(r8) :: decay ! o3uptake decay rate based on leaf lifetime (mmol m^-2)
- real(r8) :: photoInt ! intercept for photosynthesis
- real(r8) :: photoSlope ! slope for photosynthesis
- real(r8) :: condInt ! intercept for conductance
- real(r8) :: condSlope ! slope for conductance
-
- character(len=*), parameter :: subname = 'CalcOzoneStressOnePoint'
- !-----------------------------------------------------------------------
-
- ! convert o3 from mol/mol to nmol m^-3
- o3concnmolm3 = forc_ozone * 1.e9_r8 * (forc_pbot/(forc_th*SHR_CONST_RGAS*0.001_r8))
-
- ! calculate instantaneous flux
- o3flux = o3concnmolm3/ (ko3*rs+ rb + ram)
-
- ! apply o3 flux threshold
- if (o3flux < o3_flux_threshold) then
- o3fluxcrit = 0._r8
- else
- o3fluxcrit = o3flux - o3_flux_threshold
- endif
-
- dtime = get_step_size()
- dtimeh = dtime / 3600._r8
-
- ! calculate o3 flux per timestep
- o3fluxperdt = o3fluxcrit * dtime * 0.000001_r8
-
- if (tlai > lai_thresh) then
- ! checking if new leaf area was added
- if (tlai - tlai_old > 0) then
- ! minimizing o3 damage to new leaves
- heal = max(0._r8,(((tlai-tlai_old)/tlai)*o3fluxperdt))
- else
- heal = 0._r8
- endif
-
- if (pftcon%evergreen(pft_type) == 1) then
- leafturn = 1._r8/(pftcon%leaf_long(pft_type)*365._r8*24._r8)
- else
- leafturn = 0._r8
- endif
-
- ! o3 uptake decay based on leaf lifetime for evergreen plants
- decay = o3uptake * leafturn * dtimeh
- !cumulative uptake (mmol m^-2)
- o3uptake = max(0._r8, o3uptake + o3fluxperdt - decay - heal)
-
- else
- o3uptake = 0._r8
- end if
-
-
- if (o3uptake == 0._r8) then
- ! No o3 damage if no o3 uptake
- o3coefv = 1._r8
- o3coefg = 1._r8
- else
- ! Determine parameter values for this pft
- ! TODO(wjs, 2014-10-01) Once these parameters are moved into the params file, this
- ! logic can be removed.
- if (pft_type>3) then
- if (pftcon%woody(pft_type)==0) then
- photoInt = nonwoodyPhotoInt
- photoSlope = nonwoodyPhotoSlope
- condInt = nonwoodyCondInt
- condSlope = nonwoodyCondSlope
- else
- photoInt = broadleafPhotoInt
- photoSlope = broadleafPhotoSlope
- condInt = broadleafCondInt
- condSlope = broadleafCondSlope
- end if
- else
- photoInt = needleleafPhotoInt
- photoSlope = needleleafPhotoSlope
- condInt = needleleafCondInt
- condSlope = needleleafCondSlope
- end if
-
- ! Apply parameter values to compute o3 coefficients
- o3coefv = max(0._r8, min(1._r8, photoInt + photoSlope * o3uptake))
- o3coefg = max(0._r8, min(1._r8, condInt + condSlope * o3uptake))
-
- end if
-
- end subroutine CalcOzoneStressOnePoint
-
-
-end module OzoneMod
diff --git a/src/biogeophys/OzoneOffMod.F90 b/src/biogeophys/OzoneOffMod.F90
deleted file mode 100644
index 8d0df71f..00000000
--- a/src/biogeophys/OzoneOffMod.F90
+++ /dev/null
@@ -1,118 +0,0 @@
-module OzoneOffMod
-
- !-----------------------------------------------------------------------
- ! !DESCRIPTION:
- ! Provides an implementatio of ozone_base_type for the ozone-off case. Note that very
- ! little needs to be done in this case, so this module mainly provides empty
- ! implementations to satisfy the interface.
- !
- ! !USES:
-#include "shr_assert.h"
- use shr_kind_mod, only : r8 => shr_kind_r8
- use shr_log_mod , only : errMsg => shr_log_errMsg
- use decompMod , only : bounds_type
- use OzoneBaseMod, only : ozone_base_type
-
- implicit none
- save
- private
-
- ! !PUBLIC TYPES:
- type, extends(ozone_base_type), public :: ozone_off_type
- private
- contains
- procedure, public :: Init
- procedure, public :: Restart
- procedure, public :: CalcOzoneStress
- end type ozone_off_type
-
- interface ozone_off_type
- module procedure constructor
- end interface ozone_off_type
-
- character(len=*), parameter, private :: sourcefile = &
- __FILE__
-
-contains
-
- !-----------------------------------------------------------------------
- function constructor() result(ozone_off)
- !
- ! !DESCRIPTION:
- ! Return an instance of ozone_off_type
- !
- ! !USES:
- !
- ! !ARGUMENTS:
- type(ozone_off_type) :: ozone_off ! function result
- !
- ! !LOCAL VARIABLES:
-
- character(len=*), parameter :: subname = 'constructor'
- !-----------------------------------------------------------------------
-
- ! DO NOTHING (simply return a variable of the appropriate type)
-
- ! Eventually this should call the Init routine (or replace the Init routine
- ! entirely). But I think it would be confusing to do that until we switch everything
- ! to use a constructor rather than the init routine.
-
- end function constructor
-
-
- subroutine Init(this, bounds)
- class(ozone_off_type) , intent(inout) :: this
- type(bounds_type) , intent(in) :: bounds
-
- call this%InitAllocateBase(bounds)
- call this%InitColdBase(bounds)
- end subroutine Init
-
- subroutine Restart(this, bounds, ncid, flag)
- use ncdio_pio , only : file_desc_t
-
- class(ozone_off_type) :: this
- type(bounds_type), intent(in) :: bounds
- type(file_desc_t) , intent(inout) :: ncid ! netcdf id
- character(len=*) , intent(in) :: flag ! 'read', 'write' or 'define'
-
- ! DO NOTHING
-
- end subroutine Restart
-
- subroutine CalcOzoneStress(this, bounds, num_exposedvegp, filter_exposedvegp, &
- forc_pbot, forc_th, rssun, rssha, rb, ram, tlai)
-
- class(ozone_off_type) , intent(inout) :: this
- type(bounds_type) , intent(in) :: bounds
- integer , intent(in) :: num_exposedvegp ! number of points in filter_exposedvegp
- integer , intent(in) :: filter_exposedvegp(:) ! patch filter for non-snow-covered veg
- real(r8) , intent(in) :: forc_pbot( bounds%begc: ) ! atmospheric pressure (Pa)
- real(r8) , intent(in) :: forc_th( bounds%begc: ) ! atmospheric potential temperature (K)
- real(r8) , intent(in) :: rssun( bounds%begp: ) ! leaf stomatal resistance, sunlit leaves (s/m)
- real(r8) , intent(in) :: rssha( bounds%begp: ) ! leaf stomatal resistance, shaded leaves (s/m)
- real(r8) , intent(in) :: rb( bounds%begp: ) ! boundary layer resistance (s/m)
- real(r8) , intent(in) :: ram( bounds%begp: ) ! aerodynamical resistance (s/m)
- real(r8) , intent(in) :: tlai( bounds%begp: ) ! one-sided leaf area index, no burying by snow
-
- ! Enforce expected array sizes (mainly so that a debug-mode threaded test with
- ! ozone-off can pick up problems with the call to this routine)
- SHR_ASSERT_ALL((ubound(forc_pbot) == (/bounds%endc/)), errMsg(sourcefile, __LINE__))
- SHR_ASSERT_ALL((ubound(forc_th) == (/bounds%endc/)), errMsg(sourcefile, __LINE__))
- SHR_ASSERT_ALL((ubound(rssun) == (/bounds%endp/)), errMsg(sourcefile, __LINE__))
- SHR_ASSERT_ALL((ubound(rssha) == (/bounds%endp/)), errMsg(sourcefile, __LINE__))
- SHR_ASSERT_ALL((ubound(rb) == (/bounds%endp/)), errMsg(sourcefile, __LINE__))
- SHR_ASSERT_ALL((ubound(ram) == (/bounds%endp/)), errMsg(sourcefile, __LINE__))
- SHR_ASSERT_ALL((ubound(tlai) == (/bounds%endp/)), errMsg(sourcefile, __LINE__))
-
- ! Explicitly set outputs to 1. This isn't really needed, because they should still be
- ! at 1 from cold-start initialization, but do this for clarity here.
-
- this%o3coefvsha_patch(bounds%begp:bounds%endp) = 1._r8
- this%o3coefvsun_patch(bounds%begp:bounds%endp) = 1._r8
- this%o3coefgsha_patch(bounds%begp:bounds%endp) = 1._r8
- this%o3coefgsun_patch(bounds%begp:bounds%endp) = 1._r8
-
- end subroutine CalcOzoneStress
-
-end module OzoneOffMod
diff --git a/src/biogeophys/PhotosynthesisMod.F90 b/src/biogeophys/PhotosynthesisMod.F90
deleted file mode 100644
index 311780b6..00000000
--- a/src/biogeophys/PhotosynthesisMod.F90
+++ /dev/null
@@ -1,612 +0,0 @@
-module PhotosynthesisMod
-
-#include "shr_assert.h"
-
- !------------------------------------------------------------------------------
- ! !DESCRIPTION:
- ! Leaf photosynthesis and stomatal conductance calculation as described by
- ! Bonan et al (2011) JGR, 116, doi:10.1029/2010JG001593 and extended to
- ! a multi-layer canopy
- !
- ! !USES:
- use shr_sys_mod , only : shr_sys_flush
- use shr_kind_mod , only : r8 => shr_kind_r8
- use shr_log_mod , only : errMsg => shr_log_errMsg
- use shr_infnan_mod , only : nan => shr_infnan_nan, assignment(=)
- use abortutils , only : endrun
- use clm_varctl , only : use_cn, use_cndv, use_fates, use_luna, use_hydrstress
- use clm_varctl , only : iulog
- use clm_varpar , only : nlevcan, nvegwcs, mxpft
- use clm_varcon , only : namep, spval
- use decompMod , only : bounds_type
- use pftconMod , only : pftcon
- use atm2lndType , only : atm2lnd_type
- use CanopyStateType , only : canopystate_type
- use WaterStateType , only : waterstate_type
- use WaterfluxType , only : waterflux_type
- use SoilStateType , only : soilstate_type
- use TemperatureType , only : temperature_type
- use SolarAbsorbedType , only : solarabs_type
- use SurfaceAlbedoType , only : surfalb_type
- use OzoneBaseMod , only : ozone_base_type
- use LandunitType , only : lun
- use PatchType , only : patch
- use GridcellType , only : grc
- !
- implicit none
- private
- !
- ! !PRIVATE DATA:
- integer, parameter, private :: leafresp_mtd_ryan1991 = 1 ! Ryan 1991 method for lmr25top
- integer, parameter, private :: leafresp_mtd_atkin2015 = 2 ! Atkin 2015 method for lmr25top
- integer, parameter, private :: sun=1 ! index for sunlit
- integer, parameter, private :: sha=2 ! index for shaded
- integer, parameter, private :: xyl=3 ! index for xylem
- integer, parameter, private :: root=4 ! index for root
- integer, parameter, private :: veg=0 ! index for vegetation
- integer, parameter, private :: soil=1 ! index for soil
- integer, parameter, private :: stomatalcond_mtd_bb1987 = 1 ! Ball-Berry 1987 method for photosynthesis
- integer, parameter, private :: stomatalcond_mtd_medlyn2011 = 2 ! Medlyn 2011 method for photosynthesis
- ! !PUBLIC VARIABLES:
-
- type :: photo_params_type
- real(r8), allocatable, public :: krmax (:)
- real(r8), allocatable, private :: kmax (:,:)
- real(r8), allocatable, private :: psi50 (:,:)
- real(r8), allocatable, private :: ck (:,:)
- real(r8), allocatable, public :: psi_soil_ref (:)
- real(r8), allocatable, private :: lmr_intercept_atkin(:)
- contains
- procedure, private :: allocParams
- end type photo_params_type
- !
- type(photo_params_type), public, protected :: params_inst ! params_inst is populated in readParamsMod
-
- type, public :: photosyns_type
-
- logical , pointer, private :: c3flag_patch (:) ! patch true if C3 and false if C4
- ! Plant hydraulic stress specific variables
- real(r8), pointer, private :: ac_phs_patch (:,:,:) ! patch Rubisco-limited gross photosynthesis (umol CO2/m**2/s)
- real(r8), pointer, private :: aj_phs_patch (:,:,:) ! patch RuBP-limited gross photosynthesis (umol CO2/m**2/s)
- real(r8), pointer, private :: ap_phs_patch (:,:,:) ! patch product-limited (C3) or CO2-limited (C4) gross photosynthesis (umol CO2/m**2/s)
- real(r8), pointer, private :: ag_phs_patch (:,:,:) ! patch co-limited gross leaf photosynthesis (umol CO2/m**2/s)
- real(r8), pointer, private :: an_sun_patch (:,:) ! patch sunlit net leaf photosynthesis (umol CO2/m**2/s)
- real(r8), pointer, private :: an_sha_patch (:,:) ! patch shaded net leaf photosynthesis (umol CO2/m**2/s)
- real(r8), pointer, private :: vcmax_z_phs_patch (:,:,:) ! patch maximum rate of carboxylation (umol co2/m**2/s)
- real(r8), pointer, private :: kp_z_phs_patch (:,:,:) ! patch initial slope of CO2 response curve (C4 plants)
- real(r8), pointer, private :: tpu_z_phs_patch (:,:,:) ! patch triose phosphate utilization rate (umol CO2/m**2/s)
- real(r8), pointer, private :: gs_mol_sun_patch (:,:) ! patch sunlit leaf stomatal conductance (umol H2O/m**2/s)
- real(r8), pointer, private :: gs_mol_sha_patch (:,:) ! patch shaded leaf stomatal conductance (umol H2O/m**2/s)
-
- real(r8), pointer, private :: ac_patch (:,:) ! patch Rubisco-limited gross photosynthesis (umol CO2/m**2/s)
- real(r8), pointer, private :: aj_patch (:,:) ! patch RuBP-limited gross photosynthesis (umol CO2/m**2/s)
- real(r8), pointer, private :: ap_patch (:,:) ! patch product-limited (C3) or CO2-limited (C4) gross photosynthesis (umol CO2/m**2/s)
- real(r8), pointer, private :: ag_patch (:,:) ! patch co-limited gross leaf photosynthesis (umol CO2/m**2/s)
- real(r8), pointer, private :: an_patch (:,:) ! patch net leaf photosynthesis (umol CO2/m**2/s)
- real(r8), pointer, private :: vcmax_z_patch (:,:) ! patch maximum rate of carboxylation (umol co2/m**2/s)
- real(r8), pointer, private :: cp_patch (:) ! patch CO2 compensation point (Pa)
- real(r8), pointer, private :: kc_patch (:) ! patch Michaelis-Menten constant for CO2 (Pa)
- real(r8), pointer, private :: ko_patch (:) ! patch Michaelis-Menten constant for O2 (Pa)
- real(r8), pointer, private :: qe_patch (:) ! patch quantum efficiency, used only for C4 (mol CO2 / mol photons)
- real(r8), pointer, private :: tpu_z_patch (:,:) ! patch triose phosphate utilization rate (umol CO2/m**2/s)
- real(r8), pointer, private :: kp_z_patch (:,:) ! patch initial slope of CO2 response curve (C4 plants)
- real(r8), pointer, private :: theta_cj_patch (:) ! patch empirical curvature parameter for ac, aj photosynthesis co-limitation
- real(r8), pointer, private :: bbb_patch (:) ! patch Ball-Berry minimum leaf conductance (umol H2O/m**2/s)
- real(r8), pointer, private :: mbb_patch (:) ! patch Ball-Berry slope of conductance-photosynthesis relationship
- real(r8), pointer, private :: gs_mol_patch (:,:) ! patch leaf stomatal conductance (umol H2O/m**2/s)
- real(r8), pointer, private :: gb_mol_patch (:) ! patch leaf boundary layer conductance (umol H2O/m**2/s)
- real(r8), pointer, private :: rh_leaf_patch (:) ! patch fractional humidity at leaf surface (dimensionless)
-
- real(r8), pointer, private :: alphapsnsun_patch (:) ! patch sunlit 13c fractionation ([])
- real(r8), pointer, private :: alphapsnsha_patch (:) ! patch shaded 13c fractionation ([])
-
- real(r8), pointer, public :: psnsun_patch (:) ! patch sunlit leaf photosynthesis (umol CO2/m**2/s)
- real(r8), pointer, public :: psnsha_patch (:) ! patch shaded leaf photosynthesis (umol CO2/m**2/s)
-
- real(r8), pointer, private :: psnsun_z_patch (:,:) ! patch canopy layer: sunlit leaf photosynthesis (umol CO2/m**2/s)
- real(r8), pointer, private :: psnsha_z_patch (:,:) ! patch canopy layer: shaded leaf photosynthesis (umol CO2/m**2/s)
- real(r8), pointer, private :: psnsun_wc_patch (:) ! patch Rubsico-limited sunlit leaf photosynthesis (umol CO2/m**2/s)
- real(r8), pointer, private :: psnsha_wc_patch (:) ! patch Rubsico-limited shaded leaf photosynthesis (umol CO2/m**2/s)
- real(r8), pointer, private :: psnsun_wj_patch (:) ! patch RuBP-limited sunlit leaf photosynthesis (umol CO2/m**2/s)
- real(r8), pointer, private :: psnsha_wj_patch (:) ! patch RuBP-limited shaded leaf photosynthesis (umol CO2/m**2/s)
- real(r8), pointer, private :: psnsun_wp_patch (:) ! patch product-limited sunlit leaf photosynthesis (umol CO2/m**2/s)
- real(r8), pointer, private :: psnsha_wp_patch (:) ! patch product-limited shaded leaf photosynthesis (umol CO2/m**2/s)
-
- real(r8), pointer, public :: fpsn_patch (:) ! patch photosynthesis (umol CO2/m**2 ground/s)
- real(r8), pointer, private :: fpsn_wc_patch (:) ! patch Rubisco-limited photosynthesis (umol CO2/m**2 ground/s)
- real(r8), pointer, private :: fpsn_wj_patch (:) ! patch RuBP-limited photosynthesis (umol CO2/m**2 ground/s)
- real(r8), pointer, private :: fpsn_wp_patch (:) ! patch product-limited photosynthesis (umol CO2/m**2 ground/s)
-
- real(r8), pointer, public :: lnca_patch (:) ! top leaf layer leaf N concentration (gN leaf/m^2)
-
- real(r8), pointer, public :: lmrsun_patch (:) ! patch sunlit leaf maintenance respiration rate (umol CO2/m**2/s)
- real(r8), pointer, public :: lmrsha_patch (:) ! patch shaded leaf maintenance respiration rate (umol CO2/m**2/s)
- real(r8), pointer, private :: lmrsun_z_patch (:,:) ! patch canopy layer: sunlit leaf maintenance respiration rate (umol CO2/m**2/s)
- real(r8), pointer, private :: lmrsha_z_patch (:,:) ! patch canopy layer: shaded leaf maintenance respiration rate (umol CO2/m**2/s)
-
- real(r8), pointer, public :: cisun_z_patch (:,:) ! patch intracellular sunlit leaf CO2 (Pa)
- real(r8), pointer, public :: cisha_z_patch (:,:) ! patch intracellular shaded leaf CO2 (Pa)
-
- real(r8), pointer, private :: rssun_z_patch (:,:) ! patch canopy layer: sunlit leaf stomatal resistance (s/m)
- real(r8), pointer, private :: rssha_z_patch (:,:) ! patch canopy layer: shaded leaf stomatal resistance (s/m)
- real(r8), pointer, public :: rssun_patch (:) ! patch sunlit stomatal resistance (s/m)
- real(r8), pointer, public :: rssha_patch (:) ! patch shaded stomatal resistance (s/m)
- real(r8), pointer, public :: luvcmax25top_patch (:) ! vcmax25 ! (umol/m2/s)
- real(r8), pointer, public :: lujmax25top_patch (:) ! vcmax25 (umol/m2/s)
- real(r8), pointer, public :: lutpu25top_patch (:) ! vcmax25 (umol/m2/s)
-!!
-
-
- ! LUNA specific variables
- real(r8), pointer, public :: vcmx25_z_patch (:,:) ! patch leaf Vc,max25 (umol CO2/m**2/s) for canopy layer
- real(r8), pointer, public :: jmx25_z_patch (:,:) ! patch leaf Jmax25 (umol electron/m**2/s) for canopy layer
- real(r8), pointer, public :: pnlc_z_patch (:,:) ! patch proportion of leaf nitrogen allocated for light capture for canopy layer
- real(r8), pointer, public :: enzs_z_patch (:,:) ! enzyme decay status 1.0-fully active; 0-all decayed during stress
- real(r8), pointer, public :: fpsn24_patch (:) ! 24 hour mean patch photosynthesis (umol CO2/m**2 ground/day)
-
- ! Logical switches for different options
- logical, public :: rootstem_acc ! Respiratory acclimation for roots and stems
- logical, private :: light_inhibit ! If light should inhibit respiration
- integer, private :: leafresp_method ! leaf maintencence respiration at 25C for canopy top method to use
- integer, private :: stomatalcond_mtd ! Stomatal conduction method type
- logical, private :: modifyphoto_and_lmr_forcrop ! Modify photosynthesis and LMR for crop
- contains
-
- ! Public procedures
- procedure, public :: Init
- procedure, public :: Restart
- procedure, public :: ReadParams
-
- ! Private procedures
- procedure, private :: InitAllocate
- procedure, private :: InitHistory
- procedure, private :: InitCold
-
- end type photosyns_type
-
- character(len=*), parameter, private :: sourcefile = &
- __FILE__
- !------------------------------------------------------------------------
-
-contains
-
- !------------------------------------------------------------------------
- subroutine Init(this, bounds)
-
- class(photosyns_type) :: this
- type(bounds_type), intent(in) :: bounds
-
- call this%InitAllocate (bounds)
- call this%InitHistory (bounds)
- call this%InitCold (bounds)
-
- end subroutine Init
-
- !------------------------------------------------------------------------
- subroutine InitAllocate(this, bounds)
- !
- ! !ARGUMENTS:
- class(photosyns_type) :: this
- type(bounds_type), intent(in) :: bounds
- !
- ! !LOCAL VARIABLES:
- integer :: begp, endp
- integer :: begc, endc
- !------------------------------------------------------------------------
-
- begp = bounds%begp; endp= bounds%endp
- begc = bounds%begc; endc= bounds%endc
-
- allocate(this%c3flag_patch (begp:endp)) ; this%c3flag_patch (:) =.false.
- allocate(this%ac_phs_patch (begp:endp,2,1:nlevcan)) ; this%ac_phs_patch (:,:,:) = nan
- allocate(this%aj_phs_patch (begp:endp,2,1:nlevcan)) ; this%aj_phs_patch (:,:,:) = nan
- allocate(this%ap_phs_patch (begp:endp,2,1:nlevcan)) ; this%ap_phs_patch (:,:,:) = nan
- allocate(this%ag_phs_patch (begp:endp,2,1:nlevcan)) ; this%ag_phs_patch (:,:,:) = nan
- allocate(this%an_sun_patch (begp:endp,1:nlevcan)) ; this%an_sun_patch (:,:) = nan
- allocate(this%an_sha_patch (begp:endp,1:nlevcan)) ; this%an_sha_patch (:,:) = nan
- allocate(this%vcmax_z_phs_patch (begp:endp,2,1:nlevcan)) ; this%vcmax_z_phs_patch (:,:,:) = nan
- allocate(this%tpu_z_phs_patch (begp:endp,2,1:nlevcan)) ; this%tpu_z_phs_patch (:,:,:) = nan
- allocate(this%kp_z_phs_patch (begp:endp,2,1:nlevcan)) ; this%kp_z_phs_patch (:,:,:) = nan
- allocate(this%gs_mol_sun_patch (begp:endp,1:nlevcan)) ; this%gs_mol_sun_patch (:,:) = nan
- allocate(this%gs_mol_sha_patch (begp:endp,1:nlevcan)) ; this%gs_mol_sha_patch (:,:) = nan
- allocate(this%ac_patch (begp:endp,1:nlevcan)) ; this%ac_patch (:,:) = nan
- allocate(this%aj_patch (begp:endp,1:nlevcan)) ; this%aj_patch (:,:) = nan
- allocate(this%ap_patch (begp:endp,1:nlevcan)) ; this%ap_patch (:,:) = nan
- allocate(this%ag_patch (begp:endp,1:nlevcan)) ; this%ag_patch (:,:) = nan
- allocate(this%an_patch (begp:endp,1:nlevcan)) ; this%an_patch (:,:) = nan
- allocate(this%vcmax_z_patch (begp:endp,1:nlevcan)) ; this%vcmax_z_patch (:,:) = nan
- allocate(this%tpu_z_patch (begp:endp,1:nlevcan)) ; this%tpu_z_patch (:,:) = nan
- allocate(this%kp_z_patch (begp:endp,1:nlevcan)) ; this%kp_z_patch (:,:) = nan
- allocate(this%gs_mol_patch (begp:endp,1:nlevcan)) ; this%gs_mol_patch (:,:) = nan
- allocate(this%cp_patch (begp:endp)) ; this%cp_patch (:) = nan
- allocate(this%kc_patch (begp:endp)) ; this%kc_patch (:) = nan
- allocate(this%ko_patch (begp:endp)) ; this%ko_patch (:) = nan
- allocate(this%qe_patch (begp:endp)) ; this%qe_patch (:) = nan
- allocate(this%theta_cj_patch (begp:endp)) ; this%theta_cj_patch (:) = nan
- allocate(this%bbb_patch (begp:endp)) ; this%bbb_patch (:) = nan
- allocate(this%mbb_patch (begp:endp)) ; this%mbb_patch (:) = nan
- allocate(this%gb_mol_patch (begp:endp)) ; this%gb_mol_patch (:) = nan
- allocate(this%rh_leaf_patch (begp:endp)) ; this%rh_leaf_patch (:) = nan
-
- allocate(this%psnsun_patch (begp:endp)) ; this%psnsun_patch (:) = nan
- allocate(this%psnsha_patch (begp:endp)) ; this%psnsha_patch (:) = nan
-
- allocate(this%psnsun_z_patch (begp:endp,1:nlevcan)) ; this%psnsun_z_patch (:,:) = nan
- allocate(this%psnsha_z_patch (begp:endp,1:nlevcan)) ; this%psnsha_z_patch (:,:) = nan
- allocate(this%psnsun_wc_patch (begp:endp)) ; this%psnsun_wc_patch (:) = nan
- allocate(this%psnsha_wc_patch (begp:endp)) ; this%psnsha_wc_patch (:) = nan
- allocate(this%psnsun_wj_patch (begp:endp)) ; this%psnsun_wj_patch (:) = nan
- allocate(this%psnsha_wj_patch (begp:endp)) ; this%psnsha_wj_patch (:) = nan
- allocate(this%psnsun_wp_patch (begp:endp)) ; this%psnsun_wp_patch (:) = nan
- allocate(this%psnsha_wp_patch (begp:endp)) ; this%psnsha_wp_patch (:) = nan
- allocate(this%fpsn_patch (begp:endp)) ; this%fpsn_patch (:) = nan
- allocate(this%fpsn_wc_patch (begp:endp)) ; this%fpsn_wc_patch (:) = nan
- allocate(this%fpsn_wj_patch (begp:endp)) ; this%fpsn_wj_patch (:) = nan
- allocate(this%fpsn_wp_patch (begp:endp)) ; this%fpsn_wp_patch (:) = nan
-
- allocate(this%lnca_patch (begp:endp)) ; this%lnca_patch (:) = nan
-
- allocate(this%lmrsun_z_patch (begp:endp,1:nlevcan)) ; this%lmrsun_z_patch (:,:) = nan
- allocate(this%lmrsha_z_patch (begp:endp,1:nlevcan)) ; this%lmrsha_z_patch (:,:) = nan
- allocate(this%lmrsun_patch (begp:endp)) ; this%lmrsun_patch (:) = nan
- allocate(this%lmrsha_patch (begp:endp)) ; this%lmrsha_patch (:) = nan
-
- allocate(this%alphapsnsun_patch (begp:endp)) ; this%alphapsnsun_patch (:) = nan
- allocate(this%alphapsnsha_patch (begp:endp)) ; this%alphapsnsha_patch (:) = nan
-
- allocate(this%cisun_z_patch (begp:endp,1:nlevcan)) ; this%cisun_z_patch (:,:) = nan
- allocate(this%cisha_z_patch (begp:endp,1:nlevcan)) ; this%cisha_z_patch (:,:) = nan
-
- allocate(this%rssun_z_patch (begp:endp,1:nlevcan)) ; this%rssun_z_patch (:,:) = nan
- allocate(this%rssha_z_patch (begp:endp,1:nlevcan)) ; this%rssha_z_patch (:,:) = nan
- allocate(this%rssun_patch (begp:endp)) ; this%rssun_patch (:) = nan
- allocate(this%rssha_patch (begp:endp)) ; this%rssha_patch (:) = nan
- allocate(this%luvcmax25top_patch(begp:endp)) ; this%luvcmax25top_patch(:) = nan
- allocate(this%lujmax25top_patch (begp:endp)) ; this%lujmax25top_patch(:) = nan
- allocate(this%lutpu25top_patch (begp:endp)) ; this%lutpu25top_patch(:) = nan
-!!
-! allocate(this%psncanopy_patch (begp:endp)) ; this%psncanopy_patch (:) = nan
-! allocate(this%lmrcanopy_patch (begp:endp)) ; this%lmrcanopy_patch (:) = nan
- if(use_luna)then
- ! NOTE(bja, 2015-09) because these variables are only allocated
- ! when luna is turned on, they can not be placed into associate
- ! statements.
- allocate(this%vcmx25_z_patch (begp:endp,1:nlevcan)) ; this%vcmx25_z_patch (:,:) = 30._r8
- allocate(this%jmx25_z_patch (begp:endp,1:nlevcan)) ; this%jmx25_z_patch (:,:) = 60._r8
- allocate(this%pnlc_z_patch (begp:endp,1:nlevcan)) ; this%pnlc_z_patch (:,:) = 0.01_r8
- allocate(this%fpsn24_patch (begp:endp)) ; this%fpsn24_patch (:) = nan
- allocate(this%enzs_z_patch (begp:endp,1:nlevcan)) ; this%enzs_z_patch (:,:) = 1._r8
- endif
-
- end subroutine InitAllocate
-
- !-----------------------------------------------------------------------
- subroutine InitHistory(this, bounds)
- !
- ! !USES:
- use histFileMod , only: hist_addfld1d, hist_addfld2d
- !
- ! !ARGUMENTS:
- class(photosyns_type) :: this
- type(bounds_type), intent(in) :: bounds
- real(r8), pointer :: ptr_1d(:) ! pointer to 1d patch array
- !
- ! !LOCAL VARIABLES:
- integer :: begp, endp
- !---------------------------------------------------------------------
-
- begp = bounds%begp; endp= bounds%endp
-
- this%rh_leaf_patch(begp:endp) = spval
- call hist_addfld1d (fname='RH_LEAF', units='fraction', &
- avgflag='A', long_name='fractional humidity at leaf surface', &
- ptr_patch=this%rh_leaf_patch, set_spec=spval, default='inactive')
- this%lnca_patch(begp:endp) = spval
- call hist_addfld1d (fname='LNC', units='gN leaf/m^2', &
- avgflag='A', long_name='leaf N concentration', &
- ptr_patch=this%lnca_patch, set_spec=spval, default='inactive')
-
- ! Don't output photosynthesis variables when FATES is on as they aren't calculated
- if (.not. use_fates) then
- this%fpsn_patch(begp:endp) = spval
- call hist_addfld1d (fname='FPSN', units='umol/m2s', &
- avgflag='A', long_name='photosynthesis', &
- ptr_patch=this%fpsn_patch, set_lake=0._r8, set_urb=0._r8, default='inactive')
-
- ! Don't by default output this rate limiting step as only makes sense if you are outputing
- ! the others each time-step
- this%fpsn_wc_patch(begp:endp) = spval
- call hist_addfld1d (fname='FPSN_WC', units='umol/m2s', &
- avgflag='I', long_name='Rubisco-limited photosynthesis', &
- ptr_patch=this%fpsn_wc_patch, set_lake=0._r8, set_urb=0._r8, &
- default='inactive')
-
- ! Don't by default output this rate limiting step as only makes sense if you are outputing
- ! the others each time-step
- this%fpsn_wj_patch(begp:endp) = spval
- call hist_addfld1d (fname='FPSN_WJ', units='umol/m2s', &
- avgflag='I', long_name='RuBP-limited photosynthesis', &
- ptr_patch=this%fpsn_wj_patch, set_lake=0._r8, set_urb=0._r8, &
- default='inactive')
-
- ! Don't by default output this rate limiting step as only makes sense if you are outputing
- ! the others each time-step
- this%fpsn_wp_patch(begp:endp) = spval
- call hist_addfld1d (fname='FPSN_WP', units='umol/m2s', &
- avgflag='I', long_name='Product-limited photosynthesis', &
- ptr_patch=this%fpsn_wp_patch, set_lake=0._r8, set_urb=0._r8, &
- default='inactive')
- end if
-
- if (use_cn) then
- this%psnsun_patch(begp:endp) = spval
- call hist_addfld1d (fname='PSNSUN', units='umolCO2/m^2/s', &
- avgflag='A', long_name='sunlit leaf photosynthesis', &
- ptr_patch=this%psnsun_patch, default='inactive')
-
- this%psnsha_patch(begp:endp) = spval
- call hist_addfld1d (fname='PSNSHA', units='umolCO2/m^2/s', &
- avgflag='A', long_name='shaded leaf photosynthesis', &
- ptr_patch=this%psnsha_patch, default='inactive')
- end if
-
- this%rssun_patch(begp:endp) = spval
- call hist_addfld1d (fname='RSSUN', units='s/m', &
- avgflag='M', long_name='sunlit leaf stomatal resistance', &
- ptr_patch=this%rssun_patch, set_lake=spval, set_urb=spval, default='inactive')
-
- this%rssha_patch(begp:endp) = spval
- call hist_addfld1d (fname='RSSHA', units='s/m', &
- avgflag='M', long_name='shaded leaf stomatal resistance', &
- ptr_patch=this%rssha_patch, set_lake=spval, set_urb=spval, default='inactive')
-
- this%gs_mol_sun_patch(begp:endp,:) = spval
- this%gs_mol_sha_patch(begp:endp,:) = spval
- if (nlevcan>1) then
- call hist_addfld2d (fname='GSSUN', units='umol H20/m2/s', type2d='nlevcan', &
- avgflag='A', long_name='sunlit leaf stomatal conductance', &
- ptr_patch=this%gs_mol_sun_patch, set_lake=spval, set_urb=spval, default='inactive')
-
- call hist_addfld2d (fname='GSSHA', units='umol H20/m2/s', type2d='nlevcan', &
- avgflag='A', long_name='shaded leaf stomatal conductance', &
- ptr_patch=this%gs_mol_sha_patch, set_lake=spval, set_urb=spval, default='inactive')
- else
- ptr_1d => this%gs_mol_sun_patch(begp:endp,1)
- call hist_addfld1d (fname='GSSUN', units='umol H20/m2/s', &
- avgflag='A', long_name='sunlit leaf stomatal conductance', &
- ptr_patch=ptr_1d, default='inactive')
-
- ptr_1d => this%gs_mol_sha_patch(begp:endp,1)
- call hist_addfld1d (fname='GSSHA', units='umol H20/m2/s', &
- avgflag='A', long_name='shaded leaf stomatal conductance', &
- ptr_patch=ptr_1d, default='inactive')
-
- endif
-
- if(use_luna)then
- if(nlevcan>1)then
- call hist_addfld2d (fname='Vcmx25Z', units='umol/m2/s', type2d='nlevcan', &
- avgflag='A', long_name='canopy profile of vcmax25 predicted by LUNA model', &
- ptr_patch=this%vcmx25_z_patch, default='inactive')
-
- call hist_addfld2d (fname='Jmx25Z', units='umol/m2/s', type2d='nlevcan', &
- avgflag='A', long_name='canopy profile of vcmax25 predicted by LUNA model', &
- ptr_patch=this%jmx25_z_patch, default='inactive')
-
- call hist_addfld2d (fname='PNLCZ', units='unitless', type2d='nlevcan', &
- avgflag='A', long_name='Proportion of nitrogen allocated for light capture', &
- ptr_patch=this%pnlc_z_patch,default='inactive')
- else
- ptr_1d => this%vcmx25_z_patch(:,1)
- call hist_addfld1d (fname='Vcmx25Z', units='umol/m2/s',&
- avgflag='A', long_name='canopy profile of vcmax25 predicted by LUNA model', &
- ptr_patch=ptr_1d, default='inactive')
- ptr_1d => this%jmx25_z_patch(:,1)
- call hist_addfld1d (fname='Jmx25Z', units='umol/m2/s',&
- avgflag='A', long_name='canopy profile of vcmax25 predicted by LUNA model', &
- ptr_patch=ptr_1d, default='inactive')
- ptr_1d => this%pnlc_z_patch(:,1)
- call hist_addfld1d (fname='PNLCZ', units='unitless', &
- avgflag='A', long_name='Proportion of nitrogen allocated for light capture', &
- ptr_patch=ptr_1d,default='inactive')
-
- this%luvcmax25top_patch(begp:endp) = spval
- call hist_addfld1d (fname='VCMX25T', units='umol/m2/s', &
- avgflag='M', long_name='canopy profile of vcmax25', &
- ptr_patch=this%luvcmax25top_patch, set_lake=spval, set_urb=spval, default='inactive')
-
- this%lujmax25top_patch(begp:endp) = spval
- call hist_addfld1d (fname='JMX25T', units='umol/m2/s', &
- avgflag='M', long_name='canopy profile of jmax', &
- ptr_patch=this%lujmax25top_patch, set_lake=spval, set_urb=spval, default='inactive')
-
- this%lutpu25top_patch(begp:endp) = spval
- call hist_addfld1d (fname='TPU25T', units='umol/m2/s', &
- avgflag='M', long_name='canopy profile of tpu', &
- ptr_patch=this%lutpu25top_patch, set_lake=spval, set_urb=spval, default='inactive')
-
- endif
- this%fpsn24_patch = spval
- call hist_addfld1d (fname='FPSN24', units='umol CO2/m**2 ground/day',&
- avgflag='A', long_name='24 hour accumulative patch photosynthesis starting from mid-night', &
- ptr_patch=this%fpsn24_patch, default='inactive')
-
- endif
-
- end subroutine InitHistory
-
- !-----------------------------------------------------------------------
- subroutine InitCold(this, bounds)
- !
- ! !ARGUMENTS:
- class(photosyns_type) :: this
- type(bounds_type), intent(in) :: bounds
- !
- ! !LOCAL VARIABLES:
- integer :: p,l ! indices
- !-----------------------------------------------------------------------
-
- do p = bounds%begp,bounds%endp
- l = patch%landunit(p)
-
- this%alphapsnsun_patch(p) = spval
- this%alphapsnsha_patch(p) = spval
-
- if (lun%ifspecial(l)) then
- this%psnsun_patch(p) = 0._r8
- this%psnsha_patch(p) = 0._r8
- end if
- end do
-
- end subroutine InitCold
-
- !-----------------------------------------------------------------------
- subroutine allocParams ( this )
- !
- implicit none
-
- ! !ARGUMENTS:
- class(photo_params_type) :: this
- !
- ! !LOCAL VARIABLES:
- character(len=32) :: subname = 'allocParams'
- !-----------------------------------------------------------------------
-
- ! allocate parameters
-
- allocate( this%krmax (0:mxpft) ) ; this%krmax(:) = nan
- allocate( this%kmax (0:mxpft,nvegwcs) ) ; this%kmax(:,:) = nan
- allocate( this%psi50 (0:mxpft,nvegwcs) ) ; this%psi50(:,:) = nan
- allocate( this%ck (0:mxpft,nvegwcs) ) ; this%ck(:,:) = nan
- allocate( this%psi_soil_ref(0:mxpft) ) ; this%psi_soil_ref(:) = nan
-
- if ( use_hydrstress .and. nvegwcs /= 4 )then
- call endrun(msg='Error:: the Plant Hydraulics Stress methodology is for the spacA function is hardcoded for nvegwcs==4' &
- //errMsg(__FILE__, __LINE__))
- end if
-
- end subroutine allocParams
-
- !-----------------------------------------------------------------------
- subroutine readParams ( this, ncid )
- !
- ! !USES:
- use ncdio_pio , only : file_desc_t,ncd_io
- implicit none
-
- ! !ARGUMENTS:
- class(photosyns_type) :: this
- type(file_desc_t),intent(inout) :: ncid ! pio netCDF file id
- !
- ! !LOCAL VARIABLES:
- character(len=32) :: subname = 'readParams'
- character(len=100) :: errCode = '-Error reading in parameters file:'
- logical :: readv ! has variable been read in or not
- real(r8) :: temp1d(0:mxpft) ! temporary to read in parameter
- real(r8) :: temp2d(0:mxpft,nvegwcs) ! temporary to read in parameter
- character(len=100) :: tString ! temp. var for reading
- !-----------------------------------------------------------------------
-
- ! read in parameters
-
-
- call params_inst%allocParams()
-
- tString = "krmax"
- call ncd_io(varname=trim(tString),data=temp1d, flag='read', ncid=ncid, readvar=readv)
- if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__))
- params_inst%krmax=temp1d
- tString = "psi_soil_ref"
- call ncd_io(varname=trim(tString),data=temp1d, flag='read', ncid=ncid, readvar=readv)
- if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__))
- params_inst%psi_soil_ref=temp1d
- tString = "lmr_intercept_atkin"
- call ncd_io(varname=trim(tString),data=temp1d, flag='read', ncid=ncid, readvar=readv)
- if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__))
- params_inst%lmr_intercept_atkin=temp1d
- tString = "kmax"
- call ncd_io(varname=trim(tString),data=temp2d, flag='read', ncid=ncid, readvar=readv)
- if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__))
- params_inst%kmax=temp2d
- tString = "psi50"
- call ncd_io(varname=trim(tString),data=temp2d, flag='read', ncid=ncid, readvar=readv)
- if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__))
- params_inst%psi50=temp2d
- tString = "ck"
- call ncd_io(varname=trim(tString),data=temp2d, flag='read', ncid=ncid, readvar=readv)
- if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__))
- params_inst%ck=temp2d
-
- end subroutine readParams
-
- !------------------------------------------------------------------------
- subroutine Restart(this, bounds, ncid, flag)
- !
- ! !USES:
- use ncdio_pio , only : file_desc_t, ncd_defvar, ncd_io, ncd_double, ncd_int, ncd_inqvdlen
- use restUtilMod
- !
- ! !ARGUMENTS:
- class(photosyns_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
- !-----------------------------------------------------------------------
-
- call restartvar(ncid=ncid, flag=flag, varname='GSSUN', xtype=ncd_double, &
- dim1name='pft', dim2name='levcan', switchdim=.true., &
- long_name='sunlit leaf stomatal conductance', units='umol H20/m2/s', &
- interpinic_flag='interp', readvar=readvar, data=this%gs_mol_sun_patch)
-
- call restartvar(ncid=ncid, flag=flag, varname='GSSHA', xtype=ncd_double, &
- dim1name='pft', dim2name='levcan', switchdim=.true., &
- long_name='shaded leaf stomatal conductance', units='umol H20/m2/s', &
- interpinic_flag='interp', readvar=readvar, data=this%gs_mol_sha_patch)
-
- call restartvar(ncid=ncid, flag=flag, varname='lnca', xtype=ncd_double, &
- dim1name='pft', long_name='leaf N concentration', units='gN leaf/m^2', &
- interpinic_flag='interp', readvar=readvar, data=this%lnca_patch)
-
- if(use_luna) then
- call restartvar(ncid=ncid, flag=flag, varname='vcmx25_z', xtype=ncd_double, &
- dim1name='pft', dim2name='levcan', switchdim=.true., &
- long_name='Maximum carboxylation rate at 25 celcius for canopy layers', units='umol CO2/m**2/s', &
- interpinic_flag='interp', readvar=readvar, data=this%vcmx25_z_patch)
- call restartvar(ncid=ncid, flag=flag, varname='jmx25_z', xtype=ncd_double, &
- dim1name='pft', dim2name='levcan', switchdim=.true., &
- long_name='Maximum carboxylation rate at 25 celcius for canopy layers', units='umol CO2/m**2/s', &
- interpinic_flag='interp', readvar=readvar, data=this%jmx25_z_patch)
- call restartvar(ncid=ncid, flag=flag, varname='pnlc_z', xtype=ncd_double, &
- dim1name='pft', dim2name='levcan', switchdim=.true., &
- long_name='proportion of leaf nitrogen allocated for light capture', units='unitless', &
- interpinic_flag='interp', readvar=readvar, data=this%pnlc_z_patch )
- call restartvar(ncid=ncid, flag=flag, varname='enzs_z', xtype=ncd_double, &
- dim1name='pft', dim2name='levcan', switchdim=.true., &
- long_name='enzyme decay status during stress: 1.0-fully active; 0.0-all decayed', units='unitless', &
- interpinic_flag='interp', readvar=readvar, data=this%enzs_z_patch )
- call restartvar(ncid=ncid, flag=flag, varname='gpp24', xtype=ncd_double, &
- dim1name='pft', long_name='accumulative gross primary production', units='umol CO2/m**2 ground/day', &
- interpinic_flag='interp', readvar=readvar, data=this%fpsn24_patch)
- endif
- call restartvar(ncid=ncid, flag=flag, varname='vcmx25t', xtype=ncd_double, &
- dim1name='pft', long_name='canopy profile of vcmax25', &
- units='umol/m2/s', &
- interpinic_flag='interp', readvar=readvar, data=this%luvcmax25top_patch)
-
- call restartvar(ncid=ncid, flag=flag, varname='jmx25t', xtype=ncd_double, &
- dim1name='pft', long_name='canopy profile of jmax', &
- units='umol/m2/s', &
- interpinic_flag='interp', readvar=readvar, data=this%lujmax25top_patch)
-
- call restartvar(ncid=ncid, flag=flag, varname='tpu25t', xtype=ncd_double, &
- dim1name='pft', long_name='canopy profile of tpu', &
- units='umol/m2/s', &
- interpinic_flag='interp', readvar=readvar, data=this%lutpu25top_patch)
-
- end subroutine Restart
-
-end module PhotosynthesisMod
diff --git a/src/biogeophys/QSatMod.F90 b/src/biogeophys/QSatMod.F90
index 0b1819e4..76d1a406 100644
--- a/src/biogeophys/QSatMod.F90
+++ b/src/biogeophys/QSatMod.F90
@@ -12,7 +12,6 @@ module QSatMod
!
! !PUBLIC MEMBER FUNCTIONS:
public :: QSat
- public :: rhoSat
!-----------------------------------------------------------------------
! For water vapor (temperature range 0C-100C)
@@ -123,45 +122,4 @@ subroutine QSat (T, p, es, esdT, qs, qsdT)
end subroutine QSat
-
-
-!-------------------------------------------------------------------------------
- subroutine rhoSat(T, rho, rhodT)
- ! compute the saturated vapor pressure density and its derivative against the temperature
- ! jyt
- use clm_varcon, only: rwat
- use shr_const_mod, only: SHR_CONST_TKFRZ
-
- implicit none
- real(r8), intent(in) :: T
- real(r8), intent(out) :: rho
- real(r8), optional, intent(out) :: rhodT
-
-
- !------------------
-
- real(r8) :: T_limit
- real(r8) :: td, es, esdT
-
- T_limit = T - SHR_CONST_TKFRZ
- if (T_limit > 100.0_r8) T_limit=100.0_r8
- if (T_limit < -75.0_r8) T_limit=-75.0_r8
-
- td = T_limit
- if (td >= 0.0_r8) then
- es = a0 + td*(a1 + td*(a2 + td*(a3 + td*(a4 &
- + td*(a5 + td*(a6 + td*(a7 + td*a8)))))))
- esdT = b0 + td*(b1 + td*(b2 + td*(b3 + td*(b4 &
- + td*(b5 + td*(b6 + td*(b7 + td*b8)))))))
- else
- es = c0 + td*(c1 + td*(c2 + td*(c3 + td*(c4 &
- + td*(c5 + td*(c6 + td*(c7 + td*c8)))))))
- esdT = d0 + td*(d1 + td*(d2 + td*(d3 + td*(d4 &
- + td*(d5 + td*(d6 + td*(d7 + td*d8)))))))
- endif
-
- es = es * 100._r8 ! pa
- rho = es/(rwat*T) !kg m^-3
- if(present(rhodT))rhodT= esdT/(rwat*T)-rho/T !kg m^-3 K^-1
- end subroutine rhoSat
end module QSatMod
diff --git a/src/biogeophys/RootBiophysMod.F90 b/src/biogeophys/RootBiophysMod.F90
deleted file mode 100644
index ba057056..00000000
--- a/src/biogeophys/RootBiophysMod.F90
+++ /dev/null
@@ -1,332 +0,0 @@
-module RootBiophysMod
-
-#include "shr_assert.h"
-
- !--------------------------------------------------------------------------------------
- ! DESCRIPTION:
- ! module contains subroutine for root biophysics
- !
- ! HISTORY
- ! created by Jinyun Tang, Mar 1st, 2014
- implicit none
- private
- !
- public :: init_vegrootfr
- public :: init_rootprof
-
- integer, private, parameter :: zeng_2001_root = 0 !the zeng 2001 root profile function
- integer, private, parameter :: jackson_1996_root = 1 !the jackson 1996 root profile function
- integer, private, parameter :: koven_exp_root = 2 !the koven exponential root profile function
-
- integer, public :: rooting_profile_method_water !select the type of rooting profile parameterization for water
- integer, public :: rooting_profile_method_carbon !select the type of rooting profile parameterization for carbon
- integer, public :: rooting_profile_varindex_water !select the variant number of rooting profile parameterization for water
- integer, public :: rooting_profile_varindex_carbon !select the variant number of rooting profile parameterization for carbon
-
- character(len=*), parameter, private :: sourcefile = &
- __FILE__
-
- !--------------------------------------------------------------------------------------
-
-contains
-
- !--------------------------------------------------------------------------------------
- subroutine init_rootprof(NLFilename)
- !
- !DESCRIPTION
- ! initialize methods for root profile calculation
-
- ! !USES:
- use abortutils , only : endrun
- use fileutils , only : getavu, relavu
- use spmdMod , only : mpicom, masterproc
- use shr_mpi_mod , only : shr_mpi_bcast
- use clm_varctl , only : iulog
- use clm_nlUtilsMod , only : find_nlgroup_name
-
- ! !ARGUMENTS:
- !------------------------------------------------------------------------------
- implicit none
- character(len=*), intent(in) :: NLFilename
-
- integer :: nu_nml ! unit for namelist file
- integer :: nml_error ! namelist i/o error flag
- character(*), parameter :: subName = "('init_rootprof')"
-
- !-----------------------------------------------------------------------
-
-! MUST agree with name in namelist and read statement
- namelist /rooting_profile_inparm/ rooting_profile_method_water, rooting_profile_method_carbon, &
- rooting_profile_varindex_water, rooting_profile_varindex_carbon
-
- ! Default values for namelist
-
- rooting_profile_method_water = zeng_2001_root
- rooting_profile_method_carbon = zeng_2001_root
- rooting_profile_varindex_water = 1
- rooting_profile_varindex_carbon = 2
-
- ! Read rooting_profile namelist
- if (masterproc) then
- nu_nml = getavu()
- open( nu_nml, file=trim(NLFilename), status='old', iostat=nml_error )
- call find_nlgroup_name(nu_nml, 'rooting_profile_inparm', status=nml_error)
- if (nml_error == 0) then
- read(nu_nml, nml=rooting_profile_inparm,iostat=nml_error)
- if (nml_error /= 0) then
- call endrun(subname // ':: ERROR reading rooting_profile namelist')
- end if
- else
- call endrun(subname // ':: ERROR finding rooting_profile namelist')
- end if
- close(nu_nml)
- call relavu( nu_nml )
-
- endif
-
- call shr_mpi_bcast(rooting_profile_method_water, mpicom)
- call shr_mpi_bcast(rooting_profile_method_carbon, mpicom)
- call shr_mpi_bcast(rooting_profile_varindex_water, mpicom)
- call shr_mpi_bcast(rooting_profile_varindex_carbon, mpicom)
-
- if (masterproc) then
-
- write(iulog,*) ' '
- write(iulog,*) 'rooting_profile settings:'
- write(iulog,*) ' rooting_profile_method_water = ',rooting_profile_method_water
- if ( rooting_profile_method_water == jackson_1996_root )then
- write(iulog,*) ' (rooting_profile_varindex_water = ',rooting_profile_varindex_water, ')'
- end if
- write(iulog,*) ' rooting_profile_method_carbon = ',rooting_profile_method_carbon
- if ( rooting_profile_method_carbon == jackson_1996_root )then
- write(iulog,*) ' (rooting_profile_varindex_carbon = ',rooting_profile_varindex_carbon, ')'
- end if
-
- endif
-
- end subroutine init_rootprof
-
- !--------------------------------------------------------------------------------------
- subroutine init_vegrootfr(bounds, nlevsoi, nlevgrnd, rootfr, water_carbon)
- !
- !DESCRIPTION
- !initialize plant root profiles
- !
- ! USES
- use shr_kind_mod , only : r8 => shr_kind_r8
- use shr_assert_mod , only : shr_assert
- use shr_log_mod , only : errMsg => shr_log_errMsg
- use decompMod , only : bounds_type
- use abortutils , only : endrun
- use ColumnType , only : col
- use PatchType , only : patch
- !
- ! !ARGUMENTS:
- type(bounds_type), intent(in) :: bounds ! bounds
- integer, intent(in) :: nlevsoi ! number of hydactive layers
- integer, intent(in) :: nlevgrnd ! number of soil layers
- real(r8), intent(out):: rootfr(bounds%begp: , 1: ) ! root fraction by layer
- character(len=*), intent(in) :: water_carbon ! roots for water or carbon
-
- !
- ! !LOCAL VARIABLES:
- character(len=32) :: subname = 'init_vegrootfr' ! subroutine name
- integer :: c,p
- integer :: rooting_profile_method ! Rooting profile method to use
- integer :: rooting_profile_varidx ! Rooting profile variant index to use
- !------------------------------------------------------------------------
-
- SHR_ASSERT_ALL((ubound(rootfr) == (/bounds%endp, nlevgrnd/)), errMsg(sourcefile, __LINE__))
-
- if ( water_carbon == 'water' ) then
- rooting_profile_method = rooting_profile_method_water
- rooting_profile_varidx = rooting_profile_varindex_water
- else if (water_carbon == 'carbon') then
- rooting_profile_method = rooting_profile_method_carbon
- rooting_profile_varidx = rooting_profile_varindex_carbon
- else
- call endrun(subname // ':: input type can only be water or carbon = '//water_carbon )
- end if
-
- select case( rooting_profile_method )
-
- case (zeng_2001_root)
- rootfr(bounds%begp:bounds%endp, 1 : nlevsoi) = zeng2001_rootfr(bounds, nlevsoi)
- case (jackson_1996_root)
- rootfr(bounds%begp:bounds%endp, 1 : nlevsoi) = jackson1996_rootfr(bounds, nlevsoi, rooting_profile_varidx, water_carbon)
- case (koven_exp_root)
- rootfr(bounds%begp:bounds%endp, 1 : nlevsoi) = exponential_rootfr(bounds, nlevsoi)
- case default
- call endrun(subname // ':: a root fraction function must be specified!')
- end select
- rootfr(bounds%begp:bounds%endp,nlevsoi+1:nlevgrnd)=0._r8
-
- ! shift roots up above bedrock boundary (distribute equally to each layer)
- ! may not matter if normalized later
- do p = bounds%begp,bounds%endp
- c = patch%column(p)
- rootfr(p,1:col%nbedrock(c)) = rootfr(p,1:col%nbedrock(c)) &
- + sum(rootfr(p,col%nbedrock(c)+1:nlevsoi))/real(col%nbedrock(c))
- rootfr(p,col%nbedrock(c)+1:nlevsoi) = 0._r8
- enddo
- end subroutine init_vegrootfr
-
- !-------------------------------------------------------------------------
- function zeng2001_rootfr(bounds, ubj) result(rootfr)
- !
- ! DESCRIPTION
- ! compute root profile for soil water uptake
- ! using equation from Zeng 2001, J. Hydrometeorology
- !
- ! USES
- use shr_kind_mod , only : r8 => shr_kind_r8
- use shr_assert_mod , only : shr_assert
- use shr_log_mod , only : errMsg => shr_log_errMsg
- use decompMod , only : bounds_type
- use pftconMod , only : pftcon
- use PatchType , only : patch
- use ColumnType , only : col
- !
- ! !ARGUMENTS:
- type(bounds_type) , intent(in) :: bounds ! bounds
- integer , intent(in) :: ubj ! ubnd
- !
- ! !RESULT
- real(r8) :: rootfr(bounds%begp:bounds%endp , 1:ubj ) !
- !
- ! !LOCAL VARIABLES:
- integer :: p, lev, c
- !------------------------------------------------------------------------
-
- !(computing from surface, d is depth in meter):
- ! Y = 1 -1/2 (exp(-ad)+exp(-bd) under the constraint that
- ! Y(d =0.1m) = 1-beta^(10 cm) and Y(d=d_obs)=0.99 with
- ! beta & d_obs given in Zeng et al. (1998).
-
- do p = bounds%begp,bounds%endp
-
- if (.not. patch%is_fates(p)) then
- c = patch%column(p)
- do lev = 1, ubj-1
- rootfr(p,lev) = .5_r8*( &
- exp(-pftcon%roota_par(patch%itype(p)) * col%zi(c,lev-1)) &
- + exp(-pftcon%rootb_par(patch%itype(p)) * col%zi(c,lev-1)) &
- - exp(-pftcon%roota_par(patch%itype(p)) * col%zi(c,lev )) &
- - exp(-pftcon%rootb_par(patch%itype(p)) * col%zi(c,lev )) )
- end do
- rootfr(p,ubj) = .5_r8*( &
- exp(-pftcon%roota_par(patch%itype(p)) * col%zi(c,ubj-1)) &
- + exp(-pftcon%rootb_par(patch%itype(p)) * col%zi(c,ubj-1)) )
-
- else
- rootfr(p,1:ubj) = 0._r8
- endif
-
- enddo
- return
-
- end function zeng2001_rootfr
-
- !-------------------------------------------------------------------------
- function jackson1996_rootfr(bounds, ubj, varindx, water_carbon) result(rootfr)
- !
- ! DESCRIPTION
- ! compute root profile for soil water uptake
- ! using equation from Jackson et al. 1996, Oec.
- !
- ! USES
- use shr_kind_mod , only : r8 => shr_kind_r8
- use shr_assert_mod , only : shr_assert
- use shr_log_mod , only : errMsg => shr_log_errMsg
- use decompMod , only : bounds_type
- use pftconMod , only : pftcon
- use PatchType , only : patch
- use ColumnType , only : col
- !
- ! !ARGUMENTS:
- type(bounds_type) , intent(in) :: bounds ! bounds
- integer , intent(in) :: ubj ! ubnd
- integer , intent(in) :: varindx ! variant index
- character(len=*) , intent(in) :: water_carbon ! roots for water or carbon
- !
- ! !RESULT
- real(r8) :: rootfr(bounds%begp:bounds%endp , 1:ubj ) !
- !
- ! !LOCAL VARIABLES:
- real(r8), parameter :: m_to_cm = 1.e2_r8
- real(r8) :: beta !patch specific shape parameter
- integer :: p, lev, c
- !------------------------------------------------------------------------
-
- !(computing from surface, d is depth in centimeters):
- ! Y = (1 - beta^d); beta given in Jackson et al. (1996).
-
- rootfr(bounds%begp:bounds%endp, :) = 0._r8
- do p = bounds%begp,bounds%endp
- c = patch%column(p)
- if (.not.patch%is_fates(p)) then
- beta = pftcon%rootprof_beta(patch%itype(p),varindx)
- do lev = 1, ubj
- rootfr(p,lev) = ( &
- beta ** (col%zi(c,lev-1)*m_to_cm) - &
- beta ** (col%zi(c,lev)*m_to_cm) )
- end do
- else
- rootfr(p,:) = 0.
- endif
-
- enddo
- return
-
- end function jackson1996_rootfr
-
- !-------------------------------------------------------------------------
- function exponential_rootfr(bounds, ubj) result(rootfr)
- !
- ! DESCRIPTION
- ! compute root profile for soil water uptake
- ! using equation from Koven
- !
- ! USES
- use shr_kind_mod , only : r8 => shr_kind_r8
- use shr_assert_mod , only : shr_assert
- use shr_log_mod , only : errMsg => shr_log_errMsg
- use decompMod , only : bounds_type
- use pftconMod , only : pftcon
- use PatchType , only : patch
- use ColumnType , only : col
- !
- ! !ARGUMENTS:
- type(bounds_type) , intent(in) :: bounds ! bounds
- integer , intent(in) :: ubj ! ubnd
- !
- ! !RESULT
- real(r8) :: rootfr(bounds%begp:bounds%endp , 1:ubj ) !
- !
- ! !LOCAL VARIABLES:
- real(r8), parameter :: rootprof_exp = 3. ! how steep profile is for root C inputs (1/ e-folding depth) (1/m)
- real(r8) :: norm
- integer :: p, lev, c
-
- !------------------------------------------------------------------------
-
- rootfr(bounds%begp:bounds%endp, :) = 0._r8
- do p = bounds%begp,bounds%endp
- c = patch%column(p)
- if (.not.patch%is_fates(p)) then
- do lev = 1, ubj
- rootfr(p,lev) = exp(-rootprof_exp * col%z(c,lev)) * col%dz(c,lev)
- end do
- else
- rootfr(p,1) = 0.
- endif
- norm = -1./rootprof_exp * (exp(-rootprof_exp * col%z(c,ubj)) - 1._r8)
- rootfr(p,:) = rootfr(p,:) / norm
-
- enddo
-
- return
-
- end function exponential_rootfr
-
-end module RootBiophysMod
diff --git a/src/biogeophys/SnowSnicarMod.F90 b/src/biogeophys/SnowSnicarMod.F90
deleted file mode 100644
index fe731e51..00000000
--- a/src/biogeophys/SnowSnicarMod.F90
+++ /dev/null
@@ -1,300 +0,0 @@
-module SnowSnicarMod
-
-#include "shr_assert.h"
-
- !-----------------------------------------------------------------------
- ! !DESCRIPTION:
- ! Calculate albedo of snow containing impurities
- ! and the evolution of snow effective radius
- !
- ! !USES:
- use shr_kind_mod , only : r8 => shr_kind_r8
- use shr_sys_mod , only : shr_sys_flush
- use shr_log_mod , only : errMsg => shr_log_errMsg
- use clm_varctl , only : iulog
- use clm_varcon , only : namec , tfrz
- use shr_const_mod , only : SHR_CONST_RHOICE
- use abortutils , only : endrun
- use decompMod , only : bounds_type
- use AerosolMod , only : snw_rds_min
- !
- implicit none
- save
- !
- ! !PUBLIC MEMBER FUNCTIONS:
- public :: SnowAge_init ! Initial read in of snow-aging file
- public :: SnowOptics_init ! Initial read in of snow-optics file
- !
- ! !PUBLIC DATA MEMBERS:
- integer, public, parameter :: sno_nbr_aer = 8 ! number of aerosol species in snowpack
- ! (indices described above) [nbr]
- logical, public, parameter :: DO_SNO_OC = .false. ! parameter to include organic carbon (OC)
- ! in snowpack radiative calculations
- logical, public, parameter :: DO_SNO_AER = .true. ! parameter to include aerosols in snowpack radiative calculations
-
- ! !PRIVATE DATA MEMBERS:
- integer, parameter :: numrad_snw = 5 ! number of spectral bands used in snow model [nbr]
- integer, parameter :: nir_bnd_bgn = 2 ! first band index in near-IR spectrum [idx]
- integer, parameter :: nir_bnd_end = 5 ! ending near-IR band index [idx]
-
- integer, parameter :: idx_Mie_snw_mx = 1471 ! number of effective radius indices used in Mie lookup table [idx]
- integer, parameter :: idx_T_max = 11 ! maxiumum temperature index used in aging lookup table [idx]
- integer, parameter :: idx_T_min = 1 ! minimum temperature index used in aging lookup table [idx]
- integer, parameter :: idx_Tgrd_max = 31 ! maxiumum temperature gradient index used in aging lookup table [idx]
- integer, parameter :: idx_Tgrd_min = 1 ! minimum temperature gradient index used in aging lookup table [idx]
- integer, parameter :: idx_rhos_max = 8 ! maxiumum snow density index used in aging lookup table [idx]
- integer, parameter :: idx_rhos_min = 1 ! minimum snow density index used in aging lookup table [idx]
-
- integer, parameter :: snw_rds_max_tbl = 1500 ! maximum effective radius defined in Mie lookup table [microns]
- integer, parameter :: snw_rds_min_tbl = 30 ! minimium effective radius defined in Mie lookup table [microns]
- integer, parameter :: snw_rds_min_int = nint(snw_rds_min) ! minimum allowed snow effective radius as integer [microns]
- real(r8), parameter :: snw_rds_max = 1500._r8 ! maximum allowed snow effective radius [microns]
- real(r8), parameter :: snw_rds_refrz = 1000._r8 ! effective radius of re-frozen snow [microns]
-
- real(r8), parameter :: min_snw = 1.0E-30_r8 ! minimum snow mass required for SNICAR RT calculation [kg m-2]
-
- !real(r8), parameter :: C1_liq_Brun89 = 1.28E-17_r8 ! constant for liquid water grain growth [m3 s-1],
- ! from Brun89
- real(r8), parameter :: C1_liq_Brun89 = 0._r8 ! constant for liquid water grain growth [m3 s-1],
- ! from Brun89: zeroed to accomodate dry snow aging
- real(r8), parameter :: C2_liq_Brun89 = 4.22E-13_r8 ! constant for liquid water grain growth [m3 s-1],
- ! from Brun89: corrected for LWC in units of percent
-
- real(r8), parameter :: tim_cns_bc_rmv = 2.2E-8_r8 ! time constant for removal of BC in snow on sea-ice
- ! [s-1] (50% mass removal/year)
- real(r8), parameter :: tim_cns_oc_rmv = 2.2E-8_r8 ! time constant for removal of OC in snow on sea-ice
- ! [s-1] (50% mass removal/year)
- real(r8), parameter :: tim_cns_dst_rmv = 2.2E-8_r8 ! time constant for removal of dust in snow on sea-ice
- ! [s-1] (50% mass removal/year)
-
- ! scaling of the snow aging rate (tuning option):
- logical :: flg_snoage_scl = .false. ! flag for scaling the snow aging rate by some arbitrary factor
- real(r8), parameter :: xdrdt = 1.0_r8 ! arbitrary factor applied to snow aging rate
-
- ! snow and aerosol Mie parameters:
- ! (arrays declared here, but are set in iniTimeConst)
- ! (idx_Mie_snw_mx is number of snow radii with defined parameters (i.e. from 30um to 1500um))
-
- ! direct-beam weighted ice optical properties
- real(r8) :: ss_alb_snw_drc(idx_Mie_snw_mx,numrad_snw)
- real(r8) :: asm_prm_snw_drc(idx_Mie_snw_mx,numrad_snw)
- real(r8) :: ext_cff_mss_snw_drc(idx_Mie_snw_mx,numrad_snw)
-
- ! diffuse radiation weighted ice optical properties
- real(r8) :: ss_alb_snw_dfs(idx_Mie_snw_mx,numrad_snw)
- real(r8) :: asm_prm_snw_dfs(idx_Mie_snw_mx,numrad_snw)
- real(r8) :: ext_cff_mss_snw_dfs(idx_Mie_snw_mx,numrad_snw)
-
- ! hydrophiliic BC
- real(r8) :: ss_alb_bc1(numrad_snw)
- real(r8) :: asm_prm_bc1(numrad_snw)
- real(r8) :: ext_cff_mss_bc1(numrad_snw)
-
- ! hydrophobic BC
- real(r8) :: ss_alb_bc2(numrad_snw)
- real(r8) :: asm_prm_bc2(numrad_snw)
- real(r8) :: ext_cff_mss_bc2(numrad_snw)
-
- ! hydrophobic OC
- real(r8) :: ss_alb_oc1(numrad_snw)
- real(r8) :: asm_prm_oc1(numrad_snw)
- real(r8) :: ext_cff_mss_oc1(numrad_snw)
-
- ! hydrophilic OC
- real(r8) :: ss_alb_oc2(numrad_snw)
- real(r8) :: asm_prm_oc2(numrad_snw)
- real(r8) :: ext_cff_mss_oc2(numrad_snw)
-
- ! dust species 1:
- real(r8) :: ss_alb_dst1(numrad_snw)
- real(r8) :: asm_prm_dst1(numrad_snw)
- real(r8) :: ext_cff_mss_dst1(numrad_snw)
-
- ! dust species 2:
- real(r8) :: ss_alb_dst2(numrad_snw)
- real(r8) :: asm_prm_dst2(numrad_snw)
- real(r8) :: ext_cff_mss_dst2(numrad_snw)
-
- ! dust species 3:
- real(r8) :: ss_alb_dst3(numrad_snw)
- real(r8) :: asm_prm_dst3(numrad_snw)
- real(r8) :: ext_cff_mss_dst3(numrad_snw)
-
- ! dust species 4:
- real(r8) :: ss_alb_dst4(numrad_snw)
- real(r8) :: asm_prm_dst4(numrad_snw)
- real(r8) :: ext_cff_mss_dst4(numrad_snw)
-
- ! best-fit parameters for snow aging defined over:
- ! 11 temperatures from 225 to 273 K
- ! 31 temperature gradients from 0 to 300 K/m
- ! 8 snow densities from 0 to 350 kg/m3
- ! (arrays declared here, but are set in iniTimeConst)
- real(r8), pointer :: snowage_tau(:,:,:) ! (idx_rhos_max,idx_Tgrd_max,idx_T_max)
- real(r8), pointer :: snowage_kappa(:,:,:) ! (idx_rhos_max,idx_Tgrd_max,idx_T_max)
- real(r8), pointer :: snowage_drdt0(:,:,:) ! idx_rhos_max,idx_Tgrd_max,idx_T_max)
- !
- ! !REVISION HISTORY:
- ! Created by Mark Flanner
-
- character(len=*), parameter, private :: sourcefile = &
- __FILE__
- !-----------------------------------------------------------------------
-
-contains
-
- !-----------------------------------------------------------------------
- subroutine SnowOptics_init( )
-
- use fileutils , only : getfil
- use CLM_varctl , only : fsnowoptics
- use spmdMod , only : masterproc
- use ncdio_pio , only : file_desc_t, ncd_io, ncd_pio_openfile, ncd_pio_closefile
-
- type(file_desc_t) :: ncid ! netCDF file id
- character(len=256) :: locfn ! local filename
- character(len= 32) :: subname = 'SnowOptics_init' ! subroutine name
- integer :: ier ! error status
-
- return ! return early
- !
- ! Open optics file:
- if(masterproc) write(iulog,*) 'Attempting to read snow optical properties .....'
- call getfil (fsnowoptics, locfn, 0)
- call ncd_pio_openfile(ncid, locfn, 0)
- if(masterproc) write(iulog,*) subname,trim(fsnowoptics)
-
- ! direct-beam snow Mie parameters:
- call ncd_io('ss_alb_ice_drc', ss_alb_snw_drc, 'read', ncid, posNOTonfile=.true.)
- call ncd_io( 'asm_prm_ice_drc',asm_prm_snw_drc, 'read', ncid, posNOTonfile=.true.)
- call ncd_io( 'ext_cff_mss_ice_drc', ext_cff_mss_snw_drc, 'read', ncid, posNOTonfile=.true.)
-
- ! diffuse snow Mie parameters
- call ncd_io( 'ss_alb_ice_dfs', ss_alb_snw_dfs, 'read', ncid, posNOTonfile=.true.)
- call ncd_io( 'asm_prm_ice_dfs', asm_prm_snw_dfs, 'read', ncid, posNOTonfile=.true.)
- call ncd_io( 'ext_cff_mss_ice_dfs', ext_cff_mss_snw_dfs, 'read', ncid, posNOTonfile=.true.)
-
- ! BC species 1 Mie parameters
- call ncd_io( 'ss_alb_bcphil', ss_alb_bc1, 'read', ncid, posNOTonfile=.true.)
- call ncd_io( 'asm_prm_bcphil', asm_prm_bc1, 'read', ncid, posNOTonfile=.true.)
- call ncd_io( 'ext_cff_mss_bcphil', ext_cff_mss_bc1, 'read', ncid, posNOTonfile=.true.)
-
- ! BC species 2 Mie parameters
- call ncd_io( 'ss_alb_bcphob', ss_alb_bc2, 'read', ncid, posNOTonfile=.true.)
- call ncd_io( 'asm_prm_bcphob', asm_prm_bc2, 'read', ncid, posNOTonfile=.true.)
- call ncd_io( 'ext_cff_mss_bcphob', ext_cff_mss_bc2, 'read', ncid, posNOTonfile=.true.)
-
- ! OC species 1 Mie parameters
- call ncd_io( 'ss_alb_ocphil', ss_alb_oc1, 'read', ncid, posNOTonfile=.true.)
- call ncd_io( 'asm_prm_ocphil', asm_prm_oc1, 'read', ncid, posNOTonfile=.true.)
- call ncd_io( 'ext_cff_mss_ocphil', ext_cff_mss_oc1, 'read', ncid, posNOTonfile=.true.)
-
- ! OC species 2 Mie parameters
- call ncd_io( 'ss_alb_ocphob', ss_alb_oc2, 'read', ncid, posNOTonfile=.true.)
- call ncd_io( 'asm_prm_ocphob', asm_prm_oc2, 'read', ncid, posNOTonfile=.true.)
- call ncd_io( 'ext_cff_mss_ocphob', ext_cff_mss_oc2, 'read', ncid, posNOTonfile=.true.)
-
- ! dust species 1 Mie parameters
- call ncd_io( 'ss_alb_dust01', ss_alb_dst1, 'read', ncid, posNOTonfile=.true.)
- call ncd_io( 'asm_prm_dust01', asm_prm_dst1, 'read', ncid, posNOTonfile=.true.)
- call ncd_io( 'ext_cff_mss_dust01', ext_cff_mss_dst1, 'read', ncid, posNOTonfile=.true.)
-
- ! dust species 2 Mie parameters
- call ncd_io( 'ss_alb_dust02', ss_alb_dst2, 'read', ncid, posNOTonfile=.true.)
- call ncd_io( 'asm_prm_dust02', asm_prm_dst2, 'read', ncid, posNOTonfile=.true.)
- call ncd_io( 'ext_cff_mss_dust02', ext_cff_mss_dst2, 'read', ncid, posNOTonfile=.true.)
-
- ! dust species 3 Mie parameters
- call ncd_io( 'ss_alb_dust03', ss_alb_dst3, 'read', ncid, posNOTonfile=.true.)
- call ncd_io( 'asm_prm_dust03', asm_prm_dst3, 'read', ncid, posNOTonfile=.true.)
- call ncd_io( 'ext_cff_mss_dust03', ext_cff_mss_dst3, 'read', ncid, posNOTonfile=.true.)
-
- ! dust species 4 Mie parameters
- call ncd_io( 'ss_alb_dust04', ss_alb_dst4, 'read', ncid, posNOTonfile=.true.)
- call ncd_io( 'asm_prm_dust04', asm_prm_dst4, 'read', ncid, posNOTonfile=.true.)
- call ncd_io( 'ext_cff_mss_dust04', ext_cff_mss_dst4, 'read', ncid, posNOTonfile=.true.)
-
-
- call ncd_pio_closefile(ncid)
- if (masterproc) then
-
- write(iulog,*) 'Successfully read snow optical properties'
- ! print some diagnostics:
- write (iulog,*) 'SNICAR: Mie single scatter albedos for direct-beam ice, rds=100um: ', &
- ss_alb_snw_drc(71,1), ss_alb_snw_drc(71,2), ss_alb_snw_drc(71,3), &
- ss_alb_snw_drc(71,4), ss_alb_snw_drc(71,5)
- write (iulog,*) 'SNICAR: Mie single scatter albedos for diffuse ice, rds=100um: ', &
- ss_alb_snw_dfs(71,1), ss_alb_snw_dfs(71,2), ss_alb_snw_dfs(71,3), &
- ss_alb_snw_dfs(71,4), ss_alb_snw_dfs(71,5)
- if (DO_SNO_OC) then
- write (iulog,*) 'SNICAR: Including OC aerosols from snow radiative transfer calculations'
- else
- write (iulog,*) 'SNICAR: Excluding OC aerosols from snow radiative transfer calculations'
- endif
- write (iulog,*) 'SNICAR: Mie single scatter albedos for hydrophillic BC: ', &
- ss_alb_bc1(1), ss_alb_bc1(2), ss_alb_bc1(3), ss_alb_bc1(4), ss_alb_bc1(5)
- write (iulog,*) 'SNICAR: Mie single scatter albedos for hydrophobic BC: ', &
- ss_alb_bc2(1), ss_alb_bc2(2), ss_alb_bc2(3), ss_alb_bc2(4), ss_alb_bc2(5)
- if (DO_SNO_OC) then
- write (iulog,*) 'SNICAR: Mie single scatter albedos for hydrophillic OC: ', &
- ss_alb_oc1(1), ss_alb_oc1(2), ss_alb_oc1(3), ss_alb_oc1(4), ss_alb_oc1(5)
- write (iulog,*) 'SNICAR: Mie single scatter albedos for hydrophobic OC: ', &
- ss_alb_oc2(1), ss_alb_oc2(2), ss_alb_oc2(3), ss_alb_oc2(4), ss_alb_oc2(5)
- endif
- write (iulog,*) 'SNICAR: Mie single scatter albedos for dust species 1: ', &
- ss_alb_dst1(1), ss_alb_dst1(2), ss_alb_dst1(3), ss_alb_dst1(4), ss_alb_dst1(5)
- write (iulog,*) 'SNICAR: Mie single scatter albedos for dust species 2: ', &
- ss_alb_dst2(1), ss_alb_dst2(2), ss_alb_dst2(3), ss_alb_dst2(4), ss_alb_dst2(5)
- write (iulog,*) 'SNICAR: Mie single scatter albedos for dust species 3: ', &
- ss_alb_dst3(1), ss_alb_dst3(2), ss_alb_dst3(3), ss_alb_dst3(4), ss_alb_dst3(5)
- write (iulog,*) 'SNICAR: Mie single scatter albedos for dust species 4: ', &
- ss_alb_dst4(1), ss_alb_dst4(2), ss_alb_dst4(3), ss_alb_dst4(4), ss_alb_dst4(5)
- write(iulog,*)
- end if
-
- end subroutine SnowOptics_init
-
- !-----------------------------------------------------------------------
- subroutine SnowAge_init( )
- use CLM_varctl , only : fsnowaging
- use fileutils , only : getfil
- use spmdMod , only : masterproc
- use ncdio_pio , only : file_desc_t, ncd_io, ncd_pio_openfile, ncd_pio_closefile
-
- type(file_desc_t) :: ncid ! netCDF file id
- character(len=256) :: locfn ! local filename
- character(len= 32) :: subname = 'SnowOptics_init' ! subroutine name
- integer :: varid ! netCDF id's
- integer :: ier ! error status
-
- ! Open snow aging (effective radius evolution) file:
- allocate(snowage_tau(idx_rhos_max,idx_Tgrd_max,idx_T_max))
- allocate(snowage_kappa(idx_rhos_max,idx_Tgrd_max,idx_T_max))
- allocate(snowage_drdt0(idx_rhos_max,idx_Tgrd_max,idx_T_max))
-
- return ! return early
- if(masterproc) write(iulog,*) 'Attempting to read snow aging parameters .....'
- call getfil (fsnowaging, locfn, 0)
- call ncd_pio_openfile(ncid, locfn, 0)
- if(masterproc) write(iulog,*) subname,trim(fsnowaging)
-
- ! snow aging parameters
-
- call ncd_io('tau', snowage_tau, 'read', ncid, posNOTonfile=.true.)
- call ncd_io('kappa', snowage_kappa, 'read', ncid, posNOTonfile=.true.)
- call ncd_io('drdsdt0', snowage_drdt0, 'read', ncid, posNOTonfile=.true.)
-
- call ncd_pio_closefile(ncid)
- if (masterproc) then
-
- write(iulog,*) 'Successfully read snow aging properties'
-
- ! print some diagnostics:
- write (iulog,*) 'SNICAR: snowage tau for T=263K, dTdz = 100 K/m, rhos = 150 kg/m3: ', snowage_tau(3,11,9)
- write (iulog,*) 'SNICAR: snowage kappa for T=263K, dTdz = 100 K/m, rhos = 150 kg/m3: ', snowage_kappa(3,11,9)
- write (iulog,*) 'SNICAR: snowage dr/dt_0 for T=263K, dTdz = 100 K/m, rhos = 150 kg/m3: ', snowage_drdt0(3,11,9)
- endif
-
- end subroutine SnowAge_init
-
- end module SnowSnicarMod
diff --git a/src/biogeophys/SoilHydrologyInitTimeConstMod.F90 b/src/biogeophys/SoilHydrologyInitTimeConstMod.F90
deleted file mode 100644
index b399b104..00000000
--- a/src/biogeophys/SoilHydrologyInitTimeConstMod.F90
+++ /dev/null
@@ -1,565 +0,0 @@
-module SoilHydrologyInitTimeConstMod
-
- !------------------------------------------------------------------------------
- ! DESCRIPTION:
- ! Initialize time constant variables for SoilHydrologyType
- !
- ! !USES
- use shr_kind_mod , only : r8 => shr_kind_r8
- use shr_log_mod , only : errMsg => shr_log_errMsg
- use decompMod , only : bounds_type
- use SoilHydrologyType , only : soilhydrology_type
- use LandunitType , only : lun
- use ColumnType , only : col
- !
- implicit none
- private
- !
- ! !PUBLIC MEMBER FUNCTIONS:
- public :: SoilHydrologyInitTimeConst
- !
- ! !PRIVATE MEMBER FUNCTIONS:
- private :: initSoilParVIC ! Convert default CLM soil properties to VIC parameters
- private :: initCLMVICMap ! Initialize map from VIC to CLM layers
- private :: linear_interp ! function for linear interperation
-
- character(len=*), parameter, private :: sourcefile = &
- __FILE__
- !-----------------------------------------------------------------------
- !
-contains
-
- !-----------------------------------------------------------------------
- subroutine SoilHydrologyInitTimeConst(bounds, soilhydrology_inst)
- !
- ! !USES:
- use shr_const_mod , only : shr_const_pi
- use shr_spfn_mod , only : shr_spfn_erf
- use abortutils , only : endrun
- use clm_varctl , only : fsurdat, paramfile, iulog, use_vichydro, soil_layerstruct
- use clm_varpar , only : nlevsoifl, toplev_equalspace
- use clm_varpar , only : nlevsoi, nlevgrnd, nlevsno, nlevlak, nlevurb, nlayer, nlayert
- use clm_varcon , only : zsoi, dzsoi, zisoi, spval, nlvic, dzvic, pc, grlnd
- use clm_varcon , only : aquifer_water_baseline
- use landunit_varcon , only : istwet, istsoil, istdlak, istcrop, istice_mec
- use column_varcon , only : icol_shadewall, icol_road_perv, icol_road_imperv, icol_roof, icol_sunwall
- use fileutils , only : getfil
- use organicFileMod , only : organicrd
- use ncdio_pio , only : file_desc_t, ncd_io, ncd_pio_openfile, ncd_pio_closefile
- !
- ! !ARGUMENTS:
- type(bounds_type) , intent(in) :: bounds
- type(soilhydrology_type) , intent(inout) :: soilhydrology_inst
- !
- ! !LOCAL VARIABLES:
- integer :: p,c,j,l,g,lev,nlevs
- integer :: ivic,ivicstrt,ivicend
- real(r8) :: maxslope, slopemax, minslope
- real(r8) :: d, fd, dfdd, slope0,slopebeta
- real(r8) ,pointer :: tslope(:)
- logical :: readvar
- type(file_desc_t) :: ncid
- character(len=256) :: locfn
- real(r8) :: clay,sand ! temporaries
- real(r8) :: om_frac ! organic matter fraction
- real(r8) :: organic_max ! organic matter (kg/m3) where soil is assumed to act like peat
- real(r8) ,pointer :: b2d (:) ! read in - VIC b
- real(r8) ,pointer :: ds2d (:) ! read in - VIC Ds
- real(r8) ,pointer :: dsmax2d (:) ! read in - VIC Dsmax
- real(r8) ,pointer :: ws2d (:) ! read in - VIC Ws
- real(r8), pointer :: sandcol (:,:) ! column level sand fraction for calculating VIC parameters
- real(r8), pointer :: claycol (:,:) ! column level clay fraction for calculating VIC parameters
- real(r8), pointer :: om_fraccol (:,:) ! column level organic matter fraction for calculating VIC parameters
- real(r8) ,pointer :: sand3d (:,:) ! read in - soil texture: percent sand
- real(r8) ,pointer :: clay3d (:,:) ! read in - soil texture: percent clay
- real(r8) ,pointer :: organic3d (:,:) ! read in - organic matter: kg/m3
- real(r8) ,pointer :: zisoifl (:) ! original soil interface depth
- real(r8) ,pointer :: zsoifl (:) ! original soil midpoint
- real(r8) ,pointer :: dzsoifl (:) ! original soil thickness
- !-----------------------------------------------------------------------
- ! -----------------------------------------------------------------
- ! Initialize frost table
- ! -----------------------------------------------------------------
-
- soilhydrology_inst%wa_col(bounds%begc:bounds%endc) = aquifer_water_baseline
- soilhydrology_inst%zwt_col(bounds%begc:bounds%endc) = 0._r8
-
- do c = bounds%begc,bounds%endc
- l = col%landunit(c)
- if (.not. lun%lakpoi(l)) then !not lake
- if (lun%urbpoi(l)) then
- if (col%itype(c) == icol_road_perv) then
- ! Note that the following hard-coded constants (on the next two lines)
- ! seem implicitly related to aquifer_water_baseline
- soilhydrology_inst%wa_col(c) = 4800._r8
- soilhydrology_inst%zwt_col(c) = (25._r8 + col%zi(c,nlevsoi)) - soilhydrology_inst%wa_col(c)/0.2_r8 /1000._r8 ! One meter below soil column
- else
- soilhydrology_inst%wa_col(c) = spval
- soilhydrology_inst%zwt_col(c) = spval
- end if
- ! initialize frost_table, zwt_perched
- soilhydrology_inst%zwt_perched_col(c) = spval
- soilhydrology_inst%frost_table_col(c) = spval
- else
- ! Note that the following hard-coded constants (on the next two lines) seem
- ! implicitly related to aquifer_water_baseline
- soilhydrology_inst%wa_col(c) = 4000._r8
- soilhydrology_inst%zwt_col(c) = (25._r8 + col%zi(c,nlevsoi)) - soilhydrology_inst%wa_col(c)/0.2_r8 /1000._r8 ! One meter below soil column
- ! initialize frost_table, zwt_perched to bottom of soil column
- soilhydrology_inst%zwt_perched_col(c) = col%zi(c,nlevsoi)
- soilhydrology_inst%frost_table_col(c) = col%zi(c,nlevsoi)
- end if
- end if
- end do
-
- ! Initialize VIC variables
-
- if (use_vichydro) then
-
- allocate(b2d (bounds%begg:bounds%endg))
- allocate(ds2d (bounds%begg:bounds%endg))
- allocate(dsmax2d (bounds%begg:bounds%endg))
- allocate(ws2d (bounds%begg:bounds%endg))
- allocate(sandcol (bounds%begc:bounds%endc,1:nlevgrnd ))
- allocate(claycol (bounds%begc:bounds%endc,1:nlevgrnd ))
- allocate(om_fraccol (bounds%begc:bounds%endc,1:nlevgrnd ))
-
- call getfil (fsurdat, locfn, 0)
- call ncd_pio_openfile (ncid, locfn, 0)
- call ncd_io(ncid=ncid, varname='binfl', flag='read', data=b2d, dim1name=grlnd, readvar=readvar)
- if (.not. readvar) then
- call endrun(msg=' ERROR: binfl NOT on surfdata file'//errMsg(sourcefile, __LINE__))
- end if
- call ncd_io(ncid=ncid, varname='Ds', flag='read', data=ds2d, dim1name=grlnd, readvar=readvar)
- if (.not. readvar) then
- call endrun(msg=' ERROR: Ds NOT on surfdata file'//errMsg(sourcefile, __LINE__))
- end if
- call ncd_io(ncid=ncid, varname='Dsmax', flag='read', data=dsmax2d, dim1name=grlnd, readvar=readvar)
- if (.not. readvar) then
- call endrun(msg=' ERROR: Dsmax NOT on surfdata file'//errMsg(sourcefile, __LINE__))
- end if
- call ncd_io(ncid=ncid, varname='Ws', flag='read', data=ws2d, dim1name=grlnd, readvar=readvar)
- if (.not. readvar) then
- call endrun(msg=' ERROR: Ws NOT on surfdata file'//errMsg(sourcefile, __LINE__))
- end if
- call ncd_pio_closefile(ncid)
-
- !define the depth of VIC soil layers here
- nlvic(1) = 3
- nlvic(2) = toplev_equalspace - nlvic(1)
- nlvic(3) = nlevsoi - (nlvic(1) + nlvic(2))
-
- dzvic(:) = 0._r8
- ivicstrt = 1
-
- do ivic = 1,nlayer
- ivicend = ivicstrt+nlvic(ivic)-1
- do j = ivicstrt,ivicend
- dzvic(ivic) = dzvic(ivic)+dzsoi(j)
- end do
- ivicstrt = ivicend+1
- end do
-
- do c = bounds%begc, bounds%endc
- g = col%gridcell(c)
- soilhydrology_inst%b_infil_col(c) = b2d(g)
- soilhydrology_inst%ds_col(c) = ds2d(g)
- soilhydrology_inst%dsmax_col(c) = dsmax2d(g)
- soilhydrology_inst%Wsvic_col(c) = ws2d(g)
- end do
-
- do c = bounds%begc, bounds%endc
- soilhydrology_inst%max_infil_col(c) = spval
- soilhydrology_inst%i_0_col(c) = spval
- do lev = 1, nlayer
- soilhydrology_inst%ice_col(c,lev) = spval
- soilhydrology_inst%moist_col(c,lev) = spval
- soilhydrology_inst%moist_vol_col(c,lev) = spval
- soilhydrology_inst%max_moist_col(c,lev) = spval
- soilhydrology_inst%porosity_col(c,lev) = spval
- soilhydrology_inst%expt_col(c,lev) = spval
- soilhydrology_inst%ksat_col(c,lev) = spval
- soilhydrology_inst%phi_s_col(c,lev) = spval
- soilhydrology_inst%depth_col(c,lev) = spval
- sandcol(c,lev) = spval
- claycol(c,lev) = spval
- om_fraccol(c,lev) = spval
- end do
- end do
-
- allocate(sand3d(bounds%begg:bounds%endg,nlevsoifl))
- allocate(clay3d(bounds%begg:bounds%endg,nlevsoifl))
- allocate(organic3d(bounds%begg:bounds%endg,nlevsoifl))
-
- call organicrd(organic3d)
-
- call getfil (fsurdat, locfn, 0)
- call ncd_pio_openfile (ncid, locfn, 0)
- call ncd_io(ncid=ncid, varname='PCT_SAND', flag='read', data=sand3d, dim1name=grlnd, readvar=readvar)
- if (.not. readvar) then
- call endrun(msg=' ERROR: PCT_SAND NOT on surfdata file'//errMsg(sourcefile, __LINE__))
- end if
- call ncd_io(ncid=ncid, varname='PCT_CLAY', flag='read', data=clay3d, dim1name=grlnd, readvar=readvar)
- if (.not. readvar) then
- call endrun(msg=' ERROR: PCT_CLAY NOT on surfdata file'//errMsg(sourcefile, __LINE__))
- end if
- call ncd_pio_closefile(ncid)
-
- ! Determine organic_max
- call getfil (paramfile, locfn, 0)
- call ncd_pio_openfile (ncid, trim(locfn), 0)
- call ncd_io(ncid=ncid, varname='organic_max', flag='read', data=organic_max, readvar=readvar)
- if ( .not. readvar ) then
- call endrun(msg=' ERROR: organic_max not on param file'//errMsg(sourcefile, __LINE__))
- end if
- call ncd_pio_closefile(ncid)
-
- ! get original soil depths to be used in interpolation of sand and clay
- allocate(zsoifl(1:nlevsoifl), zisoifl(0:nlevsoifl), dzsoifl(1:nlevsoifl))
- do j = 1, nlevsoifl
- zsoifl(j) = 0.025*(exp(0.5_r8*(j-0.5_r8))-1._r8) !node depths
- enddo
-
- dzsoifl(1) = 0.5_r8*(zsoifl(1)+zsoifl(2)) !thickness b/n two interfaces
- do j = 2,nlevsoifl-1
- dzsoifl(j)= 0.5_r8*(zsoifl(j+1)-zsoifl(j-1))
- enddo
- dzsoifl(nlevsoifl) = zsoifl(nlevsoifl)-zsoifl(nlevsoifl-1)
-
- zisoifl(0) = 0._r8
- do j = 1, nlevsoifl-1
- zisoifl(j) = 0.5_r8*(zsoifl(j)+zsoifl(j+1)) !interface depths
- enddo
- zisoifl(nlevsoifl) = zsoifl(nlevsoifl) + 0.5_r8*dzsoifl(nlevsoifl)
-
- do c = bounds%begc, bounds%endc
- g = col%gridcell(c)
- l = col%landunit(c)
-
- if (lun%itype(l) /= istdlak) then ! soil columns of both urban and non-urban types
- if (lun%itype(l)==istwet .or. lun%itype(l)==istice_mec) then
- ! do nothing
- else if (lun%urbpoi(l) .and. (col%itype(c) /= icol_road_perv) .and. (col%itype(c) /= icol_road_imperv) )then
- ! do nothing
- else
- do lev = 1,nlevgrnd
- if ( soil_layerstruct /= '10SL_3.5m' )then
- write(iulog,*) 'Setting clay, sand, organic, in Soil Hydrology for VIC'
- if (lev .eq. 1) then
- clay = clay3d(g,1)
- sand = sand3d(g,1)
- om_frac = organic3d(g,1)/organic_max
- else if (lev <= nlevsoi) then
- do j = 1,nlevsoifl-1
- if (zisoi(lev) >= zisoifl(j) .AND. zisoi(lev) < zisoifl(j+1)) then
- clay = clay3d(g,j+1)
- sand = sand3d(g,j+1)
- om_frac = organic3d(g,j+1)/organic_max
- endif
- end do
- else
- clay = clay3d(g,nlevsoifl)
- sand = sand3d(g,nlevsoifl)
- om_frac = 0._r8
- endif
- else
- ! duplicate clay and sand values from 10th soil layer
- if (lev <= nlevsoi) then
- clay = clay3d(g,lev)
- sand = sand3d(g,lev)
- om_frac = (organic3d(g,lev)/organic_max)**2._r8
- else
- clay = clay3d(g,nlevsoi)
- sand = sand3d(g,nlevsoi)
- om_frac = 0._r8
- endif
- end if
-
- if (lun%urbpoi(l)) om_frac = 0._r8
- claycol(c,lev) = clay
- sandcol(c,lev) = sand
- om_fraccol(c,lev) = om_frac
- end do
- end if
- end if ! end of if not lake
-
- if (lun%itype(l) /= istdlak) then ! soil columns of both urban and non-urban types
- if (lun%urbpoi(l)) then
- if (col%itype(c)==icol_sunwall .or. col%itype(c)==icol_shadewall .or. col%itype(c)==icol_roof) then
- ! do nothing
- else
- soilhydrology_inst%depth_col(c, 1:nlayer) = dzvic
- soilhydrology_inst%depth_col(c, nlayer+1:nlayert) = col%dz(c, nlevsoi+1:nlevgrnd)
-
- ! create weights to map soil moisture profiles (10 layer) to 3 layers for VIC hydrology, M.Huang
- call initCLMVICMap(c, soilhydrology_inst)
- call initSoilParVIC(c, claycol, sandcol, om_fraccol, soilhydrology_inst)
- end if
- else
- soilhydrology_inst%depth_col(c, 1:nlayer) = dzvic
- soilhydrology_inst%depth_col(c, nlayer+1:nlayert) = col%dz(c, nlevsoi+1:nlevgrnd)
-
- ! create weights to map soil moisture profiles (10 layer) to 3 layers for VIC hydrology, M.Huang
- call initCLMVICMap(c, soilhydrology_inst)
- call initSoilParVIC(c, claycol, sandcol, om_fraccol, soilhydrology_inst)
- end if
- end if ! end of if not lake
-
- end do ! end of loop over columns
-
- deallocate(b2d, ds2d, dsmax2d, ws2d)
- deallocate(sandcol, claycol, om_fraccol)
- deallocate(sand3d, clay3d, organic3d)
- deallocate(zisoifl, zsoifl, dzsoifl)
-
- end if ! end of if use_vichydro
-
- associate(micro_sigma => col%micro_sigma)
- do c = bounds%begc, bounds%endc
-
- ! determine h2osfc threshold ("fill & spill" concept)
- ! set to zero for no h2osfc (w/frac_infclust =large)
-
- soilhydrology_inst%h2osfc_thresh_col(c) = 0._r8
- if (micro_sigma(c) > 1.e-6_r8 .and. (soilhydrology_inst%h2osfcflag /= 0)) then
- d = 0.0
- do p = 1,4
- fd = 0.5*(1.0_r8+shr_spfn_erf(d/(micro_sigma(c)*sqrt(2.0)))) - pc
- dfdd = exp(-d**2/(2.0*micro_sigma(c)**2))/(micro_sigma(c)*sqrt(2.0*shr_const_pi))
- d = d - fd/dfdd
- enddo
- soilhydrology_inst%h2osfc_thresh_col(c) = 0.5*d*(1.0_r8+shr_spfn_erf(d/(micro_sigma(c)*sqrt(2.0)))) + &
- micro_sigma(c)/sqrt(2.0*shr_const_pi)*exp(-d**2/(2.0*micro_sigma(c)**2))
- soilhydrology_inst%h2osfc_thresh_col(c) = 1.e3_r8 * soilhydrology_inst%h2osfc_thresh_col(c) !convert to mm from meters
- else
- soilhydrology_inst%h2osfc_thresh_col(c) = 0._r8
- endif
-
- if (soilhydrology_inst%h2osfcflag == 0) then
- soilhydrology_inst%h2osfc_thresh_col(c) = 0._r8 ! set to zero for no h2osfc (w/frac_infclust =large)
- endif
-
- ! set decay factor
- soilhydrology_inst%hkdepth_col(c) = 1._r8/2.5_r8
-
- end do
- end associate
-
- end subroutine SoilhydrologyInitTimeConst
-
- !-----------------------------------------------------------------------
- subroutine initSoilParVIC(c, claycol, sandcol, om_fraccol, soilhydrology_inst)
- !
- ! !DESCRIPTION:
- ! Convert default CLM soil properties to VIC parameters
- ! to be used for runoff simulations (added by M. Huang)
- !
- ! !USES:
- use clm_varpar, only : nlevsoi, nlayert, nlayer
- !
- ! !ARGUMENTS:
- integer , intent(in) :: c ! column index
- real(r8) , pointer :: sandcol(:,:) ! read in - soil texture: percent sand
- real(r8) , pointer :: claycol(:,:) ! read in - soil texture: percent clay
- real(r8) , pointer :: om_fraccol(:,:) ! read in - organic matter: kg/m3
- type(soilhydrology_type) , intent(inout) :: soilhydrology_inst
-
- ! !LOCAL VARIABLES:
- real(r8) :: om_watsat = 0.9_r8 ! porosity of organic soil
- real(r8) :: om_hksat = 0.1_r8 ! saturated hydraulic conductivity of organic soil [mm/s]
- real(r8) :: om_tkm = 0.25_r8 ! thermal conductivity of organic soil (Farouki, 1986) [W/m/K]
- real(r8) :: om_sucsat = 10.3_r8 ! saturated suction for organic matter (Letts, 2000)
- real(r8) :: om_csol = 2.5_r8 ! heat capacity of peat soil *10^6 (J/K m3) (Farouki, 1986)
- real(r8) :: om_tkd = 0.05_r8 ! thermal conductivity of dry organic soil (Farouki, 1981)
- real(r8) :: om_b = 2.7_r8 ! Clapp Hornberger paramater for oragnic soil (Letts, 2000)
- real(r8) :: om_expt = 3._r8+2._r8*2.7_r8 ! soil expt for VIC
- real(r8) :: csol_bedrock = 2.0e6_r8 ! vol. heat capacity of granite/sandstone J/(m3 K)(Shabbir, 2000)
- real(r8) :: pc = 0.5_r8 ! percolation threshold
- real(r8) :: pcbeta = 0.139_r8 ! percolation exponent
- real(r8) :: xksat ! maximum hydraulic conductivity of soil [mm/s]
- real(r8) :: perc_frac ! "percolating" fraction of organic soil
- real(r8) :: perc_norm ! normalize to 1 when 100% organic soil
- real(r8) :: uncon_hksat ! series conductivity of mineral/organic soil
- real(r8) :: uncon_frac ! fraction of "unconnected" soil
- real(r8) :: temp_sum_frac ! sum of node fractions in each VIC layer
- real(r8) :: sandvic(1:nlayert) ! temporary, weighted averaged sand% for VIC layers
- real(r8) :: clayvic(1:nlayert) ! temporary, weighted averaged clay% for VIC layers
- real(r8) :: om_fracvic(1:nlayert) ! temporary, weighted averaged organic matter fract for VIC layers
- integer :: i, j ! indices
- !-------------------------------------------------------------------------------------------
-
- ! soilhydrology_inst%depth_col(:,:) Output: layer depth of upper layer(m)
- ! soilhydrology_inst%vic_clm_fract_col(:,:,:) Output: fraction of VIC layers in CLM layers
- ! soilhydrology_inst%c_param_col(:) Output: baseflow exponent (Qb)
- ! soilhydrology_inst%expt_col(:,:) Output: pore-size distribution related paramter(Q12)
- ! soilhydrology_inst%ksat_col(:,:) Output: Saturated hydrologic conductivity (mm/s)
- ! soilhydrology_inst%phi_s_col(:,:) Output: soil moisture dissusion parameter
- ! soilhydrology_inst%porosity_col(:,:) Output: soil porosity
- ! soilhydrology_inst%max_moist_col(:,:) Output: maximum soil moisture (ice + liq)
-
- ! map parameters between VIC layers and CLM layers
- soilhydrology_inst%c_param_col(c) = 2._r8
-
- ! map the CLM layers to VIC layers
- do i = 1, nlayer
-
- sandvic(i) = 0._r8
- clayvic(i) = 0._r8
- om_fracvic(i) = 0._r8
- temp_sum_frac = 0._r8
- do j = 1, nlevsoi
- sandvic(i) = sandvic(i) + sandcol(c,j) * soilhydrology_inst%vic_clm_fract_col(c,i,j)
- clayvic(i) = clayvic(i) + claycol(c,j) * soilhydrology_inst%vic_clm_fract_col(c,i,j)
- om_fracvic(i) = om_fracvic(i) + om_fraccol(c,j) * soilhydrology_inst%vic_clm_fract_col(c,i,j)
- temp_sum_frac = temp_sum_frac + soilhydrology_inst%vic_clm_fract_col(c,i,j)
- end do
-
- !average soil properties, M.Huang, 08/11/2010
- sandvic(i) = sandvic(i)/temp_sum_frac
- clayvic(i) = clayvic(i)/temp_sum_frac
- om_fracvic(i) = om_fracvic(i)/temp_sum_frac
-
- !make sure sand, clay and om fractions are between 0 and 100%
- sandvic(i) = min(100._r8 , sandvic(i))
- clayvic(i) = min(100._r8 , clayvic(i))
- om_fracvic(i) = min(100._r8 , om_fracvic(i))
- sandvic(i) = max(0._r8 , sandvic(i))
- clayvic(i) = max(0._r8 , clayvic(i))
- om_fracvic(i) = max(0._r8 , om_fracvic(i))
-
- !calculate other parameters based on teh percentages
- soilhydrology_inst%porosity_col(c, i) = 0.489_r8 - 0.00126_r8*sandvic(i)
- soilhydrology_inst%expt_col(c, i) = 3._r8+ 2._r8*(2.91_r8 + 0.159_r8*clayvic(i))
- xksat = 0.0070556 *( 10.**(-0.884+0.0153*sandvic(i)) )
-
- !consider organic matter, M.Huang
- soilhydrology_inst%expt_col(c, i) = &
- (1._r8 - om_fracvic(i))*soilhydrology_inst%expt_col(c, i) + om_fracvic(i)*om_expt
- soilhydrology_inst%porosity_col(c,i) = &
- (1._r8 - om_fracvic(i))*soilhydrology_inst%porosity_col(c,i) + om_watsat*om_fracvic(i)
-
- ! perc_frac is zero unless perf_frac greater than percolation threshold
- if (om_fracvic(i) > pc) then
- perc_norm=(1._r8 - pc)**(-pcbeta)
- perc_frac=perc_norm*(om_fracvic(i) - pc)**pcbeta
- else
- perc_frac=0._r8
- endif
- ! uncon_frac is fraction of mineral soil plus fraction of "nonpercolating" organic soil
- uncon_frac=(1._r8-om_fracvic(i))+(1._r8-perc_frac)*om_fracvic(i)
-
- ! uncon_hksat is series addition of mineral/organic conductivites
- if (om_fracvic(i) < 1._r8) then
- uncon_hksat=uncon_frac/((1._r8-om_fracvic(i))/xksat &
- +((1._r8-perc_frac)*om_fracvic(i))/om_hksat)
- else
- uncon_hksat = 0._r8
- end if
-
- soilhydrology_inst%ksat_col(c,i) = &
- uncon_frac*uncon_hksat + (perc_frac*om_fracvic(i))*om_hksat
-
- soilhydrology_inst%max_moist_col(c,i) = &
- soilhydrology_inst%porosity_col(c,i) * soilhydrology_inst%depth_col(c,i) * 1000._r8 !in mm!
-
- soilhydrology_inst%phi_s_col(c,i) = &
- -(exp((1.54_r8 - 0.0095_r8*sandvic(i) + &
- 0.0063_r8*(100.0_r8-sandvic(i)-clayvic(i)))*log(10.0_r8))*9.8e-5_r8)
-
- end do ! end of loop over layers
-
- end subroutine initSoilParVIC
-
- !-----------------------------------------------------------------------
- subroutine initCLMVICMap(c, soilhydrology_inst)
- !
- ! !DESCRIPTION:
- ! Calculates mapping between CLM and VIC layers
- ! added by AWang, modified by M.Huang for CLM4
- ! NOTE: in CLM h2osoil_liq unit is kg/m2, in VIC moist is mm
- ! h2osoi_ice is actually water equavlent ice content.
- !
- ! !USES:
- use clm_varpar , only : nlevsoi, nlayer
- !
- ! !ARGUMENTS:
- integer , intent(in) :: c
- type(soilhydrology_type), intent(inout) :: soilhydrology_inst
- !
- ! !REVISION HISTORY:
- ! Created by Maoyi Huang
- ! 11/13/2012, Maoyi Huang: rewrite the mapping modules in CLM4VIC
- !
- ! !LOCAL VARIABLES
- real(r8) :: sum_frac(1:nlayer) ! sum of fraction for each layer
- real(r8) :: deltal(1:nlayer+1) ! temporary
- real(r8) :: zsum ! temporary
- real(r8) :: lsum ! temporary
- real(r8) :: temp ! temporary
- integer :: i, j, fc
- !-----------------------------------------------------------------------
-
- associate( &
- dz => col%dz , & ! Input: [real(r8) (:,:) ] layer depth (m)
- zi => col%zi , & ! Input: [real(r8) (:,:) ] interface level below a "z" level (m)
- z => col%z , & ! Input: [real(r8) (:,:) ] layer thickness (m)
-
- depth => soilhydrology_inst%depth_col , & ! Input: [real(r8) (:,:) ] layer depth of VIC (m)
- vic_clm_fract => soilhydrology_inst%vic_clm_fract_col & ! Output: [real(r8) (:,:,:) ] fraction of VIC layers in clm layers
- )
-
- ! set fraction of VIC layer in each CLM layer
-
- lsum = 0._r8
- do i = 1, nlayer
- deltal(i) = depth(c,i)
- end do
- do i = 1, nlayer
- zsum = 0._r8
- sum_frac(i) = 0._r8
- do j = 1, nlevsoi
- if( (zsum < lsum) .and. (zsum + dz(c,j) >= lsum )) then
- call linear_interp(lsum, temp, zsum, zsum + dz(c,j), 0._r8, 1._r8)
- vic_clm_fract(c,i,j) = 1._r8 - temp
- if(lsum + deltal(i) < zsum + dz(c,j)) then
- call linear_interp(lsum + deltal(i), temp, zsum, zsum + dz(c,j), 1._r8, 0._r8)
- vic_clm_fract(c,i,j) = vic_clm_fract(c,i,j) - temp
- end if
- else if( (zsum < lsum + deltal(i)) .and. (zsum + dz(c,j) >= lsum + deltal(i)) ) then
- call linear_interp(lsum + deltal(i), temp, zsum, zsum + dz(c,j), 0._r8, 1._r8)
- vic_clm_fract(c,i,j) = temp
- if(zsum<=lsum) then
- call linear_interp(lsum, temp, zsum, zsum + dz(c,j), 0._r8, 1._r8)
- vic_clm_fract(c,i,j) = vic_clm_fract(c,i,j) - temp
- end if
- else if( (zsum >= lsum .and. zsum + dz(c,j) <= lsum + deltal(i)) ) then
- vic_clm_fract(c,i,j) = 1._r8
- else
- vic_clm_fract(c,i,j) = 0._r8
- end if
- zsum = zsum + dz(c,j)
- sum_frac(i) = sum_frac(i) + vic_clm_fract(c,i,j)
- end do ! end CLM layer calculation
- lsum = lsum + deltal(i)
- end do ! end VIC layer calcultion
-
- end associate
-
- end subroutine initCLMVICMap
-
- !-------------------------------------------------------------------
- subroutine linear_interp(x,y, x0, x1, y0, y1)
- !
- ! !DESCRIPTION:
- ! Provides linear interpolation
- !
- ! !ARGUMENTS:
- real(r8), intent(in) :: x, x0, y0, x1, y1
- real(r8), intent(out) :: y
- !-------------------------------------------------------------------
-
- y = y0 + (x - x0) * (y1 - y0) / (x1 - x0)
-
- end subroutine linear_interp
-
-end module SoilHydrologyInitTimeConstMod
diff --git a/src/biogeophys/SoilHydrologyType.F90 b/src/biogeophys/SoilHydrologyType.F90
deleted file mode 100644
index be78df49..00000000
--- a/src/biogeophys/SoilHydrologyType.F90
+++ /dev/null
@@ -1,338 +0,0 @@
-Module SoilHydrologyType
-
- use shr_kind_mod , only : r8 => shr_kind_r8
- use shr_log_mod , only : errMsg => shr_log_errMsg
- use abortutils , only : endrun
- use decompMod , only : bounds_type
- use clm_varpar , only : nlevgrnd, nlayer, nlayert, nlevsoi
- use clm_varcon , only : spval
- use clm_varctl , only : iulog
- use LandunitType , only : lun
- use ColumnType , only : col
- !
- ! !PUBLIC TYPES:
- implicit none
- save
- !
- type, public :: soilhydrology_type
-
- integer :: h2osfcflag ! true => surface water is active (namelist)
- integer :: origflag ! used to control soil hydrology properties (namelist)
-
- real(r8), pointer :: num_substeps_col (:) ! col adaptive timestep counter
- ! NON-VIC
- real(r8), pointer :: frost_table_col (:) ! col frost table depth
- real(r8), pointer :: zwt_col (:) ! col water table depth
- 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 :: 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
- real(r8), pointer :: fcov_col (:) ! col fractional impermeable area
- real(r8), pointer :: fsat_col (:) ! col fractional area with water table at surface
- real(r8), pointer :: h2osfc_thresh_col (:) ! col level at which h2osfc "percolates" (time constant)
-
- ! VIC
- real(r8), pointer :: hkdepth_col (:) ! col VIC decay factor (m) (time constant)
- real(r8), pointer :: b_infil_col (:) ! col VIC b infiltration parameter (time constant)
- real(r8), pointer :: ds_col (:) ! col VIC fracton of Dsmax where non-linear baseflow begins (time constant)
- real(r8), pointer :: dsmax_col (:) ! col VIC max. velocity of baseflow (mm/day) (time constant)
- real(r8), pointer :: Wsvic_col (:) ! col VIC fraction of maximum soil moisutre where non-liear base flow occurs (time constant)
- real(r8), pointer :: porosity_col (:,:) ! col VIC porosity (1-bulk_density/soil_density)
- real(r8), pointer :: vic_clm_fract_col (:,:,:) ! col VIC fraction of VIC layers in CLM layers
- real(r8), pointer :: depth_col (:,:) ! col VIC layer depth of upper layer
- real(r8), pointer :: c_param_col (:) ! col VIC baseflow exponent (Qb)
- real(r8), pointer :: expt_col (:,:) ! col VIC pore-size distribution related paramter(Q12)
- real(r8), pointer :: ksat_col (:,:) ! col VIC Saturated hydrologic conductivity
- real(r8), pointer :: phi_s_col (:,:) ! col VIC soil moisture dissusion parameter
- real(r8), pointer :: moist_col (:,:) ! col VIC soil moisture (kg/m2) for VIC soil layers
- real(r8), pointer :: moist_vol_col (:,:) ! col VIC volumetric soil moisture for VIC soil layers
- real(r8), pointer :: max_moist_col (:,:) ! col VIC max layer moist + ice (mm)
- real(r8), pointer :: max_infil_col (:) ! col VIC maximum infiltration rate calculated in VIC
- real(r8), pointer :: i_0_col (:) ! col VIC average saturation in top soil layers
- real(r8), pointer :: ice_col (:,:) ! col VIC soil ice (kg/m2) for VIC soil layers
-
- contains
-
- ! Public routines
- procedure, public :: Init
- procedure, public :: Restart
-
- ! Private routines
- procedure, private :: InitAllocate
- procedure, private :: InitHistory
- procedure, private :: InitCold
- procedure, private :: ReadNL
-
- end type soilhydrology_type
-
- character(len=*), parameter, private :: sourcefile = &
- __FILE__
- !-----------------------------------------------------------------------
-
-contains
-
- !------------------------------------------------------------------------
- subroutine Init(this, bounds, NLFilename)
-
- class(soilhydrology_type) :: this
- type(bounds_type), intent(in) :: bounds
- character(len=*), intent(in) :: NLFilename
-
- call this%ReadNL(NLFilename)
- call this%InitAllocate(bounds)
- call this%InitHistory(bounds)
- call this%InitCold(bounds)
-
- end subroutine Init
-
- !------------------------------------------------------------------------
- subroutine InitAllocate(this, bounds)
- !
- ! !DESCRIPTION:
- ! Initialize module data structure
- !
- ! !USES:
- use shr_infnan_mod , only : nan => shr_infnan_nan, assignment(=)
- !
- ! !ARGUMENTS:
- class(soilhydrology_type) :: this
- type(bounds_type), intent(in) :: bounds
- !
- ! !LOCAL VARIABLES:
- integer :: begp, endp
- integer :: begc, endc
- integer :: begg, endg
- !------------------------------------------------------------------------
-
- begp = bounds%begp; endp= bounds%endp
- begc = bounds%begc; endc= bounds%endc
- begg = bounds%begg; endg= bounds%endg
-
- allocate(this%num_substeps_col (begc:endc)) ; this%num_substeps_col (:) = nan
- allocate(this%frost_table_col (begc:endc)) ; this%frost_table_col (:) = nan
- allocate(this%zwt_col (begc:endc)) ; this%zwt_col (:) = nan
- allocate(this%zwt_perched_col (begc:endc)) ; this%zwt_perched_col (:) = nan
- allocate(this%zwts_col (begc:endc)) ; this%zwts_col (:) = nan
-
- allocate(this%wa_col (begc:endc)) ; this%wa_col (:) = nan
- allocate(this%qcharge_col (begc:endc)) ; this%qcharge_col (:) = nan
- allocate(this%fracice_col (begc:endc,nlevgrnd)) ; this%fracice_col (:,:) = nan
- allocate(this%icefrac_col (begc:endc,nlevgrnd)) ; this%icefrac_col (:,:) = nan
- allocate(this%fcov_col (begc:endc)) ; this%fcov_col (:) = nan
- allocate(this%fsat_col (begc:endc)) ; this%fsat_col (:) = nan
- allocate(this%h2osfc_thresh_col (begc:endc)) ; this%h2osfc_thresh_col (:) = nan
-
- allocate(this%hkdepth_col (begc:endc)) ; this%hkdepth_col (:) = nan
- allocate(this%b_infil_col (begc:endc)) ; this%b_infil_col (:) = nan
- allocate(this%ds_col (begc:endc)) ; this%ds_col (:) = nan
- allocate(this%dsmax_col (begc:endc)) ; this%dsmax_col (:) = nan
- allocate(this%Wsvic_col (begc:endc)) ; this%Wsvic_col (:) = nan
- allocate(this%depth_col (begc:endc,nlayert)) ; this%depth_col (:,:) = nan
- allocate(this%porosity_col (begc:endc,nlayer)) ; this%porosity_col (:,:) = nan
- allocate(this%vic_clm_fract_col (begc:endc,nlayer, nlevsoi)) ; this%vic_clm_fract_col (:,:,:) = nan
- allocate(this%c_param_col (begc:endc)) ; this%c_param_col (:) = nan
- allocate(this%expt_col (begc:endc,nlayer)) ; this%expt_col (:,:) = nan
- allocate(this%ksat_col (begc:endc,nlayer)) ; this%ksat_col (:,:) = nan
- allocate(this%phi_s_col (begc:endc,nlayer)) ; this%phi_s_col (:,:) = nan
- allocate(this%moist_col (begc:endc,nlayert)) ; this%moist_col (:,:) = nan
- allocate(this%moist_vol_col (begc:endc,nlayert)) ; this%moist_vol_col (:,:) = nan
- allocate(this%max_moist_col (begc:endc,nlayer)) ; this%max_moist_col (:,:) = nan
- allocate(this%max_infil_col (begc:endc)) ; this%max_infil_col (:) = nan
- allocate(this%i_0_col (begc:endc)) ; this%i_0_col (:) = nan
- allocate(this%ice_col (begc:endc,nlayert)) ; this%ice_col (:,:) = nan
-
- end subroutine InitAllocate
-
- !------------------------------------------------------------------------
- subroutine InitHistory(this, bounds)
- !
- ! !USES:
- use histFileMod , only : hist_addfld1d
- !
- ! !ARGUMENTS:
- class(soilhydrology_type) :: this
- type(bounds_type), intent(in) :: bounds
- !
- ! !LOCAL VARIABLES:
- integer :: begc, endc
- integer :: begg, endg
- !------------------------------------------------------------------------
-
- begc = bounds%begc; endc= bounds%endc
- begg = bounds%begg; endg= bounds%endg
-
- this%wa_col(begc:endc) = spval
- call hist_addfld1d (fname='WA', units='mm', &
- avgflag='A', long_name='water in the unconfined aquifer (vegetated landunits only)', &
- ptr_col=this%wa_col, l2g_scale_type='veg', default='inactive')
-
- this%qcharge_col(begc:endc) = spval
- call hist_addfld1d (fname='QCHARGE', units='mm/s', &
- avgflag='A', long_name='aquifer recharge rate (vegetated landunits only)', &
- ptr_col=this%qcharge_col, l2g_scale_type='veg', default='inactive')
-
- this%fcov_col(begc:endc) = spval
- call hist_addfld1d (fname='FCOV', units='unitless', &
- avgflag='A', long_name='fractional impermeable area', &
- ptr_col=this%fcov_col, l2g_scale_type='veg', default='inactive')
-
- this%fsat_col(begc:endc) = spval
- call hist_addfld1d (fname='FSAT', units='unitless', &
- avgflag='A', long_name='fractional area with water table at surface', &
- ptr_col=this%fsat_col, l2g_scale_type='veg', default='inactive')
-
- this%num_substeps_col(begc:endc) = spval
- call hist_addfld1d (fname='NSUBSTEPS', units='unitless', &
- avgflag='A', long_name='number of adaptive timesteps in CLM timestep', &
- ptr_col=this%num_substeps_col, l2g_scale_type='veg', &
- default='inactive')
-
- this%frost_table_col(begc:endc) = spval
- call hist_addfld1d (fname='FROST_TABLE', units='m', &
- avgflag='A', long_name='frost table depth (vegetated landunits only)', &
- ptr_col=this%frost_table_col, l2g_scale_type='veg', default='inactive')
-
- this%zwt_col(begc:endc) = spval
- call hist_addfld1d (fname='ZWT', units='m', &
- avgflag='A', long_name='water table depth (vegetated landunits only)', &
- ptr_col=this%zwt_col, l2g_scale_type='veg', default='inactive')
-
- this%zwt_perched_col(begc:endc) = spval
- call hist_addfld1d (fname='ZWT_PERCH', units='m', &
- avgflag='A', long_name='perched water table depth (vegetated landunits only)', &
- ptr_col=this%zwt_perched_col, l2g_scale_type='veg', default='inactive')
-
- end subroutine InitHistory
-
- !-----------------------------------------------------------------------
- subroutine InitCold(this, bounds)
- !
- ! !USES:
- !
- ! !ARGUMENTS:
- class(soilhydrology_type) :: this
- type(bounds_type) , intent(in) :: bounds
- ! !LOCAL VARIABLES:
- integer :: c ! indices
-
- !-----------------------------------------------------------------------
-
- ! Nothing for now
-
- ! needs to be initialized to spval to avoid problems when
- ! averaging for the accum field
- do c = bounds%begc, bounds%endc
- this%num_substeps_col(c) = spval
- end do
-
- end subroutine InitCold
-
- !------------------------------------------------------------------------
- subroutine Restart(this, bounds, ncid, flag)
- !
- ! !USES:
- use ncdio_pio , only : file_desc_t, ncd_io, ncd_double
- use restUtilMod
- !
- ! !ARGUMENTS:
- class(soilhydrology_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
- !-----------------------------------------------------------------------
-
- call restartvar(ncid=ncid, flag=flag, varname='FROST_TABLE', xtype=ncd_double, &
- dim1name='column', &
- long_name='frost table depth', units='m', &
- interpinic_flag='interp', readvar=readvar, data=this%frost_table_col)
- if (flag == 'read' .and. .not. readvar) then
- this%frost_table_col(bounds%begc:bounds%endc) = col%zi(bounds%begc:bounds%endc,nlevsoi)
- end if
-
- call restartvar(ncid=ncid, flag=flag, varname='WA', xtype=ncd_double, &
- dim1name='column', &
- long_name='water in the unconfined aquifer', units='mm', &
- interpinic_flag='interp', readvar=readvar, data=this%wa_col)
-
- call restartvar(ncid=ncid, flag=flag, varname='ZWT', xtype=ncd_double, &
- dim1name='column', &
- long_name='water table depth', units='m', &
- interpinic_flag='interp', readvar=readvar, data=this%zwt_col)
-
- call restartvar(ncid=ncid, flag=flag, varname='ZWT_PERCH', xtype=ncd_double, &
- dim1name='column', &
- long_name='perched water table depth', units='m', &
- interpinic_flag='interp', readvar=readvar, data=this%zwt_perched_col)
- if (flag == 'read' .and. .not. readvar) then
- this%zwt_perched_col(bounds%begc:bounds%endc) = col%zi(bounds%begc:bounds%endc,nlevsoi)
- end if
-
- end subroutine Restart
-
- !-----------------------------------------------------------------------
- subroutine ReadNL( this, NLFilename )
- !
- ! !DESCRIPTION:
- ! Read namelist for SoilHydrology
- !
- ! !USES:
- use shr_mpi_mod , only : shr_mpi_bcast
- use shr_log_mod , only : errMsg => shr_log_errMsg
- use spmdMod , only : masterproc, mpicom
- use fileutils , only : getavu, relavu, opnfil
- use clm_nlUtilsMod , only : find_nlgroup_name
- use clm_varctl , only : iulog
- use abortutils , only : endrun
- !
- ! !ARGUMENTS:
- class(soilhydrology_type) :: this
- character(len=*), intent(IN) :: NLFilename ! Namelist filename
- !
- ! !LOCAL VARIABLES:
- integer :: ierr ! error code
- integer :: unitn ! unit for namelist file
- integer :: origflag=0 !use to control soil hydraulic properties
- integer :: h2osfcflag=1 !If surface water is active or not
- character(len=32) :: subname = 'SoilHydrology_readnl' ! subroutine name
- !-----------------------------------------------------------------------
-
- namelist / clm_soilhydrology_inparm / h2osfcflag, origflag
-
- ! preset values
-
- origflag = 0
- h2osfcflag = 1
-
- if ( masterproc )then
-
- unitn = getavu()
- write(iulog,*) 'Read in clm_soilhydrology_inparm namelist'
- call opnfil (NLFilename, unitn, 'F')
- call find_nlgroup_name(unitn, 'clm_soilhydrology_inparm', status=ierr)
- if (ierr == 0) then
- read(unitn, clm_soilhydrology_inparm, iostat=ierr)
- if (ierr /= 0) then
- call endrun(msg="ERROR reading clm_soilhydrology_inparm namelist"//errmsg(sourcefile, __LINE__))
- end if
- else
- call endrun(msg="ERROR finding clm_soilhydrology_inparm namelist"//errmsg(sourcefile, __LINE__))
- end if
- call relavu( unitn )
-
- end if
-
- call shr_mpi_bcast(h2osfcflag, mpicom)
- call shr_mpi_bcast(origflag, mpicom)
-
- this%h2osfcflag = h2osfcflag
- this%origflag = origflag
-
- end subroutine ReadNL
-
-end Module SoilHydrologyType
diff --git a/src/biogeophys/SoilStateInitTimeConstMod.F90 b/src/biogeophys/SoilStateInitTimeConstMod.F90
deleted file mode 100644
index 1c8f1342..00000000
--- a/src/biogeophys/SoilStateInitTimeConstMod.F90
+++ /dev/null
@@ -1,630 +0,0 @@
-module SoilStateInitTimeConstMod
-
- !------------------------------------------------------------------------------
- ! DESCRIPTION:
- ! Set hydraulic and thermal properties
- !
- ! !USES
- use SoilStateType , only : soilstate_type
- use LandunitType , only : lun
- use ColumnType , only : col
- use PatchType , only : patch
- !
- implicit none
- private
- !
- ! !PUBLIC MEMBER FUNCTIONS:
- public :: SoilStateInitTimeConst
- !
- ! !PRIVATE MEMBER FUNCTIONS:
- private :: ReadNL
- !
- ! !PRIVATE DATA:
- ! Control variables (from namelist)
- logical, private :: organic_frac_squared ! If organic fraction should be squared (as in CLM4.5)
-
- character(len=*), parameter, private :: sourcefile = &
- __FILE__
- !-----------------------------------------------------------------------
- !
-contains
-
- !-----------------------------------------------------------------------
- subroutine ReadNL( nlfilename )
- !
- ! !DESCRIPTION:
- ! Read namelist for SoilStateType
- !
- ! !USES:
- use shr_mpi_mod , only : shr_mpi_bcast
- use shr_log_mod , only : errMsg => shr_log_errMsg
- use fileutils , only : getavu, relavu, opnfil
- use clm_nlUtilsMod , only : find_nlgroup_name
- use clm_varctl , only : iulog
- use spmdMod , only : mpicom, masterproc
- use abortUtils , only : endrun
- !
- ! !ARGUMENTS:
- character(len=*), intent(in) :: nlfilename ! Namelist filename
- !
- ! !LOCAL VARIABLES:
- integer :: ierr ! error code
- integer :: unitn ! unit for namelist file
- character(len=32) :: subname = 'SoilState_readnl' ! subroutine name
- !-----------------------------------------------------------------------
-
- character(len=*), parameter :: nl_name = 'clm_soilstate_inparm' ! Namelist name
- ! MUST agree with name in namelist and read
- namelist / clm_soilstate_inparm / organic_frac_squared
-
- ! preset values
-
- organic_frac_squared = .false.
-
- if ( masterproc )then
-
- unitn = getavu()
- write(iulog,*) 'Read in '//nl_name//' namelist'
- call opnfil (nlfilename, unitn, 'F')
- call find_nlgroup_name(unitn, nl_name, status=ierr)
- if (ierr == 0) then
- read(unit=unitn, nml=clm_soilstate_inparm, iostat=ierr)
- if (ierr /= 0) then
- call endrun(msg="ERROR reading '//nl_name//' namelist"//errmsg(sourcefile, __LINE__))
- end if
- else
- call endrun(msg="ERROR finding '//nl_name//' namelist"//errmsg(sourcefile, __LINE__))
- end if
- call relavu( unitn )
-
- end if
-
- call shr_mpi_bcast(organic_frac_squared, mpicom)
-
- end subroutine ReadNL
-
- !-----------------------------------------------------------------------
- subroutine SoilStateInitTimeConst(bounds, soilstate_inst, nlfilename)
- !
- ! !USES:
- use shr_kind_mod , only : r8 => shr_kind_r8
- use shr_log_mod , only : errMsg => shr_log_errMsg
- use shr_infnan_mod , only : nan => shr_infnan_nan, assignment(=)
- use decompMod , only : bounds_type
- use abortutils , only : endrun
- use spmdMod , only : masterproc
- use ncdio_pio , only : file_desc_t, ncd_io, ncd_double, ncd_int, ncd_inqvdlen
- use ncdio_pio , only : ncd_pio_openfile, ncd_pio_closefile, ncd_inqdlen
- use clm_varpar , only : numpft, numrad
- use clm_varpar , only : nlevsoi, nlevgrnd, nlevlak, nlevsoifl, nlayer, nlayert, nlevurb, nlevsno
- use clm_varcon , only : zsoi, dzsoi, zisoi, spval
- use clm_varcon , only : secspday, pc, mu, denh2o, denice, grlnd
- use clm_varctl , only : use_cn, use_fates
- use clm_varctl , only : iulog, fsurdat, paramfile, soil_layerstruct
- use landunit_varcon , only : istdlak, istwet, istsoil, istcrop, istice_mec
- use column_varcon , only : icol_roof, icol_sunwall, icol_shadewall, icol_road_perv, icol_road_imperv
- use fileutils , only : getfil
- use organicFileMod , only : organicrd
- use FuncPedotransferMod , only : pedotransf, get_ipedof
- use RootBiophysMod , only : init_vegrootfr
- use GridcellType , only : grc
- !
- ! !ARGUMENTS:
- type(bounds_type) , intent(in) :: bounds
- type(soilstate_type) , intent(inout) :: soilstate_inst
- character(len=*) , intent(in) :: nlfilename ! Namelist filename
- !
- ! !LOCAL VARIABLES:
- integer :: p, lev, c, l, g, j ! indices
- real(r8) :: om_frac ! organic matter fraction
- real(r8) :: om_tkm = 0.25_r8 ! thermal conductivity of organic soil (Farouki, 1986) [W/m/K]
- real(r8) :: om_watsat_lake = 0.9_r8 ! porosity of organic soil
- real(r8) :: om_hksat_lake = 0.1_r8 ! saturated hydraulic conductivity of organic soil [mm/s]
- real(r8) :: om_sucsat_lake = 10.3_r8 ! saturated suction for organic matter (Letts, 2000)
- real(r8) :: om_b_lake = 2.7_r8 ! Clapp Hornberger paramater for oragnic soil (Letts, 2000) (lake)
- real(r8) :: om_watsat ! porosity of organic soil
- real(r8) :: om_hksat ! saturated hydraulic conductivity of organic soil [mm/s]
- real(r8) :: om_sucsat ! saturated suction for organic matter (mm)(Letts, 2000)
- real(r8) :: om_csol = 2.5_r8 ! heat capacity of peat soil *10^6 (J/K m3) (Farouki, 1986)
- real(r8) :: om_tkd = 0.05_r8 ! thermal conductivity of dry organic soil (Farouki, 1981)
- real(r8) :: om_b ! Clapp Hornberger paramater for oragnic soil (Letts, 2000)
- real(r8) :: zsapric = 0.5_r8 ! depth (m) that organic matter takes on characteristics of sapric peat
- real(r8) :: pcalpha = 0.5_r8 ! percolation threshold
- real(r8) :: pcbeta = 0.139_r8 ! percolation exponent
- real(r8) :: pc_lake = 0.5_r8 ! percolation threshold
- real(r8) :: perc_frac ! "percolating" fraction of organic soil
- real(r8) :: perc_norm ! normalize to 1 when 100% organic soil
- real(r8) :: uncon_hksat ! series conductivity of mineral/organic soil
- real(r8) :: uncon_frac ! fraction of "unconnected" soil
- real(r8) :: bd ! bulk density of dry soil material [kg/m^3]
- real(r8) :: tkm ! mineral conductivity
- real(r8) :: xksat ! maximum hydraulic conductivity of soil [mm/s]
- real(r8) :: clay,sand ! temporaries
- real(r8) :: organic_max ! organic matter (kg/m3) where soil is assumed to act like peat
- integer :: dimid ! dimension id
- logical :: readvar
- type(file_desc_t) :: ncid ! netcdf id
- real(r8) ,pointer :: zsoifl (:) ! Output: [real(r8) (:)] original soil midpoint
- real(r8) ,pointer :: zisoifl (:) ! Output: [real(r8) (:)] original soil interface depth
- real(r8) ,pointer :: dzsoifl (:) ! Output: [real(r8) (:)] original soil thickness
- real(r8) ,pointer :: gti (:) ! read in - fmax
- real(r8) ,pointer :: sand3d (:,:) ! read in - soil texture: percent sand (needs to be a pointer for use in ncdio)
- real(r8) ,pointer :: clay3d (:,:) ! read in - soil texture: percent clay (needs to be a pointer for use in ncdio)
- real(r8) ,pointer :: organic3d (:,:) ! read in - organic matter: kg/m3 (needs to be a pointer for use in ncdio)
- character(len=256) :: locfn ! local filename
- integer :: ipedof
- integer :: begp, endp
- integer :: begc, endc
- integer :: begg, endg
- !-----------------------------------------------------------------------
-
- begp = bounds%begp; endp= bounds%endp
- begc = bounds%begc; endc= bounds%endc
- begg = bounds%begg; endg= bounds%endg
-
- do c = begc,endc
- soilstate_inst%smpmin_col(c) = -1.e8_r8
- end do
-
- ! --------------------------------------------------------------------
- ! Read namelist
- ! --------------------------------------------------------------------
-
- call ReadNL( nlfilename )
-
- ! --------------------------------------------------------------------
- ! Initialize root fraction (computing from surface, d is depth in meter):
- ! --------------------------------------------------------------------
-
- ! Currently pervious road has same properties as soil
- do c = begc,endc
- l = col%landunit(c)
-
- if (lun%urbpoi(l) .and. col%itype(c) == icol_road_perv) then
- do lev = 1, nlevgrnd
- soilstate_inst%rootfr_road_perv_col(c,lev) = 0._r8
- enddo
- do lev = 1,nlevsoi
- soilstate_inst%rootfr_road_perv_col(c,lev) = 1.0_r8/real(nlevsoi,r8)
- end do
-! remove roots below bedrock layer
- soilstate_inst%rootfr_road_perv_col(c,1:col%nbedrock(c)) = &
- soilstate_inst%rootfr_road_perv_col(c,1:col%nbedrock(c)) &
- + sum(soilstate_inst%rootfr_road_perv_col(c,col%nbedrock(c)+1:nlevsoi)) &
- /real(col%nbedrock(c))
- soilstate_inst%rootfr_road_perv_col(c,col%nbedrock(c)+1:nlevsoi) = 0._r8
- end if
- end do
-
- do c = bounds%begc,bounds%endc
- l = col%landunit(c)
- if (lun%itype(l) == istsoil .or. lun%itype(l) == istcrop) then
- soilstate_inst%rootfr_col (c,nlevsoi+1:nlevgrnd) = 0._r8
- else
- ! Inactive CH4 columns
- ! (Also includes (lun%itype(l)==istdlak .and. allowlakeprod), which used to be
- ! in a separate branch of the conditional)
- soilstate_inst%rootfr_col (c,:) = spval
- end if
- end do
-
- ! Initialize root fraction
- ! Note that fates has its own root fraction root fraction routine and should not
- ! use the following since it depends on patch%itype - which fates should not use
-
- if (.not. use_fates) then
- call init_vegrootfr(bounds, nlevsoi, nlevgrnd, &
- soilstate_inst%rootfr_patch(begp:endp,1:nlevgrnd),'water')
- call init_vegrootfr(bounds, nlevsoi, nlevgrnd, &
- soilstate_inst%crootfr_patch(begp:endp,1:nlevgrnd),'carbon')
- end if
-
- ! --------------------------------------------------------------------
- ! dynamic memory allocation
- ! --------------------------------------------------------------------
-
- allocate(sand3d(begg:endg,nlevsoifl))
- allocate(clay3d(begg:endg,nlevsoifl))
-
- ! Determine organic_max from parameter file
-
- call getfil (paramfile, locfn, 0)
- call ncd_pio_openfile (ncid, trim(locfn), 0)
- call ncd_io(ncid=ncid, varname='organic_max', flag='read', data=organic_max, readvar=readvar)
- if ( .not. readvar ) call endrun(msg=' ERROR: organic_max not on param file'//errMsg(sourcefile, __LINE__))
- call ncd_pio_closefile(ncid)
-
- ! --------------------------------------------------------------------
- ! Read surface dataset
- ! --------------------------------------------------------------------
-
- if (masterproc) then
- write(iulog,*) 'Attempting to read soil color, sand and clay boundary data .....'
- end if
-
- call getfil (fsurdat, locfn, 0)
- call ncd_pio_openfile (ncid, locfn, 0)
-
- ! Read in organic matter dataset
-
- allocate(organic3d(begg:endg,nlevsoifl))
- call organicrd(organic3d)
-
- ! Read in sand and clay data
-
- call ncd_io(ncid=ncid, varname='PCT_SAND', flag='read', data=sand3d, dim1name=grlnd, readvar=readvar)
- if (.not. readvar) then
- call endrun(msg=' ERROR: PCT_SAND NOT on surfdata file'//errMsg(sourcefile, __LINE__))
- end if
-
- call ncd_io(ncid=ncid, varname='PCT_CLAY', flag='read', data=clay3d, dim1name=grlnd, readvar=readvar)
- if (.not. readvar) then
- call endrun(msg=' ERROR: PCT_CLAY NOT on surfdata file'//errMsg(sourcefile, __LINE__))
- end if
-
- do p = begp,endp
- g = patch%gridcell(p)
- if ( sand3d(g,1)+clay3d(g,1) == 0.0_r8 )then
- if ( any( sand3d(g,:)+clay3d(g,:) /= 0.0_r8 ) )then
- call endrun(msg='found depth points that do NOT sum to zero when surface does'//&
- errMsg(sourcefile, __LINE__))
- end if
- sand3d(g,:) = 1.0_r8
- clay3d(g,:) = 1.0_r8
- end if
- if ( any( sand3d(g,:)+clay3d(g,:) == 0.0_r8 ) )then
- call endrun(msg='after setting, found points sum to zero'//errMsg(sourcefile, __LINE__))
- end if
-
- soilstate_inst%sandfrac_patch(p) = sand3d(g,1)/100.0_r8
- soilstate_inst%clayfrac_patch(p) = clay3d(g,1)/100.0_r8
- end do
-
- ! Read fmax
-
- allocate(gti(begg:endg))
- call ncd_io(ncid=ncid, varname='FMAX', flag='read', data=gti, dim1name=grlnd, readvar=readvar)
- if (.not. readvar) then
- call endrun(msg=' ERROR: FMAX NOT on surfdata file'//errMsg(sourcefile, __LINE__))
- end if
- do c = begc, endc
- g = col%gridcell(c)
- soilstate_inst%wtfact_col(c) = gti(g)
- end do
- deallocate(gti)
-
- ! Close file
-
- call ncd_pio_closefile(ncid)
-
- ! --------------------------------------------------------------------
- ! get original soil depths to be used in interpolation of sand and clay
- ! --------------------------------------------------------------------
-
- allocate(zsoifl(1:nlevsoifl), zisoifl(0:nlevsoifl), dzsoifl(1:nlevsoifl))
- do j = 1, nlevsoifl
- zsoifl(j) = 0.025*(exp(0.5_r8*(j-0.5_r8))-1._r8) !node depths
- enddo
-
- dzsoifl(1) = 0.5_r8*(zsoifl(1)+zsoifl(2)) !thickness b/n two interfaces
- do j = 2,nlevsoifl-1
- dzsoifl(j)= 0.5_r8*(zsoifl(j+1)-zsoifl(j-1))
- enddo
- dzsoifl(nlevsoifl) = zsoifl(nlevsoifl)-zsoifl(nlevsoifl-1)
-
- zisoifl(0) = 0._r8
- do j = 1, nlevsoifl-1
- zisoifl(j) = 0.5_r8*(zsoifl(j)+zsoifl(j+1)) !interface depths
- enddo
- zisoifl(nlevsoifl) = zsoifl(nlevsoifl) + 0.5_r8*dzsoifl(nlevsoifl)
-
- ! --------------------------------------------------------------------
- ! Set soil hydraulic and thermal properties: non-lake
- ! --------------------------------------------------------------------
-
- ! urban roof, sunwall and shadewall thermal properties used to
- ! derive thermal conductivity and heat capacity are set to special
- ! value because thermal conductivity and heat capacity for urban
- ! roof, sunwall and shadewall are prescribed in SoilThermProp.F90
- ! in SoilPhysicsMod.F90
-
-
- do c = begc, endc
- g = col%gridcell(c)
- l = col%landunit(c)
-
- if (lun%itype(l)==istwet .or. lun%itype(l)==istice_mec) then
-
- do lev = 1,nlevgrnd
- soilstate_inst%bsw_col(c,lev) = spval
- soilstate_inst%watsat_col(c,lev) = spval
- soilstate_inst%watfc_col(c,lev) = spval
- soilstate_inst%hksat_col(c,lev) = spval
- soilstate_inst%sucsat_col(c,lev) = spval
- soilstate_inst%watdry_col(c,lev) = spval
- soilstate_inst%watopt_col(c,lev) = spval
- soilstate_inst%bd_col(c,lev) = spval
- if (lev <= nlevsoi) then
- soilstate_inst%cellsand_col(c,lev) = spval
- soilstate_inst%cellclay_col(c,lev) = spval
- soilstate_inst%cellorg_col(c,lev) = spval
- end if
- end do
-
- do lev = 1,nlevgrnd
- soilstate_inst%tkmg_col(c,lev) = spval
- soilstate_inst%tksatu_col(c,lev) = spval
- soilstate_inst%tkdry_col(c,lev) = spval
- soilstate_inst%csol_col(c,lev)= spval
- end do
-
- else if (lun%urbpoi(l) .and. (col%itype(c) /= icol_road_perv) .and. (col%itype(c) /= icol_road_imperv) )then
-
- ! Urban Roof, sunwall, shadewall properties set to special value
- do lev = 1,nlevgrnd
- soilstate_inst%watsat_col(c,lev) = spval
- soilstate_inst%watfc_col(c,lev) = spval
- soilstate_inst%bsw_col(c,lev) = spval
- soilstate_inst%hksat_col(c,lev) = spval
- soilstate_inst%sucsat_col(c,lev) = spval
- soilstate_inst%watdry_col(c,lev) = spval
- soilstate_inst%watopt_col(c,lev) = spval
- soilstate_inst%bd_col(c,lev) = spval
- if (lev <= nlevsoi) then
- soilstate_inst%cellsand_col(c,lev) = spval
- soilstate_inst%cellclay_col(c,lev) = spval
- soilstate_inst%cellorg_col(c,lev) = spval
- end if
- end do
-
- do lev = 1,nlevgrnd
- soilstate_inst%tkmg_col(c,lev) = spval
- soilstate_inst%tksatu_col(c,lev) = spval
- soilstate_inst%tkdry_col(c,lev) = spval
- soilstate_inst%csol_col(c,lev) = spval
- end do
-
- else
-
- do lev = 1,nlevgrnd
- ! DML - this if statement could probably be removed and just the
- ! top part used for all soil layer structures
- if ( soil_layerstruct /= '10SL_3.5m' )then ! apply soil texture from 10 layer input dataset
- if (lev .eq. 1) then
- clay = clay3d(g,1)
- sand = sand3d(g,1)
- om_frac = organic3d(g,1)/organic_max
- else if (lev <= nlevsoi) then
- do j = 1,nlevsoifl-1
- if (zisoi(lev) >= zisoifl(j) .AND. zisoi(lev) < zisoifl(j+1)) then
- clay = clay3d(g,j+1)
- sand = sand3d(g,j+1)
- om_frac = organic3d(g,j+1)/organic_max
- endif
- end do
- else
- clay = clay3d(g,nlevsoifl)
- sand = sand3d(g,nlevsoifl)
- om_frac = 0._r8
- endif
- else
- if (lev <= nlevsoi) then ! duplicate clay and sand values from 10th soil layer
- clay = clay3d(g,lev)
- sand = sand3d(g,lev)
- if ( organic_frac_squared )then
- om_frac = (organic3d(g,lev)/organic_max)**2._r8
- else
- om_frac = organic3d(g,lev)/organic_max
- end if
- else
- clay = clay3d(g,nlevsoi)
- sand = sand3d(g,nlevsoi)
- om_frac = 0._r8
- endif
- end if
-
- if (lun%itype(l) == istdlak) then
-
- if (lev <= nlevsoi) then
- soilstate_inst%cellsand_col(c,lev) = sand
- soilstate_inst%cellclay_col(c,lev) = clay
- soilstate_inst%cellorg_col(c,lev) = om_frac*organic_max
- end if
-
- else if (lun%itype(l) /= istdlak) then ! soil columns of both urban and non-urban types
-
- if (lun%urbpoi(l)) then
- om_frac = 0._r8 ! No organic matter for urban
- end if
-
- if (lev <= nlevsoi) then
- soilstate_inst%cellsand_col(c,lev) = sand
- soilstate_inst%cellclay_col(c,lev) = clay
- soilstate_inst%cellorg_col(c,lev) = om_frac*organic_max
- end if
-
- ! Note that the following properties are overwritten for urban impervious road
- ! layers that are not soil in SoilThermProp.F90 within SoilTemperatureMod.F90
-
- !determine the type of pedotransfer function to be used based on soil order
- !I will use the following implementation to further explore the ET problem, now
- !I set soil order to 0 for all soils. Jinyun Tang, Mar 20, 2014
-
- ipedof=get_ipedof(0)
- call pedotransf(ipedof, sand, clay, &
- soilstate_inst%watsat_col(c,lev), soilstate_inst%bsw_col(c,lev), soilstate_inst%sucsat_col(c,lev), xksat)
-
- om_watsat = max(0.93_r8 - 0.1_r8 *(zsoi(lev)/zsapric), 0.83_r8)
- om_b = min(2.7_r8 + 9.3_r8 *(zsoi(lev)/zsapric), 12.0_r8)
- om_sucsat = min(10.3_r8 - 0.2_r8 *(zsoi(lev)/zsapric), 10.1_r8)
- om_hksat = max(0.28_r8 - 0.2799_r8*(zsoi(lev)/zsapric), xksat)
-
- soilstate_inst%bd_col(c,lev) = (1._r8 - soilstate_inst%watsat_col(c,lev))*2.7e3_r8
- soilstate_inst%watsat_col(c,lev) = (1._r8 - om_frac) * soilstate_inst%watsat_col(c,lev) + om_watsat*om_frac
- tkm = (1._r8-om_frac) * (8.80_r8*sand+2.92_r8*clay)/(sand+clay)+om_tkm*om_frac ! W/(m K)
- soilstate_inst%bsw_col(c,lev) = (1._r8-om_frac) * (2.91_r8 + 0.159_r8*clay) + om_frac*om_b
- soilstate_inst%sucsat_col(c,lev) = (1._r8-om_frac) * soilstate_inst%sucsat_col(c,lev) + om_sucsat*om_frac
- soilstate_inst%hksat_min_col(c,lev) = xksat
-
- ! perc_frac is zero unless perf_frac greater than percolation threshold
- if (om_frac > pcalpha) then
- perc_norm=(1._r8 - pcalpha)**(-pcbeta)
- perc_frac=perc_norm*(om_frac - pcalpha)**pcbeta
- else
- perc_frac=0._r8
- endif
-
- ! uncon_frac is fraction of mineral soil plus fraction of "nonpercolating" organic soil
- uncon_frac=(1._r8-om_frac)+(1._r8-perc_frac)*om_frac
-
- ! uncon_hksat is series addition of mineral/organic conductivites
- if (om_frac < 1._r8) then
- uncon_hksat=uncon_frac/((1._r8-om_frac)/xksat &
- +((1._r8-perc_frac)*om_frac)/om_hksat)
- else
- uncon_hksat = 0._r8
- end if
- soilstate_inst%hksat_col(c,lev) = uncon_frac*uncon_hksat + (perc_frac*om_frac)*om_hksat
-
- soilstate_inst%tkmg_col(c,lev) = tkm ** (1._r8- soilstate_inst%watsat_col(c,lev))
-
- soilstate_inst%tksatu_col(c,lev) = soilstate_inst%tkmg_col(c,lev)*0.57_r8**soilstate_inst%watsat_col(c,lev)
-
- soilstate_inst%tkdry_col(c,lev) = ((0.135_r8*soilstate_inst%bd_col(c,lev) + 64.7_r8) / &
- (2.7e3_r8 - 0.947_r8*soilstate_inst%bd_col(c,lev)))*(1._r8-om_frac) + om_tkd*om_frac
-
- soilstate_inst%csol_col(c,lev) = ((1._r8-om_frac)*(2.128_r8*sand+2.385_r8*clay) / (sand+clay) + &
- om_csol*om_frac)*1.e6_r8 ! J/(m3 K)
-
- soilstate_inst%watdry_col(c,lev) = soilstate_inst%watsat_col(c,lev) * &
- (316230._r8/soilstate_inst%sucsat_col(c,lev)) ** (-1._r8/soilstate_inst%bsw_col(c,lev))
- soilstate_inst%watopt_col(c,lev) = soilstate_inst%watsat_col(c,lev) * &
- (158490._r8/soilstate_inst%sucsat_col(c,lev)) ** (-1._r8/soilstate_inst%bsw_col(c,lev))
-
- !! added by K.Sakaguchi for beta from Lee and Pielke, 1992
- ! water content at field capacity, defined as hk = 0.1 mm/day
- ! used eqn (7.70) in CLM3 technote with k = 0.1 (mm/day) / secspday (day/sec)
- soilstate_inst%watfc_col(c,lev) = soilstate_inst%watsat_col(c,lev) * &
- (0.1_r8 / (soilstate_inst%hksat_col(c,lev)*secspday))**(1._r8/(2._r8*soilstate_inst%bsw_col(c,lev)+3._r8))
- end if
- end do
-
- ! Urban pervious and impervious road
- if (col%itype(c) == icol_road_imperv) then
- ! Impervious road layers -- same as above except set watdry and watopt as missing
- do lev = 1,nlevgrnd
- soilstate_inst%watdry_col(c,lev) = spval
- soilstate_inst%watopt_col(c,lev) = spval
- end do
- else if (col%itype(c) == icol_road_perv) then
- ! pervious road layers - set in UrbanInitTimeConst
- end if
-
- end if
- end do
-
- ! --------------------------------------------------------------------
- ! Set soil hydraulic and thermal properties: lake
- ! --------------------------------------------------------------------
-
- do c = begc, endc
- g = col%gridcell(c)
- l = col%landunit(c)
-
- if (lun%itype(l)==istdlak) then
-
- do lev = 1,nlevgrnd
- if ( lev <= nlevsoi )then
- clay = soilstate_inst%cellclay_col(c,lev)
- sand = soilstate_inst%cellsand_col(c,lev)
- if ( organic_frac_squared )then
- om_frac = (soilstate_inst%cellorg_col(c,lev)/organic_max)**2._r8
- else
- om_frac = soilstate_inst%cellorg_col(c,lev)/organic_max
- end if
- else
- clay = soilstate_inst%cellclay_col(c,nlevsoi)
- sand = soilstate_inst%cellsand_col(c,nlevsoi)
- om_frac = 0.0_r8
- end if
-
- soilstate_inst%watsat_col(c,lev) = 0.489_r8 - 0.00126_r8*sand
-
- soilstate_inst%bsw_col(c,lev) = 2.91 + 0.159*clay
-
- soilstate_inst%sucsat_col(c,lev) = 10._r8 * ( 10._r8**(1.88_r8-0.0131_r8*sand) )
-
- bd = (1._r8-soilstate_inst%watsat_col(c,lev))*2.7e3_r8
-
- soilstate_inst%watsat_col(c,lev) = (1._r8 - om_frac)*soilstate_inst%watsat_col(c,lev) + om_watsat_lake * om_frac
-
- tkm = (1._r8-om_frac)*(8.80_r8*sand+2.92_r8*clay)/(sand+clay) + om_tkm * om_frac ! W/(m K)
-
- soilstate_inst%bsw_col(c,lev) = (1._r8-om_frac)*(2.91_r8 + 0.159_r8*clay) + om_frac * om_b_lake
-
- soilstate_inst%sucsat_col(c,lev) = (1._r8-om_frac)*soilstate_inst%sucsat_col(c,lev) + om_sucsat_lake * om_frac
-
- xksat = 0.0070556 *( 10.**(-0.884+0.0153*sand) ) ! mm/s
-
- ! perc_frac is zero unless perf_frac greater than percolation threshold
- if (om_frac > pc_lake) then
- perc_norm = (1._r8 - pc_lake)**(-pcbeta)
- perc_frac = perc_norm*(om_frac - pc_lake)**pcbeta
- else
- perc_frac = 0._r8
- endif
-
- ! uncon_frac is fraction of mineral soil plus fraction of "nonpercolating" organic soil
- uncon_frac = (1._r8-om_frac) + (1._r8-perc_frac)*om_frac
-
- ! uncon_hksat is series addition of mineral/organic conductivites
- if (om_frac < 1._r8) then
- xksat = 0.0070556 *( 10.**(-0.884+0.0153*sand) ) ! mm/s
- uncon_hksat = uncon_frac/((1._r8-om_frac)/xksat + ((1._r8-perc_frac)*om_frac)/om_hksat_lake)
- else
- uncon_hksat = 0._r8
- end if
-
- soilstate_inst%hksat_col(c,lev) = uncon_frac*uncon_hksat + (perc_frac*om_frac)*om_hksat_lake
- soilstate_inst%tkmg_col(c,lev) = tkm ** (1._r8- soilstate_inst%watsat_col(c,lev))
- soilstate_inst%tksatu_col(c,lev) = soilstate_inst%tkmg_col(c,lev)*0.57_r8**soilstate_inst%watsat_col(c,lev)
- soilstate_inst%tkdry_col(c,lev) = ((0.135_r8*bd + 64.7_r8) / (2.7e3_r8 - 0.947_r8*bd))*(1._r8-om_frac) + &
- om_tkd * om_frac
- soilstate_inst%csol_col(c,lev) = ((1._r8-om_frac)*(2.128_r8*sand+2.385_r8*clay) / (sand+clay) + &
- om_csol * om_frac)*1.e6_r8 ! J/(m3 K)
- soilstate_inst%watdry_col(c,lev) = soilstate_inst%watsat_col(c,lev) &
- * (316230._r8/soilstate_inst%sucsat_col(c,lev)) ** (-1._r8/soilstate_inst%bsw_col(c,lev))
- soilstate_inst%watopt_col(c,lev) = soilstate_inst%watsat_col(c,lev) &
- * (158490._r8/soilstate_inst%sucsat_col(c,lev)) ** (-1._r8/soilstate_inst%bsw_col(c,lev))
-
- !! added by K.Sakaguchi for beta from Lee and Pielke, 1992
- ! water content at field capacity, defined as hk = 0.1 mm/day
- ! used eqn (7.70) in CLM3 technote with k = 0.1 (mm/day) / (# seconds/day)
- soilstate_inst%watfc_col(c,lev) = soilstate_inst%watsat_col(c,lev) * (0.1_r8 / &
- (soilstate_inst%hksat_col(c,lev)*secspday))**(1._r8/(2._r8*soilstate_inst%bsw_col(c,lev)+3._r8))
- end do
- endif
-
- end do
-
- ! --------------------------------------------------------------------
- ! Initialize threshold soil moisture and mass fracion of clay limited to 0.20
- ! --------------------------------------------------------------------
-
- do c = begc,endc
- g = col%gridcell(c)
-
- soilstate_inst%gwc_thr_col(c) = 0.17_r8 + 0.14_r8 * clay3d(g,1) * 0.01_r8
- soilstate_inst%mss_frc_cly_vld_col(c) = min(clay3d(g,1) * 0.01_r8, 0.20_r8)
- end do
-
- ! --------------------------------------------------------------------
- ! Deallocate memory
- ! --------------------------------------------------------------------
-
- deallocate(sand3d, clay3d, organic3d)
- deallocate(zisoifl, zsoifl, dzsoifl)
-
- end subroutine SoilStateInitTimeConst
-
-end module SoilStateInitTimeConstMod
diff --git a/src/biogeophys/SoilStateType.F90 b/src/biogeophys/SoilStateType.F90
deleted file mode 100644
index 763165a3..00000000
--- a/src/biogeophys/SoilStateType.F90
+++ /dev/null
@@ -1,409 +0,0 @@
-module SoilStateType
-
- !------------------------------------------------------------------------------
- ! !USES:
- use shr_kind_mod , only : r8 => shr_kind_r8
- use shr_log_mod , only : errMsg => shr_log_errMsg
- use shr_infnan_mod , only : nan => shr_infnan_nan, assignment(=)
- use decompMod , only : bounds_type
- use abortutils , only : endrun
- use clm_varpar , only : nlevsoi, nlevgrnd, nlevlak, nlayer, nlevsno
- use clm_varcon , only : spval
- use clm_varctl , only : use_hydrstress, use_cn, use_dynroot
- use clm_varctl , only : iulog, hist_wrtch4diag
- use LandunitType , only : lun
- use ColumnType , only : col
- use PatchType , only : patch
- !
- implicit none
- save
- private
- !
- ! !PUBLIC TYPES:
- type, public :: soilstate_type
-
- ! sand/ clay/ organic matter
- real(r8), pointer :: sandfrac_patch (:) ! patch sand fraction
- real(r8), pointer :: clayfrac_patch (:) ! patch clay fraction
- real(r8), pointer :: mss_frc_cly_vld_col (:) ! col mass fraction clay limited to 0.20
- real(r8), pointer :: cellorg_col (:,:) ! col organic matter for gridcell containing column (1:nlevsoi)
- real(r8), pointer :: cellsand_col (:,:) ! sand value for gridcell containing column (1:nlevsoi)
- real(r8), pointer :: cellclay_col (:,:) ! clay value for gridcell containing column (1:nlevsoi)
- real(r8), pointer :: bd_col (:,:) ! col bulk density of dry soil material [kg/m^3] (CN)
-
- ! hydraulic properties
- real(r8), pointer :: hksat_col (:,:) ! col hydraulic conductivity at saturation (mm H2O /s)
- real(r8), pointer :: hksat_min_col (:,:) ! col mineral hydraulic conductivity at saturation (hksat) (mm/s)
- real(r8), pointer :: hk_l_col (:,:) ! col hydraulic conductivity (mm/s)
- real(r8), pointer :: smp_l_col (:,:) ! col soil matric potential (mm)
- real(r8), pointer :: smpmin_col (:) ! col restriction for min of soil potential (mm)
- real(r8), pointer :: bsw_col (:,:) ! col Clapp and Hornberger "b" (nlevgrnd)
- real(r8), pointer :: watsat_col (:,:) ! col volumetric soil water at saturation (porosity)
- real(r8), pointer :: watdry_col (:,:) ! col btran parameter for btran = 0
- real(r8), pointer :: watopt_col (:,:) ! col btran parameter for btran = 1
- real(r8), pointer :: watfc_col (:,:) ! col volumetric soil water at field capacity (nlevsoi)
- real(r8), pointer :: sucsat_col (:,:) ! col minimum soil suction (mm) (nlevgrnd)
- real(r8), pointer :: dsl_col (:) ! col dry surface layer thickness (mm)
- real(r8), pointer :: soilresis_col (:) ! col soil evaporative resistance S&L14 (s/m)
- real(r8), pointer :: soilbeta_col (:) ! col factor that reduces ground evaporation L&P1992(-)
- real(r8), pointer :: soilalpha_col (:) ! col factor that reduces ground saturated specific humidity (-)
- real(r8), pointer :: soilalpha_u_col (:) ! col urban factor that reduces ground saturated specific humidity (-)
- real(r8), pointer :: soilpsi_col (:,:) ! col soil water potential in each soil layer (MPa) (CN)
- real(r8), pointer :: wtfact_col (:) ! col maximum saturated fraction for a gridcell
- real(r8), pointer :: porosity_col (:,:) ! col soil porisity (1-bulk_density/soil_density) (VIC)
- real(r8), pointer :: eff_porosity_col (:,:) ! col effective porosity = porosity - vol_ice (nlevgrnd)
- real(r8), pointer :: gwc_thr_col (:) ! col threshold soil moisture based on clay content
-!scs: vangenuchten
- real(r8), pointer :: msw_col (:,:) ! col vanGenuchtenClapp "m"
- real(r8), pointer :: nsw_col (:,:) ! col vanGenuchtenClapp "n"
- real(r8), pointer :: alphasw_col (:,:) ! col vanGenuchtenClapp "nalpha"
- real(r8), pointer :: watres_col (:,:) ! residual soil water content
- ! thermal conductivity / heat capacity
- real(r8), pointer :: thk_col (:,:) ! col thermal conductivity of each layer [W/m-K]
- real(r8), pointer :: tkmg_col (:,:) ! col thermal conductivity, soil minerals [W/m-K] (new) (nlevgrnd)
- real(r8), pointer :: tkdry_col (:,:) ! col thermal conductivity, dry soil (W/m/Kelvin) (nlevgrnd)
- real(r8), pointer :: tksatu_col (:,:) ! col thermal conductivity, saturated soil [W/m-K] (new) (nlevgrnd)
- real(r8), pointer :: csol_col (:,:) ! col heat capacity, soil solids (J/m**3/Kelvin) (nlevgrnd)
-
- ! roots
- real(r8), pointer :: rootr_patch (:,:) ! patch effective fraction of roots in each soil layer (nlevgrnd)
- real(r8), pointer :: rootr_col (:,:) ! col effective fraction of roots in each soil layer (nlevgrnd)
- real(r8), pointer :: rootfr_col (:,:) ! col fraction of roots in each soil layer (nlevgrnd)
- real(r8), pointer :: rootfr_patch (:,:) ! patch fraction of roots for water in each soil layer (nlevgrnd)
- real(r8), pointer :: crootfr_patch (:,:) ! patch fraction of roots for carbon in each soil layer (nlevgrnd)
- real(r8), pointer :: root_depth_patch (:) ! root depth
- real(r8), pointer :: rootr_road_perv_col (:,:) ! col effective fraction of roots in each soil layer of urban pervious road
- real(r8), pointer :: rootfr_road_perv_col (:,:) ! col effective fraction of roots in each soil layer of urban pervious road
- real(r8), pointer :: k_soil_root_patch (:,:) ! patch soil-root interface conductance [mm/s]
- real(r8), pointer :: root_conductance_patch(:,:) ! patch root conductance [mm/s]
- real(r8), pointer :: soil_conductance_patch(:,:) ! patch soil conductance [mm/s]
-
- contains
-
- procedure, public :: Init
- procedure, public :: Restart
- procedure, private :: InitAllocate
- procedure, private :: InitHistory
- procedure, private :: InitCold
-
- end type soilstate_type
- !------------------------------------------------------------------------
-
-contains
-
- !------------------------------------------------------------------------
- subroutine Init(this, bounds)
-
- class(soilstate_type) :: this
- type(bounds_type), intent(in) :: bounds
-
- call this%InitAllocate(bounds)
- call this%InitHistory(bounds)
- call this%InitCold(bounds)
-
- end subroutine Init
-
- !------------------------------------------------------------------------
- subroutine InitAllocate(this, bounds)
- !
- ! !DESCRIPTION:
- ! Initialize module data structure
- !
- ! !ARGUMENTS:
- class(soilstate_type) :: this
- type(bounds_type), intent(in) :: bounds
- !
- ! !LOCAL VARIABLES:
- integer :: begp, endp
- integer :: begc, endc
- integer :: begg, endg
- !------------------------------------------------------------------------
-
- begp = bounds%begp; endp= bounds%endp
- begc = bounds%begc; endc= bounds%endc
- begg = bounds%begg; endg= bounds%endg
-
- allocate(this%mss_frc_cly_vld_col (begc:endc)) ; this%mss_frc_cly_vld_col (:) = nan
- allocate(this%sandfrac_patch (begp:endp)) ; this%sandfrac_patch (:) = nan
- allocate(this%clayfrac_patch (begp:endp)) ; this%clayfrac_patch (:) = nan
- allocate(this%cellorg_col (begc:endc,nlevsoi)) ; this%cellorg_col (:,:) = nan
- allocate(this%cellsand_col (begc:endc,nlevsoi)) ; this%cellsand_col (:,:) = nan
- allocate(this%cellclay_col (begc:endc,nlevsoi)) ; this%cellclay_col (:,:) = nan
- allocate(this%bd_col (begc:endc,nlevgrnd)) ; this%bd_col (:,:) = nan
-
- allocate(this%hksat_col (begc:endc,nlevgrnd)) ; this%hksat_col (:,:) = spval
- allocate(this%hksat_min_col (begc:endc,nlevgrnd)) ; this%hksat_min_col (:,:) = spval
- allocate(this%hk_l_col (begc:endc,nlevgrnd)) ; this%hk_l_col (:,:) = nan
- allocate(this%smp_l_col (begc:endc,nlevgrnd)) ; this%smp_l_col (:,:) = nan
- allocate(this%smpmin_col (begc:endc)) ; this%smpmin_col (:) = nan
-
- allocate(this%bsw_col (begc:endc,nlevgrnd)) ; this%bsw_col (:,:) = nan
- allocate(this%watsat_col (begc:endc,nlevgrnd)) ; this%watsat_col (:,:) = nan
- allocate(this%watdry_col (begc:endc,nlevgrnd)) ; this%watdry_col (:,:) = spval
- allocate(this%watopt_col (begc:endc,nlevgrnd)) ; this%watopt_col (:,:) = spval
- allocate(this%watfc_col (begc:endc,nlevgrnd)) ; this%watfc_col (:,:) = nan
- allocate(this%sucsat_col (begc:endc,nlevgrnd)) ; this%sucsat_col (:,:) = spval
- allocate(this%dsl_col (begc:endc)) ; this%dsl_col (:) = spval!nan
- allocate(this%soilresis_col (begc:endc)) ; this%soilresis_col (:) = spval!nan
- allocate(this%soilbeta_col (begc:endc)) ; this%soilbeta_col (:) = nan
- allocate(this%soilalpha_col (begc:endc)) ; this%soilalpha_col (:) = nan
- allocate(this%soilalpha_u_col (begc:endc)) ; this%soilalpha_u_col (:) = nan
- allocate(this%soilpsi_col (begc:endc,nlevgrnd)) ; this%soilpsi_col (:,:) = nan
- allocate(this%wtfact_col (begc:endc)) ; this%wtfact_col (:) = nan
- allocate(this%porosity_col (begc:endc,nlayer)) ; this%porosity_col (:,:) = spval
- allocate(this%eff_porosity_col (begc:endc,nlevgrnd)) ; this%eff_porosity_col (:,:) = spval
- allocate(this%gwc_thr_col (begc:endc)) ; this%gwc_thr_col (:) = nan
-
- allocate(this%thk_col (begc:endc,-nlevsno+1:nlevgrnd)) ; this%thk_col (:,:) = nan
- allocate(this%tkmg_col (begc:endc,nlevgrnd)) ; this%tkmg_col (:,:) = nan
- allocate(this%tkdry_col (begc:endc,nlevgrnd)) ; this%tkdry_col (:,:) = nan
- allocate(this%tksatu_col (begc:endc,nlevgrnd)) ; this%tksatu_col (:,:) = nan
- allocate(this%csol_col (begc:endc,nlevgrnd)) ; this%csol_col (:,:) = nan
-
- allocate(this%rootr_patch (begp:endp,1:nlevgrnd)) ; this%rootr_patch (:,:) = nan
- allocate(this%root_depth_patch (begp:endp)) ; this%root_depth_patch (:) = nan
- allocate(this%rootr_col (begc:endc,nlevgrnd)) ; this%rootr_col (:,:) = nan
- allocate(this%rootr_road_perv_col (begc:endc,1:nlevgrnd)) ; this%rootr_road_perv_col (:,:) = nan
- allocate(this%rootfr_patch (begp:endp,1:nlevgrnd)) ; this%rootfr_patch (:,:) = nan
- allocate(this%crootfr_patch (begp:endp,1:nlevgrnd)) ; this%crootfr_patch (:,:) = nan
- allocate(this%rootfr_col (begc:endc,1:nlevgrnd)) ; this%rootfr_col (:,:) = nan
- allocate(this%rootfr_road_perv_col (begc:endc,1:nlevgrnd)) ; this%rootfr_road_perv_col (:,:) = nan
- allocate(this%k_soil_root_patch (begp:endp,1:nlevsoi)) ; this%k_soil_root_patch (:,:) = nan
- allocate(this%root_conductance_patch(begp:endp,1:nlevsoi)) ; this%root_conductance_patch (:,:) = nan
- allocate(this%soil_conductance_patch(begp:endp,1:nlevsoi)) ; this%soil_conductance_patch (:,:) = nan
- allocate(this%msw_col (begc:endc,1:nlevgrnd)) ; this%msw_col (:,:) = nan
- allocate(this%nsw_col (begc:endc,1:nlevgrnd)) ; this%nsw_col (:,:) = nan
- allocate(this%alphasw_col (begc:endc,1:nlevgrnd)) ; this%alphasw_col (:,:) = nan
- allocate(this%watres_col (begc:endc,1:nlevgrnd)) ; this%watres_col (:,:) = nan
- end subroutine InitAllocate
-
- !-----------------------------------------------------------------------
- subroutine InitHistory(this, bounds)
- !
- ! History fields initialization
- !
- ! !USES:
- use histFileMod , only: hist_addfld1d, hist_addfld2d, no_snow_normal
- !
- ! !ARGUMENTS:
- class(soilstate_type) :: this
- type(bounds_type), intent(in) :: bounds
- !
- ! !LOCAL VARIABLES:
- integer :: begc, endc
- integer :: begp, endp
- character(10) :: active
- real(r8), pointer :: data2dptr(:,:), data1dptr(:) ! temp. pointers for slicing larger arrays
- !---------------------------------------------------------------------
-
- begp = bounds%begp; endp= bounds%endp
- begc = bounds%begc; endc= bounds%endc
-
-
- active = "inactive"
-
- call hist_addfld2d (fname='SMP', units='mm', type2d='levgrnd', &
- avgflag='A', long_name='soil matric potential (vegetated landunits only)', &
- ptr_col=this%smp_l_col, set_spec=spval, l2g_scale_type='veg', default='inactive')
-
- this%root_conductance_patch(begp:endp,:) = spval
- call hist_addfld2d (fname='KROOT', units='1/s', type2d='levsoi', &
- avgflag='A', long_name='root conductance each soil layer', &
- ptr_patch=this%root_conductance_patch, default='inactive')
-
- this%soil_conductance_patch(begp:endp,:) = spval
- call hist_addfld2d (fname='KSOIL', units='1/s', type2d='levsoi', &
- avgflag='A', long_name='soil conductance in each soil layer', &
- ptr_patch=this%soil_conductance_patch, default='inactive')
-
- if (use_cn) then
- this%bsw_col(begc:endc,:) = spval
- call hist_addfld2d (fname='bsw', units='unitless', type2d='levgrnd', &
- avgflag='A', long_name='clap and hornberger B', &
- ptr_col=this%bsw_col, default='inactive')
- end if
-
- if (use_dynroot) then
- this%rootfr_patch(begp:endp,:) = spval
- call hist_addfld2d (fname='ROOTFR', units='proportion', type2d='levgrnd', &
- avgflag='A', long_name='fraction of roots in each soil layer', &
- ptr_patch=this%rootfr_patch, default='inactive')
- end if
-
- if ( use_dynroot ) then
- this%root_depth_patch(begp:endp) = spval
- call hist_addfld1d (fname='ROOT_DEPTH', units="m", &
- avgflag='A', long_name='rooting depth', &
- ptr_patch=this%root_depth_patch, default='inactive' )
- end if
-
- if (use_cn) then
- this%rootr_patch(begp:endp,:) = spval
- call hist_addfld2d (fname='ROOTR', units='proportion', type2d='levgrnd', &
- avgflag='A', long_name='effective fraction of roots in each soil layer', &
- ptr_patch=this%rootr_patch, default='inactive')
- end if
-
- if (use_cn) then
- this%rootr_col(begc:endc,:) = spval
- call hist_addfld2d (fname='ROOTR_COLUMN', units='proportion', type2d='levgrnd', &
- avgflag='A', long_name='effective fraction of roots in each soil layer', &
- ptr_col=this%rootr_col, default='inactive')
-
- end if
-
- if (use_cn) then
- this%soilpsi_col(begc:endc,:) = spval
- call hist_addfld2d (fname='SOILPSI', units='MPa', type2d='levgrnd', &
- avgflag='A', long_name='soil water potential in each soil layer', &
- ptr_col=this%soilpsi_col, default='inactive')
- end if
-
- this%thk_col(begc:endc,-nlevsno+1:0) = spval
- data2dptr => this%thk_col(:,-nlevsno+1:0)
- call hist_addfld2d (fname='SNO_TK', units='W/m-K', type2d='levsno', &
- avgflag='A', long_name='Thermal conductivity', &
- ptr_col=data2dptr, no_snow_behavior=no_snow_normal, default='inactive')
-
- call hist_addfld2d (fname='SNO_TK_ICE', units='W/m-K', type2d='levsno', &
- avgflag='A', long_name='Thermal conductivity (ice landunits only)', &
- ptr_col=data2dptr, no_snow_behavior=no_snow_normal, &
- l2g_scale_type='ice', default='inactive')
-
- this%hk_l_col(begc:endc,:) = spval
- call hist_addfld2d (fname='HK', units='mm/s', type2d='levgrnd', &
- avgflag='A', long_name='hydraulic conductivity (vegetated landunits only)', &
- ptr_col=this%hk_l_col, set_spec=spval, l2g_scale_type='veg', default='inactive')
-
- this%soilalpha_col(begc:endc) = spval
- call hist_addfld1d (fname='SoilAlpha', units='unitless', &
- avgflag='A', long_name='factor limiting ground evap', &
- ptr_col=this%soilalpha_col, set_urb=spval, default='inactive' )
-
- this%soilalpha_u_col(begc:endc) = spval
- call hist_addfld1d (fname='SoilAlpha_U', units='unitless', &
- avgflag='A', long_name='urban factor limiting ground evap', &
- ptr_col=this%soilalpha_u_col, set_nourb=spval, default='inactive')
-
- if (use_cn) then
- this%watsat_col(begc:endc,:) = spval
- call hist_addfld2d (fname='watsat', units='m^3/m^3', type2d='levgrnd', &
- avgflag='A', long_name='water saturated', &
- ptr_col=this%watsat_col, default='inactive')
- end if
-
- if (use_cn) then
- this%eff_porosity_col(begc:endc,:) = spval
- call hist_addfld2d (fname='EFF_POROSITY', units='proportion', type2d='levgrnd', &
- avgflag='A', long_name='effective porosity = porosity - vol_ice', &
- ptr_col=this%eff_porosity_col, default='inactive')
- end if
-
- if (use_cn) then
- this%watfc_col(begc:endc,:) = spval
- call hist_addfld2d (fname='watfc', units='m^3/m^3', type2d='levgrnd', &
- avgflag='A', long_name='water field capacity', &
- ptr_col=this%watfc_col, default='inactive')
- end if
-
- this%soilresis_col(begc:endc) = spval
- call hist_addfld1d (fname='SOILRESIS', units='s/m', &
- avgflag='A', long_name='soil resistance to evaporation', &
- ptr_col=this%soilresis_col, default='inactive')
-
- this%dsl_col(begc:endc) = spval
- call hist_addfld1d (fname='DSL', units='mm', &
- avgflag='A', long_name='dry surface layer thickness', &
- ptr_col=this%dsl_col, default='inactive')
-
- end subroutine InitHistory
-
- !-----------------------------------------------------------------------
- subroutine InitCold(this, bounds)
- !
- ! Initialize module soil state variables to reasonable values
- !
- ! !USES:
- use clm_varpar , only : nlevgrnd
- !
- ! !ARGUMENTS:
- class(soilstate_type) :: this
- type(bounds_type), intent(in) :: bounds
- !
- ! !LOCAL VARIABLES:
- !-----------------------------------------------------------------------
-
- this%smp_l_col(bounds%begc:bounds%endc,1:nlevgrnd) = -1000._r8
- this%hk_l_col(bounds%begc:bounds%endc,1:nlevgrnd) = 0._r8
-
- end subroutine InitCold
-
- !------------------------------------------------------------------------
- subroutine Restart(this, bounds, ncid, flag)
- !
- ! !DESCRIPTION:
- ! Read/Write module information to/from restart file.
- !
- ! !USES:
- use ncdio_pio , only : file_desc_t, ncd_io, ncd_double
- use restUtilMod
- use spmdMod , only : masterproc
- use RootBiophysMod , only : init_vegrootfr
- !
- ! !ARGUMENTS:
- class(soilstate_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 :: c
- logical :: readvar
- logical :: readrootfr = .false.
- !------------------------------------------------------------------------
-
- call restartvar(ncid=ncid, flag=flag, varname='DSL', xtype=ncd_double, &
- dim1name='column', long_name='dsl thickness', units='mm', &
- interpinic_flag='interp', readvar=readvar, data=this%dsl_col)
-
- call restartvar(ncid=ncid, flag=flag, varname='SOILRESIS', xtype=ncd_double, &
- dim1name='column', long_name='soil resistance', units='s/m', &
- interpinic_flag='interp', readvar=readvar, data=this%soilresis_col)
-
- call restartvar(ncid=ncid, flag=flag, varname='SMP', xtype=ncd_double, &
- dim1name='column', dim2name='levgrnd', switchdim=.true., &
- long_name='soil matric potential', units='mm', &
- interpinic_flag='interp', readvar=readvar, data=this%smp_l_col)
-
- call restartvar(ncid=ncid, flag=flag, varname='HK', xtype=ncd_double, &
- dim1name='column', dim2name='levgrnd', switchdim=.true., &
- long_name='hydraulic conductivity', units='mm/s', &
- interpinic_flag='interp', readvar=readvar, data=this%hk_l_col)
-
- if( use_dynroot ) then
- call restartvar(ncid=ncid, flag=flag, varname='root_depth', xtype=ncd_double, &
- dim1name='pft', &
- long_name='root depth', units='m', &
- interpinic_flag='interp', readvar=readvar, data=this%root_depth_patch)
-
- call restartvar(ncid=ncid, flag=flag, varname='rootfr', xtype=ncd_double, &
- dim1name='pft', dim2name='levgrnd', switchdim=.true., &
- long_name='root fraction', units='', &
- interpinic_flag='interp', readvar=readrootfr, data=this%rootfr_patch)
- else
- readrootfr = .false.
- end if
- if (flag=='read' .and. .not. readrootfr ) then
- if (masterproc) then
- write(iulog,*) "can't find rootfr in restart (or initial) file..."
- write(iulog,*) "Initialize rootfr to default"
- end if
- call init_vegrootfr(bounds, nlevsoi, nlevgrnd, &
- this%rootfr_patch(bounds%begp:bounds%endp,1:nlevgrnd), 'water')
- call init_vegrootfr(bounds, nlevsoi, nlevgrnd, &
- this%crootfr_patch(bounds%begp:bounds%endp,1:nlevgrnd), 'carbon')
- end if
-
- end subroutine Restart
-
-end module SoilStateType
diff --git a/src/biogeophys/SoilWaterMovementMod.F90 b/src/biogeophys/SoilWaterMovementMod.F90
deleted file mode 100644
index d458768e..00000000
--- a/src/biogeophys/SoilWaterMovementMod.F90
+++ /dev/null
@@ -1,194 +0,0 @@
-module SoilWaterMovementMod
-
-#include "shr_assert.h"
-
- !-----------------------------------------------------------------------
- ! DESCRIPTION
- ! module contains different subroutines to couple soil and root water interactions
- !
- ! created by Jinyun Tang, Mar 12, 2014
- use shr_log_mod , only : errMsg => shr_log_errMsg
- use shr_kind_mod , only : r8 => shr_kind_r8
- use shr_sys_mod , only : shr_sys_flush
-
- !
- implicit none
- private
- !
- ! !PUBLIC MEMBER FUNCTIONS:
- public :: init_soilwater_movement
- !
- ! !PUBLIC DATA MEMBERS:
-
- ! !PRIVATE DATA MEMBERS:
-
- ! Solution method
- integer, parameter :: zengdecker_2009 = 0
- integer, parameter :: moisture_form = 1
- integer, parameter :: mixed_form = 2
- integer, parameter :: head_form = 3
-
- ! Boundary conditions
- integer, parameter :: bc_head = 0
- integer, parameter :: bc_flux = 1
- integer, parameter :: bc_zero_flux = 2
- integer, parameter :: bc_waterTable = 3
- integer, parameter :: bc_aquifer = 4
-
- ! Soil hydraulic properties
- integer, parameter :: soil_hp_clapphornberg_1978=0
- integer, parameter :: soil_hp_vanGenuchten_1980=1
-
- real(r8),parameter :: m_to_mm = 1.e3_r8 !convert meters to mm
-
- integer :: soilwater_movement_method ! method for solving richards equation
- integer :: upper_boundary_condition ! named variable for the boundary condition
- integer :: lower_boundary_condition ! named variable for the boundary condition
-
- ! Adaptive time stepping algorithmic control parameters
- real(r8) :: dtmin ! minimum time step length (seconds)
- real(r8) :: verySmall ! a very small number: used to check for sub step completion
- real(r8) :: xTolerUpper ! tolerance to halve length of substep
- real(r8) :: xTolerLower ! tolerance to double length of substep
- integer :: expensive
- integer :: inexpensive
- integer :: flux_calculation
-
- character(len=*), parameter, private :: sourcefile = &
- __FILE__
-
- !-----------------------------------------------------------------------
-
-contains
-
-!#1
- !-----------------------------------------------------------------------
- subroutine init_soilwater_movement()
- !
- !DESCRIPTION
- !specify method for doing soil&root water interactions
- !
- ! !USES:
- use abortutils , only : endrun
- use fileutils , only : getavu, relavu
- use spmdMod , only : mpicom, masterproc
- use shr_mpi_mod , only : shr_mpi_bcast
- use clm_varctl , only : iulog, use_bedrock
- use controlMod , only : NLFilename
- use clm_nlUtilsMod , only : find_nlgroup_name
-
- ! !ARGUMENTS:
- !------------------------------------------------------------------------------
- implicit none
- integer :: nu_nml ! unit for namelist file
- integer :: nml_error ! namelist i/o error flag
- character(*), parameter :: subName = "('init_soilwater_movement')"
-
- !-----------------------------------------------------------------------
-
-! MUST agree with name in namelist and read statement
- namelist /soilwater_movement_inparm/ &
- soilwater_movement_method, &
- upper_boundary_condition, &
- lower_boundary_condition, &
- dtmin, &
- verySmall, &
- xTolerUpper, &
- xTolerLower, &
- expensive, &
- inexpensive, &
- flux_calculation
-
- ! Default values for namelist
-
- soilwater_movement_method = zengdecker_2009
- upper_boundary_condition = bc_flux
- lower_boundary_condition = bc_aquifer
-
- dtmin=60._r8
- verySmall=1.e-8_r8
- xTolerUpper=1.e-1_r8
- xTolerLower=1.e-2_r8
- expensive=42
- inexpensive=1
- flux_calculation=inexpensive
-
- ! Read soilwater_movement namelist
- if (masterproc) then
- nu_nml = getavu()
- open( nu_nml, file=trim(NLFilename), status='old', iostat=nml_error )
- call find_nlgroup_name(nu_nml, 'soilwater_movement_inparm', status=nml_error)
- if (nml_error == 0) then
- read(nu_nml, nml=soilwater_movement_inparm,iostat=nml_error)
- if (nml_error /= 0) then
- call endrun(subname // ':: ERROR reading soilwater_movement namelist')
- end if
- else
- call endrun(subname // ':: ERROR reading soilwater_movement namelist')
- end if
- close(nu_nml)
- call relavu( nu_nml )
-
-! test for namelist consistency
- if((soilwater_movement_method == zengdecker_2009) .and. &
- (lower_boundary_condition /= bc_aquifer)) then
- call endrun(subname // ':: ERROR inconsistent soilwater_movement namelist: ZD09 must use bc_aquifer lbc')
- endif
- if((use_bedrock) .and. (lower_boundary_condition /= bc_zero_flux)) then
- call endrun(subname // ':: ERROR inconsistent soilwater_movement namelist: use_bedrock requires bc_zero_flux lbc')
- endif
- endif
-
- call shr_mpi_bcast(soilwater_movement_method, mpicom)
- call shr_mpi_bcast(upper_boundary_condition, mpicom)
- call shr_mpi_bcast(lower_boundary_condition, mpicom)
- call shr_mpi_bcast(dtmin, mpicom)
- call shr_mpi_bcast(verySmall, mpicom)
- call shr_mpi_bcast(xTolerUpper, mpicom)
- call shr_mpi_bcast(xTolerLower, mpicom)
- call shr_mpi_bcast(expensive, mpicom)
- call shr_mpi_bcast(inexpensive, mpicom)
- call shr_mpi_bcast(flux_calculation, mpicom)
-
-
- if (masterproc) then
-
- write(iulog,*) ' '
- write(iulog,*) 'soilwater_movement settings:'
- write(iulog,*) ' soilwater_movement_method = ',soilwater_movement_method
- write(iulog,*) ' upper_boundary_condition = ',upper_boundary_condition
- write(iulog,*) ' lower_boundary_condition = ',lower_boundary_condition
-
- write(iulog,*) ' use_bedrock = ',use_bedrock
- write(iulog,*) ' dtmin = ',dtmin
- write(iulog,*) ' verySmall = ',verySmall
- write(iulog,*) ' xTolerUpper = ',xTolerUpper
- write(iulog,*) ' xTolerLower = ',xTolerLower
- write(iulog,*) ' expensive = ',expensive
- write(iulog,*) ' inexpensive = ',inexpensive
- write(iulog,*) ' flux_calculation = ',flux_calculation
- endif
-
- end subroutine init_soilwater_movement
-
-
-!#2
- !------------------------------------------------------------------------------
- function use_aquifer_layer() result(lres)
- !
- !DESCRIPTION
- ! return true if an aquifer layer is used
- ! otherwise false
- implicit none
- logical :: lres
-
- if(lower_boundary_condition == bc_aquifer .or. lower_boundary_condition == bc_watertable)then
- lres=.true.
- else
- lres=.false.
- endif
- return
-
- end function use_aquifer_layer
-
- end module SoilWaterMovementMod
diff --git a/src/biogeophys/SoilWaterPlantSinkMod.F90 b/src/biogeophys/SoilWaterPlantSinkMod.F90
deleted file mode 100644
index 32854a3b..00000000
--- a/src/biogeophys/SoilWaterPlantSinkMod.F90
+++ /dev/null
@@ -1,444 +0,0 @@
-module SoilWaterPlantSinkMod
-
- use clm_varctl , only : use_hydrstress
- use decompMod , only : bounds_type
- 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 landunit_varcon , only : istsoil,istcrop
- use column_varcon , only : icol_road_perv
- implicit none
-
- character(len=*), parameter, private :: sourcefile = &
- __FILE__
-
-contains
-
- subroutine Compute_EffecRootFrac_And_VertTranSink(bounds, num_hydrologyc, &
- filter_hydrologyc, soilstate_inst, canopystate_inst, waterflux_inst, energyflux_inst)
-
- ! ---------------------------------------------------------------------------------
- ! This is a wrapper for calculating the effective root fraction and soil
- ! water sink due to plant transpiration.
- ! Calculate Soil Water Sink to Roots over different types
- ! of columns and for different process modules
- ! The super-set of all columns that should have a root water sink
- ! is filter_hydrologyc
- ! There are three groups of columns:
- ! 1) impervious roads, 2) non-natural vegetation and 3) natural vegetation
- ! There are several methods available.
- ! 1) the default version, 2) hydstress version and 3) fates boundary conditions
- !
- ! There are only two quantities that are the result of this routine, and its
- ! children:
- ! waterflux_inst%qflx_rootsoi_col(c,j)
- ! soilstate_inst%rootr_col(c,j)
- !
- !
- ! ---------------------------------------------------------------------------------
-
- use SoilStateType , only : soilstate_type
- use WaterFluxType , only : waterflux_type
- use CanopyStateType , only : canopystate_type
- use EnergyFluxType , only : energyflux_type
- use ColumnType , only : col
- use LandunitType , only : lun
-
- ! Arguments
- type(bounds_type) , intent(in) :: bounds ! bounds
- integer , intent(in) :: num_hydrologyc ! number of column soil points in column filter
- integer , intent(in) :: filter_hydrologyc(num_hydrologyc) ! column filter for soil points
- type(soilstate_type) , intent(inout) :: soilstate_inst
- type(waterflux_type) , intent(inout) :: waterflux_inst
- type(canopystate_type) , intent(in) :: canopystate_inst
- type(energyflux_type) , intent(in) :: energyflux_inst
-
- ! Local Variables
- integer :: filterc(bounds%endc-bounds%begc+1) !column filter
- integer :: num_filterc
- integer :: num_filterc_tot
- integer :: fc
- integer :: c
- integer :: l
-
- num_filterc_tot = 0
-
- ! 1) pervious roads
- num_filterc = 0
- do fc = 1, num_hydrologyc
- c = filter_hydrologyc(fc)
- if (col%itype(c) == icol_road_perv) then
- num_filterc = num_filterc + 1
- filterc(num_filterc) = c
- end if
- end do
- num_filterc_tot = num_filterc_tot+num_filterc
- if(use_hydrstress) then
- call Compute_EffecRootFrac_And_VertTranSink_HydStress_Roads(bounds, &
- num_filterc,filterc, soilstate_inst, waterflux_inst)
- else
- call Compute_EffecRootFrac_And_VertTranSink_Default(bounds, &
- num_filterc,filterc, soilstate_inst, waterflux_inst)
- end if
-
-
- ! Note: 2 and 3 really don't need to be split. But I am leaving
- ! it split in case someone wants to calculate uptake in a special
- ! way for a specific LU or coverage type (RGK 04/2017). Feel
- ! free to consolidate if there are no plans to do such a thing.
-
-
- ! 2) not ( pervious road or natural vegetation) , everything else
- num_filterc = 0
- do fc = 1, num_hydrologyc
- c = filter_hydrologyc(fc)
- l = col%landunit(c)
- if ( (col%itype(c) /= icol_road_perv) .and. (lun%itype(l) /= istsoil) ) then
- num_filterc = num_filterc + 1
- filterc(num_filterc) = c
- end if
- end do
- num_filterc_tot = num_filterc_tot+num_filterc
- if(use_hydrstress) then
- call Compute_EffecRootFrac_And_VertTranSink_HydStress(bounds, &
- num_filterc, filterc, waterflux_inst, soilstate_inst, &
- canopystate_inst, energyflux_inst)
- else
- call Compute_EffecRootFrac_And_VertTranSink_Default(bounds, &
- num_filterc,filterc, soilstate_inst, waterflux_inst)
- end if
-
-
- ! 3) Natural vegetation
- num_filterc = 0
- do fc = 1, num_hydrologyc
- c = filter_hydrologyc(fc)
- l = col%landunit(c)
- if ( (lun%itype(l) == istsoil) ) then
- num_filterc = num_filterc + 1
- filterc(num_filterc) = c
- end if
- end do
- num_filterc_tot = num_filterc_tot+num_filterc
- if (use_hydrstress) then
- call Compute_EffecRootFrac_And_VertTranSink_HydStress(bounds, &
- num_filterc, filterc, waterflux_inst, soilstate_inst, &
- canopystate_inst,energyflux_inst)
- else
- call Compute_EffecRootFrac_And_VertTranSink_Default(bounds, &
- num_filterc,filterc, soilstate_inst, waterflux_inst)
- end if
-
- if (num_hydrologyc /= num_filterc_tot) then
- write(iulog,*) 'The total number of columns flagged to root water uptake'
- write(iulog,*) 'did not match the total number calculated'
- write(iulog,*) 'This is likely a problem with the interpretation of column/lu filters.'
- call endrun(msg=errMsg(sourcefile, __LINE__))
- end if
-
-
- return
- end subroutine Compute_EffecRootFrac_And_VertTranSink
-
- ! ====================================================================================
-
- subroutine Compute_EffecRootFrac_And_VertTranSink_HydStress_Roads(bounds, &
- num_filterc,filterc, soilstate_inst, waterflux_inst)
-
- use SoilStateType , only : soilstate_type
- use WaterFluxType , only : waterflux_type
- use clm_varpar , only : nlevsoi
- use clm_varpar , only : max_patch_per_col
- use PatchType , only : patch
- use ColumnType , only : col
-
- ! Arguments
- type(bounds_type) , intent(in) :: bounds
- integer , intent(in) :: num_filterc
- integer , intent(in) :: filterc(:)
- type(soilstate_type) , intent(inout) :: soilstate_inst
- type(waterflux_type) , intent(inout) :: waterflux_inst
-
- ! Locals
- integer :: j
- integer :: c
- integer :: fc
- integer :: pi
- integer :: p
- real(r8) :: temp(bounds%begc:bounds%endc) ! accumulator for rootr weighting
-
-
- associate(&
- qflx_rootsoi_col => waterflux_inst%qflx_rootsoi_col , & ! Output: [real(r8) (:,:) ]
- ! vegetation/soil water exchange (mm H2O/s) (+ = to atm)
- qflx_tran_veg_patch => waterflux_inst%qflx_tran_veg_patch , & ! Input: [real(r8) (:) ]
- ! vegetation transpiration (mm H2O/s) (+ = to atm)
- qflx_tran_veg_col => waterflux_inst%qflx_tran_veg_col , & ! Input: [real(r8) (:) ]
- ! vegetation transpiration (mm H2O/s) (+ = to atm)
- rootr_patch => soilstate_inst%rootr_patch , & ! Input: [real(r8) (:,:) ]
- ! effective fraction of roots in each soil layer
- rootr_col => soilstate_inst%rootr_col & ! Output: [real(r8) (:,:) ]
- !effective fraction of roots in each soil layer
- )
-
- ! First step is to calculate the column-level effective rooting
- ! fraction in each soil layer. This is done outside the usual
- ! PATCH-to-column averaging routines because it is not a simple
- ! weighted average of the PATCH level rootr arrays. Instead, the
- ! weighting depends on both the per-unit-area transpiration
- ! of the PATCH and the PATCHEs area relative to all PATCHES.
-
- temp(bounds%begc : bounds%endc) = 0._r8
-
-
- do j = 1, nlevsoi
- do fc = 1, num_filterc
- c = filterc(fc)
- rootr_col(c,j) = 0._r8
- 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%npatches(c)) then
- p = col%patchi(c) + pi - 1
- if (patch%active(p)) then
- rootr_col(c,j) = rootr_col(c,j) + rootr_patch(p,j) * &
- qflx_tran_veg_patch(p) * patch%wtcol(p)
- end if
- end if
- end do
- end do
- do fc = 1, num_filterc
- c = filterc(fc)
- if (pi <= col%npatches(c)) then
- p = col%patchi(c) + pi - 1
- if (patch%active(p)) then
- temp(c) = temp(c) + qflx_tran_veg_patch(p) * patch%wtcol(p)
- end if
- end if
- end do
- end do
-
-
- do j = 1, nlevsoi
- do fc = 1, num_filterc
- c = filterc(fc)
- if (temp(c) /= 0._r8) then
- rootr_col(c,j) = rootr_col(c,j)/temp(c)
- end if
- qflx_rootsoi_col(c,j) = rootr_col(c,j)*qflx_tran_veg_col(c)
- end do
- end do
- end associate
- return
- end subroutine Compute_EffecRootFrac_And_VertTranSink_HydStress_Roads
-
- ! ==================================================================================
-
- subroutine Compute_EffecRootFrac_And_VertTranSink_HydStress( bounds, &
- num_filterc, filterc, waterflux_inst, soilstate_inst, &
- canopystate_inst, energyflux_inst)
-
-
- !
- !USES:
- use decompMod , only : bounds_type
- use clm_varpar , only : nlevsoi
- use clm_varpar , only : max_patch_per_col
- use SoilStateType , only : soilstate_type
- use WaterFluxType , only : waterflux_type
- use CanopyStateType , only : canopystate_type
- use PatchType , only : patch
- use ColumnType , only : col
- use clm_varctl , only : iulog
- use PhotosynthesisMod, only : params_inst
- use column_varcon , only : icol_road_perv
- use shr_infnan_mod , only : isnan => shr_infnan_isnan
- use EnergyFluxType , only : energyflux_type
- !
- ! !ARGUMENTS:
- type(bounds_type) , intent(in) :: bounds ! bounds
- integer , intent(in) :: num_filterc ! number of column soil points in column filter
- integer , intent(in) :: filterc(:) ! column filter for soil points
- type(waterflux_type) , intent(inout) :: waterflux_inst
- type(soilstate_type) , intent(inout) :: soilstate_inst
- type(canopystate_type) , intent(in) :: canopystate_inst
- type(energyflux_type), intent(in) :: energyflux_inst
- !
- ! !LOCAL VARIABLES:
- integer :: p,c,fc,j ! do loop indices
- integer :: pi ! patch index
- real(r8) :: temp(bounds%begc:bounds%endc) ! accumulator for rootr weighting
- real(r8) :: grav2 ! soil layer gravitational potential relative to surface (mm H2O)
- integer , parameter :: soil=1,root=4 ! index values
- !-----------------------------------------------------------------------
-
- associate(&
- k_soil_root => soilstate_inst%k_soil_root_patch , & ! Input: [real(r8) (:,:) ]
- ! soil-root interface conductance (mm/s)
- qflx_phs_neg_col => waterflux_inst%qflx_phs_neg_col , & ! Input: [real(r8) (:) ] n
- ! net neg hydraulic redistribution flux(mm H2O/s)
- qflx_tran_veg_col => waterflux_inst%qflx_tran_veg_col , & ! Input: [real(r8) (:) ]
- ! vegetation transpiration (mm H2O/s) (+ = to atm)
- qflx_tran_veg_patch => waterflux_inst%qflx_tran_veg_patch , & ! Input: [real(r8) (:) ]
- ! vegetation transpiration (mm H2O/s) (+ = to atm)
- qflx_rootsoi_col => waterflux_inst%qflx_rootsoi_col , & ! Output: [real(r8) (:) ]
- ! col root and soil water
- ! exchange [mm H2O/s] [+ into root]
- rootr_col => soilstate_inst%rootr_col , & ! Input: [real(r8) (:,:) ]
- ! effective fraction of roots in each soil layer
- rootr_patch => soilstate_inst%rootr_patch , & ! Input: [real(r8) (:,:) ]
- ! effective fraction of roots in each soil layer
- smp => soilstate_inst%smp_l_col , & ! Input: [real(r8) (:,:) ] soil matrix pot. [mm]
- frac_veg_nosno => canopystate_inst%frac_veg_nosno_patch , & ! Input: [integer (:) ]
- ! fraction of vegetation not
- ! covered by snow (0 OR 1) [-]
- z => col%z , & ! Input: [real(r8) (:,:) ] layer node depth (m)
- vegwp => canopystate_inst%vegwp_patch & ! Input: [real(r8) (:,:) ] vegetation water
- ! matric potential (mm)
- )
-
- do fc = 1, num_filterc
- c = filterc(fc)
- qflx_phs_neg_col(c) = 0._r8
-
- do j = 1, nlevsoi
- grav2 = z(c,j) * 1000._r8
- temp(c) = 0._r8
- do pi = 1,max_patch_per_col
- if (pi <= col%npatches(c)) then
- p = col%patchi(c) + pi - 1
- if (patch%active(p).and.frac_veg_nosno(p)>0) then
- if (patch%wtcol(p) > 0._r8) then
- temp(c) = temp(c) + k_soil_root(p,j) &
- * (smp(c,j) - vegwp(p,4) - grav2)* patch%wtcol(p)
- endif
- end if
- end if
- end do
- qflx_rootsoi_col(c,j)= temp(c)
-
- if (temp(c) < 0._r8) qflx_phs_neg_col(c) = qflx_phs_neg_col(c) + temp(c)
- end do
-
- ! Back out the effective root density
- if( sum(qflx_rootsoi_col(c,:))>0.0_r8 ) then
- do j = 1, nlevsoi
- rootr_col(c,j) = qflx_rootsoi_col(c,j)/sum( qflx_rootsoi_col(c,:))
- end do
- else
- rootr_col(c,:) = 0.0_r8
- end if
- end do
-
- end associate
-
- return
- end subroutine Compute_EffecRootFrac_And_VertTranSink_HydStress
-
- ! ==================================================================================
-
- subroutine Compute_EffecRootFrac_And_VertTranSink_Default(bounds, num_filterc, &
- filterc, soilstate_inst, waterflux_inst)
-
- !
- ! Generic routine to apply transpiration as a sink condition that
- ! is vertically distributed over the soil column. Should be
- ! applicable to any Richards solver that is not coupled to plant
- ! hydraulics.
- !
- !USES:
- use decompMod , only : bounds_type
- use shr_kind_mod , only : r8 => shr_kind_r8
- use clm_varpar , only : nlevsoi, max_patch_per_col
- use SoilStateType , only : soilstate_type
- use WaterFluxType , only : waterflux_type
- use PatchType , only : patch
- use ColumnType , only : col
- use clm_varctl , only : use_hydrstress
- use column_varcon , only : icol_road_perv
- !
- ! !ARGUMENTS:
- type(bounds_type) , intent(in) :: bounds ! bounds
- integer , intent(in) :: num_filterc ! number of column soil points in column filter
- integer , intent(in) :: filterc(num_filterc) ! column filter for soil points
- type(waterflux_type) , intent(inout) :: waterflux_inst
- type(soilstate_type) , intent(inout) :: soilstate_inst
- !
- ! !LOCAL VARIABLES:
- integer :: p,c,fc,j ! do loop indices
- integer :: pi ! patch index
- real(r8) :: temp(bounds%begc:bounds%endc) ! accumulator for rootr weighting
- associate(&
- qflx_rootsoi_col => waterflux_inst%qflx_rootsoi_col , & ! Output: [real(r8) (:,:) ]
- ! vegetation/soil water exchange (m H2O/s) (+ = to atm)
- qflx_tran_veg_patch => waterflux_inst%qflx_tran_veg_patch , & ! Input: [real(r8) (:) ]
- ! vegetation transpiration (mm H2O/s) (+ = to atm)
- qflx_tran_veg_col => waterflux_inst%qflx_tran_veg_col , & ! Input: [real(r8) (:) ]
- ! vegetation transpiration (mm H2O/s) (+ = to atm)
- rootr_patch => soilstate_inst%rootr_patch , & ! Input: [real(r8) (:,:) ]
- ! effective fraction of roots in each soil layer
- rootr_col => soilstate_inst%rootr_col & ! Output: [real(r8) (:,:) ]
- ! effective fraction of roots in each soil layer
- )
-
- ! First step is to calculate the column-level effective rooting
- ! fraction in each soil layer. This is done outside the usual
- ! PATCH-to-column averaging routines because it is not a simple
- ! weighted average of the PATCH level rootr arrays. Instead, the
- ! weighting depends on both the per-unit-area transpiration
- ! of the PATCH and the PATCHEs area relative to all PATCHES.
-
- temp(bounds%begc : bounds%endc) = 0._r8
-
- do j = 1, nlevsoi
- do fc = 1, num_filterc
- c = filterc(fc)
- rootr_col(c,j) = 0._r8
- 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%npatches(c)) then
- p = col%patchi(c) + pi - 1
- if (patch%active(p)) then
- rootr_col(c,j) = rootr_col(c,j) + rootr_patch(p,j) * &
- qflx_tran_veg_patch(p) * patch%wtcol(p)
- end if
- end if
- end do
- end do
- do fc = 1, num_filterc
- c = filterc(fc)
- if (pi <= col%npatches(c)) then
- p = col%patchi(c) + pi - 1
- if (patch%active(p)) then
- temp(c) = temp(c) + qflx_tran_veg_patch(p) * patch%wtcol(p)
- end if
- end if
- end do
- end do
-
- do j = 1, nlevsoi
- do fc = 1, num_filterc
- c = filterc(fc)
- if (temp(c) /= 0._r8) then
- rootr_col(c,j) = rootr_col(c,j)/temp(c)
- end if
- qflx_rootsoi_col(c,j) = rootr_col(c,j)*qflx_tran_veg_col(c)
-
- end do
- end do
- end associate
- return
- end subroutine Compute_EffecRootFrac_And_VertTranSink_Default
-
-end module SoilWaterPlantSinkMod
-
diff --git a/src/biogeophys/SoilWaterRetentionCurveClappHornberg1978Mod.F90 b/src/biogeophys/SoilWaterRetentionCurveClappHornberg1978Mod.F90
deleted file mode 100644
index c82e27d8..00000000
--- a/src/biogeophys/SoilWaterRetentionCurveClappHornberg1978Mod.F90
+++ /dev/null
@@ -1,162 +0,0 @@
-module SoilWaterRetentionCurveClappHornberg1978Mod
-
- !---------------------------------------------------------------------------
- ! !DESCRIPTION:
- ! Implementation of soil_water_retention_curve_type using the Clapp-Hornberg 1978
- ! parameterizations.
- !
- ! !USES:
- use shr_kind_mod , only : r8 => shr_kind_r8
- use SoilWaterRetentionCurveMod, only : soil_water_retention_curve_type
- implicit none
- save
- private
- !
- ! !PUBLIC TYPES:
- public :: soil_water_retention_curve_clapp_hornberg_1978_type
-
- type, extends(soil_water_retention_curve_type) :: &
- soil_water_retention_curve_clapp_hornberg_1978_type
- private
- contains
- procedure :: soil_hk ! compute hydraulic conductivity
- procedure :: soil_suction ! compute soil suction potential
- procedure :: soil_suction_inverse ! compute relative saturation at which soil suction is equal to a target value
- end type soil_water_retention_curve_clapp_hornberg_1978_type
-
- interface soil_water_retention_curve_clapp_hornberg_1978_type
- ! initialize a new soil_water_retention_curve_clapp_hornberg_1978_type object
- module procedure constructor
- end interface soil_water_retention_curve_clapp_hornberg_1978_type
-
-contains
-
- !-----------------------------------------------------------------------
- type(soil_water_retention_curve_clapp_hornberg_1978_type) function constructor()
- !
- ! !DESCRIPTION:
- ! Creates an object of type soil_water_retention_curve_clapp_hornberg_1978_type.
- ! For now, this is simply a place-holder.
- !-----------------------------------------------------------------------
-
- end function constructor
-
- !-----------------------------------------------------------------------
- subroutine soil_hk(this, c, j, s, imped, soilstate_inst, hk, dhkds)
- !
- ! !DESCRIPTION:
- ! Compute hydraulic conductivity
- !
- ! !USES:
- use SoilStateType , only : soilstate_type
- !
- ! !ARGUMENTS:
- class(soil_water_retention_curve_clapp_hornberg_1978_type), intent(in) :: this
- integer, intent(in) :: c !column index
- integer, intent(in) :: j !level index
- real(r8), intent(in) :: s !relative saturation, [0, 1]
- real(r8), intent(in) :: imped !ice impedance
- type(soilstate_type), intent(in) :: soilstate_inst
- real(r8), intent(out) :: hk !hydraulic conductivity [mm/s]
- real(r8), optional, intent(out) :: dhkds !d[hk]/ds [mm/s]
- !
- ! !LOCAL VARIABLES:
-
- character(len=*), parameter :: subname = 'soil_hk'
- !-----------------------------------------------------------------------
-
- associate(&
- hksat => soilstate_inst%hksat_col(c,j) , & ! Input: [real(r8) (:,:) ] hydraulic conductivity at saturation (mm H2O /s)
- bsw => soilstate_inst%bsw_col(c,j) & ! Input: [real(r8) (:,:) ] Clapp and Hornberger "b"
- )
-
-
- !compute hydraulic conductivity
- hk=imped*hksat*s**(2._r8*bsw+3._r8)
-
- !compute the derivative
- if(present(dhkds))then
- dhkds=(2._r8*bsw+3._r8)*hk/s
- endif
-
- end associate
-
- end subroutine soil_hk
-
- !-----------------------------------------------------------------------
- subroutine soil_suction(this, c, j, s, soilstate_inst, smp, dsmpds)
- !
- ! !DESCRIPTION:
- ! Compute soil suction potential
- !
- ! !USES:
- use SoilStateType , only : soilstate_type
- !
- ! !ARGUMENTS:
- class(soil_water_retention_curve_clapp_hornberg_1978_type), intent(in) :: this
- integer, intent(in) :: c !column index
- integer, intent(in) :: j !level index
- real(r8), intent(in) :: s !relative saturation, [0, 1]
- type(soilstate_type), intent(in) :: soilstate_inst
- real(r8), intent(out) :: smp !soil suction, negative, [mm]
- real(r8), optional, intent(out) :: dsmpds !d[smp]/ds, [mm]
- !
- ! !LOCAL VARIABLES:
-
- character(len=*), parameter :: subname = 'soil_suction'
- !-----------------------------------------------------------------------
-
- associate(&
- bsw => soilstate_inst%bsw_col(c,j) , & ! Input: [real(r8) (:,:) ] Clapp and Hornberger "b"
- sucsat => soilstate_inst%sucsat_col(c,j) & ! Input: [real(r8) (:,:) ] minimum soil suction (mm)
- )
-
- !compute soil suction potential, negative
- smp = -sucsat*s**(-bsw)
-
- !compute derivative
- if(present(dsmpds))then
- dsmpds=-bsw*smp/s
- endif
-
- end associate
-
- end subroutine soil_suction
-
- !-----------------------------------------------------------------------
- subroutine soil_suction_inverse(this, c, j, smp_target, soilstate_inst, &
- s_target)
- !
- ! !DESCRIPTION:
- ! Compute relative saturation at which soil suction is equal to a target value.
- ! This is done by inverting the soil_suction equation to solve for s.
- !
- ! !USES:
- use SoilStateType , only : soilstate_type
- !
- ! !ARGUMENTS:
- class(soil_water_retention_curve_clapp_hornberg_1978_type), intent(in) :: this
- integer, intent(in) :: c !column index
- integer, intent(in) :: j !level index
- type(soilstate_type), intent(in) :: soilstate_inst
- real(r8) , intent(in) :: smp_target ! target soil suction, negative [mm]
- real(r8) , intent(out) :: s_target ! relative saturation at which smp = smp_target [0,1]
- !
- ! !LOCAL VARIABLES:
-
- character(len=*), parameter :: subname = 'soil_suction_inverse'
- !-----------------------------------------------------------------------
-
- associate(&
- bsw => soilstate_inst%bsw_col(c,j) , & ! Input: [real(r8) (:,:) ] Clapp and Hornberger "b"
- sucsat => soilstate_inst%sucsat_col(c,j) & ! Input: [real(r8) (:,:) ] minimum soil suction (mm)
- )
-
- s_target = (-smp_target/sucsat)**(-1._r8/bsw)
-
- end associate
-
- end subroutine soil_suction_inverse
-
-end module SoilWaterRetentionCurveClappHornberg1978Mod
-
diff --git a/src/biogeophys/SoilWaterRetentionCurveFactoryMod.F90 b/src/biogeophys/SoilWaterRetentionCurveFactoryMod.F90
deleted file mode 100644
index 61e579dd..00000000
--- a/src/biogeophys/SoilWaterRetentionCurveFactoryMod.F90
+++ /dev/null
@@ -1,71 +0,0 @@
-module SoilWaterRetentionCurveFactoryMod
-
- !---------------------------------------------------------------------------
- ! !DESCRIPTION:
- ! Factory to create an instance of soil_water_retention_curve_type. This module figures
- ! out the particular type to return.
- !
- ! !USES:
- use abortutils , only : endrun
- use shr_log_mod , only : errMsg => shr_log_errMsg
- use clm_varctl , only : iulog
- implicit none
- save
- private
- !
- ! !PUBLIC ROUTINES:
- public :: create_soil_water_retention_curve ! create an object of class soil_water_retention_curve_type
-
- character(len=*), parameter, private :: sourcefile = &
- __FILE__
-
-contains
-
- !-----------------------------------------------------------------------
- function create_soil_water_retention_curve() result(soil_water_retention_curve)
- !
- ! !DESCRIPTION:
- ! Create and return an object of soil_water_retention_curve_type. The particular type
- ! is determined based on a namelist parameter.
- !
- ! !USES:
- use SoilWaterRetentionCurveMod, only : soil_water_retention_curve_type
- use SoilWaterRetentionCurveClappHornberg1978Mod, only : soil_water_retention_curve_clapp_hornberg_1978_type
- use SoilWaterRetentionCurveVanGenuchten1980Mod, only : soil_water_retention_curve_vangenuchten_1980_type
- !
- ! !ARGUMENTS:
- class(soil_water_retention_curve_type), allocatable :: soil_water_retention_curve ! function result
- !
- ! !LOCAL VARIABLES:
-
- ! For now, hard-code the method. Eventually this will be set from namelist, either by
- ! this routine (appropriate if the 'method' is in its own namelist group), or do the
- ! namelist read outside this module and pass the method in as a parameter (appropriate
- ! if the 'method' is part of a larger namelist group).
-!scs character(len=*), parameter :: method = "clapphornberg_1978"
- character(len=256) :: method
-
- character(len=*), parameter :: subname = 'create_soil_water_retention_curve'
- !-----------------------------------------------------------------------
-
- method = "clapphornberg_1978" !scs: placeholder until bld scripts changed
-
- select case (trim(method))
-
- case ("clapphornberg_1978")
- allocate(soil_water_retention_curve, &
- source=soil_water_retention_curve_clapp_hornberg_1978_type())
-
- case ("vangenuchten_1980")
- allocate(soil_water_retention_curve, &
- source=soil_water_retention_curve_vangenuchten_1980_type())
-
- case default
- write(iulog,*) subname//' ERROR: unknown method: ', method
- call endrun(msg=errMsg(sourcefile, __LINE__))
-
- end select
-
- end function create_soil_water_retention_curve
-
-end module SoilWaterRetentionCurveFactoryMod
diff --git a/src/biogeophys/SoilWaterRetentionCurveMod.F90 b/src/biogeophys/SoilWaterRetentionCurveMod.F90
deleted file mode 100644
index 74f8299d..00000000
--- a/src/biogeophys/SoilWaterRetentionCurveMod.F90
+++ /dev/null
@@ -1,111 +0,0 @@
-module SoilWaterRetentionCurveMod
-
- !---------------------------------------------------------------------------
- ! !DESCRIPTION:
- ! Abstract base class for functions to compute soil water retention curve
- !
- ! !USES:
- implicit none
- save
- private
- !
- ! !PUBLIC TYPES:
- public :: soil_water_retention_curve_type
-
- type, abstract :: soil_water_retention_curve_type
- private
- contains
- ! compute hydraulic conductivity
- procedure(soil_hk_interface), deferred :: soil_hk
-
- ! compute soil suction potential
- procedure(soil_suction_interface), deferred :: soil_suction
-
- ! compute relative saturation at which soil suction is equal to a target value
- procedure(soil_suction_inverse_interface), deferred :: soil_suction_inverse
- end type soil_water_retention_curve_type
-
- abstract interface
-
- ! Note: The following interfaces are set up based on the arguments needed for the
- ! clapphornberg1978 implementations. It's likely that these interfaces are not
- ! totally general for all desired implementations. In that case, we'll need to think
- ! about how to support different interfaces. Some possible solutions are:
- !
- ! - Make the interfaces contain all possible inputs that are needed by any
- ! implementation; each implementation will then ignore the inputs it doesn't need.
- !
- ! - For inputs that are needed only by particular implementations - and particularly
- ! for inputs that are constant in time (e.g., this is the case for bsw, I think):
- ! pass these into the constructor, and save pointers to these inputs as components
- ! of the child type that needs them. Then they aren't needed as inputs to the
- ! individual routines, allowing the interfaces for these routines to remain more
- ! consistent between different implementations.
-
- subroutine soil_hk_interface(this, c, j, s, imped, soilstate_inst, &
- hk, dhkds)
-
- ! !DESCRIPTION:
- ! Compute hydraulic conductivity
- !
- ! !USES:
- use shr_kind_mod , only : r8 => shr_kind_r8
- use SoilStateType , only : soilstate_type
- import :: soil_water_retention_curve_type
- !
- ! !ARGUMENTS:
- class(soil_water_retention_curve_type), intent(in) :: this
- integer, intent(in) :: c !column index
- integer, intent(in) :: j !level index
- real(r8), intent(in) :: s !relative saturation, [0, 1]
- real(r8), intent(in) :: imped !ice impedance
- type(soilstate_type), intent(in) :: soilstate_inst
- real(r8), intent(out):: hk !hydraulic conductivity [mm/s]
- real(r8), optional, intent(out):: dhkds !d[hk]/ds [mm/s]
- end subroutine soil_hk_interface
-
-
- subroutine soil_suction_interface(this, c, j, s, soilstate_inst, &
- smp, dsmpds)
-
- ! !DESCRIPTION:
- ! Compute soil suction potential
- !
- ! !USES:
- use shr_kind_mod , only : r8 => shr_kind_r8
- use SoilStateType , only : soilstate_type
- import :: soil_water_retention_curve_type
- !
- ! !ARGUMENTS:
- class(soil_water_retention_curve_type), intent(in) :: this
- integer, intent(in) :: c !column index
- integer, intent(in) :: j !level index
- real(r8), intent(in) :: s !relative saturation, [0, 1]
- type(soilstate_type), intent(in) :: soilstate_inst
- real(r8), intent(out) :: smp !soil suction, negative, [mm]
- real(r8), optional, intent(out) :: dsmpds !d[smp]/ds, [mm]
- end subroutine soil_suction_interface
-
- subroutine soil_suction_inverse_interface(this, c, j, smp_target, &
- soilstate_inst, s_target)
- ! !DESCRIPTION:
- ! Compute relative saturation at which soil suction is equal to a target value.
- ! This is done by inverting the soil_suction equation to solve for s.
- !
- ! !USES:
- use shr_kind_mod , only : r8 => shr_kind_r8
- use SoilStateType , only : soilstate_type
- import :: soil_water_retention_curve_type
- !
- ! !ARGUMENTS:
- class(soil_water_retention_curve_type), intent(in) :: this
- integer, intent(in) :: c !column index
- integer, intent(in) :: j !level index
- real(r8), intent(in) :: smp_target ! target soil suction, negative [mm]
- type(soilstate_type), intent(in) :: soilstate_inst
- real(r8) , intent(out) :: s_target ! relative saturation at which smp = smp_target [0,1]
- end subroutine soil_suction_inverse_interface
-
- end interface
-
-end module SoilWaterRetentionCurveMod
diff --git a/src/biogeophys/SoilWaterRetentionCurveVanGenuchten1980Mod.F90 b/src/biogeophys/SoilWaterRetentionCurveVanGenuchten1980Mod.F90
deleted file mode 100644
index c8dacccb..00000000
--- a/src/biogeophys/SoilWaterRetentionCurveVanGenuchten1980Mod.F90
+++ /dev/null
@@ -1,162 +0,0 @@
-module SoilWaterRetentionCurveVanGenuchten1980Mod
-
- !---------------------------------------------------------------------------
- ! !DESCRIPTION:
- ! Implementation of soil_water_retention_curve_type using the Clapp-Hornberg 1978
- ! parameterizations.
- !
- ! !USES:
- use shr_kind_mod , only : r8 => shr_kind_r8
- use SoilWaterRetentionCurveMod, only : soil_water_retention_curve_type
- implicit none
- save
- private
- !
- ! !PUBLIC TYPES:
- public :: soil_water_retention_curve_vangenuchten_1980_type
-
- type, extends(soil_water_retention_curve_type) :: &
- soil_water_retention_curve_vangenuchten_1980_type
- private
- contains
- procedure :: soil_hk ! compute hydraulic conductivity
- procedure :: soil_suction ! compute soil suction potential
- procedure :: soil_suction_inverse ! compute relative saturation at which soil suction is equal to a target value
- end type soil_water_retention_curve_vangenuchten_1980_type
-
- interface soil_water_retention_curve_vangenuchten_1980_type
- ! initialize a new soil_water_retention_curve_vangenuchten_1980_type object
- module procedure constructor
- end interface soil_water_retention_curve_vangenuchten_1980_type
-
-contains
-
- !-----------------------------------------------------------------------
- type(soil_water_retention_curve_vangenuchten_1980_type) function constructor()
- !
- ! !DESCRIPTION:
- ! Creates an object of type soil_water_retention_curve_vangenuchten_1980_type.
- ! For now, this is simply a place-holder.
- !-----------------------------------------------------------------------
-
- end function constructor
-
- !-----------------------------------------------------------------------
- subroutine soil_hk(this, c, j, s, imped, soilstate_inst, hk, dhkds)
- !
- ! !DESCRIPTION:
- ! Compute hydraulic conductivity
- !
- ! !USES:
- use SoilStateType , only : soilstate_type
- !
- ! !ARGUMENTS:
- class(soil_water_retention_curve_vangenuchten_1980_type), intent(in) :: this
- integer, intent(in) :: c !column index
- integer, intent(in) :: j !level index
- real(r8), intent(in) :: s !relative saturation, [0, 1]
- real(r8), intent(in) :: imped !ice impedance
- type(soilstate_type), intent(in) :: soilstate_inst
- real(r8), intent(out) :: hk !hydraulic conductivity [mm/s]
- real(r8), optional, intent(out) :: dhkds !d[hk]/ds [mm/s]
- !
- ! !LOCAL VARIABLES:
-
- character(len=*), parameter :: subname = 'soil_hk'
- !-----------------------------------------------------------------------
-
- associate(&
- hksat => soilstate_inst%hksat_col(c,j) , & ! Input: [real(r8) (:,:) ] hydraulic conductivity at saturation (mm H2O /s)
- bsw => soilstate_inst%bsw_col(c,j) & ! Input: [real(r8) (:,:) ] Clapp and Hornberger "b"
- )
-
-
- !compute hydraulic conductivity
- hk=imped*hksat*s**(2._r8*bsw+3._r8)
-
- !compute the derivative
- if(present(dhkds))then
- dhkds=(2._r8*bsw+3._r8)*hk/s
- endif
-
- end associate
-
- end subroutine soil_hk
-
- !-----------------------------------------------------------------------
- subroutine soil_suction(this, c, j, s, soilstate_inst, smp, dsmpds)
- !j,
- ! !DESCRIPTION:
- ! Compute soil suction potential
- !
- ! !USES:
- use SoilStateType , only : soilstate_type
- !
- ! !ARGUMENTS:
- class(soil_water_retention_curve_vangenuchten_1980_type), intent(in) :: this
- integer, intent(in) :: c !column index
- integer, intent(in) :: j !level index
- real(r8), intent(in) :: s !relative saturation, [0, 1]
- type(soilstate_type), intent(in) :: soilstate_inst
- real(r8), intent(out) :: smp !soil suction, negative, [mm]
- real(r8), optional, intent(out) :: dsmpds !d[smp]/ds, [mm]
- !
- ! !LOCAL VARIABLES:
-
- character(len=*), parameter :: subname = 'soil_suction'
- !-----------------------------------------------------------------------
-
- associate(&
- bsw => soilstate_inst%bsw_col(c,j) , & ! Input: [real(r8) (:,:) ] Clapp and Hornberger "b"
- sucsat => soilstate_inst%sucsat_col(c,j) & ! Input: [real(r8) (:,:) ] minimum soil suction (mm)
- )
-
- !compute soil suction potential, negative
- smp = -sucsat*s**(-bsw)
-
- !compute derivative
- if(present(dsmpds))then
- dsmpds=-bsw*smp/s
- endif
-
- end associate
-
- end subroutine soil_suction
-
- !-----------------------------------------------------------------------
- subroutine soil_suction_inverse(this, c, j, smp_target, soilstate_inst, s_target)
- !
- ! !DESCRIPTION:
- ! Compute relative saturation at which soil suction is equal to a target value.
- ! This is done by inverting the soil_suction equation to solve for s.
- !
- ! !USES:
- use SoilStateType , only : soilstate_type
- !
- ! !ARGUMENTS:
- class(soil_water_retention_curve_vangenuchten_1980_type), intent(in) :: this
- integer, intent(in) :: c !column index
- integer, intent(in) :: j !level index
- type(soilstate_type), intent(in) :: soilstate_inst
- real(r8) , intent(in) :: smp_target ! target soil suction, negative [mm]
- real(r8) , intent(out) :: s_target ! relative saturation at which smp = smp_target [0,1]
- !
- ! !LOCAL VARIABLES:
-
- character(len=*), parameter :: subname = 'soil_suction_inverse'
- !-----------------------------------------------------------------------
-
- associate(&
- bsw => soilstate_inst%bsw_col(c,j) , & ! Input: [real(r8) (:,:) ] Clapp and Hornberger "b"
- sucsat => soilstate_inst%sucsat_col(c,j) & ! Input: [real(r8) (:,:) ] minimum soil suction (mm)
- )
-
- s_target = (-smp_target/sucsat)**(-1._r8/bsw)
-
- end associate
-
- end subroutine soil_suction_inverse
-
-end module SoilWaterRetentionCurveVanGenuchten1980Mod
-
-
diff --git a/src/biogeophys/SolarAbsorbedType.F90 b/src/biogeophys/SolarAbsorbedType.F90
deleted file mode 100644
index e167fb3a..00000000
--- a/src/biogeophys/SolarAbsorbedType.F90
+++ /dev/null
@@ -1,423 +0,0 @@
-module SolarAbsorbedType
-
- !------------------------------------------------------------------------------
- ! !USES:
- use shr_kind_mod , only: r8 => shr_kind_r8
- use shr_log_mod , only: errMsg => shr_log_errMsg
- use decompMod , only : bounds_type
- use clm_varcon , only : spval
- use clm_varctl , only : use_luna
- !
- ! !PUBLIC TYPES:
- implicit none
- save
- private
- !
- ! !PUBLIC DATA MEMBERS:
- type, public :: solarabs_type
-
- ! Solar reflected
- real(r8), pointer :: fsr_patch (:) ! patch solar radiation reflected (W/m**2)
-
- ! Solar Absorbed
- real(r8), pointer :: fsa_patch (:) ! patch solar radiation absorbed (total) (W/m**2)
- real(r8), pointer :: fsa_u_patch (:) ! patch urban solar radiation absorbed (total) (W/m**2)
- real(r8), pointer :: fsa_r_patch (:) ! patch rural solar radiation absorbed (total) (W/m**2)
- real(r8), pointer :: parsun_z_patch (:,:) ! patch absorbed PAR for sunlit leaves in canopy layer (W/m**2)
- real(r8), pointer :: parsha_z_patch (:,:) ! patch absorbed PAR for shaded leaves in canopy layer (W/m**2)
- real(r8), pointer :: par240d_z_patch (:,:) ! 10-day running mean of daytime patch absorbed PAR for leaves in canopy layer (W/m**2)
- real(r8), pointer :: par240x_z_patch (:,:) ! 10-day running mean of maximum patch absorbed PAR for leaves in canopy layer (W/m**2)
- real(r8), pointer :: par24d_z_patch (:,:) ! daily accumulated absorbed PAR for leaves in canopy layer from midnight to current step(J/m**2)
- real(r8), pointer :: par24x_z_patch (:,:) ! daily max of patch absorbed PAR for leaves in canopy layer from midnight to current step(W/m**2)
- real(r8), pointer :: sabg_soil_patch (:) ! patch solar radiation absorbed by soil (W/m**2)
- real(r8), pointer :: sabg_snow_patch (:) ! patch solar radiation absorbed by snow (W/m**2)
- real(r8), pointer :: sabg_patch (:) ! patch solar radiation absorbed by ground (W/m**2)
- real(r8), pointer :: sabg_chk_patch (:) ! patch fsno weighted sum (W/m**2)
- real(r8), pointer :: sabg_lyr_patch (:,:) ! patch absorbed radiation in each snow layer and top soil layer (pft,lyr) [W/m2]
- real(r8), pointer :: sabg_pen_patch (:) ! patch (rural) shortwave radiation penetrating top soisno layer [W/m2]
-
- real(r8), pointer :: sub_surf_abs_SW_patch (:) ! patch fraction of solar radiation absorbed below first snow layer
- real(r8), pointer :: sabv_patch (:) ! patch solar radiation absorbed by vegetation (W/m**2)
-
- real(r8), pointer :: sabs_roof_dir_lun (:,:) ! lun direct solar absorbed by roof per unit ground area per unit incident flux
- real(r8), pointer :: sabs_roof_dif_lun (:,:) ! lun diffuse solar absorbed by roof per unit ground area per unit incident flux
- real(r8), pointer :: sabs_sunwall_dir_lun (:,:) ! lun direct solar absorbed by sunwall per unit wall area per unit incident flux
- real(r8), pointer :: sabs_sunwall_dif_lun (:,:) ! lun diffuse solar absorbed by sunwall per unit wall area per unit incident flux
- real(r8), pointer :: sabs_shadewall_dir_lun (:,:) ! lun direct solar absorbed by shadewall per unit wall area per unit incident flux
- real(r8), pointer :: sabs_shadewall_dif_lun (:,:) ! lun diffuse solar absorbed by shadewall per unit wall area per unit incident flux
- real(r8), pointer :: sabs_improad_dir_lun (:,:) ! lun direct solar absorbed by impervious road per unit ground area per unit incident flux
- real(r8), pointer :: sabs_improad_dif_lun (:,:) ! lun diffuse solar absorbed by impervious road per unit ground area per unit incident flux
- real(r8), pointer :: sabs_perroad_dir_lun (:,:) ! lun direct solar absorbed by pervious road per unit ground area per unit incident flux
- real(r8), pointer :: sabs_perroad_dif_lun (:,:) ! lun diffuse solar absorbed by pervious road per unit ground area per unit incident flux
-
- ! Currently needed by lake code
- ! TODO (MV 8/20/2014) should be moved in the future
- real(r8), pointer :: fsds_nir_d_patch (:) ! patch incident direct beam nir solar radiation (W/m**2)
- real(r8), pointer :: fsds_nir_i_patch (:) ! patch incident diffuse nir solar radiation (W/m**2)
- real(r8), pointer :: fsds_nir_d_ln_patch (:) ! patch incident direct beam nir solar radiation at local noon (W/m**2)
- real(r8), pointer :: fsr_nir_d_patch (:) ! patch reflected direct beam nir solar radiation (W/m**2)
- real(r8), pointer :: fsr_nir_i_patch (:) ! patch reflected diffuse nir solar radiation (W/m**2)
- real(r8), pointer :: fsr_nir_d_ln_patch (:) ! patch reflected direct beam nir solar radiation at local noon (W/m**2)
-
- contains
-
- procedure, public :: Init
- procedure, private :: InitAllocate
- procedure, private :: InitHistory
- procedure, private :: InitCold
- procedure, public :: Restart
-
- end type solarabs_type
- !-----------------------------------------------------------------------
-
-contains
-
- !------------------------------------------------------------------------
- subroutine Init(this, bounds)
-
- class(solarabs_type) :: this
- type(bounds_type), intent(in) :: bounds
-
- call this%InitAllocate(bounds)
- call this%InitHistory(bounds)
- call this%InitCold(bounds)
-
- end subroutine Init
-
- !-----------------------------------------------------------------------
- subroutine InitAllocate(this, bounds)
- !
- ! Allocate module variables and data structures
- !
- ! !USES:
- use shr_infnan_mod, only : nan => shr_infnan_nan, assignment(=)
- use clm_varpar , only : nlevcan, nlevcan, numrad, nlevsno
- !
- ! !ARGUMENTS:
- class(solarabs_type) :: this
- type(bounds_type), intent(in) :: bounds
- !
- ! !LOCAL VARIABLES:
- integer :: begp, endp
- integer :: begc, endc
- integer :: begl, endl
- !---------------------------------------------------------------------
-
- begp = bounds%begp; endp = bounds%endp
- begc = bounds%begc; endc = bounds%endc
- begl = bounds%begl; endl = bounds%endl
-
- allocate(this%fsa_patch (begp:endp)) ; this%fsa_patch (:) = nan
- allocate(this%fsa_u_patch (begp:endp)) ; this%fsa_u_patch (:) = nan
- allocate(this%fsa_r_patch (begp:endp)) ; this%fsa_r_patch (:) = nan
- allocate(this%parsun_z_patch (begp:endp,1:nlevcan)) ; this%parsun_z_patch (:,:) = nan
- allocate(this%parsha_z_patch (begp:endp,1:nlevcan)) ; this%parsha_z_patch (:,:) = nan
- if(use_luna)then
- allocate(this%par240d_z_patch (begp:endp,1:nlevcan)) ; this%par240d_z_patch (:,:) = spval
- allocate(this%par240x_z_patch (begp:endp,1:nlevcan)) ; this%par240x_z_patch (:,:) = spval
- allocate(this%par24d_z_patch (begp:endp,1:nlevcan)) ; this%par24d_z_patch (:,:) = spval
- allocate(this%par24x_z_patch (begp:endp,1:nlevcan)) ; this%par24x_z_patch (:,:) = spval
- endif
- allocate(this%sabv_patch (begp:endp)) ; this%sabv_patch (:) = nan
- allocate(this%sabg_patch (begp:endp)) ; this%sabg_patch (:) = nan
- allocate(this%sabg_lyr_patch (begp:endp,-nlevsno+1:1)) ; this%sabg_lyr_patch (:,:) = nan
- allocate(this%sabg_pen_patch (begp:endp)) ; this%sabg_pen_patch (:) = nan
- allocate(this%sabg_soil_patch (begp:endp)) ; this%sabg_soil_patch (:) = nan
- allocate(this%sabg_snow_patch (begp:endp)) ; this%sabg_snow_patch (:) = nan
- allocate(this%sabg_chk_patch (begp:endp)) ; this%sabg_chk_patch (:) = nan
- allocate(this%sabs_roof_dir_lun (begl:endl,1:numrad)) ; this%sabs_roof_dir_lun (:,:) = nan
- allocate(this%sabs_roof_dif_lun (begl:endl,1:numrad)) ; this%sabs_roof_dif_lun (:,:) = nan
- allocate(this%sabs_sunwall_dir_lun (begl:endl,1:numrad)) ; this%sabs_sunwall_dir_lun (:,:) = nan
- allocate(this%sabs_sunwall_dif_lun (begl:endl,1:numrad)) ; this%sabs_sunwall_dif_lun (:,:) = nan
- allocate(this%sabs_shadewall_dir_lun (begl:endl,1:numrad)) ; this%sabs_shadewall_dir_lun (:,:) = nan
- allocate(this%sabs_shadewall_dif_lun (begl:endl,1:numrad)) ; this%sabs_shadewall_dif_lun (:,:) = nan
- allocate(this%sabs_improad_dir_lun (begl:endl,1:numrad)) ; this%sabs_improad_dir_lun (:,:) = nan
- allocate(this%sabs_improad_dif_lun (begl:endl,1:numrad)) ; this%sabs_improad_dif_lun (:,:) = nan
- allocate(this%sabs_perroad_dir_lun (begl:endl,1:numrad)) ; this%sabs_perroad_dir_lun (:,:) = nan
- allocate(this%sabs_perroad_dif_lun (begl:endl,1:numrad)) ; this%sabs_perroad_dif_lun (:,:) = nan
- allocate(this%sub_surf_abs_SW_patch (begp:endp)) ; this%sub_surf_abs_SW_patch (:) = nan
- allocate(this%fsr_patch (begp:endp)) ; this%fsr_patch (:) = nan
- allocate(this%fsr_nir_d_patch (begp:endp)) ; this%fsr_nir_d_patch (:) = nan
- allocate(this%fsr_nir_i_patch (begp:endp)) ; this%fsr_nir_i_patch (:) = nan
- allocate(this%fsr_nir_d_ln_patch (begp:endp)) ; this%fsr_nir_d_ln_patch (:) = nan
- allocate(this%fsds_nir_d_patch (begp:endp)) ; this%fsds_nir_d_patch (:) = nan
- allocate(this%fsds_nir_i_patch (begp:endp)) ; this%fsds_nir_i_patch (:) = nan
- allocate(this%fsds_nir_d_ln_patch (begp:endp)) ; this%fsds_nir_d_ln_patch (:) = nan
-
- end subroutine InitAllocate
-
- !-----------------------------------------------------------------------
- subroutine InitHistory(this, bounds)
- !
- ! History fields initialization
- !
- ! !USES:
- use shr_infnan_mod, only : nan => shr_infnan_nan, assignment(=)
- use clm_varctl , only : use_snicar_frc
- use clm_varpar , only : nlevsno
- use histFileMod , only : hist_addfld1d, hist_addfld2d
- use histFileMod , only : no_snow_normal
- !
- ! !ARGUMENTS:
- class(solarabs_type) :: this
- type(bounds_type), intent(in) :: bounds
-
- !
- ! !LOCAL VARIABLES:
- integer :: begp, endp
- integer :: begc, endc
- real(r8), pointer :: data2dptr(:,:) ! temp. pointers for slicing larger arrays
- real(r8), pointer :: ptr_1d(:) ! pointer to 1d patch array
- !---------------------------------------------------------------------
-
- begp = bounds%begp; endp = bounds%endp
- begc = bounds%begc; endc = bounds%endc
-
- this%fsa_patch(begp:endp) = spval
- call hist_addfld1d (fname='FSA', units='W/m^2', &
- avgflag='A', long_name='absorbed solar radiation', &
- ptr_patch=this%fsa_patch, c2l_scale_type='urbanf', default='inactive')
-
- call hist_addfld1d (fname='FSA_ICE', units='W/m^2', &
- avgflag='A', long_name='absorbed solar radiation (ice landunits only)', &
- ptr_patch=this%fsa_patch, c2l_scale_type='urbanf', l2g_scale_type='ice', &
- default='inactive')
-
- this%fsa_r_patch(begp:endp) = spval
- call hist_addfld1d (fname='FSA_R', units='W/m^2', &
- avgflag='A', long_name='Rural absorbed solar radiation', &
- ptr_patch=this%fsa_r_patch, set_spec=spval, default='inactive')
-
- this%fsa_u_patch(begp:endp) = spval
- call hist_addfld1d (fname='FSA_U', units='W/m^2', &
- avgflag='A', long_name='Urban absorbed solar radiation', &
- ptr_patch=this%fsa_u_patch, c2l_scale_type='urbanf', set_nourb=spval, default='inactive')
-
- this%fsr_patch(begp:endp) = spval
- call hist_addfld1d (fname='FSR', units='W/m^2', &
- avgflag='A', long_name='reflected solar radiation', &
- ptr_patch=this%fsr_patch, c2l_scale_type='urbanf', default='inactive')
- ! Rename of FSR for Urban intercomparision project
- call hist_addfld1d (fname='SWup', units='W/m^2', &
- avgflag='A', long_name='upwelling shortwave radiation', &
- ptr_patch=this%fsr_patch, c2l_scale_type='urbanf', default='inactive')
-
- call hist_addfld1d (fname='FSR_ICE', units='W/m^2', &
- avgflag='A', long_name='reflected solar radiation (ice landunits only)', &
- ptr_patch=this%fsr_patch, c2l_scale_type='urbanf', l2g_scale_type='ice', &
- default='inactive')
-
- this%sabg_lyr_patch(begp:endp,-nlevsno+1:0) = spval
- data2dptr => this%sabg_lyr_patch(:,-nlevsno+1:0)
- call hist_addfld2d (fname='SNO_ABS', units='W/m^2', type2d='levsno', &
- avgflag='A', long_name='Absorbed solar radiation in each snow layer', &
- ptr_patch=data2dptr, no_snow_behavior=no_snow_normal, default='inactive')
-
- call hist_addfld2d (fname='SNO_ABS_ICE', units='W/m^2', type2d='levsno', &
- avgflag='A', long_name='Absorbed solar radiation in each snow layer (ice landunits only)', &
- ptr_patch=data2dptr, no_snow_behavior=no_snow_normal, &
- l2g_scale_type='ice', default='inactive')
-
- this%sabv_patch(begp:endp) = spval
- call hist_addfld1d (fname='SABV', units='W/m^2', &
- avgflag='A', long_name='solar rad absorbed by veg', &
- ptr_patch=this%sabv_patch, c2l_scale_type='urbanf', default='inactive')
-
- this%sabg_patch(begp:endp) = spval
- call hist_addfld1d (fname='SABG', units='W/m^2', &
- avgflag='A', long_name='solar rad absorbed by ground', &
- ptr_patch=this%sabg_patch, c2l_scale_type='urbanf', default='inactive')
-
- this%sabg_pen_patch(begp:endp) = spval
- call hist_addfld1d (fname='SABG_PEN', units='watt/m^2', &
- avgflag='A', long_name='Rural solar rad penetrating top soil or snow layer', &
- ptr_patch=this%sabg_pen_patch, set_spec=spval, default='inactive')
-
- ! Currently needed by lake code - TODO should not be here
- this%fsds_nir_d_patch(begp:endp) = spval
- call hist_addfld1d (fname='FSDSND', units='W/m^2', &
- avgflag='A', long_name='direct nir incident solar radiation', &
- ptr_patch=this%fsds_nir_d_patch, default='inactive')
-
- this%fsds_nir_i_patch(begp:endp) = spval
- call hist_addfld1d (fname='FSDSNI', units='W/m^2', &
- avgflag='A', long_name='diffuse nir incident solar radiation', &
- ptr_patch=this%fsds_nir_i_patch, default='inactive')
-
- this%fsds_nir_d_ln_patch(begp:endp) = spval
- call hist_addfld1d (fname='FSDSNDLN', units='W/m^2', &
- avgflag='A', long_name='direct nir incident solar radiation at local noon', &
- ptr_patch=this%fsds_nir_d_ln_patch, default='inactive')
-
- this%fsr_nir_d_patch(begp:endp) = spval
- call hist_addfld1d (fname='FSRND', units='W/m^2', &
- avgflag='A', long_name='direct nir reflected solar radiation', &
- ptr_patch=this%fsr_nir_d_patch, c2l_scale_type='urbanf', default='inactive')
-
- this%fsr_nir_i_patch(begp:endp) = spval
- call hist_addfld1d (fname='FSRNI', units='W/m^2', &
- avgflag='A', long_name='diffuse nir reflected solar radiation', &
- ptr_patch=this%fsr_nir_i_patch, c2l_scale_type='urbanf', default='inactive')
-
- this%fsr_nir_d_ln_patch(begp:endp) = spval
- call hist_addfld1d (fname='FSRNDLN', units='W/m^2', &
- avgflag='A', long_name='direct nir reflected solar radiation at local noon', &
- ptr_patch=this%fsr_nir_d_ln_patch, c2l_scale_type='urbanf', default='inactive')
-
- this%sub_surf_abs_SW_patch(begp:endp) = spval
- call hist_addfld1d (fname='SNOINTABS', units='-', &
- avgflag='A', long_name='Fraction of incoming solar absorbed by lower snow layers', &
- ptr_patch=this%sub_surf_abs_SW_patch, set_lake=spval, set_urb=spval, default='inactive')
-
- if(use_luna)then
- ptr_1d => this%par240d_z_patch(:,1)
- call hist_addfld1d (fname='PAR240DZ', units='W/m^2', &
- avgflag='A', long_name='10-day running mean of daytime patch absorbed PAR for leaves for top canopy layer', &
- ptr_patch=ptr_1d, default='inactive')
- ptr_1d => this%par240x_z_patch(:,1)
- call hist_addfld1d (fname='PAR240XZ', units='W/m^2', &
- avgflag='A', long_name='10-day running mean of maximum patch absorbed PAR for leaves for top canopy layer', &
- ptr_patch=ptr_1d, default='inactive')
-
- endif
-
- end subroutine InitHistory
-
- !------------------------------------------------------------------------
- subroutine InitCold(this, bounds)
- !
- ! Initialize module surface albedos to reasonable values
- !
- use landunit_varcon, only : istsoil, istcrop
- !
- ! !ARGUMENTS:
- class(solarabs_type) :: this
- type(bounds_type), intent(in) :: bounds
- !
- ! !LOCAL VARIABLES:
- integer :: begl, endl
- !-----------------------------------------------------------------------
-
- begl = bounds%begl; endl = bounds%endl
-
- this%sabs_roof_dir_lun (begl:endl, :) = 0._r8
- this%sabs_roof_dif_lun (begl:endl, :) = 0._r8
- this%sabs_sunwall_dir_lun (begl:endl, :) = 0._r8
- this%sabs_sunwall_dif_lun (begl:endl, :) = 0._r8
- this%sabs_shadewall_dir_lun (begl:endl, :) = 0._r8
- this%sabs_shadewall_dif_lun (begl:endl, :) = 0._r8
- this%sabs_improad_dir_lun (begl:endl, :) = 0._r8
- this%sabs_improad_dif_lun (begl:endl, :) = 0._r8
- this%sabs_perroad_dir_lun (begl:endl, :) = 0._r8
- this%sabs_perroad_dif_lun (begl:endl, :) = 0._r8
-
- end subroutine InitCold
-
- !---------------------------------------------------------------------
- subroutine Restart(this, bounds, ncid, flag)
- !
- ! !DESCRIPTION:
- ! Read/Write module information to/from restart file.
- !
- ! !USES:
- use shr_infnan_mod , only : shr_infnan_isnan
- use clm_varctl , only : use_snicar_frc, iulog
- use spmdMod , only : masterproc
- use abortutils , only : endrun
- use ncdio_pio , only : file_desc_t, ncd_defvar, ncd_io, ncd_double, ncd_int, ncd_inqvdlen
- use restUtilMod
- !
- ! !ARGUMENTS:
- class(solarabs_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:
- logical :: readvar ! determine if variable is on initial file
- integer :: p
- !---------------------------------------------------------------------
-
- call restartvar(ncid=ncid, flag=flag, varname='sabs_roof_dir', xtype=ncd_double, dim1name='landunit', &
- dim2name='numrad', switchdim=.true., &
- long_name='direct solar absorbed by roof per unit ground area per unit incident flux', units='', &
- interpinic_flag='interp', readvar=readvar, data=this%sabs_roof_dir_lun)
-
- call restartvar(ncid=ncid, flag=flag, varname='sabs_roof_dif', xtype=ncd_double, dim1name='landunit', &
- dim2name='numrad', switchdim=.true., &
- long_name='diffuse solar absorbed by roof per unit ground area per unit incident flux', units='', &
- interpinic_flag='interp', readvar=readvar, data=this%sabs_roof_dif_lun)
-
- call restartvar(ncid=ncid, flag=flag, varname='sabs_sunwall_dir', xtype=ncd_double, dim1name='landunit', &
- dim2name='numrad', switchdim=.true., &
- long_name='direct solar absorbed by sunwall per unit wall area per unit incident flux', units='', &
- interpinic_flag='interp', readvar=readvar, data=this%sabs_sunwall_dir_lun)
-
- call restartvar(ncid=ncid, flag=flag, varname='sabs_sunwall_dif', xtype=ncd_double, dim1name='landunit', &
- dim2name='numrad', switchdim=.true., &
- long_name='diffuse solar absorbed by sunwall per unit wall area per unit incident flux', units='', &
- interpinic_flag='interp', readvar=readvar, data=this%sabs_sunwall_dif_lun)
-
- call restartvar(ncid=ncid, flag=flag, varname='sabs_shadewall_dir', xtype=ncd_double, dim1name='landunit', &
- dim2name='numrad', switchdim=.true., &
- long_name='direct solar absorbed by shadewall per unit wall area per unit incident flux', units='', &
- interpinic_flag='interp', readvar=readvar, data=this%sabs_shadewall_dir_lun)
-
- call restartvar(ncid=ncid, flag=flag, varname='sabs_shadewall_dif', xtype=ncd_double, dim1name='landunit', &
- dim2name='numrad', switchdim=.true., &
- long_name='diffuse solar absorbed by shadewall per unit wall area per unit incident flux', units='', &
- interpinic_flag='interp', readvar=readvar, data=this%sabs_shadewall_dif_lun)
-
- call restartvar(ncid=ncid, flag=flag, varname='sabs_improad_dir', xtype=ncd_double, dim1name='landunit', &
- dim2name='numrad', switchdim=.true., &
- long_name='direct solar absorbed by impervious road per unit ground area per unit incident flux', units='', &
- interpinic_flag='interp', readvar=readvar, data=this%sabs_improad_dir_lun)
-
- call restartvar(ncid=ncid, flag=flag, varname='sabs_improad_dif', xtype=ncd_double, dim1name='landunit', &
- dim2name='numrad', switchdim=.true., &
- long_name='diffuse solar absorbed by impervious road per unit ground area per unit incident flux', units='', &
- interpinic_flag='interp', readvar=readvar, data=this%sabs_improad_dif_lun)
-
- call restartvar(ncid=ncid, flag=flag, varname='sabs_perroad_dir', xtype=ncd_double, dim1name='landunit', &
- dim2name='numrad', switchdim=.true., &
- long_name='direct solar absorbed by pervious road per unit ground area per unit incident flux', units='', &
- interpinic_flag='interp', readvar=readvar, data=this%sabs_perroad_dir_lun)
-
- call restartvar(ncid=ncid, flag=flag, varname='sabs_perroad_dif', xtype=ncd_double, dim1name='landunit', &
- dim2name='numrad', switchdim=.true., &
- long_name='diffuse solar absorbed by pervious road per unit ground area per unit incident flux', units='', &
- interpinic_flag='interp', readvar=readvar, data=this%sabs_perroad_dif_lun)
-
- if(use_luna)then
- call restartvar(ncid=ncid, flag=flag, varname='par240d', xtype=ncd_double, &
- dim1name='pft', dim2name='levcan', switchdim=.true., &
- long_name='10-day running mean of daytime absorbed PAR for leaves in canopy layer', units='W/m**2 leaf', &
- interpinic_flag='interp', readvar=readvar, data=this%par240d_z_patch )
- call restartvar(ncid=ncid, flag=flag, varname='par24d', xtype=ncd_double, &
- dim1name='pft', dim2name='levcan', switchdim=.true., &
- long_name='Accumulative daytime absorbed PAR for leaves in canopy layer for 24 hours', units='J/m**2 leaf', &
- interpinic_flag='interp', readvar=readvar, data=this%par24d_z_patch )
-
- call restartvar(ncid=ncid, flag=flag, varname='par240x', xtype=ncd_double, &
- dim1name='pft', dim2name='levcan', switchdim=.true., &
- long_name='10-day running mean of maximum absorbed PAR for leaves in canopy layers', units='W/m**2 leaf', &
- interpinic_flag='interp', readvar=readvar, data=this%par240x_z_patch )
- call restartvar(ncid=ncid, flag=flag, varname='par24x', xtype=ncd_double, &
- dim1name='pft', dim2name='levcan', switchdim=.true., &
- long_name='Maximum absorbed PAR for leaves in canopy layer in 24 hours', units='J/m**2 leaf', &
- interpinic_flag='interp', readvar=readvar, data=this%par24x_z_patch )
-
- call restartvar(ncid=ncid, flag=flag, varname='parsun', xtype=ncd_double, &
- dim1name='pft', dim2name='levcan', switchdim=.true., &
- long_name='Instaneous absorbed PAR for sunlit leaves in canopy layer', units='W/m**2 leaf', &
- interpinic_flag='interp', readvar=readvar, data=this%parsun_z_patch )
- call restartvar(ncid=ncid, flag=flag, varname='parsha', xtype=ncd_double, &
- dim1name='pft', dim2name='levcan', switchdim=.true., &
- long_name='Instaneous absorbed PAR for shaded leaves in canopy layer', units='W/m**2 leaf', &
- interpinic_flag='interp', readvar=readvar, data=this%parsha_z_patch )
-
- endif
-
- end subroutine Restart
-
-end module SolarAbsorbedType
diff --git a/src/biogeophys/SurfaceAlbedoMod.F90 b/src/biogeophys/SurfaceAlbedoMod.F90
deleted file mode 100644
index 93caf268..00000000
--- a/src/biogeophys/SurfaceAlbedoMod.F90
+++ /dev/null
@@ -1,143 +0,0 @@
-module SurfaceAlbedoMod
-
-#include "shr_assert.h"
-
- !-----------------------------------------------------------------------
- ! !DESCRIPTION:
- ! Performs surface albedo calculations
- !
- ! !PUBLIC TYPES:
- use shr_kind_mod , only : r8 => shr_kind_r8
- use shr_log_mod , only : errMsg => shr_log_errMsg
- use decompMod , only : bounds_type
- use landunit_varcon , only : istsoil, istcrop
- use clm_varcon , only : grlnd, namep
- use clm_varpar , only : numrad, nlevcan, nlevsno, nlevcan
- use clm_varctl , only : fsurdat, iulog, use_snicar_frc
- use pftconMod , only : pftcon
- use ColumnType , only : col
- !
- implicit none
- !
- ! !PUBLIC MEMBER FUNCTIONS:
- public :: SurfaceAlbedoInitTimeConst
- !
- ! !PUBLIC DATA MEMBERS:
- ! The CLM default albice values are too high.
- ! Full-spectral albedo for land ice is ~0.5 (Paterson, Physics of Glaciers, 1994, p. 59)
- ! This is the value used in CAM3 by Pritchard et al., GRL, 35, 2008.
-
- ! albedo land ice by waveband (1=vis, 2=nir)
- real(r8), public :: albice(numrad) = (/ 0.80_r8, 0.55_r8 /)
-
- ! namelist default setting for inputting alblakwi
- real(r8), public :: lake_melt_icealb(numrad) = (/ 0.10_r8, 0.10_r8/)
-
- ! Coefficient for calculating ice "fraction" for lake surface albedo
- ! From D. Mironov (2010) Boreal Env. Research
- real(r8), parameter :: calb = 95.6_r8
-
- !
- ! !PRIVATE DATA MEMBERS:
-
- ! !PRIVATE DATA FUNCTIONS:
- real(r8), allocatable, private :: albsat(:,:) ! wet soil albedo by color class and waveband (1=vis,2=nir)
- real(r8), allocatable, private :: albdry(:,:) ! dry soil albedo by color class and waveband (1=vis,2=nir)
- integer , allocatable, private :: isoicol(:) ! column soil color class
-
- character(len=*), parameter, private :: sourcefile = &
- __FILE__
- !-----------------------------------------------------------------------
-
-contains
-
- !-----------------------------------------------------------------------
- subroutine SurfaceAlbedoInitTimeConst(bounds)
- !
- ! !DESCRIPTION:
- ! Initialize module time constant variables
- !
- ! !USES:
- use shr_log_mod, only : errMsg => shr_log_errMsg
- use fileutils , only : getfil
- use abortutils , only : endrun
- use ncdio_pio , only : file_desc_t, ncd_defvar, ncd_io, ncd_pio_openfile, ncd_pio_closefile
- use spmdMod , only : masterproc
- !
- ! !ARGUMENTS:
- type(bounds_type), intent(in) :: bounds
- !
- ! !LOCAL VARIABLES:
- integer :: c,g ! indices
- integer :: mxsoil_color ! maximum number of soil color classes
- type(file_desc_t) :: ncid ! netcdf id
- character(len=256) :: locfn ! local filename
- integer :: ier ! error status
- logical :: readvar
- integer ,pointer :: soic2d (:) ! read in - soil color
- !---------------------------------------------------------------------
-
- ! Allocate module variable for soil color
-
- allocate(isoicol(bounds%begc:bounds%endc))
-
- ! Determine soil color and number of soil color classes
- ! if number of soil color classes is not on input dataset set it to 8
-
- call getfil (fsurdat, locfn, 0)
- call ncd_pio_openfile (ncid, locfn, 0)
-
- call ncd_io(ncid=ncid, varname='mxsoil_color', flag='read', data=mxsoil_color, readvar=readvar)
- if ( .not. readvar ) mxsoil_color = 8
-
- allocate(soic2d(bounds%begg:bounds%endg))
- call ncd_io(ncid=ncid, varname='SOIL_COLOR', flag='read', data=soic2d, dim1name=grlnd, readvar=readvar)
- if (.not. readvar) then
- call endrun(msg=' ERROR: SOIL_COLOR NOT on surfdata file'//errMsg(sourcefile, __LINE__))
- end if
- do c = bounds%begc, bounds%endc
- g = col%gridcell(c)
- isoicol(c) = soic2d(g)
- end do
- deallocate(soic2d)
-
- call ncd_pio_closefile(ncid)
-
- ! Determine saturated and dry soil albedos for n color classes and
- ! numrad wavebands (1=vis, 2=nir)
-
- allocate(albsat(mxsoil_color,numrad), albdry(mxsoil_color,numrad), stat=ier)
- if (ier /= 0) then
- write(iulog,*)'allocation error for albsat, albdry'
- call endrun(msg=errMsg(sourcefile, __LINE__))
- end if
-
- if (masterproc) then
- write(iulog,*) 'Attempting to read soil colo data .....'
- end if
-
- if (mxsoil_color == 8) then
- albsat(1:8,1) = (/0.12_r8,0.11_r8,0.10_r8,0.09_r8,0.08_r8,0.07_r8,0.06_r8,0.05_r8/)
- albsat(1:8,2) = (/0.24_r8,0.22_r8,0.20_r8,0.18_r8,0.16_r8,0.14_r8,0.12_r8,0.10_r8/)
- albdry(1:8,1) = (/0.24_r8,0.22_r8,0.20_r8,0.18_r8,0.16_r8,0.14_r8,0.12_r8,0.10_r8/)
- albdry(1:8,2) = (/0.48_r8,0.44_r8,0.40_r8,0.36_r8,0.32_r8,0.28_r8,0.24_r8,0.20_r8/)
- else if (mxsoil_color == 20) then
- albsat(1:20,1) = (/0.25_r8,0.23_r8,0.21_r8,0.20_r8,0.19_r8,0.18_r8,0.17_r8,0.16_r8,&
- 0.15_r8,0.14_r8,0.13_r8,0.12_r8,0.11_r8,0.10_r8,0.09_r8,0.08_r8,0.07_r8,0.06_r8,0.05_r8,0.04_r8/)
- albsat(1:20,2) = (/0.50_r8,0.46_r8,0.42_r8,0.40_r8,0.38_r8,0.36_r8,0.34_r8,0.32_r8,&
- 0.30_r8,0.28_r8,0.26_r8,0.24_r8,0.22_r8,0.20_r8,0.18_r8,0.16_r8,0.14_r8,0.12_r8,0.10_r8,0.08_r8/)
- albdry(1:20,1) = (/0.36_r8,0.34_r8,0.32_r8,0.31_r8,0.30_r8,0.29_r8,0.28_r8,0.27_r8,&
- 0.26_r8,0.25_r8,0.24_r8,0.23_r8,0.22_r8,0.20_r8,0.18_r8,0.16_r8,0.14_r8,0.12_r8,0.10_r8,0.08_r8/)
- albdry(1:20,2) = (/0.61_r8,0.57_r8,0.53_r8,0.51_r8,0.49_r8,0.48_r8,0.45_r8,0.43_r8,&
- 0.41_r8,0.39_r8,0.37_r8,0.35_r8,0.33_r8,0.31_r8,0.29_r8,0.27_r8,0.25_r8,0.23_r8,0.21_r8,0.16_r8/)
- else
- write(iulog,*)'maximum color class = ',mxsoil_color,' is not supported'
- call endrun(msg=errMsg(sourcefile, __LINE__))
- end if
-
- ! Set alblakwi
- !alblakwi(:) = lake_melt_icealb(:)
-
- end subroutine SurfaceAlbedoInitTimeConst
-
-end module SurfaceAlbedoMod
diff --git a/src/biogeophys/SurfaceAlbedoType.F90 b/src/biogeophys/SurfaceAlbedoType.F90
deleted file mode 100644
index 1540d9f9..00000000
--- a/src/biogeophys/SurfaceAlbedoType.F90
+++ /dev/null
@@ -1,636 +0,0 @@
-module SurfaceAlbedoType
-
-#include "shr_assert.h"
-
- !-----------------------------------------------------------------------
- use shr_kind_mod , only : r8 => shr_kind_r8
- use shr_log_mod , only : errMsg => shr_log_errMsg
- use decompMod , only : bounds_type
- use clm_varpar , only : numrad, nlevcan, nlevsno
- use abortutils , only : endrun
- !
- ! !PUBLIC TYPES:
- implicit none
- save
- !
- ! !PUBLIC DATA MEMBERS:
- type, public :: surfalb_type
-
- real(r8), pointer :: coszen_col (:) ! col cosine of solar zenith angle
- real(r8), pointer :: albd_patch (:,:) ! patch surface albedo (direct) (numrad)
- real(r8), pointer :: albi_patch (:,:) ! patch surface albedo (diffuse) (numrad)
- real(r8), pointer :: albgrd_pur_col (:,:) ! col pure snow ground direct albedo (numrad)
- real(r8), pointer :: albgri_pur_col (:,:) ! col pure snow ground diffuse albedo (numrad)
- real(r8), pointer :: albgrd_bc_col (:,:) ! col ground direct albedo without BC (numrad)
- real(r8), pointer :: albgri_bc_col (:,:) ! col ground diffuse albedo without BC (numrad)
- real(r8), pointer :: albgrd_oc_col (:,:) ! col ground direct albedo without OC (numrad)
- real(r8), pointer :: albgri_oc_col (:,:) ! col ground diffuse albedo without OC (numrad)
- real(r8), pointer :: albgrd_dst_col (:,:) ! col ground direct albedo without dust (numrad)
- real(r8), pointer :: albgri_dst_col (:,:) ! col ground diffuse albedo without dust (numrad)
- real(r8), pointer :: albgrd_col (:,:) ! col ground albedo (direct) (numrad)
- real(r8), pointer :: albgri_col (:,:) ! col ground albedo (diffuse) (numrad)
- real(r8), pointer :: albsod_col (:,:) ! col soil albedo: direct (col,bnd) [frc]
- real(r8), pointer :: albsoi_col (:,:) ! col soil albedo: diffuse (col,bnd) [frc]
- real(r8), pointer :: albsnd_hst_col (:,:) ! col snow albedo, direct , for history files (col,bnd) [frc]
- real(r8), pointer :: albsni_hst_col (:,:) ! col snow albedo, diffuse, for history files (col,bnd) [frc]
-
- real(r8), pointer :: ftdd_patch (:,:) ! patch down direct flux below canopy per unit direct flx (numrad)
- real(r8), pointer :: ftid_patch (:,:) ! patch down diffuse flux below canopy per unit direct flx (numrad)
- real(r8), pointer :: ftii_patch (:,:) ! patch down diffuse flux below canopy per unit diffuse flx (numrad)
- real(r8), pointer :: fabd_patch (:,:) ! patch flux absorbed by canopy per unit direct flux (numrad)
- real(r8), pointer :: fabd_sun_patch (:,:) ! patch flux absorbed by sunlit canopy per unit direct flux (numrad)
- real(r8), pointer :: fabd_sha_patch (:,:) ! patch flux absorbed by shaded canopy per unit direct flux (numrad)
- real(r8), pointer :: fabi_patch (:,:) ! patch flux absorbed by canopy per unit diffuse flux (numrad)
- real(r8), pointer :: fabi_sun_patch (:,:) ! patch flux absorbed by sunlit canopy per unit diffuse flux (numrad)
- real(r8), pointer :: fabi_sha_patch (:,:) ! patch flux absorbed by shaded canopy per unit diffuse flux (numrad)
- real(r8), pointer :: fabd_sun_z_patch (:,:) ! patch absorbed sunlit leaf direct PAR (per unit lai+sai) for each canopy layer
- real(r8), pointer :: fabd_sha_z_patch (:,:) ! patch absorbed shaded leaf direct PAR (per unit lai+sai) for each canopy layer
- real(r8), pointer :: fabi_sun_z_patch (:,:) ! patch absorbed sunlit leaf diffuse PAR (per unit lai+sai) for each canopy layer
- real(r8), pointer :: fabi_sha_z_patch (:,:) ! patch absorbed shaded leaf diffuse PAR (per unit lai+sai) for each canopy layer
- real(r8), pointer :: flx_absdv_col (:,:) ! col absorbed flux per unit incident direct flux: VIS (col,lyr) [frc]
- real(r8), pointer :: flx_absdn_col (:,:) ! col absorbed flux per unit incident direct flux: NIR (col,lyr) [frc]
- real(r8), pointer :: flx_absiv_col (:,:) ! col absorbed flux per unit incident diffuse flux: VIS (col,lyr) [frc]
- real(r8), pointer :: flx_absin_col (:,:) ! col absorbed flux per unit incident diffuse flux: NIR (col,lyr) [frc]
-
- real(r8) , pointer :: fsun_z_patch (:,:) ! patch patch sunlit fraction of canopy layer
- real(r8) , pointer :: tlai_z_patch (:,:) ! patch tlai increment for canopy layer
- real(r8) , pointer :: tsai_z_patch (:,:) ! patch tsai increment for canopy layer
- integer , pointer :: ncan_patch (:) ! patch number of canopy layers
- integer , pointer :: nrad_patch (:) ! patch number of canopy layers, above snow for radiative transfer
- real(r8) , pointer :: vcmaxcintsun_patch (:) ! patch leaf to canopy scaling coefficient, sunlit leaf vcmax
- real(r8) , pointer :: vcmaxcintsha_patch (:) ! patch leaf to canopy scaling coefficient, shaded leaf vcmax
-
- contains
-
- procedure, public :: Init
- procedure, private :: InitAllocate
- procedure, private :: InitHistory
- procedure, private :: InitCold
- procedure, public :: Restart
-
- end type surfalb_type
-
- character(len=*), parameter, private :: sourcefile = &
- __FILE__
- !-----------------------------------------------------------------------
-
-contains
-
- !------------------------------------------------------------------------
- subroutine Init(this, bounds)
-
- class(surfalb_type) :: this
- type(bounds_type), intent(in) :: bounds
-
- call this%InitAllocate(bounds)
- call this%InitHistory(bounds)
- call this%InitCold(bounds)
-
- end subroutine Init
-
- !-----------------------------------------------------------------------
- subroutine InitAllocate(this, bounds)
- !
- ! Allocate module variables and data structures
- !
- ! !USES:
- use shr_infnan_mod, only: nan => shr_infnan_nan, assignment(=)
- use clm_varcon , only: spval, ispval
- !
- ! !ARGUMENTS:
- class(surfalb_type) :: this
- type(bounds_type), intent(in) :: bounds
- !
- ! !LOCAL VARIABLES:
- integer :: begp, endp
- integer :: begc, endc
- !---------------------------------------------------------------------
-
- begp = bounds%begp; endp = bounds%endp
- begc = bounds%begc; endc = bounds%endc
-
- allocate(this%coszen_col (begc:endc)) ; this%coszen_col (:) = nan
- allocate(this%albgrd_col (begc:endc,numrad)) ; this%albgrd_col (:,:) = nan
- allocate(this%albgri_col (begc:endc,numrad)) ; this%albgri_col (:,:) = nan
- allocate(this%albsnd_hst_col (begc:endc,numrad)) ; this%albsnd_hst_col (:,:) = spval
- allocate(this%albsni_hst_col (begc:endc,numrad)) ; this%albsni_hst_col (:,:) = spval
- allocate(this%albsod_col (begc:endc,numrad)) ; this%albsod_col (:,:) = spval
- allocate(this%albsoi_col (begc:endc,numrad)) ; this%albsoi_col (:,:) = spval
- allocate(this%albgrd_pur_col (begc:endc,numrad)) ; this%albgrd_pur_col (:,:) = nan
- allocate(this%albgri_pur_col (begc:endc,numrad)) ; this%albgri_pur_col (:,:) = nan
- allocate(this%albgrd_bc_col (begc:endc,numrad)) ; this%albgrd_bc_col (:,:) = nan
- allocate(this%albgri_bc_col (begc:endc,numrad)) ; this%albgri_bc_col (:,:) = nan
- allocate(this%albgrd_oc_col (begc:endc,numrad)) ; this%albgrd_oc_col (:,:) = nan
- allocate(this%albgri_oc_col (begc:endc,numrad)) ; this%albgri_oc_col (:,:) = nan
- allocate(this%albgrd_dst_col (begc:endc,numrad)) ; this%albgrd_dst_col (:,:) = nan
- allocate(this%albgri_dst_col (begc:endc,numrad)) ; this%albgri_dst_col (:,:) = nan
- allocate(this%albd_patch (begp:endp,numrad)) ; this%albd_patch (:,:) = nan
- allocate(this%albi_patch (begp:endp,numrad)) ; this%albi_patch (:,:) = nan
-
- allocate(this%ftdd_patch (begp:endp,numrad)) ; this%ftdd_patch (:,:) = nan
- allocate(this%ftid_patch (begp:endp,numrad)) ; this%ftid_patch (:,:) = nan
- allocate(this%ftii_patch (begp:endp,numrad)) ; this%ftii_patch (:,:) = nan
- allocate(this%fabd_patch (begp:endp,numrad)) ; this%fabd_patch (:,:) = nan
- allocate(this%fabd_sun_patch (begp:endp,numrad)) ; this%fabd_sun_patch (:,:) = nan
- allocate(this%fabd_sha_patch (begp:endp,numrad)) ; this%fabd_sha_patch (:,:) = nan
- allocate(this%fabi_patch (begp:endp,numrad)) ; this%fabi_patch (:,:) = nan
- allocate(this%fabi_sun_patch (begp:endp,numrad)) ; this%fabi_sun_patch (:,:) = nan
- allocate(this%fabi_sha_patch (begp:endp,numrad)) ; this%fabi_sha_patch (:,:) = nan
- allocate(this%fabd_sun_z_patch (begp:endp,nlevcan)) ; this%fabd_sun_z_patch (:,:) = 0._r8
- allocate(this%fabd_sha_z_patch (begp:endp,nlevcan)) ; this%fabd_sha_z_patch (:,:) = 0._r8
- allocate(this%fabi_sun_z_patch (begp:endp,nlevcan)) ; this%fabi_sun_z_patch (:,:) = 0._r8
- allocate(this%fabi_sha_z_patch (begp:endp,nlevcan)) ; this%fabi_sha_z_patch (:,:) = 0._r8
- allocate(this%flx_absdv_col (begc:endc,-nlevsno+1:1)) ; this%flx_absdv_col (:,:) = spval
- allocate(this%flx_absdn_col (begc:endc,-nlevsno+1:1)) ; this%flx_absdn_col (:,:) = spval
- allocate(this%flx_absiv_col (begc:endc,-nlevsno+1:1)) ; this%flx_absiv_col (:,:) = spval
- allocate(this%flx_absin_col (begc:endc,-nlevsno+1:1)) ; this%flx_absin_col (:,:) = spval
-
- allocate(this%fsun_z_patch (begp:endp,nlevcan)) ; this%fsun_z_patch (:,:) = 0._r8
- allocate(this%tlai_z_patch (begp:endp,nlevcan)) ; this%tlai_z_patch (:,:) = 0._r8
- allocate(this%tsai_z_patch (begp:endp,nlevcan)) ; this%tsai_z_patch (:,:) = 0._r8
- allocate(this%ncan_patch (begp:endp)) ; this%ncan_patch (:) = 0
- allocate(this%nrad_patch (begp:endp)) ; this%nrad_patch (:) = 0
- allocate(this%vcmaxcintsun_patch (begp:endp)) ; this%vcmaxcintsun_patch (:) = nan
- allocate(this%vcmaxcintsha_patch (begp:endp)) ; this%vcmaxcintsha_patch (:) = nan
-
- end subroutine InitAllocate
-
- !-----------------------------------------------------------------------
- subroutine InitHistory(this, bounds)
- !
- ! History fields initialization
- !
- ! !USES:
- use shr_infnan_mod, only: nan => shr_infnan_nan, assignment(=)
- use clm_varcon , only: spval
- use histFileMod , only: hist_addfld1d, hist_addfld2d
- !
- ! !ARGUMENTS:
- class(surfalb_type) :: this
- type(bounds_type), intent(in) :: bounds
- !
- ! !LOCAL VARIABLES:
- integer :: begp, endp
- integer :: begc, endc
- !---------------------------------------------------------------------
-
- begp = bounds%begp; endp = bounds%endp
- begc = bounds%begc; endc = bounds%endc
-
- this%coszen_col(begc:endc) = spval
- call hist_addfld1d (fname='COSZEN', units='none', &
- avgflag='A', long_name='cosine of solar zenith angle', &
- ptr_col=this%coszen_col, default='inactive')
-
- this%albgri_col(begc:endc,:) = spval
- call hist_addfld2d (fname='ALBGRD', units='proportion', type2d='numrad', &
- avgflag='A', long_name='ground albedo (direct)', &
- ptr_col=this%albgrd_col, default='inactive')
-
- this%albgri_col(begc:endc,:) = spval
- call hist_addfld2d (fname='ALBGRI', units='proportion', type2d='numrad', &
- avgflag='A', long_name='ground albedo (indirect)', &
- ptr_col=this%albgri_col, default='inactive')
-
- this%albd_patch(begp:endp,:) = spval
- call hist_addfld2d (fname='ALBD', units='proportion', type2d='numrad', &
- avgflag='A', long_name='surface albedo (direct)', &
- ptr_patch=this%albd_patch, default='inactive', c2l_scale_type='urbanf')
-
- this%albi_patch(begp:endp,:) = spval
- call hist_addfld2d (fname='ALBI', units='proportion', type2d='numrad', &
- avgflag='A', long_name='surface albedo (indirect)', &
- ptr_patch=this%albi_patch, default='inactive', c2l_scale_type='urbanf')
-
- end subroutine InitHistory
-
- !-----------------------------------------------------------------------
- subroutine InitCold(this, bounds)
- !
- ! Initialize module surface albedos to reasonable values
- !
- ! !ARGUMENTS:
- class(surfalb_type) :: this
- type(bounds_type), intent(in) :: bounds
- !
- ! !LOCAL VARIABLES:
- integer :: begc, endc
- integer :: begp, endp
- !-----------------------------------------------------------------------
-
- begp = bounds%begp; endp= bounds%endp
- begc = bounds%begc; endc= bounds%endc
-
- this%albgrd_col (begc:endc, :) = 0.2_r8
- this%albgri_col (begc:endc, :) = 0.2_r8
- this%albsod_col (begc:endc, :) = 0.2_r8
- this%albsoi_col (begc:endc, :) = 0.2_r8
- this%albsnd_hst_col (begc:endc, :) = 0.6_r8
- this%albsni_hst_col (begc:endc, :) = 0.6_r8
- this%albd_patch (begp:endp, :) = 0.2_r8
- this%albi_patch (begp:endp, :) = 0.2_r8
-
- this%albgrd_pur_col (begc:endc, :) = 0.2_r8
- this%albgri_pur_col (begc:endc, :) = 0.2_r8
- this%albgrd_bc_col (begc:endc, :) = 0.2_r8
- this%albgri_bc_col (begc:endc, :) = 0.2_r8
- this%albgrd_oc_col (begc:endc, :) = 0.2_r8
- this%albgri_oc_col (begc:endc, :) = 0.2_r8
- this%albgrd_dst_col (begc:endc, :) = 0.2_r8
- this%albgri_dst_col (begc:endc, :) = 0.2_r8
-
- this%fabi_patch (begp:endp, :) = 0.0_r8
- this%fabd_patch (begp:endp, :) = 0.0_r8
- this%fabi_sun_patch (begp:endp, :) = 0.0_r8
- this%fabd_sun_patch (begp:endp, :) = 0.0_r8
- this%fabd_sha_patch (begp:endp, :) = 0.0_r8
- this%fabi_sha_patch (begp:endp, :) = 0.0_r8
- this%ftdd_patch (begp:endp, :) = 1.0_r8
- this%ftid_patch (begp:endp, :) = 0.0_r8
- this%ftii_patch (begp:endp, :) = 1.0_r8
-
- end subroutine InitCold
-
- !---------------------------------------------------------------------
- subroutine Restart(this, bounds, ncid, flag, &
- tlai_patch, tsai_patch)
- !
- ! !DESCRIPTION:
- ! Read/Write module information to/from restart file.
- !
- ! !USES:
- use clm_varctl , only : use_snicar_frc, iulog
- use spmdMod , only : masterproc
- use decompMod , only : bounds_type
- use abortutils , only : endrun
- use ncdio_pio , only : file_desc_t, ncd_defvar, ncd_io, ncd_double, ncd_int, ncd_inqvdlen
- use restUtilMod
- !
- ! !ARGUMENTS:
- class(surfalb_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'
- real(r8) , intent(in) :: tlai_patch(bounds%begp:)
- real(r8) , intent(in) :: tsai_patch(bounds%begp:)
- !
- ! !LOCAL VARIABLES:
- logical :: readvar ! determine if variable is on initial file
- integer :: iv
- integer :: begp, endp
- integer :: begc, endc
- !---------------------------------------------------------------------
-
- SHR_ASSERT_ALL((ubound(tlai_patch) == (/bounds%endp/)), errMsg(sourcefile, __LINE__))
- SHR_ASSERT_ALL((ubound(tsai_patch) == (/bounds%endp/)), errMsg(sourcefile, __LINE__))
-
- begp = bounds%begp; endp = bounds%endp
- begc = bounds%begc; endc = bounds%endc
-
- call restartvar(ncid=ncid, flag=flag, varname='coszen', xtype=ncd_double, &
- dim1name='column', &
- long_name='cosine of solar zenith angle', units='unitless', &
- interpinic_flag='interp', readvar=readvar, data=this%coszen_col)
-
- call restartvar(ncid=ncid, flag=flag, varname='albd', xtype=ncd_double, &
- dim1name='pft', dim2name='numrad', switchdim=.true., &
- long_name='surface albedo (direct) (0 to 1)', units='', &
- interpinic_flag='interp', readvar=readvar, data=this%albd_patch)
-
- call restartvar(ncid=ncid, flag=flag, varname='albi', xtype=ncd_double, &
- dim1name='pft', dim2name='numrad', switchdim=.true., &
- long_name='surface albedo (diffuse) (0 to 1)', units='', &
- interpinic_flag='interp', readvar=readvar, data=this%albi_patch)
-
- call restartvar(ncid=ncid, flag=flag, varname='albgrd', xtype=ncd_double, &
- dim1name='column', dim2name='numrad', switchdim=.true., &
- long_name='ground albedo (direct) (0 to 1)', units='', &
- interpinic_flag='interp', readvar=readvar, data=this%albgrd_col)
-
- call restartvar(ncid=ncid, flag=flag, varname='albgri', xtype=ncd_double, &
- dim1name='column', dim2name='numrad', switchdim=.true., &
- long_name='ground albedo (indirect) (0 to 1)', units='', &
- interpinic_flag='interp', readvar=readvar, data=this%albgri_col)
-
- call restartvar(ncid=ncid, flag=flag, varname='albsod', xtype=ncd_double, &
- dim1name='column', dim2name='numrad', switchdim=.true., &
- long_name='soil albedo (direct) (0 to 1)', units='', &
- interpinic_flag='interp', readvar=readvar, data=this%albsod_col)
-
- call restartvar(ncid=ncid, flag=flag, varname='albsoi', xtype=ncd_double, &
- dim1name='column', dim2name='numrad', switchdim=.true., &
- long_name='soil albedo (indirect) (0 to 1)', units='', &
- interpinic_flag='interp', readvar=readvar, data=this%albsoi_col)
-
- call restartvar(ncid=ncid, flag=flag, varname='albsnd_hst', xtype=ncd_double, &
- dim1name='column', dim2name='numrad', switchdim=.true., &
- long_name='snow albedo (direct) (0 to 1)', units='proportion', &
- interpinic_flag='interp', readvar=readvar, data=this%albsnd_hst_col)
-
- call restartvar(ncid=ncid, flag=flag, varname='albsni_hst', xtype=ncd_double, &
- dim1name='column', dim2name='numrad', switchdim=.true., &
- long_name='snow albedo (diffuse) (0 to 1)', units='proportion', &
- interpinic_flag='interp', readvar=readvar, data=this%albsni_hst_col)
-
- call restartvar(ncid=ncid, flag=flag, varname='tlai_z', xtype=ncd_double, &
- dim1name='pft', dim2name='levcan', switchdim=.true., &
- long_name='tlai increment for canopy layer', units='', &
- interpinic_flag='interp', readvar=readvar, data=this%tlai_z_patch)
- if (flag=='read' .and. .not. readvar) then
- if (masterproc) then
- write(iulog,*) "can't find tlai_z in restart (or initial) file..."
- write(iulog,*) "Initialize tlai_z to tlai/nlevcan"
- end if
- do iv=1,nlevcan
- this%tlai_z_patch(begp:endp,iv) = tlai_patch(begp:endp) / nlevcan
- end do
- end if
-
- call restartvar(ncid=ncid, flag=flag, varname='tsai_z', xtype=ncd_double, &
- dim1name='pft', dim2name='levcan', switchdim=.true., &
- long_name='tsai increment for canopy layer', units='', &
- interpinic_flag='interp', readvar=readvar, data=this%tsai_z_patch)
- if (flag=='read' .and. .not. readvar) then
- if (masterproc) then
- write(iulog,*) "can't find tsai_z in restart (or initial) file..."
- write(iulog,*) "Initialize tsai_z to tsai/nlevcan"
- end if
- do iv=1,nlevcan
- this%tsai_z_patch(begp:endp,iv) = tsai_patch(begp:endp) / nlevcan
- end do
- end if
-
- call restartvar(ncid=ncid, flag=flag, varname='ncan', xtype=ncd_int, &
- dim1name='pft', long_name='number of canopy layers', units='', &
- interpinic_flag='interp', readvar=readvar, data=this%ncan_patch)
- if (flag=='read' .and. .not. readvar) then
- if (masterproc) write(iulog,*) "can't find ncan in restart (or initial) file..."
- if (masterproc) write(iulog,*) "Initialize ncan to nlevcan"
- this%ncan_patch(begp:endp) = nlevcan
- end if
-
- call restartvar(ncid=ncid, flag=flag, varname='nrad', xtype=ncd_int, &
- dim1name='pft', long_name='number of canopy layers, above snow for radiative transfer', units='', &
- interpinic_flag='interp', readvar=readvar, data=this%nrad_patch)
- if (flag=='read' .and. .not. readvar) then
- if (masterproc) write(iulog,*) "can't find nrad in restart (or initial) file..."
- if (masterproc) write(iulog,*) "Initialize nrad to nlevcan"
- this%nrad_patch(begp:endp) = nlevcan
- end if
-
- call restartvar(ncid=ncid, flag=flag, varname='fsun_z', xtype=ncd_double, &
- dim1name='pft', dim2name='levcan', switchdim=.true., &
- long_name='sunlit fraction for canopy layer', units='', &
- interpinic_flag='interp', readvar=readvar, data=this%fsun_z_patch)
- if (flag=='read' .and. .not. readvar) then
- if (masterproc) write(iulog,*) "can't find fsun_z in restart (or initial) file..."
- if (masterproc) write(iulog,*) "Initialize fsun_z to 0"
- do iv=1,nlevcan
- this%fsun_z_patch(begp:endp,iv) = 0._r8
- end do
- end if
-
- call restartvar(ncid=ncid, flag=flag, varname='vcmaxcintsun', xtype=ncd_double, &
- dim1name='pft', long_name='sunlit canopy scaling coefficient', units='', &
- interpinic_flag='interp', readvar=readvar, data=this%vcmaxcintsun_patch)
- if (flag=='read' .and. .not. readvar) then
- if (masterproc) write(iulog,*) "can't find vcmaxcintsun in restart (or initial) file..."
- if (masterproc) write(iulog,*) "Initialize vcmaxcintsun to 1"
- this%vcmaxcintsun_patch(begp:endp) = 1._r8
- end if
-
- call restartvar(ncid=ncid, flag=flag, varname='vcmaxcintsha', xtype=ncd_double, &
- dim1name='pft', long_name='shaded canopy scaling coefficient', units='', &
- interpinic_flag='interp', readvar=readvar, data=this%vcmaxcintsha_patch)
- if (flag=='read' .and. .not. readvar) then
- if (masterproc) write(iulog,*) "can't find vcmaxcintsha in restart (or initial) file..."
- if (masterproc) write(iulog,*) "Initialize vcmaxcintsha to 1"
- this%vcmaxcintsha_patch(begp:endp) = 1._r8
- end if
-
- if (use_snicar_frc) then
-
- call restartvar(ncid=ncid, flag=flag, varname='albgrd_bc', xtype=ncd_double, &
- dim1name='column', dim2name='numrad', switchdim=.true., &
- long_name='ground albedo without BC (direct) (0 to 1)', units='', &
- interpinic_flag='interp',readvar=readvar, data=this%albgrd_bc_col)
- if (flag=='read' .and. .not. readvar) then
- if (masterproc) write(iulog,*) "SNICAR: can't find albgrd_bc in initial file..."
- if (masterproc) write(iulog,*) "Initialize albgrd_bc to albgrd"
- this%albgrd_bc_col(begc:endc,:) = this%albgrd_col(begc:endc,:)
- end if
-
- call restartvar(ncid=ncid, flag=flag, varname='albgri_bc', xtype=ncd_double, &
- dim1name='column', dim2name='numrad', switchdim=.true., &
- long_name='ground albedo without BC (diffuse) (0 to 1)', units='', &
- interpinic_flag='interp', readvar=readvar, data=this%albgri_bc_col)
- if (flag=='read' .and. .not. readvar) then
- if (masterproc) write(iulog,*) "SNICAR: can't find albgri_bc in initial file..."
- if (masterproc) write(iulog,*) "Initialize albgri_bc to albgri"
- this%albgri_bc_col(begc:endc,:) = this%albgri_col(begc:endc,:)
- end if
-
- call restartvar(ncid=ncid, flag=flag, varname='albgrd_pur', xtype=ncd_double, &
- dim1name='column', dim2name='numrad', switchdim=.true., &
- long_name='pure snow ground albedo (direct) (0 to 1)', units='', &
- interpinic_flag='interp', readvar=readvar, data=this%albgrd_pur_col)
- if (flag=='read' .and. .not. readvar) then
- if (masterproc) write(iulog,*) "SNICAR: can't find albgrd_pur in initial file..."
- if (masterproc) write(iulog,*) "Initialize albgrd_pur to albgrd"
- this%albgrd_pur_col(begc:endc,:) = this%albgrd_col(begc:endc,:)
- end if
-
- call restartvar(ncid=ncid, flag=flag, varname='albgri_pur', xtype=ncd_double, &
- dim1name='column', dim2name='numrad', switchdim=.true., &
- long_name='pure snow ground albedo (diffuse) (0 to 1)', units='', &
- interpinic_flag='interp', readvar=readvar, data=this%albgri_pur_col)
- if (flag=='read' .and. .not. readvar) then
- if (masterproc) write(iulog,*) "SNICAR: can't find albgri_pur in initial file..."
- if (masterproc) write(iulog,*) "Initialize albgri_pur to albgri"
- this%albgri_pur_col(begc:endc,:) = this%albgri_col(begc:endc,:)
- end if
-
- call restartvar(ncid=ncid, flag=flag, varname='albgrd_oc', xtype=ncd_double, &
- dim1name='column', dim2name='numrad', switchdim=.true., &
- long_name='ground albedo without OC (direct) (0 to 1)', units='', &
- interpinic_flag='interp', readvar=readvar, data=this%albgrd_oc_col)
- if (flag=='read' .and. .not. readvar) then
- if (masterproc) write(iulog,*) "SNICAR: can't find albgrd_oc in initial file..."
- if (masterproc) write(iulog,*) "Initialize albgrd_oc to albgrd"
- this%albgrd_oc_col(begc:endc,:) = this%albgrd_col(begc:endc,:)
- end if
-
- call restartvar(ncid=ncid, flag=flag, varname='albgri_oc', xtype=ncd_double, &
- dim1name='column', dim2name='numrad', switchdim=.true., &
- long_name='ground albedo without OC (diffuse) (0 to 1)', units='', &
- interpinic_flag='interp', readvar=readvar, data=this%albgri_oc_col)
- if (flag=='read' .and. .not. readvar) then
- if (masterproc) write(iulog,*) "SNICAR: can't find albgri_oc in restart (or initial) file..."
- if (masterproc) write(iulog,*) "Initialize albgri_oc to albgri"
- this%albgri_oc_col(begc:endc,:) = this%albgri_col(begc:endc,:)
- end if
-
- call restartvar(ncid=ncid, flag=flag, varname='albgrd_dst', xtype=ncd_double, &
- dim1name='column', dim2name='numrad', switchdim=.true., &
- long_name='ground albedo without dust (direct) (0 to 1)', units='', &
- interpinic_flag='interp', readvar=readvar, data=this%albgrd_dst_col)
- if (flag=='read' .and. .not. readvar) then
- if (masterproc) write(iulog,*) "SNICAR: can't find albgrd_dst in initial file..."
- if (masterproc) write(iulog,*) "Initialize albgrd_dst to albgrd"
- this%albgrd_dst_col(begc:endc,:) = this%albgrd_col(begc:endc,:)
- end if
-
- call restartvar(ncid=ncid, flag=flag, varname='albgri_dst', xtype=ncd_double, &
- dim1name='column', dim2name='numrad', switchdim=.true., &
- long_name='ground albedo without dust (diffuse) (0 to 1)', units='', &
- interpinic_flag='interp', readvar=readvar, data=this%albgri_dst_col)
- if (flag=='read' .and. .not. readvar) then
- if (masterproc) write(iulog,*) "SNICAR: can't find albgri_dst in initial file..."
- if (masterproc) write(iulog,*) "Initialize albgri_dst to albgri"
- this%albgri_dst_col(begc:endc,:) = this%albgri_col(begc:endc,:)
- end if
-
- end if ! end of if-use_snicar_frc
-
- ! patch type physical state variable - fabd
- call restartvar(ncid=ncid, flag=flag, varname='fabd', xtype=ncd_double, &
- dim1name='pft', dim2name='numrad', switchdim=.true., &
- long_name='flux absorbed by veg per unit direct flux', units='', &
- interpinic_flag='interp', readvar=readvar, data=this%fabd_patch)
-
- call restartvar(ncid=ncid, flag=flag, varname='fabi', xtype=ncd_double, &
- dim1name='pft', dim2name='numrad', switchdim=.true., &
- long_name='flux absorbed by veg per unit diffuse flux', units='', &
- interpinic_flag='interp', readvar=readvar, data=this%fabi_patch)
-
- call restartvar(ncid=ncid, flag=flag, varname='fabd_sun', xtype=ncd_double, &
- dim1name='pft', dim2name='numrad', switchdim=.true., &
- long_name='flux absorbed by sunlit leaf per unit direct flux', units='', &
- interpinic_flag='interp', readvar=readvar, data=this%fabd_sun_patch)
- if (flag=='read' .and. .not. readvar) then
- if (masterproc) write(iulog,*) "can't find fabd_sun in restart (or initial) file..."
- if (masterproc) write(iulog,*) "Initialize fabd_sun to fabd/2"
- this%fabd_sun_patch(begp:endp,:) = this%fabd_patch(begp:endp,:)/2._r8
- end if
-
- call restartvar(ncid=ncid, flag=flag, varname='fabd_sha', xtype=ncd_double, &
- dim1name='pft', dim2name='numrad', switchdim=.true., &
- long_name='flux absorbed by shaded leaf per unit direct flux', units='', &
- interpinic_flag='interp', readvar=readvar, data=this%fabd_sha_patch)
- if (flag=='read' .and. .not. readvar) then
- if (masterproc) write(iulog,*) "can't find fabd_sha in restart (or initial) file..."
- if (masterproc) write(iulog,*) "Initialize fabd_sha to fabd/2"
- this%fabd_sha_patch(begp:endp,:) = this%fabd_patch(begp:endp,:)/2._r8
- end if
-
- call restartvar(ncid=ncid, flag=flag, varname='fabi_sun', xtype=ncd_double, &
- dim1name='pft', dim2name='numrad', switchdim=.true., &
- long_name='flux absorbed by sunlit leaf per unit diffuse flux', units='', &
- interpinic_flag='interp', readvar=readvar, data=this%fabi_sun_patch)
- if (flag=='read' .and. .not. readvar) then
- if (masterproc) write(iulog,*) "can't find fabi_sun in restart (or initial) file..."
- if (masterproc) write(iulog,*) "Initialize fabi_sun to fabi/2"
- this%fabi_sun_patch(begp:endp,:) = this%fabi_patch(begp:endp,:)/2._r8
- end if
-
- call restartvar(ncid=ncid, flag=flag, varname='fabi_sha', xtype=ncd_double, &
- dim1name='pft', dim2name='numrad', switchdim=.true., &
- long_name='flux absorbed by shaded leaf per unit diffuse flux', units='', &
- interpinic_flag='interp', readvar=readvar, data=this%fabi_sha_patch)
- if (flag=='read' .and. .not. readvar) then
- if (masterproc) write(iulog,*) "can't find fabi_sha in restart (or initial) file..."
- if (masterproc) write(iulog,*) "Initialize fabi_sha to fabi/2"
- this%fabi_sha_patch(begp:endp,:) = this%fabi_patch(begp:endp,:)/2._r8
- end if
-
- call restartvar(ncid=ncid, flag=flag, varname='fabd_sun_z', xtype=ncd_double, &
- dim1name='pft', dim2name='levcan', switchdim=.true., &
- long_name='absorbed sunlit leaf direct PAR (per unit lai+sai) for canopy layer', units='', &
- interpinic_flag='interp', readvar=readvar, data=this%fabd_sun_z_patch)
- if (flag=='read' .and. .not. readvar) then
- if (masterproc) write(iulog,*) "can't find fabd_sun_z in restart (or initial) file..."
- if (masterproc) write(iulog,*) "Initialize fabd_sun_z to (fabd/2)/nlevcan"
- do iv=1,nlevcan
- this%fabd_sun_z_patch(begp:endp,iv) = (this%fabd_patch(begp:endp,1)/2._r8)/nlevcan
- end do
- end if
-
- call restartvar(ncid=ncid, flag=flag, varname='fabd_sha_z', xtype=ncd_double, &
- dim1name='pft', dim2name='levcan', switchdim=.true., &
- long_name='absorbed shaded leaf direct PAR (per unit lai+sai) for canopy layer', units='', &
- interpinic_flag='interp', readvar=readvar, data=this%fabd_sha_z_patch)
- if (flag=='read' .and. .not. readvar) then
- if (masterproc) write(iulog,*) "can't find fabd_sha_z in restart (or initial) file..."
- if (masterproc) write(iulog,*) "Initialize fabd_sha_z to (fabd/2)/nlevcan"
- do iv=1,nlevcan
- this%fabd_sha_z_patch(begp:endp,iv) = (this%fabd_patch(begp:endp,1)/2._r8)/nlevcan
- end do
- end if
-
- call restartvar(ncid=ncid, flag=flag, varname='fabi_sun_z', xtype=ncd_double, &
- dim1name='pft', dim2name='levcan', switchdim=.true., &
- long_name='absorbed sunlit leaf diffuse PAR (per unit lai+sai) for canopy layer', units='', &
- interpinic_flag='interp', readvar=readvar, data=this%fabi_sun_z_patch)
- if (flag=='read' .and. .not. readvar) then
- if (masterproc) write(iulog,*) "can't find fabi_sun_z in restart (or initial) file..."
- if (masterproc) write(iulog,*) "Initialize fabi_sun_z to (fabi/2)/nlevcan"
- do iv=1,nlevcan
- this%fabi_sun_z_patch(begp:endp,iv) = (this%fabi_patch(begp:endp,1)/2._r8)/nlevcan
- end do
- end if
-
- call restartvar(ncid=ncid, flag=flag, varname='fabi_sha_z', xtype=ncd_double, &
- dim1name='pft', dim2name='levcan', switchdim=.true., &
- long_name='absorbed shaded leaf diffuse PAR (per unit lai+sai) for canopy layer', units='', &
- interpinic_flag='interp', readvar=readvar, data=this%fabi_sha_z_patch)
- if (flag=='read' .and. .not. readvar) then
- if (masterproc) write(iulog,*) "can't find fabi_sha_z in restart (or initial) file..."
- if (masterproc) write(iulog,*) "Initialize fabi_sha_z to (fabi/2)/nlevcan"
- do iv=1,nlevcan
- this%fabi_sha_z_patch(begp:endp,iv) = &
- (this%fabi_patch(begp:endp,1)/2._r8)/nlevcan
- end do
- end if
-
- call restartvar(ncid=ncid, flag=flag, varname='ftdd', xtype=ncd_double, &
- dim1name='pft', dim2name='numrad', switchdim=.true., &
- long_name='down direct flux below veg per unit direct flux', units='', &
- interpinic_flag='interp', readvar=readvar, data=this%ftdd_patch)
-
- call restartvar(ncid=ncid, flag=flag, varname='ftid', xtype=ncd_double, &
- dim1name='pft', dim2name='numrad', switchdim=.true., &
- long_name='down diffuse flux below veg per unit direct flux', units='', &
- interpinic_flag='interp', readvar=readvar, data=this%ftid_patch)
-
- call restartvar(ncid=ncid, flag=flag, varname='ftii', xtype=ncd_double, &
- dim1name='pft', dim2name='numrad', switchdim=.true., &
- long_name='down diffuse flux below veg per unit diffuse flux', units='', &
- interpinic_flag='interp', readvar=readvar, data=this%ftii_patch)
-
- !--------------------------------
- ! variables needed for SNICAR
- !--------------------------------
-
- call restartvar(ncid=ncid, flag=flag, varname='flx_absdv', xtype=ncd_double, &
- dim1name='column', dim2name='levsno1', switchdim=.true., lowerb2=-nlevsno+1, upperb2=1, &
- long_name='snow layer flux absorption factors (direct, VIS)', units='fraction', &
- interpinic_flag='interp', readvar=readvar, data=this%flx_absdv_col)
-
- call restartvar(ncid=ncid, flag=flag, varname='flx_absdn', xtype=ncd_double, &
- dim1name='column', dim2name='levsno1', switchdim=.true., lowerb2=-nlevsno+1, upperb2=1, &
- long_name='snow layer flux absorption factors (direct, NIR)', units='fraction', &
- interpinic_flag='interp', readvar=readvar, data=this%flx_absdn_col)
-
- call restartvar(ncid=ncid, flag=flag, varname='flx_absiv', xtype=ncd_double, &
- dim1name='column', dim2name='levsno1', switchdim=.true., lowerb2=-nlevsno+1, upperb2=1, &
- long_name='snow layer flux absorption factors (diffuse, VIS)', units='fraction', &
- interpinic_flag='interp', readvar=readvar, data=this%flx_absiv_col)
-
- call restartvar(ncid=ncid, flag=flag, varname='flx_absin', xtype=ncd_double, &
- dim1name='column', dim2name='levsno1', switchdim=.true., lowerb2=-nlevsno+1, upperb2=1, &
- long_name='snow layer flux absorption factors (diffuse, NIR)', units='fraction', &
- interpinic_flag='interp', readvar=readvar, data=this%flx_absin_col)
-
- end subroutine Restart
-
-end module SurfaceAlbedoType
diff --git a/src/biogeophys/SurfaceRadiationMod.F90 b/src/biogeophys/SurfaceRadiationMod.F90
deleted file mode 100644
index f021c6fd..00000000
--- a/src/biogeophys/SurfaceRadiationMod.F90
+++ /dev/null
@@ -1,304 +0,0 @@
-module SurfaceRadiationMod
-
- !------------------------------------------------------------------------------
- ! !DESCRIPTION:
- ! Calculate solar fluxes absorbed by vegetation and ground surface
- !
- ! !USES:
- use shr_kind_mod , only : r8 => shr_kind_r8
- use shr_log_mod , only : errMsg => shr_log_errMsg
- use clm_varctl , only : use_snicar_frc, use_fates
- use decompMod , only : bounds_type
- use clm_varcon , only : namec
- use atm2lndType , only : atm2lnd_type
- use WaterstateType , only : waterstate_type
- use CanopyStateType , only : canopystate_type
- use SurfaceAlbedoType , only : surfalb_type
- use SolarAbsorbedType , only : solarabs_type
- use GridcellType , only : grc
- use LandunitType , only : lun
- use ColumnType , only : col
- use PatchType , only : patch
-
- !
- ! !PRIVATE TYPES:
- implicit none
- private
-
- logical :: DEBUG = .false. ! for debugging this module
-
- !
- ! !PUBLIC MEMBER FUNCTIONS:
-
- !
- ! !PRIVATE DATA:
- type, public :: surfrad_type
- real(r8), pointer, private :: sfc_frc_aer_patch (:) ! patch surface forcing of snow with all aerosols (patch) [W/m2]
- real(r8), pointer, private :: sfc_frc_bc_patch (:) ! patch surface forcing of snow with BC (patch) [W/m2]
- real(r8), pointer, private :: sfc_frc_oc_patch (:) ! patch surface forcing of snow with OC (patch) [W/m2]
- real(r8), pointer, private :: sfc_frc_dst_patch (:) ! patch surface forcing of snow with dust (patch) [W/m2]
- real(r8), pointer, private :: sfc_frc_aer_sno_patch (:) ! patch surface forcing of snow with all aerosols, averaged only when snow is present (patch) [W/m2]
- real(r8), pointer, private :: sfc_frc_bc_sno_patch (:) ! patch surface forcing of snow with BC, averaged only when snow is present (patch) [W/m2]
- real(r8), pointer, private :: sfc_frc_oc_sno_patch (:) ! patch surface forcing of snow with OC, averaged only when snow is present (patch) [W/m2]
- real(r8), pointer, private :: sfc_frc_dst_sno_patch (:) ! patch surface forcing of snow with dust, averaged only when snow is present (patch) [W/m2]
-
- real(r8), pointer, private :: parveg_ln_patch (:) ! patch absorbed par by vegetation at local noon (W/m**2)
-
- real(r8), pointer, private :: fsr_sno_vd_patch (:) ! patch reflected direct beam vis solar radiation from snow (W/m**2)
- real(r8), pointer, private :: fsr_sno_nd_patch (:) ! patch reflected direct beam NIR solar radiation from snow (W/m**2)
- real(r8), pointer, private :: fsr_sno_vi_patch (:) ! patch reflected diffuse vis solar radiation from snow (W/m**2)
- real(r8), pointer, private :: fsr_sno_ni_patch (:) ! patch reflected diffuse NIR solar radiation from snow (W/m**2)
-
- real(r8), pointer, private :: fsr_vis_d_patch (:) ! patch reflected direct beam vis solar radiation (W/m**2)
- real(r8), pointer, private :: fsr_vis_i_patch (:) ! patch reflected diffuse vis solar radiation (W/m**2)
- real(r8), pointer, private :: fsr_vis_d_ln_patch (:) ! patch reflected direct beam vis solar radiation at local noon (W/m**2)
-
- real(r8), pointer, private :: fsds_sno_vd_patch (:) ! patch incident visible, direct radiation on snow (for history files) [W/m2]
- real(r8), pointer, private :: fsds_sno_nd_patch (:) ! patch incident near-IR, direct radiation on snow (for history files) [W/m2]
- real(r8), pointer, private :: fsds_sno_vi_patch (:) ! patch incident visible, diffuse radiation on snow (for history files) [W/m2]
- real(r8), pointer, private :: fsds_sno_ni_patch (:) ! patch incident near-IR, diffuse radiation on snow (for history files) [W/m2]
-
- real(r8), pointer, private :: fsds_vis_d_patch (:) ! patch incident direct beam vis solar radiation (W/m**2)
- real(r8), pointer, private :: fsds_vis_i_patch (:) ! patch incident diffuse vis solar radiation (W/m**2)
- real(r8), pointer, private :: fsds_vis_d_ln_patch (:) ! patch incident direct beam vis solar radiation at local noon (W/m**2)
- real(r8), pointer, private :: fsds_vis_i_ln_patch (:) ! patch incident diffuse beam vis solar radiation at local noon (W/m**2)
-
- contains
-
- procedure, public :: Init
- procedure, private :: InitAllocate
- procedure, private :: InitHistory
- procedure, private :: InitCold
-
- end type surfrad_type
-
- character(len=*), parameter, private :: sourcefile = &
- __FILE__
- !-----------------------------------------------------------------------
-
-contains
-
- !------------------------------------------------------------------------
- subroutine Init(this, bounds)
-
- class(surfrad_type) :: this
- type(bounds_type), intent(in) :: bounds
-
- call this%InitAllocate(bounds)
- call this%InitHistory(bounds)
- call this%InitCold(bounds)
-
- end subroutine Init
-
- !-----------------------------------------------------------------------
- subroutine InitAllocate(this, bounds)
- !
- ! !USES:
- use shr_infnan_mod, only : nan => shr_infnan_nan, assignment(=)
- !
- ! !ARGUMENTS:
- class(surfrad_type) :: this
- type(bounds_type), intent(in) :: bounds
- !
- ! !LOCAL VARIABLES:
- integer :: begp, endp
- !---------------------------------------------------------------------
-
- begp = bounds%begp; endp = bounds%endp
-
- allocate(this%sfc_frc_aer_patch (begp:endp)) ; this%sfc_frc_aer_patch (:) = nan
- allocate(this%sfc_frc_bc_patch (begp:endp)) ; this%sfc_frc_bc_patch (:) = nan
- allocate(this%sfc_frc_oc_patch (begp:endp)) ; this%sfc_frc_oc_patch (:) = nan
- allocate(this%sfc_frc_dst_patch (begp:endp)) ; this%sfc_frc_dst_patch (:) = nan
- allocate(this%sfc_frc_aer_sno_patch (begp:endp)) ; this%sfc_frc_aer_sno_patch (:) = nan
- allocate(this%sfc_frc_bc_sno_patch (begp:endp)) ; this%sfc_frc_bc_sno_patch (:) = nan
- allocate(this%sfc_frc_oc_sno_patch (begp:endp)) ; this%sfc_frc_oc_sno_patch (:) = nan
- allocate(this%sfc_frc_dst_sno_patch (begp:endp)) ; this%sfc_frc_dst_sno_patch (:) = nan
-
- allocate(this%parveg_ln_patch (begp:endp)) ; this%parveg_ln_patch (:) = nan
-
- allocate(this%fsr_vis_d_patch (begp:endp)) ; this%fsr_vis_d_patch (:) = nan
- allocate(this%fsr_vis_d_ln_patch (begp:endp)) ; this%fsr_vis_d_ln_patch (:) = nan
- allocate(this%fsr_vis_i_patch (begp:endp)) ; this%fsr_vis_i_patch (:) = nan
- allocate(this%fsr_sno_vd_patch (begp:endp)) ; this%fsr_sno_vd_patch (:) = nan
- allocate(this%fsr_sno_nd_patch (begp:endp)) ; this%fsr_sno_nd_patch (:) = nan
- allocate(this%fsr_sno_vi_patch (begp:endp)) ; this%fsr_sno_vi_patch (:) = nan
- allocate(this%fsr_sno_ni_patch (begp:endp)) ; this%fsr_sno_ni_patch (:) = nan
-
- allocate(this%fsds_vis_d_patch (begp:endp)) ; this%fsds_vis_d_patch (:) = nan
- allocate(this%fsds_vis_i_patch (begp:endp)) ; this%fsds_vis_i_patch (:) = nan
- allocate(this%fsds_vis_d_ln_patch (begp:endp)) ; this%fsds_vis_d_ln_patch (:) = nan
- allocate(this%fsds_vis_i_ln_patch (begp:endp)) ; this%fsds_vis_i_ln_patch (:) = nan
- allocate(this%fsds_sno_vd_patch (begp:endp)) ; this%fsds_sno_vd_patch (:) = nan
- allocate(this%fsds_sno_nd_patch (begp:endp)) ; this%fsds_sno_nd_patch (:) = nan
- allocate(this%fsds_sno_vi_patch (begp:endp)) ; this%fsds_sno_vi_patch (:) = nan
- allocate(this%fsds_sno_ni_patch (begp:endp)) ; this%fsds_sno_ni_patch (:) = nan
-
- end subroutine InitAllocate
-
- !-----------------------------------------------------------------------
- subroutine InitHistory(this, bounds)
- !
- ! History fields initialization
- !
- ! !USES:
- use shr_infnan_mod, only : nan => shr_infnan_nan, assignment(=)
- use clm_varcon , only : spval
- use histFileMod , only : hist_addfld1d, hist_addfld2d
- !
- ! !ARGUMENTS:
- class(surfrad_type) :: this
- type(bounds_type), intent(in) :: bounds
- !
- ! !LOCAL VARIABLES:
- integer :: begp, endp
- integer :: begc, endc
- real(r8), pointer :: data2dptr(:,:) ! temp. pointers for slicing larger arrays
- !---------------------------------------------------------------------
-
- begp = bounds%begp; endp = bounds%endp
- begc = bounds%begc; endc = bounds%endc
-
- if (use_snicar_frc) then
- this%sfc_frc_aer_patch(begp:endp) = spval
- call hist_addfld1d (fname='SNOAERFRCL', units='W/m^2', &
- avgflag='A', long_name='surface forcing of all aerosols in snow (land) ', &
- ptr_patch=this%sfc_frc_aer_patch, set_urb=spval, default='inactive')
-
- this%sfc_frc_aer_sno_patch(begp:endp) = spval
- call hist_addfld1d (fname='SNOAERFRC2L', units='W/m^2', &
- avgflag='A', long_name='surface forcing of all aerosols in snow, averaged only when snow is present (land)', &
- ptr_patch=this%sfc_frc_aer_sno_patch, set_urb=spval, default='inactive')
-
- this%sfc_frc_bc_patch(begp:endp) = spval
- call hist_addfld1d (fname='SNOBCFRCL', units='W/m^2', &
- avgflag='A', long_name='surface forcing of BC in snow (land) ', &
- ptr_patch=this%sfc_frc_bc_patch, set_urb=spval, default='inactive')
-
- this%sfc_frc_bc_sno_patch(begp:endp) = spval
- call hist_addfld1d (fname='SNOBCFRC2L', units='W/m^2', &
- avgflag='A', long_name='surface forcing of BC in snow, averaged only when snow is present (land)', &
- ptr_patch=this%sfc_frc_bc_sno_patch, set_urb=spval, default='inactive')
-
- this%sfc_frc_oc_patch(begp:endp) = spval
- call hist_addfld1d (fname='SNOOCFRCL', units='W/m^2', &
- avgflag='A', long_name='surface forcing of OC in snow (land) ', &
- ptr_patch=this%sfc_frc_oc_patch, set_urb=spval, default='inactive')
-
- this%sfc_frc_oc_sno_patch(begp:endp) = spval
- call hist_addfld1d (fname='SNOOCFRC2L', units='W/m^2', &
- avgflag='A', long_name='surface forcing of OC in snow, averaged only when snow is present (land)', &
- ptr_patch=this%sfc_frc_oc_sno_patch, set_urb=spval, default='inactive')
-
- this%sfc_frc_dst_patch(begp:endp) = spval
- call hist_addfld1d (fname='SNODSTFRCL', units='W/m^2', &
- avgflag='A', long_name='surface forcing of dust in snow (land) ', &
- ptr_patch=this%sfc_frc_dst_patch, set_urb=spval, default='inactive')
-
- this%sfc_frc_dst_sno_patch(begp:endp) = spval
- call hist_addfld1d (fname='SNODSTFRC2L', units='W/m^2', &
- avgflag='A', long_name='surface forcing of dust in snow, averaged only when snow is present (land)', &
- ptr_patch=this%sfc_frc_dst_sno_patch, set_urb=spval, default='inactive')
- end if
-
- this%fsds_vis_d_patch(begp:endp) = spval
- call hist_addfld1d (fname='FSDSVD', units='W/m^2', &
- avgflag='A', long_name='direct vis incident solar radiation', &
- ptr_patch=this%fsds_vis_d_patch, default='inactive')
-
- this%fsds_vis_i_patch(begp:endp) = spval
- call hist_addfld1d (fname='FSDSVI', units='W/m^2', &
- avgflag='A', long_name='diffuse vis incident solar radiation', &
- ptr_patch=this%fsds_vis_i_patch, default='inactive')
-
- this%fsr_vis_d_patch(begp:endp) = spval
- call hist_addfld1d (fname='FSRVD', units='W/m^2', &
- avgflag='A', long_name='direct vis reflected solar radiation', &
- ptr_patch=this%fsr_vis_d_patch, c2l_scale_type='urbanf', default='inactive')
-
- this%fsr_vis_i_patch(begp:endp) = spval
- call hist_addfld1d (fname='FSRVI', units='W/m^2', &
- avgflag='A', long_name='diffuse vis reflected solar radiation', &
- ptr_patch=this%fsr_vis_i_patch, c2l_scale_type='urbanf', default='inactive')
-
- this%fsds_vis_d_ln_patch(begp:endp) = spval
- call hist_addfld1d (fname='FSDSVDLN', units='W/m^2', &
- avgflag='A', long_name='direct vis incident solar radiation at local noon', &
- ptr_patch=this%fsds_vis_d_ln_patch, default='inactive')
-
- this%fsds_vis_i_ln_patch(begp:endp) = spval
- call hist_addfld1d (fname='FSDSVILN', units='W/m^2', &
- avgflag='A', long_name='diffuse vis incident solar radiation at local noon', &
- ptr_patch=this%fsds_vis_i_ln_patch, default='inactive')
-
- this%parveg_ln_patch(begp:endp) = spval
- call hist_addfld1d (fname='PARVEGLN', units='W/m^2', &
- avgflag='A', long_name='absorbed par by vegetation at local noon', &
- ptr_patch=this%parveg_ln_patch, default='inactive')
-
- this%fsr_vis_d_ln_patch(begp:endp) = spval
- call hist_addfld1d (fname='FSRVDLN', units='W/m^2', &
- avgflag='A', long_name='direct vis reflected solar radiation at local noon', &
- ptr_patch=this%fsr_vis_d_ln_patch, c2l_scale_type='urbanf', default='inactive')
-
- this%fsds_sno_vd_patch(begp:endp) = spval
- call hist_addfld1d (fname='SNOFSDSVD', units='W/m^2', &
- avgflag='A', long_name='direct vis incident solar radiation on snow', &
- ptr_patch=this%fsds_sno_vd_patch, default='inactive')
-
- this%fsds_sno_nd_patch(begp:endp) = spval
- call hist_addfld1d (fname='SNOFSDSND', units='W/m^2', &
- avgflag='A', long_name='direct nir incident solar radiation on snow', &
- ptr_patch=this%fsds_sno_nd_patch, default='inactive')
-
- this%fsds_sno_vi_patch(begp:endp) = spval
- call hist_addfld1d (fname='SNOFSDSVI', units='W/m^2', &
- avgflag='A', long_name='diffuse vis incident solar radiation on snow', &
- ptr_patch=this%fsds_sno_vi_patch, default='inactive')
-
- this%fsds_sno_ni_patch(begp:endp) = spval
- call hist_addfld1d (fname='SNOFSDSNI', units='W/m^2', &
- avgflag='A', long_name='diffuse nir incident solar radiation on snow', &
- ptr_patch=this%fsds_sno_ni_patch, default='inactive')
-
- this%fsr_sno_vd_patch(begp:endp) = spval
- call hist_addfld1d (fname='SNOFSRVD', units='W/m^2', &
- avgflag='A', long_name='direct vis reflected solar radiation from snow', &
- ptr_patch=this%fsr_sno_vd_patch, default='inactive')
-
- this%fsr_sno_nd_patch(begp:endp) = spval
- call hist_addfld1d (fname='SNOFSRND', units='W/m^2', &
- avgflag='A', long_name='direct nir reflected solar radiation from snow', &
- ptr_patch=this%fsr_sno_nd_patch, default='inactive')
-
- this%fsr_sno_vi_patch(begp:endp) = spval
- call hist_addfld1d (fname='SNOFSRVI', units='W/m^2', &
- avgflag='A', long_name='diffuse vis reflected solar radiation from snow', &
- ptr_patch=this%fsr_sno_vi_patch, default='inactive')
-
- this%fsr_sno_ni_patch(begp:endp) = spval
- call hist_addfld1d (fname='SNOFSRNI', units='W/m^2', &
- avgflag='A', long_name='diffuse nir reflected solar radiation from snow', &
- ptr_patch=this%fsr_sno_ni_patch, default='inactive')
-
-
- end subroutine InitHistory
-
- !------------------------------------------------------------------------
- subroutine InitCold(this, bounds)
- !
- ! !USES:
- !
- ! !ARGUMENTS:
- class(surfrad_type) :: this
- type(bounds_type), intent(in) :: bounds
- !
- ! !LOCAL VARIABLES:
- integer :: p,l
- !-----------------------------------------------------------------------
-
- ! nothing for now
-
- end subroutine InitCold
-
-end module SurfaceRadiationMod
diff --git a/src/biogeophys/SurfaceResistanceMod.F90 b/src/biogeophys/SurfaceResistanceMod.F90
deleted file mode 100644
index 76813b71..00000000
--- a/src/biogeophys/SurfaceResistanceMod.F90
+++ /dev/null
@@ -1,294 +0,0 @@
-module SurfaceResistanceMod
-
-#include "shr_assert.h"
-
- !-----------------------------------------------------------------------
- ! !DESCRIPTION:
- ! Module holding routines for calculation of surface resistances of the different tracers
- ! transported with BeTR. The surface here refers to water and soil, not including canopy
- !
- ! !USES:
- use shr_kind_mod , only: r8 => shr_kind_r8
- use shr_const_mod , only: SHR_CONST_TKFRZ
- use clm_varctl , only: iulog
- use SoilStateType , only: soilstate_type
- use WaterStateType, only: waterstate_type
- use TemperatureType , only : temperature_type
- implicit none
- save
- private
- integer :: soil_resis_method !choose the method for soil resistance calculation
-
- integer, parameter :: leepielke_1992 = 0 !
- integer, parameter :: sl_14 = 1
-
- !
- ! !PUBLIC MEMBER FUNCTIONS:
- public :: calc_soilevap_resis
- public :: do_soilevap_beta, do_soil_resistance_sl14
-
- character(len=*), parameter, private :: sourcefile = &
- __FILE__
- !
- ! !REVISION HISTORY:
- ! 6/25/2013 Created by Jinyun Tang
- !-----------------------------------------------------------------------
-
-contains
-
- !------------------------------------------------------------------------------
- subroutine calc_soilevap_resis(bounds, num_nolakec, filter_nolakec, &
- soilstate_inst, waterstate_inst, temperature_inst)
- !
- ! DESCRIPTIONS
- ! compute the resis factor for soil evaporation calculation
- !
- use shr_kind_mod , only : r8 => shr_kind_r8
- use shr_const_mod , only : SHR_CONST_PI
- use decompMod , only : bounds_type
- use ColumnType , only : col
- use LandunitType , only : lun
- use abortutils , only : endrun
- !
- ! !ARGUMENTS:
- implicit none
- type(bounds_type) , intent(in) :: bounds ! bounds
- integer , intent(in) :: num_nolakec
- integer , intent(in) :: filter_nolakec(:)
- type(soilstate_type) , intent(inout) :: soilstate_inst
- type(waterstate_type) , intent(in) :: waterstate_inst
- type(temperature_type), intent(in) :: temperature_inst
- character(len=32) :: subname = 'calc_soilevap_resis' ! subroutine name
- associate( &
- soilbeta => soilstate_inst%soilbeta_col , & ! Output: [real(r8) (:)] factor that reduces ground evaporation
- dsl => soilstate_inst%dsl_col , & ! Output: [real(r8) (:)] soil dry surface layer thickness
- soilresis => soilstate_inst%soilresis_col & ! Output: [real(r8) (:)] soil evaporative resistance
- )
-
- !select the right method and do the calculation
- select case (soil_resis_method)
-
- case (leepielke_1992)
- call calc_beta_leepielke1992(bounds, num_nolakec, filter_nolakec, &
- soilstate_inst, waterstate_inst, soilbeta(bounds%begc:bounds%endc))
-
- case (sl_14)
- call calc_soil_resistance_sl14(bounds, num_nolakec, filter_nolakec, &
- soilstate_inst, waterstate_inst,temperature_inst, &
- dsl(bounds%begc:bounds%endc), soilresis(bounds%begc:bounds%endc))
- case default
- call endrun(subname // ':: a soilevap resis function must be specified!')
- end select
-
- end associate
-
- end subroutine calc_soilevap_resis
-
- !------------------------------------------------------------------------------
- subroutine calc_beta_leepielke1992(bounds, num_nolakec, filter_nolakec, &
- soilstate_inst, waterstate_inst, soilbeta)
- !
- ! DESCRIPTION
- ! compute the lee-pielke beta factor to scal actual soil evaporation from potential evaporation
- !
- ! USES
- use shr_kind_mod , only : r8 => shr_kind_r8
- use shr_const_mod , only : SHR_CONST_PI
- use shr_log_mod , only : errMsg => shr_log_errMsg
- use shr_infnan_mod , only : nan => shr_infnan_nan, assignment(=)
- use decompMod , only : bounds_type
- use clm_varcon , only : denh2o, denice
- use landunit_varcon , only : istice_mec, istwet, istsoil, istcrop
- use column_varcon , only : icol_roof, icol_sunwall, icol_shadewall
- use column_varcon , only : icol_road_imperv, icol_road_perv
- use ColumnType , only : col
- use LandunitType , only : lun
- !
- implicit none
- type(bounds_type) , intent(in) :: bounds ! bounds
- integer , intent(in) :: num_nolakec
- integer , intent(in) :: filter_nolakec(:)
- type(soilstate_type) , intent(in) :: soilstate_inst
- type(waterstate_type) , intent(in) :: waterstate_inst
- real(r8) , intent(inout) :: soilbeta(bounds%begc:bounds%endc)
-
- !local variables
- real(r8) :: fac, fac_fc, wx !temporary variables
- integer :: c, l, fc !indices
-
- SHR_ASSERT_ALL((ubound(soilbeta) == (/bounds%endc/)), errMsg(sourcefile, __LINE__))
-
- associate( &
- watsat => soilstate_inst%watsat_col , & ! Input: [real(r8) (:,:)] volumetric soil water at saturation (porosity)
- watfc => soilstate_inst%watfc_col , & ! Input: [real(r8) (:,:)] volumetric soil water at field capacity
-
- h2osoi_ice => waterstate_inst%h2osoi_ice_col , & ! Input: [real(r8) (:,:)] ice lens (kg/m2)
- h2osoi_liq => waterstate_inst%h2osoi_liq_col , & ! Input: [real(r8) (:,:)] liquid water (kg/m2)
- frac_sno => waterstate_inst%frac_sno_col , & ! Input: [real(r8) (:)] fraction of ground covered by snow (0 to 1)
- frac_h2osfc => waterstate_inst%frac_h2osfc_col & ! Input: [real(r8) (:)] fraction of ground covered by surface water (0 to 1)
- )
-
- do fc = 1,num_nolakec
- c = filter_nolakec(fc)
- l = col%landunit(c)
- if (lun%itype(l)/=istwet .AND. lun%itype(l)/=istice_mec) then
- if (lun%itype(l) == istsoil .or. lun%itype(l) == istcrop) then
- wx = (h2osoi_liq(c,1)/denh2o+h2osoi_ice(c,1)/denice)/col%dz(c,1)
- fac = min(1._r8, wx/watsat(c,1))
- fac = max( fac, 0.01_r8 )
- !! Lee and Pielke 1992 beta, added by K.Sakaguchi
- if (wx < watfc(c,1) ) then !when water content of ths top layer is less than that at F.C.
- fac_fc = min(1._r8, wx/watfc(c,1)) !eqn5.66 but divided by theta at field capacity
- fac_fc = max( fac_fc, 0.01_r8 )
- ! modify soil beta by snow cover. soilbeta for snow surface is one
- soilbeta(c) = (1._r8-frac_sno(c)-frac_h2osfc(c)) &
- *0.25_r8*(1._r8 - cos(SHR_CONST_PI*fac_fc))**2._r8 &
- + frac_sno(c)+ frac_h2osfc(c)
- else !when water content of ths top layer is more than that at F.C.
- soilbeta(c) = 1._r8
- end if
- else if (col%itype(c) == icol_road_perv) then
- soilbeta(c) = 0._r8
- else if (col%itype(c) == icol_sunwall .or. col%itype(c) == icol_shadewall) then
- soilbeta(c) = 0._r8
- else if (col%itype(c) == icol_roof .or. col%itype(c) == icol_road_imperv) then
- soilbeta(c) = 0._r8
- endif
- else
- soilbeta(c) = 1._r8
- endif
- enddo
-
- end associate
-
- end subroutine calc_beta_leepielke1992
-
- !------------------------------------------------------------------------------
- function do_soilevap_beta()result(lres)
- !
- !DESCRIPTION
- ! return true if the moisture stress for soil evaporation is computed as beta factor
- ! otherwise false
- implicit none
- logical :: lres
-
- if(soil_resis_method==leepielke_1992)then
- lres=.true.
- else
- lres=.false.
- endif
- return
-
- end function do_soilevap_beta
-
- !------------------------------------------------------------------------------
- subroutine calc_soil_resistance_sl14(bounds, num_nolakec, filter_nolakec, &
- soilstate_inst, waterstate_inst, temperature_inst, dsl, soilresis)
- !
- ! DESCRIPTION
- ! compute the lee-pielke beta factor to scal actual soil evaporation from potential evaporation
- !
- ! USES
- use shr_kind_mod , only : r8 => shr_kind_r8
- use shr_const_mod , only : SHR_CONST_PI
- use shr_log_mod , only : errMsg => shr_log_errMsg
- use shr_infnan_mod , only : nan => shr_infnan_nan, assignment(=)
- use decompMod , only : bounds_type
- use clm_varcon , only : denh2o, denice
- use landunit_varcon , only : istice_mec, istwet, istsoil, istcrop
- use column_varcon , only : icol_roof, icol_sunwall, icol_shadewall
- use column_varcon , only : icol_road_imperv, icol_road_perv
- use ColumnType , only : col
- use LandunitType , only : lun
- !
- implicit none
- type(bounds_type) , intent(in) :: bounds ! bounds
- integer , intent(in) :: num_nolakec
- integer , intent(in) :: filter_nolakec(:)
- type(soilstate_type) , intent(in) :: soilstate_inst
- type(waterstate_type) , intent(in) :: waterstate_inst
- type(temperature_type), intent(in) :: temperature_inst
- real(r8) , intent(inout) :: dsl(bounds%begc:bounds%endc)
- real(r8) , intent(inout) :: soilresis(bounds%begc:bounds%endc)
-
- !local variables
- real(r8) :: aird, eps, dg, d0, vwc_liq
- real(r8) :: eff_por_top
- integer :: c, l, fc !indices
-
- SHR_ASSERT_ALL((ubound(dsl) == (/bounds%endc/)), errMsg(sourcefile, __LINE__))
- SHR_ASSERT_ALL((ubound(soilresis) == (/bounds%endc/)), errMsg(sourcefile, __LINE__))
-
- associate( &
- dz => col%dz , & ! Input: [real(r8) (:,:) ] layer thickness (m)
- watsat => soilstate_inst%watsat_col , & ! Input: [real(r8) (:,:)] volumetric soil water at saturation (porosity)
- bsw => soilstate_inst%bsw_col , & ! Input: [real(r8) (:,:) ] Clapp and Hornberger "b"
- sucsat => soilstate_inst%sucsat_col , & ! Input: [real(r8) (:,:) ] minimum soil suction (mm)
-! eff_porosity => soilstate_inst%eff_porosity_col , & ! Input: [real(r8) (:,:) ] effective porosity = porosity - vol_ice
- t_soisno => temperature_inst%t_soisno_col , & ! Input: [real(r8) (:,:) ] soil temperature (Kelvin)
-
- h2osoi_ice => waterstate_inst%h2osoi_ice_col , & ! Input: [real(r8) (:,:)] ice lens (kg/m2)
- h2osoi_liq => waterstate_inst%h2osoi_liq_col & ! Input: [real(r8) (:,:)] liquid water (kg/m2)
- )
-
- do fc = 1,num_nolakec
- c = filter_nolakec(fc)
- l = col%landunit(c)
- if (lun%itype(l)/=istwet .AND. lun%itype(l)/=istice_mec) then
- if (lun%itype(l) == istsoil .or. lun%itype(l) == istcrop) then
- vwc_liq = max(h2osoi_liq(c,1),1.0e-6_r8)/(dz(c,1)*denh2o)
-! eff_porosity not calculated til SoilHydrology
- eff_por_top = max(0.01_r8,watsat(c,1)-min(watsat(c,1), h2osoi_ice(c,1)/(dz(c,1)*denice)))
-
-! calculate diffusivity and air free pore space
- aird = watsat(c,1)*(sucsat(c,1)/1.e7_r8)**(1./bsw(c,1))
- d0 = 2.12e-5*(t_soisno(c,1)/273.15)**1.75 ![Bitelli et al., JH, 08]
- eps = watsat(c,1) - aird
- dg = eps*d0*(eps/watsat(c,1))**(3._r8/max(3._r8,bsw(c,1)))
-
-! dsl(c) = dzmm(c,1)*max(0.001_r8,(0.8*eff_porosity(c,1) - vwc_liq)) &
-! try arbitrary scaling (not top layer thickness)
-! dsl(c) = 15._r8*max(0.001_r8,(0.8*eff_porosity(c,1) - vwc_liq)) &
- dsl(c) = 15._r8*max(0.001_r8,(0.8*eff_por_top - vwc_liq)) &
- ! /max(0.001_r8,(watsat(c,1)- aird))
- /max(0.001_r8,(0.8*watsat(c,1)- aird))
-
- dsl(c)=max(dsl(c),0._r8)
- dsl(c)=min(dsl(c),200._r8)
-
- soilresis(c) = dsl(c)/(dg*eps*1.e3) + 20._r8
- soilresis(c) = min(1.e6_r8,soilresis(c))
-
- else if (col%itype(c) == icol_road_perv) then
- soilresis(c) = 1.e6_r8
- else if (col%itype(c) == icol_sunwall .or. col%itype(c) == icol_shadewall) then
- soilresis(c) = 1.e6_r8
- else if (col%itype(c) == icol_roof .or. col%itype(c) == icol_road_imperv) then
- soilresis(c) = 1.e6_r8
- endif
- else
- soilresis(c) = 0._r8
- endif
- enddo
- end associate
- end subroutine calc_soil_resistance_sl14
-
- !------------------------------------------------------------------------------
- function do_soil_resistance_sl14()result(lres)
- !
- !DESCRIPTION
- ! return true if the soil evaporative resistance is computed using a DSL
- ! otherwise false
- implicit none
- logical :: lres
-
- if(soil_resis_method==sl_14)then
- lres=.true.
- else
- lres=.false.
- endif
- return
-
- end function do_soil_resistance_sl14
-
-end module SurfaceResistanceMod
diff --git a/src/biogeophys/TemperatureType.F90 b/src/biogeophys/TemperatureType.F90
deleted file mode 100644
index a98c1430..00000000
--- a/src/biogeophys/TemperatureType.F90
+++ /dev/null
@@ -1,1474 +0,0 @@
-module TemperatureType
-
-#include "shr_assert.h"
-
- !------------------------------------------------------------------------------
- use shr_kind_mod , only : r8 => shr_kind_r8
- use shr_log_mod , only : errMsg => shr_log_errMsg
- use decompMod , only : bounds_type
- use abortutils , only : endrun
- use clm_varctl , only : use_cndv, iulog, use_luna, use_crop
- use clm_varpar , only : nlevsno, nlevgrnd, nlevlak, nlevlak, nlevurb
- use clm_varcon , only : spval, ispval
- use GridcellType , only : grc
- use LandunitType , only : lun
- use ColumnType , only : col
- use PatchType , only : patch
- !
- implicit none
- save
- private
- !
- type, public :: temperature_type
-
- ! Temperatures
- real(r8), pointer :: t_veg_patch (:) ! patch vegetation temperature (Kelvin)
- real(r8), pointer :: t_veg_day_patch (:) ! patch daytime accumulative vegetation temperature (Kelvinx*nsteps), LUNA specific, from midnight to current step
- real(r8), pointer :: t_veg_night_patch (:) ! patch night-time accumulative vegetation temperature (Kelvin*nsteps), LUNA specific, from midnight to current step
- real(r8), pointer :: t_veg10_day_patch (:) ! 10 day running mean of patch daytime time vegetation temperature (Kelvin), LUNA specific, but can be reused
- real(r8), pointer :: t_veg10_night_patch (:) ! 10 day running mean of patch night time vegetation temperature (Kelvin), LUNA specific, but can be reused
- integer, pointer :: ndaysteps_patch (:) ! number of daytime steps accumulated from mid-night, LUNA specific
- integer, pointer :: nnightsteps_patch (:) ! number of nighttime steps accumulated from mid-night, LUNA specific
- real(r8), pointer :: t_h2osfc_col (:) ! col surface water temperature
- real(r8), pointer :: t_h2osfc_bef_col (:) ! col surface water temperature from time-step before
- real(r8), pointer :: t_ssbef_col (:,:) ! col soil/snow temperature before update (-nlevsno+1:nlevgrnd)
- real(r8), pointer :: t_soisno_col (:,:) ! col soil temperature (Kelvin) (-nlevsno+1:nlevgrnd)
- real(r8), pointer :: t_soi10cm_col (:) ! col soil temperature in top 10cm of soil (Kelvin)
- real(r8), pointer :: t_soi17cm_col (:) ! col soil temperature in top 17cm of soil (Kelvin)
- real(r8), pointer :: t_lake_col (:,:) ! col lake temperature (Kelvin) (1:nlevlak)
- real(r8), pointer :: t_grnd_col (:) ! col ground temperature (Kelvin)
- real(r8), pointer :: t_grnd_r_col (:) ! col rural ground temperature (Kelvin)
- real(r8), pointer :: t_grnd_u_col (:) ! col urban ground temperature (Kelvin) (needed by Hydrology2Mod)
- real(r8), pointer :: t_building_lun (:) ! lun internal building air temperature (K)
- real(r8), pointer :: t_roof_inner_lun (:) ! lun roof inside surface temperature (K)
- real(r8), pointer :: t_sunw_inner_lun (:) ! lun sunwall inside surface temperature (K)
- real(r8), pointer :: t_shdw_inner_lun (:) ! lun shadewall inside surface temperature (K)
- real(r8), pointer :: t_floor_lun (:) ! lun floor temperature (K)
- real(r8), pointer :: snot_top_col (:) ! col temperature of top snow layer [K]
- real(r8), pointer :: dTdz_top_col (:) ! col temperature gradient in top layer [K m-1]
- real(r8), pointer :: dt_veg_patch (:) ! patch change in t_veg, last iteration (Kelvin)
-
- real(r8), pointer :: dt_grnd_col (:) ! col change in t_grnd, last iteration (Kelvin)
- real(r8), pointer :: thv_col (:) ! col virtual potential temperature (kelvin)
- real(r8), pointer :: thm_patch (:) ! patch intermediate variable (forc_t+0.0098*forc_hgt_t_patch)
- real(r8), pointer :: t_a10_patch (:) ! patch 10-day running mean of the 2 m temperature (K)
- real(r8), pointer :: t_a10min_patch (:) ! patch 10-day running mean of min 2-m temperature
- real(r8), pointer :: t_a5min_patch (:) ! patch 5-day running mean of min 2-m temperature
-
- real(r8), pointer :: taf_lun (:) ! lun urban canopy air temperature (K)
-
- real(r8), pointer :: t_ref2m_patch (:) ! patch 2 m height surface air temperature (Kelvin)
- real(r8), pointer :: t_ref2m_r_patch (:) ! patch rural 2 m height surface air temperature (Kelvin)
- real(r8), pointer :: t_ref2m_u_patch (:) ! patch urban 2 m height surface air temperature (Kelvin)
- real(r8), pointer :: t_ref2m_min_patch (:) ! patch daily minimum of average 2 m height surface air temperature (K)
- real(r8), pointer :: t_ref2m_min_r_patch (:) ! patch daily minimum of average 2 m height surface air temperature - rural(K)
- real(r8), pointer :: t_ref2m_min_u_patch (:) ! patch daily minimum of average 2 m height surface air temperature - urban (K)
- real(r8), pointer :: t_ref2m_max_patch (:) ! patch daily maximum of average 2 m height surface air temperature (K)
- real(r8), pointer :: t_ref2m_max_r_patch (:) ! patch daily maximum of average 2 m height surface air temperature - rural(K)
- real(r8), pointer :: t_ref2m_max_u_patch (:) ! patch daily maximum of average 2 m height surface air temperature - urban (K)
- real(r8), pointer :: t_ref2m_min_inst_patch (:) ! patch instantaneous daily min of average 2 m height surface air temp (K)
- real(r8), pointer :: t_ref2m_min_inst_r_patch (:) ! patch instantaneous daily min of average 2 m height surface air temp - rural (K)
- real(r8), pointer :: t_ref2m_min_inst_u_patch (:) ! patch instantaneous daily min of average 2 m height surface air temp - urban (K)
- real(r8), pointer :: t_ref2m_max_inst_patch (:) ! patch instantaneous daily max of average 2 m height surface air temp (K)
- real(r8), pointer :: t_ref2m_max_inst_r_patch (:) ! patch instantaneous daily max of average 2 m height surface air temp - rural (K)
- real(r8), pointer :: t_ref2m_max_inst_u_patch (:) ! patch instantaneous daily max of average 2 m height surface air temp - urban (K)
-
- ! Accumulated quantities
- !
- ! TODO(wjs, 2014-08-05) Move these to the module(s) where they are used, to improve
- ! modularity. In cases where they are used by two completely different modules,
- ! which only use the same variable out of convenience, introduce a duplicate (point
- ! being: that way one parameterization is free to change the exact meaning of its
- ! accumulator without affecting the other).
- !
- real(r8), pointer :: t_veg24_patch (:) ! patch 24hr average vegetation temperature (K)
- real(r8), pointer :: t_veg240_patch (:) ! patch 240hr average vegetation temperature (Kelvin)
- real(r8), pointer :: gdd0_patch (:) ! patch growing degree-days base 0C from planting (ddays)
- real(r8), pointer :: gdd8_patch (:) ! patch growing degree-days base 8C from planting (ddays)
- real(r8), pointer :: gdd10_patch (:) ! patch growing degree-days base 10C from planting (ddays)
- real(r8), pointer :: gdd020_patch (:) ! patch 20-year average of gdd0 (ddays)
- real(r8), pointer :: gdd820_patch (:) ! patch 20-year average of gdd8 (ddays)
- real(r8), pointer :: gdd1020_patch (:) ! patch 20-year average of gdd10 (ddays)
-
- ! Heat content
- real(r8), pointer :: beta_col (:) ! coefficient of convective velocity [-]
- real(r8), pointer :: heat1_grc (:) ! grc initial gridcell total heat content
- real(r8), pointer :: heat2_grc (:) ! grc post land cover change total heat content
- real(r8), pointer :: liquid_water_temp1_grc (:) ! grc initial weighted average liquid water temperature (K)
- real(r8), pointer :: liquid_water_temp2_grc (:) ! grc post land cover change weighted average liquid water temperature (K)
-
- ! Flags
- integer , pointer :: imelt_col (:,:) ! flag for melting (=1), freezing (=2), Not=0 (-nlevsno+1:nlevgrnd)
-
- ! Emissivities
- real(r8), pointer :: emv_patch (:) ! patch vegetation emissivity
- real(r8), pointer :: emg_col (:) ! col ground emissivity
-
- ! Misc
- real(r8), pointer :: xmf_col (:) ! total latent heat of phase change of ground water
- real(r8), pointer :: xmf_h2osfc_col (:) ! latent heat of phase change of surface water
- real(r8), pointer :: fact_col (:,:) ! used in computing tridiagonal matrix
- real(r8), pointer :: c_h2osfc_col (:) ! heat capacity of surface water
-
- contains
-
- procedure, public :: Init
- procedure, public :: Restart
- procedure, private :: InitAllocate
- procedure, private :: InitHistory
- procedure, private :: InitCold
- procedure, public :: InitAccBuffer
- procedure, public :: InitAccVars
- procedure, public :: UpdateAccVars
-
- end type temperature_type
-
- character(len=*), parameter, private :: sourcefile = &
- __FILE__
- !------------------------------------------------------------------------
-
-contains
-
- !------------------------------------------------------------------------
- subroutine Init(this, bounds, &
- em_roof_lun, em_wall_lun, em_improad_lun, em_perroad_lun, &
- is_simple_buildtemp, is_prog_buildtemp)
- !
- ! !DESCRIPTION:
- !
- ! Initialization of the data type. Allocate data, setup variables
- ! for history output, and initialize values needed for a cold-start.
- !
- class(temperature_type) :: this
- type(bounds_type) , intent(in) :: bounds
- real(r8) , intent(in) :: em_roof_lun(bounds%begl:)
- real(r8) , intent(in) :: em_wall_lun(bounds%begl:)
- real(r8) , intent(in) :: em_improad_lun(bounds%begl:)
- real(r8) , intent(in) :: em_perroad_lun(bounds%begl:)
- logical , intent(in) :: is_simple_buildtemp ! Simple building temp is being used
- logical , intent(in) :: is_prog_buildtemp ! Prognostic building temp is being used
-
- call this%InitAllocate ( bounds )
- call this%InitHistory ( bounds, is_simple_buildtemp, is_prog_buildtemp )
- call this%InitCold ( bounds, &
- em_roof_lun(bounds%begl:bounds%endl), &
- em_wall_lun(bounds%begl:bounds%endl), &
- em_improad_lun(bounds%begl:bounds%endl), &
- em_perroad_lun(bounds%begl:bounds%endl), &
- is_simple_buildtemp, is_prog_buildtemp)
-
- end subroutine Init
-
- !------------------------------------------------------------------------
- subroutine InitAllocate(this, bounds)
- !
- ! !DESCRIPTION:
- ! Initialize and allocate data structure
- !
- ! !USES:
- use shr_infnan_mod , only : nan => shr_infnan_nan, assignment(=)
- !
- ! !ARGUMENTS:
- class(temperature_type) :: this
- type(bounds_type), intent(in) :: bounds
- !
- ! !LOCAL VARIABLES:
- integer :: begp, endp
- integer :: begc, endc
- integer :: begl, endl
- integer :: begg, endg
- !------------------------------------------------------------------------
-
- begp = bounds%begp; endp= bounds%endp
- begc = bounds%begc; endc= bounds%endc
- begl = bounds%begl; endl= bounds%endl
- begg = bounds%begg; endg= bounds%endg
-
- ! Temperatures
- allocate(this%t_veg_patch (begp:endp)) ; this%t_veg_patch (:) = nan
- if(use_luna) then
- allocate(this%t_veg_day_patch (begp:endp)) ; this%t_veg_day_patch (:) = spval
- allocate(this%t_veg_night_patch (begp:endp)) ; this%t_veg_night_patch (:) = spval
- allocate(this%t_veg10_day_patch (begp:endp)) ; this%t_veg10_day_patch (:) = spval
- allocate(this%t_veg10_night_patch (begp:endp)) ; this%t_veg10_night_patch (:) = spval
- allocate(this%ndaysteps_patch (begp:endp)) ; this%ndaysteps_patch (:) = ispval
- allocate(this%nnightsteps_patch (begp:endp)) ; this%nnightsteps_patch (:) = ispval
- endif
- allocate(this%t_h2osfc_col (begc:endc)) ; this%t_h2osfc_col (:) = nan
- allocate(this%t_h2osfc_bef_col (begc:endc)) ; this%t_h2osfc_bef_col (:) = nan
- allocate(this%t_ssbef_col (begc:endc,-nlevsno+1:nlevgrnd)) ; this%t_ssbef_col (:,:) = nan
- allocate(this%t_soisno_col (begc:endc,-nlevsno+1:nlevgrnd)) ; this%t_soisno_col (:,:) = nan
- allocate(this%t_lake_col (begc:endc,1:nlevlak)) ; this%t_lake_col (:,:) = nan
- allocate(this%t_grnd_col (begc:endc)) ; this%t_grnd_col (:) = nan
- allocate(this%t_grnd_r_col (begc:endc)) ; this%t_grnd_r_col (:) = nan
- allocate(this%t_grnd_u_col (begc:endc)) ; this%t_grnd_u_col (:) = nan
- allocate(this%t_building_lun (begl:endl)) ; this%t_building_lun (:) = nan
- allocate(this%t_roof_inner_lun (begl:endl)) ; this%t_roof_inner_lun (:) = nan
- allocate(this%t_sunw_inner_lun (begl:endl)) ; this%t_sunw_inner_lun (:) = nan
- allocate(this%t_shdw_inner_lun (begl:endl)) ; this%t_shdw_inner_lun (:) = nan
- allocate(this%t_floor_lun (begl:endl)) ; this%t_floor_lun (:) = nan
- allocate(this%snot_top_col (begc:endc)) ; this%snot_top_col (:) = nan
- allocate(this%dTdz_top_col (begc:endc)) ; this%dTdz_top_col (:) = nan
- allocate(this%dt_veg_patch (begp:endp)) ; this%dt_veg_patch (:) = nan
-
- allocate(this%t_soi10cm_col (begc:endc)) ; this%t_soi10cm_col (:) = nan
- allocate(this%t_soi17cm_col (begc:endc)) ; this%t_soi17cm_col (:) = spval
- allocate(this%dt_grnd_col (begc:endc)) ; this%dt_grnd_col (:) = nan
- allocate(this%thv_col (begc:endc)) ; this%thv_col (:) = nan
- allocate(this%thm_patch (begp:endp)) ; this%thm_patch (:) = nan
- allocate(this%t_a10_patch (begp:endp)) ; this%t_a10_patch (:) = nan
- allocate(this%t_a10min_patch (begp:endp)) ; this%t_a10min_patch (:) = nan
- allocate(this%t_a5min_patch (begp:endp)) ; this%t_a5min_patch (:) = nan
-
- allocate(this%taf_lun (begl:endl)) ; this%taf_lun (:) = nan
-
- allocate(this%t_ref2m_patch (begp:endp)) ; this%t_ref2m_patch (:) = nan
- allocate(this%t_ref2m_r_patch (begp:endp)) ; this%t_ref2m_r_patch (:) = nan
- allocate(this%t_ref2m_u_patch (begp:endp)) ; this%t_ref2m_u_patch (:) = nan
- allocate(this%t_ref2m_min_patch (begp:endp)) ; this%t_ref2m_min_patch (:) = nan
- allocate(this%t_ref2m_min_r_patch (begp:endp)) ; this%t_ref2m_min_r_patch (:) = nan
- allocate(this%t_ref2m_min_u_patch (begp:endp)) ; this%t_ref2m_min_u_patch (:) = nan
- allocate(this%t_ref2m_max_patch (begp:endp)) ; this%t_ref2m_max_patch (:) = nan
- allocate(this%t_ref2m_max_r_patch (begp:endp)) ; this%t_ref2m_max_r_patch (:) = nan
- allocate(this%t_ref2m_max_u_patch (begp:endp)) ; this%t_ref2m_max_u_patch (:) = nan
- allocate(this%t_ref2m_max_inst_patch (begp:endp)) ; this%t_ref2m_max_inst_patch (:) = nan
- allocate(this%t_ref2m_max_inst_r_patch (begp:endp)) ; this%t_ref2m_max_inst_r_patch (:) = nan
- allocate(this%t_ref2m_max_inst_u_patch (begp:endp)) ; this%t_ref2m_max_inst_u_patch (:) = nan
- allocate(this%t_ref2m_min_inst_patch (begp:endp)) ; this%t_ref2m_min_inst_patch (:) = nan
- allocate(this%t_ref2m_min_inst_r_patch (begp:endp)) ; this%t_ref2m_min_inst_r_patch (:) = nan
- allocate(this%t_ref2m_min_inst_u_patch (begp:endp)) ; this%t_ref2m_min_inst_u_patch (:) = nan
-
- ! Accumulated fields
- allocate(this%t_veg24_patch (begp:endp)) ; this%t_veg24_patch (:) = nan
- allocate(this%t_veg240_patch (begp:endp)) ; this%t_veg240_patch (:) = nan
- allocate(this%gdd0_patch (begp:endp)) ; this%gdd0_patch (:) = spval
- allocate(this%gdd8_patch (begp:endp)) ; this%gdd8_patch (:) = spval
- allocate(this%gdd10_patch (begp:endp)) ; this%gdd10_patch (:) = spval
- allocate(this%gdd020_patch (begp:endp)) ; this%gdd020_patch (:) = spval
- allocate(this%gdd820_patch (begp:endp)) ; this%gdd820_patch (:) = spval
- allocate(this%gdd1020_patch (begp:endp)) ; this%gdd1020_patch (:) = spval
-
- ! Heat content
- allocate(this%beta_col (begc:endc)) ; this%beta_col (:) = nan
- allocate(this%heat1_grc (begg:endg)) ; this%heat1_grc (:) = nan
- allocate(this%heat2_grc (begg:endg)) ; this%heat2_grc (:) = nan
- allocate(this%liquid_water_temp1_grc (begg:endg)) ; this%liquid_water_temp1_grc (:) = nan
- allocate(this%liquid_water_temp2_grc (begg:endg)) ; this%liquid_water_temp2_grc (:) = nan
-
- ! flags
- allocate(this%imelt_col (begc:endc,-nlevsno+1:nlevgrnd)) ; this%imelt_col (:,:) = huge(1)
-
- ! emissivities
- allocate(this%emv_patch (begp:endp)) ; this%emv_patch (:) = nan
- allocate(this%emg_col (begc:endc)) ; this%emg_col (:) = nan
-
- allocate(this%xmf_col (begc:endc)) ; this%xmf_col (:) = nan
- allocate(this%xmf_h2osfc_col (begc:endc)) ; this%xmf_h2osfc_col (:) = nan
- allocate(this%fact_col (begc:endc, -nlevsno+1:nlevgrnd)) ; this%fact_col (:,:) = nan
- allocate(this%c_h2osfc_col (begc:endc)) ; this%c_h2osfc_col (:) = nan
-
- end subroutine InitAllocate
-
- !------------------------------------------------------------------------
- subroutine InitHistory(this, bounds, is_simple_buildtemp, is_prog_buildtemp )
- !
- ! !DESCRIPTION:
- ! Setup the fields that can be output on history files.
- !
- ! !USES:
- use shr_infnan_mod , only : nan => shr_infnan_nan, assignment(=)
- use clm_varctl , only : use_cn, use_cndv
- use histFileMod , only : hist_addfld1d, hist_addfld2d, no_snow_normal
- !
- ! !ARGUMENTS:
- class(temperature_type) :: this
- type(bounds_type), intent(in) :: bounds
- logical , intent(in) :: is_simple_buildtemp ! Simple building temp is being used
- logical , intent(in) :: is_prog_buildtemp ! Prognostic building temp is being used
- !
- ! !LOCAL VARIABLES:
- integer :: begp, endp
- integer :: begc, endc
- integer :: begl, endl
- integer :: begg, endg
- character(10) :: active
- character(100) :: lname
- real(r8), pointer :: data2dptr(:,:), data1dptr(:) ! temp. pointers for slicing larger arrays
- !------------------------------------------------------------------------
-
- begp = bounds%begp; endp= bounds%endp
- begc = bounds%begc; endc= bounds%endc
- begl = bounds%begl; endl= bounds%endl
- begg = bounds%begg; endg= bounds%endg
-
- this%t_h2osfc_col(begc:endc) = spval
- call hist_addfld1d (fname='TH2OSFC', units='K', &
- avgflag='A', long_name='surface water temperature', &
- ptr_col=this%t_h2osfc_col, default='inactive')
-
- this%t_grnd_u_col(begc:endc) = spval
- call hist_addfld1d (fname='TG_U', units='K', &
- avgflag='A', long_name='Urban ground temperature', &
- ptr_col=this%t_grnd_u_col, set_nourb=spval, c2l_scale_type='urbans', default='inactive')
-
- this%t_lake_col(begc:endc,:) = spval
- call hist_addfld2d (fname='TLAKE', units='K', type2d='levlak', &
- avgflag='A', long_name='lake temperature', &
- ptr_col=this%t_lake_col, default='inactive')
-
- this%t_soisno_col(begc:endc,-nlevsno+1:0) = spval
- data2dptr => this%t_soisno_col(:,-nlevsno+1:0)
- call hist_addfld2d (fname='SNO_T', units='K', type2d='levsno', &
- avgflag='A', long_name='Snow temperatures', &
- ptr_col=data2dptr, no_snow_behavior=no_snow_normal, default='inactive')
-
- call hist_addfld2d (fname='SNO_T_ICE', units='K', type2d='levsno', &
- avgflag='A', long_name='Snow temperatures (ice landunits only)', &
- ptr_col=data2dptr, no_snow_behavior=no_snow_normal, &
- l2g_scale_type='ice', default='inactive')
-
- this%t_ref2m_patch(begp:endp) = spval
- call hist_addfld1d (fname='TSA', units='K', &
- avgflag='A', long_name='2m air temperature', &
- ptr_patch=this%t_ref2m_patch, default='inactive')
-
- call hist_addfld1d (fname='TSA_ICE', units='K', &
- avgflag='A', long_name='2m air temperature (ice landunits only)', &
- ptr_patch=this%t_ref2m_patch, l2g_scale_type='ice', default='inactive')
-
- this%t_ref2m_r_patch(begp:endp) = spval
- call hist_addfld1d (fname='TSA_R', units='K', &
- avgflag='A', long_name='Rural 2m air temperature', &
- ptr_patch=this%t_ref2m_r_patch, set_spec=spval, default='inactive')
-
- this%t_ref2m_min_patch(begp:endp) = spval
- call hist_addfld1d (fname='TREFMNAV', units='K', &
- avgflag='A', long_name='daily minimum of average 2-m temperature', &
- ptr_patch=this%t_ref2m_min_patch, default='inactive')
-
- this%t_ref2m_max_patch(begp:endp) = spval
- call hist_addfld1d (fname='TREFMXAV', units='K', &
- avgflag='A', long_name='daily maximum of average 2-m temperature', &
- ptr_patch=this%t_ref2m_max_patch, default='inactive')
-
- this%t_ref2m_min_r_patch(begp:endp) = spval
- call hist_addfld1d (fname='TREFMNAV_R', units='K', &
- avgflag='A', long_name='Rural daily minimum of average 2-m temperature', &
- ptr_patch=this%t_ref2m_min_r_patch, set_spec=spval, default='inactive')
-
- this%t_ref2m_max_r_patch(begp:endp) = spval
- call hist_addfld1d (fname='TREFMXAV_R', units='K', &
- avgflag='A', long_name='Rural daily maximum of average 2-m temperature', &
- ptr_patch=this%t_ref2m_max_r_patch, set_spec=spval, default='inactive')
-
- this%t_ref2m_u_patch(begp:endp) = spval
- call hist_addfld1d (fname='TSA_U', units='K', &
- avgflag='A', long_name='Urban 2m air temperature', &
- ptr_patch=this%t_ref2m_u_patch, set_nourb=spval, default='inactive')
-
- this%t_ref2m_min_u_patch(begp:endp) = spval
- call hist_addfld1d (fname='TREFMNAV_U', units='K', &
- avgflag='A', long_name='Urban daily minimum of average 2-m temperature', &
- ptr_patch=this%t_ref2m_min_u_patch, set_nourb=spval, default='inactive')
-
- this%t_ref2m_max_u_patch(begp:endp) = spval
- call hist_addfld1d (fname='TREFMXAV_U', units='K', &
- avgflag='A', long_name='Urban daily maximum of average 2-m temperature', &
- ptr_patch=this%t_ref2m_max_u_patch, set_nourb=spval, default='inactive')
-
- this%t_veg_patch(begp:endp) = spval
- call hist_addfld1d (fname='TV', units='K', &
- avgflag='A', long_name='vegetation temperature', &
- ptr_patch=this%t_veg_patch, default='inactive')
-
- this%t_grnd_col(begc:endc) = spval
- call hist_addfld1d (fname='TG', units='K', &
- avgflag='A', long_name='ground temperature', &
- ptr_col=this%t_grnd_col, c2l_scale_type='urbans', default='inactive')
-
- call hist_addfld1d (fname='TG_ICE', units='K', &
- avgflag='A', long_name='ground temperature (ice landunits only)', &
- ptr_col=this%t_grnd_col, c2l_scale_type='urbans', l2g_scale_type='ice', &
- default='inactive')
-
- this%t_grnd_r_col(begc:endc) = spval
- call hist_addfld1d (fname='TG_R', units='K', &
- avgflag='A', long_name='Rural ground temperature', &
- ptr_col=this%t_grnd_r_col, set_spec=spval, default='inactive')
-
- this%t_soisno_col(begc:endc,:) = spval
- call hist_addfld2d (fname='TSOI', units='K', type2d='levgrnd', &
- avgflag='A', long_name='soil temperature (vegetated landunits only)', &
- ptr_col=this%t_soisno_col, l2g_scale_type='veg', default='inactive')
-
- call hist_addfld2d (fname='TSOI_ICE', units='K', type2d='levgrnd', &
- avgflag='A', long_name='soil temperature (ice landunits only)', &
- ptr_col=this%t_soisno_col, l2g_scale_type='ice', default='inactive')
-
- this%t_soi10cm_col(begc:endc) = spval
- call hist_addfld1d (fname='TSOI_10CM', units='K', &
- avgflag='A', long_name='soil temperature in top 10cm of soil', &
- ptr_col=this%t_soi10cm_col, set_urb=spval, default='inactive')
-
- if (use_cndv .or. use_crop) then
- active = "active"
- else
- active = "active"
- end if
- this%t_a10_patch(begp:endp) = spval
- call hist_addfld1d (fname='T10', units='K', &
- avgflag='A', long_name='10-day running mean of 2-m temperature', &
- ptr_patch=this%t_a10_patch, default='inactive')
-
- if (use_cn .and. use_crop )then
- this%t_a5min_patch(begp:endp) = spval
- call hist_addfld1d (fname='A5TMIN', units='K', &
- avgflag='A', long_name='5-day running mean of min 2-m temperature', &
- ptr_patch=this%t_a5min_patch, default='inactive')
- end if
-
- if (use_cn .and. use_crop )then
- this%t_a10min_patch(begp:endp) = spval
- call hist_addfld1d (fname='A10TMIN', units='K', &
- avgflag='A', long_name='10-day running mean of min 2-m temperature', &
- ptr_patch=this%t_a10min_patch, default='inactive')
- end if
-
- this%t_building_lun(begl:endl) = spval
- if ( is_simple_buildtemp )then
- lname = 'internal urban building temperature'
- else if ( is_prog_buildtemp )then
- lname = 'internal urban building air temperature'
- end if
- call hist_addfld1d(fname='TBUILD', units='K', &
- avgflag='A', long_name=lname, &
- ptr_lunit=this%t_building_lun, set_nourb=spval, l2g_scale_type='unity', default='inactive')
-
- if ( is_prog_buildtemp )then
- this%t_roof_inner_lun(begl:endl) = spval
- call hist_addfld1d(fname='TROOF_INNER', units='K', &
- avgflag='A', long_name='roof inside surface temperature', &
- ptr_lunit=this%t_roof_inner_lun, set_nourb=spval, l2g_scale_type='unity', &
- default='inactive')
-
- this%t_sunw_inner_lun(begl:endl) = spval
- call hist_addfld1d(fname='TSUNW_INNER', units='K', &
- avgflag='A', long_name='sunwall inside surface temperature', &
- ptr_lunit=this%t_sunw_inner_lun, set_nourb=spval, l2g_scale_type='unity', &
- default='inactive')
-
- this%t_shdw_inner_lun(begl:endl) = spval
- call hist_addfld1d(fname='TSHDW_INNER', units='K', &
- avgflag='A', long_name='shadewall inside surface temperature', &
- ptr_lunit=this%t_shdw_inner_lun, set_nourb=spval, l2g_scale_type='unity', &
- default='inactive')
-
- this%t_floor_lun(begl:endl) = spval
- call hist_addfld1d(fname='TFLOOR', units='K', &
- avgflag='A', long_name='floor temperature', &
- ptr_lunit=this%t_floor_lun, set_nourb=spval, l2g_scale_type='unity', &
- default='inactive')
- end if
-
- this%heat1_grc(begg:endg) = spval
- call hist_addfld1d (fname='HEAT_CONTENT1', units='J/m^2', &
- avgflag='A', long_name='initial gridcell total heat content', &
- ptr_lnd=this%heat1_grc, default='inactive')
- call hist_addfld1d (fname='HEAT_CONTENT1_VEG', units='J/m^2', &
- avgflag='A', long_name='initial gridcell total heat content - vegetated landunits only', &
- ptr_lnd=this%heat1_grc, l2g_scale_type='veg', default='inactive')
-
- this%heat2_grc(begg:endg) = spval
- call hist_addfld1d (fname='HEAT_CONTENT2', units='J/m^2', &
- avgflag='A', long_name='post land cover change total heat content', &
- ptr_lnd=this%heat2_grc, default='inactive')
-
- this%liquid_water_temp1_grc(begg:endg) = spval
- call hist_addfld1d (fname='LIQUID_WATER_TEMP1', units='K', &
- avgflag='A', long_name='initial gridcell weighted average liquid water temperature', &
- ptr_lnd=this%liquid_water_temp1_grc, default='inactive')
-
- this%snot_top_col(begc:endc) = spval
- call hist_addfld1d (fname='SNOTTOPL', units='K', &
- avgflag='A', long_name='snow temperature (top layer)', &
- ptr_col=this%snot_top_col, set_urb=spval, default='inactive')
-
- call hist_addfld1d (fname='SNOTTOPL_ICE', units='K', &
- avgflag='A', long_name='snow temperature (top layer, ice landunits only)', &
- ptr_col=this%snot_top_col, set_urb=spval, l2g_scale_type='ice', default='inactive')
-
- this%dTdz_top_col(begc:endc) = spval
- call hist_addfld1d (fname='SNOdTdzL', units='K/m', &
- avgflag='A', long_name='top snow layer temperature gradient (land)', &
- ptr_col=this%dTdz_top_col, set_urb=spval, default='inactive')
-
- if (use_cn) then
- this%dt_veg_patch(begp:endp) = spval
- call hist_addfld1d (fname='DT_VEG', units='K', &
- avgflag='A', long_name='change in t_veg, last iteration', &
- ptr_patch=this%dt_veg_patch, default='inactive')
- end if
-
- if (use_cn ) then
- this%emv_patch(begp:endp) = spval
- call hist_addfld1d (fname='EMV', units='proportion', &
- avgflag='A', long_name='vegetation emissivity', &
- ptr_patch=this%emv_patch, default='inactive')
- end if
-
- if (use_cn) then
- this%emg_col(begc:endc) = spval
- call hist_addfld1d (fname='EMG', units='proportion', &
- avgflag='A', long_name='ground emissivity', &
- ptr_col=this%emg_col, default='inactive')
- end if
-
- if (use_cn) then
- this%beta_col(begc:endc) = spval
- call hist_addfld1d (fname='BETA', units='none', &
- avgflag='A', long_name='coefficient of convective velocity', &
- ptr_col=this%beta_col, default='inactive')
- end if
-
- ! Accumulated quantities
-
- this%t_veg24_patch(begp:endp) = spval
- call hist_addfld1d (fname='TV24', units='K', &
- avgflag='A', long_name='vegetation temperature (last 24hrs)', &
- ptr_patch=this%t_veg24_patch, default='inactive')
-
- this%t_veg240_patch(begp:endp) = spval
- call hist_addfld1d (fname='TV240', units='K', &
- avgflag='A', long_name='vegetation temperature (last 240hrs)', &
- ptr_patch=this%t_veg240_patch, default='inactive')
-
- if (use_crop) then
- this%gdd0_patch(begp:endp) = spval
- call hist_addfld1d (fname='GDD0', units='ddays', &
- avgflag='A', long_name='Growing degree days base 0C from planting', &
- ptr_patch=this%gdd0_patch, default='inactive')
- end if
-
- if (use_crop) then
- this%gdd8_patch(begp:endp) = spval
- call hist_addfld1d (fname='GDD8', units='ddays', &
- avgflag='A', long_name='Growing degree days base 8C from planting', &
- ptr_patch=this%gdd8_patch, default='inactive')
-
- this%gdd10_patch(begp:endp) = spval
- call hist_addfld1d (fname='GDD10', units='ddays', &
- avgflag='A', long_name='Growing degree days base 10C from planting', &
- ptr_patch=this%gdd10_patch, default='inactive')
-
- this%gdd020_patch(begp:endp) = spval
- call hist_addfld1d (fname='GDD020', units='ddays', &
- avgflag='A', long_name='Twenty year average of growing degree days base 0C from planting', &
- ptr_patch=this%gdd020_patch, default='inactive')
-
- this%gdd820_patch(begp:endp) = spval
- call hist_addfld1d (fname='GDD820', units='ddays', &
- avgflag='A', long_name='Twenty year average of growing degree days base 8C from planting', &
- ptr_patch=this%gdd820_patch, default='inactive')
-
- this%gdd1020_patch(begp:endp) = spval
- call hist_addfld1d (fname='GDD1020', units='ddays', &
- avgflag='A', long_name='Twenty year average of growing degree days base 10C from planting', &
- ptr_patch=this%gdd1020_patch, default='inactive')
-
- end if
- if(use_luna)then
- call hist_addfld1d (fname='TVEGD10', units='Kelvin', &
- avgflag='A', long_name='10 day running mean of patch daytime vegetation temperature', &
- ptr_patch=this%t_veg10_day_patch, default='inactive')
- call hist_addfld1d (fname='TVEGN10', units='Kelvin', &
- avgflag='A', long_name='10 day running mean of patch night-time vegetation temperature', &
- ptr_patch=this%t_veg10_night_patch, default='inactive')
- endif
-
-
- end subroutine InitHistory
-
- !-----------------------------------------------------------------------
- subroutine InitCold(this, bounds, &
- em_roof_lun, em_wall_lun, em_improad_lun, em_perroad_lun, &
- is_simple_buildtemp, is_prog_buildtemp)
- !
- ! !DESCRIPTION:
- ! Initialize cold start conditions for module variables
- !
- ! !USES:
- use shr_kind_mod , only : r8 => shr_kind_r8
- use shr_const_mod , only : SHR_CONST_TKFRZ
- use clm_varcon , only : denice, denh2o, sb
- use landunit_varcon, only : istwet, istsoil, istdlak, istice_mec
- use column_varcon , only : icol_road_imperv, icol_roof, icol_sunwall
- use column_varcon , only : icol_shadewall, icol_road_perv
- use clm_varctl , only : iulog, use_vancouver, use_mexicocity
- !
- ! !ARGUMENTS:
- class(temperature_type) :: this
- type(bounds_type) , intent(in) :: bounds
- real(r8) , intent(in) :: em_roof_lun(bounds%begl:)
- real(r8) , intent(in) :: em_wall_lun(bounds%begl:)
- real(r8) , intent(in) :: em_improad_lun(bounds%begl:)
- real(r8) , intent(in) :: em_perroad_lun(bounds%begl:)
- logical , intent(in) :: is_simple_buildtemp ! Simple building temp is being used
- logical , intent(in) :: is_prog_buildtemp ! Prognostic building temp is being used
- !
- ! !LOCAL VARIABLES:
- integer :: j,l,c,p ! indices
- integer :: nlevs ! number of levels
- real(r8) :: snowbd ! temporary calculation of snow bulk density (kg/m3)
- real(r8) :: fmelt ! snowbd/100
- integer :: lev
- !-----------------------------------------------------------------------
-
- SHR_ASSERT_ALL((ubound(em_roof_lun) == (/bounds%endl/)), errMsg(sourcefile, __LINE__))
- SHR_ASSERT_ALL((ubound(em_wall_lun) == (/bounds%endl/)), errMsg(sourcefile, __LINE__))
- SHR_ASSERT_ALL((ubound(em_improad_lun) == (/bounds%endl/)), errMsg(sourcefile, __LINE__))
- SHR_ASSERT_ALL((ubound(em_perroad_lun) == (/bounds%endl/)), errMsg(sourcefile, __LINE__))
-
- associate(snl => col%snl) ! Output: [integer (:) ] number of snow layers
-
- ! Set snow/soil temperature
- ! t_lake only has valid values over non-lake
- ! t_soisno, t_grnd and t_veg have valid values over all land
-
- do c = bounds%begc,bounds%endc
- l = col%landunit(c)
-
- this%t_soisno_col(c,-nlevsno+1:nlevgrnd) = spval
-
- ! Snow level temperatures - all land points
- if (snl(c) < 0) then
- do j = snl(c)+1, 0
- this%t_soisno_col(c,j) = 250._r8
- end do
- end if
-
- ! Below snow temperatures - nonlake points (lake points are set below)
- if (.not. lun%lakpoi(l)) then
-
- if (lun%itype(l)==istice_mec) then
- this%t_soisno_col(c,1:nlevgrnd) = 250._r8
-
- else if (lun%itype(l) == istwet) then
- this%t_soisno_col(c,1:nlevgrnd) = 277._r8
-
- else if (lun%urbpoi(l)) then
- if (use_vancouver) then
- if (col%itype(c) == icol_road_perv .or. col%itype(c) == icol_road_imperv) then
- ! Set road top layer to initial air temperature and interpolate other
- ! layers down to 20C in bottom layer
- do j = 1, nlevgrnd
- this%t_soisno_col(c,j) = 297.56 - (j-1) * ((297.56-293.16)/(nlevgrnd-1))
- end do
- ! Set wall and roof layers to initial air temperature
- else if (col%itype(c) == icol_sunwall .or. col%itype(c) == icol_shadewall .or. col%itype(c) == icol_roof) then
- this%t_soisno_col(c,1:nlevurb) = 297.56
- else
- this%t_soisno_col(c,1:nlevgrnd) = 283._r8
- end if
- else if (use_mexicocity) then
- if (col%itype(c) == icol_road_perv .or. col%itype(c) == icol_road_imperv) then
- ! Set road top layer to initial air temperature and interpolate other
- ! layers down to 22C in bottom layer
- do j = 1, nlevgrnd
- this%t_soisno_col(c,j) = 289.46 - (j-1) * ((289.46-295.16)/(nlevgrnd-1))
- end do
- else if (col%itype(c) == icol_sunwall .or. col%itype(c) == icol_shadewall .or. col%itype(c) == icol_roof) then
- ! Set wall and roof layers to initial air temperature
- this%t_soisno_col(c,1:nlevurb) = 289.46
- else
- this%t_soisno_col(c,1:nlevgrnd) = 283._r8
- end if
- else
- if (col%itype(c) == icol_road_perv .or. col%itype(c) == icol_road_imperv) then
- this%t_soisno_col(c,1:nlevgrnd) = 274._r8
- else if (col%itype(c) == icol_sunwall .or. col%itype(c) == icol_shadewall &
- .or. col%itype(c) == icol_roof) then
- ! Set sunwall, shadewall, roof to fairly high temperature to avoid initialization
- ! shock from large heating/air conditioning flux
- this%t_soisno_col(c,1:nlevurb) = 292._r8
- end if
- end if
- else
- this%t_soisno_col(c,1:nlevgrnd) = 274._r8
-
- endif
- endif
- end do
-
- ! Initialize internal building temperature, inner temperatures of building
- ! surfaces, and floor temperature
- if ( is_prog_buildtemp )then
- do l = bounds%begl, bounds%endl
- do c = lun%coli(l),lun%colf(l)
- if (col%itype(c) == icol_roof) then
- this%t_roof_inner_lun(l) = this%t_soisno_col(c,nlevurb)
- this%t_building_lun(l) = this%t_soisno_col(c,nlevurb) ! arbitrarily set to roof temperature
- this%t_floor_lun(l) = this%t_soisno_col(c,nlevurb) ! arbitrarily set to roof temperature
- else if (col%itype(c) == icol_sunwall) then
- this%t_sunw_inner_lun(l) = this%t_soisno_col(c,nlevurb)
- else if (col%itype(c) == icol_shadewall) then
- this%t_shdw_inner_lun(l) = this%t_soisno_col(c,nlevurb)
- end if
- end do
- end do
- end if
-
- ! Set Ground temperatures
-
- do c = bounds%begc,bounds%endc
- l = col%landunit(c)
-
- if (lun%lakpoi(l)) then
- this%t_grnd_col(c) = 277._r8
- else
- this%t_grnd_col(c) = this%t_soisno_col(c,snl(c)+1)
- end if
- this%t_soi17cm_col(c) = this%t_grnd_col(c)
- end do
-
- do c = bounds%begc,bounds%endc
- l = col%landunit(c)
- if (lun%lakpoi(l)) then ! lake
- this%t_lake_col(c,1:nlevlak) = this%t_grnd_col(c)
- this%t_soisno_col(c,1:nlevgrnd) = this%t_grnd_col(c)
- end if
- end do
-
- ! Set t_h2osfc_col
-
- this%t_h2osfc_col(bounds%begc:bounds%endc) = 274._r8
-
- ! Set t_veg, t_ref2m, t_ref2m_u and tref2m_r
-
- do p = bounds%begp, bounds%endp
- c = patch%column(p)
- l = patch%landunit(p)
-
- if (use_vancouver) then
- this%t_veg_patch(p) = 297.56
- else if (use_mexicocity) then
- this%t_veg_patch(p) = 289.46
- else
- this%t_veg_patch(p) = 283._r8
- end if
-
- if (use_vancouver) then
- this%t_ref2m_patch(p) = 297.56
- else if (use_mexicocity) then
- this%t_ref2m_patch(p) = 289.46
- else
- this%t_ref2m_patch(p) = 283._r8
- end if
-
- if (lun%urbpoi(l)) then
- if (use_vancouver) then
- this%t_ref2m_u_patch(p) = 297.56
- else if (use_mexicocity) then
- this%t_ref2m_u_patch(p) = 289.46
- else
- this%t_ref2m_u_patch(p) = 283._r8
- end if
- else
- if (.not. lun%ifspecial(l)) then
- if (use_vancouver) then
- this%t_ref2m_r_patch(p) = 297.56
- else if (use_mexicocity) then
- this%t_ref2m_r_patch(p) = 289.46
- else
- this%t_ref2m_r_patch(p) = 283._r8
- end if
- else
- this%t_ref2m_r_patch(p) = spval
- end if
- end if
-
- end do
-
- end associate
-
- do l = bounds%begl, bounds%endl
- if (lun%urbpoi(l)) then
- if (use_vancouver) then
- this%taf_lun(l) = 297.56_r8
- else if (use_mexicocity) then
- this%taf_lun(l) = 289.46_r8
- else
- this%taf_lun(l) = 283._r8
- end if
- end if
- end do
-
- do c = bounds%begc,bounds%endc
- l = col%landunit(c)
-
- if (col%itype(c) == icol_roof ) this%emg_col(c) = em_roof_lun(l)
- if (col%itype(c) == icol_sunwall ) this%emg_col(c) = em_wall_lun(l)
- if (col%itype(c) == icol_shadewall ) this%emg_col(c) = em_wall_lun(l)
- if (col%itype(c) == icol_road_imperv) this%emg_col(c) = em_improad_lun(l)
- if (col%itype(c) == icol_road_perv ) this%emg_col(c) = em_perroad_lun(l)
- end do
-
- end subroutine InitCold
-
- !------------------------------------------------------------------------
- subroutine Restart(this, bounds, ncid, flag, is_simple_buildtemp, is_prog_buildtemp)
- !
- ! !DESCRIPTION:
- ! Read/Write module information to/from restart file.
- !
- ! !USES:
- use shr_log_mod , only : errMsg => shr_log_errMsg
- use spmdMod , only : masterproc
- use abortutils , only : endrun
- use ncdio_pio , only : file_desc_t, ncd_double
- use restUtilMod
- !
- ! !ARGUMENTS:
- class(temperature_type) :: this
- type(bounds_type), intent(in) :: bounds
- type(file_desc_t), intent(inout) :: ncid
- character(len=*) , intent(in) :: flag
- logical , intent(in) :: is_simple_buildtemp ! Simple building temp is being used
- logical , intent(in) :: is_prog_buildtemp ! Prognostic building temp is being used
- !
- ! !LOCAL VARIABLES:
- integer :: j,c ! indices
- logical :: readvar ! determine if variable is on initial file
- !-----------------------------------------------------------------------
-
- call restartvar(ncid=ncid, flag=flag, varname='T_SOISNO', xtype=ncd_double, &
- dim1name='column', dim2name='levtot', switchdim=.true., &
- long_name='soil-snow temperature', units='K', &
- interpinic_flag='interp', readvar=readvar, data=this%t_soisno_col)
-
- call restartvar(ncid=ncid, flag=flag, varname='T_VEG', xtype=ncd_double, &
- dim1name='pft', &
- long_name='vegetation temperature', units='K', &
- interpinic_flag='interp', readvar=readvar, data=this%t_veg_patch)
-
- call restartvar(ncid=ncid, flag=flag, varname='TH2OSFC', xtype=ncd_double, &
- dim1name='column', &
- long_name='surface water temperature', units='K', &
- interpinic_flag='interp', readvar=readvar, data=this%t_h2osfc_col)
- if (flag=='read' .and. .not. readvar) then
- this%t_h2osfc_col(bounds%begc:bounds%endc) = 274.0_r8
- end if
-
- call restartvar(ncid=ncid, flag=flag, varname='T_LAKE', xtype=ncd_double, &
- dim1name='column', dim2name='levlak', switchdim=.true., &
- long_name='lake temperature', units='K', &
- interpinic_flag='interp', readvar=readvar, data=this%t_lake_col)
-
- call restartvar(ncid=ncid, flag=flag, varname='T_GRND', xtype=ncd_double, &
- dim1name='column', &
- long_name='ground temperature', units='K', &
- interpinic_flag='interp', readvar=readvar, data=this%t_grnd_col)
-
- call restartvar(ncid=ncid, flag=flag, varname='T_GRND_R', xtype=ncd_double, &
- dim1name='column', &
- long_name='rural ground temperature', units='K', &
- interpinic_flag='interp', readvar=readvar, data=this%t_grnd_r_col)
-
- call restartvar(ncid=ncid, flag=flag, varname='T_GRND_U', xtype=ncd_double, &
- dim1name='column', &
- long_name='urban ground temperature', units='K', &
- interpinic_flag='interp', readvar=readvar, data=this%t_grnd_u_col)
-
- call restartvar(ncid=ncid, flag=flag, varname='T_REF2M', xtype=ncd_double, &
- dim1name='pft', &
- long_name='2m height surface air temperature', units='K', &
- interpinic_flag='interp', readvar=readvar, data=this%t_ref2m_patch)
- if (flag=='read' .and. .not. readvar) call endrun(msg=errMsg(sourcefile, __LINE__))
-
- call restartvar(ncid=ncid, flag=flag, varname="T_REF2M_R", xtype=ncd_double, &
- dim1name='pft', &
- long_name='Rural 2m height surface air temperature', units='K', &
- interpinic_flag='interp', readvar=readvar, data=this%t_ref2m_r_patch)
-
- call restartvar(ncid=ncid, flag=flag, varname="T_REF2M_U", xtype=ncd_double, dim1name='pft', &
- long_name='Urban 2m height surface air temperature', units='K', &
- interpinic_flag='interp', readvar=readvar, data=this%t_ref2m_u_patch)
-
-
- call restartvar(ncid=ncid, flag=flag, varname='T_REF2M_MIN', xtype=ncd_double, &
- dim1name='pft', &
- long_name='daily minimum of average 2 m height surface air temperature (K)', units='K', &
- interpinic_flag='interp', readvar=readvar, data=this%t_ref2m_min_patch)
-
- call restartvar(ncid=ncid, flag=flag, varname='T_REF2M_MIN_R', xtype=ncd_double, &
- dim1name='pft', &
- long_name='rural daily minimum of average 2 m height surface air temperature (K)', units='K', &
- interpinic_flag='interp', readvar=readvar, data=this%t_ref2m_min_r_patch)
-
- call restartvar(ncid=ncid, flag=flag, varname='T_REF2M_MIN_U', xtype=ncd_double, dim1name='pft', &
- long_name='urban daily minimum of average 2 m height surface air temperature (K)', units='K', &
- interpinic_flag='interp', readvar=readvar, data=this%t_ref2m_min_u_patch)
-
- call restartvar(ncid=ncid, flag=flag, varname='T_REF2M_MAX', xtype=ncd_double, &
- dim1name='pft', &
- long_name='daily maximum of average 2 m height surface air temperature (K)', units='K', &
- interpinic_flag='interp', readvar=readvar, data=this%t_ref2m_max_patch)
-
- call restartvar(ncid=ncid, flag=flag, varname='T_REF2M_MAX_R', xtype=ncd_double, &
- dim1name='pft', &
- long_name='rural daily maximum of average 2 m height surface air temperature (K)', units='K', &
- interpinic_flag='interp', readvar=readvar, data=this%t_ref2m_max_r_patch)
-
- call restartvar(ncid=ncid, flag=flag, varname='T_REF2M_MAX_U', xtype=ncd_double, dim1name='pft', &
- long_name='urban daily maximum of average 2 m height surface air temperature (K)', units='K', &
- interpinic_flag='interp', readvar=readvar, data=this%t_ref2m_max_u_patch)
-
- call restartvar(ncid=ncid, flag=flag, varname='T_REF2M_MIN_INST', xtype=ncd_double, &
- dim1name='pft', &
- long_name='instantaneous daily min of average 2 m height surface air temp (K)', units='K', &
- interpinic_flag='interp', readvar=readvar, data=this%t_ref2m_min_inst_patch)
-
- call restartvar(ncid=ncid, flag=flag, varname='T_REF2M_MIN_INST_R', xtype=ncd_double, &
- dim1name='pft', &
- long_name='rural instantaneous daily min of average 2 m height surface air temp (K)', units='K', &
- interpinic_flag='interp', readvar=readvar, data=this%t_ref2m_min_inst_r_patch)
-
- call restartvar(ncid=ncid, flag=flag, varname='T_REF2M_MIN_INST_U', xtype=ncd_double, dim1name='pft', &
- long_name='urban instantaneous daily min of average 2 m height surface air temp (K)', units='K', &
- interpinic_flag='interp', readvar=readvar, data=this%t_ref2m_min_inst_u_patch)
-
- call restartvar(ncid=ncid, flag=flag, varname='T_REF2M_MAX_INST', xtype=ncd_double, &
- dim1name='pft', &
- long_name='instantaneous daily max of average 2 m height surface air temp (K)', units='K', &
- interpinic_flag='interp', readvar=readvar, data=this%t_ref2m_max_inst_patch)
-
- call restartvar(ncid=ncid, flag=flag, varname='T_REF2M_MAX_INST_R', xtype=ncd_double, &
- dim1name='pft', &
- long_name='rural instantaneous daily max of average 2 m height surface air temp (K)', units='K', &
- interpinic_flag='interp', readvar=readvar, data=this%t_ref2m_max_inst_r_patch)
-
- call restartvar(ncid=ncid, flag=flag, varname='T_REF2M_MAX_INST_U', xtype=ncd_double, dim1name='pft', &
- long_name='urban instantaneous daily max of average 2 m height surface air temp (K)', units='K', &
- interpinic_flag='interp', readvar=readvar, data=this%t_ref2m_max_inst_u_patch)
-
- call restartvar(ncid=ncid, flag=flag, varname='taf', xtype=ncd_double, dim1name='landunit', &
- long_name='urban canopy air temperature', units='K', &
- interpinic_flag='interp', readvar=readvar, data=this%taf_lun)
-
- if (use_crop) then
- call restartvar(ncid=ncid, flag=flag, varname='gdd1020', xtype=ncd_double, &
- dim1name='pft', long_name='20 year average of growing degree-days base 10C from planting', units='ddays', &
- interpinic_flag='interp', readvar=readvar, data=this%gdd1020_patch)
-
- call restartvar(ncid=ncid, flag=flag, varname='gdd820', xtype=ncd_double, &
- dim1name='pft', long_name='20 year average of growing degree-days base 8C from planting', units='ddays', &
- interpinic_flag='interp', readvar=readvar, data=this%gdd820_patch)
-
- call restartvar(ncid=ncid, flag=flag, varname='gdd020', xtype=ncd_double, &
- dim1name='pft', long_name='20 year average of growing degree-days base 0C from planting', units='ddays', &
- interpinic_flag='interp', readvar=readvar, data=this%gdd020_patch)
- end if
-
- if(use_luna)then
- call restartvar(ncid=ncid, flag=flag, varname='tvegd10', xtype=ncd_double, &
- dim1name='pft', long_name='10-day mean daytime vegetation temperature', units='Kelvin', &
- interpinic_flag='interp', readvar=readvar, data=this%t_veg10_day_patch )
- call restartvar(ncid=ncid, flag=flag, varname='tvegd', xtype=ncd_double, &
- dim1name='pft', long_name='accumulative daytime vegetation temperature', units='Kelvin*steps', &
- interpinic_flag='interp', readvar=readvar, data=this%t_veg_day_patch )
- call restartvar(ncid=ncid, flag=flag, varname='tvegn10', xtype=ncd_double, &
- dim1name='pft', long_name='10-day mean nighttime vegetation temperature', units='Kelvin', &
- interpinic_flag='interp', readvar=readvar, data=this%t_veg10_night_patch )
- call restartvar(ncid=ncid, flag=flag, varname='tvegn', xtype=ncd_double, &
- dim1name='pft', long_name='accumulative nighttime vegetation temperature', units='Kelvin*steps', &
- interpinic_flag='interp', readvar=readvar, data=this%t_veg_night_patch )
- call restartvar(ncid=ncid, flag=flag, varname='tair10', xtype=ncd_double, &
- dim1name='pft', long_name='10-day mean air temperature', units='Kelvin', &
- interpinic_flag='interp', readvar=readvar, data=this%t_a10_patch )
- call restartvar(ncid=ncid, flag=flag, varname='ndaysteps', xtype=ncd_double, &
- dim1name='pft', long_name='accumulative daytime steps', units='steps', &
- interpinic_flag='interp', readvar=readvar, data=this%ndaysteps_patch )
- call restartvar(ncid=ncid, flag=flag, varname='nnightsteps', xtype=ncd_double, &
- dim1name='pft', long_name='accumulative nighttime steps', units='steps', &
- interpinic_flag='interp', readvar=readvar, data=this%nnightsteps_patch )
- endif
-
- if ( is_prog_buildtemp )then
- ! landunit type physical state variable - t_building
- call restartvar(ncid=ncid, flag=flag, varname='t_building', xtype=ncd_double, &
- dim1name='landunit', &
- long_name='internal building air temperature', units='K', &
- interpinic_flag='interp', readvar=readvar, data=this%t_building_lun)
- if (flag=='read' .and. .not. readvar) then
- if (masterproc) write(iulog,*) "can't find t_building in initial file..."
- if (masterproc) write(iulog,*) "Initialize t_building to taf"
- this%t_building_lun(bounds%begl:bounds%endl) = this%taf_lun(bounds%begl:bounds%endl)
- end if
-
- ! landunit type physical state variable - t_roof_inner
- call restartvar(ncid=ncid, flag=flag, varname='t_roof_inner', xtype=ncd_double, &
- dim1name='landunit', &
- long_name='roof inside surface temperature', units='K', &
- interpinic_flag='interp', readvar=readvar, data=this%t_roof_inner_lun)
- if (flag=='read' .and. .not. readvar) then
- if (masterproc) write(iulog,*) "can't find t_roof_inner in initial file..."
- if (masterproc) write(iulog,*) "Initialize t_roof_inner to taf"
- this%t_roof_inner_lun(bounds%begl:bounds%endl) = this%taf_lun(bounds%begl:bounds%endl)
- end if
-
- ! landunit type physical state variable - t_sunw_inner
- call restartvar(ncid=ncid, flag=flag, varname='t_sunw_inner', xtype=ncd_double, &
- dim1name='landunit', &
- long_name='sunwall inside surface temperature', units='K', &
- interpinic_flag='interp', readvar=readvar, data=this%t_sunw_inner_lun)
- if (flag=='read' .and. .not. readvar) then
- if (masterproc) write(iulog,*) "can't find t_sunw_inner in initial file..."
- if (masterproc) write(iulog,*) "Initialize t_sunw_inner to taf"
- this%t_sunw_inner_lun(bounds%begl:bounds%endl) = this%taf_lun(bounds%begl:bounds%endl)
- end if
-
- ! landunit type physical state variable - t_shdw_inner
- call restartvar(ncid=ncid, flag=flag, varname='t_shdw_inner', xtype=ncd_double, &
- dim1name='landunit', &
- long_name='shadewall inside surface temperature', units='K', &
- interpinic_flag='interp', readvar=readvar, data=this%t_shdw_inner_lun)
- if (flag=='read' .and. .not. readvar) then
- if (masterproc) write(iulog,*) "can't find t_shdw_inner in initial file..."
- if (masterproc) write(iulog,*) "Initialize t_shdw_inner to taf"
- this%t_shdw_inner_lun(bounds%begl:bounds%endl) = this%taf_lun(bounds%begl:bounds%endl)
- end if
-
- ! landunit type physical state variable - t_floor
- call restartvar(ncid=ncid, flag=flag, varname='t_floor', xtype=ncd_double, &
- dim1name='landunit', &
- long_name='floor temperature', units='K', &
- interpinic_flag='interp', readvar=readvar, data=this%t_floor_lun)
- if (flag=='read' .and. .not. readvar) then
- if (masterproc) write(iulog,*) "can't find t_floor in initial file..."
- if (masterproc) write(iulog,*) "Initialize t_floor to taf"
- this%t_floor_lun(bounds%begl:bounds%endl) = this%taf_lun(bounds%begl:bounds%endl)
- end if
- end if
-
-
- end subroutine Restart
-
- !-----------------------------------------------------------------------
- subroutine InitAccBuffer (this, bounds)
- !
- ! !DESCRIPTION:
- ! Initialize accumulation buffer for all required module accumulated fields
- ! This routine set defaults values that are then overwritten by the
- ! restart file for restart or branch runs
- ! Each interval and accumulation type is unique to each field processed.
- ! Routine [initAccBuffer] defines the fields to be processed
- ! and the type of accumulation.
- ! Routine [updateAccVars] does the actual accumulation for a given field.
- ! Fields are accumulated by calls to subroutine [update_accum_field].
- ! To accumulate a field, it must first be defined in subroutine [initAccVars]
- ! and then accumulated by calls to [updateAccVars].
- ! Four types of accumulations are possible:
- ! o average over time interval
- ! o running mean over time interval
- ! o running accumulation over time interval
- ! Time average fields are only valid at the end of the averaging interval.
- ! Running means are valid once the length of the simulation exceeds the
- ! averaging interval. Accumulated fields are continuously accumulated.
- ! The trigger value "-99999." resets the accumulation to zero.
- !
- ! !USES
- use accumulMod , only : init_accum_field
- use clm_time_manager , only : get_step_size
- use shr_const_mod , only : SHR_CONST_CDAY, SHR_CONST_TKFRZ
- !
- ! !ARGUMENTS:
- class(temperature_type) :: this
- type(bounds_type), intent(in) :: bounds
- !
- ! !LOCAL VARIABLES:
- real(r8) :: dtime
- integer, parameter :: not_used = huge(1)
- !---------------------------------------------------------------------
-
- dtime = get_step_size()
-
- this%t_veg24_patch(bounds%begp:bounds%endp) = spval
- call init_accum_field (name='T_VEG24', units='K', &
- desc='24hr average of vegetation temperature', accum_type='runmean', accum_period=-1, &
- subgrid_type='pft', numlev=1, init_value=0._r8)
-
- this%t_veg240_patch(bounds%begp:bounds%endp) = spval
- call init_accum_field (name='T_VEG240', units='K', &
- desc='240hr average of vegetation temperature', accum_type='runmean', accum_period=-10, &
- subgrid_type='pft', numlev=1, init_value=0._r8)
-
- call init_accum_field(name='TREFAV', units='K', &
- desc='average over an hour of 2-m temperature', accum_type='timeavg', accum_period=nint(3600._r8/dtime), &
- subgrid_type='pft', numlev=1, init_value=0._r8)
-
- call init_accum_field(name='TREFAV_U', units='K', &
- desc='average over an hour of urban 2-m temperature', accum_type='timeavg', accum_period=nint(3600._r8/dtime), &
- subgrid_type='pft', numlev=1, init_value=0._r8)
-
- call init_accum_field(name='TREFAV_R', units='K', &
- desc='average over an hour of rural 2-m temperature', accum_type='timeavg', accum_period=nint(3600._r8/dtime), &
- subgrid_type='pft', numlev=1, init_value=0._r8)
-
- ! The following is a running mean. The accumulation period is set to -10 for a 10-day running mean.
- call init_accum_field (name='T10', units='K', &
- desc='10-day running mean of 2-m temperature', accum_type='runmean', accum_period=-10, &
- subgrid_type='pft', numlev=1,init_value=SHR_CONST_TKFRZ+20._r8)
-
- if ( use_crop )then
- call init_accum_field (name='TDM10', units='K', &
- desc='10-day running mean of min 2-m temperature', accum_type='runmean', accum_period=-10, &
- subgrid_type='pft', numlev=1, init_value=SHR_CONST_TKFRZ)
-
- call init_accum_field (name='TDM5', units='K', &
- desc='5-day running mean of min 2-m temperature', accum_type='runmean', accum_period=-5, &
- subgrid_type='pft', numlev=1, init_value=SHR_CONST_TKFRZ)
- end if
-
- if ( use_crop )then
-
- ! All GDD summations are relative to the planting date (Kucharik & Brye 2003)
- call init_accum_field (name='GDD0', units='K', &
- desc='growing degree-days base 0C from planting', accum_type='runaccum', accum_period=not_used, &
- subgrid_type='pft', numlev=1, init_value=0._r8)
-
- call init_accum_field (name='GDD8', units='K', &
- desc='growing degree-days base 8C from planting', accum_type='runaccum', accum_period=not_used, &
- subgrid_type='pft', numlev=1, init_value=0._r8)
-
- call init_accum_field (name='GDD10', units='K', &
- desc='growing degree-days base 10C from planting', accum_type='runaccum', accum_period=not_used, &
- subgrid_type='pft', numlev=1, init_value=0._r8)
-
- end if
-
- if (use_cndv) then
- ! 30-day average of 2m temperature.
- call init_accum_field (name='TDA', units='K', &
- desc='30-day average of 2-m temperature', accum_type='timeavg', accum_period=-30, &
- subgrid_type='pft', numlev=1, init_value=0._r8)
-
- end if
-
- end subroutine InitAccBuffer
-
- !-----------------------------------------------------------------------
- subroutine InitAccVars(this, bounds)
- !
- ! !DESCRIPTION:
- ! Initialize module variables that are associated with
- ! time accumulated fields. This routine is called for both an initial run
- ! and a restart run (and must therefore must be called after the restart file
- ! is read in and the accumulation buffer is obtained)
- !
- ! !USES
- use accumulMod , only : init_accum_field, extract_accum_field
- use clm_time_manager , only : get_nstep
- use clm_varctl , only : nsrest, nsrStartup
- use abortutils , only : endrun
- !
- ! !ARGUMENTS:
- class(temperature_type) :: this
- type(bounds_type), intent(in) :: bounds
- !
- ! !LOCAL VARIABLES:
- integer :: begp, endp
- integer :: nstep
- integer :: ier
- real(r8), pointer :: rbufslp(:) ! temporary
- !---------------------------------------------------------------------
-
- begp = bounds%begp; endp = bounds%endp
-
- ! Allocate needed dynamic memory for single level pft field
- allocate(rbufslp(begp:endp), stat=ier)
- if (ier/=0) then
- write(iulog,*)' in '
- call endrun(msg="extract_accum_hist allocation error for rbufslp"//&
- errMsg(sourcefile, __LINE__))
- endif
-
- ! Determine time step
- nstep = get_nstep()
-
- call extract_accum_field ('T_VEG24', rbufslp, nstep)
- this%t_veg24_patch(begp:endp) = rbufslp(begp:endp)
-
- call extract_accum_field ('T_VEG240', rbufslp, nstep)
- this%t_veg240_patch(begp:endp) = rbufslp(begp:endp)
-
- call extract_accum_field ('T10', rbufslp, nstep)
- this%t_a10_patch(begp:endp) = rbufslp(begp:endp)
-
- if (use_crop) then
- call extract_accum_field ('TDM10', rbufslp, nstep)
- this%t_a10min_patch(begp:endp)= rbufslp(begp:endp)
-
- call extract_accum_field ('TDM5', rbufslp, nstep)
- this%t_a5min_patch(begp:endp) = rbufslp(begp:endp)
- end if
-
- ! Initialize variables that are to be time accumulated
- ! Initialize 2m ref temperature max and min values
-
- if (nsrest == nsrStartup) then
- this%t_ref2m_max_patch(begp:endp) = spval
- this%t_ref2m_max_r_patch(begp:endp) = spval
- this%t_ref2m_max_u_patch(begp:endp) = spval
-
- this%t_ref2m_min_patch(begp:endp) = spval
- this%t_ref2m_min_r_patch(begp:endp) = spval
- this%t_ref2m_min_u_patch(begp:endp) = spval
-
- this%t_ref2m_max_inst_patch(begp:endp) = -spval
- this%t_ref2m_max_inst_r_patch(begp:endp) = -spval
- this%t_ref2m_max_inst_u_patch(begp:endp) = -spval
-
- this%t_ref2m_min_inst_patch(begp:endp) = spval
- this%t_ref2m_min_inst_r_patch(begp:endp) = spval
- this%t_ref2m_min_inst_u_patch(begp:endp) = spval
- end if
-
- if ( use_crop ) then
-
- call extract_accum_field ('GDD0', rbufslp, nstep)
- this%gdd0_patch(begp:endp) = rbufslp(begp:endp)
-
- call extract_accum_field ('GDD8', rbufslp, nstep) ;
- this%gdd8_patch(begp:endp) = rbufslp(begp:endp)
-
- call extract_accum_field ('GDD10', rbufslp, nstep)
- this%gdd10_patch(begp:endp) = rbufslp(begp:endp)
-
- end if
-
- deallocate(rbufslp)
-
- end subroutine InitAccVars
-
- !-----------------------------------------------------------------------
- subroutine UpdateAccVars (this, bounds)
- !
- ! USES
- use shr_const_mod , only : SHR_CONST_CDAY, SHR_CONST_TKFRZ
- use clm_time_manager , only : get_step_size, get_nstep, is_end_curr_day, get_curr_date
- use accumulMod , only : update_accum_field, extract_accum_field, accumResetVal
- !
- ! !ARGUMENTS:
- class(temperature_type) :: this
- type(bounds_type) , intent(in) :: bounds
-
- !
- ! !LOCAL VARIABLES:
- integer :: m,g,l,c,p ! indices
- integer :: ier ! error status
- integer :: dtime ! timestep size [seconds]
- integer :: nstep ! timestep number
- integer :: year ! year (0, ...) for nstep
- integer :: month ! month (1, ..., 12) for nstep
- integer :: day ! day of month (1, ..., 31) for nstep
- integer :: secs ! seconds into current date for nstep
- logical :: end_cd ! temporary for is_end_curr_day() value
- integer :: begp, endp
- real(r8), pointer :: rbufslp(:) ! temporary single level - pft level
- !---------------------------------------------------------------------
-
- begp = bounds%begp; endp = bounds%endp
-
- dtime = get_step_size()
- nstep = get_nstep()
- call get_curr_date (year, month, day, secs)
-
- ! Allocate needed dynamic memory for single level pft field
-
- allocate(rbufslp(begp:endp), stat=ier)
- if (ier/=0) then
- write(iulog,*)'update_accum_hist allocation error for rbuf1dp'
- call endrun(msg=errMsg(sourcefile, __LINE__))
- endif
-
- ! Accumulate and extract T_VEG24 & T_VEG240
- do p = begp,endp
- rbufslp(p) = this%t_veg_patch(p)
- end do
- call update_accum_field ('T_VEG24' , rbufslp , nstep)
- call extract_accum_field ('T_VEG24' , this%t_veg24_patch , nstep)
- call update_accum_field ('T_VEG240', rbufslp , nstep)
- call extract_accum_field ('T_VEG240', this%t_veg240_patch , nstep)
-
- ! Accumulate and extract TREFAV - hourly average 2m air temperature
- ! Used to compute maximum and minimum of hourly averaged 2m reference
- ! temperature over a day. Note that "spval" is returned by the call to
- ! accext if the time step does not correspond to the end of an
- ! accumulation interval. First, initialize the necessary values for
- ! an initial run at the first time step the accumulator is called
-
- call update_accum_field ('TREFAV', this%t_ref2m_patch, nstep)
- call extract_accum_field ('TREFAV', rbufslp, nstep)
- end_cd = is_end_curr_day()
- do p = begp,endp
- if (rbufslp(p) /= spval) then
- this%t_ref2m_max_inst_patch(p) = max(rbufslp(p), this%t_ref2m_max_inst_patch(p))
- this%t_ref2m_min_inst_patch(p) = min(rbufslp(p), this%t_ref2m_min_inst_patch(p))
- endif
- if (end_cd) then
- this%t_ref2m_max_patch(p) = this%t_ref2m_max_inst_patch(p)
- this%t_ref2m_min_patch(p) = this%t_ref2m_min_inst_patch(p)
- this%t_ref2m_max_inst_patch(p) = -spval
- this%t_ref2m_min_inst_patch(p) = spval
- else if (secs == dtime) then
- this%t_ref2m_max_patch(p) = spval
- this%t_ref2m_min_patch(p) = spval
- endif
- end do
-
- ! Accumulate and extract TREFAV_U - hourly average urban 2m air temperature
- ! Used to compute maximum and minimum of hourly averaged 2m reference
- ! temperature over a day. Note that "spval" is returned by the call to
- ! accext if the time step does not correspond to the end of an
- ! accumulation interval. First, initialize the necessary values for
- ! an initial run at the first time step the accumulator is called
-
- call update_accum_field ('TREFAV_U', this%t_ref2m_u_patch, nstep)
- call extract_accum_field ('TREFAV_U', rbufslp, nstep)
- do p = begp,endp
- l = patch%landunit(p)
- if (rbufslp(p) /= spval) then
- this%t_ref2m_max_inst_u_patch(p) = max(rbufslp(p), this%t_ref2m_max_inst_u_patch(p))
- this%t_ref2m_min_inst_u_patch(p) = min(rbufslp(p), this%t_ref2m_min_inst_u_patch(p))
- endif
- if (end_cd) then
- if (lun%urbpoi(l)) then
- this%t_ref2m_max_u_patch(p) = this%t_ref2m_max_inst_u_patch(p)
- this%t_ref2m_min_u_patch(p) = this%t_ref2m_min_inst_u_patch(p)
- this%t_ref2m_max_inst_u_patch(p) = -spval
- this%t_ref2m_min_inst_u_patch(p) = spval
- end if
- else if (secs == dtime) then
- this%t_ref2m_max_u_patch(p) = spval
- this%t_ref2m_min_u_patch(p) = spval
- endif
- end do
-
- ! Accumulate and extract TREFAV_R - hourly average rural 2m air temperature
- ! Used to compute maximum and minimum of hourly averaged 2m reference
- ! temperature over a day. Note that "spval" is returned by the call to
- ! accext if the time step does not correspond to the end of an
- ! accumulation interval. First, initialize the necessary values for
- ! an initial run at the first time step the accumulator is called
-
- call update_accum_field ('TREFAV_R', this%t_ref2m_r_patch, nstep)
- call extract_accum_field ('TREFAV_R', rbufslp, nstep)
- do p = begp,endp
- l = patch%landunit(p)
- if (rbufslp(p) /= spval) then
- this%t_ref2m_max_inst_r_patch(p) = max(rbufslp(p), this%t_ref2m_max_inst_r_patch(p))
- this%t_ref2m_min_inst_r_patch(p) = min(rbufslp(p), this%t_ref2m_min_inst_r_patch(p))
- endif
- if (end_cd) then
- if (.not.(lun%ifspecial(l))) then
- this%t_ref2m_max_r_patch(p) = this%t_ref2m_max_inst_r_patch(p)
- this%t_ref2m_min_r_patch(p) = this%t_ref2m_min_inst_r_patch(p)
- this%t_ref2m_max_inst_r_patch(p) = -spval
- this%t_ref2m_min_inst_r_patch(p) = spval
- end if
- else if (secs == dtime) then
- this%t_ref2m_max_r_patch(p) = spval
- this%t_ref2m_min_r_patch(p) = spval
- endif
- end do
-
- ! Accumulate and extract T10
- !(acumulates TSA as 10-day running mean)
-
- call update_accum_field ('T10', this%t_ref2m_patch, nstep)
- call extract_accum_field ('T10', this%t_a10_patch, nstep)
-
- if ( use_crop )then
- ! Accumulate and extract TDM10
-
- do p = begp,endp
- rbufslp(p) = min(this%t_ref2m_min_patch(p),this%t_ref2m_min_inst_patch(p)) !slevis: ok choice?
- if (rbufslp(p) > 1.e30_r8) rbufslp(p) = SHR_CONST_TKFRZ !and were 'min'&
- end do !'min_inst' not initialized?
- call update_accum_field ('TDM10', rbufslp, nstep)
- call extract_accum_field ('TDM10', this%t_a10min_patch, nstep)
-
- ! Accumulate and extract TDM5
-
- do p = begp,endp
- rbufslp(p) = min(this%t_ref2m_min_patch(p),this%t_ref2m_min_inst_patch(p)) !slevis: ok choice?
- if (rbufslp(p) > 1.e30_r8) rbufslp(p) = SHR_CONST_TKFRZ !and were 'min'&
- end do !'min_inst' not initialized?
- call update_accum_field ('TDM5', rbufslp, nstep)
- call extract_accum_field ('TDM5', this%t_a5min_patch, nstep)
-
- ! Accumulate and extract GDD0
-
- do p = begp,endp
- ! Avoid unnecessary calculations over inactive points
- if (patch%active(p)) then
- g = patch%gridcell(p)
- if (month==1 .and. day==1 .and. secs==dtime) then
- rbufslp(p) = accumResetVal ! reset gdd
- else if (( month > 3 .and. month < 10 .and. grc%latdeg(g) >= 0._r8) .or. &
- ((month > 9 .or. month < 4) .and. grc%latdeg(g) < 0._r8) ) then
- rbufslp(p) = max(0._r8, min(26._r8, this%t_ref2m_patch(p)-SHR_CONST_TKFRZ)) * dtime/SHR_CONST_CDAY
- else
- rbufslp(p) = 0._r8 ! keeps gdd unchanged at other times (eg, through Dec in NH)
- end if
- end if
- end do
- call update_accum_field ('GDD0', rbufslp, nstep)
- call extract_accum_field ('GDD0', this%gdd0_patch, nstep)
-
- ! Accumulate and extract GDD8
-
- do p = begp,endp
- ! Avoid unnecessary calculations over inactive points
- if (patch%active(p)) then
- g = patch%gridcell(p)
- if (month==1 .and. day==1 .and. secs==dtime) then
- rbufslp(p) = accumResetVal ! reset gdd
- else if (( month > 3 .and. month < 10 .and. grc%latdeg(g) >= 0._r8) .or. &
- ((month > 9 .or. month < 4) .and. grc%latdeg(g) < 0._r8) ) then
- rbufslp(p) = max(0._r8, min(30._r8, &
- this%t_ref2m_patch(p)-(SHR_CONST_TKFRZ + 8._r8))) * dtime/SHR_CONST_CDAY
- else
- rbufslp(p) = 0._r8 ! keeps gdd unchanged at other times (eg, through Dec in NH)
- end if
- end if
- end do
- call update_accum_field ('GDD8', rbufslp, nstep)
- call extract_accum_field ('GDD8', this%gdd8_patch, nstep)
-
- ! Accumulate and extract GDD10
-
- do p = begp,endp
- ! Avoid unnecessary calculations over inactive points
- if (patch%active(p)) then
- g = patch%gridcell(p)
- if (month==1 .and. day==1 .and. secs==dtime) then
- rbufslp(p) = accumResetVal ! reset gdd
- else if (( month > 3 .and. month < 10 .and. grc%latdeg(g) >= 0._r8) .or. &
- ((month > 9 .or. month < 4) .and. grc%latdeg(g) < 0._r8) ) then
- rbufslp(p) = max(0._r8, min(30._r8, &
- this%t_ref2m_patch(p)-(SHR_CONST_TKFRZ + 10._r8))) * dtime/SHR_CONST_CDAY
- else
- rbufslp(p) = 0._r8 ! keeps gdd unchanged at other times (eg, through Dec in NH)
- end if
- end if
- end do
- call update_accum_field ('GDD10', rbufslp, nstep)
- call extract_accum_field ('GDD10', this%gdd10_patch, nstep)
-
- end if
-
- deallocate(rbufslp)
-
- end subroutine UpdateAccVars
-
-end module TemperatureType
diff --git a/src/biogeophys/TridiagonalMod.F90 b/src/biogeophys/TridiagonalMod.F90
deleted file mode 100644
index 68dbd71c..00000000
--- a/src/biogeophys/TridiagonalMod.F90
+++ /dev/null
@@ -1,118 +0,0 @@
-module TridiagonalMod
-
-#include "shr_assert.h"
-
- !-----------------------------------------------------------------------
- ! !DESCRIPTION:
- ! Tridiagonal matrix solution
- !
- ! !PUBLIC TYPES:
- implicit none
- save
- !
- ! !PUBLIC MEMBER FUNCTIONS:
- public :: Tridiagonal
-
- character(len=*), parameter, private :: sourcefile = &
- __FILE__
- !-----------------------------------------------------------------------
-
-contains
-
- !-----------------------------------------------------------------------
- subroutine Tridiagonal (bounds, lbj, ubj, jtop, numf, filter, a, b, c, r, u)
- !
- ! !DESCRIPTION:
- ! Tridiagonal matrix solution
- !
- ! !USES:
- use shr_kind_mod , only : r8 => shr_kind_r8
- use shr_log_mod , only : errMsg => shr_log_errMsg
- use clm_varpar , only : nlevurb
- use column_varcon , only : icol_roof, icol_sunwall, icol_shadewall
- use clm_varctl , only : iulog
- use decompMod , only : bounds_type
- use ColumnType , only : col
- !
- ! !ARGUMENTS:
- implicit none
- type(bounds_type), intent(in) :: bounds
- integer , intent(in) :: lbj, ubj ! lbinning and ubing level indices
- integer , intent(in) :: jtop( bounds%begc: ) ! top level for each column [col]
- integer , intent(in) :: numf ! filter dimension
- integer , intent(in) :: filter(:) ! filter
- real(r8), intent(in) :: a( bounds%begc: , lbj: ) ! "a" left off diagonal of tridiagonal matrix [col, j]
- real(r8), intent(in) :: b( bounds%begc: , lbj: ) ! "b" diagonal column for tridiagonal matrix [col, j]
- real(r8), intent(in) :: c( bounds%begc: , lbj: ) ! "c" right off diagonal tridiagonal matrix [col, j]
- real(r8), intent(in) :: r( bounds%begc: , lbj: ) ! "r" forcing term of tridiagonal matrix [col, j]
- real(r8), intent(inout) :: u( bounds%begc: , lbj: ) ! solution [col, j]
- !
- integer :: j,ci,fc !indices
- real(r8) :: gam(bounds%begc:bounds%endc,lbj:ubj) !temporary
- real(r8) :: bet(bounds%begc:bounds%endc) !temporary
- !-----------------------------------------------------------------------
-
- ! Enforce expected array sizes
- SHR_ASSERT_ALL((ubound(jtop) == (/bounds%endc/)), errMsg(sourcefile, __LINE__))
- SHR_ASSERT_ALL((ubound(a) == (/bounds%endc, ubj/)), errMsg(sourcefile, __LINE__))
- SHR_ASSERT_ALL((ubound(b) == (/bounds%endc, ubj/)), errMsg(sourcefile, __LINE__))
- SHR_ASSERT_ALL((ubound(c) == (/bounds%endc, ubj/)), errMsg(sourcefile, __LINE__))
- SHR_ASSERT_ALL((ubound(r) == (/bounds%endc, ubj/)), errMsg(sourcefile, __LINE__))
- SHR_ASSERT_ALL((ubound(u) == (/bounds%endc, ubj/)), errMsg(sourcefile, __LINE__))
-
- ! Solve the matrix
-
- do fc = 1,numf
- ci = filter(fc)
- bet(ci) = b(ci,jtop(ci))
- end do
-
- do j = lbj, ubj
- do fc = 1,numf
- ci = filter(fc)
- if ((col%itype(ci) == icol_sunwall .or. col%itype(ci) == icol_shadewall &
- .or. col%itype(ci) == icol_roof) .and. j <= nlevurb) then
- if (j >= jtop(ci)) then
- if (j == jtop(ci)) then
- u(ci,j) = r(ci,j) / bet(ci)
- else
- gam(ci,j) = c(ci,j-1) / bet(ci)
- bet(ci) = b(ci,j) - a(ci,j) * gam(ci,j)
- u(ci,j) = (r(ci,j) - a(ci,j)*u(ci,j-1)) / bet(ci)
- end if
- end if
- else if (col%itype(ci) /= icol_sunwall .and. col%itype(ci) /= icol_shadewall &
- .and. col%itype(ci) /= icol_roof) then
- if (j >= jtop(ci)) then
- if (j == jtop(ci)) then
- u(ci,j) = r(ci,j) / bet(ci)
- else
- gam(ci,j) = c(ci,j-1) / bet(ci)
- bet(ci) = b(ci,j) - a(ci,j) * gam(ci,j)
- u(ci,j) = (r(ci,j) - a(ci,j)*u(ci,j-1)) / bet(ci)
- end if
- end if
- end if
- end do
- end do
-
- do j = ubj-1,lbj,-1
- do fc = 1,numf
- ci = filter(fc)
- if ((col%itype(ci) == icol_sunwall .or. col%itype(ci) == icol_shadewall &
- .or. col%itype(ci) == icol_roof) .and. j <= nlevurb-1) then
- if (j >= jtop(ci)) then
- u(ci,j) = u(ci,j) - gam(ci,j+1) * u(ci,j+1)
- end if
- else if (col%itype(ci) /= icol_sunwall .and. col%itype(ci) /= icol_shadewall &
- .and. col%itype(ci) /= icol_roof) then
- if (j >= jtop(ci)) then
- u(ci,j) = u(ci,j) - gam(ci,j+1) * u(ci,j+1)
- end if
- end if
- end do
- end do
-
- end subroutine Tridiagonal
-
-end module TridiagonalMod
diff --git a/src/biogeophys/UrbBuildTempOleson2015Mod.F90 b/src/biogeophys/UrbBuildTempOleson2015Mod.F90
deleted file mode 100644
index eaf1c14c..00000000
--- a/src/biogeophys/UrbBuildTempOleson2015Mod.F90
+++ /dev/null
@@ -1,938 +0,0 @@
-module UrbBuildTempOleson2015Mod
-
-#include "shr_assert.h"
-
- !-----------------------------------------------------------------------
- ! !DESCRIPTION:
- ! Calculates internal building air temperature
- !
- ! !USES:
- use shr_kind_mod , only : r8 => shr_kind_r8
- use shr_log_mod , only : errMsg => shr_log_errMsg
- use decompMod , only : bounds_type
- use abortutils , only : endrun
- use perf_mod , only : t_startf, t_stopf
- use clm_varctl , only : iulog
- use UrbanParamsType , only : urbanparams_type
- use UrbanTimeVarType , only : urbantv_type
- use EnergyFluxType , only : energyflux_type
- use TemperatureType , only : temperature_type
- use LandunitType , only : lun
- use ColumnType , only : col
- !
- ! !PUBLIC TYPES:
- implicit none
- save
- private
- !
- ! !PUBLIC MEMBER FUNCTIONS:
- public :: BuildingTemperature ! Calculation of interior building air temperature, inner
- ! surface temperatures of walls and roof, and floor temperature
-
- character(len=*), parameter, private :: sourcefile = &
- __FILE__
- !-----------------------------------------------------------------------
-
-contains
-
-!-----------------------------------------------------------------------
-!BOP
-!
-! !IROUTINE: BuildingTemperature
-!
-! !INTERFACE:
- subroutine BuildingTemperature (bounds, num_urbanl, filter_urbanl, num_nolakec, &
- filter_nolakec, tk, urbanparams_inst, temperature_inst, &
- energyflux_inst, urbantv_inst)
-!
-! !DESCRIPTION:
-! Solve for t_building, inner surface temperatures of roof, sunw, shdw, and floor temperature
-! Five equations, five unknowns (t_roof_inner,t_sunw_inner,t_shdw_inner,t_floor,t_building at n+1)
-! Derived from energy balance equations at each surface and building air
-! rd (radiation), cd (conduction), cv (convection)
-! qrd_roof + qcd_roof + qcv_roof = 0
-! qrd_sunw + qcd_sunw + qcv_sunw = 0
-! qrd_shdw + qcd_shdw + qcv_shdw = 0
-! qrd_floor + qcd_floor + qcv_floor = 0
-! Vbld*rho_dair*cpair*(dt_building/dt) = sum(Asfc*hcv_sfc*(t_sfc - t_building)
-! + Vvent*rho_dair*cpair*(taf - t_building)
-! where Vlbd is volume of building air,
-! rho_dair is density of dry air at t_building (kg m-3),
-! cpair is specific heat of dry air (J kg-1 K-1),
-! dt_building is change in interior building temperature (K),
-! dt is timestep (s),
-! Asfc is surface area of roof, sunw, shdw, floor (m2)
-! hcv_sfc is convective heat transfer coefficient for roof, sunw, shdw, floor (W m-2 K-1)
-! t_sfc is inner surface temperature of roof, sunw, shdw, floor (K)
-! t_building is interior building temperature (K)
-! Vvent is ventilation airflow rate (m3 s-1)
-! taf is urban canyon air temperature (K)
-!
-! This methodology was introduced as part of CLM5.0.
-!
-! Conduction fluxes are obtained from terms of soil temperature equations
-! Radiation fluxes are obtained from linearizing the longwave radiation equations taking into
-! account view factors for each surface.
-
-! qrd is positive away from the surface toward room air, so qrd = emitted - absorbed,
-! so positive qrd will result in a decrease in temperature
-! qcd_floor is positive away from surface toward room air, so positive
-! qcd will result in a decrease in temperature
-! qcv is positive toward room air, so positive qcv (t_surface > t_room) will
-! result in a decrease in temperature
-
-! The LAPACK routine DGESV is used to compute the solution to the real system of linear equations
-! a * x = b,
-! where a is an n-by-n matrix and x and b are n-by-nrhs matrices.
-!
-! The LU decomposition with partial pivoting and row interchanges is
-! used to factor a as
-! a = P * L * U,
-! where P is a permutation matrix, L is unit lower triangular, and U is
-! upper triangular. The factored form of a is then used to solve the
-! system of equations a * x = b.
-
-! The following is from LAPACK documentation
-! DGESV computes the solution to system of linear equations A * X = B for GE matrices
-!
-! =========== DOCUMENTATION ===========
-!
-! Online html documentation available at
-! http://www.netlib.org/lapack/explore-html/
-!
-! Download DGESV + dependencies
-!
-! [TGZ]
-!
-! [ZIP]
-!
-! [TXT]
-!
-! Definition:
-! ===========
-!
-! SUBROUTINE DGESV( N, NRHS, A, LDA, IPIV, B, LDB, INFO )
-!
-! .. Scalar Arguments ..
-! INTEGER INFO, LDA, LDB, N, NRHS
-! ..
-! .. Array Arguments ..
-! INTEGER IPIV( * )
-! DOUBLE PRECISION A( LDA, * ), B( LDB, * )
-! ..
-!
-!
-! =============
-!
-!
-! DGESV computes the solution to a real system of linear equations
-! A * X = B,
-! where A is an N-by-N matrix and X and B are N-by-NRHS matrices.
-!
-! The LU decomposition with partial pivoting and row interchanges is
-! used to factor A as
-! A = P * L * U,
-! where P is a permutation matrix, L is unit lower triangular, and U is
-! upper triangular. The factored form of A is then used to solve the
-! system of equations A * X = B.
-!
-! Arguments:
-! ==========
-!
-! \param[in] N
-! N is INTEGER
-! The number of linear equations, i.e., the order of the
-! matrix A. N >= 0.
-!
-! \param[in] NRHS
-! NRHS is INTEGER
-! The number of right hand sides, i.e., the number of columns
-! of the matrix B. NRHS >= 0.
-!
-! \param[in,out] A
-! A is DOUBLE PRECISION array, dimension (LDA,N)
-! On entry, the N-by-N coefficient matrix A.
-! On exit, the factors L and U from the factorization
-! A = P*L*U; the unit diagonal elements of L are not stored.
-!
-! \param[in] LDA
-! LDA is INTEGER
-! The leading dimension of the array A. LDA >= max(1,N).
-!
-! \param[out] IPIV
-! IPIV is INTEGER array, dimension (N)
-! The pivot indices that define the permutation matrix P;
-! row i of the matrix was interchanged with row IPIV(i).
-!
-! \param[in,out] B
-! B is DOUBLE PRECISION array, dimension (LDB,NRHS)
-! On entry, the N-by-NRHS matrix of right hand side matrix B.
-! On exit, if INFO = 0, the N-by-NRHS solution matrix X.
-!
-! \param[in] LDB
-! LDB is INTEGER
-! The leading dimension of the array B. LDB >= max(1,N).
-!
-! \param[out] INFO
-! INFO is INTEGER
-! = 0: successful exit
-! < 0: if INFO = -i, the i-th argument had an illegal value
-! > 0: if INFO = i, U(i,i) is exactly zero. The factorization
-! has been completed, but the factor U is exactly
-! singular, so the solution could not be computed.
-!
-! Authors:
-! ========
-!
-! \author Univ. of Tennessee
-! \author Univ. of California Berkeley
-! \author Univ. of Colorado Denver
-! \author NAG Ltd.
-!
-! \date November 2011
-!
-! \ingroup doubleGEsolve
-
-! !CALLED FROM:
-! subroutine SoilTemperature in this module
-!
-! !REVISION HISTORY:
-! 08/17/12 Keith Oleson: Initial code
-
-!
-! !USES:
- use shr_kind_mod , only : r8 => shr_kind_r8
- use clm_time_manager, only : get_step_size
- use clm_varcon , only : rair, pstd, cpair, sb, hcv_roof, hcv_roof_enhanced, &
- hcv_floor, hcv_floor_enhanced, hcv_sunw, hcv_shdw, &
- em_roof_int, em_floor_int, em_sunw_int, em_shdw_int, &
- dz_floor, dens_floor, cp_floor, vent_ach
- use column_varcon , only : icol_roof, icol_sunwall, icol_shadewall
- use clm_varctl , only : iulog
- use abortutils , only : endrun
- use clm_varpar , only : nlevurb, nlevsno, nlevgrnd
- use UrbanParamsType , only : urban_hac, urban_hac_off, urban_hac_on, urban_wasteheat_on
-!
-! !ARGUMENTS:
- implicit none
- type(bounds_type), intent(in) :: bounds ! bounds
- integer , intent(in) :: num_nolakec ! number of column non-lake points in column filter
- integer , intent(in) :: filter_nolakec(:) ! column filter for non-lake points
- integer , intent(in) :: num_urbanl ! number of urban landunits in clump
- integer , intent(in) :: filter_urbanl(:) ! urban landunit filter
- real(r8), intent(in) :: tk(bounds%begc: , -nlevsno+1: ) ! thermal conductivity (W m-1 K-1) [col, j]
- type(urbanparams_type), intent(in) :: urbanparams_inst ! urban parameters
- type(temperature_type), intent(inout) :: temperature_inst ! temperature variables
- type(energyflux_type) , intent(inout) :: energyflux_inst ! energy flux variables
- type(urbantv_type) , intent(in) :: urbantv_inst ! urban time varying variables
-!
-! !LOCAL VARIABLES:
- integer, parameter :: neq = 5 ! number of equation/unknowns
- integer :: fc,fl,c,l ! indices
- real(r8) :: dtime ! land model time step (s)
- real(r8) :: t_roof_inner_bef(bounds%begl:bounds%endl) ! roof inside surface temperature at previous time step (K)
- real(r8) :: t_sunw_inner_bef(bounds%begl:bounds%endl) ! sunwall inside surface temperature at previous time step (K)
- real(r8) :: t_shdw_inner_bef(bounds%begl:bounds%endl) ! shadewall inside surface temperature at previous time step (K)
- real(r8) :: t_floor_bef(bounds%begl:bounds%endl) ! floor temperature at previous time step (K)
- real(r8) :: t_building_bef(bounds%begl:bounds%endl) ! internal building air temperature at previous time step [K]
- real(r8) :: t_building_bef_hac(bounds%begl:bounds%endl)! internal building air temperature before applying HAC [K]
- real(r8) :: hcv_roofi(bounds%begl:bounds%endl) ! roof convective heat transfer coefficient (W m-2 K-1)
- real(r8) :: hcv_sunwi(bounds%begl:bounds%endl) ! sunwall convective heat transfer coefficient (W m-2 K-1)
- real(r8) :: hcv_shdwi(bounds%begl:bounds%endl) ! shadewall convective heat transfer coefficient (W m-2 K-1)
- real(r8) :: hcv_floori(bounds%begl:bounds%endl) ! floor convective heat transfer coefficient (W m-2 K-1)
- real(r8) :: em_roofi(bounds%begl:bounds%endl) ! roof inside surface emissivity (-)
- real(r8) :: em_sunwi(bounds%begl:bounds%endl) ! sunwall inside surface emissivity (-)
- real(r8) :: em_shdwi(bounds%begl:bounds%endl) ! shadewall inside surface emissivity (-)
- real(r8) :: em_floori(bounds%begl:bounds%endl) ! floor inside surface emissivity (-)
- real(r8) :: dz_floori(bounds%begl:bounds%endl) ! concrete floor thickness (m)
- real(r8) :: cp_floori(bounds%begl:bounds%endl) ! concrete floor volumetric heat capacity (J m-3 K-1)
- real(r8) :: cv_floori(bounds%begl:bounds%endl) ! intermediate calculation for concrete floor (W m-2 K-1)
- real(r8) :: rho_dair(bounds%begl:bounds%endl) ! density of dry air at standard pressure and t_building (kg m-3)
- real(r8) :: vf_rf(bounds%begl:bounds%endl) ! view factor of roof for floor (-)
- real(r8) :: vf_fr(bounds%begl:bounds%endl) ! view factor of floor for roof (-)
- real(r8) :: vf_wf(bounds%begl:bounds%endl) ! view factor of wall for floor (-)
- real(r8) :: vf_fw(bounds%begl:bounds%endl) ! view factor of floor for wall (-)
- real(r8) :: vf_rw(bounds%begl:bounds%endl) ! view factor of roof for wall (-)
- real(r8) :: vf_wr(bounds%begl:bounds%endl) ! view factor of wall for roof (-)
- real(r8) :: vf_ww(bounds%begl:bounds%endl) ! view factor of wall for wall (-)
- real(r8) :: zi_roof_innerl(bounds%begl:bounds%endl) ! interface depth of nlevurb roof (m)
- real(r8) :: z_roof_innerl(bounds%begl:bounds%endl) ! node depth of nlevurb roof (m)
- real(r8) :: zi_sunw_innerl(bounds%begl:bounds%endl) ! interface depth of nlevurb sunwall (m)
- real(r8) :: z_sunw_innerl(bounds%begl:bounds%endl) ! node depth of nlevurb sunwall (m)
- real(r8) :: zi_shdw_innerl(bounds%begl:bounds%endl) ! interface depth of nlevurb shadewall (m)
- real(r8) :: z_shdw_innerl(bounds%begl:bounds%endl) ! node depth of nlevurb shadewall (m)
- real(r8) :: t_roof_innerl_bef(bounds%begl:bounds%endl) ! roof temperature at nlevurb node depth at previous time step (K)
- real(r8) :: t_sunw_innerl_bef(bounds%begl:bounds%endl) ! sunwall temperature at nlevurb node depth at previous time step (K)
- real(r8) :: t_shdw_innerl_bef(bounds%begl:bounds%endl) ! shadewall temperature at nlevurb node depth at previous time step (K)
- real(r8) :: t_roof_innerl(bounds%begl:bounds%endl) ! roof temperature at nlevurb node depth (K)
- real(r8) :: t_sunw_innerl(bounds%begl:bounds%endl) ! sunwall temperature at nlevurb node depth (K)
- real(r8) :: t_shdw_innerl(bounds%begl:bounds%endl) ! shadewall temperature at nlevurb node depth (K)
- real(r8) :: tk_roof_innerl(bounds%begl:bounds%endl) ! roof thermal conductivity at nlevurb interface depth (W m-1 K-1)
- real(r8) :: tk_sunw_innerl(bounds%begl:bounds%endl) ! sunwall thermal conductivity at nlevurb interface depth (W m-1 K-1)
- real(r8) :: tk_shdw_innerl(bounds%begl:bounds%endl) ! shadewall thermal conductivity at nlevurb interface depth (W m-1 K-1)
- real(r8) :: qrd_roof(bounds%begl:bounds%endl) ! roof inside net longwave for energy balance check (W m-2)
- real(r8) :: qrd_sunw(bounds%begl:bounds%endl) ! sunwall inside net longwave for energy balance check (W m-2)
- real(r8) :: qrd_shdw(bounds%begl:bounds%endl) ! shadewall inside net longwave for energy balance check (W m-2)
- real(r8) :: qrd_floor(bounds%begl:bounds%endl) ! floor inside net longwave for energy balance check (W m-2)
- real(r8) :: qrd_building(bounds%begl:bounds%endl) ! building inside net longwave for energy balance check (W m-2)
- real(r8) :: qcv_roof(bounds%begl:bounds%endl) ! roof inside convection flux for energy balance check (W m-2)
- real(r8) :: qcv_sunw(bounds%begl:bounds%endl) ! sunwall inside convection flux for energy balance check (W m-2)
- real(r8) :: qcv_shdw(bounds%begl:bounds%endl) ! shadewall inside convection flux for energy balance check (W m-2)
- real(r8) :: qcv_floor(bounds%begl:bounds%endl) ! floor inside convection flux for energy balance check (W m-2)
- real(r8) :: qcd_roof(bounds%begl:bounds%endl) ! roof inside conduction flux for energy balance check (W m-2)
- real(r8) :: qcd_sunw(bounds%begl:bounds%endl) ! sunwall inside conduction flux for energy balance check (W m-2)
- real(r8) :: qcd_shdw(bounds%begl:bounds%endl) ! shadewall inside conduction flux for energy balance check (W m-2)
- real(r8) :: qcd_floor(bounds%begl:bounds%endl) ! floor inside conduction flux for energy balance check (W m-2)
- real(r8) :: enrgy_bal_roof(bounds%begl:bounds%endl) ! roof inside energy balance (W m-2)
- real(r8) :: enrgy_bal_sunw(bounds%begl:bounds%endl) ! sunwall inside energy balance (W m-2)
- real(r8) :: enrgy_bal_shdw(bounds%begl:bounds%endl) ! shadewall inside energy balance (W m-2)
- real(r8) :: enrgy_bal_floor(bounds%begl:bounds%endl) ! floor inside energy balance (W m-2)
- real(r8) :: enrgy_bal_buildair(bounds%begl:bounds%endl)! building air energy balance (W m-2)
- real(r8) :: sum ! sum of view factors for floor, wall, roof
- integer :: n ! number of linear equations (= neq)
- integer :: nrhs ! number of right hand sides (= 1)
- real(r8) :: a(neq,neq) ! n-by-n coefficient matrix a
- integer :: lda ! leading dimension of the matrix a
- integer :: ldb ! leading dimension of the matrix b
- real(r8) :: result(neq) ! on entry, the right hand side of matrix b
- ! on exit, if info = 0, the n-by-nrhs solution matrix x
- integer :: info ! exit information for LAPACK routine dgesv
- integer :: ipiv(neq) ! the pivot indices that define the permutation matrix P
-!EOP
-!-----------------------------------------------------------------------
-
- ! Enforce expected array sizes
- SHR_ASSERT_ALL((ubound(tk) == (/bounds%endc, nlevgrnd/)), errMsg(sourcefile, __LINE__))
-
- associate(&
- clandunit => col%landunit , & ! Input: [integer (:)] column's landunit
- ctype => col%itype , & ! Input: [integer (:)] column type
- zi => col%zi , & ! Input: [real(r8) (:,:)] interface level below a "z" level (m)
- z => col%z , & ! Input: [real(r8) (:,:)] layer thickness (m)
-
- ht_roof => lun%ht_roof , & ! Input: [real(r8) (:)] height of urban roof (m)
- canyon_hwr => lun%canyon_hwr , & ! Input: [real(r8) (:)] ratio of building height to street hwidth (-)
- wtlunit_roof => lun%wtlunit_roof , & ! Input: [real(r8) (:)] weight of roof with respect to landunit
- urbpoi => lun%urbpoi , & ! Input: [logical (:)] true => landunit is an urban point
-
- taf => temperature_inst%taf_lun , & ! Input: [real(r8) (:)] urban canopy air temperature (K)
- tssbef => temperature_inst%t_ssbef_col , & ! Input: [real(r8) (:,:)] temperature at previous time step (K)
- t_soisno => temperature_inst%t_soisno_col , & ! Input: [real(r8) (:,:)] soil temperature (K)
- t_roof_inner => temperature_inst%t_roof_inner_lun , & ! InOut: [real(r8) (:)] roof inside surface temperature (K)
- t_sunw_inner => temperature_inst%t_sunw_inner_lun , & ! InOut: [real(r8) (:)] sunwall inside surface temperature (K)
- t_shdw_inner => temperature_inst%t_shdw_inner_lun , & ! InOut: [real(r8) (:)] shadewall inside surface temperature (K)
- t_floor => temperature_inst%t_floor_lun , & ! InOut: [real(r8) (:)] floor temperature (K)
- t_building => temperature_inst%t_building_lun , & ! InOut: [real(r8) (:)] internal building air temperature (K)
-
- t_building_max => urbantv_inst%t_building_max , & ! Input: [real(r8) (:)] maximum internal building air temperature (K)
- t_building_min => urbanparams_inst%t_building_min , & ! Input: [real(r8) (:)] minimum internal building air temperature (K)
-
- eflx_building => energyflux_inst%eflx_building_lun , & ! Output: [real(r8) (:)] building heat flux from change in interior building air temperature (W/m**2)
- eflx_urban_ac => energyflux_inst%eflx_urban_ac_lun , & ! Output: [real(r8) (:)] urban air conditioning flux (W/m**2)
- eflx_urban_heat => energyflux_inst%eflx_urban_heat_lun & ! Output: [real(r8) (:)] urban heating flux (W/m**2)
- )
-
- ! Get step size
-
- dtime = get_step_size()
-
- ! 1. Save t_* at previous time step
- ! 2. Set convective heat transfer coefficients (Bueno et al. 2012, GMD).
- ! An alternative is Salamanca et al. 2010, TAC, where they are all set to 8 W m-2 K-1.
- ! See clm_varcon.F90
- ! 3. Set inner surface emissivities (Bueno et al. 2012, GMD).
- ! 4. Set concrete floor properties (Salamanca et al. 2010, TAC).
- do fl = 1,num_urbanl
- l = filter_urbanl(fl)
- if (urbpoi(l)) then
- t_roof_inner_bef(l) = t_roof_inner(l)
- t_sunw_inner_bef(l) = t_sunw_inner(l)
- t_shdw_inner_bef(l) = t_shdw_inner(l)
- t_floor_bef(l) = t_floor(l)
- t_building_bef(l) = t_building(l)
- if (t_roof_inner_bef(l) .le. t_building_bef(l)) then
- hcv_roofi(l) = hcv_roof_enhanced
- else
- hcv_roofi(l) = hcv_roof
- end if
- if (t_floor_bef(l) .ge. t_building_bef(l)) then
- hcv_floori(l) = hcv_floor_enhanced
- else
- hcv_floori(l) = hcv_floor
- end if
- hcv_sunwi(l) = hcv_sunw
- hcv_shdwi(l) = hcv_shdw
- em_roofi(l) = em_roof_int
- em_sunwi(l) = em_sunw_int
- em_shdwi(l) = em_shdw_int
- em_floori(l) = em_floor_int
- ! Concrete floor thickness (m)
- dz_floori(l) = dz_floor
- ! Concrete floor volumetric heat capacity (J m-3 K-1)
- cp_floori(l) = cp_floor
- ! Intermediate calculation for concrete floor (W m-2 K-1)
- cv_floori(l) = (dz_floori(l) * cp_floori(l)) / dtime
- ! Density of dry air at standard pressure and t_building (kg m-3)
- rho_dair(l) = pstd / (rair*t_building_bef(l))
- end if
- end do
-
- ! Get terms from soil temperature equations to compute conduction flux
- ! Negative is toward surface - heat added
- ! Note that the conduction flux here is in W m-2 wall area but for purposes of solving the set of
- ! simultaneous equations this must be converted to W m-2 ground area. This is done below when
- ! setting up the equation coefficients.
-
- do fc = 1,num_nolakec
- c = filter_nolakec(fc)
- l = clandunit(c)
- if (urbpoi(l)) then
- if (ctype(c) == icol_roof) then
- zi_roof_innerl(l) = zi(c,nlevurb)
- z_roof_innerl(l) = z(c,nlevurb)
- t_roof_innerl_bef(l) = tssbef(c,nlevurb)
- t_roof_innerl(l) = t_soisno(c,nlevurb)
- tk_roof_innerl(l) = tk(c,nlevurb)
- else if (ctype(c) == icol_sunwall) then
- zi_sunw_innerl(l) = zi(c,nlevurb)
- z_sunw_innerl(l) = z(c,nlevurb)
- t_sunw_innerl_bef(l) = tssbef(c,nlevurb)
- t_sunw_innerl(l) = t_soisno(c,nlevurb)
- tk_sunw_innerl(l) = tk(c,nlevurb)
- else if (ctype(c) == icol_shadewall) then
- zi_shdw_innerl(l) = zi(c,nlevurb)
- z_shdw_innerl(l) = z(c,nlevurb)
- t_shdw_innerl_bef(l) = tssbef(c,nlevurb)
- t_shdw_innerl(l) = t_soisno(c,nlevurb)
- tk_shdw_innerl(l) = tk(c,nlevurb)
- end if
- end if
- end do
-
- ! Calculate view factors
- do fl = 1,num_urbanl
- l = filter_urbanl(fl)
- if (urbpoi(l)) then
-
- vf_rf(l) = sqrt(1._r8 + canyon_hwr(l)**2._r8) - canyon_hwr(l)
- vf_fr(l) = vf_rf(l)
-
- ! This view factor implicitly converts from per unit wall area to per unit floor area
- vf_wf(l) = 0.5_r8*(1._r8 - vf_rf(l))
-
- ! This view factor implicitly converts from per unit floor area to per unit wall area
- vf_fw(l) = vf_wf(l) / canyon_hwr(l)
-
- ! This view factor implicitly converts from per unit roof area to per unit wall area
- vf_rw(l) = vf_fw(l)
-
- ! This view factor implicitly converts from per unit wall area to per unit roof area
- vf_wr(l) = vf_wf(l)
-
- vf_ww(l) = 1._r8 - vf_rw(l) - vf_fw(l)
-
- end if
- end do
-
- ! error check -- make sure view factor sums to one for floor, wall, and roof
-
- do fl = 1,num_urbanl
- l = filter_urbanl(fl)
- if (urbpoi(l)) then
-
- sum = vf_rf(l) + 2._r8*vf_wf(l)
- if (abs(sum-1._r8) > 1.e-06_r8 ) then
- write (iulog,*) 'urban floor view factor error',sum
- write (iulog,*) 'clm model is stopping'
- call endrun()
- endif
- sum = vf_rw(l) + vf_fw(l) + vf_ww(l)
- if (abs(sum-1._r8) > 1.e-06_r8 ) then
- write (iulog,*) 'urban wall view factor error',sum
- write (iulog,*) 'clm model is stopping'
- call endrun()
- endif
- sum = vf_fr(l) + vf_wr(l) + vf_wr(l)
- if (abs(sum-1._r8) > 1.e-06_r8 ) then
- write (iulog,*) 'urban roof view factor error',sum
- write (iulog,*) 'clm model is stopping'
- call endrun()
- endif
-
- endif
- end do
-
- n = neq
- nrhs = 1
- lda = neq
- ldb = neq
-
- do fl = 1,num_urbanl
- l = filter_urbanl(fl)
- if (urbpoi(l)) then
-
- ! ROOF
- a(1,1) = 0.5_r8*hcv_roofi(l) &
- + 0.5_r8*tk_roof_innerl(l)/(zi_roof_innerl(l) - z_roof_innerl(l)) &
- + 4._r8*em_roofi(l)*sb*t_roof_inner_bef(l)**3._r8 &
- - 4._r8*em_roofi(l)*sb*t_roof_inner_bef(l)**3._r8*vf_rw(l)*(1._r8-em_sunwi(l))*vf_wr(l) &
- - 4._r8*em_roofi(l)*sb*t_roof_inner_bef(l)**3._r8*vf_rw(l)*(1._r8-em_shdwi(l))*vf_wr(l) &
- - 4._r8*em_roofi(l)*sb*t_roof_inner_bef(l)**3._r8*vf_rf(l)*(1._r8-em_floori(l))*vf_fr(l)
-
- a(1,2) = - 4._r8*em_roofi(l)*em_sunwi(l)*sb*t_sunw_inner_bef(l)**3._r8*vf_wr(l) &
- - 4._r8*em_sunwi(l)*sb*t_sunw_inner_bef(l)**3._r8*vf_ww(l)*(1._r8-em_shdwi(l))*vf_wr(l) &
- - 4._r8*em_sunwi(l)*sb*t_sunw_inner_bef(l)**3._r8*vf_wf(l)*(1._r8-em_floori(l))*vf_fr(l)
-
- a(1,3) = - 4._r8*em_roofi(l)*em_shdwi(l)*sb*t_shdw_inner_bef(l)**3._r8*vf_wr(l) &
- - 4._r8*em_shdwi(l)*sb*t_shdw_inner_bef(l)**3._r8*vf_ww(l)*(1._r8-em_sunwi(l))*vf_wr(l) &
- - 4._r8*em_shdwi(l)*sb*t_shdw_inner_bef(l)**3._r8*vf_wf(l)*(1._r8-em_floori(l))*vf_fr(l)
-
- a(1,4) = - 4._r8*em_roofi(l)*em_floori(l)*sb*t_floor_bef(l)**3._r8*vf_fr(l) &
- - 4._r8*em_floori(l)*sb*t_floor_bef(l)**3._r8*vf_fw(l)*(1._r8-em_sunwi(l))*vf_wr(l) &
- - 4._r8*em_floori(l)*sb*t_floor_bef(l)**3._r8*vf_fw(l)*(1._r8-em_shdwi(l))*vf_wr(l)
-
- a(1,5) = - 0.5_r8*hcv_roofi(l)
-
- result(1) = 0.5_r8*tk_roof_innerl(l)*t_roof_innerl(l)/(zi_roof_innerl(l) - z_roof_innerl(l)) &
- - 0.5_r8*tk_roof_innerl(l)*(t_roof_inner_bef(l)-t_roof_innerl_bef(l))/(zi_roof_innerl(l) &
- - z_roof_innerl(l)) &
- - 3._r8*em_roofi(l)*em_sunwi(l)*sb*t_sunw_inner_bef(l)**4._r8*vf_wr(l) &
- - 3._r8*em_roofi(l)*em_shdwi(l)*sb*t_shdw_inner_bef(l)**4._r8*vf_wr(l) &
- - 3._r8*em_roofi(l)*em_floori(l)*sb*t_floor_bef(l)**4._r8*vf_fr(l) &
- + 3._r8*em_roofi(l)*sb*t_roof_inner_bef(l)**4._r8 &
- - 3._r8*em_roofi(l)*sb*t_roof_inner_bef(l)**4._r8*vf_rw(l)*(1._r8-em_sunwi(l))*vf_wr(l) &
- - 3._r8*em_roofi(l)*sb*t_roof_inner_bef(l)**4._r8*vf_rw(l)*(1._r8-em_shdwi(l))*vf_wr(l) &
- - 3._r8*em_roofi(l)*sb*t_roof_inner_bef(l)**4._r8*vf_rf(l)*(1._r8-em_floori(l))*vf_fr(l) &
- - 3._r8*em_sunwi(l)*sb*t_sunw_inner_bef(l)**4._r8*vf_ww(l)*(1._r8-em_shdwi(l))*vf_wr(l) &
- - 3._r8*em_sunwi(l)*sb*t_sunw_inner_bef(l)**4._r8*vf_wf(l)*(1._r8-em_floori(l))*vf_fr(l) &
- - 3._r8*em_shdwi(l)*sb*t_shdw_inner_bef(l)**4._r8*vf_ww(l)*(1._r8-em_sunwi(l))*vf_wr(l) &
- - 3._r8*em_shdwi(l)*sb*t_shdw_inner_bef(l)**4._r8*vf_wf(l)*(1._r8-em_floori(l))*vf_fr(l) &
- - 3._r8*em_floori(l)*sb*t_floor_bef(l)**4._r8*vf_fw(l)*(1._r8-em_sunwi(l))*vf_wr(l) &
- - 3._r8*em_floori(l)*sb*t_floor_bef(l)**4._r8*vf_fw(l)*(1._r8-em_shdwi(l))*vf_wr(l) &
- - 0.5_r8*hcv_roofi(l)*(t_roof_inner_bef(l) - t_building_bef(l))
-
- ! SUNWALL
- a(2,1) = - 4._r8*em_sunwi(l)*em_roofi(l)*sb*t_roof_inner_bef(l)**3._r8*vf_rw(l) &
- - 4._r8*em_roofi(l)*sb*t_roof_inner_bef(l)**3._r8*vf_rw(l)*(1._r8-em_shdwi(l))*vf_ww(l) &
- - 4._r8*em_roofi(l)*sb*t_roof_inner_bef(l)**3._r8*vf_rf(l)*(1._r8-em_floori(l))*vf_fw(l)
-
- a(2,2) = 0.5_r8*hcv_sunwi(l)*canyon_hwr(l) &
- + 0.5_r8*tk_sunw_innerl(l)/(zi_sunw_innerl(l) - z_sunw_innerl(l))*canyon_hwr(l) &
- + 4._r8*em_sunwi(l)*sb*t_sunw_inner_bef(l)**3._r8 &
- - 4._r8*em_sunwi(l)*sb*t_sunw_inner_bef(l)**3._r8*vf_wr(l)*(1._r8-em_roofi(l))*vf_rw(l) &
- - 4._r8*em_sunwi(l)*sb*t_sunw_inner_bef(l)**3._r8*vf_ww(l)*(1._r8-em_shdwi(l))*vf_ww(l) &
- - 4._r8*em_sunwi(l)*sb*t_sunw_inner_bef(l)**3._r8*vf_wf(l)*(1._r8-em_floori(l))*vf_fw(l)
-
- a(2,3) = - 4._r8*em_sunwi(l)*em_shdwi(l)*sb*t_shdw_inner_bef(l)**3._r8*vf_ww(l) &
- - 4._r8*em_shdwi(l)*sb*t_shdw_inner_bef(l)**3._r8*vf_wf(l)*(1._r8-em_floori(l))*vf_fw(l) &
- - 4._r8*em_shdwi(l)*sb*t_shdw_inner_bef(l)**3._r8*vf_wr(l)*(1._r8-em_roofi(l))*vf_rw(l)
-
- a(2,4) = - 4._r8*em_sunwi(l)*em_floori(l)*sb*t_floor_bef(l)**3._r8*vf_fw(l) &
- - 4._r8*em_floori(l)*sb*t_floor_bef(l)**3._r8*vf_fr(l)*(1._r8-em_roofi(l))*vf_rw(l) &
- - 4._r8*em_floori(l)*sb*t_floor_bef(l)**3._r8*vf_fw(l)*(1._r8-em_shdwi(l))*vf_ww(l)
- a(2,5) = - 0.5_r8*hcv_sunwi(l)*canyon_hwr(l)
-
- result(2) = 0.5_r8*tk_sunw_innerl(l)*t_sunw_innerl(l)/(zi_sunw_innerl(l) - z_sunw_innerl(l))*canyon_hwr(l) &
- - 0.5_r8*tk_sunw_innerl(l)*(t_sunw_inner_bef(l)-t_sunw_innerl_bef(l))/(zi_sunw_innerl(l) &
- - z_sunw_innerl(l))*canyon_hwr(l) &
- - 3._r8*em_sunwi(l)*em_roofi(l)*sb*t_roof_inner_bef(l)**4._r8*vf_rw(l) &
- - 3._r8*em_sunwi(l)*em_shdwi(l)*sb*t_shdw_inner_bef(l)**4._r8*vf_ww(l) &
- - 3._r8*em_sunwi(l)*em_floori(l)*sb*t_floor_bef(l)**4._r8*vf_fw(l) &
- + 3._r8*em_sunwi(l)*sb*t_sunw_inner_bef(l)**4._r8 &
- - 3._r8*em_sunwi(l)*sb*t_sunw_inner_bef(l)**4._r8*vf_wr(l)*(1._r8-em_roofi(l))*vf_rw(l) &
- - 3._r8*em_sunwi(l)*sb*t_sunw_inner_bef(l)**4._r8*vf_ww(l)*(1._r8-em_shdwi(l))*vf_ww(l) &
- - 3._r8*em_sunwi(l)*sb*t_sunw_inner_bef(l)**4._r8*vf_wf(l)*(1._r8-em_floori(l))*vf_fw(l) &
- - 3._r8*em_shdwi(l)*sb*t_shdw_inner_bef(l)**4._r8*vf_wf(l)*(1._r8-em_floori(l))*vf_fw(l) &
- - 3._r8*em_shdwi(l)*sb*t_shdw_inner_bef(l)**4._r8*vf_wr(l)*(1._r8-em_roofi(l))*vf_rw(l) &
- - 3._r8*em_roofi(l)*sb*t_roof_inner_bef(l)**4._r8*vf_rw(l)*(1._r8-em_shdwi(l))*vf_ww(l) &
- - 3._r8*em_roofi(l)*sb*t_roof_inner_bef(l)**4._r8*vf_rf(l)*(1._r8-em_floori(l))*vf_fw(l) &
- - 3._r8*em_floori(l)*sb*t_floor_bef(l)**4._r8*vf_fr(l)*(1._r8-em_roofi(l))*vf_rw(l) &
- - 3._r8*em_floori(l)*sb*t_floor_bef(l)**4._r8*vf_fw(l)*(1._r8-em_shdwi(l))*vf_ww(l) &
- - 0.5_r8*hcv_sunwi(l)*(t_sunw_inner_bef(l) - t_building_bef(l))*canyon_hwr(l)
-
- ! SHADEWALL
- a(3,1) = - 4._r8*em_shdwi(l)*em_roofi(l)*sb*t_roof_inner_bef(l)**3._r8*vf_rw(l) &
- - 4._r8*em_roofi(l)*sb*t_roof_inner_bef(l)**3._r8*vf_rw(l)*(1._r8-em_sunwi(l))*vf_ww(l) &
- - 4._r8*em_roofi(l)*sb*t_roof_inner_bef(l)**3._r8*vf_rf(l)*(1._r8-em_floori(l))*vf_fw(l)
-
- a(3,2) = - 4._r8*em_shdwi(l)*em_sunwi(l)*sb*t_sunw_inner_bef(l)**3._r8*vf_ww(l) &
- - 4._r8*em_sunwi(l)*sb*t_sunw_inner_bef(l)**3._r8*vf_wf(l)*(1._r8-em_floori(l))*vf_fw(l) &
- - 4._r8*em_sunwi(l)*sb*t_sunw_inner_bef(l)**3._r8*vf_wr(l)*(1._r8-em_roofi(l))*vf_rw(l)
-
- a(3,3) = 0.5_r8*hcv_shdwi(l)*canyon_hwr(l) &
- + 0.5_r8*tk_shdw_innerl(l)/(zi_shdw_innerl(l) - z_shdw_innerl(l))*canyon_hwr(l) &
- + 4._r8*em_shdwi(l)*sb*t_shdw_inner_bef(l)**3._r8 &
- - 4._r8*em_shdwi(l)*sb*t_shdw_inner_bef(l)**3._r8*vf_wr(l)*(1._r8-em_roofi(l))*vf_rw(l) &
- - 4._r8*em_shdwi(l)*sb*t_shdw_inner_bef(l)**3._r8*vf_ww(l)*(1._r8-em_sunwi(l))*vf_ww(l) &
- - 4._r8*em_shdwi(l)*sb*t_shdw_inner_bef(l)**3._r8*vf_wf(l)*(1._r8-em_floori(l))*vf_fw(l)
-
- a(3,4) = - 4._r8*em_shdwi(l)*em_floori(l)*sb*t_floor_bef(l)**3._r8*vf_fw(l) &
- - 4._r8*em_floori(l)*sb*t_floor_bef(l)**3._r8*vf_fr(l)*(1._r8-em_roofi(l))*vf_rw(l) &
- - 4._r8*em_floori(l)*sb*t_floor_bef(l)**3._r8*vf_fw(l)*(1._r8-em_sunwi(l))*vf_ww(l)
-
- a(3,5) = - 0.5_r8*hcv_shdwi(l)*canyon_hwr(l)
-
- result(3) = 0.5_r8*tk_shdw_innerl(l)*t_shdw_innerl(l)/(zi_shdw_innerl(l) - z_shdw_innerl(l))*canyon_hwr(l) &
- - 0.5_r8*tk_shdw_innerl(l)*(t_shdw_inner_bef(l)-t_shdw_innerl_bef(l))/(zi_shdw_innerl(l) &
- - z_shdw_innerl(l))*canyon_hwr(l) &
- - 3._r8*em_shdwi(l)*em_roofi(l)*sb*t_roof_inner_bef(l)**4._r8*vf_rw(l) &
- - 3._r8*em_shdwi(l)*em_sunwi(l)*sb*t_sunw_inner_bef(l)**4._r8*vf_ww(l) &
- - 3._r8*em_shdwi(l)*em_floori(l)*sb*t_floor_bef(l)**4._r8*vf_fw(l) &
- + 3._r8*em_shdwi(l)*sb*t_shdw_inner_bef(l)**4._r8 &
- - 3._r8*em_shdwi(l)*sb*t_shdw_inner_bef(l)**4._r8*vf_wr(l)*(1._r8-em_roofi(l))*vf_rw(l) &
- - 3._r8*em_shdwi(l)*sb*t_shdw_inner_bef(l)**4._r8*vf_ww(l)*(1._r8-em_sunwi(l))*vf_ww(l) &
- - 3._r8*em_shdwi(l)*sb*t_shdw_inner_bef(l)**4._r8*vf_wf(l)*(1._r8-em_floori(l))*vf_fw(l) &
- - 3._r8*em_sunwi(l)*sb*t_sunw_inner_bef(l)**4._r8*vf_wf(l)*(1._r8-em_floori(l))*vf_fw(l) &
- - 3._r8*em_sunwi(l)*sb*t_sunw_inner_bef(l)**4._r8*vf_wr(l)*(1._r8-em_roofi(l))*vf_rw(l) &
- - 3._r8*em_roofi(l)*sb*t_roof_inner_bef(l)**4._r8*vf_rw(l)*(1._r8-em_sunwi(l))*vf_ww(l) &
- - 3._r8*em_roofi(l)*sb*t_roof_inner_bef(l)**4._r8*vf_rf(l)*(1._r8-em_floori(l))*vf_fw(l) &
- - 3._r8*em_floori(l)*sb*t_floor_bef(l)**4._r8*vf_fr(l)*(1._r8-em_roofi(l))*vf_rw(l) &
- - 3._r8*em_floori(l)*sb*t_floor_bef(l)**4._r8*vf_fw(l)*(1._r8-em_sunwi(l))*vf_ww(l) &
- - 0.5_r8*hcv_shdwi(l)*(t_shdw_inner_bef(l) - t_building_bef(l))*canyon_hwr(l)
-
- ! FLOOR
- a(4,1) = - 4._r8*em_floori(l)*em_roofi(l)*sb*t_roof_inner_bef(l)**3._r8*vf_rf(l) &
- - 4._r8*em_roofi(l)*sb*t_roof_inner_bef(l)**3._r8*vf_rw(l)*(1._r8-em_sunwi(l))*vf_wf(l) &
- - 4._r8*em_roofi(l)*sb*t_roof_inner_bef(l)**3._r8*vf_rw(l)*(1._r8-em_shdwi(l))*vf_wf(l)
-
- a(4,2) = - 4._r8*em_floori(l)*em_sunwi(l)*sb*t_sunw_inner_bef(l)**3._r8*vf_wf(l) &
- - 4._r8*em_sunwi(l)*sb*t_sunw_inner_bef(l)**3._r8*vf_ww(l)*(1._r8-em_shdwi(l))*vf_wf(l) &
- - 4._r8*em_sunwi(l)*sb*t_sunw_inner_bef(l)**3._r8*vf_wr(l)*(1._r8-em_roofi(l))*vf_rf(l)
-
- a(4,3) = - 4._r8*em_floori(l)*em_shdwi(l)*sb*t_shdw_inner_bef(l)**3._r8*vf_wf(l) &
- - 4._r8*em_shdwi(l)*sb*t_shdw_inner_bef(l)**3._r8*vf_wr(l)*(1._r8-em_roofi(l))*vf_rf(l) &
- - 4._r8*em_shdwi(l)*sb*t_shdw_inner_bef(l)**3._r8*vf_ww(l)*(1._r8-em_sunwi(l))*vf_wf(l)
-
- a(4,4) = (cv_floori(l) + 0.5_r8*hcv_floori(l)) &
- + 4._r8*em_floori(l)*sb*t_floor_bef(l)**3._r8 &
- - 4._r8*em_floori(l)*sb*t_floor_bef(l)**3._r8*vf_fr(l)*(1._r8-em_roofi(l))*vf_rf(l) &
- - 4._r8*em_floori(l)*sb*t_floor_bef(l)**3._r8*vf_fw(l)*(1._r8-em_sunwi(l))*vf_wf(l) &
- - 4._r8*em_floori(l)*sb*t_floor_bef(l)**3._r8*vf_fw(l)*(1._r8-em_shdwi(l))*vf_wf(l)
-
- a(4,5) = - 0.5_r8*hcv_floori(l)
-
- result(4) = cv_floori(l)*t_floor_bef(l) &
- - 3._r8*em_floori(l)*em_roofi(l)*sb*t_roof_inner_bef(l)**4._r8*vf_rf(l) &
- - 3._r8*em_floori(l)*em_sunwi(l)*sb*t_sunw_inner_bef(l)**4._r8*vf_wf(l) &
- - 3._r8*em_floori(l)*em_shdwi(l)*sb*t_shdw_inner_bef(l)**4._r8*vf_wf(l) &
- + 3._r8*em_floori(l)*sb*t_floor_bef(l)**4._r8 &
- - 3._r8*em_floori(l)*sb*t_floor_bef(l)**4._r8*vf_fr(l)*(1._r8-em_roofi(l))*vf_rf(l) &
- - 3._r8*em_floori(l)*sb*t_floor_bef(l)**4._r8*vf_fw(l)*(1._r8-em_sunwi(l))*vf_wf(l) &
- - 3._r8*em_floori(l)*sb*t_floor_bef(l)**4._r8*vf_fw(l)*(1._r8-em_shdwi(l))*vf_wf(l) &
- - 3._r8*em_sunwi(l)*sb*t_sunw_inner_bef(l)**4._r8*vf_ww(l)*(1._r8-em_shdwi(l))*vf_wf(l) &
- - 3._r8*em_sunwi(l)*sb*t_sunw_inner_bef(l)**4._r8*vf_wr(l)*(1._r8-em_roofi(l))*vf_rf(l) &
- - 3._r8*em_shdwi(l)*sb*t_shdw_inner_bef(l)**4._r8*vf_wr(l)*(1._r8-em_roofi(l))*vf_rf(l) &
- - 3._r8*em_shdwi(l)*sb*t_shdw_inner_bef(l)**4._r8*vf_ww(l)*(1._r8-em_sunwi(l))*vf_wf(l) &
- - 3._r8*em_roofi(l)*sb*t_roof_inner_bef(l)**4._r8*vf_rw(l)*(1._r8-em_sunwi(l))*vf_wf(l) &
- - 3._r8*em_roofi(l)*sb*t_roof_inner_bef(l)**4._r8*vf_rw(l)*(1._r8-em_shdwi(l))*vf_wf(l) &
- - 0.5_r8*hcv_floori(l)*(t_floor_bef(l) - t_building_bef(l))
-
- ! Building air temperature
- a(5,1) = - 0.5_r8*hcv_roofi(l)
- a(5,2) = - 0.5_r8*hcv_sunwi(l)*canyon_hwr(l)
-
- a(5,3) = - 0.5_r8*hcv_shdwi(l)*canyon_hwr(l)
-
- a(5,4) = - 0.5_r8*hcv_floori(l)
-
- a(5,5) = ((ht_roof(l)*rho_dair(l)*cpair)/dtime) + &
- ((ht_roof(l)*vent_ach)/3600._r8)*rho_dair(l)*cpair + &
- 0.5_r8*hcv_roofi(l) + &
- 0.5_r8*hcv_sunwi(l)*canyon_hwr(l) + &
- 0.5_r8*hcv_shdwi(l)*canyon_hwr(l) + &
- 0.5_r8*hcv_floori(l)
-
- result(5) = (ht_roof(l)*rho_dair(l)*cpair/dtime)*t_building_bef(l) &
- + ((ht_roof(l)*vent_ach)/3600._r8)*rho_dair(l)*cpair*taf(l) &
- + 0.5_r8*hcv_roofi(l)*(t_roof_inner_bef(l) - t_building_bef(l)) &
- + 0.5_r8*hcv_sunwi(l)*(t_sunw_inner_bef(l) - t_building_bef(l))*canyon_hwr(l) &
- + 0.5_r8*hcv_shdwi(l)*(t_shdw_inner_bef(l) - t_building_bef(l))*canyon_hwr(l) &
- + 0.5_r8*hcv_floori(l)*(t_floor_bef(l) - t_building_bef(l))
-
- ! Solve equations
- call dgesv(n, nrhs, a, lda, ipiv, result, ldb, info)
-
- ! If dgesv fails, abort
- if (info /= 0) then
- write(iulog,*)'fl: ',fl
- write(iulog,*)'l: ',l
- write(iulog,*)'dgesv info: ',info
- write (iulog,*) 'dgesv error'
- write (iulog,*) 'clm model is stopping'
- call endrun()
- end if
- ! Assign new temperatures
- t_roof_inner(l) = result(1)
- t_sunw_inner(l) = result(2)
- t_shdw_inner(l) = result(3)
- t_floor(l) = result(4)
- t_building(l) = result(5)
- end if
- end do
-
- ! Energy balance checks
- do fl = 1,num_urbanl
- l = filter_urbanl(fl)
- if (urbpoi(l)) then
- qrd_roof(l) = - em_roofi(l)*em_sunwi(l)*sb*t_sunw_inner_bef(l)**4._r8*vf_wr(l) &
- - 4._r8*em_roofi(l)*em_sunwi(l)*sb*t_sunw_inner_bef(l)**3._r8*vf_wr(l)*(t_sunw_inner(l) &
- - t_sunw_inner_bef(l)) &
- - em_roofi(l)*em_shdwi(l)*sb*t_shdw_inner_bef(l)**4._r8*vf_wr(l) &
- - 4._r8*em_roofi(l)*em_shdwi(l)*sb*t_shdw_inner_bef(l)**3._r8*vf_wr(l)*(t_shdw_inner(l) &
- - t_shdw_inner_bef(l)) &
- - em_roofi(l)*em_floori(l)*sb*t_floor_bef(l)**4._r8*vf_fr(l) &
- - 4._r8*em_roofi(l)*em_floori(l)*sb*t_floor_bef(l)**3._r8*vf_fr(l)*(t_floor(l) - t_floor_bef(l)) &
- - (em_roofi(l)*sb*t_roof_inner_bef(l)**4._r8)*vf_rw(l)*(1._r8-em_sunwi(l))*vf_wr(l) &
- - 4._r8*em_roofi(l)*sb*t_roof_inner_bef(l)**3._r8*vf_rw(l)*(1._r8-em_sunwi(l))*vf_wr(l)*(t_roof_inner(l) &
- - t_roof_inner_bef(l)) &
- - (em_roofi(l)*sb*t_roof_inner_bef(l)**4._r8)*vf_rw(l)*(1._r8-em_shdwi(l))*vf_wr(l) &
- - 4._r8*em_roofi(l)*sb*t_roof_inner_bef(l)**3._r8*vf_rw(l)*(1._r8-em_shdwi(l))*vf_wr(l)*(t_roof_inner(l) &
- - t_roof_inner_bef(l)) &
- - (em_roofi(l)*sb*t_roof_inner_bef(l)**4._r8)*vf_rf(l)*(1._r8-em_floori(l))*vf_fr(l) &
- - 4._r8*em_roofi(l)*sb*t_roof_inner_bef(l)**3._r8*vf_rf(l)*(1._r8-em_floori(l))*vf_fr(l)*(t_roof_inner(l) &
- - t_roof_inner_bef(l)) &
- - (em_sunwi(l)*sb*t_sunw_inner_bef(l)**4._r8)*vf_ww(l)*(1._r8-em_shdwi(l))*vf_wr(l) &
- - 4._r8*em_sunwi(l)*sb*t_sunw_inner_bef(l)**3._r8*vf_ww(l)*(1._r8-em_shdwi(l))*vf_wr(l)*(t_sunw_inner(l) &
- - t_sunw_inner_bef(l)) &
- - (em_sunwi(l)*sb*t_sunw_inner_bef(l)**4._r8)*vf_wf(l)*(1._r8-em_floori(l))*vf_fr(l) &
- - 4._r8*em_sunwi(l)*sb*t_sunw_inner_bef(l)**3._r8*vf_wf(l)*(1._r8-em_floori(l))*vf_fr(l)*(t_sunw_inner(l) &
- - t_sunw_inner_bef(l)) &
- - (em_shdwi(l)*sb*t_shdw_inner_bef(l)**4._r8)*vf_ww(l)*(1._r8-em_sunwi(l))*vf_wr(l) &
- - 4._r8*em_shdwi(l)*sb*t_shdw_inner_bef(l)**3._r8*vf_ww(l)*(1._r8-em_sunwi(l))*vf_wr(l)*(t_shdw_inner(l) &
- - t_shdw_inner_bef(l)) &
- - (em_shdwi(l)*sb*t_shdw_inner_bef(l)**4._r8)*vf_wf(l)*(1._r8-em_floori(l))*vf_fr(l) &
- - 4._r8*em_shdwi(l)*sb*t_shdw_inner_bef(l)**3._r8*vf_wf(l)*(1._r8-em_floori(l))*vf_fr(l)*(t_shdw_inner(l) &
- - t_shdw_inner_bef(l)) &
- - (em_floori(l)*sb*t_floor_bef(l)**4._r8)*vf_fw(l)*(1._r8-em_sunwi(l))*vf_wr(l) &
- - 4._r8*em_floori(l)*sb*t_floor_bef(l)**3._r8*vf_fw(l)*(1._r8-em_sunwi(l))*vf_wr(l)*(t_floor(l) &
- - t_floor_bef(l)) &
- - (em_floori(l)*sb*t_floor_bef(l)**4._r8)*vf_fw(l)*(1._r8-em_shdwi(l))*vf_wr(l) &
- - 4._r8*em_floori(l)*sb*t_floor_bef(l)**3._r8*vf_fw(l)*(1._r8-em_shdwi(l))*vf_wr(l)*(t_floor(l) &
- - t_floor_bef(l)) &
- + em_roofi(l)*sb*t_roof_inner_bef(l)**4._r8 &
- + 4._r8*em_roofi(l)*sb*t_roof_inner_bef(l)**3._r8*(t_roof_inner(l) - t_roof_inner_bef(l))
-
- qrd_sunw(l) = - em_sunwi(l)*em_roofi(l)*sb*t_roof_inner_bef(l)**4._r8*vf_rw(l) &
- - 4._r8*em_sunwi(l)*em_roofi(l)*sb*t_roof_inner_bef(l)**3._r8*vf_rw(l)*(t_roof_inner(l) &
- - t_roof_inner_bef(l)) &
- - em_sunwi(l)*em_shdwi(l)*sb*t_shdw_inner_bef(l)**4._r8*vf_ww(l) &
- - 4._r8*em_sunwi(l)*em_shdwi(l)*sb*t_shdw_inner_bef(l)**3._r8*vf_ww(l)*(t_shdw_inner(l) &
- - t_shdw_inner_bef(l)) &
- - em_sunwi(l)*em_floori(l)*sb*t_floor_bef(l)**4._r8*vf_fw(l) &
- - 4._r8*em_sunwi(l)*em_floori(l)*sb*t_floor_bef(l)**3._r8*vf_fw(l)*(t_floor(l) - t_floor_bef(l)) &
- - (em_sunwi(l)*sb*t_sunw_inner_bef(l)**4._r8)*vf_wr(l)*(1._r8-em_roofi(l))*vf_rw(l) &
- - 4._r8*em_sunwi(l)*sb*t_sunw_inner_bef(l)**3.*vf_wr(l)*(1._r8-em_roofi(l))*vf_rw(l)*(t_sunw_inner(l) &
- - t_sunw_inner_bef(l)) &
- - (em_sunwi(l)*sb*t_sunw_inner_bef(l)**4._r8)*vf_ww(l)*(1._r8-em_shdwi(l))*vf_ww(l) &
- - 4._r8*em_sunwi(l)*sb*t_sunw_inner_bef(l)**3.*vf_ww(l)*(1._r8-em_shdwi(l))*vf_ww(l)*(t_sunw_inner(l) &
- - t_sunw_inner_bef(l)) &
- - (em_sunwi(l)*sb*t_sunw_inner_bef(l)**4._r8)*vf_wf(l)*(1._r8-em_floori(l))*vf_fw(l) &
- - 4._r8*em_sunwi(l)*sb*t_sunw_inner_bef(l)**3.*vf_wf(l)*(1._r8-em_floori(l))*vf_fw(l)*(t_sunw_inner(l) &
- - t_sunw_inner_bef(l)) &
- - (em_shdwi(l)*sb*t_shdw_inner_bef(l)**4._r8)*vf_wf(l)*(1._r8-em_floori(l))*vf_fw(l) &
- - 4._r8*em_shdwi(l)*sb*t_shdw_inner_bef(l)**3.*vf_wf(l)*(1._r8-em_floori(l))*vf_fw(l)*(t_shdw_inner(l) &
- - t_shdw_inner_bef(l)) &
- - (em_shdwi(l)*sb*t_shdw_inner_bef(l)**4._r8)*vf_wr(l)*(1._r8-em_roofi(l))*vf_rw(l) &
- - 4._r8*em_shdwi(l)*sb*t_shdw_inner_bef(l)**3.*vf_wr(l)*(1._r8-em_roofi(l))*vf_rw(l)*(t_shdw_inner(l) &
- - t_shdw_inner_bef(l)) &
- - (em_roofi(l)*sb*t_roof_inner_bef(l)**4._r8)*vf_rw(l)*(1._r8-em_shdwi(l))*vf_ww(l) &
- - 4._r8*em_roofi(l)*sb*t_roof_inner_bef(l)**3.*vf_rw(l)*(1._r8-em_shdwi(l))*vf_ww(l)*(t_roof_inner(l) &
- - t_roof_inner_bef(l)) &
- - (em_roofi(l)*sb*t_roof_inner_bef(l)**4._r8)*vf_rf(l)*(1._r8-em_floori(l))*vf_fw(l) &
- - 4._r8*em_roofi(l)*sb*t_roof_inner_bef(l)**3.*vf_rf(l)*(1._r8-em_floori(l))*vf_fw(l)*(t_roof_inner(l) &
- - t_roof_inner_bef(l)) &
- - (em_floori(l)*sb*t_floor_bef(l)**4._r8)*vf_fr(l)*(1._r8-em_roofi(l))*vf_rw(l) &
- - 4._r8*em_floori(l)*sb*t_floor_bef(l)**3.*vf_fr(l)*(1._r8-em_roofi(l))*vf_rw(l)*(t_floor(l) &
- - t_floor_bef(l)) &
- - (em_floori(l)*sb*t_floor_bef(l)**4._r8)*vf_fw(l)*(1._r8-em_shdwi(l))*vf_ww(l) &
- - 4._r8*em_floori(l)*sb*t_floor_bef(l)**3.*vf_fw(l)*(1._r8-em_shdwi(l))*vf_ww(l)*(t_floor(l) &
- - t_floor_bef(l)) &
- + em_sunwi(l)*sb*t_sunw_inner_bef(l)**4._r8 &
- + 4._r8*em_sunwi(l)*sb*t_sunw_inner_bef(l)**3._r8*(t_sunw_inner(l) - t_sunw_inner_bef(l))
-
- qrd_shdw(l) = - em_shdwi(l)*em_roofi(l)*sb*t_roof_inner_bef(l)**4._r8*vf_rw(l) &
- - 4._r8*em_shdwi(l)*em_roofi(l)*sb*t_roof_inner_bef(l)**3._r8*vf_rw(l)*(t_roof_inner(l) &
- - t_roof_inner_bef(l)) &
- - em_shdwi(l)*em_sunwi(l)*sb*t_sunw_inner_bef(l)**4._r8*vf_ww(l) &
- - 4._r8*em_shdwi(l)*em_sunwi(l)*sb*t_sunw_inner_bef(l)**3._r8*vf_ww(l)*(t_sunw_inner(l) &
- - t_sunw_inner_bef(l)) &
- - em_shdwi(l)*em_floori(l)*sb*t_floor_bef(l)**4._r8*vf_fw(l) &
- - 4._r8*em_shdwi(l)*em_floori(l)*sb*t_floor_bef(l)**3._r8*vf_fw(l)*(t_floor(l) - t_floor_bef(l)) &
- - (em_shdwi(l)*sb*t_shdw_inner_bef(l)**4._r8)*vf_wr(l)*(1._r8-em_roofi(l))*vf_rw(l) &
- - 4._r8*em_shdwi(l)*sb*t_shdw_inner_bef(l)**3.*vf_wr(l)*(1._r8-em_roofi(l))*vf_rw(l)*(t_shdw_inner(l) &
- - t_shdw_inner_bef(l)) &
- - (em_shdwi(l)*sb*t_shdw_inner_bef(l)**4._r8)*vf_ww(l)*(1._r8-em_sunwi(l))*vf_ww(l) &
- - 4._r8*em_shdwi(l)*sb*t_shdw_inner_bef(l)**3.*vf_ww(l)*(1._r8-em_sunwi(l))*vf_ww(l)*(t_shdw_inner(l) &
- - t_shdw_inner_bef(l)) &
- - (em_shdwi(l)*sb*t_shdw_inner_bef(l)**4._r8)*vf_wf(l)*(1._r8-em_floori(l))*vf_fw(l) &
- - 4._r8*em_shdwi(l)*sb*t_shdw_inner_bef(l)**3.*vf_wf(l)*(1._r8-em_floori(l))*vf_fw(l)*(t_shdw_inner(l) &
- - t_shdw_inner_bef(l)) &
- - (em_sunwi(l)*sb*t_sunw_inner_bef(l)**4._r8)*vf_wf(l)*(1._r8-em_floori(l))*vf_fw(l) &
- - 4._r8*em_sunwi(l)*sb*t_sunw_inner_bef(l)**3.*vf_wf(l)*(1._r8-em_floori(l))*vf_fw(l)*(t_sunw_inner(l) &
- - t_sunw_inner_bef(l)) &
- - (em_sunwi(l)*sb*t_sunw_inner_bef(l)**4._r8)*vf_wr(l)*(1._r8-em_roofi(l))*vf_rw(l) &
- - 4._r8*em_sunwi(l)*sb*t_sunw_inner_bef(l)**3.*vf_wr(l)*(1._r8-em_roofi(l))*vf_rw(l)*(t_sunw_inner(l) &
- - t_sunw_inner_bef(l)) &
- - (em_roofi(l)*sb*t_roof_inner_bef(l)**4._r8)*vf_rw(l)*(1._r8-em_sunwi(l))*vf_ww(l) &
- - 4._r8*em_roofi(l)*sb*t_roof_inner_bef(l)**3.*vf_rw(l)*(1._r8-em_sunwi(l))*vf_ww(l)*(t_roof_inner(l) &
- - t_roof_inner_bef(l)) &
- - (em_roofi(l)*sb*t_roof_inner_bef(l)**4._r8)*vf_rf(l)*(1._r8-em_floori(l))*vf_fw(l) &
- - 4._r8*em_roofi(l)*sb*t_roof_inner_bef(l)**3.*vf_rf(l)*(1._r8-em_floori(l))*vf_fw(l)*(t_roof_inner(l) &
- - t_roof_inner_bef(l)) &
- - (em_floori(l)*sb*t_floor_bef(l)**4._r8)*vf_fr(l)*(1._r8-em_roofi(l))*vf_rw(l) &
- - 4._r8*em_floori(l)*sb*t_floor_bef(l)**3.*vf_fr(l)*(1._r8-em_roofi(l))*vf_rw(l)*(t_floor(l) &
- - t_floor_bef(l)) &
- - (em_floori(l)*sb*t_floor_bef(l)**4._r8)*vf_fw(l)*(1._r8-em_sunwi(l))*vf_ww(l) &
- - 4._r8*em_floori(l)*sb*t_floor_bef(l)**3.*vf_fw(l)*(1._r8-em_sunwi(l))*vf_ww(l)*(t_floor(l) &
- - t_floor_bef(l)) &
- + em_shdwi(l)*sb*t_shdw_inner_bef(l)**4._r8 &
- + 4._r8*em_shdwi(l)*sb*t_shdw_inner_bef(l)**3._r8*(t_shdw_inner(l) - t_shdw_inner_bef(l))
-
- qrd_floor(l) = - em_floori(l)*em_roofi(l)*sb*t_roof_inner_bef(l)**4._r8*vf_rf(l) &
- - 4._r8*em_floori(l)*em_roofi(l)*sb*t_roof_inner_bef(l)**3._r8*vf_rf(l)*(t_roof_inner(l) &
- - t_roof_inner_bef(l)) &
- - em_floori(l)*em_sunwi(l)*sb*t_sunw_inner_bef(l)**4._r8*vf_wf(l) &
- - 4._r8*em_floori(l)*em_sunwi(l)*sb*t_sunw_inner_bef(l)**3._r8*vf_wf(l)*(t_sunw_inner(l) &
- - t_sunw_inner_bef(l)) &
- - em_floori(l)*em_shdwi(l)*sb*t_shdw_inner_bef(l)**4._r8*vf_wf(l) &
- - 4._r8*em_floori(l)*em_shdwi(l)*sb*t_shdw_inner_bef(l)**3._r8*vf_wf(l)*(t_shdw_inner(l) &
- - t_shdw_inner_bef(l)) &
- - (em_floori(l)*sb*t_floor_bef(l)**4._r8)*vf_fr(l)*(1._r8-em_roofi(l))*vf_rf(l) &
- - 4._r8*em_floori(l)*sb*t_floor_bef(l)**3.*vf_fr(l)*(1._r8-em_roofi(l))*vf_rf(l)*(t_floor(l) &
- - t_floor_bef(l)) &
- - (em_floori(l)*sb*t_floor_bef(l)**4._r8)*vf_fw(l)*(1._r8-em_sunwi(l))*vf_wf(l) &
- - 4._r8*em_floori(l)*sb*t_floor_bef(l)**3.*vf_fw(l)*(1._r8-em_sunwi(l))*vf_wf(l)*(t_floor(l) &
- - t_floor_bef(l)) &
- - (em_floori(l)*sb*t_floor_bef(l)**4._r8)*vf_fw(l)*(1._r8-em_shdwi(l))*vf_wf(l) &
- - 4._r8*em_floori(l)*sb*t_floor_bef(l)**3.*vf_fw(l)*(1._r8-em_shdwi(l))*vf_wf(l)*(t_floor(l) &
- - t_floor_bef(l)) &
- - (em_sunwi(l)*sb*t_sunw_inner_bef(l)**4._r8)*vf_ww(l)*(1._r8-em_shdwi(l))*vf_wf(l) &
- - 4._r8*em_sunwi(l)*sb*t_sunw_inner_bef(l)**3.*vf_ww(l)*(1._r8-em_shdwi(l))*vf_wf(l)*(t_sunw_inner(l) &
- - t_sunw_inner_bef(l)) &
- - (em_sunwi(l)*sb*t_sunw_inner_bef(l)**4._r8)*vf_wr(l)*(1._r8-em_roofi(l))*vf_rf(l) &
- - 4._r8*em_sunwi(l)*sb*t_sunw_inner_bef(l)**3.*vf_wr(l)*(1._r8-em_roofi(l))*vf_rf(l)*(t_sunw_inner(l) &
- - t_sunw_inner_bef(l)) &
- - (em_shdwi(l)*sb*t_shdw_inner_bef(l)**4._r8)*vf_wr(l)*(1._r8-em_roofi(l))*vf_rf(l) &
- - 4._r8*em_shdwi(l)*sb*t_shdw_inner_bef(l)**3.*vf_wr(l)*(1._r8-em_roofi(l))*vf_rf(l)*(t_shdw_inner(l) &
- - t_shdw_inner_bef(l)) &
- - (em_shdwi(l)*sb*t_shdw_inner_bef(l)**4._r8)*vf_ww(l)*(1._r8-em_sunwi(l))*vf_wf(l) &
- - 4._r8*em_shdwi(l)*sb*t_shdw_inner_bef(l)**3.*vf_ww(l)*(1._r8-em_sunwi(l))*vf_wf(l)*(t_shdw_inner(l) &
- - t_shdw_inner_bef(l)) &
- - (em_roofi(l)*sb*t_roof_inner_bef(l)**4._r8)*vf_rw(l)*(1._r8-em_sunwi(l))*vf_wf(l) &
- - 4._r8*em_roofi(l)*sb*t_roof_inner_bef(l)**3.*vf_rw(l)*(1._r8-em_sunwi(l))*vf_wf(l)*(t_roof_inner(l) &
- - t_roof_inner_bef(l)) &
- - (em_roofi(l)*sb*t_roof_inner_bef(l)**4._r8)*vf_rw(l)*(1._r8-em_shdwi(l))*vf_wf(l) &
- - 4._r8*em_roofi(l)*sb*t_roof_inner_bef(l)**3.*vf_rw(l)*(1._r8-em_shdwi(l))*vf_wf(l)*(t_roof_inner(l) &
- - t_roof_inner_bef(l)) &
- + em_floori(l)*sb*t_floor_bef(l)**4._r8 &
- + 4._r8*em_floori(l)*sb*t_floor_bef(l)**3.*(t_floor(l) - t_floor_bef(l))
-
- qrd_building(l) = qrd_roof(l) + canyon_hwr(l)*(qrd_sunw(l) + qrd_shdw(l)) + qrd_floor(l)
-
- if (abs(qrd_building(l)) > .10_r8 ) then
- write (iulog,*) 'urban inside building net longwave radiation balance error ',qrd_building(l)
- write (iulog,*) 'clm model is stopping'
- call endrun()
- end if
-
- qcv_roof(l) = 0.5_r8*hcv_roofi(l)*(t_roof_inner(l) - t_building(l)) + 0.5_r8*hcv_roofi(l)*(t_roof_inner_bef(l) &
- - t_building_bef(l))
- qcd_roof(l) = 0.5_r8*tk_roof_innerl(l)*(t_roof_inner(l) - t_roof_innerl(l))/(zi_roof_innerl(l) - z_roof_innerl(l)) &
- + 0.5_r8*tk_roof_innerl(l)*(t_roof_inner_bef(l) - t_roof_innerl_bef(l))/(zi_roof_innerl(l) &
- - z_roof_innerl(l))
- enrgy_bal_roof(l) = qrd_roof(l) + qcv_roof(l) + qcd_roof(l)
- if (abs(enrgy_bal_roof(l)) > .10_r8 ) then
- write (iulog,*) 'urban inside roof energy balance error ',enrgy_bal_roof(l)
- write (iulog,*) 'clm model is stopping'
- call endrun()
- end if
-
- qcv_sunw(l) = 0.5_r8*hcv_sunwi(l)*(t_sunw_inner(l) - t_building(l)) + 0.5_r8*hcv_sunwi(l)*(t_sunw_inner_bef(l) &
- - t_building_bef(l))
- qcd_sunw(l) = 0.5_r8*tk_sunw_innerl(l)*(t_sunw_inner(l) - t_sunw_innerl(l))/(zi_sunw_innerl(l) - z_sunw_innerl(l)) &
- + 0.5_r8*tk_sunw_innerl(l)*(t_sunw_inner_bef(l) - t_sunw_innerl_bef(l))/(zi_sunw_innerl(l) &
- - z_sunw_innerl(l))
- enrgy_bal_sunw(l) = qrd_sunw(l) + qcv_sunw(l)*canyon_hwr(l) + qcd_sunw(l)*canyon_hwr(l)
- if (abs(enrgy_bal_sunw(l)) > .10_r8 ) then
- write (iulog,*) 'urban inside sunwall energy balance error ',enrgy_bal_sunw(l)
- write (iulog,*) 'clm model is stopping'
- call endrun()
- end if
-
- qcv_shdw(l) = 0.5_r8*hcv_shdwi(l)*(t_shdw_inner(l) - t_building(l)) + 0.5_r8*hcv_shdwi(l)*(t_shdw_inner_bef(l) &
- - t_building_bef(l))
- qcd_shdw(l) = 0.5_r8*tk_shdw_innerl(l)*(t_shdw_inner(l) - t_shdw_innerl(l))/(zi_shdw_innerl(l) - z_shdw_innerl(l)) &
- + 0.5_r8*tk_shdw_innerl(l)*(t_shdw_inner_bef(l) - t_shdw_innerl_bef(l))/(zi_shdw_innerl(l) &
- - z_shdw_innerl(l))
- enrgy_bal_shdw(l) = qrd_shdw(l) + qcv_shdw(l)*canyon_hwr(l) + qcd_shdw(l)*canyon_hwr(l)
- if (abs(enrgy_bal_shdw(l)) > .10_r8 ) then
- write (iulog,*) 'urban inside shadewall energy balance error ',enrgy_bal_shdw(l)
- write (iulog,*) 'clm model is stopping'
- call endrun()
- end if
-
- qcv_floor(l) = 0.5_r8*hcv_floori(l)*(t_floor(l) - t_building(l)) + 0.5_r8*hcv_floori(l)*(t_floor_bef(l) &
- - t_building_bef(l))
- qcd_floor(l) = cv_floori(l)*(t_floor(l) - t_floor_bef(l))
- enrgy_bal_floor(l) = qrd_floor(l) + qcv_floor(l) + qcd_floor(l)
- if (abs(enrgy_bal_floor(l)) > .10_r8 ) then
- write (iulog,*) 'urban inside floor energy balance error ',enrgy_bal_floor(l)
- write (iulog,*) 'clm model is stopping'
- call endrun()
- end if
-
- enrgy_bal_buildair(l) = (ht_roof(l)*rho_dair(l)*cpair/dtime)*(t_building(l) - t_building_bef(l)) &
- - ht_roof(l)*(vent_ach/3600._r8)*rho_dair(l)*cpair*(taf(l) - t_building(l)) &
- - 0.5_r8*hcv_roofi(l)*(t_roof_inner(l) - t_building(l)) &
- - 0.5_r8*hcv_roofi(l)*(t_roof_inner_bef(l) - t_building_bef(l)) &
- - 0.5_r8*hcv_sunwi(l)*(t_sunw_inner(l) - t_building(l))*canyon_hwr(l) &
- - 0.5_r8*hcv_sunwi(l)*(t_sunw_inner_bef(l) - t_building_bef(l))*canyon_hwr(l) &
- - 0.5_r8*hcv_shdwi(l)*(t_shdw_inner(l) - t_building(l))*canyon_hwr(l) &
- - 0.5_r8*hcv_shdwi(l)*(t_shdw_inner_bef(l) - t_building_bef(l))*canyon_hwr(l) &
- - 0.5_r8*hcv_floori(l)*(t_floor(l) - t_building(l)) &
- - 0.5_r8*hcv_floori(l)*(t_floor_bef(l) - t_building_bef(l))
- if (abs(enrgy_bal_buildair(l)) > .10_r8 ) then
- write (iulog,*) 'urban building air energy balance error ',enrgy_bal_buildair(l)
- write (iulog,*) 'clm model is stopping'
- call endrun()
- end if
- end if
- end do
-
- ! Restrict internal building air temperature to between min and max
- ! Calculate heating or air conditioning flux from energy required to change
- ! internal building air temperature to t_building_min or t_building_max.
-
- do fl = 1,num_urbanl
- l = filter_urbanl(fl)
- if (urbpoi(l)) then
- if (trim(urban_hac) == urban_hac_on .or. trim(urban_hac) == urban_wasteheat_on) then
- t_building_bef_hac(l) = t_building(l)
-! rho_dair(l) = pstd / (rair*t_building(l))
-
- if (t_building_bef_hac(l) > t_building_max(l)) then
- t_building(l) = t_building_max(l)
- eflx_urban_ac(l) = wtlunit_roof(l) * abs( (ht_roof(l) * rho_dair(l) * cpair / dtime) * t_building(l) &
- - (ht_roof(l) * rho_dair(l) * cpair / dtime) * t_building_bef_hac(l) )
- else if (t_building_bef_hac(l) < t_building_min(l)) then
- t_building(l) = t_building_min(l)
- eflx_urban_heat(l) = wtlunit_roof(l) * abs( (ht_roof(l) * rho_dair(l) * cpair / dtime) * t_building(l) &
- - (ht_roof(l) * rho_dair(l) * cpair / dtime) * t_building_bef_hac(l) )
- else
- eflx_urban_ac(l) = 0._r8
- eflx_urban_heat(l) = 0._r8
- end if
- else
- eflx_urban_ac(l) = 0._r8
- eflx_urban_heat(l) = 0._r8
- end if
- eflx_building(l) = wtlunit_roof(l) * (ht_roof(l) * rho_dair(l)*cpair/dtime) * (t_building(l) - t_building_bef(l))
- end if
- end do
-
- end associate
- end subroutine BuildingTemperature
-
- !-----------------------------------------------------------------------
-
-end module UrbBuildTempOleson2015Mod
diff --git a/src/biogeophys/UrbanParamsType.F90 b/src/biogeophys/UrbanParamsType.F90
deleted file mode 100644
index 4b4187c3..00000000
--- a/src/biogeophys/UrbanParamsType.F90
+++ /dev/null
@@ -1,961 +0,0 @@
-module UrbanParamsType
-
- !------------------------------------------------------------------------------
- ! !DESCRIPTION:
- ! Urban Constants
- !
- ! !USES:
- use shr_kind_mod , only : r8 => shr_kind_r8
- use shr_log_mod , only : errMsg => shr_log_errMsg
- use abortutils , only : endrun
- use decompMod , only : bounds_type
- use clm_varctl , only : iulog, fsurdat
- use clm_varcon , only : namel, grlnd, spval
- use LandunitType , only : lun
- !
- implicit none
- save
- private
- !
- ! !PUBLIC MEMBER FUNCTIONS:
- public :: UrbanReadNML ! Read in the urban namelist items
- public :: UrbanInput ! Read in urban input data
- public :: CheckUrban ! Check validity of urban points
- public :: IsSimpleBuildTemp ! If using the simple building temperature method
- public :: IsProgBuildTemp ! If using the prognostic building temperature method
- !
- ! !PRIVATE TYPE
- type urbinp_type
- real(r8), pointer :: canyon_hwr (:,:)
- real(r8), pointer :: wtlunit_roof (:,:)
- real(r8), pointer :: wtroad_perv (:,:)
- real(r8), pointer :: em_roof (:,:)
- real(r8), pointer :: em_improad (:,:)
- real(r8), pointer :: em_perroad (:,:)
- real(r8), pointer :: em_wall (:,:)
- real(r8), pointer :: alb_roof_dir (:,:,:)
- real(r8), pointer :: alb_roof_dif (:,:,:)
- real(r8), pointer :: alb_improad_dir (:,:,:)
- real(r8), pointer :: alb_improad_dif (:,:,:)
- real(r8), pointer :: alb_perroad_dir (:,:,:)
- real(r8), pointer :: alb_perroad_dif (:,:,:)
- real(r8), pointer :: alb_wall_dir (:,:,:)
- real(r8), pointer :: alb_wall_dif (:,:,:)
- real(r8), pointer :: ht_roof (:,:)
- real(r8), pointer :: wind_hgt_canyon (:,:)
- real(r8), pointer :: tk_wall (:,:,:)
- real(r8), pointer :: tk_roof (:,:,:)
- real(r8), pointer :: tk_improad (:,:,:)
- real(r8), pointer :: cv_wall (:,:,:)
- real(r8), pointer :: cv_roof (:,:,:)
- real(r8), pointer :: cv_improad (:,:,:)
- real(r8), pointer :: thick_wall (:,:)
- real(r8), pointer :: thick_roof (:,:)
- integer, pointer :: nlev_improad (:,:)
- real(r8), pointer :: t_building_min (:,:)
- end type urbinp_type
- type (urbinp_type), public :: urbinp ! urban input derived type
-
- ! !PUBLIC TYPE
- type, public :: urbanparams_type
- real(r8), allocatable :: wind_hgt_canyon (:) ! lun height above road at which wind in canyon is to be computed (m)
- real(r8), allocatable :: em_roof (:) ! lun roof emissivity
- real(r8), allocatable :: em_improad (:) ! lun impervious road emissivity
- real(r8), allocatable :: em_perroad (:) ! lun pervious road emissivity
- real(r8), allocatable :: em_wall (:) ! lun wall emissivity
- real(r8), allocatable :: alb_roof_dir (:,:) ! lun direct roof albedo
- real(r8), allocatable :: alb_roof_dif (:,:) ! lun diffuse roof albedo
- real(r8), allocatable :: alb_improad_dir (:,:) ! lun direct impervious road albedo
- real(r8), allocatable :: alb_improad_dif (:,:) ! lun diffuse impervious road albedo
- real(r8), allocatable :: alb_perroad_dir (:,:) ! lun direct pervious road albedo
- real(r8), allocatable :: alb_perroad_dif (:,:) ! lun diffuse pervious road albedo
- real(r8), allocatable :: alb_wall_dir (:,:) ! lun direct wall albedo
- real(r8), allocatable :: alb_wall_dif (:,:) ! lun diffuse wall albedo
-
- integer , pointer :: nlev_improad (:) ! lun number of impervious road layers (-)
- real(r8), pointer :: tk_wall (:,:) ! lun thermal conductivity of urban wall (W/m/K)
- real(r8), pointer :: tk_roof (:,:) ! lun thermal conductivity of urban roof (W/m/K)
- real(r8), pointer :: tk_improad (:,:) ! lun thermal conductivity of urban impervious road (W/m/K)
- real(r8), pointer :: cv_wall (:,:) ! lun heat capacity of urban wall (J/m^3/K)
- real(r8), pointer :: cv_roof (:,:) ! lun heat capacity of urban roof (J/m^3/K)
- real(r8), pointer :: cv_improad (:,:) ! lun heat capacity of urban impervious road (J/m^3/K)
- real(r8), pointer :: thick_wall (:) ! lun total thickness of urban wall (m)
- real(r8), pointer :: thick_roof (:) ! lun total thickness of urban roof (m)
-
- real(r8), pointer :: vf_sr (:) ! lun view factor of sky for road
- real(r8), pointer :: vf_wr (:) ! lun view factor of one wall for road
- real(r8), pointer :: vf_sw (:) ! lun view factor of sky for one wall
- real(r8), pointer :: vf_rw (:) ! lun view factor of road for one wall
- real(r8), pointer :: vf_ww (:) ! lun view factor of opposing wall for one wall
-
- real(r8), pointer :: t_building_min (:) ! lun minimum internal building air temperature (K)
- real(r8), pointer :: eflx_traffic_factor (:) ! lun multiplicative traffic factor for sensible heat flux from urban traffic (-)
- contains
-
- procedure, public :: Init
-
- end type urbanparams_type
- !
- ! !Urban control variables
- character(len= *), parameter, public :: urban_hac_off = 'OFF'
- character(len= *), parameter, public :: urban_hac_on = 'ON'
- character(len= *), parameter, public :: urban_wasteheat_on = 'ON_WASTEHEAT'
- character(len= 16), public :: urban_hac = urban_hac_off
- logical, public :: urban_traffic = .false. ! urban traffic fluxes
-
- ! !PRIVATE MEMBER DATA:
- logical, private :: ReadNamelist = .false. ! If namelist was read yet or not
- integer, parameter, private :: BUILDING_TEMP_METHOD_SIMPLE = 0 ! Simple method introduced in CLM4.5
- integer, parameter, private :: BUILDING_TEMP_METHOD_PROG = 1 ! Prognostic method introduced in CLM5.0
- integer, private :: building_temp_method = BUILDING_TEMP_METHOD_PROG ! Method to calculate the building temperature
-
- character(len=*), parameter, private :: sourcefile = &
- __FILE__
- !-----------------------------------------------------------------------
-
-contains
-
- !-----------------------------------------------------------------------
- subroutine Init(this, bounds)
- !
- ! Allocate module variables and data structures
- !
- ! !USES:
- use shr_infnan_mod , only : nan => shr_infnan_nan, assignment(=)
- use clm_varpar , only : nlevcan, nlevcan, numrad, nlevgrnd, nlevurb
- use clm_varpar , only : nlevsoi, nlevgrnd
- use clm_varctl , only : use_vancouver, use_mexicocity
- use clm_varcon , only : vkc
- use column_varcon , only : icol_roof, icol_sunwall, icol_shadewall
- use column_varcon , only : icol_road_perv, icol_road_imperv, icol_road_perv
- use landunit_varcon , only : isturb_MIN
- !
- ! !ARGUMENTS:
- class(urbanparams_type) :: this
- type(bounds_type) , intent(in) :: bounds
- !
- ! !LOCAL VARIABLES:
- integer :: j,l,c,p,g ! indices
- integer :: nc,fl,ib ! indices
- integer :: dindx ! urban density type index
- integer :: ier ! error status
- real(r8) :: sumvf ! sum of view factors for wall or road
- real(r8), parameter :: alpha = 4.43_r8 ! coefficient used to calculate z_d_town
- real(r8), parameter :: beta = 1.0_r8 ! coefficient used to calculate z_d_town
- real(r8), parameter :: C_d = 1.2_r8 ! drag coefficient as used in Grimmond and Oke (1999)
- real(r8) :: plan_ai ! plan area index - ratio building area to plan area (-)
- real(r8) :: frontal_ai ! frontal area index of buildings (-)
- real(r8) :: build_lw_ratio ! building short/long side ratio (-)
- integer :: begl, endl
- integer :: begc, endc
- integer :: begp, endp
- integer :: begg, endg
- !---------------------------------------------------------------------
-
- begp = bounds%begp; endp = bounds%endp
- begc = bounds%begc; endc = bounds%endc
- begl = bounds%begl; endl = bounds%endl
- begg = bounds%begg; endg = bounds%endg
-
- ! Allocate urbanparams data structure
-
- if ( nlevurb > 0 )then
- allocate(this%tk_wall (begl:endl,nlevurb)) ; this%tk_wall (:,:) = nan
- allocate(this%tk_roof (begl:endl,nlevurb)) ; this%tk_roof (:,:) = nan
- allocate(this%cv_wall (begl:endl,nlevurb)) ; this%cv_wall (:,:) = nan
- allocate(this%cv_roof (begl:endl,nlevurb)) ; this%cv_roof (:,:) = nan
- end if
- allocate(this%t_building_min (begl:endl)) ; this%t_building_min (:) = nan
- allocate(this%tk_improad (begl:endl,nlevurb)) ; this%tk_improad (:,:) = nan
- allocate(this%cv_improad (begl:endl,nlevurb)) ; this%cv_improad (:,:) = nan
- allocate(this%thick_wall (begl:endl)) ; this%thick_wall (:) = nan
- allocate(this%thick_roof (begl:endl)) ; this%thick_roof (:) = nan
- allocate(this%nlev_improad (begl:endl)) ; this%nlev_improad (:) = huge(1)
- allocate(this%vf_sr (begl:endl)) ; this%vf_sr (:) = nan
- allocate(this%vf_wr (begl:endl)) ; this%vf_wr (:) = nan
- allocate(this%vf_sw (begl:endl)) ; this%vf_sw (:) = nan
- allocate(this%vf_rw (begl:endl)) ; this%vf_rw (:) = nan
- allocate(this%vf_ww (begl:endl)) ; this%vf_ww (:) = nan
- allocate(this%wind_hgt_canyon (begl:endl)) ; this%wind_hgt_canyon (:) = nan
- allocate(this%em_roof (begl:endl)) ; this%em_roof (:) = nan
- allocate(this%em_improad (begl:endl)) ; this%em_improad (:) = nan
- allocate(this%em_perroad (begl:endl)) ; this%em_perroad (:) = nan
- allocate(this%em_wall (begl:endl)) ; this%em_wall (:) = nan
- allocate(this%alb_roof_dir (begl:endl,numrad)) ; this%alb_roof_dir (:,:) = nan
- allocate(this%alb_roof_dif (begl:endl,numrad)) ; this%alb_roof_dif (:,:) = nan
- allocate(this%alb_improad_dir (begl:endl,numrad)) ; this%alb_improad_dir (:,:) = nan
- allocate(this%alb_perroad_dir (begl:endl,numrad)) ; this%alb_perroad_dir (:,:) = nan
- allocate(this%alb_improad_dif (begl:endl,numrad)) ; this%alb_improad_dif (:,:) = nan
- allocate(this%alb_perroad_dif (begl:endl,numrad)) ; this%alb_perroad_dif (:,:) = nan
- allocate(this%alb_wall_dir (begl:endl,numrad)) ; this%alb_wall_dir (:,:) = nan
- allocate(this%alb_wall_dif (begl:endl,numrad)) ; this%alb_wall_dif (:,:) = nan
- allocate(this%eflx_traffic_factor (begl:endl)) ; this%eflx_traffic_factor (:) = nan
-
- ! Initialize time constant urban variables
-
- do l = bounds%begl,bounds%endl
-
- ! "0" refers to urban wall/roof surface and "nlevsoi" refers to urban wall/roof bottom
- if (lun%urbpoi(l)) then
-
- g = lun%gridcell(l)
- dindx = lun%itype(l) - isturb_MIN + 1
-
- this%wind_hgt_canyon(l) = urbinp%wind_hgt_canyon(g,dindx)
- do ib = 1,numrad
- this%alb_roof_dir (l,ib) = urbinp%alb_roof_dir (g,dindx,ib)
- this%alb_roof_dif (l,ib) = urbinp%alb_roof_dif (g,dindx,ib)
- this%alb_improad_dir(l,ib) = urbinp%alb_improad_dir(g,dindx,ib)
- this%alb_perroad_dir(l,ib) = urbinp%alb_perroad_dir(g,dindx,ib)
- this%alb_improad_dif(l,ib) = urbinp%alb_improad_dif(g,dindx,ib)
- this%alb_perroad_dif(l,ib) = urbinp%alb_perroad_dif(g,dindx,ib)
- this%alb_wall_dir (l,ib) = urbinp%alb_wall_dir (g,dindx,ib)
- this%alb_wall_dif (l,ib) = urbinp%alb_wall_dif (g,dindx,ib)
- end do
- this%em_roof (l) = urbinp%em_roof (g,dindx)
- this%em_improad(l) = urbinp%em_improad(g,dindx)
- this%em_perroad(l) = urbinp%em_perroad(g,dindx)
- this%em_wall (l) = urbinp%em_wall (g,dindx)
-
- ! Landunit level initialization for urban wall and roof layers and interfaces
-
- lun%canyon_hwr(l) = urbinp%canyon_hwr(g,dindx)
- lun%wtroad_perv(l) = urbinp%wtroad_perv(g,dindx)
- lun%ht_roof(l) = urbinp%ht_roof(g,dindx)
- lun%wtlunit_roof(l) = urbinp%wtlunit_roof(g,dindx)
-
- this%tk_wall(l,:) = urbinp%tk_wall(g,dindx,:)
- this%tk_roof(l,:) = urbinp%tk_roof(g,dindx,:)
- this%tk_improad(l,:) = urbinp%tk_improad(g,dindx,:)
- this%cv_wall(l,:) = urbinp%cv_wall(g,dindx,:)
- this%cv_roof(l,:) = urbinp%cv_roof(g,dindx,:)
- this%cv_improad(l,:) = urbinp%cv_improad(g,dindx,:)
- this%thick_wall(l) = urbinp%thick_wall(g,dindx)
- this%thick_roof(l) = urbinp%thick_roof(g,dindx)
- this%nlev_improad(l) = urbinp%nlev_improad(g,dindx)
- this%t_building_min(l) = urbinp%t_building_min(g,dindx)
-
- ! Inferred from Sailor and Lu 2004
- if (urban_traffic) then
- this%eflx_traffic_factor(l) = 3.6_r8 * (lun%canyon_hwr(l)-0.5_r8) + 1.0_r8
- else
- this%eflx_traffic_factor(l) = 0.0_r8
- end if
-
- if (use_vancouver .or. use_mexicocity) then
- ! Freely evolving
- this%t_building_min(l) = 200.00_r8
- else
- if (urban_hac == urban_hac_off) then
- ! Overwrite values read in from urbinp by freely evolving values
- this%t_building_min(l) = 200.00_r8
- end if
- end if
-
- !----------------------------------------------------------------------------------
- ! View factors for road and one wall in urban canyon (depends only on canyon_hwr)
- ! ---------------------------------------------------------------------------------------
- ! WALL |
- ! ROAD |
- ! wall |
- ! -----\ /----- - - |\----------/
- ! | \ vsr / | | r | | \ vww / s
- ! | \ / | h o w | \ / k
- ! wall | \ / | wall | a | | \ / y
- ! |vwr \ / vwr| | d | |vrw \ / vsw
- ! ------\/------ - - |-----\/-----
- ! road wall |
- ! <----- w ----> |
- ! <---- h --->|
- !
- ! vsr = view factor of sky for road vrw = view factor of road for wall
- ! vwr = view factor of one wall for road vww = view factor of opposing wall for wall
- ! vsw = view factor of sky for wall
- ! vsr + vwr + vwr = 1 vrw + vww + vsw = 1
- !
- ! Source: Masson, V. (2000) A physically-based scheme for the urban energy budget in
- ! atmospheric models. Boundary-Layer Meteorology 94:357-397
- !
- ! - Calculate urban land unit aerodynamic constants using Macdonald (1998) as used in
- ! Grimmond and Oke (1999)
- ! ---------------------------------------------------------------------------------------
-
- ! road -- sky view factor -> 1 as building height -> 0
- ! and -> 0 as building height -> infinity
-
- this%vf_sr(l) = sqrt(lun%canyon_hwr(l)**2 + 1._r8) - lun%canyon_hwr(l)
- this%vf_wr(l) = 0.5_r8 * (1._r8 - this%vf_sr(l))
-
- ! one wall -- sky view factor -> 0.5 as building height -> 0
- ! and -> 0 as building height -> infinity
-
- this%vf_sw(l) = 0.5_r8 * (lun%canyon_hwr(l) + 1._r8 - sqrt(lun%canyon_hwr(l)**2+1._r8)) / lun%canyon_hwr(l)
- this%vf_rw(l) = this%vf_sw(l)
- this%vf_ww(l) = 1._r8 - this%vf_sw(l) - this%vf_rw(l)
-
- ! error check -- make sure view factor sums to one for road and wall
- sumvf = this%vf_sr(l) + 2._r8*this%vf_wr(l)
- if (abs(sumvf-1._r8) > 1.e-06_r8 ) then
- write (iulog,*) 'urban road view factor error',sumvf
- write (iulog,*) 'clm model is stopping'
- call endrun(decomp_index=l, clmlevel=namel, msg=errmsg(sourcefile, __LINE__))
- endif
- sumvf = this%vf_sw(l) + this%vf_rw(l) + this%vf_ww(l)
- if (abs(sumvf-1._r8) > 1.e-06_r8 ) then
- write (iulog,*) 'urban wall view factor error',sumvf
- write (iulog,*) 'clm model is stopping'
- call endrun(decomp_index=l, clmlevel=namel, msg=errmsg(sourcefile, __LINE__))
- endif
-
- !----------------------------------------------------------------------------------
- ! Calculate urban land unit aerodynamic constants using Macdonald (1998) as used in
- ! Grimmond and Oke (1999)
- !----------------------------------------------------------------------------------
-
- ! Calculate plan area index
- plan_ai = lun%canyon_hwr(l)/(lun%canyon_hwr(l) + 1._r8)
-
- ! Building shape shortside/longside ratio (e.g. 1 = square )
- ! This assumes the building occupies the entire canyon length
- build_lw_ratio = plan_ai
-
- ! Calculate frontal area index
- frontal_ai = (1._r8 - plan_ai) * lun%canyon_hwr(l)
-
- ! Adjust frontal area index for different building configuration
- frontal_ai = frontal_ai * sqrt(1/build_lw_ratio) * sqrt(plan_ai)
-
- ! Calculate displacement height
- if (use_vancouver) then
- lun%z_d_town(l) = 3.5_r8
- else if (use_mexicocity) then
- lun%z_d_town(l) = 10.9_r8
- else
- lun%z_d_town(l) = (1._r8 + alpha**(-plan_ai) * (plan_ai - 1._r8)) * lun%ht_roof(l)
- end if
-
- ! Calculate the roughness length
- if (use_vancouver) then
- lun%z_0_town(l) = 0.35_r8
- else if (use_mexicocity) then
- lun%z_0_town(l) = 2.2_r8
- else
- lun%z_0_town(l) = lun%ht_roof(l) * (1._r8 - lun%z_d_town(l) / lun%ht_roof(l)) * &
- exp(-1.0_r8 * (0.5_r8 * beta * C_d / vkc**2 * &
- (1 - lun%z_d_town(l) / lun%ht_roof(l)) * frontal_ai)**(-0.5_r8))
- end if
-
- else ! Not urban point
-
- this%eflx_traffic_factor(l) = spval
- this%t_building_min(l) = spval
-
- this%vf_sr(l) = spval
- this%vf_wr(l) = spval
- this%vf_sw(l) = spval
- this%vf_rw(l) = spval
- this%vf_ww(l) = spval
-
- end if
- end do
-
- ! Deallocate memory for urbinp datatype
-
- call UrbanInput(bounds%begg, bounds%endg, mode='finalize')
-
- end subroutine Init
-
- !-----------------------------------------------------------------------
- subroutine UrbanInput(begg, endg, mode)
- !
- ! !DESCRIPTION:
- ! Allocate memory and read in urban input data
- !
- ! !USES:
- use clm_varpar , only : numrad, nlevurb
- use landunit_varcon , only : numurbl
- use fileutils , only : getavu, relavu, getfil, opnfil
- use spmdMod , only : masterproc
- use domainMod , only : ldomain
- use ncdio_pio , only : file_desc_t, ncd_io, ncd_inqvdlen, ncd_inqfdims
- use ncdio_pio , only : ncd_pio_openfile, ncd_pio_closefile, ncd_inqdid, ncd_inqdlen
- !
- ! !ARGUMENTS:
- implicit none
- integer, intent(in) :: begg, endg
- character(len=*), intent(in) :: mode
- !
- ! !LOCAL VARIABLES:
- character(len=256) :: locfn ! local file name
- type(file_desc_t) :: ncid ! netcdf id
- integer :: dimid ! netCDF id
- integer :: nw,n,k,i,j,ni,nj,ns ! indices
- integer :: nlevurb_i ! input grid: number of urban vertical levels
- integer :: numrad_i ! input grid: number of solar bands (VIS/NIR)
- integer :: numurbl_i ! input grid: number of urban landunits
- integer :: ier,ret ! error status
- logical :: isgrid2d ! true => file is 2d
- logical :: readvar ! true => variable is on dataset
- logical :: has_numurbl ! true => numurbl dimension is on dataset
- character(len=32) :: subname = 'UrbanInput' ! subroutine name
- !-----------------------------------------------------------------------
-
- if ( nlevurb == 0 ) return
-
- if (mode == 'initialize') then
-
- ! Read urban data
-
- if (masterproc) then
- write(iulog,*)' Reading in urban input data from fsurdat file ...'
- end if
-
- call getfil (fsurdat, locfn, 0)
- call ncd_pio_openfile (ncid, locfn, 0)
-
- if (masterproc) then
- write(iulog,*) subname,trim(fsurdat)
- end if
-
- ! Check whether this file has new-format urban data
- call ncd_inqdid(ncid, 'numurbl', dimid, dimexist=has_numurbl)
-
- ! If file doesn't have numurbl, then it is old-format urban;
- ! in this case, set nlevurb to zero
- if (.not. has_numurbl) then
- nlevurb = 0
- if (masterproc) write(iulog,*)'PCT_URBAN is not multi-density, nlevurb set to 0'
- end if
-
- if ( nlevurb == 0 ) return
-
- ! Allocate dynamic memory
- allocate(urbinp%canyon_hwr(begg:endg, numurbl), &
- urbinp%wtlunit_roof(begg:endg, numurbl), &
- urbinp%wtroad_perv(begg:endg, numurbl), &
- urbinp%em_roof(begg:endg, numurbl), &
- urbinp%em_improad(begg:endg, numurbl), &
- urbinp%em_perroad(begg:endg, numurbl), &
- urbinp%em_wall(begg:endg, numurbl), &
- urbinp%alb_roof_dir(begg:endg, numurbl, numrad), &
- urbinp%alb_roof_dif(begg:endg, numurbl, numrad), &
- urbinp%alb_improad_dir(begg:endg, numurbl, numrad), &
- urbinp%alb_perroad_dir(begg:endg, numurbl, numrad), &
- urbinp%alb_improad_dif(begg:endg, numurbl, numrad), &
- urbinp%alb_perroad_dif(begg:endg, numurbl, numrad), &
- urbinp%alb_wall_dir(begg:endg, numurbl, numrad), &
- urbinp%alb_wall_dif(begg:endg, numurbl, numrad), &
- urbinp%ht_roof(begg:endg, numurbl), &
- urbinp%wind_hgt_canyon(begg:endg, numurbl), &
- urbinp%tk_wall(begg:endg, numurbl,nlevurb), &
- urbinp%tk_roof(begg:endg, numurbl,nlevurb), &
- urbinp%tk_improad(begg:endg, numurbl,nlevurb), &
- urbinp%cv_wall(begg:endg, numurbl,nlevurb), &
- urbinp%cv_roof(begg:endg, numurbl,nlevurb), &
- urbinp%cv_improad(begg:endg, numurbl,nlevurb), &
- urbinp%thick_wall(begg:endg, numurbl), &
- urbinp%thick_roof(begg:endg, numurbl), &
- urbinp%nlev_improad(begg:endg, numurbl), &
- urbinp%t_building_min(begg:endg, numurbl), &
- stat=ier)
- if (ier /= 0) then
- call endrun(msg="Allocation error "//errmsg(sourcefile, __LINE__))
- endif
-
- call ncd_inqfdims (ncid, isgrid2d, ni, nj, ns)
- if (ldomain%ns /= ns .or. ldomain%ni /= ni .or. ldomain%nj /= nj) then
- write(iulog,*)trim(subname), 'ldomain and input file do not match dims '
- write(iulog,*)trim(subname), 'ldomain%ni,ni,= ',ldomain%ni,ni
- write(iulog,*)trim(subname), 'ldomain%nj,nj,= ',ldomain%nj,nj
- write(iulog,*)trim(subname), 'ldomain%ns,ns,= ',ldomain%ns,ns
- call endrun(msg=errmsg(sourcefile, __LINE__))
- end if
-
- call ncd_inqdid(ncid, 'nlevurb', dimid)
- call ncd_inqdlen(ncid, dimid, nlevurb_i)
- if (nlevurb_i /= nlevurb) then
- write(iulog,*)trim(subname)// ': parameter nlevurb= ',nlevurb, &
- 'does not equal input dataset nlevurb= ',nlevurb_i
- call endrun(msg=errmsg(sourcefile, __LINE__))
- endif
-
- call ncd_inqdid(ncid, 'numrad', dimid)
- call ncd_inqdlen(ncid, dimid, numrad_i)
- if (numrad_i /= numrad) then
- write(iulog,*)trim(subname)// ': parameter numrad= ',numrad, &
- 'does not equal input dataset numrad= ',numrad_i
- call endrun(msg=errmsg(sourcefile, __LINE__))
- endif
- call ncd_inqdid(ncid, 'numurbl', dimid)
- call ncd_inqdlen(ncid, dimid, numurbl_i)
- if (numurbl_i /= numurbl) then
- write(iulog,*)trim(subname)// ': parameter numurbl= ',numurbl, &
- 'does not equal input dataset numurbl= ',numurbl_i
- call endrun(msg=errmsg(sourcefile, __LINE__))
- endif
- call ncd_io(ncid=ncid, varname='CANYON_HWR', flag='read', data=urbinp%canyon_hwr,&
- dim1name=grlnd, readvar=readvar)
- if (.not. readvar) then
- call endrun( msg='ERROR: CANYON_HWR NOT on fsurdat file '//errmsg(sourcefile, __LINE__))
- end if
-
- call ncd_io(ncid=ncid, varname='WTLUNIT_ROOF', flag='read', data=urbinp%wtlunit_roof, &
- dim1name=grlnd, readvar=readvar)
- if (.not. readvar) then
- call endrun( msg=' ERROR: WTLUNIT_ROOF NOT on fsurdat file'//errmsg(sourcefile, __LINE__))
- end if
-
- call ncd_io(ncid=ncid, varname='WTROAD_PERV', flag='read', data=urbinp%wtroad_perv, &
- dim1name=grlnd, readvar=readvar)
- if (.not. readvar) then
- call endrun( msg=' ERROR: WTROAD_PERV NOT on fsurdat file'//errmsg(sourcefile, __LINE__))
- end if
-
- call ncd_io(ncid=ncid, varname='EM_ROOF', flag='read', data=urbinp%em_roof, &
- dim1name=grlnd, readvar=readvar)
- if (.not. readvar) then
- call endrun( msg=' ERROR: EM_ROOF NOT on fsurdat file'//errmsg(sourcefile, __LINE__))
- end if
-
- call ncd_io(ncid=ncid, varname='EM_IMPROAD', flag='read', data=urbinp%em_improad, &
- dim1name=grlnd, readvar=readvar)
- if (.not. readvar) then
- call endrun( msg=' ERROR: EM_IMPROAD NOT on fsurdat file'//errmsg(sourcefile, __LINE__))
- end if
-
- call ncd_io(ncid=ncid, varname='EM_PERROAD', flag='read', data=urbinp%em_perroad, &
- dim1name=grlnd, readvar=readvar)
- if (.not. readvar) then
- call endrun( msg=' ERROR: EM_PERROAD NOT on fsurdat file'//errmsg(sourcefile, __LINE__))
- end if
-
- call ncd_io(ncid=ncid, varname='EM_WALL', flag='read', data=urbinp%em_wall, &
- dim1name=grlnd, readvar=readvar)
- if (.not. readvar) then
- call endrun( msg=' ERROR: EM_WALL NOT on fsurdat file'//errmsg(sourcefile, __LINE__))
- end if
-
- call ncd_io(ncid=ncid, varname='HT_ROOF', flag='read', data=urbinp%ht_roof, &
- dim1name=grlnd, readvar=readvar)
- if (.not. readvar) then
- call endrun( msg=' ERROR: HT_ROOF NOT on fsurdat file'//errmsg(sourcefile, __LINE__))
- end if
-
- call ncd_io(ncid=ncid, varname='WIND_HGT_CANYON', flag='read', data=urbinp%wind_hgt_canyon, &
- dim1name=grlnd, readvar=readvar)
- if (.not. readvar) then
- call endrun( msg=' ERROR: WIND_HGT_CANYON NOT on fsurdat file'//errmsg(sourcefile, __LINE__))
- end if
-
- call ncd_io(ncid=ncid, varname='THICK_WALL', flag='read', data=urbinp%thick_wall, &
- dim1name=grlnd, readvar=readvar)
- if (.not. readvar) then
- call endrun( msg=' ERROR: THICK_WALL NOT on fsurdat file'//errmsg(sourcefile, __LINE__))
- end if
-
- call ncd_io(ncid=ncid, varname='THICK_ROOF', flag='read', data=urbinp%thick_roof, &
- dim1name=grlnd, readvar=readvar)
- if (.not. readvar) then
- call endrun( msg=' ERROR: THICK_ROOF NOT on fsurdat file'//errmsg(sourcefile, __LINE__))
- end if
-
- call ncd_io(ncid=ncid, varname='NLEV_IMPROAD', flag='read', data=urbinp%nlev_improad, &
- dim1name=grlnd, readvar=readvar)
- if (.not. readvar) then
- call endrun( msg=' ERROR: NLEV_IMPROAD NOT on fsurdat file'//errmsg(sourcefile, __LINE__))
- end if
-
- call ncd_io(ncid=ncid, varname='T_BUILDING_MIN', flag='read', data=urbinp%t_building_min, &
- dim1name=grlnd, readvar=readvar)
- if (.not. readvar) then
- call endrun( msg=' ERROR: T_BUILDING_MIN NOT on fsurdat file'//errmsg(sourcefile, __LINE__))
- end if
-
- call ncd_io(ncid=ncid, varname='ALB_IMPROAD_DIR', flag='read', data=urbinp%alb_improad_dir, &
- dim1name=grlnd, readvar=readvar)
- if (.not.readvar) then
- call endrun( msg=' ERROR: ALB_IMPROAD_DIR NOT on fsurdat file'//errmsg(sourcefile, __LINE__))
- end if
-
- call ncd_io(ncid=ncid, varname='ALB_IMPROAD_DIF', flag='read', data=urbinp%alb_improad_dif, &
- dim1name=grlnd, readvar=readvar)
- if (.not.readvar) then
- call endrun( msg=' ERROR: ALB_IMPROAD_DIF NOT on fsurdat file'//errmsg(sourcefile, __LINE__) )
- end if
-
- call ncd_io(ncid=ncid, varname='ALB_PERROAD_DIR', flag='read',data=urbinp%alb_perroad_dir, &
- dim1name=grlnd, readvar=readvar)
- if (.not. readvar) then
- call endrun( msg=' ERROR: ALB_PERROAD_DIR NOT on fsurdat file'//errmsg(sourcefile, __LINE__))
- end if
-
- call ncd_io(ncid=ncid, varname='ALB_PERROAD_DIF', flag='read',data=urbinp%alb_perroad_dif, &
- dim1name=grlnd, readvar=readvar)
- if (.not. readvar) then
- call endrun( msg=' ERROR: ALB_PERROAD_DIF NOT on fsurdat file'//errmsg(sourcefile, __LINE__))
- end if
-
- call ncd_io(ncid=ncid, varname='ALB_ROOF_DIR', flag='read', data=urbinp%alb_roof_dir, &
- dim1name=grlnd, readvar=readvar)
- if (.not. readvar) then
- call endrun( msg=' ERROR: ALB_ROOF_DIR NOT on fsurdat file'//errmsg(sourcefile, __LINE__))
- end if
-
- call ncd_io(ncid=ncid, varname='ALB_ROOF_DIF', flag='read', data=urbinp%alb_roof_dif, &
- dim1name=grlnd, readvar=readvar)
- if (.not. readvar) then
- call endrun( msg=' ERROR: ALB_ROOF_DIF NOT on fsurdat file'//errmsg(sourcefile, __LINE__))
- end if
-
- call ncd_io(ncid=ncid, varname='ALB_WALL_DIR', flag='read', data=urbinp%alb_wall_dir, &
- dim1name=grlnd, readvar=readvar)
- if (.not. readvar) then
- call endrun( msg=' ERROR: ALB_WALL_DIR NOT on fsurdat file'//errmsg(sourcefile, __LINE__))
- end if
-
- call ncd_io(ncid=ncid, varname='ALB_WALL_DIF', flag='read', data=urbinp%alb_wall_dif, &
- dim1name=grlnd, readvar=readvar)
- if (.not. readvar) then
- call endrun( msg=' ERROR: ALB_WALL_DIF NOT on fsurdat file'//errmsg(sourcefile, __LINE__))
- end if
-
- call ncd_io(ncid=ncid, varname='TK_IMPROAD', flag='read', data=urbinp%tk_improad, &
- dim1name=grlnd, readvar=readvar)
- if (.not. readvar) then
- call endrun( msg=' ERROR: TK_IMPROAD NOT on fsurdat file'//errmsg(sourcefile, __LINE__))
- end if
-
- call ncd_io(ncid=ncid, varname='TK_ROOF', flag='read', data=urbinp%tk_roof, &
- dim1name=grlnd, readvar=readvar)
- if (.not. readvar) then
- call endrun( msg=' ERROR: TK_ROOF NOT on fsurdat file'//errmsg(sourcefile, __LINE__))
- end if
-
- call ncd_io(ncid=ncid, varname='TK_WALL', flag='read', data=urbinp%tk_wall, &
- dim1name=grlnd, readvar=readvar)
- if (.not. readvar) then
- call endrun( msg=' ERROR: TK_WALL NOT on fsurdat file'//errmsg(sourcefile, __LINE__))
- end if
-
- call ncd_io(ncid=ncid, varname='CV_IMPROAD', flag='read', data=urbinp%cv_improad, &
- dim1name=grlnd, readvar=readvar)
- if (.not. readvar) then
- call endrun( msg=' ERROR: CV_IMPROAD NOT on fsurdat file'//errmsg(sourcefile, __LINE__))
- end if
-
- call ncd_io(ncid=ncid, varname='CV_ROOF', flag='read', data=urbinp%cv_roof, &
- dim1name=grlnd, readvar=readvar)
- if (.not. readvar) then
- call endrun( msg=' ERROR: CV_ROOF NOT on fsurdat file'//errmsg(sourcefile, __LINE__))
- end if
-
- call ncd_io(ncid=ncid, varname='CV_WALL', flag='read', data=urbinp%cv_wall, &
- dim1name=grlnd, readvar=readvar)
- if (.not. readvar) then
- call endrun( msg=' ERROR: CV_WALL NOT on fsurdat file'//errmsg(sourcefile, __LINE__))
- end if
-
- call ncd_pio_closefile(ncid)
- if (masterproc) then
- write(iulog,*)' Sucessfully read urban input data'
- write(iulog,*)
- end if
-
- else if (mode == 'finalize') then
-
- if ( nlevurb == 0 ) return
-
- deallocate(urbinp%canyon_hwr, &
- urbinp%wtlunit_roof, &
- urbinp%wtroad_perv, &
- urbinp%em_roof, &
- urbinp%em_improad, &
- urbinp%em_perroad, &
- urbinp%em_wall, &
- urbinp%alb_roof_dir, &
- urbinp%alb_roof_dif, &
- urbinp%alb_improad_dir, &
- urbinp%alb_perroad_dir, &
- urbinp%alb_improad_dif, &
- urbinp%alb_perroad_dif, &
- urbinp%alb_wall_dir, &
- urbinp%alb_wall_dif, &
- urbinp%ht_roof, &
- urbinp%wind_hgt_canyon, &
- urbinp%tk_wall, &
- urbinp%tk_roof, &
- urbinp%tk_improad, &
- urbinp%cv_wall, &
- urbinp%cv_roof, &
- urbinp%cv_improad, &
- urbinp%thick_wall, &
- urbinp%thick_roof, &
- urbinp%nlev_improad, &
- urbinp%t_building_min, &
- stat=ier)
- if (ier /= 0) then
- call endrun(msg='initUrbanInput: deallocation error '//errmsg(sourcefile, __LINE__))
- end if
- else
- write(iulog,*)'initUrbanInput error: mode ',trim(mode),' not supported '
- call endrun(msg=errmsg(sourcefile, __LINE__))
- end if
-
- end subroutine UrbanInput
-
- !-----------------------------------------------------------------------
- subroutine CheckUrban(begg, endg, pcturb, caller)
-
- !-----------------------------------------------------------------------
- ! !DESCRIPTION:
- ! Confirm that we have valid urban data for all points with pct urban > 0. If this isn't
- ! true, abort with a message.
- !
- ! !USES:
- use clm_instur , only : urban_valid
- use landunit_varcon , only : numurbl
- !
- ! !ARGUMENTS:
- implicit none
- integer , intent(in) :: begg, endg ! beg & end grid cell indices
- real(r8) , intent(in) :: pcturb(begg:,:) ! % urban
- character(len=*), intent(in) :: caller ! identifier of caller, for more meaningful error messages
- !
- ! !REVISION HISTORY:
- ! Created by Bill Sacks 7/2013, mostly by moving code from surfrd_special
- !
- ! !LOCAL VARIABLES:
- logical :: found
- integer :: nl, n
- integer :: nindx, dindx
- integer :: nlev
- !-----------------------------------------------------------------------
-
- found = .false.
- do nl = begg,endg
- do n = 1, numurbl
- if ( pcturb(nl,n) > 0.0_r8 ) then
- if ( .not. urban_valid(nl) .or. &
- urbinp%canyon_hwr(nl,n) <= 0._r8 .or. &
- urbinp%em_improad(nl,n) <= 0._r8 .or. &
- urbinp%em_perroad(nl,n) <= 0._r8 .or. &
- urbinp%em_roof(nl,n) <= 0._r8 .or. &
- urbinp%em_wall(nl,n) <= 0._r8 .or. &
- urbinp%ht_roof(nl,n) <= 0._r8 .or. &
- urbinp%thick_roof(nl,n) <= 0._r8 .or. &
- urbinp%thick_wall(nl,n) <= 0._r8 .or. &
- urbinp%t_building_min(nl,n) <= 0._r8 .or. &
- urbinp%wind_hgt_canyon(nl,n) <= 0._r8 .or. &
- urbinp%wtlunit_roof(nl,n) <= 0._r8 .or. &
- urbinp%wtroad_perv(nl,n) <= 0._r8 .or. &
- any(urbinp%alb_improad_dir(nl,n,:) <= 0._r8) .or. &
- any(urbinp%alb_improad_dif(nl,n,:) <= 0._r8) .or. &
- any(urbinp%alb_perroad_dir(nl,n,:) <= 0._r8) .or. &
- any(urbinp%alb_perroad_dif(nl,n,:) <= 0._r8) .or. &
- any(urbinp%alb_roof_dir(nl,n,:) <= 0._r8) .or. &
- any(urbinp%alb_roof_dif(nl,n,:) <= 0._r8) .or. &
- any(urbinp%alb_wall_dir(nl,n,:) <= 0._r8) .or. &
- any(urbinp%alb_wall_dif(nl,n,:) <= 0._r8) .or. &
- any(urbinp%tk_roof(nl,n,:) <= 0._r8) .or. &
- any(urbinp%tk_wall(nl,n,:) <= 0._r8) .or. &
- any(urbinp%cv_roof(nl,n,:) <= 0._r8) .or. &
- any(urbinp%cv_wall(nl,n,:) <= 0._r8)) then
- found = .true.
- nindx = nl
- dindx = n
- exit
- else
- if (urbinp%nlev_improad(nl,n) > 0) then
- nlev = urbinp%nlev_improad(nl,n)
- if ( any(urbinp%tk_improad(nl,n,1:nlev) <= 0._r8) .or. &
- any(urbinp%cv_improad(nl,n,1:nlev) <= 0._r8)) then
- found = .true.
- nindx = nl
- dindx = n
- exit
- end if
- end if
- end if
- if (found) exit
- end if
- end do
- end do
- if ( found ) then
- write(iulog,*) trim(caller), ' ERROR: no valid urban data for nl=',nindx
- write(iulog,*)'density type: ',dindx
- write(iulog,*)'urban_valid: ',urban_valid(nindx)
- write(iulog,*)'canyon_hwr: ',urbinp%canyon_hwr(nindx,dindx)
- write(iulog,*)'em_improad: ',urbinp%em_improad(nindx,dindx)
- write(iulog,*)'em_perroad: ',urbinp%em_perroad(nindx,dindx)
- write(iulog,*)'em_roof: ',urbinp%em_roof(nindx,dindx)
- write(iulog,*)'em_wall: ',urbinp%em_wall(nindx,dindx)
- write(iulog,*)'ht_roof: ',urbinp%ht_roof(nindx,dindx)
- write(iulog,*)'thick_roof: ',urbinp%thick_roof(nindx,dindx)
- write(iulog,*)'thick_wall: ',urbinp%thick_wall(nindx,dindx)
- write(iulog,*)'t_building_min: ',urbinp%t_building_min(nindx,dindx)
- write(iulog,*)'wind_hgt_canyon: ',urbinp%wind_hgt_canyon(nindx,dindx)
- write(iulog,*)'wtlunit_roof: ',urbinp%wtlunit_roof(nindx,dindx)
- write(iulog,*)'wtroad_perv: ',urbinp%wtroad_perv(nindx,dindx)
- write(iulog,*)'alb_improad_dir: ',urbinp%alb_improad_dir(nindx,dindx,:)
- write(iulog,*)'alb_improad_dif: ',urbinp%alb_improad_dif(nindx,dindx,:)
- write(iulog,*)'alb_perroad_dir: ',urbinp%alb_perroad_dir(nindx,dindx,:)
- write(iulog,*)'alb_perroad_dif: ',urbinp%alb_perroad_dif(nindx,dindx,:)
- write(iulog,*)'alb_roof_dir: ',urbinp%alb_roof_dir(nindx,dindx,:)
- write(iulog,*)'alb_roof_dif: ',urbinp%alb_roof_dif(nindx,dindx,:)
- write(iulog,*)'alb_wall_dir: ',urbinp%alb_wall_dir(nindx,dindx,:)
- write(iulog,*)'alb_wall_dif: ',urbinp%alb_wall_dif(nindx,dindx,:)
- write(iulog,*)'tk_roof: ',urbinp%tk_roof(nindx,dindx,:)
- write(iulog,*)'tk_wall: ',urbinp%tk_wall(nindx,dindx,:)
- write(iulog,*)'cv_roof: ',urbinp%cv_roof(nindx,dindx,:)
- write(iulog,*)'cv_wall: ',urbinp%cv_wall(nindx,dindx,:)
- if (urbinp%nlev_improad(nindx,dindx) > 0) then
- nlev = urbinp%nlev_improad(nindx,dindx)
- write(iulog,*)'tk_improad: ',urbinp%tk_improad(nindx,dindx,1:nlev)
- write(iulog,*)'cv_improad: ',urbinp%cv_improad(nindx,dindx,1:nlev)
- end if
- call endrun(msg=errmsg(sourcefile, __LINE__))
- end if
-
- end subroutine CheckUrban
-
- !-----------------------------------------------------------------------
-
- !-----------------------------------------------------------------------
- !BOP
- !
- ! !IROUTINE: UrbanReadNML
- !
- ! !INTERFACE:
- !
- subroutine UrbanReadNML ( NLFilename )
- !
- ! !DESCRIPTION:
- !
- ! Read in the urban namelist
- !
- ! !USES:
- use shr_mpi_mod , only : shr_mpi_bcast
- use abortutils , only : endrun
- 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 = 'UrbanReadNML' ! subroutine name
-
- namelist / clmu_inparm / urban_hac, urban_traffic, building_temp_method
- !EOP
- !-----------------------------------------------------------------------
-
- ! ----------------------------------------------------------------------
- ! Read namelist from input namelist filename
- ! ----------------------------------------------------------------------
-
- if ( masterproc )then
-
- unitn = getavu()
- write(iulog,*) 'Read in clmu_inparm namelist'
- call opnfil (NLFilename, unitn, 'F')
- call shr_nl_find_group_name(unitn, 'clmu_inparm', status=ierr)
- if (ierr == 0) then
- read(unitn, clmu_inparm, iostat=ierr)
- if (ierr /= 0) then
- call endrun(msg="ERROR reading clmu_inparm namelist"//errmsg(sourcefile, __LINE__))
- end if
- else
- call endrun(msg="ERROR finding clmu_inparm namelist"//errmsg(sourcefile, __LINE__))
- end if
- call relavu( unitn )
-
- end if
-
- ! Broadcast namelist variables read in
- call shr_mpi_bcast(urban_hac, mpicom)
- call shr_mpi_bcast(urban_traffic, mpicom)
- call shr_mpi_bcast(building_temp_method, mpicom)
-
- !
- if (urban_traffic) then
- write(iulog,*)'Urban traffic fluxes are not implemented currently'
- call endrun(msg=errMsg(sourcefile, __LINE__))
- end if
- !
- if ( masterproc )then
- write(iulog,*) ' urban air conditioning/heating and wasteheat = ', urban_hac
- write(iulog,*) ' urban traffic flux = ', urban_traffic
- end if
-
- ReadNamelist = .true.
-
- end subroutine UrbanReadNML
-
- !-----------------------------------------------------------------------
-
- !-----------------------------------------------------------------------
- !BOP
- !
- ! !IROUTINE: IsSimpleBuildTemp
- !
- ! !INTERFACE:
- !
- logical function IsSimpleBuildTemp( )
- !
- ! !DESCRIPTION:
- !
- ! If the simple building temperature method is being used
- !
- ! !USES:
- implicit none
- !EOP
- !-----------------------------------------------------------------------
-
- if ( .not. ReadNamelist )then
- write(iulog,*)'Testing on building_temp_method before urban namelist was read in'
- call endrun(msg=errMsg(sourcefile, __LINE__))
- end if
- IsSimpleBuildTemp = building_temp_method == BUILDING_TEMP_METHOD_SIMPLE
-
- end function IsSimpleBuildTemp
-
- !-----------------------------------------------------------------------
-
- !-----------------------------------------------------------------------
- !BOP
- !
- ! !IROUTINE: IsProgBuildTemp
- !
- ! !INTERFACE:
- !
- logical function IsProgBuildTemp( )
- !
- ! !DESCRIPTION:
- !
- ! If the prognostic building temperature method is being used
- !
- ! !USES:
- implicit none
- !EOP
- !-----------------------------------------------------------------------
-
- if ( .not. ReadNamelist )then
- write(iulog,*)'Testing on building_temp_method before urban namelist was read in'
- call endrun(msg=errMsg(sourcefile, __LINE__))
- end if
- IsProgBuildTemp = building_temp_method == BUILDING_TEMP_METHOD_PROG
-
- end function IsProgBuildTemp
-
- !-----------------------------------------------------------------------
-
-end module UrbanParamsType
-
-
-
-
diff --git a/src/biogeophys/UrbanTimeVarType.F90 b/src/biogeophys/UrbanTimeVarType.F90
deleted file mode 100644
index 600f506f..00000000
--- a/src/biogeophys/UrbanTimeVarType.F90
+++ /dev/null
@@ -1,168 +0,0 @@
-module UrbanTimeVarType
-
- !------------------------------------------------------------------------------
- ! !DESCRIPTION:
- ! Urban Time Varying Data
- !
- ! !USES:
- use shr_kind_mod , only : r8 => shr_kind_r8, CL => shr_kind_CL
- use shr_log_mod , only : errMsg => shr_log_errMsg
- use abortutils , only : endrun
- use decompMod , only : bounds_type
- use clm_varctl , only : iulog
- use landunit_varcon , only : isturb_MIN, isturb_MAX
- use clm_varcon , only : spval
- use LandunitType , only : lun
- use GridcellType , only : grc
- use mct_mod
- use shr_strdata_mod , only : shr_strdata_type
- !
- implicit none
- save
- private
- !
- !
-
- ! !PUBLIC TYPE
- type, public :: urbantv_type
-
- real(r8), public, pointer :: t_building_max(:) ! lun maximum internal building air temperature (K)
- type(shr_strdata_type) :: sdat_urbantv ! urban time varying input data stream
- contains
-
- ! !PUBLIC MEMBER FUNCTIONS:
- procedure, public :: Init ! Allocate and initialize urbantv
- procedure, public :: urbantv_interp ! Interpolate urban time varying stream
-
- end type urbantv_type
-
- !-----------------------------------------------------------------------
- character(15), private :: stream_var_name(isturb_MIN:isturb_MAX)
-
- character(len=*), parameter, private :: sourcefile = &
- __FILE__
-
-contains
-
- !-----------------------------------------------------------------------
- subroutine Init(this, bounds, NLFilename)
- !
- ! Allocate module variables and data structures
- !
- ! !USES:
- use shr_infnan_mod , only : nan => shr_infnan_nan, assignment(=)
- use histFileMod , only : hist_addfld1d
- !
- ! !ARGUMENTS:
- class(urbantv_type) :: this
- type(bounds_type) , intent(in) :: bounds
- character(len=*) , intent(in) :: NLFilename ! Namelist filename
- !
- ! !LOCAL VARIABLES:
- integer :: begl, endl
- !---------------------------------------------------------------------
-
- begl = bounds%begl; endl = bounds%endl
-
- ! Allocate urbantv data structure
-
- allocate(this%t_building_max (begl:endl)) ; this%t_building_max (:) = nan
-
- call this%urbantv_interp(bounds)
-
- ! Add history fields
- call hist_addfld1d (fname='TBUILD_MAX', units='K', &
- avgflag='A', long_name='prescribed maximum interior building temperature', &
- ptr_lunit=this%t_building_max, default='inactive', set_nourb=spval, &
- l2g_scale_type='unity')
-
-
- end subroutine Init
-
- !-----------------------------------------------------------------------
- subroutine urbantv_interp(this, bounds)
- !
- ! !DESCRIPTION:
- ! Interpolate data stream information for urban time varying data.
- !
- ! !USES:
- use clm_time_manager, only : get_curr_date
- use spmdMod , only : mpicom
- use shr_strdata_mod , only : shr_strdata_advance
- use clm_instur , only : urban_valid
- !
- ! !ARGUMENTS:
- class(urbantv_type) :: this
- type(bounds_type), intent(in) :: bounds
- !
- ! !LOCAL VARIABLES:
- logical :: found
- integer :: l, glun, ig, g, ip
- integer :: year ! year (0, ...) for nstep+1
- integer :: mon ! month (1, ..., 12) for nstep+1
- integer :: day ! day of month (1, ..., 31) for nstep+1
- integer :: sec ! seconds into current date for nstep+1
- integer :: mcdate ! Current model date (yyyymmdd)
- integer :: lindx ! landunit index
- integer :: gindx ! gridcell index
- !-----------------------------------------------------------------------
-
- call get_curr_date(year, mon, day, sec)
- mcdate = year*10000 + mon*100 + day
-
- call shr_strdata_advance(this%sdat_urbantv, mcdate, sec, mpicom, 'urbantvdyn')
-
- do l = bounds%begl,bounds%endl
- if (lun%urbpoi(l)) then
- glun = lun%gridcell(l)
- ip = mct_aVect_indexRA(this%sdat_urbantv%avs(1),trim(stream_var_name(lun%itype(l))))
- !
- ! Determine vector index corresponding to glun
- !
- ig = 0
- do g = bounds%begg,bounds%endg
- ig = ig+1
- if (g == glun) exit
- end do
-
- this%t_building_max(l) = this%sdat_urbantv%avs(1)%rAttr(ip,ig)
- else
- this%t_building_max(l) = spval
- end if
- end do
-
- found = .false.
- do l = bounds%begl,bounds%endl
- if (lun%urbpoi(l)) then
- glun = lun%gridcell(l)
- !
- ! Determine vector index corresponding to glun
- !
- ig = 0
- do g = bounds%begg,bounds%endg
- ig = ig+1
- if (g == glun) exit
- end do
-
- if ( .not. urban_valid(g) .or. (this%t_building_max(l) <= 0._r8)) then
- found = .true.
- gindx = g
- lindx = l
- exit
- end if
- end if
- end do
- if ( found ) then
- write(iulog,*)'ERROR: no valid urban data for g= ',gindx
- write(iulog,*)'landunit type: ',lun%itype(l)
- write(iulog,*)'urban_valid: ',urban_valid(gindx)
- write(iulog,*)'t_building_max: ',this%t_building_max(lindx)
- call endrun(msg=errmsg(sourcefile, __LINE__))
- end if
-
-
- end subroutine urbantv_interp
-
- !-----------------------------------------------------------------------
-
-end module UrbanTimeVarType
diff --git a/src/biogeophys/WaterStateType.F90 b/src/biogeophys/WaterStateType.F90
deleted file mode 100644
index 4615e22f..00000000
--- a/src/biogeophys/WaterStateType.F90
+++ /dev/null
@@ -1,1122 +0,0 @@
-module WaterstateType
-
-#include "shr_assert.h"
-
- !------------------------------------------------------------------------------
- ! !DESCRIPTION:
- ! Module variables for hydrology
- !
- ! !USES:
- use shr_kind_mod , only : r8 => shr_kind_r8
- use shr_log_mod , only : errMsg => shr_log_errMsg
- use decompMod , only : bounds_type
- use clm_varctl , only : use_vancouver, use_mexicocity, use_cn, iulog, use_luna
- use clm_varpar , only : nlevgrnd, nlevurb, nlevsno
- use clm_varcon , only : spval
- use LandunitType , only : lun
- use ColumnType , only : col
- !
- implicit none
- save
- private
- !
- ! !PUBLIC TYPES:
- type, public :: waterstate_type
-
- real(r8), pointer :: snow_depth_col (:) ! col snow height of snow covered area (m)
- real(r8), pointer :: snow_persistence_col (:) ! col length of time that ground has had non-zero snow thickness (sec)
- real(r8), pointer :: snowdp_col (:) ! col area-averaged snow height (m)
- real(r8), pointer :: snowice_col (:) ! col average snow ice lens
- real(r8), pointer :: snowliq_col (:) ! col average snow liquid water
- real(r8), pointer :: int_snow_col (:) ! col integrated snowfall (mm H2O)
- real(r8), pointer :: snow_layer_unity_col (:,:) ! value 1 for each snow layer, used for history diagnostics
- real(r8), pointer :: bw_col (:,:) ! col partial density of water in the snow pack (ice + liquid) [kg/m3]
-
- 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_tot_col (:) ! vertically summed col liquid water (kg/m2) (new) (-nlevsno+1:nlevgrnd)
- real(r8), pointer :: h2osoi_ice_tot_col (:) ! vertically summed col ice lens (kg/m2) (new) (-nlevsno+1:nlevgrnd)
- 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
- real(r8), pointer :: h2osoi_liqvol_col (:,:) ! col volumetric liquid water content (v/v)
- real(r8), pointer :: h2ocan_patch (:) ! patch canopy water (mm H2O)
- real(r8), pointer :: h2osfc_col (:) ! col surface water (mm H2O)
- real(r8), pointer :: snocan_patch (:) ! patch canopy snow water (mm H2O)
- real(r8), pointer :: liqcan_patch (:) ! patch canopy liquid water (mm H2O)
- real(r8), pointer :: snounload_patch (:) ! Canopy snow unloading (mm H2O)
- real(r8), pointer :: swe_old_col (:,:) ! col initial snow water
- real(r8), pointer :: liq1_grc (:) ! grc initial gridcell total h2o liq content
- real(r8), pointer :: liq2_grc (:) ! grc post land cover change total liq content
- real(r8), pointer :: ice1_grc (:) ! grc initial gridcell total h2o ice content
- real(r8), pointer :: ice2_grc (:) ! grc post land cover change total ice content
- real(r8), pointer :: tws_grc (:) ! grc total water storage (mm H2O)
-
- real(r8), pointer :: total_plant_stored_h2o_col(:) ! col water that is bound in plants, including roots, sapwood, leaves, etc
- ! in most cases, the vegetation scheme does not have a dynamic
- ! water storage in plants, and thus 0.0 is a suitable for the trivial case.
- ! When FATES is coupled in with plant hydraulics turned on, this storage
- ! term is set to non-zero. (kg/m2 H2O)
-
- real(r8), pointer :: snw_rds_col (:,:) ! col snow grain radius (col,lyr) [m^-6, microns]
- real(r8), pointer :: snw_rds_top_col (:) ! col snow grain radius (top layer) [m^-6, microns]
- real(r8), pointer :: h2osno_top_col (:) ! col top-layer mass of snow [kg]
- real(r8), pointer :: sno_liq_top_col (:) ! col snow liquid water fraction (mass), top layer [fraction]
-
- real(r8), pointer :: q_ref2m_patch (:) ! patch 2 m height surface specific humidity (kg/kg)
- real(r8), pointer :: rh_ref2m_patch (:) ! patch 2 m height surface relative humidity (%)
- real(r8), pointer :: rh_ref2m_r_patch (:) ! patch 2 m height surface relative humidity - rural (%)
- real(r8), pointer :: rh_ref2m_u_patch (:) ! patch 2 m height surface relative humidity - urban (%)
- real(r8), pointer :: rh_af_patch (:) ! patch fractional humidity of canopy air (dimensionless) ! private
- real(r8), pointer :: rh10_af_patch (:) ! 10-day mean patch fractional humidity of canopy air (dimensionless)
- real(r8), pointer :: qg_snow_col (:) ! col ground specific humidity [kg/kg]
- real(r8), pointer :: qg_soil_col (:) ! col ground specific humidity [kg/kg]
- real(r8), pointer :: qg_h2osfc_col (:) ! col ground specific humidity [kg/kg]
- real(r8), pointer :: qg_col (:) ! col ground specific humidity [kg/kg]
- real(r8), pointer :: dqgdT_col (:) ! col d(qg)/dT
- real(r8), pointer :: qaf_lun (:) ! lun urban canopy air specific humidity (kg/kg)
-
- ! Fractions
- real(r8), pointer :: frac_sno_col (:) ! col fraction of ground covered by snow (0 to 1)
- real(r8), pointer :: frac_sno_eff_col (:) ! col fraction of ground covered by snow (0 to 1)
- real(r8), pointer :: frac_iceold_col (:,:) ! col fraction of ice relative to the tot water (new) (-nlevsno+1:nlevgrnd)
- real(r8), pointer :: frac_h2osfc_col (:) ! col fractional area with surface water greater than zero
- real(r8), pointer :: frac_h2osfc_nosnow_col (:) ! col fractional area with surface water greater than zero (if no snow present)
- real(r8), pointer :: wf_col (:) ! col soil water as frac. of whc for top 0.05 m (0-1)
- real(r8), pointer :: wf2_col (:) ! col soil water as frac. of whc for top 0.17 m (0-1)
- real(r8), pointer :: fwet_patch (:) ! patch canopy fraction that is wet (0 to 1)
- real(r8), pointer :: fcansno_patch (:) ! patch canopy fraction that is snow covered (0 to 1)
- real(r8), pointer :: fdry_patch (:) ! patch canopy fraction of foliage that is green and dry [-] (new)
-
- ! Balance Checks
-
- real(r8), pointer :: begwb_col (:) ! water mass begining of the time step
- real(r8), pointer :: endwb_col (:) ! water mass end of the time step
- real(r8), pointer :: errh2o_patch (:) ! water conservation error (mm H2O)
- real(r8), pointer :: errh2o_col (:) ! water conservation error (mm H2O)
- real(r8), pointer :: errh2osno_col (:) ! snow water conservation error(mm H2O)
-
- contains
-
- procedure :: Init
- procedure :: Restart
- procedure, public :: Reset
- procedure, private :: InitAllocate
- procedure, private :: InitHistory
- procedure, private :: InitCold
-
- end type waterstate_type
-
- ! minimum allowed snow effective radius (also "fresh snow" value) [microns]
- real(r8), public, parameter :: snw_rds_min = 54.526_r8
-
- character(len=*), parameter, private :: sourcefile = &
- __FILE__
- !------------------------------------------------------------------------
-
-contains
-
- !------------------------------------------------------------------------
- subroutine Init(this, bounds, &
- h2osno_input_col, snow_depth_input_col, watsat_col, t_soisno_col)
-
- class(waterstate_type) :: this
- type(bounds_type) , intent(in) :: bounds
- real(r8) , intent(inout) :: h2osno_input_col(bounds%begc:)
- real(r8) , intent(inout) :: snow_depth_input_col(bounds%begc:)
- real(r8) , intent(inout) :: watsat_col(bounds%begc:, 1:) ! volumetric soil water at saturation (porosity)
- real(r8) , intent(inout) :: t_soisno_col(bounds%begc:, -nlevsno+1:) ! col soil temperature (Kelvin)
-
-#ifdef __PGI
-# if __PGIC__ == 14 && __PGIC_MINOR__ == 7
- ! COMPILER_BUG(bja, 2015-04, pgi 14.7-?) occurs at: call this%InitCold(...)
- ! PGF90-F-0000-Internal compiler error. normalize_forall_array: non-conformable
- ! not sure why this fixes things....
- real(r8), allocatable :: workaround_for_pgi_internal_compiler_error(:)
-# endif
-#endif
-
- call this%InitAllocate(bounds)
-
- call this%InitHistory(bounds)
-
- call this%InitCold(bounds, &
- h2osno_input_col, snow_depth_input_col, watsat_col, t_soisno_col)
-
- end subroutine Init
-
- !------------------------------------------------------------------------
- subroutine InitAllocate(this, bounds)
- !
- ! !DESCRIPTION:
- ! Initialize module data structure
- !
- ! !USES:
- use shr_infnan_mod , only : nan => shr_infnan_nan, assignment(=)
- !
- ! !ARGUMENTS:
- class(waterstate_type) :: this
- type(bounds_type), intent(in) :: bounds
- !
- ! !LOCAL VARIABLES:
- integer :: begp, endp
- integer :: begc, endc
- integer :: begl, endl
- integer :: begg, endg
- !------------------------------------------------------------------------
-
- begp = bounds%begp; endp= bounds%endp
- begc = bounds%begc; endc= bounds%endc
- begl = bounds%begl; endl= bounds%endl
- begg = bounds%begg; endg= bounds%endg
-
- allocate(this%snow_depth_col (begc:endc)) ; this%snow_depth_col (:) = nan
- allocate(this%snow_persistence_col (begc:endc)) ; this%snow_persistence_col (:) = nan
- allocate(this%snowdp_col (begc:endc)) ; this%snowdp_col (:) = nan
- allocate(this%snowice_col (begc:endc)) ; this%snowice_col (:) = nan
- allocate(this%snowliq_col (begc:endc)) ; this%snowliq_col (:) = nan
- allocate(this%int_snow_col (begc:endc)) ; this%int_snow_col (:) = nan
- allocate(this%snow_layer_unity_col (begc:endc,-nlevsno+1:0)) ; this%snow_layer_unity_col (:,:) = nan
- allocate(this%bw_col (begc:endc,-nlevsno+1:0)) ; this%bw_col (:,:) = nan
- allocate(this%h2osno_col (begc:endc)) ; this%h2osno_col (:) = nan
- allocate(this%h2osno_old_col (begc:endc)) ; this%h2osno_old_col (:) = nan
- allocate(this%h2osoi_liqice_10cm_col (begc:endc)) ; this%h2osoi_liqice_10cm_col (:) = nan
- allocate(this%h2osoi_vol_col (begc:endc, 1:nlevgrnd)) ; this%h2osoi_vol_col (:,:) = nan
- 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_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%h2osoi_ice_tot_col (begc:endc)) ; this%h2osoi_ice_tot_col (:) = nan
- allocate(this%h2osoi_liq_tot_col (begc:endc)) ; this%h2osoi_liq_tot_col (:) = nan
- allocate(this%h2ocan_patch (begp:endp)) ; this%h2ocan_patch (:) = nan
- allocate(this%snocan_patch (begp:endp)) ; this%snocan_patch (:) = nan
- allocate(this%liqcan_patch (begp:endp)) ; this%liqcan_patch (:) = nan
- allocate(this%snounload_patch (begp:endp)) ; this%snounload_patch (:) = nan
- allocate(this%h2osfc_col (begc:endc)) ; this%h2osfc_col (:) = nan
- allocate(this%swe_old_col (begc:endc,-nlevsno+1:0)) ; this%swe_old_col (:,:) = nan
- allocate(this%liq1_grc (begg:endg)) ; this%liq1_grc (:) = nan
- allocate(this%liq2_grc (begg:endg)) ; this%liq2_grc (:) = nan
- allocate(this%ice1_grc (begg:endg)) ; this%ice1_grc (:) = nan
- allocate(this%ice2_grc (begg:endg)) ; this%ice2_grc (:) = nan
- allocate(this%tws_grc (begg:endg)) ; this%tws_grc (:) = nan
-
- allocate(this%total_plant_stored_h2o_col(begc:endc)) ; this%total_plant_stored_h2o_col(:) = nan
-
- allocate(this%snw_rds_col (begc:endc,-nlevsno+1:0)) ; this%snw_rds_col (:,:) = nan
- allocate(this%snw_rds_top_col (begc:endc)) ; this%snw_rds_top_col (:) = nan
- allocate(this%h2osno_top_col (begc:endc)) ; this%h2osno_top_col (:) = nan
- allocate(this%sno_liq_top_col (begc:endc)) ; this%sno_liq_top_col (:) = nan
-
- allocate(this%qg_snow_col (begc:endc)) ; this%qg_snow_col (:) = nan
- allocate(this%qg_soil_col (begc:endc)) ; this%qg_soil_col (:) = nan
- allocate(this%qg_h2osfc_col (begc:endc)) ; this%qg_h2osfc_col (:) = nan
- allocate(this%qg_col (begc:endc)) ; this%qg_col (:) = nan
- allocate(this%dqgdT_col (begc:endc)) ; this%dqgdT_col (:) = nan
- allocate(this%qaf_lun (begl:endl)) ; this%qaf_lun (:) = nan
- allocate(this%q_ref2m_patch (begp:endp)) ; this%q_ref2m_patch (:) = nan
- allocate(this%rh_ref2m_patch (begp:endp)) ; this%rh_ref2m_patch (:) = nan
- allocate(this%rh_ref2m_u_patch (begp:endp)) ; this%rh_ref2m_u_patch (:) = nan
- allocate(this%rh_ref2m_r_patch (begp:endp)) ; this%rh_ref2m_r_patch (:) = nan
- allocate(this%rh_af_patch (begp:endp)) ; this%rh_af_patch (:) = nan
- allocate(this%rh10_af_patch (begp:endp)) ; this%rh10_af_patch (:) = spval
-
- allocate(this%frac_sno_col (begc:endc)) ; this%frac_sno_col (:) = nan
- allocate(this%frac_sno_eff_col (begc:endc)) ; this%frac_sno_eff_col (:) = nan
- allocate(this%frac_iceold_col (begc:endc,-nlevsno+1:nlevgrnd)) ; this%frac_iceold_col (:,:) = nan
- allocate(this%frac_h2osfc_col (begc:endc)) ; this%frac_h2osfc_col (:) = nan
- allocate(this%frac_h2osfc_nosnow_col (begc:endc)) ; this%frac_h2osfc_nosnow_col (:) = nan
- allocate(this%wf_col (begc:endc)) ; this%wf_col (:) = nan
- allocate(this%wf2_col (begc:endc)) ;
- allocate(this%fwet_patch (begp:endp)) ; this%fwet_patch (:) = nan
- allocate(this%fcansno_patch (begp:endp)) ; this%fcansno_patch (:) = nan
- allocate(this%fdry_patch (begp:endp)) ; this%fdry_patch (:) = nan
-
- allocate(this%begwb_col (begc:endc)) ; this%begwb_col (:) = nan
- allocate(this%endwb_col (begc:endc)) ; this%endwb_col (:) = nan
- allocate(this%errh2o_patch (begp:endp)) ; this%errh2o_patch (:) = nan
- allocate(this%errh2o_col (begc:endc)) ; this%errh2o_col (:) = nan
- allocate(this%errh2osno_col (begc:endc)) ; this%errh2osno_col (:) = nan
- end subroutine InitAllocate
-
- !------------------------------------------------------------------------
- subroutine InitHistory(this, bounds)
- !
- ! !DESCRIPTION:
- ! Initialize module data structure
- !
- ! !USES:
- use shr_infnan_mod , only : nan => shr_infnan_nan, assignment(=)
- use clm_varctl , only : use_cn
- use clm_varctl , only : hist_wrtch4diag
- use clm_varpar , only : nlevsno, nlevsoi
- use histFileMod , only : hist_addfld1d, hist_addfld2d, no_snow_normal, no_snow_zero
- !
- ! !ARGUMENTS:
- class(waterstate_type) :: this
- type(bounds_type), intent(in) :: bounds
- !
- ! !LOCAL VARIABLES:
- integer :: begp, endp
- integer :: begc, endc
- integer :: begg, endg
- character(10) :: active
- real(r8), pointer :: data2dptr(:,:), data1dptr(:) ! temp. pointers for slicing larger arrays
- !------------------------------------------------------------------------
-
- begp = bounds%begp; endp= bounds%endp
- begc = bounds%begc; endc= bounds%endc
- begg = bounds%begg; endg= bounds%endg
-
- ! h2osno also includes snow that is part of the soil column (an
- ! initial snow layer is only created if h2osno > 10mm).
-
- data2dptr => this%h2osoi_liq_col(:,-nlevsno+1:0)
- call hist_addfld2d (fname='SNO_LIQH2O', units='kg/m2', type2d='levsno', &
- avgflag='A', long_name='Snow liquid water content', &
- ptr_col=data2dptr, no_snow_behavior=no_snow_normal, default='inactive')
-
- data2dptr => this%h2osoi_ice_col(:,-nlevsno+1:0)
- call hist_addfld2d (fname='SNO_ICE', units='kg/m2', type2d='levsno', &
- avgflag='A', long_name='Snow ice content', &
- ptr_col=data2dptr, no_snow_behavior=no_snow_normal, default='inactive')
-
- data2dptr => this%h2osoi_vol_col(begc:endc,1:nlevsoi)
- call hist_addfld2d (fname='H2OSOI', units='mm3/mm3', type2d='levsoi', &
- avgflag='A', long_name='volumetric soil water (vegetated landunits only)', &
- ptr_col=this%h2osoi_vol_col, l2g_scale_type='veg', default='inactive')
-
-! this%h2osoi_liq_col(begc:endc,:) = spval
-! call hist_addfld2d (fname='SOILLIQ', units='kg/m2', type2d='levgrnd', &
-! avgflag='A', long_name='soil liquid water (vegetated landunits only)', &
-! ptr_col=this%h2osoi_liq_col, l2g_scale_type='veg')
-
- data2dptr => this%h2osoi_liq_col(begc:endc,1:nlevsoi)
- call hist_addfld2d (fname='SOILLIQ', units='kg/m2', type2d='levsoi', &
- avgflag='A', long_name='soil liquid water (vegetated landunits only)', &
- ptr_col=data2dptr, l2g_scale_type='veg', default='inactive')
-
- data2dptr => this%h2osoi_ice_col(begc:endc,1:nlevsoi)
- call hist_addfld2d (fname='SOILICE', units='kg/m2', type2d='levsoi', &
- avgflag='A', long_name='soil ice (vegetated landunits only)', &
- ptr_col=data2dptr, l2g_scale_type='veg', default='inactive')
-
- this%h2osoi_liqice_10cm_col(begc:endc) = spval
- call hist_addfld1d (fname='SOILWATER_10CM', units='kg/m2', &
- avgflag='A', long_name='soil liquid water + ice in top 10cm of soil (veg landunits only)', &
- ptr_col=this%h2osoi_liqice_10cm_col, set_urb=spval, set_lake=spval, l2g_scale_type='veg', default='inactive')
-
- this%h2osoi_liq_tot_col(begc:endc) = spval
- call hist_addfld1d (fname='TOTSOILLIQ', units='kg/m2', &
- avgflag='A', long_name='vertically summed soil liquid water (veg landunits only)', &
- ptr_col=this%h2osoi_liq_tot_col, set_urb=spval, set_lake=spval, l2g_scale_type='veg', default='inactive')
-
- this%h2osoi_ice_tot_col(begc:endc) = spval
- call hist_addfld1d (fname='TOTSOILICE', units='kg/m2', &
- avgflag='A', long_name='vertically summed soil cie (veg landunits only)', &
- ptr_col=this%h2osoi_ice_tot_col, set_urb=spval, set_lake=spval, l2g_scale_type='veg', default='inactive')
-
- this%h2ocan_patch(begp:endp) = spval
- call hist_addfld1d (fname='H2OCAN', units='mm', &
- avgflag='A', long_name='intercepted water', &
- ptr_patch=this%h2ocan_patch, set_lake=0._r8, default='inactive')
-
- this%snocan_patch(begp:endp) = spval
- call hist_addfld1d (fname='SNOCAN', units='mm', &
- avgflag='A', long_name='intercepted snow', &
- ptr_patch=this%snocan_patch, set_lake=0._r8, default='inactive')
-
- this%liqcan_patch(begp:endp) = spval
- call hist_addfld1d (fname='LIQCAN', units='mm', &
- avgflag='A', long_name='intercepted liquid water', &
- ptr_patch=this%liqcan_patch, set_lake=0._r8, default='inactive')
-
- this%snounload_patch(begp:endp) = spval
- call hist_addfld1d (fname='SNOUNLOAD', units='mm', &
- avgflag='A', long_name='Canopy snow unloading', &
- ptr_patch=this%snounload_patch, set_lake=0._r8, default='inactive')
-
- call hist_addfld1d (fname='H2OSNO', units='mm', &
- avgflag='A', long_name='snow depth (liquid water)', &
- ptr_col=this%h2osno_col, c2l_scale_type='urbanf', default='inactive')
-
- call hist_addfld1d (fname='H2OSNO_ICE', units='mm', &
- avgflag='A', long_name='snow depth (liquid water, ice landunits only)', &
- ptr_col=this%h2osno_col, c2l_scale_type='urbanf', l2g_scale_type='ice', &
- default='inactive')
-
- this%liq1_grc(begg:endg) = spval
- call hist_addfld1d (fname='LIQUID_CONTENT1', units='mm', &
- avgflag='A', long_name='initial gridcell total liq content', &
- ptr_lnd=this%liq1_grc, default='inactive')
-
- this%liq2_grc(begg:endg) = spval
- call hist_addfld1d (fname='LIQUID_CONTENT2', units='mm', &
- avgflag='A', long_name='post landuse change gridcell total liq content', &
- ptr_lnd=this%liq2_grc, default='inactive')
-
- this%ice1_grc(begg:endg) = spval
- call hist_addfld1d (fname='ICE_CONTENT1', units='mm', &
- avgflag='A', long_name='initial gridcell total ice content', &
- ptr_lnd=this%ice1_grc, default='inactive')
-
- this%ice2_grc(begg:endg) = spval
- call hist_addfld1d (fname='ICE_CONTENT2', units='mm', &
- avgflag='A', long_name='post land cover change total ice content', &
- ptr_lnd=this%ice2_grc, default='inactive')
-
- this%h2osfc_col(begc:endc) = spval
- call hist_addfld1d (fname='H2OSFC', units='mm', &
- avgflag='A', long_name='surface water depth', &
- ptr_col=this%h2osfc_col, default='inactive')
-
- this%tws_grc(begg:endg) = spval
- call hist_addfld1d (fname='TWS', units='mm', &
- avgflag='A', long_name='total water storage', &
- ptr_lnd=this%tws_grc, default='inactive')
-
- ! (rgk 02-02-2017) There is intentionally no entry here for stored plant water
- ! I think that since the value is zero in all cases except
- ! for FATES plant hydraulics, it will be confusing for users
- ! when they see their plants have no water in output files.
- ! So it is not useful diagnostic information. The information
- ! can be provided through FATES specific history diagnostics
- ! if need be.
-
- ! Humidity
-
- this%q_ref2m_patch(begp:endp) = spval
- call hist_addfld1d (fname='Q2M', units='kg/kg', &
- avgflag='A', long_name='2m specific humidity', &
- ptr_patch=this%q_ref2m_patch, default='inactive')
-
- this%rh_ref2m_patch(begp:endp) = spval
- call hist_addfld1d (fname='RH2M', units='%', &
- avgflag='A', long_name='2m relative humidity', &
- ptr_patch=this%rh_ref2m_patch, default='inactive')
-
- this%rh_ref2m_r_patch(begp:endp) = spval
- call hist_addfld1d (fname='RH2M_R', units='%', &
- avgflag='A', long_name='Rural 2m specific humidity', &
- ptr_patch=this%rh_ref2m_r_patch, set_spec=spval, default='inactive')
-
- this%rh_ref2m_u_patch(begp:endp) = spval
- call hist_addfld1d (fname='RH2M_U', units='%', &
- avgflag='A', long_name='Urban 2m relative humidity', &
- ptr_patch=this%rh_ref2m_u_patch, set_nourb=spval, default='inactive')
-
- this%rh_af_patch(begp:endp) = spval
- call hist_addfld1d (fname='RHAF', units='fraction', &
- avgflag='A', long_name='fractional humidity of canopy air', &
- ptr_patch=this%rh_af_patch, set_spec=spval, default='inactive')
-
- if(use_luna)then
- call hist_addfld1d (fname='RHAF10', units='fraction', &
- avgflag='A', long_name='10 day running mean of fractional humidity of canopy air', &
- ptr_patch=this%rh10_af_patch, set_spec=spval, default='inactive')
- endif
-
- ! Fractions
-
- this%frac_h2osfc_col(begc:endc) = spval
- call hist_addfld1d (fname='FH2OSFC', units='unitless', &
- avgflag='A', long_name='fraction of ground covered by surface water', &
- ptr_col=this%frac_h2osfc_col, default='inactive')
-
- this%frac_h2osfc_nosnow_col(begc:endc) = spval
- call hist_addfld1d (fname='FH2OSFC_NOSNOW', units='unitless', &
- avgflag='A', &
- long_name='fraction of ground covered by surface water (if no snow present)', &
- ptr_col=this%frac_h2osfc_nosnow_col, default='inactive')
-
- this%frac_sno_col(begc:endc) = spval
- call hist_addfld1d (fname='FSNO', units='unitless', &
- avgflag='A', long_name='fraction of ground covered by snow', &
- ptr_col=this%frac_sno_col, c2l_scale_type='urbanf', default='inactive')
-
- this%frac_sno_eff_col(begc:endc) = spval
- call hist_addfld1d (fname='FSNO_EFF', units='unitless', &
- avgflag='A', long_name='effective fraction of ground covered by snow', &
- ptr_col=this%frac_sno_eff_col, c2l_scale_type='urbanf', default='inactive')
-
- if (use_cn) then
- this%fwet_patch(begp:endp) = spval
- call hist_addfld1d (fname='FWET', units='proportion', &
- avgflag='A', long_name='fraction of canopy that is wet', &
- ptr_patch=this%fwet_patch, default='inactive')
- end if
-
- if (use_cn) then
- this%fcansno_patch(begp:endp) = spval
- call hist_addfld1d (fname='FCANSNO', units='proportion', &
- avgflag='A', long_name='fraction of canopy that is wet', &
- ptr_patch=this%fcansno_patch, default='inactive')
- end if
-
- if (use_cn) then
- this%fdry_patch(begp:endp) = spval
- call hist_addfld1d (fname='FDRY', units='proportion', &
- avgflag='A', long_name='fraction of foliage that is green and dry', &
- ptr_patch=this%fdry_patch, default='inactive')
- end if
-
- if (use_cn)then
- this%frac_iceold_col(begc:endc,:) = spval
- call hist_addfld2d (fname='FRAC_ICEOLD', units='proportion', type2d='levgrnd', &
- avgflag='A', long_name='fraction of ice relative to the tot water', &
- ptr_col=this%frac_iceold_col, default='inactive')
- end if
-
- ! Snow properties - these will be vertically averaged over the snow profile
-
- this%snow_depth_col(begc:endc) = spval
- call hist_addfld1d (fname='SNOW_DEPTH', units='m', &
- avgflag='A', long_name='snow height of snow covered area', &
- ptr_col=this%snow_depth_col, c2l_scale_type='urbanf', default='inactive')
-
- call hist_addfld1d (fname='SNOW_DEPTH_ICE', units='m', &
- avgflag='A', long_name='snow height of snow covered area (ice landunits only)', &
- ptr_col=this%snow_depth_col, c2l_scale_type='urbanf', l2g_scale_type='ice', &
- default='inactive')
-
- this%snowdp_col(begc:endc) = spval
- call hist_addfld1d (fname='SNOWDP', units='m', &
- avgflag='A', long_name='gridcell mean snow height', &
- ptr_col=this%snowdp_col, c2l_scale_type='urbanf', default='inactive')
-
- this%snowliq_col(begc:endc) = spval
- call hist_addfld1d (fname='SNOWLIQ', units='kg/m2', &
- avgflag='A', long_name='snow liquid water', &
- ptr_col=this%snowliq_col, default='inactive')
-
- this%snowice_col(begc:endc) = spval
- call hist_addfld1d (fname='SNOWICE', units='kg/m2', &
- avgflag='A', long_name='snow ice', &
- ptr_col=this%snowice_col, default='inactive')
-
- this%int_snow_col(begc:endc) = spval
- call hist_addfld1d (fname='INT_SNOW', units='mm', &
- avgflag='A', long_name='accumulated swe (vegetated landunits only)', &
- ptr_col=this%int_snow_col, l2g_scale_type='veg', &
- default='inactive')
-
- call hist_addfld1d (fname='INT_SNOW_ICE', units='mm', &
- avgflag='A', long_name='accumulated swe (ice landunits only)', &
- ptr_col=this%int_snow_col, l2g_scale_type='ice', &
- default='inactive')
-
- this%snow_persistence_col(begc:endc) = spval
- call hist_addfld1d (fname='SNOW_PERSISTENCE', units='seconds', &
- avgflag='I', long_name='Length of time of continuous snow cover (nat. veg. landunits only)', &
- ptr_col=this%snow_persistence_col, l2g_scale_type='natveg', default='inactive')
-
- if (use_cn) then
- this%wf_col(begc:endc) = spval
- call hist_addfld1d (fname='WF', units='proportion', &
- avgflag='A', long_name='soil water as frac. of whc for top 0.05 m', &
- ptr_col=this%wf_col, default='inactive')
- end if
-
- this%h2osno_top_col(begc:endc) = spval
- call hist_addfld1d (fname='H2OSNO_TOP', units='kg/m2', &
- avgflag='A', long_name='mass of snow in top snow layer', &
- ptr_col=this%h2osno_top_col, set_urb=spval, default='inactive')
-
- this%snw_rds_top_col(begc:endc) = spval
- call hist_addfld1d (fname='SNORDSL', units='m^-6', &
- avgflag='A', long_name='top snow layer effective grain radius', &
- ptr_col=this%snw_rds_top_col, set_urb=spval, default='inactive')
-
- this%sno_liq_top_col(begc:endc) = spval
- call hist_addfld1d (fname='SNOLIQFL', units='fraction', &
- avgflag='A', long_name='top snow layer liquid water fraction (land)', &
- ptr_col=this%sno_liq_top_col, set_urb=spval, default='inactive')
-
- ! We determine the fractional time (and fraction of the grid cell) over which each
- ! snow layer existed by running the snow averaging routine on a field whose value is 1
- ! everywhere
- data2dptr => this%snow_layer_unity_col(:,-nlevsno+1:0)
- call hist_addfld2d (fname='SNO_EXISTENCE', units='unitless', type2d='levsno', &
- avgflag='A', long_name='Fraction of averaging period for which each snow layer existed', &
- ptr_col=data2dptr, no_snow_behavior=no_snow_zero, default='inactive')
-
- this%bw_col(begc:endc,-nlevsno+1:0) = spval
- data2dptr => this%bw_col(:,-nlevsno+1:0)
- call hist_addfld2d (fname='SNO_BW', units='kg/m3', type2d='levsno', &
- avgflag='A', long_name='Partial density of water in the snow pack (ice + liquid)', &
- ptr_col=data2dptr, no_snow_behavior=no_snow_normal, default='inactive')
-
- call hist_addfld2d (fname='SNO_BW_ICE', units='kg/m3', type2d='levsno', &
- avgflag='A', long_name='Partial density of water in the snow pack (ice + liquid, ice landunits only)', &
- ptr_col=data2dptr, no_snow_behavior=no_snow_normal, &
- l2g_scale_type='ice', default='inactive')
-
- this%snw_rds_col(begc:endc,-nlevsno+1:0) = spval
- data2dptr => this%snw_rds_col(:,-nlevsno+1:0)
- call hist_addfld2d (fname='SNO_GS', units='Microns', type2d='levsno', &
- avgflag='A', long_name='Mean snow grain size', &
- ptr_col=data2dptr, no_snow_behavior=no_snow_normal, default='inactive')
-
- call hist_addfld2d (fname='SNO_GS_ICE', units='Microns', type2d='levsno', &
- avgflag='A', long_name='Mean snow grain size (ice landunits only)', &
- ptr_col=data2dptr, no_snow_behavior=no_snow_normal, &
- l2g_scale_type='ice', default='inactive')
-
- this%errh2o_col(begc:endc) = spval
- call hist_addfld1d (fname='ERRH2O', units='mm', &
- avgflag='A', long_name='total water conservation error', &
- ptr_col=this%errh2o_col, default='inactive')
-
- this%errh2osno_col(begc:endc) = spval
- call hist_addfld1d (fname='ERRH2OSNO', units='mm', &
- avgflag='A', long_name='imbalance in snow depth (liquid water)', &
- ptr_col=this%errh2osno_col, c2l_scale_type='urbanf', default='inactive')
-
- end subroutine InitHistory
-
- !-----------------------------------------------------------------------
- subroutine InitCold(this, bounds, &
- h2osno_input_col, snow_depth_input_col, watsat_col, t_soisno_col)
- !
- ! !DESCRIPTION:
- ! Initialize time constant variables and cold start conditions
- !
- ! !USES:
- use shr_const_mod , only : shr_const_pi
- use shr_log_mod , only : errMsg => shr_log_errMsg
- use shr_spfn_mod , only : shr_spfn_erf
- use shr_kind_mod , only : r8 => shr_kind_r8
- use shr_const_mod , only : SHR_CONST_TKFRZ
- use clm_varpar , only : nlevsoi, nlevgrnd, nlevsno, nlevlak, nlevurb
- use landunit_varcon , only : istwet, istsoil, istdlak, istcrop, istice_mec
- use column_varcon , only : icol_shadewall, icol_road_perv
- use column_varcon , only : icol_road_imperv, icol_roof, icol_sunwall
- use clm_varcon , only : denice, denh2o, spval, sb, bdsno
- use clm_varcon , only : zlnd, tfrz, spval, pc
- use clm_varctl , only : fsurdat, iulog
- use clm_varctl , only : use_bedrock
- use spmdMod , only : masterproc
- use abortutils , only : endrun
- use fileutils , only : getfil
- use ncdio_pio , only : file_desc_t, ncd_io
- !
- ! !ARGUMENTS:
- class(waterstate_type) :: this
- type(bounds_type) , intent(in) :: bounds
- real(r8) , intent(in) :: h2osno_input_col(bounds%begc:)
- real(r8) , intent(in) :: snow_depth_input_col(bounds%begc:)
- real(r8) , intent(in) :: watsat_col(bounds%begc:, 1:) ! volumetric soil water at saturation (porosity)
- real(r8) , intent(in) :: t_soisno_col(bounds%begc:, -nlevsno+1:) ! col soil temperature (Kelvin)
- !
- ! !LOCAL VARIABLES:
- integer :: p,c,j,l,g,lev,nlevs
- real(r8) :: maxslope, slopemax, minslope
- real(r8) :: d, fd, dfdd, slope0,slopebeta
- real(r8) ,pointer :: std (:)
- logical :: readvar
- type(file_desc_t) :: ncid
- character(len=256) :: locfn
- real(r8) :: snowbd ! temporary calculation of snow bulk density (kg/m3)
- real(r8) :: fmelt ! snowbd/100
- integer :: nbedrock
- !-----------------------------------------------------------------------
-
- SHR_ASSERT_ALL((ubound(h2osno_input_col) == (/bounds%endc/)) , errMsg(sourcefile, __LINE__))
- SHR_ASSERT_ALL((ubound(snow_depth_input_col) == (/bounds%endc/)) , errMsg(sourcefile, __LINE__))
- SHR_ASSERT_ALL((ubound(watsat_col) == (/bounds%endc,nlevgrnd/)) , errMsg(sourcefile, __LINE__))
- SHR_ASSERT_ALL((ubound(t_soisno_col) == (/bounds%endc,nlevgrnd/)) , errMsg(sourcefile, __LINE__))
-
- ! The first three arrays are initialized from the input argument
- do c = bounds%begc,bounds%endc
- this%h2osno_col(c) = h2osno_input_col(c)
- this%int_snow_col(c) = h2osno_input_col(c)
- this%snow_depth_col(c) = snow_depth_input_col(c)
- this%snow_persistence_col(c) = 0._r8
- this%snow_layer_unity_col(c,:) = 1._r8
- end do
-
- do c = bounds%begc,bounds%endc
- this%wf_col(c) = spval
- this%wf2_col(c) = spval
- end do
-
- do l = bounds%begl, bounds%endl
- if (lun%urbpoi(l)) then
- if (use_vancouver) then
- this%qaf_lun(l) = 0.0111_r8
- else if (use_mexicocity) then
- this%qaf_lun(l) = 0.00248_r8
- else
- this%qaf_lun(l) = 1.e-4_r8 ! Arbitrary set since forc_q is not yet available
- end if
- end if
- end do
-
- ! Water Stored in plants is almost always a static entity, with the exception
- ! of when FATES-hydraulics is used. As such, this is trivially set to 0.0 (rgk 03-2017)
- this%total_plant_stored_h2o_col(bounds%begc:bounds%endc) = 0.0_r8
-
-
- associate(snl => col%snl)
-
- this%h2osfc_col(bounds%begc:bounds%endc) = 0._r8
- this%h2ocan_patch(bounds%begp:bounds%endp) = 0._r8
- this%snocan_patch(bounds%begp:bounds%endp) = 0._r8
- this%liqcan_patch(bounds%begp:bounds%endp) = 0._r8
- this%snounload_patch(bounds%begp:bounds%endp) = 0._r8
- this%frac_h2osfc_col(bounds%begc:bounds%endc) = 0._r8
-
- this%fwet_patch(bounds%begp:bounds%endp) = 0._r8
- this%fdry_patch(bounds%begp:bounds%endp) = 0._r8
- this%fcansno_patch(bounds%begp:bounds%endp) = 0._r8
- !--------------------------------------------
- ! Set snow water
- !--------------------------------------------
-
- ! Note: Glacier_mec columns are initialized with half the maximum snow cover.
- ! This gives more realistic values of qflx_glcice sooner in the simulation
- ! for columns with net ablation, at the cost of delaying ice formation
- ! in columns with net accumulation.
-
- do c = bounds%begc, bounds%endc
- l = col%landunit(c)
- if (lun%urbpoi(l)) then
- ! From Bonan 1996 (LSM technical note)
- this%frac_sno_col(c) = min( this%snow_depth_col(c)/0.05_r8, 1._r8)
- else
- this%frac_sno_col(c) = 0._r8
- ! snow cover fraction as in Niu and Yang 2007
- if(this%snow_depth_col(c) > 0.0) then
- snowbd = min(400._r8, this%h2osno_col(c)/this%snow_depth_col(c)) !bulk density of snow (kg/m3)
- fmelt = (snowbd/100.)**1.
- ! 100 is the assumed fresh snow density; 1 is a melting factor that could be
- ! reconsidered, optimal value of 1.5 in Niu et al., 2007
- this%frac_sno_col(c) = tanh( this%snow_depth_col(c) /(2.5 * zlnd * fmelt) )
- endif
- end if
- end do
-
- do c = bounds%begc,bounds%endc
- if (snl(c) < 0) then
- this%snw_rds_col(c,snl(c)+1:0) = snw_rds_min
- this%snw_rds_col(c,-nlevsno+1:snl(c)) = 0._r8
- this%snw_rds_top_col(c) = snw_rds_min
- elseif (this%h2osno_col(c) > 0._r8) then
- this%snw_rds_col(c,0) = snw_rds_min
- this%snw_rds_col(c,-nlevsno+1:-1) = 0._r8
- this%snw_rds_top_col(c) = spval
- this%sno_liq_top_col(c) = spval
- else
- this%snw_rds_col(c,:) = 0._r8
- this%snw_rds_top_col(c) = spval
- this%sno_liq_top_col(c) = spval
- endif
- end do
-
- !--------------------------------------------
- ! Set soil water
- !--------------------------------------------
-
- ! volumetric water is set first and liquid content and ice lens are obtained
- ! NOTE: h2osoi_vol, h2osoi_liq and h2osoi_ice only have valid values over soil
- ! and urban pervious road (other urban columns have zero soil water)
-
- this%h2osoi_vol_col(bounds%begc:bounds%endc, 1:) = spval
- this%h2osoi_liq_col(bounds%begc:bounds%endc,-nlevsno+1:) = spval
- this%h2osoi_ice_col(bounds%begc:bounds%endc,-nlevsno+1:) = spval
- do c = bounds%begc,bounds%endc
- l = col%landunit(c)
- if (.not. lun%lakpoi(l)) then !not lake
-
- ! volumetric water
- if (lun%itype(l) == istsoil .or. lun%itype(l) == istcrop) then
- nlevs = nlevgrnd
- do j = 1, nlevs
- if (use_bedrock) then
- nbedrock = col%nbedrock(c)
- else
- nbedrock = nlevsoi
- endif
- if (j > nbedrock) then
- this%h2osoi_vol_col(c,j) = 0.0_r8
- else
- this%h2osoi_vol_col(c,j) = 0.15_r8
- endif
- end do
- else if (lun%urbpoi(l)) then
- if (col%itype(c) == icol_road_perv) then
- nlevs = nlevgrnd
- do j = 1, nlevs
- if (j <= nlevsoi) then
- this%h2osoi_vol_col(c,j) = 0.3_r8
- else
- this%h2osoi_vol_col(c,j) = 0.0_r8
- end if
- end do
- else if (col%itype(c) == icol_road_imperv) then
- nlevs = nlevgrnd
- do j = 1, nlevs
- this%h2osoi_vol_col(c,j) = 0.0_r8
- end do
- else
- nlevs = nlevurb
- do j = 1, nlevs
- this%h2osoi_vol_col(c,j) = 0.0_r8
- end do
- end if
- else if (lun%itype(l) == istwet) then
- nlevs = nlevgrnd
- do j = 1, nlevs
- if (j > nlevsoi) then
- this%h2osoi_vol_col(c,j) = 0.0_r8
- else
- this%h2osoi_vol_col(c,j) = 1.0_r8
- endif
- end do
- else if (lun%itype(l) == istice_mec) then
- nlevs = nlevgrnd
- do j = 1, nlevs
- this%h2osoi_vol_col(c,j) = 1.0_r8
- end do
- endif
- do j = 1, nlevs
- this%h2osoi_vol_col(c,j) = min(this%h2osoi_vol_col(c,j), watsat_col(c,j))
- if (t_soisno_col(c,j) <= SHR_CONST_TKFRZ) then
- this%h2osoi_ice_col(c,j) = col%dz(c,j)*denice*this%h2osoi_vol_col(c,j)
- this%h2osoi_liq_col(c,j) = 0._r8
- else
- this%h2osoi_ice_col(c,j) = 0._r8
- this%h2osoi_liq_col(c,j) = col%dz(c,j)*denh2o*this%h2osoi_vol_col(c,j)
- endif
- end do
- do j = -nlevsno+1, 0
- if (j > snl(c)) then
- this%h2osoi_ice_col(c,j) = col%dz(c,j)*250._r8
- this%h2osoi_liq_col(c,j) = 0._r8
- end if
- end do
- end if
- end do
-
-
- !--------------------------------------------
- ! Set Lake water
- !--------------------------------------------
-
- do c = bounds%begc, bounds%endc
- l = col%landunit(c)
-
- if (lun%lakpoi(l)) then
- do j = -nlevsno+1, 0
- if (j > snl(c)) then
- this%h2osoi_ice_col(c,j) = col%dz(c,j)*bdsno
- this%h2osoi_liq_col(c,j) = 0._r8
- end if
- end do
- do j = 1,nlevgrnd
- if (j <= nlevsoi) then ! soil
- this%h2osoi_vol_col(c,j) = watsat_col(c,j)
- this%h2osoi_liq_col(c,j) = spval
- this%h2osoi_ice_col(c,j) = spval
- else ! bedrock
- this%h2osoi_vol_col(c,j) = 0._r8
- end if
- end do
- end if
- end do
-
- !--------------------------------------------
- ! For frozen layers !TODO - does the following make sense ???? it seems to overwrite everything
- !--------------------------------------------
-
- do c = bounds%begc, bounds%endc
- do j = 1,nlevgrnd
- if (this%h2osoi_vol_col(c,j) /= spval) then
- if (t_soisno_col(c,j) <= tfrz) then
- this%h2osoi_ice_col(c,j) = col%dz(c,j)*denice*this%h2osoi_vol_col(c,j)
- this%h2osoi_liq_col(c,j) = 0._r8
- else
- this%h2osoi_ice_col(c,j) = 0._r8
- this%h2osoi_liq_col(c,j) = col%dz(c,j)*denh2o*this%h2osoi_vol_col(c,j)
- endif
- end if
- end do
- end do
-
- end associate
-
- end subroutine InitCold
-
- !------------------------------------------------------------------------
- subroutine Restart(this, bounds, ncid, flag, &
- watsat_col)
- !
- ! !DESCRIPTION:
- ! Read/Write module information to/from restart file.
- !
- ! !USES:
- use spmdMod , only : masterproc
- use clm_varcon , only : denice, denh2o, pondmx, watmin, spval, nameg
- use landunit_varcon , only : istcrop, istdlak, istsoil
- use column_varcon , only : icol_roof, icol_sunwall, icol_shadewall
- use clm_time_manager , only : is_first_step
- use clm_varctl , only : bound_h2osoi
- use ncdio_pio , only : file_desc_t, ncd_io, ncd_double
- use restUtilMod
- !
- ! !ARGUMENTS:
- class(waterstate_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'
- real(r8) , intent(in) :: watsat_col (bounds%begc:, 1:) ! volumetric soil water at saturation (porosity)
- !
- ! !LOCAL VARIABLES:
- integer :: c,l,j,nlevs
- logical :: readvar
- real(r8) :: maxwatsat ! maximum porosity
- real(r8) :: excess ! excess volumetric soil water
- real(r8) :: totwat ! total soil water (mm)
- !------------------------------------------------------------------------
-
- SHR_ASSERT_ALL((ubound(watsat_col) == (/bounds%endc,nlevgrnd/)) , errMsg(sourcefile, __LINE__))
-
- call restartvar(ncid=ncid, flag=flag, varname='INT_SNOW', xtype=ncd_double, &
- dim1name='column', &
- long_name='accuumulated snow', units='mm', &
- interpinic_flag='interp', readvar=readvar, data=this%int_snow_col)
- if (flag=='read' .and. .not. readvar) then
- this%int_snow_col(:) = 0.0_r8
- end if
-
- call restartvar(ncid=ncid, flag=flag, varname='H2OSFC', xtype=ncd_double, &
- dim1name='column', &
- long_name='surface water', units='kg/m2', &
- interpinic_flag='interp', readvar=readvar, data=this%h2osfc_col)
- if (flag=='read' .and. .not. readvar) then
- this%h2osfc_col(bounds%begc:bounds%endc) = 0.0_r8
- end if
-
- call restartvar(ncid=ncid, flag=flag, varname='H2OSNO', xtype=ncd_double, &
- dim1name='column', &
- long_name='snow water', units='kg/m2', &
- interpinic_flag='interp', readvar=readvar, data=this%h2osno_col)
-
- call restartvar(ncid=ncid, flag=flag, varname='H2OSOI_LIQ', xtype=ncd_double, &
- dim1name='column', dim2name='levtot', switchdim=.true., &
- long_name='liquid water', units='kg/m2', &
- interpinic_flag='interp', readvar=readvar, data=this%h2osoi_liq_col)
-
- call restartvar(ncid=ncid, flag=flag, varname='H2OSOI_ICE', xtype=ncd_double, &
- dim1name='column', dim2name='levtot', switchdim=.true., &
- long_name='ice lens', units='kg/m2', &
- interpinic_flag='interp', readvar=readvar, data=this%h2osoi_ice_col)
-
- call restartvar(ncid=ncid, flag=flag, varname='H2OCAN', xtype=ncd_double, &
- dim1name='pft', &
- long_name='canopy water', units='kg/m2', &
- interpinic_flag='interp', readvar=readvar, data=this%h2ocan_patch)
-
- call restartvar(ncid=ncid, flag=flag, varname='SNOCAN', xtype=ncd_double, &
- dim1name='pft', &
- long_name='canopy snow water', units='kg/m2', &
- interpinic_flag='interp', readvar=readvar, data=this%snocan_patch)
-
- ! NOTE(wjs, 2015-07-01) In old restart files, there was no LIQCAN variable. However,
- ! H2OCAN had similar meaning. So if we can't find LIQCAN, use H2OCAN to initialize
- ! liqcan_patch.
- call restartvar(ncid=ncid, flag=flag, varname='LIQCAN:H2OCAN', xtype=ncd_double, &
- dim1name='pft', &
- long_name='canopy liquid water', units='kg/m2', &
- interpinic_flag='interp', readvar=readvar, data=this%liqcan_patch)
-
- call restartvar(ncid=ncid, flag=flag, varname='SNOUNLOAD', xtype=ncd_double, &
- dim1name='pft', &
- long_name='Canopy snow unloading', units='kg/m2', &
- interpinic_flag='interp', readvar=readvar, data=this%snounload_patch)
-
- ! TWS is needed when methane is on and the TWS_inversion is used to get exact
- ! restart.
- call restartvar(ncid=ncid, flag=flag, varname='TWS', xtype=ncd_double, &
- dim1name=nameg, &
- long_name='Total Water Storage', units='mm', &
- interpinic_flag='interp', readvar=readvar, data=this%tws_grc)
-
- if(use_luna)then
- call restartvar(ncid=ncid, flag=flag, varname='rh10', xtype=ncd_double, &
- dim1name='pft', long_name='10-day mean boundary layer relatie humidity', units='unitless', &
- interpinic_flag='interp', readvar=readvar, data=this%rh10_af_patch)
- endif
-
- ! Determine volumetric soil water (for read only)
- if (flag == 'read' ) then
- do c = bounds%begc, bounds%endc
- l = col%landunit(c)
- if ( col%itype(c) == icol_sunwall .or. &
- col%itype(c) == icol_shadewall .or. &
- col%itype(c) == icol_roof )then
- nlevs = nlevurb
- else
- nlevs = nlevgrnd
- end if
- if ( lun%itype(l) /= istdlak ) then ! This calculation is now done for lakes in initLake.
- do j = 1,nlevs
- this%h2osoi_vol_col(c,j) = this%h2osoi_liq_col(c,j)/(col%dz(c,j)*denh2o) &
- + this%h2osoi_ice_col(c,j)/(col%dz(c,j)*denice)
- end do
- end if
- end do
- end if
-
- ! If initial run -- ensure that water is properly bounded (read only)
- if (flag == 'read' ) then
- if ( is_first_step() .and. bound_h2osoi) then
- do c = bounds%begc, bounds%endc
- l = col%landunit(c)
- if ( col%itype(c) == icol_sunwall .or. col%itype(c) == icol_shadewall .or. &
- col%itype(c) == icol_roof )then
- nlevs = nlevurb
- else
- nlevs = nlevgrnd
- end if
- do j = 1,nlevs
- l = col%landunit(c)
- if (lun%itype(l) == istsoil .or. lun%itype(l) == istcrop) then
- this%h2osoi_liq_col(c,j) = max(0._r8,this%h2osoi_liq_col(c,j))
- this%h2osoi_ice_col(c,j) = max(0._r8,this%h2osoi_ice_col(c,j))
- this%h2osoi_vol_col(c,j) = this%h2osoi_liq_col(c,j)/(col%dz(c,j)*denh2o) &
- + this%h2osoi_ice_col(c,j)/(col%dz(c,j)*denice)
- if (j == 1) then
- maxwatsat = (watsat_col(c,j)*col%dz(c,j)*1000.0_r8 + pondmx) / (col%dz(c,j)*1000.0_r8)
- else
- maxwatsat = watsat_col(c,j)
- end if
- if (this%h2osoi_vol_col(c,j) > maxwatsat) then
- excess = (this%h2osoi_vol_col(c,j) - maxwatsat)*col%dz(c,j)*1000.0_r8
- totwat = this%h2osoi_liq_col(c,j) + this%h2osoi_ice_col(c,j)
- this%h2osoi_liq_col(c,j) = this%h2osoi_liq_col(c,j) - &
- (this%h2osoi_liq_col(c,j)/totwat) * excess
- this%h2osoi_ice_col(c,j) = this%h2osoi_ice_col(c,j) - &
- (this%h2osoi_ice_col(c,j)/totwat) * excess
- end if
- this%h2osoi_liq_col(c,j) = max(watmin,this%h2osoi_liq_col(c,j))
- this%h2osoi_ice_col(c,j) = max(watmin,this%h2osoi_ice_col(c,j))
- this%h2osoi_vol_col(c,j) = this%h2osoi_liq_col(c,j)/(col%dz(c,j)*denh2o) &
- + this%h2osoi_ice_col(c,j)/(col%dz(c,j)*denice)
- end if
- end do
- end do
- end if
-
- endif ! end if if-read flag
-
- call restartvar(ncid=ncid, flag=flag, varname='FH2OSFC', xtype=ncd_double, &
- dim1name='column',&
- long_name='fraction of ground covered by h2osfc (0 to 1)', units='', &
- interpinic_flag='interp', readvar=readvar, data=this%frac_h2osfc_col)
- if (flag == 'read' .and. .not. readvar) then
- this%frac_h2osfc_col(bounds%begc:bounds%endc) = 0.0_r8
- end if
-
- call restartvar(ncid=ncid, flag=flag, varname='SNOW_DEPTH', xtype=ncd_double, &
- dim1name='column', &
- long_name='snow depth', units='m', &
- interpinic_flag='interp', readvar=readvar, data=this%snow_depth_col)
-
- call restartvar(ncid=ncid, flag=flag, varname='SNOW_PERS', xtype=ncd_double, &
- dim1name='column', &
- long_name='continuous snow cover time', units='sec', &
- interpinic_flag='interp', readvar=readvar, data=this%snow_persistence_col)
- if (flag=='read' .and. .not. readvar) then
- this%snow_persistence_col(:) = 0.0_r8
- end if
-
- call restartvar(ncid=ncid, flag=flag, varname='frac_sno_eff', xtype=ncd_double, &
- dim1name='column', &
- long_name='fraction of ground covered by snow (0 to 1)',units='unitless', &
- interpinic_flag='interp', readvar=readvar, data=this%frac_sno_eff_col)
- if (flag == 'read' .and. .not. readvar) then
- this%frac_sno_eff_col(bounds%begc:bounds%endc) = 0.0_r8
- end if
-
- call restartvar(ncid=ncid, flag=flag, varname='frac_sno', xtype=ncd_double, &
- dim1name='column', &
- long_name='fraction of ground covered by snow (0 to 1)',units='unitless',&
- interpinic_flag='interp', readvar=readvar, data=this%frac_sno_col)
-
- call restartvar(ncid=ncid, flag=flag, varname='FWET', xtype=ncd_double, &
- dim1name='pft', &
- long_name='fraction of canopy that is wet (0 to 1)', units='', &
- interpinic_flag='interp', readvar=readvar, data=this%fwet_patch)
-
- call restartvar(ncid=ncid, flag=flag, varname='FCANSNO', xtype=ncd_double, &
- dim1name='pft', &
- long_name='fraction of canopy that is snow covered (0 to 1)', units='', &
- interpinic_flag='interp', readvar=readvar, data=this%fcansno_patch)
-
- ! column type physical state variable - snw_rds
- call restartvar(ncid=ncid, flag=flag, varname='snw_rds', xtype=ncd_double, &
- dim1name='column', dim2name='levsno', switchdim=.true., lowerb2=-nlevsno+1, upperb2=0, &
- long_name='snow layer effective radius', units='um', &
- interpinic_flag='interp', readvar=readvar, data=this%snw_rds_col)
- if (flag == 'read' .and. .not. readvar) then
-
- ! initial run, not restart: initialize snw_rds
- if (masterproc) then
- write(iulog,*) "SNICAR: This is an initial run (not a restart), and grain size/aerosol " // &
- "mass data are not defined in initial condition file. Initialize snow " // &
- "effective radius to fresh snow value, and snow/aerosol masses to zero."
- endif
-
- do c= bounds%begc, bounds%endc
- if (col%snl(c) < 0) then
- this%snw_rds_col(c,col%snl(c)+1:0) = snw_rds_min
- this%snw_rds_col(c,-nlevsno+1:col%snl(c)) = 0._r8
- this%snw_rds_top_col(c) = snw_rds_min
- this%sno_liq_top_col(c) = this%h2osoi_liq_col(c,col%snl(c)+1) / &
- (this%h2osoi_liq_col(c,col%snl(c)+1)+this%h2osoi_ice_col(c,col%snl(c)+1))
- elseif (this%h2osno_col(c) > 0._r8) then
- this%snw_rds_col(c,0) = snw_rds_min
- this%snw_rds_col(c,-nlevsno+1:-1) = 0._r8
- this%snw_rds_top_col(c) = spval
- this%sno_liq_top_col(c) = spval
- else
- this%snw_rds_col(c,:) = 0._r8
- this%snw_rds_top_col(c) = spval
- this%sno_liq_top_col(c) = spval
- endif
- enddo
- endif
-
- call restartvar(ncid=ncid, flag=flag, varname='qaf', xtype=ncd_double, dim1name='landunit', &
- long_name='urban canopy specific humidity', units='kg/kg', &
- interpinic_flag='interp', readvar=readvar, data=this%qaf_lun)
-
- if (use_cn) then
- call restartvar(ncid=ncid, flag=flag, varname='wf', xtype=ncd_double, &
- dim1name='column', &
- long_name='', units='', &
- interpinic_flag='interp', readvar=readvar, data=this%wf_col)
- end if
-
-
-
- end subroutine Restart
-
- !-----------------------------------------------------------------------
- subroutine Reset(this, column)
- !
- ! !DESCRIPTION:
- ! Intitialize SNICAR variables for fresh snow column
- !
- ! !ARGUMENTS:
- class(waterstate_type) :: this
- integer , intent(in) :: column ! column index
- !-----------------------------------------------------------------------
-
- this%snw_rds_col(column,0) = snw_rds_min
-
- end subroutine Reset
-
-end module WaterstateType
diff --git a/src/biogeophys/WaterfluxType.F90 b/src/biogeophys/WaterfluxType.F90
deleted file mode 100644
index 5541ab39..00000000
--- a/src/biogeophys/WaterfluxType.F90
+++ /dev/null
@@ -1,721 +0,0 @@
-module WaterfluxType
-
- !------------------------------------------------------------------------------
- ! !DESCRIPTION:
- !
- ! !USES:
- use shr_kind_mod , only: r8 => shr_kind_r8
- use shr_infnan_mod , only : nan => shr_infnan_nan, assignment(=)
- use clm_varpar , only : nlevsno, nlevsoi
- use clm_varcon , only : spval
- use decompMod , only : bounds_type
- use LandunitType , only : lun
- use ColumnType , only : col
- use PatchType , only : patch
- use CNSharedParamsMod , only : use_fun
- !
- implicit none
- private
- !
- ! !PUBLIC TYPES:
- type, public :: waterflux_type
-
- ! water fluxes are in units or mm/s
-
- real(r8), pointer :: qflx_prec_grnd_patch (:) ! patch water onto ground including canopy runoff [kg/(m2 s)]
- real(r8), pointer :: qflx_prec_grnd_col (:) ! col water onto ground including canopy runoff [kg/(m2 s)]
- real(r8), pointer :: qflx_rain_grnd_patch (:) ! patch rain on ground after interception (mm H2O/s) [+]
- real(r8), pointer :: qflx_rain_grnd_col (:) ! col rain on ground after interception (mm H2O/s) [+]
- real(r8), pointer :: qflx_snow_grnd_patch (:) ! patch snow on ground after interception (mm H2O/s) [+]
- 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_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)
- real(r8), pointer :: qflx_evap_veg_col (:) ! col vegetation evaporation (mm H2O/s) (+ = to atm)
- real(r8), pointer :: qflx_evap_can_patch (:) ! patch evaporation from leaves and stems (mm H2O/s) (+ = to atm)
- real(r8), pointer :: qflx_evap_can_col (:) ! col evaporation from leaves and stems (mm H2O/s) (+ = to atm)
- real(r8), pointer :: qflx_evap_tot_patch (:) ! patch pft_qflx_evap_soi + pft_qflx_evap_veg + qflx_tran_veg
- real(r8), pointer :: qflx_evap_tot_col (:) ! col col_qflx_evap_soi + col_qflx_evap_veg + qflx_tran_veg
- real(r8), pointer :: qflx_evap_grnd_patch (:) ! patch ground surface evaporation rate (mm H2O/s) [+]
- real(r8), pointer :: qflx_evap_grnd_col (:) ! col ground surface evaporation rate (mm H2O/s) [+]
- real(r8), pointer :: qflx_phs_neg_col (:) ! col sum of negative hydraulic redistribution fluxes (mm H2O/s) [+]
-
- ! In the snow capping parametrization excess mass above h2osno_max is removed. A breakdown of mass into liquid
- ! and solid fluxes is done, these are represented by qflx_snwcp_liq_col and qflx_snwcp_ice_col.
- real(r8), pointer :: qflx_snwcp_liq_col (:) ! col excess liquid h2o due to snow capping (outgoing) (mm H2O /s)
- real(r8), pointer :: qflx_snwcp_ice_col (:) ! col excess solid h2o due to snow capping (outgoing) (mm H2O /s)
- real(r8), pointer :: qflx_snwcp_discarded_liq_col(:) ! col excess liquid h2o due to snow capping, which we simply discard in order to reset the snow pack (mm H2O /s)
- real(r8), pointer :: qflx_snwcp_discarded_ice_col(:) ! col excess solid h2o due to snow capping, which we simply discard in order to reset the snow pack (mm H2O /s)
-
- real(r8), pointer :: qflx_tran_veg_patch (:) ! patch vegetation transpiration (mm H2O/s) (+ = to atm)
- real(r8), pointer :: qflx_tran_veg_col (:) ! col vegetation transpiration (mm H2O/s) (+ = to atm)
- real(r8), pointer :: qflx_dew_snow_patch (:) ! patch surface dew added to snow pack (mm H2O /s) [+]
- real(r8), pointer :: qflx_dew_snow_col (:) ! col surface dew added to snow pack (mm H2O /s) [+]
- real(r8), pointer :: qflx_dew_grnd_patch (:) ! patch ground surface dew formation (mm H2O /s) [+]
- real(r8), pointer :: qflx_dew_grnd_col (:) ! col ground surface dew formation (mm H2O /s) [+] (+ = to atm); usually eflx_bot >= 0)
- real(r8), pointer :: qflx_prec_intr_patch (:) ! patch interception of precipitation [mm/s]
- real(r8), pointer :: qflx_prec_intr_col (:) ! col interception of precipitation [mm/s]
- real(r8), pointer :: qflx_snowindunload_patch (:) ! patch canopy snow wind unloading (mm H2O /s)
- real(r8), pointer :: qflx_snowindunload_col (:) ! col canopy snow wind unloading (mm H2O /s)
- real(r8), pointer :: qflx_snotempunload_patch (:) ! patch canopy snow temp unloading (mm H2O /s)
- real(r8), pointer :: qflx_snotempunload_col (:) ! col canopy snow temp unloading (mm H2O /s)
-
- real(r8), pointer :: qflx_ev_snow_patch (:) ! patch evaporation heat flux from snow (mm H2O/s) [+ to atm]
- real(r8), pointer :: qflx_ev_snow_col (:) ! col evaporation heat flux from snow (mm H2O/s) [+ to atm]
- real(r8), pointer :: qflx_ev_soil_patch (:) ! patch evaporation heat flux from soil (mm H2O/s) [+ to atm]
- real(r8), pointer :: qflx_ev_soil_col (:) ! col evaporation heat flux from soil (mm H2O/s) [+ to atm]
- real(r8), pointer :: qflx_ev_h2osfc_patch (:) ! patch evaporation heat flux from soil (mm H2O/s) [+ to atm]
- real(r8), pointer :: qflx_ev_h2osfc_col (:) ! col evaporation heat flux from soil (mm H2O/s) [+ to atm]
-
- 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_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_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
- real(r8), pointer :: qflx_snow_h2osfc_col (:) ! col snow falling on surface water
- real(r8), pointer :: qflx_drain_perched_col (:) ! col sub-surface runoff from perched wt (mm H2O /s)
- real(r8), pointer :: qflx_deficit_col (:) ! col water deficit to keep non-negative liquid water content (mm H2O)
- real(r8), pointer :: qflx_floodc_col (:) ! col flood water flux at column level
- real(r8), pointer :: qflx_sl_top_soil_col (:) ! col liquid water + ice from layer above soil to top soil layer or sent to qflx_qrgwl (mm H2O/s)
- real(r8), pointer :: qflx_snomelt_col (:) ! col snow melt (mm H2O /s)
- real(r8), pointer :: qflx_snomelt_lyr_col (:,:) ! col snow melt in each layer (mm H2O /s)
- real(r8), pointer :: qflx_snow_drain_col (:) ! col drainage from snow pack
- real(r8), pointer :: qflx_qrgwl_col (:) ! col qflx_surf at glaciers, wetlands, lakes
- real(r8), pointer :: qflx_runoff_col (:) ! col total runoff (qflx_drain+qflx_surf+qflx_qrgwl) (mm H2O /s)
- real(r8), pointer :: qflx_runoff_r_col (:) ! col Rural total runoff (qflx_drain+qflx_surf+qflx_qrgwl) (mm H2O /s)
- real(r8), pointer :: qflx_runoff_u_col (:) ! col urban total runoff (qflx_drain+qflx_surf) (mm H2O /s)
- real(r8), pointer :: qflx_ice_runoff_snwcp_col(:) ! col solid runoff from snow capping (mm H2O /s)
- real(r8), pointer :: qflx_ice_runoff_xs_col (:) ! col solid runoff from excess ice in soil (mm H2O /s)
- real(r8), pointer :: qflx_rsub_sat_col (:) ! col soil saturation excess [mm/s]
- real(r8), pointer :: qflx_snofrz_lyr_col (:,:) ! col snow freezing rate (positive definite) (col,lyr) [kg m-2 s-1]
- real(r8), pointer :: qflx_snofrz_col (:) ! col column-integrated snow freezing rate (positive definite) (col) [kg m-2 s-1]
- real(r8), pointer :: qflx_drain_vr_col (:,:) ! col liquid water losted as drainage (m /time step)
- real(r8), pointer :: snow_sources_col (:) ! col snow sources (mm H2O/s)
- real(r8), pointer :: snow_sinks_col (:) ! col snow sinks (mm H2O/s)
-
- ! Dynamic land cover change
- real(r8), pointer :: qflx_liq_dynbal_grc (:) ! grc liq dynamic land cover change conversion runoff flux
- real(r8), pointer :: qflx_ice_dynbal_grc (:) ! grc ice dynamic land cover change conversion runoff flux
-
- ! ET accumulation
- real(r8), pointer :: AnnEt (:) ! Annual average ET flux mmH20/s
-
-
- contains
-
-
-
- procedure, public :: Init
- procedure, public :: Restart
- procedure, private :: InitAllocate
- procedure, private :: InitHistory
- procedure, private :: InitCold
- procedure, public :: InitAccBuffer
- procedure, public :: InitAccVars
- procedure, public :: UpdateAccVars
-
- end type waterflux_type
- !------------------------------------------------------------------------
-
-contains
-
- !------------------------------------------------------------------------
- subroutine Init(this, bounds)
-
- class(waterflux_type) :: this
- type(bounds_type), intent(in) :: bounds
-
- call this%InitAllocate(bounds) ! same as "call initAllocate_type(hydro, bounds)"
- call this%InitHistory(bounds)
- call this%InitCold(bounds)
-
- end subroutine Init
-
- !------------------------------------------------------------------------
- subroutine InitAllocate(this, bounds)
- !
- ! !DESCRIPTION:
- ! Initialize module data structure
- !
- ! !USES:
- !
- ! !ARGUMENTS:
- class(waterflux_type) :: this
- type(bounds_type), intent(in) :: bounds
- !
- ! !LOCAL VARIABLES:
- integer :: begp, endp
- integer :: begc, endc
- integer :: begg, endg
- !------------------------------------------------------------------------
-
- begp = bounds%begp; endp= bounds%endp
- begc = bounds%begc; endc= bounds%endc
- begg = bounds%begg; endg= bounds%endg
-
- allocate(this%qflx_prec_intr_patch (begp:endp)) ; this%qflx_prec_intr_patch (:) = nan
- allocate(this%qflx_prec_grnd_patch (begp:endp)) ; this%qflx_prec_grnd_patch (:) = nan
- allocate(this%qflx_rain_grnd_patch (begp:endp)) ; this%qflx_rain_grnd_patch (:) = nan
- allocate(this%qflx_snow_grnd_patch (begp:endp)) ; this%qflx_snow_grnd_patch (:) = nan
- allocate(this%qflx_sub_snow_patch (begp:endp)) ; this%qflx_sub_snow_patch (:) = 0.0_r8
- allocate(this%qflx_tran_veg_patch (begp:endp)) ; this%qflx_tran_veg_patch (:) = nan
-
- allocate(this%qflx_snowindunload_patch (begp:endp)) ; this%qflx_snowindunload_patch (:) = nan
- allocate(this%qflx_snowindunload_col (begp:endp)) ; this%qflx_snowindunload_col (:) = nan
- allocate(this%qflx_snotempunload_patch (begp:endp)) ; this%qflx_snotempunload_patch (:) = nan
- allocate(this%qflx_snotempunload_col (begp:endp)) ; this%qflx_snotempunload_col (:) = nan
-
- allocate(this%qflx_dew_grnd_patch (begp:endp)) ; this%qflx_dew_grnd_patch (:) = nan
- allocate(this%qflx_dew_snow_patch (begp:endp)) ; this%qflx_dew_snow_patch (:) = nan
-
- allocate(this%qflx_prec_intr_col (begc:endc)) ; this%qflx_prec_intr_col (:) = nan
- allocate(this%qflx_prec_grnd_col (begc:endc)) ; this%qflx_prec_grnd_col (:) = nan
- allocate(this%qflx_rain_grnd_col (begc:endc)) ; this%qflx_rain_grnd_col (:) = nan
- allocate(this%qflx_snow_grnd_col (begc:endc)) ; this%qflx_snow_grnd_col (:) = nan
- allocate(this%qflx_sub_snow_col (begc:endc)) ; this%qflx_sub_snow_col (:) = 0.0_r8
- 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_snwcp_discarded_liq_col(begc:endc)) ; this%qflx_snwcp_discarded_liq_col(:) = nan
- allocate(this%qflx_snwcp_discarded_ice_col(begc:endc)) ; this%qflx_snwcp_discarded_ice_col(:) = nan
- allocate(this%qflx_tran_veg_col (begc:endc)) ; this%qflx_tran_veg_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
- allocate(this%qflx_evap_tot_col (begc:endc)) ; this%qflx_evap_tot_col (:) = nan
- allocate(this%qflx_evap_grnd_col (begc:endc)) ; this%qflx_evap_grnd_col (:) = nan
- allocate(this%qflx_dew_grnd_col (begc:endc)) ; this%qflx_dew_grnd_col (:) = nan
- allocate(this%qflx_dew_snow_col (begc:endc)) ; this%qflx_dew_snow_col (:) = nan
- allocate(this%qflx_evap_veg_patch (begp:endp)) ; this%qflx_evap_veg_patch (:) = nan
- allocate(this%qflx_evap_can_patch (begp:endp)) ; this%qflx_evap_can_patch (:) = nan
- allocate(this%qflx_evap_soi_patch (begp:endp)) ; this%qflx_evap_soi_patch (:) = nan
- allocate(this%qflx_evap_tot_patch (begp:endp)) ; this%qflx_evap_tot_patch (:) = nan
- allocate(this%qflx_evap_grnd_patch (begp:endp)) ; this%qflx_evap_grnd_patch (:) = nan
- allocate(this%qflx_phs_neg_col (begc:endc)) ; this%qflx_phs_neg_col (:) = nan
-
- allocate( this%qflx_ev_snow_patch (begp:endp)) ; this%qflx_ev_snow_patch (:) = nan
- allocate( this%qflx_ev_snow_col (begc:endc)) ; this%qflx_ev_snow_col (:) = nan
- allocate( this%qflx_ev_soil_patch (begp:endp)) ; this%qflx_ev_soil_patch (:) = nan
- allocate( this%qflx_ev_soil_col (begc:endc)) ; this%qflx_ev_soil_col (:) = nan
- allocate( this%qflx_ev_h2osfc_patch (begp:endp)) ; this%qflx_ev_h2osfc_patch (:) = nan
- allocate( this%qflx_ev_h2osfc_col (begc:endc)) ; this%qflx_ev_h2osfc_col (:) = nan
-
- allocate(this%qflx_drain_vr_col (begc:endc,1:nlevsoi)) ; this%qflx_drain_vr_col (:,:) = nan
- allocate(this%qflx_adv_col (begc:endc,0:nlevsoi)) ; this%qflx_adv_col (:,:) = nan
- allocate(this%qflx_rootsoi_col (begc:endc,1:nlevsoi)) ; this%qflx_rootsoi_col (:,:) = 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_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
- allocate(this%qflx_h2osfc_surf_col (begc:endc)) ; this%qflx_h2osfc_surf_col (:) = nan
- allocate(this%qflx_snow_h2osfc_col (begc:endc)) ; this%qflx_snow_h2osfc_col (:) = nan
- allocate(this%qflx_snomelt_col (begc:endc)) ; this%qflx_snomelt_col (:) = nan
- allocate(this%qflx_snomelt_lyr_col (begc:endc,-nlevsno+1:0)) ; this%qflx_snomelt_lyr_col (:,:) = nan
- allocate(this%qflx_snow_drain_col (begc:endc)) ; this%qflx_snow_drain_col (:) = nan
- allocate(this%qflx_snofrz_col (begc:endc)) ; this%qflx_snofrz_col (:) = nan
- allocate(this%qflx_snofrz_lyr_col (begc:endc,-nlevsno+1:0)) ; this%qflx_snofrz_lyr_col (:,:) = nan
- allocate(this%qflx_qrgwl_col (begc:endc)) ; this%qflx_qrgwl_col (:) = nan
- allocate(this%qflx_drain_perched_col (begc:endc)) ; this%qflx_drain_perched_col (:) = nan
- allocate(this%qflx_deficit_col (begc:endc)) ; this%qflx_deficit_col (:) = nan
- allocate(this%qflx_floodc_col (begc:endc)) ; this%qflx_floodc_col (:) = nan
- allocate(this%qflx_sl_top_soil_col (begc:endc)) ; this%qflx_sl_top_soil_col (:) = nan
- allocate(this%qflx_runoff_col (begc:endc)) ; this%qflx_runoff_col (:) = nan
- allocate(this%qflx_runoff_r_col (begc:endc)) ; this%qflx_runoff_r_col (:) = nan
- allocate(this%qflx_runoff_u_col (begc:endc)) ; this%qflx_runoff_u_col (:) = nan
- allocate(this%qflx_ice_runoff_snwcp_col(begc:endc)) ; this%qflx_ice_runoff_snwcp_col(:) = nan
- allocate(this%qflx_ice_runoff_xs_col (begc:endc)) ; this%qflx_ice_runoff_xs_col (:) = nan
- allocate(this%qflx_rsub_sat_col (begc:endc)) ; this%qflx_rsub_sat_col (:) = nan
- allocate(this%snow_sources_col (begc:endc)) ; this%snow_sources_col (:) = nan
- allocate(this%snow_sinks_col (begc:endc)) ; this%snow_sinks_col (:) = nan
-
- allocate(this%qflx_liq_dynbal_grc (begg:endg)) ; this%qflx_liq_dynbal_grc (:) = nan
- allocate(this%qflx_ice_dynbal_grc (begg:endg)) ; this%qflx_ice_dynbal_grc (:) = nan
- allocate(this%AnnET (begc:endc)) ; this%AnnET (:) = nan
-
- end subroutine InitAllocate
-
- !------------------------------------------------------------------------
- subroutine InitHistory(this, bounds)
- !
- ! !USES:
- use clm_varctl , only : use_cn
- use histFileMod , only : hist_addfld1d, hist_addfld2d, no_snow_normal
- !
- ! !ARGUMENTS:
- class(waterflux_type) :: this
- type(bounds_type), intent(in) :: bounds
- !
- ! !LOCAL VARIABLES:
- integer :: begp, endp
- integer :: begc, endc
- integer :: begg, endg
- character(10) :: active
- real(r8), pointer :: data2dptr(:,:), data1dptr(:) ! temp. pointers for slicing larger arrays
- !------------------------------------------------------------------------
-
- begp = bounds%begp; endp= bounds%endp
- begc = bounds%begc; endc= bounds%endc
- begg = bounds%begg; endg= bounds%endg
-
- this%qflx_top_soil_col(begc:endc) = spval
- call hist_addfld1d (fname='QTOPSOIL', units='mm/s', &
- avgflag='A', long_name='water input to surface', &
- ptr_col=this%qflx_top_soil_col, c2l_scale_type='urbanf', default='inactive')
-
- this%qflx_infl_col(begc:endc) = spval
- call hist_addfld1d (fname='QINFL', units='mm/s', &
- avgflag='A', long_name='infiltration', &
- ptr_col=this%qflx_infl_col, c2l_scale_type='urbanf', default='inactive')
-
- this%qflx_surf_col(begc:endc) = spval
- call hist_addfld1d (fname='QOVER', units='mm/s', &
- avgflag='A', long_name='surface runoff', &
- ptr_col=this%qflx_surf_col, c2l_scale_type='urbanf', default='inactive')
-
- this%qflx_qrgwl_col(begc:endc) = spval
- call hist_addfld1d (fname='QRGWL', units='mm/s', &
- avgflag='A', &
- long_name='surface runoff at glaciers (liquid only), wetlands, lakes; also includes melted ice runoff from QSNWCPICE', &
- ptr_col=this%qflx_qrgwl_col, c2l_scale_type='urbanf', default='inactive')
-
- this%qflx_drain_col(begc:endc) = spval
- call hist_addfld1d (fname='QDRAI', units='mm/s', &
- avgflag='A', long_name='sub-surface drainage', &
- ptr_col=this%qflx_drain_col, c2l_scale_type='urbanf', default='inactive')
-
- this%qflx_liq_dynbal_grc(begg:endg) = spval
- call hist_addfld1d (fname='QFLX_LIQ_DYNBAL', units='mm/s', &
- avgflag='A', long_name='liq dynamic land cover change conversion runoff flux', &
- ptr_lnd=this%qflx_liq_dynbal_grc, default='inactive')
-
- this%qflx_ice_dynbal_grc(begg:endg) = spval
- call hist_addfld1d (fname='QFLX_ICE_DYNBAL', units='mm/s', &
- avgflag='A', long_name='ice dynamic land cover change conversion runoff flux', &
- ptr_lnd=this%qflx_ice_dynbal_grc, default='inactive')
-
- this%qflx_runoff_col(begc:endc) = spval
- call hist_addfld1d (fname='QRUNOFF', units='mm/s', &
- avgflag='A', &
- long_name='total liquid runoff not including correction for land use change', &
- ptr_col=this%qflx_runoff_col, c2l_scale_type='urbanf', default='inactive')
-
- call hist_addfld1d (fname='QRUNOFF_ICE', units='mm/s', avgflag='A', &
- long_name='total liquid runoff not incl corret for LULCC (ice landunits only)', &
- ptr_col=this%qflx_runoff_col, c2l_scale_type='urbanf', l2g_scale_type='ice', default='inactive')
-
- this%qflx_runoff_u_col(begc:endc) = spval
- call hist_addfld1d (fname='QRUNOFF_U', units='mm/s', &
- avgflag='A', long_name='Urban total runoff', &
- ptr_col=this%qflx_runoff_u_col, set_nourb=spval, c2l_scale_type='urbanf', default='inactive')
-
- this%qflx_runoff_r_col(begc:endc) = spval
- call hist_addfld1d (fname='QRUNOFF_R', units='mm/s', &
- avgflag='A', long_name='Rural total runoff', &
- ptr_col=this%qflx_runoff_r_col, set_spec=spval, default='inactive')
-
- this%qflx_snow_drain_col(begc:endc) = spval
- call hist_addfld1d (fname='QFLX_SNOW_DRAIN', units='mm/s', &
- avgflag='A', long_name='drainage from snow pack', &
- ptr_col=this%qflx_snow_drain_col, c2l_scale_type='urbanf', default='inactive')
-
- call hist_addfld1d (fname='QFLX_SNOW_DRAIN_ICE', units='mm/s', &
- avgflag='A', long_name='drainage from snow pack melt (ice landunits only)', &
- ptr_col=this%qflx_snow_drain_col, c2l_scale_type='urbanf', l2g_scale_type='ice', default='inactive')
-
- this%qflx_snomelt_col(begc:endc) = spval
- call hist_addfld1d (fname='QSNOMELT', units='mm/s', &
- avgflag='A', long_name='snow melt rate', &
- ptr_col=this%qflx_snomelt_col, c2l_scale_type='urbanf', default='inactive')
-
- call hist_addfld1d (fname='QSNOMELT_ICE', units='mm/s', &
- avgflag='A', long_name='snow melt (ice landunits only)', &
- ptr_col=this%qflx_snomelt_col, c2l_scale_type='urbanf', l2g_scale_type='ice', default='inactive')
-
- this%qflx_snomelt_lyr_col(begc:endc,-nlevsno+1:0) = spval
- data2dptr => this%qflx_snomelt_lyr_col(begc:endc,-nlevsno+1:0)
- call hist_addfld2d (fname='SNO_MELT', units='mm/s', type2d='levsno', &
- avgflag='A', long_name='snow melt rate in each snow layer', &
- ptr_col=data2dptr, c2l_scale_type='urbanf',no_snow_behavior=no_snow_normal, default='inactive')
-
- call hist_addfld2d (fname='SNO_MELT_ICE', units='mm/s', type2d='levsno', &
- avgflag='A', long_name='snow melt rate in each snow layer (ice landunits only)', &
- ptr_col=data2dptr, c2l_scale_type='urbanf',no_snow_behavior=no_snow_normal, &
- l2g_scale_type='ice', default='inactive')
-
- this%qflx_snofrz_col(begc:endc) = spval
- call hist_addfld1d (fname='QSNOFRZ', units='kg/m2/s', &
- avgflag='A', long_name='column-integrated snow freezing rate', &
- ptr_col=this%qflx_snofrz_col, set_lake=spval, c2l_scale_type='urbanf', default='inactive')
-
- call hist_addfld1d (fname='QSNOFRZ_ICE', units='mm/s', &
- avgflag='A', long_name='column-integrated snow freezing rate (ice landunits only)', &
- ptr_col=this%qflx_snofrz_col, c2l_scale_type='urbanf', l2g_scale_type='ice', default='inactive')
-
- this%qflx_snofrz_lyr_col(begc:endc,-nlevsno+1:0) = spval
- data2dptr => this%qflx_snofrz_lyr_col(begc:endc,-nlevsno+1:0)
- call hist_addfld2d (fname='SNO_FRZ', units='kg/m2/s', type2d='levsno', &
- avgflag='A', long_name='snow freezing rate in each snow layer', &
- ptr_col=data2dptr, c2l_scale_type='urbanf',no_snow_behavior=no_snow_normal, default='inactive')
-
- call hist_addfld2d (fname='SNO_FRZ_ICE', units='mm/s', type2d='levsno', &
- avgflag='A', long_name='snow freezing rate in each snow layer (ice landunits only)', &
- ptr_col=data2dptr, c2l_scale_type='urbanf',no_snow_behavior=no_snow_normal, &
- l2g_scale_type='ice', default='inactive')
-
- this%qflx_h2osfc_to_ice_col(begc:endc) = spval
- call hist_addfld1d (fname='QH2OSFC_TO_ICE', units='mm/s', &
- avgflag='A', long_name='surface water converted to ice', &
- ptr_col=this%qflx_h2osfc_to_ice_col, default='inactive')
-
- this%qflx_prec_intr_patch(begp:endp) = spval
- call hist_addfld1d (fname='QINTR', units='mm/s', &
- avgflag='A', long_name='interception', &
- ptr_patch=this%qflx_prec_intr_patch, set_lake=0._r8, default='inactive')
-
- this%qflx_prec_grnd_patch(begp:endp) = spval
- call hist_addfld1d (fname='QDRIP', units='mm/s', &
- avgflag='A', long_name='throughfall', &
- ptr_patch=this%qflx_prec_grnd_patch, c2l_scale_type='urbanf', default='inactive')
-
- this%qflx_evap_soi_patch(begp:endp) = spval
- call hist_addfld1d (fname='QSOIL', units='mm/s', &
- avgflag='A', long_name= 'Ground evaporation (soil/snow evaporation + soil/snow sublimation - dew)', &
- ptr_patch=this%qflx_evap_soi_patch, c2l_scale_type='urbanf', default='inactive')
-
- call hist_addfld1d (fname='QSOIL_ICE', units='mm/s', &
- avgflag='A', long_name='Ground evaporation (ice landunits only)', &
- ptr_patch=this%qflx_evap_soi_patch, c2l_scale_type='urbanf', l2g_scale_type='ice', default='inactive')
-
- call hist_addfld2d (fname='QROOTSINK', units='mm/s', type2d='levsoi', &
- avgflag='A', long_name='water flux from soil to root in each soil-layer', &
- ptr_col=this%qflx_rootsoi_col, set_spec=spval, l2g_scale_type='veg', default='inactive')
-
- this%qflx_evap_can_patch(begp:endp) = spval
- call hist_addfld1d (fname='QVEGE', units='mm/s', &
- avgflag='A', long_name='canopy evaporation', &
- ptr_patch=this%qflx_evap_can_patch, set_lake=0._r8, c2l_scale_type='urbanf', default='inactive')
-
- this%qflx_tran_veg_patch(begp:endp) = spval
- call hist_addfld1d (fname='QVEGT', units='mm/s', &
- avgflag='A', long_name='canopy transpiration', &
- ptr_patch=this%qflx_tran_veg_patch, set_lake=0._r8, c2l_scale_type='urbanf', default='inactive')
-
- this%qflx_ev_snow_patch(begp:endp) = spval
- call hist_addfld1d (fname='QSNOEVAP', units='mm/s', &
- avgflag='A', long_name='evaporation from snow', &
- ptr_patch=this%qflx_tran_veg_patch, set_lake=0._r8, c2l_scale_type='urbanf', default='inactive')
-
- this%qflx_snowindunload_patch(begp:endp) = spval
- call hist_addfld1d (fname='QSNO_WINDUNLOAD', units='mm/s', &
- avgflag='A', long_name='canopy snow wind unloading', &
- ptr_patch=this%qflx_snowindunload_patch, set_lake=0._r8, c2l_scale_type='urbanf', default='inactive')
-
- this%qflx_snotempunload_patch(begp:endp) = spval
- call hist_addfld1d (fname='QSNO_TEMPUNLOAD', units='mm/s', &
- avgflag='A', long_name='canopy snow temp unloading', &
- ptr_patch=this%qflx_snotempunload_patch, set_lake=0._r8, c2l_scale_type='urbanf', default='inactive')
-
- this%qflx_snwcp_liq_col(begc:endc) = spval
- call hist_addfld1d (fname='QSNOCPLIQ', units='mm H2O/s', &
- avgflag='A', long_name='excess liquid h2o due to snow capping not including correction for land use change', &
- ptr_col=this%qflx_snwcp_liq_col, c2l_scale_type='urbanf', default='inactive')
-
- this%qflx_snwcp_ice_col(begc:endc) = spval
- call hist_addfld1d (fname='QSNWCPICE', units='mm H2O/s', &
- avgflag='A', long_name='excess solid h2o due to snow capping not including correction for land use change', &
- ptr_col=this%qflx_snwcp_ice_col, c2l_scale_type='urbanf', default='inactive')
-
- this%qflx_rain_grnd_patch(begp:endp) = spval
- call hist_addfld1d (fname='QFLX_RAIN_GRND', units='mm H2O/s', &
- avgflag='A', long_name='rain on ground after interception', &
- ptr_patch=this%qflx_rain_grnd_patch, default='inactive', c2l_scale_type='urbanf')
-
- this%qflx_snow_grnd_patch(begp:endp) = spval
- call hist_addfld1d (fname='QFLX_SNOW_GRND', units='mm H2O/s', &
- avgflag='A', long_name='snow on ground after interception', &
- ptr_patch=this%qflx_snow_grnd_patch, default='inactive', c2l_scale_type='urbanf')
-
- this%qflx_evap_grnd_patch(begp:endp) = spval
- call hist_addfld1d (fname='QFLX_EVAP_GRND', units='mm H2O/s', &
- avgflag='A', long_name='ground surface evaporation', &
- ptr_patch=this%qflx_evap_grnd_patch, default='inactive', c2l_scale_type='urbanf')
-
- this%qflx_evap_veg_patch(begp:endp) = spval
- call hist_addfld1d (fname='QFLX_EVAP_VEG', units='mm H2O/s', &
- avgflag='A', long_name='vegetation evaporation', &
- ptr_patch=this%qflx_evap_veg_patch, default='inactive', c2l_scale_type='urbanf')
-
- this%qflx_evap_tot_patch(begp:endp) = spval
- call hist_addfld1d (fname='QFLX_EVAP_TOT', units='mm H2O/s', &
- avgflag='A', long_name='qflx_evap_soi + qflx_evap_can + qflx_tran_veg', &
- ptr_patch=this%qflx_evap_tot_patch, c2l_scale_type='urbanf', default='inactive')
-
- this%qflx_dew_grnd_patch(begp:endp) = spval
- call hist_addfld1d (fname='QFLX_DEW_GRND', units='mm H2O/s', &
- avgflag='A', long_name='ground surface dew formation', &
- ptr_patch=this%qflx_dew_grnd_patch, c2l_scale_type='urbanf', default='inactive')
-
- this%qflx_sub_snow_patch(begp:endp) = spval
- call hist_addfld1d (fname='QFLX_SUB_SNOW', units='mm H2O/s', &
- avgflag='A', long_name='sublimation rate from snow pack', &
- ptr_patch=this%qflx_sub_snow_patch, c2l_scale_type='urbanf', default='inactive')
-
- this%qflx_dew_snow_patch(begp:endp) = spval
- call hist_addfld1d (fname='QFLX_DEW_SNOW', units='mm H2O/s', &
- avgflag='A', long_name='surface dew added to snow pacK', &
- ptr_patch=this%qflx_dew_snow_patch, c2l_scale_type='urbanf', default='inactive')
-
- this%qflx_h2osfc_surf_col(begc:endc) = spval
- call hist_addfld1d (fname='QH2OSFC', units='mm/s', &
- avgflag='A', long_name='surface water runoff', &
- ptr_col=this%qflx_h2osfc_surf_col, default='inactive')
-
- this%qflx_drain_perched_col(begc:endc) = spval
- call hist_addfld1d (fname='QDRAI_PERCH', units='mm/s', &
- avgflag='A', long_name='perched wt drainage', &
- ptr_col=this%qflx_drain_perched_col, c2l_scale_type='urbanf', default='inactive')
-
- this%qflx_rsub_sat_col(begc:endc) = spval
- call hist_addfld1d (fname='QDRAI_XS', units='mm/s', &
- avgflag='A', long_name='saturation excess drainage', &
- ptr_col=this%qflx_rsub_sat_col, c2l_scale_type='urbanf', default='inactive')
-
- this%qflx_phs_neg_col(begc:endc) = spval
- call hist_addfld1d (fname='QPHSNEG', units='mm/s', &
- avgflag='A', long_name='net negative hydraulic redistribution flux', &
- ptr_col=this%qflx_phs_neg_col, default='inactive')
-
- ! As defined here, snow_sources - snow_sinks will equal the change in h2osno at any
- ! given time step but only if there is at least one snow layer (for all landunits
- ! except lakes). Also note that monthly average files of snow_sources and snow_sinks
- ! sinks must be weighted by number of days in the month to diagnose, for example, an
- ! annual value of the change in h2osno.
-
- this%snow_sources_col(begc:endc) = spval
- call hist_addfld1d (fname='SNOW_SOURCES', units='mm/s', &
- avgflag='A', long_name='snow sources (liquid water)', &
- ptr_col=this%snow_sources_col, c2l_scale_type='urbanf', default='inactive')
-
- this%snow_sinks_col(begc:endc) = spval
- call hist_addfld1d (fname='SNOW_SINKS', units='mm/s', &
- avgflag='A', long_name='snow sinks (liquid water)', &
- ptr_col=this%snow_sinks_col, c2l_scale_type='urbanf', default='inactive')
-
- this%AnnET(begc:endc) = spval
- call hist_addfld1d (fname='AnnET', units='mm/s', &
- avgflag='A', long_name='Annual ET', &
- ptr_col=this%AnnET, c2l_scale_type='urbanf', default='inactive')
-
- end subroutine InitHistory
-
-
-
- !-----------------------------------------------------------------------
- subroutine InitAccBuffer (this, bounds)
- !
- ! !DESCRIPTION:
- ! Initialize accumulation buffer for all required module accumulated fields
- ! This routine set defaults values that are then overwritten by the
- ! restart file for restart or branch runs
- !
- ! !USES
- use clm_varcon , only : spval
- use accumulMod , only : init_accum_field
- !
- ! !ARGUMENTS:
- class(waterflux_type) :: this
- type(bounds_type), intent(in) :: bounds
- !---------------------------------------------------------------------
-
- if (use_fun) then
-
- call init_accum_field (name='AnnET', units='MM H2O/S', &
- desc='365-day running mean of total ET', accum_type='runmean', accum_period=-365, &
- subgrid_type='column', numlev=1, init_value=0._r8)
-
- end if
-
- end subroutine InitAccBuffer
-
- !-----------------------------------------------------------------------
- !
- subroutine InitAccVars (this, bounds)
- ! !DESCRIPTION:
- ! Initialize module variables that are associated with
- ! time accumulated fields. This routine is called for both an initial run
- ! and a restart run (and must therefore must be called after the restart file
- ! is read in and the accumulation buffer is obtained)
- !
- ! !USES
- use accumulMod , only : extract_accum_field
- use clm_time_manager , only : get_nstep
- !
- ! !ARGUMENTS:
- class(waterflux_type) :: this
- type(bounds_type), intent(in) :: bounds
- !
- ! !LOCAL VARIABLES:
- integer :: begc, endc
- integer :: nstep
- integer :: ier
- real(r8), pointer :: rbufslp(:) ! temporary
- !---------------------------------------------------------------------
- begc = bounds%begc; endc = bounds%endc
-
- ! Allocate needed dynamic memory for single level patch field
- allocate(rbufslp(begc:endc), stat=ier)
-
- ! Determine time step
- nstep = get_nstep()
-
- if (use_fun) then
- call extract_accum_field ('AnnET', rbufslp, nstep)
- this%qflx_evap_tot_col(begc:endc) = rbufslp(begc:endc)
- end if
-
- deallocate(rbufslp)
-
- end subroutine InitAccVars
-
-
- !-----------------------------------------------------------------------
- subroutine UpdateAccVars (this, bounds)
- !
- ! USES
- use clm_time_manager, only : get_nstep
- use accumulMod , only : update_accum_field, extract_accum_field
- !
- ! !ARGUMENTS:
- class(waterflux_type) :: this
- type(bounds_type) , intent(in) :: bounds
- !
- ! !LOCAL VARIABLES:
- integer :: g,c,p ! indices
- integer :: dtime ! timestep size [seconds]
- integer :: nstep ! timestep number
- integer :: ier ! error status
- integer :: begc, endc
- real(r8), pointer :: rbufslp(:) ! temporary single level - patch level
- !---------------------------------------------------------------------
-
- begc = bounds%begc; endc = bounds%endc
-
- nstep = get_nstep()
-
- ! Allocate needed dynamic memory for single level patch field
-
- allocate(rbufslp(begc:endc), stat=ier)
-
- do c = begc,endc
- rbufslp(c) = this%qflx_evap_tot_col(c)
- end do
- if (use_fun) then
- ! Accumulate and extract AnnET (accumulates total ET as 365-day running mean)
- call update_accum_field ('AnnET', rbufslp, nstep)
- call extract_accum_field ('AnnET', this%AnnET, nstep)
-
- end if
-
- deallocate(rbufslp)
-
- end subroutine UpdateAccVars
-
-
- !-----------------------------------------------------------------------
- subroutine InitCold(this, bounds)
- !
- ! !USES:
- use landunit_varcon, only : istsoil, istcrop
- !
- ! !ARGUMENTS:
- class(waterflux_type) :: this
- type(bounds_type) , intent(in) :: bounds
- !
- ! !LOCAL VARIABLES:
- integer :: p,c,l
- !-----------------------------------------------------------------------
-
- this%qflx_evap_grnd_patch(bounds%begp:bounds%endp) = 0.0_r8
- this%qflx_dew_grnd_patch (bounds%begp:bounds%endp) = 0.0_r8
- this%qflx_dew_snow_patch (bounds%begp:bounds%endp) = 0.0_r8
-
- this%qflx_evap_grnd_col(bounds%begc:bounds%endc) = 0.0_r8
- this%qflx_dew_grnd_col (bounds%begc:bounds%endc) = 0.0_r8
- this%qflx_dew_snow_col (bounds%begc:bounds%endc) = 0.0_r8
-
- this%qflx_phs_neg_col(bounds%begc:bounds%endc) = 0.0_r8
-
- this%qflx_h2osfc_surf_col(bounds%begc:bounds%endc) = 0._r8
- this%qflx_snow_drain_col(bounds%begc:bounds%endc) = 0._r8
-
- ! This variable only gets set in the hydrology filter; need to initialize it to 0 for
- ! the sake of columns outside this filter
- this%qflx_ice_runoff_xs_col(bounds%begc:bounds%endc) = 0._r8
-
- this%AnnEt(bounds%begc:bounds%endc) = 0._r8
-
- ! needed for CNNLeaching
- do c = bounds%begc, bounds%endc
- l = col%landunit(c)
- if (lun%itype(l) == istsoil .or. lun%itype(l) == istcrop) then
- this%qflx_drain_col(c) = 0._r8
- this%qflx_surf_col(c) = 0._r8
- end if
- end do
-
- end subroutine InitCold
-
- !------------------------------------------------------------------------
- subroutine Restart(this, bounds, ncid, flag)
- !
- ! !USES:
- use ncdio_pio, only : file_desc_t, ncd_double
- use restUtilMod
- !
- ! !ARGUMENTS:
- class(waterflux_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:
- logical :: readvar ! determine if variable is on initial file
- !-----------------------------------------------------------------------
-
- ! needed for SNICAR
- call restartvar(ncid=ncid, flag=flag, varname='qflx_snofrz_lyr', xtype=ncd_double, &
- dim1name='column', dim2name='levsno', switchdim=.true., lowerb2=-nlevsno+1, upperb2=0, &
- long_name='snow layer ice freezing rate', units='kg m-2 s-1', &
- interpinic_flag='interp', readvar=readvar, data=this%qflx_snofrz_lyr_col)
- if (flag == 'read' .and. .not. readvar) then
- ! initial run, not restart: initialize qflx_snofrz_lyr to zero
- this%qflx_snofrz_lyr_col(bounds%begc:bounds%endc,-nlevsno+1:0) = 0._r8
- endif
-
- call restartvar(ncid=ncid, flag=flag, varname='qflx_snow_drain:qflx_snow_melt', xtype=ncd_double, &
- dim1name='column', &
- long_name='drainage from snow column', units='mm/s', &
- interpinic_flag='interp', readvar=readvar, data=this%qflx_snow_drain_col)
- if (flag == 'read' .and. .not. readvar) then
- ! initial run, not restart: initialize qflx_snow_drain to zero
- this%qflx_snow_drain_col(bounds%begc:bounds%endc) = 0._r8
- endif
-
-
- call restartvar(ncid=ncid, flag=flag, varname='AnnET', xtype=ncd_double, &
- dim1name='column', &
- long_name='Annual ET ', units='mm/s', &
- interpinic_flag='interp', readvar=readvar, data=this%AnnET)
- if (flag == 'read' .and. .not. readvar) then
- ! initial run, not restart: initialize qflx_snow_drain to zero
- this%AnnET(bounds%begc:bounds%endc) = 0._r8
- endif
-
- end subroutine Restart
-
-end module WaterfluxType
diff --git a/src/main/mml_main.F90 b/src/biogeophys/mml_main.F90
similarity index 63%
rename from src/main/mml_main.F90
rename to src/biogeophys/mml_main.F90
index 8eb1955e..2054c2b0 100644
--- a/src/main/mml_main.F90
+++ b/src/biogeophys/mml_main.F90
@@ -20,9 +20,12 @@ module mml_mainMod
! !USES:
+#include "shr_assert.h"
! MML: bounds & data type
+#include "shr_assert.h"
use decompMod , only : bounds_type
use spmdMod , only : masterproc
+ use shr_sys_mod, only : shr_sys_flush
use atm2lndType, only : atm2lnd_type
use lnd2atmType, only : lnd2atm_type ! MML: probably going to need a lnd2atm type
! to hand to the coupler as data coming from the land going to the atmosphere (l2x)
@@ -41,7 +44,8 @@ module mml_mainMod
use perf_mod ! for t_startf and t_stopf
! For using month-dependent values from forcing files
- use clm_time_manager, only : get_curr_date, get_nstep, get_step_size
+ use clm_time_manager, only : get_curr_date, is_beg_curr_day, get_step_size
+ use clm_time_manager, only : is_first_step_of_this_run_segment
! For namelist var
use clm_varctl , only: mml_surdat
@@ -50,9 +54,12 @@ module mml_mainMod
! !PUBLIC MEMBER FUNCTIONS:
public :: mml_main
+
+ public :: readnml_datasets
! !PRIVATE MEMBER FUNCTIONS:
private :: nc_import
+ private :: apply_use_init_interp ! apply the use_init_interp namelist option, if set
! mml: can I store the subroutines in other files? (just to keep this one from getting outrageously long?
! try it... (move nc_import, for starters... )
@@ -77,13 +84,150 @@ module mml_mainMod
! then used those coeffs instead of the more recent one!) Instead, I'm using the equivalent, but newer, clm
! function QSat, and doing the lhflx calculations with specific humidity rather than saturation vapour pressure
-
+ character(len=*), parameter, private :: sourcefile = &
+ __FILE__
contains
+ !-----------------------------------------------------------------------
+ subroutine readnml_datasets( NLFilename )
+ use shr_mpi_mod , only : shr_mpi_bcast
+ use spmdMod , only : mpicom
+ use clm_nlUtilsMod , only : find_nlgroup_name
+ use clm_varctl , only : finidat, fatmlndfrc, finidat_interp_dest, nsrest
+ use clm_varctl , only : nrevsn, fname_len, mml_surdat, finidat_interp_source
+ use clm_varctl , only : nsrStartup, nsrContinue, nsrBranch
+
+ implicit none
+
+ character(len=*), intent(IN) :: NLFilename ! Namelist file names
+ !-----------------------------------------------------------------------
+ ! !LOCAL VARIABLES:
+ integer :: nu_nml ! Unit for namelist file
+ integer :: nml_error ! Error code
+ logical :: use_init_interp ! Turn on interpolation of initial conditions
+ character(len=*), parameter :: nml_name = 'slim_data_and_initial'
+ character(len=*), parameter :: subname = 'readnml_datasets'
+ namelist /slim_data_and_initial/ mml_surdat, finidat, fatmlndfrc
+ namelist /slim_data_and_initial/ finidat_interp_dest, nrevsn, use_init_interp
+ !-----------------------------------------------------------------------
+
+ fatmlndfrc = ' '
+ use_init_interp = .false.
+ if (masterproc) then
+ open( newunit=nu_nml, file=trim(NLFilename), status='old', iostat=nml_error )
+ call find_nlgroup_name(nu_nml, nml_name, status=nml_error)
+ if (nml_error == 0) then
+ read(nu_nml, nml=slim_data_and_initial,iostat=nml_error)
+ if (nml_error /= 0) then
+ call endrun(subname // ':: ERROR reading '//nml_name//' namelist')
+ end if
+ else
+ call endrun(subname // ':: ERROR could NOT find '//nml_name//' namelist')
+ end if
+ close(nu_nml)
+ end if
+ call shr_mpi_bcast( mml_surdat, mpicom )
+ call shr_mpi_bcast( finidat, mpicom )
+ call shr_mpi_bcast( finidat_interp_dest, mpicom )
+ call shr_mpi_bcast( nrevsn, mpicom )
+ call shr_mpi_bcast( fatmlndfrc, mpicom )
+ call shr_mpi_bcast( use_init_interp, mpicom )
+
+ if (use_init_interp) then
+ call apply_use_init_interp(finidat, finidat_interp_source)
+ end if
+
+ if (masterproc) then
+ write(iulog,*) 'nrevsn = ', trim(nrevsn)
+ write(iulog,*) 'finidat = ', trim(finidat)
+ if ( use_init_interp )then
+ write(iulog,*) 'Interpolate initial conditions'
+ write(iulog,*) 'finidat_interp_dest = ', trim(finidat_interp_dest)
+ end if
+
+ if (fatmlndfrc == ' ') then
+ call endrun(subname // ':: ERROR fatmlndfrc was NOT set and needs to be' )
+ else
+ write(iulog,*) ' land frac data = ',trim(fatmlndfrc)
+ end if
+
+ if (mml_surdat == ' ') then
+ call endrun(subname // ':: ERROR mml_surdat was NOT set and needs to be' )
+ else
+ write(iulog,*) ' mml_surdat IS set, and = ',trim(mml_surdat)
+ end if
+
+ if (nsrest == nsrBranch .and. nrevsn == ' ') then
+ call endrun(msg=' ERROR: need to set restart data file name'//&
+ errMsg(sourcefile, __LINE__))
+ end if
+ ! Consistency settings for nrevsn
+
+ if (nsrest == nsrStartup ) nrevsn = ' '
+ if (nsrest == nsrContinue) nrevsn = 'set by restart pointer file file'
+ if (nsrest /= nsrStartup .and. nsrest /= nsrContinue .and. nsrest /= nsrBranch ) then
+ call endrun(msg=' ERROR: nsrest NOT set to a valid value'//&
+ errMsg(sourcefile, __LINE__))
+ end if
+ if (nsrest == nsrStartup) then
+ if (finidat /= ' ') then
+ write(iulog,*) ' initial data: ', trim(finidat)
+ else if (finidat_interp_source /= ' ') then
+ write(iulog,*) ' initial data interpolated from: ', trim(finidat_interp_source)
+ else
+ write(iulog,*) ' initial data created by model (cold start)'
+ end if
+ else
+ write(iulog,*) ' restart data = ',trim(nrevsn)
+ end if
+
+ end if
+
+ end subroutine readnml_datasets
+
+ !-----------------------------------------------------------------------
+ subroutine apply_use_init_interp(finidat, finidat_interp_source)
+ !
+ ! !DESCRIPTION:
+ ! Applies the use_init_interp option, setting finidat_interp_source to
+ ! finidat
+ !
+ ! Should be called if use_init_interp is true.
+ !
+ ! Does error checking to ensure that it is valid to set use_init_interp to
+ ! true,
+ ! given the values of finidat and finidat_interp_source.
+ !
+ ! !USES:
+ !
+ ! !ARGUMENTS:
+ character(len=*), intent(inout) :: finidat
+ character(len=*), intent(inout) :: finidat_interp_source
+ !
+ ! !LOCAL VARIABLES:
+
+ character(len=*), parameter :: subname = 'apply_use_init_interp'
+ !-----------------------------------------------------------------------
+
+ if (finidat == ' ') then
+ call endrun(msg=subname//'::ERROR: Can only set use_init_interp if finidat is set')
+ end if
+
+ if (finidat_interp_source /= ' ') then
+ call endrun(msg=subname//'::ERROR: Cannot set use_init_interp if finidat_interp_source is &
+ &already set')
+ end if
+
+ finidat_interp_source = finidat
+ finidat = ' '
+
+ end subroutine apply_use_init_interp
+
!-----------------------------------------------------------------------
subroutine mml_main (bounds, atm2lnd_inst, lnd2atm_inst) !lnd2atm_inst
+ use clm_varpar, only : numrad
implicit none
type(bounds_type), intent(in) :: bounds
@@ -139,7 +283,6 @@ subroutine mml_main (bounds, atm2lnd_inst, lnd2atm_inst) !lnd2atm_inst
integer :: mon ! month (1, ..., 12) for nstep+1
integer :: day ! day of month (1, ..., 31) for nstep+1
integer :: sec ! seconds into current date for nstep+1
- integer :: mcdate ! Current model date (yyyymmdd)
real(r8) :: dt ! length of time step, in seconds
@@ -173,9 +316,6 @@ subroutine mml_main (bounds, atm2lnd_inst, lnd2atm_inst) !lnd2atm_inst
!emiss(bounds%begg:bounds%endg) , & ! emissivity, from .nc file
!glc_mask(bounds%begg:bounds%endg) , & ! mask on glaciated points (1 = glacier, 0 = not), from .nc file (aiming for greenalnd + antarctica)
!dust(bounds%begg:bounds%endg,4) , & ! dust flux, land to atm, from .nc file lat x lon x 3 dust bins
- zref_t(bounds%begg:bounds%endg) , & ! reference height temperature for lnd2atm
- zref_u(bounds%begg:bounds%endg) , & ! reference height wind speed for lnd2atm
- zref_q(bounds%begg:bounds%endg) , & ! reference height humidity for lnd2atm
lwrad(bounds%begg:bounds%endg) , & ! incoming longwave radiation from atm
lw_abs(bounds%begg:bounds%endg) , & ! absorbed longwave radiation (emissivity*incoming)
lambda(bounds%begg:bounds%endg) , & ! latent heat of vaporization, or fusion, depending on phase
@@ -215,9 +355,7 @@ subroutine mml_main (bounds, atm2lnd_inst, lnd2atm_inst) !lnd2atm_inst
zeta(bounds%begg:bounds%endg)
! For the lhflx limitation
- real(r8) :: pbot(bounds%begg:bounds%endg) , & ! [Pa] midpoint of bottom layer (from atm)
- p2(bounds%begg:bounds%endg) , & ! [Pa] top boundary of bottom layer (calculate using hybrid coords)
- qbot(bounds%begg:bounds%endg) , & ! [kg/kg] specific humidity in lowest level of atm (check units?)
+ real(r8) :: p2(bounds%begg:bounds%endg), & ! [Pa] top boundary of bottom layer (calculate using hybrid coords)
dpbot(bounds%begg:bounds%endg) , & ! thickness in pressure of bottom layer, approximating as dpbot = 2*(psrf-pbot)
q_avail(bounds%begg:bounds%endg) , & ! water available in lowest level
lh_avail(bounds%begg:bounds%endg) , & ! latent heat available in lowest level
@@ -237,8 +375,6 @@ subroutine mml_main (bounds, atm2lnd_inst, lnd2atm_inst) !lnd2atm_inst
dtsoi(bounds%begg:bounds%endg,10) , &
cp(bounds%begg:bounds%endg,10) , &
dp(bounds%begg:bounds%endg,10) , &
- fsds_dir(bounds%begg:bounds%endg,2) , &
- fsds_dif(bounds%begg:bounds%endg,2) , &
sw_abs_dir(bounds%begg:bounds%endg,2) , &
sw_abs_dif(bounds%begg:bounds%endg,2)
real(r8) :: fsds_tot ! Total solar
@@ -257,111 +393,112 @@ subroutine mml_main (bounds, atm2lnd_inst, lnd2atm_inst) !lnd2atm_inst
!lwdown_atm => atm2lnd_inst%forc_lwrad_not_downscaled_grc , &
!swdown_atm => atm2lnd_inst%forc_solar_grc , &
! atm vars (need to grab them from atm portion, though... once this is written, can simplify by grabbing them right away)
- fsds => atm2lnd_inst%mml_atm_fsds_grc , &
- fsdsnd => atm2lnd_inst%mml_atm_fsdsnd_grc , & ! incoming shortwave nir direct
- fsdsvd => atm2lnd_inst%mml_atm_fsdsvd_grc , &
- fsdsni => atm2lnd_inst%mml_atm_fsdsni_grc , &
- fsdsvi => atm2lnd_inst%mml_atm_fsdsvi_grc , &
- lwdn => atm2lnd_inst%mml_atm_lwdn_grc , &
- zref => atm2lnd_inst%mml_atm_zref_grc , &
- tref => atm2lnd_inst%mml_atm_tbot_grc , &
- thref => atm2lnd_inst%mml_atm_thref_grc , &
- qref => atm2lnd_inst%mml_atm_qbot_grc , &
- uref => atm2lnd_inst%mml_atm_uref_grc , &
- eref => atm2lnd_inst%mml_atm_eref_grc , &
- pref => atm2lnd_inst%mml_atm_pbot_grc , &
- psrf => atm2lnd_inst%mml_atm_psrf_grc , &
- rhomol => atm2lnd_inst%mml_atm_rhomol_grc , &
- rhoair => atm2lnd_inst%mml_atm_rhoair_grc , &
- cpair => atm2lnd_inst%mml_atm_cp_grc , & ! MML: this is in
- pco2 => atm2lnd_inst%mml_atm_pco2 , &
- prec_liq => atm2lnd_inst%mml_atm_prec_liq_grc , & ! MML: in mm/s
- prec_frz => atm2lnd_inst%mml_atm_prec_frz_grc , &
+ ! slevis: these were later overwritten, so now I point them directly to
+ ! their final destination here
+ fsds => atm2lnd_inst%forc_solar_grc, &
+ fsds_dir => atm2lnd_inst%forc_solad_grc, &
+ fsds_dif => atm2lnd_inst%forc_solai_grc, &
+ lwdn => atm2lnd_inst%forc_lwrad_not_downscaled_grc, &
+ zref => atm2lnd_inst%forc_hgt_grc, &
+ tref => atm2lnd_inst%forc_t_not_downscaled_grc, &
+ thref => atm2lnd_inst%mml_atm_thref_grc, &
+ qref => atm2lnd_inst%forc_q_not_downscaled_grc, &
+ uref => atm2lnd_inst%forc_wind_grc, &
+ eref => atm2lnd_inst%forc_vp_grc, &
+ pref => atm2lnd_inst%forc_pbot_not_downscaled_grc, &
+ psrf => atm2lnd_inst%forc_psrf_grc, & ! surface pressure (Pa)
+ rhomol => atm2lnd_inst%mml_atm_rhomol_grc, &
+ rhoair => atm2lnd_inst%forc_rho_not_downscaled_grc, &
+ cpair => atm2lnd_inst%mml_atm_cp_grc, & ! MML: this is in
+ prec_liq => atm2lnd_inst%forc_rain_not_downscaled_grc, &
+ prec_frz => atm2lnd_inst%forc_snow_not_downscaled_grc, &
! lnd variables
- tsrf => atm2lnd_inst%mml_lnd_ts_grc , &
- qsrf => atm2lnd_inst%mml_lnd_qs_grc , &
- radforc => atm2lnd_inst%mml_lnd_qa_grc , &
- sw_abs => atm2lnd_inst%mml_lnd_swabs_grc , &
- fsr => atm2lnd_inst%mml_lnd_fsr_grc , &
- fsrnd => atm2lnd_inst%mml_lnd_fsrnd_grc , &
- fsrni => atm2lnd_inst%mml_lnd_fsrni_grc , &
- fsrvd => atm2lnd_inst%mml_lnd_fsrvd_grc , &
- fsrvi => atm2lnd_inst%mml_lnd_fsrvi_grc , &
- lwup => atm2lnd_inst%mml_lnd_lwup_grc , &
- fsns => atm2lnd_inst%mml_lnd_fsns_grc , &
- flns => atm2lnd_inst%mml_lnd_flns_grc , &
- shflx => atm2lnd_inst%mml_lnd_shflx_grc , &
- lhflx => atm2lnd_inst%mml_lnd_lhflx_grc , &
- gsoi => atm2lnd_inst%mml_lnd_gsoi_grc , &
- gsnow => atm2lnd_inst%mml_lnd_gsnow_grc , &
- evap => atm2lnd_inst%mml_lnd_evap_grc , &
- ustar => atm2lnd_inst%mml_lnd_ustar_grc , &
- tstar => atm2lnd_inst%mml_lnd_tstar_grc , &
- qstar => atm2lnd_inst%mml_lnd_qstar_grc , &
- tvstar => atm2lnd_inst%mml_lnd_tvstar_grc , &
- obu => atm2lnd_inst%mml_lnd_obu_grc , &
- ram => atm2lnd_inst%mml_lnd_ram_grc , &
- rah => atm2lnd_inst%mml_lnd_rah_grc , &
- h_disp => atm2lnd_inst%mml_lnd_disp_grc , &
- z0m => atm2lnd_inst%mml_lnd_z0m_grc , &
- z0h => atm2lnd_inst%mml_lnd_z0h_grc , &
- albedo_fin => atm2lnd_inst%mml_lnd_alb_grc , &
- snow_melt => atm2lnd_inst%mml_lnd_snowmelt , &
- taux => atm2lnd_inst%mml_out_taux , &
- tauy => atm2lnd_inst%mml_out_tauy , &
+ tsrf => atm2lnd_inst%mml_lnd_ts_grc, &
+ qsrf => atm2lnd_inst%mml_lnd_qs_grc, &
+ radforc => atm2lnd_inst%mml_lnd_qa_grc, &
+ sw_abs => atm2lnd_inst%mml_lnd_swabs_grc, &
+ fsr => atm2lnd_inst%mml_lnd_fsr_grc, &
+ fsrnd => atm2lnd_inst%mml_lnd_fsrnd_grc, &
+ fsrni => atm2lnd_inst%mml_lnd_fsrni_grc, &
+ fsrvd => atm2lnd_inst%mml_lnd_fsrvd_grc, &
+ fsrvi => atm2lnd_inst%mml_lnd_fsrvi_grc, &
+ lwup => atm2lnd_inst%mml_lnd_lwup_grc, &
+ fsns => atm2lnd_inst%mml_lnd_fsns_grc, &
+ flns => atm2lnd_inst%mml_lnd_flns_grc, &
+ shflx => atm2lnd_inst%mml_lnd_shflx_grc, &
+ lhflx => atm2lnd_inst%mml_lnd_lhflx_grc, &
+ gsoi => atm2lnd_inst%mml_lnd_gsoi_grc, &
+ gsnow => atm2lnd_inst%mml_lnd_gsnow_grc, &
+ evap => atm2lnd_inst%mml_lnd_evap_grc, &
+ ustar => atm2lnd_inst%mml_lnd_ustar_grc, &
+ tstar => atm2lnd_inst%mml_lnd_tstar_grc, &
+ qstar => atm2lnd_inst%mml_lnd_qstar_grc, &
+ tvstar => atm2lnd_inst%mml_lnd_tvstar_grc, &
+ obu => atm2lnd_inst%mml_lnd_obu_grc, &
+ ram => atm2lnd_inst%mml_lnd_ram_grc, &
+ rah => atm2lnd_inst%mml_lnd_rah_grc, &
+ h_disp => atm2lnd_inst%mml_lnd_disp_grc, &
+ z0m => atm2lnd_inst%mml_lnd_z0m_grc, &
+ z0h => atm2lnd_inst%mml_lnd_z0h_grc, &
+ albedo_fin => atm2lnd_inst%mml_lnd_alb_grc, &
+ snow_melt => atm2lnd_inst%mml_lnd_snowmelt, &
+ taux => atm2lnd_inst%mml_out_taux, &
+ tauy => atm2lnd_inst%mml_out_tauy, &
! over-large dew:
- lh_excess => atm2lnd_inst%mml_lh_excess , &
- q_excess => atm2lnd_inst%mml_q_excess , &
- lh_demand => atm2lnd_inst%mml_lh_demand , &
- q_demand => atm2lnd_inst%mml_q_demand , &
+ lh_excess => atm2lnd_inst%mml_lh_excess, &
+ q_excess => atm2lnd_inst%mml_q_excess, &
+ lh_demand => atm2lnd_inst%mml_lh_demand, &
+ q_demand => atm2lnd_inst%mml_q_demand, &
! soil variables
- tsoi => atm2lnd_inst%mml_soil_t_grc , &
- soil_liq => atm2lnd_inst%mml_soil_liq_grc , &
- soil_ice => atm2lnd_inst%mml_soil_ice_grc , &
- soil_dz => atm2lnd_inst%mml_soil_dz_grc , &
- soil_zh => atm2lnd_inst%mml_soil_zh_grc , &
- soil_tk => atm2lnd_inst%mml_soil_tk_grc , &
- soil_tk_1d => atm2lnd_inst%mml_soil_tk_1d_grc , &
- soil_tkh => atm2lnd_inst%mml_soil_tkh_grc , &
- soil_dtsoi => atm2lnd_inst%mml_soil_dtsoi_grc , &
- soil_cv => atm2lnd_inst%mml_soil_cv_grc , &
- soil_cv_1d => atm2lnd_inst%mml_soil_cv_1d_grc , &
- glc_tk_1d => atm2lnd_inst%mml_glc_tk_1d_grc , &
- glc_cv_1d => atm2lnd_inst%mml_glc_cv_1d_grc , &
- water => atm2lnd_inst%mml_soil_water_grc , &
- snow => atm2lnd_inst%mml_soil_snow_grc , &
- runoff => atm2lnd_inst%mml_soil_runoff_grc , &
+ tsoi => atm2lnd_inst%mml_soil_t_grc, &
+ soil_liq => atm2lnd_inst%mml_soil_liq_grc, &
+ soil_ice => atm2lnd_inst%mml_soil_ice_grc, &
+ soil_dz => atm2lnd_inst%mml_soil_dz_grc, &
+ soil_zh => atm2lnd_inst%mml_soil_zh_grc, &
+ soil_tk => atm2lnd_inst%mml_soil_tk_grc, &
+ soil_tk_1d => atm2lnd_inst%mml_soil_tk_1d_grc, &
+ soil_tkh => atm2lnd_inst%mml_soil_tkh_grc, &
+ soil_dtsoi => atm2lnd_inst%mml_soil_dtsoi_grc, &
+ soil_cv => atm2lnd_inst%mml_soil_cv_grc, &
+ soil_cv_1d => atm2lnd_inst%mml_soil_cv_1d_grc, &
+ glc_tk_1d => atm2lnd_inst%mml_glc_tk_1d_grc, &
+ glc_cv_1d => atm2lnd_inst%mml_glc_cv_1d_grc, &
+ water => atm2lnd_inst%mml_soil_water_grc, &
+ snow => atm2lnd_inst%mml_soil_snow_grc, &
+ runoff => atm2lnd_inst%mml_soil_runoff_grc, &
! values from .nc file
- albedo_gvd => atm2lnd_inst%mml_nc_alb_gvd_grc , &
- albedo_svd => atm2lnd_inst%mml_nc_alb_svd_grc , &
- albedo_gnd => atm2lnd_inst%mml_nc_alb_gnd_grc , &
- albedo_snd => atm2lnd_inst%mml_nc_alb_snd_grc , &
- albedo_gvf => atm2lnd_inst%mml_nc_alb_gvf_grc , &
- albedo_svf => atm2lnd_inst%mml_nc_alb_svf_grc , &
- albedo_gnf => atm2lnd_inst%mml_nc_alb_gnf_grc , &
- albedo_snf => atm2lnd_inst%mml_nc_alb_snf_grc , &
- snowmask => atm2lnd_inst%mml_nc_snowmask_grc , &
- evaprs => atm2lnd_inst%mml_nc_evaprs_grc , &
- bucket_cap => atm2lnd_inst%mml_nc_bucket_cap_grc , &
- soil_maxice => atm2lnd_inst%mml_nc_soil_maxice_grc , &
- soil_z => atm2lnd_inst%mml_nc_soil_levels_grc , &
- soil_type => atm2lnd_inst%mml_nc_soil_type_grc , &
- roughness => atm2lnd_inst%mml_nc_roughness_grc , &
- emiss => atm2lnd_inst%mml_nc_emiss_grc , &
- glc_mask => atm2lnd_inst%mml_nc_glcmask_grc , &
- dust => atm2lnd_inst%mml_nc_dust_grc , &
+ albedo_gvd => atm2lnd_inst%mml_nc_alb_gvd_grc, &
+ albedo_svd => atm2lnd_inst%mml_nc_alb_svd_grc, &
+ albedo_gnd => atm2lnd_inst%mml_nc_alb_gnd_grc, &
+ albedo_snd => atm2lnd_inst%mml_nc_alb_snd_grc, &
+ albedo_gvf => atm2lnd_inst%mml_nc_alb_gvf_grc, &
+ albedo_svf => atm2lnd_inst%mml_nc_alb_svf_grc, &
+ albedo_gnf => atm2lnd_inst%mml_nc_alb_gnf_grc, &
+ albedo_snf => atm2lnd_inst%mml_nc_alb_snf_grc, &
+ snowmask => atm2lnd_inst%mml_nc_snowmask_grc, &
+ evaprs => atm2lnd_inst%mml_nc_evaprs_grc, &
+ bucket_cap => atm2lnd_inst%mml_nc_bucket_cap_grc, &
+ soil_maxice => atm2lnd_inst%mml_nc_soil_maxice_grc, &
+ soil_z => atm2lnd_inst%mml_nc_soil_levels_grc, &
+ soil_type => atm2lnd_inst%mml_nc_soil_type_grc, &
+ roughness => atm2lnd_inst%mml_nc_roughness_grc, &
+ emiss => atm2lnd_inst%mml_nc_emiss_grc, &
+ glc_mask => atm2lnd_inst%mml_nc_glcmask_grc, &
+ dust => atm2lnd_inst%mml_nc_dust_grc, &
! temporary diagnostics
- diag1_1d => atm2lnd_inst%mml_diag1_1d_grc , &
- diag2_1d => atm2lnd_inst%mml_diag2_1d_grc , &
- diag3_1d => atm2lnd_inst%mml_diag3_1d_grc , &
- diag1_2d => atm2lnd_inst%mml_diag1_2d_grc , &
- diag2_2d => atm2lnd_inst%mml_diag2_2d_grc , &
- diag3_2d => atm2lnd_inst%mml_diag3_2d_grc &
+ diag1_1d => atm2lnd_inst%mml_diag1_1d_grc, &
+ diag2_1d => atm2lnd_inst%mml_diag2_1d_grc, &
+ diag3_1d => atm2lnd_inst%mml_diag3_1d_grc, &
+ diag1_2d => atm2lnd_inst%mml_diag1_2d_grc, &
+ diag2_2d => atm2lnd_inst%mml_diag2_2d_grc, &
+ diag3_2d => atm2lnd_inst%mml_diag3_2d_grc &
!ddvel_grc => lnd2atm_inst%ddvel_grc & ! lat x lon x 3 dust bins
)
!-----------------------------------------------------------------------
-
-
+
+ SHR_ASSERT_ALL((lbound(tref) == (/bounds%begg/)), errMsg(__FILE__, __LINE__))
+ SHR_ASSERT_ALL((ubound(tref) == (/bounds%endg/)), errMsg(__FILE__, __LINE__))
+
!-----------------------------------------------------------------------
! Assign local values
@@ -445,29 +582,16 @@ subroutine mml_main (bounds, atm2lnd_inst, lnd2atm_inst) !lnd2atm_inst
!-----------------------------------------------------------------------
! Re-assign atmospheric forcing data to simple land model equivalent
! (this is all the "forcing" data
- fsds = atm2lnd_inst%forc_solar_grc
- fsds_dir = atm2lnd_inst%forc_solad_grc
- fsds_dif = atm2lnd_inst%forc_solai_grc
- lwdn = atm2lnd_inst%forc_lwrad_not_downscaled_grc
- zref = atm2lnd_inst%forc_hgt_grc ! Note, there is a u, t , and q height in atm2lnd... compare?
+ ! slevis: I pointed these to their final destinations in the associate
+ ! statment above and left all comments as I found them
! GBB: No need to use the separate values for t, u, q; only need zref
! MML: Keith said there are 3 separate ones for historical reasons, but all three should be the same as zref
- zref_t = atm2lnd_inst%forc_hgt_t_grc
- zref_u = atm2lnd_inst%forc_hgt_u_grc
- zref_q = atm2lnd_inst%forc_hgt_q_grc
- tref = atm2lnd_inst%forc_t_not_downscaled_grc ! is this right? or does atm have a ref height value?
- uref = atm2lnd_inst%forc_wind_grc
- eref = atm2lnd_inst%forc_vp_grc
- qref = atm2lnd_inst%forc_q_not_downscaled_grc
- pref = atm2lnd_inst%forc_pbot_not_downscaled_grc
- rhoair = atm2lnd_inst%forc_rho_not_downscaled_grc
- prec_liq = atm2lnd_inst%forc_rain_not_downscaled_grc
- prec_frz = atm2lnd_inst%forc_snow_not_downscaled_grc
- pco2 = atm2lnd_inst%forc_pco2_grc
- ! For checking the big neg lhflx:
- psrf = atm2lnd_inst%forc_psrf_grc ! surface pressure (Pa)
- pbot = atm2lnd_inst%forc_pbot_not_downscaled_grc ! not downscaled atm pressure (Pa)
- qbot = atm2lnd_inst%forc_q_not_downscaled_grc ! not downscaled atm specific humidity (kg/kg)
+ SHR_ASSERT(numrad == 2, errMsg(sourcefile, __LINE__))
+ SHR_ASSERT_ALL((ubound(fsds_dir) == (/bounds%endg,numrad/)), errMsg(sourcefile, __LINE__))
+ SHR_ASSERT_ALL((lbound(fsds_dir) == (/bounds%begg,1/)), errMsg(sourcefile, __LINE__))
+ SHR_ASSERT_ALL((ubound(atm2lnd_inst%forc_solad_grc) == (/bounds%endg,numrad/)), errMsg(sourcefile, __LINE__))
+ SHR_ASSERT_ALL((lbound(atm2lnd_inst%forc_solad_grc) == (/bounds%begg,1/)), errMsg(sourcefile, __LINE__))
+ ! For checking the big neg lhflx:
! NOTE: this is NOT going to be consistent with CAM, still, if I use pbot and psrf as the "edges" of
! my lowest atm layer; cam uses the actual pressure levels at the edges of the lowermost
! atmospheric layer, but all I've got is pbot (which is likely in the middle of the lowest layer)
@@ -478,25 +602,28 @@ subroutine mml_main (bounds, atm2lnd_inst, lnd2atm_inst) !lnd2atm_inst
! total layer thickness, in pressure, which I should then be able to plug in to their equation.
! Yes, lets do it that way!
- ! Put direct/diffuse fsds vis/nir into right variable to be output:
- fsdsnd = fsds_dir(:,2)
- fsdsvd = fsds_dir(:,1)
- fsdsni = fsds_dif(:,2)
- fsdsvi = fsds_dif(:,1) ! I think? check...
-
- ! Theta = T + 0.0098 * z (Gamma = 0.0098)
- thref = tref + 0.0098_r8 * zref
-
- ! Have to calculate rhomol from the vapor pressure, actual pressure, and actual temperature
- rhomol = pref / (rgas*tref);
- ! rho_mol = (pd + forcvar.eref)/(physcon.rgas * forcvar.tref)
- ! rho_kg = ((pref - eref)*mmdry + eref*mmh2o)/(rgas*tref)
-
- ! MML: might need to move into g loop if I can't figure out how to allocate a matrix of size
- ! begg:endg before I know begg and endg ...
- ! calculate heat capacity based off specific humidity:
- mmair = rhomol / rhoair ! mol/kg
- cpair = cpd * (1._r8 + (cpw/cpd - 1._r8)*qref) ! J/kg/K
+ ! Put direct/diffuse fsds vis/nir into right variable to be output:
+ atm2lnd_inst%mml_atm_fsdsnd_grc(begg:endg) = fsds_dir(begg:endg,2)
+ atm2lnd_inst%mml_atm_fsdsvd_grc(begg:endg) = fsds_dir(begg:endg,1)
+ atm2lnd_inst%mml_atm_fsdsni_grc(begg:endg) = fsds_dif(begg:endg,2)
+ atm2lnd_inst%mml_atm_fsdsvi_grc(begg:endg) = fsds_dif(begg:endg,1)
+ ! slevis: Same for tbot and psrf
+ atm2lnd_inst%mml_atm_tbot_grc(begg:endg) = tref(begg:endg)
+ atm2lnd_inst%mml_atm_psrf_grc(begg:endg) = psrf(begg:endg)
+
+ ! Theta = T + 0.0098 * z (Gamma = 0.0098)
+ thref(begg:endg) = tref(begg:endg) + 0.0098_r8 * zref(begg:endg)
+
+ ! Have to calculate rhomol from the vapor pressure, actual pressure, and actual temperature
+ rhomol(begg:endg) = pref(begg:endg) / (rgas * tref(begg:endg));
+ ! rho_mol = (pd + forcvar.eref)/(physcon.rgas * forcvar.tref)
+ ! rho_kg = ((pref - eref)*mmdry + eref*mmh2o)/(rgas*tref)
+
+ ! MML: might need to move into g loop if I can't figure out how to allocate a matrix of size
+ ! begg:endg before I know begg and endg ...
+ ! calculate heat capacity based off specific humidity:
+ mmair(begg:endg) = rhomol(begg:endg) / rhoair(begg:endg) ! mol/kg
+ cpair(begg:endg) = cpd * (1._r8 + (cpw / cpd - 1._r8) * qref(begg:endg)) ! J/kg/K
! cpair = mmair * cpair_kg ! J/mol/K
! physcon.cpd * (1.0 + (physcon.cpw/physcon.cpd - 1.0) * forcvar.qref) (* mmair);
@@ -514,8 +641,7 @@ subroutine mml_main (bounds, atm2lnd_inst, lnd2atm_inst) !lnd2atm_inst
! Get outside data
!MML: Grab the current model time so we know what month we're in
- call get_curr_date(year, mon, day, sec) ! Actually all I need for now is mon
- mcdate = year*10000 + mon*100 + day
+ call get_curr_date(year, mon, day, sec)
!write(iulog,*)subname, 'MML month = ', mon
!write(iulog,*)subname, 'MML day = ', day
@@ -542,45 +668,27 @@ subroutine mml_main (bounds, atm2lnd_inst, lnd2atm_inst) !lnd2atm_inst
! else
! soil_maxice(begg:endg,i) = 300._r8
! end if
-
! enddo
-
- ! write(iulog,*) 'MML: Yikes! Pre-nc reading, albedo_gvd at some point begg = ', albedo_gvd(begg)
- call t_startf('mml_nc_import')
-
- ! ONLY actually run nc_import if we're on the first timestep of the first day of the month...
- !if (sec <= 1800) then !( day == 1 .and. sec <= 1800) then
- if ( day == 1 .and. sec .le. 1800 ) then
- ! <= 1800 will read it in both first 2 time steps... but after a restart it
- ! seems to start on 1800, not 0, so it needs to be able to read them then, too...
- ! Is there a better way to say "if you haven't still got the last values, read these in?"
- !
- ! Added the nc vars to the restart file, so maybe now I can revert to just saying if sec = 0?
- ! (sec <1800) -> as long as that instance HAPPENS that would work... I think...
- if ( masterproc ) write(iulog,*)'reading netcdf data for mon=',mon,', day=',day,', sec=',sec,')'
-
- call nc_import(begg, endg, mml_nsoi, lfsurdat, mon, &
- albedo_gvd(begg:endg), albedo_svd(begg:endg), &
- albedo_gnd(begg:endg), albedo_snd(begg:endg), &
- albedo_gvf(begg:endg), albedo_svf(begg:endg), &
- albedo_gnf(begg:endg), albedo_snf(begg:endg), &
- snowmask(begg:endg), evaprs(begg:endg), &
- bucket_cap(begg:endg), &
- soil_type(begg:endg), roughness(begg:endg), &
- emiss(begg:endg), glc_mask(begg:endg), dust(begg:endg,:), &
- soil_tk_1d(begg:endg), soil_cv_1d(begg:endg), &
- glc_tk_1d(begg:endg), glc_cv_1d(begg:endg) ) !, &
-
- !write(iulog,*)'read netcdf'
-
- end if
- call t_stopf('mml_nc_import')
-
+ call t_startf('mml_nc_import')
+ ! Read mml_surdat file at the beginning of a run and at the
+ ! beginning of the first day of every month
+ if (is_first_step_of_this_run_segment() .or. (day == 1 .and. sec == 0)) then
+ if ( masterproc ) write(iulog,*)'reading netcdf data for mon=',mon,', day=',day,', sec=',sec,')'
+ call nc_import(begg, endg, mml_nsoi, lfsurdat, mon, &
+ albedo_gvd(begg:endg), albedo_svd(begg:endg), &
+ albedo_gnd(begg:endg), albedo_snd(begg:endg), &
+ albedo_gvf(begg:endg), albedo_svf(begg:endg), &
+ albedo_gnf(begg:endg), albedo_snf(begg:endg), &
+ snowmask(begg:endg), evaprs(begg:endg), &
+ bucket_cap(begg:endg), &
+ soil_type(begg:endg), roughness(begg:endg), &
+ emiss(begg:endg), glc_mask(begg:endg), dust(begg:endg,:), &
+ soil_tk_1d(begg:endg), soil_cv_1d(begg:endg), &
+ glc_tk_1d(begg:endg), glc_cv_1d(begg:endg) )
+ end if
+ call t_stopf('mml_nc_import')
- ! Hard code snowmask and see if it'll run with the new files using that
- !snowmask(begg:endg) = 100.0_r8
-
! *************************************************************
! *** Start the simple model (science part) ***
! *************************************************************
@@ -596,31 +704,28 @@ subroutine mml_main (bounds, atm2lnd_inst, lnd2atm_inst) !lnd2atm_inst
!write(iulog,*)'MML: Commence actually running the model!'
- ! displacement height
- ! for now, set equal to 0.7 * canopy height
- h_disp = 0.7_r8 * roughness
-
- ! Roughness length for momentum
- ! for now, set equal to 0.1 * canopy height
- z0m = 0.1_r8 * roughness
-
- ! Roughness length for heat
- ! for now, set equal to 0.1 * momentum roughness length
- z0h = 0.1_r8 * z0m
-
-
-
- ! snow masking factor
- ! SHOULD ALWAYS BE BETWEEN 0 AND 1!!!!!
-
- ! If snow is negative (it shouldn't be, but if it went a bit neg), set temp = 0
+ begg_to_endg_0: do g = begg, endg
+ ! displacement height
+ ! for now, set equal to 0.7 * canopy height
+ h_disp(g) = 0.7_r8 * roughness(g)
+
+ ! Roughness length for momentum
+ ! for now, set equal to 0.1 * canopy height
+ z0m(g) = 0.1_r8 * roughness(g)
+
+ ! Roughness length for heat
+ ! for now, set equal to 0.1 * momentum roughness length
+ z0h(g) = 0.1_r8 * z0m(g)
+
+ ! snow masking factor
+ ! SHOULD ALWAYS BE BETWEEN 0 AND 1!!!!!
- !temp(begg:endg) = snow(begg:endg)/(snow(begg:endg) + snowmask(begg:endg)) ! snow masking factor
- !diag3_1d = temp
-
+ ! If snow is negative (it shouldn't be, but if it went a bit neg), set temp = 0
-
- do g = begg, endg
+ !temp(begg:endg) = snow(begg:endg)/(snow(begg:endg) + snowmask(begg:endg)) ! snow masking factor
+ !diag3_1d = temp
+
+
! MML 2021.09.29: initialize temp as all zeros, otherwise it might just not have a value in some places!
temp(g) = 0.0_r8
@@ -653,113 +758,103 @@ subroutine mml_main (bounds, atm2lnd_inst, lnd2atm_inst) !lnd2atm_inst
'Instead, snowmasking factor = ',temp(g)
call endrun(msg=errmsg(__FILE__, __LINE__))
end if
-
- end do
- ! -------------------------------------------------------------
- ! Albedo stuff
-
- ! Direct/Diffuse Visible/NIR
- ! for consistent coding, shove vis and nir into a (:,2) sized matrix
- alb_vis_dir(begg:endg) = (1._r8 - temp(begg:endg)) * albedo_gvd(begg:endg) + &
- temp(begg:endg) * albedo_svd(begg:endg)
- alb_nir_dir(begg:endg) = (1._r8 - temp(begg:endg)) * albedo_gnd(begg:endg) + &
- temp(begg:endg) * albedo_snd(begg:endg)
- alb_vis_dif(begg:endg) = (1._r8 - temp(begg:endg)) * albedo_gvf(begg:endg) + &
- temp(begg:endg) * albedo_svf(begg:endg)
- alb_nir_dif(begg:endg) = (1._r8 - temp(begg:endg)) * albedo_gnf(begg:endg) + &
- temp(begg:endg) * albedo_snf(begg:endg)
-
- ! for now, output one of these as albedo_fin just so there is a value:
- !albedo_fin = alb_vis_dir
- diag2_1d = alb_vis_dir
-
- !diag3_1d = alb_vis_dif ! why is the albedo going to 1e22 in h0? try this one...
-
- ! Do something special for albedo where there is a glacier?
- ! at present, I'm just feeding in albedos that already "make sense" for a glacier
-
-
- !albedo_fin = 0.3_r8 ! see if that overwrites...
-
- ! -------------------------------------------------------------
- ! Net radiation
- ! variables from atm: lwdn, fsds, fsds_dir, fsds_dif ! sw is handed as total, direct, and diffuse
- ! variables to end up with: sw_abs, fsr, radforc (into ground)
- !
- ! for lw, emissivity = absorptivity
- ! alpha (albed0) = reflected, so (1-alpha) = absorbed
-
- ! longwave
- lw_abs(begg:endg) = emiss(begg:endg)*lwdn(begg:endg)
- lwup(begg:endg) = (1._r8 - emiss(begg:endg)) * lwdn(begg:endg) ! reflected longwave. Later, add surface emission
- ! Shortwave direct visible
- sw_abs_dir(begg:endg,1) = (1._r8 - alb_vis_dir(begg:endg)) * fsds_dir(begg:endg,1)
- ! Shortwave direct NIR
- sw_abs_dir(begg:endg,2) = (1._r8 - alb_nir_dir(begg:endg)) * fsds_dir(begg:endg,2)
- ! Shortwave diffuse visible
- sw_abs_dif(begg:endg,1) = (1._r8 - alb_vis_dif(begg:endg)) * fsds_dif(begg:endg,1)
- ! Shortwave diffuse NIR
- sw_abs_dif(begg:endg,2) = (1._r8 - alb_nir_dif(begg:endg)) * fsds_dif(begg:endg,2)
-
- !fsr(begg:endg) = alb_vis_dir(begg:endg) * fsds_dir(begg:endg,1) + &
- ! alb_nir_dir(begg:endg) * fsds_dir(begg:endg,2) + &
- ! alb_vis_dif(begg:endg) * fsds_dif(begg:endg,1) + &
- ! alb_nir_dif(begg:endg) * fsds_dif(begg:endg,2)
-
- ! fsr by vis/nir/dir/dif
- fsrnd = alb_nir_dir(begg:endg) * fsds_dir(begg:endg,2)
- fsrni = alb_nir_dif(begg:endg) * fsds_dif(begg:endg,2)
- fsrvd = alb_vis_dir(begg:endg) * fsds_dir(begg:endg,1)
- fsrvi = alb_vis_dif(begg:endg) * fsds_dif(begg:endg,1)
-
- ! put sum of these in diag2, should equal fsr... well, it will. thats math. don't bother.
-
-
- sw_abs(begg:endg) = sw_abs_dir(begg:endg,1) + sw_abs_dir(begg:endg,2) + &
- sw_abs_dif(begg:endg,1) + sw_abs_dif(begg:endg,2)
-
-
- ! should be able to write like:
- fsr(:) = alb_vis_dir * fsds_dir(:,1) + &
- alb_nir_dir * fsds_dir(:,2) + &
- alb_vis_dif * fsds_dif(:,1) + &
- alb_nir_dif * fsds_dif(:,2)
-
- sw_abs(:) = sw_abs_dir(:,1) + sw_abs_dir(:,2) + &
- sw_abs_dif(:,1) + sw_abs_dif(:,2)
-
-
- ! Make output albedo to be a combination of all 4 albedo streams:
- albedo_fin(:) = 1.0e36_r8
- do g = begg, endg
+ ! -------------------------------------------------------------
+ ! Albedo stuff
+
+ ! Direct/Diffuse Visible/NIR
+ ! for consistent coding, shove vis and nir into a (:,2) sized matrix
+ alb_vis_dir(g) = (1._r8 - temp(g)) * albedo_gvd(g) + &
+ temp(g) * albedo_svd(g)
+ alb_nir_dir(g) = (1._r8 - temp(g)) * albedo_gnd(g) + &
+ temp(g) * albedo_snd(g)
+ alb_vis_dif(g) = (1._r8 - temp(g)) * albedo_gvf(g) + &
+ temp(g) * albedo_svf(g)
+ alb_nir_dif(g) = (1._r8 - temp(g)) * albedo_gnf(g) + &
+ temp(g) * albedo_snf(g)
+
+ ! for now, output one of these as albedo_fin just so there is a value:
+ !albedo_fin = alb_vis_dir
+ diag2_1d(g) = alb_vis_dir(g)
+
+ !diag3_1d = alb_vis_dif ! why is the albedo going to 1e22 in h0? try this one...
+
+ ! Do something special for albedo where there is a glacier?
+ ! at present, I'm just feeding in albedos that already "make sense" for a glacier
+
+
+ !albedo_fin = 0.3_r8 ! see if that overwrites...
+
+ ! -------------------------------------------------------------
+ ! Net radiation
+ ! variables from atm: lwdn, fsds, fsds_dir, fsds_dif ! sw is handed as total, direct, and diffuse
+ ! variables to end up with: sw_abs, fsr, radforc (into ground)
+ !
+ ! for lw, emissivity = absorptivity
+ ! alpha (albed0) = reflected, so (1-alpha) = absorbed
+
+ ! longwave
+ lw_abs(g) = emiss(g) * lwdn(g)
+ lwup(g) = (1._r8 - emiss(g)) * lwdn(g) ! reflected longwave. Later, add surface emission
+ ! Shortwave direct visible
+ sw_abs_dir(g,1) = (1._r8 - alb_vis_dir(g)) * fsds_dir(g,1)
+ ! Shortwave direct NIR
+ sw_abs_dir(g,2) = (1._r8 - alb_nir_dir(g)) * fsds_dir(g,2)
+ ! Shortwave diffuse visible
+ sw_abs_dif(g,1) = (1._r8 - alb_vis_dif(g)) * fsds_dif(g,1)
+ ! Shortwave diffuse NIR
+ sw_abs_dif(g,2) = (1._r8 - alb_nir_dif(g)) * fsds_dif(g,2)
+
+ !fsr(g) = alb_vis_dir(g) * fsds_dir(g,1) + &
+ ! alb_nir_dir(g) * fsds_dir(g,2) + &
+ ! alb_vis_dif(g) * fsds_dif(g,1) + &
+ ! alb_nir_dif(g) * fsds_dif(g,2)
+
+ ! fsr by vis/nir/dir/dif
+ fsrnd(g) = alb_nir_dir(g) * fsds_dir(g,2)
+ fsrni(g) = alb_nir_dif(g) * fsds_dif(g,2)
+ fsrvd(g) = alb_vis_dir(g) * fsds_dir(g,1)
+ fsrvi(g) = alb_vis_dif(g) * fsds_dif(g,1)
+
+ ! put sum of these in diag2, should equal fsr... well, it will. thats math. don't bother.
+
+ sw_abs(g) = sw_abs_dir(g,1) + sw_abs_dir(g,2) + &
+ sw_abs_dif(g,1) + sw_abs_dif(g,2)
+
+ ! should be able to write like:
+ fsr(g) = alb_vis_dir(g) * fsds_dir(g,1) + &
+ alb_nir_dir(g) * fsds_dir(g,2) + &
+ alb_vis_dif(g) * fsds_dif(g,1) + &
+ alb_nir_dif(g) * fsds_dif(g,2)
+
+ sw_abs(g) = sw_abs_dir(g,1) + sw_abs_dir(g,2) + &
+ sw_abs_dif(g,1) + sw_abs_dif(g,2)
+
+ ! Make output albedo to be a combination of all 4 albedo streams:
fsds_tot = fsds_dir(g,1) + fsds_dir(g,2) + fsds_dif(g,1) + fsds_dif(g,2)
if ( fsds_tot > 0.0_r8 )then
albedo_fin(g) = fsr(g) / fsds_tot
+ else
+ albedo_fin(g) = 1.0e36_r8
end if
- end do
- ! temporary fix:
- !lw_abs(begg:endg) = lwdn(begg:endg)
- !sw_abs(begg:endg) = 0.7*fsds(begg:endg)
-
-
- radforc(begg:endg) = lw_abs(begg:endg) + sw_abs(begg:endg)
-
-
- !-----------------------------------------------------------------------
- ! Initial Checks -> crash run if these fail
-
- do g = begg, endg
-
- if ( zref(g) < h_disp(g) ) then
- write(iulog,*)'Error: Forcing height is below canopy displacement height (zref < h_disp) '
- call endrun(msg=errmsg(__FILE__, __LINE__))
- end if
-
- end do
+
+ ! temporary fix:
+ !lw_abs(g) = lwdn(g)
+ !sw_abs(g) = 0.7*fsds(g)
+ radforc(g) = lw_abs(g) + sw_abs(g)
+ !-----------------------------------------------------------------------
+ ! Initial Checks -> crash run if these fail
+
+ if ( zref(g) < h_disp(g) ) then
+ write(iulog,*)'Error: Forcing height is below canopy displacement height (zref < h_disp) '
+ call endrun(msg=errmsg(__FILE__, __LINE__))
+ end if
+
+ end do begg_to_endg_0
+
! -------------------------------------------------------------
! -------- Monin-Obukhov Stuff
! -------------------------------------------------------------
@@ -811,21 +906,20 @@ subroutine mml_main (bounds, atm2lnd_inst, lnd2atm_inst) !lnd2atm_inst
! calculate aerodynamic resistances for momentum (ram) and heat (rah) in [s/m], and
! the effective resistance combining ram with the canopy resistance (res)
- ram(:) = uref / (ustar * ustar) ! [s/m] = [m/s] / ([m/s] * [m/s])
- rah(:) = (thref - tsrf) / (ustar * tstar) ! [s/m] = [K] / ([m/s] * [K])
- res(:) = (evaprs + rah) ! [s/m]
+ ram(begg:endg) = uref(begg:endg) / (ustar(begg:endg) * ustar(begg:endg)) ! [s/m] = [m/s] / ([m/s] * [m/s])
+ rah(begg:endg) = (thref(begg:endg) - tsrf(begg:endg)) / (ustar(begg:endg) * tstar(begg:endg)) ! [s/m] = [K] / ([m/s] * [K])
+ res(begg:endg) = (evaprs(begg:endg) + rah(begg:endg)) ! [s/m]
! cap res at 100,000 ()
- where ( res > 100000. )
- res(:) = 100000.0_r8
- end where
-
+ where ( res(begg:endg) > 100000.0_r8 )
+ res = 100000.0_r8
+ end where
! GBB: See what GFDL does for its evaporative resistance; should be a function
- ! of stomatal conductance and LAI
-
- ! Save initial temperature profile for energy conservation check:
- tsoi0(:,:) = tsoi
+ ! of stomatal conductance and LAI
+
+ ! Save initial temperature profile for energy conservation check:
+ tsoi0(begg:endg,:) = tsoi(begg:endg,:)
! Call soil thermal properties for this time step: (right now, it doesn't matter b/c
! it doesn't have water dependence, or soil type dependence, for that matter,
@@ -894,30 +988,30 @@ subroutine mml_main (bounds, atm2lnd_inst, lnd2atm_inst) !lnd2atm_inst
! GBB: hsub is used if snow is on the ground (check GFDL code). Or CLM uses hvap
! (gfdl says sublimation if snow, CLM says sublimation if frozen... check and make sure,
! then choose one and run with it)
- lambda(:) = hvap
- where ( tsrf < tfrz) lambda(:) = hsub
-
-
- ! Psychometric Constant [Pa/K]
- gamma(:) = cpair(:) * pref(:) / lambda(:) ! [J/kg/K] * [Pa] / [J/kg]
-
- !lhflx(:) = lambda
-
+ lambda(begg:endg) = hvap
+ where ( tsrf(begg:endg) < tfrz) lambda = hsub
+
+
+ ! Psychometric Constant [Pa/K]
+ gamma(begg:endg) = cpair(begg:endg) * pref(begg:endg) / lambda(begg:endg) ! [J/kg/K] * [Pa] / [J/kg]
+
+ !lhflx(:) = lambda
+
! --------------------------------------------------
- ! ---- Surface Fluxes
- ! --------------------------------------------------
+ ! ---- Surface Fluxes
+ ! --------------------------------------------------
! Emitted longwave radiation from surface [W/m2] and temperature derivative [W/m2/K]
- lwrad(:) = emiss * sigma * tsrf**4
- dlwrad(:) = 4.0_r8 * emiss * sigma * tsrf**3
- ! GBB: dlwrad(:) = 4.0_r8 * emiss * sigma * tsrf**3
- ! The exponents do not need to be real; but the factor 4 should be real
-
- ! Sensible heat flux [W/m2] and temperature derivative [W/m2/K]
- ! GBB: Need to multiply by rhoair: J/s/m2 = kg/m3 * J/kg/K * K * m/s
- shflx(:) = cpair * (tsrf - thref) / rah * rhoair ! [W/m2] = [J/kg/K] * [K] / [s/m] * [kg/m3]
- dshflx(:) = cpair / rah * rhoair ! [W/m2/K] = [J/kg/K] / [s/m] * [ kg/m3]
-
+ lwrad(begg:endg) = emiss(begg:endg) * sigma * tsrf(begg:endg)**4
+ dlwrad(begg:endg) = 4.0_r8 * emiss(begg:endg) * sigma * tsrf(begg:endg)**3
+ ! GBB: dlwrad(:) = 4.0_r8 * emiss * sigma * tsrf**3
+ ! The exponents do not need to be real; but the factor 4 should be real
+
+ ! Sensible heat flux [W/m2] and temperature derivative [W/m2/K]
+ ! GBB: Need to multiply by rhoair: J/s/m2 = kg/m3 * J/kg/K * K * m/s
+ shflx(begg:endg) = cpair(begg:endg) * (tsrf(begg:endg) - thref(begg:endg)) / rah(begg:endg) * rhoair(begg:endg) ! [W/m2] = [J/kg/K] * [K] / [s/m] * [kg/m3]
+ dshflx(begg:endg) = cpair(begg:endg) / rah(begg:endg) * rhoair(begg:endg) ! [W/m2/K] = [J/kg/K] / [s/m] * [ kg/m3]
+
! Latent heat flux [W/m2] and temperature derivative [W/m2/K]
! (check if lhflx > water available in snow and soil, in which case limit lhflx
! to available water; also, if there is snow, don't use soil moisture as a factor)
@@ -941,272 +1035,260 @@ subroutine mml_main (bounds, atm2lnd_inst, lnd2atm_inst) !lnd2atm_inst
! MML: plan - use qsat instead of esat, by calling CLM function QSat. Modify these
! equations accordingly (and check units!!!!)
- ! Initialize beta = 1.0 (no extra bucket resistance) everywhere. Overwrite with smaller values where appropriate.
- beta(:) = 1.0_r8
-
- ! similarly initialize mml_lnd_effective_res_grc and mml_lnd_res_grc to avoid nans
- atm2lnd_inst%mml_lnd_effective_res_grc = 1.0_r8 !9999.99_r8
- atm2lnd_inst%mml_lnd_res_grc = 1.0_r8 ! 9999.99_r8
-
- where ( snow <= 0 )
- beta(:) = min ( water/(.75 * bucket_cap) , 1.0_r8 ) ! scaling factor [unitless]
- ! OH I bet the problem is that I only end up defining beta in places where snow<0 -- hence the nan problem!!! So I should initialize
- ! a starting beta matrix where everywhere is 1.0 or something!
- ! add minimum beta value in case water is negative?
- !lhflx(:) = cpair / gamma * (esat - eref) / res * beta * rhoair ! [W/m2] = [J/kg/K] / [Pa/K] * [Pa] / [s/m] * [unitless] * [kg/m3]
- !dlhflx(:) = cpair / gamma * desat / res * beta * rhoair ! [W/m2/K]
- lhflx(:) = rhoair * lambda * (qsrf - qref) * beta / res ! [W/m2] = [kg/m3] * [J/kg] * [kg/kg] * [unitless] / [s/m] -> kg/m3 * J/kg * m/s = kg/kg J/s 1/m2 = W/m2
- dlhflx(:) = rhoair * lambda * dqsrf * beta / res ! [W/m2/K] = [kg/m3] * [J/kg] * [kg/kg/K] * [unitless] / [s/m] -> kg/m3 * J/kg * 1/K * m/s -> J/s /K /m2 = W/m2/K
- ! got here doing unit analysis - make sure this is actually the right equation!!!
- end where
-
- ! make sure beta isn't negative (if neg, set equal to 0)
- where ( beta <= 0.0 )
- beta(:) = 0.0_r8
- end where
-
- where ( snow > 0 ) ! go where there is snow and overwrite the value of lhflx and dlhflx
- !lhflx(:) = cpair / gamma * ( esat - eref ) / res * rhoair ! [W/m2]
- !dlhflx(:) = cpair / gamma * desat / res * rhoair ! [W/m2]
- lhflx(:) = rhoair * lambda * (qsrf - qref) / res ! [W/m2] = [kg/m3] * [J/kg] * [kg/kg] * [unitless] / [s/m] -> kg/m3 * J/kg * m/s = kg/kg J/s 1/m2 = W/m2
- dlhflx(:) = rhoair * lambda * dqsrf / res ! [W/m2/K] = [kg/m3] * [J/kg] * [kg/kg/K] * [unitless] / [s/m] -> kg/m3 * J/kg * 1/K * m/s -> J/s /K /m2 = W/m2/K
- end where
-
- ! Check if we tried to evaporate more water than is available
- ! ... probably isn't the sneakiest way to do this... what if dlhflx is <0? then we might
- ! be okay - would have to check at end of time step...
- where ( lhflx * dt / lambda > ( water + snow ) ) ! [W/m2] * [s] / [J/kg] -> W * [s/J] * kg/m2 = kg/m2
- !write(iulog,*)subname, 'MML tried to evaporate more water than there is in snow + water, adjusting accordingly'
- !lhflx(:) = lambda / dt * ( water + snow ) * rhoair ! [W/m2]
- !dlhflx(:) = 0._r8 ! [W/m2]
- lhflx(:) = lambda / dt * ( water + snow ) ! [W/m2] = [J/kg] / [s] * [kg/m2] -> J/s * kg/kg/m2 = W/m2
- dlhflx(:) = 0._r8 ! [W/m2/K]
- end where
-
-
-
-
-
- ! Net flux of energy into soil [W/m2] and temperature derivative [W/m2/K] from the
- ! surface energy imbalance given other fluxes:
- f0(:) = radforc - ( lwrad + lhflx + shflx ) ! [W/m2]
- df0(:) = - ( dlwrad + dlhflx + dshflx ) ! [W/m2]
-
- ! lets temporarily save this value out as gsoi (not the real gsoi, but the right "family"
- gsoi(:) = f0 ! [W/m2]
-
-
- ! -------------------------------------------------------------
- ! Initial pass at soil temperatures
- ! -------------------------------------------------------------
-
- ! Initial change in soil temperatures = 0
- dtsoi(:,:) = 0.0_r8 ! see if this helps?
-
- ! -------------------------------------------------------------
- ! Set up tri-diagonal matrix
-
- ! surface
- i = 1
-
- aa(:,i) = 0.0_r8
- cc(:,i) = -soil_tkh(:,i) / ( soil_z(:,i) - soil_z(:,i+1) )
- bb(:,i) = soil_cv(:,i) * soil_dz(:,i) / dt - cc(:,i) - df0
- dd(:,i) = -soil_tkh(:,i) * ( tsoi(:,i) - tsoi(:,i+1) ) / ( soil_z(:,i) - soil_z(:,i+1) ) + f0
-
- ! layers 2 to nsoi-1
- dummy = mml_nsoi - 1
- do i = 2, dummy
- aa(:,i) = -soil_tkh(:,i-1) / ( soil_z(:,i-1) - soil_z(:,i) )
- cc(:,i) = -soil_tkh(:,i) / ( soil_z(:,i) - soil_z(:,i+1) )
- bb(:,i) = soil_cv(:,i) * soil_dz(:,i) / dt - aa(:,i) - cc(:,i)
- dd(:,i) = soil_tkh(:,i-1) * ( tsoi(:,i-1) - tsoi(:,i) ) / (soil_z(:,i-1) - soil_z(:,i)) &
- - soil_tkh(:,i) * (tsoi(:,i) - tsoi(:,i+1)) / (soil_z(:,i) - soil_z(:,i+1))
- end do
-
- ! Bottom soil layer
- i = mml_nsoi
- aa(:,i) = -soil_tkh(:,i-1) / (soil_z(:,i-1) - soil_z(:,i))
- cc(:,i) = 0.0_r8
- bb(:,i) = soil_cv(:,i) * soil_dz(:,i) / dt - aa(:,i)
- dd(:,i) = soil_tkh(:,i-1) * (tsoi(:,i-1) - tsoi(:,i)) / (soil_z(:,i-1) - soil_z(:,i))
-
- ! ----------------------------------------------------------
- ! Begin forward (upward) sweep of tridiagonal matrix from layer N to 1
-
- ! Bottom soil layer
- i = mml_nsoi
- ee(:,i) = aa(:,i) / bb(:,i)
- ff(:,i) = dd(:,i) / bb(:,i)
-
- ! Layers nsoi-1 to 2
- dummy = mml_nsoi-1
- do i = dummy, 2, -1
- den = bb(:,i) - cc(:,i)*ee(:,i+1)
- ee(:,i) = aa(:,i) / den
- ff(:,i) = (dd(:,i) - cc(:,i)*ff(:,i+1)) / den
- end do
-
- ! Complete tridiagonal sol'n to get initial temperature guess for top soil layer
- i = 1
- num = dd(:,i) - cc(:,i) * ff(:,i+1)
- den = bb(:,i) - cc(:,i) * ee(:,i+1)
- tsrf = tsoi0(:,i) + num/den
-
-
- !write(iulog,*)subname, 'MML new tridiagonal solver IS being used'
-
- ! -------------------------------------------------------------
- ! Snow accounting:
- ! if tsrf>freezing and there is snow on the ground, melt some snow!
- ! -------------------------------------------------------------
-
- !t_to_snow(:) = soil_cv(:,1) * soil_dz(:,1) / hfus ! factor to convert a change in temperature to snow melt
-
- ! how much snow can we melt given the temperature?
- snow_melt = 0.0_r8
- !where ( snow > 0.0_r8 .and. tsrf > tfrz) snow_melt(:) = (tsrf(:) - tfrz) * den(:) * t_to_snow(:)
-
- ! Maximum snow melt RATE based on temperature above freezing:
- ptl_snow_melt(:) = max(0.0 , (tsrf(:) - tfrz) * den(:) / hfus)
- !where ( snow > 0.0_r8 .and. tsrf > tfrz) snow_melt(:) = (tsrf(:) - tfrz) * den(:) / hfus
-
- ! Maximum melt RATE is the rate it would take to melt all the snow that is currently present:
- max_snow_melt(:) = snow / dt
-
- ! Set actual snow melt RATE to either the total the potential (if enough snow is present) or the total (if enoguh energy is present)
- snow_melt(:) = min( max_snow_melt(:) , ptl_snow_melt(:) )
-
- ! Energy flux associated with realized snow melt
- gsnow(:) = snow_melt(:) * hfus ! [kg/m2/s]*[J/kg] = [J/s/m2] = [W/m2]
-
- ! Recalculate melt based off how much snow is actually present (can't melt more
- ! than what is actually present)
- ! If we have more energy than snow to melt, update surface temperature accordingly
- !where ( snow > 0.0_r8 .and. snow_melt > 0.0_r8 .and. snow_melt <= snow ) tsrf(:) = tfrz ! where snow_melt < snow, temperature stays at freezing
- !where ( snow > 0.0_r8 .and. snow_melt > 0.0_r8 .and. snow_melt > snow )
- ! snow_melt(:) = snow ! melt all available snow
- ! tsrf(:) = tsoi(:,1) + (num(:) - snow_melt(:)/t_to_snow(:))/den(:)
- !end where
-
- ! Update snow and water buckets accordingly -> convert to water units, not rates
- snow(:) = snow - snow_melt*dt ! [kg/m2] = [kg/m2] - [kg/m2/s]*[s]
- water(:) = water + snow_melt*dt
-
- ! Update surface temperature to reflect snow melt:
- ! If there is no snow melt, tsoi(1) = tsrf as above, unmodified
- ! While snow is actively melting, tsrf should be tfrz
- ! If snow melt was less than the total energy, tsrf should be > trfz but less tahn tsrf above
- tsoi(:,1) = tsoi(:,1) + (num - gsnow) / den;
- dtsoi(:,1) = tsoi(:,1) - tsoi0(:,1)
-
-
- ! -------------------------------------------------------------
- ! Complete the tri-diagonal solver for soil temperature given we now know the
- ! surface temperature after snow melting
- ! -------------------------------------------------------------
-
- !dtsoi(:,1) = tsrf(:) - tsoi(:,1) ! save change in top soil layer
- !tsoi(:,1) = tsrf(:) ! update top soil layer to be surface temperature
-
- !------ Complete tri-diagonal solver (downwards sweep)
- do i = 2,mml_nsoi
- dtsoi(:,i) = ff(:,i) - ee(:,i)*dtsoi(:,i-1)
- tsoi(:,i) = tsoi(:,i) + dtsoi(:,i)
- end do
-
- !dummy = mml_nsoi - 1
- !do i = 1, dummy
- ! dtsoi(:,i+1) = dp(:,i) + cp(:,i)*dtsoi(:,i) ! ah, this hsould have been i+1
- ! tsoi(:,i+1) = tsoi(:,i+1) + dtsoi(:,i+1) ! old tsoi + dtsoi
- !end do
-
-
- ! -------------------------------------------------------------
- ! Update surface energy fluxes based on the change in surface temperature
- ! -------------------------------------------------------------
-
- lwrad(:) = lwrad + dlwrad * dtsoi(:,1)
- lhflx(:) = lhflx + dlhflx * dtsoi(:,1) ! if lhflx = snow+water, dlhflx = 0
- shflx(:) = shflx + dshflx * dtsoi(:,1)
- ! and the ground energy flux:
- gsoi(:) = f0 + df0 * dtsoi(:,1)
-
- ! split energy flux into ground into flux into soil (gsoi) and snow (gsnow)
- gsoi(:) = gsoi(:) - gsnow(:)
- !gsoi(:) = gsoi - snow_melt / dt * hfus
- !gsnow(:) = snow_melt / dt * hfus
-
-
- ! Energy conservation check:
- ! Sum change in energy (W/m2)
- edif(:) = 0._r8
- do i = 1,mml_nsoi
- edif(:) = edif(:) + soil_cv(:,i) * soil_dz(:,i) * ( tsoi(:,i) - tsoi0(:,i) ) / dt
- end do
- ! Energy conservation check:
- err(:) = 0._r8
- err(:) = edif(:) - gsoi(:)
- do g = begg,endg
- if ( abs( err(g) ) > 1.0e-06 ) then
- write(iulog,*)subname, 'MML ERROR: Soil temperature energy conservation error: pre-phase change'
- call endrun(msg=errmsg(__FILE__, __LINE__))
- end if
- end do
-
- ! Maybe should be checking lhflx HERE for if it is larger than water+snow
-
-
- lwup(:) = lwup + lwrad ! reflected longwave (0 at the moment) plus sigma*T^4
-
-
- ! -------------------------------------------------------------
- ! TO DO:
- ! If lhflx < 0 and the total amount of water the land tries to suck out of the atmosphere is
- ! larger than the total water available in the lowest level of the atmosphere, cap the negative LHFLX
- ! at the amount of water in the atm_bot and put the excess energy into SHFLX (cam has a check
- ! that does this (qneg4.f90)
-
- ! check 1: if evap*dt > water + snow at this point, take excess and put into sensible heat flux?
- do g = begg, endg
- if ( lhflx(g) * dt / lambda(g) > (water(g) + snow(g)) ) then
- !where ( lhflx * dt / lambda > (water + snow) )
- temp(g) = lhflx(g) - (water(g) + snow(g)) * lambda(g) / dt !excess energy that we don't have water for
- lhflx(g) = lhflx(g) - temp(g) ! remove the excess from lh
- shflx(g) = shflx(g) + temp(g) ! give it to shflx ... ask Gordon about a better way to do this...
- write(iulog,*)subname, 'MML Warning: lhflx > available water; put excess in shflx'
- !end where
- end if ! put in an if loop just so I could get it to write the warning
- end do
-
-
- ! MML 2021.09.13: move update of evap (in water units) to AFTER the lh/sh check - otherwise lh and evap won't match (once put into proper units)
-
- ! LHFLX in water units [kg/m2/s = mm/s]
- ! update evap(g)
- !evap(:) = lhflx * dt / lambda
- evap(:) = lhflx / lambda ! kg/m2/s or mm/s, NOT times dt!!!!
+ ! Initialize beta = 1.0 (no extra bucket resistance) everywhere. Overwrite with smaller values where appropriate.
+ beta(begg:endg) = 1.0_r8
+
+ ! similarly initialize mml_lnd_effective_res_grc and mml_lnd_res_grc to avoid nans
+ atm2lnd_inst%mml_lnd_effective_res_grc(begg:endg) = 1.0_r8 !9999.99_r8
+ atm2lnd_inst%mml_lnd_res_grc(begg:endg) = 1.0_r8 ! 9999.99_r8
+
+ where ( snow(begg:endg) <= 0 )
+ beta = min ( water / (0.75_r8 * bucket_cap) , 1.0_r8 ) ! scaling factor [unitless]
+ ! OH I bet the problem is that I only end up defining beta in places where snow<0 -- hence the nan problem!!! So I should initialize
+ ! a starting beta matrix where everywhere is 1.0 or something!
+ ! add minimum beta value in case water is negative?
+ !lhflx(:) = cpair / gamma * (esat - eref) / res * beta * rhoair ! [W/m2] = [J/kg/K] / [Pa/K] * [Pa] / [s/m] * [unitless] * [kg/m3]
+ !dlhflx(:) = cpair / gamma * desat / res * beta * rhoair ! [W/m2/K]
+ lhflx = rhoair * lambda * (qsrf - qref) * beta / res ! [W/m2] = [kg/m3] * [J/kg] * [kg/kg] * [unitless] / [s/m] -> kg/m3 * J/kg * m/s = kg/kg J/s 1/m2 = W/m2
+ dlhflx = rhoair * lambda * dqsrf * beta / res ! [W/m2/K] = [kg/m3] * [J/kg] * [kg/kg/K] * [unitless] / [s/m] -> kg/m3 * J/kg * 1/K * m/s -> J/s /K /m2 = W/m2/K
+ ! got here doing unit analysis - make sure this is actually the right equation!!!
+ end where
+
+ ! make sure beta isn't negative (if neg, set equal to 0)
+ where ( beta(begg:endg) <= 0.0_r8 )
+ beta = 0.0_r8
+ end where
+
+ where ( snow(begg:endg) > 0 ) ! go where there is snow and overwrite the value of lhflx and dlhflx
+ !lhflx(:) = cpair / gamma * ( esat - eref ) / res * rhoair ! [W/m2]
+ !dlhflx(:) = cpair / gamma * desat / res * rhoair ! [W/m2]
+ lhflx = rhoair * lambda * (qsrf - qref) / res ! [W/m2] = [kg/m3] * [J/kg] * [kg/kg] * [unitless] / [s/m] -> kg/m3 * J/kg * m/s = kg/kg J/s 1/m2 = W/m2
+ dlhflx = rhoair * lambda * dqsrf / res ! [W/m2/K] = [kg/m3] * [J/kg] * [kg/kg/K] * [unitless] / [s/m] -> kg/m3 * J/kg * 1/K * m/s -> J/s /K /m2 = W/m2/K
+ end where
+
+ ! Check if we tried to evaporate more water than is available
+ ! ... probably isn't the sneakiest way to do this... what if dlhflx is <0? then we might
+ ! be okay - would have to check at end of time step...
+ where ( lhflx(begg:endg) * dt / lambda(begg:endg) > ( water(begg:endg) + snow(begg:endg) ) ) ! [W/m2] * [s] / [J/kg] -> W * [s/J] * kg/m2 = kg/m2
+ !write(iulog,*)subname, 'MML tried to evaporate more water than there is in snow + water, adjusting accordingly'
+ !lhflx(:) = lambda / dt * ( water + snow ) * rhoair ! [W/m2]
+ !dlhflx(:) = 0._r8 ! [W/m2]
+ lhflx = lambda / dt * ( water + snow ) ! [W/m2] = [J/kg] / [s] * [kg/m2] -> J/s * kg/kg/m2 = W/m2
+ dlhflx = 0._r8 ! [W/m2/K]
+ end where
- ! -------------------------------------------------------------
- ! Check that dew doesn't exceed water available in lowest atm level
- ! -------------------------------------------------------------
- ! check 2: if evap*dt < 0 and requires more water than is available in the bottom of the atmosphere,
- ! that is bad... the atmosphere corrects for it, but I want the atm and land to be self-consistent...
- ! TODO STILL!
- ! GBB: CLM does not do this
- !
- ! MML: implement a check for this (go back to CAM QNEG3 OR QNEG4 to check how CAM does it)
- ! Then limit the CLM LHFLX to whatever CAM is going to adjust it to. Also, print out how
- ! big that energy difference is and save it somewhere - it'll be big in the first couple
- ! of time steps, but I'm not sure how big/negligible it is after the model is sort of spun
- ! up. Gordon said there was O(1) W/m2 of energy that sort of gets lost in the coupled
- ! model - I'm curious if this contributes to that, or if this is totally negligible once
- ! the models spins up.
- ! (What CAM does is takes the excess energy that was in LHFLX (but there isn't enough water available
- ! in the lower level of the atmosphere for) and adds it to the SHFLX, so its still conserving ENERGY
- ! (ie shouldn't be a source of an energy leak), but its changing the PATHWAY the energy takes.
-
+ begg_to_endg_1: do g = begg, endg
+ ! Net flux of energy into soil [W/m2] and temperature derivative [W/m2/K] from the
+ ! surface energy imbalance given other fluxes:
+ f0(g) = radforc(g) - ( lwrad(g) + lhflx(g) + shflx(g) ) ! [W/m2]
+ df0(g) = - ( dlwrad(g) + dlhflx(g) + dshflx(g) ) ! [W/m2]
+
+ ! lets temporarily save this value out as gsoi (not the real gsoi, but the right "family"
+ gsoi(g) = f0(g) ! [W/m2]
+
+
+ ! -------------------------------------------------------------
+ ! Initial pass at soil temperatures
+ ! -------------------------------------------------------------
+
+ ! Initial change in soil temperatures = 0
+ dtsoi(g,:) = 0.0_r8 ! see if this helps?
+
+ ! -------------------------------------------------------------
+ ! Set up tri-diagonal matrix
+
+ ! surface
+ i = 1
+
+ aa(g,i) = 0.0_r8
+ cc(g,i) = -soil_tkh(g,i) / ( soil_z(g,i) - soil_z(g,i+1) )
+ bb(g,i) = soil_cv(g,i) * soil_dz(g,i) / dt - cc(g,i) - df0(g)
+ dd(g,i) = -soil_tkh(g,i) * ( tsoi(g,i) - tsoi(g,i+1) ) / ( soil_z(g,i) - soil_z(g,i+1) ) + f0(g)
+
+ ! layers 2 to nsoi-1
+ dummy = mml_nsoi - 1
+ do i = 2, dummy
+ aa(g,i) = -soil_tkh(g,i-1) / ( soil_z(g,i-1) - soil_z(g,i) )
+ cc(g,i) = -soil_tkh(g,i) / ( soil_z(g,i) - soil_z(g,i+1) )
+ bb(g,i) = soil_cv(g,i) * soil_dz(g,i) / dt - aa(g,i) - cc(g,i)
+ dd(g,i) = soil_tkh(g,i-1) * ( tsoi(g,i-1) - tsoi(g,i) ) / (soil_z(g,i-1) - soil_z(g,i)) &
+ - soil_tkh(g,i) * (tsoi(g,i) - tsoi(g,i+1)) / (soil_z(g,i) - soil_z(g,i+1))
+ end do
+
+ ! Bottom soil layer
+ i = mml_nsoi
+ aa(g,i) = -soil_tkh(g,i-1) / (soil_z(g,i-1) - soil_z(g,i))
+ cc(g,i) = 0.0_r8
+ bb(g,i) = soil_cv(g,i) * soil_dz(g,i) / dt - aa(g,i)
+ dd(g,i) = soil_tkh(g,i-1) * (tsoi(g,i-1) - tsoi(g,i)) / (soil_z(g,i-1) - soil_z(g,i))
+
+ ! ----------------------------------------------------------
+ ! Begin forward (upward) sweep of tridiagonal matrix from layer N to 1
+
+ ! Bottom soil layer
+ i = mml_nsoi
+ ee(g,i) = aa(g,i) / bb(g,i)
+ ff(g,i) = dd(g,i) / bb(g,i)
+
+ ! Layers nsoi-1 to 2
+ dummy = mml_nsoi-1
+ do i = dummy, 2, -1
+ den = bb(g,i) - cc(g,i) * ee(g,i+1)
+ ee(g,i) = aa(g,i) / den(g)
+ ff(g,i) = (dd(g,i) - cc(g,i) * ff(g,i+1)) / den(g)
+ end do
+
+ ! Complete tridiagonal sol'n to get initial temperature guess for top soil layer
+ i = 1
+ num = dd(g,i) - cc(g,i) * ff(g,i+1)
+ den = bb(g,i) - cc(g,i) * ee(g,i+1)
+ tsrf(g) = tsoi0(g,i) + num(g) / den(g)
+
+ !write(iulog,*)subname, 'MML new tridiagonal solver IS being used'
+
+ ! -------------------------------------------------------------
+ ! Snow accounting:
+ ! if tsrf>freezing and there is snow on the ground, melt some snow!
+ ! -------------------------------------------------------------
+
+ !t_to_snow(:) = soil_cv(:,1) * soil_dz(:,1) / hfus ! factor to convert a change in temperature to snow melt
+
+ ! how much snow can we melt given the temperature?
+ snow_melt(g) = 0.0_r8
+ !where ( snow > 0.0_r8 .and. tsrf > tfrz) snow_melt(:) = (tsrf(:) - tfrz) * den(:) * t_to_snow(:)
+
+ ! Maximum snow melt RATE based on temperature above freezing:
+ ptl_snow_melt(g) = max(0.0 , (tsrf(g) - tfrz) * den(g) / hfus)
+ !where ( snow > 0.0_r8 .and. tsrf > tfrz) snow_melt(:) = (tsrf(:) - tfrz) * den(:) / hfus
+
+ ! Maximum melt RATE is the rate it would take to melt all the snow that is currently present:
+ max_snow_melt(g) = snow(g) / dt
+
+ ! Set actual snow melt RATE to either the total the potential (if enough snow is present) or the total (if enoguh energy is present)
+ snow_melt(g) = min( max_snow_melt(g) , ptl_snow_melt(g) )
+
+ ! Energy flux associated with realized snow melt
+ gsnow(g) = snow_melt(g) * hfus ! [kg/m2/s]*[J/kg] = [J/s/m2] = [W/m2]
+
+ ! Recalculate melt based off how much snow is actually present (can't melt more
+ ! than what is actually present)
+ ! If we have more energy than snow to melt, update surface temperature accordingly
+ !where ( snow > 0.0_r8 .and. snow_melt > 0.0_r8 .and. snow_melt <= snow ) tsrf(:) = tfrz ! where snow_melt < snow, temperature stays at freezing
+ !where ( snow > 0.0_r8 .and. snow_melt > 0.0_r8 .and. snow_melt > snow )
+ ! snow_melt(:) = snow ! melt all available snow
+ ! tsrf(:) = tsoi(:,1) + (num(:) - snow_melt(:)/t_to_snow(:))/den(:)
+ !end where
+
+ ! Update snow and water buckets accordingly -> convert to water units, not rates
+ snow(g) = snow(g) - snow_melt(g) * dt ! [kg/m2] = [kg/m2] - [kg/m2/s]*[s]
+ water(g) = water(g) + snow_melt(g) * dt
+
+ ! Update surface temperature to reflect snow melt:
+ ! If there is no snow melt, tsoi(1) = tsrf as above, unmodified
+ ! While snow is actively melting, tsrf should be tfrz
+ ! If snow melt was less than the total energy, tsrf should be > trfz but less tahn tsrf above
+ tsoi(g,1) = tsoi(g,1) + (num(g) - gsnow(g)) / den(g)
+ dtsoi(g,1) = tsoi(g,1) - tsoi0(g,1)
+
+ ! -------------------------------------------------------------
+ ! Complete the tri-diagonal solver for soil temperature given we now know the
+ ! surface temperature after snow melting
+ ! -------------------------------------------------------------
+
+ !dtsoi(:,1) = tsrf(:) - tsoi(:,1) ! save change in top soil layer
+ !tsoi(:,1) = tsrf(:) ! update top soil layer to be surface temperature
+
+ !------ Complete tri-diagonal solver (downwards sweep)
+ do i = 2,mml_nsoi
+ dtsoi(g,i) = ff(g,i) - ee(g,i) * dtsoi(g,i-1)
+ tsoi(g,i) = tsoi(g,i) + dtsoi(g,i)
+ end do
+
+ !dummy = mml_nsoi - 1
+ !do i = 1, dummy
+ ! dtsoi(:,i+1) = dp(:,i) + cp(:,i)*dtsoi(:,i) ! ah, this should have been i+1
+ ! tsoi(:,i+1) = tsoi(:,i+1) + dtsoi(:,i+1) ! old tsoi + dtsoi
+ !end do
+
+ ! -------------------------------------------------------------
+ ! Update surface energy fluxes based on the change in surface temperature
+ ! -------------------------------------------------------------
+
+ lwrad(g) = lwrad(g) + dlwrad(g) * dtsoi(g,1)
+ lhflx(g) = lhflx(g) + dlhflx(g) * dtsoi(g,1) ! if lhflx = snow+water, dlhflx = 0
+ shflx(g) = shflx(g) + dshflx(g) * dtsoi(g,1)
+ ! and the ground energy flux:
+ gsoi(g) = f0(g) + df0(g) * dtsoi(g,1)
+
+ ! split energy flux into ground into flux into soil (gsoi) and snow (gsnow)
+ gsoi(g) = gsoi(g) - gsnow(g)
+ !gsoi(g) = gsoi(g) - snow_melt(g) / dt * hfus
+ !gsnow(g) = snow_melt(g) / dt * hfus
+
+
+ ! Energy conservation check:
+ ! Sum change in energy (W/m2)
+ edif(g) = 0._r8
+ do i = 1,mml_nsoi
+ edif(g) = edif(g) + soil_cv(g,i) * soil_dz(g,i) * ( tsoi(g,i) - tsoi0(g,i) ) / dt
+ end do
+ ! Energy conservation check:
+ err(g) = 0._r8
+ err(g) = edif(g) - gsoi(g)
+
+ if ( abs( err(g) ) > 1.0e-06 ) then
+ write(iulog,*)subname, 'MML ERROR: Soil temperature energy conservation error: pre-phase change'
+ call endrun(msg=errmsg(__FILE__, __LINE__))
+ end if
+
+ ! Maybe should be checking lhflx HERE for if it is larger than water+snow
+
+ lwup(g) = lwup(g) + lwrad(g) ! reflected longwave (0 at the moment) plus sigma*T^4
+
+ ! -------------------------------------------------------------
+ ! TO DO:
+ ! If lhflx < 0 and the total amount of water the land tries to suck out of the atmosphere is
+ ! larger than the total water available in the lowest level of the atmosphere, cap the negative LHFLX
+ ! at the amount of water in the atm_bot and put the excess energy into SHFLX (cam has a check
+ ! that does this (qneg4.f90)
+
+ ! check 1: if evap*dt > water + snow at this point, take excess and put into sensible heat flux?
+ if ( lhflx(g) * dt / lambda(g) > (water(g) + snow(g)) ) then
+ !where ( lhflx * dt / lambda > (water + snow) )
+ temp(g) = lhflx(g) - (water(g) + snow(g)) * lambda(g) / dt !excess energy that we don't have water for
+ lhflx(g) = lhflx(g) - temp(g) ! remove the excess from lh
+ shflx(g) = shflx(g) + temp(g) ! give it to shflx ... ask Gordon about a better way to do this...
+ write(iulog,*)subname, 'MML Warning: lhflx > available water; put excess in shflx'
+ !end where
+ end if ! put in an if loop just so I could get it to write the warning
+
+ ! MML 2021.09.13: move update of evap (in water units) to AFTER the lh/sh check - otherwise lh and evap won't match (once put into proper units)
+
+ ! LHFLX in water units [kg/m2/s = mm/s]
+ ! update evap(g)
+ !evap(:) = lhflx * dt / lambda
+ evap(g) = lhflx(g) / lambda(g) ! kg/m2/s or mm/s, NOT times dt!!!!
+
+! -------------------------------------------------------------
+! Check that dew doesn't exceed water available in lowest atm level
+! -------------------------------------------------------------
+! check 2: if evap*dt < 0 and requires more water than is available in the bottom of the atmosphere,
+! that is bad... the atmosphere corrects for it, but I want the atm and land to be self-consistent...
+! TODO STILL!
+! GBB: CLM does not do this
+!
+! MML: implement a check for this (go back to CAM QNEG3 OR QNEG4 to check how CAM does it)
+! Then limit the CLM LHFLX to whatever CAM is going to adjust it to. Also, print out how
+! big that energy difference is and save it somewhere - it'll be big in the first couple
+! of time steps, but I'm not sure how big/negligible it is after the model is sort of spun
+! up. Gordon said there was O(1) W/m2 of energy that sort of gets lost in the coupled
+! model - I'm curious if this contributes to that, or if this is totally negligible once
+! the models spins up.
+! (What CAM does is takes the excess energy that was in LHFLX (but there isn't enough water available
+! in the lower level of the atmosphere for) and adds it to the SHFLX, so its still conserving ENERGY
+! (ie shouldn't be a source of an energy leak), but its changing the PATHWAY the energy takes.
+
! ! Method:
! ! Following that of the CAM routine qneg4.F90 in cam/src/physics
! !
@@ -1339,124 +1421,119 @@ subroutine mml_main (bounds, atm2lnd_inst, lnd2atm_inst) !lnd2atm_inst
! write(iulog,*)subname, 'MML Warning: initial shflx = ', shflx(endg)
! !call endrun(msg=errmsg(__FILE__, __LINE__))
! end if
-
-
-
- ! -------------------------------------------------------------
- ! Update fsns and flns
- fsns = fsds - fsr
- ! compare to sw_abs, should be the same. Put in diag3_1d
- !diag3_1d = sw_abs
-
- flns = lwdn - lwup
-
-
- ! -------------------------------------------------------------
- ! Adjust soil temperatures for phase change (freezing/thawing in soil)
- ! -------------------------------------------------------------
-
- ! have to translate that function first :p
- ! returns new tsoi and epc, where epc is the energy used in phase change [W/m2]
- epc(:) = 0.0 ! for now
-
- call phase_change (begg, endg, tsoi, soil_cv, soil_dz, &
- soil_maxice, soil_liq, soil_ice, &
- mml_nsoi, dt, hfus, tfrz, epc &
- !diag1_1d, diag1_2d, diag2_2d, diag3_2d & ! temporary diagnostics
- )
-
- ! -------------------------------------------------------------
- ! Check soil temperature energy conservation
- ! -------------------------------------------------------------
- edif(:) = 0.0 ! change in energy in each layer
- do i = 1, mml_nsoi
- edif(:) = edif(:) + soil_cv(:,i) * soil_dz(:,i) * (tsoi(:,i) - tsoi0(:,i)) / dt
- end do
-
- err(:) = edif(:) - gsoi(:) - epc(:) ! not counting gsnow here, because it didn't heat/cool soil
-
- do g = begg, endg
- if ( abs(err(g)) .gt. 1.0e-06 ) then
- write(iulog,*)subname, 'MML Soil Temperature Conservation Error :( at g = ', g, &
- 'err(g) = ', err(g), ', edif(g) = ', edif(g),', gsoi(g) = ', gsoi(g)
- call endrun(msg=errmsg(__FILE__, __LINE__))
- end if
- end do
-
- ! -------------------------------------------------------------
- ! Bucket hydrology!
- ! Remove water that evaporated via LHFLX from ye-old water and snow buckets
- ! Also add rain/snow falling in from the great-big-sometimes-blue sky
- ! Then calculate runoff if the bucket overflowed
- !
- ! Ask Gordon - should I be raining into the bucket at the start of the time step?
- ! then let the bucket exceed capacity, do evaporation, and only if there is excess water
- ! at the end of the time step send it to runoff?
- ! (right now, I'm raining after LHFLX is calculated, so if it was dry then rains,
- ! we have small lhflx, but it could catch up next time step...
- ! ... probably doesn't matter much on the monthly mean scale, but if doing it one
- ! way vs the other results in wibbly-wobbly surface fluxes from time step to time
- ! step which can be avoided, should do it right...
- !
- ! GBB: This is how I would do it (calculate latent heat flux on current soil
- ! water) and then update the soil water. See what GFDL did.
- ! -------------------------------------------------------------
-
- !write(iulog,*)subname, 'MML welcome to bucket hydrology land!'
-
- ! If there is snow on the ground, sublimate that to get lhflx
- ! If there isn't enough snow to accomodate evap(g) when there is snow, steal it from
- ! the water bucket (without accounting for hvap or soil wetness or anything like that -
- ! treating the snow like it has a magic straw into the soil pool)
- ! If there isn't snow, take the water in evap(g) right from the soil water bucket
-
-
- !------------------------------------
- ! Rain into buckets
-
- ! (should I do this at the start of the time step? would up the amount of lh possible...)
- water = water + mms2kgm * prec_liq ! water in bucket [kg/m2]
- snow = snow + mms2kgm * prec_frz ! snow in bucket [kg/m2]
-
-
- ! -------------------------------------------------------------
- ! Evaporation
-
- ! shouldn't ever be in a case where evap > snow + water, it checks that when calculating lhflx
- ! though its possible if lhflx was close to snow + water, that when we update with dTsrf, it goes negative... hmm...
- ! (allow it for now?)
-
- ! Snow Evaporation:
- snow0 = snow
- water0 = water
-
- where (snow0 > 0 .and. evap*dt <= snow0)
- ! where snow is enough to cover all evaporation, take lhflx out of snow bucket
- snow(:) = snow0(:) - evap(:)*dt ! here I need to say evap*dt to get kg/m2 not kg/m2/s
- ! NOTE: IF lhflx < 0, then evap < 0, so this will ADD snow to snow bucket (sucking water out of atm)
+ ! -------------------------------------------------------------
+ ! Update fsns and flns
+ fsns(g) = fsds(g) - fsr(g)
+ ! compare to sw_abs, should be the same. Put in diag3_1d
+ !diag3_1d = sw_abs
+
+ flns(g) = lwdn(g) - lwup(g)
+
+ ! -------------------------------------------------------------
+ ! Adjust soil temperatures for phase change (freezing/thawing in soil)
+ ! -------------------------------------------------------------
+
+ ! have to translate that function first :p
+ ! returns new tsoi and epc, where epc is the energy used in phase change [W/m2]
+ epc(g) = 0.0 ! for now
+ end do begg_to_endg_1
+
+ call phase_change (begg, endg, tsoi, soil_cv, soil_dz, &
+ soil_maxice, soil_liq, soil_ice, &
+ mml_nsoi, dt, hfus, tfrz, epc &
+ !diag1_1d, diag1_2d, diag2_2d, diag3_2d & ! temporary diagnostics
+ )
+
+ begg_to_endg_2: do g = begg, endg
+ ! -------------------------------------------------------------
+ ! Check soil temperature energy conservation
+ ! -------------------------------------------------------------
+ edif(g) = 0.0 ! change in energy in each layer
+ do i = 1, mml_nsoi
+ edif(g) = edif(g) + soil_cv(g,i) * soil_dz(g,i) * (tsoi(g,i) - tsoi0(g,i)) / dt
+ end do
+
+ err(g) = edif(g) - gsoi(g) - epc(g) ! not counting gsnow here, because it didn't heat/cool soil
+
+ if ( abs(err(g)) .gt. 1.0e-06 ) then
+ write(iulog,*)subname, 'MML Soil Temperature Conservation Error :( at g = ', g, &
+ 'err(g) = ', err(g), ', edif(g) = ', edif(g),', gsoi(g) = ', gsoi(g)
+ call endrun(msg=errmsg(__FILE__, __LINE__))
+ end if
+
+ ! -------------------------------------------------------------
+ ! Bucket hydrology!
+ ! Remove water that evaporated via LHFLX from ye-old water and snow buckets
+ ! Also add rain/snow falling in from the great-big-sometimes-blue sky
+ ! Then calculate runoff if the bucket overflowed
+ !
+ ! Ask Gordon - should I be raining into the bucket at the start of the time step?
+ ! then let the bucket exceed capacity, do evaporation, and only if there is excess water
+ ! at the end of the time step send it to runoff?
+ ! (right now, I'm raining after LHFLX is calculated, so if it was dry then rains,
+ ! we have small lhflx, but it could catch up next time step...
+ ! ... probably doesn't matter much on the monthly mean scale, but if doing it one
+ ! way vs the other results in wibbly-wobbly surface fluxes from time step to time
+ ! step which can be avoided, should do it right...
+ !
+ ! GBB: This is how I would do it (calculate latent heat flux on current soil
+ ! water) and then update the soil water. See what GFDL did.
+ ! -------------------------------------------------------------
+
+ !write(iulog,*)subname, 'MML welcome to bucket hydrology land!'
+
+ ! If there is snow on the ground, sublimate that to get lhflx
+ ! If there isn't enough snow to accomodate evap(g) when there is snow, steal it from
+ ! the water bucket (without accounting for hvap or soil wetness or anything like that -
+ ! treating the snow like it has a magic straw into the soil pool)
+ ! If there isn't snow, take the water in evap(g) right from the soil water bucket
+
+ !------------------------------------
+ ! Rain into buckets
+
+ ! (should I do this at the start of the time step? would up the amount of lh possible...)
+ water(g) = water(g) + mms2kgm * prec_liq(g) ! water in bucket [kg/m2]
+ snow(g) = snow(g) + mms2kgm * prec_frz(g) ! snow in bucket [kg/m2]
+
+ ! -------------------------------------------------------------
+ ! Evaporation
+
+ ! shouldn't ever be in a case where evap > snow + water, it checks that when calculating lhflx
+ ! though its possible if lhflx was close to snow + water, that when we update with dTsrf, it goes negative... hmm...
+ ! (allow it for now?)
+
+ ! Snow Evaporation:
+ snow0(g) = snow(g)
+ water0(g) = water(g)
+ end do begg_to_endg_2
+
+ where (snow0(begg:endg) > 0 .and. evap(begg:endg) * dt <= snow0(begg:endg))
+ ! where snow is enough to cover all evaporation, take lhflx out of snow bucket
+ snow = snow0 - evap * dt ! here I need to say evap*dt to get kg/m2 not kg/m2/s
+ ! NOTE: IF lhflx < 0, then evap < 0, so this will ADD snow to snow bucket (sucking water out of atm)
end where
! MML 2021.09.21: changed from using snow to using snow0 in the where statments, otherwise I'm going to evaproate twice, aren't I?
- where (snow0 > 0 .and. evap*dt > snow0)
- ! where snow isn't enough to cover all evaporation
-
- ! steal excess water we need from soil bucket
- wat2snow(:) = evap*dt - snow0
- ! remove wat2snow from water bucket
- water(:) = water0 - wat2snow ! POSSIBLE that this could go negative at one time step, but shouldn't blow up
- ! give snow wat2snow and remove evap (should equal zero)
- snow(:) = snow0 + wat2snow - evap*dt
-
- ! NOTE: IF lhflx < 0, then evap < 0, so this will ADD water to the bucket (sucking it out of the atmosphere)
- ! ... shouldn't actually happen in this case b/c evap*dt < 0 shouldn't also be > snow
+ where (snow0(begg:endg) > 0 .and. evap(begg:endg) * dt > snow0(begg:endg))
+ ! where snow isn't enough to cover all evaporation
+
+ ! steal excess water we need from soil bucket
+ wat2snow = evap * dt - snow0
+ ! remove wat2snow from water bucket
+ water = water0 - wat2snow ! POSSIBLE that this could go negative at one time step, but shouldn't blow up
+ ! give snow wat2snow and remove evap (should equal zero)
+ snow = snow0 + wat2snow - evap * dt
+
+ ! NOTE: IF lhflx < 0, then evap < 0, so this will ADD water to the bucket (sucking it out of the atmosphere)
+ ! ... shouldn't actually happen in this case b/c evap*dt < 0 shouldn't also be > snow
end where
! Snow-free Evaporation:
- where (snow0 <= 0 )
- water(:) = water0 - evap*dt
- ! NOTE: IF lhflx < 0, then evap < 0, so this will ADD water to the bucket (sucking it out of the atmosphere)
+ where (snow0(begg:endg) <= 0 )
+ water = water0 - evap * dt
+ ! NOTE: IF lhflx < 0, then evap < 0, so this will ADD water to the bucket (sucking it out of the atmosphere)
end where
! Check water and snow buckets
@@ -1479,15 +1556,12 @@ subroutine mml_main (bounds, atm2lnd_inst, lnd2atm_inst) !lnd2atm_inst
end if
end do
-
-
-
!------------------------------------
! Runoff: check if bucket overflowed
- where (water > bucket_cap)
- runoff = water - bucket_cap ! excess h20
- water = bucket_cap
+ where (water(begg:endg) > bucket_cap(begg:endg))
+ runoff = water - bucket_cap ! excess h20
+ water = bucket_cap
end where
! Check we didn't let snow or water go negative
@@ -1536,7 +1610,7 @@ subroutine mml_main (bounds, atm2lnd_inst, lnd2atm_inst) !lnd2atm_inst
! -------------------------------------------------------------
! radforc = swabs + lwabs
! lwup = lw_reflected + lwrad
- err = radforc - (lwup + lhflx + shflx + gsoi + gsnow)
+ err(begg:endg) = radforc(begg:endg) - (lwup(begg:endg) + lhflx(begg:endg) + shflx(begg:endg) + gsoi(begg:endg) + gsnow(begg:endg))
do g = begg, endg
if( abs(err(g)) > 1.0e-06) then
write(iulog,*)subname, 'MML ERROR: Not conserving energy (surface fluxes) \n', &
@@ -1550,19 +1624,14 @@ subroutine mml_main (bounds, atm2lnd_inst, lnd2atm_inst) !lnd2atm_inst
call endrun(msg=errmsg(__FILE__, __LINE__))
end if
end do
-
-
-
-
-
! -------------------------------------------------------------
! Update qs (surface specific humidity - need it for next round's MO calculations)
! -------------------------------------------------------------
! instead of direct calculation, re-evaluate QSat on the new surface temperature to get qsrf
- qsrf(:) = qref + evap*dt * res / (dt * rhoair)
+ qsrf(begg:endg) = qref(begg:endg) + evap(begg:endg) * dt * res(begg:endg) / (dt * rhoair(begg:endg))
! Gordon says leave it with the above equation (the below is the inversion to calculate it...)
!do g = begg, endg
! call QSat (tsrf(g), pref(g), esrf(g), desrf(g), qsrf(g), dqsrf(g))
@@ -1587,8 +1656,8 @@ subroutine mml_main (bounds, atm2lnd_inst, lnd2atm_inst) !lnd2atm_inst
! but for taux and tauy you want to preserve the zonal and meridonal components
! taux = -rhoair * atm2lnd_inst%forc_u_grc(g) / ram
! tauy = -rhoair * atm2lnd_inst%forc_v_grc(g) / ram
- taux = -rhoair * (atm2lnd_inst%forc_u_grc - 0._r8) / ram ! [kg/m/s2] = [kg/m3] * [m/s] / [s/m]
- tauy = -rhoair * (atm2lnd_inst%forc_v_grc - 0._r8) / ram ! [kg/m/s2] = [kg/m3] * [m/s] / [s/m]
+ taux(begg:endg) = -rhoair(begg:endg) * (atm2lnd_inst%forc_u_grc(begg:endg) - 0._r8) / ram(begg:endg) ! [kg/m/s2] = [kg/m3] * [m/s] / [s/m]
+ tauy(begg:endg) = -rhoair(begg:endg) * (atm2lnd_inst%forc_v_grc(begg:endg) - 0._r8) / ram(begg:endg) ! [kg/m/s2] = [kg/m3] * [m/s] / [s/m]
! the - 0._r8 should be removed later, this is to remind myself I'm saying u_ref - u_srf, where u_srf = 0 by def'n
@@ -1769,48 +1838,48 @@ subroutine mml_main (bounds, atm2lnd_inst, lnd2atm_inst) !lnd2atm_inst
! lnd -> atm
- lnd2atm_inst%t_rad_grc = tsrf ! radiative temperature (Kelvin)
- lnd2atm_inst%t_ref2m_grc = atm2lnd_inst%mml_out_tref2m_grc ! 2m surface air temperature (Kelvin)
+ lnd2atm_inst%t_rad_grc(begg:endg) = tsrf(begg:endg) ! radiative temperature (Kelvin)
+ lnd2atm_inst%t_ref2m_grc(begg:endg) = atm2lnd_inst%mml_out_tref2m_grc(begg:endg) ! 2m surface air temperature (Kelvin)
!atm2lnd_inst%mml_lnd_ts_grc = tsrf ! dunno what its saving out now...
!lnd2atm_inst%q_ref2m_grc = atm2lnd_inst%mml_out_qref2m_grc ! 2m surface specific humidity (kg/kg)
!lnd2atm_inst%u_ref10m_grc = atm2lnd_inst%mml_out_uref10m_grc ! 10m surface wind speed (m/sec)
- lnd2atm_inst%q_ref2m_grc = atm2lnd_inst%mml_out_qref2m_grc ! 2m surface specific humidity (kg/kg)
- lnd2atm_inst%u_ref10m_grc = atm2lnd_inst%mml_out_uref10m_grc ! 10m surface wind speed (m/sec)
+ lnd2atm_inst%q_ref2m_grc(begg:endg) = atm2lnd_inst%mml_out_qref2m_grc(begg:endg) ! 2m surface specific humidity (kg/kg)
+ lnd2atm_inst%u_ref10m_grc(begg:endg) = atm2lnd_inst%mml_out_uref10m_grc(begg:endg) ! 10m surface wind speed (m/sec)
! note: mm h20 snow if using rhowat to convert should be the same as kg/m2
- lnd2atm_inst%h2osno_grc = snow / rhowat * 1000 ! [kg/m2] / [kg/m3] * 1000[mm/m]! snow water (mm H2O)
+ lnd2atm_inst%h2osno_grc(begg:endg) = snow(begg:endg) / rhowat * 1000 ! [kg/m2] / [kg/m3] * 1000[mm/m]! snow water (mm H2O)
!lnd2atm_inst%h2osoi_vol_grc ! volumetric soil water (0~watsat, m3/m3, nlevgrnd) (for dust model)
! MML: albedo (:,:) -> albd is direct, albd(:,1) direct vis, albd(:,2) direct nir
! -> albi is diffuse, albi(:,1) diffuse vis, albi(:,2) diffuse nir (I THINK)
! GBB: yes
- lnd2atm_inst%albd_grc(:,1) = alb_vis_dir ! (numrad=1, vis) surface albedo (direct)
- lnd2atm_inst%albd_grc(:,2) = alb_nir_dir ! (numrad=2, nir) surface albedo (direct)
-
- lnd2atm_inst%albi_grc(:,1) = alb_vis_dif ! (numrad=1, vis) surface albedo (diffuse)
- lnd2atm_inst%albi_grc(:,2) = alb_nir_dif ! (numrad=2, nir) surface albedo (diffuse)
-
- lnd2atm_inst%taux_grc = taux ! wind stress: e-w (kg/m/s**2)
- lnd2atm_inst%tauy_grc = tauy ! wind stress: n-s (kg/m/s**2)
- lnd2atm_inst%eflx_lh_tot_grc = lhflx ! total latent HF (W/m**2) [+ to atm]
- lnd2atm_inst%eflx_sh_tot_grc = shflx ! total sensible HF (W/m**2) [+ to atm]
+ lnd2atm_inst%albd_grc(begg:endg,1) = alb_vis_dir(begg:endg) ! (numrad=1, vis) surface albedo (direct)
+ lnd2atm_inst%albd_grc(begg:endg,2) = alb_nir_dir(begg:endg) ! (numrad=2, nir) surface albedo (direct)
+
+ lnd2atm_inst%albi_grc(begg:endg,1) = alb_vis_dif(begg:endg) ! (numrad=1, vis) surface albedo (diffuse)
+ lnd2atm_inst%albi_grc(begg:endg,2) = alb_nir_dif(begg:endg) ! (numrad=2, nir) surface albedo (diffuse)
+
+ lnd2atm_inst%taux_grc(begg:endg) = taux(begg:endg) ! wind stress: e-w (kg/m/s**2)
+ lnd2atm_inst%tauy_grc(begg:endg) = tauy(begg:endg) ! wind stress: n-s (kg/m/s**2)
+ lnd2atm_inst%eflx_lh_tot_grc(begg:endg) = lhflx(begg:endg) ! total latent HF (W/m**2) [+ to atm]
+ lnd2atm_inst%eflx_sh_tot_grc(begg:endg) = shflx(begg:endg) ! total sensible HF (W/m**2) [+ to atm]
! lnd2atm_inst%eflx_sh_precip_conversion_grc ! sensible HF from precipitation conversion (W/m**2) [+ to atm]
- ! Land group says (a) this is new (sh_precip_converstion) and I can set it to 0 since I don't have multiple levels on my (currently nonexistent) ice sheets
- lnd2atm_inst%eflx_lwrad_out_grc = lwup ! IR (longwave) radiation (W/m**2)
- lnd2atm_inst%qflx_evap_tot_grc = evap ! (mm H2O/s) ! qflx_evap_soi + qflx_evap_can + qflx_tran_veg
- lnd2atm_inst%fsa_grc = sw_abs ! solar rad absorbed (total) (W/m**2)
+ ! Land group says (a) this is new (sh_precip_converstion) and I can set it to 0 since I don't have multiple levels on my (currently nonexistent) ice sheets
+ lnd2atm_inst%eflx_lwrad_out_grc(begg:endg) = lwup(begg:endg) ! IR (longwave) radiation (W/m**2)
+ lnd2atm_inst%qflx_evap_tot_grc(begg:endg) = evap(begg:endg) ! (mm H2O/s) ! qflx_evap_soi + qflx_evap_can + qflx_tran_veg
+ lnd2atm_inst%fsa_grc(begg:endg) = sw_abs(begg:endg) ! solar rad absorbed (total) (W/m**2)
! MML: not running interactive BGC, set CO2/Methane fluxes to 0
!lnd2atm_inst%net_carbon_exchange_grc = 0._r8 ! net CO2 flux (kg CO2/m**2/s) [+ to atm]
- lnd2atm_inst%net_carbon_exchange_grc = 0._r8
- lnd2atm_inst%nem_grc = 0._r8 ! gridcell average net methane correction to CO2 flux (g C/m^2/s)
- lnd2atm_inst%ram1_grc = ram ! aerodynamical resistance (s/m)
+ lnd2atm_inst%net_carbon_exchange_grc(begg:endg) = 0._r8
+ lnd2atm_inst%nem_grc(begg:endg) = 0._r8 ! gridcell average net methane correction to CO2 flux (g C/m^2/s)
+ lnd2atm_inst%ram1_grc(begg:endg) = ram(begg:endg) ! aerodynamical resistance (s/m)
! MML: check if it is ram (vs res) that I should be exporting here
!lnd2atm_inst%fv_grc = ! friction velocity (m/s) (for dust model)
! MML: should be able to calculate this from MO theory... is this ustar?
! Need to put the dust fluxes I read from the .nc file into the right size
- lnd2atm_inst%flxdst_grc = dust ! dust flux (size bins)
+ lnd2atm_inst%flxdst_grc(begg:endg,:) = dust(begg:endg,:) ! dust flux (size bins)
!lnd2atm_inst%flxdst_grc = 0._r8 ! (:,ndust) where ndust=4, so I need a 4th dust flux field! and I think the ones I had were wrong...
! MML: need some sort of forcing file - see what the aquaplanet people are using
! currently borrowing the value from CLM by running the whole CLM model first...
@@ -1916,28 +1985,28 @@ subroutine nc_import (begg, endg, mml_nsoi, lfsurdat, mon, &
! !LOCAL VARIABLES:
character(len=32) :: subname = 'nc_import_sub_mml'
! MML allocation variables to read from .nc file
- real(r8), pointer :: nc_alb_gvd(:) => null() ! ground albedo read from .nc file
- real(r8), pointer :: nc_alb_svd(:) => null() ! snow albedo read from .nc file
- real(r8), pointer :: nc_alb_gnd(:) => null() !
- real(r8), pointer :: nc_alb_snd(:) => null()
- real(r8), pointer :: nc_alb_gvf(:) => null() ! ground albedo read from .nc file
- real(r8), pointer :: nc_alb_svf(:) => null() ! snow albedo read from .nc file
- real(r8), pointer :: nc_alb_gnf(:) => null() !
- real(r8), pointer :: nc_alb_snf(:) => null()
- real(r8), pointer :: nc_snowmask(:) => null() ! snow masking depth read from .nc file
- real(r8), pointer :: nc_evaprs(:) => null() ! evap resistance from .nc file
- real(r8), pointer :: nc_bucket(:) => null() ! soil bucket depth from .nc file
- real(r8), pointer :: nc_ice(:,:) => null() ! freezeable water in each soil layer from .nc file
- real(r8), pointer :: nc_z(:,:) => null() ! depth from surf to each soil layer from .nc file
- real(r8), pointer :: nc_type(:) => null() ! soil type from .nc file
- real(r8), pointer :: nc_rough(:) => null() ! roughness length from .nc file
- real(r8), pointer :: nc_soil_tk(:) => null() ! soil thermal conductivity from .nc file
- real(r8), pointer :: nc_glc_tk(:) => null() ! glacier thermal conductivity from .nc file
- real(r8), pointer :: nc_soil_cv(:) => null() ! soil heat capacity from .nc file
- real(r8), pointer :: nc_glc_cv(:) => null() ! glacier heat capacity from .nc file
- real(r8), pointer :: nc_glc_mask(:) => null() ! glacier mask from .nc file
- real(r8), pointer :: nc_emiss(:) => null() ! emissivity (for LW) from .nc file
- real(r8), pointer :: nc_dust(:) => null() ! dust flux (clm5 climatology for now) from .nc file
+ real(r8), pointer :: nc_alb_gvd(:) => null() ! ground albedo read from .nc file
+ real(r8), pointer :: nc_alb_svd(:) => null() ! snow albedo read from .nc file
+ real(r8), pointer :: nc_alb_gnd(:) => null() !
+ real(r8), pointer :: nc_alb_snd(:) => null()
+ real(r8), pointer :: nc_alb_gvf(:) => null() ! ground albedo read from .nc file
+ real(r8), pointer :: nc_alb_svf(:) => null() ! snow albedo read from .nc file
+ real(r8), pointer :: nc_alb_gnf(:) => null() !
+ real(r8), pointer :: nc_alb_snf(:) => null()
+ real(r8), pointer :: nc_snowmask(:) => null() ! snow masking depth read from .nc file
+ real(r8), pointer :: nc_evaprs(:) => null() ! evap resistance from .nc file
+ real(r8), pointer :: nc_bucket(:) => null() ! soil bucket depth from .nc file
+ real(r8), pointer :: nc_ice(:,:) => null() ! freezeable water in each soil layer from .nc file
+ real(r8), pointer :: nc_z(:,:) => null() ! depth from surf to each soil layer from .nc file
+ real(r8), pointer :: nc_type(:) => null() ! soil type from .nc file
+ real(r8), pointer :: nc_rough(:) => null() ! roughness length from .nc file
+ real(r8), pointer :: nc_soil_tk(:) => null() ! soil thermal conductivity from .nc file
+ real(r8), pointer :: nc_glc_tk(:) => null() ! glacier thermal conductivity from .nc file
+ real(r8), pointer :: nc_soil_cv(:) => null() ! soil heat capacity from .nc file
+ real(r8), pointer :: nc_glc_cv(:) => null() ! glacier heat capacity from .nc file
+ real(r8), pointer :: nc_glc_mask(:) => null() ! glacier mask from .nc file
+ real(r8), pointer :: nc_emiss(:) => null() ! emissivity (for LW) from .nc file
+ real(r8), pointer :: nc_dust(:) => null() ! dust flux (clm5 climatology for now) from .nc file
! note: doing allocatable, pointer won't compile, says variable has already been
! assigned the allocatbale tribute ... so does being a pointer encompass being allocatable?
! same error if I do pointer, allocatable instead:
@@ -1958,7 +2027,6 @@ subroutine nc_import (begg, endg, mml_nsoi, lfsurdat, mon, &
! integer :: mon ! month (1, ..., 12) for nstep+1
integer :: day ! day of month (1, ..., 31) for nstep+1
integer :: sec ! seconds into current date for nstep+1
- integer :: mcdate ! Current model date (yyyymmdd)
character(len=256) :: locfn ! local file name
logical :: readvar ! true => variable is on dataset
@@ -1974,28 +2042,28 @@ subroutine nc_import (begg, endg, mml_nsoi, lfsurdat, mon, &
ival = 0.0_r8
- allocate( nc_alb_gvd (begg:endg) ) ; nc_alb_gvd(:) = ival
- allocate( nc_alb_svd (begg:endg) ) ; nc_alb_svd(:) = ival
- allocate( nc_alb_gnd (begg:endg) ) ; nc_alb_gnd(:) = ival
- allocate( nc_alb_snd (begg:endg) ) ; nc_alb_snd(:) = ival
- allocate( nc_alb_gvf (begg:endg) ) ; nc_alb_gvf(:) = ival
- allocate( nc_alb_svf (begg:endg) ) ; nc_alb_svf(:) = ival
- allocate( nc_alb_gnf (begg:endg) ) ; nc_alb_gnf(:) = ival
- allocate( nc_alb_snf (begg:endg) ) ; nc_alb_snf(:) = ival
- allocate( nc_snowmask (begg:endg) ) ; nc_snowmask(:) = ival
- allocate( nc_evaprs (begg:endg) ) ; nc_evaprs(:) = ival
- allocate( nc_bucket (begg:endg) ) ; nc_bucket(:) = ival
- allocate( nc_ice (begg:endg,mml_nsoi) ) ; nc_ice(:,:) = ival
- allocate( nc_z (begg:endg,mml_nsoi) ) ; nc_z(:,:) = ival
- allocate( nc_type (begg:endg) ) ; nc_type(:) = ival
- allocate( nc_rough (begg:endg) ) ; nc_rough(:) = ival
- allocate( nc_soil_tk (begg:endg) ) ; nc_soil_tk(:) = ival
- allocate( nc_glc_tk (begg:endg) ) ; nc_glc_tk(:) = ival
- allocate( nc_soil_cv (begg:endg) ) ; nc_soil_cv(:) = ival
- allocate( nc_glc_cv (begg:endg) ) ; nc_glc_cv(:) = ival
- allocate( nc_glc_mask (begg:endg) ) ; nc_glc_mask(:) = ival
- allocate( nc_emiss (begg:endg) ) ; nc_emiss(:) = ival
- allocate( nc_dust (begg:endg) ) ; nc_dust(:) = ival ! keep overwriting this for each dust bin
+ allocate( nc_alb_gvd(begg:endg) ); nc_alb_gvd(begg:endg) = ival
+ allocate( nc_alb_svd(begg:endg) ); nc_alb_svd(begg:endg) = ival
+ allocate( nc_alb_gnd(begg:endg) ); nc_alb_gnd(begg:endg) = ival
+ allocate( nc_alb_snd(begg:endg) ); nc_alb_snd(begg:endg) = ival
+ allocate( nc_alb_gvf(begg:endg) ); nc_alb_gvf(begg:endg) = ival
+ allocate( nc_alb_svf(begg:endg) ); nc_alb_svf(begg:endg) = ival
+ allocate( nc_alb_gnf(begg:endg) ); nc_alb_gnf(begg:endg) = ival
+ allocate( nc_alb_snf(begg:endg) ); nc_alb_snf(begg:endg) = ival
+ allocate( nc_snowmask(begg:endg) ); nc_snowmask(begg:endg) = ival
+ allocate( nc_evaprs(begg:endg) ); nc_evaprs(begg:endg) = ival
+ allocate( nc_bucket(begg:endg) ); nc_bucket(begg:endg) = ival
+ allocate( nc_ice(begg:endg,mml_nsoi) ); nc_ice(begg:endg,:) = ival
+ allocate( nc_z(begg:endg,mml_nsoi) ); nc_z(begg:endg,:) = ival
+ allocate( nc_type(begg:endg) ); nc_type(begg:endg) = ival
+ allocate( nc_rough(begg:endg) ); nc_rough(begg:endg) = ival
+ allocate( nc_soil_tk(begg:endg) ); nc_soil_tk(begg:endg) = ival
+ allocate( nc_glc_tk(begg:endg) ); nc_glc_tk(begg:endg) = ival
+ allocate( nc_soil_cv(begg:endg) ); nc_soil_cv(begg:endg) = ival
+ allocate( nc_glc_cv(begg:endg) ); nc_glc_cv(begg:endg) = ival
+ allocate( nc_glc_mask(begg:endg) ); nc_glc_mask(begg:endg) = ival
+ allocate( nc_emiss(begg:endg) ); nc_emiss(begg:endg) = ival
+ allocate( nc_dust(begg:endg) ); nc_dust(begg:endg) = ival ! keep overwriting this for each dust bin
! if (ier /= 0) then
@@ -2039,9 +2107,8 @@ subroutine nc_import (begg, endg, mml_nsoi, lfsurdat, mon, &
if ( .NOT. readvar .and. masterproc) then
write(iulog,*)subname, 'MML tried to read dust-1, failed ', readvar
else
- dust(begg:endg,1) = nc_dust
- end if
-
+ dust(begg:endg,1) = nc_dust(begg:endg)
+ end if
! second dust bin:
call ncd_io(ncid=ncid, varname='l2xavg_Fall_flxdst2', flag='read', data=nc_dust, &
@@ -2049,9 +2116,8 @@ subroutine nc_import (begg, endg, mml_nsoi, lfsurdat, mon, &
if ( .NOT. readvar .and. masterproc) then
write(iulog,*)subname, 'MML tried to read dust-2, failed ', readvar
else
- dust(begg:endg,2) = nc_dust
- end if
-
+ dust(begg:endg,2) = nc_dust(begg:endg)
+ end if
! third dust bin:
call ncd_io(ncid=ncid, varname='l2xavg_Fall_flxdst3', flag='read', data=nc_dust, &
@@ -2059,9 +2125,8 @@ subroutine nc_import (begg, endg, mml_nsoi, lfsurdat, mon, &
if ( .NOT. readvar .and. masterproc) then
write(iulog,*)subname, 'MML tried to read dust-3, failed ', readvar
else
- dust(begg:endg,3) = nc_dust
- end if
-
+ dust(begg:endg,3) = nc_dust(begg:endg)
+ end if
! fourth dust bin:
call ncd_io(ncid=ncid, varname='l2xavg_Fall_flxdst4', flag='read', data=nc_dust, &
@@ -2069,9 +2134,8 @@ subroutine nc_import (begg, endg, mml_nsoi, lfsurdat, mon, &
if ( .NOT. readvar .and. masterproc) then
write(iulog,*)subname, 'MML tried to read dust-4, failed ', readvar
else
- dust(begg:endg,4) = nc_dust
- end if
-
+ dust(begg:endg,4) = nc_dust(begg:endg)
+ end if
! Albedo Direct
@@ -2264,10 +2328,10 @@ subroutine nc_import (begg, endg, mml_nsoi, lfsurdat, mon, &
roughness(begg:endg) = nc_rough(begg:endg)
emiss(begg:endg) = nc_emiss(begg:endg)
glc_mask(begg:endg) = nc_glc_mask(begg:endg)
- soil_tk_1d(begg:endg) = nc_soil_tk
- soil_cv_1d(begg:endg) = nc_soil_cv
- glc_tk_1d(begg:endg) = nc_glc_tk
- glc_cv_1d(begg:endg) = nc_glc_cv
+ soil_tk_1d(begg:endg) = nc_soil_tk(begg:endg)
+ soil_cv_1d(begg:endg) = nc_soil_cv(begg:endg)
+ glc_tk_1d(begg:endg) = nc_glc_tk(begg:endg)
+ glc_cv_1d(begg:endg) = nc_glc_cv(begg:endg)
!dust(begg:endg) = nc_dust(begg:endg)
!
@@ -2319,11 +2383,11 @@ end subroutine nc_import
!***********************************************
! phase change
!***********************************************
- subroutine phase_change (begg, endg, tsoi, soil_cv, soil_dz, &
- soil_maxice, soil_liq, soil_ice, &
- mml_nsoi, dt, hfus, tfrz, epc &
- !diag1_1d, diag1_2d, diag2_2d, diag3_2d & ! temporary diagnostics
- )
+ subroutine phase_change (begg, endg, tsoi, soil_cv, soil_dz, &
+ soil_maxice, soil_liq, soil_ice, &
+ mml_nsoi, dt, hfus, tfrz, epc &
+ !diag1_1d, diag1_2d, diag2_2d, diag3_2d & ! temporary diagnostics
+ )
!% -------------------------------------------------------------------------
! Given the initial soil temperature calculation, go check if we should be
! freezing/thawing any of the available freezeable water in that layer.
@@ -2338,17 +2402,17 @@ subroutine phase_change (begg, endg, tsoi, soil_cv, soil_dz, &
real(r8), intent(in) :: dt
real(r8), intent(in) :: hfus
real(r8), intent(in) :: tfrz
- real(r8), intent(in) :: soil_cv(:,:)
- real(r8), intent(in) :: soil_dz(:,:)
- real(r8), intent(in) :: soil_maxice(:,:) ! Not using this right now, instead using presc. soil_liq and soil_ice vals
+ real(r8), intent(in) :: soil_cv(begg:endg,mml_nsoi)
+ real(r8), intent(in) :: soil_dz(begg:endg,mml_nsoi)
+ real(r8), intent(in) :: soil_maxice(begg:endg,mml_nsoi) ! Not using this right now, instead using presc. soil_liq and soil_ice vals
! ----- Output Variables --------
- real(r8), intent(inout) :: tsoi(:,:)
+ real(r8), intent(inout) :: tsoi(begg:endg,mml_nsoi)
! tsoi(begg:endg,:) ! try defining them this way instead, to avoid the dummy vars and keep the correct g indices
- real(r8), intent(inout) :: soil_liq(:,:) !
- real(r8), intent(inout) :: soil_ice(:,:) !
+ real(r8), intent(inout) :: soil_liq(begg:endg,mml_nsoi) !
+ real(r8), intent(inout) :: soil_ice(begg:endg,mml_nsoi) !
- real(r8), intent(out) :: epc(:) ! (:,:) derivative of sat vapour pressure at ta [Pa/K]
+ real(r8), intent(out) :: epc(begg:endg) ! (begg:endg,:) derivative of sat vapour pressure at ta [Pa/K]
! real(r8), intent(out) :: diag1_1d(:) ! put alhf here
! real(r8), intent(out) :: diag1_2d(:,:) ! put rfm here
@@ -2379,104 +2443,103 @@ subroutine phase_change (begg, endg, tsoi, soil_cv, soil_dz, &
phase_tsoi(begg:endg,mml_nsoi) , &
phase_liq(begg:endg,mml_nsoi) , &
phase_ice(begg:endg,mml_nsoi)
-
-
- phase_cv = soil_cv
- phase_dz = soil_dz
- phase_maxice = soil_maxice
- phase_tsoi = tsoi
- phase_liq = soil_liq
- phase_ice = soil_ice
-
- !------------------------------------------------------
-
- !-----------------------------
- ! Initialization
- wliq0 = phase_liq ! [kg/m2] per layer
- wice0 = phase_ice
- wmass0 = wliq0 + wice0 ! should equal 300/dz in all but top layer, where it should be 0
- tsoi0 = phase_tsoi
-
- !-----------------------------
- ! Identify if layers should be melting or freezing
- ! imelt = 0 -> no phase change
- ! imelt = 1 -> melt
- ! imelt = 2 -> freeze
- imelt(:,:) = 0._r8
-
- !do i = 1, mml_nsoi
- do i = 1, mml_nsoi ! should be no freezeable water in top layer... ie phase_ice and phase_liq should both ==0
-
- ! Melting: if there is ice and phase_tsoi > 0
- where (phase_ice(:,i) > 0._r8 .and. phase_tsoi(:,i) > tfrz)
- imelt(:,i) = 1
- phase_tsoi(:,i) = tfrz
- end where
-
- ! Freezing: if there is water and phase_tsoi < 0
- where (phase_liq(:,i) > 0._r8 .and. phase_tsoi(:,i) < tfrz)
- imelt(:,i) = 2
- phase_tsoi(:,i) = tfrz
- end where
-
- ! otherwise, leave phase_tsoi as is and don't put energy into phase change
-
- end do
-
- !-----------------------------
- ! Energy available for freezing or melting comes from difference between phase_tsoi(:,i) and
- ! tfreeze
- !
-
- do i = 1, mml_nsoi
-
- hfm(:,i) = 0._r8 ! all the palces imelt=0, no phase change
-
- ! Energy for freezing or melting [W/m2]; hfm > 0 freezing, hfm < 0 melting
- where (imelt(:,i) > 0)
- hfm(:,i) = ( phase_tsoi(:,i) - tsoi0(:,i) ) * phase_cv(:,i) * phase_dz(:,i) / dt
- ! if I accounted for cv water/ice here, too, would that fix part of the problem?
-
- ! how much energy for freezing or melting based only off Delta T (if you've got excess, use for T change)
- ! maybe I need to include water in cv to conserve energy? Hmm. Don't think gfdl does, though...
- end where
-
- ! Melting: maximum energy available for freezing or melting [W/m2]
- where (imelt(:,i) .eq. 1) ! Melting case
- hfmx(:,i) = - phase_ice(:,i) * hfus / dt ! total meltable = depends how much ice you've got
- end where
-
- ! Freezing: maximum energy available for freezing or melting [W/m2]
- where (imelt(:,i) .eq. 2) ! freezing case
- hfmx(:,i) = phase_liq(:,i) * hfus / dt ! total freezable = depends how much water you've got
- end where
-
- end do
-
-
- !-----------------------------
- ! Calculate phase change
-
- epc(:) = 0._r8
-
- do i = 1, mml_nsoi
-
- where( imelt(:,i) > 0 )
-
- ! Freeze or melt ice
- rfm(:,i) = hfm(:,i) / hfus ! change in ice (>0 freeze, <0 melt) [kg/m2/s]
- phase_ice(:,i) = wice0(:,i) + rfm(:,i) * dt ! update ice [kg/m2]
- phase_ice(:,i) = max( 0.0 , phase_ice(:,i) ) ! can't melt more ice than is present
- phase_ice(:,i) = min( wmass0(:,i) , phase_ice(:,i) ) ! can't exceed total water than is present (300*dz, should be)
- phase_liq(:,i) = max( 0.0 , ( wmass0(:,i) - phase_ice(:,i) ) ) ! update liquid water (kg/m2)
- alhf(:) = hfus * (phase_ice(:,i) - wice0(:,i)) / dt ! actual heat flux from phase change [w/m2]
- epc(:) = epc + alhf ! sum of heat flux from phase change over soil column [w/m2]
-
- ! If there is energy left over, use it to change soil layer temperature
- phase_tsoi(:,i) = phase_tsoi(:,i) - (hfm(:,i) - alhf(:)) * dt / (phase_cv(:,i) * phase_dz(:,i))
-
- end where
+
+phase_cv(begg:endg,:) = soil_cv(begg:endg,:)
+phase_dz(begg:endg,:) = soil_dz(begg:endg,:)
+phase_maxice(begg:endg,:) = soil_maxice(begg:endg,:)
+phase_tsoi(begg:endg,:) = tsoi(begg:endg,:)
+phase_liq(begg:endg,:) = soil_liq(begg:endg,:)
+phase_ice(begg:endg,:) = soil_ice(begg:endg,:)
+
+!------------------------------------------------------
+
+!-----------------------------
+! Initialization
+wliq0(begg:endg,:) = phase_liq(begg:endg,:) ! [kg/m2] per layer
+wice0(begg:endg,:) = phase_ice(begg:endg,:)
+wmass0(begg:endg,:) = wliq0(begg:endg,:) + wice0(begg:endg,:) ! should equal 300/dz in all but top layer, where it should be 0
+tsoi0(begg:endg,:) = phase_tsoi(begg:endg,:)
+
+ !-----------------------------
+ ! Identify if layers should be melting or freezing
+ ! imelt = 0 -> no phase change
+ ! imelt = 1 -> melt
+ ! imelt = 2 -> freeze
+ imelt(begg:endg,:) = 0._r8
+
+ !do i = 1, mml_nsoi
+ do i = 1, mml_nsoi ! should be no freezeable water in top layer... ie phase_ice and phase_liq should both ==0
+
+ ! Melting: if there is ice and phase_tsoi > 0
+ where (phase_ice(begg:endg,i) > 0._r8 .and. phase_tsoi(begg:endg,i) > tfrz)
+ imelt(:,i) = 1
+ phase_tsoi(:,i) = tfrz
+ end where
+
+ ! Freezing: if there is water and phase_tsoi < 0
+ where (phase_liq(begg:endg,i) > 0._r8 .and. phase_tsoi(begg:endg,i) < tfrz)
+ imelt(:,i) = 2
+ phase_tsoi(:,i) = tfrz
+ end where
+
+ ! otherwise, leave phase_tsoi as is and don't put energy into phase change
+
+ end do
+
+ !-----------------------------
+ ! Energy available for freezing or melting comes from difference between phase_tsoi(:,i) and
+ ! tfreeze
+ !
+
+ do i = 1, mml_nsoi
+
+ hfm(begg:endg,i) = 0._r8 ! all the palces imelt=0, no phase change
+
+ ! Energy for freezing or melting [W/m2]; hfm > 0 freezing, hfm < 0 melting
+ where (imelt(begg:endg,i) > 0)
+ hfm(:,i) = ( phase_tsoi(:,i) - tsoi0(:,i) ) * phase_cv(:,i) * phase_dz(:,i) / dt
+ ! if I accounted for cv water/ice here, too, would that fix part of the problem?
+
+ ! how much energy for freezing or melting based only off Delta T (if you've got excess, use for T change)
+ ! maybe I need to include water in cv to conserve energy? Hmm. Don't think gfdl does, though...
+ end where
+
+ ! Melting: maximum energy available for freezing or melting [W/m2]
+ where (imelt(begg:endg,i) == 1) ! Melting case
+ hfmx(:,i) = - phase_ice(:,i) * hfus / dt ! total meltable = depends how much ice you've got
+ end where
+
+ ! Freezing: maximum energy available for freezing or melting [W/m2]
+ where (imelt(begg:endg,i) == 2) ! freezing case
+ hfmx(:,i) = phase_liq(:,i) * hfus / dt ! total freezable = depends how much water you've got
+ end where
+
+ end do
+
+
+ !-----------------------------
+ ! Calculate phase change
+
+ epc(begg:endg) = 0._r8
+
+ do i = 1, mml_nsoi
+
+ where( imelt(begg:endg,i) > 0 )
+
+ ! Freeze or melt ice
+ rfm(:,i) = hfm(:,i) / hfus ! change in ice (>0 freeze, <0 melt) [kg/m2/s]
+ phase_ice(:,i) = wice0(:,i) + rfm(:,i) * dt ! update ice [kg/m2]
+ phase_ice(:,i) = max( 0.0 , phase_ice(:,i) ) ! can't melt more ice than is present
+ phase_ice(:,i) = min( wmass0(:,i) , phase_ice(:,i) ) ! can't exceed total water than is present (300*dz, should be)
+ phase_liq(:,i) = max( 0.0 , ( wmass0(:,i) - phase_ice(:,i) ) ) ! update liquid water (kg/m2)
+ alhf = hfus * (phase_ice(:,i) - wice0(:,i)) / dt ! actual heat flux from phase change [w/m2]
+ epc = epc + alhf ! sum of heat flux from phase change over soil column [w/m2]
+
+ ! If there is energy left over, use it to change soil layer temperature
+ phase_tsoi(:,i) = phase_tsoi(:,i) - (hfm(:,i) - alhf) * dt / (phase_cv(:,i) * phase_dz(:,i))
+
+ end where
!---------------------
@@ -2547,13 +2610,11 @@ subroutine phase_change (begg, endg, tsoi, soil_cv, soil_dz, &
!------------------------
end do
-
- ! update out vars
- soil_liq = phase_liq
- soil_ice = phase_ice
- tsoi = phase_tsoi
-
+ ! update out vars
+ soil_liq(begg:endg,:) = phase_liq(begg:endg,:)
+ soil_ice(begg:endg,:) = phase_ice(begg:endg,:)
+ tsoi(begg:endg,:) = phase_tsoi(begg:endg,:)
end subroutine phase_change
@@ -2580,27 +2641,27 @@ subroutine soil_thermal_properties ( begg, endg, glc_mask, &
implicit none
! ----- Input Variables --------
- real(r8), intent(in) :: soil_type(:) ! silt/sand/clay identified from a table (in theory... not yet :p )
- real(r8), intent(in) :: soil_z(:,:) ! soil depth (mid point of soil layer)
- real(r8), intent(in) :: soil_zh(:,:) ! soil depth (bottom interface of soil layer)
- real(r8), intent(in) :: soil_dz(:,:) ! soil layer thickness
- real(r8), intent(in) :: soil_liq(:,:) ! soil layer water content (kg/m2)
- real(r8), intent(in) :: soil_ice(:,:) ! soil layer ice content (kg/m2)
-
- real(r8), intent(inout) :: soil_tk_1d(:) ! nc prescribed soil tk (for all layers)
- real(r8), intent(inout) :: soil_cv_1d(:) ! nc prescribed soil cv (for all layers)
- real(r8), intent(inout) :: glc_tk_1d(:) ! nc prescribed soil tk (for all layers)
- real(r8), intent(inout) :: glc_cv_1d(:) ! nc prescribed soil cv (for all layers)
-
-
- integer , intent(in) :: mml_nsoi
- integer , intent(in) :: begg, endg ! spatial bounds
- real(r8), intent(in) :: glc_mask(:) ! mask of glaciated cells, use ice properties here.
+ integer, intent(in) :: mml_nsoi
+ integer, intent(in) :: begg, endg ! spatial bounds
+ real(r8), intent(in) :: soil_type(begg:endg) ! silt/sand/clay identified from a table (in theory... not yet :p )
+ real(r8), intent(in) :: soil_z(begg:endg,mml_nsoi) ! soil depth (mid point of soil layer)
+ real(r8), intent(in) :: soil_zh(begg:endg,mml_nsoi) ! soil depth (bottom interface of soil layer)
+ real(r8), intent(in) :: soil_dz(begg:endg,mml_nsoi) ! soil layer thickness
+ real(r8), intent(in) :: soil_liq(begg:endg,mml_nsoi) ! soil layer water content (kg/m2)
+ real(r8), intent(in) :: soil_ice(begg:endg,mml_nsoi) ! soil layer ice content (kg/m2)
+
+ real(r8), intent(in) :: soil_tk_1d(begg:endg) ! nc prescribed soil tk (for all layers)
+ real(r8), intent(in) :: soil_cv_1d(begg:endg) ! nc prescribed soil cv (for all layers)
+ real(r8), intent(in) :: glc_tk_1d(begg:endg) ! nc prescribed soil tk (for all layers)
+ real(r8), intent(in) :: glc_cv_1d(begg:endg) ! nc prescribed soil cv (for all layers)
+
+
+ real(r8), intent(in) :: glc_mask(begg:endg) ! mask of glaciated cells, use ice properties here.
! ----- Output Variables --------
- real(r8), intent(out) :: soil_tk(:,:) ! soil thermal resistance at each layer
- real(r8), intent(out) :: soil_cv(:,:) ! soil heat capacity at each layer
- real(r8), intent(out) :: soil_tkh(:,:)! soil thermal resistance at the boundary (bottom) of each layer
+ real(r8), intent(out) :: soil_tk(begg:endg,mml_nsoi) ! soil thermal resistance at each layer
+ real(r8), intent(out) :: soil_cv(begg:endg,mml_nsoi) ! soil heat capacity at each layer
+ real(r8), intent(out) :: soil_tkh(begg:endg,mml_nsoi) ! soil thermal resistance at the boundary (bottom) of each layer
! ----- Local Variables --------
integer :: i ! indexing variable
@@ -2632,70 +2693,65 @@ subroutine soil_thermal_properties ( begg, endg, glc_mask, &
! (consider using the table-implementation in Gordon's code and in the GFDL code)
! calculate the volumetric liquid / ice water content in each soil layer:
- watliq = soil_liq / (rho_wat * soil_dz) ! [kg/m2] / ([kg/m3] * [m]) -> unitless? hmm... or m3/m3 I guess
- watice = soil_ice / (rho_ice * soil_dz) ! m3/m3 ?
+ watliq(begg:endg,:) = soil_liq(begg:endg,:) / (rho_wat * soil_dz(begg:endg,:)) ! [kg/m2] / ([kg/m3] * [m]) -> unitless? hmm... or m3/m3 I guess
+ watice(begg:endg,:) = soil_ice(begg:endg,:) / (rho_ice * soil_dz(begg:endg,:)) ! m3/m3 ?
! I'm assuming matrix addition works as I expect in Fortran?
! ie I don't have to loop over g = begg,endg, do I? (I might if it goes spatially
! varying and the equations aren't the same have to check. But for now, implement like this)
do i = 1, mml_nsoi
-
- ! For soil points (non-glaciated), use these values:
-
- !soil_tk(:,i) = 1.5_r8 ! [W/m/K] ! in the ballpark of that for various soils in LaD
- soil_tk(:,i) = soil_tk_1d(:)
-
- !soil_cv(:,i) = 2.0e06_r8 ! [J/m3/K] ! that used for "medium" soil in LaD
- soil_cv(:,i) = soil_cv_1d(:)
-
- ! If the point is a glacier (glc_mask=1), use these values instead:
- where(glc_mask .eq. 1) ! really, I should make glc_mask a logical...
-
- ! Using heat capacity and thermal resistance of ice
- !soil_tk(:,i) = tk_ice ! [W/m/K]
- soil_tk(:,i) = glc_tk_1d(:)
-
- !2.3_r8 ! [W/m/K]
- ! value somewhat arbitrarily taken from:
- ! http://www.engineeringtoolbox.com/ice-thermal-properties-d_576.html
- ! ... find a more supportable value to use in the end
-
- !soil_cv(:,i) = cv_ice ! [J/m3/K]
- soil_cv(:,i) = glc_cv_1d(:)
-
- !1.8e06_r8 ! [J/m3/K]
- ! value somewhat arbitrarily taken from:
- ! http://www.engineeringtoolbox.com/ice-thermal-properties-d_576.html
- ! ... find a more supportable value to use in the end
-
- end where
-
-
- ! later: add water to thermal resistance? or no?
- ! is this right? soil_cv = actual_soil_cv + water_cv + ice_cv ?
- !soil_cv(:,i) = 1.926e06 + cv_wat*watliq(:,i) + cv_ice*watice(:,i) ! [J/m3/K]
-
- enddo ! loop over all soil layers and assign them the 1d value
-
-
- soil_tkh(:,:) = 0.0_r8 ! for now, just so each entry has a value (it should really be size (:, mml_soi-1), not (:,mml_nsoi)
- ! now find tkh
- do i = 1, mml_nsoi-1 ! no heat diffusion through bottom layer
- soil_tkh(:,i) = soil_tk(:,i) * soil_tk(:,i+1) * ( soil_z(:,i) - soil_z(:,i+1) ) / &
- ( soil_tk(:,i) * (soil_zh(:,i) - soil_z(:,i+1)) + &
- soil_tk(:,i+1) * (soil_z(:,i) - soil_zh(:,i)) )
-
- ! This LOOKS the same as the matlab eq'n... add zh to
- ! output and see if that looks okay...
-
- ! NOTE: tk and tkh not currently dependent on water/ice content of layer!
- ! ... but I'll keep it like that, for now anyhow. More straightforward.
- enddo
-
-
-
+ ! For soil points (non-glaciated), use these values:
+
+ !soil_tk(:,i) = 1.5_r8 ! [W/m/K] ! in the ballpark of that for various soils in LaD
+ soil_tk(begg:endg,i) = soil_tk_1d(begg:endg)
+
+ !soil_cv(:,i) = 2.0e06_r8 ! [J/m3/K] ! that used for "medium" soil in LaD
+ soil_cv(begg:endg,i) = soil_cv_1d(begg:endg)
+
+ ! If the point is a glacier (glc_mask=1), use these values instead:
+ where(glc_mask(begg:endg) == 1) ! really, I should make glc_mask a logical...
+
+ ! Using heat capacity and thermal resistance of ice
+ !soil_tk(:,i) = tk_ice ! [W/m/K]
+ soil_tk(:,i) = glc_tk_1d
+
+ !2.3_r8 ! [W/m/K]
+ ! value somewhat arbitrarily taken from:
+ ! http://www.engineeringtoolbox.com/ice-thermal-properties-d_576.html
+ ! ... find a more supportable value to use in the end
+
+ !soil_cv(:,i) = cv_ice ! [J/m3/K]
+ soil_cv(:,i) = glc_cv_1d
+
+ !1.8e06_r8 ! [J/m3/K]
+ ! value somewhat arbitrarily taken from:
+ ! http://www.engineeringtoolbox.com/ice-thermal-properties-d_576.html
+ ! ... find a more supportable value to use in the end
+
+ end where
+
+ ! later: add water to thermal resistance? or no?
+ ! is this right? soil_cv = actual_soil_cv + water_cv + ice_cv ?
+ !soil_cv(:,i) = 1.926e06 + cv_wat*watliq(:,i) + cv_ice*watice(:,i) ! [J/m3/K]
+
+ end do ! loop over all soil layers and assign them the 1d value
+
+ soil_tkh(begg:endg,:) = 0.0_r8 ! for now, just so each entry has a value (it should really be size (:, mml_soi-1), not (:,mml_nsoi)
+ ! now find tkh
+ do i = 1, mml_nsoi-1 ! no heat diffusion through bottom layer
+ soil_tkh(begg:endg,i) = soil_tk(begg:endg,i) * soil_tk(begg:endg,i+1) * ( soil_z(begg:endg,i) - soil_z(begg:endg,i+1) ) / &
+ ( soil_tk(begg:endg,i) * (soil_zh(begg:endg,i) - soil_z(begg:endg,i+1)) + &
+ soil_tk(begg:endg,i+1) * (soil_z(begg:endg,i) - soil_zh(begg:endg,i)) )
+
+ ! This LOOKS the same as the matlab eq'n... add zh to
+ ! output and see if that looks okay...
+
+ ! NOTE: tk and tkh not currently dependent on water/ice content of layer!
+ ! ... but I'll keep it like that, for now anyhow. More straightforward.
+ enddo
+
end subroutine soil_thermal_properties
diff --git a/src/cpl/clm_cpl_indices.F90 b/src/cpl/clm_cpl_indices.F90
index 525b709c..129cb6a2 100644
--- a/src/cpl/clm_cpl_indices.F90
+++ b/src/cpl/clm_cpl_indices.F90
@@ -18,16 +18,12 @@ module clm_cpl_indices
!
! !PUBLIC DATA MEMBERS:
!
- integer , public :: glc_nec ! number of elevation classes for glacier_mec landunits
- ! (from coupler) - must equal maxpatch_glcmec from namelist
-
! lnd -> drv (required)
integer, public ::index_l2x_Flrl_rofsur ! lnd->rtm input liquid surface fluxes
integer, public ::index_l2x_Flrl_rofgwl ! lnd->rtm input liquid gwl fluxes
integer, public ::index_l2x_Flrl_rofsub ! lnd->rtm input liquid subsurface fluxes
integer, public ::index_l2x_Flrl_rofi ! lnd->rtm input frozen fluxes
- integer, public ::index_l2x_Flrl_irrig ! irrigation withdrawal
integer, public ::index_l2x_Sl_t ! temperature
integer, public ::index_l2x_Sl_tref ! 2m reference temperature
@@ -49,21 +45,11 @@ module clm_cpl_indices
integer, public ::index_l2x_Fall_lwup ! upward longwave heat flux
integer, public ::index_l2x_Fall_evap ! evaporation water flux
integer, public ::index_l2x_Fall_swnet ! heat flux shortwave net
- integer, public ::index_l2x_Fall_fco2_lnd ! co2 flux **For testing set to 0
integer, public ::index_l2x_Fall_flxdst1 ! dust flux size bin 1
integer, public ::index_l2x_Fall_flxdst2 ! dust flux size bin 2
integer, public ::index_l2x_Fall_flxdst3 ! dust flux size bin 3
integer, public ::index_l2x_Fall_flxdst4 ! dust flux size bin 4
- integer, public ::index_l2x_Fall_flxvoc ! MEGAN fluxes
- integer, public ::index_l2x_Fall_flxfire ! Fire fluxes
- integer, public ::index_l2x_Sl_ztopfire ! Top of fire emissions (m)
-
- ! In the following, index 0 is bare land, other indices are glc elevation classes
- integer, allocatable, public ::index_l2x_Sl_tsrf(:) ! glc MEC temperature
- integer, allocatable, public ::index_l2x_Sl_topo(:) ! glc MEC topo height
- integer, allocatable, public ::index_l2x_Flgl_qice(:) ! glc MEC ice flux
- integer, public ::index_x2l_Sa_methane
integer, public ::index_l2x_Fall_methane
integer, public :: nflds_l2x = 0
@@ -87,8 +73,6 @@ module clm_cpl_indices
integer, public ::index_x2l_Faxa_swvdr ! sw: vis direct downward
integer, public ::index_x2l_Faxa_swndf ! sw: nir diffuse downward
integer, public ::index_x2l_Faxa_swvdf ! sw: vis diffuse downward
- integer, public ::index_x2l_Sa_co2prog ! bottom atm level prognostic co2
- integer, public ::index_x2l_Sa_co2diag ! bottom atm level diagnostic co2
integer, public ::index_x2l_Faxa_bcphidry ! flux: Black Carbon hydrophilic dry deposition
integer, public ::index_x2l_Faxa_bcphodry ! flux: Black Carbon hydrophobic dry deposition
integer, public ::index_x2l_Faxa_bcphiwet ! flux: Black Carbon hydrophilic wet deposition
@@ -104,13 +88,6 @@ module clm_cpl_indices
integer, public ::index_x2l_Faxa_dstdry3 ! flux: Size 3 dust -- dry deposition
integer, public ::index_x2l_Faxa_dstdry4 ! flux: Size 4 dust -- dry deposition
- integer, public ::index_x2l_Faxa_nhx ! flux nhx from atm
- integer, public ::index_x2l_Faxa_noy ! flux noy from atm
-
- integer, public ::index_x2l_Flrr_flood ! rtm->lnd rof flood flux
- integer, public ::index_x2l_Flrr_volr ! rtm->lnd rof volr total volume
- integer, public ::index_x2l_Flrr_volrmch ! rtm->lnd rof volr main channel volume
-
! In the following, index 0 is bare land, other indices are glc elevation classes
integer, allocatable, public ::index_x2l_Sg_ice_covered(:) ! Fraction of glacier from glc model
integer, allocatable, public ::index_x2l_Sg_topo(:) ! Topo height from glc model
@@ -136,10 +113,6 @@ subroutine clm_cpl_indices_set( )
use seq_flds_mod , only: seq_flds_x2l_fields, seq_flds_l2x_fields
use mct_mod , only: mct_aVect, mct_aVect_init, mct_avect_indexra
use mct_mod , only: mct_aVect_clean, mct_avect_nRattr
- use seq_drydep_mod , only: drydep_fields_token, lnd_drydep
- use shr_megan_mod , only: shr_megan_fields_token, shr_megan_mechcomps_n
- use shr_fire_emis_mod,only: shr_fire_emis_fields_token, shr_fire_emis_ztop_token, shr_fire_emis_mechcomps_n
- use clm_varctl , only: ndep_from_cpl
use glc_elevclass_mod, only: glc_get_num_elevation_classes, glc_elevclass_as_string
!
! !ARGUMENTS:
@@ -175,7 +148,6 @@ subroutine clm_cpl_indices_set( )
index_l2x_Flrl_rofgwl = mct_avect_indexra(l2x,'Flrl_rofgwl')
index_l2x_Flrl_rofsub = mct_avect_indexra(l2x,'Flrl_rofsub')
index_l2x_Flrl_rofi = mct_avect_indexra(l2x,'Flrl_rofi')
- index_l2x_Flrl_irrig = mct_avect_indexra(l2x,'Flrl_irrig')
index_l2x_Sl_t = mct_avect_indexra(l2x,'Sl_t')
index_l2x_Sl_snowh = mct_avect_indexra(l2x,'Sl_snowh')
@@ -190,12 +162,6 @@ subroutine clm_cpl_indices_set( )
index_l2x_Sl_fv = mct_avect_indexra(l2x,'Sl_fv')
index_l2x_Sl_soilw = mct_avect_indexra(l2x,'Sl_soilw',perrwith='quiet')
- if ( lnd_drydep )then
- index_l2x_Sl_ddvel = mct_avect_indexra(l2x, trim(drydep_fields_token))
- else
- index_l2x_Sl_ddvel = 0
- end if
-
index_l2x_Fall_taux = mct_avect_indexra(l2x,'Fall_taux')
index_l2x_Fall_tauy = mct_avect_indexra(l2x,'Fall_tauy')
index_l2x_Fall_lat = mct_avect_indexra(l2x,'Fall_lat')
@@ -208,26 +174,8 @@ subroutine clm_cpl_indices_set( )
index_l2x_Fall_flxdst3 = mct_avect_indexra(l2x,'Fall_flxdst3')
index_l2x_Fall_flxdst4 = mct_avect_indexra(l2x,'Fall_flxdst4')
- index_l2x_Fall_fco2_lnd = mct_avect_indexra(l2x,'Fall_fco2_lnd',perrwith='quiet')
-
index_l2x_Fall_methane = mct_avect_indexra(l2x,'Fall_methane',perrWith='quiet')
- ! MEGAN fluxes
- if (shr_megan_mechcomps_n>0) then
- index_l2x_Fall_flxvoc = mct_avect_indexra(l2x,trim(shr_megan_fields_token))
- else
- index_l2x_Fall_flxvoc = 0
- endif
-
- ! Fire fluxes
- if (shr_fire_emis_mechcomps_n>0) then
- index_l2x_Fall_flxfire = mct_avect_indexra(l2x,trim(shr_fire_emis_fields_token))
- index_l2x_Sl_ztopfire = mct_avect_indexra(l2x,trim(shr_fire_emis_ztop_token))
- else
- index_l2x_Fall_flxfire = 0
- index_l2x_Sl_ztopfire = 0
- endif
-
!-------------------------------------------------------------
! drv -> clm
!-------------------------------------------------------------
@@ -240,13 +188,6 @@ subroutine clm_cpl_indices_set( )
index_x2l_Sa_pbot = mct_avect_indexra(x2l,'Sa_pbot')
index_x2l_Sa_tbot = mct_avect_indexra(x2l,'Sa_tbot')
index_x2l_Sa_shum = mct_avect_indexra(x2l,'Sa_shum')
- index_x2l_Sa_co2prog = mct_avect_indexra(x2l,'Sa_co2prog',perrwith='quiet')
- index_x2l_Sa_co2diag = mct_avect_indexra(x2l,'Sa_co2diag',perrwith='quiet')
-
- index_x2l_Sa_methane = mct_avect_indexra(x2l,'Sa_methane',perrWith='quiet')
-
- index_x2l_Flrr_volr = mct_avect_indexra(x2l,'Flrr_volr')
- index_x2l_Flrr_volrmch = mct_avect_indexra(x2l,'Flrr_volrmch')
index_x2l_Faxa_lwdn = mct_avect_indexra(x2l,'Faxa_lwdn')
index_x2l_Faxa_rainc = mct_avect_indexra(x2l,'Faxa_rainc')
@@ -272,15 +213,6 @@ subroutine clm_cpl_indices_set( )
index_x2l_Faxa_dstwet3 = mct_avect_indexra(x2l,'Faxa_dstwet3')
index_x2l_Faxa_dstwet4 = mct_avect_indexra(x2l,'Faxa_dstwet4')
- index_x2l_Faxa_nhx = mct_avect_indexra(x2l,'Faxa_nhx', perrWith='quiet')
- index_x2l_Faxa_noy = mct_avect_indexra(x2l,'Faxa_noy', perrWith='quiet')
-
- if (index_x2l_Faxa_nhx > 0 .and. index_x2l_Faxa_noy > 0) then
- ndep_from_cpl = .true.
- end if
-
- index_x2l_Flrr_flood = mct_avect_indexra(x2l,'Flrr_flood')
-
!-------------------------------------------------------------
! glc coupling
!-------------------------------------------------------------
@@ -288,21 +220,13 @@ subroutine clm_cpl_indices_set( )
index_x2l_Sg_icemask = mct_avect_indexra(x2l,'Sg_icemask')
index_x2l_Sg_icemask_coupled_fluxes = mct_avect_indexra(x2l,'Sg_icemask_coupled_fluxes')
- glc_nec = glc_get_num_elevation_classes()
- if (glc_nec < 1) then
- call shr_sys_abort('ERROR: In CLM4.5 and later, glc_nec must be at least 1.')
- end if
-
! Create coupling fields for all glc elevation classes (1:glc_nec) plus bare land
! (index 0).
- allocate(index_l2x_Sl_tsrf(0:glc_nec))
- allocate(index_l2x_Sl_topo(0:glc_nec))
- allocate(index_l2x_Flgl_qice(0:glc_nec))
- allocate(index_x2l_Sg_ice_covered(0:glc_nec))
- allocate(index_x2l_Sg_topo(0:glc_nec))
- allocate(index_x2l_Flgg_hflx(0:glc_nec))
+ allocate(index_x2l_Sg_ice_covered(0:10))
+ allocate(index_x2l_Sg_topo(0:10))
+ allocate(index_x2l_Flgg_hflx(0:10))
- do num = 0,glc_nec
+ do num = 0,10
nec_str = glc_elevclass_as_string(num)
name = 'Sg_ice_covered' // nec_str
@@ -311,13 +235,6 @@ subroutine clm_cpl_indices_set( )
index_x2l_Sg_topo(num) = mct_avect_indexra(x2l,trim(name))
name = 'Flgg_hflx' // nec_str
index_x2l_Flgg_hflx(num) = mct_avect_indexra(x2l,trim(name))
-
- name = 'Sl_tsrf' // nec_str
- index_l2x_Sl_tsrf(num) = mct_avect_indexra(l2x,trim(name))
- name = 'Sl_topo' // nec_str
- index_l2x_Sl_topo(num) = mct_avect_indexra(l2x,trim(name))
- name = 'Flgl_qice' // nec_str
- index_l2x_Flgl_qice(num) = mct_avect_indexra(l2x,trim(name))
end do
call mct_aVect_clean(x2l)
diff --git a/src/cpl/lnd_comp_mct.F90 b/src/cpl/lnd_comp_mct.F90
index 394ea63e..929651ec 100644
--- a/src/cpl/lnd_comp_mct.F90
+++ b/src/cpl/lnd_comp_mct.F90
@@ -42,10 +42,9 @@ subroutine lnd_init_mct( EClock, cdata_l, x2l_l, l2x_l, NLFilename )
use shr_kind_mod , only : shr_kind_cl
use abortutils , only : endrun
use clm_time_manager , only : get_nstep, get_step_size, set_timemgr_init, set_nextsw_cday
- use clm_initializeMod, only : initialize1, initialize2, lnd2atm_inst, lnd2glc_inst
+ use clm_initializeMod, only : initialize1, initialize2, lnd2atm_inst
use clm_varctl , only : finidat,single_column, clm_varctl_set, iulog, noland
use clm_varctl , only : inst_index, inst_suffix, inst_name
- use clm_varorb , only : eccen, obliqr, lambm0, mvelpp
use controlMod , only : control_setNL
use decompMod , only : get_proc_bounds
use domainMod , only : ldomain
@@ -151,11 +150,6 @@ subroutine lnd_init_mct( EClock, cdata_l, x2l_l, l2x_l, NLFilename )
call shr_file_getLogLevel(shrloglev)
call shr_file_setLogUnit (iulog)
- ! Use infodata to set orbital values
-
- call seq_infodata_GetData( infodata, orb_eccen=eccen, orb_mvelpp=mvelpp, &
- orb_lambm0=lambm0, orb_obliqr=obliqr )
-
! Consistency check on namelist filename
call control_setNL("lnd_in"//trim(inst_suffix))
@@ -252,7 +246,7 @@ subroutine lnd_init_mct( EClock, cdata_l, x2l_l, l2x_l, NLFilename )
! Create land export state
- call lnd_export(bounds, lnd2atm_inst, lnd2glc_inst, l2x_l%rattr)
+ call lnd_export(bounds, lnd2atm_inst, l2x_l%rattr)
!write(iulog,*)'MML back from lnd_export'
! Fill in infodata settings
@@ -295,14 +289,13 @@ subroutine lnd_run_mct(EClock, cdata_l, x2l_l, l2x_l)
!
! !USES:
use shr_kind_mod , only : r8 => shr_kind_r8
- use clm_initializeMod, only : lnd2atm_inst, atm2lnd_inst, lnd2glc_inst, glc2lnd_inst
+ use clm_initializeMod, only : lnd2atm_inst, atm2lnd_inst
use clm_driver , only : clm_drv
use clm_time_manager, only : get_curr_date, get_nstep, get_curr_calday, get_step_size
use clm_time_manager, only : advance_timestep, set_nextsw_cday,update_rad_dtime
use decompMod , only : get_proc_bounds
use abortutils , only : endrun
use clm_varctl , only : iulog
- use clm_varorb , only : eccen, obliqr, lambm0, mvelpp
use shr_file_mod , only : shr_file_setLogUnit, shr_file_setLogLevel
use shr_file_mod , only : shr_file_getLogUnit, shr_file_getLogLevel
use seq_cdata_mod , only : seq_cdata, seq_cdata_setptrs
@@ -340,16 +333,13 @@ subroutine lnd_run_mct(EClock, cdata_l, x2l_l, l2x_l)
logical :: dosend ! true => send data back to driver
logical :: doalb ! .true. ==> do albedo calculation on this time step
logical :: rof_prognostic ! .true. => running with a prognostic ROF model
- logical :: glc_present ! .true. => running with a non-stub GLC model
real(r8) :: nextsw_cday ! calday from clock of next radiation computation
real(r8) :: caldayp1 ! clm calday plus dtime offset
integer :: shrlogunit,shrloglev ! old values for share log unit and log level
integer :: lbnum ! input to memory diagnostic
integer :: g,i,lsize ! counters
- real(r8) :: calday ! calendar day for nstep
real(r8) :: declin ! solar declination angle in radians for nstep
real(r8) :: declinp1 ! solar declination angle in radians for nstep+1
- real(r8) :: eccf ! earth orbit eccentricity factor
real(r8) :: recip ! reciprical
logical,save :: first_call = .true. ! first call work
type(seq_infodata_type),pointer :: infodata ! CESM information from the driver
@@ -398,8 +388,7 @@ subroutine lnd_run_mct(EClock, cdata_l, x2l_l, l2x_l)
! their being set in initialization, so need to get them in the run method.
call seq_infodata_GetData( infodata, &
- rof_prognostic=rof_prognostic, &
- glc_present=glc_present)
+ rof_prognostic=rof_prognostic)
! Map MCT to land data type
! Perform downscaling if appropriate
@@ -411,18 +400,9 @@ subroutine lnd_run_mct(EClock, cdata_l, x2l_l, l2x_l)
call t_startf ('lc_lnd_import')
call lnd_import( bounds, &
x2l = x2l_l%rattr, &
- glc_present = glc_present, &
- atm2lnd_inst = atm2lnd_inst, &
- glc2lnd_inst = glc2lnd_inst)
+ atm2lnd_inst = atm2lnd_inst)
call t_stopf ('lc_lnd_import')
- !write(*,*)'MML just after lc_lnd_impoft'
-
- ! Use infodata to set orbital values if updated mid-run
-
- call seq_infodata_GetData( infodata, orb_eccen=eccen, orb_mvelpp=mvelpp, &
- orb_lambm0=lambm0, orb_obliqr=obliqr )
- !write(*,*)'MML just after se_infodata_GetData'
! Loop over time steps in coupling interval
dosend = .false.
@@ -468,25 +448,20 @@ subroutine lnd_run_mct(EClock, cdata_l, x2l_l, l2x_l)
call t_barrierf('sync_clm_run1', mpicom)
call t_startf ('clm_run')
- call t_startf ('shr_orb_decl')
- calday = get_curr_calday()
- call shr_orb_decl( calday , eccen, mvelpp, lambm0, obliqr, declin , eccf )
- call shr_orb_decl( nextsw_cday, eccen, mvelpp, lambm0, obliqr, declinp1, eccf )
- call t_stopf ('shr_orb_decl')
call clm_drv(doalb, nextsw_cday, declinp1, declin, rstwr, nlend, rdate, rof_prognostic)
call t_stopf ('clm_run')
! Create l2x_l export state - add river runoff input to l2x_l if appropriate
!write(*,*)'MML export l2x_l'
call t_startf ('lc_lnd_export')
- call lnd_export(bounds, lnd2atm_inst, lnd2glc_inst, l2x_l%rattr)
+ call lnd_export(bounds, lnd2atm_inst, l2x_l%rattr)
call t_stopf ('lc_lnd_export')
! Advance clm time step
!write(*,*)'MML advance clm timestep'
- call t_startf ('lc_clm2_adv_timestep')
+ call t_startf ('lc_slim_adv_timestep')
call advance_timestep()
- call t_stopf ('lc_clm2_adv_timestep')
+ call t_stopf ('lc_slim_adv_timestep')
end do
diff --git a/src/cpl/lnd_import_export.F90 b/src/cpl/lnd_import_export.F90
index 0232c0aa..3352d167 100644
--- a/src/cpl/lnd_import_export.F90
+++ b/src/cpl/lnd_import_export.F90
@@ -4,9 +4,7 @@ module lnd_import_export
use abortutils , only: endrun
use decompmod , only: bounds_type
use lnd2atmType , only: lnd2atm_type
- use lnd2glcMod , only: lnd2glc_type
use atm2lndType , only: atm2lnd_type
- use glc2lndMod , only: glc2lnd_type
use clm_cpl_indices
!
implicit none
@@ -15,7 +13,7 @@ module lnd_import_export
contains
!===============================================================================
- subroutine lnd_import( bounds, x2l, glc_present, atm2lnd_inst, glc2lnd_inst)
+ subroutine lnd_import( bounds, x2l, atm2lnd_inst)
!---------------------------------------------------------------------------
! !DESCRIPTION:
@@ -23,9 +21,8 @@ subroutine lnd_import( bounds, x2l, glc_present, atm2lnd_inst, glc2lnd_inst)
!
! !USES:
use seq_flds_mod , only: seq_flds_x2l_fields
- use clm_varctl , only: co2_type, co2_ppmv, iulog
- use clm_varctl , only: ndep_from_cpl
- use clm_varcon , only: rair, o2_molar_const, c13ratio
+ use clm_varctl , only: iulog
+ use clm_varcon , only: rair, o2_molar_const
use shr_const_mod , only: SHR_CONST_TKFRZ
use shr_string_mod , only: shr_string_listGetName
use domainMod , only: ldomain
@@ -34,9 +31,7 @@ subroutine lnd_import( bounds, x2l, glc_present, atm2lnd_inst, glc2lnd_inst)
! !ARGUMENTS:
type(bounds_type) , intent(in) :: bounds ! bounds
real(r8) , intent(in) :: x2l(:,:) ! driver import state to land model
- logical , intent(in) :: glc_present ! .true. => running with a non-stub GLC model
type(atm2lnd_type) , intent(inout) :: atm2lnd_inst ! clm internal input data type
- type(glc2lnd_type) , intent(inout) :: glc2lnd_inst ! clm internal input data type
!
! !LOCAL VARIABLES:
integer :: g,i,k,nstep,ier ! indices, number of steps, and error code
@@ -49,10 +44,6 @@ subroutine lnd_import( bounds, x2l, glc_present, atm2lnd_inst, glc2lnd_inst)
real(r8) :: forc_rainl ! rainxy Atm flux mm/s
real(r8) :: forc_snowc ! snowfxy Atm flux mm/s
real(r8) :: forc_snowl ! snowfxl Atm flux mm/s
- real(r8) :: co2_ppmv_diag ! temporary
- real(r8) :: co2_ppmv_prog ! temporary
- real(r8) :: co2_ppmv_val ! temporary
- integer :: co2_type_idx ! integer flag for co2_type options
real(r8) :: esatw ! saturation vapor pressure over water (Pa)
real(r8) :: esati ! saturation vapor pressure over ice (Pa)
real(r8) :: a0,a1,a2,a3,a4,a5,a6 ! coefficients for esat over water
@@ -79,18 +70,6 @@ subroutine lnd_import( bounds, x2l, glc_present, atm2lnd_inst, glc2lnd_inst)
esati(t) = 100._r8*(b0+t*(b1+t*(b2+t*(b3+t*(b4+t*(b5+t*b6))))))
!---------------------------------------------------------------------------
- co2_type_idx = 0
- if (co2_type == 'prognostic') then
- co2_type_idx = 1
- else if (co2_type == 'diagnostic') then
- co2_type_idx = 2
- end if
- if (co2_type == 'prognostic' .and. index_x2l_Sa_co2prog == 0) then
- call endrun( sub//' ERROR: must have nonzero index_x2l_Sa_co2prog for co2_type equal to prognostic' )
- else if (co2_type == 'diagnostic' .and. index_x2l_Sa_co2diag == 0) then
- call endrun( sub//' ERROR: must have nonzero index_x2l_Sa_co2diag for co2_type equal to diagnostic' )
- end if
-
! Note that the precipitation fluxes received from the coupler
! are in units of kg/s/m^2. To convert these precipitation rates
! in units of mm/sec, one must divide by 1000 kg/m^3 and multiply
@@ -101,19 +80,9 @@ subroutine lnd_import( bounds, x2l, glc_present, atm2lnd_inst, glc2lnd_inst)
do g = bounds%begg,bounds%endg
i = 1 + (g - bounds%begg)
- ! Determine flooding input, sign convention is positive downward and
- ! hierarchy is atm/glc/lnd/rof/ice/ocn. so water sent from rof to land is negative,
- ! change the sign to indicate addition of water to system.
-
- atm2lnd_inst%forc_flood_grc(g) = -x2l(index_x2l_Flrr_flood,i)
-
- atm2lnd_inst%volr_grc(g) = x2l(index_x2l_Flrr_volr,i) * (ldomain%area(g) * 1.e6_r8)
- atm2lnd_inst%volrmch_grc(g)= x2l(index_x2l_Flrr_volrmch,i) * (ldomain%area(g) * 1.e6_r8)
-
! Determine required receive fields
atm2lnd_inst%forc_hgt_grc(g) = x2l(index_x2l_Sa_z,i) ! zgcmxy Atm state m
- atm2lnd_inst%forc_topo_grc(g) = x2l(index_x2l_Sa_topo,i) ! Atm surface height (m)
atm2lnd_inst%forc_u_grc(g) = x2l(index_x2l_Sa_u,i) ! forc_uxy Atm state m/s
atm2lnd_inst%forc_v_grc(g) = x2l(index_x2l_Sa_v,i) ! forc_vxy Atm state m/s
atm2lnd_inst%forc_solad_grc(g,2) = x2l(index_x2l_Faxa_swndr,i) ! forc_sollxy Atm flux W/m^2
@@ -121,7 +90,6 @@ subroutine lnd_import( bounds, x2l, glc_present, atm2lnd_inst, glc2lnd_inst)
atm2lnd_inst%forc_solai_grc(g,2) = x2l(index_x2l_Faxa_swndf,i) ! forc_solldxy Atm flux W/m^2
atm2lnd_inst%forc_solai_grc(g,1) = x2l(index_x2l_Faxa_swvdf,i) ! forc_solsdxy Atm flux W/m^2
- atm2lnd_inst%forc_th_not_downscaled_grc(g) = x2l(index_x2l_Sa_ptem,i) ! forc_thxy Atm state K
atm2lnd_inst%forc_q_not_downscaled_grc(g) = x2l(index_x2l_Sa_shum,i) ! forc_qxy Atm state kg/kg
atm2lnd_inst%forc_pbot_not_downscaled_grc(g) = x2l(index_x2l_Sa_pbot,i) ! ptcmxy Atm state Pa
atm2lnd_inst%forc_t_not_downscaled_grc(g) = x2l(index_x2l_Sa_tbot,i) ! forc_txy Atm state K
@@ -132,40 +100,6 @@ subroutine lnd_import( bounds, x2l, glc_present, atm2lnd_inst, glc2lnd_inst)
forc_snowc = x2l(index_x2l_Faxa_snowc,i) ! mm/s
forc_snowl = x2l(index_x2l_Faxa_snowl,i) ! mm/s
- ! atmosphere coupling, for prognostic/prescribed aerosols
- atm2lnd_inst%forc_aer_grc(g,1) = x2l(index_x2l_Faxa_bcphidry,i)
- atm2lnd_inst%forc_aer_grc(g,2) = x2l(index_x2l_Faxa_bcphodry,i)
- atm2lnd_inst%forc_aer_grc(g,3) = x2l(index_x2l_Faxa_bcphiwet,i)
- atm2lnd_inst%forc_aer_grc(g,4) = x2l(index_x2l_Faxa_ocphidry,i)
- atm2lnd_inst%forc_aer_grc(g,5) = x2l(index_x2l_Faxa_ocphodry,i)
- atm2lnd_inst%forc_aer_grc(g,6) = x2l(index_x2l_Faxa_ocphiwet,i)
- atm2lnd_inst%forc_aer_grc(g,7) = x2l(index_x2l_Faxa_dstwet1,i)
- atm2lnd_inst%forc_aer_grc(g,8) = x2l(index_x2l_Faxa_dstdry1,i)
- atm2lnd_inst%forc_aer_grc(g,9) = x2l(index_x2l_Faxa_dstwet2,i)
- atm2lnd_inst%forc_aer_grc(g,10) = x2l(index_x2l_Faxa_dstdry2,i)
- atm2lnd_inst%forc_aer_grc(g,11) = x2l(index_x2l_Faxa_dstwet3,i)
- atm2lnd_inst%forc_aer_grc(g,12) = x2l(index_x2l_Faxa_dstdry3,i)
- atm2lnd_inst%forc_aer_grc(g,13) = x2l(index_x2l_Faxa_dstwet4,i)
- atm2lnd_inst%forc_aer_grc(g,14) = x2l(index_x2l_Faxa_dstdry4,i)
-
- ! Determine optional receive fields
-
- if (index_x2l_Sa_co2prog /= 0) then
- co2_ppmv_prog = x2l(index_x2l_Sa_co2prog,i) ! co2 atm state prognostic
- else
- co2_ppmv_prog = co2_ppmv
- end if
-
- if (index_x2l_Sa_co2diag /= 0) then
- co2_ppmv_diag = x2l(index_x2l_Sa_co2diag,i) ! co2 atm state diagnostic
- else
- co2_ppmv_diag = co2_ppmv
- end if
-
- if (index_x2l_Sa_methane /= 0) then
- atm2lnd_inst%forc_pch4_grc(g) = x2l(index_x2l_Sa_methane,i)
- endif
-
! Determine derived quantities for required fields
forc_t = atm2lnd_inst%forc_t_not_downscaled_grc(g)
@@ -178,7 +112,6 @@ subroutine lnd_import( bounds, x2l, glc_present, atm2lnd_inst, glc2lnd_inst)
atm2lnd_inst%forc_vp_grc(g) = forc_q * forc_pbot / (0.622_r8 + 0.378_r8 * forc_q)
atm2lnd_inst%forc_rho_not_downscaled_grc(g) = &
(forc_pbot - 0.378_r8 * atm2lnd_inst%forc_vp_grc(g)) / (rair * forc_t)
- atm2lnd_inst%forc_po2_grc(g) = o2_molar_const * forc_pbot
atm2lnd_inst%forc_wind_grc(g) = sqrt(atm2lnd_inst%forc_u_grc(g)**2 + atm2lnd_inst%forc_v_grc(g)**2)
atm2lnd_inst%forc_solar_grc(g) = atm2lnd_inst%forc_solad_grc(g,1) + atm2lnd_inst%forc_solai_grc(g,1) + &
atm2lnd_inst%forc_solad_grc(g,2) + atm2lnd_inst%forc_solai_grc(g,2)
@@ -202,8 +135,6 @@ subroutine lnd_import( bounds, x2l, glc_present, atm2lnd_inst, glc2lnd_inst)
endif
endif
- atm2lnd_inst%forc_rh_grc(g) = 100.0_r8*(forc_q / qsat)
-
! Check that solar, specific-humidity and LW downward aren't negative
if ( atm2lnd_inst%forc_lwrad_not_downscaled_grc(g) <= 0.0_r8 )then
call endrun( sub//' ERROR: Longwave down sent from the atmosphere model is negative or zero' )
@@ -232,50 +163,13 @@ subroutine lnd_import( bounds, x2l, glc_present, atm2lnd_inst, glc2lnd_inst)
'(Not a Number from a bad floating point calculation)' )
end if
- ! Make sure relative humidity is properly bounded
- ! atm2lnd_inst%forc_rh_grc(g) = min( 100.0_r8, atm2lnd_inst%forc_rh_grc(g) )
- ! atm2lnd_inst%forc_rh_grc(g) = max( 0.0_r8, atm2lnd_inst%forc_rh_grc(g) )
-
- ! Determine derived quantities for optional fields
- ! Note that the following does unit conversions from ppmv to partial pressures (Pa)
- ! Note that forc_pbot is in Pa
-
- if (co2_type_idx == 1) then
- co2_ppmv_val = co2_ppmv_prog
- else if (co2_type_idx == 2) then
- co2_ppmv_val = co2_ppmv_diag
- else
- co2_ppmv_val = co2_ppmv
- end if
- atm2lnd_inst%forc_pco2_grc(g) = co2_ppmv_val * 1.e-6_r8 * forc_pbot
-
- if (ndep_from_cpl) then
- ! The coupler is sending ndep in units if kgN/m2/s - and clm uses units of gN/m2/sec - so the
- ! following conversion needs to happen
- atm2lnd_inst%forc_ndep_grc(g) = (x2l(index_x2l_Faxa_nhx, i) + x2l(index_x2l_faxa_noy, i))*1000._r8
- end if
-
end do
- call glc2lnd_inst%set_glc2lnd_fields( &
- bounds = bounds, &
- glc_present = glc_present, &
- ! NOTE(wjs, 2017-12-13) the x2l argument doesn't have the typical bounds
- ! subsetting (bounds%begg:bounds%endg). This mirrors the lack of these bounds in
- ! the call to lnd_import from lnd_run_mct. This is okay as long as this code is
- ! outside a clump loop.
- x2l = x2l, &
- index_x2l_Sg_ice_covered = index_x2l_Sg_ice_covered, &
- index_x2l_Sg_topo = index_x2l_Sg_topo, &
- index_x2l_Flgg_hflx = index_x2l_Flgg_hflx, &
- index_x2l_Sg_icemask = index_x2l_Sg_icemask, &
- index_x2l_Sg_icemask_coupled_fluxes = index_x2l_Sg_icemask_coupled_fluxes)
-
end subroutine lnd_import
!===============================================================================
- subroutine lnd_export( bounds, lnd2atm_inst, lnd2glc_inst, l2x)
+ subroutine lnd_export( bounds, lnd2atm_inst, l2x)
!---------------------------------------------------------------------------
! !DESCRIPTION:
@@ -286,9 +180,6 @@ subroutine lnd_export( bounds, lnd2atm_inst, lnd2glc_inst, l2x)
use seq_flds_mod , only : seq_flds_l2x_fields
use clm_varctl , only : iulog
use clm_time_manager , only : get_nstep, get_step_size
- use seq_drydep_mod , only : n_drydep
- use shr_megan_mod , only : shr_megan_mechcomps_n
- use shr_fire_emis_mod , only : shr_fire_emis_mechcomps_n
use domainMod , only : ldomain
use shr_string_mod , only : shr_string_listGetName
use shr_infnan_mod , only : isnan => shr_infnan_isnan
@@ -297,7 +188,6 @@ subroutine lnd_export( bounds, lnd2atm_inst, lnd2glc_inst, l2x)
implicit none
type(bounds_type) , intent(in) :: bounds ! bounds
type(lnd2atm_type), intent(inout) :: lnd2atm_inst ! clm land to atmosphere exchange data type
- type(lnd2glc_type), intent(inout) :: lnd2glc_inst ! clm land to atmosphere exchange data type
real(r8) , intent(out) :: l2x(:,:)! land to coupler export state on land grid
!
! !LOCAL VARIABLES:
@@ -332,45 +222,17 @@ subroutine lnd_export( bounds, lnd2atm_inst, lnd2glc_inst, l2x)
l2x(index_l2x_Fall_lwup,i) = -lnd2atm_inst%eflx_lwrad_out_grc(g)
l2x(index_l2x_Fall_evap,i) = -lnd2atm_inst%qflx_evap_tot_grc(g)
l2x(index_l2x_Fall_swnet,i) = lnd2atm_inst%fsa_grc(g)
- if (index_l2x_Fall_fco2_lnd /= 0) then
- l2x(index_l2x_Fall_fco2_lnd,i) = -lnd2atm_inst%net_carbon_exchange_grc(g)
- end if
- ! Additional fields for DUST, PROGSSLT, dry-deposition and VOC
+ ! Additional fields for DUST, PROGSSLT, dry-deposition
! These are now standard fields, but the check on the index makes sure the driver handles them
if (index_l2x_Sl_ram1 /= 0 ) l2x(index_l2x_Sl_ram1,i) = lnd2atm_inst%ram1_grc(g)
if (index_l2x_Sl_fv /= 0 ) l2x(index_l2x_Sl_fv,i) = lnd2atm_inst%fv_grc(g)
- if (index_l2x_Sl_soilw /= 0 ) l2x(index_l2x_Sl_soilw,i) = lnd2atm_inst%h2osoi_vol_grc(g,1)
+ if (index_l2x_Sl_soilw /= 0 ) l2x(index_l2x_Sl_soilw,i) = 0.5_r8
if (index_l2x_Fall_flxdst1 /= 0 ) l2x(index_l2x_Fall_flxdst1,i)= -lnd2atm_inst%flxdst_grc(g,1)
if (index_l2x_Fall_flxdst2 /= 0 ) l2x(index_l2x_Fall_flxdst2,i)= -lnd2atm_inst%flxdst_grc(g,2)
if (index_l2x_Fall_flxdst3 /= 0 ) l2x(index_l2x_Fall_flxdst3,i)= -lnd2atm_inst%flxdst_grc(g,3)
if (index_l2x_Fall_flxdst4 /= 0 ) l2x(index_l2x_Fall_flxdst4,i)= -lnd2atm_inst%flxdst_grc(g,4)
-
- ! for dry dep velocities
- if (index_l2x_Sl_ddvel /= 0 ) then
- l2x(index_l2x_Sl_ddvel:index_l2x_Sl_ddvel+n_drydep-1,i) = &
- lnd2atm_inst%ddvel_grc(g,:n_drydep)
- end if
-
- ! for MEGAN VOC emis fluxes
- if (index_l2x_Fall_flxvoc /= 0 ) then
- l2x(index_l2x_Fall_flxvoc:index_l2x_Fall_flxvoc+shr_megan_mechcomps_n-1,i) = &
- -lnd2atm_inst%flxvoc_grc(g,:shr_megan_mechcomps_n)
- end if
-
-
- ! for fire emis fluxes
- if (index_l2x_Fall_flxfire /= 0 ) then
- l2x(index_l2x_Fall_flxfire:index_l2x_Fall_flxfire+shr_fire_emis_mechcomps_n-1,i) = &
- -lnd2atm_inst%fireflx_grc(g,:shr_fire_emis_mechcomps_n)
- l2x(index_l2x_Sl_ztopfire,i) = lnd2atm_inst%fireztop_grc(g)
- end if
-
- if (index_l2x_Fall_methane /= 0) then
- l2x(index_l2x_Fall_methane,i) = -lnd2atm_inst%flux_ch4_grc(g)
- endif
-
! sign convention is positive downward with
! hierarchy of atm/glc/lnd/rof/ice/ocn.
! I.e. water sent from land to rof is positive
@@ -389,19 +251,6 @@ subroutine lnd_export( bounds, lnd2atm_inst, lnd2glc_inst, l2x)
! ice sent individually to coupler
l2x(index_l2x_Flrl_rofi,i) = lnd2atm_inst%qflx_rofice_grc(g)
- ! irrigation flux to be removed from main channel storage (negative)
- l2x(index_l2x_Flrl_irrig,i) = - lnd2atm_inst%qirrig_grc(g)
-
- ! glc coupling
- ! We could avoid setting these fields if glc_present is .false., if that would
- ! help with performance. (The downside would be that we wouldn't have these fields
- ! available for diagnostic purposes or to force a later T compset with dlnd.)
- do num = 0,glc_nec
- l2x(index_l2x_Sl_tsrf(num),i) = lnd2glc_inst%tsrf_grc(g,num)
- l2x(index_l2x_Sl_topo(num),i) = lnd2glc_inst%topo_grc(g,num)
- l2x(index_l2x_Flgl_qice(num),i) = lnd2glc_inst%qice_grc(g,num)
- end do
-
! Check if any output sent to the coupler is NaN
if ( any(isnan(l2x(:,i))) )then
write(iulog,*) '# of NaNs = ', count(isnan(l2x(:,i)))
diff --git a/src/init_interp/initInterp.F90 b/src/init_interp/initInterp.F90
index 07d93178..e9264493 100644
--- a/src/init_interp/initInterp.F90
+++ b/src/init_interp/initInterp.F90
@@ -7,7 +7,7 @@ module initInterpMod
#include "shr_assert.h"
use initInterpBounds, only : interp_bounds_type
- use initInterpMindist, only: set_mindist, subgrid_type, subgrid_special_indices_type
+ use initInterpMindist, only: set_mindist, subgrid_type
use initInterp1dData, only : interp_1d_data
use initInterp2dvar, only: interp_2dvar_type
use initInterpMultilevelBase, only : interp_multilevel_type
@@ -31,7 +31,6 @@ module initInterpMod
! Public methods
- public :: initInterp_readnl ! Read namelist
public :: initInterp
! Private methods
@@ -44,16 +43,9 @@ module initInterpMod
private :: interp_1d_double
private :: interp_1d_int
private :: interp_2d_double
- private :: limit_snlsno
! Private data
- character(len=8) :: created_glacier_mec_landunits
-
- ! If true, fill missing types with closest natural veg column (using bare soil for
- ! patch-level variables)
- logical :: init_interp_fill_missing_with_natveg
-
character(len=*), parameter, private :: sourcefile = &
__FILE__
@@ -61,62 +53,6 @@ module initInterpMod
!=======================================================================
- !-----------------------------------------------------------------------
- subroutine initInterp_readnl(NLFilename)
- !
- ! !DESCRIPTION:
- ! Read the namelist for initInterp
- !
- ! !USES:
- use fileutils , only : getavu, relavu, opnfil
- use shr_nl_mod , only : shr_nl_find_group_name
- use spmdMod , only : masterproc, mpicom
- use shr_mpi_mod , only : shr_mpi_bcast
- !
- ! !ARGUMENTS:
- character(len=*), intent(in) :: NLFilename ! Namelist filename
- !
- ! !LOCAL VARIABLES:
- integer :: ierr ! error code
- integer :: unitn ! unit for namelist file
-
- character(len=*), parameter :: subname = 'initInterp_readnl'
- !-----------------------------------------------------------------------
-
- namelist /clm_initinterp_inparm/ &
- init_interp_fill_missing_with_natveg
-
- ! Initialize options to default values, in case they are not specified in the namelist
- init_interp_fill_missing_with_natveg = .false.
-
- if (masterproc) then
- unitn = getavu()
- write(iulog,*) 'Read in clm_initinterp_inparm namelist'
- call opnfil (NLFilename, unitn, 'F')
- call shr_nl_find_group_name(unitn, 'clm_initinterp_inparm', status=ierr)
- if (ierr == 0) then
- read(unitn, clm_initinterp_inparm, iostat=ierr)
- if (ierr /= 0) then
- call endrun(msg="ERROR reading clm_initinterp_inparm namelist"//errmsg(sourcefile, __LINE__))
- end if
- else
- call endrun(msg="ERROR finding clm_initinterp_inparm namelist"//errmsg(sourcefile, __LINE__))
- end if
- call relavu( unitn )
- end if
-
- call shr_mpi_bcast (init_interp_fill_missing_with_natveg, mpicom)
-
- if (masterproc) then
- write(iulog,*) ' '
- write(iulog,*) 'initInterp settings:'
- write(iulog,nml=clm_initinterp_inparm)
- write(iulog,*) ' '
- end if
-
- end subroutine initInterp_readnl
-
-
subroutine initInterp (filei, fileo, bounds)
!-----------------------------------------------------------------------
@@ -156,18 +92,11 @@ subroutine initInterp (filei, fileo, bounds)
integer :: ivalue
integer :: spinup_state_i, spinup_state_o
integer :: decomp_cascade_state_i, decomp_cascade_state_o
- integer :: npftsi, ncolsi, nlunsi, ngrcsi
- integer :: npftso, ncolso, nlunso, ngrcso
- integer , pointer :: pftindx(:)
- integer , pointer :: colindx(:)
- integer , pointer :: lunindx(:)
+ integer :: ngrcsi
+ integer :: ngrcso
integer , pointer :: grcindx(:)
- logical , pointer :: pft_activei(:), pft_activeo(:)
- logical , pointer :: col_activei(:), col_activeo(:)
- logical , pointer :: lun_activei(:), lun_activeo(:)
logical , pointer :: grc_activei(:), grc_activeo(:)
integer , pointer :: sgridindex(:)
- type(subgrid_special_indices_type) :: subgrid_special_indices
type(interp_multilevel_container_type) :: interp_multilevel_container
type(interp_2dvar_type) :: var2d_i, var2d_o ! holds metadata for 2-d variables
!--------------------------------------------------------------------
@@ -188,16 +117,10 @@ subroutine initInterp (filei, fileo, bounds)
! Determine dimensions and error checks on dimensions
! --------------------------------------------
- call check_dim_subgrid(ncidi, ncido, dimname ='pft' , dimleni=npftsi, dimleno=npftso)
- call check_dim_subgrid(ncidi, ncido, dimname ='column' , dimleni=ncolsi, dimleno=ncolso)
- call check_dim_subgrid(ncidi, ncido, dimname ='landunit', dimleni=nlunsi, dimleno=nlunso)
call check_dim_subgrid(ncidi, ncido, dimname ='gridcell', dimleni=ngrcsi, dimleno=ngrcso)
if (masterproc) then
write (iulog,*) 'input gridcells = ',ngrcsi,' output gridcells = ',ngrcso
- write (iulog,*) 'input landuntis = ',nlunsi,' output landunits = ',nlunso
- write (iulog,*) 'input columns = ',ncolsi,' output columns = ',ncolso
- write (iulog,*) 'input pfts = ',npftsi,' output pfts = ',npftso
end if
! NOTE(wjs, 2015-10-31) The inclusion of must_be_same in these checks essentially
@@ -206,113 +129,23 @@ subroutine initInterp (filei, fileo, bounds)
! ensure that the dimension sizes match. So we may want to remove the must_be_same
! argument, and make check_dim_level purely informational, in order to remove this
! maintenance problem - or maybe even remove check_dim_level entirely.
- call check_dim_level(ncidi, ncido, dimname='levsno' , must_be_same=.false.)
- call check_dim_level(ncidi, ncido, dimname='levsno1', must_be_same=.false.)
- call check_dim_level(ncidi, ncido, dimname='levcan' , must_be_same=.true.)
- call check_dim_level(ncidi, ncido, dimname='levlak' , must_be_same=.true.)
- call check_dim_level(ncidi, ncido, dimname='levtot' , must_be_same=.false.)
call check_dim_level(ncidi, ncido, dimname='levgrnd', must_be_same=.false.)
call check_dim_level(ncidi, ncido, dimname='numrad' , must_be_same=.true.)
! --------------------------------------------
- ! Determine input file global attributes that are needed
+ ! Find closest values for gridcells
! --------------------------------------------
- status = pio_get_att(ncidi, pio_global, &
- 'ipft_not_vegetated', &
- subgrid_special_indices%ipft_not_vegetated)
- status = pio_get_att(ncidi, pio_global, &
- 'icol_vegetated_or_bare_soil', &
- subgrid_special_indices%icol_vegetated_or_bare_soil)
- status = pio_get_att(ncidi, pio_global, &
- 'ilun_vegetated_or_bare_soil', &
- subgrid_special_indices%ilun_vegetated_or_bare_soil)
- status = pio_get_att(ncidi, pio_global, &
- 'ilun_crop', &
- subgrid_special_indices%ilun_crop)
- status = pio_get_att(ncidi, pio_global, &
- 'ilun_landice_multiple_elevation_classes', &
- subgrid_special_indices%ilun_landice_multiple_elevation_classes)
- status = pio_get_att(ncidi, pio_global, &
- 'created_glacier_mec_landunits', &
- created_glacier_mec_landunits)
-
- if (masterproc) then
- write(iulog,*)'ipft_not_vegetated = ' , &
- subgrid_special_indices%ipft_not_vegetated
- write(iulog,*)'icol_vegetated_or_bare_soil = ' , &
- subgrid_special_indices%icol_vegetated_or_bare_soil
- write(iulog,*)'ilun_vegetated_or_bare_soil = ' , &
- subgrid_special_indices%ilun_vegetated_or_bare_soil
- write(iulog,*)'ilun_crop = ' , &
- subgrid_special_indices%ilun_crop
- write(iulog,*)'ilun_landice_multiple_elevation_classes = ' , &
- subgrid_special_indices%ilun_landice_multiple_elevation_classes
- write(iulog,*)'create_glacier_mec_landunits = ', &
- trim(created_glacier_mec_landunits)
- end if
+ bounds_i = interp_bounds_type(begg = 1, endg = ngrcsi)
- ! --------------------------------------------
- ! Find closest values for pfts, cols, landunits, gridcells
- ! --------------------------------------------
+ bounds_o = interp_bounds_type(begg = bounds%begg, endg = bounds%endg)
- bounds_i = interp_bounds_type( &
- begp = 1, endp = npftsi, &
- begc = 1, endc = ncolsi, &
- begl = 1, endl = nlunsi, &
- begg = 1, endg = ngrcsi)
-
- bounds_o = interp_bounds_type( &
- begp = bounds%begp, endp = bounds%endp, &
- begc = bounds%begc, endc = bounds%endc, &
- begl = bounds%begl, endl = bounds%endl, &
- begg = bounds%begg, endg = bounds%endg)
-
- allocate(pft_activei(bounds_i%get_begp():bounds_i%get_endp()))
- allocate(col_activei(bounds_i%get_begc():bounds_i%get_endc()))
- allocate(lun_activei(bounds_i%get_begl():bounds_i%get_endl()))
allocate(grc_activei(bounds_i%get_begg():bounds_i%get_endg()))
- allocate(pft_activeo(bounds_o%get_begp():bounds_o%get_endp()))
- allocate(col_activeo(bounds_o%get_begc():bounds_o%get_endc()))
- allocate(lun_activeo(bounds_o%get_begl():bounds_o%get_endl()))
allocate(grc_activeo(bounds_o%get_begg():bounds_o%get_endg()))
- allocate(pftindx(bounds_o%get_begp():bounds_o%get_endp()))
- allocate(colindx(bounds_o%get_begc():bounds_o%get_endc()))
- allocate(lunindx(bounds_o%get_begl():bounds_o%get_endl()))
allocate(grcindx(bounds_o%get_begg():bounds_o%get_endg()))
- ! For each output pft, find the input pft, pftindx, that is closest
-
- if (masterproc) then
- write(iulog,*)'finding minimum distance for pfts'
- end if
- vec_dimname = 'pft'
- call findMinDist(vec_dimname, bounds_i%get_begp(), bounds_i%get_endp(), &
- bounds_o%get_begp(), bounds_o%get_endp(), ncidi, ncido, &
- subgrid_special_indices, pft_activei, pft_activeo, pftindx )
-
- ! For each output column, find the input column, colindx, that is closest
-
- if (masterproc) then
- write(iulog,*)'finding minimum distance for columns'
- end if
- vec_dimname = 'column'
- call findMinDist(vec_dimname, bounds_i%get_begc(), bounds_i%get_endc(), &
- bounds_o%get_begc(), bounds_o%get_endc(), ncidi, ncido, &
- subgrid_special_indices, col_activei, col_activeo, colindx )
-
- ! For each output landunit, find the input landunit, lunindx, that is closest
-
- if (masterproc) then
- write(iulog,*)'finding minimum distance for landunits'
- end if
- vec_dimname = 'landunit'
- call findMinDist(vec_dimname, bounds_i%get_begl(), bounds_i%get_endl(), &
- bounds_o%get_begl(), bounds_o%get_endl(), ncidi, ncido, &
- subgrid_special_indices, lun_activei, lun_activeo, lunindx )
-
! For each output gridcell, find the input gridcell, grcindx, that is closest
if (masterproc) then
@@ -321,19 +154,18 @@ subroutine initInterp (filei, fileo, bounds)
vec_dimname = 'gridcell'
call findMinDist(vec_dimname, bounds_i%get_begg(), bounds_i%get_endg(), &
bounds_o%get_begg(), bounds_o%get_endg(), ncidi, ncido, &
- subgrid_special_indices, grc_activei, grc_activeo, grcindx)
+ grc_activei, grc_activeo, grcindx)
! ------------------------------------------------------------------------
! Set up interpolators for multi-level variables
! ------------------------------------------------------------------------
- if (masterproc) then
- write(iulog,*)'setting up interpolators for multi-level variables'
- end if
- interp_multilevel_container = interp_multilevel_container_type( &
- ncid_source = ncidi, ncid_dest = ncido, &
- bounds_source = bounds_i, bounds_dest = bounds_o, &
- pftindex = pftindx, colindex = colindx)
+! if (masterproc) then
+! write(iulog,*)'setting up interpolators for multi-level variables'
+! end if
+! interp_multilevel_container = interp_multilevel_container_type( &
+! ncid_source = ncidi, ncid_dest = ncido, &
+! bounds_source = bounds_i, bounds_dest = bounds_o)
!------------------------------------------------------------------------
! Read input initial data and write output initial data
@@ -502,13 +334,7 @@ subroutine initInterp (filei, fileo, bounds)
endi = bounds_i%get_end(vec_dimname)
bego = bounds_o%get_beg(vec_dimname)
endo = bounds_o%get_end(vec_dimname)
- if ( vec_dimname == 'pft' )then
- sgridindex => pftindx
- else if ( vec_dimname == 'column' )then
- sgridindex => colindx
- else if ( vec_dimname == 'landunit' )then
- sgridindex => lunindx
- else if ( vec_dimname == 'gridcell' )then
+ if ( vec_dimname == 'gridcell' )then
sgridindex => grcindx
else
call endrun(msg='ERROR interpinic: 1D variable '//trim(varname)//&
@@ -555,13 +381,7 @@ subroutine initInterp (filei, fileo, bounds)
endi = bounds_i%get_end(vec_dimname)
bego = bounds_o%get_beg(vec_dimname)
endo = bounds_o%get_end(vec_dimname)
- if ( vec_dimname == 'pft' )then
- sgridindex => pftindx
- else if ( vec_dimname == 'column' )then
- sgridindex => colindx
- else if ( vec_dimname == 'landunit' )then
- sgridindex => lunindx
- else if ( vec_dimname == 'gridcell' )then
+ if ( vec_dimname == 'gridcell' )then
sgridindex => grcindx
else
call endrun(msg='ERROR interpinic: 2D variable with unknown subgrid dimension: '//&
@@ -609,9 +429,6 @@ subroutine initInterp (filei, fileo, bounds)
write(iulog,*) 'Cleaning up / adjusting variables'
end if
- call limit_snlsno(ncido, bounds_o)
-
-
! Close output file
call pio_closefile(ncido)
@@ -625,7 +442,7 @@ end subroutine initInterp
!=======================================================================
subroutine findMinDist( dimname, begi, endi, bego, endo, ncidi, ncido, &
- subgrid_special_indices, activei, activeo, minindx)
+ activei, activeo, minindx)
! --------------------------------------------------------------------
!
@@ -637,7 +454,6 @@ subroutine findMinDist( dimname, begi, endi, bego, endo, ncidi, ncido, &
integer , intent(in) :: bego, endo
type(file_desc_t) , intent(inout) :: ncidi
type(file_desc_t) , intent(inout) :: ncido
- type(subgrid_special_indices_type), intent(in) :: subgrid_special_indices
logical , intent(out) :: activei(begi:endi)
logical , intent(out) :: activeo(bego:endo)
integer , intent(out) :: minindx(bego:endo)
@@ -663,7 +479,7 @@ subroutine findMinDist( dimname, begi, endi, bego, endo, ncidi, ncido, &
write(iulog,*)'calling set_mindist for ',trim(dimname)
end if
call set_mindist(begi, endi, bego, endo, activei, activeo, subgridi, subgrido, &
- subgrid_special_indices, init_interp_fill_missing_with_natveg, minindx)
+ minindx)
deallocate(subgridi%lat, subgridi%lon, subgridi%coslat)
deallocate(subgrido%lat, subgrido%lon, subgrido%coslat)
@@ -693,53 +509,6 @@ subroutine set_subgrid_info(beg, end, dimname, use_glob, ncid, active, subgrid)
allocate(itemp(beg:end))
allocate(subgrid%lat(beg:end), subgrid%lon(beg:end), subgrid%coslat(beg:end))
- if (dimname == 'pft') then
- allocate(subgrid%ptype(beg:end), subgrid%ctype(beg:end), subgrid%ltype(beg:end))
- else if (dimname == 'column') then
- allocate(subgrid%ctype(beg:end), subgrid%ltype(beg:end))
- else if (dimname == 'landunit') then
- allocate(subgrid%ltype(beg:end))
- end if
-
- ! determine if is_glcmec from global attributes
- if (trim(created_glacier_mec_landunits) == 'true') then
- if (dimname == 'pft' .or. dimname == 'column') then
- allocate(subgrid%topoglc(beg:end))
- end if
- end if
-
- if (dimname == 'pft') then
- call read_var_double(ncid=ncid, varname='pfts1d_lon' , data=subgrid%lon , dim1name='pft', use_glob=use_glob)
- call read_var_double(ncid=ncid, varname='pfts1d_lat' , data=subgrid%lat , dim1name='pft', use_glob=use_glob)
- call read_var_int(ncid=ncid, varname='pfts1d_itypveg', data=subgrid%ptype, dim1name='pft', use_glob=use_glob)
- call read_var_int(ncid=ncid, varname='pfts1d_itypcol', data=subgrid%ctype, dim1name='pft', use_glob=use_glob)
- call read_var_int(ncid=ncid, varname='pfts1d_ityplun', data=subgrid%ltype, dim1name='pft', use_glob=use_glob)
- call read_var_int(ncid=ncid, varname='pfts1d_active' , data=itemp , dim1name='pft', use_glob=use_glob)
- if (associated(subgrid%topoglc)) then
- call read_var_double(ncid=ncid, varname='pfts1d_topoglc', data=subgrid%topoglc, dim1name='pft', use_glob=use_glob)
- end if
- else if (dimname == 'column') then
- call read_var_double(ncid=ncid, varname='cols1d_lon' , data=subgrid%lon , dim1name='column', use_glob=use_glob)
- call read_var_double(ncid=ncid, varname='cols1d_lat' , data=subgrid%lat , dim1name='column', use_glob=use_glob)
- call read_var_int(ncid=ncid, varname='cols1d_ityp' , data=subgrid%ctype, dim1name='column', use_glob=use_glob)
- call read_var_int(ncid=ncid, varname='cols1d_ityplun', data=subgrid%ltype, dim1name='column', use_glob=use_glob)
- call read_var_int(ncid=ncid, varname='cols1d_active' , data=itemp , dim1name='column', use_glob=use_glob)
- if (associated(subgrid%topoglc)) then
- call read_var_double(ncid=ncid, varname='cols1d_topoglc', data=subgrid%topoglc, dim1name='column', use_glob=use_glob)
- end if
- else if (dimname == 'landunit') then
- call read_var_double(ncid=ncid, varname='land1d_lon' , data=subgrid%lon , dim1name='landunit', use_glob=use_glob)
- call read_var_double(ncid=ncid, varname='land1d_lat' , data=subgrid%lat , dim1name='landunit', use_glob=use_glob)
- call read_var_int(ncid=ncid, varname='land1d_ityplun', data=subgrid%ltype, dim1name='landunit', use_glob=use_glob)
- call read_var_int(ncid=ncid, varname='land1d_active' , data=itemp , dim1name='landunit', use_glob=use_glob)
- else if (dimname == 'gridcell') then
- call read_var_double(ncid=ncid, varname='grid1d_lon' , data=subgrid%lon , dim1name='gridcell', use_glob=use_glob)
- call read_var_double(ncid=ncid, varname='grid1d_lat' , data=subgrid%lat , dim1name='gridcell', use_glob=use_glob)
-
- ! All gridcells in the restart file are active
- itemp(beg:end) = 1
- end if
-
do n = beg,end
if (itemp(n) > 0) then
active(n) = .true.
@@ -1067,66 +836,4 @@ subroutine check_dim_level(ncidi, ncido, dimname, must_be_same)
end subroutine check_dim_level
- !-----------------------------------------------------------------------
- subroutine limit_snlsno(ncido, bounds_o)
- !
- ! !DESCRIPTION:
- ! Apply a limit to SNLSNO in the output file so that it doesn't exceed the number of
- ! snow layers.
- !
- ! This is needed if the output file has fewer snow layers than the input file.
- !
- ! !USES:
- !
- ! !ARGUMENTS:
- type(file_desc_t) , intent(inout) :: ncido
- type(interp_bounds_type), intent(in) :: bounds_o
- !
- ! !LOCAL VARIABLES:
- character(len=16) :: vec_dimname
- integer :: bego, endo
- integer, pointer :: snlsno(:)
- integer :: snlsno_dids(1) ! dimension ID
- integer :: levsno_dimid
- integer :: levsno
- integer :: i
- integer :: err_code
-
- character(len=*), parameter :: levsno_dimname = 'levsno'
- character(len=*), parameter :: snlsno_varname = 'SNLSNO'
-
- character(len=*), parameter :: subname = 'limit_snlsno'
- !-----------------------------------------------------------------------
-
- ! Determine levsno size
- call ncd_inqdlen(ncid=ncido, dimid=levsno_dimid, len=levsno, name=levsno_dimname)
-
- ! Read SNLSNO
- !
- ! TODO(wjs, 2015-11-01) This is a lot of code for simply reading in a 1-d variable.
- ! It would be nice if there was a routine that did all of this for you, similarly to
- ! what initInterp2dvar does for 2-d variables.
- call ncd_inqvdname(ncid=ncido, varname=snlsno_varname, dimnum=1, dname=vec_dimname, &
- err_code=err_code)
- if (err_code /= 0) then
- call endrun(subname//' ERROR getting vec_dimname')
- end if
- bego = bounds_o%get_beg(vec_dimname)
- endo = bounds_o%get_end(vec_dimname)
- allocate(snlsno(bego:endo))
- call ncd_io(ncid=ncido, varname=snlsno_varname, flag='read', data=snlsno, &
- dim1name=trim(vec_dimname))
-
- ! Limit SNLSNO
- do i = bego, endo
- ! Note that snlsno is negative
- snlsno(i) = max(snlsno(i), -1*levsno)
- end do
-
- ! Write out limited SNLSNO
- call ncd_io(ncid=ncido, varname=snlsno_varname, flag='write', data=snlsno, &
- dim1name=trim(vec_dimname))
- deallocate(snlsno)
- end subroutine limit_snlsno
-
end module initInterpMod
diff --git a/src/init_interp/initInterpBounds.F90 b/src/init_interp/initInterpBounds.F90
index ff3704e4..d48280be 100644
--- a/src/init_interp/initInterpBounds.F90
+++ b/src/init_interp/initInterpBounds.F90
@@ -18,21 +18,9 @@ module initInterpBounds
type :: interp_bounds_type
private
- integer :: begp ! beginning patch-level index
- integer :: endp ! ending patch-level index
- integer :: begc ! beginning col-level index
- integer :: endc ! ending col-level index
- integer :: begl ! beginning landunit-level index
- integer :: endl ! ending landunit-level index
integer :: begg ! beginning gridcell-level index
integer :: endg ! ending gridcell-level index
contains
- procedure :: get_begp
- procedure :: get_endp
- procedure :: get_begc
- procedure :: get_endc
- procedure :: get_begl
- procedure :: get_endl
procedure :: get_begg
procedure :: get_endg
procedure :: get_beg ! get beginning index for a given subgrid level
@@ -53,7 +41,7 @@ module initInterpBounds
! ========================================================================
!-----------------------------------------------------------------------
- function constructor(begp, endp, begc, endc, begl, endl, begg, endg) result(this)
+ function constructor(begg, endg) result(this)
!
! !DESCRIPTION:
! Create an interp_bounds_type instance
@@ -62,9 +50,6 @@ function constructor(begp, endp, begc, endc, begl, endl, begg, endg) result(this
!
! !ARGUMENTS:
type(interp_bounds_type) :: this ! function result
- integer, intent(in) :: begp, endp
- integer, intent(in) :: begc, endc
- integer, intent(in) :: begl, endl
integer, intent(in) :: begg, endg
!
! !LOCAL VARIABLES:
@@ -72,12 +57,6 @@ function constructor(begp, endp, begc, endc, begl, endl, begg, endg) result(this
character(len=*), parameter :: subname = 'constructor'
!-----------------------------------------------------------------------
- this%begp = begp
- this%endp = endp
- this%begc = begc
- this%endc = endc
- this%begl = begl
- this%endl = endl
this%begg = begg
this%endg = endg
@@ -87,36 +66,6 @@ end function constructor
! Public methods
! ========================================================================
- integer function get_begp(this)
- class(interp_bounds_type), intent(in) :: this
- get_begp = this%begp
- end function get_begp
-
- integer function get_endp(this)
- class(interp_bounds_type), intent(in) :: this
- get_endp = this%endp
- end function get_endp
-
- integer function get_begc(this)
- class(interp_bounds_type), intent(in) :: this
- get_begc = this%begc
- end function get_begc
-
- integer function get_endc(this)
- class(interp_bounds_type), intent(in) :: this
- get_endc = this%endc
- end function get_endc
-
- integer function get_begl(this)
- class(interp_bounds_type), intent(in) :: this
- get_begl = this%begl
- end function get_begl
-
- integer function get_endl(this)
- class(interp_bounds_type), intent(in) :: this
- get_endl = this%endl
- end function get_endl
-
integer function get_begg(this)
class(interp_bounds_type), intent(in) :: this
get_begg = this%begg
@@ -138,7 +87,7 @@ function get_beg(this, subgrid_level) result(beg_index)
! !ARGUMENTS:
integer :: beg_index ! function result
class(interp_bounds_type), intent(in) :: this
- character(len=*), intent(in) :: subgrid_level ! 'pft', 'column', 'landunit' or 'gridcell'
+ character(len=*), intent(in) :: subgrid_level ! 'gridcell'
!
! !LOCAL VARIABLES:
@@ -146,12 +95,6 @@ function get_beg(this, subgrid_level) result(beg_index)
!-----------------------------------------------------------------------
select case (subgrid_level)
- case('pft')
- beg_index = this%begp
- case('column')
- beg_index = this%begc
- case('landunit')
- beg_index = this%begl
case('gridcell')
beg_index = this%begg
case default
@@ -172,7 +115,7 @@ function get_end(this, subgrid_level) result(end_index)
! !ARGUMENTS:
integer :: end_index ! function result
class(interp_bounds_type), intent(in) :: this
- character(len=*), intent(in) :: subgrid_level ! 'pft', 'column', 'landunit' or 'gridcell'
+ character(len=*), intent(in) :: subgrid_level ! 'gridcell'
!
! !LOCAL VARIABLES:
@@ -180,12 +123,6 @@ function get_end(this, subgrid_level) result(end_index)
!-----------------------------------------------------------------------
select case (subgrid_level)
- case('pft')
- end_index = this%endp
- case('column')
- end_index = this%endc
- case('landunit')
- end_index = this%endl
case('gridcell')
end_index = this%endg
case default
diff --git a/src/init_interp/initInterpMindist.F90 b/src/init_interp/initInterpMindist.F90
index 8e345a6a..663cd243 100644
--- a/src/init_interp/initInterpMindist.F90
+++ b/src/init_interp/initInterpMindist.F90
@@ -26,77 +26,25 @@ module initInterpMindist
! Public types
- type, public :: subgrid_special_indices_type
- integer :: ipft_not_vegetated
- integer :: icol_vegetated_or_bare_soil
- integer :: ilun_vegetated_or_bare_soil
- integer :: ilun_crop
- integer :: ilun_landice_multiple_elevation_classes
- contains
- procedure :: is_vegetated_landunit ! returns true if the given landunit type is natural veg or crop
- end type subgrid_special_indices_type
-
type, public :: subgrid_type
- character(len=16) :: name ! pft, column, landunit, gridcell
- integer , pointer :: ptype(:) => null() ! used for patch type
- integer , pointer :: ctype(:) => null() ! used for patch or col type
- integer , pointer :: ltype(:) => null() ! used for pft, col or lun type
+ character(len=16) :: name ! gridcell
real(r8), pointer :: topoglc(:) => null()
real(r8), pointer :: lat(:)
real(r8), pointer :: lon(:)
real(r8), pointer :: coslat(:)
- contains
- procedure :: print_point ! print info about one point
end type subgrid_type
! Private methods
- private :: do_fill_missing_with_natveg
private :: is_sametype
- private :: is_baresoil
character(len=*), parameter, private :: sourcefile = &
__FILE__
contains
- !-----------------------------------------------------------------------
- subroutine print_point(this, index, unit)
- !
- ! !DESCRIPTION:
- ! Print info about one point in a subgrid_type object
- !
- ! !USES:
- !
- ! !ARGUMENTS:
- class(subgrid_type), intent(in) :: this
- integer , intent(in) :: index
- integer , intent(in) :: unit ! unit to which we should write the info
- !
- ! !LOCAL VARIABLES:
-
- character(len=*), parameter :: subname = 'print_point'
- !-----------------------------------------------------------------------
-
- write(unit,*) 'subgrid level, index = ',&
- this%name, index
- if (associated(this%ltype)) then
- write(unit,*) 'ltype: ', this%ltype(index)
- end if
- if (associated(this%ctype)) then
- write(unit,*) 'ctype: ', this%ctype(index)
- end if
- if (associated(this%ptype)) then
- write(unit,*) 'ptype: ', this%ptype(index)
- end if
-
- end subroutine print_point
-
-
- !=======================================================================
-
subroutine set_mindist(begi, endi, bego, endo, activei, activeo, subgridi, subgrido, &
- subgrid_special_indices, fill_missing_with_natveg, mindist_index)
+ mindist_index)
! --------------------------------------------------------------------
! arguments
@@ -106,7 +54,6 @@ subroutine set_mindist(begi, endi, bego, endo, activei, activeo, subgridi, subgr
logical , intent(in) :: activeo(bego:endo)
type(subgrid_type) , intent(in) :: subgridi
type(subgrid_type) , intent(in) :: subgrido
- type(subgrid_special_indices_type), intent(in) :: subgrid_special_indices
! If false: if an output type cannot be found in the input, code aborts
! If true: if an output type cannot be found in the input, fill with closest natural
@@ -115,7 +62,6 @@ subroutine set_mindist(begi, endi, bego, endo, activei, activeo, subgridi, subgr
! NOTE: always treated as true for natural veg and crop landunits/columns/patches in
! the output - e.g., if we can't find the right column type to fill crop, we always
! use the closest natural veg column, regardless of the value of this flag.
- logical , intent(in) :: fill_missing_with_natveg
integer , intent(out) :: mindist_index(bego:endo)
!
@@ -146,7 +92,7 @@ subroutine set_mindist(begi, endi, bego, endo, activei, activeo, subgridi, subgr
hgtdiffmin = spval
do ni = begi,endi
if (activei(ni)) then
- if (is_sametype(ni, no, subgridi, subgrido, subgrid_special_indices)) then
+ if (is_sametype(ni, no, subgridi, subgrido)) then
dy = abs(subgrido%lat(no)-subgridi%lat(ni))*re
dx = abs(subgrido%lon(no)-subgridi%lon(ni))*re * &
0.5_r8*(subgrido%coslat(no)+subgridi%coslat(ni))
@@ -184,42 +130,6 @@ subroutine set_mindist(begi, endi, bego, endo, activei, activeo, subgridi, subgr
end if
end do
- ! If output type is not contained in input dataset, then use closest bare soil,
- ! if this point is one for which we fill missing with natveg.
- if ( distmin == spval .and. &
- do_fill_missing_with_natveg( &
- fill_missing_with_natveg, no, subgrido, subgrid_special_indices)) then
- do ni = begi, endi
- if (activei(ni)) then
- if ( is_baresoil(ni, subgridi, subgrid_special_indices)) then
- dy = abs(subgrido%lat(no)-subgridi%lat(ni))*re
- dx = abs(subgrido%lon(no)-subgridi%lon(ni))*re * &
- 0.5_r8*(subgrido%coslat(no)+subgridi%coslat(ni))
- dist = dx*dx + dy*dy
- if ( dist < distmin )then
- distmin = dist
- nmin = ni
- end if
- end if
- end if
- end do
- end if
-
- ! Error conditions
- if ( distmin == spval )then
- write(iulog,*) 'ERROR initInterp set_mindist: &
- &Cannot find any input points matching output point:'
- call subgrido%print_point(no, iulog)
- write(iulog,*) ' '
- write(iulog,*) 'Consider rerunning with the following in user_nl_clm:'
- write(iulog,*) 'init_interp_fill_missing_with_natveg = .true.'
- write(iulog,*) 'However, note that this will fill all missing types in the output'
- write(iulog,*) 'with the closest natural veg column in the input'
- write(iulog,*) '(using bare soil for patch-level variables).'
- write(iulog,*) 'So, you should consider whether that is what you want.'
- call endrun(msg=errMsg(sourcefile, __LINE__))
- end if
-
mindist_index(no) = nmin
end if ! end if activeo block
@@ -228,51 +138,9 @@ subroutine set_mindist(begi, endi, bego, endo, activei, activeo, subgridi, subgr
end subroutine set_mindist
- !-----------------------------------------------------------------------
- function do_fill_missing_with_natveg(fill_missing_with_natveg, &
- no, subgrido, subgrid_special_indices)
- !
- ! !DESCRIPTION:
- ! Returns true if the given output point, if missing, should be filled with the
- ! closest natural veg point.
- !
- ! !ARGUMENTS:
- logical :: do_fill_missing_with_natveg ! function result
-
- ! whether we should fill ALL missing points with natveg
- logical, intent(in) :: fill_missing_with_natveg
-
- integer , intent(in) :: no
- type(subgrid_type), intent(in) :: subgrido
- type(subgrid_special_indices_type), intent(in) :: subgrid_special_indices
- !
- ! !LOCAL VARIABLES:
-
- character(len=*), parameter :: subname = 'do_fill_missing_with_natveg'
- !-----------------------------------------------------------------------
-
- if (subgrido%name == 'gridcell') then
- ! It makes no sense to try to fill missing with natveg for gridcell-level values
- do_fill_missing_with_natveg = .false.
- else if (fill_missing_with_natveg) then
- ! User has asked for all missing points to be filled with natveg
- do_fill_missing_with_natveg = .true.
- else if (subgrid_special_indices%is_vegetated_landunit(subgrido%ltype(no))) then
- ! Even if user hasn't asked for it, we fill missing vegetated points (natural veg
- ! and crop) with the closest natveg point. This is mainly to support the common
- ! use case of interpolating non-crop to crop, but also supports adding a new PFT
- ! type.
- do_fill_missing_with_natveg = .true.
- else
- do_fill_missing_with_natveg = .false.
- end if
-
- end function do_fill_missing_with_natveg
-
-
!=======================================================================
- logical function is_sametype (ni, no, subgridi, subgrido, subgrid_special_indices)
+ logical function is_sametype (ni, no, subgridi, subgrido)
! --------------------------------------------------------------------
! arguments
@@ -280,49 +148,11 @@ logical function is_sametype (ni, no, subgridi, subgrido, subgrid_special_indice
integer , intent(in) :: no
type(subgrid_type), intent(in) :: subgridi
type(subgrid_type), intent(in) :: subgrido
- type(subgrid_special_indices_type), intent(in) :: subgrid_special_indices
! --------------------------------------------------------------------
is_sametype = .false.
- if (trim(subgridi%name) == 'pft' .and. trim(subgrido%name) == 'pft') then
- if ( subgridi%ltype(ni) == subgrid_special_indices%ilun_landice_multiple_elevation_classes .and. &
- subgrido%ltype(no) == subgrid_special_indices%ilun_landice_multiple_elevation_classes) then
- is_sametype = .true.
- else if (subgrid_special_indices%is_vegetated_landunit(subgrido%ltype(no))) then
- ! If the output type is natural veg or crop, then just look for the correct PFT,
- ! without regard for what column or landunit it's on (as long as it's on either
- ! the natural veg or crop landunit). This is needed to handle the generic crop
- ! properly when interpolating from non-crop to crop, or vice versa.
- !
- ! TODO(wjs, 2015-09-15) If we ever allow the same PFT to appear on multiple
- ! columns within a given grid cell, then this logic will need to be made
- ! somewhat more complex: e.g., preferably take something from the same column
- ! type, but if we can't find anything from the same column type, then ignore
- ! column type.
-
- if (subgrid_special_indices%is_vegetated_landunit(subgridi%ltype(ni)) .and. &
- subgridi%ptype(ni) == subgrido%ptype(no)) then
- is_sametype = .true.
- end if
- else if (subgridi%ptype(ni) == subgrido%ptype(no) .and. &
- subgridi%ctype(ni) == subgrido%ctype(no) .and. &
- subgridi%ltype(ni) == subgrido%ltype(no)) then
- is_sametype = .true.
- end if
- else if (trim(subgridi%name) == 'column' .and. trim(subgrido%name) == 'column') then
- if ( subgridi%ltype(ni) == subgrid_special_indices%ilun_landice_multiple_elevation_classes .and. &
- subgrido%ltype(no) == subgrid_special_indices%ilun_landice_multiple_elevation_classes ) then
- is_sametype = .true.
- else if (subgridi%ctype(ni) == subgrido%ctype(no) .and. &
- subgridi%ltype(ni) == subgrido%ltype(no)) then
- is_sametype = .true.
- end if
- else if (trim(subgridi%name) == 'landunit' .and. trim(subgrido%name) == 'landunit') then
- if (subgridi%ltype(ni) == subgrido%ltype(no)) then
- is_sametype = .true.
- end if
- else if (trim(subgridi%name) == 'gridcell' .and. trim(subgrido%name) == 'gridcell') then
+ if (trim(subgridi%name) == 'gridcell' .and. trim(subgrido%name) == 'gridcell') then
is_sametype = .true.
else
if (masterproc) then
@@ -335,69 +165,4 @@ logical function is_sametype (ni, no, subgridi, subgrido, subgrid_special_indice
end function is_sametype
- !=======================================================================
-
- logical function is_baresoil (n, subgrid, subgrid_special_indices)
-
- ! --------------------------------------------------------------------
- ! arguments
- integer , intent(in) :: n
- type(subgrid_type), intent(in) :: subgrid
- type(subgrid_special_indices_type), intent(in) :: subgrid_special_indices
- ! --------------------------------------------------------------------
-
- is_baresoil = .false.
-
- if (subgrid%name == 'pft') then
- if (subgrid%ptype(n) == subgrid_special_indices%ipft_not_vegetated .and. &
- subgrid%ctype(n) == subgrid_special_indices%icol_vegetated_or_bare_soil .and. &
- subgrid%ltype(n) == subgrid_special_indices%ilun_vegetated_or_bare_soil) then
- is_baresoil = .true.
- end if
- else if (subgrid%name == 'column') then
- if (subgrid%ctype(n) == subgrid_special_indices%icol_vegetated_or_bare_soil .and. &
- subgrid%ltype(n) == subgrid_special_indices%ilun_vegetated_or_bare_soil) then
- is_baresoil = .true.
- end if
- else if (subgrid%name == 'landunit') then
- if (subgrid%ltype(n) == subgrid_special_indices%ilun_vegetated_or_bare_soil) then
- is_baresoil = .true.
- end if
- else
- if (masterproc) then
- write(iulog,*)'ERROR interpinic: is_baresoil subgrid type ',subgrid%name,' not supported'
- end if
- call endrun(msg=errMsg(sourcefile, __LINE__))
- end if
-
- end function is_baresoil
-
- !-----------------------------------------------------------------------
- function is_vegetated_landunit(this, ltype)
- !
- ! !DESCRIPTION:
- ! Returns true if the given landunit type is vegetated: either natural veg or crop
- !
- ! !USES:
- !
- ! !ARGUMENTS:
- logical :: is_vegetated_landunit ! function result
- class(subgrid_special_indices_type), intent(in) :: this
- integer, intent(in) :: ltype ! landunit type of interest
- !
- ! !LOCAL VARIABLES:
-
- character(len=*), parameter :: subname = 'is_vegetated_landunit'
- !-----------------------------------------------------------------------
-
- if (ltype == this%ilun_vegetated_or_bare_soil .or. &
- ltype == this%ilun_crop) then
- is_vegetated_landunit = .true.
- else
- is_vegetated_landunit = .false.
- end if
-
- end function is_vegetated_landunit
-
-
end module initInterpMindist
diff --git a/src/init_interp/initInterpMultilevelContainer.F90 b/src/init_interp/initInterpMultilevelContainer.F90
index 1c165181..765141bf 100644
--- a/src/init_interp/initInterpMultilevelContainer.F90
+++ b/src/init_interp/initInterpMultilevelContainer.F90
@@ -45,11 +45,6 @@ module initInterpMultilevelContainer
! pointers would be to require all instances of this derived type to have the target
! attribute.)
type(interp_multilevel_copy_type), pointer :: interp_multilevel_copy
- type(interp_multilevel_interp_type), pointer :: interp_multilevel_levgrnd_col
- type(interp_multilevel_interp_type), pointer :: interp_multilevel_levgrnd_pft
- type(interp_multilevel_snow_type), pointer :: interp_multilevel_levsno
- type(interp_multilevel_snow_type), pointer :: interp_multilevel_levsno1
- type(interp_multilevel_split_type), pointer :: interp_multilevel_levtot_col
contains
procedure :: find_interpolator
end type interp_multilevel_container_type
@@ -58,12 +53,6 @@ module initInterpMultilevelContainer
module procedure constructor
end interface interp_multilevel_container_type
- ! Private routines
-
- private :: create_interp_multilevel_levgrnd
- private :: interp_levgrnd_check_source_file
- private :: create_snow_interpolators
-
character(len=*), parameter, private :: sourcefile = &
__FILE__
@@ -94,7 +83,7 @@ function constructor(ncid_source, ncid_dest, bounds_source, bounds_dest, &
! e.g., colindex(i) gives source col corresponding to dest col i.
integer, intent(in) :: pftindex(:)
integer, intent(in) :: colindex(:)
- !
+
! !LOCAL VARIABLES:
character(len=*), parameter :: subname = 'constructor'
@@ -103,44 +92,6 @@ function constructor(ncid_source, ncid_dest, bounds_source, bounds_dest, &
allocate(this%interp_multilevel_copy)
this%interp_multilevel_copy = interp_multilevel_copy_type()
- allocate(this%interp_multilevel_levgrnd_col)
- this%interp_multilevel_levgrnd_col = create_interp_multilevel_levgrnd( &
- ncid_source = ncid_source, &
- ncid_dest = ncid_dest, &
- bounds_source = bounds_source, &
- bounds_dest = bounds_dest, &
- coord_varname = 'COL_Z', &
- level_class_varname = 'LEVGRND_CLASS', &
- sgridindex = colindex)
-
- allocate(this%interp_multilevel_levgrnd_pft)
- this%interp_multilevel_levgrnd_pft = create_interp_multilevel_levgrnd( &
- ncid_source = ncid_source, &
- ncid_dest = ncid_dest, &
- bounds_source = bounds_source, &
- bounds_dest = bounds_dest, &
- coord_varname = 'COL_Z_p', &
- level_class_varname = 'LEVGRND_CLASS_p', &
- sgridindex = pftindex)
-
- allocate(this%interp_multilevel_levsno)
- allocate(this%interp_multilevel_levsno1)
- call create_snow_interpolators( &
- interp_multilevel_levsno = this%interp_multilevel_levsno, &
- interp_multilevel_levsno1 = this%interp_multilevel_levsno1, &
- ncid_source = ncid_source, &
- bounds_source = bounds_source, &
- bounds_dest = bounds_dest, &
- colindex = colindex)
-
- ! levtot is two sets of levels: first snow, then levgrnd
- allocate(this%interp_multilevel_levtot_col)
- this%interp_multilevel_levtot_col = create_interp_multilevel_split_type( &
- interpolator_first_levels = this%find_interpolator('levsno', 'column'), &
- interpolator_second_levels = this%interp_multilevel_levgrnd_col, &
- num_second_levels_source = this%interp_multilevel_levgrnd_col%get_nlev_source(), &
- num_second_levels_dest = this%interp_multilevel_levgrnd_col%get_nlev_dest())
-
end function constructor
! ========================================================================
@@ -171,24 +122,9 @@ function find_interpolator(this, lev_dimname, vec_dimname) result(interpolator)
select case (lev_dimname)
case ('levgrnd')
select case (vec_dimname)
- case ('column')
- interpolator => this%interp_multilevel_levgrnd_col
- case ('pft')
- interpolator => this%interp_multilevel_levgrnd_pft
- case default
- call error_not_found(subname, lev_dimname, vec_dimname)
- end select
- case ('levtot')
- select case (vec_dimname)
- case ('column')
- interpolator => this%interp_multilevel_levtot_col
case default
call error_not_found(subname, lev_dimname, vec_dimname)
end select
- case ('levsno')
- interpolator => this%interp_multilevel_levsno
- case ('levsno1')
- interpolator => this%interp_multilevel_levsno1
case default
interpolator => this%interp_multilevel_copy
end select
@@ -208,287 +144,4 @@ end subroutine error_not_found
end function find_interpolator
- ! ========================================================================
- ! Private methods and routines
- ! ========================================================================
-
- !-----------------------------------------------------------------------
- function create_interp_multilevel_levgrnd(ncid_source, ncid_dest, &
- bounds_source, bounds_dest, &
- coord_varname, level_class_varname, &
- sgridindex) &
- result(interpolator)
- !
- ! !DESCRIPTION:
- ! Create the interpolator used to interpolate variables dimensioned by levgrnd
- !
- ! !USES:
- !
- ! !ARGUMENTS:
- type(interp_multilevel_interp_type) :: interpolator ! function result
- type(file_desc_t), target, intent(inout) :: ncid_source
- type(file_desc_t), target, intent(inout) :: ncid_dest
- type(interp_bounds_type), intent(in) :: bounds_source
- type(interp_bounds_type), intent(in) :: bounds_dest
- character(len=*), intent(in) :: coord_varname
- character(len=*), intent(in) :: level_class_varname
- integer, intent(in) :: sgridindex(:) ! mappings from source to dest points for the appropriate subgrid level (e.g., column-level mappings if this interpolator is for column-level data)
- !
- ! !LOCAL VARIABLES:
- type(interp_2dvar_type) :: coord_source
- type(interp_2dvar_type) :: coord_dest
- type(interp_2dvar_type) :: level_class_source
- type(interp_2dvar_type) :: level_class_dest
- real(r8), pointer :: coord_data_source_sgrid_1d(:) ! [vec] On the source grid
- real(r8), allocatable :: coord_data_source(:,:) ! [vec, lev] Interpolated to the dest grid, but source vertical grid
- real(r8), pointer :: coord_data_dest(:,:) ! [vec, lev] Dest horiz & vertical grid
- integer , pointer :: level_class_data_source_sgrid_1d(:) ! [vec] On the source grid
- integer , allocatable :: level_class_data_source(:,:) ! [vec, lev] Interpolated to the dest grid, but source vertical grid
- integer , pointer :: level_class_data_dest(:,:) ! [vec, lev] Dest horiz & vertical grid
- real(r8), allocatable :: coord_data_source_transpose(:,:) ! [lev, vec]
- real(r8), allocatable :: coord_data_dest_transpose(:,:) ! [lev, vec]
- integer , allocatable :: level_class_data_source_transpose(:,:) ! [lev, vec]
- integer , allocatable :: level_class_data_dest_transpose(:,:) ! [lev, vec]
-
- integer :: beg_dest
- integer :: end_dest
- integer :: beg_source
- integer :: end_source
-
- integer :: level
- integer :: nlev_source
-
- character(len=*), parameter :: subname = 'create_interp_multilevel_levgrnd'
- !-----------------------------------------------------------------------
-
- ! Set coord_data_dest
- coord_dest = interp_2dvar_type( &
- varname = coord_varname, &
- ncid = ncid_dest, &
- file_is_dest = .true., &
- bounds = bounds_dest)
- ! COMPILER_BUG(wjs, 2015-11-25, cray8.4.0) The cray compiler has trouble
- ! resolving the generic reference here, giving the message: 'No specific
- ! match can be found for the generic subprogram call "READVAR"'. So we
- ! explicitly call the specific routine, rather than calling readvar.
- call coord_dest%readvar_double(coord_data_dest)
- beg_dest = coord_dest%get_vec_beg()
- end_dest = coord_dest%get_vec_end()
-
- ! Set level_class_data_dest
- level_class_dest = interp_2dvar_type( &
- varname = level_class_varname, &
- ncid = ncid_dest, &
- file_is_dest = .true., &
- bounds = bounds_dest)
- ! COMPILER_BUG(wjs, 2015-11-25, cray8.4.0) The cray compiler has trouble
- ! resolving the generic reference here, giving the message: 'No specific
- ! match can be found for the generic subprogram call "READVAR"'. So we
- ! explicitly call the specific routine, rather than calling readvar.
- call level_class_dest%readvar_int(level_class_data_dest)
- SHR_ASSERT(level_class_dest%get_vec_beg() == beg_dest, errMsg(sourcefile, __LINE__))
- SHR_ASSERT(level_class_dest%get_vec_end() == end_dest, errMsg(sourcefile, __LINE__))
-
- ! NOTE(wjs, 2015-10-18) The following check is helpful while we still have old initial
- ! conditions files that do not have the necessary metadata. Once these old initial
- ! conditions files have been phased out, we can remove this check. (Without this
- ! check, the run will still abort if it can't find the necessary variables - it just
- ! won't have a very helpful error message.)
- call interp_levgrnd_check_source_file(ncid_source, coord_varname, level_class_varname)
-
- ! Set coord_data_source
- coord_source = interp_2dvar_type( &
- varname = coord_varname, &
- ncid = ncid_source, &
- file_is_dest = .false., &
- bounds = bounds_source)
- nlev_source = coord_source%get_nlev()
- beg_source = coord_source%get_vec_beg()
- end_source = coord_source%get_vec_end()
- allocate(coord_data_source(beg_dest:end_dest, nlev_source))
- allocate(coord_data_source_sgrid_1d(beg_source:end_source))
- do level = 1, nlev_source
- ! COMPILER_BUG(wjs, 2015-11-25, cray8.4.0) The cray compiler has trouble
- ! resolving the generic reference here, giving the message: 'No specific
- ! match can be found for the generic subprogram call "READLEVEL"'. So we
- ! explicitly call the specific routine, rather than calling readlevel.
- call coord_source%readlevel_double(coord_data_source_sgrid_1d, level)
- call interp_1d_data( &
- begi = beg_source, endi = end_source, &
- bego = beg_dest, endo = end_dest, &
- sgridindex = sgridindex, &
- keep_existing = .false., &
- data_in = coord_data_source_sgrid_1d, &
- data_out = coord_data_source(:,level))
- end do
- deallocate(coord_data_source_sgrid_1d)
-
- ! Set level_class_data_source
- level_class_source = interp_2dvar_type( &
- varname = level_class_varname, &
- ncid = ncid_source, &
- file_is_dest = .false., &
- bounds = bounds_source)
- SHR_ASSERT(level_class_source%get_nlev() == nlev_source, errMsg(sourcefile, __LINE__))
- SHR_ASSERT(level_class_source%get_vec_beg() == beg_source, errMsg(sourcefile, __LINE__))
- SHR_ASSERT(level_class_source%get_vec_end() == end_source, errMsg(sourcefile, __LINE__))
- allocate(level_class_data_source(beg_dest:end_dest, nlev_source))
- allocate(level_class_data_source_sgrid_1d(beg_source:end_source))
- do level = 1, nlev_source
- ! COMPILER_BUG(wjs, 2015-11-25, cray8.4.0) The cray compiler has trouble
- ! resolving the generic reference here, giving the message: 'No specific
- ! match can be found for the generic subprogram call "READLEVEL"'. So we
- ! explicitly call the specific routine, rather than calling readlevel.
- call level_class_source%readlevel_int(level_class_data_source_sgrid_1d, level)
- call interp_1d_data( &
- begi = beg_source, endi = end_source, &
- bego = beg_dest, endo = end_dest, &
- sgridindex = sgridindex, &
- keep_existing = .false., &
- data_in = level_class_data_source_sgrid_1d, &
- data_out = level_class_data_source(:,level))
- end do
- deallocate(level_class_data_source_sgrid_1d)
-
- ! Create interpolator
- call transpose_wrapper(coord_data_source_transpose, coord_data_source)
- call transpose_wrapper(coord_data_dest_transpose, coord_data_dest)
- call transpose_wrapper(level_class_data_source_transpose, level_class_data_source)
- call transpose_wrapper(level_class_data_dest_transpose, level_class_data_dest)
- interpolator = interp_multilevel_interp_type( &
- coordinates_source = coord_data_source_transpose, &
- coordinates_dest = coord_data_dest_transpose, &
- level_classes_source = level_class_data_source_transpose, &
- level_classes_dest = level_class_data_dest_transpose, &
- coord_varname = coord_varname)
-
- ! Deallocate pointers (allocatables are automatically deallocated)
- deallocate(coord_data_dest)
- deallocate(level_class_data_dest)
-
- end function create_interp_multilevel_levgrnd
-
- !-----------------------------------------------------------------------
- subroutine interp_levgrnd_check_source_file(ncid_source, coord_varname, level_class_varname)
- !
- ! !DESCRIPTION:
- ! Ensure that the necessary variables are present on the source file for the levgrnd
- ! interpolator.
- !
- ! Aborts the run with a useful error message if either variable is missing
- !
- ! !USES:
- !
- ! !ARGUMENTS:
- type(file_desc_t), intent(inout) :: ncid_source
- character(len=*) , intent(in) :: coord_varname
- character(len=*) , intent(in) :: level_class_varname
- !
- ! !LOCAL VARIABLES:
- logical :: coord_on_source
- logical :: level_class_on_source
- type(var_desc_t) :: coord_source_vardesc ! unused, but needed for check_var interface
- type(var_desc_t) :: level_class_source_vardesc ! unused, but needed for check_var interface
- character(len=:), allocatable :: variables_missing
-
- character(len=*), parameter :: subname = 'interp_levgrnd_check_source_file'
- !-----------------------------------------------------------------------
-
- variables_missing = ' '
- call check_var(ncid_source, coord_varname, coord_source_vardesc, coord_on_source)
- if (.not. coord_on_source) then
- variables_missing = variables_missing // coord_varname // ' '
- end if
- call check_var(ncid_source, level_class_varname, level_class_source_vardesc, level_class_on_source)
- if (.not. level_class_on_source) then
- variables_missing = variables_missing // level_class_varname // ' '
- end if
- if (variables_missing /= ' ') then
- if (masterproc) then
- write(iulog,*) subname//&
- ' ERROR: source file for init_interp is missing the necessary variable(s):'
- write(iulog,*) variables_missing
- write(iulog,*) 'To solve this problem, run the model for a short time using this tag,'
- write(iulog,*) 'with a configuration that matches the source file, using the source'
- write(iulog,*) 'file as finidat (with use_init_interp = .false.), in order to'
- write(iulog,*) 'produce a new restart file with the necessary metadata.'
- write(iulog,*) 'Then use that new file as the finidat file for init_interp.'
- write(iulog,*) ' '
- write(iulog,*) 'If that is not possible, then an alternative is to run the model for'
- write(iulog,*) 'a short time using this tag, with cold start initial conditions'
- write(iulog,*) '(finidat = " "). Then use a tool like ncks to copy the misssing fields'
- write(iulog,*) 'onto the original source finidat file. Then use that patched file'
- write(iulog,*) 'as the finidat file for init_interp.'
- end if
-
- call endrun(subname//' ERROR: source file for init_interp is missing '// &
- variables_missing)
- end if
-
- end subroutine interp_levgrnd_check_source_file
-
- !-----------------------------------------------------------------------
- subroutine create_snow_interpolators(interp_multilevel_levsno, interp_multilevel_levsno1, &
- ncid_source, bounds_source, bounds_dest, colindex)
- !
- ! !DESCRIPTION:
- ! Create multi-level interpolators for snow variables
- !
- ! !USES:
- !
- ! !ARGUMENTS:
- type(interp_multilevel_snow_type), intent(out) :: interp_multilevel_levsno
- type(interp_multilevel_snow_type), intent(out) :: interp_multilevel_levsno1
- type(file_desc_t), intent(inout) :: ncid_source ! netcdf ID for source file
- type(interp_bounds_type), intent(in) :: bounds_source
- type(interp_bounds_type), intent(in) :: bounds_dest
- integer, intent(in) :: colindex(:) ! mappings from source to dest for column-level arrays
- !
- ! !LOCAL VARIABLES:
- ! snlsno_source needs to be a pointer to satisfy the interface of ncd_io
- integer, pointer :: snlsno_source_sgrid(:) ! snlsno in source, on source grid
- integer, allocatable :: snlsno_source(:) ! snlsno_source interpolated to dest
- integer, allocatable :: snlsno_source_plus_1(:) ! snlsno_source+1 interpolated to dest
-
- character(len=*), parameter :: subname = 'create_snow_interpolators'
- !-----------------------------------------------------------------------
-
- ! Read snlsno_source_sgrid
- allocate(snlsno_source_sgrid(bounds_source%get_begc() : bounds_source%get_endc()))
- call ncd_io(ncid=ncid_source, varname='SNLSNO', flag='read', &
- data=snlsno_source_sgrid)
- snlsno_source_sgrid(:) = abs(snlsno_source_sgrid(:))
-
- ! Interpolate to dest
- allocate(snlsno_source(bounds_dest%get_begc() : bounds_dest%get_endc()))
- call interp_1d_data( &
- begi = bounds_source%get_begc(), endi = bounds_source%get_endc(), &
- bego = bounds_dest%get_begc(), endo = bounds_dest%get_endc(), &
- sgridindex = colindex, &
- keep_existing = .false., &
- data_in = snlsno_source_sgrid, data_out = snlsno_source)
- deallocate(snlsno_source_sgrid)
-
- ! Set up interp_multilevel_levsno
- interp_multilevel_levsno = interp_multilevel_snow_type( &
- num_snow_layers_source = snlsno_source, &
- num_layers_name = 'SNLSNO')
-
- ! Set up interp_multilevel_levsno1
- !
- ! For variables dimensioned (levsno+1), we assume they have (snlsno+1) active layers.
- ! Thus, if there are 0 active layers in the source, the bottom layer's value will
- ! still get copied for these (levsno+1) variables.
- allocate(snlsno_source_plus_1(bounds_dest%get_begc() : bounds_dest%get_endc()))
- snlsno_source_plus_1(:) = snlsno_source(:) + 1
- interp_multilevel_levsno1 = interp_multilevel_snow_type( &
- num_snow_layers_source = snlsno_source_plus_1, &
- num_layers_name = 'SNLSNO+1')
-
- deallocate(snlsno_source)
- deallocate(snlsno_source_plus_1)
-
- end subroutine create_snow_interpolators
-
-
end module initInterpMultilevelContainer
diff --git a/src/main/ColumnType.F90 b/src/main/ColumnType.F90
deleted file mode 100644
index 7043bfa1..00000000
--- a/src/main/ColumnType.F90
+++ /dev/null
@@ -1,209 +0,0 @@
-module ColumnType
-
- !-----------------------------------------------------------------------
- ! !DESCRIPTION:
- ! Column data type allocation and initialization
- ! --------------------------------------------------------
- ! column types can have values of
- ! --------------------------------------------------------
- ! 1 => (istsoil) soil (vegetated or bare soil)
- ! 2 => (istcrop) crop (only for crop configuration)
- ! 3 => (UNUSED) (formerly non-multiple elevation class land ice; currently unused)
- ! 4 => (istice_mec) land ice (multiple elevation classes)
- ! 5 => (istdlak) deep lake
- ! 6 => (istwet) wetland
- ! 71 => (icol_roof) urban roof
- ! 72 => (icol_sunwall) urban sunwall
- ! 73 => (icol_shadewall) urban shadewall
- ! 74 => (icol_road_imperv) urban impervious road
- ! 75 => (icol_road_perv) urban pervious road
- !
- use shr_kind_mod , only : r8 => shr_kind_r8
- use shr_infnan_mod , only : nan => shr_infnan_nan, assignment(=)
- use clm_varpar , only : nlevsno, nlevgrnd, nlevlak
- use clm_varcon , only : spval, ispval
- use shr_sys_mod , only : shr_sys_abort
- use clm_varctl , only : iulog
- use column_varcon , only : is_hydrologically_active
- use LandunitType , only : lun
- !
- ! !PUBLIC TYPES:
- implicit none
- save
- private
- !
- type, public :: column_type
- ! g/l/c/p hierarchy, local g/l/c/p cells only
- integer , pointer :: landunit (:) ! index into landunit level quantities
- real(r8), pointer :: wtlunit (:) ! weight (relative to landunit)
- integer , pointer :: gridcell (:) ! index into gridcell level quantities
- real(r8), pointer :: wtgcell (:) ! weight (relative to gridcell)
- integer , pointer :: patchi (:) ! beginning patch index for each column
- integer , pointer :: patchf (:) ! ending patch index for each column
- integer , pointer :: npatches (:) ! number of patches for each column
-
- ! topological mapping functionality
- integer , pointer :: itype (:) ! column type (after init, should only be modified via update_itype routine)
- logical , pointer :: active (:) ! true=>do computations on this column
- logical , pointer :: type_is_dynamic (:) ! true=>itype can change throughout the run
-
- ! topography
- ! TODO(wjs, 2016-04-05) Probably move these things into topoMod
- real(r8), pointer :: micro_sigma (:) ! microtopography pdf sigma (m)
- real(r8), pointer :: n_melt (:) ! SCA shape parameter
- real(r8), pointer :: topo_slope (:) ! gridcell topographic slope
- real(r8), pointer :: topo_std (:) ! gridcell elevation standard deviation
-
- ! vertical levels
- integer , pointer :: snl (:) ! number of snow layers
- real(r8), pointer :: dz (:,:) ! layer thickness (m) (-nlevsno+1:nlevgrnd)
- real(r8), pointer :: z (:,:) ! layer depth (m) (-nlevsno+1:nlevgrnd)
- real(r8), pointer :: zi (:,:) ! interface level below a "z" level (m) (-nlevsno+0:nlevgrnd)
- real(r8), pointer :: zii (:) ! convective boundary height [m]
- real(r8), pointer :: dz_lake (:,:) ! lake layer thickness (m) (1:nlevlak)
- real(r8), pointer :: z_lake (:,:) ! layer depth for lake (m)
- real(r8), pointer :: lakedepth (:) ! variable lake depth (m)
- integer , pointer :: nbedrock (:) ! variable depth to bedrock index
-
- ! other column characteristics
- logical , pointer :: hydrologically_active(:) ! true if this column is a hydrologically active type
-
- ! levgrnd_class gives the class in which each layer falls. This is relevant for
- ! columns where there are 2 or more fundamentally different layer types. For
- ! example, this distinguishes between soil and bedrock layers. The particular value
- ! assigned to each class is irrelevant; the important thing is that different
- ! classes (e.g., soil vs. bedrock) have different values of levgrnd_class.
- !
- ! levgrnd_class = ispval indicates that the given layer is completely unused for
- ! this column (i.e., this column doesn't use the full nlevgrnd layers).
- integer , pointer :: levgrnd_class (:,:) ! class in which each layer falls (1:nlevgrnd)
- contains
-
- procedure, public :: Init
- procedure, public :: Clean
-
- ! Update the column type for one column. Any updates to col%itype after
- ! initialization should be made via this routine.
- procedure, public :: update_itype
-
- end type column_type
-
- type(column_type), public, target :: col !column data structure (soil/snow/canopy columns)
- !------------------------------------------------------------------------
-
-contains
-
- !------------------------------------------------------------------------
- subroutine Init(this, begc, endc)
- !
- ! !ARGUMENTS:
- class(column_type) :: this
- integer, intent(in) :: begc,endc
- !------------------------------------------------------------------------
-
- ! The following is set in initGridCellsMod
- allocate(this%gridcell (begc:endc)) ; this%gridcell (:) = ispval
- allocate(this%wtgcell (begc:endc)) ; this%wtgcell (:) = nan
- allocate(this%landunit (begc:endc)) ; this%landunit (:) = ispval
- allocate(this%wtlunit (begc:endc)) ; this%wtlunit (:) = nan
- allocate(this%patchi (begc:endc)) ; this%patchi (:) = ispval
- allocate(this%patchf (begc:endc)) ; this%patchf (:) = ispval
- allocate(this%npatches (begc:endc)) ; this%npatches (:) = ispval
- allocate(this%itype (begc:endc)) ; this%itype (:) = ispval
- allocate(this%active (begc:endc)) ; this%active (:) = .false.
- allocate(this%type_is_dynamic(begc:endc)) ; this%type_is_dynamic(:) = .false.
-
- ! The following is set in initVerticalMod
- allocate(this%snl (begc:endc)) ; this%snl (:) = ispval !* cannot be averaged up
- this%snl (:) = 0 ! Explicitly set the number of snow laters to zero as they are unused
- allocate(this%dz (begc:endc,-nlevsno+1:nlevgrnd)) ; this%dz (:,:) = nan
- allocate(this%z (begc:endc,-nlevsno+1:nlevgrnd)) ; this%z (:,:) = nan
- allocate(this%zi (begc:endc,-nlevsno+0:nlevgrnd)) ; this%zi (:,:) = nan
- allocate(this%zii (begc:endc)) ; this%zii (:) = nan
- allocate(this%lakedepth (begc:endc)) ; this%lakedepth (:) = spval
- allocate(this%dz_lake (begc:endc,nlevlak)) ; this%dz_lake (:,:) = nan
- allocate(this%z_lake (begc:endc,nlevlak)) ; this%z_lake (:,:) = nan
-
- allocate(this%nbedrock (begc:endc)) ; this%nbedrock (:) = ispval
- allocate(this%levgrnd_class(begc:endc,nlevgrnd)) ; this%levgrnd_class(:,:) = ispval
- allocate(this%micro_sigma (begc:endc)) ; this%micro_sigma (:) = nan
- allocate(this%n_melt (begc:endc)) ; this%n_melt (:) = nan
- allocate(this%topo_slope (begc:endc)) ; this%topo_slope (:) = nan
- allocate(this%topo_std (begc:endc)) ; this%topo_std (:) = nan
-
- allocate(this%hydrologically_active(begc:endc)) ; this%hydrologically_active(:) = .false.
-
- end subroutine Init
-
- !------------------------------------------------------------------------
- subroutine Clean(this)
- !
- ! !ARGUMENTS:
- class(column_type) :: this
- !------------------------------------------------------------------------
-
- deallocate(this%gridcell )
- deallocate(this%wtgcell )
- deallocate(this%landunit )
- deallocate(this%wtlunit )
- deallocate(this%patchi )
- deallocate(this%patchf )
- deallocate(this%npatches )
- deallocate(this%itype )
- deallocate(this%active )
- deallocate(this%type_is_dynamic)
- deallocate(this%snl )
- deallocate(this%dz )
- deallocate(this%z )
- deallocate(this%zi )
- deallocate(this%zii )
- deallocate(this%lakedepth )
- deallocate(this%dz_lake )
- deallocate(this%z_lake )
- deallocate(this%micro_sigma)
- deallocate(this%n_melt )
- deallocate(this%topo_slope )
- deallocate(this%topo_std )
- deallocate(this%nbedrock )
- deallocate(this%levgrnd_class)
- deallocate(this%hydrologically_active)
-
- end subroutine Clean
-
- !-----------------------------------------------------------------------
- subroutine update_itype(this, c, itype)
- !
- ! !DESCRIPTION:
- ! Update the column type for one column. Any updates to col%itype after
- ! initialization should be made via this routine.
- !
- ! !ARGUMENTS:
- class(column_type), intent(inout) :: this
- integer, intent(in) :: c
- integer, intent(in) :: itype
- !
- ! !LOCAL VARIABLES:
- integer :: l
-
- character(len=*), parameter :: subname = 'update_itype'
- !-----------------------------------------------------------------------
-
- l = col%landunit(c)
-
- if (col%type_is_dynamic(c)) then
- col%itype(c) = itype
- col%hydrologically_active(c) = is_hydrologically_active( &
- col_itype = itype, &
- lun_itype = lun%itype(l))
- else
- write(iulog,*) subname//' ERROR: attempt to update itype when type_is_dynamic is false'
- write(iulog,*) 'c, col%itype(c), itype = ', c, col%itype(c), itype
- ! Need to use shr_sys_abort rather than endrun, because using endrun would cause
- ! circular dependencies
- call shr_sys_abort(subname//' ERROR: attempt to update itype when type_is_dynamic is false')
- end if
- end subroutine update_itype
-
-
-
-end module ColumnType
diff --git a/src/main/FuncPedotransferMod.F90 b/src/main/FuncPedotransferMod.F90
deleted file mode 100644
index 41e75134..00000000
--- a/src/main/FuncPedotransferMod.F90
+++ /dev/null
@@ -1,141 +0,0 @@
-module FuncPedotransferMod
-!
-!DESCRIPTIONS:
-!module contains different pedotransfer functions to
-!compute the mineral soil hydraulic properties.
-!currenty, only the Clapp-Hornberg formulation is used.
-!HISTORY:
-!created by Jinyun Tang, Mar.1st, 2014
-implicit none
- private
- public :: pedotransf
- public :: get_ipedof
- public :: init_pedof
-
- integer, parameter :: cosby_1984_table5 = 0 !by default uses this form
- integer, parameter :: cosby_1984_table4 = 1
- integer, parameter :: noilhan_lacarrere_1995 = 2
- integer :: ipedof0
-contains
-
- subroutine init_pedof()
- !
- !DESCRIPTIONS
- !initialize the default pedotransfer function
- implicit none
-
-
- ipedof0 = cosby_1984_table5 !the default pedotransfer function
- end subroutine init_pedof
-
- subroutine pedotransf(ipedof, sand, clay, watsat, bsw, sucsat, xksat)
- !pedotransfer function to compute hydraulic properties of mineral soil
- !based on input soil texture
-
- use shr_kind_mod , only : r8 => shr_kind_r8
- use abortutils , only : endrun
- implicit none
- integer, intent(in) :: ipedof !type of pedotransfer function, use the default pedotransfer function
- real(r8), intent(in) :: sand !% sand
- real(r8), intent(in) :: clay !% clay
- real(r8), intent(out):: watsat !v/v saturate moisture
- real(r8), intent(out):: bsw !b shape parameter
- real(r8), intent(out):: sucsat !mm, soil matric potential
- real(r8), intent(out):: xksat !mm/s, saturated hydraulic conductivity
-
- character(len=32) :: subname = 'pedotransf' ! subroutine name
- select case (ipedof)
- case (cosby_1984_table4)
- call pedotransf_cosby1984_table4(sand, clay, watsat, bsw, sucsat, xksat)
- case (noilhan_lacarrere_1995)
- call pedotransf_noilhan_lacarrere1995(sand, clay, watsat, bsw, sucsat, xksat)
- case (cosby_1984_table5)
- call pedotransf_cosby1984_table5(sand, clay, watsat, bsw, sucsat, xksat)
- case default
- call endrun(subname // ':: a pedotransfer function must be specified!')
- end select
-
- end subroutine pedotransf
-
-!------------------------------------------------------------------------------------------
- subroutine pedotransf_cosby1984_table4(sand, clay, watsat, bsw, sucsat, xksat)
- !
- !DESCRIPTIONS
- !compute hydraulic properties based on functions derived from Table 4 in cosby et al, 1984
- use shr_kind_mod , only : r8 => shr_kind_r8
- implicit none
- real(r8), intent(in) :: sand !% sand
- real(r8), intent(in) :: clay !% clay
- real(r8), intent(out):: watsat !v/v saturate moisture
- real(r8), intent(out):: bsw !b shape parameter
- real(r8), intent(out):: sucsat !mm, soil matric potential
- real(r8), intent(out):: xksat !mm/s, saturated hydraulic conductivity
-
- !Cosby et al. Table 4
- watsat = 0.505_r8-0.00142_r8*sand-0.00037*clay
- bsw = 3.10+0.157*clay-0.003*sand
- sucsat = 10._r8 * ( 10._r8**(1.54_r8-0.0095_r8*sand+0.0063*(100._r8-sand-clay)))
- xksat = 0.0070556 *(10.**(-0.60+0.0126*sand-0.0064*clay) ) !mm/s now use table 4.
-
- end subroutine pedotransf_cosby1984_table4
-
-!------------------------------------------------------------------------------------------
- subroutine pedotransf_cosby1984_table5(sand, clay, watsat, bsw, sucsat, xksat)
- !
- !DESCRIPTIONS
- !compute hydraulic properties based on functions derived from Table 5 in cosby et al, 1984
-
- use shr_kind_mod , only : r8 => shr_kind_r8
- implicit none
- real(r8), intent(in) :: sand !% sand
- real(r8), intent(in) :: clay !% clay
- real(r8), intent(out):: watsat !v/v saturate moisture
- real(r8), intent(out):: bsw !b shape parameter
- real(r8), intent(out):: sucsat !mm, soil matric potential
- real(r8), intent(out):: xksat !mm/s, saturated hydraulic conductivity
-
- !Cosby et al. Table 5
- watsat = 0.489_r8 - 0.00126_r8*sand
- bsw = 2.91 + 0.159*clay
- sucsat = 10._r8 * ( 10._r8**(1.88_r8-0.0131_r8*sand) )
- xksat = 0.0070556 *( 10.**(-0.884+0.0153*sand) ) ! mm/s, from table 5
-
- end subroutine pedotransf_cosby1984_table5
-
-!------------------------------------------------------------------------------------------
- subroutine pedotransf_noilhan_lacarrere1995(sand, clay, watsat, bsw, sucsat, xksat)
- !
- !DESCRIPTIONS
- !compute hydraulic properties based on functions derived from Noilhan and Lacarrere, 1995
-
- use shr_kind_mod , only : r8 => shr_kind_r8
- implicit none
- real(r8), intent(in) :: sand !% sand
- real(r8), intent(in) :: clay !% clay
- real(r8), intent(out):: watsat !v/v saturate moisture
- real(r8), intent(out):: bsw !b shape parameter
- real(r8), intent(out):: sucsat !mm, soil matric potential
- real(r8), intent(out):: xksat !mm/s, saturated hydraulic conductivity
-
- !Noilhan and Lacarrere, 1995
- watsat = -0.00108*sand+0.494305
- bsw = 0.137*clay + 3.501
- sucsat = 10._r8**(-0.0088*sand+2.85)
- xksat = 10._r8**(-0.0582*clay-0.00091*sand+0.000529*clay**2._r8-0.0001203*sand**2._r8-1.38)
- end subroutine pedotransf_noilhan_lacarrere1995
-!------------------------------------------------------------------------------------------
- function get_ipedof(soil_order)result(ipedof)
- !
- ! DESCRIPTION
- ! select the pedotransfer function to be used
- implicit none
- integer, intent(in) :: soil_order
-
- integer :: ipedof
-
- if(soil_order==0)then
- ipedof=ipedof0
- endif
-
- end function get_ipedof
-end module FuncpedotransferMod
diff --git a/src/main/GetGlobalValuesMod.F90 b/src/main/GetGlobalValuesMod.F90
index 3cd1f9a3..1f43f27f 100644
--- a/src/main/GetGlobalValuesMod.F90
+++ b/src/main/GetGlobalValuesMod.F90
@@ -28,7 +28,7 @@ integer function GetGlobalIndex(decomp_index, clmlevel)
use shr_log_mod, only: errMsg => shr_log_errMsg
use decompMod , only: bounds_type, get_clmlevel_gsmap, get_proc_bounds
use spmdMod , only: iam
- use clm_varcon , only: nameg, namel, namec, namep
+ use clm_varcon , only: nameg
use clm_varctl , only: iulog
use mct_mod , only: mct_gsMap, mct_gsMap_orderedPoints
use shr_sys_mod, only: shr_sys_abort
@@ -48,12 +48,6 @@ integer function GetGlobalIndex(decomp_index, clmlevel)
if (trim(clmlevel) == nameg) then
beg_index = bounds_proc%begg
- else if (trim(clmlevel) == namel) then
- beg_index = bounds_proc%begl
- else if (trim(clmlevel) == namec) then
- beg_index = bounds_proc%begc
- else if (trim(clmlevel) == namep) then
- beg_index = bounds_proc%begp
else
call shr_sys_abort('clmlevel of '//trim(clmlevel)//' not supported' // &
errmsg(sourcefile, __LINE__))
@@ -77,18 +71,15 @@ subroutine GetGlobalWrite(decomp_index, clmlevel)
use shr_sys_mod , only : shr_sys_abort
use shr_log_mod , only : errMsg => shr_log_errMsg
use clm_varctl , only : iulog
- use clm_varcon , only : nameg, namel, namec, namep
+ use clm_varcon , only : nameg
use GridcellType , only : grc
- use LandunitType , only : lun
- use ColumnType , only : col
- use PatchType , only : patch
!
! Arguments:
integer , intent(in) :: decomp_index
character(len=*) , intent(in) :: clmlevel
!
! Local Variables:
- integer :: igrc, ilun, icol, ipft
+ integer :: igrc
!-----------------------------------------------------------------------
if (trim(clmlevel) == nameg) then
@@ -99,48 +90,6 @@ subroutine GetGlobalWrite(decomp_index, clmlevel)
write(iulog,*)'gridcell longitude = ',grc%londeg(igrc)
write(iulog,*)'gridcell latitude = ',grc%latdeg(igrc)
- else if (trim(clmlevel) == namel) then
-
- ilun = decomp_index
- igrc = lun%gridcell(ilun)
- write(iulog,*)'local landunit index = ',ilun
- write(iulog,*)'global landunit index = ',GetGlobalIndex(decomp_index=ilun, clmlevel=namel)
- write(iulog,*)'global gridcell index = ',GetGlobalIndex(decomp_index=igrc, clmlevel=nameg)
- write(iulog,*)'gridcell longitude = ',grc%londeg(igrc)
- write(iulog,*)'gridcell latitude = ',grc%latdeg(igrc)
- write(iulog,*)'landunit type = ',lun%itype(decomp_index)
-
- else if (trim(clmlevel) == namec) then
-
- icol = decomp_index
- ilun = col%landunit(icol)
- igrc = col%gridcell(icol)
- write(iulog,*)'local column index = ',icol
- write(iulog,*)'global column index = ',GetGlobalIndex(decomp_index=icol, clmlevel=namec)
- write(iulog,*)'global landunit index = ',GetGlobalIndex(decomp_index=ilun, clmlevel=namel)
- write(iulog,*)'global gridcell index = ',GetGlobalIndex(decomp_index=igrc, clmlevel=nameg)
- write(iulog,*)'gridcell longitude = ',grc%londeg(igrc)
- write(iulog,*)'gridcell latitude = ',grc%latdeg(igrc)
- write(iulog,*)'column type = ',col%itype(icol)
- write(iulog,*)'landunit type = ',lun%itype(ilun)
-
- else if (trim(clmlevel) == namep) then
-
- ipft = decomp_index
- icol = patch%column(ipft)
- ilun = patch%landunit(ipft)
- igrc = patch%gridcell(ipft)
- write(iulog,*)'local patch index = ',ipft
- write(iulog,*)'global patch index = ',GetGlobalIndex(decomp_index=ipft, clmlevel=namep)
- write(iulog,*)'global column index = ',GetGlobalIndex(decomp_index=icol, clmlevel=namec)
- write(iulog,*)'global landunit index = ',GetGlobalIndex(decomp_index=ilun, clmlevel=namel)
- write(iulog,*)'global gridcell index = ',GetGlobalIndex(decomp_index=igrc, clmlevel=nameg)
- write(iulog,*)'gridcell longitude = ',grc%londeg(igrc)
- write(iulog,*)'gridcell latitude = ',grc%latdeg(igrc)
- write(iulog,*)'pft type = ',patch%itype(ipft)
- write(iulog,*)'column type = ',col%itype(icol)
- write(iulog,*)'landunit type = ',lun%itype(ilun)
-
else
call shr_sys_abort('clmlevel '//trim(clmlevel)//'not supported '//errmsg(sourcefile, __LINE__))
diff --git a/src/main/GridcellType.F90 b/src/main/GridcellType.F90
index 30fe988e..580b2bd3 100644
--- a/src/main/GridcellType.F90
+++ b/src/main/GridcellType.F90
@@ -10,7 +10,6 @@ module GridcellType
!
use shr_kind_mod , only : r8 => shr_kind_r8
use shr_infnan_mod , only : nan => shr_infnan_nan, assignment(=)
- use landunit_varcon, only : max_lunit
use clm_varcon , only : ispval
!
! !PUBLIC TYPES:
@@ -29,20 +28,11 @@ module GridcellType
real(r8), pointer :: londeg (:) ! longitude (degrees)
logical , pointer :: active (:) ! just needed for symmetry with other subgrid types
- integer, pointer :: nbedrock (:) ! index of uppermost bedrock layer
-
! Daylength
real(r8) , pointer :: max_dayl (:) ! maximum daylength for this grid cell (s)
real(r8) , pointer :: dayl (:) ! daylength (seconds)
real(r8) , pointer :: prev_dayl (:) ! daylength from previous timestep (seconds)
- ! indices into landunit-level arrays for landunits in this grid cell (ispval implies
- ! this landunit doesn't exist on this grid cell) [1:max_lunit, begg:endg]
- ! (note that the spatial dimension is last here, in contrast to most 2-d variables;
- ! this is for efficiency, since most loops will go over g in the outer loop, and
- ! landunit type in the inner loop)
- integer , pointer :: landunit_indices (:,:)
-
contains
procedure, public :: Init
@@ -70,15 +60,12 @@ subroutine Init(this, begg, endg)
allocate(this%latdeg (begg:endg)) ; this%latdeg (:) = nan
allocate(this%londeg (begg:endg)) ; this%londeg (:) = nan
allocate(this%active (begg:endg)) ; this%active (:) = .true.
- allocate(this%nbedrock (begg:endg)) ; this%nbedrock (:) = ispval
! This is initiailized in module DayLength
allocate(this%max_dayl (begg:endg)) ; this%max_dayl (:) = nan
allocate(this%dayl (begg:endg)) ; this%dayl (:) = nan
allocate(this%prev_dayl (begg:endg)) ; this%prev_dayl (:) = nan
- allocate(this%landunit_indices(1:max_lunit, begg:endg)); this%landunit_indices(:,:) = ispval
-
end subroutine Init
!------------------------------------------------------------------------
@@ -95,11 +82,9 @@ subroutine Clean(this)
deallocate(this%latdeg )
deallocate(this%londeg )
deallocate(this%active )
- deallocate(this%nbedrock )
deallocate(this%max_dayl )
deallocate(this%dayl )
deallocate(this%prev_dayl )
- deallocate(this%landunit_indices )
end subroutine Clean
diff --git a/src/main/LandunitType.F90 b/src/main/LandunitType.F90
deleted file mode 100644
index 2236ca27..00000000
--- a/src/main/LandunitType.F90
+++ /dev/null
@@ -1,140 +0,0 @@
-module LandunitType
-
- !-----------------------------------------------------------------------
- ! !DESCRIPTION:
- ! Landunit data type allocation
- ! --------------------------------------------------------
- ! landunits types can have values of (see landunit_varcon.F90)
- ! --------------------------------------------------------
- ! 1 => (istsoil) soil (vegetated or bare soil landunit)
- ! 2 => (istcrop) crop (only for crop configuration)
- ! 3 => (UNUSED) (formerly non-multiple elevation class land ice; currently unused)
- ! 4 => (istice_mec) land ice (multiple elevation classes)
- ! 5 => (istdlak) deep lake
- ! 6 => (istwet) wetland
- ! 7 => (isturb_tbd) urban tbd
- ! 8 => (isturb_hd) urban hd
- ! 9 => (isturb_md) urban md
- !
- use shr_kind_mod , only : r8 => shr_kind_r8
- use shr_infnan_mod , only : nan => shr_infnan_nan, assignment(=)
- use clm_varcon , only : ispval
- !
- ! !PUBLIC TYPES:
- implicit none
- save
- private
- !
- type, public :: landunit_type
- ! g/l/c/p hierarchy, local g/l/c/p cells only
- integer , pointer :: gridcell (:) ! index into gridcell level quantities
- real(r8), pointer :: wtgcell (:) ! weight (relative to gridcell)
- integer , pointer :: coli (:) ! beginning column index per landunit
- integer , pointer :: colf (:) ! ending column index for each landunit
- integer , pointer :: ncolumns (:) ! number of columns for each landunit
- integer , pointer :: patchi (:) ! beginning patch index for each landunit
- integer , pointer :: patchf (:) ! ending patch index for each landunit
- integer , pointer :: npatches (:) ! number of patches for each landunit
-
- ! topological mapping functionality
- integer , pointer :: itype (:) ! landunit type
- logical , pointer :: ifspecial (:) ! true=>landunit is not vegetated
- logical , pointer :: lakpoi (:) ! true=>lake point
- logical , pointer :: urbpoi (:) ! true=>urban point
- logical , pointer :: glcmecpoi (:) ! true=>glacier_mec point
- logical , pointer :: active (:) ! true=>do computations on this landunit
-
- ! urban properties
- real(r8), pointer :: canyon_hwr (:) ! urban landunit canyon height to width ratio (-)
- real(r8), pointer :: wtroad_perv (:) ! urban landunit weight of pervious road column to total road (-)
- real(r8), pointer :: wtlunit_roof (:) ! weight of roof with respect to urban landunit (-)
- real(r8), pointer :: ht_roof (:) ! height of urban roof (m)
- real(r8), pointer :: z_0_town (:) ! urban landunit momentum roughness length (m)
- real(r8), pointer :: z_d_town (:) ! urban landunit displacement height (m)
-
- contains
-
- procedure, public :: Init ! Allocate and initialize
- procedure, public :: Clean ! Clean up memory
-
- end type landunit_type
- ! Singleton instance of the landunitType
- type(landunit_type), public, target :: lun !geomorphological landunits
- !------------------------------------------------------------------------
-
-contains
-
- !------------------------------------------------------------------------
- subroutine Init(this, begl, endl)
- !-----------------------------------------------------------------------
- ! !DESCRIPTION:
- ! Allocate memory and initialize to signalling NaN to require
- ! data be properly initialized somewhere else.
- !
- ! !ARGUMENTS:
- class(landunit_type) :: this
- integer, intent(in) :: begl,endl
- !------------------------------------------------------------------------
-
- ! The following is set in InitGridCellsMod
- allocate(this%gridcell (begl:endl)); this%gridcell (:) = ispval
- allocate(this%wtgcell (begl:endl)); this%wtgcell (:) = nan
- allocate(this%coli (begl:endl)); this%coli (:) = ispval
- allocate(this%colf (begl:endl)); this%colf (:) = ispval
- allocate(this%ncolumns (begl:endl)); this%ncolumns (:) = ispval
- allocate(this%patchi (begl:endl)); this%patchi (:) = ispval
- allocate(this%patchf (begl:endl)); this%patchf (:) = ispval
- allocate(this%npatches (begl:endl)); this%npatches (:) = ispval
- allocate(this%itype (begl:endl)); this%itype (:) = ispval
- allocate(this%ifspecial (begl:endl)); this%ifspecial (:) = .false.
- allocate(this%lakpoi (begl:endl)); this%lakpoi (:) = .false.
- allocate(this%urbpoi (begl:endl)); this%urbpoi (:) = .false.
- allocate(this%glcmecpoi (begl:endl)); this%glcmecpoi (:) = .false.
-
- ! The following is initialized in routine setActive in module reweightMod
- allocate(this%active (begl:endl))
-
- ! The following is set in routine urbanparams_inst%Init in module UrbanParamsType
- allocate(this%canyon_hwr (begl:endl)); this%canyon_hwr (:) = nan
- allocate(this%wtroad_perv (begl:endl)); this%wtroad_perv (:) = nan
- allocate(this%ht_roof (begl:endl)); this%ht_roof (:) = nan
- allocate(this%wtlunit_roof (begl:endl)); this%wtlunit_roof (:) = nan
- allocate(this%z_0_town (begl:endl)); this%z_0_town (:) = nan
- allocate(this%z_d_town (begl:endl)); this%z_d_town (:) = nan
-
- end subroutine Init
-
- !------------------------------------------------------------------------
- subroutine Clean(this)
- !-----------------------------------------------------------------------
- ! !DESCRIPTION:
- ! Clean up memory use
- !
- ! !ARGUMENTS:
- class(landunit_type) :: this
- !------------------------------------------------------------------------
-
- deallocate(this%gridcell )
- deallocate(this%wtgcell )
- deallocate(this%coli )
- deallocate(this%colf )
- deallocate(this%ncolumns )
- deallocate(this%patchi )
- deallocate(this%patchf )
- deallocate(this%npatches )
- deallocate(this%itype )
- deallocate(this%ifspecial )
- deallocate(this%lakpoi )
- deallocate(this%urbpoi )
- deallocate(this%glcmecpoi )
- deallocate(this%active )
- deallocate(this%canyon_hwr )
- deallocate(this%wtroad_perv )
- deallocate(this%ht_roof )
- deallocate(this%wtlunit_roof )
- deallocate(this%z_0_town )
- deallocate(this%z_d_town )
-
- end subroutine Clean
-
-end module LandunitType
diff --git a/src/main/PatchType.F90 b/src/main/PatchType.F90
deleted file mode 100644
index d00f5588..00000000
--- a/src/main/PatchType.F90
+++ /dev/null
@@ -1,207 +0,0 @@
-module PatchType
-
- !-----------------------------------------------------------------------
- ! !DESCRIPTION:
- ! Patch data type allocation
- ! --------------------------------------------------------
- ! patch types can have values of
- ! --------------------------------------------------------
- ! 0 => not_vegetated
- ! 1 => needleleaf_evergreen_temperate_tree
- ! 2 => needleleaf_evergreen_boreal_tree
- ! 3 => needleleaf_deciduous_boreal_tree
- ! 4 => broadleaf_evergreen_tropical_tree
- ! 5 => broadleaf_evergreen_temperate_tree
- ! 6 => broadleaf_deciduous_tropical_tree
- ! 7 => broadleaf_deciduous_temperate_tree
- ! 8 => broadleaf_deciduous_boreal_tree
- ! 9 => broadleaf_evergreen_shrub
- ! 10 => broadleaf_deciduous_temperate_shrub
- ! 11 => broadleaf_deciduous_boreal_shrub
- ! 12 => c3_arctic_grass
- ! 13 => c3_non-arctic_grass
- ! 14 => c4_grass
- ! 15 => c3_crop
- ! 16 => c3_irrigated
- ! 17 => temperate_corn
- ! 18 => irrigated_temperate_corn
- ! 19 => spring_wheat
- ! 20 => irrigated_spring_wheat
- ! 21 => winter_wheat
- ! 22 => irrigated_winter_wheat
- ! 23 => temperate_soybean
- ! 24 => irrigated_temperate_soybean
- ! 25 => barley
- ! 26 => irrigated_barley
- ! 27 => winter_barley
- ! 28 => irrigated_winter_barley
- ! 29 => rye
- ! 30 => irrigated_rye
- ! 31 => winter_rye
- ! 32 => irrigated_winter_rye
- ! 33 => cassava
- ! 34 => irrigated_cassava
- ! 35 => citrus
- ! 36 => irrigated_citrus
- ! 37 => cocoa
- ! 38 => irrigated_cocoa
- ! 39 => coffee
- ! 40 => irrigated_coffee
- ! 41 => cotton
- ! 42 => irrigated_cotton
- ! 43 => datepalm
- ! 44 => irrigated_datepalm
- ! 45 => foddergrass
- ! 46 => irrigated_foddergrass
- ! 47 => grapes
- ! 48 => irrigated_grapes
- ! 49 => groundnuts
- ! 50 => irrigated_groundnuts
- ! 51 => millet
- ! 52 => irrigated_millet
- ! 53 => oilpalm
- ! 54 => irrigated_oilpalm
- ! 55 => potatoes
- ! 56 => irrigated_potatoes
- ! 57 => pulses
- ! 58 => irrigated_pulses
- ! 59 => rapeseed
- ! 60 => irrigated_rapeseed
- ! 61 => rice
- ! 62 => irrigated_rice
- ! 63 => sorghum
- ! 64 => irrigated_sorghum
- ! 65 => sugarbeet
- ! 66 => irrigated_sugarbeet
- ! 67 => sugarcane
- ! 68 => irrigated_sugarcane
- ! 69 => sunflower
- ! 70 => irrigated_sunflower
- ! 71 => miscanthus
- ! 72 => irrigated_miscanthus
- ! 73 => switchgrass
- ! 74 => irrigated_switchgrass
- ! 75 => tropical_corn
- ! 76 => irrigated_tropical_corn
- ! 77 => tropical_soybean
- ! 78 => irrigated_tropical_soybean
- ! --------------------------------------------------------
- !
- use shr_kind_mod , only : r8 => shr_kind_r8
- use shr_infnan_mod , only : nan => shr_infnan_nan, assignment(=)
- use clm_varcon , only : ispval
- use clm_varctl , only : use_fates
- !
- ! !PUBLIC TYPES:
- implicit none
- save
- private
- !
- type, public :: patch_type
-
- ! g/l/c/p hierarchy, local g/l/c/p cells only
- integer , pointer :: column (:) ! index into column level quantities
- real(r8), pointer :: wtcol (:) ! weight (relative to column)
- integer , pointer :: landunit (:) ! index into landunit level quantities
- real(r8), pointer :: wtlunit (:) ! weight (relative to landunit)
- integer , pointer :: gridcell (:) ! index into gridcell level quantities
- real(r8), pointer :: wtgcell (:) ! weight (relative to gridcell)
-
- ! Non-ED only
- integer , pointer :: itype (:) ! patch vegetation
- integer , pointer :: mxy (:) ! m index for laixy(i,j,m),etc. (undefined for special landunits)
- logical , pointer :: active (:) ! true=>do computations on this patch
-
- ! fates only
- logical , pointer :: is_veg (:) ! This is an ACTIVE fates patch
- logical , pointer :: is_bareground (:)
- real(r8), pointer :: wt_ed (:) !TODO mv ? can this be removed
-
-
- logical, pointer :: is_fates (:) ! true for patch vector space reserved
- ! for FATES.
- ! this is static and is true for all
- ! patches within fates jurisdiction
- ! including patches which are not currently
- ! associated with a FATES linked-list patch
-
-
- contains
-
- procedure, public :: Init
- procedure, public :: Clean
-
- end type patch_type
- type(patch_type), public, target :: patch ! patch type data structure
- !------------------------------------------------------------------------
-
-contains
-
- !------------------------------------------------------------------------
- subroutine Init(this, begp, endp)
- !
- ! !ARGUMENTS:
- class(patch_type) :: this
- integer, intent(in) :: begp,endp
- !
- ! LOCAL VARAIBLES:
- !------------------------------------------------------------------------
-
- ! The following is set in InitGridCells
-
- allocate(this%gridcell (begp:endp)); this%gridcell (:) = ispval
- allocate(this%wtgcell (begp:endp)); this%wtgcell (:) = nan
-
- allocate(this%landunit (begp:endp)); this%landunit (:) = ispval
- allocate(this%wtlunit (begp:endp)); this%wtlunit (:) = nan
-
- allocate(this%column (begp:endp)); this%column (:) = ispval
- allocate(this%wtcol (begp:endp)); this%wtcol (:) = nan
-
- allocate(this%mxy (begp:endp)); this%mxy (:) = ispval
- allocate(this%active (begp:endp)); this%active (:) = .false.
-
- ! TODO (MV, 10-17-14): The following must be commented out because
- ! currently the logic checking if patch%itype(p) is not equal to noveg
- ! is used in RootBiogeophysMod in zeng2001_rootfr- a filter is not used
- ! in that routine - which would elimate this problem
-
- allocate(this%itype (begp:endp)); this%itype (:) = ispval
-
- allocate(this%is_fates (begp:endp)); this%is_fates (:) = .false.
-
- if (use_fates) then
- allocate(this%is_veg (begp:endp)); this%is_veg (:) = .false.
- allocate(this%is_bareground (begp:endp)); this%is_bareground (:) = .false.
- allocate(this%wt_ed (begp:endp)); this%wt_ed (:) = nan
- end if
-
- end subroutine Init
-
- !------------------------------------------------------------------------
- subroutine Clean(this)
- !
- ! !ARGUMENTS:
- class(patch_type) :: this
- !------------------------------------------------------------------------
-
- deallocate(this%gridcell)
- deallocate(this%wtgcell )
- deallocate(this%landunit)
- deallocate(this%wtlunit )
- deallocate(this%column )
- deallocate(this%wtcol )
- deallocate(this%itype )
- deallocate(this%mxy )
- deallocate(this%active )
- deallocate(this%is_fates)
-
- if (use_fates) then
- deallocate(this%is_veg)
- deallocate(this%is_bareground)
- deallocate(this%wt_ed)
- end if
-
- end subroutine Clean
-
-end module PatchType
diff --git a/src/main/TopoMod.F90 b/src/main/TopoMod.F90
deleted file mode 100644
index 9841f59b..00000000
--- a/src/main/TopoMod.F90
+++ /dev/null
@@ -1,314 +0,0 @@
-module TopoMod
-
- !-----------------------------------------------------------------------
- ! !DESCRIPTION:
- ! Handles topographic height of each column
- !
- ! !USES:
- 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 PatchType , only : patch
- use ColumnType , only : col
- use LandunitType , only : lun
- use glc2lndMod , only : glc2lnd_type
- use glcBehaviorMod , only : glc_behavior_type
- use landunit_varcon, only : istice_mec
- use filterColMod , only : filter_col_type, col_filter_from_logical_array_active_only
- !
- ! !PUBLIC TYPES:
- implicit none
- save
- private
-
- type, public :: topo_type
- private
-
- ! Public member data
-
- real(r8), pointer, public :: topo_col(:) ! surface elevation (m)
-
- ! Private member data
-
- logical, pointer :: needs_downscaling_col(:) ! whether a column needs to be downscaled
- contains
- procedure, public :: Init
- procedure, public :: Restart
- procedure, public :: Clean
- procedure, public :: UpdateTopo ! Update topographic height each time step
- procedure, public :: DownscaleFilterc ! Returns column-level filter: which columns need downscaling
-
- procedure, private :: InitAllocate
- procedure, private :: InitHistory
- procedure, private :: InitCold
- end type topo_type
-
-contains
-
- !-----------------------------------------------------------------------
- subroutine Init(this, bounds)
- ! !ARGUMENTS:
- class(topo_type), intent(inout) :: this
- type(bounds_type), intent(in) :: bounds
- !
- ! !LOCAL VARIABLES:
-
- character(len=*), parameter :: subname = 'Init'
- !-----------------------------------------------------------------------
-
- call this%InitAllocate(bounds)
- call this%InitHistory(bounds)
- call this%InitCold(bounds)
-
- end subroutine Init
-
- !-----------------------------------------------------------------------
- subroutine InitAllocate(this, bounds)
- ! !ARGUMENTS:
- class(topo_type), intent(inout) :: this
- type(bounds_type), intent(in) :: bounds
- !
- ! !LOCAL VARIABLES:
- integer :: begc, endc
-
- character(len=*), parameter :: subname = 'InitAllocate'
- !-----------------------------------------------------------------------
-
- begc = bounds%begc
- endc = bounds%endc
-
- allocate(this%topo_col(begc:endc))
- this%topo_col(:) = nan
-
- allocate(this%needs_downscaling_col(begc:endc))
- this%needs_downscaling_col(:) = .false.
-
- end subroutine InitAllocate
-
- !-----------------------------------------------------------------------
- subroutine InitHistory(this, bounds)
- ! !USES:
- use histFileMod , only : hist_addfld1d
- !
- ! !ARGUMENTS:
- class(topo_type), intent(inout) :: this
- type(bounds_type), intent(in) :: bounds
- !
- ! !LOCAL VARIABLES:
-
- character(len=*), parameter :: subname = 'InitHistory'
- !-----------------------------------------------------------------------
-
- call hist_addfld1d(fname='TOPO_COL', units='m', &
- avgflag='A', long_name='column-level topographic height', &
- ptr_col=this%topo_col, default='inactive')
-
- end subroutine InitHistory
-
- !-----------------------------------------------------------------------
- subroutine InitCold(this, bounds)
- ! !USES:
- use column_varcon , only: col_itype_to_icemec_class
- use clm_instur, only : topo_glc_mec
- ! !ARGUMENTS:
- class(topo_type), intent(inout) :: this
- type(bounds_type), intent(in) :: bounds
- !
- ! !LOCAL VARIABLES:
- integer :: c, l, g
- integer :: icemec_class ! current icemec class (1..maxpatch_glcmec)
-
- character(len=*), parameter :: subname = 'InitCold'
- !-----------------------------------------------------------------------
-
- do c = bounds%begc, bounds%endc
- l = col%landunit(c)
- g = col%gridcell(c)
-
- if (lun%itype(l) == istice_mec) then
- ! For ice_mec landunits, initialize topo_col based on surface dataset; this
- ! will get overwritten in the run loop by values sent from CISM
- icemec_class = col_itype_to_icemec_class(col%itype(c))
- this%topo_col(c) = topo_glc_mec(g, icemec_class)
- this%needs_downscaling_col(c) = .true.
- else
- ! For other landunits, arbitrarily initialize topo_col to 0 m; for landunits
- ! where this matters, this will get overwritten in the run loop by values sent
- ! from CISM
- this%topo_col(c) = 0._r8
- this%needs_downscaling_col(c) = .false.
- end if
- end do
-
- end subroutine InitCold
-
- !-----------------------------------------------------------------------
- subroutine Restart(this, bounds, ncid, flag)
- ! !USES:
- use ncdio_pio, only : file_desc_t, ncd_double
- use restUtilMod
- !
- ! !ARGUMENTS:
- class(topo_type), intent(inout) :: this
- type(bounds_type), intent(in) :: bounds
- type(file_desc_t), intent(inout) :: ncid ! netcdf id
- character(len=*) , intent(in) :: flag ! 'read', 'write' or 'define'
- !
- ! !LOCAL VARIABLES:
- integer :: p, c
- real(r8), pointer :: rparr(:)
- logical :: readvar
-
- character(len=*), parameter :: subname = 'Restart'
- !-----------------------------------------------------------------------
-
- allocate(rparr(bounds%begp:bounds%endp))
-
- ! TODO(wjs, 2016-04-05) Rename these restart variables to get rid of 'glc' in their
- ! names. However, this will require some changes to init_interp, too.
-
- call restartvar(ncid=ncid, flag=flag, varname='cols1d_topoglc', xtype=ncd_double, &
- dim1name='column', &
- long_name='mean elevation on glacier elevation classes', units='m', &
- interpinic_flag='skip', readvar=readvar, data=this%topo_col)
-
- if (flag /= 'read') then
- do p=bounds%begp,bounds%endp
- c = patch%column(p)
- rparr(p) = this%topo_col(c)
- enddo
- call restartvar(ncid=ncid, flag=flag, varname='pfts1d_topoglc', xtype=ncd_double, &
- dim1name='pft', &
- long_name='mean elevation on glacier elevation classes', units='m', &
- interpinic_flag='skip', readvar=readvar, data=rparr)
- end if
-
- deallocate(rparr)
-
- end subroutine Restart
-
-
- !-----------------------------------------------------------------------
- subroutine UpdateTopo(this, bounds, num_icemecc, filter_icemecc, &
- glc2lnd_inst, glc_behavior, atm_topo)
- !
- ! !DESCRIPTION:
- ! Update topographic heights
- !
- ! Should be called each time step.
- !
- ! Should be called after glc2lndMod:update_glc2lnd_fracs, and before
- ! atm2lndMod:downscale_forcings
- !
- ! !ARGUMENTS:
- class(topo_type) , intent(inout) :: this
- type(bounds_type) , intent(in) :: bounds
- integer , intent(in) :: num_icemecc ! number of points in filter_icemecc
- integer , intent(in) :: filter_icemecc(:) ! col filter for ice_mec
- type(glc2lnd_type) , intent(in) :: glc2lnd_inst
- type(glc_behavior_type) , intent(in) :: glc_behavior
- real(r8) , intent(in) :: atm_topo( bounds%begg: ) ! atmosphere topographic height [m]
- !
- ! !LOCAL VARIABLES:
- integer :: begc, endc
- integer :: c, g
-
- character(len=*), parameter :: subname = 'UpdateTopo'
- !-----------------------------------------------------------------------
-
- begc = bounds%begc
- endc = bounds%endc
-
- ! Reset needs_downscaling_col each time step, because this is potentially
- ! time-varying for some columns. It's simplest just to reset it everywhere, rather
- ! than trying to figure out where it does and does not need to be reset.
- this%needs_downscaling_col(begc:endc) = .false.
-
- call glc_behavior%icemec_cols_need_downscaling(bounds, num_icemecc, filter_icemecc, &
- this%needs_downscaling_col(begc:endc))
-
- ! In addition to updating topo_col, this also sets some additional elements of
- ! needs_downscaling_col to .true. (but leaves the already-.true. values as is.)
- call glc2lnd_inst%update_glc2lnd_topo(bounds, &
- this%topo_col(begc:endc), &
- this%needs_downscaling_col(begc:endc))
-
- ! For any point that isn't downscaled, set its topo value to the atmosphere's
- ! topographic height. This shouldn't matter, but is useful if topo_col is written to
- ! the history file.
- !
- ! This could operate over a filter like 'allc' in order to just operate over active
- ! points, but I'm not sure that would speed things up much, and would require passing
- ! in this additional filter.
- do c = bounds%begc, bounds%endc
- if (.not. this%needs_downscaling_col(c)) then
- g = col%gridcell(c)
- this%topo_col(c) = atm_topo(g)
- end if
- end do
-
- call glc_behavior%update_glc_classes(bounds, this%topo_col(begc:endc))
-
- end subroutine UpdateTopo
-
- !-----------------------------------------------------------------------
- function DownscaleFilterc(this, bounds) result(filter)
- !
- ! !DESCRIPTION:
- ! Returns a column-level filter: which columns need downscaling.
- !
- ! This filter only contains active points.
- !
- ! The main reason it's important to have this filter (as opposed to just doing the
- ! downscaling for all columns) is because of downscaled fields that are normalized
- ! (like longwave radiation): Consider a gridcell with a glc_mec column and a
- ! vegetated column (outside of the icemask, so the vegetated column doesn't have its
- ! topographic height explicitly set). If we called the downscaling code for all
- ! columns, the longwave radiation would get adjusted over the vegetated column. This
- ! is undesirable, because it means that adding a downscaled column in a gridcell can
- ! change answers for all other columns in that gridcell.
- !
- ! !USES:
- !
- ! !ARGUMENTS:
- type(filter_col_type) :: filter ! function result
- class(topo_type), intent(in) :: this
- type(bounds_type), intent(in) :: bounds
- !
- ! !LOCAL VARIABLES:
-
- character(len=*), parameter :: subname = 'DownscaleFilterc'
- !-----------------------------------------------------------------------
-
- ! Currently this creates the filter on the fly, recreating it every time this function
- ! is called. In principle, we should be able to compute and save this filter when
- ! UpdateTopo is called, returning the already-computed filter when this function is
- ! called. However, the problem with that is the need to have a different filter for
- ! each clump (and potentially another filter for calls from outside a clump
- ! loop). This will become easier to handle if we rework CLM's threading so that there
- ! is a separate instance of each object for each clump: in that case, we'll have
- ! multiple instances of topo_type, each corresponding to one clump, each with its own
- ! filter.
-
- filter = col_filter_from_logical_array_active_only(bounds, &
- this%needs_downscaling_col(bounds%begc:bounds%endc))
-
- end function DownscaleFilterc
-
-
- !-----------------------------------------------------------------------
- subroutine Clean(this)
- ! !ARGUMENTS:
- class(topo_type), intent(inout) :: this
- !
- ! !LOCAL VARIABLES:
-
- character(len=*), parameter :: subname = 'Clean'
- !-----------------------------------------------------------------------
-
- deallocate(this%topo_col)
- deallocate(this%needs_downscaling_col)
-
- end subroutine Clean
-
-end module TopoMod
diff --git a/src/main/abortutils.F90 b/src/main/abortutils.F90
index cd91e53a..c6e8309d 100644
--- a/src/main/abortutils.F90
+++ b/src/main/abortutils.F90
@@ -62,7 +62,7 @@ subroutine endrun_globalindex(decomp_index, clmlevel, msg)
character(len=*) , intent(in), optional :: msg ! string to be printed
!
! Local Variables:
- integer :: igrc, ilun, icol
+ integer :: igrc
!-----------------------------------------------------------------------
write(6,*)'calling getglobalwrite with decomp_index= ',decomp_index,' and clmlevel= ',trim(clmlevel)
diff --git a/src/main/accumulMod.F90 b/src/main/accumulMod.F90
index 29a52ceb..a8925fee 100644
--- a/src/main/accumulMod.F90
+++ b/src/main/accumulMod.F90
@@ -26,9 +26,6 @@ module accumulMod
use abortutils , only: endrun
use clm_varctl , only: iulog, nsrest, nsrStartup
use clm_varcon , only: spval, ispval
- use PatchType , only : patch
- use ColumnType , only : col
- use LandunitType, only : lun
use GridcellType, only : grc
!
! !PUBLIC TYPES:
@@ -160,7 +157,7 @@ subroutine init_accum_field (name, units, desc, &
character(len=*), intent(in) :: desc !field description
character(len=*), intent(in) :: accum_type !field type: timeavg, runmean, runaccum
integer , intent(in) :: accum_period !field accumulation period
- character(len=*), intent(in) :: subgrid_type !["gridcell","landunit","column" or "patch"]
+ character(len=*), intent(in) :: subgrid_type !["gridcell"]
integer , intent(in) :: numlev !number of vertical levels
real(r8), intent(in) :: init_value !field initial or reset value
character(len=*), intent(in), optional :: type2d !level type (optional) - needed if numlev > 1
@@ -168,17 +165,12 @@ subroutine init_accum_field (name, units, desc, &
! !LOCAL VARIABLES:
integer :: nf ! field index
integer :: beg1d,end1d ! beggining and end subgrid indices
- integer :: begp, endp ! per-proc beginning and ending patch indices
- integer :: begc, endc ! per-proc beginning and ending column indices
- integer :: begl, endl ! per-proc beginning and ending landunit indices
integer :: begg, endg ! per-proc gridcell ending gridcell indices
- integer :: begCohort, endCohort ! per-proc beg end cohort indices
!------------------------------------------------------------------------
! Determine necessary indices
- call get_proc_bounds(begg, endg, begl, endl, begc, endc, begp, endp, &
- begCohort, endCohort )
+ call get_proc_bounds(begg, endg)
! update field index
! Consistency check that number of accumulated does not exceed maximum.
@@ -226,18 +218,6 @@ subroutine init_accum_field (name, units, desc, &
beg1d = begg
end1d = endg
accum(nf)%active => grc%active
- case ('landunit')
- beg1d = begl
- end1d = endl
- accum(nf)%active => lun%active
- case ('column')
- beg1d = begc
- end1d = endc
- accum(nf)%active => col%active
- case ('pft')
- beg1d = begp
- end1d = endp
- accum(nf)%active => patch%active
case default
write(iulog,*)'init_accum_field: unknown subgrid type ',subgrid_type
call shr_sys_abort ()
diff --git a/src/main/atm2lndMod.F90 b/src/main/atm2lndMod.F90
deleted file mode 100644
index bfa868b2..00000000
--- a/src/main/atm2lndMod.F90
+++ /dev/null
@@ -1,682 +0,0 @@
-module atm2lndMod
-
-#include "shr_assert.h"
-
- !-----------------------------------------------------------------------
- ! !DESCRIPTION:
- ! Handle atm2lnd forcing
- !
- ! !USES:
- use shr_kind_mod , only : r8 => shr_kind_r8
- use shr_infnan_mod , only : nan => shr_infnan_nan, assignment(=)
- use shr_log_mod , only : errMsg => shr_log_errMsg
- use clm_varpar , only : numrad, ndst, nlevgrnd !ndst = number of dust bins.
- use clm_varcon , only : rair, grav, cpair, hfus, tfrz, denh2o, spval
- use clm_varcon , only : wv_to_dair_weight_ratio
- use clm_varctl , only : iulog, use_cn, iulog
- use abortutils , only : endrun
- use decompMod , only : bounds_type
- use atm2lndType , only : atm2lnd_type
- use TopoMod , only : topo_type
- use filterColMod , only : filter_col_type
- use LandunitType , only : lun
- use ColumnType , only : col
- use landunit_varcon, only : istice_mec
- !
- ! !PUBLIC TYPES:
- implicit none
- private
- save
- !
- ! !PUBLIC MEMBER FUNCTIONS:
- public :: downscale_forcings ! Downscale atm forcing fields from gridcell to column
-
- ! The following routines are public for the sake of unit testing; they should not be
- ! called by production code outside this module
- public :: partition_precip ! Partition precipitation into rain/snow
- public :: sens_heat_from_precip_conversion ! Compute sensible heat flux needed to compensate for rain-snow conversion
- !
- ! !PRIVATE MEMBER FUNCTIONS:
- private :: rhos ! calculate atmospheric density
- private :: repartition_rain_snow_one_col ! Re-partition precipitation for a single column
- private :: downscale_longwave ! Downscale longwave radiation from gridcell to column
- private :: build_normalization ! Compute normalization factors so that downscaled fields are conservative
- private :: check_downscale_consistency ! Check consistency of downscaling
-
- character(len=*), parameter, private :: sourcefile = &
- __FILE__
- !-----------------------------------------------------------------------
-
-contains
-
- !-----------------------------------------------------------------------
- subroutine downscale_forcings(bounds, &
- topo_inst, atm2lnd_inst, eflx_sh_precip_conversion)
- !
- ! !DESCRIPTION:
- ! Downscale atmospheric forcing fields from gridcell to column.
- !
- ! Downscaling is done based on the difference between each CLM column's elevation and
- ! the atmosphere's surface elevation (which is the elevation at which the atmospheric
- ! forcings are valid).
- !
- ! Note that the downscaling procedure can result in changes in grid cell mean values
- ! compared to what was provided by the atmosphere. We conserve fluxes of mass and
- ! energy, but allow states such as temperature to differ.
- !
- ! For most variables, downscaling is done over columns defined by
- ! topo_inst%DownscaleFilterc. But we also do direct copies of gridcell-level forcings
- ! into column-level forcings over all other active columns. In addition, precipitation
- ! (rain vs. snow partitioning) is adjusted everywhere.
- !
- ! !USES:
- use clm_varcon , only : rair, cpair, grav
- use QsatMod , only : Qsat
- !
- ! !ARGUMENTS:
- type(bounds_type) , intent(in) :: bounds
- class(topo_type) , intent(in) :: topo_inst
- type(atm2lnd_type) , intent(inout) :: atm2lnd_inst
- real(r8) , intent(out) :: eflx_sh_precip_conversion(bounds%begc:) ! sensible heat flux from precipitation conversion (W/m**2) [+ to atm]
- !
- ! !LOCAL VARIABLES:
- integer :: g, l, c, fc ! indices
- integer :: clo, cc
- type(filter_col_type) :: downscale_filter_c
-
- ! temporaries for topo downscaling
- real(r8) :: hsurf_g,hsurf_c
- real(r8) :: Hbot, zbot
- real(r8) :: tbot_g, pbot_g, thbot_g, qbot_g, qs_g, es_g, rhos_g
- real(r8) :: tbot_c, pbot_c, thbot_c, qbot_c, qs_c, es_c, rhos_c
- real(r8) :: rhos_c_estimate, rhos_g_estimate
- real(r8) :: dum1, dum2
-
- character(len=*), parameter :: subname = 'downscale_forcings'
- !-----------------------------------------------------------------------
-
- SHR_ASSERT_ALL((ubound(eflx_sh_precip_conversion) == (/bounds%endc/)), errMsg(sourcefile, __LINE__))
-
- associate(&
- ! Parameters:
- lapse_rate => atm2lnd_inst%params%lapse_rate , & ! Input: [real(r8)] Surface temperature lapse rate (K m-1)
-
- ! Gridcell-level metadata:
- forc_topo_g => atm2lnd_inst%forc_topo_grc , & ! Input: [real(r8) (:)] atmospheric surface height (m)
-
- ! Column-level metadata:
- topo_c => topo_inst%topo_col , & ! Input: [real(r8) (:)] column surface height (m)
-
- ! Gridcell-level non-downscaled fields:
- forc_t_g => atm2lnd_inst%forc_t_not_downscaled_grc , & ! Input: [real(r8) (:)] atmospheric temperature (Kelvin)
- forc_th_g => atm2lnd_inst%forc_th_not_downscaled_grc , & ! Input: [real(r8) (:)] atmospheric potential temperature (Kelvin)
- forc_q_g => atm2lnd_inst%forc_q_not_downscaled_grc , & ! Input: [real(r8) (:)] atmospheric specific humidity (kg/kg)
- forc_pbot_g => atm2lnd_inst%forc_pbot_not_downscaled_grc , & ! Input: [real(r8) (:)] atmospheric pressure (Pa)
- forc_rho_g => atm2lnd_inst%forc_rho_not_downscaled_grc , & ! Input: [real(r8) (:)] atmospheric density (kg/m**3)
-
- ! Column-level downscaled fields:
- forc_t_c => atm2lnd_inst%forc_t_downscaled_col , & ! Output: [real(r8) (:)] atmospheric temperature (Kelvin)
- forc_th_c => atm2lnd_inst%forc_th_downscaled_col , & ! Output: [real(r8) (:)] atmospheric potential temperature (Kelvin)
- forc_q_c => atm2lnd_inst%forc_q_downscaled_col , & ! Output: [real(r8) (:)] atmospheric specific humidity (kg/kg)
- forc_pbot_c => atm2lnd_inst%forc_pbot_downscaled_col , & ! Output: [real(r8) (:)] atmospheric pressure (Pa)
- forc_rho_c => atm2lnd_inst%forc_rho_downscaled_col & ! Output: [real(r8) (:)] atmospheric density (kg/m**3)
- )
-
- ! Initialize column forcing (needs to be done for ALL active columns)
- do c = bounds%begc,bounds%endc
- if (col%active(c)) then
- g = col%gridcell(c)
-
- forc_t_c(c) = forc_t_g(g)
- forc_th_c(c) = forc_th_g(g)
- forc_q_c(c) = forc_q_g(g)
- forc_pbot_c(c) = forc_pbot_g(g)
- forc_rho_c(c) = forc_rho_g(g)
- end if
- end do
-
- downscale_filter_c = topo_inst%DownscaleFilterc(bounds)
-
- ! Downscale forc_t, forc_th, forc_q, forc_pbot, and forc_rho to columns.
- ! For glacier_mec columns the downscaling is based on surface elevation.
- ! For other columns the downscaling is a simple copy (above).
- do fc = 1, downscale_filter_c%num
- c = downscale_filter_c%indices(fc)
- l = col%landunit(c)
- g = col%gridcell(c)
-
- ! This is a simple downscaling procedure
- ! Note that forc_hgt, forc_u, and forc_v are not downscaled.
-
- hsurf_g = forc_topo_g(g) ! gridcell sfc elevation
- hsurf_c = topo_c(c) ! column sfc elevation
- tbot_g = forc_t_g(g) ! atm sfc temp
- thbot_g = forc_th_g(g) ! atm sfc pot temp
- qbot_g = forc_q_g(g) ! atm sfc spec humid
- pbot_g = forc_pbot_g(g) ! atm sfc pressure
- rhos_g = forc_rho_g(g) ! atm density
- zbot = atm2lnd_inst%forc_hgt_grc(g) ! atm ref height
- tbot_c = tbot_g-lapse_rate*(hsurf_c-hsurf_g) ! sfc temp for column
- Hbot = rair*0.5_r8*(tbot_g+tbot_c)/grav ! scale ht at avg temp
- pbot_c = pbot_g*exp(-(hsurf_c-hsurf_g)/Hbot) ! column sfc press
-
- ! Derivation of potential temperature calculation:
- !
- ! The textbook definition would be:
- ! thbot_c = tbot_c * (p0/pbot_c)^(rair/cpair)
- !
- ! Note that pressure is related to scale height as:
- ! pbot_c = p0 * exp(-zbot/H)
- !
- ! Using Hbot in place of H, we get:
- ! pbot_c = p0 * exp(-zbot/Hbot)
- !
- ! Plugging this in to the textbook definition, then manipulating, we get:
- ! thbot_c = tbot_c * (p0/(p0*exp(-zbot/Hbot)))^(rair/cpair)
- ! = tbot_c * (1/exp(-zbot/Hbot))^(rair/cpair)
- ! = tbot_c * (exp(zbot/Hbot))^(rair/cpair)
- ! = tbot_c * exp((zbot/Hbot) * (rair/cpair))
- !
- ! But we want everything expressed in delta form, resulting in:
- ! thbot_c = thbot_g + (tbot_c - tbot_g)*exp((zbot/Hbot)*(rair/cpair))
-
- thbot_c= thbot_g + (tbot_c - tbot_g)*exp((zbot/Hbot)*(rair/cpair)) ! pot temp calc
-
- call Qsat(tbot_g,pbot_g,es_g,dum1,qs_g,dum2)
- call Qsat(tbot_c,pbot_c,es_c,dum1,qs_c,dum2)
-
- qbot_c = qbot_g*(qs_c/qs_g)
-
- ! For forc_rho_c: We could simply set:
- !
- ! rhos_c = rhos(pbot_c, egcm_c, tbot_c)
- !
- ! However, we want forc_rho_c to be identical to forc_rho_g when topo_c equals
- ! forc_topo_g. So we compute our own version of forc_rho_g using the rhos
- ! function, and then multiply forc_rho_g by the ratio of (computed column-level
- ! rho) to (computed gridcell-level rho).
- rhos_c_estimate = rhos(qbot=qbot_c, pbot=pbot_c, tbot=tbot_c)
- rhos_g_estimate = rhos(qbot=qbot_g, pbot=pbot_g, tbot=tbot_g)
- rhos_c = rhos_g * (rhos_c_estimate / rhos_g_estimate)
-
- forc_t_c(c) = tbot_c
- forc_th_c(c) = thbot_c
- forc_q_c(c) = qbot_c
- forc_pbot_c(c) = pbot_c
- forc_rho_c(c) = rhos_c
-
- end do
-
- call partition_precip(bounds, atm2lnd_inst, &
- eflx_sh_precip_conversion(bounds%begc:bounds%endc))
-
- call downscale_longwave(bounds, downscale_filter_c, topo_inst, atm2lnd_inst)
-
- call check_downscale_consistency(bounds, atm2lnd_inst)
-
- end associate
-
- end subroutine downscale_forcings
-
- !-----------------------------------------------------------------------
- pure function rhos(qbot, pbot, tbot)
- !
- ! !DESCRIPTION:
- ! Compute atmospheric density (kg/m**3)
- !
- ! !USES:
- !
- ! !ARGUMENTS:
- real(r8) :: rhos ! function result: atmospheric density (kg/m**3)
- real(r8), intent(in) :: qbot ! atmospheric specific humidity (kg/kg)
- real(r8), intent(in) :: pbot ! atmospheric pressure (Pa)
- real(r8), intent(in) :: tbot ! atmospheric temperature (K)
- !
- ! !LOCAL VARIABLES:
- real(r8) :: egcm
-
- character(len=*), parameter :: subname = 'rhos'
- !-----------------------------------------------------------------------
-
- egcm = qbot*pbot / &
- (wv_to_dair_weight_ratio + (1._r8 - wv_to_dair_weight_ratio)*qbot)
- rhos = (pbot - (1._r8 - wv_to_dair_weight_ratio)*egcm) / (rair*tbot)
-
- end function rhos
-
- !-----------------------------------------------------------------------
- subroutine partition_precip(bounds, atm2lnd_inst, eflx_sh_precip_conversion)
- !
- ! !DESCRIPTION:
- ! Partition precipitation into rain/snow based on temperature.
- !
- ! Note that, unlike the other downscalings done here, this is currently applied over
- ! all points - not just those within the downscale filter.
- !
- ! !ARGUMENTS:
- type(bounds_type) , intent(in) :: bounds
- type(atm2lnd_type) , intent(inout) :: atm2lnd_inst
- real(r8), intent(inout) :: eflx_sh_precip_conversion(bounds%begc:) ! sensible heat flux from precipitation conversion (W/m**2) [+ to atm]
- !
- ! !LOCAL VARIABLES:
- integer :: c,l,g ! indices
- real(r8) :: rain_old ! rain before conversion
- real(r8) :: snow_old ! snow before conversion
- real(r8) :: all_snow_t ! temperature at which all precip falls as snow (K)
- real(r8) :: frac_rain_slope ! slope of the frac_rain vs. temperature relationship
-
- character(len=*), parameter :: subname = 'partition_precip'
- !-----------------------------------------------------------------------
-
- SHR_ASSERT_ALL((ubound(eflx_sh_precip_conversion) == (/bounds%endc/)), errMsg(sourcefile, __LINE__))
-
- associate(&
- ! Gridcell-level non-downscaled fields:
- forc_rain_g => atm2lnd_inst%forc_rain_not_downscaled_grc , & ! Input: [real(r8) (:)] rain rate [mm/s]
- forc_snow_g => atm2lnd_inst%forc_snow_not_downscaled_grc , & ! Input: [real(r8) (:)] snow rate [mm/s]
-
- ! Column-level downscaled fields:
- forc_t_c => atm2lnd_inst%forc_t_downscaled_col , & ! Input: [real(r8) (:)] atmospheric temperature (Kelvin)
- forc_rain_c => atm2lnd_inst%forc_rain_downscaled_col , & ! Output: [real(r8) (:)] rain rate [mm/s]
- forc_snow_c => atm2lnd_inst%forc_snow_downscaled_col & ! Output: [real(r8) (:)] snow rate [mm/s]
- )
-
- ! Initialize column forcing
- do c = bounds%begc,bounds%endc
- if (col%active(c)) then
- g = col%gridcell(c)
- forc_rain_c(c) = forc_rain_g(g)
- forc_snow_c(c) = forc_snow_g(g)
- eflx_sh_precip_conversion(c) = 0._r8
- end if
- end do
-
- ! Optionally, convert rain to snow or vice versa based on forc_t_c
- if (atm2lnd_inst%params%repartition_rain_snow) then
- do c = bounds%begc, bounds%endc
- if (col%active(c)) then
- l = col%landunit(c)
- rain_old = forc_rain_c(c)
- snow_old = forc_snow_c(c)
- if (lun%itype(l) == istice_mec) then
- all_snow_t = atm2lnd_inst%params%precip_repartition_glc_all_snow_t
- frac_rain_slope = atm2lnd_inst%params%precip_repartition_glc_frac_rain_slope
- else
- all_snow_t = atm2lnd_inst%params%precip_repartition_nonglc_all_snow_t
- frac_rain_slope = atm2lnd_inst%params%precip_repartition_nonglc_frac_rain_slope
- end if
- call repartition_rain_snow_one_col(&
- temperature = forc_t_c(c), &
- all_snow_t = all_snow_t, &
- frac_rain_slope = frac_rain_slope, &
- rain = forc_rain_c(c), &
- snow = forc_snow_c(c))
- call sens_heat_from_precip_conversion(&
- rain_old = rain_old, &
- snow_old = snow_old, &
- rain_new = forc_rain_c(c), &
- snow_new = forc_snow_c(c), &
- sens_heat_flux = eflx_sh_precip_conversion(c))
- end if
- end do
- end if
-
- end associate
-
- end subroutine partition_precip
-
- !-----------------------------------------------------------------------
- subroutine repartition_rain_snow_one_col(temperature, all_snow_t, frac_rain_slope, &
- rain, snow)
- !
- ! !DESCRIPTION:
- ! Re-partition precipitation into rain/snow for a single column.
- !
- ! Rain and snow variables should be set initially, and are updated here
- !
- ! !ARGUMENTS:
- real(r8) , intent(in) :: temperature ! near-surface temperature (K)
- real(r8) , intent(in) :: all_snow_t ! temperature at which precip falls entirely as snow (K)
- real(r8) , intent(in) :: frac_rain_slope ! slope of the frac_rain vs. T relationship
- real(r8) , intent(inout) :: rain ! atm rain rate [mm/s]
- real(r8) , intent(inout) :: snow ! atm snow rate [(mm water equivalent)/s]
- !
- ! !LOCAL VARIABLES:
- real(r8) :: frac_rain ! fraction of precipitation that should become rain
- real(r8) :: total_precip
-
- character(len=*), parameter :: subname = 'repartition_rain_snow_one_col'
- !-----------------------------------------------------------------------
-
- frac_rain = (temperature - all_snow_t) * frac_rain_slope
-
- ! bound in [0,1]
- frac_rain = min(1.0_r8,max(0.0_r8,frac_rain))
-
- total_precip = rain + snow
- rain = total_precip * frac_rain
- snow = total_precip - rain
-
- end subroutine repartition_rain_snow_one_col
-
- !-----------------------------------------------------------------------
- subroutine sens_heat_from_precip_conversion(rain_old, snow_old, rain_new, snow_new, &
- sens_heat_flux)
- !
- ! !DESCRIPTION:
- ! Given old and new rain and snow amounts, compute the sensible heat flux needed to
- ! compensate for the rain-snow conversion.
- !
- ! !USES:
- !
- ! !ARGUMENTS:
- real(r8), intent(in) :: rain_old ! [mm/s]
- real(r8), intent(in) :: snow_old ! [(mm water equivalent)/s]
- real(r8), intent(in) :: rain_new ! [mm/s]
- real(r8), intent(in) :: snow_new ! [(mm water equivalent)/s]
- real(r8), intent(out) :: sens_heat_flux ! [W/m^2]
- !
- ! !LOCAL VARIABLES:
- real(r8) :: total_old
- real(r8) :: total_new
- real(r8) :: rain_to_snow ! net conversion of rain to snow
-
- real(r8), parameter :: mm_to_m = 1.e-3_r8 ! multiply by this to convert from mm to m
- real(r8), parameter :: tol = 1.e-13_r8 ! relative tolerance for error checks
-
- character(len=*), parameter :: subname = 'sens_heat_from_precip_conversion'
- !-----------------------------------------------------------------------
-
- total_old = rain_old + snow_old
- total_new = rain_new + snow_new
- SHR_ASSERT(abs(total_new - total_old) <= (tol * total_old), subname//' ERROR: mismatch between old and new totals')
-
- ! rain to snow releases energy, so results in a positive heat flux to atm
- rain_to_snow = snow_new - snow_old
- sens_heat_flux = rain_to_snow * mm_to_m * denh2o * hfus
-
- end subroutine sens_heat_from_precip_conversion
-
-
- !-----------------------------------------------------------------------
- subroutine downscale_longwave(bounds, downscale_filter_c, &
- topo_inst, atm2lnd_inst)
- !
- ! !DESCRIPTION:
- ! Downscale longwave radiation from gridcell to column
- ! Must be done AFTER temperature downscaling
- !
- ! !ARGUMENTS:
- type(bounds_type) , intent(in) :: bounds
- type(filter_col_type) , intent(in) :: downscale_filter_c
- class(topo_type) , intent(in) :: topo_inst
- type(atm2lnd_type) , intent(inout) :: atm2lnd_inst
- !
- ! !LOCAL VARIABLES:
- integer :: c,l,g,fc ! indices
- real(r8) :: hsurf_c ! column-level elevation (m)
- real(r8) :: hsurf_g ! gridcell-level elevation (m)
-
- real(r8), dimension(bounds%begg : bounds%endg) :: sum_lwrad_g ! weighted sum of column-level lwrad
- real(r8), dimension(bounds%begg : bounds%endg) :: sum_wts_g ! sum of weights that contribute to sum_lwrad_g
- real(r8), dimension(bounds%begg : bounds%endg) :: lwrad_norm_g ! normalization factors
- real(r8), dimension(bounds%begg : bounds%endg) :: newsum_lwrad_g ! weighted sum of column-level lwrad after normalization
-
- character(len=*), parameter :: subname = 'downscale_longwave'
- !-----------------------------------------------------------------------
-
- associate(&
- ! Parameters:
- lapse_rate_longwave => atm2lnd_inst%params%lapse_rate_longwave , & ! Input: [real(r8)] longwave radiation lapse rate (W m-2 m-1)
- longwave_downscaling_limit => atm2lnd_inst%params%longwave_downscaling_limit, & ! Input: [real(r8)] Relative limit for how much longwave downscaling can be done (unitless)
-
- ! Gridcell-level metadata:
- forc_topo_g => atm2lnd_inst%forc_topo_grc , & ! Input: [real(r8) (:)] atmospheric surface height (m)
-
- ! Column-level metadata:
- topo_c => topo_inst%topo_col , & ! Input: [real(r8) (:)] column surface height (m)
-
- ! Gridcell-level fields:
- forc_lwrad_g => atm2lnd_inst%forc_lwrad_not_downscaled_grc, & ! Input: [real(r8) (:)] downward longwave (W/m**2)
-
- ! Column-level (downscaled) fields:
- forc_lwrad_c => atm2lnd_inst%forc_lwrad_downscaled_col & ! Output: [real(r8) (:)] downward longwave (W/m**2)
- )
-
- ! Initialize column forcing (needs to be done for ALL active columns)
- do c = bounds%begc, bounds%endc
- if (col%active(c)) then
- g = col%gridcell(c)
- forc_lwrad_c(c) = forc_lwrad_g(g)
- end if
- end do
-
- ! Optionally, downscale the longwave radiation, conserving energy
- if (atm2lnd_inst%params%glcmec_downscale_longwave) then
-
- ! Initialize variables related to normalization
- do g = bounds%begg, bounds%endg
- sum_lwrad_g(g) = 0._r8
- sum_wts_g(g) = 0._r8
- newsum_lwrad_g(g) = 0._r8
- end do
-
- ! Do the downscaling
- do fc = 1, downscale_filter_c%num
- c = downscale_filter_c%indices(fc)
- l = col%landunit(c)
- g = col%gridcell(c)
-
- hsurf_g = forc_topo_g(g)
- hsurf_c = topo_c(c)
-
- ! Assume a linear decrease in downwelling longwave radiation with increasing
- ! elevation, based on Van Tricht et al. (2016, TC) Figure 6,
- ! doi:10.5194/tc-10-2379-2016
- forc_lwrad_c(c) = forc_lwrad_g(g) - lapse_rate_longwave * (hsurf_c-hsurf_g)
- ! But ensure that we don't depart too far from the atmospheric forcing value:
- ! negative values of lwrad are certainly bad, but small positive values might
- ! also be bad. We can especially run into trouble due to the normalization: a
- ! small lwrad value in one column can lead to a big normalization factor,
- ! leading to huge lwrad values in other columns.
- forc_lwrad_c(c) = min(forc_lwrad_c(c), &
- forc_lwrad_g(g) * (1._r8 + longwave_downscaling_limit))
- forc_lwrad_c(c) = max(forc_lwrad_c(c), &
- forc_lwrad_g(g) * (1._r8 - longwave_downscaling_limit))
-
- ! Keep track of the gridcell-level weighted sum for later normalization.
- !
- ! This gridcell-level weighted sum just includes points for which we do the
- ! downscaling (e.g., glc_mec points). Thus the contributing weights
- ! generally do not add to 1. So to do the normalization properly, we also
- ! need to keep track of the weights that have contributed to this sum.
- sum_lwrad_g(g) = sum_lwrad_g(g) + col%wtgcell(c)*forc_lwrad_c(c)
- sum_wts_g(g) = sum_wts_g(g) + col%wtgcell(c)
- end do
-
-
- ! Normalize forc_lwrad_c(c) to conserve energy
-
- call build_normalization(orig_field=forc_lwrad_g(bounds%begg:bounds%endg), &
- sum_field=sum_lwrad_g(bounds%begg:bounds%endg), &
- sum_wts=sum_wts_g(bounds%begg:bounds%endg), &
- norms=lwrad_norm_g(bounds%begg:bounds%endg))
-
- do fc = 1, downscale_filter_c%num
- c = downscale_filter_c%indices(fc)
- l = col%landunit(c)
- g = col%gridcell(c)
-
- forc_lwrad_c(c) = forc_lwrad_c(c) * lwrad_norm_g(g)
- newsum_lwrad_g(g) = newsum_lwrad_g(g) + col%wtgcell(c)*forc_lwrad_c(c)
- end do
-
-
- ! Make sure that, after normalization, the grid cell mean is conserved
-
- do g = bounds%begg, bounds%endg
- if (sum_wts_g(g) > 0._r8) then
- if (abs((newsum_lwrad_g(g) / sum_wts_g(g)) - forc_lwrad_g(g)) > 1.e-8_r8) then
- write(iulog,*) 'g, newsum_lwrad_g, sum_wts_g, forc_lwrad_g: ', &
- g, newsum_lwrad_g(g), sum_wts_g(g), forc_lwrad_g(g)
- call endrun(msg=' ERROR: Energy conservation error downscaling longwave'//&
- errMsg(sourcefile, __LINE__))
- end if
- end if
- end do
-
- end if ! glcmec_downscale_longwave
-
- end associate
-
- end subroutine downscale_longwave
-
- !-----------------------------------------------------------------------
- subroutine build_normalization(orig_field, sum_field, sum_wts, norms)
- !
- ! !DESCRIPTION:
- ! Build an array of normalization factors that can be applied to a downscaled forcing
- ! field, in order to force the mean of the new field to be the same as the mean of
- ! the old field (for conservation).
- !
- ! This allows for the possibility that only a subset of columns are downscaled. Only
- ! the columns that are adjusted should be included in the weighted sum, sum_field;
- ! sum_wts gives the sum of contributing weights on the grid cell level.
-
- ! For example, if a grid cell has an original forcing value of 1.0, and contains 4
- ! columns with the following weights on the gridcell, and the following values after
- ! normalization:
- !
- ! col #: 1 2 3 4
- ! weight: 0.1 0.2 0.3 0.4
- ! downscaled?: yes yes no no
- ! value: 0.9 1.1 1.0 1.0
- !
- ! Then we would have:
- ! orig_field(g) = 1.0
- ! sum_field(g) = 0.1*0.9 + 0.2*1.1 = 0.31
- ! sum_wts(g) = 0.1 + 0.2 = 0.3
- ! norms(g) = 1.0 / (0.31 / 0.3) = 0.9677
- !
- ! The field can then be normalized as:
- ! forc_lwrad_c(c) = forc_lwrad_c(c) * lwrad_norm_g(g)
- ! where lwrad_norm_g is the array of norms computed by this routine
-
- !
- ! !ARGUMENTS:
- real(r8), intent(in) :: orig_field(:) ! the original field, at the grid cell level
- real(r8), intent(in) :: sum_field(:) ! the new weighted sum across columns (dimensioned by grid cell)
- real(r8), intent(in) :: sum_wts(:) ! sum of the weights used to create sum_field (dimensioned by grid cell)
- real(r8), intent(out) :: norms(:) ! computed normalization factors
- !-----------------------------------------------------------------------
-
- SHR_ASSERT((size(orig_field) == size(norms)), errMsg(sourcefile, __LINE__))
- SHR_ASSERT((size(sum_field) == size(norms)), errMsg(sourcefile, __LINE__))
- SHR_ASSERT((size(sum_wts) == size(norms)), errMsg(sourcefile, __LINE__))
-
- where (sum_wts == 0._r8)
- ! Avoid divide by zero; if sum_wts is 0, then the normalization doesn't matter,
- ! because the adjusted values won't affect the grid cell mean.
- norms = 1.0_r8
-
- elsewhere (sum_field == 0._r8)
- ! Avoid divide by zero. If this is because both sum_field and orig_field are 0,
- ! then the normalization doesn't matter. If sum_field == 0 while orig_field /= 0,
- ! then we have a problem: no normalization will allow us to recover the original
- ! gridcell mean. We should probably catch this and abort, but for now we're
- ! relying on error checking in the caller (checking for conservation) to catch
- ! this potential problem.
- norms = 1.0_r8
-
- elsewhere
- ! The standard case
- norms = orig_field / (sum_field / sum_wts)
-
- end where
-
- end subroutine build_normalization
-
-
- !-----------------------------------------------------------------------
- subroutine check_downscale_consistency(bounds, atm2lnd_inst)
- !
- ! !DESCRIPTION:
- ! Check consistency of downscaling
- !
- ! Note that this operates over more than just the filter used for the downscaling,
- ! because it checks some things outside that filter.
- !
- ! !ARGUMENTS:
- implicit none
- type(bounds_type) , intent(in) :: bounds
- type(atm2lnd_type), intent(in) :: atm2lnd_inst
- !
- ! !LOCAL VARIABLES:
- integer :: g, l, c ! indices
- character(len=*), parameter :: subname = 'check_downscale_consistency'
- !-----------------------------------------------------------------------
-
- associate(&
- ! Gridcell-level fields:
- forc_t_g => atm2lnd_inst%forc_t_not_downscaled_grc , & ! Input: [real(r8) (:)] atmospheric temperature (Kelvin)
- forc_th_g => atm2lnd_inst%forc_th_not_downscaled_grc , & ! Input: [real(r8) (:)] atmospheric potential temperature (Kelvin)
- forc_q_g => atm2lnd_inst%forc_q_not_downscaled_grc , & ! Input: [real(r8) (:)] atmospheric specific humidity (kg/kg)
- forc_pbot_g => atm2lnd_inst%forc_pbot_not_downscaled_grc , & ! Input: [real(r8) (:)] atmospheric pressure (Pa)
- forc_rho_g => atm2lnd_inst%forc_rho_not_downscaled_grc , & ! Input: [real(r8) (:)] atmospheric density (kg/m**3)
- forc_rain_g => atm2lnd_inst%forc_rain_not_downscaled_grc , & ! Input: [real(r8) (:)] rain rate [mm/s]
- forc_snow_g => atm2lnd_inst%forc_snow_not_downscaled_grc , & ! Input: [real(r8) (:)] snow rate [mm/s]
- forc_lwrad_g => atm2lnd_inst%forc_lwrad_not_downscaled_grc , & ! Input: [real(r8) (:)] downward longwave (W/m**2)
-
- ! Column-level (downscaled) fields:
- forc_t_c => atm2lnd_inst%forc_t_downscaled_col , & ! Input: [real(r8) (:)] atmospheric temperature (Kelvin)
- forc_th_c => atm2lnd_inst%forc_th_downscaled_col , & ! Input: [real(r8) (:)] atmospheric potential temperature (Kelvin)
- forc_q_c => atm2lnd_inst%forc_q_downscaled_col , & ! Input: [real(r8) (:)] atmospheric specific humidity (kg/kg)
- forc_pbot_c => atm2lnd_inst%forc_pbot_downscaled_col , & ! Input: [real(r8) (:)] atmospheric pressure (Pa)
- forc_rho_c => atm2lnd_inst%forc_rho_downscaled_col , & ! Input: [real(r8) (:)] atmospheric density (kg/m**3)
- forc_rain_c => atm2lnd_inst%forc_rain_downscaled_col , & ! Input: [real(r8) (:)] rain rate [mm/s]
- forc_snow_c => atm2lnd_inst%forc_snow_downscaled_col , & ! Input: [real(r8) (:)] snow rate [mm/s]
- forc_lwrad_c => atm2lnd_inst%forc_lwrad_downscaled_col & ! Input: [real(r8) (:)] downward longwave (W/m**2)
- )
-
- ! BUG(wjs, 2016-11-15, bugz 2377)
- !
- ! Make sure that, for urban points, the column-level forcing fields are identical to
- ! the gridcell-level forcing fields. This is needed because the urban-specific code
- ! sometimes uses the gridcell-level forcing fields (and it would take a large
- ! refactor to change this to use column-level fields).
- !
- ! However, do NOT check rain & snow: these ARE downscaled for urban points (as for
- ! all other points), and the urban code does not refer to the gridcell-level versions
- ! of these fields.
-
- do c = bounds%begc, bounds%endc
- if (col%active(c)) then
- l = col%landunit(c)
- g = col%gridcell(c)
-
- if (lun%urbpoi(l)) then
- if (forc_t_c(c) /= forc_t_g(g) .or. &
- forc_th_c(c) /= forc_th_g(g) .or. &
- forc_q_c(c) /= forc_q_g(g) .or. &
- forc_pbot_c(c) /= forc_pbot_g(g) .or. &
- forc_rho_c(c) /= forc_rho_g(g) .or. &
- forc_lwrad_c(c) /= forc_lwrad_g(g)) then
- write(iulog,*) subname//' ERROR: column-level forcing differs from gridcell-level forcing for urban point'
- write(iulog,*) 'c, g = ', c, g
- write(iulog,*) 'forc_t_c, forc_t_g = ', forc_t_c(c), forc_t_g(g)
- write(iulog,*) 'forc_th_c, forc_th_g = ', forc_th_c(c), forc_th_g(g)
- write(iulog,*) 'forc_q_c, forc_q_g = ', forc_q_c(c), forc_q_g(g)
- write(iulog,*) 'forc_pbot_c, forc_pbot_g = ', forc_pbot_c(c), forc_pbot_g(g)
- write(iulog,*) 'forc_rho_c, forc_rho_g = ', forc_rho_c(c), forc_rho_g(g)
- write(iulog,*) 'forc_lwrad_c, forc_lwrad_g = ', forc_lwrad_c(c), forc_lwrad_g(g)
- call endrun(msg=errMsg(sourcefile, __LINE__))
- end if ! inequal
- end if ! urbpoi
- end if ! active
- end do
-
- end associate
-
- end subroutine check_downscale_consistency
-
-end module atm2lndMod
diff --git a/src/main/atm2lndType.F90 b/src/main/atm2lndType.F90
index f0d58fe1..cf065145 100644
--- a/src/main/atm2lndType.F90
+++ b/src/main/atm2lndType.F90
@@ -8,12 +8,12 @@ module atm2lndType
use shr_kind_mod , only : r8 => shr_kind_r8
use shr_infnan_mod, only : nan => shr_infnan_nan, assignment(=)
use shr_log_mod , only : errMsg => shr_log_errMsg
- use clm_varpar , only : numrad, ndst, nlevgrnd !ndst = number of dust bins. ! MML: numrad = 2, 1=vis, 2=nir
- use clm_varcon , only : rair, grav, cpair, hfus, tfrz, spval
- use clm_varctl , only : iulog, use_cn, use_cndv, use_fates, use_luna
+ use clm_varpar , only : numrad ! MML: numrad = 2, 1=vis, 2=nir
+ use clm_varcon , only : spval
+ use clm_varctl , only : iulog
use decompMod , only : bounds_type
use abortutils , only : endrun
- use PatchType , only : patch
+! use PatchType , only : patch
!
! !PUBLIC TYPES:
implicit none
@@ -21,38 +21,6 @@ module atm2lndType
save
!
! !PUBLIC DATA TYPES:
-
- type, public :: atm2lnd_params_type
- ! true => repartition rain/snow from atm based on temperature
- logical :: repartition_rain_snow
-
- ! true => downscale longwave radiation
- logical :: glcmec_downscale_longwave
-
- ! Surface temperature lapse rate (K m-1)
- real(r8) :: lapse_rate
-
- ! longwave radiation lapse rate (W m-2 m-1)
- real(r8) :: lapse_rate_longwave
-
- ! Relative limit for how much longwave downscaling can be done (unitless)
- ! The pre-normalized, downscaled longwave is restricted to be in the range
- ! [lwrad*(1-longwave_downscaling_limit), lwrad*(1+longwave_downscaling_limit)]
- real(r8) :: longwave_downscaling_limit
-
- ! Rain-snow ramp for glacier landunits
- ! frac_rain = (temp - all_snow_t) * frac_rain_slope
- ! (all_snow_t is in K)
- real(r8) :: precip_repartition_glc_all_snow_t
- real(r8) :: precip_repartition_glc_frac_rain_slope
-
- ! Rain-snow ramp for non-glacier landunits
- ! frac_rain = (temp - all_snow_t) * frac_rain_slope
- ! (all_snow_t is in K)
- real(r8) :: precip_repartition_nonglc_all_snow_t
- real(r8) :: precip_repartition_nonglc_frac_rain_slope
- end type atm2lnd_params_type
-
!----------------------------------------------------
! atmosphere -> land variables structure
!
@@ -68,39 +36,26 @@ module atm2lndType
! MML: I don't think this applies to me... I'm working at the grc level, not the col level...
!----------------------------------------------------
type, public :: atm2lnd_type
- type(atm2lnd_params_type) :: params
! atm->lnd not downscaled
real(r8), pointer :: forc_u_grc (:) => null() ! atm wind speed, east direction (m/s)
real(r8), pointer :: forc_v_grc (:) => null() ! atm wind speed, north direction (m/s)
real(r8), pointer :: forc_wind_grc (:) => null() ! atmospheric wind speed
real(r8), pointer :: forc_hgt_grc (:) => null() ! atmospheric reference height (m)
- real(r8), pointer :: forc_topo_grc (:) => null() ! atmospheric surface height (m)
real(r8), pointer :: forc_hgt_u_grc (:) => null() ! obs height of wind [m] (new)
real(r8), pointer :: forc_hgt_t_grc (:) => null() ! obs height of temperature [m] (new)
real(r8), pointer :: forc_hgt_q_grc (:) => null() ! obs height of humidity [m] (new)
! mml maybe use these
real(r8), pointer :: forc_vp_grc (:) => null() ! atmospheric vapor pressure (Pa)
- real(r8), pointer :: forc_rh_grc (:) => null() ! atmospheric relative humidity (%)
real(r8), pointer :: forc_psrf_grc (:) => null() ! surface pressure (Pa)
- real(r8), pointer :: forc_pco2_grc (:) => null() ! CO2 partial pressure (Pa)
- real(r8), pointer :: forc_pco2_240_patch (:) => null() ! 10-day mean CO2 partial pressure (Pa)
real(r8), pointer :: forc_solad_grc (:,:) => null() ! direct beam radiation (numrad) (vis=forc_sols , nir=forc_soll )
real(r8), pointer :: forc_solai_grc (:,:) => null() ! diffuse radiation (numrad) (vis=forc_solsd, nir=forc_solld)
real(r8), pointer :: forc_solar_grc (:) => null() ! incident solar radiation
- real(r8), pointer :: forc_ndep_grc (:) => null() ! nitrogen deposition rate (gN/m2/s)
- real(r8), pointer :: forc_pc13o2_grc (:) => null() ! C13O2 partial pressure (Pa)
- real(r8), pointer :: forc_po2_grc (:) => null() ! O2 partial pressure (Pa)
- real(r8), pointer :: forc_po2_240_patch (:) => null() ! 10-day mean O2 partial pressure (Pa)
- real(r8), pointer :: forc_aer_grc (:,:) => null() ! aerosol deposition array
- real(r8), pointer :: forc_pch4_grc (:) => null() ! CH4 partial pressure (Pa)
real(r8), pointer :: forc_t_not_downscaled_grc (:) => null() ! not downscaled atm temperature (Kelvin)
- real(r8), pointer :: forc_th_not_downscaled_grc (:) => null() ! not downscaled atm potential temperature (Kelvin)
real(r8), pointer :: forc_q_not_downscaled_grc (:) => null() ! not downscaled atm specific humidity (kg/kg)
! MML: I think this is the q I need to check if the negative LH is too big.
real(r8), pointer :: forc_pbot_not_downscaled_grc (:) => null() ! not downscaled atm pressure (Pa)
- real(r8), pointer :: forc_pbot240_downscaled_patch (:) => null() ! 10-day mean downscaled atm pressure (Pa)
real(r8), pointer :: forc_rho_not_downscaled_grc (:) => null() ! not downscaled atm density (kg/m**3)
real(r8), pointer :: forc_rain_not_downscaled_grc (:) => null() ! not downscaled atm rain rate [mm/s]
real(r8), pointer :: forc_snow_not_downscaled_grc (:) => null() ! not downscaled atm snow rate [mm/s]
@@ -183,7 +138,6 @@ module atm2lndType
real(r8), pointer :: mml_atm_rhomol_grc (:) => null() ! molar density of air at ref height [mol/m3]
real(r8), pointer :: mml_atm_rhoair_grc (:) => null() ! density of air at ref height [kg/m3]
real(r8), pointer :: mml_atm_cp_grc (:) => null() ! specific heat of air at const pressure + ref height [J/kg/K]
- real(r8), pointer :: mml_atm_pco2 (:) => null() ! partial pressure of co2
! Hydrology:
real(r8), pointer :: mml_atm_prec_liq_grc (:) => null() ! liquid precipitation (rain) [mm/s] ! MML 20180615 - bug: used to say m/s, changing to mm/s
real(r8), pointer :: mml_atm_prec_frz_grc (:) => null() ! frozen precipitation (snow) [mm/s]
@@ -276,224 +230,37 @@ module atm2lndType
! ------------------------------------------------------------------------------------
-
-
- ! atm->lnd downscaled
- real(r8), pointer :: forc_t_downscaled_col (:) => null() ! downscaled atm temperature (Kelvin)
- real(r8), pointer :: forc_th_downscaled_col (:) => null() ! downscaled atm potential temperature (Kelvin)
- real(r8), pointer :: forc_q_downscaled_col (:) => null() ! downscaled atm specific humidity (kg/kg)
- real(r8), pointer :: forc_pbot_downscaled_col (:) => null() ! downscaled atm pressure (Pa)
- real(r8), pointer :: forc_rho_downscaled_col (:) => null() ! downscaled atm density (kg/m**3)
- real(r8), pointer :: forc_rain_downscaled_col (:) => null() ! downscaled atm rain rate [mm/s]
- real(r8), pointer :: forc_snow_downscaled_col (:) => null() ! downscaled atm snow rate [mm/s]
- real(r8), pointer :: forc_lwrad_downscaled_col (:) => null() ! downscaled atm downwrd IR longwave radiation (W/m**2)
-
- ! rof->lnd
- real(r8), pointer :: forc_flood_grc (:) => null() ! rof flood (mm/s)
- real(r8), pointer :: volr_grc (:) => null() ! rof volr total volume (m3)
- real(r8), pointer :: volrmch_grc (:) => null() ! rof volr main channel (m3)
-
- ! anomaly forcing
- real(r8), pointer :: af_precip_grc (:) => null() ! anomaly forcing
- real(r8), pointer :: af_uwind_grc (:) => null() ! anomaly forcing
- real(r8), pointer :: af_vwind_grc (:) => null() ! anomaly forcing
- real(r8), pointer :: af_tbot_grc (:) => null() ! anomaly forcing
- real(r8), pointer :: af_pbot_grc (:) => null() ! anomaly forcing
- real(r8), pointer :: af_shum_grc (:) => null() ! anomaly forcing
- real(r8), pointer :: af_swdn_grc (:) => null() ! anomaly forcing
- real(r8), pointer :: af_lwdn_grc (:) => null() ! anomaly forcing
- real(r8), pointer :: bc_precip_grc (:) => null() ! anomaly forcing - add bias correction
! time averaged quantities
- real(r8) , pointer :: fsd24_patch (:) => null() ! patch 24hr average of direct beam radiation
- real(r8) , pointer :: fsd240_patch (:) => null() ! patch 240hr average of direct beam radiation
- real(r8) , pointer :: fsi24_patch (:) => null() ! patch 24hr average of diffuse beam radiation
- real(r8) , pointer :: fsi240_patch (:) => null() ! patch 240hr average of diffuse beam radiation
- real(r8) , pointer :: prec365_col (:) => null() ! col 365-day running mean of tot. precipitation (see comment in UpdateAccVars regarding why this is col-level despite other prec accumulators being patch-level)
- real(r8) , pointer :: prec60_patch (:) => null() ! patch 60-day running mean of tot. precipitation (mm/s)
- real(r8) , pointer :: prec10_patch (:) => null() ! patch 10-day running mean of tot. precipitation (mm/s)
- real(r8) , pointer :: rh30_patch (:) => null() ! patch 30-day running mean of relative humidity
- real(r8) , pointer :: prec24_patch (:) => null() ! patch 24-hour running mean of tot. precipitation (mm/s)
- real(r8) , pointer :: rh24_patch (:) => null() ! patch 24-hour running mean of relative humidity
- real(r8) , pointer :: wind24_patch (:) => null() ! patch 24-hour running mean of wind
- real(r8) , pointer :: t_mo_patch (:) => null() ! patch 30-day average temperature (Kelvin)
- real(r8) , pointer :: t_mo_min_patch (:) => null() ! patch annual min of t_mo (Kelvin)
+! real(r8) , pointer :: fsd240_patch (:) => null() ! patch 240hr average of direct beam radiation
contains
procedure, public :: Init
- procedure, public :: InitForTesting ! version of Init meant for unit testing
- procedure, private :: ReadNamelist
procedure, private :: InitAllocate
procedure, private :: InitHistory
procedure, private :: InitCold ! MML 2016.01.15 adding InitCold to give accumulating variables a starting point
- procedure, public :: InitAccBuffer
- procedure, public :: InitAccVars
- procedure, public :: UpdateAccVars
+! procedure, public :: InitAccBuffer
+! procedure, public :: InitAccVars
+! procedure, public :: UpdateAccVars
procedure, public :: Restart
procedure, public :: Clean
end type atm2lnd_type
- interface atm2lnd_params_type
- module procedure atm2lnd_params_constructor
- end interface atm2lnd_params_type
-
character(len=*), parameter, private :: sourcefile = &
__FILE__
!----------------------------------------------------
contains
- !-----------------------------------------------------------------------
- function atm2lnd_params_constructor(repartition_rain_snow, glcmec_downscale_longwave, &
- lapse_rate, lapse_rate_longwave, longwave_downscaling_limit, &
- precip_repartition_glc_all_snow_t, precip_repartition_glc_all_rain_t, &
- precip_repartition_nonglc_all_snow_t, precip_repartition_nonglc_all_rain_t) &
- result(params)
- !
- ! !DESCRIPTION:
- ! Creates a new instance of atm2lnd_params_type
- !
- ! !USES:
- !
- ! !ARGUMENTS:
- type(atm2lnd_params_type) :: params ! function result
- logical, intent(in) :: repartition_rain_snow
- logical, intent(in) :: glcmec_downscale_longwave
-
- ! Surface temperature lapse rate (K m-1)
- real(r8), intent(in) :: lapse_rate
-
- ! Longwave radiation lapse rate (W m-2 m-1)
- ! Must be present if glcmec_downscale_longwave is true; ignored otherwise
- real(r8), intent(in), optional :: lapse_rate_longwave
-
- ! Relative limit for how much longwave downscaling can be done (unitless)
- ! Must be present if glcmec_downscale_longwave is true; ignored otherwise
- real(r8), intent(in), optional :: longwave_downscaling_limit
-
- ! End-points of the rain-snow ramp for glacier landunits (degrees C)
- ! Must be present if repartition_rain_snow is true; ignored otherwise
- real(r8), intent(in), optional :: precip_repartition_glc_all_snow_t
- real(r8), intent(in), optional :: precip_repartition_glc_all_rain_t
-
- ! End-points of the rain-snow ramp for non-glacier landunits (degrees C)
- ! Must be present if repartition_rain_snow is true; ignored otherwise
- real(r8), intent(in), optional :: precip_repartition_nonglc_all_snow_t
- real(r8), intent(in), optional :: precip_repartition_nonglc_all_rain_t
- !
- ! !LOCAL VARIABLES:
-
- character(len=*), parameter :: subname = 'atm2lnd_params_constructor'
- !-----------------------------------------------------------------------
-
- params%repartition_rain_snow = repartition_rain_snow
- params%glcmec_downscale_longwave = glcmec_downscale_longwave
-
- params%lapse_rate = lapse_rate
-
- if (glcmec_downscale_longwave) then
- if (.not. present(lapse_rate_longwave)) then
- call endrun(subname // &
- ' ERROR: For glcmec_downscale_longwave true, lapse_rate_longwave must be provided')
- end if
- if (.not. present(longwave_downscaling_limit)) then
- call endrun(subname // &
- ' ERROR: For glcmec_downscale_longwave true, longwave_downscaling_limit must be provided')
- end if
-
- if (longwave_downscaling_limit < 0._r8 .or. &
- longwave_downscaling_limit > 1._r8) then
- call endrun(subname // &
- ' ERROR: longwave_downscaling_limit must be between 0 and 1')
- end if
-
- params%lapse_rate_longwave = lapse_rate_longwave
- params%longwave_downscaling_limit = longwave_downscaling_limit
- else
- params%lapse_rate_longwave = nan
- params%longwave_downscaling_limit = nan
- end if
-
- if (repartition_rain_snow) then
-
- ! Make sure all of the repartitioning-related parameters are present
-
- if (.not. present(precip_repartition_glc_all_snow_t)) then
- call endrun(subname // &
- ' ERROR: For repartition_rain_snow true, precip_repartition_glc_all_snow_t must be provided')
- end if
- if (.not. present(precip_repartition_glc_all_rain_t)) then
- call endrun(subname // &
- ' ERROR: For repartition_rain_snow true, precip_repartition_glc_all_rain_t must be provided')
- end if
- if (.not. present(precip_repartition_nonglc_all_snow_t)) then
- call endrun(subname // &
- ' ERROR: For repartition_rain_snow true, precip_repartition_nonglc_all_snow_t must be provided')
- end if
- if (.not. present(precip_repartition_nonglc_all_rain_t)) then
- call endrun(subname // &
- ' ERROR: For repartition_rain_snow true, precip_repartition_nonglc_all_rain_t must be provided')
- end if
-
- ! Do some other error checking
-
- if (precip_repartition_glc_all_rain_t <= precip_repartition_glc_all_snow_t) then
- call endrun(subname // &
- ' ERROR: Must have precip_repartition_glc_all_snow_t < precip_repartition_glc_all_rain_t')
- end if
-
- if (precip_repartition_nonglc_all_rain_t <= precip_repartition_nonglc_all_snow_t) then
- call endrun(subname // &
- ' ERROR: Must have precip_repartition_nonglc_all_snow_t < precip_repartition_nonglc_all_rain_t')
- end if
-
- ! Convert to the form of the parameters we want for the main code
-
- call compute_ramp_params( &
- all_snow_t_c = precip_repartition_glc_all_snow_t, &
- all_rain_t_c = precip_repartition_glc_all_rain_t, &
- all_snow_t_k = params%precip_repartition_glc_all_snow_t, &
- frac_rain_slope = params%precip_repartition_glc_frac_rain_slope)
-
- call compute_ramp_params( &
- all_snow_t_c = precip_repartition_nonglc_all_snow_t, &
- all_rain_t_c = precip_repartition_nonglc_all_rain_t, &
- all_snow_t_k = params%precip_repartition_nonglc_all_snow_t, &
- frac_rain_slope = params%precip_repartition_nonglc_frac_rain_slope)
-
- else ! .not. repartition_rain_snow
- params%precip_repartition_glc_all_snow_t = nan
- params%precip_repartition_glc_frac_rain_slope = nan
- params%precip_repartition_nonglc_all_snow_t = nan
- params%precip_repartition_nonglc_frac_rain_slope = nan
- end if
-
- contains
- subroutine compute_ramp_params(all_snow_t_c, all_rain_t_c, &
- all_snow_t_k, frac_rain_slope)
- real(r8), intent(in) :: all_snow_t_c ! Temperature at which precip falls entirely as rain (deg C)
- real(r8), intent(in) :: all_rain_t_c ! Temperature at which precip falls entirely as snow (deg C)
- real(r8), intent(out) :: all_snow_t_k ! Temperature at which precip falls entirely as snow (K)
- real(r8), intent(out) :: frac_rain_slope ! Slope of the frac_rain vs. T relationship
-
- frac_rain_slope = 1._r8 / (all_rain_t_c - all_snow_t_c)
- all_snow_t_k = all_snow_t_c + tfrz
- end subroutine compute_ramp_params
-
- end function atm2lnd_params_constructor
-
-
!------------------------------------------------------------------------
- subroutine Init(this, bounds, NLFilename)
+ subroutine Init(this, bounds)
class(atm2lnd_type) :: this
type(bounds_type), intent(in) :: bounds
- character(len=*), intent(in) :: NLFilename ! namelist filename
call this%InitAllocate(bounds)
- call this%ReadNamelist(NLFilename)
call this%InitHistory(bounds)
! MML 2016.01.15 adding call to InitCold (make sure it doesn't keep using the
@@ -502,156 +269,6 @@ subroutine Init(this, bounds, NLFilename)
end subroutine Init
- !-----------------------------------------------------------------------
- subroutine InitForTesting(this, bounds, params)
- !
- ! !DESCRIPTION:
- ! Does initialization needed for unit testing. Allows caller to prescribe parameter
- ! values (bypassing the namelist read)
- !
- ! !USES:
- !
- ! !ARGUMENTS:
- class(atm2lnd_type) :: this
- type(bounds_type), intent(in) :: bounds
-
- ! If params isn't provided, we use default values
- type(atm2lnd_params_type), intent(in), optional :: params
- !
- ! !LOCAL VARIABLES:
- type(atm2lnd_params_type) :: l_params
-
- character(len=*), parameter :: subname = 'InitForTesting'
- !-----------------------------------------------------------------------
-
- if (present(params)) then
- l_params = params
- else
- ! Use arbitrary values
- l_params = atm2lnd_params_type( &
- repartition_rain_snow = .false., &
- glcmec_downscale_longwave = .false., &
- lapse_rate = 0.01_r8)
- end if
-
- call this%InitAllocate(bounds)
- this%params = l_params
-
- end subroutine InitForTesting
-
-
- !-----------------------------------------------------------------------
- subroutine ReadNamelist(this, NLFilename)
- !
- ! !DESCRIPTION:
- ! Read the atm2lnd namelist
- !
- ! !USES:
- use fileutils , only : getavu, relavu, opnfil
- use shr_nl_mod , only : shr_nl_find_group_name
- use spmdMod , only : masterproc, mpicom
- use shr_mpi_mod , only : shr_mpi_bcast
- !
- ! !ARGUMENTS:
- character(len=*), intent(in) :: NLFilename ! Namelist filename
- class(atm2lnd_type), intent(inout) :: this
- !
- ! !LOCAL VARIABLES:
-
- ! temporary variables corresponding to the components of atm2lnd_params_type
- logical :: repartition_rain_snow
- logical :: glcmec_downscale_longwave
- real(r8) :: lapse_rate
- real(r8) :: lapse_rate_longwave
- real(r8) :: longwave_downscaling_limit
- real(r8) :: precip_repartition_glc_all_snow_t
- real(r8) :: precip_repartition_glc_all_rain_t
- real(r8) :: precip_repartition_nonglc_all_snow_t
- real(r8) :: precip_repartition_nonglc_all_rain_t
-
- integer :: ierr ! error code
- integer :: unitn ! unit for namelist file
- character(len=*), parameter :: nmlname = 'atm2lnd_inparm'
-
- character(len=*), parameter :: subname = 'ReadNamelist'
- !-----------------------------------------------------------------------
-
- namelist /atm2lnd_inparm/ repartition_rain_snow, glcmec_downscale_longwave, &
- lapse_rate, lapse_rate_longwave, longwave_downscaling_limit, &
- precip_repartition_glc_all_snow_t, precip_repartition_glc_all_rain_t, &
- precip_repartition_nonglc_all_snow_t, precip_repartition_nonglc_all_rain_t
-
- ! Initialize namelist variables to defaults
- repartition_rain_snow = .false.
- glcmec_downscale_longwave = .false.
- lapse_rate = nan
- lapse_rate_longwave = nan
- longwave_downscaling_limit = nan
- precip_repartition_glc_all_snow_t = nan
- precip_repartition_glc_all_rain_t = nan
- precip_repartition_nonglc_all_snow_t = nan
- precip_repartition_nonglc_all_rain_t = nan
-
- if (masterproc) then
- unitn = getavu()
- call opnfil (NLFilename, unitn, 'F')
- call shr_nl_find_group_name(unitn, nmlname, status=ierr)
- if (ierr == 0) then
- read(unitn, nml=atm2lnd_inparm, iostat=ierr)
- if (ierr /= 0) then
- call endrun(msg="ERROR reading "//nmlname//"namelist"//errmsg(sourcefile, __LINE__))
- end if
- else
- call endrun(msg="ERROR could NOT find "//nmlname//"namelist"//errmsg(sourcefile, __LINE__))
- end if
- call relavu( unitn )
- end if
-
- call shr_mpi_bcast(repartition_rain_snow, mpicom)
- call shr_mpi_bcast(glcmec_downscale_longwave, mpicom)
- call shr_mpi_bcast(lapse_rate, mpicom)
- call shr_mpi_bcast(lapse_rate_longwave, mpicom)
- call shr_mpi_bcast(longwave_downscaling_limit, mpicom)
- call shr_mpi_bcast(precip_repartition_glc_all_snow_t, mpicom)
- call shr_mpi_bcast(precip_repartition_glc_all_rain_t, mpicom)
- call shr_mpi_bcast(precip_repartition_nonglc_all_snow_t, mpicom)
- call shr_mpi_bcast(precip_repartition_nonglc_all_rain_t, mpicom)
-
- if (masterproc) then
- write(iulog,*) ' '
- write(iulog,*) nmlname//' settings:'
- ! Write settings one-by-one rather than with a nml write because some settings may
- ! be NaN if certain options are turned off.
- write(iulog,*) 'repartition_rain_snow = ', repartition_rain_snow
- write(iulog,*) 'glcmec_downscale_longwave = ', glcmec_downscale_longwave
- write(iulog,*) 'lapse_rate = ', lapse_rate
- if (glcmec_downscale_longwave) then
- write(iulog,*) 'lapse_rate_longwave = ', lapse_rate_longwave
- write(iulog,*) 'longwave_downscaling_limit = ', longwave_downscaling_limit
- end if
- if (repartition_rain_snow) then
- write(iulog,*) 'precip_repartition_glc_all_snow_t = ', precip_repartition_glc_all_snow_t
- write(iulog,*) 'precip_repartition_glc_all_rain_t = ', precip_repartition_glc_all_rain_t
- write(iulog,*) 'precip_repartition_nonglc_all_snow_t = ', precip_repartition_nonglc_all_snow_t
- write(iulog,*) 'precip_repartition_nonglc_all_rain_t = ', precip_repartition_nonglc_all_rain_t
- end if
- write(iulog,*) ' '
- end if
-
- this%params = atm2lnd_params_type( &
- repartition_rain_snow = repartition_rain_snow, &
- glcmec_downscale_longwave = glcmec_downscale_longwave, &
- lapse_rate = lapse_rate, &
- lapse_rate_longwave = lapse_rate_longwave, &
- longwave_downscaling_limit = longwave_downscaling_limit, &
- precip_repartition_glc_all_snow_t = precip_repartition_glc_all_snow_t, &
- precip_repartition_glc_all_rain_t = precip_repartition_glc_all_rain_t, &
- precip_repartition_nonglc_all_snow_t = precip_repartition_nonglc_all_snow_t, &
- precip_repartition_nonglc_all_rain_t = precip_repartition_nonglc_all_rain_t)
-
- end subroutine ReadNamelist
-
-
!------------------------------------------------------------------------
subroutine InitAllocate(this, bounds)
!
@@ -665,46 +282,28 @@ subroutine InitAllocate(this, bounds)
! !LOCAL VARIABLES:
real(r8) :: ival = 0.0_r8 ! initial value
integer :: begg, endg
- integer :: begc, endc
- integer :: begp, endp
!------------------------------------------------------------------------
begg = bounds%begg; endg= bounds%endg
- begc = bounds%begc; endc= bounds%endc
- begp = bounds%begp; endp= bounds%endp
! atm->lnd
allocate(this%forc_u_grc (begg:endg)) ; this%forc_u_grc (:) = ival
allocate(this%forc_v_grc (begg:endg)) ; this%forc_v_grc (:) = ival
allocate(this%forc_wind_grc (begg:endg)) ; this%forc_wind_grc (:) = ival
- allocate(this%forc_rh_grc (begg:endg)) ; this%forc_rh_grc (:) = ival
allocate(this%forc_hgt_grc (begg:endg)) ; this%forc_hgt_grc (:) = ival
- allocate(this%forc_topo_grc (begg:endg)) ; this%forc_topo_grc (:) = ival
allocate(this%forc_hgt_u_grc (begg:endg)) ; this%forc_hgt_u_grc (:) = ival
allocate(this%forc_hgt_t_grc (begg:endg)) ; this%forc_hgt_t_grc (:) = ival
allocate(this%forc_hgt_q_grc (begg:endg)) ; this%forc_hgt_q_grc (:) = ival
allocate(this%forc_vp_grc (begg:endg)) ; this%forc_vp_grc (:) = ival
allocate(this%forc_psrf_grc (begg:endg)) ; this%forc_psrf_grc (:) = ival
- allocate(this%forc_pco2_grc (begg:endg)) ; this%forc_pco2_grc (:) = ival
allocate(this%forc_solad_grc (begg:endg,numrad)) ; this%forc_solad_grc (:,:) = ival
allocate(this%forc_solai_grc (begg:endg,numrad)) ; this%forc_solai_grc (:,:) = ival
allocate(this%forc_solar_grc (begg:endg)) ; this%forc_solar_grc (:) = ival
- allocate(this%forc_ndep_grc (begg:endg)) ; this%forc_ndep_grc (:) = ival
- allocate(this%forc_pc13o2_grc (begg:endg)) ; this%forc_pc13o2_grc (:) = ival
- allocate(this%forc_po2_grc (begg:endg)) ; this%forc_po2_grc (:) = ival
- allocate(this%forc_aer_grc (begg:endg,14)) ; this%forc_aer_grc (:,:) = ival
- allocate(this%forc_pch4_grc (begg:endg)) ; this%forc_pch4_grc (:) = ival
- if(use_luna)then
- allocate(this%forc_pco2_240_patch (begp:endp)) ; this%forc_pco2_240_patch (:) = ival
- allocate(this%forc_po2_240_patch (begp:endp)) ; this%forc_po2_240_patch (:) = ival
- allocate(this%forc_pbot240_downscaled_patch(begp:endp)) ; this%forc_pbot240_downscaled_patch (:) = ival
- endif
! atm->lnd not downscaled
allocate(this%forc_t_not_downscaled_grc (begg:endg)) ; this%forc_t_not_downscaled_grc (:) = ival
allocate(this%forc_q_not_downscaled_grc (begg:endg)) ; this%forc_q_not_downscaled_grc (:) = ival
allocate(this%forc_pbot_not_downscaled_grc (begg:endg)) ; this%forc_pbot_not_downscaled_grc (:) = ival
- allocate(this%forc_th_not_downscaled_grc (begg:endg)) ; this%forc_th_not_downscaled_grc (:) = ival
allocate(this%forc_rho_not_downscaled_grc (begg:endg)) ; this%forc_rho_not_downscaled_grc (:) = ival
allocate(this%forc_lwrad_not_downscaled_grc (begg:endg)) ; this%forc_lwrad_not_downscaled_grc (:) = ival
allocate(this%forc_rain_not_downscaled_grc (begg:endg)) ; this%forc_rain_not_downscaled_grc (:) = ival
@@ -757,7 +356,6 @@ subroutine InitAllocate(this, bounds)
allocate(this%mml_atm_rhomol_grc (begg:endg)) ; this%mml_atm_rhomol_grc (:) = ival
allocate(this%mml_atm_rhoair_grc (begg:endg)) ; this%mml_atm_rhoair_grc (:) = ival
allocate(this%mml_atm_cp_grc (begg:endg)) ; this%mml_atm_cp_grc (:) = ival
- allocate(this%mml_atm_pco2 (begg:endg)) ; this%mml_atm_pco2 (:) = ival
allocate(this%mml_atm_prec_liq_grc (begg:endg)) ; this%mml_atm_prec_liq_grc (:) = ival
allocate(this%mml_atm_prec_frz_grc (begg:endg)) ; this%mml_atm_prec_frz_grc (:) = ival
@@ -847,48 +445,7 @@ subroutine InitAllocate(this, bounds)
! ---------------------------------------
-
- ! atm->lnd downscaled
- allocate(this%forc_t_downscaled_col (begc:endc)) ; this%forc_t_downscaled_col (:) = ival
- allocate(this%forc_q_downscaled_col (begc:endc)) ; this%forc_q_downscaled_col (:) = ival
- allocate(this%forc_pbot_downscaled_col (begc:endc)) ; this%forc_pbot_downscaled_col (:) = ival
- allocate(this%forc_th_downscaled_col (begc:endc)) ; this%forc_th_downscaled_col (:) = ival
- allocate(this%forc_rho_downscaled_col (begc:endc)) ; this%forc_rho_downscaled_col (:) = ival
- allocate(this%forc_lwrad_downscaled_col (begc:endc)) ; this%forc_lwrad_downscaled_col (:) = ival
- allocate(this%forc_rain_downscaled_col (begc:endc)) ; this%forc_rain_downscaled_col (:) = ival
- allocate(this%forc_snow_downscaled_col (begc:endc)) ; this%forc_snow_downscaled_col (:) = ival
-
- ! rof->lnd
- allocate(this%forc_flood_grc (begg:endg)) ; this%forc_flood_grc (:) = ival
- allocate(this%volr_grc (begg:endg)) ; this%volr_grc (:) = ival
- allocate(this%volrmch_grc (begg:endg)) ; this%volrmch_grc (:) = ival
-
- ! anomaly forcing
- allocate(this%bc_precip_grc (begg:endg)) ; this%bc_precip_grc (:) = ival
- allocate(this%af_precip_grc (begg:endg)) ; this%af_precip_grc (:) = ival
- allocate(this%af_uwind_grc (begg:endg)) ; this%af_uwind_grc (:) = ival
- allocate(this%af_vwind_grc (begg:endg)) ; this%af_vwind_grc (:) = ival
- allocate(this%af_tbot_grc (begg:endg)) ; this%af_tbot_grc (:) = ival
- allocate(this%af_pbot_grc (begg:endg)) ; this%af_pbot_grc (:) = ival
- allocate(this%af_shum_grc (begg:endg)) ; this%af_shum_grc (:) = ival
- allocate(this%af_swdn_grc (begg:endg)) ; this%af_swdn_grc (:) = ival
- allocate(this%af_lwdn_grc (begg:endg)) ; this%af_lwdn_grc (:) = ival
-
- allocate(this%fsd24_patch (begp:endp)) ; this%fsd24_patch (:) = nan
- allocate(this%fsd240_patch (begp:endp)) ; this%fsd240_patch (:) = nan
- allocate(this%fsi24_patch (begp:endp)) ; this%fsi24_patch (:) = nan
- allocate(this%fsi240_patch (begp:endp)) ; this%fsi240_patch (:) = nan
- allocate(this%prec10_patch (begp:endp)) ; this%prec10_patch (:) = nan
- allocate(this%prec60_patch (begp:endp)) ; this%prec60_patch (:) = nan
- allocate(this%rh30_patch (begp:endp)) ; this%rh30_patch (:) = nan
- allocate(this%prec365_col (begc:endc)) ; this%prec365_col (:) = nan
- if (use_fates) then
- allocate(this%prec24_patch (begp:endp)) ; this%prec24_patch (:) = nan
- allocate(this%rh24_patch (begp:endp)) ; this%rh24_patch (:) = nan
- allocate(this%wind24_patch (begp:endp)) ; this%wind24_patch (:) = nan
- end if
- allocate(this%t_mo_patch (begp:endp)) ; this%t_mo_patch (:) = nan
- allocate(this%t_mo_min_patch (begp:endp)) ; this%t_mo_min_patch (:) = spval ! TODO - initialize this elsewhere
+! allocate(this%fsd240_patch (begp:endp)) ; this%fsd240_patch (:) = nan
end subroutine InitAllocate
@@ -898,7 +455,7 @@ subroutine InitHistory(this, bounds)
! !USES:
! use histFileMod, only : hist_addfld1d
! MML:
- use histFileMod, only : hist_addfld1d, hist_addfld2d, hist_addfld_decomp
+ use histFileMod, only : hist_addfld1d, hist_addfld2d
!
! !ARGUMENTS:
class(atm2lnd_type) :: this
@@ -906,8 +463,6 @@ subroutine InitHistory(this, bounds)
!
! !LOCAL VARIABLES:
integer :: begg, endg
- integer :: begc, endc
- integer :: begp, endp
integer :: mml_nsoi ! number of soil levels
!---------------------------------------------------------------------
@@ -915,94 +470,29 @@ subroutine InitHistory(this, bounds)
mml_nsoi = 10
begg = bounds%begg; endg= bounds%endg
- begc = bounds%begc; endc= bounds%endc
- begp = bounds%begp; endp= bounds%endp
!write(iulog,*) 'MML trying write h0 - start'
- this%forc_flood_grc(begg:endg) = spval
- call hist_addfld1d (fname='QFLOOD', units='mm/s', &
- avgflag='A', long_name='runoff from river flooding', &
- ptr_lnd=this%forc_flood_grc)
-
- this%volr_grc(begg:endg) = spval
- call hist_addfld1d (fname='VOLR', units='m3', &
- avgflag='A', long_name='river channel total water storage', &
- ptr_lnd=this%volr_grc)
-
- this%volrmch_grc(begg:endg) = spval
- call hist_addfld1d (fname='VOLRMCH', units='m3', &
- avgflag='A', long_name='river channel main channel water storage', &
- ptr_lnd=this%volrmch_grc)
-
this%forc_wind_grc(begg:endg) = spval
call hist_addfld1d (fname='WIND', units='m/s', &
avgflag='A', long_name='atmospheric wind velocity magnitude', &
ptr_lnd=this%forc_wind_grc)
- ! Rename of WIND for Urban intercomparision project
- call hist_addfld1d (fname='Wind', units='m/s', &
- avgflag='A', long_name='atmospheric wind velocity magnitude', &
- ptr_gcell=this%forc_wind_grc, default = 'inactive')
this%forc_hgt_grc(begg:endg) = spval
call hist_addfld1d (fname='ZBOT', units='m', &
avgflag='A', long_name='atmospheric reference height', &
ptr_lnd=this%forc_hgt_grc)
- this%forc_topo_grc(begg:endg) = spval
- call hist_addfld1d (fname='ATM_TOPO', units='m', &
- avgflag='A', long_name='atmospheric surface height', &
- ptr_lnd=this%forc_topo_grc)
-
this%forc_solar_grc(begg:endg) = spval
call hist_addfld1d (fname='FSDS', units='W/m^2', &
avgflag='A', long_name='atmospheric incident solar radiation', &
ptr_lnd=this%forc_solar_grc)
- this%forc_pco2_grc(begg:endg) = spval
- call hist_addfld1d (fname='PCO2', units='Pa', &
- avgflag='A', long_name='atmospheric partial pressure of CO2', &
- ptr_lnd=this%forc_pco2_grc)
-
- this%forc_solar_grc(begg:endg) = spval
- call hist_addfld1d (fname='SWdown', units='W/m^2', &
- avgflag='A', long_name='atmospheric incident solar radiation', &
- ptr_gcell=this%forc_solar_grc, default='inactive')
-
- this%forc_rh_grc(begg:endg) = spval
- call hist_addfld1d (fname='RH', units='%', &
- avgflag='A', long_name='atmospheric relative humidity', &
- ptr_gcell=this%forc_rh_grc, default='inactive')
-
this%forc_t_not_downscaled_grc(begg:endg) = spval
call hist_addfld1d (fname='Tair_from_atm', units='K', &
avgflag='A', long_name='atmospheric air temperature received from atmosphere (pre-downscaling)', &
ptr_gcell=this%forc_t_not_downscaled_grc, default='inactive')
- this%forc_t_downscaled_col(begc:endc) = spval
- call hist_addfld1d (fname='TBOT', units='K', &
- avgflag='A', long_name='atmospheric air temperature (downscaled to columns in glacier regions)', &
- ptr_col=this%forc_t_downscaled_col)
- call hist_addfld1d (fname='Tair', units='K', &
- avgflag='A', long_name='atmospheric air temperature (downscaled to columns in glacier regions)', &
- ptr_col=this%forc_t_downscaled_col, default='inactive')
-
- this%forc_pbot_downscaled_col(begc:endc) = spval
- call hist_addfld1d (fname='PBOT', units='Pa', &
- avgflag='A', long_name='atmospheric pressure at surface (downscaled to columns in glacier regions)', &
- ptr_col=this%forc_pbot_downscaled_col)
- call hist_addfld1d (fname='PSurf', units='Pa', &
- avgflag='A', long_name='atmospheric pressure at surface (downscaled to columns in glacier regions)', &
- ptr_col=this%forc_pbot_downscaled_col, default='inactive')
-
- this%forc_lwrad_downscaled_col(begc:endc) = spval
- call hist_addfld1d (fname='FLDS', units='W/m^2', &
- avgflag='A', long_name='atmospheric longwave radiation (downscaled to columns in glacier regions)', &
- ptr_col=this%forc_lwrad_downscaled_col)
- call hist_addfld1d (fname='LWdown', units='W/m^2', &
- avgflag='A', long_name='atmospheric longwave radiation (downscaled to columns in glacier regions)', &
- ptr_col=this%forc_lwrad_downscaled_col, default='inactive')
-
this%forc_rain_not_downscaled_grc(begg:endg) = spval
call hist_addfld1d (fname='RAIN_FROM_ATM', units='mm/s', &
avgflag='A', long_name='atmospheric rain received from atmosphere (pre-repartitioning)', &
@@ -1013,41 +503,6 @@ subroutine InitHistory(this, bounds)
avgflag='A', long_name='atmospheric snow received from atmosphere (pre-repartitioning)', &
ptr_lnd=this%forc_snow_not_downscaled_grc)
- this%forc_rain_downscaled_col(begc:endc) = spval
- call hist_addfld1d (fname='RAIN', units='mm/s', &
- avgflag='A', long_name='atmospheric rain, after rain/snow repartitioning based on temperature', &
- ptr_col=this%forc_rain_downscaled_col)
- call hist_addfld1d (fname='Rainf', units='mm/s', &
- avgflag='A', long_name='atmospheric rain, after rain/snow repartitioning based on temperature', &
- ptr_col=this%forc_rain_downscaled_col, default='inactive')
-
- this%forc_snow_downscaled_col(begc:endc) = spval
- call hist_addfld1d (fname='SNOW', units='mm/s', &
- avgflag='A', long_name='atmospheric snow, after rain/snow repartitioning based on temperature', &
- ptr_col=this%forc_snow_downscaled_col)
-
- this%forc_th_downscaled_col(begc:endc) = spval
- call hist_addfld1d (fname='THBOT', units='K', &
- avgflag='A', long_name='atmospheric air potential temperature (downscaled to columns in glacier regions)', &
- ptr_col=this%forc_th_downscaled_col)
-
-! ! MML: 2016.01.14 Try and add a new history field variable equal to 2TBOT
-! ! (just to see if it will print)
-! this%forc_2t_not_downscaled_grc(begg:endg) = spval
-! call hist_addfld1d (fname='T2BOT', units='K', &
-! avgflag='A', long_name='2x atmospheric air temperature MML Test', &
-! ptr_lnd=this%forc_2t_not_downscaled_grc)
-
- this%forc_q_downscaled_col(begc:endc) = spval
- call hist_addfld1d (fname='QBOT', units='kg/kg', &
- avgflag='A', long_name='atmospheric specific humidity (downscaled to columns in glacier regions)', &
- ptr_col=this%forc_q_downscaled_col)
- ! Rename of QBOT for Urban intercomparison project
- call hist_addfld1d (fname='Qair', units='kg/kg', &
- avgflag='A', long_name='atmospheric specific humidity (downscaled to columns in glacier regions)', &
- ptr_col=this%forc_q_downscaled_col, default='inactive')
-
-
!-----------------------------------------------------------------------
! MML: 2016.01.14 Simple Land Energy and Hydrology variables (gridscale)
@@ -1057,57 +512,57 @@ subroutine InitHistory(this, bounds)
! (don't typically print these - waste of space. But for now, could be useful...
! Skipping because I'm lazy; add later
! this%mml_nc_alb_grc(begg:endg) = spval
-! call hist_addfld1d (fname='MML_albdeo', units='unitless', &
-! avgflag='A', long_name='MML prescribed snow-free surface albedo', &
+! call hist_addfld1d (fname='albedo', units='unitless', &
+! avgflag='A', long_name='prescribed snow-free surface albedo', &
! ptr_lnd=this%mml_nc_alb_grc)
!
! this%mml_nc_snoalb_grc(begg:endg) = spval
-! call hist_addfld1d (fname='MML_snow_albdeo', units='unitless', &
-! avgflag='A', long_name='MML prescribed deep-snow albedo', &
+! call hist_addfld1d (fname='snow_albedo', units='unitless', &
+! avgflag='A', long_name='prescribed deep-snow albedo', &
! ptr_lnd=this%mml_nc_snoalb_grc)
this%mml_nc_snowmask_grc(begg:endg) = spval
- call hist_addfld1d (fname='MML_snowmaskdepth', units='kg/m2', &
- avgflag='A', long_name='MML snow required to toggle deep snow albedo', &
+ call hist_addfld1d (fname='snowmaskdepth', units='kg/m2', &
+ avgflag='A', long_name='snow required to toggle deep snow albedo', &
ptr_lnd=this%mml_nc_snowmask_grc)
this%mml_nc_evaprs_grc(begg:endg) = spval
- call hist_addfld1d (fname='MML_evap_rs', units='s/m', &
- avgflag='A', long_name='MML like stomatal resistance of soil', &
+ call hist_addfld1d (fname='evap_rs', units='s/m', &
+ avgflag='A', long_name='like stomatal resistance of soil', &
ptr_lnd=this%mml_nc_evaprs_grc)
this%mml_nc_bucket_cap_grc(begg:endg) = spval
- call hist_addfld1d (fname='MML_bucket_cap', units='kg/m2', &
- avgflag='A', long_name='MML soil water bucket capacity (maximum water soil can hold)', &
+ call hist_addfld1d (fname='bucket_cap', units='kg/m2', &
+ avgflag='A', long_name='soil water bucket capacity (maximum water soil can hold)', &
ptr_lnd=this%mml_nc_bucket_cap_grc)
!this%mml_nc_soil_maxice_grc(begg:endg,:) = spval
- !call hist_addfld1d (fname='MML_maxice', units='kg/m3', &
- ! avgflag='A', long_name='MML maximum freezable water in each soil layer; for thermal calculations', &
+ !call hist_addfld1d (fname='maxice', units='kg/m3', &
+ ! avgflag='A', long_name='maximum freezable water in each soil layer; for thermal calculations', &
! ptr_lnd=this%mml_nc_soil_maxice_grc)
!data2dptr => this%mml_nc_soil_maxice_grc(begg:endg,:)
- !fieldname = 'MML_maxice'
- !longname = 'MML maximum freezable water in each soil layer; for thermal calculations'
+ !fieldname = 'maxice'
+ !longname = 'maximum freezable water in each soil layer; for thermal calculations'
this%mml_nc_soil_type_grc(begg:endg) = spval
- call hist_addfld1d (fname='MML_soiltype', units='unitless', &
- avgflag='A', long_name='MML Soil type (sand/clay), of 11 possible types; for thermal calculations', &
+ call hist_addfld1d (fname='soiltype', units='unitless', &
+ avgflag='A', long_name='Soil type (sand/clay), of 11 possible types; for thermal calculations', &
ptr_lnd=this%mml_nc_soil_type_grc)
this%mml_nc_roughness_grc(begg:endg) = spval
- call hist_addfld1d (fname='MML_roughness', units='m', &
- avgflag='A', long_name='MML surface roughness length (e.g. canopy height) ', &
+ call hist_addfld1d (fname='roughness', units='m', &
+ avgflag='A', long_name='surface roughness length (e.g. canopy height) ', &
ptr_lnd=this%mml_nc_roughness_grc)
this%mml_nc_emiss_grc(begg:endg) = spval
- call hist_addfld1d (fname='MML_emiss', units='unitless', &
- avgflag='A', long_name='MML surface emissivity ', &
+ call hist_addfld1d (fname='emiss', units='unitless', &
+ avgflag='A', long_name='surface emissivity ', &
ptr_lnd=this%mml_nc_emiss_grc)
this%mml_nc_glcmask_grc(begg:endg) = spval
- call hist_addfld1d (fname='MML_glcmask', units='unitless', &
- avgflag='A', long_name='MML logical mask saying which cells should be treated as glaciers', &
+ call hist_addfld1d (fname='glcmask', units='unitless', &
+ avgflag='A', long_name='logical mask saying which cells should be treated as glaciers', &
ptr_lnd=this%mml_nc_glcmask_grc)
@@ -1115,356 +570,346 @@ subroutine InitHistory(this, bounds)
! Carried from atmosphere:
! write(iulog,*) 'MML write to h0: atm vars '
- this%mml_atm_fsds_grc(begg:endg) = spval
- call hist_addfld1d (fname='MML_fsds', units='W/m2', &
- avgflag='A', long_name='MML incoming shortwave radiation', &
- ptr_lnd=this%mml_atm_fsds_grc)
+ this%forc_solar_grc(begg:endg) = spval
+ call hist_addfld1d (fname='fsds', units='W/m2', &
+ avgflag='A', long_name='incoming shortwave radiation', &
+ ptr_lnd=this%forc_solar_grc)
this%mml_atm_fsdsnd_grc(begg:endg) = spval
- call hist_addfld1d (fname='MML_fsdsnd', units='W/m2', &
- avgflag='A', long_name='MML incoming shortwave nir direct radiation', &
+ call hist_addfld1d (fname='fsdsnd', units='W/m2', &
+ avgflag='A', long_name='incoming shortwave nir direct radiation', &
ptr_lnd=this%mml_atm_fsdsnd_grc)
-
- this%mml_atm_fsdsvd_grc(begg:endg) = spval
- call hist_addfld1d (fname='MML_fsdsvd', units='W/m2', &
- avgflag='A', long_name='MML incoming shortwave visible direct radiation', &
+
+ this%mml_atm_fsdsvd_grc(begg:endg) = spval
+ call hist_addfld1d (fname='fsdsvd', units='W/m2', &
+ avgflag='A', long_name='incoming shortwave visible direct radiation', &
ptr_lnd=this%mml_atm_fsdsvd_grc)
this%mml_atm_fsdsni_grc(begg:endg) = spval
- call hist_addfld1d (fname='MML_fsdsni', units='W/m2', &
- avgflag='A', long_name='MML incoming shortwave nir diffuse radiation', &
+ call hist_addfld1d (fname='fsdsni', units='W/m2', &
+ avgflag='A', long_name='incoming shortwave nir diffuse radiation', &
ptr_lnd=this%mml_atm_fsdsni_grc)
this%mml_atm_fsdsvi_grc(begg:endg) = spval
- call hist_addfld1d (fname='MML_fsdsvi', units='W/m2', &
- avgflag='A', long_name='MML incoming shortwave visible diffuse radiation', &
+ call hist_addfld1d (fname='fsdsvi', units='W/m2', &
+ avgflag='A', long_name='incoming shortwave visible diffuse radiation', &
ptr_lnd=this%mml_atm_fsdsvi_grc)
- this%mml_atm_lwdn_grc(begg:endg) = spval
- call hist_addfld1d (fname='MML_lwdn', units='W/m2', &
- avgflag='A', long_name='MML incoming longwave radiation', &
- ptr_lnd=this%mml_atm_lwdn_grc)
+ this%forc_lwrad_not_downscaled_grc(begg:endg) = spval
+ call hist_addfld1d (fname='lwdn', units='W/m2', &
+ avgflag='A', long_name='incoming longwave radiation', &
+ ptr_lnd=this%forc_lwrad_not_downscaled_grc)
- this%mml_atm_zref_grc(begg:endg) = spval
- call hist_addfld1d (fname='MML_zref', units='m', &
- avgflag='A', long_name='MML height of atm reference level', &
- ptr_lnd=this%mml_atm_zref_grc)
+ this%forc_hgt_grc(begg:endg) = spval
+ call hist_addfld1d (fname='zref', units='m', &
+ avgflag='A', long_name='height of atm reference level', &
+ ptr_lnd=this%forc_hgt_grc)
this%mml_atm_tbot_grc(begg:endg) = spval
- call hist_addfld1d (fname='MML_tbot', units='K', &
- avgflag='A', long_name='MML temperature midpoint of lowest atm layer', &
+ call hist_addfld1d (fname='tbot', units='K', &
+ avgflag='A', long_name='temperature midpoint of lowest atm layer', &
ptr_lnd=this%mml_atm_tbot_grc)
this%mml_atm_thref_grc(begg:endg) = spval
- call hist_addfld1d (fname='MML_thref', units='K', &
- avgflag='A', long_name='MML potential temperature theta at reference height', &
+ call hist_addfld1d (fname='thref', units='K', &
+ avgflag='A', long_name='potential temperature theta at reference height', &
ptr_lnd=this%mml_atm_thref_grc)
- this%mml_atm_qbot_grc(begg:endg) = spval
- call hist_addfld1d (fname='MML_qbot', units='kg/kg', &
- avgflag='A', long_name='MML specific humidity midpoint of lowest atm layer', &
- ptr_lnd=this%mml_atm_qbot_grc)
+ this%forc_q_not_downscaled_grc(begg:endg) = spval
+ call hist_addfld1d (fname='qbot', units='kg/kg', &
+ avgflag='A', long_name='specific humidity midpoint of lowest atm layer', &
+ ptr_lnd=this%forc_q_not_downscaled_grc)
- this%mml_atm_uref_grc(begg:endg) = spval
- call hist_addfld1d (fname='MML_uref', units='m/s', &
- avgflag='A', long_name='MML wind speed at reference height', &
- ptr_lnd=this%mml_atm_uref_grc)
+ this%forc_wind_grc(begg:endg) = spval
+ call hist_addfld1d (fname='uref', units='m/s', &
+ avgflag='A', long_name='wind speed at reference height', &
+ ptr_lnd=this%forc_wind_grc)
- this%mml_atm_eref_grc(begg:endg) = spval
- call hist_addfld1d (fname='MML_eref', units='Pa', &
- avgflag='A', long_name='MML vapor pressure at reference height', &
- ptr_lnd=this%mml_atm_eref_grc)
+ this%forc_vp_grc(begg:endg) = spval
+ call hist_addfld1d (fname='eref', units='Pa', &
+ avgflag='A', long_name='vapor pressure at reference height', &
+ ptr_lnd=this%forc_vp_grc)
- this%mml_atm_pbot_grc(begg:endg) = spval
- call hist_addfld1d (fname='MML_pbot', units='Pa', &
- avgflag='A', long_name='MML atmospheric pressure midpoint of lowest atm layer', &
- ptr_lnd=this%mml_atm_pbot_grc)
+ this%forc_pbot_not_downscaled_grc(begg:endg) = spval
+ call hist_addfld1d (fname='pbot', units='Pa', &
+ avgflag='A', long_name='atmospheric pressure midpoint of lowest atm layer', &
+ ptr_lnd=this%forc_pbot_not_downscaled_grc)
this%mml_atm_psrf_grc(begg:endg) = spval
- call hist_addfld1d (fname='MML_psrf', units='Pa', &
- avgflag='A', long_name='MML atmospheric pressure surface', &
+ call hist_addfld1d (fname='psrf', units='Pa', &
+ avgflag='A', long_name='atmospheric pressure surface', &
ptr_lnd=this%mml_atm_psrf_grc)
this%mml_atm_rhomol_grc(begg:endg) = spval
- call hist_addfld1d (fname='MML_rhomol', units='mol/m3', &
- avgflag='A', long_name='MML molar density of air at reference height', &
+ call hist_addfld1d (fname='rhomol', units='mol/m3', &
+ avgflag='A', long_name='molar density of air at reference height', &
ptr_lnd=this%mml_atm_rhomol_grc)
- this%mml_atm_rhoair_grc(begg:endg) = spval
- call hist_addfld1d (fname='MML_rhoair', units='kg/m3', &
- avgflag='A', long_name='MML mass density of air at reference height', &
- ptr_lnd=this%mml_atm_rhoair_grc)
+ this%forc_rho_not_downscaled_grc(begg:endg) = spval
+ call hist_addfld1d (fname='rhoair', units='kg/m3', &
+ avgflag='A', long_name='mass density of air at reference height', &
+ ptr_lnd=this%forc_rho_not_downscaled_grc)
this%mml_atm_cp_grc(begg:endg) = spval
- call hist_addfld1d (fname='MML_cpair', units='J/kg/K', &
- avgflag='A', long_name='MML specific heat of air at constant pressure at ref height', &
+ call hist_addfld1d (fname='cpair', units='J/kg/K', &
+ avgflag='A', long_name='specific heat of air at constant pressure at ref height', &
ptr_lnd=this%mml_atm_cp_grc)
- this%mml_atm_pco2(begg:endg) = spval
- call hist_addfld1d (fname='MML_pco2', units='Pa', &
- avgflag='A', long_name='MML partial pressure of co2', &
- ptr_lnd=this%mml_atm_pco2)
-
- this%mml_atm_prec_liq_grc(begg:endg) = spval
- call hist_addfld1d (fname='MML_prec_liq', units='mm/s', & ! or mm/s?
- avgflag='A', long_name='MML rate of liquid precipitation (rain)', &
- ptr_lnd=this%mml_atm_prec_liq_grc)
+ this%forc_rain_not_downscaled_grc(begg:endg) = spval
+ call hist_addfld1d (fname='prec_liq', units='mm/s', & ! or mm/s?
+ avgflag='A', long_name='rate of liquid precipitation (rain)', &
+ ptr_lnd=this%forc_rain_not_downscaled_grc)
- this%mml_atm_prec_frz_grc(begg:endg) = spval
- call hist_addfld1d (fname='MML_prec_frz', units='mm/s', &
- avgflag='A', long_name='MML rate of frozen precipitation (snow)', &
- ptr_lnd=this%mml_atm_prec_frz_grc)
+ this%forc_snow_not_downscaled_grc(begg:endg) = spval
+ call hist_addfld1d (fname='prec_frz', units='mm/s', &
+ avgflag='A', long_name='rate of frozen precipitation (snow)', &
+ ptr_lnd=this%forc_snow_not_downscaled_grc)
! Land calculated surface variables
!write(iulog,*) 'MML write to h0: 1d land vars '
this%mml_lnd_ts_grc(begg:endg) = spval
- call hist_addfld1d (fname='MML_ts', units='K', &
- avgflag='A', long_name='MML surface skin temperature', &
+ call hist_addfld1d (fname='ts', units='K', &
+ avgflag='A', long_name='surface skin temperature', &
ptr_lnd=this%mml_lnd_ts_grc)
this%mml_lnd_qs_grc(begg:endg) = spval
- call hist_addfld1d (fname='MML_qs', units='kg/kg', &
+ call hist_addfld1d (fname='qs', units='kg/kg', &
avgflag='A', long_name='surface specific humidity [kg/kg] or [mol/mol]', &
ptr_lnd=this%mml_lnd_qs_grc)
this%mml_lnd_qa_grc(begg:endg) = spval
- call hist_addfld1d (fname='MML_qa', units='W/m2', &
- avgflag='A', long_name='MML radiative forcing (SWin*albedo + LWin)', &
+ call hist_addfld1d (fname='qa', units='W/m2', &
+ avgflag='A', long_name='radiative forcing (SWin*albedo + LWin)', &
ptr_lnd=this%mml_lnd_qa_grc)
this%mml_lnd_swabs_grc(begg:endg) = spval
- call hist_addfld1d (fname='MML_swabs', units='W/m2', &
- avgflag='A', long_name='MML absorbed shortwave radiation', &
+ call hist_addfld1d (fname='swabs', units='W/m2', &
+ avgflag='A', long_name='absorbed shortwave radiation', &
ptr_lnd=this%mml_lnd_swabs_grc)
this%mml_lnd_fsr_grc(begg:endg) = spval
- call hist_addfld1d (fname='MML_fsr', units='W/m2', &
- avgflag='A', long_name='MML reflected shortwave radation', &
+ call hist_addfld1d (fname='fsr', units='W/m2', &
+ avgflag='A', long_name='reflected shortwave radation', &
ptr_lnd=this%mml_lnd_fsr_grc)
this%mml_lnd_fsrnd_grc(begg:endg) = spval
- call hist_addfld1d (fname='MML_fsrnd', units='W/m2', &
- avgflag='A', long_name='MML reflected shortwave nir direct radation', &
+ call hist_addfld1d (fname='fsrnd', units='W/m2', &
+ avgflag='A', long_name='reflected shortwave nir direct radation', &
ptr_lnd=this%mml_lnd_fsrnd_grc)
this%mml_lnd_fsrni_grc(begg:endg) = spval
- call hist_addfld1d (fname='MML_fsrni', units='W/m2', &
- avgflag='A', long_name='MML reflected shortwave nir diffuse radation', &
+ call hist_addfld1d (fname='fsrni', units='W/m2', &
+ avgflag='A', long_name='reflected shortwave nir diffuse radation', &
ptr_lnd=this%mml_lnd_fsrni_grc)
this%mml_lnd_fsrvd_grc(begg:endg) = spval
- call hist_addfld1d (fname='MML_fsrvd', units='W/m2', &
- avgflag='A', long_name='MML reflected shortwave visible direct radation', &
+ call hist_addfld1d (fname='fsrvd', units='W/m2', &
+ avgflag='A', long_name='reflected shortwave visible direct radation', &
ptr_lnd=this%mml_lnd_fsrvd_grc)
this%mml_lnd_fsrvi_grc(begg:endg) = spval
- call hist_addfld1d (fname='MML_fsrvi', units='W/m2', &
- avgflag='A', long_name='MML reflected shortwave visible diffuse radation', &
+ call hist_addfld1d (fname='fsrvi', units='W/m2', &
+ avgflag='A', long_name='reflected shortwave visible diffuse radation', &
ptr_lnd=this%mml_lnd_fsrvi_grc)
this%mml_lnd_lwup_grc(begg:endg) = spval
- call hist_addfld1d (fname='MML_lwup', units='W/m2', &
- avgflag='A', long_name='MML emitted longwave radiation', &
+ call hist_addfld1d (fname='lwup', units='W/m2', &
+ avgflag='A', long_name='emitted longwave radiation', &
ptr_lnd=this%mml_lnd_lwup_grc)
this%mml_lnd_shflx_grc(begg:endg) = spval
- call hist_addfld1d (fname='MML_shflx', units='W/m2', &
- avgflag='A', long_name='MML sensible heat flux', &
+ call hist_addfld1d (fname='shflx', units='W/m2', &
+ avgflag='A', long_name='sensible heat flux', &
ptr_lnd=this%mml_lnd_shflx_grc)
this%mml_lnd_lhflx_grc(begg:endg) = spval
- call hist_addfld1d (fname='MML_lhflx', units='W/m2', &
- avgflag='A', long_name='MML latent heat flux', &
+ call hist_addfld1d (fname='lhflx', units='W/m2', &
+ avgflag='A', long_name='latent heat flux', &
ptr_lnd=this%mml_lnd_lhflx_grc)
this%mml_lnd_gsoi_grc(begg:endg) = spval
- call hist_addfld1d (fname='MML_gsoi', units='W/m2', &
- avgflag='A', long_name='MML flux of energy into the soil', &
+ call hist_addfld1d (fname='gsoi', units='W/m2', &
+ avgflag='A', long_name='flux of energy into the soil', &
ptr_lnd=this%mml_lnd_gsoi_grc)
this%mml_lnd_gsnow_grc(begg:endg) = spval
- call hist_addfld1d (fname='MML_gsnow', units='W/m2', &
- avgflag='A', long_name='MML flux of energy into snowmelt', &
+ call hist_addfld1d (fname='gsnow', units='W/m2', &
+ avgflag='A', long_name='flux of energy into snowmelt', &
ptr_lnd=this%mml_lnd_gsnow_grc)
this%mml_lnd_evap_grc(begg:endg) = spval
- call hist_addfld1d (fname='MML_evap', units='kg H20 / m2 / s = mm/s', &
- avgflag='A', long_name='MML evapotranspiration (in kg water over whole time step)', &
+ call hist_addfld1d (fname='evap', units='kg H20 / m2 / s = mm/s', &
+ avgflag='A', long_name='evapotranspiration (in kg water over whole time step)', &
ptr_lnd=this%mml_lnd_evap_grc)
this%mml_lnd_ustar_grc(begg:endg) = spval
- call hist_addfld1d (fname='MML_ustar', units='m/s', &
- avgflag='A', long_name='MML friction velocity from MO theory', &
+ call hist_addfld1d (fname='ustar', units='m/s', &
+ avgflag='A', long_name='friction velocity from MO theory', &
ptr_lnd=this%mml_lnd_ustar_grc)
this%mml_lnd_tstar_grc(begg:endg) = spval
- call hist_addfld1d (fname='MML_tstar', units='K', &
- avgflag='A', long_name='MML temperature scale from MO theory', &
+ call hist_addfld1d (fname='tstar', units='K', &
+ avgflag='A', long_name='temperature scale from MO theory', &
ptr_lnd=this%mml_lnd_tstar_grc)
this%mml_lnd_qstar_grc(begg:endg) = spval
- call hist_addfld1d (fname='MML_qstar', units='kg/kg', &
- avgflag='A', long_name='MML humidity scale (?) from MO theory', &
+ call hist_addfld1d (fname='qstar', units='kg/kg', &
+ avgflag='A', long_name='humidity scale (?) from MO theory', &
ptr_lnd=this%mml_lnd_qstar_grc)
this%mml_lnd_tvstar_grc(begg:endg) = spval
- call hist_addfld1d (fname='MML_tvstar', units='K', &
- avgflag='A', long_name='MML virtual potential temperature scale from MO theory', &
+ call hist_addfld1d (fname='tvstar', units='K', &
+ avgflag='A', long_name='virtual potential temperature scale from MO theory', &
ptr_lnd=this%mml_lnd_tvstar_grc)
this%mml_lnd_obu_grc(begg:endg) = spval
- call hist_addfld1d (fname='MML_obu', units='m', &
- avgflag='A', long_name='MML Obukhov length from MO theory', &
+ call hist_addfld1d (fname='obu', units='m', &
+ avgflag='A', long_name='Obukhov length from MO theory', &
ptr_lnd=this%mml_lnd_obu_grc)
this%mml_lnd_ram_grc(begg:endg) = spval
- call hist_addfld1d (fname='MML_ram', units='s/m', &
- avgflag='A', long_name='MML aerodynamic resistance for momentum (and moisture; from MO theory)', &
+ call hist_addfld1d (fname='ram', units='s/m', &
+ avgflag='A', long_name='aerodynamic resistance for momentum (and moisture; from MO theory)', &
ptr_lnd=this%mml_lnd_ram_grc)
this%mml_lnd_rah_grc(begg:endg) = spval
- call hist_addfld1d (fname='MML_rah', units='s/m', &
- avgflag='A', long_name='MML aerodynamic resistance for heat', &
+ call hist_addfld1d (fname='rah', units='s/m', &
+ avgflag='A', long_name='aerodynamic resistance for heat', &
ptr_lnd=this%mml_lnd_rah_grc)
this%mml_lnd_res_grc(begg:endg) = spval
- call hist_addfld1d (fname='MML_res_tot', units='s/m', &
- avgflag='A', long_name='MML lid resistance + aerodynamic resistance for heat (MML_evap_rs + MML_rah)', &
+ call hist_addfld1d (fname='res_tot', units='s/m', &
+ avgflag='A', long_name='lid resistance + aerodynamic resistance for heat (evap_rs + rah)', &
ptr_lnd=this%mml_lnd_res_grc)
this%mml_lnd_effective_res_grc(begg:endg) = spval
- call hist_addfld1d (fname='MML_res_effective', units='s/m', &
- avgflag='A', long_name='MML effective surface resistance = 1/beta * (MML_evap_rs + MML_rah)', &
+ call hist_addfld1d (fname='res_effective', units='s/m', &
+ avgflag='A', long_name='effective surface resistance = 1/beta * (evap_rs + rah)', &
ptr_lnd=this%mml_lnd_effective_res_grc)
this%mml_lnd_beta_grc(begg:endg) = spval
- call hist_addfld1d (fname='MML_beta', units='unitless', &
- avgflag='A', long_name='MML beta factor for resistance due to bucket emptiness (between 0 and 1)', &
+ call hist_addfld1d (fname='beta', units='unitless', &
+ avgflag='A', long_name='beta factor for resistance due to bucket emptiness (between 0 and 1)', &
ptr_lnd=this%mml_lnd_beta_grc)
this%mml_lnd_z0m_grc(begg:endg) = spval
- call hist_addfld1d (fname='MML_z0m', units='m', &
- avgflag='A', long_name='MML roughness length for momentum', &
+ call hist_addfld1d (fname='z0m', units='m', &
+ avgflag='A', long_name='roughness length for momentum', &
ptr_lnd=this%mml_lnd_z0m_grc)
this%mml_lnd_z0h_grc(begg:endg) = spval
- call hist_addfld1d (fname='MML_z0h', units='m', &
- avgflag='A', long_name='MML roughness length for heat', &
+ call hist_addfld1d (fname='z0h', units='m', &
+ avgflag='A', long_name='roughness length for heat', &
ptr_lnd=this%mml_lnd_z0h_grc)
this%mml_lnd_alb_grc(begg:endg) = spval
- call hist_addfld1d (fname='MML_alb', units='unitless', &
- avgflag='A', long_name='MML actual albedo (accounting for snow) used', &
+ call hist_addfld1d (fname='alb', units='unitless', &
+ avgflag='A', long_name='actual albedo (accounting for snow) used', &
ptr_lnd=this%mml_lnd_alb_grc)
this%mml_lnd_fsns_grc(begg:endg) = spval
- call hist_addfld1d (fname='MML_fsns', units='W/m2', &
- avgflag='A', long_name='MML net flux of shortwave at surface (in - out), pos into land', &
+ call hist_addfld1d (fname='fsns', units='W/m2', &
+ avgflag='A', long_name='net flux of shortwave at surface (in - out), pos into land', &
ptr_lnd=this%mml_lnd_fsns_grc)
this%mml_lnd_flns_grc(begg:endg) = spval
- call hist_addfld1d (fname='MML_flns', units='W/m2', &
- avgflag='A', long_name='MML net flux of longwave at surface (out-in), pos out of land', &
+ call hist_addfld1d (fname='flns', units='W/m2', &
+ avgflag='A', long_name='net flux of longwave at surface (out-in), pos out of land', &
ptr_lnd=this%mml_lnd_flns_grc)
this%mml_lnd_snowmelt(begg:endg) = spval
- call hist_addfld1d (fname='MML_snowmelt', units='kg/m2', &
- avgflag='A', long_name='MML snow that melted into water bucket', &
+ call hist_addfld1d (fname='snowmelt', units='kg/m2', &
+ avgflag='A', long_name='snow that melted into water bucket', &
ptr_lnd=this%mml_lnd_snowmelt)
! Soil variables
! start 2d
- ! 2d example from SoilBiogeochemCarbonStateType.F90
- !call hist_addfld2d (fname=fieldname, units='gC/m^3', type2d='levdcmp', &
- ! avgflag='A', long_name=longname, &
- ! ptr_col=data2dptr)
-
! I wanted to add an mml case to the type2d, but for now change it back, since its crashing
!write(iulog,*) 'MML write to h0: 2d soil vars '
this%mml_nc_dust_grc(begg:endg,:) = spval
- call hist_addfld2d (fname='MML_dust_2atm', units='unknown', type2d='mml_dust', &
- avgflag='A', long_name='MML surface dust flux to atmosphere ', &
+ call hist_addfld2d (fname='dust_2atm', units='unknown', type2d='mml_dust', &
+ avgflag='A', long_name='surface dust flux to atmosphere ', &
ptr_lnd=this%mml_nc_dust_grc)
this%mml_nc_soil_maxice_grc(begg:endg,:) = spval
- call hist_addfld2d (fname='MML_maxice', units='kg/m3', type2d='mml_lev', &
- avgflag='A', long_name='MML maximum freezable water in each soil layer; for thermal calculations', &
+ call hist_addfld2d (fname='maxice', units='kg/m3', type2d='mml_lev', &
+ avgflag='A', long_name='maximum freezable water in each soil layer; for thermal calculations', &
ptr_lnd=this%mml_nc_soil_maxice_grc)
this%mml_nc_soil_levels_grc(begg:endg,:) = spval
- call hist_addfld2d (fname='MML_soilz', units='m', type2d='mml_lev', &
- avgflag='A', long_name='MML depth (negative) from surface of midpoint of each soil layer', &
+ call hist_addfld2d (fname='soilz', units='m', type2d='mml_lev', &
+ avgflag='A', long_name='depth (negative) from surface of midpoint of each soil layer', &
ptr_lnd=this%mml_nc_soil_levels_grc, mml_dim=mml_nsoi)
this%mml_soil_t_grc(begg:endg,:) = spval
- call hist_addfld2d (fname='MML_soil_t', units='K', type2d='mml_lev', &
- avgflag='A', long_name='MML soil temperature at each layer', &
+ call hist_addfld2d (fname='soil_t', units='K', type2d='mml_lev', &
+ avgflag='A', long_name='soil temperature at each layer', &
ptr_lnd=this%mml_soil_t_grc, mml_dim=mml_nsoi)
this%mml_soil_liq_grc(begg:endg,:) = spval
- call hist_addfld2d (fname='MML_soil_liq', units='kg/m2', type2d='mml_lev', &
- avgflag='A', long_name='MML kg of liquid water in each soil layer (Thermodynamic ONLY)', &
+ call hist_addfld2d (fname='soil_liq', units='kg/m2', type2d='mml_lev', &
+ avgflag='A', long_name='kg of liquid water in each soil layer (Thermodynamic ONLY)', &
ptr_lnd=this%mml_soil_liq_grc, mml_dim=mml_nsoi)
this%mml_soil_ice_grc(begg:endg,:) = spval
- call hist_addfld2d (fname='MML_soil_ice', units='kg/m2', type2d='mml_lev', &
- avgflag='A', long_name='MML kg of frozen water in each soil layer (Thermodynamic ONLY)', &
+ call hist_addfld2d (fname='soil_ice', units='kg/m2', type2d='mml_lev', &
+ avgflag='A', long_name='kg of frozen water in each soil layer (Thermodynamic ONLY)', &
ptr_lnd=this%mml_soil_ice_grc, mml_dim=mml_nsoi)
this%mml_soil_dz_grc(begg:endg,:) = spval
- call hist_addfld2d (fname='MML_dz', units='m', type2d='mml_lev', &
- avgflag='A', long_name='MML thickness of each soil layer', &
+ call hist_addfld2d (fname='dz', units='m', type2d='mml_lev', &
+ avgflag='A', long_name='thickness of each soil layer', &
ptr_lnd=this%mml_soil_dz_grc, mml_dim=mml_nsoi)
this%mml_soil_zh_grc(begg:endg,:) = spval
- call hist_addfld2d (fname='MML_zh', units='m', type2d='mml_lev', &
- avgflag='A', long_name='MML soil depth at interface between each soil layer', &
+ call hist_addfld2d (fname='zh', units='m', type2d='mml_lev', &
+ avgflag='A', long_name='soil depth at interface between each soil layer', &
ptr_lnd=this%mml_soil_zh_grc, mml_dim=mml_nsoi)
this%mml_soil_tk_grc(begg:endg,:) = spval
- call hist_addfld2d (fname='MML_tk', units='W/m/K', type2d='mml_lev', &
- avgflag='A', long_name='MML thermal conductivity of each soil layer', &
+ call hist_addfld2d (fname='tk', units='W/m/K', type2d='mml_lev', &
+ avgflag='A', long_name='thermal conductivity of each soil layer', &
ptr_lnd=this%mml_soil_tk_grc, mml_dim=mml_nsoi)
this%mml_soil_tk_1d_grc(begg:endg) = spval
- call hist_addfld1d (fname='MML_tk_1d', units='W/m/K', &
- avgflag='A', long_name='MML thermal resistance of every soil layer', &
+ call hist_addfld1d (fname='tk_1d', units='W/m/K', &
+ avgflag='A', long_name='thermal resistance of every soil layer', &
ptr_lnd=this%mml_soil_tk_1d_grc)
this%mml_soil_tkh_grc(begg:endg,:) = spval
- call hist_addfld2d (fname='MML_tkh', units='W/m/K', type2d='mml_lev', &
- avgflag='A', long_name='MML thermal conductivity at bottom boundary of each soil layer', &
+ call hist_addfld2d (fname='tkh', units='W/m/K', type2d='mml_lev', &
+ avgflag='A', long_name='thermal conductivity at bottom boundary of each soil layer', &
ptr_lnd=this%mml_soil_tkh_grc, mml_dim=mml_nsoi)
this%mml_soil_dtsoi_grc(begg:endg,:) = spval
- call hist_addfld2d (fname='MML_dtsoi', units='K', type2d='mml_lev', &
- avgflag='A', long_name='MML temperature tendency in each soil layer', &
+ call hist_addfld2d (fname='dtsoi', units='K', type2d='mml_lev', &
+ avgflag='A', long_name='temperature tendency in each soil layer', &
ptr_lnd=this%mml_soil_dtsoi_grc, mml_dim=mml_nsoi)
this%mml_soil_cv_grc(begg:endg,:) = spval
- call hist_addfld2d (fname='MML_cv', units='J/m3/K', type2d='mml_lev', &
- avgflag='A', long_name='MML heat capacity of each soil layer (depends on soil type)', &
+ call hist_addfld2d (fname='cv', units='J/m3/K', type2d='mml_lev', &
+ avgflag='A', long_name='heat capacity of each soil layer (depends on soil type)', &
ptr_lnd=this%mml_soil_cv_grc, mml_dim=mml_nsoi)
this%mml_soil_cv_1d_grc(begg:endg) = spval
- call hist_addfld1d (fname='MML_cv_1d', units='J/m3/K', &
- avgflag='A', long_name='MML heat capacity of every soil layer', &
+ call hist_addfld1d (fname='cv_1d', units='J/m3/K', &
+ avgflag='A', long_name='heat capacity of every soil layer', &
ptr_lnd=this%mml_soil_cv_1d_grc)
this%mml_glc_tk_1d_grc(begg:endg) = spval
- call hist_addfld1d (fname='MML_glc_tk_1d', units='W/m/K', &
- avgflag='A', long_name='MML thermal resistance of every ice layer where glaciated', &
+ call hist_addfld1d (fname='glc_tk_1d', units='W/m/K', &
+ avgflag='A', long_name='thermal resistance of every ice layer where glaciated', &
ptr_lnd=this%mml_glc_tk_1d_grc)
this%mml_glc_cv_1d_grc(begg:endg) = spval
- call hist_addfld1d (fname='MML_glc_cv_1d', units='J/m3/K', &
- avgflag='A', long_name='MML heat capacity of every ice layer where glaciated', &
+ call hist_addfld1d (fname='glc_cv_1d', units='J/m3/K', &
+ avgflag='A', long_name='heat capacity of every ice layer where glaciated', &
ptr_lnd=this%mml_glc_cv_1d_grc)
! end 2d
@@ -1472,126 +917,126 @@ subroutine InitHistory(this, bounds)
!write(iulog,*) 'MML write to h0: 1d soil vars '
this%mml_soil_water_grc(begg:endg) = spval
- call hist_addfld1d (fname='MML_water', units='kg/m2', &
- avgflag='A', long_name='MML total amount of liquid water in soil bucket (hydrology)', &
+ call hist_addfld1d (fname='water', units='kg/m2', &
+ avgflag='A', long_name='total amount of liquid water in soil bucket (hydrology)', &
ptr_lnd=this%mml_soil_water_grc)
this%mml_soil_snow_grc(begg:endg) = spval
- call hist_addfld1d (fname='MML_snow', units='kg/m2', &
- avgflag='A', long_name='MML total amount of snow in snow bucket (hydrology)', &
+ call hist_addfld1d (fname='snow', units='kg/m2', &
+ avgflag='A', long_name='total amount of snow in snow bucket (hydrology)', &
ptr_lnd=this%mml_soil_snow_grc)
this%mml_soil_runoff_grc(begg:endg) = spval
- call hist_addfld1d (fname='MML_runoff', units='kg/m2', &
- avgflag='A', long_name='MML water in excess of bucket capacity (runoff, but it disappears)', &
+ call hist_addfld1d (fname='runoff', units='kg/m2', &
+ avgflag='A', long_name='water in excess of bucket capacity (runoff, but it disappears)', &
ptr_lnd=this%mml_soil_runoff_grc)
! lnd2atm MML vars
this%mml_out_tref2m_grc(begg:endg) = spval
- call hist_addfld1d (fname='MML_l2a_tref2m', units='K', &
- avgflag='A', long_name='MML 2m ref height temperature calculated from tsrf and tstar', &
+ call hist_addfld1d (fname='l2a_tref2m', units='K', &
+ avgflag='A', long_name='2m ref height temperature calculated from tsrf and tstar', &
ptr_lnd=this%mml_out_tref2m_grc)
this%mml_out_qref2m_grc(begg:endg) = spval
- call hist_addfld1d (fname='MML_l2a_qref2m', units='kg/kg', &
- avgflag='A', long_name='MML 2m ref height humidity calculated from qsrf and qstar', &
+ call hist_addfld1d (fname='l2a_qref2m', units='kg/kg', &
+ avgflag='A', long_name='2m ref height humidity calculated from qsrf and qstar', &
ptr_lnd=this%mml_out_qref2m_grc)
this%mml_out_uref10m_grc(begg:endg) = spval
- call hist_addfld1d (fname='MML_l2a_uref10m', units='m/s', &
- avgflag='A', long_name='MML 10m ref wind calculated from ustar', &
+ call hist_addfld1d (fname='l2a_uref10m', units='m/s', &
+ avgflag='A', long_name='10m ref wind calculated from ustar', &
ptr_lnd=this%mml_out_uref10m_grc)
this%mml_out_taux(begg:endg) = spval
- call hist_addfld1d (fname='MML_l2a_taux', units='m/s', &
- avgflag='A', long_name='MML zonal surface stress ', &
+ call hist_addfld1d (fname='l2a_taux', units='m/s', &
+ avgflag='A', long_name='zonal surface stress ', &
ptr_lnd=this%mml_out_taux)
this%mml_out_tauy(begg:endg) = spval
- call hist_addfld1d (fname='MML_l2a_tauy', units='m/s', &
- avgflag='A', long_name='MML meridional surface stress ', &
+ call hist_addfld1d (fname='l2a_tauy', units='m/s', &
+ avgflag='A', long_name='meridional surface stress ', &
ptr_lnd=this%mml_out_tauy)
! MML check if latent heat flux is larger than atm can support (giant dew)
this%mml_q_excess(begg:endg) = spval
- call hist_addfld1d (fname='MML_q_excess', units='kg/m2/s', &
- avgflag='A', long_name='MML over-demand of dew (positive downwards) by land from atmosphere', &
+ call hist_addfld1d (fname='q_excess', units='kg/m2/s', &
+ avgflag='A', long_name='over-demand of dew (positive downwards) by land from atmosphere', &
ptr_lnd=this%mml_q_excess)
this%mml_lh_excess(begg:endg) = spval
- call hist_addfld1d (fname='MML_lh_excess', units='W/m2', &
- avgflag='A', long_name='MML over-demand of latent heat flux (dew; positive downwards) by land from atmosphere', &
+ call hist_addfld1d (fname='lh_excess', units='W/m2', &
+ avgflag='A', long_name='over-demand of latent heat flux (dew; positive downwards) by land from atmosphere', &
ptr_lnd=this%mml_lh_excess)
this%mml_q_demand(begg:endg) = spval
- call hist_addfld1d (fname='MML_q_demand', units='kg/m2/s', &
- avgflag='A', long_name='MML initial demand of water flux by land from atmosphere (before correction for excess dew)', &
+ call hist_addfld1d (fname='q_demand', units='kg/m2/s', &
+ avgflag='A', long_name='initial demand of water flux by land from atmosphere (before correction for excess dew)', &
ptr_lnd=this%mml_q_demand)
this%mml_lh_demand(begg:endg) = spval
- call hist_addfld1d (fname='MML_lh_demand', units='W/m2', &
- avgflag='A', long_name='MML initial demand of latent heat flux by land from atmosphere (before correction for excess dew)', &
+ call hist_addfld1d (fname='lh_demand', units='W/m2', &
+ avgflag='A', long_name='initial demand of latent heat flux by land from atmosphere (before correction for excess dew)', &
ptr_lnd=this%mml_lh_demand)
! mml diagnostic vars (temproary)
this%mml_diag1_1d_grc(begg:endg) = spval
- call hist_addfld1d (fname='MML_diag1_1d', units='n/a', &
- avgflag='A', long_name='MML temporary 1d diagnostic var 1', &
+ call hist_addfld1d (fname='diag1_1d', units='n/a', &
+ avgflag='A', long_name='temporary 1d diagnostic var 1', &
ptr_lnd=this%mml_diag1_1d_grc)
this%mml_diag2_1d_grc(begg:endg) = spval
- call hist_addfld1d (fname='MML_diag2_1d', units='n/a', &
- avgflag='A', long_name='MML temporary 1d diagnostic var 2', &
+ call hist_addfld1d (fname='diag2_1d', units='n/a', &
+ avgflag='A', long_name='temporary 1d diagnostic var 2', &
ptr_lnd=this%mml_diag2_1d_grc)
this%mml_diag3_1d_grc(begg:endg) = spval
- call hist_addfld1d (fname='MML_diag3_1d', units='n/a', &
- avgflag='A', long_name='MML temporary 1d diagnostic var 3', &
+ call hist_addfld1d (fname='diag3_1d', units='n/a', &
+ avgflag='A', long_name='temporary 1d diagnostic var 3', &
ptr_lnd=this%mml_diag3_1d_grc)
this%mml_diag1_2d_grc(begg:endg,:) = spval
- call hist_addfld2d (fname='MML_diag1_2d', units='n/a', type2d='mml_lev', &
- avgflag='A', long_name='MML temporary 2d diagnostic var 1', &
+ call hist_addfld2d (fname='diag1_2d', units='n/a', type2d='mml_lev', &
+ avgflag='A', long_name='temporary 2d diagnostic var 1', &
ptr_lnd=this%mml_diag1_2d_grc, mml_dim=mml_nsoi)
this%mml_diag2_2d_grc(begg:endg,:) = spval
- call hist_addfld2d (fname='MML_diag2_2d', units='n/a', type2d='mml_lev', &
- avgflag='A', long_name='MML temporary 2d diagnostic var 2', &
+ call hist_addfld2d (fname='diag2_2d', units='n/a', type2d='mml_lev', &
+ avgflag='A', long_name='temporary 2d diagnostic var 2', &
ptr_lnd=this%mml_diag2_2d_grc, mml_dim=mml_nsoi)
this%mml_diag3_2d_grc(begg:endg,:) = spval
- call hist_addfld2d (fname='MML_diag3_2d', units='n/a', type2d='mml_lev', &
- avgflag='A', long_name='MML temporary 2d diagnostic var 3', &
+ call hist_addfld2d (fname='diag3_2d', units='n/a', type2d='mml_lev', &
+ avgflag='A', long_name='temporary 2d diagnostic var 3', &
ptr_lnd=this%mml_diag3_2d_grc, mml_dim=mml_nsoi)
! mml error flux/balance vars
this%mml_err_h2o(begg:endg) = spval
- call hist_addfld1d (fname='mml_err_h2o', units='n/a', &
- avgflag='A', long_name='MML total water conservation error', &
+ call hist_addfld1d (fname='err_h2o', units='n/a', &
+ avgflag='A', long_name='total water conservation error', &
ptr_lnd=this%mml_err_h2o)
this%mml_err_h2osno(begg:endg) = spval
- call hist_addfld1d (fname='mml_err_h2osno', units='n/a', &
- avgflag='A', long_name='MML imbalance in snow depth (liquid water)', &
+ call hist_addfld1d (fname='err_h2osno', units='n/a', &
+ avgflag='A', long_name='imbalance in snow depth (liquid water)', &
ptr_lnd=this%mml_err_h2osno)
this%mml_err_seb(begg:endg) = spval
- call hist_addfld1d (fname='mml_err_seb', units='n/a', &
- avgflag='A', long_name='MML surface energy conservation error', &
+ call hist_addfld1d (fname='err_seb', units='n/a', &
+ avgflag='A', long_name='surface energy conservation error', &
ptr_lnd=this%mml_err_seb)
this%mml_err_soi(begg:endg) = spval
- call hist_addfld1d (fname='mml_err_soi', units='n/a', &
- avgflag='A', long_name='MML soil/lake energy conservation error', &
+ call hist_addfld1d (fname='err_soi', units='n/a', &
+ avgflag='A', long_name='soil/lake energy conservation error', &
ptr_lnd=this%mml_err_soi)
this%mml_err_sol(begg:endg) = spval
- call hist_addfld1d (fname='mml_err_sol', units='n/a', &
- avgflag='A', long_name='MML solar radiation conservation error', &
+ call hist_addfld1d (fname='err_sol', units='n/a', &
+ avgflag='A', long_name='solar radiation conservation error', &
ptr_lnd=this%mml_err_sol)
@@ -1601,66 +1046,6 @@ subroutine InitHistory(this, bounds)
! End MML simple land model added variables
!-----------------------------------------------------------------------
-
- ! Time averaged quantities
- this%fsi24_patch(begp:endp) = spval
- call hist_addfld1d (fname='FSI24', units='K', &
- avgflag='A', long_name='indirect radiation (last 24hrs)', &
- ptr_patch=this%fsi24_patch, default='inactive')
-
- this%fsi240_patch(begp:endp) = spval
- call hist_addfld1d (fname='FSI240', units='K', &
- avgflag='A', long_name='indirect radiation (last 240hrs)', &
- ptr_patch=this%fsi240_patch, default='inactive')
-
- this%fsd24_patch(begp:endp) = spval
- call hist_addfld1d (fname='FSD24', units='K', &
- avgflag='A', long_name='direct radiation (last 24hrs)', &
- ptr_patch=this%fsd24_patch, default='inactive')
-
- this%fsd240_patch(begp:endp) = spval
- call hist_addfld1d (fname='FSD240', units='K', &
- avgflag='A', long_name='direct radiation (last 240hrs)', &
- ptr_patch=this%fsd240_patch, default='inactive')
-
- if (use_cn) then
- this%rh30_patch(begp:endp) = spval
- call hist_addfld1d (fname='RH30', units='%', &
- avgflag='A', long_name='30-day running mean of relative humidity', &
- ptr_patch=this%rh30_patch, default='inactive')
-
- this%prec10_patch(begp:endp) = spval
- call hist_addfld1d (fname='PREC10', units='MM H2O/S', &
- avgflag='A', long_name='10-day running mean of PREC', &
- ptr_patch=this%prec10_patch, default='inactive')
-
- this%prec60_patch(begp:endp) = spval
- call hist_addfld1d (fname='PREC60', units='MM H2O/S', &
- avgflag='A', long_name='60-day running mean of PREC', &
- ptr_patch=this%prec60_patch, default='inactive')
- end if
-
- if (use_cndv) then
- call hist_addfld1d (fname='TDA', units='K', &
- avgflag='A', long_name='daily average 2-m temperature', &
- ptr_patch=this%t_mo_patch)
- end if
-
- if(use_luna)then
- this%forc_pco2_240_patch = spval
- call hist_addfld1d (fname='PCO2_240', units='Pa', &
- avgflag='A', long_name='10 day running mean of CO2 pressure', &
- ptr_patch=this%forc_pco2_240_patch, default='inactive')
- this%forc_po2_240_patch = spval
- call hist_addfld1d (fname='PO2_240', units='Pa', &
- avgflag='A', long_name='10 day running mean of O2 pressure', &
- ptr_patch=this%forc_po2_240_patch, default='inactive')
- this%forc_pbot240_downscaled_patch = spval
- call hist_addfld1d (fname='PBOT_240', units='Pa', &
- avgflag='A', long_name='10 day running mean of air pressure', &
- ptr_patch=this%forc_pbot240_downscaled_patch, default='inactive')
- endif
-
end subroutine InitHistory
!-----------------------------------------------------------------------
@@ -1853,368 +1238,114 @@ end subroutine InitCold
! MML: InitAccBuffer sounds like what I actually want... unless it only initializes a
! value with the necessity of having a r0 file overwrite it.
!-----------------------------------------------------------------------
- subroutine InitAccBuffer (this, bounds)
- !
- ! !DESCRIPTION:
- ! Initialize accumulation buffer for all required module accumulated fields
- ! This routine set defaults values that are then overwritten by the
- ! restart file for restart or branch runs
- !
- ! !USES
- use clm_varcon , only : spval
- use accumulMod , only : init_accum_field
- !
- ! !ARGUMENTS:
- class(atm2lnd_type) :: this
- type(bounds_type), intent(in) :: bounds
- !---------------------------------------------------------------------
-
- this%fsd24_patch(bounds%begp:bounds%endp) = spval
- call init_accum_field (name='FSD24', units='W/m2', &
- desc='24hr average of direct solar radiation', accum_type='runmean', accum_period=-1, &
- subgrid_type='pft', numlev=1, init_value=0._r8)
-
- this%fsd240_patch(bounds%begp:bounds%endp) = spval
- call init_accum_field (name='FSD240', units='W/m2', &
- desc='240hr average of direct solar radiation', accum_type='runmean', accum_period=-10, &
- subgrid_type='pft', numlev=1, init_value=0._r8)
-
- this%fsi24_patch(bounds%begp:bounds%endp) = spval
- call init_accum_field (name='FSI24', units='W/m2', &
- desc='24hr average of diffuse solar radiation', accum_type='runmean', accum_period=-1, &
- subgrid_type='pft', numlev=1, init_value=0._r8)
-
- this%fsi240_patch(bounds%begp:bounds%endp) = spval
- call init_accum_field (name='FSI240', units='W/m2', &
- desc='240hr average of diffuse solar radiation', accum_type='runmean', accum_period=-10, &
- subgrid_type='pft', numlev=1, init_value=0._r8)
-
- if (use_cn) then
- call init_accum_field (name='PREC10', units='MM H2O/S', &
- desc='10-day running mean of total precipitation', accum_type='runmean', accum_period=-10, &
- subgrid_type='pft', numlev=1, init_value=0._r8)
-
- call init_accum_field (name='PREC60', units='MM H2O/S', &
- desc='60-day running mean of total precipitation', accum_type='runmean', accum_period=-60, &
- subgrid_type='pft', numlev=1, init_value=0._r8)
-
- call init_accum_field (name='RH30', units='%', &
- desc='30-day running mean of relative humidity', accum_type='runmean', accum_period=-30, &
- subgrid_type='pft', numlev=1, init_value=100._r8)
- end if
-
- if (use_cndv) then
- ! The following is a running mean with the accumulation period is set to -365 for a 365-day running mean.
- call init_accum_field (name='PREC365', units='MM H2O/S', &
- desc='365-day running mean of total precipitation', accum_type='runmean', accum_period=-365, &
- subgrid_type='column', numlev=1, init_value=0._r8)
- end if
-
- if ( use_fates ) then
- call init_accum_field (name='PREC24', units='m', &
- desc='24hr sum of precipitation', accum_type='runmean', accum_period=-1, &
- subgrid_type='pft', numlev=1, init_value=0._r8)
-
- ! Fudge - this neds to be initialized from the restat file eventually.
- call init_accum_field (name='RH24', units='m', &
- desc='24hr average of RH', accum_type='runmean', accum_period=-1, &
- subgrid_type='pft', numlev=1, init_value=100._r8)
-
- call init_accum_field (name='WIND24', units='m', &
- desc='24hr average of wind', accum_type='runmean', accum_period=-1, &
- subgrid_type='pft', numlev=1, init_value=0._r8)
- end if
-
- if(use_luna) then
- this%forc_po2_240_patch(bounds%begp:bounds%endp) = spval
- call init_accum_field (name='po2_240', units='Pa', &
- desc='10-day running mean of parial O2 pressure', accum_type='runmean', accum_period=-10, &
- subgrid_type='pft', numlev=1, init_value=21223._r8)
-
- this%forc_pco2_240_patch(bounds%begp:bounds%endp) = spval
- call init_accum_field (name='pco2_240', units='Pa', &
- desc='10-day running mean of parial CO2 pressure', accum_type='runmean', accum_period=-10, &
- subgrid_type='pft', numlev=1, init_value=28._r8)
-
- this%forc_pbot240_downscaled_patch(bounds%begp:bounds%endp) = spval
- call init_accum_field (name='pbot240', units='Pa', &
- desc='10-day running mean of air pressure', accum_type='runmean', accum_period=-10, &
- subgrid_type='pft', numlev=1, init_value=101325._r8)
-
- endif
-
- end subroutine InitAccBuffer
-
- !-----------------------------------------------------------------------
- subroutine InitAccVars(this, bounds)
- !
- ! !DESCRIPTION:
- ! Initialize module variables that are associated with
- ! time accumulated fields. This routine is called for both an initial run
- ! and a restart run (and must therefore must be called after the restart file
- ! is read in and the accumulation buffer is obtained)
- !
- ! !USES
- use accumulMod , only : extract_accum_field
- use clm_time_manager , only : get_nstep
- !
- ! !ARGUMENTS:
- class(atm2lnd_type) :: this
- type(bounds_type), intent(in) :: bounds
- !
- ! !LOCAL VARIABLES:
- integer :: begp, endp
- integer :: begc, endc
- integer :: nstep
- integer :: ier
- real(r8), pointer :: rbufslp(:) ! temporary
- real(r8), pointer :: rbufslc(:) ! temporary
- !---------------------------------------------------------------------
-
- begp = bounds%begp; endp = bounds%endp
- begc = bounds%begc; endc = bounds%endc
-
- ! Allocate needed dynamic memory for single level patch field
- allocate(rbufslp(begp:endp), stat=ier)
- if (ier/=0) then
- write(iulog,*)' in '
- call endrun(msg="InitAccVars allocation error for rbufslp"//&
- errMsg(sourcefile, __LINE__))
- endif
- ! Allocate needed dynamic memory for single level col field
- allocate(rbufslc(begc:endc), stat=ier)
- if (ier/=0) then
- write(iulog,*)' in '
- call endrun(msg="InitAccVars allocation error for rbufslc"//&
- errMsg(sourcefile, __LINE__))
- endif
-
- ! Determine time step
- nstep = get_nstep()
-
- call extract_accum_field ('FSD24', rbufslp, nstep)
- this%fsd24_patch(begp:endp) = rbufslp(begp:endp)
-
- call extract_accum_field ('FSD240', rbufslp, nstep)
- this%fsd240_patch(begp:endp) = rbufslp(begp:endp)
-
- call extract_accum_field ('FSI24', rbufslp, nstep)
- this%fsi24_patch(begp:endp) = rbufslp(begp:endp)
-
- call extract_accum_field ('FSI240', rbufslp, nstep)
- this%fsi240_patch(begp:endp) = rbufslp(begp:endp)
-
- if (use_cn) then
- call extract_accum_field ('PREC10', rbufslp, nstep)
- this%prec10_patch(begp:endp) = rbufslp(begp:endp)
-
- call extract_accum_field ('PREC60', rbufslp, nstep)
- this%prec60_patch(begp:endp) = rbufslp(begp:endp)
-
- call extract_accum_field ('RH30', rbufslp, nstep)
- this%rh30_patch(begp:endp) = rbufslp(begp:endp)
- end if
-
- if (use_cndv) then
- call extract_accum_field ('PREC365' , rbufslc, nstep)
- this%prec365_col(begc:endc) = rbufslc(begc:endc)
-
- call extract_accum_field ('TDA', rbufslp, nstep)
- this%t_mo_patch(begp:endp) = rbufslp(begp:endp)
- end if
-
- if (use_fates) then
- call extract_accum_field ('PREC24', rbufslp, nstep)
- this%prec24_patch(begp:endp) = rbufslp(begp:endp)
-
- call extract_accum_field ('RH24', rbufslp, nstep)
- this%rh24_patch(begp:endp) = rbufslp(begp:endp)
-
- call extract_accum_field ('WIND24', rbufslp, nstep)
- this%wind24_patch(begp:endp) = rbufslp(begp:endp)
- end if
-
- if(use_luna) then
- call extract_accum_field ('po2_240', rbufslp, nstep)
- this%forc_po2_240_patch(begp:endp) = rbufslp(begp:endp)
-
- call extract_accum_field ('pco2_240', rbufslp, nstep)
- this%forc_pco2_240_patch(begp:endp) = rbufslp(begp:endp)
-
- call extract_accum_field ('pbot240', rbufslp, nstep)
- this%forc_pbot240_downscaled_patch(begp:endp) = rbufslp(begp:endp)
-
- endif
-
- deallocate(rbufslp)
- deallocate(rbufslc)
-
- end subroutine InitAccVars
-
- !-----------------------------------------------------------------------
- subroutine UpdateAccVars (this, bounds)
- !
- ! USES
- use clm_time_manager, only : get_nstep
- use accumulMod , only : update_accum_field, extract_accum_field
- !
- ! !ARGUMENTS:
- class(atm2lnd_type) :: this
- type(bounds_type) , intent(in) :: bounds
- !
- ! !LOCAL VARIABLES:
- integer :: g,c,p ! indices
- integer :: dtime ! timestep size [seconds]
- integer :: nstep ! timestep number
- integer :: ier ! error status
- integer :: begp, endp
- integer :: begc, endc
- real(r8), pointer :: rbufslp(:) ! temporary single level - patch level
- real(r8), pointer :: rbufslc(:) ! temporary single level - column level
- !---------------------------------------------------------------------
-
- begp = bounds%begp; endp = bounds%endp
- begc = bounds%begc; endc = bounds%endc
-
- nstep = get_nstep()
-
- ! Allocate needed dynamic memory for single level patch field
- allocate(rbufslp(begp:endp), stat=ier)
- if (ier/=0) then
- write(iulog,*)'UpdateAccVars allocation error for rbufslp'
- call endrun(msg=errMsg(sourcefile, __LINE__))
- endif
- ! Allocate needed dynamic memory for single level col field
- allocate(rbufslc(begc:endc), stat=ier)
- if (ier/=0) then
- write(iulog,*)'UpdateAccVars allocation error for rbufslc'
- call endrun(msg=errMsg(sourcefile, __LINE__))
- endif
-
- ! Accumulate and extract forc_solad24 & forc_solad240
- do p = begp,endp
- g = patch%gridcell(p)
- rbufslp(p) = this%forc_solad_grc(g,1)
- end do
- call update_accum_field ('FSD240', rbufslp , nstep)
- call extract_accum_field ('FSD240', this%fsd240_patch , nstep)
- call update_accum_field ('FSD24' , rbufslp , nstep)
- call extract_accum_field ('FSD24' , this%fsd24_patch , nstep)
-
- ! Accumulate and extract forc_solai24 & forc_solai240
- do p = begp,endp
- g = patch%gridcell(p)
- rbufslp(p) = this%forc_solai_grc(g,1)
- end do
- call update_accum_field ('FSI24' , rbufslp , nstep)
- call extract_accum_field ('FSI24' , this%fsi24_patch , nstep)
- call update_accum_field ('FSI240', rbufslp , nstep)
- call extract_accum_field ('FSI240', this%fsi240_patch , nstep)
-
- ! Precipitation accumulators
- !
- ! For CNDV, we use a column-level accumulator. We cannot use a patch-level
- ! accumulator for CNDV because this is used for establishment, so must be available
- ! for inactive patches. In principle, we could/should switch to column-level for the
- ! other precip accumulators, too; we'd just need to be careful about backwards
- ! compatibility with old restart files.
-
- do p = begp,endp
- c = patch%column(p)
- rbufslp(p) = this%forc_rain_downscaled_col(c) + this%forc_snow_downscaled_col(c)
- rbufslc(c) = this%forc_rain_downscaled_col(c) + this%forc_snow_downscaled_col(c)
- end do
-
- if (use_cn) then
- ! Accumulate and extract PREC60 (accumulates total precipitation as 60-day running mean)
- call update_accum_field ('PREC60', rbufslp, nstep)
- call extract_accum_field ('PREC60', this%prec60_patch, nstep)
-
- ! Accumulate and extract PREC10 (accumulates total precipitation as 10-day running mean)
- call update_accum_field ('PREC10', rbufslp, nstep)
- call extract_accum_field ('PREC10', this%prec10_patch, nstep)
- end if
-
- if (use_cndv) then
- ! Accumulate and extract PREC365 (accumulates total precipitation as 365-day running mean)
- ! See above comment regarding why this is at the column-level despite other prec
- ! accumulators being at the patch level.
- call update_accum_field ('PREC365', rbufslc, nstep)
- call extract_accum_field ('PREC365', this%prec365_col, nstep)
-
- ! Accumulate and extract TDA (accumulates TBOT as 30-day average) and
- ! also determines t_mo_min
-
- do p = begp,endp
- c = patch%column(p)
- rbufslp(p) = this%forc_t_downscaled_col(c)
- end do
- call update_accum_field ('TDA', rbufslp, nstep)
- call extract_accum_field ('TDA', rbufslp, nstep)
- do p = begp,endp
- this%t_mo_patch(p) = rbufslp(p)
- this%t_mo_min_patch(p) = min(this%t_mo_min_patch(p), rbufslp(p))
- end do
-
- end if
-
- if (use_fates) then
- call update_accum_field ('PREC24', rbufslp, nstep)
- call extract_accum_field ('PREC24', this%prec24_patch, nstep)
-
- do p = bounds%begp,bounds%endp
- g = patch%gridcell(p)
- rbufslp(p) = this%forc_wind_grc(g)
- end do
- call update_accum_field ('WIND24', rbufslp, nstep)
- call extract_accum_field ('WIND24', this%wind24_patch, nstep)
-
- do p = bounds%begp,bounds%endp
- g = patch%gridcell(p)
- rbufslp(p) = this%forc_rh_grc(g)
- end do
- call update_accum_field ('RH24', rbufslp, nstep)
- call extract_accum_field ('RH24', this%rh24_patch, nstep)
- end if
-
- if(use_luna) then
- do p = bounds%begp,bounds%endp
- g = patch%gridcell(p)
- rbufslp(p) = this%forc_pco2_grc(g)
- enddo
- call update_accum_field ('pco2_240', rbufslp, nstep)
- call extract_accum_field ('pco2_240', this%forc_pco2_240_patch, nstep)
-
- do p = bounds%begp,bounds%endp
- g = patch%gridcell(p)
- rbufslp(p) = this%forc_po2_grc(g)
- enddo
- call update_accum_field ('po2_240', rbufslp, nstep)
- call extract_accum_field ('po2_240', this%forc_po2_240_patch, nstep)
-
- do p = bounds%begp,bounds%endp
- c = patch%column(p)
- rbufslp(p) = this%forc_pbot_downscaled_col(c)
- enddo
- call update_accum_field ('pbot240', rbufslp, nstep)
- call extract_accum_field ('pbot240', this%forc_pbot240_downscaled_patch, nstep)
-
- endif
-
- if (use_cn) then
- do p = begp,endp
- g = patch%gridcell(p)
- rbufslp(p) = this%forc_rh_grc(g)
- end do
- ! Accumulate and extract RH30 (accumulates RH as 30-day running mean)
- call update_accum_field ('RH30', rbufslp, nstep)
- call extract_accum_field ('RH30', this%rh30_patch, nstep)
- endif
-
- deallocate(rbufslp)
- deallocate(rbufslc)
-
- end subroutine UpdateAccVars
+! subroutine InitAccBuffer (this, bounds)
+! !
+! ! !DESCRIPTION:
+! ! Initialize accumulation buffer for all required module accumulated fields
+! ! This routine set defaults values that are then overwritten by the
+! ! restart file for restart or branch runs
+! !
+! ! !USES
+! use clm_varcon , only : spval
+! use accumulMod , only : init_accum_field
+! !
+! ! !ARGUMENTS:
+! class(atm2lnd_type) :: this
+! type(bounds_type), intent(in) :: bounds
+! !---------------------------------------------------------------------
+
+! this%fsd240_patch(bounds%begp:bounds%endp) = spval
+! call init_accum_field (name='FSD240', units='W/m2', &
+! desc='240hr average of direct solar radiation', accum_type='runmean', accum_period=-10, &
+! subgrid_type='pft', numlev=1, init_value=0._r8)
+
+! end subroutine InitAccBuffer
+
+! !-----------------------------------------------------------------------
+! subroutine InitAccVars(this, bounds)
+! !
+! ! !DESCRIPTION:
+! ! Initialize module variables that are associated with
+! ! time accumulated fields. This routine is called for both an initial run
+! ! and a restart run (and must therefore must be called after the restart file
+! ! is read in and the accumulation buffer is obtained)
+! !
+! ! !USES
+! use accumulMod , only : extract_accum_field
+! use clm_time_manager , only : get_nstep
+! !
+! ! !ARGUMENTS:
+! class(atm2lnd_type) :: this
+! type(bounds_type), intent(in) :: bounds
+! !
+! ! !LOCAL VARIABLES:
+! integer :: begp, endp
+! integer :: nstep
+! integer :: ier
+! real(r8), pointer :: rbufslp(:) ! temporary
+! !---------------------------------------------------------------------
+
+! begp = bounds%begp; endp = bounds%endp
+
+! ! Allocate needed dynamic memory for single level patch field
+! allocate(rbufslp(begp:endp), stat=ier)
+! if (ier/=0) then
+! write(iulog,*)' in '
+! call endrun(msg="InitAccVars allocation error for rbufslp"//&
+! errMsg(sourcefile, __LINE__))
+! endif
+
+! ! Determine time step
+! nstep = get_nstep()
+
+! call extract_accum_field ('FSD240', rbufslp, nstep)
+! this%fsd240_patch(begp:endp) = rbufslp(begp:endp)
+
+! deallocate(rbufslp)
+
+! end subroutine InitAccVars
+
+! !-----------------------------------------------------------------------
+! subroutine UpdateAccVars (this, bounds)
+! !
+! ! USES
+! use clm_time_manager, only : get_nstep
+! use accumulMod , only : update_accum_field, extract_accum_field
+! !
+! ! !ARGUMENTS:
+! class(atm2lnd_type) :: this
+! type(bounds_type) , intent(in) :: bounds
+! !
+! ! !LOCAL VARIABLES:
+! integer :: g,c,p ! indices
+! integer :: nstep ! timestep number
+! integer :: ier ! error status
+! integer :: begp, endp
+! real(r8), pointer :: rbufslp(:) ! temporary single level - patch level
+! !---------------------------------------------------------------------
+
+! begp = bounds%begp; endp = bounds%endp
+
+! nstep = get_nstep()
+
+! ! Allocate needed dynamic memory for single level patch field
+! allocate(rbufslp(begp:endp), stat=ier)
+! if (ier/=0) then
+! write(iulog,*)'UpdateAccVars allocation error for rbufslp'
+! call endrun(msg=errMsg(sourcefile, __LINE__))
+! endif
+
+! ! Accumulate and extract forc_solad24 & forc_solad240
+! do p = begp,endp
+! g = patch%gridcell(p)
+! rbufslp(p) = this%forc_solad_grc(g,1)
+! end do
+! call update_accum_field ('FSD240', rbufslp , nstep)
+! call extract_accum_field ('FSD240', this%fsd240_patch , nstep)
+
+! deallocate(rbufslp)
+
+! end subroutine UpdateAccVars
!------------------------------------------------------------------------
subroutine Restart(this, bounds, ncid, flag)
@@ -2233,165 +1364,61 @@ subroutine Restart(this, bounds, ncid, flag)
logical :: readvar
!------------------------------------------------------------------------
- call restartvar(ncid=ncid, flag=flag, varname='qflx_floodg', xtype=ncd_double, &
- dim1name='gridcell', &
- long_name='flood water flux', units='mm/s', &
- interpinic_flag='skip', readvar=readvar, data=this%forc_flood_grc)
- if (flag == 'read' .and. .not. readvar) then
- ! initial run, readvar=readvar, not restart: initialize flood to zero
- this%forc_flood_grc = 0._r8
- endif
-
- if (use_cndv) then
- call restartvar(ncid=ncid, flag=flag, varname='T_MO_MIN', xtype=ncd_double, &
- dim1name='pft', long_name='', units='', &
- interpinic_flag='interp', readvar=readvar, data=this%t_mo_min_patch)
- end if
-
- if(use_luna)then
- call restartvar(ncid=ncid, flag=flag, varname='pco2_240', xtype=ncd_double, &
- dim1name='pft', long_name='10-day mean CO2 partial pressure', units='Pa', &
- interpinic_flag='interp', readvar=readvar, data=this%forc_pco2_240_patch )
- call restartvar(ncid=ncid, flag=flag, varname='po2_240', xtype=ncd_double, &
- dim1name='pft', long_name='10-day mean O2 partial pressure', units='Pa', &
- interpinic_flag='interp', readvar=readvar, data=this%forc_po2_240_patch )
- call restartvar(ncid=ncid, flag=flag, varname='pbot240', xtype=ncd_double, &
- dim1name='pft', long_name='10 day mean atmospheric pressure(Pa)', units='Pa', &
- interpinic_flag='interp', readvar=readvar, data=this%forc_pbot240_downscaled_patch )
- endif
-
! -----------------------------------------------------------------------
! Start MML simple land model restart variables section ! MML 2016.01.15
write(iulog,*) ' MML trying to write r 1d restart vars '
! MML: surface
- call restartvar(ncid=ncid, flag=flag, varname='mml_lnd_ts_grc', xtype=ncd_double, &
+ call restartvar(ncid=ncid, flag=flag, varname='lnd_ts_grc', xtype=ncd_double, &
dim1name='gridcell', &
long_name='Surface Temperature for MO', units='K', &
interpinic_flag='skip', readvar=readvar, data=this%mml_lnd_ts_grc)
- call restartvar(ncid=ncid, flag=flag, varname='mml_lnd_qs_grc', xtype=ncd_double, &
+ call restartvar(ncid=ncid, flag=flag, varname='lnd_qs_grc', xtype=ncd_double, &
dim1name='gridcell', &
long_name='surface specific humidity for MO', units='kg/kg', &
interpinic_flag='skip', readvar=readvar, data=this%mml_lnd_qs_grc)
! MML soil:
! MML Hydrology variables:
- call restartvar(ncid=ncid, flag=flag, varname='mml_soil_water_grc', xtype=ncd_double, &
+ call restartvar(ncid=ncid, flag=flag, varname='soil_water_grc', xtype=ncd_double, &
dim1name='gridcell', &
long_name='soil bucket water content', units='kg', &
interpinic_flag='skip', readvar=readvar, data=this%mml_soil_water_grc)
- call restartvar(ncid=ncid, flag=flag, varname='mml_soil_snow_grc', xtype=ncd_double, &
+ call restartvar(ncid=ncid, flag=flag, varname='soil_snow_grc', xtype=ncd_double, &
dim1name='gridcell', &
long_name='snow bucket snow content', units='kg', &
interpinic_flag='skip', readvar=readvar, data=this%mml_soil_snow_grc)
- call restartvar(ncid=ncid, flag=flag, varname='mml_soil_runoff_grc', xtype=ncd_double, &
+ call restartvar(ncid=ncid, flag=flag, varname='soil_runoff_grc', xtype=ncd_double, &
dim1name='gridcell', &
long_name='water runoff', units='kg', &
interpinic_flag='skip', readvar=readvar, data=this%mml_soil_runoff_grc)
! write(iulog,*) 'MML trying to write r 2d restart vars '
! MML Thermodynamic vars for each soil level (3d)
- call restartvar(ncid=ncid, flag=flag, varname='mml_soil_liq_grc', xtype=ncd_double, &
+ call restartvar(ncid=ncid, flag=flag, varname='soil_liq_grc', xtype=ncd_double, &
dim1name='gridcell', dim2name='mml_lev', switchdim=.true., & ! dim2 mml_lev?
long_name='amount of liquid water in each soil layer', units='kg', &
interpinic_flag='skip', readvar=readvar, data=this%mml_soil_liq_grc)
- call restartvar(ncid=ncid, flag=flag, varname='mml_soil_ice_grc', xtype=ncd_double, &
+ call restartvar(ncid=ncid, flag=flag, varname='soil_ice_grc', xtype=ncd_double, &
dim1name='gridcell', dim2name='mml_lev', switchdim=.true., &
long_name='amount of frozen water in each soil layer', units='kg', &
interpinic_flag='skip', readvar=readvar, data=this%mml_soil_ice_grc)
- call restartvar(ncid=ncid, flag=flag, varname='mml_soil_t_grc', xtype=ncd_double, &
+ call restartvar(ncid=ncid, flag=flag, varname='soil_t_grc', xtype=ncd_double, &
dim1name='gridcell', dim2name='mml_lev', switchdim=.true., &
- long_name='MML soil temperature at each layer', units='K', &
+ long_name='soil temperature at each layer', units='K', &
interpinic_flag='skip', readvar=readvar, data=this%mml_soil_t_grc)
- call restartvar(ncid=ncid, flag=flag, varname='mml_soil_dtsoi_grc', xtype=ncd_double, &
+ call restartvar(ncid=ncid, flag=flag, varname='soil_dtsoi_grc', xtype=ncd_double, &
dim1name='gridcell', dim2name='mml_lev', switchdim=.true., &
- long_name='MML temperature tendency in each soil layer', units='K', &
+ long_name='temperature tendency in each soil layer', units='K', &
interpinic_flag='skip', readvar=readvar, data=this%mml_soil_dtsoi_grc)
-
- ! MML nc vars, so if I stop mid-month / mid-day I can still know what that month's nc params are
- call restartvar(ncid=ncid, flag=flag, varname='mml_nc_alb_gvd_grc', xtype=ncd_double, &
- dim1name='gridcell', &
- long_name='Ground visible direct albedo (from netcdf file)', units='none', &
- interpinic_flag='skip', readvar=readvar, data=this%mml_nc_alb_gvd_grc)
-
- call restartvar(ncid=ncid, flag=flag, varname='mml_nc_alb_svd_grc', xtype=ncd_double, &
- dim1name='gridcell', &
- long_name='Snow visible direct albedo (from netcdf file)', units='none', &
- interpinic_flag='skip', readvar=readvar, data=this%mml_nc_alb_svd_grc)
-
- call restartvar(ncid=ncid, flag=flag, varname='mml_nc_alb_gnd_grc', xtype=ncd_double, &
- dim1name='gridcell', &
- long_name='Ground NIR direct albedo (from netcdf file)', units='none', &
- interpinic_flag='skip', readvar=readvar, data=this%mml_nc_alb_gnd_grc)
-
- call restartvar(ncid=ncid, flag=flag, varname='mml_nc_alb_snd_grc', xtype=ncd_double, &
- dim1name='gridcell', &
- long_name='Snow NIR direct albedo (from netcdf file)', units='none', &
- interpinic_flag='skip', readvar=readvar, data=this%mml_nc_alb_snd_grc)
-
- call restartvar(ncid=ncid, flag=flag, varname='mml_nc_alb_gvf_grc', xtype=ncd_double, &
- dim1name='gridcell', &
- long_name='Ground visible diffuse albedo (from netcdf file)', units='none', &
- interpinic_flag='skip', readvar=readvar, data=this%mml_nc_alb_gvf_grc)
-
- call restartvar(ncid=ncid, flag=flag, varname='mml_nc_alb_svf_grc', xtype=ncd_double, &
- dim1name='gridcell', &
- long_name='snow visible diffuse albedo (from netcdf file)', units='none', &
- interpinic_flag='skip', readvar=readvar, data=this%mml_nc_alb_svf_grc)
-
- call restartvar(ncid=ncid, flag=flag, varname='mml_nc_alb_gnf_grc', xtype=ncd_double, &
- dim1name='gridcell', &
- long_name='Ground NIR diffuse albedo (from netcdf file)', units='K', &
- interpinic_flag='skip', readvar=readvar, data=this%mml_nc_alb_gnf_grc)
-
- call restartvar(ncid=ncid, flag=flag, varname='mml_nc_alb_snf_grc', xtype=ncd_double, &
- dim1name='gridcell', &
- long_name='Snow NIR diffuse albedo (from netcdf file)', units='none', &
- interpinic_flag='skip', readvar=readvar, data=this%mml_nc_alb_snf_grc)
-
- call restartvar(ncid=ncid, flag=flag, varname='mml_nc_snowmask_grc', xtype=ncd_double, &
- dim1name='gridcell', &
- long_name='Amount of snow required to fully mask ground albedo (from netcdf file)', units='kg/m2', &
- interpinic_flag='skip', readvar=readvar, data=this%mml_nc_snowmask_grc)
-
- call restartvar(ncid=ncid, flag=flag, varname='mml_nc_evaprs_grc', xtype=ncd_double, &
- dim1name='gridcell', &
- long_name='Evaporative resistance (from netcdf file)', units='s/m', &
- interpinic_flag='skip', readvar=readvar, data=this%mml_nc_evaprs_grc)
-
- call restartvar(ncid=ncid, flag=flag, varname='mml_nc_bucket_cap_grc', xtype=ncd_double, &
- dim1name='gridcell', &
- long_name='Bucket Capacity (from netcdf file)', units='kg/m2', &
- interpinic_flag='skip', readvar=readvar, data=this%mml_nc_bucket_cap_grc)
-
- call restartvar(ncid=ncid, flag=flag, varname='mml_nc_roughness_grc', xtype=ncd_double, &
- dim1name='gridcell', &
- long_name='Surface roughness (vegetation height) (from netcdf file)', units='m', &
- interpinic_flag='skip', readvar=readvar, data=this%mml_nc_roughness_grc)
-
- call restartvar(ncid=ncid, flag=flag, varname='mml_nc_emiss_grc', xtype=ncd_double, &
- dim1name='gridcell', &
- long_name='Surface emissivity (from netcdf file)', units='none', &
- interpinic_flag='skip', readvar=readvar, data=this%mml_nc_emiss_grc)
-
- call restartvar(ncid=ncid, flag=flag, varname='mml_nc_glcmask_grc', xtype=ncd_double, &
- dim1name='gridcell', &
- long_name='Mask of glaciated points (from netcdf file)', units='none', &
- interpinic_flag='skip', readvar=readvar, data=this%mml_nc_glcmask_grc)
-
- call restartvar(ncid=ncid, flag=flag, varname='mml_nc_dust_grc', xtype=ncd_double, &
- dim1name='gridcell', &
- long_name='Dust flux to atm (from netcdf file)', units='unknown', &
- interpinic_flag='skip', readvar=readvar, data=this%mml_nc_dust_grc)
-
write(iulog,*) ' MML end of 1d restart vars '
! 3d restart var example (soilbiogeochem carbon mod):
@@ -2400,8 +1427,8 @@ subroutine Restart(this, bounds, ncid, flag)
! long_name='', units='', fill_value=spval, &
! interpinic_flag='interp', readvar=readvar, data=ptr2d)
- ! End MML simple land model added variables
- !-----------------------------------------------------------------------
+ ! End MML simple land model added variables
+ !-----------------------------------------------------------------------
end subroutine Restart
@@ -2425,74 +1452,26 @@ subroutine Clean(this)
deallocate(this%forc_u_grc)
deallocate(this%forc_v_grc)
deallocate(this%forc_wind_grc)
- deallocate(this%forc_rh_grc)
deallocate(this%forc_hgt_grc)
- deallocate(this%forc_topo_grc)
deallocate(this%forc_hgt_u_grc)
deallocate(this%forc_hgt_t_grc)
deallocate(this%forc_hgt_q_grc)
deallocate(this%forc_vp_grc)
deallocate(this%forc_psrf_grc)
- deallocate(this%forc_pco2_grc)
deallocate(this%forc_solad_grc)
deallocate(this%forc_solai_grc)
deallocate(this%forc_solar_grc)
- deallocate(this%forc_ndep_grc)
- deallocate(this%forc_pc13o2_grc)
- deallocate(this%forc_po2_grc)
- deallocate(this%forc_aer_grc)
- deallocate(this%forc_pch4_grc)
! atm->lnd not downscaled
deallocate(this%forc_t_not_downscaled_grc)
deallocate(this%forc_q_not_downscaled_grc)
deallocate(this%forc_pbot_not_downscaled_grc)
- deallocate(this%forc_th_not_downscaled_grc)
deallocate(this%forc_rho_not_downscaled_grc)
deallocate(this%forc_lwrad_not_downscaled_grc)
deallocate(this%forc_rain_not_downscaled_grc)
deallocate(this%forc_snow_not_downscaled_grc)
- ! atm->lnd downscaled
- deallocate(this%forc_t_downscaled_col)
- deallocate(this%forc_q_downscaled_col)
- deallocate(this%forc_pbot_downscaled_col)
- deallocate(this%forc_th_downscaled_col)
- deallocate(this%forc_rho_downscaled_col)
- deallocate(this%forc_lwrad_downscaled_col)
- deallocate(this%forc_rain_downscaled_col)
- deallocate(this%forc_snow_downscaled_col)
-
- ! rof->lnd
- deallocate(this%forc_flood_grc)
- deallocate(this%volr_grc)
- deallocate(this%volrmch_grc)
-
- ! anomaly forcing
- deallocate(this%bc_precip_grc)
- deallocate(this%af_precip_grc)
- deallocate(this%af_uwind_grc)
- deallocate(this%af_vwind_grc)
- deallocate(this%af_tbot_grc)
- deallocate(this%af_pbot_grc)
- deallocate(this%af_shum_grc)
- deallocate(this%af_swdn_grc)
- deallocate(this%af_lwdn_grc)
-
- deallocate(this%fsd24_patch)
- deallocate(this%fsd240_patch)
- deallocate(this%fsi24_patch)
- deallocate(this%fsi240_patch)
- deallocate(this%prec10_patch)
- deallocate(this%prec60_patch)
- deallocate(this%prec365_col)
- if (use_fates) then
- deallocate(this%prec24_patch)
- deallocate(this%rh24_patch)
- deallocate(this%wind24_patch)
- end if
- deallocate(this%t_mo_patch)
- deallocate(this%t_mo_min_patch)
+! deallocate(this%fsd240_patch)
! MML: deallocate mml vars:
@@ -2535,7 +1514,6 @@ subroutine Clean(this)
deallocate(this%mml_atm_rhomol_grc )
deallocate(this%mml_atm_rhoair_grc )
deallocate(this%mml_atm_cp_grc )
- deallocate(this%mml_atm_pco2 )
deallocate(this%mml_atm_prec_liq_grc )
deallocate(this%mml_atm_prec_frz_grc )
diff --git a/src/main/clm_driver.F90 b/src/main/clm_driver.F90
index 5a36c237..c4465322 100644
--- a/src/main/clm_driver.F90
+++ b/src/main/clm_driver.F90
@@ -10,25 +10,17 @@ module clm_driver
! !USES:
use shr_kind_mod , only : r8 => shr_kind_r8
use clm_varctl , only : wrtdia, iulog
- use clm_varctl , only : use_cn, use_noio
+ use clm_varctl , only : use_noio
use clm_time_manager , only : get_nstep
use spmdMod , only : masterproc, mpicom
use decompMod , only : get_proc_clumps, get_clump_bounds, get_proc_bounds, bounds_type
- use filterMod , only : filter_inactive_and_active
use histFileMod , only : hist_update_hbuf, hist_htapes_wrapup
use restFileMod , only : restFile_write, restFile_filename
use abortutils , only : endrun
!
- use SoilBiogeochemVerticalProfileMod , only : SoilBiogeochemVerticalProfile
- use ActiveLayerMod , only : alt_calc
- !
use perf_mod ! MML: this is where t_startf and t_stopf are
!
- use clm_instMod , only : temperature_inst, canopystate_inst
- use clm_instMod , only : soilstate_inst, soilbiogeochem_state_inst
- use clm_instMod , only : bgc_vegetation_inst
use clm_instMod , only : atm2lnd_inst, lnd2atm_inst
- use clm_instMod , only : soilstate_inst
! MML: add use simple land model module
use mml_mainMod , only : mml_main ! MML if I don't say "only", it'll be fine, yes?
@@ -84,13 +76,8 @@ subroutine clm_drv(doalb, nextsw_cday, declinp1, declin, rstwr, nlend, rdate, ro
integer :: nclumps ! number of clumps on this processor
character(len=256) :: filer ! restart file name
integer :: ier ! error code
- type(bounds_type) :: bounds_clump
type(bounds_type) :: bounds_proc
- ! COMPILER_BUG(wjs, 2014-11-29, pgi 14.7) Workaround for internal compiler error with
- ! pgi 14.7 ('normalize_forall_array: non-conformable'), which appears in the call to
- ! CalcIrrigationNeeded. Simply declaring this variable makes the ICE go away.
- real(r8), allocatable :: dummy1_to_make_pgi_happy(:)
!-----------------------------------------------------------------------
! Determine processor bounds and clumps for this processor
@@ -98,35 +85,6 @@ subroutine clm_drv(doalb, nextsw_cday, declinp1, declin, rstwr, nlend, rdate, ro
call get_proc_bounds(bounds_proc)
nclumps = get_proc_clumps()
-! MML: I think I need this bit
- !$OMP PARALLEL DO PRIVATE (nc,bounds_clump)
- do nc = 1,nclumps
- call get_clump_bounds(nc, bounds_clump)
-
- ! BUG(wjs, 2014-12-15, bugz 2107) Because of the placement of the following
- ! routines (alt_calc and SoilBiogeochemVerticalProfile) in the driver sequence -
- ! they are called very early in each timestep, before weights are adjusted and
- ! filters are updated - it may be necessary for these routines to compute values
- ! over inactive as well as active points (since some inactive points may soon
- ! become active) - so that's what is done now. Currently, it seems to be okay to do
- ! this, because the variables computed here seem to only depend on quantities that
- ! are valid over inactive as well as active points.
-
- call t_startf("decomp_vert")
- call alt_calc(filter_inactive_and_active(nc)%num_soilc, filter_inactive_and_active(nc)%soilc, &
- temperature_inst, canopystate_inst)
-
- if (use_cn) then
- call SoilBiogeochemVerticalProfile(bounds_clump , &
- filter_inactive_and_active(nc)%num_soilc, filter_inactive_and_active(nc)%soilc , &
- filter_inactive_and_active(nc)%num_soilp, filter_inactive_and_active(nc)%soilp , &
- canopystate_inst, soilstate_inst, soilbiogeochem_state_inst)
- end if
-
- call t_stopf("decomp_vert")
- end do
- !$OMP END PARALLEL DO
-
! ============================================================================
! MML: Simple Land Model Override
! ============================================================================
@@ -140,9 +98,9 @@ subroutine clm_drv(doalb, nextsw_cday, declinp1, declin, rstwr, nlend, rdate, ro
! I give it everything it needs. I think lnd2atm (but check!) actually hands the data
! off to the coupler, so if thats the case I need to make my changes before hand.
- call t_startf('mml_main')
- call mml_main(bounds_clump, atm2lnd_inst, lnd2atm_inst)
- call t_stopf('mml_main')
+ call t_startf('mml_main')
+ call mml_main(bounds_proc, atm2lnd_inst, lnd2atm_inst)
+ call t_stopf('mml_main')
!write(iulog,*) 'MML: done with simple model, back at clm_driver'
@@ -177,56 +135,22 @@ subroutine clm_drv(doalb, nextsw_cday, declinp1, declin, rstwr, nlend, rdate, ro
! Create history and write history tapes if appropriate
call t_startf('clm_drv_io_htapes')
- !write(iulog,*)'MML: about to call htapes_wrapup, prepare to die, my name is inigio montoya... also wtf does it want the soilstate for? '
-
- ! MML workaround to try and avoid the soilstate leading to crashing - this is CLM's soil state, not SLIM's, so the values shouldn't be meaningful anyhow
- !soilstate_inst%watsat_col(bounds_proc%begc:bounds_proc%endc, :) = 0.0_r8
- !soilstate_inst%sucsat_col(bounds_proc%begc:bounds_proc%endc, :) = 0.0_r8
- !soilstate_inst%bsw_col(bounds_proc%begc:bounds_proc%endc, :) = 0.0_r8
- !soilstate_inst%hksat_col(bounds_proc%begc:bounds_proc%endc, :) = 0.0_r8
-
- !write(iulog,*)'MML: clobbered the soilstate_inst values, call hist_htapes_wrapup now'
-
- !write(iulog,*)'MML: rstwr = ',rstwr,', nlend = ',nlend
-
- call hist_htapes_wrapup( rstwr, nlend, bounds_proc, &
- soilstate_inst%watsat_col(bounds_proc%begc:bounds_proc%endc, 1:), &
- soilstate_inst%sucsat_col(bounds_proc%begc:bounds_proc%endc, 1:), &
- soilstate_inst%bsw_col(bounds_proc%begc:bounds_proc%endc, 1:), &
- soilstate_inst%hksat_col(bounds_proc%begc:bounds_proc%endc, 1:))
-
- !write(iulog,*)'MML: back from wrapup, yet we are still running'
+ call hist_htapes_wrapup( rstwr, nlend, bounds_proc )
call t_stopf('clm_drv_io_htapes')
- if (use_cn) then
- call bgc_vegetation_inst%WriteHistory(bounds_proc)
- end if
-
! Write restart/initial files if appropriate
if (rstwr) then
- !write(iulog,*)'MML: write restart file'
call t_startf('clm_drv_io_wrest')
filer = restFile_filename(rdate=rdate)
call restFile_write( bounds_proc, filer, rdate=rdate )
call t_stopf('clm_drv_io_wrest')
-
- ! MML:
- ! write(iulog,*) 'MML: end of restart if statment '
-
end if
call t_stopf('clm_drv_io')
-
- ! MML:
- !write(iulog,*) 'MML: after restart call '
-
end if
- ! MML:
- !write(iulog,*) 'MML: end clm_drv routine '
-
end subroutine clm_drv
!------------------------------------------------------------------------
diff --git a/src/main/clm_initializeMod.F90 b/src/main/clm_initializeMod.F90
index 57a91504..ad29d447 100644
--- a/src/main/clm_initializeMod.F90
+++ b/src/main/clm_initializeMod.F90
@@ -12,17 +12,9 @@ module clm_initializeMod
use clm_varctl , only : nsrest, nsrStartup, nsrContinue, nsrBranch
use clm_varctl , only : is_cold_start, is_interpolated_start
use clm_varctl , only : iulog
- use clm_varctl , only : use_cn, use_cndv
- use clm_instur , only : wt_lunit, urban_valid, wt_nat_patch, wt_cft, fert_cft, wt_glc_mec, topo_glc_mec
use perf_mod , only : t_startf, t_stopf
- use readParamsMod , only : readParameters
use ncdio_pio , only : file_desc_t
use GridcellType , only : grc ! instance
- use LandunitType , only : lun ! instance
- use ColumnType , only : col ! instance
- use PatchType , only : patch ! instance
- use reweightMod , only : reweight_wrapup
- use filterMod , only : allocFilters, filter
use clm_instMod
!
@@ -42,18 +34,15 @@ subroutine initialize1( )
! CLM initialization first phase
!
! !USES:
- use clm_varpar , only: clm_varpar_init, natpft_lb, natpft_ub, cft_lb, cft_ub, maxpatch_glcmec
+ use clm_varpar , only: clm_varpar_init
use clm_varcon , only: clm_varcon_init
- use landunit_varcon , only: landunit_varcon_init, max_lunit
- use clm_varctl , only: fsurdat, fatmlndfrc, noland, version, mml_surdat
- use pftconMod , only: pftcon
+ use clm_varctl , only: fatmlndfrc, noland, version, mml_surdat
use decompInitMod , only: decompInit_lnd, decompInit_clumps, decompInit_glcp
use domainMod , only: domain_check, ldomain, domain_init
- use surfrdMod , only: surfrd_get_globmask, surfrd_get_grid, surfrd_get_data
- use controlMod , only: control_init, control_print, NLFilename
+ use surfrdMod , only: surfrd_get_globmask, surfrd_get_grid
+ use controlMod , only: control_init, control_print, NLFilename, control_readNL_Physics, control_readNL_Perf
use ncdio_pio , only: ncd_pio_init
- use initGridCellsMod , only: initGridCells
- use UrbanParamsType , only: UrbanInput, IsSimpleBuildTemp
+ use mml_MainMod , only: readnml_datasets
!
! !LOCAL VARIABLES:
integer :: ier ! error status
@@ -78,15 +67,17 @@ subroutine initialize1( )
if ( masterproc )then
write(iulog,*) trim(version)
write(iulog,*)
- write(iulog,*) 'Attempting to initialize the land model .....'
+ write(iulog,*) 'Attempting to initialize the SLIM land model .....'
write(iulog,*)
call shr_sys_flush(iulog)
endif
+ call control_readNL_Physics()
+ call readnml_datasets( NLFilename )
+ call control_readNL_Perf()
call control_init()
call clm_varpar_init()
- call clm_varcon_init( IsSimpleBuildTemp() )
- call landunit_varcon_init()
+ call clm_varcon_init()
call ncd_pio_init()
if (masterproc) call control_print()
@@ -101,6 +92,9 @@ subroutine initialize1( )
write(iulog,*) 'Attempting to read global land mask from ',trim(fatmlndfrc)
call shr_sys_flush(iulog)
endif
+ ! TODO Currently reading domain file, although this is done in surfrd.
+ ! In NUOPC version we will be reading ESMF mesh file. Until SLIM gets
+ ! updated to NUOPC, we are leaving the calls to surfrd unchanged.
call surfrd_get_globmask(filename=fatmlndfrc, mask=amask, ni=ni, nj=nj)
! Exit early if no valid land points
@@ -132,86 +126,34 @@ subroutine initialize1( )
write(iulog,*) 'Attempting to read ldomain from ',trim(fatmlndfrc)
call shr_sys_flush(iulog)
endif
+ ! TODO Currently reading domain file, although this is done in surfrd.
+ ! In NUOPC version we will be reading ESMF mesh file. Until SLIM gets
+ ! updated to NUOPC, we are leaving the calls to surfrd unchanged.
call surfrd_get_grid(begg, endg, ldomain, fatmlndfrc)
if (masterproc) then
call domain_check(ldomain)
endif
ldomain%mask = 1 !!! TODO - is this needed?
- ! Initialize glc behavior
- call glc_behavior%Init(begg, endg, NLFilename)
-
- ! Initialize urban model input (initialize urbinp data structure)
- ! This needs to be called BEFORE the call to surfrd_get_data since
- ! that will call surfrd_get_special which in turn calls check_urban
-
- call UrbanInput(begg, endg, mode='initialize')
-
- ! Allocate surface grid dynamic memory (just gridcell bounds dependent)
-
- allocate (wt_lunit (begg:endg, max_lunit ))
- allocate (urban_valid (begg:endg ))
- allocate (wt_nat_patch (begg:endg, natpft_lb:natpft_ub ))
- allocate (wt_cft (begg:endg, cft_lb:cft_ub ))
- allocate (fert_cft (begg:endg, cft_lb:cft_ub ))
- allocate (wt_glc_mec (begg:endg, maxpatch_glcmec))
- allocate (topo_glc_mec(begg:endg, maxpatch_glcmec))
-
- ! Read list of Patches and their corresponding parameter values
- ! Independent of model resolution, Needs to stay before surfrd_get_data
-
- call pftcon%Init()
-
- ! Read surface dataset and set up subgrid weight arrays
-
- call surfrd_get_data(begg, endg, ldomain, fsurdat)
-
! ------------------------------------------------------------------------
! Determine decomposition of subgrid scale landunits, columns, patches
! ------------------------------------------------------------------------
- call decompInit_clumps(ns, ni, nj, glc_behavior)
+ call decompInit_clumps(ns, ni, nj)
! *** Get ALL processor bounds - for gridcells, landunit, columns and patches ***
call get_proc_bounds(bounds_proc)
! Allocate memory for subgrid data structures
- ! This is needed here BEFORE the following call to initGridcells
! Note that the assumption is made that none of the subgrid initialization
! can depend on other elements of the subgrid in the calls below
call grc%Init (bounds_proc%begg, bounds_proc%endg)
- call lun%Init (bounds_proc%begl, bounds_proc%endl)
- call col%Init (bounds_proc%begc, bounds_proc%endc)
- call patch%Init(bounds_proc%begp, bounds_proc%endp)
-
- ! Build hierarchy and topological info for derived types
- ! This is needed here for the following call to decompInit_glcp
- call initGridCells(glc_behavior)
+ ! Set global seg maps for gridcells
- ! Set global seg maps for gridcells, landlunits, columns and patches
-
- call decompInit_glcp(ns, ni, nj, glc_behavior)
-
- ! Set filters
-
- call allocFilters()
-
- nclumps = get_proc_clumps()
- !$OMP PARALLEL DO PRIVATE (nc, bounds_clump)
- do nc = 1, nclumps
- call get_clump_bounds(nc, bounds_clump)
- call reweight_wrapup(bounds_clump, glc_behavior)
- end do
- !$OMP END PARALLEL DO
-
- ! Deallocate surface grid dynamic memory for variables that aren't needed elsewhere.
- ! Some things are kept until the end of initialize2; urban_valid is kept through the
- ! end of the run for error checking.
-
- deallocate (wt_lunit, wt_cft, wt_glc_mec)
+ call decompInit_glcp(ns, ni, nj)
call t_stopf('clm_init1')
@@ -225,32 +167,19 @@ subroutine initialize2( )
! CLM initialization - second phase
!
! !USES:
- 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 accumulMod , only : print_accum_fields
- use clm_varpar , only : nlevsno
use clm_varcon , only : spval
- use clm_varctl , only : finidat, finidat_interp_source, finidat_interp_dest, fsurdat, mml_surdat
- use clm_varctl , only : use_century_decomp, single_column, scmlat, scmlon, use_cn
- use clm_varorb , only : eccen, mvelpp, lambm0, obliqr
- use clm_time_manager , only : get_step_size, get_curr_calday
+ use clm_varctl , only : finidat, finidat_interp_source, finidat_interp_dest, mml_surdat
+ use clm_varctl , only : single_column, scmlat, scmlon
use clm_time_manager , only : get_curr_date, get_nstep, advance_timestep
use clm_time_manager , only : timemgr_init, timemgr_restart_io, timemgr_restart
- !use DaylengthMod , only : InitDaylength, daylength
-! use dynSubgridDriverMod , only : dynSubgrid_init
use fileutils , only : getfil
use initInterpMod , only : initInterp
- use subgridWeightsMod , only : init_subgrid_weights_mod
+ use histFileMod , only : hist_readNML
use histFileMod , only : hist_htapes_build, htapes_fieldlist, hist_printflds
- use histFileMod , only : hist_addfld1d, hist_addfld2d, no_snow_normal
+ use histFileMod , only : hist_addfld1d, hist_addfld2d
use restFileMod , only : restFile_getfile, restFile_open, restFile_close
use restFileMod , only : restFile_read, restFile_write
- !use ndepStreamMod , only : ndep_init, ndep_interp
- use LakeCon , only : LakeConInit
- use SatellitePhenologyMod , only : SatellitePhenologyInit, readAnnualVegetation, interpMonthlyVeg
- use SnowSnicarMod , only : SnowAge_init, SnowOptics_init
- use lnd2atmMod , only : lnd2atm_minimal
use controlMod , only : NLFilename
!
! !ARGUMENTS
@@ -267,22 +196,12 @@ subroutine initialize2( )
character(len=256) :: pnamer ! full pathname of netcdf restart file
character(len=256) :: locfn ! local file name
type(file_desc_t) :: ncid ! netcdf id
- real(r8) :: dtime ! time step increment (sec)
integer :: nstep ! model time step
- real(r8) :: calday ! calendar day for nstep
- real(r8) :: caldaym1 ! calendar day for nstep-1
- real(r8) :: declin ! solar declination angle in radians for nstep
- real(r8) :: declinm1 ! solar declination angle in radians for nstep-1
- real(r8) :: eccf ! earth orbit eccentricity factor
type(bounds_type) :: bounds_proc ! processor bounds
type(bounds_type) :: bounds_clump ! clump bounds
logical :: lexist
integer :: closelatidx,closelonidx
real(r8) :: closelat,closelon
- real(r8) :: max_decl ! temporary, for calculation of max_dayl
- integer :: begp, endp
- integer :: begc, endc
- integer :: begl, endl
real(r8), pointer :: data2dptr(:,:) ! temp. pointers for slicing larger arrays
character(len=32) :: subname = 'initialize2'
!----------------------------------------------------------------------
@@ -296,13 +215,6 @@ subroutine initialize2( )
call get_proc_bounds(bounds_proc)
nclumps = get_proc_clumps()
- ! ------------------------------------------------------------------------
- ! Read in parameters files
- ! ------------------------------------------------------------------------
-
- call clm_instReadNML( NLFilename )
- call readParameters(photosyns_inst)
-
! ------------------------------------------------------------------------
! Initialize time manager
! ------------------------------------------------------------------------
@@ -317,43 +229,8 @@ subroutine initialize2( )
call timemgr_restart()
end if
- ! ------------------------------------------------------------------------
- ! Initialize daylength from the previous time step (needed so prev_dayl can be set correctly)
- ! ------------------------------------------------------------------------
-
- call t_startf('init_orbd')
-
- calday = get_curr_calday()
- call shr_orb_decl( calday, eccen, mvelpp, lambm0, obliqr, declin, eccf )
-
- dtime = get_step_size()
- caldaym1 = get_curr_calday(offset=-int(dtime))
- call shr_orb_decl( caldaym1, eccen, mvelpp, lambm0, obliqr, declinm1, eccf )
-
- call t_stopf('init_orbd')
-
- !call InitDaylength(bounds_proc, declin=declin, declinm1=declinm1)
-
- ! Initialize maximum daylength, based on latitude and maximum declination
- ! given by the obliquity use negative value for S. Hem
-
- do g = bounds_proc%begg,bounds_proc%endg
- max_decl = obliqr
- if (grc%lat(g) < 0._r8) max_decl = -max_decl
- !grc%max_dayl(g) = daylength(grc%lat(g), max_decl)
- end do
-
- ! History file variables
-
- if (use_cn) then
- !call hist_addfld1d (fname='DAYL', units='s', &
- !avgflag='A', long_name='daylength', &
- !ptr_gcell=grc%dayl, default='inactive')
-
- !call hist_addfld1d (fname='PREV_DAYL', units='s', &
- !avgflag='A', long_name='daylength from previous timestep', &
- !ptr_gcell=grc%prev_dayl, default='inactive')
- end if
+ ! History namelist read
+ call hist_readNML( NLFilename )
! ------------------------------------------------------------------------
! Initialize component data structures
@@ -365,26 +242,10 @@ subroutine initialize2( )
! First put in history calls for subgrid data structures - these cannot appear in the
! module for the subgrid data definition due to circular dependencies that are introduced
- data2dptr => col%dz(:,-nlevsno+1:0)
- col%dz(bounds_proc%begc:bounds_proc%endc,:) = spval
- call hist_addfld2d (fname='SNO_Z', units='m', type2d='levsno', &
- avgflag='A', long_name='Snow layer thicknesses', &
- ptr_col=data2dptr, no_snow_behavior=no_snow_normal, default='inactive')
-
- call hist_addfld2d (fname='SNO_Z_ICE', units='m', type2d='levsno', &
- avgflag='A', long_name='Snow layer thicknesses (ice landunits only)', &
- ptr_col=data2dptr, no_snow_behavior=no_snow_normal, &
- l2g_scale_type='ice', default='inactive')
-
- col%zii(bounds_proc%begc:bounds_proc%endc) = spval
- call hist_addfld1d (fname='ZII', units='m', &
- avgflag='A', long_name='convective boundary height', &
- ptr_col=col%zii, default='inactive')
-
! If single-column determine closest latitude and longitude
if (single_column) then
- call getfil (fsurdat, locfn, 0)
+ call getfil (mml_surdat, locfn, 0)
call shr_scam_getCloseLatLon(locfn, scmlat, scmlon, &
closelat, closelon, closelatidx, closelonidx)
end if
@@ -393,46 +254,12 @@ subroutine initialize2( )
call clm_instInit(bounds_proc)
- ! Initialize SNICAR optical and aging parameters
-
- call SnowOptics_init( ) ! SNICAR optical parameters:
- call SnowAge_init( ) ! SNICAR aging parameters:
-
call hist_printflds()
- ! ------------------------------------------------------------------------
- ! Initializate dynamic subgrid weights (for prescribed transient Patches, CNDV
- ! and/or dynamic landunits); note that these will be overwritten in a
- ! restart run
- ! ------------------------------------------------------------------------
-
- call t_startf('init_subgrid_weights')
- call init_subgrid_weights_mod(bounds_proc)
- call t_stopf('init_subgrid_weights')
-
! ------------------------------------------------------------------------
! Initialize modules (after time-manager initialization in most cases)
! ------------------------------------------------------------------------
- if (use_cn) then
- call bgc_vegetation_inst%Init2(bounds_proc, NLFilename)
-
- ! NOTE(wjs, 2016-02-23) Maybe the rest of the body of this conditional should also
- ! be moved into bgc_vegetation_inst%Init2
-
- if (n_drydep > 0 .and. drydep_method == DD_XLND) then
- ! Must do this also when drydeposition is used so that estimates of monthly
- ! differences in LAI can be computed
- call SatellitePhenologyInit(bounds_proc)
- end if
-
- else
- call SatellitePhenologyInit(bounds_proc)
- end if
-
-
-
-
! ------------------------------------------------------------------------
! On restart only - process the history namelist.
! ------------------------------------------------------------------------
@@ -470,7 +297,7 @@ subroutine initialize2( )
write(iulog,*)'Reading initial conditions from ',trim(finidat)
end if
call getfil( finidat, fnamer, 0 )
- call restFile_read(bounds_proc, fnamer, glc_behavior)
+ call restFile_read(bounds_proc, fnamer)
end if
else if ((nsrest == nsrContinue) .or. (nsrest == nsrBranch)) then
@@ -478,7 +305,7 @@ subroutine initialize2( )
if (masterproc) then
write(iulog,*)'Reading restart file ',trim(fnamer)
end if
- call restFile_read(bounds_proc, fnamer, glc_behavior)
+ call restFile_read(bounds_proc, fnamer)
end if
@@ -504,7 +331,7 @@ subroutine initialize2( )
call initInterp(filei=fnamer, fileo=finidat_interp_dest, bounds=bounds_proc)
! Read new interpolated conditions file back in
- call restFile_read(bounds_proc, finidat_interp_dest, glc_behavior)
+ call restFile_read(bounds_proc, finidat_interp_dest)
! Reset finidat to now be finidat_interp_dest
! (to be compatible with routines still using finidat)
@@ -525,79 +352,14 @@ subroutine initialize2( )
call hist_htapes_build()
end if
- ! ------------------------------------------------------------------------
- ! Initialize variables that are associated with accumulated fields.
- ! ------------------------------------------------------------------------
-
- ! The following is called for both initial and restart runs and must
- ! must be called after the restart file is read
-
- call atm2lnd_inst%initAccVars(bounds_proc)
- call temperature_inst%initAccVars(bounds_proc)
- call waterflux_inst%initAccVars(bounds_proc)
- call energyflux_inst%initAccVars(bounds_proc)
- call canopystate_inst%initAccVars(bounds_proc)
-
- call bgc_vegetation_inst%initAccVars(bounds_proc)
-
- !------------------------------------------------------------
- ! Read monthly vegetation
- !------------------------------------------------------------
-
- ! Even if CN is on, and dry-deposition is active, read CLMSP annual vegetation
- ! to get estimates of monthly LAI
-
- if ( n_drydep > 0 .and. drydep_method == DD_XLND )then
- call readAnnualVegetation(bounds_proc, canopystate_inst)
- if (nsrest == nsrStartup .and. finidat /= ' ') then
- ! Call interpMonthlyVeg for dry-deposition so that mlaidiff will be calculated
- ! This needs to be done even if CN or CNDV is on!
- call interpMonthlyVeg(bounds_proc, canopystate_inst)
- end if
- end if
-
- !------------------------------------------------------------
- ! Determine gridcell averaged properties to send to atm
- !------------------------------------------------------------
-
- if (nsrest == nsrStartup) then
- call t_startf('init_map2gc')
- call lnd2atm_minimal(bounds_proc, &
- waterstate_inst, surfalb_inst, energyflux_inst, lnd2atm_inst)
- call t_stopf('init_map2gc')
- end if
-
- !------------------------------------------------------------
- ! Initialize sno export state to send to glc
- !------------------------------------------------------------
-
- !$OMP PARALLEL DO PRIVATE (nc, bounds_clump)
- do nc = 1,nclumps
- call get_clump_bounds(nc, bounds_clump)
-
- call t_startf('init_lnd2glc')
- call lnd2glc_inst%update_lnd2glc(bounds_clump, &
- filter(nc)%num_do_smb_c, filter(nc)%do_smb_c, &
- temperature_inst, glacier_smb_inst, topo_inst, &
- init=.true.)
- call t_stopf('init_lnd2glc')
- end do
- !$OMP END PARALLEL DO
-
- !------------------------------------------------------------
- ! Deallocate wt_nat_patch
- !------------------------------------------------------------
-
- ! wt_nat_patch was allocated in initialize1, but needed to be kept around through
- ! initialize2 for some consistency checking; now it can be deallocated
-
- deallocate(wt_nat_patch)
-
- ! topo_glc_mec was allocated in initialize1, but needed to be kept around through
- ! initialize2 because it is used to initialize other variables; now it can be
- ! deallocated
+! TODO SLIM: slevis keeping an example of an accumulated field as template
+! ! ------------------------------------------------------------------------
+! ! Initialize variables that are associated with accumulated fields.
+! ! ------------------------------------------------------------------------
- deallocate(topo_glc_mec, fert_cft)
+! ! The following is called for both initial and restart runs and must
+! ! must be called after the restart file is read
+! call atm2lnd_inst%initAccVars(bounds_proc)
!------------------------------------------------------------
! Write log output for end of initialization
diff --git a/src/main/clm_instMod.F90 b/src/main/clm_instMod.F90
index 6be25eb4..d3306698 100644
--- a/src/main/clm_instMod.F90
+++ b/src/main/clm_instMod.F90
@@ -7,73 +7,21 @@ module clm_instMod
! !USES:
use shr_kind_mod , only : r8 => shr_kind_r8
use decompMod , only : bounds_type
- use clm_varpar , only : ndecomp_pools, nlevdecomp_full
- use clm_varctl , only : use_cn, use_cndv
- use clm_varctl , only : use_century_decomp, use_crop
- use clm_varcon , only : bdsno, c13ratio, c14ratio
- use landunit_varcon , only : istice_mec, istsoil
+ use clm_varcon , only : bdsno
+ use clm_varctl , only : iulog
use perf_mod , only : t_startf, t_stopf
- use controlMod , only : NLFilename
!-----------------------------------------
! Constants
!-----------------------------------------
- use UrbanParamsType , only : urbanparams_type ! Constants
- use UrbanParamsType , only : IsSimpleBuildTemp, IsProgBuildTemp
- use SoilBiogeochemDecompCascadeConType , only : decomp_cascade_con
- !use CNDVType , only : dgv_ecophyscon ! Constants
-
!-----------------------------------------
! Definition of component types
!-----------------------------------------
- use AerosolMod , only : aerosol_type
- use CanopyStateType , only : canopystate_type
- use ch4Mod , only : ch4_type
- use CNVegetationFacade , only : cn_vegetation_type
- use SoilBiogeochemStateType , only : soilbiogeochem_state_type
- use SoilBiogeochemCarbonFluxType , only : soilbiogeochem_carbonflux_type
- use SoilBiogeochemCarbonStateType , only : soilbiogeochem_carbonstate_type
- use SoilBiogeochemNitrogenFluxType , only : soilbiogeochem_nitrogenflux_type
- use SoilBiogeochemNitrogenStateType , only : soilbiogeochem_nitrogenstate_type
- use CropType , only : crop_type
- use DryDepVelocity , only : drydepvel_type
- use DUSTMod , only : dust_type
- use EnergyFluxType , only : energyflux_type
- use FrictionVelocityMod , only : frictionvel_type
- use GlacierSurfaceMassBalanceMod , only : glacier_smb_type
- use LakeStateType , only : lakestate_type
- use OzoneBaseMod , only : ozone_base_type
- use OzoneFactoryMod , only : create_and_init_ozone_type
- use PhotosynthesisMod , only : photosyns_type
- use SoilHydrologyType , only : soilhydrology_type
- use SoilStateType , only : soilstate_type
- use SolarAbsorbedType , only : solarabs_type
- use SurfaceRadiationMod , only : surfrad_type
- use SurfaceAlbedoType , only : surfalb_type
- use TemperatureType , only : temperature_type
- use WaterFluxType , only : waterflux_type
- use WaterStateType , only : waterstate_type
- use UrbanParamsType , only : urbanparams_type
- use VOCEmissionMod , only : vocemis_type
use atm2lndType , only : atm2lnd_type
use lnd2atmType , only : lnd2atm_type
- use lnd2glcMod , only : lnd2glc_type
- use glc2lndMod , only : glc2lnd_type
- use glcBehaviorMod , only : glc_behavior_type
- use TopoMod , only : topo_type
use GridcellType , only : grc
- use LandunitType , only : lun
- use ColumnType , only : col
- use PatchType , only : patch
- use SoilWaterRetentionCurveMod , only : soil_water_retention_curve_type
- !
- use SoilStateInitTimeConstMod , only : SoilStateInitTimeConst
- use SoilHydrologyInitTimeConstMod , only : SoilHydrologyInitTimeConst
- use SurfaceAlbedoMod , only : SurfaceAlbedoInitTimeConst
- use LakeCon , only : LakeConInit
- use SoilBiogeochemPrecisionControlMod, only: SoilBiogeochemPrecisionControlInit
!
implicit none
public ! By default everything is public
@@ -83,305 +31,42 @@ module clm_instMod
!-----------------------------------------
! Physics types
- type(aerosol_type) :: aerosol_inst
- type(canopystate_type) :: canopystate_inst
- type(energyflux_type) :: energyflux_inst
- type(frictionvel_type) :: frictionvel_inst
- type(glacier_smb_type) :: glacier_smb_inst
- type(lakestate_type) :: lakestate_inst
- class(ozone_base_type), allocatable :: ozone_inst
- type(photosyns_type) :: photosyns_inst
- type(soilstate_type) :: soilstate_inst
- type(soilhydrology_type) :: soilhydrology_inst
- type(solarabs_type) :: solarabs_inst
- type(surfalb_type) :: surfalb_inst
- type(surfrad_type) :: surfrad_inst
- type(temperature_type) :: temperature_inst
- type(urbanparams_type) :: urbanparams_inst
- type(waterflux_type) :: waterflux_inst
- type(waterstate_type) :: waterstate_inst
type(atm2lnd_type) :: atm2lnd_inst
- type(glc2lnd_type) :: glc2lnd_inst
type(lnd2atm_type) :: lnd2atm_inst
- type(lnd2glc_type) :: lnd2glc_inst
- type(glc_behavior_type), target :: glc_behavior
- type(topo_type) :: topo_inst
- class(soil_water_retention_curve_type) , allocatable :: soil_water_retention_curve
-
- ! CN vegetation types
- ! Eventually bgc_vegetation_inst will be an allocatable instance of an abstract
- ! interface
- type(cn_vegetation_type) :: bgc_vegetation_inst
-
- ! Soil biogeochem types
- type(soilbiogeochem_state_type) :: soilbiogeochem_state_inst
- type(soilbiogeochem_carbonstate_type) :: soilbiogeochem_carbonstate_inst
- type(soilbiogeochem_carbonstate_type) :: c13_soilbiogeochem_carbonstate_inst
- type(soilbiogeochem_carbonstate_type) :: c14_soilbiogeochem_carbonstate_inst
- type(soilbiogeochem_carbonflux_type) :: soilbiogeochem_carbonflux_inst
- type(soilbiogeochem_carbonflux_type) :: c13_soilbiogeochem_carbonflux_inst
- type(soilbiogeochem_carbonflux_type) :: c14_soilbiogeochem_carbonflux_inst
- type(soilbiogeochem_nitrogenstate_type) :: soilbiogeochem_nitrogenstate_inst
- type(soilbiogeochem_nitrogenflux_type) :: soilbiogeochem_nitrogenflux_inst
-
- ! General biogeochem types
- type(ch4_type) :: ch4_inst
- type(crop_type) :: crop_inst
- type(dust_type) :: dust_inst
- !type(vocemis_type) :: vocemis_inst
- type(drydepvel_type) :: drydepvel_inst
-
- ! FATES
- !
public :: clm_instInit ! Initialize
- public :: clm_instReadNML ! Read in namelist
public :: clm_instRest ! Setup restart
!-----------------------------------------------------------------------
contains
- !-----------------------------------------------------------------------
- subroutine clm_instReadNML( NLFilename )
- !
- ! !ARGUMENTS
- implicit none
- character(len=*), intent(IN) :: NLFilename ! Namelist filename
- ! Read in any namelists that must be read for any clm object instances that need it
- call canopystate_inst%ReadNML( NLFilename )
- !call photosyns_inst%ReadNML( NLFilename )
- !if (use_cn) then
- !call crop_inst%ReadNML( NLFilename )
- !end if
-
- end subroutine clm_instReadNML
-
!-----------------------------------------------------------------------
subroutine clm_instInit(bounds)
- !
- ! !USES:
- use clm_varpar , only : nlevsno, numpft
- use controlMod , only : nlfilename, fsurdat
- use domainMod , only : ldomain
- use SoilBiogeochemDecompCascadeBGCMod , only : init_decompcascade_bgc
- use SoilBiogeochemDecompCascadeCNMod , only : init_decompcascade_cn
- use SoilBiogeochemDecompCascadeContype , only : init_decomp_cascade_constants
- use initVerticalMod , only : initVertical
- use accumulMod , only : print_accum_fields
- use SoilWaterRetentionCurveFactoryMod , only : create_soil_water_retention_curve
- use decompMod , only : get_proc_bounds
!
! !ARGUMENTS
type(bounds_type), intent(in) :: bounds ! processor bounds
!
! !LOCAL VARIABLES:
- integer :: c,l,g
- integer :: nclumps,nc
- integer :: begp, endp
- integer :: begc, endc
- integer :: begl, endl
- type(bounds_type) :: bounds_clump
- real(r8), allocatable :: h2osno_col(:)
- real(r8), allocatable :: snow_depth_col(:)
-
- integer :: dummy_to_make_pgi_happy
!----------------------------------------------------------------------
- ! Note: h2osno_col and snow_depth_col are initialized as local variable
- ! since they are needed to initialize vertical data structures
-
- begp = bounds%begp; endp = bounds%endp
- begc = bounds%begc; endc = bounds%endc
- begl = bounds%begl; endl = bounds%endl
-
- allocate (h2osno_col(begc:endc))
- allocate (snow_depth_col(begc:endc))
-
- ! snow water
- do c = begc,endc
- l = col%landunit(c)
- g = col%gridcell(c)
-
- ! In areas that should be snow-covered, it can be problematic to start with 0 snow
- ! cover, because this can affect the long-term state through soil heating, albedo
- ! feedback, etc. On the other hand, we would introduce hysteresis by putting too
- ! much snow in places that are in a net melt regime, because the melt-albedo
- ! feedback may not activate on time (or at all). So, as a compromise, we start with
- ! a small amount of snow in places that are likely to be snow-covered for much or
- ! all of the year.
- if (lun%itype(l)==istice_mec) then
- h2osno_col(c) = 100._r8
- else if (lun%itype(l)==istsoil .and. abs(grc%latdeg(g)) >= 60._r8) then
- h2osno_col(c) = 100._r8
- else
- h2osno_col(c) = 0._r8
- endif
- snow_depth_col(c) = h2osno_col(c) / bdsno
- end do
-
- ! Initialize urban constants
-
- call urbanparams_inst%Init(bounds)
-
- ! Initialize vertical data components
-
- call initVertical(bounds, &
- glc_behavior, &
- snow_depth_col(begc:endc), &
- urbanparams_inst%thick_wall(begl:endl), &
- urbanparams_inst%thick_roof(begl:endl))
-
! Initialize clm->drv and drv->clm data structures
- call atm2lnd_inst%Init( bounds, NLFilename )
- call lnd2atm_inst%Init( bounds, NLFilename )
-
- call glc2lnd_inst%Init( bounds, glc_behavior )
- call lnd2glc_inst%Init( bounds )
+ call atm2lnd_inst%Init(bounds)
+ call lnd2atm_inst%Init(bounds)
! Initialization of public data types
- call temperature_inst%Init(bounds, &
- urbanparams_inst%em_roof(begl:endl), &
- urbanparams_inst%em_wall(begl:endl), &
- urbanparams_inst%em_improad(begl:endl), &
- urbanparams_inst%em_perroad(begl:endl), &
- IsSimpleBuildTemp(), IsProgBuildTemp() )
-
- call canopystate_inst%Init(bounds)
-
- call soilstate_inst%Init(bounds)
- call SoilStateInitTimeConst(bounds, soilstate_inst, nlfilename) ! sets hydraulic and thermal soil properties
-
- call waterstate_inst%Init(bounds, &
- h2osno_col(begc:endc), &
- snow_depth_col(begc:endc), &
- soilstate_inst%watsat_col(begc:endc, 1:), &
- temperature_inst%t_soisno_col(begc:endc, -nlevsno+1:) )
-
- call waterflux_inst%Init(bounds)
-
- call glacier_smb_inst%Init(bounds)
-
- ! COMPILER_BUG(wjs, 2014-11-29, pgi 14.7) Without the following assignment, the
- ! assertion in energyflux_inst%Init fails with pgi 14.7 on yellowstone, presumably due
- ! to a compiler bug.
- dummy_to_make_pgi_happy = ubound(temperature_inst%t_grnd_col, 1)
- call energyflux_inst%Init(bounds, temperature_inst%t_grnd_col(begc:endc), &
- IsSimpleBuildTemp(), IsProgBuildTemp() )
-
- !call aerosol_inst%Init(bounds, NLFilename)
-
- call frictionvel_inst%Init(bounds)
-
- call lakestate_inst%Init(bounds)
- call LakeConInit()
-
- allocate(ozone_inst, source = create_and_init_ozone_type(bounds))
-
- call photosyns_inst%Init(bounds)
-
- call soilhydrology_inst%Init(bounds, nlfilename)
- call SoilHydrologyInitTimeConst(bounds, soilhydrology_inst) ! sets time constant properties
-
- call solarabs_inst%Init(bounds)
-
- call surfalb_inst%Init(bounds)
- call SurfaceAlbedoInitTimeConst(bounds)
-
- call surfrad_inst%Init(bounds)
-
- call dust_inst%Init(bounds)
-
- call topo_inst%Init(bounds)
-
- ! Note - always initialize the memory for ch4_inst
- !call ch4_inst%Init(bounds, soilstate_inst%cellorg_col(begc:endc, 1:), fsurdat, nlfilename)
-
- !call vocemis_inst%Init(bounds)
-
- !call drydepvel_inst%Init(bounds)
-
- if (use_cn ) then
-
- ! Initialize soilbiogeochem_state_inst
-
- call soilbiogeochem_state_inst%Init(bounds)
+! TODO SLIM: slevis keeping an example of an accumulated field as template
+! ! ------------------------------------------------------------------------
+! ! Initialize accumulated fields
+! ! ------------------------------------------------------------------------
- ! Initialize decompcascade constants
- ! Note that init_decompcascade_bgc and init_decompcascade_cn need
- ! soilbiogeochem_state_inst to be initialized
+! ! The time manager needs to be initialized before this called is made, since
+! ! the step size is needed.
- call init_decomp_cascade_constants()
- if (use_century_decomp) then
- call init_decompcascade_bgc(bounds, soilbiogeochem_state_inst, &
- soilstate_inst )
- else
- call init_decompcascade_cn(bounds, soilbiogeochem_state_inst)
- end if
-
- ! Initalize soilbiogeochem carbon types
-
- call soilbiogeochem_carbonstate_inst%Init(bounds, carbon_type='c12', ratio=1._r8)
-
- end if
-
- if ( use_cn ) then
-
- ! Initalize soilbiogeochem nitrogen types
-
- call soilbiogeochem_nitrogenstate_inst%Init(bounds, &
- soilbiogeochem_carbonstate_inst%decomp_cpools_vr_col(begc:endc,1:nlevdecomp_full,1:ndecomp_pools), &
- soilbiogeochem_carbonstate_inst%decomp_cpools_col(begc:endc,1:ndecomp_pools), &
- soilbiogeochem_carbonstate_inst%decomp_cpools_1m_col(begc:endc, 1:ndecomp_pools))
-
- call soilbiogeochem_nitrogenflux_inst%Init(bounds)
-
- ! Initialize precision control for soil biogeochemistry
- call SoilBiogeochemPrecisionControlInit( soilbiogeochem_carbonstate_inst, c13_soilbiogeochem_carbonstate_inst, &
- c14_soilbiogeochem_carbonstate_inst, soilbiogeochem_nitrogenstate_inst)
-
- end if ! end of if use_cn
-
- ! Note - always call Init for bgc_vegetation_inst: some pieces need to be initialized always
- call bgc_vegetation_inst%Init(bounds, nlfilename)
-
- if (use_cn ) then
- call crop_inst%Init(bounds)
- end if
-
-
- deallocate (h2osno_col)
- deallocate (snow_depth_col)
-
- ! ------------------------------------------------------------------------
- ! Initialize accumulated fields
- ! ------------------------------------------------------------------------
-
- ! The time manager needs to be initialized before this called is made, since
- ! the step size is needed.
-
- call t_startf('init_accflds')
-
- call atm2lnd_inst%InitAccBuffer(bounds)
-
- call temperature_inst%InitAccBuffer(bounds)
-
- call waterflux_inst%InitAccBuffer(bounds)
-
- call energyflux_inst%InitAccBuffer(bounds)
-
- call canopystate_inst%InitAccBuffer(bounds)
-
- call bgc_vegetation_inst%InitAccBuffer(bounds)
-
- if (use_crop) then
- call crop_inst%InitAccBuffer(bounds)
- end if
-
- call print_accum_fields()
-
- call t_stopf('init_accflds')
+! call t_startf('init_accflds')
+! call atm2lnd_inst%InitAccBuffer(bounds)
+! call t_stopf('init_accflds')
end subroutine clm_instInit
@@ -390,85 +75,18 @@ subroutine clm_instRest(bounds, ncid, flag)
!
! !USES:
use ncdio_pio , only : file_desc_t
- use UrbanParamsType , only : IsSimpleBuildTemp, IsProgBuildTemp
- use decompMod , only : get_proc_bounds, get_proc_clumps, get_clump_bounds
-
!
! !DESCRIPTION:
! Define/write/read CLM restart file.
!
! !ARGUMENTS:
type(bounds_type) , intent(in) :: bounds
-
type(file_desc_t) , intent(inout) :: ncid ! netcdf id
character(len=*) , intent(in) :: flag ! 'define', 'write', 'read'
-
- ! Local variables
- integer :: nc, nclumps
- type(bounds_type) :: bounds_clump
-
!-----------------------------------------------------------------------
call atm2lnd_inst%restart (bounds, ncid, flag=flag)
- call canopystate_inst%restart (bounds, ncid, flag=flag)
-
- call energyflux_inst%restart (bounds, ncid, flag=flag, &
- is_simple_buildtemp=IsSimpleBuildTemp(), is_prog_buildtemp=IsProgBuildTemp())
-
- call frictionvel_inst% restart (bounds, ncid, flag=flag)
-
- call lakestate_inst%restart (bounds, ncid, flag=flag)
-
- call ozone_inst%restart (bounds, ncid, flag=flag)
-
- call photosyns_inst%restart (bounds, ncid, flag=flag)
-
- call soilhydrology_inst%restart (bounds, ncid, flag=flag)
-
- call solarabs_inst%restart (bounds, ncid, flag=flag)
-
- call temperature_inst%restart (bounds, ncid, flag=flag, &
- is_simple_buildtemp=IsSimpleBuildTemp(), is_prog_buildtemp=IsProgBuildTemp())
-
- call soilstate_inst%restart (bounds, ncid, flag=flag)
-
- call waterflux_inst%restart (bounds, ncid, flag=flag)
-
- call waterstate_inst%restart (bounds, ncid, flag=flag, &
- watsat_col=soilstate_inst%watsat_col(bounds%begc:bounds%endc,:))
-
- !call aerosol_inst%restart (bounds, ncid, flag=flag, &
- !h2osoi_ice_col=waterstate_inst%h2osoi_ice_col(bounds%begc:bounds%endc,:), &
- !h2osoi_liq_col=waterstate_inst%h2osoi_liq_col(bounds%begc:bounds%endc,:))
-
- call surfalb_inst%restart (bounds, ncid, flag=flag, &
- tlai_patch=canopystate_inst%tlai_patch(bounds%begp:bounds%endp), &
- tsai_patch=canopystate_inst%tsai_patch(bounds%begp:bounds%endp))
-
- call topo_inst%restart (bounds, ncid, flag=flag)
-
- if ( use_cn ) then
- ! Need to do vegetation restart before soil bgc restart to get totvegc_col for purpose
- ! of resetting soil carbon at exit spinup when no vegetation is growing.
- call bgc_vegetation_inst%restart(bounds, ncid, flag=flag)
-
- call soilbiogeochem_nitrogenstate_inst%restart(bounds, ncid, flag=flag, &
- totvegc_col=bgc_vegetation_inst%get_totvegc_col(bounds))
- call soilbiogeochem_nitrogenflux_inst%restart(bounds, ncid, flag=flag)
-
- call crop_inst%restart(bounds, ncid, flag=flag)
- end if
-
- if (use_cn ) then
-
- call soilbiogeochem_state_inst%restart(bounds, ncid, flag=flag)
- call soilbiogeochem_carbonstate_inst%restart(bounds, ncid, flag=flag, carbon_type='c12', &
- totvegc_col=bgc_vegetation_inst%get_totvegc_col(bounds))
-
- call soilbiogeochem_carbonflux_inst%restart(bounds, ncid, flag=flag)
- endif
-
end subroutine clm_instRest
end module clm_instMod
diff --git a/src/main/clm_varcon.F90 b/src/main/clm_varcon.F90
index d0a20535..48ea6c65 100644
--- a/src/main/clm_varcon.F90
+++ b/src/main/clm_varcon.F90
@@ -14,10 +14,6 @@ module clm_varcon
SHR_CONST_PDB, SHR_CONST_PI, SHR_CONST_CDAY, &
SHR_CONST_RGAS, SHR_CONST_PSTD, &
SHR_CONST_MWDAIR, SHR_CONST_MWWV
- use clm_varpar , only: numrad, nlevgrnd, nlevlak, nlevdecomp_full
- use clm_varpar , only: ngases
- use clm_varpar , only: nlayer
-
!
! !PUBLIC TYPES:
implicit none
@@ -42,10 +38,7 @@ module clm_varcon
! Initialize physical constants
!------------------------------------------------------------------
- real(r8), parameter :: n_melt=0.7 ! fsca shape parameter
- real(r8), parameter :: e_ice=6.0 ! soil ice impedance factor
real(r8), parameter :: pc = 0.4 ! threshold probability
- real(r8), parameter :: mu = 0.13889 ! connectivity exponent
real(r8), parameter :: secsphr = 3600._r8 ! Seconds in an hour
integer, parameter :: isecsphr = int(secsphr) ! Integer seconds in an hour
integer, parameter :: isecspmin= 60 ! Integer seconds in a minute
@@ -88,9 +81,6 @@ module clm_varcon
real(r8), public, parameter :: secspday= SHR_CONST_CDAY ! Seconds per day
integer, public, parameter :: isecspday= secspday ! Integer seconds per day
- integer, public, parameter :: fun_period = 1 ! A FUN parameter, and probably needs to be changed for testing
- real(r8),public, parameter :: smallValue = 1.e-12_r8 ! A small values used by FUN
-
! ------------------------------------------------------------------------
! Special value flags
! ------------------------------------------------------------------------
@@ -106,111 +96,14 @@ module clm_varcon
! Keep this negative to avoid conflicts with possible valid values
integer , public, parameter :: ispval = -9999 ! special value for int data
- ! ------------------------------------------------------------------------
- ! These are tunable constants from clm2_3
- ! ------------------------------------------------------------------------
-
- real(r8) :: zlnd = 0.01_r8 ! Roughness length for soil [m]
- real(r8) :: zsno = 0.0024_r8 ! Roughness length for snow [m]
- real(r8) :: csoilc = 0.004_r8 ! Drag coefficient for soil under canopy [-]
- real(r8) :: capr = 0.34_r8 ! Tuning factor to turn first layer T into surface T
- real(r8) :: cnfac = 0.5_r8 ! Crank Nicholson factor between 0 and 1
- real(r8) :: ssi = 0.033_r8 ! Irreducible water saturation of snow
- real(r8) :: wimp = 0.05_r8 ! Water impremeable if porosity less than wimp
- real(r8) :: pondmx = 0.0_r8 ! Ponding depth (mm)
- real(r8) :: pondmx_urban = 1.0_r8 ! Ponding depth for urban roof and impervious road (mm)
-
- real(r8) :: thk_bedrock = 3.0_r8 ! thermal conductivity of 'typical' saturated granitic rock
- ! (Clauser and Huenges, 1995)(W/m/K)
- real(r8) :: csol_bedrock = 2.0e6_r8 ! vol. heat capacity of granite/sandstone J/(m3 K)(Shabbir, 2000) !scs
- real(r8), parameter :: zmin_bedrock = 0.4_r8 ! minimum soil depth [m]
-
- real(r8), parameter :: aquifer_water_baseline = 5000._r8 ! baseline value for water in the unconfined aquifer [mm]
-
- !!! C13
- real(r8), parameter :: preind_atm_del13c = -6.0 ! preindustrial value for atmospheric del13C
- real(r8), parameter :: preind_atm_ratio = SHR_CONST_PDB + (preind_atm_del13c * SHR_CONST_PDB)/1000.0 ! 13C/12C
- real(r8) :: c13ratio = preind_atm_ratio/(1.0+preind_atm_ratio) ! 13C/(12+13)C preind atmosphere
-
- ! typical del13C for C3 photosynthesis (permil, relative to PDB)
- real(r8), parameter :: c3_del13c = -28._r8
-
- ! typical del13C for C4 photosynthesis (permil, relative to PDB)
- real(r8), parameter :: c4_del13c = -13._r8
-
- ! isotope ratio (13c/12c) for C3 photosynthesis
- real(r8), parameter :: c3_r1 = SHR_CONST_PDB + ((c3_del13c*SHR_CONST_PDB)/1000._r8)
-
- ! isotope ratio (13c/[12c+13c]) for C3 photosynthesis
- real(r8), parameter :: c3_r2 = c3_r1/(1._r8 + c3_r1)
-
- ! isotope ratio (13c/12c) for C4 photosynthesis
- real(r8), parameter :: c4_r1 = SHR_CONST_PDB + ((c4_del13c*SHR_CONST_PDB)/1000._r8)
-
- ! isotope ratio (13c/[12c+13c]) for C4 photosynthesis
- real(r8), parameter :: c4_r2 = c4_r1/(1._r8 + c4_r1)
-
- !!! C14
- real(r8) :: c14ratio = 1.e-12_r8
- ! real(r8) :: c14ratio = 1._r8 ! debug lets set to 1 to try to avoid numerical errors
-
- !------------------------------------------------------------------
- ! Urban building temperature constants
- !------------------------------------------------------------------
- real(r8) :: ht_wasteheat_factor = 0.2_r8 ! wasteheat factor for urban heating (-)
- real(r8) :: ac_wasteheat_factor = 0.6_r8 ! wasteheat factor for urban air conditioning (-)
- real(r8) :: em_roof_int = 0.9_r8 ! emissivity of interior surface of roof (Bueno et al. 2012, GMD)
- real(r8) :: em_sunw_int = 0.9_r8 ! emissivity of interior surface of sunwall (Bueno et al. 2012, GMD)
- real(r8) :: em_shdw_int = 0.9_r8 ! emissivity of interior surface of shadewall Bueno et al. 2012, GMD)
- real(r8) :: em_floor_int = 0.9_r8 ! emissivity of interior surface of floor (Bueno et al. 2012, GMD)
- real(r8) :: hcv_roof = 0.948_r8 ! interior convective heat transfer coefficient for roof (Bueno et al. 2012, GMD) (W m-2 K-1)
- real(r8) :: hcv_roof_enhanced = 4.040_r8 ! enhanced (t_roof_int <= t_room) interior convective heat transfer coefficient for roof (Bueno et al. 2012, GMD) !(W m-2 K-1)
- real(r8) :: hcv_floor = 0.948_r8 ! interior convective heat transfer coefficient for floor (Bueno et al. 2012, GMD) (W m-2 K-1)
- real(r8) :: hcv_floor_enhanced = 4.040_r8 ! enhanced (t_floor_int >= t_room) interior convective heat transfer coefficient for floor (Bueno et al. !2012, GMD) (W m-2 K-1)
- real(r8) :: hcv_sunw = 3.076_r8 ! interior convective heat transfer coefficient for sunwall (Bueno et al. 2012, GMD) (W m-2 K-1)
- real(r8) :: hcv_shdw = 3.076_r8 ! interior convective heat transfer coefficient for shadewall (Bueno et al. 2012, GMD) (W m-2 K-1)
- real(r8) :: dz_floor = 0.1_r8 ! floor thickness - concrete (Salmanca et al. 2010, TAC) (m)
- real(r8), parameter :: dens_floor = 2.35e3_r8 ! density of floor - concrete (Salmanca et al. 2010, TAC) (kg m-3)
- real(r8), parameter :: sh_floor = 880._r8 ! specific heat of floor - concrete (Salmanca et al. 2010, TAC) (J kg-1 K-1)
- real(r8) :: cp_floor = dens_floor*sh_floor ! volumetric heat capacity of floor - concrete (Salmanca et al. 2010, TAC) (J m-3 K-1)
- real(r8) :: vent_ach = 0.3 ! ventilation rate (air exchanges per hour)
-
- real(r8) :: wasteheat_limit = 100._r8 ! limit on wasteheat (W/m2)
-
- !------------------------------------------------------------------
-
- real(r8) :: h2osno_max = -999.0_r8 ! max allowed snow thickness (mm H2O)
- real(r8) :: int_snow_max = -999.0_r8 ! limit applied to integrated snowfall when determining changes in snow-covered fraction during melt (mm H2O)
- real(r8) :: n_melt_glcmec = -999.0_r8 ! SCA shape parameter for glc_mec columns
-
integer, private :: i ! loop index
- !real(r8), parameter :: nitrif_n2o_loss_frac = 0.02_r8 ! fraction of N lost as N2O in nitrification (Parton et al., 2001)
- real(r8), parameter :: nitrif_n2o_loss_frac = 6.e-4_r8 ! fraction of N lost as N2O in nitrification (Li et al., 2000)
- real(r8), parameter :: frac_minrlztn_to_no3 = 0.2_r8 ! fraction of N mineralized that is dieverted to the nitrification stream (Parton et al., 2001)
-
!------------------------------------------------------------------
! Set subgrid names
!------------------------------------------------------------------
character(len=16), parameter :: grlnd = 'lndgrid' ! name of lndgrid
- character(len=16), parameter :: namea = 'gridcellatm' ! name of atmgrid
character(len=16), parameter :: nameg = 'gridcell' ! name of gridcells
- character(len=16), parameter :: namel = 'landunit' ! name of landunits
- character(len=16), parameter :: namec = 'column' ! name of columns
- character(len=16), parameter :: namep = 'pft' ! name of patches
- character(len=16), parameter :: nameCohort = 'cohort' ! name of cohorts (ED specific)
-
- !------------------------------------------------------------------
- ! Initialize miscellaneous radiation constants
- !------------------------------------------------------------------
-
- real(r8) :: betads = 0.5_r8 ! two-stream parameter betad for snow
- real(r8) :: betais = 0.5_r8 ! two-stream parameter betai for snow
- real(r8) :: omegas(numrad) ! two-stream parameter omega for snow by band
- data (omegas(i),i=1,numrad) /0.8_r8, 0.4_r8/
-
- ! Lake Model Constants will be defined in LakeCon.
!------------------------------------------------------------------
! Soil depths are constants for now; lake depths can vary by gridcell
@@ -218,86 +111,28 @@ module clm_varcon
! The values for the following arrays are set in routine iniTimeConst
!------------------------------------------------------------------
- real(r8), allocatable :: zlak(:) !lake z (layers)
- real(r8), allocatable :: dzlak(:) !lake dz (thickness)
real(r8), allocatable :: zsoi(:) !soil z (layers)
- real(r8), allocatable :: dzsoi(:) !soil dz (thickness)
- real(r8), allocatable :: zisoi(:) !soil zi (interfaces)
- real(r8), allocatable :: dzsoi_decomp(:) !soil dz (thickness)
- integer , allocatable :: nlvic(:) !number of CLM layers in each VIC layer (#)
- real(r8), allocatable :: dzvic(:) !soil dz (thickness) of each VIC layer
- real(r8) ,allocatable :: zsoifl(:) !original soil midpoint (used in interpolation of sand and clay)
- real(r8) ,allocatable :: zisoifl(:) !original soil interface depth (used in interpolation of sand and clay)
- real(r8) ,allocatable :: dzsoifl(:) !original soil thickness (used in interpolation of sand and clay)
-
- !------------------------------------------------------------------
- ! (Non-tunable) Constants for the CH4 submodel (Tuneable constants in ch4varcon)
- !------------------------------------------------------------------
- ! Note some of these constants are also used in CNNitrifDenitrifMod
-
- real(r8), parameter :: catomw = 12.011_r8 ! molar mass of C atoms (g/mol)
-
- real(r8) :: s_con(ngases,4) ! Schmidt # calculation constants (spp, #)
- data (s_con(1,i),i=1,4) /1898_r8, -110.1_r8, 2.834_r8, -0.02791_r8/ ! CH4
- data (s_con(2,i),i=1,4) /1801_r8, -120.1_r8, 3.7818_r8, -0.047608_r8/ ! O2
- data (s_con(3,i),i=1,4) /1911_r8, -113.7_r8, 2.967_r8, -0.02943_r8/ ! CO2
-
- real(r8) :: d_con_w(ngases,3) ! water diffusivity constants (spp, #) (mult. by 10^-4)
- data (d_con_w(1,i),i=1,3) /0.9798_r8, 0.02986_r8, 0.0004381_r8/ ! CH4
- data (d_con_w(2,i),i=1,3) /1.172_r8, 0.03443_r8, 0.0005048_r8/ ! O2
- data (d_con_w(3,i),i=1,3) /0.939_r8, 0.02671_r8, 0.0004095_r8/ ! CO2
-
- real(r8) :: d_con_g(ngases,2) ! gas diffusivity constants (spp, #) (cm^2/s) (mult. by 10^-9)
- data (d_con_g(1,i),i=1,2) /0.1875_r8, 0.0013_r8/ ! CH4
- data (d_con_g(2,i),i=1,2) /0.1759_r8, 0.00117_r8/ ! O2
- data (d_con_g(3,i),i=1,2) /0.1325_r8, 0.0009_r8/ ! CO2
-
- real(r8) :: c_h_inv(ngases) ! constant (K) for Henry's law (4.12, Wania)
- data c_h_inv(1:3) /1600._r8, 1500._r8, 2400._r8/ ! CH4, O2, CO2
-
- real(r8) :: kh_theta(ngases) ! Henry's constant (L.atm/mol) at standard temperature (298K)
- data kh_theta(1:3) /714.29_r8, 769.23_r8, 29.4_r8/ ! CH4, O2, CO2
-
- real(r8) :: kh_tbase = 298._r8 ! base temperature for calculation of Henry's constant (K)
- !-----------------------------------------------------------------------
contains
!------------------------------------------------------------------------------
- subroutine clm_varcon_init( is_simple_buildtemp )
+ subroutine clm_varcon_init()
!
! !DESCRIPTION:
! This subroutine initializes constant arrays in clm_varcon.
! MUST be called after clm_varpar_init.
!
! !USES:
- use clm_varpar, only: nlevgrnd, nlevlak, nlevdecomp_full, nlevsoifl, nlayer
+ use clm_varpar, only: nlevgrnd
!
! !ARGUMENTS:
implicit none
- logical, intent(in) :: is_simple_buildtemp ! If simple building temp method is being used
!
! !REVISION HISTORY:
! Created by E. Kluzek
!------------------------------------------------------------------------------
- allocate( zlak(1:nlevlak ))
- allocate( dzlak(1:nlevlak ))
allocate( zsoi(1:nlevgrnd ))
- allocate( dzsoi(1:nlevgrnd ))
- allocate( zisoi(0:nlevgrnd ))
- allocate( dzsoi_decomp(1:nlevdecomp_full ))
- allocate( nlvic(1:nlayer ))
- allocate( dzvic(1:nlayer ))
- allocate( zsoifl(1:nlevsoifl ))
- allocate( zisoifl(0:nlevsoifl ))
- allocate( dzsoifl(1:nlevsoifl ))
-
- ! Zero out wastheat factors for simpler building temperature method (introduced in CLM4.5)
- if ( is_simple_buildtemp )then
- ht_wasteheat_factor = 0.0_r8
- ac_wasteheat_factor = 0.0_r8
- end if
end subroutine clm_varcon_init
diff --git a/src/main/clm_varctl.F90 b/src/main/clm_varctl.F90
index a60aa1f6..ed776822 100644
--- a/src/main/clm_varctl.F90
+++ b/src/main/clm_varctl.F90
@@ -11,8 +11,6 @@ module clm_varctl
! !PUBLIC MEMBER FUNCTIONS:
implicit none
public :: clm_varctl_set ! Set variables
- public :: cnallocate_carbon_only_set
- public :: cnallocate_carbon_only
!
private
save
@@ -85,31 +83,20 @@ module clm_varctl
!----------------------------------------------------------
character(len=fname_len), public :: finidat = ' ' ! initial conditions file name
- character(len=fname_len), public :: fsurdat = ' ' ! surface data file name
character(len=fname_len), public :: fatmgrid = ' ' ! atm grid file name
character(len=fname_len), public :: fatmlndfrc = ' ' ! lnd frac file on atm grid
- character(len=fname_len), public :: paramfile = ' ' ! ASCII data file with PFT physiological constants
character(len=fname_len), public :: nrevsn = ' ' ! restart data file name for branch run
- character(len=fname_len), public :: fsnowoptics = ' ' ! snow optical properties file name
- character(len=fname_len), public :: fsnowaging = ' ' ! snow aging parameters file name
!----------------------------------------------------------
! MML input files
!----------------------------------------------------------
character(len=fname_len), public :: mml_surdat = ' ' ! MML surface data file for simple model
- !----------------------------------------------------------
- ! Flag to read ndep rather than obtain it from coupler
- !----------------------------------------------------------
-
- logical, public :: ndep_from_cpl = .false.
!----------------------------------------------------------
! Interpolation of finidat if requested
!----------------------------------------------------------
- logical, public :: bound_h2osoi = .true. ! for debugging
-
! If finidat_interp_source is non-blank and finidat is blank then interpolation will be
! done from finidat_interp_source to finidat_interp_dest. Note that
! finidat_interp_source is not read in directly from the namelist - rather, it is set
@@ -118,157 +105,13 @@ module clm_varctl
character(len=fname_len), public :: finidat_interp_source = ' '
character(len=fname_len), public :: finidat_interp_dest = 'finidat_interp_dest.nc'
- !----------------------------------------------------------
- ! Crop & Irrigation logic
- !----------------------------------------------------------
-
- ! If prognostic crops are turned on
- logical, public :: use_crop = .false.
-
- ! true => separate crop landunit is not created by default
- logical, public :: create_crop_landunit = .false.
-
- ! do not irrigate by default
- logical, public :: irrigate = .false.
-
- !----------------------------------------------------------
- ! Other subgrid logic
- !----------------------------------------------------------
-
- ! true => make ALL patches, cols & landunits active (even if weight is 0)
- logical, public :: all_active = .false.
-
- !----------------------------------------------------------
- ! BGC logic and datasets
- !----------------------------------------------------------
-
- ! values of 'prognostic','diagnostic','constant'
- character(len=16), public :: co2_type = 'constant'
-
- ! State of the model for the accelerated decomposition (AD) spinup.
- ! 0 (default) = normal model; 1 = AD SPINUP
- integer, public :: spinup_state = 0
-
- ! true => anoxia is applied to heterotrophic respiration also considered in CH4 model
- ! default value reset in controlMod
- logical, public :: anoxia = .true.
-
- ! used to override an error check on reading in restart files
- logical, public :: override_bgc_restart_mismatch_dump = .false.
-
- ! Set in CNAllocationInit (TODO - had to move it here to avoid circular dependency)
- logical, private:: carbon_only
-
- ! Set in CNNDynamicsInit
- ! NOTE (mvertens, 2014-9 had to move it here to avoid confusion when carbon data types
- ! wehre split - TODO - should move it our of this module)
- ! NOTE(bandre, 2013-10) according to Charlie Koven, nfix_timeconst
- ! is currently used as a flag and rate constant.
- ! Rate constant: time over which to exponentially relax the npp flux for N fixation term
- ! (days) time over which to exponentially relax the npp flux for N fixation term
- ! flag: (if <= 0. or >= 365; use old annual method).
- ! Default value is junk that should always be overwritten by the namelist or init function!
- !
- real(r8), public :: nfix_timeconst = -1.2345_r8
-
!----------------------------------------------------------
! Physics
!----------------------------------------------------------
- ! use subgrid fluxes
- integer, public :: subgridflag = 1
-
! true => write global average diagnostics to std out
logical, public :: wrtdia = .false.
- ! atmospheric CO2 molar ratio (by volume) (umol/mol)
- real(r8), public :: co2_ppmv = 355._r8 !
-
- !----------------------------------------------------------
- ! C isotopes
- !----------------------------------------------------------
-
- logical, public :: use_c13 = .false. ! true => use C-13 model
- logical, public :: use_c14 = .false. ! true => use C-14 model
-
- !----------------------------------------------------------
- ! FATES switches
- !----------------------------------------------------------
-
- logical, public :: use_fates = .false. ! true => use fates
-
- ! These are INTERNAL to the FATES module
- logical, public :: use_fates_spitfire = .false. ! true => use spitfire model
- logical, public :: use_fates_logging = .false. ! true => turn on logging module
- logical, public :: use_fates_planthydro = .false. ! true => turn on fates hydro
- logical, public :: use_fates_ed_st3 = .false. ! true => static stand structure
- logical, public :: use_fates_ed_prescribed_phys = .false. ! true => prescribed physiology
- logical, public :: use_fates_inventory_init = .false. ! true => initialize fates from inventory
- character(len=256), public :: fates_inventory_ctrl_filename = '' ! filename for inventory control
-
- !----------------------------------------------------------
- ! LUNA switches
- !----------------------------------------------------------
-
- logical, public :: use_luna = .false. ! true => use LUNA
-
- !----------------------------------------------------------
- ! flexibleCN
- !----------------------------------------------------------
- ! TODO(bja, 2015-08) some of these need to be moved into the
- ! appropriate module.
- logical, public :: use_flexibleCN = .false.
- logical, public :: MM_Nuptake_opt = .false.
- logical, public :: downreg_opt = .true.
- integer, public :: plant_ndemand_opt = 0
- logical, public :: substrate_term_opt = .true.
- logical, public :: nscalar_opt = .true.
- logical, public :: temp_scalar_opt = .true.
- logical, public :: CNratio_floating = .false.
- logical, public :: lnc_opt = .false.
- logical, public :: reduce_dayl_factor = .false.
- integer, public :: vcmax_opt = 0
- integer, public :: CN_residual_opt = 0
- integer, public :: CN_partition_opt = 0
- integer, public :: CN_evergreen_phenology_opt = 0
- integer, public :: carbon_resp_opt = 0
-
- !----------------------------------------------------------
- ! lai streams switch for Sat. Phenology
- !----------------------------------------------------------
-
- logical, public :: use_lai_streams = .false. ! true => use lai streams in SatellitePhenologyMod.F90
-
- !----------------------------------------------------------
- ! bedrock / soil depth switch
- !----------------------------------------------------------
-
- logical, public :: use_bedrock = .false. ! true => use spatially variable soil depth
- character(len=16), public :: soil_layerstruct = '10SL_3.5m'
-
- !----------------------------------------------------------
- ! plant hydraulic stress switch
- !----------------------------------------------------------
-
- logical, public :: use_hydrstress = .false. ! true => use plant hydraulic stress calculation
-
- !----------------------------------------------------------
- ! dynamic root switch
- !----------------------------------------------------------
-
- logical, public :: use_dynroot = .false. ! true => use dynamic root module
-
- !----------------------------------------------------------
- ! glacier_mec control variables: default values (may be overwritten by namelist)
- !----------------------------------------------------------
-
- ! true => CLM glacier area & topography changes dynamically
- logical , public :: glc_do_dynglacier = .false.
-
- ! number of days before one considers the perennially snow-covered point 'land ice'
- integer , public :: glc_snow_persistence_max_days = 7300
-
- !
!----------------------------------------------------------
! single column control variables
!----------------------------------------------------------
@@ -302,37 +145,11 @@ module clm_varctl
! file name for local restart pointer file
character(len=256), public :: rpntfil = 'rpointer.lnd'
- ! moved hist_wrtch4diag from histFileMod.F90 to here - caused compiler error with intel
- ! namelist: write CH4 extra diagnostic output
- logical, public :: hist_wrtch4diag = .false.
-
- !----------------------------------------------------------
- ! FATES
- !----------------------------------------------------------
- character(len=fname_len), public :: fates_paramfile = ' '
-
!----------------------------------------------------------
! Migration of CPP variables
!----------------------------------------------------------
-
- logical, public :: use_lch4 = .false.
- logical, public :: use_nitrif_denitrif = .false.
- logical, public :: use_vertsoilc = .false.
- logical, public :: use_extralakelayers = .false.
- logical, public :: use_vichydro = .false.
- logical, public :: use_century_decomp = .false.
- logical, public :: use_cn = .false.
- logical, public :: use_cndv = .false.
- logical, public :: use_grainproduct = .false.
- logical, public :: use_fertilizer = .false.
- logical, public :: use_ozone = .false.
- logical, public :: use_snicar_frc = .false.
- logical, public :: use_vancouver = .false.
- logical, public :: use_mexicocity = .false.
logical, public :: use_noio = .false.
- logical, public :: use_nguardrail = .false.
-
!----------------------------------------------------------
! To retrieve namelist
!----------------------------------------------------------
@@ -382,15 +199,4 @@ subroutine clm_varctl_set( caseid_in, ctitle_in, brnch_retain_casename_in, &
end subroutine clm_varctl_set
- ! Set module carbon_only flag
- subroutine cnallocate_carbon_only_set(carbon_only_in)
- logical, intent(in) :: carbon_only_in
- carbon_only = carbon_only_in
- end subroutine cnallocate_carbon_only_set
-
- ! Get module carbon_only flag
- logical function CNAllocate_Carbon_only()
- cnallocate_carbon_only = carbon_only
- end function CNAllocate_Carbon_only
-
end module clm_varctl
diff --git a/src/main/clm_varpar.F90 b/src/main/clm_varpar.F90
index d2011dca..46343210 100644
--- a/src/main/clm_varpar.F90
+++ b/src/main/clm_varpar.F90
@@ -7,84 +7,21 @@ module clm_varpar
! !USES:
use shr_kind_mod , only: r8 => shr_kind_r8
use spmdMod , only: masterproc
- use clm_varctl , only: use_extralakelayers, use_vertsoilc
- use clm_varctl , only: use_century_decomp, use_c13, use_c14
- use clm_varctl , only: iulog, use_crop, create_crop_landunit, irrigate
- use clm_varctl , only: use_vichydro, soil_layerstruct
- use clm_varctl , only: use_fates
+ use clm_varctl , only: iulog
- !
! !PUBLIC TYPES:
implicit none
save
! Note - model resolution is read in from the surface dataset
- integer, parameter :: nlev_equalspace = 15
- integer, parameter :: toplev_equalspace = 6
- integer :: nlevsoi ! number of hydrologically active soil layers
- integer :: nlevsoifl ! number of soil layers on input file
integer :: nlevgrnd ! number of ground layers
! (includes lower layers that are hydrologically inactive)
- integer :: nlevurb ! number of urban layers
- integer :: nlevlak ! number of lake layers
- integer :: nlevdecomp ! number of biogeochemically active soil layers
- integer :: nlevdecomp_full ! number of biogeochemical layers
! (includes lower layers that are biogeochemically inactive)
- integer :: nlevsno = -1 ! maximum number of snow layers
- integer, parameter :: ngases = 3 ! CH4, O2, & CO2
- integer, parameter :: nlevcan = 1 ! number of leaf layers in canopy layer
- integer, parameter :: nvegwcs = 4 ! number of vegetation water conductance segments
!ED variables
- integer, parameter :: numwat = 5 ! number of water types (soil, ice, 2 lakes, wetland)
integer, parameter :: numrad = 2 ! number of solar radiation bands: vis, nir
- integer, parameter :: ivis = 1 ! index for visible band
- integer, parameter :: inir = 2 ! index for near-infrared band
- integer, parameter :: numsolar = 2 ! number of solar type bands: direct, diffuse
integer, parameter :: ndst = 4 ! number of dust size classes (BGC only)
- integer, parameter :: dst_src_nbr = 3 ! number of size distns in src soil (BGC only)
- integer, parameter :: sz_nbr = 200 ! number of sub-grid bins in large bin of dust size distribution (BGC only)
- integer, parameter :: mxpft = 78 ! maximum number of PFT's for any mode;
- ! FIX(RF,032414) might we set some of these automatically from reading pft-physiology?
- integer, parameter :: numveg = 16 ! number of veg types (without specific crop)
- integer, parameter :: nlayer = 3 ! number of VIC soil layer --Added by AWang
- integer :: nlayert ! number of VIC soil layer + 3 lower thermal layers
- integer, parameter :: nvariants = 2 ! number of variants of PFT constants
-
- integer :: numpft = mxpft ! actual # of pfts (without bare)
- integer :: numcft = 64 ! actual # of crops (includes unused CFTs that are merged into other CFTs)
- integer :: maxpatch_urb= 5 ! max number of urban patches (columns) in urban landunit
-
- integer :: maxpatch_pft ! max number of plant functional types in naturally vegetated landunit (namelist setting)
-
- ! constants for decomposition cascade
-
- integer, parameter :: i_met_lit = 1
- integer, parameter :: i_cel_lit = i_met_lit + 1
- integer, parameter :: i_lig_lit = i_cel_lit + 1
- integer :: i_cwd
-
- integer :: ndecomp_pools
- integer :: ndecomp_cascade_transitions
- ! Indices used in surface file read and set in clm_varpar_init
-
- integer :: natpft_lb ! In PATCH arrays, lower bound of Patches on the natural veg landunit (i.e., bare ground index)
- integer :: natpft_ub ! In PATCH arrays, upper bound of Patches on the natural veg landunit
- integer :: natpft_size ! Number of Patches on natural veg landunit (including bare ground)
-
- ! The following variables pertain to arrays of all PFTs - e.g., those dimensioned (g,
- ! pft_index). These include unused CFTs that are merged into other CFTs. Thus, these
- ! variables do NOT give the actual number of CFTs on the crop landunit - that number
- ! will generally be less because CLM does not simulate all crop types (some crop types
- ! are merged into other types).
- integer :: cft_lb ! In arrays of PFTs, lower bound of PFTs on the crop landunit
- integer :: cft_ub ! In arrays of PFTs, upper bound of PFTs on the crop landunit
- integer :: cft_size ! Number of PFTs on crop landunit in arrays of PFTs
-
- integer :: maxpatch_glcmec ! max number of elevation classes
- integer :: max_patch_per_col
- !
! !PUBLIC MEMBER FUNCTIONS:
public clm_varpar_init ! set parameters
!
@@ -106,110 +43,14 @@ subroutine clm_varpar_init()
character(len=32) :: subname = 'clm_varpar_init' ! subroutine name
!------------------------------------------------------------------------------
- ! Crop settings and consistency checks
-
- if (use_crop) then
- numpft = mxpft ! actual # of patches (without bare)
- numcft = 64 ! actual # of crops
- else
- numpft = numveg ! actual # of patches (without bare)
- numcft = 2 ! actual # of crops
- end if
-
- ! For arrays containing all Patches (natural veg & crop), determine lower and upper bounds
- ! for (1) Patches on the natural vegetation landunit (includes bare ground, and includes
- ! crops if create_crop_landunit=false), and (2) CFTs on the crop landunit (no elements
- ! if create_crop_landunit=false)
-
- if (create_crop_landunit) then
- natpft_size = (numpft + 1) - numcft ! note that numpft doesn't include bare ground -- thus we add 1
- cft_size = numcft
- else
- natpft_size = numpft + 1 ! note that numpft doesn't include bare ground -- thus we add 1
- cft_size = 0
- end if
-
- natpft_lb = 0
- natpft_ub = natpft_lb + natpft_size - 1
- cft_lb = natpft_ub + 1
- cft_ub = cft_lb + cft_size - 1
-
- ! TODO(wjs, 2015-10-04, bugz 2227) Using numcft in this 'max' gives a significant
- ! overestimate of max_patch_per_col when use_crop is true. This should be reworked -
- ! or, better, removed from the code entirely (because it is a maintenance problem, and
- ! I can't imagine that looping idioms that use it help performance that much, and
- ! likely they hurt performance.)
- max_patch_per_col= max(numpft+1, numcft, maxpatch_urb)
-
- nlevsoifl = 10
- nlevurb = 5
- if ( masterproc ) write(iulog, *) 'soil_layerstruct varpar ',soil_layerstruct
- if ( soil_layerstruct == '10SL_3.5m' ) then
- nlevsoi = nlevsoifl
- nlevgrnd = 15
- else if ( soil_layerstruct == '23SL_3.5m' ) then
- nlevsoi = 8 + nlev_equalspace
- nlevgrnd = 15 + nlev_equalspace
- else if ( soil_layerstruct == '49SL_10m' ) then
- nlevsoi = 49 ! 10x10 + 9x100 + 30x300 = 1e4mm = 10m
-! nlevsoi = 29 ! 10x10 + 9x100 + 10x300 = 4e3mm = 4m
- nlevgrnd = nlevsoi+5
- else if ( soil_layerstruct == '20SL_8.5m' ) then
- nlevsoi = 20
- nlevgrnd = nlevsoi+5
- endif
- if ( masterproc ) write(iulog, *) 'soil_layerstruct varpar ',soil_layerstruct,nlevsoi,nlevgrnd
-
- if (use_vichydro) then
- nlayert = nlayer + (nlevgrnd -nlevsoi)
- endif
-
- ! here is a switch to set the number of soil levels for the biogeochemistry calculations.
- ! currently it works on either a single level or on nlevsoi and nlevgrnd levels
- if (use_vertsoilc) then
- nlevdecomp = nlevsoi
- nlevdecomp_full = nlevgrnd
- else
- nlevdecomp = 1
- nlevdecomp_full = 1
- end if
-
- if (.not. use_extralakelayers) then
- nlevlak = 10 ! number of lake layers
- else
- nlevlak = 25 ! number of lake layers (Yields better results for site simulations)
- end if
+ nlevgrnd = 15
if ( masterproc )then
write(iulog, *) 'CLM varpar subsurface discretization levels '
- write(iulog, '(a, i3)') ' nlevsoi = ', nlevsoi
write(iulog, '(a, i3)') ' nlevgrnd = ', nlevgrnd
- write(iulog, '(a, i3)') ' nlevdecomp = ', nlevdecomp
- write(iulog, '(a, i3)') ' nlevdecomp_full = ', nlevdecomp_full
- write(iulog, '(a, i3)') ' nlevlak = ', nlevlak
write(iulog, *)
end if
- if ( use_fates ) then
- i_cwd = 0
- if (use_century_decomp) then
- ndecomp_pools = 6
- ndecomp_cascade_transitions = 8
- else
- ndecomp_pools = 7
- ndecomp_cascade_transitions = 7
- end if
- else
- i_cwd = 4
- if (use_century_decomp) then
- ndecomp_pools = 7
- ndecomp_cascade_transitions = 10
- else
- ndecomp_pools = 8
- ndecomp_cascade_transitions = 9
- end if
- endif
-
end subroutine clm_varpar_init
end module clm_varpar
diff --git a/src/main/clm_varsur.F90 b/src/main/clm_varsur.F90
deleted file mode 100644
index a86fe08c..00000000
--- a/src/main/clm_varsur.F90
+++ /dev/null
@@ -1,45 +0,0 @@
-module clm_instur
-
- !-----------------------------------------------------------------------
- ! Module containing 2-d surface boundary data information
- ! surface boundary data, these are all "gdc" local
- ! Note that some of these need to be pointers (as opposed to just allocatable arrays) to
- ! match the ncd_io interface; for consistency, we make them all pointers
- !
- ! !USES:
- use shr_kind_mod, only : r8 => shr_kind_r8
- !
- ! !PUBLIC TYPES:
- implicit none
- save
- !
- ! weight of each landunit on the grid cell
- real(r8), pointer :: wt_lunit(:,:)
-
- ! whether we have valid urban data in each grid cell
- logical , pointer :: urban_valid(:)
-
- ! for natural veg landunit, weight of each patch on the landunit (adds to 1.0 on the
- ! landunit for all all grid cells, even! those without any natural pft)
- ! (second dimension goes natpft_lb:natpft_ub)
- real(r8), pointer :: wt_nat_patch(:,:)
-
- ! for crop landunit, weight of each cft on the landunit (adds to 1.0 on the
- ! landunit for all all grid cells, even those without any crop)
- ! (second dimension goes cft_lb:cft_ub)
- real(r8), pointer :: wt_cft(:,:)
-
- ! for each cft on the crop landunit prescribe annual fertilizer
- ! landunit for all all grid cells, even those without any crop)
- ! (second dimension goes cft_lb:cft_ub)
- real(r8), pointer :: fert_cft(:,:)
-
- ! for glc_mec landunits, weight of glacier in each elevation class (adds to 1.0 on the
- ! landunit for all grid cells, even those without any glacier)
- real(r8), pointer :: wt_glc_mec(:,:)
-
- ! subgrid glacier_mec sfc elevation
- real(r8), pointer :: topo_glc_mec(:,:)
- !-----------------------------------------------------------------------
-
-end module clm_instur
diff --git a/src/main/column_varcon.F90 b/src/main/column_varcon.F90
deleted file mode 100644
index 287df93b..00000000
--- a/src/main/column_varcon.F90
+++ /dev/null
@@ -1,171 +0,0 @@
-module column_varcon
-
- !-----------------------------------------------------------------------
- ! !DESCRIPTION:
- ! Module containing column indices and associated variables and routines.
- !
- ! !USES:
-#include "shr_assert.h"
- use shr_log_mod , only : errMsg => shr_log_errMsg
- use landunit_varcon, only : isturb_MIN
- !
- ! !PUBLIC TYPES:
- implicit none
- save
- private
-
- !------------------------------------------------------------------
- ! Initialize column type constants
- !------------------------------------------------------------------
-
- ! urban column types
-
- integer, parameter, public :: icol_roof = isturb_MIN*10 + 1
- integer, parameter, public :: icol_sunwall = isturb_MIN*10 + 2
- integer, parameter, public :: icol_shadewall = isturb_MIN*10 + 3
- integer, parameter, public :: icol_road_imperv = isturb_MIN*10 + 4
- integer, parameter, public :: icol_road_perv = isturb_MIN*10 + 5
-
- !
- ! !PUBLIC MEMBER FUNCTIONS:
- public :: is_hydrologically_active ! returns true if the given column type is hydrologically active
- public :: icemec_class_to_col_itype ! convert an icemec class (1..maxpatch_glcmec) into col%itype
- public :: col_itype_to_icemec_class ! convert col%itype into an icemec class (1..maxpatch_glcmec)
- public :: write_coltype_metadata ! write column type metadata to a netcdf file
-
- character(len=*), parameter, private :: sourcefile = &
- __FILE__
-
-contains
-
- !-----------------------------------------------------------------------
- function is_hydrologically_active(col_itype, lun_itype) &
- result(hydrologically_active)
- !
- ! !DESCRIPTION:
- ! Returns a logical value saying whether the given column type is hydrologically
- ! active
- !
- ! Note that calling this can be bad for performance, because it operates on a single
- ! point rather than a loop. So in performance-critical parts of the code (or just
- ! about anywhere, really), you should use the pre-set col%hydrologically_active(c).
- !
- ! !USES:
- use landunit_varcon, only : istsoil, istcrop
- !
- ! !ARGUMENTS:
- logical :: hydrologically_active ! function result
- integer, intent(in) :: col_itype ! col%itype value
- integer, intent(in) :: lun_itype ! lun%itype value for the landunit on which this column sits
- !
- ! !LOCAL VARIABLES:
-
- character(len=*), parameter :: subname = 'is_hydrologically_active'
- !-----------------------------------------------------------------------
-
- ! If we had an easy way to figure out which landunit a column was on based on
- ! col_itype (which would be very helpful!), then we wouldn't need lun_itype.
-
- if (lun_itype == istsoil .or. lun_itype == istcrop) then
- hydrologically_active = .true.
- else if (col_itype == icol_road_perv) then
- hydrologically_active = .true.
- else
- hydrologically_active = .false.
- end if
-
- end function is_hydrologically_active
-
-
- !-----------------------------------------------------------------------
- function icemec_class_to_col_itype(icemec_class) result(col_itype)
- !
- ! !DESCRIPTION:
- ! Convert an icemec class (1..maxpatch_glcmec) into col%itype
- !
- ! !USES:
- use clm_varpar, only : maxpatch_glcmec
- use landunit_varcon, only : istice_mec
- !
- ! !ARGUMENTS:
- integer :: col_itype ! function result
- integer, intent(in) :: icemec_class ! icemec class, between 1 and maxpatch_glcmec
- !
- ! !LOCAL VARIABLES:
-
- character(len=*), parameter :: subname = 'icemec_class_to_col_itype'
- !-----------------------------------------------------------------------
-
- SHR_ASSERT((1 <= icemec_class .and. icemec_class <= maxpatch_glcmec), errMsg(sourcefile, __LINE__))
-
- col_itype = istice_mec*100 + icemec_class
-
- end function icemec_class_to_col_itype
-
- !-----------------------------------------------------------------------
- function col_itype_to_icemec_class(col_itype) result(icemec_class)
- !
- ! !DESCRIPTION:
- ! Convert a col%itype value (for an icemec landunit) into an icemec class (1..maxpatch_glcmec)
- !
- ! !USES:
- use clm_varpar, only : maxpatch_glcmec
- use landunit_varcon, only : istice_mec
- !
- ! !ARGUMENTS:
- integer :: icemec_class ! function result
- integer, intent(in) :: col_itype ! col%itype value for an icemec landunit
- !
- ! !LOCAL VARIABLES:
-
- character(len=*), parameter :: subname = 'col_itype_to_icemec_class'
- !-----------------------------------------------------------------------
-
- icemec_class = col_itype - istice_mec*100
-
- ! The following assertion is here to ensure that col_itype is really from an
- ! istice_mec landunit
- SHR_ASSERT((1 <= icemec_class .and. icemec_class <= maxpatch_glcmec), errMsg(sourcefile, __LINE__))
-
- end function col_itype_to_icemec_class
-
- !-----------------------------------------------------------------------
- subroutine write_coltype_metadata(att_prefix, ncid)
- !
- ! !DESCRIPTION:
- ! Writes column type metadata to a netcdf file.
- !
- ! Note that, unlike pft and landunit metadata, this column type metadata is NOT
- ! stored in an array. This is because of the trickiness of encoding column values for
- ! crop & icemec. So instead, other code must call this routine to do the work of
- ! adding the appropriate metadata directly to a netcdf file.
- !
- ! !USES:
- use ncdio_pio, only : file_desc_t, ncd_global, ncd_putatt
- !
- ! !ARGUMENTS:
- character(len=*) , intent(in) :: att_prefix ! prefix for attributes (e.g., 'icol_')
- type(file_desc_t) , intent(inout) :: ncid ! local file id
- !
- ! !LOCAL VARIABLES:
-
- character(len=*), parameter :: subname = 'write_coltype_metadata'
- !-----------------------------------------------------------------------
-
- call ncd_putatt(ncid, ncd_global, att_prefix // 'vegetated_or_bare_soil', 1)
- call ncd_putatt(ncid, ncd_global, att_prefix // 'crop' , 2)
- call ncd_putatt(ncid, ncd_global, att_prefix // 'crop_noncompete' , '2*100+m, m=cft_lb,cft_ub')
- call ncd_putatt(ncid, ncd_global, att_prefix // 'landice' , 3)
- call ncd_putatt(ncid, ncd_global, att_prefix // 'landice_multiple_elevation_classes', '4*100+m, m=1,glcnec')
- call ncd_putatt(ncid, ncd_global, att_prefix // 'deep_lake' , 5)
- call ncd_putatt(ncid, ncd_global, att_prefix // 'wetland' , 6)
- call ncd_putatt(ncid, ncd_global, att_prefix // 'urban_roof' , icol_roof)
- call ncd_putatt(ncid, ncd_global, att_prefix // 'urban_sunwall' , icol_sunwall)
- call ncd_putatt(ncid, ncd_global, att_prefix // 'urban_shadewall' , icol_shadewall)
- call ncd_putatt(ncid, ncd_global, att_prefix // 'urban_impervious_road' , icol_road_imperv)
- call ncd_putatt(ncid, ncd_global, att_prefix // 'urban_pervious_road' , icol_road_perv)
-
- end subroutine write_coltype_metadata
-
-
-end module column_varcon
diff --git a/src/main/controlMod.F90 b/src/main/controlMod.F90
index aef6715a..a05ac5e5 100644
--- a/src/main/controlMod.F90
+++ b/src/main/controlMod.F90
@@ -17,41 +17,24 @@ module controlMod
use abortutils , only: endrun
use spmdMod , only: masterproc
use decompMod , only: clump_pproc
- use clm_varcon , only: h2osno_max, int_snow_max, n_melt_glcmec
- use clm_varpar , only: maxpatch_pft, maxpatch_glcmec, numrad, nlevsno
- use histFileMod , only: max_tapes, max_namlen
- use histFileMod , only: hist_empty_htapes, hist_dov2xy, hist_avgflag_pertape, hist_type1d_pertape
- use histFileMod , only: hist_nhtfrq, hist_ndens, hist_mfilt, hist_fincl1, hist_fincl2, hist_fincl3
- use histFileMod , only: hist_fincl4, hist_fincl5, hist_fincl6, hist_fexcl1, hist_fexcl2, hist_fexcl3
- use histFileMod , only: hist_fexcl4, hist_fexcl5, hist_fexcl6
- use initInterpMod , only: initInterp_readnl
- use UrbanParamsType , only: UrbanReadNML
- use SurfaceAlbedoMod , only: albice
- use CNSharedParamsMod , only: use_fun
+ use clm_varpar , only: numrad
use clm_varctl , only: iundef, rundef, nsrest, caseid, ctitle, nsrStartup, nsrContinue
use clm_varctl , only: nsrBranch, brnch_retain_casename, hostname, username, source, version, conventions
- use clm_varctl , only: iulog, outnc_large_files, finidat, fsurdat, fatmgrid, fatmlndfrc, paramfile, nrevsn
- use clm_varctl , only: mml_surdat, finidat_interp_source, finidat_interp_dest, all_active, co2_type
- use clm_varctl , only: wrtdia, co2_ppmv, use_bedrock, soil_layerstruct, nsegspc, rpntdir, rpntfil
- use clm_varctl , only: use_cn, use_noio, NLFilename_in, use_century_decomp
- use clm_varctl , only: use_nitrif_denitrif, create_crop_landunit, glc_snow_persistence_max_days
- use clm_varctl , only: subgridflag, use_nguardrail, nfix_timeconst, use_vertsoilc
+ use clm_varctl , only: iulog, outnc_large_files, finidat, fatmgrid
+ use clm_varctl , only: wrtdia, nsegspc, rpntdir, rpntfil
+ use clm_varctl , only: NLFilename_in
use clm_varctl , only: clm_varctl_set
- use clm_varctl , only: use_lch4, irrigate, create_crop_landunit, use_crop, use_dynroot
- use clm_varctl , only: use_fates, use_flexiblecn, use_hydrstress, use_luna, spinup_state
use clm_varctl , only: single_column
!
! !PUBLIC TYPES:
implicit none
!
! !PUBLIC MEMBER FUNCTIONS:
- public :: control_setNL ! Set namelist filename
- public :: control_init ! initial run control information
- public :: control_print ! print run control information
- !
- !
- ! !PRIVATE MEMBER FUNCTIONS:
- private :: apply_use_init_interp ! apply the use_init_interp namelist option, if set
+ public :: control_setNL ! Set namelist filename
+ public :: control_init ! initial run control information
+ public :: control_readNL_Perf ! read in the namelist for SLIM performance settings
+ public :: control_readNL_Physics ! read in the namelist for SLIM physics settings
+ public :: control_print ! print run control information
!
! !PRIVATE TYPES:
character(len= 7) :: runtyp(4) ! run type
@@ -105,112 +88,33 @@ subroutine control_init( )
! Initialize CLM run control information
!
! !USES:
- use clm_time_manager , only : set_timemgr_init
use fileutils , only : getavu, relavu
+ use clm_time_manager , only : get_step_size
!
! !LOCAL VARIABLES:
integer :: i ! loop indices
integer :: ierr ! error code
integer :: unitn ! unit for namelist file
integer :: dtime ! Integer time-step
- integer :: override_nsrest ! If want to override the startup type sent from driver
- logical :: use_init_interp ! Apply initInterp to the file given by finidat
!------------------------------------------------------------------------
! ----------------------------------------------------------------------
! Namelist Variables
! ----------------------------------------------------------------------
- ! Time step
- namelist / clm_inparm/ &
- dtime
-
! CLM namelist settings
- namelist /clm_inparm / &
- fatmlndfrc, finidat, nrevsn, &
- finidat_interp_dest, &
- use_init_interp
-
! Input datasets
- namelist /clm_inparm/ &
- fsurdat, &
- paramfile
-
- ! MML Input datasets for simple model
- namelist /clm_inparm/ &
- mml_surdat
- ! MML forcing file w/ albedo, roughness, etc
- ! /glade/p/work/mlague/cesm_source/cesm1_5_beta05_mml_land/components/clm/bld/namelist_files/namelist_defaults.xml
- ! I think I need to modify one of the namelis_defaults xml files in the above folder in order for
- ! the model to know to accept my new namelist var...
-
- ! History, restart options
-
- namelist /clm_inparm/ &
- hist_empty_htapes, hist_dov2xy, &
- hist_avgflag_pertape, hist_type1d_pertape, &
- hist_nhtfrq, hist_ndens, hist_mfilt, &
- hist_fincl1, hist_fincl2, hist_fincl3, &
- hist_fincl4, hist_fincl5, hist_fincl6, &
- hist_fexcl1, hist_fexcl2, hist_fexcl3, &
- hist_fexcl4, hist_fexcl5, hist_fexcl6
-
- ! BGC info
-
- namelist /clm_inparm / &
- co2_type
-
- namelist /clm_inparm / use_fun
-
- ! Glacier_mec info
- namelist /clm_inparm/ &
- maxpatch_glcmec, &
- glc_snow_persistence_max_days, &
- nlevsno, h2osno_max, int_snow_max, n_melt_glcmec
-
! Other options
namelist /clm_inparm/ &
- clump_pproc, wrtdia, &
- create_crop_landunit, nsegspc, co2_ppmv, override_nsrest, &
- albice, soil_layerstruct, subgridflag, &
- all_active
-
- namelist /clm_inparm/ use_bedrock
+ clump_pproc, wrtdia
! All old cpp-ifdefs are below and have been converted to namelist variables
- ! max number of plant functional types in naturally vegetated landunit
- namelist /clm_inparm/ maxpatch_pft
-
- namelist /clm_inparm/ &
- use_vertsoilc, &
- use_century_decomp, use_cn, use_noio, &
- use_nguardrail, use_nitrif_denitrif
-
! Items not really needed, but do need to be properly set as they are used
- namelist / clm_inparm/ &
- use_lch4, &
- irrigate, &
- create_crop_landunit, &
- use_crop, &
- use_dynroot, &
- use_fates, &
- use_flexiblecn, &
- use_hydrstress, &
- use_luna, &
- spinup_state, &
- single_column
-
- logical :: use_fertilizer = .false.
- logical :: use_grainproduct = .false.
- logical :: use_lai_streams = .false.
- character(len=256) :: fsnowaging, fsnowoptics
- namelist /clm_inparm/ use_fertilizer, use_grainproduct, use_lai_streams, &
- fsnowaging, fsnowoptics
-
+ namelist / clm_inparm/ single_column
! ----------------------------------------------------------------------
! Default values
@@ -236,14 +140,10 @@ subroutine control_init( )
clump_pproc = 1
#endif
- override_nsrest = nsrest
-
- use_init_interp = .false.
-
if (masterproc) then
! ----------------------------------------------------------------------
- ! Read namelist from standard input.
+ ! Read namelist
! ----------------------------------------------------------------------
if ( len_trim(NLFilename) == 0 )then
@@ -259,7 +159,7 @@ subroutine control_init( )
call endrun(msg='ERROR reading clm_inparm namelist'//errMsg(sourcefile, __LINE__))
end if
else
- call endrun(msg='ERROR finding clm_inparm namelist'//errMsg(sourcefile, __LINE__))
+ write(iulog,*) 'Could not find clm_inparm namelist'
end if
call relavu( unitn )
@@ -268,96 +168,18 @@ subroutine control_init( )
! Process some namelist variables, and perform consistency checks
! ----------------------------------------------------------------------
- call set_timemgr_init( dtime_in=dtime )
-
! Check for namelist variables that SLIM can NOT use
- if ( use_fates )then
- call endrun(msg='ERROR SLIM can NOT run with use_fates on'//errMsg(sourcefile, __LINE__))
- end if
- if ( use_lai_streams )then
- call endrun(msg='ERROR SLIM can NOT run with use_lai_streams on'//errMsg(sourcefile, __LINE__))
- end if
- if ( use_dynroot )then
- call endrun(msg='ERROR SLIM can NOT run with use_dynroot on'//errMsg(sourcefile, __LINE__))
- end if
if ( single_column )then
call endrun(msg='ERROR SLIM can NOT run with single_column on'//errMsg(sourcefile, __LINE__))
end if
- if (use_init_interp) then
- call apply_use_init_interp(finidat, finidat_interp_source)
- end if
-
- ! History and restart files
-
- do i = 1, max_tapes
- if (hist_nhtfrq(i) == 0) then
- hist_mfilt(i) = 1
- else if (hist_nhtfrq(i) < 0) then
- hist_nhtfrq(i) = nint(-hist_nhtfrq(i)*SHR_CONST_CDAY/(24._r8*dtime))
- endif
- end do
-
- ! Override start-type (can only override to branch (3) and only
- ! if the driver is a startup type
- if ( override_nsrest /= nsrest )then
- if ( override_nsrest /= nsrBranch .and. nsrest /= nsrStartup )then
- call endrun(msg= ' ERROR: can ONLY override clm start-type ' // &
- 'to branch type and ONLY if driver is a startup type'// &
- errMsg(sourcefile, __LINE__))
- end if
- call clm_varctl_set( nsrest_in=override_nsrest )
- end if
-
- if (maxpatch_glcmec <= 0) then
- call endrun(msg=' ERROR: maxpatch_glcmec must be at least 1 ' // &
- errMsg(sourcefile, __LINE__))
- end if
-
- ! If nfix_timeconst is equal to the junk default value, then it was not specified
- ! by the user namelist and we need to assign it the correct default value. If the
- ! user specified it in the namelist, we leave it alone.
-
- if (nfix_timeconst == -1.2345_r8) then
- if (use_nitrif_denitrif) then
- nfix_timeconst = 10._r8
- else
- nfix_timeconst = 0._r8
- end if
- end if
-
- ! If nlevsno, h2osno_max, int_snow_max or n_melt_glcmec are equal to their junk
- ! default value, then they were not specified by the user namelist and we generate
- ! an error message. Also check nlevsno for bounds.
- if (nlevsno < 3 .or. nlevsno > 12) then
- write(iulog,*)'ERROR: nlevsno = ',nlevsno,' is not supported, must be in range 3-12.'
- call endrun(msg=' ERROR: invalid value for nlevsno in CLM namelist. '//&
- errMsg(sourcefile, __LINE__))
- endif
- if (h2osno_max <= 0.0_r8) then
- write(iulog,*)'ERROR: h2osno_max = ',h2osno_max,' is not supported, must be greater than 0.0.'
- call endrun(msg=' ERROR: invalid value for h2osno_max in CLM namelist. '//&
- errMsg(sourcefile, __LINE__))
- endif
- if (int_snow_max <= 0.0_r8) then
- write(iulog,*)'ERROR: int_snow_max = ',int_snow_max,' is not supported, must be greater than 0.0.'
- call endrun(msg=' ERROR: invalid value for int_snow_max in CLM namelist. '//&
- errMsg(sourcefile, __LINE__))
- endif
- if (n_melt_glcmec <= 0.0_r8) then
- write(iulog,*)'ERROR: n_melt_glcmec = ',n_melt_glcmec,' is not supported, must be greater than 0.0.'
- call endrun(msg=' ERROR: invalid value for n_melt_glcmec in CLM namelist. '//&
- errMsg(sourcefile, __LINE__))
- endif
-
endif ! end of if-masterproc if-block
! ----------------------------------------------------------------------
! Read in other namelists for other modules
! ----------------------------------------------------------------------
- call initInterp_readnl( NLFilename )
- call UrbanReadNML ( NLFilename )
+! call initInterp_readnl( NLFilename )
! ----------------------------------------------------------------------
! Broadcast all control information if appropriate
@@ -369,44 +191,124 @@ subroutine control_init( )
! consistency checks
! ----------------------------------------------------------------------
- ! Consistency settings for co2 type
- if (co2_type /= 'constant' .and. co2_type /= 'prognostic' .and. co2_type /= 'diagnostic') then
- write(iulog,*)'co2_type = ',co2_type,' is not supported'
- call endrun(msg=' ERROR:: choices are constant, prognostic or diagnostic'//&
- errMsg(sourcefile, __LINE__))
- end if
-
! Check on run type
if (nsrest == iundef) then
call endrun(msg=' ERROR:: must set nsrest'//&
errMsg(sourcefile, __LINE__))
end if
- if (nsrest == nsrBranch .and. nrevsn == ' ') then
- call endrun(msg=' ERROR: need to set restart data file name'//&
- errMsg(sourcefile, __LINE__))
- end if
+ if (masterproc) then
+ write(iulog,*) 'Successfully initialized run control settings'
+ write(iulog,*)
+ endif
- ! Consistency settings for co2_ppvm
- if ( (co2_ppmv <= 0.0_r8) .or. (co2_ppmv > 3000.0_r8) ) then
- call endrun(msg=' ERROR: co2_ppmv is out of a reasonable range'//&
- errMsg(sourcefile, __LINE__))
- end if
+ end subroutine control_init
- ! Consistency settings for nrevsn
+ !------------------------------------------------------------------------
+ subroutine control_readNL_Physics( )
+ !
+ ! !DESCRIPTION:
+ ! Initialize SLIM run physics information
+ !
+ ! !USES:
+ use shr_mpi_mod , only : shr_mpi_bcast
+ use clm_time_manager, only : set_timemgr_init
+ use spmdMod , only : mpicom
+ !
+ ! !LOCAL VARIABLES:
+ integer :: i ! loop indices
+ integer :: ierr ! error code
+ integer :: unitn ! unit for namelist file
+ integer :: dtime ! Integer time-step
+ character(len=*), parameter :: subname = "control_readNL_Physics"
+ character(len=*), parameter :: nmlName = "slim_inparm"
+ !------------------------------------------------------------------------
- if (nsrest == nsrStartup ) nrevsn = ' '
- if (nsrest == nsrContinue) nrevsn = 'set by restart pointer file file'
- if (nsrest /= nsrStartup .and. nsrest /= nsrContinue .and. nsrest /= nsrBranch ) then
- call endrun(msg=' ERROR: nsrest NOT set to a valid value'//&
- errMsg(sourcefile, __LINE__))
+ ! ----------------------------------------------------------------------
+ ! Namelist Variables
+ ! ----------------------------------------------------------------------
+
+ ! Time step
+ namelist / slim_inparm/ dtime
+
+ if (masterproc) then
+
+ ! ----------------------------------------------------------------------
+ ! Read namelist
+ ! ----------------------------------------------------------------------
+
+ if ( len_trim(NLFilename) == 0 )then
+ call endrun(msg=subname//'::ERROR: nlfilename not set'//errMsg(sourcefile, __LINE__))
+ end if
+ write(iulog,*) 'Read in '//nmlName//' namelist from: ', trim(NLFilename)
+ open( newunit=unitn, file=trim(NLFilename), status='old' )
+ call shr_nl_find_group_name(unitn, nmlName, status=ierr)
+ if (ierr == 0) then
+ read(unitn, slim_inparm, iostat=ierr)
+ if (ierr /= 0) then
+ call endrun(msg=subname//'::ERROR reading '//nmlName//' namelist'//errMsg(sourcefile, __LINE__))
+ end if
+ else
+ call endrun(msg=subname//'::ERROR reading '//nmlName//' namelist'//errMsg(sourcefile, __LINE__))
+ end if
+ close(unitn)
end if
+ call shr_mpi_bcast( dtime, mpicom )
+
+ call set_timemgr_init( dtime_in=dtime )
+
+ end subroutine control_readNL_Physics
+
+ !------------------------------------------------------------------------
+ subroutine control_readNL_Perf( )
+ !
+ ! !DESCRIPTION:
+ ! Initialize SLIM run performance information
+ !
+ ! !USES:
+ use shr_mpi_mod , only : shr_mpi_bcast
+ use clm_time_manager, only : set_timemgr_init
+ use spmdMod , only : mpicom
+ !
+ ! !LOCAL VARIABLES:
+ integer :: i ! loop indices
+ integer :: ierr ! error code
+ integer :: unitn ! unit for namelist file
+ character(len=*), parameter :: subname = "control_readNL_Perf"
+ character(len=*), parameter :: nmlName = "slim_perf"
+ !------------------------------------------------------------------------
+
+ ! ----------------------------------------------------------------------
+ ! Namelist Variables
+ ! ----------------------------------------------------------------------
+
+ ! Time step
+ namelist / slim_perf/ nsegspc
if (masterproc) then
- write(iulog,*) 'Successfully initialized run control settings'
- write(iulog,*)
- endif
- end subroutine control_init
+ ! ----------------------------------------------------------------------
+ ! Read namelist
+ ! ----------------------------------------------------------------------
+
+ if ( len_trim(NLFilename) == 0 )then
+ call endrun(msg=subname//'::ERROR: nlfilename not set'//errMsg(sourcefile, __LINE__))
+ end if
+ write(iulog,*) 'Read in '//nmlName//' namelist from: ', trim(NLFilename)
+ open( newunit=unitn, file=trim(NLFilename), status='old' )
+ call shr_nl_find_group_name(unitn, nmlName, status=ierr)
+ if (ierr == 0) then
+ read(unitn, slim_perf, iostat=ierr)
+ if (ierr /= 0) then
+ call endrun(msg=subname//'::ERROR reading '//nmlName//' namelist'//errMsg(sourcefile, __LINE__))
+ end if
+ else
+ call endrun(msg=subname//'::ERROR reading '//nmlName//' namelist'//errMsg(sourcefile, __LINE__))
+ end if
+ close(unitn)
+ end if
+ call shr_mpi_bcast( nsegspc, mpicom )
+
+ end subroutine control_readNL_Perf
!------------------------------------------------------------------------
subroutine control_spmd()
@@ -435,101 +337,9 @@ subroutine control_spmd()
call mpi_bcast (username, len(username), MPI_CHARACTER, 0, mpicom, ier)
call mpi_bcast (nsrest, 1, MPI_INTEGER, 0, mpicom, ier)
- call mpi_bcast (use_lch4, 1, MPI_LOGICAL, 0, mpicom, ier)
- call mpi_bcast (use_nitrif_denitrif, 1, MPI_LOGICAL, 0, mpicom, ier)
- call mpi_bcast (use_vertsoilc, 1, MPI_LOGICAL, 0, mpicom, ier)
- call mpi_bcast (use_century_decomp, 1, MPI_LOGICAL, 0, mpicom, ier)
- call mpi_bcast (use_cn, 1, MPI_LOGICAL, 0, mpicom, ier)
- call mpi_bcast (use_nguardrail, 1, MPI_LOGICAL, 0, mpicom, ier)
- call mpi_bcast (use_crop, 1, MPI_LOGICAL, 0, mpicom, ier)
- call mpi_bcast (use_noio, 1, MPI_LOGICAL, 0, mpicom, ier)
-
- ! initial file variables
- call mpi_bcast (nrevsn, len(nrevsn), MPI_CHARACTER, 0, mpicom, ier)
- call mpi_bcast (finidat, len(finidat), MPI_CHARACTER, 0, mpicom, ier)
- call mpi_bcast (finidat_interp_source, len(finidat_interp_source), MPI_CHARACTER, 0, mpicom, ier)
- call mpi_bcast (finidat_interp_dest, len(finidat_interp_dest), MPI_CHARACTER, 0, mpicom, ier)
- call mpi_bcast (fsurdat, len(fsurdat), MPI_CHARACTER, 0, mpicom, ier)
- call mpi_bcast (fatmlndfrc,len(fatmlndfrc),MPI_CHARACTER, 0, mpicom, ier)
- call mpi_bcast (paramfile, len(paramfile) , MPI_CHARACTER, 0, mpicom, ier)
-
- ! mml input file vars for simple model
- call mpi_bcast (mml_surdat, len(mml_surdat), MPI_CHARACTER, 0, mpicom, ier)
-
- ! Irrigation
- call mpi_bcast(irrigate, 1, MPI_LOGICAL, 0, mpicom, ier)
-
- ! Landunit generation
- call mpi_bcast(create_crop_landunit, 1, MPI_LOGICAL, 0, mpicom, ier)
-
- ! Other subgrid logic
- call mpi_bcast(all_active, 1, MPI_LOGICAL, 0, mpicom, ier)
-
- ! max number of plant functional types in naturally vegetated landunit
- call mpi_bcast(maxpatch_pft, 1, MPI_LOGICAL, 0, mpicom, ier)
-
- ! BGC
- call mpi_bcast (co2_type, len(co2_type), MPI_CHARACTER, 0, mpicom, ier)
- if (use_cn) then
- call mpi_bcast (nfix_timeconst, 1, MPI_REAL8, 0, mpicom, ier)
- call mpi_bcast (spinup_state, 1, MPI_INTEGER, 0, mpicom, ier)
- end if
-
- call mpi_bcast (use_fates, 1, MPI_LOGICAL, 0, mpicom, ier)
- ! flexibleCN nitrogen model
- call mpi_bcast (use_flexibleCN, 1, MPI_LOGICAL, 0, mpicom, ier)
-
- call mpi_bcast (use_luna, 1, MPI_LOGICAL, 0, mpicom, ier)
-
- call mpi_bcast (use_bedrock, 1, MPI_LOGICAL, 0, mpicom, ier)
-
- call mpi_bcast (use_hydrstress, 1, MPI_LOGICAL, 0, mpicom, ier)
-
- call mpi_bcast (use_dynroot, 1, MPI_LOGICAL, 0, mpicom, ier)
-
- if (use_cn) then
- call mpi_bcast (use_fun, 1, MPI_LOGICAL, 0, mpicom, ier)
- end if
-
! physics variables
- call mpi_bcast (nsegspc, 1, MPI_INTEGER, 0, mpicom, ier)
- call mpi_bcast (subgridflag , 1, MPI_INTEGER, 0, mpicom, ier)
call mpi_bcast (wrtdia, 1, MPI_LOGICAL, 0, mpicom, ier)
call mpi_bcast (single_column,1, MPI_LOGICAL, 0, mpicom, ier)
- call mpi_bcast (co2_ppmv, 1, MPI_REAL8,0, mpicom, ier)
- call mpi_bcast (albice, 2, MPI_REAL8,0, mpicom, ier)
- call mpi_bcast (soil_layerstruct,len(soil_layerstruct), MPI_CHARACTER, 0, mpicom, ier)
-
- ! snow pack variables
- call mpi_bcast (nlevsno, 1, MPI_INTEGER, 0, mpicom, ier)
- call mpi_bcast (h2osno_max, 1, MPI_REAL8, 0, mpicom, ier)
- call mpi_bcast (int_snow_max, 1, MPI_REAL8, 0, mpicom, ier)
- call mpi_bcast (n_melt_glcmec, 1, MPI_REAL8, 0, mpicom, ier)
-
- ! glacier_mec variables
- call mpi_bcast (maxpatch_glcmec, 1, MPI_INTEGER, 0, mpicom, ier)
- call mpi_bcast (glc_snow_persistence_max_days, 1, MPI_INTEGER, 0, mpicom, ier)
-
- ! history file variables
- call mpi_bcast (hist_empty_htapes, 1, MPI_LOGICAL, 0, mpicom, ier)
- call mpi_bcast (hist_dov2xy, size(hist_dov2xy), MPI_LOGICAL, 0, mpicom, ier)
- call mpi_bcast (hist_nhtfrq, size(hist_nhtfrq), MPI_INTEGER, 0, mpicom, ier)
- call mpi_bcast (hist_mfilt, size(hist_mfilt), MPI_INTEGER, 0, mpicom, ier)
- call mpi_bcast (hist_ndens, size(hist_ndens), MPI_INTEGER, 0, mpicom, ier)
- call mpi_bcast (hist_avgflag_pertape, size(hist_avgflag_pertape), MPI_CHARACTER, 0, mpicom, ier)
- call mpi_bcast (hist_type1d_pertape, max_namlen*size(hist_type1d_pertape), MPI_CHARACTER, 0, mpicom, ier)
- call mpi_bcast (hist_fexcl1, max_namlen*size(hist_fexcl1), MPI_CHARACTER, 0, mpicom, ier)
- call mpi_bcast (hist_fexcl2, max_namlen*size(hist_fexcl2), MPI_CHARACTER, 0, mpicom, ier)
- call mpi_bcast (hist_fexcl3, max_namlen*size(hist_fexcl3), MPI_CHARACTER, 0, mpicom, ier)
- call mpi_bcast (hist_fexcl4, max_namlen*size(hist_fexcl4), MPI_CHARACTER, 0, mpicom, ier)
- call mpi_bcast (hist_fexcl5, max_namlen*size(hist_fexcl5), MPI_CHARACTER, 0, mpicom, ier)
- call mpi_bcast (hist_fexcl6, max_namlen*size(hist_fexcl6), MPI_CHARACTER, 0, mpicom, ier)
- call mpi_bcast (hist_fincl1, (max_namlen+2)*size(hist_fincl1), MPI_CHARACTER, 0, mpicom, ier)
- call mpi_bcast (hist_fincl2, (max_namlen+2)*size(hist_fincl2), MPI_CHARACTER, 0, mpicom, ier)
- call mpi_bcast (hist_fincl3, (max_namlen+2)*size(hist_fincl3), MPI_CHARACTER, 0, mpicom, ier)
- call mpi_bcast (hist_fincl4, (max_namlen+2)*size(hist_fincl4), MPI_CHARACTER, 0, mpicom, ier)
- call mpi_bcast (hist_fincl5, (max_namlen+2)*size(hist_fincl5), MPI_CHARACTER, 0, mpicom, ier)
- call mpi_bcast (hist_fincl6, (max_namlen+2)*size(hist_fincl6), MPI_CHARACTER, 0, mpicom, ier)
! restart file variables
@@ -563,58 +373,8 @@ subroutine control_print ()
write(iulog,*) ' username = ',trim(username)
write(iulog,*) ' hostname = ',trim(hostname)
write(iulog,*) 'process control parameters:'
- write(iulog,*) ' use_nitrif_denitrif = ', use_nitrif_denitrif
- write(iulog,*) ' use_vertsoilc = ', use_vertsoilc
- write(iulog,*) ' use_century_decomp = ', use_century_decomp
- write(iulog,*) ' use_cn = ', use_cn
- write(iulog,*) ' use_noio = ', use_noio
write(iulog,*) 'input data files:'
- write(iulog,*) ' PFT physiology and parameters file = ',trim(paramfile)
- if (fsurdat == ' ') then
- write(iulog,*) ' fsurdat, surface dataset not set'
- else
- write(iulog,*) ' surface data = ',trim(fsurdat)
- end if
- if (fatmlndfrc == ' ') then
- write(iulog,*) ' fatmlndfrc not set, setting frac/mask to 1'
- else
- write(iulog,*) ' land frac data = ',trim(fatmlndfrc)
- end if
- if (mml_surdat == ' ') then
- write(iulog,*) ' mml_surdat NOT set, check that we are using the default'
- else
- write(iulog,*) ' mml_surdat IS set, and = ',trim(mml_surdat)
- end if
- if (use_cn) then
- if (nfix_timeconst /= 0._r8) then
- write(iulog,*) ' nfix_timeconst, timescale for smoothing npp in N fixation term: ', nfix_timeconst
- else
- write(iulog,*) ' nfix_timeconst == zero, use standard N fixation scheme. '
- end if
-
- end if
-
- write(iulog,*) ' Number of snow layers =', nlevsno
- write(iulog,*) ' Max snow depth (mm) =', h2osno_max
- write(iulog,*) ' Limit applied to integrated snowfall when determining changes in'
- write(iulog,*) ' snow-covered fraction during melt (mm) =', int_snow_max
- write(iulog,*) ' SCA shape parameter for glc_mec columns (n_melt_glcmec) =', n_melt_glcmec
-
- write(iulog,*) ' glc number of elevation classes =', maxpatch_glcmec
- write(iulog,*) ' glc snow persistence max days = ', glc_snow_persistence_max_days
-
- if (nsrest == nsrStartup) then
- if (finidat /= ' ') then
- write(iulog,*) ' initial data: ', trim(finidat)
- else if (finidat_interp_source /= ' ') then
- write(iulog,*) ' initial data interpolated from: ', trim(finidat_interp_source)
- else
- write(iulog,*) ' initial data created by model (cold start)'
- end if
- else
- write(iulog,*) ' restart data = ',trim(nrevsn)
- end if
write(iulog,*) ' atmospheric forcing data is from cesm atm model'
write(iulog,*) 'Restart parameters:'
@@ -622,14 +382,6 @@ subroutine control_print ()
write(iulog,*)' restart pointer file name = ',trim(rpntfil)
write(iulog,*) 'model physics parameters:'
- if ( trim(co2_type) == 'constant' )then
- write(iulog,*) ' CO2 volume mixing ratio (umol/mol) = ', co2_ppmv
- else
- write(iulog,*) ' CO2 volume mixing ratio = ', co2_type
- end if
-
- write(iulog,*) ' land-ice albedos (unitless 0-1) = ', albice
- write(iulog,*) ' soil layer structure = ', soil_layerstruct
if (nsrest == nsrContinue) then
write(iulog,*) 'restart warning:'
write(iulog,*) ' Namelist not checked for agreement with initial run.'
@@ -640,48 +392,7 @@ subroutine control_print ()
write(iulog,*) ' Namelist not checked for agreement with initial run.'
write(iulog,*) ' Surface data set and reference date should not differ from initial run'
end if
- write(iulog,*) ' maxpatch_pft = ',maxpatch_pft
- write(iulog,*) ' nsegspc = ',nsegspc
end subroutine control_print
-
- !-----------------------------------------------------------------------
- subroutine apply_use_init_interp(finidat, finidat_interp_source)
- !
- ! !DESCRIPTION:
- ! Applies the use_init_interp option, setting finidat_interp_source to finidat
- !
- ! Should be called if use_init_interp is true.
- !
- ! Does error checking to ensure that it is valid to set use_init_interp to true,
- ! given the values of finidat and finidat_interp_source.
- !
- ! !USES:
- !
- ! !ARGUMENTS:
- character(len=*), intent(inout) :: finidat
- character(len=*), intent(inout) :: finidat_interp_source
- !
- ! !LOCAL VARIABLES:
-
- character(len=*), parameter :: subname = 'apply_use_init_interp'
- !-----------------------------------------------------------------------
-
- if (finidat == ' ') then
- call endrun(msg=' ERROR: Can only set use_init_interp if finidat is set')
- end if
-
- if (finidat_interp_source /= ' ') then
- call endrun(msg=' ERROR: Cannot set use_init_interp if finidat_interp_source is &
- &already set')
- end if
-
- finidat_interp_source = finidat
- finidat = ' '
-
- end subroutine apply_use_init_interp
-
-
-
end module controlMod
diff --git a/src/main/decompInitMod.F90 b/src/main/decompInitMod.F90
index 810c7c96..7aecff63 100644
--- a/src/main/decompInitMod.F90
+++ b/src/main/decompInitMod.F90
@@ -14,10 +14,6 @@ module decompInitMod
use clm_varctl , only : iulog
use clm_varcon , only : grlnd
use GridcellType , only : grc
- use LandunitType , only : lun
- use ColumnType , only : col
- use PatchType , only : patch
- use glcBehaviorMod , only : glc_behavior_type
use decompMod
use mct_mod , only : mct_gsMap_init, mct_gsMap_ngseg, mct_gsMap_nlseg, mct_gsmap_gsize
!
@@ -97,20 +93,8 @@ subroutine decompInit_lnd(lni,lnj,amask)
procinfo%nclumps = clump_pproc
procinfo%cid(:) = -1
procinfo%ncells = 0
- procinfo%nlunits = 0
- procinfo%ncols = 0
- procinfo%npatches = 0
- procinfo%nCohorts = 0
procinfo%begg = 1
- procinfo%begl = 1
- procinfo%begc = 1
- procinfo%begp = 1
- procinfo%begCohort = 1
procinfo%endg = 0
- procinfo%endl = 0
- procinfo%endc = 0
- procinfo%endp = 0
- procinfo%endCohort = 0
allocate(clumps(nclumps), stat=ier)
if (ier /= 0) then
@@ -119,20 +103,8 @@ subroutine decompInit_lnd(lni,lnj,amask)
end if
clumps(:)%owner = -1
clumps(:)%ncells = 0
- clumps(:)%nlunits = 0
- clumps(:)%ncols = 0
- clumps(:)%npatches = 0
- clumps(:)%nCohorts = 0
clumps(:)%begg = 1
- clumps(:)%begl = 1
- clumps(:)%begc = 1
- clumps(:)%begp = 1
- clumps(:)%begCohort = 1
clumps(:)%endg = 0
- clumps(:)%endl = 0
- clumps(:)%endc = 0
- clumps(:)%endp = 0
- clumps(:)%endCohort = 0
! assign clumps to proc round robin
cid = 0
@@ -312,7 +284,7 @@ subroutine decompInit_lnd(lni,lnj,amask)
end subroutine decompInit_lnd
!------------------------------------------------------------------------------
- subroutine decompInit_clumps(lns,lni,lnj,glc_behavior)
+ subroutine decompInit_clumps(lns,lni,lnj)
!
! !DESCRIPTION:
! This subroutine initializes the land surface decomposition into a clump
@@ -320,13 +292,11 @@ subroutine decompInit_clumps(lns,lni,lnj,glc_behavior)
! set by clump_pproc
!
! !USES:
- use subgridMod, only : subgrid_get_gcellinfo
use spmdMod
!
! !ARGUMENTS:
implicit none
integer , intent(in) :: lns,lni,lnj ! land domain global size
- type(glc_behavior_type), intent(in) :: glc_behavior
!
! !LOCAL VARIABLES:
integer :: ln,an ! indices
@@ -336,10 +306,6 @@ subroutine decompInit_clumps(lns,lni,lnj,glc_behavior)
integer :: anumg ! lnd num gridcells
integer :: icells ! temporary
integer :: begg, endg ! temporary
- integer :: ilunits ! temporary
- integer :: icols ! temporary
- integer :: ipatches ! temporary
- integer :: icohorts ! temporary
integer :: ier ! error code
integer, allocatable :: allvecg(:,:) ! temporary vector "global"
integer, allocatable :: allvecl(:,:) ! temporary vector "local"
@@ -350,18 +316,11 @@ subroutine decompInit_clumps(lns,lni,lnj,glc_behavior)
!--- assign gridcells to clumps (and thus pes) ---
call get_proc_bounds(begg, endg)
- allocate(allvecl(nclumps,5)) ! local clumps [gcells,lunit,cols,patches,coh]
- allocate(allvecg(nclumps,5)) ! global clumps [gcells,lunit,cols,patches,coh]
+ allocate(allvecl(nclumps,5)) ! local clumps [gcells]
+ allocate(allvecg(nclumps,5)) ! global clumps [gcells]
- ! Determine the number of gridcells, landunits, columns, and patches, cohorts
+ ! Determine the number of gridcells
! on this processor
- ! Determine number of landunits, columns and patches for each global
- ! gridcell index (an) that is associated with the local gridcell index (ln)
-
- ilunits=0
- icols=0
- ipatches=0
- icohorts=0
allvecg= 0
allvecl= 0
@@ -369,101 +328,28 @@ subroutine decompInit_clumps(lns,lni,lnj,glc_behavior)
an = ldecomp%gdc2glo(anumg)
cid = lcid(an)
ln = anumg
- call subgrid_get_gcellinfo (ln, nlunits=ilunits, ncols=icols, npatches=ipatches, &
- ncohorts=icohorts, glc_behavior=glc_behavior)
allvecl(cid,1) = allvecl(cid,1) + 1
- allvecl(cid,2) = allvecl(cid,2) + ilunits ! number of landunits for local clump cid
- allvecl(cid,3) = allvecl(cid,3) + icols ! number of columns for local clump cid
- allvecl(cid,4) = allvecl(cid,4) + ipatches ! number of patches for local clump cid
- allvecl(cid,5) = allvecl(cid,5) + icohorts ! number of cohorts for local clump cid
enddo
call mpi_allreduce(allvecl,allvecg,size(allvecg),MPI_INTEGER,MPI_SUM,mpicom,ier)
- ! Determine overall total gridcells, landunits, columns and patches and distribute
+ ! Determine overall total gridcells and distribute
! gridcells over clumps
numg = 0
- numl = 0
- numc = 0
- nump = 0
- numCohort = 0
do cid = 1,nclumps
icells = allvecg(cid,1) ! number of all clump cid gridcells (over all processors)
- ilunits = allvecg(cid,2) ! number of all clump cid landunits (over all processors)
- icols = allvecg(cid,3) ! number of all clump cid columns (over all processors)
- ipatches = allvecg(cid,4) ! number of all clump cid patches (over all processors)
- icohorts = allvecg(cid,5) ! number of all clump cid cohorts (over all processors)
!--- overall total ---
numg = numg + icells ! total number of gridcells
- numl = numl + ilunits ! total number of landunits
- numc = numc + icols ! total number of columns
- nump = nump + ipatches ! total number of patches
- numCohort = numCohort + icohorts ! total number of cohorts
-
- !--- give gridcell to cid ---
- !--- increment the beg and end indices ---
- clumps(cid)%nlunits = clumps(cid)%nlunits + ilunits
- clumps(cid)%ncols = clumps(cid)%ncols + icols
- clumps(cid)%npatches = clumps(cid)%npatches + ipatches
- clumps(cid)%nCohorts = clumps(cid)%nCohorts + icohorts
-
- do m = 1,nclumps
- if ((clumps(m)%owner > clumps(cid)%owner) .or. &
- (clumps(m)%owner == clumps(cid)%owner .and. m > cid)) then
- clumps(m)%begl = clumps(m)%begl + ilunits
- clumps(m)%begc = clumps(m)%begc + icols
- clumps(m)%begp = clumps(m)%begp + ipatches
- clumps(m)%begCohort = clumps(m)%begCohort + icohorts
- endif
-
- if ((clumps(m)%owner > clumps(cid)%owner) .or. &
- (clumps(m)%owner == clumps(cid)%owner .and. m >= cid)) then
- clumps(m)%endl = clumps(m)%endl + ilunits
- clumps(m)%endc = clumps(m)%endc + icols
- clumps(m)%endp = clumps(m)%endp + ipatches
- clumps(m)%endCohort = clumps(m)%endCohort + icohorts
- endif
- enddo
!--- give gridcell to the proc that owns the cid ---
!--- increment the beg and end indices ---
- if (iam == clumps(cid)%owner) then
- procinfo%nlunits = procinfo%nlunits + ilunits
- procinfo%ncols = procinfo%ncols + icols
- procinfo%npatches = procinfo%npatches + ipatches
- procinfo%nCohorts = procinfo%nCohorts + icohorts
- endif
-
- if (iam > clumps(cid)%owner) then
- procinfo%begl = procinfo%begl + ilunits
- procinfo%begc = procinfo%begc + icols
- procinfo%begp = procinfo%begp + ipatches
- procinfo%begCohort = procinfo%begCohort + icohorts
- endif
-
- if (iam >= clumps(cid)%owner) then
- procinfo%endl = procinfo%endl + ilunits
- procinfo%endc = procinfo%endc + icols
- procinfo%endp = procinfo%endp + ipatches
- procinfo%endCohort = procinfo%endCohort + icohorts
- endif
- enddo
+ end do
do n = 1,nclumps
- if (clumps(n)%ncells /= allvecg(n,1) .or. &
- clumps(n)%nlunits /= allvecg(n,2) .or. &
- clumps(n)%ncols /= allvecg(n,3) .or. &
- clumps(n)%npatches /= allvecg(n,4) .or. &
- clumps(n)%nCohorts /= allvecg(n,5)) then
-
+ if (clumps(n)%ncells /= allvecg(n,1)) then
write(iulog ,*) 'decompInit_glcp(): allvecg error ncells ',iam,n,clumps(n)%ncells ,allvecg(n,1)
- write(iulog ,*) 'decompInit_glcp(): allvecg error lunits ',iam,n,clumps(n)%nlunits ,allvecg(n,2)
- write(iulog ,*) 'decompInit_glcp(): allvecg error ncols ',iam,n,clumps(n)%ncols ,allvecg(n,3)
- write(iulog ,*) 'decompInit_glcp(): allvecg error patches',iam,n,clumps(n)%npatches ,allvecg(n,4)
- write(iulog ,*) 'decompInit_glcp(): allvecg error cohorts',iam,n,clumps(n)%nCohorts ,allvecg(n,5)
-
call endrun(msg=errMsg(sourcefile, __LINE__))
endif
enddo
@@ -474,7 +360,7 @@ subroutine decompInit_clumps(lns,lni,lnj,glc_behavior)
end subroutine decompInit_clumps
!------------------------------------------------------------------------------
- subroutine decompInit_glcp(lns,lni,lnj,glc_behavior)
+ subroutine decompInit_glcp(lns,lni,lnj)
!
! !DESCRIPTION:
! Determine gsMaps for landunits, columns, patches and cohorts
@@ -482,32 +368,18 @@ subroutine decompInit_glcp(lns,lni,lnj,glc_behavior)
! !USES:
use spmdMod
use spmdGathScatMod
- use subgridMod, only : subgrid_get_gcellinfo
!
! !ARGUMENTS:
implicit none
integer , intent(in) :: lns,lni,lnj ! land domain global size
- type(glc_behavior_type), intent(in) :: glc_behavior
!
! !LOCAL VARIABLES:
integer :: gi,li,ci,pi,coi ! indices
integer :: i,g,k,l,n,np ! indices
integer :: cid,pid ! indices
integer :: begg,endg ! beg,end gridcells
- integer :: begl,endl ! beg,end landunits
- integer :: begc,endc ! beg,end columns
- integer :: begp,endp ! beg,end patches
- integer :: begCohort,endCohort! beg,end cohorts
integer :: numg ! total number of gridcells across all processors
- integer :: numl ! total number of landunits across all processors
- integer :: numc ! total number of columns across all processors
- integer :: nump ! total number of patches across all processors
- integer :: numCohort ! fates cohorts
integer :: icells ! temporary
- integer :: ilunits ! temporary
- integer :: icols ! temporary
- integer :: ipatches ! temporary
- integer :: icohorts ! temporary
integer :: ier ! error code
integer :: npmin,npmax,npint ! do loop values for printing
integer :: clmin,clmax ! do loop values for printing
@@ -517,9 +389,6 @@ subroutine decompInit_glcp(lns,lni,lnj,glc_behavior)
integer, pointer :: gindex(:) ! global index for gsMap init
integer, pointer :: arrayglob(:) ! temporaroy
integer, pointer :: gstart(:), gcount(:)
- integer, pointer :: lstart(:), lcount(:)
- integer, pointer :: cstart(:), ccount(:)
- integer, pointer :: pstart(:), pcount(:)
integer, pointer :: ioff(:)
integer, parameter :: dbug=1 ! 0 = min, 1=normal, 2=much, 3=max
character(len=32), parameter :: subname = 'decompInit_glcp'
@@ -527,9 +396,8 @@ subroutine decompInit_glcp(lns,lni,lnj,glc_behavior)
!init
- call get_proc_bounds(begg, endg, begl, endl, begc, endc, begp, endp, &
- begCohort, endCohort)
- call get_proc_global(ng=numg, nl=numl, nc=numc, np=nump, nCohorts=numCohort)
+ call get_proc_bounds(begg, endg)
+ call get_proc_global(ng=numg)
! Determine global seg megs
@@ -537,33 +405,16 @@ subroutine decompInit_glcp(lns,lni,lnj,glc_behavior)
gstart(:) = 0
allocate(gcount(begg:endg))
gcount(:) = 0
- allocate(lstart(begg:endg))
- lstart(:) = 0
- allocate(lcount(begg:endg))
- lcount(:) = 0
- allocate(cstart(begg:endg))
- cstart(:) = 0
- allocate(ccount(begg:endg))
- ccount(:) = 0
- allocate(pstart(begg:endg))
- pstart(:) = 0
- allocate(pcount(begg:endg))
- pcount(:) = 0
allocate(ioff(begg:endg))
ioff(:) = 0
- ! Determine gcount, lcount, ccount and pcount
+ ! Determine gcount
do gi = begg,endg
- call subgrid_get_gcellinfo (gi, nlunits=ilunits, ncols=icols, npatches=ipatches, &
- ncohorts=icohorts, glc_behavior=glc_behavior)
gcount(gi) = 1 ! number of gridcells for local gridcell index gi
- lcount(gi) = ilunits ! number of landunits for local gridcell index gi
- ccount(gi) = icols ! number of columns for local gridcell index gi
- pcount(gi) = ipatches ! number of patches for local gridcell index gi
enddo
- ! Determine gstart, lstart, cstart, pstart for the OUTPUT 1d data structures
+ ! Determine gstart
! gather the gdc subgrid counts to masterproc in glo order
! compute glo ordered start indices from the counts
@@ -586,48 +437,6 @@ subroutine decompInit_glcp(lns,lni,lnj,glc_behavior)
endif
call scatter_data_from_master(gstart, arrayglob, grlnd)
- ! lstart for gridcell (n) is the total number of the landunits
- ! over gridcells 1->n-1
-
- arrayglob(:) = 0
- call gather_data_to_master(lcount, arrayglob, grlnd)
- if (masterproc) then
- val1 = arrayglob(1)
- arrayglob(1) = 1
- do n = 2,ng
- val2 = arrayglob(n)
- arrayglob(n) = arrayglob(n-1) + val1
- val1 = val2
- enddo
- endif
- call scatter_data_from_master(lstart, arrayglob, grlnd)
-
- arrayglob(:) = 0
- call gather_data_to_master(ccount, arrayglob, grlnd)
- if (masterproc) then
- val1 = arrayglob(1)
- arrayglob(1) = 1
- do n = 2,ng
- val2 = arrayglob(n)
- arrayglob(n) = arrayglob(n-1) + val1
- val1 = val2
- enddo
- endif
- call scatter_data_from_master(cstart, arrayglob, grlnd)
-
- arrayglob(:) = 0
- call gather_data_to_master(pcount, arrayglob, grlnd)
- if (masterproc) then
- val1 = arrayglob(1)
- arrayglob(1) = 1
- do n = 2,ng
- val2 = arrayglob(n)
- arrayglob(n) = arrayglob(n-1) + val1
- val1 = val2
- enddo
- endif
- call scatter_data_from_master(pstart, arrayglob, grlnd)
-
deallocate(arrayglob)
! Gridcell gsmap (compressed, no ocean points)
@@ -656,56 +465,8 @@ subroutine decompInit_glcp(lns,lni,lnj,glc_behavior)
call mct_gsMap_init(gsmap_gce_gdc2glo, gindex, mpicom, comp_id, locsize, globsize)
deallocate(gindex)
- ! Landunit gsmap
-
- allocate(gindex(begl:endl))
- ioff(:) = 0
- do li = begl,endl
- gi = lun%gridcell(li) !===this is determined internally from how landunits are spread out in memory
- gindex(li) = lstart(gi) + ioff(gi) !=== the output gindex is ALWAYS the same regardless of how landuntis are spread out in memory
- ioff(gi) = ioff(gi) + 1
- ! check that this is less than [lstart(gi) + lcount(gi)]
- enddo
- locsize = endl-begl+1
- globsize = numl
- call mct_gsMap_init(gsmap_lun_gdc2glo, gindex, mpicom, comp_id, locsize, globsize)
- deallocate(gindex)
-
- ! Column gsmap
-
- allocate(gindex(begc:endc))
- ioff(:) = 0
- do ci = begc,endc
- gi = col%gridcell(ci)
- gindex(ci) = cstart(gi) + ioff(gi)
- ioff(gi) = ioff(gi) + 1
- ! check that this is less than [cstart(gi) + ccount(gi)]
- enddo
- locsize = endc-begc+1
- globsize = numc
- call mct_gsMap_init(gsmap_col_gdc2glo, gindex, mpicom, comp_id, locsize, globsize)
- deallocate(gindex)
-
- ! PATCH gsmap
-
- allocate(gindex(begp:endp))
- ioff(:) = 0
- do pi = begp,endp
- gi = patch%gridcell(pi)
- gindex(pi) = pstart(gi) + ioff(gi)
- ioff(gi) = ioff(gi) + 1
- ! check that this is less than [pstart(gi) + pcount(gi)]
- enddo
- locsize = endp-begp+1
- globsize = nump
- call mct_gsMap_init(gsmap_patch_gdc2glo, gindex, mpicom, comp_id, locsize, globsize)
- deallocate(gindex)
-
! Deallocate start/count arrays
deallocate(gstart, gcount)
- deallocate(lstart, lcount)
- deallocate(cstart, ccount)
- deallocate(pstart, pcount)
deallocate(ioff)
! Diagnostic output
@@ -715,19 +476,11 @@ subroutine decompInit_glcp(lns,lni,lnj,glc_behavior)
write(iulog,*)' longitude points = ',lni
write(iulog,*)' latitude points = ',lnj
write(iulog,*)' total number of gridcells = ',numg
- write(iulog,*)' total number of landunits = ',numl
- write(iulog,*)' total number of columns = ',numc
- write(iulog,*)' total number of patches = ',nump
- write(iulog,*)' total number of cohorts = ',numCohort
write(iulog,*)' Decomposition Characteristics'
write(iulog,*)' clumps per process = ',clump_pproc
write(iulog,*)' gsMap Characteristics'
write(iulog,*) ' lnd gsmap glo num of segs = ',mct_gsMap_ngseg(gsMap_lnd_gdc2glo)
write(iulog,*) ' gce gsmap glo num of segs = ',mct_gsMap_ngseg(gsMap_gce_gdc2glo)
- write(iulog,*) ' lun gsmap glo num of segs = ',mct_gsMap_ngseg(gsMap_lun_gdc2glo)
- write(iulog,*) ' col gsmap glo num of segs = ',mct_gsMap_ngseg(gsMap_col_gdc2glo)
- write(iulog,*) ' patch gsmap glo num of segs = ',mct_gsMap_ngseg(gsMap_patch_gdc2glo)
- write(iulog,*) ' coh gsmap glo num of segs = ',mct_gsMap_ngseg(gsMap_cohort_gdc2glo)
write(iulog,*)
end if
@@ -762,40 +515,12 @@ subroutine decompInit_glcp(lns,lni,lnj,glc_behavior)
' beg gridcell= ',procinfo%begg, &
' end gridcell= ',procinfo%endg, &
' total gridcells per proc= ',procinfo%ncells
- write(iulog,*)'proc= ',pid,&
- ' beg landunit= ',procinfo%begl, &
- ' end landunit= ',procinfo%endl, &
- ' total landunits per proc= ',procinfo%nlunits
- write(iulog,*)'proc= ',pid,&
- ' beg column = ',procinfo%begc, &
- ' end column = ',procinfo%endc, &
- ' total columns per proc = ',procinfo%ncols
- write(iulog,*)'proc= ',pid,&
- ' beg patch = ',procinfo%begp, &
- ' end patch = ',procinfo%endp, &
- ' total patches per proc = ',procinfo%npatches
- write(iulog,*)'proc= ',pid,&
- ' beg coh = ',procinfo%begCohort, &
- ' end coh = ',procinfo%endCohort, &
- ' total coh per proc = ',procinfo%nCohorts
write(iulog,*)'proc= ',pid,&
' lnd ngseg = ',mct_gsMap_ngseg(gsMap_lnd_gdc2glo), &
' lnd nlseg = ',mct_gsMap_nlseg(gsMap_lnd_gdc2glo,iam)
write(iulog,*)'proc= ',pid,&
' gce ngseg = ',mct_gsMap_ngseg(gsMap_gce_gdc2glo), &
' gce nlseg = ',mct_gsMap_nlseg(gsMap_gce_gdc2glo,iam)
- write(iulog,*)'proc= ',pid,&
- ' lun ngseg = ',mct_gsMap_ngseg(gsMap_lun_gdc2glo), &
- ' lun nlseg = ',mct_gsMap_nlseg(gsMap_lun_gdc2glo,iam)
- write(iulog,*)'proc= ',pid,&
- ' col ngseg = ',mct_gsMap_ngseg(gsMap_col_gdc2glo), &
- ' col nlseg = ',mct_gsMap_nlseg(gsMap_col_gdc2glo,iam)
- write(iulog,*)'proc= ',pid,&
- ' patch ngseg = ',mct_gsMap_ngseg(gsMap_patch_gdc2glo), &
- ' patch nlseg = ',mct_gsMap_nlseg(gsMap_patch_gdc2glo,iam)
- write(iulog,*)'proc= ',pid,&
- ' coh ngseg = ',mct_gsMap_ngseg(gsMap_cohort_gdc2glo), &
- ' coh nlseg = ',mct_gsMap_nlseg(gsMap_cohort_gdc2glo,iam)
write(iulog,*)'proc= ',pid,' nclumps = ',procinfo%nclumps
clmin = 1
@@ -812,26 +537,6 @@ subroutine decompInit_glcp(lns,lni,lnj,glc_behavior)
' beg gridcell= ',clumps(cid)%begg, &
' end gridcell= ',clumps(cid)%endg, &
' total gridcells per clump= ',clumps(cid)%ncells
- write(iulog,*)'proc= ',pid,' clump no = ',n, &
- ' clump id= ',procinfo%cid(n), &
- ' beg landunit= ',clumps(cid)%begl, &
- ' end landunit= ',clumps(cid)%endl, &
- ' total landunits per clump = ',clumps(cid)%nlunits
- write(iulog,*)'proc= ',pid,' clump no = ',n, &
- ' clump id= ',procinfo%cid(n), &
- ' beg column = ',clumps(cid)%begc, &
- ' end column = ',clumps(cid)%endc, &
- ' total columns per clump = ',clumps(cid)%ncols
- write(iulog,*)'proc= ',pid,' clump no = ',n, &
- ' clump id= ',procinfo%cid(n), &
- ' beg patch = ',clumps(cid)%begp, &
- ' end patch = ',clumps(cid)%endp, &
- ' total patches per clump = ',clumps(cid)%npatches
- write(iulog,*)'proc= ',pid,' clump no = ',n, &
- ' clump id= ',procinfo%cid(n), &
- ' beg cohort = ',clumps(cid)%begCohort, &
- ' end cohort = ',clumps(cid)%endCohort, &
- ' total cohorts per clump = ',clumps(cid)%nCohorts
end do
end if
call shr_sys_flush(iulog)
diff --git a/src/main/decompMod.F90 b/src/main/decompMod.F90
index 13204fab..1686bafe 100644
--- a/src/main/decompMod.F90
+++ b/src/main/decompMod.F90
@@ -10,7 +10,7 @@ module decompMod
! Must use shr_sys_abort rather than endrun here to avoid circular dependency
use shr_sys_mod , only : shr_sys_abort
use clm_varctl , only : iulog
- use clm_varcon , only : grlnd, nameg, namel, namec, namep, nameCohort
+ use clm_varcon , only : grlnd, nameg
use mct_mod , only : mct_gsMap
!
! !PUBLIC TYPES:
@@ -19,10 +19,6 @@ module decompMod
! Define possible bounds subgrid levels
integer, parameter, public :: BOUNDS_SUBGRID_GRIDCELL = 1
- integer, parameter, public :: BOUNDS_SUBGRID_LANDUNIT = 2
- integer, parameter, public :: BOUNDS_SUBGRID_COLUMN = 3
- integer, parameter, public :: BOUNDS_SUBGRID_PATCH = 4
- integer, parameter, public :: BOUNDS_SUBGRID_COHORT = 5
! Define possible bounds levels
integer, parameter, public :: BOUNDS_LEVEL_PROC = 1
@@ -33,8 +29,8 @@ module decompMod
public get_beg ! get beg bound for a given subgrid level
public get_end ! get end bound for a given subgrid level
public get_proc_clumps ! number of clumps for this processor
- public get_proc_total ! total no. of gridcells, landunits, columns and patchs for any processor
- public get_proc_global ! total gridcells, landunits, columns, patchs across all processors
+ public get_proc_total ! total no. of gridcells for any processor
+ public get_proc_global ! total gridcells across all processors
public get_clmlevel_gsize ! get global size associated with clmlevel
public get_clmlevel_gsmap ! get gsmap associated with clmlevel
@@ -42,13 +38,13 @@ module decompMod
module procedure get_clump_bounds_old
module procedure get_clump_bounds_new
end interface
- public get_clump_bounds ! clump beg and end gridcell,landunit,column,patch
+ public get_clump_bounds ! clump beg and end gridcell
interface get_proc_bounds
module procedure get_proc_bounds_old
module procedure get_proc_bounds_new
end interface
- public get_proc_bounds ! this processor beg and end gridcell,landunit,column,patch
+ public get_proc_bounds ! this processor beg and end gridcell
! !PRIVATE MEMBER FUNCTIONS:
!
@@ -57,18 +53,9 @@ module decompMod
integer,public :: nclumps ! total number of clumps across all processors
integer,public :: numg ! total number of gridcells on all procs
- integer,public :: numl ! total number of landunits on all procs
- integer,public :: numc ! total number of columns on all procs
- integer,public :: nump ! total number of patchs on all procs
- integer,public :: numCohort ! total number of fates cohorts on all procs
type bounds_type
integer :: begg, endg ! beginning and ending gridcell index
- integer :: begl, endl ! beginning and ending landunit index
- integer :: begc, endc ! beginning and ending column index
- integer :: begp, endp ! beginning and ending patch index
- integer :: begCohort, endCohort ! beginning and ending cohort indices
-
integer :: level ! whether defined on the proc or clump level
integer :: clump_index ! if defined on the clump level, this gives the clump index
end type bounds_type
@@ -79,15 +66,7 @@ module decompMod
integer :: nclumps ! number of clumps for processor_type iam
integer,pointer :: cid(:) ! clump indices
integer :: ncells ! number of gridcells in proc
- integer :: nlunits ! number of landunits in proc
- integer :: ncols ! number of columns in proc
- integer :: npatches ! number of patchs in proc
- integer :: nCohorts ! number of cohorts in proc
integer :: begg, endg ! beginning and ending gridcell index
- integer :: begl, endl ! beginning and ending landunit index
- integer :: begc, endc ! beginning and ending column index
- integer :: begp, endp ! beginning and ending patch index
- integer :: begCohort, endCohort ! beginning and ending cohort indices
end type processor_type
public processor_type
type(processor_type),public :: procinfo
@@ -96,15 +75,7 @@ module decompMod
type clump_type
integer :: owner ! process id owning clump
integer :: ncells ! number of gridcells in clump
- integer :: nlunits ! number of landunits in clump
- integer :: ncols ! number of columns in clump
- integer :: npatches ! number of patchs in clump
- integer :: nCohorts ! number of cohorts in proc
integer :: begg, endg ! beginning and ending gridcell index
- integer :: begl, endl ! beginning and ending landunit index
- integer :: begc, endc ! beginning and ending column index
- integer :: begp, endp ! beginning and ending patch index
- integer :: begCohort, endCohort ! beginning and ending cohort indices
end type clump_type
public clump_type
type(clump_type),public, allocatable :: clumps(:)
@@ -120,10 +91,6 @@ module decompMod
type(mct_gsMap) ,public,target :: gsMap_lnd_gdc2glo
type(mct_gsMap) ,public,target :: gsMap_gce_gdc2glo
- type(mct_gsMap) ,public,target :: gsMap_lun_gdc2glo
- type(mct_gsMap) ,public,target :: gsMap_col_gdc2glo
- type(mct_gsMap) ,public,target :: gsMap_patch_gdc2glo
- type(mct_gsMap) ,public,target :: gsMap_cohort_gdc2glo
!------------------------------------------------------------------------------
contains
@@ -135,7 +102,7 @@ pure function get_beg(bounds, subgrid_level) result(beg_index)
! Get beginning bounds for a given subgrid level
!
! subgrid_level should be one of the constants defined in this module:
- ! BOUNDS_SUBGRID_GRIDCELL, BOUNDS_SUBGRID_LANDUNIT, etc.
+ ! BOUNDS_SUBGRID_GRIDCELL, etc.
!
! Returns -1 for invalid subgrid_level (does not abort in this case, in order to keep
! this function pure).
@@ -155,14 +122,6 @@ pure function get_beg(bounds, subgrid_level) result(beg_index)
select case (subgrid_level)
case (BOUNDS_SUBGRID_GRIDCELL)
beg_index = bounds%begg
- case (BOUNDS_SUBGRID_LANDUNIT)
- beg_index = bounds%begl
- case (BOUNDS_SUBGRID_COLUMN)
- beg_index = bounds%begc
- case (BOUNDS_SUBGRID_PATCH)
- beg_index = bounds%begp
- case (BOUNDS_SUBGRID_COHORT)
- beg_index = bounds%begCohort
case default
beg_index = -1
end select
@@ -176,7 +135,7 @@ pure function get_end(bounds, subgrid_level) result(end_index)
! Get end bounds for a given subgrid level
!
! subgrid_level should be one of the constants defined in this module:
- ! BOUNDS_SUBGRID_GRIDCELL, BOUNDS_SUBGRID_LANDUNIT, etc.
+ ! BOUNDS_SUBGRID_GRIDCELL, etc.
!
! Returns -1 for invalid subgrid_level (does not abort in this case, in order to keep
! this function pure).
@@ -196,14 +155,6 @@ pure function get_end(bounds, subgrid_level) result(end_index)
select case (subgrid_level)
case (BOUNDS_SUBGRID_GRIDCELL)
end_index = bounds%endg
- case (BOUNDS_SUBGRID_LANDUNIT)
- end_index = bounds%endl
- case (BOUNDS_SUBGRID_COLUMN)
- end_index = bounds%endc
- case (BOUNDS_SUBGRID_PATCH)
- end_index = bounds%endp
- case (BOUNDS_SUBGRID_COHORT)
- end_index = bounds%endCohort
case default
end_index = -1
end select
@@ -231,26 +182,14 @@ subroutine get_clump_bounds_new (n, bounds)
!------------------------------------------------------------------------------
! Make sure this IS being called from a threaded region
#ifdef _OPENMP
- ! FIX(SPM, 090314) - for debugging fates and openMP
- !write(iulog,*) 'SPM omp debug decompMod 1 ', &
- !OMP_GET_NUM_THREADS(),OMP_GET_MAX_THREADS(),OMP_GET_THREAD_NUM()
-
if ( OMP_GET_NUM_THREADS() == 1 .and. OMP_GET_MAX_THREADS() > 1 )then
call shr_sys_abort( trim(subname)//' ERROR: Calling from inside a non-threaded region)')
end if
#endif
cid = procinfo%cid(n)
- bounds%begp = clumps(cid)%begp
- bounds%endp = clumps(cid)%endp
- bounds%begc = clumps(cid)%begc
- bounds%endc = clumps(cid)%endc
- bounds%begl = clumps(cid)%begl
- bounds%endl = clumps(cid)%endl
bounds%begg = clumps(cid)%begg
bounds%endg = clumps(cid)%endg
- bounds%begCohort = clumps(cid)%begCohort
- bounds%endCohort = clumps(cid)%endCohort
bounds%level = BOUNDS_LEVEL_CLUMP
bounds%clump_index = n
@@ -258,28 +197,15 @@ subroutine get_clump_bounds_new (n, bounds)
end subroutine get_clump_bounds_new
!------------------------------------------------------------------------------
- subroutine get_clump_bounds_old (n, begg, endg, begl, endl, begc, endc, begp, endp, &
- begCohort, endCohort)
+ subroutine get_clump_bounds_old (n, begg, endg)
integer, intent(in) :: n ! proc clump index
- integer, intent(out) :: begp, endp ! clump beg and end patch indices
- integer, intent(out) :: begc, endc ! clump beg and end column indices
- integer, intent(out) :: begl, endl ! clump beg and end landunit indices
integer, intent(out) :: begg, endg ! clump beg and end gridcell indices
- integer, intent(out) :: begCohort, endCohort ! cohort beg and end gridcell indices
integer :: cid ! clump id
!------------------------------------------------------------------------------
cid = procinfo%cid(n)
- begp = clumps(cid)%begp
- endp = clumps(cid)%endp
- begc = clumps(cid)%begc
- endc = clumps(cid)%endc
- begl = clumps(cid)%begl
- endl = clumps(cid)%endl
begg = clumps(cid)%begg
endg = clumps(cid)%endg
- begCohort = clumps(cid)%begCohort
- endCohort = clumps(cid)%endCohort
end subroutine get_clump_bounds_old
!------------------------------------------------------------------------------
@@ -301,25 +227,13 @@ subroutine get_proc_bounds_new (bounds)
!------------------------------------------------------------------------------
! Make sure this is NOT being called from a threaded region
#ifdef _OPENMP
- ! FIX(SPM, 090314) - for debugging fates and openMP
- !write(*,*) 'SPM omp debug decompMod 2 ', &
- !OMP_GET_NUM_THREADS(),OMP_GET_MAX_THREADS(),OMP_GET_THREAD_NUM()
-
if ( OMP_GET_NUM_THREADS() > 1 )then
call shr_sys_abort( trim(subname)//' ERROR: Calling from inside a threaded region')
end if
#endif
- bounds%begp = procinfo%begp
- bounds%endp = procinfo%endp
- bounds%begc = procinfo%begc
- bounds%endc = procinfo%endc
- bounds%begl = procinfo%begl
- bounds%endl = procinfo%endl
bounds%begg = procinfo%begg
bounds%endg = procinfo%endg
- bounds%begCohort = procinfo%begCohort
- bounds%endCohort = procinfo%endCohort
bounds%level = BOUNDS_LEVEL_PROC
bounds%clump_index = -1 ! irrelevant for proc, so assigned a bogus value
@@ -327,81 +241,48 @@ subroutine get_proc_bounds_new (bounds)
end subroutine get_proc_bounds_new
!------------------------------------------------------------------------------
- subroutine get_proc_bounds_old (begg, endg, begl, endl, begc, endc, begp, endp, &
- begCohort, endCohort)
+ subroutine get_proc_bounds_old (begg, endg)
- integer, optional, intent(out) :: begp, endp ! proc beg and end patch indices
- integer, optional, intent(out) :: begc, endc ! proc beg and end column indices
- integer, optional, intent(out) :: begl, endl ! proc beg and end landunit indices
integer, optional, intent(out) :: begg, endg ! proc beg and end gridcell indices
- integer, optional, intent(out) :: begCohort, endCohort ! cohort beg and end gridcell indices
!------------------------------------------------------------------------------
- if (present(begp)) begp = procinfo%begp
- if (present(endp)) endp = procinfo%endp
- if (present(begc)) begc = procinfo%begc
- if (present(endc)) endc = procinfo%endc
- if (present(begl)) begl = procinfo%begl
- if (present(endl)) endl = procinfo%endl
if (present(begg)) begg = procinfo%begg
if (present(endg)) endg = procinfo%endg
- if (present(begCohort)) begCohort = procinfo%begCohort
- if (present(endCohort)) endCohort = procinfo%endCohort
end subroutine get_proc_bounds_old
!------------------------------------------------------------------------------
- subroutine get_proc_total(pid, ncells, nlunits, ncols, npatches, nCohorts)
+ subroutine get_proc_total(pid, ncells)
!
! !DESCRIPTION:
- ! Count up gridcells, landunits, columns, and patchs on process.
+ ! Count up gridcells on process.
!
! !ARGUMENTS:
integer, intent(in) :: pid ! proc id
integer, intent(out) :: ncells ! total number of gridcells on the processor
- integer, intent(out) :: nlunits ! total number of landunits on the processor
- integer, intent(out) :: ncols ! total number of columns on the processor
- integer, intent(out) :: npatches ! total number of patchs on the processor
- integer, intent(out) :: nCohorts! total number of cohorts on the processor
!
! !LOCAL VARIABLES:
integer :: cid ! clump index
!------------------------------------------------------------------------------
- npatches = 0
- nlunits = 0
- ncols = 0
ncells = 0
- nCohorts = 0
do cid = 1,nclumps
if (clumps(cid)%owner == pid) then
ncells = ncells + clumps(cid)%ncells
- nlunits = nlunits + clumps(cid)%nlunits
- ncols = ncols + clumps(cid)%ncols
- npatches = npatches + clumps(cid)%npatches
- nCohorts = nCohorts + clumps(cid)%nCohorts
end if
end do
end subroutine get_proc_total
!------------------------------------------------------------------------------
- subroutine get_proc_global(ng, nl, nc, np, nCohorts)
+ subroutine get_proc_global(ng)
!
! !DESCRIPTION:
- ! Return number of gridcells, landunits, columns, and patchs across all processes.
+ ! Return number of gridcells across all processes.
!
! !ARGUMENTS:
integer, optional, intent(out) :: ng ! total number of gridcells across all processors
- integer, optional, intent(out) :: nl ! total number of landunits across all processors
- integer, optional, intent(out) :: nc ! total number of columns across all processors
- integer, optional, intent(out) :: np ! total number of patchs across all processors
- integer, optional, intent(out) :: nCohorts ! total number fates cohorts
!------------------------------------------------------------------------------
- if (present(np)) np = nump
- if (present(nc)) nc = numc
- if (present(nl)) nl = numl
if (present(ng)) ng = numg
- if (present(nCohorts)) nCohorts = numCohort
end subroutine get_proc_global
@@ -434,14 +315,6 @@ integer function get_clmlevel_gsize (clmlevel)
get_clmlevel_gsize = ldomain%ns
case(nameg)
get_clmlevel_gsize = numg
- case(namel)
- get_clmlevel_gsize = numl
- case(namec)
- get_clmlevel_gsize = numc
- case(namep)
- get_clmlevel_gsize = nump
- case(nameCohort)
- get_clmlevel_gsize = numCohort
case default
write(iulog,*) 'get_clmlevel_gsize does not match clmlevel type: ', trim(clmlevel)
call shr_sys_abort()
@@ -465,14 +338,6 @@ subroutine get_clmlevel_gsmap (clmlevel, gsmap)
gsmap => gsmap_lnd_gdc2glo
case(nameg)
gsmap => gsmap_gce_gdc2glo
- case(namel)
- gsmap => gsmap_lun_gdc2glo
- case(namec)
- gsmap => gsmap_col_gdc2glo
- case(namep)
- gsmap => gsmap_patch_gdc2glo
- case(nameCohort)
- gsmap => gsMap_cohort_gdc2glo
case default
write(iulog,*) 'get_clmlevel_gsmap: Invalid expansion character: ',trim(clmlevel)
call shr_sys_abort()
diff --git a/src/main/filterColMod.F90 b/src/main/filterColMod.F90
deleted file mode 100644
index 0c3e63ce..00000000
--- a/src/main/filterColMod.F90
+++ /dev/null
@@ -1,444 +0,0 @@
-module filterColMod
-
- !-----------------------------------------------------------------------
- ! !DESCRIPTION:
- ! Defines a type to hold column-level filters, along with factory methods to help create
- ! a column-level filter
- !
- ! To loop over the filter, use code like this:
- ! do fc = 1, myfilter%num
- ! c = myfilter%indices(fc)
- ! ...
- ! end do
- !
- ! !USES:
-#include "shr_assert.h"
- use shr_log_mod , only : errMsg => shr_log_errMsg
- use decompMod , only : bounds_type
- use GridcellType , only : grc
- use LandunitType , only : lun
- use ColumnType , only : col
- use clm_varcon , only : ispval
- use clm_varctl , only : iulog
-
- ! !PUBLIC TYPES:
- implicit none
- private
- save
-
- type, public :: filter_col_type
- integer :: num ! number of points in the filter
- integer, allocatable :: indices(:) ! column indices included in the filter
- contains
- procedure :: equals_filter
- generic :: operator(==) => equals_filter
- end type filter_col_type
-
- ! !PUBLIC ROUTINES:
-
- ! Create an empty filter
- public :: col_filter_empty
-
- ! Create a filter from an array of indices. This is mainly useful for unit testing.
- public :: col_filter_from_index_array
-
- ! Create a filter from a column-level logical array
- public :: col_filter_from_logical_array
-
- ! Create a filter from a column-level logical array, but including only active points
- public :: col_filter_from_logical_array_active_only
-
- ! Create a filter that contains one or more landunit type(s) of interest
- public :: col_filter_from_ltypes
-
- ! Create a filter from a landunit-level logical array
- public :: col_filter_from_lunflags
-
- ! Create a filter from a gridcell-level logical array and an array of landunit type(s)
- ! of interest
- public :: col_filter_from_grcflags_ltypes
-
- ! Create a filter from another filter subset by a column-level logical array
- public :: col_filter_from_filter_and_logical_array
-
- ! !PRIVATE ROUTINES:
-
- ! Whether a given column should be included in the filter based on the active flag
- private :: include_based_on_active
-
- character(len=*), parameter, private :: sourcefile = &
- __FILE__
-
-contains
-
- ! TODO(wjs, 2016-04-07) If repeated reallocation of the indices arrays (every time a
- ! filter is recreated - each time through the run loop) is a performance issue, then we
- ! could rewrite the creation functions to instead be subroutines that act on an existing
- ! filter object: I think this would involve replacing calls to col_filter_empty with
- ! something like filter%reset_filter; this would only allocate the indices array if it
- ! is not already allocated.
-
- !-----------------------------------------------------------------------
- function col_filter_empty(bounds) result(filter)
- !
- ! !DESCRIPTION:
- ! Initialize a filter object
- !
- ! !ARGUMENTS:
- type(filter_col_type) :: filter ! function result
- type(bounds_type), intent(in) :: bounds
- !
- ! !LOCAL VARIABLES:
-
- character(len=*), parameter :: subname = 'col_filter_empty'
- !-----------------------------------------------------------------------
-
- filter%num = 0
- allocate(filter%indices(bounds%endc - bounds%begc + 1))
-
- end function col_filter_empty
-
- !-----------------------------------------------------------------------
- function col_filter_from_index_array(bounds, indices_col) result(filter)
- !
- ! !DESCRIPTION:
- ! Create a filter from an array of indices.
- !
- ! This is mainly useful for unit testing.
- !
- ! !ARGUMENTS:
- type(filter_col_type) :: filter ! function result
- type(bounds_type), intent(in) :: bounds
- integer, intent(in) :: indices_col(:) ! column-level array of indices to include in filter
- !
- ! !LOCAL VARIABLES:
-
- character(len=*), parameter :: subname = 'col_filter_from_index_array'
- !-----------------------------------------------------------------------
-
- SHR_ASSERT_ALL(indices_col >= bounds%begc, errMsg(sourcefile, __LINE__))
- SHR_ASSERT_ALL(indices_col <= bounds%endc, errMsg(sourcefile, __LINE__))
-
- filter = col_filter_empty(bounds)
-
- filter%num = size(indices_col)
- filter%indices(1:filter%num) = indices_col
-
- end function col_filter_from_index_array
-
-
- !-----------------------------------------------------------------------
- function col_filter_from_logical_array(bounds, logical_col) result(filter)
- !
- ! !DESCRIPTION:
- ! Create a column-level filter from a column-level logical array.
- !
- ! This version does not consider whether a column is active: it simply includes any
- ! column 'c' for which logical_col(c) is .true.
- !
- ! !ARGUMENTS:
- type(filter_col_type) :: filter ! function result
- type(bounds_type), intent(in) :: bounds
- logical, intent(in) :: logical_col(bounds%begc:) ! column-level logical array
- !
- ! !LOCAL VARIABLES:
- integer :: c
-
- character(len=*), parameter :: subname = 'col_filter_from_logical_array'
- !-----------------------------------------------------------------------
-
- SHR_ASSERT_ALL((ubound(logical_col) == (/bounds%endc/)), errMsg(sourcefile, __LINE__))
-
- filter = col_filter_empty(bounds)
-
- do c = bounds%begc, bounds%endc
- if (logical_col(c)) then
- filter%num = filter%num + 1
- filter%indices(filter%num) = c
- end if
- end do
-
- end function col_filter_from_logical_array
-
- !-----------------------------------------------------------------------
- function col_filter_from_logical_array_active_only(bounds, logical_col) result(filter)
- !
- ! !DESCRIPTION:
- ! Create a column-level filter from a column-level logical array. Only include active
- ! points in the filter: even if the logical array is true for a given column, that
- ! column is excluded if it is inactive.
- !
- ! !USES:
- !
- ! !ARGUMENTS:
- type(filter_col_type) :: filter ! function result
- type(bounds_type), intent(in) :: bounds
- logical, intent(in) :: logical_col(bounds%begc:) ! column-level logical array
- !
- ! !LOCAL VARIABLES:
- integer :: c
-
- character(len=*), parameter :: subname = 'col_filter_from_logical_array_active_only'
- !-----------------------------------------------------------------------
-
- SHR_ASSERT_ALL((ubound(logical_col) == (/bounds%endc/)), errMsg(sourcefile, __LINE__))
-
- filter = col_filter_empty(bounds)
-
- do c = bounds%begc, bounds%endc
- if (col%active(c)) then
- if (logical_col(c)) then
- filter%num = filter%num + 1
- filter%indices(filter%num) = c
- end if
- end if
- end do
-
- end function col_filter_from_logical_array_active_only
-
-
- !-----------------------------------------------------------------------
- function col_filter_from_ltypes(bounds, ltypes, include_inactive) &
- result(filter)
- !
- ! !DESCRIPTION:
- ! Create a column-level filter that includes one or more landunit type(s) of interest
- !
- ! !USES:
- !
- ! !ARGUMENTS:
- type(filter_col_type) :: filter ! function result
- type(bounds_type), intent(in) :: bounds
- integer, intent(in) :: ltypes(:) ! landunit type(s) of interest
- logical, intent(in) :: include_inactive ! whether inactive points should be included in the filter
- !
- ! !LOCAL VARIABLES:
- integer :: c
- integer :: l
-
- character(len=*), parameter :: subname = 'col_filter_from_ltypes'
- !-----------------------------------------------------------------------
-
- filter = col_filter_empty(bounds)
-
- do c = bounds%begc, bounds%endc
- if (include_based_on_active(c, include_inactive)) then
- l = col%landunit(c)
- if (any(ltypes(:) == lun%itype(l))) then
- filter%num = filter%num + 1
- filter%indices(filter%num) = c
- end if
- end if
- end do
-
- end function col_filter_from_ltypes
-
- !-----------------------------------------------------------------------
- function col_filter_from_lunflags(bounds, lunflags, include_inactive) &
- result(filter)
- !
- ! !DESCRIPTION:
- ! Create a column-level filter from a landunit-level logical array.
- !
- ! !USES:
- !
- ! !ARGUMENTS:
- type(filter_col_type) :: filter ! function result
- type(bounds_type), intent(in) :: bounds
- logical, intent(in) :: lunflags(bounds%begl:) ! landunit-level logical array
- logical, intent(in) :: include_inactive ! whether inactive points should be included in the filter
- !
- ! !LOCAL VARIABLES:
- integer :: c
- integer :: l
-
- character(len=*), parameter :: subname = 'col_filter_from_lunflags'
- !-----------------------------------------------------------------------
-
- SHR_ASSERT_ALL((ubound(lunflags) == (/bounds%endl/)), errMsg(sourcefile, __LINE__))
-
- filter = col_filter_empty(bounds)
-
- do c = bounds%begc, bounds%endc
- if (include_based_on_active(c, include_inactive)) then
- l = col%landunit(c)
- if (lunflags(l)) then
- filter%num = filter%num + 1
- filter%indices(filter%num) = c
- end if
- end if
- end do
-
- end function col_filter_from_lunflags
-
-
- !-----------------------------------------------------------------------
- function col_filter_from_grcflags_ltypes(bounds, grcflags, ltypes, include_inactive) &
- result(filter)
- !
- ! !DESCRIPTION:
- ! Create a column-level filter from a gridcell-level logical array and an array of
- ! landunit type(s) of interest. The filter will contain all columns for which (a)
- ! grcflags is true for the gridcell containing this column, and (b) the landunit type
- ! for the landunit containing this column is one of the types in ltypes.
- !
- ! !ARGUMENTS:
- type(filter_col_type) :: filter ! function result
- type(bounds_type), intent(in) :: bounds
- logical, intent(in) :: grcflags(bounds%begg:) ! gridcell-level logical array
- integer, intent(in) :: ltypes(:) ! landunit type(s) of interest
- logical, intent(in) :: include_inactive ! whether inactive points should be included in the filter
- !
- ! !LOCAL VARIABLES:
- integer :: g ! gridcell index
- integer :: l ! landunit index
- integer :: c ! column index
- integer :: i ! array index
- integer :: ltype ! landunit type
-
- character(len=*), parameter :: subname = 'col_filter_from_grcflags_ltypes'
- !-----------------------------------------------------------------------
-
- SHR_ASSERT_ALL((ubound(grcflags) == (/bounds%endg/)), errMsg(sourcefile, __LINE__))
-
- filter = col_filter_empty(bounds)
-
- ! This loops over g then l then c rather than just looping over all columns, because
- ! this is likely more efficient for sparse filters (e.g., sparse grcflags or uncommon
- ! ltypes).
- do g = bounds%begg, bounds%endg
- if (grcflags(g)) then
- do i = 1, size(ltypes)
- ltype = ltypes(i)
- l = grc%landunit_indices(ltype, g)
- if (l == ispval) then
- cycle
- end if
-
- do c = lun%coli(l), lun%colf(l)
- if (include_based_on_active(c, include_inactive)) then
- filter%num = filter%num + 1
- filter%indices(filter%num) = c
- end if
- end do ! c
- end do ! i = 1, size(ltypes)
- end if ! grcflags(g)
- end do ! g
-
- end function col_filter_from_grcflags_ltypes
-
- !-----------------------------------------------------------------------
- function col_filter_from_filter_and_logical_array(bounds, num_orig, filter_orig, logical_col) &
- result(filter)
- !
- ! !DESCRIPTION:
- ! Create a filter from another filter subset by a column-level logical array
- !
- ! !ARGUMENTS:
- type(filter_col_type) :: filter ! function result
-
- ! Accepts separate num & indices arguments rather than a filter of filter_col_type so
- ! that this function can be called with old-style filters, where these were stored
- ! separately rather than being bundled together.
- type(bounds_type), intent(in) :: bounds
- integer, intent(in) :: num_orig ! number of points in original filter
- integer, intent(in) :: filter_orig(:) ! column indices in original filter
- logical, intent(in) :: logical_col(bounds%begc:) ! column-level logical array
- !
- ! !LOCAL VARIABLES:
- integer :: fc, c
-
- character(len=*), parameter :: subname = 'col_filter_from_filter_and_logical_array'
- !-----------------------------------------------------------------------
-
- SHR_ASSERT_ALL((ubound(logical_col) == (/bounds%endc/)), errMsg(sourcefile, __LINE__))
-
- filter = col_filter_empty(bounds)
-
- do fc = 1, num_orig
- c = filter_orig(fc)
- if (logical_col(c)) then
- filter%num = filter%num + 1
- filter%indices(filter%num) = c
- end if
- end do
-
- end function col_filter_from_filter_and_logical_array
-
-
- !-----------------------------------------------------------------------
- pure function include_based_on_active(c, include_inactive) result(include_point)
- !
- ! !DESCRIPTION:
- ! Returns true if the given column should be included in a filter based on its active
- ! flag
- !
- ! !ARGUMENTS:
- logical :: include_point ! function result
- integer, intent(in) :: c ! column index
- logical, intent(in) :: include_inactive ! whether inactive points are included in this filter
- !
- ! !LOCAL VARIABLES:
-
- character(len=*), parameter :: subname = 'include_based_on_active'
- !-----------------------------------------------------------------------
-
- ! This code is written to avoid the check of col%active if include_inactive is true.
- ! This is needed in the case of filters that are created in initialization, before
- ! the active flags are set.
- if (include_inactive) then
- include_point = .true.
- else if (col%active(c)) then
- include_point = .true.
- else
- include_point = .false.
- end if
-
- end function include_based_on_active
-
-
- !-----------------------------------------------------------------------
- function equals_filter(this, other) result(equal)
- !
- ! !DESCRIPTION:
- ! Returns true if the two filters are equal.
- !
- ! If they differ, prints some information about how they differ.
- !
- ! !USES:
- !
- ! !ARGUMENTS:
- logical :: equal ! function result
- class(filter_col_type), intent(in) :: this
- class(filter_col_type), intent(in) :: other
- !
- ! !LOCAL VARIABLES:
- integer :: i
-
- character(len=*), parameter :: subname = 'equals_filter'
- !-----------------------------------------------------------------------
-
- equal = .true.
-
- if (this%num /= other%num) then
- equal = .false.
- write(iulog,*) ' '
- write(iulog,'(a, i0, a, i0)') 'equals_filter false: Sizes differ: ', &
- this%num, ' /= ', other%num
- else
- do i = 1, this%num
- if (this%indices(i) /= other%indices(i)) then
- equal = .false.
- write(iulog,*) ' '
- write(iulog,'(a, i0, a, i0, a, i0)') &
- 'equals_filter false: Values differ; first difference at ', &
- i, ': ', this%indices(i), ' /= ', other%indices(i)
- exit
- end if
- end do
- end if
-
- end function equals_filter
-
-
-end module filterColMod
diff --git a/src/main/filterMod.F90 b/src/main/filterMod.F90
deleted file mode 100644
index 1201582a..00000000
--- a/src/main/filterMod.F90
+++ /dev/null
@@ -1,584 +0,0 @@
-module filterMod
-
-#include "shr_assert.h"
-
- !-----------------------------------------------------------------------
- ! !DESCRIPTION:
- ! Module of filters used for processing columns and pfts of particular
- ! types, including lake, non-lake, urban, soil, snow, non-snow, and
- ! naturally-vegetated patches.
- !
- ! !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 decompMod , only : bounds_type
- use GridcellType , only : grc
- use LandunitType , only : lun
- use ColumnType , only : col
- use PatchType , only : patch
- use glcBehaviorMod , only : glc_behavior_type
- !
- ! !PUBLIC TYPES:
- implicit none
- save
- private
- !
- type clumpfilter
- integer, pointer :: allc(:) ! all columns
- integer :: num_allc ! number of points in allc filter
-
- integer, pointer :: natvegp(:) ! CNDV nat-vegetated (present) filter (pfts)
- integer :: num_natvegp ! number of pfts in nat-vegetated filter
-
- integer, pointer :: pcropp(:) ! prognostic crop filter (pfts)
- integer :: num_pcropp ! number of pfts in prognostic crop filter
- integer, pointer :: soilnopcropp(:) ! soil w/o prog. crops (pfts)
- integer :: num_soilnopcropp ! number of pfts in soil w/o prog crops
-
- integer, pointer :: lakep(:) ! lake filter (pfts)
- integer :: num_lakep ! number of pfts in lake filter
- integer, pointer :: nolakep(:) ! non-lake filter (pfts)
- integer :: num_nolakep ! number of pfts in non-lake filter
- integer, pointer :: lakec(:) ! lake filter (columns)
- integer :: num_lakec ! number of columns in lake filter
- integer, pointer :: nolakec(:) ! non-lake filter (columns)
- integer :: num_nolakec ! number of columns in non-lake filter
-
- integer, pointer :: soilc(:) ! soil filter (columns)
- integer :: num_soilc ! number of columns in soil filter
- integer, pointer :: soilp(:) ! soil filter (pfts)
- integer :: num_soilp ! number of pfts in soil filter
-
- integer, pointer :: snowc(:) ! snow filter (columns)
- integer :: num_snowc ! number of columns in snow filter
- integer, pointer :: nosnowc(:) ! non-snow filter (columns)
- integer :: num_nosnowc ! number of columns in non-snow filter
-
- integer, pointer :: lakesnowc(:) ! snow filter (columns)
- integer :: num_lakesnowc ! number of columns in snow filter
- integer, pointer :: lakenosnowc(:) ! non-snow filter (columns)
- integer :: num_lakenosnowc ! number of columns in non-snow filter
-
- integer, pointer :: exposedvegp(:) ! patches where frac_veg_nosno is non-zero
- integer :: num_exposedvegp ! number of patches in exposedvegp filter
- integer, pointer :: noexposedvegp(:)! patches where frac_veg_nosno is 0 (does NOT include lake or urban)
- integer :: num_noexposedvegp ! number of patches in noexposedvegp filter
-
- integer, pointer :: hydrologyc(:) ! hydrology filter (columns)
- integer :: num_hydrologyc ! number of columns in hydrology filter
-
- integer, pointer :: urbanl(:) ! urban filter (landunits)
- integer :: num_urbanl ! number of landunits in urban filter
- integer, pointer :: nourbanl(:) ! non-urban filter (landunits)
- integer :: num_nourbanl ! number of landunits in non-urban filter
-
- integer, pointer :: urbanc(:) ! urban filter (columns)
- integer :: num_urbanc ! number of columns in urban filter
- integer, pointer :: nourbanc(:) ! non-urban filter (columns)
- integer :: num_nourbanc ! number of columns in non-urban filter
-
- integer, pointer :: urbanp(:) ! urban filter (pfts)
- integer :: num_urbanp ! number of pfts in urban filter
- integer, pointer :: nourbanp(:) ! non-urban filter (pfts)
- integer :: num_nourbanp ! number of pfts in non-urban filter
-
- integer, pointer :: nolakeurbanp(:) ! non-lake, non-urban filter (pfts)
- integer :: num_nolakeurbanp ! number of pfts in non-lake, non-urban filter
-
- integer, pointer :: icemecc(:) ! glacier mec filter (cols)
- integer :: num_icemecc ! number of columns in glacier mec filter
-
- integer, pointer :: do_smb_c(:) ! glacier+bareland SMB calculations-on filter (cols)
- integer :: num_do_smb_c ! number of columns in glacier+bareland SMB mec filter
-
- end type clumpfilter
- public clumpfilter
-
- ! This is the standard set of filters, which should be used in most places in the code.
- ! These filters only include 'active' points.
- type(clumpfilter), allocatable, public :: filter(:)
-
- ! --- DO NOT USING THE FOLLOWING VARIABLE UNLESS YOU KNOW WHAT YOU'RE DOING! ---
- !
- ! This is a separate set of filters that contains both inactive and active points. It is
- ! rarely appropriate to use these, but they are needed in a few places, e.g., where
- ! quantities are computed before weights, active flags and filters are updated due to
- ! landuse change. Note that, for the handful of filters that are computed outside of
- ! setFiltersOneGroup (including the CNDV natvegp filter and the snow filters), these
- ! filters are NOT included in this variable - so they can only be used from the main
- ! 'filter' variable.
- !
- ! Ideally, we would like to restructure the initialization code and driver ordering so
- ! that this version of the filters is never needed. At that point, we could remove this
- ! filter_inactive_and_active variable, and simplify filterMod to look the way it did
- ! before this variable was added (i.e., when there was only a single group of filters).
- !
- type(clumpfilter), allocatable, public :: filter_inactive_and_active(:)
- !
- public allocFilters ! allocate memory for filters
- public setFilters ! set filters
- public setExposedvegpFilter ! set the exposedvegp and noexposedvegp filters
-
- private allocFiltersOneGroup ! allocate memory for one group of filters
- private setFiltersOneGroup ! set one group of filters
-
- character(len=*), parameter, private :: sourcefile = &
- __FILE__
- !
- ! !REVISION HISTORY:
- ! Created by Mariana Vertenstein
- ! 11/13/03, Peter Thornton: Added soilp and num_soilp
- ! Jan/08, S. Levis: Added crop-related filters
- ! June/13, Bill Sacks: Change main filters to just work over 'active' points;
- ! add filter_inactive_and_active
- !-----------------------------------------------------------------------
-
-contains
-
- !------------------------------------------------------------------------
- subroutine allocFilters()
- !
- ! !DESCRIPTION:
- ! Allocate CLM filters.
- !
- ! !REVISION HISTORY:
- ! Created by Bill Sacks
- !------------------------------------------------------------------------
-
- call allocFiltersOneGroup(filter)
- call allocFiltersOneGroup(filter_inactive_and_active)
-
- end subroutine allocFilters
-
- !------------------------------------------------------------------------
- subroutine allocFiltersOneGroup(this_filter)
- !
- ! !DESCRIPTION:
- ! Allocate CLM filters, for one group of filters.
- !
- ! !USES:
- use decompMod , only : get_proc_clumps, get_clump_bounds
- !
- ! !ARGUMENTS:
- type(clumpfilter), intent(inout), allocatable :: this_filter(:) ! the filter to allocate
- !
- ! LOCAL VARAIBLES:
- integer :: nc ! clump index
- integer :: nclumps ! total number of clumps on this processor
- integer :: ier ! error status
- type(bounds_type) :: bounds
- !------------------------------------------------------------------------
-
- ! Determine clump variables for this processor
-
- nclumps = get_proc_clumps()
-
- ier = 0
- if( .not. allocated(this_filter)) then
- allocate(this_filter(nclumps), stat=ier)
- end if
- if (ier /= 0) then
- write(iulog,*) 'allocFiltersOneGroup(): allocation error for clumpsfilters'
- call endrun(msg=errMsg(sourcefile, __LINE__))
- end if
-
- ! Loop over clumps on this processor
-
-!$OMP PARALLEL DO PRIVATE (nc,bounds)
- do nc = 1, nclumps
- call get_clump_bounds(nc, bounds)
-
- allocate(this_filter(nc)%allc(bounds%endc-bounds%begc+1))
-
- allocate(this_filter(nc)%lakep(bounds%endp-bounds%begp+1))
- allocate(this_filter(nc)%nolakep(bounds%endp-bounds%begp+1))
- allocate(this_filter(nc)%nolakeurbanp(bounds%endp-bounds%begp+1))
-
- allocate(this_filter(nc)%lakec(bounds%endc-bounds%begc+1))
- allocate(this_filter(nc)%nolakec(bounds%endc-bounds%begc+1))
-
- allocate(this_filter(nc)%soilc(bounds%endc-bounds%begc+1))
- allocate(this_filter(nc)%soilp(bounds%endp-bounds%begp+1))
-
- allocate(this_filter(nc)%snowc(bounds%endc-bounds%begc+1))
- allocate(this_filter(nc)%nosnowc(bounds%endc-bounds%begc+1))
-
- allocate(this_filter(nc)%lakesnowc(bounds%endc-bounds%begc+1))
- allocate(this_filter(nc)%lakenosnowc(bounds%endc-bounds%begc+1))
-
- allocate(this_filter(nc)%exposedvegp(bounds%endp-bounds%begp+1))
- allocate(this_filter(nc)%noexposedvegp(bounds%endp-bounds%begp+1))
-
- allocate(this_filter(nc)%natvegp(bounds%endp-bounds%begp+1))
-
- allocate(this_filter(nc)%hydrologyc(bounds%endc-bounds%begc+1))
-
- allocate(this_filter(nc)%urbanp(bounds%endp-bounds%begp+1))
- allocate(this_filter(nc)%nourbanp(bounds%endp-bounds%begp+1))
-
- allocate(this_filter(nc)%urbanc(bounds%endc-bounds%begc+1))
- allocate(this_filter(nc)%nourbanc(bounds%endc-bounds%begc+1))
-
- allocate(this_filter(nc)%urbanl(bounds%endl-bounds%begl+1))
- allocate(this_filter(nc)%nourbanl(bounds%endl-bounds%begl+1))
-
- allocate(this_filter(nc)%pcropp(bounds%endp-bounds%begp+1))
- allocate(this_filter(nc)%soilnopcropp(bounds%endp-bounds%begp+1))
-
- allocate(this_filter(nc)%icemecc(bounds%endc-bounds%begc+1))
- allocate(this_filter(nc)%do_smb_c(bounds%endc-bounds%begc+1))
-
- end do
-!$OMP END PARALLEL DO
-
- end subroutine allocFiltersOneGroup
-
- !------------------------------------------------------------------------
- subroutine setFilters(bounds, glc_behavior)
- !
- ! !DESCRIPTION:
- ! Set CLM filters.
- use decompMod , only : BOUNDS_LEVEL_CLUMP
- !
- ! !ARGUMENTS:
- type(bounds_type) , intent(in) :: bounds
- type(glc_behavior_type) , intent(in) :: glc_behavior
- !------------------------------------------------------------------------
-
- SHR_ASSERT(bounds%level == BOUNDS_LEVEL_CLUMP, errMsg(sourcefile, __LINE__))
-
- call setFiltersOneGroup(bounds, &
- filter, include_inactive = .false., &
- glc_behavior = glc_behavior)
-
- ! At least as of June, 2013, the 'inactive_and_active' version of the filters is
- ! static in time. Thus, we could have some logic saying whether we're in
- ! initialization, and if so, skip this call. But this is problematic for two reasons:
- ! (1) it requires that the caller of this routine (currently reweight_wrapup) know
- ! whether it is in initialization; and (2) it assumes that the filter definitions
- ! won't be changed in the future in a way that creates some variability in time. So
- ! for now, it seems cleanest and safest to just update these filters whenever the main
- ! filters are updated. But if this proves to be a performance problem, we could
- ! introduce an argument saying whether we're in initialization, and if so, skip this
- ! call.
-
- call setFiltersOneGroup(bounds, &
- filter_inactive_and_active, include_inactive = .true., &
- glc_behavior = glc_behavior)
-
- end subroutine setFilters
-
-
- !------------------------------------------------------------------------
- subroutine setFiltersOneGroup(bounds, this_filter, include_inactive, glc_behavior)
- !
- ! !DESCRIPTION:
- ! Set CLM filters for one group of filters.
- !
- ! "Standard" filters only include active points. However, this routine can be used to set
- ! alternative filters that also apply over inactive points, by setting include_inactive =
- ! .true.
- !
- ! This routine sets filters that are determined by subgrid type, "active" status of
- ! patch, col or landunit, and the like. Filters based on model state (e.g., snow
- ! cover) should generally be set elsewhere, to ensure that the routine that sets them
- ! is called at the right time in the driver loop.
- !
- ! !USES:
- use decompMod , only : BOUNDS_LEVEL_CLUMP
- use pftconMod , only : npcropmin
- use landunit_varcon , only : istsoil, istcrop, istice_mec
- !
- ! !ARGUMENTS:
- type(bounds_type) , intent(in) :: bounds
- type(clumpfilter) , intent(inout) :: this_filter(:) ! the group of filters to set
- logical , intent(in) :: include_inactive ! whether inactive points should be included in the filters
- type(glc_behavior_type) , intent(in) :: glc_behavior
- !
- ! LOCAL VARAIBLES:
- integer :: nc ! clump index
- integer :: c,l,p ! column, landunit, patch indices
- integer :: fl ! lake filter index
- integer :: fnl,fnlu ! non-lake filter index
- integer :: fs ! soil filter index
- integer :: f, fn ! general indices
- integer :: g !gridcell index
- !------------------------------------------------------------------------
-
- SHR_ASSERT(bounds%level == BOUNDS_LEVEL_CLUMP, errMsg(sourcefile, __LINE__))
-
- nc = bounds%clump_index
-
- ! Create filter of all columns
- fl = 0
- do c = bounds%begc,bounds%endc
- if (col%active(c) .or. include_inactive) then
- fl = fl + 1
- this_filter(nc)%allc(fl) = c
- end if
- end do
- this_filter(nc)%num_allc = fl
-
- ! Create lake and non-lake filters at column-level
-
- fl = 0
- fnl = 0
- do c = bounds%begc,bounds%endc
- if (col%active(c) .or. include_inactive) then
- l =col%landunit(c)
- if (lun%lakpoi(l)) then
- fl = fl + 1
- this_filter(nc)%lakec(fl) = c
- else
- fnl = fnl + 1
- this_filter(nc)%nolakec(fnl) = c
- end if
- end if
- end do
- this_filter(nc)%num_lakec = fl
- this_filter(nc)%num_nolakec = fnl
-
- ! Create lake and non-lake filters at patch-level
-
- fl = 0
- fnl = 0
- fnlu = 0
- do p = bounds%begp,bounds%endp
- if (patch%active(p) .or. include_inactive) then
- l =patch%landunit(p)
- if (lun%lakpoi(l) ) then
- fl = fl + 1
- this_filter(nc)%lakep(fl) = p
- else
- fnl = fnl + 1
- this_filter(nc)%nolakep(fnl) = p
- if (.not. lun%urbpoi(l)) then
- fnlu = fnlu + 1
- this_filter(nc)%nolakeurbanp(fnlu) = p
- end if
- end if
- end if
- end do
- this_filter(nc)%num_lakep = fl
- this_filter(nc)%num_nolakep = fnl
- this_filter(nc)%num_nolakeurbanp = fnlu
-
- ! Create soil filter at column-level
-
- fs = 0
- do c = bounds%begc,bounds%endc
- if (col%active(c) .or. include_inactive) then
- l =col%landunit(c)
- if (lun%itype(l) == istsoil .or. lun%itype(l) == istcrop) then
- fs = fs + 1
- this_filter(nc)%soilc(fs) = c
- end if
- end if
- end do
- this_filter(nc)%num_soilc = fs
-
- ! Create soil filter at patch-level
-
- fs = 0
- do p = bounds%begp,bounds%endp
- if (patch%active(p) .or. include_inactive) then
- l =patch%landunit(p)
- if (lun%itype(l) == istsoil .or. lun%itype(l) == istcrop) then
- fs = fs + 1
- this_filter(nc)%soilp(fs) = p
- end if
- end if
- end do
- this_filter(nc)%num_soilp = fs
-
- ! Create column-level hydrology filter (soil and Urban pervious road cols)
-
- f = 0
- do c = bounds%begc,bounds%endc
- if (col%active(c) .or. include_inactive) then
- if (col%hydrologically_active(c)) then
- f = f + 1
- this_filter(nc)%hydrologyc(f) = c
- end if
- end if
- end do
- this_filter(nc)%num_hydrologyc = f
-
- ! Create prognostic crop and soil w/o prog. crop filters at patch-level
- ! according to where the crop model should be used
-
- fl = 0
- fnl = 0
- do p = bounds%begp,bounds%endp
- if (patch%active(p) .or. include_inactive) then
- if (patch%itype(p) >= npcropmin) then !skips 2 generic crop types
- fl = fl + 1
- this_filter(nc)%pcropp(fl) = p
- else
- l =patch%landunit(p)
- if (lun%itype(l) == istsoil .or. lun%itype(l) == istcrop) then
- fnl = fnl + 1
- this_filter(nc)%soilnopcropp(fnl) = p
- end if
- end if
- end if
- end do
- this_filter(nc)%num_pcropp = fl
- this_filter(nc)%num_soilnopcropp = fnl ! This wasn't being set before...
-
- ! Create landunit-level urban and non-urban filters
-
- f = 0
- fn = 0
- do l = bounds%begl,bounds%endl
- if (lun%active(l) .or. include_inactive) then
- if (lun%urbpoi(l)) then
- f = f + 1
- this_filter(nc)%urbanl(f) = l
- else
- fn = fn + 1
- this_filter(nc)%nourbanl(fn) = l
- end if
- end if
- end do
- this_filter(nc)%num_urbanl = f
- this_filter(nc)%num_nourbanl = fn
-
- ! Create column-level urban and non-urban filters
-
- f = 0
- fn = 0
- do c = bounds%begc,bounds%endc
- if (col%active(c) .or. include_inactive) then
- l = col%landunit(c)
- if (lun%urbpoi(l)) then
- f = f + 1
- this_filter(nc)%urbanc(f) = c
- else
- fn = fn + 1
- this_filter(nc)%nourbanc(fn) = c
- end if
- end if
- end do
- this_filter(nc)%num_urbanc = f
- this_filter(nc)%num_nourbanc = fn
-
- ! Create patch-level urban and non-urban filters
-
- f = 0
- fn = 0
- do p = bounds%begp,bounds%endp
- if (patch%active(p) .or. include_inactive) then
- l = patch%landunit(p)
- if (lun%urbpoi(l)) then
- f = f + 1
- this_filter(nc)%urbanp(f) = p
- else
- fn = fn + 1
- this_filter(nc)%nourbanp(fn) = p
- end if
- end if
- end do
- this_filter(nc)%num_urbanp = f
- this_filter(nc)%num_nourbanp = fn
-
- f = 0
- do c = bounds%begc,bounds%endc
- if (col%active(c) .or. include_inactive) then
- l = col%landunit(c)
- if (lun%itype(l) == istice_mec) then
- f = f + 1
- this_filter(nc)%icemecc(f) = c
- end if
- end if
- end do
- this_filter(nc)%num_icemecc = f
-
- f = 0
- do c = bounds%begc,bounds%endc
- if (col%active(c) .or. include_inactive) then
- l = col%landunit(c)
- g = col%gridcell(c)
-
- ! Only compute SMB in regions where we replace ice melt with new ice:
- ! Elsewhere (where ice melt remains in place), we cannot compute a sensible
- ! negative SMB.
- !
- ! In addition to istice_mec columns, we also compute SMB for any soil column in
- ! this region, in order to provide SMB forcing for the bare ground elevation
- ! class (elevation class 0).
- if ( glc_behavior%melt_replaced_by_ice_grc(g) .and. &
- (lun%itype(l) == istice_mec .or. lun%itype(l) == istsoil)) then
- f = f + 1
- this_filter(nc)%do_smb_c(f) = c
- end if
- end if
- end do
- this_filter(nc)%num_do_smb_c = f
-
- ! Note: snow filters are reconstructed each time step in
- ! LakeHydrology and SnowHydrology
- ! Note: CNDV "pft present" filter is reconstructed each time CNDV is run
-
- end subroutine setFiltersOneGroup
-
- !-----------------------------------------------------------------------
- subroutine setExposedvegpFilter(bounds, frac_veg_nosno)
- !
- ! !DESCRIPTION:
- ! Sets the exposedvegp and noexposedvegp filters for one clump.
- !
- ! The exposedvegp filter includes points for which frac_veg_nosno > 0. noexposedvegp
- ! includes points for which frac_veg_nosno <= 0. However, note that neither filter
- ! includes urban or lake points!
- !
- ! Should be called from within a loop over clumps.
- !
- ! Only sets this filter in the main 'filter' variable, NOT in
- ! filter_inactive_and_active.
- !
- ! Note that this is done separately from the main setFilters routine, because it may
- ! need to be called at a different time in the driver loop.
- !
- ! !USES:
- use decompMod , only : BOUNDS_LEVEL_CLUMP
- !
- ! !ARGUMENTS:
- type(bounds_type) , intent(in) :: bounds
- integer , intent(in) :: frac_veg_nosno( bounds%begp: ) ! fraction of vegetation not covered by snow [patch]
- !
- ! !LOCAL VARIABLES:
- integer :: nc ! clump index
- integer :: fp ! filter index
- integer :: p ! patch index
- integer :: fe, fn ! filter counts
-
- character(len=*), parameter :: subname = 'setExposedvegpFilter'
- !-----------------------------------------------------------------------
-
- SHR_ASSERT(bounds%level == BOUNDS_LEVEL_CLUMP, errMsg(sourcefile, __LINE__))
- SHR_ASSERT_ALL((ubound(frac_veg_nosno) == (/bounds%endp/)), errMsg(sourcefile, __LINE__))
-
- nc = bounds%clump_index
-
- fe = 0
- fn = 0
- do fp = 1, filter(nc)%num_nolakeurbanp
- p = filter(nc)%nolakeurbanp(fp)
- if (frac_veg_nosno(p) > 0) then
- fe = fe + 1
- filter(nc)%exposedvegp(fe) = p
- else
- fn = fn + 1
- filter(nc)%noexposedvegp(fn) = p
- end if
- end do
- filter(nc)%num_exposedvegp = fe
- filter(nc)%num_noexposedvegp = fn
-
- end subroutine setExposedvegpFilter
-
-
-end module filterMod
diff --git a/src/main/glc2lndMod.F90 b/src/main/glc2lndMod.F90
deleted file mode 100644
index d27d2e53..00000000
--- a/src/main/glc2lndMod.F90
+++ /dev/null
@@ -1,579 +0,0 @@
-module glc2lndMod
-
- !-----------------------------------------------------------------------
- ! !DESCRIPTION:
- ! Handle arrays used for exchanging data from glc to clm.
- !
- ! !USES:
-#include "shr_assert.h"
- use decompMod , only : bounds_type
- use shr_log_mod , only : errMsg => shr_log_errMsg
- use shr_kind_mod , only : r8 => shr_kind_r8
- use shr_infnan_mod , only : nan => shr_infnan_nan, assignment(=)
- use clm_varpar , only : maxpatch_glcmec
- use clm_varctl , only : iulog, glc_do_dynglacier
- use clm_varcon , only : nameg, spval, ispval
- use abortutils , only : endrun
- use GridcellType , only : grc
- use LandunitType , only : lun
- use ColumnType , only : col
- use landunit_varcon, only : istice_mec
- use glcBehaviorMod , only : glc_behavior_type
- !
- ! !REVISION HISTORY:
- ! Created by William Lipscomb, Dec. 2007, based on clm_atmlnd.F90.
- !
- ! !PUBLIC TYPES:
- implicit none
- private
- save
-
- ! glc -> land variables structure
- type, public :: glc2lnd_type
-
- ! ------------------------------------------------------------------------
- ! Public data
- ! ------------------------------------------------------------------------
-
- ! Where we should do runoff routing that is appropriate for having a dynamic icesheet underneath.
- real(r8), pointer :: glc_dyn_runoff_routing_grc (:) => null()
-
- ! ------------------------------------------------------------------------
- ! Private data
- ! ------------------------------------------------------------------------
-
- type(glc_behavior_type), pointer, private :: glc_behavior ! reference to the glc_behavior instance
-
- real(r8), pointer, private :: frac_grc (:,:) => null()
- real(r8), pointer, private :: topo_grc (:,:) => null()
- real(r8), pointer, private :: hflx_grc (:,:) => null()
-
- ! Area in which GLC model can accept surface mass balance, received from glc (0-1)
- real(r8), pointer, private :: icemask_grc (:) => null()
-
- ! icemask_coupled_fluxes_grc is like icemask_grc, but the mask only contains icesheet
- ! points that potentially send non-zero fluxes to the coupler. i.e., it does not
- ! contain icesheets that are diagnostic only, because for those diagnostic ice sheets
- ! (which do not send calving fluxes to the coupler), we need to use the non-dynamic
- ! form of runoff routing in CLM in order to conserve water properly.
- !
- ! (However, note that this measure of "diagnostic-only" does not necessarily
- ! correspond to whether CLM is updating its glacier areas there - for example, we
- ! could theoretically have an icesheet whose areas are evolving, and CLM is updating
- ! its glacier areas to match, but where we're zeroing out the fluxes sent to the
- ! coupler, and so we're using the non-dynamic form of runoff routing in CLM.)
- real(r8), pointer, private :: icemask_coupled_fluxes_grc (:) => null()
-
- contains
-
- ! ------------------------------------------------------------------------
- ! Public routines
- ! ------------------------------------------------------------------------
-
- procedure, public :: Init
- procedure, public :: Clean
-
- ! In each timestep, these routines should be called in order (though they don't need
- ! to be called all at once):
- ! - set_glc2lnd_fields
- ! - update_glc2lnd_topo
- procedure, public :: set_glc2lnd_fields ! set coupling fields sent from glc to lnd
- procedure, public :: update_glc2lnd_topo ! update topographic heights
-
- ! For unit testing only:
- procedure, public :: for_test_set_glc2lnd_fields_directly ! set glc2lnd fields directly in a unit testing context
-
- ! ------------------------------------------------------------------------
- ! Private routines
- ! ------------------------------------------------------------------------
-
- procedure, private :: InitAllocate
- procedure, private :: InitHistory
- procedure, private :: InitCold
-
- ! sanity-check icemask from GLC
- procedure, private :: check_glc2lnd_icemask
-
- ! sanity-check icemask_coupled_fluxes from GLC
- procedure, private :: check_glc2lnd_icemask_coupled_fluxes
-
- ! update glc_dyn_runoff_routing field based on input from GLC
- procedure, private :: update_glc2lnd_dyn_runoff_routing
-
- end type glc2lnd_type
-
- character(len=*), parameter, private :: sourcefile = &
- __FILE__
-
- !------------------------------------------------------------------------
-
-contains
-
- !------------------------------------------------------------------------
- subroutine Init(this, bounds, glc_behavior)
-
- class(glc2lnd_type) :: this
- type(bounds_type), intent(in) :: bounds
- type(glc_behavior_type), intent(in), target :: glc_behavior
-
- call this%InitAllocate(bounds)
- call this%InitHistory(bounds)
- call this%InitCold(bounds, glc_behavior)
-
- end subroutine Init
-
- !------------------------------------------------------------------------
- subroutine InitAllocate(this, bounds)
- !
- ! !DESCRIPTION:
- ! Initialize glc variables required by the land
- !
- ! !ARGUMENTS:
- class (glc2lnd_type) :: this
- type(bounds_type), intent(in) :: bounds
- !
- ! !LOCAL VARIABLES:
- integer :: begg,endg
- !------------------------------------------------------------------------
-
- begg = bounds%begg; endg = bounds%endg
-
- allocate(this%frac_grc (begg:endg,0:maxpatch_glcmec)) ; this%frac_grc (:,:) = nan
- allocate(this%topo_grc (begg:endg,0:maxpatch_glcmec)) ; this%topo_grc (:,:) = nan
- allocate(this%hflx_grc (begg:endg,0:maxpatch_glcmec)) ; this%hflx_grc (:,:) = nan
- allocate(this%icemask_grc (begg:endg)) ; this%icemask_grc (:) = nan
- allocate(this%icemask_coupled_fluxes_grc (begg:endg)) ; this%icemask_coupled_fluxes_grc (:) = nan
- allocate(this%glc_dyn_runoff_routing_grc (begg:endg)) ; this%glc_dyn_runoff_routing_grc (:) = nan
-
- end subroutine InitAllocate
-
- !-----------------------------------------------------------------------
- subroutine InitHistory(this, bounds)
- !
- ! !USES:
- use histFileMod, only : hist_addfld1d
- !
- ! !ARGUMENTS:
- class(glc2lnd_type) :: this
- type(bounds_type), intent(in) :: bounds
- !
- ! !LOCAL VARIABLES:
- integer :: begg, endg
-
- character(len=*), parameter :: subname = 'InitHistory'
- !-----------------------------------------------------------------------
-
- begg = bounds%begg
- endg = bounds%endg
-
- this%icemask_grc(begg:endg) = spval
- call hist_addfld1d (fname='ICE_MODEL_FRACTION', units='unitless', &
- avgflag='I', long_name='Ice sheet model fractional coverage', &
- ptr_gcell=this%icemask_grc, default='inactive')
-
- end subroutine InitHistory
-
- !-----------------------------------------------------------------------
- subroutine InitCold(this, bounds, glc_behavior)
- !
- ! !USES:
- use domainMod , only : ldomain
- !
- ! !ARGUMENTS:
- class(glc2lnd_type) :: this
- type(bounds_type), intent(in) :: bounds
- type(glc_behavior_type), intent(in), target :: glc_behavior
- !
- ! !LOCAL VARIABLES:
- integer :: begg, endg
-
- character(len=*), parameter :: subname = 'InitCold'
- !-----------------------------------------------------------------------
-
- begg = bounds%begg
- endg = bounds%endg
-
- this%glc_behavior => glc_behavior
-
- this%frac_grc(begg:endg, :) = 0.0_r8
- this%topo_grc(begg:endg, :) = 0.0_r8
- this%hflx_grc(begg:endg, :) = 0.0_r8
-
- ! When running with a stub glc model, it's important that icemask_grc be initialized
- ! to 0 everywhere. With an active glc model, icemask_grc will be updated in the first
- ! time step, and it isn't needed before then, so it's safe to initialize it to 0.
- ! Since icemask is 0, icemask_coupled_fluxes needs to be 0, too (and the latter is
- ! safest in case we aren't coupled to CISM, to ensure that we use the uncoupled form
- ! of runoff routing).
- this%icemask_grc(begg:endg) = 0.0_r8
- this%icemask_coupled_fluxes_grc(begg:endg) = 0.0_r8
-
- call this%update_glc2lnd_dyn_runoff_routing(bounds)
-
- end subroutine InitCold
-
-
- !-----------------------------------------------------------------------
- subroutine Clean(this)
- !
- ! !DESCRIPTION:
- ! Deallocate memory in this object
- !
- ! !ARGUMENTS:
- class(glc2lnd_type), intent(inout) :: this
- !
- ! !LOCAL VARIABLES:
-
- character(len=*), parameter :: subname = 'Clean'
- !-----------------------------------------------------------------------
-
- deallocate(this%frac_grc)
- deallocate(this%topo_grc)
- deallocate(this%hflx_grc)
- deallocate(this%icemask_grc)
- deallocate(this%icemask_coupled_fluxes_grc)
- deallocate(this%glc_dyn_runoff_routing_grc)
-
- end subroutine Clean
-
- !-----------------------------------------------------------------------
- subroutine set_glc2lnd_fields(this, bounds, glc_present, x2l, &
- index_x2l_Sg_ice_covered, index_x2l_Sg_topo, index_x2l_Flgg_hflx, &
- index_x2l_Sg_icemask, index_x2l_Sg_icemask_coupled_fluxes)
- !
- ! !DESCRIPTION:
- ! Set coupling fields sent from glc to lnd
- !
- ! If glc_present is true, then the given fields are all assumed to be valid; if
- ! glc_present is false, then these fields are ignored.
- !
- ! !ARGUMENTS:
- class(glc2lnd_type), intent(inout) :: this
- type(bounds_type) , intent(in) :: bounds
- logical , intent(in) :: glc_present ! true if running with a non-stub glc model
- real(r8) , intent(in) :: x2l(:, bounds%begg: ) ! driver import state to land model [field, gridcell]
- integer , intent(in) :: index_x2l_Sg_ice_covered( 0: ) ! indices of ice-covered field in x2l, for each elevation class
- integer , intent(in) :: index_x2l_Sg_topo( 0: ) ! indices of topo field in x2l, for each elevation class
- integer , intent(in) :: index_x2l_Flgg_hflx( 0: ) ! indices of heat flux field in x2l, for each elevation class
- integer , intent(in) :: index_x2l_Sg_icemask ! index of icemask field in x2l
- integer , intent(in) :: index_x2l_Sg_icemask_coupled_fluxes ! index of icemask_coupled_fluxes field in x2l
- !
- ! !LOCAL VARIABLES:
- integer :: g
- integer :: icemec_class
-
- character(len=*), parameter :: subname = 'set_glc2lnd_fields'
- !-----------------------------------------------------------------------
-
- SHR_ASSERT((ubound(x2l, 2) == bounds%endg), errMsg(sourcefile, __LINE__))
- SHR_ASSERT_ALL((ubound(index_x2l_Sg_ice_covered) == (/maxpatch_glcmec/)), errMsg(sourcefile, __LINE__))
- SHR_ASSERT_ALL((ubound(index_x2l_Sg_topo) == (/maxpatch_glcmec/)), errMsg(sourcefile, __LINE__))
- SHR_ASSERT_ALL((ubound(index_x2l_Flgg_hflx) == (/maxpatch_glcmec/)), errMsg(sourcefile, __LINE__))
-
- if (glc_present) then
- call endrun(' ERROR: SLIM can NOT run with an active ice sheet model' )
- end if
- if (glc_do_dynglacier) then
- call endrun(' ERROR: With glc_present false (e.g., a stub glc model), glc_do_dynglacier must be false '// &
- errMsg(sourcefile, __LINE__))
- end if
-
- end subroutine set_glc2lnd_fields
-
- !-----------------------------------------------------------------------
- subroutine for_test_set_glc2lnd_fields_directly(this, bounds, &
- topo, icemask)
- !
- ! !DESCRIPTION:
- ! Set glc2lnd fields directly in a unit testing context
- !
- ! This currently only provides a mechanism to set fields that are actually needed in
- ! our unit tests. More could be added later.
- !
- ! Also: In contrast to the production version (set_glc2lnd_fields), this does NOT
- ! currently update glc2lnd_dyn_runoff_routing (because doing so would require having a
- ! sensible glc_behavior, which we may not have; and also, we currently don't need this
- ! field in a unit testing context). (Note: If we eventually want/need to update
- ! glc2lnd_dyn_runoff_routing, and thus need a fully sensible glc_behavior, then we
- ! should extract the self-calls at the end of set_glc2lnd_fields
- ! (check_glc2lnd_icemask, check_glc2lnd_icemask_coupled_fluxes,
- ! update_glc2lnd_dyn_runoff_routing) into a private routine like
- ! set_glc2lnd_fields_wrapup, which could be called by both set_glc2lnd_fields and this
- ! routine.)
- !
- ! !ARGUMENTS:
- class(glc2lnd_type), intent(inout) :: this
- type(bounds_type) , intent(in) :: bounds
- real(r8), intent(in), optional :: topo( bounds%begg: , 0: ) ! topographic height [gridcell, elevclass]
- real(r8), intent(in), optional :: icemask( bounds%begg: )
- !
- ! !LOCAL VARIABLES:
-
- character(len=*), parameter :: subname = 'for_test_set_glc2lnd_fields_directly'
- !-----------------------------------------------------------------------
-
- if (present(topo)) then
- SHR_ASSERT_ALL((ubound(topo) == (/bounds%endg, maxpatch_glcmec/)), errMsg(sourcefile, __LINE__))
- this%topo_grc(bounds%begg:bounds%endg, 0:maxpatch_glcmec) = topo(bounds%begg:bounds%endg, 0:maxpatch_glcmec)
- end if
-
- if (present(icemask)) then
- SHR_ASSERT_ALL((ubound(icemask) == (/bounds%endg/)), errMsg(sourcefile, __LINE__))
- this%icemask_grc(bounds%begg:bounds%endg) = icemask(bounds%begg:bounds%endg)
- end if
-
- end subroutine for_test_set_glc2lnd_fields_directly
-
- !-----------------------------------------------------------------------
- subroutine check_glc2lnd_icemask(this, bounds)
- !
- ! !DESCRIPTION:
- ! Do a sanity check on the icemask received from CISM via coupler.
- !
- ! !USES:
- use domainMod , only : ldomain
- !
- ! !ARGUMENTS:
- class(glc2lnd_type), intent(in) :: this
- type(bounds_type) , intent(in) :: bounds
- !
- ! !LOCAL VARIABLES:
- integer :: g ! grid cell index
-
- character(len=*), parameter :: subname = 'check_glc2lnd_icemask'
- !-----------------------------------------------------------------------
-
- do g = bounds%begg, bounds%endg
-
- if (this%icemask_grc(g) > 0._r8) then
-
- ! Ensure that icemask is a subset of has_virtual_columns. This is needed because
- ! we allocated memory based on has_virtual_columns, so it is a problem if the
- ! ice sheet tries to expand beyond the area defined by has_virtual_columns.
- if (.not. this%glc_behavior%has_virtual_columns_grc(g)) then
- write(iulog,'(a)') subname//' ERROR: icemask must be a subset of has_virtual_columns.'
- write(iulog,'(a)') 'Ensure that the glacier_region_behavior namelist item is set correctly.'
- write(iulog,'(a)') '(It should specify "virtual" for the region corresponding to the GLC domain.)'
- write(iulog,'(a)') 'If glacier_region_behavior is set correctly, then you can fix this problem'
- write(iulog,'(a)') 'by modifying GLACIER_REGION on the surface dataset.'
- write(iulog,'(a)') '(Expand the region that corresponds to the GLC domain'
- write(iulog,'(a)') '- i.e., the region specified as "virtual" in glacier_region_behavior.)'
- call endrun(decomp_index=g, clmlevel=nameg, msg=errMsg(sourcefile, __LINE__))
- end if
-
- ! Ensure that icemask is a subset of melt_replaced_by_ice. This is needed
- ! because we only compute SMB in the region given by melt_replaced_by_ice
- ! (according to the logic for building the do_smb filter), and we need SMB
- ! everywhere inside the icemask.
- if (.not. this%glc_behavior%melt_replaced_by_ice_grc(g)) then
- write(iulog,'(a)') subname//' ERROR: icemask must be a subset of melt_replaced_by_ice.'
- write(iulog,'(a)') 'Ensure that the glacier_region_melt_behavior namelist item is set correctly.'
- write(iulog,'(a)') '(It should specify "replaced_by_ice" for the region corresponding to the GLC domain.)'
- write(iulog,'(a)') 'If glacier_region_behavior is set correctly, then you can fix this problem'
- write(iulog,'(a)') 'by modifying GLACIER_REGION on the surface dataset.'
- write(iulog,'(a)') '(Expand the region that corresponds to the GLC domain'
- write(iulog,'(a)') '- i.e., the region specified as "replaced_by_ice" in glacier_region_melt_behavior.)'
- call endrun(decomp_index=g, clmlevel=nameg, msg=errMsg(sourcefile, __LINE__))
- end if
-
- end if
- end do
-
- end subroutine check_glc2lnd_icemask
-
- !-----------------------------------------------------------------------
- subroutine check_glc2lnd_icemask_coupled_fluxes(this, bounds)
- !
- ! !DESCRIPTION:
- ! Do a sanity check on the icemask_coupled_fluxes field received from CISM via coupler.
- !
- ! !USES:
- !
- ! !ARGUMENTS:
- class(glc2lnd_type), intent(in) :: this
- type(bounds_type) , intent(in) :: bounds ! bounds
- !
- ! !LOCAL VARIABLES:
- integer :: g ! grid cell index
-
- character(len=*), parameter :: subname = 'check_glc2lnd_icemask_coupled_fluxes'
- !-----------------------------------------------------------------------
-
- do g = bounds%begg, bounds%endg
-
- ! Ensure that icemask_coupled_fluxes is a subset of icemask. Although there
- ! currently is no code in CLM that depends on this relationship, it seems helpful
- ! to ensure that this intuitive relationship holds, so that code developed in the
- ! future can rely on it.
- if (this%icemask_coupled_fluxes_grc(g) > 0._r8 .and. this%icemask_grc(g) == 0._r8) then
- write(iulog,*) subname//' ERROR: icemask_coupled_fluxes must be a subset of icemask.'
- call endrun(decomp_index=g, clmlevel=nameg, msg=errMsg(sourcefile, __LINE__))
- end if
-
- end do
-
- end subroutine check_glc2lnd_icemask_coupled_fluxes
-
- !-----------------------------------------------------------------------
- subroutine update_glc2lnd_dyn_runoff_routing(this, bounds)
- !
- ! !DESCRIPTION:
- ! Update glc_dyn_runoff_routing field based on updated icemask_coupled_fluxes field
- !
- ! !USES:
- use domainMod , only : ldomain
- !
- ! !ARGUMENTS:
- class(glc2lnd_type), intent(inout) :: this
- type(bounds_type) , intent(in) :: bounds ! bounds
- !
- ! !LOCAL VARIABLES:
- integer :: g ! grid cell index
-
- character(len=*), parameter :: subname = 'update_glc2lnd_dyn_runoff_routing'
- !-----------------------------------------------------------------------
-
- ! Wherever we have an icesheet that is computing and sending fluxes to the coupler -
- ! which particularly means it is computing a calving flux - we will use the
- ! "glc_dyn_runoff_routing" scheme, with 0 < glc_dyn_runoff_routing <= 1.
- ! In these places, all or part of the snowcap flux goes to CISM rather than the runoff model.
- ! In other places - including places where CISM is not running at all, as well as places
- ! where CISM is running in diagnostic-only mode and therefore is not sending a calving flux -
- ! we have glc_dyn_runoff_routing = 0, and the snowcap flux goes to the runoff model.
- ! This is needed to conserve water correctly in the absence of a calving flux.
-
- do g = bounds%begg, bounds%endg
-
- ! Set glc_dyn_runoff_routing_grc(g) to a value in the range [0,1].
- !
- ! This value gives the grid cell fraction that is deemed to be coupled to the
- ! dynamic ice sheet model. For this fraction of the grid cell, snowcap fluxes are
- ! sent to the ice sheet model. The remainder of the grid cell sends snowcap fluxes
- ! to the runoff model.
- !
- ! Note: The coupler (in prep_glc_mod.F90) assumes that the fraction coupled to the
- ! dynamic ice sheet model is min(lfrac, Sg_icemask_l), where lfrac is the
- ! "frac" component of fraction_lx, and Sg_icemask_l is obtained by mapping
- ! Sg_icemask_g from the glc to the land grid. Here, ldomain%frac is
- ! equivalent to lfrac, and this%icemask_grc is equivalent to Sg_icemask_l.
- ! However, here we use icemask_coupled_fluxes_grc, so that we route all snow
- ! capping to runoff in areas where the ice sheet is not generating calving
- ! fluxes. In addition, here we need to divide by lfrac, because the coupler
- ! multiplies by it later (and, for example, if lfrac = 0.1 and
- ! icemask_coupled_fluxes = 1, we want all snow capping to go to the ice
- ! sheet model, not to the runoff model).
- !
- ! Note: In regions where CLM overlaps the CISM domain, this%icemask_grc(g) typically
- ! is nearly equal to ldomain%frac(g). So an alternative would be to simply set
- ! glc_dyn_runoff_routing_grc(g) = icemask_grc(g).
- ! The reason to cap glc_dyn_runoff_routing at lfrac is to avoid sending the
- ! ice sheet model a greater mass of water (in the form of snowcap fluxes)
- ! than is allowed to fall on a CLM grid cell that is part ocean.
-
- ! TODO(wjs, 2017-05-08) Ideally, we wouldn't have this duplication in logic
- ! between the coupler and CLM. The best solution would be to have the coupler
- ! itself do the partitioning of the snow capping flux between the ice sheet model
- ! and the runoff model. A next-best solution would be to have the coupler send a
- ! field to CLM telling it what fraction of snow capping should go to the runoff
- ! model in each grid cell.
-
- if (ldomain%frac(g) == 0._r8) then
- ! Avoid divide by 0; note that, in this case, the amount going to runoff isn't
- ! important for system-wide conservation, so we could really choose anything we
- ! want.
- this%glc_dyn_runoff_routing_grc(g) = this%icemask_coupled_fluxes_grc(g)
- else
- this%glc_dyn_runoff_routing_grc(g) = &
- min(ldomain%frac(g), this%icemask_coupled_fluxes_grc(g)) / &
- ldomain%frac(g)
- end if
-
- if (this%glc_dyn_runoff_routing_grc(g) > 0.0_r8) then
-
- ! Ensure that glc_dyn_runoff_routing is a subset of melt_replaced_by_ice. This
- ! is needed because glacial melt is only sent to the runoff stream in the region
- ! given by melt_replaced_by_ice (because the latter is used to create the do_smb
- ! filter, and the do_smb filter controls where glacial melt is computed).
- if (.not. this%glc_behavior%melt_replaced_by_ice_grc(g)) then
- write(iulog,'(a)') subname//' ERROR: icemask_coupled_fluxes must be a subset of melt_replaced_by_ice.'
- write(iulog,'(a)') 'Ensure that the glacier_region_melt_behavior namelist item is set correctly.'
- write(iulog,'(a)') '(It should specify "replaced_by_ice" for the region corresponding to the GLC domain.)'
- write(iulog,'(a)') 'If glacier_region_behavior is set correctly, then you can fix this problem'
- write(iulog,'(a)') 'by modifying GLACIER_REGION on the surface dataset.'
- write(iulog,'(a)') '(Expand the region that corresponds to the GLC domain'
- write(iulog,'(a)') '- i.e., the region specified as "replaced_by_ice" in glacier_region_melt_behavior.)'
- call endrun(decomp_index=g, clmlevel=nameg, msg=errMsg(sourcefile, __LINE__))
- end if
- end if
- end do
-
- end subroutine update_glc2lnd_dyn_runoff_routing
-
-
-
- !-----------------------------------------------------------------------
- subroutine update_glc2lnd_topo(this, bounds, topo_col, needs_downscaling_col)
- !
- ! !DESCRIPTION:
- ! Update column-level topographic heights based on input from GLC (via the coupler).
- !
- ! Also updates the logical array, needs_downscaling_col: Sets this array to true
- ! anywhere where topo_col is updated, because these points will need downscaling.
- ! (Leaves other array elements in needs_downscaling_col untouched.)
- !
- ! If glc_do_dynglacier is false, then both topographic heights and
- ! needs_downscaling_col are left unchanged.
- !
- ! !USES:
- use landunit_varcon , only : istice_mec
- use column_varcon , only : col_itype_to_icemec_class
- !
- ! !ARGUMENTS:
- class(glc2lnd_type) , intent(in) :: this
- type(bounds_type) , intent(in) :: bounds ! bounds
- real(r8) , intent(inout) :: topo_col( bounds%begc: ) ! topographic height (m)
- logical , intent(inout) :: needs_downscaling_col( bounds%begc: )
- !
- ! !LOCAL VARIABLES:
- integer :: c, l, g ! indices
- integer :: icemec_class ! current icemec class (1..maxpatch_glcmec)
-
- character(len=*), parameter :: subname = 'update_glc2lnd_topo'
- !-----------------------------------------------------------------------
-
- SHR_ASSERT_ALL((ubound(topo_col) == (/bounds%endc/)), errMsg(sourcefile, __LINE__))
- SHR_ASSERT_ALL((ubound(needs_downscaling_col) == (/bounds%endc/)), errMsg(sourcefile, __LINE__))
-
- if (glc_do_dynglacier) then
- do c = bounds%begc, bounds%endc
- l = col%landunit(c)
- g = col%gridcell(c)
-
- ! Values from GLC are only valid within the icemask, so we only update CLM's topo values there
- if (this%icemask_grc(g) > 0._r8) then
- if (lun%itype(l) == istice_mec) then
- icemec_class = col_itype_to_icemec_class(col%itype(c))
- else
- ! If not on a glaciated column, assign topography to the bare-land value determined by GLC.
- icemec_class = 0
- end if
-
- ! Note that we do downscaling over all column types. This is for consistency:
- ! interpretation of results would be difficult if some non-glacier column types
- ! were downscaled but others were not.
- !
- ! BUG(wjs, 2016-11-15, bugz 2377) Actually, do not downscale over urban points:
- ! this currently isn't allowed because the urban code references some
- ! non-downscaled, gridcell-level atmospheric forcings
- if (.not. lun%urbpoi(l)) then
- topo_col(c) = this%topo_grc(g, icemec_class)
- needs_downscaling_col(c) = .true.
- end if
- end if
- end do
- end if
-
- end subroutine update_glc2lnd_topo
-
-end module glc2lndMod
-
diff --git a/src/main/glcBehaviorMod.F90 b/src/main/glcBehaviorMod.F90
deleted file mode 100644
index 2fa47857..00000000
--- a/src/main/glcBehaviorMod.F90
+++ /dev/null
@@ -1,994 +0,0 @@
-module glcBehaviorMod
-
- !-----------------------------------------------------------------------
- ! !DESCRIPTION:
- ! Determines a number of aspects of the behavior of glacier_mec classes in each grid
- ! cell.
- !
- ! !USES:
-#include "shr_assert.h"
- 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 landunit_varcon, only : istice_mec
- use clm_instur , only : wt_lunit, wt_glc_mec
- use decompMod , only : bounds_type
- use filterColMod , only : filter_col_type
- use ColumnType , only : col
-
- ! !PUBLIC TYPES:
- implicit none
- private
- save
-
- type, public :: glc_behavior_type
- private
-
- ! ------------------------------------------------------------------------
- ! Public data
- ! ------------------------------------------------------------------------
-
- ! If has_virtual_columns_grc(g) is true, then grid cell g has virtual columns for
- ! all possible glc_mec columns.
- !
- ! For the sake of coupling with CISM, this should only be needed within the icemask,
- ! where we need virtual columns for the sake of coupling with CISM. This is needed in
- ! order to (1) provide SMB in all elevation classes, in case it is being used with
- ! 1-way coupling (or to force a later TG run); (2) even with two-way coupling,
- ! provide SMB in the elevation classes above and below existing elevation classes,
- ! for the sake of vertical interpolation; (3) provide place-holder columns (which are
- ! already spun-up) for dynamic landunits; (4) ensure that all glacier columns are
- ! given spun-up initial conditions by init_interp.
- !
- ! More details on (4) (echoing the similar comment in subgridWeightsMod): We need all
- ! glacier and vegetated points to be active in the icemask region for the sake of
- ! init_interp - since we only interpolate onto active points, and we don't know which
- ! points will have non-zero area until after initialization (as long as we can't send
- ! information from glc to clm in initialization). (If we had an inactive glacier
- ! point in the icemask region, according to the weights on the surface dataset, and
- ! ran init_interp, this point would keep its cold start initialization values. Then,
- ! in the first time step of the run loop, it's possible that this point would become
- ! active because, according to glc, there is actually > 0% glacier in that grid
- ! cell. We don't do any state / flux adjustments in the first time step after
- ! init_interp due to glacier area changes, so this glacier column would remain at its
- ! cold start initialization values, which would be a Bad Thing. Ensuring that all
- ! glacier points within the icemask are active gets around this problem - as well as
- ! having other benefits, as noted above.)
- !
- ! However, by making this part of the user-modifiable "glc behavior", we make it easy
- ! for the user to add virtual columns, if this is desired for diagnostic
- ! purposes. One important reason why this may be desired is to produce coupler
- ! history forcings to force a later TG run, with SMB forcings outside the original
- ! CISM area. (Also, we cannot use icemask for all purposes, because it isn't known at
- ! initialization.)
- logical, allocatable, public :: has_virtual_columns_grc(:)
-
- ! If allow_multiple_columns_grc(g) is true, then grid cell g may have multiple
- ! glacier columns, for the different elevation classes. If
- ! allow_multiple_columns_grc(g) is false, then grid cell g is guaranteed to have at
- ! most one glacier column.
- logical, allocatable, public :: allow_multiple_columns_grc(:)
-
- ! If melt_replaced_by_ice_grc(g) is true, then any glacier ice melt in gridcell g
- ! runs off and is replaced by ice. Note that SMB cannot be computed in gridcell g if
- ! melt_replaced_by_ice_grc(g) is false, since we can't compute a sensible negative
- ! smb in that case.
- logical, allocatable, public :: melt_replaced_by_ice_grc(:)
-
- ! If ice_runoff_melted_grc(g) is true, then ice runoff generated by the
- ! CLM physics over glacier columns in gridcell g is melted (generating a negative
- ! sensible heat flux) and runs off as liquid. If it is false, then ice runoff is
- ! sent to the river model as ice (a crude parameterization of iceberg calving).
- logical, allocatable, public :: ice_runoff_melted_grc(:)
-
- ! ------------------------------------------------------------------------
- ! Private data
- ! ------------------------------------------------------------------------
-
- ! If collapse_to_atm_topo_grc(g) is true, then grid cell g has at most one glc_mec
- ! column, whose topographic height exactly matches the atmosphere's topographic
- ! height for that grid cell (so that there is no adjustment of atmospheric
- ! forcings).
- !
- ! Note that has_virtual_columns_grc(g) is guaranteed to be false if
- ! collapse_to_atm_topo_grc(g) is true.
- logical, allocatable :: collapse_to_atm_topo_grc(:)
-
- contains
-
- ! ------------------------------------------------------------------------
- ! Public routines
- ! ------------------------------------------------------------------------
-
- procedure, public :: Init ! version of Init meant for production use
- procedure, public :: InitFromInputs ! version of Init meant for unit testing (and called by other code in this class)
- procedure, public :: InitSetDirectly ! version of Init meant for unit testing
-
- ! get number of subgrid units in glc_mec landunit on one grid cell
- procedure, public :: get_num_glc_mec_subgrid
-
- ! returns true if memory should be allocated for the given glc_mec column, and its
- ! weight on the landunit
- procedure, public :: glc_mec_col_exists
-
- ! returns true if glc_mec columns on the given grid cell have dynamic type (type
- ! potentially changing at runtime)
- procedure, public :: cols_have_dynamic_type
-
- ! Sets a column-level logical array to true for any ice_mec column that needs
- ! downscaling, false for any ice_mec column that does not need downscaling
- procedure, public :: icemec_cols_need_downscaling
-
- ! update the column class types of any glc_mec columns that need to be updated
- procedure, public :: update_glc_classes
-
- ! ------------------------------------------------------------------------
- ! Public routines, for unit tests only
- ! ------------------------------------------------------------------------
-
- ! get the value of collapse_to_atm_topo at a given grid cell
- procedure, public :: get_collapse_to_atm_topo
-
- ! ------------------------------------------------------------------------
- ! Private routines
- ! ------------------------------------------------------------------------
-
- procedure, private :: InitAllocate
-
- ! reads GLACIER_REGION field from surface dataset
- procedure, private, nopass :: read_surface_dataset
-
- ! reads local namelist items
- procedure, private, nopass :: read_namelist
-
- ! returns a column-level filter of ice_mec columns with the collapse_to_atm_topo
- ! behavior
- procedure, private :: collapse_to_atm_topo_icemec_filterc
-
- ! update class of glc_mec columns in regions where these are collapsed to a single
- ! column, given a filter
- procedure, private :: update_collapsed_columns_classes
-
- end type glc_behavior_type
-
- ! !PRIVATE MEMBER DATA:
-
- ! Longest name allowed for glacier_region_behavior, glacier_region_melt_behavior and
- ! glacier_region_ice_runoff_behavior
- integer, parameter :: max_behavior_name_len = 32
-
- ! Smallest and largest allowed values for a glacier region ID
- integer, parameter :: min_glacier_region_id = 0
- integer, parameter :: max_glacier_region_id = 10
-
- ! Value indicating that a namelist item has not been set
- character(len=*), parameter :: behavior_str_unset = 'UNSET'
-
- character(len=*), parameter, private :: sourcefile = &
- __FILE__
-
-contains
-
- !-----------------------------------------------------------------------
- subroutine Init(this, begg, endg, NLFilename)
- !
- ! !DESCRIPTION:
- ! Initialize a glc_behavior_type object.
- !
- ! This version of Init is the one intended for production code use. It reads the
- ! information it needs from the surface dataset and namelist.
- !
- ! !USES:
- !
- ! !ARGUMENTS:
- class(glc_behavior_type), intent(inout) :: this
- integer, intent(in) :: begg ! beginning gridcell index
- integer, intent(in) :: endg ! ending gridcell index
- character(len=*), intent(in) :: NLFilename ! Namelist filename
- !
- ! !LOCAL VARIABLES:
- integer, allocatable :: glacier_region_map(:)
- character(len=max_behavior_name_len) :: glacier_region_behavior(min_glacier_region_id:max_glacier_region_id)
- character(len=max_behavior_name_len) :: glacier_region_melt_behavior(min_glacier_region_id:max_glacier_region_id)
- character(len=max_behavior_name_len) :: glacier_region_ice_runoff_behavior(min_glacier_region_id:max_glacier_region_id)
-
- character(len=*), parameter :: subname = 'Init'
- !-----------------------------------------------------------------------
-
- allocate(glacier_region_map(begg:endg))
- call this%read_surface_dataset(begg, endg, glacier_region_map(begg:endg))
- call this%read_namelist(NLFilename, glacier_region_behavior, &
- glacier_region_melt_behavior, glacier_region_ice_runoff_behavior)
-
- call this%InitFromInputs(begg, endg, &
- glacier_region_map(begg:endg), glacier_region_behavior, &
- glacier_region_melt_behavior, glacier_region_ice_runoff_behavior)
-
- end subroutine Init
-
- !-----------------------------------------------------------------------
- subroutine InitFromInputs(this, begg, endg, &
- glacier_region_map, glacier_region_behavior_str, glacier_region_melt_behavior_str, &
- glacier_region_ice_runoff_behavior_str)
- !
- ! !DESCRIPTION:
- ! Initialize a glc_behavior_type object given a map of glacier region IDs and an
- ! array of behavior specifications for each of these IDs.
- !
- ! This version should generally only be called directly by tests, but it is also used
- ! by the main production Init method.
- !
- ! !USES:
- !
- ! !ARGUMENTS:
- class(glc_behavior_type), intent(inout) :: this
- integer, intent(in) :: begg ! beginning gridcell index
- integer, intent(in) :: endg ! ending gridcell index
-
- ! map of glacier region IDs
- integer, intent(in) :: glacier_region_map(begg:)
-
- ! string giving behavior for each glacier region ID
- ! allowed values are:
- ! - 'multiple': grid cells can potentially have multiple glacier elevation classes,
- ! but no virtual columns
- ! - 'virtual': grid cells have virtual columns: values are computed for every glacier
- ! elevation class, even those with 0 area
- ! - 'single_at_atm_topo': glacier landunits in these grid cells have a single column,
- ! whose elevation matches the atmosphere's topographic height (so that there is no
- ! adjustment due to downscaling)
- character(len=*), intent(in) :: glacier_region_behavior_str(min_glacier_region_id:)
-
- ! string giving treatment of ice melt for each glacier region ID
- ! allowed values are:
- ! - 'replaced_by_ice'
- ! - 'remains_in_place'
- character(len=*), intent(in) :: glacier_region_melt_behavior_str(min_glacier_region_id:)
-
- ! string giving treatment of ice runoff for each glacier region ID
- ! allowed values are:
- ! - 'remains_ice'
- ! - 'melted'
- character(len=*), intent(in) :: glacier_region_ice_runoff_behavior_str(min_glacier_region_id:)
-
- !
- ! !LOCAL VARIABLES:
- ! whether each glacier region ID is present in the glacier_region_map
- logical :: glacier_region_present(min_glacier_region_id:max_glacier_region_id)
-
- ! integer codes corresponding to glacier_region_behavior_str
- integer :: glacier_region_behavior(min_glacier_region_id:max_glacier_region_id)
-
- ! integer codes corresponding to glacier_region_melt_behavior_str
- integer :: glacier_region_melt_behavior(min_glacier_region_id:max_glacier_region_id)
-
- ! integer codes corresponding to glacier_region_ice_runoff_behavior_str
- integer :: glacier_region_ice_runoff_behavior(min_glacier_region_id:max_glacier_region_id)
-
- integer :: g
- integer :: my_id
- integer :: my_behavior
- integer :: my_melt_behavior
- integer :: my_ice_runoff_behavior
-
- ! possible glacier_region_behavior codes
- integer, parameter :: BEHAVIOR_MULTIPLE = 1
- integer, parameter :: BEHAVIOR_VIRTUAL = 2
- integer, parameter :: BEHAVIOR_SINGLE_AT_ATM_TOPO = 3
-
- ! possible glacier_region_melt_behavior codes
- integer, parameter :: MELT_BEHAVIOR_REPLACED_BY_ICE = 1
- integer, parameter :: MELT_BEHAVIOR_REMAINS_IN_PLACE = 2
-
- ! possible glacier_region_ice_runoff_behavior codes
- integer, parameter :: ICE_RUNOFF_BEHAVIOR_REMAINS_ICE = 1
- integer, parameter :: ICE_RUNOFF_BEHAVIOR_MELTED = 2
-
- ! value indicating that a behavior code has not been set (for glacier_region_behavior,
- ! glacier_region_melt_behavior or glacier_region_ice_runoff_behavior)
- integer, parameter :: BEHAVIOR_UNSET = -1
-
- character(len=*), parameter :: subname = 'InitFromInputs'
- !-----------------------------------------------------------------------
-
- SHR_ASSERT_ALL((ubound(glacier_region_map) == (/endg/)), errMsg(sourcefile, __LINE__))
-
- call check_glacier_region_map
-
- call determine_region_presence
-
- call translate_glacier_region_behavior
- call translate_glacier_region_melt_behavior
- call translate_glacier_region_ice_runoff_behavior
-
- call this%InitAllocate(begg, endg)
-
- do g = begg, endg
- my_id = glacier_region_map(g)
- my_behavior = glacier_region_behavior(my_id)
- my_melt_behavior = glacier_region_melt_behavior(my_id)
- my_ice_runoff_behavior = glacier_region_ice_runoff_behavior(my_id)
-
- ! This should only happen due to a programming error, not due to a user input error
- SHR_ASSERT(my_behavior /= BEHAVIOR_UNSET, errMsg(sourcefile, __LINE__))
- SHR_ASSERT(my_melt_behavior /= BEHAVIOR_UNSET, errMsg(sourcefile, __LINE__))
- SHR_ASSERT(my_ice_runoff_behavior /= BEHAVIOR_UNSET, errMsg(sourcefile, __LINE__))
-
- if (my_behavior == BEHAVIOR_VIRTUAL) then
- this%has_virtual_columns_grc(g) = .true.
- else
- this%has_virtual_columns_grc(g) = .false.
- end if
-
- if (my_melt_behavior == MELT_BEHAVIOR_REMAINS_IN_PLACE) then
- this%melt_replaced_by_ice_grc(g) = .false.
- else
- this%melt_replaced_by_ice_grc(g) = .true.
- end if
-
- if (my_ice_runoff_behavior == ICE_RUNOFF_BEHAVIOR_MELTED) then
- this%ice_runoff_melted_grc(g) = .true.
- else
- this%ice_runoff_melted_grc(g) = .false.
- end if
-
- ! For now, allow_multiple_columns_grc is simply the opposite of
- ! collapse_to_atm_topo_grc. However, we maintain the separate
- ! allow_multiple_columns_grc so that the public interface can stay the same if we
- ! differentiate between the two in the future - e.g., allowing for the possibility
- ! of a behavior where we have at most one glacier column, but not forced to the
- ! atmosphere's elevation.
- if (my_behavior == BEHAVIOR_SINGLE_AT_ATM_TOPO) then
- this%collapse_to_atm_topo_grc(g) = .true.
- this%allow_multiple_columns_grc(g) = .false.
- else
- this%collapse_to_atm_topo_grc(g) = .false.
- this%allow_multiple_columns_grc(g) = .true.
- end if
- end do
-
- contains
- subroutine check_glacier_region_map
- if (minval(glacier_region_map) < min_glacier_region_id) then
- write(iulog,*) subname//' ERROR: Expect GLACIER_REGION to be >= ', min_glacier_region_id
- write(iulog,*) 'minval = ', minval(glacier_region_map)
- call endrun(msg=' ERROR: GLACIER_REGION smaller than expected'// &
- errMsg(sourcefile, __LINE__))
- end if
-
- if (maxval(glacier_region_map) > max_glacier_region_id) then
- write(iulog,*) subname//' ERROR: Max GLACIER_REGION is ', &
- maxval(glacier_region_map)
- write(iulog,*) 'but max_glacier_region_id is only ', max_glacier_region_id
- write(iulog,*) 'Try increasing max_glacier_region_id in ', sourcefile
- call endrun(msg=' ERROR: GLACIER_REGION larger than expected'// &
- errMsg(sourcefile, __LINE__))
- end if
- end subroutine check_glacier_region_map
-
- subroutine determine_region_presence
- integer :: g
- integer :: my_id
-
- glacier_region_present(:) = .false.
- do g = begg, endg
- my_id = glacier_region_map(g)
- glacier_region_present(my_id) = .true.
- end do
- end subroutine determine_region_presence
-
- subroutine translate_glacier_region_behavior
- integer :: i
-
- do i = min_glacier_region_id, max_glacier_region_id
- glacier_region_behavior(i) = BEHAVIOR_UNSET
-
- if (glacier_region_present(i)) then
- SHR_ASSERT_ALL((ubound(glacier_region_behavior_str) >= (/i/)), errMsg(sourcefile, __LINE__))
-
- select case (glacier_region_behavior_str(i))
- case ('multiple')
- glacier_region_behavior(i) = BEHAVIOR_MULTIPLE
- case ('virtual')
- glacier_region_behavior(i) = BEHAVIOR_VIRTUAL
- case ('single_at_atm_topo')
- glacier_region_behavior(i) = BEHAVIOR_SINGLE_AT_ATM_TOPO
- case (behavior_str_unset)
- write(iulog,*) ' ERROR: glacier_region_behavior not specified for ID ', i
- write(iulog,*) 'You probably need to extend the glacier_region_behavior namelist array'
- call endrun(msg=' ERROR: glacier_region_behavior not specified for ID '// &
- errMsg(sourcefile, __LINE__))
- case default
- write(iulog,*) ' ERROR: Unknown glacier_region_behavior for ID ', i
- write(iulog,*) glacier_region_behavior_str(i)
- write(iulog,*) 'Allowable values are: multiple, virtual, single_at_atm_topo'
- call endrun(msg=' ERROR: Unknown glacier_region_behavior'// &
- errMsg(sourcefile, __LINE__))
- end select
-
- end if
- end do
- end subroutine translate_glacier_region_behavior
-
- subroutine translate_glacier_region_melt_behavior
- integer :: i
-
- do i = min_glacier_region_id, max_glacier_region_id
- glacier_region_melt_behavior(i) = BEHAVIOR_UNSET
-
- if (glacier_region_present(i)) then
- SHR_ASSERT_ALL((ubound(glacier_region_melt_behavior_str) >= (/i/)), errMsg(sourcefile, __LINE__))
-
- select case (glacier_region_melt_behavior_str(i))
- case ('replaced_by_ice')
- glacier_region_melt_behavior(i) = MELT_BEHAVIOR_REPLACED_BY_ICE
- case ('remains_in_place')
- glacier_region_melt_behavior(i) = MELT_BEHAVIOR_REMAINS_IN_PLACE
- case (behavior_str_unset)
- write(iulog,*) ' ERROR: glacier_region_melt_behavior not specified for ID ', i
- write(iulog,*) 'You probably need to extend the glacier_region_melt_behavior namelist array'
- call endrun(msg=' ERROR: glacier_region_melt_behavior not specified for ID '// &
- errMsg(sourcefile, __LINE__))
- case default
- write(iulog,*) ' ERROR: Unknown glacier_region_melt_behavior for ID ', i
- write(iulog,*) glacier_region_melt_behavior_str(i)
- write(iulog,*) 'Allowable values are: replaced_by_ice, remains_in_place'
- call endrun(msg=' ERROR: Unknown glacier_region_melt_behavior'// &
- errMsg(sourcefile, __LINE__))
- end select
-
- end if
- end do
- end subroutine translate_glacier_region_melt_behavior
-
- subroutine translate_glacier_region_ice_runoff_behavior
- integer :: i
-
- do i = min_glacier_region_id, max_glacier_region_id
- glacier_region_ice_runoff_behavior(i) = BEHAVIOR_UNSET
-
- if (glacier_region_present(i)) then
- SHR_ASSERT_ALL((ubound(glacier_region_ice_runoff_behavior_str) >= (/i/)), errMsg(sourcefile, __LINE__))
-
- select case (glacier_region_ice_runoff_behavior_str(i))
- case ('remains_ice')
- glacier_region_ice_runoff_behavior(i) = ICE_RUNOFF_BEHAVIOR_REMAINS_ICE
- case('melted')
- glacier_region_ice_runoff_behavior(i) = ICE_RUNOFF_BEHAVIOR_MELTED
- case (behavior_str_unset)
- write(iulog,*) ' ERROR: glacier_region_ice_runoff_behavior not specified for ID ', i
- write(iulog,*) 'You probably need to extend the glacier_region_ice_runoff_behavior namelist array'
- call endrun(msg=' ERROR: glacier_region_ice_runoff_behavior not specified for ID '// &
- errMsg(sourcefile, __LINE__))
- case default
- write(iulog,*) ' ERROR: Unknown glacier_region_ice_runoff_behavior for ID ', i
- write(iulog,*) glacier_region_ice_runoff_behavior_str(i)
- write(iulog,*) 'Allowable values are: remains_ice, melted'
- call endrun(msg=' ERROR: Unknown glacier_region_ice_runoff_behavior'// &
- errMsg(sourcefile, __LINE__))
- end select
- end if
- end do
- end subroutine translate_glacier_region_ice_runoff_behavior
-
- end subroutine InitFromInputs
-
-
- !-----------------------------------------------------------------------
- subroutine InitSetDirectly(this, begg, endg, &
- has_virtual_columns, collapse_to_atm_topo)
- !
- ! !DESCRIPTION:
- ! Initialize a glc_behavior_type object by directly setting has_virtual_columns and
- ! collapse_to_atm_topo
- !
- ! This version is meant for testing
- !
- ! !USES:
- !
- ! !ARGUMENTS:
- class(glc_behavior_type), intent(inout) :: this
- integer, intent(in) :: begg ! beginning gridcell index
- integer, intent(in) :: endg ! ending gridcell index
- logical, intent(in) :: has_virtual_columns(begg:)
- logical, intent(in) :: collapse_to_atm_topo(begg:)
- !
- ! !LOCAL VARIABLES:
-
- character(len=*), parameter :: subname = 'InitForTesting'
- !-----------------------------------------------------------------------
-
- SHR_ASSERT_ALL((ubound(has_virtual_columns) == (/endg/)), errMsg(sourcefile, __LINE__))
- SHR_ASSERT_ALL((ubound(collapse_to_atm_topo) == (/endg/)), errMsg(sourcefile, __LINE__))
-
- call this%InitAllocate(begg, endg)
- this%has_virtual_columns_grc(:) = has_virtual_columns(:)
- this%collapse_to_atm_topo_grc(:) = collapse_to_atm_topo(:)
-
- end subroutine InitSetDirectly
-
-
- !-----------------------------------------------------------------------
- subroutine InitAllocate(this, begg, endg)
- !
- ! !DESCRIPTION:
- ! Allocate variables in this object
- !
- ! !ARGUMENTS:
- class(glc_behavior_type), intent(inout) :: this
- integer, intent(in) :: begg ! beginning gridcell index
- integer, intent(in) :: endg ! ending gridcell index
- !
- ! !LOCAL VARIABLES:
-
- character(len=*), parameter :: subname = 'InitAllocate'
- !-----------------------------------------------------------------------
-
- allocate(this%has_virtual_columns_grc (begg:endg)); this%has_virtual_columns_grc (:) = .false.
- allocate(this%allow_multiple_columns_grc(begg:endg)); this%allow_multiple_columns_grc(:) = .false.
- allocate(this%melt_replaced_by_ice_grc(begg:endg)); this%melt_replaced_by_ice_grc(:) = .false.
- allocate(this%collapse_to_atm_topo_grc(begg:endg)); this%collapse_to_atm_topo_grc(:) = .false.
- allocate(this%ice_runoff_melted_grc(begg:endg)); this%ice_runoff_melted_grc(:) = .false.
-
- end subroutine InitAllocate
-
- !-----------------------------------------------------------------------
- subroutine read_surface_dataset(begg, endg, glacier_region_map)
- !
- ! !DESCRIPTION:
- ! Reads GLACIER_REGION field from surface dataset, returns it in glacier_region_map
- !
- ! !USES:
- use clm_varctl , only : fsurdat
- use fileutils , only : getfil
- use ncdio_pio , only : file_desc_t, ncd_io, ncd_pio_openfile, ncd_pio_closefile
- use spmdMod , only : masterproc
- use clm_varcon , only : grlnd
- !
- ! !ARGUMENTS:
- integer, intent(in) :: begg ! beginning grid cell index
- integer, intent(in) :: endg ! ending grid cell index
- integer, intent(out) :: glacier_region_map(begg:)
- !
- ! !LOCAL VARIABLES:
- integer, pointer :: glacier_region_map_ptr(:) ! pointer version needed for ncd_io interface
- character(len=256) :: locfn ! local filename
- type(file_desc_t) :: ncid ! netcdf id
- logical :: readvar
-
- character(len=*), parameter :: subname = 'read_surface_dataset'
- !-----------------------------------------------------------------------
-
- SHR_ASSERT_ALL((ubound(glacier_region_map) == (/endg/)), errMsg(sourcefile, __LINE__))
-
- if (masterproc) then
- write(iulog,*) 'Attempting to read GLACIER_REGION...'
- end if
- call getfil(fsurdat, locfn, 0)
- call ncd_pio_openfile(ncid, locfn, 0)
- allocate(glacier_region_map_ptr(begg:endg))
- call ncd_io(ncid=ncid, varname='GLACIER_REGION', flag='read', &
- data=glacier_region_map_ptr, dim1name=grlnd, readvar=readvar)
- if (.not. readvar) then
- call endrun(msg=' ERROR: GLACIER_REGION NOT on surfdata file'//errMsg(sourcefile, __LINE__))
- end if
- call ncd_pio_closefile(ncid)
- glacier_region_map(begg:endg) = glacier_region_map_ptr(begg:endg)
- deallocate(glacier_region_map_ptr)
-
- end subroutine read_surface_dataset
-
- !-----------------------------------------------------------------------
- subroutine read_namelist(NLFilename, glacier_region_behavior, &
- glacier_region_melt_behavior, glacier_region_ice_runoff_behavior)
- !
- ! !DESCRIPTION:
- ! Read local namelist items
- !
- ! !USES:
- use fileutils , only : getavu, relavu, opnfil
- use shr_nl_mod , only : shr_nl_find_group_name
- use clm_nlUtilsMod , only : find_nlgroup_name
- use spmdMod , only : masterproc, mpicom
- use shr_mpi_mod , only : shr_mpi_bcast
- !
- ! !ARGUMENTS:
- character(len=*), intent(in) :: NLFilename ! Namelist filename
- character(len=max_behavior_name_len), intent(out) :: &
- glacier_region_behavior(min_glacier_region_id:max_glacier_region_id)
- character(len=max_behavior_name_len), intent(out) :: &
- glacier_region_melt_behavior(min_glacier_region_id:max_glacier_region_id)
- character(len=max_behavior_name_len), intent(out) :: &
- glacier_region_ice_runoff_behavior(min_glacier_region_id:max_glacier_region_id)
- !
- ! !LOCAL VARIABLES:
- integer :: unitn ! unit for namelist file
- integer :: nml_error ! namelist i/o error flag
-
- character(len=*), parameter :: subname = 'read_namelist'
- !-----------------------------------------------------------------------
-
- namelist /clm_glacier_behavior/ &
- glacier_region_behavior, glacier_region_melt_behavior, &
- glacier_region_ice_runoff_behavior
-
- ! Initialize options to default values
- glacier_region_behavior(:) = behavior_str_unset
- glacier_region_melt_behavior(:) = behavior_str_unset
- glacier_region_ice_runoff_behavior(:) = behavior_str_unset
-
- if (masterproc) then
- unitn = getavu()
- call opnfil(NLFilename, unitn, 'F')
- call shr_nl_find_group_name(unitn, 'clm_glacier_behavior', status=nml_error)
- if (nml_error == 0) then
- read(unitn, nml=clm_glacier_behavior, iostat=nml_error)
- if (nml_error /= 0) then
- call endrun(msg='ERROR reading clm_glacier_behavior namelist'// &
- errMsg(sourcefile, __LINE__))
- end if
- else
- call endrun(msg='ERROR finding clm_glacier_behavior namelist'// &
- errMsg(sourcefile, __LINE__))
- end if
- call relavu( unitn )
- endif
-
- call shr_mpi_bcast(glacier_region_behavior, mpicom)
- call shr_mpi_bcast(glacier_region_melt_behavior, mpicom)
- call shr_mpi_bcast(glacier_region_ice_runoff_behavior, mpicom)
-
- if (masterproc) then
- write(iulog,*) ' '
- write(iulog,*) 'clm_glacier_behavior settings:'
- write(iulog,nml=clm_glacier_behavior)
- write(iulog,*) ' '
- end if
-
- end subroutine read_namelist
-
-
- !-----------------------------------------------------------------------
- subroutine get_num_glc_mec_subgrid(this, gi, atm_topo, npatches, ncols, nlunits)
- !
- ! !DESCRIPTION:
- ! Get number of subgrid units in glc_mec landunit on one grid cell
- !
- ! !USES:
- use clm_varpar , only : maxpatch_glcmec
- !
- ! !ARGUMENTS:
- class(glc_behavior_type), intent(in) :: this
- integer , intent(in) :: gi ! grid cell index
- real(r8), intent(in) :: atm_topo ! atmosphere's topographic height for this grid cell (m)
- integer , intent(out) :: npatches ! number of glacier_mec patches in this grid cell
- integer , intent(out) :: ncols ! number of glacier_mec columns in this grid cell
- integer , intent(out) :: nlunits ! number of glacier_mec landunits in this grid cell
- !
- ! !LOCAL VARIABLES:
- integer :: m ! loop index
- logical :: col_exists
- real(r8) :: col_wt_lunit
-
- character(len=*), parameter :: subname = 'get_num_glc_mec_subgrid'
- !-----------------------------------------------------------------------
-
- ncols = 0
-
- do m = 1, maxpatch_glcmec
- call this%glc_mec_col_exists(gi = gi, elev_class = m, atm_topo = atm_topo, &
- exists = col_exists, col_wt_lunit = col_wt_lunit)
- if (col_exists) then
- ncols = ncols + 1
- end if
- end do
-
- if (this%collapse_to_atm_topo_grc(gi) .and. &
- wt_lunit(gi, istice_mec) > 0.0_r8) then
- ! For grid cells with the collapse_to_atm_topo behavior, with a non-zero weight
- ! ice_mec landunit, we expect exactly one column
- SHR_ASSERT(ncols == 1, errMsg(sourcefile, __LINE__))
- end if
-
- if (ncols > 0) then
- npatches = ncols
- nlunits = 1
- else
- npatches = 0
- nlunits = 0
- end if
-
- end subroutine get_num_glc_mec_subgrid
-
- !-----------------------------------------------------------------------
- subroutine glc_mec_col_exists(this, gi, elev_class, atm_topo, exists, col_wt_lunit)
- !
- ! !DESCRIPTION:
- ! For the given glc_mec column, with elevation class index elev_class, in grid cell
- ! gi: sets exists to true if memory should be allocated for this column, and sets
- ! col_wt_lunit to the column's weight on the icemec landunit.
- !
- ! If exists is false, then col_wt_lunit is arbitrary and should be ignored.
- !
- ! !USES:
- use glc_elevclass_mod, only : glc_get_elevation_class, GLC_ELEVCLASS_ERR_NONE
- use glc_elevclass_mod, only : GLC_ELEVCLASS_ERR_TOO_LOW, GLC_ELEVCLASS_ERR_TOO_HIGH
- use glc_elevclass_mod, only : glc_errcode_to_string
- !
- ! !ARGUMENTS:
- class(glc_behavior_type), intent(in) :: this
- integer, intent(in) :: gi ! grid cell index
- integer, intent(in) :: elev_class ! elevation class index
- real(r8), intent(in) :: atm_topo ! atmosphere's topographic height for this grid cell (m)
- logical, intent(out) :: exists ! whether memory should be allocated for this column
- real(r8), intent(out) :: col_wt_lunit ! column's weight on the icemec landunit
- !
- ! !LOCAL VARIABLES:
- integer :: atm_elev_class ! elevation class corresponding to atmosphere topographic height
- integer :: err_code
-
- character(len=*), parameter :: subname = 'glc_mec_col_exists'
- !-----------------------------------------------------------------------
-
- ! Set default outputs
- exists = .false.
- col_wt_lunit = wt_glc_mec(gi, elev_class)
-
- if (this%collapse_to_atm_topo_grc(gi)) then
- if (wt_lunit(gi, istice_mec) > 0.0_r8) then
- call glc_get_elevation_class(atm_topo, atm_elev_class, err_code)
- if ( err_code == GLC_ELEVCLASS_ERR_NONE .or. &
- err_code == GLC_ELEVCLASS_ERR_TOO_LOW .or. &
- err_code == GLC_ELEVCLASS_ERR_TOO_HIGH) then
- ! These are all acceptable "errors" - it is even okay for these purposes if
- ! the elevation is lower than the lower bound of elevation class 1, or
- ! higher than the upper bound of the top elevation class.
-
- ! Do nothing
- else
- write(iulog,*) subname, ': ERROR getting elevation class for topo = ', atm_topo
- write(iulog,*) glc_errcode_to_string(err_code)
- call endrun(msg=subname//': ERROR getting elevation class')
- end if
-
- if (elev_class == atm_elev_class) then
- exists = .true.
- col_wt_lunit = 1._r8
- else
- exists = .false.
- col_wt_lunit = 0._r8
- end if
- end if
-
- else ! collapse_to_atm_topo_grc .false.
- if (this%has_virtual_columns_grc(gi)) then
- exists = .true.
- else if (wt_lunit(gi, istice_mec) > 0.0_r8 .and. &
- wt_glc_mec(gi, elev_class) > 0.0_r8) then
- ! If the landunit has non-zero weight on the grid cell, and this column has
- ! non-zero weight on the landunit...
- exists = .true.
- end if
- end if
-
- end subroutine glc_mec_col_exists
-
- !-----------------------------------------------------------------------
- function cols_have_dynamic_type(this, gi)
- !
- ! !DESCRIPTION:
- ! Returns true if glc_mec columns on the given grid cell have dynamic type (i.e.,
- ! type potentially changing at runtime)
- !
- ! !USES:
- !
- ! !ARGUMENTS:
- logical :: cols_have_dynamic_type ! function result
- class(glc_behavior_type), intent(in) :: this
- integer, intent(in) :: gi ! grid cell index
- !
- ! !LOCAL VARIABLES:
-
- character(len=*), parameter :: subname = 'cols_have_dynamic_type'
- !-----------------------------------------------------------------------
-
- if (this%collapse_to_atm_topo_grc(gi)) then
- cols_have_dynamic_type = .true.
- else
- cols_have_dynamic_type = .false.
- end if
-
- end function cols_have_dynamic_type
-
- !-----------------------------------------------------------------------
- subroutine icemec_cols_need_downscaling(this, bounds, num_icemecc, filter_icemecc, &
- needs_downscaling_col)
- !
- ! !DESCRIPTION:
- ! Sets needs_downscaling_col to true for any ice_mec column that needs downscaling,
- ! false for any ice_mec column that does not need downscaling.
- !
- ! Outside of filter_icemecc, leaves needs_downscaling_col untouched.
- !
- ! !USES:
- !
- ! !ARGUMENTS:
- class(glc_behavior_type) , intent(in) :: this
- type(bounds_type) , intent(in) :: bounds
- integer , intent(in) :: num_icemecc ! number of points in filter_icemecc
- integer , intent(in) :: filter_icemecc(:) ! col filter for ice_mec
- logical , intent(inout) :: needs_downscaling_col( bounds%begc: )
- !
- ! !LOCAL VARIABLES:
- integer :: fc
- integer :: c
- integer :: g
-
- character(len=*), parameter :: subname = 'icemec_cols_need_downscaling'
- !-----------------------------------------------------------------------
-
- SHR_ASSERT_ALL((ubound(needs_downscaling_col) == (/bounds%endc/)), errMsg(sourcefile, __LINE__))
-
- do fc = 1, num_icemecc
- c = filter_icemecc(fc)
- g = col%gridcell(c)
-
- if (this%collapse_to_atm_topo_grc(g)) then
- needs_downscaling_col(c) = .false.
- else
- needs_downscaling_col(c) = .true.
- end if
- end do
-
- end subroutine icemec_cols_need_downscaling
-
- !-----------------------------------------------------------------------
- subroutine update_glc_classes(this, bounds, topo_col)
- !
- ! !DESCRIPTION:
- ! Update the column class types of any glc_mec columns that need to be updated.
- !
- ! Assumes that topo_col has already been set appropriately.
- !
- ! !USES:
- !
- ! !ARGUMENTS:
- class(glc_behavior_type), intent(in) :: this
- type(bounds_type), intent(in) :: bounds
- real(r8), intent(in) :: topo_col( bounds%begc: )
- !
- ! !LOCAL VARIABLES:
- type(filter_col_type) :: collapse_filterc
-
- character(len=*), parameter :: subname = 'update_glc_classes'
- !-----------------------------------------------------------------------
-
- collapse_filterc = this%collapse_to_atm_topo_icemec_filterc(bounds)
- call this%update_collapsed_columns_classes(bounds, collapse_filterc, topo_col)
-
- end subroutine update_glc_classes
-
- !-----------------------------------------------------------------------
- subroutine update_collapsed_columns_classes(this, bounds, collapse_filterc, topo_col)
- !
- ! !DESCRIPTION:
- ! Update class of glc_mec columns in regions where these are collapsed to a single
- ! column, given a filter.
- !
- ! Assumes that topo_col has already been updated appropriately for these columns.
- !
- ! !USES:
- use glc_elevclass_mod, only : glc_get_elevation_class, GLC_ELEVCLASS_ERR_NONE
- use glc_elevclass_mod, only : GLC_ELEVCLASS_ERR_TOO_LOW, GLC_ELEVCLASS_ERR_TOO_HIGH
- use glc_elevclass_mod, only : glc_errcode_to_string
- use column_varcon , only : icemec_class_to_col_itype
- !
- ! !ARGUMENTS:
- class(glc_behavior_type), intent(in) :: this
- type(bounds_type), intent(in) :: bounds
- type(filter_col_type), intent(in) :: collapse_filterc
- real(r8), intent(in) :: topo_col( bounds%begc: )
- !
- ! !LOCAL VARIABLES:
- integer :: fc ! filter index
- integer :: c ! column index
- integer :: elev_class ! elevation class of the single column on the ice_mec landunit
- integer :: err_code
- integer :: new_coltype
-
- character(len=*), parameter :: subname = 'update_collapsed_columns_classes'
- !-----------------------------------------------------------------------
-
- SHR_ASSERT_ALL((ubound(topo_col) == (/bounds%endc/)), errMsg(sourcefile, __LINE__))
-
- do fc = 1, collapse_filterc%num
- c = collapse_filterc%indices(fc)
-
- call glc_get_elevation_class(topo_col(c), elev_class, err_code)
- if ( err_code == GLC_ELEVCLASS_ERR_NONE .or. &
- err_code == GLC_ELEVCLASS_ERR_TOO_LOW .or. &
- err_code == GLC_ELEVCLASS_ERR_TOO_HIGH) then
- ! These are all acceptable "errors" - it is even okay for these purposes if
- ! the elevation is lower than the lower bound of elevation class 1, or
- ! higher than the upper bound of the top elevation class.
-
- ! Do nothing
- else
- write(iulog,*) subname, ': ERROR getting elevation class for topo = ', &
- topo_col(c)
- write(iulog,*) glc_errcode_to_string(err_code)
- call endrun(msg=subname//': ERROR getting elevation class')
- end if
-
- new_coltype = icemec_class_to_col_itype(elev_class)
- if (new_coltype /= col%itype(c)) then
- call col%update_itype(c = c, itype = new_coltype)
- end if
- end do
-
- end subroutine update_collapsed_columns_classes
-
- !-----------------------------------------------------------------------
- function collapse_to_atm_topo_icemec_filterc(this, bounds) result(filter)
- !
- ! !DESCRIPTION:
- ! Returns a column-level filter of ice_mec columns with the collapse_to_atm_topo behavior
- !
- ! !USES:
- use filterColMod, only : filter_col_type, col_filter_from_grcflags_ltypes
- !
- ! !ARGUMENTS:
- class(glc_behavior_type), intent(in) :: this
- type(filter_col_type) :: filter ! function result
- type(bounds_type), intent(in) :: bounds
- !
- ! !LOCAL VARIABLES:
-
- character(len=*), parameter :: subname = 'collapse_to_atm_topo_icemec_filterc'
- !-----------------------------------------------------------------------
-
- ! Currently this creates the filter on the fly, recreating it every time this
- ! function is called. Since this is a static filter, we could just compute it once
- ! and save it, returning the already-computed filter when this function is called.
- ! However, the problem with that is the need to have a different filter for each
- ! clump (and potentially another filter for calls from outside a clump loop). This
- ! will become easier to handle if we rework CLM's threading so that there is a
- ! separate instance of each object for each clump: in that case, we'll have multiple
- ! instances of glc_behavior_type, each corresponding to one clump, each with its own
- ! filter.
-
- filter = col_filter_from_grcflags_ltypes( &
- bounds = bounds, &
- grcflags = this%collapse_to_atm_topo_grc(bounds%begg:bounds%endg), &
- ltypes = [istice_mec], &
- include_inactive = .true.)
-
- end function collapse_to_atm_topo_icemec_filterc
-
- !-----------------------------------------------------------------------
- function get_collapse_to_atm_topo(this, gi) result(collapse_to_atm_topo)
- !
- ! !DESCRIPTION:
- ! Get the value of collapse_to_atm_topo at a given grid cell
- !
- ! This function just exists to support unit testing, and should not be called from
- ! production code.
- !
- ! !USES:
- !
- ! !ARGUMENTS:
- logical :: collapse_to_atm_topo ! function result
- class(glc_behavior_type), intent(in) :: this
- integer, intent(in) :: gi ! grid cell index
- !
- ! !LOCAL VARIABLES:
-
- character(len=*), parameter :: subname = 'get_collapse_to_atm_topo'
- !-----------------------------------------------------------------------
-
- collapse_to_atm_topo = this%collapse_to_atm_topo_grc(gi)
-
- end function get_collapse_to_atm_topo
-
-end module glcBehaviorMod
diff --git a/src/main/histFileMod.F90 b/src/main/histFileMod.F90
index 918b0259..bb85d4df 100644
--- a/src/main/histFileMod.F90
+++ b/src/main/histFileMod.F90
@@ -12,14 +12,11 @@ module histFileMod
use shr_sys_mod , only : shr_sys_flush
use spmdMod , only : masterproc
use abortutils , only : endrun
- use clm_varctl , only : iulog, use_vertsoilc
- use clm_varcon , only : spval, ispval, dzsoi_decomp
- use clm_varcon , only : grlnd, nameg, namel, namec, namep, nameCohort
+ use clm_varctl , only : iulog
+ use clm_varcon , only : spval, ispval
+ use clm_varcon , only : grlnd, nameg
use decompMod , only : get_proc_bounds, get_proc_global, bounds_type
use GridcellType , only : grc
- use LandunitType , only : lun
- use ColumnType , only : col
- use PatchType , only : patch
use ncdio_pio
!
@@ -38,16 +35,6 @@ module histFileMod
integer , private, parameter :: avgflag_strlen = 3 ! maximum number of characters for avgflag
integer , private, parameter :: hist_dim_name_length = 16 ! lenngth of character strings in dimension names
- ! Possible ways to treat multi-layer snow fields at times when no snow is present in a
- ! given layer. Note that the public parameters are the only ones that can be used by
- ! calls to hist_addfld2d; the private parameters are just used internally by the
- ! histFile implementation.
- integer , private, parameter :: no_snow_MIN = 1 ! minimum valid value for this flag
- integer , public , parameter :: no_snow_normal = 1 ! normal treatment, which should be used for most fields (use spval when snow layer not present)
- integer , public , parameter :: no_snow_zero = 2 ! average in a 0 value for times when the snow layer isn't present
- integer , private, parameter :: no_snow_MAX = 2 ! maximum valid value for this flag
- integer , private, parameter :: no_snow_unset = no_snow_MIN - 1 ! flag specifying that field is NOT a multi-layer snow field
- !
! Counters
!
integer , public :: ntapes = 0 ! index of max history file requested
@@ -105,9 +92,9 @@ module histFileMod
logical, private :: if_disphist(max_tapes) ! restart, true => save history file
!
! !PUBLIC MEMBER FUNCTIONS:
+ public :: hist_readNML ! Read in the history namelist settings
public :: hist_addfld1d ! Add a 1d single-level field to the master field list
public :: hist_addfld2d ! Add a 2d multi-level field to the master field list
- public :: hist_addfld_decomp ! Add a 2d multi-level field to the master field list
public :: hist_add_subscript ! Add a 2d subscript dimension
public :: hist_printflds ! Print summary of master field list
public :: hist_htapes_build ! Initialize history file handler for initial or continue run
@@ -123,10 +110,6 @@ module histFileMod
private :: masterlist_change_timeavg ! Override default history tape contents for specific tape
private :: htape_addfld ! Add a field to the active list for a history tape
private :: htape_create ! Define contents of history file t
- private :: htape_add_ltype_metadata ! Add global metadata defining landunit types
- private :: htape_add_ctype_metadata ! Add global metadata defining column types
- private :: htape_add_natpft_metadata ! Add global metadata defining natpft types
- private :: htape_add_cft_metadata ! Add global metadata defining cft types
private :: htape_timeconst ! Write time constant values to history tape
private :: htape_timeconst3D ! Write time constant 3D values to primary history tape
private :: hfields_normalize ! Normalize history file fields by number of accumulations
@@ -135,7 +118,6 @@ module histFileMod
private :: hfields_1dinfo ! Define/output 1d subgrid info if appropriate
private :: hist_update_hbuf_field_1d ! Updates history buffer for specific field and tape
private :: hist_update_hbuf_field_2d ! Updates history buffer for specific field and tape
- private :: hist_set_snow_field_2d ! Set values in history field dimensioned by levsno
private :: list_index ! Find index of field in exclude list
private :: set_hist_filename ! Determine history dataset filenames
private :: getname ! Retrieve name portion of input "inname"
@@ -162,7 +144,7 @@ module histFileMod
character(len=max_chars) :: units ! units
character(len=hist_dim_name_length) :: type1d ! pointer to first dimension type from data type (nameg, etc)
character(len=hist_dim_name_length) :: type1d_out ! hbuf first dimension type from data type (nameg, etc)
- character(len=hist_dim_name_length) :: type2d ! hbuf second dimension type ["levgrnd","levlak","numrad","ltype","natpft","cft","glc_nec","elevclas","subname(n)"]
+ character(len=hist_dim_name_length) :: type2d ! hbuf second dimension type ["levgrnd","numrad","ltype","subname(n)"]
integer :: beg1d ! on-node 1d clm pointer start index
integer :: end1d ! on-node 1d clm pointer end index
integer :: num1d ! size of clm pointer first dimension (all nodes)
@@ -171,10 +153,6 @@ module histFileMod
integer :: num1d_out ! size of hbuf first dimension (all nodes)
integer :: num2d ! size of hbuf second dimension (e.g. number of vertical levels)
integer :: hpindex ! history pointer index
- character(len=scale_type_strlen) :: p2c_scale_type ! scale factor when averaging patch to column
- character(len=scale_type_strlen) :: c2l_scale_type ! scale factor when averaging column to landunit
- character(len=scale_type_strlen) :: l2g_scale_type ! scale factor when averaging landunit to gridcell
- integer :: no_snow_behavior ! for multi-layer snow fields, flag saying how to treat times when a given snow layer is absent
end type field_info
type master_entry
@@ -285,9 +263,7 @@ end subroutine hist_printflds
!-----------------------------------------------------------------------
subroutine masterlist_addfld (fname, type1d, type1d_out, &
- type2d, num2d, units, avgflag, long_name, hpindex, &
- p2c_scale_type, c2l_scale_type, l2g_scale_type, &
- no_snow_behavior)
+ type2d, num2d, units, avgflag, long_name, hpindex)
!
! !DESCRIPTION:
! Add a field to the master field list. Put input arguments of
@@ -308,19 +284,12 @@ subroutine masterlist_addfld (fname, type1d, type1d_out, &
character(len=*), intent(in) :: avgflag ! time averaging flag
character(len=*), intent(in) :: long_name ! long name of field
integer , intent(in) :: hpindex ! data type index for history buffer output
- character(len=*), intent(in) :: p2c_scale_type ! scale type for subgrid averaging of pfts to column
- character(len=*), intent(in) :: c2l_scale_type ! scale type for subgrid averaging of columns to landunits
- character(len=*), intent(in) :: l2g_scale_type ! scale type for subgrid averaging of landunits to gridcells
- integer, intent(in), optional :: no_snow_behavior ! if a multi-layer snow field, behavior to use for absent snow layers
!
! !LOCAL VARIABLES:
integer :: n ! loop index
integer :: f ! masterlist index
integer :: numa ! total number of atm cells across all processors
integer :: numg ! total number of gridcells across all processors
- integer :: numl ! total number of landunits across all processors
- integer :: numc ! total number of columns across all processors
- integer :: nump ! total number of pfts across all processors
type(bounds_type) :: bounds
character(len=*),parameter :: subname = 'masterlist_addfld'
!------------------------------------------------------------------------
@@ -333,7 +302,7 @@ subroutine masterlist_addfld (fname, type1d, type1d_out, &
! Determine bounds
call get_proc_bounds(bounds)
- call get_proc_global(ng=numg, nl=numl, nc=numc, np=nump)
+ call get_proc_global(ng=numg)
! Ensure that new field is not all blanks
@@ -380,9 +349,6 @@ subroutine masterlist_addfld (fname, type1d, type1d_out, &
masterlist(f)%field%type2d = type2d
masterlist(f)%field%num2d = num2d
masterlist(f)%field%hpindex = hpindex
- masterlist(f)%field%p2c_scale_type = p2c_scale_type
- masterlist(f)%field%c2l_scale_type = c2l_scale_type
- masterlist(f)%field%l2g_scale_type = l2g_scale_type
select case (type1d)
case (grlnd)
@@ -393,29 +359,11 @@ subroutine masterlist_addfld (fname, type1d, type1d_out, &
masterlist(f)%field%beg1d = bounds%begg
masterlist(f)%field%end1d = bounds%endg
masterlist(f)%field%num1d = numg
- case (namel)
- masterlist(f)%field%beg1d = bounds%begl
- masterlist(f)%field%end1d = bounds%endl
- masterlist(f)%field%num1d = numl
- case (namec)
- masterlist(f)%field%beg1d = bounds%begc
- masterlist(f)%field%end1d = bounds%endc
- masterlist(f)%field%num1d = numc
- case (namep)
- masterlist(f)%field%beg1d = bounds%begp
- masterlist(f)%field%end1d = bounds%endp
- masterlist(f)%field%num1d = nump
case default
write(iulog,*) trim(subname),' ERROR: unknown 1d output type= ',type1d
call endrun(msg=errMsg(sourcefile, __LINE__))
end select
- if (present(no_snow_behavior)) then
- masterlist(f)%field%no_snow_behavior = no_snow_behavior
- else
- masterlist(f)%field%no_snow_behavior = no_snow_unset
- end if
-
! The following two fields are used only in master field list,
! NOT in the runtime active field list
! ALL FIELDS IN THE MASTER LIST ARE INITIALIZED WITH THE ACTIVE
@@ -453,7 +401,7 @@ subroutine hist_htapes_build ()
!-----------------------------------------------------------------------
if (masterproc) then
- write(iulog,*) trim(subname),' Initializing clm2 history files'
+ write(iulog,*) trim(subname),' Initializing slim history files'
write(iulog,'(72a1)') ("-",i=1,60)
call shr_sys_flush(iulog)
endif
@@ -500,7 +448,7 @@ subroutine hist_htapes_build ()
end do
if (masterproc) then
- write(iulog,*) trim(subname),' Successfully initialized clm2 history files'
+ write(iulog,*) trim(subname),' Successfully initialized slim history files'
write(iulog,'(72a1)') ("-",i=1,60)
call shr_sys_flush(iulog)
endif
@@ -831,25 +779,6 @@ logical function is_mapping_upto_subgrid( type1d, type1d_out ) result ( mapping)
character(len=8), intent(in) :: type1d_out ! history buffer 1d type
!
mapping = .false.
- if (type1d_out == nameg .or. type1d_out == grlnd) then
- if (type1d == namep) then
- mapping = .true.
- else if (type1d == namec) then
- mapping = .true.
- else if (type1d == namel) then
- mapping = .true.
- end if
- else if (type1d_out == namel ) then
- if (type1d == namep) then
- mapping = .true.
- else if (type1d == namec) then
- mapping = .true.
- end if
- else if (type1d_out == namec ) then
- if (type1d == namep) then
- mapping = .true.
- end if
- end if
end function is_mapping_upto_subgrid
!-----------------------------------------------------------------------
@@ -870,9 +799,6 @@ subroutine htape_addfld (t, f, avgflag)
character(len=hist_dim_name_length) :: type1d_out ! history buffer 1d type
integer :: numa ! total number of atm cells across all processors
integer :: numg ! total number of gridcells across all processors
- integer :: numl ! total number of landunits across all processors
- integer :: numc ! total number of columns across all processors
- integer :: nump ! total number of pfts across all processors
integer :: num2d ! size of second dimension (e.g. .number of vertical levels)
integer :: beg1d_out,end1d_out ! history output per-proc 1d beginning and ending indices
integer :: beg1d,end1d ! beginning and ending indices for this field (assume already set)
@@ -899,7 +825,7 @@ subroutine htape_addfld (t, f, avgflag)
! Determine bounds
call get_proc_bounds(bounds)
- call get_proc_global(ng=numg, nl=numl, nc=numc, np=nump)
+ call get_proc_global(ng=numg)
! Modify type1d_out if necessary
@@ -911,10 +837,7 @@ subroutine htape_addfld (t, f, avgflag)
type1d = tape(t)%hlist(n)%field%type1d
- if (type1d == nameg .or. &
- type1d == namel .or. &
- type1d == namec .or. &
- type1d == namep) then
+ if (type1d == nameg) then
tape(t)%hlist(n)%field%type1d_out = grlnd
end if
if (type1d == grlnd) then
@@ -931,12 +854,6 @@ subroutine htape_addfld (t, f, avgflag)
select case (trim(hist_type1d_pertape(t)))
case('GRID')
tape(t)%hlist(n)%field%type1d_out = nameg
- case('LAND')
- tape(t)%hlist(n)%field%type1d_out = namel
- case('COLS')
- tape(t)%hlist(n)%field%type1d_out = namec
- case ('PFTS')
- tape(t)%hlist(n)%field%type1d_out = namep
case default
write(iulog,*) trim(subname),' ERROR: unknown input hist_type1d_pertape= ', hist_type1d_pertape(t)
call endrun(msg=errMsg(sourcefile, __LINE__))
@@ -955,18 +872,6 @@ subroutine htape_addfld (t, f, avgflag)
beg1d_out = bounds%begg
end1d_out = bounds%endg
num1d_out = numg
- else if (type1d_out == namel) then
- beg1d_out = bounds%begl
- end1d_out = bounds%endl
- num1d_out = numl
- else if (type1d_out == namec) then
- beg1d_out = bounds%begc
- end1d_out = bounds%endc
- num1d_out = numc
- else if (type1d_out == namep) then
- beg1d_out = bounds%begp
- end1d_out = bounds%endp
- num1d_out = nump
else
write(iulog,*) trim(subname),' ERROR: incorrect value of type1d_out= ',type1d_out
call endrun(msg=errMsg(sourcefile, __LINE__))
@@ -1025,7 +930,7 @@ subroutine hist_update_hbuf(bounds)
integer :: f ! field index
integer :: num2d ! size of second dimension (e.g. number of vertical levels)
character(len=*),parameter :: subname = 'hist_update_hbuf'
- character(len=hist_dim_name_length) :: type2d ! hbuf second dimension type ["levgrnd","levlak","numrad","ltype","natpft","cft","glc_nec","elevclas","subname(n)"]
+ character(len=hist_dim_name_length) :: type2d ! hbuf second dimension type ["levgrnd","numrad","ltype","subname(n)"]
!-----------------------------------------------------------------------
do t = 1,ntapes
@@ -1054,7 +959,6 @@ subroutine hist_update_hbuf_field_1d (t, f, bounds)
! call to p2g, and the lack of explicit bounds on its arguments; see also bug 1786)
!
! !USES:
- use subgridAveMod , only : p2g, c2g, l2g, p2l, c2l, p2c
use decompMod , only : BOUNDS_LEVEL_PROC
!
! !ARGUMENTS:
@@ -1064,23 +968,16 @@ subroutine hist_update_hbuf_field_1d (t, f, bounds)
!
! !LOCAL VARIABLES:
integer :: hpindex ! history pointer index
- integer :: k ! gridcell, landunit, column or patch index
+ integer :: k ! gridcell index
integer :: beg1d,end1d ! beginning and ending indices
integer :: beg1d_out,end1d_out ! beginning and ending indices on output grid
- logical :: check_active ! true => check 'active' flag of each point (this refers to a point being active, NOT a history field being active)
logical :: valid ! true => history operation is valid
- logical :: map2gcell ! true => map clm pointer field to gridcell
- character(len=hist_dim_name_length) :: type1d ! 1d clm pointerr type ["gridcell","landunit","column","pft"]
- character(len=hist_dim_name_length) :: type1d_out ! 1d history buffer type ["gridcell","landunit","column","pft"]
+ character(len=hist_dim_name_length) :: type1d ! 1d clm pointerr type ["gridcell"]
+ character(len=hist_dim_name_length) :: type1d_out ! 1d history buffer type ["gridcell"]
character(len=avgflag_strlen) :: avgflag ! time averaging flag
- character(len=scale_type_strlen) :: p2c_scale_type ! scale type for subgrid averaging of pfts to column
- character(len=scale_type_strlen) :: c2l_scale_type ! scale type for subgrid averaging of columns to landunits
- character(len=scale_type_strlen) :: l2g_scale_type ! scale type for subgrid averaging of landunits to gridcells
real(r8), pointer :: hbuf(:,:) ! history buffer
integer , pointer :: nacs(:,:) ! accumulation counter
real(r8), pointer :: field(:) ! clm 1d pointer field
- logical , pointer :: active(:) ! flag saying whether each point is active (used for type1d = landunit/column/pft) (this refers to a point being active, NOT a history field being active)
- real(r8), allocatable :: field_gcell(:) ! gricell level field (used if mapping to gridcell is done)
integer j
character(len=*),parameter :: subname = 'hist_update_hbuf_field_1d'
integer k_offset ! offset for mapping sliced subarray pointers when outputting variables in PFT/col vector form
@@ -1097,167 +994,20 @@ subroutine hist_update_hbuf_field_1d (t, f, bounds)
end1d_out = tape(t)%hlist(f)%field%end1d_out
type1d = tape(t)%hlist(f)%field%type1d
type1d_out = tape(t)%hlist(f)%field%type1d_out
- p2c_scale_type = tape(t)%hlist(f)%field%p2c_scale_type
- c2l_scale_type = tape(t)%hlist(f)%field%c2l_scale_type
- l2g_scale_type = tape(t)%hlist(f)%field%l2g_scale_type
hpindex = tape(t)%hlist(f)%field%hpindex
field => clmptr_rs(hpindex)%ptr
! set variables to check weights when allocate all pfts
- map2gcell = .false.
if (type1d_out == nameg .or. type1d_out == grlnd) then
SHR_ASSERT(beg1d_out == bounds%begg, errMsg(sourcefile, __LINE__))
SHR_ASSERT(end1d_out == bounds%endg, errMsg(sourcefile, __LINE__))
- if (type1d == namep) then
- ! In this and the following calls, we do NOT explicitly subset field using
- ! bounds (e.g., we do NOT do field(bounds%begp:bounds%endp). This is because,
- ! for some fields, the lower bound has been reset to 1 due to taking a pointer
- ! to an array slice. Thus, this code will NOT work properly if done within a
- ! threaded region! (See also bug 1786)
- allocate( field_gcell(beg1d_out:end1d_out) )
- call p2g(bounds, &
- field, &
- field_gcell(bounds%begg:bounds%endg), &
- p2c_scale_type, c2l_scale_type, l2g_scale_type)
- map2gcell = .true.
- else if (type1d == namec) then
- allocate( field_gcell(beg1d_out:end1d_out) )
- call c2g(bounds, &
- field, &
- field_gcell(bounds%begg:bounds%endg), &
- c2l_scale_type, l2g_scale_type)
- map2gcell = .true.
- else if (type1d == namel) then
- allocate( field_gcell(beg1d_out:end1d_out) )
- call l2g(bounds, &
- field, &
- field_gcell(bounds%begg:bounds%endg), &
- l2g_scale_type)
- map2gcell = .true.
- end if
- end if
- if (type1d_out == namel ) then
- SHR_ASSERT(beg1d_out == bounds%begl, errMsg(sourcefile, __LINE__))
- SHR_ASSERT(end1d_out == bounds%endl, errMsg(sourcefile, __LINE__))
- if (type1d == namep) then
- ! In this and the following calls, we do NOT explicitly subset field using
- ! bounds (e.g., we do NOT do field(bounds%begp:bounds%endp). This is because,
- ! for some fields, the lower bound has been reset to 1 due to taking a pointer
- ! to an array slice. Thus, this code will NOT work properly if done within a
- ! threaded region! (See also bug 1786)
- allocate( field_gcell(beg1d_out:end1d_out) )
- call p2l(bounds, &
- field, &
- field_gcell(beg1d_out:end1d_out), &
- p2c_scale_type, c2l_scale_type)
- map2gcell = .true.
- else if (type1d == namec) then
- allocate( field_gcell(beg1d_out:end1d_out) )
- call c2l(bounds, &
- field, &
- field_gcell(beg1d_out:end1d_out), &
- c2l_scale_type)
- map2gcell = .true.
- end if
- end if
- if (type1d_out == namec ) then
- SHR_ASSERT(beg1d_out == bounds%begc, errMsg(sourcefile, __LINE__))
- SHR_ASSERT(end1d_out == bounds%endc, errMsg(sourcefile, __LINE__))
- if (type1d == namep) then
- ! In this and the following calls, we do NOT explicitly subset field using
- ! bounds (e.g., we do NOT do field(bounds%begp:bounds%endp). This is because,
- ! for some fields, the lower bound has been reset to 1 due to taking a pointer
- ! to an array slice. Thus, this code will NOT work properly if done within a
- ! threaded region! (See also bug 1786)
- allocate( field_gcell(beg1d_out:end1d_out) )
- call p2c(bounds, &
- field, &
- field_gcell(beg1d_out:end1d_out), &
- p2c_scale_type)
- map2gcell = .true.
- end if
- end if
- if ( map2gcell .and. .not. is_mapping_upto_subgrid(type1d, type1d_out) )then
- call endrun(msg=trim(subname)//' ERROR: mapping upto subgrid level is inconsistent'//errMsg(sourcefile, __LINE__))
- end if
- if ( .not. map2gcell .and. is_mapping_upto_subgrid(type1d, type1d_out) )then
- call endrun(msg=trim(subname)//' ERROR: mapping upto subgrid level is inconsistent'//errMsg(sourcefile, __LINE__))
end if
- if (map2gcell) then ! Map to gridcell
-
- ! note that in this case beg1d = begg and end1d=endg
- select case (avgflag)
- case ('I') ! Instantaneous
- do k = beg1d_out, end1d_out
- if (field_gcell(k) /= spval) then
- hbuf(k,1) = field_gcell(k)
- else
- hbuf(k,1) = spval
- end if
- nacs(k,1) = 1
- end do
- case ('A', 'SUM') ! Time average / sum
- do k = beg1d_out, end1d_out
- if (field_gcell(k) /= spval) then
- if (nacs(k,1) == 0) hbuf(k,1) = 0._r8
- hbuf(k,1) = hbuf(k,1) + field_gcell(k)
- nacs(k,1) = nacs(k,1) + 1
- else
- if (nacs(k,1) == 0) hbuf(k,1) = spval
- end if
- end do
- case ('X') ! Maximum over time
- do k = beg1d_out, end1d_out
- if (field_gcell(k) /= spval) then
- if (nacs(k,1) == 0) hbuf(k,1) = -1.e50_r8
- hbuf(k,1) = max( hbuf(k,1), field_gcell(k) )
- else
- hbuf(k,1) = spval
- endif
- nacs(k,1) = 1
- end do
- case ('M') ! Minimum over time
- do k = beg1d_out, end1d_out
- if (field_gcell(k) /= spval) then
- if (nacs(k,1) == 0) hbuf(k,1) = +1.e50_r8
- hbuf(k,1) = min( hbuf(k,1), field_gcell(k) )
- else
- hbuf(k,1) = spval
- endif
- nacs(k,1) = 1
- end do
- case default
- write(iulog,*) trim(subname),' ERROR: invalid time averaging flag ', avgflag
- call endrun(msg=errMsg(sourcefile, __LINE__))
- end select
- deallocate( field_gcell )
-
- else ! Do not map to gridcell
-
- ! For data defined on the pft, col or landunit, we need to check if a point is active
- ! to determine whether that point should be assigned spval
- if (type1d == namep) then
- check_active = .true.
- active => patch%active
- else if (type1d == namec) then
- check_active = .true.
- active => col%active
- else if (type1d == namel) then
- check_active = .true.
- active =>lun%active
- else
- check_active = .false.
- end if
-
select case (avgflag)
case ('I') ! Instantaneous
do k = beg1d,end1d
valid = .true.
- if (check_active) then
- if (.not. active(k)) valid = .false.
- end if
if (valid) then
if (field(k) /= spval) then
hbuf(k,1) = field(k)
@@ -1274,13 +1024,10 @@ subroutine hist_update_hbuf_field_1d (t, f, bounds)
if ( end1d .eq. ubound(field,1) ) then
k_offset = 0
else
- k_offset = 1 - beg1d
+ k_offset = 1 - beg1d
endif
do k = beg1d,end1d
valid = .true.
- if (check_active) then
- if (.not. active(k)) valid = .false.
- end if
if (valid) then
if (field(k+k_offset) /= spval) then ! add k_offset
if (nacs(k,1) == 0) hbuf(k,1) = 0._r8
@@ -1296,9 +1043,6 @@ subroutine hist_update_hbuf_field_1d (t, f, bounds)
case ('X') ! Maximum over time
do k = beg1d,end1d
valid = .true.
- if (check_active) then
- if (.not. active(k)) valid = .false.
- end if
if (valid) then
if (field(k) /= spval) then
if (nacs(k,1) == 0) hbuf(k,1) = -1.e50_r8
@@ -1314,9 +1058,6 @@ subroutine hist_update_hbuf_field_1d (t, f, bounds)
case ('M') ! Minimum over time
do k = beg1d,end1d
valid = .true.
- if (check_active) then
- if (.not. active(k)) valid = .false.
- end if
if (valid) then
if (field(k) /= spval) then
if (nacs(k,1) == 0) hbuf(k,1) = +1.e50_r8
@@ -1333,7 +1074,6 @@ subroutine hist_update_hbuf_field_1d (t, f, bounds)
write(iulog,*) trim(subname),' ERROR: invalid time averaging flag ', avgflag
call endrun(msg=errMsg(sourcefile, __LINE__))
end select
- end if
end subroutine hist_update_hbuf_field_1d
@@ -1348,7 +1088,6 @@ subroutine hist_update_hbuf_field_2d (t, f, bounds, num2d)
! call to p2g, and the lack of explicit bounds on its arguments; see also bug 1786)
!
! !USES:
- use subgridAveMod , only : p2g, c2g, l2g, p2l, c2l, p2c
use decompMod , only : BOUNDS_LEVEL_PROC
!
! !ARGUMENTS:
@@ -1359,27 +1098,18 @@ subroutine hist_update_hbuf_field_2d (t, f, bounds, num2d)
!
! !LOCAL VARIABLES:
integer :: hpindex ! history pointer index
- integer :: k ! gridcell, landunit, column or patch index
+ integer :: k ! gridcell index
integer :: j ! level index
integer :: beg1d,end1d ! beginning and ending indices
integer :: beg1d_out,end1d_out ! beginning and ending indices for output level
- logical :: check_active ! true => check 'active' flag of each point (this refers to a point being active, NOT a history field being active)
logical :: valid ! true => history operation is valid
- logical :: map2gcell ! true => map clm pointer field to gridcell
- character(len=hist_dim_name_length) :: type1d ! 1d clm pointerr type ["gridcell","landunit","column","pft"]
- character(len=hist_dim_name_length) :: type1d_out ! 1d history buffer type ["gridcell","landunit","column","pft"]
+ character(len=hist_dim_name_length) :: type1d ! 1d clm pointerr type ["gridcell"]
+ character(len=hist_dim_name_length) :: type1d_out ! 1d history buffer type ["gridcell"]
character(len=avgflag_strlen) :: avgflag ! time averaging flag
- character(len=scale_type_strlen) :: p2c_scale_type ! scale type for subgrid averaging of pfts to column
- character(len=scale_type_strlen) :: c2l_scale_type ! scale type for subgrid averaging of columns to landunits
- character(len=scale_type_strlen) :: l2g_scale_type ! scale type for subgrid averaging of landunits to gridcells
- integer :: no_snow_behavior ! for multi-layer snow fields, behavior to use when a given layer is absent
real(r8), pointer :: hbuf(:,:) ! history buffer
integer , pointer :: nacs(:,:) ! accumulation counter
real(r8), pointer :: field(:,:) ! clm 2d pointer field
logical :: field_allocated! whether 'field' was allocated here
- logical , pointer :: active(:) ! flag saying whether each point is active (used for type1d = landunit/column/pft)
- !(this refers to a point being active, NOT a history field being active)
- real(r8), allocatable :: field_gcell(:,:) ! gridcell level field (used if mapping to gridcell is done)
character(len=*),parameter :: subname = 'hist_update_hbuf_field_2d'
!-----------------------------------------------------------------------
@@ -1394,188 +1124,17 @@ subroutine hist_update_hbuf_field_2d (t, f, bounds, num2d)
end1d_out = tape(t)%hlist(f)%field%end1d_out
type1d = tape(t)%hlist(f)%field%type1d
type1d_out = tape(t)%hlist(f)%field%type1d_out
- p2c_scale_type = tape(t)%hlist(f)%field%p2c_scale_type
- c2l_scale_type = tape(t)%hlist(f)%field%c2l_scale_type
- l2g_scale_type = tape(t)%hlist(f)%field%l2g_scale_type
- no_snow_behavior = tape(t)%hlist(f)%field%no_snow_behavior
hpindex = tape(t)%hlist(f)%field%hpindex
- if (no_snow_behavior /= no_snow_unset) then
- ! For multi-layer snow fields, build a special output variable that handles
- ! missing snow layers appropriately
-
- ! Note, regarding bug 1786: The following allocation is not what we would want if
- ! this routine were operating in a threaded region (or, more generally, within a
- ! loop over nclumps) - in that case we would want to use the bounds information for
- ! this clump. But currently that's not possible because the bounds of some fields
- ! have been reset to 1 - see also bug 1786. Similarly, if we wanted to allow
- ! operation within a loop over clumps, we would need to pass 'bounds' to
- ! hist_set_snow_field_2d rather than relying on beg1d & end1d (which give the proc,
- ! bounds not the clump bounds)
-
- allocate(field(lbound(clmptr_ra(hpindex)%ptr, 1) : ubound(clmptr_ra(hpindex)%ptr, 1), 1:num2d))
- field_allocated = .true.
-
- call hist_set_snow_field_2d(field, clmptr_ra(hpindex)%ptr, no_snow_behavior, type1d, &
- beg1d, end1d)
- else
field => clmptr_ra(hpindex)%ptr(:,1:num2d)
field_allocated = .false.
- end if
! set variables to check weights when allocate all pfts
- map2gcell = .false.
if (type1d_out == nameg .or. type1d_out == grlnd) then
SHR_ASSERT(beg1d_out == bounds%begg, errMsg(sourcefile, __LINE__))
SHR_ASSERT(end1d_out == bounds%endg, errMsg(sourcefile, __LINE__))
- if (type1d == namep) then
- ! In this and the following calls, we do NOT explicitly subset field using
- ! (e.g., we do NOT do field(bounds%begp:bounds%endp). This is because,
- ! for some fields, the lower bound has been reset to 1 due to taking a pointer
- ! to an array slice. Thus, this code will NOT work properly if done within a
- ! threaded region! (See also bug 1786)
- allocate(field_gcell(bounds%begg:bounds%endg,num2d) )
- call p2g(bounds, num2d, &
- field, &
- field_gcell(bounds%begg:bounds%endg, :), &
- p2c_scale_type, c2l_scale_type, l2g_scale_type)
- map2gcell = .true.
- else if (type1d == namec) then
- allocate(field_gcell(bounds%begg:bounds%endg,num2d) )
- call c2g(bounds, num2d, &
- field, &
- field_gcell(bounds%begg:bounds%endg, :), &
- c2l_scale_type, l2g_scale_type)
- map2gcell = .true.
- else if (type1d == namel) then
- allocate(field_gcell(bounds%begg:bounds%endg,num2d) )
- call l2g(bounds, num2d, &
- field, &
- field_gcell(bounds%begg:bounds%endg, :), &
- l2g_scale_type)
- map2gcell = .true.
- end if
- else if ( type1d_out == namel )then
- SHR_ASSERT(beg1d_out == bounds%begl, errMsg(sourcefile, __LINE__))
- SHR_ASSERT(end1d_out == bounds%endl, errMsg(sourcefile, __LINE__))
- if (type1d == namep) then
- ! In this and the following calls, we do NOT explicitly subset field using
- ! (e.g., we do NOT do field(bounds%begp:bounds%endp). This is because,
- ! for some fields, the lower bound has been reset to 1 due to taking a pointer
- ! to an array slice. Thus, this code will NOT work properly if done within a
- ! threaded region! (See also bug 1786)
- allocate(field_gcell(beg1d_out:end1d_out,num2d))
- call p2l(bounds, num2d, &
- field, &
- field_gcell(beg1d_out:end1d_out, :), &
- p2c_scale_type, c2l_scale_type)
- map2gcell = .true.
- else if (type1d == namec) then
- allocate(field_gcell(beg1d_out:end1d_out,num2d))
- call c2l(bounds, num2d, &
- field, &
- field_gcell(beg1d_out:end1d_out, :), &
- c2l_scale_type)
- map2gcell = .true.
- end if
- else if ( type1d_out == namec )then
- SHR_ASSERT(beg1d_out == bounds%begc, errMsg(sourcefile, __LINE__))
- SHR_ASSERT(end1d_out == bounds%endc, errMsg(sourcefile, __LINE__))
- if (type1d == namep) then
- ! In this and the following calls, we do NOT explicitly subset field using
- ! (e.g., we do NOT do field(bounds%begp:bounds%endp). This is because,
- ! for some fields, the lower bound has been reset to 1 due to taking a pointer
- ! to an array slice. Thus, this code will NOT work properly if done within a
- ! threaded region! (See also bug 1786)
- allocate(field_gcell(beg1d_out:end1d_out,num2d))
- call p2c(bounds, num2d, &
- field, &
- field_gcell(beg1d_out:end1d_out, :), &
- p2c_scale_type)
- map2gcell = .true.
- end if
end if
- if ( map2gcell .and. .not. is_mapping_upto_subgrid(type1d, type1d_out) )then
- call endrun(msg=trim(subname)//' ERROR: mapping upto subgrid level is inconsistent'//errMsg(sourcefile, __LINE__))
- end if
- if ( .not. map2gcell .and. is_mapping_upto_subgrid(type1d, type1d_out) )then
- call endrun(msg=trim(subname)//' ERROR: mapping upto subgrid level is inconsistent'//errMsg(sourcefile, __LINE__))
- end if
-
- if (map2gcell) then ! Map to gridcell
-
- ! note that in this case beg1d = begg and end1d=endg
- select case (avgflag)
- case ('I') ! Instantaneous
- do j = 1,num2d
- do k = beg1d_out, end1d_out
- if (field_gcell(k,j) /= spval) then
- hbuf(k,j) = field_gcell(k,j)
- else
- hbuf(k,j) = spval
- end if
- nacs(k,j) = 1
- end do
- end do
- case ('A', 'SUM') ! Time average / sum
- do j = 1,num2d
- do k = beg1d_out, end1d_out
- if (field_gcell(k,j) /= spval) then
- if (nacs(k,j) == 0) hbuf(k,j) = 0._r8
- hbuf(k,j) = hbuf(k,j) + field_gcell(k,j)
- nacs(k,j) = nacs(k,j) + 1
- else
- if (nacs(k,j) == 0) hbuf(k,j) = spval
- endif
- end do
- end do
- case ('X') ! Maximum over time
- do j = 1,num2d
- do k = beg1d_out, end1d_out
- if (field_gcell(k,j) /= spval) then
- if (nacs(k,j) == 0) hbuf(k,j) = -1.e50_r8
- hbuf(k,j) = max( hbuf(k,j), field_gcell(k,j) )
- else
- hbuf(k,j) = spval
- endif
- nacs(k,j) = 1
- end do
- end do
- case ('M') ! Minimum over time
- do j = 1,num2d
- do k = beg1d_out, end1d_out
- if (field_gcell(k,j) /= spval) then
- if (nacs(k,j) == 0) hbuf(k,j) = +1.e50_r8
- hbuf(k,j) = min( hbuf(k,j), field_gcell(k,j) )
- else
- hbuf(k,j) = spval
- endif
- nacs(k,j) = 1
- end do
- end do
- case default
- write(iulog,*) trim(subname),' ERROR: invalid time averaging flag ', avgflag
- call endrun(msg=errMsg(sourcefile, __LINE__))
- end select
- deallocate( field_gcell )
-
- else ! Do not map to gridcell
-
- ! For data defined on the pft, col or landunit, we need to check if a point is active
- ! to determine whether that point should be assigned spval
- if (type1d == namep) then
- check_active = .true.
- active => patch%active
- else if (type1d == namec) then
- check_active = .true.
- active => col%active
- else if (type1d == namel) then
- check_active = .true.
- active =>lun%active
- else
- check_active = .false.
- end if
! Note that since field points to an array section the
! bounds are field(1:end1d-beg1d+1, num2d) - therefore
@@ -1586,9 +1145,6 @@ subroutine hist_update_hbuf_field_2d (t, f, bounds, num2d)
do j = 1,num2d
do k = beg1d,end1d
valid = .true.
- if (check_active) then
- if (.not. active(k)) valid = .false.
- end if
if (valid) then
if (field(k-beg1d+1,j) /= spval) then
hbuf(k,j) = field(k-beg1d+1,j)
@@ -1605,9 +1161,6 @@ subroutine hist_update_hbuf_field_2d (t, f, bounds, num2d)
do j = 1,num2d
do k = beg1d,end1d
valid = .true.
- if (check_active) then
- if (.not. active(k)) valid = .false.
- end if
if (valid) then
if (field(k-beg1d+1,j) /= spval) then
if (nacs(k,j) == 0) hbuf(k,j) = 0._r8
@@ -1625,9 +1178,6 @@ subroutine hist_update_hbuf_field_2d (t, f, bounds, num2d)
do j = 1,num2d
do k = beg1d,end1d
valid = .true.
- if (check_active) then
- if (.not. active(k)) valid = .false.
- end if
if (valid) then
if (field(k-beg1d+1,j) /= spval) then
if (nacs(k,j) == 0) hbuf(k,j) = -1.e50_r8
@@ -1645,9 +1195,6 @@ subroutine hist_update_hbuf_field_2d (t, f, bounds, num2d)
do j = 1,num2d
do k = beg1d,end1d
valid = .true.
- if (check_active) then
- if (.not. active(k)) valid = .false.
- end if
if (valid) then
if (field(k-beg1d+1,j) /= spval) then
if (nacs(k,j) == 0) hbuf(k,j) = +1.e50_r8
@@ -1665,7 +1212,6 @@ subroutine hist_update_hbuf_field_2d (t, f, bounds, num2d)
write(iulog,*) trim(subname),' ERROR: invalid time averaging flag ', avgflag
call endrun(msg=errMsg(sourcefile, __LINE__))
end select
- end if
if (field_allocated) then
deallocate(field)
@@ -1673,99 +1219,6 @@ subroutine hist_update_hbuf_field_2d (t, f, bounds, num2d)
end subroutine hist_update_hbuf_field_2d
- !-----------------------------------------------------------------------
- subroutine hist_set_snow_field_2d (field_out, field_in, no_snow_behavior, type1d, beg1d, end1d)
- !
- ! !DESCRIPTION:
- ! Set values in history field dimensioned by levsno.
- !
- ! This routine handles what to do when a given snow layer doesn't exist for a given
- ! point, based on the no_snow_behavior argument. Options are:
- !
- ! - no_snow_normal: This is the normal behavior, which applies to most snow fields:
- ! Use spval (missing value flag). This means that temporal averages will just
- ! consider times when a particular snow layer actually existed
- !
- ! - no_snow_zero: Average in a 0 value for times when the snow layer isn't present
- !
- ! Input and output fields can be defined at the patch or column level
- !
- ! !ARGUMENTS:
- integer , intent(in) :: beg1d ! beginning spatial index
- integer , intent(in) :: end1d ! ending spatial index
- real(r8) , intent(out) :: field_out( beg1d: , 1: ) ! output field [point, lev]
- real(r8) , intent(in) :: field_in ( beg1d: , 1: ) ! input field [point, lev]
- integer , intent(in) :: no_snow_behavior ! behavior to use when a snow layer is absent
- character(len=*), intent(in) :: type1d ! 1d clm pointer type ("column" or "pft")
- !
- ! !LOCAL VARIABLES:
- integer :: num_levels ! total number of possible snow layers
- integer :: point
- integer :: level
- integer :: num_snow_layers ! number of snow layers that exist at a point
- integer :: num_nonexistent_layers
- integer :: c ! column index
- real(r8):: no_snow_val ! value to use when a snow layer is missing
- character(len=*), parameter :: subname = 'hist_set_snow_field_2d'
- !-----------------------------------------------------------------------
-
- SHR_ASSERT_ALL((ubound(field_out, 1) == end1d), errMsg(sourcefile, __LINE__))
- SHR_ASSERT_ALL((ubound(field_in , 1) == end1d), errMsg(sourcefile, __LINE__))
- SHR_ASSERT_ALL((ubound(field_out, 2) == ubound(field_in, 2)), errMsg(sourcefile, __LINE__))
-
- associate(&
- snl => col%snl & ! Input: [integer (:)] number of snow layers (negative)
- )
-
- num_levels = ubound(field_in, 2)
-
- ! Determine no_snow_val
- select case (no_snow_behavior)
- case (no_snow_normal)
- no_snow_val = spval
- case (no_snow_zero)
- no_snow_val = 0._r8
- case default
- write(iulog,*) trim(subname), ' ERROR: unrecognized no_snow_behavior: ', &
- no_snow_behavior
- call endrun()
- end select
-
- do point = beg1d, end1d
-
- ! Get number of snow layers at this point
-
- if (type1d == namec) then
- c = point
- else if (type1d == namep) then
- c = patch%column(point)
- else
- write(iulog,*) trim(subname), ' ERROR: Only implemented for patch and col-level fields'
- write(iulog,*) 'type1d = ', trim(type1d)
- call endrun()
- end if
-
- num_snow_layers = abs(snl(c))
- num_nonexistent_layers = num_levels - num_snow_layers
-
- ! Fill output field appropriately for each layer
- ! When only a subset of snow layers exist, it is the LAST num_snow_layers that exist
- ! Levels are rearranged such that the top snow layer (surface layer) becomes level 1, etc.
-
- do level = num_levels, (num_levels-num_nonexistent_layers+1), -1
- field_out(point, level) = no_snow_val
- end do
- do level = (num_levels-num_nonexistent_layers), 1, -1
- field_out(point, level) = field_in(point, level+num_nonexistent_layers)
- end do
-
- end do
-
- end associate
-
- end subroutine hist_set_snow_field_2d
-
-
!-----------------------------------------------------------------------
subroutine hfields_normalize (t)
!
@@ -1852,10 +1305,8 @@ subroutine htape_create (t, histrest)
! wrapper calls to define the history file contents.
!
! !USES:
- use clm_varpar , only : nlevgrnd, nlevsno, nlevlak, nlevurb, numrad, nlevcan, nvegwcs,nlevsoi
- use clm_varpar , only : natpft_size, cft_size, maxpatch_glcmec, nlevdecomp_full
- use landunit_varcon , only : max_lunit
- use clm_varctl , only : caseid, ctitle, fsurdat, finidat, paramfile
+ use clm_varpar , only : nlevgrnd, numrad
+ use clm_varctl , only : caseid, ctitle, mml_surdat, finidat
use clm_varctl , only : version, hostname, username, conventions, source
use domainMod , only : ldomain
use fileutils , only : get_filename
@@ -1876,9 +1327,6 @@ subroutine htape_create (t, histrest)
integer :: omode ! returned mode from netCDF call
integer :: ncprec ! output netCDF write precision
integer :: ret ! netCDF error status
- integer :: nump ! total number of pfts across all processors
- integer :: numc ! total number of columns across all processors
- integer :: numl ! total number of landunits across all processors
integer :: numg ! total number of gridcells across all processors
integer :: numa ! total number of atm cells across all processors
logical :: avoid_pnetcdf ! whether we should avoid using pnetcdf
@@ -1900,7 +1348,7 @@ subroutine htape_create (t, histrest)
! Determine necessary indices
- call get_proc_global(ng=numg, nl=numl, nc=numc, np=nump)
+ call get_proc_global(ng=numg)
! define output write precsion for tape
@@ -1965,7 +1413,7 @@ subroutine htape_create (t, histrest)
call ncd_putatt(lnfid, ncd_global, 'revision_id', trim(str))
call ncd_putatt(lnfid, ncd_global, 'case_title', trim(ctitle))
call ncd_putatt(lnfid, ncd_global, 'case_id', trim(caseid))
- str = get_filename(fsurdat)
+ str = get_filename(mml_surdat)
call ncd_putatt(lnfid, ncd_global, 'Surface_dataset', trim(str))
if (finidat == ' ') then
str = 'arbitrary initialization'
@@ -1973,8 +1421,6 @@ subroutine htape_create (t, histrest)
str = get_filename(finidat)
endif
call ncd_putatt(lnfid, ncd_global, 'Initial_conditions_dataset', trim(str))
- str = get_filename(paramfile)
- call ncd_putatt(lnfid, ncd_global, 'PFT_physiological_constants_dataset', trim(str))
! Define dimensions.
! Time is an unlimited dimension. Character string is treated as an array of characters.
@@ -1989,40 +1435,16 @@ subroutine htape_create (t, histrest)
! Global compressed dimensions (not including non-land points)
call ncd_defdim(lnfid, trim(nameg), numg, dimid)
- call ncd_defdim(lnfid, trim(namel), numl, dimid)
- call ncd_defdim(lnfid, trim(namec), numc, dimid)
- call ncd_defdim(lnfid, trim(namep), nump, dimid)
! "level" dimensions
call ncd_defdim(lnfid, 'levgrnd', nlevgrnd, dimid)
- call ncd_defdim(lnfid, 'levsoi', nlevsoi, dimid)
- if (nlevurb > 0) then
- call ncd_defdim(lnfid, 'levurb' , nlevurb, dimid)
- end if
- call ncd_defdim(lnfid, 'levlak' , nlevlak, dimid)
call ncd_defdim(lnfid, 'numrad' , numrad , dimid)
- call ncd_defdim(lnfid, 'levsno' , nlevsno , dimid)
- call ncd_defdim(lnfid, 'ltype', max_lunit, dimid)
- call ncd_defdim(lnfid, 'nlevcan',nlevcan, dimid)
- call ncd_defdim(lnfid, 'nvegwcs',nvegwcs, dimid)
- call htape_add_ltype_metadata(lnfid)
- call htape_add_ctype_metadata(lnfid)
- call ncd_defdim(lnfid, 'natpft', natpft_size, dimid)
- if (cft_size > 0) then
- call ncd_defdim(lnfid, 'cft', cft_size, dimid)
- call htape_add_cft_metadata(lnfid)
- end if
- call ncd_defdim(lnfid, 'glc_nec' , maxpatch_glcmec , dimid)
- ! elevclas (in contrast to glc_nec) includes elevation class 0 (bare land)
- ! (although on the history file it will go 1:(nec+1) rather than 0:nec)
- call ncd_defdim(lnfid, 'elevclas' , maxpatch_glcmec + 1, dimid)
do n = 1,num_subs
call ncd_defdim(lnfid, subs_name(n), subs_dim(n), dimid)
end do
call ncd_defdim(lnfid, 'string_length', hist_dim_name_length, strlen_dimid)
call ncd_defdim(lnfid, 'scale_type_string_length', scale_type_strlen, dimid)
- call ncd_defdim( lnfid, 'levdcmp', nlevdecomp_full, dimid)
! MML: adding a mml soiz dimension:
call ncd_defdim(lnfid, 'mml_lev', 10, dimid); ! hard-coded for 10 soil layers; make more clever.
call ncd_defdim(lnfid, 'mml_dust', 4, dimid); ! hard-coded for 4 dust bins
@@ -2047,117 +1469,7 @@ subroutine htape_create (t, histrest)
end subroutine htape_create
!-----------------------------------------------------------------------
- subroutine htape_add_ltype_metadata(lnfid)
- !
- ! !DESCRIPTION:
- ! Add global metadata defining landunit types
- !
- ! !USES:
- use landunit_varcon, only : max_lunit, landunit_names, landunit_name_length
- !
- ! !ARGUMENTS:
- type(file_desc_t), intent(inout) :: lnfid ! local file id
- !
- ! !LOCAL VARIABLES:
- integer :: ltype ! landunit type
- character(len=*), parameter :: att_prefix = 'ltype_' ! prefix for attributes
- character(len=len(att_prefix)+landunit_name_length) :: attname ! attribute name
-
- character(len=*), parameter :: subname = 'htape_add_ltype_metadata'
- !-----------------------------------------------------------------------
-
- do ltype = 1, max_lunit
- attname = att_prefix // landunit_names(ltype)
- call ncd_putatt(lnfid, ncd_global, attname, ltype)
- end do
-
- end subroutine htape_add_ltype_metadata
-
- !-----------------------------------------------------------------------
- subroutine htape_add_ctype_metadata(lnfid)
- !
- ! !DESCRIPTION:
- ! Add global metadata defining column types
- !
- ! !USES:
- use column_varcon, only : write_coltype_metadata
- !
- ! !ARGUMENTS:
- type(file_desc_t), intent(inout) :: lnfid ! local file id
- !
- ! !LOCAL VARIABLES:
- character(len=*), parameter :: att_prefix = 'ctype_' ! prefix for attributes
-
- character(len=*), parameter :: subname = 'htape_add_ctype_metadata'
- !-----------------------------------------------------------------------
-
- call write_coltype_metadata(att_prefix, lnfid)
-
- end subroutine htape_add_ctype_metadata
-
- !-----------------------------------------------------------------------
- subroutine htape_add_natpft_metadata(lnfid)
- !
- ! !DESCRIPTION:
- ! Add global metadata defining natpft types
- !
- ! !USES:
- use clm_varpar, only : natpft_lb, natpft_ub
- use pftconMod , only : pftname_len, pftname
- !
- ! !ARGUMENTS:
- type(file_desc_t), intent(inout) :: lnfid ! local file id
- !
- ! !LOCAL VARIABLES:
- integer :: ptype ! patch type
- integer :: ptype_1_indexing ! patch type, translated to 1 indexing
- character(len=*), parameter :: att_prefix = 'natpft_' ! prefix for attributes
- character(len=len(att_prefix)+pftname_len) :: attname ! attribute name
-
- character(len=*), parameter :: subname = 'htape_add_natpft_metadata'
- !-----------------------------------------------------------------------
-
- do ptype = natpft_lb, natpft_ub
- ptype_1_indexing = ptype + (1 - natpft_lb)
- attname = att_prefix // pftname(ptype)
- call ncd_putatt(lnfid, ncd_global, attname, ptype_1_indexing)
- end do
-
- end subroutine htape_add_natpft_metadata
-
- !-----------------------------------------------------------------------
- subroutine htape_add_cft_metadata(lnfid)
- !
- ! !DESCRIPTION:
- ! Add global metadata defining natpft types
- !
- ! !USES:
- use clm_varpar, only : cft_lb, cft_ub
- use pftconMod , only : pftname_len, pftname
- !
- ! !ARGUMENTS:
- type(file_desc_t), intent(inout) :: lnfid ! local file id
- !
- ! !LOCAL VARIABLES:
- integer :: ptype ! patch type
- integer :: ptype_1_indexing ! patch type, translated to 1 indexing
- character(len=*), parameter :: att_prefix = 'cft_' ! prefix for attributes
- character(len=len(att_prefix)+pftname_len) :: attname ! attribute name
-
- character(len=*), parameter :: subname = 'htape_add_cft_metadata'
- !-----------------------------------------------------------------------
-
- do ptype = cft_lb, cft_ub
- ptype_1_indexing = ptype + (1 - cft_lb)
- attname = att_prefix // pftname(ptype)
- call ncd_putatt(lnfid, ncd_global, attname, ptype_1_indexing)
- end do
-
- end subroutine htape_add_cft_metadata
-
- !-----------------------------------------------------------------------
- subroutine htape_timeconst3D(t, &
- bounds, watsat_col, sucsat_col, bsw_col, hksat_col, mode)
+ subroutine htape_timeconst3D(t, bounds, mode)
!
! !DESCRIPTION:
! Write time constant 3D variables to history tapes.
@@ -2167,18 +1479,13 @@ subroutine htape_timeconst3D(t, &
! contents.
!
! !USES:
- use subgridAveMod , only : c2g
- use clm_varpar , only : nlevgrnd ,nlevlak
+ use clm_varpar , only : nlevgrnd
use shr_string_mod , only : shr_string_listAppend
use domainMod , only : ldomain
!
! !ARGUMENTS:
integer , intent(in) :: t ! tape index
type(bounds_type) , intent(in) :: bounds
- real(r8) , intent(in) :: watsat_col( bounds%begc:,1: )
- real(r8) , intent(in) :: sucsat_col( bounds%begc:,1: )
- real(r8) , intent(in) :: bsw_col( bounds%begc:,1: )
- real(r8) , intent(in) :: hksat_col( bounds%begc:,1: )
character(len=*) , intent(in) :: mode ! 'define' or 'write'
!
! !LOCAL VARIABLES:
@@ -2187,34 +1494,11 @@ subroutine htape_timeconst3D(t, &
character(len=max_chars) :: long_name ! variable long name
character(len=max_namlen):: varname ! variable name
character(len=max_namlen):: units ! variable units
- character(len=scale_type_strlen) :: l2g_scale_type ! scale type for subgrid averaging of landunits to grid cells
!
- real(r8), pointer :: histi(:,:) ! temporary
real(r8), pointer :: histo(:,:) ! temporary
- integer, parameter :: nflds = 6 ! Number of 3D time-constant fields
+ integer, parameter :: nflds = 1 ! Number of 3D time-constant fields
character(len=*),parameter :: subname = 'htape_timeconst3D'
- character(len=*),parameter :: varnames(nflds) = (/ &
- 'ZSOI ', &
- 'DZSOI ', &
- 'WATSAT', &
- 'SUCSAT', &
- 'BSW ', &
- 'HKSAT ' &
- /)
- real(r8), pointer :: histil(:,:) ! temporary
- real(r8), pointer :: histol(:,:)
- integer, parameter :: nfldsl = 2
- character(len=*),parameter :: varnamesl(nfldsl) = (/ &
- 'ZLAKE ', &
- 'DZLAKE' &
- /)
- !-----------------------------------------------------------------------
-
- SHR_ASSERT_ALL((ubound(watsat_col) == (/bounds%endc, nlevgrnd/)), errMsg(sourcefile, __LINE__))
- SHR_ASSERT_ALL((ubound(sucsat_col) == (/bounds%endc, nlevgrnd/)), errMsg(sourcefile, __LINE__))
- SHR_ASSERT_ALL((ubound(bsw_col) == (/bounds%endc, nlevgrnd/)), errMsg(sourcefile, __LINE__))
- SHR_ASSERT_ALL((ubound(hksat_col) == (/bounds%endc, nlevgrnd/)), errMsg(sourcefile, __LINE__))
-
+ character(len=*),parameter :: varnames(nflds) = (/ 'ZSOI ' /)
!-------------------------------------------------------------------------------
!*** Non-time varying 3D fields ***
!*** Only write out when this subroutine is called ***
@@ -2227,16 +1511,6 @@ subroutine htape_timeconst3D(t, &
! Field indices MUST match varnames array order above!
if (ifld == 1) then
long_name='soil depth'; units = 'm'
- else if (ifld == 2) then
- long_name='soil thickness'; units = 'm'
- else if (ifld == 3) then
- long_name='saturated soil water content (porosity)'; units = 'mm3/mm3'
- else if (ifld == 4) then
- long_name='saturated soil matric potential'; units = 'mm'
- else if (ifld == 5) then
- long_name='slope of soil water retention curve'; units = 'unitless'
- else if (ifld == 6) then
- long_name='saturated hydraulic conductivity'; units = 'mm s-1'
else
call endrun(msg=' ERROR: bad 3D time-constant field index'//errMsg(sourcefile, __LINE__))
end if
@@ -2250,22 +1524,12 @@ subroutine htape_timeconst3D(t, &
dim1name=grlnd, dim2name='levgrnd', &
long_name=long_name, units=units, missing_value=spval, fill_value=spval)
end if
- else
- call ncd_defvar(ncid=nfid(t), varname=trim(varnames(ifld)), xtype=tape(t)%ncprec, &
- dim1name=namec, dim2name='levgrnd', &
- long_name=long_name, units=units, missing_value=spval, fill_value=spval)
end if
call shr_string_listAppend(TimeConst3DVars,varnames(ifld))
end do
else if (mode == 'write') then
- allocate(histi(bounds%begc:bounds%endc,nlevgrnd), stat=ier)
- if (ier /= 0) then
- write(iulog,*) trim(subname),' ERROR: allocation error for histi'
- call endrun(msg=errMsg(sourcefile, __LINE__))
- end if
-
! Write time constant fields
if (tape(t)%dov2xy) then
@@ -2278,51 +1542,9 @@ subroutine htape_timeconst3D(t, &
do ifld = 1,nflds
- ! WJS (10-25-11): Note about l2g_scale_type in the following: ZSOI & DZSOI are
- ! currently constant in space, except for urban points, so their scale type
- ! doesn't matter at the moment as long as it excludes urban points. I am using
- ! 'nonurb' so that the values are output everywhere where the fields are
- ! constant (i.e., everywhere except urban points). For the other fields, I am
- ! using 'veg' to be consistent with the l2g_scale_type that is now used for many
- ! of the 3-d time-variant fields; in theory, though, one might want versions of
- ! these variables output for different landunits.
-
- ! Field indices MUST match varnames array order above!
- if (ifld == 1) then ! ZSOI
- l2g_scale_type = 'nonurb'
- else if (ifld == 2) then ! DZSOI
- l2g_scale_type = 'nonurb'
- else if (ifld == 3) then ! WATSAT
- l2g_scale_type = 'veg'
- else if (ifld == 4) then ! SUCSAT
- l2g_scale_type = 'veg'
- else if (ifld == 5) then ! BSW
- l2g_scale_type = 'veg'
- else if (ifld == 6) then ! HKSAT
- l2g_scale_type = 'veg'
- end if
-
- histi(:,:) = spval
- do lev = 1,nlevgrnd
- do c = bounds%begc,bounds%endc
- l = col%landunit(c)
- ! Field indices MUST match varnames array order above!
- if (ifld ==1) histi(c,lev) = col%z(c,lev)
- if (ifld ==2) histi(c,lev) = col%dz(c,lev)
- if (ifld ==3) histi(c,lev) = watsat_col(c,lev)
- if (ifld ==4) histi(c,lev) = sucsat_col(c,lev)
- if (ifld ==5) histi(c,lev) = bsw_col(c,lev)
- if (ifld ==6) histi(c,lev) = hksat_col(c,lev)
- end do
- end do
if (tape(t)%dov2xy) then
histo(:,:) = spval
- call c2g(bounds, nlevgrnd, &
- histi(bounds%begc:bounds%endc, :), &
- histo(bounds%begg:bounds%endg, :), &
- c2l_scale_type='unity', l2g_scale_type=l2g_scale_type)
-
if (ldomain%isgrid2d) then
call ncd_io(varname=trim(varnames(ifld)), dim1name=grlnd, &
data=histo, ncid=nfid(t), flag='write')
@@ -2330,96 +1552,10 @@ subroutine htape_timeconst3D(t, &
call ncd_io(varname=trim(varnames(ifld)), dim1name=grlnd, &
data=histo, ncid=nfid(t), flag='write')
end if
- else
- call ncd_io(varname=trim(varnames(ifld)), dim1name=namec, &
- data=histi, ncid=nfid(t), flag='write')
end if
end do
if (tape(t)%dov2xy) deallocate(histo)
- deallocate(histi)
-
- end if ! (define/write mode
-
- if (mode == 'define') then
- do ifld = 1,nfldsl
- ! Field indices MUST match varnamesl array order above!
- if (ifld == 1) then
- long_name='lake layer node depth'; units = 'm'
- else if (ifld == 2) then
- long_name='lake layer thickness'; units = 'm'
- else
- call endrun(msg=' ERROR: bad 3D time-constant field index'//errMsg(sourcefile, __LINE__))
- end if
- if (tape(t)%dov2xy) then
- if (ldomain%isgrid2d) then
- call ncd_defvar(ncid=nfid(t), varname=trim(varnamesl(ifld)), xtype=tape(t)%ncprec,&
- dim1name='lon', dim2name='lat', dim3name='levlak', &
- long_name=long_name, units=units, missing_value=spval, fill_value=spval)
- else
- call ncd_defvar(ncid=nfid(t), varname=trim(varnamesl(ifld)), xtype=tape(t)%ncprec, &
- dim1name=grlnd, dim2name='levlak', &
- long_name=long_name, units=units, missing_value=spval, fill_value=spval)
- end if
- else
- call ncd_defvar(ncid=nfid(t), varname=trim(varnamesl(ifld)), xtype=tape(t)%ncprec, &
- dim1name=namec, dim2name='levlak', &
- long_name=long_name, units=units, missing_value=spval, fill_value=spval)
- end if
- call shr_string_listAppend(TimeConst3DVars,varnamesl(ifld))
- end do
-
- else if (mode == 'write') then
-
- allocate(histil(bounds%begc:bounds%endc,nlevlak), stat=ier)
- if (ier /= 0) then
- write(iulog,*) trim(subname),' ERROR: allocation error for histil'
- call endrun(msg=errMsg(sourcefile, __LINE__))
- end if
-
- ! Write time constant fields
-
- if (tape(t)%dov2xy) then
- allocate(histol(bounds%begg:bounds%endg,nlevlak), stat=ier)
- if (ier /= 0) then
- write(iulog,*) trim(subname),' ERROR: allocation error for histol'
- call endrun(msg=errMsg(sourcefile, __LINE__))
- end if
- end if
-
- do ifld = 1,nfldsl
- histil(:,:) = spval
- do lev = 1,nlevlak
- do c = bounds%begc,bounds%endc
- l = col%landunit(c)
- if (lun%lakpoi(l)) then
- ! Field indices MUST match varnamesl array order above!
- if (ifld ==1) histil(c,lev) = col%z_lake(c,lev)
- if (ifld ==2) histil(c,lev) = col%dz_lake(c,lev)
- end if
- end do
- end do
- if (tape(t)%dov2xy) then
- histol(:,:) = spval
- call c2g(bounds, nlevlak, &
- histil(bounds%begc:bounds%endc, :), &
- histol(bounds%begg:bounds%endg, :), &
- c2l_scale_type='unity', l2g_scale_type='lake')
- if (ldomain%isgrid2d) then
- call ncd_io(varname=trim(varnamesl(ifld)), dim1name=grlnd, &
- data=histol, ncid=nfid(t), flag='write')
- else
- call ncd_io(varname=trim(varnamesl(ifld)), dim1name=grlnd, &
- data=histol, ncid=nfid(t), flag='write')
- end if
- else
- call ncd_io(varname=trim(varnamesl(ifld)), dim1name=namec, &
- data=histil, ncid=nfid(t), flag='write')
- end if
- end do
-
- if (tape(t)%dov2xy) deallocate(histol)
- deallocate(histil)
end if ! (define/write mode
@@ -2435,7 +1571,7 @@ subroutine htape_timeconst(t, mode)
! contents.
!
! !USES:
- use clm_varcon , only : zsoi, zlak, secspday, isecspday, isecsphr, isecspmin
+ use clm_varcon , only : secspday, isecspday, isecsphr, isecspmin
use domainMod , only : ldomain, lon1d, lat1d
use clm_time_manager, only : get_nstep, get_curr_date, get_curr_time
use clm_time_manager, only : get_ref_date, get_calendar, NO_LEAP_C, GREGORIAN_C
@@ -2472,7 +1608,6 @@ subroutine htape_timeconst(t, mode)
character(len=256):: str ! global attribute string
real(r8), pointer :: histo(:,:) ! temporary
integer :: status
- real(r8) :: zsoi_1d(1)
character(len=*),parameter :: subname = 'htape_timeconst'
! MML soil z:
@@ -2511,15 +1646,6 @@ subroutine htape_timeconst(t, mode)
if (tape(t)%ntimes == 1) then
if (mode == 'define') then
- call ncd_defvar(varname='levgrnd', xtype=tape(t)%ncprec, &
- dim1name='levgrnd', &
- long_name='coordinate soil levels', units='m', ncid=nfid(t))
- call ncd_defvar(varname='levlak', xtype=tape(t)%ncprec, &
- dim1name='levlak', &
- long_name='coordinate lake levels', units='m', ncid=nfid(t))
- call ncd_defvar(varname='levdcmp', xtype=tape(t)%ncprec, dim1name='levdcmp', &
- long_name='coordinate soil levels', units='m', ncid=nfid(t))
-
! Add MML soil layers
call ncd_defvar(varname='mml_lev', xtype=tape(t)%ncprec, dim1name='mml_lev', &
long_name='mml soil levels', units='m', ncid=nfid(t))
@@ -2528,15 +1654,6 @@ subroutine htape_timeconst(t, mode)
long_name='mml dust bins', units='unknown', ncid=nfid(t))
elseif (mode == 'write') then
- if ( masterproc ) write(iulog, *) ' zsoi:',zsoi
- call ncd_io(varname='levgrnd', data=zsoi, ncid=nfid(t), flag='write')
- call ncd_io(varname='levlak' , data=zlak, ncid=nfid(t), flag='write')
- if (use_vertsoilc) then
- call ncd_io(varname='levdcmp', data=zsoi, ncid=nfid(t), flag='write')
- else
- zsoi_1d(1) = 1._r8
- call ncd_io(varname='levdcmp', data=zsoi_1d, ncid=nfid(t), flag='write')
- end if
! Add MML soil layers
call ncd_io(varname='mml_lev', data=mml_zsoi, ncid=nfid(t), flag='write')
@@ -2713,28 +1830,6 @@ subroutine htape_timeconst(t, mode)
long_name='land/ocean mask (0.=ocean and 1.=land)', ncid=nfid(t), &
imissing_value=ispval, ifill_value=ispval)
end if
- if (ldomain%isgrid2d) then
- call ncd_defvar(varname='pftmask' , xtype=ncd_int, &
- dim1name='lon', dim2name='lat', &
- long_name='pft real/fake mask (0.=fake and 1.=real)', ncid=nfid(t), &
- imissing_value=ispval, ifill_value=ispval)
- else
- call ncd_defvar(varname='pftmask' , xtype=ncd_int, &
- dim1name=grlnd, &
- long_name='pft real/fake mask (0.=fake and 1.=real)', ncid=nfid(t), &
- imissing_value=ispval, ifill_value=ispval)
- end if
- if (ldomain%isgrid2d) then
- call ncd_defvar(varname='nbedrock' , xtype=ncd_int, &
- dim1name='lon', dim2name='lat', &
- long_name='index of shallowest bedrock layer', ncid=nfid(t), &
- imissing_value=ispval, ifill_value=ispval)
- else
- call ncd_defvar(varname='nbedrock' , xtype=ncd_int, &
- dim1name=grlnd, &
- long_name='index of shallowest bedrock layer', ncid=nfid(t), &
- imissing_value=ispval, ifill_value=ispval)
- end if
else if (mode == 'write') then
@@ -2751,8 +1846,6 @@ subroutine htape_timeconst(t, mode)
call ncd_io(varname='area' , data=ldomain%area, dim1name=grlnd, ncid=nfid(t), flag='write')
call ncd_io(varname='landfrac', data=ldomain%frac, dim1name=grlnd, ncid=nfid(t), flag='write')
call ncd_io(varname='landmask', data=ldomain%mask, dim1name=grlnd, ncid=nfid(t), flag='write')
- call ncd_io(varname='pftmask' , data=ldomain%pftm, dim1name=grlnd, ncid=nfid(t), flag='write')
- call ncd_io(varname='nbedrock' , data=grc%nbedrock, dim1name=grlnd, ncid=nfid(t), flag='write')
end if ! (define/write mode
@@ -2977,129 +2070,12 @@ subroutine hfields_1dinfo(t, mode)
call ncd_defvar(varname='grid1d_jxy', xtype=ncd_int, dim1name=nameg, &
long_name='2d latitude index of corresponding gridcell', ncid=ncid)
- ! Define landunit info
-
- call ncd_defvar(varname='land1d_lon', xtype=ncd_double, dim1name=namel, &
- long_name='landunit longitude', units='degrees_east', ncid=ncid)
-
- call ncd_defvar(varname='land1d_lat', xtype=ncd_double, dim1name=namel, &
- long_name='landunit latitude', units='degrees_north', ncid=ncid)
-
- call ncd_defvar(varname='land1d_ixy', xtype=ncd_int, dim1name=namel, &
- long_name='2d longitude index of corresponding landunit', ncid=ncid)
-
- call ncd_defvar(varname='land1d_jxy', xtype=ncd_int, dim1name=namel, &
- long_name='2d latitude index of corresponding landunit', ncid=ncid)
-
- ! --- EBK Do NOT write out indices that are incorrect 4/1/2011 --- Bug 1310
- !call ncd_defvar(varname='land1d_gi', xtype=ncd_int, dim1name='landunit', &
- ! long_name='1d grid index of corresponding landunit', ncid=ncid)
- ! ----------------------------------------------------------------
-
- call ncd_defvar(varname='land1d_wtgcell', xtype=ncd_double, dim1name=namel, &
- long_name='landunit weight relative to corresponding gridcell', ncid=ncid)
-
- call ncd_defvar(varname='land1d_ityplunit', xtype=ncd_int, dim1name=namel, &
- long_name='landunit type (vegetated,urban,lake,wetland,glacier or glacier_mec)', &
- ncid=ncid)
-
- call ncd_defvar(varname='land1d_active', xtype=ncd_log, dim1name=namel, &
- long_name='true => do computations on this landunit', ncid=ncid)
-
- ! Define column info
-
- call ncd_defvar(varname='cols1d_lon', xtype=ncd_double, dim1name=namec, &
- long_name='column longitude', units='degrees_east', ncid=ncid)
-
- call ncd_defvar(varname='cols1d_lat', xtype=ncd_double, dim1name=namec, &
- long_name='column latitude', units='degrees_north', ncid=ncid)
-
- call ncd_defvar(varname='cols1d_ixy', xtype=ncd_int, dim1name=namec, &
- long_name='2d longitude index of corresponding column', ncid=ncid)
-
- call ncd_defvar(varname='cols1d_jxy', xtype=ncd_int, dim1name=namec, &
- long_name='2d latitude index of corresponding column', ncid=ncid)
-
- ! --- EBK Do NOT write out indices that are incorrect 4/1/2011 --- Bug 1310
- !call ncd_defvar(varname='cols1d_gi', xtype=ncd_int, dim1name='column', &
- ! long_name='1d grid index of corresponding column', ncid=ncid)
-
- !call ncd_defvar(varname='cols1d_li', xtype=ncd_int, dim1name='column', &
- ! long_name='1d landunit index of corresponding column', ncid=ncid)
- ! ----------------------------------------------------------------
-
- call ncd_defvar(varname='cols1d_wtgcell', xtype=ncd_double, dim1name=namec, &
- long_name='column weight relative to corresponding gridcell', ncid=ncid)
-
- call ncd_defvar(varname='cols1d_wtlunit', xtype=ncd_double, dim1name=namec, &
- long_name='column weight relative to corresponding landunit', ncid=ncid)
-
- call ncd_defvar(varname='cols1d_itype_col', xtype=ncd_int, dim1name=namec, &
- long_name='column type (see global attributes)', ncid=ncid)
-
- call ncd_defvar(varname='cols1d_itype_lunit', xtype=ncd_int, dim1name=namec, &
- long_name='column landunit type (vegetated,urban,lake,wetland,glacier or glacier_mec)', &
- ncid=ncid)
-
- call ncd_defvar(varname='cols1d_active', xtype=ncd_log, dim1name=namec, &
- long_name='true => do computations on this column', ncid=ncid)
-
- ! Define patch info
-
- call ncd_defvar(varname='pfts1d_lon', xtype=ncd_double, dim1name=namep, &
- long_name='pft longitude', units='degrees_east', ncid=ncid)
-
- call ncd_defvar(varname='pfts1d_lat', xtype=ncd_double, dim1name=namep, &
- long_name='pft latitude', units='degrees_north', ncid=ncid)
-
- call ncd_defvar(varname='pfts1d_ixy', xtype=ncd_int, dim1name=namep, &
- long_name='2d longitude index of corresponding pft', ncid=ncid)
-
- call ncd_defvar(varname='pfts1d_jxy', xtype=ncd_int, dim1name=namep, &
- long_name='2d latitude index of corresponding pft', ncid=ncid)
-
- ! --- EBK Do NOT write out indices that are incorrect 4/1/2011 --- Bug 1310
- !call ncd_defvar(varname='pfts1d_gi', xtype=ncd_int, dim1name='pft', &
- ! long_name='1d grid index of corresponding pft', ncid=ncid)
-
- !call ncd_defvar(varname='pfts1d_li', xtype=ncd_int, dim1name='pft', &
- ! long_name='1d landunit index of corresponding pft', ncid=ncid)
-
- !call ncd_defvar(varname='pfts1d_ci', xtype=ncd_int, dim1name='pft', &
- ! long_name='1d column index of corresponding pft', ncid=ncid)
- ! ----------------------------------------------------------------
-
- call ncd_defvar(varname='pfts1d_wtgcell', xtype=ncd_double, dim1name=namep, &
- long_name='pft weight relative to corresponding gridcell', ncid=ncid)
-
- call ncd_defvar(varname='pfts1d_wtlunit', xtype=ncd_double, dim1name=namep, &
- long_name='pft weight relative to corresponding landunit', ncid=ncid)
-
- call ncd_defvar(varname='pfts1d_wtcol', xtype=ncd_double, dim1name=namep, &
- long_name='pft weight relative to corresponding column', ncid=ncid)
-
- call ncd_defvar(varname='pfts1d_itype_veg', xtype=ncd_int, dim1name=namep, &
- long_name='pft vegetation type', ncid=ncid)
-
- call ncd_defvar(varname='pfts1d_itype_col', xtype=ncd_int, dim1name=namep, &
- long_name='pft column type (see global attributes)', ncid=ncid)
-
- call ncd_defvar(varname='pfts1d_itype_lunit', xtype=ncd_int, dim1name=namep, &
- long_name='pft landunit type (vegetated,urban,lake,wetland,glacier or glacier_mec)', &
- ncid=ncid)
-
- call ncd_defvar(varname='pfts1d_active', xtype=ncd_log, dim1name=namep, &
- long_name='true => do computations on this pft', ncid=ncid)
-
else if (mode == 'write') then
! Determine bounds
allocate(&
rgarr(bounds%begg:bounds%endg),&
- rlarr(bounds%begl:bounds%endl),&
- rcarr(bounds%begc:bounds%endc),&
- rparr(bounds%begp:bounds%endp),&
stat=ier)
if (ier /= 0) then
call endrun(msg=' hfields_1dinfo allocation error of rarrs'//errMsg(sourcefile, __LINE__))
@@ -3107,9 +2083,7 @@ subroutine hfields_1dinfo(t, mode)
allocate(&
igarr(bounds%begg:bounds%endg),&
- ilarr(bounds%begl:bounds%endl),&
- icarr(bounds%begc:bounds%endc),&
- iparr(bounds%begp:bounds%endp),stat=ier)
+ stat=ier)
if (ier /= 0) then
call endrun(msg=' hfields_1dinfo allocation error of iarrs'//errMsg(sourcefile, __LINE__))
end if
@@ -3127,114 +2101,15 @@ subroutine hfields_1dinfo(t, mode)
enddo
call ncd_io(varname='grid1d_jxy', data=igarr , dim1name=nameg, ncid=ncid, flag='write')
- ! Write landunit info
-
- do l = bounds%begl,bounds%endl
- rlarr(l) = grc%londeg(lun%gridcell(l))
- enddo
- call ncd_io(varname='land1d_lon', data=rlarr, dim1name=namel, ncid=ncid, flag='write')
- do l = bounds%begl,bounds%endl
- rlarr(l) = grc%latdeg(lun%gridcell(l))
- enddo
- call ncd_io(varname='land1d_lat', data=rlarr, dim1name=namel, ncid=ncid, flag='write')
- do l= bounds%begl,bounds%endl
- ilarr(l) = mod(ldecomp%gdc2glo(lun%gridcell(l))-1,ldomain%ni) + 1
- enddo
- call ncd_io(varname='land1d_ixy', data=ilarr, dim1name=namel, ncid=ncid, flag='write')
- do l = bounds%begl,bounds%endl
- ilarr(l) = (ldecomp%gdc2glo(lun%gridcell(l))-1)/ldomain%ni + 1
- enddo
- call ncd_io(varname='land1d_jxy' , data=ilarr , dim1name=namel, ncid=ncid, flag='write')
- ! --- EBK Do NOT write out indices that are incorrect 4/1/2011 Bug 1310
- !call ncd_io(varname='land1d_gi' , data=lun%gridcell, dim1name=namel, ncid=ncid, flag='write')
- ! ----------------------------------------------------------------
- call ncd_io(varname='land1d_wtgcell' , data=lun%wtgcell , dim1name=namel, ncid=ncid, flag='write')
- call ncd_io(varname='land1d_ityplunit', data=lun%itype , dim1name=namel, ncid=ncid, flag='write')
- call ncd_io(varname='land1d_active' , data=lun%active , dim1name=namel, ncid=ncid, flag='write')
-
- ! Write column info
-
- do c = bounds%begc,bounds%endc
- rcarr(c) = grc%londeg(col%gridcell(c))
- enddo
- call ncd_io(varname='cols1d_lon', data=rcarr, dim1name=namec, ncid=ncid, flag='write')
- do c = bounds%begc,bounds%endc
- rcarr(c) = grc%latdeg(col%gridcell(c))
- enddo
- call ncd_io(varname='cols1d_lat', data=rcarr, dim1name=namec, ncid=ncid, flag='write')
- do c = bounds%begc,bounds%endc
- icarr(c) = mod(ldecomp%gdc2glo(col%gridcell(c))-1,ldomain%ni) + 1
- enddo
- call ncd_io(varname='cols1d_ixy', data=icarr, dim1name=namec, ncid=ncid, flag='write')
- do c = bounds%begc,bounds%endc
- icarr(c) = (ldecomp%gdc2glo(col%gridcell(c))-1)/ldomain%ni + 1
- enddo
- call ncd_io(varname='cols1d_jxy' , data=icarr ,dim1name=namec, ncid=ncid, flag='write')
- ! --- EBK Do NOT write out indices that are incorrect 4/1/2011 Bug 1310
- !call ncd_io(varname='cols1d_gi' , data=col%gridcell, dim1name=namec, ncid=ncid, flag='write')
- !call ncd_io(varname='cols1d_li' , data=col%landunit, dim1name=namec, ncid=ncid, flag='write')
- ! ----------------------------------------------------------------
- call ncd_io(varname='cols1d_wtgcell', data=col%wtgcell , dim1name=namec, ncid=ncid, flag='write')
- call ncd_io(varname='cols1d_wtlunit', data=col%wtlunit , dim1name=namec, ncid=ncid, flag='write')
- call ncd_io(varname='cols1d_itype_col', data=col%itype , dim1name=namec, ncid=ncid, flag='write')
-
- do c = bounds%begc,bounds%endc
- icarr(c) = lun%itype(col%landunit(c))
- enddo
- call ncd_io(varname='cols1d_itype_lunit', data=icarr , dim1name=namec, ncid=ncid, flag='write')
-
- call ncd_io(varname='cols1d_active' , data=col%active , dim1name=namec, ncid=ncid, flag='write')
-
- ! Write patch info
-
- do p = bounds%begp,bounds%endp
- rparr(p) = grc%londeg(patch%gridcell(p))
- enddo
- call ncd_io(varname='pfts1d_lon', data=rparr, dim1name=namep, ncid=ncid, flag='write')
- do p = bounds%begp,bounds%endp
- rparr(p) = grc%latdeg(patch%gridcell(p))
- enddo
- call ncd_io(varname='pfts1d_lat', data=rparr, dim1name=namep, ncid=ncid, flag='write')
- do p = bounds%begp,bounds%endp
- iparr(p) = mod(ldecomp%gdc2glo(patch%gridcell(p))-1,ldomain%ni) + 1
- enddo
- call ncd_io(varname='pfts1d_ixy', data=iparr, dim1name=namep, ncid=ncid, flag='write')
- do p = bounds%begp,bounds%endp
- iparr(p) = (ldecomp%gdc2glo(patch%gridcell(p))-1)/ldomain%ni + 1
- enddo
- call ncd_io(varname='pfts1d_jxy' , data=iparr , dim1name=namep, ncid=ncid, flag='write')
- ! --- EBK Do NOT write out indices that are incorrect 4/1/2011 --- Bug 1310
- !call ncd_io(varname='pfts1d_gi' , data=patch%gridcell, dim1name=namep, ncid=ncid, flag='write')
- !call ncd_io(varname='pfts1d_li' , data=patch%landunit, dim1name=namep, ncid=ncid, flag='write')
- !call ncd_io(varname='pfts1d_ci' , data=patch%column , dim1name=namep, ncid=ncid, flag='write')
- ! ----------------------------------------------------------------
- call ncd_io(varname='pfts1d_wtgcell' , data=patch%wtgcell , dim1name=namep, ncid=ncid, flag='write')
- call ncd_io(varname='pfts1d_wtlunit' , data=patch%wtlunit , dim1name=namep, ncid=ncid, flag='write')
- call ncd_io(varname='pfts1d_wtcol' , data=patch%wtcol , dim1name=namep, ncid=ncid, flag='write')
- call ncd_io(varname='pfts1d_itype_veg', data=patch%itype , dim1name=namep, ncid=ncid, flag='write')
-
- do p = bounds%begp,bounds%endp
- iparr(p) = col%itype(patch%column(p))
- end do
- call ncd_io(varname='pfts1d_itype_col', data=iparr , dim1name=namep, ncid=ncid, flag='write')
-
- do p = bounds%begp,bounds%endp
- iparr(p) = lun%itype(patch%landunit(p))
- enddo
- call ncd_io(varname='pfts1d_itype_lunit', data=iparr , dim1name=namep, ncid=ncid, flag='write')
-
- call ncd_io(varname='pfts1d_active' , data=patch%active , dim1name=namep, ncid=ncid, flag='write')
-
- deallocate(rgarr,rlarr,rcarr,rparr)
- deallocate(igarr,ilarr,icarr,iparr)
+ deallocate(rgarr)
+ deallocate(igarr)
end if
end subroutine hfields_1dinfo
!-----------------------------------------------------------------------
- subroutine hist_htapes_wrapup( rstwr, nlend, bounds, &
- watsat_col, sucsat_col, bsw_col, hksat_col)
+ subroutine hist_htapes_wrapup( rstwr, nlend, bounds)
!
! !DESCRIPTION:
! Write history tape(s)
@@ -3266,10 +2141,6 @@ subroutine hist_htapes_wrapup( rstwr, nlend, bounds, &
logical, intent(in) :: rstwr ! true => write restart file this step
logical, intent(in) :: nlend ! true => end of run on this step
type(bounds_type) , intent(in) :: bounds
- real(r8) , intent(in) :: watsat_col( bounds%begc:,1: )
- real(r8) , intent(in) :: sucsat_col( bounds%begc:,1: )
- real(r8) , intent(in) :: bsw_col( bounds%begc:,1: )
- real(r8) , intent(in) :: hksat_col( bounds%begc:,1: )
!
! !LOCAL VARIABLES:
integer :: t ! tape index
@@ -3293,11 +2164,6 @@ subroutine hist_htapes_wrapup( rstwr, nlend, bounds, &
character(len=*),parameter :: subname = 'hist_htapes_wrapup'
!-----------------------------------------------------------------------
- SHR_ASSERT_ALL((ubound(watsat_col) == (/bounds%endc, nlevgrnd/)), errMsg(sourcefile, __LINE__))
- SHR_ASSERT_ALL((ubound(sucsat_col) == (/bounds%endc, nlevgrnd/)), errMsg(sourcefile, __LINE__))
- SHR_ASSERT_ALL((ubound(bsw_col) == (/bounds%endc, nlevgrnd/)), errMsg(sourcefile, __LINE__))
- SHR_ASSERT_ALL((ubound(hksat_col) == (/bounds%endc, nlevgrnd/)), errMsg(sourcefile, __LINE__))
-
! get current step
nstep = get_nstep()
@@ -3366,37 +2232,18 @@ subroutine hist_htapes_wrapup( rstwr, nlend, bounds, &
! Define time-constant field variables
call htape_timeconst(t, mode='define')
- !write(iulog,*)'MML define 3D'
- ! Define 3D time-constant field variables only to first primary tape
- if ( do_3Dtconst .and. t == 1 ) then
- call htape_timeconst3D(t, &
- bounds, watsat_col, sucsat_col, bsw_col, hksat_col, mode='define')
- TimeConst3DVars_Filename = trim(locfnh(t))
- end if
-
- !write(iulog,*)'MML define model field vars'
! Define model field variables
call hfields_write(t, mode='define')
- !write(iulog,*)'MML run away'
! Exit define model
call ncd_enddef(nfid(t))
call t_stopf('hist_htapes_wrapup_define')
endif
- !write(iulog,*)'MML before htape_teimconst'
call t_startf('hist_htapes_wrapup_tconst')
! Write time constant history variables
call htape_timeconst(t, mode='write')
- !write(iulog,*)'MML write 3D time const'
- ! Write 3D time constant history variables only to first primary tape
- if ( do_3Dtconst .and. t == 1 .and. tape(t)%ntimes == 1 )then
- call htape_timeconst3D(t, &
- bounds, watsat_col, sucsat_col, bsw_col, hksat_col, mode='write')
- do_3Dtconst = .false.
- end if
-
if (masterproc) then
write(iulog,*)
write(iulog,*) trim(subname),' : Writing current time sample to local history file ', &
@@ -3486,7 +2333,7 @@ subroutine hist_restart_ncd (bounds, ncid, flag, rdate)
use clm_varctl , only : nsrest, caseid, inst_suffix, nsrStartup, nsrBranch
use fileutils , only : getfil
use domainMod , only : ldomain
- use clm_varpar , only : nlevgrnd, nlevlak, numrad, nlevdecomp_full
+ use clm_varpar , only : nlevgrnd, numrad
use clm_time_manager, only : is_restart
use restUtilMod , only : iflag_skip
use pio
@@ -3504,9 +2351,6 @@ subroutine hist_restart_ncd (bounds, ncid, flag, rdate)
integer :: num2d ! 2d size (e.g. number of vertical levels)
integer :: numa ! total number of atm cells across all processors
integer :: numg ! total number of gridcells across all processors
- integer :: numl ! total number of landunits across all processors
- integer :: numc ! total number of columns across all processors
- integer :: nump ! total number of pfts across all processors
character(len=max_namlen) :: name ! variable name
character(len=max_namlen) :: name_acc ! accumulator variable name
character(len=max_namlen) :: long_name ! long name of variable
@@ -3519,9 +2363,6 @@ subroutine hist_restart_ncd (bounds, ncid, flag, rdate)
character(len=max_namlen),allocatable :: tname(:)
character(len=max_chars), allocatable :: tunits(:),tlongname(:)
character(len=hist_dim_name_length), allocatable :: tmpstr(:,:)
- character(len=scale_type_strlen), allocatable :: p2c_scale_type(:)
- character(len=scale_type_strlen), allocatable :: c2l_scale_type(:)
- character(len=scale_type_strlen), allocatable :: l2g_scale_type(:)
character(len=avgflag_strlen), allocatable :: tavgflag(:)
integer :: start(2)
@@ -3538,9 +2379,6 @@ subroutine hist_restart_ncd (bounds, ncid, flag, rdate)
type(var_desc_t) :: type1d_out_desc ! variable descriptor for type1d_out
type(var_desc_t) :: type2d_desc ! variable descriptor for type2d
type(var_desc_t) :: avgflag_desc ! variable descriptor for avgflag
- type(var_desc_t) :: p2c_scale_type_desc ! variable descriptor for p2c_scale_type
- type(var_desc_t) :: c2l_scale_type_desc ! variable descriptor for c2l_scale_type
- type(var_desc_t) :: l2g_scale_type_desc ! variable descriptor for l2g_scale_type
integer :: status ! error status
integer :: dimid ! dimension ID
integer :: k ! 1d index
@@ -3559,7 +2397,7 @@ subroutine hist_restart_ncd (bounds, ncid, flag, rdate)
character(len=*),parameter :: subname = 'hist_restart_ncd'
!------------------------------------------------------------------------
- call get_proc_global(ng=numg, nl=numl, nc=numc, np=nump)
+ call get_proc_global(ng=numg)
! If branch run, initialize file times and return
@@ -3623,7 +2461,7 @@ subroutine hist_restart_ncd (bounds, ncid, flag, rdate)
! Create the restart history filename and open it
write(hnum,'(i1.1)') t-1
- locfnhr(t) = "./" // trim(caseid) //".clm2"// trim(inst_suffix) &
+ locfnhr(t) = "./" // trim(caseid) //".slim"// trim(inst_suffix) &
// ".rh" // hnum //"."// trim(rdate) //".nc"
call htape_create( t, histrest=.true. )
@@ -3769,15 +2607,6 @@ subroutine hist_restart_ncd (bounds, ncid, flag, rdate)
call ncd_defvar(ncid=ncid_hist(t), varname='type2d', xtype=ncd_char, &
long_name="2nd dimension type", &
dim1name='string_length', dim2name='max_nflds' )
- call ncd_defvar(ncid=ncid_hist(t), varname='p2c_scale_type', xtype=ncd_char, &
- long_name="PFT to column scale type", &
- dim1name='scale_type_string_length', dim2name='max_nflds' )
- call ncd_defvar(ncid=ncid_hist(t), varname='c2l_scale_type', xtype=ncd_char, &
- long_name="column to landunit scale type", &
- dim1name='scale_type_string_length', dim2name='max_nflds' )
- call ncd_defvar(ncid=ncid_hist(t), varname='l2g_scale_type', xtype=ncd_char, &
- long_name="landunit to gridpoint scale type", &
- dim1name='scale_type_string_length', dim2name='max_nflds' )
call ncd_enddef(ncid_hist(t))
@@ -3850,9 +2679,7 @@ subroutine hist_restart_ncd (bounds, ncid, flag, rdate)
call ncd_io('ncprec', tape(t)%ncprec, 'write', ncid_hist(t) )
call ncd_io('begtime', tape(t)%begtime, 'write', ncid_hist(t) )
allocate(tmpstr(tape(t)%nflds,3 ),tname(tape(t)%nflds), &
- tavgflag(tape(t)%nflds),tunits(tape(t)%nflds),tlongname(tape(t)%nflds), &
- p2c_scale_type(tape(t)%nflds), c2l_scale_type(tape(t)%nflds), &
- l2g_scale_type(tape(t)%nflds))
+ tavgflag(tape(t)%nflds),tunits(tape(t)%nflds),tlongname(tape(t)%nflds))
do f=1,tape(t)%nflds
tname(f) = tape(t)%hlist(f)%field%name
tunits(f) = tape(t)%hlist(f)%field%units
@@ -3861,9 +2688,6 @@ subroutine hist_restart_ncd (bounds, ncid, flag, rdate)
tmpstr(f,2) = tape(t)%hlist(f)%field%type1d_out
tmpstr(f,3) = tape(t)%hlist(f)%field%type2d
tavgflag(f) = tape(t)%hlist(f)%avgflag
- p2c_scale_type(f) = tape(t)%hlist(f)%field%p2c_scale_type
- c2l_scale_type(f) = tape(t)%hlist(f)%field%c2l_scale_type
- l2g_scale_type(f) = tape(t)%hlist(f)%field%l2g_scale_type
end do
call ncd_io( 'name', tname, 'write',ncid_hist(t))
call ncd_io('long_name', tlongname, 'write', ncid_hist(t))
@@ -3872,11 +2696,7 @@ subroutine hist_restart_ncd (bounds, ncid, flag, rdate)
call ncd_io('type1d_out', tmpstr(:,2), 'write', ncid_hist(t))
call ncd_io('type2d', tmpstr(:,3), 'write', ncid_hist(t))
call ncd_io('avgflag',tavgflag , 'write', ncid_hist(t))
- call ncd_io('p2c_scale_type', p2c_scale_type, 'write', ncid_hist(t))
- call ncd_io('c2l_scale_type', c2l_scale_type, 'write', ncid_hist(t))
- call ncd_io('l2g_scale_type', l2g_scale_type, 'write', ncid_hist(t))
deallocate(tname,tlongname,tunits,tmpstr,tavgflag)
- deallocate(p2c_scale_type, c2l_scale_type, l2g_scale_type)
enddo
deallocate(itemp)
@@ -3927,9 +2747,6 @@ subroutine hist_restart_ncd (bounds, ncid, flag, rdate)
call ncd_inqvid(ncid_hist(t), 'type1d_out', varid, type1d_out_desc)
call ncd_inqvid(ncid_hist(t), 'type2d', varid, type2d_desc)
call ncd_inqvid(ncid_hist(t), 'avgflag', varid, avgflag_desc)
- call ncd_inqvid(ncid_hist(t), 'p2c_scale_type', varid, p2c_scale_type_desc)
- call ncd_inqvid(ncid_hist(t), 'c2l_scale_type', varid, c2l_scale_type_desc)
- call ncd_inqvid(ncid_hist(t), 'l2g_scale_type', varid, l2g_scale_type_desc)
call ncd_io(varname='fincl', data=fincl(:,t), ncid=ncid_hist(t), flag='read')
@@ -3976,21 +2793,12 @@ subroutine hist_restart_ncd (bounds, ncid, flag, rdate)
'read', ncid_hist(t), start )
call ncd_io( avgflag_desc, tape(t)%hlist(f)%avgflag, &
'read', ncid_hist(t), start )
- call ncd_io( p2c_scale_type_desc, tape(t)%hlist(f)%field%p2c_scale_type, &
- 'read', ncid_hist(t), start )
- call ncd_io( c2l_scale_type_desc, tape(t)%hlist(f)%field%c2l_scale_type, &
- 'read', ncid_hist(t), start )
- call ncd_io( l2g_scale_type_desc, tape(t)%hlist(f)%field%l2g_scale_type, &
- 'read', ncid_hist(t), start )
call strip_null(tape(t)%hlist(f)%field%name)
call strip_null(tape(t)%hlist(f)%field%long_name)
call strip_null(tape(t)%hlist(f)%field%units)
call strip_null(tape(t)%hlist(f)%field%type1d)
call strip_null(tape(t)%hlist(f)%field%type1d_out)
call strip_null(tape(t)%hlist(f)%field%type2d)
- call strip_null(tape(t)%hlist(f)%field%p2c_scale_type)
- call strip_null(tape(t)%hlist(f)%field%c2l_scale_type)
- call strip_null(tape(t)%hlist(f)%field%l2g_scale_type)
call strip_null(tape(t)%hlist(f)%avgflag)
type1d_out = trim(tape(t)%hlist(f)%field%type1d_out)
@@ -4003,18 +2811,6 @@ subroutine hist_restart_ncd (bounds, ncid, flag, rdate)
num1d_out = numg
beg1d_out = bounds%begg
end1d_out = bounds%endg
- case (namel)
- num1d_out = numl
- beg1d_out = bounds%begl
- end1d_out = bounds%endl
- case (namec)
- num1d_out = numc
- beg1d_out = bounds%begc
- end1d_out = bounds%endc
- case (namep)
- num1d_out = nump
- beg1d_out = bounds%begp
- end1d_out = bounds%endp
case default
write(iulog,*) trim(subname),' ERROR: read unknown 1d output type=',trim(type1d_out)
call endrun(msg=errMsg(sourcefile, __LINE__))
@@ -4045,18 +2841,6 @@ subroutine hist_restart_ncd (bounds, ncid, flag, rdate)
num1d = numg
beg1d = bounds%begg
end1d = bounds%endg
- case (namel)
- num1d = numl
- beg1d = bounds%begl
- end1d = bounds%endl
- case (namec)
- num1d = numc
- beg1d = bounds%begc
- end1d = bounds%endc
- case (namep)
- num1d = nump
- beg1d = bounds%begp
- end1d = bounds%endp
case default
write(iulog,*) trim(subname),' ERROR: read unknown 1d type=',type1d
call endrun(msg=errMsg(sourcefile, __LINE__))
@@ -4355,7 +3139,7 @@ character(len=max_length_filename) function set_hist_filename (hist_freq, hist_m
write(cdate,'(i4.4,"-",i2.2,"-",i2.2,"-",i5.5)') yr,mon,day,sec
endif
write(hist_index,'(i1.1)') hist_file - 1
- set_hist_filename = "./"//trim(caseid)//".clm2"//trim(inst_suffix)//&
+ set_hist_filename = "./"//trim(caseid)//".slim"//trim(inst_suffix)//&
".h"//hist_index//"."//trim(cdate)//".nc"
! check to see if the concatenated filename exceeded the
@@ -4375,12 +3159,81 @@ character(len=max_length_filename) function set_hist_filename (hist_freq, hist_m
end if
end function set_hist_filename
+ !-----------------------------------------------------------------------
+ subroutine hist_readNML ( NLFilename )
+ use shr_mpi_mod , only : shr_mpi_bcast
+ use spmdMod , only : mpicom
+ use clm_nlUtilsMod , only : find_nlgroup_name
+ use clm_varctl , only : use_noio
+ use shr_const_mod , only : SHR_CONST_CDAY
+ use clm_time_manager, only : get_step_size
+
+ implicit none
+
+ character(len=*), intent(IN) :: NLFilename ! Namelist file names
+ !-----------------------------------------------------------------------
+ ! !LOCAL VARIABLES:
+ integer :: i ! Indices
+ integer :: nu_nml ! Unit for namelist file
+ integer :: nml_error ! Error code
+ integer :: dtime ! time step
+ character(len=*), parameter :: nml_name = 'slim_history'
+ character(len=*), parameter :: subname = 'hist_readNML'
+ namelist /slim_history/ use_noio, hist_empty_htapes
+ namelist /slim_history/ hist_avgflag_pertape
+ namelist /slim_history/ hist_nhtfrq, hist_ndens
+ namelist /slim_history/ hist_mfilt, hist_fincl1, hist_fincl2, hist_fincl3
+ namelist /slim_history/ hist_fincl4, hist_fincl5
+ namelist /slim_history/ hist_fincl6, hist_fexcl1
+ !-----------------------------------------------------------------------
+
+ if (masterproc) then
+ open( newunit=nu_nml, file=trim(NLFilename), status='old', iostat=nml_error )
+ call find_nlgroup_name(nu_nml, nml_name, status=nml_error)
+ if (nml_error == 0) then
+ read(nu_nml, nml=slim_history,iostat=nml_error)
+ if (nml_error /= 0) then
+ call endrun(subname // ':: ERROR reading '//nml_name//' namelist')
+ end if
+ else
+ call endrun(subname // ':: ERROR could NOT find '//nml_name//' namelist')
+ end if
+ close(nu_nml)
+ end if
+
+ call shr_mpi_bcast( use_noio, mpicom )
+ call shr_mpi_bcast( hist_empty_htapes, mpicom )
+ call shr_mpi_bcast( hist_avgflag_pertape, mpicom )
+ call shr_mpi_bcast( hist_nhtfrq, mpicom )
+ call shr_mpi_bcast( hist_ndens, mpicom )
+ call shr_mpi_bcast( hist_mfilt, mpicom )
+ call shr_mpi_bcast( hist_fincl1, mpicom )
+ call shr_mpi_bcast( hist_fincl2, mpicom )
+ call shr_mpi_bcast( hist_fincl3, mpicom )
+ call shr_mpi_bcast( hist_fincl4, mpicom )
+ call shr_mpi_bcast( hist_fincl5, mpicom )
+ call shr_mpi_bcast( hist_fincl6, mpicom )
+ call shr_mpi_bcast( hist_fexcl1, mpicom )
+
+ ! History and restart files
+
+ dtime = get_step_size()
+ do i = 1, max_tapes
+ if (hist_nhtfrq(i) == 0) then
+ hist_mfilt(i) = 1
+ else if (hist_nhtfrq(i) < 0) then
+ hist_nhtfrq(i) = nint(-hist_nhtfrq(i)*SHR_CONST_CDAY/(24._r8*dtime))
+ endif
+ end do
+ if ( masterproc )then
+ if ( use_noio ) write(iulog,*) ' History output is turned off with use_noio = ', use_noio
+ end if
+
+ end subroutine hist_readNML
+
!-----------------------------------------------------------------------
subroutine hist_addfld1d (fname, units, avgflag, long_name, type1d_out, &
- ptr_gcell, ptr_lunit, ptr_col, ptr_patch, ptr_lnd, &
- ptr_atm, p2c_scale_type, c2l_scale_type, &
- l2g_scale_type, set_lake, set_nolake, set_urb, set_nourb, &
- set_noglcmec, set_spec, default)
+ ptr_gcell, ptr_lnd, ptr_atm, default)
!
! !DESCRIPTION:
! Initialize a single level history field. The pointer, ptrhist,
@@ -4399,20 +3252,8 @@ subroutine hist_addfld1d (fname, units, avgflag, long_name, type1d_out, &
character(len=*), intent(in) :: long_name ! long name of field
character(len=*), optional, intent(in) :: type1d_out ! output type (from data type)
real(r8) , optional, pointer :: ptr_gcell(:) ! pointer to gridcell array
- real(r8) , optional, pointer :: ptr_lunit(:) ! pointer to landunit array
- real(r8) , optional, pointer :: ptr_col(:) ! pointer to column array
- real(r8) , optional, pointer :: ptr_patch(:) ! pointer to patch array
real(r8) , optional, pointer :: ptr_lnd(:) ! pointer to lnd array
real(r8) , optional, pointer :: ptr_atm(:) ! pointer to atm array
- real(r8) , optional, intent(in) :: set_lake ! value to set lakes to
- real(r8) , optional, intent(in) :: set_nolake ! value to set non-lakes to
- real(r8) , optional, intent(in) :: set_urb ! value to set urban to
- real(r8) , optional, intent(in) :: set_nourb ! value to set non-urban to
- real(r8) , optional, intent(in) :: set_noglcmec ! value to set non-glacier_mec to
- real(r8) , optional, intent(in) :: set_spec ! value to set special to
- character(len=*), optional, intent(in) :: p2c_scale_type ! scale type for subgrid averaging of pfts to column
- character(len=*), optional, intent(in) :: c2l_scale_type ! scale type for subgrid averaging of columns to landunits
- character(len=*), optional, intent(in) :: l2g_scale_type ! scale type for subgrid averaging of landunits to gridcells
character(len=*), optional, intent(in) :: default ! if set to 'inactive, field will not appear on primary tape
!
! !LOCAL VARIABLES:
@@ -4420,9 +3261,6 @@ subroutine hist_addfld1d (fname, units, avgflag, long_name, type1d_out, &
integer :: hpindex ! history buffer pointer index
character(len=hist_dim_name_length) :: l_type1d ! 1d data type
character(len=hist_dim_name_length) :: l_type1d_out ! 1d output type
- character(len=scale_type_strlen) :: scale_type_p2c ! scale type for subgrid averaging of pfts to column
- character(len=scale_type_strlen) :: scale_type_c2l ! scale type for subgrid averaging of columns to landunits
- character(len=scale_type_strlen) :: scale_type_l2g ! scale type for subgrid averaging of landunits to gridcells
type(bounds_type):: bounds ! boudns
character(len=16):: l_default ! local version of 'default'
character(len=*),parameter :: subname = 'hist_addfld1d'
@@ -4445,142 +3283,22 @@ subroutine hist_addfld1d (fname, units, avgflag, long_name, type1d_out, &
l_type1d = nameg
l_type1d_out = nameg
clmptr_rs(hpindex)%ptr => ptr_gcell
-
- else if (present(ptr_lunit)) then
- l_type1d = namel
- l_type1d_out = namel
- clmptr_rs(hpindex)%ptr => ptr_lunit
- if (present(set_lake)) then
- do l = bounds%begl,bounds%endl
- if (lun%lakpoi(l)) ptr_lunit(l) = set_lake
- end do
- end if
- if (present(set_nolake)) then
- do l = bounds%begl,bounds%endl
- if (.not.(lun%lakpoi(l))) ptr_lunit(l) = set_nolake
- end do
- end if
- if (present(set_urb)) then
- do l = bounds%begl,bounds%endl
- if (lun%urbpoi(l)) ptr_lunit(l) = set_urb
- end do
- end if
- if (present(set_nourb)) then
- do l = bounds%begl,bounds%endl
- if (.not.(lun%urbpoi(l))) ptr_lunit(l) = set_nourb
- end do
- end if
- if (present(set_spec)) then
- do l = bounds%begl,bounds%endl
- if (lun%ifspecial(l)) ptr_lunit(l) = set_spec
- end do
- end if
-
- else if (present(ptr_col)) then
- l_type1d = namec
- l_type1d_out = namec
- clmptr_rs(hpindex)%ptr => ptr_col
- if (present(set_lake)) then
- do c = bounds%begc,bounds%endc
- l =col%landunit(c)
- if (lun%lakpoi(l)) ptr_col(c) = set_lake
- end do
- end if
- if (present(set_nolake)) then
- do c = bounds%begc,bounds%endc
- l =col%landunit(c)
- if (.not.(lun%lakpoi(l))) ptr_col(c) = set_nolake
- end do
- end if
- if (present(set_urb)) then
- do c = bounds%begc,bounds%endc
- l =col%landunit(c)
- if (lun%urbpoi(l)) ptr_col(c) = set_urb
- end do
- end if
- if (present(set_nourb)) then
- do c = bounds%begc,bounds%endc
- l =col%landunit(c)
- if (.not.(lun%urbpoi(l))) ptr_col(c) = set_nourb
- end do
- end if
- if (present(set_spec)) then
- do c = bounds%begc,bounds%endc
- l =col%landunit(c)
- if (lun%ifspecial(l)) ptr_col(c) = set_spec
- end do
- end if
- if (present(set_noglcmec)) then
- do c = bounds%begc,bounds%endc
- l =col%landunit(c)
- if (.not.(lun%glcmecpoi(l))) ptr_col(c) = set_noglcmec
- end do
- endif
-
- else if (present(ptr_patch)) then
- l_type1d = namep
- l_type1d_out = namep
- clmptr_rs(hpindex)%ptr => ptr_patch
- if (present(set_lake)) then
- do p = bounds%begp,bounds%endp
- l =patch%landunit(p)
- if (lun%lakpoi(l)) ptr_patch(p) = set_lake
- end do
- end if
- if (present(set_nolake)) then
- do p = bounds%begp,bounds%endp
- l =patch%landunit(p)
- if (.not.(lun%lakpoi(l))) ptr_patch(p) = set_nolake
- end do
- end if
- if (present(set_urb)) then
- do p = bounds%begp,bounds%endp
- l =patch%landunit(p)
- if (lun%urbpoi(l)) ptr_patch(p) = set_urb
- end do
- end if
- if (present(set_nourb)) then
- do p = bounds%begp,bounds%endp
- l =patch%landunit(p)
- if (.not.(lun%urbpoi(l))) ptr_patch(p) = set_nourb
- end do
- end if
- if (present(set_spec)) then
- do p = bounds%begp,bounds%endp
- l =patch%landunit(p)
- if (lun%ifspecial(l)) ptr_patch(p) = set_spec
- end do
- end if
- if (present(set_noglcmec)) then
- do p = bounds%begp,bounds%endp
- l =patch%landunit(p)
- if (.not.(lun%glcmecpoi(l))) ptr_patch(p) = set_noglcmec
- end do
- end if
else
write(iulog,*) trim(subname),' ERROR: must specify a valid pointer index,', &
- ' choices are [ptr_atm, ptr_lnd, ptr_gcell, ptr_lunit, ptr_col, ptr_patch] '
+ ' choices are [ptr_atm, ptr_lnd, ptr_gcell] '
call endrun(msg=errMsg(sourcefile, __LINE__))
end if
! Set scaling factor
- scale_type_p2c = 'unity'
- scale_type_c2l = 'unity'
- scale_type_l2g = 'unity'
-
- if (present(p2c_scale_type)) scale_type_p2c = p2c_scale_type
- if (present(c2l_scale_type)) scale_type_c2l = c2l_scale_type
- if (present(l2g_scale_type)) scale_type_l2g = l2g_scale_type
if (present(type1d_out)) l_type1d_out = type1d_out
! Add field to masterlist
call masterlist_addfld (fname=trim(fname), type1d=l_type1d, type1d_out=l_type1d_out, &
type2d='unset', num2d=1, &
- units=units, avgflag=avgflag, long_name=long_name, hpindex=hpindex, &
- p2c_scale_type=scale_type_p2c, c2l_scale_type=scale_type_c2l, l2g_scale_type=scale_type_l2g)
+ units=units, avgflag=avgflag, long_name=long_name, hpindex=hpindex)
l_default = 'active'
if (present(default)) then
@@ -4596,10 +3314,7 @@ end subroutine hist_addfld1d
!-----------------------------------------------------------------------
subroutine hist_addfld2d (fname, type2d, units, avgflag, long_name, type1d_out, &
- ptr_gcell, ptr_lunit, ptr_col, ptr_patch, ptr_lnd, ptr_atm, &
- p2c_scale_type, c2l_scale_type, l2g_scale_type, &
- set_lake, set_nolake, set_urb, set_nourb, set_spec, &
- no_snow_behavior, mml_dim, default)
+ ptr_gcell, ptr_lnd, ptr_atm, mml_dim, default)
!
! !DESCRIPTION:
! Initialize a single level history field. The pointer, ptrhist,
@@ -4612,9 +3327,7 @@ subroutine hist_addfld2d (fname, type2d, units, avgflag, long_name, type1d_out,
! initial or branch run to initialize the actual history tapes.
!
! !USES:
- use clm_varpar , only : nlevgrnd, nlevsno, nlevlak, numrad, nlevdecomp_full, nlevcan, nvegwcs,nlevsoi
- use clm_varpar , only : natpft_size, cft_size, maxpatch_glcmec
- use landunit_varcon , only : max_lunit
+ use clm_varpar , only : nlevgrnd, numrad
!
! !ARGUMENTS:
character(len=*), intent(in) :: fname ! field name
@@ -4626,18 +3339,6 @@ subroutine hist_addfld2d (fname, type2d, units, avgflag, long_name, type1d_out,
real(r8) , optional, pointer :: ptr_atm(:,:) ! pointer to atm array
real(r8) , optional, pointer :: ptr_lnd(:,:) ! pointer to lnd array
real(r8) , optional, pointer :: ptr_gcell(:,:) ! pointer to gridcell array
- real(r8) , optional, pointer :: ptr_lunit(:,:) ! pointer to landunit array
- real(r8) , optional, pointer :: ptr_col(:,:) ! pointer to column array
- real(r8) , optional, pointer :: ptr_patch(:,:) ! pointer to patch array
- real(r8) , optional, intent(in) :: set_lake ! value to set lakes to
- real(r8) , optional, intent(in) :: set_nolake ! value to set non-lakes to
- real(r8) , optional, intent(in) :: set_urb ! value to set urban to
- real(r8) , optional, intent(in) :: set_nourb ! value to set non-urban to
- real(r8) , optional, intent(in) :: set_spec ! value to set special to
- integer , optional, intent(in) :: no_snow_behavior ! if a multi-layer snow field, behavior to use for absent snow layers (should be one of the public no_snow_* parameters defined above)
- character(len=*), optional, intent(in) :: p2c_scale_type ! scale type for subgrid averaging of pfts to column
- character(len=*), optional, intent(in) :: c2l_scale_type ! scale type for subgrid averaging of columns to landunits
- character(len=*), optional, intent(in) :: l2g_scale_type ! scale type for subgrid averaging of landunits to gridcells
integer , optional, intent(in) :: mml_dim ! size of second dimension for MML variables
character(len=*), optional, intent(in) :: default ! if set to 'inactive, field will not appear on primary tape
!
@@ -4647,9 +3348,6 @@ subroutine hist_addfld2d (fname, type2d, units, avgflag, long_name, type1d_out,
integer :: hpindex ! history buffer index
character(len=hist_dim_name_length) :: l_type1d ! 1d data type
character(len=hist_dim_name_length) :: l_type1d_out ! 1d output type
- character(len=scale_type_strlen) :: scale_type_p2c ! scale type for subgrid averaging of pfts to column
- character(len=scale_type_strlen) :: scale_type_c2l ! scale type for subgrid averaging of columns to landunits
- character(len=scale_type_strlen) :: scale_type_l2g ! scale type for subgrid averaging of landunits to gridcells
type(bounds_type):: bounds
character(len=16):: l_default ! local version of 'default'
character(len=*),parameter :: subname = 'hist_addfld2d'
@@ -4657,76 +3355,22 @@ subroutine hist_addfld2d (fname, type2d, units, avgflag, long_name, type1d_out,
call get_proc_bounds(bounds)
- ! Error-check no_snow_behavior optional argument: It should be present if and only if
- ! type2d is 'levsno', and its value should be one of the public no_snow_* parameters
- ! defined above.
- if (present(no_snow_behavior)) then
- if (type2d /= 'levsno') then
- write(iulog,*) trim(subname), &
- ' ERROR: Only specify no_snow_behavior for fields with dimension levsno'
- call endrun()
- end if
-
- if (no_snow_behavior < no_snow_MIN .or. no_snow_behavior > no_snow_MAX) then
- write(iulog,*) trim(subname), &
- ' ERROR: Invalid value for no_snow_behavior: ', no_snow_behavior
- call endrun()
- end if
-
- else ! no_snow_behavior is absent
- if (type2d == 'levsno') then
- write(iulog,*) trim(subname), &
- ' ERROR: must specify no_snow_behavior for fields with dimension levsno'
- call endrun()
- end if
- end if
-
! Determine second dimension size
select case (type2d)
case ('levgrnd')
num2d = nlevgrnd
- case ('levsoi')
- num2d = nlevsoi
- case ('levlak')
- num2d = nlevlak
case ('numrad')
num2d = numrad
- case ('levdcmp')
- num2d = nlevdecomp_full
- case ('ltype')
- num2d = max_lunit
- case ('natpft')
- num2d = natpft_size
- case('cft')
- if (cft_size > 0) then
- num2d = cft_size
- else
- write(iulog,*) trim(subname),' ERROR: 2d type =', trim(type2d), &
- ' only valid for cft_size > 0'
- call endrun()
- end if
- case ('glc_nec')
- num2d = maxpatch_glcmec
- case ('elevclas')
- ! add one because indexing starts at 0 (elevclas, unlike glc_nec, includes the
- ! bare ground "elevation class")
- num2d = maxpatch_glcmec + 1
- case ('levsno')
- num2d = nlevsno
- case ('nlevcan')
- num2d = nlevcan
! MML: adding my own
case ('mml_lev')
num2d = 10 !mml_nsoi ! mml_dim ! mml_nsoi not defined in this subroutine, so hard coding until I get more clever...
case ('mml_dust')
num2d = 4
- case ('nvegwcs')
- num2d = nvegwcs
case default
write(iulog,*) trim(subname),' ERROR: unsupported 2d type ',type2d, &
' currently supported types for multi level fields are: ', &
- '[levgrnd,levsoi,levlak,numrad,levdcmp,levtrc,ltype,natpft,cft,glc_nec,elevclas,levsno,nvegwcs]'
+ '[levgrnd,levsoi,numrad,ltype]'
call endrun(msg=errMsg(sourcefile, __LINE__))
end select
@@ -4743,132 +3387,22 @@ subroutine hist_addfld2d (fname, type2d, units, avgflag, long_name, type1d_out,
l_type1d = nameg
l_type1d_out = nameg
clmptr_ra(hpindex)%ptr => ptr_gcell
-
- else if (present(ptr_lunit)) then
- l_type1d = namel
- l_type1d_out = namel
- clmptr_ra(hpindex)%ptr => ptr_lunit
- if (present(set_lake)) then
- do l = bounds%begl,bounds%endl
- if (lun%lakpoi(l)) ptr_lunit(l,:) = set_lake
- end do
- end if
- if (present(set_nolake)) then
- do l = bounds%begl,bounds%endl
- if (.not.(lun%lakpoi(l))) ptr_lunit(l,:) = set_nolake
- end do
- end if
- if (present(set_urb)) then
- do l = bounds%begl,bounds%endl
- if (lun%urbpoi(l)) ptr_lunit(l,:) = set_urb
- end do
- end if
- if (present(set_nourb)) then
- do l = bounds%begl,bounds%endl
- if (.not.(lun%urbpoi(l))) ptr_lunit(l,:) = set_nourb
- end do
- end if
- if (present(set_spec)) then
- do l = bounds%begl,bounds%endl
- if (lun%ifspecial(l)) ptr_lunit(l,:) = set_spec
- end do
- end if
-
- else if (present(ptr_col)) then
- l_type1d = namec
- l_type1d_out = namec
- clmptr_ra(hpindex)%ptr => ptr_col
- if (present(set_lake)) then
- do c = bounds%begc,bounds%endc
- l =col%landunit(c)
- if (lun%lakpoi(l)) ptr_col(c,:) = set_lake
- end do
- end if
- if (present(set_nolake)) then
- do c = bounds%begc,bounds%endc
- l =col%landunit(c)
- if (.not.(lun%lakpoi(l))) ptr_col(c,:) = set_nolake
- end do
- end if
- if (present(set_urb)) then
- do c = bounds%begc,bounds%endc
- l =col%landunit(c)
- if (lun%urbpoi(l)) ptr_col(c,:) = set_urb
- end do
- end if
- if (present(set_nourb)) then
- do c = bounds%begc,bounds%endc
- l =col%landunit(c)
- if (.not.(lun%urbpoi(l))) ptr_col(c,:) = set_nourb
- end do
- end if
- if (present(set_spec)) then
- do c = bounds%begc,bounds%endc
- l =col%landunit(c)
- if (lun%ifspecial(l)) ptr_col(c,:) = set_spec
- end do
- end if
-
- else if (present(ptr_patch)) then
- l_type1d = namep
- l_type1d_out = namep
- clmptr_ra(hpindex)%ptr => ptr_patch
- if (present(set_lake)) then
- do p = bounds%begp,bounds%endp
- l =patch%landunit(p)
- if (lun%lakpoi(l)) ptr_patch(p,:) = set_lake
- end do
- end if
- if (present(set_nolake)) then
- do p = bounds%begp,bounds%endp
- l =patch%landunit(p)
- if (.not.(lun%lakpoi(l))) ptr_patch(p,:) = set_nolake
- end do
- end if
- if (present(set_urb)) then
- do p = bounds%begp,bounds%endp
- l =patch%landunit(p)
- if (lun%urbpoi(l)) ptr_patch(p,:) = set_urb
- end do
- end if
- if (present(set_nourb)) then
- do p = bounds%begp,bounds%endp
- l =patch%landunit(p)
- if (.not.(lun%urbpoi(l))) ptr_patch(p,:) = set_nourb
- end do
- end if
- if (present(set_spec)) then
- do p = bounds%begp,bounds%endp
- l =patch%landunit(p)
- if (lun%ifspecial(l)) ptr_patch(p,:) = set_spec
- end do
- end if
-
else
write(iulog,*) trim(subname),' ERROR: must specify a valid pointer index,', &
- ' choices are ptr_atm, ptr_lnd, ptr_gcell, ptr_lunit, ptr_col, ptr_patch'
+ ' choices are ptr_atm, ptr_lnd, ptr_gcell'
call endrun(msg=errMsg(sourcefile, __LINE__))
end if
! Set scaling factor
- scale_type_p2c = 'unity'
- scale_type_c2l = 'unity'
- scale_type_l2g = 'unity'
-
- if (present(p2c_scale_type)) scale_type_p2c = p2c_scale_type
- if (present(c2l_scale_type)) scale_type_c2l = c2l_scale_type
- if (present(l2g_scale_type)) scale_type_l2g = l2g_scale_type
if (present(type1d_out)) l_type1d_out = type1d_out
! Add field to masterlist
call masterlist_addfld (fname=trim(fname), type1d=l_type1d, type1d_out=l_type1d_out, &
type2d=type2d, num2d=num2d, &
- units=units, avgflag=avgflag, long_name=long_name, hpindex=hpindex, &
- p2c_scale_type=scale_type_p2c, c2l_scale_type=scale_type_c2l, l2g_scale_type=scale_type_l2g, &
- no_snow_behavior=no_snow_behavior)
+ units=units, avgflag=avgflag, long_name=long_name, hpindex=hpindex)
l_default = 'active'
if (present(default)) then
@@ -4882,94 +3416,6 @@ subroutine hist_addfld2d (fname, type2d, units, avgflag, long_name, type1d_out,
end subroutine hist_addfld2d
- !-----------------------------------------------------------------------
- subroutine hist_addfld_decomp (fname, type2d, units, avgflag, long_name, ptr_col, &
- ptr_patch, l2g_scale_type, default)
-
- !
- ! !USES:
- use clm_varpar , only : nlevdecomp_full
- use clm_varctl , only : iulog
- use abortutils , only : endrun
- use shr_log_mod , only : errMsg => shr_log_errMsg
- !
- ! !ARGUMENTS:
- character(len=*), intent(in) :: fname ! field name
- character(len=*), intent(in) :: type2d ! 2d output type
- character(len=*), intent(in) :: units ! units of field
- character(len=*), intent(in) :: avgflag ! time averaging flag
- character(len=*), intent(in) :: long_name ! long name of field
- real(r8) , optional, pointer :: ptr_col(:,:) ! pointer to column array
- real(r8) , optional, pointer :: ptr_patch(:,:) ! pointer to patch array
- character(len=*), optional, intent(in) :: l2g_scale_type ! scale type for subgrid averaging of landunits to gridcells
- character(len=*), optional, intent(in) :: default ! if set to 'inactive, field will not appear on primary tape
- !
- ! !LOCAL VARIABLES:
- real(r8), pointer :: ptr_1d(:)
- !-----------------------------------------------------------------------
-
- if (present(ptr_col)) then
-
- ! column-level data
- if (present(default)) then
- if ( nlevdecomp_full > 1 ) then
- call hist_addfld2d (fname=trim(fname), units=units, type2d=type2d, &
- avgflag=avgflag, long_name=long_name, &
- ptr_col=ptr_col, l2g_scale_type=l2g_scale_type, default=default)
- else
- ptr_1d => ptr_col(:,1)
- call hist_addfld1d (fname=trim(fname), units=units, &
- avgflag=avgflag, long_name=long_name, &
- ptr_col=ptr_1d, l2g_scale_type=l2g_scale_type, default=default)
- endif
- else
- if ( nlevdecomp_full > 1 ) then
- call hist_addfld2d (fname=trim(fname), units=units, type2d=type2d, &
- avgflag=avgflag, long_name=long_name, &
- ptr_col=ptr_col, l2g_scale_type=l2g_scale_type)
- else
- ptr_1d => ptr_col(:,1)
- call hist_addfld1d (fname=trim(fname), units=units, &
- avgflag=avgflag, long_name=long_name, &
- ptr_col=ptr_1d, l2g_scale_type=l2g_scale_type)
- endif
- endif
-
- else if (present(ptr_patch)) then
-
- ! patch-level data
- if (present(default)) then
- if ( nlevdecomp_full > 1 ) then
- call hist_addfld2d (fname=trim(fname), units=units, type2d=type2d, &
- avgflag=avgflag, long_name=long_name, &
- ptr_patch=ptr_patch, l2g_scale_type=l2g_scale_type, default=default)
- else
- ptr_1d => ptr_patch(:,1)
- call hist_addfld1d (fname=trim(fname), units=units, &
- avgflag=avgflag, long_name=long_name, &
- ptr_patch=ptr_1d, l2g_scale_type=l2g_scale_type, default=default)
- endif
- else
- if ( nlevdecomp_full > 1 ) then
- call hist_addfld2d (fname=trim(fname), units=units, type2d=type2d, &
- avgflag=avgflag, long_name=long_name, &
- ptr_patch=ptr_patch, l2g_scale_type=l2g_scale_type)
- else
- ptr_1d => ptr_patch(:,1)
- call hist_addfld1d (fname=trim(fname), units=units, &
- avgflag=avgflag, long_name=long_name, &
- ptr_patch=ptr_1d, l2g_scale_type=l2g_scale_type)
- endif
- endif
-
- else
- write(iulog, *) ' error: hist_addfld_decomp needs either patch or column level pointer'
- write(iulog, *) fname
- call endrun(msg=errMsg(sourcefile, __LINE__))
- endif
-
- end subroutine hist_addfld_decomp
-
!-----------------------------------------------------------------------
integer function pointer_index ()
!
diff --git a/src/main/initGridCellsMod.F90 b/src/main/initGridCellsMod.F90
deleted file mode 100644
index def9631a..00000000
--- a/src/main/initGridCellsMod.F90
+++ /dev/null
@@ -1,571 +0,0 @@
-module initGridCellsMod
-
-#include "shr_assert.h"
-
- !-----------------------------------------------------------------------
- ! !DESCRIPTION:
- ! Initializes sub-grid mapping for each land grid cell. This module handles the high-
- ! level logic that determines how the subgrid structure is set up in a CLM run. It
- ! makes use of lower-level routines in initSubgridMod.
- !
- ! TODO(wjs, 2015-12-08) Much of the logic here duplicates (in some sense) logic in
- ! subgridMod. The duplication should probably be extracted into routines shared between
- ! these modules (or the two modules should be combined into one).
- !
- ! !USES:
-#include "shr_assert.h"
- use shr_kind_mod , only : r8 => shr_kind_r8
- use shr_log_mod , only : errMsg => shr_log_errMsg
- use spmdMod , only : masterproc,iam
- use abortutils , only : endrun
- use clm_varctl , only : iulog
- use clm_varcon , only : namep, namec, namel, nameg
- use decompMod , only : bounds_type, ldecomp
- use GridcellType , only : grc
- use LandunitType , only : lun
- use ColumnType , only : col
- use PatchType , only : patch
- use initSubgridMod , only : clm_ptrs_compdown, clm_ptrs_check
- use initSubgridMod , only : add_landunit, add_column, add_patch
- use glcBehaviorMod , only : glc_behavior_type
- !
- ! !PUBLIC TYPES:
- implicit none
- private
- !
- ! !PUBLIC MEMBER FUNCTIONS:
- public initGridcells ! initialize sub-grid gridcell mapping
- !
- ! !PRIVATE MEMBER FUNCTIONS:
- private set_landunit_veg_compete
- private set_landunit_wet_lake
- private set_landunit_ice_mec
- private set_landunit_crop_noncompete
- private set_landunit_urban
-
- character(len=*), parameter, private :: sourcefile = &
- __FILE__
- !-----------------------------------------------------------------------
-
-contains
-
- !------------------------------------------------------------------------
- subroutine initGridcells(glc_behavior)
- !
- ! !DESCRIPTION:
- ! Initialize sub-grid mapping and allocates space for derived type hierarchy.
- ! For each land gridcell determine landunit, column and patch properties.
- !
- ! !USES
- use domainMod , only : ldomain
- use decompMod , only : get_proc_bounds, get_clump_bounds, get_proc_clumps
- use subgridWeightsMod , only : compute_higher_order_weights
- use landunit_varcon , only : istsoil, istwet, istdlak, istice_mec
- use landunit_varcon , only : isturb_tbd, isturb_hd, isturb_md, istcrop
- use clm_varctl , only : use_fates
- use shr_const_mod , only : SHR_CONST_PI
- !
- ! !ARGUMENTS:
- type(glc_behavior_type), intent(in) :: glc_behavior
- !
- ! !LOCAL VARIABLES:
- integer :: nc,li,ci,pi,gdc ! indices
- integer :: nclumps ! number of clumps on this processor
- type(bounds_type) :: bounds_proc
- type(bounds_type) :: bounds_clump
- !------------------------------------------------------------------------
-
- ! Notes about how this routine is arranged, and its implications for the arrangement
- ! of 1-d vectors in memory:
- !
- ! (1) There is an outer loop over clumps; this results in all of a clump's points (at
- ! the gridcell, landunit, column & patch level) being contiguous. This is important
- ! for the use of begg:endg, etc., and also for performance.
- !
- ! (2) Next, there is a section for each landunit, with the loop over grid cells
- ! happening separately for each landunit. This means that, within a given clump,
- ! points with the same landunit are grouped together (this is true at the
- ! landunit, column and patch levels). Thus, different landunits for a given grid
- ! cell are separated in memory. This improves performance in the many parts of
- ! the code that operate over a single landunit, or two similar landunits.
- !
- ! Example: landunit-level array: For a processor with 2 clumps, each of which has 2
- ! grid cells, each of which has 3 landunits, the layout of a landunit-level array
- ! looks like the following:
- !
- ! Array index: 1 2 3 4 5 6 7 8 9 10 11 12
- ! ------------------------------------------------------------
- ! Clump index: 1 1 1 1 1 1 2 2 2 2 2 2
- ! Gridcell: 1 2 1 2 1 2 3 4 3 4 3 4
- ! Landunit type: 1 1 2 2 3 3 1 1 2 2 3 3
- !
- ! Example: patch-level array: For a processor with 1 clump, which has 2 grid cells, each
- ! of which has 2 landunits, each of which has 3 patchs, the layout of a patch-level array
- ! looks like the following:
- !
- ! Array index: 1 2 3 4 5 6 7 8 9 10 11 12
- ! ------------------------------------------------------------
- ! Gridcell: 1 1 1 2 2 2 1 1 1 2 2 2
- ! Landunit type: 1 1 1 1 1 1 2 2 2 2 2 2
- ! Patch type: 1 2 3 1 2 3 1 2 3 1 2 3
- !
- ! So note that clump index is most slowly varying, followed by landunit type,
- ! followed by gridcell, followed by column and patch type.
- !
- ! Cohort layout
- ! Array index: 1 2 3 4 5 6 7 8 9 10 11 12
- ! ------------------------------------------------------------
- ! Gridcell: 1 1 1 1 2 2 2 2 3 3 3 3
- ! Column: 1 1 2 2 3 3 4 4 5 5 6 6
- ! Cohort: 1 2 1 2 1 2 1 2 1 2 1 2
-
- nclumps = get_proc_clumps()
-
- ! FIX(SPM,032414) add private vars for cohort and perhaps patch dimension
- !$OMP PARALLEL DO PRIVATE (nc, bounds_clump, li, ci, pi, gdc)
- do nc = 1, nclumps
-
- call get_clump_bounds(nc, bounds_clump)
-
- ! For each land gridcell on global grid determine landunit, column and patch properties
-
- li = bounds_clump%begl-1
- ci = bounds_clump%begc-1
- pi = bounds_clump%begp-1
-
- ! Determine naturally vegetated landunit
- do gdc = bounds_clump%begg,bounds_clump%endg
- call set_landunit_veg_compete( &
- ltype=istsoil, gi=gdc, li=li, ci=ci, pi=pi)
- end do
-
- ! Determine crop landunit
- do gdc = bounds_clump%begg,bounds_clump%endg
- call set_landunit_crop_noncompete( &
- ltype=istcrop, gi=gdc, li=li, ci=ci, pi=pi)
- end do
-
- ! Determine urban tall building district landunit
- do gdc = bounds_clump%begg,bounds_clump%endg
- call set_landunit_urban( &
- ltype=isturb_tbd, gi=gdc, li=li, ci=ci, pi=pi)
-
- end do
-
- ! Determine urban high density landunit
- do gdc = bounds_clump%begg,bounds_clump%endg
- call set_landunit_urban( &
- ltype=isturb_hd, gi=gdc, li=li, ci=ci, pi=pi)
- end do
-
- ! Determine urban medium density landunit
- do gdc = bounds_clump%begg,bounds_clump%endg
- call set_landunit_urban( &
- ltype=isturb_md, gi=gdc, li=li, ci=ci, pi=pi)
- end do
-
- ! Determine lake, wetland and glacier landunits
- do gdc = bounds_clump%begg,bounds_clump%endg
- call set_landunit_wet_lake( &
- ltype=istdlak, gi=gdc, li=li, ci=ci, pi=pi)
- end do
-
- do gdc = bounds_clump%begg,bounds_clump%endg
- call set_landunit_wet_lake( &
- ltype=istwet, gi=gdc, li=li, ci=ci, pi=pi)
- end do
-
- do gdc = bounds_clump%begg,bounds_clump%endg
- call set_landunit_ice_mec( &
- glc_behavior = glc_behavior, &
- ltype=istice_mec, gi=gdc, li=li, ci=ci, pi=pi)
- end do
-
- ! Ensure that we have set the expected number of patchs, cols and landunits for this clump
- SHR_ASSERT(li == bounds_clump%endl, errMsg(sourcefile, __LINE__))
- SHR_ASSERT(ci == bounds_clump%endc, errMsg(sourcefile, __LINE__))
- SHR_ASSERT(pi == bounds_clump%endp, errMsg(sourcefile, __LINE__))
-
- ! Set some other gridcell-level variables
-
- do gdc = bounds_clump%begg,bounds_clump%endg
- grc%gindex(gdc) = ldecomp%gdc2glo(gdc)
- grc%area(gdc) = ldomain%area(gdc)
- grc%latdeg(gdc) = ldomain%latc(gdc)
- grc%londeg(gdc) = ldomain%lonc(gdc)
- grc%lat(gdc) = grc%latdeg(gdc) * SHR_CONST_PI/180._r8
- grc%lon(gdc) = grc%londeg(gdc) * SHR_CONST_PI/180._r8
- enddo
-
- ! Fill in subgrid datatypes
-
- call clm_ptrs_compdown(bounds_clump)
-
- ! By putting this check within the loop over clumps, we ensure that (for example)
- ! if a clump is responsible for landunit L, then that same clump is also
- ! responsible for all columns and patchs in L.
- call clm_ptrs_check(bounds_clump)
-
- ! Set patch%wtlunit, patch%wtgcell and col%wtgcell
- call compute_higher_order_weights(bounds_clump)
-
- end do
- !$OMP END PARALLEL DO
-
- end subroutine initGridcells
-
- !------------------------------------------------------------------------
- subroutine set_landunit_veg_compete (ltype, gi, li, ci, pi)
- !
- ! !DESCRIPTION:
- ! Initialize vegetated landunit with competition
- !
- ! !USES
- use clm_instur, only : wt_lunit, wt_nat_patch
- use subgridMod, only : subgrid_get_info_natveg
- use clm_varpar, only : numpft, maxpatch_pft, natpft_lb, natpft_ub
- !
- ! !ARGUMENTS:
- integer , intent(in) :: ltype ! landunit type
- integer , intent(in) :: gi ! gridcell index
- integer , intent(inout) :: li ! landunit index
- integer , intent(inout) :: ci ! column index
- integer , intent(inout) :: pi ! patch index
- !
- ! !LOCAL VARIABLES:
- integer :: m ! index
- integer :: npatches ! number of patches in landunit
- integer :: ncols
- integer :: nlunits
- integer :: pitype ! patch itype
- real(r8) :: wtlunit2gcell ! landunit weight in gridcell
- !------------------------------------------------------------------------
-
- ! Set decomposition properties
-
- call subgrid_get_info_natveg(gi, &
- npatches=npatches, ncols=ncols, nlunits=nlunits)
- wtlunit2gcell = wt_lunit(gi, ltype)
-
- if (npatches > 0) then
- call add_landunit(li=li, gi=gi, ltype=ltype, wtgcell=wtlunit2gcell)
-
- ! Assume one column on the landunit
- call add_column(ci=ci, li=li, ctype=1, wtlunit=1.0_r8)
-
- do m = natpft_lb,natpft_ub
- call add_patch(pi=pi, ci=ci, ptype=m, wtcol=wt_nat_patch(gi,m))
- end do
- end if
-
- end subroutine set_landunit_veg_compete
-
- !------------------------------------------------------------------------
- subroutine set_landunit_wet_lake (ltype, gi, li, ci, pi)
- !
- ! !DESCRIPTION:
- ! Initialize wetland and lake landunits
- !
- ! !USES
- use clm_instur , only : wt_lunit
- use landunit_varcon , only : istwet, istdlak
- use subgridMod , only : subgrid_get_info_wetland, subgrid_get_info_lake
- use pftconMod , only : noveg
-
- !
- ! !ARGUMENTS:
- integer , intent(in) :: ltype ! landunit type
- integer , intent(in) :: gi ! gridcell index
- integer , intent(inout) :: li ! landunit index
- integer , intent(inout) :: ci ! column index
- integer , intent(inout) :: pi ! patch index
- !
- ! !LOCAL VARIABLES:
- integer :: npatches ! number of pfts in landunit
- integer :: ncols
- integer :: nlunits
- real(r8) :: wtlunit2gcell ! landunit weight in gridcell
- !------------------------------------------------------------------------
-
- ! Set decomposition properties
-
- if (ltype == istwet) then
- call subgrid_get_info_wetland(gi, &
- npatches=npatches, ncols=ncols, nlunits=nlunits)
- else if (ltype == istdlak) then
- call subgrid_get_info_lake(gi, &
- npatches=npatches, ncols=ncols, nlunits=nlunits)
- else
- write(iulog,*)' set_landunit_wet_lake: ltype of ',ltype,' not valid'
- write(iulog,*)' only istwet and istdlak ltypes are valid'
- call endrun(msg=errMsg(sourcefile, __LINE__))
- end if
-
- wtlunit2gcell = wt_lunit(gi, ltype)
-
- if (npatches > 0) then
-
- if (npatches /= 1) then
- write(iulog,*)' set_landunit_wet_lake: compete landunit must'// &
- ' have one patch '
- write(iulog,*)' current value of npatches=',npatches
- call endrun(msg=errMsg(sourcefile, __LINE__))
- end if
-
- ! Currently assume that each landunit only has only one column
- ! and that each column has its own pft
-
- call add_landunit(li=li, gi=gi, ltype=ltype, wtgcell=wtlunit2gcell)
- call add_column(ci=ci, li=li, ctype=ltype, wtlunit=1.0_r8)
- call add_patch(pi=pi, ci=ci, ptype=noveg, wtcol=1.0_r8)
-
- endif ! npatches > 0
-
- end subroutine set_landunit_wet_lake
-
- !-----------------------------------------------------------------------
- subroutine set_landunit_ice_mec(glc_behavior, ltype, gi, li, ci, pi)
- !
- ! !DESCRIPTION:
- ! Initialize glacier_mec landunits
- !
- ! !USES:
- use clm_varpar , only : maxpatch_glcmec
- use clm_instur , only : wt_lunit, wt_glc_mec
- use landunit_varcon , only : istice_mec
- use column_varcon , only : icemec_class_to_col_itype
- use subgridMod , only : subgrid_get_info_glacier_mec
- use pftconMod , only : noveg
- !
- ! !ARGUMENTS:
- type(glc_behavior_type), intent(in) :: glc_behavior
- integer , intent(in) :: ltype ! landunit type
- integer , intent(in) :: gi ! gridcell index
- integer , intent(inout) :: li ! landunit index
- integer , intent(inout) :: ci ! column index
- integer , intent(inout) :: pi ! patch index
- !
- ! !LOCAL VARIABLES:
- integer :: m ! index
- integer :: npatches ! number of patches in landunit
- integer :: ncols
- integer :: nlunits
- logical :: col_exists
- real(r8) :: wtlunit2gcell ! weight relative to gridcell of landunit
- real(r8) :: wtcol2lunit ! col weight in landunit
- logical :: type_is_dynamic
-
- ! We don't have a true atm_topo value at the point of this call, so arbitrarily use
- ! 0. This will put glc_mec in elevation class 1 in some places where it should
- ! actually be in a higher elevation class, but that will be adjusted in the run loop
- ! (or upon reading the restart file).
- real(r8), parameter :: atm_topo = 0._r8
-
- character(len=*), parameter :: subname = 'set_landunit_ice_mec'
- !-----------------------------------------------------------------------
-
- SHR_ASSERT(ltype == istice_mec, errMsg(sourcefile, __LINE__))
-
- call subgrid_get_info_glacier_mec(gi, atm_topo, glc_behavior, &
- npatches=npatches, ncols=ncols, nlunits=nlunits)
-
- if (nlunits == 1) then
- wtlunit2gcell = wt_lunit(gi, ltype)
- call add_landunit(li=li, gi=gi, ltype=ltype, wtgcell=wtlunit2gcell)
-
- ! Determine column and properties
- ! (Each column has its own pft)
- !
- ! For grid cells where the glc behavior indicates a need for virtual columns
- ! (i.e., zero-weight columns that are nevertheless active), make sure all the
- ! elevations classes are populated, even if some have zero fractional area.
- ! This ensures that the ice sheet component, glc, will receive a surface mass
- ! balance in each elevation class wherever the SMB is needed.
-
- type_is_dynamic = glc_behavior%cols_have_dynamic_type(gi)
- do m = 1, maxpatch_glcmec
- call glc_behavior%glc_mec_col_exists(gi = gi, elev_class = m, atm_topo = atm_topo, &
- exists = col_exists, col_wt_lunit = wtcol2lunit)
- if (col_exists) then
- call add_column(ci=ci, li=li, ctype=icemec_class_to_col_itype(m), &
- wtlunit=wtcol2lunit, type_is_dynamic=type_is_dynamic)
- call add_patch(pi=pi, ci=ci, ptype=noveg, wtcol=1.0_r8)
- endif
- enddo
-
- else if (nlunits /= 0) then
- call endrun(msg=subname//' ERROR: expect 0 or 1 landunits')
- end if
-
- end subroutine set_landunit_ice_mec
-
- !------------------------------------------------------------------------
-
- subroutine set_landunit_crop_noncompete (ltype, gi, li, ci, pi)
- !
- ! !DESCRIPTION:
- ! Initialize crop landunit without competition
- !
- ! Note about the ltype input argument: This provides the value for this landunit index
- ! (i.e., the crop landunit index). This may differ from the landunit's 'itype' value,
- ! since itype is istsoil if we are running with create_crop_landunit but for
- ! an older surface dataset that
- !
- ! !USES
- use clm_instur , only : wt_lunit, wt_cft
- use landunit_varcon , only : istcrop, istsoil
- use subgridMod , only : subgrid_get_info_crop, crop_patch_exists
- use clm_varpar , only : maxpatch_pft, cft_lb, cft_ub
- use clm_varctl , only : create_crop_landunit
- !
- ! !ARGUMENTS:
- integer , intent(in) :: ltype ! landunit type
- integer , intent(in) :: gi ! gridcell index
- integer , intent(inout) :: li ! landunit index
- integer , intent(inout) :: ci ! column index
- integer , intent(inout) :: pi ! patch index
- !
- ! !LOCAL VARIABLES:
- integer :: my_ltype ! landunit type for crops
- integer :: cft ! crop functional type index
- integer :: npatches ! number of pfts in landunit
- integer :: ncols
- integer :: nlunits
- real(r8) :: wtlunit2gcell ! landunit weight in gridcell
- !------------------------------------------------------------------------
-
- ! Set decomposition properties
-
- call subgrid_get_info_crop(gi, &
- npatches=npatches, ncols=ncols, nlunits=nlunits)
- wtlunit2gcell = wt_lunit(gi, ltype)
-
- if (nlunits > 0) then
-
- ! Note that we cannot simply use the 'ltype' argument to set itype here,
- ! because ltype will always indicate istcrop
- if ( create_crop_landunit )then
- my_ltype = ltype ! Will always be istcrop
- if ( ltype /= istcrop )then
- write(iulog,*)' create_crop_landunit on and ltype is not istcrop: ', ltype
- call endrun(msg=errMsg(sourcefile, __LINE__))
- end if
- else
- my_ltype = istsoil
- end if
-
- call add_landunit(li=li, gi=gi, ltype=my_ltype, wtgcell=wtlunit2gcell)
-
- ! Set column and patch properties for this landunit
- ! (each column has its own pft)
-
- do cft = cft_lb, cft_ub
- if (crop_patch_exists(gi, cft)) then
- call add_column(ci=ci, li=li, ctype=((istcrop*100) + cft), wtlunit=wt_cft(gi,cft))
- call add_patch(pi=pi, ci=ci, ptype=cft, wtcol=1.0_r8)
- end if
- end do
-
- end if
-
- end subroutine set_landunit_crop_noncompete
-
- !------------------------------------------------------------------------------
-
- subroutine set_landunit_urban (ltype, gi, li, ci, pi)
- !
- ! !DESCRIPTION:
- ! Initialize urban landunits
- !
- ! !USES
- use column_varcon , only : icol_roof, icol_sunwall, icol_shadewall
- use column_varcon , only : icol_road_perv, icol_road_imperv
- use landunit_varcon , only : isturb_tbd, isturb_hd, isturb_md, isturb_MIN
- use clm_varpar , only : maxpatch_urb
- use clm_instur , only : wt_lunit
- use subgridMod , only : subgrid_get_info_urban_tbd, subgrid_get_info_urban_hd
- use subgridMod , only : subgrid_get_info_urban_md
- use UrbanParamsType , only : urbinp
- use decompMod , only : ldecomp
- use pftconMod , only : noveg
- !
- ! !ARGUMENTS:
- integer , intent(in) :: ltype ! landunit type
- integer , intent(in) :: gi ! gridcell index
- integer , intent(inout) :: li ! landunit index
- integer , intent(inout) :: ci ! column index
- integer , intent(inout) :: pi ! patch index
- !
- ! !LOCAL VARIABLES:
- integer :: m ! index
- integer :: n ! urban density type index
- integer :: ctype ! column type
- integer :: npatches ! number of pfts in landunit
- integer :: ncols
- integer :: nlunits
- real(r8) :: wtlunit2gcell ! weight relative to gridcell of landunit
- real(r8) :: wtcol2lunit ! weight of column with respect to landunit
- real(r8) :: wtlunit_roof ! weight of roof with respect to landunit
- real(r8) :: wtroad_perv ! weight of pervious road column with respect to total road
- integer :: ier ! error status
- !------------------------------------------------------------------------
-
- ! Set decomposition properties, and set variables specific to urban density type
-
- select case (ltype)
- case (isturb_tbd)
- call subgrid_get_info_urban_tbd(gi, &
- npatches=npatches, ncols=ncols, nlunits=nlunits)
- case (isturb_hd)
- call subgrid_get_info_urban_hd(gi, &
- npatches=npatches, ncols=ncols, nlunits=nlunits)
- case (isturb_md)
- call subgrid_get_info_urban_md(gi, &
- npatches=npatches, ncols=ncols, nlunits=nlunits)
- case default
- write(iulog,*)' set_landunit_urban: unknown ltype: ', ltype
- call endrun(msg=errMsg(sourcefile, __LINE__))
- end select
-
- wtlunit2gcell = wt_lunit(gi, ltype)
-
- n = ltype - isturb_MIN + 1
- wtlunit_roof = urbinp%wtlunit_roof(gi,n)
- wtroad_perv = urbinp%wtroad_perv(gi,n)
-
- if (npatches > 0) then
-
- call add_landunit(li=li, gi=gi, ltype=ltype, wtgcell=wtlunit2gcell)
-
- ! Loop through columns for this landunit and set the column and patch properties
- ! For the urban landunits it is assumed that each column has its own pft
-
- do m = 1, maxpatch_urb
-
- if (m == 1) then
- ctype = icol_roof
- wtcol2lunit = wtlunit_roof
- else if (m == 2) then
- ctype = icol_sunwall
- wtcol2lunit = (1. - wtlunit_roof)/3
- else if (m == 3) then
- ctype = icol_shadewall
- wtcol2lunit = (1. - wtlunit_roof)/3
- else if (m == 4) then
- ctype = icol_road_imperv
- wtcol2lunit = ((1. - wtlunit_roof)/3) * (1.-wtroad_perv)
- else if (m == 5) then
- ctype = icol_road_perv
- wtcol2lunit = ((1. - wtlunit_roof)/3) * (wtroad_perv)
- end if
-
- call add_column(ci=ci, li=li, ctype=ctype, wtlunit=wtcol2lunit)
-
- call add_patch(pi=pi, ci=ci, ptype=noveg, wtcol=1.0_r8)
-
- end do ! end of loop through urban columns-pfts
- end if
-
- end subroutine set_landunit_urban
-
-end module initGridCellsMod
diff --git a/src/main/initSubgridMod.F90 b/src/main/initSubgridMod.F90
deleted file mode 100644
index 57384dc4..00000000
--- a/src/main/initSubgridMod.F90
+++ /dev/null
@@ -1,475 +0,0 @@
-module initSubgridMod
-
- !-----------------------------------------------------------------------
- ! !DESCRIPTION:
- ! Lower-level routines for initializing the subgrid structure. This module is shared
- ! between both the production code (via initGridCellsMod) and unit testing code.
- !
- ! !USES:
- use shr_kind_mod , only : r8 => shr_kind_r8
- use shr_log_mod , only : errMsg => shr_log_errMsg
- use spmdMod , only : masterproc
- use abortutils , only : endrun
- use clm_varctl , only : iulog, use_fates
- use clm_varcon , only : namep, namec, namel
- use decompMod , only : bounds_type
- use GridcellType , only : grc
- use LandunitType , only : lun
- use ColumnType , only : col
- use PatchType , only : patch
- use column_varcon , only : is_hydrologically_active
- !
- ! !PUBLIC TYPES:
- implicit none
- private
- save
- !
- ! !PUBLIC MEMBER FUNCTIONS:
- public :: clm_ptrs_compdown ! fill in data pointing down
- public :: clm_ptrs_check ! checks and writes out a summary of subgrid data
- public :: add_landunit ! add an entry in the landunit-level arrays
- public :: add_column ! add an entry in the column-level arrays
- public :: add_patch ! add an entry in the patch-level arrays
- !
-
- character(len=*), parameter, private :: sourcefile = &
- __FILE__
- !-----------------------------------------------------------------------
-
-contains
-
- !------------------------------------------------------------------------------
- subroutine clm_ptrs_compdown(bounds)
- !
- ! !DESCRIPTION:
- ! Assumes the part of the subgrid pointing up has been set. Fills
- ! in the data pointing down. Up is p_c, p_l, p_g, c_l, c_g, and l_g.
- !
- ! This algorithm assumes all indices besides grid cell are monotonically
- ! increasing. (Note that grid cell index is NOT monotonically increasing,
- ! hence we cannot set initial & final indices at the grid cell level -
- ! grc%luni, grc%lunf, etc.)
- !
- ! Algorithm works as follows. The p, c, and l loops march through
- ! the full arrays (nump, numc, and numl) checking the "up" indexes.
- ! As soon as the "up" index of the current (p,c,l) cell changes relative
- ! to the previous (p,c,l) cell, the *i array will be set to point down
- ! to that cell. The *f array follows the same logic, so it's always the
- ! last "up" index from the previous cell when an "up" index changes.
- !
- ! For example, a case where p_c(1:4) = 1 and p_c(5:12) = 2. This
- ! subroutine will set c_pi(1) = 1, c_pf(1) = 4, c_pi(2) = 5, c_pf(2) = 12.
- !
- ! !USES
- use clm_varcon, only : ispval
- !
- ! !ARGUMENTS
- implicit none
- type(bounds_type), intent(in) :: bounds ! bounds
- !
- ! !LOCAL VARIABLES:
- integer :: l,c,p ! loop counters
- integer :: curg,curl,curc,curp ! tracks g,l,c,p indexes in arrays
- integer :: ltype ! landunit type
- !------------------------------------------------------------------------------
-
- !--- Set the current c,l (curc, curl) to zero for initialization,
- !--- these indices track the current "up" index.
- !--- Take advantage of locality of l/c/p cells
- !--- Loop p through full local begp:endp length
- !--- Separately check the p_c, p_l, and p_g indexes for a change in
- !--- the "up" index.
- !--- If there is a change, verify that the current c,l,g is within the
- !--- valid range, and set c_pi, l_pi, or g_pi to that current c,l,g
- !--- Constantly update the c_pf, l_pf, and g_pf array. When the
- !--- g, l, c index changes, the *_pf array will be set correctly
- !--- Do the same for cols setting c_li, c_gi, c_lf, c_gf and
- !--- lunits setting l_gi, l_gf.
-
- curc = 0
- curl = 0
- do p = bounds%begp,bounds%endp
- if (patch%column(p) /= curc) then
- curc = patch%column(p)
- if (curc < bounds%begc .or. curc > bounds%endc) then
- write(iulog,*) 'clm_ptrs_compdown ERROR: pcolumn ',p,curc,bounds%begc,bounds%endc
- call endrun(decomp_index=p, clmlevel=namep, msg=errMsg(sourcefile, __LINE__))
- endif
- col%patchi(curc) = p
- endif
- col%patchf(curc) = p
- col%npatches(curc) = col%patchf(curc) - col%patchi(curc) + 1
- if (patch%landunit(p) /= curl) then
- curl = patch%landunit(p)
- if (curl < bounds%begl .or. curl > bounds%endl) then
- write(iulog,*) 'clm_ptrs_compdown ERROR: plandunit ',p,curl,bounds%begl,bounds%endl
- call endrun(decomp_index=p, clmlevel=namep, msg=errMsg(sourcefile, __LINE__))
- endif
- lun%patchi(curl) = p
- endif
- lun%patchf(curl) = p
- lun%npatches(curl) = lun%patchf(curl) - lun%patchi(curl) + 1
- enddo
-
- curl = 0
- do c = bounds%begc,bounds%endc
- if (col%landunit(c) /= curl) then
- curl = col%landunit(c)
- if (curl < bounds%begl .or. curl > bounds%endl) then
- write(iulog,*) 'clm_ptrs_compdown ERROR: clandunit ',c,curl,bounds%begl,bounds%endl
- call endrun(decomp_index=c, clmlevel=namec, msg=errMsg(sourcefile, __LINE__))
- endif
- lun%coli(curl) = c
- endif
- lun%colf(curl) = c
- lun%ncolumns(curl) = lun%colf(curl) - lun%coli(curl) + 1
- enddo
-
- ! Determine landunit_indices: indices into landunit-level arrays for each grid cell.
- ! Note that landunits not present in a given grid cell are set to ispval.
- grc%landunit_indices(:,bounds%begg:bounds%endg) = ispval
- do l = bounds%begl,bounds%endl
- ltype = lun%itype(l)
- curg = lun%gridcell(l)
- if (curg < bounds%begg .or. curg > bounds%endg) then
- write(iulog,*) 'clm_ptrs_compdown ERROR: landunit_indices ', l,curg,bounds%begg,bounds%endg
- call endrun(decomp_index=l, clmlevel=namel, msg=errMsg(sourcefile, __LINE__))
- end if
-
- if (grc%landunit_indices(ltype, curg) == ispval) then
- grc%landunit_indices(ltype, curg) = l
- else
- write(iulog,*) 'clm_ptrs_compdown ERROR: This landunit type has already been set for this gridcell'
- write(iulog,*) 'l, ltype, curg = ', l, ltype, curg
- call endrun(decomp_index=l, clmlevel=namel, msg=errMsg(sourcefile, __LINE__))
- end if
- end do
-
- end subroutine clm_ptrs_compdown
-
- !------------------------------------------------------------------------------
- subroutine clm_ptrs_check(bounds)
- !
- ! !DESCRIPTION:
- ! Checks and writes out a summary of subgrid data
- !
- ! !USES
- use clm_varcon, only : ispval
- use landunit_varcon, only : max_lunit
- !
- ! !ARGUMENTS
- implicit none
- type(bounds_type), intent(in) :: bounds
- !
- ! !LOCAL VARIABLES:
- integer :: g,l,c,p ! loop counters
- integer :: l_prev ! l value of previous point
- integer :: ltype ! landunit type
- logical :: error ! error flag
- !------------------------------------------------------------------------------
-
- associate( &
- begg => bounds%begg, &
- endg => bounds%endg, &
- begl => bounds%begl, &
- endl => bounds%endl, &
- begc => bounds%begc, &
- endc => bounds%endc, &
- begp => bounds%begp, &
- endp => bounds%endp &
- )
-
- if (masterproc) write(iulog,*) ' '
- if (masterproc) write(iulog,*) '---clm_ptrs_check:'
-
- !--- check index ranges ---
- error = .false.
- do g = begg, endg
- do ltype = 1, max_lunit
- l = grc%landunit_indices(ltype, g)
- if (l /= ispval) then
- if (l < begl .or. l > endl) error = .true.
- end if
- end do
- end do
- if (error) then
- write(iulog,*) ' clm_ptrs_check: g index ranges - ERROR'
- call endrun(msg=errMsg(sourcefile, __LINE__))
- end if
- if (masterproc) write(iulog,*) ' clm_ptrs_check: g index ranges - OK'
-
- error = .false.
- if (minval(lun%gridcell(begl:endl)) < begg .or. maxval(lun%gridcell(begl:endl)) > endg) error=.true.
- if (minval(lun%coli(begl:endl)) < begc .or. maxval(lun%coli(begl:endl)) > endc) error=.true.
- if (minval(lun%colf(begl:endl)) < begc .or. maxval(lun%colf(begl:endl)) > endc) error=.true.
- if (minval(lun%patchi(begl:endl)) < begp .or. maxval(lun%patchi(begl:endl)) > endp) error=.true.
- if (minval(lun%patchf(begl:endl)) < begp .or. maxval(lun%patchf(begl:endl)) > endp) error=.true.
- if (error) then
- write(iulog,*) ' clm_ptrs_check: l index ranges - ERROR'
- call endrun(msg=errMsg(sourcefile, __LINE__))
- endif
- if (masterproc) write(iulog,*) ' clm_ptrs_check: l index ranges - OK'
-
- error = .false.
- if (minval(col%gridcell(begc:endc)) < begg .or. maxval(col%gridcell(begc:endc)) > endg) error=.true.
- if (minval(col%landunit(begc:endc)) < begl .or. maxval(col%landunit(begc:endc)) > endl) error=.true.
- if (minval(col%patchi(begc:endc)) < begp .or. maxval(col%patchi(begc:endc)) > endp) error=.true.
- if (minval(col%patchf(begc:endc)) < begp .or. maxval(col%patchf(begc:endc)) > endp) error=.true.
- if (error) then
- write(iulog,*) ' clm_ptrs_check: c index ranges - ERROR'
- call endrun(msg=errMsg(sourcefile, __LINE__))
- endif
- if (masterproc) write(iulog,*) ' clm_ptrs_check: c index ranges - OK'
-
- error = .false.
- if (minval(patch%gridcell(begp:endp)) < begg .or. maxval(patch%gridcell(begp:endp)) > endg) error=.true.
- if (minval(patch%landunit(begp:endp)) < begl .or. maxval(patch%landunit(begp:endp)) > endl) error=.true.
- if (minval(patch%column(begp:endp)) < begc .or. maxval(patch%column(begp:endp)) > endc) error=.true.
- if (error) then
- write(iulog,*) ' clm_ptrs_check: p index ranges - ERROR'
- call endrun(msg=errMsg(sourcefile, __LINE__))
- endif
- if (masterproc) write(iulog,*) ' clm_ptrs_check: p index ranges - OK'
-
- !--- check that indices in arrays are monotonically increasing ---
- error = .false.
- do l=begl+1,endl
- if ((lun%itype(l) == lun%itype(l-1)) .and. &
- lun%gridcell(l) < lun%gridcell(l-1)) then
- ! grid cell indices should be monotonically increasing for a given landunit type
- error = .true.
- end if
- if (lun%coli(l) < lun%coli(l-1)) error = .true.
- if (lun%colf(l) < lun%colf(l-1)) error = .true.
- if (lun%patchi(l) < lun%patchi(l-1)) error = .true.
- if (lun%patchf(l) < lun%patchf(l-1)) error = .true.
- if (error) then
- write(iulog,*) ' clm_ptrs_check: l mono increasing - ERROR'
- call endrun(decomp_index=l, clmlevel=namel, msg=errMsg(sourcefile, __LINE__))
- endif
- enddo
- if (masterproc) write(iulog,*) ' clm_ptrs_check: l mono increasing - OK'
-
- error = .false.
- do c=begc+1,endc
- l = col%landunit(c)
- l_prev = col%landunit(c-1)
- if ((lun%itype(l) == lun%itype(l_prev)) .and. &
- col%gridcell(c) < col%gridcell(c-1)) then
- ! grid cell indices should be monotonically increasing for a given landunit type
- error = .true.
- end if
- if (col%landunit(c) < col%landunit(c-1)) error = .true.
- if (col%patchi(c) < col%patchi(c-1)) error = .true.
- if (col%patchf(c) < col%patchf(c-1)) error = .true.
- if (error) then
- write(iulog,*) ' clm_ptrs_check: c mono increasing - ERROR'
- call endrun(decomp_index=c, clmlevel=namec, msg=errMsg(sourcefile, __LINE__))
- endif
- enddo
- if (masterproc) write(iulog,*) ' clm_ptrs_check: c mono increasing - OK'
-
- error = .false.
- do p=begp+1,endp
- l = patch%landunit(p)
- l_prev = patch%landunit(p-1)
- if ((lun%itype(l) == lun%itype(l_prev)) .and. &
- patch%gridcell(p) < patch%gridcell(p-1)) then
- ! grid cell indices should be monotonically increasing for a given landunit type
- error = .true.
- end if
- if (patch%landunit(p) < patch%landunit(p-1)) error = .true.
- if (patch%column (p) < patch%column (p-1)) error = .true.
- if (error) then
- write(iulog,*) ' clm_ptrs_check: p mono increasing - ERROR'
- call endrun(decomp_index=p, clmlevel=namep, msg=errMsg(sourcefile, __LINE__))
- endif
- enddo
- if (masterproc) write(iulog,*) ' clm_ptrs_check: p mono increasing - OK'
-
- !--- check that the tree is internally consistent ---
- error = .false.
- do g = begg, endg
- do ltype = 1, max_lunit
- l = grc%landunit_indices(ltype, g)
-
- ! skip l == ispval, which implies that this landunit type doesn't exist on this grid cell
- if (l /= ispval) then
- if (lun%itype(l) /= ltype) error = .true.
- if (lun%gridcell(l) /= g) error = .true.
- if (error) then
- write(iulog,*) ' clm_ptrs_check: tree consistent - ERROR'
- call endrun(decomp_index=l, clmlevel=namel, msg=errMsg(sourcefile, __LINE__))
- endif
- do c = lun%coli(l),lun%colf(l)
- if (col%gridcell(c) /= g) error = .true.
- if (col%landunit(c) /= l) error = .true.
- if (error) then
- write(iulog,*) ' clm_ptrs_check: tree consistent - ERROR'
- call endrun(decomp_index=c, clmlevel=namec, msg=errMsg(sourcefile, __LINE__))
- endif
- do p = col%patchi(c),col%patchf(c)
- if (patch%gridcell(p) /= g) error = .true.
- if (patch%landunit(p) /= l) error = .true.
- if (patch%column(p) /= c) error = .true.
- if (error) then
- write(iulog,*) ' clm_ptrs_check: tree consistent - ERROR'
- call endrun(decomp_index=p, clmlevel=namep, msg=errMsg(sourcefile, __LINE__))
- endif
- enddo ! p
- enddo ! c
- end if ! l /= ispval
- enddo ! ltype
- enddo ! g
- if (masterproc) write(iulog,*) ' clm_ptrs_check: tree consistent - OK'
- if (masterproc) write(iulog,*) ' '
-
- end associate
-
- end subroutine clm_ptrs_check
-
- !-----------------------------------------------------------------------
- subroutine add_landunit(li, gi, ltype, wtgcell)
- !
- ! !DESCRIPTION:
- ! Add an entry in the landunit-level arrays. li gives the index of the last landunit
- ! added; the new landunit is added at li+1, and the li argument is incremented
- ! accordingly.
- !
- ! !USES:
- use landunit_varcon , only : istice_mec, istdlak, isturb_MIN, isturb_MAX, landunit_is_special
- !
- ! !ARGUMENTS:
- integer , intent(inout) :: li ! input value is index of last landunit added; output value is index of this newly-added landunit
- integer , intent(in) :: gi ! grid cell index on which this landunit should be placed
- integer , intent(in) :: ltype ! landunit type
- real(r8) , intent(in) :: wtgcell ! weight of the landunit relative to the grid cell
- !
- ! !LOCAL VARIABLES:
-
- character(len=*), parameter :: subname = 'add_landunit'
- !-----------------------------------------------------------------------
-
- li = li + 1
-
- lun%gridcell(li) = gi
- lun%wtgcell(li) = wtgcell
- lun%itype(li) = ltype
-
- lun%ifspecial(li) = landunit_is_special(ltype)
-
- if (ltype == istice_mec) then
- lun%glcmecpoi(li) = .true.
- else
- lun%glcmecpoi(li) = .false.
- end if
-
- if (ltype == istdlak) then
- lun%lakpoi(li) = .true.
- else
- lun%lakpoi(li) = .false.
- end if
-
- if (ltype >= isturb_MIN .and. ltype <= isturb_MAX) then
- lun%urbpoi(li) = .true.
- else
- lun%urbpoi(li) = .false.
- end if
-
- end subroutine add_landunit
-
- !-----------------------------------------------------------------------
- subroutine add_column(ci, li, ctype, wtlunit, type_is_dynamic)
- !
- ! !DESCRIPTION:
- ! Add an entry in the column-level arrays. ci gives the index of the last column
- ! added; the new column is added at ci+1, and the ci argument is incremented
- ! accordingly.
- !
- ! !ARGUMENTS:
- integer , intent(inout) :: ci ! input value is index of last column added; output value is index of this newly-added column
- integer , intent(in) :: li ! landunit index on which this column should be placed (assumes this landunit has already been created)
- integer , intent(in) :: ctype ! column type
- real(r8) , intent(in) :: wtlunit ! weight of the column relative to the landunit
-
- ! whether this column's type can change at runtime; if not provided, assumed to be false
- logical , intent(in), optional :: type_is_dynamic
- !
- ! !LOCAL VARIABLES:
- logical :: l_type_is_dynamic ! local version of type_is_dynamic
-
- character(len=*), parameter :: subname = 'add_column'
- !-----------------------------------------------------------------------
-
- l_type_is_dynamic = .false.
- if (present(type_is_dynamic)) then
- l_type_is_dynamic = type_is_dynamic
- end if
-
- ci = ci + 1
-
- col%landunit(ci) = li
- col%gridcell(ci) = lun%gridcell(li)
- col%wtlunit(ci) = wtlunit
- col%itype(ci) = ctype
- col%type_is_dynamic(ci) = l_type_is_dynamic
- col%hydrologically_active(ci) = is_hydrologically_active( &
- col_itype = ctype, &
- lun_itype = lun%itype(li))
-
- end subroutine add_column
-
- !-----------------------------------------------------------------------
- subroutine add_patch(pi, ci, ptype, wtcol)
- !
- ! !DESCRIPTION:
- ! Add an entry in the patch-level arrays. pi gives the index of the last patch added; the
- ! new patch is added at pi+1, and the pi argument is incremented accordingly.
- !
- ! !USES:
- use clm_varcon , only : ispval
- use landunit_varcon , only : istsoil, istcrop
- use clm_varpar , only : natpft_lb
- !
- ! !ARGUMENTS:
- integer , intent(inout) :: pi ! input value is index of last patch added; output value is index of this newly-added patch
- integer , intent(in) :: ci ! column index on which this patch should be placed (assumes this column has already been created)
- integer , intent(in) :: ptype ! patch type
- real(r8) , intent(in) :: wtcol ! weight of the patch relative to the column
- !
- ! !LOCAL VARIABLES:
- integer :: li ! landunit index
- integer :: lb_offset ! offset between natpft_lb and 1
-
- character(len=*), parameter :: subname = 'add_patch'
- !-----------------------------------------------------------------------
-
- pi = pi + 1
-
- patch%column(pi) = ci
- li = col%landunit(ci)
- patch%landunit(pi) = li
- patch%gridcell(pi) = col%gridcell(ci)
-
- patch%wtcol(pi) = wtcol
-
- ! TODO (MV, 10-17-14): The following must be commented out because
- ! currently patch%itype is used in CanopyTemperatureMod to calculate
- ! z0m(p) and displa(p) - and is still called even when fates is on
-
- !if (.not. use_fates) then
- patch%itype(pi) = ptype
- !end if
-
- if (lun%itype(li) == istsoil .or. lun%itype(li) == istcrop) then
- lb_offset = 1 - natpft_lb
- patch%mxy(pi) = ptype + lb_offset
- else
- patch%mxy(pi) = ispval
- end if
-
-
- end subroutine add_patch
-
-
-end module initSubgridMod
diff --git a/src/main/initVerticalMod.F90 b/src/main/initVerticalMod.F90
deleted file mode 100644
index c4f3f9a8..00000000
--- a/src/main/initVerticalMod.F90
+++ /dev/null
@@ -1,794 +0,0 @@
-module initVerticalMod
-
-#include "shr_assert.h"
-
- !-----------------------------------------------------------------------
- ! !DESCRIPTION:
- ! Initialize vertical components of column datatype
- !
- use shr_kind_mod , only : r8 => shr_kind_r8
- use shr_infnan_mod , only : nan => shr_infnan_nan, assignment(=)
- use shr_log_mod , only : errMsg => shr_log_errMsg
- use shr_sys_mod , only : shr_sys_abort
- use decompMod , only : bounds_type
- use spmdMod , only : masterproc
- use clm_varpar , only : nlevsno, nlevgrnd, nlevlak
- use clm_varpar , only : toplev_equalspace, nlev_equalspace
- use clm_varpar , only : nlevsoi, nlevsoifl, nlevurb
- use clm_varctl , only : fsurdat, iulog
- use clm_varctl , only : use_vancouver, use_mexicocity, use_vertsoilc, use_extralakelayers
- use clm_varctl , only : use_bedrock, soil_layerstruct
- use clm_varctl , only : use_fates
- use clm_varcon , only : zlak, dzlak, zsoi, dzsoi, zisoi, dzsoi_decomp, spval, ispval, grlnd
- use column_varcon , only : icol_roof, icol_sunwall, icol_shadewall, is_hydrologically_active
- use landunit_varcon , only : istdlak, istice_mec
- use fileutils , only : getfil
- use LandunitType , only : lun
- use GridcellType , only : grc
- use ColumnType , only : col
- use glcBehaviorMod , only : glc_behavior_type
- use abortUtils , only : endrun
- use ncdio_pio
- !
- ! !PUBLIC TYPES:
- implicit none
- save
- private
- !
- ! !PUBLIC MEMBER FUNCTIONS:
- public :: initVertical
- ! !PRIVATE MEMBER FUNCTIONS:
- private :: ReadNL
- private :: hasBedrock ! true if the given column type includes bedrock layers
- !
-
- character(len=*), parameter, private :: sourcefile = &
- __FILE__
-
- !
- !------------------------------------------------------------------------
-
-contains
-
- !------------------------------------------------------------------------
- subroutine ReadNL( )
- !
- ! !DESCRIPTION:
- ! Read namelist for SoilStateType
- !
- ! !USES:
- use shr_mpi_mod , only : shr_mpi_bcast
- use shr_log_mod , only : errMsg => shr_log_errMsg
- use fileutils , only : getavu, relavu, opnfil
- use clm_nlUtilsMod , only : find_nlgroup_name
- use clm_varctl , only : iulog
- use spmdMod , only : mpicom, masterproc
- use controlMod , only : NLFilename
- !
- ! !ARGUMENTS:
- !
- ! !LOCAL VARIABLES:
- integer :: ierr ! error code
- integer :: unitn ! unit for namelist file
- character(len=32) :: subname = 'InitVertical_readnl' ! subroutine name
- !-----------------------------------------------------------------------
-
- character(len=*), parameter :: nl_name = 'clm_inparm' ! Namelist name
-
- ! MUST agree with name in namelist and read
- namelist /clm_inparm/ use_bedrock
-
- ! preset values
-
- use_bedrock = .false.
-
- if ( masterproc )then
-
- unitn = getavu()
- write(iulog,*) 'Read in '//nl_name//' namelist'
- call opnfil (NLFilename, unitn, 'F')
- call find_nlgroup_name(unitn, nl_name, status=ierr)
- if (ierr == 0) then
- read(unit=unitn, nml=clm_inparm, iostat=ierr)
- if (ierr /= 0) then
- call endrun(msg="ERROR reading '//nl_name//' namelist"//errmsg(sourcefile, __LINE__))
- end if
- else
- call endrun(msg="ERROR finding '//nl_name//' namelist"//errmsg(sourcefile, __LINE__))
- end if
- call relavu( unitn )
-
- end if
-
- call shr_mpi_bcast(use_bedrock, mpicom)
-
- end subroutine ReadNL
-
- !------------------------------------------------------------------------
- subroutine initVertical(bounds, glc_behavior, snow_depth, thick_wall, thick_roof)
- use clm_varcon, only : zmin_bedrock, n_melt_glcmec
- !
- ! !ARGUMENTS:
- type(bounds_type) , intent(in) :: bounds
- type(glc_behavior_type), intent(in) :: glc_behavior
- real(r8) , intent(in) :: snow_depth(bounds%begc:)
- real(r8) , intent(in) :: thick_wall(bounds%begl:)
- real(r8) , intent(in) :: thick_roof(bounds%begl:)
- !
- ! LOCAL VARAIBLES:
- integer :: c,l,g,i,j,lev ! indices
- type(file_desc_t) :: ncid ! netcdf id
- logical :: readvar
- integer :: dimid ! dimension id
- character(len=256) :: locfn ! local filename
- real(r8) ,pointer :: std (:) ! read in - topo_std
- real(r8) ,pointer :: tslope (:) ! read in - topo_slope
- real(r8) :: slope0 ! temporary
- real(r8) :: slopebeta ! temporary
- real(r8) :: slopemax ! temporary
- integer :: ier ! error status
- real(r8) :: scalez = 0.025_r8 ! Soil layer thickness discretization (m)
- real(r8) :: thick_equal = 0.2
- real(r8) ,pointer :: zbedrock_in(:) ! read in - z_bedrock
- real(r8) ,pointer :: lakedepth_in(:) ! read in - lakedepth
- real(r8), allocatable :: zurb_wall(:,:) ! wall (layer node depth)
- real(r8), allocatable :: zurb_roof(:,:) ! roof (layer node depth)
- real(r8), allocatable :: dzurb_wall(:,:) ! wall (layer thickness)
- real(r8), allocatable :: dzurb_roof(:,:) ! roof (layer thickness)
- real(r8), allocatable :: ziurb_wall(:,:) ! wall (layer interface)
- real(r8), allocatable :: ziurb_roof(:,:) ! roof (layer interface)
- real(r8) :: depthratio ! ratio of lake depth to standard deep lake depth
- integer :: begc, endc
- integer :: begl, endl
- integer :: jmin_bedrock
-
- ! Possible values for levgrnd_class. The important thing is that, for a given column,
- ! layers that are fundamentally different (e.g., soil vs bedrock) have different
- ! values. This information is used in the vertical interpolation in init_interp.
- !
- ! IMPORTANT: These values should not be changed lightly. e.g., try to avoid changing
- ! the values assigned to LEVGRND_CLASS_STANDARD, LEVGRND_CLASS_DEEP_BEDROCK, etc. The
- ! problem with changing these is that init_interp expects that layers with a value of
- ! (e.g.) 1 on the source file correspond to layers with a value of 1 on the
- ! destination file. So if you change the values of these constants, you either need to
- ! adequately inform users of this change, or build in some translation mechanism in
- ! init_interp (such as via adding more metadata to the restart file on the meaning of
- ! these different values).
- !
- ! The distinction between "shallow" and "deep" bedrock is not made explicitly
- ! elsewhere. But, since these classes have somewhat different behavior, they are
- ! distinguished explicitly here.
- integer, parameter :: LEVGRND_CLASS_STANDARD = 1
- integer, parameter :: LEVGRND_CLASS_DEEP_BEDROCK = 2
- integer, parameter :: LEVGRND_CLASS_SHALLOW_BEDROCK = 3
- !------------------------------------------------------------------------
-
- begc = bounds%begc; endc= bounds%endc
- begl = bounds%begl; endl= bounds%endl
-
- SHR_ASSERT_ALL((ubound(snow_depth) == (/endc/)), errMsg(sourcefile, __LINE__))
- SHR_ASSERT_ALL((ubound(thick_wall) == (/endl/)), errMsg(sourcefile, __LINE__))
- SHR_ASSERT_ALL((ubound(thick_roof) == (/endl/)), errMsg(sourcefile, __LINE__))
-
- ! Open surface dataset to read in data below
-
- call getfil (fsurdat, locfn, 0)
- call ncd_pio_openfile (ncid, locfn, 0)
-
- ! --------------------------------------------------------------------
- ! Define layer structure for soil, lakes, urban walls and roof
- ! Vertical profile of snow is not initialized here - but below
- ! --------------------------------------------------------------------
-
- ! Soil layers and interfaces (assumed same for all non-lake patches)
- ! "0" refers to soil surface and "nlevsoi" refers to the bottom of model soil
-
- if ( soil_layerstruct == '10SL_3.5m' ) then
- do j = 1, nlevgrnd
- zsoi(j) = scalez*(exp(0.5_r8*(j-0.5_r8))-1._r8) !node depths
- enddo
-
- dzsoi(1) = 0.5_r8*(zsoi(1)+zsoi(2)) !thickness b/n two interfaces
- do j = 2,nlevgrnd-1
- dzsoi(j)= 0.5_r8*(zsoi(j+1)-zsoi(j-1))
- enddo
- dzsoi(nlevgrnd) = zsoi(nlevgrnd)-zsoi(nlevgrnd-1)
-
- zisoi(0) = 0._r8
- do j = 1, nlevgrnd-1
- zisoi(j) = 0.5_r8*(zsoi(j)+zsoi(j+1)) !interface depths
- enddo
- zisoi(nlevgrnd) = zsoi(nlevgrnd) + 0.5_r8*dzsoi(nlevgrnd)
-
- else if ( soil_layerstruct == '23SL_3.5m' )then
- ! Soil layer structure that starts with standard exponential
- ! and then has several evenly spaced layers, then finishes off exponential.
- ! this allows the upper soil to behave as standard, but then continues
- ! with higher resolution to a deeper depth, so that, for example, permafrost
- ! dynamics are not lost due to an inability to resolve temperature, moisture,
- ! and biogeochemical dynamics at the base of the active layer
- do j = 1, toplev_equalspace
- zsoi(j) = scalez*(exp(0.5_r8*(j-0.5_r8))-1._r8) !node depths
- enddo
-
- do j = toplev_equalspace+1,toplev_equalspace + nlev_equalspace
- zsoi(j) = zsoi(j-1) + thick_equal
- enddo
-
- do j = toplev_equalspace + nlev_equalspace +1, nlevgrnd
- zsoi(j) = scalez*(exp(0.5_r8*((j - nlev_equalspace)-0.5_r8))-1._r8) + nlev_equalspace * thick_equal
- enddo
-
- dzsoi(1) = 0.5_r8*(zsoi(1)+zsoi(2)) !thickness b/n two interfaces
- do j = 2,nlevgrnd-1
- dzsoi(j)= 0.5_r8*(zsoi(j+1)-zsoi(j-1))
- enddo
- dzsoi(nlevgrnd) = zsoi(nlevgrnd)-zsoi(nlevgrnd-1)
-
- zisoi(0) = 0._r8
- do j = 1, nlevgrnd-1
- zisoi(j) = 0.5_r8*(zsoi(j)+zsoi(j+1)) !interface depths
- enddo
- zisoi(nlevgrnd) = zsoi(nlevgrnd) + 0.5_r8*dzsoi(nlevgrnd)
-
- else if ( soil_layerstruct == '49SL_10m' ) then
- !scs: 10 meter soil column, nlevsoi set to 49 in clm_varpar
- do j = 1,10
- dzsoi(j)= 1.e-2_r8 !10mm layers
- enddo
- do j = 11,19
- dzsoi(j)= 1.e-1_r8 !100 mm layers
- enddo
- do j = 20,nlevsoi+1 !300 mm layers
- dzsoi(j)= 3.e-1_r8
- enddo
- do j = nlevsoi+2,nlevgrnd !10 meter bedrock layers
- dzsoi(j)= 10._r8
- enddo
-
- zisoi(0) = 0._r8
- do j = 1,nlevgrnd
- zisoi(j)= sum(dzsoi(1:j))
- enddo
-
- do j = 1, nlevgrnd
- zsoi(j) = 0.5*(zisoi(j-1) + zisoi(j))
- enddo
-
- else if ( soil_layerstruct == '20SL_8.5m' ) then
- do j = 1,4
- dzsoi(j)= j*0.02_r8 ! linear increase in layer thickness of 2cm each layer
- enddo
- do j = 5,13
- dzsoi(j)= dzsoi(4)+(j-4)*0.04_r8 ! linear increase in layer thickness of 2cm each layer
- enddo
- do j = 14,nlevsoi
- dzsoi(j)= dzsoi(13)+(j-13)*0.10_r8 ! linear increase in layer thickness of 2cm each layer
- enddo
- do j = nlevsoi+1,nlevgrnd !bedrock layers
- dzsoi(j)= dzsoi(nlevsoi)+(((j-nlevsoi)*25._r8)**1.5_r8)/100._r8 ! bedrock layers
- enddo
-
- zisoi(0) = 0._r8
- do j = 1,nlevgrnd
- zisoi(j)= sum(dzsoi(1:j))
- enddo
-
- do j = 1, nlevgrnd
- zsoi(j) = 0.5*(zisoi(j-1) + zisoi(j))
- enddo
- end if
-
- ! define a vertical grid spacing such that it is the normal dzsoi if
- ! nlevdecomp =nlevgrnd, or else 1 meter
- if (use_vertsoilc) then
- dzsoi_decomp = dzsoi !thickness b/n two interfaces
- else
- dzsoi_decomp(1) = 1.
- end if
-
- if (masterproc) then
- write(iulog, *) 'zsoi', zsoi(:)
- write(iulog, *) 'zisoi: ', zisoi(:)
- write(iulog, *) 'dzsoi: ', dzsoi(:)
- write(iulog, *) 'dzsoi_decomp: ',dzsoi_decomp
- end if
-
- if (nlevurb > 0) then
- allocate(zurb_wall(bounds%begl:bounds%endl,nlevurb), &
- zurb_roof(bounds%begl:bounds%endl,nlevurb), &
- dzurb_wall(bounds%begl:bounds%endl,nlevurb), &
- dzurb_roof(bounds%begl:bounds%endl,nlevurb), &
- ziurb_wall(bounds%begl:bounds%endl,0:nlevurb), &
- ziurb_roof(bounds%begl:bounds%endl,0:nlevurb), &
- stat=ier)
- if (ier /= 0) then
- call shr_sys_abort(' ERROR allocation error for '//&
- 'zurb_wall,zurb_roof,dzurb_wall,dzurb_roof,ziurb_wall,ziurb_roof'//&
- errMsg(sourcefile, __LINE__))
- end if
- end if
-
- ! Column level initialization for urban wall and roof layers and interfaces
- do l = bounds%begl,bounds%endl
-
- ! "0" refers to urban wall/roof surface and "nlevsoi" refers to urban wall/roof bottom
- if (lun%urbpoi(l)) then
- if (use_vancouver) then
- zurb_wall(l,1) = 0.010_r8/2._r8
- zurb_wall(l,2) = zurb_wall(l,1) + 0.010_r8/2._r8 + 0.020_r8/2._r8
- zurb_wall(l,3) = zurb_wall(l,2) + 0.020_r8/2._r8 + 0.070_r8/2._r8
- zurb_wall(l,4) = zurb_wall(l,3) + 0.070_r8/2._r8 + 0.070_r8/2._r8
- zurb_wall(l,5) = zurb_wall(l,4) + 0.070_r8/2._r8 + 0.030_r8/2._r8
-
- zurb_roof(l,1) = 0.010_r8/2._r8
- zurb_roof(l,2) = zurb_roof(l,1) + 0.010_r8/2._r8 + 0.010_r8/2._r8
- zurb_roof(l,3) = zurb_roof(l,2) + 0.010_r8/2._r8 + 0.010_r8/2._r8
- zurb_roof(l,4) = zurb_roof(l,3) + 0.010_r8/2._r8 + 0.010_r8/2._r8
- zurb_roof(l,5) = zurb_roof(l,4) + 0.010_r8/2._r8 + 0.030_r8/2._r8
-
- dzurb_wall(l,1) = 0.010_r8
- dzurb_wall(l,2) = 0.020_r8
- dzurb_wall(l,3) = 0.070_r8
- dzurb_wall(l,4) = 0.070_r8
- dzurb_wall(l,5) = 0.030_r8
- write(iulog,*)'Total thickness of wall: ',sum(dzurb_wall(l,:))
- write(iulog,*)'Wall layer thicknesses: ',dzurb_wall(l,:)
-
- dzurb_roof(l,1) = 0.010_r8
- dzurb_roof(l,2) = 0.010_r8
- dzurb_roof(l,3) = 0.010_r8
- dzurb_roof(l,4) = 0.010_r8
- dzurb_roof(l,5) = 0.030_r8
- write(iulog,*)'Total thickness of roof: ',sum(dzurb_roof(l,:))
- write(iulog,*)'Roof layer thicknesses: ',dzurb_roof(l,:)
-
- ziurb_wall(l,0) = 0.
- ziurb_wall(l,1) = dzurb_wall(l,1)
- do j = 2,nlevurb
- ziurb_wall(l,j) = sum(dzurb_wall(l,1:j))
- end do
- write(iulog,*)'Wall layer interface depths: ',ziurb_wall(l,:)
-
- ziurb_roof(l,0) = 0.
- ziurb_roof(l,1) = dzurb_roof(l,1)
- do j = 2,nlevurb
- ziurb_roof(l,j) = sum(dzurb_roof(l,1:j))
- end do
- write(iulog,*)'Roof layer interface depths: ',ziurb_roof(l,:)
- else if (use_mexicocity) then
- zurb_wall(l,1) = 0.015_r8/2._r8
- zurb_wall(l,2) = zurb_wall(l,1) + 0.015_r8/2._r8 + 0.120_r8/2._r8
- zurb_wall(l,3) = zurb_wall(l,2) + 0.120_r8/2._r8 + 0.150_r8/2._r8
- zurb_wall(l,4) = zurb_wall(l,3) + 0.150_r8/2._r8 + 0.150_r8/2._r8
- zurb_wall(l,5) = zurb_wall(l,4) + 0.150_r8/2._r8 + 0.015_r8/2._r8
-
- zurb_roof(l,1) = 0.010_r8/2._r8
- zurb_roof(l,2) = zurb_roof(l,1) + 0.010_r8/2._r8 + 0.050_r8/2._r8
- zurb_roof(l,3) = zurb_roof(l,2) + 0.050_r8/2._r8 + 0.050_r8/2._r8
- zurb_roof(l,4) = zurb_roof(l,3) + 0.050_r8/2._r8 + 0.050_r8/2._r8
- zurb_roof(l,5) = zurb_roof(l,4) + 0.050_r8/2._r8 + 0.025_r8/2._r8
-
- dzurb_wall(l,1) = 0.015_r8
- dzurb_wall(l,2) = 0.120_r8
- dzurb_wall(l,3) = 0.150_r8
- dzurb_wall(l,4) = 0.150_r8
- dzurb_wall(l,5) = 0.015_r8
- write(iulog,*)'Total thickness of wall: ',sum(dzurb_wall(l,:))
- write(iulog,*)'Wall layer thicknesses: ',dzurb_wall(l,:)
-
- dzurb_roof(l,1) = 0.010_r8
- dzurb_roof(l,2) = 0.050_r8
- dzurb_roof(l,3) = 0.050_r8
- dzurb_roof(l,4) = 0.050_r8
- dzurb_roof(l,5) = 0.025_r8
- write(iulog,*)'Total thickness of roof: ',sum(dzurb_roof(l,:))
- write(iulog,*)'Roof layer thicknesses: ',dzurb_roof(l,:)
-
- ziurb_wall(l,0) = 0.
- ziurb_wall(l,1) = dzurb_wall(l,1)
- do j = 2,nlevurb
- ziurb_wall(l,j) = sum(dzurb_wall(l,1:j))
- end do
- write(iulog,*)'Wall layer interface depths: ',ziurb_wall(l,:)
-
- ziurb_roof(l,0) = 0.
- ziurb_roof(l,1) = dzurb_roof(l,1)
- do j = 2,nlevurb
- ziurb_roof(l,j) = sum(dzurb_roof(l,1:j))
- end do
- write(iulog,*)'Roof layer interface depths: ',ziurb_roof(l,:)
- else
- do j = 1, nlevurb
- zurb_wall(l,j) = (j-0.5)*(thick_wall(l)/float(nlevurb)) !node depths
- end do
- do j = 1, nlevurb
- zurb_roof(l,j) = (j-0.5)*(thick_roof(l)/float(nlevurb)) !node depths
- end do
-
- dzurb_roof(l,1) = 0.5*(zurb_roof(l,1)+zurb_roof(l,2)) !thickness b/n two interfaces
- do j = 2,nlevurb-1
- dzurb_roof(l,j)= 0.5*(zurb_roof(l,j+1)-zurb_roof(l,j-1))
- enddo
- dzurb_roof(l,nlevurb) = zurb_roof(l,nlevurb)-zurb_roof(l,nlevurb-1)
-
- dzurb_wall(l,1) = 0.5*(zurb_wall(l,1)+zurb_wall(l,2)) !thickness b/n two interfaces
- do j = 2,nlevurb-1
- dzurb_wall(l,j)= 0.5*(zurb_wall(l,j+1)-zurb_wall(l,j-1))
- enddo
- dzurb_wall(l,nlevurb) = zurb_wall(l,nlevurb)-zurb_wall(l,nlevurb-1)
-
- ziurb_wall(l,0) = 0.
- do j = 1, nlevurb-1
- ziurb_wall(l,j) = 0.5*(zurb_wall(l,j)+zurb_wall(l,j+1)) !interface depths
- enddo
- ziurb_wall(l,nlevurb) = zurb_wall(l,nlevurb) + 0.5*dzurb_wall(l,nlevurb)
-
- ziurb_roof(l,0) = 0.
- do j = 1, nlevurb-1
- ziurb_roof(l,j) = 0.5*(zurb_roof(l,j)+zurb_roof(l,j+1)) !interface depths
- enddo
- ziurb_roof(l,nlevurb) = zurb_roof(l,nlevurb) + 0.5*dzurb_roof(l,nlevurb)
- end if
- end if
- end do
-
- do c = bounds%begc,bounds%endc
- l = col%landunit(c)
-
- if (lun%urbpoi(l)) then
- if (col%itype(c)==icol_sunwall .or. col%itype(c)==icol_shadewall) then
- col%z(c,1:nlevurb) = zurb_wall(l,1:nlevurb)
- col%zi(c,0:nlevurb) = ziurb_wall(l,0:nlevurb)
- col%dz(c,1:nlevurb) = dzurb_wall(l,1:nlevurb)
- if (nlevurb < nlevgrnd) then
- col%z(c,nlevurb+1:nlevgrnd) = spval
- col%zi(c,nlevurb+1:nlevgrnd) = spval
- col%dz(c,nlevurb+1:nlevgrnd) = spval
- end if
- else if (col%itype(c)==icol_roof) then
- col%z(c,1:nlevurb) = zurb_roof(l,1:nlevurb)
- col%zi(c,0:nlevurb) = ziurb_roof(l,0:nlevurb)
- col%dz(c,1:nlevurb) = dzurb_roof(l,1:nlevurb)
- if (nlevurb < nlevgrnd) then
- col%z(c,nlevurb+1:nlevgrnd) = spval
- col%zi(c,nlevurb+1:nlevgrnd) = spval
- col%dz(c,nlevurb+1:nlevgrnd) = spval
- end if
- else
- col%z(c,1:nlevgrnd) = zsoi(1:nlevgrnd)
- col%zi(c,0:nlevgrnd) = zisoi(0:nlevgrnd)
- col%dz(c,1:nlevgrnd) = dzsoi(1:nlevgrnd)
- end if
- else if (lun%itype(l) /= istdlak) then
- col%z(c,1:nlevgrnd) = zsoi(1:nlevgrnd)
- col%zi(c,0:nlevgrnd) = zisoi(0:nlevgrnd)
- col%dz(c,1:nlevgrnd) = dzsoi(1:nlevgrnd)
- end if
- end do
-
- if (nlevurb > 0) then
- deallocate(zurb_wall, zurb_roof, dzurb_wall, dzurb_roof, ziurb_wall, ziurb_roof)
- end if
-
- !-----------------------------------------------
- ! Set index defining depth to bedrock
- !-----------------------------------------------
-
- allocate(zbedrock_in(bounds%begg:bounds%endg))
- if (use_bedrock) then
- call ncd_io(ncid=ncid, varname='zbedrock', flag='read', data=zbedrock_in, dim1name=grlnd, readvar=readvar)
- if (.not. readvar) then
- if (masterproc) then
- call endrun( 'ERROR:: zbedrock not found on surface data set, and use_bedrock is true.'//errmsg(sourcefile, __LINE__) )
- end if
- end if
-
- ! if use_bedrock = false, set zbedrock to lowest layer bottom interface
- else
- if (masterproc) write(iulog,*) 'not using use_bedrock!!'
- zbedrock_in(:) = zisoi(nlevsoi)
- endif
-
- ! determine minimum index of minimum soil depth
- jmin_bedrock = 3
- do j = 3,nlevsoi
- if (zisoi(j-1) < zmin_bedrock .and. zisoi(j) >= zmin_bedrock) then
- jmin_bedrock = j
- endif
- enddo
-
- if (masterproc) write(iulog,*) 'jmin_bedrock: ', jmin_bedrock
-
- ! Determine gridcell bedrock index
- do g = bounds%begg,bounds%endg
- grc%nbedrock(g) = nlevsoi
- do j = jmin_bedrock,nlevsoi
- if (zisoi(j-1) < zbedrock_in(g) .and. zisoi(j) >= zbedrock_in(g)) then
- grc%nbedrock(g) = j
- end if
- end do
- end do
-
- ! Set column bedrock index
- do c = begc, endc
- g = col%gridcell(c)
- col%nbedrock(c) = grc%nbedrock(g)
- end do
-
- deallocate(zbedrock_in)
-
- !-----------------------------------------------
- ! Set lake levels and layers (no interfaces)
- !-----------------------------------------------
-
- allocate(lakedepth_in(bounds%begg:bounds%endg))
- call ncd_io(ncid=ncid, varname='LAKEDEPTH', flag='read', data=lakedepth_in, dim1name=grlnd, readvar=readvar)
- if (.not. readvar) then
- if (masterproc) then
- write(iulog,*) 'WARNING:: LAKEDEPTH not found on surface data set. All lake columns will have lake depth', &
- ' set equal to default value.'
- end if
- lakedepth_in(:) = spval
- end if
- do c = begc, endc
- g = col%gridcell(c)
- col%lakedepth(c) = lakedepth_in(g)
- end do
- deallocate(lakedepth_in)
-
- ! Lake layers
- if (.not. use_extralakelayers) then
- dzlak(1) = 0.1_r8
- dzlak(2) = 1._r8
- dzlak(3) = 2._r8
- dzlak(4) = 3._r8
- dzlak(5) = 4._r8
- dzlak(6) = 5._r8
- dzlak(7) = 7._r8
- dzlak(8) = 7._r8
- dzlak(9) = 10.45_r8
- dzlak(10)= 10.45_r8
-
- zlak(1) = 0.05_r8
- zlak(2) = 0.6_r8
- zlak(3) = 2.1_r8
- zlak(4) = 4.6_r8
- zlak(5) = 8.1_r8
- zlak(6) = 12.6_r8
- zlak(7) = 18.6_r8
- zlak(8) = 25.6_r8
- zlak(9) = 34.325_r8
- zlak(10)= 44.775_r8
- else
- dzlak(1) =0.1_r8
- dzlak(2) =0.25_r8
- dzlak(3) =0.25_r8
- dzlak(4) =0.25_r8
- dzlak(5) =0.25_r8
- dzlak(6) =0.5_r8
- dzlak(7) =0.5_r8
- dzlak(8) =0.5_r8
- dzlak(9) =0.5_r8
- dzlak(10) =0.75_r8
- dzlak(11) =0.75_r8
- dzlak(12) =0.75_r8
- dzlak(13) =0.75_r8
- dzlak(14) =2_r8
- dzlak(15) =2_r8
- dzlak(16) =2.5_r8
- dzlak(17) =2.5_r8
- dzlak(18) =3.5_r8
- dzlak(19) =3.5_r8
- dzlak(20) =3.5_r8
- dzlak(21) =3.5_r8
- dzlak(22) =5.225_r8
- dzlak(23) =5.225_r8
- dzlak(24) =5.225_r8
- dzlak(25) =5.225_r8
-
- zlak(1) = dzlak(1)/2._r8
- do i=2,nlevlak
- zlak(i) = zlak(i-1) + (dzlak(i-1)+dzlak(i))/2._r8
- end do
- end if
-
- do c = bounds%begc,bounds%endc
- l = col%landunit(c)
-
- if (lun%itype(l) == istdlak) then
-
- if (col%lakedepth(c) == spval) then
- col%lakedepth(c) = zlak(nlevlak) + 0.5_r8*dzlak(nlevlak)
- col%z_lake(c,1:nlevlak) = zlak(1:nlevlak)
- col%dz_lake(c,1:nlevlak) = dzlak(1:nlevlak)
-
- else if (col%lakedepth(c) > 1._r8 .and. col%lakedepth(c) < 5000._r8) then
-
- depthratio = col%lakedepth(c) / (zlak(nlevlak) + 0.5_r8*dzlak(nlevlak))
- col%z_lake(c,1) = zlak(1)
- col%dz_lake(c,1) = dzlak(1)
- col%dz_lake(c,2:nlevlak-1) = dzlak(2:nlevlak-1)*depthratio
- col%dz_lake(c,nlevlak) = dzlak(nlevlak)*depthratio - (col%dz_lake(c,1) - dzlak(1)*depthratio)
- do lev=2,nlevlak
- col%z_lake(c,lev) = col%z_lake(c,lev-1) + (col%dz_lake(c,lev-1)+col%dz_lake(c,lev))/2._r8
- end do
-
- else if (col%lakedepth(c) > 0._r8 .and. col%lakedepth(c) <= 1._r8) then
-
- col%dz_lake(c,:) = col%lakedepth(c) / nlevlak;
- col%z_lake(c,1) = col%dz_lake(c,1) / 2._r8;
- do lev=2,nlevlak
- col%z_lake(c,lev) = col%z_lake(c,lev-1) + (col%dz_lake(c,lev-1)+col%dz_lake(c,lev))/2._r8
- end do
-
- else
-
- write(iulog,*)'Bad lake depth: lakedepth: ', col%lakedepth(c)
- call shr_sys_abort(errmsg(sourcefile, __LINE__))
-
- end if
-
- col%z(c,1:nlevgrnd) = zsoi(1:nlevgrnd)
- col%zi(c,0:nlevgrnd) = zisoi(0:nlevgrnd)
- col%dz(c,1:nlevgrnd) = dzsoi(1:nlevgrnd)
- end if
- end do
-
- ! ------------------------------------------------------------------------
- ! Set classes of layers
- ! ------------------------------------------------------------------------
-
- do c = bounds%begc, bounds%endc
- l = col%landunit(c)
- if (hasBedrock(col_itype=col%itype(c), lun_itype=lun%itype(l))) then
- ! NOTE(wjs, 2015-10-17) We are assuming that points with bedrock have both
- ! "shallow" and "deep" bedrock. Currently, this is not true for lake columns:
- ! lakes do not distinguish between "shallow" bedrock and "normal" soil.
- ! However, that was just due to an oversight that is supposed to be corrected
- ! soon; so to keep things simple we assume that any point with bedrock
- ! potentially has both shallow and deep bedrock.
- col%levgrnd_class(c, 1:col%nbedrock(c)) = LEVGRND_CLASS_STANDARD
- if (col%nbedrock(c) < nlevsoi) then
- col%levgrnd_class(c, (col%nbedrock(c) + 1) : nlevsoi) = LEVGRND_CLASS_SHALLOW_BEDROCK
- end if
- col%levgrnd_class(c, (nlevsoi + 1) : nlevgrnd) = LEVGRND_CLASS_DEEP_BEDROCK
- else
- col%levgrnd_class(c, 1:nlevgrnd) = LEVGRND_CLASS_STANDARD
- end if
- end do
-
- do j = 1, nlevgrnd
- do c = bounds%begc, bounds%endc
- if (col%z(c,j) == spval) then
- col%levgrnd_class(c,j) = ispval
- end if
- end do
- end do
-
- !-----------------------------------------------
- ! Set cold-start values for snow levels, snow layers and snow interfaces
- !-----------------------------------------------
-
- !call InitSnowLayers(bounds, snow_depth(bounds%begc:bounds%endc))
-
- !-----------------------------------------------
- ! Read in topographic index and slope
- !-----------------------------------------------
-
- allocate(tslope(bounds%begg:bounds%endg))
- call ncd_io(ncid=ncid, varname='SLOPE', flag='read', data=tslope, dim1name=grlnd, readvar=readvar)
- if (.not. readvar) then
- call shr_sys_abort(' ERROR: TOPOGRAPHIC SLOPE NOT on surfdata file'//&
- errMsg(sourcefile, __LINE__))
- end if
- do c = begc,endc
- g = col%gridcell(c)
- ! check for near zero slopes, set minimum value
- col%topo_slope(c) = max(tslope(g), 0.2_r8)
- end do
- deallocate(tslope)
-
- allocate(std(bounds%begg:bounds%endg))
- call ncd_io(ncid=ncid, varname='STD_ELEV', flag='read', data=std, dim1name=grlnd, readvar=readvar)
- if (.not. readvar) then
- call shr_sys_abort(' ERROR: TOPOGRAPHIC STDdev (STD_ELEV) NOT on surfdata file'//&
- errMsg(sourcefile, __LINE__))
- end if
- do c = begc,endc
- g = col%gridcell(c)
- ! Topographic variables
- col%topo_std(c) = std(g)
- end do
- deallocate(std)
-
- !-----------------------------------------------
- ! SCA shape function defined
- !-----------------------------------------------
-
- do c = begc,endc
- l = col%landunit(c)
- g = col%gridcell(c)
-
- if (lun%itype(l)==istice_mec .and. glc_behavior%allow_multiple_columns_grc(g)) then
- ! ice_mec columns already account for subgrid topographic variability through
- ! their use of multiple elevation classes; thus, to avoid double-accounting for
- ! topographic variability in these columns, we ignore topo_std and use a fixed
- ! value of n_melt.
- col%n_melt(c) = n_melt_glcmec
- else
- col%n_melt(c) = 200.0/max(10.0_r8, col%topo_std(c))
- end if
-
- ! microtopographic parameter, units are meters (try smooth function of slope)
-
- slopebeta = 3._r8
- slopemax = 0.4_r8
- slope0 = slopemax**(-1._r8/slopebeta)
- col%micro_sigma(c) = (col%topo_slope(c) + slope0)**(-slopebeta)
- end do
-
- call ncd_pio_closefile(ncid)
-
- end subroutine initVertical
-
- !-----------------------------------------------------------------------
- logical function hasBedrock(col_itype, lun_itype)
- !
- ! !DESCRIPTION:
- ! Returns true if the given column type has a representation of bedrock - i.e., a set
- ! of layers at the bottom of the column that are treated fundamentally differently
- ! from the upper layers.
- !
- ! !USES:
- use landunit_varcon, only : istice_mec, isturb_MIN, isturb_MAX
- use column_varcon , only : icol_road_perv
- !
- ! !ARGUMENTS:
- integer, intent(in) :: col_itype ! col%itype value
- integer, intent(in) :: lun_itype ! lun%itype value for the landunit on which this column sits
- ! If we had an easy way to figure out which landunit a column was on based on
- ! col_itype (which would be very helpful!), then we wouldn't need lun_itype.
- !
- ! !LOCAL VARIABLES:
-
- character(len=*), parameter :: subname = 'hasBedrock'
- !-----------------------------------------------------------------------
-
- ! TODO(wjs, 2015-10-17) I don't like that the logic here implicitly duplicates logic
- ! elsewhere in the code. For example, if there were a change in the lake code so that
- ! it no longer treated the bottom layers as bedrock, then that change would need to be
- ! reflected here. One solution would be to set some has_bedrock flag in one central
- ! place, and then have the science code use that. But that could get messy in the
- ! science code. Another solution would be to decentralize the definition of
- ! hasBedrock, so that (for example) the lake code itself sets the value for lun_itype
- ! == istdlak - that way, hasBedrock(lake) would be more likely to get updated
- ! correctly if the lake logic changes.
-
- if (lun_itype == istice_mec) then
- hasBedrock = .false.
- else if (lun_itype >= isturb_MIN .and. lun_itype <= isturb_MAX) then
- if (col_itype == icol_road_perv) then
- hasBedrock = .true.
- else
- hasBedrock = .false.
- end if
- else
- hasBedrock = .true.
- end if
-
- ! As an independent check of the above logic, assert that, at the very least, any
- ! hydrologically-active column is given hasBedrock = .true. This is to try to catch
- ! problems with new column types being added that aren't handled properly by the
- ! above logic, since (as noted in the todo note above) there is some implicit
- ! duplication of logic between this routine and other parts of the code, which is
- ! dangerous. For example, if a new "urban lawn" type is added, then it should have
- ! hasBedrock = .true. - and this omission will hopefully be caught by this assertion.
- if (is_hydrologically_active(col_itype=col_itype, lun_itype=lun_itype)) then
- SHR_ASSERT(hasBedrock, "hasBedrock should be true for all hydrologically-active columns")
- end if
-
- end function hasBedrock
-
-
-end module initVerticalMod
diff --git a/src/main/landunit_varcon.F90 b/src/main/landunit_varcon.F90
deleted file mode 100644
index b6ddc7cf..00000000
--- a/src/main/landunit_varcon.F90
+++ /dev/null
@@ -1,133 +0,0 @@
-module landunit_varcon
-
- !-----------------------------------------------------------------------
- ! !DESCRIPTION:
- ! Module containing landunit indices and associated variables and routines.
- !
- ! !USES:
-#include "shr_assert.h"
- !
- !
- ! !PUBLIC TYPES:
- implicit none
- private
-
- !------------------------------------------------------------------
- ! Initialize landunit type constants
- !------------------------------------------------------------------
-
- integer, parameter, public :: istsoil = 1 !soil landunit type (natural vegetation)
- integer, parameter, public :: istcrop = 2 !crop landunit type
- ! Landunit 3 currently unused (used to be non-multiple elevation class glacier type: istice)
- integer, parameter, public :: istice_mec = 4 !land ice (multiple elevation classes) landunit type
- integer, parameter, public :: istdlak = 5 !deep lake landunit type (now used for all lakes)
- integer, parameter, public :: istwet = 6 !wetland landunit type (swamp, marsh, etc.)
-
- integer, parameter, public :: isturb_MIN = 7 !minimum urban type index
- integer, parameter, public :: isturb_tbd = 7 !urban tbd landunit type
- integer, parameter, public :: isturb_hd = 8 !urban hd landunit type
- integer, parameter, public :: isturb_md = 9 !urban md landunit type
- integer, parameter, public :: isturb_MAX = 9 !maximum urban type index
-
- integer, parameter, public :: max_lunit = 9 !maximum value that lun%itype can have
- !(i.e., largest value in the above list)
-
- integer, parameter, public :: landunit_name_length = 40 ! max length of landunit names
- character(len=landunit_name_length), public :: landunit_names(max_lunit) ! name of each landunit type
-
- ! parameters that depend on the above constants
-
- integer, parameter, public :: numurbl = isturb_MAX - isturb_MIN + 1 ! number of urban landunits
-
- !
- ! !PUBLIC MEMBER FUNCTIONS:
- public :: landunit_varcon_init ! initialize constants in this module
- public :: landunit_is_special ! returns true if this is a special landunit
-
- !
- ! !PRIVATE MEMBER FUNCTIONS:
- private :: set_landunit_names ! set the landunit_names vector
-!-----------------------------------------------------------------------
-
-contains
-
- !-----------------------------------------------------------------------
- subroutine landunit_varcon_init()
- !
- ! !DESCRIPTION:
- ! Initialize constants in landunit_varcon
- !
- ! !USES:
- !
- ! !ARGUMENTS:
- !
- ! !LOCAL VARIABLES:
-
- character(len=*), parameter :: subname = 'landunit_varcon_init'
- !-----------------------------------------------------------------------
-
- call set_landunit_names()
-
- end subroutine landunit_varcon_init
-
- !-----------------------------------------------------------------------
- function landunit_is_special(ltype) result(is_special)
- !
- ! !DESCRIPTION:
- ! Returns true if the landunit type ltype is a special landunit; returns false otherwise
- !
- ! !USES:
- !
- ! !ARGUMENTS:
- logical :: is_special ! function result
- integer :: ltype ! landunit type of interest
- !
- ! !LOCAL VARIABLES:
-
- character(len=*), parameter :: subname = 'landunit_is_special'
- !-----------------------------------------------------------------------
-
- SHR_ASSERT((ltype >= 1 .and. ltype <= max_lunit), subname//': ltype out of bounds')
-
- if (ltype == istsoil .or. ltype == istcrop) then
- is_special = .false.
- else
- is_special = .true.
- end if
-
- end function landunit_is_special
-
-
- !-----------------------------------------------------------------------
- subroutine set_landunit_names
- !
- ! !DESCRIPTION:
- ! Set the landunit_names vector
- !
- ! !USES:
- use shr_sys_mod, only : shr_sys_abort
- !
- character(len=*), parameter :: not_set = 'NOT_SET'
- character(len=*), parameter :: unused = 'UNUSED'
- character(len=*), parameter :: subname = 'set_landunit_names'
- !-----------------------------------------------------------------------
-
- landunit_names(:) = not_set
-
- landunit_names(istsoil) = 'vegetated_or_bare_soil'
- landunit_names(istcrop) = 'crop'
- landunit_names(istcrop+1) = unused
- landunit_names(istice_mec) = 'landice_multiple_elevation_classes'
- landunit_names(istdlak) = 'deep_lake'
- landunit_names(istwet) = 'wetland'
- landunit_names(isturb_tbd) = 'urban_tbd'
- landunit_names(isturb_hd) = 'urban_hd'
- landunit_names(isturb_md) = 'urban_md'
-
- if (any(landunit_names == not_set)) then
- call shr_sys_abort(trim(subname)//': Not all landunit names set')
- end if
-
- end subroutine set_landunit_names
-
-end module landunit_varcon
diff --git a/src/main/lnd2atmMod.F90 b/src/main/lnd2atmMod.F90
deleted file mode 100644
index ebe7eea1..00000000
--- a/src/main/lnd2atmMod.F90
+++ /dev/null
@@ -1,450 +0,0 @@
-module lnd2atmMod
-
- !-----------------------------------------------------------------------
- ! !DESCRIPTION:
- ! Handle lnd2atm mapping
- !
- ! !USES:
-#include "shr_assert.h"
- use shr_kind_mod , only : r8 => shr_kind_r8
- use shr_infnan_mod , only : nan => shr_infnan_nan, assignment(=)
- use shr_log_mod , only : errMsg => shr_log_errMsg
- use shr_megan_mod , only : shr_megan_mechcomps_n
- use clm_varpar , only : numrad, ndst, nlevgrnd !ndst = number of dust bins.
- use clm_varcon , only : rair, grav, cpair, hfus, tfrz, spval
- use clm_varctl , only : iulog
- use seq_drydep_mod , only : n_drydep, drydep_method, DD_XLND
- use decompMod , only : bounds_type
- use subgridAveMod , only : p2g, c2g
- use lnd2atmType , only : lnd2atm_type
- use atm2lndType , only : atm2lnd_type
- use ch4Mod , only : ch4_type
- use DUSTMod , only : dust_type
- use DryDepVelocity , only : drydepvel_type
- use VocEmissionMod , only : vocemis_type
- use EnergyFluxType , only : energyflux_type
- use FrictionVelocityMod , only : frictionvel_type
- use SolarAbsorbedType , only : solarabs_type
- use SurfaceAlbedoType , only : surfalb_type
- use TemperatureType , only : temperature_type
- use WaterFluxType , only : waterflux_type
- use WaterstateType , only : waterstate_type
- use glcBehaviorMod , only : glc_behavior_type
- use glc2lndMod , only : glc2lnd_type
- use ColumnType , only : col
- use LandunitType , only : lun
- use GridcellType , only : grc
- use landunit_varcon , only : istice_mec
- !
- ! !PUBLIC TYPES:
- implicit none
- private
- !
- ! !PUBLIC MEMBER FUNCTIONS:
- public :: lnd2atm
- public :: lnd2atm_minimal
-
- !
- ! !PRIVATE MEMBER FUNCTIONS:
- private :: handle_ice_runoff
-
- character(len=*), parameter, private :: sourcefile = &
- __FILE__
- !------------------------------------------------------------------------
-
-contains
-
- !------------------------------------------------------------------------
- subroutine lnd2atm_minimal(bounds, &
- waterstate_inst, surfalb_inst, energyflux_inst, lnd2atm_inst)
- !
- ! !DESCRIPTION:
- ! Compute clm_l2a_inst component of gridcell derived type. This routine computes
- ! the bare minimum of components necessary to get the first step of a
- ! run started.
- !
- ! !USES:
- use clm_varcon, only : sb
- !
- ! !ARGUMENTS:
- type(bounds_type) , intent(in) :: bounds
- type(waterstate_type) , intent(in) :: waterstate_inst
- type(surfalb_type) , intent(in) :: surfalb_inst
- type(energyflux_type) , intent(in) :: energyflux_inst
- type(lnd2atm_type) , intent(inout) :: lnd2atm_inst
- !
- ! !LOCAL VARIABLES:
- integer :: g ! index
- real(r8), parameter :: amC = 12.0_r8 ! Atomic mass number for Carbon
- real(r8), parameter :: amO = 16.0_r8 ! Atomic mass number for Oxygen
- real(r8), parameter :: amCO2 = amC + 2.0_r8*amO ! Atomic mass number for CO2
- ! The following converts g of C to kg of CO2
- real(r8), parameter :: convertgC2kgCO2 = 1.0e-3_r8 * (amCO2/amC)
- !------------------------------------------------------------------------
-
- call c2g(bounds, &
- waterstate_inst%h2osno_col (bounds%begc:bounds%endc), &
- lnd2atm_inst%h2osno_grc (bounds%begg:bounds%endg), &
- c2l_scale_type= 'urbanf', l2g_scale_type='unity')
-
- do g = bounds%begg,bounds%endg
- lnd2atm_inst%h2osno_grc(g) = lnd2atm_inst%h2osno_grc(g)/1000._r8
- end do
-
- call c2g(bounds, nlevgrnd, &
- waterstate_inst%h2osoi_vol_col (bounds%begc:bounds%endc, :), &
- lnd2atm_inst%h2osoi_vol_grc (bounds%begg:bounds%endg, :), &
- c2l_scale_type= 'urbanf', l2g_scale_type='unity')
-
- call p2g(bounds, numrad, &
- surfalb_inst%albd_patch (bounds%begp:bounds%endp, :), &
- lnd2atm_inst%albd_grc (bounds%begg:bounds%endg, :), &
- p2c_scale_type='unity', c2l_scale_type= 'urbanf', l2g_scale_type='unity')
-
- call p2g(bounds, numrad, &
- surfalb_inst%albi_patch (bounds%begp:bounds%endp, :), &
- lnd2atm_inst%albi_grc (bounds%begg:bounds%endg, :), &
- p2c_scale_type='unity', c2l_scale_type= 'urbanf', l2g_scale_type='unity')
-
- call p2g(bounds, &
- energyflux_inst%eflx_lwrad_out_patch (bounds%begp:bounds%endp), &
- lnd2atm_inst%eflx_lwrad_out_grc (bounds%begg:bounds%endg), &
- p2c_scale_type='unity', c2l_scale_type= 'urbanf', l2g_scale_type='unity')
-
- do g = bounds%begg,bounds%endg
- lnd2atm_inst%t_rad_grc(g) = sqrt(sqrt(lnd2atm_inst%eflx_lwrad_out_grc(g)/sb))
- end do
-
- end subroutine lnd2atm_minimal
-
- !------------------------------------------------------------------------
- subroutine lnd2atm(bounds, &
- atm2lnd_inst, surfalb_inst, temperature_inst, frictionvel_inst, &
- waterstate_inst, waterflux_inst, energyflux_inst, &
- solarabs_inst, drydepvel_inst, &
- vocemis_inst, dust_inst, ch4_inst, glc_behavior, &
- lnd2atm_inst, &
- net_carbon_exchange_grc)
- !
- ! !DESCRIPTION:
- ! Compute lnd2atm_inst component of gridcell derived type
- !
- ! !USES:
- !
- ! !ARGUMENTS:
- type(bounds_type) , intent(in) :: bounds
- type(atm2lnd_type) , intent(in) :: atm2lnd_inst
- type(surfalb_type) , intent(in) :: surfalb_inst
- type(temperature_type) , intent(in) :: temperature_inst
- type(frictionvel_type) , intent(in) :: frictionvel_inst
- type(waterstate_type) , intent(inout) :: waterstate_inst
- type(waterflux_type) , intent(inout) :: waterflux_inst
- type(energyflux_type) , intent(in) :: energyflux_inst
- type(solarabs_type) , intent(in) :: solarabs_inst
- type(drydepvel_type) , intent(in) :: drydepvel_inst
- type(vocemis_type) , intent(in) :: vocemis_inst
- type(dust_type) , intent(in) :: dust_inst
- type(ch4_type) , intent(in) :: ch4_inst
- type(glc_behavior_type) , intent(in) :: glc_behavior
- type(lnd2atm_type) , intent(inout) :: lnd2atm_inst
- real(r8) , intent(in) :: net_carbon_exchange_grc( bounds%begg: ) ! net carbon exchange between land and atmosphere, positive for source (gC/m2/s)
- !
- ! !LOCAL VARIABLES:
- integer :: c, g ! indices
- real(r8) :: qflx_ice_runoff_col(bounds%begc:bounds%endc) ! total column-level ice runoff
- real(r8) :: eflx_sh_ice_to_liq_grc(bounds%begg:bounds%endg) ! sensible heat flux generated from the ice to liquid conversion, averaged to gridcell
- real(r8), parameter :: amC = 12.0_r8 ! Atomic mass number for Carbon
- real(r8), parameter :: amO = 16.0_r8 ! Atomic mass number for Oxygen
- real(r8), parameter :: amCO2 = amC + 2.0_r8*amO ! Atomic mass number for CO2
- ! The following converts g of C to kg of CO2
- real(r8), parameter :: convertgC2kgCO2 = 1.0e-3_r8 * (amCO2/amC)
- !------------------------------------------------------------------------
-
- SHR_ASSERT_ALL((ubound(net_carbon_exchange_grc) == (/bounds%endg/)), errMsg(sourcefile, __LINE__))
-
- call handle_ice_runoff(bounds, waterflux_inst, glc_behavior, &
- melt_non_icesheet_ice_runoff = lnd2atm_inst%params%melt_non_icesheet_ice_runoff, &
- qflx_ice_runoff_col = qflx_ice_runoff_col(bounds%begc:bounds%endc), &
- qflx_liq_from_ice_col = lnd2atm_inst%qflx_liq_from_ice_col(bounds%begc:bounds%endc), &
- eflx_sh_ice_to_liq_col = lnd2atm_inst%eflx_sh_ice_to_liq_col(bounds%begc:bounds%endc))
-
- !----------------------------------------------------
- ! lnd -> atm
- !----------------------------------------------------
-
- ! First, compute the "minimal" set of fields.
- call lnd2atm_minimal(bounds, &
- waterstate_inst, surfalb_inst, energyflux_inst, lnd2atm_inst)
-
- call p2g(bounds, &
- temperature_inst%t_ref2m_patch (bounds%begp:bounds%endp), &
- lnd2atm_inst%t_ref2m_grc (bounds%begg:bounds%endg), &
- p2c_scale_type='unity', c2l_scale_type= 'unity', l2g_scale_type='unity')
-
- call p2g(bounds, &
- waterstate_inst%q_ref2m_patch (bounds%begp:bounds%endp), &
- lnd2atm_inst%q_ref2m_grc (bounds%begg:bounds%endg), &
- p2c_scale_type='unity', c2l_scale_type= 'unity', l2g_scale_type='unity')
-
- call p2g(bounds, &
- frictionvel_inst%u10_clm_patch (bounds%begp:bounds%endp), &
- lnd2atm_inst%u_ref10m_grc (bounds%begg:bounds%endg), &
- p2c_scale_type='unity', c2l_scale_type= 'unity', l2g_scale_type='unity')
-
- call p2g(bounds, &
- energyflux_inst%taux_patch (bounds%begp:bounds%endp), &
- lnd2atm_inst%taux_grc (bounds%begg:bounds%endg), &
- p2c_scale_type='unity', c2l_scale_type= 'unity', l2g_scale_type='unity')
-
- call p2g(bounds, &
- energyflux_inst%tauy_patch (bounds%begp:bounds%endp), &
- lnd2atm_inst%tauy_grc (bounds%begg:bounds%endg), &
- p2c_scale_type='unity', c2l_scale_type= 'unity', l2g_scale_type='unity')
-
- call p2g(bounds, &
- waterflux_inst%qflx_evap_tot_patch (bounds%begp:bounds%endp), &
- lnd2atm_inst%qflx_evap_tot_grc (bounds%begg:bounds%endg), &
- p2c_scale_type='unity', c2l_scale_type= 'urbanf', l2g_scale_type='unity')
-
- call p2g(bounds, &
- solarabs_inst%fsa_patch (bounds%begp:bounds%endp), &
- lnd2atm_inst%fsa_grc (bounds%begg:bounds%endg), &
- p2c_scale_type='unity', c2l_scale_type= 'urbanf', l2g_scale_type='unity')
-
- call p2g(bounds, &
- frictionvel_inst%fv_patch (bounds%begp:bounds%endp), &
- lnd2atm_inst%fv_grc (bounds%begg:bounds%endg), &
- p2c_scale_type='unity', c2l_scale_type= 'unity', l2g_scale_type='unity')
-
- call p2g(bounds, &
- frictionvel_inst%ram1_patch (bounds%begp:bounds%endp), &
- lnd2atm_inst%ram1_grc (bounds%begg:bounds%endg), &
- p2c_scale_type='unity', c2l_scale_type= 'unity', l2g_scale_type='unity')
-
- call p2g( bounds, &
- energyflux_inst%eflx_sh_tot_patch (bounds%begp:bounds%endp), &
- lnd2atm_inst%eflx_sh_tot_grc (bounds%begg:bounds%endg), &
- p2c_scale_type='unity',c2l_scale_type='urbanf',l2g_scale_type='unity')
- call c2g( bounds, &
- energyflux_inst%eflx_sh_precip_conversion_col (bounds%begc:bounds%endc), &
- lnd2atm_inst%eflx_sh_precip_conversion_grc (bounds%begg:bounds%endg), &
- c2l_scale_type='urbanf', l2g_scale_type='unity')
- call c2g( bounds, &
- lnd2atm_inst%eflx_sh_ice_to_liq_col(bounds%begc:bounds%endc), &
- eflx_sh_ice_to_liq_grc(bounds%begg:bounds%endg), &
- c2l_scale_type='urbanf', l2g_scale_type='unity')
- do g = bounds%begg, bounds%endg
- lnd2atm_inst%eflx_sh_tot_grc(g) = lnd2atm_inst%eflx_sh_tot_grc(g) + &
- lnd2atm_inst%eflx_sh_precip_conversion_grc(g) + &
- eflx_sh_ice_to_liq_grc(g) - &
- energyflux_inst%eflx_dynbal_grc(g)
- enddo
-
- call p2g(bounds, &
- energyflux_inst%eflx_lh_tot_patch (bounds%begp:bounds%endp), &
- lnd2atm_inst%eflx_lh_tot_grc (bounds%begg:bounds%endg), &
- p2c_scale_type='unity', c2l_scale_type= 'urbanf', l2g_scale_type='unity')
-
- do g = bounds%begg, bounds%endg
- lnd2atm_inst%net_carbon_exchange_grc(g) = &
- net_carbon_exchange_grc(g)
- end do
- ! Convert from gC/m2/s to kgCO2/m2/s
- do g = bounds%begg,bounds%endg
- lnd2atm_inst%net_carbon_exchange_grc(g) = &
- lnd2atm_inst%net_carbon_exchange_grc(g)*convertgC2kgCO2
- end do
-
- ! drydepvel
- if ( n_drydep > 0 .and. drydep_method == DD_XLND ) then
- call p2g(bounds, n_drydep, &
- drydepvel_inst%velocity_patch (bounds%begp:bounds%endp, :), &
- lnd2atm_inst%ddvel_grc (bounds%begg:bounds%endg, :), &
- p2c_scale_type='unity', c2l_scale_type= 'unity', l2g_scale_type='unity')
- endif
-
- ! voc emission flux
- if (shr_megan_mechcomps_n>0) then
- !call p2g(bounds, shr_megan_mechcomps_n, &
- !vocemis_inst%vocflx_patch(bounds%begp:bounds%endp,:), &
- !lnd2atm_inst%flxvoc_grc (bounds%begg:bounds%endg,:), &
- !p2c_scale_type='unity', c2l_scale_type= 'unity', l2g_scale_type='unity')
- end if
-
- ! dust emission flux
- call p2g(bounds, ndst, &
- dust_inst%flx_mss_vrt_dst_patch(bounds%begp:bounds%endp, :), &
- lnd2atm_inst%flxdst_grc (bounds%begg:bounds%endg, :), &
- p2c_scale_type='unity', c2l_scale_type= 'unity', l2g_scale_type='unity')
-
-
- !----------------------------------------------------
- ! lnd -> rof
- !----------------------------------------------------
-
- call c2g( bounds, &
- waterflux_inst%qflx_surf_col (bounds%begc:bounds%endc), &
- lnd2atm_inst%qflx_rofliq_qsur_grc (bounds%begg:bounds%endg), &
- c2l_scale_type= 'urbanf', l2g_scale_type='unity' )
-
- call c2g( bounds, &
- waterflux_inst%qflx_drain_col (bounds%begc:bounds%endc), &
- lnd2atm_inst%qflx_rofliq_qsub_grc (bounds%begg:bounds%endg), &
- c2l_scale_type= 'urbanf', l2g_scale_type='unity' )
-
- do c = bounds%begc, bounds%endc
- if (col%active(c)) then
- ! It's not entirely appropriate to put qflx_liq_from_ice_col into
- ! qflx_qrgwl_col, since this isn't necessarily just glaciers, wetlands and
- ! lakes. But since we put the liquid portion of snow capping into
- ! qflx_qrgwl_col, it seems reasonable to put qflx_liq_from_ice_col there as
- ! well.
- waterflux_inst%qflx_qrgwl_col(c) = waterflux_inst%qflx_qrgwl_col(c) + &
- lnd2atm_inst%qflx_liq_from_ice_col(c)
-
- ! qflx_runoff is the sum of a number of terms, including qflx_qrgwl. Since we
- ! are adjusting qflx_qrgwl above, we need to adjust qflx_runoff analogously.
- waterflux_inst%qflx_runoff_col(c) = waterflux_inst%qflx_runoff_col(c) + &
- lnd2atm_inst%qflx_liq_from_ice_col(c)
- end if
- end do
-
- call c2g( bounds, &
- waterflux_inst%qflx_qrgwl_col (bounds%begc:bounds%endc), &
- lnd2atm_inst%qflx_rofliq_qgwl_grc (bounds%begg:bounds%endg), &
- c2l_scale_type= 'urbanf', l2g_scale_type='unity' )
-
- call c2g( bounds, &
- waterflux_inst%qflx_runoff_col (bounds%begc:bounds%endc), &
- lnd2atm_inst%qflx_rofliq_grc (bounds%begg:bounds%endg), &
- c2l_scale_type= 'urbanf', l2g_scale_type='unity' )
-
- do g = bounds%begg, bounds%endg
- lnd2atm_inst%qflx_rofliq_qgwl_grc(g) = lnd2atm_inst%qflx_rofliq_qgwl_grc(g) - waterflux_inst%qflx_liq_dynbal_grc(g)
- lnd2atm_inst%qflx_rofliq_grc(g) = lnd2atm_inst%qflx_rofliq_grc(g) - waterflux_inst%qflx_liq_dynbal_grc(g)
- enddo
-
- call c2g( bounds, &
- waterflux_inst%qflx_h2osfc_surf_col (bounds%begc:bounds%endc), &
- lnd2atm_inst%qflx_rofliq_h2osfc_grc(bounds%begg:bounds%endg), &
- c2l_scale_type= 'urbanf', l2g_scale_type='unity' )
-
- call c2g( bounds, &
- waterflux_inst%qflx_drain_perched_col (bounds%begc:bounds%endc), &
- lnd2atm_inst%qflx_rofliq_drain_perched_grc(bounds%begg:bounds%endg), &
- c2l_scale_type= 'urbanf', l2g_scale_type='unity' )
-
- call c2g( bounds, &
- qflx_ice_runoff_col(bounds%begc:bounds%endc), &
- lnd2atm_inst%qflx_rofice_grc(bounds%begg:bounds%endg), &
- c2l_scale_type= 'urbanf', l2g_scale_type='unity' )
- do g = bounds%begg, bounds%endg
- lnd2atm_inst%qflx_rofice_grc(g) = lnd2atm_inst%qflx_rofice_grc(g) - waterflux_inst%qflx_ice_dynbal_grc(g)
- enddo
-
- ! calculate total water storage for history files
- ! first set tws to gridcell total endwb
- ! second add river storage as gridcell average depth (1.e-3 converts [m3/km2] to [mm])
- ! TODO - this was in BalanceCheckMod - not sure where it belongs?
-
- call c2g( bounds, &
- waterstate_inst%endwb_col(bounds%begc:bounds%endc), &
- waterstate_inst%tws_grc (bounds%begg:bounds%endg), &
- c2l_scale_type= 'urbanf', l2g_scale_type='unity' )
- do g = bounds%begg, bounds%endg
- waterstate_inst%tws_grc(g) = waterstate_inst%tws_grc(g) + atm2lnd_inst%volr_grc(g) / grc%area(g) * 1.e-3_r8
- enddo
-
- end subroutine lnd2atm
-
- !-----------------------------------------------------------------------
- subroutine handle_ice_runoff(bounds, waterflux_inst, glc_behavior, &
- melt_non_icesheet_ice_runoff, &
- qflx_ice_runoff_col, qflx_liq_from_ice_col, eflx_sh_ice_to_liq_col)
- !
- ! !DESCRIPTION:
- ! Take column-level ice runoff and divide it between (a) ice runoff, and (b) liquid
- ! runoff with a compensating negative sensible heat flux.
- !
- ! The rationale here is: Ice runoff is largely meant to represent a crude
- ! parameterization of iceberg calving. Iceberg calving is mainly appropriate in
- ! regions where an ice sheet terminates at the land-ocean boundary. Elsewhere, in
- ! reality, we expect most ice runoff to flow downstream and melt before it reaches the
- ! ocean. Furthermore, sending ice runoff directly to the ocean can lead to runaway sea
- ! ice growth in some regions (around the Canadian archipelago, and possibly in more
- ! wide-spread regions of the Arctic Ocean); melting this ice before it reaches the
- ! ocean avoids this problem.
- !
- ! If the river model were able to melt ice, then we might not need this routine.
- !
- ! Note that this routine does NOT handle ice runoff generated via the dynamic
- ! landunits adjustment fluxes (i.e., the fluxes that compensate for a difference in
- ! ice content between the pre- and post-dynamic landunit areas). This is partly
- ! because those gridcell-level dynamic landunits adjustment fluxes do not fit well
- ! with this column-based infrastructure, and partly because either method of handling
- ! these fluxes (i.e., sending an ice runoff or sending a liquid runoff with a
- ! negative sensible heat flux) seems equally justifiable.
- !
- ! !USES:
- !
- ! !ARGUMENTS:
- type(bounds_type), intent(in) :: bounds
- type(waterflux_type), intent(in) :: waterflux_inst
- type(glc_behavior_type), intent(in) :: glc_behavior
- logical, intent(in) :: melt_non_icesheet_ice_runoff
- real(r8), intent(out) :: qflx_ice_runoff_col( bounds%begc: ) ! total column-level ice runoff (mm H2O /s)
- real(r8), intent(out) :: qflx_liq_from_ice_col( bounds%begc: ) ! liquid runoff from converted ice runoff (mm H2O /s)
- real(r8), intent(out) :: eflx_sh_ice_to_liq_col( bounds%begc: ) ! sensible heat flux generated from the ice to liquid conversion (W/m2) (+ to atm)
-
- !
- ! !LOCAL VARIABLES:
- integer :: c, l, g
- logical :: do_conversion
-
- character(len=*), parameter :: subname = 'handle_ice_runoff'
- !-----------------------------------------------------------------------
-
- SHR_ASSERT_ALL((ubound(qflx_ice_runoff_col) == (/bounds%endc/)), errMsg(sourcefile, __LINE__))
- SHR_ASSERT_ALL((ubound(qflx_liq_from_ice_col) == (/bounds%endc/)), errMsg(sourcefile, __LINE__))
- SHR_ASSERT_ALL((ubound(eflx_sh_ice_to_liq_col) == (/bounds%endc/)), errMsg(sourcefile, __LINE__))
-
- do c = bounds%begc, bounds%endc
- if (col%active(c)) then
- qflx_ice_runoff_col(c) = waterflux_inst%qflx_ice_runoff_snwcp_col(c) + &
- waterflux_inst%qflx_ice_runoff_xs_col(c)
- qflx_liq_from_ice_col(c) = 0._r8
- eflx_sh_ice_to_liq_col(c) = 0._r8
- end if
- end do
-
- if (melt_non_icesheet_ice_runoff) then
- do c = bounds%begc, bounds%endc
- if (col%active(c)) then
- l = col%landunit(c)
- g = col%gridcell(c)
- do_conversion = .false.
- if (lun%itype(l) /= istice_mec) then
- do_conversion = .true.
- else ! istice_mec
- if (glc_behavior%ice_runoff_melted_grc(g)) then
- do_conversion = .true.
- else
- do_conversion = .false.
- end if
- end if
- if (do_conversion) then
- ! ice to liquid absorbs energy, so results in a negative heat flux to atm
- ! Note that qflx_ice_runoff_col is in mm H2O/s, which is the same as kg
- ! m-2 s-1, so we can simply multiply by hfus.
- eflx_sh_ice_to_liq_col(c) = -qflx_ice_runoff_col(c) * hfus
- qflx_liq_from_ice_col(c) = qflx_ice_runoff_col(c)
- qflx_ice_runoff_col(c) = 0._r8
- end if
- end if
- end do
- end if
-
- end subroutine handle_ice_runoff
-
-
-end module lnd2atmMod
diff --git a/src/main/lnd2atmType.F90 b/src/main/lnd2atmType.F90
index fbfab7b8..cb81fa11 100644
--- a/src/main/lnd2atmType.F90
+++ b/src/main/lnd2atmType.F90
@@ -13,26 +13,15 @@ module lnd2atmType
use clm_varpar , only : numrad, ndst, nlevgrnd !ndst = number of dust bins. ! MML: ndst = 4 from clm varpar
use clm_varcon , only : spval
use clm_varctl , only : iulog
- use shr_megan_mod , only : shr_megan_mechcomps_n
- use shr_fire_emis_mod,only : shr_fire_emis_mechcomps_n
- use seq_drydep_mod, only : n_drydep, drydep_method, DD_XLND
!
! !PUBLIC TYPES:
implicit none
private
- type, public :: lnd2atm_params_type
- ! true => ice runoff generated from non-glacier columns and glacier columns outside
- ! icesheet regions is converted to liquid, with an appropriate sensible heat flux
- logical, public :: melt_non_icesheet_ice_runoff
- end type lnd2atm_params_type
-
! ----------------------------------------------------
! land -> atmosphere variables structure
!----------------------------------------------------
type, public :: lnd2atm_type
- type(lnd2atm_params_type) :: params
-
! lnd->atm
real(r8), pointer :: t_rad_grc (:) => null() ! radiative temperature (Kelvin)
! MML check tech note for examples on how to calculate this; use MO theory
@@ -50,7 +39,6 @@ module lnd2atmType
real(r8), pointer :: tauy_grc (:) => null() ! wind stress: n-s (kg/m/s**2)
real(r8), pointer :: eflx_lh_tot_grc (:) => null() ! total latent HF (W/m**2) [+ to atm]
real(r8), pointer :: eflx_sh_tot_grc (:) => null() ! total sensible HF (W/m**2) [+ to atm]
- real(r8), pointer :: eflx_sh_precip_conversion_grc(:) => null() ! sensible HF from precipitation conversion (W/m**2) [+ to atm]
real(r8), pointer :: eflx_sh_ice_to_liq_col(:) => null() ! sensible HF generated from conversion of ice runoff to liquid (W/m**2) [+ to atm]
real(r8), pointer :: eflx_lwrad_out_grc (:) => null() ! IR (longwave) radiation (W/m**2)
real(r8), pointer :: qflx_evap_tot_grc (:) => null() ! qflx_evap_soi + qflx_evap_can + qflx_tran_veg
@@ -61,10 +49,6 @@ module lnd2atmType
real(r8), pointer :: fv_grc (:) => null() ! friction velocity (m/s) (for dust model)
real(r8), pointer :: flxdst_grc (:,:) => null() ! dust flux (size bins)
real(r8), pointer :: ddvel_grc (:,:) => null() ! dry deposition velocities
- real(r8), pointer :: flxvoc_grc (:,:) => null() ! VOC flux (size bins)
- real(r8), pointer :: fireflx_grc (:,:) => null() ! Wild Fire Emissions
- real(r8), pointer :: fireztop_grc (:) => null() ! Wild Fire Emissions vertical distribution top
- real(r8), pointer :: flux_ch4_grc (:) => null() ! net CH4 flux (kg C/m**2/s) [+ to atm]
! lnd->rof
real(r8), pointer :: qflx_rofliq_grc (:) => null() ! rof liq forcing
real(r8), pointer :: qflx_rofliq_qsur_grc (:) => null() ! rof liq -- surface runoff component
@@ -73,59 +57,29 @@ module lnd2atmType
real(r8), pointer :: qflx_rofliq_h2osfc_grc (:) => null() ! rof liq -- surface water runoff component
real(r8), pointer :: qflx_rofliq_drain_perched_grc (:) => null() ! rof liq -- perched water table runoff component
real(r8), pointer :: qflx_rofice_grc (:) => null() ! rof ice forcing
- real(r8), pointer :: qflx_liq_from_ice_col(:) => null() ! liquid runoff from converted ice runoff
- real(r8), pointer :: qirrig_grc (:) => null() ! irrigation flux
contains
procedure, public :: Init
- procedure, private :: ReadNamelist
procedure, private :: InitAllocate
procedure, private :: InitHistory
end type lnd2atm_type
!------------------------------------------------------------------------
- interface lnd2atm_params_type
- module procedure lnd2atm_params_constructor
- end interface lnd2atm_params_type
-
character(len=*), parameter, private :: sourcefile = &
__FILE__
!------------------------------------------------------------------------
contains
- !-----------------------------------------------------------------------
- function lnd2atm_params_constructor(melt_non_icesheet_ice_runoff) &
- result(params)
- !
- ! !DESCRIPTION:
- ! Creates a new instance of lnd2atm_params_type
- !
- ! !ARGUMENTS:
- type(lnd2atm_params_type) :: params ! function result
- logical, intent(in) :: melt_non_icesheet_ice_runoff
- !
- ! !LOCAL VARIABLES:
-
- character(len=*), parameter :: subname = 'lnd2atm_params_type'
- !-----------------------------------------------------------------------
-
- params%melt_non_icesheet_ice_runoff = melt_non_icesheet_ice_runoff
-
- end function lnd2atm_params_constructor
-
-
!------------------------------------------------------------------------
- subroutine Init(this, bounds, NLFilename)
+ subroutine Init(this, bounds)
class(lnd2atm_type) :: this
type(bounds_type), intent(in) :: bounds
- character(len=*), intent(in) :: NLFilename ! Namelist filename
call this%InitAllocate(bounds)
- call this%ReadNamelist(NLFilename)
call this%InitHistory(bounds)
end subroutine Init
@@ -136,33 +90,32 @@ subroutine InitAllocate(this, bounds)
! !DESCRIPTION:
! Initialize lnd2atm derived type
!
+ ! !USES
+ use clm_varcon, only: sb, tfrz
+ !
! !ARGUMENTS:
class (lnd2atm_type) :: this
type(bounds_type), intent(in) :: bounds
!
! !LOCAL VARIABLES:
real(r8) :: ival = 0.0_r8 ! initial value
- integer :: begc, endc
integer :: begg, endg
!------------------------------------------------------------------------
- begc = bounds%begc; endc = bounds%endc
begg = bounds%begg; endg = bounds%endg
- allocate(this%t_rad_grc (begg:endg)) ; this%t_rad_grc (:) =ival
+ allocate(this%t_rad_grc (begg:endg)) ; this%t_rad_grc (:) = tfrz + 2._r8
allocate(this%t_ref2m_grc (begg:endg)) ; this%t_ref2m_grc (:) =ival
allocate(this%q_ref2m_grc (begg:endg)) ; this%q_ref2m_grc (:) =ival
allocate(this%u_ref10m_grc (begg:endg)) ; this%u_ref10m_grc (:) =ival
- allocate(this%h2osno_grc (begg:endg)) ; this%h2osno_grc (:) =ival
+ allocate(this%h2osno_grc (begg:endg)) ; this%h2osno_grc (:) = 0._r8
allocate(this%h2osoi_vol_grc (begg:endg,1:nlevgrnd)) ; this%h2osoi_vol_grc (:,:) =ival
- allocate(this%albd_grc (begg:endg,1:numrad)) ; this%albd_grc (:,:) =ival
- allocate(this%albi_grc (begg:endg,1:numrad)) ; this%albi_grc (:,:) =ival
+ allocate(this%albd_grc (begg:endg,1:numrad)) ; this%albd_grc (:,:) = 0.2_r8
+ allocate(this%albi_grc (begg:endg,1:numrad)) ; this%albi_grc (:,:) = 0.2_r8
allocate(this%taux_grc (begg:endg)) ; this%taux_grc (:) =ival
allocate(this%tauy_grc (begg:endg)) ; this%tauy_grc (:) =ival
- allocate(this%eflx_lwrad_out_grc (begg:endg)) ; this%eflx_lwrad_out_grc (:) =ival
+ allocate(this%eflx_lwrad_out_grc (begg:endg)) ; this%eflx_lwrad_out_grc (:) = sb * tfrz**4
allocate(this%eflx_sh_tot_grc (begg:endg)) ; this%eflx_sh_tot_grc (:) =ival
- allocate(this%eflx_sh_precip_conversion_grc(begg:endg)) ; this%eflx_sh_precip_conversion_grc(:) = ival
- allocate(this%eflx_sh_ice_to_liq_col(begc:endc)) ; this%eflx_sh_ice_to_liq_col(:) = ival
allocate(this%eflx_lh_tot_grc (begg:endg)) ; this%eflx_lh_tot_grc (:) =ival
allocate(this%qflx_evap_tot_grc (begg:endg)) ; this%qflx_evap_tot_grc (:) =ival
allocate(this%fsa_grc (begg:endg)) ; this%fsa_grc (:) =ival
@@ -171,7 +124,6 @@ subroutine InitAllocate(this, bounds)
allocate(this%ram1_grc (begg:endg)) ; this%ram1_grc (:) =ival
allocate(this%fv_grc (begg:endg)) ; this%fv_grc (:) =ival
allocate(this%flxdst_grc (begg:endg,1:ndst)) ; this%flxdst_grc (:,:) =ival
- allocate(this%flux_ch4_grc (begg:endg)) ; this%flux_ch4_grc (:) =ival
allocate(this%qflx_rofliq_grc (begg:endg)) ; this%qflx_rofliq_grc (:) =ival
allocate(this%qflx_rofliq_qsur_grc (begg:endg)) ; this%qflx_rofliq_qsur_grc (:) =ival
allocate(this%qflx_rofliq_qsub_grc (begg:endg)) ; this%qflx_rofliq_qsub_grc (:) =ival
@@ -179,87 +131,9 @@ subroutine InitAllocate(this, bounds)
allocate(this%qflx_rofliq_h2osfc_grc (begg:endg)) ; this%qflx_rofliq_h2osfc_grc (:) =ival
allocate(this%qflx_rofliq_drain_perched_grc (begg:endg)) ; this%qflx_rofliq_drain_perched_grc (:) =ival
allocate(this%qflx_rofice_grc (begg:endg)) ; this%qflx_rofice_grc (:) =ival
- allocate(this%qflx_liq_from_ice_col(begc:endc)) ; this%qflx_liq_from_ice_col(:) = ival
- allocate(this%qirrig_grc (begg:endg)) ; this%qirrig_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
- if (shr_fire_emis_mechcomps_n>0) then
- allocate(this%fireflx_grc(begg:endg,1:shr_fire_emis_mechcomps_n))
- this%fireflx_grc = ival
- allocate(this%fireztop_grc(begg:endg))
- this%fireztop_grc = ival
- endif
- if ( n_drydep > 0 .and. drydep_method == DD_XLND )then
- allocate(this%ddvel_grc(begg:endg,1:n_drydep)); this%ddvel_grc(:,:)=ival
- end if
end subroutine InitAllocate
- !-----------------------------------------------------------------------
- subroutine ReadNamelist(this, NLFilename)
- !
- ! !DESCRIPTION:
- ! Read the lnd2atm namelist
- !
- ! !USES:
- use fileutils , only : getavu, relavu, opnfil
- use shr_nl_mod , only : shr_nl_find_group_name
- use spmdMod , only : masterproc, mpicom
- use shr_mpi_mod , only : shr_mpi_bcast
- !
- ! !ARGUMENTS:
- character(len=*), intent(in) :: NLFilename ! Namelist filename
- class(lnd2atm_type), intent(inout) :: this
- !
- ! !LOCAL VARIABLES:
-
- ! temporary variables corresponding to the components of lnd2atm_params_type
- logical :: melt_non_icesheet_ice_runoff
-
- integer :: ierr ! error code
- integer :: unitn ! unit for namelist file
- character(len=*), parameter :: nmlname = 'lnd2atm_inparm'
-
- character(len=*), parameter :: subname = 'ReadNamelist'
- !-----------------------------------------------------------------------
-
- namelist /lnd2atm_inparm/ melt_non_icesheet_ice_runoff
-
- ! Initialize namelist variables to defaults
- melt_non_icesheet_ice_runoff = .false.
-
- if (masterproc) then
- unitn = getavu()
- write(iulog,*) 'Read in '//nmlname//' namelist'
- call opnfil (NLFilename, unitn, 'F')
- call shr_nl_find_group_name(unitn, nmlname, status=ierr)
- if (ierr == 0) then
- read(unitn, nml=lnd2atm_inparm, iostat=ierr)
- if (ierr /= 0) then
- call endrun(msg="ERROR reading "//nmlname//"namelist"//errmsg(sourcefile, __LINE__))
- end if
- else
- call endrun(msg="ERROR could NOT find "//nmlname//"namelist"//errmsg(sourcefile, __LINE__))
- end if
- call relavu( unitn )
- end if
-
- call shr_mpi_bcast(melt_non_icesheet_ice_runoff, mpicom)
-
- if (masterproc) then
- write(iulog,*)
- write(iulog,*) nmlname, ' settings:'
- write(iulog,nml=lnd2atm_inparm)
- write(iulog,*) ' '
- end if
-
- this%params = lnd2atm_params_type( &
- melt_non_icesheet_ice_runoff = melt_non_icesheet_ice_runoff)
-
- end subroutine ReadNamelist
-
!-----------------------------------------------------------------------
subroutine InitHistory(this, bounds)
!
@@ -271,11 +145,9 @@ subroutine InitHistory(this, bounds)
type(bounds_type), intent(in) :: bounds
!
! !LOCAL VARIABLES:
- integer :: begc, endc
integer :: begg, endg
!---------------------------------------------------------------------
- begc = bounds%begc; endc = bounds%endc
begg = bounds%begg; endg = bounds%endg
this%eflx_sh_tot_grc(begg:endg) = 0._r8
@@ -285,37 +157,6 @@ subroutine InitHistory(this, bounds)
&(includes corrections for land use change, rain/snow conversion and conversion of ice runoff to liquid)', &
ptr_lnd=this%eflx_sh_tot_grc)
- this%eflx_sh_ice_to_liq_col(begc:endc) = 0._r8
- call hist_addfld1d (fname='FSH_RUNOFF_ICE_TO_LIQ', units='W/m^2', &
- avgflag='A', &
- long_name='sensible heat flux generated from conversion of ice runoff to liquid', &
- ptr_col=this%eflx_sh_ice_to_liq_col)
-
- this%qflx_rofliq_grc(begg:endg) = 0._r8
- call hist_addfld1d (fname='QRUNOFF_TO_COUPLER', units='mm/s', &
- avgflag='A', &
- long_name='total liquid runoff sent to coupler (includes corrections for land use change)', &
- ptr_lnd=this%qflx_rofliq_grc)
-
- this%qflx_rofice_grc(begg:endg) = 0._r8
- call hist_addfld1d (fname='QRUNOFF_ICE_TO_COUPLER', units='mm/s', &
- avgflag='A', &
- long_name='total ice runoff sent to coupler (includes corrections for land use change)', &
- ptr_lnd=this%qflx_rofice_grc)
-
- this%qflx_liq_from_ice_col(begc:endc) = 0._r8
- call hist_addfld1d (fname='QRUNOFF_ICE_TO_LIQ', units='mm/s', &
- avgflag='A', &
- long_name='liquid runoff from converted ice runoff', &
- ptr_col=this%qflx_liq_from_ice_col, default='inactive')
-
- this%net_carbon_exchange_grc(begg:endg) = spval
- call hist_addfld1d(fname='FCO2', units='kgCO2/m2/s', &
- avgflag='A', &
- long_name='CO2 flux to atmosphere (+ to atm)', &
- ptr_lnd=this%net_carbon_exchange_grc, &
- default='inactive')
-
end subroutine InitHistory
end module lnd2atmType
diff --git a/src/main/lnd2glcMod.F90 b/src/main/lnd2glcMod.F90
deleted file mode 100644
index 9de7eba3..00000000
--- a/src/main/lnd2glcMod.F90
+++ /dev/null
@@ -1,304 +0,0 @@
-module lnd2glcMod
-
- !-----------------------------------------------------------------------
- ! !DESCRIPTION:
- ! Handle arrays used for exchanging data from land model to glc
- ! For now glc datais send and received on the lnd grid and decomposition.
- !
- ! The fields sent from the lnd component to the glc component via
- ! the coupler are labeled 's2x', or sno to coupler.
- ! The fields received by the lnd component from the glc component
- ! via the coupler are labeled 'x2s', or coupler to sno.
- ! 'Sno' is a misnomer in that the exchanged data are related to
- ! the ice beneath the snow, not the snow itself. But by CESM convention,
- ! 'ice' refers to sea ice, not land ice.
- !
- ! !USES:
- use shr_kind_mod , only : r8 => shr_kind_r8
- use shr_infnan_mod , only : nan => shr_infnan_nan, assignment(=)
- use shr_log_mod , only : errMsg => shr_log_errMsg
- use decompMod , only : get_proc_bounds, bounds_type
- use domainMod , only : ldomain
- use clm_varpar , only : maxpatch_glcmec
- use clm_varctl , only : iulog
- use clm_varcon , only : spval, tfrz, namec
- use column_varcon , only : col_itype_to_icemec_class
- use landunit_varcon , only : istice_mec, istsoil
- use abortutils , only : endrun
- use GlacierSurfaceMassBalanceMod, only : glacier_smb_type
- use TemperatureType , only : temperature_type
- use LandunitType , only : lun
- use ColumnType , only : col
- use TopoMod , only : topo_type
- !
- ! !PUBLIC TYPES:
- implicit none
- private
- save
-
- ! land -> glc variables structure
- type, public :: lnd2glc_type
- real(r8), pointer :: tsrf_grc(:,:) => null()
- real(r8), pointer :: topo_grc(:,:) => null()
- real(r8), pointer :: qice_grc(:,:) => null()
-
- contains
-
- procedure, public :: Init
- procedure, public :: update_lnd2glc
- procedure, private :: InitAllocate
- procedure, private :: InitHistory
-
- end type lnd2glc_type
-
- ! !PUBLIC MEMBER FUNCTIONS:
-
- ! The following is public simply to support unit testing, and should not generally be
- ! called from outside this module.
- !
- ! Note that it is not a type-bound procedure, because it doesn't actually involve the
- ! lnd2glc_type. This suggests that perhaps it belongs in some other module.
- public :: bareland_normalization ! compute normalization factor for fluxes from the bare land portion of the grid cell
-
- character(len=*), parameter, private :: sourcefile = &
- __FILE__
- !------------------------------------------------------------------------
-
-contains
-
- !------------------------------------------------------------------------
- subroutine Init(this, bounds)
-
- class(lnd2glc_type) :: this
- type(bounds_type), intent(in) :: bounds
-
- call this%InitAllocate(bounds)
- call this%InitHistory(bounds)
-
- end subroutine Init
-
- !------------------------------------------------------------------------
- subroutine InitAllocate(this, bounds)
- !
- ! !DESCRIPTION:
- ! Initialize land variables required by glc
- !
- ! !USES:
- use clm_varcon , only : spval
- use histFileMod, only : hist_addfld1d
- !
- ! !ARGUMENTS:
- class(lnd2glc_type) :: this
- type(bounds_type), intent(in) :: bounds
- !
- ! !LOCAL VARIABLES:
- integer :: begg,endg
- !------------------------------------------------------------------------
-
- begg = bounds%begg; endg = bounds%endg
-
- allocate(this%tsrf_grc(begg:endg,0:maxpatch_glcmec)) ; this%tsrf_grc(:,:)=0.0_r8
- allocate(this%topo_grc(begg:endg,0:maxpatch_glcmec)) ; this%topo_grc(:,:)=0.0_r8
- allocate(this%qice_grc(begg:endg,0:maxpatch_glcmec)) ; this%qice_grc(:,:)=0.0_r8
-
- end subroutine InitAllocate
-
- !------------------------------------------------------------------------
- subroutine InitHistory(this, bounds)
- !
- ! !USES:
- use histFileMod, only : hist_addfld1d,hist_addfld2d
- !
- ! !ARGUMENTS:
- class(lnd2glc_type) :: this
- type(bounds_type), intent(in) :: bounds
- !
- ! !LOCAL VARIABLES:
- real(r8), pointer :: data2dptr(:,:)
- integer :: begg, endg
- !---------------------------------------------------------------------
-
- begg = bounds%begg; endg = bounds%endg
-
- this%qice_grc(begg:endg,0:maxpatch_glcmec) = spval
- ! For this and the following fields, set up a pointer to the field simply for the
- ! sake of changing the indexing, so that levels start with an index of 1, as is
- ! assumed by histFileMod - so levels go 1:(nec+1) rather than 0:nec
- data2dptr => this%qice_grc(:,0:maxpatch_glcmec)
- call hist_addfld2d (fname='QICE_FORC', units='mm/s', type2d='elevclas', &
- avgflag='A', long_name='qice forcing sent to GLC', &
- ptr_lnd=data2dptr, default='inactive')
-
- this%tsrf_grc(begg:endg,0:maxpatch_glcmec) = spval
- data2dptr => this%tsrf_grc(:,0:maxpatch_glcmec)
- call hist_addfld2d (fname='TSRF_FORC', units='K', type2d='elevclas', &
- avgflag='A', long_name='surface temperature sent to GLC', &
- ptr_lnd=data2dptr, default='inactive')
-
- this%topo_grc(begg:endg,0:maxpatch_glcmec) = spval
- data2dptr => this%topo_grc(:,0:maxpatch_glcmec)
- call hist_addfld2d (fname='TOPO_FORC', units='m', type2d='elevclas', &
- avgflag='A', long_name='topograephic height sent to GLC', &
- ptr_lnd=data2dptr, default='inactive')
-
- end subroutine InitHistory
-
-
- !------------------------------------------------------------------------------
- subroutine update_lnd2glc(this, bounds, num_do_smb_c, filter_do_smb_c, &
- temperature_inst, glacier_smb_inst, topo_inst, init)
- !
- ! !DESCRIPTION:
- ! Assign values to lnd2glc+
- !
- ! !ARGUMENTS:
- class(lnd2glc_type) , intent(inout) :: this
- type(bounds_type) , intent(in) :: bounds
- integer , intent(in) :: num_do_smb_c ! number of columns in filter_do_smb_c
- integer , intent(in) :: filter_do_smb_c(:) ! column filter: columns where smb calculations are performed
- type(temperature_type) , intent(in) :: temperature_inst
- type(glacier_smb_type) , intent(in) :: glacier_smb_inst
- type(topo_type) , intent(in) :: topo_inst
- logical , intent(in) :: init ! if true=>only set a subset of fields
- !
- ! !LOCAL VARIABLES:
- integer :: c, l, g, n, fc ! indices
- logical, allocatable :: fields_assigned(:,:) ! tracks whether fields have already been assigned for each index [begg:endg, 0:maxpatch_glcmec]
- real(r8) :: flux_normalization ! factor by which fluxes should be normalized
-
- character(len=*), parameter :: subname = 'update_lnd2glc'
- !------------------------------------------------------------------------------
-
- ! Initialize to reasonable defaults
-
- this%qice_grc(bounds%begg : bounds%endg, :) = 0._r8
- this%tsrf_grc(bounds%begg : bounds%endg, :) = tfrz
- this%topo_grc(bounds%begg : bounds%endg, :) = 0._r8
-
- ! Fill the lnd->glc data on the clm grid
-
- allocate(fields_assigned(bounds%begg:bounds%endg, 0:maxpatch_glcmec))
- fields_assigned(:,:) = .false.
-
- do fc = 1, num_do_smb_c
- c = filter_do_smb_c(fc)
- l = col%landunit(c)
- g = col%gridcell(c)
-
- ! Set vertical index and a flux normalization, based on whether the column in question is glacier or vegetated.
- if (lun%itype(l) == istice_mec) then
- n = col_itype_to_icemec_class(col%itype(c))
- flux_normalization = 1.0_r8
- else if (lun%itype(l) == istsoil) then
- n = 0 !0-level index (bareland information)
- flux_normalization = bareland_normalization(c)
- else
- ! Other landunit types do not pass information in the lnd2glc fields.
- ! Note: for this to be acceptable, we need virtual vegetated columns in any grid
- ! cell that is made up solely of glacier plus some other special landunit (e.g.,
- ! glacier + lake) -- otherwise CISM wouldn't have any information for the non-
- ! glaciated portion of the grid cell.
- cycle
- end if
-
- ! Make sure we haven't already assigned the coupling fields for this point
- ! (this could happen, for example, if there were multiple columns in the
- ! istsoil landunit, which we aren't prepared to handle)
- if (fields_assigned(g,n)) then
- write(iulog,*) subname//' ERROR: attempt to assign coupling fields twice for the same index.'
- write(iulog,*) 'One possible cause is having multiple columns in the istsoil landunit,'
- write(iulog,*) 'which this routine cannot handle.'
- write(iulog,*) 'g, n = ', g, n
- call endrun(decomp_index=c, clmlevel=namec, msg=errMsg(sourcefile, __LINE__))
- end if
-
- ! Send surface temperature, topography, and SMB flux (qice) to coupler.
- ! t_soisno and topo_col are valid even in initialization, so tsrf and topo
- ! are set here regardless of the value of init. But qflx_glcice is not valid
- ! until the run loop; thus, in initialization, we will use the default value
- ! for qice, as set above.
- fields_assigned(g,n) = .true.
- this%tsrf_grc(g,n) = temperature_inst%t_soisno_col(c,1)
- this%topo_grc(g,n) = topo_inst%topo_col(c)
- if (.not. init) then
- this%qice_grc(g,n) = glacier_smb_inst%qflx_glcice_col(c) * flux_normalization
-
- ! Check for bad values of qice
- if ( abs(this%qice_grc(g,n)) > 1.0_r8) then
- write(iulog,*) 'WARNING: qice out of bounds: g, n, qice =', g, n, this%qice_grc(g,n)
- end if
- end if
-
- end do
-
- deallocate(fields_assigned)
-
- end subroutine update_lnd2glc
-
- !-----------------------------------------------------------------------
- real(r8) function bareland_normalization(c)
- !
- ! !DESCRIPTION:
- ! Compute normalization factor for fluxes from the bare land portion of the grid
- ! cell. Fluxes should be multiplied by this factor before being sent to CISM.
- !
- ! The point of this is: CISM effectively has two land cover types: glaciated and
- ! bare. CLM, on the other hand, subdivides the bare land portion of the grid cell into
- ! multiple landunits. However, we currently don't do any sort of averaging of
- ! quantities computed in the different "bare land" landunits - instead, we simply send
- ! the values computed in the natural vegetated landunit - these fluxes (like SMB) are
- ! 0 in the other landunits. To achieve conservation, we need to normalize these
- ! natural veg. fluxes by the fraction of the "bare land" area accounted for by the
- ! natural veg. landunit.
- !
- ! For example, consider a grid cell that is:
- ! 60% glacier_mec
- ! 30% natural veg
- ! 10% lake
- !
- ! According to CISM, this grid cell is 60% icesheet, 40% "bare land". Now suppose CLM
- ! has an SMB flux of 1m in the natural veg landunit. If we simply sent 1m of ice to
- ! CISM, conservation would be broken, since it would also apply 1m of ice to the 10%
- ! of the grid cell that CLM says is lake. So, instead, we must multiply the 1m of ice
- ! by (0.3/0.4), thus "spreading out" the SMB from the natural veg. landunit, so that
- ! 0.75m of ice is grown throughout the bare land portion of CISM.
- !
- ! Note: If the non-glaciated area of the grid cell is 0, then we arbitrarily return a
- ! normalization factor of 1.0, in order to avoid divide-by-zero errors.
- !
- ! Note: We currently aren't careful about how we would handle things if there are
- ! multiple columns within the vegetated landunit. If that possibility were introduced,
- ! this code - as well as the code in update_clm_s2x - may need to be reworked somewhat.
- !
- ! !USES:
- use subgridWeightsMod , only : get_landunit_weight
- !
- ! !ARGUMENTS:
- integer, intent(in) :: c ! column index
- !
- ! !LOCAL VARIABLES:
- integer :: g ! grid cell index
- real(r8) :: area_glacier ! fractional area of the glacier_mec landunit in this grid cell
- real(r8) :: area_this_col ! fractional area of column c in the grid cell
-
- real(r8), parameter :: tol = 1.e-13_r8 ! tolerance for checking subgrid weight equality
- character(len=*), parameter :: subname = 'bareland_normalization'
- !-----------------------------------------------------------------------
-
- g = col%gridcell(c)
-
- area_glacier = get_landunit_weight(g, istice_mec)
-
- if (abs(area_glacier - 1.0_r8) < tol) then
- ! If the whole grid cell is glacier, then the normalization factor is arbitrary;
- ! set it to 1 so we don't do any normalization in this case
- bareland_normalization = 1.0_r8
- else
- area_this_col = col%wtgcell(c)
- bareland_normalization = area_this_col / (1.0_r8 - area_glacier)
- end if
-
- end function bareland_normalization
-
-end module lnd2glcMod
-
diff --git a/src/main/ncdio_pio.F90.in b/src/main/ncdio_pio.F90.in
index 6ee65a7e..01c28bc9 100644
--- a/src/main/ncdio_pio.F90.in
+++ b/src/main/ncdio_pio.F90.in
@@ -17,7 +17,7 @@ module ncdio_pio
use shr_log_mod , only : errMsg => shr_log_errMsg
use spmdMod , only : masterproc, mpicom, iam, npes
use spmdMod , only : MPI_REAL8, MPI_INTEGER, MPI_LOGICAL
- use clm_varcon , only : spval,ispval, grlnd, nameg, namel, namec, namep
+ use clm_varcon , only : spval,ispval, grlnd, nameg
use clm_varctl , only : single_column, iulog
use shr_sys_mod , only : shr_sys_flush
use decompMod , only : get_clmlevel_gsize,get_clmlevel_gsmap
@@ -2062,15 +2062,6 @@ contains
integer :: cc,i,ii ! index variable
integer :: data_offset ! offset into land array 1st column
integer :: ndata ! number of column (or pft points to read)
- real(r8) , pointer :: cols1dlon(:) ! holds cols1d_ixy var
- real(r8) , pointer :: cols1dlat(:) ! holds cols1d_jxy var
- real(r8) , pointer :: pfts1dlon(:) ! holds pfts1d_ixy var
- real(r8) , pointer :: pfts1dlat(:) ! holds pfts1d_jxy var
- real(r8) , pointer :: land1dlon(:) ! holds land1d_ixy var
- real(r8) , pointer :: land1dlat(:) ! holds land1d_jxy var
- integer, allocatable :: cols(:) ! grid cell columns for scam
- integer, allocatable :: pfts(:) ! grid cell pfts for scam
- integer, allocatable :: landunits(:) ! grid cell landunits for scam
integer, allocatable :: dids(:) ! dim ids
integer :: varid ! netCDF variable id
integer :: status ! return code
@@ -2118,113 +2109,6 @@ contains
else if ( trim(dimname)=='ni'.or. trim(dimname)=='lon'.or. trim(dimname)=='lsmlon') then
start(i)=lonidx
count(i)=1
- else if ( trim(dimname)=='column') then
-
- allocate (cols1dlon(dimlen))
- allocate (cols1dlat(dimlen))
- allocate (cols(dimlen))
-
- status = pio_inq_varid(ncid, 'cols1d_lon', varid)
- status = pio_get_var(ncid, varid, cols1dlon)
- status = pio_inq_varid(ncid, 'cols1d_lat', varid)
- status = pio_get_var(ncid, varid, cols1dlat)
-
- cols(:) = huge(1)
- data_offset = huge(1)
- ii = 1
- ndata = 0
- do cc = 1, dimlen
- if (cols1dlon(cc) == closelon.and.cols1dlat(cc) == closelat) then
- cols(ii)=cc
- ndata =ii
- ii=ii+1
- end if
- end do
- if (ndata == 0) then
- write(iulog,*)'couldnt find any columns for this latitude ',latidx,' and longitude ',lonidx
- call shr_sys_abort('ERROR:: no columns for this position'//errMsg(sourcefile, __LINE__))
- else
- data_offset=cols(1)
- end if
-
- deallocate (cols1dlon)
- deallocate (cols1dlat)
- deallocate (cols)
-
- start(i) = data_offset
- count(i) = ndata
- else if ( trim(dimname)=='pft') then
-
- allocate (pfts1dlon(dimlen))
- allocate (pfts1dlat(dimlen))
- allocate (pfts(dimlen))
-
- status = pio_inq_varid(ncid, 'pfts1d_lon', varid)
- status = pio_get_var(ncid, varid, pfts1dlon)
-
- status = pio_inq_varid(ncid, 'pfts1d_lat', varid)
- status = pio_get_var(ncid, varid, pfts1dlat)
-
- pfts(:) = huge(1)
- data_offset = huge(1)
- ii = 1
- ndata = 0
- do cc = 1, dimlen
- if (pfts1dlon(cc) == closelon.and.pfts1dlat(cc) == closelat) then
- pfts(ii)=cc
- ndata =ii
- ii=ii+1
- end if
- end do
- if (ndata == 0) then
- write(iulog,*)'couldnt find any pfts for this latitude ',closelat,' and longitude ',closelon
- call shr_sys_abort('ERROR:: no PFTs for this position'//errMsg(sourcefile, __LINE__))
- else
- data_offset=pfts(1)
- end if
-
- deallocate (pfts1dlon)
- deallocate (pfts1dlat)
- deallocate (pfts)
-
- start(i) = data_offset
- count(i) = ndata
- else if ( trim(dimname)=='landunit') then
-
- allocate (land1dlon(dimlen))
- allocate (land1dlat(dimlen))
- allocate (landunits(dimlen))
-
- status = pio_inq_varid(ncid, 'land1d_lon', varid)
- status = pio_get_var(ncid, varid, land1dlon)
-
- status = pio_inq_varid(ncid, 'land1d_lat', varid)
- status = pio_get_var(ncid, varid, land1dlat)
-
- landunits(:) = huge(1)
- data_offset = huge(1)
- ii = 1
- ndata = 0
- do cc = 1, dimlen
- if (land1dlon(cc) == closelon.and.land1dlat(cc) == closelat) then
- landunits(ii)=cc
- ndata =ii
- ii=ii+1
- end if
- end do
- if (ndata == 0) then
- write(iulog,*)'couldnt find any landunits for this latitude ',closelat,' and longitude ',closelon
- call shr_sys_abort('ERROR:: no landunits for this position'//errMsg(sourcefile, __LINE__))
- else
- data_offset=landunits(1)
- end if
-
- deallocate (land1dlon)
- deallocate (land1dlat)
- deallocate (landunits)
-
- start(i) = data_offset
- count(i) = ndata
else
start(i)=1
count(i)=dimlen
diff --git a/src/main/ndepStreamMod.F90 b/src/main/ndepStreamMod.F90
deleted file mode 100644
index c6147255..00000000
--- a/src/main/ndepStreamMod.F90
+++ /dev/null
@@ -1,126 +0,0 @@
-module ndepStreamMod
-
- !-----------------------------------------------------------------------
- ! !DESCRIPTION:
- ! Contains methods for reading in nitrogen deposition data file
- ! Also includes functions for dynamic ndep file handling and
- ! interpolation.
- !
- ! !USES
- use shr_kind_mod, only: r8 => shr_kind_r8, CL => shr_kind_cl
- use mct_mod , only: mct_ggrid
- use spmdMod , only: mpicom, iam
- use clm_varctl , only: iulog
- use abortutils , only: endrun
- use decompMod , only: bounds_type, gsmap_lnd_gdc2glo
- use domainMod , only: ldomain
-
- ! !PUBLIC TYPES:
- implicit none
- private
- save
-
- public :: clm_domain_mct ! Sets up MCT domain for this resolution
-
- ! ! PRIVATE TYPES
-
- character(len=*), parameter, private :: sourcefile = &
- __FILE__
- !==============================================================================
-
-contains
-
- !==============================================================================
- subroutine clm_domain_mct(bounds, dom_clm)
-
- !-------------------------------------------------------------------
- ! Set domain data type for internal clm grid
- use clm_varcon , only : re
- use domainMod , only : ldomain
- use seq_flds_mod
- use mct_mod , only : mct_ggrid, mct_gsMap_lsize, mct_gGrid_init
- use mct_mod , only : mct_gsMap_orderedPoints, mct_gGrid_importIAttr
- use mct_mod , only : mct_gGrid_importRAttr
- implicit none
- !
- ! arguments
- type(bounds_type), intent(in) :: bounds
- type(mct_ggrid), intent(out) :: dom_clm ! Output domain information for land model
- !
- ! local variables
- integer :: g,i,j ! index
- integer :: lsize ! land model domain data size
- real(r8), pointer :: data(:) ! temporary
- integer , pointer :: idata(:) ! temporary
- !-------------------------------------------------------------------
- !
- ! Initialize mct domain type
- ! lat/lon in degrees, area in radians^2, mask is 1 (land), 0 (non-land)
- ! Note that in addition land carries around landfrac for the purposes of domain checking
- !
- lsize = mct_gsMap_lsize(gsmap_lnd_gdc2glo, mpicom)
- call mct_gGrid_init( GGrid=dom_clm, CoordChars=trim(seq_flds_dom_coord), &
- OtherChars=trim(seq_flds_dom_other), lsize=lsize )
- !
- ! Allocate memory
- !
- allocate(data(lsize))
- !
- ! Determine global gridpoint number attribute, GlobGridNum, which is set automatically by MCT
- !
- call mct_gsMap_orderedPoints(gsmap_lnd_gdc2glo, iam, idata)
- call mct_gGrid_importIAttr(dom_clm,'GlobGridNum',idata,lsize)
- !
- ! Determine domain (numbering scheme is: West to East and South to North to South pole)
- ! Initialize attribute vector with special value
- !
- data(:) = -9999.0_R8
- call mct_gGrid_importRAttr(dom_clm,"lat" ,data,lsize)
- call mct_gGrid_importRAttr(dom_clm,"lon" ,data,lsize)
- call mct_gGrid_importRAttr(dom_clm,"area" ,data,lsize)
- call mct_gGrid_importRAttr(dom_clm,"aream",data,lsize)
- data(:) = 0.0_R8
- call mct_gGrid_importRAttr(dom_clm,"mask" ,data,lsize)
- !
- ! Determine bounds
- !
- ! Fill in correct values for domain components
- ! Note aream will be filled in in the atm-lnd mapper
- !
- do g = bounds%begg,bounds%endg
- i = 1 + (g - bounds%begg)
- data(i) = ldomain%lonc(g)
- end do
- call mct_gGrid_importRattr(dom_clm,"lon",data,lsize)
-
- do g = bounds%begg,bounds%endg
- i = 1 + (g - bounds%begg)
- data(i) = ldomain%latc(g)
- end do
- call mct_gGrid_importRattr(dom_clm,"lat",data,lsize)
-
- do g = bounds%begg,bounds%endg
- i = 1 + (g - bounds%begg)
- data(i) = ldomain%area(g)/(re*re)
- end do
- call mct_gGrid_importRattr(dom_clm,"area",data,lsize)
-
- do g = bounds%begg,bounds%endg
- i = 1 + (g - bounds%begg)
- data(i) = real(ldomain%mask(g), r8)
- end do
- call mct_gGrid_importRattr(dom_clm,"mask",data,lsize)
-
- do g = bounds%begg,bounds%endg
- i = 1 + (g - bounds%begg)
- data(i) = real(ldomain%frac(g), r8)
- end do
- call mct_gGrid_importRattr(dom_clm,"frac",data,lsize)
-
- deallocate(data)
- deallocate(idata)
-
- end subroutine clm_domain_mct
-
-end module ndepStreamMod
-
diff --git a/src/main/organicFileMod.F90 b/src/main/organicFileMod.F90
deleted file mode 100644
index 3adbd5b6..00000000
--- a/src/main/organicFileMod.F90
+++ /dev/null
@@ -1,113 +0,0 @@
-module organicFileMod
-
-!-----------------------------------------------------------------------
-!BOP
-!
-! !MODULE: organicFileMod
-!
-! !DESCRIPTION:
-! Contains methods for reading in organic matter data file which has
-! organic matter density for each grid point and soil level
-!
-! !USES
- use abortutils , only : endrun
- use clm_varctl , only : iulog
- use shr_kind_mod , only : r8 => shr_kind_r8
- use clm_varcon , only : grlnd
-!
-! !PUBLIC TYPES:
- implicit none
- private
- save
-!
-! !PUBLIC MEMBER FUNCTIONS:
- public :: organicrd ! Read organic matter dataset
-!
-! !REVISION HISTORY:
-! Created by David Lawrence, 4 May 2006
-! Revised by David Lawrence, 21 September 2007
-! Revised by David Lawrence, 14 October 2008
-!
-!EOP
-!
-!-----------------------------------------------------------------------
-
-contains
-
-!-----------------------------------------------------------------------
-!BOP
-!
-! !IROUTINE: organicrd
-!
-! !INTERFACE:
- subroutine organicrd(organic)
-!
-! !DESCRIPTION:
-! Read the organic matter dataset.
-!
-! !USES:
- use clm_varctl , only : fsurdat, single_column
- use fileutils , only : getfil
- use spmdMod , only : masterproc
- use domainMod , only : ldomain
- use ncdio_pio
-!
-! !ARGUMENTS:
- implicit none
- real(r8), pointer :: organic(:,:) ! organic matter density (kg/m3)
-!
-! !CALLED FROM:
-! subroutine initialize in module initializeMod
-!
-! !REVISION HISTORY:
-! Created by David Lawrence, 4 May 2006
-! Revised by David Lawrence, 21 September 2007
-!
-!
-! !LOCAL VARIABLES:
-!EOP
- character(len=256) :: locfn ! local file name
- type(file_desc_t) :: ncid ! netcdf id
- integer :: ni,nj,ns ! dimension sizes
- logical :: isgrid2d ! true => file is 2d
- logical :: readvar ! true => variable is on dataset
- character(len=32) :: subname = 'organicrd' ! subroutine name
-!-----------------------------------------------------------------------
-
- ! Initialize data to zero - no organic matter dataset
-
- organic(:,:) = 0._r8
-
- ! Read data if file was specified in namelist
-
- if (fsurdat /= ' ') then
- if (masterproc) then
- write(iulog,*) 'Attempting to read organic matter data .....'
- write(iulog,*) subname,trim(fsurdat)
- end if
-
- call getfil (fsurdat, locfn, 0)
- call ncd_pio_openfile (ncid, locfn, 0)
-
- call ncd_inqfdims (ncid, isgrid2d, ni, nj, ns)
- if (ldomain%ns /= ns .or. ldomain%ni /= ni .or. ldomain%nj /= nj) then
- write(iulog,*)trim(subname), 'ldomain and input file do not match dims '
- write(iulog,*)trim(subname), 'ldomain%ni,ni,= ',ldomain%ni,ni
- write(iulog,*)trim(subname), 'ldomain%nj,nj,= ',ldomain%nj,nj
- write(iulog,*)trim(subname), 'ldomain%ns,ns,= ',ldomain%ns,ns
- call endrun()
- end if
-
- call ncd_io(ncid=ncid, varname='ORGANIC', flag='read', data=organic, &
- dim1name=grlnd, readvar=readvar)
- if (.not. readvar) call endrun('organicrd: errror reading ORGANIC')
-
- if ( masterproc )then
- write(iulog,*) 'Successfully read organic matter data'
- write(iulog,*)
- end if
- endif
-
- end subroutine organicrd
-
-end module organicFileMod
diff --git a/src/main/paramUtilMod.F90 b/src/main/paramUtilMod.F90
deleted file mode 100644
index 96c95440..00000000
--- a/src/main/paramUtilMod.F90
+++ /dev/null
@@ -1,291 +0,0 @@
-module paramUtilMod
- !
- ! module that deals with reading parameter files
- !
- use shr_kind_mod , only: r8 => shr_kind_r8
- implicit none
- save
- private
-
- interface readNcdio
- module procedure readNcdioScalar
- module procedure readNcdioArray1d
- module procedure readNcdioArray2d
- module procedure readNcdioScalarCheckDimensions
- module procedure readNcdioArray1dCheckDimensions
- module procedure readNcdioArray2dCheckDimensions
- end interface
-
- public :: readNcdioScalar
- public :: readNcdioArray1d
- public :: readNcdioArray2d
- public :: readNcdioScalarCheckDimensions
- public :: readNcdioArray1dCheckDimensions
- public :: readNcdioArray2dCheckDimensions
-
- public :: readNcdio
-
- private :: checkDimensions
-
-contains
- !-----------------------------------------------------------------------
- !
- !-----------------------------------------------------------------------
- subroutine readNcdioScalar(ncid, varName, callingName, retVal)
- !
- ! read the netcdf file...generic, could be used for any parameter read
- !
- use abortutils , only : endrun
- use ncdio_pio , only : file_desc_t,ncd_io
-
- implicit none
-
- ! arguments
- type(file_desc_t),intent(inout) :: ncid ! pio netCDF file id
- character(len=*), intent(in) :: varName ! variable we are reading
- character(len=*), intent(in) :: callingName ! calling routine
- real(r8), intent(inout) :: retVal
-
- ! local vars
- character(len=32) :: subname = 'readNcdio::'
- character(len=100) :: errCode = ' - Error reading. Var: '
- logical :: readv ! has variable been read in or not
-
- !
- ! netcdf read here
- !
-
- call ncd_io(varname=trim(varName),data=retVal, flag='read', ncid=ncid, readvar=readv)
-
- if ( .not. readv ) then
- call endrun(trim(callingName)//trim(subname)//trim(errCode)//trim(varName))
- endif
-
- end subroutine readNcdioScalar
- !-----------------------------------------------------------------------
-
- !-----------------------------------------------------------------------
- !
- !-----------------------------------------------------------------------
- subroutine readNcdioArray1d(ncid, varName, callingName, retVal)
- !
- ! read the netcdf file...generic, could be used for any parameter read
- !
- use abortutils , only : endrun
- use ncdio_pio , only : file_desc_t,ncd_io
-
- implicit none
-
- ! arguments
- type(file_desc_t),intent(inout) :: ncid ! pio netCDF file id
- character(len=*), intent(in) :: varName ! variable we are reading
- character(len=*), intent(in) :: callingName ! calling routine
- real(r8), intent(inout) :: retVal( 1: )
-
- ! local vars
- character(len=32) :: subname = 'readNcdio::'
- character(len=100) :: errCode = ' - Error reading. Var: '
- logical :: readv ! has variable been read in or not
-
- !
- ! netcdf read here
- !
-
- call ncd_io(varname=trim(varName),data=retVal, flag='read', ncid=ncid, readvar=readv)
-
- if ( .not. readv ) then
- call endrun(trim(callingName)//trim(subname)//trim(errCode)//trim(varName))
- endif
-
- end subroutine readNcdioArray1d
- !-----------------------------------------------------------------------
-
- !-----------------------------------------------------------------------
- !
- !-----------------------------------------------------------------------
- subroutine readNcdioArray2d(ncid, varName, callingName, retVal)
- !
- ! read the netcdf file...generic, could be used for any parameter read
- !
- use abortutils , only : endrun
- use ncdio_pio , only : file_desc_t,ncd_io
-
- implicit none
-
- ! arguments
- type(file_desc_t),intent(inout) :: ncid ! pio netCDF file id
- character(len=*), intent(in) :: varName ! variable we are reading
- character(len=*), intent(in) :: callingName ! calling routine
- real(r8), intent(inout) :: retVal( 1: , :)
-
- ! local vars
- character(len=32) :: subname = 'readNcdio::'
- character(len=100) :: errCode = ' - Error reading. Var: '
- logical :: readv ! has variable been read in or not
-
- !
- ! netcdf read here
- !
-
- call ncd_io(varname=trim(varName),data=retVal, flag='read', ncid=ncid, readvar=readv)
-
- if ( .not. readv ) then
- call endrun(trim(callingName)//trim(subname)//trim(errCode)//trim(varName))
- endif
-
- end subroutine readNcdioArray2d
- !-----------------------------------------------------------------------
-
- !-----------------------------------------------------------------------
- !
- !-----------------------------------------------------------------------
- subroutine readNcdioScalarCheckDimensions(ncid, varName, expected_numDims, expected_dimNames, &
- callingName, retVal)
- !
- ! read the netcdf file...generic, could be used for any parameter read
- !
- use abortutils , only : endrun
- use ncdio_pio , only : file_desc_t
-
- implicit none
-
- ! arguments
- type(file_desc_t),intent(inout) :: ncid ! pio netCDF file id
- character(len=*), intent(in) :: varName ! variable we are reading
- integer, intent(in) :: expected_numDims
- character(len=*), intent(in) :: expected_dimNames(:) ! expected dimension name
- character(len=*), intent(in) :: callingName ! calling routine
- real(r8), intent(inout) :: retVal
-
- ! local vars
- character(len=32) :: subname = 'readNcdio::'
- character(len=100) :: errCode = ' - Error reading. Var: '
-
- !
- ! netcdf read here
- !
- call checkDimensions(ncid, varName, expected_numDims, expected_dimNames, subname)
- call readNcdio(ncid, varName, callingName, retVal)
-
- end subroutine readNcdioScalarCheckDimensions
- !-----------------------------------------------------------------------
-
- !-----------------------------------------------------------------------
- !
- !-----------------------------------------------------------------------
- subroutine readNcdioArray1dCheckDimensions(ncid, varName, expected_numDims, expected_dimNames, &
- callingName, retVal)
- !
- ! read the netcdf file...generic, could be used for any parameter read
- !
- use abortutils , only : endrun
- use ncdio_pio , only : file_desc_t
-
- implicit none
-
- ! arguments
- type(file_desc_t),intent(inout) :: ncid ! pio netCDF file id
- character(len=*), intent(in) :: varName ! variable we are reading
- integer, intent(in) :: expected_numDims
- character(len=*), intent(in) :: expected_dimNames(:) ! expected dimension name
- character(len=*), intent(in) :: callingName ! calling routine
- real(r8), intent(inout) :: retVal( 1: )
-
- ! local vars
- character(len=32) :: subname = 'readNcdio::'
- character(len=100) :: errCode = ' - Error reading. Var: '
- !
- ! netcdf read here
- !
- call checkDimensions(ncid, varName, expected_numDims, expected_dimNames, subname)
- call readNcdio(ncid, varName, callingName, retVal)
-
- end subroutine readNcdioArray1dCheckDimensions
- !-----------------------------------------------------------------------
-
- !-----------------------------------------------------------------------
- !
- !-----------------------------------------------------------------------
- subroutine readNcdioArray2dCheckDimensions(ncid, varName, expected_numDims, expected_dimNames, &
- callingName, retVal)
- !
- ! read the netcdf file...generic, could be used for any parameter read
- !
- use abortutils , only : endrun
- use ncdio_pio , only : file_desc_t
-
- implicit none
-
- ! arguments
- type(file_desc_t),intent(inout) :: ncid ! pio netCDF file id
- character(len=*), intent(in) :: varName ! variable we are reading
- integer, intent(in) :: expected_numDims
- character(len=*), intent(in) :: expected_dimNames(:) ! expected dimension name
- character(len=*), intent(in) :: callingName ! calling routine
- real(r8), intent(inout) :: retVal(1:, : )
-
- ! local vars
- character(len=32) :: subname = 'readNcdio::'
- character(len=100) :: errCode = ' - Error reading. Var: '
- !
- ! netcdf read here
- !
- call checkDimensions(ncid, varName, expected_numDims, expected_dimNames, subname)
- call readNcdio(ncid, varName, callingName, retVal)
-
- end subroutine readNcdioArray2dCheckDimensions
- !-----------------------------------------------------------------------
-
- !-----------------------------------------------------------------------
- !
- !-----------------------------------------------------------------------
- subroutine checkDimensions(ncid, varName, expected_numDims, expected_dimNames, callingName)
- !
- ! Assert that the expected number of dimensions and dimension
- ! names for a variable match the actual names on the file.
- !
- use abortutils , only : endrun
- use ncdio_pio , only : file_desc_t, var_desc_t, check_var, ncd_inqvdname, ncd_inqvdims
-
- implicit none
-
- ! arguments
- type(file_desc_t),intent(inout) :: ncid ! pio netCDF file id
- character(len=*), intent(in) :: varName ! variable we are reading
- integer, intent(in) :: expected_numDims ! number of expected dimensions on the variable
- character(len=*), intent(in) :: expected_dimNames(:) ! expected dimension names
- character(len=*), intent(in) :: callingName ! calling routine
- integer :: error_num
-
- ! local vars
- character(len=32) :: subname = 'checkDimensions::'
- type(Var_desc_t) :: var_desc ! variable descriptor
- logical :: readvar ! whether the variable was found
- character(len=100) :: received_dimName
- integer :: d, num_dims
- character(len=256) :: msg
-
- call check_var(ncid, varName, var_desc, readvar)
- if (readvar) then
- call ncd_inqvdims(ncid, num_dims, var_desc)
- if (num_dims /= expected_numDims) then
- write(msg, *) trim(callingName)//trim(subname)//trim(varname)//":: expected number of dimensions = ", &
- expected_numDims, " num dimensions received from file = ", num_dims
- call endrun(msg)
- end if
- do d = 1, num_dims
- received_dimName = ''
- call ncd_inqvdname(ncid, varname=trim(varName), dimnum=d, dname=received_dimName, err_code=error_num)
- if (trim(expected_dimNames(d)) /= trim(received_dimName)) then
- write(msg, *) trim(callingName)//trim(subname)//trim(varname)//":: dimension ", d, &
- " expected dimension name '"//trim(expected_dimNames(d))//&
- "' dimension name received from file '"//trim(received_dimName)//"'."
- call endrun(msg)
- end if
- end do
- end if
-
- end subroutine checkDimensions
- !-----------------------------------------------------------------------
-
-end module paramUtilMod
diff --git a/src/main/pftconMod.F90 b/src/main/pftconMod.F90
deleted file mode 100644
index 4714fca0..00000000
--- a/src/main/pftconMod.F90
+++ /dev/null
@@ -1,1374 +0,0 @@
-module pftconMod
-
- !-----------------------------------------------------------------------
- ! !DESCRIPTION:
- ! Module containing vegetation constants and method to
- ! read and initialize vegetation (PFT) constants.
- !
- ! !USES:
- use shr_kind_mod, only : r8 => shr_kind_r8
- use abortutils , only : endrun
- use clm_varpar , only : mxpft, numrad, ivis, inir, cft_lb, cft_ub
- use clm_varctl , only : iulog, use_cndv, use_vertsoilc, use_crop
- !
- ! !PUBLIC TYPES:
- implicit none
- !
- ! Vegetation type constants
- !
- integer :: noveg ! value for not vegetated
- integer :: ndllf_evr_tmp_tree ! value for Needleleaf evergreen temperate tree
- integer :: ndllf_evr_brl_tree ! value for Needleleaf evergreen boreal tree
- integer :: ndllf_dcd_brl_tree ! value for Needleleaf deciduous boreal tree
- integer :: nbrdlf_evr_trp_tree ! value for Broadleaf evergreen tropical tree
- integer :: nbrdlf_evr_tmp_tree ! value for Broadleaf evergreen temperate tree
- integer :: nbrdlf_dcd_trp_tree ! value for Broadleaf deciduous tropical tree
- integer :: nbrdlf_dcd_tmp_tree ! value for Broadleaf deciduous temperate tree
- integer :: nbrdlf_dcd_brl_tree ! value for Broadleaf deciduous boreal tree
- integer :: ntree ! value for last type of tree
- integer :: nbrdlf_evr_shrub ! value for Broadleaf evergreen shrub
- integer :: nbrdlf_dcd_tmp_shrub ! value for Broadleaf deciduous temperate shrub
- integer :: nbrdlf_dcd_brl_shrub ! value for Broadleaf deciduous boreal shrub
- integer :: nc3_arctic_grass ! value for C3 arctic grass
- integer :: nc3_nonarctic_grass ! value for C3 non-arctic grass
- integer :: nc4_grass ! value for C4 grass
- integer :: npcropmin ! value for first crop
- integer :: ntmp_corn ! value for temperate corn, rain fed (rf)
- integer :: nirrig_tmp_corn ! value for temperate corn, irrigated (ir)
- integer :: nswheat ! value for spring temperate cereal (rf)
- integer :: nirrig_swheat ! value for spring temperate cereal (ir)
- integer :: nwwheat ! value for winter temperate cereal (rf)
- integer :: nirrig_wwheat ! value for winter temperate cereal (ir)
- integer :: ntmp_soybean ! value for temperate soybean (rf)
- integer :: nirrig_tmp_soybean ! value for temperate soybean (ir)
- integer :: nbarley ! value for spring barley (rf)
- integer :: nirrig_barley ! value for spring barley (ir)
- integer :: nwbarley ! value for winter barley (rf)
- integer :: nirrig_wbarley ! value for winter barley (ir)
- integer :: nrye ! value for spring rye (rf)
- integer :: nirrig_rye ! value for spring rye (ir)
- integer :: nwrye ! value for winter rye (rf)
- integer :: nirrig_wrye ! value for winter rye (ir)
- integer :: ncassava ! ...and so on
- integer :: nirrig_cassava
- integer :: ncitrus
- integer :: nirrig_citrus
- integer :: ncocoa
- integer :: nirrig_cocoa
- integer :: ncoffee
- integer :: nirrig_coffee
- integer :: ncotton
- integer :: nirrig_cotton
- integer :: ndatepalm
- integer :: nirrig_datepalm
- integer :: nfoddergrass
- integer :: nirrig_foddergrass
- integer :: ngrapes
- integer :: nirrig_grapes
- integer :: ngroundnuts
- integer :: nirrig_groundnuts
- integer :: nmillet
- integer :: nirrig_millet
- integer :: noilpalm
- integer :: nirrig_oilpalm
- integer :: npotatoes
- integer :: nirrig_potatoes
- integer :: npulses
- integer :: nirrig_pulses
- integer :: nrapeseed
- integer :: nirrig_rapeseed
- integer :: nrice
- integer :: nirrig_rice
- integer :: nsorghum
- integer :: nirrig_sorghum
- integer :: nsugarbeet
- integer :: nirrig_sugarbeet
- integer :: nsugarcane
- integer :: nirrig_sugarcane
- integer :: nsunflower
- integer :: nirrig_sunflower
- integer :: nmiscanthus
- integer :: nirrig_miscanthus
- integer :: nswitchgrass
- integer :: nirrig_switchgrass
- integer :: ntrp_corn !value for tropical corn (rf)
- integer :: nirrig_trp_corn !value for tropical corn (ir)
- integer :: ntrp_soybean !value for tropical soybean (rf)
- integer :: nirrig_trp_soybean !value for tropical soybean (ir)
- integer :: npcropmax ! value for last prognostic crop in list
- integer :: nc3crop ! value for generic crop (rf)
- integer :: nc3irrig ! value for irrigated generic crop (ir)
-
- ! Number of crop functional types actually used in the model. This includes each CFT for
- ! which is_pft_known_to_model is true. Note that this includes irrigated crops even if
- ! irrigation is turned off in this run: it just excludes crop types that aren't handled
- ! at all, as given by the mergetoclmpft list.
- integer :: num_cfts_known_to_model
-
- ! !PUBLIC TYPES:
- type, public :: pftcon_type
-
- integer , allocatable :: noveg (:) ! value for not vegetated
- integer , allocatable :: tree (:) ! tree or not?
-
- real(r8), allocatable :: dleaf (:) ! characteristic leaf dimension (m)
- real(r8), allocatable :: c3psn (:) ! photosynthetic pathway: 0. = c4, 1. = c3
- real(r8), allocatable :: xl (:) ! leaf/stem orientation index
- real(r8), allocatable :: rhol (:,:) ! leaf reflectance: 1=vis, 2=nir
- real(r8), allocatable :: rhos (:,:) ! stem reflectance: 1=vis, 2=nir
- real(r8), allocatable :: taul (:,:) ! leaf transmittance: 1=vis, 2=nir
- real(r8), allocatable :: taus (:,:) ! stem transmittance: 1=vis, 2=nir
- real(r8), allocatable :: z0mr (:) ! ratio of momentum roughness length to canopy top height (-)
- real(r8), allocatable :: displar (:) ! ratio of displacement height to canopy top height (-)
- real(r8), allocatable :: roota_par (:) ! CLM rooting distribution parameter [1/m]
- real(r8), allocatable :: rootb_par (:) ! CLM rooting distribution parameter [1/m]
- real(r8), allocatable :: crop (:) ! crop pft: 0. = not crop, 1. = crop pft
- real(r8), allocatable :: irrigated (:) ! irrigated pft: 0. = not, 1. = irrigated
- real(r8), allocatable :: smpso (:) ! soil water potential at full stomatal opening (mm)
- real(r8), allocatable :: smpsc (:) ! soil water potential at full stomatal closure (mm)
- real(r8), allocatable :: fnitr (:) ! foliage nitrogen limitation factor (-)
-
- ! CN code
- real(r8), allocatable :: dwood (:) ! wood density (gC/m3)
- real(r8), allocatable :: slatop (:) ! SLA at top of canopy [m^2/gC]
- real(r8), allocatable :: dsladlai (:) ! dSLA/dLAI [m^2/gC]
- real(r8), allocatable :: leafcn (:) ! leaf C:N [gC/gN]
- real(r8), allocatable :: flnr (:) ! fraction of leaf N in Rubisco [no units]
- real(r8), allocatable :: woody (:) ! woody lifeform flag (0 or 1)
- real(r8), allocatable :: lflitcn (:) ! leaf litter C:N (gC/gN)
- real(r8), allocatable :: frootcn (:) ! fine root C:N (gC/gN)
- real(r8), allocatable :: livewdcn (:) ! live wood (phloem and ray parenchyma) C:N (gC/gN)
- real(r8), allocatable :: deadwdcn (:) ! dead wood (xylem and heartwood) C:N (gC/gN)
- real(r8), allocatable :: grperc (:) ! growth respiration parameter
- real(r8), allocatable :: grpnow (:) ! growth respiration parameter
- real(r8), allocatable :: rootprof_beta (:,:) ! CLM rooting distribution parameter for C and N inputs [unitless]
- real(r8), allocatable :: root_radius (:) ! root radius (m)
- real(r8), allocatable :: root_density (:) ! root density (gC/m3)
-
- ! crop
-
- ! These arrays give information about the merge of unused crop types to the types CLM
- ! knows about. mergetoclmpft(m) gives the crop type that CLM uses to simulate input
- ! type m (and mergetoclmpft(m) == m implies that CLM simulates crop type m
- ! directly). is_pft_known_to_model(m) is true if CLM simulates crop type m, and false
- ! otherwise. Note that these do NOT relate to whether irrigation is on or off in a
- ! given simulation - that is handled separately.
- integer , allocatable :: mergetoclmpft (:)
- logical , allocatable :: is_pft_known_to_model (:)
-
- real(r8), allocatable :: graincn (:) ! grain C:N (gC/gN)
- real(r8), allocatable :: mxtmp (:) ! parameter used in accFlds
- real(r8), allocatable :: baset (:) ! parameter used in accFlds
- real(r8), allocatable :: declfact (:) ! parameter used in CNAllocation
- real(r8), allocatable :: bfact (:) ! parameter used in CNAllocation
- real(r8), allocatable :: aleaff (:) ! parameter used in CNAllocation
- real(r8), allocatable :: arootf (:) ! parameter used in CNAllocation
- real(r8), allocatable :: astemf (:) ! parameter used in CNAllocation
- real(r8), allocatable :: arooti (:) ! parameter used in CNAllocation
- real(r8), allocatable :: fleafi (:) ! parameter used in CNAllocation
- real(r8), allocatable :: allconsl (:) ! parameter used in CNAllocation
- real(r8), allocatable :: allconss (:) ! parameter used in CNAllocation
- real(r8), allocatable :: ztopmx (:) ! parameter used in CNVegStructUpdate
- real(r8), allocatable :: laimx (:) ! parameter used in CNVegStructUpdate
- real(r8), allocatable :: gddmin (:) ! parameter used in CNPhenology
- real(r8), allocatable :: hybgdd (:) ! parameter used in CNPhenology
- real(r8), allocatable :: lfemerg (:) ! parameter used in CNPhenology
- real(r8), allocatable :: grnfill (:) ! parameter used in CNPhenology
- integer , allocatable :: mxmat (:) ! parameter used in CNPhenology
- real(r8), allocatable :: mbbopt (:) ! Ball-Berry equation slope used in Photosynthesis
- real(r8), allocatable :: medlynslope (:) ! Medlyn equation slope used in Photosynthesis
- real(r8), allocatable :: medlynintercept(:) ! Medlyn equation intercept used in Photosynthesis
- integer , allocatable :: mnNHplantdate (:) ! minimum planting date for NorthHemisphere (YYYYMMDD)
- integer , allocatable :: mxNHplantdate (:) ! maximum planting date for NorthHemisphere (YYYYMMDD)
- integer , allocatable :: mnSHplantdate (:) ! minimum planting date for SouthHemisphere (YYYYMMDD)
- integer , allocatable :: mxSHplantdate (:) ! maximum planting date for SouthHemisphere (YYYYMMDD)
- real(r8), allocatable :: planttemp (:) ! planting temperature used in CNPhenology (K)
- real(r8), allocatable :: minplanttemp (:) ! mininum planting temperature used in CNPhenology (K)
- real(r8), allocatable :: froot_leaf (:) ! allocation parameter: new fine root C per new leaf C (gC/gC)
- real(r8), allocatable :: stem_leaf (:) ! allocation parameter: new stem c per new leaf C (gC/gC)
- real(r8), allocatable :: croot_stem (:) ! allocation parameter: new coarse root C per new stem C (gC/gC)
- real(r8), allocatable :: flivewd (:) ! allocation parameter: fraction of new wood that is live (phloem and ray parenchyma) (no units)
- real(r8), allocatable :: fcur (:) ! allocation parameter: fraction of allocation that goes to currently displayed growth, remainder to storage
- real(r8), allocatable :: fcurdv (:) ! alternate fcur for use with cndv
- real(r8), allocatable :: lf_flab (:) ! leaf litter labile fraction
- real(r8), allocatable :: lf_fcel (:) ! leaf litter cellulose fraction
- real(r8), allocatable :: lf_flig (:) ! leaf litter lignin fraction
- real(r8), allocatable :: fr_flab (:) ! fine root litter labile fraction
- real(r8), allocatable :: fr_fcel (:) ! fine root litter cellulose fraction
- real(r8), allocatable :: fr_flig (:) ! fine root litter lignin fraction
- real(r8), allocatable :: leaf_long (:) ! leaf longevity (yrs)
- real(r8), allocatable :: evergreen (:) ! binary flag for evergreen leaf habit (0 or 1)
- real(r8), allocatable :: stress_decid (:) ! binary flag for stress-deciduous leaf habit (0 or 1)
- real(r8), allocatable :: season_decid (:) ! binary flag for seasonal-deciduous leaf habit (0 or 1)
- real(r8), allocatable :: pconv (:) ! proportion of deadstem to conversion flux
- real(r8), allocatable :: pprod10 (:) ! proportion of deadstem to 10-yr product pool
- real(r8), allocatable :: pprod100 (:) ! proportion of deadstem to 100-yr product pool
- real(r8), allocatable :: pprodharv10 (:) ! harvest mortality proportion of deadstem to 10-yr pool
-
- ! pft paraemeters for fire code
- real(r8), allocatable :: cc_leaf (:)
- real(r8), allocatable :: cc_lstem (:)
- real(r8), allocatable :: cc_dstem (:)
- real(r8), allocatable :: cc_other (:)
- real(r8), allocatable :: fm_leaf (:)
- real(r8), allocatable :: fm_lstem (:)
- real(r8), allocatable :: fm_dstem (:)
- real(r8), allocatable :: fm_other (:)
- real(r8), allocatable :: fm_root (:)
- real(r8), allocatable :: fm_lroot (:)
- real(r8), allocatable :: fm_droot (:)
- real(r8), allocatable :: fsr_pft (:)
- real(r8), allocatable :: fd_pft (:)
-
- ! pft parameters for crop code
- real(r8), allocatable :: manunitro (:) ! manure
- real(r8), allocatable :: fleafcn (:) ! C:N during grain fill; leaf
- real(r8), allocatable :: ffrootcn (:) ! C:N during grain fill; fine root
- real(r8), allocatable :: fstemcn (:) ! C:N during grain fill; stem
-
- real(r8), allocatable :: i_vcad (:)
- real(r8), allocatable :: s_vcad (:)
- real(r8), allocatable :: i_flnr (:)
- real(r8), allocatable :: s_flnr (:)
-
- ! pft parameters for CNDV code (from LPJ subroutine pftparameters)
- real(r8), allocatable :: pftpar20 (:) ! tree maximum crown area (m2)
- real(r8), allocatable :: pftpar28 (:) ! min coldest monthly mean temperature
- real(r8), allocatable :: pftpar29 (:) ! max coldest monthly mean temperature
- real(r8), allocatable :: pftpar30 (:) ! min growing degree days (>= 5 deg C)
- real(r8), allocatable :: pftpar31 (:) ! upper limit of temperature of the warmest month (twmax)
-
- ! pft parameters for FUN
- real(r8), allocatable :: a_fix (:) ! A BNF parameter
- real(r8), allocatable :: b_fix (:) ! A BNF parameter
- real(r8), allocatable :: c_fix (:) ! A BNF parameter
- real(r8), allocatable :: s_fix (:) ! A BNF parameter
- real(r8), allocatable :: akc_active (:) ! A mycorrhizal uptake parameter
- real(r8), allocatable :: akn_active (:) ! A mycorrhizal uptake parameter
- real(r8), allocatable :: ekc_active (:) ! A mycorrhizal uptake parameter
- real(r8), allocatable :: ekn_active (:) ! A mycorrhizal uptake parameter
- real(r8), allocatable :: kc_nonmyc (:) ! A non-mycorrhizal uptake parameter
- real(r8), allocatable :: kn_nonmyc (:) ! A non-mycorrhizal uptake parameter
- real(r8), allocatable :: kr_resorb (:) ! A retrasnlcation parameter
- real(r8), allocatable :: perecm (:) ! The fraction of ECM-associated PFT
- real(r8), allocatable :: fun_cn_flex_a (:) ! Parameter a of FUN-flexcn link code (def 5)
- real(r8), allocatable :: fun_cn_flex_b (:) ! Parameter b of FUN-flexcn link code (def 200)
- real(r8), allocatable :: fun_cn_flex_c (:) ! Parameter b of FUN-flexcn link code (def 80)
- real(r8), allocatable :: FUN_fracfixers(:) ! Fraction of C that can be used for fixation.
-
-
- ! pft parameters for dynamic root code
- real(r8), allocatable :: root_dmx(:) !maximum root depth
-
- contains
-
- procedure, public :: Init
- procedure, public :: InitForTesting ! version of Init meant for unit testing
- procedure, public :: Clean
- procedure, private :: InitAllocate
- procedure, private :: InitRead
- procedure, private :: set_is_pft_known_to_model ! Set is_pft_known_to_model based on mergetoclmpft
- procedure, private :: set_num_cfts_known_to_model ! Set the module-level variable, num_cfts_known_to_model
-
- end type pftcon_type
-
- type(pftcon_type), public :: pftcon ! pft type constants structure
-
- integer, parameter :: pftname_len = 40 ! max length of pftname
- character(len=pftname_len) :: pftname(0:mxpft) ! PFT description
-
- real(r8), parameter :: reinickerp = 1.6_r8 ! parameter in allometric equation
- real(r8), parameter :: dwood = 2.5e5_r8 ! cn wood density (gC/m3); lpj:2.0e5
- real(r8), parameter :: allom1 = 100.0_r8 ! parameters in
- real(r8), parameter :: allom2 = 40.0_r8 ! ...allometric
- real(r8), parameter :: allom3 = 0.5_r8 ! ...equations
- real(r8), parameter :: allom1s = 250.0_r8 ! modified for shrubs by
- real(r8), parameter :: allom2s = 8.0_r8 ! X.D.Z
-! root radius, density from Bonan, GMD, 2014
- real(r8), parameter :: root_density = 0.31e06_r8 !(g biomass / m3 root)
- real(r8), parameter :: root_radius = 0.29e-03_r8 !(m)
-
- character(len=*), parameter, private :: sourcefile = &
- __FILE__
- !-----------------------------------------------------------------------
-
-contains
-
- !------------------------------------------------------------------------
- subroutine Init(this)
-
- class(pftcon_type) :: this
-
- call this%InitAllocate()
- call this%InitRead()
-
- end subroutine Init
-
- !------------------------------------------------------------------------
- subroutine InitForTesting(this)
- ! Version of Init meant for unit testing
- !
- ! Allocate arrays, but don't try to read from file.
- !
- ! Values can then be set by tests as needed
-
- class(pftcon_type) :: this
-
- call this%InitAllocate()
-
- end subroutine InitForTesting
-
- !-----------------------------------------------------------------------
- subroutine InitAllocate (this)
- !
- ! !DESCRIPTION:
- ! Read and initialize vegetation (PFT) constants
- !
- ! !USES:
- use clm_varpar , only: nvariants
- implicit none
- !
- ! !ARGUMENTS:
- class(pftcon_type) :: this
- !-----------------------------------------------------------------------
-
- allocate( this%noveg (0:mxpft)); this%noveg (:) =huge(1)
- allocate( this%tree (0:mxpft)); this%tree (:) =huge(1)
-
- allocate( this%dleaf (0:mxpft) )
- allocate( this%c3psn (0:mxpft) )
- allocate( this%xl (0:mxpft) )
- allocate( this%rhol (0:mxpft,numrad) )
- allocate( this%rhos (0:mxpft,numrad) )
- allocate( this%taul (0:mxpft,numrad) )
- allocate( this%taus (0:mxpft,numrad) )
- allocate( this%z0mr (0:mxpft) )
- allocate( this%displar (0:mxpft) )
- allocate( this%roota_par (0:mxpft) )
- allocate( this%rootb_par (0:mxpft) )
- allocate( this%crop (0:mxpft) )
- allocate( this%mergetoclmpft (0:mxpft) )
- allocate( this%is_pft_known_to_model (0:mxpft) )
- allocate( this%irrigated (0:mxpft) )
- allocate( this%smpso (0:mxpft) )
- allocate( this%smpsc (0:mxpft) )
- allocate( this%fnitr (0:mxpft) )
- allocate( this%slatop (0:mxpft) )
- allocate( this%dsladlai (0:mxpft) )
- allocate( this%leafcn (0:mxpft) )
- allocate( this%flnr (0:mxpft) )
- allocate( this%woody (0:mxpft) )
- allocate( this%lflitcn (0:mxpft) )
- allocate( this%frootcn (0:mxpft) )
- allocate( this%livewdcn (0:mxpft) )
- allocate( this%deadwdcn (0:mxpft) )
- allocate( this%grperc (0:mxpft) )
- allocate( this%grpnow (0:mxpft) )
- allocate( this%rootprof_beta (0:mxpft,nvariants) )
- allocate( this%graincn (0:mxpft) )
- allocate( this%mxtmp (0:mxpft) )
- allocate( this%baset (0:mxpft) )
- allocate( this%declfact (0:mxpft) )
- allocate( this%bfact (0:mxpft) )
- allocate( this%aleaff (0:mxpft) )
- allocate( this%arootf (0:mxpft) )
- allocate( this%astemf (0:mxpft) )
- allocate( this%arooti (0:mxpft) )
- allocate( this%fleafi (0:mxpft) )
- allocate( this%allconsl (0:mxpft) )
- allocate( this%allconss (0:mxpft) )
- allocate( this%ztopmx (0:mxpft) )
- allocate( this%laimx (0:mxpft) )
- allocate( this%gddmin (0:mxpft) )
- allocate( this%hybgdd (0:mxpft) )
- allocate( this%lfemerg (0:mxpft) )
- allocate( this%grnfill (0:mxpft) )
- allocate( this%mbbopt (0:mxpft) )
- allocate( this%medlynslope (0:mxpft) )
- allocate( this%medlynintercept(0:mxpft) )
- allocate( this%mxmat (0:mxpft) )
- allocate( this%mnNHplantdate (0:mxpft) )
- allocate( this%mxNHplantdate (0:mxpft) )
- allocate( this%mnSHplantdate (0:mxpft) )
- allocate( this%mxSHplantdate (0:mxpft) )
- allocate( this%planttemp (0:mxpft) )
- allocate( this%minplanttemp (0:mxpft) )
- allocate( this%froot_leaf (0:mxpft) )
- allocate( this%stem_leaf (0:mxpft) )
- allocate( this%croot_stem (0:mxpft) )
- allocate( this%flivewd (0:mxpft) )
- allocate( this%fcur (0:mxpft) )
- allocate( this%fcurdv (0:mxpft) )
- allocate( this%lf_flab (0:mxpft) )
- allocate( this%lf_fcel (0:mxpft) )
- allocate( this%lf_flig (0:mxpft) )
- allocate( this%fr_flab (0:mxpft) )
- allocate( this%fr_fcel (0:mxpft) )
- allocate( this%fr_flig (0:mxpft) )
- allocate( this%leaf_long (0:mxpft) )
- allocate( this%evergreen (0:mxpft) )
- allocate( this%stress_decid (0:mxpft) )
- allocate( this%season_decid (0:mxpft) )
- allocate( this%dwood (0:mxpft) )
- allocate( this%root_density (0:mxpft) )
- allocate( this%root_radius (0:mxpft) )
- allocate( this%pconv (0:mxpft) )
- allocate( this%pprod10 (0:mxpft) )
- allocate( this%pprod100 (0:mxpft) )
- allocate( this%pprodharv10 (0:mxpft) )
- allocate( this%cc_leaf (0:mxpft) )
- allocate( this%cc_lstem (0:mxpft) )
- allocate( this%cc_dstem (0:mxpft) )
- allocate( this%cc_other (0:mxpft) )
- allocate( this%fm_leaf (0:mxpft) )
- allocate( this%fm_lstem (0:mxpft) )
- allocate( this%fm_dstem (0:mxpft) )
- allocate( this%fm_other (0:mxpft) )
- allocate( this%fm_root (0:mxpft) )
- allocate( this%fm_lroot (0:mxpft) )
- allocate( this%fm_droot (0:mxpft) )
- allocate( this%fsr_pft (0:mxpft) )
- allocate( this%fd_pft (0:mxpft) )
- allocate( this%manunitro (0:mxpft) )
- allocate( this%fleafcn (0:mxpft) )
- allocate( this%ffrootcn (0:mxpft) )
- allocate( this%fstemcn (0:mxpft) )
- allocate( this%i_vcad (0:mxpft) )
- allocate( this%s_vcad (0:mxpft) )
- allocate( this%i_flnr (0:mxpft) )
- allocate( this%s_flnr (0:mxpft) )
- allocate( this%pftpar20 (0:mxpft) )
- allocate( this%pftpar28 (0:mxpft) )
- allocate( this%pftpar29 (0:mxpft) )
- allocate( this%pftpar30 (0:mxpft) )
- allocate( this%pftpar31 (0:mxpft) )
- allocate( this%a_fix (0:mxpft) )
- allocate( this%b_fix (0:mxpft) )
- allocate( this%c_fix (0:mxpft) )
- allocate( this%s_fix (0:mxpft) )
- allocate( this%akc_active (0:mxpft) )
- allocate( this%akn_active (0:mxpft) )
- allocate( this%ekc_active (0:mxpft) )
- allocate( this%ekn_active (0:mxpft) )
- allocate( this%kc_nonmyc (0:mxpft) )
- allocate( this%kn_nonmyc (0:mxpft) )
- allocate( this%kr_resorb (0:mxpft) )
- allocate( this%perecm (0:mxpft) )
- allocate( this%root_dmx (0:mxpft) )
- allocate( this%fun_cn_flex_a (0:mxpft) )
- allocate( this%fun_cn_flex_b (0:mxpft) )
- allocate( this%fun_cn_flex_c (0:mxpft) )
- allocate( this%FUN_fracfixers(0:mxpft) )
-
-
- end subroutine InitAllocate
-
- !-----------------------------------------------------------------------
- subroutine InitRead(this)
- !
- ! !DESCRIPTION:
- ! Read and initialize vegetation (PFT) constants
- !
- ! !USES:
- use shr_log_mod , only : errMsg => shr_log_errMsg
- use fileutils , only : getfil
- use ncdio_pio , only : ncd_io, ncd_pio_closefile, ncd_pio_openfile, file_desc_t
- use ncdio_pio , only : ncd_inqdid, ncd_inqdlen
- use clm_varctl , only : paramfile, use_flexibleCN, use_dynroot
- use spmdMod , only : masterproc
- !
- ! !ARGUMENTS:
- class(pftcon_type) :: this
- !
- ! !LOCAL VARIABLES:
- character(len=256) :: locfn ! local file name
- integer :: i,n,m ! loop indices
- integer :: ier ! error code
- type(file_desc_t) :: ncid ! pio netCDF file id
- integer :: dimid ! netCDF dimension id
- integer :: npft ! number of pfts on pft-physiology file
- logical :: readv ! read variable in or not
- character(len=32) :: subname = 'InitRead' ! subroutine name
- character(len=pftname_len) :: expected_pftnames(0:mxpft)
- character(len=512) :: msg
- !-----------------------------------------------------------------------
- !
- ! Expected PFT names: The names expected on the paramfile file and the order they are expected to be in.
- ! NOTE: similar types are assumed to be together, first trees (ending with broadleaf_deciduous_boreal_tree
- ! then shrubs, ending with broadleaf_deciduous_boreal_shrub, then grasses starting with c3_arctic_grass
- ! and finally crops, ending with irrigated_tropical_soybean
- ! DO NOT CHANGE THE ORDER -- WITHOUT MODIFYING OTHER PARTS OF THE CODE WHERE THE ORDER MATTERS!
-
- expected_pftnames( 0) = 'not_vegetated '
- expected_pftnames( 1) = 'needleleaf_evergreen_temperate_tree'
- expected_pftnames( 2) = 'needleleaf_evergreen_boreal_tree '
- expected_pftnames( 3) = 'needleleaf_deciduous_boreal_tree '
- expected_pftnames( 4) = 'broadleaf_evergreen_tropical_tree '
- expected_pftnames( 5) = 'broadleaf_evergreen_temperate_tree '
- expected_pftnames( 6) = 'broadleaf_deciduous_tropical_tree '
- expected_pftnames( 7) = 'broadleaf_deciduous_temperate_tree '
- expected_pftnames( 8) = 'broadleaf_deciduous_boreal_tree '
- expected_pftnames( 9) = 'broadleaf_evergreen_shrub '
- expected_pftnames(10) = 'broadleaf_deciduous_temperate_shrub'
- expected_pftnames(11) = 'broadleaf_deciduous_boreal_shrub '
- expected_pftnames(12) = 'c3_arctic_grass '
- expected_pftnames(13) = 'c3_non-arctic_grass '
- expected_pftnames(14) = 'c4_grass '
- expected_pftnames(15) = 'c3_crop '
- expected_pftnames(16) = 'c3_irrigated '
- expected_pftnames(17) = 'temperate_corn '
- expected_pftnames(18) = 'irrigated_temperate_corn '
- expected_pftnames(19) = 'spring_wheat '
- expected_pftnames(20) = 'irrigated_spring_wheat '
- expected_pftnames(21) = 'winter_wheat '
- expected_pftnames(22) = 'irrigated_winter_wheat '
- expected_pftnames(23) = 'temperate_soybean '
- expected_pftnames(24) = 'irrigated_temperate_soybean '
- expected_pftnames(25) = 'barley '
- expected_pftnames(26) = 'irrigated_barley '
- expected_pftnames(27) = 'winter_barley '
- expected_pftnames(28) = 'irrigated_winter_barley '
- expected_pftnames(29) = 'rye '
- expected_pftnames(30) = 'irrigated_rye '
- expected_pftnames(31) = 'winter_rye '
- expected_pftnames(32) = 'irrigated_winter_rye '
- expected_pftnames(33) = 'cassava '
- expected_pftnames(34) = 'irrigated_cassava '
- expected_pftnames(35) = 'citrus '
- expected_pftnames(36) = 'irrigated_citrus '
- expected_pftnames(37) = 'cocoa '
- expected_pftnames(38) = 'irrigated_cocoa '
- expected_pftnames(39) = 'coffee '
- expected_pftnames(40) = 'irrigated_coffee '
- expected_pftnames(41) = 'cotton '
- expected_pftnames(42) = 'irrigated_cotton '
- expected_pftnames(43) = 'datepalm '
- expected_pftnames(44) = 'irrigated_datepalm '
- expected_pftnames(45) = 'foddergrass '
- expected_pftnames(46) = 'irrigated_foddergrass '
- expected_pftnames(47) = 'grapes '
- expected_pftnames(48) = 'irrigated_grapes '
- expected_pftnames(49) = 'groundnuts '
- expected_pftnames(50) = 'irrigated_groundnuts '
- expected_pftnames(51) = 'millet '
- expected_pftnames(52) = 'irrigated_millet '
- expected_pftnames(53) = 'oilpalm '
- expected_pftnames(54) = 'irrigated_oilpalm '
- expected_pftnames(55) = 'potatoes '
- expected_pftnames(56) = 'irrigated_potatoes '
- expected_pftnames(57) = 'pulses '
- expected_pftnames(58) = 'irrigated_pulses '
- expected_pftnames(59) = 'rapeseed '
- expected_pftnames(60) = 'irrigated_rapeseed '
- expected_pftnames(61) = 'rice '
- expected_pftnames(62) = 'irrigated_rice '
- expected_pftnames(63) = 'sorghum '
- expected_pftnames(64) = 'irrigated_sorghum '
- expected_pftnames(65) = 'sugarbeet '
- expected_pftnames(66) = 'irrigated_sugarbeet '
- expected_pftnames(67) = 'sugarcane '
- expected_pftnames(68) = 'irrigated_sugarcane '
- expected_pftnames(69) = 'sunflower '
- expected_pftnames(70) = 'irrigated_sunflower '
- expected_pftnames(71) = 'miscanthus '
- expected_pftnames(72) = 'irrigated_miscanthus '
- expected_pftnames(73) = 'switchgrass '
- expected_pftnames(74) = 'irrigated_switchgrass '
- expected_pftnames(75) = 'tropical_corn '
- expected_pftnames(76) = 'irrigated_tropical_corn '
- expected_pftnames(77) = 'tropical_soybean '
- expected_pftnames(78) = 'irrigated_tropical_soybean '
-
- ! Set specific vegetation type values
-
- if (masterproc) then
- write(iulog,*) 'Attempting to read PFT physiological data .....'
- end if
- call getfil (paramfile, locfn, 0)
- call ncd_pio_openfile (ncid, trim(locfn), 0)
- call ncd_inqdid(ncid, 'pft', dimid)
- call ncd_inqdlen(ncid, dimid, npft)
-
- if (npft - 1 /= mxpft) then
- ! NOTE(bja, 201503) need to subtract 1 because of indexing.
- ! NOTE(bja, 201503) fail early because one of the io libs
- ! throws a useless abort error message deep inside the stack
- ! instead of returning readv so we can get a useful line
- ! number.
- write(msg, '(a, i4, a, i4, a)') "ERROR: The number of pfts in the input netcdf file (", &
- npft, ") does not equal the expected number of pfts (", mxpft, "). "
- call endrun(msg=trim(msg)//errMsg(sourcefile, __LINE__))
- end if
-
- call ncd_io('pftname',pftname, 'read', ncid, readvar=readv, posNOTonfile=.true.)
- if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__))
-
- call ncd_io('z0mr', this%z0mr, 'read', ncid, readvar=readv, posNOTonfile=.true.)
- if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__))
-
- call ncd_io('displar', this%displar, 'read', ncid, readvar=readv, posNOTonfile=.true.)
- if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__))
-
- call ncd_io('dleaf', this%dleaf, 'read', ncid, readvar=readv, posNOTonfile=.true.)
- if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__))
-
- call ncd_io('c3psn', this%c3psn, 'read', ncid, readvar=readv, posNOTonfile=.true.)
- if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__))
-
- call ncd_io('rholvis', this%rhol(:,ivis), 'read', ncid, readvar=readv, posNOTonfile=.true.)
- if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__))
-
- call ncd_io('rholnir', this%rhol(:,inir), 'read', ncid, readvar=readv, posNOTonfile=.true.)
- if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__))
-
- call ncd_io('rhosvis', this%rhos(:,ivis), 'read', ncid, readvar=readv, posNOTonfile=.true.)
- if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__))
-
- call ncd_io('rhosnir', this% rhos(:,inir), 'read', ncid, readvar=readv, posNOTonfile=.true.)
- if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__))
-
- call ncd_io('taulvis', this%taul(:,ivis), 'read', ncid, readvar=readv, posNOTonfile=.true.)
- if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__))
-
- call ncd_io('taulnir', this%taul(:,inir), 'read', ncid, readvar=readv, posNOTonfile=.true.)
- if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__))
-
- call ncd_io('tausvis', this%taus(:,ivis), 'read', ncid, readvar=readv, posNOTonfile=.true.)
- if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__))
-
- call ncd_io('tausnir', this%taus(:,inir), 'read', ncid, readvar=readv, posNOTonfile=.true.)
- if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__))
-
- call ncd_io('xl', this%xl, 'read', ncid, readvar=readv, posNOTonfile=.true.)
- if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__))
-
- call ncd_io('roota_par', this%roota_par, 'read', ncid, readvar=readv, posNOTonfile=.true.)
- if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__))
-
- call ncd_io('rootb_par', this%rootb_par, 'read', ncid, readvar=readv, posNOTonfile=.true.)
- if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__))
-
- call ncd_io('slatop', this%slatop, 'read', ncid, readvar=readv, posNOTonfile=.true.)
- if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__))
-
- call ncd_io('dsladlai', this%dsladlai, 'read', ncid, readvar=readv, posNOTonfile=.true.)
- if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__))
-
- call ncd_io('leafcn', this%leafcn, 'read', ncid, readvar=readv, posNOTonfile=.true.)
- if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__))
-
- call ncd_io('flnr', this%flnr, 'read', ncid, readvar=readv, posNOTonfile=.true.)
- if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__))
-
- call ncd_io('smpso', this%smpso, 'read', ncid, readvar=readv, posNOTonfile=.true.)
- if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__))
-
- call ncd_io('smpsc', this%smpsc, 'read', ncid, readvar=readv, posNOTonfile=.true.)
- if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__))
-
- call ncd_io('fnitr', this%fnitr, 'read', ncid, readvar=readv, posNOTonfile=.true.)
- if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__))
-
- call ncd_io('woody', this%woody, 'read', ncid, readvar=readv, posNOTonfile=.true.)
- if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__))
-
- call ncd_io('lflitcn', this%lflitcn, 'read', ncid, readvar=readv, posNOTonfile=.true.)
- if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__))
-
- call ncd_io('frootcn', this%frootcn, 'read', ncid, readvar=readv, posNOTonfile=.true.)
- if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__))
-
- call ncd_io('livewdcn', this%livewdcn, 'read', ncid, readvar=readv, posNOTonfile=.true.)
- if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__))
-
- call ncd_io('deadwdcn', this%deadwdcn, 'read', ncid, readvar=readv, posNOTonfile=.true.)
- if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__))
-
- call ncd_io('grperc', this%grperc, 'read', ncid, readvar=readv, posNOTonfile=.true.)
- if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__))
-
- call ncd_io('grpnow', this%grpnow, 'read', ncid, readvar=readv, posNOTonfile=.true.)
- if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__))
-
- call ncd_io('froot_leaf', this%froot_leaf, 'read', ncid, readvar=readv, posNOTonfile=.true.)
- if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__))
-
- call ncd_io('stem_leaf', this%stem_leaf, 'read', ncid, readvar=readv, posNOTonfile=.true.)
- if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__))
-
- call ncd_io('croot_stem', this%croot_stem, 'read', ncid, readvar=readv, posNOTonfile=.true.)
- if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__))
-
- call ncd_io('flivewd', this%flivewd, 'read', ncid, readvar=readv, posNOTonfile=.true.)
- if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__))
-
- call ncd_io('fcur', this%fcur, 'read', ncid, readvar=readv, posNOTonfile=.true.)
- if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__))
-
- call ncd_io('fcurdv', this%fcurdv, 'read', ncid, readvar=readv, posNOTonfile=.true.)
- if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__))
-
- call ncd_io('lf_flab', this%lf_flab, 'read', ncid, readvar=readv, posNOTonfile=.true.)
- if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__))
-
- call ncd_io('lf_fcel', this%lf_fcel, 'read', ncid, readvar=readv, posNOTonfile=.true.)
- if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__))
-
- call ncd_io('lf_flig', this%lf_flig, 'read', ncid, readvar=readv, posNOTonfile=.true.)
- if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__))
-
- call ncd_io('fr_flab', this%fr_flab, 'read', ncid, readvar=readv, posNOTonfile=.true.)
- if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__))
-
- call ncd_io('fr_fcel', this%fr_fcel, 'read', ncid, readvar=readv, posNOTonfile=.true.)
- if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__))
-
- call ncd_io('fr_flig', this%fr_flig, 'read', ncid, readvar=readv, posNOTonfile=.true.)
- if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__))
-
- call ncd_io('leaf_long', this%leaf_long, 'read', ncid, readvar=readv, posNOTonfile=.true.)
- if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__))
-
- call ncd_io('evergreen', this%evergreen, 'read', ncid, readvar=readv, posNOTonfile=.true.)
- if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__))
-
- call ncd_io('stress_decid', this%stress_decid, 'read', ncid, readvar=readv, posNOTonfile=.true.)
- if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__))
-
- call ncd_io('season_decid', this%season_decid, 'read', ncid, readvar=readv, posNOTonfile=.true.)
- if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__))
-
- call ncd_io('pftpar20', this%pftpar20, 'read', ncid, readvar=readv, posNOTonfile=.true.)
- if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__))
-
- call ncd_io('pftpar28', this%pftpar28, 'read', ncid, readvar=readv, posNOTonfile=.true.)
- if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__))
-
- call ncd_io('pftpar29', this%pftpar29, 'read', ncid, readvar=readv, posNOTonfile=.true.)
- if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__))
-
- call ncd_io('pftpar30', this%pftpar30, 'read', ncid, readvar=readv, posNOTonfile=.true.)
- if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__))
-
- call ncd_io('pftpar31', this%pftpar31, 'read', ncid, readvar=readv, posNOTonfile=.true.)
- if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__))
-
- call ncd_io('a_fix', this%a_fix, 'read', ncid, readvar=readv, posNOTonfile=.true.)
- if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__))
-
- call ncd_io('b_fix', this%b_fix, 'read', ncid, readvar=readv, posNOTonfile=.true.)
- if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__))
-
- call ncd_io('c_fix', this%c_fix, 'read', ncid, readvar=readv, posNOTonfile=.true.)
- if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__))
-
- call ncd_io('s_fix', this%s_fix, 'read', ncid, readvar=readv, posNOTonfile=.true.)
- if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__))
-
- call ncd_io('akc_active', this%akc_active, 'read', ncid, readvar=readv, posNOTonfile=.true.)
- if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__))
-
- call ncd_io('akn_active', this%akn_active, 'read', ncid, readvar=readv, posNOTonfile=.true.)
- if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__))
-
- call ncd_io('ekc_active', this%ekc_active, 'read', ncid, readvar=readv, posNOTonfile=.true.)
- if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__))
-
- call ncd_io('ekn_active', this%ekn_active, 'read', ncid, readvar=readv, posNOTonfile=.true.)
- if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__))
-
- call ncd_io('kc_nonmyc', this%kc_nonmyc, 'read', ncid, readvar=readv, posNOTonfile=.true.)
- if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__))
-
- call ncd_io('kn_nonmyc', this%kn_nonmyc, 'read', ncid, readvar=readv, posNOTonfile=.true.)
- if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__))
-
- call ncd_io('kr_resorb', this%kr_resorb, 'read', ncid, readvar=readv, posNOTonfile=.true.)
- if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__))
-
- call ncd_io('perecm', this%perecm, 'read', ncid, readvar=readv, posNOTonfile=.true.)
- if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__))
-
- call ncd_io('fun_cn_flex_a', this%fun_cn_flex_a, 'read', ncid, readvar=readv, posNOTonfile=.true.)
- if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__))
-
- call ncd_io('fun_cn_flex_b', this%fun_cn_flex_b, 'read', ncid, readvar=readv, posNOTonfile=.true.)
- if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__))
-
- call ncd_io('fun_cn_flex_c', this%fun_cn_flex_c, 'read', ncid, readvar=readv, posNOTonfile=.true.)
- if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__))
-
- call ncd_io('FUN_fracfixers', this%FUN_fracfixers, 'read', ncid, readvar=readv, posNOTonfile=.true.)
- if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__))
-
- call ncd_io('manunitro', this%manunitro, 'read', ncid, readvar=readv, posNOTonfile=.true.)
- if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__))
-
- call ncd_io('fleafcn', this%fleafcn, 'read', ncid, readvar=readv, posNOTonfile=.true.)
- if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__))
-
- call ncd_io('ffrootcn', this%ffrootcn, 'read', ncid, readvar=readv, posNOTonfile=.true.)
- if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__))
-
- call ncd_io('fstemcn', this%fstemcn, 'read', ncid, readvar=readv, posNOTonfile=.true.)
- if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__))
-
- call ncd_io('rootprof_beta', this%rootprof_beta, 'read', ncid, readvar=readv, posNOTonfile=.true.)
- if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__))
-
- call ncd_io('pconv', this%pconv, 'read', ncid, readvar=readv)
- if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__))
-
- call ncd_io('pprod10', this%pprod10, 'read', ncid, readvar=readv)
- if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__))
-
- call ncd_io('pprodharv10', this%pprodharv10, 'read', ncid, readvar=readv)
- if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__))
-
- call ncd_io('pprod100', this%pprod100, 'read', ncid, readvar=readv)
- if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__))
-
- call ncd_io('graincn', this%graincn, 'read', ncid, readvar=readv)
- if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__))
-
- call ncd_io('mxtmp', this%mxtmp, 'read', ncid, readvar=readv)
- if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__))
-
- call ncd_io('baset', this%baset, 'read', ncid, readvar=readv)
- if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__))
-
- call ncd_io('declfact', this%declfact, 'read', ncid, readvar=readv)
- if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__))
-
- call ncd_io('bfact', this%bfact, 'read', ncid, readvar=readv)
- if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__))
-
- call ncd_io('aleaff', this%aleaff, 'read', ncid, readvar=readv)
- if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__))
-
- call ncd_io('arootf', this%arootf, 'read', ncid, readvar=readv)
- if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__))
-
- call ncd_io('astemf', this%astemf, 'read', ncid, readvar=readv)
- if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__))
-
- call ncd_io('arooti', this%arooti, 'read', ncid, readvar=readv)
- if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__))
-
- call ncd_io('fleafi', this%fleafi, 'read', ncid, readvar=readv)
- if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__))
-
- call ncd_io('allconsl', this%allconsl, 'read', ncid, readvar=readv)
- if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__))
-
- call ncd_io('allconss', this%allconss, 'read', ncid, readvar=readv)
- if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__))
-
- call ncd_io('crop', this%crop, 'read', ncid, readvar=readv)
- if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__))
-
- call ncd_io('mergetoclmpft', this%mergetoclmpft, 'read', ncid, readvar=readv)
- if ( .not. readv ) then
- call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__))
- end if
-
- call ncd_io('irrigated', this%irrigated, 'read', ncid, readvar=readv)
- if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__))
-
- call ncd_io('ztopmx', this%ztopmx, 'read', ncid, readvar=readv)
- if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__))
-
- call ncd_io('laimx', this%laimx, 'read', ncid, readvar=readv)
- if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__))
-
- call ncd_io('gddmin', this%gddmin, 'read', ncid, readvar=readv)
- if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__))
-
- call ncd_io('hybgdd', this%hybgdd, 'read', ncid, readvar=readv)
- if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__))
-
- call ncd_io('lfemerg', this%lfemerg, 'read', ncid, readvar=readv)
- if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__))
-
- call ncd_io('grnfill', this%grnfill, 'read', ncid, readvar=readv)
- if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__))
-
- call ncd_io('mbbopt', this%mbbopt, 'read', ncid, readvar=readv)
- if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__))
-
- call ncd_io('medlynslope', this%medlynslope, 'read', ncid, readvar=readv)
- if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__))
-
- call ncd_io('medlynintercept', this%medlynintercept, 'read', ncid, readvar=readv)
- if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__))
-
- call ncd_io('mxmat', this%mxmat, 'read', ncid, readvar=readv)
- if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__))
-
- call ncd_io('cc_leaf', this% cc_leaf, 'read', ncid, readvar=readv)
- if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__))
-
- call ncd_io('cc_lstem', this%cc_lstem, 'read', ncid, readvar=readv)
- if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__))
-
- call ncd_io('cc_dstem', this%cc_dstem, 'read', ncid, readvar=readv)
- if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__))
-
- call ncd_io('cc_other', this%cc_other, 'read', ncid, readvar=readv)
- if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__))
-
- call ncd_io('fm_leaf', this% fm_leaf, 'read', ncid, readvar=readv)
- if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__))
-
- call ncd_io('fm_lstem', this%fm_lstem, 'read', ncid, readvar=readv)
- if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__))
-
- call ncd_io('fm_dstem', this%fm_dstem, 'read', ncid, readvar=readv)
- if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__))
-
- call ncd_io('fm_other', this%fm_other, 'read', ncid, readvar=readv)
- if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__))
-
- call ncd_io('fm_root', this% fm_root, 'read', ncid, readvar=readv)
- if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__))
-
- call ncd_io('fm_lroot', this%fm_lroot, 'read', ncid, readvar=readv)
- if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__))
-
- call ncd_io('fm_droot', this%fm_droot, 'read', ncid, readvar=readv)
- if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__))
-
- call ncd_io('fsr_pft', this% fsr_pft, 'read', ncid, readvar=readv)
- if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__))
-
- call ncd_io('fd_pft', this% fd_pft, 'read', ncid, readvar=readv)
- if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__))
-
- call ncd_io('planting_temp', this%planttemp, 'read', ncid, readvar=readv)
- if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__))
-
- call ncd_io('min_planting_temp', this%minplanttemp, 'read', ncid, readvar=readv)
- if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__))
-
- call ncd_io('min_NH_planting_date', this%mnNHplantdate, 'read', ncid, readvar=readv)
- if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__))
-
- call ncd_io('min_SH_planting_date', this%mnSHplantdate, 'read', ncid, readvar=readv)
- if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__))
-
- call ncd_io('max_NH_planting_date', this%mxNHplantdate, 'read', ncid, readvar=readv)
- if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__))
-
- call ncd_io('max_SH_planting_date', this%mxSHplantdate, 'read', ncid, readvar=readv)
- if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__))
-
- !
- ! Constants
- !
- !MV (10-08-14) TODO is this right - used to be numpft - is it okay to set it to mxpft?
- do m = 0,mxpft
- this%dwood(m) = dwood
- this%root_radius(m) = root_radius
- this%root_density(m) = root_density
-
- if (m <= ntree) then
- this%tree(m) = 1
- else
- this%tree(m) = 0
- end if
- end do
- !
- ! clm 5 nitrogen variables
- !
- if (use_flexibleCN) then
- call ncd_io('i_vcad', this%i_vcad, 'read', ncid, readvar=readv)
- if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__))
-
- call ncd_io('s_vcad', this%s_vcad, 'read', ncid, readvar=readv)
- if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__))
-
- call ncd_io('i_flnr', this%i_flnr, 'read', ncid, readvar=readv)
- if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__))
-
- call ncd_io('s_flnr', this%s_flnr, 'read', ncid, readvar=readv)
- if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__))
- end if
-
- !
- ! Dynamic Root variables for crops
- !
- if ( use_crop .and. use_dynroot )then
- call ncd_io('root_dmx', this%root_dmx, 'read', ncid, readvar=readv)
- if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__))
- end if
-
- call ncd_pio_closefile(ncid)
-
- do i = 0, mxpft
- if ( trim(adjustl(pftname(i))) /= trim(expected_pftnames(i)) )then
- write(iulog,*)'pftconrd: pftname is NOT what is expected, name = ', &
- trim(pftname(i)), ', expected name = ', trim(expected_pftnames(i))
- call endrun(msg='pftconrd: bad name for pft on paramfile dataset'//errMsg(sourcefile, __LINE__))
- end if
-
- if ( trim(pftname(i)) == 'not_vegetated' ) noveg = i
- if ( trim(pftname(i)) == 'needleleaf_evergreen_temperate_tree' ) ndllf_evr_tmp_tree = i
- if ( trim(pftname(i)) == 'needleleaf_evergreen_boreal_tree' ) ndllf_evr_brl_tree = i
- if ( trim(pftname(i)) == 'needleleaf_deciduous_boreal_tree' ) ndllf_dcd_brl_tree = i
- if ( trim(pftname(i)) == 'broadleaf_evergreen_tropical_tree' ) nbrdlf_evr_trp_tree = i
- if ( trim(pftname(i)) == 'broadleaf_evergreen_temperate_tree' ) nbrdlf_evr_tmp_tree = i
- if ( trim(pftname(i)) == 'broadleaf_deciduous_tropical_tree' ) nbrdlf_dcd_trp_tree = i
- if ( trim(pftname(i)) == 'broadleaf_deciduous_temperate_tree' ) nbrdlf_dcd_tmp_tree = i
- if ( trim(pftname(i)) == 'broadleaf_deciduous_boreal_tree' ) nbrdlf_dcd_brl_tree = i
- if ( trim(pftname(i)) == 'broadleaf_evergreen_shrub' ) nbrdlf_evr_shrub = i
- if ( trim(pftname(i)) == 'broadleaf_deciduous_temperate_shrub' ) nbrdlf_dcd_tmp_shrub = i
- if ( trim(pftname(i)) == 'broadleaf_deciduous_boreal_shrub' ) nbrdlf_dcd_brl_shrub = i
- if ( trim(pftname(i)) == 'c3_arctic_grass' ) nc3_arctic_grass = i
- if ( trim(pftname(i)) == 'c3_non-arctic_grass' ) nc3_nonarctic_grass = i
- if ( trim(pftname(i)) == 'c4_grass' ) nc4_grass = i
- if ( trim(pftname(i)) == 'c3_crop' ) nc3crop = i
- if ( trim(pftname(i)) == 'c3_irrigated' ) nc3irrig = i
- if ( trim(pftname(i)) == 'temperate_corn' ) ntmp_corn = i
- if ( trim(pftname(i)) == 'irrigated_temperate_corn' ) nirrig_tmp_corn = i
- if ( trim(pftname(i)) == 'spring_wheat' ) nswheat = i
- if ( trim(pftname(i)) == 'irrigated_spring_wheat' ) nirrig_swheat = i
- if ( trim(pftname(i)) == 'winter_wheat' ) nwwheat = i
- if ( trim(pftname(i)) == 'irrigated_winter_wheat' ) nirrig_wwheat = i
- if ( trim(pftname(i)) == 'temperate_soybean' ) ntmp_soybean = i
- if ( trim(pftname(i)) == 'irrigated_temperate_soybean' ) nirrig_tmp_soybean = i
- if ( trim(pftname(i)) == 'barley' ) nbarley = i
- if ( trim(pftname(i)) == 'irrigated_barley' ) nirrig_barley = i
- if ( trim(pftname(i)) == 'winter_barley' ) nwbarley = i
- if ( trim(pftname(i)) == 'irrigated_winter_barley' ) nirrig_wbarley = i
- if ( trim(pftname(i)) == 'rye' ) nrye = i
- if ( trim(pftname(i)) == 'irrigated_rye' ) nirrig_rye = i
- if ( trim(pftname(i)) == 'winter_rye' ) nwrye = i
- if ( trim(pftname(i)) == 'irrigated_winter_rye' ) nirrig_wrye = i
- if ( trim(pftname(i)) == 'cassava' ) ncassava = i
- if ( trim(pftname(i)) == 'irrigated_cassava' ) nirrig_cassava = i
- if ( trim(pftname(i)) == 'citrus' ) ncitrus = i
- if ( trim(pftname(i)) == 'irrigated_citrus' ) nirrig_citrus = i
- if ( trim(pftname(i)) == 'cocoa' ) ncocoa = i
- if ( trim(pftname(i)) == 'irrigated_cocoa' ) nirrig_cocoa = i
- if ( trim(pftname(i)) == 'coffee' ) ncoffee = i
- if ( trim(pftname(i)) == 'irrigated_coffee' ) nirrig_coffee = i
- if ( trim(pftname(i)) == 'cotton' ) ncotton = i
- if ( trim(pftname(i)) == 'irrigated_cotton' ) nirrig_cotton = i
- if ( trim(pftname(i)) == 'datepalm' ) ndatepalm = i
- if ( trim(pftname(i)) == 'irrigated_datepalm' ) nirrig_datepalm = i
- if ( trim(pftname(i)) == 'foddergrass' ) nfoddergrass = i
- if ( trim(pftname(i)) == 'irrigated_foddergrass' ) nirrig_foddergrass = i
- if ( trim(pftname(i)) == 'grapes' ) ngrapes = i
- if ( trim(pftname(i)) == 'irrigated_grapes' ) nirrig_grapes = i
- if ( trim(pftname(i)) == 'groundnuts' ) ngroundnuts = i
- if ( trim(pftname(i)) == 'irrigated_groundnuts' ) nirrig_groundnuts = i
- if ( trim(pftname(i)) == 'millet' ) nmillet = i
- if ( trim(pftname(i)) == 'irrigated_millet' ) nirrig_millet = i
- if ( trim(pftname(i)) == 'oilpalm' ) noilpalm = i
- if ( trim(pftname(i)) == 'irrigated_oilpalm' ) nirrig_oilpalm = i
- if ( trim(pftname(i)) == 'potatoes' ) npotatoes = i
- if ( trim(pftname(i)) == 'irrigated_potatoes' ) nirrig_potatoes = i
- if ( trim(pftname(i)) == 'pulses' ) npulses = i
- if ( trim(pftname(i)) == 'irrigated_pulses' ) nirrig_pulses = i
- if ( trim(pftname(i)) == 'rapeseed' ) nrapeseed = i
- if ( trim(pftname(i)) == 'irrigated_rapeseed' ) nirrig_rapeseed = i
- if ( trim(pftname(i)) == 'rice' ) nrice = i
- if ( trim(pftname(i)) == 'irrigated_rice' ) nirrig_rice = i
- if ( trim(pftname(i)) == 'sorghum' ) nsorghum = i
- if ( trim(pftname(i)) == 'irrigated_sorghum' ) nirrig_sorghum = i
- if ( trim(pftname(i)) == 'sugarbeet' ) nsugarbeet = i
- if ( trim(pftname(i)) == 'irrigated_sugarbeet' ) nirrig_sugarbeet = i
- if ( trim(pftname(i)) == 'sugarcane' ) nsugarcane = i
- if ( trim(pftname(i)) == 'irrigated_sugarcane' ) nirrig_sugarcane = i
- if ( trim(pftname(i)) == 'sunflower' ) nsunflower = i
- if ( trim(pftname(i)) == 'irrigated_sunflower' ) nirrig_sunflower = i
- if ( trim(pftname(i)) == 'miscanthus' ) nmiscanthus = i
- if ( trim(pftname(i)) == 'irrigated_miscanthus' ) nirrig_miscanthus = i
- if ( trim(pftname(i)) == 'switchgrass' ) nswitchgrass = i
- if ( trim(pftname(i)) == 'irrigated_switchgrass' ) nirrig_switchgrass = i
- if ( trim(pftname(i)) == 'tropical_corn' ) ntrp_corn = i
- if ( trim(pftname(i)) == 'irrigated_tropical_corn' ) nirrig_trp_corn = i
- if ( trim(pftname(i)) == 'tropical_soybean' ) ntrp_soybean = i
- if ( trim(pftname(i)) == 'irrigated_tropical_soybean' ) nirrig_trp_soybean = i
- end do
-
- ntree = nbrdlf_dcd_brl_tree ! value for last type of tree
- npcropmin = ntmp_corn ! first prognostic crop
- npcropmax = mxpft ! last prognostic crop in list
-
- call this%set_is_pft_known_to_model()
- call this%set_num_cfts_known_to_model()
-
- if (use_cndv) then
- this%fcur(:) = this%fcurdv(:)
- end if
- !
- ! Do some error checking.
- !
- ! FIX(SPM,032414) double check if some of these should be on...
-
- if ( npcropmax /= mxpft )then
- call endrun(msg=' ERROR: npcropmax is NOT the last value'//errMsg(sourcefile, __LINE__))
- end if
- do i = 0, mxpft
- if ( this%irrigated(i) == 1.0_r8 .and. &
- (i == nc3irrig .or. &
- i == nirrig_tmp_corn .or. &
- i == nirrig_swheat .or. i == nirrig_wwheat .or. &
- i == nirrig_tmp_soybean .or. &
- i == nirrig_barley .or. i == nirrig_wbarley .or. &
- i == nirrig_rye .or. i == nirrig_wrye .or. &
- i == nirrig_cassava .or. &
- i == nirrig_citrus .or. &
- i == nirrig_cocoa .or. i == nirrig_coffee .or. &
- i == nirrig_cotton .or. &
- i == nirrig_datepalm .or. &
- i == nirrig_foddergrass .or. &
- i == nirrig_grapes .or. i == nirrig_groundnuts .or. &
- i == nirrig_millet .or. &
- i == nirrig_oilpalm .or. &
- i == nirrig_potatoes .or. i == nirrig_pulses .or. &
- i == nirrig_rapeseed .or. i == nirrig_rice .or. &
- i == nirrig_sorghum .or. &
- i == nirrig_sugarbeet .or. i == nirrig_sugarcane .or. &
- i == nirrig_sunflower .or. &
- i == nirrig_miscanthus .or. i == nirrig_switchgrass .or. &
- i == nirrig_trp_corn .or. &
- i == nirrig_trp_soybean) )then
- ! correct
- else if ( this%irrigated(i) == 0.0_r8 )then
- ! correct
- else
- call endrun(msg=' ERROR: irrigated has wrong values'//errMsg(sourcefile, __LINE__))
- end if
- if ( this%crop(i) == 1.0_r8 .and. (i >= nc3crop .and. i <= npcropmax) )then
- ! correct
- else if ( this%crop(i) == 0.0_r8 )then
- ! correct
- else
- call endrun(msg=' ERROR: crop has wrong values'//errMsg(sourcefile, __LINE__))
- end if
- if ( (i /= noveg) .and. (i < npcropmin) .and. &
- abs(this%pconv(i) + this%pprod10(i) + this%pprod100(i) - 1.0_r8) > 1.e-7_r8 )then
- call endrun(msg=' ERROR: pconv+pprod10+pprod100 do NOT sum to one.'//errMsg(sourcefile, __LINE__))
- end if
- if ( this%pprodharv10(i) > 1.0_r8 .or. this%pprodharv10(i) < 0.0_r8 )then
- call endrun(msg=' ERROR: pprodharv10 outside of range.'//errMsg(sourcefile, __LINE__))
- end if
- end do
-
- if (masterproc) then
- write(iulog,*) 'Successfully read PFT physiological data'
- write(iulog,*)
- end if
-
- end subroutine InitRead
-
- !-----------------------------------------------------------------------
- subroutine set_is_pft_known_to_model(this)
- !
- ! !DESCRIPTION:
- ! Set is_pft_known_to_model based on mergetoclmpft
- !
- ! !USES:
- !
- ! !ARGUMENTS:
- class(pftcon_type), intent(inout) :: this
- !
- ! !LOCAL VARIABLES:
- integer :: m, merge_type
-
- character(len=*), parameter :: subname = 'set_is_pft_known_to_model'
- !-----------------------------------------------------------------------
-
- this%is_pft_known_to_model(:) = .false.
-
- ! NOTE(wjs, 2015-10-04) Currently, type 0 has mergetoclmpft = _FillValue in the file,
- ! so we can't handle it in the general loop below. But CLM always uses type 0, so
- ! handle it specially here.
- this%is_pft_known_to_model(0) = .true.
-
- ! NOTE(wjs, 2015-10-04) Currently, mergetoclmpft is only used for crop types.
- ! However, we handle it more generally here (treating ALL pft types), in case its use
- ! is ever extended to work with non-crop types as well.
- do m = 1, mxpft
- merge_type = this%mergetoclmpft(m)
- this%is_pft_known_to_model(merge_type) = .true.
- end do
-
- end subroutine set_is_pft_known_to_model
-
- !-----------------------------------------------------------------------
- subroutine set_num_cfts_known_to_model(this)
- !
- ! !DESCRIPTION:
- ! Set the module-level variable, num_cfts_known_to_model
- !
- ! !USES:
- !
- ! !ARGUMENTS:
- class(pftcon_type), intent(in) :: this
- !
- ! !LOCAL VARIABLES:
- integer :: m
-
- character(len=*), parameter :: subname = 'set_num_cfts_known_to_model'
- !-----------------------------------------------------------------------
-
- num_cfts_known_to_model = 0
- do m = cft_lb, cft_ub
- if (this%is_pft_known_to_model(m)) then
- num_cfts_known_to_model = num_cfts_known_to_model + 1
- end if
- end do
-
- end subroutine set_num_cfts_known_to_model
-
- !-----------------------------------------------------------------------
- subroutine Clean(this)
- !
- ! !DESCRIPTION:
- ! Deallocate memory
- !
- ! !USES:
- !
- ! !ARGUMENTS:
- class(pftcon_type), intent(inout) :: this
- !
- ! !LOCAL VARIABLES:
-
- character(len=*), parameter :: subname = 'Clean'
- !-----------------------------------------------------------------------
-
- deallocate( this%noveg)
- deallocate( this%tree)
-
- deallocate( this%dleaf)
- deallocate( this%c3psn)
- deallocate( this%xl)
- deallocate( this%rhol)
- deallocate( this%rhos)
- deallocate( this%taul)
- deallocate( this%taus)
- deallocate( this%z0mr)
- deallocate( this%displar)
- deallocate( this%roota_par)
- deallocate( this%rootb_par)
- deallocate( this%crop)
- deallocate( this%mergetoclmpft)
- deallocate( this%is_pft_known_to_model)
- deallocate( this%irrigated)
- deallocate( this%smpso)
- deallocate( this%smpsc)
- deallocate( this%fnitr)
- deallocate( this%slatop)
- deallocate( this%dsladlai)
- deallocate( this%leafcn)
- deallocate( this%flnr)
- deallocate( this%woody)
- deallocate( this%lflitcn)
- deallocate( this%frootcn)
- deallocate( this%livewdcn)
- deallocate( this%deadwdcn)
- deallocate( this%grperc)
- deallocate( this%grpnow)
- deallocate( this%rootprof_beta)
- deallocate( this%graincn)
- deallocate( this%mxtmp)
- deallocate( this%baset)
- deallocate( this%declfact)
- deallocate( this%bfact)
- deallocate( this%aleaff)
- deallocate( this%arootf)
- deallocate( this%astemf)
- deallocate( this%arooti)
- deallocate( this%fleafi)
- deallocate( this%allconsl)
- deallocate( this%allconss)
- deallocate( this%ztopmx)
- deallocate( this%laimx)
- deallocate( this%gddmin)
- deallocate( this%hybgdd)
- deallocate( this%lfemerg)
- deallocate( this%grnfill)
- deallocate( this%mbbopt)
- deallocate( this%medlynslope)
- deallocate( this%medlynintercept)
- deallocate( this%mxmat)
- deallocate( this%mnNHplantdate)
- deallocate( this%mxNHplantdate)
- deallocate( this%mnSHplantdate)
- deallocate( this%mxSHplantdate)
- deallocate( this%planttemp)
- deallocate( this%minplanttemp)
- deallocate( this%froot_leaf)
- deallocate( this%stem_leaf)
- deallocate( this%croot_stem)
- deallocate( this%flivewd)
- deallocate( this%fcur)
- deallocate( this%fcurdv)
- deallocate( this%lf_flab)
- deallocate( this%lf_fcel)
- deallocate( this%lf_flig)
- deallocate( this%fr_flab)
- deallocate( this%fr_fcel)
- deallocate( this%fr_flig)
- deallocate( this%leaf_long)
- deallocate( this%evergreen)
- deallocate( this%stress_decid)
- deallocate( this%season_decid)
- deallocate( this%dwood)
- deallocate( this%root_density)
- deallocate( this%root_radius)
- deallocate( this%pconv)
- deallocate( this%pprod10)
- deallocate( this%pprod100)
- deallocate( this%pprodharv10)
- deallocate( this%cc_leaf)
- deallocate( this%cc_lstem)
- deallocate( this%cc_dstem)
- deallocate( this%cc_other)
- deallocate( this%fm_leaf)
- deallocate( this%fm_lstem)
- deallocate( this%fm_dstem)
- deallocate( this%fm_other)
- deallocate( this%fm_root)
- deallocate( this%fm_lroot)
- deallocate( this%fm_droot)
- deallocate( this%fsr_pft)
- deallocate( this%fd_pft)
- deallocate( this%manunitro)
- deallocate( this%fleafcn)
- deallocate( this%ffrootcn)
- deallocate( this%fstemcn)
- deallocate( this%i_vcad)
- deallocate( this%s_vcad)
- deallocate( this%i_flnr)
- deallocate( this%s_flnr)
- deallocate( this%pftpar20)
- deallocate( this%pftpar28)
- deallocate( this%pftpar29)
- deallocate( this%pftpar30)
- deallocate( this%pftpar31)
- deallocate( this%a_fix)
- deallocate( this%b_fix)
- deallocate( this%c_fix)
- deallocate( this%s_fix)
- deallocate( this%akc_active)
- deallocate( this%akn_active)
- deallocate( this%ekc_active)
- deallocate( this%ekn_active)
- deallocate( this%kc_nonmyc)
- deallocate( this%kn_nonmyc)
- deallocate( this%kr_resorb)
- deallocate( this%perecm)
- deallocate( this%root_dmx)
- deallocate( this%fun_cn_flex_a)
- deallocate( this%fun_cn_flex_b)
- deallocate( this%fun_cn_flex_c)
- deallocate( this%FUN_fracfixers)
-
- end subroutine Clean
-
-end module pftconMod
-
diff --git a/src/main/readParamsMod.F90 b/src/main/readParamsMod.F90
deleted file mode 100644
index d2c2393e..00000000
--- a/src/main/readParamsMod.F90
+++ /dev/null
@@ -1,100 +0,0 @@
-module readParamsMod
-
- !-----------------------------------------------------------------------
- !
- ! Read parameters
- ! module used to read parameters for individual modules and/or for some
- ! well defined functionality (eg. ED).
- !
- ! ! USES:
- use clm_varctl , only : paramfile, iulog, use_fates, use_cn
- use spmdMod , only : masterproc
- use fileutils , only : getfil
- use ncdio_pio , only : ncd_pio_closefile, ncd_pio_openfile
- use ncdio_pio , only : file_desc_t , ncd_inqdid, ncd_inqdlen
-
- implicit none
- private
- !
- public :: readParameters
-
- !-----------------------------------------------------------------------
-
-contains
-
- !-----------------------------------------------------------------------
- subroutine readParameters (photosyns_inst)
- !
- ! ! USES:
- use CNSharedParamsMod , only : CNParamsReadShared
- use CNGapMortalityMod , only : readCNGapMortParams => readParams
- use CNMRespMod , only : readCNMRespParams => readParams
- use CNPhenologyMod , only : readCNPhenolParams => readParams
- use SoilBiogeochemNLeachingMod , only : readSoilBiogeochemNLeachingParams => readParams
- use SoilBiogeochemNitrifDenitrifMod , only : readSoilBiogeochemNitrifDenitrifParams => readParams
- use SoilBiogeochemLittVertTranspMod , only : readSoilBiogeochemLittVertTranspParams => readParams
- use SoilBiogeochemPotentialMod , only : readSoilBiogeochemPotentialParams => readParams
- use SoilBiogeochemDecompMod , only : readSoilBiogeochemDecompParams => readParams
- use SoilBiogeochemDecompCascadeBGCMod , only : readSoilBiogeochemDecompBgcParams => readParams
- use SoilBiogeochemDecompCascadeCNMod , only : readSoilBiogeochemDecompCnParams => readParams
- !use ch4Mod , only : readCH4Params => readParams
- use clm_varctl, only : NLFilename_in
- use PhotosynthesisMod , only : photosyns_type
- !
- ! !ARGUMENTS:
- type(photosyns_type) , intent(in) :: photosyns_inst
- !
- ! !LOCAL VARIABLES:
- character(len=256) :: locfn ! local file name
- type(file_desc_t) :: ncid ! pio netCDF file id
- integer :: dimid ! netCDF dimension id
- integer :: npft ! number of pfts on pft-physiology file
- character(len=32) :: subname = 'readParameters'
- !-----------------------------------------------------------------------
-
- if (masterproc) then
- write(iulog,*) 'paramMod.F90::'//trim(subname)//' :: reading CLM '//' parameters '
- end if
-
- call getfil (paramfile, locfn, 0)
- call ncd_pio_openfile (ncid, trim(locfn), 0)
- call ncd_inqdid(ncid,'pft',dimid)
- call ncd_inqdlen(ncid,dimid,npft)
-
- !
- ! Above ground biogeochemistry...
- !
- if (use_cn) then
- call readCNGapMortParams(ncid)
- call readCNMRespParams(ncid)
- call readCNPhenolParams(ncid)
- end if
-
- !
- ! Soil biogeochemistry...
- !
- if (use_cn .or. use_fates) then
- call readSoilBiogeochemDecompBgcParams(ncid)
- call readSoilBiogeochemDecompCnParams(ncid)
- call readSoilBiogeochemDecompParams(ncid)
- call readSoilBiogeochemLittVertTranspParams(ncid)
- call readSoilBiogeochemNitrifDenitrifParams(ncid)
- call readSoilBiogeochemNLeachingParams(ncid)
- call readSoilBiogeochemPotentialParams(ncid)
- call CNParamsReadShared(ncid, NLFilename_in) ! this is called CN params but really is for the soil biogeochem parameters
-
- !call readCH4Params (ncid)
- end if
-
- !
- ! Biogeophysics
- !
- call photosyns_inst%ReadParams( ncid )
-
-
- !
- call ncd_pio_closefile(ncid)
-
- end subroutine readParameters
-
-end module readParamsMod
diff --git a/src/main/restFileMod.F90 b/src/main/restFileMod.F90
index d30d59a8..531686d2 100644
--- a/src/main/restFileMod.F90
+++ b/src/main/restFileMod.F90
@@ -13,18 +13,15 @@ module restFileMod
use abortutils , only : endrun
use shr_log_mod , only : errMsg => shr_log_errMsg
use clm_time_manager , only : timemgr_restart_io, get_nstep
- use subgridRestMod , only : subgridRestWrite, subgridRestRead, subgridRest_read_cleanup
+ use subgridRestMod , only : subgridRestWrite
use accumulMod , only : accumulRest
use clm_instMod , only : clm_instRest
use histFileMod , only : hist_restart_ncd
- use clm_varctl , only : iulog, use_fates, use_hydrstress
- use clm_varctl , only : create_crop_landunit, irrigate
- use clm_varcon , only : nameg, namel, namec, namep, nameCohort
+ use clm_varctl , only : iulog
+ use clm_varcon , only : nameg
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 glcBehaviorMod , only : glc_behavior_type
- use reweightMod , only : reweight_wrapup
!
! !PUBLIC TYPES:
implicit none
@@ -39,15 +36,11 @@ module restFileMod
public :: restFile_filename ! Sets restart filename
!
! !PRIVATE MEMBER FUNCTIONS:
- private :: restFile_set_derived ! On a read, set variables derived from others
private :: restFile_read_pfile
private :: restFile_write_pfile ! Writes restart pointer file
private :: restFile_closeRestart ! Close restart file and write restart pointer file
private :: restFile_dimset
private :: restFile_add_flag_metadata ! Add global metadata for some logical flag
- private :: restFile_add_ilun_metadata ! Add global metadata defining landunit types
- private :: restFile_add_icol_metadata ! Add global metadata defining column types
- private :: restFile_add_ipft_metadata ! Add global metadata defining patch types
private :: restFile_dimcheck
private :: restFile_enddef
private :: restFile_check_consistency ! Perform consistency checks on the restart file
@@ -139,7 +132,7 @@ subroutine restFile_write( bounds, file, rdate, noptr)
end subroutine restFile_write
!-----------------------------------------------------------------------
- subroutine restFile_read( bounds_proc, file, glc_behavior )
+ subroutine restFile_read( bounds_proc, file)
!
! !DESCRIPTION:
! Read a CLM restart file.
@@ -147,7 +140,6 @@ subroutine restFile_read( bounds_proc, file, glc_behavior )
! !ARGUMENTS:
type(bounds_type) , intent(in) :: bounds_proc ! processor-level bounds
character(len=*) , intent(in) :: file ! output netcdf restart file
- type(glc_behavior_type), intent(in) :: glc_behavior
!
! !LOCAL VARIABLES:
type(file_desc_t) :: ncid ! netcdf id
@@ -172,29 +164,10 @@ subroutine restFile_read( bounds_proc, file, glc_behavior )
call restFile_dimcheck( ncid )
- call subgridRestRead(bounds_proc, ncid)
-
- ! Now that we have updated subgrid information, update the filters, active flags,
- ! etc. accordingly. We do these updates as soon as possible so that the updated
- ! filters and active flags are available to other restart routines - e.g., for the
- ! sake of subgridAveMod calls like c2g.
- !
- ! The reweight_wrapup call needs to be done inside a clump loop, so we set that up
- ! here.
- nclumps = get_proc_clumps()
- !$OMP PARALLEL DO PRIVATE (nc, bounds_clump)
- do nc = 1, nclumps
- call get_clump_bounds(nc, bounds_clump)
- call reweight_wrapup(bounds_clump, glc_behavior)
- end do
- !$OMP END PARALLEL DO
-
call accumulRest( ncid, flag='read' )
call clm_instRest( bounds_proc, ncid, flag='read' )
- call restFile_set_derived(bounds_proc, glc_behavior)
-
call hist_restart_ncd (bounds_proc, ncid, flag='read' )
! Do error checking on file
@@ -203,7 +176,6 @@ subroutine restFile_read( bounds_proc, file, glc_behavior )
! Close file
- call subgridRest_read_cleanup
call restFile_close( ncid )
! Write out diagnostic info
@@ -259,8 +231,8 @@ subroutine restFile_getfile( file, path )
end if
call getfil( path, file, 0 )
- ! tcraig, adding xx. and .clm2 makes this more robust
- ctest = 'xx.'//trim(caseid)//'.clm2'
+ ! tcraig, adding xx. and .slim makes this more robust
+ ctest = 'xx.'//trim(caseid)//'.slim'
ftest = 'xx.'//trim(file)
status = index(trim(ftest),trim(ctest))
if (status /= 0 .and. .not.(brnch_retain_casename)) then
@@ -278,34 +250,6 @@ subroutine restFile_getfile( file, path )
end subroutine restFile_getfile
- !-----------------------------------------------------------------------
- subroutine restFile_set_derived(bounds, glc_behavior)
- !
- ! !DESCRIPTION:
- ! Upon a restart read, set variables that are not on the restart file, but can be
- ! derived from variables that are on the restart file.
- !
- ! This should be called after variables are read from the restart file.
- !
- ! !USES:
- !
- ! NOTE(wjs, 2016-04-05) Is it an architectural violation to use topo_inst directly
- ! here? I can't see a good way around it.
- use clm_instMod, only : topo_inst
- !
- ! !ARGUMENTS:
- type(bounds_type), intent(in) :: bounds
- type(glc_behavior_type), intent(in) :: glc_behavior
- !
- ! !LOCAL VARIABLES:
-
- character(len=*), parameter :: subname = 'restFile_set_derived'
- !-----------------------------------------------------------------------
-
- call glc_behavior%update_glc_classes(bounds, topo_inst%topo_col(bounds%begc:bounds%endc))
-
- end subroutine restFile_set_derived
-
!-----------------------------------------------------------------------
subroutine restFile_read_pfile( pnamer )
!
@@ -465,7 +409,7 @@ character(len=256) function restFile_filename( rdate )
character(len=*), intent(in) :: rdate ! input date for restart file name
!-----------------------------------------------------------------------
- restFile_filename = "./"//trim(caseid)//".clm2"//trim(inst_suffix)//&
+ restFile_filename = "./"//trim(caseid)//".slim"//trim(inst_suffix)//&
".r."//trim(rdate)//".nc"
if (masterproc) then
write(iulog,*)'writing restart file ',trim(restFile_filename),' for model date = ',rdate
@@ -481,10 +425,9 @@ subroutine restFile_dimset( ncid )
!
! !USES:
use clm_time_manager , only : get_nstep
- use clm_varctl , only : caseid, ctitle, version, username, hostname, fsurdat
+ use clm_varctl , only : caseid, ctitle, version, username, hostname, mml_surdat
use clm_varctl , only : conventions, source
- use clm_varpar , only : numrad, nlevlak, nlevsno, nlevgrnd, nlevurb, nlevcan
- use clm_varpar , only : maxpatch_glcmec, nvegwcs
+ use clm_varpar , only : numrad, nlevgrnd
use decompMod , only : get_proc_global
!
! !ARGUMENTS:
@@ -493,10 +436,6 @@ subroutine restFile_dimset( ncid )
! !LOCAL VARIABLES:
integer :: dimid ! netCDF dimension id
integer :: numg ! total number of gridcells across all processors
- integer :: numl ! total number of landunits across all processors
- integer :: numc ! total number of columns across all processors
- integer :: nump ! total number of pfts across all processors
- integer :: numCohort ! total number of cohorts across all processors
integer :: ier ! error status
integer :: strlen_dimid ! string dimension id
character(len= 8) :: curdate ! current date
@@ -505,29 +444,15 @@ subroutine restFile_dimset( ncid )
character(len= 32) :: subname='restFile_dimset' ! subroutine name
!------------------------------------------------------------------------
- call get_proc_global(ng=numg, nl=numl, nc=numc, np=nump, nCohorts=numCohort)
+ call get_proc_global(ng=numg)
! Define dimensions
call ncd_defdim(ncid , nameg , numg , dimid)
- call ncd_defdim(ncid , namel , numl , dimid)
- call ncd_defdim(ncid , namec , numc , dimid)
- call ncd_defdim(ncid , namep , nump , dimid)
- call ncd_defdim(ncid , nameCohort , numCohort , dimid)
call ncd_defdim(ncid , 'levgrnd' , nlevgrnd , dimid)
- call ncd_defdim(ncid , 'levurb' , nlevurb , dimid)
- call ncd_defdim(ncid , 'levlak' , nlevlak , dimid)
- call ncd_defdim(ncid , 'levsno' , nlevsno , dimid)
- call ncd_defdim(ncid , 'levsno1' , nlevsno+1 , dimid)
- call ncd_defdim(ncid , 'levtot' , nlevsno+nlevgrnd, dimid)
call ncd_defdim(ncid , 'numrad' , numrad , dimid)
- call ncd_defdim(ncid , 'levcan' , nlevcan , dimid)
- if ( use_hydrstress ) then
- call ncd_defdim(ncid , 'vegwcs' , nvegwcs , dimid)
- end if
call ncd_defdim(ncid , 'string_length', 64 , dimid)
- call ncd_defdim(ncid , 'glc_nec', maxpatch_glcmec, dimid)
! mml add my soil dimension
call ncd_defdim(ncid , 'mml_lev' , 10 , dimid) ! mml: hard coded for six soil layers
@@ -548,22 +473,9 @@ subroutine restFile_dimset( ncid )
call ncd_putatt(ncid, NCD_GLOBAL, 'revision_id' , trim(str))
call ncd_putatt(ncid, NCD_GLOBAL, 'case_title' , trim(ctitle))
call ncd_putatt(ncid, NCD_GLOBAL, 'case_id' , trim(caseid))
- call ncd_putatt(ncid, NCD_GLOBAL, 'surface_dataset', trim(fsurdat))
+ call ncd_putatt(ncid, NCD_GLOBAL, 'surface_dataset', trim(mml_surdat))
call ncd_putatt(ncid, NCD_GLOBAL, 'title', 'CLM Restart information')
- call restFile_add_flag_metadata(ncid, create_crop_landunit, 'create_crop_landunit')
- call restFile_add_flag_metadata(ncid, irrigate, 'irrigate')
- ! BACKWARDS_COMPATIBILITY(wjs, 2017-12-13) created_glacier_mec_landunits is always
- ! true now. However, we can't remove the read of this field from init_interp until we
- ! can reliably assume that all initial conditions files that might be used in
- ! init_interp have this flag .true. So until then, we write the flag with a
- ! hard-coded .true. value.
- call restFile_add_flag_metadata(ncid, .true., 'created_glacier_mec_landunits')
-
- call restFile_add_ipft_metadata(ncid)
- call restFile_add_icol_metadata(ncid)
- call restFile_add_ilun_metadata(ncid)
-
end subroutine restFile_dimset
!-----------------------------------------------------------------------
@@ -593,86 +505,6 @@ subroutine restFile_add_flag_metadata(ncid, flag, flag_name)
end subroutine restFile_add_flag_metadata
- !-----------------------------------------------------------------------
- subroutine restFile_add_ilun_metadata(ncid)
- !
- ! !DESCRIPTION:
- ! Add global metadata defining landunit types
- !
- ! !USES:
- use landunit_varcon, only : max_lunit, landunit_names, landunit_name_length
- !
- ! !ARGUMENTS:
- type(file_desc_t), intent(inout) :: ncid ! local file id
- !
- ! !LOCAL VARIABLES:
- integer :: ltype ! landunit type
- character(len=*), parameter :: att_prefix = 'ilun_' ! prefix for attributes
- character(len=len(att_prefix)+landunit_name_length) :: attname ! attribute name
-
- character(len=*), parameter :: subname = 'restFile_add_ilun_metadata'
- !-----------------------------------------------------------------------
-
- do ltype = 1, max_lunit
- attname = att_prefix // landunit_names(ltype)
- call ncd_putatt(ncid, ncd_global, attname, ltype)
- end do
-
- end subroutine restFile_add_ilun_metadata
-
- !-----------------------------------------------------------------------
- subroutine restFile_add_icol_metadata(ncid)
- !
- ! !DESCRIPTION:
- ! Add global metadata defining column types
- !
- ! !USES:
- use column_varcon, only : write_coltype_metadata
- !
- ! !ARGUMENTS:
- type(file_desc_t), intent(inout) :: ncid ! local file id
- !
- ! !LOCAL VARIABLES:
- character(len=*), parameter :: att_prefix = 'icol_' ! prefix for attributes
-
- character(len=*), parameter :: subname = 'restFile_add_icol_metadata'
- !-----------------------------------------------------------------------
-
- call write_coltype_metadata(att_prefix, ncid)
-
- end subroutine restFile_add_icol_metadata
-
- !-----------------------------------------------------------------------
- subroutine restFile_add_ipft_metadata(ncid)
- !
- ! !DESCRIPTION:
- ! Add global metadata defining patch types
- !
- ! !USES:
- use clm_varpar, only : natpft_lb, mxpft, cft_lb, cft_ub
- use pftconMod , only : pftname_len, pftname
- !
- ! !ARGUMENTS:
- type(file_desc_t), intent(inout) :: ncid ! local file id
- !
- ! !LOCAL VARIABLES:
- integer :: ptype ! patch type
- character(len=*), parameter :: att_prefix = 'ipft_' ! prefix for attributes
- character(len=len(att_prefix)+pftname_len) :: attname ! attribute name
-
- character(len=*), parameter :: subname = 'restFile_add_ipft_metadata'
- !-----------------------------------------------------------------------
-
- do ptype = natpft_lb, mxpft
- attname = att_prefix // pftname(ptype)
- call ncd_putatt(ncid, ncd_global, attname, ptype)
- end do
-
- call ncd_putatt(ncid, ncd_global, 'cft_lb', cft_lb)
- call ncd_putatt(ncid, ncd_global, 'cft_ub', cft_ub)
-
- end subroutine restFile_add_ipft_metadata
-
!-----------------------------------------------------------------------
subroutine restFile_dimcheck( ncid )
!
@@ -681,7 +513,7 @@ subroutine restFile_dimcheck( ncid )
!
! !USES:
use decompMod, only : get_proc_global
- use clm_varpar, only : nlevsno, nlevlak, nlevgrnd, nlevurb
+ use clm_varpar, only : nlevgrnd
use clm_varctl, only : single_column, nsrest, nsrStartup
!
! !ARGUMENTS:
@@ -689,10 +521,6 @@ subroutine restFile_dimcheck( ncid )
!
! !LOCAL VARIABLES:
integer :: numg ! total number of gridcells across all processors
- integer :: numl ! total number of landunits across all processors
- integer :: numc ! total number of columns across all processors
- integer :: nump ! total number of pfts across all processors
- integer :: numCohort ! total number of cohorts across all processors
character(len=:), allocatable :: msg ! diagnostic message
character(len=32) :: subname='restFile_dimcheck' ! subroutine name
!-----------------------------------------------------------------------
@@ -700,7 +528,7 @@ subroutine restFile_dimcheck( ncid )
! Get relevant sizes
if ( .not. single_column .or. nsrest /= nsrStartup )then
- call get_proc_global(ng=numg, nl=numl, nc=numc, np=nump, nCohorts=numCohort)
+ call get_proc_global(ng=numg)
msg = 'Did you mean to set use_init_interp = .true. in user_nl_clm?' // &
new_line('x') // &
'(Setting use_init_interp = .true. is needed when doing a' // &
@@ -711,17 +539,8 @@ subroutine restFile_dimcheck( ncid )
new_line('x') // &
'or when running a resolution or configuration that differs from the initial conditions.)'
call check_dim(ncid, nameg, numg, msg=msg)
- call check_dim(ncid, namel, numl, msg=msg)
- call check_dim(ncid, namec, numc, msg=msg)
- call check_dim(ncid, namep, nump, msg=msg)
- if ( use_fates ) call check_dim(ncid, nameCohort , numCohort, msg=msg)
end if
- call check_dim(ncid, 'levsno' , nlevsno, &
- msg = 'You can deal with this mismatch by rerunning with ' // &
- 'use_init_interp = .true. in user_nl_clm')
call check_dim(ncid, 'levgrnd' , nlevgrnd)
- call check_dim(ncid, 'levurb' , nlevurb)
- call check_dim(ncid, 'levlak' , nlevlak)
! mml add check for my dim?
call check_dim(ncid, 'mml_lev' , 10)
! mml add check for my dust dim?
@@ -765,38 +584,28 @@ subroutine restFile_check_consistency(bounds, ncid)
! !DESCRIPTION:
! Perform some consistency checks on the restart file
!
- ! !USES:
- use subgridRestMod, only : subgridRest_check_consistency
- !
! !ARGUMENTS:
type(bounds_type), intent(in) :: bounds ! bounds
type(file_desc_t), intent(inout) :: ncid ! netcdf id
!
! !LOCAL VARIABLES:
logical :: check_finidat_year_consistency ! whether to check consistency between year on finidat file and current year
- logical :: check_finidat_pct_consistency ! whether to check consistency between pct_pft on finidat file and surface dataset
character(len=*), parameter :: subname = 'restFile_check_consistency'
!-----------------------------------------------------------------------
call restFile_read_consistency_nl( &
- check_finidat_year_consistency, &
- check_finidat_pct_consistency)
+ check_finidat_year_consistency)
if (check_finidat_year_consistency) then
call restFile_check_year(ncid)
end if
- if (check_finidat_pct_consistency) then
- call subgridRest_check_consistency(bounds)
- end if
-
end subroutine restFile_check_consistency
!-----------------------------------------------------------------------
subroutine restFile_read_consistency_nl( &
- check_finidat_year_consistency, &
- check_finidat_pct_consistency)
+ check_finidat_year_consistency)
!
! !DESCRIPTION:
@@ -810,7 +619,6 @@ subroutine restFile_read_consistency_nl( &
!
! !ARGUMENTS:
logical, intent(out) :: check_finidat_year_consistency
- logical, intent(out) :: check_finidat_pct_consistency
!
! !LOCAL VARIABLES:
integer :: nu_nml ! unit for namelist file
@@ -820,12 +628,10 @@ subroutine restFile_read_consistency_nl( &
!-----------------------------------------------------------------------
namelist /finidat_consistency_checks/ &
- check_finidat_year_consistency, &
- check_finidat_pct_consistency
+ check_finidat_year_consistency
! Set default namelist values
check_finidat_year_consistency = .true.
- check_finidat_pct_consistency = .true.
! Read namelist
if (masterproc) then
@@ -838,14 +644,13 @@ subroutine restFile_read_consistency_nl( &
call endrun(msg='ERROR reading finidat_consistency_checks namelist'//errMsg(sourcefile, __LINE__))
end if
else
- call endrun(msg='ERROR finding finidat_consistency_checks namelist'//errMsg(sourcefile, __LINE__))
+ call endrun(msg='ERROR Could not find finidat_consistency_checks namelist'//errMsg(sourcefile, __LINE__))
end if
close(nu_nml)
call relavu( nu_nml )
endif
call shr_mpi_bcast (check_finidat_year_consistency, mpicom)
- call shr_mpi_bcast (check_finidat_pct_consistency, mpicom)
if (masterproc) then
write(iulog,*) ' '
diff --git a/src/main/reweightMod.F90 b/src/main/reweightMod.F90
deleted file mode 100644
index 5816fa1d..00000000
--- a/src/main/reweightMod.F90
+++ /dev/null
@@ -1,61 +0,0 @@
-module reweightMod
-
- !-----------------------------------------------------------------------
- ! !DESCRIPTION:
- ! Top level driver for things that happen when subgrid weights are changed. This is in
- ! a separate module from subgridWeightsMod in order to keep subgridWeightsMod lower-
- ! level - and particularly to break its dependency on filterMod.
- !
- !
- ! !USES:
-#include "shr_assert.h"
- use shr_log_mod , only : errMsg => shr_log_errMsg
- use shr_kind_mod , only : r8 => shr_kind_r8
- !
- ! PUBLIC TYPES:
- implicit none
- save
-
- private
- !
- ! !PUBLIC MEMBER FUNCTIONS:
- public :: reweight_wrapup ! do modifications and error-checks after modifying subgrid weights
-
- character(len=*), parameter, private :: sourcefile = &
- __FILE__
-
- !-----------------------------------------------------------------------
-
-contains
-
- !-----------------------------------------------------------------------
- subroutine reweight_wrapup(bounds, glc_behavior)
- !
- ! !DESCRIPTION:
- ! Do additional modifications and error-checks that should be done after modifying subgrid
- ! weights
- !
- ! This should be called whenever any weights change (e.g., patch weights on the column,
- ! landunit weights on the grid cell, etc.).
- !
- ! !USES:
- use filterMod , only : setFilters
- use subgridWeightsMod , only : set_active, check_weights
- use decompMod , only : bounds_type, BOUNDS_LEVEL_CLUMP
- use glcBehaviorMod , only : glc_behavior_type
- !
- ! !ARGUMENTS:
- type(bounds_type) , intent(in) :: bounds ! clump bounds
- type(glc_behavior_type), intent(in) :: glc_behavior
- !------------------------------------------------------------------------
-
- SHR_ASSERT(bounds%level == BOUNDS_LEVEL_CLUMP, errMsg(sourcefile, __LINE__))
-
- call set_active(bounds, glc_behavior)
- call check_weights(bounds, active_only=.false.)
- call check_weights(bounds, active_only=.true.)
- call setFilters(bounds, glc_behavior)
-
- end subroutine reweight_wrapup
-
-end module reweightMod
diff --git a/src/main/subgridAveMod.F90 b/src/main/subgridAveMod.F90
deleted file mode 100644
index 3375add2..00000000
--- a/src/main/subgridAveMod.F90
+++ /dev/null
@@ -1,1347 +0,0 @@
-module subgridAveMod
-
-#include "shr_assert.h"
-
- !-----------------------------------------------------------------------
- ! !DESCRIPTION:
- ! Utilities to perfrom subgrid averaging
- !
- ! !USES:
- use shr_kind_mod , only : r8 => shr_kind_r8
- use shr_log_mod , only : errMsg => shr_log_errMsg
- use column_varcon , only : icol_roof, icol_sunwall, icol_shadewall
- use column_varcon , only : icol_road_perv , icol_road_imperv
- use clm_varcon , only : grlnd, nameg, namel, namec, namep,spval
- use clm_varctl , only : iulog
- use abortutils , only : endrun
- use decompMod , only : bounds_type
- use LandunitType , only : lun
- use ColumnType , only : col
- use PatchType , only : patch
- !
- ! !PUBLIC TYPES:
- implicit none
- save
- !
- ! !PUBLIC MEMBER FUNCTIONS:
- public :: p2c ! Perform an average patches to columns
- public :: p2l ! Perform an average patches to landunits
- public :: p2g ! Perform an average patches to gridcells
- public :: c2l ! Perform an average columns to landunits
- public :: c2g ! Perform an average columns to gridcells
- public :: l2g ! Perform an average landunits to gridcells
-
- interface p2c
- module procedure p2c_1d
- module procedure p2c_2d
- module procedure p2c_1d_filter
- module procedure p2c_2d_filter
- end interface
- interface p2l
- module procedure p2l_1d
- module procedure p2l_2d
- end interface
- interface p2g
- module procedure p2g_1d
- module procedure p2g_2d
- end interface
- interface c2l
- module procedure c2l_1d
- module procedure c2l_2d
- end interface
- interface c2g
- module procedure c2g_1d
- module procedure c2g_2d
- end interface
- interface l2g
- module procedure l2g_1d
- module procedure l2g_2d
- end interface
- !
- ! !PRIVATE MEMBER FUNCTIONS:
- private :: build_scale_l2g
- private :: create_scale_l2g_lookup
-
- ! Note about the urban scaling types used for c2l_scale_type (urbanf / urbans), from
- ! Bill Sacks and Keith Oleson: These names originally meant to distinguish between
- ! fluxes and states. However, that isn't the right distinction. In general, urbanf
- ! should be used for variables that are expressed as something-per-m^2 ('extensive'
- ! state or flux variables), whereas urbans should be used for variables that are not
- ! expressed as per-m^2 ('intensive' state variables; an example is temperature). The
- ! urbanf scaling converts from per-m^2 of vertical wall area to per-m^2 of ground area.
- ! One way to think about this is: In the extreme case of a near-infinite canyon_hwr due
- ! to massively tall walls, do you want a near-infinite multiplier for the walls for the
- ! variable in question? If so, you want urbanf; if not, you want urbans.
- !
- ! However, there may be some special cases, including some hydrology variables that
- ! don't apply for urban walls.
-
- ! WJS (10-14-11): TODO:
- !
- ! - I believe that scale_p2c, scale_c2l and scale_l2g should be included in the sumwt
- ! accumulations (e.g., sumwt = sumwt + wtgcell * scale_p2c * scale_c2l * scale_l2g), but
- ! that requires some more thought to (1) make sure that is correct, and (2) make sure it
- ! doesn't break the urban scaling. (See also my notes in create_scale_l2g_lookup.)
- ! - Once that is done, you could use a scale of 0, avoiding the need for the use of
- ! spval and the special checks that requires.
- !
- ! - Currently, there is a lot of repeated code to calculate scale_c2l. This should be
- ! cleaned up.
- ! - At a minimum, should collect the repeated code into a subroutine to eliminate this
- ! repitition
- ! - The best thing might be to use a lookup array, as is done for scale_l2g
-
-
- character(len=*), parameter, private :: sourcefile = &
- __FILE__
-
- ! -----------------------------------------------------------------------
-
-contains
-
- !-----------------------------------------------------------------------
- subroutine p2c_1d (bounds, parr, carr, p2c_scale_type)
- !
- ! !DESCRIPTION:
- ! Perfrom subgrid-average from patches to columns.
- ! Averaging is only done for points that are not equal to "spval".
- !
- ! !ARGUMENTS:
- type(bounds_type), intent(in) :: bounds
- real(r8), intent(in) :: parr( bounds%begp: ) ! patch array
- real(r8), intent(out) :: carr( bounds%begc: ) ! column array
- character(len=*), intent(in) :: p2c_scale_type ! scale type
- !
- ! !LOCAL VARIABLES:
- integer :: p,c,index ! indices
- real(r8) :: scale_p2c(bounds%begp:bounds%endp) ! scale factor for column->landunit mapping
- logical :: found ! temporary for error check
- real(r8) :: sumwt(bounds%begc:bounds%endc) ! sum of weights
- !------------------------------------------------------------------------
-
- ! Enforce expected array sizes
- SHR_ASSERT_ALL((ubound(parr) == (/bounds%endp/)), errMsg(sourcefile, __LINE__))
- SHR_ASSERT_ALL((ubound(carr) == (/bounds%endc/)), errMsg(sourcefile, __LINE__))
-
- if (p2c_scale_type == 'unity') then
- do p = bounds%begp,bounds%endp
- scale_p2c(p) = 1.0_r8
- end do
- else
- write(iulog,*)'p2c_1d error: scale type ',p2c_scale_type,' not supported'
- call endrun(msg=errMsg(sourcefile, __LINE__))
- end if
-
- carr(bounds%begc:bounds%endc) = spval
- sumwt(bounds%begc:bounds%endc) = 0._r8
- do p = bounds%begp,bounds%endp
- if (patch%active(p) .and. patch%wtcol(p) /= 0._r8) then
- if (parr(p) /= spval) then
- c = patch%column(p)
- if (sumwt(c) == 0._r8) carr(c) = 0._r8
- carr(c) = carr(c) + parr(p) * scale_p2c(p) * patch%wtcol(p)
- sumwt(c) = sumwt(c) + patch%wtcol(p)
- end if
- end if
- end do
- found = .false.
- do c = bounds%begc,bounds%endc
- if (sumwt(c) > 1.0_r8 + 1.e-6_r8) then
- found = .true.
- index = c
- else if (sumwt(c) /= 0._r8) then
- carr(c) = carr(c)/sumwt(c)
- end if
- end do
- if (found) then
- write(iulog,*)'p2c_1d error: sumwt is greater than 1.0'
- call endrun(decomp_index=index, clmlevel=namec, msg=errMsg(sourcefile, __LINE__))
- end if
-
- end subroutine p2c_1d
-
- !-----------------------------------------------------------------------
- subroutine p2c_2d (bounds, num2d, parr, carr, p2c_scale_type)
- !
- ! !DESCRIPTION:
- ! Perfrom subgrid-average from landunits to gridcells.
- ! Averaging is only done for points that are not equal to "spval".
- !
- ! !ARGUMENTS:
- type(bounds_type) , intent(in) :: bounds
- integer , intent(in) :: num2d ! size of second dimension
- real(r8) , intent(in) :: parr( bounds%begp: , 1: ) ! patch array
- real(r8) , intent(out) :: carr( bounds%begc: , 1: ) ! column array
- character(len=*) , intent(in) :: p2c_scale_type ! scale type
- !
- ! !LOCAL VARIABLES:
- integer :: j,p,c,index ! indices
- real(r8) :: scale_p2c(bounds%begp:bounds%endp) ! scale factor for column->landunit mapping
- logical :: found ! temporary for error check
- real(r8) :: sumwt(bounds%begc:bounds%endc) ! sum of weights
- !------------------------------------------------------------------------
-
- ! Enforce expected array sizes
- SHR_ASSERT_ALL((ubound(parr) == (/bounds%endp, num2d/)), errMsg(sourcefile, __LINE__))
- SHR_ASSERT_ALL((ubound(carr) == (/bounds%endc, num2d/)), errMsg(sourcefile, __LINE__))
-
- if (p2c_scale_type == 'unity') then
- do p = bounds%begp,bounds%endp
- scale_p2c(p) = 1.0_r8
- end do
- else
- write(iulog,*)'p2c_2d error: scale type ',p2c_scale_type,' not supported'
- call endrun(msg=errMsg(sourcefile, __LINE__))
- end if
-
- carr(bounds%begc : bounds%endc, :) = spval
- do j = 1,num2d
- sumwt(bounds%begc : bounds%endc) = 0._r8
- do p = bounds%begp,bounds%endp
- if (patch%active(p) .and. patch%wtcol(p) /= 0._r8) then
- if (parr(p,j) /= spval) then
- c = patch%column(p)
- if (sumwt(c) == 0._r8) carr(c,j) = 0._r8
- carr(c,j) = carr(c,j) + parr(p,j) * scale_p2c(p) * patch%wtcol(p)
- sumwt(c) = sumwt(c) + patch%wtcol(p)
- end if
- end if
- end do
- found = .false.
- do c = bounds%begc,bounds%endc
- if (sumwt(c) > 1.0_r8 + 1.e-6_r8) then
- found = .true.
- index = c
- else if (sumwt(c) /= 0._r8) then
- carr(c,j) = carr(c,j)/sumwt(c)
- end if
- end do
- if (found) then
- write(iulog,*)'p2c_2d error: sumwt is greater than 1.0 at c= ',index,' lev= ',j
- call endrun(decomp_index=index, clmlevel=namec, msg=errMsg(sourcefile, __LINE__))
- end if
- end do
- end subroutine p2c_2d
-
- !-----------------------------------------------------------------------
- subroutine p2c_1d_filter (bounds, numfc, filterc, patcharr, colarr)
- !
- ! !DESCRIPTION:
- ! perform patch to column averaging for single level patch arrays
- !
- ! !ARGUMENTS:
- type(bounds_type), intent(in) :: bounds
- integer , intent(in) :: numfc
- integer , intent(in) :: filterc(numfc)
- real(r8), intent(in) :: patcharr( bounds%begp: )
- real(r8), intent(out) :: colarr( bounds%begc: )
- !
- ! !LOCAL VARIABLES:
- integer :: fc,c,p ! indices
- !-----------------------------------------------------------------------
-
- ! Enforce expected array sizes
- SHR_ASSERT_ALL((ubound(patcharr) == (/bounds%endp/)), errMsg(sourcefile, __LINE__))
- SHR_ASSERT_ALL((ubound(colarr) == (/bounds%endc/)), errMsg(sourcefile, __LINE__))
-
- do fc = 1,numfc
- c = filterc(fc)
- colarr(c) = 0._r8
- do p = col%patchi(c), col%patchf(c)
- if (patch%active(p)) colarr(c) = colarr(c) + patcharr(p) * patch%wtcol(p)
- end do
- end do
-
- end subroutine p2c_1d_filter
-
- !-----------------------------------------------------------------------
- subroutine p2c_2d_filter (lev, numfc, filterc, patcharr, colarr)
- !
- ! !DESCRIPTION:
- ! perform patch to column averaging for multi level patch arrays
- !
- ! !ARGUMENTS:
- integer , intent(in) :: lev
- integer , intent(in) :: numfc
- integer , intent(in) :: filterc(numfc)
- real(r8), pointer :: patcharr(:,:)
- real(r8), pointer :: colarr(:,:)
- !
- ! !LOCAL VARIABLES:
- integer :: fc,c,p,j ! indices
- !-----------------------------------------------------------------------
-
- do j = 1,lev
- do fc = 1,numfc
- c = filterc(fc)
- colarr(c,j) = 0._r8
- do p = col%patchi(c), col%patchf(c)
- if (patch%active(p)) colarr(c,j) = colarr(c,j) + patcharr(p,j) * patch%wtcol(p)
- end do
- end do
- end do
-
- end subroutine p2c_2d_filter
-
- !-----------------------------------------------------------------------
- subroutine p2l_1d (bounds, parr, larr, p2c_scale_type, c2l_scale_type)
- !
- ! !DESCRIPTION:
- ! Perfrom subgrid-average from patches to landunits
- ! Averaging is only done for points that are not equal to "spval".
- !
- ! !ARGUMENTS:
- type(bounds_type), intent(in) :: bounds
- real(r8), intent(in) :: parr( bounds%begp: ) ! input column array
- real(r8), intent(out) :: larr( bounds%begl: ) ! output landunit array
- character(len=*), intent(in) :: p2c_scale_type ! scale factor type for averaging
- character(len=*), intent(in) :: c2l_scale_type ! scale factor type for averaging (see note at top of module)
- !
- ! !LOCAL VARIABLES:
- integer :: p,c,l,index ! indices
- logical :: found ! temporary for error check
- real(r8) :: sumwt(bounds%begl:bounds%endl) ! sum of weights
- real(r8) :: scale_p2c(bounds%begp:bounds%endp) ! scale factor for patch->column mapping
- real(r8) :: scale_c2l(bounds%begc:bounds%endc) ! scale factor for column->landunit mapping
- !------------------------------------------------------------------------
-
- ! Enforce expected array sizes
- SHR_ASSERT_ALL((ubound(parr) == (/bounds%endp/)), errMsg(sourcefile, __LINE__))
- SHR_ASSERT_ALL((ubound(larr) == (/bounds%endl/)), errMsg(sourcefile, __LINE__))
-
- if (c2l_scale_type == 'unity') then
- do c = bounds%begc,bounds%endc
- scale_c2l(c) = 1.0_r8
- end do
- else if (c2l_scale_type == 'urbanf') then
- do c = bounds%begc,bounds%endc
- l = col%landunit(c)
- if (lun%urbpoi(l)) then
- if (col%itype(c) == icol_sunwall) then
- scale_c2l(c) = 3.0 * lun%canyon_hwr(l)
- else if (col%itype(c) == icol_shadewall) then
- scale_c2l(c) = 3.0 * lun%canyon_hwr(l)
- else if (col%itype(c) == icol_road_perv .or. col%itype(c) == icol_road_imperv) then
- scale_c2l(c) = 3.0_r8
- else if (col%itype(c) == icol_roof) then
- scale_c2l(c) = 1.0_r8
- end if
- else
- scale_c2l(c) = 1.0_r8
- end if
- end do
- else if (c2l_scale_type == 'urbans') then
- do c = bounds%begc,bounds%endc
- l = col%landunit(c)
- if (lun%urbpoi(l)) then
- if (col%itype(c) == icol_sunwall) then
- scale_c2l(c) = (3.0 * lun%canyon_hwr(l)) / (2.*lun%canyon_hwr(l) + 1.)
- else if (col%itype(c) == icol_shadewall) then
- scale_c2l(c) = (3.0 * lun%canyon_hwr(l)) / (2.*lun%canyon_hwr(l) + 1.)
- else if (col%itype(c) == icol_road_perv .or. col%itype(c) == icol_road_imperv) then
- scale_c2l(c) = 3.0 / (2.*lun%canyon_hwr(l) + 1.)
- else if (col%itype(c) == icol_roof) then
- scale_c2l(c) = 1.0_r8
- end if
- else
- scale_c2l(c) = 1.0_r8
- end if
- end do
- else
- write(iulog,*)'p2l_1d error: scale type ',c2l_scale_type,' not supported'
- call endrun(msg=errMsg(sourcefile, __LINE__))
- end if
-
- if (p2c_scale_type == 'unity') then
- do p = bounds%begp,bounds%endp
- scale_p2c(p) = 1.0_r8
- end do
- else
- write(iulog,*)'p2l_1d error: scale type ',p2c_scale_type,' not supported'
- call endrun(msg=errMsg(sourcefile, __LINE__))
- end if
-
- larr(bounds%begl : bounds%endl) = spval
- sumwt(bounds%begl : bounds%endl) = 0._r8
- do p = bounds%begp,bounds%endp
- if (patch%active(p) .and. patch%wtlunit(p) /= 0._r8) then
- c = patch%column(p)
- if (parr(p) /= spval .and. scale_c2l(c) /= spval) then
- l = patch%landunit(p)
- if (sumwt(l) == 0._r8) larr(l) = 0._r8
- larr(l) = larr(l) + parr(p) * scale_p2c(p) * scale_c2l(c) * patch%wtlunit(p)
- sumwt(l) = sumwt(l) + patch%wtlunit(p)
- end if
- end if
- end do
- found = .false.
- do l = bounds%begl,bounds%endl
- if (sumwt(l) > 1.0_r8 + 1.e-6_r8) then
- found = .true.
- index = l
- else if (sumwt(l) /= 0._r8) then
- larr(l) = larr(l)/sumwt(l)
- end if
- end do
- if (found) then
- write(iulog,*)'p2l_1d error: sumwt is greater than 1.0 at l= ',index
- call endrun(decomp_index=index, clmlevel=namel, msg=errMsg(sourcefile, __LINE__))
- end if
-
- end subroutine p2l_1d
-
- !-----------------------------------------------------------------------
- subroutine p2l_2d(bounds, num2d, parr, larr, p2c_scale_type, c2l_scale_type)
- !
- ! !DESCRIPTION:
- ! Perfrom subgrid-average from patches to landunits
- ! Averaging is only done for points that are not equal to "spval".
- !
- ! !ARGUMENTS:
- type(bounds_type), intent(in) :: bounds
- integer , intent(in) :: num2d ! size of second dimension
- real(r8), intent(in) :: parr( bounds%begp: , 1: ) ! input patch array
- real(r8), intent(out) :: larr( bounds%begl: , 1: ) ! output gridcell array
- character(len=*), intent(in) :: p2c_scale_type ! scale factor type for averaging
- character(len=*), intent(in) :: c2l_scale_type ! scale factor type for averaging (see note at top of module)
- !
- ! !LOCAL VARIABLES:
- integer :: j,p,c,l,index ! indices
- logical :: found ! temporary for error check
- real(r8) :: sumwt(bounds%begl:bounds%endl) ! sum of weights
- real(r8) :: scale_p2c(bounds%begc:bounds%endc) ! scale factor for patch->column mapping
- real(r8) :: scale_c2l(bounds%begc:bounds%endc) ! scale factor for column->landunit mapping
- !------------------------------------------------------------------------
-
- ! Enforce expected array sizes
- SHR_ASSERT_ALL((ubound(parr) == (/bounds%endp, num2d/)), errMsg(sourcefile, __LINE__))
- SHR_ASSERT_ALL((ubound(larr) == (/bounds%endl, num2d/)), errMsg(sourcefile, __LINE__))
-
- if (c2l_scale_type == 'unity') then
- do c = bounds%begc,bounds%endc
- scale_c2l(c) = 1.0_r8
- end do
- else if (c2l_scale_type == 'urbanf') then
- do c = bounds%begc,bounds%endc
- l = col%landunit(c)
- if (lun%urbpoi(l)) then
- if (col%itype(c) == icol_sunwall) then
- scale_c2l(c) = 3.0 * lun%canyon_hwr(l)
- else if (col%itype(c) == icol_shadewall) then
- scale_c2l(c) = 3.0 * lun%canyon_hwr(l)
- else if (col%itype(c) == icol_road_perv .or. col%itype(c) == icol_road_imperv) then
- scale_c2l(c) = 3.0_r8
- else if (col%itype(c) == icol_roof) then
- scale_c2l(c) = 1.0_r8
- end if
- else
- scale_c2l(c) = 1.0_r8
- end if
- end do
- else if (c2l_scale_type == 'urbans') then
- do c = bounds%begc,bounds%endc
- l = col%landunit(c)
- if (lun%urbpoi(l)) then
- if (col%itype(c) == icol_sunwall) then
- scale_c2l(c) = (3.0 * lun%canyon_hwr(l)) / (2.*lun%canyon_hwr(l) + 1.)
- else if (col%itype(c) == icol_shadewall) then
- scale_c2l(c) = (3.0 * lun%canyon_hwr(l)) / (2.*lun%canyon_hwr(l) + 1.)
- else if (col%itype(c) == icol_road_perv .or. col%itype(c) == icol_road_imperv) then
- scale_c2l(c) = 3.0 / (2.*lun%canyon_hwr(l) + 1.)
- else if (col%itype(c) == icol_roof) then
- scale_c2l(c) = 1.0_r8
- end if
- else
- scale_c2l(c) = 1.0_r8
- end if
- end do
- else
- write(iulog,*)'p2l_2d error: scale type ',c2l_scale_type,' not supported'
- call endrun(msg=errMsg(sourcefile, __LINE__))
- end if
-
- if (p2c_scale_type == 'unity') then
- do p = bounds%begp,bounds%endp
- scale_p2c(p) = 1.0_r8
- end do
- else
- write(iulog,*)'p2l_2d error: scale type ',p2c_scale_type,' not supported'
- call endrun(msg=errMsg(sourcefile, __LINE__))
- end if
-
- larr(bounds%begl : bounds%endl, :) = spval
- do j = 1,num2d
- sumwt(bounds%begl : bounds%endl) = 0._r8
- do p = bounds%begp,bounds%endp
- if (patch%active(p) .and. patch%wtlunit(p) /= 0._r8) then
- c = patch%column(p)
- if (parr(p,j) /= spval .and. scale_c2l(c) /= spval) then
- l = patch%landunit(p)
- if (sumwt(l) == 0._r8) larr(l,j) = 0._r8
- larr(l,j) = larr(l,j) + parr(p,j) * scale_p2c(p) * scale_c2l(c) * patch%wtlunit(p)
- sumwt(l) = sumwt(l) + patch%wtlunit(p)
- end if
- end if
- end do
- found = .false.
- do l = bounds%begl,bounds%endl
- if (sumwt(l) > 1.0_r8 + 1.e-6_r8) then
- found = .true.
- index = l
- else if (sumwt(l) /= 0._r8) then
- larr(l,j) = larr(l,j)/sumwt(l)
- end if
- end do
- if (found) then
- write(iulog,*)'p2l_2d error: sumwt is greater than 1.0 at l= ',index,' j= ',j
- call endrun(decomp_index=index, clmlevel=namel, msg=errMsg(sourcefile, __LINE__))
- end if
- end do
-
- end subroutine p2l_2d
-
- !-----------------------------------------------------------------------
- subroutine p2g_1d(bounds, parr, garr, p2c_scale_type, c2l_scale_type, l2g_scale_type)
- !
- ! !DESCRIPTION:
- ! Perfrom subgrid-average from patches to gridcells.
- ! Averaging is only done for points that are not equal to "spval".
- !
- ! !ARGUMENTS:
- type(bounds_type), intent(in) :: bounds
- real(r8), intent(in) :: parr( bounds%begp: ) ! input patch array
- real(r8), intent(out) :: garr( bounds%begg: ) ! output gridcell array
- character(len=*), intent(in) :: p2c_scale_type ! scale factor type for averaging
- character(len=*), intent(in) :: c2l_scale_type ! scale factor type for averaging (see note at top of module)
- character(len=*), intent(in) :: l2g_scale_type ! scale factor type for averaging
- !
- ! !LOCAL VARIABLES:
- integer :: p,c,l,g,index ! indices
- logical :: found ! temporary for error check
- real(r8) :: scale_p2c(bounds%begp:bounds%endp) ! scale factor
- real(r8) :: scale_c2l(bounds%begc:bounds%endc) ! scale factor
- real(r8) :: scale_l2g(bounds%begl:bounds%endl) ! scale factor
- real(r8) :: sumwt(bounds%begg:bounds%endg) ! sum of weights
- !------------------------------------------------------------------------
-
- ! Enforce expected array sizes
- SHR_ASSERT_ALL((ubound(parr) == (/bounds%endp/)), errMsg(sourcefile, __LINE__))
- SHR_ASSERT_ALL((ubound(garr) == (/bounds%endg/)), errMsg(sourcefile, __LINE__))
-
- call build_scale_l2g(bounds, l2g_scale_type, &
- scale_l2g(bounds%begl:bounds%endl))
-
- if (c2l_scale_type == 'unity') then
- do c = bounds%begc,bounds%endc
- scale_c2l(c) = 1.0_r8
- end do
- else if (c2l_scale_type == 'urbanf') then
- do c = bounds%begc,bounds%endc
- l = col%landunit(c)
- if (lun%urbpoi(l)) then
- if (col%itype(c) == icol_sunwall) then
- scale_c2l(c) = 3.0 * lun%canyon_hwr(l)
- else if (col%itype(c) == icol_shadewall) then
- scale_c2l(c) = 3.0 * lun%canyon_hwr(l)
- else if (col%itype(c) == icol_road_perv .or. col%itype(c) == icol_road_imperv) then
- scale_c2l(c) = 3.0_r8
- else if (col%itype(c) == icol_roof) then
- scale_c2l(c) = 1.0_r8
- end if
- else
- scale_c2l(c) = 1.0_r8
- end if
- end do
- else if (c2l_scale_type == 'urbans') then
- do c = bounds%begc,bounds%endc
- l = col%landunit(c)
- if (lun%urbpoi(l)) then
- if (col%itype(c) == icol_sunwall) then
- scale_c2l(c) = (3.0 * lun%canyon_hwr(l)) / (2.*lun%canyon_hwr(l) + 1.)
- else if (col%itype(c) == icol_shadewall) then
- scale_c2l(c) = (3.0 * lun%canyon_hwr(l)) / (2.*lun%canyon_hwr(l) + 1.)
- else if (col%itype(c) == icol_road_perv .or. col%itype(c) == icol_road_imperv) then
- scale_c2l(c) = 3.0 / (2.*lun%canyon_hwr(l) + 1.)
- else if (col%itype(c) == icol_roof) then
- scale_c2l(c) = 1.0_r8
- end if
- else
- scale_c2l(c) = 1.0_r8
- end if
- end do
- else
- write(iulog,*)'p2g_1d error: scale type ',c2l_scale_type,' not supported'
- call endrun(msg=errMsg(sourcefile, __LINE__))
- end if
-
- if (p2c_scale_type == 'unity') then
- do p = bounds%begp,bounds%endp
- scale_p2c(p) = 1.0_r8
- end do
- else
- write(iulog,*)'p2g_1d error: scale type ',c2l_scale_type,' not supported'
- call endrun(msg=errMsg(sourcefile, __LINE__))
- end if
-
- garr(bounds%begg : bounds%endg) = spval
- sumwt(bounds%begg : bounds%endg) = 0._r8
- do p = bounds%begp,bounds%endp
- if (patch%active(p) .and. patch%wtgcell(p) /= 0._r8) then
- c = patch%column(p)
- l = patch%landunit(p)
- if (parr(p) /= spval .and. scale_c2l(c) /= spval .and. scale_l2g(l) /= spval) then
- g = patch%gridcell(p)
- if (sumwt(g) == 0._r8) garr(g) = 0._r8
- garr(g) = garr(g) + parr(p) * scale_p2c(p) * scale_c2l(c) * scale_l2g(l) * patch%wtgcell(p)
- sumwt(g) = sumwt(g) + patch%wtgcell(p)
- end if
- end if
- end do
- found = .false.
- do g = bounds%begg, bounds%endg
- if (sumwt(g) > 1.0_r8 + 1.e-6_r8) then
- found = .true.
- index = g
- else if (sumwt(g) /= 0._r8) then
- garr(g) = garr(g)/sumwt(g)
- end if
- end do
- if (found) then
- write(iulog,*)'p2g_1d error: sumwt is greater than 1.0 at g= ',index
- call endrun(decomp_index=index, clmlevel=nameg, msg=errMsg(sourcefile, __LINE__))
- end if
-
- end subroutine p2g_1d
-
- !-----------------------------------------------------------------------
- subroutine p2g_2d(bounds, num2d, parr, garr, p2c_scale_type, c2l_scale_type, l2g_scale_type)
- !
- ! !DESCRIPTION:
- ! Perfrom subgrid-average from patches to gridcells.
- ! Averaging is only done for points that are not equal to "spval".
- !
- ! !USES:
- !
- ! !ARGUMENTS:
- type(bounds_type), intent(in) :: bounds
- integer , intent(in) :: num2d ! size of second dimension
- real(r8), intent(in) :: parr( bounds%begp: , 1: ) ! input patch array
- real(r8), intent(out) :: garr( bounds%begg: , 1: ) ! output gridcell array
- character(len=*), intent(in) :: p2c_scale_type ! scale factor type for averaging
- character(len=*), intent(in) :: c2l_scale_type ! scale factor type for averaging (see note at top of module)
- character(len=*), intent(in) :: l2g_scale_type ! scale factor type for averaging
- !
- ! !LOCAL VARIABLES:
- integer :: j,p,c,l,g,index ! indices
- logical :: found ! temporary for error check
- real(r8) :: scale_p2c(bounds%begp:bounds%endp) ! scale factor
- real(r8) :: scale_c2l(bounds%begc:bounds%endc) ! scale factor
- real(r8) :: scale_l2g(bounds%begl:bounds%endl) ! scale factor
- real(r8) :: sumwt(bounds%begg:bounds%endg) ! sum of weights
- !------------------------------------------------------------------------
-
- ! Enforce expected array sizes
- SHR_ASSERT_ALL((ubound(parr) == (/bounds%endp, num2d/)), errMsg(sourcefile, __LINE__))
- SHR_ASSERT_ALL((ubound(garr) == (/bounds%endg, num2d/)), errMsg(sourcefile, __LINE__))
-
- call build_scale_l2g(bounds, l2g_scale_type, &
- scale_l2g(bounds%begl:bounds%endl))
-
- if (c2l_scale_type == 'unity') then
- do c = bounds%begc,bounds%endc
- scale_c2l(c) = 1.0_r8
- end do
- else if (c2l_scale_type == 'urbanf') then
- do c = bounds%begc,bounds%endc
- l = col%landunit(c)
- if (lun%urbpoi(l)) then
- if (col%itype(c) == icol_sunwall) then
- scale_c2l(c) = 3.0 * lun%canyon_hwr(l)
- else if (col%itype(c) == icol_shadewall) then
- scale_c2l(c) = 3.0 * lun%canyon_hwr(l)
- else if (col%itype(c) == icol_road_perv .or. col%itype(c) == icol_road_imperv) then
- scale_c2l(c) = 3.0_r8
- else if (col%itype(c) == icol_roof) then
- scale_c2l(c) = 1.0_r8
- end if
- else
- scale_c2l(c) = 1.0_r8
- end if
- end do
- else if (c2l_scale_type == 'urbans') then
- do c = bounds%begc,bounds%endc
- l = col%landunit(c)
- if (lun%urbpoi(l)) then
- if (col%itype(c) == icol_sunwall) then
- scale_c2l(c) = (3.0 * lun%canyon_hwr(l)) / (2.*lun%canyon_hwr(l) + 1.)
- else if (col%itype(c) == icol_shadewall) then
- scale_c2l(c) = (3.0 * lun%canyon_hwr(l)) / (2.*lun%canyon_hwr(l) + 1.)
- else if (col%itype(c) == icol_road_perv .or. col%itype(c) == icol_road_imperv) then
- scale_c2l(c) = 3.0 / (2.*lun%canyon_hwr(l) + 1.)
- else if (col%itype(c) == icol_roof) then
- scale_c2l(c) = 1.0_r8
- end if
- else
- scale_c2l(c) = 1.0_r8
- end if
- end do
- else
- write(iulog,*)'p2g_2d error: scale type ',c2l_scale_type,' not supported'
- call endrun(msg=errMsg(sourcefile, __LINE__))
- end if
-
- if (p2c_scale_type == 'unity') then
- do p = bounds%begp,bounds%endp
- scale_p2c(p) = 1.0_r8
- end do
- else
- write(iulog,*)'p2g_2d error: scale type ',c2l_scale_type,' not supported'
- call endrun(msg=errMsg(sourcefile, __LINE__))
- end if
-
- garr(bounds%begg : bounds%endg, :) = spval
- do j = 1,num2d
- sumwt(bounds%begg : bounds%endg) = 0._r8
- do p = bounds%begp,bounds%endp
- if (patch%active(p) .and. patch%wtgcell(p) /= 0._r8) then
- c = patch%column(p)
- l = patch%landunit(p)
- if (parr(p,j) /= spval .and. scale_c2l(c) /= spval .and. scale_l2g(l) /= spval) then
- g = patch%gridcell(p)
- if (sumwt(g) == 0._r8) garr(g,j) = 0._r8
- garr(g,j) = garr(g,j) + parr(p,j) * scale_p2c(p) * scale_c2l(c) * scale_l2g(l) * patch%wtgcell(p)
- sumwt(g) = sumwt(g) + patch%wtgcell(p)
- end if
- end if
- end do
- found = .false.
- do g = bounds%begg, bounds%endg
- if (sumwt(g) > 1.0_r8 + 1.e-6_r8) then
- found = .true.
- index = g
- else if (sumwt(g) /= 0._r8) then
- garr(g,j) = garr(g,j)/sumwt(g)
- end if
- end do
- if (found) then
- write(iulog,*)'p2g_2d error: sumwt gt 1.0 at g/sumwt = ',index,sumwt(index)
- call endrun(decomp_index=index, clmlevel=nameg, msg=errMsg(sourcefile, __LINE__))
- end if
- end do
-
- end subroutine p2g_2d
-
- !-----------------------------------------------------------------------
- subroutine c2l_1d (bounds, carr, larr, c2l_scale_type)
- !
- ! !DESCRIPTION:
- ! Perfrom subgrid-average from columns to landunits
- ! Averaging is only done for points that are not equal to "spval".
- !
- ! !ARGUMENTS:
- type(bounds_type), intent(in) :: bounds
- real(r8), intent(in) :: carr( bounds%begc: ) ! input column array
- real(r8), intent(out) :: larr( bounds%begl: ) ! output landunit array
- character(len=*), intent(in) :: c2l_scale_type ! scale factor type for averaging (see note at top of module)
- !
- ! !LOCAL VARIABLES:
- integer :: c,l,index ! indices
- logical :: found ! temporary for error check
- real(r8) :: scale_c2l(bounds%begc:bounds%endc) ! scale factor for column->landunit mapping
- real(r8) :: sumwt(bounds%begl:bounds%endl) ! sum of weights
- !------------------------------------------------------------------------
-
- ! Enforce expected array sizes
- SHR_ASSERT_ALL((ubound(carr) == (/bounds%endc/)), errMsg(sourcefile, __LINE__))
- SHR_ASSERT_ALL((ubound(larr) == (/bounds%endl/)), errMsg(sourcefile, __LINE__))
-
- if (c2l_scale_type == 'unity') then
- do c = bounds%begc,bounds%endc
- scale_c2l(c) = 1.0_r8
- end do
- else if (c2l_scale_type == 'urbanf') then
- do c = bounds%begc,bounds%endc
- l = col%landunit(c)
- if (lun%urbpoi(l)) then
- if (col%itype(c) == icol_sunwall) then
- scale_c2l(c) = 3.0 * lun%canyon_hwr(l)
- else if (col%itype(c) == icol_shadewall) then
- scale_c2l(c) = 3.0 * lun%canyon_hwr(l)
- else if (col%itype(c) == icol_road_perv .or. col%itype(c) == icol_road_imperv) then
- scale_c2l(c) = 3.0_r8
- else if (col%itype(c) == icol_roof) then
- scale_c2l(c) = 1.0_r8
- end if
- else
- scale_c2l(c) = 1.0_r8
- end if
- end do
- else if (c2l_scale_type == 'urbans') then
- do c = bounds%begc,bounds%endc
- l = col%landunit(c)
- if (lun%urbpoi(l)) then
- if (col%itype(c) == icol_sunwall) then
- scale_c2l(c) = (3.0 * lun%canyon_hwr(l)) / (2.*lun%canyon_hwr(l) + 1.)
- else if (col%itype(c) == icol_shadewall) then
- scale_c2l(c) = (3.0 * lun%canyon_hwr(l)) / (2.*lun%canyon_hwr(l) + 1.)
- else if (col%itype(c) == icol_road_perv .or. col%itype(c) == icol_road_imperv) then
- scale_c2l(c) = 3.0 / (2.*lun%canyon_hwr(l) + 1.)
- else if (col%itype(c) == icol_roof) then
- scale_c2l(c) = 1.0_r8
- end if
- else
- scale_c2l(c) = 1.0_r8
- end if
- end do
- else
- write(iulog,*)'c2l_1d error: scale type ',c2l_scale_type,' not supported'
- call endrun(msg=errMsg(sourcefile, __LINE__))
- end if
-
- larr(bounds%begl : bounds%endl) = spval
- sumwt(bounds%begl : bounds%endl) = 0._r8
- do c = bounds%begc,bounds%endc
- if (col%active(c) .and. col%wtlunit(c) /= 0._r8) then
- if (carr(c) /= spval .and. scale_c2l(c) /= spval) then
- l = col%landunit(c)
- if (sumwt(l) == 0._r8) larr(l) = 0._r8
- larr(l) = larr(l) + carr(c) * scale_c2l(c) * col%wtlunit(c)
- sumwt(l) = sumwt(l) + col%wtlunit(c)
- end if
- end if
- end do
- found = .false.
- do l = bounds%begl,bounds%endl
- if (sumwt(l) > 1.0_r8 + 1.e-6_r8) then
- found = .true.
- index = l
- else if (sumwt(l) /= 0._r8) then
- larr(l) = larr(l)/sumwt(l)
- end if
- end do
- if (found) then
- write(iulog,*)'c2l_1d error: sumwt is greater than 1.0 at l= ',index
- call endrun(decomp_index=index, clmlevel=namel, msg=errMsg(sourcefile, __LINE__))
- end if
-
- end subroutine c2l_1d
-
- !-----------------------------------------------------------------------
- subroutine c2l_2d (bounds, num2d, carr, larr, c2l_scale_type)
- !
- ! !DESCRIPTION:
- ! Perfrom subgrid-average from columns to landunits
- ! Averaging is only done for points that are not equal to "spval".
- !
- ! !ARGUMENTS:
- type(bounds_type), intent(in) :: bounds
- integer , intent(in) :: num2d ! size of second dimension
- real(r8), intent(in) :: carr( bounds%begc: , 1: ) ! input column array
- real(r8), intent(out) :: larr( bounds%begl: , 1: ) ! output landunit array
- character(len=*), intent(in) :: c2l_scale_type ! scale factor type for averaging (see note at top of module)
- !
- ! !LOCAL VARIABLES:
- integer :: j,l,c,index ! indices
- logical :: found ! temporary for error check
- real(r8) :: scale_c2l(bounds%begc:bounds%endc) ! scale factor for column->landunit mapping
- real(r8) :: sumwt(bounds%begl:bounds%endl) ! sum of weights
- !------------------------------------------------------------------------
-
- ! Enforce expected array sizes
- SHR_ASSERT_ALL((ubound(carr) == (/bounds%endc, num2d/)), errMsg(sourcefile, __LINE__))
- SHR_ASSERT_ALL((ubound(larr) == (/bounds%endl, num2d/)), errMsg(sourcefile, __LINE__))
-
- if (c2l_scale_type == 'unity') then
- do c = bounds%begc,bounds%endc
- scale_c2l(c) = 1.0_r8
- end do
- else if (c2l_scale_type == 'urbanf') then
- do c = bounds%begc,bounds%endc
- l = col%landunit(c)
- if (lun%urbpoi(l)) then
- if (col%itype(c) == icol_sunwall) then
- scale_c2l(c) = 3.0 * lun%canyon_hwr(l)
- else if (col%itype(c) == icol_shadewall) then
- scale_c2l(c) = 3.0 * lun%canyon_hwr(l)
- else if (col%itype(c) == icol_road_perv .or. col%itype(c) == icol_road_imperv) then
- scale_c2l(c) = 3.0_r8
- else if (col%itype(c) == icol_roof) then
- scale_c2l(c) = 1.0_r8
- end if
- else
- scale_c2l(c) = 1.0_r8
- end if
- end do
- else if (c2l_scale_type == 'urbans') then
- do c = bounds%begc,bounds%endc
- l = col%landunit(c)
- if (lun%urbpoi(l)) then
- if (col%itype(c) == icol_sunwall) then
- scale_c2l(c) = (3.0 * lun%canyon_hwr(l)) / (2.*lun%canyon_hwr(l) + 1.)
- else if (col%itype(c) == icol_shadewall) then
- scale_c2l(c) = (3.0 * lun%canyon_hwr(l)) / (2.*lun%canyon_hwr(l) + 1.)
- else if (col%itype(c) == icol_road_perv .or. col%itype(c) == icol_road_imperv) then
- scale_c2l(c) = 3.0 / (2.*lun%canyon_hwr(l) + 1.)
- else if (col%itype(c) == icol_roof) then
- scale_c2l(c) = 1.0_r8
- end if
- else
- scale_c2l(c) = 1.0_r8
- end if
- end do
- else
- write(iulog,*)'c2l_2d error: scale type ',c2l_scale_type,' not supported'
- call endrun(msg=errMsg(sourcefile, __LINE__))
- end if
-
- larr(bounds%begl : bounds%endl, :) = spval
- do j = 1,num2d
- sumwt(bounds%begl : bounds%endl) = 0._r8
- do c = bounds%begc,bounds%endc
- if (col%active(c) .and. col%wtlunit(c) /= 0._r8) then
- if (carr(c,j) /= spval .and. scale_c2l(c) /= spval) then
- l = col%landunit(c)
- if (sumwt(l) == 0._r8) larr(l,j) = 0._r8
- larr(l,j) = larr(l,j) + carr(c,j) * scale_c2l(c) * col%wtlunit(c)
- sumwt(l) = sumwt(l) + col%wtlunit(c)
- end if
- end if
- end do
- found = .false.
- do l = bounds%begl,bounds%endl
- if (sumwt(l) > 1.0_r8 + 1.e-6_r8) then
- found = .true.
- index = l
- else if (sumwt(l) /= 0._r8) then
- larr(l,j) = larr(l,j)/sumwt(l)
- end if
- end do
- if (found) then
- write(iulog,*)'c2l_2d error: sumwt is greater than 1.0 at l= ',index,' lev= ',j
- call endrun(decomp_index=index, clmlevel=namel, msg=errMsg(sourcefile, __LINE__))
- end if
- end do
-
- end subroutine c2l_2d
-
- !-----------------------------------------------------------------------
- subroutine c2g_1d(bounds, carr, garr, c2l_scale_type, l2g_scale_type)
- !
- ! !DESCRIPTION:
- ! Perfrom subgrid-average from columns to gridcells.
- ! Averaging is only done for points that are not equal to "spval".
- !
- ! !ARGUMENTS:
- type(bounds_type), intent(in) :: bounds
- real(r8), intent(in) :: carr( bounds%begc: ) ! input column array
- real(r8), intent(out) :: garr( bounds%begg: ) ! output gridcell array
- character(len=*), intent(in) :: c2l_scale_type ! scale factor type for averaging (see note at top of module)
- character(len=*), intent(in) :: l2g_scale_type ! scale factor type for averaging
- !
- ! !LOCAL VARIABLES:
- integer :: c,l,g,index ! indices
- logical :: found ! temporary for error check
- real(r8) :: scale_c2l(bounds%begc:bounds%endc) ! scale factor
- real(r8) :: scale_l2g(bounds%begl:bounds%endl) ! scale factor
- real(r8) :: sumwt(bounds%begg:bounds%endg) ! sum of weights
- !------------------------------------------------------------------------
-
- ! Enforce expected array sizes
- SHR_ASSERT_ALL((ubound(carr) == (/bounds%endc/)), errMsg(sourcefile, __LINE__))
- SHR_ASSERT_ALL((ubound(garr) == (/bounds%endg/)), errMsg(sourcefile, __LINE__))
-
- call build_scale_l2g(bounds, l2g_scale_type, &
- scale_l2g(bounds%begl:bounds%endl))
-
- if (c2l_scale_type == 'unity') then
- do c = bounds%begc,bounds%endc
- scale_c2l(c) = 1.0_r8
- end do
- else if (c2l_scale_type == 'urbanf') then
- do c = bounds%begc,bounds%endc
- l = col%landunit(c)
- if (lun%urbpoi(l)) then
- if (col%itype(c) == icol_sunwall) then
- scale_c2l(c) = 3.0 * lun%canyon_hwr(l)
- else if (col%itype(c) == icol_shadewall) then
- scale_c2l(c) = 3.0 * lun%canyon_hwr(l)
- else if (col%itype(c) == icol_road_perv .or. col%itype(c) == icol_road_imperv) then
- scale_c2l(c) = 3.0_r8
- else if (col%itype(c) == icol_roof) then
- scale_c2l(c) = 1.0_r8
- end if
- else
- scale_c2l(c) = 1.0_r8
- end if
- end do
- else if (c2l_scale_type == 'urbans') then
- do c = bounds%begc,bounds%endc
- l = col%landunit(c)
- if (lun%urbpoi(l)) then
- if (col%itype(c) == icol_sunwall) then
- scale_c2l(c) = (3.0 * lun%canyon_hwr(l)) / (2.*lun%canyon_hwr(l) + 1.)
- else if (col%itype(c) == icol_shadewall) then
- scale_c2l(c) = (3.0 * lun%canyon_hwr(l)) / (2.*lun%canyon_hwr(l) + 1.)
- else if (col%itype(c) == icol_road_perv .or. col%itype(c) == icol_road_imperv) then
- scale_c2l(c) = 3.0 / (2.*lun%canyon_hwr(l) + 1.)
- else if (col%itype(c) == icol_roof) then
- scale_c2l(c) = 1.0_r8
- end if
- else
- scale_c2l(c) = 1.0_r8
- end if
- end do
- else
- write(iulog,*)'c2l_1d error: scale type ',c2l_scale_type,' not supported'
- call endrun(msg=errMsg(sourcefile, __LINE__))
- end if
-
- garr(bounds%begg : bounds%endg) = spval
- sumwt(bounds%begg : bounds%endg) = 0._r8
- do c = bounds%begc,bounds%endc
- if (col%active(c) .and. col%wtgcell(c) /= 0._r8) then
- l = col%landunit(c)
- if (carr(c) /= spval .and. scale_c2l(c) /= spval .and. scale_l2g(l) /= spval) then
- g = col%gridcell(c)
- if (sumwt(g) == 0._r8) garr(g) = 0._r8
- garr(g) = garr(g) + carr(c) * scale_c2l(c) * scale_l2g(l) * col%wtgcell(c)
- sumwt(g) = sumwt(g) + col%wtgcell(c)
- end if
- end if
- end do
- found = .false.
- do g = bounds%begg, bounds%endg
- if (sumwt(g) > 1.0_r8 + 1.e-6_r8) then
- found = .true.
- index = g
- else if (sumwt(g) /= 0._r8) then
- garr(g) = garr(g)/sumwt(g)
- end if
- end do
- if (found) then
- write(iulog,*)'c2g_1d error: sumwt is greater than 1.0 at g= ',index
- call endrun(decomp_index=index, clmlevel=nameg, msg=errMsg(sourcefile, __LINE__))
- end if
-
- end subroutine c2g_1d
-
- !-----------------------------------------------------------------------
- subroutine c2g_2d(bounds, num2d, carr, garr, c2l_scale_type, l2g_scale_type)
- !
- ! !DESCRIPTION:
- ! Perfrom subgrid-average from columns to gridcells.
- ! Averaging is only done for points that are not equal to "spval".
- !
- ! !ARGUMENTS:
- type(bounds_type), intent(in) :: bounds
- integer , intent(in) :: num2d ! size of second dimension
- real(r8), intent(in) :: carr( bounds%begc: , 1: ) ! input column array
- real(r8), intent(out) :: garr( bounds%begg: , 1: ) ! output gridcell array
- character(len=*), intent(in) :: c2l_scale_type ! scale factor type for averaging (see note at top of module)
- character(len=*), intent(in) :: l2g_scale_type ! scale factor type for averaging
- !
- ! !LOCAL VARIABLES:
- integer :: j,c,g,l,index ! indices
- logical :: found ! temporary for error check
- real(r8) :: scale_c2l(bounds%begc:bounds%endc) ! scale factor
- real(r8) :: scale_l2g(bounds%begl:bounds%endl) ! scale factor
- real(r8) :: sumwt(bounds%begg:bounds%endg) ! sum of weights
- !------------------------------------------------------------------------
-
- ! Enforce expected array sizes
- SHR_ASSERT_ALL((ubound(carr) == (/bounds%endc, num2d/)), errMsg(sourcefile, __LINE__))
- SHR_ASSERT_ALL((ubound(garr) == (/bounds%endg, num2d/)), errMsg(sourcefile, __LINE__))
-
- call build_scale_l2g(bounds, l2g_scale_type, &
- scale_l2g(bounds%begl:bounds%endl))
-
- if (c2l_scale_type == 'unity') then
- do c = bounds%begc,bounds%endc
- scale_c2l(c) = 1.0_r8
- end do
- else if (c2l_scale_type == 'urbanf') then
- do c = bounds%begc,bounds%endc
- l = col%landunit(c)
- if (lun%urbpoi(l)) then
- if (col%itype(c) == icol_sunwall) then
- scale_c2l(c) = 3.0 * lun%canyon_hwr(l)
- else if (col%itype(c) == icol_shadewall) then
- scale_c2l(c) = 3.0 * lun%canyon_hwr(l)
- else if (col%itype(c) == icol_road_perv .or. col%itype(c) == icol_road_imperv) then
- scale_c2l(c) = 3.0_r8
- else if (col%itype(c) == icol_roof) then
- scale_c2l(c) = 1.0_r8
- end if
- else
- scale_c2l(c) = 1.0_r8
- end if
- end do
- else if (c2l_scale_type == 'urbans') then
- do c = bounds%begc,bounds%endc
- l = col%landunit(c)
- if (lun%urbpoi(l)) then
- if (col%itype(c) == icol_sunwall) then
- scale_c2l(c) = (3.0 * lun%canyon_hwr(l)) / (2.*lun%canyon_hwr(l) + 1.)
- else if (col%itype(c) == icol_shadewall) then
- scale_c2l(c) = (3.0 * lun%canyon_hwr(l)) / (2.*lun%canyon_hwr(l) + 1.)
- else if (col%itype(c) == icol_road_perv .or. col%itype(c) == icol_road_imperv) then
- scale_c2l(c) = 3.0 / (2.*lun%canyon_hwr(l) + 1.)
- else if (col%itype(c) == icol_roof) then
- scale_c2l(c) = 1.0_r8
- end if
- else
- scale_c2l(c) = 1.0_r8
- end if
- end do
- else
- write(iulog,*)'c2g_2d error: scale type ',c2l_scale_type,' not supported'
- call endrun(msg=errMsg(sourcefile, __LINE__))
- end if
-
- garr(bounds%begg : bounds%endg,:) = spval
- do j = 1,num2d
- sumwt(bounds%begg : bounds%endg) = 0._r8
- do c = bounds%begc,bounds%endc
- if (col%active(c) .and. col%wtgcell(c) /= 0._r8) then
- l = col%landunit(c)
- if (carr(c,j) /= spval .and. scale_c2l(c) /= spval .and. scale_l2g(l) /= spval) then
- g = col%gridcell(c)
- if (sumwt(g) == 0._r8) garr(g,j) = 0._r8
- garr(g,j) = garr(g,j) + carr(c,j) * scale_c2l(c) * scale_l2g(l) * col%wtgcell(c)
- sumwt(g) = sumwt(g) + col%wtgcell(c)
- end if
- end if
- end do
- found = .false.
- do g = bounds%begg, bounds%endg
- if (sumwt(g) > 1.0_r8 + 1.e-6_r8) then
- found = .true.
- index = g
- else if (sumwt(g) /= 0._r8) then
- garr(g,j) = garr(g,j)/sumwt(g)
- end if
- end do
- if (found) then
- write(iulog,*)'c2g_2d error: sumwt is greater than 1.0 at g= ',index
- call endrun(decomp_index=index, clmlevel=nameg, msg=errMsg(sourcefile, __LINE__))
- end if
- end do
-
- end subroutine c2g_2d
-
- !-----------------------------------------------------------------------
- subroutine l2g_1d(bounds, larr, garr, l2g_scale_type)
- !
- ! !DESCRIPTION:
- ! Perfrom subgrid-average from landunits to gridcells.
- ! Averaging is only done for points that are not equal to "spval".
- !
- ! !ARGUMENTS:
- type(bounds_type), intent(in) :: bounds
- real(r8), intent(in) :: larr( bounds%begl: ) ! input landunit array
- real(r8), intent(out) :: garr( bounds%begg: ) ! output gridcell array
- character(len=*), intent(in) :: l2g_scale_type ! scale factor type for averaging
- !
- ! !LOCAL VARIABLES:
- integer :: l,g,index ! indices
- logical :: found ! temporary for error check
- real(r8) :: scale_l2g(bounds%begl:bounds%endl) ! scale factor
- real(r8) :: sumwt(bounds%begg:bounds%endg) ! sum of weights
- !------------------------------------------------------------------------
-
- ! Enforce expected array sizes
- SHR_ASSERT_ALL((ubound(larr) == (/bounds%endl/)), errMsg(sourcefile, __LINE__))
- SHR_ASSERT_ALL((ubound(garr) == (/bounds%endg/)), errMsg(sourcefile, __LINE__))
-
- call build_scale_l2g(bounds, l2g_scale_type, &
- scale_l2g(bounds%begl:bounds%endl))
-
- garr(bounds%begg : bounds%endg) = spval
- sumwt(bounds%begg : bounds%endg) = 0._r8
- do l = bounds%begl,bounds%endl
- if (lun%active(l) .and. lun%wtgcell(l) /= 0._r8) then
- if (larr(l) /= spval .and. scale_l2g(l) /= spval) then
- g = lun%gridcell(l)
- if (sumwt(g) == 0._r8) garr(g) = 0._r8
- garr(g) = garr(g) + larr(l) * scale_l2g(l) * lun%wtgcell(l)
- sumwt(g) = sumwt(g) + lun%wtgcell(l)
- end if
- end if
- end do
- found = .false.
- do g = bounds%begg, bounds%endg
- if (sumwt(g) > 1.0_r8 + 1.e-6_r8) then
- found = .true.
- index = g
- else if (sumwt(g) /= 0._r8) then
- garr(g) = garr(g)/sumwt(g)
- end if
- end do
- if (found) then
- write(iulog,*)'l2g_1d error: sumwt is greater than 1.0 at g= ',index
- call endrun(decomp_index=index, clmlevel=nameg, msg=errMsg(sourcefile, __LINE__))
- end if
-
- end subroutine l2g_1d
-
- !-----------------------------------------------------------------------
- subroutine l2g_2d(bounds, num2d, larr, garr, l2g_scale_type)
- !
- ! !DESCRIPTION:
- ! Perfrom subgrid-average from landunits to gridcells.
- ! Averaging is only done for points that are not equal to "spval".
- !
- ! !ARGUMENTS:
- type(bounds_type), intent(in) :: bounds
- integer , intent(in) :: num2d ! size of second dimension
- real(r8), intent(in) :: larr( bounds%begl: , 1: ) ! input landunit array
- real(r8), intent(out) :: garr( bounds%begg: , 1: ) ! output gridcell array
- character(len=*), intent(in) :: l2g_scale_type ! scale factor type for averaging
- !
- ! !LOCAL VARIABLES:
- integer :: j,g,l,index ! indices
- integer :: max_lu_per_gcell ! max landunits per gridcell; on the fly
- logical :: found ! temporary for error check
- real(r8) :: scale_l2g(bounds%begl:bounds%endl) ! scale factor
- real(r8) :: sumwt(bounds%begg:bounds%endg) ! sum of weights
- !------------------------------------------------------------------------
-
- ! Enforce expected array sizes
- SHR_ASSERT_ALL((ubound(larr) == (/bounds%endl, num2d/)), errMsg(sourcefile, __LINE__))
- SHR_ASSERT_ALL((ubound(garr) == (/bounds%endg, num2d/)), errMsg(sourcefile, __LINE__))
-
- call build_scale_l2g(bounds, l2g_scale_type, &
- scale_l2g(bounds%begl:bounds%endl))
-
- garr(bounds%begg : bounds%endg, :) = spval
- do j = 1,num2d
- sumwt(bounds%begg : bounds%endg) = 0._r8
- do l = bounds%begl,bounds%endl
- if (lun%active(l) .and. lun%wtgcell(l) /= 0._r8) then
- if (larr(l,j) /= spval .and. scale_l2g(l) /= spval) then
- g = lun%gridcell(l)
- if (sumwt(g) == 0._r8) garr(g,j) = 0._r8
- garr(g,j) = garr(g,j) + larr(l,j) * scale_l2g(l) * lun%wtgcell(l)
- sumwt(g) = sumwt(g) + lun%wtgcell(l)
- end if
- end if
- end do
- found = .false.
- do g = bounds%begg,bounds%endg
- if (sumwt(g) > 1.0_r8 + 1.e-6_r8) then
- found = .true.
- index= g
- else if (sumwt(g) /= 0._r8) then
- garr(g,j) = garr(g,j)/sumwt(g)
- end if
- end do
- if (found) then
- write(iulog,*)'l2g_2d error: sumwt is greater than 1.0 at g= ',index,' lev= ',j
- call endrun(decomp_index=index, clmlevel=nameg, msg=errMsg(sourcefile, __LINE__))
- end if
- end do
-
- end subroutine l2g_2d
-
- !-----------------------------------------------------------------------
- subroutine build_scale_l2g(bounds, l2g_scale_type, scale_l2g)
- !
- ! !DESCRIPTION:
- ! Fill the scale_l2g(bounds%begl:bounds%endl) array with appropriate values for the given l2g_scale_type.
- ! This array can later be used to scale each landunit in forming grid cell averages.
- !
- ! !USES:
- use landunit_varcon, only : max_lunit
- !
- ! !ARGUMENTS:
- type(bounds_type), intent(in) :: bounds
- character(len=*), intent(in) :: l2g_scale_type ! scale factor type for averaging
- real(r8) , intent(out) :: scale_l2g( bounds%begl: ) ! scale factor
- !
- ! !LOCAL VARIABLES:
- real(r8) :: scale_lookup(max_lunit) ! scale factor for each landunit type
- integer :: l ! index
- !-----------------------------------------------------------------------
-
- SHR_ASSERT_ALL((ubound(scale_l2g) == (/bounds%endl/)), errMsg(sourcefile, __LINE__))
-
- ! TODO(wjs, 2017-03-09) If this routine is a performance problem (which it may be,
- ! because I think it's called a lot), then a simple optimization would be to treat
- ! l2g_scale_type = 'unity' specially, rather than using the more general-purpose code
- ! for this special case.
-
- call create_scale_l2g_lookup(l2g_scale_type, scale_lookup)
-
- do l = bounds%begl,bounds%endl
- scale_l2g(l) = scale_lookup(lun%itype(l))
- end do
-
- end subroutine build_scale_l2g
-
- !-----------------------------------------------------------------------
- subroutine create_scale_l2g_lookup(l2g_scale_type, scale_lookup)
- !
- ! DESCRIPTION:
- ! Create a lookup array, scale_lookup(1..max_lunit), which gives the scale factor for
- ! each landunit type depending on l2g_scale_type
- !
- ! !USES:
- use landunit_varcon, only : istsoil, istcrop, istice_mec, istdlak
- use landunit_varcon, only : isturb_MIN, isturb_MAX, max_lunit
- !
- ! !ARGUMENTS:
- character(len=*), intent(in) :: l2g_scale_type ! scale factor type for averaging
- real(r8) , intent(out) :: scale_lookup(max_lunit) ! scale factor for each landunit type
- !-----------------------------------------------------------------------
-
- ! ------------ WJS (10-14-11): IMPORTANT GENERAL NOTES ------------
- !
- ! Since scale_l2g is not currently included in the sumwt accumulations, you need to
- ! be careful about the scale values you use. Values of 1 and spval are safe
- ! (including having multiple landunits with value 1), but only use other values if
- ! you know what you are doing! For example, using a value of 0 is NOT the correct way
- ! to exclude a landunit from the average, because the normalization will be done
- ! incorrectly in this case: instead, use spval to exclude a landunit from the
- ! average. Similarly, using a value of 2 is NOT the correct way to give a landunit
- ! double relative weight in general, because the normalization won't be done
- ! correctly in this case, either.
- !
- ! In the longer-term, I believe that the correct solution to this problem is to
- ! include scale_l2g (and the other scale factors) in the sumwt accumulations
- ! (e.g., sumwt = sumwt + wtgcell * scale_p2c * scale_c2l * scale_l2g), but that
- ! requires some more thought to (1) make sure that is correct, and (2) make sure it
- ! doesn't break the urban scaling.
- !
- ! -----------------------------------------------------------------
-
-
- ! Initialize scale_lookup to spval for all landunits. Thus, any landunit that keeps
- ! the default value will be excluded from grid cell averages.
- scale_lookup(:) = spval
-
- if (l2g_scale_type == 'unity') then
- scale_lookup(:) = 1.0_r8
- else if (l2g_scale_type == 'natveg') then
- scale_lookup(istsoil) = 1.0_r8
- else if (l2g_scale_type == 'veg') then
- scale_lookup(istsoil) = 1.0_r8
- scale_lookup(istcrop) = 1.0_r8
- else if (l2g_scale_type == 'ice') then
- scale_lookup(istice_mec) = 1.0_r8
- else if (l2g_scale_type == 'nonurb') then
- scale_lookup(:) = 1.0_r8
- scale_lookup(isturb_MIN:isturb_MAX) = spval
- else if (l2g_scale_type == 'lake') then
- scale_lookup(istdlak) = 1.0_r8
- else if (l2g_scale_type == 'veg_plus_lake') then
- scale_lookup(istsoil) = 1.0_r8
- scale_lookup(istcrop) = 1.0_r8
- scale_lookup(istdlak) = 1.0_r8
- else
- write(iulog,*)'scale_l2g_lookup_array error: scale type ',l2g_scale_type,' not supported'
- call endrun(msg=errMsg(sourcefile, __LINE__))
- end if
-
- end subroutine create_scale_l2g_lookup
-
-end module subgridAveMod
diff --git a/src/main/subgridMod.F90 b/src/main/subgridMod.F90
deleted file mode 100644
index f844033a..00000000
--- a/src/main/subgridMod.F90
+++ /dev/null
@@ -1,471 +0,0 @@
-module subgridMod
-
- !-----------------------------------------------------------------------
- ! !DESCRIPTION:
- ! sub-grid data and mapping types and modules
- !
- ! TODO(wjs, 2015-12-08) Much of the logic here duplicates (in some sense) logic in
- ! initGridCellsMod. The duplication should probably be extracted into routines shared
- ! between these modules (or the two modules should be combined into one).
- !
- ! !USES:
-#include "shr_assert.h"
- use shr_kind_mod , only : r8 => shr_kind_r8
- use shr_log_mod , only : errMsg => shr_log_errMsg
- use spmdMod , only : masterproc
- use abortutils , only : endrun
- use clm_varctl , only : iulog
- use clm_instur , only : wt_lunit, urban_valid, wt_cft
- use glcBehaviorMod , only : glc_behavior_type
-
- implicit none
- private
- save
-
- ! !PUBLIC MEMBER FUNCTIONS:
- public :: subgrid_get_gcellinfo ! Obtain gridcell properties, summed across all landunits
-
- ! Routines to get info for each landunit:
- public :: subgrid_get_info_natveg
- public :: subgrid_get_info_cohort
- public :: subgrid_get_info_urban_tbd
- public :: subgrid_get_info_urban_hd
- public :: subgrid_get_info_urban_md
- public :: subgrid_get_info_lake
- public :: subgrid_get_info_wetland
- public :: subgrid_get_info_glacier_mec
- public :: subgrid_get_info_crop
- public :: crop_patch_exists ! returns true if the given crop patch should be created in memory
-
- ! !PRIVATE MEMBER FUNCTIONS:
- private :: subgrid_get_info_urban
-
- character(len=*), parameter, private :: sourcefile = &
- __FILE__
- !-----------------------------------------------------------------------
-
-contains
-
- !------------------------------------------------------------------------------
- subroutine subgrid_get_gcellinfo (gi, glc_behavior, &
- nlunits, ncols, npatches, ncohorts)
- !
- ! !DESCRIPTION:
- ! Obtain gridcell properties, aggregated across all landunits
- !
- ! !ARGUMENTS
- integer , intent(in) :: gi ! grid cell index
- type(glc_behavior_type), intent(in) :: glc_behavior
- integer , intent(out) :: nlunits ! number of landunits
- integer , intent(out) :: ncols ! number of columns
- integer , intent(out) :: npatches ! number of patchs
- integer , intent(out) :: ncohorts ! number of cohorts
- !
- ! !LOCAL VARIABLES:
- ! Counts from a single landunit:
- integer :: ncohorts_temp
- integer :: npatches_temp
- integer :: ncols_temp
- integer :: nlunits_temp
-
- ! atm_topo is arbitrary for the sake of getting these counts. We don't have a true
- ! atm_topo value at the point of this call, so use 0.
- real(r8), parameter :: atm_topo = 0._r8
- !------------------------------------------------------------------------------
-
- npatches = 0
- ncols = 0
- nlunits = 0
- ncohorts = 0
-
- call subgrid_get_info_natveg(gi, npatches_temp, ncols_temp, nlunits_temp)
- call accumulate_counters()
-
- call subgrid_get_info_urban_tbd(gi, npatches_temp, ncols_temp, nlunits_temp)
- call accumulate_counters()
-
- call subgrid_get_info_urban_hd(gi, npatches_temp, ncols_temp, nlunits_temp)
- call accumulate_counters()
-
- call subgrid_get_info_urban_md(gi, npatches_temp, ncols_temp, nlunits_temp)
- call accumulate_counters()
-
- call subgrid_get_info_lake(gi, npatches_temp, ncols_temp, nlunits_temp)
- call accumulate_counters()
-
- call subgrid_get_info_wetland(gi, npatches_temp, ncols_temp, nlunits_temp)
- call accumulate_counters()
-
- call subgrid_get_info_glacier_mec(gi, atm_topo, glc_behavior, &
- npatches_temp, ncols_temp, nlunits_temp)
- call accumulate_counters()
-
- call subgrid_get_info_crop(gi, npatches_temp, ncols_temp, nlunits_temp)
- call accumulate_counters()
-
- call subgrid_get_info_cohort(gi,ncohorts)
-
- contains
- subroutine accumulate_counters
- ! Accumulate running sums of patches, columns and landunits.
- !
- ! This uses local variables in the parent subroutine as both inputs and outputs
-
- npatches = npatches + npatches_temp
- ncols = ncols + ncols_temp
- nlunits = nlunits + nlunits_temp
-
- end subroutine accumulate_counters
-
- end subroutine subgrid_get_gcellinfo
-
- !-----------------------------------------------------------------------
- subroutine subgrid_get_info_natveg(gi, npatches, ncols, nlunits)
- !
- ! !DESCRIPTION:
- ! Obtain properties for natural vegetated landunit in this grid cell
- !
- ! !USES
- use clm_varpar, only : natpft_size
- !
- ! !ARGUMENTS:
- integer, intent(in) :: gi ! grid cell index
- integer, intent(out) :: npatches ! number of nat veg patches in this grid cell
- integer, intent(out) :: ncols ! number of nat veg columns in this grid cell
- integer, intent(out) :: nlunits ! number of nat veg landunits in this grid cell
- !
- ! !LOCAL VARIABLES:
-
- character(len=*), parameter :: subname = 'subgrid_get_info_natveg'
- !-----------------------------------------------------------------------
-
- ! To support dynamic landunits, we have a naturally vegetated landunit in every grid
- ! cell, because it might need to come into existence even if its weight is 0 at the
- ! start of the run. And to support transient patches or dynamic vegetation, we always
- ! allocate space for ALL patches on this landunit.
-
- npatches = natpft_size
-
- ! Assume that the vegetated landunit has one column
- nlunits = 1
- ncols = 1
-
- end subroutine subgrid_get_info_natveg
-
- ! -----------------------------------------------------------------------------
-
- subroutine subgrid_get_info_cohort(gi, ncohorts)
- !
- ! !DESCRIPTION:
- ! Obtain cohort counts per each gridcell.
- !
- ! !USES
- use clm_varpar, only : natpft_size
- !
- ! !ARGUMENTS:
- integer, intent(in) :: gi ! grid cell index
- integer, intent(out) :: ncohorts ! number of cohorts in this grid cell
- !
- ! !LOCAL VARIABLES:
-
- character(len=*), parameter :: subname = 'subgrid_get_info_cohort'
- !-----------------------------------------------------------------------
-
- ! -------------------------------------------------------------------------
- ! Number of cohorts is set here
- ! FATES cohorts populate all natural vegetation columns.
- ! There is only one natural vegetation column per grid-cell. So allocations
- ! are mapped to the gridcell. In the future we may have more than one site
- ! per gridcell, and we just multiply that factor here.
- ! It is possible that there may be gridcells that don't have a naturally
- ! vegetated column. That case should be fine, as the cohort
- ! restart vector will just be a little sparse.
- ! -------------------------------------------------------------------------
-
- ncohorts = 1
-
- end subroutine subgrid_get_info_cohort
-
-
- !-----------------------------------------------------------------------
- subroutine subgrid_get_info_urban_tbd(gi, npatches, ncols, nlunits)
- !
- ! !DESCRIPTION:
- ! Obtain properties for urban tbd landunit in this grid cell
- !
- ! !ARGUMENTS:
- integer, intent(in) :: gi ! grid cell index
- integer, intent(out) :: npatches ! number of urban tbd patches in this grid cell
- integer, intent(out) :: ncols ! number of urban tbd columns in this grid cell
- integer, intent(out) :: nlunits ! number of urban tbd landunits in this grid cell
- !
- ! !LOCAL VARIABLES:
-
- character(len=*), parameter :: subname = 'subgrid_get_info_urban_tbd'
- !-----------------------------------------------------------------------
-
- call subgrid_get_info_urban(gi, npatches, ncols, nlunits)
-
- end subroutine subgrid_get_info_urban_tbd
-
- !-----------------------------------------------------------------------
- subroutine subgrid_get_info_urban_hd(gi, npatches, ncols, nlunits)
- !
- ! !DESCRIPTION:
- ! Obtain properties for urban hd landunit in this grid cell
- !
- ! !ARGUMENTS:
- integer, intent(in) :: gi ! grid cell index
- integer, intent(out) :: npatches ! number of urban hd patches in this grid cell
- integer, intent(out) :: ncols ! number of urban hd columns in this grid cell
- integer, intent(out) :: nlunits ! number of urban hd landunits in this grid cell
- !
- ! !LOCAL VARIABLES:
-
- character(len=*), parameter :: subname = 'subgrid_get_info_urban_hd'
- !-----------------------------------------------------------------------
-
- call subgrid_get_info_urban(gi, npatches, ncols, nlunits)
-
- end subroutine subgrid_get_info_urban_hd
-
- !-----------------------------------------------------------------------
- subroutine subgrid_get_info_urban_md(gi, npatches, ncols, nlunits)
- !
- ! !DESCRIPTION:
- ! Obtain properties for urban md landunit in this grid cell
- !
- ! !ARGUMENTS:
- integer, intent(in) :: gi ! grid cell index
- integer, intent(out) :: npatches ! number of urban md patches in this grid cell
- integer, intent(out) :: ncols ! number of urban md columns in this grid cell
- integer, intent(out) :: nlunits ! number of urban md landunits in this grid cell
- !
- ! !LOCAL VARIABLES:
-
- character(len=*), parameter :: subname = 'subgrid_get_info_urban_md'
- !-----------------------------------------------------------------------
-
- call subgrid_get_info_urban(gi, npatches, ncols, nlunits)
-
- end subroutine subgrid_get_info_urban_md
-
- !-----------------------------------------------------------------------
- subroutine subgrid_get_info_urban(gi, npatches, ncols, nlunits)
- !
- ! !DESCRIPTION:
- ! Obtain properties for one of the urban landunits in this grid cell
- !
- ! This is shared for all urban landunits, because currently they are all treated the same.
- !
- ! !USES
- use clm_varpar, only : maxpatch_urb
- !
- ! !ARGUMENTS:
- integer, intent(in) :: gi ! grid cell index
- integer, intent(out) :: npatches ! number of urban patches in this grid cell, for one urban landunit
- integer, intent(out) :: ncols ! number of urban columns in this grid cell, for one urban landunit
- integer, intent(out) :: nlunits ! number of urban landunits in this grid cell, for one urban landunit
- !
- ! !LOCAL VARIABLES:
-
- character(len=*), parameter :: subname = 'subgrid_get_info_urban'
- !-----------------------------------------------------------------------
-
- ! To support dynamic landunits, we have all urban landunits in every grid cell that
- ! has valid urban parameters, because they might need to come into existence even if
- ! their weight is 0 at the start of the run. And for simplicity, we always allocate
- ! space for ALL columns on the urban landunits.
-
- if (urban_valid(gi)) then
- npatches = maxpatch_urb
- ncols = npatches
- nlunits = 1
- else
- npatches = 0
- ncols = 0
- nlunits = 0
- end if
-
- end subroutine subgrid_get_info_urban
-
- !-----------------------------------------------------------------------
- subroutine subgrid_get_info_lake(gi, npatches, ncols, nlunits)
- !
- ! !DESCRIPTION:
- ! Obtain properties for lake landunit in this grid cell
- !
- ! !USES:
- use landunit_varcon, only : istdlak
- !
- ! !ARGUMENTS:
- integer, intent(in) :: gi ! grid cell index
- integer, intent(out) :: npatches ! number of lake patches in this grid cell
- integer, intent(out) :: ncols ! number of lake columns in this grid cell
- integer, intent(out) :: nlunits ! number of lake landunits in this grid cell
- !
- ! !LOCAL VARIABLES:
-
- character(len=*), parameter :: subname = 'subgrid_get_info_lake'
- !-----------------------------------------------------------------------
-
- ! We currently do NOT allow the lake landunit to expand via dynamic landunits, so we
- ! only need to allocate space for it where its weight is currently non-zero.
-
- if (wt_lunit(gi, istdlak) > 0.0_r8) then
- npatches = 1
- ncols = 1
- nlunits = 1
- else
- npatches = 0
- ncols = 0
- nlunits = 0
- end if
-
- end subroutine subgrid_get_info_lake
-
- !-----------------------------------------------------------------------
- subroutine subgrid_get_info_wetland(gi, npatches, ncols, nlunits)
- !
- ! !DESCRIPTION:
- ! Obtain properties for wetland landunit in this grid cell
- !
- ! !USES:
- use landunit_varcon, only : istwet
- !
- ! !ARGUMENTS:
- integer, intent(in) :: gi ! grid cell index
- integer, intent(out) :: npatches ! number of wetland patches in this grid cell
- integer, intent(out) :: ncols ! number of wetland columns in this grid cell
- integer, intent(out) :: nlunits ! number of wetland landunits in this grid cell
- !
- ! !LOCAL VARIABLES:
-
- character(len=*), parameter :: subname = 'subgrid_get_info_wetland'
- !-----------------------------------------------------------------------
-
- ! We currently do NOT allow the wetland landunit to expand via dynamic landunits, so we
- ! only need to allocate space for it where its weight is currently non-zero.
-
- if (wt_lunit(gi, istwet) > 0.0_r8) then
- npatches = 1
- ncols = 1
- nlunits = 1
- else
- npatches = 0
- ncols = 0
- nlunits = 0
- end if
-
- end subroutine subgrid_get_info_wetland
-
- !-----------------------------------------------------------------------
- subroutine subgrid_get_info_glacier_mec(gi, atm_topo, glc_behavior, npatches, ncols, nlunits)
- !
- ! !DESCRIPTION:
- ! Obtain properties for glacier_mec landunit in this grid cell
- !
- ! !ARGUMENTS:
- integer, intent(in) :: gi ! grid cell index
- real(r8), intent(in) :: atm_topo ! atmosphere's topographic height for this grid cell (m)
- type(glc_behavior_type), intent(in) :: glc_behavior
- integer, intent(out) :: npatches ! number of glacier_mec patches in this grid cell
- integer, intent(out) :: ncols ! number of glacier_mec columns in this grid cell
- integer, intent(out) :: nlunits ! number of glacier_mec landunits in this grid cell
- !
- ! !LOCAL VARIABLES:
-
- character(len=*), parameter :: subname = 'subgrid_get_info_glacier_mec'
- !-----------------------------------------------------------------------
-
- call glc_behavior%get_num_glc_mec_subgrid(gi, atm_topo, npatches, ncols, nlunits)
-
- end subroutine subgrid_get_info_glacier_mec
-
- !-----------------------------------------------------------------------
- subroutine subgrid_get_info_crop(gi, npatches, ncols, nlunits)
- !
- ! !DESCRIPTION:
- ! Obtain properties for crop landunit in this grid cell
- !
- ! !USES:
- use clm_varpar, only : cft_lb, cft_ub
- !
- ! !ARGUMENTS:
- integer, intent(in) :: gi ! grid cell index
- integer, intent(out) :: npatches ! number of nat veg patches in this grid cell
- integer, intent(out) :: ncols ! number of nat veg columns in this grid cell
- integer, intent(out) :: nlunits ! number of nat veg landunits in this grid cell
- !
- ! !LOCAL VARIABLES:
- integer :: cft ! crop functional type index
-
- character(len=*), parameter :: subname = 'subgrid_get_info_crop'
- !-----------------------------------------------------------------------
-
- npatches = 0
-
- do cft = cft_lb, cft_ub
- if (crop_patch_exists(gi, cft)) then
- npatches = npatches + 1
- end if
- end do
-
- if (npatches > 0) then
- ncols = npatches
- nlunits = 1
- else
- ncols = 0
- nlunits = 0
- end if
-
- end subroutine subgrid_get_info_crop
-
- !-----------------------------------------------------------------------
- function crop_patch_exists(gi, cft) result(exists)
- !
- ! !DESCRIPTION:
- ! Returns true if a patch should be created in memory for the given crop functional
- ! type in this grid cell.
- !
- ! This just applies to the crop landunit: it always returns .false. if
- ! create_crop_landunit is .false.
- !
- ! !USES:
- use clm_varpar , only : cft_lb, cft_ub
- use clm_varctl , only : create_crop_landunit
- use pftconmod , only : pftcon
- use landunit_varcon , only : istcrop
- !
- ! !ARGUMENTS:
- logical :: exists ! function result
- integer, intent(in) :: gi ! grid cell index
- integer, intent(in) :: cft ! crop functional type
- !
- ! !LOCAL VARIABLES:
-
- character(len=*), parameter :: subname = 'crop_patch_exists'
- !-----------------------------------------------------------------------
-
- if (create_crop_landunit) then
- SHR_ASSERT(cft >= cft_lb, errMsg(sourcefile, __LINE__))
- SHR_ASSERT(cft <= cft_ub, errMsg(sourcefile, __LINE__))
-
- ! For a run without transient crops, only allocate memory for crops that are
- ! actually present in this run. (This will require running init_interp when
- ! changing between a transient crop run and a non-transient run.)
- if (wt_lunit(gi, istcrop) > 0.0_r8 .and. wt_cft(gi, cft) > 0.0_r8) then
- exists = .true.
- else
- exists = .false.
- end if
-
- else ! create_crop_landunit false
- exists = .false.
- end if
-
- end function crop_patch_exists
-
-
-
-end module subgridMod
diff --git a/src/main/subgridRestMod.F90 b/src/main/subgridRestMod.F90
index 725db503..0ef02757 100644
--- a/src/main/subgridRestMod.F90
+++ b/src/main/subgridRestMod.F90
@@ -7,18 +7,12 @@ module subgridRestMod
use shr_kind_mod , only : r8 => shr_kind_r8
use shr_log_mod , only : errMsg => shr_log_errMsg
use abortutils , only : endrun
- use decompMod , only : bounds_type, BOUNDS_LEVEL_PROC, ldecomp
+ use decompMod , only : bounds_type, ldecomp
use domainMod , only : ldomain
- use clm_time_manager , only : get_curr_date
- use clm_varcon , only : nameg, namel, namec, namep
- use clm_varpar , only : nlevsno, nlevgrnd
+ use clm_varcon , only : nameg
use pio , only : file_desc_t
use ncdio_pio , only : ncd_int, ncd_double
- use GetGlobalValuesMod , only : GetGlobalIndex
use GridcellType , only : grc
- use LandunitType , only : lun
- use ColumnType , only : col
- use PatchType , only : patch
use restUtilMod
!
! !PUBLIC TYPES:
@@ -28,17 +22,11 @@ module subgridRestMod
!
! !PUBLIC MEMBER FUNCTIONS:
public :: subgridRestWrite ! handle restart writes of subgrid variables
- public :: subgridRestRead ! handle restart reads of subgrid variables
- public :: subgridRest_check_consistency ! check consistency of variables read by subgridRest
- public :: subgridRest_read_cleanup ! do cleanup of variables allocated when reading the restart file; should be called after subgridRest and subgridRest_check_consistency are complete
! !PRIVATE MEMBER FUNCTIONS:
private :: subgridRest_write_only ! handle restart of subgrid variables that only need to be written, not read
- private :: subgridRest_write_and_read ! handle restart of subgrid variables that need to be read as well as written
- private :: save_old_weights
! !PRIVATE TYPES:
- real(r8), allocatable :: pft_wtlunit_before_rest_read(:) ! patch%wtlunit weights - saved values from before the restart read
character(len=*), parameter, private :: sourcefile = &
__FILE__
@@ -63,29 +51,9 @@ subroutine subgridRestWrite(bounds, ncid, flag)
!-----------------------------------------------------------------------
call subgridRest_write_only(bounds, ncid, flag)
- call subgridRest_write_and_read(bounds, ncid, flag)
end subroutine subgridRestWrite
-
- !------------------------------------------------------------------------
- subroutine subgridRestRead(bounds, ncid)
- !
- ! !DESCRIPTION:
- ! Handle restart reads of subgrid variables
- !
- ! !ARGUMENTS:
- type(bounds_type), intent(in) :: bounds ! bounds
- type(file_desc_t), intent(inout) :: ncid ! netCDF dataset id
- !
- ! !LOCAL VARIABLES:
- character(len=32) :: subname='subgridRestRead' ! subroutine name
- !------------------------------------------------------------------------
-
- call subgridRest_write_and_read(bounds, ncid, 'read')
-
- end subroutine subgridRestRead
-
!-----------------------------------------------------------------------
subroutine subgridRest_write_only(bounds, ncid, flag)
!
@@ -109,13 +77,7 @@ subroutine subgridRest_write_only(bounds, ncid, flag)
integer :: g,l,c,p,i ! indices
logical :: readvar ! temporary
real(r8), pointer :: rgarr(:) ! temporary
- real(r8), pointer :: rlarr(:) ! temporary
- real(r8), pointer :: rcarr(:) ! temporary
- real(r8), pointer :: rparr(:) ! temporary
integer , pointer :: igarr(:) ! temporary
- integer , pointer :: ilarr(:) ! temporary
- integer , pointer :: icarr(:) ! temporary
- integer , pointer :: iparr(:) ! temporary
real(r8), pointer :: temp2d_r(:,:) ! temporary for multi-level variables
integer , pointer :: temp2d_i(:,:) ! temporary for multi-level variables
@@ -157,559 +119,6 @@ subroutine subgridRest_write_only(bounds, ncid, flag)
deallocate(rgarr,igarr)
- !------------------------------------------------------------------
- ! Write landunit info
- !------------------------------------------------------------------
-
- allocate(rlarr(bounds%begl:bounds%endl), ilarr(bounds%begl:bounds%endl))
-
- do l=bounds%begl,bounds%endl
- rlarr(l) = grc%londeg(lun%gridcell(l))
- enddo
-
- call restartvar(ncid=ncid, flag=flag, varname='land1d_lon', xtype=ncd_double, &
- dim1name='landunit', &
- long_name='landunit longitude', units='degrees_east', &
- interpinic_flag='skip', readvar=readvar, data=rlarr)
-
- do l=bounds%begl,bounds%endl
- rlarr(l) = grc%latdeg(lun%gridcell(l))
- enddo
- call restartvar(ncid=ncid, flag=flag, varname='land1d_lat', xtype=ncd_double, &
- dim1name='landunit', &
- long_name='landunit latitude', units='degrees_north', &
- interpinic_flag='skip', readvar=readvar, data=rlarr)
-
- do l=bounds%begl,bounds%endl
- ilarr(l) = mod(ldecomp%gdc2glo(lun%gridcell(l))-1,ldomain%ni) + 1
- enddo
- call restartvar(ncid=ncid, flag=flag, varname='land1d_ixy', xtype=ncd_int, &
- dim1name='landunit', &
- long_name='2d longitude index of corresponding landunit', &
- interpinic_flag='skip', readvar=readvar, data=ilarr)
-
- do l=bounds%begl,bounds%endl
- ilarr(l) = (ldecomp%gdc2glo(lun%gridcell(l))-1)/ldomain%ni + 1
- end do
- call restartvar(ncid=ncid, flag=flag, varname='land1d_jxy', xtype=ncd_int, &
- dim1name='landunit', &
- long_name='2d latitude index of corresponding landunit', &
- interpinic_flag='skip', readvar=readvar, data=ilarr)
-
- do l=bounds%begl,bounds%endl
- ilarr(l) = GetGlobalIndex(decomp_index=lun%gridcell(l), clmlevel=nameg)
- end do
- call restartvar(ncid=ncid, flag=flag, varname='land1d_gridcell_index', xtype=ncd_int, &
- dim1name='landunit', &
- long_name='gridcell index of corresponding landunit', &
- interpinic_flag='skip', readvar=readvar, data=ilarr)
-
- call restartvar(ncid=ncid, flag=flag, varname='land1d_ityplun', xtype=ncd_int, &
- dim1name='landunit', &
- long_name='landunit type (see global attributes)', units=' ', &
- interpinic_flag='skip', readvar=readvar, data=lun%itype)
-
- do l=bounds%begl,bounds%endl
- if (lun%active(l)) then
- ilarr(l) = 1
- else
- ilarr(l) = 0
- end if
- enddo
- call restartvar(ncid=ncid, flag=flag, varname='land1d_active', xtype=ncd_int, &
- dim1name='landunit', &
- long_name='landunit active flag (1=active, 0=inactive)', &
- interpinic_flag='skip', readvar=readvar, data=ilarr)
-
- deallocate(rlarr, ilarr)
-
- !------------------------------------------------------------------
- ! Write column info
- !------------------------------------------------------------------
-
- allocate(rcarr(bounds%begc:bounds%endc), icarr(bounds%begc:bounds%endc))
-
- do c= bounds%begc, bounds%endc
- rcarr(c) = grc%londeg(col%gridcell(c))
- enddo
- call restartvar(ncid=ncid, flag=flag, varname='cols1d_lon', xtype=ncd_double, &
- dim1name='column', &
- long_name='column longitude', units='degrees_east', &
- interpinic_flag='skip', readvar=readvar, data=rcarr)
-
- do c= bounds%begc, bounds%endc
- rcarr(c) = grc%latdeg(col%gridcell(c))
- enddo
- call restartvar(ncid=ncid, flag=flag, varname='cols1d_lat', xtype=ncd_double, &
- dim1name='column', &
- long_name='column latitude', units='degrees_north', &
- interpinic_flag='skip', readvar=readvar, data=rcarr)
-
- do c= bounds%begc, bounds%endc
- icarr(c) = mod(ldecomp%gdc2glo(col%gridcell(c))-1,ldomain%ni) + 1
- enddo
- call restartvar(ncid=ncid, flag=flag, varname='cols1d_ixy', xtype=ncd_int, &
- dim1name='column', &
- long_name='2d longitude index of corresponding column', units=' ', &
- interpinic_flag='skip', readvar=readvar, data=icarr)
-
- do c= bounds%begc, bounds%endc
- icarr(c) = (ldecomp%gdc2glo(col%gridcell(c))-1)/ldomain%ni + 1
- enddo
- call restartvar(ncid=ncid, flag=flag, varname='cols1d_jxy', xtype=ncd_int, &
- dim1name='column', &
- long_name='2d latitude index of corresponding column', units=' ', &
- interpinic_flag='skip', readvar=readvar, data=icarr)
-
- do c= bounds%begc, bounds%endc
- icarr(c) = GetGlobalIndex(decomp_index=col%gridcell(c), clmlevel=nameg)
- end do
- call restartvar(ncid=ncid, flag=flag, varname='cols1d_gridcell_index', xtype=ncd_int, &
- dim1name='column', &
- long_name='gridcell index of corresponding column', &
- interpinic_flag='skip', readvar=readvar, data=icarr)
-
- do c= bounds%begc, bounds%endc
- icarr(c) = GetGlobalIndex(decomp_index=col%landunit(c), clmlevel=namel)
- end do
- call restartvar(ncid=ncid, flag=flag, varname='cols1d_landunit_index', xtype=ncd_int, &
- dim1name='column', &
- long_name='landunit index of corresponding column', &
- interpinic_flag='skip', readvar=readvar, data=icarr)
-
- do c= bounds%begc, bounds%endc
- icarr(c) = lun%itype(col%landunit(c))
- enddo
- call restartvar(ncid=ncid, flag=flag, varname='cols1d_ityplun', xtype=ncd_int, &
- dim1name='column', &
- long_name='column landunit type (see global attributes)', units=' ', &
- interpinic_flag='skip', readvar=readvar, data=icarr)
-
- call restartvar(ncid=ncid, flag=flag, varname='cols1d_ityp', xtype=ncd_int, &
- dim1name='column', &
- long_name='column type (see global attributes)', units=' ', &
- interpinic_flag='skip', readvar=readvar, data=col%itype)
-
- do c=bounds%begc,bounds%endc
- if (col%active(c)) then
- icarr(c) = 1
- else
- icarr(c) = 0
- end if
- end do
- call restartvar(ncid=ncid, flag=flag, varname='cols1d_active', xtype=ncd_int, &
- dim1name='column', &
- long_name='column active flag (1=active, 0=inactive)', units=' ', &
- interpinic_flag='skip', readvar=readvar, data=icarr)
-
- call restartvar(ncid=ncid, flag=flag, varname='LEVGRND_CLASS', xtype=ncd_int, &
- dim1name='column', dim2name='levgrnd', switchdim=.true., &
- long_name='class in which each layer falls', units=' ', &
- interpinic_flag='skip', readvar=readvar, data=col%levgrnd_class)
-
- allocate(temp2d_r(bounds%begc:bounds%endc, 1:nlevgrnd))
- temp2d_r(bounds%begc:bounds%endc, 1:nlevgrnd) = col%z(bounds%begc:bounds%endc, 1:nlevgrnd)
- call restartvar(ncid=ncid, flag=flag, varname='COL_Z', xtype=ncd_double, &
- dim1name='column', dim2name='levgrnd', switchdim=.true., &
- long_name='layer depth, excluding snow layers', units='m', &
- interpinic_flag='skip', readvar=readvar, data=temp2d_r)
- deallocate(temp2d_r)
-
- deallocate(rcarr, icarr)
-
- !------------------------------------------------------------------
- ! Write patch info
- !------------------------------------------------------------------
-
- allocate(rparr(bounds%begp:bounds%endp), iparr(bounds%begp:bounds%endp))
-
- do p=bounds%begp,bounds%endp
- rparr(p) = grc%londeg(patch%gridcell(p))
- enddo
- call restartvar(ncid=ncid, flag=flag, varname='pfts1d_lon', xtype=ncd_double, &
- dim1name='pft', &
- long_name='pft longitude', units='degrees_east', &
- interpinic_flag='skip', readvar=readvar, data=rparr)
-
- do p=bounds%begp,bounds%endp
- rparr(p) = grc%latdeg(patch%gridcell(p))
- enddo
- call restartvar(ncid=ncid, flag=flag, varname='pfts1d_lat', xtype=ncd_double, &
- dim1name='pft', &
- long_name='pft latitude', units='degrees_north', &
- interpinic_flag='skip', readvar=readvar, data=rparr)
-
- do p=bounds%begp,bounds%endp
- iparr(p) = mod(ldecomp%gdc2glo(patch%gridcell(p))-1,ldomain%ni) + 1
- enddo
- call restartvar(ncid=ncid, flag=flag, varname='pfts1d_ixy', xtype=ncd_int, &
- dim1name='pft', &
- long_name='2d longitude index of corresponding pft', units='', &
- interpinic_flag='skip', readvar=readvar, data=iparr)
-
- do p=bounds%begp,bounds%endp
- iparr(p) = (ldecomp%gdc2glo(patch%gridcell(p))-1)/ldomain%ni + 1
- enddo
- call restartvar(ncid=ncid, flag=flag, varname='pfts1d_jxy', xtype=ncd_int, &
- dim1name='pft', &
- long_name='2d latitude index of corresponding pft', units='', &
- interpinic_flag='skip', readvar=readvar, data=iparr)
-
- do p=bounds%begp,bounds%endp
- iparr(p) = GetGlobalIndex(decomp_index=patch%gridcell(p), clmlevel=nameg)
- enddo
- call restartvar(ncid=ncid, flag=flag, varname='pfts1d_gridcell_index', xtype=ncd_int, &
- dim1name='pft', &
- long_name='gridcell index of corresponding pft', &
- interpinic_flag='skip', readvar=readvar, data=iparr)
-
- do p=bounds%begp,bounds%endp
- iparr(p) = GetGlobalIndex(decomp_index=patch%landunit(p), clmlevel=namel)
- enddo
- call restartvar(ncid=ncid, flag=flag, varname='pfts1d_landunit_index', xtype=ncd_int, &
- dim1name='pft', &
- long_name='landunit index of corresponding pft', &
- interpinic_flag='skip', readvar=readvar, data=iparr)
-
- do p=bounds%begp,bounds%endp
- iparr(p) = GetGlobalIndex(decomp_index=patch%column(p), clmlevel=namec)
- enddo
- call restartvar(ncid=ncid, flag=flag, varname='pfts1d_column_index', xtype=ncd_int, &
- dim1name='pft', &
- long_name='column index of corresponding pft', &
- interpinic_flag='skip', readvar=readvar, data=iparr)
-
- call restartvar(ncid=ncid, flag=flag, varname='pfts1d_itypveg', xtype=ncd_int, &
- dim1name='pft', &
- long_name='pft vegetation type', units='', &
- interpinic_flag='skip', readvar=readvar, data=patch%itype)
-
- do p=bounds%begp,bounds%endp
- iparr(p) = col%itype(patch%column(p))
- enddo
- call restartvar(ncid=ncid, flag=flag, varname='pfts1d_itypcol', xtype=ncd_int, &
- dim1name='pft', &
- long_name='pft column type (see global attributes)', units='', &
- interpinic_flag='skip', readvar=readvar, data=iparr)
-
- do p=bounds%begp,bounds%endp
- iparr(p) = lun%itype(patch%landunit(p))
- enddo
- call restartvar(ncid=ncid, flag=flag, varname='pfts1d_ityplun', xtype=ncd_int, &
- dim1name='pft', &
- long_name='pft landunit type (see global attributes)', units='', &
- interpinic_flag='skip', readvar=readvar, data=iparr)
-
- do p=bounds%begp,bounds%endp
- if (patch%active(p)) then
- iparr(p) = 1
- else
- iparr(p) = 0
- end if
- enddo
- call restartvar(ncid=ncid, flag=flag, varname='pfts1d_active', xtype=ncd_int, &
- dim1name='pft', &
- long_name='pft active flag (1=active, 0=inactive)', units='', &
- interpinic_flag='skip', readvar=readvar, data=iparr)
-
- allocate(temp2d_i(bounds%begp:bounds%endp, 1:nlevgrnd))
- do p=bounds%begp,bounds%endp
- c = patch%column(p)
- temp2d_i(p, 1:nlevgrnd) = col%levgrnd_class(c, 1:nlevgrnd)
- end do
- call restartvar(ncid=ncid, flag=flag, varname='LEVGRND_CLASS_p', xtype=ncd_int, &
- dim1name='pft', dim2name='levgrnd', switchdim=.true., &
- long_name='class in which each layer falls, patch-level', units=' ', &
- interpinic_flag='skip', readvar=readvar, data=temp2d_i)
- deallocate(temp2d_i)
-
- allocate(temp2d_r(bounds%begp:bounds%endp, 1:nlevgrnd))
- do p=bounds%begp,bounds%endp
- c = patch%column(p)
- temp2d_r(p, 1:nlevgrnd) = col%z(c, 1:nlevgrnd)
- end do
- call restartvar(ncid=ncid, flag=flag, varname='COL_Z_p', xtype=ncd_double, &
- dim1name='pft', dim2name='levgrnd', switchdim=.true., &
- long_name='layer depth, excluding snow layers, patch-level', units='m', &
- interpinic_flag='skip', readvar=readvar, data=temp2d_r)
- deallocate(temp2d_r)
-
- deallocate(rparr, iparr)
-
end subroutine subgridRest_write_only
- !-----------------------------------------------------------------------
- subroutine subgridRest_write_and_read(bounds, ncid, flag)
- !
- ! !DESCRIPTION:
- !
- !
- ! !USES:
- !
- ! !ARGUMENTS:
- type(bounds_type), intent(in) :: bounds ! bounds
- type(file_desc_t), intent(inout) :: ncid ! netCDF dataset id
- character(len=*) , intent(in) :: flag ! flag to determine if define, write or read data
- !
- ! !LOCAL VARIABLES:
- logical :: readvar ! temporary
- real(r8), pointer :: temp2d(:,:) ! temporary for sno column variables
-
- character(len=*), parameter :: subname = 'subgridRest_write_and_read'
- !-----------------------------------------------------------------------
-
- if (flag == 'read') then
- call save_old_weights(bounds)
- end if
-
- call restartvar(ncid=ncid, flag=flag, varname='land1d_wtxy', xtype=ncd_double, &
- dim1name='landunit', &
- long_name='landunit weight relative to corresponding gridcell', &
- interpinic_flag='skip', readvar=readvar, data=lun%wtgcell)
-
- call restartvar(ncid=ncid, flag=flag, varname='cols1d_wtxy', xtype=ncd_double, &
- dim1name='column', &
- long_name='column weight relative to corresponding gridcell', units=' ', &
- interpinic_flag='skip', readvar=readvar, data=col%wtgcell)
-
- call restartvar(ncid=ncid, flag=flag, varname='cols1d_wtlnd', xtype=ncd_double, &
- dim1name='column', &
- long_name='column weight relative to corresponding landunit', units=' ', &
- interpinic_flag='skip', readvar=readvar, data=col%wtlunit)
-
- call restartvar(ncid=ncid, flag=flag, varname='pfts1d_wtxy', xtype=ncd_double, &
- dim1name='pft', &
- long_name='pft weight relative to corresponding gridcell', units='', &
- interpinic_flag='skip', readvar=readvar, data=patch%wtgcell)
-
- call restartvar(ncid=ncid, flag=flag, varname='pfts1d_wtlnd', xtype=ncd_double, &
- dim1name='pft', &
- long_name='pft weight relative to corresponding landunit', units='', &
- interpinic_flag='skip', readvar=readvar, data=patch%wtlunit)
-
- call restartvar(ncid=ncid, flag=flag, varname='pfts1d_wtcol', xtype=ncd_double, &
- dim1name='pft', &
- long_name='pft weight relative to corresponding column', units='', &
- interpinic_flag='skip', readvar=readvar, data=patch%wtcol)
-
- ! Snow column variables
-
- call restartvar(ncid=ncid, flag=flag, varname='SNLSNO', xtype=ncd_int, &
- dim1name='column', &
- long_name='negative number of snow layers', units='unitless', &
- interpinic_flag='interp', readvar=readvar, data=col%snl)
-
- allocate(temp2d(bounds%begc:bounds%endc,-nlevsno+1:0))
- if (flag == 'write') then
- temp2d(bounds%begc:bounds%endc,-nlevsno+1:0) = col%dz(bounds%begc:bounds%endc,-nlevsno+1:0)
- end if
- call restartvar(ncid=ncid, flag=flag, varname='DZSNO', xtype=ncd_double, &
- dim1name='column', dim2name='levsno', switchdim=.true., lowerb2=-nlevsno+1, upperb2=0, &
- long_name='snow layer thickness', units='m', &
- interpinic_flag='interp', readvar=readvar, data=temp2d)
- if (flag == 'read') then
- col%dz(bounds%begc:bounds%endc,-nlevsno+1:0) = temp2d(bounds%begc:bounds%endc,-nlevsno+1:0)
- end if
- deallocate(temp2d)
-
- allocate(temp2d(bounds%begc:bounds%endc,-nlevsno+1:0))
- if (flag == 'write') then
- temp2d(bounds%begc:bounds%endc,-nlevsno+1:0) = col%z(bounds%begc:bounds%endc,-nlevsno+1:0)
- end if
- call restartvar(ncid=ncid, flag=flag, varname='ZSNO', xtype=ncd_double, &
- dim1name='column', dim2name='levsno', switchdim=.true., lowerb2=-nlevsno+1, upperb2=0, &
- long_name='snow layer depth', units='m', &
- interpinic_flag='interp', readvar=readvar, data=temp2d)
- if (flag == 'read') then
- col%z(bounds%begc:bounds%endc,-nlevsno+1:0) = temp2d(bounds%begc:bounds%endc,-nlevsno+1:0)
- end if
- deallocate(temp2d)
-
- allocate(temp2d(bounds%begc:bounds%endc,-nlevsno:-1))
- if (flag == 'write') then
- temp2d(bounds%begc:bounds%endc,-nlevsno:-1) = col%zi(bounds%begc:bounds%endc,-nlevsno:-1)
- end if
- call restartvar(ncid=ncid, flag=flag, varname='ZISNO', xtype=ncd_double, &
- dim1name='column', dim2name='levsno', switchdim=.true., lowerb2=-nlevsno, upperb2=-1, &
- long_name='snow interface depth', units='m', &
- interpinic_flag='interp', readvar=readvar, data=temp2d)
- if (flag == 'read') then
- col%zi(bounds%begc:bounds%endc,-nlevsno:-1) = temp2d(bounds%begc:bounds%endc,-nlevsno:-1)
- end if
- deallocate(temp2d)
-
- end subroutine subgridRest_write_and_read
-
- !-----------------------------------------------------------------------
- subroutine save_old_weights(bounds)
- !
- ! !DESCRIPTION:
- ! Save old weights, from before the restart read, for later consistency checks.
- !
- ! !USES:
- type(bounds_type), intent(in) :: bounds ! bounds (expected to be proc-level)
- !
- ! !ARGUMENTS:
- !
- ! !LOCAL VARIABLES:
-
- character(len=*), parameter :: subname = 'save_old_weights'
- !-----------------------------------------------------------------------
-
- SHR_ASSERT(bounds%level == BOUNDS_LEVEL_PROC, subname//' ERROR: expect proc-level bounds')
-
- allocate(pft_wtlunit_before_rest_read(bounds%begp:bounds%endp))
- pft_wtlunit_before_rest_read(bounds%begp:bounds%endp) = patch%wtlunit(bounds%begp:bounds%endp)
-
- end subroutine save_old_weights
-
-
- !-----------------------------------------------------------------------
- subroutine subgridRest_check_consistency(bounds)
- !
- ! !DESCRIPTION:
- ! Check consistency of variables read by subgridRest.
- !
- ! This should be called AFTER subgridRest is called to read the restart file.
- !
- ! !USES:
- !
- ! !ARGUMENTS:
- type(bounds_type), intent(in) :: bounds ! bounds
- !
- ! !LOCAL VARIABLES:
-
- character(len=*), parameter :: subname = 'subgridRest_check_consistency'
- !-----------------------------------------------------------------------
-
- if (do_check_weights()) then
- call check_weights(bounds)
- end if
-
- contains
-
- !-----------------------------------------------------------------------
- logical function do_check_weights()
- !
- ! !DESCRIPTION:
- ! Return true if we should check weights
- !
- ! !USES:
- use clm_varctl, only : nsrest, nsrContinue, use_cndv, use_fates
- !
- ! !ARGUMENTS:
- !
- ! !LOCAL VARIABLES:
-
- character(len=*), parameter :: subname = 'do_check_weights'
- !-----------------------------------------------------------------------
-
- if (nsrest == nsrContinue) then
- ! Don't check weights for a restart run
- !
- ! WJS (3-25-14): I'm not sure why we don't do the check in this case, but I'm
- ! maintaining the logic that used to be in BiogeophysRestMod regarding these
- ! weight checks
- do_check_weights = .false.
- else if (use_cndv) then
- ! Don't check weights for a cndv case, because the weights will almost certainly
- ! differ from the surface dataset in this case
- do_check_weights = .false.
- else if (use_fates) then
- ! Don't check weights for a fates case, because the weights will almost certainly
- ! differ from the surface dataset in this case
- do_check_weights = .false.
- else
- do_check_weights = .true.
- end if
-
- end function do_check_weights
-
- !-----------------------------------------------------------------------
- subroutine check_weights(bounds)
- !
- ! !DESCRIPTION:
- ! Make sure that patch weights on the landunit agree with the weights read from the
- ! surface dataset, for the natural veg landunit.
- !
- ! Note that we do NOT do a more general check of all subgrid weights, because it's
- ! possible that some other subgrid weights have changed relative to the surface
- ! dataset, e.g., due to dynamic landunits. It would probably be possible to do more
- ! checking than is done here, but the check here should be sufficient to catch major
- ! inconsistencies between the restart file and the surface dataset.
- !
- ! !USES:
- use landunit_varcon, only : istsoil
- use clm_varctl, only : iulog
- !
- ! !ARGUMENTS:
- type(bounds_type), intent(in) :: bounds ! bounds
- !
- ! !LOCAL VARIABLES:
- integer :: p, l ! indices
- real(r8) :: diff ! difference in weights
-
- real(r8), parameter :: tol = 5.e-3 ! tolerance for checking weights
-
- character(len=*), parameter :: subname = 'check_weights'
- !-----------------------------------------------------------------------
-
- do p = bounds%begp, bounds%endp
- l = patch%landunit(p)
- if (lun%itype(l) == istsoil) then
- diff = abs(patch%wtlunit(p) - pft_wtlunit_before_rest_read(p))
- if (diff > tol .and. patch%wtgcell(p) > 1.0e-16_r8) then
- write(iulog,*) 'ERROR: PATCH weights are SIGNIFICANTLY different between :'
- write(iulog,*) 'the restart (finidat) file : ', patch%wtlunit(p)
- write(iulog,*) 'and the surface dataset (fsurdat): ', pft_wtlunit_before_rest_read(p)
- write(iulog,*) 'weight gridcell: ', patch%wtgcell(p)
- write(iulog,*)
- write(iulog,*) 'Maximum allowed difference: ', tol
- write(iulog,*) 'Difference found: ', diff
- write(iulog,*) 'This match is a requirement for non-transient runs'
- write(iulog,*)
- write(iulog,*) 'Possible solutions to this problem:'
- write(iulog,*) '(1) Make sure you are using the intended finidat and fsurdat files'
- write(iulog,*) '(2) If you are running a present-day simulation, then make sure that your'
- write(iulog,*) ' initial conditions file is from the END of a 20th century transient run'
- write(iulog,*) '(3) If you are confident that you are using the correct finidat and fsurdat files,'
- write(iulog,*) ' yet are still experiencing this error, then you can bypass this check by setting:'
- write(iulog,*) ' check_finidat_pct_consistency = .false.'
- write(iulog,*) ' in user_nl_clm'
- write(iulog,*) ' In this case, CLM will take the weights from the initial conditions file.'
- write(iulog,*) ' '
- call endrun(decomp_index=p, clmlevel=namep, msg=errMsg(sourcefile, __LINE__))
- end if
- end if
- end do
-
- end subroutine check_weights
-
- end subroutine subgridRest_check_consistency
-
-
- !-----------------------------------------------------------------------
- subroutine subgridRest_read_cleanup
- !
- ! !DESCRIPTION:
- ! Do cleanup of variables allocated when reading the restart file
- !
- ! Should be called after subgridRest and subgridRest_check_consistency are complete.
- ! Note that this must be called after subgridRest is called to read the restart file,
- ! in order to avoid a memory leak.
- !
- ! !USES:
- !
- ! !ARGUMENTS:
- !
- ! !LOCAL VARIABLES:
-
- character(len=*), parameter :: subname = 'subgridRest_read_cleanup'
- !-----------------------------------------------------------------------
-
- deallocate(pft_wtlunit_before_rest_read)
-
- end subroutine subgridRest_read_cleanup
-
-
end module subgridRestMod
diff --git a/src/main/subgridWeightsMod.F90 b/src/main/subgridWeightsMod.F90
deleted file mode 100644
index d496c620..00000000
--- a/src/main/subgridWeightsMod.F90
+++ /dev/null
@@ -1,859 +0,0 @@
-module subgridWeightsMod
-
-#include "shr_assert.h"
-
- !-----------------------------------------------------------------------
- ! !DESCRIPTION:
- ! Handles modifications, error-checks and diagnostics related to changing subgrid weights
- !
- ! ----- Requirements for subgrid weights that are enforced here -----
- !
- ! (These requirements are checked in check_weights/weights_okay)
- !
- ! Note: in the following, 'active' refers to a pft, column, landunit or grid cell over
- ! which computations are performed, and 'inactive' refers to a pft, column or landunit
- ! where computations are NOT performed (grid cells are always active).
- !
- ! (1) For all columns, landunits and grid cells, the sum of all subgrid weights of its
- ! children (or grandchildren, etc.) is equal to 1. For example:
- ! - For all columns, the sum of all patch weights on the column equals 1
- ! - For all landunits, the sum of all col weights on the landunit equals 1
- ! - For all grid cells, the sum of all patch weights on the grid cell equals 1
- ! - etc.
- !
- ! (2) For all ACTIVE columns, landunits and grid cells, the sum of all subgrid weights of
- ! its ACTIVE children (or grandchildren, etc.) is equal to 1. For example:
- ! - For all active columns, the sum of all patch weights on the column equals 1 when
- ! just considering active pfts
- ! - For all active landunits, the sum of all col weights on the landunit equals 1 when
- ! just considering active cols
- ! - For ALL grid cells, the sum of all patch weights on the grid cell equals 1 when
- ! just considering active pfts -- note that all grid cells are considered active!
- ! - etc.
- !
- ! (3) For all INACTIVE columns, landunits and grid cells, the sum of all subgrid weights of
- ! its ACTIVE children, grandchildren, etc. are equal to either 0 or 1. For example:
- ! - For all inactive columns, the sum of all patch weights on the column equals either 0
- ! or 1 when just considering active pfts
- ! - For all inactive landunits, the sum of all col weights on the landunit equals
- ! either 0 or 1 when just considering active cols
- ! - etc.
- !
- ! Another way of stating (2) and (3) is that the sum of weights of all ACTIVE pfts, cols
- ! or landunits on their parent/grandparent/etc. is always equal to either 0 or 1 -- and
- ! must be equal to 1 if this parent/grandparent, etc. is itself active.
- !
- ! Note that, together, conditions (1) and (2) imply that any pft, col or landunit whose
- ! weight on the grid cell is non-zero must be active. In addition, these conditions imply
- ! that any patch whose weight on the column is non-zero must be active if the column is
- ! active (and similarly for any patch on an active landunit, and any col on an active
- ! landunit).
- !
- !
- ! ----- Implications of these requirements for computing subgrid averages -----
- !
- ! The preferred way to average from, say, patch to col is:
- ! colval(c) = 0
- ! do p = pfti(c), pftf(c)
- ! if (active(p)) colval(c) = colval(c) + pftval(p) * wtcol(p)
- ! (where wtcol(p) is the weight of the patch on the column)
- ! If column c is active, then the above conditions guarantee that the pwtcol values
- ! included in the above sum will sum to 1. If column c is inactive, then the above
- ! conditions guarantee that the pwtcol values included in the above sum will sum to
- ! either 1 or 0; if they sum to 0, then colval(c) will remain 0.
- !
- ! Another acceptable method is the following; this method accommodates some unknown
- ! fraction of pftval's being set to spval, and leaves colval set at spval if there are no
- ! valid patch values:
- ! colval(c) = spval
- ! sumwt(c) = 0
- ! do p = pfti(c), pftf(c)
- ! if (active(p) .and. wtcol(p) /= 0) then
- ! if (pftval(p) /= spval) then
- ! if (sumwt(c) == 0) colval(c) = 0
- ! colval(c) = colval(c) + pftval(p) * wtcol(p)
- ! sumwt(c) = sumwt(c) + wtcol(p)
- ! end if
- ! end if
- ! end do
- ! if (sumwt(c) /= 0) then
- ! colval(c) = colval(c) / sumwt(c)
- ! end if
- ! Note that here we check the condition (active(p) .and. wtcol(p) /= 0). We need to
- ! include a check for wtcol(p) /= 0 because we don't want to set colval(c) = 0 for zero-
- ! weight pfts in this line:
- ! if (sumwt(c) == 0) colval(c) = 0
- ! And we include a check for active(p) because we don't want to assume that pftval(p) has
- ! been set to spval for inactive pfts -- we want to allow for the possibility that
- ! pftval(p) will be NaN for inactive pfts.
- !
- !
- ! !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, all_active, use_fates
- use clm_varcon , only : nameg, namel, namec, namep
- use decompMod , only : bounds_type
- use GridcellType , only : grc
- use LandunitType , only : lun
- use ColumnType , only : col
- use PatchType , only : patch
- use glcBehaviorMod , only : glc_behavior_type
- !
- ! PUBLIC TYPES:
- implicit none
- save
-
- private
- !
- ! !PUBLIC MEMBER FUNCTIONS:
- public :: init_subgrid_weights_mod ! initialize stuff in this module
- public :: compute_higher_order_weights ! given p2c, c2l and l2g weights, compute other weights
- public :: set_active ! set 'active' flags at pft, column & landunit level
- public :: check_weights ! check subgrid weights
- public :: get_landunit_weight ! get the weight of a given landunit on a single grid cell
- public :: set_landunit_weight ! set the weight of a given landunit on a single grid cell
- public :: is_gcell_all_ltypeX ! determine whether a grid cell is 100% covered by the given landunit type
- public :: set_subgrid_diagnostic_fields ! set all subgrid weights diagnostic fields
- !
- ! !REVISION HISTORY:
- ! Created by Bill Sacks
- !
- ! !PRIVATE TYPES:
- type subgrid_weights_diagnostics_type
- ! This type contains diagnostics on subgrid weights, for output to the history file
- real(r8), pointer :: pct_landunit(:,:) ! % of each landunit on the grid cell [begg:endg, 1:max_lunit]
- real(r8), pointer :: pct_nat_pft(:,:) ! % of each pft, as % of landunit [begg:endg, natpft_lb:natpft_ub]
- real(r8), pointer :: pct_cft(:,:) ! % of each crop functional type, as % of landunit [begg:endg, cft_lb:cft_ub]
- real(r8), pointer :: pct_glc_mec(:,:) ! % of each glacier elevation class, as % of landunit [begg:endg, 1:maxpatch_glcmec]
- end type subgrid_weights_diagnostics_type
-
- type(subgrid_weights_diagnostics_type) :: subgrid_weights_diagnostics
-
- !
- ! !PRIVATE MEMBER FUNCTIONS:
- private :: is_active_l ! determine whether the given landunit is active
- private :: is_active_c ! determine whether the given column is active
- private :: is_active_p ! determine whether the given patch is active
- private :: weights_okay ! determine if sum of weights satisfies requirements laid out above
- private :: set_pct_landunit_diagnostics ! set pct_landunit diagnostic field
- private :: set_pct_glc_mec_diagnostics ! set pct_glc_mec diagnostic field
- private :: set_pct_pft_diagnostics ! set pct_nat_pft & pct_cft diagnostic fields
-
- character(len=*), parameter, private :: sourcefile = &
- __FILE__
- !-----------------------------------------------------------------------
-
-contains
-
- !-----------------------------------------------------------------------
- subroutine init_subgrid_weights_mod(bounds)
- !
- ! !DESCRIPTION:
- ! Initialize stuff in this module
- !
- ! !USES:
- use landunit_varcon, only : max_lunit
- use clm_varpar , only : maxpatch_glcmec, natpft_size, cft_size
- use shr_infnan_mod , only : nan => shr_infnan_nan, assignment(=)
- use decompMod , only : BOUNDS_LEVEL_PROC
- use histFileMod , only : hist_addfld2d
- !
- ! !ARGUMENTS:
- type(bounds_type), intent(in) :: bounds ! proc bounds
- !
- ! !LOCAL VARIABLES:
-
- character(len=*), parameter :: subname = 'init_subgrid_weights_mod'
- !-----------------------------------------------------------------------
-
- SHR_ASSERT(bounds%level == BOUNDS_LEVEL_PROC, errMsg(sourcefile, __LINE__))
-
- ! ------------------------------------------------------------------------
- ! Allocate variables in subgrid_weights_diagnostics
- ! ------------------------------------------------------------------------
-
- ! Note that, because these variables are output to the history file, it appears that
- ! their lower bounds need to start at 1 (e.g., 1:natpft_size rather than
- ! natpft_lb:natpft_ub)
- allocate(subgrid_weights_diagnostics%pct_landunit(bounds%begg:bounds%endg, 1:max_lunit))
- subgrid_weights_diagnostics%pct_landunit(:,:) = nan
- allocate(subgrid_weights_diagnostics%pct_nat_pft(bounds%begg:bounds%endg, 1:natpft_size))
- subgrid_weights_diagnostics%pct_nat_pft(:,:) = nan
- allocate(subgrid_weights_diagnostics%pct_cft(bounds%begg:bounds%endg, 1:cft_size))
- subgrid_weights_diagnostics%pct_cft(:,:) = nan
- allocate(subgrid_weights_diagnostics%pct_glc_mec(bounds%begg:bounds%endg, 1:maxpatch_glcmec))
- subgrid_weights_diagnostics%pct_glc_mec(:,:) = nan
-
- ! ------------------------------------------------------------------------
- ! Add history fields
- ! ------------------------------------------------------------------------
-
- call hist_addfld2d (fname='PCT_LANDUNIT', units='%', type2d='ltype', &
- avgflag='A', long_name='% of each landunit on grid cell', &
- ptr_lnd=subgrid_weights_diagnostics%pct_landunit, default='inactive')
-
- if(.not.use_fates) then
- call hist_addfld2d (fname='PCT_NAT_PFT', units='%', type2d='natpft', &
- avgflag='A', long_name='% of each PFT on the natural vegetation (i.e., soil) landunit', &
- ptr_lnd=subgrid_weights_diagnostics%pct_nat_pft, default='inactive')
- end if
-
- if (cft_size > 0) then
- call hist_addfld2d (fname='PCT_CFT', units='%', type2d='cft', &
- avgflag='A', long_name='% of each crop on the crop landunit', &
- ptr_lnd=subgrid_weights_diagnostics%pct_cft, default='inactive')
- end if
-
- call hist_addfld2d (fname='PCT_GLC_MEC', units='%', type2d='glc_nec', &
- avgflag='A', long_name='% of each GLC elevation class on the glc_mec landunit', &
- ptr_lnd=subgrid_weights_diagnostics%pct_glc_mec, default='inactive')
-
- end subroutine init_subgrid_weights_mod
-
-
- !-----------------------------------------------------------------------
- subroutine compute_higher_order_weights(bounds)
- !
- ! !DESCRIPTION:
- ! Assuming patch%wtcol, col%wtlunit and lun%wtgcell have already been computed, compute
- ! the "higher-order" weights: patch%wtlunit, patch%wtgcell and col%wtgcell, for all p and c
- !
- ! !USES:
- !
- ! !ARGUMENTS:
- implicit none
- type(bounds_type), intent(in) :: bounds ! clump bounds
- !
- ! !LOCAL VARIABLES:
- integer :: p, c, l ! indices for pft, col & landunit
- !------------------------------------------------------------------------
-
- do c = bounds%begc, bounds%endc
- l = col%landunit(c)
- col%wtgcell(c) = col%wtlunit(c) * lun%wtgcell(l)
- end do
-
- do p = bounds%begp, bounds%endp
- c = patch%column(p)
- patch%wtlunit(p) = patch%wtcol(p) * col%wtlunit(c)
- patch%wtgcell(p) = patch%wtcol(p) * col%wtgcell(c)
- end do
- end subroutine compute_higher_order_weights
-
- !-----------------------------------------------------------------------
- subroutine set_active(bounds, glc_behavior)
- !
- ! !DESCRIPTION:
- ! Set 'active' flags at the pft, column and landunit level
- ! (note that grid cells are always active)
- !
- ! This should be called whenever any weights change (e.g., patch weights on the column,
- ! landunit weights on the grid cell, etc.).
- !
- ! Ensures that we don't have any active patch on an inactive column, or an active column on an
- ! inactive landunit (since these conditions could lead to garbage data)
- !
- ! !USES:
- !
- ! !ARGUMENTS:
- implicit none
- type(bounds_type), intent(in) :: bounds ! bounds
- type(glc_behavior_type), intent(in) :: glc_behavior
- !
- ! !LOCAL VARIABLES:
- integer :: l,c,p ! loop counters
-
- character(len=*), parameter :: subname = 'set_active'
- !------------------------------------------------------------------------
-
- do l = bounds%begl,bounds%endl
- lun%active(l) = is_active_l(l, glc_behavior)
- end do
-
- do c = bounds%begc,bounds%endc
- l = col%landunit(c)
- col%active(c) = is_active_c(c, glc_behavior)
- if (col%active(c) .and. .not. lun%active(l)) then
- write(iulog,*) trim(subname),' ERROR: active column found on inactive landunit', &
- 'at c = ', c, ', l = ', l
- call endrun(decomp_index=c, clmlevel=namec, msg=errMsg(sourcefile, __LINE__))
- end if
- end do
-
- do p = bounds%begp,bounds%endp
- c = patch%column(p)
- patch%active(p) = is_active_p(p)
- if (patch%active(p) .and. .not. col%active(c)) then
- write(iulog,*) trim(subname),' ERROR: active patch found on inactive column', &
- 'at p = ', p, ', c = ', c
- call endrun(decomp_index=p, clmlevel=namep, msg=errMsg(sourcefile, __LINE__))
- end if
- end do
-
- end subroutine set_active
-
- !-----------------------------------------------------------------------
- logical function is_active_l(l, glc_behavior)
- !
- ! !DESCRIPTION:
- ! Determine whether the given landunit is active
- !
- ! !USES:
- use landunit_varcon, only : istsoil, istice_mec
- !
- ! !ARGUMENTS:
- implicit none
- integer, intent(in) :: l ! landunit index
- type(glc_behavior_type), intent(in) :: glc_behavior
- !
- ! !LOCAL VARIABLES:
- integer :: g ! grid cell index
- !------------------------------------------------------------------------
-
- if (all_active) then
- is_active_l = .true.
-
- else
- g =lun%gridcell(l)
-
- is_active_l = .false.
-
- ! ------------------------------------------------------------------------
- ! General conditions under which is_active_l NEEDS to be true in order to satisfy
- ! the requirements laid out at the top of this module:
- ! ------------------------------------------------------------------------
- if (lun%wtgcell(l) > 0) is_active_l = .true.
-
- ! ------------------------------------------------------------------------
- ! Conditions under which is_active_p is set to true because we want extra virtual landunits:
- ! ------------------------------------------------------------------------
-
- if (lun%itype(l) == istice_mec .and. &
- glc_behavior%has_virtual_columns_grc(g)) then
- is_active_l = .true.
- end if
-
- ! In general, include a virtual natural vegetation landunit. This aids
- ! initialization of a new landunit; and for runs that are coupled to CISM, this
- ! provides bare land SMB forcing even if there is no vegetated area.
- !
- ! Also (echoing the similar comment in glcBehaviorMod): We need all glacier and
- ! vegetated points to be active in the icemask region for the sake of init_interp -
- ! since we only interpolate onto active points, and we don't know which points will
- ! have non-zero area until after initialization (as long as we can't send
- ! information from glc to clm in initialization). (If we had an inactive vegetated
- ! point in the icemask region, according to the weights on the surface dataset, and
- ! ran init_interp, this point would keep its cold start initialization
- ! values. Then, in the first time step of the run loop, it's possible that this
- ! point would become active because, according to glc, there is actually > 0% bare
- ! ground in that grid cell. We don't do any state / flux adjustments in the first
- ! time step after init_interp due to glacier area changes, so this vegetated column
- ! would remain at its cold start initialization values, which would be a Bad
- ! Thing. Ensuring that all vegetated points within the icemask are active gets
- ! around this problem - as well as having other benefits, as noted above.)
- if (lun%itype(l) == istsoil) then
- is_active_l = .true.
- end if
-
- end if
-
- end function is_active_l
-
- !-----------------------------------------------------------------------
- logical function is_active_c(c, glc_behavior)
- !
- ! !DESCRIPTION:
- ! Determine whether the given column is active
- !
- ! !USES:
- use landunit_varcon, only : istice_mec, isturb_MIN, isturb_MAX
- !
- ! !ARGUMENTS:
- implicit none
- integer, intent(in) :: c ! column index
- type(glc_behavior_type), intent(in) :: glc_behavior
- !
- ! !LOCAL VARIABLES:
- integer :: l ! landunit index
- integer :: g ! grid cell index
- !------------------------------------------------------------------------
-
- if (all_active) then
- is_active_c = .true.
-
- else
- l =col%landunit(c)
- g =col%gridcell(c)
-
- is_active_c = .false.
-
- ! ------------------------------------------------------------------------
- ! General conditions under which is_active_c NEEDS to be true in order to satisfy
- ! the requirements laid out at the top of this module:
- ! ------------------------------------------------------------------------
- if (lun%active(l) .and. col%wtlunit(c) > 0._r8) is_active_c = .true.
-
- ! ------------------------------------------------------------------------
- ! Conditions under which is_active_c is set to true because we want extra virtual columns:
- ! ------------------------------------------------------------------------
-
- if (lun%itype(l) == istice_mec .and. &
- glc_behavior%has_virtual_columns_grc(g)) then
- is_active_c = .true.
- end if
-
- ! We don't really need to run over 0-weight urban columns. But because of some
- ! messiness in the urban code (many loops are over the landunit filter, then drill
- ! down to columns - so we would need to add 'col%active(c)' conditionals in many
- ! places) it keeps the code cleaner to run over 0-weight urban columns. This generally
- ! shouldn't add much computation time, since in most places, all urban columns are
- ! non-zero weight if the landunit is non-zero weight.
- if (lun%active(l) .and. (lun%itype(l) >= isturb_MIN .and. lun%itype(l) <= isturb_MAX)) then
- is_active_c = .true.
- end if
- end if
-
- end function is_active_c
-
- !-----------------------------------------------------------------------
- logical function is_active_p(p)
- !
- ! !DESCRIPTION:
- ! Determine whether the given patch is active
- !
- ! !USES:
- !
- ! !ARGUMENTS:
- implicit none
- integer, intent(in) :: p ! patch index
- !
- ! !LOCAL VARIABLES:
- integer :: c ! column index
- !------------------------------------------------------------------------
-
- if (all_active) then
- is_active_p = .true.
-
- else
- c =patch%column(p)
-
- is_active_p = .false.
-
- ! ------------------------------------------------------------------------
- ! General conditions under which is_active_p NEEDS to be true in order to satisfy
- ! the requirements laid out at the top of this module:
- ! ------------------------------------------------------------------------
- if (col%active(c) .and. patch%wtcol(p) > 0._r8) is_active_p = .true.
-
- end if
-
- end function is_active_p
-
- !-----------------------------------------------------------------------
- function get_landunit_weight(g, ltype) result(weight)
- !
- ! !DESCRIPTION:
- ! Get the subgrid weight of a given landunit type on a single grid cell
- !
- ! !USES:
- use clm_varcon, only : ispval
- !
- ! !ARGUMENTS:
- real(r8) :: weight ! function result
- integer , intent(in) :: g ! grid cell index
- integer , intent(in) :: ltype ! landunit type of interest
- !
- ! !LOCAL VARIABLES:
- integer :: l ! landunit index
-
- character(len=*), parameter :: subname = 'get_landunit_weight'
- !-----------------------------------------------------------------------
-
- l = grc%landunit_indices(ltype, g)
- if (l == ispval) then
- weight = 0._r8
- else
- weight = lun%wtgcell(l)
- end if
-
- end function get_landunit_weight
-
- !-----------------------------------------------------------------------
- subroutine set_landunit_weight(g, ltype, weight)
- !
- ! !DESCRIPTION:
- ! Set the subgrid weight of a given landunit type on a single grid cell
- !
- ! !USES:
- use clm_varcon, only : ispval
- !
- ! !ARGUMENTS:
- integer , intent(in) :: g ! grid cell index
- integer , intent(in) :: ltype ! landunit type of interest
- real(r8), intent(in) :: weight ! new weight of this landunit
- !
- ! !LOCAL VARIABLES:
- integer :: l ! landunit index
-
- character(len=*), parameter :: subname = 'set_landunit_weight'
- !-----------------------------------------------------------------------
-
- l = grc%landunit_indices(ltype, g)
- if (l /= ispval) then
- lun%wtgcell(l) = weight
- else if (weight > 0._r8) then
- write(iulog,*) subname//' ERROR: Attempt to assign non-zero weight to a non-existent landunit'
- write(iulog,*) 'g, l, ltype, weight = ', g, l, ltype, weight
- call endrun(decomp_index=l, clmlevel=namel, msg=errMsg(sourcefile, __LINE__))
- end if
-
- end subroutine set_landunit_weight
-
-
- !-----------------------------------------------------------------------
- function is_gcell_all_ltypeX(g, ltype) result(all_ltypeX)
- !
- ! !DESCRIPTION:
- ! Determine if the given grid cell is 100% covered by the landunit type given by ltype
- !
- ! !USES:
- !
- ! !ARGUMENTS:
- implicit none
- logical :: all_ltypeX ! function result
- integer, intent(in) :: g ! grid cell index
- integer, intent(in) :: ltype ! landunit type of interest
- !
- ! !LOCAL VARIABLES:
- real(r8) :: wt_lunit ! subgrid weight of the given landunit
-
- real(r8), parameter :: tolerance = 1.e-13_r8 ! tolerance for checking whether landunit's weight is 1
- character(len=*), parameter :: subname = 'is_gcell_all_ltypeX'
- !------------------------------------------------------------------------------
-
- wt_lunit = get_landunit_weight(g, ltype)
- if (wt_lunit >= (1._r8 - tolerance)) then
- all_ltypeX = .true.
- else
- all_ltypeX = .false.
- end if
-
- end function is_gcell_all_ltypeX
-
- !------------------------------------------------------------------------------
- subroutine check_weights (bounds, active_only)
- !
- ! !DESCRIPTION:
- ! Check subgrid weights.
- !
- ! This routine operates in two different modes, depending on the value of active_only. If
- ! active_only is true, then we check the sum of weights of the ACTIVE children,
- ! grandchildren, etc. of a given point. If active_only is false, then we check the sum of
- ! weights of ALL children, grandchildren, etc. of a given point.
- !
- ! Normally this routine will be called twice: once with active_only=false, and once with
- ! active_only=true.
- !
- ! !USES
- !
- ! !ARGUMENTS
- implicit none
- type(bounds_type), intent(in) :: bounds ! bounds
- logical, intent(in) :: active_only ! true => check sum of weights just of ACTIVE children, grandchildren, etc.
- !
- ! !LOCAL VARIABLES:
- integer :: g,l,c,p ! loop counters
- real(r8), allocatable :: sumwtcol(:), sumwtlunit(:), sumwtgcell(:)
- logical :: error_found ! true if we find an error
- character(len=*), parameter :: subname = 'check_weights'
- !------------------------------------------------------------------------------
-
- allocate(sumwtcol(bounds%begc:bounds%endc))
- allocate(sumwtlunit(bounds%begl:bounds%endl))
- allocate(sumwtgcell(bounds%begg:bounds%endg))
-
- error_found = .false.
-
- ! Check patch-level weights
- sumwtcol(bounds%begc : bounds%endc) = 0._r8
- sumwtlunit(bounds%begl : bounds%endl) = 0._r8
- sumwtgcell(bounds%begg : bounds%endg) = 0._r8
-
- do p = bounds%begp,bounds%endp
- c = patch%column(p)
- l = patch%landunit(p)
- g = patch%gridcell(p)
-
- if ((active_only .and. patch%active(p)) .or. .not. active_only) then
- sumwtcol(c) = sumwtcol(c) + patch%wtcol(p)
- sumwtlunit(l) = sumwtlunit(l) + patch%wtlunit(p)
- sumwtgcell(g) = sumwtgcell(g) + patch%wtgcell(p)
- end if
- end do
-
- do c = bounds%begc,bounds%endc
- if (.not. weights_okay(sumwtcol(c), active_only, col%active(c))) then
- write(iulog,*) trim(subname),' ERROR: at c = ',c,'total PFT weight is ',sumwtcol(c), &
- 'active_only = ', active_only
- error_found = .true.
- end if
- end do
-
- do l = bounds%begl,bounds%endl
- if (.not. weights_okay(sumwtlunit(l), active_only, lun%active(l))) then
- write(iulog,*) trim(subname),' ERROR: at l = ',l,'total PFT weight is ',sumwtlunit(l), &
- 'active_only = ', active_only
- error_found = .true.
- end if
- end do
-
- do g = bounds%begg,bounds%endg
- if (.not. weights_okay(sumwtgcell(g), active_only, i_am_active=.true.)) then
- write(iulog,*) trim(subname),' ERROR: at g = ',g,'total PFT weight is ',sumwtgcell(g), &
- 'active_only = ', active_only
- error_found = .true.
- end if
- end do
-
- ! Check col-level weights
- sumwtlunit(bounds%begl : bounds%endl) = 0._r8
- sumwtgcell(bounds%begg : bounds%endg) = 0._r8
-
- do c = bounds%begc,bounds%endc
- l = col%landunit(c)
- g = col%gridcell(c)
-
- if ((active_only .and. col%active(c)) .or. .not. active_only) then
- sumwtlunit(l) = sumwtlunit(l) + col%wtlunit(c)
- sumwtgcell(g) = sumwtgcell(g) + col%wtgcell(c)
- end if
- end do
-
- do l = bounds%begl,bounds%endl
- if (.not. weights_okay(sumwtlunit(l), active_only, lun%active(l))) then
- write(iulog,*) trim(subname),' ERROR: at l = ',l,'total col weight is ',sumwtlunit(l), &
- 'active_only = ', active_only
- error_found = .true.
- end if
- end do
-
- do g = bounds%begg,bounds%endg
- if (.not. weights_okay(sumwtgcell(g), active_only, i_am_active=.true.)) then
- write(iulog,*) trim(subname),' ERROR: at g = ',g,'total col weight is ',sumwtgcell(g), &
- 'active_only = ', active_only
- error_found = .true.
- end if
- end do
-
- ! Check landunit-level weights
- sumwtgcell(bounds%begg : bounds%endg) = 0._r8
-
- do l = bounds%begl,bounds%endl
- g = lun%gridcell(l)
- if ((active_only .and. lun%active(l)) .or. .not. active_only) then
- sumwtgcell(g) = sumwtgcell(g) + lun%wtgcell(l)
- end if
- end do
-
- do g = bounds%begg,bounds%endg
- if (.not. weights_okay(sumwtgcell(g), active_only, i_am_active=.true.)) then
- write(iulog,*) trim(subname),' ERROR: at g = ',g,'total lunit weight is ',sumwtgcell(g), &
- 'active_only = ', active_only
- error_found = .true.
- end if
- end do
-
- deallocate(sumwtcol, sumwtlunit, sumwtgcell)
-
- if (error_found) then
- call endrun(msg=errMsg(sourcefile, __LINE__))
- end if
-
- ! Success
-
- end subroutine check_weights
-
- !-----------------------------------------------------------------------
- logical function weights_okay(sumwts, active_weights_only, i_am_active)
- !
- ! !DESCRIPTION:
- ! Determine if sumwts (the sum of weights of children, grandchildren or
- ! great-grandchildren of a column, landunit or grid cell) satisfies the requirements laid
- ! out above.
- !
- ! The way this is determined depends on the values of two other variables:
- ! - active_weights_only: does sumwts just include weights of active children,
- ! grandchildren or great-grandchilden? (alternative is that it includes weights of ALL
- ! children, grandchildren or great-grandchildren)
- ! - i_am_active: true if the column, landunit or grid cell of interest is active
- !
- ! !ARGUMENTS:
- implicit none
- real(r8), intent(in) :: sumwts ! sum of weights of children, grandchildren or great-grandchildren
- logical , intent(in) :: active_weights_only ! true if sumwts just includes active children, etc.
- logical , intent(in) :: i_am_active ! true if the current point is active
- !
- ! !LOCAL VARIABLES:
- logical :: weights_equal_1
- real(r8), parameter :: tolerance = 1.e-12_r8 ! tolerance for checking whether weights sum to 1
- !------------------------------------------------------------------------
-
- weights_equal_1 = (abs(sumwts - 1._r8) <= tolerance)
-
- if (active_weights_only) then
- if (i_am_active) then ! condition (2) above
- weights_okay = weights_equal_1
- else ! condition (3) above
- weights_okay = (sumwts == 0._r8 .or. weights_equal_1)
- end if
- else ! condition (1) above
- ! (note that i_am_active is irrelevant in this case)
- weights_okay = weights_equal_1
- end if
-
- end function weights_okay
-
- !-----------------------------------------------------------------------
- subroutine set_subgrid_diagnostic_fields(bounds)
- !
- ! !DESCRIPTION:
- ! Set history fields giving diagnostics about subgrid weights
- !
- ! !USES:
- !
- ! !ARGUMENTS:
- type(bounds_type), intent(in) :: bounds
- !
- ! !LOCAL VARIABLES:
-
- character(len=*), parameter :: subname = 'set_subgrid_diagnostic_fields'
- !-----------------------------------------------------------------------
-
- call set_pct_landunit_diagnostics(bounds)
-
- ! Note: (MV, 10-17-14): The following has an use_fates if-block around it since
- ! the pct_pft_diagnostics referens to patch%itype(p) which is not used by ED
- ! Note: (SPM, 10-20-15): If this isn't set then debug mode with intel and
- ! yellowstone will fail when trying to write pct_nat_pft since it contains
- ! all NaN's.
- call set_pct_pft_diagnostics(bounds)
-
- call set_pct_glc_mec_diagnostics(bounds)
-
- end subroutine set_subgrid_diagnostic_fields
-
- !-----------------------------------------------------------------------
- subroutine set_pct_landunit_diagnostics(bounds)
- !
- ! !DESCRIPTION:
- ! Set pct_landunit diagnostic field: % of each landunit on the grid cell
- !
- ! !USES:
- !
- ! !ARGUMENTS:
- type(bounds_type), intent(in) :: bounds
- !
- ! !LOCAL VARIABLES:
- integer :: g, l ! grid cell & landunit indices
- integer :: ltype ! landunit type
-
- character(len=*), parameter :: subname = 'set_pct_landunit_diagnostics'
- !-----------------------------------------------------------------------
-
- subgrid_weights_diagnostics%pct_landunit(bounds%begg:bounds%endg, :) = 0._r8
-
- do l = bounds%begl, bounds%endl
- g = lun%gridcell(l)
- ltype = lun%itype(l)
- subgrid_weights_diagnostics%pct_landunit(g, ltype) = lun%wtgcell(l) * 100._r8
- end do
-
- end subroutine set_pct_landunit_diagnostics
-
- !-----------------------------------------------------------------------
- subroutine set_pct_glc_mec_diagnostics(bounds)
- !
- ! !DESCRIPTION:
- ! Set pct_glc_mec diagnostic field: % of each glc_mec column on the glc_mec landunit
- !
- ! Note: it's safe to call this even if we're not running with glc_mec, but in that
- ! case it won't do anything.
- !
- ! Note that pct_glc_mec will be 0 for all elevation classes in a grid cell that does
- ! not have a glc_mec landunit. However, it will still sum to 100% for a grid cell
- ! that has a 0-weight (i.e., virtual) glc_mec landunit.
- !
- ! !USES:
- use landunit_varcon, only : istice_mec
- use column_varcon, only : col_itype_to_icemec_class
- !
- ! !ARGUMENTS:
- type(bounds_type), intent(in) :: bounds
- !
- ! !LOCAL VARIABLES:
- integer :: c,l,g ! indices
- integer :: icemec_class ! icemec class (1..maxpatch_glcmec)
-
- character(len=*), parameter :: subname = 'set_pct_glc_mec_diagnostics'
- !-----------------------------------------------------------------------
-
- subgrid_weights_diagnostics%pct_glc_mec(bounds%begg:bounds%endg, :) = 0._r8
-
- do c = bounds%begc, bounds%endc
- g = col%gridcell(c)
- l = col%landunit(c)
- if (lun%itype(l) == istice_mec) then
- icemec_class = col_itype_to_icemec_class(col%itype(c))
- subgrid_weights_diagnostics%pct_glc_mec(g, icemec_class) = col%wtlunit(c) * 100._r8
- end if
- end do
-
- end subroutine set_pct_glc_mec_diagnostics
-
- !-----------------------------------------------------------------------
- subroutine set_pct_pft_diagnostics(bounds)
- !
- ! !DESCRIPTION:
- ! Set pct_nat_pft & pct_cft diagnostic fields: % of PFTs on their landunit
- !
- ! !USES:
- use landunit_varcon, only : istsoil, istcrop
- use clm_varpar, only : natpft_lb, cft_lb
- !
- ! !ARGUMENTS:
- type(bounds_type), intent(in) :: bounds
- !
- ! !LOCAL VARIABLES:
- integer :: p,l,g ! indices
- integer :: ptype ! patch itype
- integer :: ptype_1indexing ! patch itype, translated into 1-indexing for the given landunit type
-
- character(len=*), parameter :: subname = 'set_pct_pft_diagnostics'
- !-----------------------------------------------------------------------
-
- subgrid_weights_diagnostics%pct_nat_pft(bounds%begg:bounds%endg, :) = 0._r8
-
- ! Note that pct_cft will be 0-size if cft_size is 0 (which can happen if we don't
- ! have a crop landunit). But it doesn't hurt to have this line setting all elements
- ! to 0, and doing this always allows us to avoid extra logic which could be a
- ! maintenance problem.
- subgrid_weights_diagnostics%pct_cft(bounds%begg:bounds%endg, :) = 0._r8
-
- do p = bounds%begp,bounds%endp
- g = patch%gridcell(p)
- l = patch%landunit(p)
- ptype = patch%itype(p)
- if (lun%itype(l) == istsoil .and. (.not.use_fates) ) then
- ptype_1indexing = ptype + (1 - natpft_lb)
- subgrid_weights_diagnostics%pct_nat_pft(g, ptype_1indexing) = patch%wtlunit(p) * 100._r8
- else if (lun%itype(l) == istcrop) then
- ptype_1indexing = ptype + (1 - cft_lb)
- subgrid_weights_diagnostics%pct_cft(g, ptype_1indexing) = patch%wtlunit(p) * 100._r8
- end if
- end do
-
- end subroutine set_pct_pft_diagnostics
-
-end module subgridWeightsMod
diff --git a/src/main/surfrdMod.F90 b/src/main/surfrdMod.F90
index ef593b1a..13ebbced 100644
--- a/src/main/surfrdMod.F90
+++ b/src/main/surfrdMod.F90
@@ -5,19 +5,20 @@ module surfrdMod
! Contains methods for reading in surface data file and determining
! subgrid weights
!
+ ! !NOTES:
+ ! TODO Currently reading domain file, although this is done in surfrd.
+ ! In NUOPC version we will be reading ESMF mesh file. Until SLIM gets
+ ! updated to NUOPC, we are leaving the calls to surfrd unchanged.
+ !
! !USES:
#include "shr_assert.h"
use shr_kind_mod , only : r8 => shr_kind_r8
use shr_log_mod , only : errMsg => shr_log_errMsg
use abortutils , only : endrun
- use clm_varpar , only : nlevsoifl, numpft
- use landunit_varcon , only : numurbl
use clm_varcon , only : grlnd
use clm_varctl , only : iulog, scmlat, scmlon, single_column
- use clm_varctl , only : use_cndv, use_crop
- use surfrdUtilsMod , only : check_sums_equal_1, collapse_crop_types
use ncdio_pio , only : file_desc_t, var_desc_t, ncd_pio_openfile, ncd_pio_closefile
- use ncdio_pio , only : ncd_io, check_var, ncd_inqfdims, check_dim, ncd_inqdid
+ use ncdio_pio , only : ncd_io, check_var, ncd_inqfdims, ncd_inqdid
use pio
use spmdMod
!
@@ -28,18 +29,8 @@ module surfrdMod
! !PUBLIC MEMBER FUNCTIONS:
public :: surfrd_get_globmask ! Reads global land mask (needed for setting domain decomp)
public :: surfrd_get_grid ! Read grid/ladnfrac data into domain (after domain decomp)
- public :: surfrd_get_data ! Read surface dataset and determine subgrid weights
- !
- ! !PRIVATE MEMBER FUNCTIONS:
- private :: surfrd_special ! Read the special landunits
- private :: surfrd_veg_all ! Read all of the vegetated landunits
- private :: surfrd_veg_dgvm ! Read vegetated landunits for DGVM mode
- private :: surfrd_pftformat ! Read crop pfts in file format where they are part of the vegetated land unit
- private :: surfrd_cftformat ! Read crop pfts in file format where they are on their own landunit
!
! !PRIVATE DATA MEMBERS:
- ! default multiplication factor for epsilon for error checks
- real(r8), private, parameter :: eps_fact = 2._r8
character(len=*), parameter, private :: sourcefile = &
__FILE__
@@ -132,7 +123,7 @@ subroutine surfrd_get_globmask(filename, mask, ni, nj)
end subroutine surfrd_get_globmask
!-----------------------------------------------------------------------
- subroutine surfrd_get_grid(begg, endg, ldomain, filename, glcfilename)
+ subroutine surfrd_get_grid(begg, endg, ldomain, filename)
!
! !DESCRIPTION:
! THIS IS CALLED AFTER THE DOMAIN DECOMPOSITION HAS BEEN CREATED
@@ -149,7 +140,6 @@ subroutine surfrd_get_grid(begg, endg, ldomain, filename, glcfilename)
integer ,intent(in) :: begg, endg
type(domain_type),intent(inout) :: ldomain ! domain to init
character(len=*) ,intent(in) :: filename ! grid filename
- character(len=*) ,optional, intent(in) :: glcfilename ! glc mask filename
!
! !LOCAL VARIABLES:
type(file_desc_t) :: ncid ! netcdf id
@@ -280,540 +270,4 @@ subroutine surfrd_get_grid(begg, endg, ldomain, filename, glcfilename)
end subroutine surfrd_get_grid
- !-----------------------------------------------------------------------
- subroutine surfrd_get_data (begg, endg, ldomain, lfsurdat)
- !
- ! !DESCRIPTION:
- ! Read the surface dataset and create subgrid weights.
- ! The model's surface dataset recognizes 6 basic land cover types within a grid
- ! cell: lake, wetland, urban, glacier, glacier_mec and vegetated. The vegetated
- ! portion of the grid cell is comprised of up to [maxpatch_pft] patches. These
- ! subgrid patches are read in explicitly for each grid cell. This is in
- ! contrast to LSMv1, where the patches were built implicitly from biome types.
- ! o real latitude of grid cell (degrees)
- ! o real longitude of grid cell (degrees)
- ! o integer surface type: 0 = ocean or 1 = land
- ! o integer soil color (1 to 20) for use with soil albedos
- ! o real soil texture, %sand, for thermal and hydraulic properties
- ! o real soil texture, %clay, for thermal and hydraulic properties
- ! o real % of cell covered by lake for use as subgrid patch
- ! o real % of cell covered by wetland for use as subgrid patch
- ! o real % of cell that is urban for use as subgrid patch
- ! o real % of cell that is glacier for use as subgrid patch
- ! o real % of cell that is glacier_mec for use as subgrid patch
- ! o integer PFTs
- ! o real % abundance PFTs (as a percent of vegetated area)
- !
- ! !USES:
- use clm_varctl , only : create_crop_landunit
- use fileutils , only : getfil
- use domainMod , only : domain_type, domain_init, domain_clean
- use clm_instur , only : wt_lunit, topo_glc_mec
- !
- ! !ARGUMENTS:
- integer, intent(in) :: begg, endg
- type(domain_type),intent(in) :: ldomain ! land domain
- character(len=*), intent(in) :: lfsurdat ! surface dataset filename
- !
- ! !LOCAL VARIABLES:
- type(var_desc_t) :: vardesc ! pio variable descriptor
- type(domain_type) :: surfdata_domain ! local domain associated with surface dataset
- character(len=256):: locfn ! local file name
- integer :: n ! loop indices
- integer :: ni,nj,ns ! domain sizes
- character(len=16) :: lon_var, lat_var ! names of lat/lon on dataset
- logical :: readvar ! true => variable is on dataset
- real(r8) :: rmaxlon,rmaxlat ! local min/max vars
- type(file_desc_t) :: ncid ! netcdf id
- logical :: istype_domain ! true => input file is of type domain
- logical :: isgrid2d ! true => intut grid is 2d
- character(len=32) :: subname = 'surfrd_get_data' ! subroutine name
- !-----------------------------------------------------------------------
-
- if (masterproc) then
- write(iulog,*) 'Attempting to read surface boundary data .....'
- if (lfsurdat == ' ') then
- write(iulog,*)'lfsurdat must be specified'
- call endrun(msg=errMsg(sourcefile, __LINE__))
- endif
- endif
-
- wt_lunit(:,:) = 0._r8
- topo_glc_mec(:,:) = 0._r8
-
- ! Read surface data
-
- call getfil( lfsurdat, locfn, 0 )
- call ncd_pio_openfile (ncid, trim(locfn), 0)
-
- ! Read in patch mask - this variable is only on the surface dataset - but not
- ! on the domain dataset
-
- call ncd_io(ncid=ncid, varname= 'PFTDATA_MASK', flag='read', data=ldomain%pftm, &
- dim1name=grlnd, readvar=readvar)
- if (.not. readvar) call endrun( msg=' ERROR: pftm NOT on surface dataset'//errMsg(sourcefile, __LINE__))
-
- ! Check if fsurdat grid is "close" to fatmlndfrc grid, exit if lats/lon > 0.001
-
- call check_var(ncid=ncid, varname='xc', vardesc=vardesc, readvar=readvar)
- if (readvar) then
- istype_domain = .true.
- else
- call check_var(ncid=ncid, varname='LONGXY', vardesc=vardesc, readvar=readvar)
- if (readvar) then
- istype_domain = .false.
- else
- call endrun( msg=' ERROR: unknown domain type'//errMsg(sourcefile, __LINE__))
- end if
- end if
- if (istype_domain) then
- lon_var = 'xc'
- lat_var = 'yc'
- else
- lon_var = 'LONGXY'
- lat_var = 'LATIXY'
- end if
- if ( masterproc )then
- write(iulog,*) trim(subname),' lon_var = ',trim(lon_var),' lat_var =',trim(lat_var)
- end if
-
- call ncd_inqfdims(ncid, isgrid2d, ni, nj, ns)
- call domain_init(surfdata_domain, isgrid2d, ni, nj, begg, endg, clmlevel=grlnd)
-
- call ncd_io(ncid=ncid, varname=lon_var, flag='read', data=surfdata_domain%lonc, &
- dim1name=grlnd, readvar=readvar)
- if (.not. readvar) call endrun( msg=' ERROR: lon var NOT on surface dataset'//errMsg(sourcefile, __LINE__))
-
- call ncd_io(ncid=ncid, varname=lat_var, flag='read', data=surfdata_domain%latc, &
- dim1name=grlnd, readvar=readvar)
- if (.not. readvar) call endrun( msg=' ERROR: lat var NOT on surface dataset'//errMsg(sourcefile, __LINE__))
-
- rmaxlon = 0.0_r8
- rmaxlat = 0.0_r8
- do n = begg,endg
- if (ldomain%lonc(n)-surfdata_domain%lonc(n) > 300.) then
- rmaxlon = max(rmaxlon,abs(ldomain%lonc(n)-surfdata_domain%lonc(n)-360._r8))
- elseif (ldomain%lonc(n)-surfdata_domain%lonc(n) < -300.) then
- rmaxlon = max(rmaxlon,abs(ldomain%lonc(n)-surfdata_domain%lonc(n)+360._r8))
- else
- rmaxlon = max(rmaxlon,abs(ldomain%lonc(n)-surfdata_domain%lonc(n)))
- endif
- rmaxlat = max(rmaxlat,abs(ldomain%latc(n)-surfdata_domain%latc(n)))
- enddo
- if (rmaxlon > 0.001_r8 .or. rmaxlat > 0.001_r8) then
- write(iulog,*)' ERROR: surfdata/fatmgrid lon/lat mismatch error', rmaxlon,rmaxlat
- call endrun(msg=errMsg(sourcefile, __LINE__))
- end if
-
- !~! TODO(SPM, 022015) - if we deallocate and clean ldomain here, then you
- !~! get errors in htape_timeconst where the information is needed to write
- !~! the *.h0* file
- !~!call domain_clean(surfdata_domain)
-
- ! Obtain special landunit info
-
- call surfrd_special(begg, endg, ncid, ldomain%ns)
-
- ! Obtain vegetated landunit info
-
- call surfrd_veg_all(begg, endg, ncid, ldomain%ns)
-
- if (use_cndv) then
- call surfrd_veg_dgvm(begg, endg)
- end if
-
- call ncd_pio_closefile(ncid)
-
- call check_sums_equal_1(wt_lunit, begg, 'wt_lunit', subname)
-
- if ( masterproc )then
- write(iulog,*) 'Successfully read surface boundary data'
- write(iulog,*)
- end if
-
- end subroutine surfrd_get_data
-
-!-----------------------------------------------------------------------
- subroutine surfrd_special(begg, endg, ncid, ns)
- !
- ! !DESCRIPTION:
- ! Determine weight with respect to gridcell of all special "patches" as well
- ! as soil color and percent sand and clay
- !
- ! !USES:
- use clm_varpar , only : maxpatch_glcmec, nlevurb
- use landunit_varcon , only : isturb_MIN, isturb_MAX, istdlak, istwet, istice_mec
- use clm_instur , only : wt_lunit, urban_valid, wt_glc_mec, topo_glc_mec
- use UrbanParamsType , only : CheckUrban
- !
- ! !ARGUMENTS:
- integer , intent(in) :: begg, endg
- type(file_desc_t), intent(inout) :: ncid ! netcdf id
- integer , intent(in) :: ns ! domain size
- !
- ! !LOCAL VARIABLES:
- integer :: n,nl,nurb,g ! indices
- integer :: dimid,varid ! netCDF id's
- real(r8) :: nlevsoidata(nlevsoifl)
- logical :: found ! temporary for error check
- integer :: nindx ! temporary for error check
- integer :: ier ! error status
- logical :: readvar
- real(r8),pointer :: pctgla(:) ! percent of grid cell is glacier
- real(r8),pointer :: pctlak(:) ! percent of grid cell is lake
- real(r8),pointer :: pctwet(:) ! percent of grid cell is wetland
- real(r8),pointer :: pcturb(:,:) ! percent of grid cell is urbanized
- integer ,pointer :: urban_region_id(:)
- real(r8),pointer :: pcturb_tot(:) ! percent of grid cell is urban (sum over density classes)
- real(r8),pointer :: pctspec(:) ! percent of spec lunits wrt gcell
- integer :: dens_index ! urban density index
- character(len=32) :: subname = 'surfrd_special' ! subroutine name
- real(r8) closelat,closelon
- integer, parameter :: urban_invalid_region = 0 ! urban_region_id indicating invalid point
-!-----------------------------------------------------------------------
-
- allocate(pctgla(begg:endg))
- allocate(pctlak(begg:endg))
- allocate(pctwet(begg:endg))
- allocate(pcturb(begg:endg,numurbl))
- allocate(pcturb_tot(begg:endg))
- allocate(urban_region_id(begg:endg))
- allocate(pctspec(begg:endg))
-
- call check_dim(ncid, 'nlevsoi', nlevsoifl)
-
- ! Obtain non-grid surface properties of surface dataset other than percent patch
-
- call ncd_io(ncid=ncid, varname='PCT_WETLAND', flag='read', data=pctwet, &
- dim1name=grlnd, readvar=readvar)
- if (.not. readvar) call endrun( msg=' ERROR: PCT_WETLAND NOT on surfdata file'//errMsg(sourcefile, __LINE__))
-
- call ncd_io(ncid=ncid, varname='PCT_LAKE' , flag='read', data=pctlak, &
- dim1name=grlnd, readvar=readvar)
- if (.not. readvar) call endrun( msg=' ERROR: PCT_LAKE NOT on surfdata file'//errMsg(sourcefile, __LINE__))
-
- call ncd_io(ncid=ncid, varname='PCT_GLACIER', flag='read', data=pctgla, &
- dim1name=grlnd, readvar=readvar)
- if (.not. readvar) call endrun( msg=' ERROR: PCT_GLACIER NOT on surfdata file'//errMsg(sourcefile, __LINE__))
-
- ! Read urban info
- if (nlevurb == 0) then
- ! If PCT_URBAN is not multi-density then set pcturb to zero
- pcturb = 0._r8
- urban_valid(begg:endg) = .false.
- write(iulog,*)'PCT_URBAN is not multi-density, pcturb set to 0'
- else
- call ncd_io(ncid=ncid, varname='PCT_URBAN' , flag='read', data=pcturb, &
- dim1name=grlnd, readvar=readvar)
- if (.not. readvar) call endrun( msg=' ERROR: PCT_URBAN NOT on surfdata file'//errMsg(sourcefile, __LINE__))
-
- call ncd_io(ncid=ncid, varname='URBAN_REGION_ID', flag='read', data=urban_region_id, &
- dim1name=grlnd, readvar=readvar)
- if (.not. readvar) call endrun( msg= ' ERROR: URBAN_REGION_ID NOT on surfdata file'//errMsg(sourcefile, __LINE__))
- where (urban_region_id == urban_invalid_region)
- urban_valid = .false.
- elsewhere
- urban_valid = .true.
- end where
- end if
- if ( nlevurb == 0 )then
- if ( any(pcturb > 0.0_r8) ) then
- call endrun( msg=' ERROR: PCT_URBAN MUST be zero when nlevurb=0'//errMsg(sourcefile, __LINE__))
- end if
- end if
-
- pcturb_tot(:) = 0._r8
- do n = 1, numurbl
- do nl = begg,endg
- pcturb_tot(nl) = pcturb_tot(nl) + pcturb(nl,n)
- enddo
- enddo
-
- ! Read glacier info
-
- call check_dim(ncid, 'nglcec', maxpatch_glcmec )
- call check_dim(ncid, 'nglcecp1', maxpatch_glcmec+1 )
-
- call ncd_io(ncid=ncid, varname='PCT_GLC_MEC', flag='read', data=wt_glc_mec, &
- dim1name=grlnd, readvar=readvar)
- if (.not. readvar) call endrun( msg=' ERROR: PCT_GLC_MEC NOT on surfdata file'//errMsg(sourcefile, __LINE__))
-
- wt_glc_mec(:,:) = wt_glc_mec(:,:) / 100._r8
- call check_sums_equal_1(wt_glc_mec, begg, 'wt_glc_mec', subname)
-
- call ncd_io(ncid=ncid, varname='TOPO_GLC_MEC', flag='read', data=topo_glc_mec, &
- dim1name=grlnd, readvar=readvar)
- if (.not. readvar) call endrun( msg=' ERROR: TOPO_GLC_MEC NOT on surfdata file'//errMsg(sourcefile, __LINE__))
-
- topo_glc_mec(:,:) = max(topo_glc_mec(:,:), 0._r8)
-
- pctspec = pctwet + pctlak + pcturb_tot + pctgla
-
- ! Error check: glacier, lake, wetland, urban sum must be less than 100
-
- found = .false.
- do nl = begg,endg
- if (pctspec(nl) > 100._r8+1.e-04_r8) then
- found = .true.
- nindx = nl
- exit
- end if
- if (found) exit
- end do
- if ( found ) then
- write(iulog,*)'surfrd error: patch cover>100 for nl=',nindx
- call endrun(msg=errMsg(sourcefile, __LINE__))
- end if
-
- ! Determine wt_lunit for special landunits
-
- do nl = begg,endg
-
- wt_lunit(nl,istdlak) = pctlak(nl)/100._r8
-
- wt_lunit(nl,istwet) = pctwet(nl)/100._r8
-
- wt_lunit(nl,istice_mec) = pctgla(nl)/100._r8
-
- do n = isturb_MIN, isturb_MAX
- dens_index = n - isturb_MIN + 1
- wt_lunit(nl,n) = pcturb(nl,dens_index) / 100._r8
- end do
-
- end do
-
- call CheckUrban(begg, endg, pcturb(begg:endg,:), subname)
-
- deallocate(pctgla,pctlak,pctwet,pcturb,pcturb_tot,urban_region_id,pctspec)
-
- end subroutine surfrd_special
-
-!-----------------------------------------------------------------------
- subroutine surfrd_cftformat( ncid, begg, endg, wt_cft, cftsize, natpft_size )
- !
- ! !DESCRIPTION:
- ! Handle generic crop types for file format where they are on their own
- ! crop landunit and read in as Crop Function Types.
- ! !USES:
- use clm_instur , only : fert_cft, wt_nat_patch
- use clm_varpar , only : cft_size, cft_lb, natpft_lb
- ! !ARGUMENTS:
- implicit none
- type(file_desc_t), intent(inout) :: ncid ! netcdf id
- integer , intent(in) :: begg, endg
- integer , intent(in) :: cftsize ! CFT size
- real(r8), pointer, intent(inout) :: wt_cft(:,:) ! CFT weights
- integer , intent(in) :: natpft_size ! natural PFT size
- !
- ! !LOCAL VARIABLES:
- logical :: readvar ! is variable on dataset
- real(r8),pointer :: array2D(:,:) ! local array
- character(len=32) :: subname = 'surfrd_cftformat'! subroutine name
-!-----------------------------------------------------------------------
- SHR_ASSERT_ALL((lbound(wt_cft) == (/begg, cft_lb/)), errMsg(sourcefile, __LINE__))
- SHR_ASSERT_ALL((ubound(wt_cft, dim=1) == (/endg/)), errMsg(sourcefile, __LINE__))
- SHR_ASSERT_ALL((ubound(wt_cft, dim=2) >= (/cftsize+1-cft_lb/)), errMsg(sourcefile, __LINE__))
- SHR_ASSERT_ALL((ubound(wt_nat_patch) >= (/endg,natpft_size-1+natpft_lb/)), errMsg(sourcefile, __LINE__))
-
- call check_dim(ncid, 'cft', cftsize)
- call check_dim(ncid, 'natpft', natpft_size)
-
- call ncd_io(ncid=ncid, varname='PCT_CFT', flag='read', data=wt_cft, &
- dim1name=grlnd, readvar=readvar)
- if (.not. readvar) call endrun( msg=' ERROR: PCT_CFT NOT on surfdata file'//errMsg(sourcefile, __LINE__))
-
- if ( cft_size > 0 )then
- call ncd_io(ncid=ncid, varname='CONST_FERTNITRO_CFT', flag='read', data=fert_cft, &
- dim1name=grlnd, readvar=readvar)
- if (.not. readvar) then
- if ( masterproc ) &
- write(iulog,*) ' WARNING: CONST_FERTNITRO_CFT NOT on surfdata file zero out'
- fert_cft = 0.0_r8
- end if
- else
- fert_cft = 0.0_r8
- end if
-
- allocate( array2D(begg:endg,1:natpft_size) )
- call ncd_io(ncid=ncid, varname='PCT_NAT_PFT', flag='read', data=array2D, &
- dim1name=grlnd, readvar=readvar)
- if (.not. readvar) call endrun( msg=' ERROR: PCT_NAT_PFT NOT on surfdata file'//errMsg(sourcefile, __LINE__))
- wt_nat_patch(begg:,natpft_lb:natpft_size-1+natpft_lb) = array2D(begg:,:)
- deallocate( array2D )
-
- end subroutine surfrd_cftformat
-
-!-----------------------------------------------------------------------
- subroutine surfrd_pftformat( begg, endg, ncid )
- !
- ! !DESCRIPTION:
- ! Handle generic crop types for file format where they are part of the
- ! natural vegetation landunit.
- ! !USES:
- use clm_instur , only : fert_cft, wt_nat_patch
- use clm_varpar , only : natpft_size, cft_size, natpft_lb
- ! !ARGUMENTS:
- implicit none
- integer, intent(in) :: begg, endg
- type(file_desc_t), intent(inout) :: ncid ! netcdf id
- !
- ! !LOCAL VARIABLES:
- logical :: cft_dim_exists ! does the dimension 'cft' exist on the dataset?
- integer :: dimid ! netCDF id's
- logical :: readvar ! is variable on dataset
- character(len=32) :: subname = 'surfrd_pftformat'! subroutine name
-!-----------------------------------------------------------------------
- SHR_ASSERT_ALL((ubound(wt_nat_patch) == (/endg, natpft_size-1+natpft_lb/)), errMsg(sourcefile, __LINE__))
-
- call check_dim(ncid, 'natpft', natpft_size)
- ! If cft_size == 0, then we expect to be running with a surface dataset
- ! that does
- ! NOT have a PCT_CFT array (or CONST_FERTNITRO_CFT array), and thus does not have a 'cft' dimension.
- ! Make sure
- ! that's the case.
- call ncd_inqdid(ncid, 'cft', dimid, cft_dim_exists)
- if (cft_dim_exists) then
- call endrun( msg= ' ERROR: unexpectedly found cft dimension on dataset when cft_size=0'// &
- ' (if the surface dataset has a separate crop landunit, then the code'// &
- ' must also have a separate crop landunit, and vice versa)'//&
- errMsg(sourcefile, __LINE__))
- end if
- call ncd_io(ncid=ncid, varname='CONST_FERTNITRO_CFT', flag='read', data=fert_cft, &
- dim1name=grlnd, readvar=readvar)
- if (readvar) then
- call endrun( msg= ' ERROR: unexpectedly found CONST_FERTNITRO_CFT on dataset when cft_size=0'// &
- ' (if the surface dataset has a separate crop landunit, then the code'// &
- ' must also have a separate crop landunit, and vice versa)'//&
- errMsg(sourcefile, __LINE__))
- end if
- fert_cft = 0.0_r8
-
- call ncd_io(ncid=ncid, varname='PCT_NAT_PFT', flag='read', data=wt_nat_patch, &
- dim1name=grlnd, readvar=readvar)
- if (.not. readvar) call endrun( msg=' ERROR: PCT_NAT_PFT NOT on surfdata file'//errMsg(sourcefile, __LINE__))
-
- end subroutine surfrd_pftformat
-
-!-----------------------------------------------------------------------
- subroutine surfrd_veg_all(begg, endg, ncid, ns)
- !
- ! !DESCRIPTION:
- ! Determine weight arrays for non-dynamic landuse mode
- !
- ! !USES:
- use clm_varctl , only : create_crop_landunit, use_fates
- use clm_varpar , only : natpft_lb, natpft_ub, natpft_size, cft_size, cft_lb
- use clm_instur , only : wt_lunit, wt_nat_patch, wt_cft, fert_cft
- use landunit_varcon , only : istsoil, istcrop
- use surfrdUtilsMod , only : convert_cft_to_pft
- !
- ! !ARGUMENTS:
- implicit none
- integer, intent(in) :: begg, endg
- type(file_desc_t),intent(inout) :: ncid ! netcdf id
- integer ,intent(in) :: ns ! domain size
- !
- ! !LOCAL VARIABLES:
- integer :: dimid ! netCDF id's
- integer :: cftsize ! size of CFT's
- logical :: readvar ! is variable on dataset
- logical :: cft_dim_exists ! does the dimension 'cft' exist on the dataset?
- real(r8),pointer :: arrayl(:) ! local array
- real(r8),pointer :: array2D(:,:) ! local 2D array
- character(len=32) :: subname = 'surfrd_veg_all' ! subroutine name
-!-----------------------------------------------------------------------
- !
- ! Read in variables that are handled the same for all formats
- !
- ! Check dimension size
- call check_dim(ncid, 'lsmpft', numpft+1)
-
- ! This temporary array is needed because ncd_io expects a pointer, so we can't
- ! directly pass wt_lunit(begg:endg,istsoil)
- allocate(arrayl(begg:endg))
-
- call ncd_io(ncid=ncid, varname='PCT_NATVEG', flag='read', data=arrayl, &
- dim1name=grlnd, readvar=readvar)
- if (.not. readvar) call endrun( msg=' ERROR: PCT_NATVEG NOT on surfdata file'//errMsg(sourcefile, __LINE__))
- wt_lunit(begg:endg,istsoil) = arrayl(begg:endg)
-
- call ncd_io(ncid=ncid, varname='PCT_CROP', flag='read', data=arrayl, &
- dim1name=grlnd, readvar=readvar)
- if (.not. readvar) call endrun( msg=' ERROR: PCT_CROP NOT on surfdata file'//errMsg(sourcefile, __LINE__))
- wt_lunit(begg:endg,istcrop) = arrayl(begg:endg)
-
- deallocate(arrayl)
-
- ! Check the file format for CFT's and handle accordingly
- call ncd_inqdid(ncid, 'cft', dimid, cft_dim_exists)
- if ( cft_dim_exists .and. create_crop_landunit )then
- call surfrd_cftformat( ncid, begg, endg, wt_cft, cft_size, natpft_size ) ! Format where CFT's is read in a seperate landunit
- else if ( (.not. cft_dim_exists) .and. (.not. create_crop_landunit) )then
- if ( masterproc ) write(iulog,*) "WARNING: The PFT format is an unsupported format that will be removed in th future!"
- call surfrd_pftformat( begg, endg, ncid ) ! Format where crop is part of the natural veg. landunit
- else if ( cft_dim_exists .and. .not. create_crop_landunit )then
- if ( masterproc ) write(iulog,*) "WARNING: New CFT-based format surface datasets should be run with create_crop_landunit=T"
- if ( use_fates ) then
- if ( masterproc ) write(iulog,*) "WARNING: When fates is on we allow new CFT based surface datasets ", &
- "to be used with create_crop_land FALSE"
- cftsize = 2
- allocate(array2D(begg:endg,cft_lb:cftsize-1+cft_lb))
- call surfrd_cftformat( ncid, begg, endg, array2D, cftsize, natpft_size-cftsize ) ! Read crops in as CFT's
- call convert_cft_to_pft( begg, endg, cftsize, array2D ) ! Convert from CFT to natural veg. landunit
- deallocate(array2D)
- else
- call endrun( msg=' ERROR: New format surface datasets require create_crop_landunit TRUE'//errMsg(sourcefile, __LINE__))
- end if
- end if
-
- ! Do some checking
-
- if ( (cft_size == 0) .and. any(wt_lunit(begg:endg,istcrop) > 0._r8) ) then
- call endrun( msg=' ERROR: if PCT_CROP > 0 anywhere, then cft_size must be > 0'// &
- ' (if the surface dataset has a separate crop landunit, then the code'// &
- ' must also have a separate crop landunit, and vice versa)'//&
- errMsg(sourcefile, __LINE__))
- end if
- ! Convert from percent to fraction, check sums of nat vegetation add to 1
- if ( cft_size > 0 )then
- wt_cft(begg:endg,:) = wt_cft(begg:endg,:) / 100._r8
- call check_sums_equal_1(wt_cft, begg, 'wt_cft', subname)
- end if
- wt_lunit(begg:endg,istsoil) = wt_lunit(begg:endg,istsoil) / 100._r8
- wt_lunit(begg:endg,istcrop) = wt_lunit(begg:endg,istcrop) / 100._r8
- wt_nat_patch(begg:endg,:) = wt_nat_patch(begg:endg,:) / 100._r8
- call check_sums_equal_1(wt_nat_patch, begg, 'wt_nat_patch', subname)
-
- ! Collapse crop landunits down when prognostic crops are on
- if (use_crop) then
- call collapse_crop_types(wt_cft(begg:endg, :), fert_cft(begg:endg, :), begg, endg, verbose=.true.)
- end if
-
- end subroutine surfrd_veg_all
-
- !-----------------------------------------------------------------------
- subroutine surfrd_veg_dgvm(begg, endg)
- !
- ! !DESCRIPTION:
- ! Determine weights for CNDV mode.
- !
- ! !USES:
- use pftconMod , only : noveg
- use clm_instur, only : wt_nat_patch
- !
- ! !ARGUMENTS:
- integer, intent(in) :: begg, endg
- !
- ! !LOCAL VARIABLES:
- character(len=*), parameter :: subname = 'surfrd_veg_dgvm'
- !-----------------------------------------------------------------------
-
- ! Bare ground gets 100% weight; all other natural patches are zeroed out
- wt_nat_patch(begg:endg, :) = 0._r8
- wt_nat_patch(begg:endg, noveg) = 1._r8
-
- call check_sums_equal_1(wt_nat_patch, begg, 'wt_nat_patch', subname)
-
- end subroutine surfrd_veg_dgvm
-
end module surfrdMod
diff --git a/src/main/surfrdUtilsMod.F90 b/src/main/surfrdUtilsMod.F90
deleted file mode 100644
index 45fbf9eb..00000000
--- a/src/main/surfrdUtilsMod.F90
+++ /dev/null
@@ -1,243 +0,0 @@
-module surfrdUtilsMod
- !-----------------------------------------------------------------------
- ! !DESCRIPTION:
- ! Contains utility methods that can be used when reading surface datasets or similar
- ! datasets (such as the landuse_timeseries dataset)
- !
- ! !USES:
-#include "shr_assert.h"
- 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
- use spmdMod , only : masterproc
- !
- ! !PUBLIC TYPES:
- implicit none
- private
- save
- !
- ! !PUBLIC MEMBER FUNCTIONS:
- public :: check_sums_equal_1 ! Confirm that sum(arr(n,:)) == 1 for all n
- public :: renormalize ! Renormalize an array
- public :: convert_cft_to_pft ! Conversion of crop CFT to natural veg PFT:w
- public :: collapse_crop_types ! Collapse unused crop types into types used in this run
-
- character(len=*), parameter, private :: sourcefile = &
- __FILE__
-
- !-----------------------------------------------------------------------
-
-contains
-
- !-----------------------------------------------------------------------
- subroutine check_sums_equal_1(arr, lb, name, caller, ier)
- !
- ! !DESCRIPTION:
- ! Confirm that sum(arr(n,:)) == 1 for all n. If this isn't true for any n, abort with a message.
- !
- ! !ARGUMENTS:
- integer , intent(in) :: lb ! lower bound of the first dimension of arr
- real(r8) , intent(in) :: arr(lb:,:) ! array to check
- character(len=*), intent(in) :: name ! name of array
- character(len=*), intent(in) :: caller ! identifier of caller, for more meaningful error messages
- integer, optional, intent(out):: ier ! Return an error code rather than abort
- !
- ! !LOCAL VARIABLES:
- logical :: found
- integer :: nl
- integer :: nindx
- real(r8), parameter :: eps = 1.e-13_r8
- !-----------------------------------------------------------------------
-
- if( present(ier) ) ier = 0
- found = .false.
-
- do nl = lbound(arr, 1), ubound(arr, 1)
- if (abs(sum(arr(nl,:)) - 1._r8) > eps) then
- found = .true.
- nindx = nl
- exit
- end if
- end do
-
- if (found) then
- write(iulog,*) trim(caller), ' ERROR: sum of ', trim(name), ' not 1.0 at nl=', nindx
- write(iulog,*) 'sum is: ', sum(arr(nindx,:))
- if( present(ier) ) then
- ier = -10
- else
- call endrun(msg=errMsg(sourcefile, __LINE__))
- end if
- end if
-
- end subroutine check_sums_equal_1
-
- !-----------------------------------------------------------------------
- subroutine renormalize(arr, lb, normal)
- !
- ! !DESCRIPTION:
- ! Re normalize an array so that it sums to the input value
- !
- ! !ARGUMENTS:
- integer , intent(in) :: lb ! lower bound of the first dimension of arr
- real(r8) , intent(inout) :: arr(lb:,:) ! array to check
- real(r8) , intent(in) :: normal ! normal to sum to
- !
- ! !LOCAL VARIABLES:
- integer :: nl ! Array index
- real(r8) :: arr_sum ! sum of array
- real(r8) :: ratio ! ratio to multiply by
- !-----------------------------------------------------------------------
-
- do nl = lbound(arr, 1), ubound(arr, 1)
- arr_sum = sum(arr(nl,:))
- if ( arr_sum /= 0.0_r8 )then
- ratio = normal / arr_sum
- arr(nl,:) = arr(nl,:) * ratio
- end if
- end do
-
- end subroutine renormalize
-
-!-----------------------------------------------------------------------
- subroutine convert_cft_to_pft( begg, endg, cftsize, wt_cft )
- !
- ! !DESCRIPTION:
- ! Convert generic crop types that were read in as seperate CFT's on
- ! a crop landunit, and put them on the vegetated landunit.
- ! !USES:
- use clm_instur , only : wt_lunit, wt_nat_patch, fert_cft
- use clm_varpar , only : cft_size, natpft_size
- use pftconMod , only : nc3crop
- use landunit_varcon , only : istsoil, istcrop
- ! !ARGUMENTS:
- implicit none
- integer , intent(in) :: begg, endg
- integer , intent(in) :: cftsize ! CFT size
- real(r8) , intent(inout) :: wt_cft(begg:,:) ! CFT weights
- !
- ! !LOCAL VARIABLES:
- integer :: g ! index
-!-----------------------------------------------------------------------
- SHR_ASSERT_ALL((ubound(wt_cft) == (/endg, cftsize/)), errMsg(sourcefile, __LINE__))
- SHR_ASSERT_ALL((ubound(wt_nat_patch) == (/endg, nc3crop+cftsize-1/)), errMsg(sourcefile, __LINE__))
-
- do g = begg, endg
- if ( wt_lunit(g,istcrop) > 0.0_r8 )then
- ! Move CFT over to PFT and do weighted average of the crop and soil parts
- wt_nat_patch(g,:) = wt_nat_patch(g,:) * wt_lunit(g,istsoil)
- wt_cft(g,:) = wt_cft(g,:) * wt_lunit(g,istcrop)
- wt_nat_patch(g,nc3crop:) = wt_cft(g,:) ! Add crop CFT's to end of natural veg PFT's
- wt_lunit(g,istsoil) = (wt_lunit(g,istsoil) + wt_lunit(g,istcrop)) ! Add crop landunit to soil landunit
- wt_nat_patch(g,:) = wt_nat_patch(g,:) / wt_lunit(g,istsoil)
- wt_lunit(g,istcrop) = 0.0_r8 ! Zero out crop CFT's
- else
- wt_nat_patch(g,nc3crop:) = 0.0_r8 ! Make sure generic crops are zeroed out
- end if
- end do
-
- end subroutine convert_cft_to_pft
-
- !-----------------------------------------------------------------------
- subroutine collapse_crop_types(wt_cft, fert_cft, begg, endg, verbose)
- !
- ! !DESCRIPTION:
- ! Collapse unused crop types into types used in this run.
- !
- ! Should only be called if using prognostic crops - otherwise, wt_cft is meaningless
- !
- ! !USES:
- use clm_varctl , only : irrigate
- use clm_varpar , only : cft_lb, cft_ub, cft_size
- use pftconMod , only : nc3crop, nc3irrig, npcropmax, pftcon
- !
- ! !ARGUMENTS:
-
- ! Note that we use begg and endg rather than 'bounds', because bounds may not be
- ! available yet when this is called
- integer, intent(in) :: begg ! Beginning grid cell index
- integer, intent(in) :: endg ! Ending grid cell index
-
- ! Weight and fertilizer of each CFT in each grid cell; dimensioned [g, cft_lb:cft_ub]
- ! This array is modified in-place
- real(r8), intent(inout) :: wt_cft(begg:, cft_lb:)
- real(r8), intent(inout) :: fert_cft(begg:, cft_lb:)
-
- logical, intent(in) :: verbose ! If true, print some extra information
- !
- ! !LOCAL VARIABLES:
- integer :: g
- integer :: m
- real(r8) :: wt_cft_to
- real(r8) :: wt_cft_from
- real(r8) :: wt_cft_merge
-
- character(len=*), parameter :: subname = 'collapse_crop_types'
- !-----------------------------------------------------------------------
-
- SHR_ASSERT_ALL((ubound(wt_cft) == (/endg, cft_ub/)), errMsg(sourcefile, __LINE__))
-
- if (cft_size <= 0) then
- call endrun(msg = subname//' can only be called if cft_size > 0' // &
- errMsg(sourcefile, __LINE__))
- end if
-
- ! ------------------------------------------------------------------------
- ! If not using irrigation, merge irrigated CFTs into rainfed CFTs
- ! ------------------------------------------------------------------------
-
- if (.not. irrigate) then
- if (verbose .and. masterproc) then
- write(iulog,*) trim(subname)//' crop=.T. and irrigate=.F., so merging irrigated pfts with rainfed'
- end if
-
- do g = begg, endg
- ! Left Hand Side: merged rainfed+irrigated crop pfts from nc3crop to
- ! npcropmax-1, stride 2
- ! Right Hand Side: rainfed crop pfts from nc3crop to npcropmax-1,
- ! stride 2
- ! plus irrigated crop pfts from nc3irrig to npcropmax,
- ! stride 2
- ! where stride 2 means "every other"
- wt_cft(g, nc3crop:npcropmax-1:2) = &
- wt_cft(g, nc3crop:npcropmax-1:2) + wt_cft(g, nc3irrig:npcropmax:2)
- wt_cft(g, nc3irrig:npcropmax:2) = 0._r8
- end do
-
- call check_sums_equal_1(wt_cft, begg, 'wt_cft', subname//': irrigation')
- end if
-
- ! ------------------------------------------------------------------------
- ! Merge CFTs into the list of crops that CLM knows how to model
- ! ------------------------------------------------------------------------
-
- if (verbose .and. masterproc) then
- write(iulog, *) trim(subname) // ' merging wheat, barley, and rye into temperate cereals'
- write(iulog, *) trim(subname) // ' clm knows how to model corn, temperate cereals, and soybean'
- write(iulog, *) trim(subname) // ' all other crops are lumped with the generic crop pft'
- end if
-
- do g = begg, endg
- do m = 1, npcropmax
- if (m /= pftcon%mergetoclmpft(m)) then
- wt_cft_to = wt_cft(g, pftcon%mergetoclmpft(m))
- wt_cft_from = wt_cft(g, m)
- wt_cft_merge = wt_cft_to + wt_cft_from
- wt_cft(g, pftcon%mergetoclmpft(m)) = wt_cft_merge
- wt_cft(g, m) = 0._r8
- if (wt_cft_merge > 0._r8) then
- fert_cft(g,pftcon%mergetoclmpft(m)) = (wt_cft_to * fert_cft(g,pftcon%mergetoclmpft(m)) + &
- wt_cft_from * fert_cft(g,m)) / wt_cft_merge
- end if
- end if
- end do
-
- end do
-
- call check_sums_equal_1(wt_cft, begg, 'wt_cft', subname//': mergetoclmpft')
-
- end subroutine collapse_crop_types
-
-
-end module surfrdUtilsMod
diff --git a/src/soilbiogeochem/SoilBiogeochemCarbonFluxType.F90 b/src/soilbiogeochem/SoilBiogeochemCarbonFluxType.F90
deleted file mode 100644
index d4d29625..00000000
--- a/src/soilbiogeochem/SoilBiogeochemCarbonFluxType.F90
+++ /dev/null
@@ -1,825 +0,0 @@
-module SoilBiogeochemCarbonFluxType
-
- 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 : ndecomp_cascade_transitions, ndecomp_pools, nlevcan
- use clm_varpar , only : nlevdecomp_full, nlevgrnd, nlevdecomp, nlevsoi
- use clm_varcon , only : spval, ispval, dzsoi_decomp
- use landunit_varcon , only : istsoil, istcrop, istdlak
- use SoilBiogeochemDecompCascadeConType , only : decomp_cascade_con
- use ColumnType , only : col
- use LandunitType , only : lun
- use clm_varctl , only : use_fates
-
- !
- ! !PUBLIC TYPES:
- implicit none
- private
- !
- type, public :: soilbiogeochem_carbonflux_type
-
- ! fire fluxes
- real(r8), pointer :: somc_fire_col (:) ! (gC/m2/s) carbon emissions due to peat burning
-
- ! decomposition fluxes
- real(r8), pointer :: decomp_cpools_sourcesink_col (:,:,:) ! change in decomposing c pools. Used to update concentrations concurrently with vertical transport (gC/m3/timestep)
- real(r8), pointer :: decomp_cascade_hr_vr_col (:,:,:) ! vertically-resolved het. resp. from decomposing C pools (gC/m3/s)
- real(r8), pointer :: decomp_cascade_hr_col (:,:) ! vertically-integrated (diagnostic) het. resp. from decomposing C pools (gC/m2/s)
- real(r8), pointer :: decomp_cascade_ctransfer_vr_col (:,:,:) ! vertically-resolved C transferred along deomposition cascade (gC/m3/s)
- real(r8), pointer :: decomp_cascade_ctransfer_col (:,:) ! vertically-integrated (diagnostic) C transferred along decomposition cascade (gC/m2/s)
- real(r8), pointer :: decomp_k_col (:,:,:) ! rate constant for decomposition (1./sec)
- real(r8), pointer :: hr_vr_col (:,:) ! (gC/m3/s) total vertically-resolved het. resp. from decomposing C pools
- real(r8), pointer :: o_scalar_col (:,:) ! fraction by which decomposition is limited by anoxia
- real(r8), pointer :: w_scalar_col (:,:) ! fraction by which decomposition is limited by moisture availability
- real(r8), pointer :: t_scalar_col (:,:) ! fraction by which decomposition is limited by temperature
- real(r8), pointer :: som_c_leached_col (:) ! (gC/m^2/s) total SOM C loss from vertical transport
- real(r8), pointer :: decomp_cpools_leached_col (:,:) ! (gC/m^2/s) C loss from vertical transport from each decomposing C pool
- real(r8), pointer :: decomp_cpools_transport_tendency_col (:,:,:) ! (gC/m^3/s) C tendency due to vertical transport in decomposing C pools
-
- ! nitrif_denitrif
- real(r8), pointer :: phr_vr_col (:,:) ! (gC/m3/s) potential hr (not N-limited)
- real(r8), pointer :: fphr_col (:,:) ! fraction of potential heterotrophic respiration
-
- real(r8), pointer :: hr_col (:) ! (gC/m2/s) total heterotrophic respiration
- real(r8), pointer :: lithr_col (:) ! (gC/m2/s) litter heterotrophic respiration
- real(r8), pointer :: somhr_col (:) ! (gC/m2/s) soil organic matter heterotrophic res
- real(r8), pointer :: soilc_change_col (:) ! (gC/m2/s) FUN used soil C
-
- ! fluxes to receive carbon inputs from FATES
- real(r8), pointer :: FATES_c_to_litr_lab_c_col (:,:) ! total labile litter coming from ED. gC/m3/s
- real(r8), pointer :: FATES_c_to_litr_cel_c_col (:,:) ! total cellulose litter coming from ED. gC/m3/s
- real(r8), pointer :: FATES_c_to_litr_lig_c_col (:,:) ! total lignin litter coming from ED. gC/m3/s
-
- contains
-
- procedure , public :: Init
- procedure , private :: InitAllocate
- procedure , private :: InitHistory
- procedure , private :: InitCold
- procedure , public :: Restart
- procedure , public :: SetValues
- procedure , public :: Summary
-
- end type soilbiogeochem_carbonflux_type
- !------------------------------------------------------------------------
-
-contains
-
- !------------------------------------------------------------------------
- subroutine Init(this, bounds, carbon_type)
-
- class(soilbiogeochem_carbonflux_type) :: this
- type(bounds_type), intent(in) :: bounds
- character(len=3) , intent(in) :: carbon_type ! one of ['c12', c13','c14']
-
- call this%InitAllocate ( bounds)
- call this%InitHistory ( bounds, carbon_type )
- call this%InitCold (bounds )
-
- end subroutine Init
-
- !------------------------------------------------------------------------
- subroutine InitAllocate(this, bounds)
- !
- ! !ARGUMENTS:
- class (soilbiogeochem_carbonflux_type) :: this
- type(bounds_type), intent(in) :: bounds
- !
- ! !LOCAL VARIABLES:
- integer :: begp,endp
- integer :: begc,endc
- !------------------------------------------------------------------------
-
- begp = bounds%begp; endp = bounds%endp
- begc = bounds%begc; endc = bounds%endc
-
- allocate(this%t_scalar_col (begc:endc,1:nlevdecomp_full)); this%t_scalar_col (:,:) =spval
- allocate(this%w_scalar_col (begc:endc,1:nlevdecomp_full)); this%w_scalar_col (:,:) =spval
- allocate(this%o_scalar_col (begc:endc,1:nlevdecomp_full)); this%o_scalar_col (:,:) =spval
- allocate(this%phr_vr_col (begc:endc,1:nlevdecomp_full)); this%phr_vr_col (:,:) =nan
- allocate(this%fphr_col (begc:endc,1:nlevgrnd)) ; this%fphr_col (:,:) =nan
- allocate(this%som_c_leached_col (begc:endc)) ; this%som_c_leached_col (:) =nan
- allocate(this%somc_fire_col (begc:endc)) ; this%somc_fire_col (:) =nan
- allocate(this%hr_vr_col (begc:endc,1:nlevdecomp_full)); this%hr_vr_col (:,:) =nan
-
- allocate(this%decomp_cpools_sourcesink_col(begc:endc,1:nlevdecomp_full,1:ndecomp_pools))
- this%decomp_cpools_sourcesink_col(:,:,:)= nan
-
- allocate(this%decomp_cascade_hr_vr_col(begc:endc,1:nlevdecomp_full,1:ndecomp_cascade_transitions))
- this%decomp_cascade_hr_vr_col(:,:,:)= spval
-
- allocate(this%decomp_cascade_hr_col(begc:endc,1:ndecomp_cascade_transitions))
- this%decomp_cascade_hr_col(:,:)= nan
-
- allocate(this%decomp_cascade_ctransfer_vr_col(begc:endc,1:nlevdecomp_full,1:ndecomp_cascade_transitions))
- this%decomp_cascade_ctransfer_vr_col(:,:,:)= nan
-
- allocate(this%decomp_cascade_ctransfer_col(begc:endc,1:ndecomp_cascade_transitions))
- this%decomp_cascade_ctransfer_col(:,:)= nan
-
- allocate(this%decomp_k_col(begc:endc,1:nlevdecomp_full,1:ndecomp_cascade_transitions))
- this%decomp_k_col(:,:,:)= spval
-
- allocate(this%decomp_cpools_leached_col(begc:endc,1:ndecomp_pools))
- this%decomp_cpools_leached_col(:,:)= nan
-
- allocate(this%decomp_cpools_transport_tendency_col(begc:endc,1:nlevdecomp_full,1:ndecomp_pools))
- this%decomp_cpools_transport_tendency_col(:,:,:)= nan
-
- allocate(this%hr_col (begc:endc)) ; this%hr_col (:) = nan
- allocate(this%lithr_col (begc:endc)) ; this%lithr_col (:) = nan
- allocate(this%somhr_col (begc:endc)) ; this%somhr_col (:) = nan
- allocate(this%soilc_change_col (begc:endc)) ; this%soilc_change_col (:) = nan
-
- if ( use_fates ) then
- ! initialize these variables to be zero rather than a bad number since they are not zeroed every timestep (due to a need for them to persist)
-
- allocate(this%FATES_c_to_litr_lab_c_col(begc:endc,1:nlevdecomp_full))
- this%FATES_c_to_litr_lab_c_col(begc:endc,1:nlevdecomp_full) = 0._r8
-
- allocate(this%FATES_c_to_litr_cel_c_col(begc:endc,1:nlevdecomp_full))
- this%FATES_c_to_litr_cel_c_col(begc:endc,1:nlevdecomp_full) = 0._r8
-
- allocate(this%FATES_c_to_litr_lig_c_col(begc:endc,1:nlevdecomp_full))
- this%FATES_c_to_litr_lig_c_col(begc:endc,1:nlevdecomp_full) = 0._r8
-
- endif
-
- end subroutine InitAllocate
-
- !------------------------------------------------------------------------
- subroutine InitHistory(this, bounds, carbon_type)
- !
- ! !DESCRIPTION:
- ! add history fields for all CN variables, always set as default='inactive'
- !
- ! !USES:
- use clm_varpar , only : ndecomp_cascade_transitions, ndecomp_pools
- use clm_varpar , only : nlevdecomp, nlevdecomp_full
- use clm_varctl , only : hist_wrtch4diag
- use histFileMod, only : hist_addfld1d, hist_addfld2d, hist_addfld_decomp
- !
- ! !ARGUMENTS:
- class(soilbiogeochem_carbonflux_type) :: this
- type(bounds_type) , intent(in) :: bounds
- character(len=3) , intent(in) :: carbon_type ! one of ['c12', c13','c14']
- !
- ! !LOCAL VARIABLES:
- integer :: k,l,ii,jj,c
- character(8) :: vr_suffix
- character(10) :: active
- integer :: begp,endp
- integer :: begc,endc
- character(24) :: fieldname
- character(100) :: longname
- real(r8), pointer :: data1dptr(:) ! temp. pointer for slicing larger arrays
- real(r8), pointer :: data2dptr(:,:) ! temp. pointer for slicing larger arrays
- !---------------------------------------------------------------------
-
- begp = bounds%begp; endp = bounds%endp
- begc = bounds%begc; endc = bounds%endc
-
- if (nlevdecomp > 1) then
- vr_suffix = "_vr"
- else
- vr_suffix = ""
- endif
-
- !-------------------------------
- ! C flux variables - native to column
- !-------------------------------
-
- ! add history fields for all CLAMP CN variables
-
- if (carbon_type == 'c12') then
-
- this%hr_col(begc:endc) = spval
- call hist_addfld1d (fname='HR', units='gC/m^2/s', &
- avgflag='A', long_name='total heterotrophic respiration', &
- ptr_col=this%hr_col, default='inactive')
-
- this%lithr_col(begc:endc) = spval
- call hist_addfld1d (fname='LITTERC_HR', units='gC/m^2/s', &
- avgflag='A', long_name='litter C heterotrophic respiration', &
- ptr_col=this%lithr_col, default='inactive')
-
- this%somhr_col(begc:endc) = spval
- call hist_addfld1d (fname='SOILC_HR', units='gC/m^2/s', &
- avgflag='A', long_name='soil C heterotrophic respiration', &
- ptr_col=this%somhr_col, default='inactive')
-
- if (hist_wrtch4diag) then
- this%fphr_col(begc:endc,1:nlevgrnd) = spval
- call hist_addfld_decomp (fname='FPHR'//trim(vr_suffix), units='unitless', type2d='levdcmp', &
- avgflag='A', long_name='fraction of potential HR due to N limitation', &
- ptr_col=this%fphr_col, default='inactive')
- end if
-
- this%somc_fire_col(begc:endc) = spval
- call hist_addfld1d (fname='SOMC_FIRE', units='gC/m^2/s', &
- avgflag='A', long_name='C loss due to peat burning', &
- ptr_col=this%somc_fire_col, default='inactive')
-
- do k = 1, ndecomp_pools
- ! decomposition k
- data2dptr => this%decomp_k_col(:,:,k)
- fieldname = 'K_'//trim(decomp_cascade_con%decomp_pool_name_history(k))
- longname = trim(decomp_cascade_con%decomp_pool_name_long(k))//' potential loss coefficient'
- call hist_addfld_decomp (fname=fieldname, units='1/s', type2d='levdcmp', &
- avgflag='A', long_name=longname, &
- ptr_col=data2dptr, default='inactive')
- end do
-
- this%decomp_cascade_hr_col(begc:endc,:) = spval
- this%decomp_cascade_hr_vr_col(begc:endc,:,:) = spval
- this%decomp_cascade_ctransfer_col(begc:endc,:) = spval
- this%decomp_cascade_ctransfer_vr_col(begc:endc,:,:) = spval
- do l = 1, ndecomp_cascade_transitions
-
- ! output the vertically integrated fluxes only as default
- !-- HR fluxes (none from CWD)
- if ( .not. decomp_cascade_con%is_cwd(decomp_cascade_con%cascade_donor_pool(l)) ) then
- data1dptr => this%decomp_cascade_hr_col(:,l)
- ! check to see if there are multiple pathways that include respiration, and if so, note that in the history file
- ii = 0
- do jj = 1, ndecomp_cascade_transitions
- if ( decomp_cascade_con%cascade_donor_pool(jj) == decomp_cascade_con%cascade_donor_pool(l) ) ii = ii+1
- end do
- if ( ii == 1 ) then
- fieldname = &
- trim(decomp_cascade_con%decomp_pool_name_history(decomp_cascade_con%cascade_donor_pool(l)))//'_HR'
- else
- fieldname = &
- trim(decomp_cascade_con%decomp_pool_name_history(decomp_cascade_con%cascade_donor_pool(l)))//'_HR_'//&
- trim(decomp_cascade_con%decomp_pool_name_short(decomp_cascade_con%cascade_receiver_pool(l)))
- endif
- longname = 'Het. Resp. from '//&
- trim(decomp_cascade_con%decomp_pool_name_long(decomp_cascade_con%cascade_donor_pool(l)))
- call hist_addfld1d (fname=fieldname, units='gC/m^2/s', &
- avgflag='A', long_name=longname, &
- ptr_col=data1dptr, default='inactive')
- endif
-
- !-- transfer fluxes (none from terminal pool, if present)
- if ( decomp_cascade_con%cascade_receiver_pool(l) /= 0 ) then
- data1dptr => this%decomp_cascade_ctransfer_col(:,l)
- fieldname = &
- trim(decomp_cascade_con%decomp_pool_name_history(decomp_cascade_con%cascade_donor_pool(l)))//'C_TO_'//&
- trim(decomp_cascade_con%decomp_pool_name_history(decomp_cascade_con%cascade_receiver_pool(l)))//'C'
- longname = 'decomp. of '//trim(decomp_cascade_con%decomp_pool_name_long(decomp_cascade_con%cascade_donor_pool(l)))//&
- ' C to '//trim(decomp_cascade_con%decomp_pool_name_long(decomp_cascade_con%cascade_receiver_pool(l)))//' C'
- call hist_addfld1d (fname=fieldname, units='gC/m^2/s', &
- avgflag='A', long_name=longname, &
- ptr_col=data1dptr, default='inactive')
- endif
-
- ! output the vertically resolved fluxes
- if ( nlevdecomp_full > 1 ) then
- !-- HR fluxes (none from CWD)
- if ( .not. decomp_cascade_con%is_cwd(decomp_cascade_con%cascade_donor_pool(l)) ) then
- data2dptr => this%decomp_cascade_hr_vr_col(:,:,l)
- ! check to see if there are multiple pathways that include respiration, and if so, note that in the history file
- ii = 0
- do jj = 1, ndecomp_cascade_transitions
- if ( decomp_cascade_con%cascade_donor_pool(jj) == decomp_cascade_con%cascade_donor_pool(l) ) ii = ii+1
- end do
- if ( ii == 1 ) then
- fieldname = &
- trim(decomp_cascade_con%decomp_pool_name_history(decomp_cascade_con%cascade_donor_pool(l)))&
- //'_HR'//trim(vr_suffix)
- else
- fieldname = &
- trim(decomp_cascade_con%decomp_pool_name_history(decomp_cascade_con%cascade_donor_pool(l)))//'_HR_'//&
- trim(decomp_cascade_con%decomp_pool_name_short(decomp_cascade_con%cascade_receiver_pool(l)))&
- //trim(vr_suffix)
- endif
- longname = 'Het. Resp. from '//&
- trim(decomp_cascade_con%decomp_pool_name_long(decomp_cascade_con%cascade_donor_pool(l)))
- call hist_addfld_decomp (fname=fieldname, units='gC/m^3/s', type2d='levdcmp', &
- avgflag='A', long_name=longname, &
- ptr_col=data2dptr, default='inactive')
- endif
-
- !-- transfer fluxes (none from terminal pool, if present)
- if ( decomp_cascade_con%cascade_receiver_pool(l) /= 0 ) then
- data2dptr => this%decomp_cascade_ctransfer_vr_col(:,:,l)
- fieldname = &
- trim(decomp_cascade_con%decomp_pool_name_history(decomp_cascade_con%cascade_donor_pool(l)))//'C_TO_'//&
- trim(decomp_cascade_con%decomp_pool_name_history(decomp_cascade_con%cascade_receiver_pool(l)))&
- //'C'//trim(vr_suffix)
- longname = 'decomp. of '//&
- trim(decomp_cascade_con%decomp_pool_name_long(decomp_cascade_con%cascade_donor_pool(l)))//&
- ' C to '//&
- trim(decomp_cascade_con%decomp_pool_name_long(decomp_cascade_con%cascade_receiver_pool(l)))//' C'
- call hist_addfld_decomp (fname=fieldname, units='gC/m^3/s', type2d='levdcmp', &
- avgflag='A', long_name=longname, &
- ptr_col=data2dptr, default='inactive')
- endif
- end if
-
- end do
-
- if ( nlevdecomp_full > 1 ) then
- data2dptr => this%t_scalar_col(begc:endc,1:nlevsoi)
- call hist_addfld_decomp (fname='T_SCALAR', units='unitless', type2d='levsoi', &
- avgflag='A', long_name='temperature inhibition of decomposition', &
- ptr_col=data2dptr, default='inactive')
-
- data2dptr => this%w_scalar_col(begc:endc,1:nlevsoi)
- call hist_addfld_decomp (fname='W_SCALAR', units='unitless', type2d='levsoi', &
- avgflag='A', long_name='Moisture (dryness) inhibition of decomposition', &
- ptr_col=data2dptr, default='inactive')
-
- data2dptr => this%o_scalar_col(begc:endc,1:nlevsoi)
- call hist_addfld_decomp (fname='O_SCALAR', units='unitless', type2d='levsoi', &
- avgflag='A', long_name='fraction by which decomposition is reduced due to anoxia', &
- ptr_col=data2dptr, default='inactive')
- end if
-
- this%som_c_leached_col(begc:endc) = spval
- call hist_addfld1d (fname='SOM_C_LEACHED', units='gC/m^2/s', &
- avgflag='A', long_name='total flux of C from SOM pools due to leaching', &
- ptr_col=this%som_c_leached_col, default='inactive')
-
- this%decomp_cpools_leached_col(begc:endc,:) = spval
- this%decomp_cpools_transport_tendency_col(begc:endc,:,:) = spval
- do k = 1, ndecomp_pools
- if ( .not. decomp_cascade_con%is_cwd(k) ) then
- data1dptr => this%decomp_cpools_leached_col(:,k)
- fieldname = 'M_'//trim(decomp_cascade_con%decomp_pool_name_history(k))//'C_TO_LEACHING'
- longname = trim(decomp_cascade_con%decomp_pool_name_long(k))//' C leaching loss'
- call hist_addfld1d (fname=fieldname, units='gC/m^2/s', &
- avgflag='A', long_name=longname, &
- ptr_col=data1dptr, default='inactive')
-
- data2dptr => this%decomp_cpools_transport_tendency_col(:,:,k)
- fieldname = trim(decomp_cascade_con%decomp_pool_name_history(k))//'C_TNDNCY_VERT_TRANSPORT'
- longname = trim(decomp_cascade_con%decomp_pool_name_long(k))//' C tendency due to vertical transport'
- call hist_addfld_decomp (fname=fieldname, units='gC/m^3/s', type2d='levdcmp', &
- avgflag='A', long_name=longname, &
- ptr_col=data2dptr, default='inactive')
- endif
- end do
-
- if ( nlevdecomp_full > 1 ) then
- data2dptr => this%hr_vr_col(begc:endc,1:nlevsoi)
- call hist_addfld2d (fname='HR_vr', units='gC/m^3/s', type2d='levsoi', &
- avgflag='A', long_name='total vertically resolved heterotrophic respiration', &
- ptr_col=data2dptr, default='inactive')
- endif
-
- end if
-
- !-------------------------------
- ! C13 flux variables - native to column
- !-------------------------------
-
- if ( carbon_type == 'c13' ) then
-
- this%hr_col(begc:endc) = spval
- call hist_addfld1d (fname='C13_HR', units='gC13/m^2/s', &
- avgflag='A', long_name='C13 total heterotrophic respiration', &
- ptr_col=this%hr_col, default='inactive')
-
- this%lithr_col(begc:endc) = spval
- call hist_addfld1d (fname='C13_LITTERC_HR', units='gC13/m^2/s', &
- avgflag='A', long_name='C13 fine root C litterfall to litter 3 C', &
- ptr_col=this%lithr_col, default='inactive')
-
- this%somhr_col(begc:endc) = spval
- call hist_addfld1d (fname='C13_SOILC_HR', units='gC13/m^2/s', &
- avgflag='A', long_name='C13 soil organic matter heterotrophic respiration', &
- ptr_col=this%somhr_col, default='inactive')
-
-
- this%decomp_cascade_hr_col(begc:endc,:) = spval
- this%decomp_cascade_hr_vr_col(begc:endc,:,:) = spval
- this%decomp_cascade_ctransfer_col(begc:endc,:) = spval
- this%decomp_cascade_ctransfer_vr_col(begc:endc,:,:) = spval
- do l = 1, ndecomp_cascade_transitions
- !-- HR fluxes (none from CWD)
- if ( .not. decomp_cascade_con%is_cwd(decomp_cascade_con%cascade_donor_pool(l)) ) then
- data2dptr => this%decomp_cascade_hr_vr_col(:,:,l)
- ! check to see if there are multiple pathways that include respiration, and if so, note that in the history file
- ii = 0
- do jj = 1, ndecomp_cascade_transitions
- if ( decomp_cascade_con%cascade_donor_pool(jj) == decomp_cascade_con%cascade_donor_pool(l) ) ii = ii+1
- end do
- if ( ii == 1 ) then
- fieldname = 'C13_'//trim(decomp_cascade_con%decomp_pool_name_history(decomp_cascade_con%cascade_donor_pool(l)))&
- //'_HR'//trim(vr_suffix)
- else
- fieldname = 'C13_'//trim(decomp_cascade_con%decomp_pool_name_history(decomp_cascade_con%cascade_donor_pool(l)))&
- //'_HR_'//&
- trim(decomp_cascade_con%decomp_pool_name_short(decomp_cascade_con%cascade_receiver_pool(l)))//&
- trim(vr_suffix)
- endif
- longname = 'C13 Het. Resp. from '&
- //trim(decomp_cascade_con%decomp_pool_name_long(decomp_cascade_con%cascade_donor_pool(l)))
- call hist_addfld_decomp (fname=fieldname, units='gC13/m^3', type2d='levdcmp', &
- avgflag='A', long_name=longname, &
- ptr_col=data2dptr, default='inactive')
- endif
- !-- transfer fluxes (none from terminal pool, if present)
- if ( decomp_cascade_con%cascade_receiver_pool(l) /= 0 ) then
- data2dptr => this%decomp_cascade_ctransfer_vr_col(:,:,l)
- fieldname = 'C13_'//&
- trim(decomp_cascade_con%decomp_pool_name_history(decomp_cascade_con%cascade_donor_pool(l)))&
- //'C_TO_'//&
- trim(decomp_cascade_con%decomp_pool_name_history(decomp_cascade_con%cascade_receiver_pool(l)))&
- //'C'//trim(vr_suffix)
- longname = 'C13 decomp. of '&
- //trim(decomp_cascade_con%decomp_pool_name_long(decomp_cascade_con%cascade_donor_pool(l)))&
- //' C to '//&
- trim(decomp_cascade_con%decomp_pool_name_long(decomp_cascade_con%cascade_receiver_pool(l)))//' C'
- call hist_addfld_decomp (fname=fieldname, units='gC13/m^3', type2d='levdcmp', &
- avgflag='A', long_name=longname, &
- ptr_col=data2dptr, default='inactive')
- endif
- end do
-
- end if
-
- !-------------------------------
- ! C14 flux variables - native to column
- !-------------------------------
-
- if (carbon_type == 'c14') then
-
- this%hr_col(begc:endc) = spval
- call hist_addfld1d (fname='C14_HR', units='gC14/m^2/s', &
- avgflag='A', long_name='C14 total heterotrophic respiration', &
- ptr_col=this%hr_col, default='inactive')
-
- this%lithr_col(begc:endc) = spval
- call hist_addfld1d (fname='C14_LITTERC_HR', units='gC14/m^2/s', &
- avgflag='A', long_name='C14 litter carbon heterotrophic respiration', &
- ptr_col=this%lithr_col, default='inactive')
-
- this%somhr_col(begc:endc) = spval
- call hist_addfld1d (fname='C14_SOILC_HR', units='gC14/m^2/s', &
- avgflag='A', long_name='C14 soil organic matter heterotrophic respiration', &
- ptr_col=this%somhr_col, default='inactive')
-
- this%decomp_cascade_hr_col(begc:endc,:) = spval
- this%decomp_cascade_hr_vr_col(begc:endc,:,:) = spval
- this%decomp_cascade_ctransfer_col(begc:endc,:) = spval
- this%decomp_cascade_ctransfer_vr_col(begc:endc,:,:) = spval
-
- do l = 1, ndecomp_cascade_transitions
- !-- HR fluxes (none from CWD)
- if ( .not. decomp_cascade_con%is_cwd(decomp_cascade_con%cascade_donor_pool(l)) ) then
- data2dptr => this%decomp_cascade_hr_vr_col(:,:,l)
-
- ! check to see if there are multiple pathways that include respiration, and if so, note that in the history file
- ii = 0
- do jj = 1, ndecomp_cascade_transitions
- if ( decomp_cascade_con%cascade_donor_pool(jj) == decomp_cascade_con%cascade_donor_pool(l) ) ii = ii+1
- end do
- if ( ii == 1 ) then
- fieldname = 'C14_'//trim(decomp_cascade_con%decomp_pool_name_history(decomp_cascade_con%cascade_donor_pool(l)))&
- //'_HR'//trim(vr_suffix)
- else
- fieldname = 'C14_'//&
- trim(decomp_cascade_con%decomp_pool_name_history(decomp_cascade_con%cascade_donor_pool(l)))&
- //'_HR_'//&
- trim(decomp_cascade_con%decomp_pool_name_short(decomp_cascade_con%cascade_receiver_pool(l)))&
- //trim(vr_suffix)
- endif
- longname = 'C14 Het. Resp. from '&
- //trim(decomp_cascade_con%decomp_pool_name_long(decomp_cascade_con%cascade_donor_pool(l)))
- call hist_addfld_decomp (fname=fieldname, units='gC14/m^3', type2d='levdcmp', &
- avgflag='A', long_name=longname, &
- ptr_col=data2dptr, default='inactive')
- endif
-
- !-- transfer fluxes (none from terminal pool, if present)
- if ( decomp_cascade_con%cascade_receiver_pool(l) /= 0 ) then
- data2dptr => this%decomp_cascade_ctransfer_vr_col(:,:,l)
-
- fieldname = 'C14_'//&
- trim(decomp_cascade_con%decomp_pool_name_history(decomp_cascade_con%cascade_donor_pool(l)))&
- //'C_TO_'//&
- trim(decomp_cascade_con%decomp_pool_name_history(decomp_cascade_con%cascade_receiver_pool(l)))&
- //'C'//trim(vr_suffix)
- longname = 'C14 decomp. of '&
- //trim(decomp_cascade_con%decomp_pool_name_long(decomp_cascade_con%cascade_donor_pool(l)))//&
- ' C to '//trim(decomp_cascade_con%decomp_pool_name_long(decomp_cascade_con%cascade_receiver_pool(l)))//' C'
- call hist_addfld_decomp (fname=fieldname, units='gC14/m^3', type2d='levdcmp', &
- avgflag='A', long_name=longname, &
- ptr_col=data2dptr, default='inactive')
- endif
- end do
-
- end if
-
- do c = bounds%begc, bounds%endc
- l = col%landunit(c)
-
- this%fphr_col(c,nlevdecomp+1:nlevgrnd) = 0._r8 !used to be in ch4Mod
- if (lun%itype(l) == istsoil .or. lun%itype(l) == istcrop) then
- this%fphr_col(c,nlevdecomp+1:nlevgrnd) = 0._r8
- else ! Inactive CH4 columns
- this%fphr_col(c,:) = spval
- end if
-
- end do
-
- if ( use_fates ) then
-
- call hist_addfld_decomp(fname='FATES_c_to_litr_lab_c', units='gC/m^3/s', type2d='levdcmp', &
- avgflag='A', long_name='litter labile carbon flux from FATES to BGC', &
- ptr_col=this%FATES_c_to_litr_lab_c_col, default='inactive')
-
- call hist_addfld_decomp(fname='FATES_c_to_litr_cel_c', units='gC/m^3/s', type2d='levdcmp', &
- avgflag='A', long_name='litter celluluse carbon flux from FATES to BGC', &
- ptr_col=this%FATES_c_to_litr_cel_c_col, default='inactive')
-
- call hist_addfld_decomp(fname='FATES_c_to_litr_lig_c', units='gC/m^3/s', type2d='levdcmp', &
- avgflag='A', long_name='litter lignin carbon flux from FATES to BGC', &
- ptr_col=this%FATES_c_to_litr_lig_c_col, default='inactive')
-
- endif
-
-
- end subroutine InitHistory
-
- !-----------------------------------------------------------------------
- subroutine InitCold(this, bounds)
- !
- ! !ARGUMENTS:
- class(soilbiogeochem_carbonflux_type) :: this
- type(bounds_type), intent(in) :: bounds
- !
- ! !LOCAL VARIABLES:
- integer :: c,l
- integer :: num_special_col ! number of good values in special_col filter
- integer :: special_col(bounds%endc-bounds%begc+1) ! special landunit filter - columns
- !-----------------------------------------------------------------------
-
- ! Set column filters
-
- num_special_col = 0
- do c = bounds%begc, bounds%endc
- l = col%landunit(c)
- if (lun%ifspecial(l)) then
- num_special_col = num_special_col + 1
- special_col(num_special_col) = c
- end if
- end do
-
- ! initialize fields for special filters
-
- call this%SetValues (num_column=num_special_col, filter_column=special_col, &
- value_column=0._r8)
-
- end subroutine InitCold
-
- !-----------------------------------------------------------------------
- subroutine Restart(this, bounds, ncid, flag)
- !
- ! !USES:
- use restUtilMod
- use ncdio_pio
- use clm_varctl, only : use_vertsoilc
- !
- ! !ARGUMENTS:
- class(soilbiogeochem_carbonflux_type) :: this
- type(bounds_type) , intent(in) :: bounds
- type(file_desc_t) , intent(inout) :: ncid ! netcdf id
- character(len=*) , intent(in) :: flag !'read', 'write', 'define'
- !
- ! local vars
- real(r8), pointer :: ptr1d(:) ! temp. pointers for slicing larger arrays
- real(r8), pointer :: ptr2d(:,:) ! temp. pointers for slicing larger arrays
- logical :: readvar
- !-----------------------------------------------------------------------
-
- !
- ! if FATES is enabled, need to restart the variables used to transfer from FATES to CLM as they
- ! are persistent between daily FATES dynamics calls and half-hourly CLM timesteps
- !
- if ( use_fates ) then
-
- if (use_vertsoilc) then
- ptr2d => this%FATES_c_to_litr_lab_c_col
- call restartvar(ncid=ncid, flag=flag, varname='FATES_c_to_litr_lab_c_col', xtype=ncd_double, &
- dim1name='column', dim2name='levgrnd', switchdim=.true., &
- long_name='', units='', &
- interpinic_flag='interp', readvar=readvar, data=ptr2d)
-
- ptr2d => this%FATES_c_to_litr_cel_c_col
- call restartvar(ncid=ncid, flag=flag, varname='FATES_c_to_litr_cel_c_col', xtype=ncd_double, &
- dim1name='column', dim2name='levgrnd', switchdim=.true., &
- long_name='', units='', &
- interpinic_flag='interp', readvar=readvar, data=ptr2d)
-
- ptr2d => this%FATES_c_to_litr_lig_c_col
- call restartvar(ncid=ncid, flag=flag, varname='FATES_c_to_litr_lig_c_col', xtype=ncd_double, &
- dim1name='column', dim2name='levgrnd', switchdim=.true., &
- long_name='', units='', &
- interpinic_flag='interp', readvar=readvar, data=ptr2d)
-
- else
- ptr1d => this%FATES_c_to_litr_lab_c_col(:,1)
- call restartvar(ncid=ncid, flag=flag, varname='FATES_c_to_litr_lab_c_col', xtype=ncd_double, &
- dim1name='column', long_name='', units='', &
- interpinic_flag='interp', readvar=readvar, data=ptr1d)
-
- ptr1d => this%FATES_c_to_litr_cel_c_col(:,1)
- call restartvar(ncid=ncid, flag=flag, varname='FATES_c_to_litr_cel_c_col', xtype=ncd_double, &
- dim1name='column', long_name='', units='', &
- interpinic_flag='interp', readvar=readvar, data=ptr1d)
-
- ptr1d => this%FATES_c_to_litr_lig_c_col(:,1)
- call restartvar(ncid=ncid, flag=flag, varname='FATES_c_to_litr_lig_c_col', xtype=ncd_double, &
- dim1name='column', long_name='', units='', &
- interpinic_flag='interp', readvar=readvar, data=ptr1d)
-
- end if
-
- end if
-
- end subroutine Restart
-
- !-----------------------------------------------------------------------
- subroutine SetValues ( this, num_column, filter_column, value_column)
- !
- ! !DESCRIPTION:
- ! Set carbon fluxes
- !
- ! !ARGUMENTS:
- class (soilbiogeochem_carbonflux_type) :: this
- integer , intent(in) :: num_column
- integer , intent(in) :: filter_column(:)
- real(r8), intent(in) :: value_column
- !
- ! !LOCAL VARIABLES:
- integer :: fi,i ! loop index
- integer :: j,k,l ! indices
- !------------------------------------------------------------------------
-
- do l = 1, ndecomp_cascade_transitions
- do j = 1, nlevdecomp_full
- do fi = 1,num_column
- i = filter_column(fi)
- this%decomp_cascade_hr_col(i,l) = value_column
- this%decomp_cascade_hr_vr_col(i,j,l) = value_column
- this%decomp_cascade_ctransfer_col(i,l) = value_column
- this%decomp_cascade_ctransfer_vr_col(i,j,l) = value_column
- this%decomp_k_col(i,j,l) = value_column
- end do
- end do
- end do
-
- do k = 1, ndecomp_pools
- do fi = 1,num_column
- i = filter_column(fi)
- this%decomp_cpools_leached_col(i,k) = value_column
- end do
- do j = 1, nlevdecomp_full
- do fi = 1,num_column
- i = filter_column(fi)
- this%decomp_cpools_transport_tendency_col(i,j,k) = value_column
- this%decomp_cpools_sourcesink_col(i,j,k) = value_column
- end do
- end do
- end do
-
- do j = 1, nlevdecomp_full
- do fi = 1,num_column
- i = filter_column(fi)
- this%hr_vr_col(i,j) = value_column
- end do
- end do
-
- do fi = 1,num_column
- i = filter_column(fi)
- this%hr_col(i) = value_column
- this%somc_fire_col(i) = value_column
- this%som_c_leached_col(i) = value_column
- this%somhr_col(i) = value_column
- this%lithr_col(i) = value_column
- this%soilc_change_col(i) = value_column
- end do
-
- ! NOTE: do not zero the fates to BGC C flux variables since they need to persist from the daily fates timestep s to the half-hourly BGC timesteps. I.e. FATES_c_to_litr_lab_c_col, FATES_c_to_litr_cel_c_col, FATES_c_to_litr_lig_c_col
-
- end subroutine SetValues
-
- !-----------------------------------------------------------------------
- subroutine Summary(this, bounds, num_soilc, filter_soilc)
- !
- ! !DESCRIPTION:
- ! On the radiation time step, column-level carbon summary calculations
- !
- ! !USES:
- ! !ARGUMENTS:
- class(soilbiogeochem_carbonflux_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
- !
- ! !LOCAL VARIABLES:
- integer :: c,j,k,l
- integer :: fc
- !-----------------------------------------------------------------------
-
- do fc = 1,num_soilc
- c = filter_soilc(fc)
- this%som_c_leached_col(c) = 0._r8
- end do
-
- ! vertically integrate HR and decomposition cascade fluxes
- do k = 1, ndecomp_cascade_transitions
- do j = 1,nlevdecomp
- do fc = 1,num_soilc
- c = filter_soilc(fc)
- this%decomp_cascade_hr_col(c,k) = &
- this%decomp_cascade_hr_col(c,k) + &
- this%decomp_cascade_hr_vr_col(c,j,k) * dzsoi_decomp(j)
-
- this%decomp_cascade_ctransfer_col(c,k) = &
- this%decomp_cascade_ctransfer_col(c,k) + &
- this%decomp_cascade_ctransfer_vr_col(c,j,k) * dzsoi_decomp(j)
- end do
- end do
- end do
-
- ! total heterotrophic respiration, vertically resolved (HR)
- do j = 1,nlevdecomp
- do fc = 1,num_soilc
- c = filter_soilc(fc)
- this%hr_vr_col(c,j) = 0._r8
- end do
- end do
- do k = 1, ndecomp_cascade_transitions
- do j = 1,nlevdecomp
- do fc = 1,num_soilc
- c = filter_soilc(fc)
- this%hr_vr_col(c,j) = &
- this%hr_vr_col(c,j) + &
- this%decomp_cascade_hr_vr_col(c,j,k)
- end do
- end do
- end do
-
- ! add up all vertical transport tendency terms and calculate total som leaching loss as the sum of these
- do l = 1, ndecomp_pools
- do fc = 1,num_soilc
- c = filter_soilc(fc)
- this%decomp_cpools_leached_col(c,l) = 0._r8
- end do
- do j = 1, nlevdecomp
- do fc = 1,num_soilc
- c = filter_soilc(fc)
- this%decomp_cpools_leached_col(c,l) = this%decomp_cpools_leached_col(c,l) + &
- this%decomp_cpools_transport_tendency_col(c,j,l) * dzsoi_decomp(j)
- end do
- end do
- do fc = 1,num_soilc
- c = filter_soilc(fc)
- this%som_c_leached_col(c) = this%som_c_leached_col(c) + this%decomp_cpools_leached_col(c,l)
- end do
- end do
-
- ! soil organic matter heterotrophic respiration
- associate(is_soil => decomp_cascade_con%is_soil) ! TRUE => pool is a soil pool
- do k = 1, ndecomp_cascade_transitions
- if ( is_soil(decomp_cascade_con%cascade_donor_pool(k)) ) then
- do fc = 1,num_soilc
- c = filter_soilc(fc)
- this%somhr_col(c) = this%somhr_col(c) + this%decomp_cascade_hr_col(c,k)
- end do
- end if
- end do
- end associate
-
- ! litter heterotrophic respiration (LITHR)
- associate(is_litter => decomp_cascade_con%is_litter) ! TRUE => pool is a litter pool
- do k = 1, ndecomp_cascade_transitions
- if ( is_litter(decomp_cascade_con%cascade_donor_pool(k)) ) then
- do fc = 1,num_soilc
- c = filter_soilc(fc)
- this%lithr_col(c) = this%lithr_col(c) + this%decomp_cascade_hr_col(c,k)
- end do
- end if
- end do
- end associate
-
- ! total heterotrophic respiration (HR)
- do fc = 1,num_soilc
- c = filter_soilc(fc)
-
- this%hr_col(c) = &
- this%lithr_col(c) + &
- this%somhr_col(c)
-
- end do
-
- end subroutine Summary
-
-end module SoilBiogeochemCarbonFluxType
-
-
diff --git a/src/soilbiogeochem/SoilBiogeochemCarbonStateType.F90 b/src/soilbiogeochem/SoilBiogeochemCarbonStateType.F90
deleted file mode 100644
index 7d2c814a..00000000
--- a/src/soilbiogeochem/SoilBiogeochemCarbonStateType.F90
+++ /dev/null
@@ -1,942 +0,0 @@
-module SoilBiogeochemCarbonStateType
-
- use shr_kind_mod , only : r8 => shr_kind_r8
- use shr_infnan_mod , only : nan => shr_infnan_nan, assignment(=)
- use shr_log_mod , only : errMsg => shr_log_errMsg
- use decompMod , only : bounds_type
- use clm_varpar , only : ndecomp_cascade_transitions, ndecomp_pools, nlevcan
- use clm_varpar , only : nlevdecomp_full, nlevdecomp, nlevsoi
- use clm_varcon , only : spval, ispval, dzsoi_decomp, zisoi, zsoi, c3_r2
- use clm_varctl , only : iulog, use_vertsoilc, spinup_state, use_fates
- use landunit_varcon , only : istcrop, istsoil
- use abortutils , only : endrun
- use spmdMod , only : masterproc
- use SoilBiogeochemDecompCascadeConType , only : decomp_cascade_con
- use LandunitType , only : lun
- use ColumnType , only : col
- use GridcellType , only : grc
- use SoilBiogeochemStateType , only : get_spinup_latitude_term
- !
- ! !PUBLIC TYPES:
- implicit none
- private
- !
- type, public :: soilbiogeochem_carbonstate_type
-
- ! all c pools involved in decomposition
- real(r8), pointer :: decomp_cpools_vr_col (:,:,:) ! (gC/m3) vertically-resolved decomposing (litter, cwd, soil) c pools
- real(r8), pointer :: ctrunc_vr_col (:,:) ! (gC/m3) vertically-resolved column-level sink for C truncation
-
- ! summary (diagnostic) state variables, not involved in mass balance
- real(r8), pointer :: ctrunc_col (:) ! (gC/m2) column-level sink for C truncation
- real(r8), pointer :: totlitc_col (:) ! (gC/m2) total litter carbon
- real(r8), pointer :: totlitc_1m_col (:) ! (gC/m2) total litter carbon to 1 meter
- real(r8), pointer :: totsomc_col (:) ! (gC/m2) total soil organic matter carbon
- real(r8), pointer :: totsomc_1m_col (:) ! (gC/m2) total soil organic matter carbon to 1 meter
- real(r8), pointer :: cwdc_col (:) ! (gC/m2) coarse woody debris C (diagnostic)
- real(r8), pointer :: decomp_cpools_1m_col (:,:) ! (gC/m2) Diagnostic: decomposing (litter, cwd, soil) c pools to 1 meter
- real(r8), pointer :: decomp_cpools_col (:,:) ! (gC/m2) decomposing (litter, cwd, soil) c pools
- real(r8), pointer :: dyn_cbal_adjustments_col (:) ! (gC/m2) adjustments to each column made in this timestep via dynamic column area adjustments (note: this variable only makes sense at the column-level: it is meaningless if averaged to the gridcell-level)
- integer :: restart_file_spinup_state ! spinup state as read from restart file, for determining whether to enter or exit spinup mode.
- real(r8) :: totvegcthresh ! threshold for total vegetation carbon to zero out decomposition pools
-
- contains
-
- procedure , public :: Init
- procedure , public :: SetValues
- procedure , public :: Restart
- procedure , public :: Summary
- procedure , public :: SetTotVgCThresh
- procedure , private :: InitAllocate
- procedure , private :: InitHistory
- procedure , private :: InitCold
-
-
- end type soilbiogeochem_carbonstate_type
-
- character(len=*), parameter, private :: sourcefile = &
- __FILE__
- !------------------------------------------------------------------------
-
-contains
-
- !------------------------------------------------------------------------
- subroutine Init(this, bounds, carbon_type, ratio, c12_soilbiogeochem_carbonstate_inst)
-
- class(soilbiogeochem_carbonstate_type) :: this
- type(bounds_type) , intent(in) :: bounds
- character(len=3) , intent(in) :: carbon_type
- real(r8) , intent(in) :: ratio
- type(soilbiogeochem_carbonstate_type) , intent(in), optional :: c12_soilbiogeochem_carbonstate_inst
-
- this%totvegcthresh = nan
- call this%InitAllocate ( bounds)
- call this%InitHistory ( bounds, carbon_type )
- if (present(c12_soilbiogeochem_carbonstate_inst)) then
- call this%InitCold ( bounds, ratio, c12_soilbiogeochem_carbonstate_inst )
- else
- call this%InitCold ( bounds, ratio)
- end if
-
- end subroutine Init
-
- !------------------------------------------------------------------------
- subroutine InitAllocate(this, bounds)
- !
- ! !ARGUMENTS:
- class (soilbiogeochem_carbonstate_type) :: this
- type(bounds_type), intent(in) :: bounds
- !
- ! !LOCAL VARIABLES:
- integer :: begc,endc
- !------------------------------------------------------------------------
-
- begc = bounds%begc; endc = bounds%endc
-
- allocate( this%decomp_cpools_col (begc :endc,1:ndecomp_pools)) ; this%decomp_cpools_col (:,:) = nan
- allocate( this%decomp_cpools_1m_col (begc :endc,1:ndecomp_pools)) ; this%decomp_cpools_1m_col (:,:) = nan
-
- allocate( this%ctrunc_vr_col(begc :endc,1:nlevdecomp_full)) ;
- this%ctrunc_vr_col (:,:) = nan
-
- allocate(this%decomp_cpools_vr_col(begc:endc,1:nlevdecomp_full,1:ndecomp_pools))
- this%decomp_cpools_vr_col(:,:,:)= nan
-
- allocate(this%ctrunc_col (begc :endc)) ; this%ctrunc_col (:) = nan
- if ( .not. use_fates ) then
- allocate(this%cwdc_col (begc :endc)) ; this%cwdc_col (:) = nan
- endif
- allocate(this%totlitc_col (begc :endc)) ; this%totlitc_col (:) = nan
- allocate(this%totsomc_col (begc :endc)) ; this%totsomc_col (:) = nan
- allocate(this%totlitc_1m_col (begc :endc)) ; this%totlitc_1m_col (:) = nan
- allocate(this%totsomc_1m_col (begc :endc)) ; this%totsomc_1m_col (:) = nan
- allocate(this%dyn_cbal_adjustments_col (begc:endc)) ; this%dyn_cbal_adjustments_col (:) = nan
-
- this%restart_file_spinup_state = huge(1)
-
- end subroutine InitAllocate
-
- !------------------------------------------------------------------------
- subroutine InitHistory(this, bounds, carbon_type)
- !
- ! !USES:
- use histFileMod, only : hist_addfld1d, hist_addfld2d, hist_addfld_decomp
- !
- ! !ARGUMENTS:
- class (soilbiogeochem_carbonstate_type) :: this
- type(bounds_type) , intent(in) :: bounds
- character(len=3) , intent(in) :: carbon_type
- !
- ! !LOCAL VARIABLES:
- integer :: l
- integer :: begc ,endc
- character(24) :: fieldname
- character(100) :: longname
- real(r8), pointer :: data1dptr(:) ! temp. pointer for slicing larger arrays
- real(r8), pointer :: data2dptr(:,:) ! temp. pointer for slicing larger arrays
- !------------------------------------------------------------------------
-
- begc = bounds%begc; endc = bounds%endc
-
- !-------------------------------
- ! C12 state variables - column
- !-------------------------------
-
- if (carbon_type == 'c12') then
-
- this%decomp_cpools_col(begc:endc,:) = spval
- do l = 1, ndecomp_pools
- if ( nlevdecomp_full > 1 ) then
- data2dptr => this%decomp_cpools_vr_col(:,1:nlevsoi,l)
- fieldname = trim(decomp_cascade_con%decomp_pool_name_history(l))//'C_vr'
- longname = trim(decomp_cascade_con%decomp_pool_name_history(l))//' C (vertically resolved)'
- call hist_addfld2d (fname=fieldname, units='gC/m^3', type2d='levsoi', &
- avgflag='A', long_name=longname, &
- ptr_col=data2dptr, default='inactive')
- endif
-
- data1dptr => this%decomp_cpools_col(:,l)
- fieldname = trim(decomp_cascade_con%decomp_pool_name_history(l))//'C'
- longname = trim(decomp_cascade_con%decomp_pool_name_history(l))//' C'
- call hist_addfld1d (fname=fieldname, units='gC/m^2', &
- avgflag='A', long_name=longname, &
- ptr_col=data1dptr, default='inactive')
-
- if ( nlevdecomp_full > 1 ) then
- data1dptr => this%decomp_cpools_1m_col(:,l)
- fieldname = trim(decomp_cascade_con%decomp_pool_name_history(l))//'C_1m'
- longname = trim(decomp_cascade_con%decomp_pool_name_history(l))//' C to 1 meter'
- call hist_addfld1d (fname=fieldname, units='gC/m^2', &
- avgflag='A', long_name=longname, &
- ptr_col=data1dptr, default='inactive')
- endif
- end do
-
- this%totlitc_col(begc:endc) = spval
- call hist_addfld1d (fname='TOTLITC', units='gC/m^2', &
- avgflag='A', long_name='total litter carbon', &
- ptr_col=this%totlitc_col, default='inactive')
-
- this%totsomc_col(begc:endc) = spval
- call hist_addfld1d (fname='TOTSOMC', units='gC/m^2', &
- avgflag='A', long_name='total soil organic matter carbon', &
- ptr_col=this%totsomc_col, default='inactive')
-
- if ( nlevdecomp_full > 1 ) then
- this%totlitc_1m_col(begc:endc) = spval
- call hist_addfld1d (fname='TOTLITC_1m', units='gC/m^2', &
- avgflag='A', long_name='total litter carbon to 1 meter depth', &
- ptr_col=this%totlitc_1m_col, default='inactive')
- end if
-
- if ( nlevdecomp_full > 1 ) then
- this%totsomc_1m_col(begc:endc) = spval
- call hist_addfld1d (fname='TOTSOMC_1m', units='gC/m^2', &
- avgflag='A', long_name='total soil organic matter carbon to 1 meter depth', &
- ptr_col=this%totsomc_1m_col, default='inactive')
- end if
-
- this%ctrunc_col(begc:endc) = spval
- call hist_addfld1d (fname='COL_CTRUNC', units='gC/m^2', &
- avgflag='A', long_name='column-level sink for C truncation', &
- ptr_col=this%ctrunc_col, default='inactive')
-
- this%dyn_cbal_adjustments_col(begc:endc) = spval
- call hist_addfld1d (fname='DYN_COL_SOIL_ADJUSTMENTS_C', units='gC/m^2', &
- avgflag='SUM', &
- long_name='Adjustments in soil carbon due to dynamic column areas; &
- &only makes sense at the column level: should not be averaged to gridcell', &
- ptr_col=this%dyn_cbal_adjustments_col, default='inactive')
-
- end if
-
- !-------------------------------
- ! C13 state variables - column
- !-------------------------------
-
- if ( carbon_type == 'c13' ) then
-
- this%decomp_cpools_vr_col(begc:endc,:,:) = spval
- do l = 1, ndecomp_pools
- if ( nlevdecomp_full > 1 ) then
- data2dptr => this%decomp_cpools_vr_col(:,1:nlevsoi,l)
- fieldname = 'C13_'//trim(decomp_cascade_con%decomp_pool_name_history(l))//'C_vr'
- longname = 'C13 '//trim(decomp_cascade_con%decomp_pool_name_history(l))//' C (vertically resolved)'
- call hist_addfld2d (fname=fieldname, units='gC13/m^3', type2d='levsoi', &
- avgflag='A', long_name=longname, &
- ptr_col=data2dptr, default='inactive')
- endif
-
- data1dptr => this%decomp_cpools_col(:,l)
- fieldname = 'C13_'//trim(decomp_cascade_con%decomp_pool_name_history(l))//'C'
- longname = 'C13 '//trim(decomp_cascade_con%decomp_pool_name_history(l))//' C'
- call hist_addfld1d (fname=fieldname, units='gC13/m^2', &
- avgflag='A', long_name=longname, &
- ptr_col=data1dptr, default='inactive')
- end do
-
- this%totlitc_col(begc:endc) = spval
- call hist_addfld1d (fname='C13_TOTLITC', units='gC13/m^2', &
- avgflag='A', long_name='C13 total litter carbon', &
- ptr_col=this%totlitc_col, default='inactive')
-
- this%totsomc_col(begc:endc) = spval
- call hist_addfld1d (fname='C13_TOTSOMC', units='gC13/m^2', &
- avgflag='A', long_name='C13 total soil organic matter carbon', &
- ptr_col=this%totsomc_col, default='inactive')
-
- if ( nlevdecomp_full > 1 ) then
- this%totlitc_1m_col(begc:endc) = spval
- call hist_addfld1d (fname='C13_TOTLITC_1m', units='gC13/m^2', &
- avgflag='A', long_name='C13 total litter carbon to 1 meter', &
- ptr_col=this%totlitc_1m_col, default='inactive')
- end if
-
- if ( nlevdecomp_full > 1 ) then
- this%totsomc_1m_col(begc:endc) = spval
- call hist_addfld1d (fname='C13_TOTSOMC_1m', units='gC13/m^2', &
- avgflag='A', long_name='C13 total soil organic matter carbon to 1 meter', &
- ptr_col=this%totsomc_1m_col, default='inactive')
- endif
-
- this%ctrunc_col(begc:endc) = spval
- call hist_addfld1d (fname='C13_COL_CTRUNC', units='gC13/m^2', &
- avgflag='A', long_name='C13 column-level sink for C truncation', &
- ptr_col=this%ctrunc_col, default='inactive')
-
- this%dyn_cbal_adjustments_col(begc:endc) = spval
- call hist_addfld1d (fname='C13_DYN_COL_SOIL_ADJUSTMENTS_C', units='gC13/m^2', &
- avgflag='SUM', &
- long_name='C13 adjustments in soil carbon due to dynamic column areas; &
- &only makes sense at the column level: should not be averaged to gridcell', &
- ptr_col=this%dyn_cbal_adjustments_col, default='inactive')
- endif
-
- !-------------------------------
- ! C14 state variables - column
- !-------------------------------
-
- if ( carbon_type == 'c14' ) then
-
- this%decomp_cpools_vr_col(begc:endc,:,:) = spval
- do l = 1, ndecomp_pools
- if ( nlevdecomp_full > 1 ) then
- data2dptr => this%decomp_cpools_vr_col(:,1:nlevsoi,l)
- fieldname = 'C14_'//trim(decomp_cascade_con%decomp_pool_name_history(l))//'C_vr'
- longname = 'C14 '//trim(decomp_cascade_con%decomp_pool_name_history(l))//' C (vertically resolved)'
- call hist_addfld2d (fname=fieldname, units='gC14/m^3', type2d='levsoi', &
- avgflag='A', long_name=longname, ptr_col=data2dptr, default='inactive')
- endif
-
- data1dptr => this%decomp_cpools_col(:,l)
- fieldname = 'C14_'//trim(decomp_cascade_con%decomp_pool_name_history(l))//'C'
- longname = 'C14 '//trim(decomp_cascade_con%decomp_pool_name_history(l))//' C'
- call hist_addfld1d (fname=fieldname, units='gC14/m^2', &
- avgflag='A', long_name=longname, ptr_col=data1dptr, default='inactive')
-
- if ( nlevdecomp_full > 1 ) then
- data1dptr => this%decomp_cpools_1m_col(:,l)
- fieldname = 'C14_'//trim(decomp_cascade_con%decomp_pool_name_history(l))//'C_1m'
- longname = 'C14_'//trim(decomp_cascade_con%decomp_pool_name_history(l))//' C to 1 meter'
- call hist_addfld1d (fname=fieldname, units='gC/m^2', &
- avgflag='A', long_name=longname, ptr_col=data1dptr, default='inactive')
- endif
- end do
-
- this%totlitc_col(begc:endc) = spval
- call hist_addfld1d (fname='C14_TOTLITC', units='gC14/m^2', &
- avgflag='A', long_name='C14 total litter carbon', &
- ptr_col=this%totlitc_col, default='inactive')
-
- this%totsomc_col(begc:endc) = spval
- call hist_addfld1d (fname='C14_TOTSOMC', units='gC14/m^2', &
- avgflag='A', long_name='C14 total soil organic matter carbon', &
- ptr_col=this%totsomc_col, default='inactive')
-
- if ( nlevdecomp_full > 1 ) then
- this%totlitc_1m_col(begc:endc) = spval
- call hist_addfld1d (fname='C14_TOTLITC_1m', units='gC14/m^2', &
- avgflag='A', long_name='C14 total litter carbon to 1 meter', &
- ptr_col=this%totlitc_1m_col, default='inactive')
-
- this%totsomc_1m_col(begc:endc) = spval
- call hist_addfld1d (fname='C14_TOTSOMC_1m', units='gC14/m^2', &
- avgflag='A', long_name='C14 total soil organic matter carbon to 1 meter', &
- ptr_col=this%totsomc_1m_col, default='inactive')
- endif
-
- this%ctrunc_col(begc:endc) = spval
- call hist_addfld1d (fname='C14_COL_CTRUNC', units='gC14/m^2', &
- avgflag='A', long_name='C14 column-level sink for C truncation', &
- ptr_col=this%ctrunc_col, default='inactive')
-
- this%dyn_cbal_adjustments_col(begc:endc) = spval
- call hist_addfld1d (fname='C14_DYN_COL_SOIL_ADJUSTMENTS_C', units='gC14/m^2', &
- avgflag='SUM', &
- long_name='C14 adjustments in soil carbon due to dynamic column areas; &
- &only makes sense at the column level: should not be averaged to gridcell', &
- ptr_col=this%dyn_cbal_adjustments_col, default='inactive')
- endif
-
- end subroutine InitHistory
-
- !-----------------------------------------------------------------------
- subroutine InitCold(this, bounds, ratio, c12_soilbiogeochem_carbonstate_inst)
- !
- ! !DESCRIPTION:
- ! Initializes time varying variables used only in coupled carbon-nitrogen mode (CN):
- !
- ! !USES:
- !
- ! !ARGUMENTS:
- class(soilbiogeochem_carbonstate_type) :: this
- type(bounds_type) , intent(in) :: bounds
- real(r8) , intent(in) :: ratio
- type(soilbiogeochem_carbonstate_type), intent(in), optional :: c12_soilbiogeochem_carbonstate_inst
- !
- ! !LOCAL VARIABLES:
- integer :: p,c,l,j,k
- integer :: fc ! filter index
- integer :: num_special_col ! number of good values in special_col filter
- integer :: special_col(bounds%endc-bounds%begc+1) ! special landunit filter - columns
- !-----------------------------------------------------------------------
-
- ! initialize column-level variables
-
- do c = bounds%begc, bounds%endc
- l = col%landunit(c)
-
- if (lun%itype(l) == istsoil .or. lun%itype(l) == istcrop) then
- if (.not. present(c12_soilbiogeochem_carbonstate_inst)) then !c12
-
- do j = 1, nlevdecomp
- do k = 1, ndecomp_pools
- if (zsoi(j) < decomp_cascade_con%initial_stock_soildepth ) then !! only initialize upper soil column
- this%decomp_cpools_vr_col(c,j,k) = decomp_cascade_con%initial_stock(k)
- else
- this%decomp_cpools_vr_col(c,j,k) = 0._r8
- endif
- end do
- this%ctrunc_vr_col(c,j) = 0._r8
- end do
- if ( nlevdecomp > 1 ) then
- do j = nlevdecomp+1, nlevdecomp_full
- do k = 1, ndecomp_pools
- this%decomp_cpools_vr_col(c,j,k) = 0._r8
- end do
- this%ctrunc_vr_col(c,j) = 0._r8
- end do
- end if
- this%decomp_cpools_col(c,1:ndecomp_pools) = decomp_cascade_con%initial_stock(1:ndecomp_pools)
- this%decomp_cpools_1m_col(c,1:ndecomp_pools) = decomp_cascade_con%initial_stock(1:ndecomp_pools)
-
- else
-
- do j = 1, nlevdecomp
- do k = 1, ndecomp_pools
- this%decomp_cpools_vr_col(c,j,k) = c12_soilbiogeochem_carbonstate_inst%decomp_cpools_vr_col(c,j,k) * ratio
- end do
- this%ctrunc_vr_col(c,j) = c12_soilbiogeochem_carbonstate_inst%ctrunc_vr_col(c,j) * ratio
- end do
- if ( nlevdecomp > 1 ) then
- do j = nlevdecomp+1, nlevdecomp_full
- do k = 1, ndecomp_pools
- this%decomp_cpools_vr_col(c,j,k) = 0._r8
- end do
- this%ctrunc_vr_col(c,j) = 0._r8
- end do
- end if
- do k = 1, ndecomp_pools
- this%decomp_cpools_col(c,k) = c12_soilbiogeochem_carbonstate_inst%decomp_cpools_col(c,k) * ratio
- this%decomp_cpools_1m_col(c,k) = c12_soilbiogeochem_carbonstate_inst%decomp_cpools_1m_col(c,k) * ratio
- end do
-
- endif
- end if
-
- if ( .not. use_fates ) then
- if (lun%itype(l) == istsoil .or. lun%itype(l) == istcrop) then
- if (present(c12_soilbiogeochem_carbonstate_inst)) then
- this%cwdc_col(c) = c12_soilbiogeochem_carbonstate_inst%cwdc_col(c) * ratio
- else
- this%cwdc_col(c) = 0._r8
- end if
- this%ctrunc_col(c) = 0._r8
- this%totlitc_col(c) = 0._r8
- this%totsomc_col(c) = 0._r8
- this%totlitc_1m_col(c) = 0._r8
- this%totsomc_1m_col(c) = 0._r8
- end if
- end if
- end do
-
- ! now loop through special filters and explicitly set the variables that
- ! have to be in place for biogeophysics
-
- ! Set column filters
-
- num_special_col = 0
- do c = bounds%begc, bounds%endc
- l = col%landunit(c)
- if (lun%ifspecial(l)) then
- num_special_col = num_special_col + 1
- special_col(num_special_col) = c
- end if
- end do
-
- ! initialize fields for special filters
-
- call this%SetValues (num_column=num_special_col, filter_column=special_col, value_column=0._r8)
-
- end subroutine InitCold
-
- !-----------------------------------------------------------------------
- subroutine Restart ( this, bounds, ncid, flag, carbon_type, totvegc_col, c12_soilbiogeochem_carbonstate_inst )
- !
- ! !DESCRIPTION:
- ! Read/write CN restart data for carbon state
- !
- ! !USES:
- use shr_infnan_mod , only : isnan => shr_infnan_isnan, nan => shr_infnan_nan, assignment(=)
- use clm_time_manager , only : is_restart, get_nstep
- use shr_const_mod , only : SHR_CONST_PDB
- use clm_varcon , only : c14ratio
- use restUtilMod
- use ncdio_pio
- !
- ! !ARGUMENTS:
- class (soilbiogeochem_carbonstate_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'
- character(len=3) , intent(in) :: carbon_type ! 'c12' or 'c13' or 'c14'
- real(r8) , intent(in) :: totvegc_col(bounds%begc:bounds%endc) ! (gC/m2) total
- ! vegetation carbon
- type(soilbiogeochem_carbonstate_type) , intent(in), optional :: c12_soilbiogeochem_carbonstate_inst
-
- !
- ! !LOCAL VARIABLES:
- integer :: i,j,k,l,c
- real(r8) :: m ! multiplier for the exit_spinup code
- real(r8), pointer :: ptr2d(:,:) ! temp. pointers for slicing larger arrays
- real(r8), pointer :: ptr1d(:) ! temp. pointers for slicing larger arrays
- character(len=128) :: varname ! temporary
- logical :: readvar
- integer :: idata
- logical :: exit_spinup = .false.
- logical :: enter_spinup = .false.
- ! flags for comparing the model and restart decomposition cascades
- integer :: decomp_cascade_state, restart_file_decomp_cascade_state
- !------------------------------------------------------------------------
-
- if (carbon_type == 'c12') then
-
- do k = 1, ndecomp_pools
- varname=trim(decomp_cascade_con%decomp_pool_name_restart(k))//'c'
- if (use_vertsoilc) then
- ptr2d => this%decomp_cpools_vr_col(:,:,k)
- call restartvar(ncid=ncid, flag=flag, varname=trim(varname)//"_vr", xtype=ncd_double, &
- dim1name='column', dim2name='levgrnd', switchdim=.true., &
- long_name='', units='', fill_value=spval, &
- interpinic_flag='interp', readvar=readvar, data=ptr2d)
- else
- ptr1d => this%decomp_cpools_vr_col(:,1,k) ! nlevdecomp = 1; so treat as 1D variable
- call restartvar(ncid=ncid, flag=flag, varname=varname, xtype=ncd_double, &
- dim1name='column', long_name='', units='', fill_value=spval, &
- interpinic_flag='interp' , readvar=readvar, data=ptr1d)
- end if
- if (flag=='read' .and. .not. readvar) then
- call endrun(msg='ERROR:: '//trim(varname)//' is required on an initialization dataset'//&
- errMsg(sourcefile, __LINE__))
- end if
- end do
-
- if (use_vertsoilc) then
- ptr2d => this%ctrunc_vr_col
- call restartvar(ncid=ncid, flag=flag, varname='col_ctrunc_vr', xtype=ncd_double, &
- dim1name='column', dim2name='levgrnd', switchdim=.true., &
- long_name='', units='', fill_value=spval, &
- interpinic_flag='interp', readvar=readvar, data=ptr2d)
- else
- ptr1d => this%ctrunc_vr_col(:,1) ! nlevdecomp = 1; so treat as 1D variable
- call restartvar(ncid=ncid, flag=flag, varname='col_ctrunc', xtype=ncd_double, &
- dim1name='column', long_name='', units='', fill_value=spval, &
- interpinic_flag='interp' , readvar=readvar, data=ptr1d)
- end if
- if (flag=='read' .and. .not. readvar) then
- call endrun(msg='ERROR:: '//trim(varname)//' is required on an initialization dataset'//&
- errMsg(sourcefile, __LINE__))
- end if
-
- end if
-
- !--------------------------------
- ! C13 column carbon state variables
- !--------------------------------
-
- if ( carbon_type == 'c13' ) then
-
- do k = 1, ndecomp_pools
- varname = trim(decomp_cascade_con%decomp_pool_name_restart(k))//'c_13'
- if (use_vertsoilc) then
- ptr2d => this%decomp_cpools_vr_col(:,:,k)
- call restartvar(ncid=ncid, flag=flag, varname=trim(varname)//"_vr", xtype=ncd_double, &
- dim1name='column', dim2name='levgrnd', switchdim=.true., &
- long_name='', units='', fill_value=spval, &
- interpinic_flag='interp', readvar=readvar, data=ptr2d)
- else
- ptr1d => this%decomp_cpools_vr_col(:,1,k) ! nlevdecomp = 1; so treat as 1D variable
- call restartvar(ncid=ncid, flag=flag, varname=varname, xtype=ncd_double, &
- dim1name='column', long_name='', units='', fill_value=spval, &
- interpinic_flag='interp' , readvar=readvar, data=ptr1d)
- end if
- if (flag=='read' .and. .not. readvar) then
- write(iulog,*) 'initializing soilbiogeochem_carbonstate_inst%decomp_cpools_vr_col' &
- // ' with atmospheric c13 value for: '//trim(varname)
- do i = bounds%begc,bounds%endc
- do j = 1, nlevdecomp
- if (this%decomp_cpools_vr_col(i,j,k) /= spval .and. .not. isnan(this%decomp_cpools_vr_col(i,j,k)) ) then
- this%decomp_cpools_vr_col(i,j,k) = c12_soilbiogeochem_carbonstate_inst%decomp_cpools_vr_col(i,j,k) * c3_r2
- endif
- end do
- end do
- end if
- end do
-
- if (use_vertsoilc) then
- ptr2d => this%ctrunc_vr_col
- call restartvar(ncid=ncid, flag=flag, varname="col_ctrunc_c13_vr", xtype=ncd_double, &
- dim1name='column', dim2name='levgrnd', switchdim=.true., &
- long_name='', units='', fill_value=spval, &
- interpinic_flag='interp', readvar=readvar, data=ptr2d)
- else
- ptr1d => this%ctrunc_vr_col(:,1)
- call restartvar(ncid=ncid, flag=flag, varname="col_ctrunc_c13", xtype=ncd_double, &
- dim1name='column', long_name='', units='', fill_value=spval, &
- interpinic_flag='interp' , readvar=readvar, data=ptr1d)
- end if
- end if
-
- !--------------------------------
- ! C14 column carbon state variables
- !--------------------------------
-
- if ( carbon_type == 'c14' ) then
-
- do k = 1, ndecomp_pools
- varname = trim(decomp_cascade_con%decomp_pool_name_restart(k))//'c_14'
- if (use_vertsoilc) then
- ptr2d => this%decomp_cpools_vr_col(:,:,k)
- call restartvar(ncid=ncid, flag=flag, varname=trim(varname)//"_vr", xtype=ncd_double, &
- dim1name='column', dim2name='levgrnd', switchdim=.true., &
- long_name='', units='', fill_value=spval, &
- interpinic_flag='interp', readvar=readvar, data=ptr2d)
- else
- ptr1d => this%decomp_cpools_vr_col(:,1,k) ! nlevdecomp = 1; so treat as 1D variable
- call restartvar(ncid=ncid, flag=flag, varname=varname, xtype=ncd_double, &
- dim1name='column', &
- long_name='', units='', fill_value=spval, &
- interpinic_flag='interp' , readvar=readvar, data=ptr1d)
- end if
- if (flag=='read' .and. .not. readvar) then
- write(iulog,*) 'initializing soilbiogeochem_carbonstate_inst%decomp_cpools_vr_col with atmospheric c14 value for: '//&
- trim(varname)
- do i = bounds%begc,bounds%endc
- do j = 1, nlevdecomp
- if (this%decomp_cpools_vr_col(i,j,k) /= spval .and. .not. isnan(this%decomp_cpools_vr_col(i,j,k)) ) then
- this%decomp_cpools_vr_col(i,j,k) = c12_soilbiogeochem_carbonstate_inst%decomp_cpools_vr_col(i,j,k) * c3_r2
- endif
- end do
- end do
- end if
- end do
-
- if (use_vertsoilc) then
- ptr2d => this%ctrunc_vr_col
- call restartvar(ncid=ncid, flag=flag, varname="col_ctrunc_c14_vr", xtype=ncd_double, &
- dim1name='column', dim2name='levgrnd', switchdim=.true., &
- long_name='', units='', fill_value=spval, &
- interpinic_flag='interp', readvar=readvar, data=ptr2d)
- else
- ptr1d => this%ctrunc_vr_col(:,1)
- call restartvar(ncid=ncid, flag=flag, varname="col_ctrunc_c14", xtype=ncd_double, &
- dim1name='column', long_name='', units='', fill_value=spval, &
- interpinic_flag='interp' , readvar=readvar, data=ptr1d)
- end if
-
- end if
-
- !--------------------------------
- ! Spinup state
- !--------------------------------
-
-
- if (carbon_type == 'c12') then
- if (flag == 'write') idata = spinup_state
- call restartvar(ncid=ncid, flag=flag, varname='spinup_state', xtype=ncd_int, &
- long_name='Spinup state of the model that wrote this restart file: ' &
- // ' 0 = normal model mode, 1 = AD spinup', units='', &
- interpinic_flag='copy', readvar=readvar, data=idata)
- if (flag == 'read') then
- if (readvar) then
- this%restart_file_spinup_state = idata
- else
- call endrun(msg=' CNRest: spinup_state was not on the restart file and is required' // &
- errMsg(sourcefile, __LINE__))
- end if
- end if
- else
- this%restart_file_spinup_state = c12_soilbiogeochem_carbonstate_inst%restart_file_spinup_state
- endif
-
- ! now compare the model and restart file spinup states, and either take the
- ! model into spinup mode or out of it if they are not identical
- ! taking model out of spinup mode requires multiplying each decomposing pool
- ! by the associated AD factor.
- ! putting model into spinup mode requires dividing each decomposing pool
- ! by the associated AD factor.
- ! only allow this to occur on first timestep of model run.
-
- if (flag == 'read' .and. spinup_state /= this%restart_file_spinup_state ) then
- if (spinup_state == 0 .and. this%restart_file_spinup_state >= 1 ) then
- if ( masterproc ) write(iulog,*) ' CNRest: taking ',carbon_type,' SOM pools out of AD spinup mode'
- exit_spinup = .true.
- else if (spinup_state >= 1 .and. this%restart_file_spinup_state == 0 ) then
- if ( masterproc ) write(iulog,*) ' CNRest: taking ',carbon_type,' SOM pools into AD spinup mode'
- enter_spinup = .true.
- else
- call endrun(msg=' CNRest: error in entering/exiting spinup. spinup_state ' &
- // ' != restart_file_spinup_state, but do not know what to do'//&
- errMsg(sourcefile, __LINE__))
- end if
- if (get_nstep() >= 2) then
- call endrun(msg=' CNRest: error in entering/exiting spinup - should occur only when nstep = 1'//&
- errMsg(sourcefile, __LINE__))
- endif
- if ( exit_spinup .and. isnan(this%totvegcthresh) )then
- call endrun(msg=' CNRest: error in exit spinup - totvegcthresh was not set with SetTotVgCThresh'//&
- errMsg(sourcefile, __LINE__))
- end if
- do k = 1, ndecomp_pools
- if ( exit_spinup ) then
- m = decomp_cascade_con%spinup_factor(k)
- else if ( enter_spinup ) then
- m = 1. / decomp_cascade_con%spinup_factor(k)
- end if
- do c = bounds%begc, bounds%endc
- l = col%landunit(c)
- do j = 1, nlevdecomp_full
- if ( abs(m - 1._r8) .gt. 0.000001_r8 .and. exit_spinup) then
- this%decomp_cpools_vr_col(c,j,k) = this%decomp_cpools_vr_col(c,j,k) * m * &
- get_spinup_latitude_term(grc%latdeg(col%gridcell(c)))
- ! If there is no vegetation carbon, implying that all vegetation has died, then
- ! reset decomp pools to near zero during exit_spinup to avoid very
- ! large and inert soil carbon stocks; note that only pools with spinup factor > 1
- ! will be affected, which means that total SOMC and LITC pools will not be set to 0.
- if (totvegc_col(c) <= this%totvegcthresh .and. lun%itype(l) /= istcrop) then
- this%decomp_cpools_vr_col(c,j,k) = 0.0_r8
- endif
- elseif ( abs(m - 1._r8) .gt. 0.000001_r8 .and. enter_spinup) then
- this%decomp_cpools_vr_col(c,j,k) = this%decomp_cpools_vr_col(c,j,k) * m / &
- get_spinup_latitude_term(grc%latdeg(col%gridcell(c)))
- else
- this%decomp_cpools_vr_col(c,j,k) = this%decomp_cpools_vr_col(c,j,k) * m
- endif
- end do
- end do
- end do
- end if
-
- end subroutine Restart
-
- !-----------------------------------------------------------------------
- subroutine SetValues ( this, num_column, filter_column, value_column)
- !
- ! !DESCRIPTION:
- ! Set carbon state variables
- !
- ! !ARGUMENTS:
- class (soilbiogeochem_carbonstate_type) :: this
- integer , intent(in) :: num_column
- integer , intent(in) :: filter_column(:)
- real(r8), intent(in) :: value_column
- !
- ! !LOCAL VARIABLES:
- integer :: fi,i,j,k,l ! loop index
- !------------------------------------------------------------------------
-
- do fi = 1,num_column
- i = filter_column(fi)
- if ( .not. use_fates ) then
- this%cwdc_col(i) = value_column
- end if
- this%ctrunc_col(i) = value_column
- this%totlitc_col(i) = value_column
- this%totlitc_1m_col(i) = value_column
- this%totsomc_col(i) = value_column
- this%totsomc_1m_col(i) = value_column
- end do
-
- do j = 1,nlevdecomp_full
- do fi = 1,num_column
- i = filter_column(fi)
- this%ctrunc_vr_col(i,j) = value_column
- end do
- end do
-
- do k = 1, ndecomp_pools
- do fi = 1,num_column
- i = filter_column(fi)
- this%decomp_cpools_col(i,k) = value_column
- this%decomp_cpools_1m_col(i,k) = value_column
- end do
- end do
-
- do j = 1,nlevdecomp_full
- do k = 1, ndecomp_pools
- do fi = 1,num_column
- i = filter_column(fi)
- this%decomp_cpools_vr_col(i,j,k) = value_column
- end do
- end do
- end do
-
- end subroutine SetValues
-
- !-----------------------------------------------------------------------
- subroutine Summary(this, bounds, num_allc, filter_allc)
- !
- ! !DESCRIPTION:
- ! Perform column-level carbon summary calculations
- !
- ! !ARGUMENTS:
- class(soilbiogeochem_carbonstate_type) :: this
- type(bounds_type) , intent(in) :: bounds
- integer , intent(in) :: num_allc ! number of columns in allc filter
- integer , intent(in) :: filter_allc(:) ! filter for all active columns
- !
- ! !LOCAL VARIABLES:
- integer :: c,j,k,l ! indices
- integer :: fc ! filter indices
- real(r8) :: maxdepth ! depth to integrate soil variables
- !-----------------------------------------------------------------------
-
- ! vertically integrate each of the decomposing C pools
- do l = 1, ndecomp_pools
- do fc = 1,num_allc
- c = filter_allc(fc)
- this%decomp_cpools_col(c,l) = 0._r8
- end do
- end do
- do l = 1, ndecomp_pools
- do j = 1, nlevdecomp
- do fc = 1,num_allc
- c = filter_allc(fc)
- this%decomp_cpools_col(c,l) = &
- this%decomp_cpools_col(c,l) + &
- this%decomp_cpools_vr_col(c,j,l) * dzsoi_decomp(j)
- end do
- end do
- end do
-
- if ( nlevdecomp > 1) then
-
- ! vertically integrate each of the decomposing C pools to 1 meter
- maxdepth = 1._r8
- do l = 1, ndecomp_pools
- do fc = 1,num_allc
- c = filter_allc(fc)
- this%decomp_cpools_1m_col(c,l) = 0._r8
- end do
- end do
- do l = 1, ndecomp_pools
- do j = 1, nlevdecomp
- if ( zisoi(j) <= maxdepth ) then
- do fc = 1,num_allc
- c = filter_allc(fc)
- this%decomp_cpools_1m_col(c,l) = &
- this%decomp_cpools_1m_col(c,l) + &
- this%decomp_cpools_vr_col(c,j,l) * dzsoi_decomp(j)
- end do
- elseif ( zisoi(j-1) < maxdepth ) then
- do fc = 1,num_allc
- c = filter_allc(fc)
- this%decomp_cpools_1m_col(c,l) = &
- this%decomp_cpools_1m_col(c,l) + &
- this%decomp_cpools_vr_col(c,j,l) * (maxdepth - zisoi(j-1))
- end do
- endif
- end do
- end do
-
- endif
-
- ! truncation carbon
- do fc = 1,num_allc
- c = filter_allc(fc)
- this%ctrunc_col(c) = 0._r8
- end do
- do j = 1, nlevdecomp
- do fc = 1,num_allc
- c = filter_allc(fc)
- this%ctrunc_col(c) = &
- this%ctrunc_col(c) + &
- this%ctrunc_vr_col(c,j) * dzsoi_decomp(j)
- end do
- end do
-
- ! total litter carbon in the top meter (TOTLITC_1m)
- if ( nlevdecomp > 1) then
- do fc = 1,num_allc
- c = filter_allc(fc)
- this%totlitc_1m_col(c) = 0._r8
- end do
- do l = 1, ndecomp_pools
- if ( decomp_cascade_con%is_litter(l) ) then
- do fc = 1,num_allc
- c = filter_allc(fc)
- this%totlitc_1m_col(c) = this%totlitc_1m_col(c) + &
- this%decomp_cpools_1m_col(c,l)
- end do
- endif
- end do
- end if
-
- ! total soil organic matter carbon in the top meter (TOTSOMC_1m)
- if ( nlevdecomp > 1) then
- do fc = 1,num_allc
- c = filter_allc(fc)
- this%totsomc_1m_col(c) = 0._r8
- end do
- do l = 1, ndecomp_pools
- if ( decomp_cascade_con%is_soil(l) ) then
- do fc = 1,num_allc
- c = filter_allc(fc)
- this%totsomc_1m_col(c) = this%totsomc_1m_col(c) + this%decomp_cpools_1m_col(c,l)
- end do
- end if
- end do
- end if
-
- ! total litter carbon (TOTLITC)
- do fc = 1,num_allc
- c = filter_allc(fc)
- this%totlitc_col(c) = 0._r8
- end do
- do l = 1, ndecomp_pools
- if ( decomp_cascade_con%is_litter(l) ) then
- do fc = 1,num_allc
- c = filter_allc(fc)
- this%totlitc_col(c) = this%totlitc_col(c) + this%decomp_cpools_col(c,l)
- end do
- endif
- end do
-
- ! total soil organic matter carbon (TOTSOMC)
- do fc = 1,num_allc
- c = filter_allc(fc)
- this%totsomc_col(c) = 0._r8
- end do
- do l = 1, ndecomp_pools
- if ( decomp_cascade_con%is_soil(l) ) then
- do fc = 1,num_allc
- c = filter_allc(fc)
- this%totsomc_col(c) = this%totsomc_col(c) + this%decomp_cpools_col(c,l)
- end do
- end if
- end do
-
- ! coarse woody debris carbon
- if (.not. use_fates ) then
- do fc = 1,num_allc
- c = filter_allc(fc)
- this%cwdc_col(c) = 0._r8
- end do
- do l = 1, ndecomp_pools
- if ( decomp_cascade_con%is_cwd(l) ) then
- do fc = 1,num_allc
- c = filter_allc(fc)
- this%cwdc_col(c) = this%cwdc_col(c) + this%decomp_cpools_col(c,l)
- end do
- end if
- end do
-
- end if
-
- end subroutine Summary
-
- !------------------------------------------------------------------------
- subroutine SetTotVgCThresh(this, totvegcthresh)
-
- class(soilbiogeochem_carbonstate_type) :: this
- real(r8) , intent(in) :: totvegcthresh
-
- if ( totvegcthresh <= 0.0_r8 )then
- call endrun(msg=' ERROR totvegcthresh is zero or negative and should be > 0'//&
- errMsg(sourcefile, __LINE__))
- end if
- this%totvegcthresh = totvegcthresh
-
- end subroutine SetTotVgCThresh
-
-end module SoilBiogeochemCarbonStateType
diff --git a/src/soilbiogeochem/SoilBiogeochemDecompCascadeBGCMod.F90 b/src/soilbiogeochem/SoilBiogeochemDecompCascadeBGCMod.F90
deleted file mode 100644
index e636fd30..00000000
--- a/src/soilbiogeochem/SoilBiogeochemDecompCascadeBGCMod.F90
+++ /dev/null
@@ -1,578 +0,0 @@
-module SoilBiogeochemDecompCascadeBGCMod
-
- !-----------------------------------------------------------------------
- ! !DESCRIPTION:
- ! Sets the coeffiecients used in the decomposition cascade submodel.
- ! This uses the CENTURY/BGC parameters
- !
- ! !USES:
- use shr_kind_mod , only : r8 => shr_kind_r8
- use shr_const_mod , only : SHR_CONST_TKFRZ
- use shr_log_mod , only : errMsg => shr_log_errMsg
- use clm_varpar , only : nlevsoi, nlevgrnd, nlevdecomp, ndecomp_cascade_transitions, ndecomp_pools
- use clm_varpar , only : i_met_lit, i_cel_lit, i_lig_lit, i_cwd
- use clm_varctl , only : iulog, spinup_state, anoxia, use_vertsoilc, use_fates
- use clm_varcon , only : zsoi
- use decompMod , only : bounds_type
- use spmdMod , only : masterproc
- use abortutils , only : endrun
- use CNSharedParamsMod , only : CNParamsShareInst, anoxia_wtsat, nlev_soildecomp_standard
- use SoilBiogeochemDecompCascadeConType , only : decomp_cascade_con
- use SoilBiogeochemStateType , only : soilbiogeochem_state_type
- use SoilBiogeochemCarbonFluxType , only : soilbiogeochem_carbonflux_type
- use SoilStateType , only : soilstate_type
- use CanopyStateType , only : canopystate_type
- use TemperatureType , only : temperature_type
- use ch4Mod , only : ch4_type
- use ColumnType , only : col
- use GridcellType , only : grc
- use SoilBiogeochemStateType , only : get_spinup_latitude_term
-
- !
- implicit none
- private
- !
- ! !PUBLIC MEMBER FUNCTIONS:
- public :: readParams ! Read in parameters from params file
- public :: init_decompcascade_bgc ! Initialization
- !
- ! !PUBLIC DATA MEMBERS
- logical , public :: normalize_q10_to_century_tfunc = .true.! do we normalize the century decomp. rates so that they match the CLM Q10 at a given tep?
- logical , public :: use_century_tfunc = .false.
- real(r8), public :: normalization_tref = 15._r8 ! reference temperature for normalizaion (degrees C)
- !
- ! !PRIVATE DATA MEMBERS
-
- integer, private :: i_soil1 = -9 ! Soil Organic Matter (SOM) first pool
- integer, private :: i_soil2 = -9 ! SOM second pool
- integer, private :: i_soil3 = -9 ! SOM third pool
- integer, private, parameter :: nsompools = 3 ! Number of SOM pools
- integer, private, parameter :: i_litr1 = i_met_lit ! First litter pool, metobolic
- integer, private, parameter :: i_litr2 = i_cel_lit ! Second litter pool, cellulose
- integer, private, parameter :: i_litr3 = i_lig_lit ! Third litter pool, lignin
-
- type, private :: params_type
- 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) :: 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
- real(r8) :: maxpsi_bgc !maximum soil water potential for heterotrophic resp
-
- real(r8) :: initial_Cstocks(nsompools) ! Initial Carbon stocks for a cold-start
- real(r8) :: initial_Cstocks_depth ! Soil depth for initial Carbon stocks for a cold-start
-
- end type params_type
- !
- type(params_type), private :: params_inst
-
- character(len=*), parameter, private :: sourcefile = &
- __FILE__
-
- !-----------------------------------------------------------------------
-
-contains
-
- !-----------------------------------------------------------------------
- subroutine readParams ( ncid )
- !
- ! !DESCRIPTION:
- !
- ! !USES:
- use ncdio_pio , only: file_desc_t,ncd_io
- !
- ! !ARGUMENTS:
- type(file_desc_t),intent(inout) :: ncid ! pio netCDF file id
- !
- ! !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
- !-----------------------------------------------------------------------
-
- ! 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(sourcefile, __LINE__))
- params_inst%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(sourcefile, __LINE__))
- params_inst%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(sourcefile, __LINE__))
- params_inst%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(sourcefile, __LINE__))
- params_inst%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(sourcefile, __LINE__))
- params_inst%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(sourcefile, __LINE__))
- params_inst%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(sourcefile, __LINE__))
- params_inst%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(sourcefile, __LINE__))
- params_inst%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(sourcefile, __LINE__))
- params_inst%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(sourcefile, __LINE__))
- params_inst%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(sourcefile, __LINE__))
- params_inst%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(sourcefile, __LINE__))
- params_inst%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(sourcefile, __LINE__))
- params_inst%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(sourcefile, __LINE__))
- params_inst%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(sourcefile, __LINE__))
- params_inst%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(sourcefile, __LINE__))
- params_inst%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(sourcefile, __LINE__))
- params_inst%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(sourcefile, __LINE__))
- params_inst%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(sourcefile, __LINE__))
- params_inst%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(sourcefile, __LINE__))
- params_inst%minpsi_bgc=tempr
-
- tString='maxpsi_hr'
- call ncd_io(trim(tString),tempr, 'read', ncid, readvar=readv)
- if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__))
- params_inst%maxpsi_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(sourcefile, __LINE__))
- params_inst%cwd_flig_bgc=tempr
-
- end subroutine readParams
-
- !-----------------------------------------------------------------------
- subroutine init_decompcascade_bgc(bounds, soilbiogeochem_state_inst, soilstate_inst )
- !
- ! !DESCRIPTION:
- ! initialize rate constants and decomposition pathways following the decomposition cascade of the BGC model.
- ! written by C. Koven
- !
- ! !USES:
- use clm_time_manager , only : get_step_size
- !
- ! !ARGUMENTS:
- type(bounds_type) , intent(in) :: bounds
- type(soilbiogeochem_state_type) , intent(inout) :: soilbiogeochem_state_inst
- type(soilstate_type) , intent(in) :: soilstate_inst
- !
- ! !LOCAL VARIABLES
- !-- properties of each decomposing pool
- real(r8) :: rf_l1s1
- real(r8) :: rf_l2s1
- real(r8) :: rf_l3s2
- !real(r8) :: rf_s1s2(bounds%begc:bounds%endc,1:nlevdecomp)
- !real(r8) :: rf_s1s3(bounds%begc:bounds%endc,1:nlevdecomp)
- real(r8), allocatable :: rf_s1s2(:,:)
- real(r8), allocatable :: rf_s1s3(:,:)
- real(r8) :: rf_s2s1
- real(r8) :: rf_s2s3
- real(r8) :: rf_s3s1
- real(r8) :: rf_cwdl2
- real(r8) :: rf_cwdl3
- real(r8) :: cwd_fcel
- real(r8) :: cwd_flig
- real(r8) :: cn_s1
- real(r8) :: cn_s2
- real(r8) :: cn_s3
- !real(r8) :: f_s1s2(bounds%begc:bounds%endc,1:nlevdecomp)
- !real(r8) :: f_s1s3(bounds%begc:bounds%endc,1:nlevdecomp)
- real(r8), allocatable :: f_s1s2(:,:)
- real(r8), allocatable :: f_s1s3(:,:)
- real(r8) :: f_s2s1
- real(r8) :: f_s2s3
-
- integer :: i_l1s1
- integer :: i_l2s1
- integer :: i_l3s2
- integer :: i_s1s2
- integer :: i_s1s3
- integer :: i_s2s1
- integer :: i_s2s3
- integer :: i_s3s1
- integer :: i_cwdl2
- integer :: i_cwdl3
- real(r8):: speedup_fac ! acceleration factor, higher when vertsoilc = .true.
-
- integer :: c, j ! indices
- real(r8) :: t ! temporary variable
- !-----------------------------------------------------------------------
-
- associate( &
- rf_decomp_cascade => soilbiogeochem_state_inst%rf_decomp_cascade_col , & ! Input: [real(r8) (:,:,:) ] respired fraction in decomposition step (frac)
- pathfrac_decomp_cascade => soilbiogeochem_state_inst%pathfrac_decomp_cascade_col , & ! Input: [real(r8) (:,:,:) ] what fraction of C leaving a given pool passes through a given transition (frac)
-
- cellsand => soilstate_inst%cellsand_col , & ! Input: [real(r8) (:,:) ] column 3D sand
-
- cascade_step_name => decomp_cascade_con%cascade_step_name , & ! Output: [character(len=8) (:) ] name of transition
- cascade_donor_pool => decomp_cascade_con%cascade_donor_pool , & ! Output: [integer (:) ] which pool is C taken from for a given decomposition step
- cascade_receiver_pool => decomp_cascade_con%cascade_receiver_pool , & ! Output: [integer (:) ] which pool is C added to for a given decomposition step
- 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
- initial_stock_soildepth => decomp_cascade_con%initial_stock_soildepth , & ! Output: [real(r8) (:) ] soil depth for 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) (:) ] factor for AD spinup associated with each pool
-
- )
-
- allocate(rf_s1s2(bounds%begc:bounds%endc,1:nlevdecomp))
- allocate(rf_s1s3(bounds%begc:bounds%endc,1:nlevdecomp))
- allocate(f_s1s2(bounds%begc:bounds%endc,1:nlevdecomp))
- allocate(f_s1s3(bounds%begc:bounds%endc,1:nlevdecomp))
-
- !------- time-constant coefficients ---------- !
- ! set soil organic matter compartment C:N ratios
- cn_s1 = params_inst%cn_s1_bgc
- cn_s2 = params_inst%cn_s2_bgc
- cn_s3 = params_inst%cn_s3_bgc
-
- ! set respiration fractions for fluxes between compartments
- rf_l1s1 = params_inst%rf_l1s1_bgc
- rf_l2s1 = params_inst%rf_l2s1_bgc
- rf_l3s2 = params_inst%rf_l3s2_bgc
- rf_s2s1 = params_inst%rf_s2s1_bgc
- rf_s2s3 = params_inst%rf_s2s3_bgc
- rf_s3s1 = params_inst%rf_s3s1_bgc
-
- rf_cwdl2 = params_inst%rf_cwdl2_bgc
- rf_cwdl3 = params_inst%rf_cwdl3_bgc
-
- ! set the cellulose and lignin fractions for coarse woody debris
- cwd_fcel = params_inst%cwd_fcel_bgc
- cwd_flig = params_inst%cwd_flig_bgc
-
- ! set path fractions
- f_s2s1 = 0.42_r8/(0.45_r8)
- f_s2s3 = 0.03_r8/(0.45_r8)
-
- ! some of these are dependent on the soil texture properties
- do c = bounds%begc, bounds%endc
- do j = 1, nlevdecomp
- t = 0.85_r8 - 0.68_r8 * 0.01_r8 * (100._r8 - cellsand(c,j))
- f_s1s2(c,j) = 1._r8 - .004_r8 / (1._r8 - t)
- f_s1s3(c,j) = .004_r8 / (1._r8 - t)
- rf_s1s2(c,j) = t
- rf_s1s3(c,j) = t
- end do
- end do
- initial_stock_soildepth = params_inst%initial_Cstocks_depth
-
- !------------------- list of pools and their attributes ------------
- 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.
-
- 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.
-
- 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.
-
- if (.not. use_fates) then
- ! 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.
- endif
-
- if (.not. use_fates) then
- i_soil1 = 5
- else
- i_soil1 = 4
- endif
- 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) = params_inst%initial_Cstocks(1)
- is_metabolic(i_soil1) = .false.
- is_cellulose(i_soil1) = .false.
- is_lignin(i_soil1) = .false.
-
- if (.not. use_fates) then
- i_soil2 = 6
- else
- i_soil2 = 5
- endif
- 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) = params_inst%initial_Cstocks(2)
- is_metabolic(i_soil2) = .false.
- is_cellulose(i_soil2) = .false.
- is_lignin(i_soil2) = .false.
-
- if (.not. use_fates) then
- i_soil3 = 7
- else
- i_soil3 = 6
- endif
- 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) = params_inst%initial_Cstocks(3)
- is_metabolic(i_soil3) = .false.
- is_cellulose(i_soil3) = .false.
- is_lignin(i_soil3) = .false.
-
-
- speedup_fac = 1._r8
-
- !lit1
- spinup_factor(i_litr1) = 1._r8
- !lit2,3
- spinup_factor(i_litr2) = 1._r8
- spinup_factor(i_litr3) = 1._r8
- !CWD
- if (.not. use_fates) then
- spinup_factor(i_cwd) = max(1._r8, (speedup_fac * params_inst%tau_cwd_bgc / 2._r8 ))
- end if
- !som1
- spinup_factor(i_soil1) = 1._r8
- !som2,3
- spinup_factor(i_soil2) = max(1._r8, (speedup_fac * params_inst%tau_s2_bgc))
- spinup_factor(i_soil3) = max(1._r8, (speedup_fac * params_inst%tau_s3_bgc))
-
- if ( masterproc ) then
- write(iulog,*) 'Spinup_state ',spinup_state
- write(iulog,*) 'Spinup factors ',spinup_factor
- end if
-
- !---------------- list of transitions and their time-independent coefficients ---------------!
- i_l1s1 = 1
- cascade_step_name(i_l1s1) = 'L1S1'
- rf_decomp_cascade(bounds%begc:bounds%endc,1:nlevdecomp,i_l1s1) = rf_l1s1
- cascade_donor_pool(i_l1s1) = i_litr1
- cascade_receiver_pool(i_l1s1) = i_soil1
- pathfrac_decomp_cascade(bounds%begc:bounds%endc,1:nlevdecomp,i_l1s1) = 1.0_r8
-
- i_l2s1 = 2
- cascade_step_name(i_l2s1) = 'L2S1'
- rf_decomp_cascade(bounds%begc:bounds%endc,1:nlevdecomp,i_l2s1) = rf_l2s1
- cascade_donor_pool(i_l2s1) = i_litr2
- cascade_receiver_pool(i_l2s1) = i_soil1
- pathfrac_decomp_cascade(bounds%begc:bounds%endc,1:nlevdecomp,i_l2s1)= 1.0_r8
-
- i_l3s2 = 3
- cascade_step_name(i_l3s2) = 'L3S2'
- rf_decomp_cascade(bounds%begc:bounds%endc,1:nlevdecomp,i_l3s2) = rf_l3s2
- cascade_donor_pool(i_l3s2) = i_litr3
- cascade_receiver_pool(i_l3s2) = i_soil2
- pathfrac_decomp_cascade(bounds%begc:bounds%endc,1:nlevdecomp,i_l3s2) = 1.0_r8
-
- i_s1s2 = 4
- cascade_step_name(i_s1s2) = 'S1S2'
- rf_decomp_cascade(bounds%begc:bounds%endc,1:nlevdecomp,i_s1s2) = rf_s1s2(bounds%begc:bounds%endc,1:nlevdecomp)
- cascade_donor_pool(i_s1s2) = i_soil1
- cascade_receiver_pool(i_s1s2) = i_soil2
- pathfrac_decomp_cascade(bounds%begc:bounds%endc,1:nlevdecomp,i_s1s2) = f_s1s2(bounds%begc:bounds%endc,1:nlevdecomp)
-
- i_s1s3 = 5
- cascade_step_name(i_s1s3) = 'S1S3'
- rf_decomp_cascade(bounds%begc:bounds%endc,1:nlevdecomp,i_s1s3) = rf_s1s3(bounds%begc:bounds%endc,1:nlevdecomp)
- cascade_donor_pool(i_s1s3) = i_soil1
- cascade_receiver_pool(i_s1s3) = i_soil3
- pathfrac_decomp_cascade(bounds%begc:bounds%endc,1:nlevdecomp,i_s1s3) = f_s1s3(bounds%begc:bounds%endc,1:nlevdecomp)
-
- i_s2s1 = 6
- cascade_step_name(i_s2s1) = 'S2S1'
- rf_decomp_cascade(bounds%begc:bounds%endc,1:nlevdecomp,i_s2s1) = rf_s2s1
- cascade_donor_pool(i_s2s1) = i_soil2
- cascade_receiver_pool(i_s2s1) = i_soil1
- pathfrac_decomp_cascade(bounds%begc:bounds%endc,1:nlevdecomp,i_s2s1) = f_s2s1
-
- i_s2s3 = 7
- cascade_step_name(i_s2s3) = 'S2S3'
- rf_decomp_cascade(bounds%begc:bounds%endc,1:nlevdecomp,i_s2s3) = rf_s2s3
- cascade_donor_pool(i_s2s3) = i_soil2
- cascade_receiver_pool(i_s2s3) = i_soil3
- pathfrac_decomp_cascade(bounds%begc:bounds%endc,1:nlevdecomp,i_s2s3) = f_s2s3
-
- i_s3s1 = 8
- cascade_step_name(i_s3s1) = 'S3S1'
- rf_decomp_cascade(bounds%begc:bounds%endc,1:nlevdecomp,i_s3s1) = rf_s3s1
- cascade_donor_pool(i_s3s1) = i_soil3
- cascade_receiver_pool(i_s3s1) = i_soil1
- pathfrac_decomp_cascade(bounds%begc:bounds%endc,1:nlevdecomp,i_s3s1) = 1.0_r8
-
- if (.not. use_fates) then
- i_cwdl2 = 9
- cascade_step_name(i_cwdl2) = 'CWDL2'
- rf_decomp_cascade(bounds%begc:bounds%endc,1:nlevdecomp,i_cwdl2) = rf_cwdl2
- cascade_donor_pool(i_cwdl2) = i_cwd
- cascade_receiver_pool(i_cwdl2) = i_litr2
- pathfrac_decomp_cascade(bounds%begc:bounds%endc,1:nlevdecomp,i_cwdl2) = cwd_fcel
-
- i_cwdl3 = 10
- cascade_step_name(i_cwdl3) = 'CWDL3'
- rf_decomp_cascade(bounds%begc:bounds%endc,1:nlevdecomp,i_cwdl3) = rf_cwdl3
- cascade_donor_pool(i_cwdl3) = i_cwd
- cascade_receiver_pool(i_cwdl3) = i_litr3
- pathfrac_decomp_cascade(bounds%begc:bounds%endc,1:nlevdecomp,i_cwdl3) = cwd_flig
- end if
-
- deallocate(rf_s1s2)
- deallocate(rf_s1s3)
- deallocate(f_s1s2)
- deallocate(f_s1s3)
-
- end associate
-
- end subroutine init_decompcascade_bgc
-
-end module SoilBiogeochemDecompCascadeBGCMod
diff --git a/src/soilbiogeochem/SoilBiogeochemDecompCascadeCNMod.F90 b/src/soilbiogeochem/SoilBiogeochemDecompCascadeCNMod.F90
deleted file mode 100644
index 2c4d3b18..00000000
--- a/src/soilbiogeochem/SoilBiogeochemDecompCascadeCNMod.F90
+++ /dev/null
@@ -1,894 +0,0 @@
-module SoilBiogeochemDecompCascadeCNMod
-
- !-----------------------------------------------------------------------
- ! !DESCRIPTION:
- ! Sets the coeffiecients used in the decomposition cascade submodel.
- ! This uses the CN parameters as in CLMCN 4.0
- !
- ! !USES:
- use shr_kind_mod , only : r8 => shr_kind_r8
- use shr_const_mod , only : SHR_CONST_TKFRZ
- use shr_log_mod , only : errMsg => shr_log_errMsg
- use clm_varpar , only : nlevsoi, nlevgrnd, nlevdecomp, ndecomp_cascade_transitions, ndecomp_pools
- use clm_varpar , only : i_met_lit, i_cel_lit, i_lig_lit, i_cwd
- use clm_varctl , only : iulog, spinup_state, anoxia, use_vertsoilc, use_fates
- use clm_varcon , only : zsoi
- use decompMod , only : bounds_type
- use abortutils , only : endrun
- use CNSharedParamsMod , only : CNParamsShareInst, anoxia_wtsat, nlev_soildecomp_standard
- use SoilBiogeochemDecompCascadeConType , only : decomp_cascade_con
- use SoilBiogeochemStateType , only : soilbiogeochem_state_type
- use SoilBiogeochemCarbonFluxType , only : soilbiogeochem_carbonflux_type
- use SoilStateType , only : soilstate_type
- use CanopyStateType , only : canopystate_type
- use TemperatureType , only : temperature_type
- use ch4Mod , only : ch4_type
- use ColumnType , only : col
-
- !
- implicit none
- private
- !
- ! !PUBLIC MEMBER FUNCTIONS:
- public :: readParams
- public :: init_decompcascade_cn
- public :: decomp_rate_constants_cn
-
- type, private :: params_type
- real(r8):: cn_s1_cn !C:N for SOM 1
- real(r8):: cn_s2_cn !C:N for SOM 2
- real(r8):: cn_s3_cn !C:N for SOM 3
- real(r8):: cn_s4_cn !C:N for SOM 4
-
- real(r8):: rf_l1s1_cn !respiration fraction litter 1 -> SOM 1
- real(r8):: rf_l2s2_cn !respiration fraction litter 2 -> SOM 2
- real(r8):: rf_l3s3_cn !respiration fraction litter 3 -> SOM 3
- real(r8):: rf_s1s2_cn !respiration fraction SOM 1 -> SOM 2
- real(r8):: rf_s2s3_cn !respiration fraction SOM 2 -> SOM 3
- real(r8):: rf_s3s4_cn !respiration fraction SOM 3 -> SOM 4
-
- real(r8) :: cwd_fcel_cn !cellulose fraction for CWD
- real(r8) :: cwd_flig_cn !
-
- real(r8) :: k_l1_cn !decomposition rate for litter 1
- real(r8) :: k_l2_cn !decomposition rate for litter 2
- real(r8) :: k_l3_cn !decomposition rate for litter 3
- real(r8) :: k_s1_cn !decomposition rate for SOM 1
- real(r8) :: k_s2_cn !decomposition rate for SOM 2
- real(r8) :: k_s3_cn !decomposition rate for SOM 3
- real(r8) :: k_s4_cn !decomposition rate for SOM 4
-
- real(r8) :: k_frag_cn !fragmentation rate for CWD
- real(r8) :: minpsi_cn !minimum soil water potential for heterotrophic resp
- real(r8) :: maxpsi_cn !maximum soil water potential for heterotrophic resp
-
- integer :: nsompools = 4
- real(r8), allocatable :: spinup_vector(:) ! multipliers for soil decomp during accelerated spinup
-
- end type params_type
- !
- type(params_type), private :: params_inst
-
- character(len=*), parameter, private :: sourcefile = &
- __FILE__
- !-----------------------------------------------------------------------
-
-contains
-
- !-----------------------------------------------------------------------
- subroutine readParams ( ncid )
- !
- ! !USES:
- use ncdio_pio , only : file_desc_t,ncd_io
- !
- ! !ARGUMENTS:
- implicit none
- type(file_desc_t),intent(inout) :: ncid ! pio netCDF file id
- !
- ! !CALLED FROM: readParamsMod.F90::CNParamsReadFile
- !
- ! !REVISION HISTORY:
- ! Dec 3 2012 : Created by S. Muszala
- !
- ! !LOCAL VARIABLES:
- character(len=32) :: subname = 'SoilBiogeochemDecompCnParamsType'
- 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
-
- !EOP
- !-----------------------------------------------------------------------
-
- ! These are not read off of netcdf file
- allocate(params_inst%spinup_vector(params_inst%nsompools))
- params_inst%spinup_vector(:) = (/ 1.0_r8, 1.0_r8, 5.0_r8, 70.0_r8 /)
-
- ! Read off of netcdf file
- tString='cn_s1'
- call ncd_io(trim(tString),tempr, 'read', ncid, readvar=readv)
- if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__))
- params_inst%cn_s1_cn=tempr
-
- tString='cn_s2'
- call ncd_io(trim(tString),tempr, 'read', ncid, readvar=readv)
- if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__))
- params_inst%cn_s2_cn=tempr
-
- tString='cn_s3'
- call ncd_io(trim(tString),tempr, 'read', ncid, readvar=readv)
- if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__))
- params_inst%cn_s3_cn=tempr
-
- tString='cn_s4'
- call ncd_io(trim(tString),tempr, 'read', ncid, readvar=readv)
- if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__))
- params_inst%cn_s4_cn=tempr
-
- tString='rf_l1s1'
- call ncd_io(trim(tString),tempr, 'read', ncid, readvar=readv)
- if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__))
- params_inst%rf_l1s1_cn=tempr
-
- tString='rf_l2s2'
- call ncd_io(trim(tString),tempr, 'read', ncid, readvar=readv)
- if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__))
- params_inst%rf_l2s2_cn=tempr
-
- tString='rf_l3s3'
- call ncd_io(trim(tString),tempr, 'read', ncid, readvar=readv)
- if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__))
- params_inst%rf_l3s3_cn=tempr
-
- tString='rf_s1s2'
- call ncd_io(trim(tString),tempr, 'read', ncid, readvar=readv)
- if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__))
- params_inst%rf_s1s2_cn=tempr
-
- tString='rf_s2s3'
- call ncd_io(trim(tString),tempr, 'read', ncid, readvar=readv)
- if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__))
- params_inst%rf_s2s3_cn=tempr
-
- tString='rf_s3s4'
- call ncd_io(trim(tString),tempr, 'read', ncid, readvar=readv)
- if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__))
- params_inst%rf_s3s4_cn=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(sourcefile, __LINE__))
- params_inst%cwd_fcel_cn=tempr
-
- tString='k_l1'
- call ncd_io(trim(tString),tempr, 'read', ncid, readvar=readv)
- if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__))
- params_inst%k_l1_cn=tempr
-
- tString='k_l2'
- call ncd_io(trim(tString),tempr, 'read', ncid, readvar=readv)
- if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__))
- params_inst%k_l2_cn=tempr
-
- tString='k_l3'
- call ncd_io(trim(tString),tempr, 'read', ncid, readvar=readv)
- if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__))
- params_inst%k_l3_cn=tempr
-
- tString='k_s1'
- call ncd_io(trim(tString),tempr, 'read', ncid, readvar=readv)
- if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__))
- params_inst%k_s1_cn=tempr
-
- tString='k_s2'
- call ncd_io(trim(tString),tempr, 'read', ncid, readvar=readv)
- if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__))
- params_inst%k_s2_cn=tempr
-
- tString='k_s3'
- call ncd_io(trim(tString),tempr, 'read', ncid, readvar=readv)
- if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__))
- params_inst%k_s3_cn=tempr
-
- tString='k_s4'
- call ncd_io(trim(tString),tempr, 'read', ncid, readvar=readv)
- if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__))
- params_inst%k_s4_cn=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(sourcefile, __LINE__))
- params_inst%k_frag_cn=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(sourcefile, __LINE__))
- params_inst%minpsi_cn=tempr
-
- tString='maxpsi_hr'
- call ncd_io(trim(tString),tempr, 'read', ncid, readvar=readv)
- if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__))
- params_inst%maxpsi_cn=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(sourcefile, __LINE__))
- params_inst%cwd_flig_cn=tempr
-
- end subroutine readParams
-
- !-----------------------------------------------------------------------
- subroutine init_decompcascade_cn(bounds, soilbiogeochem_state_inst)
- !
- ! !DESCRIPTION:
- ! initialize rate constants and decomposition pathways for the BGC model originally implemented in CLM-CN
- ! written by C. Koven based on original CLM4 decomposition cascade by P. Thornton
- !
- ! !ARGUMENTS:
- type(bounds_type) , intent(in) :: bounds
- type(soilbiogeochem_state_type) , intent(inout) :: soilbiogeochem_state_inst
- !
- !-- properties of each pathway along decomposition cascade
- !-- properties of each decomposing pool
- real(r8) :: rf_l1s1 !respiration fraction litter 1 -> SOM 1
- real(r8) :: rf_l2s2 !respiration fraction litter 2 -> SOM 2
- real(r8) :: rf_l3s3 !respiration fraction litter 3 -> SOM 3
- real(r8) :: rf_s1s2 !respiration fraction SOM 1 -> SOM 2
- real(r8) :: rf_s2s3 !respiration fraction SOM 2 -> SOM 3
- real(r8) :: rf_s3s4 !respiration fraction SOM 3 -> SOM 4
- real(r8) :: cwd_fcel
- real(r8) :: cwd_flig
- real(r8) :: cn_s1
- real(r8) :: cn_s2
- real(r8) :: cn_s3
- real(r8) :: cn_s4
-
- integer :: i_litr1
- integer :: i_litr2
- integer :: i_litr3
- integer :: i_soil1
- integer :: i_soil2
- integer :: i_soil3
- integer :: i_soil4
- integer :: i_atm
- integer :: i_l1s1
- integer :: i_l2s2
- integer :: i_l3s3
- integer :: i_s1s2
- integer :: i_s2s3
- integer :: i_s3s4
- integer :: i_s4atm
- integer :: i_cwdl2
- integer :: i_cwdl3
- !-----------------------------------------------------------------------
-
- associate( &
- rf_decomp_cascade => soilbiogeochem_state_inst%rf_decomp_cascade_col , & ! Output: [real(r8) (:,:,:) ] respired fraction in decomposition step (frac)
- pathfrac_decomp_cascade => soilbiogeochem_state_inst%pathfrac_decomp_cascade_col , & ! Output: [real(r8) (:,:,:) ] what fraction of C leaving a given pool passes through a given transition (frac)
-
- cascade_step_name => decomp_cascade_con%cascade_step_name , & ! Output: [character(len=8) (:) ] name of transition
- cascade_donor_pool => decomp_cascade_con%cascade_donor_pool , & ! Output: [integer (:) ] which pool is C taken from for a given decomposition step
- cascade_receiver_pool => decomp_cascade_con%cascade_receiver_pool , & ! Output: [integer (:) ] which pool is C added to for a given decomposition step
- 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) (:) ] factor for AD spinup associated with each pool
- )
-
- !------- time-constant coefficients ---------- !
- ! set soil organic matter compartment C:N ratios (from Biome-BGC v4.2.0)
- cn_s1=params_inst%cn_s1_cn
- cn_s2=params_inst%cn_s2_cn
- cn_s3=params_inst%cn_s3_cn
- cn_s4=params_inst%cn_s4_cn
-
- ! set respiration fractions for fluxes between compartments
- ! (from Biome-BGC v4.2.0)
- rf_l1s1=params_inst%rf_l1s1_cn
- rf_l2s2=params_inst%rf_l2s2_cn
- rf_l3s3=params_inst%rf_l3s3_cn
- rf_s1s2=params_inst%rf_s1s2_cn
- rf_s2s3=params_inst%rf_s2s3_cn
- rf_s3s4=params_inst%rf_s3s4_cn
-
- ! set the cellulose and lignin fractions for coarse woody debris
- cwd_fcel=params_inst%cwd_fcel_cn
- cwd_flig=params_inst%cwd_flig_cn
-
- !------------------- 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.
-
- if (.not. use_fates) then
- 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) = 500._r8
- initial_stock(i_cwd) = 0._r8
- is_metabolic(i_cwd) = .false.
- is_cellulose(i_cwd) = .false.
- is_lignin(i_cwd) = .false.
- end if
-
- if ( .not. use_fates ) then
- i_soil1 = 5
- else
- i_soil1 = 4
- endif
- 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) = 0._r8
- is_metabolic(i_soil1) = .false.
- is_cellulose(i_soil1) = .false.
- is_lignin(i_soil1) = .false.
-
- if ( .not. use_fates ) then
- i_soil2 = 6
- else
- i_soil2 = 5
- endif
- 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) = 0._r8
- is_metabolic(i_soil2) = .false.
- is_cellulose(i_soil2) = .false.
- is_lignin(i_soil2) = .false.
-
- if ( .not. use_fates ) then
- i_soil3 = 7
- else
- i_soil3 = 6
- endif
- 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) = 0._r8
- is_metabolic(i_soil3) = .false.
- is_cellulose(i_soil3) = .false.
- is_lignin(i_soil3) = .false.
-
- if ( .not. use_fates ) then
- i_soil4 = 8
- else
- i_soil4 = 7
- endif
- floating_cn_ratio_decomp_pools(i_soil4) = .false.
- decomp_pool_name_restart(i_soil4) = 'soil4'
- decomp_pool_name_history(i_soil4) = 'SOIL4'
- decomp_pool_name_long(i_soil4) = 'soil 4'
- decomp_pool_name_short(i_soil4) = 'S4'
- is_litter(i_soil4) = .false.
- is_soil(i_soil4) = .true.
- is_cwd(i_soil4) = .false.
- initial_cn_ratio(i_soil4) = cn_s4
- initial_stock(i_soil4) = 10._r8
- is_metabolic(i_soil4) = .false.
- is_cellulose(i_soil4) = .false.
- is_lignin(i_soil4) = .false.
-
- i_atm = 0 !! for terminal pools (i.e. 100% respiration)
- floating_cn_ratio_decomp_pools(i_atm) = .false.
- decomp_pool_name_restart(i_atm) = 'atmosphere'
- decomp_pool_name_history(i_atm) = 'atmosphere'
- decomp_pool_name_long(i_atm) = 'atmosphere'
- decomp_pool_name_short(i_atm) = ''
- is_litter(i_atm) = .true.
- is_soil(i_atm) = .false.
- is_cwd(i_atm) = .false.
- initial_cn_ratio(i_atm) = 0._r8
- initial_stock(i_atm) = 0._r8
- is_metabolic(i_atm) = .false.
- is_cellulose(i_atm) = .false.
- is_lignin(i_atm) = .false.
-
-
- spinup_factor(i_litr1) = 1._r8
- spinup_factor(i_litr2) = 1._r8
- spinup_factor(i_litr3) = 1._r8
- if (.not. use_fates) then
- spinup_factor(i_cwd) = 1._r8
- end if
- spinup_factor(i_soil1) = params_inst%spinup_vector(1)
- spinup_factor(i_soil2) = params_inst%spinup_vector(2)
- spinup_factor(i_soil3) = params_inst%spinup_vector(3)
- spinup_factor(i_soil4) = params_inst%spinup_vector(4)
-
-
- !---------------- list of transitions and their time-independent coefficients ---------------!
- i_l1s1 = 1
- cascade_step_name(i_l1s1) = 'L1S1'
- rf_decomp_cascade(bounds%begc:bounds%endc,1:nlevdecomp,i_l1s1) = rf_l1s1
- cascade_donor_pool(i_l1s1) = i_litr1
- cascade_receiver_pool(i_l1s1) = i_soil1
- pathfrac_decomp_cascade(bounds%begc:bounds%endc,1:nlevdecomp,i_l1s1) = 1.0_r8
-
- i_l2s2 = 2
- cascade_step_name(i_l2s2) = 'L2S2'
- rf_decomp_cascade(bounds%begc:bounds%endc,1:nlevdecomp,i_l2s2) = rf_l2s2
- cascade_donor_pool(i_l2s2) = i_litr2
- cascade_receiver_pool(i_l2s2) = i_soil2
- pathfrac_decomp_cascade(bounds%begc:bounds%endc,1:nlevdecomp,i_l2s2) = 1.0_r8
-
- i_l3s3 = 3
- cascade_step_name(i_l3s3) = 'L3S3'
- rf_decomp_cascade(bounds%begc:bounds%endc,1:nlevdecomp,i_l3s3) = rf_l3s3
- cascade_donor_pool(i_l3s3) = i_litr3
- cascade_receiver_pool(i_l3s3) = i_soil3
- pathfrac_decomp_cascade(bounds%begc:bounds%endc,1:nlevdecomp,i_l3s3) = 1.0_r8
-
- i_s1s2 = 4
- cascade_step_name(i_s1s2) = 'S1S2'
- rf_decomp_cascade(bounds%begc:bounds%endc,1:nlevdecomp,i_s1s2) = rf_s1s2
- cascade_donor_pool(i_s1s2) = i_soil1
- cascade_receiver_pool(i_s1s2) = i_soil2
- pathfrac_decomp_cascade(bounds%begc:bounds%endc,1:nlevdecomp,i_s1s2) = 1.0_r8
-
- i_s2s3 = 5
- cascade_step_name(i_s2s3) = 'S2S3'
- rf_decomp_cascade(bounds%begc:bounds%endc,1:nlevdecomp,i_s2s3) = rf_s2s3
- cascade_donor_pool(i_s2s3) = i_soil2
- cascade_receiver_pool(i_s2s3) = i_soil3
- pathfrac_decomp_cascade(bounds%begc:bounds%endc,1:nlevdecomp,i_s2s3) = 1.0_r8
-
- i_s3s4 = 6
- cascade_step_name(i_s3s4) = 'S3S4'
- rf_decomp_cascade(bounds%begc:bounds%endc,1:nlevdecomp,i_s3s4) = rf_s3s4
- cascade_donor_pool(i_s3s4) = i_soil3
- cascade_receiver_pool(i_s3s4) = i_soil4
- pathfrac_decomp_cascade(bounds%begc:bounds%endc,1:nlevdecomp,i_s3s4) = 1.0_r8
-
- i_s4atm = 7
- cascade_step_name(i_s4atm) = 'S4'
- rf_decomp_cascade(bounds%begc:bounds%endc,1:nlevdecomp,i_s4atm) = 1.
- cascade_donor_pool(i_s4atm) = i_soil4
- cascade_receiver_pool(i_s4atm) = i_atm
- pathfrac_decomp_cascade(bounds%begc:bounds%endc,1:nlevdecomp,i_s4atm) = 1.0_r8
-
- if (.not. use_fates) then
- i_cwdl2 = 8
- cascade_step_name(i_cwdl2) = 'CWDL2'
- rf_decomp_cascade(bounds%begc:bounds%endc,1:nlevdecomp,i_cwdl2) = 0._r8
- cascade_donor_pool(i_cwdl2) = i_cwd
- cascade_receiver_pool(i_cwdl2) = i_litr2
- pathfrac_decomp_cascade(bounds%begc:bounds%endc,1:nlevdecomp,i_cwdl2) = cwd_fcel
-
- i_cwdl3 = 9
- cascade_step_name(i_cwdl3) = 'CWDL3'
- rf_decomp_cascade(bounds%begc:bounds%endc,1:nlevdecomp,i_cwdl3) = 0._r8
- cascade_donor_pool(i_cwdl3) = i_cwd
- cascade_receiver_pool(i_cwdl3) = i_litr3
- pathfrac_decomp_cascade(bounds%begc:bounds%endc,1:nlevdecomp,i_cwdl3) = cwd_flig
- end if
-
- end associate
-
- end subroutine init_decompcascade_cn
-
- !-----------------------------------------------------------------------
- subroutine decomp_rate_constants_cn(bounds, &
- num_soilc, filter_soilc, &
- canopystate_inst, soilstate_inst, temperature_inst, ch4_inst, soilbiogeochem_carbonflux_inst)
- !
- ! !DESCRIPTION:
- ! calculate rate constants and decomposition pathways for the BGC model
- ! originally implemented in CLM-CN
- ! written by C. Koven based on original CLM4 decomposition cascade by P. Thornton
- !
- ! !USES:
- use clm_time_manager, only : get_step_size
- use clm_varcon , only : secspday
- use clm_varpar , only : i_cwd
- !
- ! !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
- type(canopystate_type) , intent(in) :: canopystate_inst
- type(soilstate_type) , intent(in) :: soilstate_inst
- type(temperature_type) , intent(in) :: temperature_inst
- type(ch4_type) , intent(in) :: ch4_inst
- type(soilbiogeochem_carbonflux_type) , intent(inout) :: soilbiogeochem_carbonflux_inst
- !
- ! !LOCAL VARIABLES:
- real(r8):: dt ! decomp timestep (seconds)
- real(r8):: dtd ! decomp timestep (days)
- real(r8):: frw(bounds%begc:bounds%endc) ! rooting fraction weight
- real(r8), allocatable:: fr(:,:) ! column-level rooting fraction by soil depth
- real(r8):: minpsi, maxpsi ! limits for soil water scalar for decomp
- real(r8):: psi ! temporary soilpsi for water scalar
- real(r8):: rate_scalar ! combined rate scalar for decomp
- real(r8):: k_l1 ! decomposition rate constant litter 1
- real(r8):: k_l2 ! decomposition rate constant litter 2
- real(r8):: k_l3 ! decomposition rate constant litter 3
- real(r8):: k_s1 ! decomposition rate constant SOM 1
- real(r8):: k_s2 ! decomposition rate constant SOM 2
- real(r8):: k_s3 ! decomposition rate constant SOM 3
- real(r8):: k_s4 ! decomposition rate constant SOM 4
- real(r8):: k_frag ! fragmentation rate constant CWD
- real(r8):: ck_l1 ! corrected decomposition rate constant litter 1
- real(r8):: ck_l2 ! corrected decomposition rate constant litter 2
- real(r8):: ck_l3 ! corrected decomposition rate constant litter 3
- real(r8):: ck_s1 ! corrected decomposition rate constant SOM 1
- real(r8):: ck_s2 ! corrected decomposition rate constant SOM 2
- real(r8):: ck_s3 ! corrected decomposition rate constant SOM 3
- real(r8):: ck_s4 ! corrected decomposition rate constant SOM 4
- real(r8):: ck_frag ! corrected fragmentation rate constant CWD
- real(r8):: cwdc_loss ! fragmentation rate for CWD carbon (gC/m2/s)
- real(r8):: cwdn_loss ! fragmentation rate for CWD nitrogen (gN/m2/s)
- integer :: i_litr1
- integer :: i_litr2
- integer :: i_litr3
- integer :: i_soil1
- integer :: i_soil2
- integer :: i_soil3
- integer :: i_soil4
- integer :: c, fc, j, k, l
- real(r8):: Q10 ! temperature dependence
- real(r8):: froz_q10 ! separate q10 for frozen soil respiration rates. default to same as above zero rates
- real(r8):: decomp_depth_efolding ! (meters) e-folding depth for reduction in decomposition [
- real(r8):: depth_scalar(bounds%begc:bounds%endc,1:nlevdecomp)
- real(r8) :: mino2lim ! minimum anaerobic decomposition rate as a
- ! fraction of potential aerobic rate
- !-----------------------------------------------------------------------
-
- associate( &
- dz => col%dz , & ! Input: [real(r8) (:,:) ] soil layer thickness (m)
-
- soilpsi => soilstate_inst%soilpsi_col , & ! Input: [real(r8) (:,:) ] soil water potential in each soil layer (MPa)
-
- alt_indx => canopystate_inst%alt_indx_col , & ! Input: [integer (:) ] current depth of thaw
-
- t_soisno => temperature_inst%t_soisno_col , & ! Input: [real(r8) (:,:) ] soil temperature (Kelvin) (-nlevsno+1:nlevgrnd)
-
- o2stress_sat => ch4_inst%o2stress_sat_col , & ! Input: [real(r8) (:,:) ] Ratio of oxygen available to that demanded by roots, aerobes, & methanotrophs (nlevsoi)
- o2stress_unsat => ch4_inst%o2stress_unsat_col , & ! Input: [real(r8) (:,:) ] Ratio of oxygen available to that demanded by roots, aerobes, & methanotrophs (nlevsoi)
- finundated => ch4_inst%finundated_col , & ! Input: [real(r8) (:) ] fractional inundated area (excluding dedicated wetland columns)
-
- t_scalar => soilbiogeochem_carbonflux_inst%t_scalar_col , & ! Output: [real(r8) (:,:) ] soil temperature scalar for decomp
- w_scalar => soilbiogeochem_carbonflux_inst%w_scalar_col , & ! Output: [real(r8) (:,:) ] soil water scalar for decomp
- o_scalar => soilbiogeochem_carbonflux_inst%o_scalar_col , & ! Output: [real(r8) (:,:) ] fraction by which decomposition is limited by anoxia
- decomp_k => soilbiogeochem_carbonflux_inst%decomp_k_col & ! Output: [real(r8) (:,:,:) ] rate constant for decomposition (1./sec)
- )
-
- mino2lim = CNParamsShareInst%mino2lim
-
- ! set time steps
- dt = real( get_step_size(), r8 )
- dtd = dt/secspday
-
- ! set initial base rates for decomposition mass loss (1/day)
- ! (from Biome-BGC v4.2.0, using three SOM pools)
- ! Value inside log function is the discrete-time values for a
- ! daily time step model, and the result of the log function is
- ! the corresponding continuous-time decay rate (1/day), following
- ! Olson, 1963.
- k_l1=params_inst%k_l1_cn
- k_l2=params_inst%k_l2_cn
- k_l3=params_inst%k_l3_cn
-
- k_s1=params_inst%k_s1_cn
- k_s2=params_inst%k_s2_cn
- k_s3=params_inst%k_s3_cn
- k_s4=params_inst%k_s4_cn
-
- k_frag=params_inst%k_frag_cn
-
- ! calculate the new discrete-time decay rate for model timestep
- k_l1 = 1.0_r8-exp(-k_l1*dtd)
- k_l2 = 1.0_r8-exp(-k_l2*dtd)
- k_l3 = 1.0_r8-exp(-k_l3*dtd)
-
- k_s1 = 1.0_r8-exp(-k_s1*dtd)
- k_s2 = 1.0_r8-exp(-k_s2*dtd)
- k_s3 = 1.0_r8-exp(-k_s3*dtd)
- k_s4 = 1.0_r8-exp(-k_s4*dtd)
-
- k_frag = 1.0_r8-exp(-k_frag*dtd)
-
- minpsi = params_inst%minpsi_cn
- maxpsi = params_inst%maxpsi_cn
-
- Q10 = CNParamsShareInst%Q10
-
- ! set "froz_q10" parameter
- froz_q10 = CNParamsShareInst%froz_q10
-
- if (use_vertsoilc) then
- ! Set "decomp_depth_efolding" parameter
- decomp_depth_efolding = CNParamsShareInst%decomp_depth_efolding
- end if
-
- ! The following code implements the acceleration part of the AD spinup
- ! algorithm, by multiplying all of the SOM decomposition base rates by 10.0.
-
- if ( spinup_state .eq. 1 ) then
- k_s1 = k_s1 * params_inst%spinup_vector(1)
- k_s2 = k_s2 * params_inst%spinup_vector(2)
- k_s3 = k_s3 * params_inst%spinup_vector(3)
- k_s4 = k_s4 * params_inst%spinup_vector(4)
- endif
-
- i_litr1 = 1
- i_litr2 = 2
- i_litr3 = 3
- if (use_fates) then
- i_soil1 = 4
- i_soil2 = 5
- i_soil3 = 6
- i_soil4 = 7
- else
- i_soil1 = 5
- i_soil2 = 6
- i_soil3 = 7
- i_soil4 = 8
- endif
-
- !--- time dependent coefficients-----!
- if ( nlevdecomp .eq. 1 ) then
-
- ! calculate function to weight the temperature and water potential scalars
- ! for decomposition control.
-
-
- ! the following normalizes values in fr so that they
- ! sum to 1.0 across top nlevdecomp levels on a column
- frw(bounds%begc:bounds%endc) = 0._r8
- nlev_soildecomp_standard=5
- allocate(fr(bounds%begc:bounds%endc,nlev_soildecomp_standard))
- do j=1,nlev_soildecomp_standard
- do fc = 1,num_soilc
- c = filter_soilc(fc)
- frw(c) = frw(c) + dz(c,j)
- end do
- end do
- do j = 1,nlev_soildecomp_standard
- do fc = 1,num_soilc
- c = filter_soilc(fc)
- if (frw(c) /= 0._r8) then
- fr(c,j) = dz(c,j) / frw(c)
- else
- fr(c,j) = 0._r8
- end if
- end do
- end do
-
- ! calculate rate constant scalar for soil temperature
- ! assuming that the base rate constants are assigned for non-moisture
- ! limiting conditions at 25 C.
- ! Peter Thornton: 3/13/09
- ! Replaced the Lloyd and Taylor function with a Q10 formula, with Q10 = 1.5
- ! as part of the modifications made to improve the seasonal cycle of
- ! atmospheric CO2 concentration in global simulations. This does not impact
- ! the base rates at 25 C, which are calibrated from microcosm studies.
- do j = 1,nlev_soildecomp_standard
- do fc = 1,num_soilc
- c = filter_soilc(fc)
- if (j==1) t_scalar(c,:) = 0._r8
- !! use separate (possibly equal) t funcs above and below freezing point
- !! t_scalar(c,1)=t_scalar(c,1) + (1.5**((t_soisno(c,j)-(SHR_CONST_TKFRZ+25._r8))/10._r8))*fr(c,j)
- if (t_soisno(c,j) >= SHR_CONST_TKFRZ) then
- t_scalar(c,1)=t_scalar(c,1) + &
- (Q10**((t_soisno(c,j)-(SHR_CONST_TKFRZ+25._r8))/10._r8))*fr(c,j)
- else
- t_scalar(c,1)=t_scalar(c,1) + &
- (Q10**(-25._r8/10._r8))*(froz_q10**((t_soisno(c,j)-SHR_CONST_TKFRZ)/10._r8))*fr(c,j)
- endif
- end do
- end do
-
- ! calculate the rate constant scalar for soil water content.
- ! Uses the log relationship with water potential given in
- ! Andren, O., and K. Paustian, 1987. Barley straw decomposition in the field:
- ! a comparison of models. Ecology, 68(5):1190-1200.
- ! and supported by data in
- ! Orchard, V.A., and F.J. Cook, 1983. Relationship between soil respiration
- ! and soil moisture. Soil Biol. Biochem., 15(4):447-453.
-
- do j = 1,nlev_soildecomp_standard
- do fc = 1,num_soilc
- c = filter_soilc(fc)
- if (j==1) w_scalar(c,:) = 0._r8
- psi = min(soilpsi(c,j),maxpsi)
- ! decomp only if soilpsi is higher than minpsi
- if (psi > minpsi) then
- w_scalar(c,1) = w_scalar(c,1) + (log(minpsi/psi)/log(minpsi/maxpsi))*fr(c,j)
- end if
- end do
- end do
-
- o_scalar(bounds%begc:bounds%endc,1:nlevdecomp) = 1._r8
-
- deallocate(fr)
-
- else
-
- ! calculate rate constant scalar for soil temperature
- ! assuming that the base rate constants are assigned for non-moisture
- ! limiting conditions at 25 C.
- ! Peter Thornton: 3/13/09
- ! Replaced the Lloyd and Taylor function with a Q10 formula, with Q10 = 1.5
- ! as part of the modifications made to improve the seasonal cycle of
- ! atmospheric CO2 concentration in global simulations. This does not impact
- ! the base rates at 25 C, which are calibrated from microcosm studies.
-
- do j = 1, nlevdecomp
- do fc = 1,num_soilc
- c = filter_soilc(fc)
- !! use separate (possibly equal) t funcs above and below freezing point
- !! t_scalar(c,j)= (1.5**((t_soisno(c,j)-(SHR_CONST_TKFRZ+25._r8))/10._r8))
- if (t_soisno(c,j) >= SHR_CONST_TKFRZ) then
- t_scalar(c,j)= (Q10**((t_soisno(c,j)-(SHR_CONST_TKFRZ+25._r8))/10._r8))
- else
- t_scalar(c,j)= (Q10**(-25._r8/10._r8))*(froz_q10**((t_soisno(c,j)-SHR_CONST_TKFRZ)/10._r8))
- endif
- end do
- end do
-
-
- ! calculate the rate constant scalar for soil water content.
- ! Uses the log relationship with water potential given in
- ! Andren, O., and K. Paustian, 1987. Barley straw decomposition in the field:
- ! a comparison of models. Ecology, 68(5):1190-1200.
- ! and supported by data in
- ! Orchard, V.A., and F.J. Cook, 1983. Relationship between soil respiration
- ! and soil moisture. Soil Biol. Biochem., 15(4):447-453.
-
- do j = 1,nlevdecomp
- do fc = 1,num_soilc
- c = filter_soilc(fc)
- psi = min(soilpsi(c,j),maxpsi)
- ! decomp only if soilpsi is higher than minpsi
- if (psi > minpsi) then
- w_scalar(c,j) = (log(minpsi/psi)/log(minpsi/maxpsi))
- else
- w_scalar(c,j) = 0._r8
- end if
- end do
- end do
-
- end if
-
- o_scalar(bounds%begc:bounds%endc,1:nlevdecomp) = 1._r8
-
- if (use_vertsoilc) then
- ! add a term to reduce decomposition rate at depth
- ! for now used a fixed e-folding depth
- do j = 1, nlevdecomp
- do fc = 1,num_soilc
- c = filter_soilc(fc)
- depth_scalar(c,j) = exp(-zsoi(j)/decomp_depth_efolding)
- end do
- end do
- end if
-
- ! calculate rate constants for all litter and som pools
- if (use_vertsoilc) then
- do j = 1,nlevdecomp
- do fc = 1,num_soilc
- c = filter_soilc(fc)
- decomp_k(c,j,i_litr1) = k_l1 * t_scalar(c,j) * w_scalar(c,j) * depth_scalar(c,j) * o_scalar(c,j) / dt
- decomp_k(c,j,i_litr2) = k_l2 * t_scalar(c,j) * w_scalar(c,j) * depth_scalar(c,j) * o_scalar(c,j) / dt
- decomp_k(c,j,i_litr3) = k_l3 * t_scalar(c,j) * w_scalar(c,j) * depth_scalar(c,j) * o_scalar(c,j) / dt
- decomp_k(c,j,i_soil1) = k_s1 * t_scalar(c,j) * w_scalar(c,j) * depth_scalar(c,j) * o_scalar(c,j) / dt
- decomp_k(c,j,i_soil2) = k_s2 * t_scalar(c,j) * w_scalar(c,j) * depth_scalar(c,j) * o_scalar(c,j) / dt
- decomp_k(c,j,i_soil3) = k_s3 * t_scalar(c,j) * w_scalar(c,j) * depth_scalar(c,j) * o_scalar(c,j) / dt
- decomp_k(c,j,i_soil4) = k_s4 * t_scalar(c,j) * w_scalar(c,j) * depth_scalar(c,j) * o_scalar(c,j) / dt
- end do
- end do
- else
- do j = 1,nlevdecomp
- do fc = 1,num_soilc
- c = filter_soilc(fc)
- decomp_k(c,j,i_litr1) = k_l1 * t_scalar(c,j) * w_scalar(c,j) * o_scalar(c,j) / dt
- decomp_k(c,j,i_litr2) = k_l2 * t_scalar(c,j) * w_scalar(c,j) * o_scalar(c,j) / dt
- decomp_k(c,j,i_litr3) = k_l3 * t_scalar(c,j) * w_scalar(c,j) * o_scalar(c,j) / dt
- decomp_k(c,j,i_soil1) = k_s1 * t_scalar(c,j) * w_scalar(c,j) * o_scalar(c,j) / dt
- decomp_k(c,j,i_soil2) = k_s2 * t_scalar(c,j) * w_scalar(c,j) * o_scalar(c,j) / dt
- decomp_k(c,j,i_soil3) = k_s3 * t_scalar(c,j) * w_scalar(c,j) * o_scalar(c,j) / dt
- decomp_k(c,j,i_soil4) = k_s4 * t_scalar(c,j) * w_scalar(c,j) * o_scalar(c,j) / dt
- end do
- end do
- end if
-
- ! do the same for cwd, but only if fates is not enabled (because fates handles CWD on its own structure
- if (.not. use_fates) then
- if (use_vertsoilc) then
- do j = 1,nlevdecomp
- do fc = 1,num_soilc
- c = filter_soilc(fc)
- decomp_k(c,j,i_cwd) = k_frag * t_scalar(c,j) * w_scalar(c,j) * depth_scalar(c,j) * o_scalar(c,j) / dt
- end do
- end do
- else
- do j = 1,nlevdecomp
- do fc = 1,num_soilc
- c = filter_soilc(fc)
- decomp_k(c,j,i_cwd) = k_frag * t_scalar(c,j) * w_scalar(c,j) * o_scalar(c,j) / dt
- end do
- end do
- end if
- end if
-
- end associate
-
- end subroutine decomp_rate_constants_cn
-
- end module SoilBiogeochemDecompCascadeCNMod
diff --git a/src/soilbiogeochem/SoilBiogeochemDecompCascadeConType.F90 b/src/soilbiogeochem/SoilBiogeochemDecompCascadeConType.F90
deleted file mode 100644
index 8a8e2f8d..00000000
--- a/src/soilbiogeochem/SoilBiogeochemDecompCascadeConType.F90
+++ /dev/null
@@ -1,104 +0,0 @@
-module SoilBiogeochemDecompCascadeConType
-
- !------------------------------------------------------------------------------
- ! !DESCRIPTION:
- ! Decomposition Cascade Type
- !
- ! !USES:
- use shr_kind_mod , only : r8 => shr_kind_r8
- use shr_infnan_mod , only : nan => shr_infnan_nan, assignment(=)
- use clm_varpar , only : ndecomp_cascade_transitions, ndecomp_pools
- !
- implicit none
- private
- !
- ! !PUBLIC MEMBER FUNCTIONS:
- public :: init_decomp_cascade_constants
- !
- type, public :: decomp_cascade_type
- !-- properties of each pathway along decomposition cascade
- character(len=8) , pointer :: cascade_step_name(:) ! name of transition
- integer , pointer :: cascade_donor_pool(:) ! which pool is C taken from for a given decomposition step
- integer , pointer :: cascade_receiver_pool(:) ! which pool is C added to for a given decomposition step
-
- !-- properties of each decomposing pool
- logical , pointer :: floating_cn_ratio_decomp_pools(:) ! TRUE => pool has fixed C:N ratio
- character(len=8) , pointer :: decomp_pool_name_restart(:) ! name of pool for restart files
- character(len=8) , pointer :: decomp_pool_name_history(:) ! name of pool for history files
- character(len=20) , pointer :: decomp_pool_name_long(:) ! name of pool for netcdf long names
- character(len=8) , pointer :: decomp_pool_name_short(:) ! name of pool for netcdf short names
- logical , pointer :: is_litter(:) ! TRUE => pool is a litter pool
- logical , pointer :: is_soil(:) ! TRUE => pool is a soil pool
- logical , pointer :: is_cwd(:) ! TRUE => pool is a cwd pool
- real(r8) , pointer :: initial_cn_ratio(:) ! c:n ratio for initialization of pools
- real(r8) , pointer :: initial_stock(:) ! initial concentration for seeding at spinup
- real(r8) :: initial_stock_soildepth ! soil depth for initial concentration for seeding at spinup
- logical , pointer :: is_metabolic(:) ! TRUE => pool is metabolic material
- logical , pointer :: is_cellulose(:) ! TRUE => pool is cellulose
- logical , pointer :: is_lignin(:) ! TRUE => pool is lignin
- real(r8) , pointer :: spinup_factor(:) ! factor by which to scale AD and relevant processes by
- end type decomp_cascade_type
-
- type(decomp_cascade_type), public :: decomp_cascade_con
- !------------------------------------------------------------------------
-
-contains
-
- !------------------------------------------------------------------------
- subroutine init_decomp_cascade_constants()
- !
- ! !DESCRIPTION:
- ! Initialize decomposition cascade state
- !------------------------------------------------------------------------
-
- !-- properties of each pathway along decomposition cascade
- allocate(decomp_cascade_con%cascade_step_name(1:ndecomp_cascade_transitions))
- allocate(decomp_cascade_con%cascade_donor_pool(1:ndecomp_cascade_transitions))
- allocate(decomp_cascade_con%cascade_receiver_pool(1:ndecomp_cascade_transitions))
-
- ! NOTE(bja, 2015-10) according to Dave Lawrence and Charlie Koven,
- ! the indexing of decomposing pools from 0:ndecomp_pools is a
- ! bug. The lower bound should be 1. The index zero data shouldn't
- ! be used.
-
- !-- properties of each decomposing pool
- allocate(decomp_cascade_con%floating_cn_ratio_decomp_pools(0:ndecomp_pools))
- allocate(decomp_cascade_con%decomp_pool_name_restart(0:ndecomp_pools))
- allocate(decomp_cascade_con%decomp_pool_name_history(0:ndecomp_pools))
- allocate(decomp_cascade_con%decomp_pool_name_long(0:ndecomp_pools))
- allocate(decomp_cascade_con%decomp_pool_name_short(0:ndecomp_pools))
- allocate(decomp_cascade_con%is_litter(0:ndecomp_pools))
- allocate(decomp_cascade_con%is_soil(0:ndecomp_pools))
- allocate(decomp_cascade_con%is_cwd(0:ndecomp_pools))
- allocate(decomp_cascade_con%initial_cn_ratio(0:ndecomp_pools))
- allocate(decomp_cascade_con%initial_stock(0:ndecomp_pools))
- allocate(decomp_cascade_con%is_metabolic(0:ndecomp_pools))
- allocate(decomp_cascade_con%is_cellulose(0:ndecomp_pools))
- allocate(decomp_cascade_con%is_lignin(0:ndecomp_pools))
- allocate(decomp_cascade_con%spinup_factor(1:ndecomp_pools))
-
- !-- properties of each pathway along decomposition cascade
- decomp_cascade_con%cascade_step_name(1:ndecomp_cascade_transitions) = ''
- decomp_cascade_con%cascade_donor_pool(1:ndecomp_cascade_transitions) = 0
- decomp_cascade_con%cascade_receiver_pool(1:ndecomp_cascade_transitions) = 0
-
- !-- first initialization of properties of each decomposing pool
- decomp_cascade_con%floating_cn_ratio_decomp_pools(0:ndecomp_pools) = .false.
- decomp_cascade_con%decomp_pool_name_history(0:ndecomp_pools) = ''
- decomp_cascade_con%decomp_pool_name_restart(0:ndecomp_pools) = ''
- decomp_cascade_con%decomp_pool_name_long(0:ndecomp_pools) = ''
- decomp_cascade_con%decomp_pool_name_short(0:ndecomp_pools) = ''
- decomp_cascade_con%is_litter(0:ndecomp_pools) = .false.
- decomp_cascade_con%is_soil(0:ndecomp_pools) = .false.
- decomp_cascade_con%is_cwd(0:ndecomp_pools) = .false.
- decomp_cascade_con%initial_cn_ratio(0:ndecomp_pools) = nan
- decomp_cascade_con%initial_stock(0:ndecomp_pools) = nan
- decomp_cascade_con%initial_stock_soildepth = 0.3
- decomp_cascade_con%is_metabolic(0:ndecomp_pools) = .false.
- decomp_cascade_con%is_cellulose(0:ndecomp_pools) = .false.
- decomp_cascade_con%is_lignin(0:ndecomp_pools) = .false.
- decomp_cascade_con%spinup_factor(1:ndecomp_pools) = nan
-
- end subroutine init_decomp_cascade_constants
-
-end module SoilBiogeochemDecompCascadeConType
diff --git a/src/soilbiogeochem/SoilBiogeochemDecompMod.F90 b/src/soilbiogeochem/SoilBiogeochemDecompMod.F90
deleted file mode 100644
index 7906d8a8..00000000
--- a/src/soilbiogeochem/SoilBiogeochemDecompMod.F90
+++ /dev/null
@@ -1,245 +0,0 @@
-module SoilBiogeochemDecompMod
-
-#include "shr_assert.h"
-
- !-----------------------------------------------------------------------
- ! !DESCRIPTION:
- ! Module holding routines used in litter and soil decomposition model
- !
- ! !USES:
- use shr_kind_mod , only : r8 => shr_kind_r8
- use shr_log_mod , only : errMsg => shr_log_errMsg
- use decompMod , only : bounds_type
- use clm_varpar , only : nlevdecomp, ndecomp_cascade_transitions, ndecomp_pools
- use clm_varctl , only : use_nitrif_denitrif, use_fates
- use clm_varcon , only : dzsoi_decomp
- use SoilBiogeochemDecompCascadeConType , only : decomp_cascade_con
- use SoilBiogeochemStateType , only : soilbiogeochem_state_type
- use SoilBiogeochemCarbonStateType , only : soilbiogeochem_carbonstate_type
- use SoilBiogeochemCarbonFluxType , only : soilbiogeochem_carbonflux_type
- use SoilBiogeochemNitrogenStateType , only : soilbiogeochem_nitrogenstate_type
- use SoilBiogeochemNitrogenFluxType , only : soilbiogeochem_nitrogenflux_type
- !
- implicit none
- private
- !
- ! !PUBLIC MEMBER FUNCTIONS:
- public :: readParams
- public :: SoilBiogeochemDecomp
- !
- type, private :: params_type
- real(r8) :: dnp !denitrification proportion
- end type params_type
- !
- type(params_type), private :: params_inst
-
- character(len=*), parameter, private :: sourcefile = &
- __FILE__
- !-----------------------------------------------------------------------
-
-contains
-
- !-----------------------------------------------------------------------
- subroutine readParams ( ncid )
- !
- ! !DESCRIPTION:
- ! Read parameters
- !
- ! !USES:
- use ncdio_pio , only: file_desc_t,ncd_io
- use abortutils , only: endrun
- !
- ! !ARGUMENTS:
- type(file_desc_t),intent(inout) :: ncid ! pio netCDF file id
- !
- ! !LOCAL VARIABLES:
- 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='dnp'
- call ncd_io(trim(tString),tempr, 'read', ncid, readvar=readv)
- if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__))
- params_inst%dnp=tempr
-
- end subroutine readParams
-
- !-----------------------------------------------------------------------
- subroutine SoilBiogeochemDecomp (bounds, num_soilc, filter_soilc, &
- soilbiogeochem_state_inst, soilbiogeochem_carbonstate_inst, soilbiogeochem_carbonflux_inst, &
- soilbiogeochem_nitrogenstate_inst, soilbiogeochem_nitrogenflux_inst, &
- cn_decomp_pools, p_decomp_cpool_loss, pmnf_decomp_cascade)
- !
- ! !USES:
- !
- ! !ARGUMENT:
- 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
- type(soilbiogeochem_state_type) , intent(inout) :: soilbiogeochem_state_inst
- type(soilbiogeochem_carbonstate_type) , intent(in) :: soilbiogeochem_carbonstate_inst
- type(soilbiogeochem_carbonflux_type) , intent(inout) :: soilbiogeochem_carbonflux_inst
- type(soilbiogeochem_nitrogenstate_type) , intent(inout) :: soilbiogeochem_nitrogenstate_inst
- type(soilbiogeochem_nitrogenflux_type) , intent(inout) :: soilbiogeochem_nitrogenflux_inst
- real(r8) , intent(inout) :: cn_decomp_pools(bounds%begc:,1:,1:) ! c:n ratios of applicable pools
- real(r8) , intent(inout) :: p_decomp_cpool_loss(bounds%begc:,1:,1:) ! potential C loss from one pool to another
- real(r8) , intent(inout) :: pmnf_decomp_cascade(bounds%begc:,1:,1:) ! potential mineral N flux from one pool to another
- !
- ! !LOCAL VARIABLES:
- integer :: c,j,k,l,m ! indices
- integer :: fc ! lake filter column index
- integer :: begc,endc ! bounds
- integer, parameter :: i_atm = 0 !TODO - this appears in two places - move it to 1
- ! For methane code
- real(r8):: hrsum(bounds%begc:bounds%endc,1:nlevdecomp) ! sum of HR (gC/m2/s)
- !-----------------------------------------------------------------------
-
- begc = bounds%begc; endc = bounds%endc
-
- SHR_ASSERT_ALL((ubound(cn_decomp_pools) == (/endc,nlevdecomp,ndecomp_pools/)) , errMsg(sourcefile, __LINE__))
- SHR_ASSERT_ALL((ubound(p_decomp_cpool_loss) == (/endc,nlevdecomp,ndecomp_cascade_transitions/)) , errMsg(sourcefile, __LINE__))
- SHR_ASSERT_ALL((ubound(pmnf_decomp_cascade) == (/endc,nlevdecomp,ndecomp_cascade_transitions/)) , errMsg(sourcefile, __LINE__))
-
- associate( &
- 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
- floating_cn_ratio_decomp_pools => decomp_cascade_con%floating_cn_ratio_decomp_pools , & ! Input: [logical (:) ] TRUE => pool has fixed C:N ratio
- initial_cn_ratio => decomp_cascade_con%initial_cn_ratio , & ! Input: [real(r8) (:) ] c:n ratio for initialization of pools
-
- fpi_vr => soilbiogeochem_state_inst%fpi_vr_col , & ! Input: [real(r8) (:,:) ] fraction of potential immobilization (no units)
- rf_decomp_cascade => soilbiogeochem_state_inst%rf_decomp_cascade_col , & ! Input: [real(r8) (:,:,:) ] respired fraction in decomposition step (frac)
- pathfrac_decomp_cascade => soilbiogeochem_state_inst%pathfrac_decomp_cascade_col , & ! Input: [real(r8) (:,:,:) ] what fraction of C leaving a given pool passes through a given transition (frac)
-
- decomp_npools_vr => soilbiogeochem_nitrogenstate_inst%decomp_npools_vr_col , & ! Input: [real(r8) (:,:,:) ] (gC/m3) vertically-resolved decomposing (litter, cwd, soil) N pools
- decomp_cpools_vr => soilbiogeochem_carbonstate_inst%decomp_cpools_vr_col , & ! Input: [real(r8) (:,:,:) ] (gC/m3) vertically-resolved decomposing (litter, cwd, soil) c pools
-
- decomp_cascade_ntransfer_vr => soilbiogeochem_nitrogenflux_inst%decomp_cascade_ntransfer_vr_col , & ! Output: [real(r8) (:,:,:) ] vert-res transfer of N from donor to receiver pool along decomp. cascade (gN/m3/s)
- decomp_cascade_sminn_flux_vr => soilbiogeochem_nitrogenflux_inst%decomp_cascade_sminn_flux_vr_col , & ! Output: [real(r8) (:,:,:) ] vert-res mineral N flux for transition along decomposition cascade (gN/m3/s)
- potential_immob_vr => soilbiogeochem_nitrogenflux_inst%potential_immob_vr_col , & ! Output: [real(r8) (:,:) ]
- sminn_to_denit_decomp_cascade_vr => soilbiogeochem_nitrogenflux_inst%sminn_to_denit_decomp_cascade_vr_col , & ! Output: [real(r8) (:,:,:) ]
- gross_nmin_vr => soilbiogeochem_nitrogenflux_inst%gross_nmin_vr_col , & ! Output: [real(r8) (:,:) ]
- net_nmin_vr => soilbiogeochem_nitrogenflux_inst%net_nmin_vr_col , & ! Output: [real(r8) (:,:) ]
- gross_nmin => soilbiogeochem_nitrogenflux_inst%gross_nmin_col , & ! Output: [real(r8) (:) ] gross rate of N mineralization (gN/m2/s)
- net_nmin => soilbiogeochem_nitrogenflux_inst%net_nmin_col , & ! Output: [real(r8) (:) ] net rate of N mineralization (gN/m2/s)
-
- w_scalar => soilbiogeochem_carbonflux_inst%w_scalar_col , & ! Input: [real(r8) (:,:) ] fraction by which decomposition is limited by moisture availability
- decomp_cascade_hr_vr => soilbiogeochem_carbonflux_inst%decomp_cascade_hr_vr_col , & ! Output: [real(r8) (:,:,:) ] vertically-resolved het. resp. from decomposing C pools (gC/m3/s)
- decomp_cascade_ctransfer_vr => soilbiogeochem_carbonflux_inst%decomp_cascade_ctransfer_vr_col , & ! Output: [real(r8) (:,:,:) ] vertically-resolved het. resp. from decomposing C pools (gC/m3/s)
- decomp_k => soilbiogeochem_carbonflux_inst%decomp_k_col , & ! Output: [real(r8) (:,:,:) ] rate constant for decomposition (1./sec)
- phr_vr => soilbiogeochem_carbonflux_inst%phr_vr_col , & ! Input: [real(r8) (:,:) ] potential HR (gC/m3/s)
- fphr => soilbiogeochem_carbonflux_inst%fphr_col & ! Output: [real(r8) (:,:) ] fraction of potential SOM + LITTER heterotrophic
- )
-
- ! column loop to calculate actual immobilization and decomp rates, following
- ! resolution of plant/heterotroph competition for mineral N
-
- if ( .not. use_fates) then
- ! calculate c:n ratios of applicable pools
- do l = 1, ndecomp_pools
- if ( floating_cn_ratio_decomp_pools(l) ) then
- do j = 1,nlevdecomp
- do fc = 1,num_soilc
- c = filter_soilc(fc)
- if ( decomp_npools_vr(c,j,l) > 0._r8 ) then
- cn_decomp_pools(c,j,l) = decomp_cpools_vr(c,j,l) / decomp_npools_vr(c,j,l)
- end if
- end do
- end do
- else
- do j = 1,nlevdecomp
- do fc = 1,num_soilc
- c = filter_soilc(fc)
- cn_decomp_pools(c,j,l) = initial_cn_ratio(l)
- end do
- end do
- end if
- end do
-
- ! column loop to calculate actual immobilization and decomp rates, following
- ! resolution of plant/heterotroph competition for mineral N
-
- ! upon return from SoilBiogeochemCompetition, the fraction of potential immobilization
- ! has been set (soilbiogeochem_state_inst%fpi_vr_col). now finish the decomp calculations.
- ! Only the immobilization steps are limited by fpi_vr (pmnf > 0)
- ! Also calculate denitrification losses as a simple proportion
- ! of mineralization flux.
-
- do k = 1, ndecomp_cascade_transitions
- do j = 1,nlevdecomp
- do fc = 1,num_soilc
- c = filter_soilc(fc)
-
- if (decomp_cpools_vr(c,j,cascade_donor_pool(k)) > 0._r8) then
- if ( pmnf_decomp_cascade(c,j,k) > 0._r8 ) then
- p_decomp_cpool_loss(c,j,k) = p_decomp_cpool_loss(c,j,k) * fpi_vr(c,j)
- pmnf_decomp_cascade(c,j,k) = pmnf_decomp_cascade(c,j,k) * fpi_vr(c,j)
- if (.not. use_nitrif_denitrif) then
- sminn_to_denit_decomp_cascade_vr(c,j,k) = 0._r8
- end if
- else
- if (.not. use_nitrif_denitrif) then
- sminn_to_denit_decomp_cascade_vr(c,j,k) = -params_inst%dnp * pmnf_decomp_cascade(c,j,k)
- end if
- end if
- decomp_cascade_hr_vr(c,j,k) = rf_decomp_cascade(c,j,k) * p_decomp_cpool_loss(c,j,k)
- decomp_cascade_ctransfer_vr(c,j,k) = (1._r8 - rf_decomp_cascade(c,j,k)) * p_decomp_cpool_loss(c,j,k)
- if (decomp_npools_vr(c,j,cascade_donor_pool(k)) > 0._r8 .and. cascade_receiver_pool(k) /= i_atm) then
- decomp_cascade_ntransfer_vr(c,j,k) = p_decomp_cpool_loss(c,j,k) / cn_decomp_pools(c,j,cascade_donor_pool(k))
- else
- decomp_cascade_ntransfer_vr(c,j,k) = 0._r8
- endif
- if ( cascade_receiver_pool(k) /= 0 ) then
- decomp_cascade_sminn_flux_vr(c,j,k) = pmnf_decomp_cascade(c,j,k)
- else ! keep sign convention negative for terminal pools
- decomp_cascade_sminn_flux_vr(c,j,k) = - pmnf_decomp_cascade(c,j,k)
- endif
- net_nmin_vr(c,j) = net_nmin_vr(c,j) - pmnf_decomp_cascade(c,j,k)
- else
- decomp_cascade_ntransfer_vr(c,j,k) = 0._r8
- if (.not. use_nitrif_denitrif) then
- sminn_to_denit_decomp_cascade_vr(c,j,k) = 0._r8
- end if
- decomp_cascade_sminn_flux_vr(c,j,k) = 0._r8
- end if
-
- end do
- end do
- end do
- else
- do k = 1, ndecomp_cascade_transitions
- do j = 1,nlevdecomp
- do fc = 1,num_soilc
- c = filter_soilc(fc)
- !
- decomp_cascade_hr_vr(c,j,k) = rf_decomp_cascade(c,j,k) * p_decomp_cpool_loss(c,j,k)
- !
- decomp_cascade_ctransfer_vr(c,j,k) = (1._r8 - rf_decomp_cascade(c,j,k)) * p_decomp_cpool_loss(c,j,k)
- !
- end do
- end do
- end do
- end if
-
-
- ! vertically integrate net and gross mineralization fluxes for diagnostic output
-
- do fc = 1,num_soilc
- c = filter_soilc(fc)
- do j = 1,nlevdecomp
- if(.not.use_fates)then
- net_nmin(c) = net_nmin(c) + net_nmin_vr(c,j) * dzsoi_decomp(j)
- gross_nmin(c) = gross_nmin(c) + gross_nmin_vr(c,j) * dzsoi_decomp(j)
- ! else
- ! net_nmin(c) = 0.0_r8
- ! gross_nmin(c) = 0.0_r8
- endif
- end do
- end do
-
- end associate
-
- end subroutine SoilBiogeochemDecomp
-
-end module SoilBiogeochemDecompMod
diff --git a/src/soilbiogeochem/SoilBiogeochemLittVertTranspMod.F90 b/src/soilbiogeochem/SoilBiogeochemLittVertTranspMod.F90
deleted file mode 100644
index c9482667..00000000
--- a/src/soilbiogeochem/SoilBiogeochemLittVertTranspMod.F90
+++ /dev/null
@@ -1,494 +0,0 @@
-module SoilBiogeochemLittVertTranspMod
-
- !-----------------------------------------------------------------------
- ! calculate vertical mixing of all decomposing C and N pools
- !
- use shr_kind_mod , only : r8 => shr_kind_r8
- use shr_log_mod , only : errMsg => shr_log_errMsg
- use clm_varctl , only : iulog, spinup_state, use_vertsoilc, use_fates, use_cn
- use clm_varcon , only : secspday
- use decompMod , only : bounds_type
- use abortutils , only : endrun
- use CanopyStateType , only : canopystate_type
- use SoilBiogeochemStateType , only : soilbiogeochem_state_type
- use SoilBiogeochemCarbonFluxType , only : soilbiogeochem_carbonflux_type
- use SoilBiogeochemCarbonStateType , only : soilbiogeochem_carbonstate_type
- use SoilBiogeochemNitrogenFluxType , only : soilbiogeochem_nitrogenflux_type
- use SoilBiogeochemNitrogenStateType , only : soilbiogeochem_nitrogenstate_type
- use SoilBiogeochemDecompCascadeConType , only : decomp_cascade_con
- use ColumnType , only : col
- use GridcellType , only : grc
- use SoilBiogeochemStateType , only : get_spinup_latitude_term
- !
- implicit none
- private
- !
- public :: readParams
- public :: SoilBiogeochemLittVertTransp
-
- type, private :: params_type
- real(r8) :: som_diffus ! Soil organic matter diffusion
- real(r8) :: cryoturb_diffusion_k ! The cryoturbation diffusive constant cryoturbation to the active layer thickness
- real(r8) :: max_altdepth_cryoturbation ! (m) maximum active layer thickness for cryoturbation to occur
- end type params_type
-
- type(params_type), private :: params_inst
- !
- real(r8), public :: som_adv_flux = 0._r8
- real(r8), public :: max_depth_cryoturb = 3._r8 ! (m) this is the maximum depth of cryoturbation
- real(r8) :: som_diffus ! [m^2/sec] = 1 cm^2 / yr
- real(r8) :: cryoturb_diffusion_k ! [m^2/sec] = 5 cm^2 / yr = 1m^2 / 200 yr
- real(r8) :: max_altdepth_cryoturbation ! (m) maximum active layer thickness for cryoturbation to occur
-
- character(len=*), parameter, private :: sourcefile = &
- __FILE__
- !-----------------------------------------------------------------------
-
-contains
-
- !-----------------------------------------------------------------------
- subroutine readParams ( ncid )
- !
- use ncdio_pio , only : file_desc_t,ncd_io
- !
- type(file_desc_t),intent(inout) :: ncid ! pio netCDF file id
- !
- character(len=32) :: subname = 'SoilBiogeochemLittVertTranspType'
- 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 parameters
- !
-
- tString='som_diffus'
- call ncd_io(trim(tString),tempr, 'read', ncid, readvar=readv)
- if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__))
- !soilbiogeochem_litt_verttransp_params_inst%som_diffus=tempr
- ! FIX(SPM,032414) - can't be pulled out since division makes things not bfb
- params_inst%som_diffus = 1e-4_r8 / (secspday * 365._r8)
-
- tString='cryoturb_diffusion_k'
- call ncd_io(trim(tString),tempr, 'read', ncid, readvar=readv)
- if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__))
- !soilbiogeochem_litt_verttransp_params_inst%cryoturb_diffusion_k=tempr
- !FIX(SPM,032414) Todo. This constant cannot be on file since the divide makes things
- !SPM Todo. This constant cannot be on file since the divide makes things
- !not bfb
- params_inst%cryoturb_diffusion_k = 5e-4_r8 / (secspday * 365._r8) ! [m^2/sec] = 5 cm^2 / yr = 1m^2 / 200 yr
-
- tString='max_altdepth_cryoturbation'
- call ncd_io(trim(tString),tempr, 'read', ncid, readvar=readv)
- if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__))
- params_inst%max_altdepth_cryoturbation=tempr
-
- end subroutine readParams
-
- !-----------------------------------------------------------------------
- subroutine SoilBiogeochemLittVertTransp(bounds, num_soilc, filter_soilc, &
- canopystate_inst, soilbiogeochem_state_inst, &
- soilbiogeochem_carbonstate_inst, soilbiogeochem_carbonflux_inst, &
- c13_soilbiogeochem_carbonstate_inst, c13_soilbiogeochem_carbonflux_inst, &
- c14_soilbiogeochem_carbonstate_inst, c14_soilbiogeochem_carbonflux_inst, &
- soilbiogeochem_nitrogenstate_inst, soilbiogeochem_nitrogenflux_inst)
- !
- ! !DESCRIPTION:
- ! Calculate vertical mixing of soil and litter pools. Also reconcile sources and sinks of these pools
- ! calculated in the CStateUpdate1 and NStateUpdate1 subroutines.
- ! Advection-diffusion code based on algorithm in Patankar (1980)
- ! Initial code by C. Koven and W. Riley
- !
- ! !USES:
- use clm_time_manager , only : get_step_size
- use clm_varpar , only : nlevdecomp, ndecomp_pools, nlevdecomp_full
- use clm_varcon , only : zsoi, dzsoi_decomp, zisoi
- use TridiagonalMod , only : Tridiagonal
- use ColumnType , only : col
- use clm_varctl , only : use_bedrock
-
- !
- ! !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
- type(canopystate_type) , intent(in) :: canopystate_inst
- type(soilbiogeochem_state_type) , intent(inout) :: soilbiogeochem_state_inst
- type(soilbiogeochem_carbonstate_type) , intent(inout) :: soilbiogeochem_carbonstate_inst
- type(soilbiogeochem_carbonflux_type) , intent(inout) :: soilbiogeochem_carbonflux_inst
- type(soilbiogeochem_carbonstate_type) , intent(inout) :: c13_soilbiogeochem_carbonstate_inst
- type(soilbiogeochem_carbonflux_type) , intent(inout) :: c13_soilbiogeochem_carbonflux_inst
- type(soilbiogeochem_carbonstate_type) , intent(inout) :: c14_soilbiogeochem_carbonstate_inst
- type(soilbiogeochem_carbonflux_type) , intent(inout) :: c14_soilbiogeochem_carbonflux_inst
- type(soilbiogeochem_nitrogenstate_type) , intent(inout) :: soilbiogeochem_nitrogenstate_inst
- type(soilbiogeochem_nitrogenflux_type) , intent(inout) :: soilbiogeochem_nitrogenflux_inst
- !
- ! !LOCAL VARIABLES:
- real(r8) :: diffus (bounds%begc:bounds%endc,1:nlevdecomp+1) ! diffusivity (m2/s) (includes spinup correction, if any)
- real(r8) :: adv_flux(bounds%begc:bounds%endc,1:nlevdecomp+1) ! advective flux (m/s) (includes spinup correction, if any)
- real(r8) :: aaa ! "A" function in Patankar
- real(r8) :: pe ! Pe for "A" function in Patankar
- real(r8) :: w_m1, w_p1 ! Weights for calculating harmonic mean of diffusivity
- real(r8) :: d_m1, d_p1 ! Harmonic mean of diffusivity
- real(r8) :: a_tri(bounds%begc:bounds%endc,0:nlevdecomp+1) ! "a" vector for tridiagonal matrix
- real(r8) :: b_tri(bounds%begc:bounds%endc,0:nlevdecomp+1) ! "b" vector for tridiagonal matrix
- real(r8) :: c_tri(bounds%begc:bounds%endc,0:nlevdecomp+1) ! "c" vector for tridiagonal matrix
- real(r8) :: r_tri(bounds%begc:bounds%endc,0:nlevdecomp+1) ! "r" vector for tridiagonal solution
- real(r8) :: d_p1_zp1(bounds%begc:bounds%endc,1:nlevdecomp+1) ! diffusivity/delta_z for next j (set to zero for no diffusion)
- real(r8) :: d_m1_zm1(bounds%begc:bounds%endc,1:nlevdecomp+1) ! diffusivity/delta_z for previous j (set to zero for no diffusion)
- real(r8) :: f_p1(bounds%begc:bounds%endc,1:nlevdecomp+1) ! water flux for next j
- real(r8) :: f_m1(bounds%begc:bounds%endc,1:nlevdecomp+1) ! water flux for previous j
- real(r8) :: pe_p1(bounds%begc:bounds%endc,1:nlevdecomp+1) ! Peclet # for next j
- real(r8) :: pe_m1(bounds%begc:bounds%endc,1:nlevdecomp+1) ! Peclet # for previous j
- real(r8) :: dz_node(1:nlevdecomp+1) ! difference between nodes
- real(r8) :: epsilon_t (bounds%begc:bounds%endc,1:nlevdecomp+1,1:ndecomp_pools) !
- real(r8) :: conc_trcr(bounds%begc:bounds%endc,0:nlevdecomp+1) !
- real(r8) :: a_p_0
- real(r8) :: deficit
- integer :: ntype
- integer :: i_type,s,fc,c,j,l ! indices
- integer :: jtop(bounds%begc:bounds%endc) ! top level at each column
- real(r8) :: dtime ! land model time step (sec)
- integer :: zerolev_diffus
- real(r8) :: spinup_term ! spinup accelerated decomposition factor, used to accelerate transport as well
- real(r8) :: epsilon ! small number
- real(r8), pointer :: conc_ptr(:,:,:) ! pointer, concentration state variable being transported
- real(r8), pointer :: source(:,:,:) ! pointer, source term
- real(r8), pointer :: trcr_tendency_ptr(:,:,:) ! poiner, store the vertical tendency (gain/loss due to vertical transport)
- !-----------------------------------------------------------------------
-
- ! Set statement functions
- aaa (pe) = max (0._r8, (1._r8 - 0.1_r8 * abs(pe))**5) ! A function from Patankar, Table 5.2, pg 95
-
- associate( &
- is_cwd => decomp_cascade_con%is_cwd , & ! Input: [logical (:) ] TRUE => pool is a cwd pool
- spinup_factor => decomp_cascade_con%spinup_factor , & ! Input: [real(r8) (:) ] spinup accelerated decomposition factor, used to accelerate transport as well
-
- altmax => canopystate_inst%altmax_col , & ! Input: [real(r8) (:) ] maximum annual depth of thaw
- altmax_lastyear => canopystate_inst%altmax_lastyear_col , & ! Input: [real(r8) (:) ] prior year maximum annual depth of thaw
-
- som_adv_coef => soilbiogeochem_state_inst%som_adv_coef_col , & ! Output: [real(r8) (:,:) ] SOM advective flux (m/s)
- som_diffus_coef => soilbiogeochem_state_inst%som_diffus_coef_col & ! Output: [real(r8) (:,:) ] SOM diffusivity due to bio/cryo-turbation (m2/s)
- )
-
- !Set parameters of vertical mixing of SOM
- som_diffus = params_inst%som_diffus
- cryoturb_diffusion_k = params_inst%cryoturb_diffusion_k
- max_altdepth_cryoturbation = params_inst%max_altdepth_cryoturbation
-
- dtime = get_step_size()
-
- ntype = 2
- if ( use_fates ) then
- ntype = 1
- endif
- spinup_term = 1._r8
- epsilon = 1.e-30
-
- if (use_vertsoilc) then
- !------ first get diffusivity / advection terms -------!
- ! use different mixing rates for bioturbation and cryoturbation, with fixed bioturbation and cryoturbation set to a maximum depth
- do fc = 1, num_soilc
- c = filter_soilc (fc)
- if (( max(altmax(c), altmax_lastyear(c)) <= max_altdepth_cryoturbation ) .and. &
- ( max(altmax(c), altmax_lastyear(c)) > 0._r8) ) then
- ! use mixing profile modified slightly from Koven et al. (2009): constant through active layer, linear decrease from base of active layer to zero at a fixed depth
- do j = 1,nlevdecomp+1
- if ( j <= col%nbedrock(c)+1 ) then
- if ( zisoi(j) < max(altmax(c), altmax_lastyear(c)) ) then
- som_diffus_coef(c,j) = cryoturb_diffusion_k
- som_adv_coef(c,j) = 0._r8
- else
- som_diffus_coef(c,j) = max(cryoturb_diffusion_k * &
- ( 1._r8 - ( zisoi(j) - max(altmax(c), altmax_lastyear(c)) ) / &
- ( min(max_depth_cryoturb, zisoi(col%nbedrock(c)+1)) - max(altmax(c), altmax_lastyear(c)) ) ), 0._r8) ! go linearly to zero between ALT and max_depth_cryoturb
- som_adv_coef(c,j) = 0._r8
- endif
- else
- som_adv_coef(c,j) = 0._r8
- som_diffus_coef(c,j) = 0._r8
- endif
- end do
- elseif ( max(altmax(c), altmax_lastyear(c)) > 0._r8 ) then
- ! constant advection, constant diffusion
- do j = 1,nlevdecomp+1
- if ( j <= col%nbedrock(c)+1 ) then
- som_adv_coef(c,j) = som_adv_flux
- som_diffus_coef(c,j) = som_diffus
- else
- som_adv_coef(c,j) = 0._r8
- som_diffus_coef(c,j) = 0._r8
- endif
- end do
- else
- ! completely frozen soils--no mixing
- do j = 1,nlevdecomp+1
- som_adv_coef(c,j) = 0._r8
- som_diffus_coef(c,j) = 0._r8
- end do
- endif
- end do
-
- ! Set the distance between the node and the one ABOVE it
- dz_node(1) = zsoi(1)
- do j = 2,nlevdecomp+1
- dz_node(j)= zsoi(j) - zsoi(j-1)
- enddo
-
- endif
-
- !------ loop over litter/som types
- do i_type = 1, ntype
-
- select case (i_type)
- case (1) ! C
- conc_ptr => soilbiogeochem_carbonstate_inst%decomp_cpools_vr_col
- source => soilbiogeochem_carbonflux_inst%decomp_cpools_sourcesink_col
- trcr_tendency_ptr => soilbiogeochem_carbonflux_inst%decomp_cpools_transport_tendency_col
- case (2) ! N
- if (use_cn ) then
- conc_ptr => soilbiogeochem_nitrogenstate_inst%decomp_npools_vr_col
- source => soilbiogeochem_nitrogenflux_inst%decomp_npools_sourcesink_col
- trcr_tendency_ptr => soilbiogeochem_nitrogenflux_inst%decomp_npools_transport_tendency_col
- endif
- case (3)
- write(iulog,*) 'error. ncase = 4, but c13 and c14 not both enabled.'
- call endrun(msg=errMsg(sourcefile, __LINE__))
- case (4)
- write(iulog,*) 'error. ncase = 4, but c13 and c14 not both enabled.'
- call endrun(msg=errMsg(sourcefile, __LINE__))
- end select
-
- if (use_vertsoilc) then
-
- do s = 1, ndecomp_pools
-
- if ( .not. is_cwd(s) ) then
-
- do j = 1,nlevdecomp+1
- do fc = 1, num_soilc
- c = filter_soilc (fc)
- !
- if ( spinup_state >= 1 ) then
- ! increase transport (both advection and diffusion) by the same factor as accelerated decomposition for a given pool
- spinup_term = spinup_factor(s)
- else
- spinup_term = 1._r8
- endif
-
- if (abs(spinup_term - 1._r8) > .000001_r8 ) then
- spinup_term = spinup_term * get_spinup_latitude_term(grc%latdeg(col%gridcell(c)))
- endif
-
- if ( abs(som_adv_coef(c,j)) * spinup_term < epsilon ) then
- adv_flux(c,j) = epsilon
- else
- adv_flux(c,j) = som_adv_coef(c,j) * spinup_term
- endif
- !
- if ( abs(som_diffus_coef(c,j)) * spinup_term < epsilon ) then
- diffus(c,j) = epsilon
- else
- diffus(c,j) = som_diffus_coef(c,j) * spinup_term
- endif
- !
- end do
- end do
-
- ! Set Pe (Peclet #) and D/dz throughout column
-
- do fc = 1, num_soilc ! dummy terms here
- c = filter_soilc (fc)
- conc_trcr(c,0) = 0._r8
- conc_trcr(c,col%nbedrock(c)+1:nlevdecomp+1) = 0._r8
- end do
-
-
- do j = 1,nlevdecomp+1
- do fc = 1, num_soilc
- c = filter_soilc (fc)
-
- conc_trcr(c,j) = conc_ptr(c,j,s)
-
- ! dz_tracer below is the difference between gridcell edges (dzsoi_decomp)
- ! dz_node_tracer is difference between cell centers
-
- ! Calculate the D and F terms in the Patankar algorithm
- if (j == 1) then
- d_m1_zm1(c,j) = 0._r8
- w_p1 = (zsoi(j+1) - zisoi(j)) / dz_node(j+1)
- if ( diffus(c,j+1) > 0._r8 .and. diffus(c,j) > 0._r8) then
- d_p1 = 1._r8 / ((1._r8 - w_p1) / diffus(c,j) + w_p1 / diffus(c,j+1)) ! Harmonic mean of diffus
- else
- d_p1 = 0._r8
- endif
- d_p1_zp1(c,j) = d_p1 / dz_node(j+1)
- f_m1(c,j) = adv_flux(c,j) ! Include infiltration here
- f_p1(c,j) = adv_flux(c,j+1)
- pe_m1(c,j) = 0._r8
- pe_p1(c,j) = f_p1(c,j) / d_p1_zp1(c,j) ! Peclet #
- elseif (j >= col%nbedrock(c)+1) then
- ! At the bottom, assume no gradient in d_z (i.e., they're the same)
- w_m1 = (zisoi(j-1) - zsoi(j-1)) / dz_node(j)
- if ( diffus(c,j) > 0._r8 .and. diffus(c,j-1) > 0._r8) then
- d_m1 = 1._r8 / ((1._r8 - w_m1) / diffus(c,j) + w_m1 / diffus(c,j-1)) ! Harmonic mean of diffus
- else
- d_m1 = 0._r8
- endif
- d_m1_zm1(c,j) = d_m1 / dz_node(j)
- d_p1_zp1(c,j) = d_m1_zm1(c,j) ! Set to be the same
- f_m1(c,j) = adv_flux(c,j)
- !f_p1(c,j) = adv_flux(c,j+1)
- f_p1(c,j) = 0._r8
- pe_m1(c,j) = f_m1(c,j) / d_m1_zm1(c,j) ! Peclet #
- pe_p1(c,j) = f_p1(c,j) / d_p1_zp1(c,j) ! Peclet #
- else
- ! Use distance from j-1 node to interface with j divided by distance between nodes
- w_m1 = (zisoi(j-1) - zsoi(j-1)) / dz_node(j)
- if ( diffus(c,j-1) > 0._r8 .and. diffus(c,j) > 0._r8) then
- d_m1 = 1._r8 / ((1._r8 - w_m1) / diffus(c,j) + w_m1 / diffus(c,j-1)) ! Harmonic mean of diffus
- else
- d_m1 = 0._r8
- endif
- w_p1 = (zsoi(j+1) - zisoi(j)) / dz_node(j+1)
- if ( diffus(c,j+1) > 0._r8 .and. diffus(c,j) > 0._r8) then
- d_p1 = 1._r8 / ((1._r8 - w_p1) / diffus(c,j) + w_p1 / diffus(c,j+1)) ! Harmonic mean of diffus
- else
- d_p1 = (1._r8 - w_m1) * diffus(c,j) + w_p1 * diffus(c,j+1) ! Arithmetic mean of diffus
- endif
- d_m1_zm1(c,j) = d_m1 / dz_node(j)
- d_p1_zp1(c,j) = d_p1 / dz_node(j+1)
- f_m1(c,j) = adv_flux(c,j)
- f_p1(c,j) = adv_flux(c,j+1)
- pe_m1(c,j) = f_m1(c,j) / d_m1_zm1(c,j) ! Peclet #
- pe_p1(c,j) = f_p1(c,j) / d_p1_zp1(c,j) ! Peclet #
- end if
- enddo ! fc
- enddo ! j; nlevdecomp
-
-
- ! Calculate the tridiagonal coefficients
- do j = 0,nlevdecomp +1
- do fc = 1, num_soilc
- c = filter_soilc (fc)
- ! g = cgridcell(c)
-
- if (j > 0 .and. j < nlevdecomp+1) then
- a_p_0 = dzsoi_decomp(j) / dtime
- endif
-
- if (j == 0) then ! top layer (atmosphere)
- a_tri(c,j) = 0._r8
- b_tri(c,j) = 1._r8
- c_tri(c,j) = -1._r8
- r_tri(c,j) = 0._r8
- elseif (j == 1) then
- a_tri(c,j) = -(d_m1_zm1(c,j) * aaa(pe_m1(c,j)) + max( f_m1(c,j), 0._r8)) ! Eqn 5.47 Patankar
- c_tri(c,j) = -(d_p1_zp1(c,j) * aaa(pe_p1(c,j)) + max(-f_p1(c,j), 0._r8))
- b_tri(c,j) = -a_tri(c,j) - c_tri(c,j) + a_p_0
- r_tri(c,j) = source(c,j,s) * dzsoi_decomp(j) /dtime + (a_p_0 - adv_flux(c,j)) * conc_trcr(c,j)
- elseif (j < nlevdecomp+1) then
- a_tri(c,j) = -(d_m1_zm1(c,j) * aaa(pe_m1(c,j)) + max( f_m1(c,j), 0._r8)) ! Eqn 5.47 Patankar
- c_tri(c,j) = -(d_p1_zp1(c,j) * aaa(pe_p1(c,j)) + max(-f_p1(c,j), 0._r8))
- b_tri(c,j) = -a_tri(c,j) - c_tri(c,j) + a_p_0
- r_tri(c,j) = source(c,j,s) * dzsoi_decomp(j) /dtime + a_p_0 * conc_trcr(c,j)
- else ! j==nlevdecomp+1; 0 concentration gradient at bottom
- a_tri(c,j) = -1._r8
- b_tri(c,j) = 1._r8
- c_tri(c,j) = 0._r8
- r_tri(c,j) = 0._r8
- endif
- enddo ! fc; column
- enddo ! j; nlevdecomp
-
- do fc = 1, num_soilc
- c = filter_soilc (fc)
- jtop(c) = 0
- enddo
-
- ! subtract initial concentration and source terms for tendency calculation
- do fc = 1, num_soilc
- c = filter_soilc (fc)
- do j = 1, nlevdecomp
- trcr_tendency_ptr(c,j,s) = 0.-(conc_trcr(c,j) + source(c,j,s))
- end do
- end do
-
- ! Solve for the concentration profile for this time step
- call Tridiagonal(bounds, 0, nlevdecomp+1, &
- jtop(bounds%begc:bounds%endc), &
- num_soilc, filter_soilc, &
- a_tri(bounds%begc:bounds%endc, :), &
- b_tri(bounds%begc:bounds%endc, :), &
- c_tri(bounds%begc:bounds%endc, :), &
- r_tri(bounds%begc:bounds%endc, :), &
- conc_trcr(bounds%begc:bounds%endc,0:nlevdecomp+1))
-
- ! add post-transport concentration to calculate tendency term
- do fc = 1, num_soilc
- c = filter_soilc (fc)
- do j = 1, nlevdecomp
- trcr_tendency_ptr(c,j,s) = trcr_tendency_ptr(c,j,s) + conc_trcr(c,j)
- trcr_tendency_ptr(c,j,s) = trcr_tendency_ptr(c,j,s) / dtime
- end do
- end do
-
- else
- ! for CWD pools, just add
- do j = 1,nlevdecomp
- do fc = 1, num_soilc
- c = filter_soilc (fc)
- conc_trcr(c,j) = conc_ptr(c,j,s) + source(c,j,s)
- if (j > col%nbedrock(c) .and. source(c,j,s) > 0._r8) then
- write(iulog,*) 'source >0',c,j,s,source(c,j,s)
- end if
- if (j > col%nbedrock(c) .and. conc_ptr(c,j,s) > 0._r8) then
- write(iulog,*) 'conc_ptr >0',c,j,s,conc_ptr(c,j,s)
- end if
-
- end do
- end do
-
- end if ! not CWD
-
- do j = 1,nlevdecomp
- do fc = 1, num_soilc
- c = filter_soilc (fc)
- conc_ptr(c,j,s) = conc_trcr(c,j)
- ! Correct for small amounts of carbon that leak into bedrock
- if (j > col%nbedrock(c)) then
- conc_ptr(c,col%nbedrock(c),s) = conc_ptr(c,col%nbedrock(c),s) + &
- conc_trcr(c,j) * (dzsoi_decomp(j) / dzsoi_decomp(col%nbedrock(c)))
- conc_ptr(c,j,s) = 0._r8
- end if
- end do
- end do
-
- end do ! s (pool loop)
-
- else
-
- !! for single level case, no transport; just update the fluxes calculated in the StateUpdate1 subroutines
- do l = 1, ndecomp_pools
- do j = 1,nlevdecomp
- do fc = 1, num_soilc
- c = filter_soilc (fc)
-
- conc_ptr(c,j,l) = conc_ptr(c,j,l) + source(c,j,l)
-
- trcr_tendency_ptr(c,j,l) = 0._r8
-
- end do
- end do
- end do
-
- endif
-
- end do ! i_type
-
- end associate
-
- end subroutine SoilBiogeochemLittVertTransp
-
-end module SoilBiogeochemLittVertTranspMod
diff --git a/src/soilbiogeochem/SoilBiogeochemNLeachingMod.F90 b/src/soilbiogeochem/SoilBiogeochemNLeachingMod.F90
deleted file mode 100644
index 3a0cb0c9..00000000
--- a/src/soilbiogeochem/SoilBiogeochemNLeachingMod.F90
+++ /dev/null
@@ -1,289 +0,0 @@
-module SoilBiogeochemNLeachingMod
-
- !-----------------------------------------------------------------------
- ! !DESCRIPTION:
- ! Module for mineral nitrogen dynamics (deposition, fixation, leaching)
- ! for coupled carbon-nitrogen code.
- !
- ! !USES:
- use shr_kind_mod , only : r8 => shr_kind_r8
- use decompMod , only : bounds_type
- use clm_varcon , only : dzsoi_decomp, zisoi
- use clm_varctl , only : use_nitrif_denitrif, use_vertsoilc
- use SoilBiogeochemNitrogenStateType , only : soilbiogeochem_nitrogenstate_type
- use SoilBiogeochemNitrogenFluxType , only : soilbiogeochem_nitrogenflux_type
- use WaterStateType , only : waterstate_type
- use WaterFluxType , only : waterflux_type
- use ColumnType , only : col
- !
- implicit none
- private
- !
- ! !PUBLIC MEMBER FUNCTIONS:
- public :: readParams
- public :: SoilBiogeochemNLeaching
- !
- ! !PRIVATE DATA:
- type, private :: params_type
- real(r8):: sf ! soluble fraction of mineral N (unitless)
- real(r8):: sf_no3 ! soluble fraction of NO3 (unitless)
- end type params_type
-
- type(params_type), private :: params_inst
-
- character(len=*), parameter, private :: sourcefile = &
- __FILE__
- !-----------------------------------------------------------------------
-
-contains
-
- !-----------------------------------------------------------------------
- subroutine readParams ( ncid )
- !
- ! !DESCRIPTION:
- ! Read in parameters
- !
- ! !USES:
- use ncdio_pio , only : file_desc_t,ncd_io
- use abortutils , only : endrun
- use shr_log_mod , only : errMsg => shr_log_errMsg
- !
- ! !ARGUMENTS:
- type(file_desc_t),intent(inout) :: ncid ! pio netCDF file id
- !
- ! !LOCAL VARIABLES:
- character(len=32) :: subname = 'CNNDynamicsParamsType'
- 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='sf_minn'
- 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(sourcefile, __LINE__))
- params_inst%sf=tempr
-
- tString='sf_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(sourcefile, __LINE__))
- params_inst%sf_no3=tempr
-
- end subroutine readParams
-
- !-----------------------------------------------------------------------
- subroutine SoilBiogeochemNLeaching(bounds, num_soilc, filter_soilc, &
- waterstate_inst, waterflux_inst, &
- soilbiogeochem_nitrogenstate_inst, soilbiogeochem_nitrogenflux_inst)
- !
- ! !DESCRIPTION:
- ! On the radiation time step, update the nitrogen leaching rate
- ! as a function of soluble mineral N and total soil water outflow.
- !
- ! !USES:
- use clm_varpar , only : nlevdecomp, nlevsoi
- 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
- type(waterstate_type) , intent(in) :: waterstate_inst
- type(waterflux_type) , intent(in) :: waterflux_inst
- type(soilbiogeochem_nitrogenstate_type) , intent(in) :: soilbiogeochem_nitrogenstate_inst
- type(soilbiogeochem_nitrogenflux_type) , intent(inout) :: soilbiogeochem_nitrogenflux_inst
- !
- ! !LOCAL VARIABLES:
- integer :: j,c,fc ! indices
- real(r8) :: dt ! radiation time step (seconds)
- real(r8) :: sf ! soluble fraction of mineral N (unitless)
- real(r8) :: sf_no3 ! soluble fraction of NO3 (unitless)
- real(r8) :: disn_conc ! dissolved mineral N concentration (gN/kg water)
- real(r8) :: tot_water(bounds%begc:bounds%endc) ! total column liquid water (kg water/m2)
- real(r8) :: surface_water(bounds%begc:bounds%endc) ! liquid water to shallow surface depth (kg water/m2)
- real(r8) :: drain_tot(bounds%begc:bounds%endc) ! total drainage flux (mm H2O /s)
- real(r8), parameter :: depth_runoff_Nloss = 0.05 ! (m) depth over which runoff mixes with soil water for N loss to runoff
- !-----------------------------------------------------------------------
-
- associate( &
- h2osoi_liq => waterstate_inst%h2osoi_liq_col , & ! Input: [real(r8) (:,:) ] liquid water (kg/m2) (new) (-nlevsno+1:nlevgrnd)
-
- qflx_drain => waterflux_inst%qflx_drain_col , & ! Input: [real(r8) (:) ] sub-surface runoff (mm H2O /s)
- qflx_surf => waterflux_inst%qflx_surf_col , & ! Input: [real(r8) (:) ] surface runoff (mm H2O /s)
-
- sminn_vr => soilbiogeochem_nitrogenstate_inst%sminn_vr_col , & ! Input: [real(r8) (:,:) ] (gN/m3) soil mineral N
- smin_no3_vr => soilbiogeochem_nitrogenstate_inst%smin_no3_vr_col , & ! Input: [real(r8) (:,:) ]
-
- sminn_leached_vr => soilbiogeochem_nitrogenflux_inst%sminn_leached_vr_col , & ! Output: [real(r8) (:,:) ] rate of mineral N leaching (gN/m3/s)
- smin_no3_leached_vr => soilbiogeochem_nitrogenflux_inst%smin_no3_leached_vr_col , & ! Output: [real(r8) (:,:) ] rate of mineral NO3 leaching (gN/m3/s)
- smin_no3_runoff_vr => soilbiogeochem_nitrogenflux_inst%smin_no3_runoff_vr_col & ! Output: [real(r8) (:,:) ] rate of mineral NO3 loss with runoff (gN/m3/s)
- )
-
- ! set time steps
- dt = real( get_step_size(), r8 )
-
- if (.not. use_nitrif_denitrif) then
- ! set constant sf
- sf = params_inst%sf
- else
- ! Assume that 100% of the soil NO3 is in a soluble form
- sf_no3 = params_inst%sf_no3
- end if
-
- ! calculate the total soil water
- tot_water(bounds%begc:bounds%endc) = 0._r8
- do j = 1,nlevsoi
- do fc = 1,num_soilc
- c = filter_soilc(fc)
- tot_water(c) = tot_water(c) + h2osoi_liq(c,j)
- end do
- end do
-
- ! for runoff calculation; calculate total water to a given depth
- surface_water(bounds%begc:bounds%endc) = 0._r8
- do j = 1,nlevsoi
- if ( zisoi(j) <= depth_runoff_Nloss) then
- do fc = 1,num_soilc
- c = filter_soilc(fc)
- surface_water(c) = surface_water(c) + h2osoi_liq(c,j)
- end do
- elseif ( zisoi(j-1) < depth_runoff_Nloss) then
- do fc = 1,num_soilc
- c = filter_soilc(fc)
- surface_water(c) = surface_water(c) + h2osoi_liq(c,j) * ( (depth_runoff_Nloss - zisoi(j-1)) / col%dz(c,j))
- end do
- endif
- end do
-
- ! Loop through columns
- do fc = 1,num_soilc
- c = filter_soilc(fc)
- drain_tot(c) = qflx_drain(c)
- end do
-
-
- if (.not. use_nitrif_denitrif) then
-
- !----------------------------------------
- ! --------- NITRIF_NITRIF OFF------------
- !----------------------------------------
-
- do j = 1,nlevdecomp
- ! Loop through columns
- do fc = 1,num_soilc
- c = filter_soilc(fc)
-
- if (.not. use_vertsoilc) then
- ! calculate the dissolved mineral N concentration (gN/kg water)
- ! assumes that 10% of mineral nitrogen is soluble
- disn_conc = 0._r8
- if (tot_water(c) > 0._r8) then
- disn_conc = (sf * sminn_vr(c,j) ) / tot_water(c)
- end if
-
- ! calculate the N leaching flux as a function of the dissolved
- ! concentration and the sub-surface drainage flux
- sminn_leached_vr(c,j) = disn_conc * drain_tot(c)
- else
- ! calculate the dissolved mineral N concentration (gN/kg water)
- ! assumes that 10% of mineral nitrogen is soluble
- disn_conc = 0._r8
- if (h2osoi_liq(c,j) > 0._r8) then
- disn_conc = (sf * sminn_vr(c,j) * col%dz(c,j) )/(h2osoi_liq(c,j) )
- end if
-
- ! calculate the N leaching flux as a function of the dissolved
- ! concentration and the sub-surface drainage flux
- sminn_leached_vr(c,j) = disn_conc * drain_tot(c) * h2osoi_liq(c,j) / ( tot_water(c) * col%dz(c,j) )
-
- end if
-
- ! limit the flux based on current sminn state
- ! only let at most the assumed soluble fraction
- ! of sminn be leached on any given timestep
- sminn_leached_vr(c,j) = min(sminn_leached_vr(c,j), (sf * sminn_vr(c,j))/dt)
-
- ! limit the flux to a positive value
- sminn_leached_vr(c,j) = max(sminn_leached_vr(c,j), 0._r8)
-
- end do
- end do
-
- else
-
- !----------------------------------------
- ! --------- NITRIF_NITRIF ON-------------
- !----------------------------------------
-
- do j = 1,nlevdecomp
- ! Loop through columns
- do fc = 1,num_soilc
- c = filter_soilc(fc)
-
- if (.not. use_vertsoilc) then
- ! calculate the dissolved mineral N concentration (gN/kg water)
- ! assumes that 10% of mineral nitrogen is soluble
- disn_conc = 0._r8
- if (tot_water(c) > 0._r8) then
- disn_conc = (sf_no3 * smin_no3_vr(c,j) )/tot_water(c)
- end if
-
- ! calculate the N leaching flux as a function of the dissolved
- ! concentration and the sub-surface drainage flux
- smin_no3_leached_vr(c,j) = disn_conc * drain_tot(c)
- else
- ! calculate the dissolved mineral N concentration (gN/kg water)
- ! assumes that 10% of mineral nitrogen is soluble
- disn_conc = 0._r8
- if (h2osoi_liq(c,j) > 0._r8) then
- disn_conc = (sf_no3 * smin_no3_vr(c,j) * col%dz(c,j) )/(h2osoi_liq(c,j) )
- end if
- !
- ! calculate the N leaching flux as a function of the dissolved
- ! concentration and the sub-surface drainage flux
- smin_no3_leached_vr(c,j) = disn_conc * drain_tot(c) * h2osoi_liq(c,j) / ( tot_water(c) * col%dz(c,j) )
- !
- ! ensure that leaching rate isn't larger than soil N pool
- smin_no3_leached_vr(c,j) = min(smin_no3_leached_vr(c,j), smin_no3_vr(c,j) / dt )
- !
- ! limit the leaching flux to a positive value
- smin_no3_leached_vr(c,j) = max(smin_no3_leached_vr(c,j), 0._r8)
- !
- !
- ! calculate the N loss from surface runoff, assuming a shallow mixing of surface waters into soil and removal based on runoff
- if ( zisoi(j) <= depth_runoff_Nloss ) then
- smin_no3_runoff_vr(c,j) = disn_conc * qflx_surf(c) * &
- h2osoi_liq(c,j) / ( surface_water(c) * col%dz(c,j) )
- elseif ( zisoi(j-1) < depth_runoff_Nloss ) then
- smin_no3_runoff_vr(c,j) = disn_conc * qflx_surf(c) * &
- h2osoi_liq(c,j) * ((depth_runoff_Nloss - zisoi(j-1)) / &
- col%dz(c,j)) / ( surface_water(c) * (depth_runoff_Nloss-zisoi(j-1) ))
- else
- smin_no3_runoff_vr(c,j) = 0._r8
- endif
- !
- ! ensure that runoff rate isn't larger than soil N pool
- smin_no3_runoff_vr(c,j) = min(smin_no3_runoff_vr(c,j), smin_no3_vr(c,j) / dt - smin_no3_leached_vr(c,j))
- !
- ! limit the flux to a positive value
- smin_no3_runoff_vr(c,j) = max(smin_no3_runoff_vr(c,j), 0._r8)
-
-
- endif
- ! limit the flux based on current smin_no3 state
- ! only let at most the assumed soluble fraction
- ! of smin_no3 be leached on any given timestep
- smin_no3_leached_vr(c,j) = min(smin_no3_leached_vr(c,j), (sf_no3 * smin_no3_vr(c,j))/dt)
-
- ! limit the flux to a positive value
- smin_no3_leached_vr(c,j) = max(smin_no3_leached_vr(c,j), 0._r8)
-
- end do
- end do
- endif
-
- end associate
-
- end subroutine SoilBiogeochemNLeaching
-
-end module SoilBiogeochemNLeachingMod
diff --git a/src/soilbiogeochem/SoilBiogeochemNitrifDenitrifMod.F90 b/src/soilbiogeochem/SoilBiogeochemNitrifDenitrifMod.F90
deleted file mode 100644
index 08bbac92..00000000
--- a/src/soilbiogeochem/SoilBiogeochemNitrifDenitrifMod.F90
+++ /dev/null
@@ -1,337 +0,0 @@
-module SoilBiogeochemNitrifDenitrifMod
-
- !-----------------------------------------------------------------------
- ! !DESCRIPTION:
- ! Calculate nitrification and denitrification rates
- !
- !
- ! !USES:
- use shr_kind_mod , only : r8 => shr_kind_r8
- use shr_const_mod , only : SHR_CONST_TKFRZ
- use shr_log_mod , only : errMsg => shr_log_errMsg
- use clm_varpar , only : nlevdecomp
- use clm_varcon , only : rpi, grav
- use clm_varcon , only : d_con_g, d_con_w, secspday
- use abortutils , only : endrun
- use decompMod , only : bounds_type
- use SoilStatetype , only : soilstate_type
- use WaterStateType , only : waterstate_type
- use TemperatureType , only : temperature_type
- use SoilBiogeochemCarbonFluxType , only : soilbiogeochem_carbonflux_type
- use SoilBiogeochemNitrogenStateType , only : soilbiogeochem_nitrogenstate_type
- use SoilBiogeochemNitrogenFluxType , only : soilbiogeochem_nitrogenflux_type
- use ch4Mod , only : ch4_type
- use ColumnType , only : col
- !
- implicit none
- private
- !
- public :: readParams ! Read in parameters from params file
- public :: SoilBiogeochemNitrifDenitrif ! Calculate nitrification and
- !
- type, private :: params_type
- 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)
- real(r8) :: denitrif_respiration_coefficient ! Multiplier for heterotrophic respiration for max denitrif rates
- real(r8) :: denitrif_respiration_exponent ! Exponents for heterotrophic respiration for max denitrif rates
- real(r8) :: denitrif_nitrateconc_coefficient ! Multiplier for nitrate concentration for max denitrif rates
- real(r8) :: denitrif_nitrateconc_exponent ! Exponent for nitrate concentration for max denitrif rates
- end type params_type
-
- type(params_type), private :: params_inst
-
- logical, public :: no_frozen_nitrif_denitrif = .false. ! stop nitrification and denitrification in frozen soils
-
- character(len=*), parameter, private :: sourcefile = &
- __FILE__
-
- !-----------------------------------------------------------------------
-
-contains
-
- !-----------------------------------------------------------------------
- subroutine readParams ( ncid )
- !
- use ncdio_pio, only: file_desc_t,ncd_io
- !
- ! !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='surface_tension_water'
- call ncd_io(trim(tString),tempr, 'read', ncid, readvar=readv)
- if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__))
- params_inst%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(sourcefile, __LINE__))
- params_inst%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(sourcefile, __LINE__))
- params_inst%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(sourcefile, __LINE__))
- params_inst%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(sourcefile, __LINE__))
- params_inst%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(sourcefile, __LINE__))
- params_inst%rij_kro_delta=tempr
-
- end subroutine readParams
-
- !-----------------------------------------------------------------------
- subroutine SoilBiogeochemNitrifDenitrif(bounds, num_soilc, filter_soilc, &
- soilstate_inst, waterstate_inst, temperature_inst, ch4_inst, &
- soilbiogeochem_carbonflux_inst, soilbiogeochem_nitrogenstate_inst, soilbiogeochem_nitrogenflux_inst)
- !
- ! !DESCRIPTION:
- ! calculate nitrification and denitrification rates
- !
- ! !USES:
- use clm_time_manager , only : get_curr_date, get_step_size
- use CNSharedParamsMod , only : anoxia_wtsat, CNParamsShareInst
- !
- ! !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
- type(soilstate_type) , intent(in) :: soilstate_inst
- type(waterstate_type) , intent(in) :: waterstate_inst
- type(temperature_type) , intent(in) :: temperature_inst
- type(ch4_type) , intent(in) :: ch4_inst
- type(soilbiogeochem_carbonflux_type) , intent(in) :: soilbiogeochem_carbonflux_inst
- type(soilbiogeochem_nitrogenstate_type) , intent(in) :: soilbiogeochem_nitrogenstate_inst
- type(soilbiogeochem_nitrogenflux_type) , intent(inout) :: soilbiogeochem_nitrogenflux_inst
- !
- ! !LOCAL VARIABLES:
- integer :: c, fc, reflev, j
- real(r8) :: soil_hr_vr(bounds%begc:bounds%endc,1:nlevdecomp) ! total soil respiration rate (g C / m3 / s)
- real(r8) :: g_per_m3__to__ug_per_gsoil
- real(r8) :: g_per_m3_sec__to__ug_per_gsoil_day
- real(r8) :: mu, sigma
- real(r8) :: t
- real(r8) :: pH(bounds%begc:bounds%endc)
- !debug-- put these type structure for outing to hist files
- real(r8) :: co2diff_con(2) ! diffusion constants for CO2
- real(r8) :: eps
- real(r8) :: f_a
- real(r8) :: surface_tension_water ! (J/m^2), Arah and Vinten 1995
- real(r8) :: rij_kro_a ! Arah and Vinten 1995
- real(r8) :: rij_kro_alpha ! 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
- real(r8) :: rho_w = 1.e3_r8 ! (kg/m3)
- real(r8) :: r_max
- real(r8) :: r_min(bounds%begc:bounds%endc,1:nlevdecomp)
- real(r8) :: ratio_diffusivity_water_gas(bounds%begc:bounds%endc,1:nlevdecomp)
- real(r8) :: om_frac
- real(r8) :: anaerobic_frac_sat, r_psi_sat, r_min_sat ! scalar values in sat portion for averaging
- real(r8) :: organic_max ! organic matter content (kg/m3) where
- ! soil is assumed to act like peat
- character(len=32) :: subname='nitrif_denitrif' ! subroutine name
- !-----------------------------------------------------------------------
-
- associate( &
- watsat => soilstate_inst%watsat_col , & ! Input: [real(r8) (:,:) ] volumetric soil water at saturation (porosity) (nlevgrnd)
- watfc => soilstate_inst%watfc_col , & ! Input: [real(r8) (:,:) ] volumetric soil water at field capacity (nlevsoi)
- bd => soilstate_inst%bd_col , & ! Input: [real(r8) (:,:) ] bulk density of dry soil material [kg/m3]
- bsw => soilstate_inst%bsw_col , & ! Input: [real(r8) (:,:) ] Clapp and Hornberger "b" (nlevgrnd)
- cellorg => soilstate_inst%cellorg_col , & ! Input: [real(r8) (:,:) ] column 3D org (kg/m3 organic matter) (nlevgrnd)
- sucsat => soilstate_inst%sucsat_col , & ! Input: [real(r8) (:,:) ] minimum soil suction (mm)
- soilpsi => soilstate_inst%soilpsi_col , & ! Input: [real(r8) (:,:) ] soil water potential in each soil layer (MPa)
-
- h2osoi_vol => waterstate_inst%h2osoi_vol_col , & ! Input: [real(r8) (:,:) ] volumetric soil water (0<=h2osoi_vol<=watsat) [m3/m3] (nlevgrnd)
- h2osoi_liq => waterstate_inst%h2osoi_liq_col , & ! Input: [real(r8) (:,:) ] liquid water (kg/m2) (new) (-nlevsno+1:nlevgrnd)
-
- t_soisno => temperature_inst%t_soisno_col , & ! Input: [real(r8) (:,:) ] soil temperature (Kelvin) (-nlevsno+1:nlevgrnd)
-
- o2_decomp_depth_unsat => ch4_inst%o2_decomp_depth_unsat_col , & ! Input: [real(r8) (:,:) ] O2 consumption during decomposition in each soil layer (nlevsoi) (mol/m3/s)
- conc_o2_unsat => ch4_inst%conc_o2_unsat_col , & ! Input: [real(r8) (:,:) ] O2 conc in each soil layer (mol/m3) (nlevsoi)
- o2_decomp_depth_sat => ch4_inst%o2_decomp_depth_sat_col , & ! Input: [real(r8) (:,:) ] O2 consumption during decomposition in each soil layer (nlevsoi) (mol/m3/s)
- conc_o2_sat => ch4_inst%conc_o2_sat_col , & ! Input: [real(r8) (:,:) ] O2 conc in each soil layer (mol/m3) (nlevsoi)
- finundated => ch4_inst%finundated_col , & ! Input: [real(r8) (:) ] fractional inundated area in soil column (excluding dedicated wetland columns)
-
- smin_nh4_vr => soilbiogeochem_nitrogenstate_inst%smin_nh4_vr_col , & ! Input: [real(r8) (:,:) ] (gN/m3) soil mineral NH4 pool
- smin_no3_vr => soilbiogeochem_nitrogenstate_inst%smin_no3_vr_col , & ! Input: [real(r8) (:,:) ] (gN/m3) soil mineral NO3 pool
-
- phr_vr => soilbiogeochem_carbonflux_inst%phr_vr_col , & ! Input: [real(r8) (:,:) ] potential hr (not N-limited)
- w_scalar => soilbiogeochem_carbonflux_inst%w_scalar_col , & ! Input: [real(r8) (:,:) ] soil water scalar for decomp
- t_scalar => soilbiogeochem_carbonflux_inst%t_scalar_col , & ! Input: [real(r8) (:,:) ] temperature scalar for decomp
- denit_resp_coef => params_inst%denitrif_respiration_coefficient , & ! Input: [real(r8) ] coefficient for max denitrification rate based on respiration
- denit_resp_exp => params_inst%denitrif_respiration_exponent , & ! Input: [real(r8) ] exponent for max denitrification rate based on respiration
- denit_nitrate_coef => params_inst%denitrif_nitrateconc_coefficient , & ! Input: [real(r8) ] coefficient for max denitrification rate based on nitrate concentration
- denit_nitrate_exp => params_inst%denitrif_nitrateconc_exponent , & ! Input: [real(r8) ] exponent for max denitrification rate based on nitrate concentration
- k_nitr_max => params_inst%k_nitr_max , & ! Input:
-
- r_psi => soilbiogeochem_nitrogenflux_inst%r_psi_col , & ! Output: [real(r8) (:,:) ]
- anaerobic_frac => soilbiogeochem_nitrogenflux_inst%anaerobic_frac_col , & ! Output: [real(r8) (:,:) ]
- ! ! subsets of the n flux calcs (for diagnostic/debugging purposes)
- smin_no3_massdens_vr => soilbiogeochem_nitrogenflux_inst%smin_no3_massdens_vr_col , & ! Output: [real(r8) (:,:) ] (ugN / g soil) soil nitrate concentration
- k_nitr_t_vr => soilbiogeochem_nitrogenflux_inst%k_nitr_t_vr_col , & ! Output: [real(r8) (:,:) ]
- k_nitr_ph_vr => soilbiogeochem_nitrogenflux_inst%k_nitr_ph_vr_col , & ! Output: [real(r8) (:,:) ]
- k_nitr_h2o_vr => soilbiogeochem_nitrogenflux_inst%k_nitr_h2o_vr_col , & ! Output: [real(r8) (:,:) ]
- k_nitr_vr => soilbiogeochem_nitrogenflux_inst%k_nitr_vr_col , & ! Output: [real(r8) (:,:) ]
- wfps_vr => soilbiogeochem_nitrogenflux_inst%wfps_vr_col , & ! Output: [real(r8) (:,:) ]
- fmax_denit_carbonsubstrate_vr => soilbiogeochem_nitrogenflux_inst%fmax_denit_carbonsubstrate_vr_col , & ! Output: [real(r8) (:,:) ]
- fmax_denit_nitrate_vr => soilbiogeochem_nitrogenflux_inst%fmax_denit_nitrate_vr_col , & ! Output: [real(r8) (:,:) ]
- f_denit_base_vr => soilbiogeochem_nitrogenflux_inst%f_denit_base_vr_col , & ! Output: [real(r8) (:,:) ]
- diffus => soilbiogeochem_nitrogenflux_inst%diffus_col , & ! Output: [real(r8) (:,:) ] diffusivity (unitless fraction of total diffusivity)
- ratio_k1 => soilbiogeochem_nitrogenflux_inst%ratio_k1_col , & ! Output: [real(r8) (:,:) ]
- ratio_no3_co2 => soilbiogeochem_nitrogenflux_inst%ratio_no3_co2_col , & ! Output: [real(r8) (:,:) ]
- soil_co2_prod => soilbiogeochem_nitrogenflux_inst%soil_co2_prod_col , & ! Output: [real(r8) (:,:) ] (ug C / g soil / day)
- fr_WFPS => soilbiogeochem_nitrogenflux_inst%fr_WFPS_col , & ! Output: [real(r8) (:,:) ]
- soil_bulkdensity => soilbiogeochem_nitrogenflux_inst%soil_bulkdensity_col , & ! Output: [real(r8) (:,:) ] (kg soil / m3) bulk density of soil (including water)
- pot_f_nit_vr => soilbiogeochem_nitrogenflux_inst%pot_f_nit_vr_col , & ! Output: [real(r8) (:,:) ] (gN/m3/s) potential soil nitrification flux
-
- pot_f_denit_vr => soilbiogeochem_nitrogenflux_inst%pot_f_denit_vr_col , & ! Output: [real(r8) (:,:) ] (gN/m3/s) potential soil denitrification flux
- n2_n2o_ratio_denit_vr => soilbiogeochem_nitrogenflux_inst%n2_n2o_ratio_denit_vr_col & ! Output: [real(r8) (:,:) ] ratio of N2 to N2O production by denitrification [gN/gN]
- )
-
- surface_tension_water = params_inst%surface_tension_water
-
- ! Set parameters from simple-structure model to calculate anoxic fratction (Arah and Vinten 1995)
- rij_kro_a = params_inst%rij_kro_a
- rij_kro_alpha = params_inst%rij_kro_alpha
- rij_kro_beta = params_inst%rij_kro_beta
- rij_kro_gamma = params_inst%rij_kro_gamma
- rij_kro_delta = params_inst%rij_kro_delta
-
- organic_max = CNParamsShareInst%organic_max
-
- pH(bounds%begc:bounds%endc) = 6.5 !!! set all soils with the same pH as placeholder here
- co2diff_con(1) = 0.1325_r8
- co2diff_con(2) = 0.0009_r8
-
- do j = 1, nlevdecomp
- do fc = 1,num_soilc
- c = filter_soilc(fc)
-
- !---------------- calculate soil anoxia state
- ! calculate gas diffusivity of soil at field capacity here
- ! use expression from methane code, but neglect OM for now
- f_a = 1._r8 - watfc(c,j) / watsat(c,j)
- eps = watsat(c,j)-watfc(c,j) ! Air-filled fraction of total soil volume
-
- ! NITRIF_DENITRIF requires Methane model to be active,
- ! otherwise diffusivity will be zeroed out here. EBK CDK 10/18/2011
- anaerobic_frac(c,j) = 0._r8
- diffus (c,j) = 0._r8
- !call endrun(msg=' ERROR: NITRIF_DENITRIF requires Methane model to be active'//errMsg(sourcefile, __LINE__) )
-
-
- !---------------- nitrification
- ! follows CENTURY nitrification scheme (Parton et al., (2001, 1996))
-
- ! assume nitrification temp function equal to the HR scalar
- k_nitr_t_vr(c,j) = min(t_scalar(c,j), 1._r8)
-
- ! ph function from Parton et al., (2001, 1996)
- k_nitr_ph_vr(c,j) = 0.56 + atan(rpi * 0.45 * (-5.+ pH(c)))/rpi
-
- ! moisture function-- assume the same moisture function as limits heterotrophic respiration
- ! Parton et al. base their nitrification- soil moisture rate constants based on heterotrophic rates-- can we do the same?
- k_nitr_h2o_vr(c,j) = w_scalar(c,j)
-
- ! nitrification constant is a set scalar * temp, moisture, and ph scalars
- k_nitr_vr(c,j) = k_nitr_max * k_nitr_t_vr(c,j) * k_nitr_h2o_vr(c,j) * k_nitr_ph_vr(c,j)
-
- ! first-order decay of ammonium pool with scalar defined above
- pot_f_nit_vr(c,j) = max(smin_nh4_vr(c,j) * k_nitr_vr(c,j), 0._r8)
-
- ! limit to oxic fraction of soils
- pot_f_nit_vr(c,j) = pot_f_nit_vr(c,j) * (1._r8 - anaerobic_frac(c,j))
-
- ! limit to non-frozen soil layers
- if ( t_soisno(c,j) <= SHR_CONST_TKFRZ .and. no_frozen_nitrif_denitrif) then
- pot_f_nit_vr(c,j) = 0._r8
- endif
-
-
- !---------------- denitrification
- ! first some input variables an unit conversions
- soil_hr_vr(c,j) = phr_vr(c,j)
-
- ! CENTURY papers give denitrification in units of per gram soil; need to convert from volumetric to mass-based units here
- soil_bulkdensity(c,j) = bd(c,j) + h2osoi_liq(c,j)/col%dz(c,j)
-
- g_per_m3__to__ug_per_gsoil = 1.e3_r8 / soil_bulkdensity(c,j)
-
- g_per_m3_sec__to__ug_per_gsoil_day = g_per_m3__to__ug_per_gsoil * secspday
-
- smin_no3_massdens_vr(c,j) = max(smin_no3_vr(c,j), 0._r8) * g_per_m3__to__ug_per_gsoil
-
- soil_co2_prod(c,j) = (soil_hr_vr(c,j) * (g_per_m3_sec__to__ug_per_gsoil_day))
-
- !! maximum potential denitrification rates based on heterotrophic respiration rates or nitrate concentrations,
- !! from (del Grosso et al., 2000)
- fmax_denit_carbonsubstrate_vr(c,j) = (denit_resp_coef * (soil_co2_prod(c,j)**denit_resp_exp)) &
- / g_per_m3_sec__to__ug_per_gsoil_day
- !
- fmax_denit_nitrate_vr(c,j) = (denit_nitrate_coef * smin_no3_massdens_vr(c,j)**denit_nitrate_exp) &
- / g_per_m3_sec__to__ug_per_gsoil_day
-
- ! find limiting denitrification rate
- f_denit_base_vr(c,j) = max(min(fmax_denit_carbonsubstrate_vr(c,j), fmax_denit_nitrate_vr(c,j)),0._r8)
-
- ! limit to non-frozen soil layers
- if ( t_soisno(c,j) <= SHR_CONST_TKFRZ .and. no_frozen_nitrif_denitrif ) then
- f_denit_base_vr(c,j) = 0._r8
- endif
-
- ! limit to anoxic fraction of soils
- pot_f_denit_vr(c,j) = f_denit_base_vr(c,j) * anaerobic_frac(c,j)
-
- ! now calculate the ratio of N2O to N2 from denitrifictaion, following Del Grosso et al., 2000
- ! diffusivity constant (figure 6b)
- ratio_k1(c,j) = max(1.7_r8, 38.4_r8 - 350._r8 * diffus(c,j))
-
- ! ratio function (figure 7c)
- if ( soil_co2_prod(c,j) > 0 ) then
- ratio_no3_co2(c,j) = smin_no3_massdens_vr(c,j) / soil_co2_prod(c,j)
- else
- ! fucntion saturates at large no3/co2 ratios, so set as some nominally large number
- ratio_no3_co2(c,j) = 100._r8
- endif
-
- ! total water limitation function (Del Grosso et al., 2000, figure 7a)
- wfps_vr(c,j) = max(min(h2osoi_vol(c,j)/watsat(c, j), 1._r8), 0._r8) * 100._r8
- fr_WFPS(c,j) = max(0.1_r8, 0.015_r8 * wfps_vr(c,j) - 0.32_r8)
-
- ! final ratio expression
- n2_n2o_ratio_denit_vr(c,j) = max(0.16*ratio_k1(c,j), ratio_k1(c,j)*exp(-0.8 * ratio_no3_co2(c,j))) * fr_WFPS(c,j)
-
- end do
-
- end do
-
- end associate
-
- end subroutine SoilBiogeochemNitrifDenitrif
-
-end module SoilBiogeochemNitrifDenitrifMod
diff --git a/src/soilbiogeochem/SoilBiogeochemNitrogenFluxType.F90 b/src/soilbiogeochem/SoilBiogeochemNitrogenFluxType.F90
deleted file mode 100644
index cf962de9..00000000
--- a/src/soilbiogeochem/SoilBiogeochemNitrogenFluxType.F90
+++ /dev/null
@@ -1,1099 +0,0 @@
-module SoilBiogeochemNitrogenFluxType
-
- use shr_kind_mod , only : r8 => shr_kind_r8
- use shr_infnan_mod , only : nan => shr_infnan_nan, assignment(=)
- use shr_log_mod , only : errMsg => shr_log_errMsg
- use clm_varpar , only : ndecomp_cascade_transitions, ndecomp_pools
- use clm_varpar , only : nlevdecomp_full, nlevdecomp
- use clm_varcon , only : spval, ispval, dzsoi_decomp
- use decompMod , only : bounds_type
- use clm_varctl , only : use_nitrif_denitrif, use_vertsoilc, use_crop
- use CNSharedParamsMod , only : use_fun
- use SoilBiogeochemDecompCascadeConType , only : decomp_cascade_con
- use abortutils , only : endrun
- use LandunitType , only : lun
- use ColumnType , only : col
- !
- ! !PUBLIC TYPES:
- implicit none
- private
- !
- type, public :: SoilBiogeochem_nitrogenflux_type
-
- ! deposition fluxes
- real(r8), pointer :: ndep_to_sminn_col (:) ! col atmospheric N deposition to soil mineral N (gN/m2/s)
- real(r8), pointer :: nfix_to_sminn_col (:) ! col symbiotic/asymbiotic N fixation to soil mineral N (gN/m2/s)
- real(r8), pointer :: ffix_to_sminn_col (:) ! col free living N fixation to soil mineral N (gN/m2/s)
- real(r8), pointer :: fert_to_sminn_col (:) ! col fertilizer N to soil mineral N (gN/m2/s)
- real(r8), pointer :: soyfixn_to_sminn_col (:) ! col soybean fixation to soil mineral N (gN/m2/s)
-
- ! decomposition fluxes
- real(r8), pointer :: decomp_cascade_ntransfer_vr_col (:,:,:) ! col vert-res transfer of N from donor to receiver pool along decomp. cascade (gN/m3/s)
- real(r8), pointer :: decomp_cascade_ntransfer_col (:,:) ! col vert-int (diagnostic) transfer of N from donor to receiver pool along decomp. cascade (gN/m2/s)
- real(r8), pointer :: decomp_cascade_sminn_flux_vr_col (:,:,:) ! col vert-res mineral N flux for transition along decomposition cascade (gN/m3/s)
- real(r8), pointer :: decomp_cascade_sminn_flux_col (:,:) ! col vert-int (diagnostic) mineral N flux for transition along decomposition cascade (gN/m2/s)
-
- ! Used to update concentrations concurrently with vertical transport
- ! vertically-resolved immobilization fluxes
- real(r8), pointer :: potential_immob_vr_col (:,:) ! col vertically-resolved potential N immobilization (gN/m3/s) at each level
- real(r8), pointer :: potential_immob_col (:) ! col vert-int (diagnostic) potential N immobilization (gN/m2/s)
- real(r8), pointer :: actual_immob_vr_col (:,:) ! col vertically-resolved actual N immobilization (gN/m3/s) at each level
- real(r8), pointer :: actual_immob_col (:) ! col vert-int (diagnostic) actual N immobilization (gN/m2/s)
- real(r8), pointer :: sminn_to_plant_vr_col (:,:) ! col vertically-resolved plant uptake of soil mineral N (gN/m3/s)
- real(r8), pointer :: sminn_to_plant_col (:) ! col vert-int (diagnostic) plant uptake of soil mineral N (gN/m2/s)
- real(r8), pointer :: supplement_to_sminn_vr_col (:,:) ! col vertically-resolved supplemental N supply (gN/m3/s)
- real(r8), pointer :: supplement_to_sminn_col (:) ! col vert-int (diagnostic) supplemental N supply (gN/m2/s)
- real(r8), pointer :: gross_nmin_vr_col (:,:) ! col vertically-resolved gross rate of N mineralization (gN/m3/s)
- real(r8), pointer :: gross_nmin_col (:) ! col vert-int (diagnostic) gross rate of N mineralization (gN/m2/s)
- real(r8), pointer :: net_nmin_vr_col (:,:) ! col vertically-resolved net rate of N mineralization (gN/m3/s)
- real(r8), pointer :: net_nmin_col (:) ! col vert-int (diagnostic) net rate of N mineralization (gN/m2/s)
- real(r8), pointer :: sminn_to_plant_fun_col (:) ! col total soil N uptake of FUN (gN/m2/s)
- ! ---------- NITRIF_DENITRIF ---------------------
-
- ! nitrification / denitrification fluxes
- real(r8), pointer :: f_nit_vr_col (:,:) ! col (gN/m3/s) soil nitrification flux
- real(r8), pointer :: f_denit_vr_col (:,:) ! col (gN/m3/s) soil denitrification flux
- real(r8), pointer :: f_nit_col (:) ! col (gN/m2/s) soil nitrification flux
- real(r8), pointer :: f_denit_col (:) ! col (gN/m2/s) soil denitrification flux
-
- real(r8), pointer :: pot_f_nit_vr_col (:,:) ! col (gN/m3/s) potential soil nitrification flux
- real(r8), pointer :: pot_f_denit_vr_col (:,:) ! col (gN/m3/s) potential soil denitrification flux
- real(r8), pointer :: pot_f_nit_col (:) ! col (gN/m2/s) potential soil nitrification flux
- real(r8), pointer :: pot_f_denit_col (:) ! col (gN/m2/s) potential soil denitrification flux
- real(r8), pointer :: n2_n2o_ratio_denit_vr_col (:,:) ! col ratio of N2 to N2O production by denitrification [gN/gN]
- real(r8), pointer :: f_n2o_denit_vr_col (:,:) ! col flux of N2o from denitrification [gN/m^3/s]
- real(r8), pointer :: f_n2o_denit_col (:) ! col flux of N2o from denitrification [gN/m^2/s]
- real(r8), pointer :: f_n2o_nit_vr_col (:,:) ! col flux of N2o from nitrification [gN/m^3/s]
- real(r8), pointer :: f_n2o_nit_col (:) ! col flux of N2o from nitrification [gN/m^2/s]
-
- ! immobilization / uptake fluxes
- real(r8), pointer :: actual_immob_no3_vr_col (:,:) ! col vertically-resolved actual immobilization of NO3 (gN/m3/s)
- real(r8), pointer :: actual_immob_nh4_vr_col (:,:) ! col vertically-resolved actual immobilization of NH4 (gN/m3/s)
- real(r8), pointer :: smin_no3_to_plant_vr_col (:,:) ! col vertically-resolved plant uptake of soil NO3 (gN/m3/s)
- real(r8), pointer :: smin_nh4_to_plant_vr_col (:,:) ! col vertically-resolved plant uptake of soil NH4 (gN/m3/s)
- real(r8), pointer :: actual_immob_no3_col (:) ! col actual immobilization of NO3 (gN/m2/s)
- real(r8), pointer :: actual_immob_nh4_col (:) ! col actual immobilization of NH4 (gN/m2/s)
- real(r8), pointer :: smin_no3_to_plant_col (:) ! col plant uptake of soil NO3 (gN/m2/s)
- real(r8), pointer :: smin_nh4_to_plant_col (:) ! col plant uptake of soil Nh4 (gN/m2/s)
-
- ! leaching fluxes
- real(r8), pointer :: smin_no3_leached_vr_col (:,:) ! col vertically-resolved soil mineral NO3 loss to leaching (gN/m3/s)
- real(r8), pointer :: smin_no3_leached_col (:) ! col soil mineral NO3 pool loss to leaching (gN/m2/s)
- real(r8), pointer :: smin_no3_runoff_vr_col (:,:) ! col vertically-resolved rate of mineral NO3 loss with runoff (gN/m3/s)
- real(r8), pointer :: smin_no3_runoff_col (:) ! col soil mineral NO3 pool loss to runoff (gN/m2/s)
-
- ! nitrification /denitrification diagnostic quantities
- real(r8), pointer :: smin_no3_massdens_vr_col (:,:) ! col (ugN / g soil) soil nitrate concentration
- real(r8), pointer :: soil_bulkdensity_col (:,:) ! col (kg soil / m3) bulk density of soil
- real(r8), pointer :: k_nitr_t_vr_col (:,:)
- real(r8), pointer :: k_nitr_ph_vr_col (:,:)
- real(r8), pointer :: k_nitr_h2o_vr_col (:,:)
- real(r8), pointer :: k_nitr_vr_col (:,:)
- real(r8), pointer :: wfps_vr_col (:,:)
- real(r8), pointer :: fmax_denit_carbonsubstrate_vr_col (:,:)
- real(r8), pointer :: fmax_denit_nitrate_vr_col (:,:)
- real(r8), pointer :: f_denit_base_vr_col (:,:) ! col nitrification and denitrification fluxes
- real(r8), pointer :: diffus_col (:,:) ! col diffusivity (m2/s)
- real(r8), pointer :: ratio_k1_col (:,:)
- real(r8), pointer :: ratio_no3_co2_col (:,:)
- real(r8), pointer :: soil_co2_prod_col (:,:)
- real(r8), pointer :: fr_WFPS_col (:,:)
-
- real(r8), pointer :: r_psi_col (:,:)
- real(r8), pointer :: anaerobic_frac_col (:,:)
- real(r8), pointer :: sminn_to_plant_fun_no3_vr_col (:,:) ! col total layer no3 uptake of FUN (gN/m2/s)
- real(r8), pointer :: sminn_to_plant_fun_nh4_vr_col (:,:) ! col total layer nh4 uptake of FUN (gN/m2/s)
- !----------- no NITRIF_DENITRIF--------------
-
- ! denitrification fluxes
- real(r8), pointer :: sminn_to_denit_decomp_cascade_vr_col (:,:,:) ! col vertically-resolved denitrification along decomp cascade (gN/m3/s)
- real(r8), pointer :: sminn_to_denit_decomp_cascade_col (:,:) ! col vertically-integrated (diagnostic) denitrification along decomp cascade (gN/m2/s)
- real(r8), pointer :: sminn_to_denit_excess_vr_col (:,:) ! col vertically-resolved denitrification from excess mineral N pool (gN/m3/s)
- real(r8), pointer :: sminn_to_denit_excess_col (:) ! col vertically-integrated (diagnostic) denitrification from excess mineral N pool (gN/m2/s)
-
- ! leaching fluxes
- real(r8), pointer :: sminn_leached_vr_col (:,:) ! col vertically-resolved soil mineral N pool loss to leaching (gN/m3/s)
- real(r8), pointer :: sminn_leached_col (:) ! col soil mineral N pool loss to leaching (gN/m2/s)
-
- ! summary (diagnostic) flux variables, not involved in mass balance
- real(r8), pointer :: denit_col (:) ! col total rate of denitrification (gN/m2/s)
- real(r8), pointer :: ninputs_col (:) ! col column-level N inputs (gN/m2/s)
- real(r8), pointer :: noutputs_col (:) ! col column-level N outputs (gN/m2/s)
- real(r8), pointer :: som_n_leached_col (:) ! col total SOM N loss from vertical transport (gN/m^2/s)
- real(r8), pointer :: decomp_npools_leached_col (:,:) ! col N loss from vertical transport from each decomposing N pool (gN/m^2/s)
- real(r8), pointer :: decomp_npools_transport_tendency_col (:,:,:) ! col N tendency due to vertical transport in decomposing N pools (gN/m^3/s)
-
- ! all n pools involved in decomposition
- real(r8), pointer :: decomp_npools_sourcesink_col (:,:,:) ! col (gN/m3) change in decomposing n pools
- ! (sum of all additions and subtractions from stateupdate1).
- real(r8), pointer :: sminn_to_plant_fun_vr_col (:,:) ! col total layer soil N uptake of FUN (gN/m2/s)
- contains
-
- procedure , public :: Init
- procedure , public :: Restart
- procedure , public :: SetValues
- procedure , private :: InitAllocate
- procedure , private :: InitHistory
- procedure , private :: InitCold
-
- end type SoilBiogeochem_nitrogenflux_type
-
- character(len=*), parameter, private :: sourcefile = &
- __FILE__
- !------------------------------------------------------------------------
-
-contains
-
- !------------------------------------------------------------------------
- subroutine Init(this, bounds)
-
- class(soilbiogeochem_nitrogenflux_type) :: this
- type(bounds_type), intent(in) :: bounds
-
- call this%InitAllocate (bounds)
- call this%InitHistory (bounds)
- call this%InitCold (bounds)
-
- end subroutine Init
-
- !------------------------------------------------------------------------
- subroutine InitAllocate(this, bounds)
- !
- ! !DESCRIPTION:
- ! Initialize nitrogen flux
- !
- ! !ARGUMENTS:
- class(soilbiogeochem_nitrogenflux_type) :: this
- type(bounds_type) , intent(in) :: bounds
- !
- ! !LOCAL VARIABLES:
- integer :: begc,endc
-! integer :: begp,endp
- !------------------------------------------------------------------------
-
- begc = bounds%begc; endc = bounds%endc
-! begp = bounds%begp; endp = bounds%endp
- allocate(this%ndep_to_sminn_col (begc:endc)) ; this%ndep_to_sminn_col (:) = nan
- allocate(this%nfix_to_sminn_col (begc:endc)) ; this%nfix_to_sminn_col (:) = nan
- allocate(this%ffix_to_sminn_col (begc:endc)) ; this%ffix_to_sminn_col (:) = nan
- allocate(this%fert_to_sminn_col (begc:endc)) ; this%fert_to_sminn_col (:) = nan
- allocate(this%soyfixn_to_sminn_col (begc:endc)) ; this%soyfixn_to_sminn_col (:) = nan
- allocate(this%sminn_to_plant_col (begc:endc)) ; this%sminn_to_plant_col (:) = nan
- allocate(this%potential_immob_col (begc:endc)) ; this%potential_immob_col (:) = nan
- allocate(this%actual_immob_col (begc:endc)) ; this%actual_immob_col (:) = nan
- allocate(this%gross_nmin_col (begc:endc)) ; this%gross_nmin_col (:) = nan
- allocate(this%net_nmin_col (begc:endc)) ; this%net_nmin_col (:) = nan
- allocate(this%denit_col (begc:endc)) ; this%denit_col (:) = nan
- allocate(this%supplement_to_sminn_col (begc:endc)) ; this%supplement_to_sminn_col (:) = nan
- allocate(this%ninputs_col (begc:endc)) ; this%ninputs_col (:) = nan
- allocate(this%noutputs_col (begc:endc)) ; this%noutputs_col (:) = nan
- allocate(this%som_n_leached_col (begc:endc)) ; this%som_n_leached_col (:) = nan
-
- allocate(this%r_psi_col (begc:endc,1:nlevdecomp_full)) ; this%r_psi_col (:,:) = spval
- allocate(this%anaerobic_frac_col (begc:endc,1:nlevdecomp_full)) ; this%anaerobic_frac_col (:,:) = spval
- allocate(this%potential_immob_vr_col (begc:endc,1:nlevdecomp_full)) ; this%potential_immob_vr_col (:,:) = nan
- allocate(this%actual_immob_vr_col (begc:endc,1:nlevdecomp_full)) ; this%actual_immob_vr_col (:,:) = nan
- allocate(this%sminn_to_plant_vr_col (begc:endc,1:nlevdecomp_full)) ; this%sminn_to_plant_vr_col (:,:) = nan
- allocate(this%supplement_to_sminn_vr_col (begc:endc,1:nlevdecomp_full)) ; this%supplement_to_sminn_vr_col (:,:) = nan
- allocate(this%gross_nmin_vr_col (begc:endc,1:nlevdecomp_full)) ; this%gross_nmin_vr_col (:,:) = nan
- allocate(this%net_nmin_vr_col (begc:endc,1:nlevdecomp_full)) ; this%net_nmin_vr_col (:,:) = nan
- allocate(this%sminn_to_plant_fun_col (begc:endc)) ; this%sminn_to_plant_fun_col (:) = nan
- allocate(this%sminn_to_plant_fun_vr_col (begc:endc,1:nlevdecomp_full)) ; this%sminn_to_plant_fun_vr_col (:,:) = nan
- allocate(this%sminn_to_plant_fun_no3_vr_col (begc:endc,1:nlevdecomp_full)) ; this%sminn_to_plant_fun_no3_vr_col(:,:) = nan
- allocate(this%sminn_to_plant_fun_nh4_vr_col (begc:endc,1:nlevdecomp_full)) ; this%sminn_to_plant_fun_nh4_vr_col(:,:) = nan
- allocate(this%f_nit_vr_col (begc:endc,1:nlevdecomp_full)) ; this%f_nit_vr_col (:,:) = nan
- allocate(this%f_denit_vr_col (begc:endc,1:nlevdecomp_full)) ; this%f_denit_vr_col (:,:) = nan
- allocate(this%smin_no3_leached_vr_col (begc:endc,1:nlevdecomp_full)) ; this%smin_no3_leached_vr_col (:,:) = nan
- allocate(this%smin_no3_leached_col (begc:endc)) ; this%smin_no3_leached_col (:) = nan
- allocate(this%smin_no3_runoff_vr_col (begc:endc,1:nlevdecomp_full)) ; this%smin_no3_runoff_vr_col (:,:) = nan
- allocate(this%smin_no3_runoff_col (begc:endc)) ; this%smin_no3_runoff_col (:) = nan
- allocate(this%pot_f_nit_vr_col (begc:endc,1:nlevdecomp_full)) ; this%pot_f_nit_vr_col (:,:) = nan
- allocate(this%pot_f_nit_col (begc:endc)) ; this%pot_f_nit_col (:) = nan
- allocate(this%pot_f_denit_vr_col (begc:endc,1:nlevdecomp_full)) ; this%pot_f_denit_vr_col (:,:) = nan
- allocate(this%pot_f_denit_col (begc:endc)) ; this%pot_f_denit_col (:) = nan
- allocate(this%actual_immob_no3_vr_col (begc:endc,1:nlevdecomp_full)) ; this%actual_immob_no3_vr_col (:,:) = nan
- allocate(this%actual_immob_nh4_vr_col (begc:endc,1:nlevdecomp_full)) ; this%actual_immob_nh4_vr_col (:,:) = nan
- allocate(this%smin_no3_to_plant_vr_col (begc:endc,1:nlevdecomp_full)) ; this%smin_no3_to_plant_vr_col (:,:) = nan
- allocate(this%smin_nh4_to_plant_vr_col (begc:endc,1:nlevdecomp_full)) ; this%smin_nh4_to_plant_vr_col (:,:) = nan
- allocate(this%f_nit_col (begc:endc)) ; this%f_nit_col (:) = nan
- allocate(this%f_denit_col (begc:endc)) ; this%f_denit_col (:) = nan
- allocate(this%n2_n2o_ratio_denit_vr_col (begc:endc,1:nlevdecomp_full)) ; this%n2_n2o_ratio_denit_vr_col (:,:) = nan
- allocate(this%f_n2o_denit_col (begc:endc)) ; this%f_n2o_denit_col (:) = nan
- allocate(this%f_n2o_denit_vr_col (begc:endc,1:nlevdecomp_full)) ; this%f_n2o_denit_vr_col (:,:) = nan
- allocate(this%f_n2o_nit_col (begc:endc)) ; this%f_n2o_nit_col (:) = nan
- allocate(this%f_n2o_nit_vr_col (begc:endc,1:nlevdecomp_full)) ; this%f_n2o_nit_vr_col (:,:) = nan
-
- allocate(this%smin_no3_massdens_vr_col (begc:endc,1:nlevdecomp_full)) ; this%smin_no3_massdens_vr_col (:,:) = nan
- allocate(this%soil_bulkdensity_col (begc:endc,1:nlevdecomp_full)) ; this%soil_bulkdensity_col (:,:) = nan
- allocate(this%k_nitr_t_vr_col (begc:endc,1:nlevdecomp_full)) ; this%k_nitr_t_vr_col (:,:) = nan
- allocate(this%k_nitr_ph_vr_col (begc:endc,1:nlevdecomp_full)) ; this%k_nitr_ph_vr_col (:,:) = nan
- allocate(this%k_nitr_h2o_vr_col (begc:endc,1:nlevdecomp_full)) ; this%k_nitr_h2o_vr_col (:,:) = nan
- allocate(this%k_nitr_vr_col (begc:endc,1:nlevdecomp_full)) ; this%k_nitr_vr_col (:,:) = nan
- allocate(this%wfps_vr_col (begc:endc,1:nlevdecomp_full)) ; this%wfps_vr_col (:,:) = nan
- allocate(this%f_denit_base_vr_col (begc:endc,1:nlevdecomp_full)) ; this%f_denit_base_vr_col (:,:) = nan
- allocate(this%diffus_col (begc:endc,1:nlevdecomp_full)) ; this%diffus_col (:,:) = spval
- allocate(this%ratio_k1_col (begc:endc,1:nlevdecomp_full)) ; this%ratio_k1_col (:,:) = nan
- allocate(this%ratio_no3_co2_col (begc:endc,1:nlevdecomp_full)) ; this%ratio_no3_co2_col (:,:) = spval
- allocate(this%soil_co2_prod_col (begc:endc,1:nlevdecomp_full)) ; this%soil_co2_prod_col (:,:) = nan
- allocate(this%fr_WFPS_col (begc:endc,1:nlevdecomp_full)) ; this%fr_WFPS_col (:,:) = spval
-
- allocate(this%fmax_denit_carbonsubstrate_vr_col (begc:endc,1:nlevdecomp_full)) ;
- this%fmax_denit_carbonsubstrate_vr_col (:,:) = nan
- allocate(this%fmax_denit_nitrate_vr_col (begc:endc,1:nlevdecomp_full)) ;
- this%fmax_denit_nitrate_vr_col (:,:) = nan
-
- allocate(this%decomp_cascade_ntransfer_vr_col (begc:endc,1:nlevdecomp_full,1:ndecomp_cascade_transitions ))
- allocate(this%decomp_cascade_sminn_flux_vr_col (begc:endc,1:nlevdecomp_full,1:ndecomp_cascade_transitions ))
- allocate(this%decomp_cascade_ntransfer_col (begc:endc,1:ndecomp_cascade_transitions ))
- allocate(this%decomp_cascade_sminn_flux_col (begc:endc,1:ndecomp_cascade_transitions ))
-
- this%decomp_cascade_ntransfer_vr_col (:,:,:) = nan
- this%decomp_cascade_sminn_flux_vr_col (:,:,:) = nan
- this%decomp_cascade_ntransfer_col (:,:) = nan
- this%decomp_cascade_sminn_flux_col (:,:) = nan
-
- allocate(this%sminn_to_denit_decomp_cascade_vr_col (begc:endc,1:nlevdecomp_full,1:ndecomp_cascade_transitions ))
- allocate(this%sminn_to_denit_decomp_cascade_col (begc:endc,1:ndecomp_cascade_transitions ))
- allocate(this%sminn_to_denit_excess_vr_col (begc:endc,1:nlevdecomp_full ))
- allocate(this%sminn_to_denit_excess_col (begc:endc ))
- allocate(this%sminn_leached_vr_col (begc:endc,1:nlevdecomp_full ))
- allocate(this%sminn_leached_col (begc:endc ))
- allocate(this%decomp_npools_leached_col (begc:endc,1:ndecomp_pools ))
- allocate(this%decomp_npools_transport_tendency_col (begc:endc,1:nlevdecomp_full,1:ndecomp_pools ))
-
- this%sminn_to_denit_decomp_cascade_vr_col (:,:,:) = nan
- this%sminn_to_denit_decomp_cascade_col (:,:) = nan
- this%sminn_to_denit_excess_vr_col (:,:) = nan
- this%sminn_to_denit_excess_col (:) = nan
- this%sminn_leached_vr_col (:,:) = nan
- this%sminn_leached_col (:) = nan
- this%decomp_npools_leached_col (:,:) = nan
- this%decomp_npools_transport_tendency_col (:,:,:) = nan
-
- allocate(this%decomp_npools_sourcesink_col (begc:endc,1:nlevdecomp_full,1:ndecomp_pools))
- this%decomp_npools_sourcesink_col (:,:,:) = nan
-
- end subroutine InitAllocate
-
- !------------------------------------------------------------------------
- subroutine InitHistory(this, bounds)
- !
- ! !DESCRIPTION:
- ! Initialize module data structure
- !
- ! !USES:
- use histFileMod , only : hist_addfld1d, hist_addfld_decomp
- !
- ! !ARGUMENTS:
- class(soilbiogeochem_nitrogenflux_type) :: this
- type(bounds_type), intent(in) :: bounds
- !
- ! !LOCAL VARIABLES:
- integer :: k,l
- integer :: begc, endc
- character(24) :: fieldname
- character(100) :: longname
- character(8) :: vr_suffix
- real(r8), pointer :: data2dptr(:,:), data1dptr(:) ! temp. pointers for slicing larger arrays
- !------------------------------------------------------------------------
-
- begc = bounds%begc; endc= bounds%endc
-
- ! add suffix if number of soil decomposition depths is greater than 1
- if (nlevdecomp > 1) then
- vr_suffix = "_vr"
- else
- vr_suffix = ""
- endif
-
- !-------------------------------
- ! N flux variables - native to column
- !-------------------------------
-
- this%ndep_to_sminn_col(begc:endc) = spval
- call hist_addfld1d (fname='NDEP_TO_SMINN', units='gN/m^2/s', &
- avgflag='A', long_name='atmospheric N deposition to soil mineral N', &
- ptr_col=this%ndep_to_sminn_col, default='inactive')
-
- this%nfix_to_sminn_col(begc:endc) = spval
- call hist_addfld1d (fname='NFIX_TO_SMINN', units='gN/m^2/s', &
- avgflag='A', long_name='symbiotic/asymbiotic N fixation to soil mineral N', &
- ptr_col=this%nfix_to_sminn_col, default='inactive')
-
- this%ffix_to_sminn_col(begc:endc) = spval
- call hist_addfld1d (fname='FFIX_TO_SMINN', units='gN/m^2/s', &
- avgflag='A', long_name='free living N fixation to soil mineral N', &
- ptr_col=this%ffix_to_sminn_col, default='inactive')
-
- do l = 1, ndecomp_cascade_transitions
- ! vertically integrated fluxes
- !-- mineralization/immobilization fluxes (none from CWD)
- if ( .not. decomp_cascade_con%is_cwd(decomp_cascade_con%cascade_donor_pool(l)) ) then
- this%decomp_cascade_sminn_flux_col(begc:endc,l) = spval
- data1dptr => this%decomp_cascade_sminn_flux_col(:,l)
- if ( decomp_cascade_con%cascade_receiver_pool(l) /= 0 ) then
- fieldname = 'SMINN_TO_'//&
- trim(decomp_cascade_con%decomp_pool_name_history(decomp_cascade_con%cascade_receiver_pool(l)))//'N_'//&
- trim(decomp_cascade_con%decomp_pool_name_short(decomp_cascade_con%cascade_donor_pool(l)))
- longname = 'mineral N flux for decomp. of '&
- //trim(decomp_cascade_con%decomp_pool_name_history(decomp_cascade_con%cascade_donor_pool(l)))//&
- 'to '//trim(decomp_cascade_con%decomp_pool_name_history(decomp_cascade_con%cascade_receiver_pool(l)))
- else
- fieldname = trim(decomp_cascade_con%decomp_pool_name_history(decomp_cascade_con%cascade_donor_pool(l)))&
- //'N_TO_SMINN'
- longname = 'mineral N flux for decomp. of '&
- //trim(decomp_cascade_con%decomp_pool_name_history(decomp_cascade_con%cascade_donor_pool(l)))
- endif
- call hist_addfld1d (fname=fieldname, units='gN/m^2', &
- avgflag='A', long_name=longname, &
- ptr_col=data1dptr, default='inactive')
- end if
-
- !-- transfer fluxes (none from terminal pool, if present)
- if ( decomp_cascade_con%cascade_receiver_pool(l) /= 0 ) then
- this%decomp_cascade_ntransfer_col(begc:endc,l) = spval
- data1dptr => this%decomp_cascade_ntransfer_col(:,l)
- fieldname = trim(decomp_cascade_con%decomp_pool_name_history(decomp_cascade_con%cascade_donor_pool(l)))//'N_TO_'//&
- trim(decomp_cascade_con%decomp_pool_name_history(decomp_cascade_con%cascade_receiver_pool(l)))//'N'
- longname = 'decomp. of '//trim(decomp_cascade_con%decomp_pool_name_long(decomp_cascade_con%cascade_donor_pool(l)))//&
- ' N to '//trim(decomp_cascade_con%decomp_pool_name_long(decomp_cascade_con%cascade_receiver_pool(l)))//' N'
- call hist_addfld1d (fname=fieldname, units='gN/m^2', &
- avgflag='A', long_name=longname, &
- ptr_col=data1dptr, default='inactive')
- end if
-
- ! vertically resolved fluxes
- if ( nlevdecomp_full > 1 ) then
- !-- mineralization/immobilization fluxes (none from CWD)
- if ( .not. decomp_cascade_con%is_cwd(decomp_cascade_con%cascade_donor_pool(l)) ) then
- this%decomp_cascade_sminn_flux_vr_col(begc:endc,:,l) = spval
- data2dptr => this%decomp_cascade_sminn_flux_vr_col(:,:,l)
- if ( decomp_cascade_con%cascade_receiver_pool(l) /= 0 ) then
- fieldname = 'SMINN_TO_'&
- //trim(decomp_cascade_con%decomp_pool_name_history(decomp_cascade_con%cascade_receiver_pool(l)))//'N_'//&
- trim(decomp_cascade_con%decomp_pool_name_short(decomp_cascade_con%cascade_donor_pool(l)))//trim(vr_suffix)
- longname = 'mineral N flux for decomp. of '&
- //trim(decomp_cascade_con%decomp_pool_name_history(decomp_cascade_con%cascade_donor_pool(l)))//&
- 'to '//trim(decomp_cascade_con%decomp_pool_name_history(decomp_cascade_con%cascade_receiver_pool(l)))
- else
- fieldname = trim(decomp_cascade_con%decomp_pool_name_history(decomp_cascade_con%cascade_donor_pool(l)))&
- //'N_TO_SMINN'//trim(vr_suffix)
- longname = 'mineral N flux for decomp. of '&
- //trim(decomp_cascade_con%decomp_pool_name_history(decomp_cascade_con%cascade_donor_pool(l)))
- endif
- call hist_addfld_decomp (fname=fieldname, units='gN/m^3', type2d='levdcmp', &
- avgflag='A', long_name=longname, &
- ptr_col=data2dptr, default='inactive')
- endif
-
- !-- transfer fluxes (none from terminal pool, if present)
- if ( decomp_cascade_con%cascade_receiver_pool(l) /= 0 ) then
- this%decomp_cascade_ntransfer_vr_col(begc:endc,:,l) = spval
- data2dptr => this%decomp_cascade_ntransfer_vr_col(:,:,l)
- fieldname = trim(decomp_cascade_con%decomp_pool_name_history(decomp_cascade_con%cascade_donor_pool(l)))//'N_TO_'//&
- trim(decomp_cascade_con%decomp_pool_name_history(decomp_cascade_con%cascade_receiver_pool(l)))&
- //'N'//trim(vr_suffix)
- longname = 'decomp. of '&
- //trim(decomp_cascade_con%decomp_pool_name_long(decomp_cascade_con%cascade_donor_pool(l)))//&
- ' N to '//trim(decomp_cascade_con%decomp_pool_name_long(decomp_cascade_con%cascade_receiver_pool(l)))//' N'
- call hist_addfld_decomp (fname=fieldname, units='gN/m^3', type2d='levdcmp', &
- avgflag='A', long_name=longname, &
- ptr_col=data2dptr, default='inactive')
- endif
-
- endif
- end do
-
- this%denit_col(begc:endc) = spval
- call hist_addfld1d (fname='DENIT', units='gN/m^2/s', &
- avgflag='A', long_name='total rate of denitrification', &
- ptr_col=this%denit_col, default='inactive')
-
- this%som_n_leached_col(begc:endc) = spval
- call hist_addfld1d (fname='SOM_N_LEACHED', units='gN/m^2/s', &
- avgflag='A', long_name='total flux of N from SOM pools due to leaching', &
- ptr_col=this%som_n_leached_col, default='inactive')
-
- do k = 1, ndecomp_pools
- 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)
- fieldname = 'M_'//trim(decomp_cascade_con%decomp_pool_name_history(k))//'N_TO_LEACHING'
- longname = trim(decomp_cascade_con%decomp_pool_name_long(k))//' N leaching loss'
- call hist_addfld1d (fname=fieldname, units='gN/m^2/s', &
- avgflag='A', long_name=longname, &
- ptr_col=data1dptr, default='inactive')
-
- this%decomp_npools_transport_tendency_col(begc:endc,:,k) = spval
- data2dptr => this%decomp_npools_transport_tendency_col(:,:,k)
- fieldname = trim(decomp_cascade_con%decomp_pool_name_history(k))//'N_TNDNCY_VERT_TRANSPORT'
- longname = trim(decomp_cascade_con%decomp_pool_name_long(k))//' N tendency due to vertical transport'
- call hist_addfld_decomp (fname=fieldname, units='gN/m^3/s', type2d='levdcmp', &
- avgflag='A', long_name=longname, &
- ptr_col=data2dptr, default='inactive')
- end if
- end do
-
- if (.not. use_nitrif_denitrif) then
- do l = 1, ndecomp_cascade_transitions
- !-- denitrification fluxes (none from CWD)
- if ( .not. decomp_cascade_con%is_cwd(decomp_cascade_con%cascade_donor_pool(l)) ) then
- this%sminn_to_denit_decomp_cascade_col(begc:endc,l) = spval
- data1dptr => this%sminn_to_denit_decomp_cascade_col(:,l)
- fieldname = 'SMINN_TO_DENIT_'//trim(decomp_cascade_con%cascade_step_name(l))
- longname = 'denitrification for decomp. of '&
- //trim(decomp_cascade_con%decomp_pool_name_long(decomp_cascade_con%cascade_donor_pool(l)))//&
- 'to '//trim(decomp_cascade_con%decomp_pool_name_history(decomp_cascade_con%cascade_receiver_pool(l)))
- call hist_addfld1d (fname=fieldname, units='gN/m^2', &
- avgflag='A', long_name=longname, &
- ptr_col=data1dptr, default='inactive')
- endif
-
- if ( nlevdecomp_full > 1 ) then
- !-- denitrification fluxes (none from CWD)
- if ( .not. decomp_cascade_con%is_cwd(decomp_cascade_con%cascade_donor_pool(l)) ) then
- this%sminn_to_denit_decomp_cascade_vr_col(begc:endc,:,l) = spval
- data2dptr => this%sminn_to_denit_decomp_cascade_vr_col(:,:,l)
- fieldname = 'SMINN_TO_DENIT_'//trim(decomp_cascade_con%cascade_step_name(l))//trim(vr_suffix)
- longname = 'denitrification for decomp. of '&
- //trim(decomp_cascade_con%decomp_pool_name_long(decomp_cascade_con%cascade_donor_pool(l)))//&
- 'to '//trim(decomp_cascade_con%decomp_pool_name_history(decomp_cascade_con%cascade_receiver_pool(l)))
- call hist_addfld_decomp (fname=fieldname, units='gN/m^3', type2d='levdcmp', &
- avgflag='A', long_name=longname, &
- ptr_col=data2dptr, default='inactive')
- endif
- endif
- end do
- end if
-
- if (.not. use_nitrif_denitrif) then
- this%sminn_to_denit_excess_col(begc:endc) = spval
- call hist_addfld1d (fname='SMINN_TO_DENIT_EXCESS', units='gN/m^2/s', &
- avgflag='A', long_name='denitrification from excess mineral N pool', &
- ptr_col=this%sminn_to_denit_excess_col, default='inactive')
- end if
-
- if (.not. use_nitrif_denitrif) then
- this%sminn_leached_col(begc:endc) = spval
- call hist_addfld1d (fname='SMINN_LEACHED', units='gN/m^2/s', &
- avgflag='A', long_name='soil mineral N pool loss to leaching', &
- ptr_col=this%sminn_leached_col, default='inactive')
- end if
-
- if (.not. use_nitrif_denitrif) then
- if ( nlevdecomp_full > 1 ) then
- this%sminn_to_denit_excess_vr_col(begc:endc,:) = spval
- call hist_addfld_decomp (fname='SMINN_TO_DENIT_EXCESS'//trim(vr_suffix), units='gN/m^3/s', type2d='levdcmp', &
- avgflag='A', long_name='denitrification from excess mineral N pool', &
- ptr_col=this%sminn_to_denit_excess_vr_col, default='inactive')
-
- this%sminn_leached_vr_col(begc:endc,:) = spval
- call hist_addfld_decomp (fname='SMINN_LEACHED'//trim(vr_suffix), units='gN/m^3/s', type2d='levdcmp', &
- avgflag='A', long_name='soil mineral N pool loss to leaching', &
- ptr_col=this%sminn_leached_vr_col, default='inactive')
- endif
- end if
-
- if (use_nitrif_denitrif) then
- this%f_nit_col(begc:endc) = spval
- call hist_addfld1d (fname='F_NIT', units='gN/m^2/s', &
- avgflag='A', long_name='nitrification flux', &
- ptr_col=this%f_nit_col, default='inactive')
- end if
-
- if (use_nitrif_denitrif) then
- this%f_denit_col(begc:endc) = spval
- call hist_addfld1d (fname='F_DENIT', units='gN/m^2/s', &
- avgflag='A', long_name='denitrification flux', &
- ptr_col=this%f_denit_col, default='inactive')
- end if
-
- if (use_nitrif_denitrif) then
- this%pot_f_nit_col(begc:endc) = spval
- call hist_addfld1d (fname='POT_F_NIT', units='gN/m^2/s', &
- avgflag='A', long_name='potential nitrification flux', &
- ptr_col=this%pot_f_nit_col, default='inactive')
- end if
-
- if (use_nitrif_denitrif) then
- this%pot_f_denit_col(begc:endc) = spval
- call hist_addfld1d (fname='POT_F_DENIT', units='gN/m^2/s', &
- avgflag='A', long_name='potential denitrification flux', &
- ptr_col=this%pot_f_denit_col, default='inactive')
- end if
-
- if (use_nitrif_denitrif) then
- this%smin_no3_leached_col(begc:endc) = spval
- call hist_addfld1d (fname='SMIN_NO3_LEACHED', units='gN/m^2/s', &
- avgflag='A', long_name='soil NO3 pool loss to leaching', &
- ptr_col=this%smin_no3_leached_col, default='inactive')
- end if
-
- if (use_nitrif_denitrif) then
- this%smin_no3_runoff_col(begc:endc) = spval
- call hist_addfld1d (fname='SMIN_NO3_RUNOFF', units='gN/m^2/s', &
- avgflag='A', long_name='soil NO3 pool loss to runoff', &
- ptr_col=this%smin_no3_runoff_col, default='inactive')
- end if
-
- if (use_nitrif_denitrif .and. nlevdecomp_full > 1 ) then
- this%f_nit_vr_col(begc:endc,:) = spval
- call hist_addfld_decomp (fname='F_NIT'//trim(vr_suffix), units='gN/m^3/s', type2d='levdcmp', &
- avgflag='A', long_name='nitrification flux', &
- ptr_col=this%f_nit_vr_col, default='inactive')
- end if
-
- if (use_nitrif_denitrif .and. nlevdecomp_full > 1 ) then
- this%f_denit_vr_col(begc:endc,:) = spval
- call hist_addfld_decomp (fname='F_DENIT'//trim(vr_suffix), units='gN/m^3/s', type2d='levdcmp', &
- avgflag='A', long_name='denitrification flux', &
- ptr_col=this%f_denit_vr_col, default='inactive')
- end if
-
- if (use_nitrif_denitrif .and. nlevdecomp_full > 1 ) then
- this%pot_f_nit_vr_col(begc:endc,:) = spval
- call hist_addfld_decomp (fname='POT_F_NIT'//trim(vr_suffix), units='gN/m^3/s', type2d='levdcmp', &
- avgflag='A', long_name='potential nitrification flux', &
- ptr_col=this%pot_f_nit_vr_col, default='inactive')
- end if
-
- if (use_nitrif_denitrif .and. nlevdecomp_full > 1 ) then
- this%pot_f_denit_vr_col(begc:endc,:) = spval
- call hist_addfld_decomp (fname='POT_F_DENIT'//trim(vr_suffix), units='gN/m^3/s', type2d='levdcmp', &
- avgflag='A', long_name='potential denitrification flux', &
- ptr_col=this%pot_f_denit_vr_col, default='inactive')
- end if
-
- if (use_nitrif_denitrif .and. nlevdecomp_full > 1 ) then
- this%smin_no3_leached_vr_col(begc:endc,:) = spval
- call hist_addfld_decomp (fname='SMIN_NO3_LEACHED'//trim(vr_suffix), units='gN/m^3/s', type2d='levdcmp', &
- avgflag='A', long_name='soil NO3 pool loss to leaching', &
- ptr_col=this%smin_no3_leached_vr_col, default='inactive')
- end if
-
- if (use_nitrif_denitrif .and. nlevdecomp_full > 1 ) then
- this%smin_no3_runoff_vr_col(begc:endc,:) = spval
- call hist_addfld_decomp (fname='SMIN_NO3_RUNOFF'//trim(vr_suffix), units='gN/m^3/s', type2d='levdcmp', &
- avgflag='A', long_name='soil NO3 pool loss to runoff', &
- ptr_col=this%smin_no3_runoff_vr_col, default='inactive')
- endif
-
- if (use_nitrif_denitrif) then
- this%n2_n2o_ratio_denit_vr_col(begc:endc,:) = spval
- call hist_addfld_decomp (fname='n2_n2o_ratio_denit', units='gN/gN', type2d='levdcmp', &
- avgflag='A', long_name='n2_n2o_ratio_denit', &
- ptr_col=this%n2_n2o_ratio_denit_vr_col, default='inactive')
- end if
-
- if (use_nitrif_denitrif) then
- this%actual_immob_no3_vr_col(begc:endc,:) = spval
- call hist_addfld_decomp (fname='ACTUAL_IMMOB_NO3', units='gN/m^3/s', type2d='levdcmp', &
- avgflag='A', long_name='immobilization of NO3', &
- ptr_col=this%actual_immob_no3_vr_col, default='inactive')
- end if
-
- if (use_nitrif_denitrif) then
- this%actual_immob_nh4_vr_col(begc:endc,:) = spval
- call hist_addfld_decomp (fname='ACTUAL_IMMOB_NH4', units='gN/m^3/s', type2d='levdcmp', &
- avgflag='A', long_name='immobilization of NH4', &
- ptr_col=this%actual_immob_nh4_vr_col, default='inactive')
- end if
-
- if (use_nitrif_denitrif) then
- this%smin_no3_to_plant_vr_col(begc:endc,:) = spval
- call hist_addfld_decomp (fname='SMIN_NO3_TO_PLANT', units='gN/m^3/s', type2d='levdcmp', &
- avgflag='A', long_name='plant uptake of NO3', &
- ptr_col=this%smin_no3_to_plant_vr_col, default='inactive')
- end if
-
- if (use_nitrif_denitrif) then
- this%smin_nh4_to_plant_vr_col(begc:endc,:) = spval
- call hist_addfld_decomp (fname='SMIN_NH4_TO_PLANT', units='gN/m^3/s', type2d='levdcmp', &
- avgflag='A', long_name='plant uptake of NH4', &
- ptr_col=this%smin_nh4_to_plant_vr_col, default='inactive')
- end if
-
- if (use_nitrif_denitrif) then
- this%smin_no3_massdens_vr_col(begc:endc,:) = spval
- call hist_addfld_decomp (fname='SMIN_NO3_MASSDENS', units='ugN/cm^3 soil', type2d='levdcmp', &
- avgflag='A', long_name='SMIN_NO3_MASSDENS', &
- ptr_col=this%smin_no3_massdens_vr_col, default='inactive')
- end if
-
- if (use_nitrif_denitrif) then
- this%k_nitr_t_vr_col(begc:endc,:) = spval
- call hist_addfld_decomp (fname='K_NITR_T', units='unitless', type2d='levdcmp', &
- avgflag='A', long_name='K_NITR_T', &
- ptr_col=this%k_nitr_t_vr_col, default='inactive')
- end if
-
- if (use_nitrif_denitrif) then
- this%k_nitr_ph_vr_col(begc:endc,:) = spval
- call hist_addfld_decomp (fname='K_NITR_PH', units='unitless', type2d='levdcmp', &
- avgflag='A', long_name='K_NITR_PH', &
- ptr_col=this%k_nitr_ph_vr_col, default='inactive')
- end if
-
- if (use_nitrif_denitrif) then
- this%k_nitr_h2o_vr_col(begc:endc,:) = spval
- call hist_addfld_decomp (fname='K_NITR_H2O', units='unitless', type2d='levdcmp', &
- avgflag='A', long_name='K_NITR_H2O', &
- ptr_col=this%k_nitr_h2o_vr_col, default='inactive')
- end if
-
- if (use_nitrif_denitrif) then
- this%k_nitr_vr_col(begc:endc,:) = spval
- call hist_addfld_decomp (fname='K_NITR', units='1/s', type2d='levdcmp', &
- avgflag='A', long_name='K_NITR', &
- ptr_col=this%k_nitr_vr_col, default='inactive')
- end if
-
- if (use_nitrif_denitrif) then
- this%wfps_vr_col(begc:endc,:) = spval
- call hist_addfld_decomp (fname='WFPS', units='percent', type2d='levdcmp', &
- avgflag='A', long_name='WFPS', &
- ptr_col=this%wfps_vr_col, default='inactive')
- end if
-
- if (use_nitrif_denitrif) then
- this%fmax_denit_carbonsubstrate_vr_col(begc:endc,:) = spval
- call hist_addfld_decomp (fname='FMAX_DENIT_CARBONSUBSTRATE', units='gN/m^3/s', type2d='levdcmp', &
- avgflag='A', long_name='FMAX_DENIT_CARBONSUBSTRATE', &
- ptr_col=this%fmax_denit_carbonsubstrate_vr_col, default='inactive')
- end if
-
- if (use_nitrif_denitrif) then
- this%fmax_denit_nitrate_vr_col(begc:endc,:) = spval
- call hist_addfld_decomp (fname='FMAX_DENIT_NITRATE', units='gN/m^3/s', type2d='levdcmp', &
- avgflag='A', long_name='FMAX_DENIT_NITRATE', &
- ptr_col=this%fmax_denit_nitrate_vr_col, default='inactive')
- end if
-
- if (use_nitrif_denitrif) then
- this%f_denit_base_vr_col(begc:endc,:) = spval
- call hist_addfld_decomp (fname='F_DENIT_BASE', units='gN/m^3/s', type2d='levdcmp', &
- avgflag='A', long_name='F_DENIT_BASE', &
- ptr_col=this%f_denit_base_vr_col, default='inactive')
- end if
-
- if (use_nitrif_denitrif) then
- this%diffus_col(begc:endc,:) = spval
- call hist_addfld_decomp (fname='diffus', units='m^2/s', type2d='levdcmp', &
- avgflag='A', long_name='diffusivity', &
- ptr_col=this%diffus_col, default='inactive')
- end if
-
- if (use_nitrif_denitrif) then
- this%ratio_k1_col(begc:endc,:) = spval
- call hist_addfld_decomp (fname='ratio_k1', units='none', type2d='levdcmp', &
- avgflag='A', long_name='ratio_k1', &
- ptr_col=this%ratio_k1_col, default='inactive')
- end if
-
- if (use_nitrif_denitrif) then
- this%ratio_no3_co2_col(begc:endc,:) = spval
- call hist_addfld_decomp (fname='ratio_no3_co2', units='ratio', type2d='levdcmp', &
- avgflag='A', long_name='ratio_no3_co2', &
- ptr_col=this%ratio_no3_co2_col, default='inactive')
- end if
-
- if (use_nitrif_denitrif) then
- this%soil_co2_prod_col(begc:endc,:) = spval
- call hist_addfld_decomp (fname='soil_co2_prod', units='ug C / g soil / day', type2d='levdcmp', &
- avgflag='A', long_name='soil_co2_prod', &
- ptr_col=this%soil_co2_prod_col, default='inactive')
- end if
-
- if (use_nitrif_denitrif) then
- this%fr_WFPS_col(begc:endc,:) = spval
- call hist_addfld_decomp (fname='fr_WFPS', units='fraction', type2d='levdcmp', &
- avgflag='A', long_name='fr_WFPS', &
- ptr_col=this%fr_WFPS_col, default='inactive')
- end if
-
- if (use_nitrif_denitrif) then
- this%soil_bulkdensity_col(begc:endc,:) = spval
- call hist_addfld_decomp (fname='soil_bulkdensity', units='kg/m3', type2d='levdcmp', &
- avgflag='A', long_name='soil_bulkdensity', &
- ptr_col=this%soil_bulkdensity_col, default='inactive')
- end if
-
- if (use_nitrif_denitrif) then
- this%anaerobic_frac_col(begc:endc,:) = spval
- call hist_addfld_decomp (fname='anaerobic_frac', units='m3/m3', type2d='levdcmp', &
- avgflag='A', long_name='anaerobic_frac', &
- ptr_col=this%anaerobic_frac_col, default='inactive')
- end if
-
- if (use_nitrif_denitrif) then
- this%r_psi_col(begc:endc,:) = spval
- call hist_addfld_decomp (fname='r_psi', units='m', type2d='levdcmp', &
- avgflag='A', long_name='r_psi', &
- ptr_col=this%r_psi_col, default='inactive')
- end if
-
-
- if ( use_nitrif_denitrif .and. nlevdecomp_full > 1 ) then
- this%potential_immob_vr_col(begc:endc,:) = spval
- call hist_addfld_decomp (fname='POTENTIAL_IMMOB'//trim(vr_suffix), units='gN/m^3/s', type2d='levdcmp', &
- avgflag='A', long_name='potential N immobilization', &
- ptr_col=this%potential_immob_vr_col, default='inactive')
- end if
-
- if ( use_nitrif_denitrif .and. nlevdecomp_full > 1 ) then
- this%actual_immob_vr_col(begc:endc,:) = spval
- call hist_addfld_decomp (fname='ACTUAL_IMMOB'//trim(vr_suffix), units='gN/m^3/s', type2d='levdcmp', &
- avgflag='A', long_name='actual N immobilization', &
- ptr_col=this%actual_immob_vr_col, default='inactive')
- end if
-
- if ( use_nitrif_denitrif .and. nlevdecomp_full > 1 ) then
- this%sminn_to_plant_vr_col(begc:endc,:) = spval
- call hist_addfld_decomp (fname='SMINN_TO_PLANT'//trim(vr_suffix), units='gN/m^3/s', type2d='levdcmp', &
- avgflag='A', long_name='plant uptake of soil mineral N', &
- ptr_col=this%sminn_to_plant_vr_col, default='inactive')
- end if
-
- if ( use_nitrif_denitrif .and. nlevdecomp_full > 1 ) then
- this%supplement_to_sminn_vr_col(begc:endc,:) = spval
- call hist_addfld_decomp (fname='SUPPLEMENT_TO_SMINN'//trim(vr_suffix), units='gN/m^3/s', type2d='levdcmp', &
- avgflag='A', long_name='supplemental N supply', &
- ptr_col=this%supplement_to_sminn_vr_col, default='inactive')
- end if
-
- if ( use_nitrif_denitrif .and. nlevdecomp_full > 1 ) then
- this%gross_nmin_vr_col(begc:endc,:) = spval
- call hist_addfld_decomp (fname='GROSS_NMIN'//trim(vr_suffix), units='gN/m^3/s', type2d='levdcmp', &
- avgflag='A', long_name='gross rate of N mineralization', &
- ptr_col=this%gross_nmin_vr_col, default='inactive')
- end if
-
- if ( use_nitrif_denitrif .and. nlevdecomp_full > 1 ) then
- this%net_nmin_vr_col(begc:endc,:) = spval
- call hist_addfld_decomp (fname='NET_NMIN'//trim(vr_suffix), units='gN/m^3/s', type2d='levdcmp', &
- avgflag='A', long_name='net rate of N mineralization', &
- ptr_col=this%net_nmin_vr_col, default='inactive')
- end if
-
- this%potential_immob_col(begc:endc) = spval
- call hist_addfld1d (fname='POTENTIAL_IMMOB', units='gN/m^2/s', &
- avgflag='A', long_name='potential N immobilization', &
- ptr_col=this%potential_immob_col, default='inactive')
-
- this%actual_immob_col(begc:endc) = spval
- call hist_addfld1d (fname='ACTUAL_IMMOB', units='gN/m^2/s', &
- avgflag='A', long_name='actual N immobilization', &
- ptr_col=this%actual_immob_col, default='inactive')
-
- this%sminn_to_plant_col(begc:endc) = spval
- call hist_addfld1d (fname='SMINN_TO_PLANT', units='gN/m^2/s', &
- avgflag='A', long_name='plant uptake of soil mineral N', &
- ptr_col=this%sminn_to_plant_col, default='inactive')
-
- this%supplement_to_sminn_col(begc:endc) = spval
- call hist_addfld1d (fname='SUPPLEMENT_TO_SMINN', units='gN/m^2/s', &
- avgflag='A', long_name='supplemental N supply', &
- ptr_col=this%supplement_to_sminn_col, default='inactive')
-
- this%gross_nmin_col(begc:endc) = spval
- call hist_addfld1d (fname='GROSS_NMIN', units='gN/m^2/s', &
- avgflag='A', long_name='gross rate of N mineralization', &
- ptr_col=this%gross_nmin_col, default='inactive')
-
- this%net_nmin_col(begc:endc) = spval
- call hist_addfld1d (fname='NET_NMIN', units='gN/m^2/s', &
- avgflag='A', long_name='net rate of N mineralization', &
- ptr_col=this%net_nmin_col, default='inactive')
-
- if (use_nitrif_denitrif) then
- this%f_n2o_nit_col(begc:endc) = spval
- call hist_addfld1d (fname='F_N2O_NIT', units='gN/m^2/s', &
- avgflag='A', long_name='nitrification N2O flux', &
- ptr_col=this%f_n2o_nit_col, default='inactive')
-
- this%f_n2o_denit_col(begc:endc) = spval
- call hist_addfld1d (fname='F_N2O_DENIT', units='gN/m^2/s', &
- avgflag='A', long_name='denitrification N2O flux', &
- ptr_col=this%f_n2o_denit_col, default='inactive')
- end if
-
- if (use_crop) then
- this%fert_to_sminn_col(begc:endc) = spval
- call hist_addfld1d (fname='FERT_TO_SMINN', units='gN/m^2/s', &
- avgflag='A', long_name='fertilizer to soil mineral N', &
- ptr_col=this%fert_to_sminn_col, default='inactive')
- end if
-
- if (use_crop .and. .not. use_fun) then
- this%soyfixn_to_sminn_col(begc:endc) = spval
- call hist_addfld1d (fname='SOYFIXN_TO_SMINN', units='gN/m^2/s', &
- avgflag='A', long_name='Soybean fixation to soil mineral N', &
- ptr_col=this%soyfixn_to_sminn_col, default='inactive')
- end if
-
- end subroutine InitHistory
-
- !-----------------------------------------------------------------------
- subroutine InitCold(this, bounds)
- !
- ! !DESCRIPTION:
- ! Initializes time varying variables used only in coupled carbon-nitrogen mode (CN):
- !
- ! !USES:
- use landunit_varcon , only : istsoil, istcrop
- !
- ! !ARGUMENTS:
- class(soilbiogeochem_nitrogenflux_type) :: this
- type(bounds_type), intent(in) :: bounds
- !
- ! !LOCAL VARIABLES:
- integer :: c,l
- integer :: num_special_col ! number of good values in special_col filter
- integer :: special_col(bounds%endc-bounds%begc+1) ! special landunit filter - columns
- !---------------------------------------------------------------------
-
- ! Set column filters
-
- num_special_col = 0
- do c = bounds%begc, bounds%endc
- l = col%landunit(c)
- if (lun%ifspecial(l)) then
- num_special_col = num_special_col + 1
- special_col(num_special_col) = c
- end if
- end do
-
- !-----------------------------------------------
- ! initialize nitrogen flux variables
- !-----------------------------------------------
-
- call this%SetValues (&
- num_column=num_special_col, filter_column=special_col, value_column=0._r8)
-
- end subroutine InitCold
-
- !-----------------------------------------------------------------------
- subroutine Restart (this, bounds, ncid, flag )
- !
- ! !DESCRIPTION:
- ! Read/write CN restart data for carbon state
- !
- ! !USES:
- use restUtilMod
- use ncdio_pio
- !
- ! !ARGUMENTS:
- class(soilbiogeochem_nitrogenflux_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
- real(r8), pointer :: ptr2d(:,:) ! temp. pointers for slicing larger arrays
- real(r8), pointer :: ptr1d(:) ! temp. pointers for slicing larger arrays
- !------------------------------------------------------------------------
-
- if (use_nitrif_denitrif) then
- ! pot_f_nit_vr
- if (use_vertsoilc) then
- ptr2d => this%pot_f_nit_vr_col(:,:)
- call restartvar(ncid=ncid, flag=flag, varname='pot_f_nit_vr_vr', xtype=ncd_double, &
- dim1name='column', dim2name='levgrnd', switchdim=.true., &
- long_name='potential soil nitrification flux', units='gN/m3/s', &
- interpinic_flag='interp', readvar=readvar, data=ptr2d)
- else
- ptr1d => this%pot_f_nit_vr_col(:,1)
- call restartvar(ncid=ncid, flag=flag, varname='pot_f_nit_vr', xtype=ncd_double, &
- dim1name='column', &
- long_name='soil nitrification flux', units='gN/m3/s', &
- interpinic_flag='interp', readvar=readvar, data=ptr1d)
- end if
- if (flag=='read' .and. .not. readvar) then
- call endrun(msg= 'ERROR:: pot_f_nit_vr'//' is required on an initialization dataset' )
- end if
- end if
-
- if (use_nitrif_denitrif) then
- ! f_nit_vr
- if (use_vertsoilc) then
- ptr2d => this%f_nit_vr_col(:,:)
- call restartvar(ncid=ncid, flag=flag, varname='f_nit_vr_vr', xtype=ncd_double, &
- dim1name='column', dim2name='levgrnd', switchdim=.true., &
- long_name='soil nitrification flux', units='gN/m3/s', &
- interpinic_flag='interp', readvar=readvar, data=ptr2d)
- else
- ptr1d => this%f_nit_vr_col(:,1)
- call restartvar(ncid=ncid, flag=flag, varname='f_nit_vr', xtype=ncd_double, &
- dim1name='column', &
- long_name='soil nitrification flux', units='gN/m3/s', &
- interpinic_flag='interp', readvar=readvar, data=ptr1d)
- end if
- if (flag=='read' .and. .not. readvar) then
- call endrun(msg='ERROR:: f_nit_vr'//' is required on an initialization dataset'//&
- errMsg(sourcefile, __LINE__))
- end if
- end if
-
- end subroutine Restart
-
- !-----------------------------------------------------------------------
- subroutine SetValues ( this, &
- num_column, filter_column, value_column)
- !
- ! !DESCRIPTION:
- ! Set nitrogen flux variables
- !
- ! !ARGUMENTS:
- ! !ARGUMENTS:
- class(soilbiogeochem_nitrogenflux_type) :: this
- integer , intent(in) :: num_column
- integer , intent(in) :: filter_column(:)
- real(r8), intent(in) :: value_column
- !
- ! !LOCAL VARIABLES:
- integer :: fi,i,j,k,l ! loop index
- !------------------------------------------------------------------------
-
- do j = 1, nlevdecomp_full
- do fi = 1,num_column
- i = filter_column(fi)
-
- 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
- this%sminn_to_plant_fun_vr_col(i,j) = value_column
- else
- this%f_nit_vr_col(i,j) = value_column
- this%f_denit_vr_col(i,j) = value_column
- this%smin_no3_leached_vr_col(i,j) = value_column
- this%smin_no3_runoff_vr_col(i,j) = value_column
- this%n2_n2o_ratio_denit_vr_col(i,j) = value_column
- this%pot_f_nit_vr_col(i,j) = value_column
- this%pot_f_denit_vr_col(i,j) = value_column
- this%actual_immob_no3_vr_col(i,j) = value_column
- this%actual_immob_nh4_vr_col(i,j) = value_column
- this%smin_no3_to_plant_vr_col(i,j) = value_column
- this%smin_nh4_to_plant_vr_col(i,j) = value_column
- this%f_n2o_denit_vr_col(i,j) = value_column
- this%f_n2o_nit_vr_col(i,j) = value_column
-
- this%smin_no3_massdens_vr_col(i,j) = value_column
- this%k_nitr_t_vr_col(i,j) = value_column
- this%k_nitr_ph_vr_col(i,j) = value_column
- this%k_nitr_h2o_vr_col(i,j) = value_column
- this%k_nitr_vr_col(i,j) = value_column
- this%wfps_vr_col(i,j) = value_column
- this%fmax_denit_carbonsubstrate_vr_col(i,j) = value_column
- this%fmax_denit_nitrate_vr_col(i,j) = value_column
- this%f_denit_base_vr_col(i,j) = value_column
-
- this%diffus_col(i,j) = value_column
- this%ratio_k1_col(i,j) = value_column
- this%ratio_no3_co2_col(i,j) = value_column
- this%soil_co2_prod_col(i,j) = value_column
- this%fr_WFPS_col(i,j) = value_column
- this%soil_bulkdensity_col(i,j) = value_column
-
- this%r_psi_col(i,j) = value_column
- this%anaerobic_frac_col(i,j) = value_column
- end if
- this%potential_immob_vr_col(i,j) = value_column
- this%actual_immob_vr_col(i,j) = value_column
- this%sminn_to_plant_vr_col(i,j) = value_column
- this%supplement_to_sminn_vr_col(i,j) = value_column
- this%gross_nmin_vr_col(i,j) = value_column
- this%net_nmin_vr_col(i,j) = value_column
- this%sminn_to_plant_fun_no3_vr_col(i,j) = value_column
- this%sminn_to_plant_fun_nh4_vr_col(i,j) = value_column
- end do
- end do
-
- do fi = 1,num_column
- i = filter_column(fi)
-
- this%ndep_to_sminn_col(i) = value_column
- this%nfix_to_sminn_col(i) = value_column
- this%ffix_to_sminn_col(i) = value_column
- this%fert_to_sminn_col(i) = value_column
- this%soyfixn_to_sminn_col(i) = value_column
- this%potential_immob_col(i) = value_column
- this%actual_immob_col(i) = value_column
- this%sminn_to_plant_col(i) = value_column
- this%supplement_to_sminn_col(i) = value_column
- this%gross_nmin_col(i) = value_column
- this%net_nmin_col(i) = value_column
- this%denit_col(i) = value_column
- this%sminn_to_plant_fun_col(i) = value_column
- 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
- this%pot_f_denit_col(i) = value_column
- this%f_n2o_denit_col(i) = value_column
- this%f_n2o_nit_col(i) = value_column
- this%smin_no3_leached_col(i) = value_column
- this%smin_no3_runoff_col(i) = value_column
- else
- this%sminn_to_denit_excess_col(i) = value_column
- this%sminn_leached_col(i) = value_column
- end if
- this%ninputs_col(i) = value_column
- this%noutputs_col(i) = value_column
- this%som_n_leached_col(i) = value_column
- end do
-
- do k = 1, ndecomp_pools
- do fi = 1,num_column
- i = filter_column(fi)
- this%decomp_npools_leached_col(i,k) = value_column
- end do
- end do
-
- do k = 1, ndecomp_pools
- do j = 1, nlevdecomp_full
- do fi = 1,num_column
- i = filter_column(fi)
- this%decomp_npools_transport_tendency_col(i,j,k) = value_column
- end do
- end do
- end do
-
- do l = 1, ndecomp_cascade_transitions
- do fi = 1,num_column
- i = filter_column(fi)
- this%decomp_cascade_ntransfer_col(i,l) = value_column
- this%decomp_cascade_sminn_flux_col(i,l) = value_column
- if (.not. use_nitrif_denitrif) then
- this%sminn_to_denit_decomp_cascade_col(i,l) = value_column
- end if
- end do
- end do
-
- do l = 1, ndecomp_cascade_transitions
- do j = 1, nlevdecomp_full
- do fi = 1,num_column
- i = filter_column(fi)
- this%decomp_cascade_ntransfer_vr_col(i,j,l) = value_column
- this%decomp_cascade_sminn_flux_vr_col(i,j,l) = value_column
- if (.not. use_nitrif_denitrif) then
- this%sminn_to_denit_decomp_cascade_vr_col(i,j,l) = value_column
- end if
- end do
- end do
- end do
-
- do k = 1, ndecomp_pools
- do j = 1, nlevdecomp_full
- do fi = 1,num_column
- i = filter_column(fi)
- this%decomp_npools_sourcesink_col(i,j,k) = value_column
- end do
- end do
- end do
-
- end subroutine SetValues
-
-end module soilbiogeochemNitrogenFluxType
-
diff --git a/src/soilbiogeochem/SoilBiogeochemNitrogenStateType.F90 b/src/soilbiogeochem/SoilBiogeochemNitrogenStateType.F90
deleted file mode 100644
index 9403bd6c..00000000
--- a/src/soilbiogeochem/SoilBiogeochemNitrogenStateType.F90
+++ /dev/null
@@ -1,717 +0,0 @@
-module SoilBiogeochemNitrogenStateType
-
-#include "shr_assert.h"
-
- use shr_kind_mod , only : r8 => shr_kind_r8
- use shr_infnan_mod , only : nan => shr_infnan_nan, assignment(=)
- use shr_log_mod , only : errMsg => shr_log_errMsg
- use decompMod , only : bounds_type
- use abortutils , only : endrun
- use spmdMod , only : masterproc
- use clm_varpar , only : ndecomp_cascade_transitions, ndecomp_pools, nlevcan
- use clm_varpar , only : nlevdecomp_full, nlevdecomp, nlevsoi
- use clm_varcon , only : spval, dzsoi_decomp, zisoi
- use clm_varctl , only : use_nitrif_denitrif, use_vertsoilc, use_century_decomp
- use clm_varctl , only : iulog, override_bgc_restart_mismatch_dump, spinup_state
- use landunit_varcon , only : istcrop, istsoil
- use SoilBiogeochemDecompCascadeConType , only : decomp_cascade_con
- use LandunitType , only : lun
- use ColumnType , only : col
- use GridcellType , only : grc
- use SoilBiogeochemStateType , only : get_spinup_latitude_term
- !
- ! !PUBLIC TYPES:
- implicit none
- private
-
- type, public :: soilbiogeochem_nitrogenstate_type
-
- 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
-
- ! nitrif_denitrif
- real(r8), pointer :: smin_no3_vr_col (:,:) ! col (gN/m3) vertically-resolved soil mineral NO3
- real(r8), pointer :: smin_no3_col (:) ! col (gN/m2) soil mineral NO3 pool
- real(r8), pointer :: smin_nh4_vr_col (:,:) ! col (gN/m3) vertically-resolved soil mineral NH4
- real(r8), pointer :: smin_nh4_col (:) ! col (gN/m2) soil mineral NH4 pool
-
- ! summary (diagnostic) state variables, not involved in mass balance
- real(r8), pointer :: decomp_npools_col (:,:) ! col (gN/m2) decomposing (litter, cwd, soil) N pools
- real(r8), pointer :: decomp_npools_1m_col (:,:) ! col (gN/m2) diagnostic: decomposing (litter, cwd, soil) N pools to 1 meter
- real(r8), pointer :: sminn_col (:) ! col (gN/m2) soil mineral N
- real(r8), pointer :: ntrunc_col (:) ! col (gN/m2) column-level sink for N truncation
- real(r8), pointer :: cwdn_col (:) ! col (gN/m2) Diagnostic: coarse woody debris N
- real(r8), pointer :: totlitn_col (:) ! col (gN/m2) total litter nitrogen
- real(r8), pointer :: totsomn_col (:) ! col (gN/m2) total soil organic matter nitrogen
- real(r8), pointer :: totlitn_1m_col (:) ! col (gN/m2) total litter nitrogen to 1 meter
- real(r8), pointer :: totsomn_1m_col (:) ! col (gN/m2) total soil organic matter nitrogen to 1 meter
- real(r8), pointer :: dyn_nbal_adjustments_col (:) ! (gN/m2) adjustments to each column made in this timestep via dynamic column adjustments (note: this variable only makes sense at the column-level: it is meaningless if averaged to the gridcell-level)
-
- ! Track adjustments to no3 and nh4 pools separately, since those aren't included in
- ! the N balance check
- real(r8), pointer :: dyn_no3bal_adjustments_col (:) ! (gN/m2) NO3 adjustments to each column made in this timestep via dynamic column area adjustments (only makes sense at the column-level: meaningless if averaged to the gridcell-level)
- real(r8), pointer :: dyn_nh4bal_adjustments_col (:) ! (gN/m2) NH4 adjustments to each column made in this timestep via dynamic column adjustments (only makes sense at the column-level: meaningless if averaged to the gridcell-level)
- real(r8) :: totvegcthresh ! threshold for total vegetation carbon to zero out decomposition pools
-
- contains
-
- procedure , public :: Init
- procedure , public :: Restart
- procedure , public :: SetValues
- procedure , private :: InitAllocate
- procedure , private :: InitHistory
- procedure , private :: InitCold
-
- end type soilbiogeochem_nitrogenstate_type
-
- character(len=*), parameter, private :: sourcefile = &
- __FILE__
- !------------------------------------------------------------------------
-
-contains
-
- !------------------------------------------------------------------------
- subroutine Init(this, bounds, &
- decomp_cpools_vr_col, decomp_cpools_col, decomp_cpools_1m_col)
-
- class(soilbiogeochem_nitrogenstate_type) :: this
- type(bounds_type) , intent(in) :: bounds
- real(r8) , intent(in) :: decomp_cpools_vr_col (bounds%begc:, 1:, 1:)
- real(r8) , intent(in) :: decomp_cpools_col (bounds%begc:, 1:)
- real(r8) , intent(in) :: decomp_cpools_1m_col (bounds%begc:, 1:)
-
- this%totvegcthresh = nan
- call this%InitAllocate (bounds )
-
- call this%InitHistory (bounds)
-
- call this%InitCold ( bounds, &
- decomp_cpools_vr_col, decomp_cpools_col, decomp_cpools_1m_col)
-
- end subroutine Init
-
- !------------------------------------------------------------------------
- subroutine InitAllocate(this, bounds)
- !
- ! !ARGUMENTS:
- class (soilbiogeochem_nitrogenstate_type) :: this
- type(bounds_type) , intent(in) :: bounds
- !
- ! !LOCAL VARIABLES:
- integer :: begc,endc
- !------------------------------------------------------------------------
-
- begc = bounds%begc; endc = bounds%endc
-
- 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
- allocate(this%smin_nh4_vr_col (begc:endc,1:nlevdecomp_full)) ; this%smin_nh4_vr_col (:,:) = nan
- allocate(this%smin_no3_col (begc:endc)) ; this%smin_no3_col (:) = nan
- allocate(this%smin_nh4_col (begc:endc)) ; this%smin_nh4_col (:) = nan
- allocate(this%cwdn_col (begc:endc)) ; this%cwdn_col (:) = nan
- allocate(this%sminn_col (begc:endc)) ; this%sminn_col (:) = nan
- allocate(this%ntrunc_col (begc:endc)) ; this%ntrunc_col (:) = nan
- allocate(this%totlitn_col (begc:endc)) ; this%totlitn_col (:) = nan
- allocate(this%totsomn_col (begc:endc)) ; this%totsomn_col (:) = nan
- allocate(this%totlitn_1m_col (begc:endc)) ; this%totlitn_1m_col (:) = nan
- allocate(this%totsomn_1m_col (begc:endc)) ; this%totsomn_1m_col (:) = nan
- allocate(this%dyn_nbal_adjustments_col (begc:endc)) ; this%dyn_nbal_adjustments_col (:) = nan
- allocate(this%dyn_no3bal_adjustments_col (begc:endc)) ; this%dyn_no3bal_adjustments_col (:) = nan
- allocate(this%dyn_nh4bal_adjustments_col (begc:endc)) ; this%dyn_nh4bal_adjustments_col (:) = nan
- allocate(this%decomp_npools_col (begc:endc,1:ndecomp_pools)) ; this%decomp_npools_col (:,:) = nan
- allocate(this%decomp_npools_1m_col (begc:endc,1:ndecomp_pools)) ; this%decomp_npools_1m_col (:,:) = nan
-
- allocate(this%decomp_npools_vr_col(begc:endc,1:nlevdecomp_full,1:ndecomp_pools));
- this%decomp_npools_vr_col(:,:,:)= nan
-
- end subroutine InitAllocate
-
- !------------------------------------------------------------------------
- subroutine InitHistory(this, bounds)
- !
- ! !DESCRIPTION:
- ! add history fields for all CN variables, always set as default='inactive'
- !
- ! !USES:
- use clm_varpar , only : ndecomp_cascade_transitions, ndecomp_pools
- use clm_varpar , only : nlevdecomp, nlevdecomp_full, nlevgrnd
- use histFileMod, only : hist_addfld1d, hist_addfld2d, hist_addfld_decomp
- use decompMod , only : bounds_type
- !
- ! !ARGUMENTS:
- class(soilbiogeochem_nitrogenstate_type) :: this
- type(bounds_type) , intent(in) :: bounds
- !
- ! !LOCAL VARIABLES:
- integer :: k,l,ii,jj
- character(10) :: active
- character(8) :: vr_suffix
- integer :: begc,endc
- character(24) :: fieldname
- character(100) :: longname
- real(r8), pointer :: data1dptr(:) ! temp. pointer for slicing larger arrays
- real(r8), pointer :: data2dptr(:,:) ! temp. pointer for slicing larger arrays
- !---------------------------------------------------------------------
-
- begc = bounds%begc; endc = bounds%endc
-
- if ( nlevdecomp_full > 1 ) then
- this%decomp_npools_vr_col(begc:endc,:,:) = spval
- this%decomp_npools_1m_col(begc:endc,:) = spval
- end if
- this%decomp_npools_col(begc:endc,:) = spval
- do l = 1, ndecomp_pools
- if ( nlevdecomp_full > 1 ) then
- data2dptr => this%decomp_npools_vr_col(:,:,l)
- fieldname = trim(decomp_cascade_con%decomp_pool_name_history(l))//'N_vr'
- longname = trim(decomp_cascade_con%decomp_pool_name_history(l))//' N (vertically resolved)'
- call hist_addfld2d (fname=fieldname, units='gN/m^3', type2d='levdcmp', &
- avgflag='A', long_name=longname, &
- ptr_col=data2dptr, default='inactive')
- endif
-
- data1dptr => this%decomp_npools_col(:,l)
- fieldname = trim(decomp_cascade_con%decomp_pool_name_history(l))//'N'
- longname = trim(decomp_cascade_con%decomp_pool_name_history(l))//' N'
- call hist_addfld1d (fname=fieldname, units='gN/m^2', &
- avgflag='A', long_name=longname, &
- ptr_col=data1dptr, default='inactive')
-
- if ( nlevdecomp_full > 1 ) then
- data1dptr => this%decomp_npools_1m_col(:,l)
- fieldname = trim(decomp_cascade_con%decomp_pool_name_history(l))//'N_1m'
- longname = trim(decomp_cascade_con%decomp_pool_name_history(l))//' N to 1 meter'
- call hist_addfld1d (fname=fieldname, units='gN/m^2', &
- avgflag='A', long_name=longname, &
- ptr_col=data1dptr, default = 'inactive')
- endif
- end do
-
-
- if ( nlevdecomp_full > 1 ) then
-
- this%sminn_col(begc:endc) = spval
- call hist_addfld1d (fname='SMINN', units='gN/m^2', &
- avgflag='A', long_name='soil mineral N', &
- ptr_col=this%sminn_col, default='inactive')
-
- this%totlitn_1m_col(begc:endc) = spval
- call hist_addfld1d (fname='TOTLITN_1m', units='gN/m^2', &
- avgflag='A', long_name='total litter N to 1 meter', &
- ptr_col=this%totlitn_1m_col, default='inactive')
-
- this%totsomn_1m_col(begc:endc) = spval
- call hist_addfld1d (fname='TOTSOMN_1m', units='gN/m^2', &
- avgflag='A', long_name='total soil organic matter N to 1 meter', &
- ptr_col=this%totsomn_1m_col, default='inactive')
- endif
-
- this%ntrunc_col(begc:endc) = spval
- call hist_addfld1d (fname='COL_NTRUNC', units='gN/m^2', &
- avgflag='A', long_name='column-level sink for N truncation', &
- ptr_col=this%ntrunc_col, default='inactive')
-
- ! add suffix if number of soil decomposition depths is greater than 1
- if (nlevdecomp > 1) then
- vr_suffix = "_vr"
- else
- vr_suffix = ""
- endif
-
- if (use_nitrif_denitrif) then
- if ( nlevdecomp_full > 1 ) then
- data2dptr => this%smin_no3_vr_col(begc:endc,1:nlevsoi)
- call hist_addfld_decomp (fname='SMIN_NO3'//trim(vr_suffix), units='gN/m^3', type2d='levsoi', &
- avgflag='A', long_name='soil mineral NO3 (vert. res.)', &
- ptr_col=data2dptr, default='inactive')
-
- data2dptr => this%smin_nh4_vr_col(begc:endc,1:nlevsoi)
- call hist_addfld_decomp (fname='SMIN_NH4'//trim(vr_suffix), units='gN/m^3', type2d='levsoi', &
- avgflag='A', long_name='soil mineral NH4 (vert. res.)', &
- ptr_col=data2dptr, default='inactive')
-
- data2dptr => this%sminn_vr_col(begc:endc,1:nlevsoi)
- call hist_addfld_decomp (fname='SMINN'//trim(vr_suffix), units='gN/m^3', type2d='levsoi', &
- avgflag='A', long_name='soil mineral N', &
- ptr_col=data2dptr, default='inactive')
-
- this%smin_no3_col(begc:endc) = spval
- call hist_addfld1d (fname='SMIN_NO3', units='gN/m^2', &
- avgflag='A', long_name='soil mineral NO3', &
- ptr_col=this%smin_no3_col, default='inactive')
-
- this%smin_nh4_col(begc:endc) = spval
- call hist_addfld1d (fname='SMIN_NH4', units='gN/m^2', &
- avgflag='A', long_name='soil mineral NH4', &
- ptr_col=this%smin_nh4_col, default='inactive')
- endif
- else
- if ( nlevdecomp_full > 1 ) then
- data2dptr => this%sminn_vr_col(begc:endc,1:nlevsoi)
- call hist_addfld_decomp (fname='SMINN'//trim(vr_suffix), units='gN/m^3', type2d='levsoi', &
- avgflag='A', long_name='soil mineral N', &
- ptr_col=data2dptr, default='inactive')
- end if
-
- end if
-
- this%totlitn_col(begc:endc) = spval
- call hist_addfld1d (fname='TOTLITN', units='gN/m^2', &
- avgflag='A', long_name='total litter N', &
- ptr_col=this%totlitn_col, default='inactive')
-
- this%totsomn_col(begc:endc) = spval
- call hist_addfld1d (fname='TOTSOMN', units='gN/m^2', &
- avgflag='A', long_name='total soil organic matter N', &
- ptr_col=this%totsomn_col, default='inactive')
-
- this%dyn_nbal_adjustments_col(begc:endc) = spval
- call hist_addfld1d (fname='DYN_COL_SOIL_ADJUSTMENTS_N', units='gN/m^2', &
- avgflag='SUM', &
- long_name='Adjustments in soil nitrogen due to dynamic column areas; &
- &only makes sense at the column level: should not be averaged to gridcell', &
- ptr_col=this%dyn_nbal_adjustments_col, default='inactive')
-
- if (use_nitrif_denitrif) then
- call hist_addfld1d (fname='DYN_COL_SOIL_ADJUSTMENTS_NO3', units='gN/m^2', &
- avgflag='SUM', &
- long_name='Adjustments in soil NO3 due to dynamic column areas; &
- &only makes sense at the column level: should not be averaged to gridcell', &
- ptr_col=this%dyn_no3bal_adjustments_col, default='inactive')
-
- call hist_addfld1d (fname='DYN_COL_SOIL_ADJUSTMENTS_NH4', units='gN/m^2', &
- avgflag='SUM', &
- long_name='Adjustments in soil NH4 due to dynamic column areas; &
- &only makes sense at the column level: should not be averaged to gridcell', &
- ptr_col=this%dyn_nh4bal_adjustments_col, default='inactive')
- end if
- end subroutine InitHistory
-
- !-----------------------------------------------------------------------
- subroutine InitCold(this, bounds, &
- decomp_cpools_vr_col, decomp_cpools_col, decomp_cpools_1m_col)
- !
- ! !DESCRIPTION:
- ! Initializes time varying variables used only in coupled carbon-nitrogen mode (CN):
- !
- ! !USES:
- use decompMod , only : bounds_type
- !
- ! !ARGUMENTS:
- class(soilbiogeochem_nitrogenstate_type) :: this
- type(bounds_type) , intent(in) :: bounds
- real(r8) , intent(in) :: decomp_cpools_vr_col(bounds%begc:,:,:)
- real(r8) , intent(in) :: decomp_cpools_col(bounds%begc:,:)
- real(r8) , intent(in) :: decomp_cpools_1m_col(bounds%begc:,:)
- !
- ! !LOCAL VARIABLES:
- integer :: fc,g,l,c,j,k ! indices
- integer :: num_special_col ! number of good values in special_col filter
- integer :: special_col (bounds%endc-bounds%begc+1) ! special landunit filter - columns
- !------------------------------------------------------------------------
-
- SHR_ASSERT_ALL((ubound(decomp_cpools_col) == (/bounds%endc,ndecomp_pools/)), errMsg(sourcefile, __LINE__))
- SHR_ASSERT_ALL((ubound(decomp_cpools_1m_col) == (/bounds%endc,ndecomp_pools/)), errMsg(sourcefile, __LINE__))
- SHR_ASSERT_ALL((ubound(decomp_cpools_vr_col) == (/bounds%endc,nlevdecomp_full,ndecomp_pools/)), errMsg(sourcefile, __LINE__))
-
- do c = bounds%begc, bounds%endc
- l = col%landunit(c)
- if (lun%itype(l) == istsoil .or. lun%itype(l) == istcrop) then
-
- ! column nitrogen state variables
- this%ntrunc_col(c) = 0._r8
- this%sminn_col(c) = 0._r8
- do j = 1, nlevdecomp
- do k = 1, ndecomp_pools
- this%decomp_npools_vr_col(c,j,k) = decomp_cpools_vr_col(c,j,k) / decomp_cascade_con%initial_cn_ratio(k)
- end do
- this%sminn_vr_col(c,j) = 0._r8
- this%ntrunc_vr_col(c,j) = 0._r8
- end do
- if ( nlevdecomp > 1 ) then
- do j = nlevdecomp+1, nlevdecomp_full
- do k = 1, ndecomp_pools
- this%decomp_npools_vr_col(c,j,k) = 0._r8
- end do
- this%sminn_vr_col(c,j) = 0._r8
- this%ntrunc_vr_col(c,j) = 0._r8
- end do
- end if
- do k = 1, ndecomp_pools
- this%decomp_npools_col(c,k) = decomp_cpools_col(c,k) / decomp_cascade_con%initial_cn_ratio(k)
- this%decomp_npools_1m_col(c,k) = decomp_cpools_1m_col(c,k) / decomp_cascade_con%initial_cn_ratio(k)
- end do
-
- if (use_nitrif_denitrif) then
- do j = 1, nlevdecomp_full
- this%smin_nh4_vr_col(c,j) = 0._r8
- this%smin_no3_vr_col(c,j) = 0._r8
- end do
- this%smin_nh4_col(c) = 0._r8
- this%smin_no3_col(c) = 0._r8
- end if
- this%totlitn_col(c) = 0._r8
- this%totsomn_col(c) = 0._r8
- this%totlitn_1m_col(c) = 0._r8
- this%totsomn_1m_col(c) = 0._r8
- this%cwdn_col(c) = 0._r8
-
- end if
- end do
-
- ! initialize fields for special filters
-
- num_special_col = 0
- do c = bounds%begc, bounds%endc
- l = col%landunit(c)
- if (lun%ifspecial(l)) then
- num_special_col = num_special_col + 1
- special_col(num_special_col) = c
- end if
- end do
-
- call this%SetValues (num_column=num_special_col, filter_column=special_col, value_column=0._r8)
-
- end subroutine InitCold
-
- !-----------------------------------------------------------------------
- subroutine Restart ( this, bounds, ncid, flag, totvegc_col )
- !
- ! !DESCRIPTION:
- ! Read/write CN restart data for nitrogen state
- !
- ! !USES:
- use shr_infnan_mod , only : isnan => shr_infnan_isnan, nan => shr_infnan_nan, assignment(=)
- use clm_time_manager , only : is_restart, get_nstep
- use restUtilMod
- use ncdio_pio
- !
- ! !ARGUMENTS:
- class (soilbiogeochem_nitrogenstate_type) :: this
- type(bounds_type) , intent(in) :: bounds
- type(file_desc_t) , intent(inout) :: ncid
- character(len=*) , intent(in) :: flag !'read' or 'write' or 'define'
- real(r8) , intent(in) :: totvegc_col(bounds%begc:bounds%endc) ! (gC/m2) total vegetation carbon
-
- !
- ! !LOCAL VARIABLES:
- integer :: i,j,k,l,c
- logical :: readvar
- integer :: idata
- logical :: exit_spinup = .false.
- logical :: enter_spinup = .false.
- real(r8) :: m ! multiplier for the exit_spinup code
- real(r8), pointer :: ptr2d(:,:) ! temp. pointers for slicing larger arrays
- real(r8), pointer :: ptr1d(:) ! temp. pointers for slicing larger arrays
- character(len=128) :: varname ! temporary
- integer :: itemp ! temporary
- integer , pointer :: iptemp(:) ! pointer to memory to be allocated
- ! spinup state as read from restart file, for determining whether to enter or exit spinup mode.
- integer :: restart_file_spinup_state
- ! flags for comparing the model and restart decomposition cascades
- integer :: decomp_cascade_state, restart_file_decomp_cascade_state
- !------------------------------------------------------------------------
-
- ! sminn
- if (use_vertsoilc) then
- ptr2d => this%sminn_vr_col
- call restartvar(ncid=ncid, flag=flag, varname="sminn_vr", xtype=ncd_double, &
- dim1name='column', dim2name='levgrnd', switchdim=.true., &
- long_name='', units='', fill_value=spval, &
- interpinic_flag='interp', readvar=readvar, data=ptr2d)
- else
- ptr1d => this%sminn_vr_col(:,1)
- call restartvar(ncid=ncid, flag=flag, varname="sminn", xtype=ncd_double, &
- dim1name='column', &
- long_name='', units='', fill_value=spval, &
- interpinic_flag='interp' , readvar=readvar, data=ptr1d)
- end if
- if (flag=='read' .and. .not. readvar) then
- call endrun(msg='ERROR::'//trim(varname)//' is required on an initialization dataset'//&
- errMsg(sourcefile, __LINE__))
- end if
-
- ! decomposing N pools
- do k = 1, ndecomp_pools
- varname=trim(decomp_cascade_con%decomp_pool_name_restart(k))//'n'
- if (use_vertsoilc) then
- ptr2d => this%decomp_npools_vr_col(:,:,k)
- call restartvar(ncid=ncid, flag=flag, varname=trim(varname)//"_vr", xtype=ncd_double, &
- dim1name='column', dim2name='levgrnd', switchdim=.true., &
- long_name='', units='', &
- interpinic_flag='interp', readvar=readvar, data=ptr2d)
- else
- ptr1d => this%decomp_npools_vr_col(:,1,k)
- call restartvar(ncid=ncid, flag=flag, varname=varname, xtype=ncd_double, &
- dim1name='column', &
- long_name='', units='', fill_value=spval, &
- interpinic_flag='interp' , readvar=readvar, data=ptr1d)
- end if
- if (flag=='read' .and. .not. readvar) then
- call endrun(msg='ERROR:: '//trim(varname)//' is required on an initialization dataset'//&
- errMsg(sourcefile, __LINE__))
- end if
- end do
-
- if (use_vertsoilc) then
- ptr2d => this%ntrunc_vr_col
- call restartvar(ncid=ncid, flag=flag, varname="col_ntrunc_vr", xtype=ncd_double, &
- dim1name='column', dim2name='levgrnd', switchdim=.true., &
- long_name='', units='', fill_value=spval, &
- interpinic_flag='interp', readvar=readvar, data=ptr2d)
- else
- ptr1d => this%ntrunc_vr_col(:,1)
- call restartvar(ncid=ncid, flag=flag, varname="col_ntrunc", xtype=ncd_double, &
- dim1name='column', &
- long_name='', units='', fill_value=spval, &
- interpinic_flag='interp' , readvar=readvar, data=ptr1d)
- end if
-
- if (use_nitrif_denitrif) then
- ! smin_no3_vr
- if (use_vertsoilc) then
- ptr2d => this%smin_no3_vr_col(:,:)
- call restartvar(ncid=ncid, flag=flag, varname='smin_no3_vr', xtype=ncd_double, &
- dim1name='column', dim2name='levgrnd', switchdim=.true., &
- long_name='', units='', &
- interpinic_flag='interp', readvar=readvar, data=ptr2d)
- else
- ptr1d => this%smin_no3_vr_col(:,1)
- call restartvar(ncid=ncid, flag=flag, varname='smin_no3', xtype=ncd_double, &
- dim1name='column', &
- long_name='', units='', &
- interpinic_flag='interp', readvar=readvar, data=ptr1d)
- end if
- if (flag=='read' .and. .not. readvar) then
- call endrun(msg= 'ERROR:: smin_no3_vr'//' is required on an initialization dataset' )
- end if
- end if
-
- if (use_nitrif_denitrif) then
- ! smin_nh4
- if (use_vertsoilc) then
- ptr2d => this%smin_nh4_vr_col(:,:)
- call restartvar(ncid=ncid, flag=flag, varname='smin_nh4_vr', xtype=ncd_double, &
- dim1name='column', dim2name='levgrnd', switchdim=.true., &
- long_name='', units='', &
- interpinic_flag='interp', readvar=readvar, data=ptr2d)
- else
- ptr1d => this%smin_nh4_vr_col(:,1)
- call restartvar(ncid=ncid, flag=flag, varname='smin_nh4', xtype=ncd_double, &
- dim1name='column', &
- long_name='', units='', &
- interpinic_flag='interp', readvar=readvar, data=ptr1d)
- end if
- if (flag=='read' .and. .not. readvar) then
- call endrun(msg= 'ERROR:: smin_nh4_vr'//' is required on an initialization dataset' )
- end if
- end if
-
- ! decomp_cascade_state - the purpose of this is to check to make sure the bgc used
- ! matches what the restart file was generated with.
- ! add info about the SOM decomposition cascade
-
- if (use_century_decomp) then
- decomp_cascade_state = 1
- else
- decomp_cascade_state = 0
- end if
- ! add info about the nitrification / denitrification state
- if (use_nitrif_denitrif) then
- decomp_cascade_state = decomp_cascade_state + 10
- end if
- if (flag == 'write') itemp = decomp_cascade_state
- call restartvar(ncid=ncid, flag=flag, varname='decomp_cascade_state', xtype=ncd_int, &
- long_name='BGC of the model that wrote this restart file:' &
- // ' 1s column: 0 = CLM-CN cascade, 1 = Century cascade;' &
- // ' 10s column: 0 = CLM-CN denitrification, 10 = Century denitrification', units='', &
- interpinic_flag='skip', readvar=readvar, data=itemp)
- if (flag=='read') then
- if (.not. readvar) then
- ! assume, for sake of backwards compatibility, that if decomp_cascade_state
- ! is not in the restart file, then the current model state is the same as
- ! the prior model state
- restart_file_decomp_cascade_state = decomp_cascade_state
- if ( masterproc ) write(iulog,*) ' CNRest: WARNING! Restart file does not ' &
- // ' contain info on decomp_cascade_state used to generate the restart file. '
- if ( masterproc ) write(iulog,*) ' Assuming the same as current setting: ', decomp_cascade_state
- else
- restart_file_decomp_cascade_state = itemp
- if (decomp_cascade_state /= restart_file_decomp_cascade_state ) then
- if ( masterproc ) then
- write(iulog,*) 'CNRest: ERROR--the decomposition cascade differs between the current ' &
- // ' model state and the model that wrote the restart file. '
- write(iulog,*) 'The model will be horribly out of equilibrium until after a lengthy spinup. '
- write(iulog,*) 'Stopping here since this is probably an error in configuring the run. '
- write(iulog,*) 'If you really wish to proceed, then override by setting '
- write(iulog,*) 'override_bgc_restart_mismatch_dump to .true. in the namelist'
- if ( .not. override_bgc_restart_mismatch_dump ) then
- call endrun(msg= ' CNRest: Stopping. Decomposition cascade mismatch error.'//&
- errMsg(sourcefile, __LINE__))
- endif
- endif
- endif
- end if
- end if
-
- !--------------------------------
- ! Spinup state
- !--------------------------------
-
- ! Do nothing for write
- ! Note that the call to write spinup_state out was done in soilbiogeochem_carbonstate_inst and
- ! cannot be called again because it will try to define the variable twice
- ! when the flag below is set to define
- if (flag == 'read') then
- call restartvar(ncid=ncid, flag=flag, varname='spinup_state', xtype=ncd_int, &
- long_name='Spinup state of the model that wrote this restart file: ' &
- // ' 0 = normal model mode, 1 = AD spinup', units='', &
- interpinic_flag='copy', readvar=readvar, data=idata)
- if (readvar) then
- restart_file_spinup_state = idata
- else
- ! assume, for sake of backwards compatibility, that if spinup_state is not in
- ! the restart file then current model state is the same as prior model state
- restart_file_spinup_state = spinup_state
- if ( masterproc ) then
- write(iulog,*) ' WARNING! Restart file does not contain info ' &
- // ' on spinup state used to generate the restart file. '
- write(iulog,*) ' Assuming the same as current setting: ', spinup_state
- end if
- end if
- end if
-
- ! now compare the model and restart file spinup states, and either take the
- ! model into spinup mode or out of it if they are not identical
- ! taking model out of spinup mode requires multiplying each decomposing pool
- ! by the associated AD factor.
- ! putting model into spinup mode requires dividing each decomposing pool
- ! by the associated AD factor.
- ! only allow this to occur on first timestep of model run.
-
- if (flag == 'read' .and. spinup_state /= restart_file_spinup_state ) then
- if (spinup_state == 0 .and. restart_file_spinup_state >= 1 ) then
- if ( masterproc ) write(iulog,*) ' NitrogenStateType Restart: taking SOM pools out of AD spinup mode'
- exit_spinup = .true.
- else if (spinup_state >= 1 .and. restart_file_spinup_state == 0 ) then
- if ( masterproc ) write(iulog,*) ' NitrogenStateType Restart: taking SOM pools into AD spinup mode'
- enter_spinup = .true.
- else
- call endrun(msg=' Error in entering/exiting spinup. spinup_state ' &
- // ' != restart_file_spinup_state, but do not know what to do'//&
- errMsg(sourcefile, __LINE__))
- end if
- if (get_nstep() >= 2) then
- call endrun(msg=' Error in entering/exiting spinup - should occur only when nstep = 1'//&
- errMsg(sourcefile, __LINE__))
- endif
- if ( exit_spinup .and. isnan(this%totvegcthresh) )then
- call endrun(msg=' Error in exit spinup - totvegcthresh was not set with SetTotVgCThresh'//&
- errMsg(sourcefile, __LINE__))
- end if
- do k = 1, ndecomp_pools
- if ( exit_spinup ) then
- m = decomp_cascade_con%spinup_factor(k)
- else if ( enter_spinup ) then
- m = 1. / decomp_cascade_con%spinup_factor(k)
- end if
- do c = bounds%begc, bounds%endc
- l = col%landunit(c)
- do j = 1, nlevdecomp
- if ( abs(m - 1._r8) .gt. 0.000001_r8 .and. exit_spinup) then
- this%decomp_npools_vr_col(c,j,k) = this%decomp_npools_vr_col(c,j,k) * m * &
- get_spinup_latitude_term(grc%latdeg(col%gridcell(c)))
- ! If there is no vegetation nitrogen,
- ! implying that all vegetation has
- ! died, then
- ! reset decomp pools to near zero during exit_spinup to
- ! avoid very
- ! large and inert soil carbon stocks; note that only
- ! pools with spinup factor > 1
- ! will be affected, which means that total SOMN and LITN
- ! pools will not be set to 0.
- if (totvegc_col(c) <= this%totvegcthresh .and. lun%itype(l) /= istcrop) then
- this%decomp_npools_vr_col(c,j,k) = 0._r8
- endif
- elseif ( abs(m - 1._r8) .gt. 0.000001_r8 .and. enter_spinup) then
- this%decomp_npools_vr_col(c,j,k) = this%decomp_npools_vr_col(c,j,k) * m / &
- get_spinup_latitude_term(grc%latdeg(col%gridcell(c)))
- else
- this%decomp_npools_vr_col(c,j,k) = this%decomp_npools_vr_col(c,j,k) * m
- endif
- end do
- end do
- end do
- end if
-
- end subroutine Restart
-
- !-----------------------------------------------------------------------
- subroutine SetValues ( this, num_column, filter_column, value_column )
- !
- ! !DESCRIPTION:
- ! Set nitrogen state variables
- !
- ! !ARGUMENTS:
- class (soilbiogeochem_nitrogenstate_type) :: this
- integer , intent(in) :: num_column
- integer , intent(in) :: filter_column(:)
- real(r8), intent(in) :: value_column
- !
- ! !LOCAL VARIABLES:
- integer :: fi,i ! loop index
- integer :: j,k ! indices
- !------------------------------------------------------------------------
-
- do fi = 1,num_column
- i = filter_column(fi)
-
- this%sminn_col(i) = value_column
- this%ntrunc_col(i) = value_column
- this%cwdn_col(i) = value_column
- if (use_nitrif_denitrif) then
- this%smin_no3_col(i) = value_column
- this%smin_nh4_col(i) = value_column
- end if
- this%totlitn_col(i) = value_column
- this%totsomn_col(i) = value_column
- this%totsomn_1m_col(i) = value_column
- this%totlitn_1m_col(i) = value_column
- end do
-
- do j = 1,nlevdecomp_full
- do fi = 1,num_column
- i = filter_column(fi)
- this%sminn_vr_col(i,j) = value_column
- this%ntrunc_vr_col(i,j) = value_column
- if (use_nitrif_denitrif) then
- this%smin_no3_vr_col(i,j) = value_column
- this%smin_nh4_vr_col(i,j) = value_column
- end if
- end do
- end do
-
- ! column and decomp_pools
- do k = 1, ndecomp_pools
- do fi = 1,num_column
- i = filter_column(fi)
- this%decomp_npools_col(i,k) = value_column
- this%decomp_npools_1m_col(i,k) = value_column
- end do
- end do
-
- ! column levdecomp, and decomp_pools
- do j = 1,nlevdecomp_full
- do k = 1, ndecomp_pools
- do fi = 1,num_column
- i = filter_column(fi)
- this%decomp_npools_vr_col(i,j,k) = value_column
- end do
- end do
- end do
-
- end subroutine SetValues
-
-end module SoilBiogeochemNitrogenStateType
diff --git a/src/soilbiogeochem/SoilBiogeochemPotentialMod.F90 b/src/soilbiogeochem/SoilBiogeochemPotentialMod.F90
deleted file mode 100644
index 2349a63f..00000000
--- a/src/soilbiogeochem/SoilBiogeochemPotentialMod.F90
+++ /dev/null
@@ -1,266 +0,0 @@
-module SoilBiogeochemPotentialMod
-
-#include "shr_assert.h"
-
- !-----------------------------------------------------------------------
- ! !DESCRIPTION:
- ! Calculate potential decomp rates and total immobilization demand.
- !
- ! !USES:
- use shr_kind_mod , only : r8 => shr_kind_r8
- use decompMod , only : bounds_type
- use clm_varpar , only : nlevdecomp, ndecomp_cascade_transitions, ndecomp_pools
- use SoilBiogeochemDecompCascadeConType , only : decomp_cascade_con
- use SoilBiogeochemStateType , only : soilbiogeochem_state_type
- use SoilBiogeochemCarbonStateType , only : soilbiogeochem_carbonstate_type
- use SoilBiogeochemCarbonFluxType , only : soilbiogeochem_carbonflux_type
- use SoilBiogeochemNitrogenStateType , only : soilbiogeochem_nitrogenstate_type
- use SoilBiogeochemNitrogenFluxType , only : soilbiogeochem_nitrogenflux_type
- use clm_varctl , only : use_fates, iulog
- !
- implicit none
- private
- !
- ! !PUBLIC MEMBER FUNCTIONS:
- public :: readParams
- public :: SoilBiogeochemPotential
- !
- type, private :: params_type
- real(r8) :: dnp !denitrification proportion
- end type Params_type
- !
- type(params_type), private :: params_inst
-
- character(len=*), parameter, private :: sourcefile = &
- __FILE__
- !-----------------------------------------------------------------------
-
-contains
-
- !-----------------------------------------------------------------------
- subroutine readParams ( ncid )
- !
- ! !DESCRIPTION:
- ! Read parameters
- !
- ! !USES:
- use ncdio_pio , only: file_desc_t,ncd_io
- use abortutils , only: endrun
- use shr_log_mod , only: errMsg => shr_log_errMsg
- !
- ! !ARGUMENTS:
- type(file_desc_t),intent(inout) :: ncid ! pio netCDF file id
- !
- ! !LOCAL VARIABLES:
- character(len=32) :: subname = 'CNDecompParamsType'
- 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='dnp'
- call ncd_io(trim(tString),tempr, 'read', ncid, readvar=readv)
- if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__))
- params_inst%dnp=tempr
-
- end subroutine readParams
-
- !-----------------------------------------------------------------------
- subroutine SoilBiogeochemPotential (bounds, num_soilc, filter_soilc, &
- soilbiogeochem_state_inst, soilbiogeochem_carbonstate_inst, soilbiogeochem_carbonflux_inst, &
- soilbiogeochem_nitrogenstate_inst, soilbiogeochem_nitrogenflux_inst, &
- cn_decomp_pools, p_decomp_cpool_loss, pmnf_decomp_cascade)
- !
- ! !USES:
- use shr_log_mod, only : errMsg => shr_log_errMsg
- !
- ! !ARGUMENT:
- 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
- type(soilbiogeochem_state_type) , intent(inout) :: soilbiogeochem_state_inst
- type(soilbiogeochem_carbonstate_type) , intent(in) :: soilbiogeochem_carbonstate_inst
- type(soilbiogeochem_carbonflux_type) , intent(inout) :: soilbiogeochem_carbonflux_inst
- type(soilbiogeochem_nitrogenstate_type) , intent(inout) :: soilbiogeochem_nitrogenstate_inst
- type(soilbiogeochem_nitrogenflux_type) , intent(inout) :: soilbiogeochem_nitrogenflux_inst
- real(r8) , intent(out) :: cn_decomp_pools(bounds%begc:,1:,1:) ! c:n ratios of applicable pools
- real(r8) , intent(out) :: p_decomp_cpool_loss(bounds%begc:,1:,1:) ! potential C loss from one pool to another
- real(r8) , intent(out) :: pmnf_decomp_cascade(bounds%begc:,1:,1:) ! potential mineral N flux, from one pool to another
- !
- ! !LOCAL VARIABLES:
- integer :: c,j,k,l,m !indices
- integer :: fc !filter column index
- integer :: begc,endc !bounds
- real(r8):: immob(bounds%begc:bounds%endc,1:nlevdecomp) !potential N immobilization
- real(r8):: ratio !temporary variable
- integer, parameter :: i_atm = 0 !TODO - this appears in two places - move it to 1
- !-----------------------------------------------------------------------
-
- begc = bounds%begc; endc = bounds%endc
-
- SHR_ASSERT_ALL((ubound(cn_decomp_pools) == (/endc,nlevdecomp,ndecomp_pools/)) , errMsg(sourcefile, __LINE__))
- SHR_ASSERT_ALL((ubound(p_decomp_cpool_loss) == (/endc,nlevdecomp,ndecomp_cascade_transitions/)) , errMsg(sourcefile, __LINE__))
- SHR_ASSERT_ALL((ubound(pmnf_decomp_cascade) == (/endc,nlevdecomp,ndecomp_cascade_transitions/)) , errMsg(sourcefile, __LINE__))
-
- associate( &
- 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
- floating_cn_ratio_decomp_pools => decomp_cascade_con%floating_cn_ratio_decomp_pools , & ! Input: [logical (:) ] TRUE => pool has fixed C:N ratio
- initial_cn_ratio => decomp_cascade_con%initial_cn_ratio , & ! Input: [real(r8) (:) ] c:n ratio for initialization of pools
-
- fpi_vr => soilbiogeochem_state_inst%fpi_vr_col , & ! Input: [real(r8) (:,:) ] fraction of potential immobilization (no units)
- rf_decomp_cascade => soilbiogeochem_state_inst%rf_decomp_cascade_col , & ! Input: [real(r8) (:,:,:) ] respired fraction in decomposition step (frac)
- pathfrac_decomp_cascade => soilbiogeochem_state_inst%pathfrac_decomp_cascade_col , & ! Input: [real(r8) (:,:,:) ] what fraction of C leaving a given pool passes through a given transition (frac)
-
- decomp_npools_vr => soilbiogeochem_nitrogenstate_inst%decomp_npools_vr_col , & ! Input: [real(r8) (:,:,:) ] (gC/m3) vertically-resolved decomposing (litter, cwd, soil) N pools
-
- decomp_cpools_vr => soilbiogeochem_carbonstate_inst%decomp_cpools_vr_col , & ! Input: [real(r8) (:,:,:) ] (gC/m3) vertically-resolved decomposing (litter, cwd, soil) c pools
-
- decomp_cascade_ntransfer_vr => soilbiogeochem_nitrogenflux_inst%decomp_cascade_ntransfer_vr_col , & ! Output: [real(r8) (:,:,:) ] vert-res transfer of N from donor to receiver pool along decomp. cascade (gN/m3/s)
- decomp_cascade_sminn_flux_vr => soilbiogeochem_nitrogenflux_inst%decomp_cascade_sminn_flux_vr_col , & ! Output: [real(r8) (:,:,:) ] vert-res mineral N flux for transition along decomposition cascade (gN/m3/s)
- potential_immob_vr => soilbiogeochem_nitrogenflux_inst%potential_immob_vr_col , & ! Output: [real(r8) (:,:) ]
- sminn_to_denit_decomp_cascade_vr => soilbiogeochem_nitrogenflux_inst%sminn_to_denit_decomp_cascade_vr_col , & ! Output: [real(r8) (:,:,:) ]
- gross_nmin_vr => soilbiogeochem_nitrogenflux_inst%gross_nmin_vr_col , & ! Output: [real(r8) (:,:) ]
- net_nmin_vr => soilbiogeochem_nitrogenflux_inst%net_nmin_vr_col , & ! Output: [real(r8) (:,:) ]
- gross_nmin => soilbiogeochem_nitrogenflux_inst%gross_nmin_col , & ! Output: [real(r8) (:) ] gross rate of N mineralization (gN/m2/s)
- net_nmin => soilbiogeochem_nitrogenflux_inst%net_nmin_col , & ! Output: [real(r8) (:) ] net rate of N mineralization (gN/m2/s)
-
- w_scalar => soilbiogeochem_carbonflux_inst%w_scalar_col , & ! Input: [real(r8) (:,:) ] fraction by which decomposition is limited by moisture availability
- decomp_cascade_hr_vr => soilbiogeochem_carbonflux_inst%decomp_cascade_hr_vr_col , & ! Output: [real(r8) (:,:,:) ] vertically-resolved het. resp. from decomposing C pools (gC/m3/s)
- decomp_cascade_ctransfer_vr => soilbiogeochem_carbonflux_inst%decomp_cascade_ctransfer_vr_col , & ! Output: [real(r8) (:,:,:) ] vertically-resolved het. resp. from decomposing C pools (gC/m3/s)
- decomp_k => soilbiogeochem_carbonflux_inst%decomp_k_col , & ! Output: [real(r8) (:,:,:) ] rate constant for decomposition (1./sec)
- phr_vr => soilbiogeochem_carbonflux_inst%phr_vr_col , & ! Output: [real(r8) (:,:) ] potential HR (gC/m3/s)
- fphr => soilbiogeochem_carbonflux_inst%fphr_col & ! Output: [real(r8) (:,:) ] fraction of potential SOM + LITTER heterotrophic
- )
-
- if ( .not. use_fates ) then
- ! set initial values for potential C and N fluxes
- p_decomp_cpool_loss(begc:endc, :, :) = 0._r8
- pmnf_decomp_cascade(begc:endc, :, :) = 0._r8
-
- ! column loop to calculate potential decomp rates and total immobilization demand
-
- !! calculate c:n ratios of applicable pools
- do l = 1, ndecomp_pools
- if ( floating_cn_ratio_decomp_pools(l) ) then
- do j = 1,nlevdecomp
- do fc = 1,num_soilc
- c = filter_soilc(fc)
- if ( decomp_npools_vr(c,j,l) > 0._r8 ) then
- cn_decomp_pools(c,j,l) = decomp_cpools_vr(c,j,l) / decomp_npools_vr(c,j,l)
- end if
- end do
- end do
- else
- do j = 1,nlevdecomp
- do fc = 1,num_soilc
- c = filter_soilc(fc)
- cn_decomp_pools(c,j,l) = initial_cn_ratio(l)
- end do
- end do
- end if
- end do
-
- ! calculate the non-nitrogen-limited fluxes
- ! these fluxes include the "/ dt" term to put them on a
- ! per second basis, since the rate constants have been
- ! calculated on a per timestep basis.
-
- do k = 1, ndecomp_cascade_transitions
- do j = 1,nlevdecomp
- do fc = 1,num_soilc
- c = filter_soilc(fc)
-
- if (decomp_cpools_vr(c,j,cascade_donor_pool(k)) > 0._r8 .and. &
- decomp_k(c,j,cascade_donor_pool(k)) > 0._r8 ) then
- p_decomp_cpool_loss(c,j,k) = decomp_cpools_vr(c,j,cascade_donor_pool(k)) &
- * decomp_k(c,j,cascade_donor_pool(k)) * pathfrac_decomp_cascade(c,j,k)
- if ( .not. floating_cn_ratio_decomp_pools(cascade_receiver_pool(k)) ) then !! not transition of cwd to litter
-
- if (cascade_receiver_pool(k) /= i_atm ) then ! not 100% respiration
- ratio = 0._r8
-
- if (decomp_npools_vr(c,j,cascade_donor_pool(k)) > 0._r8) then
- ratio = cn_decomp_pools(c,j,cascade_receiver_pool(k))/cn_decomp_pools(c,j,cascade_donor_pool(k))
- endif
-
- pmnf_decomp_cascade(c,j,k) = (p_decomp_cpool_loss(c,j,k) * (1.0_r8 - rf_decomp_cascade(c,j,k) - ratio) &
- / cn_decomp_pools(c,j,cascade_receiver_pool(k)) )
-
- else ! 100% respiration
- pmnf_decomp_cascade(c,j,k) = - p_decomp_cpool_loss(c,j,k) / cn_decomp_pools(c,j,cascade_donor_pool(k))
- endif
-
- else ! CWD -> litter
- pmnf_decomp_cascade(c,j,k) = 0._r8
- end if
- end if
- end do
-
- end do
- end do
-
- ! Sum up all the potential immobilization fluxes (positive pmnf flux)
- ! and all the mineralization fluxes (negative pmnf flux)
- do j = 1,nlevdecomp
- do fc = 1,num_soilc
- c = filter_soilc(fc)
- immob(c,j) = 0._r8
- end do
- end do
- do k = 1, ndecomp_cascade_transitions
- do j = 1,nlevdecomp
- do fc = 1,num_soilc
- c = filter_soilc(fc)
- if (pmnf_decomp_cascade(c,j,k) > 0._r8) then
- immob(c,j) = immob(c,j) + pmnf_decomp_cascade(c,j,k)
- else
- gross_nmin_vr(c,j) = gross_nmin_vr(c,j) - pmnf_decomp_cascade(c,j,k)
- end if
- end do
- end do
- end do
-
- do j = 1,nlevdecomp
- do fc = 1,num_soilc
- c = filter_soilc(fc)
- potential_immob_vr(c,j) = immob(c,j)
- end do
- end do
- else ! use_fates
- ! As a first step we are making this a C-only model, so no N downregulation of fluxes.
- do k = 1, ndecomp_cascade_transitions
- do j = 1,nlevdecomp
- do fc = 1,num_soilc
- c = filter_soilc(fc)
- !
- p_decomp_cpool_loss(c,j,k) = decomp_cpools_vr(c,j,cascade_donor_pool(k)) &
- * decomp_k(c,j,cascade_donor_pool(k)) * pathfrac_decomp_cascade(c,j,k)
- !
- end do
- end do
- end do
- end if
-
- ! Add up potential hr for methane calculations
- do j = 1,nlevdecomp
- do fc = 1,num_soilc
- c = filter_soilc(fc)
- phr_vr(c,j) = 0._r8
- end do
- end do
- do k = 1, ndecomp_cascade_transitions
- do j = 1,nlevdecomp
- do fc = 1,num_soilc
- c = filter_soilc(fc)
- phr_vr(c,j) = phr_vr(c,j) + rf_decomp_cascade(c,j,k) * p_decomp_cpool_loss(c,j,k)
- end do
- end do
- end do
-
- end associate
-
- end subroutine SoilBiogeochemPotential
-
-end module SoilBiogeochemPotentialMod
diff --git a/src/soilbiogeochem/SoilBiogeochemPrecisionControlMod.F90 b/src/soilbiogeochem/SoilBiogeochemPrecisionControlMod.F90
deleted file mode 100644
index c50bbd49..00000000
--- a/src/soilbiogeochem/SoilBiogeochemPrecisionControlMod.F90
+++ /dev/null
@@ -1,173 +0,0 @@
-module SoilBiogeochemPrecisionControlMod
-
- !-----------------------------------------------------------------------
- ! !DESCRIPTION:
- ! controls on very low values in critical state variables
- !
- ! !USES:
- use shr_kind_mod , only : r8 => shr_kind_r8
- use clm_varpar , only : ndecomp_pools
- use SoilBiogeochemCarbonStateType , only : soilbiogeochem_carbonstate_type
- use SoilBiogeochemNitrogenStateType , only : soilbiogeochem_nitrogenstate_type
- use ColumnType , only : col
- !
- implicit none
- private
- !
- ! !PUBLIC MEMBER FUNCTIONS:
- public:: SoilBiogeochemPrecisionControlInit ! Initialization
- public:: SoilBiogeochemPrecisionControl ! Apply precision control to soil biogeochemistry carbon and nitrogen states
-
- ! !PUBLIC DATA:
- real(r8), public :: ccrit ! critical carbon state value for truncation (gC/m2)
- real(r8), public :: ncrit ! critical nitrogen state value for truncation (gN/m2)
- !-----------------------------------------------------------------------
-
-contains
-
- !-----------------------------------------------------------------------
- subroutine SoilBiogeochemPrecisionControlInit( soilbiogeochem_carbonstate_inst, c13_soilbiogeochem_carbonstate_inst, &
- c14_soilbiogeochem_carbonstate_inst, soilbiogeochem_nitrogenstate_inst)
-
- !
- ! !DESCRIPTION:
- ! Initialization of soil biogeochemistry precision control
- !
- ! !USES:
- !
- ! !ARGUMENTS:
- type(soilbiogeochem_carbonstate_type) , intent(inout) :: soilbiogeochem_carbonstate_inst
- type(soilbiogeochem_carbonstate_type) , intent(inout) :: c13_soilbiogeochem_carbonstate_inst
- type(soilbiogeochem_carbonstate_type) , intent(inout) :: c14_soilbiogeochem_carbonstate_inst
- type(soilbiogeochem_nitrogenstate_type) , intent(inout) :: soilbiogeochem_nitrogenstate_inst
- !
- ! !LOCAL VARIABLES:
- real(r8), parameter :: totvegcthresh = 0.1_r8 ! Total vegetation carbon threshold to zero out decomposition pools
- !-----------------------------------------------------------------------
- ccrit = 1.e-8_r8 ! critical carbon state value for truncation (gC/m2)
- ncrit = 1.e-8_r8 ! critical nitrogen state value for truncation (gN/m2)
-
- !call soilbiogeochem_carbonstate_inst%setTotVgCThresh( totvegcthresh )
- !call soilbiogeochem_nitrogenstate_inst%setTotVgCThresh( totvegcthresh )
-
- end subroutine SoilBiogeochemPrecisionControlInit
-
- !-----------------------------------------------------------------------
- subroutine SoilBiogeochemPrecisionControl(num_soilc, filter_soilc, &
- soilbiogeochem_carbonstate_inst, c13_soilbiogeochem_carbonstate_inst, &
- c14_soilbiogeochem_carbonstate_inst, soilbiogeochem_nitrogenstate_inst)
-
- !
- ! !DESCRIPTION:
- ! On the radiation time step, force leaf and deadstem c and n to 0 if
- ! they get too small.
- !
- ! !USES:
- use clm_varctl , only : iulog, use_nitrif_denitrif, use_cn
- use clm_varpar , only : nlevdecomp
- use CNSharedParamsMod, only: use_fun
- !
- ! !ARGUMENTS:
- integer , intent(in) :: num_soilc ! number of soil columns in filter
- integer , intent(in) :: filter_soilc(:) ! filter for soil columns
- type(soilbiogeochem_carbonstate_type) , intent(inout) :: soilbiogeochem_carbonstate_inst
- type(soilbiogeochem_carbonstate_type) , intent(inout) :: c13_soilbiogeochem_carbonstate_inst
- type(soilbiogeochem_carbonstate_type) , intent(inout) :: c14_soilbiogeochem_carbonstate_inst
- type(soilbiogeochem_nitrogenstate_type) , intent(inout) :: soilbiogeochem_nitrogenstate_inst
- !
- ! !LOCAL VARIABLES:
- integer :: c,j,k ! indices
- integer :: fc ! filter indices
- real(r8):: cc,cn ! truncation terms for column-level corrections
- real(r8):: cc13 ! truncation terms for column-level corrections
- real(r8):: cc14 ! truncation terms for column-level corrections
- !-----------------------------------------------------------------------
-
- ! soilbiogeochem_carbonstate_inst%ctrunc_vr_col Output: [real(r8) (:,:) ] (gC/m3) column-level sink for C truncation
- ! soilbiogeochem_carbonstate_inst%decomp_cpools_vr_col Output: [real(r8) (:,:,:) ] (gC/m3) vertically-resolved decomposing (litter, cwd, soil) c pools
-
- ! soilbiogeochem_nitrogenstate_inst%ntrunc_vr_col Output: [real(r8) (:,:) ] (gN/m3) column-level sink for N truncation
- ! soilbiogeochem_nitrogenstate_inst%decomp_npools_vr_col Output: [real(r8) (:,:,:) ] (gC/m3) vertically-resolved decomposing (litter, cwd, soil) N pools
- ! soilbiogeochem_nitrogenstate_inst%smin_nh4_vr_col Output: [real(r8) (:,:) ] (gN/m3) soil mineral NH4
- ! soilbiogeochem_nitrogenstate_inst%smin_no3_vr_col Output: [real(r8) (:,:) ] (gN/m3) soil mineral NO3
-
- associate(&
- cs => soilbiogeochem_carbonstate_inst , &
- ns => soilbiogeochem_nitrogenstate_inst , &
- c13cs => c13_soilbiogeochem_carbonstate_inst , &
- c14cs => c14_soilbiogeochem_carbonstate_inst &
- )
-
- ! column loop
- do fc = 1,num_soilc
- c = filter_soilc(fc)
-
- do j = 1,nlevdecomp
- ! initialize the column-level C and N truncation terms
- cc = 0._r8
- cn = 0._r8
-
- ! do tests on state variables for precision control
- ! for linked C-N state variables, perform precision test on
- ! the C component, but truncate both C and N components
-
-
- ! all decomposing pools C and N
- do k = 1, ndecomp_pools
-
- if (abs(cs%decomp_cpools_vr_col(c,j,k)) < ccrit) then
- cc = cc + cs%decomp_cpools_vr_col(c,j,k)
- cs%decomp_cpools_vr_col(c,j,k) = 0._r8
-
- if (use_cn) then
- cn = cn + ns%decomp_npools_vr_col(c,j,k)
- ns%decomp_npools_vr_col(c,j,k) = 0._r8
- endif
-
- end if
-
- end do
-
- ! not doing precision control on soil mineral N, since it will
- ! be getting the N truncation flux anyway.
-
- cs%ctrunc_vr_col(c,j) = cs%ctrunc_vr_col(c,j) + cc
-
- if (use_cn) then
- ns%ntrunc_vr_col(c,j) = ns%ntrunc_vr_col(c,j) + cn
- endif
- end do
-
- end do ! end of column loop
-
- if(.not.use_fun)then
- if (use_nitrif_denitrif) then
- ! remove small negative perturbations for stability purposes, if any should arise.
-
- do fc = 1,num_soilc
- c = filter_soilc(fc)
- do j = 1,nlevdecomp
- if (abs(ns%smin_no3_vr_col(c,j)) < ncrit/1e4_r8) then
- if ( ns%smin_no3_vr_col(c,j) < 0._r8 ) then
- !write(iulog, *) '-10^-12 < smin_no3 < 0. resetting to zero.'
- !write(iulog, *) 'smin_no3_vr_col(c,j), c, j: ', ns%smin_no3_vr_col(c,j), c, j
- ns%smin_no3_vr_col(c,j) = 0._r8
- endif
- end if
- if (abs(ns%smin_nh4_vr_col(c,j)) < ncrit/1e4_r8) then
- if ( ns%smin_nh4_vr_col(c,j) < 0._r8 ) then
- !write(iulog, *) '-10^-12 < smin_nh4 < 0. resetting to zero.'
- !write(iulog, *) 'smin_nh4_vr_col(c,j), c, j: ', ns%smin_nh4_vr_col(c,j), c, j
- ns%smin_nh4_vr_col(c,j) = 0._r8
- endif
- end if
- end do
- end do
- endif
- endif
-
- end associate
-
- end subroutine SoilBiogeochemPrecisionControl
-
-end module SoilBiogeochemPrecisionControlMod
diff --git a/src/soilbiogeochem/SoilBiogeochemStateType.F90 b/src/soilbiogeochem/SoilBiogeochemStateType.F90
deleted file mode 100644
index 46586ef3..00000000
--- a/src/soilbiogeochem/SoilBiogeochemStateType.F90
+++ /dev/null
@@ -1,336 +0,0 @@
-module SoilBiogeochemStateType
-
- use shr_kind_mod , only : r8 => shr_kind_r8
- use shr_log_mod , only : errMsg => shr_log_errMsg
- use shr_infnan_mod , only : nan => shr_infnan_nan, assignment(=)
- use decompMod , only : bounds_type
- use abortutils , only : endrun
- use spmdMod , only : masterproc
- use clm_varpar , only : nlevsno, nlevgrnd, nlevlak, nlevsoifl, nlevsoi
- use clm_varpar , only : ndecomp_cascade_transitions, nlevdecomp, nlevdecomp_full
- use clm_varcon , only : spval, ispval, c14ratio, grlnd
- use landunit_varcon, only : istsoil, istcrop
- use clm_varpar , only : nlevsno, nlevgrnd, nlevlak
- use clm_varctl , only : use_vertsoilc, use_cn
- use clm_varctl , only : iulog
- use LandunitType , only : lun
- use ColumnType , only : col
- !
- ! !PUBLIC TYPES:
- implicit none
- private
- !
- ! !PUBLIC MEMBER FUNCTIONS:
- public :: get_spinup_latitude_term
- !
- ! !PUBLIC TYPES:
- type, public :: soilbiogeochem_state_type
-
- real(r8) , pointer :: leaf_prof_patch (:,:) ! (1/m) profile of leaves (vertical profiles for calculating fluxes)
- real(r8) , pointer :: froot_prof_patch (:,:) ! (1/m) profile of fine roots (vertical profiles for calculating fluxes)
- real(r8) , pointer :: croot_prof_patch (:,:) ! (1/m) profile of coarse roots (vertical profiles for calculating fluxes)
- real(r8) , pointer :: stem_prof_patch (:,:) ! (1/m) profile of stems (vertical profiles for calculating fluxes)
- real(r8) , pointer :: fpi_vr_col (:,:) ! (no units) fraction of potential immobilization
- real(r8) , pointer :: fpi_col (:) ! (no units) fraction of potential immobilization
- real(r8), pointer :: fpg_col (:) ! (no units) fraction of potential gpp
- real(r8) , pointer :: rf_decomp_cascade_col (:,:,:) ! (frac) respired fraction in decomposition step
- real(r8) , pointer :: pathfrac_decomp_cascade_col (:,:,:) ! (frac) what fraction of C leaving a given pool passes through a given transition
- real(r8) , pointer :: nfixation_prof_col (:,:) ! (1/m) profile for N fixation additions
- real(r8) , pointer :: ndep_prof_col (:,:) ! (1/m) profile for N fixation additions
- real(r8) , pointer :: som_adv_coef_col (:,:) ! (m2/s) SOM advective flux
- real(r8) , pointer :: som_diffus_coef_col (:,:) ! (m2/s) SOM diffusivity due to bio/cryo-turbation
- real(r8) , pointer :: plant_ndemand_col (:) ! column-level plant N demand
-
- contains
-
- procedure, public :: Init
- procedure, public :: Restart
- procedure, private :: InitAllocate
- procedure, private :: InitHistory
- procedure, private :: InitCold
-
- end type soilbiogeochem_state_type
- !------------------------------------------------------------------------
-
-contains
-
- !------------------------------------------------------------------------
- subroutine Init(this, bounds)
-
- class(soilbiogeochem_state_type) :: this
- type(bounds_type), intent(in) :: bounds
-
- call this%InitAllocate ( bounds )
- if (use_cn) then
- call this%InitHistory ( bounds )
- end if
- call this%InitCold ( bounds )
-
- end subroutine Init
-
- !------------------------------------------------------------------------
- subroutine InitAllocate(this, bounds)
- !
- ! !DESCRIPTION:
- ! Initialize module data structure
- !
- ! !USES:
- use shr_infnan_mod , only : nan => shr_infnan_nan, assignment(=)
- !
- ! !ARGUMENTS:
- class(soilbiogeochem_state_type) :: this
- type(bounds_type), intent(in) :: bounds
- !
- ! !LOCAL VARIABLES:
- integer :: begp, endp
- integer :: begc, endc
- !------------------------------------------------------------------------
-
- begp = bounds%begp; endp= bounds%endp
- begc = bounds%begc; endc= bounds%endc
-
- allocate(this%leaf_prof_patch (begp:endp,1:nlevdecomp_full)) ; this%leaf_prof_patch (:,:) = spval
- allocate(this%froot_prof_patch (begp:endp,1:nlevdecomp_full)) ; this%froot_prof_patch (:,:) = spval
- allocate(this%croot_prof_patch (begp:endp,1:nlevdecomp_full)) ; this%croot_prof_patch (:,:) = spval
- allocate(this%stem_prof_patch (begp:endp,1:nlevdecomp_full)) ; this%stem_prof_patch (:,:) = spval
- allocate(this%fpi_vr_col (begc:endc,1:nlevdecomp_full)) ; this%fpi_vr_col (:,:) = nan
- allocate(this%fpi_col (begc:endc)) ; this%fpi_col (:) = nan
- allocate(this%fpg_col (begc:endc)) ; this%fpg_col (:) = nan
- allocate(this%nfixation_prof_col (begc:endc,1:nlevdecomp_full)) ; this%nfixation_prof_col (:,:) = spval
- allocate(this%ndep_prof_col (begc:endc,1:nlevdecomp_full)) ; this%ndep_prof_col (:,:) = spval
- allocate(this%som_adv_coef_col (begc:endc,1:nlevdecomp_full)) ; this%som_adv_coef_col (:,:) = spval
- allocate(this%som_diffus_coef_col (begc:endc,1:nlevdecomp_full)) ; this%som_diffus_coef_col (:,:) = spval
- allocate(this%plant_ndemand_col (begc:endc)) ; this%plant_ndemand_col (:) = nan
-
- allocate(this%rf_decomp_cascade_col(begc:endc,1:nlevdecomp_full,1:ndecomp_cascade_transitions));
- this%rf_decomp_cascade_col(:,:,:) = nan
-
- allocate(this%pathfrac_decomp_cascade_col(begc:endc,1:nlevdecomp_full,1:ndecomp_cascade_transitions));
- this%pathfrac_decomp_cascade_col(:,:,:) = nan
-
- end subroutine InitAllocate
-
- !------------------------------------------------------------------------
- subroutine InitHistory(this, bounds)
- !
- ! !DESCRIPTION:
- ! Initialize module data structure
- !
- ! !USES:
- use shr_infnan_mod , only : nan => shr_infnan_nan, assignment(=)
- use histFileMod , only : hist_addfld1d, hist_addfld2d, hist_addfld_decomp, no_snow_normal
- use CNSharedParamsMod , only : use_fun
- !
- ! !ARGUMENTS:
- class(soilbiogeochem_state_type) :: this
- type(bounds_type), intent(in) :: bounds
- !
- ! !LOCAL VARIABLES:
- integer :: begp, endp
- integer :: begc, endc
- character(8) :: vr_suffix
- character(10) :: active
- real(r8), pointer :: data2dptr(:,:), data1dptr(:) ! temp. pointers for slicing larger arrays
- !------------------------------------------------------------------------
-
- begp = bounds%begp; endp= bounds%endp
- begc = bounds%begc; endc= bounds%endc
-
- this%croot_prof_patch(begp:endp,:) = spval
- call hist_addfld_decomp (fname='CROOT_PROF', units='1/m', type2d='levdcmp', &
- avgflag='A', long_name='profile for litter C and N inputs from coarse roots', &
- ptr_patch=this%croot_prof_patch, default='inactive')
-
- this%froot_prof_patch(begp:endp,:) = spval
- call hist_addfld_decomp (fname='FROOT_PROF', units='1/m', type2d='levdcmp', &
- avgflag='A', long_name='profile for litter C and N inputs from fine roots', &
- ptr_patch=this%froot_prof_patch, default='inactive')
-
- this%leaf_prof_patch(begp:endp,:) = spval
- call hist_addfld_decomp (fname='LEAF_PROF', units='1/m', type2d='levdcmp', &
- avgflag='A', long_name='profile for litter C and N inputs from leaves', &
- ptr_patch=this%leaf_prof_patch, default='inactive')
-
- this%stem_prof_patch(begp:endp,:) = spval
- call hist_addfld_decomp (fname='STEM_PROF', units='1/m', type2d='levdcmp', &
- avgflag='A', long_name='profile for litter C and N inputs from stems', &
- ptr_patch=this%stem_prof_patch, default='inactive')
-
- this%nfixation_prof_col(begc:endc,:) = spval
- call hist_addfld_decomp (fname='NFIXATION_PROF', units='1/m', type2d='levdcmp', &
- avgflag='A', long_name='profile for biological N fixation', &
- ptr_col=this%nfixation_prof_col, default='inactive')
-
- this%ndep_prof_col(begc:endc,:) = spval
- call hist_addfld_decomp (fname='NDEP_PROF', units='1/m', type2d='levdcmp', &
- avgflag='A', long_name='profile for atmospheric N deposition', &
- ptr_col=this%ndep_prof_col, default='inactive')
-
- this%som_adv_coef_col(begc:endc,:) = spval
- call hist_addfld_decomp (fname='SOM_ADV_COEF', units='m/s', type2d='levdcmp', &
- avgflag='A', long_name='advection term for vertical SOM translocation', &
- ptr_col=this%som_adv_coef_col, default='inactive')
-
- this%som_diffus_coef_col(begc:endc,:) = spval
- call hist_addfld_decomp (fname='SOM_DIFFUS_COEF', units='m^2/s', type2d='levdcmp', &
- avgflag='A', long_name='diffusion coefficient for vertical SOM translocation', &
- ptr_col=this%som_diffus_coef_col, default='inactive')
-
- if ( nlevdecomp_full > 1 ) then
- this%fpi_col(begc:endc) = spval
- call hist_addfld1d (fname='FPI', units='proportion', &
- avgflag='A', long_name='fraction of potential immobilization', &
- ptr_col=this%fpi_col, default='inactive')
- endif
-
- if (.not. use_fun) then
- this%fpg_col(begc:endc) = spval
- call hist_addfld1d (fname='FPG', units='proportion', &
- avgflag='A', long_name='fraction of potential gpp', &
- ptr_col=this%fpg_col, default='inactive')
- end if
-
- if (nlevdecomp > 1) then
- vr_suffix = "_vr"
- else
- vr_suffix = ""
- endif
- this%fpi_vr_col(begc:endc,:) = spval
- call hist_addfld_decomp (fname='FPI'//trim(vr_suffix), units='proportion', type2d='levdcmp', &
- avgflag='A', long_name='fraction of potential immobilization', &
- ptr_col=this%fpi_vr_col, default='inactive')
-
- end subroutine InitHistory
-
- !-----------------------------------------------------------------------
- subroutine initCold(this, bounds)
- !
- ! !USES:
- use spmdMod , only : masterproc
- use fileutils , only : getfil
- use ncdio_pio
- !
- ! !ARGUMENTS:
- class(soilbiogeochem_state_type) :: this
- type(bounds_type), intent(in) :: bounds
- !
- ! !LOCAL VARIABLES:
- integer :: g,l,c,p,n,j,m ! indices
- integer :: dimid ! dimension id
- integer :: ier ! error status
- logical :: readvar
- integer :: begc, endc
- !-----------------------------------------------------------------------
-
- begc = bounds%begc; endc= bounds%endc
-
- ! --------------------------------------------------------------------
- ! Initialize terms needed for dust model
- ! --------------------------------------------------------------------
-
- do c = bounds%begc, bounds%endc
- l = col%landunit(c)
- if (lun%ifspecial(l)) then
- this%fpi_col (c) = spval
- this%fpg_col (c) = spval
- do j = 1,nlevdecomp_full
- this%fpi_vr_col(c,j) = spval
- end do
- end if
-
- if (lun%itype(l) == istsoil .or. lun%itype(l) == istcrop) then
- ! initialize fpi_vr so that levels below nlevsoi are not nans
- this%fpi_vr_col(c,1:nlevdecomp_full) = 0._r8
- this%som_adv_coef_col(c,1:nlevdecomp_full) = 0._r8
- this%som_diffus_coef_col(c,1:nlevdecomp_full) = 0._r8
-
- ! initialize the profiles for converting to vertically resolved carbon pools
- this%nfixation_prof_col(c,1:nlevdecomp_full) = 0._r8
- this%ndep_prof_col(c,1:nlevdecomp_full) = 0._r8
- end if
- end do
-
- end subroutine initCold
-
- !------------------------------------------------------------------------
- subroutine Restart(this, bounds, ncid, flag)
- !
- ! !USES:
- use shr_log_mod, only : errMsg => shr_log_errMsg
- use spmdMod , only : masterproc
- use abortutils , only : endrun
- use restUtilMod
- use ncdio_pio
- !
- ! !ARGUMENTS:
- class(soilbiogeochem_state_type) :: this
- type(bounds_type), intent(in) :: bounds
- type(file_desc_t), intent(inout) :: ncid
- character(len=*) , intent(in) :: flag
- !
- ! !LOCAL VARIABLES:
- integer, pointer :: temp1d(:) ! temporary
- integer :: p,j,c,i ! indices
- logical :: readvar ! determine if variable is on initial file
- real(r8), pointer :: ptr2d(:,:) ! temp. pointers for slicing larger arrays
- real(r8), pointer :: ptr1d(:) ! temp. pointers for slicing larger arrays
- !-----------------------------------------------------------------------
-
- if (use_vertsoilc) then
- ptr2d => this%fpi_vr_col
- call restartvar(ncid=ncid, flag=flag, varname='fpi_vr', xtype=ncd_double, &
- dim1name='column',dim2name='levgrnd', switchdim=.true., &
- long_name='fraction of potential immobilization', units='unitless', &
- interpinic_flag='interp', readvar=readvar, data=ptr2d)
- else
- ptr1d => this%fpi_vr_col(:,1) ! nlevdecomp = 1; so treat as 1D variable
- call restartvar(ncid=ncid, flag=flag, varname='fpi', xtype=ncd_double, &
- dim1name='column', &
- long_name='fraction of potential immobilization', units='unitless', &
- interpinic_flag='interp' , readvar=readvar, data=ptr1d)
- end if
-
- if (use_vertsoilc) then
- ptr2d => this%som_adv_coef_col
- call restartvar(ncid=ncid, flag=flag, varname='som_adv_coef_vr', xtype=ncd_double, &
- dim1name='column',dim2name='levgrnd', switchdim=.true., &
- long_name='SOM advective flux', units='m/s', fill_value=spval, &
- interpinic_flag='interp', readvar=readvar, data=ptr2d)
- end if
-
- if (use_vertsoilc) then
- ptr2d => this%som_diffus_coef_col
- call restartvar(ncid=ncid, flag=flag, varname='som_diffus_coef_vr', xtype=ncd_double, &
- dim1name='column',dim2name='levgrnd', switchdim=.true., &
- long_name='SOM diffusivity due to bio/cryo-turbation', units='m^2/s', fill_value=spval, &
- interpinic_flag='interp', readvar=readvar, data=ptr2d)
- end if
-
- call restartvar(ncid=ncid, flag=flag, varname='fpg', xtype=ncd_double, &
- dim1name='column', &
- long_name='', units='', &
- interpinic_flag='interp', readvar=readvar, data=this%fpg_col)
-
- end subroutine Restart
-
-
- function get_spinup_latitude_term(latitude) result(ans)
-
- !!DESCRIPTION:
- ! calculate a logistic function to scale spinup factors so that spinup is more accelerated in high latitude regions
- !
- ! !REVISION HISTORY
- ! charlie koven, nov. 2015
- !
- ! !ARGUMENTS:
- real(r8), intent(in) :: latitude
- !
- ! !LOCAL VARIABLES:
- real(r8) :: ans
-
- ans = 1._r8 + 50._r8 / ( 1._r8 + exp(-0.15_r8 * (abs(latitude) - 60._r8) ) )
-
- return
- end function get_spinup_latitude_term
-
-end module SoilBiogeochemStateType
diff --git a/src/soilbiogeochem/SoilBiogeochemVerticalProfileMod.F90 b/src/soilbiogeochem/SoilBiogeochemVerticalProfileMod.F90
deleted file mode 100644
index 94c8c55d..00000000
--- a/src/soilbiogeochem/SoilBiogeochemVerticalProfileMod.F90
+++ /dev/null
@@ -1,277 +0,0 @@
-module SoilBiogeochemVerticalProfileMod
-
-#include "shr_assert.h"
-
- !-----------------------------------------------------------------------
- ! !DESCRIPTION:
- ! Calculate vertical profiles for distributing soil and litter C and N
- !
- ! !USES:
- use shr_kind_mod, only: r8 => shr_kind_r8
- !
- implicit none
- private
- !
- ! !PUBLIC MEMBER FUNCTIONS:
- public:: SoilBiogeochemVerticalProfile
- !
- real(r8), public :: surfprof_exp = 10. ! how steep profile is for surface components (1/ e_folding depth) (1/m)
-
- character(len=*), parameter, private :: sourcefile = &
- __FILE__
- !-----------------------------------------------------------------------
-
-contains
-
- !-----------------------------------------------------------------------
- subroutine SoilBiogeochemVerticalProfile(bounds, num_soilc,filter_soilc,num_soilp,filter_soilp, &
- canopystate_inst, soilstate_inst, soilbiogeochem_state_inst)
- !
- ! !DESCRIPTION:
- ! calculate vertical profiles for distributing soil and litter C and N
- !
- ! BUG(wjs, 2014-12-15, bugz 2107)
- ! Because of this routine's placement in the driver sequence (it is
- ! called very early in each timestep, before weights are adjusted and filters are
- ! updated), it may be necessary for this routine to compute values over inactive as well
- ! as active points (since some inactive points may soon become active) - so that's what
- ! is done now. Currently, it seems to be okay to do this, because the variables computed
- ! here seem to only depend on quantities that are valid over inactive as well as active
- ! points. However, note that this routine is (mistakenly) called from two places
- ! currently - the above note applies to its call from the driver, but its call from
- ! CNDecompMod uses the standard filters that just apply over active points
- !
- ! !USES:
- use shr_log_mod , only : errMsg => shr_log_errMsg
- use decompMod , only : bounds_type
- use abortutils , only : endrun
- use clm_varcon , only : zsoi, dzsoi, zisoi, dzsoi_decomp, zmin_bedrock
- use clm_varpar , only : nlevdecomp, nlevgrnd, nlevdecomp_full, maxpatch_pft
- use clm_varctl , only : use_vertsoilc, iulog, use_bedrock
- use pftconMod , only : noveg, pftcon
- use SoilBiogeochemStateType , only : soilbiogeochem_state_type
- use CanopyStateType , only : canopystate_type
- use SoilStateType , only : soilstate_type
- use ColumnType , only : col
- use PatchType , only : patch
- !
- ! !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(canopystate_type) , intent(in) :: canopystate_inst
- type(soilstate_type) , intent(in) :: soilstate_inst
- type(soilbiogeochem_state_type) , intent(inout) :: soilbiogeochem_state_inst
- !
- ! !LOCAL VARIABLES:
- real(r8) :: surface_prof(1:nlevdecomp)
- real(r8) :: surface_prof_tot
- real(r8) :: rootfr_tot
- real(r8) :: cinput_rootfr(bounds%begp:bounds%endp, 1:nlevdecomp_full) ! pft-native root fraction used for calculating inputs
- real(r8) :: col_cinput_rootfr(bounds%begc:bounds%endc, 1:nlevdecomp_full) ! col-native root fraction used for calculating inputs
- integer :: c, j, fc, p, fp, pi
- integer :: alt_ind
- ! debugging temp variables
- real(r8) :: froot_prof_sum
- real(r8) :: croot_prof_sum
- real(r8) :: leaf_prof_sum
- real(r8) :: stem_prof_sum
- real(r8) :: ndep_prof_sum
- real(r8) :: nfixation_prof_sum
- real(r8) :: delta = 1.e-10
- integer :: begp, endp
- integer :: begc, endc
- character(len=32) :: subname = 'SoilBiogeochemVerticalProfile'
- !-----------------------------------------------------------------------
-
- begp = bounds%begp; endp= bounds%endp
- begc = bounds%begc; endc= bounds%endc
-
- associate( &
- altmax_lastyear_indx => canopystate_inst%altmax_lastyear_indx_col , & ! Input: [integer (:) ] frost table depth (m)
-
- crootfr => soilstate_inst%crootfr_patch , & ! Input: [real(r8) (:,:) ] fraction of roots in each soil layer (nlevgrnd)
-
- nfixation_prof => soilbiogeochem_state_inst%nfixation_prof_col , & ! Input : [real(r8) (:,:) ] (1/m) profile for N fixation additions
- ndep_prof => soilbiogeochem_state_inst%ndep_prof_col , & ! Input : [real(r8) (:,:) ] (1/m) profile for N fixation additions
- leaf_prof => soilbiogeochem_state_inst%leaf_prof_patch , & ! Output : [real(r8) (:,:) ] (1/m) profile of leaves
- froot_prof => soilbiogeochem_state_inst%froot_prof_patch , & ! Output : [real(r8) (:,:) ] (1/m) profile of fine roots
- croot_prof => soilbiogeochem_state_inst%croot_prof_patch , & ! Output : [real(r8) (:,:) ] (1/m) profile of coarse roots
- stem_prof => soilbiogeochem_state_inst%stem_prof_patch & ! Output : [real(r8) (:,:) ] (1/m) profile of stems
- )
-
- if (use_vertsoilc) then
-
- ! define a single shallow surface profile for surface additions (leaves, stems, and N deposition)
- surface_prof(:) = 0._r8
- do j = 1, nlevdecomp
- surface_prof(j) = exp(-surfprof_exp * zsoi(j)) / dzsoi_decomp(j)
- if (use_bedrock) then
- if (zsoi(j) > zmin_bedrock) then
- surface_prof(j) = 0._r8
- end if
- end if
- end do
-
- ! initialize profiles to zero
- leaf_prof(begp:endp, :) = 0._r8
- froot_prof(begp:endp, :) = 0._r8
- croot_prof(begp:endp, :) = 0._r8
- stem_prof(begp:endp, :) = 0._r8
- nfixation_prof(begc:endc, :) = 0._r8
- ndep_prof(begc:endc, :) = 0._r8
-
- cinput_rootfr(begp:endp, :) = 0._r8
- col_cinput_rootfr(begc:endc, :) = 0._r8
-
- do fp = 1,num_soilp
- p = filter_soilp(fp)
- c = patch%column(p)
- if (patch%itype(p) /= noveg) then
- do j = 1, nlevdecomp
- cinput_rootfr(p,j) = crootfr(p,j) / dzsoi_decomp(j)
- end do
-
- else
- cinput_rootfr(p,1) = 0.
- endif
- end do
-
- do fp = 1,num_soilp
- p = filter_soilp(fp)
- c = patch%column(p)
- ! integrate rootfr over active layer of soil column
- rootfr_tot = 0._r8
- surface_prof_tot = 0._r8
- do j = 1, min(max(altmax_lastyear_indx(c), 1), nlevdecomp)
- rootfr_tot = rootfr_tot + cinput_rootfr(p,j) * dzsoi_decomp(j)
- surface_prof_tot = surface_prof_tot + surface_prof(j) * dzsoi_decomp(j)
- end do
- if ( (altmax_lastyear_indx(c) > 0) .and. (rootfr_tot > 0._r8) .and. (surface_prof_tot > 0._r8) ) then
- ! where there is not permafrost extending to the surface, integrate the profiles over the active layer
- ! this is equivalnet to integrating over all soil layers outside of permafrost regions
- do j = 1, min(max(altmax_lastyear_indx(c), 1), nlevdecomp)
- froot_prof(p,j) = cinput_rootfr(p,j) / rootfr_tot
- croot_prof(p,j) = cinput_rootfr(p,j) / rootfr_tot
-
- if (j > col%nbedrock(c) .and. cinput_rootfr(p,j) > 0._r8) then
- write(iulog,*) 'cinput_rootfr > 0 in bedrock'
- end if
- ! set all surface processes to shallower profile
- leaf_prof(p,j) = surface_prof(j)/ surface_prof_tot
- stem_prof(p,j) = surface_prof(j)/ surface_prof_tot
- end do
- else
- ! if fully frozen, or no roots, put everything in the top layer
- froot_prof(p,1) = 1./dzsoi_decomp(1)
- croot_prof(p,1) = 1./dzsoi_decomp(1)
- leaf_prof(p,1) = 1./dzsoi_decomp(1)
- stem_prof(p,1) = 1./dzsoi_decomp(1)
- endif
-
- end do
-
- !! aggregate root profile to column
- ! call p2c (decomp, nlevdecomp_full, &
- ! cinput_rootfr(bounds%begp:bounds%endp, :), &
- ! col_cinput_rootfr(bounds%begc:bounds%endc, :), &
- ! 'unity')
- do pi = 1,maxpatch_pft
- do fc = 1,num_soilc
- c = filter_soilc(fc)
- if (pi <= col%npatches(c)) then
- p = col%patchi(c) + pi - 1
- do j = 1,nlevdecomp
- col_cinput_rootfr(c,j) = col_cinput_rootfr(c,j) + cinput_rootfr(p,j) * patch%wtcol(p)
- end do
- end if
- end do
- end do
-
- ! repeat for column-native profiles: Ndep and Nfix
- do fc = 1,num_soilc
- c = filter_soilc(fc)
- rootfr_tot = 0._r8
- surface_prof_tot = 0._r8
- ! redo column ntegration over active layer for column-native profiles
- do j = 1, min(max(altmax_lastyear_indx(c), 1), nlevdecomp)
- rootfr_tot = rootfr_tot + col_cinput_rootfr(c,j) * dzsoi_decomp(j)
- surface_prof_tot = surface_prof_tot + surface_prof(j) * dzsoi_decomp(j)
- end do
- if ( (altmax_lastyear_indx(c) > 0) .and. (rootfr_tot > 0._r8) .and. (surface_prof_tot > 0._r8) ) then
- do j = 1, min(max(altmax_lastyear_indx(c), 1), nlevdecomp)
- nfixation_prof(c,j) = col_cinput_rootfr(c,j) / rootfr_tot
- ndep_prof(c,j) = surface_prof(j)/ surface_prof_tot
- end do
- else
- nfixation_prof(c,1) = 1./dzsoi_decomp(1)
- ndep_prof(c,1) = 1./dzsoi_decomp(1)
- endif
- end do
-
- else
-
- ! for one layer decomposition model, set profiles to unity
- leaf_prof(begp:endp, :) = 1._r8
- froot_prof(begp:endp, :) = 1._r8
- croot_prof(begp:endp, :) = 1._r8
- stem_prof(begp:endp, :) = 1._r8
- nfixation_prof(begc:endc, :) = 1._r8
- ndep_prof(begc:endc, :) = 1._r8
-
- end if
-
-
- ! check to make sure integral of all profiles = 1.
- do fc = 1,num_soilc
- c = filter_soilc(fc)
- ndep_prof_sum = 0.
- nfixation_prof_sum = 0.
- do j = 1, nlevdecomp
- ndep_prof_sum = ndep_prof_sum + ndep_prof(c,j) * dzsoi_decomp(j)
- nfixation_prof_sum = nfixation_prof_sum + nfixation_prof(c,j) * dzsoi_decomp(j)
- end do
- if ( ( abs(ndep_prof_sum - 1._r8) > delta ) .or. ( abs(nfixation_prof_sum - 1._r8) > delta ) ) then
- write(iulog, *) 'profile sums: ', ndep_prof_sum, nfixation_prof_sum
- write(iulog, *) 'c: ', c
- write(iulog, *) 'altmax_lastyear_indx: ', altmax_lastyear_indx(c)
- write(iulog, *) 'nfixation_prof: ', nfixation_prof(c,:)
- write(iulog, *) 'ndep_prof: ', ndep_prof(c,:)
- write(iulog, *) 'cinput_rootfr: ', cinput_rootfr(c,:)
- write(iulog, *) 'dzsoi_decomp: ', dzsoi_decomp(:)
- write(iulog, *) 'surface_prof: ', surface_prof(:)
- write(iulog, *) 'npfts(c): ', col%npatches(c)
- do p = col%patchi(c), col%patchi(c) + col%npatches(c) -1
- write(iulog, *) 'p, itype(p), wtcol(p): ', p, patch%itype(p), patch%wtcol(p)
- write(iulog, *) 'cinput_rootfr(p,:): ', cinput_rootfr(p,:)
- end do
- call endrun(msg=" ERROR: _prof_sum-1>delta"//errMsg(sourcefile, __LINE__))
- endif
- end do
-
- do fp = 1,num_soilp
- p = filter_soilp(fp)
- froot_prof_sum = 0.
- croot_prof_sum = 0.
- leaf_prof_sum = 0.
- stem_prof_sum = 0.
- do j = 1, nlevdecomp
- froot_prof_sum = froot_prof_sum + froot_prof(p,j) * dzsoi_decomp(j)
- croot_prof_sum = croot_prof_sum + croot_prof(p,j) * dzsoi_decomp(j)
- leaf_prof_sum = leaf_prof_sum + leaf_prof(p,j) * dzsoi_decomp(j)
- stem_prof_sum = stem_prof_sum + stem_prof(p,j) * dzsoi_decomp(j)
- end do
- if ( ( abs(froot_prof_sum - 1._r8) > delta ) .or. ( abs(croot_prof_sum - 1._r8) > delta ) .or. &
- ( abs(stem_prof_sum - 1._r8) > delta ) .or. ( abs(leaf_prof_sum - 1._r8) > delta ) ) then
- write(iulog, *) 'profile sums: ', froot_prof_sum, croot_prof_sum, leaf_prof_sum, stem_prof_sum
- call endrun(msg=' ERROR: sum-1 > delta'//errMsg(sourcefile, __LINE__))
- endif
- end do
-
- end associate
-
- end subroutine SoilBiogeochemVerticalProfile
-
-end module SoilBiogeochemVerticalProfileMod
diff --git a/src/utils/domainMod.F90 b/src/utils/domainMod.F90
index 7cdd62b4..980df227 100644
--- a/src/utils/domainMod.F90
+++ b/src/utils/domainMod.F90
@@ -31,7 +31,6 @@ module domainMod
real(r8),pointer :: latc(:) ! latitude of grid cell (deg)
real(r8),pointer :: lonc(:) ! longitude of grid cell (deg)
real(r8),pointer :: area(:) ! grid cell area (km**2)
- integer ,pointer :: pftm(:) ! pft mask: 1=real, 0=fake, -1=notset
character*16 :: set ! flag to check if domain is set
logical :: decomped ! decomposed locally or global copy
end type domain_type
@@ -102,7 +101,7 @@ subroutine domain_init(domain,isgrid2d,ni,nj,nbeg,nend,clmlevel)
call domain_clean(domain)
endif
allocate(domain%mask(nb:ne),domain%frac(nb:ne),domain%latc(nb:ne), &
- domain%pftm(nb:ne),domain%area(nb:ne),domain%lonc(nb:ne), &
+ domain%area(nb:ne),domain%lonc(nb:ne), &
stat=ier)
if (ier /= 0) then
call shr_sys_abort('domain_init ERROR: allocate mask, frac, lat, lon, area ')
@@ -131,8 +130,6 @@ subroutine domain_init(domain,isgrid2d,ni,nj,nbeg,nend,clmlevel)
domain%decomped = .true.
endif
- domain%pftm = -9999
-
end subroutine domain_init
!------------------------------------------------------------------------------
!BOP
@@ -163,7 +160,7 @@ subroutine domain_clean(domain)
write(iulog,*) 'domain_clean: cleaning ',domain%ni,domain%nj
endif
deallocate(domain%mask,domain%frac,domain%latc, &
- domain%lonc,domain%area,domain%pftm, &
+ domain%lonc,domain%area, &
stat=ier)
if (ier /= 0) then
call shr_sys_abort('domain_clean ERROR: deallocate mask, frac, lat, lon, area ')
@@ -222,7 +219,6 @@ subroutine domain_check(domain)
write(iulog,*) ' domain_check mask = ',minval(domain%mask),maxval(domain%mask)
write(iulog,*) ' domain_check frac = ',minval(domain%frac),maxval(domain%frac)
write(iulog,*) ' domain_check area = ',minval(domain%area),maxval(domain%area)
- write(iulog,*) ' domain_check pftm = ',minval(domain%pftm),maxval(domain%pftm)
write(iulog,*) ' '
endif
diff --git a/src/utils/restUtilMod.F90.in b/src/utils/restUtilMod.F90.in
index cda77ccd..4c19343a 100644
--- a/src/utils/restUtilMod.F90.in
+++ b/src/utils/restUtilMod.F90.in
@@ -564,9 +564,6 @@ contains
! gridcell-level field from a patch-, column- or landunit-level field - and maybe
! also set a column-level field from a patch-level field, etc.
!
- ! !USES:
- use subgridAveMod, only : c2g
- !
! !ARGUMENTS:
type(bounds_type) , intent(in) :: bounds
type(file_desc_t) , intent(inout) :: ncid ! netcdf file id
@@ -582,18 +579,6 @@ contains
SHR_ASSERT_ALL((ubound(data_grc) == (/bounds%endg/)), errMsg(sourcefile, __LINE__))
- allocate(data_col(bounds%begc:bounds%endc))
- call ncd_io(varname=trim(varname), data=data_col, &
- dim1name='column', &
- ncid=ncid, flag='read', readvar=readvar)
-
- if (readvar) then
- call c2g(bounds, data_col, data_grc, &
- c2l_scale_type = 'unity', &
- l2g_scale_type = 'unity')
- end if
-
- deallocate(data_col)
end subroutine set_grc_field_from_col_field
!-----------------------------------------------------------------------
diff --git a/tools/README b/tools/README
new file mode 100644
index 00000000..2efe3a51
--- /dev/null
+++ b/tools/README
@@ -0,0 +1,29 @@
+$SLIMROOT/tools/README Feb/28/2023
+
+SLIM tools for analysis of SLIM history files or
+ for creation or modification of SLIM input files.
+
+I. General directory structure:
+
+ $SLIMROOT/tools
+ mksurdat Create SLIM surface dataset (surdat file) from CTSM
+ history output files. TOOL NOT AVAILABLE
+
+ modify_input_files Scripts to modify SLIM input files. Currently
+ there is one available tool and it can modify
+ SLIM surdat files.
+
+ cime-tools ($CIMEROOT/tools/) (CIMEROOT is ../cime for a SLIM checkout and ../../../cime for a CESM checkout)
+ $CIMEROOT/mapping/gen_domain_files
+ gen_domain ------- Create data model domain datasets from SCRIP mapping datasets.
+
+II. Notes on building/running for each of the above tools:
+
+ Refer to each tool's README for more information.
+
+III. Create input datasets needed to run SLIM
+
+ 1.) Create surface dataset with mksurdat.ipynb. Detailed instructions here:
+/glade/work/slevis/git_slim/surdat_modifier/tools/mksurdat/README.mksurdat
+
+ 2.) Add the new file to XML data or using user_nl_clm (optional)
diff --git a/tools/mksurdat/README.mksurdat b/tools/mksurdat/README.mksurdat
new file mode 100644
index 00000000..f0d58382
--- /dev/null
+++ b/tools/mksurdat/README.mksurdat
@@ -0,0 +1,42 @@
+mksurdat is a jupyter notebook tool that generates SLIM surdat files.
+It reads pre-averaged ctsm and cpl history files and outputs a SLIM
+surdat file.
+
+Files involved
+--------------
+python/slim/mksurdat/mksurdat.ipynb
+
+Instructions
+------------
+To run on Cheyenne/Casper
+1) Before starting the jupyter session for the first time, set up your
+conda environment:
+
+> cd /path/to/your_checked_out_ctsm_directory
+> ./py_env_create # needed the first time & periodically for environment updates
+> conda activate ctsm_pylib
+> pip install ipykernel
+
+Also you need the next line to use nco (netcdf operators) a bit later:
+> module load nco
+
+2) On your browser go here:
+https://jupyterhub.hpc.ucar.edu/
+
+a) Start default server
+b) Launch server
+c) Use jupyter's file navigation to get to
+your_checked_out_ctsm_directory/python/slim/mksurdat
+d) Open mksurdat.ipynb
+e) Use the menu to select Kernel --> Change Kernel --> ctsm_pylib
+f) In the notebook's second cell, modify the following settings:
+- casename
+- start_yr
+- surfdat_file (not required; tool will work without this file)
+g) In the notebook's third cell, find a suggestion for generating
+concatenated ctsm and cpl history files using nco
+
+9) Using the menu, select Run, Run all cells
+
+10) You should have a new surdat file in the same directory as the .ipynb
+file (see Files involved above) in less than a minute
diff --git a/tools/modify_input_files/README.surdat_modifier b/tools/modify_input_files/README.surdat_modifier
new file mode 100644
index 00000000..82bdfe26
--- /dev/null
+++ b/tools/modify_input_files/README.surdat_modifier
@@ -0,0 +1,28 @@
+surdat_modifier is a tool that modifies SLIM surdat files. It reads a surface
+dataset (surdat file) and outputs a modified copy of the same file.
+
+SLIM's surdat_modifier used CTSM's fsurdat_modifier as a design template.
+
+Files involved
+--------------
+python/slim/modify_input_files/surdat_modifier.py
+python/slim/modify_input_files/modify_surdat.py
+tools/modify_input_files/surdat_modifier
+tools/modify_input_files/modify_surdat_template.cfg
+
+Instructions
+------------
+To run on Cheyenne/Casper/Izumi
+1) (Un)load, execute, and activate the following:
+module unload python
+module load conda
+./py_env_create
+conda activate slim_pylib # conda activate ctsm_pylib UNTIL slim separates from ctsm
+(Use "deactivate" to reverse the latter.)
+2) Copy, then modify the configure file named modify_surdat_template.cfg, which
+contains all the arguments needed by the script.
+3) Run the script ./surdat_modifier pointing to the copied/modified .cfg file,
+e.g. modify_users_copy.cfg
+./surdat_modifier modify_users_copy.cfg
+See modify_surdat_template.cfg for required and optional settings.
+4) Use the --verbose option to see progress output on your screen
diff --git a/tools/modify_input_files/modify_surdat_defaults.cfg b/tools/modify_input_files/modify_surdat_defaults.cfg
new file mode 100644
index 00000000..c61d3e00
--- /dev/null
+++ b/tools/modify_input_files/modify_surdat_defaults.cfg
@@ -0,0 +1,25 @@
+[modify_input]
+
+# ------------------------------------------------------------------------
+# .cfg file with defaults for surdat_modifier.
+# ------------------------------------------------------------------------
+
+glc_mask = 0 0 0 0 0 0 0 0 0 0 0 0
+alb_gvd = 0.2 0.2 0.2 0.2 0.2 0.2 0.2 0.2 0.2 0.2 0.2 0.2
+alb_svd = 0.8 0.8 0.8 0.8 0.8 0.8 0.8 0.8 0.8 0.8 0.8 0.8
+alb_gnd = 0.3 0.3 0.3 0.3 0.3 0.3 0.3 0.3 0.3 0.3 0.3 0.3
+alb_snd = 0.6 0.6 0.6 0.6 0.6 0.6 0.6 0.6 0.6 0.6 0.6 0.6
+alb_gvf = 0.2 0.2 0.2 0.2 0.2 0.2 0.2 0.2 0.2 0.2 0.2 0.2
+alb_svf = 0.8 0.8 0.8 0.8 0.8 0.8 0.8 0.8 0.8 0.8 0.8 0.8
+alb_gnf = 0.3 0.3 0.3 0.3 0.3 0.3 0.3 0.3 0.3 0.3 0.3 0.3
+alb_snf = 0.6 0.6 0.6 0.6 0.6 0.6 0.6 0.6 0.6 0.6 0.6 0.6
+bucketdepth = 200 200 200 200 200 200 200 200 200 200 200 200
+emissivity = 1 1 1 1 1 1 1 1 1 1 1 1
+snowmask = 50 50 50 50 50 50 50 50 50 50 50 50
+roughness = 0.1 0.1 0.1 0.1 0.1 0.1 0.1 0.1 0.1 0.1 0.1 0.1
+evap_res = 100 100 100 100 100 100 100 100 100 100 100 100
+soil_type = 0 0 0 0 0 0 0 0 0 0 0 0
+soil_tk_1d = 1.5 1.5 1.5 1.5 1.5 1.5 1.5 1.5 1.5 1.5 1.5 1.5
+soil_cv_1d = 2e6 2e6 2e6 2e6 2e6 2e6 2e6 2e6 2e6 2e6 2e6 2e6
+glc_tk_1d = 2.4 2.4 2.4 2.4 2.4 2.4 2.4 2.4 2.4 2.4 2.4 2.4
+glc_cv_1d = 1.9e6 1.9e6 1.9e6 1.9e6 1.9e6 1.9e6 1.9e6 1.9e6 1.9e6 1.9e6 1.9e6 1.9e6
diff --git a/tools/modify_input_files/modify_surdat_template.cfg b/tools/modify_input_files/modify_surdat_template.cfg
new file mode 100644
index 00000000..413d1cbb
--- /dev/null
+++ b/tools/modify_input_files/modify_surdat_template.cfg
@@ -0,0 +1,103 @@
+[modify_input]
+
+# ------------------------------------------------------------------------
+# .cfg file with inputs for surdat_modifier.
+#
+# We advise users to make a copy of this file that they can change freely,
+# rather than changing this "template" file.
+#
+# Variables with FILL_THIS_IN must be specified.
+# Variables with UNSET may be specified; if not and
+# - defaults = False, they will remain unused
+# - defaults = True, they will take on default values hardwired in the
+# code. Details in comments below.
+# Variables with values already set, may be changed to other values. If
+# they get omitted, they will obtain the same default values found here.
+# ------------------------------------------------------------------------
+
+# Path and name of input surface dataset (str)
+surdat_in = FILL_THIS_IN
+
+# Path and name of output surface dataset (str)
+surdat_out = FILL_THIS_IN
+
+# defaults (bool)
+# When user wants existing values in surdat to persist in all except the
+# variables that they explicitly request to change, then set this to False.
+# When user wants default representation of the land by resetting all
+# surdat variables, some through this file and others by using hardwired
+# defaults, then set this to True. Hardwired values are as follows:
+# glc_mask = [0] * self.months
+# alb_gvd = [0.2] * self.months
+# alb_svd = [0.8] * self.months
+# alb_gnd = [0.3] * self.months
+# alb_snd = [0.6] * self.months
+# alb_gvf = [0.2] * self.months
+# alb_svf = [0.8] * self.months
+# alb_gnf = [0.3] * self.months
+# alb_snf = [0.6] * self.months
+# bucketdepth = [200] * self.months
+# emissivity = [1] * self.months
+# snowmask = [50] * self.months
+# roughness = [0.1] * self.months
+# evap_res = [100] * self.months
+# soil_type = [0] * self.months
+# soil_tk_1d = [1.5] * self.months
+# soil_cv_1d = [2e6] * self.months
+# glc_tk_1d = [2.4] * self.months
+# glc_cv_1d = [1.9e6] * self.months
+defaults = False
+
+# Boundaries of user-defined rectangle (float)
+# If lat_1 > lat_2, the code creates two rectangles, one in the north and
+# one in the south.
+# If lon_1 > lon_2, the rectangle wraps around the 0-degree meridian.
+# Alternatively, user may specify a custom area in a .nc landmask_file
+# below. If set, this will override the lat/lon settings.
+# -----------------------------------
+# southernmost latitude for rectangle
+lnd_lat_1 = -90
+# northernmost latitude for rectangle
+lnd_lat_2 = 90
+# westernmost longitude for rectangle
+lnd_lon_1 = 0
+# easternmost longitude for rectangle
+lnd_lon_2 = 360
+# User-defined mask in a file, as alternative to setting lat/lon values.
+# If set, lat_dimname and lon_dimname should likely also be set. IMPORTANT:
+# - lat_dimname and lon_dimname may be left UNSET if they match the expected
+# default values 'lsmlat' and 'lsmlon'
+landmask_file = UNSET
+lat_dimname = UNSET
+lon_dimname = UNSET
+
+# Monthly values over the user-defined mask.
+# Space-delimited list of 12 floats or int without brackets
+# e.g., glc_mask = 1 1 1 1 1 1 1 1 1 1 1 1
+# Any of the variables updated below by the user will be
+# updated in the surdat_out file in the user-defined mask.
+# if defaults = True and some of the following variables are UNSET, then they
+# will default to the corresponding values listed above in the "defaults"
+# comments, again only in the user-defined mask.
+# if defaults = False and some of the following variables are UNSET, then they
+# will remain unchanged from the surdat_in file.
+# SOIL_TYPE accepts integer values from ? to ?.
+glc_mask = UNSET
+alb_gvd = UNSET
+alb_svd = UNSET
+alb_gnd = UNSET
+alb_snd = UNSET
+alb_gvf = UNSET
+alb_svf = UNSET
+alb_gnf = UNSET
+alb_snf = UNSET
+bucketdepth = UNSET
+emissivity = UNSET
+snowmask = UNSET
+roughness = UNSET
+evap_res = UNSET
+soil_type = UNSET
+soil_tk_1d = UNSET
+soil_cv_1d = UNSET
+glc_tk_1d = UNSET
+glc_cv_1d = UNSET
diff --git a/tools/modify_input_files/surdat_modifier b/tools/modify_input_files/surdat_modifier
new file mode 100755
index 00000000..ed36a2b0
--- /dev/null
+++ b/tools/modify_input_files/surdat_modifier
@@ -0,0 +1,18 @@
+#!/usr/bin/env python3
+"""
+For description and instructions, please see README.
+"""
+
+import os
+import sys
+
+_SLIM_PYTHON = os.path.join(os.path.dirname(os.path.realpath(__file__)),
+ os.pardir,
+ os.pardir,
+ 'python')
+sys.path.insert(1, _SLIM_PYTHON)
+
+from slim.modify_input_files.surdat_modifier import main
+
+if __name__ == "__main__":
+ main()